[Pkg-haskell-commits] [agda] 02/04: Imported Upstream version 2.4.2
Iain Lane
laney at moszumanska.debian.org
Tue Sep 23 09:03:09 UTC 2014
This is an automated email from the git hooks/post-receive script.
laney pushed a commit to branch master
in repository agda.
commit 677086877373ece7f03f0268479162f3d2245233
Author: Iain Lane <laney at debian.org>
Date: Tue Sep 23 09:54:08 2014 +0100
Imported Upstream version 2.4.2
---
Agda.cabal | 30 +-
CHANGELOG | 354 ++-
README | 319 --
README.md | 210 ++
dist/build/Agda/Syntax/Parser/Lexer.hs | 185 +-
dist/build/Agda/Syntax/Parser/Parser.hs | 3360 +++++++++++---------
src/data/agda.sty | 45 +-
src/data/emacs-mode/agda2-mode.el | 25 +-
src/data/postprocess-latex.pl | 24 +
src/full/Agda/Auto/Convert.hs | 6 +-
src/full/Agda/Auto/NarrowingSearch.hs | 2 +-
src/full/Agda/Compiler/Epic/FromAgda.hs | 1 +
src/full/Agda/Compiler/Epic/Static.hs | 1 +
src/full/Agda/Compiler/HaskellTypes.hs | 1 +
src/full/Agda/Compiler/JS/Compiler.hs | 3 +-
src/full/Agda/Compiler/JS/Syntax.hs | 3 +-
src/full/Agda/Compiler/MAlonzo/Compiler.hs | 36 +-
src/full/Agda/Compiler/MAlonzo/Misc.hs | 5 +-
src/full/Agda/Compiler/MAlonzo/Primitives.hs | 1 +
src/full/Agda/Interaction/BasicOps.hs | 25 +-
src/full/Agda/Interaction/EmacsTop.hs | 2 +
src/full/Agda/Interaction/Highlighting/Generate.hs | 1 +
src/full/Agda/Interaction/Imports.hs | 24 +-
src/full/Agda/Interaction/InteractionTop.hs | 43 +-
src/full/Agda/Interaction/Options.hs | 6 +
src/full/Agda/Interaction/Response.hs | 1 +
src/full/Agda/Main.hs | 24 +-
src/full/Agda/Syntax/Abstract.hs | 15 +-
src/full/Agda/Syntax/Common.hs | 25 +
src/full/Agda/Syntax/Concrete.hs | 38 +-
src/full/Agda/Syntax/Concrete/Definitions.hs | 207 +-
src/full/Agda/Syntax/Concrete/Generic.hs | 3 +
src/full/Agda/Syntax/Concrete/Operators.hs | 97 +-
src/full/Agda/Syntax/Concrete/Operators/Parser.hs | 25 +-
src/full/Agda/Syntax/Concrete/Pretty.hs | 36 +-
src/full/Agda/Syntax/Info.hs | 15 +-
src/full/Agda/Syntax/Internal.hs | 105 +
src/full/Agda/Syntax/Internal/Defs.hs | 6 +-
src/full/Agda/Syntax/Internal/Generic.hs | 8 +-
src/full/Agda/Syntax/Literal.hs | 22 +
src/full/Agda/Syntax/Parser/Lexer.x | 6 +
src/full/Agda/Syntax/Parser/Parser.y | 94 +-
src/full/Agda/Syntax/Parser/Tokens.hs | 11 +-
src/full/Agda/Syntax/Position.hs | 7 +-
src/full/Agda/Syntax/Scope/Base.hs | 21 +-
src/full/Agda/Syntax/Scope/Monad.hs | 173 +-
.../Agda/Syntax/Translation/AbstractToConcrete.hs | 23 +-
.../Agda/Syntax/Translation/ConcreteToAbstract.hs | 89 +-
.../Agda/Syntax/Translation/InternalToAbstract.hs | 49 +-
src/full/Agda/Termination/CallGraph.hs | 3 -
src/full/Agda/Termination/Inlining.hs | 1 -
src/full/Agda/Termination/Monad.hs | 27 +-
src/full/Agda/Termination/TermCheck.hs | 86 +-
src/full/Agda/TypeChecking/Abstract.hs | 6 +-
src/full/Agda/TypeChecking/CheckInternal.hs | 2 +-
.../Agda/TypeChecking/CompiledClause/Compile.hs | 89 +-
src/full/Agda/TypeChecking/CompiledClause/Match.hs | 1 -
src/full/Agda/TypeChecking/Conversion.hs | 9 +-
src/full/Agda/TypeChecking/Datatypes.hs | 1 +
src/full/Agda/TypeChecking/DropArgs.hs | 1 -
src/full/Agda/TypeChecking/Errors.hs | 40 +-
src/full/Agda/TypeChecking/EtaContract.hs | 1 +
src/full/Agda/TypeChecking/Free.hs | 9 +-
src/full/Agda/TypeChecking/Implicit.hs | 5 +-
src/full/Agda/TypeChecking/Injectivity.hs | 12 +-
src/full/Agda/TypeChecking/InstanceArguments.hs | 194 +-
src/full/Agda/TypeChecking/Level.hs | 20 +-
src/full/Agda/TypeChecking/MetaVars.hs | 176 +-
src/full/Agda/TypeChecking/MetaVars.hs-boot | 7 +-
src/full/Agda/TypeChecking/MetaVars/Mention.hs | 5 +-
src/full/Agda/TypeChecking/MetaVars/Occurs.hs | 21 +-
src/full/Agda/TypeChecking/Monad/Base.hs | 89 +-
src/full/Agda/TypeChecking/Monad/Base/KillRange.hs | 8 +-
src/full/Agda/TypeChecking/Monad/Benchmark.hs | 10 +-
src/full/Agda/TypeChecking/Monad/Builtin.hs | 57 +-
src/full/Agda/TypeChecking/Monad/Constraints.hs | 70 +-
src/full/Agda/TypeChecking/Monad/Env.hs | 9 +
src/full/Agda/TypeChecking/Monad/Exception.hs | 5 +-
src/full/Agda/TypeChecking/Monad/Signature.hs | 257 +-
src/full/Agda/TypeChecking/Monad/SizedTypes.hs | 1 +
src/full/Agda/TypeChecking/Monad/State.hs | 115 +
src/full/Agda/TypeChecking/Monad/Trace.hs | 17 +-
src/full/Agda/TypeChecking/Patterns/Abstract.hs | 1 -
src/full/Agda/TypeChecking/Polarity.hs | 1 +
src/full/Agda/TypeChecking/Positivity.hs | 12 +
src/full/Agda/TypeChecking/Pretty.hs | 15 +-
src/full/Agda/TypeChecking/Primitive.hs | 68 +-
src/full/Agda/TypeChecking/ProjectionLike.hs | 2 +-
src/full/Agda/TypeChecking/Quote.hs | 391 ++-
src/full/Agda/TypeChecking/Records.hs | 2 +-
src/full/Agda/TypeChecking/Reduce.hs | 22 +-
src/full/Agda/TypeChecking/Reduce/Monad.hs | 1 -
src/full/Agda/TypeChecking/Rewriting.hs | 215 ++
src/full/Agda/TypeChecking/Rewriting.hs-boot | 7 +
src/full/Agda/TypeChecking/Rules/Builtin.hs | 43 +-
src/full/Agda/TypeChecking/Rules/Data.hs | 8 +-
src/full/Agda/TypeChecking/Rules/Decl.hs | 113 +-
src/full/Agda/TypeChecking/Rules/Decl.hs-boot | 4 +-
src/full/Agda/TypeChecking/Rules/Def.hs | 8 +-
src/full/Agda/TypeChecking/Rules/LHS.hs | 34 +-
.../Agda/TypeChecking/Rules/LHS/ProblemRest.hs | 1 +
src/full/Agda/TypeChecking/Rules/Record.hs | 16 +-
src/full/Agda/TypeChecking/Rules/Term.hs | 31 +-
src/full/Agda/TypeChecking/Serialise.hs | 43 +-
src/full/Agda/TypeChecking/SizedTypes/Solve.hs | 7 +-
src/full/Agda/TypeChecking/SizedTypes/Syntax.hs | 13 +-
.../Agda/TypeChecking/SizedTypes/WarshallSolver.hs | 3 -
src/full/Agda/TypeChecking/Substitute.hs | 61 +-
src/full/Agda/TypeChecking/Telescope.hs | 56 +-
src/full/Agda/TypeChecking/Test/Generators.hs | 2 +
src/full/Agda/TypeChecking/With.hs | 5 +-
src/full/Agda/Utils/Function.hs | 8 +
src/full/Agda/Utils/List.hs | 28 +
src/full/Agda/Utils/Null.hs | 28 +
src/full/Agda/Utils/String.hs | 6 +
src/full/Agda/Utils/Time.hs | 15 +
116 files changed, 5358 insertions(+), 3078 deletions(-)
diff --git a/Agda.cabal b/Agda.cabal
index eeb23f0..7499eef 100644
--- a/Agda.cabal
+++ b/Agda.cabal
@@ -1,5 +1,5 @@
name: Agda
-version: 2.4.0.2
+version: 2.4.2
cabal-version: >= 1.8
build-type: Custom
license: OtherLicense
@@ -37,7 +37,7 @@ tested-with: GHC == 7.2.2
GHC == 7.6.3
GHC == 7.8.3
extra-source-files: src/full/Agda/undefined.h
- README
+ README.md
CHANGELOG
data-dir: src/data
data-files: Agda.css
@@ -46,6 +46,7 @@ data-files: Agda.css
EpicInclude/stdagda.c
EpicInclude/stdagda.h
agda.sty
+ postprocess-latex.pl
lib/prim/Agda/Primitive.agda
source-repository head
@@ -54,9 +55,8 @@ source-repository head
source-repository this
type: git
- location: https://github.com/agda/agda.git
- branch: maint-2.4.0
- tag: 2.4.0.2
+ location: https://github.com/agda/agda
+ tag: 2.4.2
flag epic
default: False
@@ -113,12 +113,9 @@ library
directory == 1.2.*
build-tools: happy >= 1.19.3 && < 2,
- alex >= 3.1.0 && < 3.2
+ alex >= 3.1.0 && < 3.2,
+ cpphs >= 1.18.5 && < 1.19
- -- LANGUAGE extension CPP is needed for cabal haddock (as of now, May 2014).
- -- However, each file should define {-# LANGUAGE CPP #-}, for the sake
- -- of ghci and make tags.
- extensions: CPP
exposed-modules: Agda.Main
Agda.ImpossibleTest
Agda.Interaction.BasicOps
@@ -288,6 +285,7 @@ library
Agda.TypeChecking.Records
Agda.TypeChecking.Reduce
Agda.TypeChecking.Reduce.Monad
+ Agda.TypeChecking.Rewriting
Agda.TypeChecking.Rules.Builtin
Agda.TypeChecking.Rules.Builtin.Coinduction
Agda.TypeChecking.Rules.Data
@@ -382,6 +380,16 @@ library
-fwarn-overlapping-patterns
-fwarn-unrecognised-pragmas
-fwarn-warnings-deprecations
+ -- Using cpphs as the C preprocessor.
+ -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.
+ -- if impl(ghc > 7.2.2)
+ -- ghc-options: -Werror
if impl(ghc >= 6.12)
ghc-options: -fwarn-dodgy-exports
-fwarn-wrong-do-bind
@@ -402,7 +410,7 @@ library
executable agda
hs-source-dirs: src/main
main-is: Main.hs
- build-depends: Agda == 2.4.0.2,
+ build-depends: Agda == 2.4.2,
-- Nothing is used from the following package, except
-- for the prelude.
base >= 3 && < 6
diff --git a/CHANGELOG b/CHANGELOG
index b1466c1..309096d 100644
--- a/CHANGELOG
+++ b/CHANGELOG
@@ -1,4 +1,343 @@
------------------------------------------------------------------------
+-- Release notes for Agda version 2.4.2
+------------------------------------------------------------------------
+
+Important changes since 2.4.0.2:
+
+Pragmas and options
+===================
+
+* New option: --with-K.
+
+ This can be used to override a global --without-K in a file, by
+ adding a pragma {-# OPTIONS --with-K #-}.
+
+* New pragma {-# NON_TERMINATING #-}
+
+ This is a safer version of NO_TERMINATION_CHECK which doesn't treat the
+ affected functions as terminating. This means that NON_TERMINATING functions
+ do not reduce during type checking. They do reduce at run-time and when
+ invoking C-c C-n at top-level (but not in a hole).
+
+Language
+========
+
+* Instance search is now more efficient and recursive (see issue 938)
+ (but without termination check yet).
+
+ A new keyword `instance' has been introduced (in the style of
+ `abstract' and `private') which must now be used for every
+ definition/postulate that has to be taken into account during instance
+ resolution. For example:
+
+ record RawMonoid (A : Set) : Set where
+ field
+ nil : A
+ _++_ : A -> A -> A
+
+ open RawMonoid {{...}}
+
+ instance
+ rawMonoidList : {A : Set} -> RawMonoid (List A)
+ rawMonoidList = record { nil = []; _++_ = List._++_ }
+
+ rawMonoidMaybe : {A : Set} {{m : RawMonoid A}} -> RawMonoid (Maybe A)
+ rawMonoidMaybe {A} = record { nil = nothing ; _++_ = catMaybe }
+ where
+ catMaybe : Maybe A -> Maybe A -> Maybe A
+ catMaybe nothing mb = mb
+ catMaybe ma nothing = ma
+ catMaybe (just a) (just b) = just (a ++ b)
+
+ Moreover, each type of an instance must end in (something that reduces
+ to) a named type (e.g. a record, a datatype or a postulate). This
+ allows us to build a simple index structure
+
+ data/record name --> possible instances
+
+ that speeds up instance search.
+
+ Instance search takes into account all local bindings and all global
+ 'instance' bindings and the search is recursive. For instance,
+ searching for
+
+ ? : RawMonoid (Maybe (List A))
+
+ will consider the candidates {rawMonoidList, rawMonoidMaybe}, fail to
+ unify the first one, succeeding with the second one
+
+ ? = rawMonoidMaybe {A = List A} {{m = ?m}} : RawMonoid (Maybe (List A))
+
+ and continue with goal
+
+ ?m : RawMonoid (List A)
+
+ This will then find
+
+ ?m = rawMonoidList {A = A}
+
+ and putting together we have the solution.
+
+ Be careful that there is no termination check for now, you can easily
+ make Agda loop by declaring the identity function as an instance. But
+ it shouldn’t be possible to make Agda loop by only declaring
+ structurally recursive instances (whatever that means).
+
+ Additionally:
+
+ * Uniqueness of instances is up to definitional equality (see issue 899).
+
+ * Instances of the following form are allowed:
+
+ EqSigma : {A : Set} {B : A → Set} {{EqA : Eq A}}
+ {{EqB : {a : A} → Eq (B a)}}
+ → Eq (Σ A B)
+
+ When searching recursively for an instance of type
+ `{a : A} → Eq (B a)', a lambda will automatically be introduced and
+ instance search will search for something of type `Eq (B a)' in
+ the context extended by `a : A'. When searching for an instance, the
+ `a' argument does not have to be implicit, but in the definition of
+ EqSigma, instance search will only be able to use EqB if `a' is implicit.
+
+ * There is no longer any attempt to solve irrelevant metas by instance
+ search.
+
+ * Constructors of records and datatypes are automatically added to the
+ instance table.
+
+* You can now use 'quote' in patterns.
+
+ For instance, here is a function that unquotes a (closed) natural number
+ term.
+
+ unquoteNat : Term → Maybe Nat
+ unquoteNat (con (quote Nat.zero) []) = just zero
+ unquoteNat (con (quote Nat.suc) (arg _ n ∷ [])) = fmap suc (unquoteNat n)
+ unquoteNat _ = nothing
+
+* The builtin constructors AGDATERMUNSUPPORTED and AGDASORTUNSUPPORTED are now
+ translated to meta variables when unquoting.
+
+* New syntactic sugar 'tactic e' and 'tactic e | e1 | .. | en'.
+
+ It desugars as follows and makes it less unwieldy to call reflection-based
+ tactics.
+
+ tactic e --> quoteGoal g in unquote (e g)
+ tactic e | e1 | .. | en --> quoteGoal g in unquote (e g) e1 .. en
+
+ Note that in the second form the tactic function should generate a function
+ from a number of new subgoals to the original goal. The type of e should be
+ Term -> Term in both cases.
+
+* New reflection builtins for literals.
+
+ The Term data type AGDATERM now needs an additional constructor AGDATERMLIT
+ taking a reflected literal defined as follows (with appropriate builtin
+ bindings for the types Nat, Float, etc).
+
+ data Literal : Set where
+ nat : Nat → Literal
+ float : Float → Literal
+ char : Char → Literal
+ string : String → Literal
+ qname : QName → Literal
+
+ {-# BUILTIN AGDALITERAL Literal #-}
+ {-# BUILTIN AGDALITNAT nat #-}
+ {-# BUILTIN AGDALITFLOAT float #-}
+ {-# BUILTIN AGDALITCHAR char #-}
+ {-# BUILTIN AGDALITSTRING string #-}
+ {-# BUILTIN AGDALITQNAME qname #-}
+
+ When quoting (quoteGoal or quoteTerm) literals will be mapped to the
+ AGDATERMLIT constructor. Previously natural number literals were quoted
+ to suc/zero application and other literals were quoted to
+ AGDATERMUNSUPPORTED.
+
+* New reflection builtins for function definitions.
+
+ AGDAFUNDEF should now map to a data type defined as follows
+ (with {-# BUILTIN QNAME QName #-}
+ {-# BUILTIN ARG Arg #-}
+ {-# BUILTIN AGDATERM Term #-}
+ {-# BUILTIN AGDATYPE Type #-}
+ {-# BUILTIN AGDALITERAL Literal #-}).
+
+ data Pattern : Set where
+ con : QName → List (Arg Pattern) → Pattern
+ dot : Pattern
+ var : Pattern
+ lit : Literal → Pattern
+ proj : QName → Pattern
+ absurd : Pattern
+
+ {-# BUILTIN AGDAPATTERN Pattern #-}
+ {-# BUILTIN AGDAPATCON con #-}
+ {-# BUILTIN AGDAPATDOT dot #-}
+ {-# BUILTIN AGDAPATVAR var #-}
+ {-# BUILTIN AGDAPATLIT lit #-}
+ {-# BUILTIN AGDAPATPROJ proj #-}
+ {-# BUILTIN AGDAPATABSURD absurd #-}
+
+ data Clause : Set where
+ clause : List (Arg Pattern) → Term → Clause
+ absurd-clause : List (Arg Pattern) → Clause
+
+ {-# BUILTIN AGDACLAUSE Clause #-}
+ {-# BUILTIN AGDACLAUSECLAUSE clause #-}
+ {-# BUILTIN AGDACLAUSEABSURD absurd-clause #-}
+
+ data FunDef : Set where
+ fun-def : Type → List Clause → FunDef
+
+ {-# BUILTIN AGDAFUNDEF FunDef #-}
+ {-# BUILTIN AGDAFUNDEFCON fun-def #-}
+
+* New reflection builtins for extended (pattern-matching) lambda.
+
+ The AGDATERM data type has been augmented with a constructor
+
+ AGDATERMEXTLAM : List AGDACLAUSE → List (ARG AGDATERM) → AGDATERM
+
+ Absurd lambdas (λ ()) are quoted to extended lambdas with an absurd clause.
+
+* Unquoting declarations.
+
+ You can now define (recursive) functions by reflection using the new
+ unquoteDecl declaration
+
+ unquoteDecl x = e
+
+ Here e should have type AGDAFUNDEF and evaluate to a closed value. This value
+ is then spliced in as the definition of x. In the body e, x has type QNAME
+ which lets you splice in recursive definitions.
+
+ Standard modifiers, such as fixity declarations, can be applied to x as
+ expected.
+
+* Quoted levels
+
+ Universe levels are now quoted properly instead of being quoted to
+ AGDASORTUNSUPPORTED. Setω still gets an unsupported sort, however.
+
+* Module applicants can now be operator applications. Example:
+
+ postulate
+ [_] : A -> B
+
+ module M (b : B) where
+
+ module N (a : A) = M [ a ]
+
+ [See Issue 1245.]
+
+* Minor change in module application semantics. [Issue 892]
+
+ Previously re-exported functions were not redefined when instantiating a
+ module. For instance
+
+ module A where f = ...
+ module B (X : Set) where
+ open A public
+ module C = B Nat
+
+ In this example C.f would be an alias for A.f, so if both A and C were opened
+ f would not be ambiguous. However, this behaviour is not correct when A and B
+ share some module parameters (issue 892). To fix this C now defines its own
+ copy of f (which evaluates to A.f), which means that opening A and C results
+ in an ambiguous f.
+
+Type checking
+=============
+
+* Recursive records need to be declared as either inductive or coinductive.
+ 'inductive' is no longer default for recursive records.
+ Examples:
+
+ record _×_ (A B : Set) : Set where
+ constructor _,_
+ field
+ fst : A
+ snd : B
+
+ record Tree (A : Set) : Set where
+ inductive
+ constructor tree
+ field
+ elem : A
+ subtrees : List (Tree A)
+
+ record Stream (A : Set) : Set where
+ coinductive
+ constructor _::_
+ field
+ head : A
+ tail : Stream A
+
+ If you are using old-style (musical) coinduction, a record may have
+ to be declared as inductive, paradoxically.
+
+ record Stream (A : Set) : Set where
+ inductive -- YES, THIS IS INTENDED !
+ constructor _∷_
+ field
+ head : A
+ tail : ∞ (Stream A)
+
+ This is because the ``coinduction'' happens in the use of `∞' and not
+ in the use of `record'.
+
+Tools
+=====
+
+Emacs mode
+----------
+
+* A new menu option "Display" can be used to display the version of
+ the running Agda process.
+
+LaTeX-backend
+-------------
+
+* New experimental option ``references'' has been added. When specified,
+ i.e.:
+
+ \usepackage[references]{agda}
+
+ a new command called \AgdaRef is provided, which lets you reference
+ previously typeset commands, e.g.:
+
+ Let us postulate \AgdaRef{apa}.
+
+ \begin{code}
+ postulate
+ apa : Set
+ \end{code}
+
+ Above ``apa'' will be typeset (highlighted) the same in the text as in
+ the code, provided that the LaTeX output is post-processed using
+ src/data/postprocess-latex.pl, e.g.:
+
+ cp $(dirname $(dirname $(agda-mode locate)))/postprocess-latex.pl .
+ agda -i. --latex Example.lagda
+ cd latex/
+ perl ../postprocess-latex.pl Example.tex > Example.processed
+ mv Example.processed Example.tex
+ xelatex Example.tex
+
+ Mix-fix and unicode should work as expected (unicode requires
+ XeLaTeX/LuaLaTeX), but there are limitations:
+
+ + Overloading identifiers should be avoided, if multiples exist
+ \AgdaRef will typeset according to the first it finds.
+
+ + Only the current module is used, should you need to reference
+ identifiers in other modules then you need to specify which other
+ module manually, i.e. \AgdaRef[module]{identifier}.
+
+------------------------------------------------------------------------
-- Release notes for Agda 2 version 2.4.0.2
------------------------------------------------------------------------
@@ -87,9 +426,9 @@ Important changes since 2.4.0:
-- Release notes for Agda 2 version 2.4.0
------------------------------------------------------------------------
-Important changes since 2.3.2:
+Important changes since 2.3.2.2:
-Installation and Infrastructure
+Installation and infrastructure
===============================
* A new module called Agda.Primitive has been introduced. This module
@@ -148,8 +487,7 @@ Installation and Infrastructure
The location can also be set at run-time, using the Agda_datadir
environment variable.
-
-Pragmas and Options
+Pragmas and options
===================
* Pragma NO_TERMINATION_CHECK placed within a mutual block is now
@@ -185,8 +523,6 @@ Pragmas and Options
--no-sized-types will turn off an extra (inexpensive) analysis on
data types used for subtyping of sized types.
-
-
Language
========
@@ -566,7 +902,6 @@ Goal and error display
Type checking
=============
-
* [ issue 376 ] Implemented expansion of bound record variables during meta assignment.
Now Agda can solve for metas X that are applied to projected variables, e.g.:
@@ -890,7 +1225,7 @@ Compiler backends
"C-c C-x C-c" as before.
* A new pragma COMPILED_EXPORT was added as part of the MAlonzo FFI.
- If we have an agda file containing the following:
+ If we have an Agda file containing the following:
module A.B where
@@ -1199,7 +1534,7 @@ Installation
Emacs Lisp files, then Emacs may continue using the old, compiled
files.
-Pragmas and Options
+Pragmas and options
===================
* The --without-K check now reconstructs constructor parameters.
@@ -2245,7 +2580,6 @@ Meta-variables and unification
open Eq {{...}}
-
Instance argument resolution is not recursive. As an example,
consider the following "parametrised instance":
diff --git a/README b/README
deleted file mode 100644
index fc000a5..0000000
--- a/README
+++ /dev/null
@@ -1,319 +0,0 @@
-========================================================================
-Agda 2
-========================================================================
-
-Table of contents:
-
-* Installing Agda
-* Configuring the Emacs mode
-* Prerequisites
-* Installing the Epic backend's dependencies
-* Installing a suitable version of Emacs under Windows
-
-------------------------------------------------------------------------
-Installing Agda
-------------------------------------------------------------------------
-
- Note that this README only discusses installation of Agda, not its
- standard library. See the Agda Wiki for information about the
- library.
-
-There are several ways to install Agda:
-
-* Using a binary package, prepared for your platform.
-
- Recommended if such a package exists. See the Agda Wiki.
-
-* Using a released source package, available from Hackage.
-
- (Note that if you want to install the development version of Agda,
- then you should use the next method.)
-
- Install the prerequisites mentioned below, then run the following
- commands:
-
- cabal update
- cabal install Agda
- agda-mode setup
-
- The last command tries to set up Emacs for use with Agda. As an
- alternative you can copy the following text to your .emacs file:
-
- (load-file (let ((coding-system-for-read 'utf-8))
- (shell-command-to-string "agda-mode locate")))
-
- It is also possible (but not necessary) to compile the Emacs mode's
- files:
-
- agda-mode compile
-
- This can, in some cases, give a noticeable speedup.
-
- WARNING: If you reinstall the Agda mode without recompiling the Emacs
- Lisp files, then Emacs may continue using the old, compiled files.
-
-* Using the source tar balls available from the Agda Wiki, or the
- development version of the code available from our darcs repository.
-
- 1) Install the prerequisites mentioned below.
-
- 2a) Run the following commands in the top-level directory of the
- Agda source tree:
-
- cabal update
- cabal install
- agda-mode setup
-
- The last command tries to set up Emacs for use with Agda. As an
- alternative you can copy the following text to your .emacs file:
-
- (load-file (let ((coding-system-for-read 'utf-8))
- (shell-command-to-string "agda-mode locate")))
-
- If you want to have more control over where files are installed
- then you can give various flags to cabal install, see
- cabal install --help.
-
- It is also possible (but not necessary) to compile the Emacs
- mode's files:
-
- agda-mode compile
-
- This can, in some cases, give a noticeable speedup.
-
- WARNING: If you reinstall the Agda mode without recompiling the
- Emacs Lisp files, then Emacs may continue using the old,
- compiled files.
-
- 2b) Instead of following 2a you can try to install Agda (including a
- compiled Emacs mode) by running the following command:
-
- make install
-
-------------------------------------------------------------------------
-Configuring the Emacs mode
-------------------------------------------------------------------------
-
-If you want to you can customise the Emacs mode. Just start Emacs and
-type the following:
-
- M-x load-library RET agda2-mode RET
- M-x customize-group RET agda2 RET
-
-This is useful if you want to change the Agda search path, in which
-case you should change the agda2-include-dirs variable.
-
-If you want some specific settings for the Emacs mode you can add them
-to agda2-mode-hook. For instance, if you do not want to use the Agda
-input method (for writing various symbols like ∀≥ℕ→π⟦⟧) you can add
-the following to your .emacs:
-
-(add-hook 'agda2-mode-hook
- '(lambda ()
- ; If you do not want to use any input method:
- (deactivate-input-method)
- ; (In some versions of Emacs you should use
- ; inactivate-input-method instead of
- ; deactivate-input-method.)
-
- ; If you want to use the X input method:
- (set-input-method "X")
- ))
-
-Note that, on some systems, the Emacs mode changes the default font of
-the current frame in order to enable many Unicode symbols to be
-displayed. This only works if the right fonts are available, though.
-If you want to turn off this feature, then you should customise the
-agda2-fontset-name variable.
-
-------------------------------------------------------------------------
-Prerequisites
-------------------------------------------------------------------------
-
-You need recent versions of the following programs/libraries:
-
- GHC: http://www.haskell.org/ghc/
- cabal-install: http://www.haskell.org/cabal/
- Alex: http://www.haskell.org/alex/
- Happy: http://www.haskell.org/happy/
- GNU Emacs: http://www.gnu.org/software/emacs/
-
-You should also make sure that programs installed by cabal-install are
-on your shell's search path.
-
-For instructions on installing a suitable version of Emacs under
-Windows, see below.
-
-Non-Windows users need to ensure that the development files for the C
-libraries zlib and ncurses are installed (see http://zlib.net and
-http://www.gnu.org/software/ncurses/). Your package manager may be
-able to install these files for you. For instance, on Debian or Ubuntu
-it should suffice to run
-
- apt-get install zlib1g-dev libncurses5-dev
-
-as root to get the correct files installed.
-
-------------------------------------------------------------------------
-Installing the Epic backend's dependencies
-------------------------------------------------------------------------
-
-The Epic backend is experimental and requires that the Epic program is
-installed. You can install this program by giving the epic flag to
-cabal (but note that, at the time of writing, the Epic program does
-not build with certain recent versions of GHC):
-
-* When installing from Hackage:
-
- cabal update
- cabal install Agda -fepic
- agda-mode setup
-
-* When installing using a source tar ball, following the instructions
- in 2a) above:
-
- cabal update
- cabal install -fepic
- agda-mode setup
-
-* When installing using a source tar ball, following the instructions
- in 2b) above:
-
- make CABAL_OPTIONS=-fepic install
-
-You can also install Epic directly:
-
- cabal install epic
-
-Note that Epic depends on other software:
-
- The Boehm garbage collector:
- http://www.hpl.hp.com/personal/Hans_Boehm/gc/
- The GNU Multiple Precision Arithmetic Library:
- http://gmplib.org/
- GCC, the GNU Compiler Collection:
- http://gcc.gnu.org/
-
-For more information about Epic:
-
- http://www.cs.st-andrews.ac.uk/~eb/epic.php
-
-------------------------------------------------------------------------
-Installing a suitable version of Emacs under Windows
-------------------------------------------------------------------------
-
-Note that Agda code often uses mathematical and other symbols
-available from the Unicode character set. In order to be able to
-display these characters you may want to follow the procedure below
-when installing Emacs under Windows. (Note: These instructions are
-possibly outdated.)
-
-1. Install NTEmacs 22.
-
- Download from
- http://ntemacs.sourceforge.net/
- the self-extracting executable
- ntemacs22-bin-20070819.exe
-
- When executed, it asks where to extract itself. This can be
- anywhere you like, but here we write the top directory for ntemacs as
- c:/pkg/ntemacs
- in the following.
-
- What follows is tested only on this version. Other versions may
- work but you have to figure out yourself how to use Unicode fonts
- on your version.
-
-2. Install ucs-fonts and mule-fonts for emacs.
-
- Download from
- http://www.cl.cam.ac.uk/~mgk25/ucs-fonts.html
- the tar file
- http://www.cl.cam.ac.uk/~mgk25/download/ucs-fonts.tar.gz
- Let us write the top directory of extracted files as
- c:/pkg/ucs-fonts
- Next we create some derived fonts.
- cd c:/pkg/ucs-fonts/submission
- make all-bdfs
- This gives an error message about missing fonts, but ignore it.
-
- Download from
- http://www.meadowy.org/
- the tar file
- http://www.meadowy.org/meadow/dists/3.00/packages/mule-fonts-1.0-4-pkg.tar.bz2
- The untarred top directory is named "packages", but we are only
- interested in the subdirectory "packages/fonts". Let us assume
- we moved this subdirectory to
- c:/pkg/mule-fonts
-
- Add the following to your .emacs
-
-;;;;;;;;; start of quoted elisp code
-
-(setq bdf-directory-list
- '(
- "c:/pkg/ucs-fonts/submission"
- "c:/pkg/mule-fonts/intlfonts"
- "c:/pkg/mule-fonts/efonts"
- "c:/pkg/mule-fonts/bitmap"
- "c:/pkg/mule-fonts/CDAC"
- "c:/pkg/mule-fonts/AkrutiFreeFonts"
- ))
-
-(setq w32-bdf-filename-alist
- (w32-find-bdf-fonts bdf-directory-list))
-
-(create-fontset-from-fontset-spec
- "-*-fixed-Medium-r-Normal-*-15-*-*-*-c-*-fontset-bdf,
- ascii:-Misc-Fixed-Medium-R-Normal--15-140-75-75-C-90-ISO8859-1,
- latin-iso8859-2:-*-Fixed-*-r-*-*-15-*-*-*-c-*-iso8859-2,
- latin-iso8859-3:-*-Fixed-*-r-*-*-15-*-*-*-c-*-iso8859-3,
- latin-iso8859-4:-*-Fixed-*-r-*-*-15-*-*-*-c-*-iso8859-4,
- cyrillic-iso8859-5:-*-Fixed-*-r-*-*-15-*-*-*-c-*-iso8859-5,
- greek-iso8859-7:-*-Fixed-*-r-*-*-15-*-*-*-c-*-iso8859-7,
- latin-iso8859-9:-*-Fixed-*-r-*-*-15-*-*-*-c-*-iso8859-9,
- mule-unicode-0100-24ff:-Misc-Fixed-Medium-R-Normal--15-140-75-75-C-90-ISO10646-1,
- mule-unicode-2500-33ff:-Misc-Fixed-Medium-R-Normal--15-140-75-75-C-90-ISO10646-1,
- mule-unicode-e000-ffff:-Misc-Fixed-Medium-R-Normal--15-140-75-75-C-90-ISO10646-1,
- japanese-jisx0208:-JIS-Fixed-Medium-R-Normal--16-150-75-75-C-160-JISX0208.1983-0,
- japanese-jisx0208-1978:-Misc-Fixed-Medium-R-Normal--16-150-75-75-C-160-JISC6226.1978-0,
- japanese-jisx0212:-Misc-Fixed-Medium-R-Normal--16-150-75-75-C-160-JISX0212.1990-0,
- latin-jisx0201:-*-*-medium-r-normal-*-16-*-*-*-c-*-jisx0201*-*,
- katakana-jisx0201:-Sony-Fixed-Medium-R-Normal--16-120-100-100-C-80-JISX0201.1976-0,
- thai-tis620:-Misc-Fixed-Medium-R-Normal--24-240-72-72-C-120-TIS620.2529-1,
- lao:-Misc-Fixed-Medium-R-Normal--24-240-72-72-C-120-MuleLao-1,
- tibetan:-TibMdXA-fixed-medium-r-normal--16-160-72-72-m-160-MuleTibetan-0,
- tibetan-1-column:-TibMdXA-fixed-medium-r-normal--16-160-72-72-m-80-MuleTibetan-1,
- korean-ksc5601:-Daewoo-Mincho-Medium-R-Normal--16-120-100-100-C-160-KSC5601.1987-0,
- chinese-gb2312:-ISAS-Fangsong ti-Medium-R-Normal--16-160-72-72-c-160-GB2312.1980-0,
- chinese-cns11643-1:-HKU-Fixed-Medium-R-Normal--16-160-72-72-C-160-CNS11643.1992.1-0,
- chinese-big5-1:-ETen-Fixed-Medium-R-Normal--16-150-75-75-C-160-Big5.ETen-0,
- chinese-big5-2:-ETen-Fixed-Medium-R-Normal--16-150-75-75-C-160-Big5.ETen-0
- " t)
-
-(setq font-encoding-alist
- (append '(
- ("JISX0208" (japanese-jisx0208 . 0))
- ("JISX0212" (japanese-jisx0212 . 0))
- ("CNS11643.1992.1-0" (chinese-cns11643-1 . 0))
- ("GB2312" (chinese-gb2312 . 0))
- ("KSC5601" (korean-ksc5601 . 0))
- ("VISCII" (vietnamese-viscii-lower . 0))
- ("MuleArabic-0" (arabic-digit . 0))
- ("MuleArabic-1" (arabic-1-column . 0))
- ("MuleArabic-2" (arabic-2-column . 0))
- ("muleindian-1" (indian-1-column . 0))
- ("muleindian-2" (indian-2-column . 0))
- ("MuleTibetan-0" (tibetan . 0))
- ("MuleTibetan-1" (tibetan-1-column . 0))
- ) font-encoding-alist))
-
-;;;;;;; end of quoted elisp code
-
- To test the fonts, try
-
- M-x eval-expression RET
- (set-default-font "fontset-bdf") RET
- M-x view-hello-file
-
- You should see all the characters without white-boxes.
diff --git a/README.md b/README.md
new file mode 100644
index 0000000..7fd9d97
--- /dev/null
+++ b/README.md
@@ -0,0 +1,210 @@
+Agda 2
+======
+
+Table of contents:
+
+* [Prerequisites](#prerequisites)
+* [Installing Agda](#installing-agda)
+* [Configuring the Emacs mode](#configuring-the-emacs-mode)
+* [Installing the Epic backend's dependencies](#installing-the-epic-backends-dependencies)
+* [Installing Emacs under Windows](#installing-emacs-under-windows)
+
+Note that this README only discusses installation of Agda, not its standard
+library. See the [Agda Wiki][agdawiki] for information about the library.
+
+
+Prerequisites
+-------------
+
+You need recent versions of the following programs/libraries:
+
+* GHC: http://www.haskell.org/ghc/
+* cabal-install: http://www.haskell.org/cabal/
+* Alex: http://www.haskell.org/alex/
+* Happy: http://www.haskell.org/happy/
+* cpphs: http://projects.haskell.org/cpphs/
+* GNU Emacs: http://www.gnu.org/software/emacs/
+
+You should also make sure that programs installed by cabal-install are
+on your shell's search path.
+
+For instructions on installing a suitable version of Emacs under
+Windows, see [below]((#installing-emacs-under-windows).
+
+Non-Windows users need to ensure that the development files for the C
+libraries zlib and ncurses are installed (see http://zlib.net and
+http://www.gnu.org/software/ncurses/). Your package manager may be
+able to install these files for you. For instance, on Debian or Ubuntu
+it should suffice to run
+
+ apt-get install zlib1g-dev libncurses5-dev
+
+as root to get the correct files installed.
+
+### Note on ghc's CPP language extension
+
+Recent versions of Clang's preprocessor don't work well with Haskell.
+In order to get some dependencies to build, you may need to set up Cabal
+to have ghc use cpphs by default. You can do this by adding
+
+ program-default-options
+ ghc-options: -pgmPcpphs -optP--cpp
+
+to your .cabal/config file. (You must be using cabal >= 1.18. Note
+that some packages may not compile with this option set.)
+
+You don't need to set this option to install *Agda* from the current
+development source; Agda.cabal now uses cpphs.
+
+
+Installing Agda
+---------------
+
+There are several ways to install Agda:
+
+
+### Using a binary package prepared for your platform
+
+Recommended if such a package exists. See the [Agda Wiki][agdawiki].
+
+
+### Using a released source package from Hackage
+
+Install the prerequisites mentioned below, then run the following commands:
+
+ cabal update
+ cabal install Agda
+ agda-mode setup
+
+The last command tries to set up Emacs for use with Agda. As an alternative you
+can copy the following text to your .emacs file:
+
+ (load-file (let ((coding-system-for-read 'utf-8))
+ (shell-command-to-string "agda-mode locate")))
+
+It is also possible (but not necessary) to compile the Emacs mode's files:
+
+ agda-mode compile
+
+This can, in some cases, give a noticeable speedup.
+
+**WARNING**: If you reinstall the Agda mode without recompiling the Emacs
+Lisp files, then Emacs may continue using the old, compiled files.
+
+
+### Using the development version of the code
+
+You can obtain tarballs of the development version from the [Agda
+Wiki][agdawiki], or clone the repository.
+
+Install the prerequisites discussed in [Prerequisites](#prerequisites).
+
+Then, either:
+
+*(1a)* Run the following commands in the top-level directory of the Agda source
+tree to install Agda:
+
+ cabal update
+ cabal install
+
+*(1b)* Run `agda-mode setup` to set up Emacs for use with Agda. Alternatively,
+add the following text to your .emacs file:
+
+ (load-file (let ((coding-system-for-read 'utf-8))
+ (shell-command-to-string "agda-mode locate")))
+
+It is also possible (but not necessary) to compile the Emacs mode's files:
+
+ agda-mode compile
+
+This can, in some cases, give a noticeable speedup.
+
+**WARNING**: If you reinstall the Agda mode without recompiling the Emacs
+Lisp files, then Emacs may continue using the old compiled files.
+
+*(2)* Or, you can try to install Agda (including a compiled Emacs mode) by
+running the following command:
+
+ make install
+
+
+Configuring the Emacs mode
+--------------------------
+
+If you want to you can customise the Emacs mode. Just start Emacs and
+type the following:
+
+ M-x load-library RET agda2-mode RET
+ M-x customize-group RET agda2 RET
+
+This is useful if you want to change the Agda search path, in which
+case you should change the agda2-include-dirs variable.
+
+If you want some specific settings for the Emacs mode you can add them
+to agda2-mode-hook. For instance, if you do not want to use the Agda
+input method (for writing various symbols like ∀≥ℕ→π⟦⟧) you can add
+the following to your .emacs:
+
+ (add-hook 'agda2-mode-hook
+ '(lambda ()
+ ; If you do not want to use any input method:
+ (deactivate-input-method)
+ ; (In some versions of Emacs you should use
+ ; inactivate-input-method instead of
+ ; deactivate-input-method.)
+
+ ; If you want to use the X input method:
+ (set-input-method "X")))
+
+Note that, on some systems, the Emacs mode changes the default font of
+the current frame in order to enable many Unicode symbols to be
+displayed. This only works if the right fonts are available, though.
+If you want to turn off this feature, then you should customise the
+agda2-fontset-name variable.
+
+
+------------------------------------------------------------------------
+Installing the Epic backend's dependencies
+------------------------------------------------------------------------
+
+The Epic backend is experimental and requires that the Epic program is
+installed. You can install this program by giving the epic flag to
+cabal (but note that, at the time of writing, the Epic program does
+not build with certain recent versions of GHC):
+
+### Installing from Hackage:
+
+ cabal update
+ cabal install Agda -fepic
+ agda-mode setup
+
+### Installing from development sources using cabal
+
+ cabal update
+ cabal install -fepic
+ agda-mode setup
+
+### Installing from development sources using make
+
+ make CABAL_OPTIONS=-fepic install
+
+You can also install Epic directly:
+
+ cabal install epic
+
+Note that Epic depends on other software:
+
+* The Boehm garbage collector: http://www.hpl.hp.com/personal/Hans_Boehm/gc/
+* The GNU Multiple Precision Arithmetic Library: http://gmplib.org/
+* GCC, the GNU Compiler Collection: http://gcc.gnu.org/
+
+For more information about Epic: http://www.cs.st-andrews.ac.uk/~eb/epic.php
+
+------------------------------------------------------------------------
+Installing Emacs under Windows
+------------------------------------------------------------------------
+
+A precompiled version of Emacs 24.3, with the necessary mathematical
+fonts, is available at http://homepage.cs.uiowa.edu/~astump/agda/
+
+[agdawiki]: http://wiki.portal.chalmers.se/agda/pmwiki.php
diff --git a/dist/build/Agda/Syntax/Parser/Lexer.hs b/dist/build/Agda/Syntax/Parser/Lexer.hs
index ca17827..a5ad87d 100644
--- a/dist/build/Agda/Syntax/Parser/Lexer.hs
+++ b/dist/build/Agda/Syntax/Parser/Lexer.hs
@@ -51,19 +51,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\xc3\x00\x54\x00\x54\x00\x54\x00\x53\x00\xb6\x00\x08\x00\x27\x00\x1e\x00\x1f\x00\x22\x00\x20\x00\x13\x00\x43\x00\x56\x00\xf0\x00\xf1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x54\x00\x69\x01\x02\x01\x69\x01\x69\x01\x69\x01\x69\x01\x01\x01\xf9\x00\xfa\x00\x69\x01\x69\x01\x69\x01\x14\x01\xf2\x00\x69\x01\x07\x01\x06\x01\x06\x01\x06\x01\x06\x01\x06\x01\x06\x01\x06\x01\x06\x01\x06\x01\xf4\x00\xf3\x00\x69\x01\xf5\x00\x69\x01\xf7\x00\xfd\x00\x69\x01\x69\x01\x69\x0 [...]
+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_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\x95\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\xbc\x00\xbc\x00\xbc\x00\x95\x00\x95\x00\x95\x0 [...]
+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_accept = listArray (0::Int,443) [AlexAccNone,AlexAccPred (alex_action_33) ( not' eof )(AlexAccNone),AlexAccNone,AlexAcc (alex_action_36),AlexAccNone,AlexAcc (alex_action_35),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 222 "src/full/Agda/Syntax/Parser/Lexer.x" #-}
+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" #-}
-- | This is the initial state for parsing a literate file. Code blocks
@@ -156,92 +156,97 @@ alex_action_9 = symbol SymOpenPragma
alex_action_10 = endWith $ symbol SymClosePragma
alex_action_11 = keyword KwOPTIONS
alex_action_12 = keyword KwBUILTIN
-alex_action_13 = keyword KwCOMPILED_DATA
-alex_action_14 = keyword KwCOMPILED_TYPE
-alex_action_15 = keyword KwCOMPILED
-alex_action_16 = keyword KwCOMPILED_EXPORT
-alex_action_17 = keyword KwCOMPILED_EPIC
-alex_action_18 = keyword KwCOMPILED_JS
-alex_action_19 = keyword KwSTATIC
-alex_action_20 = keyword KwIMPORT
-alex_action_21 = keyword KwIMPOSSIBLE
-alex_action_22 = keyword KwETA
-alex_action_23 = keyword KwNO_TERMINATION_CHECK
-alex_action_24 = keyword KwLINE
-alex_action_25 = withInterval $ TokString
-alex_action_26 = nestedComment
-alex_action_27 = symbol SymEndComment
-alex_action_28 = symbol SymEndComment
-alex_action_29 = withInterval TokComment
-alex_action_31 = begin bol_
-alex_action_33 = offsideRule
-alex_action_35 = endWith newLayoutContext
-alex_action_36 = emptyLayout
-alex_action_37 = keyword KwLet
-alex_action_38 = keyword KwIn
-alex_action_39 = keyword KwWhere
-alex_action_40 = keyword KwField
-alex_action_41 = keyword KwWith
-alex_action_42 = keyword KwRewrite
-alex_action_43 = keyword KwPostulate
-alex_action_44 = keyword KwPrimitive
-alex_action_45 = keyword KwOpen
-alex_action_46 = keyword KwImport
-alex_action_47 = keyword KwModule
-alex_action_48 = keyword KwData
-alex_action_49 = keyword KwCoData
-alex_action_50 = keyword KwRecord
-alex_action_51 = keyword KwConstructor
-alex_action_52 = keyword KwInductive
-alex_action_53 = keyword KwCoInductive
-alex_action_54 = keyword KwInfix
-alex_action_55 = keyword KwInfixL
-alex_action_56 = keyword KwInfixR
-alex_action_57 = keyword KwMutual
-alex_action_58 = keyword KwAbstract
-alex_action_59 = keyword KwPrivate
-alex_action_60 = keyword KwSet
-alex_action_61 = keyword KwProp
-alex_action_62 = keyword KwForall
-alex_action_63 = withInterval' (read . drop 3) TokSetN
-alex_action_64 = keyword KwQuoteGoal
-alex_action_65 = keyword KwQuoteContext
-alex_action_66 = keyword KwQuote
-alex_action_67 = keyword KwQuoteTerm
-alex_action_68 = keyword KwUnquote
-alex_action_69 = keyword KwSyntax
-alex_action_70 = keyword KwPatternSyn
-alex_action_71 = keyword KwUsing
-alex_action_72 = keyword KwHiding
-alex_action_73 = keyword KwRenaming
-alex_action_74 = endWith $ keyword KwTo
-alex_action_75 = keyword KwPublic
-alex_action_76 = hole
-alex_action_77 = symbol SymEllipsis
-alex_action_78 = symbol SymDotDot
-alex_action_79 = symbol SymDot
-alex_action_80 = symbol SymSemi
-alex_action_81 = symbol SymColon
-alex_action_82 = symbol SymEqual
-alex_action_83 = symbol SymUnderscore
-alex_action_84 = symbol SymQuestionMark
-alex_action_85 = symbol SymBar
-alex_action_86 = symbol SymOpenParen
-alex_action_87 = symbol SymCloseParen
-alex_action_88 = symbol SymArrow
-alex_action_89 = symbol SymLambda
-alex_action_90 = symbol SymAs
-alex_action_91 = symbol SymDoubleOpenBrace
-alex_action_92 = symbol SymOpenBrace
-alex_action_93 = symbol SymCloseBrace
-alex_action_94 = litChar
-alex_action_95 = litString
-alex_action_96 = literal LitInt
-alex_action_97 = literal LitFloat
-alex_action_98 = identifier
+alex_action_13 = keyword KwREWRITE
+alex_action_14 = keyword KwCOMPILED_DATA
+alex_action_15 = keyword KwCOMPILED_TYPE
+alex_action_16 = keyword KwCOMPILED
+alex_action_17 = keyword KwCOMPILED_EXPORT
+alex_action_18 = keyword KwCOMPILED_EPIC
+alex_action_19 = keyword KwCOMPILED_JS
+alex_action_20 = keyword KwSTATIC
+alex_action_21 = keyword KwIMPORT
+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_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
{-# 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 438009c..5cca40d 100644
--- a/dist/build/Agda/Syntax/Parser/Parser.hs
+++ b/dist/build/Agda/Syntax/Parser/Parser.hs
@@ -48,843 +48,862 @@ import Agda.Utils.TestHelpers
import Agda.Utils.Tuple
import qualified Data.Array as Happy_Data_Array
import qualified GHC.Exts as Happy_GHC_Exts
+import Control.Applicative(Applicative(..))
--- parser produced by Happy Version 1.19.3
+-- parser produced by Happy Version 1.19.4
-newtype HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71 = HappyAbsSyn HappyAny
+newtype HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72 = HappyAbsSyn HappyAny
#if __GLASGOW_HASKELL__ >= 607
type HappyAny = Happy_GHC_Exts.Any
#else
type HappyAny = forall a . a
#endif
-happyIn6 :: ([Token]) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn6 :: ([Token]) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn6 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn6 #-}
-happyOut6 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> ([Token])
+happyOut6 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> ([Token])
happyOut6 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut6 #-}
-happyIn7 :: ([Token]) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn7 :: ([Token]) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn7 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn7 #-}
-happyOut7 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> ([Token])
+happyOut7 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> ([Token])
happyOut7 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut7 #-}
-happyIn8 :: (Token) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn8 :: (Token) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn8 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn8 #-}
-happyOut8 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> (Token)
+happyOut8 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> (Token)
happyOut8 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut8 #-}
-happyIn9 :: (([Pragma], [Declaration])) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn9 :: (([Pragma], [Declaration])) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn9 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn9 #-}
-happyOut9 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> (([Pragma], [Declaration]))
+happyOut9 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> (([Pragma], [Declaration]))
happyOut9 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut9 #-}
-happyIn10 :: t10 -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn10 :: t10 -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn10 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn10 #-}
-happyOut10 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> t10
+happyOut10 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> t10
happyOut10 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut10 #-}
-happyIn11 :: t11 -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn11 :: t11 -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn11 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn11 #-}
-happyOut11 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> t11
+happyOut11 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> t11
happyOut11 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut11 #-}
-happyIn12 :: t12 -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn12 :: t12 -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn12 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn12 #-}
-happyOut12 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> t12
+happyOut12 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> t12
happyOut12 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut12 #-}
-happyIn13 :: (()) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn13 :: (()) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn13 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn13 #-}
-happyOut13 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> (())
+happyOut13 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> (())
happyOut13 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut13 #-}
-happyIn14 :: (Integer) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn14 :: (Integer) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn14 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn14 #-}
-happyOut14 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> (Integer)
+happyOut14 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> (Integer)
happyOut14 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut14 #-}
-happyIn15 :: (Name) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn15 :: (Name) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn15 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn15 #-}
-happyOut15 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> (Name)
+happyOut15 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> (Name)
happyOut15 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut15 #-}
-happyIn16 :: ([Name]) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn16 :: ([Name]) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn16 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn16 #-}
-happyOut16 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> ([Name])
+happyOut16 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> ([Name])
happyOut16 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut16 #-}
-happyIn17 :: (Range) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn17 :: (Range) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn17 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn17 #-}
-happyOut17 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> (Range)
+happyOut17 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> (Range)
happyOut17 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut17 #-}
-happyIn18 :: (Arg Name) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn18 :: (Arg Name) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn18 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn18 #-}
-happyOut18 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> (Arg Name)
+happyOut18 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> (Arg Name)
happyOut18 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut18 #-}
-happyIn19 :: ([Arg Name]) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn19 :: ([Arg Name]) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn19 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn19 #-}
-happyOut19 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> ([Arg Name])
+happyOut19 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> ([Arg Name])
happyOut19 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut19 #-}
-happyIn20 :: ([Arg Name]) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn20 :: ([Arg Name]) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn20 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn20 #-}
-happyOut20 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> ([Arg Name])
+happyOut20 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> ([Arg Name])
happyOut20 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut20 #-}
-happyIn21 :: (QName) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn21 :: (QName) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn21 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn21 #-}
-happyOut21 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> (QName)
+happyOut21 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> (QName)
happyOut21 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut21 #-}
-happyIn22 :: (QName) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn22 :: (QName) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn22 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn22 #-}
-happyOut22 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> (QName)
+happyOut22 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> (QName)
happyOut22 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut22 #-}
-happyIn23 :: (Name) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn23 :: (Name) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn23 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn23 #-}
-happyOut23 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> (Name)
+happyOut23 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> (Name)
happyOut23 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut23 #-}
-happyIn24 :: ([Name]) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn24 :: ([Name]) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn24 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn24 #-}
-happyOut24 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> ([Name])
+happyOut24 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> ([Name])
happyOut24 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut24 #-}
-happyIn25 :: ([Name]) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn25 :: ([Name]) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn25 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn25 #-}
-happyOut25 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> ([Name])
+happyOut25 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> ([Name])
happyOut25 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut25 #-}
-happyIn26 :: (Either [Name] [Expr]) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn26 :: (Either [Name] [Expr]) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn26 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn26 #-}
-happyOut26 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> (Either [Name] [Expr])
+happyOut26 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> (Either [Name] [Expr])
happyOut26 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut26 #-}
-happyIn27 :: ([String]) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn27 :: ([String]) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn27 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn27 #-}
-happyOut27 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> ([String])
+happyOut27 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> ([String])
happyOut27 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut27 #-}
-happyIn28 :: (String) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn28 :: (String) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn28 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn28 #-}
-happyOut28 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> (String)
+happyOut28 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> (String)
happyOut28 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut28 #-}
-happyIn29 :: (QName) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn29 :: (Name) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn29 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn29 #-}
-happyOut29 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> (QName)
+happyOut29 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> (Name)
happyOut29 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut29 #-}
-happyIn30 :: (Expr) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn30 :: (QName) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn30 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn30 #-}
-happyOut30 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> (Expr)
+happyOut30 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> (QName)
happyOut30 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut30 #-}
-happyIn31 :: t31 -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn31 :: (Expr) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn31 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn31 #-}
-happyOut31 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> t31
+happyOut31 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> (Expr)
happyOut31 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut31 #-}
-happyIn32 :: ([Expr]) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn32 :: t32 -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn32 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn32 #-}
-happyOut32 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> ([Expr])
+happyOut32 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> t32
happyOut32 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut32 #-}
-happyIn33 :: ([Expr]) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn33 :: ([Expr]) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn33 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn33 #-}
-happyOut33 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> ([Expr])
+happyOut33 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> ([Expr])
happyOut33 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut33 #-}
-happyIn34 :: t34 -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn34 :: ([Expr]) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn34 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn34 #-}
-happyOut34 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> t34
+happyOut34 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> ([Expr])
happyOut34 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut34 #-}
-happyIn35 :: (Expr) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn35 :: t35 -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn35 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn35 #-}
-happyOut35 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> (Expr)
+happyOut35 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> t35
happyOut35 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut35 #-}
-happyIn36 :: ([Expr]) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn36 :: (Expr) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn36 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn36 #-}
-happyOut36 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> ([Expr])
+happyOut36 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> (Expr)
happyOut36 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut36 #-}
-happyIn37 :: t37 -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn37 :: ([Expr]) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn37 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn37 #-}
-happyOut37 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> t37
+happyOut37 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> ([Expr])
happyOut37 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut37 #-}
-happyIn38 :: t38 -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn38 :: t38 -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn38 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn38 #-}
-happyOut38 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> t38
+happyOut38 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> t38
happyOut38 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut38 #-}
-happyIn39 :: t39 -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn39 :: t39 -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn39 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn39 #-}
-happyOut39 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> t39
+happyOut39 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> t39
happyOut39 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut39 #-}
-happyIn40 :: ([(Name, Expr)]) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn40 :: t40 -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn40 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn40 #-}
-happyOut40 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> ([(Name, Expr)])
+happyOut40 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> t40
happyOut40 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut40 #-}
-happyIn41 :: ([(Name, Expr)]) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn41 :: ([(Name, Expr)]) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn41 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn41 #-}
-happyOut41 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> ([(Name, Expr)])
+happyOut41 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> ([(Name, Expr)])
happyOut41 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut41 #-}
-happyIn42 :: ((Name, Expr)) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn42 :: ([(Name, Expr)]) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn42 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn42 #-}
-happyOut42 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> ((Name, Expr))
+happyOut42 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> ([(Name, Expr)])
happyOut42 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut42 #-}
-happyIn43 :: t43 -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn43 :: ((Name, Expr)) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn43 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn43 #-}
-happyOut43 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> t43
+happyOut43 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> ((Name, Expr))
happyOut43 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut43 #-}
-happyIn44 :: t44 -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn44 :: t44 -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn44 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn44 #-}
-happyOut44 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> t44
+happyOut44 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> t44
happyOut44 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut44 #-}
-happyIn45 :: ([TypedBindings]) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn45 :: t45 -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn45 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn45 #-}
-happyOut45 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> ([TypedBindings])
+happyOut45 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> t45
happyOut45 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut45 #-}
-happyIn46 :: (TypedBindings) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn46 :: ([TypedBindings]) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn46 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn46 #-}
-happyOut46 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> (TypedBindings)
+happyOut46 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> ([TypedBindings])
happyOut46 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut46 #-}
-happyIn47 :: (( [Color], TypedBinding )) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn47 :: (TypedBindings) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn47 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn47 #-}
-happyOut47 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> (( [Color], TypedBinding ))
+happyOut47 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> (TypedBindings)
happyOut47 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut47 #-}
-happyIn48 :: ([LamBinding]) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn48 :: (( [Color], TypedBinding )) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn48 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn48 #-}
-happyOut48 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> ([LamBinding])
+happyOut48 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> (( [Color], TypedBinding ))
happyOut48 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut48 #-}
-happyIn49 :: (Either ([LamBinding], Hiding) [Expr]) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn49 :: ([LamBinding]) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn49 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn49 #-}
-happyOut49 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> (Either ([LamBinding], Hiding) [Expr])
+happyOut49 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> ([LamBinding])
happyOut49 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut49 #-}
-happyIn50 :: ([Either Hiding LamBinding]) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn50 :: (Either ([LamBinding], Hiding) [Expr]) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn50 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn50 #-}
-happyOut50 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> ([Either Hiding LamBinding])
+happyOut50 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> (Either ([LamBinding], Hiding) [Expr])
happyOut50 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut50 #-}
-happyIn51 :: (Either [Either Hiding LamBinding] [Expr]) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn51 :: ([Either Hiding LamBinding]) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn51 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn51 #-}
-happyOut51 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> (Either [Either Hiding LamBinding] [Expr])
+happyOut51 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> ([Either Hiding LamBinding])
happyOut51 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut51 #-}
-happyIn52 :: ((LHS,RHS,WhereClause)) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn52 :: (Either [Either Hiding LamBinding] [Expr]) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn52 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn52 #-}
-happyOut52 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> ((LHS,RHS,WhereClause))
+happyOut52 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> (Either [Either Hiding LamBinding] [Expr])
happyOut52 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut52 #-}
-happyIn53 :: ((LHS,RHS,WhereClause)) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn53 :: ((LHS,RHS,WhereClause)) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn53 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn53 #-}
-happyOut53 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> ((LHS,RHS,WhereClause))
+happyOut53 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> ((LHS,RHS,WhereClause))
happyOut53 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut53 #-}
-happyIn54 :: ((LHS,RHS,WhereClause)) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn54 :: ((LHS,RHS,WhereClause)) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn54 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn54 #-}
-happyOut54 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> ((LHS,RHS,WhereClause))
+happyOut54 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> ((LHS,RHS,WhereClause))
happyOut54 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut54 #-}
-happyIn55 :: ([(LHS,RHS,WhereClause)]) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn55 :: ((LHS,RHS,WhereClause)) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn55 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn55 #-}
-happyOut55 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> ([(LHS,RHS,WhereClause)])
+happyOut55 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> ((LHS,RHS,WhereClause))
happyOut55 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut55 #-}
-happyIn56 :: ([LamBinding]) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn56 :: ([(LHS,RHS,WhereClause)]) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn56 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn56 #-}
-happyOut56 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> ([LamBinding])
+happyOut56 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> ([(LHS,RHS,WhereClause)])
happyOut56 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut56 #-}
-happyIn57 :: ([LamBinding]) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn57 :: ([LamBinding]) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn57 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn57 #-}
-happyOut57 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> ([LamBinding])
+happyOut57 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> ([LamBinding])
happyOut57 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut57 #-}
-happyIn58 :: ([LamBinding]) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn58 :: ([LamBinding]) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn58 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn58 #-}
-happyOut58 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> ([LamBinding])
+happyOut58 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> ([LamBinding])
happyOut58 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut58 #-}
-happyIn59 :: ([LamBinding]) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn59 :: ([LamBinding]) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn59 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn59 #-}
-happyOut59 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> ([LamBinding])
+happyOut59 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> ([LamBinding])
happyOut59 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut59 #-}
-happyIn60 :: (Either [LamBinding] [Expr]) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn60 :: ([LamBinding]) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn60 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn60 #-}
-happyOut60 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> (Either [LamBinding] [Expr])
+happyOut60 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> ([LamBinding])
happyOut60 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut60 #-}
-happyIn61 :: (ImportDirective) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn61 :: (Either [LamBinding] [Expr]) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn61 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn61 #-}
-happyOut61 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> (ImportDirective)
+happyOut61 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> (Either [LamBinding] [Expr])
happyOut61 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut61 #-}
-happyIn62 :: ([ImportDirective]) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn62 :: (ImportDirective) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn62 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn62 #-}
-happyOut62 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> ([ImportDirective])
+happyOut62 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> (ImportDirective)
happyOut62 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut62 #-}
-happyIn63 :: (ImportDirective) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn63 :: ([ImportDirective]) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn63 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn63 #-}
-happyOut63 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> (ImportDirective)
+happyOut63 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> ([ImportDirective])
happyOut63 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut63 #-}
-happyIn64 :: ((UsingOrHiding , Range)) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn64 :: (ImportDirective) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn64 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn64 #-}
-happyOut64 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> ((UsingOrHiding , Range))
+happyOut64 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> (ImportDirective)
happyOut64 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut64 #-}
-happyIn65 :: (([Renaming] , Range)) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn65 :: ((UsingOrHiding , Range)) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn65 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn65 #-}
-happyOut65 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> (([Renaming] , Range))
+happyOut65 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> ((UsingOrHiding , Range))
happyOut65 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut65 #-}
-happyIn66 :: ([Renaming]) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn66 :: (([Renaming] , Range)) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn66 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn66 #-}
-happyOut66 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> ([Renaming])
+happyOut66 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> (([Renaming] , Range))
happyOut66 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut66 #-}
-happyIn67 :: (Renaming) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn67 :: ([Renaming]) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn67 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn67 #-}
-happyOut67 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> (Renaming)
+happyOut67 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> ([Renaming])
happyOut67 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut67 #-}
-happyIn68 :: (ImportedName) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn68 :: (Renaming) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn68 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn68 #-}
-happyOut68 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> (ImportedName)
+happyOut68 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> (Renaming)
happyOut68 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut68 #-}
-happyIn69 :: (ImportedName) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn69 :: (ImportedName) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn69 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn69 #-}
-happyOut69 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> (ImportedName)
+happyOut69 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> (ImportedName)
happyOut69 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut69 #-}
-happyIn70 :: ([ImportedName]) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn70 :: (ImportedName) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn70 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn70 #-}
-happyOut70 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> ([ImportedName])
+happyOut70 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> (ImportedName)
happyOut70 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut70 #-}
-happyIn71 :: t71 -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn71 :: ([ImportedName]) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn71 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn71 #-}
-happyOut71 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> t71
+happyOut71 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> ([ImportedName])
happyOut71 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut71 #-}
-happyIn72 :: (LHS) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn72 :: t72 -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn72 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn72 #-}
-happyOut72 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> (LHS)
+happyOut72 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> t72
happyOut72 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut72 #-}
-happyIn73 :: ([Pattern]) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn73 :: (LHS) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn73 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn73 #-}
-happyOut73 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> ([Pattern])
+happyOut73 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> (LHS)
happyOut73 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut73 #-}
-happyIn74 :: ([Expr]) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn74 :: ([Pattern]) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn74 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn74 #-}
-happyOut74 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> ([Expr])
+happyOut74 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> ([Pattern])
happyOut74 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut74 #-}
-happyIn75 :: ([Expr]) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn75 :: ([Expr]) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn75 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn75 #-}
-happyOut75 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> ([Expr])
+happyOut75 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> ([Expr])
happyOut75 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut75 #-}
-happyIn76 :: (WhereClause) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn76 :: ([Expr]) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn76 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn76 #-}
-happyOut76 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> (WhereClause)
+happyOut76 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> ([Expr])
happyOut76 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut76 #-}
-happyIn77 :: ([Declaration]) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn77 :: (WhereClause) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn77 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn77 #-}
-happyOut77 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> ([Declaration])
+happyOut77 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> (WhereClause)
happyOut77 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut77 #-}
-happyIn78 :: ([Declaration]) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn78 :: ([Declaration]) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn78 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn78 #-}
-happyOut78 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> ([Declaration])
+happyOut78 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> ([Declaration])
happyOut78 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut78 #-}
-happyIn79 :: ([Declaration]) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn79 :: ([Declaration]) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn79 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn79 #-}
-happyOut79 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> ([Declaration])
+happyOut79 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> ([Declaration])
happyOut79 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut79 #-}
-happyIn80 :: ([Arg Declaration]) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn80 :: ([Arg Declaration]) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn80 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn80 #-}
-happyOut80 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> ([Arg Declaration])
+happyOut80 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> ([Arg Declaration])
happyOut80 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut80 #-}
-happyIn81 :: ([Declaration]) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn81 :: ([Declaration]) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn81 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn81 #-}
-happyOut81 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> ([Declaration])
+happyOut81 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> ([Declaration])
happyOut81 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut81 #-}
-happyIn82 :: (RHSOrTypeSigs) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn82 :: (RHSOrTypeSigs) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn82 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn82 #-}
-happyOut82 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> (RHSOrTypeSigs)
+happyOut82 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> (RHSOrTypeSigs)
happyOut82 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut82 #-}
-happyIn83 :: (Declaration) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn83 :: (Declaration) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn83 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn83 #-}
-happyOut83 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> (Declaration)
+happyOut83 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> (Declaration)
happyOut83 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut83 #-}
-happyIn84 :: (Declaration) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn84 :: (Declaration) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn84 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn84 #-}
-happyOut84 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> (Declaration)
+happyOut84 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> (Declaration)
happyOut84 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut84 #-}
-happyIn85 :: (Declaration) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn85 :: (Declaration) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn85 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn85 #-}
-happyOut85 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> (Declaration)
+happyOut85 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> (Declaration)
happyOut85 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut85 #-}
-happyIn86 :: (Declaration) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn86 :: (Declaration) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn86 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn86 #-}
-happyOut86 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> (Declaration)
+happyOut86 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> (Declaration)
happyOut86 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut86 #-}
-happyIn87 :: (Name) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn87 :: (Name) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn87 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn87 #-}
-happyOut87 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> (Name)
+happyOut87 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> (Name)
happyOut87 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut87 #-}
-happyIn88 :: (Declaration) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn88 :: (Declaration) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn88 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn88 #-}
-happyOut88 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> (Declaration)
+happyOut88 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> (Declaration)
happyOut88 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut88 #-}
-happyIn89 :: ([Declaration]) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn89 :: ([Declaration]) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn89 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn89 #-}
-happyOut89 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> ([Declaration])
+happyOut89 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> ([Declaration])
happyOut89 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut89 #-}
-happyIn90 :: (Declaration) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn90 :: (Declaration) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn90 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn90 #-}
-happyOut90 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> (Declaration)
+happyOut90 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> (Declaration)
happyOut90 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut90 #-}
-happyIn91 :: (Declaration) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn91 :: (Declaration) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn91 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn91 #-}
-happyOut91 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> (Declaration)
+happyOut91 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> (Declaration)
happyOut91 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut91 #-}
-happyIn92 :: (Declaration) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn92 :: (Declaration) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn92 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn92 #-}
-happyOut92 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> (Declaration)
+happyOut92 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> (Declaration)
happyOut92 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut92 #-}
-happyIn93 :: (Declaration) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn93 :: (Declaration) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn93 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn93 #-}
-happyOut93 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> (Declaration)
+happyOut93 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> (Declaration)
happyOut93 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut93 #-}
-happyIn94 :: (Declaration) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn94 :: (Declaration) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn94 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn94 #-}
-happyOut94 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> (Declaration)
+happyOut94 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> (Declaration)
happyOut94 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut94 #-}
-happyIn95 :: (Declaration) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn95 :: (Declaration) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn95 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn95 #-}
-happyOut95 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> (Declaration)
+happyOut95 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> (Declaration)
happyOut95 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut95 #-}
-happyIn96 :: (Declaration) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn96 :: (Declaration) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn96 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn96 #-}
-happyOut96 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> (Declaration)
+happyOut96 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> (Declaration)
happyOut96 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut96 #-}
-happyIn97 :: ([Arg Name]) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn97 :: (Declaration) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn97 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn97 #-}
-happyOut97 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> ([Arg Name])
+happyOut97 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> (Declaration)
happyOut97 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut97 #-}
-happyIn98 :: ([RString]) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn98 :: (Declaration) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn98 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn98 #-}
-happyOut98 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> ([RString])
+happyOut98 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> (Declaration)
happyOut98 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut98 #-}
-happyIn99 :: ([NamedArg HoleName]) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn99 :: ([Arg Name]) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn99 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn99 #-}
-happyOut99 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> ([NamedArg HoleName])
+happyOut99 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> ([Arg Name])
happyOut99 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut99 #-}
-happyIn100 :: (NamedArg HoleName) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn100 :: ([RString]) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn100 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn100 #-}
-happyOut100 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> (NamedArg HoleName)
+happyOut100 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> ([RString])
happyOut100 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut100 #-}
-happyIn101 :: (HoleName) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn101 :: ([NamedArg HoleName]) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn101 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn101 #-}
-happyOut101 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> (HoleName)
+happyOut101 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> ([NamedArg HoleName])
happyOut101 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut101 #-}
-happyIn102 :: (HoleName) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn102 :: (NamedArg HoleName) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn102 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn102 #-}
-happyOut102 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> (HoleName)
+happyOut102 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> (NamedArg HoleName)
happyOut102 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut102 #-}
-happyIn103 :: (RString) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn103 :: (HoleName) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn103 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn103 #-}
-happyOut103 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> (RString)
+happyOut103 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> (HoleName)
happyOut103 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut103 #-}
-happyIn104 :: (Maybe Range) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn104 :: (HoleName) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn104 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn104 #-}
-happyOut104 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> (Maybe Range)
+happyOut104 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> (HoleName)
happyOut104 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut104 #-}
-happyIn105 :: ([Declaration]) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn105 :: (RString) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn105 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn105 #-}
-happyOut105 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> ([Declaration])
+happyOut105 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> (RString)
happyOut105 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut105 #-}
-happyIn106 :: ([Expr]) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn106 :: (Maybe Range) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn106 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn106 #-}
-happyOut106 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> ([Expr])
+happyOut106 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> (Maybe Range)
happyOut106 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut106 #-}
-happyIn107 :: ([TypedBindings] -> Parser ModuleApplication) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn107 :: ([Declaration]) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn107 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn107 #-}
-happyOut107 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> ([TypedBindings] -> Parser ModuleApplication)
+happyOut107 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> ([Declaration])
happyOut107 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut107 #-}
-happyIn108 :: (Declaration) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn108 :: ([Expr]) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn108 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn108 #-}
-happyOut108 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> (Declaration)
+happyOut108 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> ([Expr])
happyOut108 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut108 #-}
-happyIn109 :: (Declaration) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn109 :: ([TypedBindings] -> Parser ModuleApplication) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn109 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn109 #-}
-happyOut109 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> (Declaration)
+happyOut109 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> ([TypedBindings] -> Parser ModuleApplication)
happyOut109 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut109 #-}
-happyIn110 :: (Name) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn110 :: (Declaration) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn110 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn110 #-}
-happyOut110 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> (Name)
+happyOut110 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> (Declaration)
happyOut110 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut110 #-}
-happyIn111 :: ([Declaration]) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn111 :: (Declaration) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn111 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn111 #-}
-happyOut111 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> ([Declaration])
+happyOut111 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> (Declaration)
happyOut111 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut111 #-}
-happyIn112 :: (Declaration) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn112 :: (Name) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn112 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn112 #-}
-happyOut112 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> (Declaration)
+happyOut112 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> (Name)
happyOut112 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut112 #-}
-happyIn113 :: (Pragma) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn113 :: ([Declaration]) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn113 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn113 #-}
-happyOut113 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> (Pragma)
+happyOut113 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> ([Declaration])
happyOut113 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut113 #-}
-happyIn114 :: (Pragma) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn114 :: (Declaration) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn114 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn114 #-}
-happyOut114 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> (Pragma)
+happyOut114 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> (Declaration)
happyOut114 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut114 #-}
-happyIn115 :: (Pragma) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn115 :: (Pragma) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn115 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn115 #-}
-happyOut115 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> (Pragma)
+happyOut115 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> (Pragma)
happyOut115 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut115 #-}
-happyIn116 :: (Pragma) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn116 :: (Pragma) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn116 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn116 #-}
-happyOut116 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> (Pragma)
+happyOut116 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> (Pragma)
happyOut116 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut116 #-}
-happyIn117 :: (Pragma) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn117 :: (Pragma) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn117 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn117 #-}
-happyOut117 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> (Pragma)
+happyOut117 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> (Pragma)
happyOut117 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut117 #-}
-happyIn118 :: (Pragma) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn118 :: (Pragma) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn118 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn118 #-}
-happyOut118 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> (Pragma)
+happyOut118 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> (Pragma)
happyOut118 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut118 #-}
-happyIn119 :: (Pragma) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn119 :: (Pragma) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn119 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn119 #-}
-happyOut119 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> (Pragma)
+happyOut119 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> (Pragma)
happyOut119 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut119 #-}
-happyIn120 :: (Pragma) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn120 :: (Pragma) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn120 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn120 #-}
-happyOut120 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> (Pragma)
+happyOut120 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> (Pragma)
happyOut120 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut120 #-}
-happyIn121 :: (Pragma) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn121 :: (Pragma) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn121 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn121 #-}
-happyOut121 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> (Pragma)
+happyOut121 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> (Pragma)
happyOut121 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut121 #-}
-happyIn122 :: (Pragma) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn122 :: (Pragma) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn122 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn122 #-}
-happyOut122 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> (Pragma)
+happyOut122 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> (Pragma)
happyOut122 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut122 #-}
-happyIn123 :: (Pragma) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn123 :: (Pragma) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn123 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn123 #-}
-happyOut123 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> (Pragma)
+happyOut123 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> (Pragma)
happyOut123 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut123 #-}
-happyIn124 :: (Pragma) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn124 :: (Pragma) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn124 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn124 #-}
-happyOut124 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> (Pragma)
+happyOut124 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> (Pragma)
happyOut124 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut124 #-}
-happyIn125 :: (Pragma) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn125 :: (Pragma) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn125 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn125 #-}
-happyOut125 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> (Pragma)
+happyOut125 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> (Pragma)
happyOut125 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut125 #-}
-happyIn126 :: (Pragma) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn126 :: (Pragma) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn126 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn126 #-}
-happyOut126 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> (Pragma)
+happyOut126 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> (Pragma)
happyOut126 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut126 #-}
-happyIn127 :: ([TypeSignature]) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn127 :: (Pragma) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn127 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn127 #-}
-happyOut127 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> ([TypeSignature])
+happyOut127 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> (Pragma)
happyOut127 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut127 #-}
-happyIn128 :: ([TypeSignature]) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn128 :: (Pragma) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn128 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn128 #-}
-happyOut128 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> ([TypeSignature])
+happyOut128 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> (Pragma)
happyOut128 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut128 #-}
-happyIn129 :: ([TypeSignature]) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn129 :: (Pragma) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn129 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn129 #-}
-happyOut129 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> ([TypeSignature])
+happyOut129 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> (Pragma)
happyOut129 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut129 #-}
-happyIn130 :: ([TypeSignature]) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn130 :: (Pragma) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn130 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn130 #-}
-happyOut130 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> ([TypeSignature])
+happyOut130 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> (Pragma)
happyOut130 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut130 #-}
-happyIn131 :: ([Arg TypeSignature]) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn131 :: (Pragma) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn131 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn131 #-}
-happyOut131 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> ([Arg TypeSignature])
+happyOut131 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> (Pragma)
happyOut131 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut131 #-}
-happyIn132 :: ([Arg TypeSignature]) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn132 :: ([TypeSignature]) -> (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 t31 t34 t37 t38 t39 t43 t44 t71) -> ([Arg TypeSignature])
+happyOut132 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> ([TypeSignature])
happyOut132 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut132 #-}
-happyIn133 :: ([Constructor]) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn133 :: ([TypeSignature]) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn133 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn133 #-}
-happyOut133 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> ([Constructor])
+happyOut133 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> ([TypeSignature])
happyOut133 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut133 #-}
-happyIn134 :: ((Maybe (Ranged Induction), Maybe Name, [Declaration])) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn134 :: ([Arg 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 t31 t34 t37 t38 t39 t43 t44 t71) -> ((Maybe (Ranged Induction), Maybe Name, [Declaration]))
+happyOut134 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> ([Arg TypeSignature])
happyOut134 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut134 #-}
-happyIn135 :: (Ranged Induction) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn135 :: ([Arg TypeSignature]) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyIn135 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn135 #-}
-happyOut135 :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> (Ranged Induction)
+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 :: ([Declaration]) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn136 :: ([Constructor]) -> (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 t31 t34 t37 t38 t39 t43 t44 t71) -> ([Declaration])
+happyOut136 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> ([Constructor])
happyOut136 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut136 #-}
-happyIn137 :: ([Declaration]) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn137 :: ((Maybe (Ranged Induction), Maybe Name, [Declaration])) -> (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 t31 t34 t37 t38 t39 t43 t44 t71) -> ([Declaration])
+happyOut137 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> ((Maybe (Ranged Induction), Maybe Name, [Declaration]))
happyOut137 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut137 #-}
-happyIn138 :: ([Declaration]) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn138 :: (Ranged Induction) -> (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 t31 t34 t37 t38 t39 t43 t44 t71) -> ([Declaration])
+happyOut138 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> (Ranged Induction)
happyOut138 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut138 #-}
-happyIn139 :: ([Declaration]) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn139 :: ([Declaration]) -> (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 t31 t34 t37 t38 t39 t43 t44 t71) -> ([Declaration])
+happyOut139 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> ([Declaration])
happyOut139 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut139 #-}
-happyInTok :: (Token) -> (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71)
+happyIn140 :: ([Declaration]) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
+happyIn140 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyIn140 #-}
+happyOut140 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> ([Declaration])
+happyOut140 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyOut140 #-}
+happyIn141 :: ([Declaration]) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
+happyIn141 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyIn141 #-}
+happyOut141 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> ([Declaration])
+happyOut141 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyOut141 #-}
+happyIn142 :: ([Declaration]) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
+happyIn142 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyIn142 #-}
+happyOut142 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> ([Declaration])
+happyOut142 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyOut142 #-}
+happyInTok :: (Token) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
happyInTok x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyInTok #-}
-happyOutTok :: (HappyAbsSyn t10 t11 t12 t31 t34 t37 t38 t39 t43 t44 t71) -> (Token)
+happyOutTok :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> (Token)
happyOutTok x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOutTok #-}
happyActOffsets :: HappyAddr
-happyActOffsets = HappyA# "\x00\x00\x43\x08\x4d\x05\x00\x00\x9f\x04\x38\x05\x4d\x04\x4b\x05\x00\x00\x34\x05\x49\x05\x00\x00\x00\x00\x00\x00\x00\x00\xb3\x00\x00\x00\x00\x00\x0d\x08\xe9\x07\x3f\x05\x00\x00\xf4\x03\x32\x05\xff\x09\x00\x00\x00\x00\xad\x0e\x2b\x05\x2b\x05\x00\x00\x00\x00\x00\x00\x00\x00\x0e\x03\xd2\x09\x00\x00\x00\x00\x9d\x0e\xf1\x05\xc4\x05\xd2\x06\x00\x00\x00\x00\x00\x00\x25\x05\x37\x05\x00\x00\x2d\x05\x52\x01\x2c\x05\x00\x00\x00\x00\xaa\x01\xaa\x01\x00\x00\x27\x05\x2a\x05\ [...]
+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\ [...]
happyGotoOffsets :: HappyAddr
-happyGotoOffsets = HappyA# "\x70\x03\x63\x0e\x11\x04\x0d\x04\x04\x04\x00\x00\xe0\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x74\x05\x49\x0e\x00\x00\x00\x00\x16\x03\x8a\x03\x6b\x01\x00\x00\x00\x00\xc1\x01\xf6\x03\xe7\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xdf\x01\x00\x00\x00\x00\x57\x01\x82\x03\x78\x0a\xc9\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf9\x03\xf8\x03\x00\x00\x00\x00\x00\x00 [...]
+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 [...]
happyDefActions :: HappyAddr
-happyDefActions = HappyA# "\xfa\xff\x00\x00\x00\x00\x00\x00\xfc\xff\x00\x00\xb3\xfe\x86\xff\x64\xff\x00\x00\x76\xff\x75\xff\x73\xff\x72\xff\x6f\xff\x00\x00\x52\xff\x51\xff\x6d\xff\x00\x00\x00\x00\x4a\xff\x48\xff\x00\x00\x00\x00\x60\xff\x5f\xff\x00\x00\x00\x00\x00\x00\x5e\xff\x5d\xff\x5c\xff\x5b\xff\x00\x00\x00\x00\x61\xff\x62\xff\x00\x00\xb3\xfe\x00\x00\x00\x00\x9e\xff\x87\xff\x63\xff\x00\x00\x00\x00\x80\xff\x00\x00\x7f\xff\x00\x00\x65\xff\x57\xff\x00\x00\x00\x00\x9b\xff\x00\x00\x00\x00\ [...]
+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\ [...]
happyCheck :: HappyAddr
-happyCheck = HappyA# "\xff\xff\x05\x00\x05\x00\x40\x00\x02\x00\x09\x00\x09\x00\x0a\x00\x09\x00\x03\x00\x09\x00\x0f\x00\x05\x00\x00\x00\x0f\x00\x10\x00\x0f\x00\x4e\x00\x00\x00\x05\x00\x09\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x0f\x00\x09\x00\x39\x00\x20\x00\x0c\x00\x09\x00\x0e\x00\x09\x00\x09\x00\x3b\x00\x0c\x00\x0d\x00\x09\x00\x09\x00\x0f\x00\x10\x00\x23\x00\x24\x00\x0f\x00\x10\x00\x46\x00\x11\x00\x48\x00\x4e\x00\x4e\x00\x09\x00\x0a\x00\x51\x00\x09\x [...]
+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 [...]
happyTable :: HappyAddr
-happyTable = HappyA# "\x00\x00\x73\x02\x7c\x02\xee\x01\x3d\x01\x07\x00\xa3\x01\xa4\x01\x1d\x01\x01\x02\x07\x00\x08\x00\xbb\x02\x93\x01\x1e\x01\x42\x02\x08\x00\xc7\x01\x93\x01\xb6\x02\x3d\x01\x74\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x75\x00\x10\x00\x11\x00\x12\x00\x87\x02\x9d\x01\xa3\x01\x1a\x01\xb3\x01\x1f\x02\xb4\x01\x9d\x01\x1d\x01\x72\x01\x9e\x01\x9f\x01\x1d\x01\x40\x00\x1e\x01\x1f\x01\x26\x02\x40\x01\x1e\x01\x42\x02\x38\x00\x58\x01\x39\x00\x2b\x00\x15\x01\xa3\x01\xa4\x01\x16\x01\x9d\x [...]
+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 [...]
-happyReduceArr = Happy_Data_Array.array (3, 400) [
+happyReduceArr = Happy_Data_Array.array (3, 416) [
(3 , happyReduce_3),
(4 , happyReduce_4),
(5 , happyReduce_5),
@@ -1282,11 +1301,27 @@ happyReduceArr = Happy_Data_Array.array (3, 400) [
(397 , happyReduce_397),
(398 , happyReduce_398),
(399 , happyReduce_399),
- (400 , happyReduce_400)
+ (400 , happyReduce_400),
+ (401 , happyReduce_401),
+ (402 , happyReduce_402),
+ (403 , happyReduce_403),
+ (404 , happyReduce_404),
+ (405 , happyReduce_405),
+ (406 , happyReduce_406),
+ (407 , happyReduce_407),
+ (408 , happyReduce_408),
+ (409 , happyReduce_409),
+ (410 , happyReduce_410),
+ (411 , happyReduce_411),
+ (412 , happyReduce_412),
+ (413 , happyReduce_413),
+ (414 , happyReduce_414),
+ (415 , happyReduce_415),
+ (416 , happyReduce_416)
]
-happy_n_terms = 83 :: Int
-happy_n_nonterms = 134 :: Int
+happy_n_terms = 89 :: Int
+happy_n_nonterms = 137 :: Int
happyReduce_3 = happySpecReduce_1 0# happyReduction_3
happyReduction_3 happy_x_1
@@ -1507,428 +1542,470 @@ happyReduction_33 happy_x_1
happyReduce_34 = happySpecReduce_1 2# happyReduction_34
happyReduction_34 happy_x_1
- = case happyOutTok happy_x_1 of { (TokKeyword KwProp happy_var_1) ->
+ = case happyOutTok happy_x_1 of { (TokKeyword KwInstance happy_var_1) ->
happyIn8
- (TokKeyword KwProp happy_var_1
+ (TokKeyword KwInstance happy_var_1
)}
happyReduce_35 = happySpecReduce_1 2# happyReduction_35
happyReduction_35 happy_x_1
- = case happyOutTok happy_x_1 of { (TokKeyword KwSet happy_var_1) ->
+ = case happyOutTok happy_x_1 of { (TokKeyword KwProp happy_var_1) ->
happyIn8
- (TokKeyword KwSet happy_var_1
+ (TokKeyword KwProp happy_var_1
)}
happyReduce_36 = happySpecReduce_1 2# happyReduction_36
happyReduction_36 happy_x_1
- = case happyOutTok happy_x_1 of { (TokKeyword KwForall happy_var_1) ->
+ = case happyOutTok happy_x_1 of { (TokKeyword KwSet happy_var_1) ->
happyIn8
- (TokKeyword KwForall happy_var_1
+ (TokKeyword KwSet happy_var_1
)}
happyReduce_37 = happySpecReduce_1 2# happyReduction_37
happyReduction_37 happy_x_1
- = case happyOutTok happy_x_1 of { (TokKeyword KwSyntax happy_var_1) ->
+ = case happyOutTok happy_x_1 of { (TokKeyword KwForall happy_var_1) ->
happyIn8
- (TokKeyword KwSyntax happy_var_1
+ (TokKeyword KwForall happy_var_1
)}
happyReduce_38 = happySpecReduce_1 2# happyReduction_38
happyReduction_38 happy_x_1
- = case happyOutTok happy_x_1 of { (TokKeyword KwPatternSyn happy_var_1) ->
+ = case happyOutTok happy_x_1 of { (TokKeyword KwSyntax happy_var_1) ->
happyIn8
- (TokKeyword KwPatternSyn happy_var_1
+ (TokKeyword KwSyntax happy_var_1
)}
happyReduce_39 = happySpecReduce_1 2# happyReduction_39
happyReduction_39 happy_x_1
- = case happyOutTok happy_x_1 of { (TokKeyword KwOPTIONS happy_var_1) ->
+ = case happyOutTok happy_x_1 of { (TokKeyword KwPatternSyn happy_var_1) ->
happyIn8
- (TokKeyword KwOPTIONS happy_var_1
+ (TokKeyword KwPatternSyn happy_var_1
)}
happyReduce_40 = happySpecReduce_1 2# happyReduction_40
happyReduction_40 happy_x_1
- = case happyOutTok happy_x_1 of { (TokKeyword KwBUILTIN happy_var_1) ->
+ = case happyOutTok happy_x_1 of { (TokKeyword KwOPTIONS happy_var_1) ->
happyIn8
- (TokKeyword KwBUILTIN happy_var_1
+ (TokKeyword KwOPTIONS happy_var_1
)}
happyReduce_41 = happySpecReduce_1 2# happyReduction_41
happyReduction_41 happy_x_1
- = case happyOutTok happy_x_1 of { (TokKeyword KwIMPORT happy_var_1) ->
+ = case happyOutTok happy_x_1 of { (TokKeyword KwBUILTIN happy_var_1) ->
happyIn8
- (TokKeyword KwIMPORT happy_var_1
+ (TokKeyword KwBUILTIN happy_var_1
)}
happyReduce_42 = happySpecReduce_1 2# happyReduction_42
happyReduction_42 happy_x_1
- = case happyOutTok happy_x_1 of { (TokKeyword KwCOMPILED happy_var_1) ->
+ = case happyOutTok happy_x_1 of { (TokKeyword KwREWRITE happy_var_1) ->
happyIn8
- (TokKeyword KwCOMPILED happy_var_1
+ (TokKeyword KwREWRITE happy_var_1
)}
happyReduce_43 = happySpecReduce_1 2# happyReduction_43
happyReduction_43 happy_x_1
- = case happyOutTok happy_x_1 of { (TokKeyword KwCOMPILED_EXPORT happy_var_1) ->
+ = case happyOutTok happy_x_1 of { (TokKeyword KwIMPORT happy_var_1) ->
happyIn8
- (TokKeyword KwCOMPILED_EXPORT happy_var_1
+ (TokKeyword KwIMPORT happy_var_1
)}
happyReduce_44 = happySpecReduce_1 2# happyReduction_44
happyReduction_44 happy_x_1
- = case happyOutTok happy_x_1 of { (TokKeyword KwCOMPILED_DATA happy_var_1) ->
+ = case happyOutTok happy_x_1 of { (TokKeyword KwCOMPILED happy_var_1) ->
happyIn8
- (TokKeyword KwCOMPILED_DATA happy_var_1
+ (TokKeyword KwCOMPILED happy_var_1
)}
happyReduce_45 = happySpecReduce_1 2# happyReduction_45
happyReduction_45 happy_x_1
- = case happyOutTok happy_x_1 of { (TokKeyword KwCOMPILED_TYPE happy_var_1) ->
+ = case happyOutTok happy_x_1 of { (TokKeyword KwCOMPILED_EXPORT happy_var_1) ->
happyIn8
- (TokKeyword KwCOMPILED_TYPE happy_var_1
+ (TokKeyword KwCOMPILED_EXPORT happy_var_1
)}
happyReduce_46 = happySpecReduce_1 2# happyReduction_46
happyReduction_46 happy_x_1
- = case happyOutTok happy_x_1 of { (TokKeyword KwCOMPILED_EPIC happy_var_1) ->
+ = case happyOutTok happy_x_1 of { (TokKeyword KwCOMPILED_DATA happy_var_1) ->
happyIn8
- (TokKeyword KwCOMPILED_EPIC happy_var_1
+ (TokKeyword KwCOMPILED_DATA happy_var_1
)}
happyReduce_47 = happySpecReduce_1 2# happyReduction_47
happyReduction_47 happy_x_1
- = case happyOutTok happy_x_1 of { (TokKeyword KwCOMPILED_JS happy_var_1) ->
+ = case happyOutTok happy_x_1 of { (TokKeyword KwCOMPILED_TYPE happy_var_1) ->
happyIn8
- (TokKeyword KwCOMPILED_JS happy_var_1
+ (TokKeyword KwCOMPILED_TYPE happy_var_1
)}
happyReduce_48 = happySpecReduce_1 2# happyReduction_48
happyReduction_48 happy_x_1
- = case happyOutTok happy_x_1 of { (TokKeyword KwSTATIC happy_var_1) ->
+ = case happyOutTok happy_x_1 of { (TokKeyword KwCOMPILED_EPIC happy_var_1) ->
happyIn8
- (TokKeyword KwSTATIC happy_var_1
+ (TokKeyword KwCOMPILED_EPIC happy_var_1
)}
happyReduce_49 = happySpecReduce_1 2# happyReduction_49
happyReduction_49 happy_x_1
- = case happyOutTok happy_x_1 of { (TokKeyword KwIMPOSSIBLE happy_var_1) ->
+ = case happyOutTok happy_x_1 of { (TokKeyword KwCOMPILED_JS happy_var_1) ->
happyIn8
- (TokKeyword KwIMPOSSIBLE happy_var_1
+ (TokKeyword KwCOMPILED_JS happy_var_1
)}
happyReduce_50 = happySpecReduce_1 2# happyReduction_50
happyReduction_50 happy_x_1
- = case happyOutTok happy_x_1 of { (TokKeyword KwETA happy_var_1) ->
+ = case happyOutTok happy_x_1 of { (TokKeyword KwSTATIC happy_var_1) ->
happyIn8
- (TokKeyword KwETA happy_var_1
+ (TokKeyword KwSTATIC happy_var_1
)}
happyReduce_51 = happySpecReduce_1 2# happyReduction_51
happyReduction_51 happy_x_1
- = case happyOutTok happy_x_1 of { (TokKeyword KwNO_TERMINATION_CHECK happy_var_1) ->
+ = case happyOutTok happy_x_1 of { (TokKeyword KwIMPOSSIBLE happy_var_1) ->
happyIn8
- (TokKeyword KwNO_TERMINATION_CHECK happy_var_1
+ (TokKeyword KwIMPOSSIBLE happy_var_1
)}
happyReduce_52 = happySpecReduce_1 2# happyReduction_52
happyReduction_52 happy_x_1
- = case happyOutTok happy_x_1 of { (TokKeyword KwQuoteGoal happy_var_1) ->
+ = case happyOutTok happy_x_1 of { (TokKeyword KwETA happy_var_1) ->
happyIn8
- (TokKeyword KwQuoteGoal happy_var_1
+ (TokKeyword KwETA happy_var_1
)}
happyReduce_53 = happySpecReduce_1 2# happyReduction_53
happyReduction_53 happy_x_1
- = case happyOutTok happy_x_1 of { (TokKeyword KwQuoteContext happy_var_1) ->
+ = case happyOutTok happy_x_1 of { (TokKeyword KwNO_TERMINATION_CHECK happy_var_1) ->
happyIn8
- (TokKeyword KwQuoteContext happy_var_1
+ (TokKeyword KwNO_TERMINATION_CHECK happy_var_1
)}
happyReduce_54 = happySpecReduce_1 2# happyReduction_54
happyReduction_54 happy_x_1
- = case happyOutTok happy_x_1 of { (TokKeyword KwQuote happy_var_1) ->
+ = case happyOutTok happy_x_1 of { (TokKeyword KwNON_TERMINATING happy_var_1) ->
happyIn8
- (TokKeyword KwQuote happy_var_1
+ (TokKeyword KwNON_TERMINATING happy_var_1
)}
happyReduce_55 = happySpecReduce_1 2# happyReduction_55
happyReduction_55 happy_x_1
- = case happyOutTok happy_x_1 of { (TokKeyword KwQuoteTerm happy_var_1) ->
+ = case happyOutTok happy_x_1 of { (TokKeyword KwMEASURE happy_var_1) ->
happyIn8
- (TokKeyword KwQuoteTerm happy_var_1
+ (TokKeyword KwMEASURE happy_var_1
)}
happyReduce_56 = happySpecReduce_1 2# happyReduction_56
happyReduction_56 happy_x_1
- = case happyOutTok happy_x_1 of { (TokKeyword KwUnquote happy_var_1) ->
+ = case happyOutTok happy_x_1 of { (TokKeyword KwQuoteGoal happy_var_1) ->
happyIn8
- (TokKeyword KwUnquote happy_var_1
+ (TokKeyword KwQuoteGoal happy_var_1
)}
happyReduce_57 = happySpecReduce_1 2# happyReduction_57
happyReduction_57 happy_x_1
- = case happyOutTok happy_x_1 of { (TokSetN happy_var_1) ->
+ = case happyOutTok happy_x_1 of { (TokKeyword KwQuoteContext happy_var_1) ->
happyIn8
- (TokSetN happy_var_1
+ (TokKeyword KwQuoteContext happy_var_1
)}
happyReduce_58 = happySpecReduce_1 2# happyReduction_58
happyReduction_58 happy_x_1
- = case happyOutTok happy_x_1 of { (TokTeX happy_var_1) ->
+ = case happyOutTok happy_x_1 of { (TokKeyword KwQuote happy_var_1) ->
happyIn8
- (TokTeX happy_var_1
+ (TokKeyword KwQuote happy_var_1
)}
happyReduce_59 = happySpecReduce_1 2# happyReduction_59
happyReduction_59 happy_x_1
- = case happyOutTok happy_x_1 of { (TokComment happy_var_1) ->
+ = case happyOutTok happy_x_1 of { (TokKeyword KwQuoteTerm happy_var_1) ->
happyIn8
- (TokComment happy_var_1
+ (TokKeyword KwQuoteTerm happy_var_1
)}
happyReduce_60 = happySpecReduce_1 2# happyReduction_60
happyReduction_60 happy_x_1
- = case happyOutTok happy_x_1 of { (TokSymbol SymEllipsis happy_var_1) ->
+ = case happyOutTok happy_x_1 of { (TokKeyword KwTactic happy_var_1) ->
happyIn8
- (TokSymbol SymEllipsis happy_var_1
+ (TokKeyword KwTactic happy_var_1
)}
happyReduce_61 = happySpecReduce_1 2# happyReduction_61
happyReduction_61 happy_x_1
- = case happyOutTok happy_x_1 of { (TokSymbol SymDotDot happy_var_1) ->
+ = case happyOutTok happy_x_1 of { (TokKeyword KwUnquote happy_var_1) ->
happyIn8
- (TokSymbol SymDotDot happy_var_1
+ (TokKeyword KwUnquote happy_var_1
)}
happyReduce_62 = happySpecReduce_1 2# happyReduction_62
happyReduction_62 happy_x_1
- = case happyOutTok happy_x_1 of { (TokSymbol SymDot happy_var_1) ->
+ = case happyOutTok happy_x_1 of { (TokKeyword KwUnquoteDecl happy_var_1) ->
happyIn8
- (TokSymbol SymDot happy_var_1
+ (TokKeyword KwUnquoteDecl happy_var_1
)}
happyReduce_63 = happySpecReduce_1 2# happyReduction_63
happyReduction_63 happy_x_1
- = case happyOutTok happy_x_1 of { (TokSymbol SymSemi happy_var_1) ->
+ = case happyOutTok happy_x_1 of { (TokSetN happy_var_1) ->
happyIn8
- (TokSymbol SymSemi happy_var_1
+ (TokSetN happy_var_1
)}
happyReduce_64 = happySpecReduce_1 2# happyReduction_64
happyReduction_64 happy_x_1
- = case happyOutTok happy_x_1 of { (TokSymbol SymColon happy_var_1) ->
+ = case happyOutTok happy_x_1 of { (TokTeX happy_var_1) ->
happyIn8
- (TokSymbol SymColon happy_var_1
+ (TokTeX happy_var_1
)}
happyReduce_65 = happySpecReduce_1 2# happyReduction_65
happyReduction_65 happy_x_1
- = case happyOutTok happy_x_1 of { (TokSymbol SymEqual happy_var_1) ->
+ = case happyOutTok happy_x_1 of { (TokComment happy_var_1) ->
happyIn8
- (TokSymbol SymEqual happy_var_1
+ (TokComment happy_var_1
)}
happyReduce_66 = happySpecReduce_1 2# happyReduction_66
happyReduction_66 happy_x_1
- = case happyOutTok happy_x_1 of { (TokSymbol SymUnderscore happy_var_1) ->
+ = case happyOutTok happy_x_1 of { (TokSymbol SymEllipsis happy_var_1) ->
happyIn8
- (TokSymbol SymUnderscore happy_var_1
+ (TokSymbol SymEllipsis happy_var_1
)}
happyReduce_67 = happySpecReduce_1 2# happyReduction_67
happyReduction_67 happy_x_1
- = case happyOutTok happy_x_1 of { (TokSymbol SymQuestionMark happy_var_1) ->
+ = case happyOutTok happy_x_1 of { (TokSymbol SymDotDot happy_var_1) ->
happyIn8
- (TokSymbol SymQuestionMark happy_var_1
+ (TokSymbol SymDotDot happy_var_1
)}
happyReduce_68 = happySpecReduce_1 2# happyReduction_68
happyReduction_68 happy_x_1
- = case happyOutTok happy_x_1 of { (TokSymbol SymArrow happy_var_1) ->
+ = case happyOutTok happy_x_1 of { (TokSymbol SymDot happy_var_1) ->
happyIn8
- (TokSymbol SymArrow happy_var_1
+ (TokSymbol SymDot happy_var_1
)}
happyReduce_69 = happySpecReduce_1 2# happyReduction_69
happyReduction_69 happy_x_1
- = case happyOutTok happy_x_1 of { (TokSymbol SymLambda happy_var_1) ->
+ = case happyOutTok happy_x_1 of { (TokSymbol SymSemi happy_var_1) ->
happyIn8
- (TokSymbol SymLambda happy_var_1
+ (TokSymbol SymSemi happy_var_1
)}
happyReduce_70 = happySpecReduce_1 2# happyReduction_70
happyReduction_70 happy_x_1
- = case happyOutTok happy_x_1 of { (TokSymbol SymAs happy_var_1) ->
+ = case happyOutTok happy_x_1 of { (TokSymbol SymColon happy_var_1) ->
happyIn8
- (TokSymbol SymAs happy_var_1
+ (TokSymbol SymColon happy_var_1
)}
happyReduce_71 = happySpecReduce_1 2# happyReduction_71
happyReduction_71 happy_x_1
- = case happyOutTok happy_x_1 of { (TokSymbol SymBar happy_var_1) ->
+ = case happyOutTok happy_x_1 of { (TokSymbol SymEqual happy_var_1) ->
happyIn8
- (TokSymbol SymBar happy_var_1
+ (TokSymbol SymEqual happy_var_1
)}
happyReduce_72 = happySpecReduce_1 2# happyReduction_72
happyReduction_72 happy_x_1
- = case happyOutTok happy_x_1 of { (TokSymbol SymOpenParen happy_var_1) ->
+ = case happyOutTok happy_x_1 of { (TokSymbol SymUnderscore happy_var_1) ->
happyIn8
- (TokSymbol SymOpenParen happy_var_1
+ (TokSymbol SymUnderscore happy_var_1
)}
happyReduce_73 = happySpecReduce_1 2# happyReduction_73
happyReduction_73 happy_x_1
- = case happyOutTok happy_x_1 of { (TokSymbol SymCloseParen happy_var_1) ->
+ = case happyOutTok happy_x_1 of { (TokSymbol SymQuestionMark happy_var_1) ->
happyIn8
- (TokSymbol SymCloseParen happy_var_1
+ (TokSymbol SymQuestionMark happy_var_1
)}
happyReduce_74 = happySpecReduce_1 2# happyReduction_74
happyReduction_74 happy_x_1
- = case happyOutTok happy_x_1 of { (TokSymbol SymDoubleOpenBrace happy_var_1) ->
+ = case happyOutTok happy_x_1 of { (TokSymbol SymArrow happy_var_1) ->
happyIn8
- (TokSymbol SymDoubleOpenBrace happy_var_1
+ (TokSymbol SymArrow happy_var_1
)}
happyReduce_75 = happySpecReduce_1 2# happyReduction_75
happyReduction_75 happy_x_1
- = case happyOutTok happy_x_1 of { (TokSymbol SymDoubleCloseBrace happy_var_1) ->
+ = case happyOutTok happy_x_1 of { (TokSymbol SymLambda happy_var_1) ->
happyIn8
- (TokSymbol SymDoubleCloseBrace happy_var_1
+ (TokSymbol SymLambda happy_var_1
)}
happyReduce_76 = happySpecReduce_1 2# happyReduction_76
happyReduction_76 happy_x_1
- = case happyOutTok happy_x_1 of { (TokSymbol SymOpenBrace happy_var_1) ->
+ = case happyOutTok happy_x_1 of { (TokSymbol SymAs happy_var_1) ->
happyIn8
- (TokSymbol SymOpenBrace happy_var_1
+ (TokSymbol SymAs happy_var_1
)}
happyReduce_77 = happySpecReduce_1 2# happyReduction_77
happyReduction_77 happy_x_1
- = case happyOutTok happy_x_1 of { (TokSymbol SymCloseBrace happy_var_1) ->
+ = case happyOutTok happy_x_1 of { (TokSymbol SymBar happy_var_1) ->
happyIn8
- (TokSymbol SymCloseBrace happy_var_1
+ (TokSymbol SymBar happy_var_1
)}
happyReduce_78 = happySpecReduce_1 2# happyReduction_78
happyReduction_78 happy_x_1
- = case happyOutTok happy_x_1 of { (TokSymbol SymOpenVirtualBrace happy_var_1) ->
+ = case happyOutTok happy_x_1 of { (TokSymbol SymOpenParen happy_var_1) ->
happyIn8
- (TokSymbol SymOpenVirtualBrace happy_var_1
+ (TokSymbol SymOpenParen happy_var_1
)}
happyReduce_79 = happySpecReduce_1 2# happyReduction_79
happyReduction_79 happy_x_1
- = case happyOutTok happy_x_1 of { (TokSymbol SymCloseVirtualBrace happy_var_1) ->
+ = case happyOutTok happy_x_1 of { (TokSymbol SymCloseParen happy_var_1) ->
happyIn8
- (TokSymbol SymCloseVirtualBrace happy_var_1
+ (TokSymbol SymCloseParen happy_var_1
)}
happyReduce_80 = happySpecReduce_1 2# happyReduction_80
happyReduction_80 happy_x_1
- = case happyOutTok happy_x_1 of { (TokSymbol SymVirtualSemi happy_var_1) ->
+ = case happyOutTok happy_x_1 of { (TokSymbol SymDoubleOpenBrace happy_var_1) ->
happyIn8
- (TokSymbol SymVirtualSemi happy_var_1
+ (TokSymbol SymDoubleOpenBrace happy_var_1
)}
happyReduce_81 = happySpecReduce_1 2# happyReduction_81
happyReduction_81 happy_x_1
- = case happyOutTok happy_x_1 of { (TokSymbol SymOpenPragma happy_var_1) ->
+ = case happyOutTok happy_x_1 of { (TokSymbol SymDoubleCloseBrace happy_var_1) ->
happyIn8
- (TokSymbol SymOpenPragma happy_var_1
+ (TokSymbol SymDoubleCloseBrace happy_var_1
)}
happyReduce_82 = happySpecReduce_1 2# happyReduction_82
happyReduction_82 happy_x_1
- = case happyOutTok happy_x_1 of { (TokSymbol SymClosePragma happy_var_1) ->
+ = case happyOutTok happy_x_1 of { (TokSymbol SymOpenBrace happy_var_1) ->
happyIn8
- (TokSymbol SymClosePragma happy_var_1
+ (TokSymbol SymOpenBrace happy_var_1
)}
happyReduce_83 = happySpecReduce_1 2# happyReduction_83
happyReduction_83 happy_x_1
- = case happyOutTok happy_x_1 of { (TokId happy_var_1) ->
+ = case happyOutTok happy_x_1 of { (TokSymbol SymCloseBrace happy_var_1) ->
happyIn8
- (TokId happy_var_1
+ (TokSymbol SymCloseBrace happy_var_1
)}
happyReduce_84 = happySpecReduce_1 2# happyReduction_84
happyReduction_84 happy_x_1
- = case happyOutTok happy_x_1 of { (TokQId happy_var_1) ->
+ = case happyOutTok happy_x_1 of { (TokSymbol SymOpenVirtualBrace happy_var_1) ->
happyIn8
- (TokQId happy_var_1
+ (TokSymbol SymOpenVirtualBrace happy_var_1
)}
happyReduce_85 = happySpecReduce_1 2# happyReduction_85
happyReduction_85 happy_x_1
- = case happyOutTok happy_x_1 of { (TokString happy_var_1) ->
+ = case happyOutTok happy_x_1 of { (TokSymbol SymCloseVirtualBrace happy_var_1) ->
happyIn8
- (TokString happy_var_1
+ (TokSymbol SymCloseVirtualBrace 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) ->
+ happyIn8
+ (TokSymbol SymVirtualSemi 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) ->
+ happyIn8
+ (TokSymbol SymOpenPragma 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) ->
+ happyIn8
+ (TokSymbol SymClosePragma 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) ->
+ happyIn8
+ (TokId 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) ->
+ happyIn8
+ (TokQId 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) ->
+ happyIn8
+ (TokString happy_var_1
+ )}
+
+happyReduce_92 = happySpecReduce_1 2# happyReduction_92
+happyReduction_92 happy_x_1
= case happyOutTok happy_x_1 of { (TokLiteral happy_var_1) ->
happyIn8
(TokLiteral happy_var_1
)}
-happyReduce_87 = happySpecReduce_3 3# happyReduction_87
-happyReduction_87 happy_x_3
+happyReduce_93 = happySpecReduce_3 3# happyReduction_93
+happyReduction_93 happy_x_3
happy_x_2
happy_x_1
- = case happyOut111 happy_x_2 of { happy_var_2 ->
+ = case happyOut113 happy_x_2 of { happy_var_2 ->
happyIn9
(takeOptionsPragmas happy_var_2
)}
-happyReduce_88 = happySpecReduce_0 4# happyReduction_88
-happyReduction_88 = happyIn10
+happyReduce_94 = happySpecReduce_0 4# happyReduction_94
+happyReduction_94 = happyIn10
(()
)
-happyReduce_89 = happySpecReduce_1 4# happyReduction_89
-happyReduction_89 happy_x_1
+happyReduce_95 = happySpecReduce_1 4# happyReduction_95
+happyReduction_95 happy_x_1
= happyIn10
(()
)
-happyReduce_90 = happySpecReduce_1 5# happyReduction_90
-happyReduction_90 happy_x_1
+happyReduce_96 = happySpecReduce_1 5# happyReduction_96
+happyReduction_96 happy_x_1
= happyIn11
(()
)
-happyReduce_91 = happyMonadReduce 1# 5# happyReduction_91
-happyReduction_91 (happy_x_1 `HappyStk`
+happyReduce_97 = happyMonadReduce 1# 5# happyReduction_97
+happyReduction_97 (happy_x_1 `HappyStk`
happyRest) tk
= happyThen (( popContext)
) (\r -> happyReturn (happyIn11 r))
-happyReduce_92 = happySpecReduce_1 6# happyReduction_92
-happyReduction_92 happy_x_1
+happyReduce_98 = happySpecReduce_1 6# happyReduction_98
+happyReduction_98 happy_x_1
= case happyOutTok happy_x_1 of { (TokSymbol SymSemi happy_var_1) ->
happyIn12
(happy_var_1
)}
-happyReduce_93 = happySpecReduce_1 6# happyReduction_93
-happyReduction_93 happy_x_1
+happyReduce_99 = happySpecReduce_1 6# happyReduction_99
+happyReduction_99 happy_x_1
= case happyOutTok happy_x_1 of { (TokSymbol SymVirtualSemi happy_var_1) ->
happyIn12
(happy_var_1
)}
-happyReduce_94 = happyMonadReduce 0# 7# happyReduction_94
-happyReduction_94 (happyRest) tk
+happyReduce_100 = happyMonadReduce 0# 7# happyReduction_100
+happyReduction_100 (happyRest) tk
= happyThen (( pushLexState imp_dir)
) (\r -> happyReturn (happyIn13 r))
-happyReduce_95 = happyMonadReduce 1# 8# happyReduction_95
-happyReduction_95 (happy_x_1 `HappyStk`
+happyReduce_101 = happyMonadReduce 1# 8# happyReduction_101
+happyReduction_101 (happy_x_1 `HappyStk`
happyRest) tk
= happyThen (case happyOutTok happy_x_1 of { (TokLiteral happy_var_1) ->
( case happy_var_1 of {
@@ -1937,8 +2014,8 @@ happyReduction_95 (happy_x_1 `HappyStk`
})}
) (\r -> happyReturn (happyIn14 r))
-happyReduce_96 = happyMonadReduce 1# 8# happyReduction_96
-happyReduction_96 (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 { (TokId happy_var_1) ->
( case happy_var_1 of {
@@ -1949,15 +2026,15 @@ happyReduction_96 (happy_x_1 `HappyStk`
})}
) (\r -> happyReturn (happyIn14 r))
-happyReduce_97 = happyMonadReduce 1# 9# happyReduction_97
-happyReduction_97 (happy_x_1 `HappyStk`
+happyReduce_103 = happyMonadReduce 1# 9# happyReduction_103
+happyReduction_103 (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_98 = happySpecReduce_2 10# happyReduction_98
-happyReduction_98 happy_x_2
+happyReduce_104 = happySpecReduce_2 10# happyReduction_104
+happyReduction_104 happy_x_2
happy_x_1
= case happyOut15 happy_x_1 of { happy_var_1 ->
case happyOut16 happy_x_2 of { happy_var_2 ->
@@ -1965,22 +2042,22 @@ happyReduction_98 happy_x_2
(happy_var_1 : happy_var_2
)}}
-happyReduce_99 = happySpecReduce_1 10# happyReduction_99
-happyReduction_99 happy_x_1
+happyReduce_105 = happySpecReduce_1 10# happyReduction_105
+happyReduction_105 happy_x_1
= case happyOut15 happy_x_1 of { happy_var_1 ->
happyIn16
([happy_var_1]
)}
-happyReduce_100 = happySpecReduce_1 11# happyReduction_100
-happyReduction_100 happy_x_1
+happyReduce_106 = happySpecReduce_1 11# happyReduction_106
+happyReduction_106 happy_x_1
= case happyOutTok happy_x_1 of { (TokSymbol SymDoubleCloseBrace happy_var_1) ->
happyIn17
(getRange happy_var_1
)}
-happyReduce_101 = happyMonadReduce 2# 11# happyReduction_101
-happyReduction_101 (happy_x_2 `HappyStk`
+happyReduce_107 = happyMonadReduce 2# 11# happyReduction_107
+happyReduction_107 (happy_x_2 `HappyStk`
happy_x_1 `HappyStk`
happyRest) tk
= happyThen (case happyOutTok happy_x_1 of { (TokSymbol SymCloseBrace happy_var_1) ->
@@ -1993,23 +2070,23 @@ happyReduction_101 (happy_x_2 `HappyStk`
else return $ getRange (happy_var_1, happy_var_2))}}
) (\r -> happyReturn (happyIn17 r))
-happyReduce_102 = happySpecReduce_2 12# happyReduction_102
-happyReduction_102 happy_x_2
+happyReduce_108 = happySpecReduce_2 12# happyReduction_108
+happyReduction_108 happy_x_2
happy_x_1
= case happyOut15 happy_x_2 of { happy_var_2 ->
happyIn18
(setRelevance Irrelevant $ defaultArg happy_var_2
)}
-happyReduce_103 = happySpecReduce_1 12# happyReduction_103
-happyReduction_103 happy_x_1
+happyReduce_109 = happySpecReduce_1 12# happyReduction_109
+happyReduction_109 happy_x_1
= case happyOut15 happy_x_1 of { happy_var_1 ->
happyIn18
(defaultArg happy_var_1
)}
-happyReduce_104 = happySpecReduce_2 13# happyReduction_104
-happyReduction_104 happy_x_2
+happyReduce_110 = happySpecReduce_2 13# happyReduction_110
+happyReduction_110 happy_x_2
happy_x_1
= case happyOut18 happy_x_1 of { happy_var_1 ->
case happyOut19 happy_x_2 of { happy_var_2 ->
@@ -2017,15 +2094,15 @@ happyReduction_104 happy_x_2
(happy_var_1 : happy_var_2
)}}
-happyReduce_105 = happySpecReduce_1 13# happyReduction_105
-happyReduction_105 happy_x_1
+happyReduce_111 = happySpecReduce_1 13# happyReduction_111
+happyReduction_111 happy_x_1
= case happyOut18 happy_x_1 of { happy_var_1 ->
happyIn19
([happy_var_1]
)}
-happyReduce_106 = happySpecReduce_2 14# happyReduction_106
-happyReduction_106 happy_x_2
+happyReduce_112 = happySpecReduce_2 14# happyReduction_112
+happyReduction_112 happy_x_2
happy_x_1
= case happyOut18 happy_x_1 of { happy_var_1 ->
case happyOut20 happy_x_2 of { happy_var_2 ->
@@ -2033,15 +2110,15 @@ happyReduction_106 happy_x_2
(happy_var_1 : happy_var_2
)}}
-happyReduce_107 = happySpecReduce_1 14# happyReduction_107
-happyReduction_107 happy_x_1
+happyReduce_113 = happySpecReduce_1 14# happyReduction_113
+happyReduction_113 happy_x_1
= case happyOut18 happy_x_1 of { happy_var_1 ->
happyIn20
([happy_var_1]
)}
-happyReduce_108 = happyReduce 4# 14# happyReduction_108
-happyReduction_108 (happy_x_4 `HappyStk`
+happyReduce_114 = happyReduce 4# 14# happyReduction_114
+happyReduction_114 (happy_x_4 `HappyStk`
happy_x_3 `HappyStk`
happy_x_2 `HappyStk`
happy_x_1 `HappyStk`
@@ -2052,8 +2129,8 @@ happyReduction_108 (happy_x_4 `HappyStk`
(map makeInstance happy_var_2 ++ happy_var_4
) `HappyStk` happyRest}}
-happyReduce_109 = happySpecReduce_3 14# happyReduction_109
-happyReduction_109 happy_x_3
+happyReduce_115 = happySpecReduce_3 14# happyReduction_115
+happyReduction_115 happy_x_3
happy_x_2
happy_x_1
= case happyOut19 happy_x_2 of { happy_var_2 ->
@@ -2061,8 +2138,8 @@ happyReduction_109 happy_x_3
(map makeInstance happy_var_2
)}
-happyReduce_110 = happyReduce 4# 14# happyReduction_110
-happyReduction_110 (happy_x_4 `HappyStk`
+happyReduce_116 = happyReduce 4# 14# happyReduction_116
+happyReduction_116 (happy_x_4 `HappyStk`
happy_x_3 `HappyStk`
happy_x_2 `HappyStk`
happy_x_1 `HappyStk`
@@ -2073,8 +2150,8 @@ happyReduction_110 (happy_x_4 `HappyStk`
(map hide happy_var_2 ++ happy_var_4
) `HappyStk` happyRest}}
-happyReduce_111 = happySpecReduce_3 14# happyReduction_111
-happyReduction_111 happy_x_3
+happyReduce_117 = happySpecReduce_3 14# happyReduction_117
+happyReduction_117 happy_x_3
happy_x_2
happy_x_1
= case happyOut19 happy_x_2 of { happy_var_2 ->
@@ -2082,8 +2159,8 @@ happyReduction_111 happy_x_3
(map hide happy_var_2
)}
-happyReduce_112 = happyReduce 5# 14# happyReduction_112
-happyReduction_112 (happy_x_5 `HappyStk`
+happyReduce_118 = happyReduce 5# 14# happyReduction_118
+happyReduction_118 (happy_x_5 `HappyStk`
happy_x_4 `HappyStk`
happy_x_3 `HappyStk`
happy_x_2 `HappyStk`
@@ -2095,8 +2172,8 @@ happyReduction_112 (happy_x_5 `HappyStk`
(map (hide . setRelevance Irrelevant . defaultArg) happy_var_3 ++ happy_var_5
) `HappyStk` happyRest}}
-happyReduce_113 = happyReduce 4# 14# happyReduction_113
-happyReduction_113 (happy_x_4 `HappyStk`
+happyReduce_119 = happyReduce 4# 14# happyReduction_119
+happyReduction_119 (happy_x_4 `HappyStk`
happy_x_3 `HappyStk`
happy_x_2 `HappyStk`
happy_x_1 `HappyStk`
@@ -2106,8 +2183,8 @@ happyReduction_113 (happy_x_4 `HappyStk`
(map (hide . setRelevance Irrelevant . defaultArg) happy_var_3
) `HappyStk` happyRest}
-happyReduce_114 = happyReduce 5# 14# happyReduction_114
-happyReduction_114 (happy_x_5 `HappyStk`
+happyReduce_120 = happyReduce 5# 14# happyReduction_120
+happyReduction_120 (happy_x_5 `HappyStk`
happy_x_4 `HappyStk`
happy_x_3 `HappyStk`
happy_x_2 `HappyStk`
@@ -2119,8 +2196,8 @@ happyReduction_114 (happy_x_5 `HappyStk`
(map (makeInstance . setRelevance Irrelevant . defaultArg) happy_var_3 ++ happy_var_5
) `HappyStk` happyRest}}
-happyReduce_115 = happyReduce 4# 14# happyReduction_115
-happyReduction_115 (happy_x_4 `HappyStk`
+happyReduce_121 = happyReduce 4# 14# happyReduction_121
+happyReduction_121 (happy_x_4 `HappyStk`
happy_x_3 `HappyStk`
happy_x_2 `HappyStk`
happy_x_1 `HappyStk`
@@ -2130,8 +2207,8 @@ happyReduction_115 (happy_x_4 `HappyStk`
(map (makeInstance . setRelevance Irrelevant . defaultArg) happy_var_3
) `HappyStk` happyRest}
-happyReduce_116 = happyReduce 5# 14# happyReduction_116
-happyReduction_116 (happy_x_5 `HappyStk`
+happyReduce_122 = happyReduce 5# 14# happyReduction_122
+happyReduction_122 (happy_x_5 `HappyStk`
happy_x_4 `HappyStk`
happy_x_3 `HappyStk`
happy_x_2 `HappyStk`
@@ -2143,8 +2220,8 @@ happyReduction_116 (happy_x_5 `HappyStk`
(map (hide . setRelevance NonStrict . defaultArg) happy_var_3 ++ happy_var_5
) `HappyStk` happyRest}}
-happyReduce_117 = happyReduce 4# 14# happyReduction_117
-happyReduction_117 (happy_x_4 `HappyStk`
+happyReduce_123 = happyReduce 4# 14# happyReduction_123
+happyReduction_123 (happy_x_4 `HappyStk`
happy_x_3 `HappyStk`
happy_x_2 `HappyStk`
happy_x_1 `HappyStk`
@@ -2154,8 +2231,8 @@ happyReduction_117 (happy_x_4 `HappyStk`
(map (hide . setRelevance NonStrict . defaultArg) happy_var_3
) `HappyStk` happyRest}
-happyReduce_118 = happyReduce 5# 14# happyReduction_118
-happyReduction_118 (happy_x_5 `HappyStk`
+happyReduce_124 = happyReduce 5# 14# happyReduction_124
+happyReduction_124 (happy_x_5 `HappyStk`
happy_x_4 `HappyStk`
happy_x_3 `HappyStk`
happy_x_2 `HappyStk`
@@ -2167,8 +2244,8 @@ happyReduction_118 (happy_x_5 `HappyStk`
(map (makeInstance . setRelevance NonStrict . defaultArg) happy_var_3 ++ happy_var_5
) `HappyStk` happyRest}}
-happyReduce_119 = happyReduce 4# 14# happyReduction_119
-happyReduction_119 (happy_x_4 `HappyStk`
+happyReduce_125 = happyReduce 4# 14# happyReduction_125
+happyReduction_125 (happy_x_4 `HappyStk`
happy_x_3 `HappyStk`
happy_x_2 `HappyStk`
happy_x_1 `HappyStk`
@@ -2178,43 +2255,43 @@ happyReduction_119 (happy_x_4 `HappyStk`
(map (makeInstance . setRelevance NonStrict . defaultArg) happy_var_3
) `HappyStk` happyRest}
-happyReduce_120 = happyMonadReduce 1# 15# happyReduction_120
-happyReduction_120 (happy_x_1 `HappyStk`
+happyReduce_126 = happyMonadReduce 1# 15# happyReduction_126
+happyReduction_126 (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_121 = happySpecReduce_1 15# happyReduction_121
-happyReduction_121 happy_x_1
+happyReduce_127 = happySpecReduce_1 15# happyReduction_127
+happyReduction_127 happy_x_1
= case happyOut15 happy_x_1 of { happy_var_1 ->
happyIn21
(QName happy_var_1
)}
-happyReduce_122 = happySpecReduce_1 16# happyReduction_122
-happyReduction_122 happy_x_1
+happyReduce_128 = happySpecReduce_1 16# happyReduction_128
+happyReduction_128 happy_x_1
= case happyOut21 happy_x_1 of { happy_var_1 ->
happyIn22
(happy_var_1
)}
-happyReduce_123 = happySpecReduce_1 17# happyReduction_123
-happyReduction_123 happy_x_1
+happyReduce_129 = happySpecReduce_1 17# happyReduction_129
+happyReduction_129 happy_x_1
= case happyOut15 happy_x_1 of { happy_var_1 ->
happyIn23
(happy_var_1
)}
-happyReduce_124 = happySpecReduce_1 17# happyReduction_124
-happyReduction_124 happy_x_1
+happyReduce_130 = happySpecReduce_1 17# happyReduction_130
+happyReduction_130 happy_x_1
= case happyOutTok happy_x_1 of { (TokSymbol SymUnderscore happy_var_1) ->
happyIn23
(Name (getRange happy_var_1) [Hole]
)}
-happyReduce_125 = happySpecReduce_2 18# happyReduction_125
-happyReduction_125 happy_x_2
+happyReduce_131 = happySpecReduce_2 18# happyReduction_131
+happyReduction_131 happy_x_2
happy_x_1
= case happyOut23 happy_x_1 of { happy_var_1 ->
case happyOut24 happy_x_2 of { happy_var_2 ->
@@ -2222,15 +2299,15 @@ happyReduction_125 happy_x_2
(happy_var_1 : happy_var_2
)}}
-happyReduce_126 = happySpecReduce_1 18# happyReduction_126
-happyReduction_126 happy_x_1
+happyReduce_132 = happySpecReduce_1 18# happyReduction_132
+happyReduction_132 happy_x_1
= case happyOut23 happy_x_1 of { happy_var_1 ->
happyIn24
([happy_var_1]
)}
-happyReduce_127 = happySpecReduce_1 19# happyReduction_127
-happyReduction_127 happy_x_1
+happyReduce_133 = happySpecReduce_1 19# happyReduction_133
+happyReduction_133 happy_x_1
= case happyOut26 happy_x_1 of { happy_var_1 ->
happyIn25
(case happy_var_1 of
@@ -2238,10 +2315,10 @@ happyReduction_127 happy_x_1
Right _ -> fail $ "expected sequence of bound identifiers, not absurd pattern"
)}
-happyReduce_128 = happyMonadReduce 1# 20# happyReduction_128
-happyReduction_128 (happy_x_1 `HappyStk`
+happyReduce_134 = happyMonadReduce 1# 20# happyReduction_134
+happyReduction_134 (happy_x_1 `HappyStk`
happyRest) tk
- = happyThen (case happyOut33 happy_x_1 of { happy_var_1 ->
+ = happyThen (case happyOut34 happy_x_1 of { happy_var_1 ->
(
let getName (Ident (QName x)) = Just x
getName (Underscore r _) = Just (Name r [Hole])
@@ -2260,13 +2337,13 @@ happyReduction_128 (happy_x_1 `HappyStk`
_ -> fail $ "expected sequence of bound identifiers")}
) (\r -> happyReturn (happyIn26 r))
-happyReduce_129 = happySpecReduce_0 21# happyReduction_129
-happyReduction_129 = happyIn27
+happyReduce_135 = happySpecReduce_0 21# happyReduction_135
+happyReduction_135 = happyIn27
([]
)
-happyReduce_130 = happySpecReduce_2 21# happyReduction_130
-happyReduction_130 happy_x_2
+happyReduce_136 = happySpecReduce_2 21# happyReduction_136
+happyReduction_136 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 ->
@@ -2274,155 +2351,162 @@ happyReduction_130 happy_x_2
(snd happy_var_1 : happy_var_2
)}}
-happyReduce_131 = happySpecReduce_1 22# happyReduction_131
-happyReduction_131 happy_x_1
+happyReduce_137 = happySpecReduce_1 22# happyReduction_137
+happyReduction_137 happy_x_1
= case happyOutTok happy_x_1 of { (TokString happy_var_1) ->
happyIn28
(snd happy_var_1
)}
-happyReduce_132 = happyMonadReduce 1# 23# happyReduction_132
-happyReduction_132 (happy_x_1 `HappyStk`
+happyReduce_138 = happyMonadReduce 1# 23# happyReduction_138
+happyReduction_138 (happy_x_1 `HappyStk`
happyRest) tk
= happyThen (case happyOutTok happy_x_1 of { (TokString happy_var_1) ->
- ( fmap QName (mkName happy_var_1))}
+ ( mkName happy_var_1)}
) (\r -> happyReturn (happyIn29 r))
-happyReduce_133 = happySpecReduce_2 24# happyReduction_133
-happyReduction_133 happy_x_2
- happy_x_1
- = case happyOut43 happy_x_1 of { happy_var_1 ->
- case happyOut30 happy_x_2 of { happy_var_2 ->
- happyIn30
+happyReduce_139 = happyMonadReduce 1# 24# happyReduction_139
+happyReduction_139 (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
+ happy_x_1
+ = case happyOut44 happy_x_1 of { happy_var_1 ->
+ case happyOut31 happy_x_2 of { happy_var_2 ->
+ happyIn31
(Pi happy_var_1 happy_var_2
)}}
-happyReduce_134 = happySpecReduce_3 24# happyReduction_134
-happyReduction_134 happy_x_3
+happyReduce_141 = happySpecReduce_3 25# happyReduction_141
+happyReduction_141 happy_x_3
happy_x_2
happy_x_1
- = case happyOut56 happy_x_2 of { happy_var_2 ->
- case happyOut30 happy_x_3 of { happy_var_3 ->
- happyIn30
+ = case happyOut57 happy_x_2 of { happy_var_2 ->
+ case happyOut31 happy_x_3 of { happy_var_3 ->
+ happyIn31
(forallPi happy_var_2 happy_var_3
)}}
-happyReduce_135 = happySpecReduce_3 24# happyReduction_135
-happyReduction_135 happy_x_3
+happyReduce_142 = happySpecReduce_3 25# happyReduction_142
+happyReduction_142 happy_x_3
happy_x_2
happy_x_1
- = case happyOut36 happy_x_1 of { happy_var_1 ->
+ = case happyOut37 happy_x_1 of { happy_var_1 ->
case happyOutTok happy_x_2 of { (TokSymbol SymArrow happy_var_2) ->
- case happyOut30 happy_x_3 of { happy_var_3 ->
- happyIn30
+ case happyOut31 happy_x_3 of { happy_var_3 ->
+ happyIn31
(Fun (getRange (happy_var_1,happy_var_2,happy_var_3))
(RawApp (getRange happy_var_1) happy_var_1)
happy_var_3
)}}}
-happyReduce_136 = happySpecReduce_3 24# happyReduction_136
-happyReduction_136 happy_x_3
+happyReduce_143 = happySpecReduce_3 25# happyReduction_143
+happyReduction_143 happy_x_3
happy_x_2
happy_x_1
- = case happyOut31 happy_x_1 of { happy_var_1 ->
+ = case happyOut32 happy_x_1 of { happy_var_1 ->
case happyOutTok happy_x_2 of { (TokSymbol SymEqual happy_var_2) ->
- case happyOut30 happy_x_3 of { happy_var_3 ->
- happyIn30
+ case happyOut31 happy_x_3 of { happy_var_3 ->
+ happyIn31
(Equal (getRange (happy_var_1, happy_var_2, happy_var_3)) happy_var_1 happy_var_3
)}}}
-happyReduce_137 = happySpecReduce_1 24# happyReduction_137
-happyReduction_137 happy_x_1
- = case happyOut31 happy_x_1 of { happy_var_1 ->
- happyIn30
+happyReduce_144 = happySpecReduce_1 25# happyReduction_144
+happyReduction_144 happy_x_1
+ = case happyOut32 happy_x_1 of { happy_var_1 ->
+ happyIn31
(happy_var_1
)}
-happyReduce_138 = happyMonadReduce 1# 25# happyReduction_138
-happyReduction_138 (happy_x_1 `HappyStk`
+happyReduce_145 = happyMonadReduce 1# 26# happyReduction_145
+happyReduction_145 (happy_x_1 `HappyStk`
happyRest) tk
- = happyThen (case happyOut32 happy_x_1 of { happy_var_1 ->
+ = 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"
})}
- ) (\r -> happyReturn (happyIn31 r))
+ ) (\r -> happyReturn (happyIn32 r))
-happyReduce_139 = happySpecReduce_3 26# happyReduction_139
-happyReduction_139 happy_x_3
+happyReduce_146 = happySpecReduce_3 27# happyReduction_146
+happyReduction_146 happy_x_3
happy_x_2
happy_x_1
- = case happyOut36 happy_x_1 of { happy_var_1 ->
- case happyOut32 happy_x_3 of { happy_var_3 ->
- happyIn32
+ = case happyOut37 happy_x_1 of { happy_var_1 ->
+ case happyOut33 happy_x_3 of { happy_var_3 ->
+ happyIn33
(RawApp (getRange happy_var_1) happy_var_1 : happy_var_3
)}}
-happyReduce_140 = happySpecReduce_1 26# happyReduction_140
-happyReduction_140 happy_x_1
- = case happyOut33 happy_x_1 of { happy_var_1 ->
- happyIn32
+happyReduce_147 = happySpecReduce_1 27# happyReduction_147
+happyReduction_147 happy_x_1
+ = case happyOut34 happy_x_1 of { happy_var_1 ->
+ happyIn33
([RawApp (getRange happy_var_1) happy_var_1]
)}
-happyReduce_141 = happySpecReduce_1 27# happyReduction_141
-happyReduction_141 happy_x_1
- = case happyOut34 happy_x_1 of { happy_var_1 ->
- happyIn33
+happyReduce_148 = happySpecReduce_1 28# happyReduction_148
+happyReduction_148 happy_x_1
+ = case happyOut35 happy_x_1 of { happy_var_1 ->
+ happyIn34
([happy_var_1]
)}
-happyReduce_142 = happySpecReduce_2 27# happyReduction_142
-happyReduction_142 happy_x_2
+happyReduce_149 = happySpecReduce_2 28# happyReduction_149
+happyReduction_149 happy_x_2
happy_x_1
- = case happyOut39 happy_x_1 of { happy_var_1 ->
- case happyOut33 happy_x_2 of { happy_var_2 ->
- happyIn33
+ = case happyOut40 happy_x_1 of { happy_var_1 ->
+ case happyOut34 happy_x_2 of { happy_var_2 ->
+ happyIn34
(happy_var_1 : happy_var_2
)}}
-happyReduce_143 = happySpecReduce_3 28# happyReduction_143
-happyReduction_143 happy_x_3
+happyReduce_150 = happySpecReduce_3 29# happyReduction_150
+happyReduction_150 happy_x_3
happy_x_2
happy_x_1
= case happyOutTok happy_x_1 of { (TokSymbol SymLambda happy_var_1) ->
- case happyOut48 happy_x_2 of { happy_var_2 ->
- case happyOut30 happy_x_3 of { happy_var_3 ->
- happyIn34
+ case happyOut49 happy_x_2 of { happy_var_2 ->
+ case happyOut31 happy_x_3 of { happy_var_3 ->
+ happyIn35
(Lam (getRange (happy_var_1,happy_var_2,happy_var_3)) happy_var_2 happy_var_3
)}}}
-happyReduce_144 = happySpecReduce_1 28# happyReduction_144
-happyReduction_144 happy_x_1
- = case happyOut35 happy_x_1 of { happy_var_1 ->
- happyIn34
+happyReduce_151 = happySpecReduce_1 29# happyReduction_151
+happyReduction_151 happy_x_1
+ = case happyOut36 happy_x_1 of { happy_var_1 ->
+ happyIn35
(happy_var_1
)}
-happyReduce_145 = happyReduce 4# 28# happyReduction_145
-happyReduction_145 (happy_x_4 `HappyStk`
+happyReduce_152 = happyReduce 4# 29# happyReduction_152
+happyReduction_152 (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 happyOut136 happy_x_2 of { happy_var_2 ->
+ case happyOut139 happy_x_2 of { happy_var_2 ->
case happyOutTok happy_x_3 of { (TokKeyword KwIn happy_var_3) ->
- case happyOut30 happy_x_4 of { happy_var_4 ->
- happyIn34
+ 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_146 = happySpecReduce_1 28# happyReduction_146
-happyReduction_146 happy_x_1
- = case happyOut39 happy_x_1 of { happy_var_1 ->
- happyIn34
+happyReduce_153 = happySpecReduce_1 29# happyReduction_153
+happyReduction_153 happy_x_1
+ = case happyOut40 happy_x_1 of { happy_var_1 ->
+ happyIn35
(happy_var_1
)}
-happyReduce_147 = happyReduce 4# 28# happyReduction_147
-happyReduction_147 (happy_x_4 `HappyStk`
+happyReduce_154 = happyReduce 4# 29# happyReduction_154
+happyReduction_154 (happy_x_4 `HappyStk`
happy_x_3 `HappyStk`
happy_x_2 `HappyStk`
happy_x_1 `HappyStk`
@@ -2430,13 +2514,13 @@ happyReduction_147 (happy_x_4 `HappyStk`
= case happyOutTok happy_x_1 of { (TokKeyword KwQuoteGoal happy_var_1) ->
case happyOut15 happy_x_2 of { happy_var_2 ->
case happyOutTok happy_x_3 of { (TokKeyword KwIn happy_var_3) ->
- case happyOut30 happy_x_4 of { happy_var_4 ->
- happyIn34
+ case happyOut31 happy_x_4 of { happy_var_4 ->
+ happyIn35
(QuoteGoal (getRange (happy_var_1,happy_var_2,happy_var_3,happy_var_4)) happy_var_2 happy_var_4
) `HappyStk` happyRest}}}}
-happyReduce_148 = happyReduce 4# 28# happyReduction_148
-happyReduction_148 (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`
@@ -2444,31 +2528,54 @@ happyReduction_148 (happy_x_4 `HappyStk`
= case happyOutTok happy_x_1 of { (TokKeyword KwQuoteContext happy_var_1) ->
case happyOut15 happy_x_2 of { happy_var_2 ->
case happyOutTok happy_x_3 of { (TokKeyword KwIn happy_var_3) ->
- case happyOut30 happy_x_4 of { happy_var_4 ->
- happyIn34
+ case happyOut31 happy_x_4 of { happy_var_4 ->
+ happyIn35
(QuoteContext (getRange (happy_var_1,happy_var_2,happy_var_3,happy_var_4)) happy_var_2 happy_var_4
) `HappyStk` happyRest}}}}
-happyReduce_149 = happyReduce 4# 29# happyReduction_149
-happyReduction_149 (happy_x_4 `HappyStk`
+happyReduce_156 = happySpecReduce_2 29# happyReduction_156
+happyReduction_156 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 ->
+ happyIn35
+ (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`
+ happy_x_3 `HappyStk`
+ happy_x_2 `HappyStk`
+ happy_x_1 `HappyStk`
+ happyRest)
+ = case happyOutTok happy_x_1 of { (TokKeyword KwTactic happy_var_1) ->
+ case happyOut37 happy_x_2 of { happy_var_2 ->
+ case happyOutTok happy_x_3 of { (TokSymbol SymBar happy_var_3) ->
+ case happyOut33 happy_x_4 of { happy_var_4 ->
+ happyIn35
+ (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`
happy_x_3 `HappyStk`
happy_x_2 `HappyStk`
happy_x_1 `HappyStk`
happyRest)
= case happyOutTok happy_x_1 of { (TokSymbol SymLambda happy_var_1) ->
case happyOutTok happy_x_2 of { (TokSymbol SymOpenBrace happy_var_2) ->
- case happyOut55 happy_x_3 of { happy_var_3 ->
+ case happyOut56 happy_x_3 of { happy_var_3 ->
case happyOutTok happy_x_4 of { (TokSymbol SymCloseBrace happy_var_4) ->
- happyIn35
+ happyIn36
(ExtendedLam (getRange (happy_var_1,happy_var_2,happy_var_3,happy_var_4)) (reverse happy_var_3)
) `HappyStk` happyRest}}}}
-happyReduce_150 = happyMonadReduce 2# 29# happyReduction_150
-happyReduction_150 (happy_x_2 `HappyStk`
+happyReduce_159 = happyMonadReduce 2# 30# happyReduction_159
+happyReduction_159 (happy_x_2 `HappyStk`
happy_x_1 `HappyStk`
happyRest) tk
= happyThen (case happyOutTok happy_x_1 of { (TokSymbol SymLambda happy_var_1) ->
- case happyOut49 happy_x_2 of { happy_var_2 ->
+ case happyOut50 happy_x_2 of { happy_var_2 ->
( case happy_var_2 of
Left (bs, h) -> if null bs then return $ AbsurdLam r h else
return $ Lam r bs (AbsurdLam r h)
@@ -2477,460 +2584,460 @@ happyReduction_150 (happy_x_2 `HappyStk`
p <- exprToLHS (RawApp (getRange es) es);
return $ ExtendedLam (fuseRange happy_var_1 es)
[(p [] [], AbsurdRHS, NoWhere)])}}
- ) (\r -> happyReturn (happyIn35 r))
+ ) (\r -> happyReturn (happyIn36 r))
-happyReduce_151 = happySpecReduce_1 30# happyReduction_151
-happyReduction_151 happy_x_1
- = case happyOut39 happy_x_1 of { happy_var_1 ->
- happyIn36
+happyReduce_160 = happySpecReduce_1 31# happyReduction_160
+happyReduction_160 happy_x_1
+ = case happyOut40 happy_x_1 of { happy_var_1 ->
+ happyIn37
([happy_var_1]
)}
-happyReduce_152 = happySpecReduce_2 30# happyReduction_152
-happyReduction_152 happy_x_2
+happyReduce_161 = happySpecReduce_2 31# happyReduction_161
+happyReduction_161 happy_x_2
happy_x_1
- = case happyOut39 happy_x_1 of { happy_var_1 ->
- case happyOut36 happy_x_2 of { happy_var_2 ->
- happyIn36
+ = case happyOut40 happy_x_1 of { happy_var_1 ->
+ case happyOut37 happy_x_2 of { happy_var_2 ->
+ happyIn37
(happy_var_1 : happy_var_2
)}}
-happyReduce_153 = happySpecReduce_3 31# happyReduction_153
-happyReduction_153 happy_x_3
+happyReduce_162 = happySpecReduce_3 32# happyReduction_162
+happyReduction_162 happy_x_3
happy_x_2
happy_x_1
= case happyOutTok happy_x_1 of { (TokSymbol SymOpenBrace happy_var_1) ->
- case happyOut30 happy_x_2 of { happy_var_2 ->
+ case happyOut31 happy_x_2 of { happy_var_2 ->
case happyOutTok happy_x_3 of { (TokSymbol SymCloseBrace happy_var_3) ->
- happyIn37
+ happyIn38
(HiddenArg (getRange (happy_var_1,happy_var_2,happy_var_3)) (maybeNamed happy_var_2)
)}}}
-happyReduce_154 = happySpecReduce_2 31# happyReduction_154
-happyReduction_154 happy_x_2
+happyReduce_163 = happySpecReduce_2 32# happyReduction_163
+happyReduction_163 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) ->
- happyIn37
+ happyIn38
(let r = fuseRange happy_var_1 happy_var_2 in HiddenArg r $ unnamed $ Absurd r
)}}
-happyReduce_155 = happySpecReduce_1 32# happyReduction_155
-happyReduction_155 happy_x_1
+happyReduce_164 = happySpecReduce_1 33# happyReduction_164
+happyReduction_164 happy_x_1
= case happyOut21 happy_x_1 of { happy_var_1 ->
- happyIn38
+ happyIn39
(Ident happy_var_1
)}
-happyReduce_156 = happySpecReduce_1 32# happyReduction_156
-happyReduction_156 happy_x_1
+happyReduce_165 = happySpecReduce_1 33# happyReduction_165
+happyReduction_165 happy_x_1
= case happyOutTok happy_x_1 of { (TokLiteral happy_var_1) ->
- happyIn38
+ happyIn39
(Lit happy_var_1
)}
-happyReduce_157 = happySpecReduce_1 32# happyReduction_157
-happyReduction_157 happy_x_1
+happyReduce_166 = happySpecReduce_1 33# happyReduction_166
+happyReduction_166 happy_x_1
= case happyOutTok happy_x_1 of { (TokSymbol SymQuestionMark happy_var_1) ->
- happyIn38
+ happyIn39
(QuestionMark (getRange happy_var_1) Nothing
)}
-happyReduce_158 = happySpecReduce_1 32# happyReduction_158
-happyReduction_158 happy_x_1
+happyReduce_167 = happySpecReduce_1 33# happyReduction_167
+happyReduction_167 happy_x_1
= case happyOutTok happy_x_1 of { (TokSymbol SymUnderscore happy_var_1) ->
- happyIn38
+ happyIn39
(Underscore (getRange happy_var_1) Nothing
)}
-happyReduce_159 = happySpecReduce_1 32# happyReduction_159
-happyReduction_159 happy_x_1
+happyReduce_168 = happySpecReduce_1 33# happyReduction_168
+happyReduction_168 happy_x_1
= case happyOutTok happy_x_1 of { (TokKeyword KwProp happy_var_1) ->
- happyIn38
+ happyIn39
(Prop (getRange happy_var_1)
)}
-happyReduce_160 = happySpecReduce_1 32# happyReduction_160
-happyReduction_160 happy_x_1
+happyReduce_169 = happySpecReduce_1 33# happyReduction_169
+happyReduction_169 happy_x_1
= case happyOutTok happy_x_1 of { (TokKeyword KwSet happy_var_1) ->
- happyIn38
+ happyIn39
(Set (getRange happy_var_1)
)}
-happyReduce_161 = happySpecReduce_1 32# happyReduction_161
-happyReduction_161 happy_x_1
+happyReduce_170 = happySpecReduce_1 33# happyReduction_170
+happyReduction_170 happy_x_1
= case happyOutTok happy_x_1 of { (TokKeyword KwQuote happy_var_1) ->
- happyIn38
+ happyIn39
(Quote (getRange happy_var_1)
)}
-happyReduce_162 = happySpecReduce_1 32# happyReduction_162
-happyReduction_162 happy_x_1
+happyReduce_171 = happySpecReduce_1 33# happyReduction_171
+happyReduction_171 happy_x_1
= case happyOutTok happy_x_1 of { (TokKeyword KwQuoteTerm happy_var_1) ->
- happyIn38
+ happyIn39
(QuoteTerm (getRange happy_var_1)
)}
-happyReduce_163 = happySpecReduce_1 32# happyReduction_163
-happyReduction_163 happy_x_1
+happyReduce_172 = happySpecReduce_1 33# happyReduction_172
+happyReduction_172 happy_x_1
= case happyOutTok happy_x_1 of { (TokKeyword KwUnquote happy_var_1) ->
- happyIn38
+ happyIn39
(Unquote (getRange happy_var_1)
)}
-happyReduce_164 = happySpecReduce_1 32# happyReduction_164
-happyReduction_164 happy_x_1
+happyReduce_173 = happySpecReduce_1 33# happyReduction_173
+happyReduction_173 happy_x_1
= case happyOutTok happy_x_1 of { (TokSetN happy_var_1) ->
- happyIn38
+ happyIn39
(SetN (getRange (fst happy_var_1)) (snd happy_var_1)
)}
-happyReduce_165 = happySpecReduce_3 32# happyReduction_165
-happyReduction_165 happy_x_3
+happyReduce_174 = happySpecReduce_3 33# happyReduction_174
+happyReduction_174 happy_x_3
happy_x_2
happy_x_1
= case happyOutTok happy_x_1 of { (TokSymbol SymDoubleOpenBrace happy_var_1) ->
- case happyOut30 happy_x_2 of { happy_var_2 ->
+ case happyOut31 happy_x_2 of { happy_var_2 ->
case happyOut17 happy_x_3 of { happy_var_3 ->
- happyIn38
+ happyIn39
(InstanceArg (getRange (happy_var_1,happy_var_2,happy_var_3))
(maybeNamed happy_var_2)
)}}}
-happyReduce_166 = happySpecReduce_3 32# happyReduction_166
-happyReduction_166 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 SymOpenParen happy_var_1) ->
- case happyOut30 happy_x_2 of { happy_var_2 ->
+ case happyOut31 happy_x_2 of { happy_var_2 ->
case happyOutTok happy_x_3 of { (TokSymbol SymCloseParen happy_var_3) ->
- happyIn38
+ happyIn39
(Paren (getRange (happy_var_1,happy_var_2,happy_var_3)) happy_var_2
)}}}
-happyReduce_167 = happySpecReduce_2 32# happyReduction_167
-happyReduction_167 happy_x_2
+happyReduce_176 = happySpecReduce_2 33# happyReduction_176
+happyReduction_176 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) ->
- happyIn38
+ happyIn39
(Absurd (fuseRange happy_var_1 happy_var_2)
)}}
-happyReduce_168 = happySpecReduce_2 32# happyReduction_168
-happyReduction_168 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 SymDoubleOpenBrace happy_var_1) ->
case happyOut17 happy_x_2 of { happy_var_2 ->
- happyIn38
+ happyIn39
(let r = fuseRange happy_var_1 happy_var_2 in InstanceArg r $ unnamed $ Absurd r
)}}
-happyReduce_169 = happySpecReduce_3 32# happyReduction_169
-happyReduction_169 happy_x_3
+happyReduce_178 = happySpecReduce_3 33# happyReduction_178
+happyReduction_178 happy_x_3
happy_x_2
happy_x_1
= case happyOut15 happy_x_1 of { happy_var_1 ->
case happyOutTok happy_x_2 of { (TokSymbol SymAs happy_var_2) ->
- case happyOut39 happy_x_3 of { happy_var_3 ->
- happyIn38
+ case happyOut40 happy_x_3 of { happy_var_3 ->
+ happyIn39
(As (getRange (happy_var_1,happy_var_2,happy_var_3)) happy_var_1 happy_var_3
)}}}
-happyReduce_170 = happySpecReduce_2 32# happyReduction_170
-happyReduction_170 happy_x_2
+happyReduce_179 = happySpecReduce_2 33# happyReduction_179
+happyReduction_179 happy_x_2
happy_x_1
= case happyOutTok happy_x_1 of { (TokSymbol SymDot happy_var_1) ->
- case happyOut39 happy_x_2 of { happy_var_2 ->
- happyIn38
+ case happyOut40 happy_x_2 of { happy_var_2 ->
+ happyIn39
(Dot (fuseRange happy_var_1 happy_var_2) happy_var_2
)}}
-happyReduce_171 = happyReduce 4# 32# happyReduction_171
-happyReduction_171 (happy_x_4 `HappyStk`
+happyReduce_180 = happyReduce 4# 33# happyReduction_180
+happyReduction_180 (happy_x_4 `HappyStk`
happy_x_3 `HappyStk`
happy_x_2 `HappyStk`
happy_x_1 `HappyStk`
happyRest)
= case happyOutTok happy_x_1 of { (TokKeyword KwRecord happy_var_1) ->
case happyOutTok happy_x_2 of { (TokSymbol SymOpenBrace happy_var_2) ->
- case happyOut40 happy_x_3 of { happy_var_3 ->
+ case happyOut41 happy_x_3 of { happy_var_3 ->
case happyOutTok happy_x_4 of { (TokSymbol SymCloseBrace happy_var_4) ->
- happyIn38
+ happyIn39
(Rec (getRange (happy_var_1,happy_var_2,happy_var_3,happy_var_4)) happy_var_3
) `HappyStk` happyRest}}}}
-happyReduce_172 = happyReduce 5# 32# happyReduction_172
-happyReduction_172 (happy_x_5 `HappyStk`
+happyReduce_181 = happyReduce 5# 33# happyReduction_181
+happyReduction_181 (happy_x_5 `HappyStk`
happy_x_4 `HappyStk`
happy_x_3 `HappyStk`
happy_x_2 `HappyStk`
happy_x_1 `HappyStk`
happyRest)
= case happyOutTok happy_x_1 of { (TokKeyword KwRecord happy_var_1) ->
- case happyOut38 happy_x_2 of { happy_var_2 ->
+ case happyOut39 happy_x_2 of { happy_var_2 ->
case happyOutTok happy_x_3 of { (TokSymbol SymOpenBrace happy_var_3) ->
- case happyOut40 happy_x_4 of { happy_var_4 ->
+ case happyOut41 happy_x_4 of { happy_var_4 ->
case happyOutTok happy_x_5 of { (TokSymbol SymCloseBrace happy_var_5) ->
- happyIn38
+ happyIn39
(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_173 = happySpecReduce_1 33# happyReduction_173
-happyReduction_173 happy_x_1
- = case happyOut37 happy_x_1 of { happy_var_1 ->
- happyIn39
+happyReduce_182 = happySpecReduce_1 34# happyReduction_182
+happyReduction_182 happy_x_1
+ = case happyOut38 happy_x_1 of { happy_var_1 ->
+ happyIn40
(happy_var_1
)}
-happyReduce_174 = happySpecReduce_1 33# happyReduction_174
-happyReduction_174 happy_x_1
- = case happyOut38 happy_x_1 of { happy_var_1 ->
- happyIn39
+happyReduce_183 = happySpecReduce_1 34# happyReduction_183
+happyReduction_183 happy_x_1
+ = case happyOut39 happy_x_1 of { happy_var_1 ->
+ happyIn40
(happy_var_1
)}
-happyReduce_175 = happySpecReduce_0 34# happyReduction_175
-happyReduction_175 = happyIn40
+happyReduce_184 = happySpecReduce_0 35# happyReduction_184
+happyReduction_184 = happyIn41
([]
)
-happyReduce_176 = happySpecReduce_1 34# happyReduction_176
-happyReduction_176 happy_x_1
- = case happyOut41 happy_x_1 of { happy_var_1 ->
- happyIn40
+happyReduce_185 = happySpecReduce_1 35# happyReduction_185
+happyReduction_185 happy_x_1
+ = case happyOut42 happy_x_1 of { happy_var_1 ->
+ happyIn41
(happy_var_1
)}
-happyReduce_177 = happySpecReduce_1 35# happyReduction_177
-happyReduction_177 happy_x_1
- = case happyOut42 happy_x_1 of { happy_var_1 ->
- happyIn41
+happyReduce_186 = happySpecReduce_1 36# happyReduction_186
+happyReduction_186 happy_x_1
+ = case happyOut43 happy_x_1 of { happy_var_1 ->
+ happyIn42
([happy_var_1]
)}
-happyReduce_178 = happySpecReduce_3 35# happyReduction_178
-happyReduction_178 happy_x_3
+happyReduce_187 = happySpecReduce_3 36# happyReduction_187
+happyReduction_187 happy_x_3
happy_x_2
happy_x_1
- = case happyOut42 happy_x_1 of { happy_var_1 ->
- case happyOut41 happy_x_3 of { happy_var_3 ->
- happyIn41
+ = case happyOut43 happy_x_1 of { happy_var_1 ->
+ case happyOut42 happy_x_3 of { happy_var_3 ->
+ happyIn42
(happy_var_1 : happy_var_3
)}}
-happyReduce_179 = happySpecReduce_3 36# happyReduction_179
-happyReduction_179 happy_x_3
+happyReduce_188 = happySpecReduce_3 37# happyReduction_188
+happyReduction_188 happy_x_3
happy_x_2
happy_x_1
= case happyOut15 happy_x_1 of { happy_var_1 ->
- case happyOut30 happy_x_3 of { happy_var_3 ->
- happyIn42
+ case happyOut31 happy_x_3 of { happy_var_3 ->
+ happyIn43
((happy_var_1, happy_var_3)
)}}
-happyReduce_180 = happySpecReduce_2 37# happyReduction_180
-happyReduction_180 happy_x_2
+happyReduce_189 = happySpecReduce_2 38# happyReduction_189
+happyReduction_189 happy_x_2
happy_x_1
- = case happyOut44 happy_x_1 of { happy_var_1 ->
- happyIn43
+ = case happyOut45 happy_x_1 of { happy_var_1 ->
+ happyIn44
(happy_var_1
)}
-happyReduce_181 = happySpecReduce_1 38# happyReduction_181
-happyReduction_181 happy_x_1
- = case happyOut45 happy_x_1 of { happy_var_1 ->
- happyIn44
+happyReduce_190 = happySpecReduce_1 39# happyReduction_190
+happyReduction_190 happy_x_1
+ = case happyOut46 happy_x_1 of { happy_var_1 ->
+ happyIn45
({-TeleBind-} happy_var_1
)}
-happyReduce_182 = happySpecReduce_2 39# happyReduction_182
-happyReduction_182 happy_x_2
+happyReduce_191 = happySpecReduce_2 40# happyReduction_191
+happyReduction_191 happy_x_2
happy_x_1
- = case happyOut46 happy_x_1 of { happy_var_1 ->
- case happyOut45 happy_x_2 of { happy_var_2 ->
- happyIn45
+ = case happyOut47 happy_x_1 of { happy_var_1 ->
+ case happyOut46 happy_x_2 of { happy_var_2 ->
+ happyIn46
(happy_var_1 : happy_var_2
)}}
-happyReduce_183 = happySpecReduce_1 39# happyReduction_183
-happyReduction_183 happy_x_1
- = case happyOut46 happy_x_1 of { happy_var_1 ->
- happyIn45
+happyReduce_192 = happySpecReduce_1 40# happyReduction_192
+happyReduction_192 happy_x_1
+ = case happyOut47 happy_x_1 of { happy_var_1 ->
+ happyIn46
([happy_var_1]
)}
-happyReduce_184 = happyReduce 4# 40# happyReduction_184
-happyReduction_184 (happy_x_4 `HappyStk`
+happyReduce_193 = happyReduce 4# 41# happyReduction_193
+happyReduction_193 (happy_x_4 `HappyStk`
happy_x_3 `HappyStk`
happy_x_2 `HappyStk`
happy_x_1 `HappyStk`
happyRest)
= case happyOutTok happy_x_2 of { (TokSymbol SymOpenParen happy_var_2) ->
- case happyOut47 happy_x_3 of { happy_var_3 ->
+ case happyOut48 happy_x_3 of { happy_var_3 ->
case happyOutTok happy_x_4 of { (TokSymbol SymCloseParen happy_var_4) ->
- happyIn46
+ happyIn47
(TypedBindings (getRange (happy_var_2,happy_var_3,happy_var_4))
(setRelevance Irrelevant $ defaultColoredArg happy_var_3)
) `HappyStk` happyRest}}}
-happyReduce_185 = happyReduce 4# 40# happyReduction_185
-happyReduction_185 (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`
happyRest)
= case happyOutTok happy_x_2 of { (TokSymbol SymOpenBrace happy_var_2) ->
- case happyOut47 happy_x_3 of { happy_var_3 ->
+ case happyOut48 happy_x_3 of { happy_var_3 ->
case happyOutTok happy_x_4 of { (TokSymbol SymCloseBrace happy_var_4) ->
- happyIn46
+ happyIn47
(TypedBindings (getRange (happy_var_2,happy_var_3,happy_var_4))
(hide $ setRelevance Irrelevant $ defaultColoredArg happy_var_3)
) `HappyStk` happyRest}}}
-happyReduce_186 = happyReduce 4# 40# happyReduction_186
-happyReduction_186 (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`
happyRest)
= case happyOutTok happy_x_2 of { (TokSymbol SymDoubleOpenBrace happy_var_2) ->
- case happyOut47 happy_x_3 of { happy_var_3 ->
+ case happyOut48 happy_x_3 of { happy_var_3 ->
case happyOut17 happy_x_4 of { happy_var_4 ->
- happyIn46
+ happyIn47
(TypedBindings (getRange (happy_var_2,happy_var_3,happy_var_4))
(makeInstance $ setRelevance Irrelevant $ defaultColoredArg happy_var_3)
) `HappyStk` happyRest}}}
-happyReduce_187 = happyReduce 4# 40# happyReduction_187
-happyReduction_187 (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`
happyRest)
= case happyOutTok happy_x_2 of { (TokSymbol SymOpenParen happy_var_2) ->
- case happyOut47 happy_x_3 of { happy_var_3 ->
+ case happyOut48 happy_x_3 of { happy_var_3 ->
case happyOutTok happy_x_4 of { (TokSymbol SymCloseParen happy_var_4) ->
- happyIn46
+ happyIn47
(TypedBindings (getRange (happy_var_2,happy_var_3,happy_var_4))
(setRelevance NonStrict $ defaultColoredArg happy_var_3)
) `HappyStk` happyRest}}}
-happyReduce_188 = happyReduce 4# 40# happyReduction_188
-happyReduction_188 (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`
happyRest)
= case happyOutTok happy_x_2 of { (TokSymbol SymOpenBrace happy_var_2) ->
- case happyOut47 happy_x_3 of { happy_var_3 ->
+ case happyOut48 happy_x_3 of { happy_var_3 ->
case happyOutTok happy_x_4 of { (TokSymbol SymCloseBrace happy_var_4) ->
- happyIn46
+ happyIn47
(TypedBindings (getRange (happy_var_2,happy_var_3,happy_var_4))
(hide $ setRelevance NonStrict $ defaultColoredArg happy_var_3)
) `HappyStk` happyRest}}}
-happyReduce_189 = happyReduce 4# 40# happyReduction_189
-happyReduction_189 (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`
happyRest)
= case happyOutTok happy_x_2 of { (TokSymbol SymDoubleOpenBrace happy_var_2) ->
- case happyOut47 happy_x_3 of { happy_var_3 ->
+ case happyOut48 happy_x_3 of { happy_var_3 ->
case happyOut17 happy_x_4 of { happy_var_4 ->
- happyIn46
+ happyIn47
(TypedBindings (getRange (happy_var_2,happy_var_3,happy_var_4))
(makeInstance $ setRelevance NonStrict $ defaultColoredArg happy_var_3)
) `HappyStk` happyRest}}}
-happyReduce_190 = happySpecReduce_3 40# happyReduction_190
-happyReduction_190 happy_x_3
+happyReduce_199 = happySpecReduce_3 41# happyReduction_199
+happyReduction_199 happy_x_3
happy_x_2
happy_x_1
= case happyOutTok happy_x_1 of { (TokSymbol SymOpenParen happy_var_1) ->
- case happyOut47 happy_x_2 of { happy_var_2 ->
+ case happyOut48 happy_x_2 of { happy_var_2 ->
case happyOutTok happy_x_3 of { (TokSymbol SymCloseParen happy_var_3) ->
- happyIn46
+ happyIn47
(TypedBindings (getRange (happy_var_1,happy_var_2,happy_var_3))
(defaultColoredArg happy_var_2)
)}}}
-happyReduce_191 = happySpecReduce_3 40# happyReduction_191
-happyReduction_191 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 SymDoubleOpenBrace happy_var_1) ->
- case happyOut47 happy_x_2 of { happy_var_2 ->
+ case happyOut48 happy_x_2 of { happy_var_2 ->
case happyOut17 happy_x_3 of { happy_var_3 ->
- happyIn46
+ happyIn47
(TypedBindings (getRange (happy_var_1,happy_var_2,happy_var_3))
(makeInstance $ defaultColoredArg happy_var_2)
)}}}
-happyReduce_192 = happySpecReduce_3 40# happyReduction_192
-happyReduction_192 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 SymOpenBrace happy_var_1) ->
- case happyOut47 happy_x_2 of { happy_var_2 ->
+ case happyOut48 happy_x_2 of { happy_var_2 ->
case happyOutTok happy_x_3 of { (TokSymbol SymCloseBrace happy_var_3) ->
- happyIn46
+ happyIn47
(TypedBindings (getRange (happy_var_1,happy_var_2,happy_var_3))
(hide $ defaultColoredArg happy_var_2)
)}}}
-happyReduce_193 = happySpecReduce_3 40# happyReduction_193
-happyReduction_193 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 SymOpenParen happy_var_1) ->
- case happyOut105 happy_x_2 of { happy_var_2 ->
+ case happyOut107 happy_x_2 of { happy_var_2 ->
case happyOutTok happy_x_3 of { (TokSymbol SymCloseParen happy_var_3) ->
- happyIn46
+ happyIn47
(tLet (getRange (happy_var_1,happy_var_3)) happy_var_2
)}}}
-happyReduce_194 = happyReduce 4# 40# happyReduction_194
-happyReduction_194 (happy_x_4 `HappyStk`
+happyReduce_203 = happyReduce 4# 41# happyReduction_203
+happyReduction_203 (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 happyOut136 happy_x_3 of { happy_var_3 ->
+ case happyOut139 happy_x_3 of { happy_var_3 ->
case happyOutTok happy_x_4 of { (TokSymbol SymCloseParen happy_var_4) ->
- happyIn46
+ happyIn47
(tLet (getRange (happy_var_1,happy_var_4)) happy_var_3
) `HappyStk` happyRest}}}
-happyReduce_195 = happySpecReduce_3 41# happyReduction_195
-happyReduction_195 happy_x_3
+happyReduce_204 = happySpecReduce_3 42# happyReduction_204
+happyReduction_204 happy_x_3
happy_x_2
happy_x_1
= case happyOut25 happy_x_1 of { happy_var_1 ->
case happyOutTok happy_x_2 of { (TokSymbol SymColon happy_var_2) ->
- case happyOut30 happy_x_3 of { happy_var_3 ->
- happyIn47
+ case happyOut31 happy_x_3 of { happy_var_3 ->
+ happyIn48
(( [], TBind (getRange (happy_var_1,happy_var_2,happy_var_3)) (map mkBoundName_ happy_var_1) happy_var_3 )
)}}}
-happyReduce_196 = happyMonadReduce 2# 42# happyReduction_196
-happyReduction_196 (happy_x_2 `HappyStk`
+happyReduce_205 = happyMonadReduce 2# 43# happyReduction_205
+happyReduction_205 (happy_x_2 `HappyStk`
happy_x_1 `HappyStk`
happyRest) tk
- = happyThen (case happyOut50 happy_x_1 of { happy_var_1 ->
+ = 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 ]
[] -> parsePanic "Empty LamBinds")}
- ) (\r -> happyReturn (happyIn48 r))
+ ) (\r -> happyReturn (happyIn49 r))
-happyReduce_197 = happyMonadReduce 1# 43# happyReduction_197
-happyReduction_197 (happy_x_1 `HappyStk`
+happyReduce_206 = happyMonadReduce 1# 44# happyReduction_206
+happyReduction_206 (happy_x_1 `HappyStk`
happyRest) tk
- = happyThen (case happyOut51 happy_x_1 of { happy_var_1 ->
+ = happyThen (case happyOut52 happy_x_1 of { happy_var_1 ->
(
case happy_var_1 of
Left lb -> case reverse lb of
@@ -2938,813 +3045,817 @@ happyReduction_197 (happy_x_1 `HappyStk`
Left h : _ -> return $ Left ([ b | Right b <- init lb], h)
_ -> parsePanic "Empty LamBindsAbsurd"
Right es -> return $ Right es)}
- ) (\r -> happyReturn (happyIn49 r))
+ ) (\r -> happyReturn (happyIn50 r))
-happyReduce_198 = happySpecReduce_2 44# happyReduction_198
-happyReduction_198 happy_x_2
+happyReduce_207 = happySpecReduce_2 45# happyReduction_207
+happyReduction_207 happy_x_2
happy_x_1
- = case happyOut59 happy_x_1 of { happy_var_1 ->
- case happyOut50 happy_x_2 of { happy_var_2 ->
- happyIn50
+ = case happyOut60 happy_x_1 of { happy_var_1 ->
+ case happyOut51 happy_x_2 of { happy_var_2 ->
+ happyIn51
(map Right happy_var_1 ++ happy_var_2
)}}
-happyReduce_199 = happySpecReduce_2 44# happyReduction_199
-happyReduction_199 happy_x_2
+happyReduce_208 = happySpecReduce_2 45# happyReduction_208
+happyReduction_208 happy_x_2
happy_x_1
- = case happyOut46 happy_x_1 of { happy_var_1 ->
- case happyOut50 happy_x_2 of { happy_var_2 ->
- happyIn50
+ = case happyOut47 happy_x_1 of { happy_var_1 ->
+ case happyOut51 happy_x_2 of { happy_var_2 ->
+ happyIn51
(Right (DomainFull happy_var_1) : happy_var_2
)}}
-happyReduce_200 = happySpecReduce_1 44# happyReduction_200
-happyReduction_200 happy_x_1
- = case happyOut59 happy_x_1 of { happy_var_1 ->
- happyIn50
+happyReduce_209 = happySpecReduce_1 45# happyReduction_209
+happyReduction_209 happy_x_1
+ = case happyOut60 happy_x_1 of { happy_var_1 ->
+ happyIn51
(map Right happy_var_1
)}
-happyReduce_201 = happySpecReduce_1 44# happyReduction_201
-happyReduction_201 happy_x_1
- = case happyOut46 happy_x_1 of { happy_var_1 ->
- happyIn50
+happyReduce_210 = happySpecReduce_1 45# happyReduction_210
+happyReduction_210 happy_x_1
+ = case happyOut47 happy_x_1 of { happy_var_1 ->
+ happyIn51
([Right $ DomainFull happy_var_1]
)}
-happyReduce_202 = happySpecReduce_2 44# happyReduction_202
-happyReduction_202 happy_x_2
+happyReduce_211 = happySpecReduce_2 45# happyReduction_211
+happyReduction_211 happy_x_2
happy_x_1
- = happyIn50
+ = happyIn51
([Left NotHidden]
)
-happyReduce_203 = happySpecReduce_2 44# happyReduction_203
-happyReduction_203 happy_x_2
+happyReduce_212 = happySpecReduce_2 45# happyReduction_212
+happyReduction_212 happy_x_2
happy_x_1
- = happyIn50
+ = happyIn51
([Left Hidden]
)
-happyReduce_204 = happySpecReduce_2 44# happyReduction_204
-happyReduction_204 happy_x_2
+happyReduce_213 = happySpecReduce_2 45# happyReduction_213
+happyReduction_213 happy_x_2
happy_x_1
- = happyIn50
+ = happyIn51
([Left Instance]
)
-happyReduce_205 = happySpecReduce_2 45# happyReduction_205
-happyReduction_205 happy_x_2
+happyReduce_214 = happySpecReduce_2 46# happyReduction_214
+happyReduction_214 happy_x_2
happy_x_1
- = case happyOut59 happy_x_1 of { happy_var_1 ->
- case happyOut50 happy_x_2 of { happy_var_2 ->
- happyIn51
+ = case happyOut60 happy_x_1 of { happy_var_1 ->
+ case happyOut51 happy_x_2 of { happy_var_2 ->
+ happyIn52
(Left $ map Right happy_var_1 ++ happy_var_2
)}}
-happyReduce_206 = happySpecReduce_2 45# happyReduction_206
-happyReduction_206 happy_x_2
+happyReduce_215 = happySpecReduce_2 46# happyReduction_215
+happyReduction_215 happy_x_2
happy_x_1
- = case happyOut46 happy_x_1 of { happy_var_1 ->
- case happyOut50 happy_x_2 of { happy_var_2 ->
- happyIn51
+ = case happyOut47 happy_x_1 of { happy_var_1 ->
+ case happyOut51 happy_x_2 of { happy_var_2 ->
+ happyIn52
(Left $ Right (DomainFull happy_var_1) : happy_var_2
)}}
-happyReduce_207 = happySpecReduce_1 45# happyReduction_207
-happyReduction_207 happy_x_1
- = case happyOut60 happy_x_1 of { happy_var_1 ->
- happyIn51
+happyReduce_216 = happySpecReduce_1 46# happyReduction_216
+happyReduction_216 happy_x_1
+ = case happyOut61 happy_x_1 of { happy_var_1 ->
+ happyIn52
(case happy_var_1 of
Left lb -> Left $ map Right lb
Right es -> Right es
)}
-happyReduce_208 = happySpecReduce_1 45# happyReduction_208
-happyReduction_208 happy_x_1
- = case happyOut46 happy_x_1 of { happy_var_1 ->
- happyIn51
+happyReduce_217 = happySpecReduce_1 46# happyReduction_217
+happyReduction_217 happy_x_1
+ = case happyOut47 happy_x_1 of { happy_var_1 ->
+ happyIn52
(Left [Right $ DomainFull happy_var_1]
)}
-happyReduce_209 = happySpecReduce_2 45# happyReduction_209
-happyReduction_209 happy_x_2
+happyReduce_218 = happySpecReduce_2 46# happyReduction_218
+happyReduction_218 happy_x_2
happy_x_1
- = happyIn51
+ = happyIn52
(Left [Left NotHidden]
)
-happyReduce_210 = happySpecReduce_2 45# happyReduction_210
-happyReduction_210 happy_x_2
+happyReduce_219 = happySpecReduce_2 46# happyReduction_219
+happyReduction_219 happy_x_2
happy_x_1
- = happyIn51
+ = happyIn52
(Left [Left Hidden]
)
-happyReduce_211 = happySpecReduce_2 45# happyReduction_211
-happyReduction_211 happy_x_2
+happyReduce_220 = happySpecReduce_2 46# happyReduction_220
+happyReduction_220 happy_x_2
happy_x_1
- = happyIn51
+ = happyIn52
(Left [Left Instance]
)
-happyReduce_212 = happyMonadReduce 3# 46# happyReduction_212
-happyReduction_212 (happy_x_3 `HappyStk`
+happyReduce_221 = happyMonadReduce 3# 47# happyReduction_221
+happyReduction_221 (happy_x_3 `HappyStk`
happy_x_2 `HappyStk`
happy_x_1 `HappyStk`
happyRest) tk
- = happyThen (case happyOut36 happy_x_1 of { happy_var_1 ->
- case happyOut30 happy_x_3 of { happy_var_3 ->
+ = happyThen (case happyOut37 happy_x_1 of { happy_var_1 ->
+ case happyOut31 happy_x_3 of { happy_var_3 ->
( do
p <- exprToLHS (RawApp (getRange happy_var_1) happy_var_1) ;
return (p [] [], RHS happy_var_3, NoWhere))}}
- ) (\r -> happyReturn (happyIn52 r))
+ ) (\r -> happyReturn (happyIn53 r))
-happyReduce_213 = happyMonadReduce 1# 47# happyReduction_213
-happyReduction_213 (happy_x_1 `HappyStk`
+happyReduce_222 = happyMonadReduce 1# 48# happyReduction_222
+happyReduction_222 (happy_x_1 `HappyStk`
happyRest) tk
- = happyThen (case happyOut33 happy_x_1 of { happy_var_1 ->
+ = happyThen (case happyOut34 happy_x_1 of { happy_var_1 ->
( do
p <- exprToLHS (RawApp (getRange happy_var_1) happy_var_1);
return (p [] [], AbsurdRHS, NoWhere))}
- ) (\r -> happyReturn (happyIn53 r))
+ ) (\r -> happyReturn (happyIn54 r))
-happyReduce_214 = happySpecReduce_1 48# happyReduction_214
-happyReduction_214 happy_x_1
- = case happyOut52 happy_x_1 of { happy_var_1 ->
- happyIn54
+happyReduce_223 = happySpecReduce_1 49# happyReduction_223
+happyReduction_223 happy_x_1
+ = case happyOut53 happy_x_1 of { happy_var_1 ->
+ happyIn55
(happy_var_1
)}
-happyReduce_215 = happySpecReduce_1 48# happyReduction_215
-happyReduction_215 happy_x_1
- = case happyOut53 happy_x_1 of { happy_var_1 ->
- happyIn54
+happyReduce_224 = happySpecReduce_1 49# happyReduction_224
+happyReduction_224 happy_x_1
+ = case happyOut54 happy_x_1 of { happy_var_1 ->
+ happyIn55
(happy_var_1
)}
-happyReduce_216 = happySpecReduce_3 49# happyReduction_216
-happyReduction_216 happy_x_3
+happyReduce_225 = happySpecReduce_3 50# happyReduction_225
+happyReduction_225 happy_x_3
happy_x_2
happy_x_1
- = case happyOut55 happy_x_1 of { happy_var_1 ->
- case happyOut54 happy_x_3 of { happy_var_3 ->
- happyIn55
+ = case happyOut56 happy_x_1 of { happy_var_1 ->
+ case happyOut55 happy_x_3 of { happy_var_3 ->
+ happyIn56
(happy_var_3 : happy_var_1
)}}
-happyReduce_217 = happySpecReduce_3 49# happyReduction_217
-happyReduction_217 happy_x_3
+happyReduce_226 = happySpecReduce_3 50# happyReduction_226
+happyReduction_226 happy_x_3
happy_x_2
happy_x_1
- = case happyOut53 happy_x_1 of { happy_var_1 ->
- case happyOut54 happy_x_3 of { happy_var_3 ->
- happyIn55
+ = case happyOut54 happy_x_1 of { happy_var_1 ->
+ case happyOut55 happy_x_3 of { happy_var_3 ->
+ happyIn56
([happy_var_3, happy_var_1]
)}}
-happyReduce_218 = happySpecReduce_1 49# happyReduction_218
-happyReduction_218 happy_x_1
- = case happyOut52 happy_x_1 of { happy_var_1 ->
- happyIn55
+happyReduce_227 = happySpecReduce_1 50# happyReduction_227
+happyReduction_227 happy_x_1
+ = case happyOut53 happy_x_1 of { happy_var_1 ->
+ happyIn56
([happy_var_1]
)}
-happyReduce_219 = happySpecReduce_2 50# happyReduction_219
-happyReduction_219 happy_x_2
+happyReduce_228 = happySpecReduce_2 51# happyReduction_228
+happyReduction_228 happy_x_2
happy_x_1
- = case happyOut57 happy_x_1 of { happy_var_1 ->
- happyIn56
+ = case happyOut58 happy_x_1 of { happy_var_1 ->
+ happyIn57
(happy_var_1
)}
-happyReduce_220 = happySpecReduce_2 51# happyReduction_220
-happyReduction_220 happy_x_2
+happyReduce_229 = happySpecReduce_2 52# happyReduction_229
+happyReduction_229 happy_x_2
happy_x_1
- = case happyOut59 happy_x_1 of { happy_var_1 ->
- case happyOut57 happy_x_2 of { happy_var_2 ->
- happyIn57
+ = case happyOut60 happy_x_1 of { happy_var_1 ->
+ case happyOut58 happy_x_2 of { happy_var_2 ->
+ happyIn58
(happy_var_1 ++ happy_var_2
)}}
-happyReduce_221 = happySpecReduce_2 51# happyReduction_221
-happyReduction_221 happy_x_2
+happyReduce_230 = happySpecReduce_2 52# happyReduction_230
+happyReduction_230 happy_x_2
happy_x_1
- = case happyOut46 happy_x_1 of { happy_var_1 ->
- case happyOut57 happy_x_2 of { happy_var_2 ->
- happyIn57
+ = case happyOut47 happy_x_1 of { happy_var_1 ->
+ case happyOut58 happy_x_2 of { happy_var_2 ->
+ happyIn58
(DomainFull happy_var_1 : happy_var_2
)}}
-happyReduce_222 = happySpecReduce_1 51# happyReduction_222
-happyReduction_222 happy_x_1
- = case happyOut59 happy_x_1 of { happy_var_1 ->
- happyIn57
+happyReduce_231 = happySpecReduce_1 52# happyReduction_231
+happyReduction_231 happy_x_1
+ = case happyOut60 happy_x_1 of { happy_var_1 ->
+ happyIn58
(happy_var_1
)}
-happyReduce_223 = happySpecReduce_1 51# happyReduction_223
-happyReduction_223 happy_x_1
- = case happyOut46 happy_x_1 of { happy_var_1 ->
- happyIn57
+happyReduce_232 = happySpecReduce_1 52# happyReduction_232
+happyReduction_232 happy_x_1
+ = case happyOut47 happy_x_1 of { happy_var_1 ->
+ happyIn58
([DomainFull happy_var_1]
)}
-happyReduce_224 = happySpecReduce_2 52# happyReduction_224
-happyReduction_224 happy_x_2
+happyReduce_233 = happySpecReduce_2 53# happyReduction_233
+happyReduction_233 happy_x_2
happy_x_1
- = case happyOut59 happy_x_1 of { happy_var_1 ->
- case happyOut58 happy_x_2 of { happy_var_2 ->
- happyIn58
+ = case happyOut60 happy_x_1 of { happy_var_1 ->
+ case happyOut59 happy_x_2 of { happy_var_2 ->
+ happyIn59
(happy_var_1 ++ happy_var_2
)}}
-happyReduce_225 = happySpecReduce_2 52# happyReduction_225
-happyReduction_225 happy_x_2
+happyReduce_234 = happySpecReduce_2 53# happyReduction_234
+happyReduction_234 happy_x_2
happy_x_1
- = case happyOut46 happy_x_1 of { happy_var_1 ->
- case happyOut58 happy_x_2 of { happy_var_2 ->
- happyIn58
+ = case happyOut47 happy_x_1 of { happy_var_1 ->
+ case happyOut59 happy_x_2 of { happy_var_2 ->
+ happyIn59
(DomainFull happy_var_1 : happy_var_2
)}}
-happyReduce_226 = happySpecReduce_0 52# happyReduction_226
-happyReduction_226 = happyIn58
+happyReduce_235 = happySpecReduce_0 53# happyReduction_235
+happyReduction_235 = happyIn59
([]
)
-happyReduce_227 = happySpecReduce_1 53# happyReduction_227
-happyReduction_227 happy_x_1
- = case happyOut60 happy_x_1 of { happy_var_1 ->
- happyIn59
+happyReduce_236 = happySpecReduce_1 54# happyReduction_236
+happyReduction_236 happy_x_1
+ = case happyOut61 happy_x_1 of { happy_var_1 ->
+ happyIn60
(case happy_var_1 of
Left lbs -> lbs
Right _ -> fail "expected sequence of bound identifiers, not absurd pattern"
)}
-happyReduce_228 = happySpecReduce_1 54# happyReduction_228
-happyReduction_228 happy_x_1
+happyReduce_237 = happySpecReduce_1 55# happyReduction_237
+happyReduction_237 happy_x_1
= case happyOut23 happy_x_1 of { happy_var_1 ->
- happyIn60
+ happyIn61
(Left [DomainFree defaultArgInfo $ mkBoundName_ happy_var_1]
)}
-happyReduce_229 = happySpecReduce_2 54# happyReduction_229
-happyReduction_229 happy_x_2
+happyReduce_238 = happySpecReduce_2 55# happyReduction_238
+happyReduction_238 happy_x_2
happy_x_1
= case happyOut23 happy_x_2 of { happy_var_2 ->
- happyIn60
+ happyIn61
(Left [DomainFree (setRelevance Irrelevant $ defaultArgInfo) $ mkBoundName_ happy_var_2]
)}
-happyReduce_230 = happySpecReduce_2 54# happyReduction_230
-happyReduction_230 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 ->
- happyIn60
+ happyIn61
(Left [DomainFree (setRelevance NonStrict $ defaultArgInfo) $ mkBoundName_ happy_var_2]
)}
-happyReduce_231 = happySpecReduce_3 54# happyReduction_231
-happyReduction_231 happy_x_3
+happyReduce_240 = happySpecReduce_3 55# happyReduction_240
+happyReduction_240 happy_x_3
happy_x_2
happy_x_1
= case happyOut26 happy_x_2 of { happy_var_2 ->
- happyIn60
+ happyIn61
(either (Left . map (DomainFree (setHiding Hidden $ defaultArgInfo) . mkBoundName_)) Right happy_var_2
)}
-happyReduce_232 = happySpecReduce_3 54# happyReduction_232
-happyReduction_232 happy_x_3
+happyReduce_241 = happySpecReduce_3 55# happyReduction_241
+happyReduction_241 happy_x_3
happy_x_2
happy_x_1
= case happyOut25 happy_x_2 of { happy_var_2 ->
- happyIn60
+ happyIn61
(Left $ map (DomainFree (setHiding Instance $ defaultArgInfo) . mkBoundName_) happy_var_2
)}
-happyReduce_233 = happyReduce 4# 54# happyReduction_233
-happyReduction_233 (happy_x_4 `HappyStk`
+happyReduce_242 = happyReduce 4# 55# happyReduction_242
+happyReduction_242 (happy_x_4 `HappyStk`
happy_x_3 `HappyStk`
happy_x_2 `HappyStk`
happy_x_1 `HappyStk`
happyRest)
= case happyOut25 happy_x_3 of { happy_var_3 ->
- happyIn60
+ happyIn61
(Left $ map (DomainFree (setHiding Hidden $ setRelevance Irrelevant $ defaultArgInfo) . mkBoundName_) happy_var_3
) `HappyStk` happyRest}
-happyReduce_234 = happyReduce 4# 54# happyReduction_234
-happyReduction_234 (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`
happyRest)
= case happyOut25 happy_x_3 of { happy_var_3 ->
- happyIn60
+ happyIn61
(Left $ map (DomainFree (setHiding Instance $ setRelevance Irrelevant $ defaultArgInfo) . mkBoundName_) happy_var_3
) `HappyStk` happyRest}
-happyReduce_235 = happyReduce 4# 54# happyReduction_235
-happyReduction_235 (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`
happyRest)
= case happyOut25 happy_x_3 of { happy_var_3 ->
- happyIn60
+ happyIn61
(Left $ map (DomainFree (setHiding Hidden $ setRelevance NonStrict $ defaultArgInfo) . mkBoundName_) happy_var_3
) `HappyStk` happyRest}
-happyReduce_236 = happyReduce 4# 54# happyReduction_236
-happyReduction_236 (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`
happyRest)
= case happyOut25 happy_x_3 of { happy_var_3 ->
- happyIn60
+ happyIn61
(Left $ map (DomainFree (setHiding Instance $ setRelevance NonStrict $ defaultArgInfo) . mkBoundName_) happy_var_3
) `HappyStk` happyRest}
-happyReduce_237 = happyMonadReduce 1# 55# happyReduction_237
-happyReduction_237 (happy_x_1 `HappyStk`
+happyReduce_246 = happyMonadReduce 1# 56# happyReduction_246
+happyReduction_246 (happy_x_1 `HappyStk`
happyRest) tk
- = happyThen (case happyOut62 happy_x_1 of { happy_var_1 ->
+ = happyThen (case happyOut63 happy_x_1 of { happy_var_1 ->
( mergeImportDirectives happy_var_1)}
- ) (\r -> happyReturn (happyIn61 r))
+ ) (\r -> happyReturn (happyIn62 r))
-happyReduce_238 = happySpecReduce_2 56# happyReduction_238
-happyReduction_238 happy_x_2
+happyReduce_247 = happySpecReduce_2 57# happyReduction_247
+happyReduction_247 happy_x_2
happy_x_1
- = case happyOut63 happy_x_1 of { happy_var_1 ->
- case happyOut62 happy_x_2 of { happy_var_2 ->
- happyIn62
+ = case happyOut64 happy_x_1 of { happy_var_1 ->
+ case happyOut63 happy_x_2 of { happy_var_2 ->
+ happyIn63
(happy_var_1 : happy_var_2
)}}
-happyReduce_239 = happySpecReduce_0 56# happyReduction_239
-happyReduction_239 = happyIn62
+happyReduce_248 = happySpecReduce_0 57# happyReduction_248
+happyReduction_248 = happyIn63
([]
)
-happyReduce_240 = happySpecReduce_1 57# happyReduction_240
-happyReduction_240 happy_x_1
+happyReduce_249 = happySpecReduce_1 58# happyReduction_249
+happyReduction_249 happy_x_1
= case happyOutTok happy_x_1 of { (TokKeyword KwPublic happy_var_1) ->
- happyIn63
+ happyIn64
(defaultImportDir { importDirRange = getRange happy_var_1, publicOpen = True }
)}
-happyReduce_241 = happySpecReduce_1 57# happyReduction_241
-happyReduction_241 happy_x_1
- = case happyOut64 happy_x_1 of { happy_var_1 ->
- happyIn63
+happyReduce_250 = happySpecReduce_1 58# happyReduction_250
+happyReduction_250 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_242 = happySpecReduce_1 57# happyReduction_242
-happyReduction_242 happy_x_1
- = case happyOut65 happy_x_1 of { happy_var_1 ->
- happyIn63
+happyReduce_251 = happySpecReduce_1 58# happyReduction_251
+happyReduction_251 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_243 = happyReduce 4# 58# happyReduction_243
-happyReduction_243 (happy_x_4 `HappyStk`
+happyReduce_252 = happyReduce 4# 59# happyReduction_252
+happyReduction_252 (happy_x_4 `HappyStk`
happy_x_3 `HappyStk`
happy_x_2 `HappyStk`
happy_x_1 `HappyStk`
happyRest)
= case happyOutTok happy_x_1 of { (TokKeyword KwUsing happy_var_1) ->
case happyOutTok happy_x_2 of { (TokSymbol SymOpenParen happy_var_2) ->
- case happyOut70 happy_x_3 of { happy_var_3 ->
+ case happyOut71 happy_x_3 of { happy_var_3 ->
case happyOutTok happy_x_4 of { (TokSymbol SymCloseParen happy_var_4) ->
- happyIn64
+ happyIn65
((Using happy_var_3 , getRange (happy_var_1,happy_var_2,happy_var_3,happy_var_4))
) `HappyStk` happyRest}}}}
-happyReduce_244 = happyReduce 4# 58# happyReduction_244
-happyReduction_244 (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`
happyRest)
= case happyOutTok happy_x_1 of { (TokKeyword KwHiding happy_var_1) ->
case happyOutTok happy_x_2 of { (TokSymbol SymOpenParen happy_var_2) ->
- case happyOut70 happy_x_3 of { happy_var_3 ->
+ case happyOut71 happy_x_3 of { happy_var_3 ->
case happyOutTok happy_x_4 of { (TokSymbol SymCloseParen happy_var_4) ->
- happyIn64
+ happyIn65
((Hiding happy_var_3 , getRange (happy_var_1,happy_var_2,happy_var_3,happy_var_4))
) `HappyStk` happyRest}}}}
-happyReduce_245 = happyReduce 4# 59# happyReduction_245
-happyReduction_245 (happy_x_4 `HappyStk`
+happyReduce_254 = happyReduce 4# 60# happyReduction_254
+happyReduction_254 (happy_x_4 `HappyStk`
happy_x_3 `HappyStk`
happy_x_2 `HappyStk`
happy_x_1 `HappyStk`
happyRest)
= case happyOutTok happy_x_1 of { (TokKeyword KwRenaming happy_var_1) ->
case happyOutTok happy_x_2 of { (TokSymbol SymOpenParen happy_var_2) ->
- case happyOut66 happy_x_3 of { happy_var_3 ->
+ case happyOut67 happy_x_3 of { happy_var_3 ->
case happyOutTok happy_x_4 of { (TokSymbol SymCloseParen happy_var_4) ->
- happyIn65
+ happyIn66
((happy_var_3 , getRange (happy_var_1,happy_var_2,happy_var_3,happy_var_4))
) `HappyStk` happyRest}}}}
-happyReduce_246 = happySpecReduce_3 59# happyReduction_246
-happyReduction_246 happy_x_3
+happyReduce_255 = happySpecReduce_3 60# happyReduction_255
+happyReduction_255 happy_x_3
happy_x_2
happy_x_1
= case happyOutTok happy_x_1 of { (TokKeyword KwRenaming happy_var_1) ->
case happyOutTok happy_x_2 of { (TokSymbol SymOpenParen happy_var_2) ->
case happyOutTok happy_x_3 of { (TokSymbol SymCloseParen happy_var_3) ->
- happyIn65
+ happyIn66
(([] , getRange (happy_var_1,happy_var_2,happy_var_3))
)}}}
-happyReduce_247 = happySpecReduce_3 60# happyReduction_247
-happyReduction_247 happy_x_3
+happyReduce_256 = happySpecReduce_3 61# happyReduction_256
+happyReduction_256 happy_x_3
happy_x_2
happy_x_1
- = case happyOut67 happy_x_1 of { happy_var_1 ->
- case happyOut66 happy_x_3 of { happy_var_3 ->
- happyIn66
+ = case happyOut68 happy_x_1 of { happy_var_1 ->
+ case happyOut67 happy_x_3 of { happy_var_3 ->
+ happyIn67
(happy_var_1 : happy_var_3
)}}
-happyReduce_248 = happySpecReduce_1 60# happyReduction_248
-happyReduction_248 happy_x_1
- = case happyOut67 happy_x_1 of { happy_var_1 ->
- happyIn66
+happyReduce_257 = happySpecReduce_1 61# happyReduction_257
+happyReduction_257 happy_x_1
+ = case happyOut68 happy_x_1 of { happy_var_1 ->
+ happyIn67
([happy_var_1]
)}
-happyReduce_249 = happySpecReduce_3 61# happyReduction_249
-happyReduction_249 happy_x_3
+happyReduce_258 = happySpecReduce_3 62# happyReduction_258
+happyReduction_258 happy_x_3
happy_x_2
happy_x_1
- = case happyOut68 happy_x_1 of { happy_var_1 ->
+ = case happyOut69 happy_x_1 of { happy_var_1 ->
case happyOutTok happy_x_2 of { (TokKeyword KwTo happy_var_2) ->
case happyOut15 happy_x_3 of { happy_var_3 ->
- happyIn67
+ happyIn68
(Renaming happy_var_1 happy_var_3 (getRange happy_var_2)
)}}}
-happyReduce_250 = happySpecReduce_2 62# happyReduction_250
-happyReduction_250 happy_x_2
+happyReduce_259 = happySpecReduce_2 63# happyReduction_259
+happyReduction_259 happy_x_2
happy_x_1
= case happyOut15 happy_x_2 of { happy_var_2 ->
- happyIn68
+ happyIn69
(ImportedName happy_var_2
)}
-happyReduce_251 = happySpecReduce_3 62# happyReduction_251
-happyReduction_251 happy_x_3
+happyReduce_260 = happySpecReduce_3 63# happyReduction_260
+happyReduction_260 happy_x_3
happy_x_2
happy_x_1
= case happyOut15 happy_x_3 of { happy_var_3 ->
- happyIn68
+ happyIn69
(ImportedModule happy_var_3
)}
-happyReduce_252 = happySpecReduce_1 63# happyReduction_252
-happyReduction_252 happy_x_1
+happyReduce_261 = happySpecReduce_1 64# happyReduction_261
+happyReduction_261 happy_x_1
= case happyOut15 happy_x_1 of { happy_var_1 ->
- happyIn69
+ happyIn70
(ImportedName happy_var_1
)}
-happyReduce_253 = happySpecReduce_2 63# happyReduction_253
-happyReduction_253 happy_x_2
+happyReduce_262 = happySpecReduce_2 64# happyReduction_262
+happyReduction_262 happy_x_2
happy_x_1
= case happyOut15 happy_x_2 of { happy_var_2 ->
- happyIn69
+ happyIn70
(ImportedModule happy_var_2
)}
-happyReduce_254 = happySpecReduce_0 64# happyReduction_254
-happyReduction_254 = happyIn70
+happyReduce_263 = happySpecReduce_0 65# happyReduction_263
+happyReduction_263 = happyIn71
([]
)
-happyReduce_255 = happySpecReduce_1 64# happyReduction_255
-happyReduction_255 happy_x_1
- = case happyOut71 happy_x_1 of { happy_var_1 ->
- happyIn70
+happyReduce_264 = happySpecReduce_1 65# happyReduction_264
+happyReduction_264 happy_x_1
+ = case happyOut72 happy_x_1 of { happy_var_1 ->
+ happyIn71
(happy_var_1
)}
-happyReduce_256 = happySpecReduce_1 65# happyReduction_256
-happyReduction_256 happy_x_1
- = case happyOut69 happy_x_1 of { happy_var_1 ->
- happyIn71
+happyReduce_265 = happySpecReduce_1 66# happyReduction_265
+happyReduction_265 happy_x_1
+ = case happyOut70 happy_x_1 of { happy_var_1 ->
+ happyIn72
([happy_var_1]
)}
-happyReduce_257 = happySpecReduce_3 65# happyReduction_257
-happyReduction_257 happy_x_3
+happyReduce_266 = happySpecReduce_3 66# happyReduction_266
+happyReduction_266 happy_x_3
happy_x_2
happy_x_1
- = case happyOut69 happy_x_1 of { happy_var_1 ->
- case happyOut71 happy_x_3 of { happy_var_3 ->
- happyIn71
+ = case happyOut70 happy_x_1 of { happy_var_1 ->
+ case happyOut72 happy_x_3 of { happy_var_3 ->
+ happyIn72
(happy_var_1 : happy_var_3
)}}
-happyReduce_258 = happyMonadReduce 3# 66# happyReduction_258
-happyReduction_258 (happy_x_3 `HappyStk`
+happyReduce_267 = happyMonadReduce 3# 67# happyReduction_267
+happyReduction_267 (happy_x_3 `HappyStk`
happy_x_2 `HappyStk`
happy_x_1 `HappyStk`
happyRest) tk
- = happyThen (case happyOut31 happy_x_1 of { happy_var_1 ->
- case happyOut75 happy_x_2 of { happy_var_2 ->
- case happyOut74 happy_x_3 of { happy_var_3 ->
+ = happyThen (case happyOut32 happy_x_1 of { happy_var_1 ->
+ case happyOut76 happy_x_2 of { happy_var_2 ->
+ case happyOut75 happy_x_3 of { happy_var_3 ->
( exprToLHS happy_var_1 >>= \p -> return (p happy_var_2 happy_var_3))}}}
- ) (\r -> happyReturn (happyIn72 r))
+ ) (\r -> happyReturn (happyIn73 r))
-happyReduce_259 = happyReduce 4# 66# happyReduction_259
-happyReduction_259 (happy_x_4 `HappyStk`
+happyReduce_268 = happyReduce 4# 67# happyReduction_268
+happyReduction_268 (happy_x_4 `HappyStk`
happy_x_3 `HappyStk`
happy_x_2 `HappyStk`
happy_x_1 `HappyStk`
happyRest)
= case happyOutTok happy_x_1 of { (TokSymbol SymEllipsis happy_var_1) ->
- case happyOut73 happy_x_2 of { happy_var_2 ->
- case happyOut75 happy_x_3 of { happy_var_3 ->
- case happyOut74 happy_x_4 of { happy_var_4 ->
- happyIn72
+ case happyOut74 happy_x_2 of { happy_var_2 ->
+ case happyOut76 happy_x_3 of { happy_var_3 ->
+ case happyOut75 happy_x_4 of { happy_var_4 ->
+ happyIn73
(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_260 = happySpecReduce_0 67# happyReduction_260
-happyReduction_260 = happyIn73
+happyReduce_269 = happySpecReduce_0 68# happyReduction_269
+happyReduction_269 = happyIn74
([]
)
-happyReduce_261 = happyMonadReduce 3# 67# happyReduction_261
-happyReduction_261 (happy_x_3 `HappyStk`
+happyReduce_270 = happyMonadReduce 3# 68# happyReduction_270
+happyReduction_270 (happy_x_3 `HappyStk`
happy_x_2 `HappyStk`
happy_x_1 `HappyStk`
happyRest) tk
- = happyThen (case happyOut36 happy_x_2 of { happy_var_2 ->
- case happyOut73 happy_x_3 of { happy_var_3 ->
+ = 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))}}
- ) (\r -> happyReturn (happyIn73 r))
+ ) (\r -> happyReturn (happyIn74 r))
-happyReduce_262 = happySpecReduce_0 68# happyReduction_262
-happyReduction_262 = happyIn74
+happyReduce_271 = happySpecReduce_0 69# happyReduction_271
+happyReduction_271 = happyIn75
([]
)
-happyReduce_263 = happySpecReduce_2 68# happyReduction_263
-happyReduction_263 happy_x_2
+happyReduce_272 = happySpecReduce_2 69# happyReduction_272
+happyReduction_272 happy_x_2
happy_x_1
- = case happyOut30 happy_x_2 of { happy_var_2 ->
- happyIn74
+ = case happyOut31 happy_x_2 of { happy_var_2 ->
+ happyIn75
(case happy_var_2 of { WithApp _ e es -> e : es; e -> [e] }
)}
-happyReduce_264 = happySpecReduce_0 69# happyReduction_264
-happyReduction_264 = happyIn75
+happyReduce_273 = happySpecReduce_0 70# happyReduction_273
+happyReduction_273 = happyIn76
([]
)
-happyReduce_265 = happySpecReduce_2 69# happyReduction_265
-happyReduction_265 happy_x_2
+happyReduce_274 = happySpecReduce_2 70# happyReduction_274
+happyReduction_274 happy_x_2
happy_x_1
- = case happyOut31 happy_x_2 of { happy_var_2 ->
- happyIn75
+ = case happyOut32 happy_x_2 of { happy_var_2 ->
+ happyIn76
(case happy_var_2 of { WithApp _ e es -> e : es; e -> [e] }
)}
-happyReduce_266 = happySpecReduce_0 70# happyReduction_266
-happyReduction_266 = happyIn76
+happyReduce_275 = happySpecReduce_0 71# happyReduction_275
+happyReduction_275 = happyIn77
(NoWhere
)
-happyReduce_267 = happySpecReduce_2 70# happyReduction_267
-happyReduction_267 happy_x_2
+happyReduce_276 = happySpecReduce_2 71# happyReduction_276
+happyReduction_276 happy_x_2
happy_x_1
- = case happyOut137 happy_x_2 of { happy_var_2 ->
- happyIn76
+ = case happyOut140 happy_x_2 of { happy_var_2 ->
+ happyIn77
(AnyWhere happy_var_2
)}
-happyReduce_268 = happyReduce 4# 70# happyReduction_268
-happyReduction_268 (happy_x_4 `HappyStk`
+happyReduce_277 = happyReduce 4# 71# happyReduction_277
+happyReduction_277 (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 happyOut137 happy_x_4 of { happy_var_4 ->
- happyIn76
+ case happyOut140 happy_x_4 of { happy_var_4 ->
+ happyIn77
(SomeWhere happy_var_2 happy_var_4
) `HappyStk` happyRest}}
-happyReduce_269 = happyReduce 4# 70# happyReduction_269
-happyReduction_269 (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 happyOut110 happy_x_2 of { happy_var_2 ->
- case happyOut137 happy_x_4 of { happy_var_4 ->
- happyIn76
+ = case happyOut112 happy_x_2 of { happy_var_2 ->
+ case happyOut140 happy_x_4 of { happy_var_4 ->
+ happyIn77
(SomeWhere happy_var_2 happy_var_4
) `HappyStk` happyRest}}
-happyReduce_270 = happySpecReduce_1 71# happyReduction_270
-happyReduction_270 happy_x_1
+happyReduce_279 = happySpecReduce_1 72# happyReduction_279
+happyReduction_279 happy_x_1
= case happyOut89 happy_x_1 of { happy_var_1 ->
- happyIn77
+ happyIn78
(happy_var_1
)}
-happyReduce_271 = happySpecReduce_1 71# happyReduction_271
-happyReduction_271 happy_x_1
+happyReduce_280 = happySpecReduce_1 72# happyReduction_280
+happyReduction_280 happy_x_1
= case happyOut81 happy_x_1 of { happy_var_1 ->
- happyIn77
+ happyIn78
(happy_var_1
)}
-happyReduce_272 = happySpecReduce_1 71# happyReduction_272
-happyReduction_272 happy_x_1
+happyReduce_281 = happySpecReduce_1 72# happyReduction_281
+happyReduction_281 happy_x_1
= case happyOut83 happy_x_1 of { happy_var_1 ->
- happyIn77
+ happyIn78
([happy_var_1]
)}
-happyReduce_273 = happySpecReduce_1 71# happyReduction_273
-happyReduction_273 happy_x_1
+happyReduce_282 = happySpecReduce_1 72# happyReduction_282
+happyReduction_282 happy_x_1
= case happyOut84 happy_x_1 of { happy_var_1 ->
- happyIn77
+ happyIn78
([happy_var_1]
)}
-happyReduce_274 = happySpecReduce_1 71# happyReduction_274
-happyReduction_274 happy_x_1
+happyReduce_283 = happySpecReduce_1 72# happyReduction_283
+happyReduction_283 happy_x_1
= case happyOut85 happy_x_1 of { happy_var_1 ->
- happyIn77
+ happyIn78
([happy_var_1]
)}
-happyReduce_275 = happySpecReduce_1 71# happyReduction_275
-happyReduction_275 happy_x_1
+happyReduce_284 = happySpecReduce_1 72# happyReduction_284
+happyReduction_284 happy_x_1
= case happyOut86 happy_x_1 of { happy_var_1 ->
- happyIn77
+ happyIn78
([happy_var_1]
)}
-happyReduce_276 = happySpecReduce_1 71# happyReduction_276
-happyReduction_276 happy_x_1
+happyReduce_285 = happySpecReduce_1 72# happyReduction_285
+happyReduction_285 happy_x_1
= case happyOut88 happy_x_1 of { happy_var_1 ->
- happyIn77
+ happyIn78
([happy_var_1]
)}
-happyReduce_277 = happySpecReduce_1 71# happyReduction_277
-happyReduction_277 happy_x_1
+happyReduce_286 = happySpecReduce_1 72# happyReduction_286
+happyReduction_286 happy_x_1
= case happyOut90 happy_x_1 of { happy_var_1 ->
- happyIn77
+ happyIn78
([happy_var_1]
)}
-happyReduce_278 = happySpecReduce_1 71# happyReduction_278
-happyReduction_278 happy_x_1
+happyReduce_287 = happySpecReduce_1 72# happyReduction_287
+happyReduction_287 happy_x_1
= case happyOut91 happy_x_1 of { happy_var_1 ->
- happyIn77
+ happyIn78
([happy_var_1]
)}
-happyReduce_279 = happySpecReduce_1 71# happyReduction_279
-happyReduction_279 happy_x_1
+happyReduce_288 = happySpecReduce_1 72# happyReduction_288
+happyReduction_288 happy_x_1
= case happyOut92 happy_x_1 of { happy_var_1 ->
- happyIn77
+ happyIn78
([happy_var_1]
)}
-happyReduce_280 = happySpecReduce_1 71# happyReduction_280
-happyReduction_280 happy_x_1
+happyReduce_289 = happySpecReduce_1 72# happyReduction_289
+happyReduction_289 happy_x_1
= case happyOut93 happy_x_1 of { happy_var_1 ->
- happyIn77
+ happyIn78
([happy_var_1]
)}
-happyReduce_281 = happySpecReduce_1 71# happyReduction_281
-happyReduction_281 happy_x_1
+happyReduce_290 = happySpecReduce_1 72# happyReduction_290
+happyReduction_290 happy_x_1
= case happyOut94 happy_x_1 of { happy_var_1 ->
- happyIn77
+ happyIn78
([happy_var_1]
)}
-happyReduce_282 = happySpecReduce_1 71# happyReduction_282
-happyReduction_282 happy_x_1
- = case happyOut105 happy_x_1 of { happy_var_1 ->
- happyIn77
+happyReduce_291 = happySpecReduce_1 72# happyReduction_291
+happyReduction_291 happy_x_1
+ = case happyOut95 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 ->
+ happyIn78
(happy_var_1
)}
-happyReduce_283 = happySpecReduce_1 71# happyReduction_283
-happyReduction_283 happy_x_1
- = case happyOut108 happy_x_1 of { happy_var_1 ->
- happyIn77
+happyReduce_293 = happySpecReduce_1 72# happyReduction_293
+happyReduction_293 happy_x_1
+ = case happyOut110 happy_x_1 of { happy_var_1 ->
+ happyIn78
([happy_var_1]
)}
-happyReduce_284 = happySpecReduce_1 71# happyReduction_284
-happyReduction_284 happy_x_1
- = case happyOut109 happy_x_1 of { happy_var_1 ->
- happyIn77
+happyReduce_294 = happySpecReduce_1 72# happyReduction_294
+happyReduction_294 happy_x_1
+ = case happyOut111 happy_x_1 of { happy_var_1 ->
+ happyIn78
([happy_var_1]
)}
-happyReduce_285 = happySpecReduce_1 71# happyReduction_285
-happyReduction_285 happy_x_1
- = case happyOut112 happy_x_1 of { happy_var_1 ->
- happyIn77
+happyReduce_295 = happySpecReduce_1 72# happyReduction_295
+happyReduction_295 happy_x_1
+ = case happyOut114 happy_x_1 of { happy_var_1 ->
+ happyIn78
([happy_var_1]
)}
-happyReduce_286 = happySpecReduce_1 71# happyReduction_286
-happyReduction_286 happy_x_1
- = case happyOut95 happy_x_1 of { happy_var_1 ->
- happyIn77
+happyReduce_296 = happySpecReduce_1 72# happyReduction_296
+happyReduction_296 happy_x_1
+ = case happyOut97 happy_x_1 of { happy_var_1 ->
+ happyIn78
([happy_var_1]
)}
-happyReduce_287 = happySpecReduce_1 71# happyReduction_287
-happyReduction_287 happy_x_1
- = case happyOut96 happy_x_1 of { happy_var_1 ->
- happyIn77
+happyReduce_297 = happySpecReduce_1 72# happyReduction_297
+happyReduction_297 happy_x_1
+ = case happyOut98 happy_x_1 of { happy_var_1 ->
+ happyIn78
([happy_var_1]
)}
-happyReduce_288 = happySpecReduce_3 72# happyReduction_288
-happyReduction_288 happy_x_3
- happy_x_2
- happy_x_1
- = case happyOut16 happy_x_1 of { happy_var_1 ->
- case happyOut30 happy_x_3 of { happy_var_3 ->
+happyReduce_298 = happySpecReduce_1 72# happyReduction_298
+happyReduction_298 happy_x_1
+ = case happyOut96 happy_x_1 of { happy_var_1 ->
happyIn78
- (map (flip (TypeSig defaultArgInfo) happy_var_3) happy_var_1
- )}}
+ ([happy_var_1]
+ )}
-happyReduce_289 = happySpecReduce_3 73# happyReduction_289
-happyReduction_289 happy_x_3
+happyReduce_299 = happySpecReduce_3 73# happyReduction_299
+happyReduction_299 happy_x_3
happy_x_2
happy_x_1
- = case happyOut19 happy_x_1 of { happy_var_1 ->
- case happyOut30 happy_x_3 of { happy_var_3 ->
+ = case happyOut16 happy_x_1 of { happy_var_1 ->
+ case happyOut31 happy_x_3 of { happy_var_3 ->
happyIn79
- (map (\ (Common.Arg info x) -> TypeSig info x happy_var_3) happy_var_1
+ (map (flip (TypeSig defaultArgInfo) happy_var_3) happy_var_1
)}}
-happyReduce_290 = happySpecReduce_3 74# happyReduction_290
-happyReduction_290 happy_x_3
+happyReduce_300 = happySpecReduce_3 74# happyReduction_300
+happyReduction_300 happy_x_3
happy_x_2
happy_x_1
= case happyOut20 happy_x_1 of { happy_var_1 ->
- case happyOut30 happy_x_3 of { happy_var_3 ->
+ case happyOut31 happy_x_3 of { happy_var_3 ->
happyIn80
(map (fmap (flip (TypeSig defaultArgInfo) happy_var_3)) happy_var_1
)}}
-happyReduce_291 = happyMonadReduce 3# 75# happyReduction_291
-happyReduction_291 (happy_x_3 `HappyStk`
+happyReduce_301 = happyMonadReduce 3# 75# happyReduction_301
+happyReduction_301 (happy_x_3 `HappyStk`
happy_x_2 `HappyStk`
happy_x_1 `HappyStk`
happyRest) tk
- = happyThen (case happyOut72 happy_x_1 of { happy_var_1 ->
+ = happyThen (case happyOut73 happy_x_1 of { happy_var_1 ->
case happyOut82 happy_x_2 of { happy_var_2 ->
- case happyOut76 happy_x_3 of { happy_var_3 ->
+ case happyOut77 happy_x_3 of { happy_var_3 ->
( funClauseOrTypeSigs happy_var_1 happy_var_2 happy_var_3)}}}
) (\r -> happyReturn (happyIn81 r))
-happyReduce_292 = happySpecReduce_2 76# happyReduction_292
-happyReduction_292 happy_x_2
+happyReduce_302 = happySpecReduce_2 76# happyReduction_302
+happyReduction_302 happy_x_2
happy_x_1
- = case happyOut30 happy_x_2 of { happy_var_2 ->
+ = case happyOut31 happy_x_2 of { happy_var_2 ->
happyIn82
(JustRHS (RHS happy_var_2)
)}
-happyReduce_293 = happySpecReduce_2 76# happyReduction_293
-happyReduction_293 happy_x_2
+happyReduce_303 = happySpecReduce_2 76# happyReduction_303
+happyReduction_303 happy_x_2
happy_x_1
- = case happyOut30 happy_x_2 of { happy_var_2 ->
+ = case happyOut31 happy_x_2 of { happy_var_2 ->
happyIn82
(TypeSigsRHS happy_var_2
)}
-happyReduce_294 = happySpecReduce_0 76# happyReduction_294
-happyReduction_294 = happyIn82
+happyReduce_304 = happySpecReduce_0 76# happyReduction_304
+happyReduction_304 = happyIn82
(JustRHS AbsurdRHS
)
-happyReduce_295 = happyReduce 7# 77# happyReduction_295
-happyReduction_295 (happy_x_7 `HappyStk`
+happyReduce_305 = happyReduce 7# 77# happyReduction_305
+happyReduction_305 (happy_x_7 `HappyStk`
happy_x_6 `HappyStk`
happy_x_5 `HappyStk`
happy_x_4 `HappyStk`
@@ -3754,17 +3865,17 @@ happyReduction_295 (happy_x_7 `HappyStk`
happyRest)
= case happyOutTok happy_x_1 of { (TokKeyword KwData happy_var_1) ->
case happyOut15 happy_x_2 of { happy_var_2 ->
- case happyOut58 happy_x_3 of { happy_var_3 ->
+ case happyOut59 happy_x_3 of { happy_var_3 ->
case happyOutTok happy_x_4 of { (TokSymbol SymColon happy_var_4) ->
- case happyOut30 happy_x_5 of { happy_var_5 ->
+ case happyOut31 happy_x_5 of { happy_var_5 ->
case happyOutTok happy_x_6 of { (TokKeyword KwWhere happy_var_6) ->
- case happyOut133 happy_x_7 of { happy_var_7 ->
+ case happyOut136 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_296 = happyReduce 7# 77# happyReduction_296
-happyReduction_296 (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`
@@ -3774,17 +3885,17 @@ happyReduction_296 (happy_x_7 `HappyStk`
happyRest)
= case happyOutTok happy_x_1 of { (TokKeyword KwCoData happy_var_1) ->
case happyOut15 happy_x_2 of { happy_var_2 ->
- case happyOut58 happy_x_3 of { happy_var_3 ->
+ case happyOut59 happy_x_3 of { happy_var_3 ->
case happyOutTok happy_x_4 of { (TokSymbol SymColon happy_var_4) ->
- case happyOut30 happy_x_5 of { happy_var_5 ->
+ case happyOut31 happy_x_5 of { happy_var_5 ->
case happyOutTok happy_x_6 of { (TokKeyword KwWhere happy_var_6) ->
- case happyOut133 happy_x_7 of { happy_var_7 ->
+ case happyOut136 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_297 = happyReduce 5# 77# happyReduction_297
-happyReduction_297 (happy_x_5 `HappyStk`
+happyReduce_307 = happyReduce 5# 77# happyReduction_307
+happyReduction_307 (happy_x_5 `HappyStk`
happy_x_4 `HappyStk`
happy_x_3 `HappyStk`
happy_x_2 `HappyStk`
@@ -3792,15 +3903,15 @@ happyReduction_297 (happy_x_5 `HappyStk`
happyRest)
= case happyOutTok happy_x_1 of { (TokKeyword KwData happy_var_1) ->
case happyOut15 happy_x_2 of { happy_var_2 ->
- case happyOut58 happy_x_3 of { happy_var_3 ->
+ case happyOut59 happy_x_3 of { happy_var_3 ->
case happyOutTok happy_x_4 of { (TokKeyword KwWhere happy_var_4) ->
- case happyOut133 happy_x_5 of { happy_var_5 ->
+ case happyOut136 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_298 = happyReduce 5# 77# happyReduction_298
-happyReduction_298 (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`
@@ -3808,15 +3919,15 @@ happyReduction_298 (happy_x_5 `HappyStk`
happyRest)
= case happyOutTok happy_x_1 of { (TokKeyword KwCoData happy_var_1) ->
case happyOut15 happy_x_2 of { happy_var_2 ->
- case happyOut58 happy_x_3 of { happy_var_3 ->
+ case happyOut59 happy_x_3 of { happy_var_3 ->
case happyOutTok happy_x_4 of { (TokKeyword KwWhere happy_var_4) ->
- case happyOut133 happy_x_5 of { happy_var_5 ->
+ case happyOut136 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_299 = happyReduce 5# 78# happyReduction_299
-happyReduction_299 (happy_x_5 `HappyStk`
+happyReduce_309 = happyReduce 5# 78# happyReduction_309
+happyReduction_309 (happy_x_5 `HappyStk`
happy_x_4 `HappyStk`
happy_x_3 `HappyStk`
happy_x_2 `HappyStk`
@@ -3824,15 +3935,15 @@ happyReduction_299 (happy_x_5 `HappyStk`
happyRest)
= case happyOutTok happy_x_1 of { (TokKeyword KwData happy_var_1) ->
case happyOut15 happy_x_2 of { happy_var_2 ->
- case happyOut58 happy_x_3 of { happy_var_3 ->
+ case happyOut59 happy_x_3 of { happy_var_3 ->
case happyOutTok happy_x_4 of { (TokSymbol SymColon happy_var_4) ->
- case happyOut30 happy_x_5 of { happy_var_5 ->
+ case happyOut31 happy_x_5 of { happy_var_5 ->
happyIn84
(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_300 = happyMonadReduce 7# 79# happyReduction_300
-happyReduction_300 (happy_x_7 `HappyStk`
+happyReduce_310 = happyMonadReduce 7# 79# happyReduction_310
+happyReduction_310 (happy_x_7 `HappyStk`
happy_x_6 `HappyStk`
happy_x_5 `HappyStk`
happy_x_4 `HappyStk`
@@ -3841,55 +3952,55 @@ happyReduction_300 (happy_x_7 `HappyStk`
happy_x_1 `HappyStk`
happyRest) tk
= happyThen (case happyOutTok happy_x_1 of { (TokKeyword KwRecord happy_var_1) ->
- case happyOut38 happy_x_2 of { happy_var_2 ->
- case happyOut58 happy_x_3 of { happy_var_3 ->
+ case happyOut39 happy_x_2 of { happy_var_2 ->
+ case happyOut59 happy_x_3 of { happy_var_3 ->
case happyOutTok happy_x_4 of { (TokSymbol SymColon happy_var_4) ->
- case happyOut30 happy_x_5 of { happy_var_5 ->
+ case happyOut31 happy_x_5 of { happy_var_5 ->
case happyOutTok happy_x_6 of { (TokKeyword KwWhere happy_var_6) ->
- case happyOut134 happy_x_7 of { happy_var_7 ->
+ case happyOut137 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_301 = happyMonadReduce 5# 79# happyReduction_301
-happyReduction_301 (happy_x_5 `HappyStk`
+happyReduce_311 = happyMonadReduce 5# 79# happyReduction_311
+happyReduction_311 (happy_x_5 `HappyStk`
happy_x_4 `HappyStk`
happy_x_3 `HappyStk`
happy_x_2 `HappyStk`
happy_x_1 `HappyStk`
happyRest) tk
= happyThen (case happyOutTok happy_x_1 of { (TokKeyword KwRecord happy_var_1) ->
- case happyOut38 happy_x_2 of { happy_var_2 ->
- case happyOut58 happy_x_3 of { happy_var_3 ->
+ 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 happyOut134 happy_x_5 of { happy_var_5 ->
+ case happyOut137 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_302 = happyMonadReduce 5# 80# happyReduction_302
-happyReduction_302 (happy_x_5 `HappyStk`
+happyReduce_312 = happyMonadReduce 5# 80# happyReduction_312
+happyReduction_312 (happy_x_5 `HappyStk`
happy_x_4 `HappyStk`
happy_x_3 `HappyStk`
happy_x_2 `HappyStk`
happy_x_1 `HappyStk`
happyRest) tk
= happyThen (case happyOutTok happy_x_1 of { (TokKeyword KwRecord happy_var_1) ->
- case happyOut38 happy_x_2 of { happy_var_2 ->
- case happyOut58 happy_x_3 of { happy_var_3 ->
+ case happyOut39 happy_x_2 of { happy_var_2 ->
+ case happyOut59 happy_x_3 of { happy_var_3 ->
case happyOutTok happy_x_4 of { (TokSymbol SymColon happy_var_4) ->
- case happyOut30 happy_x_5 of { happy_var_5 ->
+ case happyOut31 happy_x_5 of { happy_var_5 ->
( 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_303 = happySpecReduce_2 81# happyReduction_303
-happyReduction_303 happy_x_2
+happyReduce_313 = happySpecReduce_2 81# happyReduction_313
+happyReduction_313 happy_x_2
happy_x_1
= case happyOut15 happy_x_2 of { happy_var_2 ->
happyIn87
(happy_var_2
)}
-happyReduce_304 = happySpecReduce_3 82# happyReduction_304
-happyReduction_304 happy_x_3
+happyReduce_314 = happySpecReduce_3 82# happyReduction_314
+happyReduction_314 happy_x_3
happy_x_2
happy_x_1
= case happyOutTok happy_x_1 of { (TokKeyword KwInfix happy_var_1) ->
@@ -3899,8 +4010,8 @@ happyReduction_304 happy_x_3
(Infix (NonAssoc (getRange (happy_var_1,happy_var_3)) happy_var_2) happy_var_3
)}}}
-happyReduce_305 = happySpecReduce_3 82# happyReduction_305
-happyReduction_305 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 KwInfixL happy_var_1) ->
@@ -3910,8 +4021,8 @@ happyReduction_305 happy_x_3
(Infix (LeftAssoc (getRange (happy_var_1,happy_var_3)) happy_var_2) happy_var_3
)}}}
-happyReduce_306 = happySpecReduce_3 82# happyReduction_306
-happyReduction_306 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 KwInfixR happy_var_1) ->
@@ -3921,79 +4032,101 @@ happyReduction_306 happy_x_3
(Infix (RightAssoc (getRange (happy_var_1,happy_var_3)) happy_var_2) happy_var_3
)}}}
-happyReduce_307 = happySpecReduce_2 83# happyReduction_307
-happyReduction_307 happy_x_2
+happyReduce_317 = happySpecReduce_2 83# happyReduction_317
+happyReduction_317 happy_x_2
happy_x_1
- = case happyOut131 happy_x_2 of { happy_var_2 ->
+ = case happyOut134 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_308 = happySpecReduce_2 84# happyReduction_308
-happyReduction_308 happy_x_2
+happyReduce_318 = happySpecReduce_2 84# happyReduction_318
+happyReduction_318 happy_x_2
happy_x_1
= case happyOutTok happy_x_1 of { (TokKeyword KwMutual happy_var_1) ->
- case happyOut136 happy_x_2 of { happy_var_2 ->
+ case happyOut139 happy_x_2 of { happy_var_2 ->
happyIn90
(Mutual (fuseRange happy_var_1 happy_var_2) happy_var_2
)}}
-happyReduce_309 = happySpecReduce_2 85# happyReduction_309
-happyReduction_309 happy_x_2
+happyReduce_319 = happySpecReduce_2 85# happyReduction_319
+happyReduction_319 happy_x_2
happy_x_1
= case happyOutTok happy_x_1 of { (TokKeyword KwAbstract happy_var_1) ->
- case happyOut136 happy_x_2 of { happy_var_2 ->
+ case happyOut139 happy_x_2 of { happy_var_2 ->
happyIn91
(Abstract (fuseRange happy_var_1 happy_var_2) happy_var_2
)}}
-happyReduce_310 = happySpecReduce_2 86# happyReduction_310
-happyReduction_310 happy_x_2
+happyReduce_320 = happySpecReduce_2 86# happyReduction_320
+happyReduction_320 happy_x_2
happy_x_1
= case happyOutTok happy_x_1 of { (TokKeyword KwPrivate happy_var_1) ->
- case happyOut136 happy_x_2 of { happy_var_2 ->
+ case happyOut139 happy_x_2 of { happy_var_2 ->
happyIn92
(Private (fuseRange happy_var_1 happy_var_2) happy_var_2
)}}
-happyReduce_311 = happySpecReduce_2 87# happyReduction_311
-happyReduction_311 happy_x_2
+happyReduce_321 = happySpecReduce_2 87# happyReduction_321
+happyReduction_321 happy_x_2
happy_x_1
- = case happyOutTok happy_x_1 of { (TokKeyword KwPostulate happy_var_1) ->
- case happyOut129 happy_x_2 of { happy_var_2 ->
+ = case happyOutTok happy_x_1 of { (TokKeyword KwInstance happy_var_1) ->
+ case happyOut139 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
+ happy_x_1
+ = case happyOutTok happy_x_1 of { (TokKeyword KwPostulate happy_var_1) ->
+ case happyOut139 happy_x_2 of { happy_var_2 ->
+ happyIn94
(Postulate (fuseRange happy_var_1 happy_var_2) happy_var_2
)}}
-happyReduce_312 = happySpecReduce_2 88# happyReduction_312
-happyReduction_312 happy_x_2
+happyReduce_323 = happySpecReduce_2 89# happyReduction_323
+happyReduction_323 happy_x_2
happy_x_1
= case happyOutTok happy_x_1 of { (TokKeyword KwPrimitive happy_var_1) ->
- case happyOut127 happy_x_2 of { happy_var_2 ->
- happyIn94
+ case happyOut132 happy_x_2 of { happy_var_2 ->
+ happyIn95
(Primitive (fuseRange happy_var_1 happy_var_2) happy_var_2
)}}
-happyReduce_313 = happyMonadReduce 5# 89# happyReduction_313
-happyReduction_313 (happy_x_5 `HappyStk`
+happyReduce_324 = happyReduce 4# 90# happyReduction_324
+happyReduction_324 (happy_x_4 `HappyStk`
+ happy_x_3 `HappyStk`
+ happy_x_2 `HappyStk`
+ happy_x_1 `HappyStk`
+ happyRest)
+ = case happyOutTok happy_x_1 of { (TokKeyword KwUnquoteDecl happy_var_1) ->
+ case happyOut15 happy_x_2 of { happy_var_2 ->
+ case happyOut31 happy_x_4 of { happy_var_4 ->
+ happyIn96
+ (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`
happy_x_4 `HappyStk`
happy_x_3 `HappyStk`
happy_x_2 `HappyStk`
happy_x_1 `HappyStk`
happyRest) tk
= happyThen (case happyOut15 happy_x_2 of { happy_var_2 ->
- case happyOut99 happy_x_3 of { happy_var_3 ->
- case happyOut98 happy_x_5 of { happy_var_5 ->
+ case happyOut101 happy_x_3 of { happy_var_3 ->
+ case happyOut100 happy_x_5 of { happy_var_5 ->
(
case happy_var_2 of
Name _ [_] -> case mkNotation happy_var_3 (map rangedThing happy_var_5) of
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)")}}}
- ) (\r -> happyReturn (happyIn95 r))
+ ) (\r -> happyReturn (happyIn97 r))
-happyReduce_314 = happyMonadReduce 5# 90# happyReduction_314
-happyReduction_314 (happy_x_5 `HappyStk`
+happyReduce_326 = happyMonadReduce 5# 92# happyReduction_326
+happyReduction_326 (happy_x_5 `HappyStk`
happy_x_4 `HappyStk`
happy_x_3 `HappyStk`
happy_x_2 `HappyStk`
@@ -4001,180 +4134,180 @@ happyReduction_314 (happy_x_5 `HappyStk`
happyRest) tk
= happyThen (case happyOutTok happy_x_1 of { (TokKeyword KwPatternSyn happy_var_1) ->
case happyOut15 happy_x_2 of { happy_var_2 ->
- case happyOut97 happy_x_3 of { happy_var_3 ->
+ case happyOut99 happy_x_3 of { happy_var_3 ->
case happyOutTok happy_x_4 of { (TokSymbol SymEqual happy_var_4) ->
- case happyOut30 happy_x_5 of { happy_var_5 ->
+ case happyOut31 happy_x_5 of { happy_var_5 ->
( do
p <- exprToPattern happy_var_5
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 (happyIn96 r))
+ ) (\r -> happyReturn (happyIn98 r))
-happyReduce_315 = happySpecReduce_0 91# happyReduction_315
-happyReduction_315 = happyIn97
+happyReduce_327 = happySpecReduce_0 93# happyReduction_327
+happyReduction_327 = happyIn99
([]
)
-happyReduce_316 = happyMonadReduce 1# 91# happyReduction_316
-happyReduction_316 (happy_x_1 `HappyStk`
+happyReduce_328 = happyMonadReduce 1# 93# happyReduction_328
+happyReduction_328 (happy_x_1 `HappyStk`
happyRest) tk
- = happyThen (case happyOut50 happy_x_1 of { happy_var_1 ->
+ = happyThen (case happyOut51 happy_x_1 of { happy_var_1 ->
( patternSynArgs happy_var_1)}
- ) (\r -> happyReturn (happyIn97 r))
+ ) (\r -> happyReturn (happyIn99 r))
-happyReduce_317 = happySpecReduce_1 92# happyReduction_317
-happyReduction_317 happy_x_1
- = case happyOut103 happy_x_1 of { happy_var_1 ->
- happyIn98
+happyReduce_329 = happySpecReduce_1 94# happyReduction_329
+happyReduction_329 happy_x_1
+ = case happyOut105 happy_x_1 of { happy_var_1 ->
+ happyIn100
([happy_var_1]
)}
-happyReduce_318 = happySpecReduce_2 92# happyReduction_318
-happyReduction_318 happy_x_2
+happyReduce_330 = happySpecReduce_2 94# happyReduction_330
+happyReduction_330 happy_x_2
happy_x_1
- = case happyOut98 happy_x_1 of { happy_var_1 ->
- case happyOut103 happy_x_2 of { happy_var_2 ->
- happyIn98
+ = case happyOut100 happy_x_1 of { happy_var_1 ->
+ case happyOut105 happy_x_2 of { happy_var_2 ->
+ happyIn100
(happy_var_1 ++ [happy_var_2]
)}}
-happyReduce_319 = happySpecReduce_1 93# happyReduction_319
-happyReduction_319 happy_x_1
- = case happyOut100 happy_x_1 of { happy_var_1 ->
- happyIn99
+happyReduce_331 = happySpecReduce_1 95# happyReduction_331
+happyReduction_331 happy_x_1
+ = case happyOut102 happy_x_1 of { happy_var_1 ->
+ happyIn101
([happy_var_1]
)}
-happyReduce_320 = happySpecReduce_2 93# happyReduction_320
-happyReduction_320 happy_x_2
+happyReduce_332 = happySpecReduce_2 95# happyReduction_332
+happyReduction_332 happy_x_2
happy_x_1
- = case happyOut99 happy_x_1 of { happy_var_1 ->
- case happyOut100 happy_x_2 of { happy_var_2 ->
- happyIn99
+ = case happyOut101 happy_x_1 of { happy_var_1 ->
+ case happyOut102 happy_x_2 of { happy_var_2 ->
+ happyIn101
(happy_var_1 ++ [happy_var_2]
)}}
-happyReduce_321 = happySpecReduce_1 94# happyReduction_321
-happyReduction_321 happy_x_1
- = case happyOut101 happy_x_1 of { happy_var_1 ->
- happyIn100
+happyReduce_333 = happySpecReduce_1 96# happyReduction_333
+happyReduction_333 happy_x_1
+ = case happyOut103 happy_x_1 of { happy_var_1 ->
+ happyIn102
(defaultNamedArg happy_var_1
)}
-happyReduce_322 = happySpecReduce_3 94# happyReduction_322
-happyReduction_322 happy_x_3
+happyReduce_334 = happySpecReduce_3 96# happyReduction_334
+happyReduction_334 happy_x_3
happy_x_2
happy_x_1
- = case happyOut102 happy_x_2 of { happy_var_2 ->
- happyIn100
+ = case happyOut104 happy_x_2 of { happy_var_2 ->
+ happyIn102
(setHiding Hidden $ defaultNamedArg happy_var_2
)}
-happyReduce_323 = happySpecReduce_3 94# happyReduction_323
-happyReduction_323 happy_x_3
+happyReduce_335 = happySpecReduce_3 96# happyReduction_335
+happyReduction_335 happy_x_3
happy_x_2
happy_x_1
- = case happyOut102 happy_x_2 of { happy_var_2 ->
- happyIn100
+ = case happyOut104 happy_x_2 of { happy_var_2 ->
+ happyIn102
(setHiding Instance $ defaultNamedArg happy_var_2
)}
-happyReduce_324 = happyReduce 5# 94# happyReduction_324
-happyReduction_324 (happy_x_5 `HappyStk`
+happyReduce_336 = happyReduce 5# 96# happyReduction_336
+happyReduction_336 (happy_x_5 `HappyStk`
happy_x_4 `HappyStk`
happy_x_3 `HappyStk`
happy_x_2 `HappyStk`
happy_x_1 `HappyStk`
happyRest)
- = case happyOut103 happy_x_2 of { happy_var_2 ->
- case happyOut102 happy_x_4 of { happy_var_4 ->
- happyIn100
+ = case happyOut105 happy_x_2 of { happy_var_2 ->
+ case happyOut104 happy_x_4 of { happy_var_4 ->
+ happyIn102
(setHiding Hidden $ defaultArg $ named happy_var_2 happy_var_4
) `HappyStk` happyRest}}
-happyReduce_325 = happyReduce 5# 94# happyReduction_325
-happyReduction_325 (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`
happy_x_1 `HappyStk`
happyRest)
- = case happyOut103 happy_x_2 of { happy_var_2 ->
- case happyOut102 happy_x_4 of { happy_var_4 ->
- happyIn100
+ = case happyOut105 happy_x_2 of { happy_var_2 ->
+ case happyOut104 happy_x_4 of { happy_var_4 ->
+ happyIn102
(setHiding Instance $ defaultArg $ named happy_var_2 happy_var_4
) `HappyStk` happyRest}}
-happyReduce_326 = happySpecReduce_1 95# happyReduction_326
-happyReduction_326 happy_x_1
- = case happyOut103 happy_x_1 of { happy_var_1 ->
- happyIn101
+happyReduce_338 = happySpecReduce_1 97# happyReduction_338
+happyReduction_338 happy_x_1
+ = case happyOut105 happy_x_1 of { happy_var_1 ->
+ happyIn103
(ExprHole (rangedThing happy_var_1)
)}
-happyReduce_327 = happyReduce 6# 95# happyReduction_327
-happyReduction_327 (happy_x_6 `HappyStk`
+happyReduce_339 = happyReduce 6# 97# happyReduction_339
+happyReduction_339 (happy_x_6 `HappyStk`
happy_x_5 `HappyStk`
happy_x_4 `HappyStk`
happy_x_3 `HappyStk`
happy_x_2 `HappyStk`
happy_x_1 `HappyStk`
happyRest)
- = case happyOut103 happy_x_3 of { happy_var_3 ->
- case happyOut103 happy_x_5 of { happy_var_5 ->
- happyIn101
+ = case happyOut105 happy_x_3 of { happy_var_3 ->
+ case happyOut105 happy_x_5 of { happy_var_5 ->
+ happyIn103
(LambdaHole (rangedThing happy_var_3) (rangedThing happy_var_5)
) `HappyStk` happyRest}}
-happyReduce_328 = happySpecReduce_1 96# happyReduction_328
-happyReduction_328 happy_x_1
- = case happyOut103 happy_x_1 of { happy_var_1 ->
- happyIn102
+happyReduce_340 = happySpecReduce_1 98# happyReduction_340
+happyReduction_340 happy_x_1
+ = case happyOut105 happy_x_1 of { happy_var_1 ->
+ happyIn104
(ExprHole (rangedThing happy_var_1)
)}
-happyReduce_329 = happyReduce 4# 96# happyReduction_329
-happyReduction_329 (happy_x_4 `HappyStk`
+happyReduce_341 = happyReduce 4# 98# happyReduction_341
+happyReduction_341 (happy_x_4 `HappyStk`
happy_x_3 `HappyStk`
happy_x_2 `HappyStk`
happy_x_1 `HappyStk`
happyRest)
- = case happyOut103 happy_x_2 of { happy_var_2 ->
- case happyOut103 happy_x_4 of { happy_var_4 ->
- happyIn102
+ = case happyOut105 happy_x_2 of { happy_var_2 ->
+ case happyOut105 happy_x_4 of { happy_var_4 ->
+ happyIn104
(LambdaHole (rangedThing happy_var_2) (rangedThing happy_var_4)
) `HappyStk` happyRest}}
-happyReduce_330 = happySpecReduce_1 97# happyReduction_330
-happyReduction_330 happy_x_1
+happyReduce_342 = happySpecReduce_1 99# happyReduction_342
+happyReduction_342 happy_x_1
= case happyOutTok happy_x_1 of { (TokId happy_var_1) ->
- happyIn103
+ happyIn105
(Ranged (getRange $ fst happy_var_1) (stringToRawName $ snd happy_var_1)
)}
-happyReduce_331 = happySpecReduce_1 98# happyReduction_331
-happyReduction_331 happy_x_1
+happyReduce_343 = happySpecReduce_1 100# happyReduction_343
+happyReduction_343 happy_x_1
= case happyOutTok happy_x_1 of { (TokKeyword KwOpen happy_var_1) ->
- happyIn104
+ happyIn106
(Just (getRange happy_var_1)
)}
-happyReduce_332 = happySpecReduce_0 98# happyReduction_332
-happyReduction_332 = happyIn104
+happyReduce_344 = happySpecReduce_0 100# happyReduction_344
+happyReduction_344 = happyIn106
(Nothing
)
-happyReduce_333 = happyMonadReduce 5# 99# happyReduction_333
-happyReduction_333 (happy_x_5 `HappyStk`
+happyReduce_345 = happyMonadReduce 5# 101# happyReduction_345
+happyReduction_345 (happy_x_5 `HappyStk`
happy_x_4 `HappyStk`
happy_x_3 `HappyStk`
happy_x_2 `HappyStk`
happy_x_1 `HappyStk`
happyRest) tk
- = happyThen (case happyOut104 happy_x_1 of { happy_var_1 ->
+ = happyThen (case happyOut106 happy_x_1 of { happy_var_1 ->
case happyOutTok happy_x_2 of { (TokKeyword KwImport happy_var_2) ->
case happyOut22 happy_x_3 of { happy_var_3 ->
- case happyOut106 happy_x_4 of { happy_var_4 ->
- case happyOut61 happy_x_5 of { happy_var_5 ->
+ case happyOut108 happy_x_4 of { happy_var_4 ->
+ case happyOut62 happy_x_5 of { happy_var_5 ->
(
let
{ doOpen = maybe DontOpen (const DoOpen) happy_var_1
@@ -4220,18 +4353,18 @@ happyReduction_333 (happy_x_5 `HappyStk`
, appStm (noName $ beginningOf $ getRange m) es
]
})}}}}}
- ) (\r -> happyReturn (happyIn105 r))
+ ) (\r -> happyReturn (happyIn107 r))
-happyReduce_334 = happyReduce 4# 99# happyReduction_334
-happyReduction_334 (happy_x_4 `HappyStk`
+happyReduce_346 = happyReduce 4# 101# happyReduction_346
+happyReduction_346 (happy_x_4 `HappyStk`
happy_x_3 `HappyStk`
happy_x_2 `HappyStk`
happy_x_1 `HappyStk`
happyRest)
= case happyOut22 happy_x_2 of { happy_var_2 ->
- case happyOut106 happy_x_3 of { happy_var_3 ->
- case happyOut61 happy_x_4 of { happy_var_4 ->
- happyIn105
+ case happyOut108 happy_x_3 of { happy_var_3 ->
+ case happyOut62 happy_x_4 of { happy_var_4 ->
+ happyIn107
(let
{ m = happy_var_2
; es = happy_var_3
@@ -4248,8 +4381,8 @@ happyReduction_334 (happy_x_4 `HappyStk`
]
) `HappyStk` happyRest}}}
-happyReduce_335 = happyReduce 6# 99# happyReduction_335
-happyReduction_335 (happy_x_6 `HappyStk`
+happyReduce_347 = happyReduce 6# 101# happyReduction_347
+happyReduction_347 (happy_x_6 `HappyStk`
happy_x_5 `HappyStk`
happy_x_4 `HappyStk`
happy_x_3 `HappyStk`
@@ -4257,8 +4390,8 @@ happyReduction_335 (happy_x_6 `HappyStk`
happy_x_1 `HappyStk`
happyRest)
= case happyOut22 happy_x_2 of { happy_var_2 ->
- case happyOut61 happy_x_6 of { happy_var_6 ->
- happyIn105
+ case happyOut62 happy_x_6 of { happy_var_6 ->
+ 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
@@ -4266,22 +4399,22 @@ happyReduction_335 (happy_x_6 `HappyStk`
]
) `HappyStk` happyRest}}
-happyReduce_336 = happySpecReduce_0 100# happyReduction_336
-happyReduction_336 = happyIn106
+happyReduce_348 = happySpecReduce_0 102# happyReduction_348
+happyReduction_348 = happyIn108
([]
)
-happyReduce_337 = happySpecReduce_2 100# happyReduction_337
-happyReduction_337 happy_x_2
+happyReduce_349 = happySpecReduce_2 102# happyReduction_349
+happyReduction_349 happy_x_2
happy_x_1
- = case happyOut39 happy_x_1 of { happy_var_1 ->
- case happyOut106 happy_x_2 of { happy_var_2 ->
- happyIn106
+ = case happyOut40 happy_x_1 of { happy_var_1 ->
+ case happyOut108 happy_x_2 of { happy_var_2 ->
+ happyIn108
(happy_var_1 : happy_var_2
)}}
-happyReduce_338 = happyReduce 4# 101# happyReduction_338
-happyReduction_338 (happy_x_4 `HappyStk`
+happyReduce_350 = happyReduce 4# 103# happyReduction_350
+happyReduction_350 (happy_x_4 `HappyStk`
happy_x_3 `HappyStk`
happy_x_2 `HappyStk`
happy_x_1 `HappyStk`
@@ -4290,23 +4423,23 @@ happyReduction_338 (happy_x_4 `HappyStk`
case happyOutTok happy_x_2 of { (TokSymbol SymDoubleOpenBrace happy_var_2) ->
case happyOutTok happy_x_3 of { (TokSymbol SymEllipsis happy_var_3) ->
case happyOut17 happy_x_4 of { happy_var_4 ->
- happyIn107
+ 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" )
) `HappyStk` happyRest}}}}
-happyReduce_339 = happySpecReduce_2 101# happyReduction_339
-happyReduction_339 happy_x_2
+happyReduce_351 = happySpecReduce_2 103# happyReduction_351
+happyReduction_351 happy_x_2
happy_x_1
= case happyOut22 happy_x_1 of { happy_var_1 ->
- case happyOut106 happy_x_2 of { happy_var_2 ->
- happyIn107
+ case happyOut108 happy_x_2 of { happy_var_2 ->
+ happyIn109
((\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_340 = happyMonadReduce 6# 102# happyReduction_340
-happyReduction_340 (happy_x_6 `HappyStk`
+happyReduce_352 = happyMonadReduce 6# 104# happyReduction_352
+happyReduction_352 (happy_x_6 `HappyStk`
happy_x_5 `HappyStk`
happy_x_4 `HappyStk`
happy_x_3 `HappyStk`
@@ -4315,16 +4448,16 @@ happyReduction_340 (happy_x_6 `HappyStk`
happyRest) tk
= happyThen (case happyOutTok happy_x_1 of { (TokKeyword KwModule happy_var_1) ->
case happyOut22 happy_x_2 of { happy_var_2 ->
- case happyOut58 happy_x_3 of { happy_var_3 ->
- case happyOut107 happy_x_5 of { happy_var_5 ->
- case happyOut61 happy_x_6 of { happy_var_6 ->
+ case happyOut59 happy_x_3 of { happy_var_3 ->
+ case happyOut109 happy_x_5 of { happy_var_5 ->
+ case happyOut62 happy_x_6 of { happy_var_6 ->
( do { ma <- happy_var_5 (map addType happy_var_3)
; name <- ensureUnqual happy_var_2
; return $ ModuleMacro (getRange (happy_var_1, happy_var_2, ma, happy_var_6)) name ma DontOpen happy_var_6 })}}}}}
- ) (\r -> happyReturn (happyIn108 r))
+ ) (\r -> happyReturn (happyIn110 r))
-happyReduce_341 = happyMonadReduce 7# 102# happyReduction_341
-happyReduction_341 (happy_x_7 `HappyStk`
+happyReduce_353 = happyMonadReduce 7# 104# happyReduction_353
+happyReduction_353 (happy_x_7 `HappyStk`
happy_x_6 `HappyStk`
happy_x_5 `HappyStk`
happy_x_4 `HappyStk`
@@ -4335,14 +4468,14 @@ happyReduction_341 (happy_x_7 `HappyStk`
= happyThen (case happyOutTok happy_x_1 of { (TokKeyword KwOpen happy_var_1) ->
case happyOutTok happy_x_2 of { (TokKeyword KwModule happy_var_2) ->
case happyOut15 happy_x_3 of { happy_var_3 ->
- case happyOut58 happy_x_4 of { happy_var_4 ->
- case happyOut107 happy_x_6 of { happy_var_6 ->
- case happyOut61 happy_x_7 of { happy_var_7 ->
+ case happyOut59 happy_x_4 of { happy_var_4 ->
+ case happyOut109 happy_x_6 of { happy_var_6 ->
+ case happyOut62 happy_x_7 of { happy_var_7 ->
( 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 (happyIn108 r))
+ ) (\r -> happyReturn (happyIn110 r))
-happyReduce_342 = happyReduce 5# 103# happyReduction_342
-happyReduction_342 (happy_x_5 `HappyStk`
+happyReduce_354 = happyReduce 5# 105# happyReduction_354
+happyReduction_354 (happy_x_5 `HappyStk`
happy_x_4 `HappyStk`
happy_x_3 `HappyStk`
happy_x_2 `HappyStk`
@@ -4350,143 +4483,164 @@ happyReduction_342 (happy_x_5 `HappyStk`
happyRest)
= case happyOutTok happy_x_1 of { (TokKeyword KwModule happy_var_1) ->
case happyOut22 happy_x_2 of { happy_var_2 ->
- case happyOut58 happy_x_3 of { happy_var_3 ->
+ 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 ->
- happyIn109
+ case happyOut140 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_343 = happyReduce 5# 103# happyReduction_343
-happyReduction_343 (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`
happy_x_1 `HappyStk`
happyRest)
= case happyOutTok happy_x_1 of { (TokKeyword KwModule happy_var_1) ->
- case happyOut110 happy_x_2 of { happy_var_2 ->
- case happyOut58 happy_x_3 of { happy_var_3 ->
+ 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 happyOut137 happy_x_5 of { happy_var_5 ->
- happyIn109
+ case happyOut140 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_344 = happySpecReduce_1 104# happyReduction_344
-happyReduction_344 happy_x_1
+happyReduce_356 = happySpecReduce_1 106# happyReduction_356
+happyReduction_356 happy_x_1
= case happyOutTok happy_x_1 of { (TokSymbol SymUnderscore happy_var_1) ->
- happyIn110
+ happyIn112
(noName (getRange happy_var_1)
)}
-happyReduce_345 = happySpecReduce_1 105# happyReduction_345
-happyReduction_345 happy_x_1
- = case happyOut139 happy_x_1 of { happy_var_1 ->
- happyIn111
+happyReduce_357 = happySpecReduce_1 107# happyReduction_357
+happyReduction_357 happy_x_1
+ = case happyOut142 happy_x_1 of { happy_var_1 ->
+ happyIn113
(figureOutTopLevelModule happy_var_1
)}
-happyReduce_346 = happySpecReduce_1 106# happyReduction_346
-happyReduction_346 happy_x_1
- = case happyOut113 happy_x_1 of { happy_var_1 ->
- happyIn112
+happyReduce_358 = happySpecReduce_1 108# happyReduction_358
+happyReduction_358 happy_x_1
+ = case happyOut115 happy_x_1 of { happy_var_1 ->
+ happyIn114
(Pragma happy_var_1
)}
-happyReduce_347 = happySpecReduce_1 107# happyReduction_347
-happyReduction_347 happy_x_1
- = case happyOut115 happy_x_1 of { happy_var_1 ->
- happyIn113
+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_348 = happySpecReduce_1 107# happyReduction_348
-happyReduction_348 happy_x_1
- = case happyOut116 happy_x_1 of { happy_var_1 ->
- happyIn113
+happyReduce_360 = happySpecReduce_1 109# happyReduction_360
+happyReduction_360 happy_x_1
+ = case happyOut118 happy_x_1 of { happy_var_1 ->
+ happyIn115
(happy_var_1
)}
-happyReduce_349 = happySpecReduce_1 107# happyReduction_349
-happyReduction_349 happy_x_1
- = case happyOut117 happy_x_1 of { happy_var_1 ->
- happyIn113
+happyReduce_361 = happySpecReduce_1 109# happyReduction_361
+happyReduction_361 happy_x_1
+ = case happyOut119 happy_x_1 of { happy_var_1 ->
+ happyIn115
(happy_var_1
)}
-happyReduce_350 = happySpecReduce_1 107# happyReduction_350
-happyReduction_350 happy_x_1
- = case happyOut119 happy_x_1 of { happy_var_1 ->
- happyIn113
+happyReduce_362 = happySpecReduce_1 109# happyReduction_362
+happyReduction_362 happy_x_1
+ = case happyOut120 happy_x_1 of { happy_var_1 ->
+ happyIn115
(happy_var_1
)}
-happyReduce_351 = happySpecReduce_1 107# happyReduction_351
-happyReduction_351 happy_x_1
- = case happyOut118 happy_x_1 of { happy_var_1 ->
- happyIn113
+happyReduce_363 = happySpecReduce_1 109# happyReduction_363
+happyReduction_363 happy_x_1
+ = case happyOut122 happy_x_1 of { happy_var_1 ->
+ happyIn115
(happy_var_1
)}
-happyReduce_352 = happySpecReduce_1 107# happyReduction_352
-happyReduction_352 happy_x_1
- = case happyOut120 happy_x_1 of { happy_var_1 ->
- happyIn113
+happyReduce_364 = happySpecReduce_1 109# happyReduction_364
+happyReduction_364 happy_x_1
+ = case happyOut121 happy_x_1 of { happy_var_1 ->
+ happyIn115
(happy_var_1
)}
-happyReduce_353 = happySpecReduce_1 107# happyReduction_353
-happyReduction_353 happy_x_1
- = case happyOut121 happy_x_1 of { happy_var_1 ->
- happyIn113
+happyReduce_365 = happySpecReduce_1 109# happyReduction_365
+happyReduction_365 happy_x_1
+ = case happyOut123 happy_x_1 of { happy_var_1 ->
+ happyIn115
(happy_var_1
)}
-happyReduce_354 = happySpecReduce_1 107# happyReduction_354
-happyReduction_354 happy_x_1
- = case happyOut122 happy_x_1 of { happy_var_1 ->
- happyIn113
+happyReduce_366 = happySpecReduce_1 109# happyReduction_366
+happyReduction_366 happy_x_1
+ = case happyOut124 happy_x_1 of { happy_var_1 ->
+ happyIn115
(happy_var_1
)}
-happyReduce_355 = happySpecReduce_1 107# happyReduction_355
-happyReduction_355 happy_x_1
+happyReduce_367 = happySpecReduce_1 109# happyReduction_367
+happyReduction_367 happy_x_1
= case happyOut125 happy_x_1 of { happy_var_1 ->
- happyIn113
+ happyIn115
(happy_var_1
)}
-happyReduce_356 = happySpecReduce_1 107# happyReduction_356
-happyReduction_356 happy_x_1
+happyReduce_368 = happySpecReduce_1 109# happyReduction_368
+happyReduction_368 happy_x_1
+ = case happyOut130 happy_x_1 of { happy_var_1 ->
+ happyIn115
+ (happy_var_1
+ )}
+
+happyReduce_369 = happySpecReduce_1 109# happyReduction_369
+happyReduction_369 happy_x_1
+ = case happyOut131 happy_x_1 of { happy_var_1 ->
+ happyIn115
+ (happy_var_1
+ )}
+
+happyReduce_370 = happySpecReduce_1 109# happyReduction_370
+happyReduction_370 happy_x_1
= case happyOut126 happy_x_1 of { happy_var_1 ->
- happyIn113
+ happyIn115
(happy_var_1
)}
-happyReduce_357 = happySpecReduce_1 107# happyReduction_357
-happyReduction_357 happy_x_1
- = case happyOut123 happy_x_1 of { happy_var_1 ->
- happyIn113
+happyReduce_371 = happySpecReduce_1 109# happyReduction_371
+happyReduction_371 happy_x_1
+ = case happyOut128 happy_x_1 of { happy_var_1 ->
+ happyIn115
(happy_var_1
)}
-happyReduce_358 = happySpecReduce_1 107# happyReduction_358
-happyReduction_358 happy_x_1
- = case happyOut124 happy_x_1 of { happy_var_1 ->
- happyIn113
+happyReduce_372 = happySpecReduce_1 109# happyReduction_372
+happyReduction_372 happy_x_1
+ = case happyOut127 happy_x_1 of { happy_var_1 ->
+ happyIn115
(happy_var_1
)}
-happyReduce_359 = happySpecReduce_1 107# happyReduction_359
-happyReduction_359 happy_x_1
- = case happyOut114 happy_x_1 of { happy_var_1 ->
- happyIn113
+happyReduce_373 = happySpecReduce_1 109# happyReduction_373
+happyReduction_373 happy_x_1
+ = case happyOut129 happy_x_1 of { happy_var_1 ->
+ happyIn115
+ (happy_var_1
+ )}
+
+happyReduce_374 = happySpecReduce_1 109# happyReduction_374
+happyReduction_374 happy_x_1
+ = case happyOut116 happy_x_1 of { happy_var_1 ->
+ happyIn115
(happy_var_1
)}
-happyReduce_360 = happyReduce 4# 108# happyReduction_360
-happyReduction_360 (happy_x_4 `HappyStk`
+happyReduce_375 = happyReduce 4# 110# happyReduction_375
+happyReduction_375 (happy_x_4 `HappyStk`
happy_x_3 `HappyStk`
happy_x_2 `HappyStk`
happy_x_1 `HappyStk`
@@ -4495,12 +4649,12 @@ happyReduction_360 (happy_x_4 `HappyStk`
case happyOutTok happy_x_2 of { (TokKeyword KwOPTIONS happy_var_2) ->
case happyOut27 happy_x_3 of { happy_var_3 ->
case happyOutTok happy_x_4 of { (TokSymbol SymClosePragma happy_var_4) ->
- happyIn114
+ happyIn116
(OptionsPragma (getRange (happy_var_1,happy_var_2,happy_var_4)) happy_var_3
) `HappyStk` happyRest}}}}
-happyReduce_361 = happyReduce 5# 109# happyReduction_361
-happyReduction_361 (happy_x_5 `HappyStk`
+happyReduce_376 = happyReduce 5# 111# happyReduction_376
+happyReduction_376 (happy_x_5 `HappyStk`
happy_x_4 `HappyStk`
happy_x_3 `HappyStk`
happy_x_2 `HappyStk`
@@ -4509,14 +4663,44 @@ happyReduction_361 (happy_x_5 `HappyStk`
= case happyOutTok happy_x_1 of { (TokSymbol SymOpenPragma happy_var_1) ->
case happyOutTok happy_x_2 of { (TokKeyword KwBUILTIN happy_var_2) ->
case happyOutTok happy_x_3 of { (TokString happy_var_3) ->
- case happyOut29 happy_x_4 of { happy_var_4 ->
+ case happyOut30 happy_x_4 of { happy_var_4 ->
case happyOutTok happy_x_5 of { (TokSymbol SymClosePragma happy_var_5) ->
- happyIn115
+ happyIn117
(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_362 = happyReduce 5# 110# happyReduction_362
-happyReduction_362 (happy_x_5 `HappyStk`
+happyReduce_377 = happyReduce 5# 111# happyReduction_377
+happyReduction_377 (happy_x_5 `HappyStk`
+ happy_x_4 `HappyStk`
+ happy_x_3 `HappyStk`
+ happy_x_2 `HappyStk`
+ happy_x_1 `HappyStk`
+ happyRest)
+ = case happyOutTok happy_x_1 of { (TokSymbol SymOpenPragma happy_var_1) ->
+ case happyOutTok happy_x_2 of { (TokKeyword KwBUILTIN happy_var_2) ->
+ case happyOutTok happy_x_3 of { (TokKeyword KwREWRITE happy_var_3) ->
+ case happyOut30 happy_x_4 of { happy_var_4 ->
+ case happyOutTok happy_x_5 of { (TokSymbol SymClosePragma happy_var_5) ->
+ happyIn117
+ (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`
+ happy_x_3 `HappyStk`
+ happy_x_2 `HappyStk`
+ happy_x_1 `HappyStk`
+ happyRest)
+ = case happyOutTok happy_x_1 of { (TokSymbol SymOpenPragma happy_var_1) ->
+ case happyOutTok happy_x_2 of { (TokKeyword KwREWRITE happy_var_2) ->
+ case happyOut30 happy_x_3 of { happy_var_3 ->
+ case happyOutTok happy_x_4 of { (TokSymbol SymClosePragma happy_var_4) ->
+ happyIn118
+ (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`
happy_x_4 `HappyStk`
happy_x_3 `HappyStk`
happy_x_2 `HappyStk`
@@ -4524,15 +4708,15 @@ happyReduction_362 (happy_x_5 `HappyStk`
happyRest)
= case happyOutTok happy_x_1 of { (TokSymbol SymOpenPragma happy_var_1) ->
case happyOutTok happy_x_2 of { (TokKeyword KwCOMPILED happy_var_2) ->
- case happyOut29 happy_x_3 of { happy_var_3 ->
+ case happyOut30 happy_x_3 of { happy_var_3 ->
case happyOut27 happy_x_4 of { happy_var_4 ->
case happyOutTok happy_x_5 of { (TokSymbol SymClosePragma happy_var_5) ->
- happyIn116
+ happyIn119
(CompiledPragma (getRange (happy_var_1,happy_var_2,happy_var_3,happy_var_5)) happy_var_3 (unwords happy_var_4)
) `HappyStk` happyRest}}}}}
-happyReduce_363 = happyReduce 5# 111# happyReduction_363
-happyReduction_363 (happy_x_5 `HappyStk`
+happyReduce_380 = happyReduce 5# 114# happyReduction_380
+happyReduction_380 (happy_x_5 `HappyStk`
happy_x_4 `HappyStk`
happy_x_3 `HappyStk`
happy_x_2 `HappyStk`
@@ -4540,15 +4724,15 @@ happyReduction_363 (happy_x_5 `HappyStk`
happyRest)
= case happyOutTok happy_x_1 of { (TokSymbol SymOpenPragma happy_var_1) ->
case happyOutTok happy_x_2 of { (TokKeyword KwCOMPILED_EXPORT happy_var_2) ->
- case happyOut29 happy_x_3 of { happy_var_3 ->
+ case happyOut30 happy_x_3 of { happy_var_3 ->
case happyOut28 happy_x_4 of { happy_var_4 ->
case happyOutTok happy_x_5 of { (TokSymbol SymClosePragma happy_var_5) ->
- happyIn117
+ happyIn120
(CompiledExportPragma (getRange (happy_var_1,happy_var_2,happy_var_3,happy_var_5)) happy_var_3 happy_var_4
) `HappyStk` happyRest}}}}}
-happyReduce_364 = happyReduce 5# 112# happyReduction_364
-happyReduction_364 (happy_x_5 `HappyStk`
+happyReduce_381 = happyReduce 5# 115# happyReduction_381
+happyReduction_381 (happy_x_5 `HappyStk`
happy_x_4 `HappyStk`
happy_x_3 `HappyStk`
happy_x_2 `HappyStk`
@@ -4556,15 +4740,15 @@ happyReduction_364 (happy_x_5 `HappyStk`
happyRest)
= case happyOutTok happy_x_1 of { (TokSymbol SymOpenPragma happy_var_1) ->
case happyOutTok happy_x_2 of { (TokKeyword KwCOMPILED_TYPE happy_var_2) ->
- case happyOut29 happy_x_3 of { happy_var_3 ->
+ case happyOut30 happy_x_3 of { happy_var_3 ->
case happyOut27 happy_x_4 of { happy_var_4 ->
case happyOutTok happy_x_5 of { (TokSymbol SymClosePragma happy_var_5) ->
- happyIn118
+ happyIn121
(CompiledTypePragma (getRange (happy_var_1,happy_var_2,happy_var_3,happy_var_5)) happy_var_3 (unwords happy_var_4)
) `HappyStk` happyRest}}}}}
-happyReduce_365 = happyReduce 6# 113# happyReduction_365
-happyReduction_365 (happy_x_6 `HappyStk`
+happyReduce_382 = happyReduce 6# 116# happyReduction_382
+happyReduction_382 (happy_x_6 `HappyStk`
happy_x_5 `HappyStk`
happy_x_4 `HappyStk`
happy_x_3 `HappyStk`
@@ -4573,16 +4757,16 @@ happyReduction_365 (happy_x_6 `HappyStk`
happyRest)
= case happyOutTok happy_x_1 of { (TokSymbol SymOpenPragma happy_var_1) ->
case happyOutTok happy_x_2 of { (TokKeyword KwCOMPILED_DATA happy_var_2) ->
- case happyOut29 happy_x_3 of { happy_var_3 ->
+ case happyOut30 happy_x_3 of { happy_var_3 ->
case happyOutTok happy_x_4 of { (TokString happy_var_4) ->
case happyOut27 happy_x_5 of { happy_var_5 ->
case happyOutTok happy_x_6 of { (TokSymbol SymClosePragma happy_var_6) ->
- happyIn119
+ happyIn122
(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_366 = happyReduce 5# 114# happyReduction_366
-happyReduction_366 (happy_x_5 `HappyStk`
+happyReduce_383 = happyReduce 5# 117# happyReduction_383
+happyReduction_383 (happy_x_5 `HappyStk`
happy_x_4 `HappyStk`
happy_x_3 `HappyStk`
happy_x_2 `HappyStk`
@@ -4590,15 +4774,15 @@ happyReduction_366 (happy_x_5 `HappyStk`
happyRest)
= case happyOutTok happy_x_1 of { (TokSymbol SymOpenPragma happy_var_1) ->
case happyOutTok happy_x_2 of { (TokKeyword KwCOMPILED_EPIC happy_var_2) ->
- case happyOut29 happy_x_3 of { happy_var_3 ->
+ case happyOut30 happy_x_3 of { happy_var_3 ->
case happyOut27 happy_x_4 of { happy_var_4 ->
case happyOutTok happy_x_5 of { (TokSymbol SymClosePragma happy_var_5) ->
- happyIn120
+ happyIn123
(CompiledEpicPragma (getRange (happy_var_1,happy_var_2,happy_var_3,happy_var_5)) happy_var_3 (unwords happy_var_4)
) `HappyStk` happyRest}}}}}
-happyReduce_367 = happyReduce 5# 115# happyReduction_367
-happyReduction_367 (happy_x_5 `HappyStk`
+happyReduce_384 = happyReduce 5# 118# happyReduction_384
+happyReduction_384 (happy_x_5 `HappyStk`
happy_x_4 `HappyStk`
happy_x_3 `HappyStk`
happy_x_2 `HappyStk`
@@ -4606,54 +4790,80 @@ happyReduction_367 (happy_x_5 `HappyStk`
happyRest)
= case happyOutTok happy_x_1 of { (TokSymbol SymOpenPragma happy_var_1) ->
case happyOutTok happy_x_2 of { (TokKeyword KwCOMPILED_JS happy_var_2) ->
- case happyOut29 happy_x_3 of { happy_var_3 ->
+ case happyOut30 happy_x_3 of { happy_var_3 ->
case happyOut27 happy_x_4 of { happy_var_4 ->
case happyOutTok happy_x_5 of { (TokSymbol SymClosePragma happy_var_5) ->
- happyIn121
+ happyIn124
(CompiledJSPragma (getRange (happy_var_1,happy_var_2,happy_var_3,happy_var_5)) happy_var_3 (unwords happy_var_4)
) `HappyStk` happyRest}}}}}
-happyReduce_368 = happyReduce 4# 116# happyReduction_368
-happyReduction_368 (happy_x_4 `HappyStk`
+happyReduce_385 = happyReduce 4# 119# happyReduction_385
+happyReduction_385 (happy_x_4 `HappyStk`
happy_x_3 `HappyStk`
happy_x_2 `HappyStk`
happy_x_1 `HappyStk`
happyRest)
= case happyOutTok happy_x_1 of { (TokSymbol SymOpenPragma happy_var_1) ->
case happyOutTok happy_x_2 of { (TokKeyword KwSTATIC happy_var_2) ->
- case happyOut29 happy_x_3 of { happy_var_3 ->
+ case happyOut30 happy_x_3 of { happy_var_3 ->
case happyOutTok happy_x_4 of { (TokSymbol SymClosePragma happy_var_4) ->
- happyIn122
+ happyIn125
(StaticPragma (getRange (happy_var_1,happy_var_2,happy_var_3,happy_var_4)) happy_var_3
) `HappyStk` happyRest}}}}
-happyReduce_369 = happyReduce 4# 117# happyReduction_369
-happyReduction_369 (happy_x_4 `HappyStk`
+happyReduce_386 = happyReduce 4# 120# happyReduction_386
+happyReduction_386 (happy_x_4 `HappyStk`
happy_x_3 `HappyStk`
happy_x_2 `HappyStk`
happy_x_1 `HappyStk`
happyRest)
= case happyOutTok happy_x_1 of { (TokSymbol SymOpenPragma happy_var_1) ->
case happyOutTok happy_x_2 of { (TokKeyword KwETA happy_var_2) ->
- case happyOut29 happy_x_3 of { happy_var_3 ->
+ case happyOut30 happy_x_3 of { happy_var_3 ->
case happyOutTok happy_x_4 of { (TokSymbol SymClosePragma happy_var_4) ->
- happyIn123
+ happyIn126
(EtaPragma (getRange (happy_var_1,happy_var_2,happy_var_3,happy_var_4)) happy_var_3
) `HappyStk` happyRest}}}}
-happyReduce_370 = happySpecReduce_3 118# happyReduction_370
-happyReduction_370 happy_x_3
+happyReduce_387 = happySpecReduce_3 121# happyReduction_387
+happyReduction_387 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 KwNO_TERMINATION_CHECK happy_var_2) ->
case happyOutTok happy_x_3 of { (TokSymbol SymClosePragma happy_var_3) ->
- happyIn124
- (NoTerminationCheckPragma (getRange (happy_var_1,happy_var_2,happy_var_3))
+ happyIn127
+ (TerminationCheckPragma (getRange (happy_var_1,happy_var_2,happy_var_3)) NoTerminationCheck
+ )}}}
+
+happyReduce_388 = happySpecReduce_3 122# happyReduction_388
+happyReduction_388 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 KwNON_TERMINATING happy_var_2) ->
+ case happyOutTok happy_x_3 of { (TokSymbol SymClosePragma happy_var_3) ->
+ happyIn128
+ (TerminationCheckPragma (getRange (happy_var_1,happy_var_2,happy_var_3)) NonTerminating
)}}}
-happyReduce_371 = happyMonadReduce 4# 119# happyReduction_371
-happyReduction_371 (happy_x_4 `HappyStk`
+happyReduce_389 = happyReduce 4# 123# happyReduction_389
+happyReduction_389 (happy_x_4 `HappyStk`
+ happy_x_3 `HappyStk`
+ happy_x_2 `HappyStk`
+ happy_x_1 `HappyStk`
+ happyRest)
+ = case happyOutTok happy_x_1 of { (TokSymbol SymOpenPragma happy_var_1) ->
+ 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
+ (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`
happy_x_3 `HappyStk`
happy_x_2 `HappyStk`
happy_x_1 `HappyStk`
@@ -4666,173 +4876,147 @@ happyReduction_371 (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 (happyIn125 r))
+ ) (\r -> happyReturn (happyIn130 r))
-happyReduce_372 = happySpecReduce_3 120# happyReduction_372
-happyReduction_372 happy_x_3
+happyReduce_391 = happySpecReduce_3 125# 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 KwIMPOSSIBLE happy_var_2) ->
case happyOutTok happy_x_3 of { (TokSymbol SymClosePragma happy_var_3) ->
- happyIn126
+ happyIn131
(ImpossiblePragma (getRange (happy_var_1,happy_var_2,happy_var_3))
)}}}
-happyReduce_373 = happySpecReduce_3 121# happyReduction_373
-happyReduction_373 happy_x_3
- happy_x_2
- happy_x_1
- = case happyOut128 happy_x_2 of { happy_var_2 ->
- happyIn127
- (reverse happy_var_2
- )}
-
-happyReduce_374 = happySpecReduce_3 122# happyReduction_374
-happyReduction_374 happy_x_3
+happyReduce_392 = happySpecReduce_3 126# happyReduction_392
+happyReduction_392 happy_x_3
happy_x_2
happy_x_1
- = case happyOut128 happy_x_1 of { happy_var_1 ->
- case happyOut78 happy_x_3 of { happy_var_3 ->
- happyIn128
- (reverse happy_var_3 ++ happy_var_1
- )}}
-
-happyReduce_375 = happySpecReduce_1 122# happyReduction_375
-happyReduction_375 happy_x_1
- = case happyOut78 happy_x_1 of { happy_var_1 ->
- happyIn128
- (reverse happy_var_1
- )}
-
-happyReduce_376 = happySpecReduce_3 123# happyReduction_376
-happyReduction_376 happy_x_3
- happy_x_2
- happy_x_1
- = case happyOut130 happy_x_2 of { happy_var_2 ->
- happyIn129
+ = case happyOut133 happy_x_2 of { happy_var_2 ->
+ happyIn132
(reverse happy_var_2
)}
-happyReduce_377 = happySpecReduce_3 124# happyReduction_377
-happyReduction_377 happy_x_3
+happyReduce_393 = happySpecReduce_3 127# happyReduction_393
+happyReduction_393 happy_x_3
happy_x_2
happy_x_1
- = case happyOut130 happy_x_1 of { happy_var_1 ->
+ = case happyOut133 happy_x_1 of { happy_var_1 ->
case happyOut79 happy_x_3 of { happy_var_3 ->
- happyIn130
+ happyIn133
(reverse happy_var_3 ++ happy_var_1
)}}
-happyReduce_378 = happySpecReduce_1 124# happyReduction_378
-happyReduction_378 happy_x_1
+happyReduce_394 = happySpecReduce_1 127# happyReduction_394
+happyReduction_394 happy_x_1
= case happyOut79 happy_x_1 of { happy_var_1 ->
- happyIn130
+ happyIn133
(reverse happy_var_1
)}
-happyReduce_379 = happySpecReduce_3 125# happyReduction_379
-happyReduction_379 happy_x_3
+happyReduce_395 = happySpecReduce_3 128# happyReduction_395
+happyReduction_395 happy_x_3
happy_x_2
happy_x_1
- = case happyOut132 happy_x_2 of { happy_var_2 ->
- happyIn131
+ = case happyOut135 happy_x_2 of { happy_var_2 ->
+ happyIn134
(reverse happy_var_2
)}
-happyReduce_380 = happySpecReduce_3 126# happyReduction_380
-happyReduction_380 happy_x_3
+happyReduce_396 = happySpecReduce_3 129# happyReduction_396
+happyReduction_396 happy_x_3
happy_x_2
happy_x_1
- = case happyOut132 happy_x_1 of { happy_var_1 ->
+ = case happyOut135 happy_x_1 of { happy_var_1 ->
case happyOut80 happy_x_3 of { happy_var_3 ->
- happyIn132
+ happyIn135
(reverse happy_var_3 ++ happy_var_1
)}}
-happyReduce_381 = happySpecReduce_1 126# happyReduction_381
-happyReduction_381 happy_x_1
+happyReduce_397 = happySpecReduce_1 129# happyReduction_397
+happyReduction_397 happy_x_1
= case happyOut80 happy_x_1 of { happy_var_1 ->
- happyIn132
+ happyIn135
(reverse happy_var_1
)}
-happyReduce_382 = happySpecReduce_2 127# happyReduction_382
-happyReduction_382 happy_x_2
+happyReduce_398 = happySpecReduce_2 130# happyReduction_398
+happyReduction_398 happy_x_2
happy_x_1
- = happyIn133
+ = happyIn136
([]
)
-happyReduce_383 = happySpecReduce_1 127# happyReduction_383
-happyReduction_383 happy_x_1
- = case happyOut127 happy_x_1 of { happy_var_1 ->
- happyIn133
+happyReduce_399 = happySpecReduce_1 130# happyReduction_399
+happyReduction_399 happy_x_1
+ = case happyOut132 happy_x_1 of { happy_var_1 ->
+ happyIn136
(happy_var_1
)}
-happyReduce_384 = happySpecReduce_2 128# happyReduction_384
-happyReduction_384 happy_x_2
+happyReduce_400 = happySpecReduce_2 131# happyReduction_400
+happyReduction_400 happy_x_2
happy_x_1
- = happyIn134
+ = happyIn137
((Nothing, Nothing, [])
)
-happyReduce_385 = happySpecReduce_3 128# happyReduction_385
-happyReduction_385 happy_x_3
+happyReduce_401 = happySpecReduce_3 131# happyReduction_401
+happyReduction_401 happy_x_3
happy_x_2
happy_x_1
= case happyOut87 happy_x_2 of { happy_var_2 ->
- happyIn134
+ happyIn137
((Nothing, Just happy_var_2, [])
)}
-happyReduce_386 = happyReduce 5# 128# happyReduction_386
-happyReduction_386 (happy_x_5 `HappyStk`
+happyReduce_402 = happyReduce 5# 131# happyReduction_402
+happyReduction_402 (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 happyOut138 happy_x_4 of { happy_var_4 ->
- happyIn134
+ case happyOut141 happy_x_4 of { happy_var_4 ->
+ happyIn137
((Nothing, Just happy_var_2, happy_var_4)
) `HappyStk` happyRest}}
-happyReduce_387 = happySpecReduce_3 128# happyReduction_387
-happyReduction_387 happy_x_3
+happyReduce_403 = happySpecReduce_3 131# happyReduction_403
+happyReduction_403 happy_x_3
happy_x_2
happy_x_1
- = case happyOut138 happy_x_2 of { happy_var_2 ->
- happyIn134
+ = case happyOut141 happy_x_2 of { happy_var_2 ->
+ happyIn137
((Nothing, Nothing, happy_var_2)
)}
-happyReduce_388 = happySpecReduce_3 128# happyReduction_388
-happyReduction_388 happy_x_3
+happyReduce_404 = happySpecReduce_3 131# happyReduction_404
+happyReduction_404 happy_x_3
happy_x_2
happy_x_1
- = case happyOut135 happy_x_2 of { happy_var_2 ->
- happyIn134
+ = case happyOut138 happy_x_2 of { happy_var_2 ->
+ happyIn137
((Just happy_var_2, Nothing, [])
)}
-happyReduce_389 = happyReduce 5# 128# happyReduction_389
-happyReduction_389 (happy_x_5 `HappyStk`
+happyReduce_405 = happyReduce 5# 131# 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 happyOut135 happy_x_2 of { happy_var_2 ->
+ = case happyOut138 happy_x_2 of { happy_var_2 ->
case happyOut87 happy_x_4 of { happy_var_4 ->
- happyIn134
+ happyIn137
((Just happy_var_2, Just happy_var_4, [])
) `HappyStk` happyRest}}
-happyReduce_390 = happyReduce 7# 128# happyReduction_390
-happyReduction_390 (happy_x_7 `HappyStk`
+happyReduce_406 = happyReduce 7# 131# happyReduction_406
+happyReduction_406 (happy_x_7 `HappyStk`
happy_x_6 `HappyStk`
happy_x_5 `HappyStk`
happy_x_4 `HappyStk`
@@ -4840,89 +5024,89 @@ happyReduction_390 (happy_x_7 `HappyStk`
happy_x_2 `HappyStk`
happy_x_1 `HappyStk`
happyRest)
- = case happyOut135 happy_x_2 of { happy_var_2 ->
+ = case happyOut138 happy_x_2 of { happy_var_2 ->
case happyOut87 happy_x_4 of { happy_var_4 ->
- case happyOut138 happy_x_6 of { happy_var_6 ->
- happyIn134
+ case happyOut141 happy_x_6 of { happy_var_6 ->
+ happyIn137
((Just happy_var_2, Just happy_var_4, happy_var_6)
) `HappyStk` happyRest}}}
-happyReduce_391 = happyReduce 5# 128# happyReduction_391
-happyReduction_391 (happy_x_5 `HappyStk`
+happyReduce_407 = happyReduce 5# 131# happyReduction_407
+happyReduction_407 (happy_x_5 `HappyStk`
happy_x_4 `HappyStk`
happy_x_3 `HappyStk`
happy_x_2 `HappyStk`
happy_x_1 `HappyStk`
happyRest)
- = case happyOut135 happy_x_2 of { happy_var_2 ->
- case happyOut138 happy_x_4 of { happy_var_4 ->
- happyIn134
+ = case happyOut138 happy_x_2 of { happy_var_2 ->
+ case happyOut141 happy_x_4 of { happy_var_4 ->
+ happyIn137
((Just happy_var_2, Nothing, happy_var_4)
) `HappyStk` happyRest}}
-happyReduce_392 = happySpecReduce_1 129# happyReduction_392
-happyReduction_392 happy_x_1
+happyReduce_408 = happySpecReduce_1 132# happyReduction_408
+happyReduction_408 happy_x_1
= case happyOutTok happy_x_1 of { (TokKeyword KwInductive happy_var_1) ->
- happyIn135
+ happyIn138
(Ranged (getRange happy_var_1) Inductive
)}
-happyReduce_393 = happySpecReduce_1 129# happyReduction_393
-happyReduction_393 happy_x_1
+happyReduce_409 = happySpecReduce_1 132# happyReduction_409
+happyReduction_409 happy_x_1
= case happyOutTok happy_x_1 of { (TokKeyword KwCoInductive happy_var_1) ->
- happyIn135
+ happyIn138
(Ranged (getRange happy_var_1) CoInductive
)}
-happyReduce_394 = happySpecReduce_3 130# happyReduction_394
-happyReduction_394 happy_x_3
+happyReduce_410 = happySpecReduce_3 133# happyReduction_410
+happyReduction_410 happy_x_3
happy_x_2
happy_x_1
- = case happyOut138 happy_x_2 of { happy_var_2 ->
- happyIn136
+ = case happyOut141 happy_x_2 of { happy_var_2 ->
+ happyIn139
(happy_var_2
)}
-happyReduce_395 = happySpecReduce_2 131# happyReduction_395
-happyReduction_395 happy_x_2
+happyReduce_411 = happySpecReduce_2 134# happyReduction_411
+happyReduction_411 happy_x_2
happy_x_1
- = happyIn137
+ = happyIn140
([]
)
-happyReduce_396 = happySpecReduce_1 131# happyReduction_396
-happyReduction_396 happy_x_1
- = case happyOut136 happy_x_1 of { happy_var_1 ->
- happyIn137
+happyReduce_412 = happySpecReduce_1 134# happyReduction_412
+happyReduction_412 happy_x_1
+ = case happyOut139 happy_x_1 of { happy_var_1 ->
+ happyIn140
(happy_var_1
)}
-happyReduce_397 = happySpecReduce_3 132# happyReduction_397
-happyReduction_397 happy_x_3
+happyReduce_413 = happySpecReduce_3 135# happyReduction_413
+happyReduction_413 happy_x_3
happy_x_2
happy_x_1
- = case happyOut77 happy_x_1 of { happy_var_1 ->
- case happyOut138 happy_x_3 of { happy_var_3 ->
- happyIn138
+ = case happyOut78 happy_x_1 of { happy_var_1 ->
+ case happyOut141 happy_x_3 of { happy_var_3 ->
+ happyIn141
(happy_var_1 ++ happy_var_3
)}}
-happyReduce_398 = happySpecReduce_1 132# happyReduction_398
-happyReduction_398 happy_x_1
- = case happyOut77 happy_x_1 of { happy_var_1 ->
- happyIn138
+happyReduce_414 = happySpecReduce_1 135# happyReduction_414
+happyReduction_414 happy_x_1
+ = case happyOut78 happy_x_1 of { happy_var_1 ->
+ happyIn141
(happy_var_1
)}
-happyReduce_399 = happySpecReduce_0 133# happyReduction_399
-happyReduction_399 = happyIn139
+happyReduce_415 = happySpecReduce_0 136# happyReduction_415
+happyReduction_415 = happyIn142
([]
)
-happyReduce_400 = happySpecReduce_1 133# happyReduction_400
-happyReduction_400 happy_x_1
- = case happyOut138 happy_x_1 of { happy_var_1 ->
- happyIn139
+happyReduce_416 = happySpecReduce_1 136# happyReduction_416
+happyReduction_416 happy_x_1
+ = case happyOut141 happy_x_1 of { happy_var_1 ->
+ happyIn142
(happy_var_1
)}
@@ -4930,7 +5114,7 @@ happyNewToken action sts stk
= lexer(\tk ->
let cont i = happyDoAction i tk action sts stk in
case tk of {
- TokEOF -> happyDoAction 82# tk action sts stk;
+ TokEOF -> happyDoAction 88# 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#;
@@ -4959,63 +5143,69 @@ happyNewToken action sts stk
TokKeyword KwMutual happy_dollar_dollar -> cont 26#;
TokKeyword KwAbstract happy_dollar_dollar -> cont 27#;
TokKeyword KwPrivate happy_dollar_dollar -> cont 28#;
- TokKeyword KwProp happy_dollar_dollar -> cont 29#;
- TokKeyword KwSet happy_dollar_dollar -> cont 30#;
- TokKeyword KwForall happy_dollar_dollar -> cont 31#;
- TokKeyword KwSyntax happy_dollar_dollar -> cont 32#;
- TokKeyword KwPatternSyn happy_dollar_dollar -> cont 33#;
- TokKeyword KwOPTIONS happy_dollar_dollar -> cont 34#;
- TokKeyword KwBUILTIN happy_dollar_dollar -> cont 35#;
- TokKeyword KwIMPORT happy_dollar_dollar -> cont 36#;
- TokKeyword KwIMPOSSIBLE happy_dollar_dollar -> cont 37#;
- TokKeyword KwETA happy_dollar_dollar -> cont 38#;
- TokKeyword KwNO_TERMINATION_CHECK happy_dollar_dollar -> cont 39#;
- TokKeyword KwCOMPILED happy_dollar_dollar -> cont 40#;
- TokKeyword KwCOMPILED_EXPORT happy_dollar_dollar -> cont 41#;
- TokKeyword KwCOMPILED_DATA happy_dollar_dollar -> cont 42#;
- TokKeyword KwCOMPILED_TYPE happy_dollar_dollar -> cont 43#;
- TokKeyword KwCOMPILED_EPIC happy_dollar_dollar -> cont 44#;
- TokKeyword KwCOMPILED_JS happy_dollar_dollar -> cont 45#;
- TokKeyword KwSTATIC happy_dollar_dollar -> cont 46#;
- TokKeyword KwQuoteGoal happy_dollar_dollar -> cont 47#;
- TokKeyword KwQuoteContext happy_dollar_dollar -> cont 48#;
- TokKeyword KwQuote happy_dollar_dollar -> cont 49#;
- TokKeyword KwQuoteTerm happy_dollar_dollar -> cont 50#;
- TokKeyword KwUnquote happy_dollar_dollar -> cont 51#;
- TokSetN happy_dollar_dollar -> cont 52#;
- TokTeX happy_dollar_dollar -> cont 53#;
- TokComment happy_dollar_dollar -> cont 54#;
- TokSymbol SymEllipsis happy_dollar_dollar -> cont 55#;
- TokSymbol SymDotDot happy_dollar_dollar -> cont 56#;
- TokSymbol SymDot happy_dollar_dollar -> cont 57#;
- TokSymbol SymSemi happy_dollar_dollar -> cont 58#;
- TokSymbol SymColon happy_dollar_dollar -> cont 59#;
- TokSymbol SymEqual happy_dollar_dollar -> cont 60#;
- TokSymbol SymUnderscore happy_dollar_dollar -> cont 61#;
- TokSymbol SymQuestionMark happy_dollar_dollar -> cont 62#;
- TokSymbol SymArrow happy_dollar_dollar -> cont 63#;
- TokSymbol SymLambda happy_dollar_dollar -> cont 64#;
- TokSymbol SymAs happy_dollar_dollar -> cont 65#;
- TokSymbol SymBar happy_dollar_dollar -> cont 66#;
- TokSymbol SymOpenParen happy_dollar_dollar -> cont 67#;
- TokSymbol SymCloseParen happy_dollar_dollar -> cont 68#;
- TokSymbol SymDoubleOpenBrace happy_dollar_dollar -> cont 69#;
- TokSymbol SymDoubleCloseBrace happy_dollar_dollar -> cont 70#;
- TokSymbol SymOpenBrace happy_dollar_dollar -> cont 71#;
- TokSymbol SymCloseBrace happy_dollar_dollar -> cont 72#;
- TokSymbol SymOpenVirtualBrace happy_dollar_dollar -> cont 73#;
- TokSymbol SymCloseVirtualBrace happy_dollar_dollar -> cont 74#;
- TokSymbol SymVirtualSemi happy_dollar_dollar -> cont 75#;
- TokSymbol SymOpenPragma happy_dollar_dollar -> cont 76#;
- TokSymbol SymClosePragma happy_dollar_dollar -> cont 77#;
- TokId happy_dollar_dollar -> cont 78#;
- TokQId happy_dollar_dollar -> cont 79#;
- TokString happy_dollar_dollar -> cont 80#;
- TokLiteral happy_dollar_dollar -> cont 81#;
+ TokKeyword KwInstance happy_dollar_dollar -> cont 29#;
+ TokKeyword KwProp happy_dollar_dollar -> cont 30#;
+ TokKeyword KwSet happy_dollar_dollar -> cont 31#;
+ TokKeyword KwForall happy_dollar_dollar -> cont 32#;
+ TokKeyword KwSyntax happy_dollar_dollar -> cont 33#;
+ TokKeyword KwPatternSyn happy_dollar_dollar -> cont 34#;
+ TokKeyword KwOPTIONS happy_dollar_dollar -> cont 35#;
+ TokKeyword KwBUILTIN happy_dollar_dollar -> cont 36#;
+ TokKeyword KwREWRITE happy_dollar_dollar -> cont 37#;
+ TokKeyword KwIMPORT happy_dollar_dollar -> cont 38#;
+ TokKeyword KwIMPOSSIBLE happy_dollar_dollar -> cont 39#;
+ 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#;
_ -> happyError' tk
})
-happyError_ 82# tk = happyError' tk
+happyError_ 88# tk = happyError' tk
happyError_ _ tk = happyError' tk
happyThen :: () => Parser a -> (a -> Parser b) -> Parser b
@@ -5032,7 +5222,7 @@ tokensParser = happySomeParser where
happySomeParser = happyThen (happyParse 0#) (\x -> happyReturn (happyOut6 x))
exprParser = happySomeParser where
- happySomeParser = happyThen (happyParse 1#) (\x -> happyReturn (happyOut30 x))
+ happySomeParser = happyThen (happyParse 1#) (\x -> happyReturn (happyOut31 x))
moduleParser = happySomeParser where
happySomeParser = happyThen (happyParse 2#) (\x -> happyReturn (happyOut9 x))
@@ -5247,6 +5437,7 @@ exprToPattern e =
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
@@ -5321,7 +5512,6 @@ 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 028c29f..dd7fff4 100644
--- a/src/data/agda.sty
+++ b/src/data/agda.sty
@@ -4,7 +4,7 @@
\ProvidesPackage{agda}
-\RequirePackage{ifxetex, ifluatex, ifthen, xcolor, polytable, etoolbox}
+\RequirePackage{ifxetex, ifluatex, xifthen, xcolor, polytable, etoolbox}
% http://tex.stackexchange.com/questions/47576/combining-ifxetex-and-ifluatex-with-the-logical-or-operation
\newif\ifxetexorluatex
@@ -47,23 +47,48 @@
\fi
% ----------------------------------------------------------------------
-% Colour schemes.
-
-\newcommand{\AgdaColourScheme}{standard}
+% Options
-\DeclareOption{bw} {\renewcommand{\AgdaColourScheme}{bw}}
-\DeclareOption{conor}{\renewcommand{\AgdaColourScheme}{conor}}
+\DeclareOption{bw} {\newcommand{\AgdaColourScheme}{bw}}
+\DeclareOption{conor}{\newcommand{\AgdaColourScheme}{conor}}
-% ----------------------------------------------------------------------
-% Links (only done if the option is passed and the user has loaded the
-% hyperref package).
+\newif\if at AgdaEnableReferences\@AgdaEnableReferencesfalse
+\DeclareOption{references}{
+ \@AgdaEnableReferencestrue
+}
\newif\if at AgdaEnableLinks\@AgdaEnableLinksfalse
\DeclareOption{links}{
- \@AgdaEnableLinkstrue
+ \@AgdaEnableLinkstrue
}
+
\ProcessOptions\relax
+% ----------------------------------------------------------------------
+% Colour schemes.
+
+\providecommand{\AgdaColourScheme}{standard}
+
+% ----------------------------------------------------------------------
+% References to code (needs additional post-processing of tex files to
+% work, see wiki for details).
+
+\if at AgdaEnableReferences
+ \RequirePackage{catchfilebetweentags, xstring}
+ \newcommand{\AgdaRef}[2][]{%
+ \StrSubstitute{#2}{\_}{AgdaUnderscore}[\tmp]%
+ \ifthenelse{\isempty{#1}}%
+ {\ExecuteMetaData{AgdaTag-\tmp}}%
+ {\ExecuteMetaData{#1}{AgdaTag-\tmp}}
+ }
+\fi
+
+\providecommand{\AgdaRef}[2][]{#2}
+
+% ----------------------------------------------------------------------
+% Links (only done if the option is passed and the user has loaded the
+% hyperref package).
+
\if at AgdaEnableLinks
\@ifpackageloaded{hyperref}{
diff --git a/src/data/emacs-mode/agda2-mode.el b/src/data/emacs-mode/agda2-mode.el
index a30f9bf..4f1c162 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.0.2"
+(defvar agda2-version "2.4.2"
"The version of the Agda mode.
Note that the same version of the Agda executable must be used.")
@@ -251,6 +251,7 @@ constituents.")
(agda2-compute-normalised-maybe-toplevel "\C-c\C-n" (local global) "Evaluate term to normal form")
(describe-char nil (global) "Information about the character at point")
(agda2-comment-dwim-rest-of-buffer ,(kbd "C-c C-x M-;") (global) "Comment/uncomment the rest of the buffer")
+ (agda2-display-program-version nil (global) "Version")
(eri-indent ,(kbd "TAB"))
(eri-indent-reverse [S-iso-lefttab])
(eri-indent-reverse [S-lefttab])
@@ -1126,19 +1127,20 @@ top-level scope."
"Cmd_helper_function"
"Expression")
-(defun agda2-module-contents ()
+(agda2-maybe-normalised
+ agda2-module-contents
"Shows all the top-level names in the given module.
Along with their types."
- (interactive)
- (agda2-goal-cmd "Cmd_show_module_contents" "Module name"))
+ "Cmd_show_module_contents"
+ "Module name")
-(defun agda2-module-contents-toplevel (module)
+(agda2-maybe-normalised-toplevel
+ agda2-module-contents-toplevel
"Shows all the top-level names in the given module.
Along with their types."
- (interactive "MModule name: ")
- (agda2-go t nil t
- "Cmd_show_module_contents_toplevel"
- (agda2-string-quote module)))
+ "Cmd_show_module_contents_toplevel"
+ "Module name"
+)
(defun agda2-module-contents-maybe-toplevel ()
"Shows all the top-level names in the given module.
@@ -1199,6 +1201,11 @@ With a prefix argument \"abstract\" is ignored during the computation."
(call-interactively 'agda2-compute-normalised)
(call-interactively 'agda2-compute-normalised-toplevel)))
+(defun agda2-display-program-version ()
+ "Display version of Agda"
+ (interactive)
+ (agda2-go nil nil t "Cmd_show_version"))
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
diff --git a/src/data/postprocess-latex.pl b/src/data/postprocess-latex.pl
new file mode 100644
index 0000000..d52573b
--- /dev/null
+++ b/src/data/postprocess-latex.pl
@@ -0,0 +1,24 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+
+my $tag_prefix = "AgdaTag";
+my $underscore = "AgdaUnderscore";
+my $commands = qr"(InductiveConstructor|CoinductiveConstructor\
+ |Datatype|Field|Function|Module|Postulate|Record)";
+
+while (<>) {
+
+ s|(\\Agda$commands){(.*?)}
+
+ | my $cmd = $1;
+ my $arg = $3;
+ my $tag = "$tag_prefix-$3" =~ s/\\_/$underscore/gr;
+
+ $_ = "\n%<*$tag>\n$cmd\{$arg\}\n%</$tag>\n";
+ |gxe;
+
+ print;
+
+}
diff --git a/src/full/Agda/Auto/Convert.hs b/src/full/Agda/Auto/Convert.hs
index 3af609d..e5beb90 100644
--- a/src/full/Agda/Auto/Convert.hs
+++ b/src/full/Agda/Auto/Convert.hs
@@ -15,7 +15,8 @@ import qualified Agda.Syntax.Abstract.Name as AN
import qualified Agda.Syntax.Abstract as A
import qualified Agda.Syntax.Position as SP
import qualified Agda.TypeChecking.Monad.Base as MB
-import Agda.TypeChecking.Monad.Signature (getConstInfo, getDefFreeVars, getImportedSignature)
+import Agda.TypeChecking.Monad.State (getImportedSignature)
+import Agda.TypeChecking.Monad.Signature (getConstInfo, getDefFreeVars)
import Agda.Utils.Permutation (Permutation(Perm), permute, takeP, compactP)
import Agda.TypeChecking.Level (reallyUnLevelView)
import Agda.TypeChecking.Monad.Base (mvJudgement, mvPermutation, getMetaInfo, ctxEntry, envContext, clEnv)
@@ -405,6 +406,7 @@ tomyExp v0 =
_ -> tomyExp t
I.DontCare _ -> return $ NotM $ dontCare
I.Shared p -> tomyExp $ I.derefPtr p
+ I.ExtLam{} -> __IMPOSSIBLE__
tomyExps [] = return $ NotM ALNil
tomyExps (C.Arg info a : as) = do
@@ -432,6 +434,7 @@ 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 m [] = False
fmExps m (a : as) = fmExp m (C.unArg a) || fmExps m as
@@ -749,6 +752,7 @@ findClauseDeep m = do
I.MetaV m' _ -> m == m'
I.DontCare _ -> False
I.Shared{} -> __IMPOSSIBLE__
+ I.ExtLam{} -> __IMPOSSIBLE__
findMetas = any (findMeta . C.unArg)
findMetat (I.El _ e) = findMeta e
toplevel e =
diff --git a/src/full/Agda/Auto/NarrowingSearch.hs b/src/full/Agda/Auto/NarrowingSearch.hs
index 508f68e..d2cbc73 100644
--- a/src/full/Agda/Auto/NarrowingSearch.hs
+++ b/src/full/Agda/Auto/NarrowingSearch.hs
@@ -5,7 +5,7 @@
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE UndecidableInstances #-}
+-- {-# LANGUAGE UndecidableInstances #-}
module Agda.Auto.NarrowingSearch where
diff --git a/src/full/Agda/Compiler/Epic/FromAgda.hs b/src/full/Agda/Compiler/Epic/FromAgda.hs
index a33a9ab..f03c5d0 100644
--- a/src/full/Agda/Compiler/Epic/FromAgda.hs
+++ b/src/full/Agda/Compiler/Epic/FromAgda.hs
@@ -259,6 +259,7 @@ substTerm env term = case T.unSpine term of
T.Sort _ -> return UNIT
T.MetaV _ _ -> return UNIT
T.DontCare _ -> return UNIT
+ T.ExtLam{} -> __IMPOSSIBLE__
-- | Translate Agda literals to our AUX definition
substLit :: TL.Literal -> Compile TCM Lit
diff --git a/src/full/Agda/Compiler/Epic/Static.hs b/src/full/Agda/Compiler/Epic/Static.hs
index 4004e47..22747c7 100644
--- a/src/full/Agda/Compiler/Epic/Static.hs
+++ b/src/full/Agda/Compiler/Epic/Static.hs
@@ -105,6 +105,7 @@ instance Evaluate Term where
Level l -> return term
DontCare i -> return term
Shared{} -> updateSharedTermT evaluate term
+ ExtLam{} -> __IMPOSSIBLE__
where
{-
evaluateTerms :: Args -> Compile TCM Args
diff --git a/src/full/Agda/Compiler/HaskellTypes.hs b/src/full/Agda/Compiler/HaskellTypes.hs
index 653b04c..924c613 100644
--- a/src/full/Agda/Compiler/HaskellTypes.hs
+++ b/src/full/Agda/Compiler/HaskellTypes.hs
@@ -135,3 +135,4 @@ haskellType t = fromType t
Shared p -> fromTerm $ derefPtr p
MetaV{} -> err
DontCare{} -> err
+ ExtLam{} -> __IMPOSSIBLE__
diff --git a/src/full/Agda/Compiler/JS/Compiler.hs b/src/full/Agda/Compiler/JS/Compiler.hs
index 3df80a8..c4531c4 100644
--- a/src/full/Agda/Compiler/JS/Compiler.hs
+++ b/src/full/Agda/Compiler/JS/Compiler.hs
@@ -26,7 +26,7 @@ import Agda.Syntax.Internal
( Name, Args, Type,
Clause, Pattern(VarP,DotP,LitP,ConP,ProjP),
ClauseBodyF(Body,NoBody,Bind),ClauseBody,
- Term(Var,Lam,Lit,Level,Def,Con,Pi,Sort,MetaV,DontCare,Shared),
+ Term(Var,Lam,Lit,Level,Def,Con,Pi,Sort,MetaV,DontCare,Shared,ExtLam),
unSpine, allApplyElims,
conName,
derefPtr,
@@ -413,6 +413,7 @@ term v = do
(Sort _) -> return (String "*")
(MetaV _ _) -> return (Undefined)
(DontCare _) -> return (Undefined)
+ ExtLam{} -> __IMPOSSIBLE__
-- Check to see if a type is a singleton, and if so, return its only
-- member. Singleton types are of the form T1 -> ... -> Tn -> T where
diff --git a/src/full/Agda/Compiler/JS/Syntax.hs b/src/full/Agda/Compiler/JS/Syntax.hs
index d74f664..f361e89 100644
--- a/src/full/Agda/Compiler/JS/Syntax.hs
+++ b/src/full/Agda/Compiler/JS/Syntax.hs
@@ -1,5 +1,4 @@
-{-# LANGUAGE DeriveDataTypeable
- #-}
+{-# 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 ffb44d4..06598f4 100644
--- a/src/full/Agda/Compiler/MAlonzo/Compiler.hs
+++ b/src/full/Agda/Compiler/MAlonzo/Compiler.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE CPP #-}
{-# LANGUAGE PatternGuards #-}
module Agda.Compiler.MAlonzo.Compiler where
@@ -127,11 +127,11 @@ definition kit (Defn Forced _ _ _ _ _ _ _ _) = __IMPOSSIBLE__
definition kit (Defn UnusedArg _ _ _ _ _ _ _ _) = __IMPOSSIBLE__
definition kit (Defn NonStrict _ _ _ _ _ _ _ _) = __IMPOSSIBLE__
-}
-definition kit (Defn info q _ _ _ _ _ _ _) | isIrrelevant info = do
+definition kit Defn{defArgInfo = info, defName = q} | isIrrelevant info = do
reportSDoc "malonzo.definition" 10 $
text "Not compiling" <+> prettyTCM q <> text "."
return []
-definition kit (Defn _ q ty _ _ _ _ compiled d) = do
+definition kit Defn{defName = q, defType = ty, defCompiledRep = compiled, theDef = d} = do
reportSDoc "malonzo.definition" 10 $ vcat
[ text "Compiling" <+> prettyTCM q <> text ":"
, nest 2 $ text (show d)
@@ -205,21 +205,40 @@ definition kit (Defn _ q ty _ _ _ _ compiled d) = do
-- Just c -> snd <$> condecl c
return $ tvaldecl q Inductive noFields ar [cd] cl
where
+ function :: [Clause] -> Maybe HaskellExport -> TCM [HS.Decl]
function cls (Just (HsExport t name)) =
- (HS.TypeSig dummy [HS.Ident name] (fakeType t) :) <$>
- mkwhere <$> mapM (clause q (Just name)) (tag 0 cls)
- function cls Nothing = mkwhere <$> mapM (clause q Nothing) (tag 0 cls)
+ do ccls <- functionStdName cls
+ let tsig :: HS.Decl
+ tsig = HS.TypeSig dummy [HS.Ident name] (fakeType t)
+
+ def :: HS.Decl
+ def = HS.FunBind [HS.Match dummy (HS.Ident name) [] Nothing (HS.UnGuardedRhs (hsVarUQ $ dsubname q 0)) (HS.BDecls [])]
+ return ([tsig,def] ++ ccls)
+ function cls Nothing = functionStdName cls
+
+ functionStdName :: [Clause] -> TCM [HS.Decl]
+ functionStdName cls = mkwhere <$> mapM (clause q Nothing) (tag 0 cls)
+
+ tag :: Nat -> [Clause] -> [(Nat, Bool, Clause)]
tag _ [] = []
- tag i [cl] = (i, True , cl): []
- tag i (cl:cls) = (i, False, cl): tag (i + 1) cls
+ tag i [cl] = (i, True , cl) : []
+ tag i (cl:cls) = (i, False, cl) : tag (i + 1) cls
+
+ mkwhere :: [HS.Decl] -> [HS.Decl]
mkwhere (HS.FunBind [m0, HS.Match _ dn ps mt rhs (HS.BDecls [])] :
fbs@(_:_)) =
[HS.FunBind [m0, HS.Match dummy dn ps mt rhs (HS.BDecls fbs)]]
mkwhere fbs = fbs
+
+ fbWithType :: HaskellType -> HS.Exp -> [HS.Decl]
fbWithType ty e =
[ HS.TypeSig dummy [unqhname "d" q] $ fakeType ty ] ++ fb e
+
+ fb :: HS.Exp -> [HS.Decl]
fb e = [HS.FunBind [HS.Match dummy (unqhname "d" q) [] Nothing
(HS.UnGuardedRhs $ e) (HS.BDecls [])]]
+
+ axiomErr :: HS.Exp
axiomErr = rtmError $ "postulate evaluated: " ++ show q
checkConstructorType :: QName -> TCM [HS.Decl]
@@ -361,6 +380,7 @@ term tm0 = case unSpine $ ignoreSharing tm0 of
MetaV _ _ -> mazerror "hit MetaV"
DontCare _ -> return $ rtmError $ "hit DontCare"
Shared{} -> __IMPOSSIBLE__
+ ExtLam{} -> __IMPOSSIBLE__
where apps = foldM (\h a -> HS.App h <$> term' a)
-- | Irrelevant arguments are replaced by Haskells' ().
diff --git a/src/full/Agda/Compiler/MAlonzo/Misc.hs b/src/full/Agda/Compiler/MAlonzo/Misc.hs
index b5fd8d0..0d3256e 100644
--- a/src/full/Agda/Compiler/MAlonzo/Misc.hs
+++ b/src/full/Agda/Compiler/MAlonzo/Misc.hs
@@ -136,7 +136,8 @@ bltQual b s = do
Def q _ <- ignoreSharing <$> getBuiltin b
xqual q (HS.Ident s)
--- sub-naming for cascaded definitions for concsecutive clauses
+-- Sub-naming for cascaded definitions for consecutive clauses.
+dsubname :: QName -> Nat -> HS.Name
dsubname q i | i == 0 = unqhname "d" q
| otherwise = unqhname ("d_" ++ show i ++ "_") q
@@ -157,7 +158,9 @@ mazerror msg = error $ mazstr ++ ": " ++ msg
mazCoerce = HS.Var $ HS.Qual mazRTE $ HS.Ident "mazCoerce"
-- Andreas, 2011-11-16: error incomplete match now RTE-call
+mazIncompleteMatch :: HS.Exp
mazIncompleteMatch = HS.Var $ HS.Qual mazRTE $ HS.Ident "mazIncompleteMatch"
+
rtmIncompleteMatch :: QName -> HS.Exp
rtmIncompleteMatch q = mazIncompleteMatch `HS.App` hsVarUQ (unqhname "name" q)
diff --git a/src/full/Agda/Compiler/MAlonzo/Primitives.hs b/src/full/Agda/Compiler/MAlonzo/Primitives.hs
index c663d6a..aa7a280 100644
--- a/src/full/Agda/Compiler/MAlonzo/Primitives.hs
+++ b/src/full/Agda/Compiler/MAlonzo/Primitives.hs
@@ -196,6 +196,7 @@ primBody s = maybe unimplemented (either (hsVarUQ . HS.Ident) id <$>) $
, "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)"
diff --git a/src/full/Agda/Interaction/BasicOps.hs b/src/full/Agda/Interaction/BasicOps.hs
index 50e569c..5ad70e9 100644
--- a/src/full/Agda/Interaction/BasicOps.hs
+++ b/src/full/Agda/Interaction/BasicOps.hs
@@ -47,7 +47,7 @@ import Agda.TypeChecking.Coverage
import Agda.TypeChecking.Records
import Agda.TypeChecking.Irrelevance (wakeIrrelevantVars)
import Agda.TypeChecking.Pretty (prettyTCM)
-import Agda.TypeChecking.Free (freeIn)
+import Agda.TypeChecking.Free
import qualified Agda.TypeChecking.Pretty as TP
import Agda.Utils.Functor
@@ -278,7 +278,8 @@ instance Reify Constraint (OutputConstraint Expr Expr) where
OpenIFS{} -> __IMPOSSIBLE__
InstS{} -> __IMPOSSIBLE__
InstV{} -> __IMPOSSIBLE__
- reify (FindInScope m cands) = do
+ reify (FindInScope m mcands) = do
+ let cands = caseMaybe mcands [] (\ x -> x)
m' <- reify (MetaV m [])
ctxArgs <- getContextArgs
t <- getMetaType m
@@ -485,8 +486,15 @@ metaHelperType norm ii rng s = case words s of
-- Remember the arity of a
TelV atel _ <- telView a
let arity = size atel
- a <- local (\e -> e { envPrintDomainFreePi = True }) $ do
- reify =<< cleanupType arity args =<< normalForm norm =<< withFunctionType tel vs as EmptyTel a
+ fv = allVars $ freeVars (vs, as)
+ SplitTel delta1 delta2 perm = splitTelescope fv tel
+ a' = renameP (reverseP perm) a
+ (vs, as) <- do
+ let -- We know that as does not depend on Δ₂
+ rho = parallelS (replicate (size delta2) __IMPOSSIBLE__)
+ 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'
return (OfType' h a)
where
cleanupType arity args t = do
@@ -543,6 +551,7 @@ metaHelperType norm ii rng s = case words s of
I.Level{} -> pure v
I.MetaV{} -> pure v
I.Shared{} -> pure v
+ I.ExtLam{} -> __IMPOSSIBLE__
onNamesElims f = traverse $ traverse $ onNamesTm f
onNamesArgs f = traverse $ traverse $ onNamesTm f
onNamesAbs f = onNamesAbs' f (stringToArgName <.> f . argNameToString)
@@ -743,14 +752,16 @@ parseName r s = do
-- | Returns the contents of the given module.
-moduleContents :: Range
+moduleContents :: Rewrite
+ -- ^ How should the types be presented
+ -> Range
-- ^ The range of the next argument.
-> String
-- ^ The module name.
-> TCM ([C.Name], [(C.Name, Type)])
-- ^ Module names, names paired up with
-- corresponding types.
-moduleContents rng s = do
+moduleContents norm rng s = do
m <- parseName rng s
modScope <- getNamedScope . amodName =<< resolveModule m
let modules :: ThingsInScope AbstractModule
@@ -759,7 +770,7 @@ moduleContents rng s = do
names = exportedNamesInScope modScope
types <- mapM (\(x, n) -> do
d <- getConstInfo $ anameName n
- t <- defType <$> instantiateDef d
+ t <- normalForm norm =<< (defType <$> instantiateDef d)
return (x, t))
(concatMap (\(x, ns) -> map ((,) x) ns) $
Map.toList names)
diff --git a/src/full/Agda/Interaction/EmacsTop.hs b/src/full/Agda/Interaction/EmacsTop.hs
index 74b61d4..e5a1d04 100644
--- a/src/full/Agda/Interaction/EmacsTop.hs
+++ b/src/full/Agda/Interaction/EmacsTop.hs
@@ -28,6 +28,7 @@ import Agda.Interaction.InteractionTop
import Agda.Interaction.EmacsCommand
import Agda.Interaction.Highlighting.Emacs
+import Agda.Version
----------------------------------
@@ -95,6 +96,7 @@ lispifyResponse (Resp_DisplayInfo info) = return $ case info of
]
]
Info_Intro s -> f (render s) "*Intro*"
+ Info_Version -> f ("Agda version " ++ version) "*Agda Version*"
where f content bufname = [ display_info' False bufname content ]
lispifyResponse Resp_ClearHighlighting = return [ L [ A "agda2-highlight-clear" ] ]
lispifyResponse Resp_ClearRunningInfo = return [ clearRunningInfo ]
diff --git a/src/full/Agda/Interaction/Highlighting/Generate.hs b/src/full/Agda/Interaction/Highlighting/Generate.hs
index 90b99fb..39eabdc 100644
--- a/src/full/Agda/Interaction/Highlighting/Generate.hs
+++ b/src/full/Agda/Interaction/Highlighting/Generate.hs
@@ -427,6 +427,7 @@ nameKinds hlLevel decl = do
declToKind (A.Open {}) = id
declToKind (A.PatternSynDef q _ _) = insert q (Constructor SC.Inductive)
declToKind (A.FunDef _ q _ _) = insert q Function
+ declToKind (A.UnquoteDecl _ _ q _) = insert q Function
declToKind (A.DataSig _ q _ _) = insert q Datatype
declToKind (A.DataDef _ q _ cs) = \m ->
insert q Datatype $
diff --git a/src/full/Agda/Interaction/Imports.hs b/src/full/Agda/Interaction/Imports.hs
index 3f7368a..d8d2809 100644
--- a/src/full/Agda/Interaction/Imports.hs
+++ b/src/full/Agda/Interaction/Imports.hs
@@ -42,6 +42,7 @@ import Agda.TypeChecking.Reduce
import Agda.TypeChecking.Monad
-- import Agda.TypeChecking.Monad.Base.KillRange -- killRange for Signature
import Agda.TypeChecking.Serialise
+import Agda.TypeChecking.Telescope
import Agda.TypeChecking.Primitive
import Agda.TypeChecking.Monad.Benchmark (billTop, reimburseTop)
import qualified Agda.TypeChecking.Monad.Benchmark as Bench
@@ -101,13 +102,14 @@ mergeInterface i = do
addImportedThings ::
Signature -> BuiltinThings PrimFun -> Set String -> A.PatternSynDefns -> TCM ()
-addImportedThings isig ibuiltin hsImports patsyns =
+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
}
+ addSignatureInstances isig
-- | Scope checks the given module. A proper version of the module
-- name (with correct definition sites) is returned.
@@ -209,7 +211,7 @@ getInterface_ :: C.TopLevelModuleName -> TCM Interface
getInterface_ x = do
(i, wt) <- getInterface' x False
case wt of
- SomeWarnings w -> typeError $ warningsToError w
+ SomeWarnings w -> warningsToError w
NoWarnings -> return i
-- | A more precise variant of 'getInterface'. If warnings are
@@ -368,8 +370,10 @@ getInterface' x includeStateChanges =
return (True, r)
else do
ms <- getImportPath
- nesting <- envModuleNestingLevel <$> ask
- mf <- stModuleToSource <$> get
+ nesting <- asks envModuleNestingLevel
+ range <- asks envRange
+ call <- asks envCall
+ mf <- gets stModuleToSource
vs <- getVisitedModules
ds <- getDecodedModules
opts <- stPersistentOptions . stPersistent <$> get
@@ -386,6 +390,12 @@ getInterface' x includeStateChanges =
r <- freshTCM $
withImportPath ms $
local (\e -> e { envModuleNestingLevel = nesting
+ -- Andreas, 2014-08-18:
+ -- Preserve the range of import statement
+ -- for reporting termination errors in
+ -- imported modules:
+ , envRange = range
+ , envCall = call
}) $ do
setDecodedModules ds
setCommandLineOptions opts
@@ -587,8 +597,10 @@ createInterface file mname =
let ifile = filePath $ toIFile file
writeInterface ifile i
return (i, NoWarnings)
- else
- return (i, SomeWarnings $ Warnings termErrs unsolvedMetas unsolvedConstraints)
+ else do
+ termErr <- if null termErrs then return Nothing else Just <$> do
+ typeError_ $ TerminationCheckFailed termErrs
+ return (i, SomeWarnings $ Warnings termErr unsolvedMetas unsolvedConstraints)
-- Profiling: Print statistics.
verboseS "profile" 1 $ do
diff --git a/src/full/Agda/Interaction/InteractionTop.hs b/src/full/Agda/Interaction/InteractionTop.hs
index e92c64d..b559605 100644
--- a/src/full/Agda/Interaction/InteractionTop.hs
+++ b/src/full/Agda/Interaction/InteractionTop.hs
@@ -3,7 +3,6 @@
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE ScopedTypeVariables #-}
@@ -287,6 +286,7 @@ data Interaction' range
-- | Shows all the top-level names in the given module, along with
-- their types. Uses the top-level scope.
| Cmd_show_module_contents_toplevel
+ B.Rewrite
String
| Cmd_solveAll
@@ -372,7 +372,7 @@ data Interaction' range
-- | Shows all the top-level names in the given module, along with
-- their types. Uses the scope of the given goal.
| Cmd_show_module_contents
- InteractionId range String
+ B.Rewrite InteractionId range String
| Cmd_make_case InteractionId range String
@@ -381,6 +381,8 @@ data Interaction' range
| Cmd_why_in_scope InteractionId range String
| Cmd_why_in_scope_toplevel String
+ -- | Displays version of the running Agda
+ | Cmd_show_version
deriving (Read, Functor, Foldable, Traversable)
@@ -474,10 +476,11 @@ instance Read a => Read (Position' a) where
-- into the state?
independent :: Interaction -> Bool
-independent (Cmd_load {}) = True
-independent (Cmd_compile {}) = True
+independent (Cmd_load {}) = True
+independent (Cmd_compile {}) = True
independent (Cmd_load_highlighting_info {}) = True
-independent _ = False
+independent Cmd_show_version = True
+independent _ = False
-- | Interpret an interaction
@@ -532,8 +535,8 @@ interpret Cmd_metas = do -- CL.showMetas []
d <- B.withMetaId i (showATop m)
return $ d ++ " [ at " ++ show r ++ " ]"
-interpret (Cmd_show_module_contents_toplevel s) =
- liftCommandMT B.atTopLevel $ showModuleContents noRange s
+interpret (Cmd_show_module_contents_toplevel norm s) =
+ liftCommandMT B.atTopLevel $ showModuleContents norm noRange s
interpret Cmd_solveAll = do
out <- lift $ mapM lowr =<< B.getSolvedInteractionPoints False -- only solve metas which have a proper instantiation, i.e., not another meta
@@ -548,7 +551,8 @@ interpret (Cmd_infer_toplevel norm s) =
parseAndDoAtToplevel (B.typeInCurrent norm) Info_InferredType s
interpret (Cmd_compute_toplevel ignore s) =
- parseAndDoAtToplevel (if ignore then ignoreAbstractMode . c
+ parseAndDoAtToplevel (allowNonTerminatingReductions .
+ if ignore then ignoreAbstractMode . c
else inConcreteMode . c)
Info_NormalForm
s
@@ -692,8 +696,8 @@ interpret (Cmd_goal_type_context_infer norm ii rng s) = do
prettyATop =<< B.typeInMeta ii norm =<< B.parseExprIn ii rng s
cmd_goal_type_context_and (text "Have:" <+> typ) norm ii rng s
-interpret (Cmd_show_module_contents ii rng s) =
- liftCommandMT (B.withInteractionId ii) $ showModuleContents rng s
+interpret (Cmd_show_module_contents norm ii rng s) =
+ liftCommandMT (B.withInteractionId ii) $ showModuleContents norm rng s
interpret (Cmd_why_in_scope_toplevel s) =
liftCommandMT B.atTopLevel $ whyInScope s
@@ -743,6 +747,8 @@ interpret (Cmd_compute ignore ii rng s) = do
prettyATop v
display_info $ Info_NormalForm d
+interpret Cmd_show_version = display_info Info_Version
+
type GoalCommand = InteractionId -> Range -> String -> Interaction
-- | @cmd_load' m includes cmd cmd2@ loads the module in file @m@,
@@ -956,9 +962,9 @@ cmd_goal_type_context_and doc norm ii _ _ = do
-- | Shows all the top-level names in the given module, along with
-- their types.
-showModuleContents :: Range -> String -> CommandM ()
-showModuleContents rng s = do
- (modules, types) <- lift $ B.moduleContents rng s
+showModuleContents :: B.Rewrite -> Range -> String -> CommandM ()
+showModuleContents norm rng s = do
+ (modules, types) <- lift $ B.moduleContents norm rng s
types' <- lift $ forM types $ \ (x, t) -> do
t <- prettyTCM t
return (show x, text ":" <+> t)
@@ -1008,6 +1014,7 @@ whyInScope s = do
pKind ConName = TCP.text "constructor"
pKind FldName = TCP.text "record field"
pKind PatternSynName = TCP.text "pattern synonym"
+ pKind QuotableName = TCP.text "quotable name"
pName :: AbstractName -> TCM Doc
pName a = TCP.sep
@@ -1142,9 +1149,13 @@ parseAndDoAtToplevel
-- ^ The expression to parse.
-> CommandM ()
parseAndDoAtToplevel cmd title s = do
- e <- liftIO $ parse exprParser s
- display_info . title =<<
- lift (B.atTopLevel $ prettyA =<< cmd =<< concreteToAbstract_ e)
+ e <- liftIO $ parse exprParser s
+ doTime <- lift $ hasVerbosity "profile.interactive" 10
+ 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
+ display_info (title res)
-- | Tell to highlight the code using the given highlighting
-- info (unless it is @Nothing@).
diff --git a/src/full/Agda/Interaction/Options.hs b/src/full/Agda/Interaction/Options.hs
index ae20f03..50f453d 100644
--- a/src/full/Agda/Interaction/Options.hs
+++ b/src/full/Agda/Interaction/Options.hs
@@ -1,6 +1,9 @@
{-# LANGUAGE CPP #-}
+
+#if __GLASGOW_HASKELL__ <= 706
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE StandaloneDeriving #-}
+#endif
module Agda.Interaction.Options
( CommandLineOptions(..)
@@ -305,6 +308,7 @@ guardingTypeConstructorFlag o = return $ o { optGuardingTypeConstructors = Tru
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 }
@@ -442,6 +446,8 @@ pragmaOptions =
"disable projection of irrelevant record fields"
, Option [] ["experimental-irrelevance"] (NoArg experimentalIrrelevanceFlag)
"enable potentially unsound irrelevance features (irrelevant levels, irrelevant data matching)"
+ , Option [] ["with-K"] (NoArg withKFlag)
+ "enable the K rule in pattern matching"
, Option [] ["without-K"] (NoArg withoutKFlag)
"disable the K rule in pattern matching"
, Option [] ["copatterns"] (NoArg copatternsFlag)
diff --git a/src/full/Agda/Interaction/Response.hs b/src/full/Agda/Interaction/Response.hs
index 234adc3..67f69b4 100644
--- a/src/full/Agda/Interaction/Response.hs
+++ b/src/full/Agda/Interaction/Response.hs
@@ -75,6 +75,7 @@ data DisplayInfo
| Info_InferredType Doc
| Info_Context Doc
| Info_HelperFunction Doc
+ | Info_Version
deriving Show
-- | Status information.
diff --git a/src/full/Agda/Main.hs b/src/full/Agda/Main.hs
index d654445..902662e 100644
--- a/src/full/Agda/Main.hs
+++ b/src/full/Agda/Main.hs
@@ -1,5 +1,4 @@
{-# LANGUAGE CPP #-}
-{-# LANGUAGE PatternGuards #-}
{-| Agda main module.
-}
@@ -40,6 +39,7 @@ import Agda.Compiler.Epic.Compiler as Epic
import Agda.Compiler.JS.Compiler as JS
import Agda.Utils.Monad
+import Agda.Utils.String
import qualified Agda.Utils.Trie as Trie
import Agda.Tests
@@ -85,7 +85,7 @@ runAgda = do
-- Second column is times.
-- CPU times are in pico seconds, convert to milliseconds.
col2 = Boxes.vcat Boxes.right $
- map (Boxes.text . (++ " ms") . show . (`div` 1000000000)) $
+ map (Boxes.text . (++ " ms") . showThousandSep . (`div` 1000000000)) $
times
table = Boxes.hsep 1 Boxes.left [col1, col2]
reportBenchmarkingLn $ Boxes.render table
@@ -132,15 +132,17 @@ runAgda = do
result <- case mw of
-- we get here if there are unfilled interaction
-- points that have been solved by unification
- SomeWarnings (Warnings [] [] []) -> return Nothing
- SomeWarnings (Warnings _ unsolved@(_:_) _)
- | not unsolvedOK -> typeError $ UnsolvedMetas unsolved
- SomeWarnings (Warnings _ _ unsolved@(_:_))
- | not unsolvedOK -> typeError $ UnsolvedConstraints unsolved
- SomeWarnings (Warnings termErrs@(_:_) _ _) ->
- typeError $ TerminationCheckFailed termErrs
- SomeWarnings _ -> return Nothing
- NoWarnings -> return $ Just i
+ SomeWarnings (Warnings Nothing [] []) -> return Nothing
+ -- Unsolved metas.
+ 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
whenM (optGenerateHTML <$> commandLineOptions) $
generateHTML
diff --git a/src/full/Agda/Syntax/Abstract.hs b/src/full/Agda/Syntax/Abstract.hs
index a8d3481..612ddd5 100644
--- a/src/full/Agda/Syntax/Abstract.hs
+++ b/src/full/Agda/Syntax/Abstract.hs
@@ -95,8 +95,8 @@ data Expr
| 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 -- ^
- | QuoteTerm ExprInfo -- ^
+ | 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
@@ -113,13 +113,15 @@ data Axiom
-- or another (e.g. data/record) type signature (internally).
deriving (Typeable, Eq, Ord, Show)
+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 (Map QName QName) (Map ModuleName ModuleName)
+ | Apply ModuleInfo ModuleName ModuleApplication (Ren QName) (Ren ModuleName)
| Import ModuleInfo ModuleName
| Pragma Range Pragma
| Open ModuleInfo ModuleName
@@ -135,6 +137,7 @@ data Declaration
-- 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)
@@ -162,6 +165,7 @@ data ModuleApplication
data Pragma = OptionsPragma [String]
| BuiltinPragma String Expr
+ | RewritePragma QName
| CompiledPragma QName String
| CompiledExportPragma QName String
| CompiledTypePragma QName String
@@ -178,7 +182,7 @@ data LetBinding
-- ^ @LetBind info rel name type defn@
| LetPatBind LetInfo Pattern Expr
-- ^ Irrefutable pattern binding.
- | LetApply ModuleInfo ModuleName ModuleApplication (Map QName QName) (Map ModuleName ModuleName)
+ | LetApply ModuleInfo ModuleName ModuleApplication (Ren QName) (Ren ModuleName)
-- ^ @LetApply mi newM (oldM args) renaming moduleRenaming at .
| LetOpen ModuleInfo ModuleName
-- ^ only for highlighting and abstractToConcrete
@@ -503,6 +507,7 @@ instance HasRange Declaration where
getRange (RecSig i _ _ _ ) = getRange i
getRange (RecDef i _ _ _ _ _ _) = getRange i
getRange (PatternSynDef x _ _ ) = getRange x
+ getRange (UnquoteDecl _ i _ _) = getRange i
instance HasRange (Pattern' e) where
getRange (VarP x) = getRange x
@@ -614,6 +619,7 @@ instance KillRange Declaration where
killRange (RecSig i a b c ) = killRange4 RecSig i a b c
killRange (RecDef i a b c d e f ) = killRange7 RecDef i a b c d e f
killRange (PatternSynDef x xs p ) = killRange3 PatternSynDef x xs p
+ killRange (UnquoteDecl mi i x e ) = killRange4 UnquoteDecl mi i x e
instance KillRange ModuleApplication where
killRange (SectionApp a b c ) = killRange3 SectionApp a b c
@@ -692,6 +698,7 @@ 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
diff --git a/src/full/Agda/Syntax/Common.hs b/src/full/Agda/Syntax/Common.hs
index 0564073..225a836 100644
--- a/src/full/Agda/Syntax/Common.hs
+++ b/src/full/Agda/Syntax/Common.hs
@@ -541,6 +541,10 @@ data IsAbstract = AbstractDef | ConcreteDef
instance KillRange IsAbstract where
killRange = id
+-- | Is this definition eligible for instance search?
+data IsInstance = InstanceDef | NotInstanceDef
+ deriving (Typeable, Show, Eq, Ord)
+
type Nat = Int
type Arity = Nat
@@ -575,3 +579,24 @@ instance Show InteractionId where
show (InteractionId x) = "?" ++ show x
instance KillRange InteractionId where killRange = id
+
+-----------------------------------------------------------------------------
+-- * Termination
+-----------------------------------------------------------------------------
+
+-- | Termination check? (Default = True).
+data TerminationCheck m
+ = TerminationCheck
+ -- ^ Run the termination checker.
+ | NoTerminationCheck
+ -- ^ Skip termination checking (unsafe).
+ | NonTerminating
+ -- ^ Treat as non-terminating.
+ | TerminationMeasure !Range m
+ -- ^ Skip termination checking but use measure instead.
+ deriving (Typeable, Show, Eq)
+
+instance KillRange m => KillRange (TerminationCheck m) where
+ killRange (TerminationMeasure _ m) = TerminationMeasure noRange (killRange m)
+ killRange t = t
+
diff --git a/src/full/Agda/Syntax/Concrete.hs b/src/full/Agda/Syntax/Concrete.hs
index 05f502e..39509d4 100644
--- a/src/full/Agda/Syntax/Concrete.hs
+++ b/src/full/Agda/Syntax/Concrete.hs
@@ -27,10 +27,12 @@ module Agda.Syntax.Concrete
, ColoredTypedBinding(..)
, BoundName(..), mkBoundName_, mkBoundName
, Telescope -- (..)
+ , countTelVars
-- * Declarations
, Declaration(..)
, ModuleApplication(..)
, TypeSignature
+ , TypeSignatureOrInstanceBlock
, Constructor
, ImportDirective(..), UsingOrHiding(..), ImportedName(..)
, Renaming(..), AsName(..)
@@ -57,6 +59,7 @@ import Control.DeepSeq
import Data.Typeable (Typeable)
import Data.Foldable (Foldable)
import Data.Traversable (Traversable)
+import Data.List
import Agda.Syntax.Position
import Agda.Syntax.Common hiding (Arg, Dom, NamedArg, ArgInfo)
import qualified Agda.Syntax.Common as Common
@@ -116,6 +119,7 @@ data Expr
| 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
@@ -126,6 +130,7 @@ 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 @_=>_@
@@ -183,6 +188,13 @@ data ColoredTypedBinding = WithColors [Color] TypedBinding
-- in later types.
type Telescope = [TypedBindings]
+countTelVars :: Telescope -> Nat
+countTelVars tel =
+ sum [ case unArg b of
+ TBind _ xs _ -> genericLength xs
+ TLet{} -> 0
+ | TypedBindings _ b <- tel ]
+
{-| Left hand sides can be written in infix style. For example:
> n + suc m = suc (n + m)
@@ -295,6 +307,9 @@ data AsName = AsName { asName :: Name
-- | Just type signatures.
type TypeSignature = Declaration
+-- | Just type signatures or instance blocks.
+type TypeSignatureOrInstanceBlock = Declaration
+
-- | A data constructor declaration is just a type signature.
type Constructor = TypeSignature
@@ -318,12 +333,14 @@ data Declaration
| Mutual !Range [Declaration]
| Abstract !Range [Declaration]
| Private !Range [Declaration]
- | Postulate !Range [TypeSignature]
+ | 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)
@@ -341,6 +358,7 @@ data OpenShortHand = DoOpen | DontOpen
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
@@ -353,7 +371,7 @@ data Pragma = OptionsPragma !Range [String]
-- module name.
| ImpossiblePragma !Range
| EtaPragma !Range QName
- | NoTerminationCheckPragma !Range
+ | TerminationCheckPragma !Range (TerminationCheck Name)
deriving (Typeable)
---------------------------------------------------------------------------
@@ -411,6 +429,7 @@ patternHead p =
DotP{} -> Nothing
LitP (LitQName _ x) -> Nothing -- return $ unqualify x -- does not compile
LitP _ -> Nothing
+ QuoteP _ -> Nothing
InstanceP _ (namedPat) -> patternHead (namedThing namedPat)
@@ -429,6 +448,7 @@ patternNames p =
AsP _ x p -> patternNames p
DotP{} -> []
LitP _ -> []
+ QuoteP _ -> []
InstanceP _ (namedPat) -> patternNames (namedThing namedPat)
{--------------------------------------------------------------------------
@@ -474,6 +494,7 @@ instance HasRange Expr where
Quote r -> r
QuoteTerm r -> r
Unquote r -> r
+ Tactic r _ _ -> r
DontCare{} -> noRange
Equal r _ _ -> r
@@ -517,6 +538,7 @@ instance HasRange Declaration where
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
@@ -524,6 +546,7 @@ instance HasRange Declaration where
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
@@ -541,6 +564,7 @@ instance HasRange RHS where
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
@@ -551,7 +575,7 @@ instance HasRange Pragma where
getRange (ImportPragma r _) = r
getRange (ImpossiblePragma r) = r
getRange (EtaPragma r _) = r
- getRange (NoTerminationCheckPragma r) = r
+ getRange (TerminationCheckPragma r _) = r
instance HasRange UsingOrHiding where
getRange (Using xs) = getRange xs
@@ -580,6 +604,7 @@ instance HasRange Pattern where
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
@@ -604,12 +629,14 @@ instance KillRange Declaration where
killRange (Mutual _ d) = killRange1 (Mutual noRange) d
killRange (Abstract _ d) = killRange1 (Abstract noRange) d
killRange (Private _ d) = killRange1 (Private noRange) d
+ killRange (InstanceB _ d) = killRange1 (InstanceB noRange) d
killRange (Postulate _ t) = killRange1 (Postulate noRange) t
killRange (Primitive _ t) = killRange1 (Primitive noRange) t
killRange (Open _ q i) = killRange2 (Open noRange) q i
killRange (Import _ q a o i) = killRange3 (\q a -> Import noRange q a o) q a i
killRange (ModuleMacro _ n m o i) = killRange3 (\n m -> ModuleMacro noRange n m o) n m i
killRange (Module _ q t d) = killRange3 (Module noRange) q t d
+ killRange (UnquoteDecl _ x t) = killRange2 (UnquoteDecl noRange) x t
killRange (Pragma p) = killRange1 Pragma p
instance KillRange Expr where
@@ -644,6 +671,7 @@ instance KillRange Expr where
killRange (Quote _) = Quote noRange
killRange (QuoteTerm _) = QuoteTerm noRange
killRange (Unquote _) = Unquote noRange
+ killRange (Tactic _ t es) = killRange2 (Tactic noRange) t es
killRange (DontCare e) = killRange1 DontCare e
killRange (Equal _ x y) = Equal noRange x y
@@ -684,10 +712,12 @@ instance KillRange Pattern where
killRange (AsP _ n p) = killRange2 (AsP noRange) n p
killRange (DotP _ e) = killRange1 (DotP noRange) e
killRange (LitP l) = killRange1 LitP l
+ killRange (QuoteP _) = QuoteP noRange
instance KillRange Pragma where
killRange (OptionsPragma _ s) = OptionsPragma noRange s
killRange (BuiltinPragma _ s e) = killRange1 (BuiltinPragma noRange s) e
+ killRange (RewritePragma _ q) = killRange1 (RewritePragma noRange) q
killRange (CompiledDataPragma _ q s ss) = killRange1 (\q -> CompiledDataPragma noRange q s ss) q
killRange (CompiledTypePragma _ q s) = killRange1 (\q -> CompiledTypePragma noRange q s) q
killRange (CompiledPragma _ q s) = killRange1 (\q -> CompiledPragma noRange q s) q
@@ -698,7 +728,7 @@ instance KillRange Pragma where
killRange (ImportPragma _ s) = ImportPragma noRange s
killRange (ImpossiblePragma _) = ImpossiblePragma noRange
killRange (EtaPragma _ q) = killRange1 (EtaPragma noRange) q
- killRange (NoTerminationCheckPragma _) = NoTerminationCheckPragma noRange
+ killRange (TerminationCheckPragma _ t) = TerminationCheckPragma noRange (killRange t)
instance KillRange Renaming where
killRange (Renaming i n _) = killRange2 (\i n -> Renaming i n noRange) i n
diff --git a/src/full/Agda/Syntax/Concrete/Definitions.hs b/src/full/Agda/Syntax/Concrete/Definitions.hs
index 47128b7..b3432b8 100644
--- a/src/full/Agda/Syntax/Concrete/Definitions.hs
+++ b/src/full/Agda/Syntax/Concrete/Definitions.hs
@@ -10,6 +10,7 @@ module Agda.Syntax.Concrete.Definitions
, Nice, runNice
, niceDeclarations
, notSoNiceDeclaration
+ , Measure
) where
import Control.Arrow ((***))
@@ -25,7 +26,7 @@ import Data.List as List
import Data.Traversable (traverse)
import Agda.Syntax.Concrete
-import Agda.Syntax.Common hiding (Arg, Dom, NamedArg, ArgInfo)
+import Agda.Syntax.Common hiding (Arg, Dom, NamedArg, ArgInfo, TerminationCheck())
import qualified Agda.Syntax.Common as Common
import Agda.Syntax.Position
import Agda.Syntax.Fixity
@@ -45,11 +46,11 @@ import Agda.Utils.Impossible
{-| The nice declarations. No fixity declarations and function definitions are
contained in a single constructor instead of spread out between type
- signatures and clauses. The @private@, @postulate@, and @abstract@
+ signatures and clauses. The @private@, @postulate@, @abstract@ and @instance@
modifiers have been distributed to the individual declarations.
-}
data NiceDeclaration
- = Axiom Range Fixity' Access ArgInfo Name Expr
+ = Axiom Range Fixity' Access IsInstance ArgInfo Name Expr
-- ^ Axioms and functions can be declared irrelevant. (Hiding should be NotHidden)
| NiceField Range Fixity' Access IsAbstract Name (Arg Expr)
| PrimitiveFunction Range Fixity' Access IsAbstract Name Expr
@@ -64,15 +65,18 @@ data NiceDeclaration
| NiceFunClause Range Access IsAbstract TerminationCheck Declaration
-- ^ a uncategorized function clause, could be a function clause
-- without type signature or a pattern lhs (e.g. for irrefutable let)x
- | FunSig Range Fixity' Access ArgInfo TerminationCheck Name Expr
+ | FunSig Range Fixity' Access IsInstance ArgInfo TerminationCheck Name Expr
| FunDef Range [Declaration] Fixity' IsAbstract TerminationCheck Name [Clause] -- ^ block of function clauses (we have seen the type signature before)
| DataDef Range Fixity' IsAbstract Name [LamBinding] [NiceConstructor]
| RecDef Range Fixity' IsAbstract Name (Maybe (Ranged Induction)) (Maybe (ThingWithFixity Name)) [LamBinding] [NiceDeclaration]
| NicePatternSyn Range Fixity' Name [Arg Name] Pattern
+ | NiceUnquoteDecl Range Fixity' Access IsAbstract TerminationCheck Name Expr
deriving (Typeable, Show)
--- | Termination check? (Default = True).
-type TerminationCheck = Bool
+type TerminationCheck = Common.TerminationCheck Measure
+
+-- | Termination measure is, for now, a variable name.
+type Measure = Name
-- | Only 'Axiom's.
type NiceConstructor = NiceTypeSignature
@@ -100,8 +104,13 @@ data DeclarationException
| DeclarationPanic String
| UselessPrivate Range
| UselessAbstract Range
+ | UselessInstance Range
+ | WrongContentPostulateBlock Range
| AmbiguousFunClauses LHS [Name] -- ^ in a mutual block, a clause could belong to any of the @[Name]@ type signatures
- | InvalidNoTerminationCheckPragma Range
+ | InvalidTerminationCheckPragma Range
+ | InvalidMeasureMutual Range
+ -- ^ In a mutual block, all or none need a MEASURE pragma.
+ -- Range is of mutual block.
deriving (Typeable)
instance HasRange DeclarationException where
@@ -119,10 +128,13 @@ instance HasRange DeclarationException where
getRange (DeclarationPanic _) = noRange
getRange (UselessPrivate r) = r
getRange (UselessAbstract r) = r
- getRange (InvalidNoTerminationCheckPragma r) = r
+ getRange (UselessInstance r) = r
+ getRange (WrongContentPostulateBlock r) = r
+ getRange (InvalidTerminationCheckPragma r) = r
+ getRange (InvalidMeasureMutual r) = r
instance HasRange NiceDeclaration where
- getRange (Axiom r _ _ _ _ _) = r
+ getRange (Axiom r _ _ _ _ _ _) = r
getRange (NiceField r _ _ _ _ _) = r
getRange (NiceMutual r _ _) = r
getRange (NiceModule r _ _ _ _ _) = r
@@ -131,7 +143,7 @@ instance HasRange NiceDeclaration where
getRange (NiceImport r _ _ _ _) = r
getRange (NicePragma r _) = r
getRange (PrimitiveFunction r _ _ _ _ _) = r
- getRange (FunSig r _ _ _ _ _ _) = r
+ getRange (FunSig r _ _ _ _ _ _ _) = r
getRange (FunDef r _ _ _ _ _ _) = r
getRange (DataDef r _ _ _ _ _) = r
getRange (RecDef r _ _ _ _ _ _ _) = r
@@ -139,6 +151,7 @@ instance HasRange NiceDeclaration where
getRange (NiceDataSig r _ _ _ _ _) = r
getRange (NicePatternSyn r _ _ _ _) = r
getRange (NiceFunClause r _ _ _ _) = r
+ getRange (NiceUnquoteDecl r _ _ _ _ _ _) = r
instance Error DeclarationException where
noMsg = strMsg ""
@@ -173,8 +186,14 @@ instance Show DeclarationException where
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 $
pwords "Using abstract here has no effect. Abstract applies only definitions like data definitions, record type definitions and function clauses."
- show (InvalidNoTerminationCheckPragma _) = show $ fsep $
- pwords "The NO_TERMINATION_CHECK pragma can only preceed a mutual block or a function definition."
+ show (UselessInstance _) = show $ fsep $
+ 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 (InvalidTerminationCheckPragma _) = show $ fsep $
+ pwords "Termination checking pragmas can only preceed 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
@@ -208,7 +227,7 @@ data DataRecOrFun
= DataName Params -- ^ name of a data with parameters
| RecName Params -- ^ name of a record with parameters
| FunName TerminationCheck -- ^ name of a function
- deriving (Eq, Ord)
+ deriving (Eq)
type Params = [Hiding]
@@ -227,9 +246,31 @@ sameKind RecName{} RecName{} = True
sameKind FunName{} FunName{} = True
sameKind _ _ = False
-terminationCheck :: DataRecOrFun -> Bool
+terminationCheck :: DataRecOrFun -> TerminationCheck
terminationCheck (FunName tc) = tc
-terminationCheck _ = True
+terminationCheck _ = TerminationCheck
+
+-- | Check that declarations in a mutual block are consistently
+-- equipped with MEASURE pragmas, or whether there is a
+-- NO_TERMINATION_CHECK pragma.
+combineTermChecks :: Range -> [TerminationCheck] -> Nice TerminationCheck
+combineTermChecks r tcs = loop tcs where
+ loop [] = return TerminationCheck
+ loop (tc : tcs) = do
+ 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
+ (TerminationMeasure{} , TerminationMeasure{} ) -> return tc
+ (TerminationMeasure r _, NoTerminationCheck ) -> failure r
+ (NoTerminationCheck , TerminationMeasure r _) -> failure r
+ (TerminationMeasure r _, NonTerminating ) -> failure r
+ (NonTerminating , TerminationMeasure r _) -> failure r
+ (NoTerminationCheck , NonTerminating ) -> failure r
+ (NonTerminating , NoTerminationCheck ) -> failure r
type LoneSigs = [(DataRecOrFun, Name)]
data NiceEnv = NiceEnv
@@ -278,7 +319,7 @@ data DeclKind
| OtherDecl
deriving (Eq, Show)
-declKind (FunSig _ _ _ _ tc x _) = LoneSig (FunName tc) x
+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
declKind (FunDef _ _ _ _ tc x _) = LoneDef (FunName tc) x
@@ -339,12 +380,14 @@ niceDeclarations ds = do
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]
@@ -355,7 +398,8 @@ niceDeclarations ds = do
LoneDef _ x -> __IMPOSSIBLE__
LoneSig k x -> do
addLoneSig k x
- (tc, (ds0, ds1)) <- untilAllDefined (terminationCheck k) ds
+ (tcs, (ds0, ds1)) <- untilAllDefined [terminationCheck k] ds
+ tc <- combineTermChecks (getRange d) tcs
-- Record modules are, for performance reasons, not always
-- placed in mutual blocks.
@@ -365,36 +409,48 @@ niceDeclarations ds = do
(NiceMutual (getRange (d : ds0)) tc (d : ds0) :)
prefix <$> inferMutualBlocks ds1
where
- untilAllDefined :: TerminationCheck
+ untilAllDefined :: [TerminationCheck]
-> [NiceDeclaration]
- -> Nice (TerminationCheck, ([NiceDeclaration], [NiceDeclaration]))
+ -> Nice ([TerminationCheck], ([NiceDeclaration], [NiceDeclaration]))
untilAllDefined tc ds = do
done <- noLoneSigs
if done then return (tc, ([], ds)) else
case ds of
[] -> __IMPOSSIBLE__ <$ (checkLoneSigs =<< gets loneSigs)
d : ds -> case declKind d of
- LoneSig k x -> addLoneSig k x >> cons d (untilAllDefined (tc && terminationCheck k) ds)
- LoneDef k x -> removeLoneSig x >> cons d (untilAllDefined (tc && terminationCheck k) ds)
+ 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)
OtherDecl -> cons d (untilAllDefined tc ds)
where
cons d = fmap (id *** (d :) *** id)
+ notMeasure TerminationMeasure{} = False
+ notMeasure _ = True
+
nice :: [Declaration] -> Nice [NiceDeclaration]
nice [] = return []
- nice (Pragma (NoTerminationCheckPragma r) : ds@(Mutual{} : _)) = do
+ nice (Pragma (TerminationCheckPragma r tc) : ds@(Mutual{} : _)) | notMeasure tc = do
ds <- nice ds
case ds of
- NiceMutual r _ ds' : ds -> return $ NiceMutual r False ds' : ds
+ NiceMutual r _ ds' : ds -> return $ NiceMutual r tc ds' : ds
_ -> __IMPOSSIBLE__
- nice (Pragma (NoTerminationCheckPragma r) : d at TypeSig{} : ds) =
- niceTypeSig False d ds
- nice (Pragma (NoTerminationCheckPragma r) : d at FunClause{} : ds) =
- niceFunClause False d ds
+ nice (Pragma (TerminationCheckPragma r tc) : d at TypeSig{} : ds) =
+ niceTypeSig tc d ds
+ nice (Pragma (TerminationCheckPragma r tc) : d at FunClause{} : ds) | notMeasure tc =
+ niceFunClause tc d ds
+ nice (Pragma (TerminationCheckPragma r tc) : ds@(UnquoteDecl{} : _)) | notMeasure tc = do
+ NiceUnquoteDecl r f p a _ x e : ds <- nice ds
+ return $ NiceUnquoteDecl r f p a tc x e : ds
+
+ nice (d at TypeSig{} : Pragma (TerminationCheckPragma r (TerminationMeasure _ x)) : ds) =
+ niceTypeSig (TerminationMeasure r x) d ds
+ -- nice (Pragma (MeasurePragma r x) : d at FunClause{} : ds) =
+ -- niceFunClause (TerminationMeasure r x) d ds
+
nice (d:ds) = do
case d of
- TypeSig{} -> niceTypeSig True d ds
- FunClause{} -> niceFunClause True d ds
+ TypeSig{} -> niceTypeSig TerminationCheck d ds
+ FunClause{} -> niceFunClause TerminationCheck d ds
Field x t -> (++) <$> niceAxioms [ d ] <*> nice ds
DataSig r CoInductive x tel t -> throwError (Codata r)
Data r CoInductive x tel t cs -> throwError (Codata r)
@@ -425,6 +481,9 @@ niceDeclarations ds = do
Private r ds' ->
(++) <$> (privateBlock r =<< nice ds') <*> nice ds
+ InstanceB r ds' ->
+ (++) <$> (instanceBlock r =<< nice ds') <*> nice ds
+
Postulate _ ds' -> (++) <$> niceAxioms ds' <*> nice ds
Primitive _ ds' -> (++) <$> (map toPrim <$> niceAxioms ds') <*> nice ds
@@ -444,8 +503,12 @@ niceDeclarations ds = do
Open r x is -> (NiceOpen r x is :) <$> nice ds
Import r x as op is -> (NiceImport r x as op is :) <$> nice ds
- Pragma (NoTerminationCheckPragma r) ->
- throwError $ InvalidNoTerminationCheckPragma r
+ UnquoteDecl r x e -> do
+ fx <- getFixity x
+ (NiceUnquoteDecl r fx PublicAccess ConcreteDef TerminationCheck x e :) <$> nice ds
+
+ Pragma (TerminationCheckPragma r _) ->
+ throwError $ InvalidTerminationCheckPragma r
Pragma p -> (NicePragma (getRange p) p :) <$> nice ds
niceFunClause :: TerminationCheck -> Declaration -> [Declaration] -> Nice [NiceDeclaration]
@@ -499,7 +562,7 @@ niceDeclarations ds = do
-- register x as lone type signature, to recognize clauses later
addLoneSig (FunName termCheck) x
ds <- nice ds
- return $ FunSig (getRange d) fx PublicAccess info termCheck x t : ds
+ return $ FunSig (getRange d) fx PublicAccess NotInstanceDef info termCheck x t : ds
niceTypeSig _ _ _ = __IMPOSSIBLE__
-- We could add a default type signature here, but at the moment we can't
@@ -527,27 +590,28 @@ niceDeclarations ds = do
dropType b at DomainFree{} = [b]
-- Translate axioms
- niceAxioms :: [TypeSignature] -> Nice [NiceDeclaration]
- niceAxioms ds = mapM niceAxiom ds
+ niceAxioms :: [TypeSignatureOrInstanceBlock] -> Nice [NiceDeclaration]
+ niceAxioms ds = liftM List.concat $ mapM niceAxiom ds
- niceAxiom :: TypeSignature -> Nice NiceDeclaration
+ niceAxiom :: TypeSignatureOrInstanceBlock -> Nice [NiceDeclaration]
niceAxiom d@(TypeSig rel x t) = do
fx <- getFixity x
- return $ Axiom (getRange d) fx PublicAccess rel x t
+ return $ [ Axiom (getRange d) fx PublicAccess NotInstanceDef rel x t ]
niceAxiom d@(Field x argt) = do
fx <- getFixity x
- return $ NiceField (getRange d) fx PublicAccess ConcreteDef x argt
- niceAxiom _ = __IMPOSSIBLE__
+ return $ [ NiceField (getRange d) fx PublicAccess ConcreteDef x argt ]
+ niceAxiom d@(InstanceB r decls) = instanceBlock r =<< niceAxioms decls
+ niceAxiom d = throwError $ WrongContentPostulateBlock $ getRange d
toPrim :: NiceDeclaration -> NiceDeclaration
- toPrim (Axiom r f a rel x t) = PrimitiveFunction r f a ConcreteDef x t
+ toPrim (Axiom r f a i rel x t) = PrimitiveFunction r f a ConcreteDef x t
toPrim _ = __IMPOSSIBLE__
-- Create a function definition.
mkFunDef info termCheck x mt ds0 = do
cs <- mkClauses x $ expandEllipsis ds0
f <- getFixity x
- return [ FunSig (fuseRange x t) f PublicAccess info termCheck x t
+ return [ FunSig (fuseRange x t) f PublicAccess NotInstanceDef info termCheck x t
, FunDef (getRange ds0) ds0 f ConcreteDef termCheck x cs ]
where
t = case mt of
@@ -657,7 +721,9 @@ niceDeclarations ds = do
[] -> return ()
(NiceFunClause _ _ _ _ (FunClause lhs _ _)):_ -> throwError $ MissingTypeSignature lhs
d:_ -> throwError $ NotAllowedInMutual d
- return $ NiceMutual r (all termCheck ds) $ sigs ++ other
+ let tcs = map termCheck ds
+ tc <- combineTermChecks r tcs
+ return $ NiceMutual r tc $ sigs ++ other
where
-- Andreas, 2013-11-23 allow postulates in mutual blocks
notAllowedInMutual Axiom{} = False
@@ -676,10 +742,15 @@ niceDeclarations ds = do
-- Andreas, 2013-02-28 (issue 804):
-- do not termination check a mutual block if any of its
-- inner declarations comes with a {-# NO_TERMINATION_CHECK #-}
- termCheck (FunSig _ _ _ _ tc _ _) = tc
- termCheck (FunDef _ _ _ _ tc _ _) = tc
- termCheck (NiceMutual _ tc _) = tc
- termCheck _ = True
+ termCheck (FunSig _ _ _ _ _ tc _ _) = tc
+ termCheck (FunDef _ _ _ _ tc _ _) = tc
+ termCheck (NiceMutual _ tc _) = tc
+ termCheck (NiceUnquoteDecl _ _ _ _ tc _ _) = tc
+ termCheck _ = TerminationCheck
+
+ -- A mutual block cannot have a measure,
+ -- but it can skip termination check.
+
abstractBlock _ [] = return []
abstractBlock r ds = do
@@ -700,6 +771,7 @@ niceDeclarations ds = do
-- no effect on fields or primitives, the InAbstract field there is unused
NiceField r f p _ x e -> return $ NiceField r f p AbstractDef x e
PrimitiveFunction r f p _ x e -> return $ PrimitiveFunction r f p AbstractDef x e
+ NiceUnquoteDecl r f p _ t x e -> return $ NiceUnquoteDecl r f p AbstractDef t x e
NiceModule{} -> return $ d
NiceModuleMacro{} -> return $ d
Axiom{} -> return $ d
@@ -782,16 +854,17 @@ niceDeclarations ds = do
mkPrivate :: Updater NiceDeclaration
mkPrivate d =
case d of
- Axiom r f p rel x e -> (\ p -> Axiom r f p rel x e) <$> setPrivate p
+ Axiom r f p i rel x e -> (\ p -> Axiom r f p i rel x e) <$> setPrivate p
NiceField r f p a x e -> (\ p -> NiceField r f p a x e) <$> setPrivate p
PrimitiveFunction r f p a x e -> (\ p -> PrimitiveFunction r f p a x e) <$> setPrivate p
NiceMutual r termCheck ds -> NiceMutual r termCheck <$> mapM mkPrivate ds
NiceModule r p a x tel ds -> (\ p -> NiceModule r p a x tel ds) <$> setPrivate p
NiceModuleMacro r p x ma op is -> (\ p -> NiceModuleMacro r p x ma op is) <$> setPrivate p
- FunSig r f p rel tc x e -> (\ p -> FunSig r f p rel tc x e) <$> setPrivate p
+ FunSig r f p i rel tc x e -> (\ p -> FunSig r f p i rel tc x e) <$> setPrivate p
NiceRecSig r f p x ls t -> (\ p -> NiceRecSig r f p x ls t) <$> setPrivate p
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
@@ -855,6 +928,7 @@ niceDeclarations ds = do
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
@@ -871,6 +945,40 @@ niceDeclarations ds = do
mkPrivateWhere (SomeWhere m ds) = SomeWhere m [Private (getRange ds) ds]
-}
+ instanceBlock _ [] = return []
+ instanceBlock r ds = do
+ let (ds', anyChange) = runChange $ mapM mkInstance ds
+ if anyChange then return ds' else throwError $ UselessInstance r
+
+
+ -- Make a declaration eligible for instance search.
+ mkInstance :: Updater NiceDeclaration
+ mkInstance d =
+ case d of
+ Axiom r f p i rel x e -> (\ i -> Axiom r f p i rel x e) <$> setInstance i
+ FunSig r f p i rel tc x e -> (\ i -> FunSig r f p i rel tc x e) <$> setInstance i
+ NiceMutual{} -> return $ d
+ NiceFunClause{} -> return $ d
+ FunDef{} -> return $ d
+ NiceField{} -> return $ d
+ PrimitiveFunction{} -> return $ d
+ NiceUnquoteDecl{} -> return $ d
+ NiceRecSig{} -> return $ d
+ NiceDataSig{} -> return $ d
+ NiceModuleMacro{} -> return $ d
+ NiceModule{} -> return $ d
+ NicePragma _ _ -> return $ d
+ NiceOpen _ _ _ -> return $ d
+ NiceImport _ _ _ _ _ -> return $ d
+ DataDef{} -> return $ d
+ RecDef{} -> return $ d
+ NicePatternSyn _ _ _ _ _ -> return $ d
+
+ setInstance :: Updater IsInstance
+ setInstance i = case i of
+ InstanceDef -> return i
+ _ -> 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')
plusFixities m1 m2
@@ -911,7 +1019,7 @@ fixities [] = return $ Map.empty
notSoNiceDeclaration :: NiceDeclaration -> Declaration
notSoNiceDeclaration d =
case d of
- Axiom _ _ _ rel x e -> TypeSig rel x e
+ Axiom _ _ _ _ rel x e -> TypeSig rel x e
NiceField _ _ _ _ x argt -> Field x argt
PrimitiveFunction r _ _ _ x e -> Primitive r [TypeSig defaultArgInfo x e]
NiceMutual r _ ds -> Mutual r $ map notSoNiceDeclaration ds
@@ -923,13 +1031,14 @@ notSoNiceDeclaration d =
NiceRecSig r _ _ x bs e -> RecordSig r x bs e
NiceDataSig r _ _ x bs e -> DataSig r Inductive x bs e
NiceFunClause _ _ _ _ d -> d
- FunSig _ _ _ rel tc x e -> TypeSig rel x e
+ FunSig _ _ _ _ rel tc x e -> TypeSig rel x e
FunDef r [d] _ _ _ _ _ -> d
FunDef r ds _ _ _ _ _ -> Mutual r ds -- Andreas, 2012-04-07 Hack!
DataDef r _ _ x bs cs -> Data r Inductive x bs Nothing $ map notSoNiceDeclaration cs
RecDef r _ _ x i c bs ds -> Record r x i (unThing <$> c) bs Nothing $ map notSoNiceDeclaration ds
where unThing (ThingWithFixity c _) = c
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,
diff --git a/src/full/Agda/Syntax/Concrete/Generic.hs b/src/full/Agda/Syntax/Concrete/Generic.hs
index fd83ba1..3717d42 100644
--- a/src/full/Agda/Syntax/Concrete/Generic.hs
+++ b/src/full/Agda/Syntax/Concrete/Generic.hs
@@ -122,6 +122,7 @@ instance ExprLike Expr where
ETel tel -> f $ ETel $ mapE tel
QuoteGoal r x e -> f $ QuoteGoal r x $ mapE e
QuoteContext r x e -> f $ QuoteContext r x $ mapE e
+ Tactic r e es -> f $ Tactic r (mapE e) $ mapE es
Quote{} -> f $ e0
QuoteTerm{} -> f $ e0
Unquote{} -> f $ e0
@@ -173,12 +174,14 @@ instance ExprLike Declaration where
Mutual r ds -> Mutual r $ mapE ds
Abstract r ds -> Abstract r $ mapE ds
Private r ds -> Private r $ mapE ds
+ InstanceB r ds -> InstanceB r $ mapE ds
Postulate r ds -> Postulate r $ mapE ds
Primitive r ds -> Primitive r $ mapE ds
Open{} -> e0
Import{} -> e0
ModuleMacro r n es op dir -> ModuleMacro r n (mapE es) op dir
Module r n tel ds -> Module r n (mapE tel) $ mapE ds
+ UnquoteDecl r x e -> UnquoteDecl r x (mapE e)
Pragma{} -> e0
where mapE e = mapExpr f e
diff --git a/src/full/Agda/Syntax/Concrete/Operators.hs b/src/full/Agda/Syntax/Concrete/Operators.hs
index f4149b1..586b425 100644
--- a/src/full/Agda/Syntax/Concrete/Operators.hs
+++ b/src/full/Agda/Syntax/Concrete/Operators.hs
@@ -11,6 +11,7 @@
-}
module Agda.Syntax.Concrete.Operators
( parseApplication
+ , parseModuleApplication
, parseLHS
, parsePattern
, parsePatternSyn
@@ -20,7 +21,7 @@ module Agda.Syntax.Concrete.Operators
, validConPattern
, patternAppView
, fullParen
- , buildParser
+ , buildParsers, buildParser
, parsePat
, getDefinedNames
, UseBoundNames(..)
@@ -173,8 +174,27 @@ notationNames (q, _, ps) = zipWith ($) (requal : repeat QName) [Name noRange [Id
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
let cons = getDefinedNames [ConName, PatternSynName] flat
reportSLn "scope.operators" 50 $ unlines
@@ -192,12 +212,16 @@ buildParser r flat use = do
DontUseBoundNames -> not (Set.member x conparts) || Set.member x connames
-- If string is a part of notation, it cannot be used as an identifier,
-- unless it is also used as an identifier. See issue 307.
- return $ -- traceShow ops $
- recursive $ \p -> -- p is a parser for an arbitrary expression
- concatMap (mkP p) (order fix) -- for infix operators (with outer "holes")
- ++ [ appP p ] -- parser for simple applications
- ++ map (nonfixP . opP p) non -- for things with no outer "holes"
- ++ [ const $ atomP isAtom ]
+
+ let chain = foldr ( $ )
+
+ return $ Data.Function.fix $ \p -> Parsers
+ { pTop = chain (pApp p) (concatMap (mkP (pTop p)) (order fix))
+ , pApp = appP (pNonfix p) (pArgs p)
+ , pArgs = argsP (pNonfix p)
+ , pNonfix = chain (pAtom p) (map (nonfixP . opP (pTop p)) non)
+ , pAtom = atomP isAtom
+ }
where
level :: NewNotation -> Integer
level (_name, fixity, _syn) = fixityLevel fixity
@@ -242,6 +266,7 @@ buildParser r flat use = do
[] -> []
ops -> [ f $ choice $ map (opP p0) ops ]
+
---------------------------------------------------------------------------
-- * Expression instances
---------------------------------------------------------------------------
@@ -353,6 +378,7 @@ parsePat prs p = case p of
WildP _ -> return p
AbsurdP _ -> return p
LitP _ -> return p
+ QuoteP _ -> return p
IdentP _ -> return p
@@ -398,7 +424,8 @@ parseLHS' :: LHSOrPatSyn -> Maybe Name -> Pattern -> ScopeM ParseLHS
parseLHS' lhsOrPatSyn top p = do
let ms = qualifierModules $ patternQNames p
flat <- flattenScope ms <$> getScope
- patP <- buildParser (getRange p) flat DontUseBoundNames
+ parsers <- buildParsers (getRange p) flat DontUseBoundNames
+ let patP = pTop parsers
let cons = getNames [ConName, PatternSynName] flat
let flds = getNames [FldName] flat
case [ res | p' <- force $ parsePat patP p
@@ -497,6 +524,7 @@ validConPattern :: [QName] -> Pattern -> Bool
validConPattern cons p = case appView p of
[_] -> True
IdentP x : ps -> elem x cons && all (validConPattern cons) ps
+ [QuoteP _, _] -> True
_ -> False
-- Andreas, 2012-06-04: I do not know why the following line was
-- the catch-all case. It seems that the new catch-all works also
@@ -524,11 +552,12 @@ patternQNames p = case p of
InstanceP _ p -> patternQNames (namedThing p)
OpAppP r d ps -> __IMPOSSIBLE__
AppP{} -> __IMPOSSIBLE__
- AsP{} -> __IMPOSSIBLE__
+ AsP r x p -> patternQNames p
AbsurdP{} -> []
WildP{} -> []
DotP{} -> []
LitP{} -> []
+ QuoteP{} -> []
-- | Return all qualifiers occuring in a list of 'QName's.
-- Each qualifier is returned as a list of names, e.g.
@@ -546,21 +575,60 @@ parseApplication es = do
flat <- flattenScope ms <$> getScope
-- Andreas, 2014-04-27 Time for building the parser is negligible
p <- -- billSub [Bench.Parsing, Bench.Operators, Bench.BuildParser] $
- buildParser (getRange es) flat UseBoundNames
+ buildParsers (getRange es) flat UseBoundNames
-- Parse
- case force $ parse p es of
+ case force $ parse (pTop p) es of
[e] -> return e
- [] -> do
+ [] -> do
-- When the parser fails and a name is not in scope, it is more
-- useful to say that to the user rather than just "failed".
inScope <- partsInScope flat
case [ x | Ident x <- es, not (Set.member x inScope) ] of
- [] -> typeError $ NoParseForApplication es
- xs -> typeError $ NotInScope xs
+ [] -> typeError $ NoParseForApplication es
+ xs -> typeError $ NotInScope xs
es' -> typeError $ AmbiguousParseForApplication es $ map fullParen es'
+parseModuleIdentifier :: Expr -> ScopeM QName
+parseModuleIdentifier (Ident m) = return m
+parseModuleIdentifier e = typeError $ NotAModuleExpr e
+
+parseRawModuleApplication :: [Expr] -> ScopeM (QName, [NamedArg Expr])
+parseRawModuleApplication es = do
+ let e : es_args = es
+ m <- parseModuleIdentifier e
+
+ -- Build the arguments parser
+ let ms = qualifierModules [ q | Ident q <- es_args ]
+ flat <- flattenScope ms <$> getScope
+ p <- buildParsers (getRange es_args) flat UseBoundNames
+
+ -- Parse
+ case {-force $-} parse (pArgs p) es_args of -- TODO: not sure about forcing
+ [as] -> return (m, as)
+ [] -> do
+ inScope <- partsInScope flat
+ case [ x | Ident x <- es_args, not (Set.member x inScope) ] of
+ [] -> typeError $ NoParseForApplication es
+ xs -> typeError $ NotInScope xs
+
+ ass -> do
+ let f = fullParen . foldl (App noRange) (Ident m)
+ typeError $ AmbiguousParseForApplication es
+ $ map f ass
+
+-- | Parse an expression into a module application
+-- (an identifier plus a list of arguments).
+parseModuleApplication :: Expr -> ScopeM (QName, [NamedArg Expr])
+parseModuleApplication (RawApp _ es) = parseRawModuleApplication es
+parseModuleApplication (App r e1 e2) = do -- TODO: do we need this case?
+ (m, args) <- parseModuleApplication e1
+ return (m, args ++ [e2])
+parseModuleApplication e = do
+ m <- parseModuleIdentifier e
+ return (m, [])
+
---------------------------------------------------------------------------
-- * Inserting parenthesis
---------------------------------------------------------------------------
@@ -601,6 +669,7 @@ 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
diff --git a/src/full/Agda/Syntax/Concrete/Operators/Parser.hs b/src/full/Agda/Syntax/Concrete/Operators/Parser.hs
index 024ac9b..a924ff5 100644
--- a/src/full/Agda/Syntax/Concrete/Operators/Parser.hs
+++ b/src/full/Agda/Syntax/Concrete/Operators/Parser.hs
@@ -42,13 +42,6 @@ instance IsExpr e => HasRange (ExprView e) where
-- * Parser combinators
---------------------------------------------------------------------------
--- | Combining a hierarchy of parsers.
-recursive :: (ReadP tok a -> [ReadP tok a -> ReadP tok a]) -> ReadP tok a
-recursive f = p0
- where
- fs = f p0
- p0 = foldr ( $ ) p0 fs
-
----------------------------
-- Specific combinators
@@ -156,15 +149,9 @@ nonfixP op p = do
return $ rebuild nsyn r es
+++ p
-appP :: IsExpr e => ReadP e e -> ReadP e e -> ReadP e e
-appP top p = do
- h <- p
- es <- many (nothidden +++ hidden +++ instanceH)
- return $ foldl app h es
+argsP :: IsExpr e => ReadP e e -> ReadP e [NamedArg e]
+argsP p = many (nothidden +++ hidden +++ instanceH)
where
-
- app e arg = unExprView $ AppV e arg
-
isHidden (HiddenArgV _) = True
isHidden _ = False
@@ -186,6 +173,14 @@ appP top p = 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
+ h <- p
+ es <- pa
+ return $ foldl app h es
+ where
+ app e = unExprView . AppV e
+
atomP :: IsExpr e => (QName -> Bool) -> ReadP e e
atomP p = do
e <- get
diff --git a/src/full/Agda/Syntax/Concrete/Pretty.hs b/src/full/Agda/Syntax/Concrete/Pretty.hs
index acd59ab..1a306f0 100644
--- a/src/full/Agda/Syntax/Concrete/Pretty.hs
+++ b/src/full/Agda/Syntax/Concrete/Pretty.hs
@@ -96,25 +96,6 @@ instance Pretty Name where
instance Pretty QName where
pretty = text . show
-instance Pretty Literal where
- pretty (LitInt _ n) = text $ show n
- pretty (LitFloat _ x) = text $ show x
- pretty (LitString _ s) = text $ showString' s ""
- pretty (LitChar _ c) = text $ "'" ++ showChar' c "" ++ "'"
- pretty (LitQName _ x) = text $ show x
-
-showString' :: String -> ShowS
-showString' s =
- foldr (.) id $ [ showString "\"" ] ++ map showChar' s ++ [ showString "\"" ]
-
-showChar' :: Char -> ShowS
-showChar' '"' = showString "\\\""
-showChar' c
- | escapeMe c = showLitChar c
- | otherwise = showString [c]
- where
- escapeMe c = not (isPrint c) || c == '\\'
-
instance Pretty Relevance where
pretty Forced = empty
pretty UnusedArg = empty
@@ -198,6 +179,10 @@ instance Pretty Expr where
Quote _ -> text "quote"
QuoteTerm _ -> text "quoteTerm"
Unquote _ -> text "unquote"
+ Tactic _ t es ->
+ sep [ text "tactic" <+> pretty t
+ , fsep [ text "|" <+> pretty e | e <- es ]
+ ]
-- Andreas, 2011-10-03 print irrelevant things as .(e)
DontCare e -> text "." <> parens (pretty e)
Equal _ a b -> pretty a <+> text "=" <+> pretty b
@@ -398,6 +383,7 @@ instance Pretty Declaration where
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 ->
@@ -425,6 +411,8 @@ instance Pretty Declaration where
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 =
@@ -439,6 +427,8 @@ instance Pretty OpenShortHand where
instance Pretty Pragma where
pretty (OptionsPragma _ opts) = fsep $ map text $ "OPTIONS" : opts
pretty (BuiltinPragma _ b x) = hsep [ text "BUILTIN", text b, pretty x ]
+ pretty (RewritePragma _ x) =
+ hsep [ text "REWRITE", pretty x ]
pretty (CompiledPragma _ x hs) =
hsep [ text "COMPILED", pretty x, text hs ]
pretty (CompiledExportPragma _ x hs) =
@@ -459,7 +449,12 @@ instance Pretty Pragma where
hsep $ [text "IMPOSSIBLE"]
pretty (EtaPragma _ x) =
hsep $ [text "ETA", pretty x]
- pretty (NoTerminationCheckPragma _) = text "NO_TERMINATION_CHECK"
+ pretty (TerminationCheckPragma _ tc) =
+ case tc of
+ TerminationCheck -> __IMPOSSIBLE__
+ NoTerminationCheck -> text "NO_TERMINATION_CHECK"
+ NonTerminating -> text "NON_TERMINATING"
+ TerminationMeasure _ x -> hsep $ [text "MEASURE", pretty x]
instance Pretty Fixity where
pretty (LeftAssoc _ n) = text "infixl" <+> text (show n)
@@ -495,6 +490,7 @@ instance Pretty Pattern where
DotP _ p -> text "." <> pretty p
AbsurdP _ -> text "()"
LitP l -> pretty l
+ QuoteP _ -> text "quote"
prettyOpApp :: Pretty a => QName -> [a] -> [Doc]
prettyOpApp q es = prOp ms xs es
diff --git a/src/full/Agda/Syntax/Info.hs b/src/full/Agda/Syntax/Info.hs
index 4811d4c..ed6f299 100644
--- a/src/full/Agda/Syntax/Info.hs
+++ b/src/full/Agda/Syntax/Info.hs
@@ -1,4 +1,8 @@
-{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving, FlexibleContexts, UndecidableInstances #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE UndecidableInstances #-}
+
{-| An info object contains additional information about a piece of abstract
syntax that isn't part of the actual syntax. For instance, it might contain
the source code position of an expression or the concrete syntax that
@@ -113,12 +117,17 @@ data DefInfo =
DefInfo { defFixity :: Fixity'
, defAccess :: Access
, defAbstract :: IsAbstract
+ , defInstance :: IsInstance
, defInfo :: DeclInfo
}
deriving (Typeable, Show)
mkDefInfo :: Name -> Fixity' -> Access -> IsAbstract -> Range -> DefInfo
-mkDefInfo x f a ab r = DefInfo f a ab (DeclInfo x r)
+mkDefInfo x f a ab r = DefInfo f a ab NotInstanceDef (DeclInfo x r)
+
+-- | Same as @mkDefInfo@ but where we can also give the @IsInstance@
+mkDefInfoInstance :: Name -> Fixity' -> Access -> IsAbstract -> IsInstance -> Range -> DefInfo
+mkDefInfoInstance x f a ab i r = DefInfo f a ab i (DeclInfo x r)
instance HasRange DefInfo where
getRange = getRange . defInfo
@@ -153,7 +162,7 @@ instance KillRange DeclInfo where
--------------------------------------------------------------------------}
data MutualInfo =
- MutualInfo { mutualTermCheck :: Bool -- ^ termination check (default=True)
+ MutualInfo { mutualTermCheck :: TerminationCheck Name
, mutualRange :: Range
}
deriving (Typeable, Show)
diff --git a/src/full/Agda/Syntax/Internal.hs b/src/full/Agda/Syntax/Internal.hs
index 5baabdd..8959d10 100644
--- a/src/full/Agda/Syntax/Internal.hs
+++ b/src/full/Agda/Syntax/Internal.hs
@@ -43,6 +43,7 @@ import Agda.Utils.Null
import Agda.Utils.Permutation
import Agda.Utils.Pointer
import Agda.Utils.Size
+import Agda.Utils.Pretty
#include "../undefined.h"
import Agda.Utils.Impossible
@@ -111,6 +112,7 @@ instance LensConName ConHead where
--
data Term = Var {-# UNPACK #-} !Int Elims -- ^ @x es@ neutral
| 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@
@@ -500,6 +502,13 @@ impossibleTerm file line = Lit $ LitString noRange $ unlines
sgTel :: Dom (ArgName, Type) -> Telescope
sgTel (Common.Dom ai (x, t)) = ExtendTel (Common.Dom ai t) $ Abs x EmptyTel
+hackReifyToMeta :: Term
+hackReifyToMeta = DontCare $ Lit $ LitInt noRange (-42)
+
+isHackReifyToMeta :: Term -> Bool
+isHackReifyToMeta (DontCare (Lit (LitInt r (-42)))) = r == noRange
+isHackReifyToMeta _ = False
+
---------------------------------------------------------------------------
-- * Handling blocked terms.
---------------------------------------------------------------------------
@@ -586,6 +595,7 @@ hasElims v =
Sort{} -> Nothing
Level{} -> Nothing
DontCare{} -> Nothing
+ ExtLam{} -> Nothing
Shared{} -> __IMPOSSIBLE__
{- PROBABLY USELESS
@@ -678,6 +688,7 @@ instance Sized Term where
Sort s -> 1
DontCare mv -> size mv
Shared p -> size (derefPtr p)
+ ExtLam{} -> __IMPOSSIBLE__
instance Sized Type where
size = size . unEl
@@ -726,6 +737,7 @@ instance KillRange Term where
Sort s -> killRange1 Sort s
DontCare mv -> killRange1 DontCare mv
Shared p -> Shared $ updatePtr killRange p
+ ExtLam{} -> __IMPOSSIBLE__
instance KillRange Level where
killRange (Max as) = killRange1 Max as
@@ -791,3 +803,96 @@ instanceUniverseBiT' [] [t| (([Type], [Clause]), Term) |]
instanceUniverseBiT' [] [t| (Args, Term) |]
instanceUniverseBiT' [] [t| (Elims, Term) |] -- ?
instanceUniverseBiT' [] [t| ([Term], Term) |]
+
+-----------------------------------------------------------------------------
+-- * Simple pretty printing
+-----------------------------------------------------------------------------
+
+showTerm :: Term -> String
+showTerm = show . pretty
+
+instance Pretty Term where
+ prettyPrec p v =
+ case ignoreSharing v of
+ Var x els -> text ("@" ++ show x) `pApp` els
+ Lam _ b ->
+ mparens (p > 0) $
+ sep [ text ("λ " ++ show (absName b) ++ " ->")
+ , 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
+ Pi a (NoAbs _ b) -> mparens (p > 0) $
+ sep [ prettyPrec 1 (unDom a) <+> text "->"
+ , nest 2 $ pretty b ]
+ Pi a b -> mparens (p > 0) $
+ sep [ pDom (domInfo a) (text (absName b) <+> text ":" <+> pretty (unDom a)) <+> text "->"
+ , nest 2 $ pretty (unAbs b) ]
+ Sort s -> pretty s
+ Level l -> pretty l
+ MetaV x els -> text (show x) `pApp` els
+ DontCare v -> pretty v
+ Shared{} -> __IMPOSSIBLE__
+ ExtLam{} -> __IMPOSSIBLE__
+ where
+ pApp d els = mparens (not (null els) && p > 9) $
+ d <+> fsep (map (prettyPrec 10) els)
+
+ pDom i =
+ case getHiding i of
+ NotHidden -> parens
+ Hidden -> braces
+ Instance -> braces . braces
+
+instance Pretty Level where
+ prettyPrec p (Max as) =
+ case as of
+ [] -> prettyPrec p (ClosedLevel 0)
+ [a] -> prettyPrec p a
+ _ -> mparens (p > 9) $ List.foldr1 (\a b -> text "lub" <+> a <+> b) $ map (prettyPrec 10) as
+
+instance Pretty PlusLevel where
+ prettyPrec p l =
+ case l of
+ ClosedLevel n -> sucs p n $ \_ -> text "lzero"
+ Plus n a -> sucs p n $ \p -> prettyPrec p a
+ where
+ sucs p 0 d = d p
+ sucs p n d = mparens (p > 9) $ text "lsuc" <+> sucs 10 (n - 1) d
+
+instance Pretty LevelAtom where
+ prettyPrec p a =
+ case a of
+ MetaLevel x els -> prettyPrec p (MetaV x els)
+ BlockedLevel _ v -> prettyPrec p v
+ NeutralLevel v -> prettyPrec p v
+ UnreducedLevel v -> prettyPrec p v
+
+instance Pretty Sort where
+ prettyPrec p s =
+ case s of
+ Type (Max []) -> text "Set"
+ Type (Max [ClosedLevel n]) -> text $ "Set" ++ show n
+ Type l -> mparens (p > 9) $ text "Set" <+> prettyPrec 10 l
+ Prop -> text "Prop"
+ Inf -> text "Setω"
+ DLub s b -> mparens (p > 9) $
+ text "dlub" <+> prettyPrec 10 s
+ <+> parens (sep [ text ("λ " ++ show (absName b) ++ " ->")
+ , nest 2 $ pretty (unAbs b) ])
+
+instance Pretty Type where
+ prettyPrec p (El _ a) = prettyPrec p a
+
+instance Pretty Elim where
+ prettyPrec p (Apply v) = prettyPrec p v
+ prettyPrec _ (Proj x) = text ("." ++ show x)
+
+instance Pretty a => Pretty (Arg a) where
+ prettyPrec p a =
+ ($ unArg a) $
+ case getHiding a of
+ 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 4e11d17..2ea05eb 100644
--- a/src/full/Agda/Syntax/Internal/Defs.hs
+++ b/src/full/Agda/Syntax/Internal/Defs.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}
+{-# LANGUAGE CPP, TypeSynonymInstances, FlexibleInstances #-}
-- | Extract used definitions from terms.
module Agda.Syntax.Internal.Defs where
@@ -11,6 +11,9 @@ import qualified Data.Foldable as Fold
import Agda.Syntax.Common
import Agda.Syntax.Internal hiding (ArgInfo, Arg, Dom)
+import Agda.Utils.Impossible
+#include "../../undefined.h"
+
-- | @getDefs' lookup emb a@ extracts all used definitions
-- (functions, data/record types) from @a@, embedded into a monoid via @emb at .
-- Instantiations of meta variables are obtained via @lookup at .
@@ -64,6 +67,7 @@ instance GetDefs Term where
MetaV x vs -> getDefs x >> getDefs vs
DontCare v -> getDefs v
Shared p -> getDefs $ derefPtr p -- TODO: exploit sharing!
+ ExtLam _ _ -> __IMPOSSIBLE__
instance GetDefs MetaId where
getDefs x = doMeta x
diff --git a/src/full/Agda/Syntax/Internal/Generic.hs b/src/full/Agda/Syntax/Internal/Generic.hs
index 69e3cc6..fb143b0 100644
--- a/src/full/Agda/Syntax/Internal/Generic.hs
+++ b/src/full/Agda/Syntax/Internal/Generic.hs
@@ -1,4 +1,4 @@
--- {-# LANGUAGE CPP #-}
+{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeSynonymInstances #-}
@@ -10,6 +10,9 @@ import Data.Monoid
import Data.Foldable
import Agda.Syntax.Internal
+import Agda.Utils.Impossible
+#include "../../undefined.h"
+
class TermLike a where
traverseTerm :: (Term -> Term) -> a -> a
traverseTermM :: (Monad m, Applicative m) => (Term -> m Term) -> a -> m a
@@ -109,6 +112,7 @@ instance TermLike Term where
Sort _ -> f t
DontCare mv -> f $ DontCare $ traverseTerm f mv
Shared p -> f $ Shared $ traverseTerm f p
+ ExtLam{} -> __IMPOSSIBLE__
traverseTermM f t = case t of
Var i xs -> f =<< Var i <$> traverseTermM f xs
@@ -122,6 +126,7 @@ instance TermLike Term where
Sort _ -> f t
DontCare mv -> f =<< DontCare <$> traverseTermM f mv
Shared p -> f =<< Shared <$> traverseTermM f p
+ ExtLam{} -> __IMPOSSIBLE__
foldTerm f t = f t `mappend` case t of
Var i xs -> foldTerm f xs
@@ -135,6 +140,7 @@ instance TermLike Term where
Sort _ -> mempty
DontCare mv -> foldTerm f mv
Shared p -> foldTerm f p
+ ExtLam{} -> __IMPOSSIBLE__
instance TermLike Level where
traverseTerm f (Max as) = Max $ traverseTerm f as
diff --git a/src/full/Agda/Syntax/Literal.hs b/src/full/Agda/Syntax/Literal.hs
index c220d05..ca1c2a9 100644
--- a/src/full/Agda/Syntax/Literal.hs
+++ b/src/full/Agda/Syntax/Literal.hs
@@ -1,9 +1,11 @@
{-# LANGUAGE DeriveDataTypeable #-}
module Agda.Syntax.Literal where
+import Data.Char
import Data.Typeable (Typeable)
import Agda.Syntax.Position
import Agda.Syntax.Abstract.Name
+import Agda.Utils.Pretty
data Literal = LitInt Range Integer
| LitFloat Range Double
@@ -23,6 +25,25 @@ instance Show Literal where
sh :: Show a => String -> a -> ShowS
sh c x = showString (c ++ " ") . shows x
+instance Pretty Literal where
+ pretty (LitInt _ n) = text $ show n
+ pretty (LitFloat _ x) = text $ show x
+ pretty (LitString _ s) = text $ showString' s ""
+ pretty (LitChar _ c) = text $ "'" ++ showChar' c "" ++ "'"
+ pretty (LitQName _ x) = text $ show x
+
+showString' :: String -> ShowS
+showString' s =
+ foldr (.) id $ [ showString "\"" ] ++ map showChar' s ++ [ showString "\"" ]
+
+showChar' :: Char -> ShowS
+showChar' '"' = showString "\\\""
+showChar' c
+ | escapeMe c = showLitChar c
+ | otherwise = showString [c]
+ where
+ escapeMe c = not (isPrint c) || c == '\\'
+
instance Eq Literal where
LitInt _ n == LitInt _ m = n == m
LitFloat _ x == LitFloat _ y = x == y
@@ -36,6 +57,7 @@ instance Ord Literal where
LitFloat _ x `compare` LitFloat _ y = x `compare` y
LitString _ s `compare` LitString _ t = s `compare` t
LitChar _ c `compare` LitChar _ d = c `compare` d
+ LitQName _ x `compare` LitQName _ y = x `compare` y
compare LitInt{} _ = LT
compare _ LitInt{} = GT
compare LitFloat{} _ = LT
diff --git a/src/full/Agda/Syntax/Parser/Lexer.x b/src/full/Agda/Syntax/Parser/Lexer.x
index 55e8b4e..5618879 100644
--- a/src/full/Agda/Syntax/Parser/Lexer.x
+++ b/src/full/Agda/Syntax/Parser/Lexer.x
@@ -79,6 +79,7 @@ tokens :-
<pragma_> "#-}" { endWith $ symbol SymClosePragma }
<pragma_> "OPTIONS" { keyword KwOPTIONS }
<pragma_> "BUILTIN" { keyword KwBUILTIN }
+<pragma_> "REWRITE" { keyword KwREWRITE }
<pragma_> "COMPILED_DATA" { keyword KwCOMPILED_DATA }
<pragma_> "COMPILED_TYPE" { keyword KwCOMPILED_TYPE }
<pragma_> "COMPILED" { keyword KwCOMPILED }
@@ -90,6 +91,8 @@ tokens :-
<pragma_> "IMPOSSIBLE" { keyword KwIMPOSSIBLE }
<pragma_> "ETA" { keyword KwETA }
<pragma_> "NO_TERMINATION_CHECK" { keyword KwNO_TERMINATION_CHECK }
+<pragma_> "NON_TERMINATING" { keyword KwNON_TERMINATING }
+<pragma_> "MEASURE" { keyword KwMEASURE }
<pragma_> "LINE" { keyword KwLINE }
<pragma_> . # [ $white ] + { withInterval $ TokString }
@@ -155,6 +158,7 @@ tokens :-
<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 }
@@ -164,6 +168,8 @@ tokens :-
<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 }
diff --git a/src/full/Agda/Syntax/Parser/Parser.y b/src/full/Agda/Syntax/Parser/Parser.y
index 10de583..9abe09b 100644
--- a/src/full/Agda/Syntax/Parser/Parser.y
+++ b/src/full/Agda/Syntax/Parser/Parser.y
@@ -94,6 +94,7 @@ import Agda.Utils.Tuple
'mutual' { TokKeyword KwMutual $$ }
'abstract' { TokKeyword KwAbstract $$ }
'private' { TokKeyword KwPrivate $$ }
+ 'instance' { TokKeyword KwInstance $$ }
'Prop' { TokKeyword KwProp $$ }
'Set' { TokKeyword KwSet $$ }
'forall' { TokKeyword KwForall $$ }
@@ -101,10 +102,13 @@ import Agda.Utils.Tuple
'pattern' { TokKeyword KwPatternSyn $$ }
'OPTIONS' { TokKeyword KwOPTIONS $$ }
'BUILTIN' { TokKeyword KwBUILTIN $$ }
+ 'REWRITE' { TokKeyword KwREWRITE $$ }
'IMPORT' { TokKeyword KwIMPORT $$ }
'IMPOSSIBLE' { TokKeyword KwIMPOSSIBLE $$ }
'ETA' { TokKeyword KwETA $$ }
'NO_TERMINATION_CHECK' { TokKeyword KwNO_TERMINATION_CHECK $$ }
+ 'NON_TERMINATING' { TokKeyword KwNON_TERMINATING $$ }
+ 'MEASURE' { TokKeyword KwMEASURE $$ }
'COMPILED' { TokKeyword KwCOMPILED $$ }
'COMPILED_EXPORT' { TokKeyword KwCOMPILED_EXPORT $$ }
'COMPILED_DATA' { TokKeyword KwCOMPILED_DATA $$ }
@@ -116,7 +120,9 @@ import Agda.Utils.Tuple
'quoteContext' { TokKeyword KwQuoteContext $$ }
'quote' { TokKeyword KwQuote $$ }
'quoteTerm' { TokKeyword KwQuoteTerm $$ }
+ 'tactic' { TokKeyword KwTactic $$ }
'unquote' { TokKeyword KwUnquote $$ }
+ 'unquoteDecl' { TokKeyword KwUnquoteDecl $$ }
setN { TokSetN $$ }
tex { TokTeX $$ }
@@ -200,6 +206,7 @@ Token
| '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 }
@@ -207,6 +214,7 @@ Token
| 'pattern' { TokKeyword KwPatternSyn $1 }
| 'OPTIONS' { TokKeyword KwOPTIONS $1 }
| 'BUILTIN' { TokKeyword KwBUILTIN $1 }
+ | 'REWRITE' { TokKeyword KwREWRITE $1 }
| 'IMPORT' { TokKeyword KwIMPORT $1 }
| 'COMPILED' { TokKeyword KwCOMPILED $1 }
| 'COMPILED_EXPORT' { TokKeyword KwCOMPILED_EXPORT $1 }
@@ -218,11 +226,15 @@ Token
| 'IMPOSSIBLE' { TokKeyword KwIMPOSSIBLE $1 }
| 'ETA' { TokKeyword KwETA $1 }
| 'NO_TERMINATION_CHECK' { TokKeyword KwNO_TERMINATION_CHECK $1 }
+ | 'NON_TERMINATING' { TokKeyword KwNON_TERMINATING $1 }
+ | 'MEASURE' { TokKeyword KwMEASURE $1 }
| 'quoteGoal' { TokKeyword KwQuoteGoal $1 }
| 'quoteContext' { TokKeyword KwQuoteContext $1 }
| 'quote' { TokKeyword KwQuote $1 }
| 'quoteTerm' { TokKeyword KwQuoteTerm $1 }
+ | 'tactic' { TokKeyword KwTactic $1 }
| 'unquote' { TokKeyword KwUnquote $1 }
+ | 'unquoteDecl' { TokKeyword KwUnquoteDecl $1 }
| setN { TokSetN $1 }
| tex { TokTeX $1 }
@@ -482,8 +494,11 @@ PragmaString :: { String }
PragmaString
: string { snd $1 }
-PragmaName :: { QName }
-PragmaName : string {% fmap QName (mkName $1) }
+PragmaName :: { Name }
+PragmaName : string {% mkName $1 }
+
+PragmaQName :: { QName }
+PragmaQName : string {% fmap QName (mkName $1) }
{--------------------------------------------------------------------------
Expressions (terms and types)
@@ -542,7 +557,9 @@ Expr2
| 'let' Declarations 'in' Expr { Let (getRange ($1,$2,$3,$4)) $2 $4 }
| 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 }
+ | 'quoteContext' Id 'in' Expr { QuoteContext (getRange ($1,$2,$3,$4)) $2 $4 }
+ | 'tactic' Application3 { Tactic (getRange ($1, $2)) (RawApp (getRange $2) $2) [] }
+ | 'tactic' Application3 '|' WithExprs { Tactic (getRange ($1, $2, $3, $4)) (RawApp (getRange $2) $2) $4 }
ExtendedOrAbsurdLam :: { Expr }
ExtendedOrAbsurdLam
@@ -917,6 +934,7 @@ Declaration
| Mutual { [$1] }
| Abstract { [$1] }
| Private { [$1] }
+ | Instance { [$1] }
| Postulate { [$1] }
| Primitive { [$1] }
| Open { $1 }
@@ -926,6 +944,7 @@ Declaration
| Pragma { [$1] }
| Syntax { [$1] }
| PatternSyn { [$1] }
+ | UnquoteDecl { [$1] }
{--------------------------------------------------------------------------
@@ -937,9 +956,6 @@ Declaration
TypeSigs :: { [Declaration] }
TypeSigs : SpaceIds ':' Expr { map (flip (TypeSig defaultArgInfo) $3) $1 }
-RelTypeSigs :: { [Declaration] }
-RelTypeSigs : MaybeDottedIds ':' Expr { map (\ (Common.Arg info x) -> TypeSig info x $3) $1 }
-
-- A variant of TypeSigs where any sub-sequence of names can be marked
-- as hidden or irrelevant using braces and dots:
-- {n1 .n2} n3 .n4 {n5} .{n6 n7} ... : Type.
@@ -1024,14 +1040,23 @@ Private :: { Declaration }
Private : 'private' Declarations { Private (fuseRange $1 $2) $2 }
--- Postulates. Can only contain type signatures. TODO: relax this.
+-- Instance declarations.
+Instance :: { Declaration }
+Instance : 'instance' Declarations { InstanceB (fuseRange $1 $2) $2 }
+
+
+-- Postulates.
Postulate :: { Declaration }
-Postulate : 'postulate' RelTypeSignatures { Postulate (fuseRange $1 $2) $2 }
+Postulate : 'postulate' Declarations { Postulate (fuseRange $1 $2) $2 }
-- Primitives. Can only contain type signatures.
Primitive :: { Declaration }
Primitive : 'primitive' TypeSignatures { Primitive (fuseRange $1 $2) $2 }
+-- Unquoting declarations.
+UnquoteDecl :: { Declaration }
+UnquoteDecl : 'unquoteDecl' Id '=' Expr { UnquoteDecl (fuseRange $1 $4) $2 $4 }
+
-- Syntax declaration (To declare eg. mixfix binders)
Syntax :: { Declaration }
Syntax : 'syntax' Id HoleNames '=' SimpleIds {%
@@ -1202,6 +1227,7 @@ Pragma : DeclarationPragma { Pragma $1 }
DeclarationPragma :: { Pragma }
DeclarationPragma
: BuiltinPragma { $1 }
+ | RewritePragma { $1 }
| CompiledPragma { $1 }
| CompiledExportPragma { $1 }
| CompiledDataPragma { $1 }
@@ -1212,7 +1238,9 @@ DeclarationPragma
| ImportPragma { $1 }
| ImpossiblePragma { $1 }
| RecordEtaPragma { $1 }
+ | NonTerminatingPragma { $1 }
| NoTerminationCheckPragma { $1 }
+ | MeasurePragma { $1 }
| OptionsPragma { $1 }
-- Andreas, 2014-03-06
-- OPTIONS pragma not allowed everywhere, but don't give parse error.
@@ -1223,53 +1251,71 @@ OptionsPragma : '{-#' 'OPTIONS' PragmaStrings '#-}' { OptionsPragma (getRange ($
BuiltinPragma :: { Pragma }
BuiltinPragma
- : '{-#' 'BUILTIN' string PragmaName '#-}'
+ : '{-#' 'BUILTIN' string PragmaQName '#-}'
{ BuiltinPragma (getRange ($1,$2,fst $3,$4,$5)) (snd $3) (Ident $4) }
+ | '{-#' 'BUILTIN' 'REWRITE' PragmaQName '#-}'
+ { BuiltinPragma (getRange ($1,$2,$3,$4,$5)) "REWRITE" (Ident $4) }
+
+RewritePragma :: { Pragma }
+RewritePragma
+ : '{-#' 'REWRITE' PragmaQName '#-}'
+ { RewritePragma (getRange ($1,$2,$3,$4)) $3 }
CompiledPragma :: { Pragma }
CompiledPragma
- : '{-#' 'COMPILED' PragmaName PragmaStrings '#-}'
+ : '{-#' 'COMPILED' PragmaQName PragmaStrings '#-}'
{ CompiledPragma (getRange ($1,$2,$3,$5)) $3 (unwords $4) }
CompiledExportPragma :: { Pragma }
CompiledExportPragma
- : '{-#' 'COMPILED_EXPORT' PragmaName PragmaString '#-}'
+ : '{-#' 'COMPILED_EXPORT' PragmaQName PragmaString '#-}'
{ CompiledExportPragma (getRange ($1,$2,$3,$5)) $3 $4 }
CompiledTypePragma :: { Pragma }
CompiledTypePragma
- : '{-#' 'COMPILED_TYPE' PragmaName PragmaStrings '#-}'
+ : '{-#' 'COMPILED_TYPE' PragmaQName PragmaStrings '#-}'
{ CompiledTypePragma (getRange ($1,$2,$3,$5)) $3 (unwords $4) }
CompiledDataPragma :: { Pragma }
CompiledDataPragma
- : '{-#' 'COMPILED_DATA' PragmaName string PragmaStrings '#-}'
+ : '{-#' 'COMPILED_DATA' PragmaQName string PragmaStrings '#-}'
{ CompiledDataPragma (getRange ($1,$2,$3,fst $4,$6)) $3 (snd $4) $5 }
CompiledEpicPragma :: { Pragma }
CompiledEpicPragma
- : '{-#' 'COMPILED_EPIC' PragmaName PragmaStrings '#-}'
+ : '{-#' 'COMPILED_EPIC' PragmaQName PragmaStrings '#-}'
{ CompiledEpicPragma (getRange ($1,$2,$3,$5)) $3 (unwords $4) }
CompiledJSPragma :: { Pragma }
CompiledJSPragma
- : '{-#' 'COMPILED_JS' PragmaName PragmaStrings '#-}'
+ : '{-#' 'COMPILED_JS' PragmaQName PragmaStrings '#-}'
{ CompiledJSPragma (getRange ($1,$2,$3,$5)) $3 (unwords $4) }
StaticPragma :: { Pragma }
StaticPragma
- : '{-#' 'STATIC' PragmaName '#-}'
+ : '{-#' 'STATIC' PragmaQName '#-}'
{ StaticPragma (getRange ($1,$2,$3,$4)) $3 }
RecordEtaPragma :: { Pragma }
RecordEtaPragma
- : '{-#' 'ETA' PragmaName '#-}'
+ : '{-#' 'ETA' PragmaQName '#-}'
{ EtaPragma (getRange ($1,$2,$3,$4)) $3 }
NoTerminationCheckPragma :: { Pragma }
NoTerminationCheckPragma
: '{-#' 'NO_TERMINATION_CHECK' '#-}'
- { NoTerminationCheckPragma (getRange ($1,$2,$3)) }
+ { TerminationCheckPragma (getRange ($1,$2,$3)) NoTerminationCheck }
+
+NonTerminatingPragma :: { Pragma }
+NonTerminatingPragma
+ : '{-#' 'NON_TERMINATING' '#-}'
+ { TerminationCheckPragma (getRange ($1,$2,$3)) NonTerminating }
+
+MeasurePragma :: { Pragma }
+MeasurePragma
+ : '{-#' 'MEASURE' PragmaName '#-}'
+ { let r = getRange ($1, $2, $3, $4) in
+ TerminationCheckPragma r (TerminationMeasure r $3) }
ImportPragma :: { Pragma }
ImportPragma
@@ -1299,17 +1345,6 @@ TypeSignatures1
: TypeSignatures1 semi TypeSigs { reverse $3 ++ $1 }
| TypeSigs { reverse $1 }
--- A variant of TypeSignatures which allows the irrelevance annotation (dot).
-RelTypeSignatures :: { [TypeSignature] }
-RelTypeSignatures
- : vopen RelTypeSignatures1 close { reverse $2 }
-
--- Inside the layout block.
-RelTypeSignatures1 :: { [TypeSignature] }
-RelTypeSignatures1
- : RelTypeSignatures1 semi RelTypeSigs { reverse $3 ++ $1 }
- | RelTypeSigs { reverse $1 }
-
-- A variant of TypeSignatures which uses ArgTypeSigs instead of
-- TypeSigs.
ArgTypeSignatures :: { [Arg TypeSignature] }
@@ -1576,6 +1611,7 @@ exprToPattern e =
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
diff --git a/src/full/Agda/Syntax/Parser/Tokens.hs b/src/full/Agda/Syntax/Parser/Tokens.hs
index 43034a0..87680ee 100644
--- a/src/full/Agda/Syntax/Parser/Tokens.hs
+++ b/src/full/Agda/Syntax/Parser/Tokens.hs
@@ -11,7 +11,7 @@ import Agda.Syntax.Position
data Keyword
= KwLet | KwIn | KwWhere | KwData | KwCoData
- | KwPostulate | KwMutual | KwAbstract | KwPrivate
+ | KwPostulate | KwMutual | KwAbstract | KwPrivate | KwInstance
| KwOpen | KwImport | KwModule | KwPrimitive
| KwInfix | KwInfixL | KwInfixR | KwWith | KwRewrite
| KwSet | KwProp | KwForall | KwRecord | KwConstructor | KwField
@@ -20,14 +20,15 @@ data Keyword
| KwOPTIONS | KwBUILTIN | KwLINE
| KwCOMPILED_DATA | KwCOMPILED_TYPE | KwCOMPILED | KwCOMPILED_EXPORT
| KwCOMPILED_EPIC | KwCOMPILED_JS
- | KwIMPORT | KwIMPOSSIBLE | KwETA | KwNO_TERMINATION_CHECK | KwSTATIC
- | KwQuoteGoal | KwQuoteContext | KwQuote | KwQuoteTerm | KwUnquote | KwSyntax
- | KwPatternSyn
+ | KwIMPORT | KwIMPOSSIBLE | KwETA | KwNO_TERMINATION_CHECK | KwNON_TERMINATING | KwMEASURE | KwSTATIC
+ | KwREWRITE
+ | KwQuoteGoal | KwQuoteContext | KwQuote | KwQuoteTerm | KwUnquote | KwUnquoteDecl | KwSyntax
+ | KwPatternSyn | KwTactic
deriving (Eq, Show)
layoutKeywords :: [Keyword]
layoutKeywords =
- [ KwLet, KwWhere, KwPostulate, KwMutual, KwAbstract, KwPrivate, KwPrimitive, KwField ]
+ [ KwLet, KwWhere, KwPostulate, KwMutual, KwAbstract, KwPrivate, KwInstance, KwPrimitive, KwField ]
data Symbol
= SymDot | SymSemi | SymVirtualSemi | SymBar
diff --git a/src/full/Agda/Syntax/Position.hs b/src/full/Agda/Syntax/Position.hs
index 27a8405..f07a40f 100644
--- a/src/full/Agda/Syntax/Position.hs
+++ b/src/full/Agda/Syntax/Position.hs
@@ -64,13 +64,15 @@ module Agda.Syntax.Position
, tests
) where
+import Prelude hiding (null)
+
import Control.Applicative
import Control.Monad
import Data.Foldable (Foldable)
import Data.Function
import Data.Int
-import Data.List
+import Data.List hiding (null)
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Traversable (Traversable)
@@ -80,6 +82,7 @@ import Test.QuickCheck.All
import Agda.Utils.FileName hiding (tests)
import Agda.Utils.Maybe
+import Agda.Utils.Null
import Agda.Utils.TestHelpers
import Agda.Utils.QuickCheck
@@ -150,7 +153,7 @@ iLength i = posPos (iEnd i) - posPos (iStart i)
--
-- Note the invariant which ranges have to satisfy: 'rangeInvariant'.
newtype Range' a = Range [Interval' a]
- deriving (Typeable, Eq, Ord, Functor, Foldable, Traversable)
+ deriving (Typeable, Eq, Ord, Functor, Foldable, Traversable, Null)
type Range = Range' SrcFile
diff --git a/src/full/Agda/Syntax/Scope/Base.hs b/src/full/Agda/Syntax/Scope/Base.hs
index 0d89ad9..528454c 100644
--- a/src/full/Agda/Syntax/Scope/Base.hs
+++ b/src/full/Agda/Syntax/Scope/Base.hs
@@ -143,6 +143,7 @@ data KindOfName
| FldName -- ^ Record field name.
| DefName -- ^ Ordinary defined name.
| PatternSynName -- ^ Name of a pattern synonym.
+ | QuotableName -- ^ A name that can only quoted.
deriving (Eq, Show, Typeable, Enum, Bounded)
-- | A list containing all name kinds.
@@ -393,6 +394,13 @@ addNamesToScope acc x ys s = mergeScope s s1
addNameToScope :: NameSpaceId -> C.Name -> AbstractName -> Scope -> Scope
addNameToScope acc x y s = addNamesToScope acc x [y] s
+-- | Remove a name from a scope.
+removeNameFromScope :: NameSpaceId -> C.Name -> Scope -> Scope
+removeNameFromScope ns x s = mapScope remove (const id) s
+ where
+ remove ns' | ns' /= ns = id
+ | otherwise = Map.delete x
+
-- | Add a module to a scope.
addModuleToScope :: NameSpaceId -> C.Name -> AbstractModule -> Scope -> Scope
addModuleToScope acc x m s = mergeScope s s1
@@ -591,10 +599,16 @@ scopeLookup' q scope = nubBy ((==) `on` fst) $ findName q root ++ imports
-- * Inverse look-up
+data AllowAmbiguousConstructors = AllowAmbiguousConstructors | NoAmbiguousConstructors
+ deriving (Eq)
+
-- | Find the shortest concrete name that maps (uniquely) to a given abstract
-- name.
inverseScopeLookup :: Either A.ModuleName A.QName -> ScopeInfo -> Maybe C.QName
-inverseScopeLookup name scope = case name of
+inverseScopeLookup = inverseScopeLookup' AllowAmbiguousConstructors
+
+inverseScopeLookup' :: AllowAmbiguousConstructors -> Either A.ModuleName A.QName -> ScopeInfo -> Maybe C.QName
+inverseScopeLookup' ambCon name scope = case name of
Left m -> best $ filter unambiguousModule $ findModule m
Right q -> best $ filter unambiguousName $ findName nameMap q
where
@@ -622,7 +636,7 @@ inverseScopeLookup name scope = case name of
unique (_:_:_) = False
unambiguousModule q = unique (scopeLookup q scope :: [AbstractModule])
- unambiguousName q = unique xs || all ((ConName ==) . anameKind) xs
+ unambiguousName q = unique xs || AllowAmbiguousConstructors == ambCon && all ((ConName ==) . anameKind) xs
where xs = scopeLookup q scope
findName :: Ord a => Map a [(A.ModuleName, C.Name)] -> a -> [C.QName]
@@ -659,6 +673,9 @@ inverseScopeLookup name scope = case name of
inverseScopeLookupName :: A.QName -> ScopeInfo -> Maybe C.QName
inverseScopeLookupName x = inverseScopeLookup (Right x)
+inverseScopeLookupName' :: AllowAmbiguousConstructors -> A.QName -> ScopeInfo -> Maybe C.QName
+inverseScopeLookupName' ambCon x = inverseScopeLookup' ambCon (Right x)
+
-- | Takes the second component of 'inverseScopeLookup'.
inverseScopeLookupModule :: A.ModuleName -> ScopeInfo -> Maybe C.QName
inverseScopeLookupModule x = inverseScopeLookup (Left x)
diff --git a/src/full/Agda/Syntax/Scope/Monad.hs b/src/full/Agda/Syntax/Scope/Monad.hs
index 64b2783..0bac96a 100644
--- a/src/full/Agda/Syntax/Scope/Monad.hs
+++ b/src/full/Agda/Syntax/Scope/Monad.hs
@@ -22,6 +22,7 @@ import Agda.Syntax.Common
import Agda.Syntax.Position
import Agda.Syntax.Fixity
import Agda.Syntax.Abstract.Name as A
+import qualified Agda.Syntax.Abstract as A
import Agda.Syntax.Concrete as C
import Agda.Syntax.Scope.Base
@@ -107,10 +108,7 @@ modifyScopes f = modifyScopeInfo $ \s -> s { scopeModules = f $ scopeModules s }
-- | Apply a function to the given scope.
modifyNamedScope :: A.ModuleName -> (Scope -> Scope) -> ScopeM ()
-modifyNamedScope m f = modifyScopes $ Map.mapWithKey f'
- where
- f' m' s | m' == m = f s
- | otherwise = s
+modifyNamedScope m f = modifyScopes $ Map.adjust f m
-- | Apply a function to the current scope.
modifyCurrentScope :: (Scope -> Scope) -> ScopeM ()
@@ -289,6 +287,15 @@ bindName acc kind x y = do
head' [] = {- ' -} __IMPOSSIBLE__
head' (x:_) = x
+-- | Rebind a name. Use with care!
+-- Ulf, 2014-06-29: Currently used to rebind the name defined by an
+-- unquoteDecl, which is a 'QuotableName' in the body, but a 'DefinedName'
+-- later on.
+rebindName :: Access -> KindOfName -> C.Name -> A.QName -> ScopeM ()
+rebindName acc kind x y = do
+ modifyCurrentScope $ removeNameFromScope (localNameSpace acc) x
+ bindName acc kind x y
+
-- | Bind a module name.
bindModule :: Access -> C.Name -> A.ModuleName -> ScopeM ()
bindModule acc x m = modifyCurrentScope $
@@ -309,100 +316,96 @@ stripNoNames = modifyScopes $ Map.map strip
stripN m = Map.filterWithKey (const . notNoName) m
notNoName = not . isNoName
-type Ren a = Map a a
-type Out = (Ren A.ModuleName, Ren A.QName)
+type Out = (A.Ren A.ModuleName, A.Ren A.QName)
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.
-copyScope :: C.QName -> A.ModuleName -> Scope -> ScopeM (Scope, (Ren A.ModuleName, Ren A.QName))
-copyScope cm new s = first (inScopeBecause $ Applied cm) <$> runStateT (copy new s) (Map.empty, Map.empty)
+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
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
return $ s' { scopeName = scopeName s0
, scopeParents = scopeParents s0
}
-
- new' = killRange 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 :: 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 }
-
- 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)
-
- addNames rd' = modify $ \(rm, rd) -> (rm, Map.union rd rd')
- addMods rm' = modify $ \(rm, rd) -> (Map.union rm rm', rd)
-
- findName x = Map.lookup x <$> gets snd
- findMod x = Map.lookup x <$> gets fst
-
- isInOld qs = isPrefixOf (A.mnameToList old) qs
-
- -- Change a binding M.x -> old.M'.y to M.x -> new.M'.y
- -- Ulf, 2013-11-06: We should run this also on the imported name space
- -- (issue892), so make sure to only rename things with the prefix M.
- renName :: A.QName -> WSM A.QName
- renName x | not (isInOld $ A.qnameToList x) = return x
- renName x = do
- -- 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 = A.qnameFromList . drop (size old) . A.qnameToList
-
- -- Change a binding M.x -> old.M'.y to M.x -> new.M'.y
- renMod :: A.ModuleName -> WSM A.ModuleName
- renMod x | not (isInOld $ A.mnameToList x) = return x
- 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
+ new' = killRange 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 :: 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 }
+
+ 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)
+
+ addNames rd' = modify $ \(rm, rd) -> (rm, Map.union rd rd')
+ addMods rm' = modify $ \(rm, rd) -> (Map.union rm rm', rd)
+
+ findName x = Map.lookup x <$> gets snd
+ findMod x = Map.lookup x <$> gets fst
+
+ -- Change a binding M.x -> old.M'.y to M.x -> new.M'.y
+ 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]
+
+ -- 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
-- | Apply an import directive and check that all the names mentioned actually
-- exist.
diff --git a/src/full/Agda/Syntax/Translation/AbstractToConcrete.hs b/src/full/Agda/Syntax/Translation/AbstractToConcrete.hs
index 8fac4d4..8ab7b48 100644
--- a/src/full/Agda/Syntax/Translation/AbstractToConcrete.hs
+++ b/src/full/Agda/Syntax/Translation/AbstractToConcrete.hs
@@ -42,6 +42,7 @@ import Data.Traversable (traverse)
import Agda.Syntax.Common hiding (Arg, Dom, NamedArg)
import qualified Agda.Syntax.Common as Common
import Agda.Syntax.Position
+import Agda.Syntax.Literal
import Agda.Syntax.Info
import Agda.Syntax.Internal (MetaId(..))
import Agda.Syntax.Fixity
@@ -167,9 +168,9 @@ lookupName x = do
Just y -> return y
Nothing -> return $ nameConcrete x
-lookupQName :: A.QName -> AbsToCon C.QName
-lookupQName x = do
- my <- inverseScopeLookupName x <$> asks currentScope
+lookupQName :: AllowAmbiguousConstructors -> A.QName -> AbsToCon C.QName
+lookupQName ambCon x = do
+ my <- inverseScopeLookupName' ambCon x <$> asks currentScope
case my of
Just y -> return y
Nothing -> do
@@ -338,7 +339,7 @@ instance ToConcrete A.Name C.Name where
bindToConcrete x = bindName x
instance ToConcrete A.QName C.QName where
- toConcrete = lookupQName
+ toConcrete = lookupQName AllowAmbiguousConstructors
instance ToConcrete A.ModuleName C.QName where
toConcrete = lookupModule
@@ -353,6 +354,10 @@ instance ToConcrete A.Expr C.Expr where
-- for names we have to use the name from the info, since the abstract
-- name has been resolved to a fully qualified name (except for
-- variables)
+ toConcrete (A.Lit (LitQName r x)) = do
+ x <- lookupQName NoAmbiguousConstructors x
+ bracket appBrackets $ return $
+ C.App r (C.Quote r) (defaultNamedArg $ C.Ident x)
toConcrete (A.Lit l) = return $ C.Lit l
-- Andreas, 2014-05-17 We print question marks with their
@@ -780,6 +785,10 @@ instance ToConcrete A.Declaration [C.Declaration] where
C.QName x <- toConcrete x
bindToConcrete xs $ \xs -> (:[]) . C.PatternSyn (getRange x) x xs <$> toConcrete p
+ toConcrete (A.UnquoteDecl _ i x e) = do
+ C.QName x <- toConcrete x
+ (:[]) . C.UnquoteDecl (getRange i) x <$> toConcrete e
+
data RangeAndPragma = RangeAndPragma Range A.Pragma
@@ -789,6 +798,9 @@ instance ToConcrete RangeAndPragma C.Pragma where
A.BuiltinPragma b x -> do
x <- toConcrete x
return $ C.BuiltinPragma r b x
+ A.RewritePragma x -> do
+ x <- toConcrete x
+ return $ C.RewritePragma r x
A.CompiledTypePragma x hs -> do
x <- toConcrete x
return $ C.CompiledTypePragma r x hs
@@ -877,6 +889,9 @@ instance ToConcrete A.Pattern C.Pattern where
(x, p) <- toConcreteCtx ArgumentCtx (x,p)
return $ C.AsP (getRange i) x p
toConcrete (A.AbsurdP i) = return $ C.AbsurdP (getRange i)
+ toConcrete (A.LitP (LitQName r x)) = do
+ x <- lookupQName NoAmbiguousConstructors x
+ bracketP_ appBrackets $ return $ AppP (C.QuoteP r) (defaultNamedArg (C.IdentP x))
toConcrete (A.LitP l) = return $ C.LitP l
toConcrete (A.DotP i e) = do
e <- toConcreteCtx DotPatternCtx e
diff --git a/src/full/Agda/Syntax/Translation/ConcreteToAbstract.hs b/src/full/Agda/Syntax/Translation/ConcreteToAbstract.hs
index a261bf4..d37082c 100644
--- a/src/full/Agda/Syntax/Translation/ConcreteToAbstract.hs
+++ b/src/full/Agda/Syntax/Translation/ConcreteToAbstract.hs
@@ -3,6 +3,7 @@
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverlappingInstances #-}
+{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE UndecidableInstances #-}
@@ -42,6 +43,7 @@ import Agda.Syntax.Concrete.Generic
import Agda.Syntax.Concrete.Operators
import Agda.Syntax.Abstract as A
import Agda.Syntax.Position
+import Agda.Syntax.Literal
import Agda.Syntax.Common hiding (Arg, Dom, NamedArg, ArgInfo)
import qualified Agda.Syntax.Common as Common
import Agda.Syntax.Info
@@ -182,14 +184,11 @@ 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@
- (m, args) <- case appView e of
- AppView (Ident m) args -> return (m, args)
- _ -> notAModuleExpr e
-
+ (m, args) <- parseModuleApplication e
-- scope check the telescope (introduces bindings!)
tel' <- toAbstract tel
-- scope the old module name, the module args
- (m1,args') <- toAbstract (OldModuleName m, 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.
let noRecConstr | null args = id
@@ -354,10 +353,12 @@ instance ToAbstract (NewName C.BoundName) A.Name where
nameExpr :: AbstractName -> A.Expr
nameExpr d = mk (anameKind d) $ anameName d
where
- mk DefName = Def
- mk FldName = Def
- mk ConName = Con . AmbQ . (:[])
- mk PatternSynName = A.PatternSyn
+ mk DefName x = Def x
+ mk FldName x = Def x
+ mk ConName x = 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)
instance ToAbstract OldQName A.Expr where
toAbstract (OldQName x) = do
@@ -591,7 +592,7 @@ instance ToAbstract C.Expr A.Expr where
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 True cname
+ 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
@@ -684,6 +685,13 @@ instance ToAbstract C.Expr A.Expr where
C.QuoteTerm r -> return $ A.QuoteTerm (ExprRange r)
C.Unquote r -> return $ A.Unquote (ExprRange r)
+ C.Tactic r e es -> do
+ g <- freshName r "g"
+ let re = ExprRange (getRange e)
+ e : es <- toAbstract (e : es)
+ let tac = A.App re e (defaultNamedArg $ A.Var g)
+ return $ A.QuoteGoal (ExprRange r) g $ foldl (A.App re) (A.Unquote re) (map defaultNamedArg $ tac : es)
+
-- DontCare
C.DontCare e -> A.DontCare <$> toAbstract e
@@ -898,7 +906,9 @@ instance ToAbstract [C.Declaration] [A.Declaration] where
ds <- ifM (optSafe <$> commandLineOptions) (mapM noNoTermCheck ds) (return ds)
toAbstract =<< niceDecls ds
where
- noNoTermCheck (C.Pragma (NoTerminationCheckPragma r)) =
+ noNoTermCheck (C.Pragma (C.TerminationCheckPragma r NoTerminationCheck)) =
+ typeError $ SafeFlagNoTerminationCheck
+ noNoTermCheck (C.Pragma (C.TerminationCheckPragma r NonTerminating)) =
typeError $ SafeFlagNoTerminationCheck
noNoTermCheck d = return d
@@ -912,9 +922,11 @@ instance ToAbstract LetDefs [A.LetBinding] where
instance ToAbstract LetDef [A.LetBinding] where
toAbstract (LetDef d) =
case d of
- NiceMutual _ _ d@[C.FunSig _ fx _ info _ x t, C.FunDef _ _ _ abstract _ _ [cl]] ->
+ NiceMutual _ _ d@[C.FunSig _ fx _ instanc info _ x t, C.FunDef _ _ _ abstract _ _ [cl]] ->
do when (abstract == AbstractDef) $ do
typeError $ GenericError $ "abstract not allowed in let expressions"
+ when (instanc == InstanceDef) $ do
+ typeError $ GenericError $ "Using instance is useless here, let expressions are always eligible for instance search."
e <- letToAbstract cl
t <- toAbstract t
x <- toAbstract (NewName $ mkBoundName x fx)
@@ -936,7 +948,7 @@ instance ToAbstract LetDef [A.LetBinding] where
case definedName p of
Nothing -> throwError err
Just x -> toAbstract $ LetDef $ NiceMutual r termCheck
- [ C.FunSig r defaultFixity' PublicAccess defaultArgInfo termCheck x (C.Underscore (getRange x) Nothing)
+ [ C.FunSig r defaultFixity' PublicAccess NotInstanceDef defaultArgInfo termCheck x (C.Underscore (getRange x) Nothing)
, C.FunDef r __IMPOSSIBLE__ __IMPOSSIBLE__ ConcreteDef __IMPOSSIBLE__ __IMPOSSIBLE__
[C.Clause x lhs (C.RHS rhs) NoWhere []]
]
@@ -950,6 +962,7 @@ instance ToAbstract LetDef [A.LetBinding] where
definedName C.AsP{} = Nothing
definedName C.DotP{} = Nothing
definedName C.LitP{} = Nothing
+ definedName C.QuoteP{} = Nothing
definedName C.HiddenP{} = __IMPOSSIBLE__
definedName C.InstanceP{} = __IMPOSSIBLE__
definedName C.RawAppP{} = __IMPOSSIBLE__
@@ -1018,7 +1031,7 @@ instance ToAbstract NiceDeclaration A.Declaration where
case d of
-- Axiom (actual postulate)
- C.Axiom r f p rel x t -> do
+ C.Axiom r f p i rel x t -> do
-- check that we do not postulate in --safe mode
clo <- commandLineOptions
when (optSafe clo) (typeError (SafeFlagPostulate x))
@@ -1054,6 +1067,7 @@ instance ToAbstract NiceDeclaration A.Declaration where
-- Definitions (possibly mutual)
NiceMutual r termCheck ds -> do
ds' <- toAbstract ds
+ -- We only termination check blocks that do not have a measure.
return [ A.Mutual (MutualInfo termCheck r) ds' ]
C.NiceRecSig r f a x ls t -> do
@@ -1076,7 +1090,7 @@ instance ToAbstract NiceDeclaration A.Declaration where
t' <- toAbstract t
return [ A.DataSig (mkDefInfo x f a ConcreteDef r) x' ls' t' ]
-- Type signatures
- C.FunSig r f p rel tc x t -> toAbstractNiceAxiom A.FunSig (C.Axiom r f p rel x t)
+ C.FunSig r f p i rel tc x t -> toAbstractNiceAxiom A.FunSig (C.Axiom r f p i rel x t)
-- Function definitions
C.FunDef r ds f a tc x cs -> do
printLocals 10 $ "checking def " ++ show x
@@ -1117,7 +1131,7 @@ instance ToAbstract NiceDeclaration A.Declaration where
printScope "data" 20 $ "Checked data " ++ show x
return [ A.DataDef (mkDefInfo x f PublicAccess a r) x' pars cons ]
where
- conName (C.Axiom _ _ _ _ c _) = c
+ conName (C.Axiom _ _ _ _ _ c _) = c
conName _ = __IMPOSSIBLE__
-- Record definitions (mucho interesting)
@@ -1175,7 +1189,7 @@ instance ToAbstract NiceDeclaration A.Declaration where
ps <- toAbstract p
return $ map (A.Pragma r) ps
- NiceImport r x as open dir -> do
+ NiceImport r x as open dir -> traceCall (SetRange r) $ do
notPublicWithoutOpen open dir
-- First scope check the imported module and return its name and
@@ -1224,6 +1238,14 @@ instance ToAbstract NiceDeclaration A.Declaration where
})
m ]
+ NiceUnquoteDecl r fx p a tc x e -> do
+ y <- freshAbstractQName fx x
+ bindName p QuotableName x y
+ e <- toAbstract e
+ rebindName p DefName x y
+ let mi = MutualInfo tc r
+ return [A.UnquoteDecl mi (mkDefInfo x fx p a r) y e]
+
NicePatternSyn r fx n as p -> do
reportSLn "scope.pat" 10 $ "found nice pattern syn: " ++ show r
@@ -1241,12 +1263,12 @@ instance ToAbstract NiceDeclaration A.Declaration where
where
-- checking postulate or type sig. without checking safe flag
- toAbstractNiceAxiom funSig (C.Axiom r f p info x t) = do
+ toAbstractNiceAxiom funSig (C.Axiom r f p i info x t) = do
t' <- toAbstractCtx TopCtx t
y <- freshAbstractQName f x
info <- toAbstract info
bindName p DefName x y
- return [ A.Axiom funSig (mkDefInfo x f p ConcreteDef r) info y t' ]
+ return [ A.Axiom funSig (mkDefInfoInstance x f p ConcreteDef i r) info y t' ]
toAbstractNiceAxiom _ _ = __IMPOSSIBLE__
@@ -1272,20 +1294,27 @@ bindConstructorName m x f a p record = do
_ -> PublicAccess
instance ToAbstract ConstrDecl A.Declaration where
- toAbstract (ConstrDecl record m a p (C.Axiom r f _ info x t)) = do -- rel==Relevant
+ toAbstract (ConstrDecl record m a p (C.Axiom r f _ i info x t)) = do -- rel==Relevant
t' <- toAbstractCtx TopCtx t
-- The abstract name is the qualified one
-- Bind it twice, once unqualified and once qualified
y <- bindConstructorName m x f a p record
info <- toAbstract info
printScope "con" 15 "bound constructor"
- return $ A.Axiom NoFunSig (mkDefInfo x f p ConcreteDef r) info y t'
+ return $ A.Axiom NoFunSig (mkDefInfoInstance x f p ConcreteDef i r) info y t'
toAbstract _ = __IMPOSSIBLE__ -- a constructor is always an axiom
instance ToAbstract C.Pragma [A.Pragma] where
toAbstract (C.ImpossiblePragma _) = impossibleTest
toAbstract (C.OptionsPragma _ opts) = return [ A.OptionsPragma opts ]
+ toAbstract (C.RewritePragma _ x) = do
+ e <- toAbstract $ OldQName x
+ case e of
+ A.Def 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__
toAbstract (C.CompiledTypePragma _ x hs) = do
e <- toAbstract $ OldQName x
case e of
@@ -1341,8 +1370,8 @@ instance ToAbstract C.Pragma [A.Pragma] where
case e of
A.Def x -> return [ A.EtaPragma x ]
_ -> fail "Bad ETA pragma"
- -- NO_TERMINATION_CHECK is handled by the nicifier
- toAbstract (C.NoTerminationCheckPragma _) = __IMPOSSIBLE__
+ -- Termination checking pragmes are handled by the nicifier
+ toAbstract C.TerminationCheckPragma{} = __IMPOSSIBLE__
instance ToAbstract C.Clause A.Clause where
toAbstract (C.Clause top C.Ellipsis{} _ _ _) = fail "bad '...'" -- TODO: errors message
@@ -1549,6 +1578,20 @@ instance ToAbstract C.Pattern (A.Pattern' C.Expr) where
PatternSynPatName d -> return $ PatternSynP (PatRange (getRange p))
(anameName d) []
+ toAbstract (AppP (QuoteP _) p)
+ | IdentP x <- namedArg p,
+ getHiding p == NotHidden = do
+ e <- toAbstract (OldQName x)
+ let quoted (A.Def 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
+ quoted _ = typeError $ GenericError $ "quote: not a defined name"
+ A.LitP . LitQName (getRange x) <$> quoted e
+
+ toAbstract (QuoteP r) =
+ typeError $ GenericError "quote must be applied to an identifier"
+
toAbstract p0@(AppP p q) = do
(p', q') <- toAbstract (p,q)
case p' of
diff --git a/src/full/Agda/Syntax/Translation/InternalToAbstract.hs b/src/full/Agda/Syntax/Translation/InternalToAbstract.hs
index 9dd6e1b..db761a5 100644
--- a/src/full/Agda/Syntax/Translation/InternalToAbstract.hs
+++ b/src/full/Agda/Syntax/Translation/InternalToAbstract.hs
@@ -44,6 +44,7 @@ import Data.Traversable as Trav
import Agda.Syntax.Literal
import Agda.Syntax.Position
import Agda.Syntax.Common hiding (Arg, Dom, NamedArg, ArgInfo)
+import Agda.Syntax.Fixity
import qualified Agda.Syntax.Common as Common
import Agda.Syntax.Info as Info
import Agda.Syntax.Abstract as A
@@ -183,7 +184,8 @@ reifyDisplayFormP lhs@(A.SpineLHS i f ps wps) =
-- But apparently, it has no influence...
-- Ulf, can you add an explanation?
md <- liftTCM $ -- addContext (replicate (length ps) "x") $
- displayForm f vs
+ displayForm f vs `catchError` \_ -> return Nothing
+ -- unquoted extended lambdas use fake names, so catch errors here
reportSLn "reify.display" 20 $
"display form of " ++ show f ++ " " ++ show ps ++ " " ++ show wps ++ ":\n " ++ show md
case md of
@@ -299,9 +301,14 @@ instance Reify Term Expr where
reify v = reifyTerm True v
reifyTerm :: Bool -> Term -> TCM Expr
-reifyTerm expandAnonDefs v = do
+reifyTerm expandAnonDefs0 v = do
+ hasDisplayForms <- displayFormsEnabled
+ -- Ulf 2014-07-10: Don't expand anonymous when display forms are disabled
+ -- (i.e. when we don't care about nice printing)
+ let expandAnonDefs = expandAnonDefs0 && hasDisplayForms
v <- unSpine <$> instantiate v
case v of
+ _ | isHackReifyToMeta v -> return $ A.Underscore emptyMetaInfo
I.Var n es -> do
let vs = fromMaybe __IMPOSSIBLE__ $ allApplyElims es
x <- liftTCM $ nameOfBV n `catchError` \_ -> freshName_ ("@" ++ show n)
@@ -342,7 +349,10 @@ reifyTerm expandAnonDefs v = do
-- (see for example the parameter {i} to Data.Star.Star, which is also
-- the first argument to the cons).
-- @data Star {i}{I : Set i} ... where cons : {i : I} ...@
- if (np == 0) then apps h es else do
+ -- Ulf, 2014-07-19: Don't do any of this if we're reifying an
+ -- unquoted term (issue 1237).
+ unquote <- isReifyingUnquoted
+ if np == 0 || unquote then apps h es else do
-- Get name of first argument from type of constructor.
-- Here, we need the reducing version of @telView@
-- because target of constructor could be a definition
@@ -406,7 +416,9 @@ reifyTerm expandAnonDefs v = do
apps x' =<< reifyIArgs vs
I.DontCare v -> A.DontCare <$> reifyTerm expandAnonDefs v
I.Shared p -> reifyTerm expandAnonDefs $ derefPtr p
-
+ I.ExtLam cls args -> do
+ x <- freshName_ "extlam"
+ reifyExtLam (qnameFromList [x]) 0 cls (map (fmap unnamed) args)
where
-- Andreas, 2012-10-20 expand a copy in an anonymous module
-- to improve error messages.
@@ -487,19 +499,23 @@ reifyTerm expandAnonDefs v = do
Just defn -> case theDef defn of
Function{ funExtLam = Just (h, nh) } -> Just (h + nh)
_ -> Nothing
- if df && isJust extLam
- then do
- reportSLn "reify.def" 10 $ "reifying extended lambda with definition: x = " ++ show x
- info <- getConstInfo x
- --drop lambda lifted arguments
- cls <- mapM (reify . (QNamed x) . (dropArgs $ fromJust extLam)) $ defClauses info
- -- Karim: Currently Abs2Conc does not require a DefInfo thus we
- -- use __IMPOSSIBLE__.
- napps (A.ExtendedLam exprInfo __IMPOSSIBLE__ x cls) =<< reifyIArgs vs
- else do
+ case extLam of
+ Just pars | df -> do
+ info <- getConstInfo x
+ reifyExtLam x pars (defClauses info) vs
+ _ -> do
let apps = foldl' (\e a -> A.App exprInfo e (fmap unnamed a))
napps (A.Def x `apps` pad) =<< reifyIArgs vs
+ reifyExtLam :: QName -> Int -> [I.Clause] -> [I.NamedArg Term] -> TCM Expr
+ reifyExtLam x n cls vs = do
+ reportSLn "reify.def" 10 $ "reifying extended lambda with definition: x = " ++ show x
+ -- drop lambda lifted arguments
+ cls <- mapM (reify . QNamed x . dropArgs n) $ cls
+ let cx = nameConcrete $ qnameName x
+ dInfo = mkDefInfo cx defaultFixity' PublicAccess ConcreteDef (getRange x)
+ napps (A.ExtendedLam exprInfo dInfo x cls) =<< reifyIArgs vs
+
-- | @nameFirstIfHidden n (a1->...an->{x:a}->b) ({e} es) = {x = e} es@
nameFirstIfHidden :: [I.Dom (ArgName, t)] -> [I.Arg a] -> [I.NamedArg a]
nameFirstIfHidden _ [] = []
@@ -834,6 +850,7 @@ reifyPatterns tel perm ps = evalStateT (reifyArgs ps) 0
reifyPat :: I.Pattern -> StateT Nat TCM A.Pattern
reifyPat p = case p of
+ I.VarP "()" -> A.AbsurdP patNoRange <$ tick -- HACK
I.VarP s -> do
i <- tick
let j = translate i
@@ -853,7 +870,7 @@ instance Reify NamedClause A.Clause where
reify (QNamed f (I.Clause _ tel perm ps body _)) = addCtxTel tel $ do
ps <- reifyPatterns tel perm ps
lhs <- liftTCM $ reifyDisplayFormP $ SpineLHS info f ps [] -- LHS info (LHSHead f ps) []
- nfv <- getDefFreeVars f
+ nfv <- getDefFreeVars f `catchError` \_ -> return 0
lhs <- stripImps $ dropParams nfv lhs
reportSLn "reify.clause" 60 $ "reifying NamedClause, lhs = " ++ show lhs
rhs <- reify $ renameP (reverseP perm) <$> body
@@ -904,7 +921,7 @@ instance (Free i, Reify i a) => Reify (Abs i) (Name, a) where
s <- return $ if isUnderscore s && 0 `freeIn` v then "z" else s
x <- freshName_ s
- e <- addCtx x dummyDom -- type doesn't matter
+ e <- addContext x -- type doesn't matter
$ reify v
return (x,e)
diff --git a/src/full/Agda/Termination/CallGraph.hs b/src/full/Agda/Termination/CallGraph.hs
index b00c406..90e161d 100644
--- a/src/full/Agda/Termination/CallGraph.hs
+++ b/src/full/Agda/Termination/CallGraph.hs
@@ -1,7 +1,4 @@
{-# LANGUAGE CPP #-}
-{-# LANGUAGE DeriveFoldable #-}
-{-# LANGUAGE DeriveFunctor #-}
-{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ImplicitParams #-}
diff --git a/src/full/Agda/Termination/Inlining.hs b/src/full/Agda/Termination/Inlining.hs
index 3358a85..d7482e9 100644
--- a/src/full/Agda/Termination/Inlining.hs
+++ b/src/full/Agda/Termination/Inlining.hs
@@ -1,5 +1,4 @@
{-# LANGUAGE CPP #-}
-{-# LANGUAGE PatternGuards #-}
-- Author: Ulf Norell
-- Created: 2013-11-09
diff --git a/src/full/Agda/Termination/Monad.hs b/src/full/Agda/Termination/Monad.hs
index abf546a..f14e382 100644
--- a/src/full/Agda/Termination/Monad.hs
+++ b/src/full/Agda/Termination/Monad.hs
@@ -3,7 +3,6 @@
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeSynonymInstances #-}
-- | The monad for the termination checker.
@@ -77,6 +76,8 @@ data TerEnv = TerEnv
, terGuardingTypeConstructors :: Bool
-- ^ Do we assume that record and data type constructors
-- preserve guardedness?
+ , terInlineWithFunctions :: Bool
+ -- ^ Do we inline with functions to enhance termination checking of with?
, terSizeSuc :: Maybe QName
-- ^ The name of size successor, if any.
, terSharp :: Maybe QName
@@ -100,6 +101,10 @@ data TerEnv = TerEnv
-- Only the constructors of 'Target' are considered guarding.
, terDelayed :: Delayed
-- ^ Are we checking a delayed definition?
+ , terMaskArgs :: [Bool]
+ -- ^ Only consider the 'True' arguments for establishing termination.
+ , terMaskResult :: Bool
+ -- ^ Only consider guardedness if 'True'.
, terPatterns :: [DeBruijnPat]
-- ^ The patterns of the clause we are checking.
, terPatternsRaise :: !Int
@@ -135,6 +140,7 @@ defaultTerEnv :: TerEnv
defaultTerEnv = TerEnv
{ terUseDotPatterns = False -- must be False initially!
, terGuardingTypeConstructors = False
+ , terInlineWithFunctions = True
, terSizeSuc = Nothing
, terSharp = Nothing
, terCutOff = defaultCutOff
@@ -143,6 +149,8 @@ defaultTerEnv = TerEnv
, terCurrent = __IMPOSSIBLE__ -- needs to be set!
, terTarget = Nothing
, terDelayed = NotDelayed
+ , terMaskArgs = repeat True -- use all arguments
+ , terMaskResult = True -- use result
, terPatterns = __IMPOSSIBLE__ -- needs to be set!
, terPatternsRaise = 0
, terGuarded = le -- not initially guarded
@@ -197,6 +205,9 @@ instance MonadError TCErr TerM where
terGetGuardingTypeConstructors :: TerM Bool
terGetGuardingTypeConstructors = terAsks terGuardingTypeConstructors
+terGetInlineWithFunctions :: TerM Bool
+terGetInlineWithFunctions = terAsks terInlineWithFunctions
+
terGetUseDotPatterns :: TerM Bool
terGetUseDotPatterns = terAsks terUseDotPatterns
@@ -236,6 +247,18 @@ terGetDelayed = terAsks terDelayed
terSetDelayed :: Delayed -> TerM a -> TerM a
terSetDelayed b = terLocal $ \ e -> e { terDelayed = b }
+terGetMaskArgs :: TerM [Bool]
+terGetMaskArgs = terAsks terMaskArgs
+
+terSetMaskArgs :: [Bool] -> TerM a -> TerM a
+terSetMaskArgs b = terLocal $ \ e -> e { terMaskArgs = b }
+
+terGetMaskResult :: TerM Bool
+terGetMaskResult = terAsks terMaskResult
+
+terSetMaskResult :: Bool -> TerM a -> TerM a
+terSetMaskResult b = terLocal $ \ e -> e { terMaskResult = b }
+
terGetPatterns :: TerM DeBruijnPats
terGetPatterns = raiseDBP <$> terAsks terPatternsRaise <*> terAsks terPatterns
@@ -347,7 +370,7 @@ isCoinductiveProjection q = liftTCM $ do
Just Projection{ projProper = Just{}, projFromType = r, projIndex = n }
-> caseMaybeM (isRecord r) __IMPOSSIBLE__ $ \ rdef -> do
-- no for inductive or non-recursive record
- if recInduction rdef == Inductive then return False else do
+ if recInduction rdef /= Just CoInductive then return False else do
if not (recRecursive rdef) then return False else do
-- TODO: the following test for recursiveness of a projection should be cached.
-- E.g., it could be stored in the @Projection@ component.
diff --git a/src/full/Agda/Termination/TermCheck.hs b/src/full/Agda/Termination/TermCheck.hs
index b9967f6..de8099d 100644
--- a/src/full/Agda/Termination/TermCheck.hs
+++ b/src/full/Agda/Termination/TermCheck.hs
@@ -1,5 +1,4 @@
{-# LANGUAGE CPP #-}
-{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ImplicitParams #-}
@@ -136,6 +135,8 @@ termDecl' d = case d of
A.FunDef{} -> __IMPOSSIBLE__
A.DataSig{} -> __IMPOSSIBLE__
A.DataDef{} -> __IMPOSSIBLE__
+ -- This should have been expanded to a proper declaration before termination checking
+ A.UnquoteDecl{} -> __IMPOSSIBLE__
where
setScopeFromDefs = mapM_ setScopeFromDef
setScopeFromDef (A.ScopedDecl scope d) = setScope scope
@@ -185,10 +186,20 @@ termMutual i ds = if names == [] then return mempty else
skip = not <$> do
billTo [Benchmark.Termination, Benchmark.RecCheck] $ recursive allNames
- -- Skip termination check when asked by pragma or no recursion.
- ifM (return (not (Info.mutualTermCheck i)) `or2M` skip) (do
+ -- NO_TERMINATION_CHECK
+ if (Info.mutualTermCheck i == NoTerminationCheck) then do
reportSLn "term.warn.yes" 2 $ "Skipping termination check for " ++ show names
forM_ allNames $ \ q -> setTerminates q True -- considered terminating!
+ return mempty
+ -- NON_TERMINATING
+ else if (Info.mutualTermCheck i == NonTerminating) then do
+ reportSLn "term.warn.yes" 2 $ "Considering as non-terminating: " ++ show names
+ forM_ allNames $ \ q -> setTerminates q False
+ return mempty
+ -- Trivially terminating (non-recursive)
+ else ifM skip (do
+ reportSLn "term.warn.yes" 2 $ "Trivially terminating: " ++ show names
+ forM_ allNames $ \ q -> setTerminates q True
return mempty)
$ {- else -} do
@@ -208,8 +219,13 @@ termMutual i ds = if names == [] then return mempty else
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
@@ -412,18 +428,37 @@ termDef name = terSetCurrent name $ do
-- Retrieve definition
def <- liftTCM $ getConstInfo name
+ let t = defType def
liftTCM $ reportSDoc "term.def.fun" 5 $
sep [ text "termination checking body of" <+> prettyTCM name
- , nest 2 $ text ":" <+> (prettyTCM $ defType def)
+ , nest 2 $ text ":" <+> prettyTCM t
]
+ -- If --without-K, we disregard all arguments (and result)
+ -- which are not of data or record type.
+
+ withoutKEnabled <- liftTCM $ optWithoutK <$> pragmaOptions
+ applyWhen withoutKEnabled (setMasks t) $ do
+
+ -- If the result should be disregarded, set all calls to unguarded.
+ applyUnlessM terGetMaskResult terUnguarded $ do
+
case theDef def of
Function{ funClauses = cls, funDelayed = delayed } ->
terSetDelayed delayed $ forM' cls $ termClause
_ -> return CallGraph.empty
+-- | Mask arguments and result for termination checking
+-- according to type of function.
+-- Only arguments of data/record type 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
+ terSetMaskArgs (ds ++ repeat False) $ terSetMaskResult d $ cont
{- Termination check clauses:
@@ -497,26 +532,10 @@ stripCoConstructors p = do
LitDBP{} -> return p
ProjDBP{} -> return p
-stripNonDataArgs :: [DeBruijnPat] -> TerM [DeBruijnPat]
-stripNonDataArgs ps = do
- withoutKEnabled <- liftTCM $ optWithoutK <$> pragmaOptions
- if withoutKEnabled
- then do
- f <- terGetCurrent
- def <- liftTCM $ getConstInfo f
- ty <- liftTCM $ reduce $ defType def
- TelV tel _ <- liftTCM $ telView ty
- let types = map (unEl . snd . unDom) $ telToList tel
- zipWithM stripIfNotData ps types
- else return ps
- where
- stripIfNotData :: DeBruijnPat -> Term -> TerM DeBruijnPat
- stripIfNotData p ty = liftTCM $ do
- isData <- isDataOrRecord ty
- case isData of
- Just _ -> return p
- Nothing -> return unusedVar
-
+-- | 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
-- | cf. 'TypeChecking.Coverage.Match.buildMPatterns'
openClause :: Permutation -> [Pattern] -> ClauseBody -> TerM ([DeBruijnPat], Maybe Term)
@@ -546,10 +565,7 @@ openClause perm ps body = do
-- | Extract recursive calls from one clause.
termClause :: Clause -> TerM Calls
termClause clause = do
- withoutKEnabled <- liftTCM $ optWithoutK <$> pragmaOptions
- if withoutKEnabled
- then termClause' clause
- else do
+ ifNotM (terGetInlineWithFunctions) (termClause' clause) $ {- else -} do
name <- terGetCurrent
ifM (isJust <$> do isWithFunction name) (return mempty) $ do
mapM' termClause' =<< do liftTCM $ inlineWithClauses name clause
@@ -574,7 +590,7 @@ termClause' clause = do
Nothing -> return CallGraph.empty
Just v -> do
dbpats <- mapM stripCoConstructors dbpats
- dbpats <- stripNonDataArgs dbpats
+ dbpats <- maskNonDataArgs dbpats
terSetPatterns dbpats $ do
reportBody v
{-
@@ -683,7 +699,7 @@ instance ExtractCalls Sort where
case s of
Prop -> return CallGraph.empty
Inf -> return CallGraph.empty
- Type t -> terSetGuarded Order.unknown $ extract t -- no guarded levels
+ Type t -> terUnguarded $ extract t -- no guarded levels
DLub s1 s2 -> extract (s1, s2)
-- | Extract recursive calls from a type.
@@ -773,7 +789,7 @@ withFunction g es = do
-- | Handles function applications @g es at .
function :: QName -> Elims -> TerM Calls
-function g es = ifJustM (isWithFunction g) (\ _ -> withFunction g es)
+function g es = ifM (terGetInlineWithFunctions `and2M` do isJust <$> isWithFunction g) (withFunction g es)
$ {-else, no with function-} do
f <- terGetCurrent
@@ -863,8 +879,8 @@ function g es = ifJustM (isWithFunction g) (\ _ -> withFunction g es)
, callInfoCall = doc
}]
liftTCM $ reportSDoc "term.kept.call" 5 $ vcat
- [ text "kept call from" <+> prettyTCM f <+> hsep (map prettyTCM pats)
- , nest 2 $ text "to" <+> prettyTCM g <+>
+ [ text "kept call from" <+> text (show f) <+> hsep (map prettyTCM pats)
+ , nest 2 $ text "to" <+> text (show g) <+>
hsep (map (parens . prettyTCM) args)
, nest 2 $ text "call matrix (with guardedness): "
, nest 2 $ pretty cm
@@ -897,7 +913,7 @@ instance ExtractCalls Term where
Nothing -> return Inductive
Just (q, def) -> (\ b -> if b then CoInductive else Inductive) <$>
andM [ return $ recRecursive def
- , return $ recInduction def == CoInductive
+ , return $ recInduction def == Just CoInductive
, targetElem (q : recMutual def)
]
constructor c ind argsg
@@ -940,6 +956,7 @@ instance ExtractCalls Term where
extract l
Shared{} -> __IMPOSSIBLE__
+ ExtLam{} -> __IMPOSSIBLE__
-- | Extract recursive calls from level expressions.
@@ -1287,4 +1304,3 @@ compareVarVar i j
case res of
BoundedNo -> return Order.unknown
BoundedLt v -> decrease 1 <$> compareTerm' v (VarDBP j)
-
diff --git a/src/full/Agda/TypeChecking/Abstract.hs b/src/full/Agda/TypeChecking/Abstract.hs
index e626f89..111bda5 100644
--- a/src/full/Agda/TypeChecking/Abstract.hs
+++ b/src/full/Agda/TypeChecking/Abstract.hs
@@ -1,4 +1,4 @@
--- {-# LANGUAGE CPP #-}
+{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE TypeSynonymInstances #-}
@@ -16,6 +16,9 @@ import Agda.Syntax.Internal
import Agda.TypeChecking.Substitute
import Agda.Utils.List (splitExactlyAt)
+import Agda.Utils.Impossible
+
+#include "../undefined.h"
piAbstractTerm :: Term -> Type -> Type -> Type
piAbstractTerm v a b = fun a (abstractTerm v b)
@@ -69,6 +72,7 @@ instance AbstractTerm Term where
MetaV m vs -> MetaV m $ absT vs
DontCare mv -> DontCare $ absT mv
Shared p -> Shared $ absT p
+ ExtLam{} -> __IMPOSSIBLE__
where
absT x = abstractTerm u x
diff --git a/src/full/Agda/TypeChecking/CheckInternal.hs b/src/full/Agda/TypeChecking/CheckInternal.hs
index bd29246..7c4f66b 100644
--- a/src/full/Agda/TypeChecking/CheckInternal.hs
+++ b/src/full/Agda/TypeChecking/CheckInternal.hs
@@ -1,6 +1,5 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE TypeSynonymInstances #-}
-- Initially authored by Andreas, 2013-10-22.
@@ -141,6 +140,7 @@ checkInternal v t = do
levelType >>= (`subtype` t)
DontCare v -> checkInternal v t
Shared{} -> __IMPOSSIBLE__
+ ExtLam{} -> __IMPOSSIBLE__
{- RETIRED, works also when elimView has not been called before.
-- | Check function application.
diff --git a/src/full/Agda/TypeChecking/CompiledClause/Compile.hs b/src/full/Agda/TypeChecking/CompiledClause/Compile.hs
index cd664d4..a127b01 100644
--- a/src/full/Agda/TypeChecking/CompiledClause/Compile.hs
+++ b/src/full/Agda/TypeChecking/CompiledClause/Compile.hs
@@ -2,6 +2,7 @@
module Agda.TypeChecking.CompiledClause.Compile where
+import Data.Maybe
import Data.Monoid
import qualified Data.Map as Map
import Data.List (genericReplicate, nubBy, findIndex)
@@ -17,6 +18,7 @@ import Agda.TypeChecking.RecordPatterns
import Agda.TypeChecking.Substitute
import Agda.TypeChecking.Pretty
+import Agda.Utils.Functor
import Agda.Utils.List
#include "../../undefined.h"
@@ -38,14 +40,6 @@ compileClauses mt cs = do
Nothing -> return $ compile cls
Just (q, t) -> do
splitTree <- coverageCheck q t cs
- {-
- splitTree <- translateSplitTree splitTree
- reportSDoc "tc.cc.splittree" 10 $ vcat
- [ text "translated split tree for" <+> prettyTCM q
- , text $ show splitTree
- ]
- -}
- -- cs <- mapM translateRecordPatterns cs
reportSDoc "tc.cc" 30 $ sep $ do
(text "clauses patterns before compilation") : do
@@ -53,7 +47,7 @@ compileClauses mt cs = do
reportSDoc "tc.cc" 50 $ do
sep [ text "clauses before compilation"
, (nest 2 . text . show) cs
- ] -- ++ map (nest 2 . text . show) cs
+ ]
let cc = compileWithSplitTree splitTree cls
reportSDoc "tc.cc" 12 $ sep
[ text "compiled clauses (still containing record splits)"
@@ -104,7 +98,7 @@ compileWithSplitTree t cs = case t of
compile :: Cls -> CompiledClauses
compile cs = case nextSplit cs of
Just n -> Case n $ fmap compile $ splitOn False n cs
- Nothing -> case map getBody cs of
+ Nothing -> case map (getBody . snd) cs of
-- It's possible to get more than one clause here due to
-- catch-all expansion.
Just t : _ -> Done (map (fmap name) $ fst $ head cs) (shared t)
@@ -116,23 +110,20 @@ compile cs = case nextSplit cs of
name ConP{} = __IMPOSSIBLE__
name LitP{} = __IMPOSSIBLE__
name ProjP{} = __IMPOSSIBLE__
- getBody (_, b) = body b
- body (Bind b) = body (absBody b)
- body (Body t) = Just t
- body NoBody = Nothing
-- | Get the index of the next argument we need to split on.
-- This the number of the first pattern that does a match in the first clause.
nextSplit :: Cls -> Maybe Int
nextSplit [] = __IMPOSSIBLE__
-nextSplit ((ps, _):_) = findIndex isPat $ map unArg ps
- -- OLD, IDENTICAL: mhead [ n | (a, n) <- zip ps [0..], isPat (unArg a) ]
- where
- isPat VarP{} = False
- isPat DotP{} = False
- isPat ConP{} = True
- isPat LitP{} = True
- isPat ProjP{} = True
+nextSplit ((ps, _):_) = findIndex (not . isVar . unArg) ps
+
+-- | Is this a variable pattern?
+isVar :: Pattern -> Bool
+isVar VarP{} = True
+isVar DotP{} = True
+isVar ConP{} = False
+isVar LitP{} = False
+isVar ProjP{} = False
-- | @splitOn single n cs@ will force expansion of catch-alls
-- if @single at .
@@ -172,10 +163,6 @@ expandCatchAlls single n cs =
-- we force expansion
if single then doExpand =<< cs else
case cs of
-{-
- _ | all (isCatchAll . nth . fst) cs -> cs
- (ps, b) : cs | not (isCatchAll (nth ps)) -> (ps, b) : expandCatchAlls False n cs
--}
_ | all (isCatchAllNth . fst) cs -> cs
(ps, b) : cs | not (isCatchAllNth ps) -> (ps, b) : expandCatchAlls False n cs
| otherwise -> map (expand ps b) expansions ++ (ps, b) : expandCatchAlls False n cs
@@ -186,24 +173,13 @@ expandCatchAlls single n cs =
-- The @expansions@ are collected from all the clauses @cs@ then.
-- Note: @expansions@ could be empty, so we keep the orignal clause.
doExpand c@(ps, b)
- | isCatchAll (nth ps) = map (expand ps b) expansions ++ [c]
- | otherwise = [c]
-
- isCatchAllNth ps =
- case map unArg $ drop n ps of
- (ConP {} : _) -> False
- (LitP {} : _) -> False
- (ProjP{} : _) -> False
- (VarP{} : _) -> True
- (DotP{} : _) -> True
- [] -> True -- ?? is that right
-
- isCatchAll (Arg _ ConP{}) = False
- isCatchAll (Arg _ LitP{}) = False
- isCatchAll (Arg _ ProjP{}) = False
- isCatchAll _ = True
- nth qs = maybe __IMPOSSIBLE__ id $ mhead $ drop n qs
- -- where (_, p, _) = extractNthElement' n qs
+ | isVar $ unArg $ nth ps = map (expand ps b) expansions ++ [c]
+ | otherwise = [c]
+
+ -- 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
classify (LitP l) = Left l
classify (ConP c _ _) = Right c
@@ -211,20 +187,23 @@ expandCatchAlls single n cs =
-- All non-catch-all patterns following this one (at position n).
-- These are the cases the wildcard needs to be expanded into.
- expansions = nubBy ((==) `on` classify)
- . map unArg
- . filter (not . isCatchAll)
- . map (nth . fst) $ cs
+ expansions = nubBy ((==) `on` (classify . unArg))
+ . filter (not . isVar . unArg)
+ . map (nth . fst)
+ $ cs
expand ps b q =
- case q of
- ConP c _ qs' -> (ps0 ++ [defaultArg $ ConP c Nothing (genericReplicate m $ defaultArg $ unnamed $ VarP underscore)] ++ ps1,
- substBody n' m (Con c (map var [m - 1, m - 2..0])) b)
- where m = length qs'
- LitP l -> (ps0 ++ [defaultArg $ LitP l] ++ ps1, substBody n' 0 (Lit l) b)
+ case unArg q of
+ ConP c mt qs' -> (ps0 ++ [q $> ConP c mt conPArgs] ++ ps1,
+ substBody n' m (Con c conArgs) b)
+ where
+ m = length qs'
+ -- replace all direct subpatterns of q by _
+ conPArgs = map (fmap ($> VarP underscore)) qs'
+ conArgs = zipWith (\ q n -> q $> var n) qs' $ downFrom m
+ LitP l -> (ps0 ++ [q $> LitP l] ++ ps1, substBody n' 0 (Lit l) b)
_ -> __IMPOSSIBLE__
where
- -- (ps0, _, ps1) = extractNthElement' n ps
(ps0, rest) = splitAt n ps
ps1 = maybe __IMPOSSIBLE__ snd $ uncons rest
@@ -235,8 +214,6 @@ expandCatchAlls single n cs =
count DotP{} = 1 -- dot patterns are treated as variables in the clauses
count _ = 0
- var x = defaultArg $ Var x []
-
substBody :: Int -> Int -> Term -> ClauseBody -> ClauseBody
substBody _ _ _ NoBody = NoBody
substBody 0 m v b = case b of
diff --git a/src/full/Agda/TypeChecking/CompiledClause/Match.hs b/src/full/Agda/TypeChecking/CompiledClause/Match.hs
index 1c40045..f40d849 100644
--- a/src/full/Agda/TypeChecking/CompiledClause/Match.hs
+++ b/src/full/Agda/TypeChecking/CompiledClause/Match.hs
@@ -1,5 +1,4 @@
{-# LANGUAGE CPP #-}
-{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Agda.TypeChecking.CompiledClause.Match where
diff --git a/src/full/Agda/TypeChecking/Conversion.hs b/src/full/Agda/TypeChecking/Conversion.hs
index ac497c2..b206338 100644
--- a/src/full/Agda/TypeChecking/Conversion.hs
+++ b/src/full/Agda/TypeChecking/Conversion.hs
@@ -45,10 +45,11 @@ import Agda.TypeChecking.ProjectionLike (elimView)
import Agda.Interaction.Options
-import Agda.Utils.Size
import Agda.Utils.Functor (($>))
import Agda.Utils.Monad
import Agda.Utils.Maybe
+import Agda.Utils.Size
+import Agda.Utils.Tuple
#include "../undefined.h"
import Agda.Utils.Impossible
@@ -392,8 +393,10 @@ compareAtom cmp t m n =
, text ":" <+> prettyTCM t ]
-- Andreas: what happens if I cut out the eta expansion here?
-- Answer: Triggers issue 245, does not resolve 348
- mb' <- etaExpandBlocked =<< reduceB m
- nb' <- etaExpandBlocked =<< reduceB n
+ (mb',nb') <- ifM (asks envCompareBlocked) ((NotBlocked -*- NotBlocked) <$> reduce (m,n)) $ do
+ mb' <- etaExpandBlocked =<< reduceB m
+ nb' <- etaExpandBlocked =<< reduceB n
+ return (mb', nb')
-- constructorForm changes literal to constructors
-- only needed if the other side is not a literal
diff --git a/src/full/Agda/TypeChecking/Datatypes.hs b/src/full/Agda/TypeChecking/Datatypes.hs
index 6451483..75bcd20 100644
--- a/src/full/Agda/TypeChecking/Datatypes.hs
+++ b/src/full/Agda/TypeChecking/Datatypes.hs
@@ -7,6 +7,7 @@ import Control.Applicative ((<$>))
import Data.Maybe (fromMaybe)
import Agda.Syntax.Common
+import Agda.Syntax.Position
import Agda.Syntax.Internal as I
import Agda.TypeChecking.Monad
diff --git a/src/full/Agda/TypeChecking/DropArgs.hs b/src/full/Agda/TypeChecking/DropArgs.hs
index 17c820f..ead5577 100644
--- a/src/full/Agda/TypeChecking/DropArgs.hs
+++ b/src/full/Agda/TypeChecking/DropArgs.hs
@@ -1,6 +1,5 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE TypeSynonymInstances #-}
module Agda.TypeChecking.DropArgs where
diff --git a/src/full/Agda/TypeChecking/Errors.hs b/src/full/Agda/TypeChecking/Errors.hs
index 7e6f26d..62a03e9 100644
--- a/src/full/Agda/TypeChecking/Errors.hs
+++ b/src/full/Agda/TypeChecking/Errors.hs
@@ -11,6 +11,8 @@ module Agda.TypeChecking.Errors
, warningsToError
) where
+import Prelude hiding (null)
+
import Control.Monad.State
import Control.Monad.Error
@@ -40,7 +42,9 @@ import Agda.TypeChecking.Pretty
import Agda.TypeChecking.Reduce (instantiate)
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"
@@ -52,15 +56,17 @@ import Agda.Utils.Impossible
{-# SPECIALIZE prettyError :: TCErr -> TCM String #-}
prettyError :: MonadTCM tcm => TCErr -> tcm String
-prettyError err = liftTCM $ liftM show $
- prettyTCM err
- `catchError` \err' -> text "panic: error when printing error!" $$ prettyTCM err'
- `catchError` \err'' -> text "much panic: error when printing error from printing error!" $$ prettyTCM err''
- `catchError` \err''' -> fsep (
+prettyError err = liftTCM $ show <$> prettyError' err []
+ where
+ 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:" )
- $$ vcat (map (text . tcErrString) [err,err',err'',err'''])
-
+ 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)
---------------------------------------------------------------------------
-- * Warnings
---------------------------------------------------------------------------
@@ -70,7 +76,7 @@ prettyError err = liftTCM $ liftM show $
-- Invariant: The fields are never empty at the same time.
data Warnings = Warnings
- { terminationProblems :: [TerminationError]
+ { terminationProblems :: Maybe TCErr
-- ^ Termination checking problems are not reported if
-- 'optTerminationCheck' is 'False'.
, unsolvedMetaVariables :: [Range]
@@ -81,20 +87,20 @@ data Warnings = Warnings
}
-- | Turns warnings into an error. Even if several errors are possible
--- only one is raised.
-
-warningsToError :: Warnings -> TypeError
-warningsToError (Warnings [] [] []) = __IMPOSSIBLE__
-warningsToError (Warnings _ w@(_:_) _) = UnsolvedMetas w
-warningsToError (Warnings _ _ w@(_:_)) = UnsolvedConstraints w
-warningsToError (Warnings w@(_:_) _ _) = TerminationCheckFailed w
+-- 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
---------------------------------------------------------------------------
-- * Helpers
---------------------------------------------------------------------------
sayWhere :: HasRange a => a -> TCM Doc -> TCM Doc
-sayWhere x d = prettyTCM (getRange x) $$ d
+sayWhere x d = applyUnless (null r) (prettyTCM r $$) d
+ where r = getRange x
sayWhen :: Range -> Maybe (Closure Call) -> TCM Doc -> TCM Doc
sayWhen r Nothing m = sayWhere r m
diff --git a/src/full/Agda/TypeChecking/EtaContract.hs b/src/full/Agda/TypeChecking/EtaContract.hs
index 554eef3..684d044 100644
--- a/src/full/Agda/TypeChecking/EtaContract.hs
+++ b/src/full/Agda/TypeChecking/EtaContract.hs
@@ -45,6 +45,7 @@ binAppView t = case t of
Sort _ -> noApp
MetaV _ _ -> noApp
DontCare _ -> noApp
+ ExtLam _ _ -> __IMPOSSIBLE__
Shared p -> binAppView (derefPtr p) -- destroys sharing
where
noApp = NoApp t
diff --git a/src/full/Agda/TypeChecking/Free.hs b/src/full/Agda/TypeChecking/Free.hs
index 0ee844f..19e87e0 100644
--- a/src/full/Agda/TypeChecking/Free.hs
+++ b/src/full/Agda/TypeChecking/Free.hs
@@ -1,4 +1,4 @@
--- {-# LANGUAGE CPP #-}
+{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeSynonymInstances #-}
@@ -24,6 +24,9 @@ import Agda.Utils.VarSet (VarSet)
import Agda.Syntax.Common hiding (Arg, Dom, NamedArg)
import Agda.Syntax.Internal
+import Agda.Utils.Impossible
+#include "../undefined.h"
+
-- | The distinction between rigid and strongly rigid occurrences comes from:
-- Jason C. Reed, PhD thesis, 2009, page 96 (see also his LFMTP 2009 paper)
--
@@ -162,6 +165,7 @@ instance Free Term where
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)
instance Free Type where
freeVars' conf (El s t)
@@ -228,6 +232,9 @@ instance Free ClauseBody where
freeVars' conf (Bind b) = freeVars' conf b
freeVars' conf NoBody = empty
+instance Free Clause where
+ freeVars' conf = freeVars' conf . clauseBody
+
freeIn :: Free a => Nat -> a -> Bool
freeIn v t = v `Set.member` allVars (freeVars t)
diff --git a/src/full/Agda/TypeChecking/Implicit.hs b/src/full/Agda/TypeChecking/Implicit.hs
index 91036a2..ca79598 100644
--- a/src/full/Agda/TypeChecking/Implicit.hs
+++ b/src/full/Agda/TypeChecking/Implicit.hs
@@ -18,6 +18,7 @@ import Agda.TypeChecking.Monad
import Agda.TypeChecking.Reduce
import Agda.TypeChecking.Substitute
import {-# SOURCE #-} Agda.TypeChecking.InstanceArguments
+import Agda.TypeChecking.Pretty
import Agda.Utils.Tuple
@@ -40,8 +41,8 @@ implicitNamedArgs n expand t0 = do
t0' <- reduce t0
case ignoreSharing $ unEl t0' of
Pi (Dom info a) b | let x = absName b, expand (getHiding info) x -> do
- when (getHiding info == Instance) $ reportSLn "tc.term.args.ifs" 15 $
- "inserting instance meta for type " ++ show a
+ when (getHiding info == Instance) $ reportSDoc "tc.term.args.ifs" 15 $
+ text "inserting instance meta for type" <+> prettyTCM a
v <- applyRelevanceToContext (getRelevance info) $
newMeta (getHiding info) (argNameToString x) a
let narg = Arg info (Named (Just $ unranged x) v)
diff --git a/src/full/Agda/TypeChecking/Injectivity.hs b/src/full/Agda/TypeChecking/Injectivity.hs
index b58ea17..9ed5710 100644
--- a/src/full/Agda/TypeChecking/Injectivity.hs
+++ b/src/full/Agda/TypeChecking/Injectivity.hs
@@ -1,12 +1,15 @@
{-# LANGUAGE CPP #-}
+{-# LANGUAGE TupleSections #-}
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)
+
import Data.Map (Map)
import qualified Data.Map as Map
import qualified Data.Set as Set
@@ -15,6 +18,7 @@ import Data.Traversable hiding (for)
import Agda.Syntax.Common
import Agda.Syntax.Internal
+
import Agda.TypeChecking.Monad
import Agda.TypeChecking.Substitute
import Agda.TypeChecking.Reduce
@@ -24,8 +28,9 @@ import {-# SOURCE #-} Agda.TypeChecking.Conversion
import Agda.TypeChecking.Pretty
import Agda.TypeChecking.Constraints
import Agda.TypeChecking.Polarity
+
import Agda.Utils.List
-import Agda.Utils.Functor (for)
+import Agda.Utils.Functor
import Agda.Utils.Permutation
#include "../undefined.h"
@@ -68,6 +73,7 @@ headSymbol v = do -- ignoreAbstractMode $ do
MetaV{} -> return Nothing
DontCare{} -> return Nothing
Shared{} -> __IMPOSSIBLE__
+ ExtLam{} -> __IMPOSSIBLE__
checkInjectivity :: QName -> [Clause] -> TCM FunctionInverse
checkInjectivity f cs
@@ -87,9 +93,7 @@ checkInjectivity f cs = do
-- Extract the head symbol of the rhs of each clause (skip absurd clauses)
es <- catMaybes <$> do
forM cs $ \ c -> do -- produces a list ...
- forM (getBody c) $ \ v -> do -- ... of maybes
- h <- headSymbol v
- return (h, c)
+ mapM ((,c) <.> headSymbol) $ getBodyUnraised c -- ... of maybes
let (hs, ps) = unzip es
reportSLn "tc.inj.check" 40 $ " right hand sides: " ++ show hs
if all isJust hs && distinct hs
diff --git a/src/full/Agda/TypeChecking/InstanceArguments.hs b/src/full/Agda/TypeChecking/InstanceArguments.hs
index cb7a1b1..6ee28dd 100644
--- a/src/full/Agda/TypeChecking/InstanceArguments.hs
+++ b/src/full/Agda/TypeChecking/InstanceArguments.hs
@@ -19,6 +19,7 @@ import Agda.TypeChecking.Monad
import Agda.TypeChecking.Pretty
import Agda.TypeChecking.Substitute
import Agda.TypeChecking.Reduce
+import Agda.TypeChecking.Telescope
import {-# SOURCE #-} Agda.TypeChecking.Constraints
import {-# SOURCE #-} Agda.TypeChecking.Rules.Term (checkArguments)
@@ -32,13 +33,22 @@ import Agda.Utils.Monad
import Agda.Utils.Impossible
-- | A candidate solution for an instance meta is a term with its type.
-type Candidates = [(Term, Type)]
+type Candidate = (Term, Type)
+type Candidates = [Candidate]
-initialIFSCandidates :: TCM Candidates
-initialIFSCandidates = do
+-- | Compute a list of instance candidates.
+-- 'Nothing' if type is a meta, error if type is not eligible
+-- for instance search.
+initialIFSCandidates :: Type -> TCM (Maybe Candidates)
+initialIFSCandidates t = do
cands1 <- getContextVars
- cands2 <- getScopeDefs
- return $ cands1 ++ cands2
+ otn <- getOutputTypeName t
+ case otn of
+ NoOutputTypeName -> typeError $ GenericError $ "Instance search can only be used to find elements in a named type"
+ OutputTypeNameNotYetKnown -> return Nothing
+ OutputTypeName n -> do
+ cands2 <- getScopeDefs n
+ return $ Just $ cands1 ++ cands2
where
-- get a list of variables with their type, relative to current context
getContextVars :: TCM Candidates
@@ -57,19 +67,14 @@ initialIFSCandidates = do
]
return $ vars ++ lets
- getScopeDefs :: TCM Candidates
- getScopeDefs = do
- scopeInfo <- gets stScope
- let ns = everythingInScope scopeInfo
- let nsList = Map.toList $ nsNames ns
- -- all abstract names in scope are candidates
- -- (even ones that you can't refer to unambiguously)
- let qs = List.map anameName $ snd =<< nsList
- rel <- asks envRelevance
- cands <- mapM (candidate rel) qs
- return $ concat cands
+ getScopeDefs :: QName -> TCM Candidates
+ getScopeDefs n = do
+ instanceDefs <- getInstanceDefs
+ rel <- asks envRelevance
+ let qs = fromMaybe [] $ Map.lookup n instanceDefs
+ catMaybes <$> mapM (candidate rel) qs
- candidate :: Relevance -> QName -> TCM Candidates
+ candidate :: Relevance -> QName -> TCM (Maybe Candidate)
candidate rel q =
-- Andreas, 2012-07-07:
-- we try to get the info for q
@@ -78,25 +83,29 @@ initialIFSCandidates = do
flip catchError handle $ do
def <- getConstInfo q
let r = defRelevance def
- if not (r `moreRelevant` rel) then return [] else do
+ if not (r `moreRelevant` rel) then return Nothing else do
t <- defType <$> instantiateDef def
args <- freeVarsToApply q
let v = case theDef def of
-- drop parameters if it's a projection function...
- Function{ funProjection = Just p } -> Def q $ map Apply $ genericDrop (projIndex p - 1) args
- Constructor{} -> Con (ConHead q []) []
+ Function{ funProjection = Just p } -> projDropPars p `apply` args
+ -- Andreas, 2014-08-19: constructors cannot be declared as
+ -- instances (at least as of now).
+ -- I do not understand why the Constructor case is not impossible.
+ -- Ulf, 2014-08-20: constructors are always instances.
+ Constructor{ conSrcCon = c } -> Con c []
_ -> Def q $ map Apply args
- return [(v, t)]
+ return $ Just (v, t)
where
-- unbound constant throws an internal error
- handle (TypeError _ (Closure {clValue = InternalError _})) = return []
+ handle (TypeError _ (Closure {clValue = InternalError _})) = return Nothing
handle err = throwError err
-- | @initializeIFSMeta s t@ generates an instance meta of type @t@
-- with suggested name @s at .
initializeIFSMeta :: String -> Type -> TCM Term
initializeIFSMeta s t = do
- cands <- initialIFSCandidates
+ cands <- initialIFSCandidates t
newIFSMeta s t cands
-- | @findInScope m (v,a)s@ tries to instantiate on of the types @a at s
@@ -104,8 +113,18 @@ initializeIFSMeta s t = do
-- If successful, meta @m@ is solved with the instantiation of @v at .
-- If unsuccessful, the constraint is regenerated, with possibly reduced
-- candidate set.
-findInScope :: MetaId -> Candidates -> TCM ()
-findInScope m cands = whenJustM (findInScope' m cands) $ addConstraint . FindInScope m
+-- The list of candidates is equal to @Nothing@ when the type of the meta
+-- wasn't known when the constraint was generated. In that case, try to find
+-- 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."
+ t <- getMetaType m
+ cands <- initialIFSCandidates t
+ case cands of
+ Nothing -> addConstraint $ FindInScope m Nothing
+ Just {} -> findInScope m cands
+findInScope m (Just cands) = whenJustM (findInScope' m cands) $ addConstraint . FindInScope m . Just
-- | Result says whether we need to add constraint, and if so, the set of
-- remaining candidates.
@@ -114,27 +133,44 @@ 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
- reportSDoc "tc.constr.findInScope" 15 $ text ("findInScope 2: constraint: " ++ show m ++ "; candidates left: " ++ show (length cands))
+ reportSLn "tc.constr.findInScope" 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
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.
+ -- Metas that are rigidly constrained need not be frozen.
+ isRec <- orM $ map (isRecursive . unEl . snd) cands
+ let shouldFreeze rigid m
+ | elem m rigid = return False
+ | otherwise = not <$> isFrozen m
+ metas <- if not isRec then return [] else do
+ rigid <- rigidlyConstrainedMetas
+ filterM (shouldFreeze rigid) (allMetas t)
+ forM_ metas $ \ m -> updateMetaVar m $ \ mv -> mv { mvFrozen = Frozen }
cands <- checkCandidates m t cands
- reportSLn "tc.constr.findInScope" 15 $ "findInScope 4: cands left: " ++ show (length cands)
+ reportSLn "tc.constr.findInScope" 15 $
+ "findInScope 4: cands left: " ++ show (length cands)
+ unfreezeMeta metas
case cands of
[] -> do
- reportSDoc "tc.constr.findInScope" 15 $ text "findInScope 5: not a single candidate found..."
+ reportSDoc "tc.constr.findInScope" 15 $
+ text "findInScope 5: not a single candidate found..."
typeError $ IFSNoCandidateInScope t
[(term, t')] -> do
- reportSDoc "tc.constr.findInScope" 15 $ text (
- "findInScope 5: one candidate found for type '") <+>
- prettyTCM t <+> text "': '" <+> prettyTCM term <+>
- text "', of type '" <+> prettyTCM t' <+> text "'."
+ reportSDoc "tc.constr.findInScope" 15 $ vcat
+ [ text "findInScope 5: found one candidate"
+ , nest 2 $ prettyTCM term
+ , text "of type " <+> prettyTCM t'
+ , text "for type" <+> prettyTCM t
+ ]
-- if t' takes initial hidden arguments, apply them
- ca <- liftTCM $ runErrorT $ checkArguments ExpandLast DontExpandInstanceArguments (getRange mv) [] t' t
+ ca <- liftTCM $ runErrorT $ checkArguments ExpandLast ExpandInstanceArguments (getRange mv) [] t' t
case ca of
Left _ -> __IMPOSSIBLE__
Right (args, t'') -> do
@@ -147,9 +183,10 @@ 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 $
- text "solved by instance search:" <+> prettyTCM m
- <+> text ":=" <+> prettyTCM v
+ reportSDoc "tc.constr.findInScope" 10 $ vcat
+ [ text "solved by instance search:"
+ , prettyTCM m <+> text ":=" <+> prettyTCM v
+ ]
return Nothing
cs -> do
@@ -157,13 +194,61 @@ findInScope' m cands = ifM (isFrozen m) (return (Just cands)) $ do
text ("findInScope 5: more than one candidate found: ") <+>
prettyTCM (List.map fst cs)
return (Just cs)
+ where
+ -- | Check whether a type is a function type with an instance domain.
+ isRecursive :: Term -> TCM Bool
+ isRecursive v = do
+ v <- reduce v
+ case ignoreSharing v of
+ Pi (Dom info _) t ->
+ if getHiding info == Instance then return True else
+ isRecursive $ unEl $ unAbs t
+ _ -> return False
+
+-- | A meta _M is rigidly constrained if there is a constraint _M us == D vs,
+-- for inert D. Such metas can safely be instantiated by recursive instance
+-- search, since the constraint limits the solution space.
+rigidlyConstrainedMetas :: TCM [MetaId]
+rigidlyConstrainedMetas = do
+ cs <- (++) <$> gets stSleepingConstraints <*> gets stAwakeConstraints
+ catMaybes <$> mapM rigidMetas cs
+ where
+ isRigid v =
+ case v of
+ Def f _ -> return True
+ -- def <- getConstInfo f
+ -- case theDef def of
+ -- Record{} -> return True
+ -- Datatype{} -> return True
+ -- Axiom{} -> return True
+ -- _
+ Con{} -> return True
+ Lit{} -> return True
+ Var{} -> return True
+ _ -> return False
+ rigidMetas c =
+ case clValue $ theConstraint c of
+ ValueCmp _ _ u v ->
+ case (u, v) of
+ (MetaV m _, _) -> ifM (isRigid v) (return $ Just m) (return Nothing)
+ (_, MetaV m _) -> ifM (isRigid u) (return $ Just m) (return Nothing)
+ _ -> return Nothing
+ ElimCmp{} -> return Nothing
+ TypeCmp{} -> return Nothing
+ TelCmp{} -> return Nothing
+ SortCmp{} -> return Nothing
+ LevelCmp{} -> return Nothing
+ UnBlock{} -> return Nothing
+ Guarded{} -> return Nothing -- don't look inside Guarded, since the inner constraint might not fire
+ IsEmpty{} -> return Nothing
+ FindInScope{} -> return Nothing
-- | Given a meta @m@ of type @t@ and a list of candidates @cands@,
-- @checkCandidates m t cands@ returns a refined list of valid candidates.
checkCandidates :: MetaId -> Type -> Candidates -> TCM Candidates
checkCandidates m t cands = localTCState $ disableDestructiveUpdate $ do
-- for candidate checking, we don't take into account other IFS
- -- constrains
+ -- constraints
dropConstraints (isIFSConstraint . clValue . theConstraint)
cands <- filterM (uncurry $ checkCandidateForMeta m t) cands
-- Drop all candidates which are equal to the first one
@@ -183,7 +268,7 @@ 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 DontExpandInstanceArguments noRange [] t' t
+ ca <- runErrorT $ checkArguments ExpandLast ExpandInstanceArguments noRange [] t' t
case ca of
Left _ -> return False
Right (args, t'') -> do
@@ -195,9 +280,10 @@ checkCandidates m t cands = localTCState $ disableDestructiveUpdate $ do
--tel <- getContextTelescope
ctxArgs <- getContextArgs
v <- (`applyDroppingParameters` args) =<< reduce term
- reportSDoc "tc.constr.findInScope" 10 $
- text "instance search: attempting" <+> prettyTCM m
- <+> text ":=" <+> prettyTCM v
+ reportSDoc "tc.constr.findInScope" 15 $ vcat
+ [ text "instance search: attempting"
+ , nest 2 $ prettyTCM m <+> text ":=" <+> prettyTCM v
+ ]
assign DirEq m ctxArgs v
-- assign m ctxArgs (term `apply` args)
-- make a pass over constraints, to detect cases where some are made
@@ -208,7 +294,8 @@ checkCandidates m t cands = localTCState $ disableDestructiveUpdate $ do
return True
where
handle err = do
- reportSDoc "tc.constr.findInScope" 50 $ text "assignment failed:" <+> prettyTCM err
+ reportSDoc "tc.constr.findInScope" 50 $
+ text "assignment failed:" <+> prettyTCM err
return False
isIFSConstraint :: Constraint -> Bool
isIFSConstraint FindInScope{} = True
@@ -252,26 +339,3 @@ applyDroppingParameters t vs = do
u : us -> (`apply` us) <$> applyDef f u
_ -> fallback
_ -> fallback
-
--- | Attempt to solve irrelevant metas by instance search.
-solveIrrelevantMetas :: TCM ()
-solveIrrelevantMetas = mapM_ solveMetaIfIrrelevant =<< getOpenMetas
-
-solveMetaIfIrrelevant :: MetaId -> TCM ()
-solveMetaIfIrrelevant x = do
- m <- lookupMeta x
- unless (isSortMeta_ m) $ do
- when (irrelevantOrUnused (getMetaRelevance m)) $ do
- let t = jMetaType $ mvJudgement m
- cl = miClosRange $ mvInfo m
- reportSDoc "tc.conv.irr" 20 $ sep
- [ text "instance search for solution of irrelevant meta"
- , prettyTCM x, colon, prettyTCM $ t
- ]
- -- Andreas, 2013-10-21 see Issue 922: we need to restore the context
- -- of the meta, otherwise getMetaTypeInContext will go beserk.
- enterClosure cl $ \ r -> do
- flip catchError (const $ return ()) $ do
- findInScope' x =<< initialIFSCandidates
- -- do not add constraints!
- return ()
diff --git a/src/full/Agda/TypeChecking/Level.hs b/src/full/Agda/TypeChecking/Level.hs
index 45ddf68..a1a3f45 100644
--- a/src/full/Agda/TypeChecking/Level.hs
+++ b/src/full/Agda/TypeChecking/Level.hs
@@ -84,15 +84,17 @@ reallyUnLevelView nv = liftTCM $ do
zer <- primLevelZero
suc <- primLevelSuc
return $ unPlusV zer (\n -> suc `apply` [defaultArg n]) a
- Max as -> do
- LevelKit{ lvlZero = zer, lvlSuc = suc, lvlMax = max } <- requireLevels
- return $ case map (unPlusV zer suc) as of
- [a] -> a
- [] -> __IMPOSSIBLE__
- as -> foldr1 max as
- where
- unPlusV zer suc (ClosedLevel n) = foldr (.) id (genericReplicate n suc) zer
- unPlusV _ suc (Plus n a) = foldr (.) id (genericReplicate n suc) (unLevelAtom a)
+ _ -> (`unlevelWithKit` nv) <$> requireLevels
+
+unlevelWithKit :: LevelKit -> Level -> Term
+unlevelWithKit LevelKit{ lvlZero = zer, lvlSuc = suc, lvlMax = max } (Max as) =
+ case map (unPlusV zer suc) as of
+ [a] -> a
+ [] -> zer
+ as -> foldr1 max as
+
+unPlusV zer suc (ClosedLevel n) = foldr (.) id (genericReplicate n suc) zer
+unPlusV _ suc (Plus n a) = foldr (.) id (genericReplicate n suc) (unLevelAtom a)
maybePrimCon :: TCM Term -> TCM (Maybe ConHead)
maybePrimCon prim = liftTCM $ do
diff --git a/src/full/Agda/TypeChecking/MetaVars.hs b/src/full/Agda/TypeChecking/MetaVars.hs
index dd2a51d..bbb6848 100644
--- a/src/full/Agda/TypeChecking/MetaVars.hs
+++ b/src/full/Agda/TypeChecking/MetaVars.hs
@@ -1,8 +1,7 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE RelaxedPolyRec #-}
{-# LANGUAGE PatternGuards #-}
+{-# LANGUAGE RelaxedPolyRec #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeSynonymInstances #-}
@@ -173,15 +172,19 @@ newTypeMeta_ = newTypeMeta =<< (workOnTypes $ newSortMeta)
-- newTypeMeta_ = newTypeMeta Inf
-- | @newIFSMeta s t cands@ creates a new "implicit from scope" metavariable
--- of type @t@ with name suggestion @s@ and initial solution candidates @cands at .
-newIFSMeta :: MetaNameSuggestion -> Type -> [(Term, Type)] -> TCM Term
+-- of type the output type of @t@ with name suggestion @s@ and initial
+-- solution candidates @cands at . If @t@ is a function type, then insert enough
+-- lambdas in front of it.
+newIFSMeta :: MetaNameSuggestion -> Type -> Maybe [(Term, Type)] -> TCM Term
newIFSMeta s t cands = do
- vs <- getContextArgs
- tel <- getContextTelescope
- newIFSMetaCtx s (telePi_ tel t) vs cands
+ let TelV tel t' = telView' t
+ addCtxTel tel $ do
+ vs <- getContextArgs
+ ctx <- getContextTelescope
+ teleLam tel <$> newIFSMetaCtx s (telePi_ ctx t') vs (raise (size tel) cands)
-- | Create a new value meta with specific dependencies.
-newIFSMetaCtx :: MetaNameSuggestion -> Type -> Args -> [(Term, Type)] -> TCM Term
+newIFSMetaCtx :: MetaNameSuggestion -> Type -> Args -> Maybe [(Term, Type)] -> TCM Term
newIFSMetaCtx s t vs cands = do
reportSDoc "tc.meta.new" 50 $ fsep
[ text "new ifs meta:"
@@ -195,7 +198,7 @@ newIFSMetaCtx s t vs cands = do
reportSDoc "tc.meta.new" 50 $ fsep
[ nest 2 $ text (show x) <+> text ":" <+> prettyTCM t
]
- solveConstraint_ $ FindInScope x cands
+ addConstraint $ FindInScope x cands
return $ MetaV x $ map Apply vs
@@ -646,47 +649,38 @@ assign dir x args v = do
text "fvars rhs:" <+> sep (map (text . show) $ Set.toList fvs)
-- Check that the arguments are variables
- ids <- do
+ mids <- do
res <- runErrorT $ inverseSubst args
case res of
-- all args are variables
Right ids -> do
reportSDoc "tc.meta.assign" 50 $
text "inverseSubst returns:" <+> sep (map prettyTCM ids)
- return ids
+ return $ Just ids
-- we have proper values as arguments which could be cased on
-- here, we cannot prune, since offending vars could be eliminated
- Left CantInvert -> patternViolation
+ Left CantInvert -> return Nothing
-- we have non-variables, but these are not eliminateable
- Left NeutralArg -> attemptPruning x args fvs
+ Left NeutralArg -> Just <$> attemptPruning x args fvs
-- we have a projected variable which could not be eta-expanded away:
-- same as neutral
- Left (ProjectedVar i qs) -> attemptPruning x args fvs
-
- -- Check linearity
- ids <- do
- res <- runErrorT $ checkLinearity {- (`Set.member` fvs) -} ids
- case res of
- -- case: linear
- Right ids -> return ids
- -- case: non-linear variables that could possibly be pruned
- Left () -> attemptPruning x args fvs
-
-{- UNNECESSARILY COMPLICATED:
- ids <- do
- res <- runErrorT $ runWriterT $ checkLinearity (`Set.member` fvs) ids
- case res of
- -- case: linear
- Right (ids, []) -> return ids
- -- case: non-linear variables that could possibly be pruned
- Right (_, xs) -> attemptPruning x args fvs -- or s.th. clever with killargs and xs
- -- case: non-linear variable that cannot be pruned from lhs
- -- attempt pruning of other args
- Left () -> attemptPruning x args fvs
--}
- -- Solve.
- m <- getContextSize
- assignMeta' m x t (length args) ids v
+ Left (ProjectedVar i qs) -> Just <$> attemptPruning x args fvs
+
+ case mids of
+ Nothing -> patternViolation -- Ulf 2014-07-13: actually not needed after all: attemptInertRHSImprovement x args v
+ Just ids -> do
+ -- Check linearity
+ ids <- do
+ res <- runErrorT $ checkLinearity {- (`Set.member` fvs) -} ids
+ case res of
+ -- case: linear
+ Right ids -> return ids
+ -- case: non-linear variables that could possibly be pruned
+ Left () -> attemptPruning x args fvs
+
+ -- Solve.
+ m <- getContextSize
+ assignMeta' m x t (length args) ids v
where
attemptPruning x args fvs = do
-- non-linear lhs: we cannot solve, but prune
@@ -698,6 +692,109 @@ assign dir x args v = do
else "failed"
patternViolation
+-- | When faced with @_X us == D vs@ for an inert D we can solve this by
+-- @_X xs := D _Ys@ with new constraints @_Yi us == vi at . This is important
+-- for instance arguments, where knowing the head D might enable progress.
+attemptInertRHSImprovement :: MetaId -> Args -> Term -> TCM ()
+attemptInertRHSImprovement m args v = do
+ reportSDoc "tc.meta.inert" 30 $ vcat
+ [ text "attempting inert rhs improvement"
+ , nest 2 $ sep [ prettyTCM (MetaV m $ map Apply args) <+> text "=="
+ , prettyTCM v ] ]
+ -- Check that the right-hand side has the form D vs, for some inert constant D.
+ -- Returns the type of D and a function to build an application of D.
+ (a, mkRHS) <- ensureInert v
+ -- Check that all arguments to the meta are neutral and does not have head D.
+ -- If there are non-neutral arguments there could be solutions to the meta
+ -- that computes over these arguments. If D is an argument to the meta we get
+ -- multiple solutions (for instance: _M Nat == Nat can be solved by both
+ -- _M := \ x -> x and _M := \ x -> Nat).
+ mapM_ (ensureNeutral (mkRHS []) . unArg) args
+ tel <- theTel <$> (telView =<< getMetaType m)
+ -- When attempting shortcut meta solutions, metas aren't necessarily fully
+ -- eta expanded. If this is the case we skip inert improvement.
+ when (length args < size tel) $ do
+ reportSDoc "tc.meta.inert" 30 $ text "not fully applied"
+ patternViolation
+ -- 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
+ 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
+ patternViolation -- throwing a pattern violation here lets the constraint
+ -- machinery worry about restarting the comparison.
+ where
+ ensureInert :: Term -> TCM (Type, Args -> Term)
+ ensureInert v = do
+ let notInert = do
+ reportSDoc "tc.meta.inert" 30 $ nest 2 $ text "not inert:" <+> prettyTCM v
+ patternViolation
+ toArgs elims =
+ case allApplyElims elims of
+ Nothing -> do
+ reportSDoc "tc.meta.inert" 30 $ nest 2 $ text "can't do projections from inert"
+ patternViolation
+ Just args -> return args
+ case ignoreSharing v of
+ Var x elims -> (, Var x . map Apply) <$> typeOfBV x
+ Con c args -> notInert -- (, Con c) <$> defType <$> getConstInfo (conName c)
+ Def f elims -> do
+ def <- getConstInfo f
+ let good = return (defType def, Def f . map Apply)
+ case theDef def of
+ Axiom{} -> good
+ Datatype{} -> good
+ Record{} -> good
+ Function{} -> notInert
+ Primitive{} -> notInert
+ Constructor{} -> __IMPOSSIBLE__
+
+ Pi{} -> notInert -- this is actually inert but improving doesn't buy us anything for Pi
+ Lam{} -> notInert
+ Sort{} -> notInert
+ Lit{} -> notInert
+ Level{} -> notInert
+ MetaV{} -> notInert
+ DontCare{} -> notInert
+ ExtLam{} -> __IMPOSSIBLE__
+ Shared{} -> __IMPOSSIBLE__
+
+ ensureNeutral :: Term -> Term -> TCM ()
+ ensureNeutral rhs v = do
+ b <- reduceB v
+ let notNeutral v = do
+ reportSDoc "tc.meta.inert" 30 $ nest 2 $ text "not neutral:" <+> prettyTCM v
+ patternViolation
+ checkRHS arg
+ | arg == rhs = do
+ reportSDoc "tc.meta.inert" 30 $ nest 2 $ text "argument shares head with RHS:" <+> prettyTCM arg
+ patternViolation
+ | otherwise = return ()
+ case fmap ignoreSharing b of
+ Blocked{} -> notNeutral v
+ NotBlocked v ->
+ case v of
+ Var x _ -> checkRHS (Var x [])
+ Def f _ -> checkRHS (Def f [])
+ Pi{} -> return ()
+ Sort{} -> return ()
+ Level{} -> return ()
+ Lit{} -> notNeutral v
+ DontCare{} -> notNeutral v
+ MetaV{} -> notNeutral v
+ Con{} -> notNeutral v
+ Lam{} -> notNeutral v
+ ExtLam{} -> __IMPOSSIBLE__
+ Shared{} -> __IMPOSSIBLE__
+
+
-- | @assignMeta m x t ids u@ solves @x ids = u@ for meta @x@ of type @t@,
-- where term @u@ lives in a context of length @m at .
-- Precondition: @ids@ is linear.
@@ -1031,6 +1128,7 @@ inverseSubst args = map (mapFst unArg) <$> loop (zip args terms)
Arg _ Pi{} -> neutralArg
Arg _ Sort{} -> neutralArg
Arg _ Level{} -> neutralArg
+ Arg _ ExtLam{} -> __IMPOSSIBLE__
Arg info (Shared p) -> isVarOrIrrelevant vars (Arg info $ derefPtr p, t)
diff --git a/src/full/Agda/TypeChecking/MetaVars.hs-boot b/src/full/Agda/TypeChecking/MetaVars.hs-boot
index 24e5129..4166338 100644
--- a/src/full/Agda/TypeChecking/MetaVars.hs-boot
+++ b/src/full/Agda/TypeChecking/MetaVars.hs-boot
@@ -1,7 +1,7 @@
-
module Agda.TypeChecking.MetaVars where
import Agda.Syntax.Internal ( MetaId, Term, Type, 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
@@ -10,8 +10,9 @@ newArgsMeta :: Type -> TCM Args
assignTerm :: MetaId -> Term -> TCM ()
etaExpandMetaSafe :: MetaId -> TCM ()
assignV :: CompareDirection -> MetaId -> Args -> Term -> TCM ()
-assign :: CompareDirection -> MetaId -> Args -> Term -> TCM ()
-newIFSMeta :: String -> Type -> [(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
+allMetas :: TermLike a => a -> [MetaId]
diff --git a/src/full/Agda/TypeChecking/MetaVars/Mention.hs b/src/full/Agda/TypeChecking/MetaVars/Mention.hs
index be4ebf3..c59d817 100644
--- a/src/full/Agda/TypeChecking/MetaVars/Mention.hs
+++ b/src/full/Agda/TypeChecking/MetaVars/Mention.hs
@@ -1,10 +1,12 @@
-{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}
+{-# LANGUAGE CPP, FlexibleInstances, TypeSynonymInstances #-}
module Agda.TypeChecking.MetaVars.Mention where
import Agda.Syntax.Common
import Agda.Syntax.Internal as I
import Agda.TypeChecking.Monad
+import Agda.Utils.Impossible
+#include "../../undefined.h"
class MentionsMeta t where
mentionsMeta :: MetaId -> t -> Bool
@@ -22,6 +24,7 @@ instance MentionsMeta Term where
DontCare v -> False -- we don't have to look inside don't cares when deciding to wake constraints
MetaV y args -> x == y || mm args -- TODO: we really only have to look one level deep at meta args
Shared p -> mm $ derefPtr p
+ ExtLam{} -> __IMPOSSIBLE__
where
mm v = mentionsMeta x v
diff --git a/src/full/Agda/TypeChecking/MetaVars/Occurs.hs b/src/full/Agda/TypeChecking/MetaVars/Occurs.hs
index 16cf931..b819621 100644
--- a/src/full/Agda/TypeChecking/MetaVars/Occurs.hs
+++ b/src/full/Agda/TypeChecking/MetaVars/Occurs.hs
@@ -235,6 +235,7 @@ instance Occurs Term where
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
-- Check for loop
-- don't fail hard on this, since we might still be on the top-level
@@ -300,6 +301,7 @@ instance Occurs Term where
Pi a b -> metaOccurs m (a,b)
Sort s -> metaOccurs m s
Shared p -> metaOccurs m $ derefPtr p
+ ExtLam{} -> __IMPOSSIBLE__
MetaV m' vs | m == m' -> patternViolation' 50 $ "Found occurrence of " ++ show m
| otherwise -> metaOccurs m vs
@@ -474,11 +476,11 @@ hasBadRigid xs t = do
let failure = throwError ()
t <- liftTCM $ reduce t
case ignoreSharing t of
- (Var x _) -> return $ notElem x xs
+ Var x _ -> return $ notElem x xs
-- Issue 1153: A lambda has to be considered matchable.
- -- (Lam _ v) -> hasBadRigid (0 : map (+1) xs) (absBody v)
- (Lam _ v) -> failure
- (DontCare v) -> hasBadRigid xs v
+ -- Lam _ v -> hasBadRigid (0 : map (+1) xs) (absBody v)
+ Lam _ v -> failure
+ DontCare v -> hasBadRigid xs v
-- The following types of arguments cannot be eliminated by a pattern
-- match: data, record, Pi, levels, sorts
-- Thus, their offending rigid variables are bad.
@@ -486,14 +488,14 @@ hasBadRigid xs t = do
return $ es `rigidVarsNotContainedIn` xs
-- Andreas, 2012-05-03: There is room for further improvement.
-- We could also consider a defined f which is not blocked by a meta.
- (Pi a b) -> return $ (a,b) `rigidVarsNotContainedIn` xs
- (Level v) -> return $ v `rigidVarsNotContainedIn` xs
- (Sort s) -> return $ s `rigidVarsNotContainedIn` xs
+ Pi a b -> return $ (a,b) `rigidVarsNotContainedIn` xs
+ Level v -> return $ v `rigidVarsNotContainedIn` xs
+ Sort s -> return $ s `rigidVarsNotContainedIn` xs
-- Since constructors can be eliminated by pattern-matching,
-- offending variables under a constructor could be removed by
-- the right instantiation of the meta variable.
-- Thus, they are not rigid.
- (Con c args) -> do
+ Con c args -> do
ifM (liftTCM $ isEtaCon (conName c))
-- in case of a record con, we can in principle prune
-- (but not this argument; the meta could become a projection!)
@@ -501,7 +503,8 @@ hasBadRigid xs t = do
failure
Lit{} -> failure -- matchable
MetaV{} -> failure -- potentially matchable
- (Shared p) -> __IMPOSSIBLE__
+ Shared p -> __IMPOSSIBLE__
+ ExtLam{} -> __IMPOSSIBLE__
-- | Check whether a term @Def f es@ is finally stuck.
-- Currently, we give only a crude approximation.
diff --git a/src/full/Agda/TypeChecking/Monad/Base.hs b/src/full/Agda/TypeChecking/Monad/Base.hs
index d99fe4c..1145491 100644
--- a/src/full/Agda/TypeChecking/Monad/Base.hs
+++ b/src/full/Agda/TypeChecking/Monad/Base.hs
@@ -97,7 +97,11 @@ data TCState =
-- 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
@@ -106,7 +110,10 @@ data TCState =
-- 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.
@@ -182,6 +189,7 @@ initState = TCSt
, stScope = emptyScopeInfo
, stPatternSyns = Map.empty
, stPatternSynImports = Map.empty
+ , stInstanceDefs = (Map.empty , [])
, stPragmaOptions = defaultInteractionOptions
, stStatistics = Map.empty
, stMutualBlocks = Map.empty
@@ -363,7 +371,7 @@ data Constraint
| Guarded Constraint ProblemId
| IsEmpty Range Type
-- ^ the range is the one of the absurd pattern
- | FindInScope MetaId [(Term, Type)]
+ | FindInScope MetaId (Maybe [(Term, Type)])
deriving (Typeable, Show)
instance HasRange Constraint where
@@ -675,6 +683,19 @@ defaultDisplayForm c = []
defRelevance = argInfoRelevance . defArgInfo
defColors = argInfoColors . defArgInfo
+type RewriteRules = [RewriteRule]
+
+-- | Rewrite rules can be added independently from function clauses.
+data RewriteRule = RewriteRule
+ { rewName :: QName -- ^ Name of rewrite rule @q : Γ → lhs ≡ rhs@
+ -- where @≡@ is the rewrite relation.
+ , rewContext :: Telescope -- ^ @Γ@.
+ , rewLHS :: Term -- ^ @Γ ⊢ lhs : t at .
+ , rewRHS :: Term -- ^ @Γ ⊢ rhs : t at .
+ , rewType :: Type -- ^ @Γ ⊢ t at .
+ }
+ deriving (Typeable, Show)
+
data Definition = Defn
{ defArgInfo :: ArgInfo -- ^ Hiding should not be used.
, defName :: QName
@@ -684,6 +705,10 @@ data Definition = Defn
, defDisplay :: [Open DisplayForm]
, defMutual :: MutualId
, defCompiledRep :: CompiledRepresentation
+ , defRewriteRules :: RewriteRules
+ -- ^ Rewrite rules for this symbol, (additional to function clauses).
+ , defInstance :: Maybe QName
+ -- ^ @Just q@ when this definition is an instance of class q
, theDef :: Defn
}
deriving (Typeable, Show)
@@ -699,6 +724,8 @@ defaultDefn info x t def = Defn
, defDisplay = defaultDisplayForm x
, defMutual = 0
, defCompiledRep = noCompiledRep
+ , defRewriteRules = []
+ , defInstance = Nothing
, theDef = def
}
@@ -832,7 +859,10 @@ data Defn = Axiom
-- Thus, @recTel@ is redundant.
, recMutual :: [QName] -- ^ Mutually recursive functions, @data at s and @record at s. Does not include this record.
, recEtaEquality :: Bool -- ^ Eta-expand at this record type. @False@ for unguarded recursive records and coinductive records.
- , recInduction :: Induction -- ^ 'Inductive' or 'Coinductive'? Matters only for recursive records.
+ , recInduction :: Maybe Induction
+ -- ^ 'Inductive' or 'CoInductive'? Matters only for recursive records.
+ -- 'Nothing' means that the user did not specify it, which is an error
+ -- for recursive records.
, recRecursive :: Bool -- ^ Recursive record. Implies @recEtaEquality = False at . Projections are not size-preserving.
, recAbstr :: IsAbstract
}
@@ -936,14 +966,17 @@ reduced b = case fmap ignoreSharing <$> b of
-- | Controlling 'reduce'.
data AllowedReduction
- = ProjectionReductions -- ^ (Projection and) projection-like functions may be reduced.
- | FunctionReductions -- ^ Functions which are not projections may be reduced.
- | LevelReductions -- ^ Reduce @'Level'@ terms.
+ = ProjectionReductions -- ^ (Projection and) projection-like functions may be reduced.
+ | FunctionReductions -- ^ Functions which are not projections may be reduced.
+ | LevelReductions -- ^ Reduce @'Level'@ terms.
+ | NonTerminatingReductions -- ^ Functions that have not passed termination checking.
deriving (Show, Eq, Ord, Enum, Bounded)
type AllowedReductions = [AllowedReduction]
-allReductions = [minBound..maxBound]
+-- | Not quite all reductions (skip non-terminating reductions)
+allReductions :: AllowedReductions
+allReductions = [minBound..pred maxBound]
data PrimFun = PrimFun
{ primFunName :: QName
@@ -1084,6 +1117,24 @@ instance HasRange Call where
getRange (NoHighlighting _) = noRange
---------------------------------------------------------------------------
+-- ** Instance table
+---------------------------------------------------------------------------
+
+-- | The instance table is a @Map@ associating to every name of
+-- record/data type/postulate its list of instances
+type InstanceTable = Map QName [QName]
+
+-- | When typechecking something of the following form:
+--
+-- instance
+-- x : _
+-- x = y
+--
+-- it's not yet known where to add @x@, so we add it to a list of
+-- unresolved instances and we'll deal with it later.
+type TempInstanceTable = (InstanceTable , [QName])
+
+---------------------------------------------------------------------------
-- ** Builtin things
---------------------------------------------------------------------------
@@ -1217,6 +1268,10 @@ data TCEnv =
-- ^ Did we encounter a simplification (proper match)
-- during the current reduction process?
, envAllowedReductions :: AllowedReductions
+ , envCompareBlocked :: Bool
+ -- ^ Can we compare blocked things during conversion?
+ -- No by default.
+ -- Yes for rewriting feature.
, envPrintDomainFreePi :: Bool
-- ^ When True types will be omitted from printed pi types if they
-- can be inferred
@@ -1224,6 +1279,10 @@ data TCEnv =
-- ^ Used by the scope checker to make sure that certain forms
-- of expressions are not used inside dot patterns: extended
-- lambdas and let-expressions.
+ , envReifyUnquoted :: Bool
+ -- ^ The rules for translating internal to abstract syntax are
+ -- slightly different when the internal term comes from an
+ -- unquote.
}
deriving (Typeable)
@@ -1263,8 +1322,10 @@ initEnv = TCEnv { envContext = []
, envAppDef = Nothing
, envSimplification = NoSimplification
, envAllowedReductions = allReductions
+ , envCompareBlocked = False
, envPrintDomainFreePi = False
, envInsideDotPattern = False
+ , envReifyUnquoted = False
}
---------------------------------------------------------------------------
@@ -1628,6 +1689,12 @@ runReduceM m = do
s <- get
return $ runReader (unReduceM m) (ReduceEnv e s)
+runReduceF :: (a -> ReduceM b) -> TCM (a -> b)
+runReduceF f = do
+ e <- ask
+ s <- get
+ return $ \x -> runReader (unReduceM (f x)) (ReduceEnv e s)
+
instance MonadReader TCEnv ReduceM where
ask = redEnv <$> ReduceM ask
local f = ReduceM . local (mapRedEnv f) . unReduceM
@@ -1774,11 +1841,13 @@ patternViolation = do
internalError :: MonadTCM tcm => String -> tcm a
internalError s = typeError $ InternalError s
+{-# SPECIALIZE typeError :: TypeError -> TCM a #-}
typeError :: MonadTCM tcm => TypeError -> tcm a
-typeError err = liftTCM $ do
- cl <- buildClosure err
- s <- get
- throwError $ TypeError s cl
+typeError err = liftTCM $ throwError =<< typeError_ err
+
+{-# SPECIALIZE typeError_ :: TypeError -> TCM TCErr #-}
+typeError_ :: MonadTCM tcm => TypeError -> tcm TCErr
+typeError_ err = liftTCM $ TypeError <$> get <*> buildClosure err
-- | Running the type checking monad (most general form).
{-# SPECIALIZE runTCM :: TCEnv -> TCState -> TCM a -> IO (a, TCState) #-}
diff --git a/src/full/Agda/TypeChecking/Monad/Base/KillRange.hs b/src/full/Agda/TypeChecking/Monad/Base/KillRange.hs
index 4c1eda6..d7707c1 100644
--- a/src/full/Agda/TypeChecking/Monad/Base/KillRange.hs
+++ b/src/full/Agda/TypeChecking/Monad/Base/KillRange.hs
@@ -29,10 +29,14 @@ instance KillRange Section where
killRange (Section tel freeVars) = killRange2 Section tel freeVars
instance KillRange Definition where
- killRange (Defn ai name t pols occs displ mut compiled def) =
- killRange9 Defn ai name t pols occs displ mut compiled def
+ killRange (Defn ai name t pols occs displ mut compiled rew inst def) =
+ killRange11 Defn ai name t pols occs displ mut compiled rew inst def
-- TODO clarify: Keep the range in the defName field?
+instance KillRange RewriteRule where
+ killRange (RewriteRule q gamma lhs rhs t) =
+ killRange5 RewriteRule q gamma lhs rhs t
+
instance KillRange CompiledRepresentation where
killRange = id
diff --git a/src/full/Agda/TypeChecking/Monad/Benchmark.hs b/src/full/Agda/TypeChecking/Monad/Benchmark.hs
index 8c66c85..9b66629 100644
--- a/src/full/Agda/TypeChecking/Monad/Benchmark.hs
+++ b/src/full/Agda/TypeChecking/Monad/Benchmark.hs
@@ -12,7 +12,6 @@ module Agda.TypeChecking.Monad.Benchmark
import qualified Control.Exception as E (evaluate)
import Control.Monad.State
-import System.CPUTime
import Agda.TypeChecking.Monad.Base.Benchmark
import Agda.TypeChecking.Monad.Base
@@ -21,6 +20,7 @@ import Agda.TypeChecking.Monad.State
import Agda.Utils.Monad
import Agda.Utils.Pretty (Doc)
+import Agda.Utils.Time
#include "../../undefined.h"
import Agda.Utils.Impossible
@@ -41,11 +41,9 @@ reportBenchmarkingDoc = reportSDoc "profile" 7
-- | Bill a computation to a specific account (True) or reimburse (False).
billTo' :: MonadTCM tcm => Bool -> Account -> tcm a -> tcm a
billTo' add k m = ifNotM benchmarking m {- else -} $ do
- start <- liftIO $ getCPUTime
- result <- liftIO . E.evaluate =<< m
- stop <- liftIO $ getCPUTime
- addToAccount k $ if add then stop - start else start - stop
- return result
+ (res, time) <- measureTime $ liftIO . E.evaluate =<< m
+ addToAccount k $ if add then time else -time
+ return res
-- | Bill a computation to a specific account.
billTo :: MonadTCM tcm => Account -> tcm a -> tcm a
diff --git a/src/full/Agda/TypeChecking/Monad/Builtin.hs b/src/full/Agda/TypeChecking/Monad/Builtin.hs
index d92ac64..2f3e7a7 100644
--- a/src/full/Agda/TypeChecking/Monad/Builtin.hs
+++ b/src/full/Agda/TypeChecking/Monad/Builtin.hs
@@ -114,19 +114,23 @@ primInteger, primFloat, primChar, primString, primBool, primTrue, primFalse,
primSize, primSizeLt, primSizeSuc, primSizeInf,
primInf, primSharp, primFlat,
primEquality, primRefl,
+ primRewrite, -- Name of rewrite relation
primLevel, primLevelZero, primLevelSuc, primLevelMax,
primIrrAxiom, primSizeMax,
-- builtins for reflection:
primQName, primArgInfo, primArgArgInfo, primArg, primArgArg, primAgdaTerm, primAgdaTermVar,
- primAgdaTermLam, primAgdaTermDef, primAgdaTermCon, primAgdaTermPi,
- primAgdaTermSort, primAgdaTermUnsupported,
+ primAgdaTermLam, primAgdaTermExtLam, primAgdaTermDef, primAgdaTermCon, primAgdaTermPi,
+ primAgdaTermSort, primAgdaTermLit, primAgdaTermUnsupported,
primAgdaType, primAgdaTypeEl,
primHiding, primHidden, primInstance, primVisible,
primRelevance, primRelevant, primIrrelevant,
+ primAgdaLiteral, primAgdaLitNat, primAgdaLitFloat, primAgdaLitString, primAgdaLitChar, primAgdaLitQName,
primAgdaSort, primAgdaSortSet, primAgdaSortLit, primAgdaSortUnsupported,
primAgdaDefinition, primAgdaDefinitionFunDef, primAgdaDefinitionDataDef, primAgdaDefinitionRecordDef,
primAgdaDefinitionPostulate, primAgdaDefinitionPrimitive, primAgdaDefinitionDataConstructor,
- primAgdaFunDef, primAgdaDataDef, primAgdaRecordDef
+ primAgdaFunDef, primAgdaFunDefCon, primAgdaClause, primAgdaClauseClause, primAgdaClauseAbsurd,
+ primAgdaPattern, primAgdaPatCon, primAgdaPatVar, primAgdaPatDot,
+ primAgdaDataDef, primAgdaRecordDef
:: TCM Term
primInteger = getBuiltin builtinInteger
primFloat = getBuiltin builtinFloat
@@ -159,6 +163,7 @@ primSharp = getBuiltin builtinSharp
primFlat = getBuiltin builtinFlat
primEquality = getBuiltin builtinEquality
primRefl = getBuiltin builtinRefl
+primRewrite = getBuiltin builtinRewrite
primLevel = getBuiltin builtinLevel
primLevelZero = getBuiltin builtinLevelZero
primLevelSuc = getBuiltin builtinLevelSuc
@@ -185,14 +190,33 @@ primAgdaSortUnsupported = getBuiltin builtinAgdaSortUnsupported
primAgdaTerm = getBuiltin builtinAgdaTerm
primAgdaTermVar = getBuiltin builtinAgdaTermVar
primAgdaTermLam = getBuiltin builtinAgdaTermLam
+primAgdaTermExtLam = getBuiltin builtinAgdaTermExtLam
primAgdaTermDef = getBuiltin builtinAgdaTermDef
primAgdaTermCon = getBuiltin builtinAgdaTermCon
primAgdaTermPi = getBuiltin builtinAgdaTermPi
primAgdaTermSort = getBuiltin builtinAgdaTermSort
+primAgdaTermLit = getBuiltin builtinAgdaTermLit
primAgdaTermUnsupported = getBuiltin builtinAgdaTermUnsupported
-primAgdaFunDef = getBuiltin builtinAgdaFunDef
-primAgdaDataDef = getBuiltin builtinAgdaDataDef
-primAgdaRecordDef = getBuiltin builtinAgdaRecordDef
+primAgdaLiteral = getBuiltin builtinAgdaLiteral
+primAgdaLitNat = getBuiltin builtinAgdaLitNat
+primAgdaLitFloat = getBuiltin builtinAgdaLitFloat
+primAgdaLitChar = getBuiltin builtinAgdaLitChar
+primAgdaLitString = getBuiltin builtinAgdaLitString
+primAgdaLitQName = getBuiltin builtinAgdaLitQName
+primAgdaFunDef = getBuiltin builtinAgdaFunDef
+primAgdaFunDefCon = getBuiltin builtinAgdaFunDefCon
+primAgdaDataDef = getBuiltin builtinAgdaDataDef
+primAgdaRecordDef = getBuiltin builtinAgdaRecordDef
+primAgdaPattern = getBuiltin builtinAgdaPattern
+primAgdaPatCon = getBuiltin builtinAgdaPatCon
+primAgdaPatVar = getBuiltin builtinAgdaPatVar
+primAgdaPatDot = getBuiltin builtinAgdaPatDot
+primAgdaPatLit = getBuiltin builtinAgdaPatLit
+primAgdaPatProj = getBuiltin builtinAgdaPatProj
+primAgdaPatAbsurd = getBuiltin builtinAgdaPatAbsurd
+primAgdaClause = getBuiltin builtinAgdaClause
+primAgdaClauseClause = getBuiltin builtinAgdaClauseClause
+primAgdaClauseAbsurd = getBuiltin builtinAgdaClauseAbsurd
primAgdaDefinitionFunDef = getBuiltin builtinAgdaDefinitionFunDef
primAgdaDefinitionDataDef = getBuiltin builtinAgdaDefinitionDataDef
primAgdaDefinitionRecordDef = getBuiltin builtinAgdaDefinitionRecordDef
@@ -200,6 +224,7 @@ primAgdaDefinitionDataConstructor = getBuiltin builtinAgdaDefinitionDataConstruc
primAgdaDefinitionPostulate = getBuiltin builtinAgdaDefinitionPostulate
primAgdaDefinitionPrimitive = getBuiltin builtinAgdaDefinitionPrimitive
primAgdaDefinition = getBuiltin builtinAgdaDefinition
+
builtinNat = "NATURAL"
builtinSuc = "SUC"
builtinZero = "ZERO"
@@ -231,6 +256,7 @@ builtinSharp = "SHARP"
builtinFlat = "FLAT"
builtinEquality = "EQUALITY"
builtinRefl = "REFL"
+builtinRewrite = "REWRITE"
builtinLevelMax = "LEVELMAX"
builtinLevel = "LEVEL"
builtinLevelZero = "LEVELZERO"
@@ -257,12 +283,31 @@ 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"
+builtinAgdaClauseClause = "AGDACLAUSECLAUSE"
+builtinAgdaClauseAbsurd = "AGDACLAUSEABSURD"
+builtinAgdaPattern = "AGDAPATTERN"
+builtinAgdaPatVar = "AGDAPATVAR"
+builtinAgdaPatCon = "AGDAPATCON"
+builtinAgdaPatDot = "AGDAPATDOT"
+builtinAgdaPatLit = "AGDAPATLIT"
+builtinAgdaPatProj = "AGDAPATPROJ"
+builtinAgdaPatAbsurd = "AGDAPATABSURD"
builtinAgdaDataDef = "AGDADATADEF"
builtinAgdaRecordDef = "AGDARECORDDEF"
builtinAgdaDefinitionFunDef = "AGDADEFINITIONFUNDEF"
diff --git a/src/full/Agda/TypeChecking/Monad/Constraints.hs b/src/full/Agda/TypeChecking/Monad/Constraints.hs
index c60b63f..7ecefff 100644
--- a/src/full/Agda/TypeChecking/Monad/Constraints.hs
+++ b/src/full/Agda/TypeChecking/Monad/Constraints.hs
@@ -6,11 +6,15 @@ import Control.Arrow ((&&&))
import Control.Applicative
import Control.Monad.State
import Control.Monad.Reader
+
import Data.List as List
+import Data.Maybe
import Agda.TypeChecking.Monad.Base
import Agda.TypeChecking.Monad.Closure
import Agda.TypeChecking.Monad.Options
+
+import Agda.Utils.List
import Agda.Utils.Monad
#include "../../undefined.h"
@@ -18,30 +22,29 @@ import Agda.Utils.Impossible
-- | Get the current problem
currentProblem :: TCM ProblemId
-currentProblem = asks $ head' . envActiveProblems
- where
- head' [] = {- ' -} __IMPOSSIBLE__
- head' (x:_) = x
+currentProblem = fromMaybe __IMPOSSIBLE__ . mhead <$> asks envActiveProblems
-- | Steal all constraints belonging to the given problem and add them to the current problem.
stealConstraints :: ProblemId -> TCM ()
stealConstraints pid = do
current <- currentProblem
reportSLn "tc.constr.steal" 50 $ "problem " ++ show current ++ " is stealing problem " ++ show pid ++ "'s constraints!"
+ -- Rename @pid@ to @current@ in all constraints.
let rename pc@(PConstr pid' c) | pid' == pid = PConstr current c
| otherwise = pc
-- We should never steal from an active problem.
whenM (elem pid <$> asks envActiveProblems) __IMPOSSIBLE__
- modify $ \s -> s { stAwakeConstraints = List.map rename $ stAwakeConstraints s
- , stSleepingConstraints = List.map rename $ stSleepingConstraints s }
+ modifyAwakeConstraints $ List.map rename
+ modifySleepingConstraints $ List.map rename
solvingProblem :: ProblemId -> TCM a -> TCM a
solvingProblem pid m = verboseBracket "tc.constr.solve" 50 ("working on problem " ++ show pid) $ do
x <- local (\e -> e { envActiveProblems = pid : envActiveProblems e }) m
- ifM (isProblemSolved pid) (do
+ ifNotM (isProblemSolved pid)
+ (reportSLn "tc.constr.solve" 50 $ "problem " ++ show pid ++ " was not solved.")
+ $ {- else -} do
reportSLn "tc.constr.solve" 50 $ "problem " ++ show pid ++ " was solved!"
wakeConstraints (blockedOn pid . clValue . theConstraint)
- ) (reportSLn "tc.constr.solve" 50 $ "problem " ++ show pid ++ " was not solved.")
return x
where
blockedOn pid (Guarded _ pid') = pid == pid'
@@ -61,31 +64,25 @@ getAwakeConstraints = gets stAwakeConstraints
wakeConstraints :: (ProblemConstraint-> Bool) -> TCM ()
wakeConstraints wake = do
- sleepers <- gets stSleepingConstraints
- let (wakeup, sleepin) = List.partition wake sleepers
- reportSLn "tc.constr.wake" 50 $ "waking up " ++ show (List.map constraintProblem wakeup) ++ "\n" ++
- " still sleeping: " ++ show (List.map constraintProblem sleepin)
- modify $ \s ->
- s { stSleepingConstraints = sleepin
- , stAwakeConstraints = stAwakeConstraints s ++ wakeup
- }
+ (wakeup, sleepin) <- List.partition wake <$> gets stSleepingConstraints
+ reportSLn "tc.constr.wake" 50 $
+ "waking up " ++ show (List.map constraintProblem wakeup) ++ "\n" ++
+ " still sleeping: " ++ show (List.map constraintProblem sleepin)
+ modifySleepingConstraints $ const sleepin
+ modifyAwakeConstraints (++ wakeup)
-- danger...
dropConstraints :: (ProblemConstraint -> Bool) -> TCM ()
dropConstraints crit = do
- sleepers <- gets stSleepingConstraints
- wakers <- gets stAwakeConstraints
- let filt = List.filter (not . crit)
- modify $ \s -> s { stSleepingConstraints = filt sleepers
- , stAwakeConstraints = filt wakers
- }
+ let filt = List.filter $ not . crit
+ modifySleepingConstraints filt
+ modifyAwakeConstraints filt
putAllConstraintsToSleep :: TCM ()
putAllConstraintsToSleep = do
awakeOnes <- gets stAwakeConstraints
- sleepers <- gets stSleepingConstraints
- modify $ \s -> s { stSleepingConstraints = sleepers ++ awakeOnes
- , stAwakeConstraints = [] }
+ modifySleepingConstraints $ (++ awakeOnes)
+ modifyAwakeConstraints $ const []
takeAwakeConstraint :: TCM (Maybe ProblemConstraint)
takeAwakeConstraint = do
@@ -93,8 +90,8 @@ takeAwakeConstraint = do
case cs of
[] -> return Nothing
c : cs -> do
- modify $ \s -> s { stAwakeConstraints = cs }
- return (Just c)
+ modifyAwakeConstraints $ const cs
+ return $ Just c
getAllConstraints :: TCM Constraints
getAllConstraints = gets $ \s -> stAwakeConstraints s ++ stSleepingConstraints s
@@ -134,7 +131,7 @@ addConstraint' c = do
-- | Add already awake constraints
addAwakeConstraints :: Constraints -> TCM ()
-addAwakeConstraints cs = modify $ \s -> s { stAwakeConstraints = cs ++ stAwakeConstraints s }
+addAwakeConstraints cs = modifyAwakeConstraints (cs ++)
-- | Start solving constraints
nowSolvingConstraints :: TCM a -> TCM a
@@ -142,3 +139,20 @@ nowSolvingConstraints = local $ \e -> e { envSolvingConstraints = True }
isSolvingConstraints :: TCM Bool
isSolvingConstraints = asks envSolvingConstraints
+
+---------------------------------------------------------------------------
+-- * Lenses
+---------------------------------------------------------------------------
+
+mapAwakeConstraints :: (Constraints -> Constraints) -> TCState -> TCState
+mapAwakeConstraints f s = s { stAwakeConstraints = f (stAwakeConstraints s) }
+
+mapSleepingConstraints :: (Constraints -> Constraints) -> TCState -> TCState
+mapSleepingConstraints f s = s { stSleepingConstraints = f (stSleepingConstraints s) }
+
+modifyAwakeConstraints :: (Constraints -> Constraints) -> TCM ()
+modifyAwakeConstraints = modify . mapAwakeConstraints
+
+modifySleepingConstraints :: (Constraints -> Constraints) -> TCM ()
+modifySleepingConstraints = modify . mapSleepingConstraints
+
diff --git a/src/full/Agda/TypeChecking/Monad/Env.hs b/src/full/Agda/TypeChecking/Monad/Env.hs
index dc08df6..fcf0fcb 100644
--- a/src/full/Agda/TypeChecking/Monad/Env.hs
+++ b/src/full/Agda/TypeChecking/Monad/Env.hs
@@ -83,9 +83,18 @@ dontReduceLevels = local $ \ e -> e { envAllowedReductions = allReductions \\ [L
allowAllReductions :: TCM a -> TCM a
allowAllReductions = local $ \ e -> e { envAllowedReductions = allReductions }
+allowNonTerminatingReductions :: TCM a -> TCM a
+allowNonTerminatingReductions = local $ \ e -> e { envAllowedReductions = allReductions ++ [NonTerminatingReductions] }
+
insideDotPattern :: TCM a -> TCM a
insideDotPattern = local $ \e -> e { envInsideDotPattern = True }
isInsideDotPattern :: TCM Bool
isInsideDotPattern = asks envInsideDotPattern
+isReifyingUnquoted :: TCM Bool
+isReifyingUnquoted = asks envReifyUnquoted
+
+nowReifyingUnquoted :: TCM a -> TCM a
+nowReifyingUnquoted = local $ \e -> e { envReifyUnquoted = True }
+
diff --git a/src/full/Agda/TypeChecking/Monad/Exception.hs b/src/full/Agda/TypeChecking/Monad/Exception.hs
index 27d3cdb..516bb5c 100644
--- a/src/full/Agda/TypeChecking/Monad/Exception.hs
+++ b/src/full/Agda/TypeChecking/Monad/Exception.hs
@@ -1,4 +1,7 @@
-{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances, UndecidableInstances #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# 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).
diff --git a/src/full/Agda/TypeChecking/Monad/Signature.hs b/src/full/Agda/TypeChecking/Monad/Signature.hs
index a2e2d95..eb5a1f7 100644
--- a/src/full/Agda/TypeChecking/Monad/Signature.hs
+++ b/src/full/Agda/TypeChecking/Monad/Signature.hs
@@ -15,6 +15,7 @@ import qualified Data.Map as Map
import Data.Maybe
import Agda.Syntax.Abstract.Name
+import Agda.Syntax.Abstract (Ren)
import Agda.Syntax.Common
import Agda.Syntax.Internal as I
import Agda.Syntax.Position
@@ -39,64 +40,12 @@ import Agda.Utils.Monad
import Agda.Utils.Size
import Agda.Utils.Permutation
import Agda.Utils.Pretty
+import Agda.Utils.List
import qualified Agda.Utils.HashMap as HMap
#include "../../undefined.h"
import Agda.Utils.Impossible
-modifySignature :: (Signature -> Signature) -> TCM ()
-modifySignature f = modify $ \s -> s { stSignature = f $ stSignature s }
-
-modifyImportedSignature :: (Signature -> Signature) -> TCM ()
-modifyImportedSignature f = modify $ \s -> s { stImports = f $ stImports s }
-
-getSignature :: TCM Signature
-getSignature = gets stSignature
-
-getImportedSignature :: TCM Signature
-getImportedSignature = gets stImports
-
-setSignature :: Signature -> TCM ()
-setSignature sig = modifySignature $ const sig
-
-setImportedSignature :: Signature -> TCM ()
-setImportedSignature sig = modify $ \s -> s { stImports = sig }
-
-withSignature :: Signature -> TCM a -> TCM a
-withSignature sig m =
- do sig0 <- getSignature
- setSignature sig
- r <- m
- setSignature sig0
- return r
-
--- * modifiers for parts of the signature
-
-lookupDefinition :: QName -> Signature -> Maybe Definition
-lookupDefinition q sig = HMap.lookup q $ sigDefinitions sig
-
-updateDefinition :: QName -> (Definition -> Definition) -> Signature -> Signature
-updateDefinition q f sig = sig { sigDefinitions = HMap.adjust f q (sigDefinitions sig) }
-
-updateTheDef :: (Defn -> Defn) -> (Definition -> Definition)
-updateTheDef f def = def { theDef = f (theDef def) }
-
-updateDefType :: (Type -> Type) -> (Definition -> Definition)
-updateDefType f def = def { defType = f (defType def) }
-
-updateDefArgOccurrences :: ([Occurrence] -> [Occurrence]) -> (Definition -> Definition)
-updateDefArgOccurrences f def = def { defArgOccurrences = f (defArgOccurrences def) }
-
-updateDefPolarity :: ([Polarity] -> [Polarity]) -> (Definition -> Definition)
-updateDefPolarity f def = def { defPolarity = f (defPolarity def) }
-
-updateDefCompiledRep :: (CompiledRepresentation -> CompiledRepresentation) -> (Definition -> Definition)
-updateDefCompiledRep f def = def { defCompiledRep = f (defCompiledRep def) }
-
-updateFunClauses :: ([Clause] -> [Clause]) -> (Defn -> Defn)
-updateFunClauses f def at Function{ funClauses = cs} = def { funClauses = f cs }
-updateFunClauses f _ = __IMPOSSIBLE__
-
-- | Add a constant to the signature. Lifts the definition to top level.
addConstant :: QName -> Definition -> TCM ()
addConstant q d = do
@@ -112,7 +61,8 @@ addConstant q d = do
i <- currentOrFreshMutualBlock
setMutualBlock i q
where
- new +++ old = new { defDisplay = defDisplay new ++ defDisplay old }
+ new +++ old = new { defDisplay = defDisplay new ++ defDisplay old
+ , defInstance = defInstance new `mplus` defInstance old }
-- | Set termination info of a defined function symbol.
setTerminates :: QName -> Bool -> TCM ()
@@ -245,18 +195,14 @@ addDisplayForms x = do
-- | Module application (followed by module parameter abstraction).
applySection
- :: ModuleName -- ^ Name of new module defined by the module macro.
- -> Telescope -- ^ Parameters of new module.
- -> ModuleName -- ^ Name of old module applied to arguments.
- -> Args -- ^ Arguments of module application.
- -> Map QName QName -- ^ Imported names (given as renaming).
- -> Map ModuleName ModuleName -- ^ Imported modules (given as renaming).
+ :: ModuleName -- ^ Name of new module defined by the module macro.
+ -> Telescope -- ^ Parameters of new module.
+ -> ModuleName -- ^ Name of old module applied to arguments.
+ -> Args -- ^ Arguments of module application.
+ -> Ren QName -- ^ Imported names (given as renaming).
+ -> Ren ModuleName -- ^ Imported modules (given as renaming).
-> TCM ()
applySection new ptel old ts rd rm = do
- sig <- getSignature
- isig <- getImportedSignature
- let ss = getOld partOfOldM sigSections [sig, isig]
- ds = getOldH partOfOldD sigDefinitions [sig, isig]
reportSLn "tc.mod.apply" 10 $ render $ vcat
[ text "applySection"
, text "new =" <+> text (show new)
@@ -264,23 +210,13 @@ applySection new ptel old ts rd rm = do
, text "old =" <+> text (show old)
, text "ts =" <+> text (show ts)
]
- reportSLn "tc.mod.apply" 80 $ "sections: " ++ show ss ++ "\n" ++
- "definitions: " ++ show ds
reportSLn "tc.mod.apply" 80 $ render $ vcat
[ text "arguments: " <+> text (show ts)
]
- mapM_ (copyDef ts) ds
- mapM_ (copySec ts) ss
+ mapM_ (copyDef ts) $ Map.toList rd
+ mapM_ (copySec ts) $ Map.toList rm
mapM_ computePolarity (Map.elems rd)
where
- getOld partOfOld fromSig sigs =
- Map.toList $ Map.filterKeys partOfOld $ Map.unions $ map fromSig sigs
- getOldH partOfOld fromSig sigs =
- HMap.toList $ HMap.filterWithKey (const . partOfOld) $ HMap.unions $ map fromSig sigs
-
- partOfOldM x = x `isSubModuleOf` old
- partOfOldD x = x `isInModule` old
-
-- Andreas, 2013-10-29
-- Here, if the name x is not imported, it persists as
-- old, possibly out-of-scope name.
@@ -291,12 +227,25 @@ applySection new ptel old ts rd rm = do
-- produce out-of-scope constructors.
copyName x = Map.findWithDefault x x rd
- copyDef :: Args -> (QName, Definition) -> TCM ()
- copyDef ts (x, d) =
- case Map.lookup x rd of
- Nothing -> return () -- if it's not in the renaming it was private and
- -- we won't need it
- Just y -> do
+ argsToUse x = do
+ let m = mnameFromList $ commonPrefix (mnameToList old) (mnameToList $ qnameModule x)
+ 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 ]
+ reportSLn "tc.mod.apply" 80 $ " params: " ++ show (zip ms ps)
+ return $ sum ps
+
+ copyDef :: Args -> (QName, QName) -> TCM ()
+ copyDef ts (x, y) = do
+ def <- getConstInfo x
+ np <- argsToUse x
+ copyDef' np def
+ where
+ copyDef' np d = do
+ reportSLn "tc.mod.apply" 80 $ "making new def for " ++ show y ++ " from " ++ show x ++ " with " ++ show np ++ " args"
+ 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
makeProjection y
-- Set display form for the old name if it's not a constructor.
@@ -304,57 +253,67 @@ applySection new ptel old ts rd rm = do
-- Andreas, 2012-10-20 and if we are not an anonymous module
-- 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
- where
- t = defType d `apply` ts
- pol = defPolarity d `apply` ts
- occ = defArgOccurrences d `apply` ts
- -- the name is set by the addConstant function
- nd y = Defn (defArgInfo d) y t pol occ [] (-1) noCompiledRep <$> def -- TODO: mutual block?
- oldDef = theDef d
- isCon = case oldDef of { Constructor{} -> True ; _ -> False }
- mutual = case oldDef of { Function{funMutual = m} -> m ; _ -> [] }
- extlam = case oldDef of { Function{funExtLam = e} -> e ; _ -> Nothing }
- with = case oldDef of { Function{funWith = w} -> copyName <$> w ; _ -> Nothing }
+ where
+ ts' = take np ts
+ t = defType d `apply` ts'
+ pol = defPolarity d `apply` ts'
+ occ = defArgOccurrences d `apply` ts'
+ rew = defRewriteRules d `apply` ts'
+ inst = defInstance d
+ -- the name is set by the addConstant function
+ nd :: QName -> TCM Definition
+ nd y = Defn (defArgInfo d) y t pol occ [] (-1) noCompiledRep rew inst <$> def -- TODO: mutual block?
+ oldDef = theDef d
+ isCon = case oldDef of { Constructor{} -> True ; _ -> False }
+ mutual = case oldDef of { Function{funMutual = m} -> m ; _ -> [] }
+ extlam = case oldDef of { Function{funExtLam = e} -> e ; _ -> Nothing }
+ with = case oldDef of { Function{funWith = w} -> copyName <$> w ; _ -> Nothing }
{- THIS BREAKS A LOT OF THINGS:
- -- Andreas, 2013-10-21:
- -- Even if we apply the record argument, we stay a projection.
- -- This is because we may abstract the record argument later again.
- -- See succeed/ProjectionNotNormalized.agda
- proj = case oldDef of
- Function{funProjection = Just p at Projection{projIndex = n}}
- -> Just $ p { projIndex = n - size ts
- , projDropPars = projDropPars p `apply` ts
- }
- _ -> Nothing
+ -- Andreas, 2013-10-21:
+ -- Even if we apply the record argument, we stay a projection.
+ -- This is because we may abstract the record argument later again.
+ -- See succeed/ProjectionNotNormalized.agda
+ proj = case oldDef of
+ Function{funProjection = Just p at Projection{projIndex = n}}
+ -> Just $ p { projIndex = n - size ts
+ , projDropPars = projDropPars p `apply` ts
+ }
+ _ -> Nothing
-}
- -- NB (Andreas, 2013-10-19):
- -- If we apply the record argument, we are no longer a projection!
- proj = case oldDef of
- Function{funProjection = Just p at Projection{projIndex = n}} | size ts < n
- -> Just $ p { projIndex = n - size ts
- , projDropPars = projDropPars p `apply` ts
- }
- _ -> Nothing
-
- def = case oldDef of
+ -- NB (Andreas, 2013-10-19):
+ -- If we apply the record argument, we are no longer a projection!
+ proj = case oldDef of
+ Function{funProjection = Just p at Projection{projIndex = n}} | size ts < n
+ -> Just $ p { projIndex = n - size ts
+ , projDropPars = projDropPars p `apply` ts
+ }
+ _ -> Nothing
+
+ def =
+ case oldDef of
Constructor{ conPars = np, conData = d } -> return $
- oldDef { conPars = np - size ts
+ oldDef { conPars = np - size ts'
, conData = copyName d
}
Datatype{ dataPars = np, dataCons = cs } -> return $
- oldDef { dataPars = np - size ts
+ oldDef { dataPars = np - size ts'
, dataClause = Just cl
, dataCons = map copyName cs
}
Record{ recPars = np, recConType = t, recTel = tel } -> return $
- oldDef { recPars = np - size ts
+ oldDef { recPars = np - size ts'
, recClause = Just cl
, recConType = apply t ts
, recTel = apply tel ts
}
- _ -> do
+ _ -> do
cc <- compileClauses Nothing [cl] -- Andreas, 2012-10-07 non need for record pattern translation
let newDef = Function
{ funClauses = [cl]
@@ -372,34 +331,26 @@ applySection new ptel old ts rd rm = do
}
reportSLn "tc.mod.apply" 80 $ "new def for " ++ show x ++ "\n " ++ show newDef
return newDef
-{-
- ts' | null ts = []
- | otherwise = case oldDef of
- Function{funProjection = Just Projection{ projIndex = n}}
- | n == 0 -> __IMPOSSIBLE__
- | otherwise -> drop (n - 1) ts
- _ -> ts
--}
- head = case oldDef of
- Function{funProjection = Just Projection{ projDropPars = f}}
- -> f
- _ -> Def x []
- cl = Clause { clauseRange = getRange $ defClauses d
- , clauseTel = EmptyTel
- , clausePerm = idP 0
- , namedClausePats = []
- , clauseBody = Body $ head `apply` ts
- , clauseType = Just $ defaultArg t
- }
-
- copySec :: Args -> (ModuleName, Section) -> TCM ()
- copySec ts (x, sec) = case Map.lookup x rm of
- Nothing -> return () -- if it's not in the renaming it was private and
- -- we won't need it
- Just y ->
- addCtxTel (apply tel ts) $ addSection y 0
- where
- tel = secTelescope sec
+
+ head = case oldDef of
+ Function{funProjection = Just Projection{ projDropPars = f}}
+ -> f
+ _ -> Def x []
+ cl = Clause { clauseRange = getRange $ defClauses d
+ , clauseTel = EmptyTel
+ , clausePerm = idP 0
+ , namedClausePats = []
+ , clauseBody = Body $ head `apply` ts'
+ , clauseType = Just $ defaultArg t
+ }
+
+ copySec :: Args -> (ModuleName, ModuleName) -> TCM ()
+ copySec ts (x, y) = do
+ tel <- lookupSection x
+ let fv = size tel - size ts
+ 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
addDisplayForm :: QName -> DisplayForm -> TCM ()
addDisplayForm x df = do
@@ -441,7 +392,7 @@ whatInduction c = do
case def of
Datatype{ dataInduction = i } -> return i
Record{ recRecursive = False} -> return Inductive
- Record{ recInduction = i } -> return i
+ Record{ recInduction = i } -> return $ fromMaybe Inductive i
Constructor{ conInd = i } -> return i
_ -> __IMPOSSIBLE__
@@ -585,16 +536,22 @@ setMutual d m = modifySignature $ updateDefinition d $ updateTheDef $ \ def ->
mutuallyRecursive :: QName -> QName -> TCM Bool
mutuallyRecursive d d' = (d `elem`) <$> getMutual d'
+-- | Why Maybe? The reason is that we look up all prefixes of a module to
+-- compute number of parameters, and for hierarchical top-level modules,
+-- A.B.C say, A and A.B do not exist.
+getSection :: ModuleName -> TCM (Maybe Section)
+getSection m = do
+ sig <- sigSections <$> getSignature
+ isig <- sigSections <$> getImportedSignature
+ return $ Map.lookup m sig <|> Map.lookup m isig
+
-- | Look up the number of free variables of a section. This is equal to the
-- number of parameters if we're currently inside the section and 0 otherwise.
getSecFreeVars :: ModuleName -> TCM Nat
getSecFreeVars m = do
- sig <- sigSections <$> getSignature
- isig <- sigSections <$> getImportedSignature
top <- currentModule
case top `isSubModuleOf` m || top == m of
- True -> return $ maybe 0 secFreeVars $
- Map.lookup m sig <|> Map.lookup m isig
+ True -> maybe 0 secFreeVars <$> getSection m
False -> return 0
-- | Compute the number of free variables of a module. This is the sum of
diff --git a/src/full/Agda/TypeChecking/Monad/SizedTypes.hs b/src/full/Agda/TypeChecking/Monad/SizedTypes.hs
index c29619a..6a3a3b0 100644
--- a/src/full/Agda/TypeChecking/Monad/SizedTypes.hs
+++ b/src/full/Agda/TypeChecking/Monad/SizedTypes.hs
@@ -20,6 +20,7 @@ import Agda.TypeChecking.Monad.Base
import Agda.TypeChecking.Monad.Options
import Agda.TypeChecking.Monad.Builtin
import Agda.TypeChecking.Monad.Signature
+import Agda.TypeChecking.Monad.State
import Agda.TypeChecking.Substitute ()
import Agda.Utils.Monad
diff --git a/src/full/Agda/TypeChecking/Monad/State.hs b/src/full/Agda/TypeChecking/Monad/State.hs
index 0be0d8d..b3f80f0 100644
--- a/src/full/Agda/TypeChecking/Monad/State.hs
+++ b/src/full/Agda/TypeChecking/Monad/State.hs
@@ -1,7 +1,10 @@
+{-# LANGUAGE CPP #-}
+
-- | Lenses for 'TCState' and more.
module Agda.TypeChecking.Monad.State where
+import Control.Arrow ((***), first, second)
import Control.Applicative
import qualified Control.Exception as E
import Control.Monad.State
@@ -18,14 +21,20 @@ import Agda.Syntax.Scope.Base
import qualified Agda.Syntax.Concrete.Name as C
import Agda.Syntax.Abstract (PatternSynDefn, PatternSynDefns)
import Agda.Syntax.Abstract.Name
+import Agda.Syntax.Internal
import Agda.TypeChecking.Monad.Base
import Agda.TypeChecking.Monad.Base.Benchmark
import {-# SOURCE #-} Agda.TypeChecking.Monad.Options
import Agda.Utils.Hash
+import qualified Agda.Utils.HashMap as HMap
import Agda.Utils.Monad (bracket_)
import Agda.Utils.Pretty
+import Agda.Utils.Tuple
+
+#include "../../undefined.h"
+import Agda.Utils.Impossible
-- | Resets the non-persistent part of the type checking state.
@@ -115,6 +124,66 @@ printScope tag v s = verboseS ("scope." ++ tag) v $ do
reportSDoc ("scope." ++ tag) v $ return $ vcat [ text s, text $ show scope ]
---------------------------------------------------------------------------
+-- * Signature
+---------------------------------------------------------------------------
+
+-- ** Lens for 'stSignature' and 'stImports'
+
+modifySignature :: (Signature -> Signature) -> TCM ()
+modifySignature f = modify $ \s -> s { stSignature = f $ stSignature s }
+
+modifyImportedSignature :: (Signature -> Signature) -> TCM ()
+modifyImportedSignature f = modify $ \s -> s { stImports = f $ stImports s }
+
+getSignature :: TCM Signature
+getSignature = gets stSignature
+
+getImportedSignature :: TCM Signature
+getImportedSignature = gets stImports
+
+setSignature :: Signature -> TCM ()
+setSignature sig = modifySignature $ const sig
+
+setImportedSignature :: Signature -> TCM ()
+setImportedSignature sig = modify $ \s -> s { stImports = sig }
+
+-- | Run some computation in a different signature, restore original signature.
+withSignature :: Signature -> TCM a -> TCM a
+withSignature sig m = do
+ sig0 <- getSignature
+ setSignature sig
+ r <- m
+ setSignature sig0
+ return r
+
+-- ** Modifiers for parts of the signature
+
+lookupDefinition :: QName -> Signature -> Maybe Definition
+lookupDefinition q sig = HMap.lookup q $ sigDefinitions sig
+
+updateDefinition :: QName -> (Definition -> Definition) -> Signature -> Signature
+updateDefinition q f sig = sig { sigDefinitions = HMap.adjust f q (sigDefinitions sig) }
+
+updateTheDef :: (Defn -> Defn) -> (Definition -> Definition)
+updateTheDef f def = def { theDef = f (theDef def) }
+
+updateDefType :: (Type -> Type) -> (Definition -> Definition)
+updateDefType f def = def { defType = f (defType def) }
+
+updateDefArgOccurrences :: ([Occurrence] -> [Occurrence]) -> (Definition -> Definition)
+updateDefArgOccurrences f def = def { defArgOccurrences = f (defArgOccurrences def) }
+
+updateDefPolarity :: ([Polarity] -> [Polarity]) -> (Definition -> Definition)
+updateDefPolarity f def = def { defPolarity = f (defPolarity def) }
+
+updateDefCompiledRep :: (CompiledRepresentation -> CompiledRepresentation) -> (Definition -> Definition)
+updateDefCompiledRep f def = def { defCompiledRep = f (defCompiledRep def) }
+
+updateFunClauses :: ([Clause] -> [Clause]) -> (Defn -> Defn)
+updateFunClauses f def at Function{ funClauses = cs} = def { funClauses = f cs }
+updateFunClauses f _ = __IMPOSSIBLE__
+
+---------------------------------------------------------------------------
-- * Top level module
---------------------------------------------------------------------------
@@ -238,3 +307,49 @@ freshTCM m = do
-- Keep only the benchmark info from the final state of the subcomp.
modifyBenchmark $ const $ theBenchmark s
return $ Right a
+
+---------------------------------------------------------------------------
+-- * Instance definitions
+---------------------------------------------------------------------------
+
+-- | Look through the signature and reconstruct the instance table.
+addSignatureInstances :: Signature -> TCM ()
+addSignatureInstances sig = do
+ let itable = Map.fromListWith (++)
+ [ (c, [i]) | (i, Defn{ defInstance = Just c }) <- HMap.toList $ sigDefinitions sig ]
+ modifyInstanceDefs $ first $ Map.unionWith (++) itable
+
+-- | Lens for 'stInstanceDefs'.
+updateInstanceDefs :: (TempInstanceTable -> TempInstanceTable) -> (TCState -> TCState)
+updateInstanceDefs f s = s { stInstanceDefs = f $ stInstanceDefs s }
+
+modifyInstanceDefs :: (TempInstanceTable -> TempInstanceTable) -> TCM ()
+modifyInstanceDefs = modify . updateInstanceDefs
+
+getAllInstanceDefs :: TCM TempInstanceTable
+getAllInstanceDefs = gets stInstanceDefs
+
+getAnonInstanceDefs :: TCM [QName]
+getAnonInstanceDefs = snd <$> getAllInstanceDefs
+
+-- | Remove all instances whose type is still unresolved.
+clearAnonInstanceDefs :: TCM ()
+clearAnonInstanceDefs = modifyInstanceDefs $ mapSnd $ const []
+
+-- | Add an instance whose type is still unresolved.
+addUnknownInstance :: QName -> TCM ()
+addUnknownInstance x = do
+ reportSLn "tc.decl.instance" 10 $ "adding definition " ++ show x ++ " to the instance table (the type is not yet known)"
+ modifyInstanceDefs $ mapSnd (x:)
+
+-- | Add instance to some ``class''.
+addNamedInstance
+ :: QName -- ^ Name of the instance.
+ -> QName -- ^ Name of the class.
+ -> TCM ()
+addNamedInstance x n = do
+ reportSLn "tc.decl.instance" 10 $ ("adding definition " ++ show x ++ " to instance table for " ++ show n)
+ -- Mark x as instance for n.
+ modifySignature $ updateDefinition x $ \ d -> d { defInstance = Just n }
+ -- Add x to n's instances.
+ modifyInstanceDefs $ mapFst $ Map.insertWith (++) n [x]
diff --git a/src/full/Agda/TypeChecking/Monad/Trace.hs b/src/full/Agda/TypeChecking/Monad/Trace.hs
index 2d06d72..c6d1436 100644
--- a/src/full/Agda/TypeChecking/Monad/Trace.hs
+++ b/src/full/Agda/TypeChecking/Monad/Trace.hs
@@ -1,14 +1,19 @@
module Agda.TypeChecking.Monad.Trace where
+import Prelude hiding (null)
+
import Control.Monad.Reader
+import {-# SOURCE #-} Agda.Interaction.Highlighting.Generate
+ (highlightAsTypeChecked)
+
import Agda.Syntax.Position
import Agda.TypeChecking.Monad.Base
-import Agda.Utils.Monad
-import {-# SOURCE #-} Agda.Interaction.Highlighting.Generate
- (highlightAsTypeChecked)
+import Agda.Utils.Function
+import Agda.Utils.Monad
+import Agda.Utils.Null
---------------------------------------------------------------------------
-- * Trace
@@ -91,9 +96,7 @@ traceCallCPS_ mkCall ret cc =
traceCallCPS mkCall (const ret) (\k -> cc $ k ())
getCurrentRange :: TCM Range
-getCurrentRange = envRange <$> ask
+getCurrentRange = asks envRange
setCurrentRange :: Range -> TCM a -> TCM a
-setCurrentRange r
- | r == noRange = id
- | otherwise = traceCall (SetRange r)
+setCurrentRange r = applyUnless (null r) $ traceCall $ SetRange r
diff --git a/src/full/Agda/TypeChecking/Patterns/Abstract.hs b/src/full/Agda/TypeChecking/Patterns/Abstract.hs
index 2820cee..3524913 100644
--- a/src/full/Agda/TypeChecking/Patterns/Abstract.hs
+++ b/src/full/Agda/TypeChecking/Patterns/Abstract.hs
@@ -1,6 +1,5 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeSynonymInstances #-}
diff --git a/src/full/Agda/TypeChecking/Polarity.hs b/src/full/Agda/TypeChecking/Polarity.hs
index 1b1c868..74db82b 100644
--- a/src/full/Agda/TypeChecking/Polarity.hs
+++ b/src/full/Agda/TypeChecking/Polarity.hs
@@ -388,6 +388,7 @@ instance HasPolarity Term where
MetaV _ ts -> map (const Invariant) <$> polarities i ts
Shared p -> polarities i $ derefPtr p
DontCare t -> polarities i t -- return []
+ ExtLam{} -> __IMPOSSIBLE__
instance HasPolarity Level where
polarities i (Max as) = polarities i as
diff --git a/src/full/Agda/TypeChecking/Positivity.hs b/src/full/Agda/TypeChecking/Positivity.hs
index 548912e..ef09a85 100644
--- a/src/full/Agda/TypeChecking/Positivity.hs
+++ b/src/full/Agda/TypeChecking/Positivity.hs
@@ -103,6 +103,7 @@ checkStrictlyPositive qs = disableDestructiveUpdate $ do
, prettyTCM how
]
unguardedRecord q
+ checkInduction q
-- otherwise, if the record is recursive, mark it as well
Nothing -> forM_ (take 1 [ how | Edge GuardPos how <- loops ]) $ \ how -> do
reportSDoc "tc.pos.record" 5 $ sep
@@ -110,6 +111,16 @@ checkStrictlyPositive qs = disableDestructiveUpdate $ do
, prettyTCM how
]
recursiveRecord q
+ checkInduction q
+
+ checkInduction q = do
+ -- Check whether the recursive record has been declared as
+ -- 'Inductive' or 'Coinductive'. Otherwise, error.
+ unlessM (isJust . recInduction . theDef <$> getConstInfo q) $ do
+ traceCall (SetRange $ nameBindingSite $ qnameName q) $ do
+ typeError . GenericDocError =<<
+ text "Recursive record" <+> prettyTCM q <+>
+ text "needs to be declared as either inductive or coinductive"
occ (Edge o _) = o
@@ -415,6 +426,7 @@ instance ComputeOccurrences Term where
Sort{} -> return $ Map.empty
DontCare _ -> return $ Map.empty -- Andreas, 2011-09-09: do we need to check for negative occurrences in irrelevant positions?
Shared p -> occurrences $ derefPtr p
+ ExtLam{} -> __IMPOSSIBLE__
where
-- Apparently some development version of GHC chokes if the
-- following line is replaced by vs ! i.
diff --git a/src/full/Agda/TypeChecking/Pretty.hs b/src/full/Agda/TypeChecking/Pretty.hs
index 7044f3e..3a938a0 100644
--- a/src/full/Agda/TypeChecking/Pretty.hs
+++ b/src/full/Agda/TypeChecking/Pretty.hs
@@ -218,7 +218,11 @@ instance PrettyTCM Constraint where
OpenIFS{} -> __IMPOSSIBLE__
InstS{} -> __IMPOSSIBLE__
InstV{} -> __IMPOSSIBLE__
- FindInScope m cands -> 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
t <- getMetaType m
sep [ text $ "Find in scope " ++ (show m) ++ " :"
, nest 2 $ prettyTCM t
@@ -291,3 +295,12 @@ instance PrettyTCM Pattern where
prettyTCM c <+> fsep (map (showPat . namedArg) ps) <+> text ":" <+> prettyTCM t
showPat (LitP l) = text (show l)
showPat (ProjP q) = text (show q)
+
+instance PrettyTCM RewriteRule where
+ prettyTCM (RewriteRule q gamma lhs rhs b) = inTopContext $ do
+ prettyTCM q <+> text " rule " <+> do
+ prettyTCM gamma <+> text " |- " <+> do
+ addContext gamma $ do
+ prettyTCM lhs <+> text " --> " <+> do
+ prettyTCM rhs <+> text " : " <+> do
+ prettyTCM b
diff --git a/src/full/Agda/TypeChecking/Primitive.hs b/src/full/Agda/TypeChecking/Primitive.hs
index bf0571c..83669f7 100644
--- a/src/full/Agda/TypeChecking/Primitive.hs
+++ b/src/full/Agda/TypeChecking/Primitive.hs
@@ -102,7 +102,10 @@ instance PrimTerm a => PrimTerm (IO a) where
-- From Agda term to Haskell value
class ToTerm a where
- toTerm :: TCM (a -> Term)
+ toTerm :: TCM (a -> Term)
+ toTermR :: TCM (a -> ReduceM Term)
+
+ toTermR = (pure .) <$> toTerm
instance ToTerm Integer where toTerm = return $ Lit . LitInt noRange
instance ToTerm Nat where toTerm = return $ Lit . LitInt noRange . unNat
@@ -118,8 +121,35 @@ instance ToTerm Bool where
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
+
instance ToTerm Type where
- toTerm = snd <$> quotingKit
+ toTerm = do (_, f, _) <- quotingKit; runReduceF f
+ toTermR = do (_, f, _) <- quotingKit; return f
+
+instance ToTerm I.ArgInfo where
+ toTerm = do
+ info <- primArgArgInfo
+ vis <- primVisible
+ hid <- primHidden
+ ins <- primInstance
+ rel <- primRelevant
+ irr <- primIrrelevant
+ return $ \(ArgInfo h r _) ->
+ apply info $ map defaultArg
+ [ case h of
+ NotHidden -> vis
+ Hidden -> hid
+ Instance -> ins
+ , case r of
+ Relevant -> rel
+ Irrelevant -> irr
+ NonStrict -> rel
+ Forced -> irr
+ UnusedArg -> irr
+ ]
-- | @buildList A ts@ builds a list of type @List A at . Assumes that the terms
-- @ts@ all have type @A at .
@@ -298,21 +328,30 @@ primQNameType = mkPrimFun1TCM (el primQName --> el primAgdaType)
primQNameDefinition :: TCM PrimitiveImpl
primQNameDefinition = do
- agdaFunDef <- primAgdaDefinitionFunDef
+ (_, qType, qClause) <- quotingKit
+ agdaFunDef <- primAgdaFunDef
+ agdaFunDefCon <- primAgdaFunDefCon
agdaDefinitionFunDef <- primAgdaDefinitionFunDef
agdaDefinitionDataDef <- primAgdaDefinitionDataDef
agdaDefinitionRecordDef <- primAgdaDefinitionRecordDef
agdaDefinitionPostulate <- primAgdaDefinitionPostulate
agdaDefinitionPrimitive <- primAgdaDefinitionPrimitive
agdaDefinitionDataConstructor <- primAgdaDefinitionDataConstructor
-
- let argQName qn = [defaultArg (Lit (LitQName noRange qn))]
- con qn Function{} = apply agdaDefinitionFunDef (argQName qn)
- con qn Datatype{} = apply agdaDefinitionDataDef (argQName qn)
- con qn Record{} = apply agdaDefinitionRecordDef (argQName qn)
- con _ Axiom{} = apply agdaDefinitionPostulate []
- con _ Primitive{} = apply agdaDefinitionPrimitive []
- con _ Constructor{} = apply agdaDefinitionDataConstructor []
+ list <- buildList
+
+ let 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
+ def <- getConstInfo qn
+ case theDef def of
+ Function{funClauses = cs}
+ -> defapp agdaDefinitionFunDef [qFunDef (defType def) cs]
+ Datatype{} -> defapp agdaDefinitionDataDef [pure $ qQName qn]
+ Record{} -> defapp agdaDefinitionRecordDef [pure $ qQName qn]
+ Axiom{} -> defapp agdaDefinitionPostulate []
+ Primitive{} -> defapp agdaDefinitionPrimitive []
+ Constructor{} -> defapp agdaDefinitionDataConstructor []
unquoteQName <- fromTerm
t <- el primQName --> el primAgdaDefinition
@@ -321,7 +360,7 @@ primQNameDefinition = do
[v] ->
redBind (unquoteQName v)
(\v' -> [v']) $ \x ->
- redReturn =<< (con x . theDef <$> getConstInfo x)
+ redReturn =<< con x
_ -> __IMPOSSIBLE__
primDataConstructors :: TCM PrimitiveImpl
@@ -352,14 +391,14 @@ mkPrimLevelMax = do
mkPrimFun1TCM :: (FromTerm a, ToTerm b) => TCM Type -> (a -> ReduceM b) -> TCM PrimitiveImpl
mkPrimFun1TCM mt f = do
toA <- fromTerm
- fromB <- toTerm
+ fromB <- toTermR
t <- mt
return $ PrimImpl t $ PrimFun __IMPOSSIBLE__ 1 $ \ts ->
case ts of
[v] ->
redBind (toA v)
(\v' -> [v']) $ \x ->
- redReturn . fromB =<< f x
+ redReturn =<< fromB =<< f x
_ -> __IMPOSSIBLE__
-- Tying the knot
@@ -544,6 +583,7 @@ primitiveFunctions = Map.fromList
, "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)
diff --git a/src/full/Agda/TypeChecking/ProjectionLike.hs b/src/full/Agda/TypeChecking/ProjectionLike.hs
index 3d9f38b..bc8d598 100644
--- a/src/full/Agda/TypeChecking/ProjectionLike.hs
+++ b/src/full/Agda/TypeChecking/ProjectionLike.hs
@@ -144,7 +144,7 @@ makeProjection x = inTopContext $ do
]
case theDef defn of
Function{funClauses = cls}
- | any (isNothing . getBody) cls ->
+ | any (isNothing . getBodyUnraised) cls ->
reportSLn "tc.proj.like" 30 $ " projection-like functions cannot have absurd clauses"
-- Constructor-headed functions can't be projection-like (at the moment). The reason
-- for this is that invoking constructor-headedness will circumvent the inference of
diff --git a/src/full/Agda/TypeChecking/Quote.hs b/src/full/Agda/TypeChecking/Quote.hs
index 1cdd20d..fa554f5 100644
--- a/src/full/Agda/TypeChecking/Quote.hs
+++ b/src/full/Agda/TypeChecking/Quote.hs
@@ -1,108 +1,173 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# 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 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.Translation.InternalToAbstract
import {-# SOURCE #-} Agda.TypeChecking.Datatypes
import Agda.TypeChecking.Monad
import Agda.TypeChecking.Monad.Builtin
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.Impossible
-quotingKit :: TCM ((Term -> Term), (Type -> Term))
+quotingKit :: TCM (Term -> ReduceM Term, Type -> ReduceM Term, Clause -> ReduceM Term)
quotingKit = do
- hidden <- primHidden
- instanceH <- primInstance
- visible <- primVisible
- relevant <- primRelevant
- irrelevant <- primIrrelevant
- nil <- primNil
- cons <- primCons
- arg <- primArgArg
- arginfo <- primArgArgInfo
- var <- primAgdaTermVar
- lam <- primAgdaTermLam
- def <- primAgdaTermDef
- con <- primAgdaTermCon
- pi <- primAgdaTermPi
- sort <- primAgdaTermSort
- set <- primAgdaSortSet
- setLit <- primAgdaSortLit
+ hidden <- primHidden
+ instanceH <- primInstance
+ visible <- primVisible
+ relevant <- primRelevant
+ irrelevant <- primIrrelevant
+ nil <- primNil
+ cons <- primCons
+ arg <- primArgArg
+ arginfo <- primArgArgInfo
+ var <- primAgdaTermVar
+ lam <- primAgdaTermLam
+ extlam <- primAgdaTermExtLam
+ def <- primAgdaTermDef
+ con <- primAgdaTermCon
+ pi <- primAgdaTermPi
+ sort <- primAgdaTermSort
+ lit <- primAgdaTermLit
+ litNat <- primAgdaLitNat
+ litFloat <- primAgdaLitFloat
+ litChar <- primAgdaLitChar
+ litString <- primAgdaLitString
+ litQName <- primAgdaLitQName
+ normalClause <- primAgdaClauseClause
+ absurdClause <- primAgdaClauseAbsurd
+ varP <- primAgdaPatVar
+ conP <- primAgdaPatCon
+ dotP <- primAgdaPatDot
+ litP <- primAgdaPatLit
+ projP <- primAgdaPatProj
+ absurdP <- primAgdaPatAbsurd
+ set <- primAgdaSortSet
+ setLit <- primAgdaSortLit
unsupportedSort <- primAgdaSortUnsupported
- sucLevel <- primLevelSuc
- lub <- primLevelMax
- el <- primAgdaTypeEl
- Con z _ <- ignoreSharing <$> primZero
- Con s _ <- ignoreSharing <$> primSuc
- unsupported <- primAgdaTermUnsupported
- let t @@ u = apply t [defaultArg u]
- quoteHiding Hidden = hidden
- quoteHiding Instance = instanceH
- quoteHiding NotHidden = visible
- quoteRelevance Relevant = relevant
- quoteRelevance Irrelevant = irrelevant
- quoteRelevance NonStrict = relevant
- quoteRelevance Forced = relevant
- quoteRelevance UnusedArg = relevant
+ sucLevel <- primLevelSuc
+ lub <- primLevelMax
+ lkit <- requireLevels
+ el <- primAgdaTypeEl
+ Con z _ <- ignoreSharing <$> primZero
+ Con s _ <- ignoreSharing <$> primSuc
+ unsupported <- primAgdaTermUnsupported
+
+ let (@@) :: Apply a => ReduceM a -> ReduceM Term -> ReduceM a
+ t @@ u = apply <$> t <*> ((:[]) . defaultArg <$> u)
+
+ (!@) :: Apply a => a -> ReduceM Term -> ReduceM a
+ t !@ u = pure t @@ u
+
+ (!@!) :: Apply a => a -> Term -> ReduceM a
+ t !@! u = pure t @@ pure u
+
+ quoteHiding Hidden = pure hidden
+ quoteHiding Instance = pure instanceH
+ quoteHiding NotHidden = pure visible
+ quoteRelevance Relevant = pure relevant
+ quoteRelevance Irrelevant = pure irrelevant
+ quoteRelevance NonStrict = pure relevant
+ quoteRelevance Forced = pure relevant
+ quoteRelevance UnusedArg = pure relevant
quoteColors _ = nil -- TODO guilhem
- quoteArgInfo (ArgInfo h r cs) = arginfo @@ quoteHiding h
+ quoteArgInfo (ArgInfo h r cs) = arginfo !@ quoteHiding h
@@ quoteRelevance r
-- @@ quoteColors cs
- quoteLit (LitInt _ n) = iterate suc zero !! fromIntegral n
- quoteLit _ = unsupported
+ 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 (Max []) = setLit @@ Lit (LitInt noRange 0)
- quoteSortLevelTerm (Max [ClosedLevel n]) = setLit @@ Lit (LitInt noRange n)
- quoteSortLevelTerm (Max [Plus 0 (NeutralLevel v)]) = set @@ quote v
- quoteSortLevelTerm _ = unsupportedSort
+ 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 = unsupportedSort
- quoteSort Inf = unsupportedSort
- quoteSort DLub{} = unsupportedSort
- quoteType (El s t) = el @@ quoteSort s @@ quote t
- list [] = nil
- list (a : as) = cons @@ a @@ list as
- zero = con @@ quoteConName z @@ nil
- suc n = con @@ quoteConName s @@ list [arg @@ quoteArgInfo defaultArgInfo @@ n]
- quoteDom q (Dom info t) = arg @@ quoteArgInfo info @@ q t
- quoteArg q (Arg info t) = arg @@ quoteArgInfo info @@ q t
+ quoteSort Prop = pure unsupportedSort
+ quoteSort Inf = pure unsupportedSort
+ quoteSort DLub{} = pure unsupportedSort
+ quoteType (El s t) = el !@ quoteSort s @@ quote t
+
+ quoteQName x = pure $ Lit $ LitQName noRange x
+ quotePats ps = list $ map (quoteArg quotePat . fmap namedThing) ps
+ 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 (Bind b) = quoteBody (absBody b)
+ quoteBody NoBody = Nothing
+ quoteClause Clause{namedClausePats = ps, clauseBody = body} =
+ case quoteBody body of
+ Nothing -> absurdClause !@ quotePats ps
+ Just b -> normalClause !@ quotePats ps @@ b
+
+ list [] = pure nil
+ list (a : as) = cons !@ a @@ list as
+ quoteDom q (Dom info t) = arg !@ quoteArgInfo info @@ q t
+ quoteArg q (Arg info t) = arg !@ quoteArgInfo info @@ q t
quoteArgs ts = list (map (quoteArg quote) ts)
quote 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)
- (Def x es) ->
+ Var n es ->
let ts = fromMaybe __IMPOSSIBLE__ $ allApplyElims es
- in def @@ quoteName x @@ quoteArgs ts
- (Con x ts) -> con @@ quoteConName x @@ quoteArgs ts
- (Pi t u) -> pi @@ quoteDom quoteType t
- @@ quoteType (absBody u)
- (Level _) -> unsupported
- (Lit lit) -> quoteLit lit
- (Sort s) -> sort @@ quoteSort s
- (Shared p) -> quote $ derefPtr p
- MetaV{} -> unsupported
- DontCare{} -> unsupported -- could be exposed at some point but we have to take care
- return (quote, quoteType)
+ in var !@! Lit (LitInt noRange $ fromIntegral n) @@ quoteArgs ts
+ Lam info t -> lam !@ quoteHiding (getHiding info) @@ quote (absBody t)
+ Def x es -> do
+ d <- theDef <$> getConstInfo x
+ qx d @@ quoteArgs ts
+ where
+ ts = fromMaybe __IMPOSSIBLE__ $ allApplyElims es
+ qx Function{ funExtLam = Just (h, nh), funClauses = cs } =
+ extlam !@ list (map (quoteClause . dropArgs (h + nh)) cs)
+ qx Function{ funCompiled = Just Fail, funClauses = [cl] } =
+ extlam !@ list [quoteClause $ dropArgs (length (clausePats cl) - 1) cl]
+ qx _ = def !@! quoteName x
+ Con x ts -> con !@! quoteConName x @@ quoteArgs ts
+ Pi t u -> pi !@ quoteDom quoteType t
+ @@ quoteType (absBody u)
+ Level _ -> pure unsupported
+ Lit lit -> quoteLit lit
+ Sort s -> sort !@ quoteSort s
+ Shared p -> quote $ 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)
quoteName :: QName -> Term
quoteName x = Lit (LitQName noRange x)
@@ -111,10 +176,14 @@ quoteConName :: ConHead -> Term
quoteConName = quoteName . conName
quoteTerm :: Term -> TCM Term
-quoteTerm v = ($v) . fst <$> quotingKit
+quoteTerm v = do
+ (f, _, _) <- quotingKit
+ runReduceM (f v)
quoteType :: Type -> TCM Term
-quoteType v = ($v) . snd <$> quotingKit
+quoteType v = do
+ (_, f, _) <- quotingKit
+ runReduceM (f v)
agdaTermType :: TCM Type
agdaTermType = El (mkType 0) <$> primAgdaTerm
@@ -152,6 +221,37 @@ 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
@@ -184,6 +284,27 @@ instance Unquote Integer where
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
@@ -233,11 +354,10 @@ instance Unquote QName where
_ -> unquoteFailed "QName" "not a literal qname value" t
instance Unquote ConHead where
- unquote t = getConHead =<< unquote t
+ unquote t = getConHead =<< ensureCon =<< unquote t
instance Unquote a => Unquote (Abs a) where
- unquote t = do x <- freshNoName_ -- Andreas, 2014-07-11 This is pointless, as it does NOT generate a name suggestion.
- Abs (nameToArgName x) <$> unquote t
+ unquote t = Abs "_" <$> unquote t
instance Unquote Sort where
unquote t = do
@@ -245,8 +365,8 @@ instance Unquote Sort where
case ignoreSharing t of
Con c [] -> do
choice
- [(c `isCon` primAgdaSortUnsupported, unquoteFailed "Sort" "unsupported sort" t)]
- (unquoteFailed "Sort" "arity 0 and not the `unsupported' constructor" t)
+ [(c `isCon` primAgdaSortUnsupported, pure $ Type $ Max [Plus 0 $ UnreducedLevel $ hackReifyToMeta])]
+ __IMPOSSIBLE__
Con c [u] -> do
choice
[(c `isCon` primAgdaSortSet, Type <$> unquoteN u)
@@ -267,29 +387,134 @@ instance Unquote Type where
(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, unquoteFailed "Term" "unsupported term" t)]
+ [(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)]
- (unquoteFailed "Term" "arity 1 and not the `sort' constructor" t)
+ [ (c `isCon` primAgdaTermSort, Sort <$> unquoteN x)
+ , (c `isCon` primAgdaTermLit, Lit <$> unquoteN x) ]
+ (unquoteFailed "Term" "bad constructor" t)
- Con c [x,y] ->
+ 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 <$> unquoteN x <*> unquoteN y)
- ,(c `isCon` primAgdaTermLam, Lam <$> (flip setHiding defaultArgInfo <$> unquoteN x) <*> unquoteN y)
- ,(c `isCon` primAgdaTermPi, Pi <$> (domFromArg <$> unquoteN x) <*> unquoteN y)]
- (unquoteFailed "Term" "arity 2 and none of Var, Con, Def, Lam, Pi" t)
+ [ (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
+
diff --git a/src/full/Agda/TypeChecking/Records.hs b/src/full/Agda/TypeChecking/Records.hs
index 3b9b4a5..654c279 100644
--- a/src/full/Agda/TypeChecking/Records.hs
+++ b/src/full/Agda/TypeChecking/Records.hs
@@ -192,7 +192,7 @@ isEtaCon c = do
-- | Check if a name refers to a record which is not coinductive. (Projections are then size-preserving)
isInductiveRecord :: QName -> TCM Bool
-isInductiveRecord r = maybe False (\ d -> recInduction d == Inductive || not (recRecursive d)) <$> isRecord r
+isInductiveRecord r = maybe False (\ d -> recInduction d /= Just CoInductive || not (recRecursive d)) <$> isRecord r
-- | Check if a type is an eta expandable record and return the record identifier and the parameters.
isEtaRecordType :: Type -> TCM (Maybe (QName, Args))
diff --git a/src/full/Agda/TypeChecking/Reduce.hs b/src/full/Agda/TypeChecking/Reduce.hs
index 2409e0b..fd4026e 100644
--- a/src/full/Agda/TypeChecking/Reduce.hs
+++ b/src/full/Agda/TypeChecking/Reduce.hs
@@ -297,6 +297,7 @@ instance Reduce Term where
Var _ _ -> done
Lam _ _ -> done
DontCare _ -> done
+ ExtLam{} -> __IMPOSSIBLE__
Shared{} -> __IMPOSSIBLE__ -- updateSharedTermF reduceB' v
where
-- NOTE: reduceNat can traverse the entire term.
@@ -379,7 +380,7 @@ unfoldDefinition' unfoldDelayed keepGoing v0 f es =
(isJust (isProjection_ def) && ProjectionReductions `elem` allowed) -- includes projection-like
then
reduceNormalE keepGoing v0 f (map notReduced es)
- (defDelayed info) (defNonterminating info)
+ (defDelayed info) (notElem NonTerminatingReductions allowed && defNonterminating info)
(defClauses info) (defCompiled info)
else retSimpl $ notBlocked v
@@ -595,7 +596,7 @@ appDefE' v cls es = goCls cls $ map ignoreReduced es
DontKnow Nothing -> cantReduce es
DontKnow (Just m) -> return $ NoReduction $ blocked m $ v `applyE` es
Yes simpl vs -- vs is the subst. for the variables bound in body
- | isJust (getBody body) -- clause has body?
+ | isJust (getBodyUnraised body) -- clause has body?
-> return $ YesReduction simpl $
-- TODO: let matchPatterns also return the reduced forms
-- of the original arguments!
@@ -690,6 +691,7 @@ instance Simplify Term where
Var i vs -> Var i <$> simplify' vs
Lam h v -> Lam h <$> simplify' v
DontCare v -> dontCare <$> simplify' v
+ ExtLam{} -> __IMPOSSIBLE__
Shared{} -> __IMPOSSIBLE__ -- updateSharedTerm simplify' v
simplifyBlocked' :: Simplify t => Blocked t -> ReduceM t
@@ -837,6 +839,7 @@ instance Normalise Term where
Sort s -> sortTm <$> normalise' s
Pi a b -> uncurry Pi <$> normalise' (a,b)
Shared{} -> __IMPOSSIBLE__ -- updateSharedTerm normalise' v
+ ExtLam{} -> __IMPOSSIBLE__
DontCare _ -> return v
instance Normalise Elim where
@@ -979,6 +982,7 @@ instance InstantiateFull Term where
Sort s -> sortTm <$> instantiateFull' s
Pi a b -> uncurry Pi <$> instantiateFull' (a,b)
Shared{} -> __IMPOSSIBLE__ -- updateSharedTerm instantiateFull' v
+ ExtLam{} -> __IMPOSSIBLE__
DontCare v -> dontCare <$> instantiateFull' v
instance InstantiateFull Level where
@@ -1095,9 +1099,17 @@ instance InstantiateFull Char where
instantiateFull' = return
instance InstantiateFull Definition where
- instantiateFull' (Defn rel x t pol occ df i c d) = do
- (t, (df, d)) <- instantiateFull' (t, (df, d))
- return $ Defn rel x t pol occ df i c d
+ instantiateFull' (Defn rel x t pol occ df i c rew inst d) = do
+ (t, (df, d, rew)) <- instantiateFull' (t, (df, d, rew))
+ return $ Defn rel x t pol occ df i c rew inst d
+
+instance InstantiateFull RewriteRule where
+ instantiateFull' (RewriteRule q gamma lhs rhs t) =
+ RewriteRule q
+ <$> instantiateFull' gamma
+ <*> instantiateFull' lhs
+ <*> instantiateFull' rhs
+ <*> instantiateFull' t
instance InstantiateFull a => InstantiateFull (Open a) where
instantiateFull' (OpenThing n a) = OpenThing n <$> instantiateFull' a
diff --git a/src/full/Agda/TypeChecking/Reduce/Monad.hs b/src/full/Agda/TypeChecking/Reduce/Monad.hs
index fd22dda..2215677 100644
--- a/src/full/Agda/TypeChecking/Reduce/Monad.hs
+++ b/src/full/Agda/TypeChecking/Reduce/Monad.hs
@@ -1,6 +1,5 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TupleSections #-}
module Agda.TypeChecking.Reduce.Monad
diff --git a/src/full/Agda/TypeChecking/Rewriting.hs b/src/full/Agda/TypeChecking/Rewriting.hs
new file mode 100644
index 0000000..8fd319a
--- /dev/null
+++ b/src/full/Agda/TypeChecking/Rewriting.hs
@@ -0,0 +1,215 @@
+{-# LANGUAGE CPP #-}
+
+-- | Rewriting with arbitrary rules.
+--
+-- The user specifies a relation symbol by the pragma
+-- @
+-- {-# BUILTIN REWRITE rel #-}
+-- @
+-- where @rel@ should be of type @Δ → (lhs rhs : A) → Set i at .
+--
+-- Then the user can add rewrite rules by the pragma
+-- @
+-- {-# REWRITE q #-}
+-- @
+-- where @q@ should be a closed term of type @Γ → rel us lhs rhs at .
+--
+-- We then intend to add a rewrite rule
+-- @
+-- Γ ⊢ lhs ↦ rhs : B
+-- @
+-- to the signature where @B = A[us/Δ]@.
+--
+-- To this end, we normalize @lhs@, which should be of the form
+-- @
+-- f ts
+-- @
+-- for a @'Def'@-symbol f (postulate, function, data, record, constructor).
+-- Further, @FV(ts) = dom(Γ)@.
+-- The rule @q :: Γ ⊢ f ts ↦ rhs : B@ is added to the signature
+-- to the definition of @f at .
+--
+-- When reducing a term @Ψ ⊢ f vs@ is stuck, we try the rewrites for @f@,
+-- by trying to unify @vs@ with @ts at .
+-- This is for now done by substituting fresh metas Xs for the bound
+-- variables in @ts@ and checking equality with @vs@
+-- @
+-- Ψ ⊢ (f ts)[Xs/Γ] = f vs : B[Xs/Γ]
+-- @
+-- If successful (no open metas/constraints), we replace @f vs@ by
+-- @rhs[Xs/Γ]@ and continue reducing.
+
+module Agda.TypeChecking.Rewriting where
+
+import Control.Monad
+import Control.Monad.Reader (local)
+
+import Agda.Syntax.Common
+import Agda.Syntax.Internal as I
+
+import Agda.TypeChecking.Monad
+import Agda.TypeChecking.Monad.Builtin
+import Agda.TypeChecking.EtaContract
+import Agda.TypeChecking.MetaVars
+import Agda.TypeChecking.Conversion
+import Agda.TypeChecking.Pretty
+import Agda.TypeChecking.Reduce
+import Agda.TypeChecking.Substitute
+import Agda.TypeChecking.Telescope
+
+import Agda.Utils.Maybe
+import Agda.Utils.Monad
+import Agda.Utils.Size
+
+#include "../undefined.h"
+import Agda.Utils.Impossible
+
+-- | Check that the name given to the BUILTIN REWRITE is actually
+-- a relation symbol.
+-- I.e., its type should be of the form @Δ → (lhs rhs : A) → Set ℓ@.
+-- Note: we do not care about hiding/non-hiding of lhs and rhs.
+verifyBuiltinRewrite :: Term -> Type -> TCM ()
+verifyBuiltinRewrite v t = do
+ let failure reason = typeError . GenericDocError =<< sep
+ [ prettyTCM v <+> text " does not have the right type for a rewriting relation"
+ , reason
+ ]
+ caseMaybeM (relView t)
+ (failure $ text "because it should accept at least two arguments") $
+ \ (RelView tel delta a b core) -> do
+ case ignoreSharing (unEl core) of
+ Sort{} -> do
+ -- Check that the types of the last two arguments are equal.
+ unlessM (tryConversion $
+ inTopContext $ addContext tel $ escapeContext 1 $
+ equalType (raise 1 a) b) $
+ failure $ text $ "because the types of the last two arguments are different"
+ Con{} -> __IMPOSSIBLE__
+ Level{} -> __IMPOSSIBLE__
+ Lam{} -> __IMPOSSIBLE__
+ Pi{} -> __IMPOSSIBLE__
+ Shared{} -> __IMPOSSIBLE__
+ _ -> failure $ text "because its type does not end in a sort, but in "
+ <+> do inTopContext $ addContext tel $ prettyTCM core
+
+-- | Deconstructing a type into @Δ → t → t' → core at .
+data RelView = RelView
+ { relViewTel :: Telescope -- ^ The whole telescope @Δ, t, t'@.
+ , relViewDelta :: ListTel -- ^ @Δ@.
+ , relViewType :: Type -- ^ @t at .
+ , relViewType' :: Type -- ^ @t'@.
+ , relViewCore :: Type -- ^ @core at .
+ }
+
+-- | Deconstructing a type into @Δ → t → t' → core at .
+-- Returns @Nothing@ if not enough argument types.
+relView :: Type -> TCM (Maybe RelView)
+relView t = do
+ TelV tel core <- telView t
+ let n = size tel
+ (delta, lastTwo) = splitAt (n - 2) $ telToList tel
+ if size lastTwo < 2 then return Nothing else do
+ let [a, b] = snd . unDom <$> lastTwo
+ return $ Just $ RelView tel delta a b core
+
+-- | Add @q : Γ → rel us lhs rhs@ as rewrite rule
+-- @
+-- Γ ⊢ lhs ↦ rhs : B
+-- @
+-- to the signature where @B = A[us/Δ]@.
+-- Remember that @rel : Δ → A → A → Set i@, so
+-- @rel us : (lhs rhs : A[us/Δ]) → Set i at .
+addRewriteRule :: QName -> TCM ()
+addRewriteRule q = do
+ let failureWrongTarget = typeError . GenericDocError =<< sep
+ [ prettyTCM q , text " does not target rewrite relation" ]
+ let failureMetas = typeError . GenericDocError =<< sep
+ [ prettyTCM q , text " is not a legal rewrite rule, since it contains unsolved meta variables" ]
+ let failureFreeVars = typeError . GenericDocError =<< sep
+ [ prettyTCM q , text " is not a legal rewrite rule, since not all variables are bound by the left hand side" ]
+ let failureIllegalRule = typeError . GenericDocError =<< sep
+ [ prettyTCM q , text " is not a legal rewrite rule" ]
+ Def rel _ <- primRewrite
+ -- We know that the type of rel is that of a relation.
+ Just (RelView _tel delta a _a' _core) <- relView =<< do
+ defType <$> getConstInfo rel
+ reportSDoc "rewriting" 30 $ do
+ text "rewrite relation at type " <+> do
+ inTopContext $ prettyTCM (telFromList delta) <+> text " |- " <+> do
+ addContext delta $ prettyTCM a
+ -- Get rewrite rule (type of q).
+ t <- defType <$> getConstInfo q
+ TelV gamma core <- telView t
+ -- Check that type of q targets rel.
+ case ignoreSharing $ unEl core of
+ Def rel' es@(_:_:_) | rel == rel' -> do
+ -- Because of the type of rel (Γ → sort), all es are applications.
+ let vs = map unArg $ fromMaybe __IMPOSSIBLE__ $ allApplyElims es
+ -- The last two arguments are lhs and rhs.
+ n = size vs
+ (us, [lhs, rhs]) = splitAt (n - 2) vs
+ unless (size delta == size us) __IMPOSSIBLE__
+ let b = applySubst (parallelS $ reverse us) a
+ -- Normalize lhs: we do not want to match redexes.
+ lhs <- etaContract =<< normalise lhs
+ -- Normalize rhs: might be more efficient.
+ rhs <- etaContract =<< normalise rhs
+ unless (null $ allMetas (telToList gamma, lhs, rhs, b)) failureMetas
+ let rew = RewriteRule q gamma lhs rhs b
+ reportSDoc "rewriting" 10 $
+ text "considering rewrite rule " <+> prettyTCM rew
+ -- Check whether lhs can be rewritten with itself.
+ -- Otherwise, there are unbound variables in either gamma or rhs.
+ addContext gamma $
+ unlessM (isJust <$> rewriteWith (Just b) lhs rew) $
+ failureFreeVars
+ -- Find head symbol f of the lhs.
+ case ignoreSharing lhs of
+ Def f _ -> do
+ -- Add rewrite rule gamma ⊢ lhs ↦ rhs : b for f.
+ addRewriteRules f [rew]
+ _ -> failureIllegalRule
+ _ -> failureWrongTarget
+
+-- | Append rewrite rules to a definition.
+addRewriteRules :: QName -> RewriteRules -> TCM ()
+addRewriteRules f rews =
+ modifySignature $ updateDefinition f $ updateRewriteRules $ (++ rews)
+
+-- | Lens for 'RewriteRules'.
+updateRewriteRules :: (RewriteRules -> RewriteRules) -> Definition -> Definition
+updateRewriteRules f def = def { defRewriteRules = f (defRewriteRules def) }
+
+-- | @rewriteWith t v rew@
+-- tries to rewrite @v : t@ with @rew@, returning the reduct if successful.
+rewriteWith :: Maybe Type -> Term -> RewriteRule -> TCM (Maybe Term)
+rewriteWith mt v (RewriteRule q gamma lhs rhs b) = do
+ xs <- newTelMeta gamma
+ let sigma = parallelS $ map unArg xs
+ (lhs', rhs', b') = applySubst sigma (lhs, rhs, b)
+ ok <- tryConversion $ do
+ -- Unify type and term with type and lhs of rewrite rule.
+ whenJust mt $ \ t -> leqType t b'
+ local (\ e -> e {envCompareBlocked = True}) $ equalTerm b' lhs' v
+ -- Check that all variables have been solved for.
+ unlessM (isInstantiatedMeta xs) $ do
+ reportSDoc "rewriting" 20 $ text "lhs variables solved with: " <+> do
+ sep $ map prettyTCM xs
+ -- The following error is caught immediately by tryConversion.
+ typeError $ GenericError $ "free variables not bound by left hand side"
+ if ok then return $ Just rhs' else return Nothing
+
+-- | @rewrite t@ tries to rewrite a reduced term.
+rewrite :: Term -> TCM (Maybe Term)
+rewrite v = do
+ case ignoreSharing v of
+ -- We only rewrite @Def at s.
+ Def f es -> do
+ -- Get the rewrite rules for f.
+ rews <- defRewriteRules <$> getConstInfo f
+ loop rews
+ where
+ loop [] = return Nothing
+ loop (rew:rews) = do
+ caseMaybeM (rewriteWith Nothing v rew) (loop rews) (return . Just)
+ _ -> return Nothing
diff --git a/src/full/Agda/TypeChecking/Rewriting.hs-boot b/src/full/Agda/TypeChecking/Rewriting.hs-boot
new file mode 100644
index 0000000..631659f
--- /dev/null
+++ b/src/full/Agda/TypeChecking/Rewriting.hs-boot
@@ -0,0 +1,7 @@
+module Agda.TypeChecking.Rewriting where
+
+import Agda.Syntax.Internal
+import Agda.TypeChecking.Monad.Base
+
+verifyBuiltinRewrite :: Term -> Type -> TCM ()
+rewrite :: Term -> TCM (Maybe Term)
diff --git a/src/full/Agda/TypeChecking/Rules/Builtin.hs b/src/full/Agda/TypeChecking/Rules/Builtin.hs
index 8769c1f..6a8defd 100644
--- a/src/full/Agda/TypeChecking/Rules/Builtin.hs
+++ b/src/full/Agda/TypeChecking/Rules/Builtin.hs
@@ -26,6 +26,7 @@ import Agda.TypeChecking.Irrelevance
import Agda.TypeChecking.Monad.SizedTypes ( builtinSizeHook )
import Agda.TypeChecking.Rules.Term ( checkExpr , inferExpr )
import {-# SOURCE #-} Agda.TypeChecking.Rules.Builtin.Coinduction
+import {-# SOURCE #-} Agda.TypeChecking.Rewriting
import Agda.Utils.Maybe
import Agda.Utils.Size
@@ -47,6 +48,17 @@ coreBuiltins = map (\ (x, z) -> BuiltinInfo x z)
, (builtinArgInfo |-> BuiltinData tset [builtinArgArgInfo])
, (builtinBool |-> BuiltinData tset [builtinTrue, builtinFalse])
, (builtinNat |-> BuiltinData tset [builtinZero, builtinSuc])
+ , (builtinAgdaLiteral |-> BuiltinData tset [builtinAgdaLitNat, builtinAgdaLitFloat,
+ builtinAgdaLitChar, builtinAgdaLitString,
+ builtinAgdaLitQName])
+ , (builtinAgdaPattern |-> BuiltinData tset [builtinAgdaPatVar, builtinAgdaPatCon, builtinAgdaPatDot,
+ builtinAgdaPatLit, builtinAgdaPatProj, builtinAgdaPatAbsurd])
+ , (builtinAgdaPatVar |-> BuiltinDataCons tpat)
+ , (builtinAgdaPatCon |-> BuiltinDataCons (tqname --> tlist (targ tpat) --> tpat))
+ , (builtinAgdaPatDot |-> BuiltinDataCons tpat)
+ , (builtinAgdaPatLit |-> BuiltinDataCons (tliteral --> tpat))
+ , (builtinAgdaPatProj |-> BuiltinDataCons (tqname --> tpat))
+ , (builtinAgdaPatAbsurd |-> BuiltinDataCons tpat)
, (builtinLevel |-> builtinPostulate tset)
, (builtinInteger |-> builtinPostulate tset)
, (builtinFloat |-> builtinPostulate tset)
@@ -57,10 +69,10 @@ coreBuiltins = map (\ (x, z) -> BuiltinInfo x z)
, (builtinAgdaSort |-> BuiltinData tset [builtinAgdaSortSet, builtinAgdaSortLit, builtinAgdaSortUnsupported])
, (builtinAgdaType |-> BuiltinData tset [builtinAgdaTypeEl])
, (builtinAgdaTerm |-> BuiltinData tset
- [builtinAgdaTermVar, builtinAgdaTermLam
- ,builtinAgdaTermDef, builtinAgdaTermCon
- ,builtinAgdaTermPi, builtinAgdaTermSort
- ,builtinAgdaTermUnsupported])
+ [ builtinAgdaTermVar, builtinAgdaTermLam, builtinAgdaTermExtLam
+ , builtinAgdaTermDef, builtinAgdaTermCon
+ , builtinAgdaTermPi, builtinAgdaTermSort
+ , builtinAgdaTermLit, builtinAgdaTermUnsupported])
, (builtinEquality |-> BuiltinData (hPi "a" (el primLevel) $
hPi "A" (return $ sort $ varSort 0) $
(El (varSort 1) <$> varM 0) -->
@@ -73,6 +85,7 @@ coreBuiltins = map (\ (x, z) -> BuiltinInfo x z)
hPi "A" (return $ sort $ varSort 0) $
hPi "x" (El (varSort 1) <$> varM 0) $
El (varSort 2) <$> primEquality <#> varM 2 <#> varM 1 <@> varM 0 <@> varM 0))
+ , (builtinRewrite |-> BuiltinUnknown Nothing verifyBuiltinRewrite)
, (builtinNil |-> BuiltinDataCons (hPi "A" tset (el (list v0))))
, (builtinCons |-> BuiltinDataCons (hPi "A" tset (tv0 --> el (list v0) --> el (list v0))))
, (builtinZero |-> BuiltinDataCons tnat)
@@ -84,11 +97,18 @@ coreBuiltins = map (\ (x, z) -> BuiltinInfo x z)
, (builtinAgdaTypeEl |-> BuiltinDataCons (tsort --> tterm --> ttype))
, (builtinAgdaTermVar |-> BuiltinDataCons (tnat --> targs --> tterm))
, (builtinAgdaTermLam |-> BuiltinDataCons (thiding --> tterm --> tterm))
+ , (builtinAgdaTermExtLam |-> BuiltinDataCons (tlist tclause --> targs --> tterm))
, (builtinAgdaTermDef |-> BuiltinDataCons (tqname --> targs --> tterm))
, (builtinAgdaTermCon |-> BuiltinDataCons (tqname --> targs --> tterm))
, (builtinAgdaTermPi |-> BuiltinDataCons (targ ttype --> ttype --> tterm))
, (builtinAgdaTermSort |-> BuiltinDataCons (tsort --> tterm))
+ , (builtinAgdaTermLit |-> BuiltinDataCons (tliteral --> tterm))
, (builtinAgdaTermUnsupported|-> BuiltinDataCons tterm)
+ , (builtinAgdaLitNat |-> BuiltinDataCons (tnat --> tliteral))
+ , (builtinAgdaLitFloat |-> BuiltinDataCons (tfloat --> tliteral))
+ , (builtinAgdaLitChar |-> BuiltinDataCons (tchar --> tliteral))
+ , (builtinAgdaLitString |-> BuiltinDataCons (tstring --> tliteral))
+ , (builtinAgdaLitQName |-> BuiltinDataCons (tqname --> tliteral))
, (builtinHidden |-> BuiltinDataCons thiding)
, (builtinInstance |-> BuiltinDataCons thiding)
, (builtinVisible |-> BuiltinDataCons thiding)
@@ -118,7 +138,11 @@ coreBuiltins = map (\ (x, z) -> BuiltinInfo x z)
, (builtinLevelZero |-> BuiltinPrim "primLevelZero" (const $ return ()))
, (builtinLevelSuc |-> BuiltinPrim "primLevelSuc" (const $ return ()))
, (builtinLevelMax |-> BuiltinPrim "primLevelMax" verifyMax)
- , (builtinAgdaFunDef |-> builtinPostulate tset) -- internally this is QName
+ , (builtinAgdaFunDef |-> BuiltinData tset [builtinAgdaFunDefCon])
+ , (builtinAgdaFunDefCon |-> BuiltinDataCons (ttype --> tlist tclause --> tfun))
+ , (builtinAgdaClause |-> BuiltinData tset [builtinAgdaClauseClause, builtinAgdaClauseAbsurd])
+ , (builtinAgdaClauseClause |-> BuiltinDataCons (tlist (targ tpat) --> tterm --> tclause))
+ , (builtinAgdaClauseAbsurd |-> BuiltinDataCons (tlist (targ tpat) --> tclause))
, (builtinAgdaDataDef |-> builtinPostulate tset) -- internally this is QName
, (builtinAgdaRecordDef |-> builtinPostulate tset) -- internally this is QName
, (builtinAgdaDefinition |-> BuiltinData tset [builtinAgdaDefinitionFunDef
@@ -147,11 +171,15 @@ coreBuiltins = map (\ (x, z) -> BuiltinInfo x z)
arg :: TCM Term -> TCM Term
arg t = primArg <@> t
+ tlist x = el $ list (fmap unEl x)
targ x = el (arg (fmap unEl x))
targs = el (list (arg primAgdaTerm))
tterm = el primAgdaTerm
- tqname = el primQName
tnat = el primNat
+ tfloat = el primFloat
+ tchar = el primChar
+ tstring = el primString
+ tqname = el primQName
tsize = el primSize
tbool = el primBool
thiding = el primHiding
@@ -164,6 +192,9 @@ coreBuiltins = map (\ (x, z) -> BuiltinInfo x z)
tfun = el primAgdaFunDef
tdtype = el primAgdaDataDef
trec = el primAgdaRecordDef
+ tliteral = el primAgdaLiteral
+ tpat = el primAgdaPattern
+ tclause = el primAgdaClause
verifyPlus plus =
verify ["n","m"] $ \(@@) zero suc (==) (===) choice -> do
diff --git a/src/full/Agda/TypeChecking/Rules/Data.hs b/src/full/Agda/TypeChecking/Rules/Data.hs
index 704a583..421d97a 100644
--- a/src/full/Agda/TypeChecking/Rules/Data.hs
+++ b/src/full/Agda/TypeChecking/Rules/Data.hs
@@ -230,6 +230,9 @@ checkConstructor d tel nofIxs s con@(A.Axiom _ i _ c e) =
defaultDefn defaultArgInfo c (telePi tel t') $
Constructor (size tel) con d (Info.defAbstract i) Inductive
+ -- declare the constructor as eligible for instance search
+ addNamedInstance c d
+
return nonLinPars
where
debugEnter c e =
@@ -410,8 +413,8 @@ isCoinductive t = do
Function {} -> return Nothing
Datatype { dataInduction = CoInductive } -> return (Just True)
Datatype { dataInduction = Inductive } -> return (Just False)
- Record { recInduction = CoInductive } -> return (Just True)
- Record { recInduction = Inductive } -> return (Just False)
+ Record { recInduction = Just CoInductive } -> return (Just True)
+ Record { recInduction = _ } -> return (Just False)
Constructor {} -> __IMPOSSIBLE__
Primitive {} -> __IMPOSSIBLE__
Var {} -> return Nothing
@@ -424,3 +427,4 @@ isCoinductive t = do
MetaV {} -> return Nothing
Shared{} -> __IMPOSSIBLE__
DontCare{} -> __IMPOSSIBLE__
+ ExtLam{} -> __IMPOSSIBLE__
diff --git a/src/full/Agda/TypeChecking/Rules/Decl.hs b/src/full/Agda/TypeChecking/Rules/Decl.hs
index e119a01..3f9385a 100644
--- a/src/full/Agda/TypeChecking/Rules/Decl.hs
+++ b/src/full/Agda/TypeChecking/Rules/Decl.hs
@@ -24,6 +24,7 @@ import Agda.Syntax.Internal as I
import qualified Agda.Syntax.Info as Info
import Agda.Syntax.Position
import Agda.Syntax.Common
+import Agda.Syntax.Translation.InternalToAbstract
import Agda.TypeChecking.Monad
import Agda.TypeChecking.Monad.Builtin
@@ -34,14 +35,15 @@ import Agda.TypeChecking.Constraints
import Agda.TypeChecking.Conversion
import Agda.TypeChecking.Errors
import Agda.TypeChecking.Injectivity
-import Agda.TypeChecking.InstanceArguments (solveIrrelevantMetas)
import Agda.TypeChecking.Positivity
import Agda.TypeChecking.Polarity
import Agda.TypeChecking.Pretty
import Agda.TypeChecking.Primitive hiding (Nat)
import Agda.TypeChecking.ProjectionLike
+import Agda.TypeChecking.Quote
import Agda.TypeChecking.Records
import Agda.TypeChecking.Reduce
+import Agda.TypeChecking.Rewriting
import Agda.TypeChecking.SizedTypes.Solve
import Agda.TypeChecking.Substitute
import Agda.TypeChecking.Telescope
@@ -83,17 +85,19 @@ 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 ds m = m >>= return . Just . mutualChecks ds
- impossible m = m >> return __IMPOSSIBLE__
+ none m = m >> return Nothing
+ meta m = m >> return (Just (return []))
+ mutual i ds m = m >>= return . Just . mutualChecks i ds
+ impossible m = m >> return __IMPOSSIBLE__
-- We're definitely inside a mutual block.
+ let mi = Info.MutualInfo TerminationCheck noRange
+
finalChecks <- case d of
A.Axiom{} -> meta $ checkTypeSignature d
A.Field{} -> typeError FieldOutsideRecord
A.Primitive i x e -> meta $ checkPrimitive i x e
- A.Mutual i ds -> mutual ds $ checkMutual i ds
+ A.Mutual i ds -> mutual i ds $ checkMutual i ds
A.Section i x tel ds -> meta $ checkSection i x tel ds
A.Apply i x modapp rd rm -> meta $ checkSectionApplication i x modapp rd rm
A.Import i x -> none $ checkImport i x
@@ -101,7 +105,7 @@ checkDecl d = traceCall (SetRange (getRange d)) $ do
A.ScopedDecl scope ds -> none $ setScope scope >> checkDecls ds
A.FunDef i x delayed cs -> impossible $ check x i $ checkFunDef delayed i x cs
A.DataDef i x ps cs -> impossible $ check x i $ checkDataDef i x ps cs
- A.RecDef i x ind c ps tel cs -> mutual [d] $ check x i $ do
+ A.RecDef i x ind c ps tel cs -> mutual mi [d] $ check x i $ do
checkRecDef i x ind c ps tel cs
return (Set.singleton x)
A.DataSig i x ps t -> impossible $ checkSig i x ps t
@@ -118,11 +122,12 @@ checkDecl d = traceCall (SetRange (getRange d)) $ do
-- Open and PatternSynDef are just artifacts
-- from the concrete syntax, retained for
-- 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
solveSizeConstraints
- solveIrrelevantMetas
wakeupConstraints_ -- solve emptyness constraints
freezeMetas
@@ -144,6 +149,7 @@ checkDecl d = traceCall (SetRange (getRange d)) $ do
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.
@@ -181,12 +187,14 @@ checkDecl d = traceCall (SetRange (getRange d)) $ do
-- 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 ds names = do
+ 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 <- checkTermination_ d
+ 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
@@ -196,12 +204,31 @@ checkDecl d = traceCall (SetRange (getRange d)) $ do
checkProjectionLikeness_ names
return termErrs
--- | 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.
---
--- Precondition: name has been added to signature already.
+ 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
+ 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
+ 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
+ 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
+
+-- | 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.
+-- -- Precondition: name has been added to signature already.
instantiateDefinitionType :: QName -> TCM ()
instantiateDefinitionType q = do
reportSLn "tc.decl.inst" 20 $ "instantiating type of " ++ show q
@@ -332,9 +359,9 @@ checkAxiom funSig i info0 x e = do
A.FunSig -> emptyFunction
A.NoFunSig -> Axiom -- NB: used also for data and record type sigs
- -- for top-level axioms (postulates) try to solve irrelevant metas
- -- when postulate $
- maybe solveIrrelevantMetas (const $ return ()) =<< asks envMutualBlock
+ -- Add the definition to the instance table, if needed
+ when (Info.defInstance i == InstanceDef) $ do
+ addTypedInstance x t
traceCall (IsType_ e) $ solveSizeConstraints -- need Range for error message
@@ -362,6 +389,7 @@ 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.CompiledTypePragma x hs -> do
def <- getConstInfo x
case theDef def of
@@ -497,12 +525,12 @@ checkSection :: Info.ModuleInfo -> ModuleName -> A.Telescope -> [A.Declaration]
checkSection i x tel ds =
checkTelescope_ tel $ \tel' -> do
addSection x (size tel')
- verboseS "tc.section.check" 10 $ do
+ verboseS "tc.mod.check" 10 $ do
dx <- prettyTCM x
dtel <- mapM prettyAs tel
dtel' <- prettyTCM =<< lookupSection x
- reportSLn "tc.section.check" 10 $ "checking section " ++ show dx ++ " " ++ show dtel
- reportSLn "tc.section.check" 10 $ " actual tele: " ++ show dtel'
+ reportSLn "tc.mod.check" 10 $ "checking section " ++ show dx ++ " " ++ show dtel
+ reportSLn "tc.mod.check" 10 $ " actual tele: " ++ show dtel'
withCurrentModule x $ checkDecls ds
-- | Helper for 'checkSectionApplication'.
@@ -548,10 +576,10 @@ checkModuleArity m tel args = check tel args
-- | Check an application of a section (top-level function, includes @'traceCall'@).
checkSectionApplication
:: Info.ModuleInfo
- -> ModuleName -- ^ Name @m1@ of module defined by the module macro.
- -> A.ModuleApplication -- ^ The module macro @λ tel → m2 args at .
- -> Map QName QName -- ^ Imported names (given as renaming).
- -> Map ModuleName ModuleName -- ^ Imported modules (given as renaming).
+ -> ModuleName -- ^ Name @m1@ of module defined by the module macro.
+ -> A.ModuleApplication -- ^ The module macro @λ tel → m2 args at .
+ -> A.Ren QName -- ^ Imported names (given as renaming).
+ -> A.Ren ModuleName -- ^ Imported modules (given as renaming).
-> TCM ()
checkSectionApplication i m1 modapp rd rm =
traceCall (CheckSectionApplication (getRange i) m1 modapp) $
@@ -560,12 +588,19 @@ checkSectionApplication i m1 modapp rd rm =
-- | Check an application of a section.
checkSectionApplication'
:: Info.ModuleInfo
- -> ModuleName -- ^ Name @m1@ of module defined by the module macro.
- -> A.ModuleApplication -- ^ The module macro @λ tel → m2 args at .
- -> Map QName QName -- ^ Imported names (given as renaming).
- -> Map ModuleName ModuleName -- ^ Imported modules (given as renaming).
+ -> ModuleName -- ^ Name @m1@ of module defined by the module macro.
+ -> A.ModuleApplication -- ^ The module macro @λ tel → m2 args at .
+ -> A.Ren QName -- ^ Imported names (given as renaming).
+ -> A.Ren ModuleName -- ^ Imported modules (given as renaming).
-> TCM ()
-checkSectionApplication' i m1 (A.SectionApp ptel m2 args) rd rm =
+checkSectionApplication' i m1 (A.SectionApp ptel m2 args) rd rm = do
+ -- Module applications can appear in lets, in which case we treat
+ -- lambda-bound variables as additional parameters to the module.
+ extraParams <- do
+ mfv <- getModuleFreeVars =<< currentModule
+ fv <- size <$> getContextTelescope
+ return (fv - mfv)
+ when (extraParams > 0) $ reportSLn "tc.mod.apply" 30 $ "Extra parameters to " ++ show m1 ++ ": " ++ show extraParams
-- Type-check the LHS (ptel) of the module macro.
checkTelescope_ ptel $ \ ptel -> do
-- We are now in the context @ptel at .
@@ -581,7 +616,7 @@ checkSectionApplication' i m1 (A.SectionApp ptel m2 args) rd rm =
etaTel <- checkModuleArity m2 tel' args'
-- Take the module parameters that will be instantiated by @args at .
let tel'' = telFromList $ take (size tel' - size etaTel) $ telToList tel'
- reportSDoc "tc.section.apply" 15 $ vcat
+ reportSDoc "tc.mod.apply" 15 $ vcat
[ text "applying section" <+> prettyTCM m2
, nest 2 $ text "args =" <+> sep (map prettyA args)
, nest 2 $ text "ptel =" <+> escapeContext (size ptel) (prettyTCM ptel)
@@ -594,14 +629,14 @@ checkSectionApplication' i m1 (A.SectionApp ptel m2 args) rd rm =
ts <- noConstraints $ checkArguments_ DontExpandLast (getRange i) args' tel''
-- Perform the application of the module parameters.
let aTel = tel' `apply` ts
- reportSDoc "tc.section.apply" 15 $ vcat
+ reportSDoc "tc.mod.apply" 15 $ vcat
[ nest 2 $ text "aTel =" <+> prettyTCM aTel
]
-- Andreas, 2014-04-06, Issue 1094:
-- Add the section with well-formed telescope.
- addCtxTel aTel $ addSection m1 (size ptel + size aTel)
+ addCtxTel aTel $ addSection m1 (size ptel + size aTel + extraParams)
- reportSDoc "tc.section.apply" 20 $ vcat
+ reportSDoc "tc.mod.apply" 20 $ vcat
[ sep [ text "applySection", prettyTCM m1, text "=", prettyTCM m2, fsep $ map prettyTCM (vs ++ ts) ]
, nest 2 $ text " defs:" <+> text (show rd)
, nest 2 $ text " mods:" <+> text (show rm)
@@ -633,7 +668,7 @@ checkSectionApplication' i m1 (A.RecordModuleIFS x) rd rm = do
-- Before instFinal is invoked, we have checked that the @tel@ is not empty.
instFinal EmptyTel = __IMPOSSIBLE__
- reportSDoc "tc.section.apply" 20 $ vcat
+ reportSDoc "tc.mod.apply" 20 $ vcat
[ sep [ text "applySection", prettyTCM name, text "{{...}}" ]
, nest 2 $ text "x =" <+> prettyTCM x
, nest 2 $ text "name =" <+> prettyTCM name
@@ -642,7 +677,7 @@ checkSectionApplication' i m1 (A.RecordModuleIFS x) rd rm = do
, nest 2 $ text "vs =" <+> sep (map prettyTCM vs)
-- , nest 2 $ text "args =" <+> sep (map prettyTCM args)
]
- reportSDoc "tc.section.apply" 60 $ vcat
+ reportSDoc "tc.mod.apply" 60 $ vcat
[ nest 2 $ text "vs =" <+> text (show vs)
-- , nest 2 $ text "args =" <+> text (show args)
]
@@ -651,11 +686,11 @@ checkSectionApplication' i m1 (A.RecordModuleIFS x) rd rm = do
addCtxTel telInst $ do
vs <- freeVarsToApply name
- reportSDoc "tc.section.apply" 20 $ vcat
+ reportSDoc "tc.mod.apply" 20 $ vcat
[ nest 2 $ text "vs =" <+> sep (map prettyTCM vs)
, nest 2 $ text "args =" <+> sep (map (parens . prettyTCM) args)
]
- reportSDoc "tc.section.apply" 60 $ vcat
+ reportSDoc "tc.mod.apply" 60 $ vcat
[ nest 2 $ text "vs =" <+> text (show vs)
, nest 2 $ text "args =" <+> text (show args)
]
diff --git a/src/full/Agda/TypeChecking/Rules/Decl.hs-boot b/src/full/Agda/TypeChecking/Rules/Decl.hs-boot
index 824b513..b6c143b 100644
--- a/src/full/Agda/TypeChecking/Rules/Decl.hs-boot
+++ b/src/full/Agda/TypeChecking/Rules/Decl.hs-boot
@@ -3,11 +3,11 @@ module Agda.TypeChecking.Rules.Decl where
import Data.Map (Map)
import Agda.Syntax.Info (ModuleInfo)
-import Agda.Syntax.Abstract (QName, Declaration, ModuleName, ModuleApplication)
+import Agda.Syntax.Abstract (QName, Declaration, ModuleName, ModuleApplication, Ren)
import Agda.TypeChecking.Monad (TCM)
checkDecls :: [Declaration] -> TCM ()
checkDecl :: Declaration -> TCM ()
checkSectionApplication ::
ModuleInfo -> ModuleName -> ModuleApplication ->
- Map QName QName -> Map ModuleName ModuleName -> TCM ()
+ Ren QName -> Ren ModuleName -> TCM ()
diff --git a/src/full/Agda/TypeChecking/Rules/Def.hs b/src/full/Agda/TypeChecking/Rules/Def.hs
index c5b03a3..0007c76 100644
--- a/src/full/Agda/TypeChecking/Rules/Def.hs
+++ b/src/full/Agda/TypeChecking/Rules/Def.hs
@@ -46,7 +46,7 @@ import Agda.TypeChecking.CompiledClause (CompiledClauses(..))
import Agda.TypeChecking.CompiledClause.Compile
import Agda.TypeChecking.Rules.Term ( checkExpr, inferExpr, inferExprForWith, checkDontExpandLast, checkTelescope_, ConvColor(..) )
-import Agda.TypeChecking.Rules.LHS ( checkLeftHandSide )
+import Agda.TypeChecking.Rules.LHS ( checkLeftHandSide, LHSResult(..) )
import {-# SOURCE #-} Agda.TypeChecking.Rules.Decl ( checkDecls )
import Agda.Utils.Size
@@ -392,7 +392,7 @@ checkClause t c@(A.Clause (A.SpineLHS i x aps withPats) rhs0 wh) = do
typeError $ UnexpectedWithPatterns withPats
traceCall (CheckClause t c) $ do
aps <- (traverse . traverse . traverse) expandPatternSynonyms aps
- checkLeftHandSide (CheckPatternShadowing c) (Just x) aps t $ \ mgamma delta sub xs ps trhs perm -> do
+ checkLeftHandSide (CheckPatternShadowing c) (Just x) aps t $ \ (LHSResult mgamma delta sub xs ps trhs perm) -> do
-- Note that we might now be in irrelevant context,
-- in case checkLeftHandSide walked over an irrelevant projection pattern.
let mkBody v = foldr (\x t -> Bind $ Abs x t) (Body $ applySubst sub v) xs
@@ -589,7 +589,7 @@ checkClause t c@(A.Clause (A.SpineLHS i x aps withPats) rhs0 wh) = do
-- Andreas, 2013-02-26 add with-name to signature for printing purposes
- addConstant aux (Defn defaultArgInfo aux typeDontCare [] [] [] 0 noCompiledRep emptyFunction)
+ addConstant aux (Defn defaultArgInfo aux typeDontCare [] [] [] 0 noCompiledRep [] Nothing emptyFunction)
-- Andreas, 2013-02-26 separate msgs to see which goes wrong
reportSDoc "tc.with.top" 20 $
@@ -720,7 +720,7 @@ 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 emptyFunction)
+ addConstant aux (Defn defaultArgInfo aux auxType [] [] [df] 0 noCompiledRep [] Nothing emptyFunction)
-- solveSizeConstraints -- Andreas, 2012-10-16 does not seem necessary
reportSDoc "tc.with.top" 10 $ sep
diff --git a/src/full/Agda/TypeChecking/Rules/LHS.hs b/src/full/Agda/TypeChecking/Rules/LHS.hs
index cc79a77..8fc1914 100644
--- a/src/full/Agda/TypeChecking/Rules/LHS.hs
+++ b/src/full/Agda/TypeChecking/Rules/LHS.hs
@@ -230,6 +230,7 @@ noShadowingOfConstructors mkCall problem =
Level {} -> __IMPOSSIBLE__
Con {} -> __IMPOSSIBLE__
DontCare{} -> __IMPOSSIBLE__
+ ExtLam{} -> __IMPOSSIBLE__
-- | Check that a dot pattern matches it's instantiation.
checkDotPattern :: DotPatternInst -> TCM ()
@@ -247,8 +248,8 @@ checkDotPattern (DPI e v (Dom info a)) =
noConstraints $ equalTerm a u v
-- | Bind the variables in a left hand side. Precondition: the patterns should
--- all be 'A.VarP', 'A.WildP', or 'A.ImplicitP' and the telescope should have
--- the same size as the pattern list.
+-- all be 'A.VarP', 'A.WildP', 'A.AbsurdP', or 'A.ImplicitP' and the
+-- telescope should have the same size as the pattern list.
-- There could also be 'A.ConP's resulting from eta expanded implicit record
-- patterns.
bindLHSVars :: [A.NamedArg A.Pattern] -> Telescope -> TCM a -> TCM a
@@ -299,6 +300,20 @@ bindAsPatterns (AsB x v a : asb) ret = do
addLetBinding defaultArgInfo x v a $ bindAsPatterns asb ret
+data LHSResult = LHSResult
+ { lhsPatternTele :: Maybe Telescope -- ^ Γ: The types of the patterns.
+ -- 'Nothing' if more patterns than domain types in @a at .
+ -- Used only to construct a @with@ function; see 'stripwithClausePatterns'.
+ , lhsVarTele :: Telescope -- ^ Δ : The types of the pattern variables.
+ , lhsSubstitution :: S.Substitution -- ^ σ : The patterns in form of a substitution Δ ⊢ σ : Γ
+ , lhsVarNames :: [String] -- ^ Names for the variables in Δ, for binding the body.
+ , lhsPatterns :: [I.NamedArg Pattern] -- ^ The patterns in internal syntax.
+ , lhsBodyType :: I.Arg Type -- ^ The type of the body. Is @bσ@ if @Γ@ is defined.
+ -- 'Irrelevant' to indicate the rhs must be checked
+ -- in irrelevant mode.
+ , lhsPermutation :: Permutation -- ^ The permutation from pattern vars to @Δ@.
+ }
+
-- | Check a LHS. Main function.
--
-- @checkLeftHandSide a ps a ret@ checks that user patterns @ps@ eliminate
@@ -314,18 +329,7 @@ checkLeftHandSide
-- ^ The patterns.
-> Type
-- ^ The expected type @a = Γ → b at .
- -> (Maybe Telescope -- Γ : The types of the patterns.
- -- 'Nothing' if more patterns than domain types in @a at .
- -- Used only to construct a @with@ function; see 'stripwithClausePatterns'.
- -> Telescope -- Δ : The types of the pattern variables.
- -> S.Substitution -- σ : The patterns in form of a substitution Δ ⊢ σ : Γ
- -> [ArgName] -- Names for the variables in Δ, for binding the body.
- -> [I.NamedArg Pattern] -- The patterns in internal syntax.
- -> I.Arg Type -- The type of the body. Is @bσ@ if @Γ@ is defined.
- -- 'Irrelevant' to indicate the rhs must be checked
- -- in irrelevant mode.
- -> Permutation -- The permutation from pattern vars to @Δ@.
- -> TCM a)
+ -> (LHSResult -> TCM a)
-- ^ Continuation.
-> TCM a
checkLeftHandSide c f ps a ret = do
@@ -367,7 +371,7 @@ checkLeftHandSide c f ps a ret = do
Perm n _ = perm
xs = [ stringToArgName $ "h" ++ show n | n <- [0..n - 1] ]
applyRelevanceToContext (getRelevance b') $ do
- ret mgamma delta rho xs qs b' perm
+ 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
diff --git a/src/full/Agda/TypeChecking/Rules/LHS/ProblemRest.hs b/src/full/Agda/TypeChecking/Rules/LHS/ProblemRest.hs
index 3e30da2..850cf48 100644
--- a/src/full/Agda/TypeChecking/Rules/LHS/ProblemRest.hs
+++ b/src/full/Agda/TypeChecking/Rules/LHS/ProblemRest.hs
@@ -29,6 +29,7 @@ useNamesFromPattern ps = telFromList . zipWith ren (toPats ps ++ repeat dummy) .
where
dummy = A.WildP __IMPOSSIBLE__
ren (A.VarP x) (Dom info (_, a)) | notHidden info = Dom info (nameToArgName x, a)
+ ren A.AbsurdP{} (Dom info (_, a)) | notHidden info = Dom info ("()", a)
-- Andreas, 2013-03-13: inserted the following line in the hope to fix issue 819
-- but it does not do the job, instead, it puts a lot of "_"s
-- instead of more sensible names into error messages.
diff --git a/src/full/Agda/TypeChecking/Rules/Record.hs b/src/full/Agda/TypeChecking/Rules/Record.hs
index bd59a77..49943a4 100644
--- a/src/full/Agda/TypeChecking/Rules/Record.hs
+++ b/src/full/Agda/TypeChecking/Rules/Record.hs
@@ -3,6 +3,7 @@
module Agda.TypeChecking.Rules.Record where
import Control.Applicative
+import Data.Maybe
import qualified Agda.Syntax.Abstract as A
import Agda.Syntax.Common
@@ -123,13 +124,7 @@ checkRecDef i name ind con ps contel fields =
fs = concatMap (convColor . getName) fields
con = ConHead conName $ map unArg fs
-
- -- Default is 'Inductive'.
- -- This makes sense because all non-recursive records are "inductive",
- -- meaning not coinductive.
- -- Of course, one could make all *recursive* records coinductive
- -- by default, but this would not be backwards-compatible.
- indCo = maybe Inductive rangedThing ind
+ indCo = rangedThing <$> ind
reportSDoc "tc.rec" 30 $ text "record constructor is " <+> text (show con)
addConstant name $ defaultDefn defaultArgInfo name t0
@@ -141,7 +136,7 @@ checkRecDef i name ind con ps contel fields =
, recFields = fs
, recTel = ftel -- addConstant adds params!
, recAbstr = Info.defAbstract i
- , recEtaEquality = indCo == Inductive
+ , recEtaEquality = indCo /= Just CoInductive
, recInduction = indCo
-- determined by positivity checker:
, recRecursive = False
@@ -157,9 +152,12 @@ checkRecDef i name ind con ps contel fields =
, conSrcCon = con
, conData = name
, conAbstr = Info.defAbstract conInfo
- , conInd = indCo
+ , conInd = fromMaybe Inductive indCo
}
+ -- Declare the constructor as eligible for instance search
+ addNamedInstance conName name
+
-- Check that the fields fit inside the sort
let dummy = Sort Prop -- We're only interested in the sort here
telePi ftel (El (raise (size ftel) s) dummy) `fitsIn` s
diff --git a/src/full/Agda/TypeChecking/Rules/Term.hs b/src/full/Agda/TypeChecking/Rules/Term.hs
index e50ca58..ce9eaf3 100644
--- a/src/full/Agda/TypeChecking/Rules/Term.hs
+++ b/src/full/Agda/TypeChecking/Rules/Term.hs
@@ -55,7 +55,7 @@ import Agda.TypeChecking.Records
import Agda.TypeChecking.Reduce
import Agda.TypeChecking.Substitute
import Agda.TypeChecking.Telescope
-import Agda.TypeChecking.Rules.LHS (checkLeftHandSide)
+import Agda.TypeChecking.Rules.LHS (checkLeftHandSide, LHSResult(..))
import {-# SOURCE #-} Agda.TypeChecking.Empty (isEmptyType)
import {-# SOURCE #-} Agda.TypeChecking.Rules.Decl (checkSectionApplication)
@@ -292,7 +292,7 @@ checkAbsurdLambda i h e t = do
addConstant aux
$ Defn (setRelevance rel info') aux t'
[Nonvariant] [Unused] (defaultDisplayForm aux)
- 0 noCompiledRep
+ 0 noCompiledRep [] Nothing
$ Function
{ funClauses =
[Clause
@@ -783,12 +783,19 @@ checkApplication hd args e t = do
-- Subcase: unquote
A.Unquote _
| [arg] <- args -> do
- v <- unquote =<< checkExpr (namedArg arg) =<< el primAgdaTerm
- checkTerm v t
+ e <- unquoteTerm (namedArg arg)
+ checkExpr e t
| arg : args <- args -> do
- v <- unquote =<< checkExpr (namedArg arg) =<< el primAgdaTerm
- e' <- withShowAllArguments $ reify (v :: Term) -- TODO: use checkInternal (but see comment on checkTerm)
- checkHeadApplication e t e' $ map convColor args
+ e <- unquoteTerm (namedArg arg)
+ 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)
-- Subcase: defined symbol or variable.
_ -> checkHeadApplication e t hd $ map convColor args
@@ -1143,7 +1150,7 @@ checkHeadApplication e t hd args = do
rel <- asks envRelevance
addConstant c' (Defn (setRelevance rel defaultArgInfo)
c' t [] [] (defaultDisplayForm c')
- i noCompiledRep $ emptyFunction)
+ i noCompiledRep [] Nothing $ emptyFunction)
-- Define and type check the fresh function.
ctx <- getContext >>= mapM (\d -> flip Dom (unDom d) <$> reify (domInfo d))
@@ -1384,12 +1391,6 @@ inferExprForWith e = do
return (v `apply` args, t1)
_ -> return (v, t)
--- TODO: should really use CheckInternal but doesn't quite work at the moment,
--- since CheckInternal can't instantiate metas to sorts or to function types.
-checkTerm :: Term -> Type -> TCM Term
-checkTerm tm ty = do atm <- withShowAllArguments $ reify tm
- checkExpr (killRange atm) ty
-
---------------------------------------------------------------------------
-- * Let bindings
---------------------------------------------------------------------------
@@ -1419,7 +1420,7 @@ checkLetBinding b@(A.LetPatBind i p e) ret =
, text "t =" <+> prettyTCM t
]
]
- checkLeftHandSide (CheckPattern p EmptyTel t) Nothing [p0] t0 $ \ mgamma delta sub xs ps t' perm -> do
+ checkLeftHandSide (CheckPattern p EmptyTel t) Nothing [p0] t0 $ \ (LHSResult mgamma delta sub xs ps t' perm) -> do
-- A single pattern in internal syntax is returned.
let p = case ps of [p] -> namedArg p; _ -> __IMPOSSIBLE__
reportSDoc "tc.term.let.pattern" 20 $ nest 2 $ vcat
diff --git a/src/full/Agda/TypeChecking/Serialise.hs b/src/full/Agda/TypeChecking/Serialise.hs
index d9d1fd5..e3b3f71 100644
--- a/src/full/Agda/TypeChecking/Serialise.hs
+++ b/src/full/Agda/TypeChecking/Serialise.hs
@@ -1,10 +1,8 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverlappingInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# OPTIONS_GHC -O2 #-}
@@ -37,9 +35,9 @@ import qualified Data.HashTable.IO as H
import Data.Int (Int32)
import Data.IORef
import Data.Map (Map)
-import qualified Data.Map as M
+import qualified Data.Map as Map
import Data.Set (Set)
-import qualified Data.Set as S
+import qualified Data.Set as Set
import qualified Data.Binary as B
import qualified Data.Binary.Get as B
import qualified Data.Binary.Put as B
@@ -89,7 +87,7 @@ import Agda.Utils.Impossible
-- 32-bit machines). Word64 does not have these problems.
currentInterfaceVersion :: Word64
-currentInterfaceVersion = 20140611 * 10 + 0
+currentInterfaceVersion = 20140828 * 10 + 0
-- | Constructor tag (maybe omitted) and argument indices.
@@ -363,15 +361,15 @@ instance EmbPrj Bool where
instance EmbPrj AbsolutePath where
icode file = do
- mm <- M.lookup file . fileMod <$> ask
+ mm <- Map.lookup file <$> asks fileMod
case mm of
Just m -> icode m
Nothing -> __IMPOSSIBLE__
value m = do
m :: TopLevelModuleName
<- value m
- mf <- modFile <$> get
- incs <- includes <$> get
+ mf <- gets modFile
+ incs <- gets includes
(r, mf) <- liftIO $ findFile'' incs m mf
modify $ \s -> s { modFile = mf }
case r of
@@ -404,12 +402,12 @@ instance (Ord a, Ord b, EmbPrj a, EmbPrj b) => EmbPrj (BiMap a b) where
value m = BiMap.fromList <$> value m
instance (Ord a, EmbPrj a, EmbPrj b) => EmbPrj (Map a b) where
- icode m = icode (M.toList m)
- value m = M.fromList `fmap` value m
+ icode m = icode (Map.toList m)
+ value m = Map.fromList `fmap` value m
instance (Ord a, EmbPrj a) => EmbPrj (Set a) where
- icode s = icode (S.toList s)
- value s = S.fromList `fmap` value s
+ icode 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
@@ -450,7 +448,7 @@ instance EmbPrj C.QName where
instance EmbPrj Scope where
icode (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
+ valu _ = malformed
instance EmbPrj NameSpaceId where
icode PublicNS = icode0'
@@ -497,14 +495,16 @@ instance EmbPrj AbstractModule where
valu _ = malformed
instance EmbPrj KindOfName where
- icode DefName = icode0'
- icode ConName = icode0 1
- icode FldName = icode0 2
+ icode DefName = icode0'
+ icode ConName = icode0 1
+ icode FldName = icode0 2
icode PatternSynName = icode0 3
+ icode QuotableName = icode0 4
value = vcase valu where valu [] = valu0 DefName
valu [1] = valu0 ConName
valu [2] = valu0 FldName
valu [3] = valu0 PatternSynName
+ valu [4] = valu0 QuotableName
valu _ = malformed
instance EmbPrj Agda.Syntax.Fixity.Fixity where
@@ -797,6 +797,7 @@ instance EmbPrj I.Term where
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
@@ -901,10 +902,16 @@ instance EmbPrj MutualId where
value n = MutId `fmap` value n
instance EmbPrj Definition where
- icode (Defn rel a b c d e f g h) = icode9' rel a (P.killRange b) c d e f g h
- value = vcase valu where valu [rel, a, b, c, d, e, f, g, h] = valu9 Defn rel a b c d e f g h
+ 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
+ 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
+ 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
value = vcase valu where valu [a, b, c, d, e] = valu5 Projection a b c d e
diff --git a/src/full/Agda/TypeChecking/SizedTypes/Solve.hs b/src/full/Agda/TypeChecking/SizedTypes/Solve.hs
index c21bf5e..a622848 100644
--- a/src/full/Agda/TypeChecking/SizedTypes/Solve.hs
+++ b/src/full/Agda/TypeChecking/SizedTypes/Solve.hs
@@ -1,13 +1,8 @@
{-# LANGUAGE CPP #-}
-{-# LANGUAGE DeriveFoldable #-}
-{-# LANGUAGE DeriveFunctor #-}
-{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeSynonymInstances #-}
diff --git a/src/full/Agda/TypeChecking/SizedTypes/Syntax.hs b/src/full/Agda/TypeChecking/SizedTypes/Syntax.hs
index 0dd1a00..a5e3b9e 100644
--- a/src/full/Agda/TypeChecking/SizedTypes/Syntax.hs
+++ b/src/full/Agda/TypeChecking/SizedTypes/Syntax.hs
@@ -1,7 +1,12 @@
-{-# LANGUAGE NoMonomorphismRestriction,
- TypeSynonymInstances, FlexibleInstances, UndecidableInstances,
- MultiParamTypeClasses, FunctionalDependencies,
- DeriveFunctor, DeriveFoldable, DeriveTraversable #-}
+{-# LANGUAGE DeriveFoldable #-}
+{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE DeriveTraversable #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE NoMonomorphismRestriction #-}
+{-# LANGUAGE TypeSynonymInstances #-}
+{-# LANGUAGE UndecidableInstances #-}
-- | Syntax of size expressions and constraints.
diff --git a/src/full/Agda/TypeChecking/SizedTypes/WarshallSolver.hs b/src/full/Agda/TypeChecking/SizedTypes/WarshallSolver.hs
index 85c2081..3f1f09e 100644
--- a/src/full/Agda/TypeChecking/SizedTypes/WarshallSolver.hs
+++ b/src/full/Agda/TypeChecking/SizedTypes/WarshallSolver.hs
@@ -1,14 +1,11 @@
{-# LANGUAGE CPP #-}
-{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
--- {-# LANGUAGE OverlappingInstances #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeSynonymInstances #-}
--- {-# LANGUAGE UndecidableInstances #-}
module Agda.TypeChecking.SizedTypes.WarshallSolver where
diff --git a/src/full/Agda/TypeChecking/Substitute.hs b/src/full/Agda/TypeChecking/Substitute.hs
index 6decbea..a199ec3 100644
--- a/src/full/Agda/TypeChecking/Substitute.hs
+++ b/src/full/Agda/TypeChecking/Substitute.hs
@@ -72,6 +72,7 @@ instance Apply Term where
Sort _ -> __IMPOSSIBLE__
DontCare mv -> dontCare $ mv `applyE` es -- Andreas, 2011-10-02
-- need to go under DontCare, since "with" might resurrect irrelevant term
+ ExtLam _ _ -> __IMPOSSIBLE__
-- | If $v$ is a record value, @canProject f v@
-- returns its field @f at .
@@ -144,7 +145,12 @@ instance Subst a => Apply (Tele a) where
apply (ExtendTel _ tel) (t : ts) = absApp tel (unArg t) `apply` ts
instance Apply Definition where
- apply (Defn info x t pol occ df m c d) args = Defn info x (piApply t args) (apply pol args) (apply occ args) df m c (apply d args)
+ apply (Defn info x t pol occ df m c rew inst d) args =
+ Defn info x (piApply t args) (apply pol args) (apply occ args) df m c (apply rew args) inst (apply d args)
+
+instance Apply RewriteRule where
+ apply (RewriteRule q gamma lhs rhs t) args =
+ RewriteRule q (apply gamma args) lhs rhs t
instance Apply [Base.Occurrence] where
apply occ args = List.drop (length args) occ
@@ -353,8 +359,15 @@ instance Abstract Telescope where
abstract (ExtendTel arg tel') tel = ExtendTel arg $ fmap (`abstract` tel) tel'
instance Abstract Definition where
- abstract tel (Defn info x t pol occ df m c d) =
- Defn info x (abstract tel t) (abstract tel pol) (abstract tel occ) df m c (abstract tel d)
+ abstract tel (Defn info x t pol occ df m c rews inst d) =
+ Defn info x (abstract tel t) (abstract tel pol) (abstract tel occ) df m c (abstract tel rews) inst (abstract tel d)
+
+-- | @tel ⊢ (Γ ⊢ lhs ↦ rhs : t)@ becomes @tel, Γ ⊢ lhs ↦ rhs : t)@
+-- we do not need to change lhs, rhs, and t since they live in Γ.
+-- See 'Abstract Clause'.
+instance Abstract RewriteRule where
+ abstract tel (RewriteRule q gamma lhs rhs t) =
+ RewriteRule q (abstract tel gamma) lhs rhs t
instance Abstract [Base.Occurrence] where
abstract tel [] = []
@@ -600,6 +613,7 @@ instance Subst Term where
Sort s -> sortTm $ applySubst rho s
Shared p -> Shared $ applySubst rho p
DontCare mv -> dontCare $ applySubst rho mv
+ ExtLam cs es-> ExtLam (applySubst rho cs) (applySubst rho es)
instance Subst a => Subst (Ptr a) where
applySubst rho = fmap (applySubst rho)
@@ -717,6 +731,11 @@ instance Subst ClauseBody where
applySubst rho (Bind b) = Bind $ applySubst rho b
applySubst _ NoBody = NoBody
+instance Subst Clause where
+ -- NOTE: This only happens when reifying extended lambdas, in which case there are
+ -- no interesting dot patterns and we don't care about the type.
+ applySubst rho c = c { clauseBody = applySubst rho $ clauseBody c }
+
---------------------------------------------------------------------------
-- * Telescopes
---------------------------------------------------------------------------
@@ -865,24 +884,32 @@ underLambdas n cont a v = loop n a v where
Lam h b -> Lam h $ underAbs (loop $ n-1) a b
_ -> __IMPOSSIBLE__
--- | @getBody@ returns the properly raised clause 'Body',
--- and 'Nothing' if 'NoBody'.
---
--- @getBodyUnraised@ just grabs the body, without raising the de Bruijn indices.
--- This is useful if you want to consider the body in context 'clauseTel'.
+-- | Methods to retrieve the 'clauseBody'.
class GetBody a where
getBody :: a -> Maybe Term
+ -- ^ Returns the properly raised clause 'Body',
+ -- and 'Nothing' if 'NoBody'.
getBodyUnraised :: a -> Maybe Term
+ -- ^ Just grabs the body, without raising the de Bruijn indices.
+ -- This is useful if you want to consider the body in context 'clauseTel'.
instance GetBody ClauseBody where
- getBody = body 0
- where
- -- collect all shiftings and do them in the end in one go
- body :: Int -> ClauseBody -> Maybe Term
- body _ NoBody = Nothing
- body n (Body v) = Just $ raise n v
- body n (Bind (NoAbs _ v)) = body n v
- body n (Bind (Abs _ v)) = body (n + 1) v
+ getBody NoBody = Nothing
+ getBody (Body v) = Just v
+ getBody (Bind b) = getBody $ absBody b
+
+ -- Andreas, 2014-08-25: The following 'optimization' is WRONG,
+ -- since it does not respect the order of Abs and NoAbs.
+ -- (They do not commute w.r.t. raise!!)
+ --
+ -- getBody = body 0
+ -- where
+ -- -- collect all shiftings and do them in the end in one go
+ -- body :: Int -> ClauseBody -> Maybe Term
+ -- body _ NoBody = Nothing
+ -- body n (Body v) = Just $ raise n v
+ -- body n (Bind (NoAbs _ v)) = body (n + 1) v
+ -- body n (Bind (Abs _ v)) = body n v
getBodyUnraised NoBody = Nothing
getBodyUnraised (Body v) = Just v
@@ -940,6 +967,8 @@ instance Eq Term where
_ == _ = False
instance Ord Term where
+ ExtLam{} `compare` _ = __IMPOSSIBLE__
+ _ `compare` ExtLam{} = __IMPOSSIBLE__
Shared a `compare` Shared x | a == x = EQ
Shared a `compare` x = compare (derefPtr a) x
a `compare` Shared x = compare a (derefPtr x)
diff --git a/src/full/Agda/TypeChecking/Telescope.hs b/src/full/Agda/TypeChecking/Telescope.hs
index af36262..d4cb8dc 100644
--- a/src/full/Agda/TypeChecking/Telescope.hs
+++ b/src/full/Agda/TypeChecking/Telescope.hs
@@ -3,7 +3,7 @@
module Agda.TypeChecking.Telescope where
import Control.Applicative
-
+import Control.Monad (forM_, unless)
import Data.List
import Agda.Syntax.Common hiding (Arg, Dom, NamedArg, ArgInfo)
@@ -25,6 +25,32 @@ import qualified Agda.Utils.VarSet as Set
#include "../undefined.h"
import Agda.Utils.Impossible
+data OutputTypeName
+ = OutputTypeName QName
+ | OutputTypeNameNotYetKnown
+ | NoOutputTypeName
+
+-- | Strips all Pi's and return the head definition name, if possible.
+getOutputTypeName :: Type -> TCM OutputTypeName
+getOutputTypeName t = do
+ TelV tel t' <- telView t
+ ifBlocked (unEl t') (\ _ _ -> return OutputTypeNameNotYetKnown) $ \ v ->
+ case ignoreSharing v of
+ -- Possible base types:
+ Def n _ -> return $ OutputTypeName n
+ Sort{} -> return NoOutputTypeName
+ Var{} -> return NoOutputTypeName
+ -- Not base types:
+ Con{} -> __IMPOSSIBLE__
+ ExtLam{} -> __IMPOSSIBLE__
+ Lam{} -> __IMPOSSIBLE__
+ Lit{} -> __IMPOSSIBLE__
+ Level{} -> __IMPOSSIBLE__
+ MetaV{} -> __IMPOSSIBLE__
+ Pi{} -> __IMPOSSIBLE__
+ Shared{} -> __IMPOSSIBLE__
+ DontCare{} -> __IMPOSSIBLE__
+
-- | The permutation should permute the corresponding telescope. (left-to-right list)
renameP :: Subst t => Permutation -> t -> t
renameP p = applySubst (renaming p)
@@ -154,3 +180,31 @@ piApplyM t (arg : args) = do
case ignoreSharing $ unEl t of
Pi _ b -> absApp b (unArg arg) `piApplyM` args
_ -> __IMPOSSIBLE__
+
+---------------------------------------------------------------------------
+-- * Instance definitions
+---------------------------------------------------------------------------
+
+addTypedInstance :: QName -> Type -> TCM ()
+addTypedInstance x t = do
+ n <- getOutputTypeName t
+ case n of
+ OutputTypeName n -> addNamedInstance x n
+ OutputTypeNameNotYetKnown -> addUnknownInstance x
+ NoOutputTypeName -> typeError $ GenericError $ "Terms marked as eligible for instance search should end with a name"
+
+resolveUnknownInstanceDefs :: TCM ()
+resolveUnknownInstanceDefs = do
+ anonInstanceDefs <- getAnonInstanceDefs
+ clearAnonInstanceDefs
+ forM_ anonInstanceDefs $ \ n -> addTypedInstance n =<< typeOfConst n
+
+-- | Try to solve the instance definitions whose type is not yet known, report
+-- an error if it doesn't work and return the instance table otherwise.
+getInstanceDefs :: TCM InstanceTable
+getInstanceDefs = do
+ resolveUnknownInstanceDefs
+ insts <- getAllInstanceDefs
+ unless (null $ snd insts) $
+ typeError $ GenericError $ "There are instances whose type is still unsolved"
+ return $ fst insts
diff --git a/src/full/Agda/TypeChecking/Test/Generators.hs b/src/full/Agda/TypeChecking/Test/Generators.hs
index c307bc8..7ab10de 100644
--- a/src/full/Agda/TypeChecking/Test/Generators.hs
+++ b/src/full/Agda/TypeChecking/Test/Generators.hs
@@ -483,6 +483,7 @@ instance ShrinkC Term Term where
(MetaV m <$> shrinkC conf (NoType es))
DontCare _ -> []
Shared{} -> __IMPOSSIBLE__
+ ExtLam _ _ -> __IMPOSSIBLE__
where
validType t
| not (tcIsType conf) = True
@@ -515,6 +516,7 @@ instance KillVar Term where
MetaV m args -> MetaV m $ killVar i args
DontCare mv -> DontCare $ killVar i mv
Shared{} -> __IMPOSSIBLE__
+ ExtLam _ _ -> __IMPOSSIBLE__
instance KillVar Type where
killVar i (El s t) = El s $ killVar i t
diff --git a/src/full/Agda/TypeChecking/With.hs b/src/full/Agda/TypeChecking/With.hs
index 41c75a5..7bb4c74 100644
--- a/src/full/Agda/TypeChecking/With.hs
+++ b/src/full/Agda/TypeChecking/With.hs
@@ -48,8 +48,9 @@ withFunctionType delta1 vs as delta2 b = {-dontEtaContractImplicit $-} do
reportSDoc "tc.with.abstract" 20 $ text " vs = " <+> prettyTCM vs
as <- etaContract =<< normalise as
reportSDoc "tc.with.abstract" 20 $ text " as = " <+> prettyTCM as
- reportSDoc "tc.with.abstract" 30 $ text "normalizing b = " <+> prettyTCM (telePi_ delta2 b)
- b <- normalise (telePi_ delta2 b)
+ b <- return $ telePi_ delta2 b
+ reportSDoc "tc.with.abstract" 30 $ text "normalizing b = " <+> prettyTCM b
+ b <- normalise b
reportSDoc "tc.with.abstract" 30 $ text "eta-contracting b = " <+> prettyTCM b
b <- etaContract b
reportSDoc "tc.with.abstract" 20 $ text " b = " <+> prettyTCM b
diff --git a/src/full/Agda/Utils/Function.hs b/src/full/Agda/Utils/Function.hs
index c9423fa..b27997d 100644
--- a/src/full/Agda/Utils/Function.hs
+++ b/src/full/Agda/Utils/Function.hs
@@ -65,3 +65,11 @@ applyWhen b f = if b then f else id
-- | @applyUnless b f a@ applies @f@ to @a@ unless @b at .
applyUnless :: Bool -> (a -> a) -> a -> a
applyUnless b f = if b then id else f
+
+-- | Monadic version of @applyWhen@
+applyWhenM :: (Monad m) => m Bool -> (m a -> m a) -> m a -> m a
+applyWhenM mb f x = mb >>= \ b -> applyWhen b f x
+
+-- | Monadic version of @applyUnless@
+applyUnlessM :: (Monad m) => m Bool -> (m a -> m a) -> m a -> m a
+applyUnlessM mb f x = mb >>= \ b -> applyUnless b f x
diff --git a/src/full/Agda/Utils/List.hs b/src/full/Agda/Utils/List.hs
index 8e655cf..28e9d21 100644
--- a/src/full/Agda/Utils/List.hs
+++ b/src/full/Agda/Utils/List.hs
@@ -301,6 +301,34 @@ uniqBy tag =
prop_uniqBy :: [Integer] -> Bool
prop_uniqBy xs = sort (nub xs) == uniqBy id xs
+-- | Compute the common suffix of two lists.
+commonSuffix :: Eq a => [a] -> [a] -> [a]
+commonSuffix xs ys = reverse $ (commonPrefix `on` reverse) xs ys
+
+-- | Compute the common prefix of two lists.
+commonPrefix :: Eq a => [a] -> [a] -> [a]
+commonPrefix [] _ = []
+commonPrefix _ [] = []
+commonPrefix (x:xs) (y:ys)
+ | x == y = x : commonPrefix xs ys
+ | otherwise = []
+
+prop_commonPrefix :: [Integer] -> [Integer] -> [Integer] -> Bool
+prop_commonPrefix xs ys zs =
+ and [ isPrefixOf zs zs'
+ , isPrefixOf zs' (zs ++ xs)
+ , isPrefixOf zs' (zs ++ ys) ]
+ where
+ zs' = commonPrefix (zs ++ xs) (zs ++ ys)
+
+prop_commonSuffix :: [Integer] -> [Integer] -> [Integer] -> Bool
+prop_commonSuffix xs ys zs =
+ and [ isSuffixOf zs zs'
+ , isSuffixOf zs' (xs ++ zs)
+ , isSuffixOf zs' (ys ++ zs) ]
+ where
+ zs' = commonSuffix (xs ++ zs) (ys ++ zs)
+
-- Hack to make $quickCheckAll work under ghc-7.8
return []
diff --git a/src/full/Agda/Utils/Null.hs b/src/full/Agda/Utils/Null.hs
index 54d62ab..a501e83 100644
--- a/src/full/Agda/Utils/Null.hs
+++ b/src/full/Agda/Utils/Null.hs
@@ -2,6 +2,10 @@
module Agda.Utils.Null where
+import Prelude hiding (null)
+
+import Control.Monad
+
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as ByteString
import qualified Data.List as List
@@ -12,6 +16,9 @@ import qualified Data.Sequence as Seq
import Data.Set (Set)
import qualified Data.Set as Set
+import Agda.Utils.Functor
+import Agda.Utils.Monad
+
class Null a where
empty :: a
null :: a -> Bool
@@ -41,3 +48,24 @@ instance Null (Set a) where
-- empty = Nothing
-- null Nothing = True
-- null (Just a) = False
+
+-- * Testing for null.
+
+ifNull :: (Null a) => a -> b -> (a -> b) -> b
+ifNull a b k = if null a then b else k a
+
+ifNullM :: (Monad m, Null a) => m a -> m b -> (a -> m b) -> m b
+ifNullM ma mb k = ma >>= \ a -> ifNull a mb k
+
+whenNull :: (Monad m, Null a) => a -> m () -> m ()
+whenNull = when . null
+
+unlessNull :: (Monad m, Null a) => a -> (a -> m ()) -> m ()
+unlessNull a k = unless (null a) $ k a
+
+whenNullM :: (Monad m, Null a) => m a -> m () -> m ()
+whenNullM ma k = ma >>= (`whenNull` k)
+
+unlessNullM :: (Monad m, Null a) => m a -> (a -> m ()) -> m ()
+unlessNullM ma k = ma >>= (`unlessNull` k)
+
diff --git a/src/full/Agda/Utils/String.hs b/src/full/Agda/Utils/String.hs
index 399d0b5..587a5f7 100644
--- a/src/full/Agda/Utils/String.hs
+++ b/src/full/Agda/Utils/String.hs
@@ -4,10 +4,12 @@ module Agda.Utils.String
, addFinalNewLine
, indent
, Str(..)
+ , showThousandSep
) where
import Data.List
import Numeric
+import Agda.Utils.List
-- | 'quote' adds double quotes around the string, replaces newline
-- characters with @\n@, and escapes double quotes and backslashes
@@ -56,3 +58,7 @@ newtype Str = Str { getStr :: String }
instance Show Str where
show = getStr
+-- | Show a number using comma to separate powers of 1,000.
+
+showThousandSep :: Show a => a -> String
+showThousandSep = reverse . intercalate "," . chop 3 . reverse . show
diff --git a/src/full/Agda/Utils/Time.hs b/src/full/Agda/Utils/Time.hs
index fc47507..7d9145f 100644
--- a/src/full/Agda/Utils/Time.hs
+++ b/src/full/Agda/Utils/Time.hs
@@ -5,8 +5,12 @@
module Agda.Utils.Time
( ClockTime
, getClockTime
+ , measureTime
) where
+import Control.Monad.Trans
+import System.CPUTime
+
#if MIN_VERSION_directory(1,1,1)
import qualified Data.Time
#else
@@ -31,3 +35,14 @@ getClockTime =
#else
System.Time.getClockTime
#endif
+
+type Picoseconds = Integer
+
+-- | Measure the time of a computation. Returns the
+measureTime :: MonadIO m => m a -> m (a, Picoseconds)
+measureTime m = do
+ start <- liftIO $ getCPUTime
+ x <- m
+ stop <- liftIO $ getCPUTime
+ return (x, stop - start)
+
--
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