Agda (empty) → 2.2.0

raw patch · 186 files changed

+37921/−0 lines, 186 filesdep +QuickCheckdep +arraydep +basesetup-changed

Dependencies added: QuickCheck, array, base, binary, bytestring, containers, directory, filepath, ghc-prim, haskeline, haskell-src, haskell98, mtl, old-time, pretty, process, utf8-string, xhtml, zlib

Files

Agda.cabal +229/−0
LICENSE +21/−0
README +259/−0
Setup.hs +3/−0
dist/build/Agda/Syntax/Parser/Lexer.hs +410/−0
dist/build/Agda/Syntax/Parser/Parser.hs +3495/−0
src/data/Agda.css +30/−0
src/full/Agda/Compiler/Agate/Classify.hs +137/−0
src/full/Agda/Compiler/Agate/Common.hs +135/−0
src/full/Agda/Compiler/Agate/Main.hs +161/−0
src/full/Agda/Compiler/Agate/OptimizedPrinter.hs +305/−0
src/full/Agda/Compiler/Agate/TranslateName.hs +53/−0
src/full/Agda/Compiler/Agate/UntypedPrinter.hs +124/−0
src/full/Agda/Compiler/Alonzo/Haskell.hs +112/−0
src/full/Agda/Compiler/Alonzo/Main.hs +501/−0
src/full/Agda/Compiler/Alonzo/Names.hs +66/−0
src/full/Agda/Compiler/Alonzo/PatternMonad.hs +68/−0
src/full/Agda/Compiler/HaskellTypes.hs +117/−0
src/full/Agda/Compiler/MAlonzo/Compiler.hs +314/−0
src/full/Agda/Compiler/MAlonzo/Encode.hs +101/−0
src/full/Agda/Compiler/MAlonzo/Misc.hs +203/−0
src/full/Agda/Compiler/MAlonzo/Pretty.hs +19/−0
src/full/Agda/Compiler/MAlonzo/Primitives.hs +223/−0
src/full/Agda/Interaction/BasicOps.hs +424/−0
src/full/Agda/Interaction/CommandLine/CommandLine.hs +303/−0
src/full/Agda/Interaction/Exceptions.hs +26/−0
src/full/Agda/Interaction/GhciTop.hs +692/−0
src/full/Agda/Interaction/Highlighting/Emacs.hs +145/−0
src/full/Agda/Interaction/Highlighting/Generate.hs +482/−0
src/full/Agda/Interaction/Highlighting/HTML.hs +166/−0
src/full/Agda/Interaction/Highlighting/Precise.hs +308/−0
src/full/Agda/Interaction/Highlighting/Range.hs +99/−0
src/full/Agda/Interaction/Highlighting/Vim.hs +88/−0
src/full/Agda/Interaction/Imports.hs +502/−0
src/full/Agda/Interaction/Imports.hs-boot +9/−0
src/full/Agda/Interaction/MakeCase.hs +111/−0
src/full/Agda/Interaction/Monad.hs +44/−0
src/full/Agda/Interaction/Options.hs +334/−0
src/full/Agda/Main.hs +185/−0
src/full/Agda/Syntax/Abstract.hs +358/−0
src/full/Agda/Syntax/Abstract/Name.hs +246/−0
src/full/Agda/Syntax/Abstract/Pretty.hs +17/−0
src/full/Agda/Syntax/Abstract/Views.hs +46/−0
src/full/Agda/Syntax/Common.hs +127/−0
src/full/Agda/Syntax/Concrete.hs +345/−0
src/full/Agda/Syntax/Concrete/Definitions.hs +476/−0
src/full/Agda/Syntax/Concrete/Name.hs +167/−0
src/full/Agda/Syntax/Concrete/Operators.hs +336/−0
src/full/Agda/Syntax/Concrete/Operators/Parser.hs +139/−0
src/full/Agda/Syntax/Concrete/Pretty.hs +321/−0
src/full/Agda/Syntax/Fixity.hs +100/−0
src/full/Agda/Syntax/Info.hs +159/−0
src/full/Agda/Syntax/Internal.hs +294/−0
src/full/Agda/Syntax/Internal/Generic.hs +61/−0
src/full/Agda/Syntax/Internal/Pattern.hs +39/−0
src/full/Agda/Syntax/Literal.hs +38/−0
src/full/Agda/Syntax/Parser.hs +109/−0
src/full/Agda/Syntax/Parser/Alex.hs +97/−0
src/full/Agda/Syntax/Parser/Comments.hs +80/−0
src/full/Agda/Syntax/Parser/Layout.hs +149/−0
src/full/Agda/Syntax/Parser/Layout.hs-boot +8/−0
src/full/Agda/Syntax/Parser/LexActions.hs +237/−0
src/full/Agda/Syntax/Parser/LexActions.hs-boot +30/−0
src/full/Agda/Syntax/Parser/Lexer.x +255/−0
src/full/Agda/Syntax/Parser/LookAhead.hs +136/−0
src/full/Agda/Syntax/Parser/Monad.hs +307/−0
src/full/Agda/Syntax/Parser/Parser.y +974/−0
src/full/Agda/Syntax/Parser/StringLiterals.hs +213/−0
src/full/Agda/Syntax/Parser/Tokens.hs +69/−0
src/full/Agda/Syntax/Position.hs +423/−0
src/full/Agda/Syntax/Scope/Base.hs +432/−0
src/full/Agda/Syntax/Scope/Monad.hs +382/−0
src/full/Agda/Syntax/Strict.hs +84/−0
src/full/Agda/Syntax/Translation/AbstractToConcrete.hs +716/−0
src/full/Agda/Syntax/Translation/ConcreteToAbstract.hs +941/−0
src/full/Agda/Syntax/Translation/InternalToAbstract.hs +419/−0
src/full/Agda/Termination/CallGraph.hs +454/−0
src/full/Agda/Termination/Lexicographic.hs +238/−0
src/full/Agda/Termination/Matrix.hs +338/−0
src/full/Agda/Termination/Semiring.hs +66/−0
src/full/Agda/Termination/TermCheck.hs +555/−0
src/full/Agda/Termination/Termination.hs +257/−0
src/full/Agda/Tests.hs +44/−0
src/full/Agda/TypeChecker.hs +14/−0
src/full/Agda/TypeChecking/Abstract.hs +55/−0
src/full/Agda/TypeChecking/Constraints.hs +113/−0
src/full/Agda/TypeChecking/Conversion.hs +391/−0
src/full/Agda/TypeChecking/Conversion.hs-boot +19/−0
src/full/Agda/TypeChecking/Coverage.hs +370/−0
src/full/Agda/TypeChecking/Coverage/Match.hs +119/−0
src/full/Agda/TypeChecking/DisplayForm.hs +78/−0
src/full/Agda/TypeChecking/Empty.hs +39/−0
src/full/Agda/TypeChecking/Empty.hs-boot +9/−0
src/full/Agda/TypeChecking/Errors.hs +612/−0
src/full/Agda/TypeChecking/EtaContract.hs +43/−0
src/full/Agda/TypeChecking/Free.hs +96/−0
src/full/Agda/TypeChecking/Implicit.hs +42/−0
src/full/Agda/TypeChecking/Injectivity.hs +211/−0
src/full/Agda/TypeChecking/MetaVars.hs +456/−0
src/full/Agda/TypeChecking/MetaVars.hs-boot +8/−0
src/full/Agda/TypeChecking/Monad.hs +37/−0
src/full/Agda/TypeChecking/Monad/Base.hs +919/−0
src/full/Agda/TypeChecking/Monad/Builtin.hs +122/−0
src/full/Agda/TypeChecking/Monad/Closure.hs +17/−0
src/full/Agda/TypeChecking/Monad/Constraints.hs +42/−0
src/full/Agda/TypeChecking/Monad/Context.hs +147/−0
src/full/Agda/TypeChecking/Monad/Context.hs-boot +10/−0
src/full/Agda/TypeChecking/Monad/Debug.hs +8/−0
src/full/Agda/TypeChecking/Monad/Env.hs +40/−0
src/full/Agda/TypeChecking/Monad/Exception.hs +64/−0
src/full/Agda/TypeChecking/Monad/Imports.hs +94/−0
src/full/Agda/TypeChecking/Monad/MetaVars.hs +163/−0
src/full/Agda/TypeChecking/Monad/Mutual.hs +64/−0
src/full/Agda/TypeChecking/Monad/Open.hs +49/−0
src/full/Agda/TypeChecking/Monad/Options.hs +149/−0
src/full/Agda/TypeChecking/Monad/Signature.hs +427/−0
src/full/Agda/TypeChecking/Monad/SizedTypes.hs +55/−0
src/full/Agda/TypeChecking/Monad/State.hs +90/−0
src/full/Agda/TypeChecking/Monad/Statistics.hs +20/−0
src/full/Agda/TypeChecking/Monad/Trace.hs +65/−0
src/full/Agda/TypeChecking/Patterns/Match.hs +86/−0
src/full/Agda/TypeChecking/Patterns/Match.hs-boot +11/−0
src/full/Agda/TypeChecking/Polarity.hs +164/−0
src/full/Agda/TypeChecking/Polarity.hs-boot +8/−0
src/full/Agda/TypeChecking/Positivity.hs +431/−0
src/full/Agda/TypeChecking/Pretty.hs +148/−0
src/full/Agda/TypeChecking/Primitive.hs +392/−0
src/full/Agda/TypeChecking/Rebind.hs +31/−0
src/full/Agda/TypeChecking/Records.hs +101/−0
src/full/Agda/TypeChecking/Records.hs-boot +9/−0
src/full/Agda/TypeChecking/Reduce.hs +533/−0
src/full/Agda/TypeChecking/Rules/Builtin.hs +310/−0
src/full/Agda/TypeChecking/Rules/Data.hs +248/−0
src/full/Agda/TypeChecking/Rules/Decl.hs +248/−0
src/full/Agda/TypeChecking/Rules/Decl.hs-boot +14/−0
src/full/Agda/TypeChecking/Rules/Def.hs +562/−0
src/full/Agda/TypeChecking/Rules/Def.hs-boot +7/−0
src/full/Agda/TypeChecking/Rules/LHS.hs +583/−0
src/full/Agda/TypeChecking/Rules/LHS/Implicit.hs +59/−0
src/full/Agda/TypeChecking/Rules/LHS/Instantiate.hs +133/−0
src/full/Agda/TypeChecking/Rules/LHS/Problem.hs +55/−0
src/full/Agda/TypeChecking/Rules/LHS/Split.hs +125/−0
src/full/Agda/TypeChecking/Rules/LHS/Unify.hs +326/−0
src/full/Agda/TypeChecking/Rules/Record.hs +198/−0
src/full/Agda/TypeChecking/Rules/Term.hs +616/−0
src/full/Agda/TypeChecking/Rules/Term.hs-boot +9/−0
src/full/Agda/TypeChecking/Serialise.hs +693/−0
src/full/Agda/TypeChecking/SizedTypes.hs +241/−0
src/full/Agda/TypeChecking/Substitute.hs +404/−0
src/full/Agda/TypeChecking/Telescope.hs +119/−0
src/full/Agda/TypeChecking/Test/Generators.hs +510/−0
src/full/Agda/TypeChecking/Tests.hs +93/−0
src/full/Agda/TypeChecking/With.hs +262/−0
src/full/Agda/Utils/Char.hs +15/−0
src/full/Agda/Utils/Either.hs +40/−0
src/full/Agda/Utils/FileName.hs +243/−0
src/full/Agda/Utils/Fresh.hs +24/−0
src/full/Agda/Utils/Function.hs +12/−0
src/full/Agda/Utils/Generics.hs +28/−0
src/full/Agda/Utils/Graph.hs +77/−0
src/full/Agda/Utils/Hash.hs +12/−0
src/full/Agda/Utils/IO.hs +27/−0
src/full/Agda/Utils/Impossible.hs +32/−0
src/full/Agda/Utils/List.hs +116/−0
src/full/Agda/Utils/Map.hs +40/−0
src/full/Agda/Utils/Maybe.hs +13/−0
src/full/Agda/Utils/Monad.hs +111/−0
src/full/Agda/Utils/Monad/Undo.hs +63/−0
src/full/Agda/Utils/Permutation.hs +83/−0
src/full/Agda/Utils/Pointer.hs +25/−0
src/full/Agda/Utils/Pretty.hs +29/−0
src/full/Agda/Utils/QuickCheck.hs +24/−0
src/full/Agda/Utils/ReadP.hs +486/−0
src/full/Agda/Utils/SemiRing.hs +16/−0
src/full/Agda/Utils/Serialise.hs +163/−0
src/full/Agda/Utils/Size.hs +21/−0
src/full/Agda/Utils/String.hs +38/−0
src/full/Agda/Utils/Suffix.hs +24/−0
src/full/Agda/Utils/TestHelpers.hs +129/−0
src/full/Agda/Utils/Trace.hs +48/−0
src/full/Agda/Utils/Trie.hs +130/−0
src/full/Agda/Utils/Tuple.hs +15/−0
src/full/Agda/Utils/Unicode.hs +25/−0
src/full/Agda/Utils/Warshall.hs +526/−0
src/full/Agda/Version.hs +13/−0
src/full/Agda/undefined.h +1/−0

+ Agda.cabal view

@@ -0,0 +1,229 @@+name:            Agda+version:         2.2.0+cabal-version:   >= 1.4 && < 2+build-type:      Simple+license:         OtherLicense+license-file:    LICENSE+author:          Ulf Norell, Catarina Coquand, Makoto Takeyama, Nils Anders Danielsson, Andreas Abel, ...+maintainer:      Ulf Norell <ulfn@chalmers.se>+homepage:        http://wiki.portal.chalmers.se/agda/+bug-reports:     http://code.google.com/p/agda/issues/list+category:        Dependent types+synopsis:        A dependently typed functional programming language and proof assistant+description:+  Agda is a dependently typed functional programming language: It has+  inductive families, which are like Haskell's GADTs, but they can be+  indexed by values and not just types. It also has parameterised+  modules, mixfix operators, Unicode characters, and an interactive+  Emacs interface (the type checker can assist in the development of+  your code).+  .+  Agda is a proof assistant: It is an interactive system for writing+  and checking proofs. Agda is based on intuitionistic type theory, a+  foundational system for constructive mathematics developed by the+  Swedish logician Per Martin-Löf. It has many similarities with other+  proof assistants based on dependent types, such as Coq, Epigram and+  NuPRL.+tested-with:     GHC == 6.8.3 && == 6.10.1+extra-source-files: src/full/Agda/undefined.h+                    README+data-dir:        src/data+data-files:      Agda.css++library+  hs-source-dirs:  src/full+  build-depends:   base >= 3 && < 4,+                   mtl >= 1.1 && < 2,+                   QuickCheck == 2.1.0.1,+                   haskell98 >= 1.0.1 && < 2,+                   haskell-src >= 1.0.1.1 && < 2,+                   containers >= 0.1.0 && < 1,+                   pretty >= 1 && < 2,+                   directory >= 1 && < 2,+                   old-time >= 1 && < 2,+                   bytestring >= 0.9.0.1 && < 1,+                   array >= 0.1 && < 1,+                   binary >= 0.4.4 && < 0.5,+                   zlib >= 0.4.0.1 && < 1,+                   filepath >= 1.1 && < 2,+                   process >= 1.0.1.0 && < 2,+                   haskeline >= 0.3 && < 0.7,+                   utf8-string >= 0.3 && < 0.4,+                   xhtml >= 3000.2 && < 3000.3+  if impl(ghc >= 6.10)+    build-depends: ghc-prim >= 0.1 && < 1+  build-tools:     happy >= 1.15 && < 2,+                   alex >= 2.0.1 && < 3+  exposed-modules: Agda.Main+                   Agda.Interaction.BasicOps+                   Agda.Interaction.GhciTop+                   Agda.Compiler.Agate.Classify+                   Agda.Compiler.Agate.Common+                   Agda.Compiler.Agate.Main+                   Agda.Compiler.Agate.OptimizedPrinter+                   Agda.Compiler.Agate.TranslateName+                   Agda.Compiler.Agate.UntypedPrinter+                   Agda.Compiler.Alonzo.Main+                   Agda.Compiler.Alonzo.Names+                   Agda.Compiler.Alonzo.Haskell+                   Agda.Compiler.Alonzo.PatternMonad+                   Agda.Compiler.HaskellTypes+                   Agda.Compiler.MAlonzo.Compiler+                   Agda.Compiler.MAlonzo.Encode+                   Agda.Compiler.MAlonzo.Misc+                   Agda.Compiler.MAlonzo.Pretty+                   Agda.Compiler.MAlonzo.Primitives+                   Agda.Interaction.CommandLine.CommandLine+                   Agda.Interaction.Exceptions+                   Agda.Interaction.Highlighting.Emacs+                   Agda.Interaction.Highlighting.Generate+                   Agda.Interaction.Highlighting.HTML+                   Agda.Interaction.Highlighting.Precise+                   Agda.Interaction.Highlighting.Range+                   Agda.Interaction.Highlighting.Vim+                   Agda.Interaction.Imports+                   Agda.Interaction.MakeCase+                   Agda.Interaction.Monad+                   Agda.Interaction.Options+                   Agda.Syntax.Abstract.Name+                   Agda.Syntax.Abstract.Pretty+                   Agda.Syntax.Abstract.Views+                   Agda.Syntax.Abstract+                   Agda.Syntax.Common+                   Agda.Syntax.Concrete.Definitions+                   Agda.Syntax.Concrete.Name+                   Agda.Syntax.Concrete.Operators.Parser+                   Agda.Syntax.Concrete.Operators+                   Agda.Syntax.Concrete.Pretty+                   Agda.Syntax.Concrete+                   Agda.Syntax.Fixity+                   Agda.Syntax.Info+                   Agda.Syntax.Internal+                   Agda.Syntax.Internal.Generic+                   Agda.Syntax.Internal.Pattern+                   Agda.Syntax.Literal+                   Agda.Syntax.Parser.Alex+                   Agda.Syntax.Parser.Comments+                   Agda.Syntax.Parser.Layout+                   Agda.Syntax.Parser.LexActions+                   Agda.Syntax.Parser.Lexer+                   Agda.Syntax.Parser.LookAhead+                   Agda.Syntax.Parser.Monad+                   Agda.Syntax.Parser.Parser+                   Agda.Syntax.Parser.StringLiterals+                   Agda.Syntax.Parser.Tokens+                   Agda.Syntax.Parser+                   Agda.Syntax.Position+                   Agda.Syntax.Scope.Base+                   Agda.Syntax.Scope.Monad+                   Agda.Syntax.Strict+                   Agda.Syntax.Translation.AbstractToConcrete+                   Agda.Syntax.Translation.ConcreteToAbstract+                   Agda.Syntax.Translation.InternalToAbstract+                   Agda.Termination.CallGraph+                   Agda.Termination.Lexicographic+                   Agda.Termination.Matrix+                   Agda.Termination.Semiring+                   Agda.Termination.TermCheck+                   Agda.Termination.Termination+                   Agda.Tests+                   Agda.TypeChecker+                   Agda.TypeChecking.Abstract+                   Agda.TypeChecking.Constraints+                   Agda.TypeChecking.Conversion+                   Agda.TypeChecking.Coverage+                   Agda.TypeChecking.Coverage.Match+                   Agda.TypeChecking.DisplayForm+                   Agda.TypeChecking.Empty+                   Agda.TypeChecking.EtaContract+                   Agda.TypeChecking.Errors+                   Agda.TypeChecking.Free+                   Agda.TypeChecking.Implicit+                   Agda.TypeChecking.Injectivity+                   Agda.TypeChecking.MetaVars+                   Agda.TypeChecking.Monad.Base+                   Agda.TypeChecking.Monad.Builtin+                   Agda.TypeChecking.Monad.Closure+                   Agda.TypeChecking.Monad.Constraints+                   Agda.TypeChecking.Monad.Context+                   Agda.TypeChecking.Monad.Debug+                   Agda.TypeChecking.Monad.Env+                   Agda.TypeChecking.Monad.Exception+                   Agda.TypeChecking.Monad.Imports+                   Agda.TypeChecking.Monad.MetaVars+                   Agda.TypeChecking.Monad.Mutual+                   Agda.TypeChecking.Monad.Open+                   Agda.TypeChecking.Monad.Options+                   Agda.TypeChecking.Monad.Signature+                   Agda.TypeChecking.Monad.SizedTypes+                   Agda.TypeChecking.Monad.State+                   Agda.TypeChecking.Monad.Statistics+                   Agda.TypeChecking.Monad.Trace+                   Agda.TypeChecking.Monad+                   Agda.TypeChecking.Patterns.Match+                   Agda.TypeChecking.Polarity+                   Agda.TypeChecking.Positivity+                   Agda.TypeChecking.Pretty+                   Agda.TypeChecking.Primitive+                   Agda.TypeChecking.Rebind+                   Agda.TypeChecking.Records+                   Agda.TypeChecking.Reduce+                   Agda.TypeChecking.Rules.Builtin+                   Agda.TypeChecking.Rules.Data+                   Agda.TypeChecking.Rules.Decl+                   Agda.TypeChecking.Rules.Def+                   Agda.TypeChecking.Rules.LHS+                   Agda.TypeChecking.Rules.LHS.Implicit+                   Agda.TypeChecking.Rules.LHS.Instantiate+                   Agda.TypeChecking.Rules.LHS.Problem+                   Agda.TypeChecking.Rules.LHS.Split+                   Agda.TypeChecking.Rules.LHS.Unify+                   Agda.TypeChecking.Rules.Record+                   Agda.TypeChecking.Rules.Term+                   Agda.TypeChecking.Serialise+                   Agda.TypeChecking.SizedTypes+                   Agda.TypeChecking.Substitute+                   Agda.TypeChecking.Telescope+                   Agda.TypeChecking.Test.Generators+                   Agda.TypeChecking.Tests+                   Agda.TypeChecking.With+                   Agda.Utils.Char+                   Agda.Utils.Either+                   Agda.Utils.FileName+                   Agda.Utils.Fresh+                   Agda.Utils.Function+                   Agda.Utils.Generics+                   Agda.Utils.Graph+                   Agda.Utils.Hash+                   Agda.Utils.Impossible+                   Agda.Utils.IO+                   Agda.Utils.List+                   Agda.Utils.Map+                   Agda.Utils.Maybe+                   Agda.Utils.Monad.Undo+                   Agda.Utils.Monad+                   Agda.Utils.Permutation+                   Agda.Utils.Pointer+                   Agda.Utils.Pretty+                   Agda.Utils.QuickCheck+                   Agda.Utils.ReadP+                   Agda.Utils.SemiRing+                   Agda.Utils.Serialise+                   Agda.Utils.Size+                   Agda.Utils.String+                   Agda.Utils.Suffix+                   Agda.Utils.TestHelpers+                   Agda.Utils.Trace+                   Agda.Utils.Trie+                   Agda.Utils.Tuple+                   Agda.Utils.Unicode+                   Agda.Utils.Warshall+                   Agda.Version+  other-modules:   Paths_Agda+  ghc-options:     -auto-all -w -Werror -fwarn-dodgy-imports+                   -fwarn-duplicate-exports -fwarn-hi-shadowing+                   -fwarn-incomplete-patterns -fwarn-missing-fields+                   -fwarn-missing-methods -fwarn-overlapping-patterns+  if impl(ghc >= 6.10)+    ghc-options:   -fwarn-warnings-deprecations -fwarn-deprecated-flags+                   -fwarn-dodgy-foreign-imports

+ LICENSE view

@@ -0,0 +1,21 @@+Copyright (c) 2005-2009 Ulf Norell, Catarina Coquand, Makoto Takeyama,+Nils Anders Danielsson, Andreas Abel, Karl Mehltretter, Marcin Benke.++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be+included in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

+ README view

@@ -0,0 +1,259 @@+README+------++We recommend that you install Agda 2 using a binary package. To+install Agda 2 from source, proceed as follows:++(An appendix below lists a partial installation script for Ubuntu+Linux.)++0) Install prerequisites (recent versions of GHC, Alex, Happy and+   cabal-install, and perhaps also darcs, Emacs and haskell-mode).++   GHC:           http://www.haskell.org/ghc/+   Alex:          http://www.haskell.org/alex/+   Happy:         http://www.haskell.org/happy/+   cabal-install: http://www.haskell.org/cabal/+   darcs:         http://darcs.net/+   GNU Emacs:     http://www.gnu.org/software/emacs/+   haskell-mode:  http://haskell.org/haskell-mode/ (version 2.1 or later)++   Note: If you are downloading a source tar-ball, then you do not+   need Alex, Happy or darcs.++   For non-Windows users:+     The development files for the C library zlib have to be installed+     (see http://zlib.net). 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+     as root to get the correct files installed.++1) Download Agda 2, perhaps as follows:++     darcs get --partial http://code.haskell.org/Agda+     cd Agda++2) If your system is Unix-like you can now hopefully install the+   Agda 2 library, batch-mode tool and Emacs mode by running++     make install PREFIX=<installation location>++   (the PREFIX=<...> part can be omitted if the default location is OK+   for you).++   If your system is not sufficiently Unix-like, or you want to have+   more control, continue reading below.++3) Build and install the Agda 2 library. If you want to install it in+   the default location (you may need root privileges for this), use+   the following command in the root of the Agda source tree:++     cabal install++   You can select another location for the installation of the library+   by using the following command:++     cabal install --prefix=<the install path>++   You can also give other options to the installer, see the built-in+   documentation of cabal-install:++     cabal install --help++4) If you want to use the Emacs mode (recommended), build and install+   it (see below).++5) If you want to use the batch-mode Agda tool (not necessary), go to+   the src/main directory and run the following commands:++     cabal clean    # To ensure recompilation when upgrading.+     cabal install++   (You can give options to cabal-install just as under step 2.)++   When upgrading Agda, note that the batch-mode tool also needs to be+   rebuilt.++------------------------------------------------------------------------+To use the Agda 2 Emacs mode:++-1. Install Emacs.++   (For non-Windows - jump down to **END OF "Under Windows ...")+   **Under Windows you may want to follow the following procedure:++      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.+  **END OF "Under Windows ..."++1. Install Agda 2. (See above.)++2. Copy the .el files in src/emacs-mode to some directory+   <agda-mode-dir>. Example installation:++   mkdir <agda-mode-dir>+   cp src/emacs-mode/*.el <agda-mode-dir>++3. Add the following to your .emacs:++   (add-to-list 'load-path "<agda-mode-dir>")+   (require 'agda2)++   If you have already set up the suffix .agda for use with some other+   mode you may need to remove or alter that setting. You are+   encouraged to use the suffix .alfa for Agda 1 files.++   Now, if you open a file named XXX.agda the buffer will use+   agda2-mode. It may take 5 or 10 seconds before you see anything in+   the buffer, but that is normal.++4. If you want to you can customise some settings. 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.++5. 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:+                (inactivate-input-method)+                ; If you want to use the X input method:+                (set-input-method "X")+                ))++   A side note: In order to display Unicode characters you need to use+   a font which contains the glyphs in question. If such a font is not+   enabled by default (empty boxes are displayed instead of proper+   characters) you need to select another font. Do this by running+     M-x customize-face RET agda2-fontset-spec RET+   in Emacs (after you have started the Agda mode) and change the+   setting to a suitable font.++------------------------------------------------------------------+Appendix: Partial installation script for (at least) Ubuntu Linux++sudo apt-get install ghc6 happy alex darcs emacs haskell-mode zlib1g-dev+wget http://www.haskell.org/cabal/release/cabal-install-0.6.0.tar.gz+tar xzf cabal-install-0.6.0.tar.gz+cd cabal-install-0.6.0+. bootstrap.sh+cd ..+darcs get --partial http://code.haskell.org/Agda+cd Agda+sudo make install

+ Setup.hs view

@@ -0,0 +1,3 @@+import Distribution.Simple++main = defaultMain

+ dist/build/Agda/Syntax/Parser/Lexer.hs view

@@ -0,0 +1,410 @@+{-# OPTIONS -fglasgow-exts -cpp #-}+{-# LINE 1 "src/full/Agda/Syntax/Parser/Lexer.x" #-}++{-| The lexer is generated by Alex (<http://www.haskell.org/alex>) and is an+    adaptation of GHC's lexer. The main lexing function 'lexer' is called by+    the "Agda.Syntax.Parser.Parser" to get the next token from the input.+-}+module Agda.Syntax.Parser.Lexer+    ( -- * The main function+      lexer+      -- * Lex states+    , normal, literate, code+    , layout, empty_layout, bol, imp_dir+      -- * Alex generated functions+    , AlexReturn(..), alexScanUser+    ) where++import Data.List++import Agda.Syntax.Parser.Alex+import Agda.Syntax.Parser.Comments+#ifndef __HADDOCK__+import {-# SOURCE #-} Agda.Syntax.Parser.Layout+import {-# SOURCE #-} Agda.Syntax.Parser.LexActions+#endif+import Agda.Syntax.Parser.Monad+import Agda.Syntax.Parser.StringLiterals+import Agda.Syntax.Parser.Tokens+import Agda.Syntax.Literal+++#if __GLASGOW_HASKELL__ >= 603+#include "ghcconfig.h"+#elif defined(__GLASGOW_HASKELL__)+#include "config.h"+#endif+#if __GLASGOW_HASKELL__ >= 503+import Data.Array+import Data.Char (ord)+import Data.Array.Base (unsafeAt)+#else+import Array+import Char (ord)+#endif+#if __GLASGOW_HASKELL__ >= 503+import GHC.Exts+#else+import GlaExts+#endif+alex_base :: AlexAddr+alex_base = AlexA# "\xf8\xff\xff\xff\x6e\x00\x00\x00\xca\x00\x00\x00\x40\x01\x00\x00\x45\x01\x00\x00\x4a\x01\x00\x00\x50\x01\x00\x00\x73\x00\x00\x00\x7c\x00\x00\x00\x84\x00\x00\x00\x8b\x00\x00\x00\x94\x00\x00\x00\x9c\x00\x00\x00\xa4\xff\xff\xff\x77\x00\x00\x00\x56\x01\x00\x00\x70\x01\x00\x00\xa2\xff\xff\xff\x78\x00\x00\x00\xa1\xff\xff\xff\x79\x00\x00\x00\xa0\xff\xff\xff\x7a\x00\x00\x00\x9c\xff\xff\xff\xdc\x00\x00\x00\x90\xff\xff\xff\x0b\x00\x00\x00\xa9\xff\xff\xff\x81\x00\x00\x00\x9e\xff\xff\xff\x4e\x01\x00\x00\xaa\xff\xff\xff\x54\x01\x00\x00\xab\xff\xff\xff\x80\x00\x00\x00\x92\xff\xff\xff\x5a\x01\x00\x00\x07\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x09\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xaf\xff\xff\xff\xa8\xff\xff\xff\xb3\xff\xff\xff\x11\x00\x00\x00\x2f\x00\x00\x00\x2a\x00\x00\x00\x36\x00\x00\x00\x39\x00\x00\x00\x25\x00\x00\x00\xa1\x00\x00\x00\x00\x00\x00\x00\x82\x00\x00\x00\x8d\x00\x00\x00\xac\x00\x00\x00\xba\x00\x00\x00\x75\x01\x00\x00\x7a\x01\x00\x00\x80\x01\x00\x00\x9e\x01\x00\x00\xaa\x01\x00\x00\xc4\x01\x00\x00\xc9\x01\x00\x00\xcf\x01\x00\x00\xd4\x01\x00\x00\xe1\x01\x00\x00\xec\x01\x00\x00\xf1\x01\x00\x00\xf9\x01\x00\x00\xfe\x01\x00\x00\x1b\x02\x00\x00\x20\x02\x00\x00\x28\x02\x00\x00\x2d\x02\x00\x00\x38\x02\x00\x00\x46\x02\x00\x00\x50\x02\x00\x00\x55\x02\x00\x00\x5f\x02\x00\x00\x6d\x02\x00\x00\x77\x02\x00\x00\x7c\x02\x00\x00\x86\x02\x00\x00\x95\x02\x00\x00\xa1\x02\x00\x00\xa6\x02\x00\x00\xbe\x02\x00\x00\xc3\x02\x00\x00\xc8\x02\x00\x00\xe1\x02\x00\x00\xe6\x02\x00\x00\xeb\x02\x00\x00\x03\x03\x00\x00\x08\x03\x00\x00\x0d\x03\x00\x00\x12\x03\x00\x00\x2a\x03\x00\x00\x2f\x03\x00\x00\x34\x03\x00\x00\x39\x03\x00\x00\x54\x03\x00\x00\x5c\x03\x00\x00\x00\x00\x00\x00\x85\x00\x00\x00\xa7\x00\x00\x00\x70\x03\x00\x00\xa9\x00\x00\x00\xe1\x03\x00\x00\x52\x04\x00\x00\xc3\x04\x00\x00\x34\x05\x00\x00\xa5\x05\x00\x00\x01\x06\x00\x00\x8e\x00\x00\x00\x5d\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb9\x06\x00\x00\x15\x07\x00\x00\x71\x07\x00\x00\xcd\x07\x00\x00\x29\x08\x00\x00\x85\x08\x00\x00\xe1\x08\x00\x00\x3d\x09\x00\x00\x99\x09\x00\x00\xf5\x09\x00\x00\x51\x0a\x00\x00\xad\x0a\x00\x00\x09\x0b\x00\x00\x65\x0b\x00\x00\xc1\x0b\x00\x00\x1d\x0c\x00\x00\x79\x0c\x00\x00\xd5\x0c\x00\x00\x31\x0d\x00\x00\x8d\x0d\x00\x00\xe9\x0d\x00\x00\x45\x0e\x00\x00\xa1\x0e\x00\x00\xfd\x0e\x00\x00\x59\x0f\x00\x00\xb5\x0f\x00\x00\x11\x10\x00\x00\x6d\x10\x00\x00\xc9\x10\x00\x00\x25\x11\x00\x00\x81\x11\x00\x00\xdd\x11\x00\x00\x39\x12\x00\x00\x95\x12\x00\x00\xf1\x12\x00\x00\x4d\x13\x00\x00\xa9\x13\x00\x00\x05\x14\x00\x00\x61\x14\x00\x00\xbd\x14\x00\x00\x19\x15\x00\x00\x75\x15\x00\x00\xd1\x15\x00\x00\x2d\x16\x00\x00\x89\x16\x00\x00\xe5\x16\x00\x00\x41\x17\x00\x00\x9d\x17\x00\x00\xf9\x17\x00\x00\x55\x18\x00\x00\xb1\x18\x00\x00\x0d\x19\x00\x00\x69\x19\x00\x00\xc5\x19\x00\x00\x21\x1a\x00\x00\x7d\x1a\x00\x00\xd9\x1a\x00\x00\x35\x1b\x00\x00\x91\x1b\x00\x00\xed\x1b\x00\x00\x49\x1c\x00\x00\xa5\x1c\x00\x00\x01\x1d\x00\x00\x5d\x1d\x00\x00\xb9\x1d\x00\x00\x15\x1e\x00\x00\x71\x1e\x00\x00\xcd\x1e\x00\x00\x29\x1f\x00\x00\x85\x1f\x00\x00\xe1\x1f\x00\x00\x3d\x20\x00\x00\x99\x20\x00\x00\xf5\x20\x00\x00\x51\x21\x00\x00\xad\x21\x00\x00\x09\x22\x00\x00\x65\x22\x00\x00\xc1\x22\x00\x00\x1d\x23\x00\x00\x79\x23\x00\x00\xd5\x23\x00\x00\x31\x24\x00\x00\x8d\x24\x00\x00\xe9\x24\x00\x00\x45\x25\x00\x00\xa1\x25\x00\x00\xfd\x25\x00\x00\x59\x26\x00\x00\xb5\x26\x00\x00\x11\x27\x00\x00\x6d\x27\x00\x00\xc9\x27\x00\x00\x25\x28\x00\x00\x81\x28\x00\x00\xdd\x28\x00\x00\x39\x29\x00\x00\x95\x29\x00\x00\xf1\x29\x00\x00\x4d\x2a\x00\x00\xa9\x2a\x00\x00\x05\x2b\x00\x00\x61\x2b\x00\x00\xbd\x2b\x00\x00\x19\x2c\x00\x00\x75\x2c\x00\x00\xd1\x2c\x00\x00\x2d\x2d\x00\x00\x89\x2d\x00\x00\xe5\x2d\x00\x00\x41\x2e\x00\x00\x9d\x2e\x00\x00\xf9\x2e\x00\x00\x55\x2f\x00\x00\xb1\x2f\x00\x00\x0d\x30\x00\x00\x69\x30\x00\x00\xc5\x30\x00\x00\x21\x31\x00\x00\x7d\x31\x00\x00\xd9\x31\x00\x00\x00\x00\x00\x00\x4b\x00\x00\x00\x35\x32\x00\x00\x91\x32\x00\x00\xed\x32\x00\x00\x49\x33\x00\x00\xa5\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x8f\x00\x00\x00\x90\x00\x00\x00\x00\x00\x00\x00\x01\x34\x00\x00\x5d\x34\x00\x00\xb9\x34\x00\x00\x15\x35\x00\x00\x71\x35\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xcd\x35\x00\x00\x29\x36\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x85\x36\x00\x00\xe1\x36\x00\x00\x3d\x37\x00\x00\x99\x37\x00\x00\xf5\x37\x00\x00\x51\x38\x00\x00\xad\x38\x00\x00\x09\x39\x00\x00\x65\x39\x00\x00\xc1\x39\x00\x00\x1d\x3a\x00\x00\x79\x3a\x00\x00\xd5\x3a\x00\x00\x31\x3b\x00\x00\x8d\x3b\x00\x00\xe9\x3b\x00\x00\x45\x3c\x00\x00\xa1\x3c\x00\x00\xfd\x3c\x00\x00\x59\x3d\x00\x00\xb5\x3d\x00\x00\x11\x3e\x00\x00\x6d\x3e\x00\x00\xc9\x3e\x00\x00\x25\x3f\x00\x00\x81\x3f\x00\x00\xdd\x3f\x00\x00\x39\x40\x00\x00\x95\x40\x00\x00\xf1\x40\x00\x00\x4d\x41\x00\x00\xa9\x41\x00\x00\x05\x42\x00\x00\x61\x42\x00\x00\xbd\x42\x00\x00"#++alex_table :: AlexAddr+alex_table = AlexA# "\x00\x00\x35\x00\x76\x00\x35\x00\x35\x00\x35\x00\x11\x00\x13\x00\x15\x00\x17\x00\x19\x00\x1b\x00\x1d\x00\x1f\x00\x21\x00\x09\x00\x23\x00\x26\x00\xff\xff\x29\x00\x2d\x00\xff\xff\x2e\x00\x2f\x00\x35\x00\x28\x01\x0a\x01\x28\x01\x28\x01\x28\x01\x28\x01\x09\x01\x03\x01\x04\x01\x28\x01\x28\x01\x28\x01\x75\x00\xfb\x00\x28\x01\x0b\x01\x0c\x01\x0c\x01\x0c\x01\x0c\x01\x0c\x01\x0c\x01\x0c\x01\x0c\x01\x0c\x01\xfe\x00\xfd\x00\x28\x01\xff\x00\x28\x01\x01\x01\x07\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\xd7\x00\x28\x01\x28\x01\xd3\x00\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x06\x01\x28\x01\x28\x01\x00\x01\x28\x01\xcc\x00\x28\x01\xb4\x00\xae\x00\x28\x01\x87\x00\x28\x01\xeb\x00\x7d\x00\x28\x01\x28\x01\x7b\x00\xaa\x00\x28\x01\x9f\x00\x93\x00\x28\x01\xba\x00\x28\x01\x28\x01\xe5\x00\x28\x01\x82\x00\x28\x01\x28\x01\x28\x01\x37\x00\x02\x01\x08\x01\x28\x01\x35\x00\x77\x00\x35\x00\x35\x00\x35\x00\x10\x00\x2a\x00\x10\x00\x10\x00\x10\x00\xff\xff\xff\xff\xff\xff\xff\xff\x0f\x00\x1c\x00\x0f\x00\x0f\x00\x0f\x00\xff\xff\xff\xff\x30\x00\x0b\x00\x35\x00\x0b\x00\x0b\x00\x0b\x00\x31\x00\x10\x00\x0c\x00\xff\xff\x0c\x00\x0c\x00\x0c\x00\x32\x00\x33\x00\x74\x00\x0f\x00\x0b\x00\x34\x00\x0b\x00\x0b\x00\x0b\x00\x2b\x00\xf9\x00\x0b\x00\x0c\x00\xff\xff\x0c\x00\x0c\x00\x0c\x00\x35\x00\x0c\x00\x35\x00\x35\x00\x35\x00\x38\x00\x36\x00\xff\xff\x69\x00\xff\xff\x0b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xf2\x00\x6b\x00\x0c\x00\xfc\x00\xfa\x00\x00\x00\x00\x00\x35\x00\x00\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x00\x00\x00\x2c\x00\x00\x00\xff\xff\x00\x00\x00\x00\x0e\x00\x00\x00\x00\x00\x00\x00\x35\x00\x76\x00\x35\x00\x35\x00\x35\x00\x0d\x00\x12\x00\xff\xff\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x16\x00\x00\x00\x00\x00\x18\x00\x1e\x00\x24\x00\xff\xff\x3b\x00\x00\x00\x6a\x00\x35\x00\x28\x01\x0a\x01\x28\x01\x28\x01\x28\x01\x28\x01\x09\x01\x03\x01\x04\x01\x28\x01\x28\x01\x28\x01\x75\x00\xfb\x00\x28\x01\x0b\x01\x0c\x01\x0c\x01\x0c\x01\x0c\x01\x0c\x01\x0c\x01\x0c\x01\x0c\x01\x0c\x01\xfe\x00\xfd\x00\x28\x01\xff\x00\x28\x01\x01\x01\x07\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\xd7\x00\x28\x01\x28\x01\xd3\x00\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x06\x01\x28\x01\x28\x01\x00\x01\x28\x01\xcc\x00\x28\x01\xb4\x00\xae\x00\x28\x01\x87\x00\x28\x01\xeb\x00\x7d\x00\x28\x01\x28\x01\x7b\x00\xaa\x00\x28\x01\x9f\x00\x93\x00\x28\x01\xba\x00\x28\x01\x28\x01\xe5\x00\x28\x01\x82\x00\x28\x01\x28\x01\x28\x01\x37\x00\x02\x01\x08\x01\x28\x01\x35\x00\x1a\x00\x35\x00\x35\x00\x35\x00\x35\x00\x76\x00\x35\x00\x35\x00\x35\x00\x35\x00\x78\x00\x35\x00\x35\x00\x35\x00\xff\xff\x35\x00\x76\x00\x35\x00\x35\x00\x35\x00\xff\xff\x0f\x00\x35\x00\x0f\x00\x0f\x00\x0f\x00\xff\xff\x35\x00\x00\x00\x00\x00\x00\x00\x00\x00\x35\x00\x00\x00\x00\x00\x74\x00\x00\x00\x00\x00\x35\x00\x00\x00\x74\x00\x3d\x00\x00\x00\x00\x00\x0f\x00\x74\x00\x00\x00\x10\x00\xff\xff\x10\x00\x10\x00\x10\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x00\x00\x00\x10\x00\x00\x00\x47\x00\x4e\x00\x00\x00\xff\xff\x00\x00\x00\x00\x39\x00\x5f\x00\xff\xff\x00\x00\x65\x00\x00\x00\x00\x00\x40\x00\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x00\x3e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x22\x00\xf3\x00\x00\x00\x6a\x00\x00\x00\x20\x00\xff\xff\x00\x00\x6a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6a\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\x3a\x00\x0e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x00\x00\x00\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x00\x00\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\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\x00\x00\x00\x00\x41\x00\x00\x00\x00\x00\x00\x00\x43\x00\xff\xff\x00\x00\x3c\x00\x00\x00\x42\x00\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x44\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x00\x45\x00\x00\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x00\x00\x00\x00\x00\x3f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x00\x49\x00\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\x48\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x00\x00\x00\x00\x00\xff\xff\x4a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x00\x00\x00\x00\x00\xff\xff\x4c\x00\x00\x00\x00\x00\x4b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x46\x00\x00\x00\x00\x00\x00\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x00\x00\x00\x00\x00\xff\xff\x00\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x00\x4f\x00\x00\x00\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\x50\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x00\x00\x00\x51\x00\xff\xff\x00\x00\x52\x00\x00\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x00\xff\xff\x00\x00\x00\x00\x00\x00\x53\x00\x00\x00\x00\x00\x54\x00\x00\x00\x00\x00\x00\x00\x55\x00\xff\xff\x00\x00\x00\x00\x00\x00\x00\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\x00\x00\x00\x00\x00\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\x00\x00\x00\x00\x00\x00\x58\x00\xff\xff\x00\x00\x56\x00\x00\x00\x00\x00\xff\xff\x5b\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\x00\x00\x59\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x00\x00\x00\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\x00\x00\x00\x00\x00\x00\x00\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\x00\x00\x5c\x00\x00\x00\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\x00\x00\x00\x00\x5a\x00\x00\x00\xff\xff\x00\x00\x00\x00\x00\x00\x5d\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\x00\x00\x00\x00\x00\x00\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\x60\x00\x00\x00\x00\x00\x00\x00\xff\xff\x00\x00\x00\x00\x00\x00\x61\x00\xff\xff\x00\x00\x00\x00\x62\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x00\x00\x00\x63\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\x00\x00\xff\xff\x66\x00\x5e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x67\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6f\x00\x00\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x00\x00\x64\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x71\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x00\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x00\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\xff\xff\x6f\x00\x00\x00\x6f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6f\x00\x00\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x00\x00\x00\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x71\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x00\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x00\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\xff\xff\x6f\x00\x00\x00\x6f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6f\x00\x00\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x00\x00\x00\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x71\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x00\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x00\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\x6f\x00\xff\xff\x6f\x00\x00\x00\x6f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x70\x00\x00\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x00\x00\x00\x00\x70\x00\x70\x00\x70\x00\x70\x00\x71\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x00\x00\x70\x00\x70\x00\x70\x00\x70\x00\x00\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\xff\xff\x70\x00\x00\x00\x70\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6e\x00\x00\x00\x6e\x00\x6e\x00\x6e\x00\x6e\x00\x00\x00\x00\x00\x00\x00\x6e\x00\x6e\x00\x6e\x00\x6e\x00\x00\x00\x6e\x00\x6e\x00\x6e\x00\x6e\x00\x6e\x00\x6e\x00\x6e\x00\x6e\x00\x6e\x00\x6e\x00\x6e\x00\x6e\x00\x00\x00\x6e\x00\x6e\x00\x6e\x00\x6e\x00\x00\x00\x6e\x00\x6e\x00\x6e\x00\x6e\x00\x6e\x00\x6e\x00\x6e\x00\x6e\x00\x6e\x00\x6e\x00\x6e\x00\x6e\x00\x6e\x00\x6e\x00\x6e\x00\x6e\x00\x6e\x00\x6e\x00\x6e\x00\x6e\x00\x6e\x00\x6e\x00\x6e\x00\x6e\x00\x6e\x00\x6e\x00\x6e\x00\x72\x00\x6e\x00\x6e\x00\x73\x00\x6e\x00\x6e\x00\x6e\x00\x6e\x00\x6e\x00\x6e\x00\x6e\x00\x6e\x00\x6e\x00\x6e\x00\x6e\x00\x6e\x00\x6e\x00\x6e\x00\x6e\x00\x6e\x00\x6e\x00\x6e\x00\x6e\x00\x6e\x00\x6e\x00\x6e\x00\x6e\x00\x6e\x00\x6e\x00\x6e\x00\x6e\x00\xff\xff\x6e\x00\x00\x00\x6e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6e\x00\x00\x00\x6e\x00\x6e\x00\x6e\x00\x6e\x00\x6e\x00\x00\x00\x00\x00\x6e\x00\x6e\x00\x6e\x00\x6e\x00\x00\x00\x6e\x00\x6e\x00\x6e\x00\x6e\x00\x6e\x00\x6e\x00\x6e\x00\x6e\x00\x6e\x00\x6e\x00\x6e\x00\x6e\x00\x00\x00\x6e\x00\x6e\x00\x6e\x00\x6e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6e\x00\x6e\x00\x6e\x00\x6e\x00\x00\x00\x6e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6e\x00\x70\x00\x6e\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x00\x00\x00\x00\x70\x00\x70\x00\x70\x00\x70\x00\x00\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x00\x00\x70\x00\x70\x00\x70\x00\x70\x00\x00\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x00\x00\x70\x00\x29\x01\x70\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x6c\x00\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x05\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x79\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x7a\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\xbd\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\xa4\x00\x7c\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x7e\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x7f\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x80\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x81\x00\x8a\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x83\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x84\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x85\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x86\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\xdc\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x88\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x89\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x8b\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x8c\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x8d\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x8e\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x8f\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x90\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x91\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x92\x00\x29\x01\x29\x01\x9b\x00\x29\x01\x29\x01\xf8\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x94\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x95\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x96\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x97\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x98\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x99\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\xd0\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x9a\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x9c\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x9d\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x9e\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\xa0\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\xa1\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\xa2\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\xa3\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\xa5\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\xa6\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\xa7\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\xa8\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\xa9\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\xc4\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\xab\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\xac\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\xad\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\xaf\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\xb0\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\xb1\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\xb2\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\xb3\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\xb5\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\xb6\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\xb7\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\xb8\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\xf1\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\xb9\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\xbe\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\xbf\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\xbb\x00\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\xbc\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\xc0\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\xc1\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\xc2\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\xc3\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\xc5\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\xc6\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\xc7\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\xc8\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\xc9\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\xca\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\xcb\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\xcd\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\xce\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\xcf\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\xdd\x00\xde\x00\xde\x00\xde\x00\xde\x00\xde\x00\xde\x00\xde\x00\xde\x00\xde\x00\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\xd1\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\xd2\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\xd4\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\xd5\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\xd6\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\xd8\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\xd9\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\xda\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\xdb\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\xde\x00\xde\x00\xde\x00\xde\x00\xde\x00\xde\x00\xde\x00\xde\x00\xde\x00\xde\x00\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\xe0\x00\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\xde\x00\xde\x00\xde\x00\xde\x00\xde\x00\xde\x00\xde\x00\xde\x00\xde\x00\xde\x00\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\xdf\x00\xdf\x00\xdf\x00\xdf\x00\xdf\x00\xdf\x00\xdf\x00\xdf\x00\xdf\x00\xdf\x00\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\xdf\x00\xdf\x00\xdf\x00\xdf\x00\xdf\x00\xdf\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\xdf\x00\xdf\x00\xdf\x00\xdf\x00\xdf\x00\xdf\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\xdf\x00\xdf\x00\xdf\x00\xdf\x00\xdf\x00\xdf\x00\xdf\x00\xdf\x00\xdf\x00\xdf\x00\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\xdf\x00\xdf\x00\xdf\x00\xdf\x00\xdf\x00\xdf\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\xdf\x00\xdf\x00\xdf\x00\xdf\x00\xdf\x00\xdf\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\xe1\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\xe2\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\xe3\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\xe4\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\xe6\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\xe7\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\xe8\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\xe9\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\xea\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\xec\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\xed\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\xee\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\xef\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\xf0\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\xf4\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\xf5\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\xf6\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\xf7\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x2a\x01\x29\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x00\x00\x00\x00\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x00\x00\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x00\x00\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x00\x00\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x00\x00\x2a\x01\x29\x01\x2a\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x28\x01\x29\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x00\x00\x00\x00\x28\x01\x28\x01\x28\x01\x28\x01\x00\x00\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x00\x00\x28\x01\x28\x01\x28\x01\x28\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x28\x01\x28\x01\x28\x01\x28\x01\x00\x00\x28\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x28\x01\x29\x01\x28\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x20\x01\x29\x01\x0d\x01\x0d\x01\x0d\x01\x0d\x01\x0d\x01\x0d\x01\x0d\x01\x0d\x01\x0d\x01\x0d\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x25\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x25\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x12\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x20\x01\x29\x01\x0d\x01\x0d\x01\x0d\x01\x0d\x01\x0d\x01\x0d\x01\x0d\x01\x0d\x01\x0d\x01\x0d\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x25\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x25\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x20\x01\x29\x01\x0d\x01\x0d\x01\x0d\x01\x0d\x01\x0d\x01\x0d\x01\x0d\x01\x0d\x01\x0d\x01\x0d\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x25\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x25\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x20\x01\x29\x01\x0f\x01\x0f\x01\x0f\x01\x0f\x01\x0f\x01\x0f\x01\x0f\x01\x0f\x01\x0f\x01\x0f\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x11\x01\x11\x01\x11\x01\x11\x01\x10\x01\x11\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x11\x01\x11\x01\x11\x01\x11\x01\x10\x01\x11\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x27\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x20\x01\x29\x01\x0f\x01\x0f\x01\x0f\x01\x0f\x01\x0f\x01\x0f\x01\x0f\x01\x0f\x01\x0f\x01\x0f\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x11\x01\x11\x01\x11\x01\x11\x01\x10\x01\x11\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x11\x01\x11\x01\x11\x01\x11\x01\x10\x01\x11\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x26\x01\x29\x01\x26\x01\x20\x01\x29\x01\x0e\x01\x0f\x01\x0f\x01\x0f\x01\x0f\x01\x0f\x01\x0f\x01\x0f\x01\x0f\x01\x0f\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x11\x01\x11\x01\x11\x01\x11\x01\x10\x01\x11\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x11\x01\x11\x01\x11\x01\x11\x01\x10\x01\x11\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x20\x01\x29\x01\x11\x01\x11\x01\x11\x01\x11\x01\x11\x01\x11\x01\x11\x01\x11\x01\x11\x01\x11\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x11\x01\x11\x01\x11\x01\x11\x01\x10\x01\x11\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x11\x01\x11\x01\x11\x01\x11\x01\x10\x01\x11\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x11\x01\x11\x01\x11\x01\x11\x01\x11\x01\x11\x01\x11\x01\x11\x01\x11\x01\x11\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x11\x01\x11\x01\x11\x01\x11\x01\x11\x01\x11\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x11\x01\x11\x01\x11\x01\x11\x01\x11\x01\x11\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x15\x01\x15\x01\x15\x01\x15\x01\x15\x01\x15\x01\x15\x01\x15\x01\x15\x01\x15\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x22\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x22\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x21\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x15\x01\x15\x01\x15\x01\x15\x01\x15\x01\x15\x01\x15\x01\x15\x01\x15\x01\x15\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x22\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x22\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x15\x01\x15\x01\x15\x01\x15\x01\x15\x01\x15\x01\x15\x01\x15\x01\x15\x01\x15\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x22\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x22\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x23\x01\x29\x01\x23\x01\x2b\x01\x29\x01\x17\x01\x18\x01\x18\x01\x18\x01\x18\x01\x18\x01\x18\x01\x18\x01\x18\x01\x18\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x19\x01\x19\x01\x19\x01\x19\x01\x16\x01\x19\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x19\x01\x19\x01\x19\x01\x19\x01\x16\x01\x19\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x18\x01\x18\x01\x18\x01\x18\x01\x18\x01\x18\x01\x18\x01\x18\x01\x18\x01\x18\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x19\x01\x19\x01\x19\x01\x19\x01\x16\x01\x19\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x19\x01\x19\x01\x19\x01\x19\x01\x16\x01\x19\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x24\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x18\x01\x18\x01\x18\x01\x18\x01\x18\x01\x18\x01\x18\x01\x18\x01\x18\x01\x18\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x19\x01\x19\x01\x19\x01\x19\x01\x16\x01\x19\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x19\x01\x19\x01\x19\x01\x19\x01\x16\x01\x19\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x19\x01\x19\x01\x19\x01\x19\x01\x19\x01\x19\x01\x19\x01\x19\x01\x19\x01\x19\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x19\x01\x19\x01\x19\x01\x19\x01\x16\x01\x19\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x19\x01\x19\x01\x19\x01\x19\x01\x16\x01\x19\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x1b\x01\x1b\x01\x1b\x01\x1b\x01\x1b\x01\x1b\x01\x1b\x01\x1b\x01\x1b\x01\x1b\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x24\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x1b\x01\x1b\x01\x1b\x01\x1b\x01\x1b\x01\x1b\x01\x1b\x01\x1b\x01\x1b\x01\x1b\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x1c\x01\x1c\x01\x1c\x01\x1c\x01\x1c\x01\x1c\x01\x1c\x01\x1c\x01\x1c\x01\x1c\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x1c\x01\x1c\x01\x1c\x01\x1c\x01\x1c\x01\x1c\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x1c\x01\x1c\x01\x1c\x01\x1c\x01\x1c\x01\x1c\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x1e\x01\x1e\x01\x1e\x01\x1e\x01\x1e\x01\x1e\x01\x1e\x01\x1e\x01\x1e\x01\x1e\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x27\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x1e\x01\x1e\x01\x1e\x01\x1e\x01\x1e\x01\x1e\x01\x1e\x01\x1e\x01\x1e\x01\x1e\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x1f\x01\x1f\x01\x1f\x01\x1f\x01\x1f\x01\x1f\x01\x1f\x01\x1f\x01\x1f\x01\x1f\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x1f\x01\x1f\x01\x1f\x01\x1f\x01\x1f\x01\x1f\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x1f\x01\x1f\x01\x1f\x01\x1f\x01\x1f\x01\x1f\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x28\x01\x29\x01\x28\x01\x28\x01\x28\x01\x28\x01\x00\x00\x00\x00\x00\x00\x28\x01\x28\x01\x28\x01\x28\x01\x00\x00\x28\x01\x13\x01\x14\x01\x14\x01\x14\x01\x14\x01\x14\x01\x14\x01\x14\x01\x14\x01\x14\x01\x28\x01\x00\x00\x28\x01\x28\x01\x28\x01\x28\x01\x00\x00\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x2c\x01\x28\x01\x28\x01\x2d\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x00\x00\x28\x01\x29\x01\x28\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x19\x01\x19\x01\x19\x01\x19\x01\x19\x01\x19\x01\x19\x01\x19\x01\x19\x01\x19\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x19\x01\x19\x01\x19\x01\x19\x01\x19\x01\x19\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x19\x01\x19\x01\x19\x01\x19\x01\x19\x01\x19\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x23\x01\x29\x01\x23\x01\x2b\x01\x29\x01\x1a\x01\x1b\x01\x1b\x01\x1b\x01\x1b\x01\x1b\x01\x1b\x01\x1b\x01\x1b\x01\x1b\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x1a\x01\x1b\x01\x1b\x01\x1b\x01\x1b\x01\x1b\x01\x1b\x01\x1b\x01\x1b\x01\x1b\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x1c\x01\x1c\x01\x1c\x01\x1c\x01\x1c\x01\x1c\x01\x1c\x01\x1c\x01\x1c\x01\x1c\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x1c\x01\x1c\x01\x1c\x01\x1c\x01\x1c\x01\x1c\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x1c\x01\x1c\x01\x1c\x01\x1c\x01\x1c\x01\x1c\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x26\x01\x29\x01\x26\x01\x2b\x01\x29\x01\x1d\x01\x1e\x01\x1e\x01\x1e\x01\x1e\x01\x1e\x01\x1e\x01\x1e\x01\x1e\x01\x1e\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x1d\x01\x1e\x01\x1e\x01\x1e\x01\x1e\x01\x1e\x01\x1e\x01\x1e\x01\x1e\x01\x1e\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x1f\x01\x1f\x01\x1f\x01\x1f\x01\x1f\x01\x1f\x01\x1f\x01\x1f\x01\x1f\x01\x1f\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x1f\x01\x1f\x01\x1f\x01\x1f\x01\x1f\x01\x1f\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x1f\x01\x1f\x01\x1f\x01\x1f\x01\x1f\x01\x1f\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x2b\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x29\x01\x00\x00\x29\x01\x2a\x01\x29\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x00\x00\x00\x00\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2b\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x00\x00\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x00\x00\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x00\x00\x2a\x01\x28\x01\x2a\x01\x28\x01\x28\x01\x28\x01\x28\x01\x00\x00\x00\x00\x00\x00\x28\x01\x28\x01\x28\x01\x28\x01\x00\x00\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x00\x00\x28\x01\x28\x01\x28\x01\x28\x01\x00\x00\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x2c\x01\x28\x01\x28\x01\x2d\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x00\x00\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x00\x00\x00\x00\x28\x01\x28\x01\x28\x01\x28\x01\x00\x00\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x28\x01\x00\x00\x28\x01\x28\x01\x28\x01\x28\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x28\x01\x28\x01\x28\x01\x28\x01\x00\x00\x28\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x28\x01\x2a\x01\x28\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x00\x00\x00\x00\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x00\x00\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x00\x00\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x00\x00\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x2a\x01\x00\x00\x2a\x01\x00\x00\x2a\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"#++alex_check :: AlexAddr+alex_check = AlexA# "\xff\xff\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x62\x00\x65\x00\x67\x00\x69\x00\x6e\x00\x7b\x00\x63\x00\x6f\x00\x64\x00\x7d\x00\x65\x00\x0a\x00\x0a\x00\x0a\x00\x65\x00\x0a\x00\x6e\x00\x64\x00\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\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x09\x00\x7b\x00\x0b\x00\x0c\x00\x0d\x00\x0a\x00\x0a\x00\x7b\x00\x09\x00\x20\x00\x0b\x00\x0c\x00\x0d\x00\x63\x00\x20\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x6f\x00\x64\x00\x2d\x00\x20\x00\x09\x00\x65\x00\x0b\x00\x0c\x00\x0d\x00\x7d\x00\x21\x00\x20\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x09\x00\x20\x00\x0b\x00\x0c\x00\x0d\x00\x2d\x00\x23\x00\x0a\x00\x2d\x00\x0a\x00\x20\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x6f\x00\x2d\x00\x20\x00\x2e\x00\x2e\x00\xff\xff\xff\xff\x20\x00\xff\xff\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\xff\xff\xff\xff\x5c\x00\xff\xff\x20\x00\xff\xff\xff\xff\x5c\x00\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x5c\x00\x62\x00\x20\x00\xff\xff\xff\xff\x65\x00\xff\xff\xff\xff\x67\x00\xff\xff\xff\xff\x69\x00\x63\x00\x65\x00\x0a\x00\x2d\x00\xff\xff\x7b\x00\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\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x09\x00\x6e\x00\x0b\x00\x0c\x00\x0d\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0a\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0a\x00\x09\x00\x20\x00\x0b\x00\x0c\x00\x0d\x00\x0a\x00\x20\x00\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\xff\xff\x2d\x00\xff\xff\xff\xff\x20\x00\xff\xff\x2d\x00\x23\x00\xff\xff\xff\xff\x20\x00\x2d\x00\xff\xff\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\xff\xff\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\xff\xff\xff\xff\x20\x00\xff\xff\x42\x00\x43\x00\xff\xff\x20\x00\xff\xff\xff\xff\x23\x00\x49\x00\x20\x00\xff\xff\x4c\x00\xff\xff\xff\xff\x4f\x00\x20\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5c\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\xff\xff\x2d\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5c\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x64\x00\x74\x00\xff\xff\x7b\x00\xff\xff\x6f\x00\x20\x00\xff\xff\x7b\x00\xff\xff\xff\xff\xff\xff\xff\xff\x7b\x00\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\x7b\x00\x5c\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x7d\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\xff\xff\xff\xff\x20\x00\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x20\x00\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\xff\xff\xff\xff\x20\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x20\x00\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\xff\xff\x50\x00\xff\xff\xff\xff\xff\xff\x49\x00\x20\x00\xff\xff\x7d\x00\xff\xff\x54\x00\x20\x00\xff\xff\xff\xff\xff\xff\xff\xff\x4f\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\xff\xff\x4e\x00\xff\xff\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x20\x00\xff\xff\xff\xff\xff\xff\x53\x00\x20\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\xff\xff\x49\x00\x20\x00\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\x55\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\xff\xff\xff\xff\xff\xff\x20\x00\x4c\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\xff\xff\xff\xff\xff\xff\x20\x00\x49\x00\xff\xff\xff\xff\x54\x00\x20\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x4e\x00\xff\xff\xff\xff\xff\xff\x20\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\xff\xff\x4f\x00\xff\xff\x20\x00\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\x4d\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\xff\xff\xff\xff\x50\x00\x20\x00\xff\xff\x49\x00\xff\xff\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\xff\xff\x20\x00\xff\xff\xff\xff\xff\xff\x4c\x00\xff\xff\xff\xff\x45\x00\xff\xff\xff\xff\xff\xff\x44\x00\x20\x00\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\xff\xff\xff\xff\xff\xff\x44\x00\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\xff\xff\xff\xff\x41\x00\x20\x00\xff\xff\x5f\x00\xff\xff\xff\xff\x20\x00\x54\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\xff\xff\x54\x00\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\xff\xff\x20\x00\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\xff\xff\x59\x00\xff\xff\x20\x00\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\xff\xff\x45\x00\xff\xff\x20\x00\xff\xff\xff\xff\xff\xff\x50\x00\x20\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\x4d\x00\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\xff\xff\xff\xff\x50\x00\x20\x00\xff\xff\xff\xff\x4f\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\xff\xff\xff\xff\x52\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0a\x00\xff\xff\x20\x00\x49\x00\x54\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x21\x00\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\x45\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x0a\x00\x7c\x00\xff\xff\x7e\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\x21\x00\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x0a\x00\x7c\x00\xff\xff\x7e\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\x21\x00\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x0a\x00\x7c\x00\xff\xff\x7e\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\x21\x00\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x0a\x00\x7c\x00\xff\xff\x7e\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\x21\x00\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\xff\xff\xff\xff\xff\xff\x2a\x00\x2b\x00\x2c\x00\x2d\x00\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x0a\x00\x7c\x00\xff\xff\x7e\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\x21\x00\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\x2b\x00\x2c\x00\x2d\x00\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\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\x5b\x00\x5c\x00\x5d\x00\x5e\x00\xff\xff\x60\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0a\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\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\x2b\x00\x2c\x00\x2d\x00\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\x2b\x00\x2c\x00\x2d\x00\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\x2b\x00\x2c\x00\x2d\x00\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\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\x5b\x00\x5c\x00\x5d\x00\x5e\x00\xff\xff\x60\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\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\xff\xff\xff\xff\xff\xff\x2a\x00\x2b\x00\x2c\x00\x2d\x00\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\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\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\xff\xff\xff\xff\xff\xff\x2a\x00\x2b\x00\x2c\x00\x2d\x00\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\x2b\x00\x2c\x00\x2d\x00\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\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\x5b\x00\x5c\x00\x5d\x00\x5e\x00\xff\xff\x60\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\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\x2b\x00\x2c\x00\x2d\x00\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\xff\xff\x7e\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\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\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\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\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"#++alex_deflt :: AlexAddr+alex_deflt = AlexA# "\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x68\x00\x27\x00\xff\xff\xff\xff\x27\x00\xff\xff\x27\x00\xff\xff\x27\x00\xff\xff\x27\x00\xff\xff\x27\x00\xff\xff\x27\x00\xff\xff\x27\x00\xff\xff\x27\x00\xff\xff\x27\x00\xff\xff\x27\x00\xff\xff\x27\x00\xff\xff\x27\x00\xff\xff\x27\x00\xff\xff\x27\x00\xff\xff\xff\xff\x27\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\x68\x00\x68\x00\x68\x00\x68\x00\x68\x00\x68\x00\x68\x00\x68\x00\x68\x00\x68\x00\x68\x00\x68\x00\x68\x00\x68\x00\x68\x00\x68\x00\x68\x00\x68\x00\x68\x00\x68\x00\x68\x00\x68\x00\x68\x00\x68\x00\x68\x00\x68\x00\x68\x00\x68\x00\x68\x00\x68\x00\x68\x00\x68\x00\x68\x00\x68\x00\x68\x00\x68\x00\x68\x00\x68\x00\x68\x00\x68\x00\x68\x00\x68\x00\x68\x00\x68\x00\x68\x00\x68\x00\x68\x00\x68\x00\xff\xff\xff\xff\x6d\x00\x6d\x00\x6d\x00\x6d\x00\x6d\x00\x6d\x00\x6d\x00\x6d\x00\x6d\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\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\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\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\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\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\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"#++alex_accept = listArray (0::Int,301) [[],[(AlexAccPred  (alex_action_22) ( not' eof ))],[],[(AlexAcc (alex_action_25))],[],[(AlexAcc (alex_action_24))],[],[(AlexAccPred  (alex_action_1) (alexRightContext 40))],[],[(AlexAccPred  (alex_action_0) (alexRightContext 37))],[(AlexAccPred  (alex_action_0) (alexRightContext 37)),(AlexAccPred  (alex_action_1) (alexRightContext 40)),(AlexAcc (alex_action_2))],[(AlexAccPred  (alex_action_0) (alexRightContext 37))],[(AlexAccPred  (alex_action_0) (alexRightContext 37)),(AlexAccPred  (alex_action_1) (alexRightContext 40)),(AlexAcc (alex_action_2))],[],[(AlexAccPred  (alex_action_1) (alexRightContext 40)),(AlexAcc (alex_action_2))],[],[(AlexAccPred  (alex_action_1) (alexRightContext 40)),(AlexAcc (alex_action_2))],[],[(AlexAccPred  (alex_action_1) (alexRightContext 40)),(AlexAcc (alex_action_2))],[],[(AlexAccPred  (alex_action_1) (alexRightContext 40)),(AlexAcc (alex_action_2))],[],[(AlexAccPred  (alex_action_1) (alexRightContext 40)),(AlexAcc (alex_action_2))],[],[(AlexAccPred  (alex_action_1) (alexRightContext 40)),(AlexAcc (alex_action_2))],[],[(AlexAccPred  (alex_action_1) (alexRightContext 40)),(AlexAcc (alex_action_2))],[],[(AlexAccPred  (alex_action_1) (alexRightContext 40)),(AlexAcc (alex_action_2))],[],[(AlexAccPred  (alex_action_1) (alexRightContext 40)),(AlexAcc (alex_action_2))],[],[(AlexAccPred  (alex_action_1) (alexRightContext 40)),(AlexAcc (alex_action_2))],[],[(AlexAccPred  (alex_action_1) (alexRightContext 40)),(AlexAcc (alex_action_2))],[],[(AlexAccPred  (alex_action_1) (alexRightContext 40)),(AlexAcc (alex_action_2))],[],[(AlexAccSkip)],[(AlexAccPred  (alex_action_1) (alexRightContext 40)),(AlexAcc (alex_action_2))],[],[(AlexAccSkip)],[(AlexAccSkip)],[(AlexAccPred  (alex_action_4) ( inState code ))],[],[],[],[],[],[],[],[],[],[(AlexAccSkip)],[(AlexAcc (alex_action_6))],[(AlexAcc (alex_action_68))],[(AlexAccPred  (alex_action_17) ( not' (followedBy '#') ))],[(AlexAcc (alex_action_7))],[(AlexAcc (alex_action_16))],[(AlexAcc (alex_action_16))],[(AlexAcc (alex_action_8))],[(AlexAcc (alex_action_16))],[(AlexAcc (alex_action_16))],[(AlexAcc (alex_action_9))],[(AlexAcc (alex_action_16))],[(AlexAcc (alex_action_16))],[(AlexAcc (alex_action_16))],[(AlexAcc (alex_action_16))],[(AlexAcc (alex_action_16))],[(AlexAcc (alex_action_16))],[(AlexAcc (alex_action_10))],[(AlexAcc (alex_action_16))],[(AlexAcc (alex_action_16))],[(AlexAcc (alex_action_16))],[(AlexAcc (alex_action_16))],[(AlexAcc (alex_action_16))],[(AlexAcc (alex_action_16))],[(AlexAcc (alex_action_11))],[(AlexAcc (alex_action_16))],[(AlexAcc (alex_action_16))],[(AlexAcc (alex_action_16))],[(AlexAcc (alex_action_16))],[(AlexAcc (alex_action_16))],[(AlexAcc (alex_action_16))],[(AlexAcc (alex_action_16))],[(AlexAcc (alex_action_13))],[(AlexAcc (alex_action_16))],[(AlexAcc (alex_action_16))],[(AlexAcc (alex_action_16))],[(AlexAcc (alex_action_16))],[(AlexAcc (alex_action_12))],[(AlexAcc (alex_action_16))],[(AlexAcc (alex_action_16))],[(AlexAcc (alex_action_16))],[(AlexAcc (alex_action_14))],[(AlexAcc (alex_action_16))],[(AlexAcc (alex_action_16))],[(AlexAcc (alex_action_16))],[(AlexAcc (alex_action_16))],[(AlexAcc (alex_action_16))],[(AlexAcc (alex_action_15))],[(AlexAcc (alex_action_16))],[(AlexAcc (alex_action_16))],[(AlexAcc (alex_action_16))],[(AlexAcc (alex_action_16))],[(AlexAccPred  (alex_action_17) ( not' (followedBy '#') ))],[],[(AlexAccPred  (alex_action_18) ( keepComments .&&. (followedBy '\n' .||. eof) )),(AlexAccSkipPred  ( followedBy '\n' .||. eof ))],[(AlexAccPred  (alex_action_18) ( keepComments .&&. (followedBy '\n' .||. eof) )),(AlexAccSkipPred  ( followedBy '\n' .||. eof )),(AlexAcc (alex_action_74))],[(AlexAccPred  (alex_action_18) ( keepComments .&&. (followedBy '\n' .||. eof) )),(AlexAccSkipPred  ( followedBy '\n' .||. eof ))],[(AlexAccPred  (alex_action_18) ( keepComments .&&. (followedBy '\n' .||. eof) )),(AlexAccSkipPred  ( followedBy '\n' .||. eof )),(AlexAcc (alex_action_74))],[(AlexAccPred  (alex_action_18) ( keepComments .&&. (followedBy '\n' .||. eof) )),(AlexAccSkipPred  ( followedBy '\n' .||. eof )),(AlexAcc (alex_action_74))],[(AlexAccPred  (alex_action_18) ( keepComments .&&. (followedBy '\n' .||. eof) )),(AlexAccSkipPred  ( followedBy '\n' .||. eof )),(AlexAcc (alex_action_74))],[(AlexAccPred  (alex_action_18) ( keepComments .&&. (followedBy '\n' .||. eof) )),(AlexAccSkipPred  ( followedBy '\n' .||. eof ))],[(AlexAccPred  (alex_action_18) ( keepComments .&&. (followedBy '\n' .||. eof) )),(AlexAccSkipPred  ( followedBy '\n' .||. eof ))],[(AlexAccPred  (alex_action_18) ( keepComments .&&. (followedBy '\n' .||. eof) )),(AlexAccSkipPred  ( followedBy '\n' .||. eof ))],[],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_20))],[(AlexAccSkip)],[(AlexAccSkip)],[(AlexAcc (alex_action_26))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_27))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_28))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_29))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_30))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_31))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_32))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_33))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_34))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_35))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_36))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_37))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_38))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_39))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_40))],[(AlexAcc (alex_action_41))],[(AlexAcc (alex_action_42))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_43))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_44))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_45))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_46))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_47))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_48))],[(AlexAcc (alex_action_48))],[(AlexAcc (alex_action_48))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_49))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_50))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_51))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_52))],[],[(AlexAcc (alex_action_53))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_54))],[(AlexAcc (alex_action_55))],[(AlexAcc (alex_action_56))],[],[(AlexAcc (alex_action_57))],[(AlexAcc (alex_action_58))],[(AlexAcc (alex_action_59))],[(AlexAcc (alex_action_60))],[(AlexAcc (alex_action_61))],[(AlexAcc (alex_action_62))],[(AlexAcc (alex_action_63))],[(AlexAcc (alex_action_64))],[(AlexAcc (alex_action_65))],[(AlexAcc (alex_action_66))],[(AlexAcc (alex_action_67))],[(AlexAcc (alex_action_69))],[(AlexAcc (alex_action_70))],[(AlexAcc (alex_action_71))],[(AlexAcc (alex_action_72))],[(AlexAcc (alex_action_72))],[(AlexAcc (alex_action_72))],[(AlexAcc (alex_action_72))],[(AlexAcc (alex_action_72))],[(AlexAcc (alex_action_72))],[(AlexAcc (alex_action_72))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_73))],[(AlexAcc (alex_action_73))],[(AlexAcc (alex_action_73))],[(AlexAcc (alex_action_73))],[(AlexAcc (alex_action_73))],[(AlexAcc (alex_action_73))],[(AlexAcc (alex_action_73))],[(AlexAcc (alex_action_73))],[(AlexAcc (alex_action_73))],[(AlexAcc (alex_action_73))],[(AlexAcc (alex_action_73))],[(AlexAcc (alex_action_73))],[(AlexAcc (alex_action_73))],[],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_74))],[(AlexAcc (alex_action_74))],[],[],[]]+{-# LINE 182 "src/full/Agda/Syntax/Parser/Lexer.x" #-}+++-- | This is the initial state for parsing a literate file. Code blocks+--   should be enclosed in @\\begin{code}@ @\\end{code}@ pairs.+literate :: LexState+literate = tex+++-- | This is the initial state for parsing a regular, non-literate file.+normal :: LexState+normal = 0+++{-| The layout state. Entered when we see a layout keyword ('withLayout') and+    exited either when seeing an open brace ('openBrace') or at the next token+    ('newLayoutContext').++    Update: we don't use braces for layout anymore.+-}+layout :: LexState+layout = layout_+++{-| The state inside a pragma.+-}+pragma :: LexState+pragma = pragma_++{-| We enter this state from 'newLayoutContext' when the token following a+    layout keyword is to the left of (or at the same column as) the current+    layout context. Example:++    > data Empty : Set where+    > foo : Empty -> Nat++    Here the second line is not part of the @where@ clause since it is has the+    same indentation as the @data@ definition. What we have to do is insert an+    empty layout block @{}@ after the @where@. The only thing that can happen+    in this state is that 'emptyLayout' is executed, generating the closing+    brace. The open brace is generated when entering by 'newLayoutContext'.+-}+empty_layout :: LexState+empty_layout = empty_layout_+++-- | This state is entered at the beginning of each line. You can't lex+--   anything in this state, and to exit you have to check the layout rule.+--   Done with 'offsideRule'.+bol :: LexState+bol = bol_+++-- | This state can only be entered by the parser. In this state you can only+--   lex the keywords @using@, @hiding@, @renaming@ and @to@. Moreover they are+--   only keywords in this particular state. The lexer will never enter this+--   state by itself, that has to be done in the parser.+imp_dir :: LexState+imp_dir = imp_dir_+++-- | Return the next token. This is the function used by Happy in the parser.+--+--   @lexer k = 'lexToken' >>= k@+lexer :: (Token -> Parser a) -> Parser a+lexer k = lexToken >>= k++-- | Do not use this function; it sets the 'ParseFlags' to+-- 'undefined'.+alexScan :: AlexInput -> Int -> AlexReturn (LexAction Token)++-- | This is the main lexing function generated by Alex.+alexScanUser :: ([LexState], ParseFlags) -> AlexInput -> Int -> AlexReturn (LexAction Token)++++bol_,code,empty_layout_,imp_dir_,layout_,pragma_,tex :: Int+bol_ = 1+code = 2+empty_layout_ = 3+imp_dir_ = 4+layout_ = 5+pragma_ = 6+tex = 7+alex_action_0 =  end_ +alex_action_1 =  withInterval TokTeX +alex_action_2 =  withInterval TokTeX +alex_action_4 =  begin_ tex +alex_action_6 =  begin pragma +alex_action_7 =  symbol SymOpenPragma +alex_action_8 =  endWith $ symbol SymClosePragma +alex_action_9 =  keyword KwOPTIONS +alex_action_10 =  keyword KwBUILTIN +alex_action_11 =  keyword KwCOMPILED_DATA +alex_action_12 =  keyword KwCOMPILED_TYPE +alex_action_13 =  keyword KwCOMPILED +alex_action_14 =  keyword KwIMPORT +alex_action_15 =  keyword KwLINE +alex_action_16 =  withInterval $ TokString +alex_action_17 =  nestedComment +alex_action_18 =  withInterval TokComment +alex_action_20 =  begin bol_ +alex_action_22 =  offsideRule +alex_action_24 =  endWith newLayoutContext +alex_action_25 =  emptyLayout +alex_action_26 =  keyword KwLet +alex_action_27 =  keyword KwIn +alex_action_28 =  keyword KwWhere +alex_action_29 =  keyword KwField +alex_action_30 =  keyword KwWith +alex_action_31 =  keyword KwPostulate +alex_action_32 =  keyword KwPrimitive +alex_action_33 =  keyword KwOpen +alex_action_34 =  keyword KwImport +alex_action_35 =  keyword KwModule +alex_action_36 =  keyword KwData +alex_action_37 =  keyword KwCoData +alex_action_38 =  keyword KwRecord +alex_action_39 =  keyword KwInfix +alex_action_40 =  keyword KwInfixL +alex_action_41 =  keyword KwInfixR +alex_action_42 =  keyword KwMutual +alex_action_43 =  keyword KwAbstract +alex_action_44 =  keyword KwPrivate +alex_action_45 =  keyword KwSet +alex_action_46 =  keyword KwProp +alex_action_47 =  keyword KwForall +alex_action_48 =  withInterval' (read . drop 3) TokSetN +alex_action_49 =  keyword KwUsing +alex_action_50 =  keyword KwHiding +alex_action_51 =  keyword KwRenaming +alex_action_52 =  endWith $ keyword KwTo +alex_action_53 =  keyword KwPublic +alex_action_54 =  hole +alex_action_55 =  symbol SymEllipsis +alex_action_56 =  symbol SymDot +alex_action_57 =  symbol SymSemi +alex_action_58 =  symbol SymColon +alex_action_59 =  symbol SymEqual +alex_action_60 =  symbol SymUnderscore +alex_action_61 =  symbol SymQuestionMark +alex_action_62 =  symbol SymBar +alex_action_63 =  symbol SymOpenParen +alex_action_64 =  symbol SymCloseParen +alex_action_65 =  symbol SymArrow +alex_action_66 =  symbol SymLambda +alex_action_67 =  symbol SymAs +alex_action_68 =  symbol SymOpenBrace +alex_action_69 =  symbol SymCloseBrace +alex_action_70 =  litChar +alex_action_71 =  litString +alex_action_72 =  literal LitInt +alex_action_73 =  literal LitFloat +alex_action_74 =  identifier +{-# LINE 1 "templates/GenericTemplate.hs" #-}+{-# LINE 1 "templates/GenericTemplate.hs" #-}+{-# LINE 1 "<built-in>" #-}+{-# LINE 1 "<command-line>" #-}+{-# LINE 1 "templates/GenericTemplate.hs" #-}+-- -----------------------------------------------------------------------------+-- ALEX TEMPLATE+--+-- This code is in the PUBLIC DOMAIN; you may copy it freely and use+-- it for any purpose whatsoever.++-- -----------------------------------------------------------------------------+-- INTERNALS and main scanner engine++{-# LINE 35 "templates/GenericTemplate.hs" #-}++{-# LINE 45 "templates/GenericTemplate.hs" #-}+++data AlexAddr = AlexA# Addr#++#if __GLASGOW_HASKELL__ < 503+uncheckedShiftL# = shiftL#+#endif++{-# INLINE alexIndexInt16OffAddr #-}+alexIndexInt16OffAddr (AlexA# arr) off =+#ifdef WORDS_BIGENDIAN+  narrow16Int# i+  where+	i    = word2Int# ((high `uncheckedShiftL#` 8#) `or#` low)+	high = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#)))+	low  = int2Word# (ord# (indexCharOffAddr# arr off'))+	off' = off *# 2#+#else+  indexInt16OffAddr# arr off+#endif++++++{-# INLINE alexIndexInt32OffAddr #-}+alexIndexInt32OffAddr (AlexA# arr) off = +#ifdef WORDS_BIGENDIAN+  narrow32Int# i+  where+   i    = word2Int# ((b3 `uncheckedShiftL#` 24#) `or#`+		     (b2 `uncheckedShiftL#` 16#) `or#`+		     (b1 `uncheckedShiftL#` 8#) `or#` b0)+   b3   = int2Word# (ord# (indexCharOffAddr# arr (off' +# 3#)))+   b2   = int2Word# (ord# (indexCharOffAddr# arr (off' +# 2#)))+   b1   = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#)))+   b0   = int2Word# (ord# (indexCharOffAddr# arr off'))+   off' = off *# 4#+#else+  indexInt32OffAddr# arr off+#endif++++++#if __GLASGOW_HASKELL__ < 503+quickIndex arr i = arr ! i+#else+-- GHC >= 503, unsafeAt is available from Data.Array.Base.+quickIndex = unsafeAt+#endif+++++-- -----------------------------------------------------------------------------+-- Main lexing routines++data AlexReturn a+  = AlexEOF+  | AlexError  !AlexInput+  | AlexSkip   !AlexInput !Int+  | AlexToken  !AlexInput !Int a++-- alexScan :: AlexInput -> StartCode -> AlexReturn a+alexScan input (I# (sc))+  = alexScanUser undefined input (I# (sc))++alexScanUser user input (I# (sc))+  = case alex_scan_tkn user input 0# input sc AlexNone of+	(AlexNone, input') ->+		case alexGetChar input of+			Nothing -> ++++				   AlexEOF+			Just _ ->++++				   AlexError input'++	(AlexLastSkip input len, _) ->++++		AlexSkip input len++	(AlexLastAcc k input len, _) ->++++		AlexToken input len k+++-- Push the input through the DFA, remembering the most recent accepting+-- state it encountered.++alex_scan_tkn user orig_input len input s last_acc =+  input `seq` -- strict in the input+  let +	new_acc = check_accs (alex_accept `quickIndex` (I# (s)))+  in+  new_acc `seq`+  case alexGetChar input of+     Nothing -> (new_acc, input)+     Just (c, new_input) -> ++++	let+		base   = alexIndexInt32OffAddr alex_base s+		(I# (ord_c)) = ord c+		offset = (base +# ord_c)+		check  = alexIndexInt16OffAddr alex_check offset+		+		new_s = if (offset >=# 0#) && (check ==# ord_c)+			  then alexIndexInt16OffAddr alex_table offset+			  else alexIndexInt16OffAddr alex_deflt s+	in+	case new_s of +	    -1# -> (new_acc, input)+		-- on an error, we want to keep the input *before* the+		-- character that failed, not after.+    	    _ -> alex_scan_tkn user orig_input (len +# 1#) +			new_input new_s new_acc++  where+	check_accs [] = last_acc+	check_accs (AlexAcc a : _) = AlexLastAcc a input (I# (len))+	check_accs (AlexAccSkip : _)  = AlexLastSkip  input (I# (len))+	check_accs (AlexAccPred a pred : rest)+	   | pred user orig_input (I# (len)) input+	   = AlexLastAcc a input (I# (len))+	check_accs (AlexAccSkipPred pred : rest)+	   | pred user orig_input (I# (len)) input+	   = AlexLastSkip input (I# (len))+	check_accs (_ : rest) = check_accs rest++data AlexLastAcc a+  = AlexNone+  | AlexLastAcc a !AlexInput !Int+  | AlexLastSkip  !AlexInput !Int++data AlexAcc a user+  = AlexAcc a+  | AlexAccSkip+  | AlexAccPred a (AlexAccPred user)+  | AlexAccSkipPred (AlexAccPred user)++type AlexAccPred user = user -> AlexInput -> Int -> AlexInput -> Bool++-- -----------------------------------------------------------------------------+-- Predicates on a rule++alexAndPred p1 p2 user in1 len in2+  = p1 user in1 len in2 && p2 user in1 len in2++--alexPrevCharIsPred :: Char -> AlexAccPred _ +alexPrevCharIs c _ input _ _ = c == alexInputPrevChar input++--alexPrevCharIsOneOfPred :: Array Char Bool -> AlexAccPred _ +alexPrevCharIsOneOf arr _ input _ _ = arr ! alexInputPrevChar input++--alexRightContext :: Int -> AlexAccPred _+alexRightContext (I# (sc)) user _ _ input = +     case alex_scan_tkn user input 0# input sc AlexNone of+	  (AlexNone, _) -> False+	  _ -> True+	-- TODO: there's no need to find the longest+	-- match when checking the right context, just+	-- the first match will do.++-- used by wrappers+iUnbox (I# (i)) = i

+ dist/build/Agda/Syntax/Parser/Parser.hs view

@@ -0,0 +1,3495 @@+{-# OPTIONS -fglasgow-exts -cpp #-}+{-# OPTIONS -fno-warn-incomplete-patterns #-}+{-| The parser is generated by Happy (<http://www.haskell.org/happy>).+-}+module Agda.Syntax.Parser.Parser (+      moduleParser+    , exprParser+    , tokensParser+    ) where++import Control.Monad+import Control.Monad.State+import Data.Char  (isDigit)+import Data.List+import Data.Maybe+import qualified Data.Traversable as T++import Agda.Syntax.Position+import Agda.Syntax.Parser.Monad+import Agda.Syntax.Parser.Lexer+import Agda.Syntax.Parser.Tokens+import Agda.Syntax.Concrete+import Agda.Syntax.Concrete.Name+import Agda.Syntax.Concrete.Pretty+import Agda.Syntax.Common+import Agda.Syntax.Fixity+import Agda.Syntax.Literal++import Agda.Utils.Monad+#if __GLASGOW_HASKELL__ >= 503+import Data.Array+#else+import Array+#endif+#if __GLASGOW_HASKELL__ >= 503+import GHC.Exts+#else+import GlaExts+#endif++-- parser produced by Happy Version 1.17++newtype HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57 = HappyAbsSyn HappyAny+#if __GLASGOW_HASKELL__ >= 607+type HappyAny = GHC.Exts.Any+#else+type HappyAny = forall a . a+#endif+happyIn6 :: ([Token]) -> (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57)+happyIn6 x = unsafeCoerce# x+{-# INLINE happyIn6 #-}+happyOut6 :: (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57) -> ([Token])+happyOut6 x = unsafeCoerce# x+{-# INLINE happyOut6 #-}+happyIn7 :: ([Token]) -> (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57)+happyIn7 x = unsafeCoerce# x+{-# INLINE happyIn7 #-}+happyOut7 :: (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57) -> ([Token])+happyOut7 x = unsafeCoerce# x+{-# INLINE happyOut7 #-}+happyIn8 :: (Token) -> (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57)+happyIn8 x = unsafeCoerce# x+{-# INLINE happyIn8 #-}+happyOut8 :: (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57) -> (Token)+happyOut8 x = unsafeCoerce# x+{-# INLINE happyOut8 #-}+happyIn9 :: (()) -> (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57)+happyIn9 x = unsafeCoerce# x+{-# INLINE happyIn9 #-}+happyOut9 :: (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57) -> (())+happyOut9 x = unsafeCoerce# x+{-# INLINE happyOut9 #-}+happyIn10 :: (([Pragma], [Declaration])) -> (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57)+happyIn10 x = unsafeCoerce# x+{-# INLINE happyIn10 #-}+happyOut10 :: (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57) -> (([Pragma], [Declaration]))+happyOut10 x = unsafeCoerce# x+{-# INLINE happyOut10 #-}+happyIn11 :: t11 -> (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57)+happyIn11 x = unsafeCoerce# x+{-# INLINE happyIn11 #-}+happyOut11 :: (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57) -> t11+happyOut11 x = unsafeCoerce# x+{-# INLINE happyOut11 #-}+happyIn12 :: t12 -> (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57)+happyIn12 x = unsafeCoerce# x+{-# INLINE happyIn12 #-}+happyOut12 :: (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57) -> t12+happyOut12 x = unsafeCoerce# x+{-# INLINE happyOut12 #-}+happyIn13 :: t13 -> (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57)+happyIn13 x = unsafeCoerce# x+{-# INLINE happyIn13 #-}+happyOut13 :: (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57) -> t13+happyOut13 x = unsafeCoerce# x+{-# INLINE happyOut13 #-}+happyIn14 :: (()) -> (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57)+happyIn14 x = unsafeCoerce# x+{-# INLINE happyIn14 #-}+happyOut14 :: (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57) -> (())+happyOut14 x = unsafeCoerce# x+{-# INLINE happyOut14 #-}+happyIn15 :: (Integer) -> (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57)+happyIn15 x = unsafeCoerce# x+{-# INLINE happyIn15 #-}+happyOut15 :: (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57) -> (Integer)+happyOut15 x = unsafeCoerce# x+{-# INLINE happyOut15 #-}+happyIn16 :: (Name) -> (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57)+happyIn16 x = unsafeCoerce# x+{-# INLINE happyIn16 #-}+happyOut16 :: (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57) -> (Name)+happyOut16 x = unsafeCoerce# x+{-# INLINE happyOut16 #-}+happyIn17 :: (QName) -> (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57)+happyIn17 x = unsafeCoerce# x+{-# INLINE happyIn17 #-}+happyOut17 :: (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57) -> (QName)+happyOut17 x = unsafeCoerce# x+{-# INLINE happyOut17 #-}+happyIn18 :: (QName) -> (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57)+happyIn18 x = unsafeCoerce# x+{-# INLINE happyIn18 #-}+happyOut18 :: (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57) -> (QName)+happyOut18 x = unsafeCoerce# x+{-# INLINE happyOut18 #-}+happyIn19 :: (Name) -> (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57)+happyIn19 x = unsafeCoerce# x+{-# INLINE happyIn19 #-}+happyOut19 :: (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57) -> (Name)+happyOut19 x = unsafeCoerce# x+{-# INLINE happyOut19 #-}+happyIn20 :: ([Name]) -> (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57)+happyIn20 x = unsafeCoerce# x+{-# INLINE happyIn20 #-}+happyOut20 :: (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57) -> ([Name])+happyOut20 x = unsafeCoerce# x+{-# INLINE happyOut20 #-}+happyIn21 :: ([Name]) -> (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57)+happyIn21 x = unsafeCoerce# x+{-# INLINE happyIn21 #-}+happyOut21 :: (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57) -> ([Name])+happyOut21 x = unsafeCoerce# x+{-# INLINE happyOut21 #-}+happyIn22 :: ([String]) -> (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57)+happyIn22 x = unsafeCoerce# x+{-# INLINE happyIn22 #-}+happyOut22 :: (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57) -> ([String])+happyOut22 x = unsafeCoerce# x+{-# INLINE happyOut22 #-}+happyIn23 :: (QName) -> (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57)+happyIn23 x = unsafeCoerce# x+{-# INLINE happyIn23 #-}+happyOut23 :: (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57) -> (QName)+happyOut23 x = unsafeCoerce# x+{-# INLINE happyOut23 #-}+happyIn24 :: (Expr) -> (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57)+happyIn24 x = unsafeCoerce# x+{-# INLINE happyIn24 #-}+happyOut24 :: (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57) -> (Expr)+happyOut24 x = unsafeCoerce# x+{-# INLINE happyOut24 #-}+happyIn25 :: t25 -> (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57)+happyIn25 x = unsafeCoerce# x+{-# INLINE happyIn25 #-}+happyOut25 :: (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57) -> t25+happyOut25 x = unsafeCoerce# x+{-# INLINE happyOut25 #-}+happyIn26 :: ([Expr]) -> (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57)+happyIn26 x = unsafeCoerce# x+{-# INLINE happyIn26 #-}+happyOut26 :: (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57) -> ([Expr])+happyOut26 x = unsafeCoerce# x+{-# INLINE happyOut26 #-}+happyIn27 :: ([Expr]) -> (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57)+happyIn27 x = unsafeCoerce# x+{-# INLINE happyIn27 #-}+happyOut27 :: (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57) -> ([Expr])+happyOut27 x = unsafeCoerce# x+{-# INLINE happyOut27 #-}+happyIn28 :: t28 -> (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57)+happyIn28 x = unsafeCoerce# x+{-# INLINE happyIn28 #-}+happyOut28 :: (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57) -> t28+happyOut28 x = unsafeCoerce# x+{-# INLINE happyOut28 #-}+happyIn29 :: ([Expr]) -> (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57)+happyIn29 x = unsafeCoerce# x+{-# INLINE happyIn29 #-}+happyOut29 :: (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57) -> ([Expr])+happyOut29 x = unsafeCoerce# x+{-# INLINE happyOut29 #-}+happyIn30 :: t30 -> (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57)+happyIn30 x = unsafeCoerce# x+{-# INLINE happyIn30 #-}+happyOut30 :: (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57) -> t30+happyOut30 x = unsafeCoerce# x+{-# INLINE happyOut30 #-}+happyIn31 :: ([(Name, Expr)]) -> (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57)+happyIn31 x = unsafeCoerce# x+{-# INLINE happyIn31 #-}+happyOut31 :: (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57) -> ([(Name, Expr)])+happyOut31 x = unsafeCoerce# x+{-# INLINE happyOut31 #-}+happyIn32 :: ([(Name, Expr)]) -> (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57)+happyIn32 x = unsafeCoerce# x+{-# INLINE happyIn32 #-}+happyOut32 :: (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57) -> ([(Name, Expr)])+happyOut32 x = unsafeCoerce# x+{-# INLINE happyOut32 #-}+happyIn33 :: ((Name, Expr)) -> (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57)+happyIn33 x = unsafeCoerce# x+{-# INLINE happyIn33 #-}+happyOut33 :: (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57) -> ((Name, Expr))+happyOut33 x = unsafeCoerce# x+{-# INLINE happyOut33 #-}+happyIn34 :: t34 -> (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57)+happyIn34 x = unsafeCoerce# x+{-# INLINE happyIn34 #-}+happyOut34 :: (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57) -> t34+happyOut34 x = unsafeCoerce# x+{-# INLINE happyOut34 #-}+happyIn35 :: t35 -> (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57)+happyIn35 x = unsafeCoerce# x+{-# INLINE happyIn35 #-}+happyOut35 :: (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57) -> t35+happyOut35 x = unsafeCoerce# x+{-# INLINE happyOut35 #-}+happyIn36 :: ([TypedBindings]) -> (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57)+happyIn36 x = unsafeCoerce# x+{-# INLINE happyIn36 #-}+happyOut36 :: (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57) -> ([TypedBindings])+happyOut36 x = unsafeCoerce# x+{-# INLINE happyOut36 #-}+happyIn37 :: (TypedBindings) -> (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57)+happyIn37 x = unsafeCoerce# x+{-# INLINE happyIn37 #-}+happyOut37 :: (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57) -> (TypedBindings)+happyOut37 x = unsafeCoerce# x+{-# INLINE happyOut37 #-}+happyIn38 :: ([TypedBinding]) -> (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57)+happyIn38 x = unsafeCoerce# x+{-# INLINE happyIn38 #-}+happyOut38 :: (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57) -> ([TypedBinding])+happyOut38 x = unsafeCoerce# x+{-# INLINE happyOut38 #-}+happyIn39 :: ([TypedBinding]) -> (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57)+happyIn39 x = unsafeCoerce# x+{-# INLINE happyIn39 #-}+happyOut39 :: (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57) -> ([TypedBinding])+happyOut39 x = unsafeCoerce# x+{-# INLINE happyOut39 #-}+happyIn40 :: (TypedBinding) -> (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57)+happyIn40 x = unsafeCoerce# x+{-# INLINE happyIn40 #-}+happyOut40 :: (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57) -> (TypedBinding)+happyOut40 x = unsafeCoerce# x+{-# INLINE happyOut40 #-}+happyIn41 :: ([LamBinding]) -> (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57)+happyIn41 x = unsafeCoerce# x+{-# INLINE happyIn41 #-}+happyOut41 :: (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57) -> ([LamBinding])+happyOut41 x = unsafeCoerce# x+{-# INLINE happyOut41 #-}+happyIn42 :: (([LamBinding], Hiding)) -> (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57)+happyIn42 x = unsafeCoerce# x+{-# INLINE happyIn42 #-}+happyOut42 :: (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57) -> (([LamBinding], Hiding))+happyOut42 x = unsafeCoerce# x+{-# INLINE happyOut42 #-}+happyIn43 :: ([Either Hiding LamBinding]) -> (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57)+happyIn43 x = unsafeCoerce# x+{-# INLINE happyIn43 #-}+happyOut43 :: (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57) -> ([Either Hiding LamBinding])+happyOut43 x = unsafeCoerce# x+{-# INLINE happyOut43 #-}+happyIn44 :: ([LamBinding]) -> (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57)+happyIn44 x = unsafeCoerce# x+{-# INLINE happyIn44 #-}+happyOut44 :: (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57) -> ([LamBinding])+happyOut44 x = unsafeCoerce# x+{-# INLINE happyOut44 #-}+happyIn45 :: ([LamBinding]) -> (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57)+happyIn45 x = unsafeCoerce# x+{-# INLINE happyIn45 #-}+happyOut45 :: (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57) -> ([LamBinding])+happyOut45 x = unsafeCoerce# x+{-# INLINE happyOut45 #-}+happyIn46 :: ((Maybe Name, ImportDirective)) -> (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57)+happyIn46 x = unsafeCoerce# x+{-# INLINE happyIn46 #-}+happyOut46 :: (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57) -> ((Maybe Name, ImportDirective))+happyOut46 x = unsafeCoerce# x+{-# INLINE happyOut46 #-}+happyIn47 :: (ImportDirective) -> (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57)+happyIn47 x = unsafeCoerce# x+{-# INLINE happyIn47 #-}+happyOut47 :: (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57) -> (ImportDirective)+happyOut47 x = unsafeCoerce# x+{-# INLINE happyOut47 #-}+happyIn48 :: (ImportDirective) -> (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57)+happyIn48 x = unsafeCoerce# x+{-# INLINE happyIn48 #-}+happyOut48 :: (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57) -> (ImportDirective)+happyOut48 x = unsafeCoerce# x+{-# INLINE happyOut48 #-}+happyIn49 :: (ImportDirective) -> (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57)+happyIn49 x = unsafeCoerce# x+{-# INLINE happyIn49 #-}+happyOut49 :: (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57) -> (ImportDirective)+happyOut49 x = unsafeCoerce# x+{-# INLINE happyOut49 #-}+happyIn50 :: (UsingOrHiding) -> (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57)+happyIn50 x = unsafeCoerce# x+{-# INLINE happyIn50 #-}+happyOut50 :: (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57) -> (UsingOrHiding)+happyOut50 x = unsafeCoerce# x+{-# INLINE happyOut50 #-}+happyIn51 :: ([(ImportedName, Name)]) -> (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57)+happyIn51 x = unsafeCoerce# x+{-# INLINE happyIn51 #-}+happyOut51 :: (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57) -> ([(ImportedName, Name)])+happyOut51 x = unsafeCoerce# x+{-# INLINE happyOut51 #-}+happyIn52 :: ([(ImportedName, Name)]) -> (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57)+happyIn52 x = unsafeCoerce# x+{-# INLINE happyIn52 #-}+happyOut52 :: (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57) -> ([(ImportedName, Name)])+happyOut52 x = unsafeCoerce# x+{-# INLINE happyOut52 #-}+happyIn53 :: ((ImportedName, Name)) -> (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57)+happyIn53 x = unsafeCoerce# x+{-# INLINE happyIn53 #-}+happyOut53 :: (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57) -> ((ImportedName, Name))+happyOut53 x = unsafeCoerce# x+{-# INLINE happyOut53 #-}+happyIn54 :: (ImportedName) -> (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57)+happyIn54 x = unsafeCoerce# x+{-# INLINE happyIn54 #-}+happyOut54 :: (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57) -> (ImportedName)+happyOut54 x = unsafeCoerce# x+{-# INLINE happyOut54 #-}+happyIn55 :: (ImportedName) -> (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57)+happyIn55 x = unsafeCoerce# x+{-# INLINE happyIn55 #-}+happyOut55 :: (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57) -> (ImportedName)+happyOut55 x = unsafeCoerce# x+{-# INLINE happyOut55 #-}+happyIn56 :: ([ImportedName]) -> (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57)+happyIn56 x = unsafeCoerce# x+{-# INLINE happyIn56 #-}+happyOut56 :: (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57) -> ([ImportedName])+happyOut56 x = unsafeCoerce# x+{-# INLINE happyOut56 #-}+happyIn57 :: t57 -> (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57)+happyIn57 x = unsafeCoerce# x+{-# INLINE happyIn57 #-}+happyOut57 :: (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57) -> t57+happyOut57 x = unsafeCoerce# x+{-# INLINE happyOut57 #-}+happyIn58 :: (LHS) -> (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57)+happyIn58 x = unsafeCoerce# x+{-# INLINE happyIn58 #-}+happyOut58 :: (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57) -> (LHS)+happyOut58 x = unsafeCoerce# x+{-# INLINE happyOut58 #-}+happyIn59 :: ([Pattern]) -> (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57)+happyIn59 x = unsafeCoerce# x+{-# INLINE happyIn59 #-}+happyOut59 :: (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57) -> ([Pattern])+happyOut59 x = unsafeCoerce# x+{-# INLINE happyOut59 #-}+happyIn60 :: ([Expr]) -> (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57)+happyIn60 x = unsafeCoerce# x+{-# INLINE happyIn60 #-}+happyOut60 :: (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57) -> ([Expr])+happyOut60 x = unsafeCoerce# x+{-# INLINE happyOut60 #-}+happyIn61 :: (WhereClause) -> (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57)+happyIn61 x = unsafeCoerce# x+{-# INLINE happyIn61 #-}+happyOut61 :: (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57) -> (WhereClause)+happyOut61 x = unsafeCoerce# x+{-# INLINE happyOut61 #-}+happyIn62 :: ([Declaration]) -> (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57)+happyIn62 x = unsafeCoerce# x+{-# INLINE happyIn62 #-}+happyOut62 :: (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57) -> ([Declaration])+happyOut62 x = unsafeCoerce# x+{-# INLINE happyOut62 #-}+happyIn63 :: (Declaration) -> (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57)+happyIn63 x = unsafeCoerce# x+{-# INLINE happyIn63 #-}+happyOut63 :: (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57) -> (Declaration)+happyOut63 x = unsafeCoerce# x+{-# INLINE happyOut63 #-}+happyIn64 :: (Declaration) -> (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57)+happyIn64 x = unsafeCoerce# x+{-# INLINE happyIn64 #-}+happyOut64 :: (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57) -> (Declaration)+happyOut64 x = unsafeCoerce# x+{-# INLINE happyOut64 #-}+happyIn65 :: (RHS) -> (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57)+happyIn65 x = unsafeCoerce# x+{-# INLINE happyIn65 #-}+happyOut65 :: (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57) -> (RHS)+happyOut65 x = unsafeCoerce# x+{-# INLINE happyOut65 #-}+happyIn66 :: (Declaration) -> (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57)+happyIn66 x = unsafeCoerce# x+{-# INLINE happyIn66 #-}+happyOut66 :: (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57) -> (Declaration)+happyOut66 x = unsafeCoerce# x+{-# INLINE happyOut66 #-}+happyIn67 :: (Declaration) -> (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57)+happyIn67 x = unsafeCoerce# x+{-# INLINE happyIn67 #-}+happyOut67 :: (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57) -> (Declaration)+happyOut67 x = unsafeCoerce# x+{-# INLINE happyOut67 #-}+happyIn68 :: (Declaration) -> (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57)+happyIn68 x = unsafeCoerce# x+{-# INLINE happyIn68 #-}+happyOut68 :: (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57) -> (Declaration)+happyOut68 x = unsafeCoerce# x+{-# INLINE happyOut68 #-}+happyIn69 :: ([Declaration]) -> (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57)+happyIn69 x = unsafeCoerce# x+{-# INLINE happyIn69 #-}+happyOut69 :: (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57) -> ([Declaration])+happyOut69 x = unsafeCoerce# x+{-# INLINE happyOut69 #-}+happyIn70 :: (Declaration) -> (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57)+happyIn70 x = unsafeCoerce# x+{-# INLINE happyIn70 #-}+happyOut70 :: (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57) -> (Declaration)+happyOut70 x = unsafeCoerce# x+{-# INLINE happyOut70 #-}+happyIn71 :: (Declaration) -> (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57)+happyIn71 x = unsafeCoerce# x+{-# INLINE happyIn71 #-}+happyOut71 :: (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57) -> (Declaration)+happyOut71 x = unsafeCoerce# x+{-# INLINE happyOut71 #-}+happyIn72 :: (Declaration) -> (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57)+happyIn72 x = unsafeCoerce# x+{-# INLINE happyIn72 #-}+happyOut72 :: (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57) -> (Declaration)+happyOut72 x = unsafeCoerce# x+{-# INLINE happyOut72 #-}+happyIn73 :: (Declaration) -> (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57)+happyIn73 x = unsafeCoerce# x+{-# INLINE happyIn73 #-}+happyOut73 :: (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57) -> (Declaration)+happyOut73 x = unsafeCoerce# x+{-# INLINE happyOut73 #-}+happyIn74 :: (Declaration) -> (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57)+happyIn74 x = unsafeCoerce# x+{-# INLINE happyIn74 #-}+happyOut74 :: (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57) -> (Declaration)+happyOut74 x = unsafeCoerce# x+{-# INLINE happyOut74 #-}+happyIn75 :: (Declaration) -> (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57)+happyIn75 x = unsafeCoerce# x+{-# INLINE happyIn75 #-}+happyOut75 :: (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57) -> (Declaration)+happyOut75 x = unsafeCoerce# x+{-# INLINE happyOut75 #-}+happyIn76 :: ([Expr]) -> (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57)+happyIn76 x = unsafeCoerce# x+{-# INLINE happyIn76 #-}+happyOut76 :: (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57) -> ([Expr])+happyOut76 x = unsafeCoerce# x+{-# INLINE happyOut76 #-}+happyIn77 :: (Declaration) -> (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57)+happyIn77 x = unsafeCoerce# x+{-# INLINE happyIn77 #-}+happyOut77 :: (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57) -> (Declaration)+happyOut77 x = unsafeCoerce# x+{-# INLINE happyOut77 #-}+happyIn78 :: (Declaration) -> (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57)+happyIn78 x = unsafeCoerce# x+{-# INLINE happyIn78 #-}+happyOut78 :: (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57) -> (Declaration)+happyOut78 x = unsafeCoerce# x+{-# INLINE happyOut78 #-}+happyIn79 :: (Declaration) -> (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57)+happyIn79 x = unsafeCoerce# x+{-# INLINE happyIn79 #-}+happyOut79 :: (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57) -> (Declaration)+happyOut79 x = unsafeCoerce# x+{-# INLINE happyOut79 #-}+happyIn80 :: ([Declaration]) -> (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57)+happyIn80 x = unsafeCoerce# x+{-# INLINE happyIn80 #-}+happyOut80 :: (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57) -> ([Declaration])+happyOut80 x = unsafeCoerce# x+{-# INLINE happyOut80 #-}+happyIn81 :: (Declaration) -> (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57)+happyIn81 x = unsafeCoerce# x+{-# INLINE happyIn81 #-}+happyOut81 :: (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57) -> (Declaration)+happyOut81 x = unsafeCoerce# x+{-# INLINE happyOut81 #-}+happyIn82 :: (Declaration) -> (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57)+happyIn82 x = unsafeCoerce# x+{-# INLINE happyIn82 #-}+happyOut82 :: (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57) -> (Declaration)+happyOut82 x = unsafeCoerce# x+{-# INLINE happyOut82 #-}+happyIn83 :: (Pragma) -> (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57)+happyIn83 x = unsafeCoerce# x+{-# INLINE happyIn83 #-}+happyOut83 :: (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57) -> (Pragma)+happyOut83 x = unsafeCoerce# x+{-# INLINE happyOut83 #-}+happyIn84 :: (Pragma) -> (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57)+happyIn84 x = unsafeCoerce# x+{-# INLINE happyIn84 #-}+happyOut84 :: (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57) -> (Pragma)+happyOut84 x = unsafeCoerce# x+{-# INLINE happyOut84 #-}+happyIn85 :: (Pragma) -> (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57)+happyIn85 x = unsafeCoerce# x+{-# INLINE happyIn85 #-}+happyOut85 :: (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57) -> (Pragma)+happyOut85 x = unsafeCoerce# x+{-# INLINE happyOut85 #-}+happyIn86 :: (Pragma) -> (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57)+happyIn86 x = unsafeCoerce# x+{-# INLINE happyIn86 #-}+happyOut86 :: (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57) -> (Pragma)+happyOut86 x = unsafeCoerce# x+{-# INLINE happyOut86 #-}+happyIn87 :: (Pragma) -> (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57)+happyIn87 x = unsafeCoerce# x+{-# INLINE happyIn87 #-}+happyOut87 :: (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57) -> (Pragma)+happyOut87 x = unsafeCoerce# x+{-# INLINE happyOut87 #-}+happyIn88 :: (Pragma) -> (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57)+happyIn88 x = unsafeCoerce# x+{-# INLINE happyIn88 #-}+happyOut88 :: (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57) -> (Pragma)+happyOut88 x = unsafeCoerce# x+{-# INLINE happyOut88 #-}+happyIn89 :: (Pragma) -> (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57)+happyIn89 x = unsafeCoerce# x+{-# INLINE happyIn89 #-}+happyOut89 :: (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57) -> (Pragma)+happyOut89 x = unsafeCoerce# x+{-# INLINE happyOut89 #-}+happyIn90 :: (Pragma) -> (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57)+happyIn90 x = unsafeCoerce# x+{-# INLINE happyIn90 #-}+happyOut90 :: (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57) -> (Pragma)+happyOut90 x = unsafeCoerce# x+{-# INLINE happyOut90 #-}+happyIn91 :: (Pragma) -> (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57)+happyIn91 x = unsafeCoerce# x+{-# INLINE happyIn91 #-}+happyOut91 :: (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57) -> (Pragma)+happyOut91 x = unsafeCoerce# x+{-# INLINE happyOut91 #-}+happyIn92 :: ([TypeSignature]) -> (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57)+happyIn92 x = unsafeCoerce# x+{-# INLINE happyIn92 #-}+happyOut92 :: (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57) -> ([TypeSignature])+happyOut92 x = unsafeCoerce# x+{-# INLINE happyOut92 #-}+happyIn93 :: ([TypeSignature]) -> (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57)+happyIn93 x = unsafeCoerce# x+{-# INLINE happyIn93 #-}+happyOut93 :: (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57) -> ([TypeSignature])+happyOut93 x = unsafeCoerce# x+{-# INLINE happyOut93 #-}+happyIn94 :: ([Constructor]) -> (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57)+happyIn94 x = unsafeCoerce# x+{-# INLINE happyIn94 #-}+happyOut94 :: (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57) -> ([Constructor])+happyOut94 x = unsafeCoerce# x+{-# INLINE happyOut94 #-}+happyIn95 :: ([Declaration]) -> (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57)+happyIn95 x = unsafeCoerce# x+{-# INLINE happyIn95 #-}+happyOut95 :: (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57) -> ([Declaration])+happyOut95 x = unsafeCoerce# x+{-# INLINE happyOut95 #-}+happyIn96 :: ([Declaration]) -> (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57)+happyIn96 x = unsafeCoerce# x+{-# INLINE happyIn96 #-}+happyOut96 :: (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57) -> ([Declaration])+happyOut96 x = unsafeCoerce# x+{-# INLINE happyOut96 #-}+happyIn97 :: ([Declaration]) -> (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57)+happyIn97 x = unsafeCoerce# x+{-# INLINE happyIn97 #-}+happyOut97 :: (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57) -> ([Declaration])+happyOut97 x = unsafeCoerce# x+{-# INLINE happyOut97 #-}+happyInTok :: Token -> (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57)+happyInTok x = unsafeCoerce# x+{-# INLINE happyInTok #-}+happyOutTok :: (HappyAbsSyn t11 t12 t13 t25 t28 t30 t34 t35 t57) -> Token+happyOutTok x = unsafeCoerce# x+{-# INLINE happyOutTok #-}+++happyActOffsets :: HappyAddr+happyActOffsets = HappyA# "\x00\x00\xa8\x02\x3e\x03\x00\x00\x66\x01\xa9\x00\x1c\x03\x35\x03\x00\x00\x35\x03\x28\x03\x00\x00\x18\x03\x00\x00\x00\x00\x00\x00\x00\x00\x67\x00\x2f\x02\xa8\x02\x21\x03\x00\x00\x76\x00\x31\x03\x1a\x03\x00\x00\x00\x00\xd0\x01\x00\x00\xe0\x02\x00\x00\x00\x00\xd0\x01\x13\x02\xf7\x01\x00\x00\x00\x00\x00\x00\x0e\x03\xc4\x00\x22\x03\x14\x03\x0d\x03\xfb\x02\x04\x03\x00\x00\xfc\x02\xf6\x02\x00\x00\x00\x00\x00\x00\xd0\x01\xa8\x02\x00\x00\xf9\x02\xd0\x01\x00\x00\x8c\x02\x70\x02\x00\x00\xdb\x01\xbf\x01\x54\x02\xf9\x02\xe8\x02\xec\x02\x1e\x03\x00\x00\xc4\x02\xc4\x02\x00\x00\x00\x00\x00\x00\x00\x00\x54\x02\xc4\x02\xe0\x02\x00\x00\x00\x00\xf8\x02\xf8\x02\x00\x00\xf8\x02\x00\x00\x00\x00\x7e\x00\x13\x01\x13\x01\x98\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe2\x02\xdc\x02\x00\x00\x00\x00\x28\x01\x97\x00\xe0\x02\x13\x01\x00\x00\xf3\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe5\x02\x00\x00\x00\x00\xc4\x02\x54\x02\xea\x02\xdf\x02\xd4\x02\x00\x00\xde\x02\x00\x00\x00\x00\x7a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x54\x02\x00\x00\x00\x00\x54\x02\x54\x02\xce\x02\x00\x00\xd8\x02\x00\x00\x00\x00\x00\x00\xc3\x02\x00\x00\x54\x02\xa3\x01\xe1\x00\x00\x00\x97\x00\xe0\x02\x12\x02\x00\x00\x00\x00\x00\x00\x00\x00\xf1\x02\x00\x00\xca\x02\xc7\x02\xc5\x02\xa7\x02\xb4\x02\x28\x01\xe7\x02\x28\x01\xc4\x02\xb1\x02\xb0\x02\xac\x02\x00\x00\x00\x00\xab\x02\x00\x00\xc2\x02\x00\x00\x12\x02\x00\x00\xd3\x02\x05\x00\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1e\x00\xbc\x02\x00\x00\xf3\xff\xdb\x02\xb2\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xae\x02\xae\x02\xa5\x00\x9e\x02\x9e\x02\x9e\x02\xe5\xff\xad\x02\x93\x02\x93\x02\x93\x02\xa6\x02\xa6\x02\xa6\x02\x98\x02\x23\x03\x00\x00\x00\x00\x54\x02\x00\x00\x00\x00\x92\x02\x91\x02\x90\x02\x90\x02\x90\x02\xc0\x02\xe0\x02\x00\x00\x00\x00\x00\x00\xf6\xff\x00\x00\xf6\xff\xf6\xff\x87\x02\x00\x00\x28\x01\x28\x01\x28\x01\x28\x01\x86\x02\x00\x00\x00\x00\x85\x00\x54\x02\x00\x00\x54\x02\x54\x02\xa3\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x8e\x02\x89\x02\x00\x00\x7b\x02\x82\x02\x74\x02\x7a\x02\x80\x02\x9b\x02\x00\x00\x00\x00\x6d\x02\x00\x00\x00\x00\x00\x00\x75\x02\x60\x02\x60\x02\x84\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6c\x02\x52\x02\x28\x01\x0f\x00\x62\x02\x5f\x02\x5b\x02\x58\x02\xf6\xff\x00\x00\x00\x00\x00\x00\x3b\x02\xe0\x02\x00\x00\x34\x02\x00\x00\x2a\x02\x27\x02\x1b\x02\x22\x02\x1a\x02\x00\x00\x16\x02\x15\x02\x0e\x02\x00\x00\x00\x00\x03\x02\xe1\x00\x54\x02\x54\x02\x54\x02\x18\x02\x54\x02\x0d\x02\x30\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x29\x01\x00\x00\x0b\x02\x54\x02\x12\x02\x00\x00\x24\x02\x1e\x02\x1d\x02\x1e\x00\xf5\x01\xee\x01\x00\x00\x00\x00\xda\x01\x00\x00\x00\x00\x00\x00\xcb\x01\x00\x00\xeb\x01\xeb\x01\xeb\x01\x00\x00\x12\x02\x00\x00\x00\x00\xd6\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe0\x01\x72\x00\x00\x00\x00\x00"#++happyGotoOffsets :: HappyAddr+happyGotoOffsets = HappyA# "\x4b\x00\x08\x05\x26\x00\xff\x01\xfd\x01\xaa\x00\x00\x00\xfa\x01\x00\x00\xf4\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5d\x02\xf9\x04\x00\x00\x00\x00\xff\x00\x0d\x00\x00\x00\x00\x00\x00\x00\xe3\x00\x00\x00\xd9\x00\x00\x00\x00\x00\x00\x03\x94\x03\x7b\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2b\x03\xea\x04\x00\x00\x00\x00\x2a\x03\x00\x00\xe9\x03\xda\x03\x00\x00\xdb\x04\xcc\x04\xbd\x04\x00\x00\x13\x00\x00\x00\x00\x00\x00\x00\xcb\x03\xbc\x03\x00\x00\x00\x00\x00\x00\x00\x00\xae\x04\x17\x05\x1b\x00\x00\x00\x00\x00\x37\x00\x2c\x00\x00\x00\x03\x00\x00\x00\x00\x00\x8a\x02\x6e\x02\x4d\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe1\x01\x00\x00\x00\x00\x00\x00\x20\x03\x11\x03\x3f\x00\x40\x02\x00\x00\x6a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xfa\x02\x9f\x04\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x62\x03\x00\x00\x00\x00\x90\x04\x81\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2d\x00\x00\x00\x72\x04\xd3\x00\x31\x00\x00\x00\x1e\x01\x2b\x00\x07\x05\x00\x00\x00\x00\x00\x00\x00\x00\xbc\x01\x00\x00\x00\x00\x00\x00\x00\x00\x7a\x01\xde\x01\x0c\x03\x00\x00\x0a\x03\xad\x03\x00\x00\x00\x00\xd3\x01\x00\x00\x00\x00\x00\x00\x00\x00\x06\x00\x00\x00\x98\x01\x00\x00\xce\x00\xc3\x00\x8b\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd9\x01\xd4\x01\x00\x00\x00\x00\x9d\x01\x92\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x18\x00\x17\x00\x21\x01\xbd\x01\xb5\x01\xb4\x01\x5b\x01\x16\x00\x57\x01\x55\x01\x54\x01\x0c\x00\x0b\x00\x0a\x00\x23\x01\x00\x00\x00\x00\x00\x00\x49\x03\x00\x00\x00\x00\x00\x00\x46\x01\x11\x01\x08\x01\xfd\x00\xea\x00\x3a\x01\x00\x00\x00\x00\x00\x00\x2b\x02\x00\x00\xd7\x01\xbe\x01\x00\x00\x00\x00\xcd\x02\x79\x02\x57\x02\x1c\x02\xee\x00\x00\x00\x00\x00\xb5\x00\x63\x04\x00\x00\x54\x04\x45\x04\x87\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xdb\x00\x00\x00\xd8\x00\x00\x00\x00\x00\x00\x00\xba\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xfe\xff\xac\x00\xa0\x00\x0e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x09\x00\x8c\x00\xc8\x01\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\xf6\x00\x00\x00\x00\x00\x00\x00\x55\x00\x8e\x00\x00\x00\x34\x00\x00\x00\x00\x00\x32\x00\x00\x00\x2a\x00\x00\x00\x00\x00\x00\x00\xfa\xff\x00\x00\x00\x00\x00\x00\x07\x00\x21\x00\x36\x04\x27\x04\x18\x04\x04\x00\x09\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3b\x00\x00\x00\x08\x00\xfa\x03\x83\x01\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x2e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf9\xff\x00\x00\x02\x00\x12\x00\x11\x00\x00\x00\x09\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x1d\x00\x00\x00\x00\x00"#++happyDefActions :: HappyAddr+happyDefActions = HappyA# "\xfa\xff\x00\x00\xbc\xff\x00\x00\xfc\xff\x00\x00\x00\x00\xbc\xff\xb9\xff\xbc\xff\xaf\xff\x96\xff\x00\x00\xa2\xff\xa1\xff\x9f\xff\x9e\xff\x00\x00\x99\xff\x00\x00\x00\x00\x81\xff\x7f\xff\xbc\xff\x00\x00\x92\xff\x91\xff\x00\x00\x90\xff\x00\x00\x93\xff\x94\xff\x00\x00\x00\x00\x00\x00\xb1\xff\xb0\xff\x95\xff\x00\x00\xaf\xff\x00\x00\x00\x00\x9f\xff\x00\x00\x7c\xff\x8c\xff\x00\x00\x00\x00\x8b\xff\xad\xff\x6b\xff\x71\xff\x00\x00\x9b\xff\x75\xff\x72\xff\xac\xff\x00\x00\x00\x00\x89\xff\x00\x00\x00\x00\x00\x00\x00\x00\x87\xff\x00\x00\x00\x00\x80\xff\x00\x00\x00\x00\x82\xff\xa5\xff\x9d\xff\x97\xff\x00\x00\x00\x00\x00\x00\xbb\xff\xba\xff\xbc\xff\xbc\xff\x21\xff\xbc\xff\x1c\xff\x1b\xff\x00\x00\x00\x00\x00\x00\x00\x00\xfb\xff\xf9\xff\xf8\xff\xf7\xff\xf6\xff\xf5\xff\xf4\xff\xf3\xff\xf2\xff\xf1\xff\xf0\xff\xef\xff\xee\xff\xed\xff\xec\xff\xeb\xff\xea\xff\xe9\xff\xe8\xff\xe7\xff\xe6\xff\xe5\xff\xe4\xff\xe3\xff\xe2\xff\xe1\xff\xe0\xff\xdf\xff\xde\xff\xdd\xff\xdc\xff\xdb\xff\xda\xff\xd9\xff\xd8\xff\xd7\xff\xd6\xff\xd5\xff\xd4\xff\xd3\xff\xd2\xff\xd1\xff\xd0\xff\xcf\xff\xce\xff\xcd\xff\xcc\xff\xcb\xff\xca\xff\xc9\xff\xc8\xff\xc7\xff\xc6\xff\xc5\xff\xc4\xff\xc3\xff\xc2\xff\xc1\xff\xc0\xff\xbf\xff\xbe\xff\xbd\xff\xa8\xff\x00\x00\xaf\xff\xae\xff\x6c\xff\x61\xff\x28\xff\x00\x00\xb8\xff\x00\x00\x20\xff\x1f\xff\x8a\xff\xa0\xff\x00\x00\xa3\xff\xa9\xff\x99\xff\x00\x00\xbc\xff\x00\x00\x00\x00\x86\xff\x85\xff\x76\xff\xa4\xff\x00\x00\x6f\xff\x70\xff\x74\xff\x9c\xff\x73\xff\x7e\xff\x8d\xff\x00\x00\x7d\xff\x8f\xff\x00\x00\x00\x00\x00\x00\x77\xff\x78\xff\x7a\xff\x7b\xff\x6a\xff\x00\x00\x88\xff\x00\x00\x00\x00\xbc\xff\x9a\xff\x61\xff\x28\xff\x61\xff\x24\xff\x69\xff\x67\xff\x65\xff\x62\xff\x63\xff\x00\x00\x00\x00\x00\x00\x61\xff\x00\x00\x6c\xff\x00\x00\x6c\xff\x00\x00\x00\x00\x00\x00\xa8\xff\xa7\xff\x14\xff\x00\x00\x6e\xff\xbc\xff\x6d\xff\x61\xff\x66\xff\xb3\xff\x00\x00\x56\xff\x64\xff\x29\xff\x27\xff\x23\xff\x00\x00\xbc\xff\xb5\xff\xaf\xff\x4e\xff\x36\xff\x04\xff\x49\xff\x47\xff\x46\xff\x45\xff\x44\xff\x48\xff\x43\xff\x42\xff\x41\xff\x40\xff\x3f\xff\x3e\xff\x3c\xff\x3d\xff\x3b\xff\x3a\xff\x1d\xff\x1a\xff\x18\xff\x16\xff\x17\xff\x15\xff\x19\xff\xbc\xff\xbc\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbc\xff\x00\x00\x00\x00\x00\x00\xbc\xff\xbc\xff\xbc\xff\x50\xff\x00\x00\x83\xff\x84\xff\x00\x00\x8e\xff\x79\xff\x00\x00\xa8\xff\x00\x00\x00\x00\x00\x00\x4e\xff\x00\x00\x2c\xff\x2d\xff\x2e\xff\x00\x00\xb2\xff\x00\x00\x00\x00\x00\x00\x2f\xff\x6c\xff\x6c\xff\x6c\xff\x6c\xff\x00\x00\x2a\xff\x2b\xff\x4c\xff\x00\x00\x52\xff\x00\x00\x00\x00\x00\x00\x08\xff\xb6\xff\xb7\xff\xb4\xff\x58\xff\x54\xff\x00\x00\x55\xff\x00\x00\x00\x00\x00\x00\x00\x00\x5c\xff\x00\x00\xb3\xff\x68\xff\x00\x00\x06\xff\x1e\xff\x0e\xff\xbc\xff\x00\x00\x00\x00\xb3\xff\x5e\xff\x5a\xff\x5f\xff\x57\xff\x60\xff\x00\x00\x05\xff\x39\xff\x4d\xff\x37\xff\x38\xff\xbc\xff\x00\x00\x6c\xff\x00\x00\x00\x00\x00\x00\x00\x00\xbc\xff\xaa\xff\x32\xff\x31\xff\x30\xff\x50\xff\x98\xff\x51\xff\xa8\xff\xa6\xff\x00\x00\xa8\xff\x00\x00\x00\x00\x00\x00\x0f\xff\x00\x00\xa8\xff\x00\x00\x4f\xff\xab\xff\x00\x00\xbc\xff\x00\x00\x00\x00\x00\x00\xbc\xff\x00\x00\x00\x00\x00\x00\x4b\xff\x53\xff\x5d\xff\x5b\xff\x59\xff\x00\x00\x07\xff\xbc\xff\x00\x00\x61\xff\x22\xff\x00\x00\x00\x00\x00\x00\x00\x00\xbc\xff\x00\x00\x0b\xff\x11\xff\x00\x00\x12\xff\x13\xff\x10\xff\x00\x00\x0d\xff\xbc\xff\xbc\xff\xbc\xff\x26\xff\x61\xff\x4a\xff\x25\xff\x00\x00\x0a\xff\x35\xff\x34\xff\x33\xff\x0c\xff\xbc\xff\x00\x00\x09\xff"#++happyCheck :: HappyAddr+happyCheck = HappyA# "\xff\xff\x03\x00\x03\x00\x0a\x00\x03\x00\x03\x00\x03\x00\x03\x00\x05\x00\x03\x00\x10\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x0a\x00\x03\x00\x0e\x00\x03\x00\x03\x00\x08\x00\x03\x00\x33\x00\x03\x00\x03\x00\x03\x00\x29\x00\x0a\x00\x00\x00\x3a\x00\x06\x00\x2b\x00\x2f\x00\x06\x00\x03\x00\x0a\x00\x0b\x00\x0a\x00\x07\x00\x03\x00\x04\x00\x05\x00\x19\x00\x1a\x00\x1b\x00\x03\x00\x3a\x00\x03\x00\x39\x00\x18\x00\x03\x00\x0a\x00\x0b\x00\x0a\x00\x07\x00\x2a\x00\x03\x00\x11\x00\x2e\x00\x2f\x00\x30\x00\x3a\x00\x39\x00\x06\x00\x10\x00\x18\x00\x10\x00\x0a\x00\x0b\x00\x1a\x00\x1b\x00\x0a\x00\x0b\x00\x00\x00\x01\x00\x4a\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x36\x00\x37\x00\x39\x00\x18\x00\x57\x00\x5b\x00\x5b\x00\x59\x00\x5a\x00\x59\x00\x5a\x00\x59\x00\x5a\x00\x59\x00\x59\x00\x59\x00\x59\x00\x59\x00\x59\x00\x56\x00\x56\x00\x58\x00\x58\x00\x57\x00\x56\x00\x56\x00\x56\x00\x34\x00\x4a\x00\x46\x00\x00\x00\x38\x00\x39\x00\x3a\x00\x4a\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x4a\x00\x47\x00\x48\x00\x49\x00\x46\x00\x08\x00\x4c\x00\x03\x00\x4e\x00\x35\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x0a\x00\x0b\x00\x0e\x00\x2d\x00\x0a\x00\x0a\x00\x30\x00\x0a\x00\x0b\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x09\x00\x0a\x00\x0b\x00\x29\x00\x0d\x00\x17\x00\x18\x00\x31\x00\x36\x00\x33\x00\x0a\x00\x0a\x00\x3a\x00\x08\x00\x34\x00\x45\x00\x07\x00\x08\x00\x48\x00\x0e\x00\x1c\x00\x4b\x00\x0a\x00\x0e\x00\x3a\x00\x3b\x00\x22\x00\x34\x00\x31\x00\x32\x00\x33\x00\x38\x00\x39\x00\x3a\x00\x08\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x0a\x00\x47\x00\x48\x00\x49\x00\x3a\x00\x31\x00\x4c\x00\x33\x00\x4e\x00\x08\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x0a\x00\x0b\x00\x3a\x00\x3b\x00\x38\x00\x0a\x00\x0a\x00\x0b\x00\x0a\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x37\x00\x0a\x00\x2a\x00\x45\x00\x0d\x00\x18\x00\x48\x00\x2f\x00\x31\x00\x4b\x00\x33\x00\x4d\x00\x0a\x00\x4f\x00\x07\x00\x08\x00\x2e\x00\x2f\x00\x30\x00\x55\x00\x0a\x00\x0e\x00\x1f\x00\x0d\x00\x0e\x00\x24\x00\x23\x00\x34\x00\x25\x00\x28\x00\x27\x00\x38\x00\x39\x00\x3a\x00\x11\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x11\x00\x47\x00\x48\x00\x49\x00\x1e\x00\x1f\x00\x4c\x00\x36\x00\x4e\x00\x11\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x00\x00\x01\x00\x0a\x00\x0b\x00\x0c\x00\x05\x00\x06\x00\x07\x00\x08\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x0a\x00\x0b\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x23\x00\x3a\x00\x3b\x00\x26\x00\x27\x00\x17\x00\x18\x00\x2b\x00\x2b\x00\x2c\x00\x10\x00\x2e\x00\x35\x00\x31\x00\x31\x00\x33\x00\x33\x00\x09\x00\x09\x00\x36\x00\x09\x00\x38\x00\x3a\x00\x3a\x00\x3b\x00\x0a\x00\x3d\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\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\x01\x00\x2b\x00\x2c\x00\x2d\x00\x05\x00\x06\x00\x07\x00\x08\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x0a\x00\x0a\x00\x01\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x23\x00\x0a\x00\x0a\x00\x26\x00\x27\x00\x0d\x00\x0e\x00\x3b\x00\x2b\x00\x2c\x00\x11\x00\x2e\x00\x0a\x00\x36\x00\x31\x00\x0d\x00\x33\x00\x03\x00\x19\x00\x1a\x00\x1b\x00\x38\x00\x01\x00\x3a\x00\x3b\x00\x06\x00\x3d\x00\x0a\x00\x23\x00\x10\x00\x0d\x00\x0e\x00\x27\x00\x1f\x00\x0a\x00\x2d\x00\x2b\x00\x2c\x00\x11\x00\x2e\x00\x26\x00\x27\x00\x31\x00\x10\x00\x33\x00\x34\x00\x19\x00\x1a\x00\x1b\x00\x03\x00\x01\x00\x3a\x00\x3b\x00\x2b\x00\x3d\x00\x03\x00\x23\x00\x02\x00\x01\x00\x31\x00\x27\x00\x33\x00\x24\x00\x3a\x00\x2b\x00\x2c\x00\x11\x00\x2e\x00\x3a\x00\x35\x00\x31\x00\x32\x00\x33\x00\x24\x00\x19\x00\x1a\x00\x1b\x00\x39\x00\x01\x00\x3a\x00\x3b\x00\x29\x00\x3d\x00\x24\x00\x23\x00\x09\x00\x0a\x00\x0b\x00\x27\x00\x0d\x00\x03\x00\x03\x00\x2b\x00\x2c\x00\x11\x00\x2e\x00\x0a\x00\x03\x00\x31\x00\x0d\x00\x33\x00\x34\x00\x19\x00\x1a\x00\x1b\x00\x24\x00\x01\x00\x3a\x00\x3b\x00\x03\x00\x3d\x00\x0a\x00\x23\x00\x2a\x00\x0d\x00\x0e\x00\x27\x00\x1f\x00\x24\x00\x3a\x00\x2b\x00\x2c\x00\x11\x00\x2e\x00\x26\x00\x27\x00\x31\x00\x32\x00\x33\x00\x39\x00\x19\x00\x1a\x00\x0a\x00\x0b\x00\x0c\x00\x3a\x00\x3b\x00\x39\x00\x3d\x00\x3c\x00\x23\x00\x39\x00\x39\x00\x01\x00\x27\x00\x0a\x00\x0b\x00\x0c\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x3c\x00\x30\x00\x31\x00\x0a\x00\x33\x00\x3c\x00\x0d\x00\x11\x00\x3c\x00\x0a\x00\x0b\x00\x3a\x00\x3b\x00\x30\x00\x3d\x00\x19\x00\x1a\x00\x1b\x00\x3c\x00\x01\x00\x15\x00\x16\x00\x17\x00\x18\x00\x1f\x00\x23\x00\x0a\x00\x0b\x00\x0c\x00\x27\x00\x24\x00\x26\x00\x27\x00\x2b\x00\x2c\x00\x11\x00\x2e\x00\x0a\x00\x29\x00\x31\x00\x0d\x00\x33\x00\x29\x00\x19\x00\x1a\x00\x29\x00\x3a\x00\x01\x00\x3a\x00\x3b\x00\x24\x00\x3d\x00\x0e\x00\x23\x00\x0a\x00\x0b\x00\x0c\x00\x27\x00\x1f\x00\x24\x00\x3a\x00\x2b\x00\x2c\x00\x11\x00\x2e\x00\x26\x00\x27\x00\x31\x00\x35\x00\x33\x00\x34\x00\x19\x00\x1a\x00\x0c\x00\x28\x00\x01\x00\x3a\x00\x3b\x00\x32\x00\x3d\x00\x3a\x00\x23\x00\x09\x00\x0a\x00\x0b\x00\x27\x00\x32\x00\x3a\x00\x28\x00\x2b\x00\x2c\x00\x11\x00\x2e\x00\x32\x00\x35\x00\x31\x00\x32\x00\x33\x00\x3a\x00\x19\x00\x1a\x00\x1b\x00\x04\x00\x01\x00\x3a\x00\x3b\x00\x30\x00\x3d\x00\x24\x00\x23\x00\x3c\x00\x3c\x00\x3c\x00\x27\x00\x3d\x00\x24\x00\x24\x00\x2b\x00\x2c\x00\x11\x00\x2e\x00\x0a\x00\x3a\x00\x31\x00\x0d\x00\x33\x00\x2a\x00\x19\x00\x1a\x00\x04\x00\x24\x00\x0e\x00\x3a\x00\x3b\x00\x39\x00\x3d\x00\x24\x00\x23\x00\x3c\x00\x39\x00\x03\x00\x27\x00\x1f\x00\x3c\x00\x3a\x00\x2b\x00\x2c\x00\x11\x00\x2e\x00\x26\x00\x27\x00\x31\x00\x31\x00\x33\x00\x31\x00\x19\x00\x1a\x00\x31\x00\x0b\x00\x3a\x00\x3a\x00\x3b\x00\x28\x00\x3d\x00\x34\x00\x23\x00\x0a\x00\x0b\x00\x28\x00\x27\x00\x34\x00\x2a\x00\x0a\x00\x2b\x00\x2c\x00\x0d\x00\x24\x00\x15\x00\x16\x00\x31\x00\x18\x00\x33\x00\x0a\x00\x30\x00\x0a\x00\x0d\x00\x3c\x00\x0d\x00\x3a\x00\x3b\x00\x24\x00\x3d\x00\x3c\x00\x1f\x00\x02\x00\x35\x00\x3a\x00\x23\x00\x24\x00\x25\x00\x2d\x00\x27\x00\x32\x00\x1f\x00\x0a\x00\x1f\x00\x28\x00\x0d\x00\x32\x00\x34\x00\x26\x00\x27\x00\x26\x00\x27\x00\x0a\x00\x0a\x00\x29\x00\x0d\x00\x0d\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x1f\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x26\x00\x27\x00\x34\x00\x1f\x00\x1f\x00\x29\x00\x3e\x00\x33\x00\x2d\x00\x25\x00\x25\x00\x27\x00\x27\x00\x0a\x00\x0b\x00\x24\x00\x3e\x00\x2f\x00\x0f\x00\x24\x00\x3e\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x24\x00\xff\xff\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x0a\x00\x0b\x00\xff\xff\xff\xff\xff\xff\x0f\x00\xff\xff\xff\xff\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\xff\xff\xff\xff\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x0a\x00\x0b\x00\xff\xff\xff\xff\xff\xff\x0f\x00\xff\xff\xff\xff\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\xff\xff\xff\xff\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\xff\xff\x22\x00\x0a\x00\x0b\x00\xff\xff\xff\xff\xff\xff\x0f\x00\xff\xff\xff\xff\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\xff\xff\xff\xff\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\xff\xff\x22\x00\x0a\x00\x0b\x00\xff\xff\xff\xff\xff\xff\x0f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x15\x00\x16\x00\xff\xff\x18\x00\x0a\x00\x0b\x00\xff\xff\xff\xff\xff\xff\x0f\x00\xff\xff\x20\x00\xff\xff\x22\x00\xff\xff\x15\x00\x16\x00\xff\xff\x18\x00\x0a\x00\x0b\x00\xff\xff\xff\xff\xff\xff\x0f\x00\xff\xff\x20\x00\xff\xff\x22\x00\xff\xff\x15\x00\x16\x00\xff\xff\x18\x00\x0a\x00\x0b\x00\xff\xff\xff\xff\xff\xff\x0f\x00\xff\xff\x20\x00\xff\xff\x22\x00\xff\xff\x15\x00\x16\x00\xff\xff\x18\x00\x0a\x00\x0b\x00\xff\xff\xff\xff\xff\xff\x0f\x00\xff\xff\x20\x00\xff\xff\x22\x00\xff\xff\x15\x00\x16\x00\xff\xff\x18\x00\xff\xff\xff\xff\x0a\x00\x0b\x00\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\x22\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x0a\x00\x0b\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\xff\xff\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x0a\x00\x0b\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\xff\xff\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x0a\x00\x0b\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\xff\xff\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x0a\x00\x0b\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\xff\xff\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x0a\x00\x0b\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\xff\xff\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x0a\x00\x0b\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\xff\xff\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x0a\x00\x0b\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\xff\xff\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x0a\x00\x0b\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\xff\xff\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x0a\x00\x0b\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\xff\xff\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x0a\x00\x0b\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\xff\xff\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x0a\x00\x0b\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\xff\xff\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x0a\x00\x0b\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\xff\xff\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x0a\x00\x0b\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\xff\xff\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x0a\x00\x0b\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\xff\xff\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x0a\x00\x0b\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\xff\xff\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x0a\x00\x0b\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\xff\xff\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x0a\x00\x0b\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\xff\xff\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x0a\x00\x0b\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\xff\xff\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x0a\x00\x0b\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\xff\xff\xff\xff\xff\xff\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\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\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"#++happyTable :: HappyAddr+happyTable = HappyA# "\x00\x00\x8b\x01\xc7\x00\x96\x01\xad\x01\x4e\x01\x05\x00\x4e\x01\x9f\x00\x4e\x01\x99\x01\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x96\x01\x83\x01\x47\x01\xa6\x01\xa6\x01\x48\x01\x7d\x01\x41\x00\x2f\x01\x2f\x01\x2f\x01\x3d\x01\xab\x00\x40\x01\x24\x00\x9e\x01\x39\x00\x4d\x00\xae\x01\x94\x01\x0a\x00\x0b\x00\x96\x01\x95\x01\x05\x00\x06\x00\x07\x00\xac\x00\xad\x00\xae\x00\xa0\x00\x24\x00\x9d\x01\xab\x01\xa3\x00\xee\x00\x0a\x00\x0b\x00\xab\x00\xef\x00\x84\x01\xa0\x00\x76\x01\x88\x01\x4a\x01\x4b\x01\x24\x00\x97\x01\x8c\x01\x78\x01\xcb\x00\x7a\x01\xf1\x00\x0b\x00\x1d\x01\xae\x00\x0a\x00\x0b\x00\x26\x00\x04\x00\x08\x00\xf2\x00\x0e\x00\x0f\x00\x10\x00\xa5\x00\x12\x00\x41\x01\x42\x01\x97\x01\xcb\x00\x7e\x01\xc8\x00\xc8\x00\x4f\x01\xaa\x01\x4f\x01\x90\x01\x4f\x01\x50\x01\xa4\x01\x86\x01\x28\x01\x29\x01\x2a\x01\x42\x00\xa7\x01\xa7\x01\xa8\x01\xa9\x01\x7e\x01\x30\x01\x36\x01\x37\x01\xf3\x00\x08\x00\xec\x00\x40\x01\xf4\x00\xf5\x00\xf6\x00\xa1\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x00\x01\xa2\x00\x01\x01\x02\x01\x03\x01\xcc\x00\x9f\x00\x04\x01\x62\x01\x05\x01\x7b\x01\x06\x01\x07\x01\x08\x01\x09\x01\x0a\x01\x0b\x01\xf1\x00\x0b\x00\x63\x01\x4b\x00\x42\x01\x85\x01\x4c\x00\x0a\x00\x0b\x00\xf2\x00\x0e\x00\x0f\x00\x10\x00\xa5\x00\x12\x00\xd4\x00\xd5\x00\xd6\x00\xbd\x00\xd7\x00\x49\x00\x6e\x01\x45\x00\x41\x01\x46\x00\x89\x01\x42\x01\x24\x00\x9f\x00\xc4\x00\x4f\x00\x56\x00\x57\x00\x50\x00\x36\x01\x98\x00\x51\x00\x8a\x01\x58\x00\x24\x00\x25\x00\x99\x00\xf3\x00\x43\x01\x44\x01\x45\x01\x5c\x01\xf5\x00\xf6\x00\x53\x01\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x00\x01\x42\x01\x01\x01\x02\x01\x03\x01\xd8\x00\x43\x01\x04\x01\x87\x01\x05\x01\x48\x01\x06\x01\x07\x01\x08\x01\x09\x01\x0a\x01\x0b\x01\xf1\x00\x0b\x00\x24\x00\x25\x00\x59\x00\x57\x01\x0a\x00\x0b\x00\x59\x01\xf2\x00\x0e\x00\x0f\x00\x10\x00\xa5\x00\x12\x00\x60\x01\x31\x00\xbe\x00\x4f\x00\x32\x00\x3b\x00\x50\x00\x4d\x00\x43\x01\x51\x00\x47\x01\x52\x00\x63\x01\x53\x00\x56\x00\x57\x00\x49\x01\x4a\x01\x4b\x01\x54\x00\x31\x00\x58\x00\x33\x00\x69\x01\x7c\x01\x0a\x00\x3e\x00\xf3\x00\x3f\x00\xf1\x00\x37\x00\xf4\x00\xf5\x00\xf6\x00\x70\x01\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x00\x01\x72\x01\x01\x01\x02\x01\x03\x01\x43\x00\x16\x00\x04\x01\x6f\x01\x05\x01\x73\x01\x06\x01\x07\x01\x08\x01\x09\x01\x0a\x01\x0b\x01\x40\x01\x18\x00\x99\x00\x9a\x00\x9d\x00\x0d\x01\x0e\x01\x0f\x01\x57\x00\xa5\x01\xcf\x00\xd0\x00\xd1\x00\xd2\x00\x10\x01\x11\x01\x12\x01\x13\x01\x14\x01\x15\x01\x16\x01\x17\x01\x18\x01\x19\x01\x1a\x01\x1a\x00\x1b\x00\x0a\x00\x0b\x00\xed\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\x1d\x00\x24\x00\x25\x00\x1b\x01\x1e\x00\x6d\x01\x6e\x01\x39\x00\x1f\x00\x20\x00\x74\x01\x21\x00\x26\x01\x45\x00\x3d\x00\xdc\x00\x3e\x00\x2b\x01\x2d\x01\x41\x01\x2e\x01\x1c\x01\x24\x00\x24\x00\x25\x00\x31\x01\x26\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x18\x00\xe6\x00\xd1\x00\xd2\x00\x0d\x01\x0e\x01\x0f\x01\x57\x00\xa2\x01\xcf\x00\xd0\x00\xd1\x00\xd2\x00\x10\x01\x11\x01\x12\x01\x13\x01\x14\x01\x15\x01\x16\x01\x17\x01\x18\x01\x19\x01\x1a\x01\x1a\x00\x1b\x00\x32\x01\x33\x01\x18\x00\x4d\x01\xcf\x00\xd0\x00\xd1\x00\xd2\x00\x1d\x00\x34\x01\x31\x00\x1b\x01\x1e\x00\x69\x01\x6a\x01\x38\x01\x1f\x00\x20\x00\x19\x00\x21\x00\x31\x00\x3a\x01\x3d\x00\x32\x00\x3e\x00\x3d\x01\x1a\x00\x1b\x00\x1c\x00\x1c\x01\x18\x00\x24\x00\x25\x00\x3e\x01\x26\x00\x31\x00\x1d\x00\xdf\x00\x69\x01\x6b\x01\x1e\x00\xd8\x00\xe5\x00\xea\x00\x1f\x00\x20\x00\x19\x00\x21\x00\x84\x01\xda\x00\x22\x00\xdd\x00\x23\x00\x2e\x00\x1a\x00\x1b\x00\x1c\x00\x4d\x00\x18\x00\x24\x00\x25\x00\x39\x00\x26\x00\x4e\x00\x1d\x00\x59\x00\x04\x00\x3a\x00\x1e\x00\x3b\x00\x0a\x00\x24\x00\x1f\x00\x20\x00\x19\x00\x21\x00\x24\x00\xad\x01\x22\x00\x31\x00\x23\x00\x0a\x00\x1a\x00\x1b\x00\x1c\x00\x9d\x01\x18\x00\x24\x00\x25\x00\x3d\x01\x26\x00\x0a\x00\x1d\x00\xd4\x00\xd5\x00\xd6\x00\x1e\x00\xd7\x00\xa0\x01\xa1\x01\x1f\x00\x20\x00\x19\x00\x21\x00\x31\x00\xa2\x01\x22\x00\x32\x00\x23\x00\x2e\x00\x1a\x00\x1b\x00\x1c\x00\x0a\x00\x18\x00\x24\x00\x25\x00\x8e\x01\x26\x00\x31\x00\x1d\x00\x8f\x01\x69\x01\x6c\x01\x1e\x00\xd8\x00\x0a\x00\x24\x00\x1f\x00\x20\x00\x19\x00\x21\x00\x64\x01\xda\x00\x22\x00\x31\x00\x23\x00\x99\x01\x1a\x00\x1b\x00\x99\x00\x9a\x00\xca\x00\x24\x00\x25\x00\x9b\x01\x26\x00\xdf\x00\x1d\x00\x9c\x01\x78\x01\x18\x00\x1e\x00\x99\x00\x9a\x00\x9b\x00\x1f\x00\x20\x00\x98\xff\x21\x00\x72\x01\x98\xff\x3d\x00\x31\x00\x3e\x00\xdf\x00\x32\x00\x19\x00\x7a\x01\x0a\x00\x0b\x00\x24\x00\x25\x00\x28\x01\x26\x00\x1a\x00\x1b\x00\x1c\x00\xdf\x00\x18\x00\x48\x00\x10\x00\x49\x00\x12\x00\xd8\x00\x1d\x00\x99\x00\x9a\x00\x9c\x00\x1e\x00\x0a\x00\x65\x01\xda\x00\x1f\x00\x20\x00\x19\x00\x21\x00\x31\x00\x80\x01\x22\x00\x32\x00\x23\x00\x81\x01\x1a\x00\x1b\x00\x82\x01\x24\x00\x18\x00\x24\x00\x25\x00\x0a\x00\x26\x00\x4d\x01\x1d\x00\x99\x00\x9a\x00\x9d\x00\x1e\x00\xd8\x00\x0a\x00\x24\x00\x1f\x00\x20\x00\x19\x00\x21\x00\x66\x01\xda\x00\x3d\x00\x53\x01\x3e\x00\xb3\x00\x1a\x00\x1b\x00\x55\x01\x56\x01\x18\x00\x24\x00\x25\x00\x57\x01\x26\x00\x24\x00\x1d\x00\xd4\x00\xd5\x00\xd6\x00\x1e\x00\x59\x01\x24\x00\x5c\x01\x1f\x00\x20\x00\x19\x00\x21\x00\x5b\x01\x69\x01\x3d\x00\xb4\x00\x3e\x00\x24\x00\x1a\x00\x1b\x00\x1c\x00\x3c\x01\x18\x00\x24\x00\x25\x00\x28\x01\x26\x00\x0a\x00\x1d\x00\x72\x01\xdf\x00\x76\x01\x1e\x00\x2d\x01\x0a\x00\x0a\x00\x1f\x00\x20\x00\x19\x00\x21\x00\x31\x00\x24\x00\x22\x00\x32\x00\x23\x00\x3a\x01\x1a\x00\x1b\x00\x3c\x01\x0a\x00\x4d\x01\x24\x00\x25\x00\x52\x01\x26\x00\x0a\x00\x1d\x00\xdf\x00\xe1\x00\xe4\x00\x1e\x00\xd8\x00\xe2\x00\x24\x00\x1f\x00\x20\x00\x19\x00\x21\x00\x67\x01\xda\x00\x3d\x00\xe8\x00\x3e\x00\xe9\x00\x1a\x00\x1b\x00\xea\x00\xd6\x00\x24\x00\x24\x00\x25\x00\x1f\x01\x26\x00\x20\x01\x1d\x00\x0a\x00\x0b\x00\xc5\x00\x1e\x00\xc6\x00\xc7\x00\x31\x00\x1f\x00\x20\x00\x32\x00\x0a\x00\x48\x00\x10\x00\x3d\x00\xa8\x00\x3e\x00\x31\x00\x4c\x00\x31\x00\x32\x00\xdd\x00\x32\x00\x24\x00\x25\x00\x0a\x00\x26\x00\xdf\x00\x33\x00\xaa\x00\xab\x00\x24\x00\x34\x00\x35\x00\x36\x00\xb0\x00\x37\x00\xb8\x00\xd8\x00\x31\x00\xd8\x00\xba\x00\x32\x00\xb9\x00\xbb\x00\xe2\x00\xda\x00\xe4\x00\xda\x00\x31\x00\x31\x00\xa9\xff\x32\x00\x32\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd8\x00\x22\x01\x23\x01\x24\x01\x25\x01\x26\x01\x99\x00\xd9\x00\xda\x00\xbc\x00\x33\x00\x33\x00\xbd\x00\xff\xff\x41\x00\x47\x00\xb4\x00\xb6\x00\x37\x00\x37\x00\x0a\x00\x0b\x00\x0a\x00\xff\xff\x4d\x00\x28\x00\x0a\x00\xff\xff\xc0\x00\x0d\x00\x0e\x00\x2a\x00\x10\x00\x11\x00\x12\x00\x0a\x00\x00\x00\x00\x00\x13\x00\x14\x00\x15\x00\x16\x00\xc1\x00\x20\x01\x2c\x00\x0a\x00\x0b\x00\x00\x00\x00\x00\x00\x00\x28\x00\x00\x00\x00\x00\xc0\x00\x0d\x00\x0e\x00\x2a\x00\x10\x00\x11\x00\x12\x00\x00\x00\x00\x00\x00\x00\x13\x00\x14\x00\x15\x00\x16\x00\xc1\x00\xc2\x00\x2c\x00\x27\x00\x0b\x00\x00\x00\x00\x00\x00\x00\x28\x00\x00\x00\x00\x00\x29\x00\x0d\x00\x0e\x00\x2a\x00\x10\x00\x11\x00\x12\x00\x00\x00\x00\x00\x00\x00\x13\x00\x14\x00\x15\x00\x16\x00\x2b\x00\x00\x00\x2c\x00\x0a\x00\x0b\x00\x00\x00\x00\x00\x00\x00\x28\x00\x00\x00\x00\x00\x2e\x00\x0d\x00\x0e\x00\x2a\x00\x10\x00\x11\x00\x12\x00\x00\x00\x00\x00\x00\x00\x13\x00\x14\x00\x15\x00\x16\x00\x2f\x00\x00\x00\x2c\x00\x0a\x00\x0b\x00\x00\x00\x00\x00\x00\x00\xb1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa7\x00\x10\x00\x00\x00\xa8\x00\x0a\x00\x0b\x00\x00\x00\x00\x00\x00\x00\x28\x00\x00\x00\x2b\x00\x00\x00\x2c\x00\x00\x00\xa7\x00\x10\x00\x00\x00\xa8\x00\x0a\x00\x0b\x00\x00\x00\x00\x00\x00\x00\x28\x00\x00\x00\x2b\x00\x00\x00\x2c\x00\x00\x00\xa7\x00\x10\x00\x00\x00\xa8\x00\x0a\x00\x0b\x00\x00\x00\x00\x00\x00\x00\xb1\x00\x00\x00\x2f\x00\x00\x00\x2c\x00\x00\x00\xa7\x00\x10\x00\x00\x00\xa8\x00\x0a\x00\x0b\x00\x00\x00\x00\x00\x00\x00\x28\x00\x00\x00\x2b\x00\x00\x00\x2c\x00\x00\x00\xa7\x00\x10\x00\x00\x00\xa8\x00\x00\x00\x00\x00\x0a\x00\x0b\x00\x00\x00\x00\x00\x00\x00\x2f\x00\x00\x00\x2c\x00\xa3\x01\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x0a\x00\x0b\x00\x00\x00\x13\x00\x14\x00\x15\x00\x16\x00\x00\x00\x8f\x01\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x0a\x00\x0b\x00\x00\x00\x13\x00\x14\x00\x15\x00\x16\x00\x00\x00\x91\x01\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x0a\x00\x0b\x00\x00\x00\x13\x00\x14\x00\x15\x00\x16\x00\x00\x00\x92\x01\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x0a\x00\x0b\x00\x00\x00\x13\x00\x14\x00\x15\x00\x16\x00\x00\x00\x93\x01\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x0a\x00\x0b\x00\x00\x00\x13\x00\x14\x00\x15\x00\x16\x00\x00\x00\x5d\x01\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x0a\x00\x0b\x00\x00\x00\x13\x00\x14\x00\x15\x00\x16\x00\x00\x00\x5e\x01\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x0a\x00\x0b\x00\x00\x00\x13\x00\x14\x00\x15\x00\x16\x00\x00\x00\x5f\x01\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x0a\x00\x0b\x00\x00\x00\x13\x00\x14\x00\x15\x00\x16\x00\x00\x00\x1c\x01\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x0a\x00\x0b\x00\x00\x00\x13\x00\x14\x00\x15\x00\x16\x00\x00\x00\xbe\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x0a\x00\x0b\x00\x00\x00\x13\x00\x14\x00\x15\x00\x16\x00\x00\x00\xbf\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x0a\x00\x0b\x00\x00\x00\x13\x00\x14\x00\x15\x00\x16\x00\x00\x00\xc9\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x0a\x00\x0b\x00\x00\x00\x13\x00\x14\x00\x15\x00\x16\x00\x00\x00\xa6\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x0a\x00\x0b\x00\x00\x00\x13\x00\x14\x00\x15\x00\x16\x00\x00\x00\xb0\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x27\x00\x0b\x00\x00\x00\x13\x00\x14\x00\x15\x00\x16\x00\x00\x00\x29\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x0a\x00\x0b\x00\x00\x00\x13\x00\x14\x00\x15\x00\x16\x00\x00\x00\x2e\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x0a\x00\x0b\x00\x00\x00\x13\x00\x14\x00\x15\x00\x16\x00\x00\x00\xb5\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x0a\x00\x0b\x00\x00\x00\x13\x00\x14\x00\x15\x00\x16\x00\x00\x00\x47\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x0a\x00\x0b\x00\x00\x00\x13\x00\x14\x00\x15\x00\x16\x00\x00\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x0a\x00\x0b\x00\x00\x00\x13\x00\x14\x00\x15\x00\x16\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x0f\x00\x10\x00\xa5\x00\x12\x00\xeb\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"#++happyReduceArr = array (3, 251) [+	(3 , happyReduce_3),+	(4 , happyReduce_4),+	(5 , happyReduce_5),+	(6 , happyReduce_6),+	(7 , happyReduce_7),+	(8 , happyReduce_8),+	(9 , happyReduce_9),+	(10 , happyReduce_10),+	(11 , happyReduce_11),+	(12 , happyReduce_12),+	(13 , happyReduce_13),+	(14 , happyReduce_14),+	(15 , happyReduce_15),+	(16 , happyReduce_16),+	(17 , happyReduce_17),+	(18 , happyReduce_18),+	(19 , happyReduce_19),+	(20 , happyReduce_20),+	(21 , happyReduce_21),+	(22 , happyReduce_22),+	(23 , happyReduce_23),+	(24 , happyReduce_24),+	(25 , happyReduce_25),+	(26 , happyReduce_26),+	(27 , happyReduce_27),+	(28 , happyReduce_28),+	(29 , happyReduce_29),+	(30 , happyReduce_30),+	(31 , happyReduce_31),+	(32 , happyReduce_32),+	(33 , happyReduce_33),+	(34 , happyReduce_34),+	(35 , happyReduce_35),+	(36 , happyReduce_36),+	(37 , happyReduce_37),+	(38 , happyReduce_38),+	(39 , happyReduce_39),+	(40 , happyReduce_40),+	(41 , happyReduce_41),+	(42 , happyReduce_42),+	(43 , happyReduce_43),+	(44 , happyReduce_44),+	(45 , happyReduce_45),+	(46 , happyReduce_46),+	(47 , happyReduce_47),+	(48 , happyReduce_48),+	(49 , happyReduce_49),+	(50 , happyReduce_50),+	(51 , happyReduce_51),+	(52 , happyReduce_52),+	(53 , happyReduce_53),+	(54 , happyReduce_54),+	(55 , happyReduce_55),+	(56 , happyReduce_56),+	(57 , happyReduce_57),+	(58 , happyReduce_58),+	(59 , happyReduce_59),+	(60 , happyReduce_60),+	(61 , happyReduce_61),+	(62 , happyReduce_62),+	(63 , happyReduce_63),+	(64 , happyReduce_64),+	(65 , happyReduce_65),+	(66 , happyReduce_66),+	(67 , happyReduce_67),+	(68 , happyReduce_68),+	(69 , happyReduce_69),+	(70 , happyReduce_70),+	(71 , happyReduce_71),+	(72 , happyReduce_72),+	(73 , happyReduce_73),+	(74 , happyReduce_74),+	(75 , happyReduce_75),+	(76 , happyReduce_76),+	(77 , happyReduce_77),+	(78 , happyReduce_78),+	(79 , happyReduce_79),+	(80 , happyReduce_80),+	(81 , happyReduce_81),+	(82 , happyReduce_82),+	(83 , happyReduce_83),+	(84 , happyReduce_84),+	(85 , happyReduce_85),+	(86 , happyReduce_86),+	(87 , happyReduce_87),+	(88 , happyReduce_88),+	(89 , happyReduce_89),+	(90 , happyReduce_90),+	(91 , happyReduce_91),+	(92 , happyReduce_92),+	(93 , happyReduce_93),+	(94 , happyReduce_94),+	(95 , happyReduce_95),+	(96 , happyReduce_96),+	(97 , happyReduce_97),+	(98 , happyReduce_98),+	(99 , happyReduce_99),+	(100 , happyReduce_100),+	(101 , happyReduce_101),+	(102 , happyReduce_102),+	(103 , happyReduce_103),+	(104 , happyReduce_104),+	(105 , happyReduce_105),+	(106 , happyReduce_106),+	(107 , happyReduce_107),+	(108 , happyReduce_108),+	(109 , happyReduce_109),+	(110 , happyReduce_110),+	(111 , happyReduce_111),+	(112 , happyReduce_112),+	(113 , happyReduce_113),+	(114 , happyReduce_114),+	(115 , happyReduce_115),+	(116 , happyReduce_116),+	(117 , happyReduce_117),+	(118 , happyReduce_118),+	(119 , happyReduce_119),+	(120 , happyReduce_120),+	(121 , happyReduce_121),+	(122 , happyReduce_122),+	(123 , happyReduce_123),+	(124 , happyReduce_124),+	(125 , happyReduce_125),+	(126 , happyReduce_126),+	(127 , happyReduce_127),+	(128 , happyReduce_128),+	(129 , happyReduce_129),+	(130 , happyReduce_130),+	(131 , happyReduce_131),+	(132 , happyReduce_132),+	(133 , happyReduce_133),+	(134 , happyReduce_134),+	(135 , happyReduce_135),+	(136 , happyReduce_136),+	(137 , happyReduce_137),+	(138 , happyReduce_138),+	(139 , happyReduce_139),+	(140 , happyReduce_140),+	(141 , happyReduce_141),+	(142 , happyReduce_142),+	(143 , happyReduce_143),+	(144 , happyReduce_144),+	(145 , happyReduce_145),+	(146 , happyReduce_146),+	(147 , happyReduce_147),+	(148 , happyReduce_148),+	(149 , happyReduce_149),+	(150 , happyReduce_150),+	(151 , happyReduce_151),+	(152 , happyReduce_152),+	(153 , happyReduce_153),+	(154 , happyReduce_154),+	(155 , happyReduce_155),+	(156 , happyReduce_156),+	(157 , happyReduce_157),+	(158 , happyReduce_158),+	(159 , happyReduce_159),+	(160 , happyReduce_160),+	(161 , happyReduce_161),+	(162 , happyReduce_162),+	(163 , happyReduce_163),+	(164 , happyReduce_164),+	(165 , happyReduce_165),+	(166 , happyReduce_166),+	(167 , happyReduce_167),+	(168 , happyReduce_168),+	(169 , happyReduce_169),+	(170 , happyReduce_170),+	(171 , happyReduce_171),+	(172 , happyReduce_172),+	(173 , happyReduce_173),+	(174 , happyReduce_174),+	(175 , happyReduce_175),+	(176 , happyReduce_176),+	(177 , happyReduce_177),+	(178 , happyReduce_178),+	(179 , happyReduce_179),+	(180 , happyReduce_180),+	(181 , happyReduce_181),+	(182 , happyReduce_182),+	(183 , happyReduce_183),+	(184 , happyReduce_184),+	(185 , happyReduce_185),+	(186 , happyReduce_186),+	(187 , happyReduce_187),+	(188 , happyReduce_188),+	(189 , happyReduce_189),+	(190 , happyReduce_190),+	(191 , happyReduce_191),+	(192 , happyReduce_192),+	(193 , happyReduce_193),+	(194 , happyReduce_194),+	(195 , happyReduce_195),+	(196 , happyReduce_196),+	(197 , happyReduce_197),+	(198 , happyReduce_198),+	(199 , happyReduce_199),+	(200 , happyReduce_200),+	(201 , happyReduce_201),+	(202 , happyReduce_202),+	(203 , happyReduce_203),+	(204 , happyReduce_204),+	(205 , happyReduce_205),+	(206 , happyReduce_206),+	(207 , happyReduce_207),+	(208 , happyReduce_208),+	(209 , happyReduce_209),+	(210 , happyReduce_210),+	(211 , happyReduce_211),+	(212 , happyReduce_212),+	(213 , happyReduce_213),+	(214 , happyReduce_214),+	(215 , happyReduce_215),+	(216 , happyReduce_216),+	(217 , happyReduce_217),+	(218 , happyReduce_218),+	(219 , happyReduce_219),+	(220 , happyReduce_220),+	(221 , happyReduce_221),+	(222 , happyReduce_222),+	(223 , happyReduce_223),+	(224 , happyReduce_224),+	(225 , happyReduce_225),+	(226 , happyReduce_226),+	(227 , happyReduce_227),+	(228 , happyReduce_228),+	(229 , happyReduce_229),+	(230 , happyReduce_230),+	(231 , happyReduce_231),+	(232 , happyReduce_232),+	(233 , happyReduce_233),+	(234 , happyReduce_234),+	(235 , happyReduce_235),+	(236 , happyReduce_236),+	(237 , happyReduce_237),+	(238 , happyReduce_238),+	(239 , happyReduce_239),+	(240 , happyReduce_240),+	(241 , happyReduce_241),+	(242 , happyReduce_242),+	(243 , happyReduce_243),+	(244 , happyReduce_244),+	(245 , happyReduce_245),+	(246 , happyReduce_246),+	(247 , happyReduce_247),+	(248 , happyReduce_248),+	(249 , happyReduce_249),+	(250 , happyReduce_250),+	(251 , happyReduce_251)+	]++happy_n_terms = 63 :: Int+happy_n_nonterms = 92 :: Int++happyReduce_3 = happySpecReduce_1  0# happyReduction_3+happyReduction_3 happy_x_1+	 =  case happyOut7 happy_x_1 of { happy_var_1 -> +	happyIn6+		 (reverse happy_var_1+	)}++happyReduce_4 = happySpecReduce_2  1# happyReduction_4+happyReduction_4 happy_x_2+	happy_x_1+	 =  case happyOut7 happy_x_1 of { happy_var_1 -> +	case happyOut8 happy_x_2 of { happy_var_2 -> +	happyIn7+		 (happy_var_2 : happy_var_1+	)}}++happyReduce_5 = happySpecReduce_0  1# happyReduction_5+happyReduction_5  =  happyIn7+		 ([]+	)++happyReduce_6 = happySpecReduce_1  2# happyReduction_6+happyReduction_6 happy_x_1+	 =  case happyOutTok happy_x_1 of { (TokKeyword KwLet happy_var_1) -> +	happyIn8+		 (TokKeyword KwLet happy_var_1+	)}++happyReduce_7 = happySpecReduce_1  2# happyReduction_7+happyReduction_7 happy_x_1+	 =  case happyOutTok happy_x_1 of { (TokKeyword KwIn happy_var_1) -> +	happyIn8+		 (TokKeyword KwIn happy_var_1+	)}++happyReduce_8 = happySpecReduce_1  2# happyReduction_8+happyReduction_8 happy_x_1+	 =  case happyOutTok happy_x_1 of { (TokKeyword KwWhere happy_var_1) -> +	happyIn8+		 (TokKeyword KwWhere happy_var_1+	)}++happyReduce_9 = happySpecReduce_1  2# happyReduction_9+happyReduction_9 happy_x_1+	 =  case happyOutTok happy_x_1 of { (TokKeyword KwWith happy_var_1) -> +	happyIn8+		 (TokKeyword KwWith happy_var_1+	)}++happyReduce_10 = happySpecReduce_1  2# happyReduction_10+happyReduction_10 happy_x_1+	 =  case happyOutTok happy_x_1 of { (TokKeyword KwPostulate happy_var_1) -> +	happyIn8+		 (TokKeyword KwPostulate happy_var_1+	)}++happyReduce_11 = happySpecReduce_1  2# happyReduction_11+happyReduction_11 happy_x_1+	 =  case happyOutTok happy_x_1 of { (TokKeyword KwPrimitive happy_var_1) -> +	happyIn8+		 (TokKeyword KwPrimitive happy_var_1+	)}++happyReduce_12 = happySpecReduce_1  2# happyReduction_12+happyReduction_12 happy_x_1+	 =  case happyOutTok happy_x_1 of { (TokKeyword KwOpen happy_var_1) -> +	happyIn8+		 (TokKeyword KwOpen happy_var_1+	)}++happyReduce_13 = happySpecReduce_1  2# happyReduction_13+happyReduction_13 happy_x_1+	 =  case happyOutTok happy_x_1 of { (TokKeyword KwImport happy_var_1) -> +	happyIn8+		 (TokKeyword KwImport happy_var_1+	)}++happyReduce_14 = happySpecReduce_1  2# happyReduction_14+happyReduction_14 happy_x_1+	 =  case happyOutTok happy_x_1 of { (TokKeyword KwUsing happy_var_1) -> +	happyIn8+		 (TokKeyword KwUsing happy_var_1+	)}++happyReduce_15 = happySpecReduce_1  2# happyReduction_15+happyReduction_15 happy_x_1+	 =  case happyOutTok happy_x_1 of { (TokKeyword KwHiding happy_var_1) -> +	happyIn8+		 (TokKeyword KwHiding happy_var_1+	)}++happyReduce_16 = happySpecReduce_1  2# happyReduction_16+happyReduction_16 happy_x_1+	 =  case happyOutTok happy_x_1 of { (TokKeyword KwRenaming happy_var_1) -> +	happyIn8+		 (TokKeyword KwRenaming happy_var_1+	)}++happyReduce_17 = happySpecReduce_1  2# happyReduction_17+happyReduction_17 happy_x_1+	 =  case happyOutTok happy_x_1 of { (TokKeyword KwTo happy_var_1) -> +	happyIn8+		 (TokKeyword KwTo happy_var_1+	)}++happyReduce_18 = happySpecReduce_1  2# happyReduction_18+happyReduction_18 happy_x_1+	 =  case happyOutTok happy_x_1 of { (TokKeyword KwPublic happy_var_1) -> +	happyIn8+		 (TokKeyword KwPublic happy_var_1+	)}++happyReduce_19 = happySpecReduce_1  2# happyReduction_19+happyReduction_19 happy_x_1+	 =  case happyOutTok happy_x_1 of { (TokKeyword KwModule happy_var_1) -> +	happyIn8+		 (TokKeyword KwModule happy_var_1+	)}++happyReduce_20 = happySpecReduce_1  2# happyReduction_20+happyReduction_20 happy_x_1+	 =  case happyOutTok happy_x_1 of { (TokKeyword KwData happy_var_1) -> +	happyIn8+		 (TokKeyword KwData happy_var_1+	)}++happyReduce_21 = happySpecReduce_1  2# happyReduction_21+happyReduction_21 happy_x_1+	 =  case happyOutTok happy_x_1 of { (TokKeyword KwCoData happy_var_1) -> +	happyIn8+		 (TokKeyword KwCoData happy_var_1+	)}++happyReduce_22 = happySpecReduce_1  2# happyReduction_22+happyReduction_22 happy_x_1+	 =  case happyOutTok happy_x_1 of { (TokKeyword KwRecord happy_var_1) -> +	happyIn8+		 (TokKeyword KwRecord happy_var_1+	)}++happyReduce_23 = happySpecReduce_1  2# happyReduction_23+happyReduction_23 happy_x_1+	 =  case happyOutTok happy_x_1 of { (TokKeyword KwField happy_var_1) -> +	happyIn8+		 (TokKeyword KwField happy_var_1+	)}++happyReduce_24 = happySpecReduce_1  2# happyReduction_24+happyReduction_24 happy_x_1+	 =  case happyOutTok happy_x_1 of { (TokKeyword KwInfix happy_var_1) -> +	happyIn8+		 (TokKeyword KwInfix happy_var_1+	)}++happyReduce_25 = happySpecReduce_1  2# happyReduction_25+happyReduction_25 happy_x_1+	 =  case happyOutTok happy_x_1 of { (TokKeyword KwInfixL happy_var_1) -> +	happyIn8+		 (TokKeyword KwInfixL happy_var_1+	)}++happyReduce_26 = happySpecReduce_1  2# happyReduction_26+happyReduction_26 happy_x_1+	 =  case happyOutTok happy_x_1 of { (TokKeyword KwInfixR happy_var_1) -> +	happyIn8+		 (TokKeyword KwInfixR happy_var_1+	)}++happyReduce_27 = happySpecReduce_1  2# happyReduction_27+happyReduction_27 happy_x_1+	 =  case happyOutTok happy_x_1 of { (TokKeyword KwMutual happy_var_1) -> +	happyIn8+		 (TokKeyword KwMutual happy_var_1+	)}++happyReduce_28 = happySpecReduce_1  2# happyReduction_28+happyReduction_28 happy_x_1+	 =  case happyOutTok happy_x_1 of { (TokKeyword KwAbstract happy_var_1) -> +	happyIn8+		 (TokKeyword KwAbstract happy_var_1+	)}++happyReduce_29 = happySpecReduce_1  2# happyReduction_29+happyReduction_29 happy_x_1+	 =  case happyOutTok happy_x_1 of { (TokKeyword KwPrivate happy_var_1) -> +	happyIn8+		 (TokKeyword KwPrivate happy_var_1+	)}++happyReduce_30 = happySpecReduce_1  2# happyReduction_30+happyReduction_30 happy_x_1+	 =  case happyOutTok happy_x_1 of { (TokKeyword KwProp happy_var_1) -> +	happyIn8+		 (TokKeyword KwProp happy_var_1+	)}++happyReduce_31 = happySpecReduce_1  2# happyReduction_31+happyReduction_31 happy_x_1+	 =  case happyOutTok happy_x_1 of { (TokKeyword KwSet happy_var_1) -> +	happyIn8+		 (TokKeyword KwSet happy_var_1+	)}++happyReduce_32 = happySpecReduce_1  2# happyReduction_32+happyReduction_32 happy_x_1+	 =  case happyOutTok happy_x_1 of { (TokKeyword KwForall happy_var_1) -> +	happyIn8+		 (TokKeyword KwForall happy_var_1+	)}++happyReduce_33 = happySpecReduce_1  2# happyReduction_33+happyReduction_33 happy_x_1+	 =  case happyOutTok happy_x_1 of { (TokKeyword KwOPTIONS happy_var_1) -> +	happyIn8+		 (TokKeyword KwOPTIONS happy_var_1+	)}++happyReduce_34 = happySpecReduce_1  2# happyReduction_34+happyReduction_34 happy_x_1+	 =  case happyOutTok happy_x_1 of { (TokKeyword KwBUILTIN happy_var_1) -> +	happyIn8+		 (TokKeyword KwBUILTIN happy_var_1+	)}++happyReduce_35 = happySpecReduce_1  2# happyReduction_35+happyReduction_35 happy_x_1+	 =  case happyOutTok happy_x_1 of { (TokKeyword KwIMPORT happy_var_1) -> +	happyIn8+		 (TokKeyword KwIMPORT happy_var_1+	)}++happyReduce_36 = happySpecReduce_1  2# happyReduction_36+happyReduction_36 happy_x_1+	 =  case happyOutTok happy_x_1 of { (TokKeyword KwCOMPILED happy_var_1) -> +	happyIn8+		 (TokKeyword KwCOMPILED happy_var_1+	)}++happyReduce_37 = happySpecReduce_1  2# happyReduction_37+happyReduction_37 happy_x_1+	 =  case happyOutTok happy_x_1 of { (TokKeyword KwCOMPILED_DATA happy_var_1) -> +	happyIn8+		 (TokKeyword KwCOMPILED_DATA happy_var_1+	)}++happyReduce_38 = happySpecReduce_1  2# happyReduction_38+happyReduction_38 happy_x_1+	 =  case happyOutTok happy_x_1 of { (TokKeyword KwCOMPILED_TYPE happy_var_1) -> +	happyIn8+		 (TokKeyword KwCOMPILED_TYPE happy_var_1+	)}++happyReduce_39 = happySpecReduce_1  2# happyReduction_39+happyReduction_39 happy_x_1+	 =  case happyOutTok happy_x_1 of { (TokKeyword KwLINE happy_var_1) -> +	happyIn8+		 (TokKeyword KwLINE happy_var_1+	)}++happyReduce_40 = happySpecReduce_1  2# happyReduction_40+happyReduction_40 happy_x_1+	 =  case happyOutTok happy_x_1 of { (TokSetN happy_var_1) -> +	happyIn8+		 (TokSetN happy_var_1+	)}++happyReduce_41 = happySpecReduce_1  2# happyReduction_41+happyReduction_41 happy_x_1+	 =  case happyOutTok happy_x_1 of { (TokTeX happy_var_1) -> +	happyIn8+		 (TokTeX happy_var_1+	)}++happyReduce_42 = happySpecReduce_1  2# happyReduction_42+happyReduction_42 happy_x_1+	 =  case happyOutTok happy_x_1 of { (TokComment happy_var_1) -> +	happyIn8+		 (TokComment happy_var_1+	)}++happyReduce_43 = happySpecReduce_1  2# happyReduction_43+happyReduction_43 happy_x_1+	 =  case happyOutTok happy_x_1 of { (TokSymbol SymEllipsis happy_var_1) -> +	happyIn8+		 (TokSymbol SymEllipsis happy_var_1+	)}++happyReduce_44 = happySpecReduce_1  2# happyReduction_44+happyReduction_44 happy_x_1+	 =  case happyOutTok happy_x_1 of { (TokSymbol SymDot happy_var_1) -> +	happyIn8+		 (TokSymbol SymDot happy_var_1+	)}++happyReduce_45 = happySpecReduce_1  2# happyReduction_45+happyReduction_45 happy_x_1+	 =  case happyOutTok happy_x_1 of { (TokSymbol SymSemi happy_var_1) -> +	happyIn8+		 (TokSymbol SymSemi happy_var_1+	)}++happyReduce_46 = happySpecReduce_1  2# happyReduction_46+happyReduction_46 happy_x_1+	 =  case happyOutTok happy_x_1 of { (TokSymbol SymColon happy_var_1) -> +	happyIn8+		 (TokSymbol SymColon happy_var_1+	)}++happyReduce_47 = happySpecReduce_1  2# happyReduction_47+happyReduction_47 happy_x_1+	 =  case happyOutTok happy_x_1 of { (TokSymbol SymEqual happy_var_1) -> +	happyIn8+		 (TokSymbol SymEqual happy_var_1+	)}++happyReduce_48 = happySpecReduce_1  2# happyReduction_48+happyReduction_48 happy_x_1+	 =  case happyOutTok happy_x_1 of { (TokSymbol SymUnderscore happy_var_1) -> +	happyIn8+		 (TokSymbol SymUnderscore happy_var_1+	)}++happyReduce_49 = happySpecReduce_1  2# happyReduction_49+happyReduction_49 happy_x_1+	 =  case happyOutTok happy_x_1 of { (TokSymbol SymQuestionMark happy_var_1) -> +	happyIn8+		 (TokSymbol SymQuestionMark happy_var_1+	)}++happyReduce_50 = happySpecReduce_1  2# happyReduction_50+happyReduction_50 happy_x_1+	 =  case happyOutTok happy_x_1 of { (TokSymbol SymArrow happy_var_1) -> +	happyIn8+		 (TokSymbol SymArrow happy_var_1+	)}++happyReduce_51 = happySpecReduce_1  2# happyReduction_51+happyReduction_51 happy_x_1+	 =  case happyOutTok happy_x_1 of { (TokSymbol SymLambda happy_var_1) -> +	happyIn8+		 (TokSymbol SymLambda happy_var_1+	)}++happyReduce_52 = happySpecReduce_1  2# happyReduction_52+happyReduction_52 happy_x_1+	 =  case happyOutTok happy_x_1 of { (TokSymbol SymAs happy_var_1) -> +	happyIn8+		 (TokSymbol SymAs happy_var_1+	)}++happyReduce_53 = happySpecReduce_1  2# happyReduction_53+happyReduction_53 happy_x_1+	 =  case happyOutTok happy_x_1 of { (TokSymbol SymBar happy_var_1) -> +	happyIn8+		 (TokSymbol SymBar happy_var_1+	)}++happyReduce_54 = happySpecReduce_1  2# happyReduction_54+happyReduction_54 happy_x_1+	 =  case happyOutTok happy_x_1 of { (TokSymbol SymOpenParen happy_var_1) -> +	happyIn8+		 (TokSymbol SymOpenParen happy_var_1+	)}++happyReduce_55 = happySpecReduce_1  2# happyReduction_55+happyReduction_55 happy_x_1+	 =  case happyOutTok happy_x_1 of { (TokSymbol SymCloseParen happy_var_1) -> +	happyIn8+		 (TokSymbol SymCloseParen happy_var_1+	)}++happyReduce_56 = happySpecReduce_1  2# happyReduction_56+happyReduction_56 happy_x_1+	 =  case happyOutTok happy_x_1 of { (TokSymbol SymOpenBrace happy_var_1) -> +	happyIn8+		 (TokSymbol SymOpenBrace happy_var_1+	)}++happyReduce_57 = happySpecReduce_1  2# happyReduction_57+happyReduction_57 happy_x_1+	 =  case happyOutTok happy_x_1 of { (TokSymbol SymCloseBrace happy_var_1) -> +	happyIn8+		 (TokSymbol SymCloseBrace happy_var_1+	)}++happyReduce_58 = happySpecReduce_1  2# happyReduction_58+happyReduction_58 happy_x_1+	 =  case happyOutTok happy_x_1 of { (TokSymbol SymOpenVirtualBrace happy_var_1) -> +	happyIn8+		 (TokSymbol SymOpenVirtualBrace happy_var_1+	)}++happyReduce_59 = happySpecReduce_1  2# happyReduction_59+happyReduction_59 happy_x_1+	 =  case happyOutTok happy_x_1 of { (TokSymbol SymCloseVirtualBrace happy_var_1) -> +	happyIn8+		 (TokSymbol SymCloseVirtualBrace happy_var_1+	)}++happyReduce_60 = happySpecReduce_1  2# happyReduction_60+happyReduction_60 happy_x_1+	 =  case happyOutTok happy_x_1 of { (TokSymbol SymVirtualSemi happy_var_1) -> +	happyIn8+		 (TokSymbol SymVirtualSemi happy_var_1+	)}++happyReduce_61 = happySpecReduce_1  2# happyReduction_61+happyReduction_61 happy_x_1+	 =  case happyOutTok happy_x_1 of { (TokSymbol SymOpenPragma happy_var_1) -> +	happyIn8+		 (TokSymbol SymOpenPragma happy_var_1+	)}++happyReduce_62 = happySpecReduce_1  2# happyReduction_62+happyReduction_62 happy_x_1+	 =  case happyOutTok happy_x_1 of { (TokSymbol SymClosePragma happy_var_1) -> +	happyIn8+		 (TokSymbol SymClosePragma happy_var_1+	)}++happyReduce_63 = happySpecReduce_1  2# happyReduction_63+happyReduction_63 happy_x_1+	 =  case happyOutTok happy_x_1 of { (TokId happy_var_1) -> +	happyIn8+		 (TokId happy_var_1+	)}++happyReduce_64 = happySpecReduce_1  2# happyReduction_64+happyReduction_64 happy_x_1+	 =  case happyOutTok happy_x_1 of { (TokQId happy_var_1) -> +	happyIn8+		 (TokQId happy_var_1+	)}++happyReduce_65 = happySpecReduce_1  2# happyReduction_65+happyReduction_65 happy_x_1+	 =  case happyOutTok happy_x_1 of { (TokString happy_var_1) -> +	happyIn8+		 (TokString happy_var_1+	)}++happyReduce_66 = happySpecReduce_1  2# happyReduction_66+happyReduction_66 happy_x_1+	 =  case happyOutTok happy_x_1 of { (TokLiteral happy_var_1) -> +	happyIn8+		 (TokLiteral happy_var_1+	)}++happyReduce_67 = happySpecReduce_0  3# happyReduction_67+happyReduction_67  =  happyIn9+		 (()+	)++happyReduce_68 = happySpecReduce_2  3# happyReduction_68+happyReduction_68 happy_x_2+	happy_x_1+	 =  happyIn9+		 (()+	)++happyReduce_69 = happySpecReduce_2  4# happyReduction_69+happyReduction_69 happy_x_2+	happy_x_1+	 =  case happyOut11 happy_x_1 of { happy_var_1 -> +	happyIn10+		 (happy_var_1+	)}++happyReduce_70 = happySpecReduce_1  5# happyReduction_70+happyReduction_70 happy_x_1+	 =  case happyOut80 happy_x_1 of { happy_var_1 -> +	happyIn11+		 (([], happy_var_1)+	)}++happyReduce_71 = happySpecReduce_3  5# happyReduction_71+happyReduction_71 happy_x_3+	happy_x_2+	happy_x_1+	 =  case happyOut83 happy_x_2 of { happy_var_2 -> +	case happyOut11 happy_x_3 of { happy_var_3 -> +	happyIn11+		 (let (ps,m) = happy_var_3 in (happy_var_2 : ps, m)+	)}}++happyReduce_72 = happySpecReduce_1  6# happyReduction_72+happyReduction_72 happy_x_1+	 =  happyIn12+		 (()+	)++happyReduce_73 = happyMonadReduce 1# 6# happyReduction_73+happyReduction_73 (happy_x_1 `HappyStk`+	happyRest) tk+	 = happyThen (( popContext)+	) (\r -> happyReturn (happyIn12 r))++happyReduce_74 = happySpecReduce_1  7# happyReduction_74+happyReduction_74 happy_x_1+	 =  case happyOutTok happy_x_1 of { (TokSymbol SymSemi happy_var_1) -> +	happyIn13+		 (happy_var_1+	)}++happyReduce_75 = happySpecReduce_2  7# happyReduction_75+happyReduction_75 happy_x_2+	happy_x_1+	 =  case happyOutTok happy_x_2 of { (TokSymbol SymVirtualSemi happy_var_2) -> +	happyIn13+		 (happy_var_2+	)}++happyReduce_76 = happyMonadReduce 0# 8# happyReduction_76+happyReduction_76 (happyRest) tk+	 = happyThen (( pushLexState imp_dir)+	) (\r -> happyReturn (happyIn14 r))++happyReduce_77 = happyMonadReduce 1# 9# happyReduction_77+happyReduction_77 (happy_x_1 `HappyStk`+	happyRest) tk+	 = happyThen (case happyOutTok happy_x_1 of { (TokLiteral happy_var_1) -> +	( case happy_var_1 of {+		     LitInt _ n	-> return $ fromIntegral n;+		     _		-> fail $ "Expected integer"+		   })}+	) (\r -> happyReturn (happyIn15 r))++happyReduce_78 = happyMonadReduce 1# 10# happyReduction_78+happyReduction_78 (happy_x_1 `HappyStk`+	happyRest) tk+	 = happyThen (case happyOutTok happy_x_1 of { (TokId happy_var_1) -> +	( mkName happy_var_1)}+	) (\r -> happyReturn (happyIn16 r))++happyReduce_79 = happyMonadReduce 1# 11# happyReduction_79+happyReduction_79 (happy_x_1 `HappyStk`+	happyRest) tk+	 = happyThen (case happyOutTok happy_x_1 of { (TokQId happy_var_1) -> +	( mkQName happy_var_1)}+	) (\r -> happyReturn (happyIn17 r))++happyReduce_80 = happySpecReduce_1  11# happyReduction_80+happyReduction_80 happy_x_1+	 =  case happyOut16 happy_x_1 of { happy_var_1 -> +	happyIn17+		 (QName happy_var_1+	)}++happyReduce_81 = happySpecReduce_1  12# happyReduction_81+happyReduction_81 happy_x_1+	 =  case happyOut17 happy_x_1 of { happy_var_1 -> +	happyIn18+		 (happy_var_1+	)}++happyReduce_82 = happySpecReduce_1  13# happyReduction_82+happyReduction_82 happy_x_1+	 =  case happyOut16 happy_x_1 of { happy_var_1 -> +	happyIn19+		 (happy_var_1+	)}++happyReduce_83 = happySpecReduce_1  13# happyReduction_83+happyReduction_83 happy_x_1+	 =  case happyOutTok happy_x_1 of { (TokSymbol SymUnderscore happy_var_1) -> +	happyIn19+		 (Name (getRange happy_var_1) [Hole]+	)}++happyReduce_84 = happySpecReduce_2  14# happyReduction_84+happyReduction_84 happy_x_2+	happy_x_1+	 =  case happyOut19 happy_x_1 of { happy_var_1 -> +	case happyOut20 happy_x_2 of { happy_var_2 -> +	happyIn20+		 (happy_var_1 : happy_var_2+	)}}++happyReduce_85 = happySpecReduce_1  14# happyReduction_85+happyReduction_85 happy_x_1+	 =  case happyOut19 happy_x_1 of { happy_var_1 -> +	happyIn20+		 ([happy_var_1]+	)}++happyReduce_86 = happyMonadReduce 1# 15# happyReduction_86+happyReduction_86 (happy_x_1 `HappyStk`+	happyRest) tk+	 = happyThen (case happyOut27 happy_x_1 of { happy_var_1 -> +	(+    let getName (Ident (QName x)) = Just x+	getName (Underscore r _)  = Just (Name r [Hole])+	getName _		  = Nothing+    in+    case partition isJust $ map getName happy_var_1 of+	(good, []) -> return $ map fromJust good+	_	   -> fail $ "expected sequence of bound identifiers")}+	) (\r -> happyReturn (happyIn21 r))++happyReduce_87 = happySpecReduce_0  16# happyReduction_87+happyReduction_87  =  happyIn22+		 ([]+	)++happyReduce_88 = happySpecReduce_2  16# happyReduction_88+happyReduction_88 happy_x_2+	happy_x_1+	 =  case happyOutTok happy_x_1 of { (TokString happy_var_1) -> +	case happyOut22 happy_x_2 of { happy_var_2 -> +	happyIn22+		 (snd happy_var_1 : happy_var_2+	)}}++happyReduce_89 = happyMonadReduce 1# 17# happyReduction_89+happyReduction_89 (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 (happyIn23 r))++happyReduce_90 = happySpecReduce_2  18# happyReduction_90+happyReduction_90 happy_x_2+	happy_x_1+	 =  case happyOut34 happy_x_1 of { happy_var_1 -> +	case happyOut24 happy_x_2 of { happy_var_2 -> +	happyIn24+		 (Pi happy_var_1 happy_var_2+	)}}++happyReduce_91 = happySpecReduce_3  18# happyReduction_91+happyReduction_91 happy_x_3+	happy_x_2+	happy_x_1+	 =  case happyOut41 happy_x_2 of { happy_var_2 -> +	case happyOut24 happy_x_3 of { happy_var_3 -> +	happyIn24+		 (forallPi happy_var_2 happy_var_3+	)}}++happyReduce_92 = happySpecReduce_3  18# happyReduction_92+happyReduction_92 happy_x_3+	happy_x_2+	happy_x_1+	 =  case happyOut29 happy_x_1 of { happy_var_1 -> +	case happyOut24 happy_x_3 of { happy_var_3 -> +	happyIn24+		 (Fun (fuseRange happy_var_1 happy_var_3) (RawApp (getRange happy_var_1) happy_var_1) happy_var_3+	)}}++happyReduce_93 = happySpecReduce_1  18# happyReduction_93+happyReduction_93 happy_x_1+	 =  case happyOut25 happy_x_1 of { happy_var_1 -> +	happyIn24+		 (happy_var_1+	)}++happyReduce_94 = happyMonadReduce 1# 19# happyReduction_94+happyReduction_94 (happy_x_1 `HappyStk`+	happyRest) tk+	 = happyThen (case happyOut26 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 (happyIn25 r))++happyReduce_95 = happySpecReduce_3  20# happyReduction_95+happyReduction_95 happy_x_3+	happy_x_2+	happy_x_1+	 =  case happyOut29 happy_x_1 of { happy_var_1 -> +	case happyOut26 happy_x_3 of { happy_var_3 -> +	happyIn26+		 (RawApp (getRange happy_var_1) happy_var_1 :  happy_var_3+	)}}++happyReduce_96 = happySpecReduce_1  20# happyReduction_96+happyReduction_96 happy_x_1+	 =  case happyOut27 happy_x_1 of { happy_var_1 -> +	happyIn26+		 ([RawApp (getRange happy_var_1) happy_var_1]+	)}++happyReduce_97 = happySpecReduce_1  21# happyReduction_97+happyReduction_97 happy_x_1+	 =  case happyOut28 happy_x_1 of { happy_var_1 -> +	happyIn27+		 ([happy_var_1]+	)}++happyReduce_98 = happySpecReduce_2  21# happyReduction_98+happyReduction_98 happy_x_2+	happy_x_1+	 =  case happyOut30 happy_x_1 of { happy_var_1 -> +	case happyOut27 happy_x_2 of { happy_var_2 -> +	happyIn27+		 (happy_var_1 : happy_var_2+	)}}++happyReduce_99 = happySpecReduce_3  22# happyReduction_99+happyReduction_99 happy_x_3+	happy_x_2+	happy_x_1+	 =  case happyOutTok happy_x_1 of { (TokSymbol SymLambda happy_var_1) -> +	case happyOut41 happy_x_2 of { happy_var_2 -> +	case happyOut24 happy_x_3 of { happy_var_3 -> +	happyIn28+		 (Lam (fuseRange happy_var_1 happy_var_3) happy_var_2 happy_var_3+	)}}}++happyReduce_100 = happySpecReduce_2  22# happyReduction_100+happyReduction_100 happy_x_2+	happy_x_1+	 =  case happyOutTok happy_x_1 of { (TokSymbol SymLambda happy_var_1) -> +	case happyOut42 happy_x_2 of { happy_var_2 -> +	happyIn28+		 (let (bs, h) = happy_var_2; r = fuseRange happy_var_1 bs in+                                     if null bs then AbsurdLam r h else+                                     Lam r bs (AbsurdLam r h)+	)}}++happyReduce_101 = happyReduce 4# 22# happyReduction_101+happyReduction_101 (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 happyOut95 happy_x_2 of { happy_var_2 -> +	case happyOut24 happy_x_4 of { happy_var_4 -> +	happyIn28+		 (Let (fuseRange happy_var_1 happy_var_4) happy_var_2 happy_var_4+	) `HappyStk` happyRest}}}++happyReduce_102 = happySpecReduce_1  22# happyReduction_102+happyReduction_102 happy_x_1+	 =  case happyOut30 happy_x_1 of { happy_var_1 -> +	happyIn28+		 (happy_var_1+	)}++happyReduce_103 = happySpecReduce_1  23# happyReduction_103+happyReduction_103 happy_x_1+	 =  case happyOut30 happy_x_1 of { happy_var_1 -> +	happyIn29+		 ([happy_var_1]+	)}++happyReduce_104 = happySpecReduce_2  23# happyReduction_104+happyReduction_104 happy_x_2+	happy_x_1+	 =  case happyOut30 happy_x_1 of { happy_var_1 -> +	case happyOut29 happy_x_2 of { happy_var_2 -> +	happyIn29+		 (happy_var_1 : happy_var_2+	)}}++happyReduce_105 = happySpecReduce_1  24# happyReduction_105+happyReduction_105 happy_x_1+	 =  case happyOut17 happy_x_1 of { happy_var_1 -> +	happyIn30+		 (Ident happy_var_1+	)}++happyReduce_106 = happySpecReduce_1  24# happyReduction_106+happyReduction_106 happy_x_1+	 =  case happyOutTok happy_x_1 of { (TokLiteral happy_var_1) -> +	happyIn30+		 (Lit happy_var_1+	)}++happyReduce_107 = happySpecReduce_1  24# happyReduction_107+happyReduction_107 happy_x_1+	 =  case happyOutTok happy_x_1 of { (TokSymbol SymQuestionMark happy_var_1) -> +	happyIn30+		 (QuestionMark (getRange happy_var_1) Nothing+	)}++happyReduce_108 = happySpecReduce_1  24# happyReduction_108+happyReduction_108 happy_x_1+	 =  case happyOutTok happy_x_1 of { (TokSymbol SymUnderscore happy_var_1) -> +	happyIn30+		 (Underscore (getRange happy_var_1) Nothing+	)}++happyReduce_109 = happySpecReduce_1  24# happyReduction_109+happyReduction_109 happy_x_1+	 =  case happyOutTok happy_x_1 of { (TokKeyword KwProp happy_var_1) -> +	happyIn30+		 (Prop (getRange happy_var_1)+	)}++happyReduce_110 = happySpecReduce_1  24# happyReduction_110+happyReduction_110 happy_x_1+	 =  case happyOutTok happy_x_1 of { (TokKeyword KwSet happy_var_1) -> +	happyIn30+		 (Set (getRange happy_var_1)+	)}++happyReduce_111 = happySpecReduce_1  24# happyReduction_111+happyReduction_111 happy_x_1+	 =  case happyOutTok happy_x_1 of { (TokSetN happy_var_1) -> +	happyIn30+		 (SetN (getRange (fst happy_var_1)) (snd happy_var_1)+	)}++happyReduce_112 = happySpecReduce_3  24# happyReduction_112+happyReduction_112 happy_x_3+	happy_x_2+	happy_x_1+	 =  case happyOutTok happy_x_1 of { (TokSymbol SymOpenBrace happy_var_1) -> +	case happyOut24 happy_x_2 of { happy_var_2 -> +	case happyOutTok happy_x_3 of { (TokSymbol SymCloseBrace happy_var_3) -> +	happyIn30+		 (HiddenArg (fuseRange happy_var_1 happy_var_3) (unnamed happy_var_2)+	)}}}++happyReduce_113 = happyReduce 5# 24# happyReduction_113+happyReduction_113 (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 SymOpenBrace happy_var_1) -> +	case happyOut16 happy_x_2 of { happy_var_2 -> +	case happyOut24 happy_x_4 of { happy_var_4 -> +	case happyOutTok happy_x_5 of { (TokSymbol SymCloseBrace happy_var_5) -> +	happyIn30+		 (HiddenArg (fuseRange happy_var_1 happy_var_5) (named (show happy_var_2) happy_var_4)+	) `HappyStk` happyRest}}}}++happyReduce_114 = happySpecReduce_3  24# happyReduction_114+happyReduction_114 happy_x_3+	happy_x_2+	happy_x_1+	 =  case happyOutTok happy_x_1 of { (TokSymbol SymOpenParen happy_var_1) -> +	case happyOut24 happy_x_2 of { happy_var_2 -> +	case happyOutTok happy_x_3 of { (TokSymbol SymCloseParen happy_var_3) -> +	happyIn30+		 (Paren (fuseRange happy_var_1 happy_var_3) happy_var_2+	)}}}++happyReduce_115 = happySpecReduce_2  24# happyReduction_115+happyReduction_115 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) -> +	happyIn30+		 (let r = fuseRange happy_var_1 happy_var_2 in HiddenArg r $ unnamed $ Absurd r+	)}}++happyReduce_116 = happySpecReduce_2  24# happyReduction_116+happyReduction_116 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) -> +	happyIn30+		 (Absurd (fuseRange happy_var_1 happy_var_2)+	)}}++happyReduce_117 = happySpecReduce_3  24# happyReduction_117+happyReduction_117 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 -> +	happyIn30+		 (As (fuseRange happy_var_1 happy_var_3) happy_var_1 happy_var_3+	)}}++happyReduce_118 = happySpecReduce_2  24# happyReduction_118+happyReduction_118 happy_x_2+	happy_x_1+	 =  case happyOutTok happy_x_1 of { (TokSymbol SymDot happy_var_1) -> +	case happyOut30 happy_x_2 of { happy_var_2 -> +	happyIn30+		 (Dot (fuseRange happy_var_1 happy_var_2) happy_var_2+	)}}++happyReduce_119 = happyReduce 4# 24# happyReduction_119+happyReduction_119 (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 happyOut31 happy_x_3 of { happy_var_3 -> +	case happyOutTok happy_x_4 of { (TokSymbol SymCloseBrace happy_var_4) -> +	happyIn30+		 (Rec (getRange (happy_var_1,happy_var_4)) happy_var_3+	) `HappyStk` happyRest}}}++happyReduce_120 = happySpecReduce_0  25# happyReduction_120+happyReduction_120  =  happyIn31+		 ([]+	)++happyReduce_121 = happySpecReduce_1  25# happyReduction_121+happyReduction_121 happy_x_1+	 =  case happyOut32 happy_x_1 of { happy_var_1 -> +	happyIn31+		 (happy_var_1+	)}++happyReduce_122 = happySpecReduce_1  26# happyReduction_122+happyReduction_122 happy_x_1+	 =  case happyOut33 happy_x_1 of { happy_var_1 -> +	happyIn32+		 ([happy_var_1]+	)}++happyReduce_123 = happySpecReduce_3  26# happyReduction_123+happyReduction_123 happy_x_3+	happy_x_2+	happy_x_1+	 =  case happyOut33 happy_x_1 of { happy_var_1 -> +	case happyOut32 happy_x_3 of { happy_var_3 -> +	happyIn32+		 (happy_var_1 : happy_var_3+	)}}++happyReduce_124 = happySpecReduce_3  27# happyReduction_124+happyReduction_124 happy_x_3+	happy_x_2+	happy_x_1+	 =  case happyOut16 happy_x_1 of { happy_var_1 -> +	case happyOut24 happy_x_3 of { happy_var_3 -> +	happyIn33+		 ((happy_var_1, happy_var_3)+	)}}++happyReduce_125 = happySpecReduce_2  28# happyReduction_125+happyReduction_125 happy_x_2+	happy_x_1+	 =  case happyOut35 happy_x_1 of { happy_var_1 -> +	happyIn34+		 (happy_var_1+	)}++happyReduce_126 = happySpecReduce_1  29# happyReduction_126+happyReduction_126 happy_x_1+	 =  case happyOut36 happy_x_1 of { happy_var_1 -> +	happyIn35+		 ({-TeleBind-} happy_var_1+	)}++happyReduce_127 = happySpecReduce_2  30# happyReduction_127+happyReduction_127 happy_x_2+	happy_x_1+	 =  case happyOut37 happy_x_1 of { happy_var_1 -> +	case happyOut36 happy_x_2 of { happy_var_2 -> +	happyIn36+		 (happy_var_1 : happy_var_2+	)}}++happyReduce_128 = happySpecReduce_1  30# happyReduction_128+happyReduction_128 happy_x_1+	 =  case happyOut37 happy_x_1 of { happy_var_1 -> +	happyIn36+		 ([happy_var_1]+	)}++happyReduce_129 = happySpecReduce_3  31# happyReduction_129+happyReduction_129 happy_x_3+	happy_x_2+	happy_x_1+	 =  case happyOutTok happy_x_1 of { (TokSymbol SymOpenParen happy_var_1) -> +	case happyOut38 happy_x_2 of { happy_var_2 -> +	case happyOutTok happy_x_3 of { (TokSymbol SymCloseParen happy_var_3) -> +	happyIn37+		 (TypedBindings (fuseRange happy_var_1 happy_var_3) NotHidden happy_var_2+	)}}}++happyReduce_130 = happySpecReduce_3  31# happyReduction_130+happyReduction_130 happy_x_3+	happy_x_2+	happy_x_1+	 =  case happyOutTok happy_x_1 of { (TokSymbol SymOpenBrace happy_var_1) -> +	case happyOut38 happy_x_2 of { happy_var_2 -> +	case happyOutTok happy_x_3 of { (TokSymbol SymCloseBrace happy_var_3) -> +	happyIn37+		 (TypedBindings (fuseRange happy_var_1 happy_var_3) Hidden    happy_var_2+	)}}}++happyReduce_131 = happySpecReduce_1  32# happyReduction_131+happyReduction_131 happy_x_1+	 =  case happyOut40 happy_x_1 of { happy_var_1 -> +	happyIn38+		 ([happy_var_1]+	)}++happyReduce_132 = happySpecReduce_3  32# happyReduction_132+happyReduction_132 happy_x_3+	happy_x_2+	happy_x_1+	 =  case happyOut40 happy_x_1 of { happy_var_1 -> +	case happyOut39 happy_x_3 of { happy_var_3 -> +	happyIn38+		 (happy_var_1 : happy_var_3+	)}}++happyReduce_133 = happySpecReduce_1  33# happyReduction_133+happyReduction_133 happy_x_1+	 =  case happyOut38 happy_x_1 of { happy_var_1 -> +	happyIn39+		 (happy_var_1+	)}++happyReduce_134 = happySpecReduce_3  33# happyReduction_134+happyReduction_134 happy_x_3+	happy_x_2+	happy_x_1+	 =  case happyOut24 happy_x_1 of { happy_var_1 -> +	case happyOut39 happy_x_3 of { happy_var_3 -> +	happyIn39+		 (TNoBind happy_var_1 : happy_var_3+	)}}++happyReduce_135 = happySpecReduce_1  33# happyReduction_135+happyReduction_135 happy_x_1+	 =  case happyOut24 happy_x_1 of { happy_var_1 -> +	happyIn39+		 ([TNoBind happy_var_1]+	)}++happyReduce_136 = happySpecReduce_3  34# happyReduction_136+happyReduction_136 happy_x_3+	happy_x_2+	happy_x_1+	 =  case happyOut21 happy_x_1 of { happy_var_1 -> +	case happyOut24 happy_x_3 of { happy_var_3 -> +	happyIn40+		 (TBind (fuseRange happy_var_1 happy_var_3) (map mkBoundName_ happy_var_1) happy_var_3+	)}}++happyReduce_137 = happyMonadReduce 2# 35# happyReduction_137+happyReduction_137 (happy_x_2 `HappyStk`+	happy_x_1 `HappyStk`+	happyRest) tk+	 = happyThen (case happyOut43 happy_x_1 of { happy_var_1 -> +	(+      case last happy_var_1 of+        Left _  -> parseError "Absurd lambda cannot have a body."+        _       -> return [ b | Right b <- happy_var_1 ])}+	) (\r -> happyReturn (happyIn41 r))++happyReduce_138 = happyMonadReduce 1# 36# happyReduction_138+happyReduction_138 (happy_x_1 `HappyStk`+	happyRest) tk+	 = happyThen (case happyOut43 happy_x_1 of { happy_var_1 -> +	(+    case last happy_var_1 of+      Right _ -> parseError "Missing body for lambda"+      Left h  -> return ([ b | Right b <- init happy_var_1], h))}+	) (\r -> happyReturn (happyIn42 r))++happyReduce_139 = happySpecReduce_2  37# happyReduction_139+happyReduction_139 happy_x_2+	happy_x_1+	 =  case happyOut45 happy_x_1 of { happy_var_1 -> +	case happyOut43 happy_x_2 of { happy_var_2 -> +	happyIn43+		 (map Right happy_var_1 ++ happy_var_2+	)}}++happyReduce_140 = happySpecReduce_2  37# happyReduction_140+happyReduction_140 happy_x_2+	happy_x_1+	 =  case happyOut37 happy_x_1 of { happy_var_1 -> +	case happyOut43 happy_x_2 of { happy_var_2 -> +	happyIn43+		 (Right (DomainFull happy_var_1) : happy_var_2+	)}}++happyReduce_141 = happySpecReduce_1  37# happyReduction_141+happyReduction_141 happy_x_1+	 =  case happyOut45 happy_x_1 of { happy_var_1 -> +	happyIn43+		 (map Right happy_var_1+	)}++happyReduce_142 = happySpecReduce_1  37# happyReduction_142+happyReduction_142 happy_x_1+	 =  case happyOut37 happy_x_1 of { happy_var_1 -> +	happyIn43+		 ([Right $ DomainFull happy_var_1]+	)}++happyReduce_143 = happySpecReduce_2  37# happyReduction_143+happyReduction_143 happy_x_2+	happy_x_1+	 =  happyIn43+		 ([Left NotHidden]+	)++happyReduce_144 = happySpecReduce_2  37# happyReduction_144+happyReduction_144 happy_x_2+	happy_x_1+	 =  happyIn43+		 ([Left Hidden]+	)++happyReduce_145 = happySpecReduce_2  38# happyReduction_145+happyReduction_145 happy_x_2+	happy_x_1+	 =  case happyOut45 happy_x_1 of { happy_var_1 -> +	case happyOut44 happy_x_2 of { happy_var_2 -> +	happyIn44+		 (happy_var_1 ++ happy_var_2+	)}}++happyReduce_146 = happySpecReduce_2  38# happyReduction_146+happyReduction_146 happy_x_2+	happy_x_1+	 =  case happyOut37 happy_x_1 of { happy_var_1 -> +	case happyOut44 happy_x_2 of { happy_var_2 -> +	happyIn44+		 (DomainFull happy_var_1 : happy_var_2+	)}}++happyReduce_147 = happySpecReduce_0  38# happyReduction_147+happyReduction_147  =  happyIn44+		 ([]+	)++happyReduce_148 = happySpecReduce_1  39# happyReduction_148+happyReduction_148 happy_x_1+	 =  case happyOut19 happy_x_1 of { happy_var_1 -> +	happyIn45+		 ([DomainFree NotHidden $ mkBoundName_ happy_var_1]+	)}++happyReduce_149 = happySpecReduce_3  39# happyReduction_149+happyReduction_149 happy_x_3+	happy_x_2+	happy_x_1+	 =  case happyOut21 happy_x_2 of { happy_var_2 -> +	happyIn45+		 (map (DomainFree Hidden . mkBoundName_) happy_var_2+	)}++happyReduce_150 = happySpecReduce_1  40# happyReduction_150+happyReduction_150 happy_x_1+	 =  case happyOut47 happy_x_1 of { happy_var_1 -> +	happyIn46+		 ((Nothing, happy_var_1)+	)}++happyReduce_151 = happyMonadReduce 3# 40# happyReduction_151+happyReduction_151 (happy_x_3 `HappyStk`+	happy_x_2 `HappyStk`+	happy_x_1 `HappyStk`+	happyRest) tk+	 = happyThen (case happyOutTok happy_x_1 of { (TokId happy_var_1) -> +	case happyOut16 happy_x_2 of { happy_var_2 -> +	case happyOut47 happy_x_3 of { happy_var_3 -> +	( isName "as" happy_var_1 >> return (Just happy_var_2, happy_var_3))}}}+	) (\r -> happyReturn (happyIn46 r))++happyReduce_152 = happyMonadReduce 1# 41# happyReduction_152+happyReduction_152 (happy_x_1 `HappyStk`+	happyRest) tk+	 = happyThen (case happyOut48 happy_x_1 of { happy_var_1 -> +	( verifyImportDirective happy_var_1)}+	) (\r -> happyReturn (happyIn47 r))++happyReduce_153 = happySpecReduce_2  42# happyReduction_153+happyReduction_153 happy_x_2+	happy_x_1+	 =  case happyOut49 happy_x_2 of { happy_var_2 -> +	happyIn48+		 (happy_var_2 { publicOpen = True }+	)}++happyReduce_154 = happySpecReduce_1  42# happyReduction_154+happyReduction_154 happy_x_1+	 =  case happyOut49 happy_x_1 of { happy_var_1 -> +	happyIn48+		 (happy_var_1+	)}++happyReduce_155 = happySpecReduce_2  43# happyReduction_155+happyReduction_155 happy_x_2+	happy_x_1+	 =  case happyOut50 happy_x_1 of { happy_var_1 -> +	case happyOut51 happy_x_2 of { happy_var_2 -> +	happyIn49+		 (ImportDirective (fuseRange happy_var_1 happy_var_2) happy_var_1 happy_var_2 False+	)}}++happyReduce_156 = happySpecReduce_1  43# happyReduction_156+happyReduction_156 happy_x_1+	 =  case happyOut51 happy_x_1 of { happy_var_1 -> +	happyIn49+		 (ImportDirective (getRange happy_var_1) (Hiding []) happy_var_1 False+	)}++happyReduce_157 = happySpecReduce_1  43# happyReduction_157+happyReduction_157 happy_x_1+	 =  case happyOut50 happy_x_1 of { happy_var_1 -> +	happyIn49+		 (ImportDirective (getRange happy_var_1) happy_var_1 [] False+	)}++happyReduce_158 = happySpecReduce_0  43# happyReduction_158+happyReduction_158  =  happyIn49+		 (ImportDirective noRange (Hiding []) [] False+	)++happyReduce_159 = happyReduce 4# 44# happyReduction_159+happyReduction_159 (happy_x_4 `HappyStk`+	happy_x_3 `HappyStk`+	happy_x_2 `HappyStk`+	happy_x_1 `HappyStk`+	happyRest)+	 = case happyOut56 happy_x_3 of { happy_var_3 -> +	happyIn50+		 (Using happy_var_3+	) `HappyStk` happyRest}++happyReduce_160 = happyReduce 4# 44# happyReduction_160+happyReduction_160 (happy_x_4 `HappyStk`+	happy_x_3 `HappyStk`+	happy_x_2 `HappyStk`+	happy_x_1 `HappyStk`+	happyRest)+	 = case happyOut57 happy_x_3 of { happy_var_3 -> +	happyIn50+		 (Hiding happy_var_3+	) `HappyStk` happyRest}++happyReduce_161 = happyReduce 4# 45# happyReduction_161+happyReduction_161 (happy_x_4 `HappyStk`+	happy_x_3 `HappyStk`+	happy_x_2 `HappyStk`+	happy_x_1 `HappyStk`+	happyRest)+	 = case happyOut52 happy_x_3 of { happy_var_3 -> +	happyIn51+		 (happy_var_3+	) `HappyStk` happyRest}++happyReduce_162 = happySpecReduce_3  46# happyReduction_162+happyReduction_162 happy_x_3+	happy_x_2+	happy_x_1+	 =  case happyOut53 happy_x_1 of { happy_var_1 -> +	case happyOut52 happy_x_3 of { happy_var_3 -> +	happyIn52+		 (happy_var_1 : happy_var_3+	)}}++happyReduce_163 = happySpecReduce_1  46# happyReduction_163+happyReduction_163 happy_x_1+	 =  case happyOut53 happy_x_1 of { happy_var_1 -> +	happyIn52+		 ([happy_var_1]+	)}++happyReduce_164 = happySpecReduce_3  47# happyReduction_164+happyReduction_164 happy_x_3+	happy_x_2+	happy_x_1+	 =  case happyOut54 happy_x_1 of { happy_var_1 -> +	case happyOut16 happy_x_3 of { happy_var_3 -> +	happyIn53+		 ((happy_var_1,happy_var_3)+	)}}++happyReduce_165 = happySpecReduce_2  48# happyReduction_165+happyReduction_165 happy_x_2+	happy_x_1+	 =  case happyOut16 happy_x_2 of { happy_var_2 -> +	happyIn54+		 (ImportedName happy_var_2+	)}++happyReduce_166 = happySpecReduce_3  48# happyReduction_166+happyReduction_166 happy_x_3+	happy_x_2+	happy_x_1+	 =  case happyOut16 happy_x_3 of { happy_var_3 -> +	happyIn54+		 (ImportedModule happy_var_3+	)}++happyReduce_167 = happySpecReduce_1  49# happyReduction_167+happyReduction_167 happy_x_1+	 =  case happyOut16 happy_x_1 of { happy_var_1 -> +	happyIn55+		 (ImportedName happy_var_1+	)}++happyReduce_168 = happySpecReduce_2  49# happyReduction_168+happyReduction_168 happy_x_2+	happy_x_1+	 =  case happyOut16 happy_x_2 of { happy_var_2 -> +	happyIn55+		 (ImportedModule happy_var_2+	)}++happyReduce_169 = happySpecReduce_0  50# happyReduction_169+happyReduction_169  =  happyIn56+		 ([]+	)++happyReduce_170 = happySpecReduce_1  50# happyReduction_170+happyReduction_170 happy_x_1+	 =  case happyOut57 happy_x_1 of { happy_var_1 -> +	happyIn56+		 (happy_var_1+	)}++happyReduce_171 = happySpecReduce_1  51# happyReduction_171+happyReduction_171 happy_x_1+	 =  case happyOut55 happy_x_1 of { happy_var_1 -> +	happyIn57+		 ([happy_var_1]+	)}++happyReduce_172 = happySpecReduce_3  51# happyReduction_172+happyReduction_172 happy_x_3+	happy_x_2+	happy_x_1+	 =  case happyOut55 happy_x_1 of { happy_var_1 -> +	case happyOut57 happy_x_3 of { happy_var_3 -> +	happyIn57+		 (happy_var_1 : happy_var_3+	)}}++happyReduce_173 = happyMonadReduce 2# 52# happyReduction_173+happyReduction_173 (happy_x_2 `HappyStk`+	happy_x_1 `HappyStk`+	happyRest) tk+	 = happyThen (case happyOut25 happy_x_1 of { happy_var_1 -> +	case happyOut60 happy_x_2 of { happy_var_2 -> +	( exprToLHS happy_var_1 >>= \p -> return (p happy_var_2))}}+	) (\r -> happyReturn (happyIn58 r))++happyReduce_174 = happySpecReduce_3  52# happyReduction_174+happyReduction_174 happy_x_3+	happy_x_2+	happy_x_1+	 =  case happyOutTok happy_x_1 of { (TokSymbol SymEllipsis happy_var_1) -> +	case happyOut59 happy_x_2 of { happy_var_2 -> +	case happyOut60 happy_x_3 of { happy_var_3 -> +	happyIn58+		 (Ellipsis (fuseRange happy_var_1 happy_var_3) happy_var_2 happy_var_3+	)}}}++happyReduce_175 = happySpecReduce_0  53# happyReduction_175+happyReduction_175  =  happyIn59+		 ([]+	)++happyReduce_176 = happyMonadReduce 3# 53# happyReduction_176+happyReduction_176 (happy_x_3 `HappyStk`+	happy_x_2 `HappyStk`+	happy_x_1 `HappyStk`+	happyRest) tk+	 = happyThen (case happyOut29 happy_x_2 of { happy_var_2 -> +	case happyOut59 happy_x_3 of { happy_var_3 -> +	( exprToPattern (RawApp (getRange happy_var_2) happy_var_2) >>= \p ->+		   return (p : happy_var_3))}}+	) (\r -> happyReturn (happyIn59 r))++happyReduce_177 = happySpecReduce_0  54# happyReduction_177+happyReduction_177  =  happyIn60+		 ([]+	)++happyReduce_178 = happySpecReduce_2  54# happyReduction_178+happyReduction_178 happy_x_2+	happy_x_1+	 =  case happyOut24 happy_x_2 of { happy_var_2 -> +	happyIn60+		 (case happy_var_2 of { WithApp _ e es -> e : es; e -> [e] }+	)}++happyReduce_179 = happySpecReduce_0  55# happyReduction_179+happyReduction_179  =  happyIn61+		 (NoWhere+	)++happyReduce_180 = happySpecReduce_2  55# happyReduction_180+happyReduction_180 happy_x_2+	happy_x_1+	 =  case happyOut95 happy_x_2 of { happy_var_2 -> +	happyIn61+		 (AnyWhere happy_var_2+	)}++happyReduce_181 = happyReduce 4# 55# happyReduction_181+happyReduction_181 (happy_x_4 `HappyStk`+	happy_x_3 `HappyStk`+	happy_x_2 `HappyStk`+	happy_x_1 `HappyStk`+	happyRest)+	 = case happyOut16 happy_x_2 of { happy_var_2 -> +	case happyOut95 happy_x_4 of { happy_var_4 -> +	happyIn61+		 (SomeWhere happy_var_2 happy_var_4+	) `HappyStk` happyRest}}++happyReduce_182 = happySpecReduce_1  56# happyReduction_182+happyReduction_182 happy_x_1+	 =  case happyOut63 happy_x_1 of { happy_var_1 -> +	happyIn62+		 ([happy_var_1]+	)}++happyReduce_183 = happySpecReduce_1  56# happyReduction_183+happyReduction_183 happy_x_1+	 =  case happyOut69 happy_x_1 of { happy_var_1 -> +	happyIn62+		 (happy_var_1+	)}++happyReduce_184 = happySpecReduce_1  56# happyReduction_184+happyReduction_184 happy_x_1+	 =  case happyOut64 happy_x_1 of { happy_var_1 -> +	happyIn62+		 ([happy_var_1]+	)}++happyReduce_185 = happySpecReduce_1  56# happyReduction_185+happyReduction_185 happy_x_1+	 =  case happyOut66 happy_x_1 of { happy_var_1 -> +	happyIn62+		 ([happy_var_1]+	)}++happyReduce_186 = happySpecReduce_1  56# happyReduction_186+happyReduction_186 happy_x_1+	 =  case happyOut67 happy_x_1 of { happy_var_1 -> +	happyIn62+		 ([happy_var_1]+	)}++happyReduce_187 = happySpecReduce_1  56# happyReduction_187+happyReduction_187 happy_x_1+	 =  case happyOut68 happy_x_1 of { happy_var_1 -> +	happyIn62+		 ([happy_var_1]+	)}++happyReduce_188 = happySpecReduce_1  56# happyReduction_188+happyReduction_188 happy_x_1+	 =  case happyOut70 happy_x_1 of { happy_var_1 -> +	happyIn62+		 ([happy_var_1]+	)}++happyReduce_189 = happySpecReduce_1  56# happyReduction_189+happyReduction_189 happy_x_1+	 =  case happyOut71 happy_x_1 of { happy_var_1 -> +	happyIn62+		 ([happy_var_1]+	)}++happyReduce_190 = happySpecReduce_1  56# happyReduction_190+happyReduction_190 happy_x_1+	 =  case happyOut72 happy_x_1 of { happy_var_1 -> +	happyIn62+		 ([happy_var_1]+	)}++happyReduce_191 = happySpecReduce_1  56# happyReduction_191+happyReduction_191 happy_x_1+	 =  case happyOut73 happy_x_1 of { happy_var_1 -> +	happyIn62+		 ([happy_var_1]+	)}++happyReduce_192 = happySpecReduce_1  56# happyReduction_192+happyReduction_192 happy_x_1+	 =  case happyOut74 happy_x_1 of { happy_var_1 -> +	happyIn62+		 ([happy_var_1]+	)}++happyReduce_193 = happySpecReduce_1  56# happyReduction_193+happyReduction_193 happy_x_1+	 =  case happyOut75 happy_x_1 of { happy_var_1 -> +	happyIn62+		 ([happy_var_1]+	)}++happyReduce_194 = happySpecReduce_1  56# happyReduction_194+happyReduction_194 happy_x_1+	 =  case happyOut78 happy_x_1 of { happy_var_1 -> +	happyIn62+		 ([happy_var_1]+	)}++happyReduce_195 = happySpecReduce_1  56# happyReduction_195+happyReduction_195 happy_x_1+	 =  case happyOut77 happy_x_1 of { happy_var_1 -> +	happyIn62+		 ([happy_var_1]+	)}++happyReduce_196 = happySpecReduce_1  56# happyReduction_196+happyReduction_196 happy_x_1+	 =  case happyOut79 happy_x_1 of { happy_var_1 -> +	happyIn62+		 ([happy_var_1]+	)}++happyReduce_197 = happySpecReduce_1  56# happyReduction_197+happyReduction_197 happy_x_1+	 =  case happyOut82 happy_x_1 of { happy_var_1 -> +	happyIn62+		 ([happy_var_1]+	)}++happyReduce_198 = happySpecReduce_3  57# happyReduction_198+happyReduction_198 happy_x_3+	happy_x_2+	happy_x_1+	 =  case happyOut16 happy_x_1 of { happy_var_1 -> +	case happyOut24 happy_x_3 of { happy_var_3 -> +	happyIn63+		 (TypeSig happy_var_1 happy_var_3+	)}}++happyReduce_199 = happySpecReduce_3  58# happyReduction_199+happyReduction_199 happy_x_3+	happy_x_2+	happy_x_1+	 =  case happyOut58 happy_x_1 of { happy_var_1 -> +	case happyOut65 happy_x_2 of { happy_var_2 -> +	case happyOut61 happy_x_3 of { happy_var_3 -> +	happyIn64+		 (FunClause happy_var_1 happy_var_2 happy_var_3+	)}}}++happyReduce_200 = happySpecReduce_2  59# happyReduction_200+happyReduction_200 happy_x_2+	happy_x_1+	 =  case happyOut24 happy_x_2 of { happy_var_2 -> +	happyIn65+		 (RHS happy_var_2+	)}++happyReduce_201 = happySpecReduce_0  59# happyReduction_201+happyReduction_201  =  happyIn65+		 (AbsurdRHS+	)++happyReduce_202 = happyReduce 7# 60# happyReduction_202+happyReduction_202 (happy_x_7 `HappyStk`+	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 happyOutTok happy_x_1 of { (TokKeyword KwData happy_var_1) -> +	case happyOut16 happy_x_2 of { happy_var_2 -> +	case happyOut44 happy_x_3 of { happy_var_3 -> +	case happyOut24 happy_x_5 of { happy_var_5 -> +	case happyOutTok happy_x_6 of { (TokKeyword KwWhere happy_var_6) -> +	case happyOut94 happy_x_7 of { happy_var_7 -> +	happyIn66+		 (Data (getRange (happy_var_1, happy_var_6, happy_var_7)) Inductive happy_var_2 (map addType happy_var_3) happy_var_5 happy_var_7+	) `HappyStk` happyRest}}}}}}++happyReduce_203 = happyReduce 7# 60# happyReduction_203+happyReduction_203 (happy_x_7 `HappyStk`+	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 happyOutTok happy_x_1 of { (TokKeyword KwCoData happy_var_1) -> +	case happyOut16 happy_x_2 of { happy_var_2 -> +	case happyOut44 happy_x_3 of { happy_var_3 -> +	case happyOut24 happy_x_5 of { happy_var_5 -> +	case happyOutTok happy_x_6 of { (TokKeyword KwWhere happy_var_6) -> +	case happyOut94 happy_x_7 of { happy_var_7 -> +	happyIn66+		 (Data (getRange (happy_var_1, happy_var_6, happy_var_7)) CoInductive happy_var_2 (map addType happy_var_3) happy_var_5 happy_var_7+	) `HappyStk` happyRest}}}}}}++happyReduce_204 = happyReduce 7# 61# happyReduction_204+happyReduction_204 (happy_x_7 `HappyStk`+	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 happyOutTok happy_x_1 of { (TokKeyword KwRecord happy_var_1) -> +	case happyOut16 happy_x_2 of { happy_var_2 -> +	case happyOut44 happy_x_3 of { happy_var_3 -> +	case happyOut24 happy_x_5 of { happy_var_5 -> +	case happyOutTok happy_x_6 of { (TokKeyword KwWhere happy_var_6) -> +	case happyOut96 happy_x_7 of { happy_var_7 -> +	happyIn67+		 (Record (getRange (happy_var_1, happy_var_6, happy_var_7)) happy_var_2 (map addType happy_var_3) happy_var_5 happy_var_7+	) `HappyStk` happyRest}}}}}}++happyReduce_205 = happySpecReduce_3  62# happyReduction_205+happyReduction_205 happy_x_3+	happy_x_2+	happy_x_1+	 =  case happyOutTok happy_x_1 of { (TokKeyword KwInfix happy_var_1) -> +	case happyOut15 happy_x_2 of { happy_var_2 -> +	case happyOut20 happy_x_3 of { happy_var_3 -> +	happyIn68+		 (Infix (NonAssoc (fuseRange happy_var_1 happy_var_3) happy_var_2) happy_var_3+	)}}}++happyReduce_206 = happySpecReduce_3  62# happyReduction_206+happyReduction_206 happy_x_3+	happy_x_2+	happy_x_1+	 =  case happyOutTok happy_x_1 of { (TokKeyword KwInfixL happy_var_1) -> +	case happyOut15 happy_x_2 of { happy_var_2 -> +	case happyOut20 happy_x_3 of { happy_var_3 -> +	happyIn68+		 (Infix (LeftAssoc (fuseRange happy_var_1 happy_var_3) happy_var_2) happy_var_3+	)}}}++happyReduce_207 = happySpecReduce_3  62# happyReduction_207+happyReduction_207 happy_x_3+	happy_x_2+	happy_x_1+	 =  case happyOutTok happy_x_1 of { (TokKeyword KwInfixR happy_var_1) -> +	case happyOut15 happy_x_2 of { happy_var_2 -> +	case happyOut20 happy_x_3 of { happy_var_3 -> +	happyIn68+		 (Infix (RightAssoc (fuseRange happy_var_1 happy_var_3) happy_var_2) happy_var_3+	)}}}++happyReduce_208 = happySpecReduce_2  63# happyReduction_208+happyReduction_208 happy_x_2+	happy_x_1+	 =  case happyOut92 happy_x_2 of { happy_var_2 -> +	happyIn69+		 (let toField (TypeSig x t) = Field x t in map toField happy_var_2+	)}++happyReduce_209 = happySpecReduce_2  64# happyReduction_209+happyReduction_209 happy_x_2+	happy_x_1+	 =  case happyOutTok happy_x_1 of { (TokKeyword KwMutual happy_var_1) -> +	case happyOut95 happy_x_2 of { happy_var_2 -> +	happyIn70+		 (Mutual (fuseRange happy_var_1 happy_var_2) happy_var_2+	)}}++happyReduce_210 = happySpecReduce_2  65# happyReduction_210+happyReduction_210 happy_x_2+	happy_x_1+	 =  case happyOutTok happy_x_1 of { (TokKeyword KwAbstract happy_var_1) -> +	case happyOut95 happy_x_2 of { happy_var_2 -> +	happyIn71+		 (Abstract (fuseRange happy_var_1 happy_var_2) happy_var_2+	)}}++happyReduce_211 = happySpecReduce_2  66# happyReduction_211+happyReduction_211 happy_x_2+	happy_x_1+	 =  case happyOutTok happy_x_1 of { (TokKeyword KwPrivate happy_var_1) -> +	case happyOut95 happy_x_2 of { happy_var_2 -> +	happyIn72+		 (Private (fuseRange happy_var_1 happy_var_2) happy_var_2+	)}}++happyReduce_212 = happySpecReduce_2  67# happyReduction_212+happyReduction_212 happy_x_2+	happy_x_1+	 =  case happyOutTok happy_x_1 of { (TokKeyword KwPostulate happy_var_1) -> +	case happyOut92 happy_x_2 of { happy_var_2 -> +	happyIn73+		 (Postulate (fuseRange happy_var_1 happy_var_2) happy_var_2+	)}}++happyReduce_213 = happySpecReduce_2  68# happyReduction_213+happyReduction_213 happy_x_2+	happy_x_1+	 =  case happyOutTok happy_x_1 of { (TokKeyword KwPrimitive happy_var_1) -> +	case happyOut92 happy_x_2 of { happy_var_2 -> +	happyIn74+		 (Primitive (fuseRange happy_var_1 happy_var_2) happy_var_2+	)}}++happyReduce_214 = happyReduce 4# 69# happyReduction_214+happyReduction_214 (happy_x_4 `HappyStk`+	happy_x_3 `HappyStk`+	happy_x_2 `HappyStk`+	happy_x_1 `HappyStk`+	happyRest)+	 = case happyOutTok happy_x_1 of { (TokKeyword KwOpen happy_var_1) -> +	case happyOut18 happy_x_2 of { happy_var_2 -> +	case happyOut76 happy_x_3 of { happy_var_3 -> +	case happyOut47 happy_x_4 of { happy_var_4 -> +	happyIn75+		 (let+    { m   = happy_var_2+    ; es  = happy_var_3+    ; dir = happy_var_4+    ; r   = getRange (happy_var_1, m, dir)+    } in+    case es of+    { []  -> Open r m dir+    ; _   -> Private r [ ModuleMacro r (noName $ beginningOf $ getRange happy_var_2) []+                           (RawApp (fuseRange m es) (Ident m : es)) DoOpen dir+                       ]+    }+	) `HappyStk` happyRest}}}}++happyReduce_215 = happySpecReduce_0  70# happyReduction_215+happyReduction_215  =  happyIn76+		 ([]+	)++happyReduce_216 = happySpecReduce_2  70# happyReduction_216+happyReduction_216 happy_x_2+	happy_x_1+	 =  case happyOut30 happy_x_1 of { happy_var_1 -> +	case happyOut76 happy_x_2 of { happy_var_2 -> +	happyIn76+		 (happy_var_1 : happy_var_2+	)}}++happyReduce_217 = happyReduce 6# 71# happyReduction_217+happyReduction_217 (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 happyOutTok happy_x_1 of { (TokKeyword KwModule happy_var_1) -> +	case happyOut16 happy_x_2 of { happy_var_2 -> +	case happyOut44 happy_x_3 of { happy_var_3 -> +	case happyOut24 happy_x_5 of { happy_var_5 -> +	case happyOut47 happy_x_6 of { happy_var_6 -> +	happyIn77+		 (ModuleMacro (getRange (happy_var_1, happy_var_5, happy_var_6)) happy_var_2 (map addType happy_var_3) happy_var_5 DontOpen happy_var_6+	) `HappyStk` happyRest}}}}}++happyReduce_218 = happyReduce 7# 71# happyReduction_218+happyReduction_218 (happy_x_7 `HappyStk`+	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 happyOutTok happy_x_1 of { (TokKeyword KwOpen happy_var_1) -> +	case happyOut16 happy_x_3 of { happy_var_3 -> +	case happyOut44 happy_x_4 of { happy_var_4 -> +	case happyOut24 happy_x_6 of { happy_var_6 -> +	case happyOut47 happy_x_7 of { happy_var_7 -> +	happyIn77+		 (ModuleMacro (getRange (happy_var_1, happy_var_6, happy_var_7)) happy_var_3 (map addType happy_var_4) happy_var_6 DoOpen happy_var_7+	) `HappyStk` happyRest}}}}}++happyReduce_219 = happySpecReduce_3  72# happyReduction_219+happyReduction_219 happy_x_3+	happy_x_2+	happy_x_1+	 =  case happyOutTok happy_x_1 of { (TokKeyword KwImport happy_var_1) -> +	case happyOut18 happy_x_2 of { happy_var_2 -> +	case happyOut46 happy_x_3 of { happy_var_3 -> +	happyIn78+		 (Import (getRange (happy_var_1,happy_var_2,snd happy_var_3)) happy_var_2 (fst happy_var_3) DontOpen (snd happy_var_3)+	)}}}++happyReduce_220 = happyReduce 4# 72# happyReduction_220+happyReduction_220 (happy_x_4 `HappyStk`+	happy_x_3 `HappyStk`+	happy_x_2 `HappyStk`+	happy_x_1 `HappyStk`+	happyRest)+	 = case happyOutTok happy_x_1 of { (TokKeyword KwOpen happy_var_1) -> +	case happyOut18 happy_x_3 of { happy_var_3 -> +	case happyOut46 happy_x_4 of { happy_var_4 -> +	happyIn78+		 (Import (getRange (happy_var_1,happy_var_3,snd happy_var_4)) happy_var_3 (fst happy_var_4) DoOpen (snd happy_var_4)+	) `HappyStk` happyRest}}}++happyReduce_221 = happyReduce 5# 73# happyReduction_221+happyReduction_221 (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 happyOut16 happy_x_2 of { happy_var_2 -> +	case happyOut44 happy_x_3 of { happy_var_3 -> +	case happyOutTok happy_x_4 of { (TokKeyword KwWhere happy_var_4) -> +	case happyOut96 happy_x_5 of { happy_var_5 -> +	happyIn79+		 (Module (getRange (happy_var_1,happy_var_4,happy_var_5)) (QName happy_var_2) (map addType happy_var_3) happy_var_5+	) `HappyStk` happyRest}}}}}++happyReduce_222 = happySpecReduce_2  74# happyReduction_222+happyReduction_222 happy_x_2+	happy_x_1+	 =  case happyOut81 happy_x_2 of { happy_var_2 -> +	happyIn80+		 ([happy_var_2]+	)}++happyReduce_223 = happySpecReduce_3  74# happyReduction_223+happyReduction_223 happy_x_3+	happy_x_2+	happy_x_1+	 =  case happyOut78 happy_x_2 of { happy_var_2 -> +	case happyOut80 happy_x_3 of { happy_var_3 -> +	happyIn80+		 (happy_var_2 : happy_var_3+	)}}++happyReduce_224 = happySpecReduce_3  74# happyReduction_224+happyReduction_224 happy_x_3+	happy_x_2+	happy_x_1+	 =  case happyOut75 happy_x_2 of { happy_var_2 -> +	case happyOut80 happy_x_3 of { happy_var_3 -> +	happyIn80+		 (happy_var_2 : happy_var_3+	)}}++happyReduce_225 = happyReduce 5# 75# happyReduction_225+happyReduction_225 (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 happyOut18 happy_x_2 of { happy_var_2 -> +	case happyOut44 happy_x_3 of { happy_var_3 -> +	case happyOutTok happy_x_4 of { (TokKeyword KwWhere happy_var_4) -> +	case happyOut96 happy_x_5 of { happy_var_5 -> +	happyIn81+		 (Module (getRange (happy_var_1,happy_var_4,happy_var_5)) happy_var_2 (map addType happy_var_3) happy_var_5+	) `HappyStk` happyRest}}}}}++happyReduce_226 = happySpecReduce_1  76# happyReduction_226+happyReduction_226 happy_x_1+	 =  case happyOut84 happy_x_1 of { happy_var_1 -> +	happyIn82+		 (Pragma happy_var_1+	)}++happyReduce_227 = happySpecReduce_1  77# happyReduction_227+happyReduction_227 happy_x_1+	 =  case happyOut85 happy_x_1 of { happy_var_1 -> +	happyIn83+		 (happy_var_1+	)}++happyReduce_228 = happySpecReduce_1  77# happyReduction_228+happyReduction_228 happy_x_1+	 =  case happyOut91 happy_x_1 of { happy_var_1 -> +	happyIn83+		 (happy_var_1+	)}++happyReduce_229 = happySpecReduce_1  78# happyReduction_229+happyReduction_229 happy_x_1+	 =  case happyOut86 happy_x_1 of { happy_var_1 -> +	happyIn84+		 (happy_var_1+	)}++happyReduce_230 = happySpecReduce_1  78# happyReduction_230+happyReduction_230 happy_x_1+	 =  case happyOut91 happy_x_1 of { happy_var_1 -> +	happyIn84+		 (happy_var_1+	)}++happyReduce_231 = happySpecReduce_1  78# happyReduction_231+happyReduction_231 happy_x_1+	 =  case happyOut87 happy_x_1 of { happy_var_1 -> +	happyIn84+		 (happy_var_1+	)}++happyReduce_232 = happySpecReduce_1  78# happyReduction_232+happyReduction_232 happy_x_1+	 =  case happyOut89 happy_x_1 of { happy_var_1 -> +	happyIn84+		 (happy_var_1+	)}++happyReduce_233 = happySpecReduce_1  78# happyReduction_233+happyReduction_233 happy_x_1+	 =  case happyOut88 happy_x_1 of { happy_var_1 -> +	happyIn84+		 (happy_var_1+	)}++happyReduce_234 = happySpecReduce_1  78# happyReduction_234+happyReduction_234 happy_x_1+	 =  case happyOut90 happy_x_1 of { happy_var_1 -> +	happyIn84+		 (happy_var_1+	)}++happyReduce_235 = happyReduce 4# 79# happyReduction_235+happyReduction_235 (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 happyOut22 happy_x_3 of { happy_var_3 -> +	case happyOutTok happy_x_4 of { (TokSymbol SymClosePragma happy_var_4) -> +	happyIn85+		 (OptionsPragma (fuseRange happy_var_1 happy_var_4) happy_var_3+	) `HappyStk` happyRest}}}++happyReduce_236 = happyReduce 5# 80# happyReduction_236+happyReduction_236 (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_3 of { (TokString happy_var_3) -> +	case happyOut23 happy_x_4 of { happy_var_4 -> +	case happyOutTok happy_x_5 of { (TokSymbol SymClosePragma happy_var_5) -> +	happyIn86+		 (BuiltinPragma (fuseRange happy_var_1 happy_var_5) (snd happy_var_3) (Ident happy_var_4)+	) `HappyStk` happyRest}}}}++happyReduce_237 = happyReduce 5# 81# happyReduction_237+happyReduction_237 (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 happyOut23 happy_x_3 of { happy_var_3 -> +	case happyOut22 happy_x_4 of { happy_var_4 -> +	case happyOutTok happy_x_5 of { (TokSymbol SymClosePragma happy_var_5) -> +	happyIn87+		 (CompiledPragma (fuseRange happy_var_1 happy_var_5) happy_var_3 (unwords happy_var_4)+	) `HappyStk` happyRest}}}}++happyReduce_238 = happyReduce 5# 82# happyReduction_238+happyReduction_238 (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 happyOut23 happy_x_3 of { happy_var_3 -> +	case happyOut22 happy_x_4 of { happy_var_4 -> +	case happyOutTok happy_x_5 of { (TokSymbol SymClosePragma happy_var_5) -> +	happyIn88+		 (CompiledTypePragma (fuseRange happy_var_1 happy_var_5) happy_var_3 (unwords happy_var_4)+	) `HappyStk` happyRest}}}}++happyReduce_239 = happyReduce 6# 83# happyReduction_239+happyReduction_239 (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 happyOutTok happy_x_1 of { (TokSymbol SymOpenPragma happy_var_1) -> +	case happyOut23 happy_x_3 of { happy_var_3 -> +	case happyOutTok happy_x_4 of { (TokString happy_var_4) -> +	case happyOut22 happy_x_5 of { happy_var_5 -> +	case happyOutTok happy_x_6 of { (TokSymbol SymClosePragma happy_var_6) -> +	happyIn89+		 (CompiledDataPragma (fuseRange happy_var_1 happy_var_6) happy_var_3 (snd happy_var_4) happy_var_5+	) `HappyStk` happyRest}}}}}++happyReduce_240 = happyReduce 4# 84# happyReduction_240+happyReduction_240 (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 happyOut22 happy_x_3 of { happy_var_3 -> +	case happyOutTok happy_x_4 of { (TokSymbol SymClosePragma happy_var_4) -> +	happyIn90+		 (ImportPragma (fuseRange happy_var_1 happy_var_4) (unwords happy_var_3)+	) `HappyStk` happyRest}}}++happyReduce_241 = happyMonadReduce 5# 85# happyReduction_241+happyReduction_241 (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 { (TokSymbol SymOpenPragma happy_var_1) -> +	case happyOutTok happy_x_3 of { (TokString happy_var_3) -> +	case happyOutTok happy_x_4 of { (TokString happy_var_4) -> +	case happyOutTok happy_x_5 of { (TokSymbol SymClosePragma happy_var_5) -> +	( do+      let r = fuseRange happy_var_1 happy_var_5+	  parseFile (i, f)+	    | head f == '"' && last f == '"'  = return $ init (tail f)+	    | otherwise	= parseErrorAt (iStart i) $ "Expected \"filename\", found " ++ f+	  parseLine (i, l)+	    | all isDigit l = return $ read l+	    | otherwise	    = parseErrorAt (iStart i) $ "Expected line number, found " ++ l+      line <- parseLine happy_var_3+      file <- parseFile happy_var_4+      currentPos <- fmap parsePos get+      setParsePos $ Pn+	{ srcFile = file+	, posPos  = posPos currentPos+	, posLine = line+	, posCol  = 1+	}+      return $ LinePragma r line file)}}}}+	) (\r -> happyReturn (happyIn91 r))++happyReduce_242 = happyReduce 5# 86# happyReduction_242+happyReduction_242 (happy_x_5 `HappyStk`+	happy_x_4 `HappyStk`+	happy_x_3 `HappyStk`+	happy_x_2 `HappyStk`+	happy_x_1 `HappyStk`+	happyRest)+	 = case happyOut93 happy_x_3 of { happy_var_3 -> +	happyIn92+		 (reverse happy_var_3+	) `HappyStk` happyRest}++happyReduce_243 = happyReduce 4# 87# happyReduction_243+happyReduction_243 (happy_x_4 `HappyStk`+	happy_x_3 `HappyStk`+	happy_x_2 `HappyStk`+	happy_x_1 `HappyStk`+	happyRest)+	 = case happyOut93 happy_x_1 of { happy_var_1 -> +	case happyOut63 happy_x_4 of { happy_var_4 -> +	happyIn93+		 (happy_var_4 : happy_var_1+	) `HappyStk` happyRest}}++happyReduce_244 = happySpecReduce_2  87# happyReduction_244+happyReduction_244 happy_x_2+	happy_x_1+	 =  case happyOut63 happy_x_2 of { happy_var_2 -> +	happyIn93+		 ([happy_var_2]+	)}++happyReduce_245 = happySpecReduce_1  88# happyReduction_245+happyReduction_245 happy_x_1+	 =  case happyOut92 happy_x_1 of { happy_var_1 -> +	happyIn94+		 (happy_var_1+	)}++happyReduce_246 = happyReduce 4# 88# happyReduction_246+happyReduction_246 (happy_x_4 `HappyStk`+	happy_x_3 `HappyStk`+	happy_x_2 `HappyStk`+	happy_x_1 `HappyStk`+	happyRest)+	 = happyIn94+		 ([]+	) `HappyStk` happyRest++happyReduce_247 = happyReduce 5# 89# happyReduction_247+happyReduction_247 (happy_x_5 `HappyStk`+	happy_x_4 `HappyStk`+	happy_x_3 `HappyStk`+	happy_x_2 `HappyStk`+	happy_x_1 `HappyStk`+	happyRest)+	 = case happyOut97 happy_x_3 of { happy_var_3 -> +	happyIn95+		 (reverse happy_var_3+	) `HappyStk` happyRest}++happyReduce_248 = happyReduce 4# 90# happyReduction_248+happyReduction_248 (happy_x_4 `HappyStk`+	happy_x_3 `HappyStk`+	happy_x_2 `HappyStk`+	happy_x_1 `HappyStk`+	happyRest)+	 = happyIn96+		 ([]+	) `HappyStk` happyRest++happyReduce_249 = happySpecReduce_1  90# happyReduction_249+happyReduction_249 happy_x_1+	 =  case happyOut95 happy_x_1 of { happy_var_1 -> +	happyIn96+		 (happy_var_1+	)}++happyReduce_250 = happyReduce 4# 91# happyReduction_250+happyReduction_250 (happy_x_4 `HappyStk`+	happy_x_3 `HappyStk`+	happy_x_2 `HappyStk`+	happy_x_1 `HappyStk`+	happyRest)+	 = case happyOut97 happy_x_1 of { happy_var_1 -> +	case happyOut62 happy_x_4 of { happy_var_4 -> +	happyIn97+		 (reverse happy_var_4 ++ happy_var_1+	) `HappyStk` happyRest}}++happyReduce_251 = happySpecReduce_2  91# happyReduction_251+happyReduction_251 happy_x_2+	happy_x_1+	 =  case happyOut62 happy_x_2 of { happy_var_2 -> +	happyIn97+		 (reverse happy_var_2+	)}++happyNewToken action sts stk+	= lexer(\tk -> +	let cont i = happyDoAction i tk action sts stk in+	case tk of {+	TokEOF -> happyDoAction 62# 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#;+	TokKeyword KwWith happy_dollar_dollar -> cont 4#;+	TokKeyword KwPostulate happy_dollar_dollar -> cont 5#;+	TokKeyword KwPrimitive happy_dollar_dollar -> cont 6#;+	TokKeyword KwOpen happy_dollar_dollar -> cont 7#;+	TokKeyword KwImport happy_dollar_dollar -> cont 8#;+	TokKeyword KwUsing happy_dollar_dollar -> cont 9#;+	TokKeyword KwHiding happy_dollar_dollar -> cont 10#;+	TokKeyword KwRenaming happy_dollar_dollar -> cont 11#;+	TokKeyword KwTo happy_dollar_dollar -> cont 12#;+	TokKeyword KwPublic happy_dollar_dollar -> cont 13#;+	TokKeyword KwModule happy_dollar_dollar -> cont 14#;+	TokKeyword KwData happy_dollar_dollar -> cont 15#;+	TokKeyword KwCoData happy_dollar_dollar -> cont 16#;+	TokKeyword KwRecord happy_dollar_dollar -> cont 17#;+	TokKeyword KwField happy_dollar_dollar -> cont 18#;+	TokKeyword KwInfix happy_dollar_dollar -> cont 19#;+	TokKeyword KwInfixL happy_dollar_dollar -> cont 20#;+	TokKeyword KwInfixR happy_dollar_dollar -> cont 21#;+	TokKeyword KwMutual happy_dollar_dollar -> cont 22#;+	TokKeyword KwAbstract happy_dollar_dollar -> cont 23#;+	TokKeyword KwPrivate happy_dollar_dollar -> cont 24#;+	TokKeyword KwProp happy_dollar_dollar -> cont 25#;+	TokKeyword KwSet happy_dollar_dollar -> cont 26#;+	TokKeyword KwForall happy_dollar_dollar -> cont 27#;+	TokKeyword KwOPTIONS happy_dollar_dollar -> cont 28#;+	TokKeyword KwBUILTIN happy_dollar_dollar -> cont 29#;+	TokKeyword KwIMPORT happy_dollar_dollar -> cont 30#;+	TokKeyword KwCOMPILED happy_dollar_dollar -> cont 31#;+	TokKeyword KwCOMPILED_DATA happy_dollar_dollar -> cont 32#;+	TokKeyword KwCOMPILED_TYPE happy_dollar_dollar -> cont 33#;+	TokKeyword KwLINE happy_dollar_dollar -> cont 34#;+	TokSetN happy_dollar_dollar -> cont 35#;+	TokTeX happy_dollar_dollar -> cont 36#;+	TokComment happy_dollar_dollar -> cont 37#;+	TokSymbol SymEllipsis happy_dollar_dollar -> cont 38#;+	TokSymbol SymDot happy_dollar_dollar -> cont 39#;+	TokSymbol SymSemi happy_dollar_dollar -> cont 40#;+	TokSymbol SymColon happy_dollar_dollar -> cont 41#;+	TokSymbol SymEqual happy_dollar_dollar -> cont 42#;+	TokSymbol SymUnderscore happy_dollar_dollar -> cont 43#;+	TokSymbol SymQuestionMark happy_dollar_dollar -> cont 44#;+	TokSymbol SymArrow happy_dollar_dollar -> cont 45#;+	TokSymbol SymLambda happy_dollar_dollar -> cont 46#;+	TokSymbol SymAs happy_dollar_dollar -> cont 47#;+	TokSymbol SymBar happy_dollar_dollar -> cont 48#;+	TokSymbol SymOpenParen happy_dollar_dollar -> cont 49#;+	TokSymbol SymCloseParen happy_dollar_dollar -> cont 50#;+	TokSymbol SymOpenBrace happy_dollar_dollar -> cont 51#;+	TokSymbol SymCloseBrace happy_dollar_dollar -> cont 52#;+	TokSymbol SymOpenVirtualBrace happy_dollar_dollar -> cont 53#;+	TokSymbol SymCloseVirtualBrace happy_dollar_dollar -> cont 54#;+	TokSymbol SymVirtualSemi happy_dollar_dollar -> cont 55#;+	TokSymbol SymOpenPragma happy_dollar_dollar -> cont 56#;+	TokSymbol SymClosePragma happy_dollar_dollar -> cont 57#;+	TokId happy_dollar_dollar -> cont 58#;+	TokQId happy_dollar_dollar -> cont 59#;+	TokString happy_dollar_dollar -> cont 60#;+	TokLiteral happy_dollar_dollar -> cont 61#;+	_ -> happyError' tk+	})++happyError_ tk = happyError' tk++happyThen :: () => Parser a -> (a -> Parser b) -> Parser b+happyThen = (>>=)+happyReturn :: () => a -> Parser a+happyReturn = (return)+happyThen1 = happyThen+happyReturn1 :: () => a -> Parser a+happyReturn1 = happyReturn+happyError' :: () => Token -> Parser a+happyError' tk = (\token -> happyError) tk++tokensParser = happySomeParser where+  happySomeParser = happyThen (happyParse 0#) (\x -> happyReturn (happyOut6 x))++exprParser = happySomeParser where+  happySomeParser = happyThen (happyParse 1#) (\x -> happyReturn (happyOut24 x))++moduleParser = happySomeParser where+  happySomeParser = happyThen (happyParse 2#) (\x -> happyReturn (happyOut10 x))++happySeq = happyDontSeq+++{--------------------------------------------------------------------------+    Parsers+ --------------------------------------------------------------------------}++-- | Parse the token stream. Used by the TeX compiler.+tokensParser :: Parser [Token]++-- | Parse an expression. Could be used in interactions.+exprParser :: Parser Expr++-- | Parse a module.+moduleParser :: Parser ([Pragma], [Declaration])+++{--------------------------------------------------------------------------+    Happy stuff+ --------------------------------------------------------------------------}++-- | Required by Happy.+happyError :: Parser a+happyError = parseError "Parse error"+++{--------------------------------------------------------------------------+    Utility functions+ --------------------------------------------------------------------------}++-- | Create a name from a string.++mkName :: (Interval, String) -> Parser Name+mkName (i, s) = do+    let xs = parts s+    mapM_ isValidId xs+    unless (alternating xs) $ fail $ "a name cannot contain two consecutive underscores"+    return $ Name (getRange i) xs+    where+        parts :: String -> [NamePart]+        parts ""        = []+        parts ('_' : s) = Hole : parts s+        parts s         = Id x : parts s'+          where (x, s') = break (== '_') s++	isValidId Hole   = return ()+	isValidId (Id x) = case parse defaultParseFlags [0] (lexer return) x of+	    ParseOk _ (TokId _) -> return ()+	    _			-> fail $ "in the name " ++ s ++ ", the part " ++ x ++ " is not valid"++	-- we know that there aren't two Ids in a row+	alternating (Hole : Hole : _) = False+	alternating (_ : xs)	      = alternating xs+	alternating []		      = True++-- | Create a qualified name from a list of strings+mkQName :: [(Interval, String)] -> Parser QName+mkQName ss = do+    xs <- mapM mkName ss+    return $ foldr Qual (QName $ last xs) (init xs)++-- | Match a particular name.+isName :: String -> (Interval, String) -> Parser ()+isName s (_,s')+    | s == s'	= return ()+    | otherwise	= fail $ "expected " ++ s ++ ", found " ++ s'++-- | Build a forall pi (forall x y z -> ...)+forallPi :: [LamBinding] -> Expr -> Expr+forallPi bs e = Pi (map addType bs) e++-- | Converts lambda bindings to typed bindings.+addType :: LamBinding -> TypedBindings+addType (DomainFull b)	 = b+addType (DomainFree h x) = TypedBindings r h [TBind r [x] $ Underscore r Nothing]+  where r = getRange x++-- | Check that an import directive doesn't contain repeated names+verifyImportDirective :: ImportDirective -> Parser ImportDirective+verifyImportDirective i =+    case filter ((>1) . length)+	 $ group+	 $ sort xs+    of+	[]  -> return i+	yss -> let Just pos = rStart $ getRange $ head $ concat yss in+               parseErrorAt pos $+		"repeated name" ++ s ++ " in import directive: " +++		concat (intersperse ", " $ map (show . head) yss)+	    where+		s = case yss of+			[_] -> ""+			_   -> "s"+    where+	xs = names (usingOrHiding i) ++ map fst (renaming i)+	names (Using xs)    = xs+	names (Hiding xs)   = xs++{--------------------------------------------------------------------------+    Patterns+ --------------------------------------------------------------------------}++-- | Turn an expression into a left hand side.+exprToLHS :: Expr -> Parser ([Expr] -> LHS)+exprToLHS e = case e of+  WithApp r e es -> LHS <$> exprToPattern e <*> mapM exprToPattern es+  _		 -> LHS <$> exprToPattern e <*> return []++-- | Turn an expression into a pattern. Fails if the expression is not a+--   valid pattern.+exprToPattern :: Expr -> Parser Pattern+exprToPattern e =+    case e of+	Ident x			-> return $ IdentP x+	App _ e1 e2		-> AppP <$> exprToPattern e1+					<*> T.mapM (T.mapM exprToPattern) e2+	Paren r e		-> ParenP r+					<$> exprToPattern e+	Underscore r _		-> return $ WildP r+	Absurd r		-> return $ AbsurdP r+	As r x e		-> AsP r x <$> exprToPattern e+	Dot r (HiddenArg _ e)	-> return $ HiddenP r $ fmap (DotP r) e+	Dot r e			-> return $ DotP r e+	Lit l			-> return $ LitP l+	HiddenArg r e		-> HiddenP r <$> T.mapM exprToPattern e+	RawApp r es		-> RawAppP r <$> mapM exprToPattern es+	OpApp r x es		-> OpAppP r x <$> mapM exprToPattern es+	_			->+          let Just pos = rStart $ getRange e in+          parseErrorAt pos $ "Not a valid pattern: " ++ show e+{-# 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 ++{-# LINE 28 "templates/GenericTemplate.hs" #-}+++data Happy_IntList = HappyCons Int# Happy_IntList++++++{-# LINE 49 "templates/GenericTemplate.hs" #-}++{-# LINE 59 "templates/GenericTemplate.hs" #-}++{-# LINE 68 "templates/GenericTemplate.hs" #-}++infixr 9 `HappyStk`+data HappyStk a = HappyStk a (HappyStk a)++-----------------------------------------------------------------------------+-- starting the parse++happyParse start_state = happyNewToken start_state notHappyAtAll notHappyAtAll++-----------------------------------------------------------------------------+-- Accepting the parse++-- If the current token is 0#, it means we've just accepted a partial+-- parse (a %partial parser).  We must ignore the saved token on the top of+-- the stack in this case.+happyAccept 0# tk st sts (_ `HappyStk` ans `HappyStk` _) =+	happyReturn1 ans+happyAccept j tk st sts (HappyStk ans _) = +	(happyTcHack j (happyTcHack st)) (happyReturn1 ans)++-----------------------------------------------------------------------------+-- Arrays only: do the next action++++happyDoAction i tk st+	= {- nothing -}+++	  case action of+		0#		  -> {- nothing -}+				     happyFail i tk st+		-1# 	  -> {- nothing -}+				     happyAccept i tk st+		n | (n <# (0# :: Int#)) -> {- nothing -}++				     (happyReduceArr ! rule) i tk st+				     where rule = (I# ((negateInt# ((n +# (1# :: Int#))))))+		n		  -> {- nothing -}+++				     happyShift new_state i tk st+				     where new_state = (n -# (1# :: Int#))+   where off    = indexShortOffAddr happyActOffsets st+	 off_i  = (off +# i)+	 check  = if (off_i >=# (0# :: Int#))+			then (indexShortOffAddr happyCheck off_i ==#  i)+			else False+ 	 action | check     = indexShortOffAddr happyTable off_i+		| otherwise = indexShortOffAddr happyDefActions st++{-# LINE 127 "templates/GenericTemplate.hs" #-}+++indexShortOffAddr (HappyA# arr) off =+#if __GLASGOW_HASKELL__ > 500+	narrow16Int# i+#elif __GLASGOW_HASKELL__ == 500+	intToInt16# i+#else+	(i `iShiftL#` 16#) `iShiftRA#` 16#+#endif+  where+#if __GLASGOW_HASKELL__ >= 503+	i = word2Int# ((high `uncheckedShiftL#` 8#) `or#` low)+#else+	i = word2Int# ((high `shiftL#` 8#) `or#` low)+#endif+	high = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#)))+	low  = int2Word# (ord# (indexCharOffAddr# arr off'))+	off' = off *# 2#++++++data HappyAddr = HappyA# Addr#+++++-----------------------------------------------------------------------------+-- HappyState data type (not arrays)++{-# LINE 170 "templates/GenericTemplate.hs" #-}++-----------------------------------------------------------------------------+-- Shifting a token++happyShift new_state 0# tk st sts stk@(x `HappyStk` _) =+     let i = (case unsafeCoerce# x of { (I# (i)) -> i }) in+--     trace "shifting the error token" $+     happyDoAction i tk new_state (HappyCons (st) (sts)) (stk)++happyShift new_state i tk st sts stk =+     happyNewToken new_state (HappyCons (st) (sts)) ((happyInTok (tk))`HappyStk`stk)++-- happyReduce is specialised for the common cases.++happySpecReduce_0 i fn 0# tk st sts stk+     = happyFail 0# tk st sts stk+happySpecReduce_0 nt fn j tk st@((action)) sts stk+     = happyGoto nt j tk st (HappyCons (st) (sts)) (fn `HappyStk` stk)++happySpecReduce_1 i fn 0# tk st sts stk+     = happyFail 0# tk st sts stk+happySpecReduce_1 nt fn j tk _ sts@((HappyCons (st@(action)) (_))) (v1`HappyStk`stk')+     = let r = fn v1 in+       happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk'))++happySpecReduce_2 i fn 0# tk st sts stk+     = happyFail 0# tk st sts stk+happySpecReduce_2 nt fn j tk _ (HappyCons (_) (sts@((HappyCons (st@(action)) (_))))) (v1`HappyStk`v2`HappyStk`stk')+     = let r = fn v1 v2 in+       happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk'))++happySpecReduce_3 i fn 0# tk st sts stk+     = happyFail 0# tk st sts stk+happySpecReduce_3 nt fn j tk _ (HappyCons (_) ((HappyCons (_) (sts@((HappyCons (st@(action)) (_))))))) (v1`HappyStk`v2`HappyStk`v3`HappyStk`stk')+     = let r = fn v1 v2 v3 in+       happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk'))++happyReduce k i fn 0# tk st sts stk+     = happyFail 0# tk st sts stk+happyReduce k nt fn j tk st sts stk+     = case happyDrop (k -# (1# :: Int#)) sts of+	 sts1@((HappyCons (st1@(action)) (_))) ->+        	let r = fn stk in  -- it doesn't hurt to always seq here...+       		happyDoSeq r (happyGoto nt j tk st1 sts1 r)++happyMonadReduce k nt fn 0# tk st sts stk+     = happyFail 0# tk st sts stk+happyMonadReduce k nt fn j tk st sts stk =+        happyThen1 (fn stk tk) (\r -> happyGoto nt j tk st1 sts1 (r `HappyStk` drop_stk))+       where sts1@((HappyCons (st1@(action)) (_))) = happyDrop k (HappyCons (st) (sts))+             drop_stk = happyDropStk k stk++happyMonad2Reduce k nt fn 0# tk st sts stk+     = happyFail 0# tk st sts stk+happyMonad2Reduce k nt fn j tk st sts stk =+       happyThen1 (fn stk tk) (\r -> happyNewToken new_state sts1 (r `HappyStk` drop_stk))+       where sts1@((HappyCons (st1@(action)) (_))) = happyDrop k (HappyCons (st) (sts))+             drop_stk = happyDropStk k stk++             off    = indexShortOffAddr happyGotoOffsets st1+             off_i  = (off +# nt)+             new_state = indexShortOffAddr happyTable off_i+++++happyDrop 0# l = l+happyDrop n (HappyCons (_) (t)) = happyDrop (n -# (1# :: Int#)) t++happyDropStk 0# l = l+happyDropStk n (x `HappyStk` xs) = happyDropStk (n -# (1#::Int#)) xs++-----------------------------------------------------------------------------+-- Moving to a new state after a reduction+++happyGoto nt j tk st = +   {- nothing -}+   happyDoAction j tk new_state+   where off    = indexShortOffAddr happyGotoOffsets st+	 off_i  = (off +# nt)+ 	 new_state = indexShortOffAddr happyTable off_i+++++-----------------------------------------------------------------------------+-- Error recovery (0# is the error token)++-- parse error if we are in recovery and we fail again+happyFail  0# tk old_st _ stk =+--	trace "failing" $ +    	happyError_ tk++{-  We don't need state discarding for our restricted implementation of+    "error".  In fact, it can cause some bogus parses, so I've disabled it+    for now --SDM++-- discard a state+happyFail  0# tk old_st (HappyCons ((action)) (sts)) +						(saved_tok `HappyStk` _ `HappyStk` stk) =+--	trace ("discarding state, depth " ++ show (length stk))  $+	happyDoAction 0# tk action sts ((saved_tok`HappyStk`stk))+-}++-- Enter error recovery: generate an error token,+--                       save the old token and carry on.+happyFail  i tk (action) sts stk =+--      trace "entering error recovery" $+	happyDoAction 0# tk action sts ( (unsafeCoerce# (I# (i))) `HappyStk` stk)++-- Internal happy errors:++notHappyAtAll = error "Internal Happy error\n"++-----------------------------------------------------------------------------+-- Hack to get the typechecker to accept our action functions+++happyTcHack :: Int# -> a -> a+happyTcHack x y = y+{-# INLINE happyTcHack #-}+++-----------------------------------------------------------------------------+-- Seq-ing.  If the --strict flag is given, then Happy emits +--	happySeq = happyDoSeq+-- otherwise it emits+-- 	happySeq = happyDontSeq++happyDoSeq, happyDontSeq :: a -> b -> b+happyDoSeq   a b = a `seq` b+happyDontSeq a b = b++-----------------------------------------------------------------------------+-- Don't inline any functions from the template.  GHC has a nasty habit+-- of deciding to inline happyGoto everywhere, which increases the size of+-- the generated parser quite a bit.+++{-# NOINLINE happyDoAction #-}+{-# NOINLINE happyTable #-}+{-# NOINLINE happyCheck #-}+{-# NOINLINE happyActOffsets #-}+{-# NOINLINE happyGotoOffsets #-}+{-# NOINLINE happyDefActions #-}++{-# NOINLINE happyShift #-}+{-# NOINLINE happySpecReduce_0 #-}+{-# NOINLINE happySpecReduce_1 #-}+{-# NOINLINE happySpecReduce_2 #-}+{-# NOINLINE happySpecReduce_3 #-}+{-# NOINLINE happyReduce #-}+{-# NOINLINE happyMonadReduce #-}+{-# NOINLINE happyGoto #-}+{-# NOINLINE happyFail #-}++-- end of Happy Template.

+ src/data/Agda.css view

@@ -0,0 +1,30 @@+/* Aspects. */+.Comment       { color: #B22222 }+.Keyword       { color: #CD6600 }+.String        { color: #B22222 }+.Number        { color: #A020F0 }+.Symbol        { color: #404040 }+.PrimitiveType { color: #0000CD }+.Operator      {}++/* NameKinds. */+.Bound                  { color: black   }+.InductiveConstructor   { color: #008B00 }+.CoinductiveConstructor { color: #8B7500 }+.Datatype               { color: #0000CD }+.Field                  { color: #EE1289 }+.Function               { color: #0000CD }+.Module                 { color: #A020F0 }+.Postulate              { color: #0000CD }+.Primitive              { color: #0000CD }+.Record                 { color: #0000CD }++/* OtherAspects. */+.DottedPattern      {}+.UnsolvedMeta       { color: black; background: yellow         }+.TerminationProblem { color: black; background: #FFA07A        }+.IncompletePattern  { color: black; background: #F5DEB3        }+.Error              { color: red;   text-decoration: underline }++/* Standard attributes. */+a { text-decoration: none }

+ src/full/Agda/Compiler/Agate/Classify.hs view

@@ -0,0 +1,137 @@+{-# LANGUAGE CPP #-}++{-| Classify type familes and constants+    TODO: optimize by getting rid of !'s+-}++module Agda.Compiler.Agate.Classify where++#include "../../undefined.h"+import Agda.Utils.Impossible++import Agda.Compiler.Agate.TranslateName+import Agda.Compiler.Agate.Common++import Agda.TypeChecking.MetaVars+import Agda.TypeChecking.Reduce+import Agda.TypeChecking.Monad++import Agda.Syntax.Common+import Agda.Syntax.Internal+import Agda.Syntax.Abstract.Name++import Data.Map ((!), Map)+import qualified Data.Map as Map++import Control.Monad+import Agda.Utils.Monad++allM :: Monad m => (a -> m Bool) -> [a] -> m Bool+allM f xs = liftM and $ mapM f xs++andM :: Monad m => m Bool -> m Bool -> m Bool+andM x y = ifM x y $ return False++----------------------------------------------------------------++enumTypeFamilies :: Map QName Definition -> TCM [QName]+enumTypeFamilies definitions = fmap concat $ mapM f $ Map.toList definitions+    where+      f (name,d) = do+	--let def = theDef d+	let ty = defType d+	(_,ty2) <- splitType ty+	(El sort term) <- reduce ty2+	case term of+	    Sort _ -> return [name]+	    _      -> return []++enumCompilableTypeFamilies :: Map QName Definition -> TCM [QName]+enumCompilableTypeFamilies definitions = do+    names <- enumTypeFamilies definitions+    computeGreatestFixedPoint f names where+    f :: [QName] -> QName -> TCM Bool+    f names name = do+	let d = definitions ! name+	let def = theDef d+	case def of+	    Axiom{}                                       -> return False -- IO should get True+	    Primitive{}                                   -> return False -- String should get True+	    Function{funClauses = []}                     -> __IMPOSSIBLE__+	    Function{funClauses = [Clause{ clauseBody = NoBody }]}  -> return False+	    Function{funClauses = [Clause{}]}             -> return False -- TODO+	    Function{}                                    -> return False+	    Constructor{}                                 -> return False -- ctor is not a typefam+	    Datatype{dataCons = cnames} -> do+	    	ty <- instantiate $ defType d+	    	andM (isCompilableType ty) $+	    	    allM ( \cname ->+	    	             do let d = definitions ! cname+			    	ty <- instantiate $ defType d+				isCompilableType ty ) cnames+	    Record{} -> return True+	where -- TODO: implement correctly+--	isCompilableType (El s tm) = isCompilableTypeFamily tm+	+	isCompilableType :: Type -> TCM Bool+	isCompilableType (El s tm) = isCompilableTypeFamily tm+	+	isCompilableTypeFamily :: Term -> TCM Bool+	isCompilableTypeFamily tm = do+	    tm <- reduce tm+	    case tm of+		Var n args -> allM (isCompilableTypeFamily . unArg) args+		Sort _     -> return True+		Lam h abs  -> return False -- this can be too strong+		Def c args -> andM (return $ elem c names) $+		    allM (isCompilableTypeFamily . unArg) args+		Pi arg abs -> andM (isCompilableType $ unArg arg) $+		    underAbstraction_ abs isCompilableType+		Fun arg ty -> andM (isCompilableType $ unArg arg) $+		    isCompilableType ty+		Lit lit    -> return False+		Con c args -> return False+		MetaV _ _  -> return __IMPOSSIBLE__++----------------------------------------------------------------++enumOptimizableConstants :: Map QName Definition -> [QName] -> TCM [QName]+enumOptimizableConstants definitions names = do+	computeGreatestFixedPoint f names+	where+	f :: [QName] -> QName -> TCM Bool+	f names name = return True -- All constants are optimized at the moment+	-- TODO: implement correctly+++----------------------------------------------------------------++computeGreatestFixedPoint :: ([QName] -> QName -> TCM Bool)-> [QName] -> TCM [QName]+computeGreatestFixedPoint f names = go names True where+    go names False = return names+    go names True  = go2 names names [] False+    go2 keptNames []           namesNext changed = go namesNext changed+    go2 keptNames (name:names) namesNext changed = do+	b <- f keptNames name+	case b of+	    True  -> go2 keptNames names (name : namesNext) changed+	    -- name is kept+	    False -> go2 keptNames names namesNext True+	    -- name is removed++computeLeastFixedPoint :: ([QName] -> QName -> TCM Bool) -> [QName] -> TCM [QName]+computeLeastFixedPoint f names = go names [] True where+    go names grantedNames False = return grantedNames+    go names grantedNames True  = go2 names [] grantedNames False+    go2 []           namesNext grantedNames changed =+	go namesNext grantedNames changed+    go2 (name:names) namesNext grantedNames changed = do+	b <- f grantedNames name +	case b of+	    True  -> go2 names namesNext (name : grantedNames) True+	    -- name is granted to be okay+	    False -> go2 names (name : namesNext) grantedNames changed+	    -- name is unsettled++--+

+ src/full/Agda/Compiler/Agate/Common.hs view

@@ -0,0 +1,135 @@+{-# LANGUAGE CPP #-}++{-| common+-}++module Agda.Compiler.Agate.Common where++#include "../../undefined.h"+import Agda.Utils.Impossible++import Control.Monad++import Agda.Compiler.Agate.TranslateName++import Agda.Syntax.Common+import Agda.Syntax.Literal+import Agda.Syntax.Internal++import Agda.TypeChecking.Monad+import Agda.TypeChecking.Reduce+import Agda.TypeChecking.Substitute++import Agda.Utils.Pretty+import Agda.Utils.Monad++----------------------------------------------------------------++psep :: [Doc] -> Doc+psep [x] = x+psep xs = parens $ sep xs+++dropArgs :: Int -> Type -> TCM Type+dropArgs n (El s t) = dropArgsTm s n t+    where+	dropArgsTm s 0 t = return (El s t)+	dropArgsTm _ n t = do+	    t <- reduce t+	    case t of+		Pi arg abs  -> dropArgs (n - 1) $ absBody abs+		Fun arg ty  -> dropArgs (n - 1) ty+		Var _ _	    -> __IMPOSSIBLE__+		Def _ _	    -> __IMPOSSIBLE__+		Con _ _	    -> __IMPOSSIBLE__+		MetaV _ _   -> __IMPOSSIBLE__+		Lam _ _	    -> __IMPOSSIBLE__+		Sort _	    -> __IMPOSSIBLE__+		Lit _	    -> __IMPOSSIBLE__++withFunctionDomain :: Type -> (Type -> TCM a) -> ([a] -> Type -> TCM b) -> TCM b+withFunctionDomain (El s tm) f ret = withDomain s tm+    where+	withDomain s tm = do+	    tm <- reduce tm+	    case tm of+		Pi arg abs -> do+		    res	    <- f $ unArg arg+		    underAbstraction arg abs $ \ty ->+			withFunctionDomain ty f $ \ress ty ->+			ret (res : ress) ty+		Fun arg ty -> do+		    res  <- f $ unArg arg+		    withFunctionDomain ty f $ \ress ty ->+			ret (res : ress) ty+		Var _ _    -> ret [] (El s tm)+		Def _ _    -> ret [] (El s tm)+		Con _ _    -> ret [] (El s tm)+		Sort _	   -> ret [] (El s tm)+		Lit _	   -> __IMPOSSIBLE__+		MetaV _ _  -> __IMPOSSIBLE__+		Lam _ _	   -> __IMPOSSIBLE__++splitType :: Type -> TCM ([Type], Type)+splitType ty = withFunctionDomain ty return $ \tys ty -> return (tys,ty)++forEachArgM :: (Type -> TCM a) -> Type -> TCM [a]+forEachArgM f ty = withFunctionDomain ty f $ \ress _ -> return ress++underContext :: Type -> TCM a -> TCM a+underContext ty k = withFunctionDomain ty return $ \_ _ -> k++--++showOptimizedLiteral :: Literal -> Doc+showOptimizedLiteral (LitInt    _ i) = text $ show i+showOptimizedLiteral (LitString _ s) = text $ show s+showOptimizedLiteral (LitFloat  _ f) = text $ show f+showOptimizedLiteral (LitChar   _ c) = text $ show c++showUntypedLiteral :: Literal -> Doc+showUntypedLiteral (LitInt    _ i) = text "VInt"    <+> text (show i)+showUntypedLiteral (LitString _ s) = text "VString" <+> text (show s)+showUntypedLiteral (LitFloat  _ f) = text "VFloat"  <+> text (show f)+showUntypedLiteral (LitChar   _ c) = text "VChar"   <+> text (show c)+++showClause :: (Term -> TCM Doc) ->+	      (QName -> [Doc] -> TCM Doc) ->+	      ([Doc] -> Term -> TCM Doc) -> Clause -> TCM Doc+showClause fTerm fCon fBody (Clause{ clauseBody = NoBody }) = return empty+showClause fTerm fCon fBody (Clause{ clausePats = pats, clauseBody = body })   = go 0 [] body+    where+    go :: Int -> [Doc] -> ClauseBody -> TCM Doc+    go n dvars NoBody        = return empty+    go n dvars (NoBind body) = go n (dvars ++ [text "_"]) body+    go n dvars (Bind abs)    =+	underAbstraction_ abs{absName = show (n + 1)} $ \body -> do+	    dvar <- fTerm $ Var 0 []+	    go (n + 1) (dvars ++ [dvar]) body+    go n dvars (Body term)   = do+	(_,dpats) <- showPatterns dvars $ map unArg pats+	fBody dpats term++    showPatterns :: [Doc] -> [Pattern] -> TCM ([Doc], [Doc])+    showPatterns dvars []           = return (dvars,[])+    showPatterns dvars (pat : pats) = do+	(dvars', dpat)  <- showPattern  dvars  pat+	(dvars'',dpats) <- showPatterns dvars' pats+	return (dvars'', (dpat : dpats))++    showPattern :: [Doc] -> Pattern -> TCM ([Doc], Doc)+    showPattern (dvar : dvars) (VarP s) = return (dvars, dvar)+    showPattern []             (VarP s) = __IMPOSSIBLE__+    showPattern (dvar : dvars) (DotP _) = return (dvars, dvar)+    showPattern []             (DotP _) = __IMPOSSIBLE__+    showPattern dvars (ConP name args) = do+	(dvars',dargs) <- showPatterns dvars (map unArg args)+	dcon <- fCon name dargs+	return (dvars', dcon)+    showPattern dvars (LitP lit) = do+	dlit <- fTerm $ Lit lit+	return (dvars, dlit)++--+

+ src/full/Agda/Compiler/Agate/Main.hs view

@@ -0,0 +1,161 @@+{-# LANGUAGE CPP #-}++{-| main module.+-}++module Agda.Compiler.Agate.Main where++#include "../../undefined.h"+import Agda.Utils.Impossible++import Agda.Compiler.Agate.TranslateName+import Agda.Compiler.Agate.OptimizedPrinter+import Agda.Compiler.Agate.UntypedPrinter+import Agda.Compiler.Agate.Common++import Agda.Syntax.Internal+import Text.PrettyPrint+import Agda.Syntax.Common++import Control.Monad.State+import Control.Monad.Error++import Data.List as List+import qualified Data.Map as Map+import Data.Map (Map)++import Agda.Syntax.Abstract.Name++import Agda.Interaction.Options+import Agda.Interaction.Monad++import Agda.TypeChecker+import Agda.TypeChecking.Monad+import Agda.TypeChecking.Reduce++import Agda.Utils.Monad++import Agda.Version++-- | The main function+compilerMain :: TCM () -> TCM ()+compilerMain typeCheck = do+	typeCheck+	sig <- gets stSignature+	let definitions = sigDefinitions sig+	let defs = Map.toList definitions+	maxconargs <- computeMaxArity definitions+	liftIO $ do+	    putStrLn "{-# OPTIONS -fglasgow-exts -cpp #-}"+	    putStrLn ""+	    putStrLn "-- Generated by Agate 2"+	    putStrLn ""+	    printConstants definitions+	    putStrLn ""+	    putStrLn "data Value = VAbs (Value -> Value)"+	    putStrLn "           | VCon0 !Nat"+	    mapM_ (\k -> putStrLn $ "           | VCon" ++ show k ++ " !Nat"+	 			 ++ concat (genericReplicate k " Value") )+	    	  [1..maxconargs]+	    putStrLn "           | VNonData"+	    putStrLn "           | VIO      !(IO Value)"+	    putStrLn "           | VInt     !Integer"+	    putStrLn "           | VFloat   !Double"+	    putStrLn "           | VString  !String"+	    putStrLn "           | VChar    !Char"+	    putStrLn ""+	    putStrLn "instance Show Value where"+	    putStrLn "  show v = case v of"+	    putStrLn "    VAbs     f     -> \"<func>\""+	    putStrLn "    VCon0    c     -> getConString c"+	    mapM_ (\k -> putStrLn $ "    VCon" ++ show k ++ "    c"+	 			 ++ concatMap (\i -> " a" ++ show i) [1..k]+	 			 ++ "\t-> showCons c [a1"+	 			 ++ concatMap (\i -> ",a" ++ show i) [2..k]+	 			 ++ "]" )+	    	  [1..maxconargs]+	    putStrLn "    VNonData       -> \"<nondata>\""+	    putStrLn "    VIO      m     -> \"<IO>\""+	    putStrLn "    VInt     i     -> show i"+	    putStrLn "    VFloat   f     -> show f"+	    putStrLn "    VString  s     -> show s"+	    putStrLn "    VChar    c     -> show c"+	    putStrLn ""+	    --putStrLn "join sep []     = \"\""+	    --putStrLn "join sep [a]    = a"+	    --putStrLn "join sep (a:as) = a ++ sep ++ join sep as"+	    putStrLn ""+	    putStrLn "showCons c as = \"(\" ++ unwords (getConString c : map show as) ++ \")\""+	    putStrLn "showBind (f,v) = show v"+	    putStrLn ""+	    printShowConstants definitions+	    putStrLn "getConString c = show c"+	    putStrLn ""+    	    putStrLn "(|$|) :: Value -> Value -> Value"+	    putStrLn "(VAbs f) |$| x = f x"+	    putStrLn ""+	    putStrLn "class Trans a where"+	    putStrLn "    unbox :: Value -> a"+	    putStrLn "    box   :: a -> Value"+	    putStrLn ""+	    putStrLn "instance Trans () where"+	    putStrLn "    unbox VNonData = ()"+	    putStrLn "    box () = VNonData"+	    putStrLn ""+	    putStrLn "instance (Trans a, Trans b) => Trans (a -> b) where"+	    putStrLn "    unbox (VAbs f) = unbox . f . box"+	    putStrLn "    box f = VAbs ( box . f . unbox )"+	    putStrLn ""+	    putStrLn "instance Trans Integer where"+	    putStrLn "    unbox (VInt i) = i"+	    putStrLn "    box i = VInt i"+	    putStrLn ""+	    putStrLn "instance Trans Double where"+	    putStrLn "    unbox (VFloat f) = f"+	    putStrLn "    box f = VFloat f"+	    putStrLn ""+	    putStrLn "instance Trans String where"+	    putStrLn "    unbox (VString s) = s"+	    putStrLn "    box s = VString s"+	    putStrLn ""+	    putStrLn "instance Trans Char where"+	    putStrLn "    unbox (VChar c) = c"+	    putStrLn "    box c = VChar c"+	    putStrLn ""+	    putStrLn "main = putStrLn $ show x_Main__main"+	liftIO $ putStrLn $ "--"+	ddefs <- mapM showUntypedDefinition defs+	liftIO $ putStrLn $ render $ vcat ddefs+	showOptimizedDefinitions definitions++enumConstructors :: Definitions -> [QName]+enumConstructors = concatMap f . Map.toList where+    f (name, d) = case theDef d of+			Constructor{} -> [name]+                        Record{}      -> [name]+                        _             -> []++computeMaxArity :: Definitions -> TCM Nat+computeMaxArity dd =+    fmap maximum $ mapM getConstructorArity $ map snd $ Map.toList dd++getConstructorArity :: Definition -> TCM Nat+getConstructorArity defn = case theDef defn of+    Record{recFields = flds} -> return $ genericLength flds+    Constructor{conPars = np} -> do+	ty <- normalise $ defType defn+	(args,_) <- splitType ty+	return $ genericLength args - np+    _ -> return 0++printConstants :: Definitions -> IO ()+printConstants dd = mapM_ go $ zip (enumConstructors dd) [1..] where+    go (name,n) = let cname = translateNameAsUntypedConstructor $ show name in+		  putStrLn $ "#define " ++ cname ++ " " ++ show n++printShowConstants :: Definitions -> IO ()+printShowConstants dd = mapM_ go $ zip (enumConstructors dd) [1..] where+    go (name,n) = let pname = show $ qnameName name in+		  putStrLn $ "getConString " ++ show n ++ " = \"" ++ pname ++ "\""++----------------------------------------------------------------

+ src/full/Agda/Compiler/Agate/OptimizedPrinter.hs view

@@ -0,0 +1,305 @@+{-# LANGUAGE CPP #-}++{-| Generate GHC code for optimized datatypes and their values+-}++module Agda.Compiler.Agate.OptimizedPrinter where++#include "../../undefined.h"+import Agda.Utils.Impossible++import Control.Monad.Trans+import qualified Data.Map as Map+import Data.Map ((!), Map)++import Agda.Compiler.Agate.Classify+import Agda.Compiler.Agate.TranslateName+import Agda.Compiler.Agate.Common++import Agda.Syntax.Common+import Agda.Syntax.Internal+import Agda.TypeChecking.Monad+import Agda.TypeChecking.Reduce+import Agda.TypeChecking.Free+import Agda.Utils.Pretty+import Agda.Utils.Size++----------------------------------------------------------------++showAsOptimizedConstructor :: QName -> TCM Doc+showAsOptimizedConstructor s =+    return $ text $ translateNameAsOptimizedConstructor $ show s++----------------------------------------------------------------++showOptimizedDefinitions :: Definitions -> TCM ()+showOptimizedDefinitions definitions = do+    liftIO $ putStrLn ("\n-----\n")+    typefams <- enumCompilableTypeFamilies definitions+    dtypedecls <- showTypeDeclarations definitions typefams+    liftIO $ putStrLn $ render dtypedecls+    optimizableConstants <- enumOptimizableConstants definitions typefams+    liftIO $ putStrLn $ ""+    dvaluedefs <- showValueDefinitions definitions typefams+    liftIO $ putStrLn $ render dvaluedefs+    return ()++----------------------------------------------------------------+-- Generating GHC Type Declarations++showTypeDeclarations :: Definitions -> [QName] -> TCM Doc+showTypeDeclarations definitions typefams = do+    dtypedecls <- mapM (showTypeDeclaration definitions) typefams+    return $ vcat dtypedecls++showTypeDeclaration :: Definitions -> QName -> TCM Doc+showTypeDeclaration definitions name = do+    dtypename <- showAsOptimizedType name+    let defn = definitions ! name+    ty <- normalise $ defType defn+    case theDef defn of+	Datatype{ dataPars = np, dataIxs = ni, dataCons = cnames } | ni == 0 -> do+	    dparams <- underDatatypeParameters np ty showTypeParameter stop+	    dargs <- mapM (showConstructorDeclaration np) cnames+	    showDatatypeDeclaration dtypename dparams dargs+	Record{ recPars = np, recFields = flds } -> do+	    let arity = np `div` 2+	    dparams <- underDatatypeParameters arity ty showTypeParameter stop+	    dcon <- showAsOptimizedConstructor name+	    dflds <- mapM (showRecordFieldDeclaration (arity + 1)) flds+	    showDatatypeDeclaration dtypename dparams [sep $ dcon : dflds]+     	Function { funClauses = [clause@(Clause{ clausePats = pat })] } -> do+	    (args,_) <- splitType ty+	    let dextra = map (\i -> text $ "a" ++ show i)+			     [length pat + 1 .. length args]+	    showTypeSynonymDeclaration dtypename dextra clause+     	_ -> return empty+    where+    stop ty = return []+    showDatatypeDeclaration dtypename dparams [] =+	return $ (text "type") <+> (sep (dtypename : dparams) <+> equals <+>+				    text "()")+    showDatatypeDeclaration dtypename dparams dargs =+	return $ (text "data") <+> (sep $+				    sep (dtypename : dparams) <+> equals :+				    punctuate (text " |") dargs)+				$+$ text "    -- deriving (Show)"+    showTypeSynonymDeclaration dtypename dextra = showClause fTerm fCon fBody+	where+	fTerm = showAsOptimizedType+	fCon name dargs = __IMPOSSIBLE__+	fBody dpats term = do+	    dterm <- showAsOptimizedType term+	    return $ (text "type") <+>+		     (sep (dtypename : (dpats ++ dextra)) <+> equals <+>+		      sep (dterm : dextra))++    showConstructorDeclaration np cname = do+	let defn = definitions ! cname+	ty <- normalise $ defType defn+	dcon <- showAsOptimizedConstructor cname+	underDatatypeParameters np ty (\d t -> return id) $ \ty -> do+	    dargs <- forEachArgM showAsOptimizedType ty+	    return $ sep $ dcon : dargs+    showRecordFieldDeclaration np fldname = do+	let defn = definitions ! fldname+	ty <- normalise $ defType defn+	underDatatypeParameters np ty (\d t -> return id) showAsOptimizedType++showTypeParameter :: Doc -> Type -> TCM ([Doc] -> [Doc])+showTypeParameter dname ty = do+    ty <- instantiate ty+    (args,_) <- splitType ty+    case args of+	[]  -> return $ (:) dname+	_:_ -> do+		dk <- showAsOptimizedKind ty+		return $ (:) $ parens $ sep [ dname <+> text "::", dk ]++underDatatypeParameters :: Nat -> Type -> (Doc -> Type -> TCM (a -> a)) ->+			   (Type -> TCM a) -> TCM a+underDatatypeParameters np ty f k = go 0 ty where+    go i ty        | i >= np = k ty+    go i (El s tm)           = do+      let varname = show (i + 1)+      tm <- reduce tm+      case tm of+	Pi arg abs -> underAbstraction arg abs{absName = varname} $ \ty -> do+	    dname <- showAsOptimizedTerm $ Var 0 []+	    cont <- f dname $ unArg arg+	    dparams <- go (i + 1) ty+	    return $ cont dparams+	Fun arg ty -> do+	    let dname = text $ translateNameAsOptimizedTerm varname+	    cont <- f dname $ unArg arg+	    dparams <- go (i + 1) ty+	    return $ cont dparams+	Var _ _    -> __IMPOSSIBLE__+	Def _ _    -> __IMPOSSIBLE__+	Con _ _    -> __IMPOSSIBLE__+	Sort _	   -> __IMPOSSIBLE__+	Lit _	   -> __IMPOSSIBLE__+	MetaV _ _  -> __IMPOSSIBLE__+	Lam _ _	   -> __IMPOSSIBLE__++----------------------------------------------------------------+-- Generating GHC Value Definitions++showValueDefinitions :: Definitions -> [QName] -> TCM Doc+showValueDefinitions definitions typefams = do+    let defs = Map.toList definitions+    dvaluedefs <- mapM (showValueDefinition definitions typefams) defs+    return $ vcat dvaluedefs++showValueDefinition :: Definitions -> [QName] -> (QName,Definition) -> TCM Doc+showValueDefinition definitions typefams (name, defn) = do+    dname <- showAsOptimizedTerm name+    ty <- normalise $ defType defn+    dty <- showAsOptimizedType ty+    let dtypedecl = sep [ dname, text "::" ] <+> dty+    case theDef defn of+	Axiom{} -> do+	    let dvaluedef = sep [ dname, equals ] <+>+			    sep [ text "undefined {- postulate -}" ]+	    return $ dtypedecl $+$ dvaluedef+	Function { funClauses = clauses } -> do+	    dclauses <- mapM (showOptimizedClause dname) clauses+	    return $ vcat $ dtypedecl : dclauses+	Datatype{ dataPars = np, dataIxs = ni, dataCons = cnames } -> do+	    let dvars = map (\i -> text ("v" ++ show i)) [1 .. np + ni]+	    let dvaluedef = sep [ sep (dname : dvars), equals ] <+> text "()"+	    return $ dtypedecl $+$ dvaluedef+	Record{} -> +	    return empty  -- no o_xxx since we always use D_xxx+	Constructor{} ->+	    return empty  -- no o_xxx since we always use D_xxx+	Primitive { primName = pf } -> do+	    let dvaluedef = sep [ dname, equals ] <+>+			    sep [ text (show name), text "{- primitive -}" ]+	    return $ dtypedecl $+$ dvaluedef++showOptimizedClause :: Doc -> Clause -> TCM Doc+showOptimizedClause dfuncname = showClause fTerm fCon fBody where+    fTerm = showAsOptimizedTerm+    fCon name dargs = do+	dname <- showAsOptimizedConstructor name+	return $ parens $ sep (dname : dargs)    +    fBody dpats term = do+	dterm <- showAsOptimizedTerm term+	return $ (sep (dfuncname : dpats) <+> equals) <+> nest 2 dterm++----------------------------------------------------------------+-- implementation of the "K" function++class ShowAsOptimizedKind a where+    showAsOptimizedKind :: a -> TCM Doc ++instance ShowAsOptimizedKind Type where+    showAsOptimizedKind (El s t) = showAsOptimizedKind t++instance ShowAsOptimizedKind Term where+    showAsOptimizedKind t = do+	t <- reduce t+	case t of+	    Pi arg abs -> do+		dk1 <- showAsOptimizedKind $ unArg arg+		dk2 <- showAsOptimizedKind $ absBody abs+		return $ parens $ sep [dk1 <+> text "->", dk2]+	    Fun arg ty -> do+		dk1 <- showAsOptimizedKind $ unArg arg+		dk2 <- showAsOptimizedKind $ ty+		return $ parens $ sep [dk1 <+> text "->", dk2]+	    Sort s     -> return $ text "*"+	    Var _ _    -> return $ text "*" -- ok?+	    Def _ _    -> __IMPOSSIBLE__+	    Con _ _    -> __IMPOSSIBLE__+	    Lit _      -> __IMPOSSIBLE__+	    MetaV _ _  -> __IMPOSSIBLE__+	    Lam _ _    -> __IMPOSSIBLE__++----------------------------------------------------------------+-- implementation of the "T" function++class ShowAsOptimizedType a where+    showAsOptimizedType :: a -> TCM Doc ++instance ShowAsOptimizedType QName where+    showAsOptimizedType s = return $ text $ translateNameAsOptimizedType $ show s++instance ShowAsOptimizedType Type where+    showAsOptimizedType (El s t) = showAsOptimizedType t++instance ShowAsOptimizedType Term where+    showAsOptimizedType t = do+	t <- reduce t+	case t of+	    Var n args -> do+		varname <- nameOfBV n+		dvar <- showAsOptimizedTerm varname+		dargs <- mapM (showAsOptimizedType . unArg) args+		return $ psep $ dvar : dargs+	    Def name args -> do+		dname <- showAsOptimizedType name+		dargs <- mapM (showAsOptimizedType . unArg) args+		return $ psep $ dname : dargs+	    Con name args -> do+		return $ text "<constructor term (impossible)>"+	    Pi arg abs -> do+		dt1 <- showAsOptimizedType $ unArg arg+		underAbstraction_ abs $ \body -> do+		    dvar <- showAsOptimizedTerm $ Var 0 []+		    dt2 <- showAsOptimizedType body+		    case freeIn 0 body of+			True  -> return $ parens $ sep $+			    [ sep [ text "forall",+				    dvar <> text ".", dt1, text "->" ],+			      dt2 ]+			False -> return $ parens $ sep [dt1 <+> text "->", dt2]+	    Fun arg ty -> do+		dt1 <- showAsOptimizedType $ unArg arg+		dt2 <- showAsOptimizedType $ ty+		return $ parens $ sep [dt1, text "->", dt2]+	    Sort s        -> return $ text "()"+	    MetaV id args -> return $ text "<meta (impossible)>"+	    Lam h t       -> __IMPOSSIBLE__+	    Lit lit       -> __IMPOSSIBLE__+++----------------------------------------------------------------+-- implementation of the "O" function++class ShowAsOptimizedTerm a where+    showAsOptimizedTerm :: a -> TCM Doc ++instance ShowAsOptimizedTerm Name where+    showAsOptimizedTerm s = return $ text $ translateNameAsOptimizedTerm $ show s++instance ShowAsOptimizedTerm QName where+    showAsOptimizedTerm s = return $ text $ translateNameAsOptimizedTerm $ show s++instance ShowAsOptimizedTerm Term where+    showAsOptimizedTerm (Var n args) = do+    	varname <- nameOfBV n+    	dvar <- showAsOptimizedTerm varname+    	dargs <- mapM (showAsOptimizedTerm . unArg) args+    	return $ psep $ dvar : dargs+    showAsOptimizedTerm (Lam h abs) = underAbstraction_ abs $ \body -> do+    	dvar <- showAsOptimizedTerm $ Var 0 []+    	dt <- showAsOptimizedTerm body+    	return $ parens $ sep [ text "\\" <> dvar, text "->", dt ]+    showAsOptimizedTerm (Def name args) = do+	dname <- showAsOptimizedTerm name+	dargs <- mapM (showAsOptimizedTerm . unArg) args+	return $ psep $ dname : dargs+    showAsOptimizedTerm (Con name args) = do+    	dname <- showAsOptimizedConstructor name+    	dargs <- mapM (showAsOptimizedTerm . unArg) args+    	return $ psep $ dname : dargs+    showAsOptimizedTerm (Lit lit)        = return $ showOptimizedLiteral lit+    showAsOptimizedTerm (Pi _ _)	 = return $ text "()"+    showAsOptimizedTerm (Fun _ _)	 = return $ text "()"+    showAsOptimizedTerm (Sort _)	 = return $ text "()"+    showAsOptimizedTerm (MetaV id args)  = __IMPOSSIBLE__++----------------------------------------------------------------+--

+ src/full/Agda/Compiler/Agate/TranslateName.hs view

@@ -0,0 +1,53 @@+{-# LANGUAGE CPP #-}++{-| Translate Agda names into a variety of GHC names+-}++module Agda.Compiler.Agate.TranslateName where++#include "../../undefined.h"+import Agda.Utils.Impossible++import Data.Char++----------------------------------------------------------------++translateNameAsUntypedTerm :: String -> String+translateNameAsUntypedTerm "_"                 = "_"+translateNameAsUntypedTerm s   | all isDigit s = 'x':s+translateNameAsUntypedTerm s                   = 'x':'_':escape s++translateNameAsUntypedConstructor :: String -> String+translateNameAsUntypedConstructor s = 'C':'_':escape s++translateNameAsOptimizedType :: String -> String+translateNameAsOptimizedType "_" = "_"+translateNameAsOptimizedType s   = 'T':'_':escape s++translateNameAsOptimizedTerm :: String -> String+translateNameAsOptimizedTerm "_"                 = "_"+translateNameAsOptimizedTerm s   | all isDigit s = 'o':s+translateNameAsOptimizedTerm s                   = 'o':'_':escape s++translateNameAsOptimizedConstructor :: String -> String+translateNameAsOptimizedConstructor s = 'D':'_':escape s++----------------------------------------------------------------++escape :: String -> String+escape ""      = ""+escape "_"     = "_"+escape (c:s) | isUpper c || isLower c || isDigit c = c:escape s+escape ('.':s) = '_':'_':escape s+escape ('_':s) = '_':'z':escape s+escape (c:s) | ord c >= 256+	       = '_':'u'+                    :intToDigit (ord c `div` 4096)+                    :intToDigit ((ord c `div` 256) `mod` 16)+                    :intToDigit ((ord c `div` 16)  `mod` 16)+                    :intToDigit (ord c `mod` 16):escape s+escape (c:s)   = '_':intToDigit (ord c `div` 16)+                    :intToDigit (ord c `mod` 16):escape s++----------------------------------------------------------------+

+ src/full/Agda/Compiler/Agate/UntypedPrinter.hs view

@@ -0,0 +1,124 @@+{-# LANGUAGE CPP #-}++{-| Generate GHC code for untyped execution+-}++module Agda.Compiler.Agate.UntypedPrinter where++import Data.List++#include "../../undefined.h"+import Agda.Utils.Impossible++import Agda.Compiler.Agate.TranslateName+import Agda.Compiler.Agate.Common+import Agda.Compiler.Agate.OptimizedPrinter++import Agda.Syntax.Common+import Agda.Syntax.Internal+import Agda.Syntax.Literal+import Agda.TypeChecking.Monad+import Agda.TypeChecking.Reduce+import Agda.Utils.Pretty++----------------------------------------------------------------++showAsUntypedConstructor :: QName -> TCM Doc+showAsUntypedConstructor name =+    return $ text $ translateNameAsUntypedConstructor $ show name++----------------------------------------------------------------+-- implementation of the "X" function++class ShowAsUntypedTerm a where+    showAsUntypedTerm :: a -> TCM Doc ++instance ShowAsUntypedTerm Name where+    showAsUntypedTerm t = return $ text $ translateNameAsUntypedTerm $ show t++instance ShowAsUntypedTerm QName where+    showAsUntypedTerm t = return $ text $ translateNameAsUntypedTerm $ show t++instance ShowAsUntypedTerm Term where+    showAsUntypedTerm (Var n args) = do+	varname <- nameOfBV n+	showUntypedApp varname args+    showAsUntypedTerm (Lam h abs) = underAbstraction_ abs $ \body -> do+	dvar <- showAsUntypedTerm $ Var 0 []+	dbody <- showAsUntypedTerm body+	return $ parens $ text "VAbs" <+>+		 parens (sep [ text "\\" <> dvar, text "->", dbody ])+    showAsUntypedTerm (Con name args) = showUntypedApp name args+    showAsUntypedTerm (Def name args) = showUntypedApp name args+    showAsUntypedTerm (Lit lit)    = return $ parens $ showUntypedLiteral lit+    showAsUntypedTerm (Pi _ _)	   = return $ text "VNonData"+    showAsUntypedTerm (Fun _ _)    = return $ text "VNonData"+    showAsUntypedTerm (Sort _)	   = return $ text "VNonData"+    showAsUntypedTerm (MetaV _ _)  = __IMPOSSIBLE__++showUntypedApp :: ShowAsUntypedTerm a => a -> [Arg Term] -> TCM Doc+showUntypedApp head args = do+    dhead <- showAsUntypedTerm head+    dargs <- mapM (showAsUntypedTerm . unArg) args+    return $ foldl (\f a -> parens (f <+> text "|$|" <+> a)) dhead dargs++----------------------------------------------------------------++showUntypedDefinition :: (QName, Definition) -> TCM Doc+showUntypedDefinition (name, defn) = do+    dname <- showAsUntypedTerm name+    case theDef defn of+	Axiom{} ->+	    return $ sep [ dname, equals ] <+>+		     sep [ text "undefined {- postulate -}" ]+	Function {funClauses = []} -> __IMPOSSIBLE__+	Function {funClauses = clauses} -> do+            let pats = clausePats $ head clauses+	    let dvars = map (\i -> text ("v" ++ show i)) [1 .. length pats]+	    let drhs = untypedAbs dvars $ sep (text "f" : dvars)+	    dclauses <- mapM showUntypedClause clauses+	    return $ (dname <+> equals) <+> drhs <+> text "where" $+$+		     nest 2 (vcat dclauses)+	Datatype{ dataPars = np, dataIxs = ni, dataCons = cnames } -> do+	    let dvars = map (\i -> text ("v" ++ show i)) [1 .. np + ni]+	    let drhs = untypedAbs dvars $ text "VNonData"+	    return $ sep [ dname, equals ] <+> drhs <+> text "{- datatype -}"+	Record{ recPars = np, recFields = flds } -> do+	    dcname <- showAsUntypedConstructor name+	    let arity = length flds+	    let dvars = map (\i -> text ("v" ++ show i)) [1 .. arity]+	    let drhs = untypedAbs dvars $ sep $+		       text "VCon" <> text (show arity) : dcname : dvars+	    return $ sep [ dname, equals ] <+> drhs+	Constructor{ conPars = np } -> do+	    dcname <- showAsUntypedConstructor name+	    ty <- instantiate $ defType defn+	    (args,_) <- splitType ty+	    let arity = genericLength args - np+	    let dvars = map (\i -> text ("v" ++ show i)) [1 .. arity]+	    let drhs = untypedAbs dvars $ sep $+		       text "VCon" <> text (show arity) : dcname : dvars+	    return $ sep [ dname, equals ] <+> drhs+	Primitive{ primName = pf } -> do+	    doptname <- showAsOptimizedTerm name+	    return $ sep [ dname, equals ] <+>+		     sep [ text "box", doptname, text "{- primitive -}" ]++untypedAbs :: [Doc] -> Doc -> Doc+untypedAbs dvars dtail = foldr+    (\dvar d -> sep [ text "VAbs (\\" <> dvar <+> text "->",+		      d <> text ")" ]) dtail dvars++showUntypedClause :: Clause -> TCM Doc+showUntypedClause = showClause fTerm fCon fBody where+    fTerm = showAsUntypedTerm+    fCon name dargs = do+	dname <- showAsUntypedConstructor name+	return $ parens $ (text "VCon" <> text (show (length dargs))) <+>+			  sep (dname : dargs)+    fBody dpats term = do+	dterm <- showAsUntypedTerm term+	return $ text "f" <+> sep [ sep [ sep dpats, equals ], dterm ]++----------------------------------------------------------------+--

+ src/full/Agda/Compiler/Alonzo/Haskell.hs view

@@ -0,0 +1,112 @@+module Agda.Compiler.Alonzo.Haskell where+import Language.Haskell.Syntax+import Language.Haskell.Pretty+import System.IO++dummyLoc :: SrcLoc+dummyLoc = SrcLoc "=alonzo=" 0 0++hsModule :: String -> [HsDecl] -> HsModule+hsModule name decls = HsModule dummyLoc (Module name) Nothing [] decls++hsModuleImporting :: String -> [String] -> [String] -> [HsDecl] -> HsModule+hsModuleImporting name imps qimps decls = +  HsModule dummyLoc (Module name) Nothing+    (map hsImport imps ++ impRTS : impRTP : map hsQImport qimps) decls++hsImport :: String -> HsImportDecl+hsImport s = HsImportDecl dummyLoc (Module s) False Nothing Nothing++hsQImport :: String -> HsImportDecl+hsQImport s = HsImportDecl dummyLoc (Module s) True Nothing Nothing++impRTS :: HsImportDecl+impRTS = hsImport "RTS"++impRTP :: HsImportDecl+impRTP = hsQImport "RTP"++hsUndefined :: HsExp+hsUndefined = hsVar "undefined"++hsError :: String -> HsExp+hsError s = HsApp (hsVar "error") (HsLit $ HsString s)++hsCast e@(HsVar _) = HsApp (hsVar "cast") e+hsCast e@(HsCon _) = HsApp (hsVar "cast") e+hsCast e = HsApp (hsVar "cast") (HsParen e)++hsVar :: String -> HsExp+hsVar s = HsVar $ UnQual $ HsIdent s++hsCon :: String -> HsExp +hsCon s = HsCon $ UnQual $ HsIdent s++hsLam :: String -> HsExp -> HsExp+hsLam n e = HsLambda dummyLoc [HsPVar (HsIdent n)] e++hsAp :: HsExp -> HsExp -> HsExp +hsAp e1 e2 =  HsApp (hsCast e1) $ HsParen (hsCast e2)++outputHsModule s hsmod numOfMainS = do+  handle <- openFile (s++".hs") WriteMode+  printHsModule handle hsmod+  case numOfMainS of+    Nothing -> return ()+    Just i -> printHsMain handle i+  hClose handle++printHsMain handle i = do+  hPutStrLn handle mainStr where+      -- mainStr = "main = putStrLn d" ++ (show i)+      mainStr = "main = d" ++ show i++printHsModule :: Handle -> HsModule -> IO ()+printHsModule handle hsmod = do+	    hPutStrLn handle "{-# OPTIONS -fglasgow-exts #-}"+	    hPutStrLn handle ""+	    hPutStrLn handle "-- Generated by Alonzo"+	    hPutStrLn handle ""+            hPutStrLn handle $ prettyPrint $ hsmod++printHsDecls :: [HsDecl] -> IO ()+printHsDecls ds = mapM_ (putStrLn . prettyPrint) ds++data AlDecl = AlDecl [HsDecl] | AlComment String++printAlDecl :: AlDecl -> IO()+printAlDecl (AlDecl ds) = printHsDecls ds+printAlDecl (AlComment s) = putStrLn $ "{- "++s++" -}"++printAlModule :: String -> [AlDecl] -> IO()+printAlModule name ds = do+	    putStrLn "{-# OPTIONS -fglasgow-exts -cpp #-}"+	    putStrLn ""+	    putStrLn "-- Generated by Alonzo"+	    putStrLn ""+            putStrLn $ "module " ++ name ++ " where"+            putStrLn "import RTS"+            mapM_ printAlDecl ds+++{-++type sigs+HsExp = ...+HsExpTypeSig SrcLoc HsExp HsQualType++data HsQualType+	 = HsQualType HsContext HsType+type HsContext = [HsAsst]++HsType = ... HsTyCon HsQName+-}++hsTypedExp :: HsQName -> HsExp -> HsExp+hsTypedExp qn e = HsExpTypeSig dummyLoc e $ HsQualType [] $ HsTyCon qn++hsPreludeName :: String -> HsQName+hsPreludeName s = Qual prelude_mod $ HsIdent s++hsPreludeTypedExp :: String -> HsExp -> HsExp+hsPreludeTypedExp s e = hsTypedExp (hsPreludeName s) e

+ src/full/Agda/Compiler/Alonzo/Main.hs view

@@ -0,0 +1,501 @@+{-# LANGUAGE CPP #-}++module Agda.Compiler.Alonzo.Main where++#include "../../undefined.h"+import Agda.Utils.Impossible++import Debug.Trace(trace)+import Language.Haskell.Syntax+import Language.Haskell.Pretty+import System.FilePath (pathSeparator)++import Agda.Compiler.Alonzo.Haskell+-- import Agda.Compiler.Alonzo.Debug+import Agda.Compiler.Alonzo.Names+import Agda.Compiler.Alonzo.PatternMonad+-- import qualified Agda.Compiler.Alonzo.PatternMonadLift as PML++import qualified Agda.Syntax.Concrete.Name as C++import Agda.Syntax.Internal+import Agda.Syntax.Literal+-- import Agda.Syntax.Scope+import Text.PrettyPrint+import Agda.Syntax.Common+-- import Agda.Syntax.Abstract(Pattern'(..),Pattern)++import Control.Applicative+import Control.Monad.State++import qualified Data.Set as Set+import qualified Data.Map as Map+import Data.List as List+import Data.Set (Set)+import Data.Map (Map, (!))+import Data.Generics.Text++-- import Agda.Syntax.Abstract.Test+import Agda.Syntax.Abstract.Name+import qualified Agda.Syntax.Concrete.Name as CN++import Agda.Interaction.Options+import Agda.Interaction.Monad++import Agda.TypeChecker+import Agda.TypeChecking.Monad+import Agda.TypeChecking.Monad.Builtin+import Agda.TypeChecking.Reduce++import Agda.Utils.Monad+import Agda.Utils.Permutation++import System.IO+-- import Data.List(nub)++-- import Agda.Version++-- | The main function+compilerMain :: TCM () -> TCM ()+compilerMain typeCheck = ignoreAbstractMode $ do+      typeCheck+      sig <- gets stSignature+      let (moduleName:_) =  Map.keys $ sigSections sig+      withCurrentModule moduleName $ do -- TODO: Hack!+        builtinMap <- getBuiltinThings+	-- let sigs = toList sig+	-- let definitions = mdefDefs (snd (head sigs)) -- :: Map Name Definition       +	let definitions = sigDefinitions sig -- :: Map QName Definition+	let defs = Map.toList definitions+        let names = List.map fst defs+        hsdefs <- mapM processDefWithDebug defs+        -- We get more than we need here+        allImps <- map show . Map.keys <$> getVisitedModules+        verboseS "comp.alonzo.import" 20 $ liftIO $ mapM_ (\m -> putStrLn $ "import " ++ m) allImps+        hImps <- getHaskellImports+        let mainNum = (numOfMainS names)+        let fileBase = map pathSep (show moduleName)+              where+                pathSep '.' = pathSeparator+                pathSep c   = c+        let moduleString = show moduleName+        let hsmod = hsModuleImporting moduleString hImps allImps (concat hsdefs)+        liftIO $ outputHsModule fileBase hsmod mainNum+        -- let almod = List.map AlDecl hsdefs+        -- liftIO $ printAlModule moduleString almod++-- TODO: move somewhere else+fromCurrentModule :: QName -> TCM Bool+fromCurrentModule q = do+  m <- qnameFromList . mnameToList <$> currentModule+  return $ moduleId q == moduleId m+  where+    moduleId q = mi+      where NameId _ mi = nameId $ qnameName q++flattenSubmodules :: QName -> TCM QName+flattenSubmodules q = do+  ifM (fromCurrentModule q)+      (return q)+  $ do+    topModules <- Map.keys <$> getVisitedModules+    case filter (isInModule q) topModules of+      [top]     -> return $ q { qnameModule = top }+      []        -> error $ "flattenSubmodules: " ++ show q ++ " </- " ++ show topModules+      _ : _ : _ -> __IMPOSSIBLE__++maybeQualName :: (QName -> HsQName) -> (Name -> HsName) -> QName -> PM HsQName+maybeQualName qual unqual q = lift $ do+  ifM (fromCurrentModule q)+      (return $ UnQual (unqual $ qnameName q))+      (qual <$> flattenSubmodules q)++maybeQualConName = maybeQualName conQName conName+maybeQualDefName = maybeQualName dfQName dfName++numOfMainS :: [QName] -> Maybe Nat+numOfMainS [] = Nothing+numOfMainS (n:ns) | isMain (qnameName n) = Just $ numOfQName n+                  | otherwise = numOfMainS ns++-- isMain (Name _ (C.Name _ [C.Id _ "mainS"]) _ _ ) = True+isMain n = (show n == "main")++	++processDefWithDebug :: (QName,Definition) -> TCM [HsDecl]+processDefWithDebug (qname,def) = do+     def <- instantiateFull def+     hsdecls <- processDef (qname,def)+     return (nameInfo:hsdecls) where+         nameInfo = infoDecl infoName (show name)+         infoName = "name" ++ (show $ numOfName name)+	 name = qnameName qname+        +infoDecl :: String -> String -> HsDecl+infoDecl name val = HsFunBind [ HsMatch dummyLoc hsname [] rhs []] where+    rhs = HsUnGuardedRhs $ HsLit $ HsString val +    hsname = HsIdent name+++processDef :: (QName,Definition) -> TCM [HsDecl]+processDef (qname,Defn { theDef = Function { funClauses = clauses } }) =  do+      hsDecls <- foldClauses name 1 clauses+      return [HsFunBind [HsMatch dummyLoc (dfName name) [] rhs hsDecls]] where+                rhs = HsUnGuardedRhs $ HsVar $ UnQual $ dfNameSub name 1+                name = qnameName qname+ +processDef (qname,Defn { theDef = Datatype{ dataPars = n, dataClause = Nothing, dataCons = [] } }) = do+  return [ddecl,vdecl]  where+      name = qnameName qname+      ddecl = HsDataDecl  dummyLoc [] (dataName name) tvars cons []+      tvars = []+      cons = [HsConDecl dummyLoc (conName name) [] ]+      vdecl = HsFunBind [ HsMatch dummyLoc hsname (nDummyArgs n) rhs []]+      rhs = HsUnGuardedRhs $ HsVar $ unit_con_name+      hsname = dfName name+      nDummyArgs :: Nat -> [HsPat]+      nDummyArgs 0 = []+      nDummyArgs k = (HsPVar $ HsIdent ("v" ++ (show k))) : nDummyArgs (k-1)++processDef (qname,Defn { theDef = Datatype{ dataPars = n, dataIxs = nind, dataClause = Nothing, dataCons = cs }}) = do+  cons <- consForName name cs+  arities <- getConArities cs+  return [ddecl cons arities,vdecl]  where+      name = qnameName qname+      dataname = dataName name+      ddecl cs arities = HsDataDecl  dummyLoc [] dataname (tvars arities) cs []+      tvars arities = genericTake (List.maximum arities) $ List.map HsIdent letters+      vdecl = HsFunBind [ HsMatch dummyLoc hsname (nDummyArgs (n+nind)) rhs []]+      rhs = HsUnGuardedRhs $ HsVar $ unit_con_name+      hsname = dfName name+      nDummyArgs 0 = []+      nDummyArgs k = (HsPVar $ HsIdent ("v" ++ (show k))) : nDummyArgs (k-1)++-- Records are translated to a data with one cons+processDef (qname, Defn { theDef =+            Record { recPars = n, recFields = fields, recTel = tel } }) =  do+   return [ddecl arity tel,vdecl tel]  where+      name = qnameName qname+      arity = genericLength fields+      ddecl n tel = HsDataDecl  dummyLoc [] dataname (tvars n) [con n] []+      dataname = (dataName name)+      tvars n = genericTake n idents+      con n = HsConDecl dummyLoc (conName  name) args+      idents = List.map HsIdent letters+      args =  List.map (HsUnBangedTy . HsTyVar) $ genericTake arity idents+      vdecl tel = HsFunBind [ HsMatch dummyLoc hsname (nDummyArgs 0) rhs []]+      rhs = HsUnGuardedRhs $ HsVar $ unit_con_name+      hsname = dfName name+      nDummyArgs 0 = []+      nDummyArgs k = (HsPVar $ HsIdent ("v" ++ (show k))) : nDummyArgs (k-1)+	+processDef def@(qname,Defn { theDef = Constructor{} }) =+    return []++processDef def@(qname,Defn { theDef = Axiom{axHsDef = mhs} }) = return+  [HsFunBind [HsMatch dummyLoc hsid  [] rhs decls]] where+             rhs = HsUnGuardedRhs $ case mhs of+                    Just (HsDefn _ hs) -> hsVar hs+                    _                  -> hsError $ "axiom: " ++ show qname+             decls = []+             hsid = dfName name+             name = qnameName qname++processDef (qname,Defn { theDef = Primitive info prim expr }) = return $+  [HsFunBind [HsMatch dummyLoc hsid  [] rhs decls]] where+             -- rhs = HsUnGuardedRhs $ error $ "primitive: " ++ (show prim)+             rhs = HsUnGuardedRhs $ HsVar $ rtpQName prim+             decls = []+             hsid = dfName name+             name = qnameName qname++processDef (qname, (Defn { theDef = Datatype{dataClause = Just clause} })) = do+           -- liftIO $ putStrLn $ gshow $ clauseBod clause +    mkSynonym (clauseBod clause) where+    name = qnameName qname+    mkSynonym (Lam _ (Abs _ t)) = mkSynonym t+    mkSynonym (Def rhsqname args) = return [ddecl, vdecl] where+      ddecl = HsTypeDecl loc dname [] typ+      moduleName = qnameModule rhsqname+      hsModuleName = Module $ moduleStr moduleName+      vdecl = HsFunBind [ HsMatch dummyLoc hsname (nDummyArgs 0) rhs []]+      rhs = HsUnGuardedRhs $ HsVar $ unit_con_name+      hsname = dfName name+      loc = dummyLoc+      nDummyArgs 0 = []+      nDummyArgs k = (HsPVar $ HsIdent ("v" ++ (show k))) : nDummyArgs (k-1)+      dname = dataName name+      typ = HsTyCon $ Qual hsModuleName $ dataName $ qnameName rhsqname+    mkSynonym t = __IMPOSSIBLE__+{-          do+              liftIO $ putStrLn $ gshow t +              return []+-}++{-+  t <- normalise $ Def qname []+  mkSynonym t where+    name = qnameName qname+    mkSynonym (Lam _ (Abs _ t)) = mkSynonym t+    mkSynonym (Def newqn args) = return [ddecl, vdecl] where+      ddecl = HsTypeDecl loc dname [] typ+   +      loc = dummyLoc+      dname = dataName name+      typ = HsTyCon $ UnQual $ dataName $ qnameName newqn+    mkSynonym t = do+              liftIO $ putStrLn $ gshow t +              return []+-}+++-- error "Unimplemented: Datatype from module"++consForName dname qns = mapM (processCon dname)  qns++times :: Nat -> a -> [a]+times 0 x = []+times n x = x:(times (n-1) x)++processCon dname qn = do+  -- let id = nameId $ qnameName qn+  -- let NameId cn = id+  arity <- getConArity qn+  -- let arg = HsUnBangedTy $ HsTyCon unit_tycon_name+  let arg = HsUnBangedTy $ HsTyVar $ HsIdent "a"+  let idents =  List.map HsIdent letters+  let args =  List.map (HsUnBangedTy . HsTyVar) $ genericTake arity idents+  return $ HsConDecl dummyLoc (conName $ qnameName qn) args++{-+dummyCon :: Nat -> Nat -> HsConDecl+dummyCon i j = HsConDecl dummyLoc (mangleConName i j) []++mangleConName :: Nat -> Nat -> HsCode+-- mangleConName i j = (HsIdent $ "C"++(show i)++"_"++(show j))+mangleConName i j = (HsIdent $ "C"++(show j))+-}++-- consForData :: QName -> TCM [Definition]+-- consForData qn = undefined++consDefs :: [QName] -> TCM [Definition]+consDefs qns = do+  definitions <- getDefinitions+  return [definitions ! qn | qn <- qns]+++processClause :: Name -> Nat -> Clause -> TCM HsDecl+processClause name number clause@(Clause{ clausePerm = perm+                                        , clausePats = args+                                        , clauseBody = body+                                        }) = do+  reportSLn "comp.alonzo.clause" 20 $+    "processClause " ++ show name ++ "\n" +++    "  perm = " ++ show perm ++ "\n" +++    "  args = " ++ show args ++ "\n"+  ldefs <- getDefinitions+  let bodyPM = processBody body+      pst0   = initPState clause ldefs+  (exp, pst) <- runStateT bodyPM pst0+  let rhs = HsUnGuardedRhs exp+  (pats, pst2) <- runStateT (processArgPats args) pst+  return $ HsFunBind $ [HsMatch dummyLoc hsid pats rhs decls] +    where+                    decls = []+                    hsid = dfNameSub name $ fromIntegral number+                    -- pats =  processArgPats  args               +                    +contClause :: Name -> Nat -> Clause -> TCM HsDecl+contClause name number (Clause{ clausePats = args, clauseBody = body }) = do+  return $ HsFunBind $ [HsMatch dummyLoc hsid pats rhs decls] where+                decls = []+                hsid = dfNameSub name (fromIntegral number)+                rightLetters =  genericTake (length args) letters+                pats = List.map (HsPVar . HsIdent) rightLetters+                rhs = HsUnGuardedRhs exp+		exp = vecApp expfun expargs+                expfun = hsCast$ HsVar $ UnQual $ dfNameSub name (fromIntegral $ number+1)+                expargs = List.map (HsVar . UnQual . HsIdent) rightLetters++foldClauses :: Name -> Nat -> [Clause] -> TCM [HsDecl]+foldClauses name n [] = return []+foldClauses name n [c] = do+        decl <- processClause name n c+        return [decl]+foldClauses name n (c:cs) = do+	head <- processClause name n c+        cont <- contClause name n c+	tail <- foldClauses name (n+1) cs+	return (head:cont:tail)++processArgPats :: [Arg Pattern] -> PM [HsPat]+processArgPats args = mapM processArgPat args++processArgPat :: (Arg Pattern) -> PM HsPat+processArgPat (Arg hid pat) = processPat pat++processPat :: Pattern -> PM HsPat+processPat (VarP _) = do+  pats  <- getPlst+  case pats of+        [] -> do +	   c <- getPclause+	   error $ "Oops! empty pattern list in\n" ++ (gshow c)+	(p:ps) -> do+	  putPlst ps+	  return p++processPat (DotP _) = return HsPWildCard++processPat (ConP qname args) = do+  hsCode <- do+    def <- lift $ theDef <$> getConstInfo qname+    case def of+      Constructor{conHsCode = c} -> return c+      Record{}                   -> return Nothing  -- no COMPILED_DATA for records yet+      _                          -> __IMPOSSIBLE__+  cname <- case hsCode of+        Just (_, h)  -> return $ UnQual $ HsIdent h+        Nothing -> maybeQualConName qname+  hspats <- mapM processArgPat args+  return $ HsPParen $ HsPApp cname hspats++processPat (LitP (LitInt _ i)) = return $ HsPLit (HsInt i)+processPat (LitP (LitChar _ c)) = +  return $  HsPParen $ HsPApp (rtpCon "CharT") [HsPLit (HsChar c)]+processPat (LitP _) = error "Unimplemented literal patttern" +-- processPat (AbsurdP _) = return HsPWildCard++           +processBody :: ClauseBody -> PM HsExp+processBody (NoBind cb) = do +        addWildcard+	processBody cb +processBody (Bind (Abs name cb)) = do+	-- cnt <- getPcnt+	addVar+	incPcnt+	processBody cb++processBody (Body t) = processTerm t >>= (return . hsCast)+processBody NoBody = do+	putPlst (repeat HsPWildCard)+	return hsUndefined++processTerm :: Term -> PM HsExp+processTerm (Var n ts) = do+  cnt <- getPcnt+  processVap (hsVar $ "v" ++ (show (cnt - fromIntegral n - 1))) ts++processTerm (Def qn ts) = do+  x <- maybeQualDefName qn+  processVap (HsVar x) ts++-- Check if the con was redefined from other module+-- if so, use the original name+-- !!!+processTerm (Con qn ts) = do+  def <- lift $ theDef <$> getConstInfo qn+  case def of+    Constructor{conHsCode = Just (_, hs)} ->+        processVap (HsCon $ UnQual $ HsIdent hs) ts+    -- Can be a record constructor in which case the def will be for the record.+    _ -> do+      ldefs <- getPDefs+      if (Map.member qn ldefs) +        then do +          definiens <- case theDef <$> Map.lookup qn ldefs of+                          Just df -> return df+                          Nothing -> fail $ "Alonzo: No such definition: " ++ show qn+          case definiens of+            Constructor{conSrcCon = origqn} -> do+              x <- maybeQualConName origqn+              processVap (HsCon x) ts+            _ -> do+              x <- maybeQualConName qn+              processVap (HsCon x) ts+        else do+          x <- maybeQualConName qn+          processVap (HsCon x) ts++processTerm (Lam h (Abs n t)) = do+  cnt <- getPcnt+  incPcnt+  exp <- processTerm t+  return $ hsLam ("v" ++ show cnt)  exp+processTerm (Lit l) = return $  (processLit l)+processTerm (Pi arg abs) = return $ HsVar  unit_con_name+processTerm (Fun arg typ) = return $ HsVar  unit_con_name+processTerm (Sort s) =  return $ HsVar  unit_con_name+processTerm (MetaV _ _) =  error "Can't have metavariables"++-- processTerm t =  return hsUndefined++processLit :: Literal -> HsExp+processLit (LitInt _ i) =  HsApp toNat $ intLit i where+	intLit i = HsParen $ hsPreludeTypedExp "Integer" $ HsLit $ HsInt i+	toNat = HsVar $ Qual (Module "RTP") $ HsIdent "_primIntegerToNat"+processLit (LitFloat _ f) =  hsPreludeTypedExp "Double" $ +						HsLit $ HsFrac $ toRational f+-- processLit (LitFloat _ f) =  HsApp (HsVar $ rtpCon "FloatT")+--                                   (HsLit $ HsFrac $ toRational f)+processLit (LitString _ s) =  HsLit $ HsString s+processLit (LitChar _ c) =  HsApp (HsVar $ rtpCon "CharT")+                                  (HsLit $ HsChar c)++processVap :: HsExp -> [Arg Term] -> PM HsExp+processVap e ts = do+  p <- get+  lift $ unfoldVap p e ts++unfoldVap :: PState -> HsExp -> [Arg Term] -> TCM HsExp+unfoldVap _ e [] = return e+unfoldVap p e ((Arg NotHidden t):ts) = do+  e1 <- evalStateT (processTerm t) p+  unfoldVap p (hsAp e e1) ts+-- unfoldVap p e ((Arg Hidden t):ts) = unfoldVap p e ts +unfoldVap p e ((Arg Hidden t):ts) = do+  e1 <- evalStateT (processTerm t) p+  unfoldVap p (hsAp e e1) ts++++getDefinitions :: TCM Definitions+getDefinitions = do+  sig <- gets stSignature+  let definitions = sigDefinitions sig -- :: Map QName Definition+  idefs <- sigDefinitions <$> getImportedSignature+  return (definitions `Map.union` idefs)++++getConArities cs = mapM getConArity cs++getConArity :: QName -> TCM Nat+getConArity qn = do+        Defn _ ty _ _ Constructor{conPars = np} <- getConstInfo qn        +	ty' <- normalise ty+        return $ typeArity ty' - np+        -- return $ arity ty'++typeArity :: Type -> Nat+typeArity (El s t) = ar t where+    ar (Pi _ (Abs _ t2)) = typeArity t2 + 1+    ar (Fun a t2) = typeArity t2 + 1+    ar _ = 0++clauseBod :: Clause -> Term+clauseBod c = stripBinds (clauseBody c) where+  stripBinds (Bind (Abs _ r)) = stripBinds r+  stripBinds (NoBind r) = stripBinds r+  stripBinds (Body r) = r+  stripBinds (NoBody) = __IMPOSSIBLE__++letters = ["a", "b", "c", "d", "e", "f", "g", "h", "i", "k", "m", "n", "p","q"]++vecApp :: HsExp -> [HsExp] -> HsExp+vecApp e [] = e+vecApp e (a:as) = vecApp (HsApp e a) as+

+ src/full/Agda/Compiler/Alonzo/Names.hs view

@@ -0,0 +1,66 @@+module Agda.Compiler.Alonzo.Names where++import Data.List+import Language.Haskell.Syntax+import Agda.Syntax.Abstract.Name+import Agda.Syntax.Common++conStr :: Name -> String+conStr n = "C" ++ (show $ numOfName n)++dfStr :: Name -> String+dfStr n = "d" ++ (show $ numOfName n)+-- dfStr (Name (NameId i) c) = "d" ++ (show i)++conQStr :: QName -> String+conQStr qn = "C" ++ (show $ numOfQName qn)++dfQStr :: QName -> String+dfQStr qn = "d" ++ (show $ numOfQName qn)++-- For now a hack that allows hierarhical modules, but not local modules(?)+moduleStr :: ModuleName -> String+-- moduleStr m = show m+moduleStr (MName []) = error "Empty module list!"+moduleStr (MName ns) = intercalate "." (map show ns)++conName :: Name -> HsName+conName = HsIdent . conStr++dataName :: Name -> HsName+dataName n = HsIdent $ "T" ++ (show (numOfName n))++-- dataQName :: QName -> HsQName+-- dataQName n = HsIdent $ "T" ++ (show (numOfName n))++dfName :: Name -> HsName+dfName = HsIdent . dfStr++dfNameSub :: Name -> Int -> HsName+dfNameSub name i = HsIdent id where+	id = (dfStr name) ++ "_" ++  (show i)++dfQName :: QName -> HsQName+dfQName (QName m n) +  | (moduleStr m) == "RTP" = Qual (Module $ moduleStr m)(HsIdent $ "_"++(show n))+  | otherwise = Qual (Module $ moduleStr m) (dfName n)++conQName :: QName -> HsQName+conQName (QName m n)+  |(moduleStr m)=="RTP" = Qual (Module $ moduleStr m)  (HsIdent $ show n)+  | otherwise = Qual (Module $ moduleStr m) (conName n)++numOfName :: Name -> Nat+numOfName n = i where+	id = nameId n+        (NameId i mi) = id+++numOfQName :: QName -> Nat+-- numOfQName (QName m (Name (NameId i) nc) ) = i+numOfQName = numOfName . qnameName+++rtpQName :: String -> HsQName+rtpQName s = Qual (Module "RTP")(HsIdent $ ('_':s))+rtpCon s = Qual (Module "RTP")(HsIdent s)

+ src/full/Agda/Compiler/Alonzo/PatternMonad.hs view

@@ -0,0 +1,68 @@+module Agda.Compiler.Alonzo.PatternMonad where+import Agda.Syntax.Internal+import Agda.TypeChecking.Monad.Base++import Control.Monad.State+import Control.Monad.Error++import qualified Data.Map+import Data.Map (Map)++import Language.Haskell.Syntax+import Agda.TypeChecking.Monad+import Agda.Utils.Permutation+import Agda.Utils.Size++type Defs =  Map QName Definition+data PState = PSt +  { cnt :: Int+  , vars :: [Int]+  , lst :: [HsPat]+  , clause :: Clause+  , defs :: Defs+  }++initPState :: Clause -> Defs -> PState+initPState c@(Clause{ clausePerm = perm }) d = PSt +  { cnt = 0+  , vars = permute perm [0..]+  , lst = []+  , clause = c +  , defs = d+  }++type PM a = StateT PState TCM a++getPDefs :: PM Defs+getPDefs = gets defs++getPcnt :: PM Int+getPcnt = gets cnt++getPlst :: PM [HsPat]+getPlst = gets lst++getPclause :: PM Clause+getPclause = gets clause++putPlst :: [HsPat] -> PM()+putPlst newlst = modify $ \s -> s { lst = newlst }++putPcnt :: Int -> PM()+putPcnt newcnt = modify $ \s -> s { cnt = newcnt }++incPcnt :: PM()+incPcnt = modify $ \s -> s { cnt = 1 + cnt s }++addWildcard :: PM()+addWildcard = do +        lst <- getPlst+        putPlst $ lst++[HsPWildCard]++addVar :: PM()+addVar = do+        lst <- getPlst+        s <- get+        let v : vs = vars s+        put $ s { vars = vs }+        putPlst $ lst++[HsPVar(HsIdent ("v" ++ show v))]

+ src/full/Agda/Compiler/HaskellTypes.hs view

@@ -0,0 +1,117 @@+{-# LANGUAGE CPP #-}++-- | Translating Agda types to Haskell types. Used to ensure that imported+--   Haskell functions have the right type.++module Agda.Compiler.HaskellTypes where++import Control.Applicative+import Control.Monad.Error+import Data.Char++import Agda.Syntax.Common+import Agda.Syntax.Internal+import Agda.TypeChecking.Monad+import Agda.TypeChecking.Pretty+import Agda.TypeChecking.Reduce+import Agda.TypeChecking.Substitute+import Agda.TypeChecking.Free+import Agda.Utils.Monad+import Agda.Utils.Impossible++#include "../undefined.h"++type HaskellKind = String++hsStar :: HaskellKind+hsStar = "*"++hsKFun :: HaskellKind -> HaskellKind -> HaskellKind+hsKFun k l = "(" ++ k ++ " -> " ++ l ++ ")"++hsFun :: HaskellKind -> HaskellKind -> HaskellKind+hsFun a b = "(" ++ a ++ " -> " ++ b ++ ")"++hsVar :: Name -> HaskellType+hsVar x = "x" ++ concatMap encode (show x)+  where+    okChars = ['a'..'z'] ++ ['A'..'Y'] ++ "_'"+    encode 'Z' = "ZZ"+    encode c+      | c `elem` okChars = [c]+      | otherwise        = "Z" ++ show (fromEnum c)+++hsApp :: String -> [HaskellType] -> HaskellType+hsApp d [] = d+hsApp d as = "(" ++ unwords (d : as) ++ ")"++hsForall :: String -> HaskellType -> HaskellType+hsForall x a = "(forall " ++ x ++ ". " ++ a ++ ")"++notAHaskellKind :: MonadTCM tcm => Type -> tcm a+notAHaskellKind a = do+  err <- fsep $ pwords "The type" ++ [prettyTCM a] +++                pwords "cannot be translated to a Haskell kind."+  typeError $ GenericError $ show err++notAHaskellType :: MonadTCM tcm => Type -> tcm a+notAHaskellType a = do+  err <- fsep $ pwords "The type" ++ [prettyTCM a] +++                pwords "cannot be translated to a Haskell type."+  typeError $ GenericError $ show err++getHsType :: MonadTCM tcm => QName -> tcm HaskellType+getHsType x = do+  d <- theDef <$> getConstInfo x+  case d of+    Axiom{ axHsDef = Just (HsType t) } -> return t+    Datatype{ dataHsType = Just t }    -> return t+    _                                  -> notAHaskellType (El Prop $ Def x [])++getHsVar :: MonadTCM tcm => Nat -> tcm HaskellCode+getHsVar i = hsVar <$> nameOfBV i++isHaskellKind :: Type -> TCM Bool+isHaskellKind a =+  (const True <$> haskellKind a) `catchError` \_ -> return False++haskellKind :: MonadTCM tcm => Type -> tcm HaskellKind+haskellKind a = do+  a <- reduce a+  case unEl a of+    Sort _  -> return hsStar+    Pi a b  -> hsKFun <$> haskellKind (unArg a) <*> underAbstraction a b haskellKind+    Fun a b -> hsKFun <$> haskellKind (unArg a) <*> haskellKind b+    _       -> notAHaskellKind a++haskellType :: MonadTCM tcm => Type -> tcm HaskellType+haskellType = liftTCM . fromType+  where+    fromArgs = mapM (fromTerm . unArg)+    fromType = fromTerm . unEl+    fromTerm v = do+      v <- reduce v+      case v of+        Var x args -> hsApp <$> getHsVar x <*> fromArgs args+        Def d args -> hsApp <$> getHsType d <*> fromArgs args+        Fun a b    -> hsFun <$> fromType (unArg a) <*> fromType b+        Pi a b ->+          ifM (isHaskellKind $ unArg a)+          (underAbstraction a b $ \b -> do+              x <- getHsVar 0+              b <- fromType b+              return $ hsForall x $ hsFun "()" b+          )+          (if 0 `freeIn` absBody b+           then notAHaskellType (El Prop v)+           else hsFun <$> fromType (unArg a) <*> fromType (absApp b __IMPOSSIBLE__)+          )+        Con{}      -> notAHaskellType (El Prop v)+        Lam{}      -> notAHaskellType (El Prop v)+        Lit{}      -> notAHaskellType (El Prop v)+        Sort{}     -> notAHaskellType (El Prop v)+        MetaV{}    -> notAHaskellType (El Prop v)+++

+ src/full/Agda/Compiler/MAlonzo/Compiler.hs view

@@ -0,0 +1,314 @@+{-# LANGUAGE CPP #-}++module Agda.Compiler.MAlonzo.Compiler where++import Control.Applicative+import Control.Monad.Reader+import Control.Monad.State+import Data.Char+import Data.List as L+import Data.Map as M+import Data.Set as S+import Language.Haskell.Syntax+import System.Cmd+import System.Directory+import System.Exit+import System.IO+import qualified System.IO.UTF8 as UTF8+import System.Time+import System.Process+import System.FilePath ((</>))++import Agda.Compiler.MAlonzo.Misc+import Agda.Compiler.MAlonzo.Pretty+import Agda.Compiler.MAlonzo.Primitives+import Agda.Interaction.Imports+import Agda.Interaction.Monad+import Agda.Interaction.Options+import Agda.Syntax.Common+import Agda.Syntax.Internal+import Agda.Syntax.Literal+import Agda.TypeChecking.Monad+import Agda.TypeChecking.Monad.Options+import Agda.TypeChecking.Reduce+import Agda.TypeChecking.Pretty+import Agda.Utils.FileName+import Agda.Utils.Monad+import Agda.Utils.Impossible++#include "../../undefined.h"++compilerMain :: TCM Interface -> TCM ()+compilerMain typecheck = do+  i <- typecheck+  ignoreAbstractMode $ do+    t <- liftIO getClockTime+    let mainICT = (i, t)+    mapM_ compile =<< ((mainICT :) . M.elems <$> getVisitedModules)+    callGHC mainICT++compile :: (Interface, ClockTime) -> TCM ()+compile ict = do+  setInterface ict+  ifM uptodate noComp $ (yesComp >>) $ do+    writeModule =<< decl <$> curHsMod <*> (definitions =<< curDefs) <*> imports+  where+  decl mn ds imp = HsModule dummy mn Nothing imp ds+  uptodate = liftIO =<< (isNewerThan <$> outFile <*> ifile)+  ifile    = findFile InterfaceFile =<< curMName+  noComp   = reportSLn "" 1 . (++ " : no compilation is needed.").show =<< curMName+  yesComp  = reportSLn "" 1 . (`repl` "Compiling <<0>> in <<1>> to <<2>>") =<<+             sequence [show <$> curMName, ifile, outFile] :: TCM ()++--------------------------------------------------+-- imported modules+--   I use stImportedModules in a non-standard way,+--   accumulating in it what are acutally used in Misc.xqual+--------------------------------------------------++imports :: TCM [HsImportDecl]+imports = (++) <$> unqualImps <*> qualImps where+  unqualImps = (L.map (decl False) . (unsafeCoerceMod :) . L.map Module) <$>+               getHaskellImports+  qualImps   = L.map (decl True) . uniq <$>+               ((++) <$> importsForPrim <*> (L.map mazMod <$> mnames))+  decl qual m = HsImportDecl dummy m qual Nothing Nothing+  mnames      = (++) <$> (S.elems <$> gets stImportedModules)+                     <*> (iImportedModules <$> curIF)+  uniq        = L.map head . group . L.sort++--------------------------------------------------+-- Main compiling clauses+--------------------------------------------------++definitions :: Definitions -> TCM [HsDecl]+definitions = M.fold (liftM2(++).(definition<.>instantiateFull)) declsForPrim++definition :: Definition -> TCM [HsDecl]+definition (Defn q ty _ _ d) = do+  checkTypeOfMain q ty+  (infodecl q :) <$> case d of+    Axiom{ axHsDef = Just (HsDefn ty hs) } -> return $ fbWithType ty (fakeExp hs)+    Axiom{}                                -> return $ fb axiomErr+    Function{ funClauses = cls } -> mkwhere <$> mapM (clause q) (tag 0 cls)+    Datatype{ dataPars = np, dataIxs = ni, dataClause = cl, dataCons = cs, dataHsType = Just ty } -> do+      ccs <- concat <$> mapM checkConstructorType cs+      cov <- checkCover q ty np cs+      return $ tvaldecl q 0 (np + ni) [] (Just __IMPOSSIBLE__) ++ ccs ++ cov+    Datatype{ dataPars = np, dataIxs = ni, dataClause = cl, dataCons = cs, dataHsType = Nothing } -> do+      (ars, cds) <- unzip <$> mapM condecl cs+      return $ tvaldecl q (maximum (np:ars) - np) (np + ni) cds cl+    Constructor{} -> return []+    Record{ recClause = cl, recFields = flds } -> do+      ar <- arity <$> normalise ty+      return $ tvaldecl q (genericLength flds) ar [cdecl q (genericLength flds)] cl  +    Primitive{ primName = s } -> fb <$> primBody s+  where+  tag _ []       = []+  tag i [cl]     = (i, True , cl): []+  tag i (cl:cls) = (i, False, cl): tag (i + 1) cls+  mkwhere (HsFunBind [m0, HsMatch _     dn ps rhs [] ] : fbs@(_:_)) =+          [HsFunBind [m0, HsMatch dummy dn ps rhs fbs]]+  mkwhere fbs = fbs+  fbWithType ty e =+    [ HsTypeSig dummy [unqhname "d" q] $ fakeType ty ] ++ fb e+  fb e  =[HsFunBind[HsMatch dummy (unqhname "d" q)[] (HsUnGuardedRhs $ e) []]]+  axiomErr = rtmError $ "postulate evaluated: " ++ show q++checkConstructorType :: QName -> TCM [HsDecl]+checkConstructorType q = do+  Constructor{ conHsCode = Just (ty, hs) } <- theDef <$> getConstInfo q+  return [ HsTypeSig dummy [unqhname "check" q] $ fakeType ty+         , HsFunBind [HsMatch dummy (unqhname "check" q) [] (HsUnGuardedRhs $ fakeExp hs) []]+         ]++checkCover :: QName -> HaskellType -> Nat -> [QName] -> TCM [HsDecl]+checkCover q ty n cs = do+  let tvs = [ "a" ++ show i | i <- [1..n] ]+      makeClause c = do+        a <- constructorArity c+        Just (_, hsc) <- conHsCode . theDef <$> getConstInfo c+        let pat = HsPApp (UnQual $ HsIdent hsc) $ genericReplicate a HsPWildCard+        return $ HsAlt dummy pat (HsUnGuardedAlt $ HsTuple []) []+  cs <- mapM makeClause cs+  let rhs = case cs of+              [] -> fakeExp "()" -- There is no empty case statement in Haskell+              _  -> HsCase (HsVar $ UnQual $ HsIdent "x") cs++  return [ HsTypeSig dummy [unqhname "cover" q] $ fakeType $ unwords (ty : tvs) ++ " -> ()"+         , HsFunBind [HsMatch dummy (unqhname "cover" q) [HsPVar $ HsIdent "x"]+            (HsUnGuardedRhs rhs) []]+         ]++-- | Move somewhere else!+constructorArity :: MonadTCM tcm => QName -> tcm Nat+constructorArity q = do+  def <- getConstInfo q+  a <- normalise $ defType def+  case theDef def of+    Constructor{ conPars = np } -> return $ arity a - np+    _ -> fail $ "constructorArity: non constructor: " ++ show q++clause :: QName -> (Nat, Bool, Clause) -> TCM HsDecl+clause q (i, isLast, Clause{ clausePats = ps, clauseBody = b }) =+  HsFunBind . (: cont) <$> main where+  main = match <$> argpatts ps (bvars b (0::Nat)) <*> clausebody b+  cont | isLast && any isCon ps = [match (L.map HsPVar cvs) failrhs]+       | isLast                 = []+       | otherwise              = [match (L.map HsPVar cvs) crhs]+  cvs  = L.map (ihname "v") [0 .. genericLength ps - 1]+  crhs = hsCast$ foldl HsApp (hsVarUQ $ dsubname q (i + 1)) (L.map hsVarUQ cvs)+  failrhs = rtmError $ "incomplete pattern matching: " ++ show q+  match hps rhs = HsMatch dummy (dsubname q i) hps (HsUnGuardedRhs rhs) []+  bvars (Body _)          _ = []+  bvars (Bind (Abs _ b')) n = HsPVar (ihname "v" n) : bvars b' (n + 1)+  bvars (NoBind      b' ) n = HsPWildCard           : bvars b' n+  bvars NoBody            _ = repeat HsPWildCard -- ?++  isCon (Arg _ ConP{}) = True+  isCon _              = False++argpatts :: [Arg Pattern] -> [HsPat] -> TCM [HsPat]+argpatts ps0 bvs = evalStateT (mapM pat' ps0) bvs where+  pat (VarP _   ) = do v <- gets head; modify tail; return v+  pat (DotP _   ) = pat (VarP dummy)+  pat (ConP q ps) = (HsPParen .).HsPApp <$> lift (conhqn q) <*> mapM pat' ps+  pat (LitP l   ) = return $ HsPLit $ hslit l+  pat' = pat . unArg++clausebody :: ClauseBody -> TCM HsExp+clausebody b0 = runReaderT (go b0) 0 where+  go (Body   tm       ) = hsCast <$> term tm+  go (Bind   (Abs _ b)) = local (1+) $ go b+  go (NoBind b        ) = go b+  go NoBody             = return$ rtmError$ "Impossible Clause Body"++term :: Term -> ReaderT Nat TCM HsExp+term tm0 = case tm0 of+  Var   i as -> do n <- ask; apps (hsVarUQ $ ihname "v" (n - i - 1)) as+  Lam   _ at -> do n <- ask; HsLambda dummy [HsPVar $ ihname "v" n] <$>+                              local (1+) (term $ absBody at)+  Lit   l    -> lift $ literal l+  Def   q as -> (`apps` as) . HsVar =<< lift (xhqn "d" q)+  Con   q as -> (`apps` as) . HsCon =<< lift (conhqn q)+  Pi    _ _  -> return unit_con+  Fun   _ _  -> return unit_con+  Sort  _    -> return unit_con+  MetaV _ _  -> mazerror "hit MetaV"+  where apps =  foldM (\h a -> HsApp h <$> term (unArg a))++literal :: Literal -> TCM HsExp+literal l = case l of+  LitInt    _ _   -> do toN <- bltQual "NATURAL" mazIntegerToNat+                        return $ HsVar toN `HsApp` typed "Integer"+  LitFloat  _ _   -> return $ typed "Double"+  _               -> return $ l'+  where l'    = HsLit $ hslit l+        typed = HsExpTypeSig dummy l' . HsQualType [] . HsTyCon . rtmQual ++hslit :: Literal -> HsLiteral+hslit l = case l of LitInt    _ x -> HsInt    x+                    LitFloat  _ x -> HsFrac   (toRational x)+                    LitString _ x -> HsString x +                    LitChar   _ x -> HsChar   x++condecl :: QName -> TCM (Nat, HsConDecl)+condecl q = getConstInfo q >>= \d -> case d of+  Defn _ ty _ _ (Constructor {conPars = np}) -> do ar <- arity <$> normalise ty+                                                   return $ (ar, cdecl q (ar - np))+  _ -> mazerror $ "condecl:" ++ gshow' (q, d)++cdecl :: QName -> Nat -> HsConDecl+cdecl q n = HsConDecl dummy (unqhname "C" q)+            [ HsUnBangedTy $ HsTyVar $ ihname "a" i | i <- [0 .. n - 1]]++tvaldecl :: QName -> Nat -> Nat -> [HsConDecl] -> Maybe Clause -> [HsDecl]+tvaldecl q ntv npar cds cl = let+    (tn, vn) = (unqhname "T" q, unqhname "d" q)+    tvs = [          ihname "a" i | i <- [0 .. ntv  - 1]]+    pvs = [ HsPVar $ ihname "a" i | i <- [0 .. npar - 1]]+  in HsFunBind [HsMatch dummy vn pvs (HsUnGuardedRhs unit_con) []] :+     maybe [HsDataDecl dummy [] tn tvs cds []] (const []) cl++infodecl :: QName -> HsDecl+infodecl q = fakeD (unqhname "name" q) $ show (show q)++--------------------------------------------------+-- Inserting unsafeCoerce+--------------------------------------------------++hsCast :: HsExp -> HsExp+{-+hsCast = addcast . go where+  addcast [e@(HsVar(UnQual(HsIdent(c:ns))))] | c == 'v' && all isDigit ns = e+  addcast es = foldl HsApp mazCoerce es+  -- this need to be extended if you generate other kinds of exps.+  go (HsApp e1 e2    ) = go e1 ++ [hsCast e2]+  go (HsLambda _ ps e) = [ HsLambda dummy ps (hsCast e) ]+  go e = [e]+-}++hsCast e = mazCoerce `HsApp` hsCast' e+hsCast' (HsApp e1 e2)     = hsCast' e1 `HsApp` (mazCoerce `HsApp` hsCast' e2)+hsCast' (HsLambda _ ps e) = HsLambda dummy ps $ hsCast' e+hsCast' e = e++--------------------------------------------------+-- Writing out a haskell module+--------------------------------------------------++writeModule :: HsModule -> TCM ()+writeModule m =+  liftIO . (`UTF8.writeFile` (preamble ++ prettyPrint m)) =<< outFile+  where+  preamble = unlines $ [ "{-# LANGUAGE EmptyDataDecls"+                       , "           , ExistentialQuantification"+                       , "           , ScopedTypeVariables"+                       , "           , UnicodeSyntax"+                       , "           , NoMonomorphismRestriction"+                       , "  #-}"+                       ]++outFile' = do+  mdir <- gets (optMAlonzoDir . stOptions)+  (fdir, fn, _) <- splitFilePath . repldot slash . prettyPrint <$> curHsMod+  let (dir, fp) = (addSlash mdir ++ fdir, addSlash dir ++ fn ++ ".hs")+  liftIO $ createDirectoryIfMissing True dir+  return (mdir, fp)+  where+  repldot c = L.map (\c' -> if c' == '.' then c else c')++outFile :: TCM FilePath+outFile = snd <$> outFile'+           +callGHC :: (Interface, ClockTime) -> TCM ()+callGHC mainICT = do+  setInterface mainICT+  mdir          <- optMAlonzoDir <$> commandLineOptions+  hsmod         <- prettyPrint <$> curHsMod+  MName agdaMod <- curMName+  let outputName = case agdaMod of+        [] -> __IMPOSSIBLE__+        ms -> last ms+  (mdir, fp) <- outFile'+  opts       <- gets (optGhcFlags . stOptions)+  let overridableArgs =+        [ "-O"+        , "-o", mdir </> show outputName+        ]+      otherArgs       =+        [ "-i" ++ mdir+        , "-main-is", hsmod+        , fp+        , "--make"+        , "-fwarn-incomplete-patterns"+        , "-fno-warn-overlapping-patterns"+        , "-Werror"+        ]+      args     = overridableArgs ++ opts ++ otherArgs+      compiler = "ghc"+  reportSLn "" 1 $ "calling: " ++ L.intercalate " " (compiler : args)+  (exitcode, out, err) <- liftIO $ readProcessWithExitCode compiler args ""+  case exitcode of+    ExitFailure _ -> typeError $ CompilationError $ out ++ "\n" ++ err+    _             -> return ()

+ src/full/Agda/Compiler/MAlonzo/Encode.hs view

@@ -0,0 +1,101 @@+------------------------------------------------------------------------+-- Module name encoding+------------------------------------------------------------------------++module Agda.Compiler.MAlonzo.Encode+  ( encodeModuleName+  , tests+  ) where++import Data.Char+import Data.Function+import Data.List+import Language.Haskell.Syntax+import Test.QuickCheck++import Agda.Utils.QuickCheck+import Agda.Utils.TestHelpers++-- | Can the character be used in a Haskell module name part+-- (@conid@)? This function is more restrictive than what the Haskell+-- report allows.++isModChar :: Char -> Bool+isModChar c =+  isLower c || c == '_' || isUpper c || isDigit c || c == '\''++-- | Haskell module names have to satisfy the Haskell (including the+-- hierarchical module namespace extension) lexical syntax:+--+--   @modid -> [modid.] large {small | large | digit | ' }@+--+-- 'encodeModuleName' is an injective function into the set of module+-- names defined by @modid@. The function often preserves names. The+-- function always preserves @.@s.+--+-- Precondition: The input must not start or end with @.@, and no two+-- @.@s may be adjacent.++encodeModuleName :: Module -> Module+encodeModuleName (Module s) = Module (concatMap encNamePart $ splitUp s)+  where+  -- splitUp ".apa.bepa." == [".","apa",".","bepa","."]+  splitUp = groupBy ((&&) `on` (/= '.'))++  encNamePart "." = "."+  encNamePart s   = ensureFirstCharLarge s ++ concatMap enc s++  ensureFirstCharLarge s = case s of+    c : cs | isUpper c -> ""+    _                  -> "M"++  isOK c = c /= 'Z' && isModChar c++  enc c | isOK c    = [c]+        | otherwise = "Z" ++ show (fromEnum c) ++ "Z"++-- Note: This injectivity test is quite weak. A better, dedicated+-- generator could strengthen it.++prop_encodeModuleName_injective (M s1) (M s2) =+  if encodeModuleName (Module s1) == encodeModuleName (Module s2) then+    s1 == s2+   else+    True++prop_encodeModuleName_OK (M s) =+  s ~= unM (encodeModuleName (Module s))+  where+  ""        ~= ""         = True+  ('.' : s) ~= ('.' : s') = s ~= s'+  s         ~= (c : s')   = isUpper c && all isModChar s1' &&+                            dropWhile (/= '.') s ~= s2'+                              where (s1', s2') = span (/= '.') s'+  _         ~= _          = False++  unM (Module s) = s++-- | Agda module names. Used to test 'encodeModuleName'.++newtype M = M String deriving (Show)++instance Arbitrary M where+  arbitrary = do+    ms <- choose (0, 2)+    m <- vectorOf ms namePart+    return $ M (intercalate "." m)+    where+    namePart = do+      cs <- choose (1, 2)+      vectorOf cs (elements "a_AZ0'-∀")++------------------------------------------------------------------------+-- All tests++-- | All the properties.++tests :: IO Bool+tests = runTests "Agda.Compiler.MAlonzo.Encode"+  [ quickCheck' prop_encodeModuleName_injective+  , quickCheck' prop_encodeModuleName_OK+  ]

+ src/full/Agda/Compiler/MAlonzo/Misc.hs view

@@ -0,0 +1,203 @@+{-# LANGUAGE CPP #-}++module Agda.Compiler.MAlonzo.Misc where++import Control.Monad.State+import Data.Generics+import Data.Generics.Aliases+import Data.List as L+import Data.Map as M+import Data.Set as S+import Data.Maybe+import Data.Function+import Language.Haskell.Syntax+import System.IO+import System.Time++import Agda.Interaction.Imports+import Agda.Interaction.Monad+import Agda.Syntax.Common+import qualified Agda.Syntax.Concrete.Name as C+import Agda.Syntax.Internal+import Agda.Syntax.Position+import Agda.Syntax.Scope.Base+import Agda.Syntax.Translation.ConcreteToAbstract+import Agda.TypeChecking.Monad+import Agda.TypeChecking.Monad.Builtin+import Agda.Utils.FileName+import Agda.Utils.Monad++import Agda.Utils.Impossible+#include "../../undefined.h"++--------------------------------------------------+-- Setting up Interface before compile+--------------------------------------------------++-- find the abstract module name from the given file name+mnameFromFileName :: TCM () -> FilePath -> TCM ModuleName+mnameFromFileName typecheck = (sigMName <$>) .+  (maybe (typecheck>> getSignature) (return . iSignature) =<<) .+  liftIO . readInterface . setExtension ".agdai"++-- the known module name used to find the current interface+mazCurrentMod = "MazCurrentModule"++setInterface :: (Interface, ClockTime) -> TCM ()+setInterface (i,t) = do modify $ \s -> s{ stImportedModules = S.empty+                                        , stHaskellImports  = iHaskellImports i+                                        }+                        (`uncurry` (i,t)) . visitModule =<< mazCurMName++mazCurMName :: TCM ModuleName+mazCurMName = maybe firstTime return .  L.lookup mazCurrentMod .+              L.map (\m -> (show m, m)) . keys =<< getVisitedModules+  where firstTime = concreteToAbstract_ . NewModuleQName . C.QName $+                    C.Name noRange [C.Id mazCurrentMod]++curIF :: TCM Interface+curIF = do+  m  <- mazCurMName+  mi <- M.lookup m <$> getVisitedModules+  case mi of+    Just (i, _) -> return i+    Nothing     -> fail $ "No such module: " ++ show m++curSig :: TCM Signature+curSig = iSignature <$> curIF++curMName :: TCM ModuleName+curMName = sigMName <$> curSig++curHsMod :: TCM Module+curHsMod = mazMod <$> curMName++curDefs :: TCM Definitions+curDefs = sigDefinitions <$> curSig++sigMName :: Signature -> ModuleName+sigMName sig = case M.keys (sigSections sig) of+  []    -> __IMPOSSIBLE__+  m : _ -> m++--------------------------------------------------+-- utilities for haskell names+--------------------------------------------------++ihname :: String -> Nat -> HsName+ihname s i = HsIdent $ s ++ show i++unqhname :: String -> QName -> HsName+unqhname s q | ("d", "main") == (s, show(qnameName q)) = HsIdent "main"+             | otherwise = ihname s (idnum $ nameId $ qnameName $ q)+  where idnum (NameId x _) = fromIntegral x++-- the toplevel module containing the given one+tlmodOf :: ModuleName -> TCM Module+tlmodOf = fmap mazMod . tlmname++tlmname :: ModuleName -> TCM ModuleName+tlmname m = do+  ms <- sortBy (compare `on` (length . mnameToList)) .+        L.filter (flip (isPrefixOf `on` mnameToList) m) <$>+        ((:) <$> curMName <*> (keys <$> getVisitedModules))+  return $ case ms of (m' : _) -> m'; _ -> mazerror$ "tlmodOf: "++show m++-- qualify HsName n by the module of QName q, if necessary;+-- accumulates the used module in stImportedModules at the same time.+xqual :: QName -> HsName -> TCM HsQName+xqual q n = do m1 <- tlmname (qnameModule q)+               m2 <- curMName+               if m1 == m2 then return (UnQual n)+                  else addImport m1 >> return (Qual (mazMod m1) n)++xhqn :: String -> QName -> TCM HsQName+xhqn s q = xqual q (unqhname s q)++-- always use the original name for a constructor even when it's redefined.+conhqn :: QName -> TCM HsQName+conhqn q = do+    cq   <- canonicalName q+    defn <- theDef <$> getConstInfo cq+    case defn of Constructor{conHsCode = Just (_, hs)} -> return $ UnQual $ HsIdent hs+                 _                                     -> xhqn "C" cq++-- qualify name s by the module of builtin b+bltQual :: String -> String -> TCM HsQName+bltQual b s = do (Def q _) <- getBuiltin b; xqual q (HsIdent s) ++-- sub-naming for cascaded definitions for concsecutive clauses+dsubname q i | i == 0    = unqhname "d"                     q+             | otherwise = unqhname ("d_" ++ show i ++ "_") q++hsVarUQ :: HsName -> HsExp+hsVarUQ = HsVar . UnQual++--------------------------------------------------+-- Hard coded module names+--------------------------------------------------++mazstr  = "MAlonzo"+mazName = mkName_ dummy mazstr+mazMod' s = Module $ mazstr ++ "." ++ s+mazMod :: ModuleName -> Module+mazMod = mazMod' . show+mazerror msg = error $ mazstr ++ ": " ++ msg+mazCoerce = hsVarUQ $ HsIdent "unsafeCoerce"++-- for Runtime module: Not really used (Runtime modules has been abolished).+rtmMod  = mazMod' "Runtime"+rtmQual = UnQual . HsIdent+rtmVar  = HsVar . rtmQual+rtmError s = rtmVar "error" `HsApp` +             (HsLit $ HsString $ "MAlonzo Runtime Error: " ++ s)++unsafeCoerceMod = Module "Unsafe.Coerce"++--------------------------------------------------+-- Sloppy ways to declare <name> = <string>+--------------------------------------------------++fakeD :: HsName -> String -> HsDecl+fakeD v s = HsFunBind [HsMatch dummy v []+                      (HsUnGuardedRhs $ hsVarUQ $ HsIdent $ s) [] ]++fakeDS :: String -> String -> HsDecl+fakeDS = fakeD . HsIdent++fakeDQ :: QName -> String -> HsDecl+fakeDQ = fakeD . unqhname "d"++fakeType :: String -> HsQualType+fakeType = HsQualType [] . HsTyVar . HsIdent++fakeExp :: String -> HsExp+fakeExp = HsVar . UnQual . HsIdent++dummy :: a+dummy = error "MAlonzo : this dummy value should not have been eval'ed."+    ++--------------------------------------------------+-- For Debugging+--------------------------------------------------+gshow' :: Data a => a -> String+gshow' = ( \t ->+           "("+           ++ showConstr (toConstr t)+           ++ concat (gmapQ ((++) " " . gshow') t)+           ++ ")" )+         `extQ` (show :: String -> String)+         `extQ` (show :: Name -> String)+         `extQ` (show :: QName -> String)+         `extQ` (show :: ModuleName -> String)+         `extQ` (gshow' . M.toList :: M.Map QName [AbstractName] -> String)+         `extQ` (gshow' . M.toList :: M.Map QName [AbstractModule] -> String)+         `extQ` (gshow' . M.toList :: M.Map ModuleName Section -> String)+         `extQ` (gshow' . M.toList :: M.Map QName Definition -> String)+         `extQ` (gshow' . M.toList :: M.Map TermHead [Pattern] -> String)+         `extQ` (gshow' . M.toList :: M.Map TermHead [Arg Pattern] -> String)+         `extQ` (gshow' . M.toList :: M.Map String (Builtin String) -> String)+         `extQ` (show :: Scope -> String)++

+ src/full/Agda/Compiler/MAlonzo/Pretty.hs view

@@ -0,0 +1,19 @@+------------------------------------------------------------------------+-- Pretty-printing of Haskell modules+------------------------------------------------------------------------++module Agda.Compiler.MAlonzo.Pretty where++import Data.Generics+import qualified Language.Haskell.Pretty as Pretty+import Language.Haskell.Syntax++import Agda.Compiler.MAlonzo.Encode++-- | Inserts disambiguating parentheses and encodes module names just+-- before pretty-printing.++prettyPrint :: (Pretty.Pretty a, Data a) => a -> String+prettyPrint = Pretty.prettyPrint .+              everywhere (mkT HsParen) .+              everywhere (mkT encodeModuleName)

+ src/full/Agda/Compiler/MAlonzo/Primitives.hs view

@@ -0,0 +1,223 @@+module Agda.Compiler.MAlonzo.Primitives where
+
+import Control.Monad.State
+import Data.Char
+import Data.List as L
+import Data.Map as M
+import Language.Haskell.Syntax
+
+import Agda.Compiler.MAlonzo.Misc
+import Agda.Compiler.MAlonzo.Pretty
+import Agda.Syntax.Internal
+import Agda.TypeChecking.Monad
+import Agda.TypeChecking.Monad.Builtin
+import Agda.TypeChecking.Reduce
+import Agda.TypeChecking.Pretty
+import Agda.Utils.Monad
+
+-- | Check that the main function has type IO a, for some a.
+checkTypeOfMain :: QName -> Type -> TCM ()
+checkTypeOfMain q ty
+  | show (qnameName q) /= "main" = return ()
+  | otherwise = do
+    Def io [] <- primIO
+    ty <- normalise ty
+    case unEl ty of
+      Def d _ | d == io -> return ()
+      _                 -> do
+        err <- fsep $
+          pwords "The type of main should be" ++
+          [prettyTCM io] ++ pwords " A, for some A. The given type is" ++ [prettyTCM ty]
+        typeError $ GenericError $ show err
+
+-- Haskell modules to be imported for BUILT-INs
+importsForPrim :: TCM [Module]
+importsForPrim = xForPrim $ L.map (\(s, ms)-> (s, return (L.map Module ms))) $
+  [ "CHAR" |-> ["Data.Char"]
+  -- , "IO" |-> ["System.IO"]
+  ]
+  where (|->) = (,)
+
+
+-- Declarations of helper functions for BUILT-INs
+declsForPrim :: TCM [HsDecl]
+declsForPrim = xForPrim $
+  [ "NATURAL" |-> (++) <$> natToFrom "Integer" mazNatToInteger mazIntegerToNat
+                       <*> natToFrom "Int"     mazNatToInt     mazIntToNat
+  , "LIST"   |-> forList mazListToHList mazHListToList
+  , "STRING" |-> forList mazListToString mazStringToList
+  , "BOOL"   |-> decls ["TRUE", "FALSE"]
+       mazBoolToHBool "let { f <<0>> = True; f <<1>> = False; } in f"
+       mazHBoolToBool "let { f True = <<0>>; f False = <<1>>; } in f"
+  , "CHAR"   |-> return
+                 [ fakeDS mazCharToInteger
+                   "(fromIntegral . Data.Char.ord :: Char -> Integer)"
+                 ]
+  ]
+  where
+    infix 1 |->
+    (|->) = (,)
+    forList toH toA = decls ["NIL", "CONS"]
+       toH (concat
+           ["let { f <<0>>        = [];"
+           ,"      f (<<1>> x xs) = x : f (unsafeCoerce xs)"
+           ,"} in f"])
+       toA (concat
+           ["let { f []     = <<0>>;"
+           ,"      f (c:cs) = <<1>> c (unsafeCoerce (f cs));"
+           ,"} in f"])
+    natToFrom hty to from = let
+        totxt   = repl ["<<0>>", "<<1>>", hty] (concat
+                       ["let { f <<0>>     = 0 :: <<2>>;"
+                       ,"      f (<<1>> x) = 1 + f (unsafeCoerce x);"
+                       ,"} in f"])
+        fromtxt = repl ["<<0>>", "<<1>>", hty] (concat
+                       ["let { f x | x <= (0 :: <<2>>) = <<0>>"
+                       ,"     | True = <<1>> (unsafeCoerce (f (x - 1)))"
+                       ,"} in f"])
+      in decls ["ZERO", "SUC"] to totxt from fromtxt
+    decls cs n1 b1 n2 b2 = 
+      ifM (hasCompiledData cs)
+          (return $ L.map (`fakeDS` "id") [n1, n2])
+        $ do cs' <- mapM pconName cs
+             return $ zipWith (\ n -> fakeDS n . repl cs') [n1, n2] [b1, b2]
+               
+mazNatToInteger  = "mazNatToInteger"
+mazIntegerToNat  = "mazIntegerToNat"
+mazNatToInt      = "mazNatToInt"
+mazIntToNat      = "mazIntToNat"
+mazCharToInteger = "mazCharToInteger"
+mazListToHList   = "mazListToHList"
+mazHListToList   = "mazHListToList"
+mazListToString  = "mazListToString"
+mazStringToList  = "mazStringToList"
+mazBoolToHBool   = "mazBoolToHBool"
+mazHBoolToBool   = "mazHBoolToBool"
+
+--------------
+
+xForPrim :: [(String, TCM [a])] -> TCM [a]
+xForPrim table = do
+  qs <- keys   <$> curDefs
+  bs <- toList <$> gets stBuiltinThings
+  concat <$> sequence [ maybe (return []) id $ L.lookup s table
+                        | (s, Builtin (Def q _)) <- bs, q `elem` qs ]
+
+
+-- Definition bodies for primitive functions
+primBody :: String -> TCM HsExp
+primBody s = (hsVarUQ . HsIdent <$>) $ maybe unimplemented id $ L.lookup s $ 
+  [
+  -- Integer functions
+    "primIntegerPlus"    |-> binAsis "(+)" "Integer"
+  , "primIntegerMinus"   |-> binAsis "(-)" "Integer"
+  , "primIntegerTimes"   |-> binAsis "(*)" "Integer"
+  , "primIntegerDiv"     |-> binAsis "div" "Integer"
+  , "primIntegerMod"     |-> binAsis "mod" "Integer"
+  , "primIntegerEquality"|-> rel "(==)" "Integer"
+  , "primIntegerLess"    |-> rel "(<)"  "Integer"
+  , "primIntegerAbs"     |-> do toN <- bltQual' "NATURAL" mazIntegerToNat
+                                return $ repl [toN] $ "\\ x -> <<0>> (abs x)"
+  , "primNatToInteger"   |-> bltQual' "NATURAL" mazNatToInteger
+  , "primShowInteger"    |-> return "(show :: Integer -> String)"
+
+  -- Natural number functions
+  , "primNatPlus"     |-> binNat "(+)"
+  , "primNatMinus"    |-> binNat "(-)"
+  , "primNatTimes"    |-> binNat "(*)"
+  , "primNatDivSuc"   |-> binNat "(\\ x y -> div x (y + 1))"
+  , "primNatModSuc"   |-> binNat "(\\ x y -> mod x (y + 1))"
+  , "primNatEquality" |-> relNat "(==)"
+  , "primNatLess"     |-> relNat "(<)"
+
+  -- Floating point functions
+  , "primIntegerToFloat"    |-> return "(fromIntegral :: Integer -> Double)"
+  , "primFloatPlus"	    |-> return "((+) :: Double -> Double -> Double)"
+  , "primFloatMinus"	    |-> return "((-) :: Double -> Double -> Double)"
+  , "primFloatTimes"	    |-> return "((*) :: Double -> Double -> Double)"
+  , "primFloatDiv"	    |-> return "((/) :: Double -> Double -> Double)"
+  , "primFloatLess"         |-> rel "(<)" "Double"
+  , "primRound"	            |-> return "(round :: Double -> Integer)"
+  , "primFloor"	            |-> return "(floor :: Double -> Integer)"
+  , "primCeiling"	    |-> return "(ceiling :: Double -> Integer)"
+  , "primExp"		    |-> return "(exp :: Double -> Double)"
+  , "primLog"		    |-> return "(log :: Double -> Double)"  -- partial
+  , "primSin"		    |-> return "(sin :: Double -> Double)"
+  , "primShowFloat"	    |-> return "(show :: Double -> String)"
+  , "primRound"             |-> return "(round :: Double -> Integer)"
+
+  -- Character functions
+  , "primCharEquality"   |-> rel "(==)" "Char"
+  , "primIsLower"        |-> pred "Data.Char.isLower"
+  , "primIsDigit"        |-> pred "Data.Char.isDigit"
+  , "primIsAlpha"        |-> pred "Data.Char.isAlpha"
+  , "primIsSpace"        |-> pred "Data.Char.isSpace"
+  , "primIsAscii"        |-> pred "Data.Char.isAscii"
+  , "primIsLatin1"       |-> pred "Data.Char.isLatin1"
+  , "primIsPrint"        |-> pred "Data.Char.isPrint"
+  , "primIsHExDigit"     |-> pred "Data.Char.isHexDigit"
+  , "primToUpper"        |-> return "Data.Char.toUpper"
+  , "primToLower"        |-> return "Data.Char.toLower"
+  , "primCharToNat" |-> do toN <- bltQual' "NATURAL" mazIntToNat
+                           return $ repl [toN] $
+                            "(\\ x -> <<0>> ((fromEnum :: Char -> Int) x))"
+  , "primNatToChar" |-> do toI <- bltQual' "NATURAL" mazNatToInt
+                           return $ repl[toI] $
+                            "(\\ x -> (toEnum :: Int -> Char) (<<0>> x))"
+  , "primShowChar"  |-> return "(show :: Char -> String)"
+
+  -- String functions
+  , "primStringToList"   |-> bltQual' "STRING" mazStringToList
+  , "primStringFromList" |-> bltQual' "STRING" mazListToString
+  , "primStringAppend"   |-> binAsis "(++)" "String"
+  , "primStringEquality" |-> rel "(==)" "String"
+  , "primShowString"     |-> return "(show :: String -> String)"
+  ]
+  where
+  (|->) = (,)
+  bin blt op ty from to = do
+    from' <- bltQual' blt from
+    to'   <- bltQual' blt to
+    return $ repl [op, opty ty, from', to'] $
+               "\\ x y -> <<3>> ((<<0>> :: <<1>>) (<<2>> x) (<<2>> y))"
+  binNat op = bin "NATURAL" op "Integer" mazNatToInteger mazIntegerToNat
+  binAsis op ty = return $ repl [op, opty ty] $ "((<<0>>) :: <<1>>)"
+  rel' toTy op ty = do
+    toHB <- bltQual' "BOOL" mazHBoolToBool
+    return $ repl [op, ty, toHB, toTy] $
+      "(\\ x y -> <<2>> ((<<0>> :: <<1>> -> <<1>> -> Bool) (<<3>> x) (<<3>> y)))"
+  relNat op = do toHI <- bltQual' "NATURAL" mazNatToInteger
+                 rel' toHI op "Integer"  
+  rel op ty  = rel' "" op ty
+  pred p = do toHB <- bltQual' "BOOL" mazHBoolToBool
+              return $ repl [p, toHB] $ "(\\ x -> <<1>> (<<0>> x))"
+  opty t = t ++ "->" ++ t ++ "->" ++ t
+  unimplemented = return$ prettyPrint$ rtmError$ "not yet implemented: "++ s
+
+----------------------
+
+repl subs = go where
+  go ('<':'<':c:'>':'>':s) | 0 <= i && i < length subs = subs !! i ++ go s
+     where i = ord c - ord '0'
+  go (c:s) = c : go s
+  go []    = []
+
+pconName :: String -> TCM String
+pconName s = toS =<< getBuiltin s where
+  toS (Con q _)         = prettyPrint <$> conhqn q
+  toS (Lam _ (Abs _ t)) = toS t
+  toS _ = mazerror $ "pconName" ++ s
+
+hasCompiledData :: [String] -> TCM Bool
+hasCompiledData (s:_) = toB =<< getBuiltin s where
+  toB (Con q _)         = do
+    def <- getConstInfo =<< ignoreAbstractMode (canonicalName q)
+    return $ case theDef def of Constructor{conHsCode = Just _} -> True
+                                _                               -> False
+  toB (Lam _ (Abs _ t)) = toB t
+  toB _                 = return False
+hasCompiledData _    = return False
+                       
+
+bltQual' b s = prettyPrint <$> bltQual b s
+

+ src/full/Agda/Interaction/BasicOps.hs view

@@ -0,0 +1,424 @@+{-# LANGUAGE CPP, MultiParamTypeClasses, FlexibleInstances,+             UndecidableInstances+  #-}++module Agda.Interaction.BasicOps where+{- TODO: The operations in this module should return Expr and not String, +         for this we need to write a translator from Internal to Abstract syntax.+-}+++import Control.Monad.Error+import Control.Monad.Reader+import qualified Data.Map as Map+import Data.Map (Map)+import Data.List+import Data.Maybe++import Agda.Interaction.Monad ++import qualified Agda.Syntax.Concrete as C -- ToDo: Remove with instance of ToConcrete+import Agda.Syntax.Position+import Agda.Syntax.Abstract +import Agda.Syntax.Common+import Agda.Syntax.Info(ExprInfo(..),MetaInfo(..))+import Agda.Syntax.Internal (MetaId(..),Type(..),Term(..),Sort(..))+import Agda.Syntax.Translation.InternalToAbstract+import Agda.Syntax.Translation.AbstractToConcrete+import Agda.Syntax.Translation.ConcreteToAbstract+import Agda.Syntax.Scope.Base+import Agda.Syntax.Fixity(Precedence(..))+import Agda.Syntax.Parser++import Agda.TypeChecker+import Agda.TypeChecking.Conversion+import Agda.TypeChecking.Monad as M+import Agda.TypeChecking.MetaVars+import Agda.TypeChecking.Reduce+import Agda.TypeChecking.Substitute++import Agda.Utils.Monad+import Agda.Utils.Monad.Undo+import Agda.Utils.Pretty++#include "../undefined.h"+import Agda.Utils.Impossible++parseExprIn :: InteractionId -> Range -> String -> TCM Expr+parseExprIn ii rng s = do+    mId <- lookupInteractionId ii+    updateMetaVarRange mId rng       +    mi  <- getMetaInfo <$> lookupMeta mId+    let pos = case rStart (getRange mi) of+                Just pos -> pos+                Nothing  -> __IMPOSSIBLE__+    e <- liftIO $ parsePosString exprParser pos s+    concreteToAbstract (clScope mi) e++giveExpr :: MetaId -> Expr -> TCM Expr+-- When translater from internal to abstract is given, this function might return+-- the expression returned by the type checker.+giveExpr mi e = +    do  mv <- lookupMeta mi +        withMetaInfo (getMetaInfo mv) $ metaTypeCheck' mi e mv+        +  where  metaTypeCheck' mi e mv = +            case mvJudgement mv of +		 HasType _ t  -> do+		    ctx <- getContextArgs+		    let t' = t `piApply` ctx+		    v	<- checkExpr e t'+		    case mvInstantiation mv of+			InstV v' ->+			  addConstraints =<< equalTerm t' v (v' `apply` ctx)+			_	 -> updateMeta mi v+		    reify v+		 IsSort _ -> __IMPOSSIBLE__++give :: InteractionId -> Maybe Range -> Expr -> TCM (Expr,[InteractionId])+give ii mr e = liftTCM $  +     do  setUndo+         mi <- lookupInteractionId ii +         mis <- getInteractionPoints+         r <- getInteractionRange ii+         updateMetaVarRange mi $ maybe r id mr+         giveExpr mi e+         removeInteractionPoint ii +         mis' <- getInteractionPoints+         return (e, mis' \\ mis) +++addDecl :: Declaration -> TCM ([InteractionId])+addDecl d = +    do   setUndo+         mis <- getInteractionPoints+         checkDecl d+         mis' <- getInteractionPoints+         return (mis' \\ mis) +++refine :: InteractionId -> Maybe Range -> Expr -> TCM (Expr,[InteractionId])+-- If constants has a fixed arity, then it might be better to do +-- exact refinement.+refine ii mr e = +    do  mi <- lookupInteractionId ii+        mv <- lookupMeta mi +        let range = maybe (getRange mv) id mr+        let scope = M.getMetaScope mv  +        tryRefine 10 range scope e+  where tryRefine :: Int -> Range -> ScopeInfo -> Expr -> TCM (Expr,[InteractionId])+        tryRefine nrOfMetas r scope e = try nrOfMetas e+           where try 0 e = throwError (strMsg "Can not refine")+                 try n e = give ii (Just r) e `catchError` (\_ -> try (n-1) (appMeta e))+                 appMeta :: Expr -> Expr+                 appMeta e = +                      let metaVar = QuestionMark+				  $ Agda.Syntax.Info.MetaInfo+				    { Agda.Syntax.Info.metaRange = r+                                    , Agda.Syntax.Info.metaScope = scope { scopePrecedence = ArgumentCtx }+				    , metaNumber = Nothing+				    }+                      in App (ExprRange $ r) e (Arg NotHidden $ unnamed metaVar)+                 --ToDo: The position of metaVar is not correct+                 --ToDo: The fixity of metavars is not correct -- fixed? MT++{-+refineExact :: InteractionId -> Maybe Range -> Expr -> TCM (Expr,[InteractionId])+refineExact ii mr e = +    do  mi <- lookupInteractionId ii+        mv <- lookupMeta mi +        let range = maybe (getRange mv) id mr+        let scope = M.getMetaScope mv+        (_,t) <- withMetaInfo (getMetaInfo mv) $ inferExpr e         +        let arityt = arity t+        +        tryRefine 10 range scope e+  where tryRefine :: Int -> Range -> ScopeInfo -> Expr -> TCM (Expr,[InteractionId])+        tryRefine nrOfMetas r scope e = try nrOfMetas e+           where try 0 e = throwError (strMsg "Can not refine")+                 try n e = give ii (Just r) e `catchError` (\_ -> try (n-1) (appMeta e))+                 appMeta :: Expr -> Expr+                 appMeta e = +                      let metaVar = QuestionMark $ Agda.Syntax.Info.MetaInfo {Agda.Syntax.Info.metaRange = r,+                                                 Agda.Syntax.Info.metaScope = scope}+                      in App (ExprRange $ r) NotHidden e metaVar    +                 --ToDo: The position of metaVar is not correct++++++abstract :: InteractionId -> Maybe Range -> TCM (Expr,[InteractionId])+abstract ii mr +++refineExact :: InteractionId -> Expr -> TCM (Expr,[InteractionId])+refineExact ii e = +    do  +-}+++{-| Evaluate the given expression in the current environment -}+evalInCurrent :: Expr -> TCM Expr+evalInCurrent e = +    do  t <- newTypeMeta_ +	v <- checkExpr e t+	v' <- normalise v+	reify v'+++evalInMeta :: InteractionId -> Expr -> TCM Expr+evalInMeta ii e = +   do 	m <- lookupInteractionId ii+	mi <- getMetaInfo <$> lookupMeta m+	withMetaInfo mi $+	    evalInCurrent e+++data Rewrite =  AsIs | Instantiated | HeadNormal | Normalised ++--rewrite :: Rewrite -> Term -> TCM Term+rewrite AsIs	     t = return t+rewrite Instantiated t = return t   -- reify does instantiation+rewrite HeadNormal   t = reduce t+rewrite Normalised   t = normalise t+++data OutputForm a b+      = OfType b a | CmpInType Comparison a b b+      | JustType b | CmpTypes Comparison b b+      | JustSort b | CmpSorts Comparison b b+      | Guard (OutputForm a b) [OutputForm a b]+      | Assign b a+      | IsEmptyType a++-- | A subset of 'OutputForm'.++data OutputForm' a b = OfType' { ofName :: b+                               , ofExpr :: a+                               }++outputFormId :: OutputForm a b -> b+outputFormId o = case o of+  OfType i _        -> i+  CmpInType _ _ i _ -> i+  JustType i        -> i+  CmpTypes _ i _    -> i+  JustSort i        -> i+  CmpSorts _ i _    -> i+  Guard o _         -> outputFormId o+  Assign i _        -> i+  IsEmptyType _     -> __IMPOSSIBLE__   -- Should never be used on IsEmpty constraints++instance Functor (OutputForm a) where+    fmap f (OfType e t)           = OfType (f e) t+    fmap f (JustType e)           = JustType (f e)+    fmap f (JustSort e)           = JustSort (f e)+    fmap f (CmpInType cmp t e e') = CmpInType cmp t (f e) (f e')+    fmap f (CmpTypes cmp e e')    = CmpTypes cmp (f e) (f e')+    fmap f (CmpSorts cmp e e')    = CmpSorts cmp (f e) (f e')+    fmap f (Guard o os)           = Guard (fmap f o) (fmap (fmap f) os)+    fmap f (Assign m e)           = Assign (f m) e+    fmap f (IsEmptyType a)        = IsEmptyType a++instance Reify Constraint (OutputForm Expr Expr) where+    reify (ValueCmp cmp t u v) = CmpInType cmp <$> reify t <*> reify u <*> reify v +    reify (TypeCmp cmp t t')   = CmpTypes cmp <$> reify t <*> reify t'+    reify (SortCmp cmp s s')   = CmpSorts cmp <$> reify s <*> reify s'+    reify (Guarded c cs) = do+	o  <- reify c+	os <- mapM (withConstraint reify) cs+	return $ Guard o os+    reify (UnBlock m) = do+        mi <- mvInstantiation <$> lookupMeta m+        case mi of+          BlockedConst t -> do+            e  <- reify t+            m' <- reify (MetaV m [])+            return $ Assign m' e+          PostponedTypeCheckingProblem cl -> enterClosure cl $ \(e, a, _) -> do+            a <- reify a+            return $ OfType e a+          Open{}  -> __IMPOSSIBLE__+          InstS{} -> __IMPOSSIBLE__+          InstV{} -> __IMPOSSIBLE__+    reify (IsEmpty a) = IsEmptyType <$> reify a++showComparison :: Comparison -> String+showComparison CmpEq  = " = "+showComparison CmpLeq = " =< "++instance (Show a,Show b) => Show (OutputForm a b) where+    show (OfType e t)           = show e ++ " : " ++ show t+    show (JustType e)           = "Type " ++ show e+    show (JustSort e)           = "Sort " ++ show e+    show (CmpInType cmp t e e') = show e ++ showComparison cmp ++ show e' ++ " : " ++ show t+    show (CmpTypes  cmp t t')   = show t ++ showComparison cmp ++ show t'+    show (CmpSorts cmp s s')    = show s ++ showComparison cmp ++ show s'+    show (Guard o os)           = show o ++ "  |  " ++ show os+    show (Assign m e)           = show m ++ " := " ++ show e+    show (IsEmptyType a)        = "Is empty: " ++ show a++instance (ToConcrete a c, ToConcrete b d) => +         ToConcrete (OutputForm a b) (OutputForm c d) where+    toConcrete (OfType e t) = OfType <$> toConcrete e <*> toConcrete t+    toConcrete (JustType e) = JustType <$> toConcrete e+    toConcrete (JustSort e) = JustSort <$> toConcrete e+    toConcrete (CmpInType cmp t e e') = +             CmpInType cmp <$> toConcrete t <*> toConcrete e <*> toConcrete e'+    toConcrete (CmpTypes cmp e e') = CmpTypes cmp <$> toConcrete e <*> toConcrete e'+    toConcrete (CmpSorts cmp e e') = CmpSorts cmp <$> toConcrete e <*> toConcrete e'+    toConcrete (Guard o os) = Guard <$> toConcrete o <*> toConcrete os+    toConcrete (Assign m e) = Assign <$> toConcrete m <*> toConcrete e+    toConcrete (IsEmptyType a) = IsEmptyType <$> toConcrete a++instance (Pretty a, Pretty b) => Pretty (OutputForm' a b) where+  pretty (OfType' e t) = pretty e <+> text ":" <+> pretty t++instance (ToConcrete a c, ToConcrete b d) =>+            ToConcrete (OutputForm' a b) (OutputForm' c d) where+  toConcrete (OfType' e t) = OfType' <$> toConcrete e <*> toConcrete t++--ToDo: Move somewhere else+instance ToConcrete InteractionId C.Expr where+    toConcrete (InteractionId i) = return $ C.QuestionMark noRange (Just i)+instance ToConcrete MetaId C.Expr where+    toConcrete (MetaId i) = return $ C.Underscore noRange (Just i)++judgToOutputForm :: Judgement a c -> OutputForm a c+judgToOutputForm (HasType e t) = OfType e t+judgToOutputForm (IsSort s)    = JustSort s+++mkUndo :: TCM ()+mkUndo = undo++--- Printing Operations+getConstraint :: Int -> TCM (OutputForm Expr Expr)+getConstraint ci = +    do  cc <- lookupConstraint ci +        cc <- reduce cc+        withConstraint reify cc+++getConstraints :: TCM [OutputForm C.Expr C.Expr]+getConstraints = liftTCM $ do+    cs <- mapM (withConstraint (abstractToConcrete_ <.> reify)) =<< reduce =<< M.getConstraints+    ss <- mapM toOutputForm =<< getSolvedInteractionPoints+    return $ ss ++ cs+  where+    toOutputForm (ii, mi, e) = do+      mv <- getMetaInfo <$> lookupMeta mi+      withMetaInfo mv $ do+        let m = QuestionMark $ MetaInfo noRange emptyScopeInfo (Just $ fromIntegral ii)+        abstractToConcrete_ $ Assign m e++getSolvedInteractionPoints :: TCM [(InteractionId, MetaId, Expr)]+getSolvedInteractionPoints = do+  is <- getInteractionPoints+  concat <$> mapM solution is+  where+    solution i = do+      m  <- lookupInteractionId i+      mv <- lookupMeta m+      withMetaInfo (getMetaInfo mv) $ do+        args  <- getContextArgs+        scope <- getScope+        let sol v = do e <- reify v; return [(i, m, ScopedExpr scope e)]+            unsol = return []+        case mvInstantiation mv of+          InstV{}                        -> sol (MetaV m args)+          InstS{}                        -> sol (Sort $ MetaS m)+          Open{}                         -> unsol+          BlockedConst{}                 -> unsol+          PostponedTypeCheckingProblem{} -> unsol++typeOfMetaMI :: Rewrite -> MetaId -> TCM (OutputForm Expr MetaId)+typeOfMetaMI norm mi = +     do mv <- lookupMeta mi+	withMetaInfo (getMetaInfo mv) $+	  rewriteJudg mv (mvJudgement mv)+   where+    rewriteJudg mv (HasType i t) = do+      t <- rewrite norm t+      vs <- getContextArgs+      OfType i <$> reify (t `piApply` vs)+    rewriteJudg mv (IsSort i)    = return $ JustSort i+++typeOfMeta :: Rewrite -> InteractionId -> TCM (OutputForm Expr InteractionId)+typeOfMeta norm ii = +     do mi <- lookupInteractionId ii+        out <- typeOfMetaMI norm mi+        return $ fmap (\_ -> ii) out+++typeOfMetas :: Rewrite -> TCM ([OutputForm Expr InteractionId],[OutputForm Expr MetaId])+-- First visible metas, then hidden+typeOfMetas norm = liftTCM $+    do	ips <- getInteractionPoints +        js <- mapM (typeOfMeta norm) ips+        hidden <- hiddenMetas+        return $ (js,hidden)+   where hiddenMetas =    --TODO: Change so that it uses getMetaMI above +            do is <- getInteractionMetas+	       store <- Map.filterWithKey (openAndImplicit is) <$> getMetaStore+               let mvs = Map.keys store+               mapM (typeOfMetaMI norm) mvs+          where+               openAndImplicit is x (MetaVar _ _ _ M.Open _)		 = x `notElem` is+	       openAndImplicit is x (MetaVar _ _ _ (M.BlockedConst _) _) = True+	       openAndImplicit _ _ _					 = False++-- Gives a list of names and corresponding types.++contextOfMeta :: InteractionId -> Rewrite -> TCM [OutputForm' Expr Name]+contextOfMeta ii norm = do+  info <- getMetaInfo <$> (lookupMeta =<< lookupInteractionId ii)+  let localVars = map ctxEntry . envContext . clEnv $ info+  withMetaInfo info $ gfilter visible <$> reifyContext localVars+  where gfilter p = catMaybes . map p+        visible (OfType x y) | show x /= "_" = Just (OfType' x y)+                             | otherwise     = Nothing+	visible _	     = __IMPOSSIBLE__+        reifyContext xs = escapeContext (length xs) $ foldr out (return []) $ reverse xs+	out (Arg h (x,t)) rest = do+	  t' <- reify =<< rewrite norm t+	  ts <- addCtx x (Arg h t) rest+	  return $ OfType x t' : ts+++{-| Returns the type of the expression in the current environment -}+typeInCurrent :: Rewrite -> Expr -> TCM Expr+typeInCurrent norm e =+    do 	(_,t) <- inferExpr e+        v <- rewrite norm t+        reify v++++typeInMeta :: InteractionId -> Rewrite -> Expr -> TCM Expr+typeInMeta ii norm e =+   do 	m <- lookupInteractionId ii+	mi <- getMetaInfo <$> lookupMeta m+	withMetaInfo mi $+	    typeInCurrent norm e++withInteractionId :: InteractionId -> TCM a -> TCM a+withInteractionId i ret = do+  m <- lookupInteractionId i+  withMetaId m ret++withMetaId :: MetaId -> TCM a -> TCM a+withMetaId m ret = do+  info <- lookupMeta m+  withMetaInfo (mvInfo info) ret++-------------------------------+----- Help Functions ----------+-------------------------------+++++

+ src/full/Agda/Interaction/CommandLine/CommandLine.hs view

@@ -0,0 +1,303 @@+{-# LANGUAGE CPP #-}++module Agda.Interaction.CommandLine.CommandLine where++import Control.Monad.Error+import Control.Monad.Reader+import Control.Applicative+import Data.Char+import Data.Set as Set+import Data.Map as Map+import Data.List as List+import Data.Maybe+import qualified System.IO.UTF8 as UTF8++import Agda.Interaction.BasicOps as BasicOps+import Agda.Interaction.Monad++import qualified Agda.Syntax.Abstract as A+import Agda.Syntax.Common+import Agda.Syntax.Internal+import Agda.Syntax.Parser+import Agda.Syntax.Position+import Agda.Syntax.Scope.Base+import Agda.Syntax.Scope.Monad+import Agda.Syntax.Translation.ConcreteToAbstract+import Agda.Syntax.Translation.InternalToAbstract+import Agda.Syntax.Abstract.Pretty++import Text.PrettyPrint++import Agda.TypeChecker+import Agda.TypeChecking.Conversion+import Agda.TypeChecking.Constraints+import Agda.TypeChecking.Monad+import Agda.TypeChecking.MetaVars+import Agda.TypeChecking.Reduce+import Agda.TypeChecking.Errors+import Agda.TypeChecking.Substitute++import Agda.Utils.Monad+import Agda.Utils.Fresh+import Agda.Utils.Monad.Undo++#include "../../undefined.h"+import Agda.Utils.Impossible++data ExitCode a = Continue | ContinueIn TCEnv | Return a++type Command a = (String, [String] -> TCM (ExitCode a))++matchCommand :: String -> [Command a] -> Either [String] ([String] -> TCM (ExitCode a))+matchCommand x cmds =+    case List.filter (isPrefixOf x . fst) cmds of+	[(_,m)]	-> Right m+	xs	-> Left $ List.map fst xs++interaction :: String -> [Command a] -> (String -> TCM (ExitCode a)) -> IM a+interaction prompt cmds eval = loop+    where+	go (Return x)	    = return x+	go Continue	    = loop+	go (ContinueIn env) = local (const env) loop++	loop =+	    do	ms <- readline prompt+		case fmap words ms of+		    Nothing		  -> return $ error "** EOF **"+		    Just []		  -> loop+		    Just ((':':cmd):args) ->+			do  case matchCommand cmd cmds of+				Right c	-> go =<< liftTCM (c args)+				Left []	->+				    do	liftIO $ UTF8.putStrLn $ "Unknown command '" ++ cmd ++ "'"+					loop+				Left xs	->+				    do	liftIO $ UTF8.putStrLn $ "More than one command match: " ++ concat (intersperse ", " xs)+					loop+		    Just _ ->+			do  go =<< liftTCM (eval $ fromJust ms)+	    `catchError` \e ->+		do  s <- prettyError e+		    liftIO $ UTF8.putStrLn s+		    loop++-- | The interaction loop.+interactionLoop :: TCM (ScopeInfo, a) -> IM ()+interactionLoop typeCheck =+    do  liftTCM reload+	interaction "Main> " commands evalTerm+    where+	reload = do+	    setUndo+	    (scope, a) <- typeCheck+	    setScope scope+	  `catchError` \e -> do+	    s <- prettyError e+	    liftIO $ UTF8.putStrLn s+	    liftIO $ UTF8.putStrLn "Failed."++	commands =+	    [ "quit"	    |>  \_ -> return $ Return ()+	    , "?"	    |>  \_ -> continueAfter $ liftIO $ help commands+	    , "reload"	    |>  \_ -> do reload+					 ContinueIn <$> ask+	    , "constraints" |> \args -> continueAfter $ showConstraints args+	    , "Context"	    |> \args -> continueAfter $ showContext args+            , "give"	    |> \args -> continueAfter $ giveMeta args+            , "Refine"	    |> \args -> continueAfter $ refineMeta args+	    , "metas"	    |> \args -> continueAfter $ showMetas args+            , "undo"	    |> \_ -> continueAfter $ mkUndo+            , "load"	    |> \args -> continueAfter $ loadFile reload args+	    , "eval"	    |> \args -> continueAfter $ evalIn args+            , "typeOf"      |> \args -> continueAfter $ typeOf args+            , "typeIn"      |> \args -> continueAfter $ typeIn args+	    , "wakeup"	    |> \_ -> continueAfter $ retryConstraints+	    , "noundo"	    |> \_ -> continueAfter $ clearUndoHistory+	    , "scope"	    |> \_ -> continueAfter $ showScope+	    ]+	    where+		(|>) = (,)++continueAfter :: TCM a -> TCM (ExitCode b)+continueAfter m = m >> return Continue++loadFile :: TCM () -> [String] -> TCM ()+loadFile reload [file] =+    do	setInputFile file+	reload+loadFile _ _ = liftIO $ UTF8.putStrLn ":load file"++showConstraints :: [String] -> TCM ()+showConstraints [c] =+    do	i  <- readM c+	cc <- normalise =<< lookupConstraint i+	d  <- prettyTCM $ clValue cc+	liftIO $ UTF8.print d+showConstraints [] =+    do	cs <- BasicOps.getConstraints+	liftIO $ UTF8.putStrLn $ unlines (List.map show cs)+showConstraints _ = liftIO $ UTF8.putStrLn ":constraints [cid]"++	+showMetas :: [String] -> TCM ()+showMetas [m] =+    do	i <- InteractionId <$> readM m+	withInteractionId i $ do+	  s <- typeOfMeta AsIs i+	  r <- getInteractionRange i+	  d <- showA s+	  liftIO $ UTF8.putStrLn $ d ++ " " ++ show r+showMetas [m,"normal"] =+    do	i <- InteractionId <$> readM m+	withInteractionId i $ do+	  s <- showA =<< typeOfMeta Normalised i+	  r <- getInteractionRange i+	  liftIO $ UTF8.putStrLn $ s ++ " " ++ show r+showMetas [] = +    do  (interactionMetas,hiddenMetas) <- typeOfMetas AsIs +        mapM_ (liftIO . UTF8.putStrLn) =<< mapM showII interactionMetas+	mapM_ print' hiddenMetas+    where+	showII o = withInteractionId (outputFormId o) $ showA o+	showM  o = withMetaId (outputFormId o) $ showA o++	metaId (OfType i _) = i+	metaId (JustType i) = i+	metaId (JustSort i) = i+	metaId (Assign i e) = i+	metaId _ = __IMPOSSIBLE__+	print' x = do+	    r <- getMetaRange (metaId x)+	    d <- showM x+	    liftIO $ UTF8.putStrLn $ d ++ "  [ at " ++ show r ++ " ]"+showMetas _ = liftIO $ UTF8.putStrLn $ ":meta [metaid]"+++showScope :: TCM ()+showScope = do+  scope <- getScope+  liftIO $ UTF8.print scope++metaParseExpr ::  InteractionId -> String -> TCM A.Expr+metaParseExpr ii s = +    do	m <- lookupInteractionId ii+        scope <- getMetaScope <$> lookupMeta m+        r <- getRange <$> lookupMeta m+        --liftIO $ UTF8.putStrLn $ show scope+        let pos = case rStart r of+                    Nothing  -> __IMPOSSIBLE__+                    Just pos -> pos+	e <- liftIO $ parsePosString exprParser pos s+	concreteToAbstract scope e++actOnMeta :: [String] -> (InteractionId -> A.Expr -> TCM a) -> TCM a+actOnMeta (is:es) f = +     do  i <- readM is+         let ii = InteractionId i +         e <- metaParseExpr ii (unwords es)+         withInteractionId ii $ f ii e+actOnMeta _ _ = __IMPOSSIBLE__+++giveMeta :: [String] -> TCM ()+giveMeta s | length s >= 2 = +    do  actOnMeta s (\ii -> \e  -> give ii Nothing e)+        return ()+giveMeta _ = liftIO $ UTF8.putStrLn $ ": give" ++ " metaid expr"++++refineMeta :: [String] -> TCM ()+refineMeta s | length s >= 2 = +    do  actOnMeta s (\ii -> \e  -> refine ii Nothing e)+        return ()+refineMeta _ = liftIO $ UTF8.putStrLn $ ": refine" ++ " metaid expr"++++retryConstraints :: TCM ()+retryConstraints = liftTCM wakeupConstraints+++evalIn :: [String] -> TCM ()+evalIn s | length s >= 2 =+    do	d <- actOnMeta s $ \_ e -> prettyA =<< evalInCurrent e+        liftIO $ UTF8.print d+evalIn _ = liftIO $ UTF8.putStrLn ":eval metaid expr"++parseExpr :: String -> TCM A.Expr+parseExpr s = do+    e <- liftIO $ parse exprParser s+    localToAbstract e return++evalTerm :: String -> TCM (ExitCode a)+evalTerm s =+    do	e <- parseExpr s+        v <- evalInCurrent e+	e <- prettyTCM v+	liftIO $ UTF8.putStrLn $ show e+	return Continue+    where+	evalInCurrent e = do+	  t <- newTypeMeta_ +	  v <- checkExpr e t+	  v' <- normalise v+	  return v'+++typeOf :: [String] -> TCM ()+typeOf s = +    do  e  <- parseExpr (unwords s)+        e0 <- typeInCurrent Normalised e+        e1 <- typeInCurrent AsIs e+	liftIO . UTF8.putStrLn =<< showA e1++typeIn :: [String] -> TCM ()+typeIn s@(_:_:_) = +    actOnMeta s $ \i e ->+    do	e1  <- typeInMeta i Normalised e+        e2 <- typeInMeta i AsIs e+	liftIO . UTF8.putStrLn =<< showA e1+typeIn _ = liftIO $ UTF8.putStrLn ":typeIn meta expr"++showContext :: [String] -> TCM ()+showContext (meta:args) = do+    i <- InteractionId <$> readM meta+    mi <- lookupMeta =<< lookupInteractionId i+    withMetaInfo (getMetaInfo mi) $ do+    ctx <- List.map unArg . telToList <$> getContextTelescope+    zipWithM_ display ctx $ reverse $ zipWith const [1..] ctx+    where+	display (x, t) n = do+	    t <- case args of+		    ["normal"] -> normalise $ raise n t+		    _	       -> return $ raise n t+	    d <- prettyTCM t+	    liftIO $ UTF8.print $ text x <+> text ":" <+> d+showContext _ = liftIO $ UTF8.putStrLn ":Context meta"++-- | The logo that prints when agdaLight is started in interactive mode.+splashScreen :: String+splashScreen = unlines+    [ "                 _        ______"+    , "   ____         | |      |_ __ _|"+    , "  / __ \\        | |       | || |"+    , " | |__| |___  __| | ___   | || |"+    , " |  __  / _ \\/ _  |/ __\\  | || |   Agda 2 Interactive"+    , " | |  |/ /_\\ \\/_| / /_| \\ | || |"+    , " |_|  |\\___  /____\\_____/|______|  Type :? for help."+    , "        __/ /"+    , "        \\__/"+    , ""+    , "The interactive mode is no longer supported. Don't complain if it doesn't work."+    ]++-- | The help message+help :: [Command a] -> IO ()+help cs = UTF8.putStr $ unlines $+    [ "Command overview" ] ++ List.map explain cs +++    [ "<exp> Infer type of expression <exp> and evaluate it." ]+    where+	explain (x,_) = ":" ++ x+

+ src/full/Agda/Interaction/Exceptions.hs view

@@ -0,0 +1,26 @@++{-| This module defines the exception handler.+-}+module Agda.Interaction.Exceptions where++import Control.Exception+import Control.Monad.Trans+import System.Exit+import qualified System.IO.UTF8 as UTF8++import Agda.Syntax.Position+import Agda.Syntax.Parser		    ( ParseError(..)	       )+import Agda.Syntax.Concrete.Definitions  ( DeclarationException(..) )++handleParseException :: (ParseError -> IO a) -> ParseError -> IO a+handleParseException crash e = crash e++handleDeclarationException :: (DeclarationException -> IO a) -> DeclarationException -> IO a+handleDeclarationException crash e = crash e++failOnException :: (Range -> String -> IO a) -> IO a -> IO a+failOnException h m = m `catchDyn` handleParseException handler+		        `catchDyn` handleDeclarationException handler+    where+	handler x = h (getRange x) (show x)+

+ src/full/Agda/Interaction/GhciTop.hs view

@@ -0,0 +1,692 @@+{-# LANGUAGE CPP, TypeSynonymInstances #-}+{-# OPTIONS -fno-cse #-}++module Agda.Interaction.GhciTop+  ( module Agda.Interaction.GhciTop+  , module Agda.TypeChecker+  , module TM+  , module Agda.TypeChecking.MetaVars+  , module Agda.TypeChecking.Reduce+  , module Agda.TypeChecking.Errors++  , module Agda.Syntax.Position+  , module Agda.Syntax.Parser+  , module SCo+--  , module SC  -- trivial clash removal: remove all!+--  , module SA+--  , module SI+  , module Agda.Syntax.Scope.Base+  , module Agda.Syntax.Scope.Monad+  , module Agda.Syntax.Translation.ConcreteToAbstract+  , module Agda.Syntax.Translation.AbstractToConcrete+  , module Agda.Syntax.Translation.InternalToAbstract+  , module Agda.Syntax.Abstract.Name++  , module Agda.Interaction.Exceptions+  )+  where++import System.Directory+import System.IO.Unsafe+import Data.Char+import Data.IORef+import Data.Function+import Control.Applicative+import qualified System.IO.UTF8 as UTF8++import Agda.Utils.Fresh+import Agda.Utils.Monad+import Agda.Utils.Monad.Undo+import Agda.Utils.Pretty as P+import Agda.Utils.String+import Agda.Utils.FileName+import Agda.Utils.Tuple++import Control.Monad.Error+import Control.Monad.Reader+import Control.Monad.State hiding (State)+import Control.Exception+import Data.List as List+import qualified Data.Map as Map+import System.Exit+import qualified System.Mem as System++import Agda.TypeChecker+import Agda.TypeChecking.Monad as TM+  hiding (initState, setCommandLineOptions)+import qualified Agda.TypeChecking.Monad as TM+import Agda.TypeChecking.MetaVars+import Agda.TypeChecking.Reduce+import Agda.TypeChecking.Errors+import Agda.TypeChecking.Serialise (encodeFile)++import Agda.Syntax.Position+import Agda.Syntax.Parser+import qualified Agda.Syntax.Parser.Tokens as T+import Agda.Syntax.Concrete as SC+import Agda.Syntax.Common as SCo+import Agda.Syntax.Concrete.Name as CN+import Agda.Syntax.Concrete.Pretty ()+import Agda.Syntax.Abstract as SA+import Agda.Syntax.Abstract.Pretty+import Agda.Syntax.Internal as SI+import Agda.Syntax.Scope.Base+import Agda.Syntax.Scope.Monad hiding (bindName)+import qualified Agda.Syntax.Info as Info+import Agda.Syntax.Translation.ConcreteToAbstract+import Agda.Syntax.Translation.AbstractToConcrete hiding (withScope)+import Agda.Syntax.Translation.InternalToAbstract+import Agda.Syntax.Abstract.Name++import Agda.Interaction.Exceptions+import Agda.Interaction.Options+import Agda.Interaction.MakeCase+import qualified Agda.Interaction.BasicOps as B+import qualified Agda.Interaction.CommandLine.CommandLine as CL+import Agda.Interaction.Highlighting.Emacs+import Agda.Interaction.Highlighting.Generate+import qualified Agda.Interaction.Imports as Imp++import Agda.Termination.TermCheck++import qualified Agda.Compiler.MAlonzo.Compiler as MAlonzo++#include "../undefined.h"+import Agda.Utils.Impossible++data State = State+  { theTCState           :: TCState+  , theUndoStack         :: [TCState]+  , theTopLevel          :: Maybe TopLevelInfo+    -- ^ Invariant: The 'TopLevelInfo' corresponds to a type-correct+    --   module.+  , theInteractionPoints :: [InteractionId]+    -- ^ The interaction points of the buffer, in the order in which+    --   they appear in the buffer. The interaction points are+    --   recorded in 'theTCState', but when new interaction points are+    --   added by give or refine Agda does not ensure that the ranges+    --   of later interaction points are updated.+  }++initState :: State+initState = State+  { theTCState           = TM.initState+  , theUndoStack         = []+  , theTopLevel          = Nothing+  , theInteractionPoints = []+  }++{-# NOINLINE theState #-}+theState :: IORef State+theState = unsafePerformIO $ newIORef initState++ioTCM :: TCM a -> IO a+ioTCM cmd = infoOnException $ do+  State { theTCState   = st+        , theUndoStack = us+        } <- readIORef theState+  r <- runTCM $ do+      putUndoStack us+      put st+      x <- withEnv initEnv cmd+      st <- get+      us <- getUndoStack+      return (x,st,us)+  case r of+    Right (a,st',ss') -> do+      modifyIORef theState $ \s ->+        s { theTCState = st'+          , theUndoStack = ss'+          }+      return a+    Left err -> displayErrorAndExit (Left err)++-- | @cmd_load m includes@ loads the module in file @m@, using+-- @includes@ as the include directories.++cmd_load :: FilePath -> [FilePath] -> IO ()+cmd_load m includes =+  cmd_load' m includes True (\_ -> return ()) cmd_metas++-- | @cmd_load' m includes cmd cmd2@ loads the module in file @m@,+-- using @includes@ as the include directories.+--+-- If type checking completes without any exceptions having been+-- encountered then the command @cmd r@ is executed, where @r@ is the+-- second component of the result of 'Imp.createInterface'.+--+-- The command @cmd2@ is executed as the final step of @cmd_load'@,+-- unless an exception is encountered.++cmd_load' :: FilePath -> [FilePath]+          -> Bool -- ^ Allow unsolved meta-variables?+          -> (Imp.CreateInterfaceResult -> TCM ()) -> IO ()+          -> IO ()+cmd_load' file includes unsolvedOK cmd cmd2 = infoOnException $ do+    -- canonicalizePath seems to return absolute paths.+    file <- liftIO $ canonicalizePath file+    clearSyntaxInfo file+    ioTCM $ do+            clearUndoHistory+	    preserveDecodedModules resetState+            decodedModules <- stDecodedModules <$> get+            setUndo++            -- All options are reset when a file is reloaded,+            -- including the choice of whether or not to display+            -- implicit arguments.+            (topLevel, ok) <- Imp.createInterface+              (defaultOptions { optGenerateEmacsFile = True+                              , optAllowUnsolved     = unsolvedOK+                              , optIncludeDirs       = includes })+              noTrace [] Map.empty+              decodedModules emptySignature+              Map.empty Nothing file True++            -- The module type checked, so let us store the abstract+            -- syntax information and the interaction points.+            is <- sortInteractionPoints =<< getInteractionPoints+            liftIO $ modifyIORef theState $ \s ->+              s { theTopLevel          = Just topLevel+                , theInteractionPoints = is+                }+            cmd ok++            -- tellEmacsToReloadSyntaxInfo should run before+            -- tellEmacsToUpdateGoals, because the latter can change+            -- the contents of the buffer, and this can invalidate the+            -- ranges of the syntax-info.+            liftIO tellEmacsToReloadSyntaxInfo+            liftIO tellEmacsToUpdateGoals++    cmd2+    System.performGC++-- | @cmd_compile m includes@ compiles the module in file @m@, using+-- @includes@ as the include directories.++cmd_compile :: FilePath -> [FilePath] -> IO ()+cmd_compile file includes =+  cmd_load' file includes False (\r ->+    case r of+      Imp.Success { Imp.cirInterface = i } -> do+        MAlonzo.compilerMain (return i)+        display_info "*Compilation result*"+                   "The module was successfully compiled."+      Imp.Warnings {} ->+        display_info errorTitle $ unlines+          [ "You can only compile modules without unsolved metavariables"+          , "or termination checking problems."+          ])+    (return ())++cmd_constraints :: IO ()+cmd_constraints = ioTCM $ do+    cs <- map show <$> B.getConstraints+    display_info "*Constraints*" (unlines cs)+++cmd_metas :: IO ()+cmd_metas = ioTCM $ do -- CL.showMetas []+  ims <- fst <$> B.typeOfMetas B.AsIs+  hms <- snd <$> B.typeOfMetas B.Normalised -- show unsolved implicit arguments normalised+  di <- mapM (\i -> B.withInteractionId (B.outputFormId i) (showA i)) ims+  dh <- mapM showA' hms+  display_info "*All Goals*" $ unlines $ di ++ dh+  where+    metaId (B.OfType i _) = i+    metaId (B.JustType i) = i+    metaId (B.JustSort i) = i+    metaId (B.Assign i e) = i+    metaId _ = __IMPOSSIBLE__+    showA' m = do+      r <- getMetaRange (metaId m)+      d <- B.withMetaId (B.outputFormId m) (showA m)+      return $ d ++ "  [ at " ++ show r ++ " ]"++cmd_undo :: IO ()+cmd_undo = ioTCM undo++cmd_reset :: IO ()+cmd_reset = ioTCM $ do putUndoStack []; preserveDecodedModules resetState++type GoalCommand = InteractionId -> Range -> String -> IO()++cmd_give :: GoalCommand+cmd_give = give_gen B.give $ \s ce -> case ce of (SC.Paren _ _)-> "'paren"+                                                 _             -> "'no-paren"++cmd_refine :: GoalCommand+cmd_refine = give_gen B.refine $ \s -> emacsStr . show++give_gen give_ref mk_newtxt ii rng s = do+    ioTCM $ do+      scope     <- getInteractionScope ii+      (ae, iis) <- give_ref ii Nothing =<< B.parseExprIn ii rng s+      let newtxt = A . mk_newtxt s $ abstractToConcrete (makeEnv scope) ae+      iis       <- sortInteractionPoints iis+      liftIO $ modifyIORef theState $ \s ->+                 s { theInteractionPoints =+                       replace ii iis (theInteractionPoints s) }+      liftIO $ UTF8.putStrLn $ response $+                 L [A "agda2-give-action", showNumIId ii, newtxt]+      liftIO tellEmacsToUpdateGoals+    cmd_metas+  where+  -- Substitutes xs for x in ys.+  replace x xs ys = concatMap (\y -> if y == x then xs else [y]) ys++-- | Sorts interaction points based on their ranges.++sortInteractionPoints :: [InteractionId] -> TCM [InteractionId]+sortInteractionPoints is =+  map fst . sortBy (compare `on` snd) <$>+    mapM (\i -> (,) i <$> getInteractionRange i) is++-- | Pretty-prints the type of the meta-variable.++prettyTypeOfMeta :: B.Rewrite -> InteractionId -> TCM Doc+prettyTypeOfMeta norm ii = do+  form <- B.typeOfMeta norm ii+  case form of+    B.OfType _ e -> prettyA e+    _            -> text <$> showA form++-- | Pretty-prints the context of the given meta-variable.++prettyContext+  :: B.Rewrite      -- ^ Normalise?+  -> InteractionId+  -> TCM Doc+prettyContext norm ii = B.withInteractionId ii $ do+  ctx <- B.contextOfMeta ii norm+  es  <- mapM (prettyA . B.ofExpr) ctx+  ns  <- mapM (showA   . B.ofName) ctx+  let maxLen = maximum $ 0 : filter (< longNameLength) (map length ns)+  return $ vcat $+           map (\(n, e) -> text n $$ nest (maxLen + 1) (text ":") <+> e) $+           zip ns es++-- | 'prettyContext' lays out @n : e@ on (at least) two lines if @n@+-- has at least @longNameLength@ characters.++longNameLength = 10++cmd_context :: B.Rewrite -> GoalCommand+cmd_context norm ii _ _ = ioTCM $+  display_infoD "*Context*" =<< prettyContext norm ii++cmd_infer :: B.Rewrite -> GoalCommand+cmd_infer norm ii rng s = ioTCM $+  display_infoD "*Inferred Type*"+    =<< B.withInteractionId ii+          (prettyA =<< B.typeInMeta ii norm =<< B.parseExprIn ii rng s)++cmd_goal_type :: B.Rewrite -> GoalCommand+cmd_goal_type norm ii _ _ = ioTCM $ do+    s <- B.withInteractionId ii $ prettyTypeOfMeta norm ii+    display_infoD "*Current Goal*" s++-- | Displays the current goal and context plus the given document.++cmd_goal_type_context_and :: Doc -> B.Rewrite -> GoalCommand+cmd_goal_type_context_and s norm ii _ _ = ioTCM $ do+    goal <- B.withInteractionId ii $ prettyTypeOfMeta norm ii+    ctx  <- prettyContext norm ii+    display_infoD "*Goal type etc.*"+                  (ctx $+$+                   text (replicate 60 '\x2014') $+$+                   text "Goal:" <+> goal $+$+                   s)++-- | Displays the current goal and context.++cmd_goal_type_context :: B.Rewrite -> GoalCommand+cmd_goal_type_context = cmd_goal_type_context_and P.empty++-- | Displays the current goal and context /and/ infers the type of an+-- expression.++cmd_goal_type_context_infer :: B.Rewrite -> GoalCommand+cmd_goal_type_context_infer norm ii rng s = ioTCM $ do+    typ <- B.withInteractionId ii $+             prettyA =<< B.typeInMeta ii norm =<< B.parseExprIn ii rng s+    liftIO $ cmd_goal_type_context_and+               (text "Have:" <+> typ)+               norm ii rng s++-- | Sets the command line options and updates the status information.++setCommandLineOptions :: CommandLineOptions -> TCM ()+setCommandLineOptions opts = do+  TM.setCommandLineOptions opts+  displayStatus++-- | Displays\/updates some status information (currently just+-- indicates whether or not implicit arguments are shown).++displayStatus :: TCM ()+displayStatus = do+  showImpl <- showImplicitArguments+  let statusString = if showImpl then "ShowImplicit" else ""+  liftIO $ UTF8.putStrLn $ response $+    L [A "agda2-status-action", A (quote statusString)]++-- | @display_info header content@ displays @content@ (with header+-- @header@) in some suitable way, and also displays some status+-- information (see 'displayStatus').++display_info :: String -> String -> TCM ()+display_info bufname content = do+  displayStatus+  liftIO $ UTF8.putStrLn $ response $+    L [ A "agda2-info-action"+      , A (quote bufname)+      , A (quote content)+      ]++-- | Like 'display_info', but takes a 'Doc' instead of a 'String'.++display_infoD :: String -> Doc -> TCM ()+display_infoD bufname content = display_info bufname (render content)++response :: Lisp String -> String+response l = show (text "agda2_mode_code" <+> pretty l)++data Lisp a = A a | L [Lisp a] | Q (Lisp a)++instance Pretty a => Pretty (Lisp a) where+  pretty (A a ) = pretty a+  pretty (L xs) = parens (sep (List.map pretty xs))+  pretty (Q x)  = text "'"<>pretty x++instance Pretty String where pretty = text++instance Pretty a => Show (Lisp a) where show = show . pretty++showNumIId = A . tail . show++takenNameStr :: TCM [String]+takenNameStr = do+  xss <- sequence [ List.map (fst . unArg) <$> getContext+                  , Map.keys <$> asks envLetBindings+                  , List.map qnameName . Map.keys . sigDefinitions <$> getSignature+		  ]+  return $ concat [ parts $ nameConcrete x | x <- concat xss]+  where+    parts x = [ s | Id s <- nameParts x ]++refreshStr :: [String] -> String -> ([String], String)+refreshStr taken s = go nameModifiers where+  go (m:mods) = let s' = s ++ m in+                if s' `elem` taken then go mods else (s':taken, s')+  go _        = __IMPOSSIBLE__++nameModifiers = "" : "'" : "''" : [show i | i <-[3..]]++cmd_make_case :: GoalCommand+cmd_make_case ii rng s = ioTCM $ do+  cs <- makeCase ii rng s+  B.withInteractionId ii $ do+    pcs <- mapM prettyA cs+    liftIO $ UTF8.putStrLn $ response $+      L [ A "agda2-make-case-action",+          Q $ L $ List.map (A . quote . show) pcs+        ]++cmd_solveAll :: IO ()+cmd_solveAll = ioTCM $ do+    out <- getInsts+    liftIO $ UTF8.putStrLn $ response $+      L[ A"agda2-solveAll-action" , Q . L $ concatMap prn out]+  where+  getInsts = mapM lowr =<< B.getSolvedInteractionPoints+    where+      lowr (i, m, e) = do+        mi <- getMetaInfo <$> lookupMeta m+        e <- withMetaInfo mi $ lowerMeta <$> abstractToConcrete_ e+        return (i, e)+  prn (ii,e)= [showNumIId ii, A $ emacsStr $ show e]++class LowerMeta a where lowerMeta :: a -> a+instance LowerMeta SC.Expr where+  lowerMeta = go where+    go e = case e of+      Ident _              -> e+      SC.Lit _             -> e+      SC.QuestionMark _ _  -> preMeta+      SC.Underscore _ _    -> preUscore+      SC.App r e1 ae2      -> case appView e of+        SC.AppView (SC.QuestionMark _ _) _ -> preMeta+        SC.AppView (SC.Underscore   _ _) _ -> preUscore+        _ -> SC.App r (go e1) (lowerMeta ae2)+      SC.WithApp r e es	   -> SC.WithApp r (lowerMeta e) (lowerMeta es)+      SC.Lam r bs e1       -> SC.Lam r (lowerMeta bs) (go e1)+      SC.AbsurdLam r h     -> SC.AbsurdLam r h+      SC.Fun r ae1 e2      -> SC.Fun r (lowerMeta ae1) (go e2)+      SC.Pi tb e1          -> SC.Pi (lowerMeta tb) (go e1)+      SC.Set _             -> e+      SC.Prop _            -> e+      SC.SetN _ _          -> e+      SC.Let r ds e1       -> SC.Let r (lowerMeta ds) (go e1)+      Paren r e1           -> case go e1 of+        q@(SC.QuestionMark _ Nothing) -> q+        e2                            -> Paren r e2+      Absurd _          -> e+      As r n e1         -> As r n (go e1)+      SC.Dot r e	-> SC.Dot r (go e)+      SC.RawApp r es	-> SC.RawApp r (lowerMeta es)+      SC.OpApp r x es	-> SC.OpApp r x (lowerMeta es)+      SC.Rec r fs	-> SC.Rec r (List.map (id -*- lowerMeta) fs)+      SC.HiddenArg r e	-> SC.HiddenArg r (lowerMeta e)++instance LowerMeta SC.LamBinding where+  lowerMeta b@(SC.DomainFree _ _) = b+  lowerMeta (SC.DomainFull tb)    = SC.DomainFull (lowerMeta tb)++instance LowerMeta SC.TypedBindings where+  lowerMeta (SC.TypedBindings r h bs) = SC.TypedBindings r h (lowerMeta bs)++instance LowerMeta SC.TypedBinding where+  lowerMeta (SC.TBind r ns e) = SC.TBind r ns (lowerMeta e)+  lowerMeta (SC.TNoBind e)    = SC.TNoBind (lowerMeta e)++instance LowerMeta SC.RHS where+    lowerMeta (SC.RHS e)    = SC.RHS (lowerMeta e)+    lowerMeta  SC.AbsurdRHS = SC.AbsurdRHS++instance LowerMeta SC.Declaration where+  lowerMeta = go where+    go d = case d of+      TypeSig n e1            -> TypeSig n (lowerMeta e1)+      SC.Field n e1           -> SC.Field n (lowerMeta e1)+      FunClause lhs rhs whcl  -> FunClause lhs (lowerMeta rhs) (lowerMeta whcl)+      Data r ind n tel e1 cs  -> Data r ind n+                                 (lowerMeta tel) (lowerMeta e1) (lowerMeta cs)+      SC.Record r n tel e1 cs -> SC.Record r n+                                 (lowerMeta tel) (lowerMeta e1) (lowerMeta cs)+      Infix _ _               -> d+      Mutual r ds             -> Mutual r (lowerMeta ds)+      Abstract r ds           -> Abstract r (lowerMeta ds)+      Private r ds            -> Private r (lowerMeta ds)+      Postulate r sigs        -> Postulate r (lowerMeta sigs)+      SC.Primitive r sigs     -> SC.Primitive r (lowerMeta sigs)+      SC.Open _ _ _           -> d+      SC.Import _ _ _ _ _     -> d+      SC.Pragma _	      -> d+      ModuleMacro r n tel e1 op dir -> ModuleMacro r n+                                    (lowerMeta tel) (lowerMeta e1) op dir+      SC.Module r qn tel ds   -> SC.Module r qn (lowerMeta tel) (lowerMeta ds)++instance LowerMeta SC.WhereClause where+  lowerMeta SC.NoWhere		= SC.NoWhere+  lowerMeta (SC.AnyWhere ds)	= SC.AnyWhere $ lowerMeta ds+  lowerMeta (SC.SomeWhere m ds) = SC.SomeWhere m $ lowerMeta ds++instance LowerMeta a => LowerMeta [a] where+  lowerMeta as = List.map lowerMeta as++instance LowerMeta a => LowerMeta (Arg a) where+  lowerMeta aa = fmap lowerMeta aa++instance LowerMeta a => LowerMeta (Named name a) where+  lowerMeta aa = fmap lowerMeta aa+++preMeta   = SC.QuestionMark noRange Nothing+preUscore = SC.Underscore   noRange Nothing++cmd_compute :: Bool -- ^ Ignore abstract?+               -> GoalCommand+cmd_compute ignore ii rng s = ioTCM $ do+  e <- B.parseExprIn ii rng s+  d <- B.withInteractionId ii $ do+         let c = B.evalInCurrent e+         v <- if ignore then ignoreAbstractMode c else c+         prettyA v+  display_info "*Normal Form*" (show d)++-- | Parses and scope checks an expression (using insideScope topLevel+-- as the scope), performs the given command with the expression as+-- input, and displays the result.++parseAndDoAtToplevel+  :: (SA.Expr -> TCM SA.Expr)+     -- ^ The command to perform.+  -> String+     -- ^ The name to used for the buffer displaying the output.+  -> String+     -- ^ The expression to parse.+  -> IO ()+parseAndDoAtToplevel cmd title s = infoOnException $ do+  e <- parse exprParser s+  mTopLevel <- theTopLevel <$> readIORef theState+  ioTCM $ display_info title =<<+    case mTopLevel of+      Nothing       -> return "Error: First load the file."+      Just topLevel -> do+        setScope $ insideScope topLevel+        showA =<< cmd =<< concreteToAbstract_ e++-- | Parse the given expression (as if it were defined at the+-- top-level of the current module) and infer its type.++cmd_infer_toplevel+  :: B.Rewrite  -- ^ Normalise the type?+  -> String+  -> IO ()+cmd_infer_toplevel norm =+  parseAndDoAtToplevel (B.typeInCurrent norm) "*Inferred Type*"++-- | Parse and type check the given expression (as if it were defined+-- at the top-level of the current module) and normalise it.++cmd_compute_toplevel :: Bool -- ^ Ignore abstract?+                     -> String -> IO ()+cmd_compute_toplevel ignore =+  parseAndDoAtToplevel (if ignore then ignoreAbstractMode . c else c)+                       "*Normal Form*"+  where c = B.evalInCurrent++-- change "\<decimal>" to a single character+-- TODO: This seems to be the wrong solution to the problem. Attack+-- the source instead.+emacsStr s = go (show s) where+  go ('\\':ns@(n:_))+     | isDigit n = toEnum (read digits :: Int) : go rest+     where (digits, rest) = span isDigit ns+  go (c:s) = c : go s+  go []    = []++------------------------------------------------------------------------+-- Syntax highlighting++-- | Tell the Emacs mode to rescan the buffer for goals.++tellEmacsToUpdateGoals :: IO ()+tellEmacsToUpdateGoals = do+  is <- theInteractionPoints <$> readIORef theState+  UTF8.putStrLn $ response $ L [A "agda2-annotate", format is]+  where format = Q . L . List.map showNumIId++-- | Tell the Emacs mode to reload the highlighting information.++tellEmacsToReloadSyntaxInfo :: IO ()+tellEmacsToReloadSyntaxInfo =+  UTF8.putStrLn $ response $ L [A "agda2-highlight-reload"]++-- | Tells the Emacs mode to reload the highlighting information and+-- go to the first error position (if any).++tellEmacsToJumpToError :: Range -> IO ()+tellEmacsToJumpToError r = do+  case rStart r of+    Nothing                                -> return ()+    -- Errors for expressions entered using the command line sometimes+    -- have an empty file name component. This should be fixed.+    Just (Pn { srcFile = "" })             -> return ()+    Just (Pn { srcFile = f,  posPos = p }) ->+      UTF8.putStrLn $ response $+        L [A "annotation-goto", Q $ L [A (show f), A ".", A (show p)]]+  tellEmacsToReloadSyntaxInfo++------------------------------------------------------------------------+-- Implicit arguments++-- | Tells Agda whether or not to show implicit arguments.++showImplicitArgs :: Bool -- ^ Show them?+                 -> IO ()+showImplicitArgs showImpl = ioTCM $ do+  opts <- commandLineOptions+  setCommandLineOptions (opts { optShowImplicit = showImpl })++-- | Toggle display of implicit arguments.++toggleImplicitArgs :: IO ()+toggleImplicitArgs = ioTCM $ do+  opts <- commandLineOptions+  setCommandLineOptions (opts { optShowImplicit =+                                  not $ optShowImplicit opts })++------------------------------------------------------------------------+-- Error handling++-- | When an error message is displayed the following title should be+-- used, if appropriate.++errorTitle :: String+errorTitle = "*Error*"++-- | Displays an error (represented either as a 'TCErr' or as a+-- 'Range' and a message) and terminates the program.++displayErrorAndExit :: Either TCErr (Range, String) -> IO a+displayErrorAndExit err = do+  runTCM $ do+    appendErrorToEmacsFile err'+    display_info errorTitle =<< msg+  tellEmacsToJumpToError rng+  exitWith (ExitFailure 1)+  where+  err' = case err of+    Left e           -> e+    Right (rng, msg) -> Exception rng msg++  msg = case err of+    Left e             -> prettyError e+    Right (rng, msg)+      | rng == noRange -> return msg+      | otherwise      -> return (show rng ++ "\n" ++ msg)++  rng = case err of+    Left  e          -> getRange e+    Right (rng, msg) -> rng++-- | Outermost error handler. Should wrap all functions called from+-- Emacs (directly or indirectly).++infoOnException m =+  failOnException inform m `catchImpossible` \e ->+    inform noRange (show e)+  where inform rng msg = displayErrorAndExit (Right (rng, msg))

+ src/full/Agda/Interaction/Highlighting/Emacs.hs view

@@ -0,0 +1,145 @@+-- | Functions which give precise syntax highlighting info to Emacs.++module Agda.Interaction.Highlighting.Emacs+  ( clearSyntaxInfo+  , writeEmacsFile+  , appendErrorToEmacsFile+  , Agda.Interaction.Highlighting.Emacs.tests+  ) where++import Agda.Interaction.Highlighting.Precise+import Agda.Interaction.Highlighting.Range+import Agda.Interaction.Highlighting.Generate+import Agda.TypeChecking.Monad (TCM, TCErr)+import Agda.Syntax.Abstract (QName)+import Agda.Syntax.Common+import qualified Agda.Syntax.Position as P+import Agda.Syntax.Translation.ConcreteToAbstract (TopLevelInfo)+import Agda.TypeChecking.Errors (prettyError)+import Agda.Utils.FileName+import Agda.Utils.String+import Agda.Utils.TestHelpers++import Control.Monad.Trans+import Data.List+import Data.Char+import Data.Maybe+import qualified System.IO.UTF8 as UTF8++------------------------------------------------------------------------+-- Read/show functions++-- | Converts the 'aspect' and 'otherAspects' fields to atoms readable+-- by the Emacs interface.++toAtoms :: MetaInfo -> [String]+toAtoms m = map toAtom (otherAspects m) ++ toAtoms' (aspect m)+  where+  toAtom x = map toLower (show x)++  kindToAtom (Constructor Inductive)   = "inductiveconstructor"+  kindToAtom (Constructor CoInductive) = "coinductiveconstructor"+  kindToAtom k                         = toAtom k++  toAtoms' Nothing               = []+  toAtoms' (Just (Name mKind op)) =+    map kindToAtom (maybeToList mKind) ++ opAtom+    where opAtom | op        = ["operator"]+                 | otherwise = []+  toAtoms' (Just a) = [toAtom a]++-- | Shows meta information in such a way that it can easily be read+-- by Emacs.++showMetaInfo :: (Range, MetaInfo) -> String+showMetaInfo (r, m) =+     "(annotation-annotate "+  ++ show (from r)+  ++ " "+  ++ show (to r)+  ++ " '("+  ++ concat (intersperse " " (toAtoms m))+  ++ ")"+  ++ (maybe " nil" ((" " ++) . quote) $ note m)+  ++ (maybe ""+            (\(_, f, p) -> " '(" ++ quote f ++ " . " ++ show p ++ ")")+        $ definitionSite m)+  ++ ")"++-- | Shows a file in an Emacsy fashion.++showFile :: CompressedFile -> String+showFile = unlines . map showMetaInfo++------------------------------------------------------------------------+-- IO++-- | Gives the syntax highlighting information file name associated+-- with the given Agda file.++infoFileName :: FilePath -> String+infoFileName path | null dir  = base+                  | otherwise = dir ++ slash : base+  where+  (dir, name, ext) = splitFilePath path+  base = '.' : name ++ ext ++ ".el"++-- | Clears a syntax highlighting information file.+--+-- The output file name is constructed from the given file name by+-- prepending \".\" and appending \".el\".++clearSyntaxInfo+  :: FilePath+     -- ^ The path to the file which should be highlighted+     -- (not the file which should be cleared).+  -> IO ()+clearSyntaxInfo path = UTF8.writeFile (infoFileName path) ""++-- | Appends to a file with syntax highlighting information.++appendSyntaxInfo :: HighlightingInfo -> IO ()+appendSyntaxInfo highlighting =+  UTF8.appendFile (infoFileName $ source highlighting)+                  (showFile $ info highlighting)++------------------------------------------------------------------------+-- Driver which uses the code in+-- Agda.Interaction.Highlighting.Generate to create syntax+-- highlighting files++-- | Outputs syntax highlighting information after clearing existing+-- highlighting info.++writeEmacsFile :: HighlightingInfo -> TCM ()+writeEmacsFile highlighting = do+  liftIO $ clearSyntaxInfo (source highlighting)+  liftIO $ appendSyntaxInfo highlighting++-- | Appends information about an error to the highlighting file+-- relevant for the error.++appendErrorToEmacsFile :: TCErr -> TCM ()+appendErrorToEmacsFile err = do+  let r = P.getRange err+  s <- prettyError err+  case P.rStart r of+    Nothing                                         -> return ()+    -- Errors for expressions entered using the command line sometimes+    -- have an empty file name component. This should be fixed.+    Just     (P.Pn { P.srcFile = "" })              -> return ()+    Just pos@(P.Pn { P.srcFile = f, P.posPos = p }) -> do+      liftIO $ appendSyntaxInfo $+        HighlightingInfo { source = f+                         , info   = compress $ generateErrorInfo r s+                         }++------------------------------------------------------------------------+-- All tests++-- TODO: One could check that the show functions are invertible.++-- | All the properties.++tests :: IO Bool+tests = runTests "Agda.Interaction.Highlighting.Emacs" []

+ src/full/Agda/Interaction/Highlighting/Generate.hs view

@@ -0,0 +1,482 @@+{-# LANGUAGE CPP, Rank2Types #-}++-- | Generates data used for precise syntax highlighting.++module Agda.Interaction.Highlighting.Generate+  ( TypeCheckingState(..)+  , generateSyntaxInfo+  , generateErrorInfo+  , Agda.Interaction.Highlighting.Generate.tests+  )+  where++import Agda.Interaction.Highlighting.Precise hiding (tests)+import Agda.Interaction.Highlighting.Range   hiding (tests)+import Agda.TypeChecking.MetaVars (isBlockedTerm)+import Agda.TypeChecking.Monad+  hiding (MetaInfo, Primitive, Constructor, Record, Function, Datatype)+import qualified Agda.TypeChecking.Monad as M+import qualified Agda.TypeChecking.Reduce as R+import qualified Agda.Syntax.Abstract as A+import qualified Agda.Syntax.Concrete as C+import qualified Agda.Syntax.Internal as I+import qualified Agda.Syntax.Literal as L+import qualified Agda.Syntax.Parser as Pa+import qualified Agda.Syntax.Parser.Tokens as T+import qualified Agda.Syntax.Position as P+import qualified Agda.Syntax.Scope.Base as S+import qualified Agda.Syntax.Translation.ConcreteToAbstract as CA+import Agda.Utils.List+import Agda.Utils.TestHelpers+import Control.Monad+import Control.Monad.Trans+import Control.Monad.State+import Control.Applicative+import Data.Monoid+import Data.Generics+import Data.Function+import Agda.Utils.Generics+import Agda.Utils.FileName+import Data.Map (Map)+import qualified Data.Map as Map+import Data.Maybe+import Data.Sequence (Seq, (><))+import Data.List ((\\))+import qualified Data.Sequence as Seq+import qualified Data.Foldable as Fold (toList, fold, foldMap)++import Agda.Utils.Impossible+#include "../../undefined.h"++-- | Generates syntax highlighting information for an error,+-- represented as a range and a string. The range is first completed+-- so that there are no gaps in it.++generateErrorInfo :: P.Range -> String -> File+generateErrorInfo r s =+  several (rToR $ P.continuousPerLine r)+          (mempty { otherAspects = [Error], note = Just s })++-- | Has typechecking been done yet?++data TypeCheckingState = TypeCheckingDone | TypeCheckingNotDone+  deriving (Show, Eq)++-- | Generates syntax highlighting information.++generateSyntaxInfo+  :: FilePath               -- ^ The module to highlight.+  -> TypeCheckingState      -- ^ Has it been type checked?+  -> CA.TopLevelInfo        -- ^ The abstract syntax of the module.+  -> [([A.QName], [Range])] -- ^ Functions which failed to termination+                            --   check (grouped if they are mutual),+                            --   along with ranges for problematic+                            --   call sites.+  -> TCM HighlightingInfo+generateSyntaxInfo file tcs top termErrs =+  M.withScope_ (CA.insideScope top) $ M.ignoreAbstractMode $ do+    modMap <- sourceToModule file (CA.topLevelModuleName top)+    tokens <- liftIO $ Pa.parseFile' Pa.tokensParser file+    kinds  <- nameKinds tcs decls+    let nameInfo = mconcat $ map (generate modMap file kinds)+                                 (Fold.toList names)+    -- Constructors are only highlighted after type checking, since they+    -- can be overloaded.+    constructorInfo <-+      if tcs == TypeCheckingNotDone+         then return mempty+         else generateConstructorInfo modMap file kinds decls+    metaInfo <- if tcs == TypeCheckingNotDone+                   then return mempty+                   else computeUnsolvedMetaWarnings+    -- theRest needs to be placed before nameInfo here since record+    -- field declarations contain QNames. constructorInfo also needs+    -- to be placed before nameInfo since, when typechecking is done,+    -- constructors are included in both lists. Finally tokInfo is+    -- placed last since token highlighting is more crude than the+    -- others.+    return $ HighlightingInfo+               { source = file+               , info   = compress $+                            mconcat [ constructorInfo+                                    , theRest modMap+                                    , nameInfo+                                    , metaInfo+                                    , termInfo+                                    , tokInfo tokens+                                    ]+               }+  where+    decls = CA.topLevelDecls top++    tokInfo = Fold.foldMap tokenToFile+      where+      aToF a r = several (rToR r) (mempty { aspect = Just a })++      tokenToFile :: T.Token -> File+      tokenToFile (T.TokSetN (i, _))               = aToF PrimitiveType (P.getRange i)+      tokenToFile (T.TokKeyword T.KwSet  i)        = aToF PrimitiveType (P.getRange i)+      tokenToFile (T.TokKeyword T.KwProp i)        = aToF PrimitiveType (P.getRange i)+      tokenToFile (T.TokKeyword T.KwForall i)      = aToF Symbol (P.getRange i)+      tokenToFile (T.TokKeyword _ i)               = aToF Keyword (P.getRange i)+      tokenToFile (T.TokSymbol  _ i)               = aToF Symbol (P.getRange i)+      tokenToFile (T.TokLiteral (L.LitInt    r _)) = aToF Number r+      tokenToFile (T.TokLiteral (L.LitFloat  r _)) = aToF Number r+      tokenToFile (T.TokLiteral (L.LitString r _)) = aToF String r+      tokenToFile (T.TokLiteral (L.LitChar   r _)) = aToF String r+      tokenToFile (T.TokComment (i, _))            = aToF Comment (P.getRange i)+      tokenToFile (T.TokTeX (i, _))                = aToF Comment (P.getRange i)+      tokenToFile (T.TokId {})                     = mempty+      tokenToFile (T.TokQId {})                    = mempty+      tokenToFile (T.TokString {})                 = mempty+      tokenToFile (T.TokDummy {})                  = mempty+      tokenToFile (T.TokEOF {})                    = mempty++    termInfo = functionDefs `mappend` callSites+      where+      m            = mempty { otherAspects = [TerminationProblem] }+      functionDefs = Fold.foldMap (\x -> several (rToR $ bindingSite x) m) $+                     concatMap fst termErrs+      callSites    = Fold.foldMap (\r -> singleton r m) $+                     concatMap snd termErrs++    -- All names mentioned in the syntax tree (not bound variables).+    names = everything' (><) (Seq.empty `mkQ`  getName+                                        `extQ` getAmbiguous)+                        decls+      where+      getName :: A.QName -> Seq A.AmbiguousQName+      getName n = Seq.singleton (A.AmbQ [n])++      getAmbiguous :: A.AmbiguousQName -> Seq A.AmbiguousQName+      getAmbiguous = Seq.singleton++    -- Bound variables, dotted patterns, record fields and module+    -- names.+    theRest modMap = everything' mappend query decls+      where+      query :: GenericQ File+      query = mempty         `mkQ`+              getFieldDecl   `extQ`+              getVarAndField `extQ`+              getLet         `extQ`+              getLam         `extQ`+              getTyped       `extQ`+              getPattern     `extQ`+              getModuleName++      bound n = nameToFile modMap file []+                           (A.nameConcrete n)+                           (\isOp -> mempty { aspect = Just $ Name (Just Bound) isOp })+                           (Just $ A.nameBindingSite n)+      field m n = nameToFile modMap file m n+                             (\isOp -> mempty { aspect = Just $ Name (Just Field) isOp })+                             Nothing+      mod n = nameToFile modMap file []+                         (A.nameConcrete n)+                         (\isOp -> mempty { aspect = Just $ Name (Just Module) isOp })+                         (Just $ A.nameBindingSite n)++      getVarAndField :: A.Expr -> File+      getVarAndField (A.Var x)    = bound x+      getVarAndField (A.Rec _ fs) = mconcat $ map (field [] . fst) fs+      getVarAndField _            = mempty++      getLet :: A.LetBinding -> File+      getLet (A.LetBind _ x _ _) = bound x+      getLet A.LetApply{}        = mempty++      getLam :: A.LamBinding -> File+      getLam (A.DomainFree _ x) = bound x+      getLam (A.DomainFull {})  = mempty++      getTyped :: A.TypedBinding -> File+      getTyped (A.TBind _ xs _) = mconcat $ map bound xs+      getTyped (A.TNoBind {})   = mempty++      getPattern :: A.Pattern -> File+      getPattern (A.VarP x)    = bound x+      getPattern (A.AsP _ x _) = bound x+      getPattern (A.DotP pi _) =+        several (rToR $ P.getRange pi)+                (mempty { otherAspects = [DottedPattern] })+      getPattern _             = mempty++      getFieldDecl :: A.Definition -> File+      getFieldDecl (A.RecDef _ _ _ _ fs) = Fold.foldMap extractField fs+        where+        extractField (A.ScopedDecl _ ds) = Fold.foldMap extractField ds+        extractField (A.Field _ x _)     = field (concreteQualifier x)+                                                 (concreteBase x)+        extractField _                   = mempty+      getFieldDecl _                   = mempty++      getModuleName :: A.ModuleName -> File+      getModuleName (A.MName { A.mnameToList = xs }) =+        mconcat $ map mod xs++-- | A function mapping names to the kind of name they stand for.++type NameKinds = A.QName -> Maybe NameKind++-- | Builds a 'NameKinds' function.++nameKinds :: TypeCheckingState+          -> [A.Declaration]+          -> TCM NameKinds+nameKinds tcs decls = do+  imported <- fix . stImports <$> get+  local    <- case tcs of+    TypeCheckingDone    -> fix . stSignature <$> get+    TypeCheckingNotDone -> return $+      -- Traverses the syntax tree and constructs a map from qualified+      -- names to name kinds. TODO: Handle open public.+      everything' union (Map.empty `mkQ` getDef `extQ` getDecl) decls+  let merged = Map.union local imported+  return (\n -> Map.lookup n merged)+  where+  fix = Map.map (defnToNameKind . theDef) . sigDefinitions++  -- | The 'M.Axiom' constructor is used to represent various things+  -- which are not really axioms, so when maps are merged 'Postulate's+  -- are thrown away whenever possible. The 'getDef' and 'getDecl'+  -- functions below can return several explanations for one qualified+  -- name; the 'Postulate's are bogus.+  union = Map.unionWith dropPostulates+    where+    dropPostulates Postulate k = k+    dropPostulates k         _ = k++  defnToNameKind :: Defn -> NameKind+  defnToNameKind (M.Axiom {})                     = Postulate+  defnToNameKind (M.Function {})                  = Function+  defnToNameKind (M.Datatype {})                  = Datatype+  defnToNameKind (M.Record {})                    = Record+  defnToNameKind (M.Constructor { M.conInd = i }) = Constructor i+  defnToNameKind (M.Primitive {})                 = Primitive++  getAxiomName :: A.Declaration -> A.QName+  getAxiomName (A.Axiom _ q _) = q+  getAxiomName _               = __IMPOSSIBLE__++  getDef :: A.Definition -> Map A.QName NameKind+  getDef (A.FunDef  _ q _)      = Map.singleton q Function+  getDef (A.DataDef _ q i _ cs) = Map.singleton q Datatype `union`+                                  (Map.unions $+                                   map (\q -> Map.singleton q (Constructor i)) $+                                   map getAxiomName cs)+  getDef (A.RecDef  _ q _ _ _)  = Map.singleton q Record+  getDef (A.ScopedDef {})       = Map.empty++  getDecl :: A.Declaration -> Map A.QName NameKind+  getDecl (A.Axiom _ q _)     = Map.singleton q Postulate+  getDecl (A.Field _ q _)     = Map.singleton q Field+  getDecl (A.Primitive _ q _) = Map.singleton q Primitive+  getDecl (A.Definition {})   = Map.empty+  getDecl (A.Section {})      = Map.empty+  getDecl (A.Apply {})        = Map.empty+  getDecl (A.Import {})       = Map.empty+  getDecl (A.Pragma {})       = Map.empty+  getDecl (A.ScopedDecl {})   = Map.empty++-- | Generates syntax highlighting information for all constructors+-- occurring in patterns and expressions in the given declarations.+--+-- This function should only be called after type checking.+-- Constructors can be overloaded, and the overloading is resolved by+-- the type checker.++generateConstructorInfo+  :: SourceToModule  -- ^ Maps source file paths to module names.+  -> FilePath        -- ^ The module to highlight.+  -> NameKinds+  -> [A.Declaration]+  -> TCM File+generateConstructorInfo modMap file kinds decls = do+  -- Extract all defined names from the declaration list.+  let names = Fold.toList $ Fold.foldMap A.allNames decls++  -- Look up the corresponding declarations in the internal syntax.+  defMap <- M.sigDefinitions <$> M.getSignature+  let defs = catMaybes $ map (flip Map.lookup defMap) names++  -- Instantiate meta variables.+  clauses <- R.instantiateFull $ concatMap M.defClauses defs+  types   <- R.instantiateFull $ map defType defs++  -- Find all constructors occurring in type signatures or clauses+  -- within the given declarations.+  let constrs = everything' (><) query (types, clauses)++  -- Return suitable syntax highlighting information.+  return $ Fold.fold $ fmap (generate modMap file kinds . mkAmb) constrs+  where+  mkAmb q = A.AmbQ [q]++  query :: GenericQ (Seq A.QName)+  query = mempty          `mkQ`+          getConstructor  `extQ`+          getConstructorP++  getConstructor :: I.Term -> Seq A.QName+  getConstructor (I.Con q _) = Seq.singleton q+  getConstructor _           = Seq.empty++  getConstructorP :: I.Pattern -> Seq A.QName+  getConstructorP (I.ConP q _) = Seq.singleton q+  getConstructorP _            = Seq.empty++-- | Generates syntax highlighting information for unsolved meta+-- variables.++computeUnsolvedMetaWarnings :: TCM File+computeUnsolvedMetaWarnings = do+  is <- getInteractionMetas++  -- We don't want to highlight blocked terms, since+  --   * there is always at least one proper meta responsible for the blocking+  --   * in many cases the blocked term covers the highlighting for this meta+  let notBlocked m = not <$> isBlockedTerm m+  ms <- filterM notBlocked =<< getOpenMetas++  rs <- mapM getMetaRange (ms \\ is)+  return $ several (concatMap (rToR . P.continuousPerLine) rs)+         $ mempty { otherAspects = [UnsolvedMeta] }++-- | Generates a suitable file for a possibly ambiguous name.++generate :: SourceToModule+            -- ^ Maps source file paths to module names.+         -> FilePath+            -- ^ The module to highlight.+         -> NameKinds+         -> A.AmbiguousQName+         -> File+generate modMap file kinds (A.AmbQ qs) =+  mconcat $ map (\q -> nameToFileA modMap file q include m) qs+  where+    ks   = map kinds qs+    kind = case (allEqual ks, ks) of+             (True, Just k : _) -> Just k+             _                  -> Nothing+    -- Note that all names in an AmbiguousQName should have the same+    -- concrete name, so either they are all operators, or none of+    -- them are.+    m isOp  = mempty { aspect = Just $ Name kind isOp }+    include = allEqual (map bindingSite qs)++-- | Converts names to suitable 'File's.++nameToFile :: SourceToModule+              -- ^ Maps source file paths to module names.+           -> FilePath+              -- ^ The file name of the current module. Used for+              -- consistency checking.+           -> [C.Name]+              -- ^ The name qualifier (may be empty).+           -> C.Name+              -- ^ The base name.+           -> (Bool -> MetaInfo)+              -- ^ Meta information to be associated with the name.+              -- The argument is 'True' iff the name is an operator.+           -> Maybe P.Range+              -- ^ The definition site of the name. The calculated+              -- meta information is extended with this information,+              -- if possible.+           -> File+nameToFile modMap file xs x m mR =+  -- Make sure that we don't get any funny ranges.+  if all (== file) $ catMaybes $+     map (fmap P.srcFile . P.rStart . P.getRange) (x : xs) then+    several rs' ((m isOp) { definitionSite = mFilePos })+   else+    __IMPOSSIBLE__+  where+  (rs, isOp) = getRanges x+  rs'        = rs ++ concatMap (fst . getRanges) xs+  mFilePos   = do+    r <- mR+    P.Pn { P.srcFile = f, P.posPos = p } <- P.rStart r+    mod <- Map.lookup f modMap+    return (toStrings mod, f, toInteger p)++-- | A variant of 'nameToFile' for qualified abstract names.++nameToFileA :: SourceToModule+               -- ^ Maps source file paths to module names.+            -> FilePath+               -- ^ The file name of the current module. Used for+               -- consistency checking.+            -> A.QName+               -- ^ The name.+            -> Bool+               -- ^ Should the binding site be included in the file?+            -> (Bool -> MetaInfo)+               -- ^ Meta information to be associated with the name.+               -- ^ The argument is 'True' iff the name is an operator.+            -> File+nameToFileA modMap file x include m =+  nameToFile modMap+             file+             (concreteQualifier x)+             (concreteBase x)+             m+             (if include then Just $ bindingSite x else Nothing)++concreteBase      = A.nameConcrete . A.qnameName+concreteQualifier = map A.nameConcrete . A.mnameToList . A.qnameModule+bindingSite       = A.nameBindingSite . A.qnameName+toStrings         = map show . A.mnameToList++-- | Maps source file names to the corresponding top-level module+-- names.++type SourceToModule = Map FilePath A.ModuleName++sourceToModule+  :: FilePath            -- ^ The current source file.+  -> A.ModuleName        -- ^ The current top-level module name.+  -> TCM SourceToModule+sourceToModule file mod =+  Map.fromList .+  (:) (file, mod) .+  map (\(m, (i, _)) -> (source $ M.iHighlighting i, m)) .+  Map.toList <$>+  M.getVisitedModules++-- | Like 'everything', but modified so that it does not descend into+-- everything.++everything' :: (r -> r -> r) -> GenericQ r -> GenericQ r+everything' (+) = everythingBut+                    (+)+                    (False `mkQ` isString+                           `extQ` isAQName `extQ` isAName `extQ` isCName+                           `extQ` isScope `extQ` isMap1 `extQ` isMap2+                           `extQ` isAmbiguous)+  where+  isString    :: String                        -> Bool+  isAQName    :: A.QName                       -> Bool+  isAName     :: A.Name                        -> Bool+  isCName     :: C.Name                        -> Bool+  isScope     :: S.ScopeInfo                   -> Bool+  isMap1      :: Map A.QName A.QName           -> Bool+  isMap2      :: Map A.ModuleName A.ModuleName -> Bool+  isAmbiguous :: A.AmbiguousQName              -> Bool++  isString    = const True+  isAQName    = const True+  isAName     = const True+  isCName     = const True+  isScope     = const True+  isMap1      = const True+  isMap2      = const True+  isAmbiguous = const True++------------------------------------------------------------------------+-- All tests++-- | All the properties.++tests :: IO Bool+tests = runTests "Agda.Interaction.Highlighting.Generate" []

+ src/full/Agda/Interaction/Highlighting/HTML.hs view

@@ -0,0 +1,166 @@+-- | Function for generating highlighted, hyperlinked HTML from Agda+-- sources.++module Agda.Interaction.Highlighting.HTML+  ( generateHTML+  ) where++import Control.Applicative+import Control.Monad+import Control.Monad.Trans+import Control.Arrow ((***))+import System.FilePath+import System.Directory+import Text.XHtml.Strict+import Data.Function+import Data.Monoid+import Data.Maybe+import qualified Data.Map  as Map+import qualified Data.List as List+import qualified Agda.Utils.IO as UTF8++import Paths_Agda++import Agda.Interaction.Highlighting.Generate+import Agda.Interaction.Highlighting.Precise+import Agda.Interaction.Highlighting.Range+import qualified Agda.Interaction.Imports as Imp+import Agda.TypeChecking.Monad (TCM)+import qualified Agda.TypeChecking.Monad as TCM+import qualified Agda.Syntax.Abstract as A+import Agda.Syntax.Common+import qualified Agda.Syntax.Scope.Monad as Scope+import Agda.Syntax.Translation.ConcreteToAbstract+import Agda.Interaction.Options++-- | The name of the default CSS file.++defaultCSSFile :: FilePath+defaultCSSFile = "Agda.css"++-- | Generates HTML files from all the sources which the given module+-- depends on (including the module itself).+--+-- This function should only be called after type checking has+-- completed successfully.++generateHTML :: A.ModuleName -> TCM ()+generateHTML mod = do+  options <- TCM.commandLineOptions+  case optHTMLDir options of+    Nothing  -> TCM.typeError TCM.HTMLDirUndefined+    Just dir -> do+      liftIO $ createDirectoryIfMissing True dir++      -- If the default CSS file should be used, then it is copied to+      -- the output directory.+      liftIO $ when (isNothing $ optCSSFile options) $ do+        cssFile <- getDataFileName defaultCSSFile+        copyFile cssFile (dir </> defaultCSSFile)++      TCM.reportSLn "html" 1 $+        "\nWarning: HTML is currently generated for ALL files which can be\n\+        \reached from the given module, including library files.\n"++      -- Pull highlighting info from the state and generate all the+      -- web pages.+      mapM_ (\(m, h) -> generatePage dir m h) =<<+        map (id *** TCM.iHighlighting) . Map.toList <$>+          TCM.getAllModules++-- | Converts module names to the corresponding HTML file names.++modToFile :: [String] -> FilePath+modToFile m = List.intercalate "." m <.> "html"++-- | Generates an HTML file with a highlighted, hyperlinked version of+-- the given module.++generatePage+  :: FilePath         -- ^ Directory in which to create files.+  -> A.ModuleName     -- ^ Module to be highlighted.+  -> HighlightingInfo -- ^ Syntax highlighting info for the module.+  -> TCM ()+generatePage dir mod highlighting = do+  contents <- liftIO $ UTF8.readTextFile (source highlighting)+  css      <- maybe defaultCSSFile id . optCSSFile <$>+                TCM.commandLineOptions+  let html = page css mod contents (info highlighting)+  TCM.reportSLn "html" 1 $ "Generating HTML for " ++ show mod +++                           " (" ++ target ++ ")."+  liftIO $ UTF8.writeFile target (renderHtml html)+  where target = dir </> modToFile (map show $ A.mnameToList mod)++-- | Constructs the web page, including headers.++page :: FilePath       -- ^ URL to the CSS file.+     -> A.ModuleName   -- ^ Module to be highlighted.+     -> String         -- ^ The contents of the module.+     -> CompressedFile -- ^ Highlighting information.+     -> Html+page css modName contents info =+  header (thetitle << show modName+            ++++          meta ! [ httpequiv "Content-Type"+                 , content "text/html; charset=UTF-8"+                 ]+            ++++          meta ! [ httpequiv "Content-Style-Type"+                 , content "text/css"+                 ]+            ++++          thelink noHtml ! [ href css+                           , rel "stylesheet"+                           , thetype "text/css"+                           ])+  ++++  body << pre << code contents info++-- | Constructs the HTML displaying the code.++code :: String         -- ^ The contents of the module.+     -> CompressedFile -- ^ Highlighting information.+     -> Html+code contents info =+  mconcat $+  map (\(pos, s, mi) -> annotate pos mi (stringToHtml s)) $+  map (\cs@((mi, (pos, _)) : _) ->+         (pos, map (snd . snd) cs, maybe mempty id mi)) $+  List.groupBy ((==) `on` fst) $+  map (\(pos, c) -> (Map.lookup pos infoMap, (pos, c))) $+  zip [1..] contents+  where+  infoMap = toMap (decompress info)++  annotate :: Integer -> MetaInfo -> Html -> Html+  annotate pos mi = anchor ! attributes+    where+    attributes =+      [name (show pos)] +++      maybe [] link (definitionSite mi) +++      (case classes of+        [] -> []+        cs -> [theclass $ unwords cs])++    classes =+      maybe [] noteClasses (note mi)+      ++ otherAspectClasses (otherAspects mi)+      ++ maybe [] aspectClasses (aspect mi)++    aspectClasses (Name mKind op) = kindClass ++ opClass+      where+      kindClass = maybe [] ((: []) . showKind) mKind++      showKind (Constructor Inductive)   = "InductiveConstructor"+      showKind (Constructor CoInductive) = "CoinductiveConstructor"+      showKind k                         = show k++      opClass = if op then ["Operator"] else []+    aspectClasses a = [show a]++    otherAspectClasses = map show++    -- Notes are not included.+    noteClasses s = []++    link (m, f, pos) = [href $ modToFile m ++ "#" ++ show pos]

+ src/full/Agda/Interaction/Highlighting/Precise.hs view

@@ -0,0 +1,308 @@+{-# LANGUAGE DeriveDataTypeable #-}++-- | Types used for precise syntax highlighting.++module Agda.Interaction.Highlighting.Precise+  ( Aspect(..)+  , NameKind(..)+  , OtherAspect(..)+  , MetaInfo(..)+  , File+  , HighlightingInfo(..)+  , singleton+  , several+  , smallestPos+  , toMap+  , CompressedFile+  , compress+  , decompress+  , Agda.Interaction.Highlighting.Precise.tests+  ) where++import Agda.Utils.TestHelpers+import Agda.Utils.String+import Agda.Utils.List hiding (tests)+import Data.List+import Data.Function+import Data.Monoid+import Control.Monad+import Agda.Utils.QuickCheck+import Data.Map (Map)+import qualified Data.Map as Map+import Data.Generics++import qualified Agda.Syntax.Abstract.Name as A+import qualified Agda.Syntax.Common as C++import Agda.Interaction.Highlighting.Range++------------------------------------------------------------------------+-- Files++-- | Various more or less syntactic aspects of the code. (These cannot+-- overlap.)++data Aspect+  = Comment+  | Keyword+  | String+  | Number+  | Symbol                     -- ^ Symbols like forall, =, ->, etc.+  | PrimitiveType              -- ^ Things like Set and Prop.+  | Name (Maybe NameKind) Bool -- ^ Is the name an operator part?+    deriving (Eq, Show, Typeable, Data)++data NameKind+  = Bound                   -- ^ Bound variable.+  | Constructor C.Induction -- ^ Inductive or coinductive constructor.+  | Datatype+  | Field                   -- ^ Record field.+  | Function+  | Module                  -- ^ Module name.+  | Postulate+  | Primitive               -- ^ Primitive.+  | Record                  -- ^ Record type.+    deriving (Eq, Show, Typeable, Data)++-- | Other aspects. (These can overlap with each other and with+-- 'Aspect's.)++data OtherAspect+  = Error+  | DottedPattern+  | UnsolvedMeta+  | TerminationProblem+  | IncompletePattern+    -- ^ When this constructor is used it is probably a good idea to+    -- include a 'note' explaining why the pattern is incomplete.+    deriving (Eq, Show, Enum, Bounded, Typeable, Data)++-- | Meta information which can be associated with a+-- character\/character range.++data MetaInfo = MetaInfo+  { aspect       :: Maybe Aspect+  , otherAspects :: [OtherAspect]  +  , note         :: Maybe String+    -- ^ This note, if present, can be displayed as a tool-tip or+    -- something like that. It should contain useful information about+    -- the range (like the module containing a certain identifier, or+    -- the fixity of an operator).+  , definitionSite :: Maybe ([String], FilePath, Integer)+    -- ^ The definition site of the annotated thing, if applicable and+    --   known. File positions are counted from 1. The list of strings+    --   is the name of the /top-level/ module in which the thing is+    --   defined.+  }+  deriving (Eq, Show, Typeable, Data)++-- | A 'File' is a mapping from file positions to meta information.+--+-- The first position in the file has number 1.++newtype File = File { mapping :: Map Integer MetaInfo }+  deriving (Eq, Show, Typeable, Data)++-- | Returns the smallest position, if any, in the 'File'.++smallestPos :: File -> Maybe Integer+smallestPos = fmap (fst . fst) . Map.minViewWithKey . mapping++-- | Syntax highlighting information for a given source file.++data HighlightingInfo =+  HighlightingInfo { source :: FilePath+                     -- ^ The source file.+                   , info :: CompressedFile+                     -- ^ Highlighting info.+                   }+  deriving (Typeable, Data)++------------------------------------------------------------------------+-- Creation++-- | @'singleton' r m@ is a file whose positions are those in @r@, and+-- in which every position is associated with @m@.++singleton :: Range -> MetaInfo -> File+singleton r m = File {+ mapping = Map.fromAscList [ (p, m) | p <- toList r ] }++prop_singleton r m =+  compress (singleton r m) ==+    if null (toList r) then [] else [(r, m)]++-- | Like 'singleton', but with several ranges instead of only one.++several :: [Range] -> MetaInfo -> File+several rs m = mconcat $ map (\r -> singleton r m) rs++------------------------------------------------------------------------+-- Merging++-- | Merges meta information.++mergeMetaInfo :: MetaInfo -> MetaInfo -> MetaInfo+mergeMetaInfo m1 m2 = MetaInfo+  { aspect       = (mplus `on` aspect) m1 m2+  , otherAspects = nub $ ((++) `on` otherAspects) m1 m2+  , note         = case (note m1, note m2) of+      (Just n1, Just n2) -> Just $+         if n1 == n2 then n1+                     else addFinalNewLine n1 ++ "----\n" ++ n2+      (Just n1, Nothing) -> Just n1+      (Nothing, Just n2) -> Just n2+      (Nothing, Nothing) -> Nothing+  , definitionSite = (mplus `on` definitionSite) m1 m2+  }++instance Monoid MetaInfo where+  mempty = MetaInfo { aspect         = Nothing+                    , otherAspects   = []+                    , note           = Nothing+                    , definitionSite = Nothing+                    }+  mappend = mergeMetaInfo++-- | Merges files.++merge :: File -> File -> File+merge f1 f2 =+  File { mapping = (Map.unionWith mappend `on` mapping) f1 f2 }++instance Monoid File where+  mempty  = File { mapping = Map.empty }+  mappend = merge++------------------------------------------------------------------------+-- Inspection++-- | Convert the 'File' to a map from file positions (counting from 1)+-- to meta information.++toMap :: File -> Map Integer MetaInfo+toMap = mapping++------------------------------------------------------------------------+-- Compression++-- | A compressed 'File', in which consecutive positions with the same+-- 'MetaInfo' are stored together.++type CompressedFile = [(Range, MetaInfo)]++-- | Compresses a file by merging consecutive positions with equal+-- meta information into longer ranges.++compress :: File -> CompressedFile+compress f = map join $ groupBy' p (Map.toAscList $ mapping f)+  where+  p (pos1, m1) (pos2, m2) = pos2 == pos1 + 1 && m1 == m2+  join pms = ( Range { from = head ps, to = last ps + 1 }+             , head ms+             )+    where (ps, ms) = unzip pms ++-- | Decompresses a compressed file.++decompress :: CompressedFile -> File+decompress =+  File .+  Map.fromList .+  concat .+  map (\(r, m) -> [ (p, m) | p <- toList r ])++prop_compress f =+  decompress c == f+  &&+  and (map (rangeInvariant . fst) c)+  &&+  and [ not (overlapping r1 r2) | (r1, r2) <- allPairs (map fst c) ]+  where+    c = compress f++    allPairs []       = []+    allPairs (x : xs) = map ((,) x) xs ++ allPairs xs++------------------------------------------------------------------------+-- Generators++instance Arbitrary Aspect where+  arbitrary =+    frequency [ (3, elements [ Comment, Keyword, String, Number+                             , Symbol, PrimitiveType ])+              , (1, liftM2 Name (maybeGen arbitrary) arbitrary)+              ]++instance CoArbitrary Aspect where+  coarbitrary Comment       = variant 0+  coarbitrary Keyword       = variant 1+  coarbitrary String        = variant 2+  coarbitrary Number        = variant 3+  coarbitrary Symbol        = variant 4+  coarbitrary PrimitiveType = variant 5+  coarbitrary (Name nk b)   =+    variant 6 . maybeCoGen coarbitrary nk . coarbitrary b++instance Arbitrary NameKind where+  arbitrary = oneof $ [liftM Constructor arbitrary] +++                      map return [ Bound+                                 , Datatype+                                 , Field+                                 , Function+                                 , Module+                                 , Postulate+                                 , Primitive+                                 , Record+                                 ]++instance CoArbitrary NameKind where+  coarbitrary Bound             = variant 0+  coarbitrary (Constructor ind) = variant 1 . coarbitrary ind+  coarbitrary Datatype          = variant 2+  coarbitrary Field             = variant 3+  coarbitrary Function          = variant 4+  coarbitrary Module            = variant 5+  coarbitrary Postulate         = variant 6+  coarbitrary Primitive         = variant 7+  coarbitrary Record            = variant 8++instance Arbitrary OtherAspect where+  arbitrary = elements [minBound .. maxBound]++instance CoArbitrary OtherAspect where+  coarbitrary = coarbitrary . fromEnum++instance Arbitrary MetaInfo where+  arbitrary = do+    aspect  <- maybeGen arbitrary+    other   <- arbitrary+    note    <- maybeGen string+    defSite <- maybeGen (liftM3 (,,) (listOf string) string arbitrary)+    return (MetaInfo { aspect = aspect, otherAspects = other+                     , note = note, definitionSite = defSite })+    where string = listOfElements "abcdefABCDEF/\\.\"'@()åäö\n"++instance CoArbitrary MetaInfo where+  coarbitrary (MetaInfo aspect otherAspects note defSite) =+    coarbitrary aspect .+    coarbitrary otherAspects .+    coarbitrary note .+    coarbitrary defSite++instance Arbitrary File where+  arbitrary = fmap (File . Map.fromList) $ listOf arbitrary++instance CoArbitrary File where+  coarbitrary (File rs) = coarbitrary (Map.toAscList rs)++------------------------------------------------------------------------+-- All tests++-- | All the properties.++tests :: IO Bool+tests = runTests "Agda.Interaction.Highlighting.Precise"+  [ quickCheck' prop_singleton+  , quickCheck' prop_compress+  ]

+ src/full/Agda/Interaction/Highlighting/Range.hs view

@@ -0,0 +1,99 @@+{-# LANGUAGE DeriveDataTypeable #-}++-- | Ranges.++module Agda.Interaction.Highlighting.Range+  ( Range(..)+  , rangeInvariant+  , overlapping+  , toList+  , getRanges+  , getRangesA+  , rToR+  , Agda.Interaction.Highlighting.Range.tests+  ) where++import Agda.Utils.QuickCheck+import Data.List+import Data.Generics+import Agda.Utils.TestHelpers+import qualified Agda.Syntax.Abstract as A+import qualified Agda.Syntax.Concrete as C+import qualified Agda.Syntax.Position as P++-- | Character ranges. The first character in the file has position 1.+-- Note that the 'to' position is considered to be outside of the+-- range.+--+-- Invariant: @'from' '<=' 'to'@.++data Range = Range { from, to :: Integer }+             deriving (Eq, Ord, Show, Typeable, Data)++-- | The 'Range' invariant.++rangeInvariant :: Range -> Bool+rangeInvariant r = from r <= to r++-- | 'True' iff the ranges overlap.+--+-- The ranges are assumed to be well-formed.++overlapping :: Range -> Range -> Bool+overlapping r1 r2 = not $+  to r1 <= from r2 || to r2 <= from r1++-- | Converts a range to a list of positions.++toList :: Range -> [Integer]+toList r = [from r .. to r - 1]++------------------------------------------------------------------------+-- Conversion++-- | Calculates a set of ranges associated with a name.+--+-- For an operator the ranges associated with the NameParts are+-- returned. Otherwise the range associated with the Name is returned.+--+-- A boolean, indicating operatorness, is also returned.++getRanges :: C.Name -> ([Range], Bool)+getRanges n = (rToR $ P.getRange n, C.isOperator n)++-- | Like 'getRanges', but for 'A.QName's. Note that the module part+-- of the name is thrown away; only the base part is used.++getRangesA :: A.QName -> ([Range], Bool)+getRangesA = getRanges . A.nameConcrete . A.qnameName++-- | Converts a 'P.Range' to a list of 'Range's.++rToR :: P.Range -> [Range]+rToR (P.Range is) = map iToR is+  where+  iToR (P.Interval { P.iStart = P.Pn { P.posPos = pos1 }+                   , P.iEnd   = P.Pn { P.posPos = pos2 }+                   }) =+    Range { from = toInteger pos1, to = toInteger pos2 }++------------------------------------------------------------------------+-- Generators++instance Arbitrary Range where+  arbitrary = do+    [from, to] <- fmap sort $ vectorOf 2 positive+    return $ Range { from = from, to = to }++instance CoArbitrary Range where+  coarbitrary (Range f t) = coarbitrary f . coarbitrary t++------------------------------------------------------------------------+-- All tests++-- | All the properties.++tests :: IO Bool+tests = runTests "Agda.Interaction.Highlighting.Range"+  [ quickCheck' rangeInvariant+  ]

+ src/full/Agda/Interaction/Highlighting/Vim.hs view

@@ -0,0 +1,88 @@+{-# LANGUAGE CPP #-}++module Agda.Interaction.Highlighting.Vim where++import Control.Monad.Trans+import Data.Char+import Data.Set ( Set )+import Data.Map ( Map )+import qualified System.IO.UTF8 as UTF8++import qualified Data.List as List+import qualified Data.Map as Map+import qualified Data.Set as Set++import Agda.Syntax.Scope.Base+import Agda.Syntax.Concrete.Name as CName++import Agda.TypeChecking.Monad++import Agda.Utils.FileName+import Agda.Utils.Tuple++#include "../../undefined.h"+import Agda.Utils.Impossible++on f g x y = f (g x) (g y)++vimFile :: FilePath -> FilePath+vimFile file =+    case splitFilePath file of+	(path,name,ext)	-> path ++ "." ++ name ++ ext ++ ".vim"++escape :: String -> String+escape = concatMap esc+    where+	escchars = "$\\^.*~[]"+	esc c	| c `elem` escchars = ['\\',c]+		| otherwise	    = [c]++keyword :: String -> [String] -> String+keyword _ [] = ""+keyword cat ws	= "syn keyword " ++ unwords (cat : ws)++match :: String -> [String] -> String+match _ [] = ""+match cat ws	= "syn match " ++ cat ++ " \"" +++		    concat (List.intersperse "\\|" $ map escape ws) ++ "\""++matches :: [String] -> [String] -> [String] -> [String] -> [String]+matches cons icons defs idefs =+    map snd+    $ List.sortBy (compare `on` fst)+    $ cons' ++ defs' ++ icons' ++ idefs'+    where+	cons'  = foo "agdaConstructor"	    $ classify length cons+	icons' = foo "agdaInfixConstructor" $ classify length icons+	defs'  = foo "agdaFunction"	    $ classify length defs+	idefs' = foo "agdaInfixFunction"    $ classify length idefs++	classify f = List.groupBy ((==) `on` f)+		     . List.sortBy (compare `on` f)++	foo :: String -> [[String]] -> [(Int, String)]+	foo cat = map (length . head /\ match cat)++toVim :: NamesInScope -> String+toVim ns = unlines $ matches mcons micons mdefs midefs+    where+	cons = [ x | (x, [def]) <- Map.toList ns, anameKind def == ConName ]+	defs = [ x | (x, [def]) <- Map.toList ns, anameKind def == DefName ]++	mcons = map show cons+	mdefs = map show defs++	micons = concatMap parts cons+	midefs = concatMap parts defs++	parts (Qual _ _)	   = []+	parts (QName (NoName _ _)) = []+	parts (QName (Name _ [_])) = []+	parts (QName (Name _ ps))  = [ x | Id x <- ps ]++generateVimFile :: FilePath -> TCM ()+generateVimFile file = do+    scope <- getScope+    liftIO $ UTF8.writeFile (vimFile file) $ toVim $ names scope+    where+	names = allNamesInScope . mergeScopes . scopeStack

+ src/full/Agda/Interaction/Imports.hs view

@@ -0,0 +1,502 @@+{-# LANGUAGE CPP #-}+{-| This modules deals with how to find imported modules and loading their+    interface files.+-}+module Agda.Interaction.Imports where++import Prelude hiding (catch)++import Control.Monad.Error+import Control.Monad.State+import qualified Data.Map as Map+import qualified Data.List as List+import qualified Data.Set as Set+import qualified Data.ByteString.Lazy as BS+import Data.Generics+import Data.List+import System.Directory+import System.Time+import Control.Exception+import qualified System.IO.UTF8 as UTF8+import System.FilePath (isAbsolute)++import Agda.Syntax.Position+import qualified Agda.Syntax.Concrete as C+import Agda.Syntax.Abstract.Name+import Agda.Syntax.Parser +import Agda.Syntax.Scope.Base+import Agda.Syntax.Scope.Monad+import Agda.Syntax.Translation.ConcreteToAbstract+import Agda.Syntax.Internal++import Agda.Termination.TermCheck++import Agda.TypeChecking.Reduce+import Agda.TypeChecking.Monad+import Agda.TypeChecking.Monad.Builtin+import Agda.TypeChecking.Serialise+import Agda.TypeChecking.Primitive+import Agda.TypeChecker++import Agda.Interaction.Options+import Agda.Interaction.Highlighting.Precise (HighlightingInfo)+import Agda.Interaction.Highlighting.Generate+import Agda.Interaction.Highlighting.Emacs+import Agda.Interaction.Highlighting.Vim+import qualified Agda.Interaction.Highlighting.Range as R++import Agda.Utils.FileName+import Agda.Utils.Monad+import Agda.Utils.IO++import Agda.Utils.Impossible+#include "../undefined.h"++-- | Converts an Agda file name to the corresponding interface file+-- name.++toIFile :: FilePath -> FilePath+toIFile = setExtension ".agdai"++-- | Merge an interface into the current proof state.+mergeInterface :: Interface -> TCM ()+mergeInterface i = do+    let sig	= iSignature i+	builtin = Map.toList $ iBuiltin i+	prim	= [ x | (_,Prim x) <- builtin ]+	bi	= Map.fromList [ (x,Builtin t) | (x,Builtin t) <- builtin ]+    bs <- getBuiltinThings+    reportSLn "import.iface.merge" 10 $ "Merging interface"+    reportSLn "import.iface.merge" 20 $+      "  Current builtins " ++ show (Map.keys bs) ++ "\n" +++      "  New builtins     " ++ show (Map.keys bi)+    case Map.toList $ Map.intersection bs bi of+      []               -> return ()+      (b, Builtin x):_ -> typeError $ DuplicateBuiltinBinding b x x+      (_, Prim{}):_    -> __IMPOSSIBLE__+    modify $ \st -> st { stImports	    = unionSignatures [stImports st, sig]+		       , stImportedBuiltins = stImportedBuiltins st `Map.union` bi+		       }+    reportSLn "import.iface.merge" 20 $+      "  Rebinding primitives " ++ show prim+    prim <- Map.fromList <$> mapM rebind prim+    modify $ \st -> st { stImportedBuiltins = stImportedBuiltins st `Map.union` prim+		       }+    where+	rebind x = do+	    PrimImpl _ pf <- lookupPrimitiveFunction x+	    return (x, Prim pf)++addImportedThings :: Signature -> BuiltinThings PrimFun -> TCM ()+addImportedThings isig ibuiltin =+  modify $ \st -> st+    { stImports          = unionSignatures [stImports st, isig]+    , stImportedBuiltins = Map.union (stImportedBuiltins st) ibuiltin+    }++-- TODO: move+data FileType = SourceFile | InterfaceFile++findFile :: FileType -> ModuleName -> TCM FilePath+findFile ft m = do+    let x = mnameToConcrete m+    dirs <- getIncludeDirs+    let files = [ dir ++ [slash] ++ file+		| dir  <- dirs+		, file <- map (C.moduleNameToFileName x) exts+		]+    files' <- liftIO $ filterM doesFileExist files+    files' <- liftIO $ nubFiles files'+    case files' of+	[]	-> typeError $ FileNotFound m files+	file:_	-> return file+    where+	exts = case ft of+		SourceFile    -> [".agda", ".lagda"]+		InterfaceFile -> [".agdai"]++-- | Scope checks the given module. A proper version of the module+-- name (with correct definition sites) is returned.++scopeCheckImport :: ModuleName -> TCM (ModuleName, Scope)+scopeCheckImport x = do+    reportSLn "import.scope" 5 $ "Scope checking " ++ show x+    visited <- Map.keys <$> getVisitedModules+    reportSLn "import.scope" 10 $ "  visited: " ++ show visited+    (i,t)   <- getInterface x+    addImport x+    return (iModuleName i `withRangesOfQ` mnameToConcrete x, iScope i)++alreadyVisited :: ModuleName -> TCM (Interface, ClockTime) -> TCM (Interface, ClockTime)+alreadyVisited x getIface = do+    mm <- getVisitedModule x+    case mm of+	Just it	-> do+            reportSLn "import.visit" 10 $ "  Already visited " ++ show x+            return it+	Nothing	-> do+	    reportSLn "import.visit" 5 $ "  Getting interface for " ++ show x+	    (i, t) <- getIface+	    reportSLn "import.visit" 5 $ "  Now we've looked at " ++ show x+	    visitModule x i t+	    return (i, t)++getInterface :: ModuleName -> TCM (Interface, ClockTime)+getInterface x = alreadyVisited x $ addImportCycleCheck x $ do+    file <- findFile SourceFile x	-- requires source to exist++    reportSLn "import.iface" 10 $ "  Check for cycle"+    checkForImportCycle++    uptodate <- ifM ignoreInterfaces+		    (return False)+		    (liftIO $ toIFile file `isNewerThan` file)++    reportSLn "import.iface" 5 $ "  " ++ show x ++ " is " ++ (if uptodate then "" else "not ") ++ "up-to-date."++    (i,t) <- if uptodate+	then skip x file+	else typeCheck file++    visited <- isVisited x+    reportSLn "import.iface" 5 $ if visited then "  We've been here. Don't merge."+			         else "  New module. Let's check it out."+    unless visited $ mergeInterface i++    storeDecodedModule x i t+    return (i,t)++    where+	skip x file = do+	    -- Examine the mtime of the interface file. If it is newer than the+	    -- stored version (in stDecodedModules), or if there is no stored version,+	    -- read and decode it. Otherwise use the stored version.+            let ifile = toIFile file+	    t  <- liftIO $ getModificationTime ifile+	    mm <- getDecodedModule x+	    mi <- case mm of+		      Just (im, tm) ->+			 if tm < t+			 then do dropDecodedModule x+				 reportSLn "import.iface" 5 $ "  file is newer, re-reading " ++ ifile+				 liftIO $ readInterface ifile+			 else do reportSLn "import.iface" 5 $ "  using stored version of " ++ ifile+				 return (Just im)+		      Nothing ->+			 do reportSLn "import.iface" 5 $ "  no stored version, reading " ++ ifile+			    liftIO $ readInterface ifile++	    -- Check that it's the right version+	    case mi of+		Nothing	-> do+		    reportSLn "import.iface" 5 $ "  bad interface, re-type checking"+		    typeCheck file+		Just i	-> do++		    reportSLn "import.iface" 5 $ "  imports: " ++ show (iImportedModules i)++		    ts <- map snd <$> mapM getInterface (iImportedModules i)++		    -- If any of the imports are newer we need to retype check+		    if any (> t) ts+			then do+			    -- liftIO close	-- Close the interface file. See above.+			    typeCheck file+			else do+			    reportSLn "" 1 $ "Skipping " ++ show x ++ " (" ++ ifile ++ ")."+			    return (i, t)++	typeCheck file = do+	    -- Do the type checking+	    ms       <- getImportPath+	    vs       <- getVisitedModules+	    ds       <- getDecodedModules+	    opts     <- commandLineOptions+	    trace    <- getTrace+            isig     <- getImportedSignature+            ibuiltin <- gets stImportedBuiltins+	    r <- liftIO $ runTCM $ -- Every interface should be+	                           -- treated in isolation.+                   createInterface opts trace ms vs ds+                                   isig ibuiltin (Just x) file False++	    case r of+		Left err -> throwError err+                Right (_, Warnings termErrs@(_:_) []) -> do+                  typeError $ TerminationCheckFailed termErrs+                Right (_, Warnings _ _) -> __IMPOSSIBLE__+		Right (_, Success vs ds i isig ibuiltin)  -> do+                  -- writeInterface (used by createInterface) may+                  -- remove ifile.+                  let ifile = toIFile file+                  t <- liftIO $ ifM (doesFileExist ifile)+                         (getModificationTime ifile)+                         getClockTime+                  setVisitedModules vs+                  setDecodedModules ds+                  -- We need to add things imported when checking+                  -- the imported modules.+                  addImportedThings isig ibuiltin+                  return (i, t)++readInterface :: FilePath -> IO (Maybe Interface)+readInterface file = do+    -- Decode the interface file+    (s, close) <- readBinaryFile' file+    do  i <- decode s++        -- Force the entire string, to allow the file to be closed.+        let n = BS.length s+        () <- when (n == n) $ return ()++        -- Close the file+        close++	-- Force the interface to make sure the interface version is looked at+        i `seq` return $ Just i+      -- Catch exceptions and close+      `catch` \e -> close >> handler e+  -- Catch exceptions+  `catch` handler+  where+    handler e = case e of+      ErrorCall _   -> return Nothing+      IOException e -> do+          UTF8.putStrLn $ "IO exception: " ++ show e+          return Nothing   -- work-around for file locking bug+      _		    -> throwIO e++writeInterface :: FilePath -> Interface -> IO ()+writeInterface file i = do+    encodeFile file i+  `catch` \e -> do+    UTF8.putStrLn $ "failed to write interface " ++ file ++ " : " ++ show e+    removeFile file+    return ()++-- | Return type used by 'createInterface'.++data CreateInterfaceResult+  = Success { cirVisited   :: VisitedModules+            , cirDecoded   :: DecodedModules+            , cirInterface :: Interface+            , cirSignature :: Signature+            , cirBuiltin   :: BuiltinThings PrimFun+            }+    -- ^ Everything completed successfully, and an interface file was+    -- written.+  | Warnings { terminationProblems   :: [([QName], [R.Range])]+             , unsolvedMetaVariables :: [Range]+             }+    -- ^ Type checking was successful, except for some termination+    -- checking problems or unsolved meta-variables.+    --+    -- Meta-variable problems are reported as type errors unless we+    -- are type checking a top-level module and the flag to allow+    -- unsolved meta-variables has been selected.++-- | Tries to type check a module and write out its interface.+--+-- If appropriate this function writes out syntax highlighting+-- information.++createInterface+  :: CommandLineOptions+  -> CallTrace+  -> [ModuleName]+  -> VisitedModules+  -> DecodedModules+  -> Signature+  -> BuiltinThings PrimFun+  -> Maybe ModuleName       -- ^ Expected module name.+  -> FilePath               -- ^ The file to type check.+                            --   Must be an absolute path.+  -> Bool                   -- ^ Should the working directory be+                            --   changed to the root directory of+                            --   the \"project\" containing the+                            --   file?+  -> TCM (TopLevelInfo, CreateInterfaceResult)+createInterface opts trace path visited decoded+                isig ibuiltin mname file changeDir+  | not (isAbsolute file) = __IMPOSSIBLE__+  | otherwise             = withImportPath path $ do+    reportSLn "" 1 $ "Checking " ++ (case mname of+                        Nothing -> file+                        Just m  -> show m ++ " (" ++ file ++ ")") ++ "."++    setDecodedModules decoded+    setTrace trace+    setCommandLineOptions opts+    setVisitedModules visited++    reportSLn "import.iface.create" 5  $ "Creating interface for " ++ show mname+    reportSLn "import.iface.create" 10 $ "  visited: " ++ show (Map.keys visited)++    addImportedThings isig ibuiltin++    (pragmas, top) <- liftIO $ parseFile' moduleParser file+    when changeDir $+      liftIO $ setWorkingDirectory file top+    pragmas <- concat <$> concreteToAbstract_ pragmas+               -- identity for top-level pragmas at the moment+    -- Note that pragmas can affect scope checking.+    setOptionsFromPragmas pragmas+    topLevel <- concreteToAbstract_ (TopLevel top)++    termErrs <- catchError (do+      checkModuleName mname file topLevel++      -- Type checking.+      checkDecls (topLevelDecls topLevel)++      -- Termination checking.+      termErrs <- ifM (optTerminationCheck <$> commandLineOptions)+                      (termDecls $ topLevelDecls topLevel)+                      (return [])+      mapM_ (\e -> reportSLn "term.warn.no" 2+                     (show (fst e) +++                      " does NOT pass the termination checker."))+            termErrs+      return termErrs+      ) (\e -> do+        -- If there is an error syntax highlighting info can still be+        -- generated. Since there is no Vim highlighting for errors no+        -- Vim highlighting is generated, though.+        whenM (optGenerateEmacsFile <$> commandLineOptions) $ do+          writeEmacsFile =<<+            generateSyntaxInfo file TypeCheckingNotDone topLevel []++        throwError e)++    -- Generate syntax highlighting info.+    syntaxInfo <- generateSyntaxInfo file TypeCheckingDone+                                     topLevel termErrs++    -- Write Emacs file.+    whenM (optGenerateEmacsFile <$> commandLineOptions) $+      writeEmacsFile syntaxInfo++    -- Generate Vim file.+    whenM (optGenerateVimFile <$> commandLineOptions) $+	withScope_ (insideScope topLevel) $ generateVimFile file++    -- Check if there are unsolved meta-variables.+    unsolvedMetas <- List.nub <$> (mapM getMetaRange =<< getOpenMetas)+    case unsolvedMetas of+	[]  -> return ()+	_   -> do+          unsolvedOK <- optAllowUnsolved <$> commandLineOptions+          unless (unsolvedOK && path == []) $ do+            typeError $ UnsolvedMetas unsolvedMetas++    setScope $ outsideScope topLevel++    reportSLn "scope.top" 50 $ "SCOPE " ++ show (insideScope topLevel)++    -- True if the file was successfully and completely+    -- type-checked.+    let ok = null termErrs && null unsolvedMetas++    (,) topLevel <$> if ok then do+      i        <- buildInterface (topLevelModuleName topLevel) syntaxInfo+      isig     <- getImportedSignature+      vs       <- getVisitedModules+      ds       <- getDecodedModules+      ibuiltin <- gets stImportedBuiltins+      liftIO $ writeInterface (toIFile file) i+      modify (\s -> s { stCurrentModule =+                          Just (topLevelModuleName topLevel, i) })+      return (Success vs ds i isig ibuiltin)+     else+      return (Warnings termErrs unsolvedMetas)++-- | Builds an interface for the current module, which should already+-- have been successfully type checked.++buildInterface :: ModuleName+                  -- ^ The name of the current module.+               -> HighlightingInfo+                  -- ^ Syntax highlighting info for the module.+               -> TCM Interface+buildInterface m syntaxInfo = do+    reportSLn "import.iface" 5 "Building interface..."+    scope   <- getScope+    sig     <- getSignature+    builtin <- gets stLocalBuiltins+    ms      <- getImports+    hsImps  <- getHaskellImports+    let	builtin' = Map.mapWithKey (\x b -> fmap (const x) b) builtin+    reportSLn "import.iface" 7 "  instantiating all meta variables"+    i <- instantiateFull $ Interface+			{ iImportedModules = Set.toList ms+                        , iModuleName      = m+			, iScope	   = case scopeStack scope of  -- TODO!!+                                               []    -> __IMPOSSIBLE__+                                               s : _ -> s+			, iSignature	   = sig+			, iBuiltin	   = builtin'+                        , iHaskellImports  = hsImps+                        , iHighlighting    = syntaxInfo+			}+    reportSLn "import.iface" 7 "  interface complete"+    return i++-- | Set the current working directory based on the file name of the+-- current module and its module name, so that when the module is+-- imported qualified it will be found.+--+-- The given list of declarations should correspond to a module, i.e.+-- it should be non-empty and the last declaration should be+-- 'C.Module' something.++setWorkingDirectory :: FilePath -> [C.Declaration] -> IO ()+setWorkingDirectory _    [] = __IMPOSSIBLE__+setWorkingDirectory file xs = case last xs of+  C.Module _ n _ _ -> do+    -- canonicalizePath seems to return absolute paths.+    absolute <- canonicalizePath file+    let (path, _, _)  = splitFilePath absolute+    setCurrentDirectory (dropDirectory (countDots n) path)+  _                -> __IMPOSSIBLE__+  where+  countDots (C.QName _)  = 0+  countDots (C.Qual _ n) = 1 + countDots n++-- | Move somewhere else.+matchFileName :: ModuleName -> FilePath -> Bool+matchFileName mname file = expected `isSuffixOf` given || literate `isSuffixOf` given+  where+    given    = splitPath file+    expected = splitPath $ C.moduleNameToFileName (mnameToConcrete mname) ".agda"+    literate = splitPath $ C.moduleNameToFileName (mnameToConcrete mname) ".lagda"++-- | Checks that the top-level module name, the file name and what we+-- expect are consistent.++checkModuleName+  :: Maybe ModuleName  -- ^ The module should have this name (might be+                       --   unknown).+  -> FilePath          -- ^ The module is defined in this file, whose+                       --   file name is known to be consistent with the+                       --   previous argument.+  -> TopLevelInfo      -- ^ The module.+  -> TCM ()+checkModuleName mname file topLevel = case mname of+    Nothing -> unless (matchFileName actualName file) err+    Just expectedName -> unless (actualName == expectedName) err+  where+  actualName = topLevelModuleName topLevel+  err = typeError $ ModuleNameDoesntMatchFileName actualName++-- | True if the first file is newer than the second file. If a file doesn't+-- exist it is considered to be infinitely old.+isNewerThan :: FilePath -> FilePath -> IO Bool+isNewerThan new old = do+    newExist <- doesFileExist new+    oldExist <- doesFileExist old+    if not (newExist && oldExist)+	then return newExist+	else do+	    newT <- getModificationTime new+	    oldT <- getModificationTime old+	    return $ newT >= oldT

+ src/full/Agda/Interaction/Imports.hs-boot view

@@ -0,0 +1,9 @@++module Agda.Interaction.Imports where++import Agda.Syntax.Abstract.Name    ( ModuleName )+import Agda.Syntax.Scope.Base       ( Scope )+import Agda.TypeChecking.Monad.Base ( TCM )++scopeCheckImport :: ModuleName -> TCM (ModuleName, Scope)+

+ src/full/Agda/Interaction/MakeCase.hs view

@@ -0,0 +1,111 @@+{-# LANGUAGE CPP #-}++module Agda.Interaction.MakeCase where++import Prelude hiding (mapM, mapM_)+import Control.Applicative+import Control.Monad hiding (mapM, mapM_)+import Control.Monad.State hiding (mapM, mapM_)+import qualified Data.Map as Map+import Data.Traversable+import Data.List++import Agda.Syntax.Common+import Agda.Syntax.Position+import qualified Agda.Syntax.Abstract as A+import qualified Agda.Syntax.Info as A+import Agda.Syntax.Abstract.Views+import Agda.Syntax.Internal+import Agda.Syntax.Translation.InternalToAbstract+import Agda.Syntax.Scope.Base (emptyScopeInfo)++import Agda.TypeChecking.Monad+import Agda.TypeChecking.Coverage+import Agda.TypeChecking.Pretty+import Agda.TypeChecking.Reduce+import Agda.TypeChecker++import Agda.Interaction.BasicOps++import Agda.Utils.Size+import Agda.Utils.Permutation++#include "../undefined.h"+import Agda.Utils.Impossible++-- | Find the clause whose right hand side is the given meta.+--   Raises an error if there is no such clause.+findClause :: MetaId -> TCM (QName, Clause)+findClause m = do+  sig <- getSignature+  let res = do+        def <- Map.elems $ sigDefinitions sig+        Function{funClauses = cs} <- [theDef def]+        c <- cs+        unless (rhsIsm $ clauseBody c) []+        return (defName def, c)+  case res of+    []  -> fail "Right hand side must be a single hole when making case."+    [r] -> return r+    _   -> __IMPOSSIBLE__+  where+    rhsIsm (Bind b)   = rhsIsm $ absBody b+    rhsIsm (NoBind b) = rhsIsm b+    rhsIsm NoBody     = False+    rhsIsm (Body e)   = case e of+      MetaV m' _  -> m == m'+      _           -> False++makeCase :: InteractionId -> Range -> String -> TCM [A.Clause]+makeCase hole rng s = do+  meta        <- lookupInteractionId hole+  (f, clause@(Clause{ clauseTel = tel, clausePerm = perm, clausePats = ps })) <- findClause meta+  reportSDoc "interaction.case" 10 $ vcat+    [ text "splitting clause:"+    , nest 2 $ vcat+      [ text "context =" <+> (prettyTCM =<< getContextTelescope)+      , text "tel     =" <+> prettyTCM tel+      , text "perm    =" <+> text (show perm)+      , text "ps      =" <+> text (show ps)+      ]+    ]+  var         <- withInteractionId hole $ deBruijnIndex =<< parseExprIn hole rng s+  z           <- splitClauseWithAbs clause var+  case z of+    Left err        -> fail $ show err+    Right (Left cl) -> (:[]) <$> makeAbsurdClause f cl+    Right (Right c) -> mapM (makeAbstractClause f) c++makeAbsurdClause :: QName -> SplitClause -> TCM A.Clause+makeAbsurdClause f (SClause tel perm ps _) = do+  reportSDoc "interaction.case" 10 $ vcat+    [ text "split clause:"+    , nest 2 $ vcat+      [ text "context =" <+> (prettyTCM =<< getContextTelescope)+      , text "tel =" <+> prettyTCM tel+      , text "perm =" <+> text (show perm)+      , text "ps =" <+> text (show ps)+      ]+    ]+  withCurrentModule (qnameModule f) $ do+    -- Normalise the dot patterns+    ps <- addCtxTel tel $ normalise ps+    reify $ NamedClause f $ Clause noRange tel perm ps NoBody++makeAbstractClause :: QName -> SplitClause -> TCM A.Clause+makeAbstractClause f cl = do+  A.Clause lhs _ _ <- makeAbsurdClause f cl+  return $ mkClause lhs+  where+    mkClause :: A.LHS -> A.Clause+    mkClause lhs = A.Clause lhs (A.RHS $ A.QuestionMark info) []+      where+        info = A.MetaInfo noRange emptyScopeInfo Nothing++deBruijnIndex :: A.Expr -> TCM Nat+deBruijnIndex e = do+  (v, _) <- inferExpr e+  case v of+    Var n _ -> return n+    _       -> fail $ "Should be a variable: " ++ show v+

+ src/full/Agda/Interaction/Monad.hs view

@@ -0,0 +1,44 @@++module Agda.Interaction.Monad where++import Agda.TypeChecking.Monad++import Control.Monad.Trans+import System.Console.Haskeline++-- | Interaction monad.++type IM = TCMT (InputT IO)++-- | Line reader. The line reader history is not stored between+-- sessions.++readline :: String -> IM (Maybe String)+readline s = lift (getInputLine s)++{-+data CurrentPoint = InInteractionPoint InteractionId | TopLevel++newtype IM a = IM {unIM :: StateT [CurrentPoint] TCM a}+   deriving (Monad,MonadIO)+++instance MonadError e IM where+    throwError	   = lift . throwError+    catchError m h = IM $ catchError (unIM m) (unIM . h)++++instance MonadUndo [CurrentPoint] IM where+    undo = +        ++run++-}++-- instance MonadTCM IM where+--     liftTCM = id++runIM :: IM a -> TCM a+runIM = mapTCMT (runInputT defaultSettings)

+ src/full/Agda/Interaction/Options.hs view

@@ -0,0 +1,334 @@+{-# LANGUAGE CPP #-}++module Agda.Interaction.Options+    ( CommandLineOptions(..)+    , Flag+    , checkOpts+    , parseStandardOptions+    , parsePragmaOptions+    , parsePluginOptions+    , defaultOptions+    , standardOptions_+    , isLiterate+    , mapFlag+    , usage+    , tests+    ) where++import Control.Monad.Error	( MonadError(catchError) )+import Data.List		( isSuffixOf )+import System.Console.GetOpt	(getOpt, usageInfo, ArgOrder(ReturnInOrder)+				, OptDescr(..), ArgDescr(..)+				)+import Agda.Utils.TestHelpers   ( runTests )+import Agda.Utils.QuickCheck    ( quickCheck' )+import Agda.Utils.Monad		( readM )+import Agda.Utils.FileName		( slash )+import Agda.Utils.List               ( wordsBy )+import Agda.Utils.Trie               ( Trie )+import qualified Agda.Utils.Trie as Trie++-- | This should probably go somewhere else.+isLiterate :: FilePath -> Bool+isLiterate file = ".lagda" `isSuffixOf` file++-- OptDescr is a Functor --------------------------------------------------++instance Functor OptDescr where+    fmap f (Option short long arg descr) = Option short long (fmap f arg) descr++instance Functor ArgDescr where+    fmap f (NoArg x)	= NoArg (f x)+    fmap f (ReqArg p s) = ReqArg (f . p) s+    fmap f (OptArg p s) = OptArg (f . p) s++data CommandLineOptions =+    Options { optProgramName	   :: String+	    , optInputFile	   :: Maybe FilePath+	    , optIncludeDirs	   :: [FilePath]+	    , optShowVersion	   :: Bool+	    , optShowHelp	   :: Bool+	    , optInteractive	   :: Bool+	    , optVerbose	   :: Trie String Int+	    , optProofIrrelevance  :: Bool+	    , optAllowUnsolved	   :: Bool+	    , optShowImplicit	   :: Bool+	    , optRunTests	   :: Bool+	    , optCompile	   :: Bool+	    , optGenerateVimFile   :: Bool+	    , optGenerateEmacsFile :: Bool+	    , optGenerateHTML      :: Bool+	    , optHTMLDir           :: Maybe FilePath+	    , optCSSFile           :: Maybe FilePath+	    , optIgnoreInterfaces  :: Bool+	    , optDisablePositivity :: Bool+	    , optCompileAlonzo     :: Bool+            , optCompileMAlonzo    :: Bool+            , optMAlonzoDir        :: FilePath+	    , optTerminationCheck  :: Bool+	    , optCompletenessCheck :: Bool+            , optUnreachableCheck  :: Bool+	    , optUniverseCheck     :: Bool+            , optSizedTypes        :: Bool+            , optGhcFlags          :: [String]+	    }+    deriving Show++-- | Map a function over the long options. Also removes the short options.+--   Will be used to add the plugin name to the plugin options.+mapFlag :: (String -> String) -> OptDescr a -> OptDescr a+mapFlag f (Option _ long arg descr) = Option [] (map f long) arg descr++defaultOptions :: CommandLineOptions+defaultOptions =+    Options { optProgramName	   = "agda"+	    , optInputFile	   = Nothing+	    , optIncludeDirs	   = []+	    , optShowVersion	   = False+	    , optShowHelp	   = False+	    , optInteractive	   = False+	    , optVerbose	   = Trie.singleton [] 1+	    , optProofIrrelevance  = False+	    , optAllowUnsolved	   = False+	    , optShowImplicit	   = False+	    , optRunTests	   = False+	    , optCompile	   = False+	    , optGenerateVimFile   = False+	    , optGenerateEmacsFile = False+	    , optGenerateHTML      = False+	    , optHTMLDir           = Nothing+	    , optCSSFile           = Nothing+	    , optIgnoreInterfaces  = False+	    , optDisablePositivity = False+	    , optCompileAlonzo     = False+	    , optCompileMAlonzo    = False+            , optMAlonzoDir        = defaultMAlonzoDir+            , optTerminationCheck  = True+            , optCompletenessCheck = True+            , optUnreachableCheck  = True+            , optUniverseCheck     = True+            , optSizedTypes        = False+            , optGhcFlags          = []+	    }++-- | The default output directory for MAlonzo.++defaultMAlonzoDir = "."++prop_defaultOptions = case checkOpts defaultOptions of+  Left  _ -> False+  Right _ -> True++{- | @f :: Flag opts@  is an action on the option record that results from+     parsing an option.  @f opts@ produces either an error message or an+     updated options record+-}+type Flag opts	= opts -> Either String opts++-- | Checks that the given options are consistent.++checkOpts :: Flag CommandLineOptions+checkOpts opts+  | not (atMostOne compilerOpts) =+    Left "At most one compiler may be used.\n"+  | optAllowUnsolved opts && or compilerOpts = Left+      "Unsolved meta variables are not allowed when compiling.\n"+  | not (atMostOne [or compilerOpts, optInteractive opts]) =+      Left "Choose at most one: compiler or interactive mode.\n"+  | not (atMostOne [optGenerateHTML opts, optInteractive opts]) =+      Left "Choose at most one: HTML generator or interactive mode.\n"+  | otherwise = Right opts+  where+  atMostOne bs = length (filter id bs) <= 1++  compilerOpts =+    map ($ opts)+      [ optCompile+      , optCompileAlonzo+      , optCompileMAlonzo+      ]++inputFlag f o	    =+    case optInputFile o of+	Nothing  -> checkOpts $ o { optInputFile = Just f }+	Just _	 -> fail "only one input file allowed"++versionFlag               o = checkOpts $ o { optShowVersion       = True }+helpFlag                  o = checkOpts $ o { optShowHelp	       = True }+proofIrrelevanceFlag      o = checkOpts $ o { optProofIrrelevance  = True }+ignoreInterfacesFlag      o = checkOpts $ o { optIgnoreInterfaces  = True }+allowUnsolvedFlag         o = checkOpts $ o { optAllowUnsolved     = True }+showImplicitFlag          o = checkOpts $ o { optShowImplicit      = True }+runTestsFlag              o = checkOpts $ o { optRunTests	       = True }+vimFlag                   o = checkOpts $ o { optGenerateVimFile   = True }+emacsFlag                 o = checkOpts $ o { optGenerateEmacsFile = True }+noPositivityFlag          o = checkOpts $ o { optDisablePositivity = True }+dontTerminationCheckFlag  o = checkOpts $ o { optTerminationCheck  = False }+dontCompletenessCheckFlag o = checkOpts $ o { optCompletenessCheck = False }+noUnreachableCheckFlag    o = checkOpts $ o { optUnreachableCheck  = False }+dontUniverseCheckFlag     o = checkOpts $ o { optUniverseCheck     = False }+sizedTypes                o = checkOpts $ o { optSizedTypes        = True }++interactiveFlag o = checkOpts $ o { optInteractive   = True+			          , optAllowUnsolved = True+			          }+compileFlag      o = checkOpts $ o { optCompileMAlonzo = True }+agateFlag        o = checkOpts $ o { optCompile        = True }+alonzoFlag       o = checkOpts $ o { optCompileAlonzo  = True }+malonzoFlag      o = checkOpts $ o { optCompileMAlonzo = True }+malonzoDirFlag f o = checkOpts $ o { optMAlonzoDir     = f }+ghcFlag        f o = checkOpts $ o { optGhcFlags       = f : optGhcFlags o }++htmlFlag      o = checkOpts $ o { optGenerateHTML = True }+htmlDirFlag d o = checkOpts $ o { optHTMLDir      = Just d }+cssFlag     f o = checkOpts $ o { optCSSFile      = Just f }++includeFlag d o	    = checkOpts $ o { optIncludeDirs   = d : optIncludeDirs o   }+verboseFlag s o	    =+    do	(k,n) <- parseVerbose s+	checkOpts $ o { optVerbose = Trie.insert k n $ optVerbose o }+  where+    parseVerbose s = case wordsBy (`elem` ":.") s of+      []  -> usage+      ss  -> do+        n <- readM (last ss) `catchError` \_ -> usage+        return (init ss, n)+    usage = fail "argument to verbose should be on the form x.y.z:N or N"++integerArgument :: String -> String -> Either String Int+integerArgument flag s =+    readM s `catchError` \_ ->+	fail $ "option '" ++ flag ++ "' requires an integer argument"++standardOptions :: [OptDescr (Flag CommandLineOptions)]+standardOptions =+    [ Option ['V']  ["version"]	(NoArg versionFlag) "show version number"+    , Option ['?']  ["help"]	(NoArg helpFlag)    "show this help"+    , Option ['i']  ["include-path"] (ReqArg includeFlag "DIR")+		    "look for imports in DIR"+    , Option ['I']  ["interactive"] (NoArg interactiveFlag)+		    "start in interactive mode"+    , Option ['c']  ["compile"] (NoArg compileFlag)+                    "compile program (experimental)"+    , Option []	    ["agate"] (NoArg agateFlag)+		    "use the Agate compiler (only with --compile)"+    , Option []     ["alonzo"] (NoArg alonzoFlag)+		    "use the Alonzo compiler (only with --compile)"+    , Option []     ["malonzo"] (NoArg malonzoFlag)+		    "use the MAlonzo compiler (DEFAULT) (only with --compile)"+    , Option []     ["malonzodir"] (ReqArg malonzoDirFlag "DIR")+		    ("directory for MAlonzo output (default: " +++                     defaultMAlonzoDir ++ ")")+    , Option []     ["ghc-flag"] (ReqArg ghcFlag "GHC-FLAG")+                    "give the flag GHC-FLAG to GHC when compiling using MAlonzo"+    , Option []	    ["test"] (NoArg runTestsFlag)+		    "run internal test suite"+    , Option []	    ["vim"] (NoArg vimFlag)+		    "generate Vim highlighting files"+    , Option []	    ["emacs"] (NoArg emacsFlag)+		    "generate Emacs highlighting files"+    , Option []	    ["html"] (NoArg htmlFlag)+		    "generate HTML files with highlighted source code"+    , Option []	    ["html-dir"] (ReqArg htmlDirFlag "DIR")+		    "directory in which HTML files are placed"+    , Option []	    ["css"] (ReqArg cssFlag "URL")+		    "the CSS file used by the HTML files (can be relative)"+    , Option []	    ["ignore-interfaces"] (NoArg ignoreInterfacesFlag)+		    "ignore interface files (re-type check everything)"+    ] ++ pragmaOptions++pragmaOptions :: [OptDescr (Flag CommandLineOptions)]+pragmaOptions =+    [ Option ['v']  ["verbose"]	(ReqArg verboseFlag "N")+		    "set verbosity level to N"+    , Option []	    ["show-implicit"] (NoArg showImplicitFlag)+		    "show implicit arguments when printing"+    , Option []	    ["proof-irrelevance"] (NoArg proofIrrelevanceFlag)+		    "enable proof irrelevance (experimental feature)"+    , Option []	    ["allow-unsolved-metas"] (NoArg allowUnsolvedFlag)+		    "allow unsolved meta variables (only needed in batch mode)"+    , Option []	    ["no-positivity-check"] (NoArg noPositivityFlag)+		    "do not warn about not strictly positive data types"+    , Option []	    ["no-termination-check"] (NoArg dontTerminationCheckFlag)+		    "do not warn about possibly nonterminating code"+    , Option []	    ["no-coverage-check"] (NoArg dontCompletenessCheckFlag)+		    "do not warn about possibly incomplete pattern matches"+    , Option []	    ["no-unreachable-check"] (NoArg noUnreachableCheckFlag)+		    "do not warn about unreachable function clauses"+    , Option []	    ["type-in-type"] (NoArg dontUniverseCheckFlag)+		    "ignore universe levels (this makes Agda inconsistent)"+    , Option []     ["sized-types"] (NoArg sizedTypes)+                    "use sized datatypes"+    ]++-- | Used for printing usage info.+standardOptions_ :: [OptDescr ()]+standardOptions_ = map (fmap $ const ()) standardOptions++-- | Don't export+parseOptions' ::+    String -> [String] -> opts ->+    [OptDescr (Flag opts)] -> (String -> Flag opts) -> Either String opts+parseOptions' progName argv defaults opts fileArg =+    case (getOpt (ReturnInOrder fileArg) opts argv) of+	(o,_,[])    -> foldl (>>=) (return defaults) o+	(_,_,errs)  -> fail $ concat errs++-- | Parse the standard options.+parseStandardOptions :: String -> [String] -> Either String CommandLineOptions+parseStandardOptions progName argv =+    parseOptions' progName argv defaultOptions standardOptions inputFlag++-- | Parse options from an options pragma.+parsePragmaOptions :: [String] -> CommandLineOptions -> Either String CommandLineOptions+parsePragmaOptions argv opts =+    parseOptions' progName argv opts pragmaOptions $+    \s _ -> fail $ "Bad option in pragma: " ++ s+    where+	progName = optProgramName opts++-- | Parse options for a plugin.+parsePluginOptions ::+    String -> [String] ->+    opts -> [OptDescr (Flag opts)] ->+    Either String opts+parsePluginOptions progName argv defaults opts =+    parseOptions'+	progName argv defaults opts+	(\s _ -> fail $ "Internal error: Flag " ++ s ++ " passed to a plugin")++-- | The usage info message. The argument is the program name (probably+--   agdaLight).+usage :: [OptDescr ()] -> [(String, String, [String], [OptDescr ()])] -> String -> String+usage options pluginInfos progName =+	usageInfo (header progName) options +++	"\nPlugins:\n" +++        indent (concatMap pluginMsg pluginInfos)+    +    where+	header progName = unlines [ "Agda 2"+				  , ""+				  , "Usage: " ++ progName ++ " [OPTIONS...] FILE"+				  ]++	indent = unlines . map ("  " ++) . lines++        pluginMsg (name, help, inherited, opts) +            | null opts && null inherited = optHeader+            | otherwise = usageInfo (optHeader +++                                     "  Plugin-specific options:" +++				     inheritedOptions inherited+				     ) opts+            where+		optHeader = "\n" ++ name ++ "-plugin:\n" ++ indent help+		inheritedOptions [] = ""+		inheritedOptions pls =+		    "\n    Inherits options from: " ++ unwords pls++------------------------------------------------------------------------+-- All tests++tests :: IO Bool+tests = runTests "Agda.Interaction.Options"+  [ quickCheck' prop_defaultOptions+  ]

+ src/full/Agda/Main.hs view

@@ -0,0 +1,185 @@+{-# LANGUAGE CPP #-}++{-| Agda 2 main module.+-}+module Agda.Main where++import Control.Monad.State+import Control.Monad.Error+import Control.Applicative++import Data.List+import Data.Map (Map)+import qualified Data.Map as Map+import Data.Maybe++import System.Environment+import System.Exit+import qualified System.IO.UTF8 as UTF8++import Agda.Syntax.Position+import Agda.Syntax.Parser+import Agda.Syntax.Concrete.Pretty ()+import qualified Agda.Syntax.Abstract as A+import Agda.Syntax.Abstract.Pretty+import Agda.Syntax.Translation.ConcreteToAbstract+import Agda.Syntax.Translation.AbstractToConcrete+import Agda.Syntax.Translation.InternalToAbstract+import Agda.Syntax.Abstract.Name+import Agda.Syntax.Strict+import Agda.Syntax.Scope.Base++import Agda.Interaction.Exceptions+import Agda.Interaction.CommandLine.CommandLine+import Agda.Interaction.Options+import Agda.Interaction.Monad+import Agda.Interaction.GhciTop ()	-- to make sure it compiles+import qualified Agda.Interaction.Imports as Imp+import Agda.Interaction.Highlighting.HTML++import Agda.TypeChecker+import Agda.TypeChecking.Monad+import Agda.TypeChecking.Reduce+import Agda.TypeChecking.Errors+import qualified Agda.TypeChecking.Serialise+import Agda.TypeChecking.Serialise+import Agda.TypeChecking.SizedTypes++import Agda.Compiler.Agate.Main as Agate+import Agda.Compiler.Alonzo.Main as Alonzo+import Agda.Compiler.MAlonzo.Compiler as MAlonzo++import Agda.Termination.TermCheck++import Agda.Utils.Monad+import Agda.Utils.FileName+import Agda.Utils.Pretty++import Agda.Tests+import Agda.Version++#include "undefined.h"+import Agda.Utils.Impossible++-- | The main function+runAgda :: TCM ()+runAgda =+    do	progName <- liftIO getProgName+	argv	 <- liftIO getArgs+	let opts = parseStandardOptions progName argv+	case opts of+	    Left err -> liftIO $ optionError err+	    Right opts+		| optShowHelp opts	-> liftIO printUsage+		| optShowVersion opts	-> liftIO printVersion+		| optRunTests opts	-> liftIO $ do+                    ok <- testSuite+                    unless ok exitFailure+		| isNothing (optInputFile opts)+		    && not (optInteractive opts)+					-> liftIO printUsage+		| otherwise		-> do setCommandLineOptions opts+					      checkFile+    where+	checkFile :: TCM ()+	checkFile =+	    do	i	<- optInteractive <$> liftTCM commandLineOptions+		compile <- optCompile <$> liftTCM commandLineOptions+		alonzo  <- optCompileAlonzo <$> liftTCM commandLineOptions+                malonzo <- optCompileMAlonzo <$> liftTCM commandLineOptions+		when i $ liftIO $ UTF8.putStr splashScreen+		let failIfError (_, Right _)  = return ()+                    failIfError (_, Left err) = typeError err++                    failIfNoInt (_, Right (Just i)) = return i+                    -- The allowed combinations of command-line+                    -- options should rule out Right Nothing here.+                    failIfNoInt (_, Right Nothing)  = __IMPOSSIBLE__+                    failIfNoInt (_, Left err)       = typeError err++                    interaction | i	  = runIM . interactionLoop+				| compile = Agate.compilerMain   . (failIfError =<<)+				| alonzo  = Alonzo.compilerMain  . (failIfError =<<)+                                | malonzo = MAlonzo.compilerMain . (failIfNoInt =<<)+				| otherwise = (failIfError =<<)+		interaction $+		    do	hasFile <- hasInputFile+			resetState+			if hasFile then+			    do	file    <- getInputFile+                                options <- commandLineOptions++                                (topLevel, ok) <- Imp.createInterface options+                                  noTrace [] Map.empty+                                  Map.empty emptySignature+                                  Map.empty Nothing file False++                                -- The value of options from above+                                -- cannot be reused here, because then+                                -- options set in pragmas would have+                                -- no effect.+                                unsolvedOK <- optAllowUnsolved <$> commandLineOptions++                                let result = case ok of+                                      Imp.Warnings []             [] -> __IMPOSSIBLE__+                                      Imp.Warnings _  unsolved@(_:_)+                                        | unsolvedOK -> Right Nothing+                                        | otherwise  -> Left $ UnsolvedMetas unsolved+                                      Imp.Warnings termErrs@(_:_) _  ->+                                        Left (TerminationCheckFailed termErrs)+                                      Imp.Success { Imp.cirInterface = i } ->+                                        Right (Just i)++				-- Print stats+				stats <- Map.toList <$> getStatistics+				case stats of+				    []	-> return ()+				    _	-> liftIO $ do+					UTF8.putStrLn "Statistics"+					UTF8.putStrLn "----------"+					mapM_ (\ (s,n) -> UTF8.putStrLn $ s ++ " : " ++ show n) $+					    sortBy (\x y -> compare (snd x) (snd y)) stats++                                whenM (optGenerateHTML <$> commandLineOptions) $ do+                                  case ok of+                                    Imp.Success {} -> generateHTML $ topLevelModuleName topLevel+                                    _ -> return ()+                                         -- The error will be handled by interaction.++				return (insideScope topLevel, result)+			  else return (emptyScopeInfo, Right Nothing)++		return ()++-- | Print usage information.+printUsage :: IO ()+printUsage =+    do	progName <- getProgName+	UTF8.putStr $ usage standardOptions_ [] progName++-- | Print version information.+printVersion :: IO ()+printVersion =+    UTF8.putStrLn $ "Agda 2 version " ++ version++-- | What to do for bad options.+optionError :: String -> IO ()+optionError err =+    do	UTF8.putStrLn $ "Error: " ++ err+	printUsage+	exitFailure++-- | Main+main :: IO ()+main = do+    r <- runTCM $ runAgda `catchError` \err -> do+	s <- prettyError err+	liftIO $ UTF8.putStrLn s+	throwError err+    case r of+	Right _	-> return ()+	Left _	-> exitFailure+  `catchImpossible` \e -> do+    UTF8.putStr $ show e+    exitFailure+

+ src/full/Agda/Syntax/Abstract.hs view

@@ -0,0 +1,358 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-| The abstract syntax. This is what you get after desugaring and scope+    analysis of the concrete syntax. The type checker works on abstract syntax,+    producing internal syntax ("Agda.Syntax.Internal").+-}+module Agda.Syntax.Abstract+    ( module Agda.Syntax.Abstract+    , module Agda.Syntax.Abstract.Name+    ) where++import Prelude hiding (foldr)+import Control.Applicative+import Data.Sequence (Seq, (<|), (><))+import qualified Data.Sequence as Seq+import Data.Foldable as Fold+import Data.Traversable+import Data.Map (Map)+import Data.Generics (Typeable, Data)++import qualified Agda.Syntax.Concrete as C+import Agda.Syntax.Info+import Agda.Syntax.Common+import Agda.Syntax.Position+import Agda.Syntax.Abstract.Name+import Agda.Syntax.Literal+import Agda.Syntax.Scope.Base++import Agda.Utils.Tuple++data Expr+        = Var  Name			     -- ^ Bound variables+        | Def  QName			     -- ^ Constants (i.e. axioms, functions, and datatypes)+        | Con  AmbiguousQName		     -- ^ Constructors+	| Lit Literal			     -- ^ Literals+	| QuestionMark MetaInfo		     -- ^ meta variable for interaction+        | Underscore   MetaInfo		     -- ^ meta variable for hidden argument (must be inferred locally)+        | App  ExprInfo Expr (NamedArg Expr) -- ^+	| WithApp ExprInfo Expr [Expr]	     -- ^ with application+        | Lam  ExprInfo LamBinding Expr	     -- ^+        | AbsurdLam ExprInfo Hiding+        | Pi   ExprInfo Telescope Expr	     -- ^+	| Fun  ExprInfo (Arg Expr) Expr	     -- ^ independent function space+        | Set  ExprInfo Nat		     -- ^+        | Prop ExprInfo			     -- ^+        | Let  ExprInfo [LetBinding] Expr    -- ^+	| Rec  ExprInfo [(C.Name, Expr)]     -- ^ record construction+	| ScopedExpr ScopeInfo Expr	     -- ^ scope annotation+  deriving (Typeable, Data)++data Declaration+	= Axiom      DefInfo QName Expr				-- ^ postulate+	| Field      DefInfo QName Expr				-- ^ record field+	| Primitive  DefInfo QName Expr				-- ^ primitive function+	| Definition DeclInfo [TypeSignature] [Definition]	-- ^ a bunch of mutually recursive definitions+	| Section    ModuleInfo ModuleName [TypedBindings] [Declaration]+	| Apply	     ModuleInfo ModuleName [TypedBindings] ModuleName [NamedArg Expr] (Map QName QName) (Map ModuleName ModuleName)+	| Import     ModuleInfo ModuleName+	| Pragma     Range	Pragma+	| ScopedDecl ScopeInfo [Declaration]  -- ^ scope annotation+  deriving (Typeable, Data)++data Pragma = OptionsPragma [String]+	    | BuiltinPragma String Expr+            | CompiledPragma QName String+            | CompiledTypePragma QName String+            | CompiledDataPragma QName String [String]+  deriving (Typeable, Data)++data LetBinding = LetBind LetInfo Name Expr Expr    -- ^ LetBind info name type defn+                | LetApply ModuleInfo ModuleName [TypedBindings] ModuleName [NamedArg Expr] (Map QName QName) (Map ModuleName ModuleName)+  deriving (Typeable, Data)++-- | A definition without its type signature.+data Definition+	= FunDef     DefInfo QName [Clause]+	| DataDef    DefInfo QName Induction [LamBinding] [Constructor]+	    -- ^ the 'LamBinding's are 'DomainFree' and binds the parameters of the datatype.+	| RecDef     DefInfo QName [LamBinding] Expr [Declaration]+	    -- ^ the 'Expr' gives the constructor type telescope: @(x1 : A1)..(xn : An) -> Prop@+        | ScopedDef ScopeInfo Definition+  deriving (Typeable, Data)++-- | Only 'Axiom's.+type TypeSignature  = Declaration+type Constructor    = TypeSignature++-- | A lambda binding is either domain free or typed.+data LamBinding+	= DomainFree Hiding Name    -- ^ . @x@ or @{x}@+	| DomainFull TypedBindings  -- ^ . @(xs:e)@ or @{xs:e}@+  deriving (Typeable, Data)++-- | Typed bindings with hiding information.+data TypedBindings = TypedBindings Range Hiding [TypedBinding]+	    -- ^ . @(xs:e;..;ys:e')@ or @{xs:e;..;ys:e'}@+  deriving (Typeable, Data)++-- | A typed binding. Appears in dependent function spaces, typed lambdas, and+--   telescopes. I might be tempting to simplify this to only bind a single+--   name at a time. This would mean that we would have to typecheck the type+--   several times (@x,y:A@ vs. @x:A; y:A@). In most cases this wouldn't+--   really be a problem, but it's good principle to not do extra work unless+--   you have to.+data TypedBinding = TBind Range [Name] Expr+		  | TNoBind Expr+  deriving (Typeable, Data)++type Telescope	= [TypedBindings]++-- | We could throw away @where@ clauses at this point and translate them to+--   @let@. It's not obvious how to remember that the @let@ was really a+--   @where@ clause though, so for the time being we keep it here.+data Clause	= Clause LHS RHS [Declaration]+  deriving (Typeable, Data)+data RHS	= RHS Expr+		| AbsurdRHS+		| WithRHS QName [Expr] [Clause] -- ^ The 'QName' is the name of the with function.+  deriving (Typeable, Data)++data LHS	= LHS LHSInfo QName [NamedArg Pattern] [Pattern]+  deriving (Typeable, Data)++-- | Parameterised over the type of dot patterns.+data Pattern' e	= VarP Name+		| ConP PatInfo AmbiguousQName [NamedArg (Pattern' e)]+		| DefP PatInfo QName          [NamedArg (Pattern' e)]  -- ^ defined pattern+		| WildP PatInfo+		| AsP PatInfo Name (Pattern' e)+		| DotP PatInfo e+		| AbsurdP PatInfo+		| LitP Literal+		| ImplicitP PatInfo	-- ^ generated at type checking for implicit arguments+  deriving (Typeable, Data)++type Pattern = Pattern' Expr++{--------------------------------------------------------------------------+    Instances+ --------------------------------------------------------------------------}++instance Functor Pattern' where+    fmap f p = case p of+	VarP x	    -> VarP x+	ConP i c ps -> ConP i c $ (fmap . fmap . fmap . fmap) f ps+	DefP i c ps -> DefP i c $ (fmap . fmap . fmap . fmap) f ps+	LitP l	    -> LitP l+	AsP i x p   -> AsP i x $ fmap f p+	DotP i e    -> DotP i (f e)+	AbsurdP i   -> AbsurdP i+	WildP i	    -> WildP i+	ImplicitP i -> ImplicitP i++-- foldr should really take its arguments in a different order!+instance Foldable Pattern' where+    foldr f z p = case p of+	VarP _	    -> z+	ConP _ _ ps -> (foldrF . foldrF . foldrF . foldrF) f ps z+	DefP _ _ ps -> (foldrF . foldrF . foldrF . foldrF) f ps z+	LitP _	    -> z+	AsP _ _ p   -> foldr f z p+	DotP _ e    -> f e z+	AbsurdP _   -> z+	WildP _	    -> z+	ImplicitP _ -> z+	where+	    foldrF f = flip (foldr f)++instance Traversable Pattern' where+    traverse f p = case p of+	VarP x	    -> pure $ VarP x+	ConP i c ps -> ConP i c <$> (traverse . traverse . traverse . traverse) f ps+	DefP i c ps -> DefP i c <$> (traverse . traverse . traverse . traverse) f ps+	LitP l	    -> pure $ LitP l+	AsP i x p   -> AsP i x <$> traverse f p+	DotP i e    -> DotP i <$> f e+	AbsurdP i   -> pure $ AbsurdP i+	WildP i	    -> pure $ WildP i+	ImplicitP i -> pure $ ImplicitP i++instance HasRange LamBinding where+    getRange (DomainFree _ x) = getRange x+    getRange (DomainFull b)   = getRange b++instance HasRange TypedBindings where+    getRange (TypedBindings r _ _) = r++instance HasRange TypedBinding where+    getRange (TBind r _ _) = r+    getRange (TNoBind e)   = getRange e++instance HasRange Expr where+    getRange (Var x)		= getRange x+    getRange (Def x)		= getRange x+    getRange (Con x)		= getRange x+    getRange (Lit l)		= getRange l+    getRange (QuestionMark i)	= getRange i+    getRange (Underscore  i)	= getRange i+    getRange (App i _ _)	= getRange i+    getRange (WithApp i _ _)	= getRange i+    getRange (Lam i _ _)	= getRange i+    getRange (AbsurdLam i _)    = getRange i+    getRange (Pi i _ _)		= getRange i+    getRange (Fun i _ _)	= getRange i+    getRange (Set i _)		= getRange i+    getRange (Prop i)		= getRange i+    getRange (Let i _ _)	= getRange i+    getRange (Rec i _)		= getRange i+    getRange (ScopedExpr _ e)	= getRange e++instance HasRange Declaration where+    getRange (Axiom      i _ _	       ) = getRange i+    getRange (Field      i _ _         ) = getRange i+    getRange (Definition i _ _	       ) = getRange i+    getRange (Section    i _ _ _       ) = getRange i+    getRange (Apply	 i _ _ _ _ _ _ ) = getRange i+    getRange (Import     i _	       ) = getRange i+    getRange (Primitive  i _ _	       ) = getRange i+    getRange (Pragma	 i _	       ) = getRange i+    getRange (ScopedDecl _ d	       ) = getRange d++instance HasRange Definition where+    getRange (FunDef  i _ _    )   = getRange i+    getRange (DataDef i _ _ _ _  ) = getRange i+    getRange (RecDef  i _ _ _ _)   = getRange i+    getRange (ScopedDef _ d)       = getRange d++instance HasRange (Pattern' e) where+    getRange (VarP x)	   = getRange x+    getRange (ConP i _ _)  = getRange i+    getRange (DefP i _ _)  = getRange i+    getRange (WildP i)	   = getRange i+    getRange (ImplicitP i) = getRange i+    getRange (AsP i _ _)   = getRange i+    getRange (DotP i _)    = getRange i+    getRange (AbsurdP i)   = getRange i+    getRange (LitP l)	   = getRange l++instance HasRange LHS where+    getRange (LHS i _ _ _) = getRange i++instance HasRange Clause where+    getRange (Clause lhs rhs ds) = getRange (lhs,rhs,ds)++instance HasRange RHS where+    getRange AbsurdRHS        = noRange+    getRange (RHS e)          = getRange e+    getRange (WithRHS _ e cs) = fuseRange e cs++instance HasRange LetBinding where+    getRange (LetBind  i _ _ _       ) = getRange i+    getRange (LetApply i _ _ _ _ _ _ ) = getRange i++instance KillRange LamBinding where+  killRange (DomainFree h x) = killRange1 (DomainFree h) x+  killRange (DomainFull b)   = killRange1 DomainFull b++instance KillRange TypedBindings where+  killRange (TypedBindings r h b) = TypedBindings (killRange r) h (killRange b)++instance KillRange TypedBinding where+  killRange (TBind r xs e) = killRange3 TBind r xs e+  killRange (TNoBind e)    = killRange1 TNoBind e++instance KillRange Expr where+  killRange (Var x)          = killRange1 Var x+  killRange (Def x)          = killRange1 Def x+  killRange (Con x)          = killRange1 Con x+  killRange (Lit l)          = killRange1 Lit l+  killRange (QuestionMark i) = killRange1 QuestionMark i+  killRange (Underscore  i)  = killRange1 Underscore i+  killRange (App i e1 e2)    = killRange3 App i e1 e2+  killRange (WithApp i e es) = killRange3 WithApp i e es+  killRange (Lam i b e)      = killRange3 Lam i b e+  killRange (AbsurdLam i h)  = killRange1 AbsurdLam i h+  killRange (Pi i a b)       = killRange3 Pi i a b+  killRange (Fun i a b)      = killRange3 Fun i a b+  killRange (Set i n)        = Set (killRange i) n+  killRange (Prop i)         = killRange1 Prop i+  killRange (Let i ds e)     = killRange3 Let i ds e+  killRange (Rec i fs)       = Rec (killRange i) (map (id -*- killRange) fs)+  killRange (ScopedExpr s e) = killRange1 (ScopedExpr s) e++instance KillRange Declaration where+  killRange (Axiom      i a b         ) = killRange3 Axiom      i a b+  killRange (Field      i a b         ) = killRange3 Field      i a b+  killRange (Definition i a b         ) = killRange3 Definition i a b+  killRange (Section    i a b c       ) = killRange4 Section    i a b c+  killRange (Apply      i a b c d e f ) = killRange5 Apply      i a b c d e f+  killRange (Import     i a           ) = killRange2 Import     i a+  killRange (Primitive  i a b         ) = killRange3 Primitive  i a b+  killRange (Pragma     i a           ) = Pragma (killRange i) a+  killRange (ScopedDecl a d           ) = killRange1 (ScopedDecl a) d++instance KillRange Definition where+  killRange (FunDef  i a b    ) = killRange3 FunDef  i a b+  killRange (DataDef i a b c d) = killRange5 DataDef i a b c d+  killRange (RecDef  i a b c d) = killRange5 RecDef  i a b c d+  killRange (ScopedDef s a)     = killRange1 (ScopedDef s) a++instance KillRange e => KillRange (Pattern' e) where+  killRange (VarP x)      = killRange1 VarP x+  killRange (ConP i a b)  = killRange3 ConP i a b+  killRange (DefP i a b)  = killRange3 DefP i a b+  killRange (WildP i)     = killRange1 WildP i+  killRange (ImplicitP i) = killRange1 ImplicitP i+  killRange (AsP i a b)   = killRange3 AsP i a b+  killRange (DotP i a)    = killRange2 DotP i a+  killRange (AbsurdP i)   = killRange1 AbsurdP i+  killRange (LitP l)      = killRange1 LitP l++instance KillRange LHS where+  killRange (LHS i a b c) = killRange4 LHS i a b c++instance KillRange Clause where+  killRange (Clause lhs rhs ds) = killRange3 Clause lhs rhs ds++instance KillRange RHS where+  killRange AbsurdRHS        = AbsurdRHS+  killRange (RHS e)          = killRange1 RHS e+  killRange (WithRHS q e cs) = killRange3 WithRHS q e cs++instance KillRange LetBinding where+  killRange (LetBind  i a b c       ) = killRange4 LetBind  i a b c+  killRange (LetApply i a b c d e f ) = killRange5 LetApply i a b c d e f++------------------------------------------------------------------------+-- Queries+------------------------------------------------------------------------++-- | Extracts all the names which are declared in a 'Declaration'.+-- This does not include open public or let expressions, but it does+-- include local modules and where clauses.++allNames :: Declaration -> Seq QName+allNames (Axiom     _ q _)     = Seq.singleton q+allNames (Field     _ q _)     = Seq.singleton q+allNames (Primitive _ q _)     = Seq.singleton q+allNames (Definition _ _ defs) = Fold.foldMap allNamesD defs+  where+  allNamesD :: Definition -> Seq QName+  allNamesD (FunDef _ q cls)        = q <| Fold.foldMap allNamesC cls+  allNamesD (DataDef _ q _ _ decls) = q <| Fold.foldMap allNames decls+  allNamesD (RecDef _ q _ _ decls)  = q <| Fold.foldMap allNames decls+  allNamesD (ScopedDef _ def)       = allNamesD def++  allNamesC :: Clause -> Seq QName+  allNamesC (Clause _ rhs decls) = allNamesR rhs ><+                                   Fold.foldMap allNames decls++  allNamesR :: RHS -> Seq QName+  allNamesR (RHS {})          = Seq.empty+  allNamesR (AbsurdRHS {})    = Seq.empty+  allNamesR (WithRHS q _ cls) = q <| Fold.foldMap allNamesC cls+allNames (Section _ _ _ decls) = Fold.foldMap allNames decls+allNames (Apply {})            = Seq.empty+allNames (Import {})           = Seq.empty+allNames (Pragma {})           = Seq.empty+allNames (ScopedDecl _ decls)  = Fold.foldMap allNames decls

+ src/full/Agda/Syntax/Abstract/Name.hs view

@@ -0,0 +1,246 @@+{-# LANGUAGE CPP, DeriveDataTypeable, GeneralizedNewtypeDeriving, FlexibleContexts #-}++{-| Abstract names should carry unique identifiers and stuff. Not right now though.+-}+module Agda.Syntax.Abstract.Name where++import Control.Monad.State+import Data.Generics (Typeable, Data)+import Data.List+import Data.Function++import Agda.Syntax.Position+import Agda.Syntax.Common+import Agda.Syntax.Fixity+import qualified Agda.Syntax.Concrete.Name as C++import Agda.Utils.Fresh+import Agda.Utils.Size+import Agda.Utils.Suffix++#include "../../undefined.h"+import Agda.Utils.Impossible++-- | A name is a unique identifier and a suggestion for a concrete name. The+--   concrete name contains the source location (if any) of the name. The+--   source location of the binding site is also recorded.+data Name = Name { nameId	   :: NameId+		 , nameConcrete	   :: C.Name+		 , nameBindingSite :: Range+		 , nameFixity	   :: Fixity+		 }+    deriving (Typeable, Data)++-- | Qualified names are non-empty lists of names. Equality on qualified names+--   are just equality on the last name, i.e. the module part is just+--   for show.+--+-- The 'SetRange' instance for qualified names sets all individual+-- ranges (including those of the module prefix) to the given one.+data QName = QName { qnameModule :: ModuleName+		   , qnameName	 :: Name+		   }+    deriving (Typeable, Data)++-- | A module name is just a qualified name.+--+-- The 'SetRange' instance for module names sets all individual ranges+-- to the given one.+newtype ModuleName = MName { mnameToList :: [Name] }+  deriving (Eq, Ord, Typeable, Data)++-- | Ambiguous qualified names. Used for overloaded constructors.+--+-- Invariant: All the names in the list must have the same concrete,+-- unqualified name.+newtype AmbiguousQName = AmbQ { unAmbQ :: [QName] }+  deriving (Typeable, Data, HasRange)++instance HasRange ModuleName where+  getRange (MName []) = noRange+  getRange (MName xs) = getRange xs++-- | Sets the ranges of the individual names in the module name to+-- match those of the corresponding concrete names. If the concrete+-- names are fewer than the number of module name name parts, then the+-- initial name parts get the range 'noRange'.+--+-- @C.D.E `withRangesOf` [A, B]@ returns @C.D.E@ but with ranges set+-- as follows:+--+-- * @C@: 'noRange'.+--+-- * @D@: the range of @A@.+--+-- * @E@: the range of @B@.+--+-- Precondition: The number of module name name parts has to be at+-- least as large as the length of the list.++withRangesOf :: ModuleName -> [C.Name] -> ModuleName+MName ms `withRangesOf` ns+  | length ms < length ns  = __IMPOSSIBLE__+  | otherwise              = MName $+      reverse $ zipWith setRange+                        (reverse (map getRange ns) ++ repeat noRange)+                        (reverse ms)++-- | Like 'withRangesOf', but uses the name parts (qualifier + name)+-- of the qualified name as the list of concrete names.++withRangesOfQ :: ModuleName -> C.QName -> ModuleName+m `withRangesOfQ` q = m `withRangesOf` C.qnameParts q++mnameFromList :: [Name] -> ModuleName+mnameFromList = MName++noModuleName :: ModuleName+noModuleName = mnameFromList []++-- | The 'Range' sets the /definition site/ of the name, not the use+-- site.++mkName :: Range -> NameId -> String -> Name+mkName r i s = Name i (C.Name noRange (parseName s)) r defaultFixity+  where+    parseName ""      = []+    parseName ('_':s) = C.Hole : parseName s+    parseName s = case break (== '_') s of+      (s0, s1)	-> C.Id s0 : parseName s1++mkName_ :: NameId -> String -> Name+mkName_ = mkName noRange++qnameToList :: QName -> [Name]+qnameToList (QName m x) = mnameToList m ++ [x]++qnameFromList :: [Name] -> QName+qnameFromList [] = __IMPOSSIBLE__+qnameFromList xs = QName (mnameFromList $ init xs) (last xs)++-- | Turn a qualified name into a concrete name. This should only be used as a+--   fallback when looking up the right concrete name in the scope fails.+qnameToConcrete :: QName -> C.QName+qnameToConcrete (QName m x) =+  foldr C.Qual (C.QName $ nameConcrete x) $ map nameConcrete $ mnameToList m++mnameToConcrete :: ModuleName -> C.QName+mnameToConcrete (MName []) = __IMPOSSIBLE__ -- C.QName C.noName_  -- should never happen?+mnameToConcrete (MName xs) = foldr C.Qual (C.QName $ last cs) $ init cs+  where+    cs = map nameConcrete xs++qualifyM :: ModuleName -> ModuleName -> ModuleName+qualifyM m1 m2 = mnameFromList $ mnameToList m1 ++ mnameToList m2++qualifyQ :: ModuleName -> QName -> QName+qualifyQ m x = qnameFromList $ mnameToList m ++ qnameToList x++qualify :: ModuleName -> Name -> QName+qualify m x = qualifyQ m (qnameFromList [x])++-- | Is the name an operator?++isOperator :: QName -> Bool+isOperator q = C.isOperator (nameConcrete (qnameName q))++isSubModuleOf :: ModuleName -> ModuleName -> Bool+isSubModuleOf x y = xs /= ys && isPrefixOf ys xs+  where+    xs = mnameToList x+    ys = mnameToList y++isInModule :: QName -> ModuleName -> Bool+isInModule q m = mnameToList m `isPrefixOf` qnameToList q++freshName :: (MonadState s m, HasFresh NameId s) => Range -> String -> m Name+freshName r s = do+  i <- fresh+  return $ mkName r i s++freshName_ :: (MonadState s m, HasFresh NameId s) => String -> m Name+freshName_ = freshName noRange++freshNoName :: (MonadState s m, HasFresh NameId s) => Range -> m Name+freshNoName r =+    do	i <- fresh+	return $ Name i (C.NoName noRange i) r defaultFixity++freshNoName_ :: (MonadState s m, HasFresh NameId s) => m Name+freshNoName_ = freshNoName noRange++-- | Get the next version of the concrete name. For instance, @nextName "x" = "x'"@.+--   The name must not be a 'NoName'.+nextName :: Name -> Name+nextName x = x { nameConcrete = C.Name noRange $ nextSuf ps }+    where+	C.Name _ ps = nameConcrete x+	-- NoName cannot appear here+	nextSuf [C.Id s]         = [C.Id $ nextStr s]+	nextSuf [C.Id s, C.Hole] = [C.Id $ nextStr s, C.Hole]+	nextSuf (p : ps)         = p : nextSuf ps+	nextSuf []               = __IMPOSSIBLE__+	nextStr s = case suffixView s of+	    (s0, suf) -> addSuffix s0 (nextSuffix suf)++instance Show NameId where+  show (NameId x i) = show x ++ "@" ++ show i++instance Eq Name where+  x == y  = nameId x == nameId y++instance Ord Name where+  compare x y = compare (nameId x) (nameId y)++instance Show Name where+  show x = show (nameConcrete x) -- ++ "|" ++ show (nameId x)++instance Show QName where+  show q = concat $ intersperse "." $ map show $ qnameToList q++instance Show ModuleName where+  show m = concat $ intersperse "." $ map show $ mnameToList m++instance Eq QName where+  (==) = (==) `on` qnameName++instance Ord QName where+  compare = compare `on` qnameName++instance HasRange Name where+  getRange = getRange . nameConcrete++instance HasRange QName where+  getRange q = getRange (qnameModule q, qnameName q)++instance SetRange Name where+  setRange r x = x { nameConcrete = setRange r $ nameConcrete x }++instance SetRange QName where+  setRange r q = q { qnameModule = setRange r $ qnameModule q+                   , qnameName   = setRange r $ qnameName   q+                   }++instance SetRange ModuleName where+  setRange r (MName ns) = MName (map (setRange r) ns)++instance KillRange QName where+  killRange q = q { qnameModule = killRange $ qnameModule q+                  , qnameName   = killRange $ qnameName   q+                  }++instance KillRange Name where+  killRange x = x { nameConcrete = killRange $ nameConcrete x }++instance KillRange ModuleName where+  killRange (MName xs) = MName $ killRange xs++instance KillRange AmbiguousQName where+  killRange (AmbQ xs) = AmbQ $ killRange xs++instance Sized QName where+  size = size . qnameToList++instance Sized ModuleName where+  size = size . mnameToList+

+ src/full/Agda/Syntax/Abstract/Pretty.hs view

@@ -0,0 +1,17 @@++module Agda.Syntax.Abstract.Pretty where++import Control.Applicative++import Agda.Syntax.Abstract+import Agda.Syntax.Concrete.Pretty ()+import Agda.Syntax.Translation.AbstractToConcrete+import Agda.TypeChecking.Monad+import Agda.Utils.Pretty++showA :: (Show c, ToConcrete a c, MonadTCM tcm) => a -> tcm String+showA x = show <$> abstractToConcrete_ x++prettyA :: (Pretty c, ToConcrete a c, MonadTCM tcm) => a -> tcm Doc+prettyA x = pretty <$> abstractToConcrete_ x+

+ src/full/Agda/Syntax/Abstract/Views.hs view

@@ -0,0 +1,46 @@++module Agda.Syntax.Abstract.Views where++import Agda.Syntax.Position+import Agda.Syntax.Common+import Agda.Syntax.Abstract+import Agda.Syntax.Info++data AppView = Application Head [NamedArg Expr]+	     | NonApplication Expr+		-- ^ TODO: if we allow beta-redexes (which we currently do) there could be one here.++data Head = HeadVar Name+	  | HeadDef QName+	  | HeadCon [QName]++appView :: Expr -> AppView+appView e =+    case e of+	Var x	       -> Application (HeadVar x) []+	Def x	       -> Application (HeadDef x) []+	Con (AmbQ x)   -> Application (HeadCon x) []+	App i e1 arg   -> apply i (appView e1) arg+	ScopedExpr _ e -> appView e+	_	       -> NonApplication e+    where+	apply i v arg =+	    case v of+		Application hd es -> Application hd $ es ++ [arg]+		NonApplication e  -> NonApplication (App i e arg)++headToExpr :: Head -> Expr+headToExpr (HeadVar x)  = Var x+headToExpr (HeadDef f)  = Def f+headToExpr (HeadCon cs) = Con (AmbQ cs)++unAppView :: AppView -> Expr+unAppView (NonApplication e) = e+unAppView (Application h es) =+  foldl (App (ExprRange noRange)) (headToExpr h) es++instance HasRange Head where+    getRange (HeadVar x) = getRange x+    getRange (HeadDef x) = getRange x+    getRange (HeadCon x) = getRange x+

+ src/full/Agda/Syntax/Common.hs view

@@ -0,0 +1,127 @@+{-# LANGUAGE CPP, FlexibleInstances, DeriveDataTypeable #-}++{-| Some common syntactic entities are defined in this module.+-}+module Agda.Syntax.Common where++import Data.Generics (Typeable, Data)+import Control.Applicative+import Data.Foldable+import Data.Traversable+import Test.QuickCheck++import Agda.Syntax.Position+import Agda.Utils.Monad+import Agda.Utils.Size++#include "../undefined.h"+import Agda.Utils.Impossible++data Induction = Inductive | CoInductive+  deriving (Typeable, Data, Show, Eq)++data Hiding  = Hidden | NotHidden+    deriving (Typeable, Data, Show, Eq)++instance KillRange Induction where killRange = id+instance KillRange Hiding    where killRange = id++-- | A function argument can be hidden.+data Arg e  = Arg { argHiding :: Hiding, unArg :: e }+    deriving (Typeable, Data, Eq)++instance Functor Arg where+    fmap f (Arg h x) = Arg h $ f x++instance Foldable Arg where+    foldr f z (Arg _ x) = f x z++instance Traversable Arg where+    traverse f (Arg h x) = Arg h <$> f x++instance HasRange a => HasRange (Arg a) where+    getRange = getRange . unArg++instance KillRange a => KillRange (Arg a) where+  killRange = fmap killRange++instance Sized a => Sized (Arg a) where+  size = size . unArg++instance Show a => Show (Arg a) where+    show (Arg Hidden x)    = "{" ++ show x ++ "}"+    show (Arg NotHidden x) = "(" ++ show x ++ ")"++data Named name a =+    Named { nameOf     :: Maybe name+	  , namedThing :: a+	  }+    deriving (Eq, Typeable, Data)++unnamed :: a -> Named name a+unnamed = Named Nothing++named :: name -> a -> Named name a+named = Named . Just++instance Functor (Named name) where+    fmap f (Named n x) = Named n $ f x++instance Foldable (Named name) where+    foldr f z (Named _ x) = f x z++instance Traversable (Named name) where+    traverse f (Named n x) = Named n <$> f x++instance HasRange a => HasRange (Named name a) where+    getRange = getRange . namedThing++instance KillRange a => KillRange (Named name a) where+  killRange = fmap killRange++instance Sized a => Sized (Named name a) where+  size = size . namedThing++instance Show a => Show (Named String a) where+    show (Named Nothing x)  = show x+    show (Named (Just n) x) = n ++ " = " ++ show x++-- | Only 'Hidden' arguments can have names.+type NamedArg a = Arg (Named String a)++-- | Functions can be defined in both infix and prefix style. See+--   'Agda.Syntax.Concrete.LHS'.+data IsInfix = InfixDef | PrefixDef+    deriving (Typeable, Data, Show, Eq)++-- | Access modifier.+data Access = PrivateAccess | PublicAccess+    deriving (Typeable, Data, Show, Eq)++-- | Abstract or concrete+data IsAbstract = AbstractDef | ConcreteDef+    deriving (Typeable, Data, Show, Eq)++type Nat    = Integer+type Arity  = Nat++-- | The unique identifier of a name. Second argument is the top-level module+--   identifier.+data NameId = NameId Nat Integer+    deriving (Eq, Ord, Typeable, Data)++instance Enum NameId where+  succ (NameId n m)	= NameId (n + 1) m+  pred (NameId n m)	= NameId (n - 1) m+  toEnum n		= __IMPOSSIBLE__  -- should not be used+  fromEnum (NameId n _) = fromIntegral n++------------------------------------------------------------------------+-- Arbitrary and CoArbitrary instances++instance Arbitrary Induction where+  arbitrary = elements [Inductive, CoInductive]++instance CoArbitrary Induction where+  coarbitrary Inductive   = variant 0+  coarbitrary CoInductive = variant 1

+ src/full/Agda/Syntax/Concrete.hs view

@@ -0,0 +1,345 @@+{-# LANGUAGE CPP, DeriveDataTypeable #-}++{-| The concrete syntax is a raw representation of the program text+    without any desugaring at all.  This is what the parser produces.+    The idea is that if we figure out how to keep the concrete syntax+    around, it can be printed exactly as the user wrote it.+-}+module Agda.Syntax.Concrete+    ( -- * Expressions+      Expr(..)+    , module Agda.Syntax.Concrete.Name+    , appView, AppView(..)+      -- * Bindings+    , LamBinding(..)+    , TypedBindings(..)+    , TypedBinding(..)+    , BoundName(..), mkBoundName_+    , Telescope -- (..)+      -- * Declarations+    , Declaration(..)+    , TypeSignature+    , Constructor+    , ImportDirective(..), UsingOrHiding(..), ImportedName(..)+    , defaultImportDir+    , OpenShortHand(..)+    , LHS(..), Pattern(..)+    , RHS(..), WhereClause(..)+    , Pragma(..)+    )+    where++import Data.Generics hiding (Fixity, Infix)++import Agda.Syntax.Position+import Agda.Syntax.Common+import Agda.Syntax.Fixity+import Agda.Syntax.Literal++import Agda.Syntax.Concrete.Name++-- | Concrete expressions. Should represent exactly what the user wrote.+data Expr+	= Ident QName			       -- ^ ex: @x@+	| Lit Literal			       -- ^ ex: @1@ or @\"foo\"@+	| QuestionMark !Range (Maybe Nat)      -- ^ ex: @?@ or @{! ... !}@+	| Underscore !Range (Maybe Nat)	       -- ^ ex: @_@+	| RawApp !Range [Expr]		       -- ^ before parsing operators+	| App !Range Expr (NamedArg Expr)      -- ^ ex: @e e@, @e {e}@, or @e {x = e}@+	| OpApp !Range Name [Expr]	       -- ^ ex: @e + e@+        | WithApp !Range Expr [Expr]           -- ^ ex: @e | e1 | .. | en@+	| HiddenArg !Range (Named String Expr) -- ^ ex: @{e}@ or @{x=e}@+	| Lam !Range [LamBinding] Expr	       -- ^ ex: @\\x {y} -> e@ or @\\(x:A){y:B} -> e@+        | AbsurdLam !Range Hiding              -- ^ ex: @\\ ()@+	| Fun !Range Expr Expr		       -- ^ ex: @e -> e@ or @{e} -> e@+	| Pi Telescope Expr		       -- ^ ex: @(xs:e) -> e@ or @{xs:e} -> e@+	| Set !Range			       -- ^ ex: @Set@+	| Prop !Range			       -- ^ ex: @Prop@+	| SetN !Range Nat		       -- ^ ex: @Set0, Set1, ..@+	| Rec !Range [(Name, Expr)]	       -- ^ ex: @record {x = a; y = b}@+	| Let !Range [Declaration] Expr	       -- ^ ex: @let Ds in e@+	| Paren !Range Expr		       -- ^ ex: @(e)@+	| Absurd !Range			       -- ^ ex: @()@ or @{}@, only in patterns+	| As !Range Name Expr		       -- ^ ex: @x\@p@, only in patterns+	| Dot !Range Expr		       -- ^ ex: @.p@, only in patterns+    deriving (Typeable, Data, Eq)+++-- | Concrete patterns. No literals in patterns at the moment.+data Pattern+	= IdentP QName+	| AppP Pattern (NamedArg Pattern)+	| RawAppP !Range [Pattern]+	| OpAppP !Range Name [Pattern]+	| HiddenP !Range (Named String Pattern)+	| ParenP !Range Pattern+	| WildP !Range+	| AbsurdP !Range+	| AsP !Range Name Pattern+	| DotP !Range Expr+	| LitP Literal+    deriving (Typeable, Data, Eq)+++-- | A lambda binding is either domain free or typed.+data LamBinding+	= DomainFree Hiding BoundName -- ^ . @x@ or @{x}@+	| DomainFull TypedBindings    -- ^ . @(xs:e,..,ys:e')@ or @{xs:e,..,ys:e'}@+    deriving (Typeable, Data, Eq)+++-- | A sequence of typed bindings with hiding information. Appears in dependent+--   function spaces, typed lambdas, and telescopes.+data TypedBindings = TypedBindings !Range Hiding [TypedBinding]+	-- ^ . @(xs:e;..;ys:e')@ or @{xs:e;..;ys:e'}@+    deriving (Typeable, Data, Eq)+++data BoundName = BName { boundName   :: Name+                       , bnameFixity :: Fixity+                       }+    deriving (Typeable, Data, Eq)++mkBoundName_ :: Name -> BoundName+mkBoundName_ x = BName x defaultFixity++-- | A typed binding.+data TypedBinding+	= TBind !Range [BoundName] Expr   -- Binding @x1,..,xn:A@+	| TNoBind Expr		    -- No binding @A@, equivalent to @_ : A@.+    deriving (Typeable, Data, Eq)+++-- | A telescope is a sequence of typed bindings. Bound variables are in scope+--   in later types. Or it's the mysterious Thierry-function-telescope. Only it's not.+type Telescope = [TypedBindings]+-- data Telescope = TeleBind [TypedBindings]+-- 	       | TeleFun Telescope Telescope+--     deriving (Typeable, Data, Eq)+++{-| Left hand sides can be written in infix style. For example:++    > n + suc m = suc (n + m)+    > (f ∘ g) x = f (g x)++   We use fixity information to see which name is actually defined.+-}+data LHS = LHS Pattern [Pattern] [Expr]+         -- ^ original pattern, with-patterns and with-expressions+         | Ellipsis Range [Pattern] [Expr]+         -- ^ new with-patterns and with-expressions+  deriving (Typeable, Data, Eq)++data RHS = AbsurdRHS+	 | RHS Expr+    deriving (Typeable, Data, Eq)++data WhereClause = NoWhere | AnyWhere [Declaration] | SomeWhere Name [Declaration]+  deriving (Typeable, Data, Eq)+++-- | The things you are allowed to say when you shuffle names between name+--   spaces (i.e. in @import@, @namespace@, or @open@ declarations).+data ImportDirective+	= ImportDirective+	    { importDirRange	:: !Range+	    , usingOrHiding	:: UsingOrHiding+	    , renaming		:: [(ImportedName, Name)]+	    , publicOpen	:: Bool	-- ^ Only for @open@. Exports the opened names from the current module.+	    }+    deriving (Typeable, Data, Eq)++defaultImportDir :: ImportDirective+defaultImportDir = ImportDirective noRange (Hiding []) [] False++data UsingOrHiding+	= Hiding [ImportedName]+	| Using  [ImportedName]+    deriving (Typeable, Data, Eq)++-- | An imported name can be a module or a defined name+data ImportedName = ImportedModule  { importedName :: Name }+		  | ImportedName    { importedName :: Name }+    deriving (Typeable, Data, Eq, Ord)++instance Show ImportedName where+    show (ImportedModule x) = "module " ++ show x+    show (ImportedName   x) = show x++{--------------------------------------------------------------------------+    Declarations+ --------------------------------------------------------------------------}++-- | Just type signatures.+type TypeSignature   = Declaration++-- | A constructor or field declaration is just a type signature.+type Constructor = TypeSignature+type Field	 = TypeSignature++{-| The representation type of a declaration. The comments indicate+    which type in the intended family the constructor targets.+-}+data Declaration+	= TypeSig Name Expr+        | Field Name Expr+	| FunClause LHS RHS WhereClause+	| Data        !Range Induction Name [TypedBindings] Expr [Constructor]+	| Record      !Range Name [TypedBindings] Expr [Field]+	| Infix Fixity [Name]+	| Mutual      !Range [Declaration]+	| Abstract    !Range [Declaration]+	| Private     !Range [Declaration]+	| Postulate   !Range [TypeSignature]+	| Primitive   !Range [TypeSignature]+	| Open        !Range QName ImportDirective+	| Import      !Range QName (Maybe Name) OpenShortHand ImportDirective+	| ModuleMacro !Range  Name [TypedBindings] Expr OpenShortHand ImportDirective+	| Module      !Range QName [TypedBindings] [Declaration]+	| Pragma      Pragma+    deriving (Eq, Typeable, Data)++data OpenShortHand = DoOpen | DontOpen+    deriving (Eq, Typeable, Data, Show)++-- Pragmas ----------------------------------------------------------------++data Pragma = OptionsPragma     !Range [String]+	    | BuiltinPragma     !Range String Expr+	    | LinePragma        !Range Int String+            | CompiledDataPragma !Range QName String [String]+            | CompiledTypePragma !Range QName String+            | CompiledPragma    !Range QName String+            | ImportPragma      !Range String+    deriving (Eq, Typeable, Data)++{--------------------------------------------------------------------------+    Views+ --------------------------------------------------------------------------}++-- | The 'Expr' is not an application.+data AppView = AppView Expr [NamedArg Expr]++appView :: Expr -> AppView+appView (App r e1 e2) = vApp (appView e1) e2+    where+	vApp (AppView e es) arg = AppView e (es ++ [arg])+appView (RawApp _ (e:es)) = AppView e $ map arg es+    where+	arg (HiddenArg _ e) = Arg Hidden e+	arg e		    = Arg NotHidden (unnamed e)+appView e = AppView e []++{--------------------------------------------------------------------------+    Instances+ --------------------------------------------------------------------------}++instance HasRange Expr where+    getRange e =+	case e of+	    Ident x		-> getRange x+	    Lit x		-> getRange x+	    QuestionMark r _	-> r+	    Underscore r _	-> r+	    App r _ _		-> r+	    RawApp r _		-> r+	    OpApp r _ _		-> r+            WithApp r _ _       -> r+	    Lam r _ _		-> r+            AbsurdLam r _       -> r+	    Fun r _ _		-> r+	    Pi b e		-> fuseRange b e+	    Set r		-> r+	    Prop r		-> r+	    SetN r _		-> r+	    Let r _ _		-> r+	    Paren r _		-> r+	    As r _ _		-> r+	    Dot r _		-> r+	    Absurd r		-> r+	    HiddenArg r _	-> r+	    Rec r _		-> r++-- instance HasRange Telescope where+--     getRange (TeleBind bs) = getRange bs+--     getRange (TeleFun x y) = fuseRange x y++instance HasRange TypedBindings where+    getRange (TypedBindings r _ _) = r++instance HasRange TypedBinding where+    getRange (TBind r _ _) = r+    getRange (TNoBind e)   = getRange e++instance HasRange LamBinding where+    getRange (DomainFree _ x)	= getRange x+    getRange (DomainFull b)	= getRange b++instance HasRange BoundName where+  getRange = getRange . boundName++instance HasRange WhereClause where+  getRange  NoWhere	    = noRange+  getRange (AnyWhere ds)    = getRange ds+  getRange (SomeWhere _ ds) = getRange ds++instance HasRange Declaration where+    getRange (TypeSig x t)		= fuseRange x t+    getRange (Field x t)                = fuseRange x t+    getRange (FunClause lhs rhs wh)	= fuseRange lhs rhs `fuseRange` wh+    getRange (Data r _ _ _ _ _)		= r+    getRange (Record r _ _ _ _)		= r+    getRange (Mutual r _)		= r+    getRange (Abstract r _)		= r+    getRange (Open r _ _)		= r+    getRange (ModuleMacro r _ _ _ _ _)	= r+    getRange (Import r _ _ _ _)		= r+    getRange (Private r _)		= r+    getRange (Postulate r _)		= r+    getRange (Primitive r _)		= r+    getRange (Module r _ _ _)		= r+    getRange (Infix f _)		= getRange f+    getRange (Pragma p)			= getRange p++instance HasRange LHS where+  getRange (LHS p ps es) = fuseRange p (fuseRange ps es)+  getRange (Ellipsis r _ _) = r++instance HasRange RHS where+    getRange AbsurdRHS = noRange+    getRange (RHS e)   = getRange e++instance HasRange Pragma where+    getRange (OptionsPragma r _)          = r+    getRange (BuiltinPragma r _ _)        = r+    getRange (LinePragma r _ _)           = r+    getRange (CompiledDataPragma r _ _ _) = r+    getRange (CompiledTypePragma r _ _)   = r+    getRange (CompiledPragma r _ _)       = r+    getRange (ImportPragma r _)           = r++instance HasRange UsingOrHiding where+    getRange (Using xs)	    = getRange xs+    getRange (Hiding xs)    = getRange xs++instance HasRange ImportDirective where+    getRange = importDirRange++instance HasRange ImportedName where+    getRange (ImportedName x)	= getRange x+    getRange (ImportedModule x)	= getRange x++instance HasRange Pattern where+    getRange (IdentP x)		= getRange x+    getRange (AppP p q)		= fuseRange p q+    getRange (OpAppP r _ _)	= r+    getRange (RawAppP r _)	= r+    getRange (ParenP r _)	= r+    getRange (WildP r)		= r+    getRange (AsP r _ _)	= r+    getRange (AbsurdP r)	= r+    getRange (LitP l)		= getRange l+    getRange (HiddenP r _)	= r+    getRange (DotP r _)		= r+

+ src/full/Agda/Syntax/Concrete/Definitions.hs view

@@ -0,0 +1,476 @@+{-# LANGUAGE CPP, PatternGuards, DeriveDataTypeable #-}++module Agda.Syntax.Concrete.Definitions+    ( NiceDeclaration(..)+    , NiceDefinition(..)+    , NiceConstructor, NiceTypeSignature+    , Clause(..)+    , DeclarationException(..)+    , Nice, runNice+    , niceDeclarations+    , notSoNiceDeclarations+    ) where++import Control.Exception+import Control.Applicative++import Data.Generics (Data, Typeable)+import qualified Data.Map as Map+import Control.Monad.Error+import Data.List++import Agda.Syntax.Concrete+import Agda.Syntax.Common+import Agda.Syntax.Position+import Agda.Syntax.Fixity+import Agda.Syntax.Concrete.Pretty+import Agda.Utils.Pretty++#include "../../undefined.h"+import Agda.Utils.Impossible++{--------------------------------------------------------------------------+    Types+ --------------------------------------------------------------------------}++{-| 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@+    modifiers have been distributed to the individual declarations.+-}+data NiceDeclaration+	= Axiom Range Fixity Access IsAbstract Name Expr+        | NiceField Range Fixity Access IsAbstract Name Expr+	| PrimitiveFunction Range Fixity Access IsAbstract Name Expr+	| NiceDef Range [Declaration] [NiceTypeSignature] [NiceDefinition]+	    -- ^ A bunch of mutually recursive functions\/datatypes.+	    --   The last two lists have the same length. The first list is the+	    --   concrete declarations these definitions came from.+	| NiceModule Range Access IsAbstract QName Telescope [Declaration]+	| NiceModuleMacro Range Access IsAbstract Name Telescope Expr OpenShortHand ImportDirective+	| NiceOpen Range QName ImportDirective+	| NiceImport Range QName (Maybe Name) OpenShortHand ImportDirective+	| NicePragma Range Pragma+    deriving (Typeable, Data)++-- | A definition without its type signature.+data NiceDefinition+	= FunDef  Range [Declaration] Fixity Access IsAbstract Name [Clause]+	| DataDef Range Induction Fixity Access IsAbstract Name [LamBinding] [NiceConstructor]+	| RecDef Range Fixity Access IsAbstract Name [LamBinding] [NiceField]+    deriving (Typeable, Data)++-- | Only 'Axiom's.+type NiceConstructor = NiceTypeSignature+type NiceField = NiceTypeSignature++-- | Only 'Axiom's.+type NiceTypeSignature	= NiceDeclaration++-- | One clause in a function definition. There is no guarantee that the 'LHS'+--   actually declares the 'Name'. We will have to check that later.+data Clause = Clause Name LHS RHS WhereClause [Clause]+    deriving (Typeable, Data)++-- | The exception type.+data DeclarationException+	= MultipleFixityDecls [(Name, [Fixity])]+	| MissingDefinition Name+        | MissingWithClauses Name+	| MissingTypeSignature LHS+	| NotAllowedInMutual NiceDeclaration+	| UnknownNamesInFixityDecl [Name]+	| DeclarationPanic String+    deriving (Typeable)++instance HasRange DeclarationException where+    getRange (MultipleFixityDecls xs)	   = getRange (fst $ head xs)+    getRange (MissingDefinition x)	   = getRange x+    getRange (MissingWithClauses x)        = getRange x+    getRange (MissingTypeSignature x)	   = getRange x+    getRange (NotAllowedInMutual x)	   = getRange x+    getRange (UnknownNamesInFixityDecl xs) = getRange . head $ xs+    getRange (DeclarationPanic _)	   = noRange++instance HasRange NiceDeclaration where+    getRange (Axiom r _ _ _ _ _)	       = r+    getRange (NiceField r _ _ _ _ _)	       = r+    getRange (NiceDef r _ _ _)		       = r+    getRange (NiceModule r _ _ _ _ _)	       = r+    getRange (NiceModuleMacro r _ _ _ _ _ _ _) = r+    getRange (NiceOpen r _ _)		       = r+    getRange (NiceImport r _ _ _ _)	       = r+    getRange (NicePragma r _)		       = r+    getRange (PrimitiveFunction r _ _ _ _ _)   = r++instance HasRange NiceDefinition where+  getRange (FunDef r _ _ _ _ _ _)    = r+  getRange (DataDef r _ _ _ _ _ _ _) = r+  getRange (RecDef r _ _ _ _ _ _)    = r++instance Error DeclarationException where+  noMsg  = strMsg ""+  strMsg = DeclarationPanic++instance Show DeclarationException where+  show (MultipleFixityDecls xs) = show $+    sep [ fsep $ pwords "Multiple fixity declarations for"+	, vcat $ map f xs+	]+      where+	f (x, fs) = pretty x <> text ":" <+> fsep (map (text . show) fs)+  show (MissingDefinition x) = show $ fsep $+    pwords "Missing definition for" ++ [pretty x]+  show (MissingWithClauses x) = show $ fsep $+    pwords "Missing with-clauses for function" ++ [pretty x]+  show (MissingTypeSignature x) = show $ fsep $+    pwords "Missing type signature for left hand side" ++ [pretty x]+  show (UnknownNamesInFixityDecl xs) = show $ fsep $+    pwords "Names out of scope in fixity declarations:" ++ map pretty xs+  show (NotAllowedInMutual nd) = show $ fsep $+    [text $ decl nd] ++ pwords "are not allowed in mutual blocks"+    where+      decl (Axiom _ _ _ _ _ _)		     = "Postulates"+      decl (NiceField _ _ _ _ _ _)           = "Fields"+      decl (NiceDef _ _ _ _)		     = "Record types"+      decl (NiceModule _ _ _ _ _ _)	     = "Modules"+      decl (NiceModuleMacro _ _ _ _ _ _ _ _) = "Modules"+      decl (NiceOpen _ _ _)		     = "Open declarations"+      decl (NiceImport _ _ _ _ _)	     = "Import statements"+      decl (NicePragma _ _)		     = "Pragmas"+      decl (PrimitiveFunction _ _ _ _ _ _)   = "Primitive declarations"+  show (DeclarationPanic s) = s++{--------------------------------------------------------------------------+    The niceifier+ --------------------------------------------------------------------------}++type Nice = Either DeclarationException++runNice :: Nice a -> Either DeclarationException a+runNice = id++niceDeclarations :: [Declaration] -> Nice [NiceDeclaration]+niceDeclarations ds = do+      fixs <- fixities ds+      case Map.keys fixs \\ concatMap declaredNames ds of+	[]  -> nice fixs ds+	xs  -> throwError $ UnknownNamesInFixityDecl xs+    where++	-- If no fixity is given we return the default fixity.+	fixity :: Name -> Map.Map Name Fixity -> Fixity+	fixity = Map.findWithDefault defaultFixity++	-- We forget all fixities in recursive calls. This is because+	-- fixity declarations have to appear at the same level as the+	-- declaration.+	fmapNice x = mapM niceDeclarations x++	-- Compute the names defined in a declaration+	declaredNames :: Declaration -> [Name]+	declaredNames d = case d of+	  TypeSig x _				       -> [x]+          Field x _                                    -> [x]+	  FunClause (LHS p [] _) _ _+            | IdentP (QName x) <- noSingletonRawAppP p -> [x]+	  FunClause{}				       -> []+	  Data _ _ x _ _ cs			       -> x : concatMap declaredNames cs+	  Record _ x _ _ _			       -> [x]+	  Infix _ _				       -> []+	  Mutual _ ds				       -> concatMap declaredNames ds+	  Abstract _ ds				       -> concatMap declaredNames ds+	  Private _ ds				       -> concatMap declaredNames ds+	  Postulate _ ds			       -> concatMap declaredNames ds+	  Primitive _ ds			       -> concatMap declaredNames ds+	  Open{}				       -> []+	  Import{}				       -> []+	  ModuleMacro{}				       -> []+	  Module{}				       -> []+	  Pragma{}				       -> []++        niceFix fixs ds = do+	  fixs <- plusFixities fixs =<< fixities ds+          nice fixs ds++	nice _ []	 = return []+	nice fixs (d:ds) =+	    case d of+		TypeSig x t ->+		    -- After a type signature there should follow a bunch of+		    -- clauses.+		    case span (isFunClauseOf x) ds of+			([], _)	    -> throwError $ MissingDefinition x+			(ds0,ds1)   -> do+			  ds1 <- nice fixs ds1+			  d <- mkFunDef fixs x (Just t) ds0+                          return $ d : ds1++		cl@(FunClause lhs@(LHS p [] _) _ _)+                  | IdentP (QName x) <- noSingletonRawAppP p+                                  -> do+		      ds <- nice fixs ds+		      d <- mkFunDef fixs x Nothing [cl]+                      return $ d : ds+                FunClause lhs _ _ -> throwError $ MissingTypeSignature lhs++		_   -> liftM2 (++) nds (nice fixs ds)+		    where+			nds = case d of+                            Field x t               -> return $ niceAxioms fixs [ Field x t ]+			    Data   r ind x tel t cs -> dataOrRec (flip DataDef ind) niceAx r x tel t cs+			    Record r x tel t cs     -> dataOrRec RecDef (const niceDeclarations) r x tel t cs+			    Mutual r ds -> do+			      d <- mkMutual r [d] =<< niceFix fixs ds+			      return [d]++			    Abstract r ds -> do+			      map mkAbstract <$> niceFix fixs ds++			    Private _ ds -> do+			      map mkPrivate <$> niceFix fixs ds++			    Postulate _ ds -> return $ niceAxioms fixs ds++			    Primitive _ ds -> return $ map toPrim $ niceAxioms fixs ds++			    Module r x tel ds	-> return+				[ NiceModule r PublicAccess ConcreteDef x tel ds ]++			    ModuleMacro r x tel e op is -> return+				[ NiceModuleMacro r PublicAccess ConcreteDef x tel e op is ]++			    Infix _ _		-> return []+			    Open r x is		-> return [NiceOpen r x is]+			    Import r x as op is	-> return [NiceImport r x as op is]++			    Pragma p		-> return [NicePragma (getRange p) p]++			    FunClause _ _ _	-> __IMPOSSIBLE__+			    TypeSig _ _		-> __IMPOSSIBLE__+			  where+			    dataOrRec mkDef niceD r x tel t cs = do+                              ds <- niceD fixs cs+                              return $ +                                [ NiceDef r [d]+                                  [ Axiom (fuseRange x t) f PublicAccess ConcreteDef+                                          x (Pi tel t)+                                  ]+                                  -- Setting the range to the range of t makes sense+                                  -- since the only errors you get at the level of the+                                  -- definitions are the type not ending in a sort.+                                  [ mkDef (getRange t) f PublicAccess ConcreteDef x+                                          (concatMap binding tel)+                                          ds+                                  ]+                                ]+                              where+                                f = fixity x fixs+                                binding (TypedBindings _ h bs) =+                                    concatMap (bind h) bs+                                bind h (TBind _ xs _) =+                                    map (DomainFree h) xs+                                bind h (TNoBind e) =+                                    [ DomainFree h $ mkBoundName_ (noName (getRange e)) ]++++	-- Translate axioms+        niceAx fixs ds = return $ niceAxioms fixs ds++	niceAxioms :: Map.Map Name Fixity -> [TypeSignature] -> [NiceDeclaration]+	niceAxioms fixs ds = nice ds+	    where+		nice [] = []+		nice (d@(TypeSig x t) : ds) =+		    Axiom (getRange d) (fixity x fixs) PublicAccess ConcreteDef x t+		    : nice ds+		nice (d@(Field x t) : ds) =+		    NiceField (getRange d) (fixity x fixs) PublicAccess ConcreteDef x t+		    : nice ds+		nice _ = __IMPOSSIBLE__++	toPrim :: NiceDeclaration -> NiceDeclaration+	toPrim (Axiom r f a c x t) = PrimitiveFunction r f a c x t+	toPrim _		   = __IMPOSSIBLE__++	-- Create a function definition.+	mkFunDef fixs x mt ds0 = do+          cs <- mkClauses x $ expandEllipsis ds0+          return $+	    NiceDef (fuseRange x ds0)+		    (TypeSig x t : ds0)+		    [ Axiom (fuseRange x t) f PublicAccess ConcreteDef x t ]+		    [ FunDef (getRange ds0) ds0 f PublicAccess ConcreteDef x cs+		    ]+	    where+	      f = fixity x fixs+	      t = case mt of+		    Just t  -> t+		    Nothing -> Underscore (getRange x) Nothing+++        expandEllipsis :: [Declaration] -> [Declaration]+        expandEllipsis [] = []+        expandEllipsis (d@(FunClause (Ellipsis _ _ _) _ _) : ds) =+          d : expandEllipsis ds+        expandEllipsis (d@(FunClause lhs@(LHS p ps _) _ _) : ds) =+          d : expand p ps ds+          where+            expand _ _ [] = []+            expand p ps (FunClause (Ellipsis _ ps' []) rhs wh : ds) =+              FunClause (LHS p (ps ++ ps') []) rhs wh : expand p ps ds+            expand p ps (FunClause (Ellipsis _ ps' es) rhs wh : ds) =+              FunClause (LHS p (ps ++ ps') es) rhs wh : expand p (ps ++ ps') ds+            expand p ps (d@(FunClause (LHS _ _ []) _ _) : ds) =+              d : expand p ps ds+            expand _ _ (d@(FunClause (LHS p ps (_ : _)) _ _) : ds) =+              d : expand p ps ds+            expand _ _ (_ : ds) = __IMPOSSIBLE__+        expandEllipsis (_ : ds) = __IMPOSSIBLE__+++        -- Turn function clauses into nice function clauses.+        mkClauses :: Name -> [Declaration] -> Nice [Clause]+        mkClauses _ [] = return []+        mkClauses x (FunClause lhs@(LHS _ _ []) rhs wh : cs) =+          (Clause x lhs rhs wh [] :) <$> mkClauses x cs+        mkClauses x (FunClause lhs@(LHS _ ps es) rhs wh : cs) = do+          when (null with) $ throwError $ MissingWithClauses x+          wcs <- mkClauses x with+          (Clause x lhs rhs wh wcs :) <$> mkClauses x cs'+          where+            (with, cs') = span subClause cs++            -- A clause is a subclause if the number of with-patterns is+            -- greater or equal to the current number of with-patterns plus the+            -- number of with arguments.+            subClause (FunClause (LHS _ ps' _) _ _)      = length ps' >= length ps + length es+            subClause (FunClause (Ellipsis _ ps' _) _ _) = True+            subClause _                                  = __IMPOSSIBLE__+        mkClauses x (FunClause lhs@(Ellipsis _ _ _) rhs wh : cs) =+          (Clause x lhs rhs wh [] :) <$> mkClauses x cs   -- Will result in an error later.+        mkClauses _ _ = __IMPOSSIBLE__++	noSingletonRawAppP (RawAppP _ [p]) = noSingletonRawAppP p+	noSingletonRawAppP p		   = p++        isFunClauseOf x (FunClause (Ellipsis _ _ _) _ _) = True+	isFunClauseOf x (FunClause (LHS p _ _) _ _) = case noSingletonRawAppP p of+	    IdentP (QName q)	-> x == q+	    _			-> True+		-- more complicated lhss must come with type signatures, so we just assume+		-- it's part of the current definition+	isFunClauseOf _ _ = False++	-- Make a mutual declaration+	mkMutual :: Range -> [Declaration] -> [NiceDeclaration] -> Nice NiceDeclaration+	mkMutual r cs ds = do+            when (length ds > 1) $ mapM_ checkMutual ds+            setConcrete cs <$> foldM smash (NiceDef r [] [] []) ds+	  where+            setConcrete cs (NiceDef r _ ts ds)  = NiceDef r cs ts ds+            setConcrete cs d		    = __IMPOSSIBLE__++            isRecord RecDef{} = True+            isRecord _	  = False++            checkMutual nd@(NiceDef _ _ _ ds)+              | any isRecord ds = throwError $ NotAllowedInMutual nd+              | otherwise       = return ()+            checkMutual d = throwError $ NotAllowedInMutual d++            smash nd@(NiceDef r0 _ ts0 ds0) (NiceDef r1 _ ts1 ds1) =+              return $ NiceDef (fuseRange r0 r1) [] (ts0 ++ ts1) (ds0 ++ ds1)+            smash _ _ = __IMPOSSIBLE__++	-- Make a declaration abstract+	mkAbstract d =+	    case d of+		Axiom r f a _ x e		    -> Axiom r f a AbstractDef x e+		NiceField r f a _ x e		    -> NiceField r f a AbstractDef x e+		PrimitiveFunction r f a _ x e	    -> PrimitiveFunction r f a AbstractDef x e+		NiceDef r cs ts ds		    -> NiceDef r cs (map mkAbstract ts)+								 (map mkAbstractDef ds)+		NiceModule r a _ x tel ds	    -> NiceModule r a AbstractDef x tel [ Abstract (getRange ds) ds ]+		NiceModuleMacro r a _ x tel e op is -> NiceModuleMacro r a AbstractDef x tel e op is+		NicePragma _ _			    -> d+		NiceOpen _ _ _			    -> d+		NiceImport _ _ _ _ _		    -> d++	mkAbstractDef d =+	    case d of+		FunDef r ds f a _ x cs      -> FunDef r ds f a AbstractDef x+						  (map mkAbstractClause cs)+		DataDef r ind f a _ x ps cs -> DataDef r ind f a AbstractDef x ps $ map mkAbstract cs+		RecDef r f a _ x ps cs      -> RecDef r f a AbstractDef x ps $ map mkAbstract cs++	mkAbstractClause (Clause x lhs rhs wh with) =+	    Clause x lhs rhs (mkAbstractWhere wh) (map mkAbstractClause with)++	mkAbstractWhere  NoWhere	 = NoWhere+	mkAbstractWhere (AnyWhere ds)	 = AnyWhere [Abstract (getRange ds) ds]+	mkAbstractWhere (SomeWhere m ds) = SomeWhere m [Abstract (getRange ds) ds]++	-- Make a declaration private+	mkPrivate d =+	    case d of+		Axiom r f _ a x e		    -> Axiom r f PrivateAccess a x e+		NiceField r f _ a x e		    -> NiceField r f PrivateAccess a x e+		PrimitiveFunction r f _ a x e	    -> PrimitiveFunction r f PrivateAccess a x e+		NiceDef r cs ts ds		    -> NiceDef r cs (map mkPrivate ts)+								    (map mkPrivateDef ds)+		NiceModule r _ a x tel ds	    -> NiceModule r PrivateAccess a x tel ds+		NiceModuleMacro r _ a x tel e op is -> NiceModuleMacro r PrivateAccess a x tel e op is+		NicePragma _ _			    -> d+		NiceOpen _ _ _			    -> d+		NiceImport _ _ _ _ _		    -> d++	mkPrivateDef d =+	    case d of+		FunDef r ds f _ a x cs      -> FunDef r ds f PrivateAccess a x+						  (map mkPrivateClause cs)+		DataDef r ind f _ a x ps cs -> DataDef r ind f PrivateAccess a x ps (map mkPrivate cs)+		RecDef r f _ a x ps cs      -> RecDef r f PrivateAccess a x ps cs++	mkPrivateClause (Clause x lhs rhs wh with) =+	    Clause x lhs rhs (mkPrivateWhere wh) (map mkPrivateClause with)+	+	mkPrivateWhere  NoWhere		= NoWhere+	mkPrivateWhere (AnyWhere ds)	= AnyWhere [Private (getRange ds) ds]+	mkPrivateWhere (SomeWhere m ds) = SomeWhere m [Private (getRange ds) ds]++-- | 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+    | Map.null isect	= return $ Map.union m1 m2+    | otherwise		=+	throwError $ MultipleFixityDecls $ map decls (Map.keys isect)+    where+	isect	= Map.intersection m1 m2+	decls x = (x, map (Map.findWithDefault __IMPOSSIBLE__ x) [m1,m2])+				-- cpp doesn't know about primes++-- | Get the fixities from the current block. Doesn't go inside /any/ blocks.+--   The reason for this is that fixity declarations have to appear at the same+--   level (or possibly outside an abstract or mutual block) as its target+--   declaration.+fixities :: [Declaration] -> Nice (Map.Map Name Fixity)+fixities (d:ds) = case d of+  Infix f xs -> plusFixities (Map.fromList [ (x,f) | x <- xs ]) =<< fixities ds+  _          -> fixities ds+fixities [] = return $ Map.empty++notSoNiceDeclarations :: [NiceDeclaration] -> [Declaration]+notSoNiceDeclarations = concatMap notNice+  where+    notNice (Axiom _ _ _ _ x e)                   = [TypeSig x e]+    notNice (NiceField _ _ _ _ x e)               = [Field x e]+    notNice (PrimitiveFunction r _ _ _ x e)       = [Primitive r [TypeSig x e]]+    notNice (NiceDef _ ds _ _)                    = ds+    notNice (NiceModule r _ _ x tel ds)           = [Module r x tel ds]+    notNice (NiceModuleMacro r _ _ x tel e o dir) = [ModuleMacro r x tel e o dir]+    notNice (NiceOpen r x dir)                    = [Open r x dir]+    notNice (NiceImport r x as o dir)             = [Import r x as o dir]+    notNice (NicePragma _ p)                      = [Pragma p]+

+ src/full/Agda/Syntax/Concrete/Name.hs view

@@ -0,0 +1,167 @@+{-# LANGUAGE CPP, DeriveDataTypeable #-}++{-| Names in the concrete syntax are just strings (or lists of strings for+    qualified names).+-}+module Agda.Syntax.Concrete.Name where++import Data.Maybe+import Data.Generics (Typeable, Data)++import Agda.Syntax.Common+import Agda.Syntax.Position+import Agda.Utils.FileName+import Agda.Utils.TestHelpers++#include "../../undefined.h"+import Agda.Utils.Impossible++{-| A name is a non-empty list of alternating 'Id's and 'Hole's. A normal name+    is represented by a singleton list, and operators are represented by a list+    with 'Hole's where the arguments should go. For instance: @[Hole,Id "+",Hole]@+    is infix addition.++    Equality and ordering on @Name@s are defined to ignore range so same names+    in different locations are equal.+-}+data Name = Name !Range [NamePart]+	  | NoName !Range NameId+    deriving (Typeable, Data)++data NamePart = Hole | Id String+    deriving (Typeable, Data)++-- | @noName_ = 'noName' 'noRange'@+noName_ :: Name+noName_ = noName noRange++-- | @noName r = 'Name' r ['Hole']@+noName :: Range -> Name+noName r = NoName r (NameId 0 0)++isNoName :: Name -> Bool+isNoName (NoName _ _)    = True+isNoName (Name _ [Hole]) = True   -- TODO: Track down where these come from+isNoName _               = False++-- | Is the name an operator?++isOperator :: Name -> Bool+isOperator (NoName {}) = False+isOperator (Name _ ps) = length ps > 1++nameParts :: Name -> [NamePart]+nameParts (Name _ ps)  = ps+nameParts (NoName _ _) = [Hole]++-- | @qualify A.B x == A.B.x@+qualify :: QName -> Name -> QName+qualify (QName m) x	= Qual m (QName x)+qualify (Qual m m') x	= Qual m $ qualify m' x++-- | @unqualify A.B.x == x@+--+-- The range is preserved.+unqualify :: QName -> Name+unqualify q = unqualify' q `withRangeOf` q+  where+  unqualify' (QName x)  = x+  unqualify' (Qual _ x) = unqualify' x++-- | @qnameParts A.B.x = [A, B, x]@+qnameParts :: QName -> [Name]+qnameParts (Qual x q) = x : qnameParts q+qnameParts (QName x)  = [x]++-- Define equality on @Name@ to ignore range so same names in different+--     locations are equal.+--+--   Is there a reason not to do this? -Jeff+--+--   No. But there are tons of reasons to do it. For instance, when using+--   names as keys in maps you really don't want to have to get the range+--   right to be able to do a lookup. -Ulf++instance Eq Name where+    Name _ xs  == Name _ ys  = xs == ys+    NoName _ i == NoName _ j = i == j+    _	       == _	     = False++instance Ord Name where+    compare (Name _ xs)  (Name _ ys)  = compare xs ys+    compare (NoName _ i) (NoName _ j) = compare i j+    compare (NoName {})  (Name {})    = LT+    compare (Name {})    (NoName {})  = GT++instance Eq NamePart where+  Hole  == Hole  = True+  Id s1 == Id s2 = s1 == s2+  _     == _     = False++instance Ord NamePart where+  compare Hole    Hole    = EQ+  compare Hole    (Id {}) = LT+  compare (Id {}) Hole    = GT+  compare (Id s1) (Id s2) = compare s1 s2++-- | @QName@ is a list of namespaces and the name of the constant.+--   For the moment assumes namespaces are just @Name@s and not+--     explicitly applied modules.+--   Also assumes namespaces are generative by just using derived+--     equality. We will have to define an equality instance to+--     non-generative namespaces (as well as having some sort of+--     lookup table for namespace names).+data QName = Qual  Name QName+           | QName Name+  deriving (Typeable, Data, Eq, Ord)++isHole :: NamePart -> Bool+isHole Hole = True+isHole _    = False++isPrefix, isPostfix, isInfix, isNonfix :: Name -> Bool+isPrefix  x = not (isHole (head xs)) &&      isHole (last xs)  where xs = nameParts x+isPostfix x =      isHole (head xs)  && not (isHole (last xs)) where xs = nameParts x+isInfix   x =      isHole (head xs)  &&      isHole (last xs)  where xs = nameParts x+isNonfix  x = not (isHole (head xs)) && not (isHole (last xs)) where xs = nameParts x++type Suffix = String++-- | Turns a module name into a file name with the given suffix.++moduleNameToFileName :: QName -> Suffix -> FilePath+moduleNameToFileName (QName  x) ext = show x ++ ext+moduleNameToFileName (Qual m x) ext = show m ++ [slash] ++ moduleNameToFileName x ext++instance Show Name where+    show (Name _ xs)  = concatMap show xs+    show (NoName _ _) = "_"++instance Show NamePart where+    show Hole   = "_"+    show (Id s) = s++instance Show QName where+    show (Qual m x) = show m ++ "." ++ show x+    show (QName x)  = show x++instance HasRange Name where+    getRange (Name r ps)  = r+    getRange (NoName r _) = r++instance HasRange QName where+    getRange (QName  x) = getRange x+    getRange (Qual n x)	= fuseRange n x++instance SetRange Name where+  setRange r (Name _ ps)  = Name r ps+  setRange r (NoName _ i) = NoName r i++instance KillRange QName where+  killRange (QName x) = QName $ killRange x+  killRange (Qual n x) = killRange n `Qual` killRange x++instance KillRange Name where+  killRange (Name r ps)  = Name (killRange r) ps+  killRange (NoName r i) = NoName (killRange r) i+

+ src/full/Agda/Syntax/Concrete/Operators.hs view

@@ -0,0 +1,336 @@+{-# LANGUAGE CPP #-}++{-| The parser doesn't know about operators and parses everything as normal+    function application. This module contains the functions that parses the+    operators properly. For a stand-alone implementation of this see+    @src\/prototyping\/mixfix@.++    It also contains the function that puts parenthesis back given the+    precedence of the context.+-}+module Agda.Syntax.Concrete.Operators+    ( parseApplication+    , parseLHS+    , paren+    , mparen+    ) where++import Control.Applicative+import Control.Monad.Trans+import Data.Typeable+import Data.Traversable (traverse)+import qualified Data.Map as Map+import qualified Data.Set as Set+import Data.Set (Set)+import Data.List+import Data.Function++import Agda.Syntax.Concrete.Pretty ()+import Agda.Syntax.Common+import Agda.Syntax.Concrete+import Agda.Syntax.Concrete.Operators.Parser+import qualified Agda.Syntax.Abstract.Name as A+import Agda.Syntax.Position+import Agda.Syntax.Fixity+import Agda.Syntax.Scope.Base+import Agda.Syntax.Scope.Monad++import Agda.TypeChecking.Monad.Base (typeError, TypeError(..))+import Agda.TypeChecking.Monad.State (getScope)++import Agda.Utils.ReadP+import Agda.Utils.Monad+import Agda.Utils.Tuple++#include "../../undefined.h"+import Agda.Utils.Impossible++---------------------------------------------------------------------------+-- * Building the parser+---------------------------------------------------------------------------++partsInScope :: ScopeM (Set Name)+partsInScope = do+    xs <- uncurry (++) . (id -*- map fst) <$> localNames+    return $ Set.fromList $ concatMap parts xs+    where+	parts (NoName _ _)   = []+	parts x@(Name _ [_]) = [x]+	parts x@(Name _ xs)  = x : [ Name noRange [i] | i@(Id {}) <- xs ]++-- | Compute all unqualified defined names in scope and their fixities.+getDefinedNames :: [KindOfName] -> ScopeM [(Name, Fixity)]+getDefinedNames kinds = do+  names <- allNamesInScope . mergeScopes . scopeStack <$> getScope+  return [ (x, A.nameFixity $ A.qnameName $ anameName d)+	 | (QName x, ds) <- Map.assocs names+	 , d		 <- take 1 ds+	 , anameKind d `elem` kinds+	 ]++-- | Compute all names (first component) and operators (second component) in+--   scope.+localNames :: ScopeM ([Name], [(Name, Fixity)])+localNames = do+  defs   <- getDefinedNames [DefName, ConName]+  locals <- scopeLocals <$> getScope+  return $ split $ nubBy ((==) `on` fst) $ map localOp locals ++ defs+  where+    localOp (x, y) = (x, A.nameFixity y)+    split ops = ([ x | Left x <- zs], [ y | Right y <- zs ])+	where+	    zs = concatMap opOrNot ops++    opOrNot (x@(Name _ [_]), fx) = [Left x]+    opOrNot (x, fx)	         = [Left x, Right (x, fx)]++data UseBoundNames = UseBoundNames | DontUseBoundNames++{-| Builds parser for operator applications from all the operators and function+    symbols in scope. When parsing a pattern we 'DontUseBoundNames' since a+    pattern binds new variables, but when parsing an expression we+    'UseBoundNames' and refute application of things that aren't in scope. The+    reason for this is to disambiguate things like @x + y@. This could mean+    both @_+_@ applied to @x@ and @y@, and @x@ applied to @+@ and @y@, but if there+    is no @+@ in scope it could only be the first.++    To avoid problems with operators of the same precedence but different+    associativity we decide (completely arbitrary) to fix the precedences of+    operators with the same given precedence in the following order (from+    loosest to hardest):++    - non-associative++    - left associative++    - right associative++    - prefix++    - postfix++    This has the effect that if you mix operators with the same precedence but+    different associativity the parser won't complain. One could argue that+    this is a Bad Thing, but since it's not trivial to implement the check it+    will stay this way until people start complaining about it.++    TODO: Clean up (too many fst and snd)+-}+buildParser :: IsExpr e => Range -> UseBoundNames -> ScopeM (ReadP e e)+buildParser r use = do+    (names, ops) <- localNames+    cons	 <- getDefinedNames [ConName]+    let conparts   = Set.fromList $ concatMap (parts . fst) cons+	connames   = Set.fromList $ map fst cons+	(non, fix) = partition nonfix ops+	set	   = Set.fromList names+	isLocal    = case use of+	    UseBoundNames     -> \x -> Set.member x set+	    DontUseBoundNames -> \x -> Set.member x connames || not (Set.member x conparts)+    return $ recursive $ \p ->+	concatMap (mkP p) (order fix)+	++ [ appP p ]+	++ map (nonfixP . opP p . fst) non+	++ [ const $ atomP isLocal ]+    where+	parts (NoName _ _) = []+	parts (Name _ [_]) = []+	parts (Name _ xs)  = [ Name noRange [i] | i@(Id {}) <- xs ]++	level = fixityLevel . snd++	isinfixl (op, LeftAssoc _ _)  = isInfix op+	isinfixl _		      = False++	isinfixr (op, RightAssoc _ _) = isInfix op+	isinfixr _		      = False++	isinfix (op, NonAssoc _ _)    = isInfix op+	isinfix _		      = False++	on f g x y = f (g x) (g y)++	nonfix = isNonfix . fst+	order = groupBy ((==) `on` level) . sortBy (compare `on` level)++	mkP p0 ops = case concat [infx, inlfx, inrfx, prefx, postfx] of+	    []	    -> [id]+	    fs	    -> fs+	    where+		choice' = foldr1 (++++)+		f ++++ g = \p -> f p +++ g p+		inlfx	= fixP infixlP  isinfixl+		inrfx	= fixP infixrP  isinfixr+		infx	= fixP infixP   isinfix+		prefx	= fixP prefixP  (isPrefix . fst)+		postfx	= fixP postfixP (isPostfix . fst)++		fixP f g =+		    case filter g ops of+			[]  -> []+			ops -> [ f $ choice $ map (opP p0 . fst) ops ]++---------------------------------------------------------------------------+-- * Expression instances+---------------------------------------------------------------------------++instance IsExpr Expr where+    exprView e = case e of+	Ident (QName x)	-> LocalV x+	App _ e1 e2	-> AppV e1 e2+	OpApp r d es	-> OpAppV d es+	HiddenArg _ e	-> HiddenArgV e+	Paren _ e	-> ParenV e+	_		-> OtherV e+    unExprView e = case e of+	LocalV x      -> Ident (QName x)+	AppV e1 e2    -> App (fuseRange e1 e2) e1 e2+	OpAppV d es   -> OpApp (fuseRange d es) d es+	HiddenArgV e  -> HiddenArg (getRange e) e+	ParenV e      -> Paren (getRange e) e+	OtherV e      -> e++instance IsExpr Pattern where+    exprView e = case e of+	IdentP (QName x) -> LocalV x+	AppP e1 e2	 -> AppV e1 e2+	OpAppP r d es	 -> OpAppV d es+	HiddenP _ e	 -> HiddenArgV e+	ParenP _ e	 -> ParenV e+	_		 -> OtherV e+    unExprView e = case e of+	LocalV x	 -> IdentP (QName x)+	AppV e1 e2	 -> AppP e1 e2+	OpAppV d es	 -> OpAppP (fuseRange d es) d es+	HiddenArgV e	 -> HiddenP (getRange e) e+	ParenV e	 -> ParenP (getRange e) e+	OtherV e	 -> e++---------------------------------------------------------------------------+-- * Parse functions+---------------------------------------------------------------------------++-- | Returns the list of possible parses.+parsePattern :: ReadP Pattern Pattern -> Pattern -> [Pattern]+parsePattern prs p = case p of+    AppP p (Arg h q) -> fullParen' <$> (AppP <$> parsePattern prs p <*> (Arg h <$> traverse (parsePattern prs) q))+    RawAppP _ ps     -> fullParen' <$> (parsePattern prs =<< parse prs ps)+    OpAppP r d ps    -> fullParen' . OpAppP r d <$> mapM (parsePattern prs) ps+    HiddenP _ _	     -> fail "bad hidden argument"+    AsP r x p	     -> AsP r x <$> parsePattern prs p+    DotP r e	     -> return $ DotP r e+    ParenP r p	     -> fullParen' <$> parsePattern prs p+    WildP _	     -> return p+    AbsurdP _	     -> return p+    LitP _	     -> return p+    IdentP _	     -> return p+++-- | Parses a left-hand side, and makes sure that it defined the expected name.+--   TODO: check the arities of constructors. There is a possible ambiguity with+--   postfix constructors:+--	Assume _ * is a constructor. Then 'true *' can be parsed as either the+--	intended _* applied to true, or as true applied to a variable *. If we+--	check arities this problem won't appear.+parseLHS :: Maybe Name -> Pattern -> ScopeM Pattern+parseLHS top p = do+    patP <- buildParser (getRange p) DontUseBoundNames+    cons <- getNames [ConName]+    case filter (validPattern top cons) $ parsePattern patP p of+	[p] -> return p+	[]  -> typeError $ NoParseForLHS p+	ps  -> typeError $ AmbiguousParseForLHS p $ map fullParen ps+    where+	getNames kinds = map fst <$> getDefinedNames kinds++	validPattern :: Maybe Name -> [Name] -> Pattern -> Bool+	validPattern (Just top) cons p = case appView p of+	    IdentP (QName x) : ps -> x == top && all (validPat cons) ps+	    _			  -> False+	validPattern Nothing cons p = validPat cons p++	validPat :: [Name] -> Pattern -> Bool+	validPat cons p = case appView p of+	    [_]			  -> True+	    IdentP (QName x) : ps -> elem x cons && all (validPat cons) ps+	    ps			  -> all (validPat cons) ps++	appView :: Pattern -> [Pattern]+	appView p = case p of+	    AppP p (Arg _ q) -> appView p ++ [namedThing q]+	    OpAppP _ op ps   -> IdentP (QName op) : ps+	    ParenP _ p	     -> appView p+	    RawAppP _ _	     -> __IMPOSSIBLE__+	    HiddenP _ _	     -> __IMPOSSIBLE__+	    _		     -> [p]++parseApplication :: [Expr] -> ScopeM Expr+parseApplication [e] = return e+parseApplication es = do++    -- Check that all parts of the application are in scope (else it won't+    -- parse and we can just as well give a nice error).+    inScope <- partsInScope+    case [ QName x | Ident (QName x) <- es, not (Set.member x inScope) ] of+	[]  -> return ()+	xs  -> typeError $ NotInScope xs++    -- Build the parser+    p <- buildParser (getRange es) UseBoundNames++    -- Parse+    case parse p es of+	[e] -> return e+	[]  -> typeError $ NoParseForApplication es+	es' -> typeError $ AmbiguousParseForApplication es $ map fullParen es'++-- Inserting parenthesis --------------------------------------------------++fullParen :: IsExpr e => e -> e+fullParen e = case exprView $ fullParen' e of+    ParenV e	-> e+    e'		-> unExprView e'++fullParen' :: IsExpr e => e -> e+fullParen' e = case exprView e of+    LocalV _	 -> e+    OtherV _	 -> e+    HiddenArgV _ -> e+    ParenV _	 -> e+    AppV e1 (Arg h e2) -> par $ unExprView $ AppV (fullParen' e1) (Arg h e2')+	where+	    e2' = case h of+		Hidden	  -> e2+		NotHidden -> fullParen' <$> e2+    OpAppV x es -> par $ unExprView $ OpAppV x $ map fullParen' es+    where+	par = unExprView . ParenV++paren :: Monad m => (Name -> m Fixity) -> Expr -> m (Precedence -> Expr)+paren _   e@(App _ _ _)	       = return $ \p -> mparen (appBrackets p) e+paren f	  e@(OpApp _ op _)     = do fx <- f op; return $ \p -> mparen (opBrackets fx p) e+paren _   e@(Lam _ _ _)	       = return $ \p -> mparen (lamBrackets p) e+paren _   e@(AbsurdLam _ _)    = return $ \p -> mparen (lamBrackets p) e+paren _   e@(Fun _ _ _)	       = return $ \p -> mparen (lamBrackets p) e+paren _   e@(Pi _ _)	       = return $ \p -> mparen (lamBrackets p) e+paren _   e@(Let _ _ _)	       = return $ \p -> mparen (lamBrackets p) e+paren _	  e@(Rec _ _)	       = return $ \p -> mparen (appBrackets p) e+paren _   e@(WithApp _ _ _)    = return $ \p -> mparen (withAppBrackets p) e+paren _	  e@(Ident _)	       = return $ \p -> e+paren _	  e@(Lit _)	       = return $ \p -> e+paren _	  e@(QuestionMark _ _) = return $ \p -> e+paren _	  e@(Underscore _ _)   = return $ \p -> e+paren _	  e@(Set _)	       = return $ \p -> e+paren _	  e@(SetN _ _)	       = return $ \p -> e+paren _	  e@(Prop _)	       = return $ \p -> e+paren _	  e@(Paren _ _)	       = return $ \p -> e+paren _	  e@(As _ _ _)	       = return $ \p -> e+paren _	  e@(Dot _ _)	       = return $ \p -> e+paren _	  e@(Absurd _)	       = return $ \p -> e+paren _	  e@(RawApp _ _)       = __IMPOSSIBLE__+paren _	  e@(HiddenArg _ _)    = __IMPOSSIBLE__++mparen :: Bool -> Expr -> Expr+mparen True  e = Paren (getRange e) e+mparen False e = e+

+ src/full/Agda/Syntax/Concrete/Operators/Parser.hs view

@@ -0,0 +1,139 @@+{-# LANGUAGE CPP #-}++module Agda.Syntax.Concrete.Operators.Parser where++import Agda.Syntax.Position+import Agda.Syntax.Common+import Agda.Syntax.Fixity+import Agda.Syntax.Concrete.Name+import Agda.Utils.ReadP+import Agda.Utils.Monad++#include "../../../undefined.h"+import Agda.Utils.Impossible++data ExprView e+    = LocalV Name+    | OtherV e+    | AppV e (NamedArg e)+    | OpAppV Name [e]+    | HiddenArgV (Named String e)+    | ParenV e+    deriving (Show)++class HasRange e => IsExpr e where+    exprView   :: e -> ExprView e+    unExprView :: ExprView e -> e++---------------------------------------------------------------------------+-- * 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+partP :: IsExpr e => String -> ReadP e (Range, NamePart)+partP s = do+    tok <- get+    case isLocal s tok of+      Just p  -> return p+      Nothing -> pfail+    where+	isLocal x e = case exprView e of+	    LocalV (Name r [Id y]) | x == y -> Just (r, Id y)+	    _			            -> Nothing++binop :: IsExpr e => ReadP e e -> ReadP e (e -> e -> e)+binop opP = do+    OpAppV (Name r ps) es <- exprView <$> opP+    return $ \x y -> unExprView $+      OpAppV (Name r ([Hole] ++ ps ++ [Hole])) ([x] ++ es ++ [y])++preop :: IsExpr e => ReadP e e -> ReadP e (e -> e)+preop opP = do+    OpAppV (Name r ps) es <- exprView <$> opP+    return $ \x -> unExprView $+      OpAppV (Name r (ps ++ [Hole])) (es ++ [x])++postop :: IsExpr e => ReadP e e -> ReadP e (e -> e)+postop opP = do+    OpAppV (Name r ps) es <- exprView <$> opP+    return $ \x -> unExprView $+      OpAppV (Name r ([Hole] ++ ps)) ([x] ++ es)++opP :: IsExpr e => ReadP e e -> Name -> ReadP e e+opP p (NoName _ _) = pfail+opP p (Name _ xs)  = do+    (r, ps, es) <- mix [ x | Id x <- xs ]+    return $ unExprView $ OpAppV (Name r ps) es+    where+	mix []	   = __IMPOSSIBLE__+	mix [x]	   = do (r, part) <- partP x; return (r, [part], [])+	mix (x:xs) = do+	    (r1, part)    <- partP x+	    e             <- p+	    (r2 , ps, es) <- mix xs+	    return (fuseRanges r1 r2, part : Hole : ps, e : es)++prefixP :: IsExpr e => ReadP e e -> ReadP e e -> ReadP e e+prefixP op p = do+    fs <- many (preop op)+    e  <- p+    return $ foldr ( $ ) e fs++postfixP :: IsExpr e => ReadP e e -> ReadP e e -> ReadP e e+postfixP op p = do+    e <- p+    fs <- many (postop op)+    return $ foldl (flip ( $ )) e fs++infixP, infixrP, infixlP :: IsExpr e => ReadP e e -> ReadP e e -> ReadP e e+infixlP op p = chainl1 p (binop op)+infixrP op p = chainr1 p (binop op)+infixP  op p = do+    e <- p+    f <- restP+    return $ f e+    where+	restP = return id +++ do+	    f <- binop op +	    e <- p+	    return $ flip f e++nonfixP :: IsExpr e => ReadP e e -> ReadP e e -> ReadP e e+nonfixP op p = op +++ p++appP :: IsExpr e => ReadP e e -> ReadP e e -> ReadP e e+appP top p = do+    h  <- p+    es <- many (nothidden +++ hidden)+    return $ foldl app h es+    where++	app e arg = unExprView $ AppV e arg++	isHidden (HiddenArgV _) = True+	isHidden _	       = False++	nothidden = Arg NotHidden . unnamed <$> do+	    e <- p+	    case exprView e of+		HiddenArgV _ -> pfail+		_	     -> return e++	hidden = do+	    HiddenArgV e <- exprView <$> satisfy (isHidden . exprView)+	    return $ Arg Hidden e++atomP :: IsExpr e => (Name -> Bool) -> ReadP e e+atomP p = do+    e <- get+    case exprView e of+	LocalV x | not (p x) -> pfail+	_		     -> return e+

+ src/full/Agda/Syntax/Concrete/Pretty.hs view

@@ -0,0 +1,321 @@+{-# LANGUAGE CPP, FlexibleInstances #-}+{-# OPTIONS -fno-warn-orphans #-}++{-| Pretty printer for the concrete syntax.+-}+module Agda.Syntax.Concrete.Pretty where++import Data.Char++import Agda.Syntax.Common+import Agda.Syntax.Concrete+import Agda.Syntax.Fixity+import Agda.Syntax.Literal++import Agda.Utils.Pretty++#include "../../undefined.h"+import Agda.Utils.Impossible++instance Show Expr	      where show = show . pretty+instance Show Declaration     where show = show . pretty+instance Show Pattern	      where show = show . pretty+instance Show TypedBindings   where show = show . pretty+instance Show LamBinding      where show = show . pretty+instance Show ImportDirective where show = show . pretty+instance Show Pragma	      where show = show . pretty+instance Show RHS	      where show = show . pretty++arrow  = text "\x2192"+lambda = text "\x03bb"++pHidden :: Pretty a => Hiding -> a -> Doc+pHidden Hidden	    = braces . pretty+pHidden NotHidden   = pretty++instance Pretty Name where+    pretty = text . show++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 "" ++ "'"++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 Induction where+  pretty Inductive = text "data"+  pretty CoInductive = text "codata"++instance Pretty Expr where+    pretty e =+	case e of+	    Ident x	     -> pretty x+	    Lit l	     -> pretty l+	    QuestionMark _ n -> text "?" <> maybe empty (text . show) n+	    Underscore _ n   -> text "_" <> maybe empty (text . show) n+	    App _ _ _	     ->+		case appView e of+		    AppView e1 args	->+			fsep $ pretty e1 : map pretty args+-- 			sep [ pretty e1+-- 			    , nest 2 $ fsep $ map pretty args+-- 			    ]+	    RawApp _ es   -> fsep $ map pretty es+	    OpApp _ (Name _ xs) es -> fsep $ prOp xs es+		where+		    prOp (Hole : xs) (e : es) = pretty e : prOp xs es+		    prOp (Hole : _)  []       = __IMPOSSIBLE__+		    prOp (Id x : xs) es       = text x : prOp xs es+		    prOp []	     es       = map pretty es+	    OpApp _ (NoName _ _) _ -> __IMPOSSIBLE__++	    WithApp _ e es -> fsep $+	      pretty e : map ((text "|" <+>) . pretty) es++	    HiddenArg _ e -> braces $ pretty e+	    Lam _ bs e ->+		sep [ lambda <+> fsep (map pretty bs) <+> arrow+		    , nest 2 $ pretty e+		    ]+            AbsurdLam _ NotHidden -> lambda <+> text "()"+            AbsurdLam _ Hidden -> lambda <+> text "{}"+	    Fun _ e1 e2 ->+		sep [ pretty e1 <+> arrow+		    , pretty e2+		    ]+	    Pi tel e ->+		sep [ fsep (map pretty tel ++ [arrow])+		    , pretty e+		    ]+	    Set _   -> text "Set"+	    Prop _  -> text "Prop"+	    SetN _ n	-> text "Set" <> text (show n)+	    Let _ ds e	->+		sep [ text "let" <+> vcat (map pretty ds)+		    , text "in" <+> pretty e+		    ]+	    Paren _ e -> parens $ pretty e+	    As _ x e  -> pretty x <> text "@" <> pretty e+	    Dot _ e   -> text "." <> pretty e+	    Absurd _  -> text "()"+	    Rec _ xs  -> sep+	      [ text "record"+	      , nest 2 $ braces $ fsep $ punctuate (text ";") $ map pr xs+	      ]+	      where+		pr (x, e) = sep [ pretty x <+> text "="+				, nest 2 $ pretty e+				]++instance Pretty BoundName where+  pretty = pretty . boundName++instance Pretty LamBinding where+    pretty (DomainFree h x) = pHidden h (pretty x)+    pretty (DomainFull b)   = pretty b++instance Pretty TypedBindings where+    pretty (TypedBindings _ h bs) =+	bracks $ fsep $ punctuate semi $ map pretty bs+	where+	    bracks = case h of+			Hidden	    -> braces+			NotHidden   -> parens++instance Pretty TypedBinding where+    pretty (TNoBind e) = pretty e+    pretty (TBind _ xs e) =+	sep [ fsep (punctuate comma $ map pretty xs)+	    , text ":" <+> pretty e+	    ]++instance Pretty RHS where+    pretty (RHS e)   = text "=" <+> pretty e+    pretty AbsurdRHS = empty++instance Pretty WhereClause where+  pretty  NoWhere = empty+  pretty (AnyWhere ds) = vcat [ text "where", nest 2 (vcat $ map pretty ds) ]+  pretty (SomeWhere m ds) =+    vcat [ hsep [ text "module", pretty m, text "where" ]+	 , nest 2 (vcat $ map pretty ds)+	 ]++instance Pretty LHS where+  pretty lhs = case lhs of+    LHS p ps es  -> pr (pretty p) ps es+    Ellipsis _ ps es -> pr (text "...") ps es+    where+      pr d ps es =+        sep [ d+            , nest 2 $ fsep $ map ((text "|" <+>) . pretty) ps+            , nest 2 $ pWith es+            ]+      pWith []	     = empty+      pWith (e : es) = fsep $ (text "with" <+> pretty e)+			    : map ((text "|" <+>) . pretty) es++instance Pretty [Declaration] where+  pretty = vcat . map pretty++instance Pretty Declaration where+    pretty d =+	case d of+	    TypeSig x e	-> sep [ pretty x <+> text ":"+			       , nest 2 $ pretty e+			       ]+            Field x e -> sep [ text "field", nest 2 $ pretty (TypeSig x e) ]+	    FunClause lhs rhs wh ->+		sep [ pretty lhs+		    , nest 2 $ pretty rhs+		    ] $$ nest 2 (pretty wh)+	    Data _ ind x tel e cs ->+		sep [ hsep  [ pretty ind+			    , pretty x+			    , fcat (map pretty tel)+			    ]+		    , nest 2 $ hsep+			    [ text ":"+			    , pretty e+			    , text "where"+			    ]+		    ] $$ nest 2 (vcat $ map pretty cs)+	    Record _ x tel e cs ->+		sep [ hsep  [ text "record"+			    , pretty x+			    , fcat (map pretty tel)+			    ]+		    , nest 2 $ hsep+			    [ text ":"+			    , pretty e+			    , text "where"+			    ]+		    ] $$ nest 2 (vcat $ map pretty cs)+	    Infix f xs	->+		pretty f <+> (fsep $ punctuate comma $ map pretty xs)+	    +	    Mutual _ ds	    -> namedBlock "mutual" ds+	    Abstract _ ds   -> namedBlock "abstract" ds+	    Private _ ds    -> namedBlock "private" ds+	    Postulate _ ds  -> namedBlock "postulate" ds+	    Primitive _ ds  -> namedBlock "primitive" ds+	    Module _ x tel ds ->+		hsep [ text "module"+		     , pretty x+		     , fcat (map pretty tel)+		     , text "where"+		     ] $$ nest 2 (vcat $ map pretty ds)+	    ModuleMacro _ x tel e open i ->+		sep [ pretty open <+> text "module" <+> pretty x <+> fcat (map pretty tel)+		    , nest 2 $ text "=" <+> pretty e <+> pretty i+		    ]+	    Open _ x i	-> hsep [ text "open", pretty x, pretty i ]+	    Import _ x rn open i   -> +		hsep [ pretty open, text "import", pretty x, as rn, pretty i ]+		where+		    as Nothing	= empty+		    as (Just x) = text "as" <+> pretty x+	    Pragma pr	-> sep [ text "{-#" <+> pretty pr, text "#-}" ]+	where+	    namedBlock s ds =+		sep [ text s+		    , nest 2 $ vcat $ map pretty ds+		    ]++instance Pretty OpenShortHand where+    pretty DoOpen = text "open"+    pretty DontOpen = empty++instance Pretty Pragma where+    pretty (OptionsPragma _ opts) = fsep $ map text $ "OPTIONS" : opts+    pretty (BuiltinPragma _ b x)  = hsep [ text "BUILTIN", text b, pretty x ]+    pretty (LinePragma _ n f)	  = hsep [ text "LINE", text (show n), text (show f) ]+    pretty (CompiledPragma _ x hs) =+      hsep [ text "COMPILED", pretty x, text hs ]+    pretty (CompiledTypePragma _ x hs) =+      hsep [ text "COMPILED_TYPE", pretty x, text hs ]+    pretty (CompiledDataPragma _ x hs hcs) =+      hsep $ [text "COMPILED_DATA", pretty x] ++ map text (hs : hcs)+    pretty (ImportPragma _ i) =+      hsep $ [text "IMPORT", text i]++instance Pretty Fixity where+    pretty (LeftAssoc _ n)  = text "infixl" <+> text (show n)+    pretty (RightAssoc _ n) = text "infixr" <+> text (show n)+    pretty (NonAssoc _ n)   = text "infix" <+> text (show n)++instance Pretty e => Pretty (Arg e) where+    pretty (Arg h e) = pHidden h e++instance Pretty e => Pretty (Named String e) where+    pretty (Named Nothing e) = pretty e+    pretty (Named (Just s) e) = sep [ text s <+> text "=", pretty e ]++instance Pretty [Pattern] where+    pretty = fsep . map pretty++instance Pretty Pattern where+    pretty p =+	case p of+	    IdentP x	       -> pretty x+	    AppP p1 p2	       -> sep [ pretty p1, nest 2 $ pretty p2 ]+	    RawAppP _ ps       -> fsep $ map pretty ps+	    OpAppP _ (Name _ xs) ps -> fsep $ prOp xs ps+		where+		    prOp (Hole : xs) (e : es) = pretty e : prOp xs es+		    prOp (Hole : _)  []	      = __IMPOSSIBLE__+		    prOp (Id x : xs) es       = text x : prOp xs es+		    prOp []	     []       = []+		    prOp []	     (_ : _)  = __IMPOSSIBLE__+	    OpAppP _ (NoName _ _) _ -> __IMPOSSIBLE__+	    HiddenP _ p	       -> braces $ pretty p+	    ParenP _ p	       -> parens $ pretty p+	    WildP _	       -> text "_"+	    AsP _ x p	       -> pretty x <> text "@" <> pretty p+	    DotP _ p	       -> text "." <> pretty p+	    AbsurdP _	       -> text "()"+	    LitP l	       -> pretty l++instance Pretty ImportDirective where+    pretty i =+	cat [ public (publicOpen i)+	    , pretty $ usingOrHiding i+	    , rename $ renaming i+	    ]+	where+	    public True  = text "public"+	    public False = empty++	    rename [] = empty+	    rename xs =	hsep [ text "renaming"+			     , parens $ fsep $ punctuate (text ";") $ map pr xs+			     ]++	    pr (x,y) = hsep [ pretty x, text "to", pretty y ]++instance Pretty UsingOrHiding where+    pretty (Hiding [])	= empty+    pretty (Hiding xs)	=+	text "hiding" <+> parens (fsep $ punctuate (text ";") $ map pretty xs)+    pretty (Using xs)	 =+	text "using" <+> parens (fsep $ punctuate (text ";") $ map pretty xs)++instance Pretty ImportedName where+    pretty (ImportedName x)	= pretty x+    pretty (ImportedModule x)	= text "module" <+> pretty x+

+ src/full/Agda/Syntax/Fixity.hs view

@@ -0,0 +1,100 @@+{-# LANGUAGE CPP, DeriveDataTypeable #-}++{-| Definitions for fixity and precedence levels.+-}+module Agda.Syntax.Fixity where++import Data.Generics (Typeable, Data)++import Agda.Syntax.Position+import Agda.Syntax.Common+import Agda.Syntax.Concrete.Name++-- | Fixity of operators.+data Fixity = LeftAssoc  Range Nat+	    | RightAssoc Range Nat+	    | NonAssoc   Range Nat+    deriving (Typeable, Data, Show)++instance Eq Fixity where+    LeftAssoc _ n   == LeftAssoc _ m	= n == m+    RightAssoc _ n  == RightAssoc _ m	= n == m+    NonAssoc _ n    == NonAssoc _ m	= n == m+    _		    == _		= False++fixityLevel :: Fixity -> Nat+fixityLevel (LeftAssoc	_ n) = n+fixityLevel (RightAssoc _ n) = n+fixityLevel (NonAssoc	_ n) = n++-- | The default fixity. Currently defined to be @'LeftAssoc' 20@.+defaultFixity :: Fixity+defaultFixity = NonAssoc noRange 20++-- | Precedence is associated with a context.+data Precedence = TopCtx | FunctionSpaceDomainCtx+		| LeftOperandCtx Fixity | RightOperandCtx Fixity+		| FunctionCtx | ArgumentCtx | InsideOperandCtx+                | WithFunCtx | WithArgCtx | DotPatternCtx+    deriving (Show,Typeable,Data)+++-- | The precedence corresponding to a possibly hidden argument.+hiddenArgumentCtx :: Hiding -> Precedence+hiddenArgumentCtx NotHidden = ArgumentCtx+hiddenArgumentCtx Hidden    = TopCtx++-- | Do we need to bracket an operator application of the given fixity+--   in a context with the given precedence.+opBrackets :: Fixity -> Precedence -> Bool+opBrackets (LeftAssoc _ n1)+           (LeftOperandCtx   (LeftAssoc   _ n2)) | n1 >= n2       = False+opBrackets (RightAssoc _ n1)+           (RightOperandCtx  (RightAssoc  _ n2)) | n1 >= n2       = False+opBrackets f1+           (LeftOperandCtx  f2) | fixityLevel f1 > fixityLevel f2 = False+opBrackets f1+           (RightOperandCtx f2) | fixityLevel f1 > fixityLevel f2 = False+opBrackets _ TopCtx = False+opBrackets _ FunctionSpaceDomainCtx = False+opBrackets _ InsideOperandCtx	    = False+opBrackets _ WithArgCtx             = False+opBrackets _ WithFunCtx             = False+opBrackets _ _			    = True++-- | Does a lambda-like thing (lambda, let or pi) need brackets in the given+--   context. A peculiar thing with lambdas is that they don't need brackets+--   in a right operand context. For instance: @m >>= \x -> m'@ is a valid+--   infix application.+lamBrackets :: Precedence -> Bool+lamBrackets TopCtx		= False+lamBrackets (RightOperandCtx _) = False+lamBrackets _			= True++-- | Does a function application need brackets?+appBrackets :: Precedence -> Bool+appBrackets ArgumentCtx   = True+appBrackets DotPatternCtx = True+appBrackets _             = False++-- | Does a with application need brackets?+withAppBrackets :: Precedence -> Bool+withAppBrackets TopCtx                 = False+withAppBrackets FunctionSpaceDomainCtx = False+withAppBrackets WithFunCtx             = False+withAppBrackets _                      = True++-- | Does a function space need brackets?+piBrackets :: Precedence -> Bool+piBrackets TopCtx   = False+piBrackets _	    = True++roundFixBrackets :: Precedence -> Bool+roundFixBrackets DotPatternCtx = True+roundFixBrackets _ = False++instance HasRange Fixity where+    getRange (LeftAssoc  r _)	= r+    getRange (RightAssoc r _)	= r+    getRange (NonAssoc   r _)	= r+

+ src/full/Agda/Syntax/Info.hs view

@@ -0,0 +1,159 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-| 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 posisiton of an expression or the concrete syntax that+    an internal expression originates from.+-}++module Agda.Syntax.Info where++import Data.Generics(Data,Typeable) +import Agda.Syntax.Common+import Agda.Syntax.Position+import Agda.Syntax.Concrete+import Agda.Syntax.Fixity+import Agda.Syntax.Scope.Base (ScopeInfo)++{--------------------------------------------------------------------------+    No information+ --------------------------------------------------------------------------}++data Info = Nope++{--------------------------------------------------------------------------+    Meta information+ --------------------------------------------------------------------------}++data MetaInfo =+	MetaInfo { metaRange	:: Range+		 , metaScope	:: ScopeInfo+		 , metaNumber	:: Maybe Nat+		 }+  deriving (Typeable, Data)++instance HasRange MetaInfo where+  getRange = metaRange++instance KillRange MetaInfo where+  killRange m = m { metaRange = killRange $ metaRange m }++{--------------------------------------------------------------------------+    General expression information+ --------------------------------------------------------------------------}++-- | For a general expression we can either remember just the source code+--   position or the entire concrete expression it came from.+data ExprInfo+	= ExprRange  Range+	| ExprSource Range (Precedence -> Expr)+	    -- ^ Even if we store the original expression we have to know+	    --	 whether to put parenthesis around it.+  deriving (Typeable, Data)++instance HasRange ExprInfo where+  getRange (ExprRange  r  ) = r+  getRange (ExprSource r _) = r++instance KillRange ExprInfo where+  killRange (ExprRange r)    = ExprRange (killRange r)+  killRange (ExprSource r f) = ExprSource (killRange r) f++{--------------------------------------------------------------------------+    Module information+ --------------------------------------------------------------------------}++data ModuleInfo =+	ModuleInfo { minfoAccess   :: Access+		   , minfoAbstract :: IsAbstract+		   , minfoRange    :: Range+		   }+  deriving (Typeable, Data)++instance HasRange ModuleInfo where+  getRange = minfoRange++instance KillRange ModuleInfo where+  killRange m = m { minfoRange = killRange $ minfoRange m }++---------------------------------------------------------------------------+-- Let info+---------------------------------------------------------------------------++newtype LetInfo = LetRange Range+  deriving (Typeable, Data)++instance HasRange LetInfo where+  getRange (LetRange r)   = r++instance KillRange LetInfo where+  killRange (LetRange r) = LetRange (killRange r)++{--------------------------------------------------------------------------+    Definition information (declarations that actually defines something)+ --------------------------------------------------------------------------}++data DefInfo =+	DefInfo	{ defFixity   :: Fixity+		, defAccess   :: Access+		, defAbstract :: IsAbstract+		, defInfo     :: DeclInfo+		}+  deriving (Typeable, Data)++mkDefInfo :: Name -> Fixity -> Access -> IsAbstract -> Range -> DefInfo+mkDefInfo x f a ab r = DefInfo f a ab (DeclInfo x r)++instance HasRange DefInfo where+  getRange = getRange . defInfo++instance KillRange DefInfo where+  killRange i = i { defInfo = killRange $ defInfo i }++{--------------------------------------------------------------------------+    General declaration information+ --------------------------------------------------------------------------}++data DeclInfo =+	DeclInfo { declName  :: Name+		 , declRange :: Range+		 }+  deriving (Eq, Typeable, Data)++instance HasRange DeclInfo where+  getRange = declRange++instance KillRange DeclInfo where+  killRange i = i { declRange = killRange $ declRange i }++{--------------------------------------------------------------------------+    Left hand side information+ --------------------------------------------------------------------------}++newtype LHSInfo = LHSRange Range+  deriving (Typeable, Data)++instance HasRange LHSInfo where+  getRange (LHSRange r) = r++instance KillRange LHSInfo where+  killRange (LHSRange r) = LHSRange (killRange r)++{--------------------------------------------------------------------------+    Pattern information+ --------------------------------------------------------------------------}++-- TODO: Is it safe to add Typeable/Data here? PatInfo contains a+-- function space.++data PatInfo = PatRange Range+	     | PatSource Range (Precedence -> Pattern)+  deriving (Typeable, Data)++instance HasRange PatInfo where+  getRange (PatRange r)    = r+  getRange (PatSource r _) = r++instance KillRange PatInfo where+  killRange (PatRange r)    = PatRange $ killRange r+  killRange (PatSource r f) = PatSource (killRange r) f+

+ src/full/Agda/Syntax/Internal.hs view

@@ -0,0 +1,294 @@+{-# LANGUAGE CPP, DeriveDataTypeable, GeneralizedNewtypeDeriving #-}++module Agda.Syntax.Internal+    ( module Agda.Syntax.Internal+    , module Agda.Syntax.Abstract.Name+    ) where++import Prelude hiding (foldr)+import Control.Applicative+import Data.Generics+import Data.Foldable+import Data.Traversable++import Agda.Syntax.Position+import Agda.Syntax.Common+import Agda.Syntax.Literal+import Agda.Syntax.Abstract.Name++import Agda.Utils.Monad+import Agda.Utils.Size+import Agda.Utils.Permutation++#include "../undefined.h"+import Agda.Utils.Impossible++-- | Raw values.+--+--   @Def@ is used for both defined and undefined constants.+--   Assume there is a type declaration and a definition for+--     every constant, even if the definition is an empty+--     list of clauses.+--+data Term = Var Nat Args+	  | Lam Hiding (Abs Term)   -- ^ terms are beta normal+	  | Lit Literal+	  | Def QName Args+	  | Con QName Args+	  | Pi (Arg Type) (Abs Type)+	  | Fun (Arg Type) Type+	  | Sort Sort+	  | MetaV MetaId Args+  deriving (Typeable, Data, Eq, Show)++data Type = El Sort Term+  deriving (Typeable, Data, Eq, Show)++data Sort = Type Nat+	  | Prop +	  | Lub Sort Sort+	  | Suc Sort+	  | MetaS MetaId +  deriving (Typeable, Data, Eq, Show)++-- | Something where a meta variable may block reduction.+data Blocked t = Blocked MetaId t+               | NotBlocked t+    deriving (Typeable, Data, Eq)++instance Show t => Show (Blocked t) where+  showsPrec p (Blocked m x) = showParen (p > 0) $+    showString "Blocked " . shows m . showString " " . showsPrec 10 x+  showsPrec p (NotBlocked x) = showsPrec p x++instance Functor Blocked where+  fmap f (Blocked m t) = Blocked m $ f t+  fmap f (NotBlocked t) = NotBlocked $ f t++instance Foldable Blocked where+  foldr f z (Blocked _ x) = f x z+  foldr f z (NotBlocked x) = f x z++instance Traversable Blocked where+  traverse f (Blocked m t)  = Blocked m <$> f t+  traverse f (NotBlocked t) = NotBlocked <$> f t++instance Applicative Blocked where+  pure = notBlocked+  Blocked x f  <*> e = Blocked x $ f (ignoreBlocking e)+  NotBlocked f <*> e = f <$> e++instance Sized Term where+  size v = case v of+    Var _ vs   -> 1 + Prelude.sum (map size vs)+    Def _ vs   -> 1 + Prelude.sum (map size vs)+    Con _ vs   -> 1 + Prelude.sum (map size vs)+    MetaV _ vs -> 1 + Prelude.sum (map size vs)+    Lam _ f    -> 1 + size f+    Lit _      -> 1+    Pi a b     -> 1 + size a + size b+    Fun a b    -> 1 + size a + size b+    Sort s     -> 1++instance Sized Type where+  size = size . unEl++instance KillRange Term where+  killRange v = case v of+    Var i vs   -> killRange1 (Var i) vs+    Def c vs   -> killRange2 Def c vs+    Con c vs   -> killRange2 Con c vs+    MetaV m vs -> killRange1 (MetaV m) vs+    Lam h f    -> killRange2 Lam h f+    Lit l      -> killRange1 Lit l+    Pi a b     -> killRange2 Pi a b+    Fun a b    -> killRange2 Fun a b+    Sort s     -> killRange1 Sort s++instance KillRange Type where+  killRange (El s v) = killRange2 El s v++instance KillRange Sort where+  killRange = id++instance KillRange Telescope where+  killRange EmptyTel = EmptyTel+  killRange (ExtendTel a tel) = killRange2 ExtendTel a tel++instance KillRange a => KillRange (Blocked a) where+  killRange = fmap killRange++instance KillRange a => KillRange (Abs a) where+  killRange = fmap killRange++-- | Type of argument lists.+--                          +type Args = [Arg Term]      +                            +-- | Sequence of types. An argument of the first type is bound in later types+--   and so on.+data Telescope = EmptyTel+	       | ExtendTel (Arg Type) (Abs Telescope)+  deriving (Typeable, Data, Show, Eq)++instance Sized Telescope where+  size  EmptyTel	 = 0+  size (ExtendTel _ tel) = 1 + size tel++-- | The body has (at least) one free variable.+data Abs a = Abs { absName :: String+		 , absBody :: a+		 }+  deriving (Typeable, Data, Eq)++instance Show a => Show (Abs a) where+  showsPrec p (Abs x a) = showParen (p > 0) $+    showString "Abs " . shows x . showString " " . showsPrec 10 a++instance Functor Abs where+  fmap f (Abs x t) = Abs x $ f t++instance Foldable Abs where+  foldr f z (Abs _ t) = f t z++instance Traversable Abs where +  traverse f (Abs x t) = Abs x <$> f t++instance Sized a => Sized (Abs a) where+  size = size . absBody++telFromList :: [Arg (String, Type)] -> Telescope+telFromList = foldr (\(Arg h (x, a)) -> ExtendTel (Arg h a) . Abs x) EmptyTel++telToList :: Telescope -> [Arg (String, Type)]+telToList EmptyTel = []+telToList (ExtendTel arg (Abs x tel)) = fmap ((,) x) arg : telToList tel++--+-- Definitions+--++-- | A clause is a list of patterns and the clause body should @Bind@ or+-- @NoBind@ in the order the variables occur in the patterns. The @NoBind@+-- constructor is an optimisation to avoid substituting for variables that+-- aren't used.+--+--  The telescope contains the types of the pattern variables and the+--  permutation is how to get from the order the variables occur in the+--  patterns to the order they occur in the telescope.  For the purpose of the+--  permutation dot patterns counts as variables.+--  TODO: change this!+data Clause = Clause+    { clauseRange     :: Range+    , clauseTel       :: Telescope+    , clausePerm      :: Permutation+    , clausePats      :: [Arg Pattern]+    , clauseBody      :: ClauseBody+    }+  deriving (Typeable, Data, Show)+data ClauseBody = Body Term +		| Bind (Abs ClauseBody)+		| NoBind ClauseBody+		| NoBody    -- for absurd clauses+  deriving (Typeable, Data, Show)++instance HasRange Clause where+  getRange = clauseRange++-- | Patterns are variables, constructors, or wildcards.+--   @QName@ is used in @ConP@ rather than @Name@ since+--     a constructor might come from a particular namespace.+--     This also meshes well with the fact that values (i.e.+--     the arguments we are matching with) use @QName@.+--+data Pattern = VarP String  -- name suggestion+             | DotP Term+	     | ConP QName [Arg Pattern]+	     | LitP Literal+  deriving (Typeable, Data, Show)++newtype MetaId = MetaId Nat+    deriving (Eq, Ord, Num, Real, Enum, Integral, Typeable, Data)++instance Show MetaId where+    show (MetaId n) = "_" ++ show n++-- | Doesn't do any reduction.+arity :: Type -> Nat+arity t =+    case unEl t of+	Pi  _ (Abs _ b) -> 1 + arity b+	Fun _	     b	-> 1 + arity b+	_		-> 0++-- | Suggest a name for the first argument of a function of the given type.+argName :: Type -> String+argName = argN . unEl+    where+	argN (Pi _ b)  = "." ++ absName b+	argN (Fun _ _) = ".x"+	argN _	  = __IMPOSSIBLE__+++---------------------------------------------------------------------------+-- * Views+---------------------------------------------------------------------------++data FunView+	= FunV (Arg Type) Term	-- ^ second arg is the entire type ('Pi' or 'Fun').+	| NoFunV Term++funView :: Term -> FunView+funView t@(Pi  arg _) = FunV arg t+funView t@(Fun arg _) = FunV arg t+funView t	      = NoFunV t++---------------------------------------------------------------------------+-- * Smart constructors+---------------------------------------------------------------------------++blockingMeta :: Blocked t -> Maybe MetaId+blockingMeta (Blocked m _) = Just m+blockingMeta (NotBlocked _) = Nothing++blocked :: MetaId -> a -> Blocked a+blocked x = Blocked x++notBlocked :: a -> Blocked a+notBlocked = NotBlocked++ignoreBlocking :: Blocked a -> a+ignoreBlocking (Blocked _ x) = x+ignoreBlocking (NotBlocked x) = x++set0   = sort (Type 0)+set n  = sort (Type n)+prop   = sort Prop+sort s = El (sSuc s) $ Sort s++teleLam :: Telescope -> Term -> Term+teleLam  EmptyTel	  t = t+teleLam (ExtendTel u tel) t = Lam (argHiding u) $ flip teleLam t <$> tel++getSort :: Type -> Sort+getSort (El s _) = s++unEl :: Type -> Term+unEl (El _ t) = t++-- | Get the next higher sort.+sSuc :: Sort -> Sort+sSuc Prop	 = Type 1+sSuc (Type n)	 = Type (n + 1)+sSuc (Lub s1 s2) = sSuc s1 `sLub` sSuc s2+sSuc s		 = Suc s++sLub :: Sort -> Sort -> Sort+sLub (Type 0) Prop     = Prop   -- (x:A) -> B prop if A type0, B prop [x:A]+sLub (Type n) Prop     = Type n+sLub Prop (Type n)     = Type n+sLub (Type n) (Type m) = Type $ max n m+sLub s1 s2+    | s1 == s2	= s1+    | otherwise	= Lub s1 s2+

+ src/full/Agda/Syntax/Internal/Generic.hs view

@@ -0,0 +1,61 @@+{-# LANGUAGE CPP #-}++module Agda.Syntax.Internal.Generic where++import Control.Applicative+import Data.Traversable+import Data.Monoid+import Data.Foldable+import Agda.Syntax.Common+import Agda.Syntax.Internal++#include "../../undefined.h"+import Agda.Utils.Impossible++class TermLike a where+  traverseTerm  :: (Term -> Term) -> a -> a+  foldTerm :: Monoid m => (Term -> m) -> a -> m++instance TermLike a => TermLike (Arg a) where+  traverseTerm f = fmap (traverseTerm f)+  foldTerm f = foldMap (foldTerm f)++instance TermLike a => TermLike [a] where+  traverseTerm f = fmap (traverseTerm f)+  foldTerm f = foldMap (foldTerm f)++instance (TermLike a, TermLike b) => TermLike (a, b) where+  traverseTerm f (x, y) = (traverseTerm f x, traverseTerm f y)+  foldTerm f (x, y) = foldTerm f x `mappend` foldTerm f y++instance TermLike a => TermLike (Abs a) where+  traverseTerm f = fmap (traverseTerm f)+  foldTerm f = foldMap (foldTerm f)++instance TermLike Term where+  traverseTerm f t = case t of+    Var i xs -> f $ Var i $ traverseTerm f xs+    Def c xs -> f $ Def c $ traverseTerm f xs+    Con c xs -> f $ Con c $ traverseTerm f xs+    Lam h b  -> f $ Lam h $ traverseTerm f b+    Pi a b   -> f $ uncurry Pi $ traverseTerm f (a, b)+    Fun a b  -> f $ uncurry Fun $ traverseTerm f (a, b)+    MetaV m xs -> f $ MetaV m $ traverseTerm f xs+    Lit _    -> f t+    Sort _   -> f t++  foldTerm f t = f t `mappend` case t of+    Var i xs   -> foldTerm f xs+    Def c xs   -> foldTerm f xs+    Con c xs   -> foldTerm f xs+    Lam h b    -> foldTerm f b+    Pi a b     -> foldTerm f (a, b)+    Fun a b    -> foldTerm f (a, b)+    MetaV m xs -> foldTerm f xs+    Lit _      -> mempty+    Sort _     -> mempty++instance TermLike Type where+  traverseTerm f (El s t) = El s $ traverseTerm f t+  foldTerm f (El s t) = foldTerm f t+

+ src/full/Agda/Syntax/Internal/Pattern.hs view

@@ -0,0 +1,39 @@++module Agda.Syntax.Internal.Pattern where++import Agda.Syntax.Common+import Agda.Syntax.Internal+import Agda.Utils.Tuple++data OneHolePatterns = OHPats [Arg Pattern] (Arg OneHolePattern) [Arg Pattern]+  deriving (Show)+data OneHolePattern  = Hole+		     | OHCon QName OneHolePatterns+  deriving (Show)++plugHole :: Pattern -> OneHolePatterns -> [Arg Pattern]+plugHole p (OHPats ps hole qs) = ps ++ [fmap (plug p) hole] ++ qs+  where+    plug p Hole	       = p+    plug p (OHCon c h) = ConP c $ plugHole p h++allHoles :: [Arg Pattern] -> [OneHolePatterns]+allHoles = map snd . allHolesWithContents++allHolesWithContents :: [Arg Pattern] -> [(Pattern, OneHolePatterns)]+allHolesWithContents []       = []+allHolesWithContents (p : ps) = map left phs ++ map (right p) (allHolesWithContents ps)+  where+    phs :: [(Pattern, Arg OneHolePattern)]+    phs = map (id -*- Arg (argHiding p)) (holes $ unArg p)++    holes :: Pattern -> [(Pattern, OneHolePattern)]+    holes p@(VarP _)  = [(p, Hole)]+    holes p@(DotP _)  = [(p, Hole)]+    holes (ConP c qs) = map (id -*- OHCon c) $ allHolesWithContents qs+    holes _           = []++    left  (p, ph)               = (p, OHPats [] ph ps)+    right q (p, OHPats ps h qs) = (p, OHPats (q : ps) h qs)++

+ src/full/Agda/Syntax/Literal.hs view

@@ -0,0 +1,38 @@+{-# LANGUAGE DeriveDataTypeable #-}+module Agda.Syntax.Literal where++import Data.Generics (Typeable, Data)++import Agda.Syntax.Position++data Literal = LitInt    Range Integer+	     | LitFloat  Range Double+	     | LitString Range String+	     | LitChar   Range Char+  deriving (Typeable, Data, Show)++instance Eq Literal where+  LitInt _ n    == LitInt _ m    = n == m+  LitFloat _ x  == LitFloat _ y  = x == y+  LitString _ s == LitString _ t = s == t+  LitChar _ c   == LitChar _ d   = c == d+  _             == _             = False++instance HasRange Literal where+  getRange (LitInt    r _)	= r+  getRange (LitFloat  r _)	= r+  getRange (LitString r _)	= r+  getRange (LitChar   r _)	= r++instance SetRange Literal where+  setRange r (LitInt    _ x)	= LitInt    r x+  setRange r (LitFloat  _ x)	= LitFloat  r x+  setRange r (LitString _ x)	= LitString r x+  setRange r (LitChar   _ x)	= LitChar   r x++instance KillRange Literal where+  killRange (LitInt    r x) = LitInt    (killRange r) x+  killRange (LitFloat  r x) = LitFloat  (killRange r) x+  killRange (LitString r x) = LitString (killRange r) x+  killRange (LitChar   r x) = LitChar   (killRange r) x+

+ src/full/Agda/Syntax/Parser.hs view

@@ -0,0 +1,109 @@++module Agda.Syntax.Parser+    ( -- * Types+      Parser+      -- * Parse functions+    , Agda.Syntax.Parser.parse+    , Agda.Syntax.Parser.parseLiterate+    , Agda.Syntax.Parser.parsePosString+    , parseFile'+      -- * Parsers+    , moduleParser+    , exprParser+    , tokensParser+      -- * Parse errors+    , ParseError(..)+    ) where++import Control.Exception+import Data.List+import System.Directory++import Agda.Syntax.Position+import Agda.Syntax.Parser.Monad as M hiding (Parser, parseFlags)+import qualified Agda.Syntax.Parser.Monad as M+import qualified Agda.Syntax.Parser.Parser as P+import Agda.Syntax.Parser.Lexer+import Agda.Syntax.Strict+import Agda.Syntax.Concrete+import Agda.Syntax.Parser.Tokens++------------------------------------------------------------------------+-- Wrapping parse results++wrap :: Strict a => ParseResult a -> a+wrap (ParseOk _ x)	= x+wrap (ParseFailed err)	= throwDyn err++wrapM:: (Strict a, Monad m) => m (ParseResult a) -> m a+wrapM m =+    do	r <- m+	case r of+	    ParseOk _ x	    -> return x+	    ParseFailed err -> throwDyn err++------------------------------------------------------------------------+-- Parse functions++-- | Wrapped Parser type.++data Parser a = Parser+  { parser     :: M.Parser a+  , parseFlags :: ParseFlags+  }++parse :: Strict a => Parser a -> String -> IO a+parse p = wrapM . return . M.parse (parseFlags p) [normal] (parser p)++parseFile :: Strict a => Parser a -> FilePath -> IO a+parseFile p = wrapM . M.parseFile (parseFlags p) [normal] (parser p)++parseLiterate :: Strict a => Parser a -> String -> IO a+parseLiterate p =+  wrapM . return . M.parse (parseFlags p) [literate, code] (parser p)++parseLiterateFile :: Strict a => Parser a -> FilePath -> IO a+parseLiterateFile p =+  wrapM . M.parseFile (parseFlags p) [literate, code] (parser p)++parsePosString :: Strict a => Parser a -> Position -> String -> IO a+parsePosString p pos =+  wrapM . return . M.parsePosString pos (parseFlags p) [normal] (parser p)++parseFile' :: Strict a => Parser a -> FilePath -> IO a+parseFile' p file =+  if "lagda" `isSuffixOf` file then+    Agda.Syntax.Parser.parseLiterateFile p file+   else+    Agda.Syntax.Parser.parseFile p file++------------------------------------------------------------------------+-- Specific parsers++-- | Parses a module.++moduleParser :: Parser ([Pragma], [Declaration])+moduleParser = Parser { parser = P.moduleParser+                      , parseFlags = withoutComments }++-- | Parses an expression.++exprParser :: Parser Expr+exprParser = Parser { parser = P.exprParser+                    , parseFlags = withoutComments }++-- | Gives the parsed token stream (including comments).++tokensParser :: Parser [Token]+tokensParser = Parser { parser = P.tokensParser+                      , parseFlags = withComments }++-- | Keep comments in the token stream generated by the lexer.++withComments :: ParseFlags+withComments = defaultParseFlags { parseKeepComments = True }++-- | Do not keep comments in the token stream generated by the lexer.++withoutComments :: ParseFlags+withoutComments = defaultParseFlags { parseKeepComments = False }

+ src/full/Agda/Syntax/Parser/Alex.hs view

@@ -0,0 +1,97 @@++{-| This module defines the things required by Alex and some other+    Alex related things.+-}+module Agda.Syntax.Parser.Alex+    ( -- * Alex requirements+      AlexInput(..)+    , alexInputPrevChar+    , alexGetChar+      -- * Lex actions+    , LexAction, LexPredicate+    , (.&&.), (.||.), not'+    , PreviousInput, CurrentInput, TokenLength+      -- * Monad operations+    , getLexInput, setLexInput+    )+    where++import Control.Monad.State++import Agda.Syntax.Position+import Agda.Syntax.Parser.Monad++import Agda.Utils.Monad++-- | This is what the lexer manipulates.+data AlexInput = AlexInput+		    { lexPos	    :: !Position    -- ^ current position+		    , lexInput	    :: String	    -- ^ current input+		    , lexPrevChar   :: !Char	    -- ^ previously read character+		    }++-- | Get the previously lexed character. Same as 'lexPrevChar'. Alex needs this+--   to be defined to handle \"patterns with a left-context\".+alexInputPrevChar :: AlexInput -> Char+alexInputPrevChar = lexPrevChar++-- | Lex a character. No surprises.+alexGetChar :: AlexInput -> Maybe (Char, AlexInput)+alexGetChar (AlexInput { lexInput = []  }) = Nothing+alexGetChar (AlexInput { lexInput = c:s, lexPos = p }) =+    Just (c, AlexInput+		 { lexInput	= s+		 , lexPos	= movePos p c+		 , lexPrevChar	= c+		 }+	 )++{--------------------------------------------------------------------------+    Monad operations+ --------------------------------------------------------------------------}++getLexInput :: Parser AlexInput+getLexInput = getInp <$> get+    where+	getInp s = AlexInput+		    { lexPos	    = parsePos s+		    , lexInput	    = parseInp s+		    , lexPrevChar   = parsePrevChar s+		    }++setLexInput :: AlexInput -> Parser ()+setLexInput inp = modify upd+    where+	upd s = s { parsePos	    = lexPos inp+		  , parseInp	    = lexInput inp+		  , parsePrevChar   = lexPrevChar inp+		  }++{--------------------------------------------------------------------------+    Lex actions+ --------------------------------------------------------------------------}++type PreviousInput  = AlexInput+type CurrentInput   = AlexInput+type TokenLength    = Int++-- | In the lexer, regular expressions are associated with lex actions who's+--   task it is to construct the tokens.+type LexAction r    = PreviousInput -> CurrentInput -> TokenLength -> Parser r++-- | Sometimes regular expressions aren't enough. Alex provides a way to do+--   arbitrary computations to see if the input matches. This is done with a+--   lex predicate.+type LexPredicate   = ([LexState], ParseFlags) -> PreviousInput -> TokenLength -> CurrentInput -> Bool++-- | Conjunction of 'LexPredicate's.+(.&&.) :: LexPredicate -> LexPredicate -> LexPredicate+p1 .&&. p2 = \x y z u -> p1 x y z u && p2 x y z u++-- | Disjunction of 'LexPredicate's.+(.||.) :: LexPredicate -> LexPredicate -> LexPredicate+p1 .||. p2 = \x y z u -> p1 x y z u || p2 x y z u++-- | Negation of 'LexPredicate's.+not' :: LexPredicate -> LexPredicate+not' p = \x y z u -> not (p x y z u)

+ src/full/Agda/Syntax/Parser/Comments.hs view

@@ -0,0 +1,80 @@+{-# LANGUAGE CPP #-}++{-| This module defines the lex action to lex nested comments. As is well-known+    this cannot be done by regular expressions (which, incidently, is probably+    the reason why C-comments don't nest).++    When scanning nested comments we simply keep track of the nesting level,+    counting up for /open comments/ and down for /close comments/.+-}+module Agda.Syntax.Parser.Comments+    where++import {-# SOURCE #-} Agda.Syntax.Parser.LexActions+import Agda.Syntax.Parser.Monad+import Agda.Syntax.Parser.Tokens+import Agda.Syntax.Parser.Alex+import Agda.Syntax.Parser.LookAhead+import Agda.Syntax.Position++import Agda.Utils.Monad++#include "../../undefined.h"+import Agda.Utils.Impossible++-- | Should comment tokens be output?++keepComments :: LexPredicate+keepComments (_, s) _ _ _ = parseKeepComments s++-- | Should comment tokens be output?++keepCommentsM :: Parser Bool+keepCommentsM = fmap parseKeepComments getParseFlags++-- | Manually lexing a block comment. Assumes an /open comment/ has been lexed.+--   In the end the comment is discarded and 'lexToken' is called to lex a real+--   token.+nestedComment :: LexAction Token+nestedComment inp inp' _ =+    do	setLexInput inp'+	runLookAhead err $ skipBlock "{-" "-}"+        keep <- keepCommentsM+        if keep then do+          inp'' <- getLexInput+          let p1 = lexPos inp; p2 = lexPos inp''+              i = Interval p1 p2+              s = case (p1, p2) of+                    (Pn { posPos = p1 }, Pn { posPos = p2 }) ->+                      take (p2 - p1) $ lexInput inp+          return $ TokComment (i, s)+         else+	  lexToken+    where+        err _ = liftP $ parseErrorAt (lexPos inp) "Unterminated '{-'"++-- | Lex a hole (@{! ... !}@). Holes can be nested.+--   Returns @'TokSymbol' 'SymQuestionMark'@.+hole :: LexAction Token+hole inp inp' _ =+    do	setLexInput inp'+	runLookAhead err $ skipBlock "{!" "!}"+	p <- lexPos <$> getLexInput+	return $ TokSymbol SymQuestionMark (Interval (lexPos inp) p)+    where+        err _ = liftP $ parseErrorAt (lexPos inp) "Unterminated '{!'"++-- | Skip a block of text enclosed by the given open and close strings. Assumes+--   the first open string has been consumed. Open-close pairs may be nested.+skipBlock :: String -> String -> LookAhead ()+skipBlock open close = scan 1+    where+	scan 0 = sync+	scan n = match [ open	==>  scan (n + 1)+		       , close	==>  scan (n - 1)+		       ] `other` scan n+	    where+		(==>) = (,)+		other = ($)++

+ src/full/Agda/Syntax/Parser/Layout.hs view

@@ -0,0 +1,149 @@+{-# LANGUAGE CPP #-}++{-| This module contains the lex actions that handle the layout rules. The way+    it works is that the 'Parser' monad keeps track of a stack of+    'LayoutContext's specifying the indentation of the layout blocks in scope.+    For instance, consider the following incomplete (Haskell) program:++    > f x = x'+    >   where+    >     x' = case x of { True -> False; False -> ...++    At the @...@ the layout context would be++    > [NoLayout, Layout 4, Layout 0]++    The closest layout block is the one containing the @case@ branches.  This+    block starts with an open brace (@\'{\'@) and so doesn't use layout.  The+    second closest block is the @where@ clause.  Here, there is no open brace+    so the block is started by the @x'@ token which has indentation 4. Finally+    there is a top-level layout block with indentation 0.+-}+module Agda.Syntax.Parser.Layout+    ( openBrace, closeBrace+    , withLayout+    , offsideRule+    , newLayoutContext+    , emptyLayout+    ) where++import Agda.Syntax.Parser.Lexer+import Agda.Syntax.Parser.Alex+import Agda.Syntax.Parser.Monad+import Agda.Syntax.Parser.Tokens+import Agda.Syntax.Parser.LexActions+import Agda.Syntax.Position+++-- | Executed upon lexing an open brace (@\'{\'@). Enters the 'NoLayout'+--   context.+openBrace :: LexAction Token+openBrace = token $ \_ ->+    do	pushContext NoLayout+	i <- getParseInterval+	return (TokSymbol SymOpenBrace i)+++{-| Executed upon lexing a close brace (@\'}\'@). Exits the current layout+    context. This might look a bit funny--the lexer will happily use a close+    brace to close a context open by a virtual brace. This is not a problem+    since the parser will make sure the braces are appropriately matched.+-}+closeBrace :: LexAction Token+closeBrace = token $ \_ ->+    do	popContext+	i <- getParseInterval+	return (TokSymbol SymCloseBrace i)+++{-| Executed for the first token in each line (see 'Agda.Syntax.Parser.Lexer.bol').+    Checks the position of the token relative to the current layout context.+    If the token is++    - /to the left/ :+	Exit the current context and a return virtual close brace (stay in the+	'Agda.Syntax.Parser.Lexer.bol' state).++    - /same column/ :+	Exit the 'Agda.Syntax.Parser.Lexer.bol' state and return a virtual semi+	colon.++    - /to the right/ :+	Exit the 'Agda.Syntax.Parser.Lexer.bol' state and continue lexing.++    If the current block doesn't use layout (i.e. it was started by+    'openBrace') all positions are considered to be /to the right/.+-}+offsideRule :: LexAction Token+offsideRule inp _ _ =+    do	offs <- getOffside p+	case offs of+	    LT	-> do	popContext+			return (TokSymbol SymCloseVirtualBrace (Interval p p))+	    EQ	-> do	popLexState+			return (TokSymbol SymVirtualSemi (Interval p p))+	    GT	-> do	popLexState+			lexToken+    where+	p = lexPos inp+++{-| This action is only executed from the 'Agda.Syntax.Parser.Lexer.empty_layout'+    state. It will exit this state, enter the 'Agda.Syntax.Parser.Lexer.bol' state,+    and return a virtual close brace (closing the empty layout block started+    by 'newLayoutContext').+-}+emptyLayout :: LexAction Token+emptyLayout inp _ _ =+    do	popLexState+	pushLexState bol+	return (TokSymbol SymCloseVirtualBrace (Interval p p))+    where+	p = lexPos inp+++{-| Start a new layout context. This is one of two ways to get out of the+    'Agda.Syntax.Parser.Lexer.layout' state (the other is 'openBrace'). There are+    two possibilities:++    - The current token is to the right of the current layout context (or we're+      in a no layout context).++    - The current token is to the left of or in the same column as the current+      context.++    In the first case everything is fine and we enter a new layout context at+    the column of the current token. In the second case we have an empty layout+    block so we enter the 'Agda.Syntax.Parser.Lexer.empty_layout' state. In both+    cases we return a virtual open brace without consuming any input.++    Entering a new state when we know we want to generate a virtual @{}@ may+    seem a bit roundabout. The thing is that we can only generate one token at+    a time, so the way to generate two tokens is to generate the first one and+    then enter a state in which the only thing you can do is generate the+    second one.+-}+newLayoutContext :: LexAction Token+newLayoutContext inp _ _ =+    do	let offset = posCol p+	ctx <- topContext+	case ctx of+	    Layout prevOffs | prevOffs >= offset ->+		do  pushLexState empty_layout+		    return (TokSymbol SymOpenVirtualBrace (Interval p p))+	    _ ->+		do  pushContext (Layout offset)+		    return (TokSymbol SymOpenVirtualBrace (Interval p p))+    where+	p = lexPos inp+++-- | Compute the relative position of a location to the+--   current layout context.+getOffside :: Position -> Parser Ordering+getOffside loc =+    do	ctx <- topContext+	return $ case ctx of+	    Layout n	-> compare (posCol loc) n+	    _		-> GT+

+ src/full/Agda/Syntax/Parser/Layout.hs-boot view

@@ -0,0 +1,8 @@+module Agda.Syntax.Parser.Layout where++import Agda.Syntax.Parser.Alex+import Agda.Syntax.Parser.Tokens++offsideRule      :: LexAction Token+newLayoutContext :: LexAction Token+emptyLayout      :: LexAction Token

+ src/full/Agda/Syntax/Parser/LexActions.hs view

@@ -0,0 +1,237 @@+{-# LANGUAGE CPP #-}++{-| This module contains the building blocks used to construct the lexer.+-}+module Agda.Syntax.Parser.LexActions+    ( -- * Main function+      lexToken+      -- * Lex actions+      -- ** General actions+    , token+    , withInterval, withInterval', withInterval_+    , withLayout+    , begin, end, endWith+    , begin_, end_+    , lexError+      -- ** Specialized actions+    , keyword, symbol, identifier, literal+      -- * Lex predicates+    , followedBy, eof, inState+    ) where++import Data.Char+import Control.Arrow++import Agda.Syntax.Parser.Lexer+import Agda.Syntax.Parser.Alex+import Agda.Syntax.Parser.Monad+import Agda.Syntax.Parser.Tokens+import Agda.Syntax.Position+import Agda.Syntax.Literal+import Agda.Syntax.Concrete.Name++import Agda.Utils.List+import Agda.Utils.Tuple+import Agda.Utils.Unicode++#include "../../undefined.h"+import Agda.Utils.Impossible++{--------------------------------------------------------------------------+    Scan functions+ --------------------------------------------------------------------------}++-- | Called at the end of a file. Returns 'TokEOF'.+returnEOF :: AlexInput -> Parser Token+returnEOF inp =+    do  setLastPos $ lexPos inp+	setPrevToken "<EOF>"+	return TokEOF++-- | Set the current input and lex a new token (calls 'lexToken').+skipTo :: AlexInput -> Parser Token+skipTo inp = setLexInput inp >> lexToken++{-| Scan the input to find the next token. Calls+'Agda.Syntax.Parser.Lexer.alexScanUser'. This is the main lexing function+where all the work happens. The function 'Agda.Syntax.Parser.Lexer.lexer',+used by the parser is the continuation version of this function.+-}+lexToken :: Parser Token+lexToken =+    do	inp <- getLexInput+	lss@(ls:_) <- getLexState+        flags <- getParseFlags+	case alexScanUser (lss, flags) (foolAlex inp) ls of+	    AlexEOF			-> returnEOF inp+	    AlexError _			-> parseError "Lexical error"+	    AlexSkip inp' len		-> skipTo (newInput inp inp' len)+	    AlexToken inp' len action	-> fmap postToken $ action inp (newInput inp inp' len) len++postToken :: Token -> Token+postToken (TokId (r, "\x03bb")) = TokSymbol SymLambda r+postToken (TokId (r, "\x2192")) = TokSymbol SymArrow r+postToken (TokId (r, "\x2200")) = TokKeyword KwForall r+postToken t = t++-- | Use the input string from the previous input (with the appropriate+--   number of characters dropped) instead of the fake input string that+--   was given to Alex (with unicode characters removed).+newInput :: PreviousInput -> CurrentInput -> TokenLength -> CurrentInput+newInput inp inp' len =+    case drop (len - 1) (lexInput inp) of+	c:s'	-> inp' { lexInput    = s'+			, lexPrevChar = c+			}+	[]	-> __IMPOSSIBLE__++-- | Alex can't handle unicode characters. To solve this we translate all+--   Unicode (non-ASCII) identifiers to @z@, all Unicode operator+--   characters to @+@, and all whitespace characters (except for @\t@+--   and @\n@) to ' '. It is important that there aren't any keywords+--   containing @z@, @+@ or @ @.+foolAlex :: AlexInput -> AlexInput+foolAlex inp = inp { lexInput = map fool $ lexInput inp }+    where+	fool c+            | isSpace c && not (c `elem` "\t\n") = ' '+	    | isUnicodeId c = if isAlpha c then 'z' else '+'+	    | otherwise     = c++{--------------------------------------------------------------------------+    Lex actions+ --------------------------------------------------------------------------}++-- | The most general way of parsing a token.+token :: (String -> Parser tok) -> LexAction tok+token action inp inp' len =+    do  setLexInput inp'+	setPrevToken t+	setLastPos $ lexPos inp+	action t+    where+	t = take len $ lexInput inp++-- | Parse a token from an 'Interval' and the lexed string.+withInterval :: ((Interval, String) -> tok) -> LexAction tok+withInterval f = token $ \s -> do+                   r <- getParseInterval+		   return $ f (r,s)++-- | Like 'withInterval', but applies a function to the string.+withInterval' :: (String -> a) -> ((Interval, a) -> tok) -> LexAction tok+withInterval' f t = withInterval (t . (id -*- f))++-- | Return a token without looking at the lexed string.+withInterval_ :: (Interval -> r) -> LexAction r+withInterval_ f = withInterval (f . fst)+++-- | Executed for layout keywords. Enters the 'Agda.Syntax.Parser.Lexer.layout'+--   state and performs the given action.+withLayout :: LexAction r -> LexAction r+withLayout a i1 i2 n =+    do	pushLexState layout+	a i1 i2 n+++-- | Enter a new state without consuming any input.+begin :: LexState -> LexAction Token+begin code _ _ _ =+    do	pushLexState code+	lexToken+++-- | Enter a new state throwing away the current lexeme.+begin_ :: LexState -> LexAction Token+begin_ code _ inp' _ =+    do	pushLexState code+	skipTo inp'+++-- | Exit the current state throwing away the current lexeme.+end_ :: LexAction Token+end_ _ inp' _ =+    do	popLexState+	skipTo inp'+++-- | Exit the current state and perform the given action.+endWith :: LexAction a -> LexAction a+endWith a inp inp' n =+    do	popLexState+	a inp inp' n+++-- | Exit the current state without consuming any input+end :: LexAction Token+end _ _ _ =+    do	popLexState+	lexToken++-- | Parse a 'Keyword' token, triggers layout for 'layoutKeywords'.+keyword :: Keyword -> LexAction Token+keyword k = layout $ withInterval_ (TokKeyword k)+    where+	layout | elem k layoutKeywords	= withLayout+	       | otherwise		= id+++-- | Parse a 'Symbol' token.+symbol :: Symbol -> LexAction Token+symbol s = withInterval_ (TokSymbol s)+++-- | Parse a literal.+literal :: Read a => (Range -> a -> Literal) -> LexAction Token+literal lit =+  withInterval' read (TokLiteral . uncurry lit . (getRange *** id))++-- | Parse an identifier. Identifiers can be qualified (see 'Name').+--   Example: @Foo.Bar.f@+identifier :: LexAction Token+identifier = qualified (either TokId TokQId)+++-- | Parse a possibly qualified name.+qualified :: (Either (Interval, String) [(Interval, String)] -> a) -> LexAction a+qualified tok =+    token $ \s ->+    do  i <- getParseInterval+	case mkName i $ wordsBy (=='.') s of+	    []	-> lexError "lex error on .."+	    [x]	-> return $ tok $ Left  x+	    xs	-> return $ tok $ Right xs+    where+	-- Compute the ranges for the substrings (separated by '.') of a name.+	mkName :: Interval -> [String] -> [(Interval, String)]+	mkName _ []	= []+	mkName i [x]	= [(i, x)]+	mkName i (x:xs) = (i0, x) : mkName i1 xs+	    where+		p0 = iStart i+		p1 = iEnd i+		p' = movePosByString p0 x+		i0 = Interval p0 p'+		i1 = Interval (movePos p' '.') p1+++{--------------------------------------------------------------------------+    Predicates+ --------------------------------------------------------------------------}++-- | True when the given character is the next character of the input string.+followedBy :: Char -> LexPredicate+followedBy c' _ _ _ inp =+    case lexInput inp of+	[]  -> False+	c:_ -> c == c'++-- | True if we are at the end of the file.+eof :: LexPredicate+eof _ _ _ inp = null $ lexInput inp++-- | True if the given state appears somewhere on the state stack+inState :: LexState -> LexPredicate+inState s (ls, _) _ _ _ = s `elem` ls+

+ src/full/Agda/Syntax/Parser/LexActions.hs-boot view

@@ -0,0 +1,30 @@+module Agda.Syntax.Parser.LexActions where++import Agda.Syntax.Literal+import Agda.Syntax.Parser.Alex+import Agda.Syntax.Parser.Monad+import Agda.Syntax.Parser.Tokens+import Agda.Syntax.Position++lexToken :: Parser Token++token :: (String -> Parser tok) -> LexAction tok++withInterval  :: ((Interval, String) -> tok) -> LexAction tok+withInterval' :: (String -> a) -> ((Interval, a) -> tok) -> LexAction tok+withLayout :: LexAction r -> LexAction r++begin   :: LexState -> LexAction Token+endWith :: LexAction a -> LexAction a+begin_  :: LexState -> LexAction Token+end_    :: LexAction Token++keyword    :: Keyword -> LexAction Token+symbol     :: Symbol -> LexAction Token+identifier :: LexAction Token+literal    :: Read a => (Range -> a -> Literal) -> LexAction Token++followedBy    :: Char -> LexPredicate+eof           :: LexPredicate+inState       :: LexState -> LexPredicate+

+ src/full/Agda/Syntax/Parser/Lexer.x view

@@ -0,0 +1,255 @@+{+{-| The lexer is generated by Alex (<http://www.haskell.org/alex>) and is an+    adaptation of GHC's lexer. The main lexing function 'lexer' is called by+    the "Agda.Syntax.Parser.Parser" to get the next token from the input.+-}+module Agda.Syntax.Parser.Lexer+    ( -- * The main function+      lexer+      -- * Lex states+    , normal, literate, code+    , layout, empty_layout, bol, imp_dir+      -- * Alex generated functions+    , AlexReturn(..), alexScanUser+    ) where++import Data.List++import Agda.Syntax.Parser.Alex+import Agda.Syntax.Parser.Comments+#ifndef __HADDOCK__+import {-# SOURCE #-} Agda.Syntax.Parser.Layout+import {-# SOURCE #-} Agda.Syntax.Parser.LexActions+#endif+import Agda.Syntax.Parser.Monad+import Agda.Syntax.Parser.StringLiterals+import Agda.Syntax.Parser.Tokens+import Agda.Syntax.Literal++}++$digit	     = 0-9+$hexdigit    = [ $digit a-f A-F ]+$alpha	     = [ A-Z a-z _ ]+$op	     = [ \- \! \# \$ \% \& \* \+ \/ \< \= \> \^ \| \~ \? \` \[ \] \, \: ]+$idstart     = [ $digit $alpha $op ]+$idchar	     = [ $idstart ' \\ ]+$endcomment  = ~ [ $idchar ]+$nonalpha    = $idchar # $alpha+$nonalphanum = $nonalpha # $digit++$white_nonl  = $white # \n++@number	     = $digit+ | "0x" $hexdigit++@exponent    = [eE] [\-\+]? @number+@float	     = @number \. @number @exponent? | @number @exponent++-- A name can't start with \x (to allow \x -> x).+-- Bug in alex: [ _ op ]+ doesn't seem to work!+@start = ($idstart # [_]) | \\ [ $nonalpha ]+@ident = @start $idchar* | [_] $idchar+++@namespace  = (@ident \.)*+@q_ident    = @namespace @ident++tokens :-++-- Lexing literate files+<tex>	 $white_nonl* \\ "begin{code}" $white_nonl* $ { end_ }+<tex>	 .* $		            { withInterval TokTeX }+<tex>	 .+		            { withInterval TokTeX }+<tex>    \n                         ;+<bol_,layout_>+  \\ "end{code}" / { inState code } { begin_ tex }+  -- \end{code} should only be recognized if the bottom of the stack is <code>++-- White space+<0,code,bol_,layout_,empty_layout_,imp_dir_,pragma_>+    $white_nonl+    ;++-- Pragmas+<0,code>    "{-#"		{ begin pragma }+<pragma_>   "{-#"		{ symbol SymOpenPragma }+<pragma_>   "#-}"		{ endWith $ symbol SymClosePragma }+<pragma_>   "OPTIONS"		{ keyword KwOPTIONS }+<pragma_>   "BUILTIN"		{ keyword KwBUILTIN }+<pragma_>   "COMPILED_DATA"	{ keyword KwCOMPILED_DATA }+<pragma_>   "COMPILED_TYPE"	{ keyword KwCOMPILED_TYPE }+<pragma_>   "COMPILED"	        { keyword KwCOMPILED }+<pragma_>   "IMPORT"	        { keyword KwIMPORT }+<pragma_>   "LINE"		{ keyword KwLINE }+<pragma_>   . # [ $white ] +    { withInterval $ TokString }++-- Comments+    -- We need to rule out pragmas here. Usually longest match would take+    -- precedence, but in some states pragmas aren't valid but comments are.+<0,code,bol_,layout_,empty_layout_,imp_dir_>+    "{-" / { not' (followedBy '#') }    { nestedComment }+++-- Dashes followed by a name symbol should be parsed as a name.+<0,code,bol_,layout_,empty_layout_,imp_dir_>+   "--" .* / { keepComments .&&. (followedBy '\n' .||. eof) }+             { withInterval TokComment }+<0,code,bol_,layout_,empty_layout_,imp_dir_>+  "--" .* / { followedBy '\n' .||. eof } ;++-- We need to check the offside rule for the first token on each line.  We+-- should not check the offside rule for the end of file token or an+-- '\end{code}'+<0,code,imp_dir_,pragma_> \n	{ begin bol_ }+<bol_>+    {+	\n		    ;+--	^ \\ "end{code}"    { end }+	() / { not' eof }	{ offsideRule }+    }++-- After a layout keyword there is either an open brace (no layout) or the+-- indentation of the first token decides the column of the layout block.+<layout_>+    {	\n	;+--	\{	{ endWith openBrace }+	()	{ endWith newLayoutContext }+    }++-- The only rule for the empty_layout state. Generates a close brace.+<empty_layout_> ()		{ emptyLayout }++-- Keywords+<0,code> let		{ keyword KwLet }+<0,code> in		{ keyword KwIn }+<0,code> where		{ keyword KwWhere }+<0,code> field		{ keyword KwField }+<0,code> with           { keyword KwWith }+<0,code> postulate	{ keyword KwPostulate }+<0,code> primitive	{ keyword KwPrimitive }+<0,code> open		{ keyword KwOpen }+<0,code> import		{ keyword KwImport }+<0,code> module		{ keyword KwModule }+<0,code> data		{ keyword KwData }+<0,code> codata		{ keyword KwCoData }+<0,code> record		{ keyword KwRecord }+<0,code> infix		{ keyword KwInfix }+<0,code> infixl		{ keyword KwInfixL }+<0,code> infixr		{ keyword KwInfixR }+<0,code> mutual		{ keyword KwMutual }+<0,code> abstract	{ keyword KwAbstract }+<0,code> private	{ keyword KwPrivate }+<0,code> Set		{ keyword KwSet }+<0,code> Prop		{ keyword KwProp }+<0,code> forall		{ keyword KwForall }+<0,code> Set @number	{ withInterval' (read . drop 3) TokSetN }++-- The parser is responsible to put the lexer in the imp_dir_ state when it+-- expects an import directive keyword. This means that if you run the+-- tokensParser you will never see these keywords.+<0,code> using	    { keyword KwUsing }+<0,code> hiding	    { keyword KwHiding }+<0,code> renaming   { keyword KwRenaming }+<imp_dir_> to	    { endWith $ keyword KwTo }+<0,code> public	    { keyword KwPublic }++-- Holes+<0,code> "{!"		{ hole }++-- Special symbols+<0,code> "..."		{ symbol SymEllipsis }+<0,code> "."		{ symbol SymDot }+<0,code> ";"		{ symbol SymSemi }+<0,code> ":"		{ symbol SymColon }+<0,code> "="		{ symbol SymEqual }+<0,code> "_"		{ symbol SymUnderscore }+<0,code> "?"		{ symbol SymQuestionMark }+<0,code> "|"		{ symbol SymBar }+<0,code> "("		{ symbol SymOpenParen }+<0,code> ")"		{ symbol SymCloseParen }+<0,code> "->"		{ symbol SymArrow }+<0,code> "\"		{ symbol SymLambda }+<0,code> "@"		{ symbol SymAs }+<0,code> "{"		{ symbol SymOpenBrace }	    -- you can't use braces for layout+<0,code> "}"		{ symbol SymCloseBrace }++-- Literals+<0,code> \'		{ litChar }+<0,code> \"		{ litString }+<0,code> @number	{ literal LitInt }+<0,code> @float		{ literal LitFloat }++-- Identifiers+<0,code> @q_ident	{ identifier }++{++-- | This is the initial state for parsing a literate file. Code blocks+--   should be enclosed in @\\begin{code}@ @\\end{code}@ pairs.+literate :: LexState+literate = tex+++-- | This is the initial state for parsing a regular, non-literate file.+normal :: LexState+normal = 0+++{-| The layout state. Entered when we see a layout keyword ('withLayout') and+    exited either when seeing an open brace ('openBrace') or at the next token+    ('newLayoutContext').++    Update: we don't use braces for layout anymore.+-}+layout :: LexState+layout = layout_+++{-| The state inside a pragma.+-}+pragma :: LexState+pragma = pragma_++{-| We enter this state from 'newLayoutContext' when the token following a+    layout keyword is to the left of (or at the same column as) the current+    layout context. Example:++    > data Empty : Set where+    > foo : Empty -> Nat++    Here the second line is not part of the @where@ clause since it is has the+    same indentation as the @data@ definition. What we have to do is insert an+    empty layout block @{}@ after the @where@. The only thing that can happen+    in this state is that 'emptyLayout' is executed, generating the closing+    brace. The open brace is generated when entering by 'newLayoutContext'.+-}+empty_layout :: LexState+empty_layout = empty_layout_+++-- | This state is entered at the beginning of each line. You can't lex+--   anything in this state, and to exit you have to check the layout rule.+--   Done with 'offsideRule'.+bol :: LexState+bol = bol_+++-- | This state can only be entered by the parser. In this state you can only+--   lex the keywords @using@, @hiding@, @renaming@ and @to@. Moreover they are+--   only keywords in this particular state. The lexer will never enter this+--   state by itself, that has to be done in the parser.+imp_dir :: LexState+imp_dir = imp_dir_+++-- | Return the next token. This is the function used by Happy in the parser.+--+--   @lexer k = 'lexToken' >>= k@+lexer :: (Token -> Parser a) -> Parser a+lexer k = lexToken >>= k++-- | Do not use this function; it sets the 'ParseFlags' to+-- 'undefined'.+alexScan :: AlexInput -> Int -> AlexReturn (LexAction Token)++-- | This is the main lexing function generated by Alex.+alexScanUser :: ([LexState], ParseFlags) -> AlexInput -> Int -> AlexReturn (LexAction Token)++}

+ src/full/Agda/Syntax/Parser/LookAhead.hs view

@@ -0,0 +1,136 @@+{-# LANGUAGE Rank2Types #-}+{-| When lexing by hands (for instance string literals) we need to do some+    looking ahead. The 'LookAhead' monad keeps track of the position we are+    currently looking at, and provides facilities to synchronise the look-ahead+    position with the actual position of the 'Parser' monad (see 'sync' and+    'rollback').+-}+module Agda.Syntax.Parser.LookAhead+    ( -- * The LookAhead monad+      LookAhead+    , runLookAhead+      -- * Operations+    , getInput, setInput, liftP+    , nextChar, eatNextChar+    , sync, rollback+    , match, match'+    )+    where++import Control.Monad.Reader+import Control.Monad.State++import Agda.Syntax.Parser.Alex+import Agda.Syntax.Parser.Monad++{--------------------------------------------------------------------------+    The look-ahead monad+ --------------------------------------------------------------------------}++{-| The LookAhead monad is basically a state monad keeping with an extra+    'AlexInput', wrapped around the 'Parser' monad.+-}+newtype LookAhead a =+    LookAhead { unLookAhead :: ReaderT ErrorFunction+				       (StateT AlexInput Parser) a+	      }++newtype ErrorFunction =+    ErrorFun { throwError :: forall a. String -> LookAhead a }++{--------------------------------------------------------------------------+    Monad instances+ --------------------------------------------------------------------------}++instance Monad LookAhead where+    return  = LookAhead . return+    m >>= k = LookAhead $ unLookAhead m >>= unLookAhead . k+    fail s  =+	do  err <- LookAhead ask+	    throwError err s++{--------------------------------------------------------------------------+    Operations+ --------------------------------------------------------------------------}++-- | Get the current look-ahead position.+getInput :: LookAhead AlexInput+getInput = LookAhead get+++-- | Set the look-ahead position.+setInput :: AlexInput -> LookAhead ()+setInput = LookAhead . put+++-- | Lift a computation in the 'Parser' monad to the 'LookAhead' monad.+liftP :: Parser a -> LookAhead a+liftP = LookAhead . lift . lift+++-- | Look at the next character. Fails if there are no more characters.+nextChar :: LookAhead Char+nextChar =+    do	inp <- getInput+	case alexGetChar inp of+	    Nothing	    -> fail "unexpected end of file"+	    Just (c,inp')   ->+		do  setInput inp'+		    return c+++-- | Consume all the characters up to the current look-ahead position.+sync :: LookAhead ()+sync =+    do	inp <- getInput+	liftP $ setLexInput inp+++-- | Undo look-ahead. Restores the input from the 'ParseState'.+rollback :: LookAhead ()+rollback =+    do	inp <- liftP getLexInput+	setInput inp+++-- | Consume the next character. Does 'nextChar' followed by 'sync'.+eatNextChar :: LookAhead Char+eatNextChar =+    do	c <- nextChar+	sync+	return c+++{-| Do a case on the current input string. If any of the given strings match we+    move past it and execute the corresponding action. If no string matches, we+    execute a default action, advancing the input one character. This function+    only affects the look-ahead position.+-}+match :: [(String, LookAhead a)] -> LookAhead a -> LookAhead a+match xs def =+    do	c <- nextChar+	match' c xs def++{-| Same as 'match' but takes the initial character from the first argument+    instead of reading it from the input.  Consequently, in the default case+    the input is not advanced.+-}+match' :: Char -> [(String, LookAhead a)] -> LookAhead a -> LookAhead a+match' c xs def =+    do	inp <- getInput+	match'' inp xs c+    where+	match'' inp bs c =+	    case bs' of+		[]	    -> setInput inp >> def+		[("",p)]    -> p+		_	    -> match'' inp bs' =<< nextChar+	    where+		bs' = [ (s, p) | (c':s, p) <- bs, c == c' ]++-- | Run a 'LookAhead' computation. The first argument is the error function.+runLookAhead :: (forall b. String -> LookAhead b) -> LookAhead a -> Parser a+runLookAhead err (LookAhead m) =+    do	inp <- getLexInput+	evalStateT (runReaderT m (ErrorFun err)) inp+

+ src/full/Agda/Syntax/Parser/Monad.hs view

@@ -0,0 +1,307 @@+{-# LANGUAGE MultiParamTypeClasses, DeriveDataTypeable #-}+module Agda.Syntax.Parser.Monad+    ( -- * The parser monad+      Parser+    , ParseResult(..)+    , ParseState(..)+    , ParseError(..)+    , LexState+    , LayoutContext(..)+    , ParseFlags (..)+      -- * Running the parser+    , initState+    , defaultParseFlags+    , parse+    , parsePosString+    , parseFile+      -- * Manipulating the state+    , setParsePos, setLastPos, getParseInterval+    , setPrevToken+    , getParseFlags+    , getLexState, pushLexState, popLexState+      -- ** Layout+    , topContext, popContext, pushContext+    , pushCurrentContext+      -- ** Errors+    , parseError, parseErrorAt+    , lexError+    )+    where++import Data.Char+import Data.Typeable++import Control.Monad.State+import Control.Monad.Error+import Control.Applicative++import qualified Agda.Utils.IO as UTF8++import Agda.Syntax.Position++import Agda.Utils.Monad++{--------------------------------------------------------------------------+    The parse monad+ --------------------------------------------------------------------------}++-- | The parse monad. Equivalent to @StateT 'ParseState' (Either 'ParseError')@+--   except for the definition of @fail@, which builds a suitable 'ParseError'+--   object.+newtype Parser a = P { unP :: ParseState -> ParseResult a }++-- | The parser state. Contains everything the parser and the lexer could ever+--   need.+data ParseState = PState+    { parsePos	    :: !Position	-- ^ position at current input location+    , parseLastPos  :: !Position	-- ^ position of last token+    , parseInp	    :: String		-- ^ the current input+    , parsePrevChar :: !Char		-- ^ the character before the input+    , parsePrevToken:: String		-- ^ the previous token+    , parseLayout   :: [LayoutContext]	-- ^ the stack of layout contexts+    , parseLexState :: [LexState]	-- ^ the state of the lexer+					--   (states can be nested so we need a stack)+    , parseFlags    :: ParseFlags	-- ^ currently there are no flags+    }+    deriving Show++{-| To do context sensitive lexing alex provides what is called /start codes/+    in the Alex documentation. It is really an integer representing the state+    of the lexer, so we call it @LexState@ instead.+-}+type LexState = Int++-- | We need to keep track of the context to do layout. The context+--   specifies the indentation (if any) of a layout block. See+--   "Agda.Syntax.Parser.Layout" for more informaton.+data LayoutContext  = NoLayout	    -- ^ no layout+		    | Layout Int    -- ^ layout at specified column+    deriving Show++-- | There aren't any parser flags at the moment.+data ParseFlags	= ParseFlags+  { parseKeepComments :: Bool+    -- ^ Should comment tokens be returned by the lexer?+  }+  deriving Show++-- | What you get if parsing fails.+data ParseError	= ParseError+		    { errPos	    :: Position	-- ^ where the error occured+		    , errInput	    :: String	-- ^ the remaining input+		    , errPrevToken  :: String	-- ^ the previous token+		    , errMsg	    :: String	-- ^ hopefully an explanation+						--   of what happened+		    }+    deriving (Typeable)++-- | The result of parsing something.+data ParseResult a  = ParseOk ParseState a+		    | ParseFailed ParseError++{--------------------------------------------------------------------------+    Instances+ --------------------------------------------------------------------------}++instance Monad Parser where+    return x	= P $ \s -> ParseOk s x+    P m >>= f	= P $ \s -> case m s of+				ParseFailed e	-> ParseFailed e+				ParseOk s' x	-> unP (f x) s'+    fail msg	= P $ \s -> ParseFailed $+				ParseError  { errPos	    = parseLastPos s+					    , errInput	    = parseInp s+					    , errPrevToken  = parsePrevToken s+					    , errMsg	    = msg+					    }++instance Functor Parser where+    fmap = liftM++instance Applicative Parser where+    pure = return+    (<*>) = ap++instance MonadError ParseError Parser where+    throwError e	= P $ \_ -> ParseFailed e+    P m `catchError` h	= P $ \s -> case m s of+					ParseFailed err	-> unP (h err) s+					m'		-> m'++instance MonadState ParseState Parser where+    get	    = P $ \s -> ParseOk s s+    put s   = P $ \_ -> ParseOk s ()++instance Show ParseError where+    show err =+	unlines+	    [ pos ++ ": " ++ errMsg err+	    --, replicate (length pos + 2) ' ' ++ "on '" ++ errPrevToken err ++ "'"+            , errPrevToken err ++ "<ERROR>\n" ++ take 30 (errInput err) ++ "..."+	    ]+	where+	    pos = show (errPos err)++-- 	    showInp ""  = "at end of file"+-- 	    showInp t   = "on input " ++ elide 5 t+-- +-- 	    elide 3 s+-- 		| length (take 4 s) < 4 = s+-- 		| otherwise		    = "..."+-- 	    elide n (c:s)		    = c : elide (n - 1) s+-- 	    elide _ ""		    = ""++instance HasRange ParseError where+    getRange err = posToRange (errPos err) (errPos err)++{--------------------------------------------------------------------------+    Running the parser+ --------------------------------------------------------------------------}++initStatePos :: Position -> ParseFlags -> String -> [LexState] -> ParseState+initStatePos pos flags inp st =+	PState  { parsePos	    = pos+		, parseLastPos	    = pos+		, parseInp	    = inp+		, parsePrevChar	    = '\n'+		, parsePrevToken    = ""+		, parseLexState	    = st+		, parseLayout	    = [NoLayout]+		, parseFlags	    = flags+		}++-- | Constructs the initial state of the parser. The string argument+--   is the input string, the file path is only there because it's part+--   of a position.+initState :: FilePath -> ParseFlags -> String -> [LexState] -> ParseState+initState file = initStatePos (startPos file)++-- | The default flags.+defaultParseFlags :: ParseFlags+defaultParseFlags = ParseFlags { parseKeepComments = False }++-- | The most general way of parsing a string. The "Agda.Syntax.Parser" will define+--   more specialised functions that supply the 'ParseFlags' and the+--   'LexState'.+parse :: ParseFlags -> [LexState] -> Parser a -> String -> ParseResult a+parse flags st p input = unP p (initState "" flags input st)++-- | The even more general way of parsing a string.+parsePosString :: Position -> ParseFlags -> [LexState] -> Parser a -> String ->+                  ParseResult a+parsePosString pos flags st p input = unP p (initStatePos pos flags input st)++-- | The most general way of parsing a file. The "Agda.Syntax.Parser" will define+--   more specialised functions that supply the 'ParseFlags' and the+--   'LexState'.+parseFile :: ParseFlags -> [LexState] -> Parser a -> FilePath -> IO (ParseResult a)+parseFile flags st p file =+    do	input <- liftIO $ UTF8.readTextFile file+	return $ unP p (initState file flags input st)++{--------------------------------------------------------------------------+    Manipulating the state+ --------------------------------------------------------------------------}++setParsePos :: Position -> Parser ()+setParsePos p = modify $ \s -> s { parsePos = p }++setLastPos :: Position -> Parser ()+setLastPos p = modify $ \s -> s { parseLastPos = p }++setPrevToken :: String -> Parser ()+setPrevToken t = modify $ \s -> s { parsePrevToken = t }++getLastPos :: Parser Position+getLastPos = get >>= return . parseLastPos++-- | The parse interval is between the last position and the current position.+getParseInterval :: Parser Interval+getParseInterval =+    do	s <- get+	return $ Interval (parseLastPos s) (parsePos s)++getLexState :: Parser [LexState]+getLexState = parseLexState <$> get++setLexState :: [LexState] -> Parser ()+setLexState ls =+    do	s <- get+	put $ s { parseLexState = ls }++pushLexState :: LexState -> Parser ()+pushLexState l = do s <- getLexState+		    setLexState (l:s)++popLexState :: Parser ()+popLexState = do _:ls <- getLexState+		 setLexState ls++getParseFlags :: Parser ParseFlags+getParseFlags = parseFlags <$> get+++-- | @parseError = fail@+parseError :: String -> Parser a+parseError = fail+++-- | Fake a parse error at the specified position. Used, for instance, when+--   lexing nested comments, which when failing will always fail at the end+--   of the file. A more informative position is the beginning of the failing+--   comment.+parseErrorAt :: Position -> String -> Parser a+parseErrorAt p msg =+    do	setLastPos p+	parseError msg+++-- | For lexical errors we want to report the current position as the site of+--   the error, whereas for parse errors the previous position is the one+--   we're interested in (since this will be the position of the token we just+--   lexed). This function does 'parseErrorAt' the current position.+lexError :: String -> Parser a+lexError msg =+    do	p <- parsePos <$> get+	parseErrorAt p msg++{--------------------------------------------------------------------------+    Layout+ --------------------------------------------------------------------------}++getContext :: Parser [LayoutContext]+getContext = parseLayout <$> get++setContext :: [LayoutContext] -> Parser ()+setContext ctx =+    do	s <- get+	put $ s { parseLayout = ctx }++-- | Return the current layout context.+topContext :: Parser LayoutContext+topContext =+    do	ctx <- getContext+	case ctx of+	    []  -> parseError "No layout context in scope"+	    l:_ -> return l++popContext :: Parser ()+popContext =+    do	ctx <- getContext+	case ctx of+	    []	    -> parseError "There is no layout block to close at this point."+	    _:ctx   -> setContext ctx++pushContext :: LayoutContext -> Parser ()+pushContext l =+    do	ctx <- getContext+	setContext (l : ctx)++-- | Should only be used at the beginning of a file. When we start parsing+--   we should be in layout mode. Instead of forcing zero indentation we use+--   the indentation of the first token.+pushCurrentContext :: Parser ()+pushCurrentContext =+    do	p <- getLastPos+	pushContext (Layout (posCol p))+

+ src/full/Agda/Syntax/Parser/Parser.y view

@@ -0,0 +1,974 @@+{+{-# OPTIONS -fno-warn-incomplete-patterns #-}+{-| The parser is generated by Happy (<http://www.haskell.org/happy>).+-}+module Agda.Syntax.Parser.Parser (+      moduleParser+    , exprParser+    , tokensParser+    ) where++import Control.Monad+import Control.Monad.State+import Data.Char  (isDigit)+import Data.List+import Data.Maybe+import qualified Data.Traversable as T++import Agda.Syntax.Position+import Agda.Syntax.Parser.Monad+import Agda.Syntax.Parser.Lexer+import Agda.Syntax.Parser.Tokens+import Agda.Syntax.Concrete+import Agda.Syntax.Concrete.Name+import Agda.Syntax.Concrete.Pretty+import Agda.Syntax.Common+import Agda.Syntax.Fixity+import Agda.Syntax.Literal++import Agda.Utils.Monad++}++%name tokensParser Tokens+%name exprParser Expr+%name moduleParser File+%tokentype { Token }+%monad { Parser }+%lexer { lexer } { TokEOF }++-- This is a trick to get rid of shift/reduce conflicts arising because we want+-- to parse things like "m >>= \x -> k x". See the Expr rule for more+-- information.+%nonassoc LOWEST+%nonassoc '->'++%token+    'let'	{ TokKeyword KwLet $$ }+    'in'	{ TokKeyword KwIn $$ }+    'where'	{ TokKeyword KwWhere $$ }+    'with'	{ TokKeyword KwWith $$ }+    'postulate' { TokKeyword KwPostulate $$ }+    'primitive' { TokKeyword KwPrimitive $$ }+    'open'	{ TokKeyword KwOpen $$ }+    'import'	{ TokKeyword KwImport $$ }+    'using'	{ TokKeyword KwUsing $$ }+    'hiding'	{ TokKeyword KwHiding $$ }+    'renaming'	{ TokKeyword KwRenaming $$ }+    'to'	{ TokKeyword KwTo $$ }+    'public'	{ TokKeyword KwPublic $$ }+    'module'	{ TokKeyword KwModule $$ }+    'data'	{ TokKeyword KwData $$ }+    'codata'	{ TokKeyword KwCoData $$ }+    'record'	{ TokKeyword KwRecord $$ }+    'field'	{ TokKeyword KwField $$ }+    'infix'	{ TokKeyword KwInfix $$ }+    'infixl'	{ TokKeyword KwInfixL $$ }+    'infixr'	{ TokKeyword KwInfixR $$ }+    'mutual'	{ TokKeyword KwMutual $$ }+    'abstract'	{ TokKeyword KwAbstract $$ }+    'private'	{ TokKeyword KwPrivate $$ }+    'Prop'	{ TokKeyword KwProp $$ }+    'Set'	{ TokKeyword KwSet $$ }+    'forall'	{ TokKeyword KwForall $$ }+    'OPTIONS'	{ TokKeyword KwOPTIONS $$ }+    'BUILTIN'	{ TokKeyword KwBUILTIN $$ }+    'IMPORT'	{ TokKeyword KwIMPORT $$ }+    'COMPILED'	{ TokKeyword KwCOMPILED $$ }+    'COMPILED_DATA' { TokKeyword KwCOMPILED_DATA $$ }+    'COMPILED_TYPE' { TokKeyword KwCOMPILED_TYPE $$ }+    'LINE'	{ TokKeyword KwLINE $$ }++    setN	{ TokSetN $$ }+    tex		{ TokTeX $$ }+    comment	{ TokComment $$ }++    '...'	{ TokSymbol SymEllipsis $$ }+    '.'		{ TokSymbol SymDot $$ }+    ';'		{ TokSymbol SymSemi $$ }+    ':'		{ TokSymbol SymColon $$ }+    '='		{ TokSymbol SymEqual $$ }+    '_'		{ TokSymbol SymUnderscore $$ }+    '?'		{ TokSymbol SymQuestionMark $$ }+    '->'	{ TokSymbol SymArrow $$ }+    '\\'	{ TokSymbol SymLambda $$ }+    '@'		{ TokSymbol SymAs $$ }+    '|'		{ TokSymbol SymBar $$ }+    '('		{ TokSymbol SymOpenParen $$ }+    ')'		{ TokSymbol SymCloseParen $$ }+    '{'		{ TokSymbol SymOpenBrace $$ }+    '}'		{ TokSymbol SymCloseBrace $$ }+    vopen	{ TokSymbol SymOpenVirtualBrace $$ }+    vclose	{ TokSymbol SymCloseVirtualBrace $$ }+    vsemi	{ TokSymbol SymVirtualSemi $$ }+    '{-#'	{ TokSymbol SymOpenPragma $$ }+    '#-}'	{ TokSymbol SymClosePragma $$ }++    id		{ TokId $$ }+    q_id	{ TokQId $$ }++    string	{ TokString $$ }+    literal	{ TokLiteral $$ }++%%++{--------------------------------------------------------------------------+    Parsing the token stream. Used by the TeX compiler.+ --------------------------------------------------------------------------}++-- Parse a list of tokens.+Tokens :: { [Token] }+Tokens : TokensR	{ reverse $1 }++-- Happy is much better at parsing left recursive grammars (constant+-- stack size vs. linear stack size for right recursive).+TokensR :: { [Token] }+TokensR	: TokensR Token	{ $2 : $1 }+	|		{ [] }++-- Parse single token.+Token :: { Token }+Token+    : 'let'	    { TokKeyword KwLet $1 }+    | 'in'	    { TokKeyword KwIn $1 }+    | 'where'	    { TokKeyword KwWhere $1 }+    | 'with'	    { TokKeyword KwWith $1 }+    | 'postulate'   { TokKeyword KwPostulate $1 }+    | 'primitive'   { TokKeyword KwPrimitive $1 }+    | 'open'	    { TokKeyword KwOpen $1 }+    | 'import'	    { TokKeyword KwImport $1 }+    | 'using'	    { TokKeyword KwUsing $1 }+    | 'hiding'	    { TokKeyword KwHiding $1 }+    | 'renaming'    { TokKeyword KwRenaming $1 }+    | 'to'	    { TokKeyword KwTo $1 }+    | 'public'	    { TokKeyword KwPublic $1 }+    | 'module'	    { TokKeyword KwModule $1 }+    | 'data'	    { TokKeyword KwData $1 }+    | 'codata'	    { TokKeyword KwCoData $1 }+    | 'record'	    { TokKeyword KwRecord $1 }+    | 'field'       { TokKeyword KwField $1 }+    | 'infix'	    { TokKeyword KwInfix $1 }+    | 'infixl'	    { TokKeyword KwInfixL $1 }+    | 'infixr'	    { TokKeyword KwInfixR $1 }+    | 'mutual'	    { TokKeyword KwMutual $1 }+    | 'abstract'    { TokKeyword KwAbstract $1 }+    | 'private'	    { TokKeyword KwPrivate $1 }+    | 'Prop'	    { TokKeyword KwProp $1 }+    | 'Set'	    { TokKeyword KwSet $1 }+    | 'forall'	    { TokKeyword KwForall $1 }+    | 'OPTIONS'	    { TokKeyword KwOPTIONS $1 }+    | 'BUILTIN'     { TokKeyword KwBUILTIN $1 }+    | 'IMPORT'      { TokKeyword KwIMPORT $1 }+    | 'COMPILED'    { TokKeyword KwCOMPILED $1 }+    | 'COMPILED_DATA'{ TokKeyword KwCOMPILED_DATA $1 }+    | 'COMPILED_TYPE'{ TokKeyword KwCOMPILED_TYPE $1 }+    | 'LINE'	    { TokKeyword KwLINE $1 }++    | setN	    { TokSetN $1 }+    | tex	    { TokTeX $1 }+    | comment	    { TokComment $1 }++    | '...'	    { TokSymbol SymEllipsis $1 }+    | '.'	    { TokSymbol SymDot $1 }+    | ';'	    { TokSymbol SymSemi $1 }+    | ':'	    { TokSymbol SymColon $1 }+    | '='	    { TokSymbol SymEqual $1 }+    | '_'	    { TokSymbol SymUnderscore $1 }+    | '?'	    { TokSymbol SymQuestionMark $1 }+    | '->'	    { TokSymbol SymArrow $1 }+    | '\\'	    { TokSymbol SymLambda $1 }+    | '@'	    { TokSymbol SymAs $1 }+    | '|'	    { TokSymbol SymBar $1 }+    | '('	    { TokSymbol SymOpenParen $1 }+    | ')'	    { TokSymbol SymCloseParen $1 }+    | '{'	    { TokSymbol SymOpenBrace $1 }+    | '}'	    { TokSymbol SymCloseBrace $1 }+    | vopen	    { TokSymbol SymOpenVirtualBrace $1 }+    | vclose	    { TokSymbol SymCloseVirtualBrace $1 }+    | vsemi	    { TokSymbol SymVirtualSemi $1 }+    | '{-#'	    { TokSymbol SymOpenPragma $1 }+    | '#-}'	    { TokSymbol SymClosePragma $1 }++    | id	    { TokId $1 }+    | q_id	    { TokQId $1 }+    | string	    { TokString $1 }++    | literal	    { TokLiteral $1 }++{--------------------------------------------------------------------------+    TeX+ --------------------------------------------------------------------------}++TeX :: { () }+TeX : {- empty -} { () }+    | tex TeX	  { () }++{--------------------------------------------------------------------------+    Top level+ --------------------------------------------------------------------------}++File :: { ([Pragma], [Declaration]) }+File : File1 TeX  { $1 }++File1 : TopLevel		 { ([], $1) }+      | TeX TopLevelPragma File1 { let (ps,m) = $3 in ($2 : ps, m) }+++{--------------------------------------------------------------------------+    Meta rules+ --------------------------------------------------------------------------}++-- The first token in a file decides the indentation of the top-level layout+-- block. Or not. It will if we allow the top-level module to be omitted.+-- topen :	{- empty -}	{% pushCurrentContext }+++{-  A layout block might have to be closed by a parse error. Example:+	let x = e in e'+    Here the 'let' starts a layout block which should end before the 'in'.  The+    problem is that the lexer doesn't know this, so there is no virtual close+    brace. However when the parser sees the 'in' there will be a parse error.+    This is our cue to close the layout block.+-}+close : vclose  { () }+      | error	{% popContext }+++-- You can use concrete semi colons in a layout block started with a virtual+-- brace, so we don't have to distinguish between the two semi colons. You can't+-- use a virtual semi colon in a block started by a concrete brace, but this is+-- simply because the lexer will not generate virtual semis in this case.+semi : ';'	  { $1 }+     | TeX vsemi  { $2 }+++-- Enter the 'imp_dir' lex state, where we can parse the keywords 'using',+-- 'hiding', 'renaming' and 'to'.+beginImpDir :: { () }+beginImpDir : {- empty -}   {% pushLexState imp_dir }++{--------------------------------------------------------------------------+    Helper rules+ --------------------------------------------------------------------------}++-- An integer. Used in fixity declarations.+Int :: { Integer }+Int : literal	{% case $1 of {+		     LitInt _ n	-> return $ fromIntegral n;+		     _		-> fail $ "Expected integer"+		   }+		}+++{--------------------------------------------------------------------------+    Names+ --------------------------------------------------------------------------}++-- A name is really a sequence of parts, but the lexer just sees it as a+-- string, so we have to do the translation here.+Id :: { Name }+Id : id	    {% mkName $1 }++-- Qualified operators are treated as identifiers, i.e. they have to be back+-- quoted to appear infix.+QId :: { QName }+QId : q_id  {% mkQName $1 }+    | Id    { QName $1 }+++-- A module name is just a qualified name+ModuleName :: { QName }+ModuleName : QId { $1 }+++-- A binding variable. Can be '_'+BId :: { Name }+BId : Id    { $1 }+    | '_'   { Name (getRange $1) [Hole] }+++-- Space separated list of binding identifiers. Used in fixity+-- declarations infixl 100 + -+SpaceBIds :: { [Name] }+SpaceBIds+    : BId SpaceBIds { $1 : $2 }+    | BId	    { [$1] }++-- Comma separated list of binding identifiers. Used in dependent+-- function spaces: (x,y,z : Nat) -> ...+CommaBIds :: { [Name] }+CommaBIds : Application {%+    let getName (Ident (QName x)) = Just x+	getName (Underscore r _)  = Just (Name r [Hole])+	getName _		  = Nothing+    in+    case partition isJust $ map getName $1 of+	(good, []) -> return $ map fromJust good+	_	   -> fail $ "expected sequence of bound identifiers"+    }+++-- Space separated list of strings in a pragma.+PragmaStrings :: { [String] }+PragmaStrings+    : {- empty -}	    { [] }+    | string PragmaStrings  { snd $1 : $2 }++PragmaName :: { QName }+PragmaName : string {% fmap QName (mkName $1) }++{--------------------------------------------------------------------------+    Expressions (terms and types)+ --------------------------------------------------------------------------}++{-  Expressions. You might expect lambdas and lets to appear in the first+    expression category (lowest precedence). The reason they don't is that we+    wan't to parse things like++	m >>= \x -> k x++    This will leads to a conflict in the following case++	m >>= \x -> k x >>= \y -> k' y++    At the second '>>=' we can either shift or reduce. We solve this problem+    using Happy's precedence directives. The rule 'Expr -> Expr1' (which is the+    rule you shouldn't use to reduce when seeing '>>=') is given LOWEST+    precedence.  The terminals '->' and op (which is what you should shift)+    is given higher precedence.+-}++-- Top level: Function types.+Expr :: { Expr }+Expr+    : TeleArrow Expr		{ Pi $1 $2 }+    | 'forall' LamBindings Expr	{ forallPi $2 $3 }+    | Application3 '->' Expr	{ Fun (fuseRange $1 $3) (RawApp (getRange $1) $1) $3 }+    | Expr1 %prec LOWEST	{ $1 }++-- Level 1: Application+Expr1  : WithExprs {% case $1 of+		      { [e]    -> return e+		      ; e : es -> return $ WithApp (fuseRange e es) e es+		      ; []     -> fail "impossible: empty with expressions"+		      }+		   }++WithExprs :: { [Expr] }+WithExprs+  : Application3 '|' WithExprs { RawApp (getRange $1) $1 :  $3 }+  | Application		       { [RawApp (getRange $1) $1] }++Application :: { [Expr] }+Application+    : Expr2		{ [$1] }+    | Expr3 Application { $1 : $2 }++-- Level 2: Lambdas and lets+Expr2+    : '\\' LamBindings Expr	   { Lam (fuseRange $1 $3) $2 $3 }+    | '\\' AbsurdLamBindings       { let (bs, h) = $2; r = fuseRange $1 bs in+                                     if null bs then AbsurdLam r h else+                                     Lam r bs (AbsurdLam r h)+                                   }+    | 'let' Declarations 'in' Expr { Let (fuseRange $1 $4) $2 $4 }+    | Expr3			   { $1 }++Application3 :: { [Expr] }+Application3+    : Expr3		 { [$1] }+    | Expr3 Application3 { $1 : $2 }++-- Level 3: Atoms+Expr3+    : QId				{ Ident $1 }+    | literal				{ Lit $1 }+    | '?'				{ QuestionMark (getRange $1) Nothing }+    | '_'				{ Underscore (getRange $1) Nothing }+    | 'Prop'				{ Prop (getRange $1) }+    | 'Set'				{ Set (getRange $1) }+    | setN				{ SetN (getRange (fst $1)) (snd $1) }+    | '{' Expr '}'			{ HiddenArg (fuseRange $1 $3) (unnamed $2) }+    | '{' Id '=' Expr '}'		{ HiddenArg (fuseRange $1 $5) (named (show $2) $4) }+    | '(' Expr ')'			{ Paren (fuseRange $1 $3) $2 }+    | '{' '}'				{ let r = fuseRange $1 $2 in HiddenArg r $ unnamed $ Absurd r }+    | '(' ')'				{ Absurd (fuseRange $1 $2) }+    | Id '@' Expr3			{ As (fuseRange $1 $3) $1 $3 }+    | '.' Expr3				{ Dot (fuseRange $1 $2) $2 }+    | 'record' '{' FieldAssignments '}' { Rec (getRange ($1,$4)) $3 }+++FieldAssignments :: { [(Name, Expr)] }+FieldAssignments+  : {- empty -}	      { [] }+  | FieldAssignments1 { $1 }++FieldAssignments1 :: { [(Name, Expr)] }+FieldAssignments1+  : FieldAssignment			  { [$1] }+  | FieldAssignment ';' FieldAssignments1 { $1 : $3 }++FieldAssignment :: { (Name, Expr) }+FieldAssignment+  : Id '=' Expr	  { ($1, $3) }++{--------------------------------------------------------------------------+    Bindings+ --------------------------------------------------------------------------}++-- "Delta ->" to avoid conflict between Delta -> Gamma and Delta -> A.+TeleArrow : Telescope1 '->' { $1 }++Telescope1+    : TypedBindingss	{ {-TeleBind-} $1 }++TypedBindingss :: { [TypedBindings] }+TypedBindingss+    : TypedBindings TypedBindingss { $1 : $2 }+    | TypedBindings		   { [$1] }+++-- A typed binding is either (x1,..,xn:A;..;y1,..,ym:B) or {x1,..,xn:A;..;y1,..,ym:B}.+TypedBindings :: { TypedBindings }+TypedBindings+    : '(' TBinds ')' { TypedBindings (fuseRange $1 $3) NotHidden $2 }+    | '{' TBinds '}' { TypedBindings (fuseRange $1 $3) Hidden    $2 }+++-- A semicolon separated list of TypedBindings+TBinds :: { [TypedBinding] }+TBinds : TBind		   { [$1] }+       | TBind ';' TBinds2 { $1 : $3 }++TBinds2 :: { [TypedBinding] }+TBinds2 : TBinds	   { $1 }+	| Expr ';' TBinds2 { TNoBind $1 : $3 }+	| Expr		   { [TNoBind $1] }+++-- x1,..,xn:A+TBind :: { TypedBinding }+TBind : CommaBIds ':' Expr  { TBind (fuseRange $1 $3) (map mkBoundName_ $1) $3 }+++-- A non-empty sequence of lambda bindings.+LamBindings :: { [LamBinding] }+LamBindings+  : LamBinds '->' {%+      case last $1 of+        Left _  -> parseError "Absurd lambda cannot have a body."+        _       -> return [ b | Right b <- $1 ]+      }++AbsurdLamBindings :: { ([LamBinding], Hiding) }+AbsurdLamBindings+  : LamBinds {%+    case last $1 of+      Right _ -> parseError "Missing body for lambda"+      Left h  -> return ([ b | Right b <- init $1], h)+    }++LamBinds :: { [Either Hiding LamBinding] }+LamBinds+  : DomainFreeBinding LamBinds	{ map Right $1 ++ $2 }+  | TypedBindings LamBinds	{ Right (DomainFull $1) : $2 }+  | DomainFreeBinding		{ map Right $1 }+  | TypedBindings		{ [Right $ DomainFull $1] }+  | '(' ')'                     { [Left NotHidden] }+  | '{' '}'                     { [Left Hidden] }++-- A possibly empty sequence of lambda bindings.+LamBindings0 :: { [LamBinding] }+LamBindings0+  : DomainFreeBinding LamBindings0	{ $1 ++ $2 }+  | TypedBindings LamBindings0	        { DomainFull $1 : $2 }+  |             		        { [] }++-- A domain free binding is either x or {x1 .. xn}+DomainFreeBinding :: { [LamBinding] }+DomainFreeBinding+    : BId		{ [DomainFree NotHidden $ mkBoundName_ $1]  }+    | '{' CommaBIds '}' { map (DomainFree Hidden . mkBoundName_) $2 }+++{--------------------------------------------------------------------------+    Modules and imports+ --------------------------------------------------------------------------}++-- You can rename imports+ImportImportDirective :: { (Maybe Name, ImportDirective) }+ImportImportDirective+    : ImportDirective	    { (Nothing, $1) }+    | id Id ImportDirective {% isName "as" $1 >> return (Just $2, $3) }++-- Import directives+ImportDirective :: { ImportDirective }+ImportDirective : ImportDirective1 {% verifyImportDirective $1 }++-- Can contain public+ImportDirective1 :: { ImportDirective }+ImportDirective1+    : 'public' ImportDirective2 { $2 { publicOpen = True } }+    | ImportDirective2	        { $1 }++ImportDirective2 :: { ImportDirective }+ImportDirective2+    : UsingOrHiding RenamingDir	{ ImportDirective (fuseRange $1 $2) $1 $2 False }+    | RenamingDir		{ ImportDirective (getRange $1) (Hiding []) $1 False }+    | UsingOrHiding		{ ImportDirective (getRange $1) $1 [] False }+    | {- empty -}		{ ImportDirective noRange (Hiding []) [] False }++UsingOrHiding :: { UsingOrHiding }+UsingOrHiding+    : 'using' '(' CommaImportNames ')'   { Using $3 }+	-- only using can have an empty list+    | 'hiding' '(' CommaImportNames1 ')' { Hiding $3 }++RenamingDir :: { [(ImportedName, Name)] }+RenamingDir+    : 'renaming' '(' Renamings ')'	{ $3 }++-- Renamings of the form 'x to y'+Renamings :: { [(ImportedName, Name)] }+Renamings+    : Renaming ';' Renamings	{ $1 : $3 }+    | Renaming			{ [$1] }++Renaming :: { (ImportedName, Name) }+Renaming+    : ImportName_ 'to' Id { ($1,$3) }++-- We need a special imported name here, since we have to trigger+-- the imp_dir state exactly one token before the 'to'+ImportName_ :: { ImportedName }+ImportName_+    : beginImpDir Id	      { ImportedName $2 }+    | 'module' beginImpDir Id { ImportedModule $3 }++ImportName :: { ImportedName }+ImportName : Id  	 { ImportedName $1 }+	   | 'module' Id { ImportedModule $2 }++CommaImportNames :: { [ImportedName] }+CommaImportNames+    : {- empty -}	{ [] }+    | CommaImportNames1	{ $1 }++CommaImportNames1+    : ImportName			{ [$1] }+    | ImportName ';' CommaImportNames1	{ $1 : $3 }++{--------------------------------------------------------------------------+    Function clauses+ --------------------------------------------------------------------------}++-- A left hand side of a function clause. We parse it as an expression, and+-- then check that it is a valid left hand side.+LHS :: { LHS }+LHS : Expr1 WithExpressions	     {% exprToLHS $1 >>= \p -> return (p $2) }+    | '...' WithPats WithExpressions { Ellipsis (fuseRange $1 $3) $2 $3 }++WithPats :: { [Pattern] }+WithPats : {- empty -}	{ [] }+	 | '|' Application3 WithPats+		{% exprToPattern (RawApp (getRange $2) $2) >>= \p ->+		   return (p : $3)+		}++WithExpressions :: { [Expr] }+WithExpressions+  : {- empty -}	{ [] }+  | 'with' Expr { case $2 of { WithApp _ e es -> e : es; e -> [e] } }++-- Where clauses are optional.+WhereClause :: { WhereClause }+WhereClause+    : {- empty -}		       { NoWhere	 }+    | 'where' Declarations	       { AnyWhere $2	 }+    | 'module' Id 'where' Declarations { SomeWhere $2 $4 }+++{--------------------------------------------------------------------------+    Different kinds of declarations+ --------------------------------------------------------------------------}++-- Top-level defintions.+Declaration :: { [Declaration] }+Declaration+    : TypeSig	    { [$1] }+    | Fields        { $1   }+    | FunClause	    { [$1] }+    | Data	    { [$1] }+    | Record	    { [$1] }+    | Infix	    { [$1] }+    | Mutual	    { [$1] }+    | Abstract	    { [$1] }+    | Private	    { [$1] }+    | Postulate	    { [$1] }+    | Primitive	    { [$1] }+    | Open	    { [$1] }+    | Import	    { [$1] }+    | ModuleMacro   { [$1] }+    | Module	    { [$1] }+    | Pragma	    { [$1] }+++{--------------------------------------------------------------------------+    Individual declarations+ --------------------------------------------------------------------------}++-- Type signatures can appear everywhere, so the type is completely polymorphic+-- in the indices.+TypeSig :: { Declaration }+TypeSig : Id ':' Expr   { TypeSig $1 $3 }+++-- Function declarations. The left hand side is parsed as an expression to allow+-- declarations like 'x::xs ++ ys = e', when '::' has higher precedence than '++'.+FunClause :: { Declaration }+FunClause : LHS RHS WhereClause	{ FunClause $1 $2 $3 }++RHS :: { RHS }+RHS : '=' Expr	    { RHS $2 }+    | {- empty -}   { AbsurdRHS }++-- Data declaration. Can be local.+Data :: { Declaration }+Data : 'data' Id LamBindings0 ':' Expr 'where'+	    Constructors	{ Data (getRange ($1, $6, $7)) Inductive $2 (map addType $3) $5 $7 }+     | 'codata' Id LamBindings0 ':' Expr 'where'+	    Constructors	{ Data (getRange ($1, $6, $7)) CoInductive $2 (map addType $3) $5 $7 }+++-- Record declarations.+Record :: { Declaration }+Record : 'record' Id LamBindings0 ':' Expr 'where'+	    Declarations0 { Record (getRange ($1, $6, $7)) $2 (map addType $3) $5 $7 }+++-- Fixity declarations.+Infix :: { Declaration }+Infix : 'infix'  Int SpaceBIds  { Infix (NonAssoc (fuseRange $1 $3) $2) $3 }+      | 'infixl' Int SpaceBIds  { Infix (LeftAssoc (fuseRange $1 $3) $2) $3 }+      | 'infixr' Int SpaceBIds  { Infix (RightAssoc (fuseRange $1 $3) $2) $3 }++-- Field declarations.+Fields :: { [Declaration] }+Fields : 'field' TypeSignatures { let toField (TypeSig x t) = Field x t in map toField $2 }++-- Mutually recursive declarations.+Mutual :: { Declaration }+Mutual : 'mutual' Declarations  { Mutual (fuseRange $1 $2) $2 }+++-- Abstract declarations.+Abstract :: { Declaration }+Abstract : 'abstract' Declarations  { Abstract (fuseRange $1 $2) $2 }+++-- Private can only appear on the top-level (or rather the module level).+Private :: { Declaration }+Private : 'private' Declarations	{ Private (fuseRange $1 $2) $2 }+++-- Postulates. Can only contain type signatures. TODO: relax this.+Postulate :: { Declaration }+Postulate : 'postulate' TypeSignatures	{ Postulate (fuseRange $1 $2) $2 }+++-- Primitives. Can only contain type signatures.+Primitive :: { Declaration }+Primitive : 'primitive' TypeSignatures	{ Primitive (fuseRange $1 $2) $2 }+++-- Open+Open :: { Declaration }+Open : 'open' ModuleName OpenArgs ImportDirective {+    let+    { m   = $2+    ; es  = $3+    ; dir = $4+    ; r   = getRange ($1, m, dir)+    } in+    case es of+    { []  -> Open r m dir+    ; _   -> Private r [ ModuleMacro r (noName $ beginningOf $ getRange $2) []+                           (RawApp (fuseRange m es) (Ident m : es)) DoOpen dir+                       ]+    }+  }++OpenArgs :: { [Expr] }+OpenArgs : {- empty -}    { [] }+         | Expr3 OpenArgs { $1 : $2 }++-- Module instantiation+ModuleMacro :: { Declaration }+ModuleMacro : 'module' Id LamBindings0 '=' Expr ImportDirective+		    { ModuleMacro (getRange ($1, $5, $6)) $2 (map addType $3) $5 DontOpen $6 }+	    | 'open' 'module' Id LamBindings0 '=' Expr ImportDirective+		    { ModuleMacro (getRange ($1, $6, $7)) $3 (map addType $4) $6 DoOpen $7 }++-- Import+Import :: { Declaration }+Import : 'import' ModuleName ImportImportDirective+	    { Import (getRange ($1,$2,snd $3)) $2 (fst $3) DontOpen (snd $3) }+       | 'open' 'import' ModuleName ImportImportDirective+	    { Import (getRange ($1,$3,snd $4)) $3 (fst $4) DoOpen (snd $4) }++-- Module+Module :: { Declaration }+Module : 'module' Id LamBindings0 'where' Declarations0+		    { Module (getRange ($1,$4,$5)) (QName $2) (map addType $3) $5 }++-- The top-level consist of a bunch of import and open followed by a top-level module.+TopLevel :: { [Declaration] }+TopLevel : TeX TopModule       { [$2] }+	 | TeX Import TopLevel { $2 : $3 }+	 | TeX Open   TopLevel { $2 : $3 }++-- The top-level module can have a qualified name.+TopModule :: { Declaration }+TopModule : 'module' ModuleName LamBindings0 'where' Declarations0+		    { Module (getRange ($1,$4,$5)) $2 (map addType $3) $5 }++Pragma :: { Declaration }+Pragma : DeclarationPragma  { Pragma $1 }++TopLevelPragma :: { Pragma }+TopLevelPragma+  : OptionsPragma { $1 }+  | LinePragma	  { $1 }++DeclarationPragma :: { Pragma }+DeclarationPragma+  : BuiltinPragma      { $1 }+  | LinePragma	       { $1 }+  | CompiledPragma     { $1 }+  | CompiledDataPragma { $1 }+  | CompiledTypePragma { $1 }+  | ImportPragma       { $1 }++OptionsPragma :: { Pragma }+OptionsPragma : '{-#' 'OPTIONS' PragmaStrings '#-}' { OptionsPragma (fuseRange $1 $4) $3 }++BuiltinPragma :: { Pragma }+BuiltinPragma+    : '{-#' 'BUILTIN' string PragmaName '#-}'+      { BuiltinPragma (fuseRange $1 $5) (snd $3) (Ident $4) }++CompiledPragma :: { Pragma }+CompiledPragma+  : '{-#' 'COMPILED' PragmaName PragmaStrings '#-}'+    { CompiledPragma (fuseRange $1 $5) $3 (unwords $4) }++CompiledTypePragma :: { Pragma }+CompiledTypePragma+  : '{-#' 'COMPILED_TYPE' PragmaName PragmaStrings '#-}'+    { CompiledTypePragma (fuseRange $1 $5) $3 (unwords $4) }++CompiledDataPragma :: { Pragma }+CompiledDataPragma+  : '{-#' 'COMPILED_DATA' PragmaName string PragmaStrings '#-}'+    { CompiledDataPragma (fuseRange $1 $6) $3 (snd $4) $5 }++ImportPragma :: { Pragma }+ImportPragma+  : '{-#' 'IMPORT' PragmaStrings '#-}'+    { ImportPragma (fuseRange $1 $4) (unwords $3) }++-- TODO: When a line pragma is encountered the line and column numbers+-- are updated, but the linear position is preserved. Is this what we+-- want?++LinePragma :: { Pragma }+LinePragma+    : '{-#' 'LINE' string string '#-}' {% do+      let r = fuseRange $1 $5+	  parseFile (i, f)+	    | head f == '"' && last f == '"'  = return $ init (tail f)+	    | otherwise	= parseErrorAt (iStart i) $ "Expected \"filename\", found " ++ f+	  parseLine (i, l)+	    | all isDigit l = return $ read l+	    | otherwise	    = parseErrorAt (iStart i) $ "Expected line number, found " ++ l+      line <- parseLine $3+      file <- parseFile $4+      currentPos <- fmap parsePos get+      setParsePos $ Pn+	{ srcFile = file+	, posPos  = posPos currentPos+	, posLine = line+	, posCol  = 1+	}+      return $ LinePragma r line file+    }++{--------------------------------------------------------------------------+    Sequences of declarations+ --------------------------------------------------------------------------}++-- Non-empty list of type signatures. Used in postulates.+TypeSignatures :: { [TypeSignature] }+TypeSignatures+    : TeX vopen TypeSignatures1 TeX close   { reverse $3 }++-- Inside the layout block.+TypeSignatures1 :: { [TypeSignature] }+TypeSignatures1+    : TypeSignatures1 semi TeX TypeSig  { $4 : $1 }+    | TeX TypeSig			{ [$2] }++-- Constructors are type signatures. But constructor lists can be empty.+Constructors :: { [Constructor] }+Constructors+    : TypeSignatures	  { $1 }+    | TeX vopen TeX close { [] }++-- Arbitrary declarations+Declarations :: { [Declaration] }+Declarations+    : TeX vopen Declarations1 TeX close { reverse $3 }++-- Arbitrary declarations+Declarations0 :: { [Declaration] }+Declarations0+    : TeX vopen TeX close  { [] }+    | Declarations { $1 }++Declarations1 :: { [Declaration] }+Declarations1+    : Declarations1 semi TeX Declaration { reverse $4 ++ $1 }+    | TeX Declaration			 { reverse $2 }+++{++{--------------------------------------------------------------------------+    Parsers+ --------------------------------------------------------------------------}++-- | Parse the token stream. Used by the TeX compiler.+tokensParser :: Parser [Token]++-- | Parse an expression. Could be used in interactions.+exprParser :: Parser Expr++-- | Parse a module.+moduleParser :: Parser ([Pragma], [Declaration])+++{--------------------------------------------------------------------------+    Happy stuff+ --------------------------------------------------------------------------}++-- | Required by Happy.+happyError :: Parser a+happyError = parseError "Parse error"+++{--------------------------------------------------------------------------+    Utility functions+ --------------------------------------------------------------------------}++-- | Create a name from a string.++mkName :: (Interval, String) -> Parser Name+mkName (i, s) = do+    let xs = parts s+    mapM_ isValidId xs+    unless (alternating xs) $ fail $ "a name cannot contain two consecutive underscores"+    return $ Name (getRange i) xs+    where+        parts :: String -> [NamePart]+        parts ""        = []+        parts ('_' : s) = Hole : parts s+        parts s         = Id x : parts s'+          where (x, s') = break (== '_') s++	isValidId Hole   = return ()+	isValidId (Id x) = case parse defaultParseFlags [0] (lexer return) x of+	    ParseOk _ (TokId _) -> return ()+	    _			-> fail $ "in the name " ++ s ++ ", the part " ++ x ++ " is not valid"++	-- we know that there aren't two Ids in a row+	alternating (Hole : Hole : _) = False+	alternating (_ : xs)	      = alternating xs+	alternating []		      = True++-- | Create a qualified name from a list of strings+mkQName :: [(Interval, String)] -> Parser QName+mkQName ss = do+    xs <- mapM mkName ss+    return $ foldr Qual (QName $ last xs) (init xs)++-- | Match a particular name.+isName :: String -> (Interval, String) -> Parser ()+isName s (_,s')+    | s == s'	= return ()+    | otherwise	= fail $ "expected " ++ s ++ ", found " ++ s'++-- | Build a forall pi (forall x y z -> ...)+forallPi :: [LamBinding] -> Expr -> Expr+forallPi bs e = Pi (map addType bs) e++-- | Converts lambda bindings to typed bindings.+addType :: LamBinding -> TypedBindings+addType (DomainFull b)	 = b+addType (DomainFree h x) = TypedBindings r h [TBind r [x] $ Underscore r Nothing]+  where r = getRange x++-- | Check that an import directive doesn't contain repeated names+verifyImportDirective :: ImportDirective -> Parser ImportDirective+verifyImportDirective i =+    case filter ((>1) . length)+	 $ group+	 $ sort xs+    of+	[]  -> return i+	yss -> let Just pos = rStart $ getRange $ head $ concat yss in+               parseErrorAt pos $+		"repeated name" ++ s ++ " in import directive: " +++		concat (intersperse ", " $ map (show . head) yss)+	    where+		s = case yss of+			[_] -> ""+			_   -> "s"+    where+	xs = names (usingOrHiding i) ++ map fst (renaming i)+	names (Using xs)    = xs+	names (Hiding xs)   = xs++{--------------------------------------------------------------------------+    Patterns+ --------------------------------------------------------------------------}++-- | Turn an expression into a left hand side.+exprToLHS :: Expr -> Parser ([Expr] -> LHS)+exprToLHS e = case e of+  WithApp r e es -> LHS <$> exprToPattern e <*> mapM exprToPattern es+  _		 -> LHS <$> exprToPattern e <*> return []++-- | Turn an expression into a pattern. Fails if the expression is not a+--   valid pattern.+exprToPattern :: Expr -> Parser Pattern+exprToPattern e =+    case e of+	Ident x			-> return $ IdentP x+	App _ e1 e2		-> AppP <$> exprToPattern e1+					<*> T.mapM (T.mapM exprToPattern) e2+	Paren r e		-> ParenP r+					<$> exprToPattern e+	Underscore r _		-> return $ WildP r+	Absurd r		-> return $ AbsurdP r+	As r x e		-> AsP r x <$> exprToPattern e+	Dot r (HiddenArg _ e)	-> return $ HiddenP r $ fmap (DotP r) e+	Dot r e			-> return $ DotP r e+	Lit l			-> return $ LitP l+	HiddenArg r e		-> HiddenP r <$> T.mapM exprToPattern e+	RawApp r es		-> RawAppP r <$> mapM exprToPattern es+	OpApp r x es		-> OpAppP r x <$> mapM exprToPattern es+	_			->+          let Just pos = rStart $ getRange e in+          parseErrorAt pos $ "Not a valid pattern: " ++ show e++}

+ src/full/Agda/Syntax/Parser/StringLiterals.hs view

@@ -0,0 +1,213 @@++{-| The code to lex string and character literals. Basically the same code+    as in GHC.+-}+module Agda.Syntax.Parser.StringLiterals+    ( litString, litChar+    ) where++import Control.Monad.State+import Data.Char++import Agda.Syntax.Parser.Alex+import Agda.Syntax.Parser.Monad+import Agda.Syntax.Parser.Tokens+import Agda.Syntax.Parser.LookAhead+import Agda.Syntax.Position+import Agda.Syntax.Literal++import Agda.Utils.Char   ( decDigit, hexDigit, octDigit )+import Agda.Utils.Tuple  ( (-*-) )++{--------------------------------------------------------------------------+    Exported actions+ --------------------------------------------------------------------------}++-- | Lex a string literal. Assumes that a double quote has been lexed.+litString :: LexAction Token+litString = stringToken '"' (\i s ->+              return $ TokLiteral $ LitString (getRange i) s)++{-| Lex a character literal. Assumes that a single quote has been lexed.  A+    character literal is lexed in exactly the same way as a string literal.+    Only before returning the token do we check that the lexed string is of+    length 1. This is maybe not the most efficient way of doing things, but on+    the other hand it will only be inefficient if there is a lexical error.+-}+litChar :: LexAction Token+litChar = stringToken '\'' $ \i s ->+	    do	case s of+		    [c]	-> return $ TokLiteral $ LitChar (getRange i) c+		    _	-> lexError+			    "character literal must contain a single character"+++{--------------------------------------------------------------------------+    Errors+ --------------------------------------------------------------------------}++-- | Custom error function.+litError :: String -> LookAhead a+litError msg =+    do	sync+	liftP $ lexError $+	    "Lexical error in string or character literal: " ++ msg+++{--------------------------------------------------------------------------+    The meat+ --------------------------------------------------------------------------}++-- | The general function to lex a string or character literal token. The+--   character argument is the delimiter (@\"@ for strings and @\'@ for+--   characters).+stringToken :: Char -> (Interval -> String -> Parser tok) -> LexAction tok+stringToken del mkTok inp inp' n =+    do	setLastPos (backupPos $ lexPos inp')+        setLexInput inp'+        -- TODO: Should setPrevToken be run here? Compare with+        -- Agda.Syntax.Parser.LexActions.token.+	tok <- runLookAhead litError $ lexString del ""+	i   <- getParseInterval+	mkTok i tok+++-- | This is where the work happens. The string argument is an accumulating+--   parameter for the string being lexed.+lexString :: Char -> String -> LookAhead String+lexString del s =++    do	c <- nextChar+	case c of++	    c | c == del  -> sync >> return (reverse s)++	    '\\' ->+		do  c' <- nextChar+		    case c' of+			'&'		-> sync >> lexString del s+			c | isSpace c	-> sync >> lexStringGap del s+			_		-> normalChar++	    _ -> normalChar+    where+	normalChar =+	    do	rollback+		c <- lexChar+		lexString del (c:s)+++-- | A string gap consists of whitespace (possibly including line breaks)+--   enclosed in backslashes. The gap is not part of the resulting string.+lexStringGap :: Char -> String -> LookAhead String+lexStringGap del s =+    do	c <- eatNextChar+	case c of+	    '\\'	    -> lexString del s+	    c | isSpace c   -> lexStringGap del s+	    _		    -> fail "non-space in string gap"++-- | Lex a single character.+lexChar :: LookAhead Char+lexChar =+    do	c <- eatNextChar+	case c of+	    '\\'    -> lexEscape+	    _	    -> return c++-- | Lex an escaped character. Assumes the backslash has been lexed.+lexEscape :: LookAhead Char+lexEscape =+    do	c <- eatNextChar+	case c of+	    '^'	    -> do c <- eatNextChar+			  if c >= '@' && c <= '_'+			    then return (chr (ord c - ord '@'))+			    else fail "invalid control character"++	    'x'	    -> readNum isHexDigit 16 hexDigit+	    'o'	    -> readNum isOctDigit  8 octDigit+	    x | isDigit x+		    -> readNumAcc isDigit 10 decDigit (decDigit x)++	    c ->+		-- Try to match the input (starting with c) against the+		-- silly escape codes.+		do  esc <- match' c (map (id -*- return) sillyEscapeChars)+				    (fail "bad escape code")+		    sync+		    return esc++-- | Read a number in the specified base.+readNum :: (Char -> Bool) -> Int -> (Char -> Int) -> LookAhead Char+readNum isDigit base conv =+    do	c <- eatNextChar+	if isDigit c +	    then readNumAcc isDigit base conv (conv c)+	    else fail "non-digit in numeral"++-- | Same as 'readNum' but with an accumulating parameter.+readNumAcc :: (Char -> Bool) -> Int -> (Char -> Int) -> Int -> LookAhead Char+readNumAcc isDigit base conv i = scan i+    where+	scan i =+	    do	inp <- getInput+		c   <- nextChar+		case c of+		    c | isDigit c -> scan (i*base + conv c)+		    _		  ->+			do  setInput inp+			    sync+			    if i >= ord minBound && i <= ord maxBound+				then return (chr i)+				else fail "character literal out of bounds"++-- | The escape codes.+sillyEscapeChars :: [(String, Char)]+sillyEscapeChars =+    [ ("a", '\a')+    , ("b", '\b')+    , ("f", '\f')+    , ("n", '\n')+    , ("r", '\r')+    , ("t", '\t')+    , ("v", '\v')+    , ("\\", '\\')+    , ("\"", '\"')+    , ("'", '\'')+    , ("NUL", '\NUL')+    , ("SOH", '\SOH')+    , ("STX", '\STX')+    , ("ETX", '\ETX')+    , ("EOT", '\EOT')+    , ("ENQ", '\ENQ')+    , ("ACK", '\ACK')+    , ("BEL", '\BEL')+    , ("BS", '\BS')+    , ("HT", '\HT')+    , ("LF", '\LF')+    , ("VT", '\VT')+    , ("FF", '\FF')+    , ("CR", '\CR')+    , ("SO", '\SO')+    , ("SI", '\SI')+    , ("DLE", '\DLE')+    , ("DC1", '\DC1')+    , ("DC2", '\DC2')+    , ("DC3", '\DC3')+    , ("DC4", '\DC4')+    , ("NAK", '\NAK')+    , ("SYN", '\SYN')+    , ("ETB", '\ETB')+    , ("CAN", '\CAN')+    , ("EM", '\EM')+    , ("SUB", '\SUB')+    , ("ESC", '\ESC')+    , ("FS", '\FS')+    , ("GS", '\GS')+    , ("RS", '\RS')+    , ("US", '\US')+    , ("SP", '\SP')+    , ("DEL", '\DEL')+    ]+

+ src/full/Agda/Syntax/Parser/Tokens.hs view

@@ -0,0 +1,69 @@++module Agda.Syntax.Parser.Tokens+    ( Token(..)+    , Keyword(..)+    , layoutKeywords+    , Symbol(..)+    ) where++import Agda.Syntax.Literal (Literal)+import Agda.Syntax.Concrete.Name (Name, QName)+import Agda.Syntax.Position++data Keyword+	= KwLet | KwIn | KwWhere | KwData | KwCoData+	| KwPostulate | KwMutual | KwAbstract | KwPrivate+	| KwOpen | KwImport | KwModule | KwPrimitive+	| KwInfix | KwInfixL | KwInfixR | KwWith+	| KwSet | KwProp | KwForall | KwRecord | KwField+	| KwHiding | KwUsing | KwRenaming | KwTo | KwPublic+	| KwOPTIONS | KwBUILTIN | KwLINE+        | KwCOMPILED_DATA | KwCOMPILED_TYPE | KwCOMPILED | KwIMPORT+    deriving (Eq, Show)++layoutKeywords :: [Keyword]+layoutKeywords =+    [ KwLet, KwWhere, KwPostulate, KwMutual, KwAbstract, KwPrivate, KwPrimitive, KwField ]++data Symbol+	= SymDot | SymSemi | SymVirtualSemi | SymBar+	| SymColon | SymArrow | SymEqual | SymLambda+	| SymUnderscore	| SymQuestionMark   | SymAs+	| SymOpenParen	      | SymCloseParen+	| SymOpenBrace	      | SymCloseBrace+	| SymOpenVirtualBrace | SymCloseVirtualBrace+	| SymOpenPragma	      | SymClosePragma | SymEllipsis+    deriving (Eq, Show)++data Token+	  -- Keywords+	= TokKeyword Keyword Interval+	  -- Identifiers and operators+	| TokId		(Interval, String)+	| TokQId	[(Interval, String)] -- non empty namespace+	  -- Literals+	| TokLiteral	Literal+	  -- Special symbols+	| TokSymbol Symbol Interval+	  -- Other tokens+	| TokString (Interval, String)  -- arbitrary string, used in pragmas+	| TokSetN (Interval, Integer)+	| TokTeX (Interval, String)+        | TokComment (Interval, String)+	| TokDummy	-- Dummy token to make Happy not complain+			-- about overlapping cases.+	| TokEOF+    deriving (Eq, Show)++instance HasRange Token where+  getRange (TokKeyword _ i)    = getRange i+  getRange (TokId (i, _))      = getRange i+  getRange (TokQId iss)        = Range $ map fst iss+  getRange (TokLiteral lit)    = getRange lit+  getRange (TokSymbol _ i)     = getRange i+  getRange (TokString (i, _))  = getRange i+  getRange (TokSetN (i, _))    = getRange i+  getRange (TokTeX (i, _))     = getRange i+  getRange (TokComment (i, _)) = getRange i+  getRange TokDummy            = noRange+  getRange TokEOF              = noRange

+ src/full/Agda/Syntax/Position.hs view

@@ -0,0 +1,423 @@+{-# LANGUAGE CPP, DeriveDataTypeable #-}++{-| Position information for syntax. Crucial for giving good error messages.+-}++module Agda.Syntax.Position+  ( -- * Positions+    Position(..)+  , positionInvariant+  , startPos+  , movePos+  , movePosByString+  , backupPos++    -- * Intervals+  , Interval(..)+  , intervalInvariant+  , takeI+  , dropI++    -- * Ranges+  , Range(..)+  , rangeInvariant+  , noRange+  , posToRange+  , rStart+  , rEnd+  , rangeToInterval+  , continuous+  , continuousPerLine+  , HasRange(..)+  , SetRange(..)+  , KillRange(..)+  , killRange1, killRange2, killRange3, killRange4, killRange5, killRange6, killRange7+  , withRangeOf+  , fuseRange+  , fuseRanges+  , beginningOf++    -- * Tests+  , tests+  ) where++import Data.Generics (Data, Typeable)+import Data.List+import Data.Function+import Data.Set (Set, (\\))+import qualified Data.Set as Set+import Agda.Utils.QuickCheck+import Control.Applicative+import Control.Monad+import Agda.Utils.TestHelpers++#include "../undefined.h"+import Agda.Utils.Impossible++{--------------------------------------------------------------------------+    Types and classes+ --------------------------------------------------------------------------}++-- | Represents a point in the input (file, position, line, col).+-- Positions and line and column numbers start from 1.+--+-- If two positions have the same 'srcFile' and 'posPos' components,+-- then the final two components should be the same as well, but since+-- this can be hard to enforce the program should not rely too much on+-- the last two components; they are mainly there to improve error+-- messages for the user.+--+-- Note the invariant which positions have to satisfy: 'positionInvariant'.+data Position = Pn { srcFile :: FilePath+                   , posPos  :: !Int+		   , posLine :: !Int+		   , posCol  :: !Int+		   }+    deriving (Typeable, Data)++positionInvariant p =+  posPos p > 0 && posLine p > 0 && posCol p > 0++importantPart p = (srcFile p, posPos p)++instance Eq Position where+  (==) = (==) `on` importantPart++instance Ord Position where+  compare = compare `on` importantPart++-- | An interval. The @iEnd@ position is not included in the interval.+--+-- Note the invariant which intervals have to satisfy: 'intervalInvariant'.+data Interval = Interval { iStart, iEnd :: !Position }+    deriving (Typeable, Data, Eq, Ord)++intervalInvariant :: Interval -> Bool+intervalInvariant i =+  all positionInvariant [iStart i, iEnd i] &&+  iStart i <= iEnd i++-- | The length of an interval, assuming that the start and end+-- positions are in the same file.+iLength :: Interval -> Int+iLength i = posPos (iEnd i) - posPos (iStart i)++-- | A range is a list of intervals. The intervals should be+-- consecutive and separated.+--+-- Note the invariant which ranges have to satisfy: 'rangeInvariant'.+newtype Range = Range [Interval]+  deriving (Typeable, Data, Eq, Ord)++rangeInvariant :: Range -> Bool+rangeInvariant (Range []) = True+rangeInvariant (Range is) =+  all intervalInvariant is &&+  and (zipWith (<) (map iEnd $ init is) (map iStart $ tail is))++-- | Things that have a range are instances of this class.+class HasRange t where+    getRange :: t -> Range++instance HasRange Interval where+    getRange i = Range [i]++instance HasRange Range where+    getRange = id++instance HasRange a => HasRange [a] where+    getRange = foldr fuseRange noRange++instance (HasRange a, HasRange b) => HasRange (a,b) where+    getRange = uncurry fuseRange++instance (HasRange a, HasRange b, HasRange c) => HasRange (a,b,c) where+    getRange (x,y,z) = getRange (x,(y,z))++-- | If it is also possible to set the range, this is the class.+--+--   Instances should satisfy @'getRange' ('setRange' r x) == r@.+class HasRange t => SetRange t where+  setRange :: Range -> t -> t++instance SetRange Range where+  setRange = const++-- | Killing the range of an object sets all range information to 'noRange'.+class KillRange a where+  killRange :: a -> a++killRange1 f a = f (killRange a)+killRange2 f a = killRange1 (f $ killRange a)+killRange3 f a = killRange2 (f $ killRange a)+killRange4 f a = killRange3 (f $ killRange a)+killRange5 f a = killRange4 (f $ killRange a)+killRange6 f a = killRange5 (f $ killRange a)+killRange7 f a = killRange6 (f $ killRange a)++instance KillRange Range where+  killRange _ = noRange++instance KillRange a => KillRange [a] where+  killRange = map killRange++instance (KillRange a, KillRange b) => KillRange (a, b) where+  killRange (x, y) = (killRange x, killRange y)++instance KillRange a => KillRange (Maybe a) where+  killRange = fmap killRange++instance (KillRange a, KillRange b) => KillRange (Either a b) where+  killRange (Left  x) = Left  $ killRange x+  killRange (Right x) = Right $ killRange x++{--------------------------------------------------------------------------+    Pretty printing+ --------------------------------------------------------------------------}++instance Show Position where+    show (Pn "" _ l c)	= show l ++ "," ++ show c+    show (Pn f  _ l c)	= f ++ ":" ++ show l ++ "," ++ show c++instance Show Interval where+    show (Interval s e) = file ++ start ++ "-" ++ end+	where+	    f	= srcFile s+	    sl	= posLine s+	    el	= posLine e+	    sc	= posCol s+	    ec	= posCol e+	    file+		| null f    = ""+		| otherwise = f ++ ":"+	    start = show sl ++ "," ++ show sc+	    end+		| sl == el  = show ec+		| otherwise = show el ++ "," ++ show ec++instance Show Range where+  show r = case rangeToInterval r of+    Nothing -> ""+    Just i  -> show i++{--------------------------------------------------------------------------+    Functions on postitions and ranges+ --------------------------------------------------------------------------}++-- | The first position in a file: position 1, line 1, column 1.+startPos :: FilePath -> Position+startPos f = Pn { srcFile = f, posPos = 1, posLine = 1, posCol = 1 }++-- | Ranges between two unknown positions+noRange :: Range+noRange = Range []++-- | Advance the position by one character.+--   A tab character (@'\t'@) will move the position to the next+--   tabstop (tab size is 8). A newline character (@'\n'@) moves+--   the position to the first character in the next line. Any+--   other character moves the position to the next column.+movePos :: Position -> Char -> Position+movePos (Pn f p l c) '\t' = Pn f (p + 1) l (div (c + 7) 8 * 8 + 1)+movePos (Pn f p l c) '\n' = Pn f (p + 1) (l + 1) 1+movePos (Pn f p l c) _	  = Pn f (p + 1) l (c + 1)++-- | Advance the position by a string.+--+--   > movePosByString = foldl' movePos+movePosByString :: Position -> String -> Position+movePosByString = foldl' movePos++-- | Backup the position by one character.+--+-- Precondition: The character must not be @'\t'@ or @'\n'@.+backupPos :: Position -> Position+backupPos (Pn f p l c) = Pn f (p - 1) l (c - 1)++-- | Extracts the interval corresponding to the given string, assuming+-- that the string starts at the beginning of the given interval.+--+-- Precondition: The string must not be too long for the interval.+takeI :: String -> Interval -> Interval+takeI s i | length s > iLength i = __IMPOSSIBLE__+          | otherwise = i { iEnd = movePosByString (iStart i) s }++-- | Removes the interval corresponding to the given string from the+-- given interval, assuming that the string starts at the beginning of+-- the interval.+--+-- Precondition: The string must not be too long for the interval.+dropI :: String -> Interval -> Interval+dropI s i | length s > iLength i = __IMPOSSIBLE__+          | otherwise = i { iStart = movePosByString (iStart i) s }++-- | Converts two positions to a range.+posToRange :: Position -> Position -> Range+posToRange p1 p2 | p1 < p2   = Range [Interval p1 p2]+                 | otherwise = Range [Interval p2 p1]++-- | Converts a range to an interval, if possible.+rangeToInterval :: Range -> Maybe Interval+rangeToInterval (Range [])   = Nothing+rangeToInterval (Range is)   = Just $ Interval { iStart = iStart (head is)+                                               , iEnd   = iEnd   (last is)+                                               }++-- | Returns the shortest continuous range containing the given one.+continuous :: Range -> Range+continuous r = case rangeToInterval r of+  Nothing -> Range []+  Just i  -> Range [i]++-- | Removes gaps between intervals on the same line.+continuousPerLine :: Range -> Range+continuousPerLine (Range [])     = Range []+continuousPerLine (Range (i:is)) = Range $ fuse i $ sortBy (compare `on` iStart) is+  where+    fuse i [] = [i]+    fuse i (j:is)+      | sameLine i j = fuse (fuseIntervals i j) is+      | otherwise    = i : fuse j is+    sameLine i j = posLine (iEnd i) == posLine (iStart j)++-- | The initial position in the range, if any.+rStart :: Range -> Maybe Position+rStart r = iStart <$> rangeToInterval r++-- | The position after the final position in the range, if any.+rEnd :: Range -> Maybe Position+rEnd r = iEnd <$> rangeToInterval r++-- | Finds the least interval which covers the arguments.+fuseIntervals :: Interval -> Interval -> Interval+fuseIntervals x y = Interval { iStart = head ps, iEnd = last ps }+    where ps = sort [iStart x, iStart y, iEnd x, iEnd y]++-- | Finds a range which covers the arguments.+fuseRanges :: Range -> Range -> Range+fuseRanges (Range is) (Range js) = Range (helper is js)+  where+  helper []     js  = js+  helper is     []  = is+  helper (i:is) (j:js)+    | iEnd i < iStart j = i : helper is     (j:js)+    | iEnd j < iStart i = j : helper (i:is) js+    | iEnd i < iEnd j   = helper is (fuseIntervals i j : js)+    | otherwise         = helper (fuseIntervals i j : is) js++fuseRange :: (HasRange u, HasRange t) => u -> t -> Range+fuseRange x y = fuseRanges (getRange x) (getRange y)++-- | @beginningOf r@ is an empty range (a single, empty interval)+-- positioned at the beginning of @r@. If @r@ does not have a+-- beginning, then 'noRange' is returned.+beginningOf :: Range -> Range+beginningOf r = case rStart r of+  Just pos -> Range [Interval { iStart = pos, iEnd = pos }]+  Nothing  -> noRange++-- | @x `withRangeOf` y@ sets the range of @x@ to the range of @y@.+withRangeOf :: (SetRange t, HasRange u) => t -> u -> t+x `withRangeOf` y = setRange (getRange y) x++------------------------------------------------------------------------+-- Test suite++-- | The positions corresponding to the interval, /including/ the+-- end-point. This function assumes that the two end points belong to+-- the same file. Note that the 'Arbitrary' instance for 'Position's+-- uses a single, hard-wired file name.+iPositions :: Interval -> Set Int+iPositions i = Set.fromList [posPos (iStart i) .. posPos (iEnd i)]++-- | The positions corresponding to the range, including the+-- end-points. All ranges are assumed to belong to a single file.+rPositions :: Range -> Set Int+rPositions (Range is) = Set.unions (map iPositions is)++-- | Constructs the least interval containing all the elements in the+-- set.+makeInterval :: Set Int -> Set Int+makeInterval s+  | Set.null s = Set.empty+  | otherwise  = Set.fromList [Set.findMin s .. Set.findMax s]++prop_iLength i = iLength i >= 0++prop_startPos = positionInvariant . startPos++prop_noRange = rangeInvariant noRange++prop_takeI_dropI i =+  forAll (choose (0, iLength i)) $ \n ->+    let s = replicate n ' '+        t = takeI s i+        d = dropI s i+    in+    intervalInvariant t &&+    intervalInvariant d &&+    fuseIntervals t d == i++prop_rangeToInterval (Range []) = True+prop_rangeToInterval r =+  intervalInvariant i &&+  iPositions i == makeInterval (rPositions r)+  where Just i = rangeToInterval r++prop_continuous r =+  rangeInvariant cr &&+  rPositions cr == makeInterval (rPositions r)+  where cr = continuous r++prop_fuseIntervals i1 i2 =+  intervalInvariant i &&+  iPositions i ==+    makeInterval (Set.union (iPositions i1) (iPositions i2))+  where i = fuseIntervals i1 i2++prop_fuseRanges :: Range -> Range -> Bool+prop_fuseRanges r1 r2 =+  rangeInvariant r &&+  rPositions r == Set.union (rPositions r1) (rPositions r2)+  where r = fuseRanges r1 r2++prop_beginningOf r = rangeInvariant (beginningOf r)++instance Arbitrary Position where+  arbitrary = do+    NonZero (NonNegative pos') <- arbitrary+    let pos  = fromInteger pos'+        line = pred pos `div` 10 + 1+        col  = pred pos `mod` 10 + 1+    return (Pn {srcFile = "file name", posPos = pos,+                posLine = line, posCol = col })++instance Arbitrary Interval where+  arbitrary = do+    (p1, p2) <- liftM2 (,) arbitrary arbitrary+    let [p1', p2'] = sort [p1, p2]+    return (Interval p1' p2')++instance Arbitrary Range where+  arbitrary = Range . fixUp . sort <$> arbitrary+    where+    fixUp (i1 : i2 : is)+      | iEnd i1 >= iStart i2 = fixUp (fuseIntervals i1 i2 : is)+      | otherwise            = i1 : fixUp (i2 : is)+    fixUp is = is++-- | Test suite.+tests = runTests "Agda.Syntax.Position"+  [ quickCheck' positionInvariant+  , quickCheck' intervalInvariant+  , quickCheck' rangeInvariant+  , quickCheck' prop_iLength+  , quickCheck' prop_startPos+  , quickCheck' prop_noRange+  , quickCheck' prop_takeI_dropI+  , quickCheck' prop_rangeToInterval+  , quickCheck' prop_continuous+  , quickCheck' prop_fuseIntervals+  , quickCheck' prop_fuseRanges+  , quickCheck' prop_beginningOf+  ]

+ src/full/Agda/Syntax/Scope/Base.hs view

@@ -0,0 +1,432 @@+{-# LANGUAGE CPP, DeriveDataTypeable #-}++{-| This module defines the notion of a scope and operations on scopes.+-}+module Agda.Syntax.Scope.Base where++import Data.Generics (Typeable, Data)+import Data.List+import Data.Map (Map)+import qualified Data.Map as Map+import Data.Function++import Agda.Syntax.Position+import Agda.Syntax.Common+import Agda.Syntax.Fixity+import Agda.Syntax.Abstract.Name as A+import Agda.Syntax.Concrete.Name as C+import Agda.Syntax.Concrete (ImportDirective(..), UsingOrHiding(..), ImportedName(..))+import qualified Agda.Utils.Map as Map+import Agda.Utils.Tuple++#include "../../undefined.h"+import Agda.Utils.Impossible++-- * Scope representation++-- | A scope is a named collection of names partitioned into public and private+--   names.+data Scope = Scope+      { scopeName    :: A.ModuleName+      , scopePrivate :: NameSpace+      , scopePublic  :: NameSpace+      }+  deriving (Typeable, Data)++-- | The scope at a particular point in the program is determined by the stack+--   of all enclosing scopes.+type ScopeStack = [Scope]++-- | The complete information about the scope at a particular program point+--   includes the scope stack, the local variables, and the context precedence.+data ScopeInfo = ScopeInfo+      { scopeStack	:: ScopeStack+      , scopeLocals	:: LocalVars+      , scopePrecedence :: Precedence+      }+  deriving (Typeable, Data)++-- | Local variables+type LocalVars = [(C.Name, A.Name)]++-- | A @NameSpace@ contains the mappings from concrete names that the user can+--   write to the abstract fully qualified names that the type checker wants to+--   read.+data NameSpace = NameSpace+      { nsNames	  :: NamesInScope+      , nsModules :: ModulesInScope+      }+  deriving (Typeable, Data)++type NamesInScope   = Map C.QName [AbstractName]+type ModulesInScope = Map C.QName [AbstractModule]++-- | We distinguish constructor names from other names.+data KindOfName = ConName | DefName+  deriving (Eq, Show, Typeable, Data)++-- | Apart from the name, we also record whether it's a constructor or not and+--   what the fixity is.+data AbstractName = AbsName+      { anameName   :: A.QName+      , anameKind   :: KindOfName+      }+  deriving (Typeable, Data)++-- | For modules we record the arity. I'm not sure that it's every used anywhere.+data AbstractModule = AbsModule+      { amodName    :: A.ModuleName+      }+  deriving (Typeable, Data)++instance Eq AbstractName where+  (==) = (==) `on` anameName++instance Ord AbstractName where+  compare = compare `on` anameName++instance Eq AbstractModule where+  (==) = (==) `on` amodName++instance Ord AbstractModule where+  compare = compare `on` amodName++instance Show ScopeInfo where+  show (ScopeInfo stack locals ctx) =+    unlines $+      [ "ScopeInfo" ] +++      (if null locals then [] else [ "  locals  = " ++ show locals ]) +++      [ "  context = " ++ show ctx+      , "  stack"+      ] ++ map ("    "++) (relines . map show $ stack)+    where+      relines = filter (not . null) . lines . unlines++blockOfLines :: String -> [String] -> [String]+blockOfLines _  [] = []+blockOfLines hd ss = hd : map ("  "++) ss++instance Show Scope where+  show (Scope { scopeName = name, scopePublic = pub, scopePrivate = pri }) =+    unlines $+      [ "scope " ++ show name ]+      ++ blockOfLines "public"  (lines $ show pub)+      ++ blockOfLines "private" (lines $ show pri)++instance Show NameSpace where+  show (NameSpace names mods) =+    unlines $+      blockOfLines "names"   (map pr $ Map.toList names) +++      blockOfLines "modules" (map pr $ Map.toList mods)+    where+      pr (x, y) = show x ++ " --> " ++ show y++instance Show AbstractName where+  show = show . anameName++instance Show AbstractModule where+  show = show . amodName++-- * Operations on names++instance HasRange AbstractName where+  getRange = getRange . anameName++instance SetRange AbstractName where+  setRange r x = x { anameName = setRange r $ anameName x }++-- * Operations on name and module maps.++mergeNames :: NamesInScope -> NamesInScope -> NamesInScope+mergeNames = Map.unionWith union++mergeModules :: ModulesInScope -> ModulesInScope -> ModulesInScope+mergeModules = Map.unionWith union++-- * Operations on name spaces++-- | The empty name space.+emptyNameSpace :: NameSpace+emptyNameSpace = NameSpace Map.empty Map.empty+++-- | Map functions over the names and modules in a name space.+mapNameSpace :: (NamesInScope   -> NamesInScope  ) ->+		(ModulesInScope -> ModulesInScope) ->+		NameSpace -> NameSpace+mapNameSpace fd fm ns =+  ns { nsNames	 = fd $ nsNames ns+     , nsModules = fm $ nsModules  ns+     }++-- | Zip together two name spaces.+zipNameSpace :: (NamesInScope   -> NamesInScope   -> NamesInScope  ) ->+		(ModulesInScope -> ModulesInScope -> ModulesInScope) ->+		NameSpace -> NameSpace -> NameSpace+zipNameSpace fd fm ns1 ns2 =+  ns1 { nsNames	  = nsNames   ns1 `fd` nsNames   ns2+      , nsModules = nsModules ns1 `fm` nsModules ns2+      }++-- | Map monadic function over a namespace.+mapNameSpaceM :: Monad m => +  (NamesInScope   -> m NamesInScope  ) ->+  (ModulesInScope -> m ModulesInScope) ->+  NameSpace -> m NameSpace+mapNameSpaceM fd fm ns = do+  ds <- fd $ nsNames ns+  ms <- fm $ nsModules ns+  return $ ns { nsNames = ds, nsModules = ms }++-- * General operations on scopes++-- | The empty scope.+emptyScope :: Scope+emptyScope = Scope { scopeName	  = noModuleName+		   , scopePublic  = emptyNameSpace+		   , scopePrivate = emptyNameSpace+		   }++-- | The empty scope info.+emptyScopeInfo :: ScopeInfo+emptyScopeInfo = ScopeInfo+		  { scopeStack	    = [emptyScope]+		  , scopeLocals	    = []+		  , scopePrecedence = TopCtx+		  }++-- | Map functions over the names and modules in a scope.+mapScope :: (Access -> NamesInScope   -> NamesInScope  ) ->+	    (Access -> ModulesInScope -> ModulesInScope) ->+	    Scope -> Scope+mapScope fd fm s =+  s { scopePrivate = mapNS PrivateAccess $ scopePrivate s+    , scopePublic  = mapNS PublicAccess  $ scopePublic  s+    }+  where+    mapNS acc = mapNameSpace (fd acc) (fm acc)++-- | Same as 'mapScope' but applies the same function to both the public and+--   private name spaces.+mapScope_ :: (NamesInScope   -> NamesInScope  ) ->+	     (ModulesInScope -> ModulesInScope) ->+	     Scope -> Scope+mapScope_ fd fm = mapScope (const fd) (const fm)++-- | Map monadic functions over the names and modules in a scope.+mapScopeM :: Monad m =>+  (Access -> NamesInScope   -> m NamesInScope  ) ->+  (Access -> ModulesInScope -> m ModulesInScope) ->+  Scope -> m Scope+mapScopeM fd fm s = do+  pri <- mapNS PrivateAccess $ scopePrivate s+  pub <- mapNS PublicAccess  $ scopePublic  s+  return $ s { scopePrivate = pri, scopePublic = pub }+  where+    mapNS acc = mapNameSpaceM (fd acc) (fm acc)++-- | Same as 'mapScopeM' but applies the same function to both the public and+--   private name spaces.+mapScopeM_ :: Monad m =>+  (NamesInScope   -> m NamesInScope  ) ->+  (ModulesInScope -> m ModulesInScope) ->+  Scope -> m Scope+mapScopeM_ fd fm = mapScopeM (const fd) (const fm)++-- | Zip together two scopes. The resulting scope has the same name as the+--   first scope.+zipScope :: (Access -> NamesInScope   -> NamesInScope   -> NamesInScope  ) ->+	    (Access -> ModulesInScope -> ModulesInScope -> ModulesInScope) ->+	    Scope -> Scope -> Scope+zipScope fd fm s1 s2 =+  s1 { scopePrivate = zipNS PrivateAccess (scopePrivate s1) (scopePrivate s2)+     , scopePublic  = zipNS PublicAccess  (scopePublic  s1) (scopePublic  s2)+     }+  where+    zipNS acc = zipNameSpace (fd acc) (fm acc)++-- | Same as 'zipScope' but applies the same function to both the public and+--   private name spaces.+zipScope_ :: (NamesInScope   -> NamesInScope   -> NamesInScope  ) ->+	     (ModulesInScope -> ModulesInScope -> ModulesInScope) ->+	     Scope -> Scope -> Scope+zipScope_ fd fm = zipScope (const fd) (const fm)++-- | Filter a scope keeping only concrete names matching the predicates.+--   The first predicate is applied to the names and the second to the modules.+filterScope :: (C.QName -> Bool) -> (C.QName -> Bool) -> Scope -> Scope+filterScope pd pm = mapScope_ (Map.filterKeys pd) (Map.filterKeys pm)++-- | Return all names in a scope, both public and private.+allNamesInScope :: Scope -> NamesInScope+allNamesInScope s = (mergeNames `on` nsNames) (scopePublic s) (scopePrivate s)++-- | Return all modules in a scope, both public and private.+allModulesInScope :: Scope -> ModulesInScope+allModulesInScope s = (mergeModules `on` nsModules) (scopePublic s) (scopePrivate s)++-- | Merge two scopes. The result has the name of the first scope.+mergeScope :: Scope -> Scope -> Scope+mergeScope = zipScope_ mergeNames mergeModules++-- | Merge a non-empty list of scopes. The result has the name of the first+--   scope in the list.+mergeScopes :: [Scope] -> Scope+mergeScopes [] = __IMPOSSIBLE__+mergeScopes ss = foldr1 mergeScope ss++-- * Specific operations on scopes++-- | Given a scope where all concrete names start with @M@, remove all the+--   @M@s. Used when opening a module @M@, in which case only those names+--   starting with @M@ are considered.+unqualifyScope :: C.QName -> Scope -> Scope+unqualifyScope m = mapScope_ unqual unqual+  where+    unqual = Map.mapKeys (unq m)++    unq _	     (C.QName _) = __IMPOSSIBLE__+    unq (C.Qual m n) (C.Qual m' q)+      | m == m'   = unq n q+      | otherwise = __IMPOSSIBLE__+    unq (C.QName m)  (C.Qual m' q)+      | m == m'	  = q+      | otherwise = __IMPOSSIBLE__++-- | Move all names in a scope to the public or private section, depending on+--   the first argument. Used when opening a module.+setScopeAccess :: Access -> Scope -> Scope+setScopeAccess a s = s { scopePublic  = pub+		       , scopePrivate = pri+		       }+  where+    one  = zipNameSpace mergeNames mergeModules (scopePublic s) (scopePrivate s)+    zero = emptyNameSpace++    (pub, pri) = case a of+      PublicAccess  -> (one, zero)+      PrivateAccess -> (zero, one)++-- | Add names to a scope.+addNamesToScope :: Access -> C.QName -> [AbstractName] -> Scope -> Scope+addNamesToScope acc x ys s = mergeScope s s1+  where+    s1 = setScopeAccess acc $ emptyScope+	 { scopePublic = emptyNameSpace { nsNames = Map.singleton x ys } }++-- | Add a name to a scope.+addNameToScope :: Access -> C.QName -> AbstractName -> Scope -> Scope+addNameToScope acc x y s = addNamesToScope acc x [y] s++-- | Add a module to a scope.+addModuleToScope :: Access -> C.QName -> AbstractModule -> Scope -> Scope+addModuleToScope acc x m s = mergeScope s s1+  where+    s1 = setScopeAccess acc $ emptyScope+	 { scopePublic = emptyNameSpace { nsModules = Map.singleton x [m] } }++-- | Apply an 'ImportDirective' to a scope.+applyImportDirective :: ImportDirective -> Scope -> Scope+applyImportDirective dir s = mergeScope usedOrHidden renamed+  where+    usedOrHidden = useOrHide (hideLHS (renaming dir) $ usingOrHiding dir) s+    renamed	 = rename (renaming dir) $ useOrHide useRenamedThings s++    useRenamedThings = Using $ map fst $ renaming dir++    hideLHS :: [(ImportedName, C.Name)] -> UsingOrHiding -> UsingOrHiding+    hideLHS _	i@(Using _) = i+    hideLHS ren (Hiding xs) = Hiding $ xs ++ map fst ren++    useOrHide :: UsingOrHiding -> Scope -> Scope+    useOrHide (Hiding xs) s = filterNames notElem notElem xs s+    useOrHide (Using  xs) s = filterNames elem	  elem	  xs s++    -- Qualified names are only ok if the top-most module is ok.+    okName pd pm (C.QName  x) = pd x+    okName pd pm (C.Qual m _) = pm m++    okModule pm (C.QName  x) = pm x+    okModule pm (C.Qual m _) = pm m++    filterNames :: (C.Name -> [C.Name] -> Bool) -> (C.Name -> [C.Name] -> Bool) ->+		   [ImportedName] -> Scope -> Scope+    filterNames pd pm xs = filterScope' (flip pd ds) (flip pm ms)+      where+	ds = [ x | ImportedName   x <- xs ]+	ms = [ m | ImportedModule m <- xs ]++    filterScope' pd pm = filterScope (okName pd pm) (okModule pm)++    -- Renaming+    rename :: [(ImportedName, C.Name)] -> Scope -> Scope+    rename rho = mapScope_ (Map.mapKeys $ renName drho mrho)+			   (Map.mapKeys $ renMod mrho)+      where+	mrho = [ (x, y) | (ImportedModule x, y) <- rho ]+	drho = [ (x, y) | (ImportedName	  x, y) <- rho ]++	ren r x = maybe x id $ lookup x r++	renName dr mr (C.QName  x) = C.QName $ ren dr x+	renName dr mr (C.Qual m x) = flip C.Qual x $ ren mr m++	renMod mr (C.QName  x) = C.QName $ ren mr x+	renMod mr (C.Qual m x) = flip C.Qual x $ ren mr m++-- | Rename the canical names in a scope.+renameCanonicalNames :: Map A.QName A.QName -> Map A.ModuleName A.ModuleName ->+			Scope -> Scope+renameCanonicalNames renD renM = mapScope_ renameD renameM+  where+    renameD = Map.map (map $ onName  rD)+    renameM = Map.map (map $ onMName rM)++    onName  f x = x { anameName = f $ anameName x }+    onMName f x = x { amodName  = f $ amodName  x }++    rD x = maybe x id $ Map.lookup x renD+    rM x = maybe x id $ Map.lookup x renM++-- * Inverse look-up++-- | Find the shortest concrete name that maps (uniquely) to a given abstract+--   name. Find defined names (first component of result) and module names+--   (second component) simultaneously.++-- | Takes the first component of 'inverseScopeLookup'.+inverseScopeLookupName :: A.QName -> ScopeInfo -> Maybe C.QName+inverseScopeLookupName x s = best $ invert x $ mergeScopes $ scopeStack s+  where+    len :: C.QName -> Int+    len (C.QName _)  = 1+    len (C.Qual _ x) = 1 + len x++    best xs = case sortBy (compare `on` len) xs of+      []    -> Nothing+      x : _ -> Just x++    invert x s = ds+      where+	ds = [ y | (y, zs) <- Map.toList $ allNamesInScope s+                 , x `elem` map anameName zs+                 , length zs == 1 || all ((==ConName) . anameKind) zs+             ]++-- | Takes the second component of 'inverseScopeLookup'.+inverseScopeLookupModule :: A.ModuleName -> ScopeInfo -> Maybe C.QName+inverseScopeLookupModule x s = best $ invert x $ mergeScopes $ scopeStack s+  where+    len :: C.QName -> Int+    len (C.QName _)  = 1+    len (C.Qual _ x) = 1 + len x++    best xs = case sortBy (compare `on` len) xs of+      []    -> Nothing+      x : _ -> Just x++    invert x s = ms+      where+	ms = [ y | (y, [m]) <- Map.toList $ allModulesInScope s, x == amodName m  ]++

+ src/full/Agda/Syntax/Scope/Monad.hs view

@@ -0,0 +1,382 @@+{-# LANGUAGE CPP #-}++{-| The scope monad with operations.+-}++module Agda.Syntax.Scope.Monad where++import Prelude hiding (mapM)+import Control.Applicative+import Control.Monad hiding (mapM)+import Data.Map (Map)+import Data.Traversable+import Data.List+import qualified Data.Map as Map++import Agda.Syntax.Common+import Agda.Syntax.Position+import Agda.Syntax.Fixity+import Agda.Syntax.Abstract.Name as A+import Agda.Syntax.Concrete as C+import Agda.Syntax.Scope.Base++import Agda.TypeChecking.Monad.Base+import Agda.TypeChecking.Monad.State+import Agda.TypeChecking.Monad.Options++import Agda.Utils.Tuple+import Agda.Utils.Fresh+import Agda.Utils.Size+import Agda.Utils.List++#include "../../undefined.h"+import Agda.Utils.Impossible++-- * The scope checking monad++-- | To simplify interaction between scope checking and type checking (in+--   particular when chasing imports), we use the same monad.+type ScopeM = TCM++-- * Errors++notInScope :: C.QName -> ScopeM a+notInScope x = typeError $ NotInScope [x]++-- * General operations++-- | Apply a function to the scope info.+modifyScopeInfo :: (ScopeInfo -> ScopeInfo) -> ScopeM ()+modifyScopeInfo f = do+  scope <- getScope+  setScope $ f scope++-- | Apply a function to the scope stack.+modifyScopeStack :: (ScopeStack -> ScopeStack) -> ScopeM ()+modifyScopeStack f = modifyScopeInfo $ \s -> s { scopeStack = f $ scopeStack s }++-- | Apply a function to the top scope.+modifyTopScope :: (Scope -> Scope) -> ScopeM ()+modifyTopScope f = modifyScopeStack $ \(s:ss) -> f s : ss++-- | Apply a monadic function to the top scope.+modifyTopScopeM :: (Scope -> ScopeM Scope) -> ScopeM ()+modifyTopScopeM f = do+  s : _ <- scopeStack <$> getScope+  s'	<- f s+  modifyTopScope (const s')++-- | Apply a function to the public or private name space.+modifyTopNameSpace :: Access -> (NameSpace -> NameSpace) -> ScopeM ()+modifyTopNameSpace acc f = modifyTopScope action+  where+    action s = s { scopePublic	= pub $ scopePublic  s+		 , scopePrivate = pri $ scopePrivate s+		 }+    (pub, pri) = case acc of+      PublicAccess  -> (f, id)+      PrivateAccess -> (id, f)++-- | Set context precedence+setContextPrecedence :: Precedence -> ScopeM ()+setContextPrecedence p = modifyScopeInfo $ \s -> s { scopePrecedence = p }++getContextPrecedence :: ScopeM Precedence+getContextPrecedence = scopePrecedence <$> getScope++withContextPrecedence :: Precedence -> ScopeM a -> ScopeM a+withContextPrecedence p m = do+  p' <- getContextPrecedence+  setContextPrecedence p+  x <- m+  setContextPrecedence p'+  return x++getLocalVars :: ScopeM LocalVars+getLocalVars = scopeLocals <$> getScope++setLocalVars :: LocalVars -> ScopeM ()+setLocalVars vars = modifyScope $ \s -> s { scopeLocals = vars }++-- | Run a computation without changing the local variables.+withLocalVars :: ScopeM a -> ScopeM a+withLocalVars m = do+  vars <- getLocalVars+  x    <- m+  setLocalVars vars+  return x++-- * Names++-- | Create a fresh abstract name from a concrete name.+freshAbstractName :: Fixity -> C.Name -> ScopeM A.Name+freshAbstractName fx x = do+  i <- fresh+  return $ A.Name i x (getRange x) fx++-- | @freshAbstractName_ = freshAbstractName defaultFixity@+freshAbstractName_ :: C.Name -> ScopeM A.Name+freshAbstractName_ = freshAbstractName defaultFixity++-- | Create a fresh abstract qualified name.+freshAbstractQName :: Fixity -> C.Name -> ScopeM A.QName+freshAbstractQName fx x = do+  y <- freshAbstractName fx x+  m <- getCurrentModule+  return $ A.qualify m y++-- * Simple queries++-- | Returns the name of the current module, with the range set to+-- 'noRange'.+getCurrentModule :: ScopeM ModuleName+getCurrentModule =+  setRange noRange .+  A.mnameFromList . concatMap A.mnameToList .+  reverse . map scopeName . scopeStack <$> getScope++-- * Resolving names++data ResolvedName = VarName A.Name+		  | DefinedName AbstractName+                  | ConstructorName [AbstractName]+		  | UnknownName+  deriving (Show)++-- | Look up the abstract name referred to by a given concrete name.+resolveName :: C.QName -> ScopeM ResolvedName+resolveName x = do+  scope <- getScope+  let vars = map (C.QName -*- id) $ scopeLocals scope+      defs = allNamesInScope . mergeScopes . scopeStack $ scope+  case lookup x vars of+    Just y  -> return $ VarName $ y { nameConcrete = unqualify x }+    Nothing -> case Map.lookup x defs of+      Just ds | all ((==ConName) . anameKind) ds ->+        return $ ConstructorName+               $ map (\d -> updateConcreteName d $ unqualify x) ds+      Just [d] -> return $ DefinedName $ updateConcreteName d (unqualify x)+      Just ds  -> typeError $ AmbiguousName x (map anameName ds)+      Nothing  -> return UnknownName+  where+  updateConcreteName :: AbstractName -> C.Name -> AbstractName+  updateConcreteName d@(AbsName { anameName = an@(A.QName { qnameName = qn }) }) x =+    d { anameName = an { qnameName = qn { nameConcrete = x } } }++-- | Look up a module in the scope.+resolveModule :: C.QName -> ScopeM AbstractModule+resolveModule x = do+  ms <- resolveModule' x+  case ms of+    [AbsModule m] -> return $ AbsModule (m `withRangesOfQ` x)+    []            -> typeError $ NoSuchModule x+    ms            -> typeError $ AmbiguousModule x (map amodName ms)++resolveModule' :: C.QName -> ScopeM [AbstractModule]+resolveModule' x = do+  ms <- allModulesInScope . mergeScopes . scopeStack <$> getScope+  case Map.lookup x ms of+    Just ms -> return ms+    Nothing -> return []++-- | Get the fixity of a name. The name is assumed to be in scope.+getFixity :: C.QName -> ScopeM Fixity+getFixity x = do+  r <- resolveName x+  case r of+    VarName y          -> return $ nameFixity y+    DefinedName d      -> return $ nameFixity $ qnameName $ anameName d+    ConstructorName ds+      | null fs        -> __IMPOSSIBLE__+      | allEqual fs    -> return $ head fs+      | otherwise      -> return defaultFixity+      where+        fs = map (nameFixity . qnameName . anameName) ds+    UnknownName        -> __IMPOSSIBLE__++-- * Binding names++-- | Bind a variable. The abstract name is supplied as the second argument.+bindVariable :: C.Name -> A.Name -> ScopeM ()+bindVariable x y = do+  scope <- getScope+  let scope' = scope { scopeLocals = (x, y) : scopeLocals scope }+  setScope scope'++-- | Bind a defined name. Must not shadow anything.+bindName :: Access -> KindOfName -> C.Name -> A.QName -> ScopeM ()+bindName acc kind x y = do+  r  <- resolveName (C.QName x)+  ys <- case r of+    DefinedName	d      -> typeError $ ClashingDefinition (C.QName x) $ anameName d+    VarName z          -> typeError $ ClashingDefinition (C.QName x) $ A.qualify (mnameFromList []) z+    ConstructorName [] -> __IMPOSSIBLE__+    ConstructorName ds+      | kind == ConName && all ((==ConName) . anameKind) ds -> return [ AbsName y kind ]+      | otherwise -> typeError $ ClashingDefinition (C.QName x) $ anameName (head ds) -- TODO: head+    UnknownName        -> return [AbsName y kind]+  modifyTopScope $ addNamesToScope acc (C.QName x) ys++-- | Bind a module name.+bindModule :: Access -> C.Name -> A.ModuleName -> ScopeM ()+bindModule acc x m = bindQModule acc (C.QName x) m++-- | Bind a qualified module name.+bindQModule :: Access -> C.QName -> A.ModuleName -> ScopeM ()+bindQModule acc x m = modifyTopScope $ addModuleToScope acc x $ AbsModule m++-- * Module manipulation operations++-- | Clear the scope of any no names.+stripNoNames :: ScopeM ()+stripNoNames = modifyScopeStack $ map strip+  where+    strip     = mapScope (\_ -> stripN) (\_ -> stripN)+    stripN m  = Map.filterWithKey (const . notNoName) m+    notNoName = not . any isNoName . qnameParts++-- | Push a new scope onto the scope stack+pushScope :: A.ModuleName -> ScopeM ()+pushScope name = modifyScopeStack (s:)+  where+    s = emptyScope { scopeName = name }++{-| Pop the top scope from the scope stack and incorporate its (public)+    contents in the new top scope. Depending on the first argument the contents+    is added to the public or private part of the top scope. Basically if the+    stack looks like this:++    @+    scope A: x -> Q.B.A.x+    scope B: y -> Q.B.y+    scope Q: ..+    @++    then after popping it will look like++    @+    scope B: A.x -> Q.B.A.x+             y   -> Q.B.y+    scope Q: ..+    @+-}+popScope :: Access -> ScopeM ()+popScope acc = do+  modifyScopeStack $ \(s0:s1:ss) ->+    mergeScope s1 (setScopeAccess acc $ mapScope_ (qual s0) (qual s0) $ noPrivate s0) : ss+  where+    qual s m	= Map.mapKeys (qual' (mnameToList $ scopeName s)) m+      where+	qual' xs x = foldr C.Qual x $ map nameConcrete xs+    noPrivate s = s { scopePrivate = emptyNameSpace }++-- | Pop the top scope from the stack and discard its contents.+popScope_ :: ScopeM ()+popScope_ = modifyScopeStack tail++-- | Returns a scope containing everything starting with a particular module+--   name. Used to open a module.+matchPrefix :: C.QName -> ScopeM Scope+matchPrefix m = filterScope (isPrefix m) (isPrefix m)+	      . mergeScopes . scopeStack <$> getScope+  where+    isPrefix _		   (C.QName _  ) = False+    isPrefix (C.QName m)   (C.Qual m' x) = m == m'+    isPrefix (C.Qual m m2) (C.Qual m' x) = m == m' && isPrefix m2 x++-- | @renamedCanonicalNames old new s@ returns a renaming replacing all+--   (abstract) names @old.m.x@ with @new.m.x@. Any other names are left+--   untouched.+renamedCanonicalNames :: ModuleName -> ModuleName -> Scope ->+		       ScopeM (Map A.QName A.QName, Map A.ModuleName A.ModuleName)+renamedCanonicalNames old new s = (,) <$> renamedNames names <*> renamedMods mods+  where+    ns	  = scopePublic $ setScopeAccess PublicAccess s+    names = nsNames ns+    mods  = nsModules ns++    renamedNames ds = Map.fromList <$> zip xs <$> mapM renName xs+      where+	xs = filter (`isInModule` old) $ map anameName $ concat $ Map.elems ds++    renamedMods ms = Map.fromList <$> zip xs <$> mapM renMod xs+      where+	xs = filter (`isSubModuleOf` old) $ map amodName $ concat $ Map.elems ms++    -- Change a binding M.x -> old.M'.y to M.x -> new.M'.y+    renName :: A.QName -> ScopeM A.QName+    renName y = do+      i <- fresh+      return . qualifyQ new . dequalify+	     $ y { qnameName = (qnameName y) { nameId = i } }+      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 -> ScopeM A.ModuleName+    renMod = return . qualifyM new . dequalify+      where+	dequalify = A.mnameFromList . drop (size old) . A.mnameToList++-- | Apply an importdirective and check that all the names mentioned actually+--   exist.+applyImportDirectiveM :: C.QName -> ImportDirective -> Scope -> ScopeM Scope+applyImportDirectiveM m dir scope = do+  xs <- filterM doesn'tExist names+  reportSLn "scope.import.apply" 20 $ "non existing names: " ++ show xs+  case xs of+    []	-> return $ applyImportDirective dir scope+    _	-> typeError $ ModuleDoesntExport m xs+  where+    names :: [ImportedName]+    names = map fst (renaming dir) ++ case usingOrHiding dir of+      Using  xs -> xs+      Hiding xs -> xs++    doesn'tExist (ImportedName x) =+      case Map.lookup (C.QName x) $ allNamesInScope scope of+	Just _	-> return False+	Nothing	-> return True+    doesn'tExist (ImportedModule x) =+      case Map.lookup (C.QName x) $ allModulesInScope scope of+	Just _	-> return False+	Nothing	-> return True++-- | Open a module. Assumes that all preconditions have been checked, i.e. that+--   the module is not opened into a different context than it was defined.+openModule_ :: C.QName -> ImportDirective -> ScopeM ()+openModule_ m dir =+  addScope  .  setScopeAccess acc+           =<< applyImportDirectiveM m dir+            .  unqualifyScope m =<< matchPrefix m+  where+    addScope s+      | not (publicOpen dir) = modifyTopScope (`mergeScope` s)+      | otherwise            = do+        -- In case of a public open we check that there are no+        -- clashes with previously defined names.+        pub0 <- scopePublic . head . scopeStack <$> getScope+        let pub1 = scopePublic s+            [def0, def1] = map (Map.keys . nsNames) [pub0, pub1]+            [mod0, mod1] = map (Map.keys . nsModules) [pub0, pub1]++        -- Clashing definitions?+        case intersect def0 def1 of+          []    -> return ()+          x : _ -> case Map.lookup x (nsNames pub0) of+                    Just [q] -> typeError $ ClashingDefinition x (anameName q)+                    _        -> __IMPOSSIBLE__++        -- Clashing modules?+        case intersect mod0 mod1 of+          []    -> return ()+          x : _ -> case (Map.lookup x (nsModules pub0), Map.lookup x (nsModules pub1)) of+                    (Just [q0], Just [q1]) -> typeError $ ClashingModule (amodName q0) (amodName q1)+                    _                      -> __IMPOSSIBLE__++        -- All is well. Merge.+        modifyTopScope (`mergeScope` s)++    acc | publicOpen dir  = PublicAccess+	| otherwise	  = PrivateAccess+

+ src/full/Agda/Syntax/Strict.hs view

@@ -0,0 +1,84 @@+{-# LANGUAGE CPP #-}++module Agda.Syntax.Strict where++import Data.Generics++import Agda.Syntax.Common+import Agda.Syntax.Internal+import Agda.Syntax.Parser.Tokens+import qualified Agda.Syntax.Concrete as C+import qualified Agda.Syntax.Concrete.Definitions as C++#include "../undefined.h"+import Agda.Utils.Impossible++class Strict a where+    force :: a -> Int++instance Strict Term where+    force t = case t of+	Var _ ts   -> force ts+	Def _ ts   -> force ts+	Con _ ts   -> force ts+	Lam _ t    -> force t+	Lit _	   -> 0+	Pi a b	   -> force (a,b)+	Fun a b    -> force (a,b)+	Sort s	   -> force s+	MetaV _ ts -> force ts++instance Strict Type where+    force (El s t) = force (s,t)++instance Strict Sort where+    force s = case s of+	Type n	  -> fromIntegral n+	Prop	  -> 0+	Lub s1 s2 -> force (s1,s2)+	Suc s	  -> force s+	MetaS _   -> 0++instance Strict ClauseBody where+    force (Body t)   = force t+    force (Bind b)   = force b+    force (NoBind b) = force b+    force  NoBody    = 0++instance Strict C.Expr where+    force e = everything (+) (const 1) e++instance Strict C.Declaration where+    force e = everything (+) (const 1) e++instance Strict C.Pragma where+    force e = everything (+) (const 1) e++instance Strict C.NiceDeclaration where+    force d = everything (+) (const 1) d++instance (Strict a, Strict b) => Strict (a,b) where+    force (x,y) = force x + force y++instance Strict a => Strict (Arg a) where+    force = force . unArg++instance Strict a => Strict [a] where+    force = sum . map force++instance Strict a => Strict (Abs a) where+    force = force . absBody++instance Strict Token where+  -- TODO: This is just a dummy instance. Why can't we just use the+  -- NFData derivation provided by Drift?+  force = (`seq` 0)++infixr 0 $!!++($!!) :: Strict a => (a -> b) -> a -> b+f $!! x = force x `seq` f x++strict :: Strict a => a -> a+strict x = id $!! x+

+ src/full/Agda/Syntax/Translation/AbstractToConcrete.hs view

@@ -0,0 +1,716 @@+{-# LANGUAGE CPP, PatternGuards, MultiParamTypeClasses, FunctionalDependencies,+             TypeSynonymInstances, FlexibleInstances, UndecidableInstances,+             OverlappingInstances+  #-}++{-| The translation of abstract syntax to concrete syntax has two purposes.+    First it allows us to pretty print abstract syntax values without having to+    write a dedicated pretty printer, and second it serves as a sanity check+    for the concrete to abstract translation: translating from concrete to+    abstract and then back again should be (more or less) the identity.+-}+module Agda.Syntax.Translation.AbstractToConcrete where++import Control.Applicative+import Control.Monad.Reader+import Data.Char+import qualified Data.Map as Map+import Data.Map (Map)+import qualified Data.Set as Set+import Data.Set (Set)+import Data.List as List++import Agda.Syntax.Common+import Agda.Syntax.Position+import Agda.Syntax.Info+import Agda.Syntax.Fixity+import Agda.Syntax.Concrete as C+import Agda.Syntax.Concrete.Pretty+import Agda.Syntax.Abstract as A+import Agda.Syntax.Abstract.Views as AV+import Agda.Syntax.Scope.Base++import Agda.TypeChecking.Monad.State (getScope)+import Agda.TypeChecking.Monad.Base  (MonadTCM)++import Agda.Utils.Maybe+import Agda.Utils.Monad+import Agda.Utils.Tuple+import Agda.Utils.Suffix++#include "../../undefined.h"+import Agda.Utils.Impossible++-- Environment ------------------------------------------------------------++data Env = Env { takenNames   :: Set C.Name+	       , currentScope :: ScopeInfo+	       }++defaultEnv :: Env+defaultEnv = Env { takenNames	= Set.empty+		 , currentScope	= emptyScopeInfo+		 }++makeEnv :: ScopeInfo -> Env+makeEnv scope = Env { takenNames   = taken+		    , currentScope = scope+		    }+  where+    s	  = mergeScopes $ scopeStack scope+    taken = Set.union vars defs+    vars  = Set.fromList $ map fst $ scopeLocals scope+    defs  = Set.fromList [ x | (C.QName x, _) <- Map.toList $ allNamesInScope s ]++currentPrecedence :: AbsToCon Precedence+currentPrecedence = asks $ scopePrecedence . currentScope++withPrecedence :: Precedence -> AbsToCon a -> AbsToCon a+withPrecedence p = local $ \e ->+  e { currentScope = (currentScope e) { scopePrecedence = p } }++withScope :: ScopeInfo -> AbsToCon a -> AbsToCon a+withScope scope = local $ \e -> e { currentScope = scope }++-- The Monad --------------------------------------------------------------++-- | We make the translation monadic for modularity purposes.+type AbsToCon = Reader Env++runAbsToCon :: MonadTCM tcm => AbsToCon a -> tcm a+runAbsToCon m = do+  scope <- getScope+  return $ runReader m (makeEnv scope)++abstractToConcrete :: ToConcrete a c => Env -> a -> c+abstractToConcrete flags a = runReader (toConcrete a) flags++abstractToConcreteCtx :: (MonadTCM tcm, ToConcrete a c) => Precedence -> a -> tcm c+abstractToConcreteCtx ctx x = do+  scope <- getScope+  let scope' = scope { scopePrecedence = ctx }+  return $ abstractToConcrete (makeEnv scope') x+  where+    scope = (currentScope defaultEnv) { scopePrecedence = ctx }++abstractToConcrete_ :: (MonadTCM tcm, ToConcrete a c) => a -> tcm c+abstractToConcrete_ x = do+  scope <- getScope+  return $ abstractToConcrete (makeEnv scope) x++-- Dealing with names -----------------------------------------------------++-- | Names in abstract syntax are fully qualified, but the concrete syntax+--   requires non-qualified names in places. In theory (if all scopes are+--   correct), we should get a non-qualified name when translating back to a+--   concrete name, but I suspect the scope isn't always perfect. In these+--   cases we just throw away the qualified part. It's just for pretty printing+--   anyway...+unsafeQNameToName :: C.QName -> C.Name+unsafeQNameToName (C.QName x) = x+unsafeQNameToName (C.Qual _ x) = unsafeQNameToName x++lookupName :: A.Name -> AbsToCon C.Name+lookupName x = do+  names <- asks $ scopeLocals . currentScope+  case lookup x $ map swap names of+      Just y  -> return y+      Nothing -> return $ nameConcrete x+  where+    swap (x, y) = (y, x)++lookupQName :: A.QName -> AbsToCon C.QName+lookupQName x =+    do	scope <- asks currentScope+	case inverseScopeLookupName x scope of+	    Just y  -> return y+	    Nothing -> return $ C.Qual (C.Name noRange [Id ""]) $ qnameToConcrete x+		-- this is what happens for names that are not in scope (private names)++lookupModule :: A.ModuleName -> AbsToCon C.QName+lookupModule x =+    do	scope <- asks currentScope+	case inverseScopeLookupModule x scope of+	    Just y  -> return y+	    Nothing -> return $ mnameToConcrete x+		-- this is what happens for names that are not in scope (private names)++bindName :: A.Name -> (C.Name -> AbsToCon a) -> AbsToCon a+bindName x ret = do+  names <- asks takenNames+  let y = nameConcrete x+  case (Set.member y names) of+    _ | C.isNoName y -> ret y+    True	     -> bindName (nextName x) ret+    False	     ->+	local (\e -> e { takenNames   = Set.insert y $ takenNames e+		       , currentScope = (currentScope e)+			  { scopeLocals = (y, x) : scopeLocals (currentScope e)+			  }+		       }+	      ) $ ret y++-- Dealing with precedences -----------------------------------------------++-- | General bracketing function.+bracket' ::    (e -> e)		    -- ^ the bracketing function+	    -> (Precedence -> Bool) -- ^ do we need brackets+	    -> e -> AbsToCon e+bracket' paren needParen e =+    do	p <- currentPrecedence+	return $ if needParen p then paren e else e++-- | Expression bracketing+bracket :: (Precedence -> Bool) -> AbsToCon C.Expr -> AbsToCon C.Expr+bracket par m =+    do	e <- m+	bracket' (Paren (getRange e)) par e++-- | Pattern bracketing+bracketP_ :: (Precedence -> Bool) -> AbsToCon C.Pattern -> AbsToCon C.Pattern+bracketP_ par m =+    do	e <- m+	bracket' (ParenP (getRange e)) par e++-- | Pattern bracketing+bracketP :: (Precedence -> Bool) -> (C.Pattern -> AbsToCon a)+				 -> ((C.Pattern -> AbsToCon a) -> AbsToCon a)+				 -> AbsToCon a+bracketP par ret m = m $ \p -> do+    p <- bracket' (ParenP $ getRange p) par p+    ret p++-- Dealing with infix declarations ----------------------------------------++-- | If a name is defined with a fixity that differs from the default, we have+--   to generate a fixity declaration for that name.+withInfixDecl :: DefInfo -> C.Name -> AbsToCon [C.Declaration] -> AbsToCon [C.Declaration]+withInfixDecl i x m+    | defFixity i == defaultFixity = m+    | otherwise			   = do+	ds <- m+	return $ C.Infix (defFixity i) [x] : ds++withInfixDecls :: [(DefInfo, C.Name)] -> AbsToCon [C.Declaration] -> AbsToCon [C.Declaration]+withInfixDecls = foldr (.) id . map (uncurry withInfixDecl)++-- Dealing with private definitions ---------------------------------------++withAbstractPrivate :: DefInfo -> AbsToCon [C.Declaration] -> AbsToCon [C.Declaration]+withAbstractPrivate i m =+    case (defAccess i, defAbstract i) of+	(PublicAccess, ConcreteDef) -> m+	(p,a)			    -> +	    do	ds <- m+		return $ abst a $ priv p $ ds+    where+	priv PrivateAccess ds = [ C.Private (getRange ds) ds ]+	priv _ ds	      = ds+	abst AbstractDef ds   = [ C.Abstract (getRange ds) ds ]+	abst _ ds	      = ds++-- The To Concrete Class --------------------------------------------------++class ToConcrete a c | a -> c where+    toConcrete :: a -> AbsToCon c+    bindToConcrete :: a -> (c -> AbsToCon b) -> AbsToCon b++    toConcrete	   x	 = bindToConcrete x return+    bindToConcrete x ret = ret =<< toConcrete x++-- | Translate something in a context of the given precedence.+toConcreteCtx :: ToConcrete a c => Precedence -> a -> AbsToCon c+toConcreteCtx p x = withPrecedence p $ toConcrete x++-- | Translate something in a context of the given precedence.+bindToConcreteCtx :: ToConcrete a c => Precedence -> a -> (c -> AbsToCon b) -> AbsToCon b+bindToConcreteCtx p x ret = withPrecedence p $ bindToConcrete x ret++-- General instances ------------------------------------------------------++instance ToConcrete a c => ToConcrete [a] [c] where+    toConcrete	   = mapM toConcrete+    bindToConcrete = thread bindToConcrete++instance (ToConcrete a1 c1, ToConcrete a2 c2) => ToConcrete (a1,a2) (c1,c2) where+    toConcrete (x,y) = liftM2 (,) (toConcrete x) (toConcrete y)+    bindToConcrete (x,y) ret =+	bindToConcrete x $ \x ->+	bindToConcrete y $ \y ->+	ret (x,y)++instance (ToConcrete a1 c1, ToConcrete a2 c2, ToConcrete a3 c3) =>+	 ToConcrete (a1,a2,a3) (c1,c2,c3) where+    toConcrete (x,y,z) = reorder <$> toConcrete (x,(y,z))+	where+	    reorder (x,(y,z)) = (x,y,z)++    bindToConcrete (x,y,z) ret = bindToConcrete (x,(y,z)) $ ret . reorder+	where+	    reorder (x,(y,z)) = (x,y,z)++instance ToConcrete a c => ToConcrete (Arg a) (Arg c) where+    toConcrete (Arg h@Hidden    x) = Arg h <$> toConcreteCtx TopCtx x+    toConcrete (Arg h@NotHidden x) = Arg h <$> toConcrete x++    bindToConcrete (Arg h x) ret = bindToConcreteCtx (hiddenArgumentCtx h) x $ ret . Arg h++instance ToConcrete a c => ToConcrete (Named name a) (Named name c) where+    toConcrete (Named n x) = Named n <$> toConcrete x+    bindToConcrete (Named n x) ret = bindToConcrete x $ ret . Named n++newtype DontTouchMe a = DontTouchMe a++instance ToConcrete (DontTouchMe a) a where+    toConcrete (DontTouchMe x) = return x++-- Names ------------------------------------------------------------------++instance ToConcrete A.Name C.Name where+  toConcrete	   = lookupName+  bindToConcrete x = bindName x++instance ToConcrete A.QName C.QName where+  toConcrete = lookupQName++instance ToConcrete A.ModuleName C.QName where+  toConcrete = lookupModule++-- Expression instance ----------------------------------------------------++instance ToConcrete A.Expr C.Expr where+    toConcrete (Var x)            = Ident . C.QName <$> toConcrete x+    toConcrete (Def x)            = Ident <$> toConcrete x+    toConcrete (Con (AmbQ (x:_))) = Ident <$> toConcrete x+    toConcrete (Con (AmbQ []))    = __IMPOSSIBLE__+	-- for names we have to use the name from the info, since the abstract+	-- name has been resolved to a fully qualified name (except for+	-- variables)+    toConcrete (A.Lit l)	    = return $ C.Lit l++    toConcrete (A.QuestionMark i)   = return $ C.QuestionMark+						(getRange i)+						(metaNumber i)+    toConcrete (A.Underscore i)	    = return $ C.Underscore+						(getRange i)+						(metaNumber i)++    toConcrete e@(A.App i e1 e2)    =+        tryToRecoverOpApp e+        -- or fallback to App+	$ bracket appBrackets+        $ do e1' <- toConcreteCtx FunctionCtx e1+	     e2' <- toConcreteCtx ArgumentCtx e2+	     return $ C.App (getRange i) e1' e2'++    toConcrete (A.WithApp i e es) =+      bracket withAppBrackets $ do+        e <- toConcreteCtx WithFunCtx e+	es <- mapM (toConcreteCtx WithArgCtx) es+	return $ C.WithApp (getRange i) e es++    toConcrete (A.AbsurdLam i h) =+      bracket lamBrackets $ return $ C.AbsurdLam (getRange i) h+    toConcrete e@(A.Lam i _ _)	    =+	bracket lamBrackets+	$ case lamView e of+	    (bs, e) ->+		bindToConcrete bs $ \bs -> do+		    e  <- toConcreteCtx TopCtx e+		    return $ C.Lam (getRange i) bs e+	where+	    lamView (A.Lam _ b@(A.DomainFree _ _) e) =+		case lamView e of+		    ([], e)			   -> ([b], e)+		    (bs@(A.DomainFree _ _ : _), e) -> (b:bs, e)+		    _				   -> ([b], e)+	    lamView (A.Lam _ b@(A.DomainFull _) e) =+		case lamView e of+		    ([], e)			   -> ([b], e)+		    (bs@(A.DomainFull _ : _), e)   -> (b:bs, e)+		    _				   -> ([b], e)+	    lamView e = ([], e)++    toConcrete (A.Pi _ [] e) = toConcrete e+    toConcrete t@(A.Pi i _ _)  = case piTel t of+      (tel, e) ->+	bracket piBrackets+	$ bindToConcrete tel $ \b' -> do+	     e' <- toConcreteCtx TopCtx e+	     return $ C.Pi b' e'+      where+	piTel (A.Pi _ tel e) = (tel ++) -*- id $ piTel e+	piTel e		     = ([], e)++    toConcrete (A.Fun i a b) =+	bracket piBrackets+	$ do a' <- toConcreteCtx FunctionSpaceDomainCtx a +	     b' <- toConcreteCtx TopCtx b+	     return $ C.Fun (getRange i) (mkArg a') b'+	where+	    mkArg (Arg Hidden	 e) = HiddenArg (getRange e) (unnamed e)+	    mkArg (Arg NotHidden e) = e++    toConcrete (A.Set i 0)  = return $ C.Set (getRange i)+    toConcrete (A.Set i n)  = return $ C.SetN (getRange i) n+    toConcrete (A.Prop i)   = return $ C.Prop (getRange i)++    toConcrete (A.Let i ds e) =+	bracket lamBrackets+	$ bindToConcrete ds $ \ds' -> do+	     e'  <- toConcreteCtx TopCtx e+	     return $ C.Let (getRange i) (concat ds') e'++    toConcrete (A.Rec i fs) =+      bracket appBrackets $ do+	let (xs, es) = unzip fs+	es <- toConcreteCtx TopCtx es+	return $ C.Rec (getRange i) $ zip xs es++    toConcrete (A.ScopedExpr _ e) = toConcrete e++-- Binder instances -------------------------------------------------------++instance ToConcrete A.LamBinding C.LamBinding where+    bindToConcrete (A.DomainFree h x) ret = bindToConcrete x $ ret . C.DomainFree h . mkBoundName_+    bindToConcrete (A.DomainFull b)   ret = bindToConcrete b $ ret . C.DomainFull++instance ToConcrete A.TypedBindings C.TypedBindings where+    bindToConcrete (A.TypedBindings r h bs) ret =+	bindToConcrete bs $ \bs ->+	ret (C.TypedBindings r h bs)++instance ToConcrete A.TypedBinding C.TypedBinding where+    bindToConcrete (A.TBind r xs e) ret =+	bindToConcrete xs $ \xs -> do+	e <- toConcreteCtx TopCtx e+	ret (C.TBind r (map mkBoundName_ xs) e)+    bindToConcrete (A.TNoBind e) ret = do+	e <- toConcreteCtx TopCtx e+	ret (C.TNoBind e)++instance ToConcrete LetBinding [C.Declaration] where+    bindToConcrete (LetBind i x t e) ret =+	bindToConcrete x $ \x ->+	do  (t,(e, [], [])) <- toConcrete (t, A.RHS e)+	    ret [C.TypeSig x t, C.FunClause (C.LHS (C.IdentP $ C.QName x) [] []) e C.NoWhere]+    bindToConcrete (LetApply i x tel y es _ _) ret = do+      x  <- unsafeQNameToName <$> toConcrete x+      y  <- toConcrete y+      bindToConcrete tel $ \tel -> do+      es <- toConcrete es+      let r = fuseRange y es+      ret [ C.ModuleMacro (getRange i) x tel+                  (foldl (C.App r) (C.Ident y) es) DontOpen+                  (ImportDirective r (Hiding []) [] False)+          ]+++-- Declaration instances --------------------------------------------------++instance ToConcrete [A.Declaration] [C.Declaration] where+    toConcrete ds = concat <$> mapM toConcrete ds++instance ToConcrete A.RHS (C.RHS, [C.Expr], [C.Declaration]) where+    toConcrete (A.RHS e) = do+      e <- toConcrete e+      return (C.RHS e, [], [])+    toConcrete A.AbsurdRHS = return (C.AbsurdRHS, [], [])+    toConcrete (A.WithRHS _ es cs) = do+      es <- toConcrete es+      cs <- toConcrete cs+      return (C.AbsurdRHS, es, concat cs)++data TypeAndDef = TypeAndDef A.TypeSignature A.Definition++instance ToConcrete TypeAndDef [C.Declaration] where+  -- We don't do withInfixDecl here. It's done at the declaration level.++  toConcrete (TypeAndDef (ScopedDecl scope [d]) def) =+    withScope scope $ toConcrete (TypeAndDef d def)++  toConcrete (TypeAndDef d (ScopedDef scope def)) =+    withScope scope $ toConcrete (TypeAndDef d def)++  toConcrete (TypeAndDef (Axiom _ x t) (FunDef i _ cs)) =+    withAbstractPrivate i $ do+    t'  <- toConcreteCtx TopCtx t+    cs' <- toConcrete cs+    x'  <- unsafeQNameToName <$> toConcrete x+    return $ TypeSig x' t' : concat cs'++  toConcrete (TypeAndDef (Axiom _ x t) (DataDef i _ ind bs cs)) =+    withAbstractPrivate i $+    bindToConcrete tel $ \tel' -> do+      t'       <- toConcreteCtx TopCtx t0+      (x',cs') <- (unsafeQNameToName -*- id) <$> toConcrete (x, map Constr cs)+      return [ C.Data (getRange i) ind x' tel' t' cs' ]+    where+      (tel, t0) = mkTel (length bs) t+      mkTel 0 t		   = ([], t)+      mkTel n (A.Pi _ b t) = (b++) -*- id $ mkTel (n - 1) t+      mkTel _ _		   = __IMPOSSIBLE__++  toConcrete (TypeAndDef (Axiom _ x t) (RecDef  i _ bs _ cs)) =+    withAbstractPrivate i $+    bindToConcrete tel $ \tel' -> do+      t'       <- toConcreteCtx TopCtx t0+      (x',cs') <- (unsafeQNameToName -*- id) <$> toConcrete (x, map Constr cs)+      return [ C.Record (getRange i) x' tel' t' cs' ]+    where+      (tel, t0) = mkTel (length bs) t+      mkTel 0 t		   = ([], t)+      mkTel n (A.Pi _ b t) = (b++) -*- id $ mkTel (n - 1) t+      mkTel _ _		   = __IMPOSSIBLE__++  toConcrete _ = __IMPOSSIBLE__++newtype Constr a = Constr a++instance ToConcrete (Constr A.Constructor) C.Declaration where+  toConcrete (Constr (A.ScopedDecl scope [d])) =+    withScope scope $ toConcrete (Constr d)+  toConcrete (Constr (A.Axiom i x t)) = do+    x' <- unsafeQNameToName <$> toConcrete x+    t' <- toConcreteCtx TopCtx t+    return $ C.TypeSig x' t'+  toConcrete _ = __IMPOSSIBLE__++instance ToConcrete A.Clause [C.Declaration] where+  toConcrete (A.Clause lhs rhs wh) =+      bindToConcrete lhs $ \(C.LHS p wps _) -> do+	  (rhs', with, wcs) <- toConcreteCtx TopCtx rhs+	  ds	     <- toConcrete wh+	  let wh' = case ds of+		[]  -> C.NoWhere+		_   -> C.AnyWhere ds+	  return $ FunClause (C.LHS p wps with) rhs' wh' : wcs++instance ToConcrete A.Declaration [C.Declaration] where+  toConcrete (ScopedDecl scope ds) =+    withScope scope $ toConcrete ds++  toConcrete (Axiom i x t) = do+    x' <- unsafeQNameToName <$> toConcrete x+    withAbstractPrivate	i $+      withInfixDecl i x'  $ do+      t' <- toConcreteCtx TopCtx t+      return [C.Postulate (getRange i) [C.TypeSig x' t']]++  toConcrete (A.Field i x t) = do+    x' <- unsafeQNameToName <$> toConcrete x+    withAbstractPrivate	i $+      withInfixDecl i x'  $ do+      t' <- toConcreteCtx TopCtx t+      return [C.Field x' t']++  toConcrete (A.Primitive i x t) = do+    x' <- unsafeQNameToName <$> toConcrete x+    withAbstractPrivate	i $+      withInfixDecl i x'  $ do+      t' <- toConcreteCtx TopCtx t+      return [C.Primitive (getRange i) [C.TypeSig x' t']]++  toConcrete (Definition i ts ds) = do+      ixs' <- map (id -*- unsafeQNameToName) <$> toConcrete (map (DontTouchMe -*- id) ixs)+      withInfixDecls ixs' $ do+	ds' <- concat <$> toConcrete (zipWith TypeAndDef ts ds)+	return [mutual (getRange i) ds']+      where+	  ixs = map getInfoAndName ts+	  is  = map fst ixs+	  getInfoAndName (A.Axiom i x _)	  = (i,x)+	  getInfoAndName (A.ScopedDecl scope [d]) = getInfoAndName d+	  getInfoAndName _			  = __IMPOSSIBLE__++	  mutual r [d] = d+	  mutual r ds  = C.Mutual r ds++  toConcrete (A.Section i x tel ds) = do+    x <- toConcrete x+    bindToConcrete tel $ \tel -> do+    ds <- toConcrete ds+    return [ C.Module (getRange i) x tel ds ]++  toConcrete (A.Apply i x tel y es _ _) = do+    x  <- unsafeQNameToName <$> toConcrete x+    y  <- toConcrete y+    bindToConcrete tel $ \tel -> do+    es <- toConcrete es+    let r = fuseRange y es+    return [ C.ModuleMacro (getRange i) x tel+		(foldl (C.App r) (C.Ident y) es) DontOpen+		(ImportDirective r (Hiding []) [] False)+	   ]++  toConcrete (A.Import i x) = do+    x <- toConcrete x+    return [ C.Import (getRange i) x Nothing DontOpen defaultImportDir ]++  toConcrete (A.Pragma i p)	= do+    p <- toConcrete $ RangeAndPragma (getRange i) p+    return [C.Pragma p]++data RangeAndPragma = RangeAndPragma Range A.Pragma++instance ToConcrete RangeAndPragma C.Pragma where+    toConcrete (RangeAndPragma r p) = case p of+	A.OptionsPragma xs  -> return $ C.OptionsPragma r xs+	A.BuiltinPragma b x -> do+          x <- toConcrete x+          return $ C.BuiltinPragma r b x+        A.CompiledTypePragma x hs -> do+          x <- toConcrete x+          return $ C.CompiledTypePragma r x hs+        A.CompiledDataPragma x hs hcs -> do+          x <- toConcrete x+          return $ C.CompiledDataPragma r x hs hcs+        A.CompiledPragma x hs -> do+          x <- toConcrete x+          return $ C.CompiledPragma r x hs++-- Left hand sides --------------------------------------------------------++noImplicitArgs = filter (noImplicit . namedThing . unArg)+noImplicitPats = filter noImplicit++noImplicit (A.ImplicitP _) = False+noImplicit _               = True++instance ToConcrete A.LHS C.LHS where+    bindToConcrete (A.LHS i x args wps) ret = do+      bindToConcreteCtx TopCtx (A.DefP info x args) $ \lhs ->+        bindToConcreteCtx TopCtx (noImplicitPats wps) $ \wps ->+          ret $ C.LHS lhs wps []+      where info = PatRange (getRange i)++appBrackets' :: [arg] -> Precedence -> Bool+appBrackets' []	   _   = False+appBrackets' (_:_) ctx = appBrackets ctx++-- TODO: bind variables properly+instance ToConcrete A.Pattern C.Pattern where+    toConcrete (VarP x)	   = toConcrete x >>= return . IdentP . C.QName+    toConcrete (A.WildP i)	   =+	return $ C.WildP (getRange i)+    toConcrete (ConP i (AmbQ []) args) = __IMPOSSIBLE__+    toConcrete p@(ConP i (AmbQ (x:_)) args) =+      tryToRecoverOpAppP p $+	bracketP_ (appBrackets' args) $ do+	    x <- toConcrete x+	    args <- toConcreteCtx ArgumentCtx (noImplicitArgs args)+	    return $ foldl AppP (C.IdentP x) args+    toConcrete p@(DefP i x args) =+      tryToRecoverOpAppP p $+	bracketP_ (appBrackets' args) $ do+	    x <- toConcrete x+	    args <- toConcreteCtx ArgumentCtx (noImplicitArgs args)+	    return $ foldl AppP (C.IdentP x) args+    toConcrete (A.AsP i x p)   = do+      (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 l)    = return $ C.LitP l+    toConcrete (A.DotP i e)  = do+	e <- toConcreteCtx DotPatternCtx e+	return $ C.DotP (getRange i) e+    -- just for debugging purposes (shouldn't show up in practise)+    toConcrete (A.ImplicitP i) = return $ C.IdentP (C.QName $ C.Name noRange [C.Id "(implicit)"])++-- Helpers for recovering C.OpApp ------------------------------------------++data Hd = HdVar A.Name | HdCon A.QName | HdDef A.QName++tryToRecoverOpApp :: A.Expr -> AbsToCon C.Expr -> AbsToCon C.Expr+tryToRecoverOpApp e def = recoverOpApp bracket C.OpApp view e def+  where+    view e = case AV.appView e of+      NonApplication _   -> Nothing+      Application h args -> Just (mkHd h, args)++    mkHd (HeadVar x)     = HdVar x+    mkHd (HeadCon (c:_)) = HdCon c+    mkHd (HeadCon [])    = __IMPOSSIBLE__+    mkHd (HeadDef f)     = HdDef f++tryToRecoverOpAppP :: A.Pattern -> AbsToCon C.Pattern -> AbsToCon C.Pattern+tryToRecoverOpAppP p def = recoverOpApp bracketP_ C.OpAppP view p def+  where+    view p = case p of+      ConP _ (AmbQ (c:_)) ps -> Just (HdCon c, ps)+      DefP _ f            ps -> Just (HdDef f, ps)+      _                      -> Nothing++recoverOpApp :: (ToConcrete a c, HasRange c) =>+                ((Precedence -> Bool) -> AbsToCon c -> AbsToCon c) ->+                (Range -> C.Name -> [c] -> c) -> (a -> Maybe (Hd, [NamedArg a])) -> a ->+                AbsToCon c -> AbsToCon c+recoverOpApp bracket opApp view e mdefault = case view e of+  Nothing -> mdefault+  Just (hd, args)+    | all notHidden args  -> do+      let  args' = map (namedThing . unArg) args+      case hd of+	HdVar n  -> do+	  x <- toConcrete n+	  doCName (nameFixity n) x args'+	HdDef qn -> doQName qn args'+	HdCon qn -> doQName qn args'+    | otherwise -> mdefault+  where++  notHidden (Arg h _) = h == NotHidden++  -- qualified names can't use mixfix syntax+  doQName qn as = do+    x <- toConcrete qn+    case x of+      C.QName x -> doCName (nameFixity $ qnameName qn) x as+      _		-> mdefault++  -- fall-back (wrong number of arguments or no holes)+  doCName _ cn@(C.Name _ xs) es+    | length es /= numHoles = mdefault+    | List.null es	    = mdefault+    where numHoles = length [ () | Hole <- xs ]+	  msg = "doCName " ++ showList xs "" ++ " on " ++ show (length es) ++ " args"++  -- binary case+  doCName fixity cn@(C.Name _ xs) as+    | Hole <- head xs+    , Hole <- last xs = do+	let a1	   = head as+	    an	   = last as+	    as'	   = init $ tail as+	e1 <- toConcreteCtx (LeftOperandCtx fixity) a1+	es <- mapM (toConcreteCtx InsideOperandCtx) as'+	en <- toConcreteCtx (RightOperandCtx fixity) an+	bracket (opBrackets fixity)+	    $ return $ opApp (getRange (e1,en)) cn ([e1] ++ es ++ [en])++  -- prefix+  doCName fixity cn@(C.Name _ xs) as+    | Hole <- last xs = do+	let an	= last as+	    as' = init as+	es <- mapM (toConcreteCtx InsideOperandCtx) as'+	en <- toConcreteCtx (RightOperandCtx fixity) an+	bracket (opBrackets fixity)+	    $ return $ opApp (getRange (cn,en)) cn (es ++ [en])++  -- postfix+  doCName fixity cn@(C.Name _ xs) as+    | Hole <- head xs = do+	let a1	   = head as+	    as'	   = tail as+	e1 <- toConcreteCtx (LeftOperandCtx fixity) a1+	es <- mapM (toConcreteCtx InsideOperandCtx) as'+	bracket (opBrackets fixity)+	    $ return $ opApp (getRange (e1,cn)) cn ([e1] ++ es)++  -- roundfix+  doCName _ cn as = do+    es <- mapM (toConcreteCtx InsideOperandCtx) as+    bracket roundFixBrackets+      $ return $ opApp (getRange cn) cn es+

+ src/full/Agda/Syntax/Translation/ConcreteToAbstract.hs view

@@ -0,0 +1,941 @@+{-# LANGUAGE CPP, MultiParamTypeClasses, FunctionalDependencies,+             FlexibleInstances, UndecidableInstances, OverlappingInstances+  #-}++{-| Translation from "Agda.Syntax.Concrete" to "Agda.Syntax.Abstract". Involves scope analysis,+    figuring out infix operator precedences and tidying up definitions.+-}+module Agda.Syntax.Translation.ConcreteToAbstract+    ( ToAbstract(..), localToAbstract+    , concreteToAbstract_+    , concreteToAbstract+    , NewModuleQName(..)+    , OldName(..)+    , TopLevel(..)+    , TopLevelInfo(..)+    , topLevelModuleName+    ) where++import Prelude hiding (mapM)+import Control.Applicative+import Control.Monad.Reader hiding (mapM)+import Control.Monad.Error hiding (mapM)+import Data.Typeable+import Data.Traversable (mapM)+import Data.List ((\\), nub)++import Agda.Syntax.Concrete as C+import Agda.Syntax.Abstract as A+import Agda.Syntax.Position+import Agda.Syntax.Common+import Agda.Syntax.Info+import Agda.Syntax.Concrete.Definitions as C+import Agda.Syntax.Concrete.Operators+import Agda.Syntax.Fixity+import Agda.Syntax.Scope.Base+import Agda.Syntax.Scope.Monad+import Agda.Syntax.Strict++import Agda.TypeChecking.Monad.Base (TypeError(..), Call(..), typeError, TCErr(..))+import Agda.TypeChecking.Monad.Trace (traceCall, traceCallCPS, setCurrentRange)+import Agda.TypeChecking.Monad.State+import Agda.TypeChecking.Monad.Options++import {-# SOURCE #-} Agda.Interaction.Imports (scopeCheckImport)++import Agda.Utils.Monad+import Agda.Utils.Tuple+import Agda.Utils.List+import Agda.Utils.Fresh++#include "../../undefined.h"+import Agda.Utils.Impossible+++{--------------------------------------------------------------------------+    Exceptions+ --------------------------------------------------------------------------}++notAModuleExpr e	    = typeError $ NotAModuleExpr e+notAnExpression e	    = typeError $ NotAnExpression e+notAValidLetBinding d	    = typeError $ NotAValidLetBinding d+nothingAppliedToHiddenArg e = typeError $ NothingAppliedToHiddenArg e++-- Debugging++printLocals :: Int -> String -> ScopeM ()+printLocals v s = verboseS "scope.top" v $ do+  locals <- scopeLocals <$> getScope+  reportSLn "" 0 $ s ++ " " ++ show locals++printScope :: String -> Int -> String -> ScopeM ()+printScope tag v s = verboseS ("scope." ++ tag) v $ do+  scope <- getScope+  reportSLn "" 0 $ s ++ " " ++ show scope++{--------------------------------------------------------------------------+    Helpers+ --------------------------------------------------------------------------}++lhsArgs :: C.Pattern -> (C.Name, [NamedArg C.Pattern])+lhsArgs p = case appView p of+    Arg _ (Named _ (IdentP (C.QName x))) : ps -> (x, ps)+    _				              -> __IMPOSSIBLE__+    where+	mkHead	  = Arg NotHidden . unnamed+	notHidden = Arg NotHidden . unnamed+	appView p = case p of+	    AppP p arg	  -> appView p ++ [arg]+	    OpAppP _ x ps -> mkHead (IdentP $ C.QName x) : map notHidden ps+	    ParenP _ p	  -> appView p+	    RawAppP _ _	  -> __IMPOSSIBLE__+	    _		  -> [ mkHead p ]++annotateDecl :: ScopeM A.Declaration -> ScopeM A.Declaration+annotateDecl m = annotateDecls $ (:[]) <$> m++annotateDecls :: ScopeM [A.Declaration] -> ScopeM A.Declaration+annotateDecls m = do+  ds <- m+  s  <- getScope+  return $ ScopedDecl s ds++annotateDefn :: ScopeM A.Definition -> ScopeM A.Definition+annotateDefn m = do+  d <- m+  s <- getScope+  return $ ScopedDef s d++annotateExpr :: ScopeM A.Expr -> ScopeM A.Expr+annotateExpr m = do+  e <- m+  s <- getScope+  return $ ScopedExpr s e++expandEllipsis :: C.Pattern -> [C.Pattern] -> C.Clause -> C.Clause+expandEllipsis _ _ c@(C.Clause _ (C.LHS _ _ _) _ _ _) = c+expandEllipsis p ps (C.Clause x (C.Ellipsis _ ps' es) rhs wh wcs) =+  C.Clause x (C.LHS p (ps ++ ps') es) rhs wh wcs++-- | Make sure that each variable occurs only once.+checkPatternLinearity :: [A.Pattern' e] -> ScopeM ()+checkPatternLinearity ps = case xs \\ nub xs of+    []	-> return ()+    ys	-> typeError $ RepeatedVariablesInPattern $ nub ys+  where+    xs = concatMap vars ps+    vars :: A.Pattern' e -> [C.Name]+    vars p = case p of+      A.VarP x	      -> [nameConcrete x]+      A.ConP _ _ args -> concatMap (vars . namedThing . unArg) args+      A.WildP _	      -> []+      A.AsP _ x p     -> nameConcrete x : vars p+      A.DotP _ _      -> []+      A.AbsurdP _     -> []+      A.LitP _	      -> []+      A.DefP _ _ args -> __IMPOSSIBLE__+      A.ImplicitP _   -> __IMPOSSIBLE__++-- | Compute the type of the record constructor (with bogus target type)+recordConstructorType :: [NiceDeclaration] -> C.Expr+recordConstructorType fields = build fs+  where+    fs = reverse $ dropWhile notField $ reverse fields++    notField NiceField{} = False+    notField _           = True++    build (NiceField r f _ _ x e : fs) = C.Pi [C.TypedBindings r NotHidden+                                                [C.TBind r [BName x f] e]+                                              ] $ build fs+      where r = getRange x+    build (d : fs)                     = C.Let noRange (notSoNiceDeclarations [d]) $ build fs+    build []                           = C.Prop noRange++checkModuleMacro apply r p a x tel m args open dir =+    withLocalVars $ do+    tel' <- toAbstract tel+    (x',m1,args') <- toAbstract ( NewModuleName x+                                , OldModuleName m+                                , args+                                )+    printScope "mod.inst" 20 "module macro"+    pushScope x'+    m0 <- getCurrentModule+    openModule_ m $ dir { C.publicOpen = True }+    printScope "mod.inst" 20 "opened source module"+    s : _ <- scopeStack <$> getScope+    (renD, renM) <- renamedCanonicalNames m1 m0 s+    modifyTopScope $ renameCanonicalNames renD renM+    printScope "mod.inst" 20 "renamed stuff"+    popScope p+    printScope "mod.inst" 20 "popped"+    bindModule p x m0+    case open of+      DontOpen -> return ()+      DoOpen   -> openModule_ (C.QName x) $ defaultImportDir { C.publicOpen = C.publicOpen dir }+    printScope "mod.inst" 20 $ case open of+      DontOpen  -> "didn't open"+      DoOpen    -> "opened"+    printScope "mod.inst" 10 $ "before stripping"+    stripNoNames+    printScope "mod.inst" 10 $ "after stripping"+    return [ apply info (m0 `withRangesOf` [x]) tel' m1 args' renD renM ]+  where+    info = ModuleInfo p a r++{--------------------------------------------------------------------------+    Translation+ --------------------------------------------------------------------------}++concreteToAbstract_ :: ToAbstract c a => c -> ScopeM a+concreteToAbstract_ x = toAbstract x++concreteToAbstract :: ToAbstract c a => ScopeInfo -> c -> ScopeM a+concreteToAbstract scope x = withScope_ scope (toAbstract x)++-- | Things that can be translated to abstract syntax are instances of this+--   class.+class ToAbstract concrete abstract | concrete -> abstract where+    toAbstract	  :: concrete -> ScopeM abstract++-- | This function should be used instead of 'toAbstract' for things that need+--   to keep track of precedences to make sure that we don't forget about it.+toAbstractCtx :: ToAbstract concrete abstract =>+		 Precedence -> concrete -> ScopeM abstract+toAbstractCtx ctx c = withContextPrecedence ctx $ toAbstract c++setContextCPS :: Precedence -> (a -> ScopeM b) ->+		 ((a -> ScopeM b) -> ScopeM b) -> ScopeM b+setContextCPS p ret f = do+  p' <- getContextPrecedence+  withContextPrecedence p $ f $ withContextPrecedence p' . ret++localToAbstractCtx :: ToAbstract concrete abstract =>+		     Precedence -> concrete -> (abstract -> ScopeM a) -> ScopeM a+localToAbstractCtx ctx c ret = setContextCPS ctx ret (localToAbstract c)++-- | This operation does not affect the scope, i.e. the original scope+--   is restored upon completion.+localToAbstract :: ToAbstract c a => c -> (a -> ScopeM b) -> ScopeM b+localToAbstract x ret = fst <$> localToAbstract' x ret++-- | Like 'localToAbstract' but returns the scope after the completion of the+--   second argument.+localToAbstract' :: ToAbstract c a => c -> (a -> ScopeM b) -> ScopeM (b, ScopeInfo)+localToAbstract' x ret = do+  scope <- getScope+  withScope scope $ ret =<< toAbstract x++instance (ToAbstract c1 a1, ToAbstract c2 a2) => ToAbstract (c1,c2) (a1,a2) where+  toAbstract (x,y) =+    (,) <$> toAbstract x <*> toAbstract y++instance (ToAbstract c1 a1, ToAbstract c2 a2, ToAbstract c3 a3) =>+	 ToAbstract (c1,c2,c3) (a1,a2,a3) where+    toAbstract (x,y,z) = flatten <$> toAbstract (x,(y,z))+	where+	    flatten (x,(y,z)) = (x,y,z)++instance ToAbstract c a => ToAbstract [c] [a] where+    toAbstract = mapM toAbstract ++instance ToAbstract c a => ToAbstract (Maybe c) (Maybe a) where+    toAbstract Nothing  = return Nothing+    toAbstract (Just x) = Just <$> toAbstract x++-- Names ------------------------------------------------------------------++newtype NewName a = NewName a+newtype OldQName  = OldQName C.QName+newtype OldName   = OldName C.Name+newtype PatName   = PatName C.QName++instance ToAbstract (NewName C.Name) A.Name where+  toAbstract (NewName x) = do+    y <- freshAbstractName_ x+    bindVariable x y+    return y++instance ToAbstract (NewName C.BoundName) A.Name where+  toAbstract (NewName (BName x fx)) = do+    y <- freshAbstractName fx x+    bindVariable x y+    return y++nameExpr :: AbstractName -> A.Expr+nameExpr d = mk (anameKind d) $ anameName d+  where+    mk DefName = Def+    mk ConName = Con . AmbQ . (:[])++instance ToAbstract OldQName A.Expr where+  toAbstract (OldQName x) = do+    qx <- resolveName x+    reportSLn "scope.name" 10 $ "resolved " ++ show x ++ ": " ++ show qx+    case qx of+      VarName x'         -> return $ A.Var x'+      DefinedName d      -> return $ nameExpr d+      ConstructorName ds -> return $ A.Con $ AmbQ (map anameName ds)+      UnknownName        -> notInScope x++data APatName = VarPatName A.Name+	      | ConPatName [AbstractName]++instance ToAbstract PatName APatName where+  toAbstract (PatName x) = do+    reportSLn "scope.pat" 10 $ "checking pattern name: " ++ show x+    rx <- resolveName x+    z  <- case (rx, x) of+      -- TODO: warn about shadowing+      (VarName y,     C.QName x)			  -> return $ Left x -- typeError $ RepeatedVariableInPattern y x+      (DefinedName d, C.QName x) | DefName == anameKind d -> return $ Left x+      (UnknownName,   C.QName x)			  -> return $ Left x+      (ConstructorName ds, _)	                          -> return $ Right ds+      _							  -> fail $ "not a constructor: " ++ show x -- TODO+    case z of+      Left x  -> do+	reportSLn "scope.pat" 10 $ "it was a var: " ++ show x+	p <- VarPatName <$> toAbstract (NewName x)+	printLocals 10 "bound it:"+	return p+      Right cs -> do+	reportSLn "scope.pat" 10 $ "it was a con: " ++ show (map anameName cs)+	return $ ConPatName cs++-- Should be a defined name.+instance ToAbstract OldName A.QName where+  toAbstract (OldName x) = do+    rx <- resolveName (C.QName x)+    case rx of+      DefinedName d -> return $ anameName d+      _		    -> __IMPOSSIBLE__++newtype NewModuleName  = NewModuleName  C.Name+newtype NewModuleQName = NewModuleQName C.QName+newtype OldModuleName  = OldModuleName  C.QName++instance ToAbstract NewModuleName A.ModuleName where+  toAbstract (NewModuleName x) = mnameFromList . (:[]) <$> freshAbstractName_ x++instance ToAbstract NewModuleQName A.ModuleName where+  toAbstract (NewModuleQName q) = do+    ms <- resolveModule' q+    case ms of+      [] -> foldr1 A.qualifyM <$> mapM (toAbstract . NewModuleName) (toList q)+      ms -> typeError $ ShadowedModule $+                          map ((`withRangesOfQ` q) . amodName) ms+    where+      toList (C.QName  x) = [x]+      toList (C.Qual m x) = m : toList x++instance ToAbstract OldModuleName A.ModuleName where+  toAbstract (OldModuleName q) = amodName <$> resolveModule q++-- Expressions ------------------------------------------------------------++-- | Peel off 'C.HiddenArg' and represent it as an 'NamedArg'.+mkNamedArg :: C.Expr -> NamedArg C.Expr+mkNamedArg (C.HiddenArg _ e) = Arg Hidden e+mkNamedArg e		     = Arg NotHidden $ unnamed e++-- | Peel off 'C.HiddenArg' and represent it as an 'Arg', throwing away any name.+mkArg :: C.Expr -> Arg C.Expr+mkArg (C.HiddenArg _ e) = Arg Hidden $ namedThing e+mkArg e			= Arg NotHidden e++instance ToAbstract C.Expr A.Expr where+  toAbstract e =+    traceCall (ScopeCheckExpr e) $ annotateExpr $ case e of+  -- Names+      Ident x -> toAbstract (OldQName x)++  -- Literals+      C.Lit l -> return $ A.Lit l++  -- Meta variables+      C.QuestionMark r n -> do+	scope <- getScope+	return $ A.QuestionMark $ MetaInfo+		    { metaRange  = r+		    , metaScope  = scope+		    , metaNumber = n+		    }+      C.Underscore r n -> do+	scope <- getScope+	return $ A.Underscore $ MetaInfo+		    { metaRange  = r+		    , metaScope  = scope+		    , metaNumber = n+		    }++  -- Raw application+      C.RawApp r es -> do+	e <- parseApplication es+	toAbstract e++  -- Application+      C.App r e1 e2 -> do+	e1 <- toAbstractCtx FunctionCtx e1+	e2 <- toAbstractCtx ArgumentCtx e2+	return $ A.App (ExprRange r) e1 e2++  -- Operator application+      C.OpApp r op es -> toAbstractOpApp op es++  -- With application+      C.WithApp r e es -> do+	e  <- toAbstractCtx WithFunCtx e+	es <- mapM (toAbstractCtx WithArgCtx) es+	return $ A.WithApp (ExprRange r) e es++  -- Malplaced hidden argument+      C.HiddenArg _ _ -> nothingAppliedToHiddenArg e++  -- Lambda+      C.AbsurdLam r h -> return $ A.AbsurdLam (ExprRange r) h++      e0@(C.Lam r bs e) -> do+	localToAbstract bs $ \(b:bs') -> do+	e	 <- toAbstractCtx TopCtx e+	let info = ExprRange r+	return $ A.Lam info b $ foldr mkLam e bs'+	where+	    mkLam b e = A.Lam (ExprRange $ fuseRange b e) b e++  -- Function types+      C.Fun r e1 e2 -> do+	e1 <- toAbstractCtx FunctionSpaceDomainCtx $ mkArg e1+	e2 <- toAbstractCtx TopCtx e2+	let info = ExprRange r+	return $ A.Fun info e1 e2++      e0@(C.Pi tel e) ->+	localToAbstract tel $ \tel -> do+	e    <- toAbstractCtx TopCtx e+	let info = ExprRange (getRange e0)+	return $ A.Pi info tel e++  -- Sorts+      C.Set _    -> return $ A.Set (ExprRange $ getRange e) 0+      C.SetN _ n -> return $ A.Set (ExprRange $ getRange e) n+      C.Prop _   -> return $ A.Prop $ ExprRange $ getRange e++  -- Let+      e0@(C.Let _ ds e) ->+	localToAbstract (LetDefs ds) $ \ds' -> do+	e	 <- toAbstractCtx TopCtx e+	let info = ExprRange (getRange e0)+	return $ A.Let info ds' e++  -- Record construction+      C.Rec r fs  -> do+	let (xs, es) = unzip fs+	es <- toAbstractCtx TopCtx es+	return $ A.Rec (ExprRange r) $ zip xs es++  -- Parenthesis+      C.Paren _ e -> toAbstractCtx TopCtx e++  -- Pattern things+      C.As _ _ _ -> notAnExpression e+      C.Dot _ _  -> notAnExpression e+      C.Absurd _ -> notAnExpression e++instance ToAbstract C.LamBinding A.LamBinding where+  toAbstract (C.DomainFree h x) = A.DomainFree h <$> toAbstract (NewName x)+  toAbstract (C.DomainFull tb)	= A.DomainFull <$> toAbstract tb++instance ToAbstract C.TypedBindings A.TypedBindings where+  toAbstract (C.TypedBindings r h bs) = A.TypedBindings r h <$> toAbstract bs++instance ToAbstract C.TypedBinding A.TypedBinding where+  toAbstract (C.TBind r xs t) = do+    t' <- toAbstractCtx TopCtx t+    xs' <- toAbstract (map NewName xs)+    return $ A.TBind r xs' t'+  toAbstract (C.TNoBind e) = do+    e <- toAbstractCtx TopCtx e+    return (A.TNoBind e)++newtype TopLevel a = TopLevel a++-- | Returns the scope inside the checked module.+scopeCheckModule :: Range -> Access -> IsAbstract -> C.QName -> A.ModuleName -> C.Telescope -> [C.Declaration] ->+		    ScopeM (ScopeInfo, [A.Declaration])+scopeCheckModule r a c x m tel ds = do+  pushScope m+  qm <- getCurrentModule+  ds <- withLocalVars $ do+	  tel <- toAbstract tel+	  (:[]) . A.Section info (qm `withRangesOfQ` x) tel <$>+            toAbstract ds+  scope <- getScope+  popScope a+  bindQModule a x qm+  return (scope, ds)+  where+    info = ModuleInfo a c r++data TopLevelInfo = TopLevelInfo+	{ topLevelDecls :: [A.Declaration]+	, outsideScope  :: ScopeInfo+	, insideScope	:: ScopeInfo+	}++-- | The top-level module name.++topLevelModuleName :: TopLevelInfo -> A.ModuleName+topLevelModuleName topLevel = case scopeStack (insideScope topLevel) of+  []    -> __IMPOSSIBLE__+  s : _ -> scopeName s++-- Top-level declarations are always (import|open)* module+instance ToAbstract (TopLevel [C.Declaration]) TopLevelInfo where+    toAbstract (TopLevel ds) = case splitAt (length ds - 1) ds of+	(ds', [C.Module r m tel ds]) -> do+	  setTopLevelModule m+	  am	       <- toAbstract (NewModuleQName m)+	  ds'	       <- toAbstract ds'+	  (scope0, ds) <- scopeCheckModule r PublicAccess ConcreteDef m am tel ds+	  scope	       <- getScope+	  return $ TopLevelInfo (ds' ++ ds) scope scope0+	_ -> __IMPOSSIBLE__+++niceDecls :: [C.Declaration] -> ScopeM [NiceDeclaration]+niceDecls ds = case runNice $ niceDeclarations ds of+  Left e   -> throwError $ Exception (getRange e) (show e)+  Right ds -> return ds++instance ToAbstract [C.Declaration] [A.Declaration] where+  toAbstract ds = toAbstract =<< niceDecls ds++newtype LetDefs = LetDefs [C.Declaration]+newtype LetDef = LetDef NiceDeclaration++instance ToAbstract LetDefs [A.LetBinding] where+    toAbstract (LetDefs ds) =+	concat <$> (toAbstract =<< map LetDef <$> niceDecls ds)++instance ToAbstract LetDef [A.LetBinding] where+    toAbstract (LetDef d) =+	case d of+	    NiceDef _ c [C.Axiom _ _ _ _ x t] [C.FunDef _ _ _ _ _ _ [cl]] ->+		do  e <- letToAbstract cl+		    t <- toAbstract t+		    x <- toAbstract (NewName x)+		    return [ A.LetBind (LetRange $ getRange c) x t e ]++            -- You can't open public in a let+            NiceOpen r x dirs | not (C.publicOpen dirs) -> do+              m	      <- toAbstract (OldModuleName x)+              n	      <- length . scopeLocals <$> getScope+              openModule_ x dirs+              return []++            NiceModuleMacro r p a x tel e open dir | not (C.publicOpen dir) -> case appView e of+              AppView (Ident m) args -> checkModuleMacro LetApply r p a x tel m args open dir+              _                      -> notAModuleExpr e++	    _	-> notAValidLetBinding d+	where+	    letToAbstract (C.Clause top clhs@(C.LHS p [] []) (C.RHS rhs) NoWhere []) = do+		p    <- parseLHS (Just top) p+		localToAbstract (snd $ lhsArgs p) $ \args ->+		    do	rhs <- toAbstract rhs+			foldM lambda rhs (reverse args)  -- just reverse because these DomainFree+	    letToAbstract _ = notAValidLetBinding d++	    -- Named patterns not allowed in let definitions+	    lambda e (Arg h (Named Nothing (A.VarP x))) = return $ A.Lam i (A.DomainFree h x) e+		where+		    i = ExprRange (fuseRange x e)+	    lambda e (Arg h (Named Nothing (A.WildP i))) =+		do  x <- freshNoName (getRange i)+		    return $ A.Lam i' (A.DomainFree h x) e+		where+		    i' = ExprRange (fuseRange i e)+	    lambda _ _ = notAValidLetBinding d++instance ToAbstract C.Pragma [A.Pragma] where+    toAbstract (C.OptionsPragma _ opts) = return [ A.OptionsPragma opts ]+    toAbstract (C.CompiledTypePragma _ x hs) = do+      e <- toAbstract $ OldQName x+      case e of+        A.Def x -> return [ A.CompiledTypePragma x hs ]+        _       -> fail $ "Bad compiled type: " ++ show x  -- TODO: error message+    toAbstract (C.CompiledDataPragma _ x hs hcs) = do+      e <- toAbstract $ OldQName x+      case e of+        A.Def x -> return [ A.CompiledDataPragma x hs hcs ]+        _       -> fail $ "Not a datatype: " ++ show x  -- TODO: error message+    toAbstract (C.CompiledPragma _ x hs) = do+      e <- toAbstract $ OldQName x+      y <- case e of+            A.Def x -> return x+            A.Con _ -> fail "Use HASKELL_DATA for constructors" -- TODO+            _       -> __IMPOSSIBLE__+      return [ A.CompiledPragma y hs ]+    toAbstract (C.BuiltinPragma _ b e) = do+	e <- toAbstract e+	return [ A.BuiltinPragma b e ]+    toAbstract (C.LinePragma _ _ _) = return []+    toAbstract (C.ImportPragma _ i) = do+      addHaskellImport i+      return []++-- Only constructor names are bound by definitions.+instance ToAbstract NiceDefinition Definition where++    toAbstract d = annotateDefn $ case d of++    -- Function definitions+      C.FunDef r ds f p a x cs ->+        traceCall (ScopeCheckDefinition d) $ do+          (x',cs') <- toAbstract (OldName x,cs)+          return $ A.FunDef (mkDefInfo x f p a r) x' cs'++    -- Data definitions+      C.DataDef r ind f p a x pars cons ->+        traceCall (ScopeCheckDefinition d) $+        withLocalVars $ do++          -- Check for duplicate constructors+          do let cs   = map conName cons+                 dups = nub $ cs \\ nub cs+                 bad  = filter (`elem` dups) cs+             unless (distinct cs) $ +               setCurrentRange (getRange bad) $+                  typeError $ DuplicateConstructors dups++          pars <- toAbstract pars+          cons <- toAbstract (map Constr cons)+          x'   <- toAbstract (OldName x)+          printScope "data" 20 $ "Checked data " ++ show x+          return $ A.DataDef (mkDefInfo x f p a r) x' ind pars cons+        where+          conName (C.Axiom _ _ _ _ c _) = c+          conName _ = __IMPOSSIBLE__++    -- Record definitions (mucho interesting)+      C.RecDef r f p a x pars fields ->+        traceCall (ScopeCheckDefinition d) $+        withLocalVars $ do+          pars   <- toAbstract pars+          x'     <- toAbstract (OldName x)+          contel <- toAbstract $ recordConstructorType fields+          let m = mnameFromList $ (:[]) $ last $ qnameToList x'+          printScope "rec" 15 "before record"+          pushScope m+          afields <- toAbstract fields+          printScope "rec" 15 "checked fields"+          qm <- getCurrentModule+          popScope p+          bindModule p x qm+          printScope "rec" 15 "record complete"+          return $ A.RecDef (mkDefInfo x f p a r) x' pars contel afields++-- The only reason why we return a list is that open declarations disappears.+-- For every other declaration we get a singleton list.+instance ToAbstract NiceDeclaration A.Declaration where++  toAbstract d = annotateDecls $+    traceCall (ScopeCheckDeclaration d) $+    case d of++  -- Axiom+    C.Axiom r f p a x t -> do+      t' <- toAbstractCtx TopCtx t+      y  <- freshAbstractQName f x+      bindName p DefName x y+      return [ A.Axiom (mkDefInfo x f p a r) y t' ]++  -- Fields+    C.NiceField r f p a x t -> do+      t' <- toAbstractCtx TopCtx t+      y  <- freshAbstractQName f x+      bindName p DefName x y+      return [ A.Field (mkDefInfo x f p a r) y t' ]++  -- Primitive function+    PrimitiveFunction r f p a x t -> do+      t' <- toAbstractCtx TopCtx t+      y  <- freshAbstractQName f x+      bindName p DefName x y+      return [ A.Primitive (mkDefInfo x f p a r) y t' ]++  -- Definitions (possibly mutual)+    NiceDef r cs ts ds -> do+      (ts', ds') <- toAbstract (ts, ds)+      return [ Definition (DeclInfo C.noName_ r) ts' ds' ]+			  -- TODO: what does the info mean here?++  -- TODO: what does an abstract module mean? The syntax doesn't allow it.+    NiceModule r p a name tel ds -> do+      aname <- toAbstract (NewModuleQName name)+      snd <$> scopeCheckModule r p a name aname tel ds++    NiceModuleMacro r p a x tel e open dir -> case appView e of+      AppView (Ident m) args -> checkModuleMacro Apply r p a x tel m args open dir+      _                      -> notAModuleExpr e++    NiceOpen r x dir -> do+      m	      <- toAbstract (OldModuleName x)+      n	      <- length . scopeLocals <$> getScope++      printScope "open" 20 $ "opening " ++ show x+      -- Opening (privately) a submodule or opening into a non-parameterised module+      -- is fine. Otherwise we have to create a temporary module.+      if not (C.publicOpen dir) -- && (m `isSubModuleOf` current || n == 0)+	then do+	  reportSLn "scope.open" 20 "normal open"+	  openModule_ x dir+	  printScope "open" 20 $ "result:"+	  return []+	else do+	  reportSLn "scope.open" 20 "fancy open"+	  tmp <- nameConcrete <$> freshNoName (getRange x)+	  d   <- toAbstract $ NiceModuleMacro r PrivateAccess ConcreteDef+					    tmp [] (C.Ident x) DoOpen dir+	  printScope "open" 20 "result:"+	  return [d]++    NicePragma r p -> do+      ps <- toAbstract p+      return $ map (A.Pragma r) ps++    NiceImport r x as open dir -> do++      -- First scope check the imported module and return its name and+      -- interface. This is done with that module as the top-level module.+      (m, i) <- withTopLevelModule x $ do+	m <- toAbstract $ NewModuleQName x+	printScope "import" 10 "before import:"+	(m, i) <- scopeCheckImport m+	printScope "import" 10 $ "scope checked import: " ++ show i+	return (m, i)++      -- Abstract name for the imported module.+      m' <- case as of+	      Nothing -> return m+	      Just y  -> toAbstract $ NewModuleName y++      -- Now, we push a new scope with the name we want for the imported+      -- module containing its interface. We then do a public open on the+      -- imported module and pop the scope. This results in the concrete names+      -- getting renamed to use the "as" name (if any).+      pushScope m'+      modifyTopScope (`mergeScope` setScopeAccess PrivateAccess i)+      openModule_ x $ dir { publicOpen = True }+      popScope PrivateAccess++      -- Finally we bind the desired module name to the right abstract name.+      bindQModule PrivateAccess name m++      printScope "import" 10 "merged imported sig:"+      ds <- case open of+	DontOpen -> return []+	DoOpen   -> do+	  toAbstract [ C.Open r name dir { usingOrHiding = Hiding []+					 , renaming	 = []+					 }+		     ]+      return $ A.Import (ModuleInfo PublicAccess ConcreteDef r) m : ds+      where+	  name = maybe x C.QName as++newtype Constr a = Constr a++instance ToAbstract (Constr C.NiceDeclaration) A.Declaration where+    toAbstract (Constr (C.Axiom r f p a x t)) = do+	t' <- toAbstractCtx TopCtx t+	y  <- freshAbstractQName f x+	bindName p' ConName x y+	return $ A.Axiom (mkDefInfo x f p a r) y t'+	where+	    -- An abstract constructor is private (abstract constructor means+	    -- abstract datatype, so the constructor should not be exported).+	    p' = case (a, p) of+		    (AbstractDef, _) -> PrivateAccess+		    (_, p)	     -> p++    toAbstract _ = __IMPOSSIBLE__    -- a constructor is always an axiom++instance ToAbstract C.Clause A.Clause where+    toAbstract (C.Clause top (C.Ellipsis _ _ _) _ _ _) = fail "bad '...'" -- TODO: errors message+    toAbstract (C.Clause top lhs@(C.LHS p wps with) rhs wh wcs) = withLocalVars $ do+      let wcs' = map (expandEllipsis p wps) wcs+      lhs' <- toAbstract (LeftHandSide top p wps)+      printLocals 10 "after lhs:"+      let (whname, whds) = case wh of+	    NoWhere	   -> (Nothing, [])+	    AnyWhere ds	   -> (Nothing, ds)+	    SomeWhere m ds -> (Just m, ds)+      case whds of+	[] -> do+	  rhs <- toAbstract =<< toAbstractCtx TopCtx (RightHandSide with wcs' rhs)+	  return $ A.Clause lhs' rhs []+	_	-> do+	  m <- C.QName <$> maybe (nameConcrete <$> freshNoName noRange) return whname+	  let acc = maybe PrivateAccess (const PublicAccess) whname  -- unnamed where's are private+	  let tel = []+	  am <- toAbstract (NewModuleQName m)+	  (scope, ds) <- scopeCheckModule (getRange wh) acc ConcreteDef m am tel whds+	  setScope scope+	  -- the right hand side is checked inside the module of the local definitions+	  rhs <- toAbstractCtx TopCtx (RightHandSide with wcs' rhs)+	  qm <- getCurrentModule+	  case acc of+	    PublicAccess  -> popScope PublicAccess+	    PrivateAccess -> popScope_	-- unnamed where clauses are not in scope+	  bindQModule acc m qm+          rhs <- toAbstract rhs+	  return $ A.Clause lhs' rhs ds++data RightHandSide = RightHandSide [C.Expr] [C.Clause] C.RHS+data AbstractRHS = AbsurdRHS'+                 | WithRHS' [A.Expr] [C.Clause]  -- ^ The with clauses haven't been translated yet+                 | RHS' A.Expr++instance ToAbstract AbstractRHS A.RHS where+  toAbstract AbsurdRHS'       = return A.AbsurdRHS+  toAbstract (RHS' e)         = return $ A.RHS e+  toAbstract (WithRHS' es cs) = do+    m   <- getCurrentModule+    -- Hack+    NameId i _ <- fresh+    aux <- A.qualify m <$> freshName_ ("aux" ++ show i)+    A.WithRHS aux es <$> toAbstract cs++instance ToAbstract RightHandSide AbstractRHS where+  toAbstract (RightHandSide [] (_ : _) _)        = __IMPOSSIBLE__+  toAbstract (RightHandSide (_ : _) _ (C.RHS _)) = typeError $ BothWithAndRHS+  toAbstract (RightHandSide [] [] rhs)           = toAbstract rhs+  toAbstract (RightHandSide es cs C.AbsurdRHS)   = do+    es <- toAbstractCtx TopCtx es+    return $ WithRHS' es cs++instance ToAbstract C.RHS AbstractRHS where+    toAbstract C.AbsurdRHS = return $ AbsurdRHS'+    toAbstract (C.RHS e)   = RHS' <$> toAbstract e++data LeftHandSide = LeftHandSide C.Name C.Pattern [C.Pattern]++instance ToAbstract LeftHandSide A.LHS where+    toAbstract (LeftHandSide top lhs wps) =+      traceCall (ScopeCheckLHS top lhs) $ do+	p <- parseLHS (Just top) lhs+	printLocals 10 "before lhs:"+        let (x, ps) = lhsArgs p+	x    <- toAbstract (OldName x)+	args <- toAbstract ps+	wps  <- toAbstract =<< mapM (parseLHS Nothing) wps+	checkPatternLinearity (map (namedThing . unArg) args ++ wps)+	printLocals 10 "checked pattern:"+	args <- toAbstract args -- take care of dot patterns+	wps  <- toAbstract wps+	printLocals 10 "checked dots:"+	return $ A.LHS (LHSRange $ getRange (lhs, wps)) x args wps++instance ToAbstract c a => ToAbstract (Arg c) (Arg a) where+    toAbstract (Arg h e) = Arg h <$> toAbstractCtx (hiddenArgumentCtx h) e++instance ToAbstract c a => ToAbstract (Named name c) (Named name a) where+    toAbstract (Named n e) = Named n <$> toAbstract e++-- Patterns are done in two phases. First everything but the dot patterns, and+-- then the dot patterns. This is because dot patterns can refer to variables+-- bound anywhere in the pattern.++instance ToAbstract c a => ToAbstract (A.Pattern' c) (A.Pattern' a) where+    toAbstract = mapM toAbstract++instance ToAbstract C.Pattern (A.Pattern' C.Expr) where++    toAbstract p@(C.IdentP x) = do+	px <- toAbstract (PatName x)+	case px of+	    VarPatName y  -> return $ VarP y+	    ConPatName ds -> return $ ConP (PatRange (getRange p))+                                           (AmbQ $ map anameName ds)+                                           []++    toAbstract p0@(AppP p q) = do+	(p', q') <- toAbstract (p,q)+	case p' of+	    ConP _ x as -> return $ ConP info x (as ++ [q'])+	    DefP _ x as -> return $ DefP info x (as ++ [q'])+	    _		-> typeError $ InvalidPattern p0+	where+	    r = getRange p0+	    info = PatSource r $ \pr -> if appBrackets pr then ParenP r p0 else p0++    toAbstract p0@(OpAppP r op ps) = do+	p <- toAbstract (IdentP $ C.QName op)+	ps <- toAbstract ps+	case p of+	  ConP _ x as -> return $ ConP info x (as ++ map (Arg NotHidden . unnamed) ps)+	  DefP _ x as -> return $ DefP info x (as ++ map (Arg NotHidden . unnamed) ps)+	  _	      -> __IMPOSSIBLE__+	where+	    r = getRange p0+	    info = PatSource r $ \pr -> if appBrackets pr then ParenP r p0 else p0++    -- Removed when parsing+    toAbstract (HiddenP _ _) = __IMPOSSIBLE__+    toAbstract (RawAppP _ _) = __IMPOSSIBLE__++    toAbstract p@(C.WildP r)    = return $ A.WildP (PatSource r $ const p)+    toAbstract (C.ParenP _ p)   = toAbstract p+    toAbstract (C.LitP l)	= return $ A.LitP l+    toAbstract p0@(C.AsP r x p) = typeError $ NotSupported "@-patterns"+      {- do+	x <- toAbstract (NewName x)+	p <- toAbstract p+	return $ A.AsP info x p+	where+	    info = PatSource r $ \_ -> p0+      -}+    -- we have to do dot patterns at the end+    toAbstract p0@(C.DotP r e) = return $ A.DotP info e+	where info = PatSource r $ \_ -> p0+    toAbstract p0@(C.AbsurdP r) = return $ A.AbsurdP info+	where+	    info = PatSource r $ \_ -> p0++-- | Turn an operator application into abstract syntax. Make sure to record the+-- right precedences for the various arguments.+toAbstractOpApp :: C.Name -> [C.Expr] -> ScopeM A.Expr+toAbstractOpApp op@(C.NoName _ _) es = __IMPOSSIBLE__+toAbstractOpApp op@(C.Name _ xs) es = do+    f  <- getFixity (C.QName op)+    op <- toAbstract (OldQName $ C.QName op)+    foldl app op <$> left f xs es+    where+	app e arg = A.App (ExprRange (fuseRange e arg)) e+		  $ Arg NotHidden $ unnamed arg++	left f (Hole : xs) (e : es) = do+	    e  <- toAbstractCtx (LeftOperandCtx f) e+	    es <- inside f xs es+	    return (e : es)+	left f (Id {} : xs) es = inside f xs es+	left f (Hole  : _)  [] = __IMPOSSIBLE__+	left f []           _  = __IMPOSSIBLE__++	inside f [x]	      es       = right f x es+	inside f (Id {} : xs) es       = inside f xs es+	inside f (Hole  : xs) (e : es) = do+	    e  <- toAbstractCtx InsideOperandCtx e+	    es <- inside f xs es+	    return (e : es)+	inside _ (Hole : _) [] = __IMPOSSIBLE__+	inside _ []         _  = __IMPOSSIBLE__++	right f Hole [e] = do+	    e <- toAbstractCtx (RightOperandCtx f) e+	    return [e]+	right _ (Id {})  [] = return []+	right _ Hole     _  = __IMPOSSIBLE__+	right _ (Id {})  _  = __IMPOSSIBLE__

+ src/full/Agda/Syntax/Translation/InternalToAbstract.hs view

@@ -0,0 +1,419 @@+{-# LANGUAGE CPP, MultiParamTypeClasses, FunctionalDependencies,+             UndecidableInstances, TypeSynonymInstances, FlexibleInstances+  #-}++{-|+    Translating from internal syntax to abstract syntax. Enables nice+    pretty printing of internal syntax.++    TODO++	- numbers on metas+	- fake dependent functions to independent functions+	- meta parameters+	- shadowing+-}+module Agda.Syntax.Translation.InternalToAbstract where++import Prelude hiding (mapM_, mapM)+import Control.Monad.State hiding (mapM_, mapM)+import Control.Monad.Error hiding (mapM_, mapM)++import qualified Data.Set as Set+import Data.Set (Set)+import qualified Data.Map as Map+import Data.Map (Map)+import Data.List hiding (sort)+import Data.Traversable++import Agda.Syntax.Position+import Agda.Syntax.Common+import Agda.Syntax.Info as Info+import Agda.Syntax.Fixity+import Agda.Syntax.Abstract as A+import qualified Agda.Syntax.Concrete as C+import Agda.Syntax.Internal as I+import Agda.Syntax.Scope.Base+import Agda.Syntax.Scope.Monad++import Agda.TypeChecking.Monad as M+import Agda.TypeChecking.Reduce+import {-# SOURCE #-} Agda.TypeChecking.Records+import Agda.TypeChecking.DisplayForm++import Agda.Utils.Monad+import Agda.Utils.Tuple+import Agda.Utils.Permutation+import Agda.Utils.Size++#include "../../undefined.h"+import Agda.Utils.Impossible++apps :: MonadTCM tcm => (Expr, [Arg Expr]) -> tcm Expr+apps (e, [])		    = return e+apps (e, arg@(Arg Hidden _) : args) =+    do	showImp <- showImplicitArguments+	if showImp then apps (App exprInfo e (unnamed <$> arg), args)+		   else apps (e, args)+apps (e, arg:args)	    =+    apps (App exprInfo e (unnamed <$> arg), args)++exprInfo :: ExprInfo+exprInfo = ExprRange noRange++reifyApp :: MonadTCM tcm => Expr -> [Arg Term] -> tcm Expr+reifyApp e vs = curry apps e =<< reify vs++class Reify i a | i -> a where+    reify :: MonadTCM tcm => i -> tcm a++instance Reify MetaId Expr where+    reify x@(MetaId n) = liftTCM $ do+      mi  <- getMetaInfo <$> lookupMeta x+      let mi' = Info.MetaInfo (getRange mi)+                              (M.clScope mi)+                              (Just n)+      ifM shouldReifyInteractionPoints+          (do iis <- map (snd /\ fst) . Map.assocs+                      <$> gets stInteractionPoints+              case lookup x iis of+                Just ii@(InteractionId n)+                        -> return $ A.QuestionMark $ mi' {metaNumber = Just n}+                Nothing	-> return $ A.Underscore mi'+          ) (return $ A.Underscore mi')++instance Reify DisplayTerm Expr where+  reify d = case d of+    DTerm v -> reify v+    DWithApp us vs -> do+      us <- reify us+      let wapp [e] = e+	  wapp (e : es) = A.WithApp exprInfo e es+	  wapp [] = __IMPOSSIBLE__+      reifyApp (wapp us) vs++reifyDisplayForm :: MonadTCM tcm => QName -> Args -> tcm A.Expr -> tcm A.Expr+reifyDisplayForm x vs fallback = do+  enabled <- displayFormsEnabled+  if enabled+    then do+      md <- liftTCM $ displayForm x vs+      case md of+        Nothing -> fallback+        Just d  -> reify d+    else fallback++reifyDisplayFormP :: A.LHS -> TCM A.LHS+reifyDisplayFormP lhs@(A.LHS i x ps wps) =+  ifM (not <$> displayFormsEnabled) (return lhs) $ do+    let vs = [ Arg h $ I.Var n [] | (n, h) <- zip [0..] $ map argHiding ps]+    md <- liftTCM $ displayForm x vs+    reportSLn "syntax.reify.display" 20 $ "display form of " ++ show x ++ ": " ++ show md+    case md of+      Just d  | okDisplayForm d ->+        reifyDisplayFormP =<< displayLHS (map (namedThing . unArg) ps) wps d+      _ -> return lhs+  where+    okDisplayForm (DWithApp (d : ds) []) =+      okDisplayForm d && all okDisplayTerm ds+    okDisplayForm (DTerm (I.Def f vs)) = all okArg vs+    okDisplayForm _ = True -- False++    okDisplayTerm (DTerm v) = okTerm v+    okDisplayTerm _ = False++    okArg = okTerm . unArg++    okTerm (I.Var _ []) = True+    okTerm (I.Con c vs) = all okArg vs+    okTerm (I.Def x []) = show x == "_" -- Handling wildcards in display forms+    okTerm _            = True -- False++    flattenWith (DWithApp (d : ds) []) = case flattenWith d of+      (f, vs, ds') -> (f, vs, ds' ++ map unDTerm ds)+    flattenWith (DTerm (I.Def f vs)) = (f, vs, [])+    flattenWith _ = __IMPOSSIBLE__++    unDTerm (DTerm v) = v+    unDTerm _ = __IMPOSSIBLE__++    displayLHS ps wps d = case flattenWith d of+      (f, vs, ds) -> do+        ds <- mapM termToPat ds+        vs <- mapM argToPat vs+        return $ LHS i f vs (ds ++ wps)+      where+        info = PatRange noRange+        argToPat arg = fmap unnamed <$> traverse termToPat arg++        -- TODO: dot variables+        termToPat (I.Var n []) = return $ ps !! fromIntegral n+        termToPat (I.Con c vs) = A.ConP info (AmbQ [c]) <$> mapM argToPat vs+        termToPat (I.Def _ []) = return $ A.WildP info+        termToPat v = A.DotP info <$> reify v -- __IMPOSSIBLE__++instance Reify Term Expr where+    reify v =+	do  v <- instantiate v+	    case v of+		I.Var n vs   -> do+                    x  <- liftTCM $ nameOfBV n `catchError` \_ -> freshName_ ("@" ++ show n)+                    reifyApp (A.Var x) vs+		I.Def x vs   -> reifyDisplayForm x vs $ do+		    n <- getDefFreeVars x+		    reifyApp (A.Def x) $ genericDrop n vs+		I.Con x vs   -> do+		  isR <- isRecord x+		  case isR of+		    True -> do+		      xs <- getRecordFieldNames x+		      vs <- reify $ map unArg vs+		      return $ A.Rec exprInfo $ zip xs vs+		    False -> reifyDisplayForm x vs $ do+                      let hide (Arg _ x) = Arg Hidden x+                      Constructor{conPars = np} <- theDef <$> getConstInfo x+		      scope <- getScope+                      let whocares = A.Underscore (Info.MetaInfo noRange scope Nothing)+                          us = replicate (fromIntegral np) $ Arg Hidden whocares+                      n  <- getDefFreeVars x+                      es <- reify vs+                      apps (A.Con (AmbQ [x]), genericDrop n $ us ++ es)+		I.Lam h b    ->+		    do	(x,e) <- reify b+			return $ A.Lam exprInfo (DomainFree h x) e+		I.Lit l	     -> return $ A.Lit l+		I.Pi a b     ->+		    do	Arg h a <- reify a+			(x,b)   <- reify b+			return $ A.Pi exprInfo [TypedBindings noRange h [TBind noRange [x] a]] b+		I.Fun a b    -> uncurry (A.Fun $ exprInfo)+				<$> reify (a,b)+		I.Sort s     -> reify s+		I.MetaV x vs -> apps =<< reify (x,vs)++data NamedClause = NamedClause QName I.Clause+-- Named clause does not need 'Recursion' flag since I.Clause has it+-- data NamedClause = NamedClause QName Recursion I.Clause++instance Reify ClauseBody RHS where+  reify NoBody     = return AbsurdRHS+  reify (Body v)   = RHS <$> reify v+  reify (NoBind b) = reify b+  reify (Bind b)   = reify $ absBody b  -- the variables should already be bound++stripImplicits :: MonadTCM tcm => [NamedArg A.Pattern] -> [A.Pattern] -> tcm [NamedArg A.Pattern]+stripImplicits ps wps =+  ifM showImplicitArguments (return ps) $ do+  let vars = dotVars (ps, wps)+  reportSLn "syntax.reify.implicit" 30 $ unlines+    [ "stripping implicits"+--     , "  ps   = " ++ show ps+--     , "  wps  = " ++ show wps+    , "  vars = " ++ show vars+    ]+  return $ strip vars ps+  where+    argsVars = Set.unions . map argVars+    argVars = patVars . namedThing . unArg+    patVars p = case p of+      A.VarP x      -> Set.singleton x+      A.ConP _ _ ps -> argsVars ps+      A.DefP _ _ ps -> Set.empty+      A.DotP _ e    -> Set.empty+      A.WildP _     -> Set.empty+      A.AbsurdP _   -> Set.empty+      A.LitP _      -> Set.empty+      A.ImplicitP _ -> Set.empty+      A.AsP _ _ p   -> patVars p++    strip dvs = stripArgs+      where+        stripArgs [] = []+        stripArgs (a : as) = case argHiding a of+          Hidden | canStrip a as -> stripArgs as+          _                      -> stripArg a : stripArgs as++        -- TODO: use named implicits (need to get the names from somewhere!)+        canStrip a as = and+          [ varOrDot p+          , noInterestingBindings p+          , all (flip canStrip []) $ takeWhile ((Hidden ==) . argHiding) as+          ]+          where p = namedThing $ unArg a++        stripArg a = fmap (fmap stripPat) a++        stripPat p = case p of+          A.VarP _      -> p+          A.ConP i c ps -> A.ConP i c $ stripArgs ps+          A.DefP _ _ _  -> p+          A.DotP _ e    -> p+          A.WildP _     -> p+          A.AbsurdP _   -> p+          A.LitP _      -> p+          A.ImplicitP _ -> p+          A.AsP i x p   -> A.AsP i x $ stripPat p++        noInterestingBindings p =+          Set.null $ dvs `Set.intersection` patVars p++        varOrDot (A.VarP _)      = True+        varOrDot (A.WildP _)     = True+        varOrDot (A.DotP _ _)    = True+        varOrDot (A.ImplicitP _) = True+        varOrDot _               = False+++class DotVars a where+  dotVars :: a -> Set Name++instance DotVars a => DotVars (Arg a) where+  dotVars (Arg Hidden _)    = Set.empty+  dotVars (Arg NotHidden x) = dotVars x++instance DotVars a => DotVars (Named s a) where+  dotVars = dotVars . namedThing++instance DotVars a => DotVars [a] where+  dotVars = Set.unions . map dotVars++instance (DotVars a, DotVars b) => DotVars (a, b) where+  dotVars (x, y) = Set.union (dotVars x) (dotVars y)++instance DotVars A.Pattern where+  dotVars p = case p of+    A.VarP _      -> Set.empty+    A.ConP _ _ ps -> dotVars ps+    A.DefP _ _ ps -> dotVars ps+    A.DotP _ e    -> dotVars e+    A.WildP _     -> Set.empty+    A.AbsurdP _   -> Set.empty+    A.LitP _      -> Set.empty+    A.ImplicitP _ -> Set.empty+    A.AsP _ _ p   -> dotVars p++instance DotVars A.Expr where+  dotVars e = case e of+    A.ScopedExpr _ e -> dotVars e+    A.Var x          -> Set.singleton x+    A.Def _          -> Set.empty+    A.Con _          -> Set.empty+    A.Lit _          -> Set.empty+    A.QuestionMark _ -> Set.empty+    A.Underscore _   -> Set.empty+    A.App _ e1 e2    -> dotVars (e1, e2)+    A.WithApp _ e es -> dotVars (e, es)+    A.Lam _ _ e      -> dotVars e+    A.AbsurdLam _ _  -> Set.empty+    A.Pi _ tel e     ->  dotVars (tel, e)+    A.Fun _ a b      -> dotVars (a, b)+    A.Set _ _        -> Set.empty+    A.Prop _         -> Set.empty+    A.Let _ _ _      -> __IMPOSSIBLE__+    A.Rec _ es       -> dotVars $ map snd es++instance DotVars TypedBindings where+  dotVars (TypedBindings _ _ bs) = dotVars bs++instance DotVars TypedBinding where+  dotVars (TBind _ _ e) = dotVars e+  dotVars (TNoBind e)   = dotVars e++reifyPatterns :: MonadTCM tcm =>+  I.Telescope -> Permutation -> [Arg I.Pattern] -> tcm [NamedArg A.Pattern]+reifyPatterns tel perm ps = evalStateT (reifyArgs ps) 0+  where+    reifyArgs as = map (fmap unnamed) <$> mapM reifyArg as+    reifyArg a   = traverse reifyPat a++    tick = do i <- get; put (i + 1); return i++    translate = (vars !!)+      where+        vars = permute (invertP perm) [0..]++    reifyPat p = case p of+      I.VarP s    -> do+        i <- tick+        let j = translate i+        lift $ A.VarP <$> nameOfBV (size tel - 1 - j)+      I.DotP v -> do+        t <- lift $ reify v+        let vars = Set.map show (dotVars t)+        if Set.member "()" vars+          then tick >> (return $ A.DotP i $ A.Underscore mi)+          else tick >> lift (A.DotP i <$> reify v)+      I.LitP l    -> return $ A.LitP l+      I.ConP c ps -> A.ConP i (AmbQ [c]) <$> reifyArgs ps+      where+        i = PatRange noRange+        mi = MetaInfo noRange emptyScopeInfo Nothing++instance Reify NamedClause A.Clause where+  reify (NamedClause f (I.Clause _ tel perm ps body)) = addCtxTel tel $ do+    ps  <- reifyPatterns tel perm ps+    lhs <- liftTCM $ reifyDisplayFormP $ LHS info f ps []+    nfv <- getDefFreeVars f+    lhs <- stripImps $ dropParams nfv lhs+    rhs <- reify body+    return $ A.Clause lhs rhs []+    where+      info = LHSRange noRange+      dropParams n (LHS i f ps wps) = LHS i f (genericDrop n ps) wps+      stripImps (LHS i f ps wps) = do+        ps <- stripImplicits ps wps+        return $ LHS i f ps wps++instance Reify Type Expr where+    reify (I.El _ t) = reify t++instance Reify Sort Expr where+    reify s =+	do  s <- normalise s+	    case s of+		I.Type n  -> return $ A.Set exprInfo n+		I.Prop	  -> return $ A.Prop exprInfo+		I.MetaS x -> reify x+		I.Suc s	  ->+		    do	suc <- freshName_ "suc"	-- TODO: hack+			e   <- reify s+			return $ A.App exprInfo (A.Var suc) (Arg NotHidden $ unnamed e)+		I.Lub s1 s2 ->+		    do	lub <- freshName_ "\\/"	-- TODO: hack+			(e1,e2) <- reify (s1,s2)+			let app x y = A.App exprInfo x (Arg NotHidden $ unnamed y)+			return $ A.Var lub `app` e1 `app` e2++instance Reify i a => Reify (Abs i) (Name, a) where+    reify (Abs s v) =+	do  x <- freshName_ s+	    e <- addCtx x (Arg NotHidden $ sort I.Prop) -- type doesn't matter+		 $ reify v+	    return (x,e)++instance Reify I.Telescope A.Telescope where+  reify EmptyTel = return []+  reify (ExtendTel arg tel) = do+    Arg h e <- reify arg+    (x,bs)  <- reify $ betterName tel+    let r = getRange e+    return $ TypedBindings r h [TBind r [x] e] : bs+    where+      betterName (Abs "_" x) = Abs "z" x+      betterName (Abs s   x) = Abs s   x++instance Reify i a => Reify (Arg i) (Arg a) where+    reify = traverse reify++instance Reify i a => Reify [i] [a] where+    reify = traverse reify++instance (Reify i1 a1, Reify i2 a2) => Reify (i1,i2) (a1,a2) where+    reify (x,y) = (,) <$> reify x <*> reify y++instance (Reify t t', Reify a a') +         => Reify (Judgement t a) (Judgement t' a') where+    reify (HasType i t) = HasType <$> reify i <*> reify t+    reify (IsSort i) = IsSort <$> reify i++

+ src/full/Agda/Termination/CallGraph.hs view

@@ -0,0 +1,454 @@+-- | Call graphs and related concepts, more or less as defined in+--     \"A Predicative Analysis of Structural Recursion\" by+--     Andreas Abel and Thorsten Altenkirch.++-- Originally copied from Agda1 sources.++module Agda.Termination.CallGraph+  ( -- * Structural orderings+    Order(..)+  , (.*.)+  , supremum+    -- * Call matrices+  , Index+  , CallMatrix(..)+  , (>*<)+  , callMatrixInvariant+    -- * Calls+  , Call(..)+  , callInvariant+    -- * Call graphs+  , CallGraph+  , callGraphInvariant+  , fromList+  , toList+  , empty+  , union+  , insert+  , complete+  , showBehaviour+    -- * Tests+  , Agda.Termination.CallGraph.tests+  ) where++import Agda.Utils.QuickCheck+import Agda.Utils.Function+import Agda.Utils.List+import Agda.Utils.TestHelpers+import Agda.Termination.Matrix as Matrix+import Agda.Termination.Semiring (Semiring)+import qualified Agda.Termination.Semiring as Semiring+import Data.Set (Set)+import qualified Data.Set as Set+import Data.Map (Map, (!))+import qualified Data.Map as Map+import Data.List hiding (union, insert)+import Data.Monoid+import Data.Array (elems)+import Data.Function++------------------------------------------------------------------------+-- Structural orderings++-- | The order called R in the paper referred to above. Note that+-- @'Unknown' '<=' 'Le' '<=' 'Lt'@.+--+-- See 'Call' for more information.+-- +-- TODO: document orders which are call-matrices themselves.+data Order+  = Lt | Le | Unknown | Mat (Matrix Integer Order)+  deriving (Eq,Ord)++instance Show Order where+  show Lt      = "<"+  show Le      = "="+  show Unknown = "?"+  show (Mat m) = "Mat " ++ show m ++--instance Ord Order where+--    max = maxO++instance Arbitrary Order where+  arbitrary = elements [Lt, Le, Unknown]++instance CoArbitrary Order where+  coarbitrary Lt      = variant 0+  coarbitrary Le      = variant 1+  coarbitrary Unknown = variant 2+  coarbitrary (Mat m) = variant 3 ++-- | Multiplication of 'Order's. (Corresponds to sequential+-- composition.)++(.*.) :: Order -> Order -> Order+Lt      .*. Unknown   = Unknown+Lt      .*. (Mat m)   = Lt .*. (collapse m)+Lt      .*. _         = Lt+Le      .*. o         = o+Unknown .*. _         = Unknown+(Mat m1) .*. (Mat m2) = if (okM m1 m2) then +                            Mat $ mul orderSemiring m1 m2+                        else+                            (collapse m1) .*. (collapse m2)+(Mat m) .*. Le        = Mat m+(Mat m) .*. Unknown   = Unknown+(Mat m) .*. Lt        = (collapse m) .*. Lt++collapse :: Matrix Integer Order -> Order+collapse m = foldl (.*.) Le (Data.Array.elems $ diagonal m)++okM :: Matrix Integer Order -> Matrix Integer Order -> Bool+okM m1 m2 = (rows $ size m2) == (cols $ size m1)++-- | The supremum of a (possibly empty) list of 'Order's.++supremum :: [Order] -> Order+supremum = foldr maxO Unknown++maxO :: Order -> Order -> Order+maxO o1 o2 = case (o1,o2) of +               (_,Lt) -> Lt+               (Lt,_) -> Lt+               (Unknown,_) -> o2+               (_,Unknown) -> o1+               (Mat m1, Mat m2) -> Mat (Matrix.zipWith maxO m1 m2)+               (Mat m,_) -> maxO (collapse m) o2+               (_,Mat m) ->  maxO o1 (collapse m)+               (Le,Le) -> Le++-- | The infimum of a (possibly empty) list of 'Order's.++-- infimum :: [Order] -> Order+-- infimum = foldr min Lt -- DELETE ?++-- | @('Order', 'max', '.*.')@ forms a semiring, with 'Unknown' as zero+-- and 'Le' as one.  ++orderSemiring :: Semiring Order+orderSemiring =+  Semiring.Semiring { Semiring.add = maxO+                    , Semiring.mul = (.*.)+                    , Semiring.zero = Unknown+                    , Semiring.one = Le+                    }++prop_orderSemiring = Semiring.semiringInvariant orderSemiring++------------------------------------------------------------------------+-- Call matrices++-- | Call matrix indices.++type Index = Integer++-- | Call matrices. Note the call matrix invariant+-- ('callMatrixInvariant').++newtype CallMatrix = CallMatrix { mat :: Matrix Index Order }+  deriving (Eq, Ord, Show)++instance Arbitrary CallMatrix where+  arbitrary = do+    sz <- arbitrary+    callMatrix sz++instance CoArbitrary CallMatrix where+  coarbitrary (CallMatrix m) = coarbitrary m++prop_Arbitrary_CallMatrix = callMatrixInvariant++-- | Generates a call matrix of the given size.++callMatrix :: Size Index -> Gen CallMatrix+callMatrix sz = do+  m <- matrixUsingRowGen sz rowGen+  return $ CallMatrix { mat = m }+  where+  rowGen :: Index -> Gen [Order]+  rowGen 0 = return []+  rowGen n = do+    x <- arbitrary+    i <- choose (0, n - 1)+    return $ genericReplicate i Unknown ++ [x] +++             genericReplicate (n - 1 - i) Unknown++prop_callMatrix sz =+  forAll (callMatrix sz) $ \cm ->+    callMatrixInvariant cm+    &&+    size (mat cm) == sz++-- | In a call matrix at most one element per row may be different+-- from 'Unknown'.++callMatrixInvariant :: CallMatrix -> Bool+callMatrixInvariant cm =+  matrixInvariant m &&+  all ((<= 1) . length . filter (/= Unknown)) (toLists m)+  where m = mat cm++-- | Call matrix multiplication.+--+-- Precondition: see 'mul'.++(<*>) :: CallMatrix -> CallMatrix -> CallMatrix+cm1 <*> cm2 =+  CallMatrix { mat = mul orderSemiring (mat cm1) (mat cm2) }++prop_cmMul sz =+  forAll natural $ \c2 ->+  forAll (callMatrix sz) $ \cm1 ->+  forAll (callMatrix $ Size { rows = cols sz, cols = c2 }) $ \cm2 ->+    callMatrixInvariant (cm1 <*> cm2)++------------------------------------------------------------------------+-- Calls++-- | This datatype encodes information about a single recursive+-- function application. The columns of the call matrix stand for+-- 'source' function arguments (patterns); the first argument has+-- index 0, the second 1, and so on. The rows of the matrix stand for+-- 'target' function arguments. Element @(i, j)@ in the matrix should+-- be computed as follows:+--+--   * 'Lt' (less than) if the @j@-th argument to the 'target'+--     function is structurally strictly smaller than the @i@-th+--     pattern.+--+--   * 'Le' (less than or equal) if the @j@-th argument to the+--     'target' function is structurally smaller than the @i@-th+--     pattern.+--+--   * 'Unknown' otherwise.+--+--   The structural ordering used is defined in the paper referred to+--   above.++data Call =+  Call { source :: Index        -- ^ The function making the call.+       , target :: Index        -- ^ The function being called.+       , cm :: CallMatrix       -- ^ The call matrix describing the call.+       }+  deriving (Eq, Ord, Show)++instance Arbitrary Call where+  arbitrary = do+    [s, t]    <- vectorOf 2 arbitrary+    cm        <- arbitrary+    return (Call { source = s, target = t, cm = cm })++instance CoArbitrary Call where+  coarbitrary (Call s t cm) =+    coarbitrary s . coarbitrary t . coarbitrary cm++prop_Arbitrary_Call :: Call -> Bool+prop_Arbitrary_Call = callInvariant++-- | 'Call' invariant.++callInvariant :: Call -> Bool+callInvariant = callMatrixInvariant . cm++-- | 'Call' combination.+--+-- Precondition: see '<*>'; furthermore the 'source' of the first+-- argument should be equal to the 'target' of the second one.++(>*<) :: Call -> Call -> Call+c1 >*< c2 =+  Call { source    = source c2+       , target    = target c1+       , cm        = cm c1 <*> cm c2+       }++------------------------------------------------------------------------+-- Call graphs++-- | A call graph is a set of calls. Every call also has some+-- associated meta information, which should be 'Monoid'al so that the+-- meta information for different calls can be combined when the calls+-- are combined.++newtype CallGraph meta = CallGraph { cg :: Map Call meta }+  deriving (Eq, Show)++-- | 'CallGraph' invariant.++callGraphInvariant :: CallGraph meta -> Bool+callGraphInvariant = all (callInvariant . fst) . toList++-- | Converts a call graph to a list of calls with associated meta+-- information.++toList :: CallGraph meta -> [(Call, meta)]+toList = Map.toList . cg++-- | Converts a list of calls with associated meta information to a+-- call graph.++fromList :: Monoid meta => [(Call, meta)] -> CallGraph meta+fromList = CallGraph . Map.fromListWith mappend++-- | Creates an empty call graph.++empty :: CallGraph meta+empty = CallGraph Map.empty++-- | Takes the union of two call graphs.++union :: Monoid meta+      => CallGraph meta -> CallGraph meta -> CallGraph meta+union cs1 cs2 = CallGraph $ (Map.unionWith mappend `on` cg) cs1 cs2++-- | Inserts a call into a call graph.++insert :: Monoid meta+       => Call -> meta -> CallGraph meta -> CallGraph meta+insert c m = CallGraph . Map.insertWith mappend c m . cg++-- | Generates a call graph.++callGraph :: (Monoid meta, Arbitrary meta) => Gen (CallGraph meta)+callGraph = do+  indices <- fmap nub arbitrary+  n <- natural+  let noMatrices | null indices = 0+                 | otherwise    = n `min` 3  -- Not too many.+  fmap fromList $ vectorOf noMatrices (matGen indices)+  where+  matGen indices = do+    [s, t] <- vectorOf 2 (elements indices)+    [c, r] <- vectorOf 2 (choose (0, 2))     -- Not too large.+    m <- callMatrix (Size { rows = r, cols = c })+    callId <- arbitrary+    return (Call { source = s, target = t, cm = m }, callId)++prop_callGraph =+  forAll (callGraph :: Gen (CallGraph [Integer])) $ \cs ->+    callGraphInvariant cs++-- | Call graph combination. (Application of '>*<' to all pairs @(c1,+-- c2)@ for which @'source' c1 = 'target' c2@.)+--+-- Precondition: see '<*>'.++combine+  :: Monoid meta => CallGraph meta -> CallGraph meta -> CallGraph meta+combine s1 s2 = fromList $+  [ (c1 >*< c2, m1 `mappend` m2)+  | (c1, m1) <- toList s1, (c2, m2) <- toList s2+  , source c1 == target c2+  ]++-- | @'complete' cs@ completes the call graph @cs@. A call graph is+-- complete if it contains all indirect calls; if @f -> g@ and @g ->+-- h@ are present in the graph, then @f -> h@ should also be present.++complete :: Monoid meta => CallGraph meta -> CallGraph meta+complete cs = complete' safeCS+  where+  safeCS = ensureCompletePrecondition cs++  complete' cs | cs' .==. cs = cs+               | otherwise   = complete' cs'+    where+    cs' = cs `union` combine cs safeCS+    (.==.) = ((==) `on` (Map.keys . cg))++prop_complete =+  forAll (callGraph :: Gen (CallGraph [Integer])) $ \cs ->+    isComplete (complete cs)++-- | Returns 'True' iff the call graph is complete.++isComplete :: (Ord meta, Monoid meta) => CallGraph meta -> Bool+isComplete s = all (`Map.member` cg s) combinations+  where+  calls = toList s+  combinations =+    [ c2 >*< c1 | (c1, _) <- calls, (c2, _) <- calls+                , target c1 == source c2 ]++-- | Checks whether every 'Index' used in the call graph corresponds+-- to a fixed number of arguments (i.e. rows\/columns).++completePrecondition :: CallGraph meta -> Bool+completePrecondition cs =+  all (allEqual . map snd) $+  groupOn fst $+  concat [ [(source c, cols $ size' c), (target c, rows $ size' c)]+         | (c, _) <- toList cs]+  where+  size' = size . mat . cm++-- | Returns a call graph padded with 'Unknown's in such a way that+-- 'completePrecondition' is satisfied.++ensureCompletePrecondition+  :: Monoid meta => CallGraph meta -> CallGraph meta+ensureCompletePrecondition cs =+  CallGraph $ Map.mapKeysWith mappend pad $ cg cs+  where+  -- The maximum number of arguments detected for every index.+  noArgs :: Map Index Integer+  noArgs = foldr (\c m -> insert (source c) (cols' c) $+                          insert (target c) (rows' c) m)+                 Map.empty+                 (map fst $ toList cs)+    where insert = Map.insertWith max++  pad c = c { cm = CallMatrix { mat = padRows $ padCols $ mat $ cm c } }+    where+    padCols = iterate' ((noArgs ! source c) - cols' c)+                       (addColumn Unknown)++    padRows = iterate' ((noArgs ! target c) - rows' c)+                       (addRow Unknown)++  cols'  = cols . size'+  rows'  = rows . size'+  size'  = size . mat . cm++prop_ensureCompletePrecondition =+  forAll (callGraph :: Gen (CallGraph [Integer])) $ \cs ->+    let cs' = ensureCompletePrecondition cs in+    completePrecondition cs'+    &&+    all callInvariant (map fst $ toList cs')+    &&+    and [ or [ new .==. old | (old, _) <- toList cs ]+        | (new, _) <- toList cs' ]+  where+  c1 .==. c2 = all (all (uncurry (==)))+                   ((zipZip `on` (toLists . mat . cm)) c1 c2)++  -- zipZip discards the new elements.+  zipZip :: [[a]] -> [[b]] -> [[(a, b)]]+  zipZip xs ys = map (uncurry zip) $ zip xs ys++-- | Displays the recursion behaviour corresponding to a call graph.++showBehaviour :: Show meta => CallGraph meta -> String+showBehaviour = concatMap showCall . toList+  where+  showCall (c, meta) | source c /= target c = ""+                     | otherwise            = unlines+    [ "Function:  " ++ show (source c)+    , "Behaviour: " ++ show (elems $ diagonal $ mat $ cm c)+    , "Meta info: " ++ show meta+    ]++------------------------------------------------------------------------+-- All tests++tests = runTests "Agda.Termination.CallGraph"+  [ quickCheck' prop_orderSemiring+  , quickCheck' prop_Arbitrary_CallMatrix+  , quickCheck' prop_callMatrix+  , quickCheck' prop_cmMul+  , quickCheck' prop_Arbitrary_Call+  , quickCheck' prop_callGraph+  , quickCheck' prop_complete+  , quickCheck' prop_ensureCompletePrecondition+  ]

+ src/full/Agda/Termination/Lexicographic.hs view

@@ -0,0 +1,238 @@+-- | Lexicographic order search, more or less as defined in+--      \"A Predicative Analysis of Structural Recursion\" by+--      Andreas Abel and Thorsten Altenkirch.++module Agda.Termination.Lexicographic+  ( LexOrder+  , RecBehaviour(..)+  , Column+  , recBehaviourInvariant+  , fromDiagonals+  , lexOrder+  , Agda.Termination.Lexicographic.tests+  ) where++import Agda.Utils.QuickCheck+import Agda.Termination.Matrix (Size (..))+import qualified Agda.Termination.Matrix as M+import Agda.Utils.Either+import Agda.Utils.List+import Agda.Utils.TestHelpers+import Agda.Termination.CallGraph+import Control.Arrow+import Data.List+import Data.Map (Map, (!))+import qualified Data.Map as Map+import Data.Array (Array, Ix)+import qualified Data.Array as Array+import Data.Set (Set)+import qualified Data.Set as Set++-- | A lexicographic ordering for the recursion behaviour of a+-- given function is a permutation of the argument indices which can+-- be used to show that the function terminates. See the paper+-- referred to above for more details.++type LexOrder arg = [arg]++-- | A recursion behaviour expresses how a certain function calls+-- itself (transitively). For every argument position there is a value+-- ('Column') describing how the function calls itself for that+-- particular argument. See also 'recBehaviourInvariant'.++data RecBehaviour arg call =+  RB { columns :: Map arg (Column call)+     , calls   :: Set call+       -- ^ The indices to the columns.+     , size    :: Size Integer+     }+  deriving Show++-- | A column expresses how the size of a certain argument changes in+-- the various recursive calls a function makes to itself+-- (transitively).++type Column call = Map call Order++-- | 'RecBehaviour' invariant: the size must match the real size of+-- the recursion behaviour, and all columns must have the same+-- indices.++recBehaviourInvariant :: Eq call => RecBehaviour arg call -> Bool+recBehaviourInvariant rb =+  genericLength (Map.elems $ columns rb) == cols (size rb)+  &&+  all (== rows (size rb))+      (map (genericLength . Map.elems) $ Map.elems $ columns rb)+  &&+  allEqual (calls rb : (map Map.keysSet $ Map.elems $ columns rb))++-- Generates a recursion behaviour.++instance (Arbitrary call, Arbitrary arg, Ord arg, Ord call)+  => Arbitrary (RecBehaviour call arg) where+  arbitrary = do+    calls <- fmap nub $ listOf arbitrary+    args  <- fmap nub $ listOf arbitrary+    let rows = genericLength calls+        cols = genericLength args+        sz   = Size { rows = rows, cols = cols }+        colGen = do+          col <- vectorOf (fromIntegral rows) arbitrary+          return $ Map.fromList (zip calls col)+    cols <- fmap (zip args) $ vectorOf (fromIntegral cols) colGen+    return $ RB { columns = Map.fromList cols+                , calls   = Set.fromList calls+                , size    = sz }++instance (CoArbitrary call, CoArbitrary arg) => CoArbitrary (RecBehaviour call arg) where+  coarbitrary (RB c cs s) =+    coarbitrary (map (id *** Map.toList) $ Map.toList c) .+    coarbitrary (Set.toList cs) .+    coarbitrary s++prop_recBehaviour_Arbitrary :: RecBehaviour Integer Integer -> Bool+prop_recBehaviour_Arbitrary = recBehaviourInvariant++-- | Checks whether there are any calls left in the recursion+-- behaviour.++noCallsLeft :: RecBehaviour arg call -> Bool+noCallsLeft rb = rows (size rb) == 0++-- | Constructs a recursion behaviour from a list of matrix diagonals+-- (\"rows\"). Note that the @call@ indices do not need to be+-- distinct, since they are paired up with unique 'Integer's.+--+-- Precondition: all arrays should have the same bounds.++fromDiagonals :: (Ord call, Ix arg)+              => [(call, Array arg Order)] -> RecBehaviour arg (Integer, call)+fromDiagonals []   = RB { columns = Map.fromList []+                        , calls   = Set.empty+                        , size    = Size 0 0 }+fromDiagonals rows = RB { columns = Map.fromList $ zip args cols+                        , calls   = Set.fromList calls+                        , size    = Size { rows = genericLength rows+                                         , cols = genericLength cols }+                        }+  where+  calls = zip [1 ..] $ map fst rows+  cols = map Map.fromList $ map (zip calls) $ transpose $+         map (Array.elems . snd) rows+  args = Array.range $ Array.bounds $ snd $ head rows++prop_fromDiagonals m =+  forAll (vectorOf (fromIntegral $ rows $ M.size m) arbitrary) $ \calls ->+    let oss = zip calls $+              map (Array.listArray (1, cols $ M.size m)) $+              M.toLists m+        rb = fromDiagonals oss :: RecBehaviour Integer (Integer, Bool)+    in+    recBehaviourInvariant rb+    &&+    if rows (M.size m) == 0 then+      rows (size rb) == 0+     else+      size rb == M.size m++-- | Checks if this \"column\" is well-behaved (all calls decreasing,+-- at least one strictly decreasing).++okColumn :: Column call -> Bool+okColumn col = any (== Lt) col' && all (/= Unknown) col'+  where col' = Map.elems col++-- | @'newBehaviour' n rb@ computes a new recursion behaviour from+-- @rb@ by removing all \"rows\" (calls) for which the @n@-th element+-- is 'Lt', and also completely removing the @n@-th column.+--+-- Precondition: there has to be an @n@-th column.++newBehaviour :: (Ord arg, Ord call)+             => arg -> RecBehaviour arg call -> RecBehaviour arg call+newBehaviour n rb =+  RB { columns = Map.map remove $ Map.delete n $ columns rb+     , calls   = Set.difference (calls rb)+                                (Set.fromList indicesToRemove)+     , size    = Size { rows = rows (size rb) -+                               genericLength indicesToRemove+                      , cols = cols (size rb) - 1 }+     }+  where+  Just colN       = Map.lookup n $ columns rb+  indicesToRemove = map fst $ filter ((== Lt) . snd) $ Map.toList colN+  remove colJ     = foldr Map.delete colJ indicesToRemove++prop_newBehaviour :: RecBehaviour Integer Integer -> Property+prop_newBehaviour rb =+  not (cols (size rb) == 0) ==>+    forAll (elements $ Map.keys $ columns rb) $ \n ->+      recBehaviourInvariant (newBehaviour n rb)++-- | @'correctLexOrder' rs ps@ checks that the permutation @ps@ really+-- induces a lexicographic ordering which shows that the function+-- represented by the recursion behaviour @rs@ terminates.++correctLexOrder :: (Ord arg, Ord call)+                => RecBehaviour arg call -> LexOrder arg -> Bool+correctLexOrder rb []        = noCallsLeft rb+correctLexOrder rb (p0 : ps) =+  okColumn (columns rb ! p0) && correctLexOrder (newBehaviour p0 rb) ps++-- | Tries to compute a lexicographic ordering for the given recursion+-- behaviour. This algorithm should be complete.+--+-- If no lexicographic ordering can be found, then two sets are+-- returned:+--+-- * A set of argument positions which are not properly decreasing, and+--+-- * the calls where these problems show up.++lexOrder :: (Ord arg, Ord call) =>+  RecBehaviour arg call -> Either (Set arg, Set call) (LexOrder arg)+lexOrder rb | noCallsLeft rb = Right []+            | otherwise      = case okColumns of+  []      -> Left (Map.keysSet $ columns rb, calls rb)+  (n : _) -> case lexOrder (newBehaviour n rb) of+    Left err -> Left err+    Right ps -> Right $ n : ps+  where+  okColumns = map fst $ filter snd $+              map (id *** okColumn) $+              Map.toList $ columns rb++prop_lexOrder :: RecBehaviour Integer Integer -> Property+prop_lexOrder rb =+  let mPerm = lexOrder rb+      Right perm = mPerm+  in+  isRight mPerm ==>+    classify (cols (size rb) >= 2) "interesting" $+    correctLexOrder rb perm++prop_lexOrder_noArgs =+  forAll positive $ \n ->+    isLeft (lexOrder $ rb n)+    where rb :: Integer -> RecBehaviour Integer Integer+          rb n = RB { columns = Map.empty+                    , calls   = Set.fromList [1 .. n]+                    , size    = Size { rows = n, cols = 0 }+                    }++------------------------------------------------------------------------+-- All tests++tests = runTests "Agda.Termination.Lexicographic"+  [ quickCheck' prop_recBehaviour_Arbitrary+  , quickCheck' prop_fromDiagonals+  , quickCheck' prop_newBehaviour+  , quickCheckWith' Args{ replay     = Nothing+                        , maxSuccess = 50+                        , maxDiscard = 200+                        , maxSize    = 20+                        }+                    prop_lexOrder+  , quickCheck' prop_lexOrder_noArgs+  ]

+ src/full/Agda/Termination/Matrix.hs view

@@ -0,0 +1,338 @@+-- | Naive implementation of simple matrix library.++-- Originally copied from Agda1 sources.++module Agda.Termination.Matrix+  ( -- * Basic data types+    Matrix+  , matrixInvariant+  , Size(..)+  , sizeInvariant+  , MIx (..)+  , mIxInvariant+    -- * Generating and creating matrices+  , fromLists+  , fromIndexList+  , toLists+  , Agda.Termination.Matrix.zipWith+  , matrix+  , matrixUsingRowGen+    -- * Combining and querying matrices+  , size+  , square+  , isEmpty+  , add+  , mul+  , diagonal+    -- * Modifying matrices+  , addRow+  , addColumn+    -- * Tests+  , Agda.Termination.Matrix.tests+  ) where++import Data.Array+import Data.List as List+import Agda.Utils.QuickCheck+import Agda.Utils.TestHelpers+import Agda.Termination.Semiring (Semiring)+import qualified Agda.Termination.Semiring as Semiring++------------------------------------------------------------------------+-- Basic data types++-- | This matrix type is used for tests.++type TM = Matrix Integer Integer++-- | Size of a matrix.++data Size i = Size { rows :: i, cols :: i }+  deriving (Eq, Show)++sizeInvariant :: (Ord i, Num i) => Size i -> Bool+sizeInvariant sz = rows sz >= 0 && cols sz >= 0++instance (Arbitrary i, Integral i) => Arbitrary (Size i) where+  arbitrary = do+    r <- natural+    c <- natural+    return $ Size { rows = fromInteger r, cols = fromInteger c }++instance CoArbitrary i => CoArbitrary (Size i) where+  coarbitrary (Size rs cs) = coarbitrary rs . coarbitrary cs++prop_Arbitrary_Size :: Size Integer -> Bool+prop_Arbitrary_Size = sizeInvariant++-- | Converts a size to a set of bounds suitable for use with+-- the matrices in this module.++toBounds :: Num i => Size i -> (MIx i, MIx i)+toBounds sz = (MIx { row = 1, col = 1 }, MIx { row = rows sz, col = cols sz })++-- | Type of matrix indices (row, column).++data MIx i = MIx { row, col :: i }+  deriving (Eq, Show, Ix, Ord)++instance (Arbitrary i, Integral i) => Arbitrary (MIx i) where+  arbitrary = do+    r <- positive+    c <- positive+    return $ MIx { row = r, col = c }++instance CoArbitrary i => CoArbitrary (MIx i) where+  coarbitrary (MIx r c) = coarbitrary r . coarbitrary c++-- | No nonpositive indices are allowed.++mIxInvariant :: (Ord i, Num i) => MIx i -> Bool+mIxInvariant i = row i >= 1 && col i >= 1++prop_Arbitrary_MIx :: MIx Integer -> Bool+prop_Arbitrary_MIx = mIxInvariant++-- | Type of matrices, parameterised on the type of values.++newtype Matrix i b = M { unM :: Array (MIx i) b }+  deriving (Eq, Ord)++matrixInvariant :: (Num i, Ix i) => Matrix i b -> Bool+matrixInvariant m =+  fst (bounds $ unM m) == MIx 1 1+  &&+  sizeInvariant (size m)++instance (Ix i, Num i, Enum i, Show i, Show b) => Show (Matrix i b) where+  showsPrec _ m =+    showString "Agda.Termination.Matrix.fromLists " . shows (size m) .+    showString " " . shows (toLists m)++instance (Arbitrary i, Num i, Integral i, Ix i, Arbitrary b)+         => Arbitrary (Matrix i b) where+  arbitrary     = matrix =<< arbitrary++instance (Ix i, Num i, Enum i, CoArbitrary b) => CoArbitrary (Matrix i b) where+  coarbitrary m = coarbitrary (toLists m)++prop_Arbitrary_Matrix :: TM -> Bool+prop_Arbitrary_Matrix = matrixInvariant++------------------------------------------------------------------------+-- Generating and creating matrices++-- | Generates a matrix of the given size, using the given generator+-- to generate the rows.++matrixUsingRowGen :: (Arbitrary i, Integral i, Ix i, Arbitrary b)+  => Size i+  -> (i -> Gen [b])+     -- ^ The generator is parameterised on the size of the row.+  -> Gen (Matrix i b)+matrixUsingRowGen sz rowGen = do+  rows <- vectorOf (fromIntegral $ rows sz) (rowGen $ cols sz)+  return $ fromLists sz rows++-- | Generates a matrix of the given size.++matrix :: (Arbitrary i, Integral i, Ix i, Arbitrary b)+  => Size i -> Gen (Matrix i b)+matrix sz = matrixUsingRowGen sz (\n -> vectorOf (fromIntegral n) arbitrary)++prop_matrix sz = forAll (matrix sz :: Gen TM) $ \m ->+  matrixInvariant m &&+  size m == sz++-- | Constructs a matrix from a list of (index, value)-pairs.++fromIndexList :: (Num i, Ix i) => Size i -> [(MIx i, b)] -> Matrix i b+fromIndexList sz = M . array (toBounds sz)++prop_fromIndexList :: TM -> Bool+prop_fromIndexList m = matrixInvariant m' && m' == m+  where vs = assocs $ unM m+        m' = fromIndexList (size m) vs++-- | @'fromLists' sz rs@ constructs a matrix from a list of lists of+-- values (a list of rows).+--+-- Precondition: @'length' rs '==' 'rows' sz '&&' 'all' (('==' 'cols' sz) . 'length') rs@.++fromLists :: (Num i, Ix i) => Size i -> [[b]] -> Matrix i b+fromLists sz bs = fromIndexList sz $ zip (range $ toBounds sz) (concat bs)++-- | Converts a matrix to a list of row lists.++toLists :: (Ix i, Num i, Enum i) => Matrix i b -> [[b]]+toLists m = [ [unM m ! MIx { row = r, col = c }+            | c <- [1 .. cols sz] ] | r <- [1 .. rows sz] ]+  where sz = size m++prop_fromLists_toLists :: TM -> Bool+prop_fromLists_toLists m = fromLists (size m) (toLists m) == m++------------------------------------------------------------------------+-- Combining and querying matrices++-- | The size of a matrix.++size :: Ix i => Matrix i b -> Size i+size m = Size { rows = row b, cols = col b }+  where (_, b) = bounds $ unM m++prop_size :: TM -> Bool+prop_size m = sizeInvariant (size m)++prop_size_fromIndexList :: Size Int -> Bool+prop_size_fromIndexList sz =+  size (fromIndexList sz ([] :: [(MIx Int, Integer)])) == sz++-- | 'True' iff the matrix is square.++square :: Ix i => Matrix i b -> Bool+square m = rows (size m) == cols (size m)++-- | Returns 'True' iff the matrix is empty.++isEmpty :: (Num i, Ix i) => Matrix i b -> Bool+isEmpty m = rows sz <= 0 || cols sz <= 0+  where sz = size m++-- | @'add' (+) m1 m2@ adds @m1@ and @m2@. Uses @(+)@ to add values.+--+-- Precondition: @'size' m1 == 'size' m2@.++add :: (Ix i, Num i)+    => (a -> b -> c) -> Matrix i a -> Matrix i b -> Matrix i c+add (+) m1 m2 =+  fromIndexList (size m1)+                [ (i, (unM m1 ! i) + (unM m2 ! i))+                | i <- range $ toBounds $ size m1 ]++prop_add sz =+  forAll (vectorOf 3 (matrix sz :: Gen TM)) $ \[m1, m2, m3] ->+    let m' = add (+) m1 m2 in+      associative (add (+)) m1 m2 m3 &&+      commutative (add (+)) m1 m2 &&+      matrixInvariant m' &&+      size m' == size m1++-- | @'mul' semiring m1 m2@ multiplies @m1@ and @m2@. Uses the+-- operations of the semiring @semiring@ to perform the+-- multiplication.+--+-- Precondition: @'cols' ('size' m1) == rows ('size' m2)@.++mul :: (Enum i, Num i, Ix i)+    => Semiring a -> Matrix i a -> Matrix i a -> Matrix i a+mul semiring m1 m2 =+  fromIndexList sz' [ (ix, res)+                    | r <- [1 .. rows $ size m1]+                    , c <- [1 .. cols $ size m2]+                    , let ix = MIx { row = r, col = c }+                    , let res = mulRowCol r c+                    ]+    where+    sz' = Size { rows = rows $ size m1, cols = cols $ size m2 }++    mulRowCol r c =+      foldl' (Semiring.add semiring) (Semiring.zero semiring)+             [ (Semiring.mul semiring)+               (unM m1 ! MIx { row = r, col = i })+               (unM m2 ! MIx { row = i, col = c })+             | i <- [1 .. cols (size m1)]]++prop_mul sz =+  sized $ \n -> resize (n `div` 2) $+  forAll (vectorOf 2 natural) $ \[c2, c3] ->+  forAll (matrix sz :: Gen TM) $ \m1 ->+  forAll (matrix (Size { rows = cols sz, cols = c2 })) $ \m2 ->+  forAll (matrix (Size { rows = c2, cols = c3 })) $ \m3 ->+    let m' = mult m1 m2 in+      associative mult m1 m2 m3 &&+      matrixInvariant m' &&+      size m' == Size { rows = rows sz, cols = c2 }+  where mult = mul Semiring.integerSemiring++-- | @'diagonal' m@ extracts the diagonal of @m@.+--+-- Precondition: @'square' m@.++diagonal :: (Enum i, Num i, Ix i) => Matrix i b -> Array i b+diagonal m = listArray (1, rows sz) [ unM m ! MIx {row = i, col = i}+                                    | i <- [1 .. rows sz] ]+  where sz = size m++prop_diagonal =+  forAll natural $ \n ->+  forAll (matrix (Size n n) :: Gen TM) $ \m ->+    bounds (diagonal m) == (1, n)++------------------------------------------------------------------------+-- Modifying matrices++-- | @'addColumn' x m@ adds a new column to @m@, after the columns+-- already existing in the matrix. All elements in the new column get+-- set to @x@.++addColumn :: (Ix i, Num i, Enum i) => b -> Matrix i b -> Matrix i b+addColumn x m = fromLists sz . addCol' . toLists $ m+  where+  sz      = (size m) { cols = cols (size m) + 1 }+  addCol' = map (++ [x])++prop_addColumn :: Integer -> TM -> Bool+prop_addColumn x m =+  matrixInvariant m'+  &&+  map init (toLists m') == toLists m+  where+  m' = addColumn x m++-- | @'addRow' x m@ adds a new row to @m@, after the rows already+-- existing in the matrix. All elements in the new row get set to @x@.++addRow :: (Ix i, Integral i) => b -> Matrix i b -> Matrix i b+addRow x m = fromLists sz . addRow' . toLists $ m+  where+  sz      = (size m) { rows = rows (size m) + 1 }+  addRow' = (++ [genericReplicate (cols (size m)) x])++prop_addRow :: Integer -> TM -> Bool+prop_addRow x m =+  matrixInvariant m'+  &&+  init (toLists m') == toLists m+  where+  m' = addRow x m++------------------------------------------------------------------------+-- Zipping (assumes non-empty matrices)++zipWith :: (a -> b -> c) -> +           Matrix Integer a -> Matrix Integer b -> Matrix Integer c+zipWith f m1 m2 +  = fromLists (Size { rows = toInteger $ length ll, +                      cols = toInteger $ length (head ll) }) ll+    where ll = List.zipWith (List.zipWith f) (toLists m1) (toLists m2)+++------------------------------------------------------------------------+-- All tests++tests = runTests "Agda.Termination.Matrix"+  [ quickCheck' prop_Arbitrary_Size+  , quickCheck' prop_Arbitrary_Matrix+  , quickCheck' prop_Arbitrary_MIx+  , quickCheck' prop_fromIndexList+  , quickCheck' prop_matrix+  , quickCheck' prop_size+  , quickCheck' prop_size_fromIndexList+  , quickCheck' prop_fromLists_toLists+  , quickCheck' prop_add+  , quickCheck' prop_mul+  , quickCheck' prop_diagonal+  , quickCheck' prop_addColumn+  , quickCheck' prop_addRow+  ]

+ src/full/Agda/Termination/Semiring.hs view

@@ -0,0 +1,66 @@+-- | Semirings.++module Agda.Termination.Semiring+  ( Semiring(..)+  , semiringInvariant+  , integerSemiring+  , boolSemiring+  , Agda.Termination.Semiring.tests+  ) where++import Agda.Utils.QuickCheck+import Agda.Utils.TestHelpers++-- | Semirings.++data Semiring a+  = Semiring { add  :: a -> a -> a  -- ^ Addition.+             , mul  :: a -> a -> a  -- ^ Multiplication.+             , zero :: a            -- ^ Zero.+             , one  :: a            -- ^ One.+             }++-- | Semiring invariant.++-- I think it's OK to use the same x, y, z triple for all the+-- properties below.++semiringInvariant :: (Arbitrary a, Eq a, Show a)+                  => Semiring a+                  -> a -> a -> a -> Bool+semiringInvariant (Semiring { add = (+), mul = (*)+                            , zero = zero, one = one}) = \x y z ->+  associative (+)           x y z &&+  identity zero (+)         x     &&+  commutative (+)           x y   &&+  associative (*)           x y z &&+  identity one (*)          x     &&+  leftDistributive (*) (+)  x y z &&+  rightDistributive (*) (+) x y z &&+  isZero zero (*)           x++------------------------------------------------------------------------+-- Specific semirings++-- | The standard semiring on 'Integer's.++integerSemiring :: Semiring Integer+integerSemiring = Semiring { add = (+), mul = (*), zero = 0, one = 1 }++prop_integerSemiring = semiringInvariant integerSemiring++-- | The standard semiring on 'Bool's.++boolSemiring :: Semiring Bool+boolSemiring =+  Semiring { add = (||), mul = (&&), zero = False, one = True }++prop_boolSemiring = semiringInvariant boolSemiring++------------------------------------------------------------------------+-- All tests++tests = runTests "Agda.Termination.Semiring"+  [ quickCheck' prop_integerSemiring+  , quickCheck' prop_boolSemiring+  ]

+ src/full/Agda/Termination/TermCheck.hs view

@@ -0,0 +1,555 @@+{-# LANGUAGE CPP #-}++{- Checking for Structural recursion+   Authors: Andreas Abel, Nils Anders Danielsson, Ulf Norell, +              Karl Mehltretter and others+   Created: 2007-05-28+   Source : TypeCheck.Rules.Decl+ -}++module Agda.Termination.TermCheck (termDecls) where++import Control.Monad.Error+import Data.List as List+import qualified Data.Map as Map+import Data.Map (Map)+import qualified Data.Maybe as Maybe+import qualified Data.Set as Set+import Data.Set (Set)+import Text.PrettyPrint (Doc)+import qualified System.IO.UTF8 as UTF8++import qualified Agda.Syntax.Abstract as A+import Agda.Syntax.Internal+import qualified Agda.Syntax.Info as Info+import Agda.Syntax.Position+import Agda.Syntax.Common+import Agda.Syntax.Literal (Literal(LitString))++import Agda.Termination.CallGraph   as Term+import qualified Agda.Termination.Matrix      as Term+import qualified Agda.Termination.Termination as Term++import Agda.TypeChecking.Monad+import Agda.TypeChecking.Pretty+import Agda.TypeChecking.Reduce (reduce, normalise, instantiate, instantiateFull)+import Agda.TypeChecking.Rules.Term (isType_)+import Agda.TypeChecking.Substitute (abstract,raise,substs)+import Agda.TypeChecking.Telescope+import Agda.TypeChecking.EtaContract+import Agda.TypeChecking.Monad.Builtin+import Agda.TypeChecking.Primitive (constructorForm)++import qualified Agda.Interaction.Highlighting.Range as R+import Agda.Interaction.Options++import Agda.Utils.Size+import Agda.Utils.String+import Agda.Utils.Monad (thread, (<$>), ifM)++#include "../undefined.h"+import Agda.Utils.Impossible++type Calls = Term.CallGraph (Set R.Range)+type MutualNames = [QName]++-- | The result of termination checking a module is a list of+-- problematic mutual blocks (represented by the names of the+-- functions in the block), along with the ranges for the problematic+-- call sites (call site paths).++type Result = [([A.QName], [R.Range])]++-- | Termination check a sequence of declarations.+termDecls :: [A.Declaration] -> TCM Result+termDecls ds = fmap concat $ mapM termDecl ds++-- | Termination check a single declaration.+termDecl :: A.Declaration -> TCM Result+termDecl d =+    case d of+	A.Axiom {}		 -> return []+        A.Field {}               -> return []+	A.Primitive {}  	 -> return []+	A.Definition i ts ds	 -> termMutual i ts ds+	A.Section i x tel ds	 -> termSection i x tel ds+	A.Apply {}               -> return []+	A.Import {}		 -> return []+	A.Pragma {}		 -> return []+	A.ScopedDecl scope ds	 -> setScope scope >> termDecls ds+	    -- open is just an artifact from the concrete syntax++collectCalls :: (a -> TCM Calls) -> [a] -> TCM Calls+collectCalls f [] = return Term.empty+collectCalls f (a : as) = do c1 <- f a+                             c2 <- collectCalls f as+                             return (c1 `Term.union` c2)++-- | Termination check a bunch of mutually inductive recursive definitions.+termMutual :: Info.DeclInfo -> [A.TypeSignature] -> [A.Definition] -> TCM Result+termMutual i ts ds = if names == [] then return [] else+  do -- get list of sets of mutually defined names from the TCM+     -- this includes local and auxiliary functions introduced+     -- during type-checking+     reportSLn "term.top" 20 $ "Termination checking " ++ show names ++ "..."+     mutualBlock <- findMutualBlock (head names)+     let allNames = Set.elems mutualBlock++     -- collect all recursive calls in the block+     let collect use = collectCalls (termDef use allNames) allNames++     -- Get the name of size suc (if sized types are enabled)+     suc <- sizeSuc++     -- first try to termination check ignoring the dot patterns+     let conf = DBPConf { useDotPatterns = False, withSizeSuc = suc }+     calls1 <- collect conf{ useDotPatterns = False }+     reportS "term.lex" 30 $ unlines+       [ "Calls (no dot patterns): " ++ show calls1+       ]+     reportS "term.behaviours" 30 $ unlines+       [ "Recursion behaviours (no dot patterns):"+       , indent 2 $ Term.showBehaviour (Term.complete calls1)+       ]+     r <- do let r = Term.terminates calls1+             case r of+               Right _ -> return r+               Left _  -> do+     -- now try to termination check regarding the dot patterns     +                 calls2 <- collect conf{ useDotPatterns = True }+                 reportS "term.lex" 30 $ unlines+                   [ "Calls    (dot patterns): " ++ show calls2+                   ]+                 reportS "term.behaviours" 30 $ unlines+                   [ "Recursion behaviours (no dot patterns):"+                   , indent 2 $ Term.showBehaviour (Term.complete calls1)+                   , "Recursion behaviours (dot patterns):"+                   , indent 2 $ Term.showBehaviour (Term.complete calls2)+                   ]+                 return $ Term.terminates calls2+     case r of+       Left  errDesc -> do+         let callSites = Set.toList errDesc+         return [(names, callSites)] -- TODO: this could be changed to+                                     -- [(allNames, callSites)]+       Right _ -> do+         reportSLn "term.warn.yes" 2+                     (show (names) ++ " does termination check")+         return []+  where+  getName (A.FunDef i x cs) = [x]+  getName (A.ScopedDef _ d) = getName d+  getName _                 = []++  -- the mutual names mentioned in the abstract syntax+  names = concatMap getName ds++  concat' :: Ord a => [Set a] -> [a]+  concat' = Set.toList . Set.unions++-- | Termination check a module.+termSection :: Info.ModuleInfo -> ModuleName -> A.Telescope -> [A.Declaration] -> TCM Result+termSection i x tel ds =+  termTelescope tel $ \tel' -> do+    addSection x (size tel')+    verboseS "term.section" 10 $ do+      dx   <- prettyTCM x+      dtel <- mapM prettyA tel+      dtel' <- prettyTCM =<< lookupSection x+      liftIO $ UTF8.putStrLn $ "termination checking section " ++ show dx ++ " " ++ show dtel+      liftIO $ UTF8.putStrLn $ "    actual tele: " ++ show dtel'+    withCurrentModule x $ termDecls ds++-- | Termination check a telescope. Binds the variables defined by the telescope.+termTelescope :: A.Telescope -> (Telescope -> TCM a) -> TCM a+termTelescope [] ret = ret EmptyTel+termTelescope (b : tel) ret =+    termTypedBindings b $ \tel1 ->+    termTelescope tel   $ \tel2 ->+	ret $ abstract tel1 tel2+++-- | Termination check a typed binding and extends the context with the bound variables.+--   The telescope passed to the continuation is valid in the original context.+termTypedBindings :: A.TypedBindings -> (Telescope -> TCM a) -> TCM a+termTypedBindings (A.TypedBindings i h bs) ret =+    thread (termTypedBinding h) bs $ \bss ->+    ret $ foldr (\(x,t) -> ExtendTel (Arg h t) . Abs x) EmptyTel (concat bss)++termTypedBinding :: Hiding -> A.TypedBinding -> ([(String,Type)] -> TCM a) -> TCM a+termTypedBinding h (A.TBind i xs e) ret = do+    t <- isType_ e+    addCtxs xs (Arg h t) $ ret $ mkTel xs t+    where+	mkTel [] t     = []+	mkTel (x:xs) t = (show $ nameConcrete x,t) : mkTel xs (raise 1 t)+termTypedBinding h (A.TNoBind e) ret = do+    t <- isType_ e+    ret [("_",t)]++-- | Termination check a definition by pattern matching.+termDef :: DBPConf -> MutualNames -> QName -> TCM Calls+termDef use names name = do+	-- Retrieve definition+        def <- getConstInfo name+        -- returns a TC.Monad.Base.Definition++	reportSDoc "term.def.fun" 10 $+	  sep [ text "termination checking body of" <+> prettyTCM name+	      , nest 2 $ text ":" <+> (prettyTCM $ defType def)+	      ]+        case (theDef def) of+          Function{ funClauses = cls } ->+            collectCalls (termClause use names name) cls+          _ -> return Term.empty+++-- | Termination check clauses+{- Precondition: Each clause headed by the same number of patterns++   For instance++   f x (cons y nil) = g x y++   Clause+     [VarP "x", ConP "List.cons" [VarP "y", ConP "List.nil" []]]+     Bind (Abs { absName = "x"+               , absBody = Bind (Abs { absName = "y"+                                     , absBody = Def "g" [ Var 1 []+                                                         , Var 0 []]})})++   Outline:+   - create "De Bruijn pattern"+   - collect recursive calls+   - going under a binder, lift de Bruijn pattern+   - compare arguments of recursive call to pattern++-}++data DeBruijnPat = VarDBP Nat  -- de Bruijn Index+	         | ConDBP QName [DeBruijnPat]+                   -- ^ The name refers to either an ordinary+                   --   constructor or the successor function on sized+                   --   types.+	         | LitDBP Literal++instance PrettyTCM DeBruijnPat where+  prettyTCM (VarDBP i)    = text $ show i+  prettyTCM (ConDBP c ps) = parens (prettyTCM c <+> hsep (map prettyTCM ps))+  prettyTCM (LitDBP l)    = prettyTCM l ++unusedVar :: DeBruijnPat+unusedVar = LitDBP (LitString noRange "term.unused.pat.var")++adjIndexDBP :: (Nat -> Nat) -> DeBruijnPat -> DeBruijnPat+adjIndexDBP f (VarDBP i)      = VarDBP (f i)+adjIndexDBP f (ConDBP c args) = ConDBP c (map (adjIndexDBP f) args)+adjIndexDBP f (LitDBP l)      = LitDBP l++{- | liftDeBruijnPat p n++     increases each de Bruijn index in p by n.+     Needed when going under a binder during analysis of a term.+-}++liftDBP :: DeBruijnPat -> DeBruijnPat+liftDBP = adjIndexDBP (1+)++{- | Configuration parameters to termination checker.+-}+data DBPConf = DBPConf { useDotPatterns :: Bool+                       , withSizeSuc    :: Maybe QName+                       }++{- | Convert a term (from a dot pattern) to a DeBruijn pattern.+-}++termToDBP :: DBPConf -> Term -> TCM DeBruijnPat+termToDBP conf t+  | not $ useDotPatterns conf = return $ unusedVar+  | otherwise                 = do+    t <- constructorForm t+    case t of+      Var i []    -> return $ VarDBP i+      Con c args  -> ConDBP c <$> mapM (termToDBP conf . unArg) args+      Def s [arg]+        | Just s == withSizeSuc conf -> ConDBP s . (:[]) <$> termToDBP conf (unArg arg)+      Lit l       -> return $ LitDBP l+      _   -> return unusedVar++-- | Removes coconstructors from a deBruijn pattern.+stripCoConstructors :: DBPConf -> DeBruijnPat -> TCM DeBruijnPat+stripCoConstructors conf p = case p of+  VarDBP _  -> return p+  LitDBP _ -> return p+  ConDBP c args -> do+    ind <- if withSizeSuc conf == Just c then+             return Inductive+            else+             whatInduction c+    case ind of+      Inductive   -> ConDBP c <$> mapM (stripCoConstructors conf) args+      CoInductive -> return unusedVar++{- | stripBind i p b = Just (i', dbp, b')++  converts a pattern into a de Bruijn pattern++  i  is the next free de Bruijn level before consumption of p+  i' is the next free de Bruijn level after  consumption of p++  if the clause has no body (b = NoBody), Nothing is returned++-}+stripBind :: DBPConf -> Nat -> Pattern -> ClauseBody -> TCM (Maybe (Nat, DeBruijnPat, ClauseBody))+stripBind _ _ _ NoBody            = return Nothing+stripBind conf i (VarP x) (NoBind b) = return $ Just (i, unusedVar, b)+stripBind conf i (VarP x) (Bind b)   = return $ Just (i - 1, VarDBP i, absBody b)+stripBind conf i (VarP x) (Body b)   = __IMPOSSIBLE__+stripBind conf i (DotP t) (NoBind b) = do+  t <- termToDBP conf t+  return $ Just (i, t, b)+stripBind conf i (DotP t) (Bind b)   = do+  t <- termToDBP conf t+  return $ Just (i - 1, t, absBody b)+stripBind conf i (DotP _) (Body b)   = __IMPOSSIBLE__+stripBind conf i (LitP l) b          = return $ Just (i, LitDBP l, b)+stripBind conf i (ConP c args) b     = do +    r <- stripBinds conf i (map unArg args) b+    case r of+      Just (i', dbps, b') -> return $ Just (i', ConDBP c dbps, b')+      _                   -> return Nothing++{- | stripBinds i ps b = Just (i', dbps, b')++  i  is the next free de Bruijn level before consumption of ps+  i' is the next free de Bruijn level after  consumption of ps+-}+stripBinds :: DBPConf -> Nat -> [Pattern] -> ClauseBody -> TCM (Maybe (Nat, [DeBruijnPat], ClauseBody))+stripBinds use i [] b     = return $ Just (i, [], b)+stripBinds use i (p:ps) b = do+  r1 <- stripBind use i p b+  case r1 of+    Just (i1, dbp, b1) -> do+      r2 <- stripBinds use i1 ps b1+      case r2 of+        Just (i2, dbps, b2) -> return $ Just (i2, dbp:dbps, b2)+        Nothing -> return Nothing+    Nothing -> return Nothing++-- | Extract recursive calls from one clause.+termClause :: DBPConf -> MutualNames -> QName -> Clause -> TCM Calls+termClause use names name (Clause { clauseTel  = tel+                                  , clausePerm = perm+                                  , clausePats = argPats'+                                  , clauseBody = body }) = do+    argPats' <- addCtxTel tel $ normalise argPats'+    -- The termination checker doesn't know about reordered telescopes+    let argPats = substs (renamingR perm) argPats'+    dbs <- stripBinds use (nVars - 1) (map unArg argPats) body+    case dbs of+       Nothing -> return Term.empty+       Just (-1, dbpats, Body t) -> do+          dbpats <- mapM (stripCoConstructors use) dbpats+          termTerm names name dbpats t+          -- note: convert dB levels into dB indices+       Just (n, dbpats, Body t) -> internalError $ "termClause: misscalculated number of vars: guess=" ++ show nVars ++ ", real=" ++ show (nVars - 1 - n)+       Just (n, dbpats, b)  -> internalError $ "termClause: not a Body" -- ++ show b+  where+    nVars = boundVars body+    boundVars (Bind b)   = 1 + boundVars (absBody b)+    boundVars (NoBind b) = boundVars b+    boundVars NoBody     = 0+    boundVars (Body _)   = 0++-- | Extract recursive calls from a term.+termTerm :: MutualNames -> QName -> [DeBruijnPat] -> Term -> TCM Calls+termTerm names f pats0 t0 = do+  reportSDoc "term.check.clause" 11+    (sep [ text "termination checking clause of" <+> prettyTCM f+         , nest 2 $ text "lhs:" <+> hsep (map prettyTCM pats0)+         , nest 2 $ text "rhs:" <+> prettyTCM t0+         ])+  loop pats0 Le t0+  where +       Just fInd = toInteger <$> List.elemIndex f names+       loop :: [DeBruijnPat] -> Order -> Term -> TCM Calls+       loop pats guarded t = do+         t <- instantiate t          -- instantiate top-level MetaVar+         suc <- sizeSuc+         case t of++            -- call to defined function+            Def g args0 ->+               do let args1 = map unArg args0+                  args2 <- mapM instantiateFull args1++                  -- We have to reduce constructors in case they're reexported.+                  let reduceCon t@(Con _ _) = reduce t+                      reduceCon t           = return t+                  args2 <- mapM reduceCon args2+                  let args = map etaContract args2++                  -- collect calls in the arguments of this call+                  calls <- collectCalls (loop pats Unknown) args+++                  reportSDoc "term.found.call" 10 +                          (sep [ text "found call from" <+> prettyTCM f+                               , nest 2 $ text "to" <+> prettyTCM g+                	       ])++                  -- insert this call into the call list+                  case List.elemIndex g names of+ +                     -- call leads outside the mutual block and can be ignored+                     Nothing   -> return calls+ +                     -- call is to one of the mutally recursive functions+                     Just gInd' -> do++                        matrix <- compareArgs suc pats args+                        let ncols   = genericLength pats + 1+                            nrows   = genericLength args + 1+                            matrix' = addGuardedness guarded (ncols - 1) matrix++                        reportSDoc "term.kept.call" 10 +                          (sep [ text "kept call from" <+> prettyTCM f+                                  <+> hsep (map prettyTCM pats)+                               , nest 2 $ text "to" <+> prettyTCM g <+> +                                           hsep (map (parens . prettyTCM) args)+                               , nest 2 $ text ("call matrix: " ++ show matrix)+                	       ])+                       +                        return+                          (Term.insert+                            (Term.Call { Term.source = fInd+                                       , Term.target = toInteger gInd'+                                       , Term.cm     = makeCM ncols nrows matrix'+                                       })+                            -- Note that only the base part of the+                            -- name is collected here.+                            (Set.fromList $ fst $ R.getRangesA g)+                            calls)++            -- abstraction+            Lam _ (Abs _ t) -> loop (map liftDBP pats) guarded t++            -- variable+            Var i args -> collectCalls (loop pats Unknown) (map unArg args)++            -- constructed value+            Con c args -> do+              ind <- whatInduction c+              let g' = case ind of+                        Inductive   -> guarded+                        CoInductive -> Lt .*. guarded+              collectCalls (loop pats g') (map unArg args)++            -- dependent function space+            Pi (Arg _ (El _ a)) (Abs _ (El _ b)) ->+               do g1 <- loop pats guarded a+                  g2 <- loop (map liftDBP pats) guarded b+                  return $ g1 `Term.union` g2++            -- non-dependent function space+            Fun (Arg _ (El _ a)) (El _ b) ->+               do g1 <- loop pats guarded a+                  g2 <- loop pats guarded b+                  return $ g1 `Term.union` g2++            -- literal+            Lit l -> return Term.empty++            -- sort+            Sort s -> return Term.empty++	    -- Unsolved metas are not considered termination problems, there+	    -- will be a warning for them anyway.+            MetaV x args -> return Term.empty++{- | compareArgs suc pats ts++     compare a list of de Bruijn patterns (=parameters) @pats@ +     with a list of arguments @ts@ and create a call maxtrix +     with |ts| rows and |pats| columns.++     If sized types are enabled, @suc@ is the name of the size successor.+ -} +compareArgs :: Maybe QName -> [DeBruijnPat] -> [Term] -> TCM [[Term.Order]]+compareArgs suc pats ts = mapM (\t -> mapM (compareTerm suc t) pats) ts++-- | 'makeCM' turns the result of 'compareArgs' into a proper call matrix+makeCM :: Index -> Index -> [[Term.Order]] -> Term.CallMatrix+makeCM ncols nrows matrix = Term.CallMatrix $+  Term.fromLists (Term.Size { Term.rows = nrows+                            , Term.cols = ncols+                            })+                 matrix++-- | 'addGuardedness' adds guardedness flag in the upper left corner (0,0).+addGuardedness :: Integral n => Order -> n -> [[Term.Order]] -> [[Term.Order]]+addGuardedness g ncols m =+  (g : genericReplicate ncols Unknown) : map (Unknown :) m++-- | Compute the sub patterns of a 'DeBruijnPat'.+subPatterns :: DeBruijnPat -> [DeBruijnPat]+subPatterns p = case p of+  VarDBP _    -> []+  ConDBP c ps -> ps ++ concatMap subPatterns ps+  LitDBP _    -> []++compareTerm :: Maybe QName -> Term -> DeBruijnPat -> TCM Term.Order+compareTerm suc t p = compareTerm' suc t p+{-+compareTerm t p = Term.supremum $ compareTerm' t p : map cmp (subPatterns p)+  where+    cmp p' = (Term..*.) Term.Lt (compareTerm' t p')+-}++-- | compareTerm t dbpat+--   Precondition: top meta variable resolved+compareTerm' :: Maybe QName -> Term -> DeBruijnPat -> TCM Term.Order+compareTerm' _ (Var i _)  p              = compareVar i p+compareTerm' _ (Lit l)    (LitDBP l')+  | l == l'   = return Term.Le+  | otherwise = return Term.Unknown+compareTerm' suc (Lit l) p = do+  t <- constructorForm (Lit l)+  case t of+    Lit _ -> return Term.Unknown+    _     -> compareTerm' suc t p+compareTerm' suc (Con c ts) (ConDBP c' ps)+  | c == c' = compareConArgs suc ts ps+compareTerm' suc (Def s ts) (ConDBP s' ps)+  | s == s' && Just s == suc = compareConArgs suc ts ps+compareTerm' _ _ _ = return Term.Unknown++compareConArgs :: Maybe QName -> Args -> [DeBruijnPat] -> TCM Term.Order+compareConArgs suc ts ps =+  -- we may assume |ps| >= |ts|, otherwise c ps would be of functional type+  -- which is impossible+      case (length ts, length ps) of+        (0,0) -> return Term.Le        -- c <= c+        (0,1) -> return Term.Unknown   -- c not<= c x+        (1,0) -> __IMPOSSIBLE__ +        (1,1) -> compareTerm' suc (unArg (head ts)) (head ps)+        (_,_) -> do -- build "call matrix"+          m <- mapM (\t -> mapM (compareTerm' suc (unArg t)) ps) ts+          let m2 = makeCM (genericLength ps) (genericLength ts) m+          return $ Term.Mat (Term.mat m2)+{-+--    if null ts then Term.Le+--               else Term.infimum (zipWith compareTerm' (map unArg ts) ps)+     foldl (Term..*.) Term.Le (zipWith compareTerm' (map unArg ts) ps)+       -- corresponds to taking the size, not the height+       -- allows examples like (x, y) < (Succ x, y)+-}++compareVar :: Nat -> DeBruijnPat -> TCM Term.Order+compareVar i (VarDBP j)    = return $ if i == j then Term.Le else Term.Unknown+compareVar i (LitDBP _)    = return $ Term.Unknown+compareVar i (ConDBP c ps) = do+  os <- mapM (compareVar i) ps+  let o = Term.supremum os +  return $ (Term..*.) Term.Lt o

+ src/full/Agda/Termination/Termination.hs view

@@ -0,0 +1,257 @@+-- | Termination checker, based on+--     \"A Predicative Analysis of Structural Recursion\" by+--     Andreas Abel and Thorsten Altenkirch (JFP'01).+--   and+--     \"The Size-Change Principle for Program Termination\" by+--     Chin Soon Lee, Neil Jones, and Amir Ben-Amram (POPL'01).+--+-- TODO: Note that we should also check that data type definitions are+-- strictly positive. Furthermore, for inductive-recursive families we+-- may need to do something more clever.++module Agda.Termination.Termination+  ( terminates+  , Agda.Termination.Termination.tests+  ) where++import Agda.Termination.Lexicographic+import Agda.Termination.CallGraph+import Agda.Termination.Matrix+import Agda.Utils.Either+import Agda.Utils.TestHelpers+import Control.Arrow+import Agda.Utils.QuickCheck+import qualified Data.Set as Set+import qualified Data.Array as Array+import Data.Set (Set)+import qualified Data.Set as Set+import Data.Map (Map)+import qualified Data.Map as Map+import Data.Monoid+import Data.Array (Array)++-- | TODO: This comment seems to be partly out of date.+--+-- @'terminates' cs@ checks if the functions represented by @cs@+-- terminate. The call graph @cs@ should have one entry ('Call') per+-- recursive function application.+--+-- @'Right' perms@ is returned if the functions are size-change terminating.+--+-- If termination can not be established, then @'Left' problems@ is+-- returned instead. Here @problems@ contains an+-- indication of why termination cannot be established. See 'lexOrder'+-- for further details.+--+-- Note that this function assumes that all data types are strictly+-- positive.+--+-- The termination criterion is taken from Jones et al.+-- In the completed call graph, each idempotent call-matrix +-- from a function to itself must have a decreasing argument.+-- Idempotency is wrt. matrix multiplication.+--+-- This criterion is strictly more liberal than searching for a +-- lexicographic order (and easier to implement, but harder to justify).++terminates :: (Ord meta, Monoid meta) => CallGraph meta -> Either meta ()+terminates cs = let ccs = complete cs+                in+                  checkIdems $ toList ccs++checkIdems :: (Ord meta,Monoid meta) => [(Call,meta)] -> Either meta ()+checkIdems [] = Right ()+checkIdems ((c,m):xs) = if (checkIdem c) then checkIdems xs else Left m++{- Convention (see TermCheck): +   Guardedness flag is in position (0,0) of the matrix,+   it is always present even if the functions are all recursive.+   The examples below do not include the guardedness flag, though.+ -}+   +checkIdem :: Call -> Bool+checkIdem c = let+  b = target c == source c+  idem = (c >*< c) == c+  diag =  Array.elems $ diagonal (mat (cm c))+  hasDecr = any isDecr $ diag+  in+    (not b) || (not idem) || hasDecr++-- | Matrix is decreasing if any diagonal element is 'Lt'.++isDecr :: Order -> Bool+isDecr Lt = True+isDecr (Mat m) = any isDecr $ Array.elems $ diagonal m+isDecr _ = False++------------------------------------------------------------------------+-- Some examples++-- | The call graph instantiation used by the examples below.++type CG = CallGraph (Set Integer)++-- | Constructs a call graph suitable for use with the 'R' monoid.++buildCallGraph :: [Call] -> CG+buildCallGraph = fromList . flip zip (map Set.singleton [1 ..])++-- | The example from the JFP'02 paper.++example1 :: CG+example1 = buildCallGraph [c1, c2, c3]+  where+  flat = 1+  aux  = 2+  c1 = Call { source = flat, target = aux+            , cm = CallMatrix $ fromLists (Size 2 1) [[Lt], [Lt]] +            }+  c2 = Call { source = aux,  target = aux+            , cm = CallMatrix $ fromLists (Size 2 2) [ [Lt, Unknown]+                                                     , [Unknown, Le]] +            }+  c3 = Call { source = aux,  target = flat+            , cm = CallMatrix $ fromLists (Size 1 2) [[Unknown, Le]] +            }++prop_terminates_example1 = isRight $ terminates example1++-- | An example which is now handled by this algorithm: argument+-- swapping addition.+--+-- @S x + y = S (y + x)@+--+-- @Z   + y = y@++example2 :: CG+example2 = buildCallGraph [c]+  where+  plus = 1+  c = Call { source = plus, target = plus+           , cm = CallMatrix $ fromLists (Size 2 2) [ [Unknown, Le]+                                                    , [Lt, Unknown] ]  +           }++prop_terminates_example2 = isRight $ terminates example2 ++-- | A related example which is anyway handled: argument swapping addition+-- using two alternating functions.+--+-- @S x + y = S (y +' x)@+--+-- @Z   + y = y@+--+-- @S x +' y = S (y + x)@+--+-- @Z   +' y = y@++example3 :: CG+example3 = buildCallGraph [c plus plus', c plus' plus]+  where+  plus  = 1+  plus' = 2+  c f g = Call { source = f, target = g+               , cm = CallMatrix $ fromLists (Size 2 2) [ [Unknown, Le]+                                                        , [Lt, Unknown] ]  +               }++prop_terminates_example3 = isRight $ terminates example3 ++-- | A contrived example.+--+-- @f (S x) y = f (S x) y + g x y@+--+-- @f Z     y = y@+--+-- @g x y = f x y@+--+-- TODO: This example checks that the meta information is reported properly+-- when an error is encountered.++example4 :: CG+example4 = buildCallGraph [c1, c2, c3]+  where+  f = 1+  g = 2+  c1 = Call { source = f, target = f+            , cm = CallMatrix $ fromLists (Size 2 2) [ [Le, Unknown]+                                                     , [Unknown, Le] ]  +            }+  c2 = Call { source = f, target = g+            , cm = CallMatrix $ fromLists (Size 2 2) [ [Lt, Unknown]+                                                     , [Unknown, Le] ]  +            }+  c3 = Call { source = g, target = f+            , cm = CallMatrix $ fromLists (Size 2 2) [ [Le, Unknown]+                                                     , [Unknown, Le] ]  +            }++prop_terminates_example4 = isLeft $ terminates example4++-- | This should terminate.+--+-- @f (S x) (S y) = g x (S y) + f (S (S x)) y@ +--+-- @g (S x) (S y) = f (S x) (S y) + g x (S y)@++example5 :: CG+example5 = buildCallGraph [c1, c2, c3, c4]+  where+  f = 1+  g = 2+  c1 = Call { source = f, target = g+            , cm = CallMatrix $ fromLists (Size 2 2) [ [Lt, Unknown]+                                                     , [Unknown, Le] ]  +            }+  c2 = Call { source = f, target = f+            , cm = CallMatrix $ fromLists (Size 2 2) [ [Unknown, Unknown]+                                                     , [Unknown, Lt] ]  +            }+  c3 = Call { source = g, target = f+            , cm = CallMatrix $ fromLists (Size 2 2) [ [Le, Unknown]+                                                     , [Unknown, Le] ]  +            }+  c4 = Call { source = g, target = g+            , cm = CallMatrix $ fromLists (Size 2 2) [ [Lt, Unknown]+                                                     , [Unknown, Le] ]  +            }++prop_terminates_example5 = isRight $ terminates example5 ++-- | Another example which should fail.+--+-- @f (S x) = f x + f (S x)@+--+-- @f x     = f x@+--+-- TODO: This example checks that the meta information is reported properly+-- when an error is encountered.++example6 :: CG+example6 = buildCallGraph [c1, c2, c3]+  where+  f = 1+  c1 = Call { source = f, target = f+            , cm = CallMatrix $ fromLists (Size 1 1) [ [Lt] ]  +            }+  c2 = Call { source = f, target = f+            , cm = CallMatrix $ fromLists (Size 1 1) [ [Le] ]  +            }+  c3 = Call { source = f, target = f+            , cm = CallMatrix $ fromLists (Size 1 1) [ [Le] ]  +            }++prop_terminates_example6 = isLeft $ terminates example6 ++------------------------------------------------------------------------+-- All tests++tests = runTests "Agda.Termination.Termination"+  [ quickCheck' prop_terminates_example1+  , quickCheck' prop_terminates_example2+  , quickCheck' prop_terminates_example3+  , quickCheck' prop_terminates_example4+  , quickCheck' prop_terminates_example5+  , quickCheck' prop_terminates_example6+  ]

+ src/full/Agda/Tests.hs view

@@ -0,0 +1,44 @@++-- | Responsible for running all internal tests.+module Agda.Tests (testSuite) where++import Agda.Utils.TestHelpers++import Agda.Compiler.MAlonzo.Encode           as CompEnco   (tests)+import Agda.Interaction.Highlighting.Emacs    as InteEmac   (tests)+import Agda.Interaction.Highlighting.Generate as InteGene   (tests)+import Agda.Interaction.Highlighting.Precise  as IntePrec   (tests)+import Agda.Interaction.Highlighting.Range    as InteRang   (tests)+import Agda.Interaction.Options               as InteOpti   (tests)+import Agda.Syntax.Position                   as SyntPosi   (tests)+import Agda.Termination.Termination	      as TermTerm   (tests)+import Agda.Termination.CallGraph	      as TermCall   (tests)+import Agda.Termination.Lexicographic         as TermLex    (tests)+import Agda.Termination.Matrix                as TermMatrix (tests)+import Agda.Termination.Semiring	      as TermRing   (tests)+import Agda.TypeChecking.Tests                as TypeChck   (tests)+import Agda.Utils.Either	              as UtilEith   (tests)+import Agda.Utils.FileName                    as UtilFile   (tests)+import Agda.Utils.List                        as UtilList   (tests)+import Agda.Utils.Warshall                    as UtilWarsh  (tests)++testSuite :: IO Bool+testSuite = runTests "QuickCheck test suite:"+  [ CompEnco.tests+  , InteEmac.tests+  , InteGene.tests+  , IntePrec.tests+  , InteRang.tests+  , InteOpti.tests+  , SyntPosi.tests+  , TermTerm.tests+  , TermRing.tests+  , TermMatrix.tests+  , TermLex.tests+  , TermCall.tests+  , TypeChck.tests+  , UtilEith.tests+  , UtilFile.tests+  , UtilList.tests+  , UtilWarsh.tests+  ]

+ src/full/Agda/TypeChecker.hs view

@@ -0,0 +1,14 @@++module Agda.TypeChecker+  ( checkDecls, checkDecl+  , inferExpr, checkExpr+  ) where++import Agda.TypeChecking.Rules.Builtin as Rules+import Agda.TypeChecking.Rules.Data	  as Rules+import Agda.TypeChecking.Rules.Decl	  as Rules+import Agda.TypeChecking.Rules.Def	  as Rules+import Agda.TypeChecking.Rules.LHS	  as Rules+import Agda.TypeChecking.Rules.Record  as Rules+import Agda.TypeChecking.Rules.Term	  as Rules+

+ src/full/Agda/TypeChecking/Abstract.hs view

@@ -0,0 +1,55 @@+{-# LANGUAGE CPP #-}++-- | Functions for abstracting terms over other terms.+module Agda.TypeChecking.Abstract where++import Agda.Syntax.Common+import Agda.Syntax.Internal+import Agda.TypeChecking.Substitute+import Data.Function++#include "../undefined.h"+import Agda.Utils.Impossible++piAbstractTerm :: Term -> Type -> Type -> Type+piAbstractTerm v a b = fun a (abstractTerm v b)+  where+    fun a b = El s $ Pi (Arg NotHidden a) $ Abs "w" b+      where s = (sLub `on` getSort) a b++class AbstractTerm a where+  -- | @subst u . abstractTerm u == id@+  abstractTerm :: Term -> a -> a++instance AbstractTerm Term where+  abstractTerm u v = case v of+    v | u == v  -> Var 0 []+    Var i vs    -> Var (i + 1) $ absT vs+    Lam h b     -> Lam h $ absT b+    Def c vs    -> Def c $ absT vs+    Con c vs    -> Con c $ absT vs+    Pi a b      -> uncurry Pi $ absT (a, b)+    Fun a b      -> uncurry Fun $ absT (a, b)+    Lit l       -> Lit l+    Sort s      -> Sort s+    MetaV m vs  -> MetaV m $ absT vs+    where+      absT x = abstractTerm u x++instance AbstractTerm Type where+  abstractTerm u (El s v) = El s $ abstractTerm u v++instance AbstractTerm a => AbstractTerm (Arg a) where+  abstractTerm = fmap . abstractTerm++instance AbstractTerm a => AbstractTerm [a] where+  abstractTerm = fmap . abstractTerm++instance (Subst a, AbstractTerm a) => AbstractTerm (Abs a) where+  abstractTerm u (Abs x v) = Abs x $ swap $ abstractTerm (raise 1 u) v+    where+      swap = substs $ [Var 1 [], Var 0 []] ++ [Var i [] | i <- [2..]]++instance (AbstractTerm a, AbstractTerm b) => AbstractTerm (a, b) where+  abstractTerm u (x, y) = (abstractTerm u x, abstractTerm u y)+

+ src/full/Agda/TypeChecking/Constraints.hs view

@@ -0,0 +1,113 @@+{-# LANGUAGE CPP #-}+module Agda.TypeChecking.Constraints where++import Control.Monad.State+import Control.Monad.Reader+import Control.Monad.Error+import Control.Applicative+import Data.Map as Map+import Data.List as List++import Agda.Syntax.Internal+import Agda.TypeChecking.Monad+import Agda.TypeChecking.Errors+import Agda.TypeChecking.Pretty+import Agda.TypeChecking.Reduce++import {-# SOURCE #-} Agda.TypeChecking.Rules.Term (checkExpr)+import {-# SOURCE #-} Agda.TypeChecking.Conversion+import {-# SOURCE #-} Agda.TypeChecking.MetaVars+import {-# SOURCE #-} Agda.TypeChecking.Empty++import Agda.Utils.Fresh++#include "../undefined.h"+import Agda.Utils.Impossible++-- | Catch pattern violation errors and adds a constraint.+--+catchConstraint :: MonadTCM tcm => Constraint -> TCM Constraints -> tcm Constraints+catchConstraint c v = liftTCM $+   catchError v $ \err ->+   case err of+       PatternErr s -> put s >> buildConstraint c+       _	    -> throwError err++-- | Try to solve the constraints to be added.+addNewConstraints :: MonadTCM tcm => Constraints -> tcm ()+addNewConstraints cs = do addConstraints cs; wakeupConstraints++-- | Don't allow the argument to produce any constraints.+noConstraints :: MonadTCM tcm => tcm Constraints -> tcm ()+noConstraints m = do+    cs <- solveConstraints =<< m+    unless (List.null cs) $ typeError $ UnsolvedConstraints cs+    return ()++-- | Guard constraint+guardConstraint :: MonadTCM tcm => tcm Constraints -> Constraint -> tcm Constraints+guardConstraint m c = do+    cs <- solveConstraints =<< m+    case List.partition isSortConstraint cs of   -- sort constraints doesn't block anything+	(scs, []) -> (scs ++) <$> solveConstraint c+	(scs, cs) -> (scs ++) <$> buildConstraint (Guarded c cs)+    where+	isSortConstraint = isSC . clValue+	isSC SortCmp{}     = True+	isSC ValueCmp{}    = False+	isSC TypeCmp{}     = False+	isSC (Guarded c _) = isSC c+	isSC UnBlock{}     = False+        isSC IsEmpty{}     = False++-- | We ignore the constraint ids and (as in Agda) retry all constraints every time.+--   We probably generate very few constraints.+wakeupConstraints :: MonadTCM tcm => tcm ()+wakeupConstraints = do+    cs <- takeConstraints+    cs <- solveConstraints cs+    addConstraints cs++solveConstraints :: MonadTCM tcm => Constraints -> tcm Constraints+solveConstraints cs = do+    n  <- length <$> getInstantiatedMetas+    cs <- concat <$> mapM (withConstraint solveConstraint) cs+    n' <- length <$> getInstantiatedMetas+    if (n' > n)+	then solveConstraints cs -- Go again if we made progress+	else return cs++solveConstraint :: MonadTCM tcm => Constraint -> tcm Constraints+solveConstraint (ValueCmp cmp a u v) = compareTerm cmp a u v+solveConstraint (TypeCmp cmp a b)    = compareType cmp a b+solveConstraint (SortCmp cmp s1 s2)  = compareSort cmp s1 s2+solveConstraint (Guarded c cs)       = guardConstraint (return cs) c+solveConstraint (IsEmpty t)          = isEmptyTypeC t+solveConstraint (UnBlock m)          = do+    inst <- mvInstantiation <$> lookupMeta m+    reportSDoc "tc.constr.unblock" 15 $ text ("unblocking a metavar yields the constraint:" ++ show inst)+    case inst of+      BlockedConst t -> do+        verboseS "tc.constr.blocked" 15 $ do+            d <- prettyTCM t+            debug $ show m ++ " := " ++ show d+        assignTerm m t+        return []+      PostponedTypeCheckingProblem cl -> enterClosure cl $ \(e, t, unblock) -> do+        b <- liftTCM unblock+        if not b+          then buildConstraint $ UnBlock m+          else do+            tel <- getContextTelescope+            v   <- liftTCM $ checkExpr e t+            assignTerm m $ teleLam tel v+            return []+      -- Andreas, 2009-02-09, the following were IMPOSSIBLE cases+      -- somehow they pop up in the context of sized types+      --+      -- already solved metavariables: no constraints left (Ulf, is that correct?)+      InstV{} -> return []+      InstS{} -> return []+      -- Open (whatever that means)+      Open -> __IMPOSSIBLE__+

+ src/full/Agda/TypeChecking/Conversion.hs view

@@ -0,0 +1,391 @@+{-# LANGUAGE CPP, PatternGuards #-}++module Agda.TypeChecking.Conversion where++import Control.Applicative+import Control.Monad+import Control.Monad.State+import Control.Monad.Error+import Data.Generics+import Data.Traversable hiding (mapM)+import Data.List hiding (sort)++import Agda.Syntax.Common+import Agda.Syntax.Internal+import Agda.TypeChecking.Monad+import Agda.TypeChecking.MetaVars+import Agda.TypeChecking.Substitute+import Agda.TypeChecking.Reduce+import Agda.TypeChecking.Constraints+import Agda.TypeChecking.Errors+import Agda.TypeChecking.Primitive (constructorForm)+import Agda.TypeChecking.Free+import Agda.TypeChecking.Records+import Agda.TypeChecking.Pretty+import Agda.TypeChecking.Injectivity+import Agda.TypeChecking.SizedTypes++import Agda.Utils.Monad++import Agda.TypeChecking.Monad.Debug++#include "../undefined.h"+import Agda.Utils.Impossible++nextPolarity []       = (Invariant, [])+nextPolarity (p : ps) = (p, ps)++-- | Check if to lists of arguments are the same (and all variables).+--   Precondition: the lists have the same length.+sameVars :: Args -> Args -> Bool+sameVars xs ys = and $ zipWith same xs ys+    where+	same (Arg _ (Var n [])) (Arg _ (Var m [])) = n == m+	same _ _				   = False++equalTerm :: MonadTCM tcm => Type -> Term -> Term -> tcm Constraints+equalTerm = compareTerm CmpEq++equalAtom :: MonadTCM tcm => Type -> Term -> Term -> tcm Constraints+equalAtom = compareAtom CmpEq++equalArgs :: MonadTCM tcm => Type -> Args -> Args -> tcm Constraints+equalArgs = compareArgs []++equalType :: MonadTCM tcm => Type -> Type -> tcm Constraints+equalType = compareType CmpEq++-- | Type directed equality on values.+--+compareTerm :: MonadTCM tcm => Comparison -> Type -> Term -> Term -> tcm Constraints+compareTerm cmp a m n =+  catchConstraint (ValueCmp cmp a m n) $ do+    a'       <- reduce a+    reportSDoc "tc.conv.term" 10 $ fsep+      [ text "compareTerm", prettyTCM m, prettyTCM cmp, prettyTCM n, text ":", prettyTCM a' ]+    proofIrr <- proofIrrelevance+    isSize   <- isSizeType a'+    s        <- reduce $ getSort a'+    case s of+      Prop | proofIrr -> return []+      _    | isSize   -> compareSizes cmp m n+      _               -> case unEl a' of+        Pi a _    -> equalFun (a,a') m n+        Fun a _   -> equalFun (a,a') m n+        MetaV x _ -> do+          (m,n) <- normalise (m,n)+          if m == n+            then return []+            else buildConstraint (ValueCmp cmp a m n)+        Lam _ _   -> __IMPOSSIBLE__+        Def r ps  -> do+          isrec <- isRecord r+          if isrec+            then do+              m <- reduceB m+              n <- reduceB n+              case (m, n) of+                _ | isNeutral m && isNeutral n ->+                    compareAtom cmp a' (ignoreBlocking m) (ignoreBlocking n)+                _ -> do+                  (tel, m') <- etaExpandRecord r ps $ ignoreBlocking m+                  (_  , n') <- etaExpandRecord r ps $ ignoreBlocking n+                  -- No subtyping on record terms+                  compareArgs [] (telePi_ tel $ sort Prop) m' n'+            else compareAtom cmp a' m n+        _ -> compareAtom cmp a' m n+  where+    isNeutral Blocked{}          = False+    isNeutral (NotBlocked Con{}) = False+    isNeutral _                  = True++    equalFun (a,t) m n = do+        name <- freshName_ (suggest $ unEl t)+        addCtx name a $ compareTerm cmp t' m' n'+      where+        p	= fmap (const $ Var 0 []) a+        (m',n') = raise 1 (m,n) `apply` [p]+        t'	= raise 1 t `piApply` [p]+        suggest (Fun _ _)	 = "x"+        suggest (Pi _ (Abs x _)) = x+        suggest _		 = __IMPOSSIBLE__++-- | Syntax directed equality on atomic values+--+compareAtom :: MonadTCM tcm => Comparison -> Type -> Term -> Term -> tcm Constraints+compareAtom cmp t m n =+    catchConstraint (ValueCmp cmp t m n) $ do+      mb <- traverse constructorForm =<< reduceB m+      nb <- traverse constructorForm =<< reduceB n+      let m = ignoreBlocking mb+          n = ignoreBlocking nb+      reportSDoc "tc.conv.atom" 10 $ fsep+	[ text "compareAtom", prettyTCM mb, prettyTCM cmp, prettyTCM nb, text ":", prettyTCM t ]+      case (mb, nb) of+        (NotBlocked (MetaV x xArgs), NotBlocked (MetaV y yArgs))+            | x == y -> if   sameVars xArgs yArgs+                        then return []+                        else do -- Check syntactic equality on meta-variables+                                -- (same as for blocked terms)+                          m <- normalise m+                          n <- normalise n+                          if m == n+                            then return []+                            else buildConstraint (ValueCmp cmp t m n)+            | otherwise -> do+                [p1, p2] <- mapM getMetaPriority [x,y]+                -- instantiate later meta variables first+                let (solve1, solve2)+                      | (p1,x) > (p2,y) = (l,r)+                      | otherwise	    = (r,l)+                      where l = assignV t x xArgs n+                            r = assignV t y yArgs m+                    try m fallback = do+                      cs <- m+                      case cs of+                        []	-> return []+                        _	-> fallback cs++                -- First try the one with the highest priority. If that doesn't+                -- work, try the low priority one. If that doesn't work either,+                -- go with the first version.+                rollback <- return . put =<< get+                try solve1 $ \cs -> do+                  undoRollback <- return . put =<< get+                  rollback+                  try solve2 $ \_ -> do+                    undoRollback+                    return cs++	(NotBlocked (MetaV x xArgs), _) -> assignV t x xArgs n+	(_, NotBlocked (MetaV x xArgs)) -> assignV t x xArgs m+        (Blocked{}, Blocked{})	-> do+            n <- normalise n    -- is this what we want?+            m <- normalise m+            if m == n+                then return []	-- Check syntactic equality for blocked terms+                else buildConstraint $ ValueCmp cmp t m n+        (Blocked{}, _)    -> useInjectivity cmp t m n+        (_,Blocked{})     -> useInjectivity cmp t m n+        _ -> case (m, n) of+	    _ | f1@(FunV _ _) <- funView m+	      , f2@(FunV _ _) <- funView n -> equalFun f1 f2++	    (Sort s1, Sort s2) -> compareSort cmp s1 s2++	    (Lit l1, Lit l2) | l1 == l2 -> return []+	    (Var i iArgs, Var j jArgs) | i == j -> do+		a <- typeOfBV i+                -- Variables are invariant in their arguments+		compareArgs [] a iArgs jArgs+	    (Def x xArgs, Def y yArgs) | x == y -> do+                pol <- getPolarity' cmp x+		reportSDoc "tc.conv.atom" 20 $+		  text "compareArgs" <+> sep+                    [ sep [ prettyTCM xArgs+			  , prettyTCM yArgs+			  ]+                    , nest 2 $ text (show pol)+                    ]+		a <- defType <$> getConstInfo x+		compareArgs pol a xArgs yArgs+	    (Con x xArgs, Con y yArgs)+		| x == y -> do+		    -- The type is a datatype.+		    Def d args <- reduce $ unEl t+		    -- Get the number of parameters to the datatype+		    Datatype{dataPars = npars} <- theDef <$> getConstInfo d+		    -- The type to compare the arguments at is obtained by+		    -- instantiating the parameters.+		    a <- defType <$> getConstInfo x+		    let a' = piApply a (genericTake npars args)+                    -- Constructors are invariant in their arguments+                    -- (could be covariant).+                    compareArgs [] a' xArgs yArgs+            _ -> typeError $ UnequalTerms cmp m n t+    where+	equalFun (FunV arg1@(Arg h1 a1) t1) (FunV (Arg h2 a2) t2)+	    | h1 /= h2	= typeError $ UnequalHiding ty1 ty2+	    | otherwise = do+		    let (ty1',ty2') = raise 1 (ty1,ty2)+			arg	    = Arg h1 (Var 0 [])+		    name <- freshName_ (suggest t1 t2)+		    cs   <- compareType cmp a2 a1+		    let c = TypeCmp cmp (piApply ty1' [arg]) (piApply ty2' [arg])++		    -- We only need to require a1 == a2 if t2 is a dependent function type.+		    -- If it's non-dependent it doesn't matter what we add to the context.+		    let dependent = case t2 of+					Pi _ _	-> True+					Fun _ _	-> False+					_	-> __IMPOSSIBLE__+		    if dependent+			then addCtx name arg1 $ guardConstraint (return cs) c+			else do+			    cs' <- addCtx name arg1 $ solveConstraint c+			    return $ cs ++ cs'+	    where+		ty1 = El (getSort a1) t1    -- TODO: wrong (but it doesn't matter)+		ty2 = El (getSort a2) t2+		suggest t1 t2 = case concatMap name [t1,t2] of+				    []	-> "_"+				    x:_	-> x+		    where+			name (Pi _ (Abs x _)) = [x]+			name (Fun _ _)	      = []+			name _		      = __IMPOSSIBLE__+	equalFun _ _ = __IMPOSSIBLE__++++-- | Type-directed equality on argument lists+--+compareArgs :: MonadTCM tcm => [Polarity] -> Type -> Args -> Args -> tcm Constraints+compareArgs _ _ [] [] = return []+compareArgs _ _ [] (_:_) = __IMPOSSIBLE__+compareArgs _ _ (_:_) [] = __IMPOSSIBLE__+compareArgs pols0 a (arg1 : args1) (arg2 : args2) = do+    let (pol, pols) = nextPolarity pols0+    a <- reduce a+    case funView (unEl a) of+	FunV (Arg _ b) _ -> do+	    reportSDoc "tc.conv.args" 10 $ +              sep [ text "compareArgs" <+> parens (text $ show pol)+                  , nest 2 $ sep [ prettyTCM arg1+                                 , text "~~" <+> prettyTCM arg2+                                 , text ":" <+> prettyTCM b+                                 ]+                  ]+            let cmp x y = case pol of+                            Invariant     -> compareTerm CmpEq b x y+                            Covariant     -> compareTerm CmpLeq b x y+                            Contravariant -> compareTerm CmpLeq b y x+            cs1 <- cmp (unArg arg1) (unArg arg2)+	    case (cs1, unEl a) of+		(_:_, Pi _ c) | 0 `freeIn` absBody c+		    -> do+                        reportSDoc "tc.conv.args" 15 $ sep+                          [ text "aborting compareArgs" <+> parens (text $ show pol)+                          , nest 2 $ sep+                              [ parens $ text (show pol)+                              , prettyTCM arg1+                              , text "~~" <+> prettyTCM arg2+                              , text ":" <+> prettyTCM b+                              , text "-->" <+> prettyTCM cs1+                              ]+                          ]+                        patternViolation   -- TODO: will duplicate work (all arguments checked so far)+		_   -> do+                    reportSDoc "tc.conv.args" 15 $ sep+                      [ text "compareArgs" <+> parens (text $ show pol)+                      , nest 2 $ sep+                        [ prettyTCM arg1+                        , text "~~" <+> prettyTCM arg2+                        , text ":" <+> prettyTCM (piApply a [arg1])+                        ]+                      ]+		    cs2 <- compareArgs pols (piApply a [arg1]) args1 args2+		    return $ cs1 ++ cs2+        _   -> patternViolation++-- | Equality on Types+compareType :: MonadTCM tcm => Comparison -> Type -> Type -> tcm Constraints+compareType cmp ty1@(El s1 a1) ty2@(El s2 a2) =+    catchConstraint (TypeCmp cmp ty1 ty2) $ do+	reportSDoc "tc.conv.type" 9 $ vcat+          [ hsep [ text "compareType", prettyTCM ty1, prettyTCM cmp, prettyTCM ty2 ]+          , hsep [ text "   sorts:", prettyTCM s1, text " and ", prettyTCM s2 ]+          ]+	cs1 <- compareSort cmp s1 s2 `catchError` \err -> case err of+                  TypeError _ _ -> typeError $ UnequalTypes cmp ty1 ty2+                  _             -> throwError err+	cs2 <- compareTerm cmp (sort s1) a1 a2+        unless (null $ cs1 ++ cs2) $+          reportSDoc "tc.conv.type" 9 $+            text "   --> " <+> prettyTCM (cs1 ++ cs2)+	return $ cs1 ++ cs2++leqType :: MonadTCM tcm => Type -> Type -> tcm Constraints+leqType = compareType CmpLeq++---------------------------------------------------------------------------+-- * Sorts+---------------------------------------------------------------------------++compareSort :: MonadTCM tcm => Comparison -> Sort -> Sort -> tcm Constraints+compareSort CmpEq  = equalSort+compareSort CmpLeq = equalSort -- TODO: change to leqSort when we have better constraint solving++-- | Check that the first sort is less or equal to the second.+leqSort :: MonadTCM tcm => Sort -> Sort -> tcm Constraints+leqSort s1 s2 =+  ifM typeInType (return []) $+    catchConstraint (SortCmp CmpLeq s1 s2) $+    do	(s1,s2) <- reduce (s1,s2)+-- 	do  d1 <- prettyTCM s1+-- 	    d2 <- prettyTCM s2+-- 	    debug $ "leqSort   " ++ show d1 ++ " <= " ++ show d2+	case (s1,s2) of++	    (Prop    , Prop    )	     -> return []+	    (Type _  , Prop    )	     -> notLeq s1 s2+	    (Suc _   , Prop    )	     -> notLeq s1 s2++	    (Prop    , Type _  )	     -> return []+	    (Type n  , Type m  ) | n <= m    -> return []+				 | otherwise -> notLeq s1 s2+	    (Suc s   , Type n  ) | 1 <= n    -> leqSort s (Type $ n - 1)+				 | otherwise -> notLeq s1 s2+	    (_	     , Suc _   )	     -> equalSort s1 s2++	    (Lub a b , _       )	     -> liftM2 (++) (leqSort a s2) (leqSort b s2)+	    (_	     , Lub _ _ )	     -> equalSort s1 s2++	    (MetaS x , MetaS y ) | x == y    -> return []+	    (MetaS x , _       )	     -> equalSort s1 s2+	    (_	     , MetaS x )	     -> equalSort s1 s2+    where+	notLeq s1 s2 = typeError $ NotLeqSort s1 s2++-- | Check that the first sort equal to the second.+equalSort :: MonadTCM tcm => Sort -> Sort -> tcm Constraints+equalSort s1 s2 =+  ifM typeInType (return []) $+    catchConstraint (SortCmp CmpEq s1 s2) $+    do	(s1,s2) <- reduce (s1,s2)+-- 	do  d1 <- prettyTCM s1+-- 	    d2 <- prettyTCM s2+-- 	    debug $ "equalSort " ++ show d1 ++ " == " ++ show d2+	case (s1,s2) of++	    (MetaS x , MetaS y ) | x == y    -> return []+				 | otherwise -> do+		[p1, p2] <- mapM getMetaPriority [x, y]+		if p1 >= p2 then assignS x s2+			    else assignS y s1+	    (MetaS x , _       )	     -> assignS x s2+	    (_	     , MetaS x )	     -> equalSort s2 s1++	    (Prop    , Prop    )	     -> return []+	    (Type _  , Prop    )	     -> notEq s1 s2+	    (Prop    , Type _  )	     -> notEq s1 s2++	    (Type n  , Type m  ) | n == m    -> return []+				 | otherwise -> notEq s1 s2+	    (Suc s   , Prop    )	     -> notEq s1 s2+	    (Suc s   , Type 0  )	     -> notEq s1 s2+	    (Suc s   , Type 1  )	     -> buildConstraint (SortCmp CmpEq s1 s2)+	    (Suc s   , Type n  )	     -> equalSort s (Type $ n - 1)+	    (Prop    , Suc s   )	     -> notEq s1 s2+	    (Type 0  , Suc s   )	     -> notEq s1 s2+	    (Type 1  , Suc s   )	     -> buildConstraint (SortCmp CmpEq s1 s2)+	    (Type n  , Suc s   )	     -> equalSort (Type $ n - 1) s+	    (_	     , Suc _   )	     -> buildConstraint (SortCmp CmpEq s1 s2)+	    (Suc _   , _       )	     -> buildConstraint (SortCmp CmpEq s1 s2)++	    (Lub _ _ , _       )	     -> buildConstraint (SortCmp CmpEq s1 s2)+	    (_	     , Lub _ _ )	     -> buildConstraint (SortCmp CmpEq s1 s2)++    where+	notEq s1 s2 = typeError $ UnequalSorts s1 s2+

+ src/full/Agda/TypeChecking/Conversion.hs-boot view

@@ -0,0 +1,19 @@++module Agda.TypeChecking.Conversion where++import Data.Generics+import Agda.Syntax.Internal+import Agda.TypeChecking.Monad++compareTerm :: MonadTCM tcm => Comparison -> Type -> Term -> Term -> tcm Constraints+compareAtom :: MonadTCM tcm => Comparison -> Type -> Term -> Term -> tcm Constraints+compareArgs :: MonadTCM tcm => [Polarity] -> Type -> Args -> Args -> tcm Constraints+compareType :: MonadTCM tcm => Comparison -> Type -> Type -> tcm Constraints+compareSort :: MonadTCM tcm => Comparison -> Sort -> Sort -> tcm Constraints+equalTerm :: MonadTCM tcm => Type -> Term -> Term -> tcm Constraints+equalArgs :: MonadTCM tcm => Type -> Args -> Args -> tcm Constraints+equalType :: MonadTCM tcm => Type -> Type -> tcm Constraints+equalSort :: MonadTCM tcm => Sort -> Sort -> tcm Constraints+leqSort   :: MonadTCM tcm => Sort -> Sort -> tcm Constraints++

+ src/full/Agda/TypeChecking/Coverage.hs view

@@ -0,0 +1,370 @@+{-# LANGUAGE CPP #-}++module Agda.TypeChecking.Coverage where++import Control.Monad+import Control.Monad.Error+import Control.Applicative+import Data.List+import qualified Data.Set as Set+import Data.Set (Set)++import Agda.Syntax.Position+import Agda.Syntax.Common+import Agda.Syntax.Internal+import Agda.Syntax.Internal.Pattern++import Agda.TypeChecking.Monad.Base+import Agda.TypeChecking.Monad.Trace+import Agda.TypeChecking.Monad.Signature+import Agda.TypeChecking.Monad.Options+import Agda.TypeChecking.Monad.Exception+import Agda.TypeChecking.Monad.Context++import Agda.TypeChecking.Rules.LHS.Unify+import Agda.TypeChecking.Rules.LHS.Instantiate+import Agda.TypeChecking.Rules.LHS++import Agda.TypeChecking.Coverage.Match++import Agda.TypeChecking.Pretty+import Agda.TypeChecking.Substitute+import Agda.TypeChecking.Reduce+import Agda.TypeChecking.Primitive (constructorForm)+import Agda.TypeChecking.Telescope++import Agda.Interaction.Options++import Agda.Utils.Permutation+import Agda.Utils.Size+import Agda.Utils.Tuple+import Agda.Utils.Monad++#include "../undefined.h"+import Agda.Utils.Impossible++data SplitClause = SClause+      { scTel   :: Telescope      -- ^ type of variables in scPats+      , scPerm  :: Permutation    -- ^ how to get from the variables in the patterns to the telescope+      , scPats  :: [Arg Pattern]+      , scSubst :: [Term]         -- ^ substitution from scTel to old context+      }++type Covering = [SplitClause]++typeOfVar :: Telescope -> Nat -> Type+typeOfVar tel n+  | n >= len  = __IMPOSSIBLE__+  | otherwise = snd . unArg $ ts !! fromIntegral n+  where+    len = genericLength ts+    ts  = reverse $ telToList tel++-- | Top-level function for checking pattern coverage.+checkCoverage :: QName -> TCM ()+checkCoverage f = do+  d <- getConstInfo f+  t <- normalise $ defType d+  let defn = theDef d+  case defn of+    Function{ funClauses = cs@(_:_) } -> do+      let n            = genericLength $ clausePats $ head cs+          TelV gamma _ = telView t+          gamma'       = telFromList $ genericTake n $ telToList gamma+          xs           = map (fmap $ const $ VarP "_") $ telToList gamma'+      reportSDoc "tc.cover.top" 10 $ vcat+        [ text "Coverage checking"+        , nest 2 $ vcat $ map (text . show . clausePats) cs+        ]+      (used, pss) <- cover cs $ SClause gamma' (idP n) xs (idSub gamma')+      whenM (optCompletenessCheck <$> commandLineOptions) $+        case pss of+          []  -> return ()+          _   -> +            setCurrentRange (getRange cs) $+              typeError $ CoverageFailure f pss+      whenM (optUnreachableCheck <$> commandLineOptions) $+        case Set.toList $ Set.difference (Set.fromList [0..genericLength cs - 1]) used of+          []  -> return ()+          is  -> do+            let unreached = map ((cs !!) . fromIntegral) is+            setCurrentRange (getRange unreached) $+              typeError $ UnreachableClauses f (map clausePats unreached)+    _             -> __IMPOSSIBLE__++-- | Check that the list of clauses covers the given split clause.+--   Returns the missing cases.+cover :: MonadTCM tcm => [Clause] -> SplitClause -> tcm (Set Nat, [[Arg Pattern]])+cover cs (SClause tel perm ps _) = do+  reportSDoc "tc.cover.cover" 10 $ vcat+    [ text "checking coverage of pattern:"+    , nest 2 $ text "tel  =" <+> prettyTCM tel+    , nest 2 $ text "perm =" <+> text (show perm)+    , nest 2 $ text "ps   =" <+> text (show ps)+    ]+  case match cs ps perm of+    Yes i          -> do+      reportSLn "tc.cover.cover" 10 $ "pattern covered by clause " ++ show i+      -- Check if any earlier clauses could match with appropriate literals+      let is = [ j | (j, c) <- zip [0..] (genericTake i cs), matchLits c ps perm ]+      reportSLn "tc.cover.cover"  10 $ "literal matches: " ++ show is+      return (Set.fromList (i : is), [])+    No             -> return (Set.empty, [ps])+    Block Nothing  -> fail $ "blocked by dot pattern"+    Block (Just x) -> do+      r <- split tel perm ps x+      case r of+        Left err  -> case err of+          CantSplit c         -> typeError $ CoverageCantSplitOn c+          NotADatatype a      -> typeError $ CoverageCantSplitType a+          GenericSplitError s -> fail $ "failed to split: " ++ s+        Right scs -> (Set.unions -*- concat) . unzip <$> mapM (cover cs) scs++-- | Check that a type is a datatype+isDatatype :: MonadTCM tcm => Type -> tcm (Maybe (QName, [Arg Term], [Arg Term], [QName]))+isDatatype t = do+  t <- normalise t+  case unEl t of+    Def d args -> do+      def <- theDef <$> getConstInfo d+      case def of+        Datatype{dataPars = np, dataCons = cs} -> do+          let (ps, is) = genericSplitAt np args+          return $ Just (d, ps, is, cs)+        _ -> return Nothing+    _ -> return Nothing++data SplitError = NotADatatype Type+                | CantSplit QName+                | GenericSplitError String+  deriving (Show)++instance Error SplitError where+  noMsg  = strMsg ""+  strMsg = GenericSplitError++type CoverM = ExceptionT SplitError TCM++-- | @dtype == d pars ixs@+computeNeighbourhood :: Telescope -> Telescope -> Permutation -> QName -> Args -> Args -> Nat -> OneHolePatterns -> QName -> CoverM [SplitClause]+computeNeighbourhood delta1 delta2 perm d pars ixs hix hps con = do++  -- Get the type of the datatype+  dtype <- normalise =<< (`piApply` pars) . defType <$> getConstInfo d++  -- Get the real constructor name+  Con con [] <- constructorForm =<< normalise (Con con [])++  -- Get the type of the constructor+  ctype <- defType <$> getConstInfo con++  -- Lookup the type of the constructor at the given parameters+  TelV gamma (El _ (Def _ cixs)) <- telView <$> normalise (ctype `piApply` pars)++  debugInit con ctype pars ixs cixs delta1 delta2 gamma hps hix++  -- All variables are flexible+  let flex = [0..size delta1 + size gamma - 1]++  -- Unify constructor target and given type (in Δ₁Γ)+  r <- addCtxTel (delta1 `abstract` gamma) $+       unifyIndices flex (raise (size gamma) dtype) (drop (size pars) cixs) (raise (size gamma) ixs)++  case r of+    NoUnify _ _ _ -> do+      debugNoUnify+      return []+    DontKnow _    -> do+      debugCantSplit+      throwException $ CantSplit con+    Unifies sub   -> do+      debugSubst "sub" sub++      -- Substitute the constructor for x in Δ₂: Δ₂' = Δ₂[conv/x]+      let conv    = Con con  $ teleArgs gamma   -- Θ Γ ⊢ conv (for any Θ)+          delta2' = subst conv $ raiseFrom 1 (size gamma) delta2+      debugTel "delta2'" delta2'++      -- Compute a substitution ρ : Δ₁ΓΔ₂' → Δ₁(x:D)Δ₂+      let rho = [ Var i [] | i <- [0..size delta2' - 1] ]+             ++ [ raise (size delta2') conv ]+             ++ [ Var i [] | i <- [size delta2' + size gamma ..] ]++      -- Plug the hole with the constructor and apply ρ+      let conp = ConP con $ map (fmap VarP) $ teleArgNames gamma+          ps   = plugHole conp hps+          ps'  = substs rho ps      -- Δ₁ΓΔ₂' ⊢ ps'+      debugPlugged ps ps'++      -- Δ₁Γ ⊢ sub, we need something in Δ₁ΓΔ₂'+      -- Also needs to be padded with Nothing's to have the right length.+      let pad n xs x = xs ++ replicate (max 0 $ n - size xs) x+          sub'       = replicate (size delta2') Nothing +++                       pad (size delta1 + size gamma) (raise (size delta2') sub) Nothing+      debugSubst "sub'" sub'++      -- Θ = Δ₁ΓΔ₂'+      let theta = delta1 `abstract` gamma `abstract` delta2'+      debugTel "theta" theta++      -- Apply the unifying substitution to Θ +      -- We get ρ' : Θ' -> Θ+      --        π  : Θ' -> Θ+      (theta', iperm, rho', _) <- instantiateTel sub' theta+      debugTel "theta'" theta'+      debugShow "iperm" iperm++      -- Compute final permutation+      let perm' = expandP hix (size gamma) perm -- perm' : Θ -> Δ₁(x : D)Δ₂+          rperm = iperm `composeP` perm'+      debugShow "perm'" perm'+      debugShow "rperm" rperm++      -- Compute the final patterns+      let ps'' = instantiatePattern sub' perm' ps'+          rps  = substs rho' ps''++      -- Compute the final substitution+      let rsub  = substs rho' rho++      debugFinal theta' rperm rps++      return [SClause theta' rperm rps rsub]++  where+    debugInit con ctype pars ixs cixs delta1 delta2 gamma hps hix =+      reportSDoc "tc.cover.split.con" 20 $ vcat+        [ text "computeNeighbourhood"+        , nest 2 $ vcat+          [ text "con    =" <+> prettyTCM con+          , text "ctype  =" <+> prettyTCM ctype+          , text "hps    =" <+> text (show hps)+          , text "pars   =" <+> prettyList (map prettyTCM pars)+          , text "ixs    =" <+> prettyList (map prettyTCM ixs)+          , text "cixs   =" <+> prettyList (map prettyTCM cixs)+          , text "delta1 =" <+> prettyTCM delta1+          , text "delta2 =" <+> prettyTCM delta2+          , text "gamma  =" <+> prettyTCM gamma+          , text "hix    =" <+> text (show hix)+          ]+        ]++    debugNoUnify =+      reportSLn "tc.cover.split.con" 20 "  Constructor impossible!"++    debugCantSplit =+      reportSLn "tc.cover.split.con" 20 "  Bad split!"++    debugSubst s sub =+      reportSDoc "tc.cover.split.con" 20 $ nest 2 $ vcat+        [ text (s ++ " =") <+> brackets (fsep $ punctuate comma $ map (maybe (text "_") prettyTCM) sub)+        ]++    debugTel s tel =+      reportSDoc "tc.cover.split.con" 20 $ nest 2 $ vcat+        [ text (s ++ " =") <+> prettyTCM tel+        ]++    debugShow s x =+      reportSDoc "tc.cover.split.con" 20 $ nest 2 $ vcat+        [ text (s ++ " =") <+> text (show x)+        ]++    debugPlugged ps ps' =+      reportSDoc "tc.cover.split.con" 20 $ nest 2 $ vcat+        [ text "ps     =" <+> text (show ps)+        , text "ps'    =" <+> text (show ps')+        ]++    debugFinal tel perm ps =+      reportSDoc "tc.cover.split.con" 20 $ nest 2 $ vcat+        [ text "rtel   =" <+> prettyTCM tel+        , text "rperm  =" <+> text (show perm)+        , text "rps    =" <+> text (show ps)+        ]++-- | split Δ x ps. Δ ⊢ ps, x ∈ Δ (deBruijn index)+splitClause :: Clause -> Nat -> TCM (Either SplitError Covering)+splitClause c x = split (clauseTel c) (clausePerm c) (clausePats c) x++splitClauseWithAbs :: Clause -> Nat -> TCM (Either SplitError (Either SplitClause Covering))+splitClauseWithAbs c x = split' (clauseTel c) (clausePerm c) (clausePats c) x++split :: MonadTCM tcm => Telescope -> Permutation -> [Arg Pattern] -> Nat ->+         tcm (Either SplitError Covering)+split tel perm ps x = do+  r <- split' tel perm ps x+  return $ case r of+    Left err        -> Left err+    Right (Left _)  -> Right []+    Right (Right c) -> Right c++split' :: MonadTCM tcm => Telescope -> Permutation -> [Arg Pattern] -> Nat ->+         tcm (Either SplitError (Either SplitClause Covering))+split' tel perm ps x = liftTCM $ runExceptionT $ do++  debugInit tel perm x ps++  -- Split the telescope at the variable+  (delta1, delta2) <- do+    let (tel1, _ : tel2) = genericSplitAt (size tel - x - 1) $ telToList tel+    return (telFromList tel1, telFromList tel2)++  -- Get the type of the variable+  t <- normalise $ typeOfVar tel x  -- Δ₁ ⊢ t++  -- Compute the one hole context of the patterns at the variable+  (hps, hix) <- do+    let holes = reverse $ permute perm $ zip [0..] $ allHolesWithContents ps+    unless (length holes == length (telToList tel)) $+      fail "split: bad holes or tel"++    -- There is always a variable at the given hole.+    let (hix, (VarP s, hps)) = holes !! fromIntegral x+    debugHoleAndType s hps t++    return (hps, hix)++  -- Check that t is a datatype+  (d, pars, ixs, cons) <- do+    dt <- isDatatype t+    case dt of+      Nothing -> throwException $ NotADatatype t+      Just d  -> return d++  -- Compute the neighbourhoods for the constructors+  ns <- concat <$> mapM (computeNeighbourhood delta1 delta2 perm d pars ixs hix hps) cons+  case ns of+    []  -> do+      let absurd = VarP "()"+      return $ Left $ SClause+               { scTel  = telFromList $ telToList delta1 +++                                        [Arg NotHidden ("()", t)] +++                                        telToList delta2+               , scPerm = perm+               , scPats = plugHole absurd hps+               , scSubst = [] -- not used anyway+               }++    _   -> return $ Right ns++  where++    -- Debug printing+    debugInit tel perm x ps =+      reportSDoc "tc.cover.top" 10 $ vcat+        [ text "split"+        , nest 2 $ vcat+          [ text "tel  =" <+> prettyTCM tel+          , text "perm =" <+> text (show perm)+          , text "x    =" <+> text (show x)+          , text "ps   =" <+> text (show ps)+          ]+        ]++    debugHoleAndType s hps t =+      reportSDoc "tc.cover.top" 10 $ nest 2 $ vcat $+        [ text "p   =" <+> text s+        , text "hps =" <+> text (show hps)+        , text "t   =" <+> prettyTCM t+        ]

+ src/full/Agda/TypeChecking/Coverage/Match.hs view

@@ -0,0 +1,119 @@+{-# LANGUAGE CPP #-}++module Agda.TypeChecking.Coverage.Match where++import Control.Applicative+import Control.Monad.State+import Data.Monoid+import Data.Traversable (traverse)+import Data.Function++import Agda.Syntax.Common+import Agda.Syntax.Internal+import Agda.Syntax.Internal.Pattern+import Agda.Syntax.Literal++import Agda.Utils.Permutation+import Agda.Utils.Size++#include "../../undefined.h"+import Agda.Utils.Impossible++-- | We use a special representation of the patterns we're trying to match+--   against a clause. In particular we want to keep track of which variables+--   are blocking a match.+data MPat = VarMP Nat | ConMP QName [Arg MPat] | LitMP Literal | WildMP++buildMPatterns :: Permutation -> [Arg Pattern] -> [Arg MPat]+buildMPatterns perm ps = evalState (mapM (traverse build) ps) xs+  where+    xs   = permute (invertP perm) $ reverse [0 .. fromIntegral (size perm) - 1]+    tick = do x : xs <- get; put xs; return x++    build (VarP _)      = VarMP <$> tick+    build (ConP con ps) = ConMP con <$> mapM (traverse build) ps+    build (DotP t)      = tick *> buildT t+    build (LitP l)      = return $ LitMP l++    buildT (Con c args) = ConMP c <$> mapM (traverse buildT) args+    buildT (Var i [])   = return (VarMP i)+    buildT _            = return WildMP++-- | If matching is inconclusive (@Block@) we want to know which+--   variable is blocking the match. If a dot pattern is blocking a match+--   we're screwed.+data Match a = Yes a | No | Block (Maybe Nat)++instance Functor Match where+  fmap f (Yes a)   = Yes (f a)+  fmap f No        = No+  fmap f (Block x) = Block x++instance Monoid a => Monoid (Match a) where+  mempty                    = Yes mempty+  Yes a   `mappend` Yes b   = Yes $ mappend a b+  Yes _   `mappend` No      = No+  Yes _   `mappend` Block x = Block x+  No      `mappend` _       = No+  Block x `mappend` _       = Block x++choice :: Match a -> Match a -> Match a+choice (Yes a) _   = Yes a+choice (Block x) _ = Block x+choice No m        = m++type MatchLit = Literal -> MPat -> Match ()++noMatchLit :: MatchLit+noMatchLit _ _ = No++yesMatchLit :: MatchLit+yesMatchLit _ VarMP{}  = Yes ()+yesMatchLit _ WildMP{} = Yes ()+yesMatchLit _ _        = No++-- | Match the given patterns against a list of clauses+match :: [Clause] -> [Arg Pattern] -> Permutation -> Match Nat+match cs ps perm = foldr choice No $ zipWith matchIt [0..] cs+  where+    mps = buildMPatterns perm ps++    -- If liberal matching on literals fails or blocks we go with that.+    -- If it succeeds we use the result from conservative literal matching.+    -- This is to make sure that we split enough when literals are involved.+    -- For instance,+    --    f ('x' :: 'y' :: _) = ...+    --    f (c :: s) = ...+    -- would never split the tail of the list if we only used conservative+    -- literal matching.+    matchIt i c = matchClause yesMatchLit mps i c ++++                  matchClause noMatchLit  mps i c++    Yes _   +++ m = m+    No      +++ _ = No+    Block x +++ _ = Block x++-- | Check if a clause could match given generously chosen literals+matchLits :: Clause -> [Arg Pattern] -> Permutation -> Bool+matchLits c ps perm = case matchClause yesMatchLit (buildMPatterns perm ps) 0 c of+  Yes _ -> True+  _     -> False++matchClause :: MatchLit -> [Arg MPat] -> Nat -> Clause -> Match Nat+matchClause mlit qs i c = fmap (const i) $ matchPats mlit (clausePats c) qs++matchPats :: MatchLit -> [Arg Pattern] -> [Arg MPat] -> Match ()+matchPats mlit ps qs = mconcat $ zipWith (matchPat mlit) (map unArg ps) (map unArg qs)++matchPat :: MatchLit -> Pattern -> MPat -> Match ()+matchPat _    (VarP _) _ = Yes ()+matchPat _    (DotP _) _ = Yes ()+matchPat mlit (LitP l) q = mlit l q+matchPat mlit (ConP c ps) q = case q of+  VarMP x -> Block $ Just x+  WildMP  -> Block Nothing+  ConMP c' qs+    | c == c'   -> matchPats mlit ps qs+    | otherwise -> No+  LitMP _ -> __IMPOSSIBLE__+

+ src/full/Agda/TypeChecking/DisplayForm.hs view

@@ -0,0 +1,78 @@+{-# LANGUAGE CPP #-}++module Agda.TypeChecking.DisplayForm where++import Control.Applicative+import Control.Monad+import Control.Monad.Error++import Agda.Syntax.Common+import Agda.Syntax.Internal+import Agda.TypeChecking.Monad+import Agda.TypeChecking.Substitute+import Agda.TypeChecking.Reduce+import Agda.Syntax.Scope.Base+import Agda.Utils.Size++#include "../undefined.h"+import Agda.Utils.Impossible++displayForm :: QName -> Args -> TCM (Maybe DisplayTerm)+displayForm c vs = do+    odfs  <- defDisplay <$> getConstInfo c+    unless (null odfs) $ verboseS "tc.display.top" 30 $ do+      n <- getContextId+      let fvs = map (\(OpenThing n _) -> n) odfs+      reportSLn "" 0 $ "displayForm: context = " ++ show n ++ ", dfs = " ++ show fvs+    dfs	  <- do+      xs <- mapM tryOpen odfs+      return [ df | Just df <- xs ]+    scope <- getScope+    let matches dfs vs = [ m | Just m <- map (flip matchDisplayForm vs) dfs, inScope scope m ]+    -- Not safe when printing non-terminating terms.+    -- (nfdfs, us) <- normalise (dfs, vs)+    unless (null odfs) $ reportSLn "tc.display.top" 20 $ unlines+      [ "displayForms: " ++ show dfs+      , "arguments   : " ++ show vs+      , "matches     : " ++ show (matches dfs vs)+      ]+    return $ foldr (const . Just) Nothing $ matches dfs vs -- ++ matches nfdfs us+  `catchError` \_ -> return Nothing+  where+    inScope _ _ = True  -- TODO: distinguish between with display forms and other display forms+--     inScope scope d = case hd d of+--       Just h  -> maybe False (const True) $ inverseScopeLookupName h scope+--       Nothing -> __IMPOSSIBLE__ -- TODO: currently all display forms have heads+    hd (DTerm (Def x _))    = Just x+    hd (DTerm (Con x _))    = Just x+    hd (DWithApp (d : _) _) = hd d+    hd _		    = Nothing++matchDisplayForm :: DisplayForm -> Args -> Maybe DisplayTerm+matchDisplayForm (Display n ps v) vs+  | length ps > length vs = Nothing+  | otherwise             = do+    us <- match n ps $ raise 1 (map unArg vs0)+    return $ substs (reverse us) v `apply` vs1+  where+    (vs0, vs1) = splitAt (length ps) vs++class Match a where+  match :: Nat -> a -> a -> Maybe [Term]++instance Match a => Match [a] where+  match n xs ys = concat <$> zipWithM (match n) xs ys++instance Match a => Match (Arg a) where+  match n p v = match n (unArg p) (unArg v)++instance Match Term where+  match n p v = case (p, v) of+    (Var 0 [], v)                  -> return [subst __IMPOSSIBLE__ v]+    (Var i ps, Var j vs) | i == j  -> match n ps vs+    (Def c ps, Def d vs) | c == d  -> match n ps vs+    (Con c ps, Con d vs) | c == d  -> match n ps vs+    (Lit l, Lit l')      | l == l' -> return []+    (p, v)               | p == v  -> return []+    _                              -> fail ""+

+ src/full/Agda/TypeChecking/Empty.hs view

@@ -0,0 +1,39 @@++module Agda.TypeChecking.Empty where++import Control.Applicative++import Agda.Syntax.Common+import Agda.Syntax.Internal++import Agda.TypeChecking.Monad+import Agda.TypeChecking.Coverage+import Agda.TypeChecking.Constraints+import Agda.TypeChecking.Reduce++import Agda.Utils.Permutation+import Agda.Utils.Size++-- | Make sure that a type is empty.+isEmptyType :: MonadTCM tcm => Type -> tcm ()+isEmptyType t = noConstraints $ isEmptyTypeC t++isEmptyTypeC :: MonadTCM tcm => Type -> tcm Constraints+isEmptyTypeC t = do+  tb <- reduceB t+  let t = ignoreBlocking tb+  case unEl <$> tb of+    NotBlocked MetaV{} -> buildConstraint (IsEmpty t)+    Blocked{}          -> buildConstraint (IsEmpty t)+    _                  -> do+      tel0 <- getContextTelescope+      let tel = telFromList $ telToList tel0 ++ [Arg NotHidden ("_", t)]+          ps  = [ Arg h $ VarP x | Arg h (x, _) <- telToList tel ]++      r <- split tel (idP $ size tel) ps 0++      case r of+        Left err  -> typeError $ ShouldBeEmpty t []+        Right []  -> return []+        Right cs  -> typeError $ ShouldBeEmpty t $ map (unArg . last . scPats) cs+

+ src/full/Agda/TypeChecking/Empty.hs-boot view

@@ -0,0 +1,9 @@++module Agda.TypeChecking.Empty where++import Agda.TypeChecking.Monad (MonadTCM, Constraints)+import Agda.Syntax.Internal (Type)++isEmptyType :: MonadTCM tcm => Type -> tcm ()+isEmptyTypeC :: MonadTCM tcm => Type -> tcm Constraints+

+ src/full/Agda/TypeChecking/Errors.hs view

@@ -0,0 +1,612 @@+{-# LANGUAGE CPP #-}+module Agda.TypeChecking.Errors+    ( prettyError+    , PrettyTCM(..)+    ) where++import Control.Applicative ( (<$>) )+import Control.Monad.State+import Control.Monad.Error+import qualified Data.Map as Map (empty)+import System.FilePath++import Agda.Syntax.Common+import Agda.Syntax.Fixity+import Agda.Syntax.Position+import qualified Agda.Syntax.Info as A+import qualified Agda.Syntax.Concrete as C+import qualified Agda.Syntax.Concrete.Definitions as D+import Agda.Syntax.Abstract as A+import Agda.Syntax.Internal as I+import qualified Agda.Syntax.Abstract.Pretty as P+import qualified Agda.Syntax.Concrete.Pretty as P+import Agda.Syntax.Translation.InternalToAbstract+import Agda.Syntax.Translation.AbstractToConcrete++import Agda.TypeChecking.Monad+import Agda.TypeChecking.Pretty++import Agda.Utils.Monad+import Agda.Utils.Trace+import Agda.Utils.Size++#include "../undefined.h"+import Agda.Utils.Impossible++---------------------------------------------------------------------------+-- * Top level function+---------------------------------------------------------------------------++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 (+	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'''])++---------------------------------------------------------------------------+-- * Helpers+---------------------------------------------------------------------------++sayWhere :: (MonadTCM tcm, HasRange a) => a -> tcm Doc -> tcm Doc+sayWhere x d = text (show $ getRange x) $$ d++sayWhen :: MonadTCM tcm => CallTrace -> tcm Doc -> tcm Doc+sayWhen tr m = case matchCall interestingCall tr of+  Nothing -> sayWhere tr m+  Just c  -> sayWhere tr (m $$ prettyTCM c)++panic :: MonadTCM tcm => String -> tcm Doc+panic s = fwords $ "Panic: " ++ s++nameWithBinding :: MonadTCM tcm => QName -> tcm Doc+nameWithBinding q =+  sep [ prettyTCM q, text "bound at", text (show r) ]+  where+    r = nameBindingSite $ qnameName q++tcErrString :: TCErr -> String+tcErrString err = show (getRange err) ++ " " ++ case err of+    TypeError _ cl -> errorString $ clValue cl+    Exception r s  -> show r ++ " " ++ s+    PatternErr _   -> "PatternErr"+    AbortAssign _  -> "AbortAssign"++errorString :: TypeError -> String+errorString err = case err of+    AmbiguousModule _ _			       -> "AmbiguousModule"+    AmbiguousName _ _			       -> "AmbiguousName"+    AmbiguousParseForApplication _ _	       -> "AmbiguousParseForApplication"+    AmbiguousParseForLHS _ _		       -> "AmbiguousParseForLHS"+    BothWithAndRHS                             -> "BothWithAndRHS"+    BuiltinInParameterisedModule _	       -> "BuiltinInParameterisedModule"+    BuiltinMustBeConstructor _ _               -> "BuiltinMustBeConstructor"+    ClashingDefinition _ _		       -> "ClashingDefinition"+    ClashingFileNamesFor _ _		       -> "ClashingFileNamesFor"+    ClashingImport _ _			       -> "ClashingImport"+    ClashingModule _ _			       -> "ClashingModule"+    ClashingModuleImport _ _		       -> "ClashingModuleImport"+    CompilationError _                         -> "CompilationError"+    ConstructorPatternInWrongDatatype _ _      -> "ConstructorPatternInWrongDatatype"+    CoverageFailure _ _                        -> "CoverageFailure"+    CoverageCantSplitOn _                      -> "CoverageCantSplitOn"+    CoverageCantSplitType _                    -> "CoverageCantSplitType"+    CyclicModuleDependency _		       -> "CyclicModuleDependency"+    DataMustEndInSort _			       -> "DataMustEndInSort"+    DependentPatternMatchingOnCodata           -> "DependentPatternMatchingOnCodata"+    DifferentArities			       -> "DifferentArities"+    DoesNotConstructAnElementOf{}              -> "DoesNotConstructAnElementOf"+    DuplicateBuiltinBinding _ _ _	       -> "DuplicateBuiltinBinding"+    DuplicateFields _			       -> "DuplicateFields"+    DuplicateConstructors _		       -> "DuplicateConstructors"+    FieldOutsideRecord                         -> "FieldOutsideRecord"+    FileNotFound _ _			       -> "FileNotFound"+    GenericError _			       -> "GenericError"+    HTMLDirUndefined                           -> "HTMLDirUndefined"+    IlltypedPattern _ _                        -> "IlltypedPattern"+    IncompletePatternMatching _ _	       -> "IncompletePatternMatching"+    InternalError _			       -> "InternalError"+    InvalidPattern _                           -> "InvalidPattern"+    LocalVsImportedModuleClash _	       -> "LocalVsImportedModuleClash"+    MetaCannotDependOn _ _ _		       -> "MetaCannotDependOn"+    MetaOccursInItself _		       -> "MetaOccursInItself"+    ModuleArityMismatch _ _ _                  -> "ModuleArityMismatch"+    ModuleDoesntExport _ _		       -> "ModuleDoesntExport"+    ModuleNameDoesntMatchFileName _	       -> "ModuleNameDoesntMatchFileName"+    NoBindingForBuiltin _		       -> "NoBindingForBuiltin"+    NoParseForApplication _		       -> "NoParseForApplication"+    NoParseForLHS _			       -> "NoParseForLHS"+    NoRHSRequiresAbsurdPattern _	       -> "NoRHSRequiresAbsurdPattern"+    NotInductive {}                            -> "NotInductive"+    AbsurdPatternRequiresNoRHS _	       -> "AbsurdPatternRequiresNoRHS"+    NoSuchBuiltinName _			       -> "NoSuchBuiltinName"+    NoSuchModule _			       -> "NoSuchModule"+    NoSuchPrimitiveFunction _		       -> "NoSuchPrimitiveFunction"+    NotAModuleExpr _			       -> "NotAModuleExpr"+    NotAProperTerm			       -> "NotAProperTerm"+    NotAValidLetBinding _		       -> "NotAValidLetBinding"+    NotAnExpression _			       -> "NotAnExpression"+    NotImplemented _			       -> "NotImplemented"+    NotSupported _			       -> "NotSupported"+    NotInScope _			       -> "NotInScope"+    NotLeqSort _ _			       -> "NotLeqSort"+    NotStrictlyPositive _ _		       -> "NotStrictlyPositive"+    NothingAppliedToHiddenArg _		       -> "NothingAppliedToHiddenArg"+    PatternShadowsConstructor {}               -> "PatternShadowsConstructor"+    PropMustBeSingleton			       -> "PropMustBeSingleton"+    RepeatedVariablesInPattern _	       -> "RepeatedVariablesInPattern"+    ShadowedModule _                           -> "ShadowedModule"+    ShouldBeASort _			       -> "ShouldBeASort"+    ShouldBeApplicationOf _ _		       -> "ShouldBeApplicationOf"+    ShouldBeAppliedToTheDatatypeParameters _ _ -> "ShouldBeAppliedToTheDatatypeParameters"+    ShouldBeEmpty _ _			       -> "ShouldBeEmpty"+    ShouldBePi _			       -> "ShouldBePi"+    ShouldBeRecordType _		       -> "ShouldBeRecordType"+    ShouldEndInApplicationOfTheDatatype _      -> "ShouldEndInApplicationOfTheDatatype"+    TerminationCheckFailed _		       -> "TerminationCheckFailed"+    TooFewFields _ _			       -> "TooFewFields"+    TooManyArgumentsInLHS _ _                  -> "TooManyArgumentsInLHS"+    TooManyFields _ _			       -> "TooManyFields"+    UnequalHiding _ _			       -> "UnequalHiding"+    UnequalSorts{}			       -> "UnequalSorts"+    UnequalTerms{}			       -> "UnequalTerms"+    UnequalTypes{}			       -> "UnequalTypes"+    UnexpectedWithPatterns _                   -> "UnexpectedWithPatterns"+    UninstantiatedDotPattern _                 -> "UninstantiatedDotPattern"+    UninstantiatedModule _		       -> "UninstantiatedModule"+    UnreachableClauses{}                       -> "UnreachableClauses"+    UnsolvedConstraints _		       -> "UnsolvedConstraints"+    UnsolvedMetas _			       -> "UnsolvedMetas"+    WithClausePatternMismatch _ _              -> "WithClausePatternMismatch"+    WrongHidingInApplication _		       -> "WrongHidingInApplication"+    WrongHidingInLHS _			       -> "WrongHidingInLHS"+    WrongHidingInLambda _		       -> "WrongHidingInLambda"+    WrongNumberOfConstructorArguments _ _ _    -> "WrongNumberOfConstructorArguments"++instance PrettyTCM TCErr where+    prettyTCM err = case err of+	TypeError s e -> do+	    s0 <- get+	    put s+	    d <- sayWhen (clTrace e) $ prettyTCM e+	    put s0+	    return d+	Exception r s -> sayWhere r $ fwords s+	PatternErr _  -> sayWhere err $ panic "uncaught pattern violation"+	AbortAssign _ -> sayWhere err $ panic "uncaught aborted assignment"++instance PrettyTCM TypeError where+    prettyTCM err = do+	trace <- getTrace+	case err of+	    InternalError s  -> panic s+	    NotImplemented s -> fwords $ "Not implemented: " ++ s+	    NotSupported s -> fwords $ "Not supported: " ++ s+	    CompilationError s -> sep [fwords "Compilation error:", text s]+	    GenericError s   -> fwords s+	    TerminationCheckFailed because -> fsep $+	      pwords "Termination checking failed for the following functions:" +++              [ fsep (punctuate comma (map (text . show . qnameName)+                                           (concatMap fst because))) <> text "." ]+	    PropMustBeSingleton -> fwords+		"Datatypes in Prop must have at most one constructor when proof irrelevance is enabled"+	    DataMustEndInSort t -> fsep $+		pwords "The type of a datatype must end in a sort."+		++ [prettyTCM t] ++ pwords "isn't a sort."+	    ShouldEndInApplicationOfTheDatatype t -> fsep $+		pwords "The target of a constructor must be the datatype applied to its parameters,"+		++ [prettyTCM t] ++ pwords "isn't"+	    ShouldBeAppliedToTheDatatypeParameters s t -> fsep $+		pwords "The target of the constructor should be" ++ [prettyTCM s] +++		pwords "instead of" ++ [prettyTCM t]+	    ShouldBeApplicationOf t q -> fsep $+		pwords "The pattern constructs an element of" ++ [prettyTCM q] +++		pwords "which is not the right datatype"+	    ShouldBeRecordType t -> fsep $+		pwords "Expected record type, found " ++ [prettyTCM t]+	    DifferentArities ->+		fwords "The number of arguments in the defining equations differ"+	    WrongHidingInLHS t -> do+		fwords "Found an implicit argument where an explicit argument was expected"+	    WrongHidingInLambda t -> do+		fwords "Found an implicit lambda where an explicit lambda was expected"+	    WrongHidingInApplication t -> do+		fwords "Found an implicit application where an explicit application was expected"+            DependentPatternMatchingOnCodata ->+              fwords "Dependent pattern matching on codata is not allowed"+            NotInductive t -> fsep $+              [prettyTCM t] ++ pwords "is not an inductive data type"+            UninstantiatedDotPattern e -> fsep $+              pwords "Failed to infer the value of dotted pattern"+            IlltypedPattern p a -> fsep $+              pwords "Type mismatch"+            TooManyArgumentsInLHS n a -> fsep $+              pwords "Left hand side gives too many arguments to a function of type" ++ [prettyTCM a]+            WrongNumberOfConstructorArguments c expect given -> fsep $+              pwords "The constructor" ++ [prettyTCM c] ++ pwords "expects" +++              [text (show expect)] ++ pwords "arguments, but has been given" ++ [text (show given)]+            DoesNotConstructAnElementOf c t -> fsep $+              pwords "the constructor" ++ [prettyTCM c] +++              pwords "does not construct an element of" ++ [prettyTCM t]+            ConstructorPatternInWrongDatatype c d -> fsep $+              [prettyTCM c] ++ pwords "is not a constructor of the datatype" ++ [prettyTCM d]+            ShadowedModule [] -> __IMPOSSIBLE__+            ShadowedModule ms@(m : _) -> fsep $+              pwords "Shadowing of module" ++ [prettyTCM m] ++ pwords "defined at" ++ [text $ show r] +++              pwords "is not allowed"+              where+                r = case [ r | r <- map (defSiteOfLast . mnameToList) ms+                             , r /= noRange ] of+                      []    -> noRange+                      r : _ -> r++                defSiteOfLast [] = noRange+                defSiteOfLast ns = nameBindingSite (last ns)+            ModuleArityMismatch m EmptyTel args -> fsep $+              pwords "The module" ++ [prettyTCM m] +++              pwords "is not parameterized, but is being applied to arguments"+            ModuleArityMismatch m tel@(ExtendTel _ _) args -> fsep $+              pwords "The arguments to " ++ [prettyTCM m] ++ pwords "does not fit the telescope" +++	      [prettyTCM tel]+            ShouldBeEmpty t [] -> fsep $+		[prettyTCM t] ++ pwords "should be empty, but it isn't obvious that it is."+	    ShouldBeEmpty t ps -> fsep (+		[prettyTCM t] +++                pwords "should be empty, but the following constructor patterns are valid:"+              ) $$ nest 2 (vcat $ map (showPat 0) ps)++	    ShouldBeASort t -> fsep $+		[prettyTCM t] ++ pwords "should be a sort, but it isn't"+	    ShouldBePi t -> fsep $+		[prettyTCM t] ++ pwords "should be a function type, but it isn't"+	    NotAProperTerm ->+		fwords "Found a malformed term"+	    UnequalTerms cmp s t a -> fsep $+		[prettyTCM s, f cmp, prettyTCM t] ++ pwords "of type" ++ [prettyTCM a]+                where+                  f CmpEq  = text "!="+                  f CmpLeq = text "!=<"+	    UnequalTypes cmp a b -> fsep $+		[prettyTCM a, f cmp, prettyTCM b]+                where+                  f CmpEq  = text "!="+                  f CmpLeq = text "!=<"+	    UnequalHiding a b -> fsep $+		[prettyTCM a] ++ pwords "!=" ++ [prettyTCM b] +++		pwords "because one is an implicit function type and the other is an explicit function type"+	    UnequalSorts s1 s2 -> fsep $+		[prettyTCM s1] ++ pwords "!=" ++ [prettyTCM s2]+	    NotLeqSort s1 s2 -> fsep $+		pwords "The type of the constructor does not fit in the sort of the datatype, since"+		++ [prettyTCM s1] ++ pwords "is not less or equal than" ++ [prettyTCM s2]+	    TooFewFields r xs -> fsep $+		pwords "Missing fields" ++ punctuate comma (map pretty xs) +++		pwords "in an element of the record" ++ [prettyTCM r]+	    TooManyFields r xs -> fsep $+		pwords "The record type" ++ [prettyTCM r] +++		pwords "does not have the fields" ++ punctuate comma (map pretty xs)+	    DuplicateConstructors xs -> fsep $+		pwords "Duplicate constructors" ++ punctuate comma (map pretty xs) +++		pwords "in datatype"+	    DuplicateFields xs -> fsep $+		pwords "Duplicate fields" ++ punctuate comma (map pretty xs) +++		pwords "in record"+            UnexpectedWithPatterns ps -> fsep $+              pwords "Unexpected with patterns" ++ (punctuate (text " |") $ map prettyA ps)+            WithClausePatternMismatch p q -> fsep $+              pwords "With clause pattern" ++ [prettyA p] +++              pwords "is not an instance of its parent pattern" -- TODO: pretty for internal patterns+	    MetaCannotDependOn m ps i -> fsep $+		    pwords "The metavariable" ++ [prettyTCM $ MetaV m []] ++ pwords "cannot depend on" ++ [pvar i] +++		    pwords "because it" ++ deps+		where+		    pvar i = prettyTCM $ I.Var i []+		    deps = case map pvar ps of+			[]  -> pwords "does not depend on any variables"+			[x] -> pwords "only depends on the variable" ++ [x]+			xs  -> pwords "only depends on the variables" ++ punctuate comma xs++	    MetaOccursInItself m -> fsep $+		pwords "Cannot construct infinite solution of metavariable" ++ [prettyTCM $ MetaV m []]+            BuiltinMustBeConstructor s e -> fsep $+                [prettyA e] ++ pwords "must be a constructor in the binding to builtin" ++ [text s]+	    NoSuchBuiltinName s -> fsep $+		pwords "There is no built-in thing called" ++ [text s]+	    DuplicateBuiltinBinding b x y -> fsep $+		pwords "Duplicate binding for built-in thing" ++ [text b <> comma] +++		pwords "previous binding to" ++ [prettyTCM x]+	    NoBindingForBuiltin x -> fsep $+		pwords "No binding for builtin thing" ++ [text x <> comma] +++		pwords ("use {-# BUILTIN " ++ x ++ " name #-} to bind it to 'name'")+	    NoSuchPrimitiveFunction x -> fsep $+		pwords "There is no primitive function called" ++ [text x]+	    BuiltinInParameterisedModule x -> fwords $+		"The BUILTIN pragma cannot appear inside a bound context " +++		"(for instance, in a parameterised module or as a local declaration)"+	    NoRHSRequiresAbsurdPattern ps -> fwords $+		"The right-hand side can only be omitted if there " +++		"is an absurd pattern, () or {}, in the left-hand side."+	    AbsurdPatternRequiresNoRHS ps -> fwords $+		"The right-hand side must be omitted if there " +++		"is an absurd pattern, () or {}, in the left-hand side."+	    LocalVsImportedModuleClash m -> fsep $+		pwords "The module" ++ [text $ show m] +++		pwords "can refer to either a local module or an imported module"+	    UnsolvedMetas rs ->+		fsep ( pwords "Unsolved metas at the following locations:" )+		$$ nest 2 (vcat $ map (text . show) rs)+	    UnsolvedConstraints cs ->+		fsep ( pwords "Failed to solve the following constraints:" )+		$$ nest 2 (vcat $ map prettyTCM cs)+	    CyclicModuleDependency ms ->+		fsep (pwords "cyclic module dependency:")+		$$ nest 2 (vcat $ map (text . show) ms)+	    FileNotFound x files ->+		fsep ( pwords "Failed to find source of module" ++ [text $ show x] +++		       pwords "in any of the following locations:"+		     ) $$ nest 2 (vcat $ map text files)+	    ClashingFileNamesFor x files ->+		fsep ( pwords "Multiple possible sources for module" ++ [text $ show x] +++		       pwords "found:"+		     ) $$ nest 2 (vcat $ map text files)+	    ModuleNameDoesntMatchFileName given -> fsep $+              pwords "The name of the top level module does not match the file name. The module" +++              [ text (show given) ] ++ pwords "should be defined in either" +++              [ text ("<top-level>" </> mod ".agda")+              , text "or"+              , text ("<top-level>" </> mod ".lagda") <> text "."+              ]+              where mod = C.moduleNameToFileName (mnameToConcrete given)+            BothWithAndRHS -> fsep $+              pwords "Unexpected right hand side"+	    NotInScope xs ->+		fsep (pwords "Not in scope:") $$ nest 2 (vcat $ map name xs)+		where+                  name x = fsep [ pretty x, text "at" <+> text (show $ getRange x), suggestion (show x) ]+                  suggestion s+                    | elem ':' s    = parens $ text "did you forget space around the ':'?"+                    | elem "->" two = parens $ text "did you forget space around the '->'?"+                    | otherwise     = empty+                    where+                      two = zipWith (\a b -> [a,b]) s (tail s)+	    NoSuchModule x -> fsep $+		pwords "No such module" ++ [pretty x]+	    AmbiguousName x ys -> vcat +	      [ fsep $ pwords "Ambiguous name" ++ [pretty x <> text "."] +++		       pwords "It could refer to any one of"+	      , nest 2 $ vcat $ map nameWithBinding ys+	      ]+	    AmbiguousModule x ys -> vcat +	      [ fsep $ pwords "Ambiguous module name" ++ [pretty x <> text "."] +++		       pwords "It could refer to any one of"+	      , nest 2 $ vcat $ map prettyTCM ys+	      ]+	    UninstantiatedModule x -> fsep (+		    pwords "Cannot access the contents of the parameterised module" ++ [pretty x <> text "."] +++		    pwords "To do this the module first has to be instantiated. For instance:"+		) $$ nest 2 (hsep [ text "module", pretty x <> text "'", text "=", pretty x, text "e1 .. en" ])+	    ClashingDefinition x y -> fsep $+		pwords "Multiple definitions of" ++ [pretty x <> text "."] +++		pwords "Previous definition at" ++ [text $ show $ nameBindingSite $ qnameName y]+	    ClashingModule m1 m2 -> fsep $+		pwords "The modules" ++ [prettyTCM m1, text "and", prettyTCM m2] ++ pwords "clash."+	    ClashingImport x y -> fsep $+		pwords "Import clash between" ++ [pretty x, text "and", prettyTCM y]+	    ClashingModuleImport x y -> fsep $+		pwords "Module import clash between" ++ [pretty x, text "and", prettyTCM y]+	    PatternShadowsConstructor x c -> fsep $+                pwords "The pattern variable" ++ [prettyTCM x] +++                pwords "has the same name as the constructor" ++ [prettyTCM c]+	    ModuleDoesntExport m xs -> fsep $+		pwords "The module" ++ [pretty m] ++ pwords "doesn't export the following:" +++		punctuate comma (map pretty xs)+	    NotAModuleExpr e -> fsep $+		pwords "The right-hand side of a module definition must have the form 'M e1 .. en'" +++		pwords "where M is a module name. The expression" ++ [pretty e, text "doesn't."]+            FieldOutsideRecord -> fsep $+              pwords "Field appearing outside record declaration."+            InvalidPattern p -> fsep $+              pretty p : pwords "is not a valid pattern"+	    RepeatedVariablesInPattern xs -> fsep $+	      pwords "Repeated variables in left hand side:" ++ map pretty xs+	    NotAnExpression e -> fsep $+		[pretty e] ++ pwords "is not a valid expression."+	    NotAValidLetBinding nd -> fwords $+		"Not a valid let-declaration"+	    NothingAppliedToHiddenArg e	-> fsep $+		[pretty e] ++ pwords "cannot appear by itself. It needs to be the argument to" +++		pwords "a function expecting an implicit argument."+	    NoParseForApplication es -> fsep $+		pwords "Could not parse the application" ++ [pretty $ C.RawApp noRange es]+	    AmbiguousParseForApplication es es' -> fsep (+		    pwords "Don't know how to parse" ++ [pretty (C.RawApp noRange es) <> text "."] +++		    pwords "Could mean any one of:"+		) $$ nest 2 (vcat $ map pretty es')+	    NoParseForLHS p -> fsep $+		pwords "Could not parse the left-hand side" ++ [pretty p]+	    AmbiguousParseForLHS p ps -> fsep (+		    pwords "Don't know how to parse" ++ [pretty p <> text "."] +++		    pwords "Could mean any one of:"+		) $$ nest 2 (vcat $ map pretty ps)+	    IncompletePatternMatching v args -> fsep $+		pwords "Incomplete pattern matching for" ++ [prettyTCM v <> text "."] +++		pwords "No match for" ++ map prettyTCM args+            UnreachableClauses f pss -> fsep $+                pwords "Unreachable" ++ pwords (plural (length pss) "clause")+                where+                  plural 1 thing = thing+                  plural n thing = thing ++ "s"+            CoverageFailure f pss -> fsep (+                pwords "Incomplete pattern matching for" ++ [prettyTCM f <> text "."] +++                pwords "Missing cases:") $$ nest 2 (vcat $ map display pss)+                where+                  display ps = do+                    ps <- nicify f ps+                    prettyTCM f <+> fsep (map showArg ps)++                  nicify f ps = do+                    showImp <- showImplicitArguments+                    if showImp+                      then return ps+                      else return ps  -- TODO: remove implicit arguments which aren't constructors++            CoverageCantSplitOn c -> fsep $+              pwords "Cannot split on the constructor" ++ [prettyTCM c]++            CoverageCantSplitType a -> fsep $+              pwords "Cannot split on argument of non-datatype" ++ [prettyTCM a]++	    NotStrictlyPositive d ocs -> fsep $+		pwords "The datatype" ++ [prettyTCM d] ++ pwords "is not strictly positive, because"+		++ prettyOcc "it" ocs+		where+		    prettyOcc _ [] = []+		    prettyOcc it (OccCon d c r : ocs) = concat+			[ pwords it, pwords "occurs", prettyR r+			, pwords "in the constructor", [prettyTCM c], pwords "of"+			, [prettyTCM d <> com ocs], prettyOcc "which" ocs+			]+		    prettyOcc it (OccClause f n r : ocs) = concat+			[ pwords it, pwords "occurs", prettyR r+			, pwords "in the", [th n], pwords "clause of"+			, [prettyTCM f <> com ocs], prettyOcc "which" ocs+			]+		    prettyR NonPositively = pwords "negatively"+		    prettyR (ArgumentTo i q) =+			pwords "as the" ++ [th i] +++			pwords "argument to" ++ [prettyTCM q]+		    th 0 = text "first"+		    th 1 = text "second"+		    th 2 = text "third"+		    th n = text (show $ n - 1) <> text "th"++		    com []    = empty+		    com (_:_) = comma+            HTMLDirUndefined ->+              fwords "You have to specify where to place the HTML files."+          where+            mpar n args+              | n > 0 && not (null args) = parens+              | otherwise                = id++            showArg (Arg Hidden x)    = braces $ showPat 0 x+            showArg (Arg NotHidden x) = showPat 1 x++            showPat _ (I.VarP _)      = text "_"+            showPat _ (I.DotP _)      = text "._"+            showPat n (I.ConP c args) = mpar n args $ prettyTCM c <+> fsep (map showArg args)+            showPat _ (I.LitP l)      = text (show l)++++instance PrettyTCM Call where+    prettyTCM c = case c of+	CheckClause t cl _  -> fsep $+	    pwords "when checking that the clause"+	    ++ [P.prettyA cl] ++ pwords "has type" ++ [prettyTCM t]+	CheckPattern p tel t _ -> addCtxTel tel $ fsep $+	    pwords "when checking that the pattern"+	    ++ [prettyA p] ++ pwords "has type" ++ [prettyTCM t]+	CheckLetBinding b _ -> fsep $+	    pwords "when checking the let binding" ++ [P.prettyA b]+	InferExpr e _ -> fsep $+	    pwords "when inferring the type of" ++ [prettyA e]+	CheckExpr e t _ -> fsep $+	    pwords "when checking that the expression"+	    ++ [prettyA e] ++ pwords "has type" ++ [prettyTCM t]+	IsTypeCall e s _ -> fsep $+	    pwords "when checking that the expression"+	    ++ [prettyA e] ++ pwords "is a type of sort" ++ [prettyTCM s]+	IsType_ e _ -> fsep $+	    pwords "when checking that the expression"+	    ++ [prettyA e] ++ pwords "is a type"+	CheckArguments r es t0 t1 _ -> fsep $+	    pwords "when checking that" +++	    map hPretty es ++ pwords "are valid arguments to a function of type" ++ [prettyTCM t0]+	CheckRecDef _ x ps cs _ ->+	    fsep $ pwords "when checking the definition of" ++ [prettyTCM x]+	CheckDataDef _ x ps cs _ ->+	    fsep $ pwords "when checking the definition of" ++ [prettyTCM x]+	CheckConstructor d _ _ (A.Axiom _ c _) _ -> fsep $+	    pwords "when checking the constructor" ++ [prettyTCM c] +++	    pwords "in the declaration of" ++ [prettyTCM d]+	CheckConstructor _ _ _ _ _ -> __IMPOSSIBLE__+	CheckFunDef _ f _ _ ->+	    fsep $ pwords "when checking the definition of" ++ [prettyTCM f]+	CheckPragma _ p _ ->+	    fsep $ pwords "when checking the pragma" ++ [prettyA $ RangeAndPragma noRange p]+	CheckPrimitive _ x e _ -> fsep $+	    pwords "when checking that the type of the primitive function" +++	    [prettyTCM x] ++ pwords "is" ++ [prettyA e]+        CheckDotPattern e v _ -> fsep $+            pwords "when checking that the given dot pattern" ++ [prettyA e] +++            pwords "matches the inferred value" ++ [prettyTCM v]+        CheckPatternShadowing c _ -> fsep $+            pwords "when checking the clause" ++ [P.prettyA c]+	InferVar x _ ->+	    fsep $ pwords "when inferring the type of" ++ [prettyTCM x]+	InferDef _ x _ ->+	    fsep $ pwords "when inferring the type of" ++ [prettyTCM x]+	ScopeCheckExpr e _ ->+	    fsep $ pwords "when scope checking" ++ [pretty e]+	ScopeCheckDeclaration d _ ->+	    fwords "when scope checking the declaration" $$+	    nest 2 (pretty $ simpleDecl d)+	ScopeCheckDefinition d _ ->+	    fwords "when scope checking the definition" $$+	    nest 2 (vcat $ map pretty $ simpleDef d)+	ScopeCheckLHS x p _ ->+	    fsep $ pwords "when scope checking the left-hand side" ++ [pretty p] +++		   pwords "in the definition of" ++ [pretty x]+	TermFunDef _ f _ _ ->+	    fsep $ pwords "when termination checking the definition of" ++ [prettyTCM f]+	SetRange r _ ->+	    fsep $ pwords "when doing something at" ++ [text $ show r]+        CheckSectionApplication _ m1 ptel m2 args _ -> fsep $+          pwords "when checking the module application" +++          [prettyA $ A.Apply info m1 ptel m2 args Map.empty Map.empty]+          where+            info = A.ModuleInfo PublicAccess ConcreteDef noRange++	where+	    hPretty a@(Arg h _) = pretty =<< abstractToConcreteCtx (hiddenArgumentCtx h) a++	    simpleDef d = case d of+	      D.FunDef _ ds _ _ _ _ _	 -> ds+	      D.DataDef r ind fx p a d bs cs ->+		[ C.Data r ind d (map bind bs) (C.Underscore noRange Nothing)+		    $ map simpleDecl cs+		]+	      D.RecDef r fx p a d bs cs ->+		[ C.Record r d (map bind bs) (C.Underscore noRange Nothing)+		    $ map simpleDecl cs+		]+	      where+		bind :: C.LamBinding -> C.TypedBindings+		bind (C.DomainFull b) = b+		bind (C.DomainFree h x) = C.TypedBindings r h [C.TBind r [x] (C.Underscore r Nothing)]+		  where r = getRange x+		-- bind _		      = __IMPOSSIBLE__++	    simpleDecl d = case d of+		D.Axiom _ _ _ _ x e		       -> C.TypeSig x e+		D.NiceField _ _ _ _ x e		       -> C.Field x e+		D.PrimitiveFunction r _ _ _ x e	       -> C.Primitive r [C.TypeSig x e]+		D.NiceDef r ds _ _		       -> C.Mutual r ds+		D.NiceModule r _ _ x tel _	       -> C.Module r x tel []+		D.NiceModuleMacro r _ _ x tel e op dir -> C.ModuleMacro r x tel e op dir+		D.NiceOpen r x dir		       -> C.Open r x dir+		D.NiceImport r x as op dir	       -> C.Import r x as op dir+		D.NicePragma _ p		       -> C.Pragma p++interestingCall :: Closure Call -> Maybe (Closure Call)+interestingCall cl = case clValue cl of+    InferVar _ _	      -> Nothing+    InferDef _ _ _	      -> Nothing+    CheckArguments _ [] _ _ _ -> Nothing+    SetRange _ _	      -> Nothing+    _			      -> Just cl+

+ src/full/Agda/TypeChecking/EtaContract.hs view

@@ -0,0 +1,43 @@+{-# LANGUAGE CPP #-}++-- | Compute eta short normal forms.+module Agda.TypeChecking.EtaContract where++import Agda.Syntax.Common+import Agda.Syntax.Internal+import Agda.Syntax.Internal.Generic+import Agda.TypeChecking.Substitute+import Agda.TypeChecking.Free++#include "../undefined.h"+import Agda.Utils.Impossible++-- TODO: move to Agda.Syntax.Internal.SomeThing+data BinAppView = App Term (Arg Term)+                | NoApp Term++binAppView :: Term -> BinAppView+binAppView t = case t of+  Var i xs   -> app (Var i) xs+  Def c xs   -> app (Def c) xs+  Con c xs   -> app (Con c) xs+  Lit _      -> noApp+  Lam _ _    -> noApp+  Pi _ _     -> noApp+  Fun _ _    -> noApp+  Sort _     -> noApp+  MetaV _ _  -> noApp+  where+    noApp = NoApp t+    app f [] = noApp+    app f xs = App (f $ init xs) (last xs)++etaContract :: TermLike a => a -> a+etaContract = traverseTerm eta+  where+    eta t@(Lam h b) = case binAppView (absBody b) of+      App u (Arg _ (Var 0 []))+        | not (freeIn 0 u)  -> subst __IMPOSSIBLE__ u+      _ -> t+    eta t = t+

+ src/full/Agda/TypeChecking/Free.hs view

@@ -0,0 +1,96 @@+{-# LANGUAGE CPP #-}++-- | Computing the free variables of a term.+module Agda.TypeChecking.Free +    ( FreeVars(..)+    , Free(..)+    , allVars+    , freeIn+    ) where++import qualified Data.Set as Set+import Data.Set (Set)++import Agda.Syntax.Common+import Agda.Syntax.Internal++#include "../undefined.h"+import Agda.Utils.Impossible++data FreeVars = FV { rigidVars	  :: Set Nat+		   , flexibleVars :: Set Nat+		   }++allVars :: FreeVars -> Set Nat+allVars fv = Set.union (rigidVars fv) (flexibleVars fv)++flexible :: FreeVars -> FreeVars+flexible fv =+    FV { rigidVars    = Set.empty+       , flexibleVars = allVars fv+       }++union :: FreeVars -> FreeVars -> FreeVars+union (FV rv1 fv1) (FV rv2 fv2) = FV (Set.union rv1 rv2) (Set.union fv1 fv2)++unions :: [FreeVars] -> FreeVars+unions = foldr union empty++empty :: FreeVars+empty = FV Set.empty Set.empty++mapFV :: (Nat -> Nat) -> FreeVars -> FreeVars+mapFV f (FV rv fv) = FV (Set.map f rv) (Set.map f fv)++delete :: Nat -> FreeVars -> FreeVars+delete x (FV rv fv) = FV (Set.delete x rv) (Set.delete x fv)++singleton :: Nat -> FreeVars+singleton x = FV { rigidVars	= Set.singleton x+		 , flexibleVars = Set.empty+		 }++-- | Doesn't go inside metas.+class Free a where+  freeVars :: a -> FreeVars++instance Free Term where+  freeVars t = case t of+    Var n ts   -> singleton n `union` freeVars ts+    Lam _ t    -> freeVars t+    Lit _      -> empty+    Def _ ts   -> freeVars ts+    Con _ ts   -> freeVars ts+    Pi a b     -> freeVars (a,b)+    Fun a b    -> freeVars (a,b)+    Sort _     -> empty+    MetaV _ ts -> flexible $ freeVars ts++instance Free Type where+  freeVars (El _ t) = freeVars t++instance Free a => Free [a] where+  freeVars xs = unions $ map freeVars xs++instance (Free a, Free b) => Free (a,b) where+  freeVars (x,y) = freeVars x `union` freeVars y++instance Free a => Free (Arg a) where+  freeVars = freeVars . unArg++instance Free a => Free (Abs a) where+  freeVars (Abs _ b) = mapFV (subtract 1) $ delete 0 $ freeVars b++instance Free Telescope where+  freeVars EmptyTel	     = empty+  freeVars (ExtendTel a tel) = freeVars (a, tel)++instance Free ClauseBody where+  freeVars (Body t)   = freeVars t+  freeVars (Bind b)   = freeVars b+  freeVars (NoBind b) = freeVars b+  freeVars  NoBody    = empty++freeIn :: Free a => Nat -> a -> Bool+freeIn v t = v `Set.member` allVars (freeVars t)+

+ src/full/Agda/TypeChecking/Implicit.hs view

@@ -0,0 +1,42 @@+{-# LANGUAGE CPP #-}++{-| Functions for inserting implicit arguments at the right places.+-}+module Agda.TypeChecking.Implicit where++import Agda.Syntax.Common++#include "../undefined.h"+import Agda.Utils.Impossible++data ImplicitInsertion+      = ImpInsert Int	  -- ^ this many implicits have to be inserted+      | BadImplicits	  -- ^ hidden argument where there should have been a non-hidden arg+      | NoSuchName String -- ^ bad named argument+      | NoInsertNeeded+  deriving (Show)++impInsert :: Int -> ImplicitInsertion+impInsert 0 = NoInsertNeeded+impInsert n = ImpInsert n++-- | The list should be non-empty.+insertImplicit :: NamedArg e -> [Arg String] -> ImplicitInsertion+insertImplicit _		 [] = __IMPOSSIBLE__+insertImplicit (Arg NotHidden _) ts = impInsert $ nofHidden ts+  where+    nofHidden :: [Arg a] -> Int+    nofHidden = length . takeWhile ((Hidden ==) . argHiding)+insertImplicit (Arg _ e) ts@(t : _) =+  case argHiding t of+    NotHidden -> BadImplicits+    Hidden    -> case nameOf e of+      Nothing -> impInsert 0+      Just x  -> find 0 x ts+  where+    find i x (Arg Hidden y : ts)+      | x == y	  = impInsert i+      | otherwise = find (i + 1) x ts+    find i x (Arg NotHidden _ : _) = NoSuchName x+    find i x []			   = NoSuchName x+

+ src/full/Agda/TypeChecking/Injectivity.hs view

@@ -0,0 +1,211 @@+{-# LANGUAGE CPP #-}++module Agda.TypeChecking.Injectivity where++import Prelude hiding (mapM)+import Control.Applicative+import Control.Monad hiding (mapM)+import Control.Monad.Error hiding (mapM)+import Control.Monad.State hiding (mapM)+import Control.Monad.Reader hiding (mapM)+import Data.Map (Map)+import qualified Data.Map as Map+import Data.Maybe+import Data.List+import Data.Traversable++import Agda.Syntax.Common+import Agda.Syntax.Internal+import Agda.TypeChecking.Monad+import Agda.TypeChecking.Substitute+import Agda.TypeChecking.Reduce+import Agda.TypeChecking.Primitive+import Agda.TypeChecking.MetaVars+import {-# SOURCE #-} Agda.TypeChecking.Conversion+import Agda.TypeChecking.Pretty+import Agda.TypeChecking.Constraints+import Agda.Utils.List+import Agda.Utils.Monad+import Agda.Utils.Permutation++#include "../undefined.h"+import Agda.Utils.Impossible++-- | Reduce simple (single clause) definitions.+reduceHead :: Term -> TCM (Blocked Term)+reduceHead v = ignoreAbstractMode $ do+  v <- constructorForm v+  case v of+    Def f args -> do+      def <- theDef <$> getConstInfo f+      case def of+--         Function{ funClauses = [ _ ] }  -> unfoldDefinition False reduceHead v f args+        Datatype{ dataClause = Just _ } -> unfoldDefinition False reduceHead v f args+        Record{ recClause = Just _ }    -> unfoldDefinition False reduceHead v f args+        _                               -> return $ notBlocked v+    _ -> return $ notBlocked v++headSymbol :: Term -> TCM (Maybe TermHead)+headSymbol v = ignoreAbstractMode $ do+  v <- ignoreBlocking <$> reduceHead v+  case v of+    Def f _ -> do+      def <- theDef <$> getConstInfo f+      case def of+        Datatype{}  -> return (Just $ ConHead f)+        Record{}    -> return (Just $ ConHead f)+        Axiom{}     -> return (Just $ ConHead f)+        _           -> return Nothing+    Con c _ -> return (Just $ ConHead c)+    Sort _  -> return (Just SortHead)+    Pi _ _  -> return (Just PiHead)+    Fun _ _ -> return (Just PiHead)+    Lit _   -> return Nothing -- handle literal heads as well? can't think of+                              -- any examples where it would be useful...+    _       -> return Nothing++checkInjectivity :: QName -> [Clause] -> TCM FunctionInverse+checkInjectivity f cs = do+  reportSLn "tc.inj.check" 40 $ "Checking injectivity of " ++ show f+  es <- concat <$> mapM entry cs+  let (hs, ps) = unzip es+  reportSLn "tc.inj.check" 40 $ "  right hand sides: " ++ show hs+  if all isJust hs && distinct hs+    then do+      let inv = Map.fromList (map fromJust hs `zip` ps)+      reportSLn "tc.inj.check" 20 $ show f ++ " is injective."+      reportSDoc "tc.inj.check" 30 $ nest 2 $ vcat $+        map (\ (h, c) -> text (show h) <+> text "-->" <+>+                          fsep (punctuate comma $ map (text . show) $ clausePats c)+            ) $ Map.toList inv+      return $ Inverse inv+    else return NotInjective+  where+    entry c = do+      mv <- rhs (clauseBody c)+      case mv of+        Nothing -> return []+        Just v  -> do+          h <- headSymbol v+          return [(h, c)]++    rhs (NoBind b) = rhs b+    rhs (Bind b)   = underAbstraction_ b rhs+    rhs (Body v)   = return $ Just v+    rhs NoBody     = return Nothing++-- | Argument should be on weak head normal form.+functionInverse :: Term -> TCM InvView+functionInverse v = case v of+  Def f args -> do+    d <- theDef <$> getConstInfo f+    case d of+      Function{ funInv = inv } -> case inv of+        NotInjective  -> return NoInv+        Inverse m     -> return $ Inv f args m+      _ -> return NoInv+  _ -> return NoInv++data InvView = Inv QName Args (Map TermHead Clause)+             | NoInv++useInjectivity :: Comparison -> Type -> Term -> Term -> TCM Constraints+useInjectivity cmp a u v = do+  uinv <- functionInverse u+  vinv <- functionInverse v+  case (uinv, vinv) of+    (Inv f fArgs _, Inv g gArgs _)+      | f == g    -> do+        a <- defType <$> getConstInfo f+        reportSDoc "tc.inj.use" 20 $ vcat+          [ fsep (pwords "comparing application of injective function" ++ [prettyTCM f] +++                pwords "at")+          , nest 2 $ fsep $ punctuate comma $ map prettyTCM fArgs+          , nest 2 $ fsep $ punctuate comma $ map prettyTCM gArgs+          , nest 2 $ text "and type" <+> prettyTCM a+          ]+        pol <- getPolarity' cmp f+        compareArgs pol a fArgs gArgs+      | otherwise -> fallBack+    (Inv f args inv, NoInv) -> do+      a <- defType <$> getConstInfo f+      reportSDoc "tc.inj.use" 20 $ fsep $+        pwords "inverting injective function" +++        [ prettyTCM f, text ":", prettyTCM a, text "for", prettyTCM v+        , parens $ text "args =" <+> prettyList (map prettyTCM args)+        ]+      invert u f a inv args =<< headSymbol v+    (NoInv, Inv g args inv) -> do+      a <- defType <$> getConstInfo g+      reportSDoc "tc.inj.use" 20 $ fsep $+        pwords "inverting injective function" +++        [ prettyTCM g, text ":", prettyTCM a,  text "for", prettyTCM u+        , parens $ text "args =" <+> prettyList (map prettyTCM args)+        ]+      invert v g a inv args =<< headSymbol u+    (NoInv, NoInv)          -> fallBack+  where+    fallBack = buildConstraint $ ValueCmp cmp a u v++    invert _ _ a inv args Nothing  = fallBack+    invert org f ftype inv args (Just h) = case Map.lookup h inv of+      Nothing                     -> typeError $ UnequalTerms cmp u v a+      Just (Clause{ clauseTel  = tel+                  , clausePerm = perm+                  , clausePats = ps }) -> do -- instArgs args ps+          -- These are what dot patterns should be instantiated at+          ms <- map unArg <$> newTelMeta tel+          reportSDoc "tc.inj.invert" 20 $ vcat+            [ text "meta patterns" <+> prettyList (map prettyTCM ms)+            , text "  perm =" <+> text (show perm)+            , text "  tel  =" <+> prettyTCM tel+            , text "  ps   =" <+> prettyList (map (text . show) ps)+            ]+          -- and this is the order the variables occur in the patterns+          let ms' = permute (invertP $ compactP perm) ms+          cxt <- getContextTelescope+          let sub = (reverse ms ++ idSub cxt)+          margs <- runReaderT (evalStateT (metaArgs ps) ms') sub+          reportSDoc "tc.inj.invert" 20 $ vcat+            [ text "inversion"+            , nest 2 $ vcat+              [ text "lhs  =" <+> prettyTCM margs+              , text "rhs  =" <+> prettyTCM args+              , text "type =" <+> prettyTCM ftype+              ]+            ]+          pol <- getPolarity' cmp f+          -- The clause might not give as many patterns as there+          -- are arguments (point-free style definitions).+          let args' = take (length margs) args+          cs  <- compareArgs pol ftype margs args'+          unless (null cs) patternViolation+          -- Check that we made progress, i.e. the head symbol+          -- of the original term should be a constructor.+          h <- headSymbol =<< reduce org+          case h of+            Just h  -> compareTerm cmp a u v+            Nothing -> patternViolation+        `catchError` \err -> case err of+          TypeError _ _ -> throwError err+          Exception _ _ -> throwError err+          PatternErr _  -> fallBack+          AbortAssign _ -> fallBack++    nextMeta = do+      m : ms <- get+      put ms+      return m++    dotP v = do+      sub <- ask+      return $ substs sub v++    metaArgs args = mapM metaArg args+    metaArg arg = traverse metaPat arg++    metaPat (DotP v) = dotP v+    metaPat (VarP _) = nextMeta+    metaPat (ConP c args) = Con c <$> metaArgs args+    metaPat (LitP l) = return $ Lit l+

+ src/full/Agda/TypeChecking/MetaVars.hs view

@@ -0,0 +1,456 @@+{-# LANGUAGE CPP, RelaxedPolyRec #-}++module Agda.TypeChecking.MetaVars where++import Control.Monad.Reader+import Control.Monad.State+import Control.Monad.Error+import Data.Generics+import Data.Map (Map)+import Data.Set (Set)+import Data.List as List hiding (sort)+import qualified Data.Map as Map+import qualified Data.Set as Set+import qualified System.IO.UTF8 as UTF8++import Agda.Syntax.Common+import qualified Agda.Syntax.Info as Info+import Agda.Syntax.Internal+import Agda.Syntax.Position+import qualified Agda.Syntax.Abstract as A++import Agda.TypeChecking.Monad+import Agda.TypeChecking.Reduce+import Agda.TypeChecking.Substitute+import Agda.TypeChecking.Constraints+import Agda.TypeChecking.Errors+import Agda.TypeChecking.Free+import Agda.TypeChecking.Records+import Agda.TypeChecking.Pretty++import {-# SOURCE #-} Agda.TypeChecking.Conversion++import Agda.Utils.Fresh+import Agda.Utils.List+import Agda.Utils.Monad+import Agda.Utils.Size++import Agda.TypeChecking.Monad.Debug++#include "../undefined.h"+import Agda.Utils.Impossible++-- | Find position of a value in a list.+--   Used to change metavar argument indices during assignment.+--+--   @reverse@ is necessary because we are directly abstracting over the list.+--+findIdx :: Eq a => [a] -> a -> Maybe Int+findIdx vs v = findIndex (==v) (reverse vs)++-- | Check whether a meta variable is a place holder for a blocked term.+isBlockedTerm :: MonadTCM tcm => MetaId -> tcm Bool+isBlockedTerm x = do+    reportS "tc.meta.blocked" 12 $ "is " ++ show x ++ " a blocked term? "+    i <- mvInstantiation <$> lookupMeta x+    let r = case i of+	    BlockedConst{}                 -> True+            PostponedTypeCheckingProblem{} -> True+	    InstV{}                        -> False+	    InstS{}                        -> False+	    Open{}                         -> False+    reportSLn "tc.meta.blocked" 12 $ if r then "yes" else "no"+    return r++class HasMeta t where+    metaInstance :: MonadTCM tcm => t -> tcm MetaInstantiation+    metaVariable :: MetaId -> Args -> t++instance HasMeta Term where+    metaInstance = return . InstV+    metaVariable = MetaV++instance HasMeta Sort where+    metaInstance     = return . InstS+    metaVariable x _ = MetaS x++-- | The instantiation should not be an 'InstV' or 'InstS' and the 'MetaId'+--   should point to something 'Open' or a 'BlockedConst'.+(=:) :: (MonadTCM tcm, HasMeta t) => MetaId -> t -> tcm ()+x =: t = do+    i <- metaInstance t+    store <- getMetaStore+    modify $ \st -> st { stMetaStore = ins x i store }+    etaExpandListeners x+    wakeupConstraints+  where+    ins x i store = Map.adjust (inst i) x store+    inst i mv = mv { mvInstantiation = i }++assignTerm :: MonadTCM tcm => MetaId -> Term -> tcm ()+assignTerm = (=:)++newSortMeta :: MonadTCM tcm => tcm Sort+newSortMeta =+  ifM typeInType (return $ Type 0) $ do+    i <- createMetaInfo+    MetaS <$> newMeta i normalMetaPriority (IsSort ())++newTypeMeta :: MonadTCM tcm => Sort -> tcm Type+newTypeMeta s = El s <$> newValueMeta (sort s)++newTypeMeta_ ::  MonadTCM tcm => tcm Type+newTypeMeta_  = newTypeMeta =<< newSortMeta++-- | Create a new metavariable, possibly η-expanding in the process.+newValueMeta ::  MonadTCM tcm => Type -> tcm Term+newValueMeta t = do+  vs  <- getContextArgs+  tel <- getContextTelescope+  newValueMetaCtx (telePi_ tel t) vs++newValueMetaCtx :: MonadTCM tcm => Type -> Args -> tcm Term+newValueMetaCtx t ctx = do+  m@(MetaV i _) <- newValueMetaCtx' t ctx+  etaExpandMeta i+  instantiateFull m++-- | Create a new value meta without η-expanding.+newValueMeta' :: MonadTCM tcm => Type -> tcm Term+newValueMeta' t = do+  vs  <- getContextArgs+  tel <- getContextTelescope+  newValueMetaCtx' (telePi_ tel t) vs++-- | Create a new value meta with specific dependencies.+newValueMetaCtx' :: MonadTCM tcm => Type -> Args -> tcm Term+newValueMetaCtx' t vs = do+  i <- createMetaInfo+  x <- newMeta i normalMetaPriority (HasType () t)+  reportSDoc "tc.meta.new" 50 $ fsep+    [ text "new meta:"+    , nest 2 $ prettyTCM vs <+> text "|-"+    , nest 2 $ text (show x) <+> text ":" <+> prettyTCM t+    ]+  return $ MetaV x vs++newTelMeta :: MonadTCM tcm => Telescope -> tcm Args+newTelMeta tel = newArgsMeta (abstract tel $ El Prop $ Sort Prop)++newArgsMeta :: MonadTCM tcm => Type -> tcm Args+newArgsMeta t = do+  args <- getContextArgs+  tel  <- getContextTelescope+  newArgsMetaCtx t tel args++newArgsMetaCtx :: MonadTCM tcm => Type -> Telescope -> Args -> tcm Args+newArgsMetaCtx (El s tm) tel ctx = do+  tm <- reduce tm+  case funView tm of+      FunV (Arg h a) _  -> do+	  v    <- newValueMetaCtx (telePi_ tel a) ctx+	  args <- newArgsMetaCtx (El s tm `piApply` [Arg h v]) tel ctx+	  return $ Arg h v : args+      NoFunV _    -> return []++-- | Create a metavariable of record type. This is actually one metavariable+--   for each field.+newRecordMeta :: MonadTCM tcm => QName -> Args -> tcm Term+newRecordMeta r pars = do+  args <- getContextArgs+  tel  <- getContextTelescope+  newRecordMetaCtx r pars tel args++newRecordMetaCtx :: MonadTCM tcm => QName -> Args -> Telescope -> Args -> tcm Term+newRecordMetaCtx r pars tel ctx = do+  ftel	 <- flip apply pars <$> getRecordFieldTypes r+  fields <- newArgsMetaCtx (telePi_ ftel $ sort Prop) tel ctx+  return $ Con r fields++newQuestionMark :: MonadTCM tcm => Type -> tcm Term+newQuestionMark t = do+  m@(MetaV x _) <- newValueMeta' t+  ii		<- fresh+  addInteractionPoint ii x+  return m++-- | Construct a blocked constant if there are constraints.+blockTerm :: MonadTCM tcm => Type -> Term -> tcm Constraints -> tcm Term+blockTerm t v m = do+    cs <- solveConstraints =<< m+    if List.null cs+	then return v+	else do+	    i	  <- createMetaInfo+	    vs	  <- getContextArgs+	    tel   <- getContextTelescope+	    x	  <- newMeta' (BlockedConst $ abstract tel v)+                              i lowMetaPriority (HasType () $ telePi_ tel t)+			    -- we don't instantiate blocked terms+	    c <- escapeContext (size tel) $ guardConstraint (return cs) (UnBlock x)+            verboseS "tc.meta.blocked" 20 $ do+                dx  <- prettyTCM (MetaV x [])+                dv  <- escapeContext (size tel) $ prettyTCM $ abstract tel v+                dcs <- mapM prettyTCM cs+                liftIO $ UTF8.putStrLn $ "blocked " ++ show dx ++ " := " ++ show dv+                liftIO $ UTF8.putStrLn $ "     by " ++ show dcs+	    addConstraints c+	    return $ MetaV x vs++postponeTypeCheckingProblem_ :: MonadTCM tcm => A.Expr -> Type -> tcm Term+postponeTypeCheckingProblem_ e t =+  postponeTypeCheckingProblem e t unblock+  where+    unblock = do+      t <- reduceB $ unEl t+      case t of+        Blocked{}          -> return False+        NotBlocked MetaV{} -> return False+        _                  -> return True++postponeTypeCheckingProblem :: MonadTCM tcm => A.Expr -> Type -> TCM Bool -> tcm Term+postponeTypeCheckingProblem e t unblock = do+  i   <- createMetaInfo+  tel <- getContextTelescope+  cl  <- buildClosure (e, t, unblock)+  m   <- newMeta' (PostponedTypeCheckingProblem cl)+                  i normalMetaPriority $ HasType () $ telePi_ tel t+  addConstraints =<< buildConstraint (UnBlock m)+  MetaV m <$> getContextArgs++-- | Eta expand metavariables listening on the current meta.+etaExpandListeners :: MonadTCM tcm => MetaId -> tcm ()+etaExpandListeners m = do+  ms <- getMetaListeners m+  clearMetaListeners m	-- we don't really have to do this+  mapM_ etaExpandMeta ms++-- | Eta expand a metavariable.+etaExpandMeta :: MonadTCM tcm => MetaId -> tcm ()+etaExpandMeta m = do+  HasType _ a <- mvJudgement <$> lookupMeta m+  TelV tel b <- telViewM a+  let args	 = [ Arg h $ Var i []+		   | (i, Arg h _) <- reverse $ zip [0..] $ reverse $ telToList tel+		   ]+  bb <- reduceB b+  case unEl <$> bb of+    Blocked x _            -> listenToMeta m x+    NotBlocked (MetaV x _) -> listenToMeta m x+    NotBlocked (Def r ps)  ->+      ifM (isRecord r) (do+	rng <- getMetaRange m+	u   <- setCurrentRange rng $ newRecordMetaCtx r ps tel args+	inContext [] $ addCtxTel tel $ do+	  verboseS "tc.meta.eta" 20 $ do+	    du <- prettyTCM u+	    liftIO $ UTF8.putStrLn $ "eta expanding: " ++ show m ++ " --> " ++ show du+	  noConstraints $ assignV b m args u  -- should never produce any constraints+      ) $ return ()+    _		-> return ()++  return ()++-- | Extended occurs check.+class Occurs t where+  occurs :: (TypeError -> TCM ()) -> MetaId -> [Nat] -> t -> TCM t++occursCheck :: (MonadTCM tcm, Occurs a) => MetaId -> [Nat] -> a -> tcm a+occursCheck m xs = liftTCM . occurs typeError m xs++instance Occurs Term where+    occurs abort m xs v = do+	v <- reduceB v+	case v of+	    -- Don't fail on blocked terms or metas+	    Blocked _ v          -> occurs' (const patternViolation) v+	    NotBlocked v         -> occurs' abort v+	where+	    occurs' abort v = case v of+		Var i vs   -> do+		  unless (i `elem` xs) $ abort $ MetaCannotDependOn m xs i+		  Var i <$> occ vs+		Lam h f	    -> Lam h <$> occ f+		Lit l	    -> return v+		Def c vs    -> Def c <$> occ vs+		Con c vs    -> Con c <$> occ vs+		Pi a b	    -> uncurry Pi <$> occ (a,b)+		Fun a b	    -> uncurry Fun <$> occ (a,b)+		Sort s	    -> Sort <$> occ s+		MetaV m' vs -> do+		    when (m == m') $ abort $ MetaOccursInItself m+		    -- Don't fail on flexible occurrence+		    MetaV m' <$> occurs (const patternViolation) m xs vs+		where+		    occ x = occurs abort m xs x++instance Occurs Type where+    occurs abort m xs (El s v) = uncurry El <$> occurs abort m xs (s,v)++instance Occurs Sort where+    occurs abort m xs s =+	do  s' <- reduce s+	    case s' of+		MetaS m'  -> do+		  when (m == m') $ abort $ MetaOccursInItself m+		  return s'+		Lub s1 s2 -> uncurry Lub <$> occurs abort m xs (s1,s2)+		Suc s	  -> Suc <$> occurs abort m xs s+		Type _	  -> return s'+		Prop	  -> return s'++instance Occurs a => Occurs (Abs a) where+    occurs abort m xs (Abs s x) = Abs s <$> occurs abort m (0 : map (1+) xs) x++instance Occurs a => Occurs (Arg a) where+    occurs abort m xs (Arg h x) = Arg h <$> occurs abort m xs x++instance (Occurs a, Occurs b) => Occurs (a,b) where+    occurs abort m xs (x,y) = (,) <$> occurs abort m xs x <*> occurs abort m xs y++instance Occurs a => Occurs [a] where+    occurs abort m xs ys = mapM (occurs abort m xs) ys++abortAssign :: MonadTCM tcm => tcm a+abortAssign =+    do	s <- get+	liftTCM $ throwError $ AbortAssign s++handleAbort :: MonadTCM tcm => TCM a -> TCM a -> tcm a+handleAbort h m = liftTCM $+    m `catchError` \e ->+	case e of+	    AbortAssign s -> do put s; h+	    _		  -> throwError e++-- | Assign to an open metavar.+--   First check that metavar args are in pattern fragment.+--     Then do extended occurs check on given thing.+--+assignV :: MonadTCM tcm => Type -> MetaId -> Args -> Term -> tcm Constraints+assignV t x args v =+    handleAbort handler $ do+	reportSDoc "tc.meta.assign" 10 $ do+	  prettyTCM (MetaV x args) <+> text ":=" <+> prettyTCM v++	-- We don't instantiate blocked terms+	whenM (isBlockedTerm x) patternViolation	-- TODO: not so nice++	-- Check that the arguments are distinct variables+        reportSDoc "tc.meta.assign" 20 $+            let pr (Var n []) = text (show n)+                pr (Def c []) = prettyTCM c+                pr _          = text ".."+            in+            text "args:" <+> sep (map (pr . unArg) args)+            +	ids <- checkArgs x args++	reportSDoc "tc.meta.assign" 15 $+	    text "preparing to instantiate: " <+> prettyTCM v++	-- Check that the x doesn't occur in the right hand side+	v <- liftTCM $ occursCheck x (map unArg ids) v++	verboseS "tc.conv.assign" 30 $ do+	  let n = size v+	  when (n > 200) $ do+	    r <- getMetaRange x+	    d <- sep [ text "size" <+> text (show n)+		     , nest 2 $ text "type" <+> prettyTCM t+		     , nest 2 $ text "term" <+> prettyTCM v+		     ]+	    liftIO $ UTF8.print d++	reportSLn "tc.meta.assign" 15 "passed occursCheck"++	-- Rename the variables in v to make it suitable for abstraction over ids.+	v' <- do+	    -- Basically, if+	    --   Γ   = a b c d e+	    --   ids = d b e+	    -- then+	    --   v' = (λ a b c d e. v) _ 1 _ 2 0+	    tel  <- getContextTelescope+	    args <- map (Arg NotHidden) <$> getContextTerms+	    let iargs = reverse $ zipWith (rename $ reverse $ map unArg ids) [0..] $ reverse args+		v'    = raise (size ids) (abstract tel v) `apply` iargs+	    return v'++	let extTel (Arg h i) m = do+	      tel <- m+	      t	  <- typeOfBV i+	      x	  <- nameOfBV i+	      return $ ExtendTel (Arg h t) (Abs (show x) tel)+	tel' <- foldr extTel (return EmptyTel) ids++	reportSDoc "tc.meta.assign" 15 $+	  text "final instantiation:" <+> prettyTCM (abstract tel' v')++	-- Perform the assignment (and wake constraints). Metas+	-- are top-level so we do the assignment at top-level.+	n <- size <$> getContextTelescope+	escapeContext n $ x =: killRange (abstract tel' v')+	return []+    where+	rename ids i arg = case findIndex (==i) ids of+	    Just j  -> fmap (const $ Var (fromIntegral j) []) arg+	    Nothing -> fmap (const __IMPOSSIBLE__) arg	-- we will end up here, but never look at the result++	handler :: MonadTCM tcm => tcm Constraints+	handler = do+	    reportSLn "tc.meta.assign" 10 $ "Oops. Undo " ++ show x ++ " := ..."+	    equalTerm t (MetaV x args) v++assignS :: MonadTCM tcm => MetaId -> Sort -> tcm Constraints+assignS x s =+    handleAbort (equalSort (MetaS x) s) $ do+	s <- occursCheck x [] s+	x =: s+	return []++-- | Check that arguments to a metavar are in pattern fragment.+--   Assumes all arguments already in whnf.+--   Parameters are represented as @Var@s so @checkArgs@ really+--     checks that all args are unique @Var@s and returns the+--     list of corresponding indices for each arg-- done+--     to not define equality on @Term@.+--+--   @reverse@ is necessary because we are directly abstracting over this list @ids@.+--+checkArgs :: MonadTCM tcm => MetaId -> Args -> tcm [Arg Nat]+checkArgs x args =+    case validParameters args of+	Just ids    -> return $ reverse ids+	Nothing	    -> patternViolation++-- | Check that the parameters to a meta variable are distinct variables.+validParameters :: Monad m => Args -> m [Arg Nat]+validParameters args+    | all isVar args && distinct (map unArg vars)+                = return $ reverse vars+    | otherwise	= fail "invalid parameters"+    where+	vars = [ Arg h i | Arg h (Var i []) <- args ]++isVar :: Arg Term -> Bool+isVar (Arg _ (Var _ [])) = True+isVar _			 = False+++updateMeta :: (MonadTCM tcm, Data a, Occurs a, Abstract a) => MetaId -> a -> tcm ()+updateMeta mI t = +    do	mv <- lookupMeta mI+	withMetaInfo (getMetaInfo mv) $+	    do	args <- getContextArgs+		cs <- upd mI args (mvJudgement mv) t+		unless (List.null cs) $ fail $ "failed to update meta " ++ show mI+    where+	upd mI args j t = (__IMPOSSIBLE__ `mkQ` updV j `extQ` updS) t+	    where+		updV (HasType _ t) v =+		  assignV (t `piApply` args) mI args v+		updV _ _	     = __IMPOSSIBLE__++		updS s = assignS mI s+

+ src/full/Agda/TypeChecking/MetaVars.hs-boot view

@@ -0,0 +1,8 @@++module Agda.TypeChecking.MetaVars where++import Agda.Syntax.Internal	       ( MetaId, Term )+import Agda.TypeChecking.Monad.Base ( MonadTCM )++assignTerm :: MonadTCM tcm => MetaId -> Term -> tcm ()+

+ src/full/Agda/TypeChecking/Monad.hs view

@@ -0,0 +1,37 @@+module Agda.TypeChecking.Monad+    ( module Agda.TypeChecking.Monad.Base+    , module Agda.TypeChecking.Monad.Closure+    , module Agda.TypeChecking.Monad.Constraints+    , module Agda.TypeChecking.Monad.Context+    , module Agda.TypeChecking.Monad.Debug+    , module Agda.TypeChecking.Monad.Env+    , module Agda.TypeChecking.Monad.Imports+    , module Agda.TypeChecking.Monad.MetaVars+    , module Agda.TypeChecking.Monad.Mutual+    , module Agda.TypeChecking.Monad.Open+    , module Agda.TypeChecking.Monad.Options+    , module Agda.TypeChecking.Monad.Signature+    , module Agda.TypeChecking.Monad.SizedTypes+    , module Agda.TypeChecking.Monad.State+    , module Agda.TypeChecking.Monad.Statistics+    , module Agda.TypeChecking.Monad.Trace+    ) where++import Agda.TypeChecking.Monad.Base+import Agda.TypeChecking.Monad.Closure+import Agda.TypeChecking.Monad.Constraints+import Agda.TypeChecking.Monad.Context+import Agda.TypeChecking.Monad.Debug+import Agda.TypeChecking.Monad.Env+import Agda.TypeChecking.Monad.Imports+import Agda.TypeChecking.Monad.MetaVars+import Agda.TypeChecking.Monad.Mutual+import Agda.TypeChecking.Monad.Options+import Agda.TypeChecking.Monad.Open+import Agda.TypeChecking.Monad.Signature+import Agda.TypeChecking.Monad.SizedTypes+import Agda.TypeChecking.Monad.State+import Agda.TypeChecking.Monad.Statistics+import Agda.TypeChecking.Monad.Trace++

+ src/full/Agda/TypeChecking/Monad/Base.hs view

@@ -0,0 +1,919 @@+{-# LANGUAGE CPP, ExistentialQuantification, FlexibleContexts, Rank2Types,+             TypeSynonymInstances, MultiParamTypeClasses, FlexibleInstances,+             UndecidableInstances, DeriveDataTypeable, GeneralizedNewtypeDeriving+  #-}+module Agda.TypeChecking.Monad.Base where++import Control.Monad.Error+import Control.Monad.State+import Control.Monad.Reader+import Control.Exception+import Control.Applicative+import Data.Map as Map+import Data.Set as Set+import Data.Generics+import Data.Foldable+import Data.Traversable+import System.Time++import Agda.Syntax.Common+import qualified Agda.Syntax.Concrete as C+import qualified Agda.Syntax.Concrete.Definitions as D+import qualified Agda.Syntax.Abstract as A+import Agda.Syntax.Internal+import Agda.Syntax.Position+import Agda.Syntax.Scope.Base++import Agda.Interaction.Exceptions+import Agda.Interaction.Options+import qualified Agda.Interaction.Highlighting.Range as R+import Agda.Interaction.Highlighting.Precise (HighlightingInfo)++import Agda.Utils.Fresh+import Agda.Utils.Monad+import Agda.Utils.Monad.Undo+import Agda.Utils.Trace++#include "../../undefined.h"+import Agda.Utils.Impossible++---------------------------------------------------------------------------+-- * Type checking state+---------------------------------------------------------------------------++data TCState =+    TCSt { stFreshThings       :: FreshThings+	 , stMetaStore	       :: MetaStore+	 , stInteractionPoints :: InteractionPoints+	 , stConstraints       :: Constraints+	 , stSignature	       :: Signature+	 , stImports	       :: Signature+	 , stImportedModules   :: Set ModuleName+	 , stVisitedModules    :: VisitedModules+	 , stDecodedModules    :: DecodedModules+         , stCurrentModule     :: Maybe (ModuleName, Interface)+           -- ^ The current module is available after it has been type+           -- checked.+	 , stScope	       :: ScopeInfo+	 , stOptions	       :: CommandLineOptions+	 , stStatistics	       :: Statistics+	 , stTrace	       :: CallTrace+	     -- ^ record what is happening (for error msgs)+	 , stMutualBlocks      :: Map MutualId (Set QName)+	 , stLocalBuiltins     :: BuiltinThings PrimFun+         , stImportedBuiltins  :: BuiltinThings PrimFun+         , stHaskellImports    :: [String]  -- ^ imports that should be generated+                                            --   by the compiler+	 }++data FreshThings =+	Fresh { fMeta	     :: MetaId+	      , fInteraction :: InteractionId+	      , fMutual	     :: MutualId+	      , fName	     :: NameId+	      , fCtx	     :: CtxId+              , fInteger     :: Integer+                -- ^ Can be used for various things.+	      }+    deriving (Show)++initState :: TCState+initState =+    TCSt { stFreshThings       = Fresh 0 0 0 (NameId 0 0) 0 0+	 , stMetaStore	       = Map.empty+	 , stInteractionPoints = Map.empty+	 , stConstraints       = []+	 , stSignature	       = emptySignature+	 , stImports	       = emptySignature+	 , stImportedModules   = Set.empty+	 , stVisitedModules    = Map.empty+	 , stDecodedModules    = Map.empty+         , stCurrentModule     = Nothing+	 , stScope	       = emptyScopeInfo+	 , stOptions	       = defaultOptions+	 , stStatistics	       = Map.empty+	 , stTrace	       = noTrace+	 , stMutualBlocks      = Map.empty+	 , stLocalBuiltins     = Map.empty+	 , stImportedBuiltins  = Map.empty+         , stHaskellImports    = []+	 }++stBuiltinThings :: TCState -> BuiltinThings PrimFun+stBuiltinThings s = stLocalBuiltins s `Map.union` stImportedBuiltins s++instance HasFresh MetaId FreshThings where+    nextFresh s = (i, s { fMeta = i + 1 })+	where+	    i = fMeta s++instance HasFresh MutualId FreshThings where+    nextFresh s = (i, s { fMutual = i + 1 })+	where+	    i = fMutual s++instance HasFresh InteractionId FreshThings where+    nextFresh s = (i, s { fInteraction = i + 1 })+	where+	    i = fInteraction s++instance HasFresh NameId FreshThings where+    nextFresh s = (i, s { fName = succ i })+	where+	    i = fName s++instance HasFresh CtxId FreshThings where+    nextFresh s = (i, s { fCtx = succ i })+	where+	    i = fCtx s++instance HasFresh Integer FreshThings where+    nextFresh s = (i, s { fInteger = succ i })+	where+	    i = fInteger s++instance HasFresh i FreshThings => HasFresh i TCState where+    nextFresh s = (i, s { stFreshThings = f })+	where+	    (i,f) = nextFresh $ stFreshThings s++---------------------------------------------------------------------------+-- ** Interface+---------------------------------------------------------------------------++type VisitedModules = Map ModuleName (Interface, ClockTime)+type DecodedModules = Map ModuleName (Interface, ClockTime)++data Interface = Interface+	{ iImportedModules :: [ModuleName]+        , iModuleName      :: ModuleName+	, iScope	   :: Scope+	, iSignature	   :: Signature+	, iBuiltin	   :: BuiltinThings String+        , iHaskellImports  :: [String]+        , iHighlighting    :: HighlightingInfo+	}+    deriving (Typeable, Data)++---------------------------------------------------------------------------+-- ** Closure+---------------------------------------------------------------------------++data Closure a = Closure { clSignature  :: Signature+			 , clEnv	:: TCEnv+			 , clScope	:: ScopeInfo+			 , clTrace	:: CallTrace+			 , clValue	:: a+			 }+    deriving (Typeable, Data)++instance HasRange a => HasRange (Closure a) where+    getRange = getRange . clValue++buildClosure :: MonadTCM tcm => a -> tcm (Closure a)+buildClosure x = liftTCM $ do+    env   <- ask+    sig   <- gets stSignature+    scope <- gets stScope+    trace <- gets stTrace+    return $ Closure sig env scope trace x++---------------------------------------------------------------------------+-- ** Constraints+---------------------------------------------------------------------------++type ConstraintClosure = Closure Constraint++data Constraint = ValueCmp Comparison Type Term Term+		| TypeCmp Comparison Type Type+		| SortCmp Comparison Sort Sort+		| UnBlock MetaId+		| Guarded Constraint Constraints+                | IsEmpty Type+  deriving (Typeable)++data Comparison = CmpEq | CmpLeq+  deriving (Eq, Typeable)++type Constraints = [ConstraintClosure]++---------------------------------------------------------------------------+-- * Open things+---------------------------------------------------------------------------++-- | A thing tagged with the context it came from.+data Open a = OpenThing [CtxId] a+    deriving (Typeable, Data)++---------------------------------------------------------------------------+-- * Judgements+---------------------------------------------------------------------------++data Judgement t a+	= HasType a t+	| IsSort  a+    deriving (Typeable, Data)++instance (Show t, Show a) => Show (Judgement t a) where+    show (HasType a t) = show a ++ " : " ++ show t+    show (IsSort  a)   = show a ++ " sort"++instance Functor (Judgement t) where+    fmap f (HasType x t) = HasType (f x) t+    fmap f (IsSort  x)	 = IsSort (f x)++instance Foldable (Judgement t) where+    foldr f z (HasType x _) = f x z+    foldr f z (IsSort  x)   = f x z++instance Traversable (Judgement t) where+    traverse f (HasType x t) = flip HasType t <$> f x+    traverse f (IsSort  x)   = IsSort <$> f x++---------------------------------------------------------------------------+-- ** Meta variables+---------------------------------------------------------------------------++data MetaVariable = +	MetaVar	{ mvInfo	  :: MetaInfo+		, mvPriority	  :: MetaPriority -- ^ some metavariables are more eager to be instantiated+		, mvJudgement	  :: Judgement Type MetaId+		, mvInstantiation :: MetaInstantiation+		, mvListeners	  :: Set MetaId	  -- ^ metavariables interested in what happens to this guy+		}+    deriving (Typeable)++data MetaInstantiation+	= InstV Term+	| InstS Sort+	| Open+	| BlockedConst Term+        | PostponedTypeCheckingProblem (Closure (A.Expr, Type, TCM Bool))+    deriving (Typeable)++instance Show MetaInstantiation where+  show (InstV t) = "InstV (" ++ show t ++ ")"+  show (InstS s) = "InstS (" ++ show s ++ ")"+  show Open      = "Open"+  show (BlockedConst t) = "BlockedConst (" ++ show t ++ ")"+  show (PostponedTypeCheckingProblem{}) = "PostponedTypeCheckingProblem (...)"++newtype MetaPriority = MetaPriority Int+    deriving (Eq, Ord, Show)++-- | TODO: Not so nice.+type MetaInfo = Closure Range++type MetaStore = Map MetaId MetaVariable++instance HasRange MetaVariable where+    getRange m = getRange $ getMetaInfo m++instance SetRange MetaVariable where+  setRange r (MetaVar mi p j inst ls) = MetaVar (mi {clValue = r}) p j inst ls++normalMetaPriority :: MetaPriority+normalMetaPriority = MetaPriority 0++lowMetaPriority :: MetaPriority+lowMetaPriority = MetaPriority (-10)++highMetaPriority :: MetaPriority+highMetaPriority = MetaPriority 10++getMetaInfo :: MetaVariable -> MetaInfo+getMetaInfo = mvInfo++getMetaScope :: MetaVariable -> ScopeInfo+getMetaScope m = clScope $ getMetaInfo m++getMetaEnv :: MetaVariable -> TCEnv+getMetaEnv m = clEnv $ getMetaInfo m++getMetaSig :: MetaVariable -> Signature+getMetaSig m = clSignature $ getMetaInfo m ++---------------------------------------------------------------------------+-- ** Interaction meta variables+---------------------------------------------------------------------------++type InteractionPoints = Map InteractionId MetaId++newtype InteractionId = InteractionId Nat+    deriving (Eq,Ord,Num,Integral,Real,Enum)++instance Show InteractionId where+    show (InteractionId x) = "?" ++ show x++---------------------------------------------------------------------------+-- ** Signature+---------------------------------------------------------------------------++data Signature = Sig+      { sigSections    :: Sections+      , sigDefinitions :: Definitions+      }+  deriving (Typeable, Data)++type Sections	 = Map ModuleName Section+type Definitions = Map QName Definition++data Section = Section+      { secTelescope :: Telescope+      , secFreeVars  :: Nat	    -- ^ This is the number of parameters when+				    --	 we're inside the section and 0+				    --	 outside. It's used to know how much of+				    --	 the context to apply function from the+				    --	 section to when translating from+				    --	 abstract to internal syntax.+      }+  deriving (Typeable, Data)++emptySignature :: Signature+emptySignature = Sig Map.empty Map.empty++data DisplayForm = Display Nat [Term] DisplayTerm+		-- ^ The three arguments are:+		--+		--   * @n@: number of free variables;+		--+		--   * Patterns for arguments, one extra free var which+		--     represents pattern vars. There should @n@ of them.+		--+		--   * Display form. @n@ free variables.+  deriving (Typeable, Data, Show)++data DisplayTerm = DWithApp [DisplayTerm] Args+		 | DTerm Term+  deriving (Typeable, Data, Show)++defaultDisplayForm :: QName -> [Open DisplayForm]+defaultDisplayForm c = []++data Definition = Defn { defName     :: QName+		       , defType     :: Type	-- type of the lifted definition+		       , defDisplay  :: [Open DisplayForm]+		       , defMutual   :: MutualId+		       , theDef	     :: Defn+		       }+    deriving (Typeable, Data)++type HaskellCode = String+type HaskellType = String++data HaskellRepresentation+      = HsDefn HaskellType HaskellCode+      | HsType HaskellType+  deriving (Typeable, Data, Show)++data Polarity = Covariant | Contravariant | Invariant+  deriving (Typeable, Data, Show, Eq)++-- | 'Positive' means strictly positive and 'Negative' means not strictly+-- positive.+data Occurrence = Positive | Negative | Unused+  deriving (Typeable, Data, Show, Eq, Ord)++data Defn = Axiom+            { axHsDef   :: Maybe HaskellRepresentation+            }+	  | Function+            { funClauses        :: [Clause]+            , funInv            :: FunctionInverse+            , funPolarity       :: [Polarity]+            , funArgOccurrences :: [Occurrence]+            , funAbstr          :: IsAbstract+            , funDelayed        :: Delayed+              -- ^ Are the clauses of this definition delayed?+            }+	  | Datatype+            { dataPars           :: Nat           -- nof parameters+	    , dataIxs            :: Nat           -- nof indices+            , dataInduction      :: Induction  -- data or codata?+            , dataClause         :: (Maybe Clause) -- this might be in an instantiated module+            , dataCons           :: [QName]        -- constructor names+            , dataSort           :: Sort+            , dataPolarity       :: [Polarity]+            , dataArgOccurrences :: [Occurrence]+            , dataHsType         :: Maybe HaskellType+            , dataAbstr          :: IsAbstract+            }+	  | Record+            { recPars           :: Nat+            , recClause         :: Maybe Clause+            , recFields         :: [A.QName]+            , recTel            :: Telescope+            , recSort           :: Sort+            , recPolarity       :: [Polarity]+            , recArgOccurrences :: [Occurrence]+            , recAbstr          :: IsAbstract+            }+	  | Constructor+            { conPars   :: Nat         -- nof parameters+	    , conSrcCon :: QName       -- original constructor (this might be in a module instance)+	    , conData   :: QName       -- name of datatype+            , conHsCode :: Maybe (HaskellType, HaskellCode) -- used by the compiler+	    , conAbstr  :: IsAbstract+            , conInd    :: Induction   -- ^ Inductive or coinductive?+            }+	  | Primitive -- PrimFun+            { primAbstr :: IsAbstract+            , primName  :: String+            , primClauses :: [Clause]+            }+    deriving (Typeable, Data)++newtype Fields = Fields [(C.Name, Type)]+  deriving (Typeable, Data)++data Reduced no yes = NoReduction no | YesReduction yes+    deriving (Typeable)++data PrimFun = PrimFun+	{ primFunName		:: QName+	, primFunArity		:: Arity+	, primFunImplementation :: MonadTCM tcm => [Arg Term] -> tcm (Reduced [Arg Term] Term)+	}+    deriving (Typeable)++defClauses :: Definition -> [Clause]+defClauses Defn{theDef = Function{funClauses = cs}}	= cs+defClauses Defn{theDef = Primitive{primClauses = cs}}	= cs+defClauses Defn{theDef = Datatype{dataClause = Just c}} = [c]+defClauses Defn{theDef = Record{recClause = Just c}}    = [c]+defClauses _					        = []++-- | Used to specify whether something should be delayed.+data Delayed = Delayed | NotDelayed+  deriving (Typeable, Data, Show, Eq)++-- | Are the clauses of this definition delayed?+defDelayed :: Definition -> Delayed+defDelayed Defn{theDef = Function{funDelayed = d}} = d+defDelayed _                                       = NotDelayed++defAbstract :: Definition -> IsAbstract+defAbstract d = case theDef d of+    Axiom{}                   -> AbstractDef+    Function{funAbstr = a}    -> a+    Datatype{dataAbstr = a}   -> a+    Record{recAbstr = a}      -> a+    Constructor{conAbstr = a} -> a+    Primitive{primAbstr = a}  -> a+++---------------------------------------------------------------------------+-- ** Injectivity+---------------------------------------------------------------------------++data FunctionInverse = NotInjective+                     | Inverse (Map TermHead Clause)+  deriving (Typeable, Data)++data TermHead = SortHead+              | PiHead+              | ConHead QName+  deriving (Typeable, Data, Eq, Ord, Show)++---------------------------------------------------------------------------+-- ** Mutual blocks+---------------------------------------------------------------------------++newtype MutualId = MutId Int+  deriving (Typeable, Data, Eq, Ord, Show, Num)++---------------------------------------------------------------------------+-- ** Statistics+---------------------------------------------------------------------------++type Statistics = Map String Int++---------------------------------------------------------------------------+-- ** Trace+---------------------------------------------------------------------------++type CallTrace = Trace (Closure Call)++noTrace :: CallTrace+noTrace = TopLevel []++data Call = CheckClause Type A.Clause (Maybe Clause)+	  | forall a. CheckPattern A.Pattern Telescope Type (Maybe a)+	  | CheckLetBinding A.LetBinding (Maybe ())+	  | InferExpr A.Expr (Maybe (Term, Type))+	  | CheckExpr A.Expr Type (Maybe Term)+	  | CheckDotPattern A.Expr Term (Maybe ())+	  | CheckPatternShadowing A.Clause (Maybe ())+	  | IsTypeCall A.Expr Sort (Maybe Type)+	  | IsType_ A.Expr (Maybe Type)+	  | InferVar Name (Maybe (Term, Type))+	  | InferDef Range QName (Maybe (Term, Type))+	  | CheckArguments Range [NamedArg A.Expr] Type Type (Maybe (Args, Type, Constraints))+	  | CheckDataDef Range Name [A.LamBinding] [A.Constructor] (Maybe ())+	  | CheckRecDef Range Name [A.LamBinding] [A.Constructor] (Maybe ())+	  | CheckConstructor QName Telescope Sort A.Constructor (Maybe ())+	  | CheckFunDef Range Name [A.Clause] (Maybe ())+	  | CheckPragma Range A.Pragma (Maybe ())+	  | CheckPrimitive Range Name A.Expr (Maybe ())+          | CheckSectionApplication Range ModuleName A.Telescope ModuleName [NamedArg A.Expr] (Maybe ())+	  | ScopeCheckExpr C.Expr (Maybe A.Expr)+	  | ScopeCheckDeclaration D.NiceDeclaration (Maybe [A.Declaration])+	  | ScopeCheckLHS C.Name C.Pattern (Maybe A.LHS)+	  | ScopeCheckDefinition D.NiceDefinition (Maybe A.Definition)+	  | forall a. TermFunDef Range Name [A.Clause] (Maybe a)+	  | forall a. SetRange Range (Maybe a)	-- ^ used by 'setCurrentRange'+            -- actually, 'a' is Agda.Termination.TermCheck.CallGraph+            -- but I was to lazy to import the stuff here --Andreas,2007-5-29++    deriving (Typeable)++-- Dummy instance+instance Data Call where+  dataTypeOf _  = mkDataType "Call" []+  toConstr   x  = mkConstr (dataTypeOf x) "Dummy" [] Prefix+  gunfold k z _ = __IMPOSSIBLE__++instance HasRange a => HasRange (Trace a) where+    getRange (TopLevel _)      = noRange+    getRange (Current c par _ _)+      | r == noRange = getRange par+      | otherwise    = r+      where r = getRange c++instance HasRange a => HasRange (ParentCall a) where+  getRange NoParent = noRange+  getRange (Parent c par _)+    | r == noRange = getRange par+    | otherwise	   = r+    where r = getRange c++instance HasRange Call where+    getRange (CheckClause _ c _)                   = getRange c+    getRange (CheckPattern p _ _ _)                = getRange p+    getRange (InferExpr e _)                       = getRange e+    getRange (CheckExpr e _ _)                     = getRange e+    getRange (CheckLetBinding b _)                 = getRange b+    getRange (IsTypeCall e s _)                    = getRange e+    getRange (IsType_ e _)                         = getRange e+    getRange (InferVar x _)                        = getRange x+    getRange (InferDef _ f _)                      = getRange f+    getRange (CheckArguments r _ _ _ _)            = r+    getRange (CheckDataDef i _ _ _ _)              = getRange i+    getRange (CheckRecDef i _ _ _ _)               = getRange i+    getRange (CheckConstructor _ _ _ c _)          = getRange c+    getRange (CheckFunDef i _ _ _)                 = getRange i+    getRange (CheckPragma r _ _)                   = r+    getRange (CheckPrimitive i _ _ _)              = getRange i+    getRange (ScopeCheckExpr e _)                  = getRange e+    getRange (ScopeCheckDeclaration d _)           = getRange d+    getRange (ScopeCheckLHS _ p _)                 = getRange p+    getRange (ScopeCheckDefinition d _)            = getRange d+    getRange (CheckDotPattern e _ _)               = getRange e+    getRange (CheckPatternShadowing c _)           = getRange c+    getRange (TermFunDef i _ _ _)                  = getRange i+    getRange (SetRange r _)                        = r+    getRange (CheckSectionApplication r _ _ _ _ _) = r++---------------------------------------------------------------------------+-- ** Builtin things+---------------------------------------------------------------------------++type BuiltinThings pf = Map String (Builtin pf)++data Builtin pf+	= Builtin Term+	| Prim pf+    deriving (Typeable, Data)++instance Functor Builtin where+    fmap f (Builtin t) = Builtin t+    fmap f (Prim x)    = Prim $ f x++instance Foldable Builtin where+    foldr f z (Builtin t) = z+    foldr f z (Prim x)    = f x z++instance Traversable Builtin where+    traverse f (Builtin t) = pure $ Builtin t+    traverse f (Prim x)    = Prim <$> f x++---------------------------------------------------------------------------+-- * Type checking environment+---------------------------------------------------------------------------++data TCEnv =+    TCEnv { envContext             :: Context+	  , envLetBindings         :: LetBindings+	  , envCurrentModule       :: ModuleName+          , envAnonymousModules    :: [(ModuleName, Nat)] -- ^ anonymous modules and their number of free variables+	  , envImportPath          :: [ModuleName]   -- ^ to detect import cycles+	  , envMutualBlock         :: Maybe MutualId -- ^ the current (if any) mutual block+	  , envAbstractMode        :: AbstractMode+		-- ^ When checking the typesignature of a public definition+		--   or the body of a non-abstract definition this is true.+		--   To prevent information about abstract things leaking+		--   outside the module.+          , envReplace             :: Bool+                -- ^ Coinductive constructor applications @c args@ get+                -- replaced by a function application @f tel@, where+                -- tel corresponds to the current telescope and @f@ is+                -- defined as @f tel = c args@. The initial occurrence+                -- of @c@ in the body of @f@ should not be replaced by+                -- yet another function application, though. To avoid+                -- that this happens the @envReplace@ flag is set to+                -- 'False' when @f@ is checked.+          , envDisplayFormsEnabled :: Bool+                -- ^ Sometimes we want to disable display forms.+          , envReifyInteractionPoints :: Bool+                -- ^ should we try to recover interaction points when reifying?+                --   disabled when generating types for with functions+	  }+    deriving (Typeable, Data)++initEnv :: TCEnv+initEnv = TCEnv { envContext	         = []+		, envLetBindings         = Map.empty+		, envCurrentModule       = noModuleName+                , envAnonymousModules    = []+		, envImportPath          = []+		, envMutualBlock         = Nothing+		, envAbstractMode        = AbstractMode+                , envReplace             = True+                , envDisplayFormsEnabled = True+                , envReifyInteractionPoints = True+		}++---------------------------------------------------------------------------+-- ** Context+---------------------------------------------------------------------------++type Context	  = [ContextEntry]+data ContextEntry = Ctx { ctxId	   :: CtxId+			, ctxEntry :: Arg (Name, Type)+			}+  deriving (Typeable, Data)++newtype CtxId	  = CtxId Nat+  deriving (Typeable, Data, Eq, Ord, Show, Enum, Real, Integral, Num)++---------------------------------------------------------------------------+-- ** Let bindings+---------------------------------------------------------------------------++type LetBindings = Map Name (Open (Term, Type))++---------------------------------------------------------------------------+-- ** Abstract mode+---------------------------------------------------------------------------++data AbstractMode = AbstractMode       -- ^ abstract things in the current module can be accessed+		  | ConcreteMode       -- ^ no abstract things can be accessed+		  | IgnoreAbstractMode -- ^ all abstract things can be accessed+  deriving (Typeable, Data)++---------------------------------------------------------------------------+-- * Type checking errors+---------------------------------------------------------------------------++-- Occurence of a name in a datatype definition+data Occ = OccCon { occDatatype	:: QName+	          , occConstructor :: QName+	          , occPosition	:: OccPos+	          }+         | OccClause { occFunction :: QName+                     , occClause   :: Int+                     , occPosition :: OccPos+                     }++data OccPos = NonPositively | ArgumentTo Nat QName++data TypeError+	= InternalError String+	| NotImplemented String+	| NotSupported String+        | CompilationError String+	| TerminationCheckFailed [([QName], [R.Range])]+          -- ^ Parameterised on functions which failed to termination+          --   check (grouped if they are mutual), along with ranges+          --   for problematic call sites.+	| PropMustBeSingleton+	| DataMustEndInSort Term+	| ShouldEndInApplicationOfTheDatatype Type+	    -- ^ The target of a constructor isn't an application of its+	    -- datatype. The 'Type' records what it does target.+	| ShouldBeAppliedToTheDatatypeParameters Term Term+	    -- ^ The target of a constructor isn't its datatype applied to+	    --	 something that isn't the parameters. First term is the correct+	    --	 target and the second term is the actual target.+	| ShouldBeApplicationOf Type QName+	    -- ^ Expected a type to be an application of a particular datatype.+	| ConstructorPatternInWrongDatatype QName QName -- ^ constructor, datatype+        | DoesNotConstructAnElementOf QName Term -- ^ constructor, type+	| DifferentArities+	    -- ^ Varying number of arguments for a function.+	| WrongHidingInLHS Type+	    -- ^ The left hand side of a function definition has a hidden argument+	    --	 where a non-hidden was expected.+	| WrongHidingInLambda Type+	    -- ^ Expected a non-hidden function and found a hidden lambda.+	| WrongHidingInApplication Type+	    -- ^ A function is applied to a hidden argument where a non-hidden was expected.+	| DependentPatternMatchingOnCodata+	| NotInductive Term+          -- ^ The term does not correspond to an inductive data type.+	| UninstantiatedDotPattern A.Expr+	| IlltypedPattern A.Pattern Type+	| TooManyArgumentsInLHS Nat Type+	| WrongNumberOfConstructorArguments QName Nat Nat+	| ShouldBeEmpty Type [Pattern]+	| ShouldBeASort Type+	    -- ^ The given type should have been a sort.+	| ShouldBePi Type+	    -- ^ The given type should have been a pi.+	| ShouldBeRecordType Type+	| NotAProperTerm+	| UnequalTerms Comparison Term Term Type+	| UnequalTypes Comparison Type Type+	| UnequalHiding Type Type+	    -- ^ The two function types have different hiding.+	| UnequalSorts Sort Sort+	| NotLeqSort Sort Sort+	| MetaCannotDependOn MetaId [Nat] Nat+	    -- ^ The arguments are the meta variable, the parameters it can+	    --	 depend on and the paratemeter that it wants to depend on.+	| MetaOccursInItself MetaId+	| GenericError String+        | BuiltinMustBeConstructor String A.Expr+	| NoSuchBuiltinName String+	| DuplicateBuiltinBinding String Term Term+	| NoBindingForBuiltin String+	| NoSuchPrimitiveFunction String+        | ShadowedModule [A.ModuleName]+	| BuiltinInParameterisedModule String+	| NoRHSRequiresAbsurdPattern [NamedArg A.Pattern]+	| AbsurdPatternRequiresNoRHS [NamedArg A.Pattern]+	| TooFewFields QName [C.Name]+	| TooManyFields QName [C.Name]+	| DuplicateFields [C.Name]+	| DuplicateConstructors [C.Name]+	| UnexpectedWithPatterns [A.Pattern]+	| WithClausePatternMismatch A.Pattern Pattern+        | FieldOutsideRecord+        | ModuleArityMismatch A.ModuleName Telescope [NamedArg A.Expr]+    -- Coverage errors+	| IncompletePatternMatching Term Args -- can only happen if coverage checking is switched off+        | CoverageFailure QName [[Arg Pattern]]+        | UnreachableClauses QName [[Arg Pattern]]+        | CoverageCantSplitOn QName+        | CoverageCantSplitType Type+    -- Positivity errors+	| NotStrictlyPositive QName [Occ]+    -- Import errors+	| LocalVsImportedModuleClash ModuleName+	| UnsolvedMetas [Range]+	| UnsolvedConstraints Constraints+	| CyclicModuleDependency [ModuleName]+	| FileNotFound ModuleName [FilePath]+	| ClashingFileNamesFor ModuleName [FilePath]+    -- Scope errors+	| ModuleNameDoesntMatchFileName ModuleName -- ^ @NoMatch given@+	| BothWithAndRHS+	| NotInScope [C.QName]+	| NoSuchModule C.QName+	| AmbiguousName C.QName [A.QName]+	| AmbiguousModule C.QName [A.ModuleName]+	| UninstantiatedModule C.QName+	| ClashingDefinition C.QName A.QName+	| ClashingModule A.ModuleName A.ModuleName+	| ClashingImport C.Name A.QName+	| ClashingModuleImport C.Name A.ModuleName+	| PatternShadowsConstructor A.Name A.QName+	| ModuleDoesntExport C.QName [C.ImportedName]+	| InvalidPattern C.Pattern+	| RepeatedVariablesInPattern [C.Name]+    -- Concrete to Abstract errors+	| NotAModuleExpr C.Expr+	    -- ^ The expr was used in the right hand side of an implicit module+	    --	 definition, but it wasn't of the form @m Delta@.+	| NotAnExpression C.Expr+	| NotAValidLetBinding D.NiceDeclaration+	| NothingAppliedToHiddenArg C.Expr+    -- Operator errors+	| NoParseForApplication [C.Expr]+	| AmbiguousParseForApplication [C.Expr] [C.Expr]+	| NoParseForLHS C.Pattern+	| AmbiguousParseForLHS C.Pattern [C.Pattern]+    -- Usage errors.+        | HTMLDirUndefined+    deriving (Typeable)++data TCErr = TypeError TCState (Closure TypeError)+	   | Exception Range String+	   | PatternErr  TCState -- ^ for pattern violations+	   | AbortAssign TCState -- ^ used to abort assignment to meta when there are instantiations+  deriving (Typeable)++instance Error TCErr where+    noMsg  = strMsg ""+    strMsg = Exception noRange . strMsg++{-+instance Show TCErr where+    show (TypeError _ e) = show (getRange $ clTrace e) ++ ": " ++ show (clValue e)+    show (Exception r s) = show r ++ ": " ++ s+    show (PatternErr _)  = "Pattern violation (you shouldn't see this)"+    show (AbortAssign _) = "Abort assignment (you shouldn't see this)"+-}++instance HasRange TCErr where+    getRange (TypeError _ cl) = getRange $ clTrace cl+    getRange (Exception r _)  = r+    getRange (PatternErr s)   = getRange $ stTrace s+    getRange (AbortAssign s)  = getRange $ stTrace s++---------------------------------------------------------------------------+-- * Type checking monad transformer+---------------------------------------------------------------------------++newtype TCMT m a = TCM { unTCM :: UndoT TCState+			          (StateT TCState+			          (ReaderT TCEnv+			          (ErrorT TCErr m))) a+		       }+    deriving ( MonadState TCState+             , MonadReader TCEnv+             , MonadError TCErr+             , MonadUndo TCState+             )++type TCM = TCMT IO++class ( Applicative tcm, MonadIO tcm+      , MonadReader TCEnv tcm+      , MonadState TCState tcm+      ) => MonadTCM tcm where+    liftTCM :: TCM a -> tcm a++mapTCMT :: (m (Either TCErr ((a, [TCState]), TCState)) ->+            n (Either TCErr ((b, [TCState]), TCState))+           ) -> TCMT m a -> TCMT n b+mapTCMT f = TCM . mapUndoT (mapStateT (mapReaderT (mapErrorT f))) . unTCM++instance MonadIO m => MonadTCM (TCMT m) where+    liftTCM = mapTCMT liftIO++instance MonadTrans TCMT where+    lift = TCM . lift . lift . lift . lift++-- We want a special monad implementation of fail.+instance MonadIO m => Monad (TCMT m) where+    return  = TCM . return+    m >>= k = TCM $ unTCM m >>= unTCM . k+    fail    = internalError++instance MonadIO m => Functor (TCMT m) where+    fmap = liftM++instance MonadIO m => Applicative (TCMT m) where+    pure = return+    (<*>) = ap++instance MonadIO m => MonadIO (TCMT m) where+  liftIO m = TCM $ do tr <- gets stTrace+                      lift $ lift $ lift $ ErrorT $ liftIO $+                        handle (handleIOException $ getRange tr)+                        (failOnException+                         (\r -> return . throwError . Exception r)+                         (return <$> m) )+    where+      handleIOException r e = case e of+        IOException _ -> return . throwError . Exception r . show $ e+        _             -> throwIO e++patternViolation :: MonadTCM tcm => tcm a+patternViolation = liftTCM $ do+    s <- get+    throwError $ PatternErr s++internalError :: MonadTCM tcm => String -> tcm a+internalError s = typeError $ InternalError s++typeError :: MonadTCM tcm => TypeError -> tcm a+typeError err = liftTCM $ do+    cl <- buildClosure err+    s  <- get+    throwError $ TypeError s cl++handleTypeErrorException :: MonadTCM tcm => IO a -> tcm a+handleTypeErrorException m = do+    r <- liftIO $ liftM Right m `catchDyn` (return . Left)+    either typeError return r++-- | Running the type checking monad+runTCM :: Monad m => TCMT m a -> m (Either TCErr a)+runTCM m = runErrorT+	 $ flip runReaderT initEnv+	 $ flip evalStateT initState+	 $ runUndoT+	 $ unTCM m+

+ src/full/Agda/TypeChecking/Monad/Builtin.hs view

@@ -0,0 +1,122 @@++module Agda.TypeChecking.Monad.Builtin where++import Control.Monad.State+import qualified Data.Map as Map++import Agda.Syntax.Internal+import Agda.TypeChecking.Monad.Base++getBuiltinThings :: MonadTCM tcm => tcm (BuiltinThings PrimFun)+getBuiltinThings = gets stBuiltinThings++setBuiltinThings :: MonadTCM tcm => BuiltinThings PrimFun -> tcm ()+setBuiltinThings b = modify $ \s -> s { stLocalBuiltins = b }++bindBuiltinName :: MonadTCM tcm => String -> Term -> tcm ()+bindBuiltinName b x = do+	builtin <- getBuiltinThings+	case Map.lookup b builtin of+	    Just (Builtin y) -> typeError $ DuplicateBuiltinBinding b y x+	    Just (Prim _)    -> typeError $ NoSuchBuiltinName b+	    Nothing	     -> modify $ \st ->+              st { stLocalBuiltins = +                    Map.insert b (Builtin x) $ stLocalBuiltins st+                 }++bindPrimitive :: MonadTCM tcm => String -> PrimFun -> tcm ()+bindPrimitive b pf = do+  builtin <- gets stLocalBuiltins+  setBuiltinThings $ Map.insert b (Prim pf) builtin+++getBuiltin :: MonadTCM tcm => String -> tcm Term+getBuiltin x = do+    mt <- getBuiltin' x+    case mt of+        Nothing -> typeError $ NoBindingForBuiltin x+        Just t  -> return t++getBuiltin' :: MonadTCM tcm => String -> tcm (Maybe Term)+getBuiltin' x = do+    builtin <- getBuiltinThings+    case Map.lookup x builtin of+	Just (Builtin t) -> return $ Just t+	_		 -> return Nothing++getPrimitive :: MonadTCM tcm => String -> tcm PrimFun+getPrimitive x = do+    builtin <- getBuiltinThings+    case Map.lookup x builtin of+	Just (Prim pf) -> return pf+	_	       -> typeError $ NoSuchPrimitiveFunction x++---------------------------------------------------------------------------+-- * The names of built-in things+---------------------------------------------------------------------------++primInteger, primFloat, primChar, primString, primBool, primTrue, primFalse,+    primList, primNil, primCons, primIO, primNat, primSuc, primZero,+    primNatPlus, primNatMinus, primNatTimes, primNatDivSuc, primNatModSuc,+    primNatEquality, primNatLess, primSize, primSizeSuc, primSizeInf+    :: MonadTCM tcm => tcm Term+primInteger     = getBuiltin builtinInteger+primFloat       = getBuiltin builtinFloat+primChar        = getBuiltin builtinChar+primString      = getBuiltin builtinString+primBool        = getBuiltin builtinBool+primTrue        = getBuiltin builtinTrue+primFalse       = getBuiltin builtinFalse+primList        = getBuiltin builtinList+primNil         = getBuiltin builtinNil+primCons        = getBuiltin builtinCons+primIO          = getBuiltin builtinIO+primNat         = getBuiltin builtinNat+primSuc         = getBuiltin builtinSuc+primZero        = getBuiltin builtinZero+primNatPlus     = getBuiltin builtinNatPlus+primNatMinus    = getBuiltin builtinNatMinus+primNatTimes    = getBuiltin builtinNatTimes+primNatDivSuc   = getBuiltin builtinNatDivSuc+primNatModSuc   = getBuiltin builtinNatModSuc+primNatEquality = getBuiltin builtinNatEquals+primNatLess     = getBuiltin builtinNatLess+primSize        = getBuiltin builtinSize+primSizeSuc     = getBuiltin builtinSizeSuc+primSizeInf     = getBuiltin builtinSizeInf++builtinNat       = "NATURAL"+builtinSuc       = "SUC"+builtinZero      = "ZERO"+builtinNatPlus   = "NATPLUS"+builtinNatMinus  = "NATMINUS"+builtinNatTimes  = "NATTIMES"+builtinNatDivSuc = "NATDIVSUC"+builtinNatModSuc = "NATMODSUC"+builtinNatEquals = "NATEQUALS"+builtinNatLess   = "NATLESS"+builtinInteger   = "INTEGER"+builtinFloat     = "FLOAT"+builtinChar      = "CHAR"+builtinString    = "STRING"+builtinBool      = "BOOL"+builtinTrue      = "TRUE"+builtinFalse     = "FALSE"+builtinList      = "LIST"+builtinNil       = "NIL"+builtinCons      = "CONS"+builtinIO        = "IO"+builtinSize      = "SIZE"+builtinSizeSuc   = "SIZESUC"+builtinSizeInf   = "SIZEINF"++builtinTypes :: [String]+builtinTypes =+    [ builtinInteger+    , builtinFloat+    , builtinChar+    , builtinString+    , builtinBool+    , builtinNat+    ]+

+ src/full/Agda/TypeChecking/Monad/Closure.hs view

@@ -0,0 +1,17 @@++module Agda.TypeChecking.Monad.Closure where++import Agda.TypeChecking.Monad.Base+import Agda.TypeChecking.Monad.Env+import Agda.TypeChecking.Monad.State+import Agda.TypeChecking.Monad.Signature+import Agda.TypeChecking.Monad.Trace++enterClosure :: MonadTCM tcm => Closure a -> (a -> tcm b) -> tcm b+enterClosure (Closure sig env scope trace x) k =+    withScope_ scope+    $ withEnv env+    $ withTrace trace+    $ k x+    +

+ src/full/Agda/TypeChecking/Monad/Constraints.hs view

@@ -0,0 +1,42 @@++module Agda.TypeChecking.Monad.Constraints where++import Control.Monad.State+import Data.Map as Map++import Agda.TypeChecking.Monad.Base+import Agda.TypeChecking.Monad.Signature+import Agda.TypeChecking.Monad.Env+import Agda.TypeChecking.Monad.State+import Agda.TypeChecking.Monad.Closure++-- | Get the constraints+getConstraints :: MonadTCM tcm => tcm Constraints+getConstraints = gets stConstraints++lookupConstraint :: MonadTCM tcm => Int -> tcm ConstraintClosure+lookupConstraint i =+    do	cs <- getConstraints+	unless (i < length cs) $ fail $ "no such constraint: " ++ show i+	return $ cs !! i++-- | Take constraints (clear all constraints).+takeConstraints :: MonadTCM tcm => tcm Constraints+takeConstraints =+    do	cs <- getConstraints+	modify $ \s -> s { stConstraints = [] }+	return cs++withConstraint :: MonadTCM tcm => (Constraint -> tcm a) -> ConstraintClosure -> tcm a+withConstraint = flip enterClosure++-- | Add new constraints+addConstraints :: MonadTCM tcm => Constraints -> tcm ()+addConstraints cs = modify $ \st -> st { stConstraints = cs ++ stConstraints st }++-- | Create a new constraint.+buildConstraint :: MonadTCM tcm => Constraint -> tcm Constraints+buildConstraint c = do+    cl <- buildClosure c+    return [cl]+

+ src/full/Agda/TypeChecking/Monad/Context.hs view

@@ -0,0 +1,147 @@+{-# LANGUAGE CPP #-}++module Agda.TypeChecking.Monad.Context where++import Control.Monad.Reader+import Data.List hiding (sort)+import qualified Data.Map as Map++import Agda.Syntax.Concrete.Name (isNoName)+import Agda.Syntax.Abstract.Name+import Agda.Syntax.Common+import Agda.Syntax.Internal+import Agda.Syntax.Scope.Base+import Agda.TypeChecking.Monad.Base+import Agda.TypeChecking.Substitute+import Agda.TypeChecking.Monad.Open++import Agda.Utils.Monad+import Agda.Utils.Fresh++#include "../../undefined.h"+import Agda.Utils.Impossible++mkContextEntry :: MonadTCM tcm => Arg (Name, Type) -> tcm ContextEntry+mkContextEntry x = do+  i <- fresh+  return $ Ctx i x++-- | add a variable to the context+--+addCtx :: MonadTCM tcm => Name -> Arg Type -> tcm a -> tcm a+addCtx x a ret = do+  ctx <- map (nameConcrete . fst . unArg) <$> getContext+  let x' = head $ filter (notTaken ctx) $ iterate nextName x+  ce <- mkContextEntry $ fmap ((,) x') a+  flip local ret $ \e -> e { envContext = ce : envContext e }+      -- let-bindings keep track of own their context+  where+    notTaken xs x = isNoName (nameConcrete x) || nameConcrete x `notElem` xs++-- | Change the context+inContext :: MonadTCM tcm => [Arg (Name, Type)] -> tcm a -> tcm a+inContext xs ret = do+  ctx <- mapM mkContextEntry xs+  flip local ret $ \e -> e { envContext = ctx }++-- | Go under an abstraction.+underAbstraction :: MonadTCM tcm => Arg Type -> Abs a -> (a -> tcm b) -> tcm b+underAbstraction t a k = do+    xs <- map (nameConcrete . fst . unArg) <$> getContext+    x <- freshName_ $ realName $ absName a+    let y = head $ filter (notTaken xs) $ iterate nextName x+    addCtx y t $ k $ absBody a+  where+    notTaken xs x = notElem (nameConcrete x) xs+    realName "_" = "y"+    realName s   = s++-- | Go under an abstract without worrying about the type to add to the context.+underAbstraction_ :: MonadTCM tcm => Abs a -> (a -> tcm b) -> tcm b+underAbstraction_ = underAbstraction (Arg NotHidden $ sort Prop)++-- | Add a telescope to the context.+addCtxTel :: MonadTCM tcm => Telescope -> tcm a -> tcm a+addCtxTel EmptyTel	    ret = ret+addCtxTel (ExtendTel t tel) ret = underAbstraction t tel $ \tel -> addCtxTel tel ret++-- | Get the current context.+getContext :: MonadTCM tcm => tcm [Arg (Name, Type)]+getContext = asks $ map ctxEntry . envContext++-- | Generate [Var n - 1, .., Var 0] for all declarations in the context.+getContextArgs :: MonadTCM tcm => tcm Args+getContextArgs = do+  ctx <- getContext+  return $ reverse $ [ Arg h $ Var i [] | (Arg h _, i) <- zip ctx [0..] ]++getContextTerms :: MonadTCM tcm => tcm [Term]+getContextTerms = map unArg <$> getContextArgs++-- | Get the current context as a 'Telescope' with the specified 'Hiding'.+getContextTelescope :: MonadTCM tcm => tcm Telescope+getContextTelescope = foldr extTel EmptyTel . reverse <$> getContext+  where+    extTel (Arg h (x, t)) = ExtendTel (Arg h t) . Abs (show x)++-- | add a bunch of variables with the same type to the context+addCtxs :: MonadTCM tcm => [Name] -> Arg Type -> tcm a -> tcm a+addCtxs []     _ k = k+addCtxs (x:xs) t k = addCtx x t $ addCtxs xs (raise 1 t) k++-- | Check if we are in a compatible context, i.e. an extension of the given context.+getContextId :: MonadTCM tcm => tcm [CtxId]+getContextId = asks $ map ctxId . envContext++-- | Add a let bound variable+addLetBinding :: MonadTCM tcm => Name -> Term -> Type -> tcm a -> tcm a+addLetBinding x v t ret = do+    vt <- makeOpen (v, t)+    flip local ret $ \e -> e { envLetBindings = Map.insert x vt $ envLetBindings e }++-- | get type of bound variable (i.e. deBruijn index)+--+typeOfBV' :: MonadTCM tcm => Nat -> tcm (Arg Type)+typeOfBV' n =+    do	ctx <- getContext+	Arg h (_,t) <- ctx !!! n+	return $ Arg h $ raise (n + 1) t++typeOfBV :: MonadTCM tcm => Nat -> tcm Type+typeOfBV i = unArg <$> typeOfBV' i++nameOfBV :: MonadTCM tcm => Nat -> tcm Name+nameOfBV n =+    do	ctx <- getContext+	Arg _ (x,_) <- ctx !!! n+	return x++-- | TODO: move(?)+xs !!! n = xs !!!! n+    where+	[]     !!!! _ = do+            ctx <- getContext+            fail $ "deBruijn index out of scope: " ++ show n ++ " in context " ++ show (map (fst . unArg) ctx)+	(x:_)  !!!! 0 = return x+	(_:xs) !!!! n = xs !!!! (n - 1)++-- | Get the term corresponding to a named variable. If it is a lambda bound+--   variable the deBruijn index is returned and if it is a let bound variable+--   its definition is returned.+getVarInfo :: MonadTCM tcm => Name -> tcm (Term, Type)+getVarInfo x =+    do	ctx <- getContext+	def <- asks envLetBindings+	case findIndex ((==x) . fst . unArg) ctx of+	    Just n  ->+		do  n <- return $ fromIntegral n+                    t <- typeOfBV n+		    return (Var n [], t)+	    _	    ->+		case Map.lookup x def of+		    Just vt -> getOpen vt+		    _	    -> fail $ "unbound variable " ++ show x++escapeContext :: MonadTCM tcm => Int -> tcm a -> tcm a+escapeContext n = local $ \e -> e { envContext = drop n $ envContext e }+

+ src/full/Agda/TypeChecking/Monad/Context.hs-boot view

@@ -0,0 +1,10 @@++module Agda.TypeChecking.Monad.Context where++import Agda.Syntax.Common+import Agda.Syntax.Internal+import Agda.TypeChecking.Monad.Base++getContext   :: MonadTCM tcm => tcm [Arg (Name, Type)]+getContextId :: MonadTCM tcm => tcm [CtxId]+

+ src/full/Agda/TypeChecking/Monad/Debug.hs view

@@ -0,0 +1,8 @@++module Agda.TypeChecking.Monad.Debug where++import qualified System.IO.UTF8 as UTF8+import Control.Monad.Trans ( MonadIO(liftIO) )++debug :: MonadIO m => String -> m ()+debug s = liftIO $ UTF8.putStrLn s

+ src/full/Agda/TypeChecking/Monad/Env.hs view

@@ -0,0 +1,40 @@++module Agda.TypeChecking.Monad.Env where++import Control.Monad.Reader+import Data.List++import Agda.Syntax.Common+import Agda.Syntax.Abstract.Name++import Agda.TypeChecking.Monad.Base++-- | Get the name of the current module, if any.+currentModule :: MonadTCM tcm => tcm ModuleName+currentModule = asks envCurrentModule++-- | Set the name of the current module.+withCurrentModule :: MonadTCM tcm => ModuleName -> tcm a -> tcm a+withCurrentModule m =+    local $ \e -> e { envCurrentModule = m }++-- | Get the number of variables bound by anonymous modules.+getAnonymousVariables :: MonadTCM tcm => ModuleName -> tcm Nat+getAnonymousVariables m = do+  ms <- asks envAnonymousModules+  return $ sum [ n | (m', n) <- ms, mnameToList m' `isPrefixOf` mnameToList m ]++-- | Add variables bound by an anonymous module.+withAnonymousModule :: MonadTCM tcm => ModuleName -> Nat -> tcm a -> tcm a+withAnonymousModule m n =+  local $ \e -> e { envAnonymousModules   = (m, n) : envAnonymousModules e+                  }++-- | Set the current environment to the given +withEnv :: MonadTCM tcm => TCEnv -> tcm a -> tcm a+withEnv env m = local (const env) m++-- | Get the current environmnet+getEnv :: MonadTCM tcm => tcm TCEnv+getEnv = ask+

+ src/full/Agda/TypeChecking/Monad/Exception.hs view

@@ -0,0 +1,64 @@+{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances, 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).++module Agda.TypeChecking.Monad.Exception where++import Control.Applicative+import Control.Monad.Error+import Control.Monad.State+import Control.Monad.Reader+import Agda.TypeChecking.Monad.Base++newtype ExceptionT err m a = ExceptionT { runExceptionT :: m (Either err a) }++class Error err => MonadException err m | m -> err where+  throwException :: err -> m a+  catchException :: m a -> (err -> m a) -> m a++instance (Monad m, Error err) => Monad (ExceptionT err m) where+  return = ExceptionT . return . Right+  ExceptionT m >>= k = ExceptionT $ do+    r <- m+    case r of+      Left err -> return $ Left err+      Right x  -> runExceptionT $ k x+  fail = ExceptionT . return . Left . strMsg++instance (Monad m, Error err) => MonadException err (ExceptionT err m) where+  throwException = ExceptionT . return . Left+  catchException m h = ExceptionT $ do+    r <- runExceptionT m+    case r of+      Left err  -> runExceptionT $ h err+      Right x   -> return $ Right x++instance MonadTrans (ExceptionT err) where+  lift = ExceptionT . liftM Right++instance Functor f => Functor (ExceptionT err f) where+  fmap f = ExceptionT . fmap (either Left (Right . f)) . runExceptionT++instance (Error err, Applicative m, Monad m) => Applicative (ExceptionT err m) where+  pure  = return+  (<*>) = ap++instance (Error err, MonadState s m) => MonadState s (ExceptionT err m) where+  get   = ExceptionT $ Right `liftM` get+  put x = ExceptionT $ Right `liftM` put x++instance (Error err, MonadReader r m) => MonadReader r (ExceptionT err m) where+  ask     = ExceptionT $ Right `liftM` ask+  local f = ExceptionT . local f . runExceptionT++instance (Error err, MonadError err' m) => MonadError err' (ExceptionT err m) where+  throwError err = ExceptionT $ Right `liftM` throwError err+  catchError m h = ExceptionT $ runExceptionT m `catchError` (runExceptionT . h)++instance (Error err, MonadIO m) => MonadIO (ExceptionT err m) where+  liftIO m = ExceptionT $ Right `liftM` liftIO m++instance (Error err, MonadTCM tcm) => MonadTCM (ExceptionT err tcm) where+  liftTCM m = ExceptionT $ Right `liftM` liftTCM m+

+ src/full/Agda/TypeChecking/Monad/Imports.hs view

@@ -0,0 +1,94 @@++module Agda.TypeChecking.Monad.Imports where++import Control.Monad.State+import Control.Monad.Reader++import Data.Maybe+import Data.Map (Map)+import Data.Set (Set)+import qualified Data.Map as Map+import qualified Data.List as List+import qualified Data.Set as Set++import System.Time++import Agda.Syntax.Abstract.Name+import Agda.TypeChecking.Monad.Base+import Agda.Utils.Monad++addImport :: ModuleName -> TCM ()+addImport m =+    modify $ \s -> s { stImportedModules = Set.insert m $ stImportedModules s }++addImportCycleCheck :: ModuleName -> TCM a -> TCM a+addImportCycleCheck m =+    local $ \e -> e { envImportPath = m : envImportPath e }++getImports :: TCM (Set ModuleName)+getImports = gets stImportedModules++isImported :: ModuleName -> TCM Bool+isImported m = Set.member m <$> getImports++getImportPath :: TCM [ModuleName]+getImportPath = asks envImportPath++visitModule :: ModuleName -> Interface -> ClockTime -> TCM ()+visitModule x i t = modify $ \s -> s { stVisitedModules = Map.insert x (i,t) $ stVisitedModules s }++setVisitedModules :: VisitedModules -> TCM ()+setVisitedModules ms = modify $ \s -> s { stVisitedModules = ms }++getVisitedModules :: TCM VisitedModules+getVisitedModules = gets stVisitedModules++isVisited :: ModuleName -> TCM Bool+isVisited x = gets $ Map.member x . stVisitedModules++getVisitedModule :: ModuleName -> TCM (Maybe (Interface, ClockTime))+getVisitedModule x = gets $ Map.lookup x . stVisitedModules++-- | This map includes the current module, if it has been type+-- checked, along with the visited modules.++getAllModules :: TCM (Map ModuleName Interface)+getAllModules = do+  visited <- Map.map fst <$> getVisitedModules+  current <- stCurrentModule <$> get+  case current of+    Nothing      -> return visited+    Just (m, i)  -> return (Map.insert m i visited)++getDecodedModules :: TCM DecodedModules+getDecodedModules = gets stDecodedModules++setDecodedModules :: DecodedModules -> TCM ()+setDecodedModules ms = modify $ \s -> s { stDecodedModules = ms }++preserveDecodedModules :: TCM a -> TCM a+preserveDecodedModules tcm = do ms <- getDecodedModules+                                a  <- tcm+                                setDecodedModules ms+                                return a++getDecodedModule :: ModuleName -> TCM (Maybe (Interface, ClockTime))+getDecodedModule x = gets $ Map.lookup x . stDecodedModules++storeDecodedModule :: ModuleName -> Interface -> ClockTime -> TCM ()+storeDecodedModule x i t = modify $ \s -> s { stDecodedModules = Map.insert x (i,t) $ stDecodedModules s }++dropDecodedModule :: ModuleName -> TCM ()+dropDecodedModule x = modify $ \s -> s { stDecodedModules = Map.delete x $ stDecodedModules s }++withImportPath :: [ModuleName] -> TCM a -> TCM a+withImportPath path = local $ \e -> e { envImportPath = path }++-- | Assumes that the first module in the import path is the module we are+--   worried about.+checkForImportCycle :: TCM ()+checkForImportCycle = do+    m:ms <- getImportPath+    when (m `elem` ms) $ typeError $ CyclicModuleDependency+				   $ dropWhile (/= m) $ reverse (m:ms)+

+ src/full/Agda/TypeChecking/Monad/MetaVars.hs view

@@ -0,0 +1,163 @@+{-# LANGUAGE CPP #-}+module Agda.TypeChecking.Monad.MetaVars where++import Control.Applicative+import Control.Monad.State+import Control.Monad.Reader+import qualified Data.Map as Map+import qualified Data.Set as Set++import Agda.Syntax.Internal+import Agda.Syntax.Position+import Agda.Syntax.Scope.Base++import Agda.TypeChecking.Monad.Base+import Agda.TypeChecking.Monad.Env+import Agda.TypeChecking.Monad.Signature+import Agda.TypeChecking.Monad.State+import Agda.TypeChecking.Monad.Trace+import Agda.TypeChecking.Monad.Closure+import Agda.TypeChecking.Monad.Open+import Agda.TypeChecking.Substitute++import Agda.Utils.Monad+import Agda.Utils.Fresh++#include "../../undefined.h"+import Agda.Utils.Impossible++-- | Get the meta store.+getMetaStore :: MonadTCM tcm => tcm MetaStore+getMetaStore = gets stMetaStore++-- | Lookup a meta variable+lookupMeta :: MonadTCM tcm => MetaId -> tcm MetaVariable+lookupMeta m =+    do	mmv <- Map.lookup m <$> getMetaStore+	case mmv of+	    Just mv -> return mv+	    _	    -> fail $ "no such meta variable " ++ show m++updateMetaVar :: MonadTCM tcm => MetaId -> (MetaVariable -> MetaVariable) -> tcm ()+updateMetaVar m f =+  modify $ \st -> st { stMetaStore = Map.adjust f m $ stMetaStore st }++getMetaPriority :: MonadTCM tcm => MetaId -> tcm MetaPriority+getMetaPriority i = mvPriority <$> lookupMeta i++createMetaInfo :: MonadTCM tcm => tcm MetaInfo+createMetaInfo = +    do  r <- getCurrentRange+	buildClosure r++updateMetaVarRange :: MonadTCM tcm => MetaId -> Range -> tcm ()+updateMetaVarRange mi r = updateMetaVar mi (setRange r)++addInteractionPoint :: MonadTCM tcm => InteractionId -> MetaId -> tcm ()+addInteractionPoint ii mi =+    modify $ \s -> s { stInteractionPoints =+			Map.insert ii mi $ stInteractionPoints s+		     }+++removeInteractionPoint :: MonadTCM tcm => InteractionId -> tcm ()+removeInteractionPoint ii =+    modify $ \s -> s { stInteractionPoints =+			Map.delete ii $ stInteractionPoints s+		     }+++getInteractionPoints :: MonadTCM tcm => tcm [InteractionId]+getInteractionPoints = Map.keys <$> gets stInteractionPoints++getInteractionMetas :: MonadTCM tcm => tcm [MetaId]+getInteractionMetas = Map.elems <$> gets stInteractionPoints++-- | Does the meta variable correspond to an interaction point?++isInteractionMeta :: MonadTCM tcm => MetaId -> tcm Bool+isInteractionMeta m = fmap (m `elem`) getInteractionMetas++lookupInteractionId :: MonadTCM tcm => InteractionId -> tcm MetaId+lookupInteractionId ii = +    do  mmi <- Map.lookup ii <$> gets stInteractionPoints+	case mmi of+	    Just mi -> return mi+	    _	    -> fail $ "no such interaction point: " ++ show ii++judgementInteractionId :: MonadTCM tcm => InteractionId -> tcm (Judgement Type MetaId)+judgementInteractionId ii = +    do  mi <- lookupInteractionId ii+        mvJudgement <$> lookupMeta mi++-- | Generate new meta variable.+newMeta :: MonadTCM tcm => MetaInfo -> MetaPriority -> Judgement Type a -> tcm MetaId+newMeta = newMeta' Open++newMeta' :: MonadTCM tcm => MetaInstantiation -> MetaInfo -> MetaPriority ->+            Judgement Type a -> tcm MetaId+newMeta' inst mi p j = do+  x <- fresh+  let mv = MetaVar mi p (fmap (const x) j) inst Set.empty+  modify $ \st -> st { stMetaStore = Map.insert x mv $ stMetaStore st }+  return x++getInteractionRange :: MonadTCM tcm => InteractionId -> tcm Range+getInteractionRange ii = do+    mi <- lookupInteractionId ii+    getMetaRange mi++getMetaRange :: MonadTCM tcm => MetaId -> tcm Range+getMetaRange mi = getRange <$> lookupMeta mi+++getInteractionScope :: MonadTCM tcm => InteractionId -> tcm ScopeInfo+getInteractionScope ii = +    do mi <- lookupInteractionId ii+       mv <- lookupMeta mi+       return $ getMetaScope mv++withMetaInfo :: MonadTCM tcm => MetaInfo -> tcm a -> tcm a+withMetaInfo mI m = enterClosure mI $ \_ -> m++getInstantiatedMetas :: MonadTCM tcm => tcm [MetaId]+getInstantiatedMetas = do+    store <- getMetaStore+    return [ i | (i, MetaVar _ _ _ mi _) <- Map.assocs store, isInst mi ]+    where+	isInst Open                             = False+	isInst (BlockedConst _)                 = False+        isInst (PostponedTypeCheckingProblem _) = False+	isInst (InstV _)                        = True+	isInst (InstS _)                        = True++getOpenMetas :: MonadTCM tcm => tcm [MetaId]+getOpenMetas = do+    store <- getMetaStore+    return [ i | (i, MetaVar _ _ _ mi _) <- Map.assocs store, isOpen mi ]+    where+	isOpen Open                             = True+	isOpen (BlockedConst _)                 = True+        isOpen (PostponedTypeCheckingProblem _) = True+	isOpen (InstV _)                        = False+	isOpen (InstS _)                        = False++-- | @listenToMeta l m@: register @l@ as a listener to @m@. This is done+--   when the type of l is blocked by @m@.+listenToMeta :: MonadTCM tcm => MetaId -> MetaId -> tcm ()+listenToMeta l m =+  updateMetaVar m $ \mv -> mv { mvListeners = Set.insert l $ mvListeners mv }++-- | Unregister a listener.+unlistenToMeta :: MonadTCM tcm => MetaId -> MetaId -> tcm ()+unlistenToMeta l m =+  updateMetaVar m $ \mv -> mv { mvListeners = Set.delete l $ mvListeners mv }++-- | Get the listeners to a meta.+getMetaListeners :: MonadTCM tcm => MetaId -> tcm [MetaId]+getMetaListeners m = Set.toList . mvListeners <$> lookupMeta m++clearMetaListeners :: MonadTCM tcm => MetaId -> tcm ()+clearMetaListeners m =+  updateMetaVar m $ \mv -> mv { mvListeners = Set.empty }+

+ src/full/Agda/TypeChecking/Monad/Mutual.hs view

@@ -0,0 +1,64 @@+{-# LANGUAGE CPP #-}++module Agda.TypeChecking.Monad.Mutual where++import Control.Monad.Reader+import Control.Monad.State+import Data.Map (Map)+import qualified Data.Map as Map+import Data.Set (Set)+import qualified Data.Set as Set++import Agda.Syntax.Internal+import Agda.TypeChecking.Monad.Base+import Agda.Utils.Fresh+import Agda.Utils.Impossible++#include "../../undefined.h"++noMutualBlock :: MonadTCM tcm => tcm a -> tcm a+noMutualBlock = local $ \e -> e { envMutualBlock = Nothing }++inMutualBlock :: MonadTCM tcm => tcm a -> tcm a+inMutualBlock m = do+  mi <- asks envMutualBlock+  case mi of+    Nothing -> do+      i <- fresh+      flip local m $ \e -> e { envMutualBlock = Just i }+    -- Don't create a new mutual block if we're already inside one.+    Just _  -> m++-- | Set the mutual block for a definition+setMutualBlock :: MonadTCM tcm => MutualId -> QName -> tcm ()+setMutualBlock i x = do+  modify $ \s -> s { stMutualBlocks = Map.insertWith Set.union i (Set.singleton x) $ stMutualBlocks s+		   , stSignature    = (stSignature s)+				      { sigDefinitions = setMutId x i $ sigDefinitions $ stSignature s+				      }+		   }+  where+    setMutId x i = flip Map.adjust x $ \defn -> defn { defMutual = i }++-- | Get all mutual blocks+getMutualBlocks :: MonadTCM tcm => tcm [Set QName]+getMutualBlocks = gets $ Map.elems . stMutualBlocks++-- | Get the current mutual block.+currentMutualBlock :: MonadTCM tcm => tcm MutualId+currentMutualBlock = maybe fresh return =<< asks envMutualBlock++lookupMutualBlock :: MonadTCM tcm => MutualId -> tcm (Set QName)+lookupMutualBlock mi = do+  mb <- gets stMutualBlocks+  case Map.lookup mi mb of+    Just qs -> return qs+    Nothing -> fail $ "No such mutual block: " ++ show mi++findMutualBlock :: MonadTCM tcm => QName -> tcm (Set QName)+findMutualBlock f = do+  bs <- getMutualBlocks+  case filter (Set.member f) bs of+    []    -> fail $ "No mutual block for " ++ show f+    b : _ -> return b+

+ src/full/Agda/TypeChecking/Monad/Open.hs view

@@ -0,0 +1,49 @@+{-# LANGUAGE CPP #-}++module Agda.TypeChecking.Monad.Open+	( makeOpen+	, makeClosed+	, getOpen+	, tryOpen+	) where++import Control.Applicative+import Control.Monad+import Control.Monad.Error+import Data.List++import Agda.Syntax.Common++import Agda.TypeChecking.Substitute+import Agda.TypeChecking.Monad.Base++import {-# SOURCE #-} Agda.TypeChecking.Monad.Context++#include "../../undefined.h"+import Agda.Utils.Impossible++-- | Create an open term in the current context.+makeOpen :: MonadTCM tcm => a -> tcm (Open a)+makeOpen x = do+    ctx <- getContextId+    return $ OpenThing ctx x++-- | Create an open term which is closed.+makeClosed :: a -> Open a+makeClosed = OpenThing []+++-- | Extract the value from an open term. Must be done in an extension of the+--   context in which the term was created.+getOpen :: (MonadTCM tcm, Raise a) => Open a -> tcm a+getOpen (OpenThing []  x) = return x+getOpen (OpenThing ctx x) = do+  ctx' <- getContextId+  unless (ctx `isSuffixOf` ctx') $ fail $ "thing out of context (" ++ show ctx ++ " is not a sub context of " ++ show ctx' ++ ")"+  return $ raise (genericLength ctx' - genericLength ctx) x++tryOpen :: (MonadTCM tcm, Raise a) => Open a -> tcm (Maybe a)+tryOpen o = liftTCM $+  (Just <$> getOpen o)+  `catchError` \_ -> return Nothing+

+ src/full/Agda/TypeChecking/Monad/Options.hs view

@@ -0,0 +1,149 @@+{-# LANGUAGE CPP #-}++module Agda.TypeChecking.Monad.Options where++import Control.Monad.Reader+import Control.Monad.State+import Data.Maybe+import Text.PrettyPrint+import qualified System.IO.UTF8 as UTF8+import System.Directory++import Agda.TypeChecking.Monad.Base+import Agda.Interaction.Options+import Agda.Syntax.Abstract+import Agda.Utils.Monad+import Agda.Utils.List+import Agda.Utils.Trie (Trie)+import qualified Agda.Utils.Trie as Trie++#include "../../undefined.h"+import Agda.Utils.Impossible++-- | Sets the command line options. Ensures that the 'optInputFile'+-- field contains an absolute path.++setCommandLineOptions :: MonadTCM tcm => CommandLineOptions -> tcm ()+setCommandLineOptions opts =+  case checkOpts opts of+    Left err   -> __IMPOSSIBLE__+    Right opts -> do+      opts <- case optInputFile opts of+        Nothing -> return opts+        Just f  -> do+          -- canonicalizePath seems to return absolute paths.+          f <- liftIO $ canonicalizePath f+          return (opts { optInputFile = Just f })+      liftTCM $ modify $ \s -> s { stOptions = opts }++commandLineOptions :: MonadTCM tcm => tcm CommandLineOptions+commandLineOptions = liftTCM $ gets stOptions++setOptionsFromPragma :: MonadTCM tcm => Pragma -> tcm ()+setOptionsFromPragma (OptionsPragma xs) = do+    opts <- commandLineOptions+    case parsePragmaOptions xs opts of+	Left err    -> typeError $ GenericError err+	Right opts' -> setCommandLineOptions opts'+setOptionsFromPragma _ = return ()++setOptionsFromPragmas :: MonadTCM tcm => [Pragma] -> tcm ()+setOptionsFromPragmas = foldr (>>) (return ()) . map setOptionsFromPragma++bracketOptions :: MonadTCM tcm => tcm a -> tcm a+bracketOptions m = do+    opts <- commandLineOptions+    x    <- m+    setCommandLineOptions opts+    return x++-- | Disable display forms.+enableDisplayForms :: MonadTCM tcm => tcm a -> tcm a+enableDisplayForms =+  local $ \e -> e { envDisplayFormsEnabled = True }++-- | Disable display forms.+disableDisplayForms :: MonadTCM tcm => tcm a -> tcm a+disableDisplayForms =+  local $ \e -> e { envDisplayFormsEnabled = False }++-- | Check if display forms are enabled.+displayFormsEnabled :: MonadTCM tcm => tcm Bool+displayFormsEnabled = asks envDisplayFormsEnabled++-- | Don't reify interaction points+dontReifyInteractionPoints :: MonadTCM tcm => tcm a -> tcm a+dontReifyInteractionPoints =+  local $ \e -> e { envReifyInteractionPoints = False }++shouldReifyInteractionPoints :: MonadTCM tcm => tcm Bool+shouldReifyInteractionPoints = asks envReifyInteractionPoints++getIncludeDirs :: MonadTCM tcm => tcm [FilePath]+getIncludeDirs = addDot . optIncludeDirs <$> commandLineOptions+    where+	addDot [] = ["."]   -- if there are no include dirs we use .+	addDot is = is++setInputFile :: MonadTCM tcm => FilePath -> tcm ()+setInputFile file =+    do	opts <- commandLineOptions+	setCommandLineOptions $ opts { optInputFile = Just file }++-- | Should only be run if 'hasInputFile'.+getInputFile :: MonadTCM tcm => tcm FilePath+getInputFile =+    do	mf <- optInputFile <$> commandLineOptions+	case mf of+	    Just file	-> return file+	    Nothing	-> __IMPOSSIBLE__++hasInputFile :: MonadTCM tcm => tcm Bool+hasInputFile = isJust <$> optInputFile <$> commandLineOptions++proofIrrelevance :: MonadTCM tcm => tcm Bool+proofIrrelevance = optProofIrrelevance <$> commandLineOptions++showImplicitArguments :: MonadTCM tcm => tcm Bool+showImplicitArguments = optShowImplicit <$> commandLineOptions++setShowImplicitArguments :: MonadTCM tcm => Bool -> tcm a -> tcm a+setShowImplicitArguments showImp ret = do+  opts <- commandLineOptions+  let imp = optShowImplicit opts+  setCommandLineOptions $ opts { optShowImplicit = showImp }+  x <- ret+  opts <- commandLineOptions+  setCommandLineOptions $ opts { optShowImplicit = imp }+  return x++ignoreInterfaces :: MonadTCM tcm => tcm Bool+ignoreInterfaces = optIgnoreInterfaces <$> commandLineOptions++positivityCheckEnabled :: MonadTCM tcm => tcm Bool+positivityCheckEnabled = not . optDisablePositivity <$> commandLineOptions++typeInType :: MonadTCM tcm => tcm Bool+typeInType = not . optUniverseCheck <$> commandLineOptions++getVerbosity :: MonadTCM tcm => tcm (Trie String Int)+getVerbosity = optVerbose <$> commandLineOptions++type VerboseKey = String++verboseS :: MonadTCM tcm => VerboseKey -> Int -> tcm () -> tcm ()+verboseS k n action = do+    t <- getVerbosity+    let ks = wordsBy (`elem` ".:") k+	m  = maximum $ 0 : Trie.lookupPath ks t+    when (n <= m) action++reportS :: MonadTCM tcm => VerboseKey -> Int -> String -> tcm ()+reportS k n s = verboseS k n $ liftIO $ UTF8.putStr s++reportSLn :: MonadTCM tcm => VerboseKey -> Int -> String -> tcm ()+reportSLn k n s = verboseS k n $ liftIO $ UTF8.putStrLn s++reportSDoc :: MonadTCM tcm => VerboseKey -> Int -> tcm Doc -> tcm ()+reportSDoc k n d = verboseS k n $ liftIO . UTF8.print =<< d+

+ src/full/Agda/TypeChecking/Monad/Signature.hs view

@@ -0,0 +1,427 @@+{-# LANGUAGE CPP, PatternGuards #-}+module Agda.TypeChecking.Monad.Signature where++import Control.Monad.State+import Control.Monad.Reader+import Data.Set (Set)+import qualified Data.Set as Set+import Data.Map (Map)+import qualified Data.Map as Map+import Data.List+import Data.Function+import qualified System.IO.UTF8 as UTF8++import Agda.Syntax.Abstract.Name+import Agda.Syntax.Common+import Agda.Syntax.Internal+import Agda.Syntax.Position++import Agda.TypeChecking.Monad.Base+import Agda.TypeChecking.Monad.Context+import Agda.TypeChecking.Monad.Options+import Agda.TypeChecking.Monad.Env+import Agda.TypeChecking.Monad.Mutual+import Agda.TypeChecking.Monad.Open+import Agda.TypeChecking.Substitute+import {-# SOURCE #-} Agda.TypeChecking.Polarity++import Agda.Utils.Monad+import Agda.Utils.Map as Map+import Agda.Utils.Size+import Agda.Utils.Permutation++#include "../../undefined.h"+import Agda.Utils.Impossible++modifySignature :: MonadTCM tcm => (Signature -> Signature) -> tcm ()+modifySignature f = modify $ \s -> s { stSignature = f $ stSignature s }++modifyImportedSignature :: MonadTCM tcm => (Signature -> Signature) -> tcm ()+modifyImportedSignature f = modify $ \s -> s { stImports = f $ stImports s }++getSignature :: MonadTCM tcm => tcm Signature+getSignature = liftTCM $ gets stSignature++getImportedSignature :: MonadTCM tcm => tcm Signature+getImportedSignature = liftTCM $ gets stImports++setSignature :: MonadTCM tcm => Signature -> tcm ()+setSignature sig = modifySignature $ const sig++setImportedSignature :: MonadTCM tcm => Signature -> tcm ()+setImportedSignature sig = liftTCM $ modify $ \s -> s { stImports = sig }++withSignature :: MonadTCM tcm => Signature -> tcm a -> tcm a+withSignature sig m =+    do	sig0 <- getSignature+	setSignature sig+	r <- m+	setSignature sig0+        return r++-- | Add a constant to the signature. Lifts the definition to top level.+addConstant :: MonadTCM tcm => QName -> Definition -> tcm ()+addConstant q d = liftTCM $ do+  tel <- getContextTelescope+  let tel' = killRange $ case theDef d of+	      Constructor{} -> hideTel tel+	      _		    -> tel+  modifySignature $ \sig -> sig+    { sigDefinitions = Map.insertWith (+++) q (abstract tel' d') $ sigDefinitions sig }+  i <- currentMutualBlock+  setMutualBlock i q+  where+    d' = d { defName = q }+    new +++ old = new { defDisplay = defDisplay new ++ defDisplay old }+    +    hideTel  EmptyTel		      = EmptyTel+    hideTel (ExtendTel (Arg _ t) tel) = ExtendTel (Arg Hidden t) $ hideTel <$> tel++addHaskellCode :: MonadTCM tcm => QName -> HaskellType -> HaskellCode -> tcm ()+addHaskellCode q hsTy hsDef =+  -- TODO: sanity checking+  modifySignature $ \sig -> sig+  { sigDefinitions = Map.adjust addHs q $ sigDefinitions sig }+  where+    addHs def@Defn{theDef = con@Constructor{}} =+      def{theDef = con{conHsCode = Just (hsTy, hsDef)}}+    addHs def@Defn{theDef = ax@Axiom{}} =+      def{theDef = ax{axHsDef = Just $ HsDefn hsTy hsDef}}+    addHs def = def++addHaskellType :: MonadTCM tcm => QName -> HaskellType -> tcm ()+addHaskellType q hsTy =+  -- TODO: sanity checking+  modifySignature $ \sig -> sig+  { sigDefinitions = Map.adjust addHs q $ sigDefinitions sig }+  where+    addHs def@Defn{theDef = ax@Axiom{}} =+      def{theDef = ax{axHsDef = Just $ HsType hsTy}}+    addHs def@Defn{theDef = d@Datatype{}} =+      def{theDef = d{dataHsType = Just hsTy}}+    addHs def = def++unionSignatures :: [Signature] -> Signature+unionSignatures ss = foldr unionSignature emptySignature ss+  where+    unionSignature (Sig a b) (Sig c d) = Sig (Map.union a c) (Map.union b d)++-- | Add a section to the signature.+addSection :: MonadTCM tcm => ModuleName -> Nat -> tcm ()+addSection m fv = do+  tel <- getContextTelescope+  let sec = Section tel fv+  modifySignature $ \sig -> sig { sigSections = Map.insert m sec $ sigSections sig }++-- | Lookup a section. If it doesn't exist that just means that the module+--   wasn't parameterised.+lookupSection :: MonadTCM tcm => ModuleName -> tcm Telescope+lookupSection m = do+  sig  <- sigSections <$> getSignature+  isig <- sigSections <$> getImportedSignature+  return $ maybe EmptyTel secTelescope $ Map.lookup m sig `mplus` Map.lookup m isig++-- Add display forms to all names @xn@ such that @x = x1 es1@, ... @xn-1 = xn esn@.+addDisplayForms :: QName -> TCM ()+addDisplayForms x = do+  args <- getContextArgs+  add args x x []+  where+    add args top x ps = do+      cs <- defClauses <$> getConstInfo x+      case cs of+	[ Clause{ clauseBody = b } ]+	  | Just (m, Def y vs) <- strip b+	  , m == length args && args `isPrefixOf` vs -> do+	      let ps' = raise 1 (map unArg vs) ++ ps+	      reportSLn "tc.section.apply.display" 20 $ "adding display form " ++ show y ++ " --> " ++ show top+	      addDisplayForm y (Display 0 ps' $ DTerm $ Def top args)+	      add args top y $ drop (length args) ps'+	_ -> do+	      let reason = case cs of+		    []    -> "no clauses"+		    _:_:_ -> "many clauses"+		    [ Clause{ clauseBody = b } ] -> case strip b of+		      Nothing -> "bad body"+		      Just (m, Def y vs)+			| m < length args -> "too few args"+			| m > length args -> "too many args"+			| otherwise	      -> "args=" ++ unwords (map var args) ++ " vs=" ++ unwords (map var vs)+			  where+			    var (Arg h x) = hid h $ case x of+			      Var i []	-> show i+			      MetaV _ _	-> "?"+			      _		-> "_"+			    hid NotHidden s = s+			    hid Hidden    s = "{" ++ s ++ "}"+		      Just (m, v) -> "not a def body"+	      reportSLn "tc.section.apply.display" 30 $ "no display form from" ++ show x ++ " because " ++ reason+	      return ()+    strip (Body v)   = return (0, v)+    strip  NoBody    = Nothing+    strip (NoBind b) = Nothing+    strip (Bind b)   = do+      (n, v) <- strip $ absBody b+      return (n + 1, v)++applySection ::+  MonadTCM tcm => ModuleName -> Telescope -> ModuleName -> Args ->+  Map QName QName -> Map ModuleName ModuleName -> tcm ()+applySection new ptel old ts rd rm = liftTCM $ do+  sig  <- getSignature+  isig <- getImportedSignature+  let ss = Map.toList $ Map.filterKeys partOfOldM $ sigSections sig `Map.union` sigSections isig+      ds = Map.toList $ Map.filterKeys partOfOldD $ sigDefinitions sig `Map.union` sigDefinitions isig+  mapM_ (copyDef ts) ds+  mapM_ (copySec ts) ss+  where+    partOfOldM x = x `isSubModuleOf` old+    partOfOldD x = x `isInModule`    old++    copyName x = maybe x id $ Map.lookup 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+	  addConstant y (nd y)+          computePolarity y+	  -- Set display form for the old name if it's not a constructor.+	  unless (isCon || size ptel > 0) $ do+	    addDisplayForms y+      where+	t  = defType d `apply` ts+	-- the name is set by the addConstant function+	nd y = Defn y t [] (-1) def  -- TODO: mutual block?+        oldDef = theDef d+	isCon = case oldDef of+	  Constructor{} -> True+	  _		-> False+        -- TODO: compute polarity for the new definition+	def  = case oldDef of+                Constructor{ conPars = np, conData = d } ->+                  oldDef { conPars = np - size ts, conData = copyName d }+                Datatype{ dataPars = np, dataCons = cs } ->+                  oldDef { dataPars = np - size ts, dataClause = Just cl, dataCons = map copyName cs }+                Record{ recPars = np, recTel = tel } ->+                  oldDef { recPars = np - size ts, recClause = Just cl, recTel = apply tel ts }+		_ ->+                  Function { funClauses        = [cl]+                           , funDelayed        = NotDelayed+                           , funInv            = NotInjective+                           , funPolarity       = []+                           , funArgOccurrences = []+                           , funAbstr          = ConcreteDef+                           }+	cl = Clause { clauseRange = getRange $ defClauses d+                    , clauseTel   = EmptyTel+                    , clausePerm  = idP 0+                    , clausePats  = []+                    , clauseBody  = Body $ Def x ts+                    }++    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++addDisplayForm :: MonadTCM tcm => QName -> DisplayForm -> tcm ()+addDisplayForm x df = do+  d <- makeOpen df+  modifyImportedSignature (add d)+  modifySignature (add d)+  where+    add df sig = sig { sigDefinitions = Map.adjust addDf x defs }+      where+	addDf def = def { defDisplay = df : defDisplay def }+	defs	  = sigDefinitions sig++canonicalName :: MonadTCM tcm => QName -> tcm QName+canonicalName x = do+  def <- theDef <$> getConstInfo x+  case def of+    Constructor{conSrcCon = c}                                -> return c+    Record{recClause = Just (Clause{ clauseBody = body })}    -> canonicalName $ extract body+    Datatype{dataClause = Just (Clause{ clauseBody = body })} -> canonicalName $ extract body+    _                                                         -> return x+  where+    extract NoBody	     = __IMPOSSIBLE__+    extract (Body (Def x _)) = x+    extract (Body _)	     = __IMPOSSIBLE__+    extract (Bind (Abs _ b)) = extract b+    extract (NoBind b)	     = extract b++-- | Can be called on either a (co)datatype, a record type or a+--   (co)constructor.+whatInduction :: MonadTCM tcm => QName -> tcm Induction+whatInduction c = do+  def <- theDef <$> getConstInfo c+  case def of+    Datatype{ dataInduction = i } -> return i+    Record{}                      -> return Inductive+    Constructor{ conInd = i }     -> return i+    _                             -> __IMPOSSIBLE__++-- | Lookup the definition of a name. The result is a closed thing, all free+--   variables have been abstracted over.+getConstInfo :: MonadTCM tcm => QName -> tcm Definition+getConstInfo q = liftTCM $ do+  ab    <- treatAbstractly q+  defs  <- sigDefinitions <$> getSignature+  idefs <- sigDefinitions <$> getImportedSignature+  let smash = (++) `on` maybe [] (:[])+  case smash (Map.lookup q defs) (Map.lookup q idefs) of+      []  -> fail $ show (getRange q) ++ ": no such name " ++ show q+      [d] -> mkAbs ab d+      ds  -> fail $ show (getRange q) ++ ": ambiguous name " ++ show q+  where+    mkAbs True d =+      case makeAbstract d of+	Just d	-> return d+	Nothing	-> typeError $ NotInScope [qnameToConcrete q]+	  -- the above can happen since the scope checker is a bit sloppy with 'abstract'+    mkAbs False d = return d++-- | Look up the polarity of a definition.+getPolarity :: MonadTCM tcm => QName -> tcm [Polarity]+getPolarity q = liftTCM $ do+  defn <- theDef <$> getConstInfo q+  case defn of+    Function{ funPolarity  = p } -> return p+    Datatype{ dataPolarity = p } -> return p+    Record{ recPolarity    = p } -> return p+    _                            -> return []++getPolarity' :: MonadTCM tcm => Comparison -> QName -> tcm [Polarity]+getPolarity' CmpEq _  = return []+getPolarity' CmpLeq q = getPolarity q++-- | Set the polarity of a definition.+setPolarity :: MonadTCM tcm => QName -> [Polarity] -> tcm ()+setPolarity q pol = liftTCM $ do+  modifySignature setP+  where+    setP sig = sig { sigDefinitions = Map.adjust setPx q defs }+      where+	setPx def = def { theDef = setPd $ theDef def }+        setPd d   = case d of+          Function{} -> d { funPolarity  = pol }+          Datatype{} -> d { dataPolarity = pol }+          Record{}   -> d { recPolarity  = pol }+          _          -> d+	defs	  = sigDefinitions sig++getArgOccurrence :: MonadTCM tcm => QName -> Nat -> tcm Occurrence+getArgOccurrence d i = do+  def <- theDef <$> getConstInfo d+  return $ case def of+    Function { funArgOccurrences  = os } -> look i os+    Datatype { dataArgOccurrences = os } -> look i os+    Record   { recArgOccurrences  = os } -> look i os+    Constructor{}                        -> Positive+    _                                    -> Negative+  where+    look i os = (os ++ repeat Negative) !! fromIntegral i++setArgOccurrences :: MonadTCM tcm => QName -> [Occurrence] -> tcm ()+setArgOccurrences d os = liftTCM $+  modifySignature setO+  where+    setO sig = sig { sigDefinitions = Map.adjust setOx d defs }+      where+	setOx def = def { theDef = setOd $ theDef def }+        setOd d   = case d of+          Function{} -> d { funArgOccurrences  = os }+          Datatype{} -> d { dataArgOccurrences = os }+          Record{}   -> d { recArgOccurrences  = os }+          _          -> d+	defs	  = sigDefinitions sig+++-- | 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 :: MonadTCM tcm => ModuleName -> tcm Nat+getSecFreeVars m = do+  sig <- sigSections <$> getSignature+  top <- currentModule+  case top `isSubModuleOf` m || top == m of+    True  -> return $ maybe 0 secFreeVars $ Map.lookup m sig+    False -> return 0++-- | Compute the number of free variables of a defined name. This is the sum of+--   the free variables of the sections it's contained in.+getDefFreeVars :: MonadTCM tcm => QName -> tcm Nat+getDefFreeVars q = sum <$> ((:) <$> getAnonymousVariables m <*> mapM getSecFreeVars ms)+  where+    m  = qnameModule q+    ms = map mnameFromList . inits . mnameToList $ m++-- | Compute the context variables to apply a definition to.+freeVarsToApply :: MonadTCM tcm => QName -> tcm Args+freeVarsToApply x = genericTake <$> getDefFreeVars x <*> getContextArgs++-- | Instantiate a closed definition with the correct part of the current+--   context.+instantiateDef :: MonadTCM tcm => Definition -> tcm Definition+instantiateDef d = do+  vs  <- freeVarsToApply $ defName d+  verboseS "tc.sig.inst" 30 $ do+    ctx <- getContext+    m   <- currentModule+    liftIO $ UTF8.putStrLn $ "instDef in " ++ show m ++ ": " ++ show (defName d) ++ " " +++			unwords (map show . take (size vs) . reverse . map (fst . unArg) $ ctx)+  return $ d `apply` vs++-- | Give the abstract view of a definition.+makeAbstract :: Definition -> Maybe Definition+makeAbstract d = do def <- makeAbs $ theDef d+		    return d { theDef = def }+    where+	makeAbs Datatype   {dataAbstr = AbstractDef} = Just $ Axiom Nothing+	makeAbs Function   {funAbstr  = AbstractDef} = Just $ Axiom Nothing+	makeAbs Constructor{conAbstr  = AbstractDef} = Nothing+	makeAbs d                                    = Just d++-- | Enter abstract mode. Abstract definition in the current module are transparent.+inAbstractMode :: MonadTCM tcm => tcm a -> tcm a+inAbstractMode = local $ \e -> e { envAbstractMode = AbstractMode }++-- | Not in abstract mode. All abstract definitions are opaque.+inConcreteMode :: MonadTCM tcm => tcm a -> tcm a+inConcreteMode = local $ \e -> e { envAbstractMode = ConcreteMode }++-- | Ignore abstract mode. All abstract definitions are transparent.+ignoreAbstractMode :: MonadTCM tcm => tcm a -> tcm a+ignoreAbstractMode = local $ \e -> e { envAbstractMode = IgnoreAbstractMode }++-- | Check whether a name might have to be treated abstractly (either if we're+--   'inAbstractMode' or it's not a local name). Returns true for things not+--   declared abstract as well, but for those 'makeAbstract' will have no effect.+treatAbstractly :: MonadTCM tcm => QName -> tcm Bool+treatAbstractly q = treatAbstractly' q <$> ask++treatAbstractly' :: QName -> TCEnv -> Bool+treatAbstractly' q env = case envAbstractMode env of+  ConcreteMode	     -> True+  IgnoreAbstractMode -> False+  AbstractMode	     -> not $ current == m || current `isSubModuleOf` m+  where+    current = envCurrentModule env+    m	    = qnameModule q++-- | get type of a constant +typeOfConst :: MonadTCM tcm => QName -> tcm Type+typeOfConst q = defType <$> (instantiateDef =<< getConstInfo q)++-- | The name must be a datatype.+sortOfConst :: MonadTCM tcm => QName -> tcm Sort+sortOfConst q =+    do	d <- theDef <$> getConstInfo q+	case d of+	    Datatype{dataSort = s} -> return s+	    _			   -> fail $ "Expected " ++ show q ++ " to be a datatype."+

+ src/full/Agda/TypeChecking/Monad/SizedTypes.hs view

@@ -0,0 +1,55 @@++module Agda.TypeChecking.Monad.SizedTypes where++import Control.Monad.Error++import Agda.Interaction.Options+import Agda.Syntax.Common+import Agda.Syntax.Internal+import Agda.TypeChecking.Monad.Base+import Agda.TypeChecking.Monad.Options+import Agda.TypeChecking.Monad.Builtin+import Agda.TypeChecking.Substitute+import Agda.Utils.Monad++-- | Check if a type is the 'primSize' type. The argument should be 'reduce'd.+isSizeType :: MonadTCM tcm => Type -> tcm Bool+isSizeType (El _ v) = liftTCM $+  ifM (not . optSizedTypes <$> commandLineOptions) (return False) $+  case v of+    Def x [] -> do+      Def size [] <- primSize+      return $ x == size+    _ -> return False+  `catchError` \_ -> return False++sizeType :: MonadTCM tcm => tcm Type+sizeType = El (Type 0) <$> primSize++sizeSuc :: MonadTCM tcm => tcm (Maybe QName)+sizeSuc = liftTCM $+  ifM (not . optSizedTypes <$> commandLineOptions) (return Nothing) $ do+    Def x [] <- primSizeSuc+    return $ Just x+  `catchError` \_ -> return Nothing++-- | A useful view on sizes.+data SizeView = SizeInf | SizeSuc Term | OtherSize Term++-- | Compute the size view of a term. The argument should be 'reduce'd.+--   Precondition: sized types are enabled.+sizeView :: MonadTCM tcm => Term -> tcm SizeView+sizeView v = do+  Def inf [] <- primSizeInf+  Def suc [] <- primSizeSuc+  case v of+    Def x []  | x == inf -> return SizeInf+    Def x [u] | x == suc -> return $ SizeSuc (unArg u)+    _                    -> return $ OtherSize v++-- | Turn a size view into a term.+unSizeView :: MonadTCM tcm => SizeView -> tcm Term+unSizeView SizeInf       = primSizeInf+unSizeView (SizeSuc v)   = flip apply [Arg NotHidden v] <$> primSizeSuc+unSizeView (OtherSize v) = return v+

+ src/full/Agda/TypeChecking/Monad/State.hs view

@@ -0,0 +1,90 @@++module Agda.TypeChecking.Monad.State where++import Control.Applicative+import Control.Monad.State++import Agda.Syntax.Common+import Agda.Syntax.Scope.Base+import qualified Agda.Syntax.Concrete.Name as C+import Agda.Syntax.Abstract.Name++import Agda.TypeChecking.Monad.Base+import Agda.TypeChecking.Monad.Options++import Agda.Utils.Hash++-- | Resets the type checking state. The command line options are+-- preserved.++resetState :: MonadTCM tcm => tcm ()+resetState = liftTCM $ do+    opts <- commandLineOptions+    put initState+    setCommandLineOptions opts++-- | Set the current scope.+setScope :: MonadTCM tcm => ScopeInfo -> tcm ()+setScope scope = liftTCM $ modify $ \s -> s { stScope = scope }++-- | Get the current scope.+getScope :: MonadTCM tcm => tcm ScopeInfo+getScope = liftTCM $ gets stScope++-- | Modify the current scope.+modifyScope :: MonadTCM tcm => (ScopeInfo -> ScopeInfo) -> tcm ()+modifyScope f = do+  s <- getScope+  setScope $ f s++-- | Run a computation in a local scope.+withScope :: MonadTCM tcm => ScopeInfo -> tcm a -> tcm (a, ScopeInfo)+withScope s m = do+  s' <- getScope+  setScope s+  x   <- m+  s'' <- getScope+  setScope s'+  return (x, s'')++-- | Same as 'withScope', but discard the scope from the computation.+withScope_ :: MonadTCM tcm => ScopeInfo -> tcm a -> tcm a+withScope_ s m = fst <$> withScope s m++-- | Discard any changes to the scope by a computation.+localScope :: MonadTCM tcm => tcm a -> tcm a+localScope m = do+  scope <- getScope+  x <- m+  setScope scope+  return x++-- | Set the top-level module. This affects the global module id of freshly+--   generated names.+setTopLevelModule :: MonadTCM tcm => C.QName -> tcm ()+setTopLevelModule x =+  modify $ \s -> s+    { stFreshThings = (stFreshThings s)+      { fName = NameId 0 $ hash (show x)+      }+    }++-- | Use a different top-level module for a computation. Used when generating+--   names for imported modules.+withTopLevelModule :: MonadTCM tcm => C.QName -> tcm a -> tcm a+withTopLevelModule x m = do+  next <- gets $ fName . stFreshThings+  setTopLevelModule x+  y <- m+  modify $ \s -> s { stFreshThings = (stFreshThings s) { fName = next } }+  return y++-- | Tell the compiler to import the given Haskell module.+addHaskellImport :: MonadTCM tcm => String -> tcm ()+addHaskellImport i =+  modify $ \s -> s { stHaskellImports = i : stHaskellImports s }++-- | Get the Haskell imports.+getHaskellImports :: MonadTCM tcm => tcm [String]+getHaskellImports = gets stHaskellImports+

+ src/full/Agda/TypeChecking/Monad/Statistics.hs view

@@ -0,0 +1,20 @@++module Agda.TypeChecking.Monad.Statistics+    ( tick+    , getStatistics+    ) where++import Control.Monad.State+import Data.Map as Map++import Agda.TypeChecking.Monad.Base++tick :: String -> TCM ()+tick x = modify $ \s ->+    s { stStatistics = Map.insertWith (\_ n -> n + 1) x 1+		     $ stStatistics s+      }++getStatistics :: TCM Statistics+getStatistics = gets stStatistics+

+ src/full/Agda/TypeChecking/Monad/Trace.hs view

@@ -0,0 +1,65 @@++module Agda.TypeChecking.Monad.Trace where++import Control.Monad.State++import Agda.Syntax.Position+import Agda.TypeChecking.Monad.Base+import Agda.Utils.Monad+import Agda.Utils.Trace++---------------------------------------------------------------------------+-- * Trace+---------------------------------------------------------------------------++-- | Record a function call in the trace.+traceCall :: MonadTCM tcm => (Maybe r -> Call) -> tcm r -> tcm r+traceCall mkCall m = do+    cl <- buildClosure $ mkCall Nothing+    onTrace $ newCall cl+    r <- m+    onTrace $ updateCall $ cl { clValue = mkCall (Just r) }+    return r++traceCall_ :: MonadTCM tcm => (Maybe () -> Call) -> tcm r -> tcm r+traceCall_ mkCall = traceCall (mkCall . fmap (const ()))++traceCallCPS :: MonadTCM tcm => (Maybe r -> Call) -> (r -> tcm a) -> ((r -> tcm a) -> tcm b) -> tcm b+traceCallCPS mkCall ret cc = do+    cl <- buildClosure $ mkCall Nothing+    onTrace $ newCall cl+    cc $ \r -> do+	onTrace $ updateCall $ cl { clValue = mkCall (Just r) }+	ret r++traceCallCPS_ :: MonadTCM tcm => (Maybe () -> Call) -> tcm a -> (tcm a -> tcm b) -> tcm b+traceCallCPS_ mkCall ret cc =+    traceCallCPS mkCall (const ret) (\k -> cc $ k ())++getTrace :: MonadTCM tcm => tcm CallTrace+getTrace = liftTCM $ gets stTrace++setTrace :: MonadTCM tcm => CallTrace -> tcm ()+setTrace tr = liftTCM $ modify $ \s -> s { stTrace = tr }++getCurrentRange :: MonadTCM tcm => tcm Range+getCurrentRange = getRange <$> getTrace++setCurrentRange :: MonadTCM tcm => Range -> tcm a -> tcm a+setCurrentRange r+  | r == noRange = id+  | otherwise    = traceCall (SetRange r)++onTrace :: MonadTCM tcm => (CallTrace -> CallTrace) -> tcm ()+onTrace f = do+    tr <- getTrace+    setTrace (f tr)++withTrace :: MonadTCM tcm => CallTrace -> tcm a -> tcm a+withTrace tr m = do+    tr0 <- getTrace+    setTrace tr+    x <- m+    setTrace tr0+    return x+

+ src/full/Agda/TypeChecking/Patterns/Match.hs view

@@ -0,0 +1,86 @@+{-# LANGUAGE CPP #-}++module Agda.TypeChecking.Patterns.Match where++import Control.Monad+import Data.Monoid+import Data.Traversable++import Agda.Syntax.Common+import Agda.Syntax.Internal+import Agda.Syntax.Literal++import Agda.TypeChecking.Reduce+import Agda.TypeChecking.Monad+import Agda.TypeChecking.Monad.Builtin+import Agda.TypeChecking.Primitive++import Agda.Utils.Monad++#include "../../undefined.h"+import Agda.Utils.Impossible++-- | If matching is inconclusive (@DontKnow@) we want to know whether+--   it is due to a particular meta variable.+data Match = Yes [Term] | No | DontKnow (Maybe MetaId)++instance Monoid Match where+    mempty = Yes []++    Yes us     `mappend` Yes vs		  = Yes (us ++ vs)+    Yes _      `mappend` No		  = No+    Yes _      `mappend` DontKnow m	  = DontKnow m+    No	       `mappend` _		  = No++    -- Nothing means blocked by a variable.  In this case no instantiation of+    -- meta-variables will make progress.+    DontKnow _ `mappend` DontKnow Nothing = DontKnow Nothing++    -- One could imagine DontKnow _ `mappend` No = No, but would break the+    -- equivalence to case-trees.+    DontKnow m `mappend` _		  = DontKnow m++matchPatterns :: MonadTCM tcm => [Arg Pattern] -> [Arg Term] -> tcm (Match, [Arg Term])+matchPatterns ps vs =+    do	(ms,vs) <- unzip <$> zipWithM' matchPattern ps vs+	return (mconcat ms, vs)++matchPattern :: MonadTCM tcm => Arg Pattern -> Arg Term -> tcm (Match, Arg Term)+matchPattern (Arg h' (VarP _))	  arg@(Arg _ v) = return (Yes [v], arg)+matchPattern (Arg _  (DotP _))    arg@(Arg _ v) = return (Yes [v], arg)+matchPattern (Arg h' (LitP l))	  arg@(Arg h v) = do+    w <- reduceB v+    let v = ignoreBlocking w+    case w of+	NotBlocked (Lit l')+	    | l == l'          -> return (Yes [], Arg h v)+	    | otherwise        -> return (No, Arg h v)+	NotBlocked (MetaV x _) -> return (DontKnow $ Just x, Arg h v)+	Blocked x _            -> return (DontKnow $ Just x, Arg h v)+	_                      -> return (DontKnow Nothing, Arg h v)+matchPattern (Arg h' (ConP c ps))     (Arg h v) =+    do	w <- traverse constructorForm =<< reduceB v+        -- Unfold delayed (corecursive) definitions one step. This is+        -- only necessary if c is a coinductive constructor, but+        -- 1) it does not hurt to do it all the time, and+        -- 2) whatInduction c sometimes crashes because c may point to+        --    an axiom at this stage (if we are checking the+        --    projection functions for a record type).+        w <- case w of+               NotBlocked (Def f args) ->+                 unfoldDefinition True reduceB (Def f []) f args+                   -- reduceB is used here because some constructors+                   -- are actually definitions which need to be+                   -- unfolded (due to open public).+               _ -> return w+        let v = ignoreBlocking w+	case w of+	  NotBlocked (Con c' vs)+	    | c == c'             -> do+		(m, vs) <- matchPatterns ps vs+		return (m, Arg h $ Con c' vs)+	    | otherwise           -> return (No, Arg h v)+	  NotBlocked (MetaV x vs) -> return (DontKnow $ Just x, Arg h v)+	  Blocked x _             -> return (DontKnow $ Just x, Arg h v)+          _                       -> return (DontKnow Nothing, Arg h v)+

+ src/full/Agda/TypeChecking/Patterns/Match.hs-boot view

@@ -0,0 +1,11 @@++module Agda.TypeChecking.Patterns.Match where++import Agda.Syntax.Common+import Agda.Syntax.Internal+import Agda.TypeChecking.Monad++data Match = Yes [Term] | No | DontKnow (Maybe MetaId)++matchPatterns :: MonadTCM tcm => [Arg Pattern] -> [Arg Term] -> tcm (Match, [Arg Term])+

+ src/full/Agda/TypeChecking/Polarity.hs view

@@ -0,0 +1,164 @@+{-# LANGUAGE CPP #-}+module Agda.TypeChecking.Polarity where++import Control.Applicative+import Control.Monad.State+import Control.Monad.Error+import Data.List++import Agda.Syntax.Common+import Agda.Syntax.Internal+import Agda.TypeChecking.Monad+import Agda.TypeChecking.Positivity+import Agda.TypeChecking.Substitute+import Agda.TypeChecking.Reduce+import Agda.TypeChecking.Free+import Agda.TypeChecking.Monad.Builtin+import Agda.Interaction.Options+import Agda.Utils.Monad+import Agda.Utils.Impossible+import Agda.Utils.Size++#include "../undefined.h"++getArity :: QName -> TCM Arity+getArity x = do+  def <- theDef <$> getConstInfo x+  case def of+    Axiom{}                                 -> return 0+    Function{ funClauses = c : _ }          -> return $ genericLength (clausePats c)+    Function{ funClauses = [] }             -> return 0+    Datatype{ dataPars = np, dataIxs = ni } -> return np+    Record{ recPars = n }                   -> return n+    Constructor{}                           -> return 0+    Primitive{}                             -> return 0++computePolarity :: QName -> TCM ()+computePolarity x = do+  reportSLn "tc.polarity.set" 15 $ "Computing polarity of " ++ show x+  n <- getArity x+  reportSLn "tc.polarity.set" 20 $ "  arity = " ++ show n+  pol0 <- mapM getPol [0..n - 1]++  -- Not very nice, but should work+  setPolarity x $ pol0 ++ [Covariant]+  pol1 <- sizePolarity x++  let pol = pol0 ++ pol1+  reportSLn "tc.polarity.set" 10 $ "Polarity of " ++ show x ++ ": " ++ show pol+  setPolarity x pol+  where+    getPol :: Nat -> TCM Polarity+    getPol i = do+        o <- getArgOccurrence x i+        case o of+          Positive -> return Covariant+          Negative -> return Invariant  -- Negative isn't the same as contravariant+          Unused   -> return Invariant  -- add NonVariant?++-- | Hack for polarity of size indices.+sizePolarity :: QName -> TCM [Polarity]+sizePolarity d =+  ifM (not . optSizedTypes <$> commandLineOptions) (return []) $ do+  def <- getConstInfo d+  case theDef def of+    Datatype{ dataPars = np, dataCons = cons } -> do+      let TelV tel _      = telView $ defType def+          (parTel, ixTel) = genericSplitAt np $ telToList tel+      case ixTel of+        []                -> return []  -- No size index+        Arg _ (_, a) : _  -> ifM (not <$> isSizeType a) (return []) $ do+          let check c = do+                t <- normalise =<< defType <$> getConstInfo c+                addCtxTel (telFromList parTel) $ do+                  let pars = reverse [ Arg NotHidden $ Var i [] | i <- [0..np - 1] ]+                      TelV conTel target = telView $ t `piApply` pars+                  case conTel of+                    EmptyTel  -> return False  -- no size argument+                    ExtendTel arg@(Arg _ a) tel ->+                      ifM (not <$> isSizeType a) (return False) $ do -- also no size argument+                        -- First constructor argument has type Size++                        -- check only positive occurences in tel+                        isPos <- underAbstraction arg tel $ \tel -> do+                          pols <- zipWithM polarity [0..] $ map (snd . unArg) $ telToList tel+                          return $ all (== Covariant) pols++                        -- check that the size argument appears in the+                        -- right spot in the target type+                        let sizeArg = size tel+                        isLin <- checkSizeIndex np sizeArg target++                        return $ isPos && isLin+                      +          ifM (and <$> mapM check cons)+              (return [Covariant])+              (return [Invariant])+    _ -> return []++checkSizeIndex :: Nat -> Nat -> Type -> TCM Bool+checkSizeIndex np i (El _ (Def _ args)) = do+  let excl = not $ freeIn i (pars ++ ixs)+  s <- sizeView ix+  case s of+    SizeSuc (Var j []) -> return $ and [ excl, i == j ]+    _                  -> return False+  where+    (pars, Arg _ ix : ixs) = genericSplitAt np args+checkSizeIndex _ _ _ = __IMPOSSIBLE__++(/\) :: Polarity -> Polarity -> Polarity+a /\ b | a == b    = a+       | otherwise = Invariant++neg :: Polarity -> Polarity+neg Covariant     = Contravariant+neg Contravariant = Covariant+neg Invariant     = Invariant++composePol :: Polarity -> Polarity -> Polarity+composePol Invariant _     = Invariant+composePol Covariant x     = x+composePol Contravariant x = neg x++class HasPolarity a where+  polarities :: Nat -> a -> TCM [Polarity]++polarity :: HasPolarity a => Nat -> a -> TCM Polarity+polarity i x = do+  ps <- polarities i x+  case ps of+    [] -> return Covariant+    ps -> return $ foldr1 (/\) ps++instance HasPolarity a => HasPolarity (Arg a) where+  polarities i = polarities i . unArg++instance HasPolarity a => HasPolarity (Abs a) where+  polarities i = polarities (i + 1) . absBody++instance HasPolarity a => HasPolarity [a] where+  polarities i xs = concat <$> mapM (polarities i) xs++instance (HasPolarity a, HasPolarity b) => HasPolarity (a, b) where+  polarities i (x, y) = (++) <$> polarities i x <*> polarities i y++instance HasPolarity Type where+  polarities i (El _ v) = polarities i v++instance HasPolarity Term where+  polarities i v = case v of+    Var n ts  | n == i -> (Covariant :) <$> polarities i ts+              | otherwise -> polarities i ts+    Lam _ t    -> polarities i t+    Lit _      -> return []+    Def x ts   -> do+      pols <- getPolarity x+      let compose p ps = map (composePol p) ps+      concat . zipWith compose (pols ++ repeat Invariant) <$> mapM (polarities i) ts+    Con _ ts   -> polarities i ts+    Pi a b     -> (++) <$> (map neg <$> polarities i a) <*> polarities i b+    Fun a b    -> (++) <$> (map neg <$> polarities i a) <*> polarities i b+    Sort _     -> return []+    MetaV _ ts -> map (const Invariant) <$> polarities i ts+

+ src/full/Agda/TypeChecking/Polarity.hs-boot view

@@ -0,0 +1,8 @@++module Agda.TypeChecking.Polarity where++import Agda.Syntax.Internal+import Agda.TypeChecking.Monad.Base++computePolarity :: QName -> TCM ()+

+ src/full/Agda/TypeChecking/Positivity.hs view

@@ -0,0 +1,431 @@+{-# LANGUAGE CPP #-}++-- | Check that a datatype is strictly positive.+module Agda.TypeChecking.Positivity where++import Control.Applicative hiding (empty)+import Data.Set (Set)+import qualified Data.Set as Set+import Data.Map (Map)+import qualified Data.Map as Map+import Data.List as List++import Agda.Syntax.Position+import Agda.Syntax.Common+import Agda.Syntax.Internal+import Agda.TypeChecking.Monad+import Agda.TypeChecking.Reduce+import Agda.TypeChecking.Pretty+import Agda.TypeChecking.Substitute++import Agda.Utils.Impossible+import Agda.Utils.Permutation+import Agda.Utils.Size+import Agda.Utils.Monad+import Agda.Utils.SemiRing+import qualified Agda.Utils.Graph as Graph+import Agda.Utils.Graph (Graph)++#include "../undefined.h"++-- | Check that the datatypes in the given mutual block+--   are strictly positive.+checkStrictlyPositive :: MutualId -> TCM ()+checkStrictlyPositive mi = do+  qs <- lookupMutualBlock mi+  reportSDoc "tc.pos.tick" 100 $ text "positivity of" <+> prettyTCM (Set.toList qs)+  g  <- buildOccurrenceGraph qs+  reportSDoc "tc.pos.tick" 100 $ text "constructed graph"+  reportSLn "tc.pos.graph" 5 $ "Positivity graph: N=" ++ show (size $ Graph.nodes g) +++                               " E=" ++ show (length $ Graph.edges g)+  reportSDoc "tc.pos.graph" 10 $ vcat+    [ text "positivity graph for" <+> prettyTCM (Set.toList qs)+    , nest 2 $ prettyGraph g+    ]+  mapM_ (setArgs g) $ Set.toList qs+  reportSDoc "tc.pos.tick" 100 $ text "set args"+  whenM positivityCheckEnabled $+    mapM_ (checkPos g) $ Set.toList qs+  reportSDoc "tc.pos.tick" 100 $ text "checked positivity"+  where+    checkPos g q = whenM (isDatatype q) $ do+      reportSDoc "tc.pos.check" 10 $ text "Checking positivity of" <+> prettyTCM q+      case Graph.findPath isNegative (DefNode q) (DefNode q) g of+        Nothing                  -> return ()+        Just (Edge Positive _)   -> __IMPOSSIBLE__+        Just (Edge Unused _)     -> __IMPOSSIBLE__+        Just (Edge Negative how) -> do+          err <- fsep $+            [prettyTCM q] ++ pwords "is not strictly positive, because it occurs" +++            [prettyTCM how]+          setCurrentRange (getRange q) $ typeError $ GenericError (show err)++    isNegative (Edge o _) = o == Negative++    isDatatype q = do+      def <- theDef <$> getConstInfo q+      return $ case def of+        Datatype{dataClause = Nothing} -> True+        _ -> False++    getArity q = do+      def <- theDef <$> getConstInfo q+      return $ case def of+        Function{ funClauses = Clause{ clausePats = ps } : _ } -> size ps+        Datatype{ dataPars = n }                     -> n+        Record{ recPars = n }                        -> n+        _                                            -> 0++    -- Set the polarity of the arguments to a definition+    setArgs g q = do+      reportSDoc "tc.pos.args" 5 $ text "checking args of" <+> prettyTCM q+      n <- getArity q+      let nArgs = maximum $ n :+                    [ i + 1 | (ArgNode q1 i) <- Set.toList $ Graph.nodes g+                    , q1 == q ]+          findOcc i = case Graph.allPaths isNegative (ArgNode q i) (DefNode q) g of+            []                     -> Positive  -- Unused is not good for datatypes+            es | any isNegative es -> Negative+               | otherwise         -> Positive+          args = map findOcc [0..nArgs - 1]+      reportSDoc "tc.pos.args" 10 $ sep+        [ text "args of" <+> prettyTCM q <+> text "="+        , nest 2 $ prettyList $ map (text . show) args+        ]+      setArgOccurrences q args++-- Specification of occurrences -------------------------------------------++instance SemiRing Occurrence where+  oplus Negative _        = Negative+  oplus _ Negative        = Negative+  oplus Unused o          = o+  oplus o Unused          = o+  oplus Positive Positive = Positive++  otimes Unused _          = Unused+  otimes _ Unused          = Unused+  otimes Negative _        = Negative+  otimes _ Negative        = Negative+  otimes Positive Positive = Positive++-- | Description of an occurrence.+data OccursWhere+  = LeftOfArrow OccursWhere+  | DefArg QName Nat OccursWhere -- ^ in the nth argument of a define constant+  | VarArg OccursWhere           -- ^ as an argument to a bound variable+  | MetaArg OccursWhere          -- ^ as an argument of a metavariable+  | ConArgType QName OccursWhere -- ^ in the type of a constructor+  | InClause Nat OccursWhere     -- ^ in the nth clause of a defined function+  | InDefOf QName OccursWhere    -- ^ in the definition of a constant+  | Here+  | Unknown                      -- ^ an unknown position (treated as negative)+  deriving (Show, Eq)++(>*<) :: OccursWhere -> OccursWhere -> OccursWhere+Here            >*< o  = o+Unknown         >*< o  = Unknown+LeftOfArrow o1  >*< o2 = LeftOfArrow (o1 >*< o2)+DefArg d i o1   >*< o2 = DefArg d i (o1 >*< o2)+VarArg o1       >*< o2 = VarArg (o1 >*< o2)+MetaArg o1      >*< o2 = MetaArg (o1 >*< o2)+ConArgType c o1 >*< o2 = ConArgType c (o1 >*< o2)+InClause i o1   >*< o2 = InClause i (o1 >*< o2)+InDefOf d o1    >*< o2 = InDefOf d (o1 >*< o2)++instance PrettyTCM OccursWhere where+  prettyTCM o = prettyOs $ map maxOneLeftOfArrow $ uniq $ splitOnDef o+    where+      nth 0 = pwords "first"+      nth 1 = pwords "second"+      nth 2 = pwords "third"+      nth n = pwords $ show (n + 1) ++ "th"++      uniq (x:y:xs)+        | x == y  = uniq (x:xs)+      uniq (x:xs) = x : uniq xs+      uniq []     = []++      prettyOs [] = __IMPOSSIBLE__+      prettyOs [o] = prettyO o <> text "."+      prettyOs (o:os) = prettyO o <> text ", which occurs" <+> prettyOs os++      prettyO o = case o of+        Here           -> empty+        Unknown        -> empty+        LeftOfArrow o  -> explain o $ pwords "to the left of an arrow"+        DefArg q i o   -> explain o $ pwords "in the" ++ nth i ++ pwords "argument to" +++                                      [prettyTCM q]+        VarArg o       -> explain o $ pwords "in an argument to a bound variable"+        MetaArg o      -> explain o $ pwords "in an argument to a metavariable"+        ConArgType c o -> explain o $ pwords "in the type of the constructor" ++ [prettyTCM c]+        InClause i o   -> explain o $ pwords "in the" ++ nth i ++ pwords "clause"+        InDefOf d o    -> explain o $ pwords "in the definition of" ++ [prettyTCM d]++      explain o ds = prettyO o $$ fsep ds++      maxOneLeftOfArrow o = case o of+        LeftOfArrow o  -> LeftOfArrow $ purgeArrows o+        Here           -> Here+        Unknown        -> Unknown+        DefArg q i o   -> DefArg q i   $ maxOneLeftOfArrow o+        InDefOf d o    -> InDefOf d    $ maxOneLeftOfArrow o+        VarArg o       -> VarArg       $ maxOneLeftOfArrow o+        MetaArg o      -> MetaArg      $ maxOneLeftOfArrow o+        ConArgType c o -> ConArgType c $ maxOneLeftOfArrow o+        InClause i o   -> InClause i   $ maxOneLeftOfArrow o++      purgeArrows o = case o of+        LeftOfArrow o -> purgeArrows o+        Here           -> Here+        Unknown        -> Unknown+        DefArg q i o   -> DefArg q i   $ purgeArrows o+        InDefOf d o    -> InDefOf d    $ purgeArrows o+        VarArg o       -> VarArg       $ purgeArrows o+        MetaArg o      -> MetaArg      $ purgeArrows o+        ConArgType c o -> ConArgType c $ purgeArrows o+        InClause i o   -> InClause i   $ purgeArrows o++      splitOnDef o = case o of+        Here           -> [Here]+        Unknown        -> [Unknown]+        InDefOf d o    -> sp (InDefOf d) o+        LeftOfArrow o  -> sp LeftOfArrow o+        DefArg q i o   -> sp (DefArg q i) o+        VarArg o       -> sp VarArg o+        MetaArg o      -> sp MetaArg o+        ConArgType c o -> sp (ConArgType c) o+        InClause i o   -> sp (InClause i) o+        where+          sp f o = case splitOnDef o of+            os@(InDefOf _ _:_) -> f Here : os+            o:os               -> f o : os+            []                 -> __IMPOSSIBLE__++-- Computing occurrences --------------------------------------------------++data Item = AnArg Nat+          | ADef QName+  deriving (Eq, Ord, Show)++type Occurrences = Map Item [OccursWhere]++(>+<) :: Occurrences -> Occurrences -> Occurrences+(>+<) = Map.unionWith (++)++concatOccurs :: [Occurrences] -> Occurrences+concatOccurs = Map.unionsWith (++)++occursAs :: (OccursWhere -> OccursWhere) -> Occurrences -> Occurrences+occursAs f = Map.map (map f)++here :: Item -> Occurrences+here i = Map.singleton i [Here]++class ComputeOccurrences a where+  -- | The first argument is the items corresponding to the free variables.+  occurrences :: [Maybe Item] -> a -> Occurrences++instance ComputeOccurrences Clause where+  occurrences vars (Clause{ clausePats = ps, clauseBody = body }) =+    concatOccurs (zipWith match [0..] ps) >+<+    walk vars (patItems ps) body+    where+      walk _    _         NoBody     = Map.empty+      walk vars []        (Body v)   = occurrences vars v+      walk vars (i : pis) (Bind b)   = walk (i : vars) pis $ absBody b+      walk vars (_ : pis) (NoBind b) = walk vars pis b+      walk _    []        Bind{}     = __IMPOSSIBLE__+      walk _    []        NoBind{}   = __IMPOSSIBLE__+      walk _    (_ : _)   Body{}     = __IMPOSSIBLE__++      match i (Arg _ VarP{}) = Map.empty+      match i _              = Map.singleton (AnArg i) [Unknown]++      patItems ps = concat $ zipWith patItem [0..] $ map unArg ps+      patItem i (VarP _) = [Just (AnArg i)]+      patItem i p        = replicate (nVars p) Nothing++      nVars p = case p of+        VarP{}    -> 1+        DotP{}    -> 1+        ConP _ ps -> sum $ map (nVars . unArg) ps+        LitP{}    -> 0++instance ComputeOccurrences Term where+  occurrences vars v = case v of+    Var i args ->+      maybe Map.empty here (vars ! fromIntegral i)+      >+< occursAs VarArg (occurrences vars args)+    Def d args   ->+      here (ADef d) >+<+      concatOccurs (zipWith (occursAs . DefArg d) [0..] $ map (occurrences vars) args)+    Con c args   -> occurrences vars args+    MetaV _ args -> occursAs MetaArg $ occurrences vars args+    Pi a b       -> occursAs LeftOfArrow (occurrences vars a) >+<+                    occurrences vars b+    Fun a b      -> occursAs LeftOfArrow (occurrences vars a) >+<+                    occurrences vars b+    Lam _ b      -> occurrences vars b+    Lit{}        -> Map.empty+    Sort{}       -> Map.empty+    where+      vs ! i+        | i < length vs = vs !! i+        | otherwise     = error $ show vs ++ " ! " ++ show i ++ "  (" ++ show v ++ ")"++instance ComputeOccurrences Type where+  occurrences vars (El _ v) = occurrences vars v++instance ComputeOccurrences Telescope where+  occurrences vars EmptyTel        = Map.empty+  occurrences vars (ExtendTel a b) = occurrences vars (a, b)++instance ComputeOccurrences a => ComputeOccurrences (Abs a) where+  occurrences vars = occurrences (Nothing : vars) . absBody++instance ComputeOccurrences a => ComputeOccurrences (Arg a) where+  occurrences vars = occurrences vars . unArg++instance ComputeOccurrences a => ComputeOccurrences [a] where+  occurrences vars = concatOccurs . map (occurrences vars)++instance (ComputeOccurrences a, ComputeOccurrences b) => ComputeOccurrences (a, b) where+  occurrences vars (x, y) = occurrences vars x >+< occurrences vars y++-- | Compute the occurrences in a given definition.+computeOccurrences :: QName -> TCM Occurrences+computeOccurrences q = do+  def <- getConstInfo q+  occursAs (InDefOf q) <$> case theDef def of+    Function{funClauses = cs} -> do+      n  <- arity <$> instantiateFull (defType def)+      cs <- map (etaExpandClause n) <$> instantiateFull cs+      return+        $ concatOccurs+        $ zipWith (occursAs . InClause) [0..]+        $ map (occurrences []) cs+    Datatype{dataClause = Just c} -> occurrences [] <$> instantiateFull c+    Datatype{dataPars = np, dataCons = cs}       -> do+      let conOcc c = do+            a <- defType <$> getConstInfo c+            TelV tel _ <- telView <$> normalise a+            let tel' = telFromList $ genericDrop np $ telToList tel+                vars = reverse [ Just (AnArg i) | i <- [0..np - 1] ]+            return $ occursAs (ConArgType c) $ occurrences vars tel'+      concatOccurs <$> mapM conOcc cs+    Record{recClause = Just c} -> occurrences [] <$> instantiateFull c+    Record{recPars = np, recTel = tel} -> do+      let tel' = telFromList $ genericDrop np $ telToList tel+          vars = reverse [ Just (AnArg i) | i <- [0..np - 1] ]+      occurrences vars <$> instantiateFull tel'++    -- Arguments to other kinds of definitions are hard-wired.+    Constructor{} -> return Map.empty+    Axiom{}       -> return Map.empty+    Primitive{}   -> return Map.empty++-- | Eta expand a clause to have the given number of variables.+--   Warning: doesn't update telescope or permutation!+--   This is used instead of special treatment of lambdas+--   (which was unsound: issue 121)+etaExpandClause :: Nat -> Clause -> Clause+etaExpandClause n c@Clause{ clausePats = ps, clauseBody = b }+  | m <= 0    = c+  | otherwise = c { clausePats = ps ++ genericReplicate m (Arg NotHidden $ VarP "_")+                  , clauseBody = liftBody m b+                  }+  where+    m = n - genericLength ps++    bind 0 = id+    bind n = Bind . Abs "_" . bind (n - 1)++    vars = reverse [ Arg NotHidden $ Var i [] | i <- [0..m - 1] ]++    liftBody m (Bind b)   = Bind $ fmap (liftBody m) b+    liftBody m (NoBind b) = NoBind $ liftBody m b+    liftBody m NoBody     = bind m NoBody+    liftBody m (Body v)   = bind m $ Body $ raise m v `apply` vars++-- Building the occurrence graph ------------------------------------------++data Node = DefNode QName+          | ArgNode QName Nat+  deriving (Eq, Ord)++instance Show Node where+  show (DefNode q)   = show q+  show (ArgNode q i) = show q ++ "." ++ show i++instance PrettyTCM Node where+  prettyTCM (DefNode q)   = prettyTCM q+  prettyTCM (ArgNode q i) = prettyTCM q <> text ("." ++ show i)++prettyGraph g = vcat $ map pr $ Map.assocs $ Graph.unGraph g+  where+    pr (n, es) = sep+      [ prettyTCM n+      , nest 2 $ vcat $ map prE $ Map.assocs es+      ]+    prE (n, Edge o w) = prO o <+> prettyTCM n <+> fsep (pwords $ show w)+    prO Positive = text "-[+]->"+    prO Negative = text "-[-]->"+    prO Unused   = text "-[ ]->"++data Edge = Edge Occurrence OccursWhere+  deriving (Show)++instance SemiRing Edge where+  oplus _                   e@(Edge Negative _) = e+  oplus e@(Edge Negative _) _                   = e+  oplus (Edge Unused _)     e                   = e+  oplus e                   (Edge Unused _)     = e+  oplus (Edge Positive _)   e@(Edge Positive _) = e++  otimes (Edge o1 w1) (Edge o2 w2) = Edge (otimes o1 o2) (w1 >*< w2)++buildOccurrenceGraph :: Set QName -> TCM (Graph Node Edge)+buildOccurrenceGraph qs = Graph.unions <$> mapM defGraph (Set.toList qs)+  where+    defGraph :: QName -> TCM (Graph Node Edge)+    defGraph q = do+      occs <- computeOccurrences q+      let onItem (item, occs) = do+            es <- mapM (computeEdge qs) occs+            return $ Graph.unions $ +                map (\(b, w) -> Graph.singleton (itemToNode item) b w) es+      Graph.unions <$> mapM onItem (Map.assocs occs)+      where+        itemToNode (AnArg i) = ArgNode q i+        itemToNode (ADef q)  = DefNode q++-- | Given an 'OccursWhere' computes the target node and an 'Edge'. The first+--   argument is the set of names in the current mutual block.+computeEdge :: Set QName -> OccursWhere -> TCM (Node, Edge)+computeEdge muts o = do+  (to, occ) <- mkEdge __IMPOSSIBLE__ Positive o+  return (to, Edge occ o)+  where+    mkEdge to pol o = case o of+      Here           -> return (to, pol)+      Unknown        -> return (to, Negative)+      VarArg o       -> negative o+      MetaArg o      -> negative o+      LeftOfArrow o  -> negative o+      DefArg d i o+        | Set.member d muts -> inArg d i o+        | otherwise         -> addPol o =<< getArgOccurrence d i+      ConArgType _ o -> keepGoing o+      InClause _ o   -> keepGoing o+      InDefOf d o    -> mkEdge (DefNode d) Positive o+      where+        keepGoing     = mkEdge to pol+        negative      = mkEdge to Negative+        addPol o pol' = mkEdge to (otimes pol pol') o++        -- Reset polarity when changing the target node+        -- D: (A B -> C) generates a positive edge B --> A.1+        -- even though the context is negative.+        inArg d i = mkEdge (ArgNode d i) Positive+

+ src/full/Agda/TypeChecking/Pretty.hs view

@@ -0,0 +1,148 @@+{-# LANGUAGE TypeSynonymInstances, UndecidableInstances #-}+module Agda.TypeChecking.Pretty where++import Control.Applicative hiding (empty)++import Agda.Syntax.Common+import Agda.Syntax.Internal+import Agda.Syntax.Literal+import Agda.Syntax.Translation.InternalToAbstract+import Agda.Syntax.Translation.AbstractToConcrete+import qualified Agda.Syntax.Abstract as A+import qualified Agda.Syntax.Abstract.Pretty as P+import qualified Agda.Syntax.Concrete.Pretty as P++import Agda.TypeChecking.Monad++import qualified Agda.Utils.Pretty as P++---------------------------------------------------------------------------+-- * Wrappers for pretty printing combinators+---------------------------------------------------------------------------++type Doc = P.Doc++empty, comma :: MonadTCM tcm => tcm Doc++empty	   = return P.empty+comma	   = return P.comma+pretty x   = return $ P.pretty x+prettyA x  = P.prettyA x+text s	   = return $ P.text s+pwords s   = map return $ P.pwords s+fwords s   = return $ P.fwords s+sep ds	   = P.sep <$> sequence ds+fsep ds    = P.fsep <$> sequence ds+hsep ds    = P.hsep <$> sequence ds+vcat ds    = P.vcat <$> sequence ds+d1 $$ d2   = (P.$$) <$> d1 <*> d2+d1 <> d2   = (P.<>) <$> d1 <*> d2+d1 <+> d2  = (P.<+>) <$> d1 <*> d2+nest n d   = P.nest n <$> d+braces d   = P.braces <$> d+brackets d = P.brackets <$> d+parens d   = P.parens <$> d++prettyList ds = brackets $ fsep $ punctuate comma ds++punctuate _ [] = []+punctuate d ds = zipWith (<>) ds (replicate n d ++ [empty])+    where+	n = length ds - 1++---------------------------------------------------------------------------+-- * The PrettyTCM class+---------------------------------------------------------------------------++class PrettyTCM a where+    prettyTCM :: MonadTCM tcm => a -> tcm Doc++instance PrettyTCM a => PrettyTCM (Closure a) where+    prettyTCM cl = enterClosure cl prettyTCM++instance PrettyTCM a => PrettyTCM [a] where+  prettyTCM = prettyList . map prettyTCM++instance PrettyTCM Term where prettyTCM x = prettyA =<< reify x+instance PrettyTCM Type where prettyTCM x = prettyA =<< reify x+instance PrettyTCM Sort where prettyTCM x = prettyA =<< reify x+instance PrettyTCM DisplayTerm where prettyTCM x = prettyA =<< reify x++instance PrettyTCM a => PrettyTCM (Blocked a) where+  prettyTCM (Blocked x a) = text "[" <+> prettyTCM a <+> text "]" <> text (show x)+  prettyTCM (NotBlocked x) = prettyTCM x++instance (Reify a e, ToConcrete e c, P.Pretty c) => PrettyTCM (Arg a) where+    prettyTCM x = prettyA =<< reify x++instance PrettyTCM A.Expr where+    prettyTCM = prettyA++instance PrettyTCM Comparison where+  prettyTCM CmpEq  = text "=="+  prettyTCM CmpLeq = text "=<"++instance PrettyTCM Constraint where+    prettyTCM c = case c of+	ValueCmp cmp ty s t ->+	    sep [ sep [ prettyTCM s+		      , prettyTCM cmp <+> prettyTCM t+		      ]+		, nest 2 $ text ":" <+> prettyTCM ty+		]+	TypeCmp cmp a b ->+	    sep [ prettyTCM a+		, prettyTCM cmp <+> prettyTCM b+		]+	SortCmp cmp s1 s2 ->+	    sep [ prettyTCM s1+		, prettyTCM cmp <+> prettyTCM s2+		]+	Guarded c cs ->+	    sep [ prettyTCM c+		, nest 2 $ brackets $ sep $ punctuate comma $ map prettyTCM cs+		]+	UnBlock m   -> do+	    BlockedConst t <- mvInstantiation <$> lookupMeta m+	    sep [ text (show m) <+> text ":="+		, nest 2 $ prettyTCM t+		]+        IsEmpty t ->+            sep [ text "Is empty:", nest 2 $ prettyTCM t ]++instance PrettyTCM Literal where+  prettyTCM = text . show++instance PrettyTCM Name where+    prettyTCM x = P.pretty <$> abstractToConcrete_ x++instance PrettyTCM QName where+    prettyTCM x = P.pretty <$> abstractToConcrete_ x++instance PrettyTCM ModuleName where+  prettyTCM x = P.pretty <$> abstractToConcrete_ x++instance PrettyTCM Telescope where+  prettyTCM tel = P.fsep . map P.pretty <$> (do+      tel <- reify tel+      runAbsToCon $ bindToConcrete tel return+    )++newtype PrettyContext = PrettyContext Context++instance PrettyTCM PrettyContext where+  prettyTCM (PrettyContext ctx) = P.fsep . reverse <$> pr (map ctxEntry ctx)+      where+          pr []		   = return []+          pr (Arg h (x,t) : ctx) = escapeContext 1 $ do+              d    <- prettyTCM t+              x    <- prettyTCM x+              dctx <- pr ctx+              return $ par h (P.hsep [ x, P.text ":", d]) : dctx+            where+              par NotHidden = P.parens+              par Hidden    = P.braces++instance PrettyTCM Context where+  prettyTCM = prettyTCM . PrettyContext+

+ src/full/Agda/TypeChecking/Primitive.hs view

@@ -0,0 +1,392 @@+{-# LANGUAGE CPP, FlexibleInstances, UndecidableInstances,+             GeneralizedNewtypeDeriving, ScopedTypeVariables+  #-}++{-| Primitive functions, such as addition on builtin integers.+-}+module Agda.TypeChecking.Primitive where++import Control.Monad+import Data.Map (Map)+import qualified Data.Map as Map+import Data.Char++import Agda.Syntax.Position+import Agda.Syntax.Common hiding (Nat)+import Agda.Syntax.Internal+import Agda.Syntax.Literal+import Agda.Syntax.Concrete.Pretty ()+import Agda.Syntax.Abstract.Name+import qualified Agda.Syntax.Concrete.Name as C++import Agda.TypeChecking.Monad+import Agda.TypeChecking.Monad.Builtin+import Agda.TypeChecking.Reduce+import Agda.TypeChecking.Substitute+import Agda.TypeChecking.Errors+import Agda.TypeChecking.Pretty ()  -- instances only++import Agda.Utils.Monad+import Agda.Utils.Pretty (pretty)++#include "../undefined.h"+import Agda.Utils.Impossible++-- | Rewrite a literal to constructor form if possible.+constructorForm :: MonadTCM tcm => Term -> tcm Term+constructorForm v@(Lit (LitInt r n))+    | n == 0	= primZero+    | n > 0	= do+	s <- primSuc+	return $ s `apply` [Arg NotHidden $ Lit $ LitInt r $ n - 1]+    | otherwise	= return v+constructorForm v = return v++---------------------------------------------------------------------------+-- * Primitive functions+---------------------------------------------------------------------------++data PrimitiveImpl = PrimImpl Type PrimFun++-- Haskell type to Agda type++newtype Str = Str { unStr :: String }+    deriving (Eq, Ord)++newtype Nat = Nat { unNat :: Integer }+    deriving (Eq, Ord, Num, Integral, Enum, Real)++instance Show Nat where+    show = show . unNat++class PrimType a where+    primType :: MonadTCM tcm => a -> tcm Type++instance (PrimType a, PrimType b) => PrimTerm (a -> b) where+    primTerm _ = unEl <$> (primType (undefined :: a) --> primType (undefined :: b))++instance PrimTerm a => PrimType a where+    primType _ = el $ primTerm (undefined :: a)++class	 PrimTerm a	  where primTerm :: MonadTCM tcm => a -> tcm Term+instance PrimTerm Integer where primTerm _ = primInteger+instance PrimTerm Bool	  where primTerm _ = primBool+instance PrimTerm Char	  where primTerm _ = primChar+instance PrimTerm Double  where primTerm _ = primFloat+instance PrimTerm Str	  where primTerm _ = primString+instance PrimTerm Nat	  where primTerm _ = primNat++instance PrimTerm a => PrimTerm [a] where+    primTerm _ = list (primTerm (undefined :: a))++instance PrimTerm a => PrimTerm (IO a) where+    primTerm _ = io (primTerm (undefined :: a))++-- From Agda term to Haskell value++class ToTerm a where+    toTerm :: MonadTCM tcm => tcm (a -> Term)++instance ToTerm Integer where toTerm = return $ Lit . LitInt noRange+instance ToTerm Nat	where toTerm = return $ Lit . LitInt noRange . unNat+instance ToTerm Double  where toTerm = return $ Lit . LitFloat noRange+instance ToTerm Char	where toTerm = return $ Lit . LitChar noRange+instance ToTerm Str	where toTerm = return $ Lit . LitString noRange . unStr++instance ToTerm Bool where+    toTerm = do+	true  <- primTrue+	false <- primFalse+	return $ \b -> if b then true else false++-- | @buildList A ts@ builds a list of type @List A@. Assumes that the terms+--   @ts@ all have type @A@.+buildList :: MonadTCM tcm => Term -> tcm ([Term] -> Term)+buildList a = do+    nil'  <- primNil+    cons' <- primCons+    let nil       = nil'  `apply` [Arg Hidden a]+	cons x xs = cons' `apply` [Arg Hidden a, Arg NotHidden x, Arg NotHidden xs]+    return $ foldr cons nil++instance (PrimTerm a, ToTerm a) => ToTerm [a] where+    toTerm = do+	a      <- primTerm (undefined :: a)+	mkList <- buildList a+	fromA  <- toTerm+	return $ mkList . map fromA++-- From Haskell value to Agda term++type FromTermFunction a = Arg Term -> TCM (Reduced (Arg Term) a)++class FromTerm a where+    fromTerm :: MonadTCM tcm => tcm (FromTermFunction a)++instance FromTerm Integer where+    fromTerm = fromLiteral $ \l -> case l of+	LitInt _ n -> Just n+	_	   -> Nothing++instance FromTerm Nat where+    fromTerm = fromLiteral $ \l -> case l of+	LitInt _ n -> Just $ Nat n+	_	   -> Nothing++instance FromTerm Double where+    fromTerm = fromLiteral $ \l -> case l of+	LitFloat _ x -> Just x+	_	     -> Nothing++instance FromTerm Char where+    fromTerm = fromLiteral $ \l -> case l of+	LitChar _ c -> Just c+	_	    -> Nothing++instance FromTerm Str where+    fromTerm = fromLiteral $ \l -> case l of+	LitString _ s -> Just $ Str s+	_	      -> Nothing++instance FromTerm Bool where+    fromTerm = do+	true  <- primTrue+	false <- primFalse+	fromReducedTerm $ \t -> case t of+	    _	| t === true  -> Just True+		| t === false -> Just False+		| otherwise   -> Nothing+	where+	    Def x [] === Def y []   = x == y+	    Con x [] === Con y []   = x == y+	    Var n [] === Var m []   = n == m+	    _	     === _	    = False++instance (ToTerm a, FromTerm a) => FromTerm [a] where+    fromTerm = do+	nil'  <- primNil+	cons' <- primCons+	nil   <- isCon nil'+	cons  <- isCon cons'+	toA   <- fromTerm+	fromA <- toTerm+	return $ mkList nil cons toA fromA+	where+	    isCon (Lam _ b) = isCon $ absBody b+	    isCon (Con c _) = return c+	    isCon v	    = do+		d <- prettyTCM v+		typeError $ GenericError $ "expected constructor in built-in binding to " ++ show d+				-- TODO: check this when binding the things++	    mkList nil cons toA fromA t = do+		t <- reduce t+		let arg = Arg (argHiding t)+		case unArg t of+		    Con c []+			| c == nil  -> return $ YesReduction []+		    Con c [x,xs]+			| c == cons ->+			    redBind (toA x)+				(\x' -> arg $ Con c [x',xs]) $ \y ->+			    redBind+				(mkList nil cons toA fromA xs)+				(\xs' -> arg $ Con c [Arg NotHidden $ fromA y, xs']) $ \ys ->+			    redReturn (y : ys)+		    _ -> return $ NoReduction t++-- | Conceptually: @redBind m f k = either (return . Left . f) k =<< m@+redBind :: MonadTCM tcm => tcm (Reduced a a') -> (a -> b) -> +	     (a' -> tcm (Reduced b b')) -> tcm (Reduced b b')+redBind ma f k = do+    r <- ma+    case r of+	NoReduction x	-> return $ NoReduction $ f x+	YesReduction y	-> k y++redReturn :: MonadTCM tcm => a -> tcm (Reduced a' a)+redReturn = return . YesReduction++fromReducedTerm :: MonadTCM tcm => (Term -> Maybe a) -> tcm (FromTermFunction a)+fromReducedTerm f = return $ \t -> do+    t <- reduce t+    case f $ unArg t of+	Just x	-> return $ YesReduction x+	Nothing	-> return $ NoReduction t++fromLiteral :: MonadTCM tcm => (Literal -> Maybe a) -> tcm (FromTermFunction a)+fromLiteral f = fromReducedTerm $ \t -> case t of+    Lit lit -> f lit+    _	    -> Nothing++-- Tying the knot+mkPrimFun1 :: (MonadTCM tcm, PrimType a, PrimType b, FromTerm a, ToTerm b) =>+	      (a -> b) -> tcm PrimitiveImpl+mkPrimFun1 f = do+    toA   <- fromTerm+    fromB <- toTerm+    t	  <- primType f+    return $ PrimImpl t $ PrimFun __IMPOSSIBLE__ 1 $ \[v] -> liftTCM $+	redBind (toA v)+	    (\v' -> [v']) $ \x ->+	redReturn $ fromB $ f x++mkPrimFun2 :: (MonadTCM tcm, PrimType a, PrimType b, PrimType c, FromTerm a, ToTerm a, FromTerm b, ToTerm c) =>+	      (a -> b -> c) -> tcm PrimitiveImpl+mkPrimFun2 f = do+    toA   <- fromTerm+    fromA <- toTerm+    toB	  <- fromTerm+    fromC <- toTerm+    t	  <- primType f+    return $ PrimImpl t $ PrimFun __IMPOSSIBLE__ 2 $ \[v,w] -> liftTCM $+	redBind (toA v)+	    (\v' -> [v',w]) $ \x ->+	redBind (toB w)+	    (\w' -> [Arg (argHiding v) (fromA x), w']) $ \y ->+	redReturn $ fromC $ f x y++-- Abstract primitive functions+abstractPrim :: (MonadTCM tcm, PrimType a) => a -> tcm PrimitiveImpl+abstractPrim x = abstractFromType (primType x)++abstractFromType :: MonadTCM tcm => tcm Type -> tcm PrimitiveImpl+abstractFromType mt = do+    t <- mt+    return $ PrimImpl t $ PrimFun __IMPOSSIBLE__ (arity t) $ \args -> NoReduction <$> normalise args++-- Type combinators+infixr 4 -->++(-->) :: MonadTCM tcm => tcm Type -> tcm Type -> tcm Type+a --> b = do+    a' <- a+    b' <- b+    return $ El (getSort a' `sLub` getSort b') $ Fun (Arg NotHidden a') b'++gpi :: MonadTCM tcm => Hiding -> String -> tcm Type -> tcm Type -> tcm Type+gpi h name a b = do+    a' <- a+    x  <- freshName_ name+    b' <- addCtx x (Arg h a') b+    return $ El (getSort a' `sLub` getSort b') $ Pi (Arg h a') (Abs name b')++hPi, nPi :: MonadTCM tcm => String -> tcm Type -> tcm Type -> tcm Type+hPi = gpi Hidden+nPi = gpi NotHidden++var :: MonadTCM tcm => Integer -> tcm Term+var n = return $ Var n []++infixl 9 <@>, <#>++gApply :: MonadTCM tcm => Hiding -> tcm Term -> tcm Term -> tcm Term+gApply h a b = do+    x <- a+    y <- b+    return $ x `apply` [Arg h y]++(<@>),(<#>) :: MonadTCM tcm => tcm Term -> tcm Term -> tcm Term+(<@>) = gApply NotHidden+(<#>) = gApply Hidden++list :: MonadTCM tcm => tcm Term -> tcm Term+list t = primList <@> t++io :: MonadTCM tcm => tcm Term -> tcm Term+io t = primIO <@> t++el :: MonadTCM tcm => tcm Term -> tcm Type+el t = El (Type 0) <$> t++tset :: MonadTCM tcm => tcm Type+tset = return $ sort (Type 0)++---------------------------------------------------------------------------+-- * The actual primitive functions+---------------------------------------------------------------------------++type Op   a = a -> a -> a+type Fun  a = a -> a+type Rel  a = a -> a -> Bool+type Pred a = a -> Bool++primitiveFunctions :: Map String (TCM PrimitiveImpl)+primitiveFunctions = Map.fromList++    -- Integer functions+    [ "primIntegerPlus"	    |-> mkPrimFun2 ((+)	       :: Op Integer)+    , "primIntegerMinus"    |-> mkPrimFun2 ((-)	       :: Op Integer)+    , "primIntegerTimes"    |-> mkPrimFun2 ((*)	       :: Op Integer)+    , "primIntegerDiv"	    |-> mkPrimFun2 (div	       :: Op Integer)    -- partial+    , "primIntegerMod"	    |-> mkPrimFun2 (mod	       :: Op Integer)    -- partial+    , "primIntegerEquality" |-> mkPrimFun2 ((==)       :: Rel Integer)+    , "primIntegerLess"	    |-> mkPrimFun2 ((<)	       :: Rel Integer)+    , "primIntegerAbs"      |-> mkPrimFun1 (Nat . abs  :: Integer -> Nat)+    , "primNatToInteger"    |-> mkPrimFun1 (unNat      :: Nat -> Integer)+    , "primShowInteger"	    |-> mkPrimFun1 (Str . show :: Integer -> Str)++    -- Natural number functions+    , "primNatPlus"	    |-> mkPrimFun2 ((+)			    :: Op Nat)+    , "primNatMinus"	    |-> mkPrimFun2 ((\x y -> max 0 (x - y)) :: Op Nat)+    , "primNatTimes"	    |-> mkPrimFun2 ((*)			    :: Op Nat)+    , "primNatDivSuc"	    |-> mkPrimFun2 ((\x y -> div x (y + 1)) :: Op Nat)+    , "primNatModSuc"	    |-> mkPrimFun2 ((\x y -> mod x (y + 1)) :: Op Nat)+    , "primNatEquality"	    |-> mkPrimFun2 ((==)		    :: Rel Nat)+    , "primNatLess"	    |-> mkPrimFun2 ((<)			    :: Rel Nat)++    -- Floating point functions+    , "primIntegerToFloat"  |-> mkPrimFun1 (fromIntegral :: Integer -> Double)+    , "primFloatPlus"	    |-> mkPrimFun2 ((+)		 :: Op Double)+    , "primFloatMinus"	    |-> mkPrimFun2 ((-)		 :: Op Double)+    , "primFloatTimes"	    |-> mkPrimFun2 ((*)		 :: Op Double)+    , "primFloatDiv"	    |-> mkPrimFun2 ((/)		 :: Op Double)+    , "primFloatLess"	    |-> mkPrimFun2 ((<)		 :: Rel Double)+    , "primRound"	    |-> mkPrimFun1 (round	 :: Double -> Integer)+    , "primFloor"	    |-> mkPrimFun1 (floor	 :: Double -> Integer)+    , "primCeiling"	    |-> mkPrimFun1 (ceiling	 :: Double -> Integer)+    , "primExp"		    |-> mkPrimFun1 (exp		 :: Fun Double)+    , "primLog"		    |-> mkPrimFun1 (log		 :: Fun Double)    -- partial+    , "primSin"		    |-> mkPrimFun1 (sin		 :: Fun Double)+    , "primShowFloat"	    |-> mkPrimFun1 (Str . show	 :: Double -> Str)++    -- Character functions+    , "primCharEquality"    |-> mkPrimFun2 ((==) :: Rel Char)+    , "primIsLower"	    |-> mkPrimFun1 isLower+    , "primIsDigit"	    |-> mkPrimFun1 isDigit+    , "primIsAlpha"	    |-> mkPrimFun1 isAlpha+    , "primIsSpace"	    |-> mkPrimFun1 isSpace+    , "primIsAscii"	    |-> mkPrimFun1 isAscii+    , "primIsLatin1"	    |-> mkPrimFun1 isLatin1+    , "primIsPrint"	    |-> mkPrimFun1 isPrint+    , "primIsHexDigit"	    |-> mkPrimFun1 isHexDigit+    , "primToUpper"	    |-> mkPrimFun1 toUpper+    , "primToLower"	    |-> mkPrimFun1 toLower+    , "primCharToNat"       |-> mkPrimFun1 (fromIntegral . fromEnum :: Char -> Nat)+    , "primNatToChar"       |-> mkPrimFun1 (toEnum . fromIntegral   :: Nat -> Char)+    , "primShowChar"	    |-> mkPrimFun1 (Str . show . pretty . LitChar noRange)++    -- String functions+    , "primStringToList"    |-> mkPrimFun1 unStr+    , "primStringFromList"  |-> mkPrimFun1 Str+    , "primStringAppend"    |-> mkPrimFun2 (\s1 s2 -> Str $ unStr s1 ++ unStr s2)+    , "primStringEquality"  |-> mkPrimFun2 ((==) :: Rel Str)+    , "primShowString"	    |-> mkPrimFun1 (Str . show . pretty . LitString noRange . unStr)+    ]+    where+	(|->) = (,)++lookupPrimitiveFunction :: MonadTCM tcm => String -> tcm PrimitiveImpl+lookupPrimitiveFunction x =+    case Map.lookup x primitiveFunctions of+	Just p	-> liftTCM p+	Nothing	-> typeError $ NoSuchPrimitiveFunction x++-- | Rebind a primitive. Assumes everything is type correct. Used when+--   importing a module with primitives.+rebindPrimitive :: MonadTCM tcm => String -> tcm PrimFun+rebindPrimitive x = do+    PrimImpl _ pf <- lookupPrimitiveFunction x+    bindPrimitive x pf+    return pf+

+ src/full/Agda/TypeChecking/Rebind.hs view

@@ -0,0 +1,31 @@+{-# LANGUAGE CPP #-}++module Agda.TypeChecking.Rebind where++import Agda.Syntax.Internal+import Agda.TypeChecking.Free+import Agda.TypeChecking.Reduce+import Agda.TypeChecking.Monad+import Agda.TypeChecking.Substitute++#include "../undefined.h"+import Agda.Utils.Impossible++-- | Change 'Bind's to 'NoBind' if the variable is not used in the body.+--   Also normalises the body in the process. Or not. Disabled.+rebindClause :: Clause -> TCM Clause+rebindClause = return+{-+rebindClause (Clause tel perm ps rec b) = return $ Clause tel perm ps rec b+  do+    b <- instantiateFull b+    return $ Clause ps $ rebind b+    where+	rebind (Body t) = Body t+	rebind (Bind b)+	    | 0 `freeIn` absBody b  = Bind $ fmap rebind b+	    | otherwise		    = NoBind $ b `absApp` __IMPOSSIBLE__+	rebind (NoBind b) = NoBind $ rebind b+	rebind  NoBody	  = NoBody+-}+

+ src/full/Agda/TypeChecking/Records.hs view

@@ -0,0 +1,101 @@+{-# LANGUAGE CPP #-}++module Agda.TypeChecking.Records where++import Control.Applicative+import Control.Monad+import Data.List++import Agda.Syntax.Common+import qualified Agda.Syntax.Concrete.Name as C+import Agda.Syntax.Abstract.Name+import Agda.Syntax.Internal+import Agda.TypeChecking.Monad+import Agda.TypeChecking.Substitute+import Agda.TypeChecking.Pretty+import Agda.Utils.List++#include "../undefined.h"+import Agda.Utils.Impossible++-- | Order the fields of a record construction.+--   Use the second argument for missing fields.+orderFields :: MonadTCM tcm => QName -> a -> [C.Name] -> [(C.Name, a)] -> tcm [a]+orderFields r def xs fs = do+  shouldBeNull (ys \\ nub ys) $ DuplicateFields . nub+  shouldBeNull (ys \\ xs)     $ TooManyFields r+  -- shouldBeNull (xs \\ ys)     $ TooFewFields r+  return $ order xs fs+  where+    ys = map fst fs++    shouldBeNull [] err = return ()+    shouldBeNull xs err = typeError $ err xs++    -- invariant: the first list contains at least the fields of the second list+    order [] [] = []+    order [] _  = __IMPOSSIBLE__+    order (x : xs) ys = case lookup x (assocHoles ys) of+      Just (e, ys') -> e : order xs ys'+      Nothing       -> def : order xs ys++    assocHoles xs = [ (x, (v, xs')) | ((x, v), xs') <- holes xs ]++-- | The name of the module corresponding to a record.+recordModule :: QName -> ModuleName+recordModule = mnameFromList . qnameToList++-- | Get the definition for a record. Throws an exception if the name+--   does not refer to a record.+getRecordDef :: MonadTCM tcm => QName -> tcm Defn+getRecordDef r = do+  def <- theDef <$> getConstInfo r+  case def of+    Record{} -> return def+    _        -> typeError $ ShouldBeRecordType (El Prop $ Def r [])++-- | Get the field names of a record.+getRecordFieldNames :: MonadTCM tcm => QName -> tcm [C.Name]+getRecordFieldNames r = map (nameConcrete . qnameName) . recFields <$> getRecordDef r++-- | Get the field types of a record.+getRecordFieldTypes :: MonadTCM tcm => QName -> tcm Telescope+getRecordFieldTypes r = recTel <$> getRecordDef r++-- | Get the type of the record constructor.+getRecordConstructorType :: MonadTCM tcm => QName -> [Arg Term] -> tcm Type+getRecordConstructorType r pars = do+  Record{ recTel = tel, recSort = s} <- getRecordDef r+  return $ telePi (apply tel pars) $ El s $ Def r pars++-- | Check if a name refers to a record.+isRecord :: MonadTCM tcm => QName -> tcm Bool+isRecord r = do+  def <- theDef <$> getConstInfo r+  return $ case def of+    Record{} -> True+    _        -> False++{-| Compute the eta expansion of a record. The first argument should be+    the name of a record type. Given++    @record R : Set where x : A; y : B@++    and @r : R@, @etaExpand R [] r@ is @[R.x r, R.y r]@+-}+etaExpandRecord :: MonadTCM tcm => QName -> Args -> Term -> tcm (Telescope, Args)+etaExpandRecord r pars u = do+  Record{ recFields = xs, recTel = tel } <- getRecordDef r+  let tel'   = apply tel pars+      proj x = Arg NotHidden $ Def x $ map hide pars ++ [Arg NotHidden u]+  reportSDoc "tc.record.eta" 20 $ vcat+    [ text "eta expanding" <+> prettyTCM u <+> text ":" <+> prettyTCM r+    , nest 2 $ vcat+      [ text "tel' =" <+> prettyTCM tel'+      , text "args =" <+> prettyTCM (map proj xs)+      ]+    ]+  return (tel', map proj xs)+  where+    hide (Arg _ x) = Arg Hidden x+

+ src/full/Agda/TypeChecking/Records.hs-boot view

@@ -0,0 +1,9 @@++module Agda.TypeChecking.Records where++import Agda.Syntax.Abstract.Name+import qualified Agda.Syntax.Concrete.Name as C+import Agda.TypeChecking.Monad++isRecord :: MonadTCM tcm => QName -> tcm Bool+getRecordFieldNames :: MonadTCM tcm => QName -> tcm [C.Name]

+ src/full/Agda/TypeChecking/Reduce.hs view

@@ -0,0 +1,533 @@+{-# LANGUAGE CPP #-}++module Agda.TypeChecking.Reduce where++import Prelude hiding (mapM)+import Control.Monad.State hiding (mapM)+import Control.Monad.Reader hiding (mapM)+import Control.Applicative+import Data.List as List hiding (sort)+import Data.Map as Map+import Data.Generics+import Data.Traversable++import Agda.Syntax.Position+import Agda.Syntax.Common+import Agda.Syntax.Internal+import Agda.Syntax.Scope.Base (Scope)+import Agda.Syntax.Literal++import Agda.TypeChecking.Monad+import Agda.TypeChecking.Monad.Context+import Agda.TypeChecking.Monad.Builtin+import Agda.TypeChecking.Substitute++import {-# SOURCE #-} Agda.TypeChecking.Patterns.Match++import Agda.Utils.Monad++#include "../undefined.h"+import Agda.Utils.Impossible++-- | Instantiate something.+--   Results in an open meta variable or a non meta.+--   Doesn't do any reduction, and preserves blocking tags (when blocking meta+--   is uninstantiated).+class Instantiate t where+    instantiate :: MonadTCM tcm => t -> tcm t++instance Instantiate Term where+    instantiate t@(MetaV x args) =+	do  mi <- mvInstantiation <$> lookupMeta x+	    case mi of+		InstV a                        -> instantiate $ a `apply` args+		Open                           -> return t+		BlockedConst _                 -> return t+                PostponedTypeCheckingProblem _ -> return t+		InstS _                        -> __IMPOSSIBLE__+    instantiate t = return t++instance Instantiate a => Instantiate (Blocked a) where+  instantiate v@NotBlocked{} = return v+  instantiate v@(Blocked x u) = do+    mi <- mvInstantiation <$> lookupMeta x+    case mi of+      InstV _                        -> notBlocked <$> instantiate u+      Open                           -> return v+      BlockedConst _                 -> return v+      PostponedTypeCheckingProblem _ -> return v+      InstS _                        -> __IMPOSSIBLE__++instance Instantiate Type where+    instantiate (El s t) = El s <$> instantiate t++instance Instantiate Sort where+    instantiate s = case s of+	MetaS x -> do+	    mi <- mvInstantiation <$> lookupMeta x+	    case mi of+		InstS s'                       -> instantiate s'+		Open                           -> return s+		InstV{}                        -> __IMPOSSIBLE__+		BlockedConst{}                 -> __IMPOSSIBLE__+                PostponedTypeCheckingProblem{} -> __IMPOSSIBLE__+	Type _	  -> return s+	Prop	  -> return s+	Suc s	  -> sSuc <$> instantiate s+	Lub s1 s2 -> sLub <$> instantiate s1 <*> instantiate s2++instance Instantiate t => Instantiate (Arg t) where+    instantiate = traverse instantiate++instance Instantiate t => Instantiate [t] where+    instantiate = traverse instantiate++instance (Instantiate a, Instantiate b) => Instantiate (a,b) where+    instantiate (x,y) = (,) <$> instantiate x <*> instantiate y+++instance (Instantiate a, Instantiate b,Instantiate c) => Instantiate (a,b,c) where+    instantiate (x,y,z) = (,,) <$> instantiate x <*> instantiate y <*> instantiate z++++instance Instantiate a => Instantiate (Closure a) where+    instantiate cl = do+	x <- enterClosure cl instantiate+	return $ cl { clValue = x }++instance Instantiate Constraint where+    instantiate (ValueCmp cmp t u v) =+	do  (t,u,v) <- instantiate (t,u,v)+	    return $ ValueCmp cmp t u v+    instantiate (TypeCmp cmp a b) = uncurry (TypeCmp cmp) <$> instantiate (a,b)+    instantiate (SortCmp cmp a b) = uncurry (SortCmp cmp) <$> instantiate (a,b)+    instantiate (Guarded c cs)    = uncurry Guarded <$> instantiate (c,cs)+    instantiate (UnBlock m)       = return $ UnBlock m+    instantiate (IsEmpty t)       = IsEmpty <$> instantiate t++instance (Ord k, Instantiate e) => Instantiate (Map k e) where+    instantiate = traverse instantiate+++--+-- Reduction to weak head normal form.+--++class Reduce t where+    reduce  :: MonadTCM tcm => t -> tcm t+    reduceB :: MonadTCM tcm => t -> tcm (Blocked t)++    reduce  t = ignoreBlocking <$> reduceB t+    reduceB t = notBlocked <$> reduce t++instance Reduce Type where+    reduce (El s t) = El <$> reduce s <*> reduce t+    reduceB (El s t) = do+      s <- reduce s+      t <- reduceB t+      return (El s <$> t)++instance Reduce Sort where+    reduce s =+	{-# SCC "reduce<Sort>" #-}+	do  s <- instantiate s+	    case s of+		Suc s'	  -> sSuc <$> reduce s'+		Lub s1 s2 -> sLub <$> reduce s1 <*> reduce s2+		Prop	  -> return s+		Type _	  -> return s+		MetaS _   -> return s++-- Lists are never blocked+instance Reduce t => Reduce [t] where+    reduce = traverse reduce++instance Reduce t => Reduce (Arg t) where+    reduce  = traverse reduce+    reduceB t = traverse id <$> traverse reduceB t++-- Tuples are never blocked+instance (Reduce a, Reduce b) => Reduce (a,b) where+    reduce (x,y)  = (,) <$> reduce x <*> reduce y++instance (Reduce a, Reduce b,Reduce c) => Reduce (a,b,c) where+    reduce (x,y,z) = (,,) <$> reduce x <*> reduce y <*> reduce z++instance Reduce Term where+    reduceB v =+	{-# SCC "reduce<Term>" #-}+	do  v <- instantiate v+	    case v of+		MetaV x args -> notBlocked . MetaV x <$> reduce args+		Def f args   -> unfoldDefinition False reduceB (Def f []) f args+		Con c args   -> do+                    -- Constructors can reduce when they come from an+                    -- instantiated module.+		    v <- unfoldDefinition False reduceB (Con c []) c args+		    traverse reduceNat v+		Sort s	   -> fmap Sort <$> reduceB s+		Pi _ _	   -> return $ notBlocked v+		Fun _ _    -> return $ notBlocked v+		Lit _	   -> return $ notBlocked v+		Var _ _    -> return $ notBlocked v+		Lam _ _    -> return $ notBlocked v+	where+	    reduceNat v@(Con c []) = do+		mz <- getBuiltin' builtinZero+		case mz of+		    Just (Con z []) | c == z -> return $ Lit $ LitInt (getRange c) 0+		    _			     -> return v+	    reduceNat v@(Con c [Arg NotHidden w]) = do+		ms <- getBuiltin' builtinSuc+		case ms of+		    Just (Con s []) | c == s -> do+			w <- reduce w+			case w of+			    Lit (LitInt r n) -> return $ Lit $ LitInt (fuseRange c r) $ n + 1+			    _		     -> return $ Con c [Arg NotHidden w]+		    _	-> return v+	    reduceNat v = return v++-- | If the first argument is 'True', then a single delayed clause may+-- be unfolded.+unfoldDefinition :: MonadTCM tcm =>+  Bool -> (Term -> tcm (Blocked Term)) ->+  Term -> QName -> Args -> tcm (Blocked Term)+unfoldDefinition unfoldDelayed keepGoing v0 f args =+    {-# SCC "reduceDef" #-}+    do  info <- getConstInfo f+        case theDef info of+            Constructor{conSrcCon = c} ->+              return $ notBlocked $ Con (c `withRangeOf` f) args+            Primitive ConcreteDef x cls -> do+                pf <- getPrimitive x+                reducePrimitive x v0 f args pf (defDelayed info) cls+            _  -> reduceNormal v0 f args (defDelayed info) (defClauses info)+  where+    reducePrimitive x v0 f args pf delayed cls+        | n < ar    = return $ notBlocked $ v0 `apply` args -- not fully applied+        | otherwise = do+            let (args1,args2) = genericSplitAt ar args+            r <- def args1+            case r of+                NoReduction args1' -> reduceNormal v0 f (args1' ++ args2)+                                                   delayed cls+                YesReduction v	   -> keepGoing $ v `apply` args2+        where+            n	= genericLength args+            ar  = primFunArity pf+            def = primFunImplementation pf++    reduceNormal v0 f args delayed def = do+        case (delayed, def) of+            (Delayed, _) | not unfoldDelayed -> defaultResult+            (_, []) -> defaultResult -- no definition for head+            (_, cls@(Clause{ clausePats = ps } : _))+                | length ps <= length args ->+                    do  let (args1,args2) = splitAt (length ps) args +                        ev <- appDef v0 cls args1+                        case ev of+                            NoReduction  v -> return    $ v `apply` args2+                            YesReduction v -> keepGoing $ v `apply` args2+                | otherwise	-> defaultResult -- partial application+      where defaultResult = return $ notBlocked $ v0 `apply` args++    -- Apply a defined function to it's arguments.+    --   The original term is the first argument applied to the third.+    appDef :: MonadTCM tcm => Term -> [Clause] -> Args -> tcm (Reduced (Blocked Term) Term)+    appDef v cls args = goCls cls args where++        goCls :: MonadTCM tcm => [Clause] -> Args -> tcm (Reduced (Blocked Term) Term)+        goCls [] args = typeError $ IncompletePatternMatching v args+        goCls (cl@(Clause { clausePats = pats+                          , clauseBody = body }) : cls) args = do+            (m, args) <- matchPatterns pats args+            case m of+                No		  -> goCls cls args+                DontKnow Nothing  -> return $ NoReduction $ notBlocked $ v `apply` args+                DontKnow (Just m) -> return $ NoReduction $ blocked m $ v `apply` args+                Yes args'+                  | hasBody body  -> return $ YesReduction (+                      -- TODO: let matchPatterns also return the reduced forms +                      -- of the original arguments!+                      app args' body)+                  | otherwise	  -> return $ NoReduction $ notBlocked $ v `apply` args++        hasBody (Body _)	 = True+        hasBody NoBody		 = False+        hasBody (Bind (Abs _ b)) = hasBody b+        hasBody (NoBind b)	 = hasBody b++        app []		 (Body v')	     = v'+        app (arg : args) (Bind (Abs _ body)) = app args $ subst arg body -- CBN+        app (_   : args) (NoBind body)	     = app args body+        app  _		  NoBody	     = __IMPOSSIBLE__+        app (_ : _)	 (Body _)	     = __IMPOSSIBLE__+        app []		 (Bind _)	     = __IMPOSSIBLE__+        app []		 (NoBind _)	     = __IMPOSSIBLE__+++instance Reduce a => Reduce (Closure a) where+    reduce cl = do+	x <- enterClosure cl reduce+	return $ cl { clValue = x }++instance Reduce Constraint where+    reduce (ValueCmp cmp t u v) =+	do  (t,u,v) <- reduce (t,u,v)+	    return $ ValueCmp cmp t u v+    reduce (TypeCmp cmp a b) = uncurry (TypeCmp cmp) <$> reduce (a,b)+    reduce (SortCmp cmp a b) = uncurry (SortCmp cmp) <$> reduce (a,b)+    reduce (Guarded c cs)    = uncurry Guarded <$> reduce (c,cs)+    reduce (UnBlock m)       = return $ UnBlock m+    reduce (IsEmpty t)       = IsEmpty <$> reduce t++instance (Ord k, Reduce e) => Reduce (Map k e) where+    reduce = traverse reduce++---------------------------------------------------------------------------+-- * Normalisation+---------------------------------------------------------------------------++class Normalise t where+    normalise :: MonadTCM tcm => t -> tcm t++instance Normalise Sort where+    normalise = reduce++instance Normalise Type where+    normalise (El s t) = El <$> normalise s <*> normalise t++instance Normalise Term where+    normalise v =+	do  v <- reduce v+	    case v of+		Var n vs    -> Var n <$> normalise vs+		Con c vs    -> Con c <$> normalise vs+		Def f vs    -> Def f <$> normalise vs+		MetaV x vs  -> MetaV x <$> normalise vs+		Lit _	    -> return v+		Lam h b	    -> Lam h <$> normalise b+		Sort s	    -> Sort <$> normalise s+		Pi a b	    -> uncurry Pi <$> normalise (a,b)+		Fun a b     -> uncurry Fun <$> normalise (a,b)++instance Normalise ClauseBody where+    normalise (Body   t) = Body   <$> normalise t+    normalise (Bind   b) = Bind   <$> normalise b+    normalise (NoBind b) = NoBind <$> normalise b+    normalise  NoBody	 = return NoBody++instance Normalise t => Normalise (Abs t) where+    normalise a = Abs (absName a) <$> underAbstraction_ a normalise++instance Normalise t => Normalise (Arg t) where+    normalise = traverse normalise++instance Normalise t => Normalise [t] where+    normalise = traverse normalise++instance (Normalise a, Normalise b) => Normalise (a,b) where+    normalise (x,y) = (,) <$> normalise x <*> normalise y++instance (Normalise a, Normalise b, Normalise c) => Normalise (a,b,c) where+    normalise (x,y,z) =+	do  (x,(y,z)) <- normalise (x,(y,z))+	    return (x,y,z)++instance Normalise a => Normalise (Closure a) where+    normalise cl = do+	x <- enterClosure cl normalise+	return $ cl { clValue = x }++instance Normalise Constraint where+    normalise (ValueCmp cmp t u v) =+	do  (t,u,v) <- normalise (t,u,v)+	    return $ ValueCmp cmp t u v+    normalise (TypeCmp cmp a b) = uncurry (TypeCmp cmp) <$> normalise (a,b)+    normalise (SortCmp cmp a b) = uncurry (SortCmp cmp) <$> normalise (a,b)+    normalise (Guarded c cs)    = uncurry Guarded <$> normalise (c,cs)+    normalise (UnBlock m)       = return $ UnBlock m+    normalise (IsEmpty t)       = IsEmpty <$> normalise t++instance Normalise Pattern where+  normalise p = case p of+    VarP _    -> return p+    LitP _    -> return p+    ConP c ps -> ConP c <$> normalise ps+    DotP v    -> DotP <$> normalise v++instance Normalise DisplayForm where+  normalise (Display n ps v) = Display n <$> normalise ps <*> return v++instance (Ord k, Normalise e) => Normalise (Map k e) where+    normalise = traverse normalise+++---------------------------------------------------------------------------+-- * Full instantiation+---------------------------------------------------------------------------++-- Full instantiatiation = normalisation [ instantiate / reduce ]+-- How can we express this? We need higher order classes!++class InstantiateFull t where+    instantiateFull :: MonadTCM tcm => t -> tcm t++instance InstantiateFull Name where+    instantiateFull = return++instance InstantiateFull Sort where+    instantiateFull s = do+	s <- instantiate s+	case s of+	    MetaS x   -> return $ MetaS x+	    Type _    -> return s+	    Prop      -> return s+	    Suc s     -> sSuc <$> instantiateFull s+	    Lub s1 s2 -> sLub <$> instantiateFull s1 <*> instantiateFull s2++instance InstantiateFull Type where+    instantiateFull (El s t) = El <$> instantiateFull s <*> instantiateFull t++instance InstantiateFull Term where+    instantiateFull v =+	do  v <- instantiate v+	    case v of+		Var n vs   -> Var n <$> instantiateFull vs+		Con c vs   -> Con c <$> instantiateFull vs+		Def f vs   -> Def f <$> instantiateFull vs+		MetaV x vs -> MetaV x <$> instantiateFull vs+		Lit _	   -> return v+		Lam h b    -> Lam h <$> instantiateFull b+		Sort s	   -> Sort <$> instantiateFull s+		Pi a b	   -> uncurry Pi <$> instantiateFull (a,b)+		Fun a b    -> uncurry Fun <$> instantiateFull (a,b)++instance InstantiateFull ClauseBody where+    instantiateFull (Body   t) = Body   <$> instantiateFull t+    instantiateFull (Bind   b) = Bind   <$> instantiateFull b+    instantiateFull (NoBind b) = NoBind <$> instantiateFull b+    instantiateFull  NoBody    = return NoBody++instance InstantiateFull t => InstantiateFull (Abs t) where+    instantiateFull a = Abs (absName a) <$> underAbstraction_ a instantiateFull++instance InstantiateFull t => InstantiateFull (Arg t) where+    instantiateFull = traverse instantiateFull++instance InstantiateFull t => InstantiateFull [t] where+    instantiateFull = traverse instantiateFull++instance (InstantiateFull a, InstantiateFull b) => InstantiateFull (a,b) where+    instantiateFull (x,y) = (,) <$> instantiateFull x <*> instantiateFull y++instance (InstantiateFull a, InstantiateFull b, InstantiateFull c) => InstantiateFull (a,b,c) where+    instantiateFull (x,y,z) =+	do  (x,(y,z)) <- instantiateFull (x,(y,z))+	    return (x,y,z)++instance InstantiateFull a => InstantiateFull (Closure a) where+    instantiateFull cl = do+	x <- enterClosure cl instantiateFull+	return $ cl { clValue = x }++instance InstantiateFull Constraint where+    instantiateFull (ValueCmp cmp t u v) =+	do  (t,u,v) <- instantiateFull (t,u,v)+	    return $ ValueCmp cmp t u v+    instantiateFull (TypeCmp cmp a b) = uncurry (TypeCmp cmp) <$> instantiateFull (a,b)+    instantiateFull (SortCmp cmp a b) = uncurry (SortCmp cmp) <$> instantiateFull (a,b)+    instantiateFull (Guarded c cs)    = uncurry Guarded <$> instantiateFull (c,cs)+    instantiateFull (UnBlock m)       = return $ UnBlock m+    instantiateFull (IsEmpty t)       = IsEmpty <$> instantiateFull t++instance (Ord k, InstantiateFull e) => InstantiateFull (Map k e) where+    instantiateFull = traverse instantiateFull++instance InstantiateFull ModuleName where+    instantiateFull = return++instance InstantiateFull Scope where+    instantiateFull = return++instance InstantiateFull Signature where+  instantiateFull (Sig a b) = uncurry Sig <$> instantiateFull (a, b)++instance InstantiateFull Section where+  instantiateFull (Section tel n) = flip Section n <$> instantiateFull tel++instance InstantiateFull Telescope where+  instantiateFull EmptyTel = return EmptyTel+  instantiateFull (ExtendTel a b) = uncurry ExtendTel <$> instantiateFull (a, b)++instance InstantiateFull Char where+    instantiateFull = return++instance InstantiateFull Definition where+    instantiateFull (Defn x t df i d) = do+      (t, (df, d)) <- instantiateFull (t, (df, d))+      return $ Defn x t df i d++instance InstantiateFull a => InstantiateFull (Open a) where+  instantiateFull (OpenThing n a) = OpenThing n <$> instantiateFull a++instance InstantiateFull DisplayForm where+  instantiateFull (Display n ps v) = uncurry (Display n) <$> instantiateFull (ps, v)++instance InstantiateFull DisplayTerm where+  instantiateFull (DTerm v)	   = DTerm <$> instantiateFull v+  instantiateFull (DWithApp vs ws) = uncurry DWithApp <$> instantiateFull (vs, ws)++instance InstantiateFull Defn where+    instantiateFull d = case d of+      Axiom{} -> return d+      Function{ funClauses = cs } -> do+        cs <- instantiateFull cs+        return $ d { funClauses = cs }+      Datatype{ dataSort = s, dataClause = cl } -> do+	s  <- instantiateFull s+	cl <- instantiateFull cl+	return $ d { dataSort = s, dataClause = cl }+      Record{ recSort = s, recClause = cl, recTel = tel } -> do+        s   <- instantiateFull s+        cl  <- instantiateFull cl+        tel <- instantiateFull tel+        return $ d { recSort = s, recClause = cl, recTel = tel }+      Constructor{} -> return d+      Primitive{ primClauses = cs } -> do+        cs <- instantiateFull cs+        return $ d { primClauses = cs }++instance InstantiateFull Clause where+    instantiateFull (Clause r tel perm ps b) =+       Clause r <$> instantiateFull tel+       <*> return perm+       <*> return ps+       <*> instantiateFull b++instance InstantiateFull Interface where+    instantiateFull (Interface ms mod scope sig b hsImports highlighting) =+	Interface ms mod scope+	    <$> instantiateFull sig+	    <*> instantiateFull b+            <*> return hsImports+            <*> return highlighting++instance InstantiateFull a => InstantiateFull (Builtin a) where+    instantiateFull (Builtin t) = Builtin <$> instantiateFull t+    instantiateFull (Prim x)	= Prim <$> instantiateFull x++instance InstantiateFull a => InstantiateFull (Maybe a) where+  instantiateFull = mapM instantiateFull++telViewM :: MonadTCM tcm => Type -> tcm TelView+telViewM t = do+  t <- reduce t+  case unEl t of+    Pi a (Abs x b) -> absV a x <$> telViewM b+    Fun a b	   -> absV a "_" <$> telViewM (raise 1 b)+    _		   -> return $ TelV EmptyTel t+  where+    absV a x (TelV tel t) = TelV (ExtendTel a (Abs x tel)) t

+ src/full/Agda/TypeChecking/Rules/Builtin.hs view

@@ -0,0 +1,310 @@+{-# LANGUAGE PatternGuards #-}+module Agda.TypeChecking.Rules.Builtin where++import Control.Applicative+import Control.Monad+import Control.Monad.Error+import Data.Maybe++import qualified Agda.Syntax.Abstract as A+import Agda.Syntax.Internal+import Agda.Syntax.Common++import Agda.TypeChecking.Monad+import Agda.TypeChecking.Monad.Builtin+import Agda.TypeChecking.Conversion+import Agda.TypeChecking.Substitute+import Agda.TypeChecking.Primitive+import Agda.TypeChecking.Constraints+import Agda.TypeChecking.Reduce++import Agda.TypeChecking.Rules.Term ( checkExpr )++import Agda.Utils.Size++---------------------------------------------------------------------------+-- * Checking builtin pragmas+---------------------------------------------------------------------------++ensureInductive :: Term -> TCM ()+ensureInductive t = do+  t <- normalise t+  let err = typeError (NotInductive t)+  case t of+    Def t _ -> do+      t <- theDef <$> getConstInfo t+      case t of+        Datatype { dataInduction = Inductive } -> return ()+        _ -> err+    _ -> err++bindBuiltinType :: String -> A.Expr -> TCM ()+bindBuiltinType b e = do+    t <- checkExpr e (sort $ Type 0)+    when (b `elem` [builtinBool, builtinNat]) $ do+      ensureInductive t+    bindBuiltinName b t++bindBuiltinBool :: String -> A.Expr -> TCM ()+bindBuiltinBool b e = do+    bool <- primBool+    t	 <- checkExpr e $ El (Type 0) bool+    bindBuiltinName b t++-- | Bind something of type @Set -> Set@.+bindBuiltinType1 :: String -> A.Expr -> TCM ()+bindBuiltinType1 thing e = do+    let set	 = sort (Type 0)+	setToSet = El (Type 1) $ Fun (Arg NotHidden set) set+    f <- checkExpr e setToSet+    when (thing `elem` [builtinList]) $ do+      ensureInductive f+    bindBuiltinName thing f++bindBuiltinZero :: A.Expr -> TCM ()+bindBuiltinZero e = do+    nat  <- primNat+    zero <- checkExpr e (El (Type 0) nat)+    bindBuiltinName builtinZero zero++bindBuiltinSuc :: A.Expr -> TCM ()+bindBuiltinSuc e = do+    nat  <- primNat+    let	nat' = El (Type 0) nat+	natToNat = El (Type 0) $ Fun (Arg NotHidden nat') nat'+    suc <- checkExpr e natToNat+    bindBuiltinName builtinSuc suc++typeOfSizeInf :: TCM Type+typeOfSizeInf = do+    sz  <- primSize+    return $ (El (Type 0) sz)++typeOfSizeSuc :: TCM Type+typeOfSizeSuc = do+    sz  <- primSize+    let	sz' = El (Type 0) sz+    return $ El (Type 0) $ Fun (Arg NotHidden sz') sz'++-- | Built-in nil should have type @{A:Set} -> List A@+bindBuiltinNil :: A.Expr -> TCM ()+bindBuiltinNil e = do+    list' <- primList+    let set	= sort (Type 0)+	list a	= El (Type 0) (list' `apply` [Arg NotHidden a])+	nilType = telePi (telFromList [Arg Hidden ("A",set)]) $ list (Var 0 [])+    nil <- checkExpr e nilType+    bindBuiltinName builtinNil nil++-- | Built-in cons should have type @{A:Set} -> A -> List A -> List A@+bindBuiltinCons :: A.Expr -> TCM ()+bindBuiltinCons e = do+    list' <- primList+    let set	  = sort (Type 0)+	el	  = El (Type 0)+	a	  = Var 0 []+	list x	  = el $ list' `apply` [Arg NotHidden x]+	hPi x a b = telePi (telFromList [Arg Hidden (x,a)]) b+	fun a b	  = el $ Fun (Arg NotHidden a) b+	consType  = hPi "A" set $ el a `fun` (list a `fun` list a)+    cons <- checkExpr e consType+    bindBuiltinName builtinCons cons++bindBuiltinPrimitive :: String -> String -> A.Expr -> (Term -> TCM ()) -> TCM ()+bindBuiltinPrimitive name builtin (A.ScopedExpr scope e) verify = do+  setScope scope+  bindBuiltinPrimitive name builtin e verify+bindBuiltinPrimitive name builtin e@(A.Def qx) verify = do+    PrimImpl t pf <- lookupPrimitiveFunction name+    v <- checkExpr e t++    verify v++    info <- getConstInfo qx+    let cls = defClauses info+	a   = defAbstract info+    bindPrimitive name $ pf { primFunName = qx }+    addConstant qx $ info { theDef = Primitive a name cls }++    -- needed? yes, for checking equations for mul+    bindBuiltinName builtin v+bindBuiltinPrimitive _ b _ _ = typeError $ GenericError $ "Builtin " ++ b ++ " must be bound to a function"++builtinPrimitives :: [ (String, (String, Term -> TCM ())) ]+builtinPrimitives =+    [ "NATPLUS"   |-> ("primNatPlus", verifyPlus)+    , "NATMINUS"  |-> ("primNatMinus", verifyMinus)+    , "NATTIMES"  |-> ("primNatTimes", verifyTimes)+    , "NATDIVSUC" |-> ("primNatDivSuc", verifyDivSuc)+    , "NATMODSUC" |-> ("primNatModSuc", verifyModSuc)+    , "NATEQUALS" |-> ("primNatEquality", verifyEquals)+    , "NATLESS"	  |-> ("primNatLess", verifyLess)+    ]+    where+	(|->) = (,)++	verifyPlus plus =+	    verify ["n","m"] $ \(@@) zero suc (==) choice -> do+		let m = Var 0 []+		    n = Var 1 []+		    x + y = plus @@ x @@ y++		-- We allow recursion on any argument+		choice+		    [ do n + zero  == n+			 n + suc m == suc (n + m)+		    , do suc n + m == suc (n + m)+			 zero  + m == m+		    ]++	verifyMinus minus =+	    verify ["n","m"] $ \(@@) zero suc (==) choice -> do+		let m = Var 0 []+		    n = Var 1 []+		    x - y = minus @@ x @@ y++		-- We allow recursion on any argument+		zero  - zero  == zero+		zero  - suc m == zero+		suc n - zero  == suc n+		suc n - suc m == (n - m)++	verifyTimes times = do+	    plus <- primNatPlus+	    verify ["n","m"] $ \(@@) zero suc (==) choice -> do+		let m = Var 0 []+		    n = Var 1 []+		    x + y = plus  @@ x @@ y+		    x * y = times @@ x @@ y++		choice+		    [ do n * zero == zero+			 choice [ (n * suc m) == (n + (n * m))+				, (n * suc m) == ((n * m) + n)+				]+		    , do zero * n == zero+			 choice [ (suc n * m) == (m + (n * m))+				, (suc n * m) == ((n * m) + m)+				]+		    ]++	verifyDivSuc ds =+	    verify ["n","m"] $ \(@@) zero suc (==) choice -> do+		minus <- primNatMinus+		let x - y      = minus @@ x @@ y+		    divSuc x y = ds @@ x @@ y+		    m	       = Var 0 []+		    n	       = Var 1 []++		divSuc  zero   m == zero+		divSuc (suc n) m == suc (divSuc (n - m) m)++	verifyModSuc ms =+	    verify ["n","m"] $ \(@@) zero suc (==) choice -> do+		minus <- primNatMinus+		let x - y      = minus @@ x @@ y+		    modSuc x y = ms @@ x @@ y+		    m	       = Var 0 []+		    n	       = Var 1 []+		modSuc  zero   m == zero+		modSuc (suc n) m == modSuc (n - m) m++	verifyEquals eq =+	    verify ["n","m"] $ \(@@) zero suc (===) choice -> do+	    true  <- primTrue+	    false <- primFalse+	    let x == y = eq @@ x @@ y+		m      = Var 0 []+		n      = Var 1 []+	    (zero  == zero ) === true+	    (suc n == suc m) === (n == m)+	    (suc n == zero ) === false+	    (zero  == suc n) === false++	verifyLess leq =+	    verify ["n","m"] $ \(@@) zero suc (===) choice -> do+	    true  <- primTrue+	    false <- primFalse+	    let x < y = leq @@ x @@ y+		m     = Var 0 []+		n     = Var 1 []+	    (n     < zero)  === false+	    (suc n < suc m) === (n < m)+	    (zero  < suc m) === true++	verify :: [String] -> ( (Term -> Term -> Term) -> Term -> (Term -> Term) ->+				(Term -> Term -> TCM ()) ->+				([TCM ()] -> TCM ()) -> TCM a) -> TCM a+	verify xs f = do+	    nat	 <- El (Type 0) <$> primNat+	    zero <- primZero+	    s    <- primSuc+	    let x @@ y = x `apply` [Arg NotHidden y]+		x == y = noConstraints $ equalTerm nat x y+		suc n  = s @@ n+		choice = foldr1 (\x y -> x `catchError` \_ -> y)+	    xs <- mapM freshName_ xs+	    addCtxs xs (Arg NotHidden nat) $ f (@@) zero suc (==) choice++-- | Builtin constructors+builtinConstructors :: [(String, A.Expr -> TCM ())]+builtinConstructors =+  [ (builtinNil,     bindBuiltinNil               )+  , (builtinCons,    bindBuiltinCons              )+  , (builtinZero,    bindBuiltinZero              )+  , (builtinSuc,     bindBuiltinSuc               )+  , (builtinTrue,    bindBuiltinBool builtinTrue  )+  , (builtinFalse,   bindBuiltinBool builtinFalse )+  ]++-- | Builtin postulates+builtinPostulates :: [(String, TCM Type)]+builtinPostulates =+  [ (builtinSize,    return $ sort $ Type 0 )+  , (builtinSizeSuc, typeOfSizeSuc          )+  , (builtinSizeInf, typeOfSizeInf          )+  ]++-- | Bind a builtin constructor. Pre-condition: argument is an element of+--   'builtinConstructors'.+bindConstructor :: String -> (A.Expr -> TCM ()) -> A.Expr -> TCM ()+bindConstructor s bind (A.ScopedExpr scope e) = do+  setScope scope+  bindConstructor s bind e+bindConstructor s bind e@(A.Con _) = bind e+bindConstructor s _ e              = typeError $ BuiltinMustBeConstructor s e++-- | Bind a builtin postulate. Pre-condition: argument is an element of+--   'builtinPostulates'.+bindPostulate :: String -> TCM Type -> A.Expr -> TCM ()+bindPostulate s typ e = do+  t <- typ+  v <- checkExpr e t++  let bad = typeError $ GenericError $ "The builtin " ++ s ++ " must be bound to a postulated identifier."++  case v of+    Def c []  -> ignoreAbstractMode $ do+      defn <- theDef <$> getConstInfo c+      case defn of+        Axiom{} -> return ()+        _       -> bad+    _         -> bad++  bindBuiltinName s v++-- | Bind a builtin thing to an expression.+bindBuiltin :: String -> A.Expr -> TCM ()+bindBuiltin b e = do+    top <- (== 0) . size <$> getContextTelescope+    unless top $ typeError $ BuiltinInParameterisedModule b+    bind b e+    where+	bind b e+	    | elem b builtinTypes                        = bindBuiltinType b e+	    | elem b [builtinList]                       = bindBuiltinType1 b e+            | Just bind  <- lookup b builtinConstructors = bindConstructor b bind e+	    | Just (s,v) <- lookup b builtinPrimitives   = bindBuiltinPrimitive s b e v+            | Just typ   <- lookup b builtinPostulates   = bindPostulate b typ e+	    | otherwise                                  = typeError $ NoSuchBuiltinName b+

+ src/full/Agda/TypeChecking/Rules/Data.hs view

@@ -0,0 +1,248 @@+{-# LANGUAGE CPP #-}++module Agda.TypeChecking.Rules.Data where++import Control.Applicative+import Control.Monad+import Control.Monad.Trans+import qualified System.IO.UTF8 as UTF8++import qualified Agda.Syntax.Abstract as A+import Agda.Syntax.Internal+import Agda.Syntax.Common+import Agda.Syntax.Position+import qualified Agda.Syntax.Info as Info++import Agda.TypeChecking.Monad+import Agda.TypeChecking.Conversion+import Agda.TypeChecking.Substitute+import Agda.TypeChecking.MetaVars+import Agda.TypeChecking.Reduce+import Agda.TypeChecking.Constraints+import Agda.TypeChecking.Pretty+import Agda.TypeChecking.Polarity++import Agda.TypeChecking.Rules.Term ( isType_ )++import Agda.Interaction.Options++import Agda.Utils.Monad+import Agda.Utils.Size+import Agda.Utils.Tuple++#include "../../undefined.h"+import Agda.Utils.Impossible++---------------------------------------------------------------------------+-- * Datatypes+---------------------------------------------------------------------------++-- | Type check a datatype definition. Assumes that the type has already been+--   checked.+checkDataDef :: Info.DefInfo -> Induction -> QName -> [A.LamBinding] -> [A.Constructor] -> TCM ()+checkDataDef i ind name ps cs =+    traceCall (CheckDataDef (getRange i) (qnameName name) ps cs) $ do -- TODO!! (qnameName)+	let npars = size ps++	-- Look up the type of the datatype.+	t <- instantiateFull =<< typeOfConst name++	-- The parameters are in scope when checking the constructors. +	dataDef <- bindParameters ps t $ \tel t0 -> do++	    -- Parameters are always hidden in constructors+	    let tel' = hideTel tel++	    -- The type we get from bindParameters is Θ -> s where Θ is the type of+	    -- the indices. We count the number of indices and return s.+            (nofIxs, s) <- splitType =<< normalise t0++	    -- Change the datatype from an axiom to a datatype with no constructors.+            let dataDef = Datatype { dataPars           = npars+                                   , dataIxs            = nofIxs+                                   , dataInduction      = ind+                                   , dataClause         = Nothing+                                   , dataCons           = []     -- Constructors are added later+				   , dataSort           = s+                                   , dataHsType         = Nothing+                                   , dataAbstr          = Info.defAbstract i+                                   , dataPolarity       = []+                                   , dataArgOccurrences = []+                                   }++	    escapeContext (size tel) $ do+	      addConstant name ( Defn name t (defaultDisplayForm name) 0 dataDef )++	    -- Check the types of the constructors+	    mapM_ (checkConstructor name tel' nofIxs s ind) cs++	    -- Return the data definition+	    return dataDef++        let nofIxs = dataIxs dataDef+            s      = dataSort dataDef++	-- If proof irrelevance is enabled we have to check that datatypes in+	-- Prop contain at most one element.+	do  proofIrr <- proofIrrelevance+	    case (proofIrr, s, cs) of+		(True, Prop, _:_:_) -> setCurrentRange (getRange $ map conName cs) $+                                        typeError PropMustBeSingleton+                  where conName (A.Axiom _ c _) = c+                        conName (A.ScopedDecl _ (d:_)) = conName d+                        conName _ = __IMPOSSIBLE__+		_		    -> return ()++	-- Add the datatype to the signature with its constructors. It was previously+	-- added without them.+	addConstant name (Defn name t (defaultDisplayForm name) 0 $+                            dataDef { dataCons = map cname cs }+			 )+        computePolarity name+    where+	cname (A.ScopedDecl _ [d]) = cname d+	cname (A.Axiom _ x _)	   = x+	cname _			   = __IMPOSSIBLE__ -- constructors are axioms++	hideTel  EmptyTel		  = EmptyTel+	hideTel (ExtendTel (Arg _ t) tel) = ExtendTel (Arg Hidden t) $ hideTel <$> tel++	splitType (El _ (Pi _ b))  = ((+ 1) -*- id) <$> splitType (absBody b)+	splitType (El _ (Fun _ b)) = ((+ 1) -*- id) <$> splitType b+	splitType (El _ (Sort s))  = return (0, s)+	splitType (El _ t)	   = typeError $ DataMustEndInSort t++-- | Type check a constructor declaration. Checks that the constructor targets+--   the datatype and that it fits inside the declared sort.+checkConstructor :: QName -> Telescope -> Nat -> Sort+                 -> Induction -- ^ Is the constructor inductive or coinductive?+                 -> A.Constructor -> TCM ()+checkConstructor d tel nofIxs s ind (A.ScopedDecl scope [con]) = do+  setScope scope+  checkConstructor d tel nofIxs s ind con+checkConstructor d tel nofIxs s ind con@(A.Axiom i c e) =+    traceCall (CheckConstructor d tel s con) $ do+	t <- isType_ e+	n <- size <$> getContextTelescope+	verboseS "tc.data.con" 15 $ do+	    td <- prettyTCM t+	    liftIO $ UTF8.putStrLn $ "checking that " ++ show td ++ " ends in " ++ show d+	    liftIO $ UTF8.putStrLn $ "  nofPars = " ++ show n+	constructs n t d+	verboseS "tc.data.con" 15 $ do+	    d <- prettyTCM s+	    liftIO $ UTF8.putStrLn $ "checking that the type fits in " ++ show d+	t `fitsIn` s+	escapeContext (size tel)+	    $ addConstant c+	    $ Defn c (telePi tel t) (defaultDisplayForm c) 0+	    $ Constructor (size tel) c d Nothing (Info.defAbstract i) ind+checkConstructor _ _ _ _ _ _ = __IMPOSSIBLE__ -- constructors are axioms+++-- | Bind the parameters of a datatype. The bindings should be domain free.+bindParameters :: [A.LamBinding] -> Type -> (Telescope -> Type -> TCM a) -> TCM a+bindParameters [] a ret = ret EmptyTel a+bindParameters (A.DomainFree h x : ps) (El _ (Pi (Arg h' a) b)) ret+    | h /= h'	=+	__IMPOSSIBLE__+    | otherwise = addCtx x arg $ bindParameters ps (absBody b) $ \tel s ->+		    ret (ExtendTel arg $ Abs (show x) tel) s+  where+    arg = Arg h a+bindParameters (A.DomainFree h x : ps) (El _ (Fun (Arg h' a) b)) ret+    | h /= h'	=+	__IMPOSSIBLE__+    | otherwise = addCtx x arg $ bindParameters ps (raise 1 b) $ \tel s ->+		    ret (ExtendTel arg $ Abs (show x) tel) s+  where+    arg = Arg h a+bindParameters _ _ _ = __IMPOSSIBLE__+++-- | Check that the arguments to a constructor fits inside the sort of the datatype.+--   The first argument is the type of the constructor.+fitsIn :: Type -> Sort -> TCM ()+fitsIn t s =+    do	t <- instantiate t+	case funView $ unEl t of+	    FunV arg@(Arg h a) _ -> do+		let s' = getSort a+                s' `leqSort` s+		x <- freshName_ (argName t)+		let v  = Arg h $ Var 0 []+		    t' = piApply (raise 1 t) [v]+		addCtx x arg $ fitsIn t' s+	    _		     -> return ()++-- | Check that a type constructs something of the given datatype. The first+--   argument is the number of parameters to the datatype.+--   TODO: what if there's a meta here?+constructs :: Int -> Type -> QName -> TCM ()+constructs nofPars t q = constrT 0 t+    where+	constrT n (El s v) = constr n s v++	constr n s v = do+	    v <- reduce v+	    case v of+		Pi a b	-> underAbstraction a b $ \t ->+			   constrT (n + 1) t+		Fun _ b -> constrT n b+		Def d vs+		    | d == q -> checkParams n =<< reduce (take nofPars vs)+						    -- we only check the parameters+		_ -> bad $ El s v++	bad t = typeError $ ShouldEndInApplicationOfTheDatatype t++	checkParams n vs = zipWithM_ sameVar (map unArg vs) ps+	    where+		ps = reverse [ i | (i,Arg h _) <- zip [n..] vs ]++		sameVar v i = do+		    t <- typeOfBV i+		    noConstraints $ equalTerm t v (Var i [])+++-- | Force a type to be a specific datatype.+forceData :: MonadTCM tcm => QName -> Type -> tcm Type+forceData d (El s0 t) = liftTCM $ do+    t' <- reduce t+    d  <- canonicalName d+    case t' of+	Def d' _+	    | d == d'   -> return $ El s0 t'+	    | otherwise	-> fail $ "wrong datatype " ++ show d ++ " != " ++ show d'+	MetaV m vs	    -> do+	    Defn _ t _ _ Datatype{dataSort = s} <- getConstInfo d+	    ps <- newArgsMeta t+	    noConstraints $ equalType (El s0 t') (El s (Def d ps)) -- TODO: too strict?+	    reduce $ El s0 t'+	_ -> typeError $ ShouldBeApplicationOf (El s0 t) d++-- | Is the type coinductive? Returns 'Nothing' if the answer cannot+-- be determined.++isCoinductive :: MonadTCM tcm => Type -> tcm (Maybe Bool)+isCoinductive t = do+  El _ t <- normalise t+  case t of+    Def q _ -> do+      def <- getConstInfo q+      case theDef def of+        Axiom       {} -> return (Just False)+        Function    {} -> return Nothing+        Datatype    { dataInduction = CoInductive } -> return (Just True)+        Datatype    { dataInduction = Inductive   } -> return (Just False)+        Record      {} -> return (Just False)+        Constructor {} -> __IMPOSSIBLE__+        Primitive   {} -> __IMPOSSIBLE__+    Var   {} -> return Nothing+    Lam   {} -> __IMPOSSIBLE__+    Lit   {} -> __IMPOSSIBLE__+    Con   {} -> __IMPOSSIBLE__+    Pi    {} -> return (Just False)+    Fun   {} -> return (Just False)+    Sort  {} -> return (Just False)+    MetaV {} -> return Nothing

+ src/full/Agda/TypeChecking/Rules/Decl.hs view

@@ -0,0 +1,248 @@+{-# LANGUAGE CPP #-}++module Agda.TypeChecking.Rules.Decl where++import Control.Monad+import Control.Monad.Trans+import qualified Data.Map as Map+import Data.Map (Map)+import qualified System.IO.UTF8 as UTF8++import qualified Agda.Syntax.Abstract as A+import Agda.Syntax.Internal+import qualified Agda.Syntax.Info as Info+import Agda.Syntax.Position+import Agda.Syntax.Common++import Agda.TypeChecking.Monad+import Agda.TypeChecking.Monad.Builtin+import Agda.TypeChecking.Monad.Mutual+import Agda.TypeChecking.Pretty+import Agda.TypeChecking.Constraints+import Agda.TypeChecking.Positivity+import Agda.TypeChecking.Primitive hiding (Nat)+import Agda.TypeChecking.Conversion+import Agda.TypeChecking.Substitute+import Agda.TypeChecking.Reduce+import Agda.TypeChecking.SizedTypes++import Agda.TypeChecking.Rules.Term+import Agda.TypeChecking.Rules.Data    ( checkDataDef )+import Agda.TypeChecking.Rules.Record  ( checkRecDef )+import Agda.TypeChecking.Rules.Def     ( checkFunDef )+import Agda.TypeChecking.Rules.Builtin ( bindBuiltin, bindBuiltinType1 )++import Agda.Compiler.HaskellTypes++import Agda.Utils.Size+import Agda.Utils.Monad++#include "../../undefined.h"+import Agda.Utils.Impossible++-- | Type check a sequence of declarations.+checkDecls :: [A.Declaration] -> TCM ()+checkDecls ds = mapM_ checkDecl ds+++-- | Type check a single declaration.+checkDecl :: A.Declaration -> TCM ()+checkDecl d = do+    case d of+	A.Axiom i x e		     -> checkAxiom i x e+        A.Field _ _ _                -> typeError FieldOutsideRecord+	A.Primitive i x e	     -> checkPrimitive i x e+	A.Definition i ts ds	     -> checkMutual i ts ds+	A.Section i x tel ds	     -> checkSection i x tel ds+	A.Apply i x tel m args rd rm -> checkSectionApplication i x tel m args rd rm+	A.Import i x		     -> checkImport i x+	A.Pragma i p		     -> checkPragma i p+	A.ScopedDecl scope ds	     -> setScope scope >> checkDecls ds+	    -- open is just an artifact from the concrete syntax+    solveSizeConstraints+++-- | Type check an axiom.+checkAxiom :: Info.DefInfo -> QName -> A.Expr -> TCM ()+checkAxiom _ x e = do+  t <- isType_ e+  reportSDoc "tc.decl.ax" 10 $ sep+    [ text "checked axiom"+    , nest 2 $ prettyTCM x <+> text ":" <+> prettyTCM t+    ]+  addConstant x (Defn x t (defaultDisplayForm x) 0 $ Axiom Nothing)+  solveSizeConstraints+++-- | Type check a primitive function declaration.+checkPrimitive :: Info.DefInfo -> QName -> A.Expr -> TCM ()+checkPrimitive i x e =+    traceCall (CheckPrimitive (getRange i) (qnameName x) e) $ do  -- TODO!! (qnameName)+    PrimImpl t' pf <- lookupPrimitiveFunction (nameString $ qnameName x)+    t <- isType_ e+    noConstraints $ equalType t t'+    let s  = show $ nameConcrete $ qnameName x+    bindPrimitive s $ pf { primFunName = x }+    addConstant x (Defn x t (defaultDisplayForm x) 0 $ Primitive (Info.defAbstract i) s [])+    where+	nameString (Name _ x _ _) = show x+++-- | Check a pragma.+checkPragma :: Range -> A.Pragma -> TCM ()+checkPragma r p =+    traceCall (CheckPragma r p) $ case p of+	A.BuiltinPragma x e -> bindBuiltin x e+        A.CompiledTypePragma x hs -> do+          def <- getConstInfo x+          case theDef def of+            Axiom{} -> addHaskellType x hs+            _       -> typeError $ GenericError "COMPILED_TYPE directive only works on postulates."+          -- TODO: hack+          when (hs == builtinIO) $+            bindBuiltinType1 builtinIO (A.Def x)+        A.CompiledDataPragma x hs hcs -> do+          def <- theDef <$> getConstInfo x+          case def of+            Datatype{dataCons = cs}+              | length cs /= length hcs -> do+                  let n_forms_are = case length hcs of+                        1 -> "1 compiled form is"+                        n -> show n ++ " compiled forms are"+                      only | null hcs               = ""+                           | length hcs < length cs = "only "+                           | otherwise              = ""++                  err <- fsep $ [prettyTCM x] ++ pwords ("has " ++ show (length cs) +++                                " constructors, but " ++ only ++ n_forms_are ++ " given [" ++ unwords hcs ++ "]")+                  typeError $ GenericError $ show err+              | otherwise -> do+                addHaskellType x hs+                let computeHaskellType c = do+                      def <- getConstInfo c+                      let Constructor{ conPars = np } = theDef def+                          underPars 0 a = haskellType a+                          underPars n a = do+                            a <- reduce a+                            case unEl a of+                              Pi a b  -> underAbstraction a b $ underPars (n - 1)+                              Fun a b -> underPars (n - 1) b+                              _       -> __IMPOSSIBLE__+                      ty <- underPars np $ defType def+                      reportSLn "tc.pragma.compile" 10 $ "Haskell type for " ++ show c ++ ": " ++ ty+                      return ty+                hts <- mapM computeHaskellType cs+                sequence_ $ zipWith3 addHaskellCode cs hts hcs+            _ -> typeError $ GenericError "COMPILED_DATA on non datatype"+        A.CompiledPragma x hs -> do+          def <- getConstInfo x+          case theDef def of+            Axiom{} -> do+              ty <- haskellType $ defType def+              reportSLn "tc.pragma.compile" 10 $ "Haskell type for " ++ show x ++ ": " ++ ty+              addHaskellCode x ty hs+            _   -> typeError $ GenericError "COMPILED directive only works on postulates."+	A.OptionsPragma _   -> __IMPOSSIBLE__	-- not allowed here++-- | Type check a bunch of mutual inductive recursive definitions.+checkMutual :: Info.DeclInfo -> [A.TypeSignature] -> [A.Definition] -> TCM ()+checkMutual i ts ds = inMutualBlock $ do+  mapM_ checkTypeSignature ts+  mapM_ checkDefinition ds+  checkStrictlyPositive =<< currentMutualBlock+++-- | Type check the type signature of an inductive or recursive definition.+checkTypeSignature :: A.TypeSignature -> TCM ()+checkTypeSignature (A.ScopedDecl scope ds) = do+  setScope scope+  mapM_ checkTypeSignature ds+checkTypeSignature (A.Axiom i x e) =+    case Info.defAccess i of+	PublicAccess  -> inConcreteMode $ checkAxiom i x e+	PrivateAccess -> inAbstractMode $ checkAxiom i x e+checkTypeSignature _ = __IMPOSSIBLE__	-- type signatures are always axioms+++-- | Check an inductive or recursive definition. Assumes the type has has been+--   checked and added to the signature.+checkDefinition :: A.Definition -> TCM ()+checkDefinition d =+    case d of+	A.FunDef i x cs         -> abstract (Info.defAbstract i) $ checkFunDef NotDelayed i x cs+	A.DataDef i x ind ps cs -> abstract (Info.defAbstract i) $ checkDataDef i ind x ps cs+	A.RecDef i x ps tel cs  -> abstract (Info.defAbstract i) $ checkRecDef i x ps tel cs+        A.ScopedDef scope d     -> setScope scope >> checkDefinition d+    where+	-- Concrete definitions cannot use information about abstract things.+	abstract ConcreteDef = inConcreteMode+	abstract AbstractDef = inAbstractMode+++-- | Type check a module.+checkSection :: Info.ModuleInfo -> ModuleName -> A.Telescope -> [A.Declaration] -> TCM ()+checkSection i x tel ds =+  checkTelescope tel $ \tel' -> do+    addSection x (size tel')+    verboseS "tc.section.check" 10 $ do+      dx   <- prettyTCM x+      dtel <- mapM prettyA tel+      dtel' <- prettyTCM =<< lookupSection x+      liftIO $ UTF8.putStrLn $ "checking section " ++ show dx ++ " " ++ show dtel+      liftIO $ UTF8.putStrLn $ "    actual tele: " ++ show dtel'+    withCurrentModule x $ checkDecls ds++checkModuleArity :: ModuleName -> Telescope -> [NamedArg A.Expr] -> TCM Telescope+checkModuleArity m tel args = check tel args+  where+    bad = typeError $ ModuleArityMismatch m tel args++    check eta []             = return eta+    check EmptyTel (_:_)     = bad+    check (ExtendTel (Arg h _) (Abs y tel)) args0@(Arg h' (Named name _) : args) =+      case (h, h', name) of+        (Hidden, NotHidden, _)    -> check tel args0+        (Hidden, Hidden, Nothing) -> check tel args+        (Hidden, Hidden, Just x)+          | x == y                -> check tel args+          | otherwise             -> check tel args0+        (NotHidden, NotHidden, _) -> check tel args+        (NotHidden, Hidden, _)    -> bad++-- | Check an application of a section.+checkSectionApplication ::+  Info.ModuleInfo -> ModuleName -> A.Telescope -> ModuleName -> [NamedArg A.Expr] ->+  Map QName QName -> Map ModuleName ModuleName -> TCM ()+checkSectionApplication i m1 ptel m2 args rd rm =+  traceCall (CheckSectionApplication (getRange i) m1 ptel m2 args) $+  checkTelescope ptel $ \ptel -> do+  tel <- lookupSection m2+  vs  <- freeVarsToApply $ qnameFromList $ mnameToList m2+  let tel' = apply tel vs+  etaTel <- checkModuleArity m2 tel' args+  let tel'' = telFromList $ take (size tel' - size etaTel) $ telToList tel'+  addCtxTel etaTel $ addSection m1 (size ptel + size etaTel)+  reportSDoc "tc.section.apply" 15 $ vcat+    [ text "applying section" <+> prettyTCM m2+    , nest 2 $ text "ptel =" <+> prettyTCM ptel+    , nest 2 $ text "tel  =" <+> prettyTCM tel+    , nest 2 $ text "tel' =" <+> prettyTCM tel'+    , nest 2 $ text "tel''=" <+> prettyTCM tel''+    , nest 2 $ text "eta  =" <+> prettyTCM etaTel+    ]+  (ts, cs)  <- checkArguments_ DontExpandLast (getRange i) args tel''+  noConstraints $ return cs+  reportSDoc "tc.section.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)+    ]+  args <- instantiateFull $ vs ++ ts+  applySection m1 ptel m2 args rd rm++-- | Type check an import declaration. Actually doesn't do anything, since all+--   the work is done when scope checking.+checkImport :: Info.ModuleInfo -> ModuleName -> TCM ()+checkImport i x = return ()++

+ src/full/Agda/TypeChecking/Rules/Decl.hs-boot view

@@ -0,0 +1,14 @@++module Agda.TypeChecking.Rules.Decl where++import Data.Map           (Map)+import Agda.Syntax.Info        (ModuleInfo)+import Agda.Syntax.Common      (NamedArg)+import Agda.Syntax.Abstract    (QName, Expr, Declaration, ModuleName, Telescope)+import Agda.TypeChecking.Monad (TCM)++checkDecls :: [Declaration] -> TCM ()+checkDecl  :: Declaration -> TCM ()+checkSectionApplication ::+  ModuleInfo -> ModuleName -> Telescope -> ModuleName -> [NamedArg Expr] ->+  Map QName QName -> Map ModuleName ModuleName -> TCM ()

+ src/full/Agda/TypeChecking/Rules/Def.hs view

@@ -0,0 +1,562 @@+{-# LANGUAGE CPP #-}++module Agda.TypeChecking.Rules.Def where++import Prelude hiding (mapM)+import Control.Applicative+import Control.Monad.State hiding (mapM)+import Control.Monad.Reader hiding (mapM)+import Control.Monad hiding (mapM)+import Data.List hiding (sort)+import Data.Traversable+import Data.Set (Set)+import qualified Data.Set as Set+import qualified System.IO.UTF8 as UTF8++import Agda.Syntax.Common+import Agda.Syntax.Position+import qualified Agda.Syntax.Abstract as A+import Agda.Syntax.Internal+import qualified Agda.Syntax.Info as Info+import qualified Agda.Syntax.Abstract.Pretty as A+import Agda.Syntax.Fixity+import Agda.Syntax.Translation.InternalToAbstract++import Agda.TypeChecking.Monad+import Agda.TypeChecking.Reduce+import Agda.TypeChecking.Pretty+import Agda.TypeChecking.Substitute+import Agda.TypeChecking.Free+import Agda.TypeChecking.Constraints+import Agda.TypeChecking.Conversion+import Agda.TypeChecking.Empty+import Agda.TypeChecking.MetaVars+import Agda.TypeChecking.Rebind+import Agda.TypeChecking.Primitive hiding (Nat)+import Agda.TypeChecking.With+import Agda.TypeChecking.Telescope+import Agda.TypeChecking.Coverage+import Agda.TypeChecking.Injectivity+import Agda.TypeChecking.Polarity+import Agda.TypeChecking.SizedTypes++import Agda.TypeChecking.Rules.Term                ( checkExpr, inferExpr, checkTelescope, isType_ )+import Agda.TypeChecking.Rules.LHS                 ( checkLeftHandSide )+import {-# SOURCE #-} Agda.TypeChecking.Rules.Decl ( checkDecls )+import Agda.TypeChecking.Rules.Data                ( isCoinductive )++import Agda.Interaction.Options++import Agda.Utils.Tuple+import Agda.Utils.Size+import Agda.Utils.Function+import Agda.Utils.List+import Agda.Utils.Permutation+import Agda.Utils.Monad++#include "../../undefined.h"+import Agda.Utils.Impossible++---------------------------------------------------------------------------+-- * Definitions by pattern matching+---------------------------------------------------------------------------++-- | Type check a definition by pattern matching. The first argument+-- specifies whether the clauses are delayed or not.+checkFunDef :: Delayed -> Info.DefInfo -> QName -> [A.Clause] -> TCM ()+checkFunDef delayed i name cs =++    traceCall (CheckFunDef (getRange i) (qnameName name) cs) $ do   -- TODO!! (qnameName)+        -- Get the type of the function+        t    <- typeOfConst name++        reportSDoc "tc.def.fun" 10 $+          sep [ text "checking body of" <+> prettyTCM name+              , nest 2 $ text ":" <+> prettyTCM t+              , nest 2 $ text "full type:" <+> (prettyTCM . defType =<< getConstInfo name)+              ]++        -- Check the clauses+        let check c = do+              c <- checkClause t c+              solveSizeConstraints+              return c+        cs <- mapM check cs++        -- Check that all clauses have the same number of arguments+        unless (allEqual $ map npats cs) $ typeError DifferentArities++        -- Annotate the clauses with which arguments are actually used.+        cs <- mapM rebindClause cs++        -- Check if the function is injective+        inv <- checkInjectivity name cs++        -- Add the definition+        addConstant name $ Defn name t (defaultDisplayForm name) 0+                         $ Function+                            { funClauses        = cs+                            , funDelayed        = delayed+                            , funInv            = inv+                            , funAbstr          = Info.defAbstract i+                            , funPolarity       = []+                            , funArgOccurrences = []+                            }+        computePolarity name+        verboseS "tc.def.fun" 10 $ do+          dx <- prettyTCM name+          t' <- prettyTCM . defType =<< getConstInfo name+          liftIO $ UTF8.putStrLn $ "added " ++ show dx ++ " : " ++ show t'++        -- Check pattern coverage+        checkCoverage name+    where+        npats = size . clausePats++data WithFunctionProblem+      = NoWithFunction+      | WithFunction QName          -- parent function name+                     QName          -- with function name+                     Telescope      -- arguments to parent function+                     Telescope      -- arguments to the with function before the with expressions+                     Telescope      -- arguments to the with function after the with expressions+                     [Term]         -- with expressions+                     [Type]         -- types of the with expressions+                     Type           -- type of the right hand side+                     [Arg Pattern]  -- parent patterns+                     Permutation    -- permutation reordering the variables in the parent pattern+                     [A.Clause]     -- the given clauses for the with function++-- | Type check a function clause.+checkClause :: Type -> A.Clause -> TCM Clause+checkClause t c@(A.Clause (A.LHS i x aps []) rhs wh) =+    traceCall (CheckClause t c) $+    checkLeftHandSide c aps t $ \gamma delta sub xs ps t' perm -> do+      let mkBody v = foldr (\x t -> Bind $ Abs x t) (Body $ substs sub v) xs+      (body, with) <- checkWhere (size delta) wh $ +              case rhs of+                A.RHS e+                  | any (containsAbsurdPattern . namedThing . unArg) aps ->+                    typeError $ AbsurdPatternRequiresNoRHS aps+                  | otherwise -> do+                    v <- checkExpr e t'+                    return (mkBody v, NoWithFunction)+                A.AbsurdRHS+                  | any (containsAbsurdPattern . namedThing . unArg) aps+                              -> return (NoBody, NoWithFunction)+                  | otherwise -> typeError $ NoRHSRequiresAbsurdPattern aps+                A.WithRHS aux es cs -> do++                  -- Infer the types of the with expressions+                  vas <- mapM inferExpr es+                  (vs, as) <- instantiateFull $ unzip vas++                  -- Invent a clever name for the with function+                  m <- currentModule+                  reportSDoc "tc.with.top" 20 $ text "with function module:" <+> prettyList (map prettyTCM $ mnameToList m)++                  -- Split the telescope into the part needed to type the with arguments+                  -- and all the other stuff+                  let fv = allVars $ freeVars vs+                      SplitTel delta1 delta2 perm' = splitTelescope fv delta+                      finalPerm = composeP perm' perm++                  reportSDoc "tc.with.top" 25 $ vcat+                    [ text "delta  =" <+> prettyTCM delta+                    , text "delta1 =" <+> prettyTCM delta1+                    , text "delta2 =" <+> addCtxTel delta1 (prettyTCM delta2)+                    ]++                  -- Create the body of the original function+                  ctx <- getContextTelescope+                  let n    = size ctx+                      m    = size delta+                      us   = [ Arg h (Var i []) | (i, Arg h _) <- zip [n - 1,n - 2..0] $ telToList ctx ]+                      (us0, us1') = genericSplitAt (n - m) us+                      (us1, us2)  = genericSplitAt (size delta1) $ permute perm' us1'+                      v    = Def aux $ us0 ++ us1 ++ (map (Arg NotHidden) vs) ++ us2++                  -- We need Δ₁Δ₂ ⊢ t'+                  t' <- return $ rename (reverseP perm') t'+                  -- and Δ₁ ⊢ vs : as+                  (vs, as) <- do+                    let var = flip Var []+                        -- We know that as does not depend on Δ₂+                        rho = replicate (size delta2) __IMPOSSIBLE__ ++ map var [0..]+                    return $ substs rho $ rename (reverseP perm') (vs, as)++                  reportSDoc "tc.with.top" 20 $ vcat+                    [ text "    with arguments" <+> prettyList (map prettyTCM vs)+                    , text "             types" <+> prettyList (map prettyTCM as)+                    , text "with function call" <+> prettyTCM v+                    , text "           context" <+> (prettyTCM =<< getContextTelescope)+                    , text "             delta" <+> prettyTCM delta+                    , text "                fv" <+> text (show fv)+                    ]++                  return (mkBody v, WithFunction x aux gamma delta1 delta2 vs as t' ps finalPerm cs)+      escapeContext (size delta) $ checkWithFunction with++      reportSDoc "tc.lhs.top" 10 $ vcat+        [ text "Final clause:"+        , nest 2 $ vcat+          [ text "delta =" <+> prettyTCM delta+          , text "perm  =" <+> text (show perm)+          , text "ps    =" <+> text (show ps)+          , text "body  =" <+> text (show body)+          ]+        ]+      return $ Clause { clauseRange = getRange i+                      , clauseTel   = killRange delta  -- TODO: make sure delta and perm are what we want+                      , clausePerm  = perm+                      , clausePats  = ps+                      , clauseBody  = body+                      }++checkClause t (A.Clause (A.LHS _ _ _ ps@(_ : _)) _ _) = typeError $ UnexpectedWithPatterns ps++checkWithFunction :: WithFunctionProblem -> TCM ()+checkWithFunction NoWithFunction = return ()+checkWithFunction (WithFunction f aux gamma delta1 delta2 vs as b qs perm cs) = do++  reportSDoc "tc.with.top" 10 $ vcat+    [ text "checkWithFunction"+    , nest 2 $ vcat+      [ text "delta1 =" <+> prettyTCM delta1+      , text "delta2 =" <+> prettyTCM delta2+      , text "gamma  =" <+> prettyTCM gamma+      , text "as     =" <+> prettyTCM as+      , text "vs     =" <+> prettyTCM vs+      , text "b      =" <+> prettyTCM b+      , text "qs     =" <+> text (show qs)+      , text "perm   =" <+> text (show perm)+      ]+    ]++  -- Add the type of the auxiliary function to the signature++  -- With display forms are closed+  df <- makeClosed <$> withDisplayForm f aux delta1 delta2 (size as) qs perm++  reportSLn "tc.with.top" 20 "created with display form"++  -- Generate the type of the with function+  candidateType <- withFunctionType delta1 vs as delta2 b+  reportSDoc "tc.with.type" 10 $ sep [ text "candidate type:", nest 2 $ prettyTCM candidateType ]+  absAuxType <- setShowImplicitArguments True+                $ disableDisplayForms+                $ dontReifyInteractionPoints+                $ reify candidateType+  reportSDoc "tc.with.top" 15 $+    vcat [ text "type of with function:"+         , nest 2 $ prettyTCM absAuxType+         ]+  -- The ranges in the generated type are completely bogus, so we kill them.+  auxType <- setCurrentRange (getRange cs) $ isType_ $ killRange absAuxType++  case df of+    OpenThing _ (Display n ts dt) -> reportSDoc "tc.with.top" 20 $ text "Display" <+> fsep+      [ text (show n)+      , prettyList $ map prettyTCM ts+      , prettyTCM dt+      ]+  addConstant aux (Defn aux auxType [df] 0 $ Axiom Nothing)+  solveSizeConstraints++  reportSDoc "tc.with.top" 10 $ sep+    [ text "added with function" <+> (prettyTCM aux) <+> text "of type"+    , nest 2 $ prettyTCM auxType+    , nest 2 $ text "-|" <+> (prettyTCM =<< getContextTelescope)+    ]++  -- Construct the body for the with function+  cs <- buildWithFunction aux gamma qs perm (size delta1) (size as) cs++  -- Check the with function+  checkFunDef NotDelayed info aux cs++  where+    info = Info.mkDefInfo (nameConcrete $ qnameName aux) defaultFixity PublicAccess ConcreteDef (getRange cs)++-- | Type check a where clause. The first argument is the number of variables+--   bound in the left hand side.+checkWhere :: Nat -> [A.Declaration] -> TCM a -> TCM a+checkWhere _ []                      ret = ret+checkWhere n [A.ScopedDecl scope ds] ret = withScope_ scope $ checkWhere n ds ret+checkWhere n [A.Section _ m tel ds]  ret = do+  checkTelescope tel $ \tel' -> do+    reportSDoc "tc.def.where" 10 $+      text "adding section:" <+> prettyTCM m <+> text (show (size tel')) <+> text (show n)+    addSection m (size tel' + n)  -- the variables bound in the lhs+                                  -- are also parameters+    verboseS "tc.def.where" 10 $ do+      dx   <- prettyTCM m+      dtel <- mapM prettyA tel+      dtel' <- prettyTCM =<< lookupSection m+      liftIO $ UTF8.putStrLn $ "checking where section " ++ show dx ++ " " ++ show dtel+      liftIO $ UTF8.putStrLn $ "        actual tele: " ++ show dtel'+    x <- withCurrentModule m $ checkDecls ds >> ret+    return x+checkWhere _ _ _ = __IMPOSSIBLE__++-- | Check if a pattern contains an absurd pattern. For instance, @suc ()@+containsAbsurdPattern :: A.Pattern -> Bool+containsAbsurdPattern p = case p of+    A.AbsurdP _   -> True+    A.VarP _      -> False+    A.WildP _     -> False+    A.ImplicitP _ -> False+    A.DotP _ _    -> False+    A.LitP _      -> False+    A.AsP _ _ p   -> containsAbsurdPattern p+    A.ConP _ _ ps -> any (containsAbsurdPattern . namedThing . unArg) ps+    A.DefP _ _ _  -> __IMPOSSIBLE__++{-+-- | Type check a left-hand side.+checkLHS :: [NamedArg A.Pattern] -> Type -> ([Term] -> [String] -> [Arg Pattern] -> Type -> TCM a) -> TCM a+checkLHS ps t ret = do++    verbose 15 $ do+      dt  <- prettyTCM t+      dps <- mapM prettyA ps+      liftIO $ UTF8.putStrLn $ "checking clause " ++ show dps ++ " : " ++ show dt++    -- Save the state for later. (should this be done with the undo monad, or+    -- would that interfere with normal undo?)+    rollback <- do+        st  <- get+        env <- ask+        return $ \k -> do put st; local (const env) k++    -- Preliminary type checking to decide what should be variables and what+    -- should be dotted. Ignore empty types.+    runCheckPatM (checkPatterns ps t) $ \xs metas _ (ps0, ps, ts, a) -> do++    -- Build the new pattern, turning implicit patterns into variables when+    -- they couldn't be solved.+    ps1 <- evalStateT (buildNewPatterns ps0) metas++    verbose 10 $ do+        d0 <- A.showA ps0+        d1 <- A.showA ps1+        liftIO $ do+        UTF8.putStrLn $ "first check"+        UTF8.putStrLn $ "  xs    = " ++ show xs+        UTF8.putStrLn $ "  metas = " ++ show metas+        UTF8.putStrLn $ "  ps0   = " ++ d0+        UTF8.putStrLn $ "  ps1   = " ++ d1++    verbose 10 $ do+        is <- mapM (instantiateFull . flip MetaV []) metas+        ds <- mapM prettyTCM is+        dts <- mapM prettyTCM =<< mapM instantiateFull ts+        liftIO $ UTF8.putStrLn $ "  is    = " ++ concat (intersperse ", " $ map show ds)+        liftIO $ UTF8.putStrLn $ "  ts    = " ++ concat (intersperse ", " $ map show dts)++    -- Now we forget that we ever type checked anything and type check the new+    -- pattern.+    rollback $ runCheckPatM (checkPatterns ps1 t)+             $ \xs metas emptyTypes (_, ps, ts, a) -> do++    -- Check that the empty types are indeed empty+    mapM_ isEmptyType emptyTypes++    verbose 10 $ liftIO $ do+        UTF8.putStrLn $ "second check"+        UTF8.putStrLn $ "  xs    = " ++ show xs+        UTF8.putStrLn $ "  metas = " ++ show metas++    verbose 10 $ do+        is <- mapM (instantiateFull . flip MetaV []) metas+        ds <- mapM prettyTCM is+        liftIO $ UTF8.putStrLn $ "  is    = " ++ concat (intersperse ", " $ map show ds)++    -- Finally we type check the dot patterns and check that they match their+    -- instantiations.+    evalStateT (checkDotPatterns ps1) metas++    reportLn 15 "dot patterns check out"++    -- Sanity check. Make sure that all metas were instantiated.+    is <- mapM lookupMeta metas+    case [ getRange i | i <- is, FirstOrder <- [mvInstantiation i] ] of+        [] -> return ()+        rs -> fail $ "unsolved pattern metas at\n" ++ unlines (map show rs)++    -- Make sure to purge the type and the context from any first-order metas.+    a    <- instantiateFull a+    flat <- instantiateFull =<< flatContext++    -- The context might not be well-formed. We may have to do some reordering.+    reportLn 20 $ "Before reordering:"+    verbose 20 $ dumpContext flat++    flat' <- reorderCtx flat++    -- Compute renamings to and from the new context+    let sub  = (computeSubst `on` map (fst . unArg)) flat flat'+        rsub = (computeSubst `on` map (fst . unArg)) flat' flat++    -- Apply the reordering to the types in the new context+    let flat'' = map (fmap $ id -*- substs sub) flat'++    reportLn 20 $ "After reordering:"+    verbose 20 $ dumpContext flat'++    -- Deflatten the context+    let ctx = mkContext flat''++    inContext ctx $ do++        verbose 20 $ do+            d <- prettyTCM ctx+            dt <- prettyTCM (substs sub a)+            liftIO $ UTF8.putStrLn $ "context = " ++ show d+            liftIO $ UTF8.putStrLn $ "type    = " ++ show dt++        reportLn 20 $ "finished type checking left hand side"+        ret rsub xs ps (substs sub a)+    where+        popMeta = do+            x : xs <- get+            put xs+            return x++        buildNewPatterns :: [NamedArg A.Pattern] -> StateT [MetaId] TCM [NamedArg A.Pattern]+        buildNewPatterns = mapM buildNewPattern'++        buildNewPattern' = (traverse . traverse) buildNewPattern++        buildNewPattern :: A.Pattern -> StateT [MetaId] TCM A.Pattern+        buildNewPattern (A.ImplicitP i) = do+            x <- popMeta+            v <- lift $ instantiate (MetaV x [])+            lift $ verbose 6 $ do+                d <- prettyTCM v+                liftIO $ UTF8.putStrLn $ "new pattern for " ++ show x ++ " = " ++ show d+            case v of+                -- Unsolved metas become variables+                MetaV y _ | x == y  -> return $ A.WildP i+                -- Anything else becomes dotted+                _                   -> do+                    lift $ verbose 6 $ do+                        d <- prettyTCM =<< instantiateFull v+                        liftIO $ UTF8.putStrLn $ show x ++ " := " ++ show d+                    scope <- lift getScope+                    return $ A.DotP i (A.Underscore $ info scope)+                    where info s = Info.MetaInfo (getRange i) s Nothing++        buildNewPattern p@(A.VarP _)    = return p+        buildNewPattern p@(A.WildP _)   = return p+        buildNewPattern p@(A.DotP _ _)  = popMeta >> return p+        buildNewPattern (A.AsP i x p)   = A.AsP i x <$> buildNewPattern p+        buildNewPattern (A.ConP i c ps) = A.ConP i c <$> buildNewPatterns ps+        buildNewPattern (A.DefP i c ps) = A.DefP i c <$> buildNewPatterns ps+        buildNewPattern p@(A.AbsurdP _) = return p+        buildNewPattern p@(A.LitP _)    = return p++        checkDotPatterns :: [NamedArg A.Pattern] -> StateT [MetaId] TCM ()+        checkDotPatterns = mapM_ checkDotPattern'++        checkDotPattern' p = (traverse . traverse) checkDotPattern p >> return ()++        checkDotPattern :: A.Pattern -> StateT [MetaId] TCM ()+        checkDotPattern (A.ImplicitP i) = __IMPOSSIBLE__    -- there should be no implicits left at this point+        checkDotPattern p@(A.VarP _)    = return ()+        checkDotPattern p@(A.WildP _)   = return ()+        checkDotPattern p@(A.DotP i e)  = do+            x <- popMeta+            lift $ do+                firstOrder <- isFirstOrder x    -- first order and uninstantiated+                when firstOrder $ typeError+                                $ InternalError -- TODO: proper error+                                $ "uninstantiated dot pattern at " ++ show (getRange i)+                HasType _ o <- mvJudgement <$> lookupMeta x+                a <- getOpen o+                v <- checkExpr e a+                noConstraints $ equalTerm t v (MetaV x [])+        checkDotPattern (A.AsP i x p)   = checkDotPattern p+        checkDotPattern (A.ConP i c ps) = checkDotPatterns ps+        checkDotPattern (A.DefP i c ps) = checkDotPatterns ps+        checkDotPattern p@(A.AbsurdP _) = return ()+        checkDotPattern p@(A.LitP _)    = return ()++        -- Get the flattened context+        flatContext :: TCM Context+        flatContext = do+            n <- size <$> getContext+            mapM f [0..n - 1]+            where+                f i = do+                    Arg h t <- instantiateFull =<< typeOfBV' i+                    x <- nameOfBV i+                    return $ Arg h (x, t)++        -- Reorder a flat context to make sure it's valid.+        reorderCtx :: Context -> TCM Context+        reorderCtx ctx = reverse <$> reorder (reverse ctx)+            where+                free t = mapM nameOfBV (Set.toList $ allVars $ freeVars t)++                reorder :: [Arg (Name, Type)] -> TCM [Arg (Name, Type)]+                reorder []            = return []+                reorder (Arg h (x,t) : tel) = do+                    tel' <- reorder tel+                    xs   <- free t+                    verbose 20 $ do+                        d <- prettyTCM t+                        liftIO $ UTF8.putStrLn $ "freeIn " ++ show x ++ " : " ++ show d ++ " are " ++ show xs+                    case intersect (map (fst . unArg) tel') xs of+                        [] -> return $ Arg h (x,t) : tel'+                        zs -> return $ ins zs (Arg h (x,t)) tel'++                ins [] p tel               = p : tel+                ins xs p (Arg h (x,t):tel) = Arg h (x,t) : ins (delete x xs) p tel+                ins (_:_) _ []             = __IMPOSSIBLE__++        -- Compute a renaming from the first names to the second.+        computeSubst :: [Name] -> [Name] -> [Term]+        computeSubst old new = map ix old+            where+                ix x = case findIndex (==x) new of+                        Just i  -> Var i []+                        Nothing -> __IMPOSSIBLE__++        -- Take a flat (but valid) context and turn it into a proper context.+        mkContext :: [Arg (Name, Type)] -> Context+        mkContext = reverse . mkCtx . reverse+            where+                mkCtx []          = []+                mkCtx ctx0@(Arg h (x,t) : ctx) = Arg h (x, substs sub t) : mkCtx ctx+                    where+                        sub = map err ctx0 ++ [ Var i [] | i <- [0..] ]++                        err (Arg _ (y,_)) = error $ show y ++ " occurs in the type of " ++ show x++        -- Print a flat context+        dumpContext :: Context -> TCM ()+        dumpContext ctx = do+            let pr (Arg h (x,t)) = do+                  d <- prettyTCM t+                  return $ "  " ++ par h (show x ++ " : " ++ show d)+                par Hidden    s = "{" ++ s ++ "}"+                par NotHidden s = "(" ++ s ++ ")"+            ds <- mapM pr ctx+            liftIO $ UTF8.putStr $ unlines $ reverse ds+-}++actualConstructor :: MonadTCM tcm => QName -> tcm QName+actualConstructor c = do+    v <- constructorForm =<< normalise (Con c [])+    case v of+        Con c _ -> return c+        _       -> actualConstructor =<< stripLambdas v+    where+        stripLambdas v = case v of+            Con c _ -> return c+            Lam h b -> do+                x <- freshName_ $ absName b+                addCtx x (Arg h $ sort Prop) $ stripLambdas (absBody b)+            _       -> typeError $ GenericError $ "Not a constructor: " ++ show c+

+ src/full/Agda/TypeChecking/Rules/Def.hs-boot view

@@ -0,0 +1,7 @@+module Agda.TypeChecking.Rules.Def where++import Agda.Syntax.Abstract+import Agda.Syntax.Info+import Agda.TypeChecking.Monad++checkFunDef :: Delayed -> DefInfo -> QName -> [Clause] -> TCM ()

+ src/full/Agda/TypeChecking/Rules/LHS.hs view

@@ -0,0 +1,583 @@+{-# LANGUAGE CPP #-}++module Agda.TypeChecking.Rules.LHS where++import Data.Maybe+import Control.Applicative+import Control.Monad++import Agda.Syntax.Internal+import Agda.Syntax.Internal.Pattern+import qualified Agda.Syntax.Abstract as A+import Agda.Syntax.Common+import Agda.Syntax.Info+import Agda.Syntax.Position++import Agda.TypeChecking.Monad+import Agda.TypeChecking.Pretty+import Agda.TypeChecking.Reduce+import Agda.TypeChecking.Substitute+import Agda.TypeChecking.Conversion+import Agda.TypeChecking.Constraints+import Agda.TypeChecking.Primitive (constructorForm)+import {-# SOURCE #-} Agda.TypeChecking.Empty (isEmptyType)+import Agda.TypeChecking.Telescope (renamingR, teleArgs)++import Agda.TypeChecking.Rules.Term (checkExpr)+import Agda.TypeChecking.Rules.LHS.Problem+import Agda.TypeChecking.Rules.LHS.Unify+import Agda.TypeChecking.Rules.LHS.Split+import Agda.TypeChecking.Rules.LHS.Implicit+import Agda.TypeChecking.Rules.LHS.Instantiate+import Agda.TypeChecking.Rules.Data++import Agda.Utils.Permutation+import Agda.Utils.Size+import Agda.Utils.Monad++#include "../../undefined.h"+import Agda.Utils.Impossible++data DotPatternInst = DPI A.Expr Term Type+data AsBinding      = AsB Name Term Type++instance Subst DotPatternInst where+  substs us      (DPI e v a) = uncurry (DPI e) $ substs us (v,a)+  substUnder n u (DPI e v a) = uncurry (DPI e) $ substUnder n u (v,a)++instance PrettyTCM DotPatternInst where+  prettyTCM (DPI e v a) = sep [ prettyA e <+> text "="+                              , nest 2 $ prettyTCM v <+> text ":"+                              , nest 2 $ prettyTCM a+                              ]++instance Subst AsBinding where+  substs us      (AsB x v a) = uncurry (AsB x) $ substs us (v, a)+  substUnder n u (AsB x v a) = uncurry (AsB x) $ substUnder n u (v, a)++instance Raise AsBinding where+  raiseFrom m k (AsB x v a) = uncurry (AsB x) $ raiseFrom m k (v, a)++instance PrettyTCM AsBinding where+  prettyTCM (AsB x v a) =+    sep [ prettyTCM x <> text "@" <> parens (prettyTCM v)+        , nest 2 $ text ":" <+> prettyTCM a+        ]++-- | Compute the set of flexible patterns in a list of patterns. The result is+--   the deBruijn indices of the flexible patterns. A pattern is flexible if it+--   is dotted or implicit.+flexiblePatterns :: [NamedArg A.Pattern] -> FlexibleVars+flexiblePatterns nps = [ i | (i, p) <- zip [0..] $ reverse ps, flexible p ]+  where+    ps = map (namedThing . unArg) nps+    flexible (A.DotP _ _)    = True+    flexible (A.ImplicitP _) = True+    flexible _               = False++-- | Compute the dot pattern instantiations.+dotPatternInsts :: [NamedArg A.Pattern] -> Substitution -> [Type] -> [DotPatternInst]+dotPatternInsts ps s as = dpi (map (namedThing . unArg) ps) (reverse s) as+  where+    dpi (_ : _)  []            _       = __IMPOSSIBLE__+    dpi (_ : _)  (Just _ : _)  []      = __IMPOSSIBLE__+    -- the substitution also contains entries for module parameters, so it can+    -- be longer than the pattern+    dpi []       _             _       = []+    dpi (_ : ps) (Nothing : s) as      = dpi ps s as+    dpi (p : ps) (Just u : s) (a : as) = +      case p of+        A.DotP _ e    -> DPI e u a : dpi ps s as+        A.ImplicitP _ -> dpi ps s as+        _           -> __IMPOSSIBLE__++instantiatePattern :: Substitution -> Permutation -> [Arg Pattern] -> [Arg Pattern]+instantiatePattern sub perm ps+  | length sub /= length hps = error $ unlines [ "instantiatePattern:"+                                               , "  sub  = " ++ show sub+                                               , "  perm = " ++ show perm+                                               , "  ps   = " ++ show ps+                                               ]+  | otherwise  = foldr merge ps $ zipWith inst (reverse sub) hps+  where+    hps = permute perm $ allHoles ps+    inst Nothing  hps = Nothing+    inst (Just t) hps = Just $ plugHole (DotP t) hps++    merge Nothing   ps = ps+    merge (Just qs) ps = zipWith mergeA qs ps+      where+        mergeA (Arg h p) (Arg _ q) = Arg h $ mergeP p q+        mergeP (DotP s)  (DotP t)+          | s == t                 = DotP s+          | otherwise              = __IMPOSSIBLE__+        mergeP (DotP t)  (VarP _)  = DotP t+        mergeP (VarP _)  (DotP t)  = DotP t+        mergeP (DotP _)  _         = __IMPOSSIBLE__+        mergeP _         (DotP _)  = __IMPOSSIBLE__+        mergeP (ConP c1 ps) (ConP c2 qs)+          | c1 == c2               = ConP (c1 `withRangeOf` c2) $ zipWith mergeA ps qs+          | otherwise              = __IMPOSSIBLE__+        mergeP (LitP l1) (LitP l2)+          | l1 == l2               = LitP (l1 `withRangeOf` l2)+          | otherwise              = __IMPOSSIBLE__+        mergeP (VarP x) (VarP y)+          | x == y                 = VarP x+          | otherwise              = __IMPOSSIBLE__+        mergeP (ConP _ _) (VarP _) = __IMPOSSIBLE__+        mergeP (ConP _ _) (LitP _) = __IMPOSSIBLE__+        mergeP (VarP _) (ConP _ _) = __IMPOSSIBLE__+        mergeP (VarP _) (LitP _)   = __IMPOSSIBLE__+        mergeP (LitP _) (ConP _ _) = __IMPOSSIBLE__+        mergeP (LitP _) (VarP _)   = __IMPOSSIBLE__++-- | Check if a problem is solved. That is, if the patterns are all variables.+isSolvedProblem :: Problem -> Bool+isSolvedProblem = all (isVar . snd . asView . namedThing . unArg) . problemInPat+  where+    isVar (A.VarP _)      = True+    isVar (A.WildP _)     = True+    isVar (A.ImplicitP _) = True+    isVar (A.AbsurdP _)   = True+    isVar _               = False++-- | For each user-defined pattern variable in the 'Problem', check+-- that the corresponding data type (if any) does not contain a+-- constructor of the same name (which is not in scope); this+-- \"shadowing\" could indicate an error, and is not allowed.+--+-- Precondition: The problem has to be solved.++noShadowingOfConstructors+  :: A.Clause+     -- ^ The entire clause (used for error reporting).+  -> Problem -> TCM ()+noShadowingOfConstructors c problem =+  traceCall (CheckPatternShadowing c) $ do+    let pat = map (snd . asView . namedThing . unArg) $+                  problemInPat problem+        tel = map (unEl . snd . unArg) $ telToList $ problemTel problem+    zipWithM' noShadowing pat tel+    return ()+  where+  noShadowing (A.WildP     {}) t = return ()+  noShadowing (A.AbsurdP   {}) t = return ()+  noShadowing (A.ImplicitP {}) t = return ()+  noShadowing (A.ConP      {}) t = __IMPOSSIBLE__+  noShadowing (A.DefP      {}) t = __IMPOSSIBLE__+  noShadowing (A.AsP       {}) t = __IMPOSSIBLE__+  noShadowing (A.DotP      {}) t = __IMPOSSIBLE__+  noShadowing (A.LitP      {}) t = __IMPOSSIBLE__+  noShadowing (A.VarP x)       t = do+    t <- normalise t+    case t of+      Def t _ -> do+        d <- theDef <$> getConstInfo t+        case d of+          Datatype { dataCons = cs } -> do+            let ns = map (\c -> (c, A.nameConcrete $ A.qnameName c)) cs+                match x = catMaybes $+                            map (\(c, n) -> if A.nameConcrete x == n+                                            then Just c else Nothing) ns+            case match x of+              []      -> return ()+              (c : _) -> setCurrentRange (getRange x) $+                typeError $ PatternShadowsConstructor x c+          Axiom       {} -> return ()+          Function    {} -> return ()+          Record      {} -> return ()+          Constructor {} -> __IMPOSSIBLE__+          Primitive   {} -> __IMPOSSIBLE__+      Var   {} -> return ()+      Pi    {} -> return ()+      Fun   {} -> return ()+      Sort  {} -> return ()+      MetaV {} -> return ()+      -- TODO: If the type is a meta-variable, should the test be+      -- postponed? If there is a problem, then it will be caught when+      -- the completed module is type checked, so it is safe to skip+      -- the test here. However, users may be annoyed if they get an+      -- error in code which has already passed the type checker.+      Lam   {} -> __IMPOSSIBLE__+      Lit   {} -> __IMPOSSIBLE__+      Con   {} -> __IMPOSSIBLE__++-- | Check that a dot pattern matches it's instantiation.+checkDotPattern :: DotPatternInst -> TCM ()+checkDotPattern (DPI e v a) =+  traceCall (CheckDotPattern e v) $ do+  reportSDoc "tc.lhs.dot" 15 $+    sep [ text "checking dot pattern"+        , nest 2 $ prettyA e+        , nest 2 $ text "=" <+> prettyTCM v+        , nest 2 $ text ":" <+> prettyTCM a+        ]+  u <- checkExpr e 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.+bindLHSVars :: [NamedArg A.Pattern] -> Telescope -> TCM a -> TCM a+bindLHSVars []       (ExtendTel _ _)   _   = __IMPOSSIBLE__+bindLHSVars (_ : _)   EmptyTel         _   = __IMPOSSIBLE__+bindLHSVars []        EmptyTel         ret = ret+bindLHSVars (p : ps) (ExtendTel a tel) ret =+  case namedThing $ unArg p of+    A.VarP x      -> addCtx x a $ bindLHSVars ps (absBody tel) ret+    A.WildP _     -> bindDummy (absName tel)+    A.ImplicitP _ -> bindDummy (absName tel)+    A.AbsurdP _   -> do+      isEmptyType $ unArg a+      bindDummy (absName tel)+    _             -> __IMPOSSIBLE__+    where+      name "_" = freshNoName_+      name s   = freshName_ ("." ++ s)+      bindDummy s = do+        x <- name s+        addCtx x a $ bindLHSVars ps (absBody tel) ret++-- | Bind as patterns+bindAsPatterns :: [AsBinding] -> TCM a -> TCM a+bindAsPatterns []                ret = ret+bindAsPatterns (AsB x v a : asb) ret = do+  reportSDoc "tc.lhs.as" 10 $ text "as pattern" <+> prettyTCM x <+>+    sep [ text ":" <+> prettyTCM a+        , text "=" <+> prettyTCM v+        ]+  addLetBinding x v a $ bindAsPatterns asb ret++-- | Rename the variables in a telescope using the names from a given pattern+useNamesFromPattern :: [NamedArg A.Pattern] -> Telescope -> Telescope+useNamesFromPattern ps = telFromList . zipWith ren (toPats ps ++ repeat dummy) . telToList+  where+    dummy = A.WildP __IMPOSSIBLE__+    ren (A.VarP x) (Arg NotHidden (_, a)) = Arg NotHidden (show x, a)+    ren _ a = a+    toPats = map (namedThing . unArg)++-- | Check a LHS. Main function.+checkLeftHandSide+  :: A.Clause+     -- ^ The entire clause.+  -> [NamedArg A.Pattern]+     -- ^ The patterns.+  -> Type+     -- ^ The expected type.+  -> (Telescope -> Telescope -> [Term] -> [String] -> [Arg Pattern]+      -> Type -> Permutation -> TCM a)+     -- ^ Continuation.+  -> TCM a+checkLeftHandSide c ps a ret = do+  a <- normalise a+  let TelV tel0' b0 = telView a+  ps <- insertImplicitPatterns ps tel0'+  unless (size tel0' >= size ps) $ typeError $ TooManyArgumentsInLHS (size ps) a+  let tel0     = useNamesFromPattern ps tel0'   +      (as, bs) = splitAt (size ps) $ telToList tel0+      gamma    = telFromList as+      b        = telePi (telFromList bs) b0++      -- internal patterns start as all variables+      ips      = map (fmap (VarP . fst)) as++      problem  = Problem ps (idP $ size ps, ips) gamma++  reportSDoc "tc.lhs.top" 10 $+    vcat [ text "checking lhs:"+	 , nest 2 $ vcat+	   [ text "ps    =" <+> fsep (map prettyA ps)+	   , text "a     =" <+> prettyTCM a+	   , text "a'    =" <+> prettyTCM (telePi tel0  b0)+	   , text "a''   =" <+> prettyTCM (telePi tel0' b0)+           , text "xs    =" <+> text (show $ map (fst . unArg) as)+	   , text "tel0  =" <+> prettyTCM tel0+	   , text "b0    =" <+> prettyTCM b0+	   , text "gamma =" <+> prettyTCM gamma+	   , text "b     =" <+> addCtxTel gamma (prettyTCM b)+	   ]+	 ]++  let idsub = [ Var i [] | i <- [0..] ]++  (Problem ps (perm, qs) delta, sigma, dpi, asb) <- checkLHS problem idsub [] []+  let b' = substs sigma b++  noPatternMatchingOnCodata $+    zip (map (not . (== "_") . fst . unArg) as) qs++  reportSDoc "tc.lhs.top" 10 $+    vcat [ text "checked lhs:"+	 , nest 2 $ vcat+	   [ text "ps    = " <+> fsep (map prettyA ps)+	   , text "perm  = " <+> text (show perm)+	   , text "delta = " <+> prettyTCM delta+	   , text "dpi   = " <+> brackets (fsep $ punctuate comma $ map prettyTCM dpi)+	   , text "asb   = " <+> brackets (fsep $ punctuate comma $ map prettyTCM asb)+           , text "qs    = " <+> text (show qs)+	   ]+         ]+  bindLHSVars ps delta $ bindAsPatterns asb $ do+    reportSDoc "tc.lhs.top" 10 $ nest 2 $ text "type  = " <+> prettyTCM b'+    mapM_ checkDotPattern dpi+    let rho = renamingR perm -- I'm not certain about this...+        Perm n _ = perm+        xs  = replicate (fromIntegral n) "h"+    ret gamma delta rho xs qs b' perm+  where+    checkLHS :: Problem -> [Term] -> [DotPatternInst] -> [AsBinding] ->+                TCM (Problem, [Term], [DotPatternInst], [AsBinding])+    checkLHS problem sigma dpi asb+      | isSolvedProblem problem = do+        problem <- insertImplicitProblem problem -- inserting implicit patterns preserves solvedness+        noShadowingOfConstructors c problem+        return (problem, sigma, dpi, asb)+      | otherwise               = do+        sp <- splitProblem =<< insertImplicitProblem problem+        reportSDoc "tc.lhs.top" 20 $ text "splitting completed"+        case sp of+          Left NothingToSplit   -> nothingToSplitError problem+          Left (SplitPanic err) -> __IMPOSSIBLE__++          -- Split on literal pattern+          Right (Split p0 xs (Arg h (LitFocus lit iph hix a)) p1) -> do++            -- plug the hole with a lit pattern+            let ip    = plugHole (LitP lit) iph+                iperm = expandP (fromIntegral hix) 0 $ fst (problemOutPat problem)++            -- substitute the literal in p1 and sigma and dpi and asb+            let delta1 = problemTel p0+                delta2 = absApp (fmap problemTel p1) (Lit lit)+                rho    = [ var i | i <- [0..size delta2 - 1] ]+                      ++ [ raise (size delta2) $ Lit lit ]+                      ++ [ var i | i <- [size delta2 ..] ]+                  where+                    var i = Var i []+                sigma'   = substs rho sigma+                dpi'     = substs rho dpi+                asb0     = substs rho asb+                ip'      = substs rho ip++            -- Compute the new problem+            let ps'      = problemInPat p0 ++ problemInPat (absBody p1)+                delta'   = abstract delta1 delta2+                problem' = Problem ps' (iperm, ip') delta'+                asb'     = raise (size delta2) (map (\x -> AsB x (Lit lit) a) xs) ++ asb0+            checkLHS problem' sigma' dpi' asb'++          -- Split on constructor pattern+          Right (Split p0 xs (Arg h+                  ( Focus { focusCon      = c+                          , focusConArgs  = qs+                          , focusRange    = r+                          , focusOutPat   = iph+                          , focusHoleIx   = hix+                          , focusDatatype = d+                          , focusParams   = vs+                          , focusIndices  = ws+                          }+                  )) p1+                ) -> traceCall (CheckPattern (A.ConP (PatRange r) (A.AmbQ [c]) qs)+                                             (problemTel p0)+                                             (El Prop $ Def d $ vs ++ ws)) $ do++            let delta1 = problemTel p0++            reportSDoc "tc.lhs.top" 10 $ sep+              [ text "checking lhs"+              , nest 2 $ text "tel =" <+> prettyTCM (problemTel problem)+              ]++            reportSDoc "tc.lhs.split" 15 $ sep+              [ text "split problem"+              , nest 2 $ vcat+                [ text "delta1 = " <+> prettyTCM delta1+                , text "delta2 = " <+> prettyTCM (problemTel $ absBody p1)+                ]+              ]++            Con c' [] <- constructorForm =<< normalise (Con c [])+            c <- return $ c' `withRangeOf` c++            ca <- defType <$> getConstInfo c++            reportSDoc "tc.lhs.top" 20 $ nest 2 $ vcat+              [ text "ca =" <+> prettyTCM ca+              , text "vs =" <+> prettyList (map prettyTCM vs)+              ]++            -- Lookup the type of the constructor at the given parameters+            a <- normalise =<< (`piApply` vs) . defType <$> getConstInfo c++            -- It will end in an application of the datatype+            let TelV gamma' ca@(El _ (Def d' us)) = telView a++            -- This should be the same datatype as we split on+            unless (d == d') $ typeError $ ShouldBeApplicationOf ca d'++            -- Insert implicit patterns+            qs' <- insertImplicitPatterns qs gamma'++            unless (size qs' == size gamma') $+              typeError $ WrongNumberOfConstructorArguments c (size gamma') (size qs')++            let gamma = useNamesFromPattern qs' gamma'++            -- Get the type of the datatype.+            da <- normalise =<< (`piApply` vs) . defType <$> getConstInfo d++            -- Compute the flexible variables+            let flex = flexiblePatterns (problemInPat p0 ++ qs')++	    reportSDoc "tc.lhs.top" 15 $ addCtxTel delta1 $+	      sep [ text "preparing to unify"+		  , nest 2 $ vcat+		    [ text "c      =" <+> prettyTCM c <+> text ":" <+> prettyTCM a+		    , text "d      =" <+> prettyTCM d <+> text ":" <+> prettyTCM da+		    , text "gamma  =" <+> prettyTCM gamma+		    , text "gamma' =" <+> prettyTCM gamma'+		    , text "vs     =" <+> brackets (fsep $ punctuate comma $ map prettyTCM vs)+		    , text "ws     =" <+> brackets (fsep $ punctuate comma $ map prettyTCM ws)+		    ]+		  ]++            -- Unify constructor target and given type (in Δ₁Γ)+            sub0 <- addCtxTel (delta1 `abstract` gamma) $+                    unifyIndices_ flex (raise (size gamma) da) (drop (size vs) us) (raise (size gamma) ws)++            -- We should subsitute c ys for x in Δ₂ and sigma+            let ys     = teleArgs gamma+                delta2 = absApp (raise (size gamma) $ fmap problemTel p1) (Con c ys)+                rho0 = [ var i | i <- [0..size delta2 - 1] ]+                    ++ [ raise (size delta2) $ Con c ys ]+                    ++ [ var i | i <- [size delta2 + size gamma ..] ]+                  where+                    var i = Var i []+                sigma0 = substs rho0 sigma+                dpi0   = substs rho0 dpi+                asb0   = substs rho0 asb++            reportSDoc "tc.lhs.top" 15 $ addCtxTel (delta1 `abstract` gamma) $ nest 2 $ vcat+              [ text "delta2 =" <+> prettyTCM delta2+              , text "sub0   =" <+> brackets (fsep $ punctuate comma $ map (maybe (text "_") prettyTCM) sub0)+              ]+            reportSDoc "tc.lhs.top" 15 $ addCtxTel (delta1 `abstract` gamma `abstract` delta2) $+              nest 2 $ vcat+                [ text "dpi0 = " <+> brackets (fsep $ punctuate comma $ map prettyTCM dpi0)+                , text "asb0 = " <+> brackets (fsep $ punctuate comma $ map prettyTCM asb0)+                ]++            -- Plug the hole in the out pattern with c ys+            let ysp = map (fmap (VarP . fst)) $ telToList gamma+                ip  = plugHole (ConP c ysp) iph+                ip0 = substs rho0 ip++            -- Δ₁Γ ⊢ sub0, we need something in Δ₁ΓΔ₂+            -- Also needs to be padded with Nothing's to have the right length.+            let pad n xs x = xs ++ replicate (max 0 $ n - size xs) x+                newTel = problemTel p0 `abstract` (gamma `abstract` delta2)+                sub    = replicate (size delta2) Nothing +++                         pad (size delta1 + size gamma) (raise (size delta2) sub0) Nothing++            reportSDoc "tc.lhs.top" 15 $ nest 2 $ vcat+              [ text "newTel =" <+> prettyTCM newTel+              , addCtxTel newTel $ text "sub =" <+> brackets (fsep $ punctuate comma $ map (maybe (text "_") prettyTCM) sub)+              , text "ip  =" <+> text (show ip)+              , text "ip0  = " <+> text (show ip0)+              ]++            -- Instantiate the new telescope with the given substitution+            (delta', perm, rho, instTypes) <- instantiateTel sub newTel+++            reportSDoc "tc.lhs.inst" 12 $+              vcat [ sep [ text "instantiateTel"+                         , nest 4 $ brackets $ fsep $ punctuate comma $ map (maybe (text "_") prettyTCM) sub+                         , nest 4 $ prettyTCM newTel+                         ]+                   , nest 2 $ text "delta' =" <+> prettyTCM delta'+                   , nest 2 $ text "perm   =" <+> text (show perm)+                   , nest 2 $ text "itypes =" <+> fsep (punctuate comma $ map prettyTCM instTypes)+                   ]++            -- Compute the new dot pattern instantiations+            let ps0'   = problemInPat p0 ++ qs' ++ problemInPat (absBody p1)+                newDpi = dotPatternInsts ps0' (substs rho sub) instTypes++            reportSDoc "tc.lhs.top" 15 $ nest 2 $ vcat+              [ text "subst rho sub =" <+> brackets (fsep $ punctuate comma $ map (maybe (text "_") prettyTCM) (substs rho sub))+              , text "ps0'  =" <+> brackets (fsep $ punctuate comma $ map prettyA ps0')+              ]++            -- The final dpis and asbs are the new ones plus the old ones substituted by ρ+            let dpi' = substs rho dpi0 ++ newDpi+                asb' = substs rho $ asb0 ++ raise (size delta2) (map (\x -> AsB x (Con c ys) ca) xs)++            reportSDoc "tc.lhs.top" 15 $ nest 2 $ vcat+              [ text "dpi' = " <+> brackets (fsep $ punctuate comma $ map prettyTCM dpi')+              , text "asb' = " <+> brackets (fsep $ punctuate comma $ map prettyTCM asb')+              ]++            -- Apply the substitution to the type+            let sigma'   = substs rho sigma0++            reportSDoc "tc.lhs.inst" 15 $+              nest 2 $ text "ps0 = " <+> brackets (fsep $ punctuate comma $ map prettyA ps0')++            -- Permute the in patterns+            let ps'  = permute perm ps0'++           -- Compute the new permutation of the out patterns. This is the composition of+            -- the new permutation with the expansion of the old permutation to+            -- reflect the split.+            let perm'  = expandP (fromIntegral hix) (size gamma) $ fst (problemOutPat problem)+                iperm' = perm `composeP` perm'++            -- Instantiate the out patterns+            let ip'    = instantiatePattern sub perm' ip0+                newip  = substs rho ip'++            -- Construct the new problem+            let problem' = Problem ps' (iperm', newip) delta'++            reportSDoc "tc.lhs.top" 12 $ sep+              [ text "new problem"+              , nest 2 $ vcat+                [ text "ps'    = " <+> fsep (map prettyA ps')+                , text "delta' = " <+> prettyTCM delta'+                ]+              ]++            reportSDoc "tc.lhs.top" 14 $ nest 2 $ vcat+              [ text "perm'  =" <+> text (show perm')+              , text "iperm' =" <+> text (show iperm')+              ]+            reportSDoc "tc.lhs.top" 14 $ nest 2 $ vcat+              [ text "ip'    =" <+> text (show ip')+              , text "newip  =" <+> text (show newip)+              ]++            -- Continue splitting+            checkLHS problem' sigma' dpi' asb'++-- Ensures that we are not performing dependent pattern matching on+-- codata.++noPatternMatchingOnCodata+  :: MonadTCM tcm+  => [(Bool, Arg Pattern)]  -- ^ True stands for dependent pattern matching.+  -> tcm ()+noPatternMatchingOnCodata = mapM_ check . map (unArg . snd) . filter fst+  where+  check (VarP {})   = return ()+  check (DotP {})   = return ()+  check (LitP {})   = return ()  -- Literals are assumed not to be coinductive.+  check (ConP q ps) = do+    TelV _ t <- telView . defType <$> getConstInfo q+    c <- isCoinductive t+    case c of+      Nothing    -> __IMPOSSIBLE__+      Just False -> mapM_ (check . unArg) ps+      Just True  -> typeError DependentPatternMatchingOnCodata

+ src/full/Agda/TypeChecking/Rules/LHS/Implicit.hs view

@@ -0,0 +1,59 @@+{-# LANGUAGE CPP #-}++module Agda.TypeChecking.Rules.LHS.Implicit where++import Control.Applicative++import Agda.Syntax.Common+import Agda.Syntax.Position+import Agda.Syntax.Info+import Agda.Syntax.Internal+import qualified Agda.Syntax.Abstract as A++import Agda.TypeChecking.Monad+import Agda.TypeChecking.Implicit+import Agda.TypeChecking.Substitute+import Agda.TypeChecking.Pretty++import Agda.TypeChecking.Rules.LHS.Problem++#include "../../../undefined.h"+import Agda.Utils.Impossible++-- | Insert implicit patterns in a problem.+insertImplicitProblem :: Problem -> TCM Problem+insertImplicitProblem (Problem ps qs tel) = do+  reportSDoc "tc.lhs.imp" 15 $+    sep [ text "insertImplicits"+	, nest 2 $ brackets $ fsep $ punctuate comma $ map prettyA ps+	, nest 2 $ prettyTCM tel+	]+  ps' <- insertImplicitPatterns ps tel+  return $ Problem ps' qs tel++-- | Insert implicit patterns in a list of patterns.+insertImplicitPatterns :: [NamedArg A.Pattern] -> Telescope -> TCM [NamedArg A.Pattern]+insertImplicitPatterns ps EmptyTel = return ps+insertImplicitPatterns ps tel@(ExtendTel _ tel') = case ps of+  [] -> do+    i <- insImp dummy tel+    case i of+      Just n	-> return $ replicate n implicitP+      Nothing	-> return []+  p : ps -> do+    i <- insImp p tel+    case i of+      Just 0	-> __IMPOSSIBLE__+      Just n	-> insertImplicitPatterns (replicate n implicitP ++ p : ps) tel+      Nothing	-> (p :) <$> insertImplicitPatterns ps (absBody tel')+  where+    dummy = Arg NotHidden $ unnamed ()++    insImp x tel = case insertImplicit x $ map (fmap fst) $ telToList tel of+      BadImplicits   -> typeError $ WrongHidingInLHS (telePi tel $ sort Prop)+      NoSuchName x   -> typeError $ WrongHidingInLHS (telePi tel $ sort Prop)+      ImpInsert n    -> return $ Just n+      NoInsertNeeded -> return Nothing++    implicitP = Arg Hidden . unnamed . A.ImplicitP . PatRange $ noRange+

+ src/full/Agda/TypeChecking/Rules/LHS/Instantiate.hs view

@@ -0,0 +1,133 @@+{-# LANGUAGE CPP #-}++module Agda.TypeChecking.Rules.LHS.Instantiate where++import Agda.Syntax.Common+import Agda.Syntax.Internal+import qualified Agda.Syntax.Abstract as A++import Agda.TypeChecking.Monad+import Agda.TypeChecking.Substitute+import Agda.TypeChecking.Free+import Agda.TypeChecking.Pretty+import Agda.TypeChecking.Reduce+import Agda.TypeChecking.Telescope++import Agda.TypeChecking.Rules.LHS.Problem+import Agda.TypeChecking.Rules.LHS.Split ( asView )++import Agda.Utils.Permutation+import Agda.Utils.Size++#include "../../../undefined.h"+import Agda.Utils.Impossible++-- | Instantiate a telescope with a substitution. Might reorder the telescope.+--   @instantiateTel (Γ : Tel)(σ : Γ --> Γ) = Γσ~@+--   Monadic only for debugging purposes.+instantiateTel :: MonadTCM tcm => Substitution -> Telescope -> tcm (Telescope, Permutation, [Term], [Type])+instantiateTel s tel = liftTCM $ do++  reportSDoc "tc.lhs.inst" 10 $ sep+    [ text "instantiateTel "+    , nest 2 $ fsep $ punctuate comma $ map (maybe (text "_") prettyTCM) s+    , nest 2 $ prettyTCM tel+    ]++  -- Shrinking permutation (removing Justs) (and its complement, and reverse)+  let ps  = Perm (size s) [ i | (i, Nothing) <- zip [0..] $ reverse s ]+      psR = reverseP ps+      psC = Perm (size s) [ i | (i, Just _)  <- zip [0..] $ reverse s ]++  reportS "tc.lhs.inst" 10 $ unlines+    [ "ps  = " ++ show ps+    , "psR = " ++ show psR+    , "psC = " ++ show psC+    ]++  -- s' : Substitution Γσ+  let s' = rename psR s++  reportSDoc "tc.lhs.inst" 15 $ nest 2 $ +    text "s'   =" <+> fsep (punctuate comma $ map (maybe (text "_") prettyTCM) s')++  -- rho : [Tm Γσ]Γ+  let rho = mkSubst s'++  -- tel1 : [Type Γ]Γ+  let tel1   = flattenTel tel+      names1 = teleNames tel++  reportSDoc "tc.lhs.inst" 15 $ nest 2 $ +    text "tel1 =" <+> brackets (fsep $ punctuate comma $ map prettyTCM tel1)++  -- tel2 : [Type Γσ]Γ+  let tel2 = substs rho tel1++  reportSDoc "tc.lhs.inst" 15 $ nest 2 $ +    text "tel2 =" <+> brackets (fsep $ punctuate comma $ map prettyTCM tel2)++  -- tel3 : [Type Γσ]Γσ+  tel3 <- instantiateFull $ permute ps tel2+  let names3 = permute ps names1++  reportSDoc "tc.lhs.inst" 15 $ nest 2 $ +    text "tel3 =" <+> brackets (fsep $ punctuate comma $ map prettyTCM tel3)++  -- p : Permutation (Γσ -> Γσ~)+  let p = reorderTel tel3++  reportSLn "tc.lhs.inst" 10 $ "p   = " ++ show p++  -- rho' : [Term Γσ~]Γσ+  let rho' = renaming (reverseP p)++  -- tel4 : [Type Γσ~]Γσ~+  let tel4   = substs rho' (permute p tel3)+      names4 = permute p names3++  reportSDoc "tc.lhs.inst" 15 $ nest 2 $ +    text "tel4 =" <+> brackets (fsep $ punctuate comma $ map prettyTCM tel4)++  -- tel5 = Γσ~+  let tel5 = unflattenTel names4 tel4++  reportSDoc "tc.lhs.inst" 15 $ nest 2 $ +    text "tel5 =" <+> prettyTCM tel5++  -- remember the types of the instantiations+  -- itypes : [Type Γσ~]Γ*+  let itypes = substs rho' $ permute psC $ map unArg tel2++  return (tel5, composeP p ps, substs rho' rho, itypes)+  where++    -- Turn a Substitution ([Maybe Term]) into a substitution ([Term])+    -- (The result is an infinite list)+    mkSubst :: [Maybe Term] -> [Term]+    mkSubst s = rho 0 s'+      where s'  = s ++ repeat Nothing+	    rho i (Nothing : s) = Var i [] : rho (i + 1) s+	    rho i (Just u  : s) = u : rho i s+	    rho _ []		= __IMPOSSIBLE__++-- | Produce a nice error message when splitting failed+nothingToSplitError :: Problem -> TCM a+nothingToSplitError (Problem ps _ tel) = splitError ps tel+  where+    splitError []	EmptyTel    = __IMPOSSIBLE__+    splitError (_:_)	EmptyTel    = __IMPOSSIBLE__+    splitError []	ExtendTel{} = __IMPOSSIBLE__+    splitError (p : ps) (ExtendTel a tel)+      | isBad p   = traceCall (CheckPattern (strip p) EmptyTel (unArg a)) $ case strip p of+	  A.DotP _ e -> typeError $ UninstantiatedDotPattern e+	  p	     -> typeError $ IlltypedPattern p (unArg a)+      | otherwise = underAbstraction a tel $ \tel -> splitError ps tel+      where+	strip = snd . asView . namedThing . unArg+	isBad p = case strip p of+	  A.DotP _ _   -> True+	  A.ConP _ _ _ -> True+	  A.LitP _     -> True+	  _	       -> False+

+ src/full/Agda/TypeChecking/Rules/LHS/Problem.hs view

@@ -0,0 +1,55 @@++module Agda.TypeChecking.Rules.LHS.Problem where++import Control.Monad.Error+import Data.Monoid++import Agda.Syntax.Common+import Agda.Syntax.Literal+import Agda.Syntax.Position+import Agda.Syntax.Internal+import Agda.Syntax.Internal.Pattern+import qualified Agda.Syntax.Abstract as A++import Agda.TypeChecking.Substitute++import Agda.Utils.Permutation++type Substitution   = [Maybe Term]+type FlexibleVars   = [Nat]++data Problem' p	    = Problem { problemInPat  :: [NamedArg A.Pattern]+			      , problemOutPat :: p+			      , problemTel    :: Telescope+			      }+data Focus	    = Focus   { focusCon      :: QName+			      , focusConArgs  :: [NamedArg A.Pattern]+			      , focusRange    :: Range+			      , focusOutPat   :: OneHolePatterns+			      , focusHoleIx   :: Int  -- ^ index of focused variable in the out patterns+			      , focusDatatype :: QName+			      , focusParams   :: [Arg Term]+			      , focusIndices  :: [Arg Term]+			      }+		    | LitFocus Literal OneHolePatterns Int Type+data SplitProblem   = Split ProblemPart [Name] (Arg Focus) (Abs ProblemPart)+                      -- ^ the [Name]s give the as-bindings for the focus++data SplitError	    = NothingToSplit+		    | SplitPanic String++type ProblemPart = Problem' ()++-- | The permutation should permute @allHoles@ of the patterns to correspond to+--   the abstract patterns in the problem.+type Problem	 = Problem' (Permutation, [Arg Pattern])++instance Error SplitError where+  noMsg  = NothingToSplit+  strMsg = SplitPanic++instance Monoid p => Monoid (Problem' p) where+  mempty = Problem [] mempty EmptyTel+  Problem ps1 qs1 tel1 `mappend` Problem ps2 qs2 tel2 =+    Problem (ps1 ++ ps2) (mappend qs1 qs2) (abstract tel1 tel2)+

+ src/full/Agda/TypeChecking/Rules/LHS/Split.hs view

@@ -0,0 +1,125 @@+{-# LANGUAGE CPP #-}++module Agda.TypeChecking.Rules.LHS.Split where++import Control.Applicative+import Control.Monad.Error+import Data.Monoid+import Data.List++import Agda.Syntax.Common+import Agda.Syntax.Literal+import Agda.Syntax.Position+import Agda.Syntax.Internal+import Agda.Syntax.Internal.Pattern+import qualified Agda.Syntax.Abstract as A+import qualified Agda.Syntax.Info as A++import Agda.TypeChecking.Monad+import Agda.TypeChecking.Pretty+import Agda.TypeChecking.Reduce+import Agda.TypeChecking.Constraints+import Agda.TypeChecking.Conversion+import Agda.TypeChecking.Rules.LHS.Problem+import Agda.TypeChecking.Rules.Term+import Agda.TypeChecking.Monad.Builtin++import Agda.Utils.Permutation+import Agda.Utils.Tuple++#include "../../../undefined.h"+import Agda.Utils.Impossible++instance (Monad m, Error err) => Applicative (ErrorT err m) where+  pure	= return+  (<*>) = ap++instance (Error err, MonadTCM tcm) => MonadTCM (ErrorT err tcm) where+  liftTCM = lift . liftTCM++-- | TODO: move to Agda.Syntax.Abstract.View+asView :: A.Pattern -> ([Name], A.Pattern)+asView (A.AsP _ x p) = (x :) -*- id $ asView p+asView p	     = ([], p)++-- | Split a problem at the first constructor of datatype type. Implicit+--   patterns should have been inserted.+splitProblem :: Problem -> TCM (Either SplitError SplitProblem)+splitProblem (Problem ps (perm, qs) tel) = do+    reportS "tc.lhs.split" 20 $ "initiating splitting\n"+    runErrorT $+      splitP ps (permute perm $ zip [0..] $ allHoles qs) tel+  where+    splitP :: [NamedArg A.Pattern] -> [(Int, OneHolePatterns)] -> Telescope -> ErrorT SplitError TCM SplitProblem+    splitP _	    []		 (ExtendTel _ _)	 = __IMPOSSIBLE__+    splitP _	    (_:_)	  EmptyTel		 = __IMPOSSIBLE__+    splitP []	     _		  _			 = throwError $ NothingToSplit+    splitP ps	    []		  EmptyTel		 = __IMPOSSIBLE__+    splitP (p : ps) ((i, q) : qs) tel0@(ExtendTel a tel) =+      case asView $ namedThing $ unArg p of+	(xs, A.LitP (LitInt r n)) | n < 0     -> __IMPOSSIBLE__+                                  | n > 20    -> typeError $ GenericError $+                                                "Matching on natural number literals is done by expanding "+                                                ++ "the literal to the corresponding constructor pattern, so "+                                                ++ "you probably don't want to do it this way."+                                  | otherwise -> do+          Con z _ <- primZero+          Con s  _ <- primSuc+          let zero  = A.ConP info (A.AmbQ [setRange r z]) []+              suc p = A.ConP info (A.AmbQ [setRange r s]) [Arg NotHidden $ unnamed p]+              info  = A.PatRange r+              p'    = fmap (fmap $ const $ foldr ($) zero $ replicate (fromIntegral n) suc) p+          splitP (p' : ps) ((i, q) : qs) tel0+	(xs, A.LitP lit)  -> do+	  b <- lift $ litType lit+	  ok <- lift $ do+	      noConstraints (equalType (unArg a) b)+	      return True+	    `catchError` \_ -> return False+	  if ok+	    then return $+	      Split mempty+		    xs+		    (fmap (LitFocus lit q i) a)+		    (fmap (Problem ps ()) tel)+	    else keepGoing+	(xs, p@(A.ConP _ (A.AmbQ cs) args)) -> do+	  a' <- reduce $ unArg a+	  case unEl a' of+	    Def d vs	-> do+	      def <- theDef <$> getConstInfo d+	      case def of+		Datatype{dataPars = np} ->+		  traceCall (CheckPattern p EmptyTel (unArg a)) $ do  -- TODO: wrong telescope+                  -- Check that we construct something in the right datatype+                  c <- do+                      cs' <- mapM canonicalName cs+                      d'  <- canonicalName d+                      Datatype{dataCons = cs0} <- theDef <$> getConstInfo d'+                      case [ c | (c, c') <- zip cs cs', elem c' cs0 ] of+                        c : _ -> return c   -- if there are more than one they will+                                            -- all have the same canonical form+                        []    -> typeError $ ConstructorPatternInWrongDatatype (head cs) d+		  let (pars, ixs) = genericSplitAt np vs+		  reportSDoc "tc.lhs.split" 10 $+		    vcat [ sep [ text "splitting on"+			       , nest 2 $ fsep [ prettyA p, text ":", prettyTCM a ]+			       ]+			 , nest 2 $ text "pars =" <+> fsep (punctuate comma $ map prettyTCM pars)+			 , nest 2 $ text "ixs  =" <+> fsep (punctuate comma $ map prettyTCM ixs)+			 ]+		  return $ Split mempty+				 xs+				 (fmap (const $ Focus c args (getRange p) q i d pars ixs) a)+				 (fmap (Problem ps ()) tel)+		-- TODO: record patterns+		_ -> keepGoing+	    _	-> keepGoing+	p -> keepGoing+      where+	keepGoing = do+	  let p0 = Problem [p] () (ExtendTel a $ fmap (const EmptyTel) tel)+	  Split p1 xs foc p2 <- underAbstraction a tel $ \tel -> splitP ps qs tel+	  return $ Split (mappend p0 p1) xs foc p2++

+ src/full/Agda/TypeChecking/Rules/LHS/Unify.hs view

@@ -0,0 +1,326 @@+{-# LANGUAGE CPP, MultiParamTypeClasses, GeneralizedNewtypeDeriving #-}++module Agda.TypeChecking.Rules.LHS.Unify where++import Control.Applicative+import Control.Monad.State+import Control.Monad.Reader+import Control.Monad.Error++import Data.Map (Map)+import qualified Data.Map as Map+import Data.List++import Agda.Syntax.Common+import Agda.Syntax.Internal+import Agda.Syntax.Position++import Agda.TypeChecking.Monad+import Agda.TypeChecking.Monad.Exception+import Agda.TypeChecking.Conversion+import Agda.TypeChecking.Constraints+import Agda.TypeChecking.Reduce+import Agda.TypeChecking.Pretty+import Agda.TypeChecking.Substitute+import Agda.TypeChecking.Free+import Agda.TypeChecking.Records+import Agda.TypeChecking.Primitive (constructorForm)+import Agda.TypeChecking.MetaVars (assignV, newArgsMetaCtx)+import Agda.TypeChecking.EtaContract++import Agda.TypeChecking.Rules.LHS.Problem++#include "../../../undefined.h"+import Agda.Utils.Impossible++newtype Unify a = U { unUnify :: ExceptionT UnifyException (StateT UnifyState TCM) a }+  deriving (Monad, MonadIO, Functor, Applicative, MonadReader TCEnv, MonadException UnifyException)++data Equality = Equal Type Term Term+type Sub = Map Nat Term++data UnifyException = ConstructorMismatch Type Term Term+                    | GenericUnifyException String++instance Error UnifyException where+  noMsg  = strMsg ""+  strMsg = GenericUnifyException++data UnifyState = USt { uniSub	  :: Sub+		      , uniConstr :: [Equality]+		      }++emptyUState = USt Map.empty []++constructorMismatch :: Type -> Term -> Term -> Unify a+constructorMismatch a u v = throwException $ ConstructorMismatch a u v++instance MonadState TCState Unify where+  get = U . lift . lift $ get+  put = U . lift . lift . put++instance MonadTCM Unify where+  liftTCM = U . lift . lift++instance Subst Equality where+  substs us	 (Equal a s t) = Equal (substs us a)	  (substs us s)	     (substs us t)+  substUnder n u (Equal a s t) = Equal (substUnder n u a) (substUnder n u s) (substUnder n u t)++getSub :: Unify Sub+getSub = U $ gets uniSub++onSub :: (Sub -> a) -> Unify a+onSub f = U $ gets $ f . uniSub++modSub :: (Sub -> Sub) -> Unify ()+modSub f = U $ modify $ \s -> s { uniSub = f $ uniSub s }++checkEqualities :: [Equality] -> TCM ()+checkEqualities eqs = noConstraints $ concat <$> mapM checkEq eqs+  where+    checkEq (Equal a s t) = equalTerm a s t++addEquality :: Type -> Term -> Term -> Unify ()+addEquality a u v = U $ modify $ \s -> s { uniConstr = Equal a u v : uniConstr s }++takeEqualities :: Unify [Equality]+takeEqualities = U $ do+  s <- get+  put $ s { uniConstr = [] }+  return $ uniConstr s++-- | Includes flexible occurrences, metas need to be solved. TODO: relax?+--   TODO: later solutions may remove flexible occurences+occursCheck :: Nat -> Term -> Type -> Unify ()+occursCheck i u a+  | i `freeIn` u = do+    reportSDoc "tc.lhs.unify" 20 $ prettyTCM (Var i []) <+> text "occurs in" <+> prettyTCM u+    typeError $ UnequalTerms CmpEq (Var i []) u a+  | otherwise	 = return ()++(|->) :: Nat -> (Term, Type) -> Unify ()+i |-> (u, a) = do+  occursCheck i u a+  reportSDoc "tc.lhs.unify" 15 $ prettyTCM (Var i []) <+> text ":=" <+> prettyTCM u+  modSub $ Map.insert i (killRange u)++makeSubstitution :: Sub -> [Term]+makeSubstitution sub = map val [0..]+  where+    val i = maybe (Var i []) id $ Map.lookup i sub++-- | Apply the current substitution on a term and reduce to weak head normal form.+ureduce :: Term -> Unify Term+ureduce u = do+  rho <- onSub makeSubstitution+  liftTCM $ etaContract <$> reduce (substs rho u)++-- | Take a substitution σ and ensure that no variables from the domain appear+--   in the targets. The context of the targets is not changed.+--   TODO: can this be expressed using makeSubstitution and substs?+flattenSubstitution :: Substitution -> Substitution+flattenSubstitution s = foldr instantiate s is+  where+    -- instantiated variables+    is = [ i | (i, Just _) <- zip [0..] s ]++    instantiate :: Nat -> Substitution -> Substitution+    instantiate i s = map (fmap $ inst i u) s+      where+	Just u = s !! fromIntegral i++    inst :: Nat -> Term -> Term -> Term+    inst i u v = substs us v+      where us = [var j | j <- [0..i - 1] ] ++ [u] ++ [var j | j <- [i + 1..] ]+	    var j = Var j []++data UnificationResult = Unifies Substitution | NoUnify Type Term Term | DontKnow TCErr++-- | Unify indices.+unifyIndices_ :: MonadTCM tcm => FlexibleVars -> Type -> [Arg Term] -> [Arg Term] -> tcm Substitution+unifyIndices_ flex a us vs = liftTCM $ do+  r <- unifyIndices flex a us vs+  case r of+    Unifies sub   -> return sub+    DontKnow err  -> throwError err+    NoUnify a u v -> typeError $ UnequalTerms CmpEq u v a++unifyIndices :: MonadTCM tcm => FlexibleVars -> Type -> [Arg Term] -> [Arg Term] -> tcm UnificationResult+unifyIndices flex a us vs = liftTCM $ do+    reportSDoc "tc.lhs.unify" 10 $+      sep [ text "unifyIndices"+          , nest 2 $ text (show flex)+          , nest 2 $ parens (prettyTCM a)+          , nest 2 $ prettyList $ map prettyTCM us+          , nest 2 $ prettyList $ map prettyTCM vs+          , nest 2 $ text "context: " <+> (prettyTCM =<< getContextTelescope)+          ]+    (r, USt s eqs) <- flip runStateT emptyUState . runExceptionT . unUnify $+                      unifyArgs a us vs >> recheckConstraints++    case r of+      Left (ConstructorMismatch a u v)  -> return $ NoUnify a u v+      Left (GenericUnifyException err)  -> fail err+      Right _                           -> do+        checkEqualities $ substs (makeSubstitution s) eqs+        let n = maximum $ (-1) : flex+        return $ Unifies $ flattenSubstitution [ Map.lookup i s | i <- [0..n] ]+  `catchError` \err -> return $ DontKnow err+  where+    flexible i = i `elem` flex++    unifyArgs :: Type -> [Arg Term] -> [Arg Term] -> Unify ()+    unifyArgs _ (_ : _) [] = __IMPOSSIBLE__+    unifyArgs _ [] (_ : _) = __IMPOSSIBLE__+    unifyArgs _ [] [] = return ()+    unifyArgs a us0@(arg@(Arg _ u) : us) vs0@(Arg _ v : vs) = do+      reportSDoc "tc.lhs.unify" 15 $ sep+        [ text "unifyArgs"+	, nest 2 $ parens (prettyTCM a)+	, nest 2 $ prettyList $ map prettyTCM us0+	, nest 2 $ prettyList $ map prettyTCM vs0+        ]+      a <- reduce a+      case funView $ unEl a of+	FunV (Arg _ b) _  -> do+	  unify b u v+	  unifyArgs (a `piApply` [arg]) us vs+	_	  -> __IMPOSSIBLE__++    recheckConstraints :: Unify ()+    recheckConstraints = mapM_ unifyEquality =<< takeEqualities++    unifyEquality :: Equality -> Unify ()+    unifyEquality (Equal a u v) = unify a u v++    i |->> x = do+      i |-> x+      recheckConstraints++    unifySizes :: Term -> Term -> Unify ()+    unifySizes u v = do+      sz <- sizeType+      su <- sizeView u+      sv <- sizeView v+      case (su, sv) of+        (SizeSuc u, SizeInf) -> unify sz u v+        (SizeInf, SizeSuc v) -> unify sz u v+        _                    -> unifyAtom sz u v++    -- TODO: eta for records here+    unify :: Type -> Term -> Term -> Unify ()+    unify a u v = do+      u <- constructorForm =<< ureduce u+      v <- constructorForm =<< ureduce v+      reportSDoc "tc.lhs.unify" 15 $+	sep [ text "unify"+	    , nest 2 $ parens $ prettyTCM u+	    , nest 2 $ parens $ prettyTCM v+	    , nest 2 $ text ":" <+> prettyTCM a+	    ]+      isSize <- isSizeType a+      if isSize then unifySizes u v+                else unifyAtom a u v++    unifyAtom :: Type -> Term -> Term -> Unify ()+    unifyAtom a u v =+      case (u, v) of+	(Var i us, Var j vs) | i == j  -> do+	    a <- typeOfBV i+	    unifyArgs a us vs+	(Var i [], v) | flexible i -> i |->> (v, a)+	(u, Var j []) | flexible j -> j |->> (u, a)+	(Con c us, Con c' vs)+          | c == c' -> do+              -- The type is a datatype or a record.+              Def d args <- reduce $ unEl a+              -- Get the number of parameters.+              def <- theDef <$> getConstInfo d+              a'  <- case def of+                Datatype{dataPars = n} -> do+                  a <- defType <$> getConstInfo c+                  return $ piApply a (genericTake n args)+                Record{recPars = n} -> getRecordConstructorType d (genericTake n args)+                _		    -> __IMPOSSIBLE__+              unifyArgs a' us vs+          | otherwise -> constructorMismatch a u v+        -- Definitions are ok as long as they can't reduce (i.e. datatypes/axioms)+	(Def d us, Def d' vs)+          | d == d' -> do+              -- d must be a data, record or axiom+              def <- getConstInfo d+              let ok = case theDef def of+                    Datatype{} -> True+                    Record{}   -> True+                    Axiom{}    -> True+                    _          -> False+              if ok+                then unifyArgs (defType def) us vs+                else addEquality a u v+        (Lit l1, Lit l2)+          | l1 == l2  -> return ()+          | otherwise -> constructorMismatch a u v++        -- We can instantiate metas if the other term is inert (constructor application)+        (MetaV m us, v) -> do+            ok <- liftTCM $ instMeta a m us v+            reportSDoc "tc.lhs.unify" 40 $+              vcat [ fsep [ text "inst meta", text $ if ok then "(ok)" else "(not ok)" ]+                   , nest 2 $ sep [ prettyTCM u, text ":=", prettyTCM =<< normalise u ]+                   ]+            if ok then unify a u v+                  else addEquality a u v+        (u, MetaV m vs) -> do+            ok <- liftTCM $ instMeta a m vs u+            reportSDoc "tc.lhs.unify" 40 $+              vcat [ fsep [ text "inst meta", text $ if ok then "(ok)" else "(not ok)" ]+                   , nest 2 $ sep [ prettyTCM v, text ":=", prettyTCM =<< normalise v ]+                   ]+            if ok then unify a u v+                  else addEquality a u v+	_  -> addEquality a u v++    instMeta a m us v = do+      app <- inertApplication a v+      reportSDoc "tc.lhs.unify" 50 $+        sep [ text "inert"+              <+> sep [ text (show m), text (show us), parens $ prettyTCM v ]+            , nest 2 $ text "==" <+> text (show app)+            ]+      case app of+        Nothing -> return False+        Just (v', b, _) -> do+            margs <- do+              -- The new metas should have the same dependencies as the original meta+              mi <- getMetaInfo <$> lookupMeta m+              withMetaInfo mi $ do+                tel <- getContextTelescope+                -- important: create the meta in the same environment as the original meta+                newArgsMetaCtx b tel us+            noConstraints $ assignV a m us (v' `apply` margs)+            return True+          `catchError` \_ -> return False++    inertApplication :: Type -> Term -> TCM (Maybe (Term, Type, Args))+    inertApplication a v =+      case v of+        Con c vs -> do+          Def d args <- reduce $ unEl a+          def <- theDef <$> getConstInfo d+          b   <- case def of+            Datatype{dataPars = n} -> do+              a <- defType <$> getConstInfo c+              return $ piApply a (genericTake n args)+            Record{recPars = n} -> getRecordConstructorType d (genericTake n args)+            _		    -> __IMPOSSIBLE__+          return $ Just (Con c [], b, vs)+        Def d vs -> do+          def <- getConstInfo d+          let ans = Just (Def d [], defType def, vs)+          return $ case theDef def of+            Datatype{} -> ans+            Record{}   -> ans+            Axiom{}    -> ans+            _          -> Nothing+        _        -> return Nothing+

+ src/full/Agda/TypeChecking/Rules/Record.hs view

@@ -0,0 +1,198 @@+{-# LANGUAGE CPP #-}++module Agda.TypeChecking.Rules.Record where++import Control.Applicative+import Control.Monad.Trans+import Control.Monad.Reader++import qualified Agda.Syntax.Abstract as A+import Agda.Syntax.Common+import Agda.Syntax.Internal+import Agda.Syntax.Position+import qualified Agda.Syntax.Info as Info++import Agda.TypeChecking.Monad+import Agda.TypeChecking.Substitute+import Agda.TypeChecking.Reduce+import Agda.TypeChecking.Pretty+import Agda.TypeChecking.Polarity++import Agda.TypeChecking.Rules.Data ( bindParameters, fitsIn )+import Agda.TypeChecking.Rules.Term ( isType_ )+import {-# SOURCE #-} Agda.TypeChecking.Rules.Decl (checkDecl)++import Agda.Utils.Size+import Agda.Utils.Permutation++#include "../../undefined.h"+import Agda.Utils.Impossible++---------------------------------------------------------------------------+-- * Records+---------------------------------------------------------------------------++checkRecDef :: Info.DefInfo -> QName -> [A.LamBinding] -> A.Expr -> [A.Constructor] -> TCM ()+checkRecDef i name ps contel fields =+  noMutualBlock $ -- records can't be recursive anyway+  traceCall (CheckRecDef (getRange i) (qnameName name) ps fields) $ do+    t <- instantiateFull =<< typeOfConst name+    bindParameters ps t $ \tel t0 -> do+      t0' <- normalise t0+      s <- case unEl t0' of+	Sort s	-> return s+	_	-> typeError $ ShouldBeASort t0+      gamma <- getContextTelescope+      let m = mnameFromList $ qnameToList name+	  hide (Arg _ x) = Arg Hidden x+	  htel		 = map hide $ telToList tel+	  rect		 = El s $ Def name $ reverse +			   [ Arg h (Var i [])+			   | (i, Arg h _) <- zip [0..] $ reverse $ telToList gamma+			   ]+	  tel'		 = telFromList $ htel ++ [Arg NotHidden ("r", rect)]+          extWithR ret   = underAbstraction (Arg NotHidden rect) (Abs "r" ()) $ \_ -> ret+          ext (Arg h (x, t)) = addCtx x (Arg h t)++      let getName (A.Field _ x _)      = [x]+	  getName (A.ScopedDecl _ [f]) = getName f+	  getName _		       = []++      ctx <- (reverse . map hide . take (size tel)) <$> getContext++      -- We have to rebind the parameters to make them hidden+      -- Check the field telescope+      contype <- killRange <$> (instantiateFull =<< isType_ contel)+      let TelV ftel _ = telView contype++      escapeContext (size tel) $ flip (foldr ext) ctx $ extWithR $ do+	reportSDoc "tc.rec.def" 10 $ sep+	  [ text "record section:"+	  , nest 2 $ sep+            [ prettyTCM m <+> (prettyTCM =<< getContextTelescope)+            , fsep $ punctuate comma $ map (text . show . getName) fields+            ]+	  ]+        reportSDoc "tc.rec.def" 15 $ nest 2 $ vcat+          [ text "field tel =" <+> prettyTCM ftel+          ]+	addSection m (size tel')++        -- Check the types of the fields+        -- ftel <- checkRecordFields m name tel s [] (size fields) fields+        withCurrentModule m $ checkRecordProjections m name tel' (raise 1 ftel) s fields++      -- Check that the fields fit inside the sort+      telePi ftel t0 `fitsIn` s++      addConstant name $ Defn name t0 (defaultDisplayForm name) 0+		       $ Record { recPars           = size tel+                                , recClause         = Nothing+				, recFields         = concatMap getName fields+                                , recTel            = ftel+                                , recSort           = s+				, recAbstr          = Info.defAbstract i+                                , recPolarity       = []+                                , recArgOccurrences = []+                                }+      computePolarity name++      return ()++{-| @checkRecordProjections q tel ftel s vs n fs@:+    @m@: name of the generated module+    @q@: name of the record+    @tel@: parameters+    @s@: sort of the record+    @ftel@: telescope of fields+    @vs@: values of previous fields (should have one free variable, which is+	  the record)+    @fs@: the fields to be checked+-}+checkRecordProjections ::+  ModuleName -> QName -> Telescope -> Telescope -> Sort ->+  [A.Declaration] -> TCM ()+checkRecordProjections m q tel ftel s fs = checkProjs EmptyTel ftel fs+  where+    checkProjs :: Telescope -> Telescope -> [A.Declaration] -> TCM ()+    checkProjs _ _ [] = return ()+    checkProjs ftel1 ftel2 (A.ScopedDecl scope fs' : fs) =+      setScope scope >> checkProjs ftel1 ftel2 (fs' ++ fs)+    checkProjs ftel1 (ExtendTel (Arg _ _) ftel2) (A.Field info x t : fs) = do+      -- check the type (in the context of the telescope)+      -- the previous fields will be free in +      reportSDoc "tc.rec.proj" 5 $ sep+	[ text "checking projection"+	, nest 2 $ vcat+	  [ text "top   =" <+> (prettyTCM =<< getContextTelescope)+	  , text "ftel1 =" <+> prettyTCM ftel1+	  , text "ftel2 =" <+> addCtxTel ftel1 (underAbstraction_ ftel2 prettyTCM)+	  , text "t     =" <+> prettyTCM t+	  ]+	]+      let add (x, t) = addCtx x (Arg NotHidden t)+          n          = size ftel++      t <- isType_ t++      -- create the projection functions (instantiate the type with the values+      -- of the previous fields)++      {- what are the contexts?++	  Γ, tel            ⊢ t+	  Γ, tel, r         ⊢ vs+	  Γ, tel, r, ftel₁  ⊢ raiseFrom (size ftel₁) 1 t+      -}++      -- The type of the projection function should be+      --  {tel} -> (r : R Δ) -> t+      -- where Δ = Γ, tel is the current context+      delta <- getContextTelescope+      let finalt   = telePi tel t+	  projname = qualify m $ qnameName x++      reportSDoc "tc.rec.proj" 10 $ sep+	[ text "adding projection"+	, nest 2 $ prettyTCM projname <+> text ":" <+> prettyTCM finalt+	]++      -- The body should be+      --  P.xi {tel} (r _ .. x .. _) = x+      let ptel   = telFromList $ take (size tel - 1) $ telToList tel+          hps	 = map (fmap $ VarP . fst) $ telToList ptel+	  conp	 = Arg NotHidden+		 $ ConP q $ map (Arg NotHidden)+			    [ VarP "x" | _ <- [1..n] ]+	  nobind 0 = id+	  nobind n = NoBind . nobind (n - 1)+	  body	 = nobind (size tel - 1)+		 $ nobind (size ftel1)+		 $ Bind . Abs "x"+		 $ nobind (size ftel2)+		 $ Body $ Var 0 []+          cltel  = ptel `abstract` ftel+	  clause = Clause { clauseRange = getRange info+                          , clauseTel   = cltel+                          , clausePerm  = idP $ size ptel + size ftel+                          , clausePats  = hps ++ [conp]+                          , clauseBody  = body+                          }+      escapeContext (size tel) $ do+	addConstant projname $ Defn projname finalt (defaultDisplayForm projname) 0+          $ Function { funClauses        = [clause]+                     , funDelayed        = NotDelayed+                     , funInv            = NotInjective+                     , funAbstr          = ConcreteDef+                     , funPolarity       = []+                     , funArgOccurrences = map (const Unused) hps ++ [Negative]+                     }+        computePolarity projname++      checkProjs (abstract ftel1 $ ExtendTel (Arg NotHidden t)+                                 $ Abs (show $ qnameName projname) EmptyTel+                 ) (absBody ftel2) fs+    checkProjs ftel1 ftel2 (d : fs) = do+      checkDecl d+      checkProjs ftel1 ftel2 fs+

+ src/full/Agda/TypeChecking/Rules/Term.hs view

@@ -0,0 +1,616 @@+{-# LANGUAGE CPP, PatternGuards #-}++module Agda.TypeChecking.Rules.Term where++import Control.Applicative+import Control.Monad.Trans+import Control.Monad.Reader+import Control.Monad.Error+import Data.Maybe+import Data.List hiding (sort)+import qualified System.IO.UTF8 as UTF8+import qualified Data.Map as Map++import qualified Agda.Syntax.Abstract as A+import qualified Agda.Syntax.Abstract.Views as A+import qualified Agda.Syntax.Info as A+import Agda.Syntax.Common+import Agda.Syntax.Fixity+import Agda.Syntax.Internal+import Agda.Syntax.Internal.Generic+import Agda.Syntax.Position+import Agda.Syntax.Literal+import Agda.Syntax.Abstract.Views++import Agda.TypeChecking.Monad+import Agda.TypeChecking.Monad.Builtin+import Agda.TypeChecking.Substitute+import Agda.TypeChecking.Reduce+import Agda.TypeChecking.MetaVars+import Agda.TypeChecking.Pretty+import Agda.TypeChecking.Records+import Agda.TypeChecking.Conversion+import Agda.TypeChecking.Primitive+import Agda.TypeChecking.Constraints++import Agda.Utils.Fresh+import Agda.Utils.Tuple+import Agda.Utils.Permutation++import {-# SOURCE #-} Agda.TypeChecking.Empty (isEmptyTypeC)+import {-# SOURCE #-} Agda.TypeChecking.Rules.Decl (checkSectionApplication)+import {-# SOURCE #-} Agda.TypeChecking.Rules.Def (checkFunDef)++import Agda.Utils.Monad+import Agda.Utils.Size++#include "../../undefined.h"+import Agda.Utils.Impossible++---------------------------------------------------------------------------+-- * Types+---------------------------------------------------------------------------++-- | Check that an expression is a type.+isType :: A.Expr -> Sort -> TCM Type+isType e s =+    traceCall (IsTypeCall e s) $ do+    v <- checkExpr e (sort s)+    return $ El s v++-- | Check that an expression is a type without knowing the sort.+isType_ :: A.Expr -> TCM Type+isType_ e =+    traceCall (IsType_ e) $ do+    s <- newSortMeta+    isType e s+++-- | Force a type to be a Pi. Instantiates if necessary. The 'Hiding' is only+--   used when instantiating a meta variable.+forcePi :: MonadTCM tcm => Hiding -> String -> Type -> tcm (Type, Constraints)+forcePi h name (El s t) =+    do	t' <- reduce t+	case t' of+	    Pi _ _	-> return (El s t', [])+	    Fun _ _	-> return (El s t', [])+            _           -> do+                sa <- newSortMeta+                sb <- newSortMeta+                let s' = sLub sa sb++                a <- newTypeMeta sa+                x <- freshName_ name+		let arg = Arg h a+                b <- addCtx x arg $ newTypeMeta sb+                let ty = El s' $ Pi arg (Abs (show x) b)+                cs <- equalType (El s t') ty+                ty' <- reduce ty+                return (ty', cs)+++---------------------------------------------------------------------------+-- * Telescopes+---------------------------------------------------------------------------++-- | Type check a telescope. Binds the variables defined by the telescope.+checkTelescope :: A.Telescope -> (Telescope -> TCM a) -> TCM a+checkTelescope [] ret = ret EmptyTel+checkTelescope (b : tel) ret =+    checkTypedBindings b $ \tel1 ->+    checkTelescope tel   $ \tel2 ->+	ret $ abstract tel1 tel2+++-- | Check a typed binding and extends the context with the bound variables.+--   The telescope passed to the continuation is valid in the original context.+checkTypedBindings :: A.TypedBindings -> (Telescope -> TCM a) -> TCM a+checkTypedBindings (A.TypedBindings i h bs) ret =+    thread (checkTypedBinding h) bs $ \bss ->+    ret $ foldr (\(x,t) -> ExtendTel (Arg h t) . Abs x) EmptyTel (concat bss)++checkTypedBinding :: Hiding -> A.TypedBinding -> ([(String,Type)] -> TCM a) -> TCM a+checkTypedBinding h (A.TBind i xs e) ret = do+    t <- isType_ e+    addCtxs xs (Arg h t) $ ret $ mkTel xs t+    where+	mkTel [] t     = []+	mkTel (x:xs) t = (show $ nameConcrete x,t) : mkTel xs (raise 1 t)+checkTypedBinding h (A.TNoBind e) ret = do+    t <- isType_ e+    ret [("_",t)]+++---------------------------------------------------------------------------+-- * Literal+---------------------------------------------------------------------------++checkLiteral :: Literal -> Type -> TCM Term+checkLiteral lit t = do+    t' <- litType lit+    v  <- blockTerm t (Lit lit) $ leqType t' t+    return v++litType :: Literal -> TCM Type+litType l = case l of+    LitInt _ _	  -> el <$> primNat+    LitFloat _ _  -> el <$> primFloat+    LitChar _ _   -> el <$> primChar+    LitString _ _ -> el <$> primString+  where+    el t = El (Type 0) t++---------------------------------------------------------------------------+-- * Terms+---------------------------------------------------------------------------++-- TODO: move somewhere suitable+reduceCon :: MonadTCM tcm => QName -> tcm QName+reduceCon c = do+  Con c [] <- constructorForm =<< reduce (Con c [])+  return c++checkArguments' exph r args t0 t e k = do+  z <- runErrorT $ checkArguments exph r args t0 t+  case z of+    Right (vs, t1, cs) -> k vs t1 cs+    Left t0 -> do+      let unblock = do+            t0 <- reduceB $ unEl t0+            case t0 of+              Blocked{}          -> return False+              NotBlocked MetaV{} -> return False+              _                  -> return True+      postponeTypeCheckingProblem e t unblock++-- | Type check an expression.+checkExpr :: A.Expr -> Type -> TCM Term+checkExpr e t =+    traceCall (CheckExpr e t) $ localScope $ do+    reportSDoc "tc.term.expr.top" 15 $+        text "Checking" <+> sep+	  [ fsep [ prettyTCM e, text ":", prettyTCM t ]+	  , nest 2 $ text "at " <+> (text . show =<< getCurrentRange)+	  ]+    t <- reduce t+    reportSDoc "tc.term.expr.top" 15 $+        text "    --> " <+> prettyTCM t+    let scopedExpr (A.ScopedExpr scope e) = setScope scope >> scopedExpr e+	scopedExpr e			  = return e+    e <- scopedExpr e+    case e of++	-- Insert hidden lambda if appropriate+	_   | not (hiddenLambdaOrHole e)+	    , FunV (Arg Hidden _) _ <- funView (unEl t) -> do+		x <- freshName r (argName t)+                reportSLn "tc.term.expr.impl" 15 $ "Inserting implicit lambda"+		checkExpr (A.Lam (A.ExprRange $ getRange e) (A.DomainFree Hidden x) e) t+	    where+		r = case rStart $ getRange e of+                      Nothing  -> noRange+                      Just pos -> posToRange pos pos++                hiddenLambdaOrHole (A.AbsurdLam _ Hidden)                                  = True+		hiddenLambdaOrHole (A.Lam _ (A.DomainFree Hidden _) _)			   = True+		hiddenLambdaOrHole (A.Lam _ (A.DomainFull (A.TypedBindings _ Hidden _)) _) = True+		hiddenLambdaOrHole (A.QuestionMark _)					   = True+		hiddenLambdaOrHole _							   = False++	-- Variable or constant application+	_   | Application (HeadCon cs@(_:_:_)) args <- appView e -> do+                -- First we should figure out which constructor we want.+                reportSLn "tc.check.term" 40 $ "Ambiguous constructor: " ++ show cs++                -- Get the datatypes of the various constructors+                let getData Constructor{conData = d} = d+                    getData _                        = __IMPOSSIBLE__+                reportSLn "tc.check.term" 40 $ "  ranges before: " ++ show (getRange cs)+                cs  <- zipWith setRange (map getRange cs) <$> mapM reduceCon cs+                reportSLn "tc.check.term" 40 $ "  ranges after: " ++ show (getRange cs)+                reportSLn "tc.check.term" 40 $ "  reduced: " ++ show cs+                dcs <- mapM (\c -> (getData /\ const c) . theDef <$> getConstInfo c) cs++                -- Lets look at the target type at this point+                let getCon = do+                      t <- normalise t+                      let TelV _ t1 = telView t+                      t1 <- reduceB $ unEl t1+                      reportSDoc "tc.check.term.con" 40 $ nest 2 $+                        text "target type: " <+> prettyTCM t1+                      case t1 of+                        NotBlocked (Def d _) -> do+                          defn <- theDef <$> getConstInfo d+                          case defn of+                            Datatype{} ->+                              case [ c | (d', c) <- dcs, d == d' ] of+                                c:_   -> return (Just c)+                                []    -> typeError $ DoesNotConstructAnElementOf+                                          (head cs) (Def d [])+                            _ -> typeError $ DoesNotConstructAnElementOf (head cs) (ignoreBlocking t1)+                        NotBlocked (MetaV _ _)  -> return Nothing+                        Blocked{} -> return Nothing+                        _ -> typeError $ DoesNotConstructAnElementOf (head cs) (ignoreBlocking t1)+                let unblock = isJust <$> getCon+                mc <- getCon+                case mc of+                  Just c  -> checkHeadApplication e t (HeadCon [c]) args+                  Nothing -> postponeTypeCheckingProblem e t unblock++            | Application hd args <- appView e -> checkHeadApplication e t hd args++	A.WithApp _ e es -> typeError $ NotImplemented "type checking of with application"++	A.App i e arg -> do+	    (v0, t0)	 <- inferExpr e+	    checkArguments' ExpandLast (getRange e) [arg] t0 t e $ \vs t1 cs ->+	      blockTerm t (apply v0 vs) $ (cs ++) <$> leqType t1 t++        A.AbsurdLam i h -> do+          t <- reduceB =<< instantiateFull t+          case t of+            Blocked{}                 -> postponeTypeCheckingProblem_ e $ ignoreBlocking t+            NotBlocked (El _ MetaV{}) -> postponeTypeCheckingProblem_ e $ ignoreBlocking t+            NotBlocked t' -> case funView $ unEl t' of+              FunV (Arg h' a) _+                | h == h' && not (null $ foldTerm metas a) ->+                    postponeTypeCheckingProblem e (ignoreBlocking t) $+                      null . foldTerm metas <$> instantiateFull a+                | h == h' -> do+                  cs' <- isEmptyTypeC a+                  -- Add helper function+                  top <- currentModule+                  let name = "absurd"+                  aux <- qualify top <$> freshName (getRange i) name+                  reportSDoc "tc.term.absurd" 10 $ vcat+                    [ text "Adding absurd function" <+> prettyTCM aux+                    , nest 2 $ text "of type" <+> prettyTCM t'+                    ]+                  addConstant aux $ Defn aux t' (defaultDisplayForm aux) 0+                                  $ Function+                                    { funClauses        =+                                        [Clause { clauseRange = getRange e+                                                , clauseTel   = EmptyTel+                                                , clausePerm  = Perm 0 []+                                                , clausePats  = [Arg h $ VarP "()"]+                                                , clauseBody  = NoBody+                                                }+                                        ]+                                    , funDelayed        = NotDelayed+                                    , funInv            = NotInjective+                                    , funAbstr          = ConcreteDef+                                    , funPolarity       = [Covariant]+                                    , funArgOccurrences = [Unused]+                                    }+                  blockTerm t' (Def aux []) $ return cs'+                | otherwise -> typeError $ WrongHidingInLambda t'+              _ -> typeError $ ShouldBePi t'+          where+            metas (MetaV m _) = [m]+            metas _           = []++	A.Lam i (A.DomainFull b) e -> do+	    (v, cs) <- checkTypedBindings b $ \tel -> do+	        t1 <- newTypeMeta_+                cs <- escapeContext (size tel) $ leqType (telePi tel t1) t+                v <- checkExpr e t1+                return (teleLam tel v, cs)+	    blockTerm t v (return cs)+	    where+		name (Arg h (x,_)) = Arg h x++	A.Lam i (A.DomainFree h x) e0 -> do+	    -- (t',cs) <- forcePi h (show x) t+            t <- reduceB t+            case t of+              Blocked{}                 -> postponeTypeCheckingProblem_ e $ ignoreBlocking t+              NotBlocked (El _ MetaV{}) -> postponeTypeCheckingProblem_ e $ ignoreBlocking t+              NotBlocked t' -> case funView $ unEl t' of+		FunV arg0@(Arg h' a) _+		    | h == h' -> do+			v <- addCtx x arg0 $ do+                              let arg = Arg h (Var 0 [])+                                  tb  = raise 1 t' `piApply` [arg]+                              v <- checkExpr e0 tb+                              return $ Lam h $ Abs (show x) v+			-- blockTerm t v (return cs)+                        return v+		    | otherwise ->+			typeError $ WrongHidingInLambda t'+		_   -> typeError $ ShouldBePi t'++	A.QuestionMark i -> do+	    setScope (A.metaScope i)+	    newQuestionMark  t+	A.Underscore i   -> do+	    setScope (A.metaScope i)+	    newValueMeta t++	A.Lit lit    -> checkLiteral lit t+	A.Let i ds e -> checkLetBindings ds $ checkExpr e t+	A.Pi _ tel e -> do+	    t' <- checkTelescope tel $ \tel -> telePi_ tel <$> isType_ e+	    blockTerm t (unEl t') $ leqType (sort $ getSort t') t+	A.Fun _ (Arg h a) b -> do+	    a' <- isType_ a+	    b' <- isType_ b+	    let s = getSort a' `sLub` getSort b'+	    blockTerm t (Fun (Arg h a') b') $ leqType (sort s) t+	A.Set _ n    -> do+          n <- ifM typeInType (return 0) (return n)+	  blockTerm t (Sort (Type n)) $ leqType (sort $ Type $ n + 1) t+	A.Prop _     -> do+          s <- ifM typeInType (return $ Type 0) (return Prop)+	  blockTerm t (Sort Prop) $ leqType (sort $ Type 1) t++	A.Rec _ fs  -> do+	  t <- normalise t+	  case unEl t of+	    Def r vs  -> do+	      xs    <- getRecordFieldNames r+	      ftel  <- getRecordFieldTypes r+              scope <- getScope+              let meta = A.Underscore $ A.MetaInfo (getRange e) scope Nothing+	      es   <- orderFields r meta xs fs+	      let tel = ftel `apply` vs+	      (args, cs) <- checkArguments_ ExpandLast (getRange e)+			      (map (Arg NotHidden . unnamed) es) tel+	      blockTerm t (Con (killRange r) args) $ return cs+            MetaV _ _ -> do+              reportSDoc "tc.term.expr.rec" 10 $ sep+                [ text "Postponing type checking of"+                , nest 2 $ prettyA e <+> text ":" <+> prettyTCM t+                ]+              postponeTypeCheckingProblem_ e t+	    _         -> typeError $ ShouldBeRecordType t++	A.Var _    -> __IMPOSSIBLE__+	A.Def _    -> __IMPOSSIBLE__+	A.Con _    -> __IMPOSSIBLE__++	A.ScopedExpr scope e -> setScope scope >> checkExpr e t++-- | Infer the type of a head thing (variable, function symbol, or constructor)+inferHead :: Head -> TCM (Args -> Term, Type)+inferHead (HeadVar x) = do -- traceCall (InferVar x) $ do+  (u, a) <- getVarInfo x+  return (apply u, a)+inferHead (HeadDef x) = do+  (u, a) <- inferDef Def x+  return (apply u, a)+inferHead (HeadCon [c]) = do++  -- Constructors are polymorphic internally so when building the constructor+  -- term we should throw away arguments corresponding to parameters.++  -- First, inferDef will try to apply the constructor to the free parameters+  -- of the current context. We ignore that.+  (u, a) <- inferDef (\c _ -> Con c []) c++  -- Next get the number of parameters in the current context.+  Constructor{conPars = n} <- theDef <$> (instantiateDef =<< getConstInfo c)++  verboseS "tc.term.con" 7 $ do+    liftIO $ UTF8.putStrLn $ unwords [show c, "has", show n, "parameters."]++  -- So when applying the constructor throw away the parameters.+  return (apply u . genericDrop n, a)+inferHead (HeadCon _) = __IMPOSSIBLE__  -- inferHead will only be called on unambiguous constructors++inferDef :: (QName -> Args -> Term) -> QName -> TCM (Term, Type)+inferDef mkTerm x =+    traceCall (InferDef (getRange x) x) $ do+    d  <- instantiateDef =<< getConstInfo x+    vs <- freeVarsToApply x+    verboseS "tc.term.def" 10 $ do+      ds <- mapM prettyTCM vs+      dx <- prettyTCM x+      dt <- prettyTCM $ defType d+      liftIO $ UTF8.putStrLn $ "inferred def " ++ unwords (show dx : map show ds) ++ " : " ++ show dt+    return (mkTerm x vs, defType d)++-- | @checkHeadApplication e t hd args@ checks that @e@ has type @t@,+-- assuming that @e@ has the form @hd args@. The corresponding+-- type-checked term is returned.+--+-- If the head term @hd@ is a coinductive constructor, then a+-- top-level definition @fresh tel = hd args@ (where the clause is+-- delayed) is added, where @tel@ corresponds to the current+-- telescope. The returned term is @fresh tel@.+--+-- Precondition: The head @hd@ has to be unambiguous, and there should+-- not be any need to insert hidden lambdas.+checkHeadApplication :: A.Expr -> Type -> A.Head -> [NamedArg A.Expr] -> TCM Term+checkHeadApplication e t hd args = do+  replacing <- envReplace <$> ask+  if not replacing+   then local (\e -> e { envReplace = True }) defaultResult+   else case hd of+    HeadCon [c] -> do+      info <- getConstInfo c+      case conInd $ theDef info of+        Inductive   -> defaultResult+        CoInductive -> do+          -- TODO: Handle coinductive constructors under lets.+          lets <- envLetBindings <$> ask+          unless (Map.null lets) $+            typeError $ NotImplemented+              "coinductive constructor in the scope of a let-bound variable"++          -- The name of the fresh function.+          i <- fresh :: TCM Integer+          let name = filter (/= '_') (show $ A.qnameName c) ++ "-" ++ show i+          c' <- liftM2 qualify currentModule (freshName_ name)++          -- The application of the fresh function to the relevant+          -- arguments.+          e' <- Def c' <$> getContextArgs++          -- Add the type signature of the fresh function to the+          -- signature.+          i   <- currentMutualBlock+          tel <- getContextTelescope+          addConstant c' (Defn c' t (defaultDisplayForm c') i $ Axiom Nothing)++          -- Define and type check the fresh function.+          ctx <- getContext+          let info   = A.mkDefInfo (A.nameConcrete $ A.qnameName c') defaultFixity+                                   PublicAccess ConcreteDef noRange+              pats   = map (fmap $ \(n, _) -> Named Nothing (A.VarP n)) $+                           reverse ctx+              clause = A.Clause (A.LHS (A.LHSRange noRange) c' pats [])+                                (A.RHS $ unAppView (A.Application hd args))+                                []++          reportSDoc "tc.term.expr.coind" 15 $ vcat $+              [ text "The coinductive constructor application"+              , nest 2 $ prettyTCM e+              , text "was translated into the application"+              , nest 2 $ prettyTCM e'+              , text "and the function"+              , nest 2 $ prettyTCM c' <+> text ":"+              , nest 4 $ prettyTCM (telePi tel t)+              , nest 2 $ prettyA clause <> text "."+              ]++          local (\e -> e { envReplace = False }) $+            escapeContext (size ctx) $ checkFunDef Delayed info c' [clause]++          reportSDoc "tc.term.expr.coind" 15 $ do+            def <- theDef <$> getConstInfo c'+            text "The definition is" <+> text (show $ funDelayed def) <>+              text "."++          return e'+    HeadCon _  -> __IMPOSSIBLE__+    HeadVar {} -> defaultResult+    HeadDef {} -> defaultResult+  where+  defaultResult = do+    (f, t0) <- inferHead hd+    checkArguments' ExpandLast (getRange hd) args t0 t e $ \vs t1 cs ->+      blockTerm t (f vs) $ (cs ++) <$> leqType t1 t++data ExpandHidden = ExpandLast | DontExpandLast++instance Error Type where+  strMsg _ = __IMPOSSIBLE__+  noMsg = __IMPOSSIBLE__++traceCallE :: Error e => (Maybe r -> Call) -> ErrorT e TCM r -> ErrorT e TCM r+traceCallE call m = do+  z <- lift $ traceCall call' $ runErrorT m+  case z of+    Right e  -> return e+    Left err -> throwError err+  where+    call' Nothing          = call Nothing+    call' (Just (Left _))  = call Nothing+    call' (Just (Right x)) = call (Just x)++-- | Check a list of arguments: @checkArgs args t0 t1@ checks that+--   @t0 = Delta -> t0'@ and @args : Delta@. Inserts hidden arguments to+--   make this happen. Returns @t0'@ and any constraints that have to be+--   solve for everything to be well-formed.+--   TODO: doesn't do proper blocking of terms+checkArguments :: ExpandHidden -> Range -> [NamedArg A.Expr] -> Type -> Type -> ErrorT Type TCM (Args, Type, Constraints)+checkArguments DontExpandLast _ [] t0 t1 = return ([], t0, [])+checkArguments exh r [] t0 t1 =+    traceCallE (CheckArguments r [] t0 t1) $ do+	t0' <- lift $ reduce t0+	t1' <- lift $ reduce t1+	case funView $ unEl t0' of -- TODO: clean+	    FunV (Arg Hidden a) _ | notHPi $ unEl t1'  -> do+		v  <- lift $ newValueMeta a+		let arg = Arg Hidden v+		(vs, t0'',cs) <- checkArguments exh r [] (piApply t0' [arg]) t1'+		return (arg : vs, t0'',cs)+	    _ -> return ([], t0', [])+    where+	notHPi (Pi  (Arg Hidden _) _) = False+	notHPi (Fun (Arg Hidden _) _) = False+	notHPi _		      = True++checkArguments exh r args0@(Arg h e : args) t0 t1 =+    traceCallE (CheckArguments r args0 t0 t1) $ do+      t0b <- lift $ reduceB t0+      case t0b of+        Blocked{}                 -> throwError $ ignoreBlocking t0b+        NotBlocked (El _ MetaV{}) -> throwError $ ignoreBlocking t0b+        NotBlocked t0' -> do+          -- (t0', cs) <- forcePi h (name e) t0+          e' <- return $ namedThing e+          case (h, funView $ unEl t0') of+              (NotHidden, FunV (Arg Hidden a) _) -> insertUnderscore+              (Hidden, FunV (Arg Hidden a) _)+                  | not $ sameName (nameOf e) (nameInPi $ unEl t0') -> insertUnderscore+              (_, FunV (Arg h' a) _) | h == h' -> do+                  u  <- lift $ checkExpr e' a+                  let arg = Arg h u+                  (us, t0'', cs') <- checkArguments exh (fuseRange r e) args (piApply t0' [arg]) t1+                  return (arg : us, t0'', cs')+              (Hidden, FunV (Arg NotHidden _) _) ->+                  lift $ typeError $ WrongHidingInApplication t0'+              _ -> lift $ typeError $ ShouldBePi t0'+    where+	insertUnderscore = do+	  scope <- lift $ getScope+	  let m = A.Underscore $ A.MetaInfo+		  { A.metaRange  = r+		  , A.metaScope  = scope+		  , A.metaNumber = Nothing+		  }+	  checkArguments exh r (Arg Hidden (unnamed m) : args0) t0 t1++	name (Named _ (A.Var x)) = show x+	name (Named (Just x) _)    = x+	name _			   = "x"++	sameName Nothing _  = True+	sameName n1	 n2 = n1 == n2++	nameInPi (Pi _ b)  = Just $ absName b+	nameInPi (Fun _ _) = Nothing+	nameInPi _	   = __IMPOSSIBLE__+++-- | Check that a list of arguments fits a telescope.+checkArguments_ :: ExpandHidden -> Range -> [NamedArg A.Expr] -> Telescope -> TCM (Args, Constraints)+checkArguments_ exh r args tel = do+    z <- runErrorT $ checkArguments exh r args (telePi tel $ sort Prop) (sort Prop)+    case z of+      Right (args, _, cs) -> return (args, cs)+      Left _              -> __IMPOSSIBLE__+++-- | Infer the type of an expression. Implemented by checking agains a meta+--   variable.+inferExpr :: A.Expr -> TCM (Term, Type)+inferExpr e = do+    t <- newTypeMeta_+    v <- checkExpr e t+    return (v,t)++---------------------------------------------------------------------------+-- * Let bindings+---------------------------------------------------------------------------++checkLetBindings :: [A.LetBinding] -> TCM a -> TCM a+checkLetBindings = foldr (.) id . map checkLetBinding++checkLetBinding :: A.LetBinding -> TCM a -> TCM a+checkLetBinding b@(A.LetBind i x t e) ret =+  traceCallCPS_ (CheckLetBinding b) ret $ \ret -> do+    t <- isType_ t+    v <- checkExpr e t+    addLetBinding x v t ret+checkLetBinding (A.LetApply i x tel m args rd rm) ret = do+  -- Any variables in the context that doesn't belong to the current+  -- module should go with the new module.+  fv   <- getDefFreeVars =<< (qnameFromList . mnameToList) <$> currentModule+  n    <- size <$> getContext+  let new = n - fv+  reportSLn "tc.term.let.apply" 10 $ "Applying " ++ show m ++ " with " ++ show new ++ " free variables"+  checkSectionApplication i x tel m args rd rm+  withAnonymousModule x new ret+

+ src/full/Agda/TypeChecking/Rules/Term.hs-boot view

@@ -0,0 +1,9 @@++module Agda.TypeChecking.Rules.Term where++import qualified Agda.Syntax.Abstract as A+import Agda.Syntax.Internal+import Agda.TypeChecking.Monad.Base++checkExpr :: A.Expr -> Type -> TCM Term+

+ src/full/Agda/TypeChecking/Serialise.hs view

@@ -0,0 +1,693 @@+{-# LANGUAGE OverlappingInstances,+             TypeSynonymInstances,+             ExistentialQuantification,+             ScopedTypeVariables,+             CPP+             #-}+{-# OPTIONS_GHC -O2 #-}++-- | Structure-sharing serialisation of Agda interface files.++-- -!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-+-- NOTE: Every time the interface format is changed the interface+-- version number should be bumped _in the same patch_.+-- -!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-++-- TODO: It should be easy to produce a decent QuickCheck test suite+-- for this file.++module Agda.TypeChecking.Serialise+  ( encode+  , encodeFile+  , decode+  , decodeFile+  )+  where++import Control.Monad+import Control.Monad.State.Strict+import Control.Monad.Reader+import Data.Array.IArray+import Data.Bits (shiftR)+import Data.ByteString.Lazy as L+import Data.Char (ord, chr)+import Data.HashTable (HashTable)+import qualified Data.HashTable as H+import Data.Int (Int32, Int64)+import Data.IORef+import Data.Map (Map)+import qualified Data.Map as M+import qualified Data.Binary as B+import qualified Data.Binary.Get as B+import qualified Data.List as List+import Data.Function+import Data.Generics+import Data.Typeable+import qualified Codec.Compression.GZip as G++import Agda.Syntax.Common+import Agda.Syntax.Concrete.Name as C+import Agda.Syntax.Abstract.Name as A+import Agda.Syntax.Internal as I+import Agda.Syntax.Scope.Base+import Agda.Syntax.Position (Position(..), Range)+import qualified Agda.Syntax.Position as P+import Agda.Syntax.Common+import Agda.Syntax.Fixity+import Agda.Syntax.Literal+import qualified Agda.Interaction.Highlighting.Range   as HR+import qualified Agda.Interaction.Highlighting.Precise as HP++import Agda.TypeChecking.Monad+import Agda.Utils.Tuple+import Agda.Utils.Permutation++#include "../undefined.h"+import Agda.Utils.Impossible++currentInterfaceVersion :: Int+currentInterfaceVersion = 20090312++type Node = [Int] -- constructor tag (maybe omitted) and arg indices++data Dict = Dict{ nodeD     :: !(HashTable Node    Int)+                , stringD   :: !(HashTable String  Int)+                , integerD  :: !(HashTable Integer Int)+                , doubleD   :: !(HashTable Double  Int)+                , nodeC     :: !(IORef Int)  -- counters for fresh indexes+                , stringC   :: !(IORef Int)+                , integerC  :: !(IORef Int)+                , doubleC   :: !(IORef Int)+                }++data U    = forall a . Data a => U !a+type Memo = HashTable (Int, Int) U    -- (node index, type rep key)++data Env  = Env { nodeE     :: !(Array Int Node)+                , stringE   :: !(Array Int String)+                , integerE  :: !(Array Int Integer)+                , doubleE   :: !(Array Int Double)+                , nodeMemo  :: !Memo+                }++type S a = ReaderT Dict IO a+type R a = ReaderT Env  IO a++class Data a => EmbPrj a where+  icode :: a -> S Int+  value :: Int -> R a+++encode :: EmbPrj a => a -> IO ByteString+encode a = do+    newD@(Dict nD sD iD dD _ _ _ _) <- emptyDict+    root <- runReaderT (icode a) newD+    nL <- l nD; sL <- l sD; iL <- l iD; dL <- l dD+    return $ B.encode currentInterfaceVersion `L.append`+             G.compress (B.encode (root, nL, sL, iL, dL))+  where l = fmap (List.map fst . List.sortBy (compare `on` snd)) . H.toList++decode :: EmbPrj a => ByteString -> IO a+decode s | ver /= currentInterfaceVersion = error "Wrong interface version"+         | otherwise = runReaderT (value r) . env =<< H.new (==) hashInt2+  where (ver                , s1, _) = B.runGetState B.get s                 0+        ((r, nL, sL, iL, dL), s2, _) = B.runGetState B.get (G.decompress s1) 0+        ar l = listArray (0, List.length l - 1) l+        env  = Env (ar nL) (ar sL) (ar iL) (ar dL)++encodeFile :: EmbPrj a => FilePath -> a -> IO ()+encodeFile f x = L.writeFile f =<< encode x++decodeFile :: EmbPrj a => FilePath -> IO a+decodeFile f = decode =<< L.readFile f+++instance EmbPrj String where+  icode   = icodeX stringD stringC+  value i = (! i) `fmap` asks stringE++instance EmbPrj Integer where+  icode   = icodeX integerD integerC+  value i = (! i) `fmap` asks integerE++instance EmbPrj Int where+  icode i = return i+  value i = return i++instance EmbPrj Char where+  icode c = return (ord c)+  value i = return (chr i)++instance EmbPrj Double where+  icode   = icodeX doubleD doubleC+  value i = (! i) `fmap` asks doubleE++instance (EmbPrj a, EmbPrj b) => EmbPrj (a, b) where+  icode (a, b) = icode2' a b+  value = vcase valu where valu [a, b] = valu2 (,) a b+                           valu _      = __IMPOSSIBLE__++instance (EmbPrj a, EmbPrj b, EmbPrj c) => EmbPrj (a, b, c) where+  icode (a, b, c) = icode3' a b c+  value = vcase valu where valu [a, b, c] = valu3 (,,) a b c+                           valu _         = __IMPOSSIBLE__++instance EmbPrj a => EmbPrj (Maybe a) where+  icode Nothing  = icode0'+  icode (Just x) = icode1' x+  value = vcase valu where valu []  = valu0 Nothing+                           valu [x] = valu1 Just x+                           valu _   = __IMPOSSIBLE__++instance EmbPrj Bool where+  icode True  = icode0 0+  icode False = icode0 1+  value = vcase valu where valu [0] = valu0 True+                           valu [1] = valu0 False+                           valu _   = __IMPOSSIBLE__++instance EmbPrj Position where+  icode (P.Pn file pos line col) = icode4' file pos line col+  value = vcase valu where valu [f, p, l, c] = valu4 P.Pn f p l c+                           valu _            = __IMPOSSIBLE__++instance EmbPrj a => EmbPrj [a] where+  icode xs = icodeN =<< mapM icode xs+  value = vcase $ mapM value+--   icode []       = icode0'+--   icode (x : xs) = icode2' x xs+--   value = vcase valu where valu []      = valu0 []+--                            valu [x, xs] = valu2 (:) x xs+--                            valu _       = __IMPOSSIBLE__++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++instance EmbPrj P.Interval where+  icode (P.Interval p q) = icode2' p q+  value = vcase valu where valu [p, q] = valu2 P.Interval p q+                           valu _      = __IMPOSSIBLE__++instance EmbPrj Range where+  icode (P.Range is) = icode1' is+  value = vcase valu where valu [is] = valu1 P.Range is+                           valu _    = __IMPOSSIBLE__++instance EmbPrj HR.Range where+  icode (HR.Range a b) = icode2' a b+  value = vcase valu where valu [a, b] = valu2 HR.Range a b+                           valu _      = __IMPOSSIBLE__++instance EmbPrj C.Name where+  icode (C.NoName a b) = icode2 0 a b+  icode (C.Name r xs)  = icode2 1 r xs+  value = vcase valu where valu [0, a, b]  = valu2 C.NoName a b+                           valu [1, r, xs] = valu2 C.Name   r xs+                           valu _          = __IMPOSSIBLE__++instance EmbPrj NamePart where+  icode Hole   = icode0'+  icode (Id a) = icode1' a+  value = vcase valu where valu []  = valu0 Hole+                           valu [a] = valu1 Id a+                           valu _   = __IMPOSSIBLE__++instance EmbPrj C.QName where+  icode (Qual    a b) = icode2' a b+  icode (C.QName a  ) = icode1' a+  value = vcase valu where valu [a, b] = valu2 Qual    a b+                           valu [a]    = valu1 C.QName a+                           valu _      = __IMPOSSIBLE__++instance EmbPrj Scope where+  icode (Scope a b c) = icode3' a b c+  value = vcase valu where valu [a, b, c] = valu3 Scope a b c+                           valu _         = __IMPOSSIBLE__++instance EmbPrj Access where+  icode PrivateAccess = icode0 0+  icode PublicAccess  = icode0 1+  value = vcase valu where valu [0] = valu0 PrivateAccess+                           valu [1] = valu0 PublicAccess+                           valu _   = __IMPOSSIBLE__++instance EmbPrj NameSpace where+  icode (NameSpace a b) = icode2' a b+  value = vcase valu where valu [a, b] = valu2 NameSpace a b+                           valu _      = __IMPOSSIBLE__++instance EmbPrj AbstractName where+  icode (AbsName a b) = icode2' a b+  value = vcase valu where valu [a, b] = valu2 AbsName a b+                           valu _      = __IMPOSSIBLE__++instance EmbPrj AbstractModule where+  icode (AbsModule a) = icode a+  value n = AbsModule `fmap` value n++instance EmbPrj KindOfName where+  icode DefName = icode0 0+  icode ConName = icode0 1+  value = vcase valu where valu [0] = valu0 DefName+                           valu [1] = valu0 ConName+                           valu _   = __IMPOSSIBLE__++instance EmbPrj Agda.Syntax.Fixity.Fixity where+  icode (LeftAssoc  a b) = icode2 0 a b+  icode (RightAssoc a b) = icode2 1 a b+  icode (NonAssoc   a b) = icode2 2 a b+  value = vcase valu where valu [0, a, b] = valu2 LeftAssoc  a b+                           valu [1, a, b] = valu2 RightAssoc a b+                           valu [2, a, b] = valu2 NonAssoc   a b+                           valu _         = __IMPOSSIBLE__++instance EmbPrj A.QName where+  icode (A.QName a b) = icode2' a b+  value = vcase valu where valu [a, b] = valu2 A.QName a b+                           valu _      = __IMPOSSIBLE__++instance EmbPrj A.ModuleName where+  icode (A.MName a) = icode a+  value n = A.MName `fmap` value n++instance EmbPrj A.Name where+  icode (A.Name a b c d) = icode4' a b c d +  value = vcase valu where valu [a, b, c, d] = valu4 A.Name a b c d+                           valu _            = __IMPOSSIBLE__++instance EmbPrj NameId where+  icode (NameId a b) = icode2' a b+  value = vcase valu where valu [a, b] = valu2 NameId a b+                           valu _      = __IMPOSSIBLE__++instance EmbPrj Signature where+  icode (Sig a b) = icode2' a b+  value = vcase valu where valu [a, b] = valu2 Sig a b+                           valu _      = __IMPOSSIBLE__++instance EmbPrj Section where+  icode (Section a b) = icode2' a b+  value = vcase valu where valu [a, b] = valu2 Section a b+                           valu _      = __IMPOSSIBLE__++instance EmbPrj Telescope where+  icode EmptyTel        = icode0'+  icode (ExtendTel a b) = icode2' a b+  value = vcase valu where valu []     = valu0 EmptyTel+                           valu [a, b] = valu2 ExtendTel a b+                           valu _      = __IMPOSSIBLE__++instance EmbPrj Permutation where+  icode (Perm a b) = icode2' a b+  value = vcase valu where valu [a, b] = valu2 Perm a b+                           valu _      = __IMPOSSIBLE__++instance (EmbPrj a) => EmbPrj (Agda.Syntax.Common.Arg a) where+  icode (Arg a b) = icode2' a b+  value = vcase valu where valu [a, b] = valu2 Arg a b+                           valu _      = __IMPOSSIBLE__++instance EmbPrj Agda.Syntax.Common.Induction where+  icode Inductive   = icode0 0+  icode CoInductive = icode0 1+  value = vcase valu where valu [0] = valu0 Inductive+                           valu [1] = valu0 CoInductive+                           valu _   = __IMPOSSIBLE__++instance EmbPrj Agda.Syntax.Common.Hiding where+  icode Hidden    = icode0 0+  icode NotHidden = icode0 1+  value = vcase valu where valu [0] = valu0 Hidden+                           valu [1] = valu0 NotHidden+                           valu _   = __IMPOSSIBLE__++instance EmbPrj I.Type where+  icode (El a b) = icode2' a b+  value = vcase valu where valu [a, b] = valu2 El a b+                           valu _      = __IMPOSSIBLE__++instance EmbPrj I.MetaId where+  icode (MetaId a) = icode a+  value n = MetaId `fmap` value n++instance (EmbPrj a) => EmbPrj (I.Abs a) where+  icode (Abs a b) = icode2' a b+  value = vcase valu where valu [a, b] = valu2 Abs a b+                           valu _      = __IMPOSSIBLE__++instance EmbPrj I.Term where+  icode (Var      a b) = icode2 0 a b+  icode (Lam      a b) = icode2 1 a b+  icode (Lit      a  ) = icode1 2 a+  icode (Def      a b) = icode2 3 a b+  icode (Con      a b) = icode2 4 a b+  icode (Pi       a b) = icode2 5 a b+  icode (Fun      a b) = icode2 6 a b+  icode (Sort     a  ) = icode1 7 a+  icode (MetaV    a b) = icode2 8 a b+  value = vcase valu where valu [0, a, b] = valu2 Var   a b +                           valu [1, a, b] = valu2 Lam   a b +                           valu [2, a]    = valu1 Lit   a+                           valu [3, a, b] = valu2 Def   a b+                           valu [4, a, b] = valu2 Con   a b+                           valu [5, a, b] = valu2 Pi    a b+                           valu [6, a, b] = valu2 Fun   a b+                           valu [7, a]    = valu1 Sort  a+                           valu [8, a, b] = valu2 MetaV a b+                           valu _         = __IMPOSSIBLE__++instance EmbPrj I.Sort where+  icode (Type  a  ) = icode1 0 a+  icode Prop        = icode0 1+  icode (Lub   a b) = icode2 2 a b+  icode (Suc   a  ) = icode1 3 a+  icode (MetaS a )  = icode1 4 a+  value = vcase valu where valu [0, a]    = valu1 Type  a+                           valu [1]       = valu0 Prop+                           valu [2, a, b] = valu2 Lub   a b+                           valu [3, a]    = valu1 Suc   a+                           valu [4, a]    = valu1 MetaS a+                           valu _         = __IMPOSSIBLE__++instance EmbPrj Agda.Syntax.Literal.Literal where+  icode (LitInt    a b) = icode2 0 a b+  icode (LitFloat  a b) = icode2 1 a b+  icode (LitString a b) = icode2 2 a b+  icode (LitChar   a b) = icode2 3 a b+  value = vcase valu where valu [0, a, b] = valu2 LitInt    a b+                           valu [1, a, b] = valu2 LitFloat  a b+                           valu [2, a, b] = valu2 LitString a b+                           valu [3, a, b] = valu2 LitChar   a b+                           valu _         = __IMPOSSIBLE__++instance EmbPrj DisplayForm where+  icode (Display a b c) = icode3' a b c+  value = vcase valu where valu [a, b, c] = valu3 Display a b c+                           valu _         = __IMPOSSIBLE__++instance EmbPrj a => EmbPrj (Open a) where+  icode (OpenThing a b) = icode2' a b+  value = vcase valu where valu [a, b] = valu2 OpenThing a b+                           valu _      = __IMPOSSIBLE__++instance EmbPrj CtxId where+  icode (CtxId a) = icode a+  value n = CtxId `fmap` value n++instance EmbPrj DisplayTerm where+  icode (DTerm    a  ) = icode1' a+  icode (DWithApp a b) = icode2' a b+  value = vcase valu where valu [a]    = valu1 DTerm a+                           valu [a, b] = valu2 DWithApp a b+                           valu _      = __IMPOSSIBLE__++instance EmbPrj MutualId where+  icode (MutId a) = icode a+  value n = MutId `fmap` value n++instance EmbPrj Definition where+  icode (Defn a b c d e) = icode5' a b c d e+  value = vcase valu where valu [a, b, c, d, e] = valu5 Defn a b c d e+                           valu _               = __IMPOSSIBLE__++instance EmbPrj HaskellRepresentation where+  icode (HsType a)   = icode1 0 a+  icode (HsDefn a b) = icode2 1 a b++  value = vcase valu where+    valu [0, a]    = valu1 HsType a+    valu [1, a, b] = valu2 HsDefn a b+    valu _         = __IMPOSSIBLE__++instance EmbPrj Polarity where+  icode Covariant     = icode0 0+  icode Contravariant = icode0 1+  icode Invariant     = icode0 2++  value = vcase valu where+    valu [0] = valu0 Covariant+    valu [1] = valu0 Contravariant+    valu [2] = valu0 Invariant+    valu _   = __IMPOSSIBLE__++instance EmbPrj Occurrence where+  icode Positive = icode0 0+  icode Negative = icode0 1+  icode Unused   = icode0 2++  value = vcase valu where+    valu [0] = valu0 Positive+    valu [1] = valu0 Negative+    valu [2] = valu0 Unused+    valu _   = __IMPOSSIBLE__++instance EmbPrj Defn where+  icode (Axiom       a)                   = icode1 0 a+  icode (Function    a b c d e f)         = icode6 1 a b c d e f+  icode (Datatype    a b c d e f g h i j) = icode10 2 a b c d e f g h i j+  icode (Record      a b c d e f g h)     = icode8 3 a b c d e f g h+  icode (Constructor a b c d e f)         = icode6 4 a b c d e f+  icode (Primitive   a b c)               = icode3 5 a b c+  value = vcase valu where+    valu [0, a]                            = valu1 Axiom       a+    valu [1, a, b, c, d, e, f]             = valu6 Function    a b c d e f+    valu [2, a, b, c, d, e, f, g, h, i, j] = valu10 Datatype    a b c d e f g h i j+    valu [3, a, b, c, d, e, f, g, h]       = valu8 Record      a b c d e f g h+    valu [4, a, b, c, d, e, f]             = valu6 Constructor a b c d e f+    valu [5, a, b, c]                      = valu3 Primitive   a b c+    valu _                                 = __IMPOSSIBLE__++instance EmbPrj FunctionInverse where+  icode NotInjective = icode0'+  icode (Inverse a)  = icode1' a+  value = vcase valu where valu []  = valu0 NotInjective+                           valu [a] = valu1 Inverse a+                           valu _   = __IMPOSSIBLE__++instance EmbPrj TermHead where+  icode SortHead    = icode0 0+  icode PiHead      = icode0 1+  icode (ConHead a) = icode1 2 a+  value = vcase valu where valu [0]    = return SortHead+                           valu [1]    = return PiHead+                           valu [2, a] = valu1 ConHead a+                           valu _      = __IMPOSSIBLE__++instance EmbPrj Agda.Syntax.Common.IsAbstract where+  icode AbstractDef = icode0 0+  icode ConcreteDef = icode0 1+  value = vcase valu where valu [0] = valu0 AbstractDef+                           valu [1] = valu0 ConcreteDef+                           valu _   = __IMPOSSIBLE__++instance EmbPrj I.Clause where+  icode (Clause a b c d e) = icode5' a b c d e+  value = vcase valu where valu [a, b, c, d, e] = valu5 Clause a b c d e+                           valu _               = __IMPOSSIBLE__++instance EmbPrj I.ClauseBody where+  icode (Body   a) = icode1 0 a+  icode (Bind   a) = icode1 1 a+  icode (NoBind a) = icode1 2 a+  icode NoBody     = icode0'+  value = vcase valu where valu [0, a] = valu1 Body   a+                           valu [1, a] = valu1 Bind   a+                           valu [2, a] = valu1 NoBind a+                           valu []     = valu0 NoBody+                           valu _      = __IMPOSSIBLE__++instance EmbPrj Delayed where+  icode Delayed    = icode0 0+  icode NotDelayed = icode0 1+  value = vcase valu where valu [0] = valu0 Delayed+                           valu [1] = valu0 NotDelayed+                           valu _   = __IMPOSSIBLE__++instance EmbPrj I.Pattern where+  icode (VarP a  ) = icode1 0 a+  icode (ConP a b) = icode2 1 a b+  icode (LitP a  ) = icode1 2 a+  icode (DotP a  ) = icode1 3 a+  value = vcase valu where valu [0, a]    = valu1 VarP a+                           valu [1, a, b] = valu2 ConP a b+                           valu [2, a]    = valu1 LitP a+                           valu [3, a]    = valu1 DotP a+                           valu _         = __IMPOSSIBLE__++instance EmbPrj a => EmbPrj (Builtin a) where+  icode (Prim    a) = icode1 0 a+  icode (Builtin a) = icode1 1 a+  value = vcase valu where valu [0, a] = valu1 Prim    a+                           valu [1, a] = valu1 Builtin a+                           valu _      = __IMPOSSIBLE__++instance EmbPrj HP.NameKind where+  icode HP.Bound           = icode0 0+  icode (HP.Constructor a) = icode1 1 a+  icode HP.Datatype        = icode0 2+  icode HP.Field           = icode0 3+  icode HP.Function        = icode0 4+  icode HP.Module          = icode0 5+  icode HP.Postulate       = icode0 6+  icode HP.Primitive       = icode0 7+  icode HP.Record          = icode0 8++  value = vcase valu where+    valu [0]     = valu0 HP.Bound+    valu [1 , a] = valu1 HP.Constructor a+    valu [2]     = valu0 HP.Datatype+    valu [3]     = valu0 HP.Field+    valu [4]     = valu0 HP.Function+    valu [5]     = valu0 HP.Module+    valu [6]     = valu0 HP.Postulate+    valu [7]     = valu0 HP.Primitive+    valu [8]     = valu0 HP.Record+    valu _       = __IMPOSSIBLE__++instance EmbPrj HP.Aspect where+  icode HP.Comment       = icode0 0+  icode HP.Keyword       = icode0 1+  icode HP.String        = icode0 2+  icode HP.Number        = icode0 3+  icode HP.Symbol        = icode0 4+  icode HP.PrimitiveType = icode0 5+  icode (HP.Name mk b)   = icode2 6 mk b++  value = vcase valu where+    valu [0]        = valu0 HP.Comment+    valu [1]        = valu0 HP.Keyword+    valu [2]        = valu0 HP.String+    valu [3]        = valu0 HP.Number+    valu [4]        = valu0 HP.Symbol+    valu [5]        = valu0 HP.PrimitiveType+    valu [6, mk, b] = valu2 HP.Name mk b+    valu _          = __IMPOSSIBLE__++instance EmbPrj HP.OtherAspect where+  icode HP.Error              = icode0 0+  icode HP.DottedPattern      = icode0 1+  icode HP.UnsolvedMeta       = icode0 2+  icode HP.TerminationProblem = icode0 3+  icode HP.IncompletePattern  = icode0 4++  value = vcase valu where+    valu [0] = valu0 HP.Error+    valu [1] = valu0 HP.DottedPattern+    valu [2] = valu0 HP.UnsolvedMeta+    valu [3] = valu0 HP.TerminationProblem+    valu [4] = valu0 HP.IncompletePattern+    valu _   = __IMPOSSIBLE__++instance EmbPrj HP.MetaInfo where+  icode (HP.MetaInfo a b c d) = icode4' a b c d++  value = vcase valu where+    valu [a, b, c, d] = valu4 HP.MetaInfo a b c d+    valu _            = __IMPOSSIBLE__++instance EmbPrj HP.HighlightingInfo where+  icode (HP.HighlightingInfo a b) = icode2' a b++  value = vcase valu where+    valu [a, b] = valu2 HP.HighlightingInfo a b+    valu _      = __IMPOSSIBLE__++instance EmbPrj Interface where+  icode (Interface a b c d e f g) = icode7' a b c d e f g+  value = vcase valu where valu [a, b, c, d, e, f, g] = valu7 Interface a b c d e f g+                           valu _                     = __IMPOSSIBLE__++++icodeX :: (Dict -> HashTable k Int) -> (Dict -> IORef Int) ->+          k -> S Int+icodeX dict counter key = do+  d     <- asks dict+  c     <- asks counter+  fresh <- lift $ readIORef c+  mi    <- lift $ H.lookup d key+  case mi of+    Just i  -> return i+    Nothing -> do lift $ H.insert d key fresh+                  lift $ writeIORef c (fresh + 1)+                  return fresh++icodeN = icodeX nodeD nodeC++vcase :: forall a . EmbPrj a => ([Int] -> R a) -> Int -> R a+vcase valu ix = do+    aTyp <- lift $ typeRepKey $ typeOf (undefined :: a)+    memo <- asks nodeMemo+    maybeU <- lift $ H.lookup memo (ix, aTyp)+    case maybeU of+      Just (U u) -> maybe (__IMPOSSIBLE__) return (cast u)+      Nothing    -> do+          v <- valu . (! ix) =<< asks nodeE +          lift $ H.insert memo (ix, aTyp) (U v)+          return v++icode0  tag                     = icodeN [tag]+icode1  tag a                   = icodeN . (tag :) =<< sequence [icode a]+icode2  tag a b                 = icodeN . (tag :) =<< sequence [icode a, icode b]+icode3  tag a b c               = icodeN . (tag :) =<< sequence [icode a, icode b, icode c]+icode4  tag a b c d             = icodeN . (tag :) =<< sequence [icode a, icode b, icode c, icode d]+icode5  tag a b c d e           = icodeN . (tag :) =<< sequence [icode a, icode b, icode c, icode d, icode e]+icode6  tag a b c d e f         = icodeN . (tag :) =<< sequence [icode a, icode b, icode c, icode d, icode e, icode f]+icode7  tag a b c d e f g       = icodeN . (tag :) =<< sequence [icode a, icode b, icode c, icode d, icode e, icode f, icode g]+icode8  tag a b c d e f g h     = icodeN . (tag :) =<< sequence [icode a, icode b, icode c, icode d, icode e, icode f, icode g, icode h]+icode9  tag a b c d e f g h i   = icodeN . (tag :) =<< sequence [icode a, icode b, icode c, icode d, icode e, icode f, icode g, icode h, icode i]+icode10 tag a b c d e f g h i j = icodeN . (tag :) =<< sequence [icode a, icode b, icode c, icode d, icode e, icode f, icode g, icode h, icode i, icode j]++icode0'                      = icodeN []+icode1'  a                   = icodeN =<< sequence [icode a]+icode2'  a b                 = icodeN =<< sequence [icode a, icode b]+icode3'  a b c               = icodeN =<< sequence [icode a, icode b, icode c]+icode4'  a b c d             = icodeN =<< sequence [icode a, icode b, icode c, icode d]+icode5'  a b c d e           = icodeN =<< sequence [icode a, icode b, icode c, icode d, icode e]+icode6'  a b c d e f         = icodeN =<< sequence [icode a, icode b, icode c, icode d, icode e, icode f]+icode7'  a b c d e f g       = icodeN =<< sequence [icode a, icode b, icode c, icode d, icode e, icode f, icode g]+icode8'  a b c d e f g h     = icodeN =<< sequence [icode a, icode b, icode c, icode d, icode e, icode f, icode g, icode h]+icode9'  a b c d e f g h i   = icodeN =<< sequence [icode a, icode b, icode c, icode d, icode e, icode f, icode g, icode h, icode i]+icode10' a b c d e f g h i j = icodeN =<< sequence [icode a, icode b, icode c, icode d, icode e, icode f, icode g, icode h, icode i, icode j]++valu0  z                     = return z+valu1  z a                   = valu0 z                   `ap` value a+valu2  z a b                 = valu1 z a                 `ap` value b+valu3  z a b c               = valu2 z a b               `ap` value c+valu4  z a b c d             = valu3 z a b c             `ap` value d+valu5  z a b c d e           = valu4 z a b c d           `ap` value e+valu6  z a b c d e f         = valu5 z a b c d e         `ap` value f+valu7  z a b c d e f g       = valu6 z a b c d e f       `ap` value g+valu8  z a b c d e f g h     = valu7 z a b c d e f g     `ap` value h+valu9  z a b c d e f g h i   = valu8 z a b c d e f g h   `ap` value i+valu10 z a b c d e f g h i j = valu9 z a b c d e f g h i `ap` value j++test :: EmbPrj a => a -> IO a+test x = decode =<< encode x++emptyDict :: IO Dict+emptyDict = liftM5 Dict+            (H.new (==) hashNode)+            (H.new (==) H.hashString)+            (H.new (==) (H.hashInt . fromIntegral))+            (H.new (==) (H.hashInt . floor))+            (newIORef 0)+            `ap` (newIORef 0)+            `ap` (newIORef 0)+            `ap` (newIORef 0)++hashNode :: [ Int ] -> Int32+hashNode is = List.foldl' f golden is+   where f m c = fromIntegral c * magic + hashInt32 m+         magic  = 0xdeadbeef+         golden :: Int32+         golden = 1013904242 +         hashInt32 x = mulHi x golden + x+         mulHi :: Int32 -> Int32 -> Int32+         mulHi a b = fromIntegral (r `shiftR` 32)+             where r :: Int64+                   r = fromIntegral a * fromIntegral b++hashInt2 :: (Int, Int) -> Int32+hashInt2 (ix, rep) = hashNode [ix , rep]

+ src/full/Agda/TypeChecking/SizedTypes.hs view

@@ -0,0 +1,241 @@+{-# LANGUAGE CPP #-}+module Agda.TypeChecking.SizedTypes where++import Control.Monad.Error+import Control.Monad+import Data.List+import qualified Data.Map as Map++import Agda.Interaction.Options+import Agda.Syntax.Common+import Agda.Syntax.Internal+import Agda.TypeChecking.Monad+import Agda.TypeChecking.Monad.Builtin+import Agda.TypeChecking.Pretty+import Agda.TypeChecking.Reduce+import Agda.TypeChecking.MetaVars+import Agda.TypeChecking.Substitute+import {-# SOURCE #-} Agda.TypeChecking.Conversion+import qualified Agda.Utils.Warshall as W+import Agda.Utils.List+import Agda.Utils.Monad+import Agda.Utils.Impossible+import Agda.Utils.Size++#include "../undefined.h"++-- | Compare two sizes. Only with --sized-types.+compareSizes :: MonadTCM tcm => Comparison -> Term -> Term -> tcm Constraints+compareSizes cmp u v = do+  reportSDoc "tc.conv.size" 10 $ vcat+    [ text "Comparing sizes"+    , nest 2 $ sep [ prettyTCM u <+> prettyTCM cmp+                   , prettyTCM v+                   ]+    ]+  u <- reduce u+  v <- reduce v+  reportSDoc "tc.conv.size" 15 $ +      nest 2 $ sep [ text (show u) <+> prettyTCM cmp+                   , text (show v)+                   ]+  s1   <- sizeView u+  s2   <- sizeView v+  size <- sizeType+  case (cmp, s1, s2) of+    (CmpLeq, _,         SizeInf)   -> return []+    (CmpLeq, SizeInf,   _)         -> compareSizes CmpEq u v+    (CmpEq,  SizeSuc u, SizeInf)   -> compareSizes CmpEq u v+    (_,      SizeInf,   SizeSuc v) -> compareSizes CmpEq u v+    (_,      SizeSuc u, SizeSuc v) -> compareSizes cmp u v+    (CmpLeq, _,         _)         ->+      ifM (trivial u v) (return []) $+        buildConstraint $ ValueCmp CmpLeq size u v+    _                              -> compareAtom cmp size u v++trivial :: MonadTCM tcm => Term -> Term -> tcm Bool+trivial u v = liftTCM $ do+    a <- sizeExpr u+    b <- sizeExpr v+    reportSDoc "tc.conv.size" 15 $ +      nest 2 $ sep [ text (show a) <+> text "<="+                   , text (show b)+                   ]+    return $ case (a, b) of+      ((Rigid i, n), (Rigid j, m)) -> i == j && n <= m+      _ -> False+  `catchError` \_ -> return False++-- | Find the size constraints.+getSizeConstraints :: MonadTCM tcm => tcm [SizeConstraint]+getSizeConstraints = do+  cs   <- getConstraints+  size <- sizeType+  let sizeConstraints cl@(Closure{ clValue = ValueCmp CmpLeq s _ _ })+        | s == size = [cl]+      sizeConstraints cl@(Closure{ clValue = Guarded _ cs }) =+        concatMap sizeConstraints cs+      sizeConstraints _ = []+  scs <- mapM computeSizeConstraint $ concatMap sizeConstraints cs+  return [ c | Just c <- scs ]++getSizeMetas :: MonadTCM tcm => tcm [(MetaId, Int)]+getSizeMetas = do+  ms <- getOpenMetas+  sz <- sizeType+  let sizeCon m = do+        mi <- lookupMeta m+        case mvJudgement mi of+          HasType _ a -> do+            TelV tel b <- telView <$> instantiateFull a+            if b /= sz+              then return []+              else return [(m, size tel)]+          _ -> return []+  concat <$> mapM sizeCon ms++data SizeExpr = SizeMeta MetaId [CtxId]+              | Rigid CtxId++data SizeConstraint = Leq SizeExpr Int SizeExpr++instance Show SizeExpr where+  show (SizeMeta m _) = "X" ++ show (fromIntegral m :: Int)+  show (Rigid i) = "c" ++ show (fromIntegral i :: Int)++instance Show SizeConstraint where+  show (Leq a n b)+    | n == 0    = show a ++ " =< " ++ show b+    | n > 0     = show a ++ " =< " ++ show b ++ " + " ++ show n+    | otherwise = show a ++ " + " ++ show (-n) ++ " =< " ++ show b++computeSizeConstraint :: MonadTCM tcm => ConstraintClosure -> tcm (Maybe SizeConstraint)+computeSizeConstraint cl = liftTCM $+  enterClosure cl $ \(ValueCmp CmpLeq _ u v) -> do+    (a, n) <- sizeExpr u+    (b, m) <- sizeExpr v+    return $ Just $ Leq a (m - n) b+  `catchError` \err -> case err of+    PatternErr _ -> return Nothing+    _            -> throwError err++-- | Throws a 'patternViolation' if the term isn't a proper size expression.+sizeExpr :: MonadTCM tcm => Term -> tcm (SizeExpr, Int)+sizeExpr u = do+  u <- reduce u -- Andreas, 2009-02-09. +                -- This is necessary to surface the solutions of metavariables.+  s <- sizeView u+  case s of+    SizeSuc u -> do+      (e, n) <- sizeExpr u+      return (e, n + 1)+    SizeInf -> patternViolation+    OtherSize u -> case u of+      Var i []  -> do+        cxt <- getContextId+        return (Rigid (cxt !! fromIntegral i), 0)+      MetaV m args+        | all isVar args && distinct args -> do+          cxt <- getContextId+          return (SizeMeta m [ cxt !! fromIntegral i | Arg _ (Var i []) <- args ], 0)+      _ -> patternViolation+  where+    isVar (Arg _ (Var _ [])) = True+    isVar _ = False++flexibleVariables :: SizeConstraint -> [(MetaId, [CtxId])]+flexibleVariables (Leq a _ b) = flex a ++ flex b+  where+    flex (Rigid _)       = []+    flex (SizeMeta m xs) = [(m, xs)]++haveSizedTypes :: MonadTCM tcm => tcm Bool+haveSizedTypes = liftTCM $ do+    Def _ [] <- primSize+    Def _ [] <- primSizeInf+    Def _ [] <- primSizeSuc+    optSizedTypes <$> commandLineOptions+  `catchError` \_ -> return False++solveSizeConstraints :: MonadTCM tcm => tcm ()+solveSizeConstraints = whenM haveSizedTypes $ do+  cs <- getSizeConstraints+  ms <- getSizeMetas+  when (not (null cs) || not (null ms)) $ do+  reportSLn "tc.size.solve" 10 $ "Solving size constraints " ++ show cs++  let metas0 = map mkMeta $ groupOn fst $ concatMap flexibleVariables cs+      mkMeta ms@((m, xs) : _)+        | allEqual (map snd ms) = (m, xs)+        | otherwise             = error $ "Inconsistent meta: " ++ show m ++ " " ++ show (map snd ms)+      mkMeta _ = __IMPOSSIBLE__++      mkFlex (m, xs) = W.NewFlex (fromIntegral m) $ \i -> fromIntegral i `elem` xs++      mkConstr (Leq a n b)  = W.Arc (mkNode a) n (mkNode b)+      mkNode (Rigid i)      = W.Rigid $ W.RVar $ fromIntegral i+      mkNode (SizeMeta m _) = W.Flex $ fromIntegral m++      found (m, _) = elem m $ map fst metas0++  -- Compute unconstrained metas+  let metas1 = map mkMeta' $ filter (not . found) ms+      mkMeta' (m, n) = (m, [0..fromIntegral n - 1])++  let metas = metas0 ++ metas1++  reportSLn "tc.size.solve" 15 $ "Metas: " ++ show metas0 ++ ", " ++ show metas1++  verboseS "tc.size.solve" 20 $ do+    let meta (m, _) = do+          j <- mvJudgement <$> lookupMeta m+          reportSDoc "" 0 $ case j of+            HasType _ t -> text (show m) <+> text ":" <+> prettyTCM t+            IsSort _    -> text (show m) <+> text "sort"+    mapM_ meta metas++  case W.solve $ map mkFlex metas ++ map mkConstr cs of+    Nothing  -> do+      typeError $ GenericError $ "Unsolvable size constraints: " ++ show cs+    Just sol -> do+      reportSLn "tc.size.solve" 10 $ "Solved constraints: " ++ show sol+      inf <- primSizeInf+      s <- primSizeSuc+      let suc v = s `apply` [Arg NotHidden v]+          plus v 0 = v+          plus v n = suc $ plus v (n - 1)++          inst (i, e) = do+            let m = fromIntegral i+                args = case lookup m metas of+                  Just xs -> xs+                  Nothing -> __IMPOSSIBLE__++                term (W.SizeConst (W.Finite _)) = __IMPOSSIBLE__+                term (W.SizeConst W.Infinite) = primSizeInf+                term (W.SizeVar j n) = case findIndex (==fromIntegral j) $ reverse args of+                  Just x -> return $ plus (Var (fromIntegral x) []) n+                  Nothing -> __IMPOSSIBLE__++                lam _ v = Lam NotHidden $ Abs "s" v++            b <- term e+            let v = foldr lam b args -- TODO: correct hiding++            reportSDoc "tc.size.solve" 20 $ sep+              [ text (show m) <+> text ":="+              , nest 2 $ prettyTCM v+              ]++            m =: v++      mapM_ inst $ Map.toList sol++-- type Solution = Map Int SizeExpr+-- data SizeExpr = SizeVar Int Int   -- e.g. x + 5+--               | SizeConst Weight  -- a number or infinity+-- data Weight = Finite Int | Infinite +-- data Node = Rigid Rigid+--           | Flex  FlexId+-- data Rigid = RConst Weight+--            | RVar RigidId

+ src/full/Agda/TypeChecking/Substitute.hs view

@@ -0,0 +1,404 @@+{-# LANGUAGE CPP #-}+module Agda.TypeChecking.Substitute where++import Control.Monad.Identity+import Control.Monad.Reader+import Data.Generics+import Data.List hiding (sort)+import Data.Map (Map)+import qualified Data.Map as Map++import Agda.Syntax.Common+import Agda.Syntax.Internal++import Agda.TypeChecking.Monad.Base+import Agda.TypeChecking.Free++import Agda.Utils.Monad+import Agda.Utils.Size+import Agda.Utils.Permutation++#include "../undefined.h"+import Agda.Utils.Impossible++-- | Apply something to a bunch of arguments.+--   Preserves blocking tags (application can never resolve blocking).+class Apply t where+    apply :: t -> Args -> t++instance Apply Term where+    apply m [] = m+    apply m args@(Arg _ v:args0) =+	case m of+	    Var i args'   -> Var i (args' ++ args)+	    Def c args'   -> Def c (args' ++ args)+	    Con c args'   -> Con c (args' ++ args)+	    Lam _ u	  -> absApp u v `apply` args0+	    MetaV x args' -> MetaV x (args' ++ args) +	    Lit l	  -> __IMPOSSIBLE__+	    Pi _ _	  -> __IMPOSSIBLE__+	    Fun _ _	  -> __IMPOSSIBLE__+	    Sort _	  -> __IMPOSSIBLE__++instance Apply Type where+  apply = piApply++instance Apply Sort where+  apply s [] = s+  apply s _  = __IMPOSSIBLE__++instance Apply Telescope where+  apply tel		  []	   = tel+  apply EmptyTel	  _	   = __IMPOSSIBLE__+  apply (ExtendTel _ tel) (t : ts) = absApp tel (unArg t) `apply` ts++instance Apply Definition where+    apply (Defn x t df m d) args = Defn x (piApply t args) df m (apply d args)++instance Apply Defn where+  apply d args = case d of+    Axiom{} -> d+    Function{ funClauses = cs, funInv = inv } ->+      d { funClauses = apply cs args, funInv = apply inv args }+    Datatype{ dataPars = np, dataClause = cl } ->+      d { dataPars = np - size args, dataClause = apply cl args }+    Record{ recPars = np, recClause = cl, recTel = tel } ->+      d { recPars = np - size args, recClause = apply cl args, recTel = apply tel args }+    Constructor{ conPars = np } ->+      d { conPars = np - size args }+    Primitive{ primClauses = cs } ->+      d { primClauses = apply cs args }++instance Apply PrimFun where+    apply (PrimFun x ar def) args   = PrimFun x (ar - size args) $ \vs -> def (args ++ vs)++instance Apply Clause where+    apply (Clause r tel perm ps b) args =+      Clause r (apply tel args) (apply perm args)+             (drop (size args) ps) (apply b args)++instance Apply FunctionInverse where+  apply NotInjective  args = NotInjective+  apply (Inverse inv) args = Inverse $ apply inv args++instance Apply ClauseBody where+    apply  b		   []		  = b+    apply (Bind (Abs _ b)) (Arg _ v:args) = subst v b `apply` args+    apply (NoBind b)	   (_:args)	  = b `apply` args+    apply (Body _)	   (_:_)	  = __IMPOSSIBLE__+    apply  NoBody	    _		  = NoBody++instance Apply DisplayTerm where+  apply (DTerm v)	   args = DTerm $ apply v args+  apply (DWithApp v args') args = DWithApp v $ args' ++ args++instance Apply t => Apply [t] where+    apply ts args = map (`apply` args) ts++instance Apply t => Apply (Blocked t) where+    apply b args = fmap (`apply` args) b++instance Apply t => Apply (Maybe t) where+  apply x args = fmap (`apply` args) x++instance Apply v => Apply (Map k v) where+  apply x args = fmap (`apply` args) x++instance (Apply a, Apply b) => Apply (a,b) where+    apply (x,y) args = (apply x args, apply y args)++instance (Apply a, Apply b, Apply c) => Apply (a,b,c) where+    apply (x,y,z) args = (apply x args, apply y args, apply z args)++instance Apply Permutation where+  -- The permutation must start with [0..m - 1]+  apply (Perm n xs) args = Perm (n - m) $ map (flip (-) m) $ genericDrop m xs+    where+      m = size args++instance Abstract Permutation where+  abstract tel (Perm n xs) = Perm (n + m) $ [0..m - 1] ++ map (+ m) xs+    where+      m = size tel++-- | The type must contain the right number of pis without have to perform any+-- reduction.+piApply :: Type -> Args -> Type+piApply t []				= t+piApply (El _ (Pi  _ b)) (Arg _ v:args) = absApp b v `piApply` args+piApply (El _ (Fun _ b)) (_:args)	= b `piApply` args+piApply _ _				= __IMPOSSIBLE__++-- | @(abstract args v) args --> v[args]@.+class Abstract t where+    abstract :: Telescope -> t -> t++instance Abstract Term where+    abstract = teleLam++instance Abstract Type where+    abstract = telePi_++instance Abstract Sort where+    abstract EmptyTel s = s+    abstract _	      s = __IMPOSSIBLE__++instance Abstract Telescope where+  abstract  EmptyTel	        tel = tel+  abstract (ExtendTel arg tel') tel = ExtendTel arg $ fmap (`abstract` tel) tel'++instance Abstract Definition where+    abstract tel (Defn x t df m d) = Defn x (abstract tel t) df m (abstract tel d)++instance Abstract Defn where+  abstract tel d = case d of+    Axiom{} -> d+    Function{ funClauses = cs, funInv = inv } ->+      d { funClauses = abstract tel cs, funInv = abstract tel inv }+    Datatype{ dataPars = np, dataClause = cl } ->+      d { dataPars = np + size tel, dataClause = abstract tel cl }+    Record{ recPars = np, recClause = cl, recTel = tel' } ->+      d { recPars = np + size tel, recClause = abstract tel cl, recTel = abstract tel tel' }+    Constructor{ conPars = np } ->+      d { conPars = np + size tel }+    Primitive{ primClauses = cs } ->+      d { primClauses = abstract tel cs }++instance Abstract PrimFun where+    abstract tel (PrimFun x ar def) = PrimFun x (ar + n) $ \ts -> def $ genericDrop n ts+	where n = size tel++instance Abstract Clause where+  abstract tel (Clause r tel' perm ps b) =+    Clause r (abstract tel tel') (abstract tel perm)+           (telVars tel ++ ps) (abstract tel b)++telVars EmptyTel		    = []+telVars (ExtendTel arg (Abs x tel)) = fmap (const $ VarP x) arg : telVars tel++instance Abstract FunctionInverse where+  abstract tel NotInjective  = NotInjective+  abstract tel (Inverse inv) = Inverse $ abstract tel inv++instance Abstract ClauseBody where+    abstract EmptyTel		 b = b+    abstract (ExtendTel _ tel)	 b = Bind $ fmap (`abstract` b) tel++instance Abstract t => Abstract [t] where+    abstract tel = map (abstract tel)++instance Abstract t => Abstract (Maybe t) where+  abstract tel x = fmap (abstract tel) x++instance Abstract v => Abstract (Map k v) where+  abstract tel m = fmap (abstract tel) m++abstractArgs :: Abstract a => Args -> a -> a+abstractArgs args x = abstract tel x+    where+	tel   = foldr (\(Arg h x) -> ExtendTel (Arg h $ sort Prop) . Abs x) EmptyTel+	      $ zipWith (fmap . const) names args+	names = cycle $ map (:[]) ['a'..'z']++-- | Substitute a term for the nth free variable.+--+class Subst t where+    substs     :: [Term] -> t -> t+    substUnder :: Nat -> Term -> t -> t++idSub :: Telescope -> [Term]+idSub tel = [ Var i [] | i <- [0..size tel - 1] ]++subst :: Subst t => Term -> t -> t+subst u t = substUnder 0 u t++instance Subst Term where+    substs us t =+	case t of+	    Var i vs   -> (us !!! i) `apply` substs us vs+	    Lam h m    -> Lam h $ substs us m+	    Def c vs   -> Def c $ substs us vs+	    Con c vs   -> Con c $ substs us vs+	    MetaV x vs -> MetaV x $ substs us vs+	    Lit l      -> Lit l+	    Pi a b     -> uncurry Pi $ substs us (a,b)+	    Fun a b    -> uncurry Fun $ substs us (a,b)+	    Sort s     -> Sort s+        where+            []     !!! n = error "unbound variable"+            (x:xs) !!! 0 = x+            (_:xs) !!! n = xs !!! (n - 1)+    substUnder n u t =+	case t of+	    Var i vs+	      | i == n	  -> raise n u `apply` substUnder n u vs+	      | i < n	  -> Var i $ substUnder n u vs+	      | otherwise -> Var (i - 1) $ substUnder n u vs+	    Lam h m    -> Lam h $ substUnder n u m+	    Def c vs   -> Def c $ substUnder n u vs+	    Con c vs   -> Con c $ substUnder n u vs+	    MetaV x vs -> MetaV x $ substUnder n u vs+	    Lit l      -> Lit l+	    Pi a b     -> uncurry Pi $ substUnder n u (a,b)+	    Fun a b    -> uncurry Fun $ substUnder n u (a,b)+	    Sort s     -> Sort s++instance Subst Type where+    substs us (El s t) = El s $ substs us t+    substUnder n u (El s t) = El s $ substUnder n u t++instance Subst Pattern where+  substs us p = case p of+    VarP s    -> VarP s+    LitP l    -> LitP l+    ConP c ps -> ConP c $ substs us ps+    DotP t    -> DotP $ substs us t+  substUnder n u p = case p of+    VarP s    -> VarP s+    LitP l    -> LitP l+    ConP c ps -> ConP c $ substUnder n u ps+    DotP t    -> DotP $ substUnder n u t++instance Subst t => Subst (Blocked t) where+    substs us b	     = fmap (substs us) b+    substUnder n u b = fmap (substUnder n u) b++instance Subst DisplayTerm where+  substs us	 (DTerm v)	  = DTerm $ substs us v+  substs us	 (DWithApp vs ws) = uncurry DWithApp $ substs us (vs, ws)+  substUnder n u (DTerm v)	  = DTerm $ substUnder n u v+  substUnder n u (DWithApp vs ws) = uncurry DWithApp $ substUnder n u (vs, ws)++instance Subst Telescope where+  substs us  EmptyTel		   = EmptyTel+  substs us (ExtendTel t tel)	   = uncurry ExtendTel $ substs us (t, tel)+  substUnder n u  EmptyTel	   = EmptyTel+  substUnder n u (ExtendTel t tel) = uncurry ExtendTel $ substUnder n u (t, tel)++instance (Data a, Subst a) => Subst (Abs a) where+    substs us	   (Abs x t) = Abs x $ substs (Var 0 [] : raise 1 us) t+    substUnder n u (Abs x t) = Abs x $ substUnder (n + 1) u t++instance Subst a => Subst (Arg a) where+    substs us	   = fmap (substs us)+    substUnder n u = fmap (substUnder n u)++instance Subst a => Subst (Maybe a) where+  substs us	 = fmap (substs us)+  substUnder n u = fmap (substUnder n u)++instance Subst a => Subst [a] where+    substs us	   = map (substs us)+    substUnder n u = map (substUnder n u)++instance (Subst a, Subst b) => Subst (a,b) where+    substs us (x,y)	 = (substs us x, substs us y)+    substUnder n u (x,y) = (substUnder n u x, substUnder n u y)++instance Subst ClauseBody where+    substs us (Body t)	      = Body $ substs us t+    substs us (Bind b)	      = Bind $ substs us b+    substs us (NoBind b)      = NoBind $ substs us b+    substs _   NoBody	      = NoBody+    substUnder n u (Body t)   = Body $ substUnder n u t+    substUnder n u (Bind b)   = Bind $ substUnder n u b+    substUnder n u (NoBind b) = NoBind $ substUnder n u b+    substUnder _ _   NoBody   = NoBody++-- | Instantiate an abstraction+absApp :: Subst t => Abs t -> Term -> t+absApp (Abs _ v) u = subst u v++-- | Add @k@ to index of each open variable in @x@.+class Raise t where+    raiseFrom :: Nat -> Nat -> t -> t++instance Raise Term where+    raiseFrom m k v =+	case v of+	    Var i vs+		| i < m	    -> Var i $ rf vs+		| otherwise -> Var (i + k) $ rf vs+	    Lam h m	    -> Lam h $ rf m+	    Def c vs	    -> Def c $ rf vs+	    Con c vs	    -> Con c $ rf vs+	    MetaV x vs	    -> MetaV x $ rf vs+	    Lit l	    -> Lit l+	    Pi a b	    -> uncurry Pi $ rf (a,b)+	    Fun a b	    -> uncurry Fun $ rf (a,b)+	    Sort s	    -> Sort s+	where+	    rf x = raiseFrom m k x++instance Raise Type where+    raiseFrom m k (El s t) = El s $ raiseFrom m k t++instance Raise Telescope where+    raiseFrom m k EmptyTel	    = EmptyTel+    raiseFrom m k (ExtendTel a tel) = uncurry ExtendTel $ raiseFrom m k (a, tel)++instance Raise DisplayForm where+  raiseFrom m k (Display n ps v) = Display n (raiseFrom (m + 1) k ps)+					     (raiseFrom (m + n) k v)++instance Raise DisplayTerm where+  raiseFrom m k (DWithApp xs ys) = uncurry DWithApp $ raiseFrom m k (xs, ys)+  raiseFrom m k (DTerm v)	 = DTerm $ raiseFrom m k v++instance Raise t => Raise (Abs t) where+    raiseFrom m k = fmap (raiseFrom (m + 1) k)++instance Raise t => Raise (Arg t) where+    raiseFrom m k = fmap (raiseFrom m k)++instance Raise t => Raise (Blocked t) where+    raiseFrom m k = fmap (raiseFrom m k)++instance Raise t => Raise [t] where+    raiseFrom m k = fmap (raiseFrom m k)++instance Raise t => Raise (Maybe t) where+    raiseFrom m k = fmap (raiseFrom m k)++instance Raise v => Raise (Map k v) where+    raiseFrom m k = fmap (raiseFrom m k)++instance (Raise a, Raise b) => Raise (a,b) where+    raiseFrom m k (x,y) = (raiseFrom m k x, raiseFrom m k y)++raise :: Raise t => Nat -> t -> t+raise = raiseFrom 0++data TelView = TelV Telescope Type++telView :: Type -> TelView+telView t = case unEl t of+  Pi a (Abs x b)  -> absV a x $ telView b+  Fun a b	  -> absV a "_" $ telView (raise 1 b)+  _		  -> TelV EmptyTel t+  where+    absV a x (TelV tel t) = TelV (ExtendTel a (Abs x tel)) t++telePi :: Telescope -> Type -> Type+telePi  EmptyTel	 t = t+telePi (ExtendTel u tel) t = el $ fn u b+  where+    el = El (sLub s1 s2)  +    b = fmap (flip telePi t) tel+    s1 = getSort $ unArg u+    s2 = getSort $ absBody b++    fn a b+      | 0 `freeIn` absBody b = Pi a b+      | otherwise	     = Fun a $ absApp b __IMPOSSIBLE__++-- | Everything will be a pi.+telePi_ :: Telescope -> Type -> Type+telePi_  EmptyTel	 t = t+telePi_ (ExtendTel u tel) t = el $ Pi u b+  where+    el = El (sLub s1 s2)  +    b = fmap (flip telePi_ t) tel+    s1 = getSort $ unArg u+    s2 = getSort $ absBody b+

+ src/full/Agda/TypeChecking/Telescope.hs view

@@ -0,0 +1,119 @@+{-# LANGUAGE CPP #-}++module Agda.TypeChecking.Telescope where++import Data.Set (Set)+import qualified Data.Set as Set+import Data.List++import Agda.Syntax.Common+import Agda.Syntax.Internal++import Agda.TypeChecking.Monad+import Agda.TypeChecking.Substitute+import Agda.TypeChecking.Free++import Agda.Utils.Permutation+import Agda.Utils.Size+import Agda.Utils.Tuple++#include "../undefined.h"+import Agda.Utils.Impossible++-- | The permutation should permute the corresponding telescope. (left-to-right list)+rename :: Subst t => Permutation -> t -> t+rename p = substs (renaming p)++-- | If @permute π : [a]Γ -> [a]Δ@, then @substs (renaming π) : Term Γ -> Term Δ@+renaming :: Permutation -> [Term]+renaming p = gamma'+  where+    n	   = size p+    gamma  = permute (reverseP $ invertP $ reverseP p) $ map var [0..]+    gamma' = gamma ++ map var [n..]+    var i  = Var i []++-- | If @permute π : [a]Γ -> [a]Δ@, then @substs (renamingR π) : Term Δ -> Term Γ@+renamingR :: Permutation -> [Term]+renamingR p@(Perm n _) = permute (reverseP p) (map var [0..]) ++ map var [n..]+  where+    var i  = Var (fromIntegral i) []++-- | Flatten telescope: (Γ : Tel) -> [Type Γ]+flattenTel :: Telescope -> [Arg Type]+flattenTel EmptyTel	     = []+flattenTel (ExtendTel a tel) = raise (size tel + 1) a : flattenTel (absBody tel)++-- | Order a flattened telescope in the correct dependeny order: Γ ->+--   Permutation (Γ -> Γ~)+reorderTel :: [Arg Type] -> Permutation+reorderTel tel = case topoSort comesBefore tel' of+  Nothing -> __IMPOSSIBLE__+  Just p  -> p+  where+    tel' = reverse $ zip [0..] $ reverse tel+    (i, _) `comesBefore` (_, a) = i `freeIn` a++-- | Unflatten: turns a flattened telescope into a proper telescope. Must be+--   properly ordered.+unflattenTel :: [String] -> [Arg Type] -> Telescope+unflattenTel []	  []	        = EmptyTel+unflattenTel (x : xs) (a : tel) = ExtendTel a' (Abs x tel')+  where+    tel' = unflattenTel xs tel+    a'   = substs rho a+    rho  = replicate (size tel + 1) __IMPOSSIBLE__ ++ map var [0..]+      where var i = Var i []+unflattenTel [] (_ : _) = __IMPOSSIBLE__+unflattenTel (_ : _) [] = __IMPOSSIBLE__++-- | Get the suggested names from a telescope+teleNames :: Telescope -> [String]+teleNames = map (fst . unArg) . telToList++teleArgNames :: Telescope -> [Arg String]+teleArgNames = map (fmap fst) . telToList++teleArgs :: Telescope -> Args+teleArgs tel = +  reverse [ Arg h (Var i []) | (i, Arg h _) <- zip [0..] $ reverse (telToList tel) ]++-- | A telescope split in two.+data SplitTel = SplitTel+      { firstPart  :: Telescope+      , secondPart :: Telescope+      , splitPerm  :: Permutation+      }++-- | Split a telescope into the part that defines the given variables and the+--   part that doesn't.+splitTelescope :: Set Nat -> Telescope -> SplitTel+splitTelescope fv tel = SplitTel tel1 tel2 perm+  where+    names = teleNames tel+    ts0   = flattenTel tel++    n     = size tel++    -- We start with a rough split into fv and the rest. This will most likely+    -- not be correct so we patch it up later with reorderTel.+    is    = map (n - 1 -) $ filter (< n) $ reverse $ Set.toList fv+    isC   = [0..n - 1] \\ is+    perm0 = Perm n $ is ++ isC++    permuteTel p ts = rename (reverseP p) (permute p ts)++    ts1   = permuteTel perm0 ts0++    perm1 = reorderTel ts1++    ts2   = permuteTel perm1 ts1++    perm  = composeP perm1 perm0++    tel'  = unflattenTel (permute perm names) ts2++    Perm _ js = perm+    m         = genericLength $ takeWhile (`notElem` is) (reverse js)+    (tel1, tel2) = telFromList -*- telFromList $ genericSplitAt (n - m) $ telToList tel'+

+ src/full/Agda/TypeChecking/Test/Generators.hs view

@@ -0,0 +1,510 @@+{-# LANGUAGE CPP, MultiParamTypeClasses,+             FunctionalDependencies, UndecidableInstances,+             TypeSynonymInstances, FlexibleInstances+  #-}++module Agda.TypeChecking.Test.Generators where++import Control.Applicative+import Control.Monad+import Control.Monad.State+import qualified Data.Set as Set+import qualified Data.List as List (sort, nub)+import Agda.Utils.QuickCheck hiding (Args)++import Agda.Syntax.Position+import Agda.Syntax.Common+import Agda.Syntax.Literal+import Agda.Syntax.Fixity+import Agda.Syntax.Internal+import qualified Agda.Syntax.Concrete.Name as C+import Agda.TypeChecking.Free+import Agda.TypeChecking.Substitute+import Agda.Utils.TestHelpers+import Agda.Utils.Monad+import Agda.Utils.QuickCheck hiding (Args)++#include "../../undefined.h"+import Agda.Utils.Impossible++data TermConfiguration = TermConf+      { tcDefinedNames	   :: [QName]+      , tcConstructorNames :: [QName]+      , tcFreeVariables	   :: [Nat]+      , tcLiterals	   :: UseLiterals+      , tcFrequencies	   :: Frequencies+      , tcFixSize	   :: Maybe Int+	-- ^ Maximum size of the generated element. When @Nothing@ this value+	--   is initialized from the 'Test.QuickCheck.size' parameter.+      , tcIsType	   :: Bool+	-- ^ When this is true no lambdas, literals, or constructors are+	--   generated+      }+  deriving Show++data Frequencies = Freqs+      { hiddenFreqs :: HiddenFreqs+      , nameFreqs   :: NameFreqs+      , sortFreqs   :: SortFreqs+      , termFreqs   :: TermFreqs+      }+  deriving Show++data TermFreqs = TermFreqs+      { nameFreq :: Int+      , litFreq	 :: Int+      , sortFreq :: Int+      , lamFreq	 :: Int+      , piFreq	 :: Int+      , funFreq	 :: Int+      }+  deriving Show++data NameFreqs = NameFreqs+      { varFreq :: Int+      , defFreq :: Int+      , conFreq :: Int+      }+  deriving Show++data HiddenFreqs = HiddenFreqs+      { hiddenFreq    :: Int+      , notHiddenFreq :: Int+      }+  deriving Show++data SortFreqs = SortFreqs+      { setFreqs :: [Int]+      , propFreq :: Int+      }+  deriving Show++defaultFrequencies :: Frequencies+defaultFrequencies = Freqs+      { termFreqs   = TermFreqs	  { nameFreq = 40, litFreq = 1, sortFreq = 2, lamFreq = 10, piFreq = 5, funFreq = 5 }+      , nameFreqs   = NameFreqs	  { varFreq = 3, defFreq = 1, conFreq = 1 }+      , hiddenFreqs = HiddenFreqs { hiddenFreq = 1, notHiddenFreq = 5 }+      , sortFreqs   = SortFreqs	  { setFreqs = [3, 1], propFreq = 1 }+      }++noProp :: TermConfiguration -> TermConfiguration+noProp conf = conf { tcFrequencies = fq { sortFreqs = sfq { propFreq = 0 } } }+  where+    fq	= tcFrequencies conf+    sfq	= sortFreqs fq++data UseLiterals = UseLit+      { useLitInt    :: Bool+      , useLitFloat  :: Bool+      , useLitString :: Bool+      , useLitChar   :: Bool+      }+  deriving Show++noLiterals :: UseLiterals+noLiterals = UseLit False False False False++fixSizeConf :: Int -> TermConfiguration -> TermConfiguration+fixSizeConf n conf = conf { tcFixSize = Just n }++resizeConf :: (Int -> Int) -> TermConfiguration -> TermConfiguration+resizeConf f conf = conf { tcFixSize = fmap f $ tcFixSize conf}++decrConf :: TermConfiguration -> TermConfiguration+decrConf = resizeConf (flip (-) 1)++divConf :: TermConfiguration -> Int -> TermConfiguration+divConf conf k = resizeConf (`div` k) conf++isTypeConf :: TermConfiguration -> TermConfiguration+isTypeConf conf = conf { tcIsType = True }++isntTypeConf :: TermConfiguration -> TermConfiguration+isntTypeConf conf = conf { tcIsType = False }++extendConf :: TermConfiguration -> TermConfiguration+extendConf conf = conf { tcFreeVariables = 0 : map (1+) (tcFreeVariables conf) }++extendWithTelConf :: Telescope -> TermConfiguration -> TermConfiguration+extendWithTelConf tel conf = foldr (const extendConf) conf (telToList tel)++makeConfiguration :: [String] -> [String] -> [Nat] -> TermConfiguration+makeConfiguration ds cs vs = TermConf+  { tcDefinedNames     = defs+  , tcConstructorNames = cons+  , tcFreeVariables    = List.sort $ List.nub vs+  , tcFrequencies      = defaultFrequencies+  , tcLiterals	       = noLiterals+  , tcFixSize	       = Nothing+  , tcIsType	       = False+  }+  where+    (defs, cons) = flip evalState 0 $ +		   (,) <$> mapM mkName ds <*> mapM mkName cs++    tick     = do x <- get; put (x + 1); return x+    mkName s = do+      n <- tick+      return $ QName { qnameModule = MName []+		     , qnameName   = Name+			{ nameId	  = NameId n 1+			, nameConcrete	  = C.Name noRange [C.Id s]+			, nameBindingSite = noRange+			, nameFixity	  = defaultFixity+			}+		      }++class GenC a where+  genC :: TermConfiguration -> Gen a++newtype YesType a   = YesType	{ unYesType :: a     }+newtype NoType  a   = NoType	{ unNoType  :: a     }+newtype VarName	    = VarName	{ unVarName :: Nat   }+newtype DefName	    = DefName	{ unDefName :: QName }+newtype ConName	    = ConName	{ unConName :: QName }+newtype SizedList a = SizedList { unSizedList :: [a] }++fixSize :: TermConfiguration -> Gen a -> Gen a+fixSize conf g = sized $ \n -> resize (maybe n id $ tcFixSize conf) g++instance GenC a => GenC (SizedList a) where+  genC conf = do+    n <- fixSize conf natural+    SizedList <$> vectorOf n (genC $ divConf conf n)++instance GenC a => GenC [a] where+  genC conf = do+    n <- natural+    vectorOf n $ genC $ divConf conf n++instance (GenC a, GenC b) => GenC (a, b) where+  genC conf = (,) <$> genC conf2 <*> genC conf2+    where+      conf2 = divConf conf 2++instance GenC Range where+  genC _ = return noRange++instance GenC Hiding where+  genC conf = frequency [ (hideF, return Hidden), (nohideF, return NotHidden) ]+    where+      HiddenFreqs {hiddenFreq = hideF, notHiddenFreq = nohideF } =+	hiddenFreqs $ tcFrequencies conf++instance GenC a => GenC (Arg a) where+  genC conf = uncurry Arg <$> genC conf++instance GenC a => GenC (Abs a) where+  genC conf = Abs "x" <$> genC (extendConf conf)++genArgs :: TermConfiguration -> Gen Args+genArgs conf = unSizedList <$> genC (isntTypeConf conf)++instance GenC Sort where+  genC conf = frequency $+    (propF, return Prop) :+    zip setFs (map (return . Type) [0..])+    where+      freq f = f $ tcFrequencies conf+      setFs = freq (setFreqs . sortFreqs)+      propF = freq (propFreq . sortFreqs)++instance GenC Char where+  genC _ = elements [' '..'~'] -- TODO++instance GenC Double where+  genC _ = arbitrary++instance GenC Integer where+  genC _ = arbitrary++instance GenC Literal where+  genC conf = oneof (concat $ zipWith gen useLits+	      [ uncurry LitInt	  <$> genC conf+	      , uncurry LitFloat  <$> genC conf+	      , uncurry LitString <$> genC conf+	      , uncurry LitChar   <$> genC conf+	      ]+	   )+    where+      useLits = map ($ tcLiterals conf) [ useLitInt, useLitFloat, useLitString, useLitChar ]++      gen True  g = [g]+      gen False g = []++instance GenC Telescope where+  genC conf = do+    n <- fixSize conf natural+    let confs = take n $ iterate extendConf (divConf conf n)+    telFromList <$> mapM genC confs++instance GenC Type where+  genC conf = El <$> genC conf <*> genC (isTypeConf conf)++instance GenC Term where+  genC conf = case tcFixSize conf of+      Nothing -> sized $ \n -> genC $ fixSizeConf n conf+      Just n | n <= 0    -> genLeaf+	     | otherwise -> frequency+	[ (nameF, genName $ genArgs conf)+	, (litF,  Lit <$> genC conf)+	, (sortF, Sort <$> genC conf)+	, (lamF,  genLam)+	, (piF,	  genPi)+	, (funF,  genFun)+	]+    where+      defs    = tcDefinedNames conf+      cons    = tcConstructorNames conf+      vars    = tcFreeVariables conf+      freq f  = f $ tcFrequencies conf+      isType  = tcIsType conf+      useLits = map ($ tcLiterals conf) [ useLitInt, useLitFloat, useLitString, useLitChar ]++      varF  | null vars = 0+	    | otherwise = freq (varFreq . nameFreqs)+      defF  | null defs = 0+	    | otherwise = freq (defFreq . nameFreqs)+      conF  | null cons || isType = 0+	    | otherwise	       = freq (conFreq . nameFreqs)+      litF  | or useLits && not isType = freq (litFreq . termFreqs)+	    | otherwise		    = 0+      nameF | 0 == varF + defF + conF = 0+	    | otherwise		    = freq (nameFreq . termFreqs)+      lamF  | isType    = 0+	    | otherwise = freq (lamFreq  . termFreqs)+      sortF = freq (sortFreq . termFreqs)+      piF   = freq (piFreq   . termFreqs)+      funF  = freq (funFreq  . termFreqs)++      genLam :: Gen Term+      genLam = Lam <$> genC conf <*> genC (isntTypeConf $ decrConf conf)++      genPi :: Gen Term+      genPi = uncurry Pi <$> genC conf++      genFun :: Gen Term+      genFun = uncurry Fun <$> genC conf++      genVar, genDef, genCon :: Gen Args -> Gen Term+      genVar args = Var <$> elements vars <*> args+      genDef args = Def <$> elements defs <*> args+      genCon args = Con <$> elements cons <*> args++      genName :: Gen Args -> Gen Term+      genName args = frequency+	[ (varF, genVar args) +	, (defF, genDef args)+	, (conF, genCon args)+	]++      genLeaf :: Gen Term+      genLeaf = frequency+	[ (nameF, genName $ return [])+	, (litF,  Lit  <$> genC conf)+	, (sortF, Sort <$> genC conf)+	]++-- | Only generates default configurations. Names and free variables varies.+genConf :: Gen TermConfiguration+genConf = do+  ds <- listOf $ elements defs+  cs <- listOf $ elements cons+  vs <- listOf natural+  return $ makeConfiguration ds cs vs+  where+    defs = [ [c] | c <- ['a'..'z'] ]+    cons = [ [c] | c <- ['A'..'Z'] ]++instance Arbitrary TermConfiguration where+  arbitrary   = genConf++-- Shrinking --------------------------------------------------------------++class ShrinkC a b | a -> b where+  shrinkC  :: TermConfiguration -> a -> [b]+  noShrink :: a -> b++instance ShrinkC a b => ShrinkC (YesType a) b where+  shrinkC conf (YesType x) = shrinkC (isTypeConf conf) x+  noShrink (YesType x) = noShrink x++instance ShrinkC a b => ShrinkC (NoType a) b where+  shrinkC conf (NoType x) = shrinkC (isntTypeConf conf) x+  noShrink (NoType x) = noShrink x++instance ShrinkC a b => ShrinkC [a] [b] where+  noShrink	  = map noShrink+  shrinkC conf xs = noShrink (removeChunks xs) ++ shrinkOne xs+   where+    -- Code stolen from Test.QuickCheck.Arbitrary+    removeChunks xs = rem (length xs) xs+     where+      rem 0 _  = []+      rem 1 _  = [[]]+      rem n xs = xs1+               : xs2+               : ( [ xs1' ++ xs2 | xs1' <- rem n1 xs1, not (null xs1') ]+             `ilv` [ xs1 ++ xs2' | xs2' <- rem n2 xs2, not (null xs2') ]+                 )+       where+        n1  = n `div` 2+        xs1 = take n1 xs+        n2  = n - n1+        xs2 = drop n1 xs+    +        []     `ilv` ys     = ys+        xs     `ilv` []     = xs+        (x:xs) `ilv` (y:ys) = x : y : (xs `ilv` ys)+    +    shrinkOne []     = []+    shrinkOne (x:xs) = [ x' : noShrink xs | x'  <- shrinkC conf x ]+                    ++ [ noShrink x : xs' | xs' <- shrinkOne xs ] ++instance (ShrinkC a a', ShrinkC b b') => ShrinkC (a, b) (a', b') where+  noShrink (x, y) = (noShrink x, noShrink y)+  shrinkC conf (x, y) =+    [ (x', noShrink y) | x' <- shrinkC conf x ] +++    [ (noShrink x, y') | y' <- shrinkC conf y ]++instance ShrinkC VarName Nat where+  shrinkC conf (VarName x) = [ y | y <- tcFreeVariables conf, y < x ]+  noShrink = unVarName++instance ShrinkC DefName QName where+  shrinkC conf (DefName c) = takeWhile (/= c) $ tcDefinedNames conf+  noShrink = unDefName++instance ShrinkC ConName QName where+  shrinkC conf (ConName c) = takeWhile (/= c) $ tcConstructorNames conf+  noShrink = unConName++instance ShrinkC Literal Literal where+  shrinkC _ (LitInt _ 0) = []+  shrinkC conf l	 = LitInt noRange 0 : case l of+      LitInt    r n -> LitInt    r <$> shrink n+      LitString r s -> LitString r <$> shrinkC conf s+      LitChar   r c -> LitChar   r <$> shrinkC conf c+      LitFloat  r x -> LitFloat  r <$> shrink x+  noShrink = id++instance ShrinkC Char Char where+  shrinkC _ 'a' = []+  shrinkC _ _	= ['a']+  noShrink = id++instance ShrinkC Hiding Hiding where+  shrinkC _ Hidden    = [NotHidden]+  shrinkC _ NotHidden = []+  noShrink = id++instance ShrinkC a b => ShrinkC (Abs a) (Abs b) where+  shrinkC conf (Abs s x) = Abs s <$> shrinkC (extendConf conf) x+  noShrink = fmap noShrink++instance ShrinkC a b => ShrinkC (Arg a) (Arg b) where+  shrinkC conf (Arg h x) = uncurry Arg <$> shrinkC conf (h, x)+  noShrink = fmap noShrink++instance ShrinkC a b => ShrinkC (Blocked a) (Blocked b) where+  shrinkC conf (Blocked m x)  = Blocked m <$> shrinkC conf x+  shrinkC conf (NotBlocked x) = NotBlocked <$> shrinkC conf x+  noShrink = fmap noShrink++instance ShrinkC Sort Sort where+  shrinkC conf Prop = []+  shrinkC conf s = Prop : case s of+    Type n    -> Type <$> shrink n+    Lub s1 s2 -> s1 : s2 : (uncurry Lub <$> shrinkC conf (s1, s2))+    Suc s     -> s : (Suc <$> shrinkC conf s)+    MetaS m   -> []+    Prop      -> __IMPOSSIBLE__+  noShrink = id++instance ShrinkC Telescope Telescope where+  shrinkC conf EmptyTel		 = []+  shrinkC conf (ExtendTel a tel) =+    killAbs tel : (uncurry ExtendTel <$> shrinkC conf (a, tel))+  noShrink = id++instance ShrinkC Type Type where+  shrinkC conf (El s t) = uncurry El <$> shrinkC conf (s, YesType t)+  noShrink = id++instance ShrinkC Term Term where+  shrinkC conf (Sort Prop) = []+  shrinkC conf t	   = filter validType $ Sort Prop : case t of+    Var i args   -> map unArg args +++		    (uncurry Var <$> shrinkC conf (VarName i, NoType args))+    Def d args   -> map unArg args +++		    (uncurry Def <$> shrinkC conf (DefName d, NoType args))+    Con d args   -> map unArg args +++		    (uncurry Con <$> shrinkC conf (ConName d, NoType args))+    Lit l	 -> Lit <$> shrinkC conf l+    Lam h b      -> killAbs b : (uncurry Lam <$> shrinkC conf (h, b))+    Pi a b       -> unEl (unArg a) : unEl (killAbs b) :+		    (uncurry Pi <$> shrinkC conf (a, b))+    Fun a b      -> unEl (unArg a) : unEl b :+		    (uncurry Fun <$> shrinkC conf (a, b))+    Sort s       -> Sort <$> shrinkC conf s+    MetaV m args -> map unArg args ++ (MetaV m <$> shrinkC conf (NoType args))+    where+      validType t+	| not (tcIsType conf) = True+	| otherwise	    = case t of+	    Con _ _ -> False+	    Lam _ _ -> False+	    Lit _	  -> False+	    _	  -> True+  noShrink = id++killAbs :: KillVar a => Abs a -> a+killAbs (Abs _ x) = killVar 0 x++class KillVar a where+  killVar :: Nat -> a -> a++instance KillVar Term where+  killVar i t = case t of+    Var j args | j == i	   -> Sort Prop+	       | j >  i	   -> Var (j - 1) $ killVar i args+	       | otherwise -> Var j	  $ killVar i args+    Def c args		   -> Def c	  $ killVar i args+    Con c args		   -> Con c	  $ killVar i args+    Lit l		   -> Lit l+    Sort s		   -> Sort s+    Lam h b		   -> Lam h	  $ killVar i b+    Pi a b		   -> uncurry Pi  $ killVar i (a, b)+    Fun a b		   -> uncurry Fun $ killVar i (a, b)+    MetaV m args	   -> MetaV m	  $ killVar i args++instance KillVar Type where+  killVar i (El s t) = El s $ killVar i t++instance KillVar Telescope where+  killVar i EmptyTel	      = EmptyTel+  killVar i (ExtendTel a tel) = uncurry ExtendTel $ killVar i (a, tel)++instance KillVar a => KillVar (Arg a) where+  killVar i = fmap (killVar i)++instance KillVar a => KillVar (Abs a) where+  killVar i = fmap (killVar (i + 1))++instance KillVar a => KillVar [a] where+  killVar i = map (killVar i)++instance (KillVar a, KillVar b) => KillVar (a, b) where+  killVar i (x, y) = (killVar i x, killVar i y)++-- Tests ------------------------------------------------------------------++isWellScoped :: Free a => TermConfiguration -> a -> Bool+isWellScoped conf t = allVars (freeVars t) `Set.isSubsetOf` Set.fromList (tcFreeVariables conf)++-- | Check that the generated terms don't have any out of scope variables.+prop_wellScopedVars :: TermConfiguration -> Property+prop_wellScopedVars conf =+  forAllShrink (genC conf) (shrinkC conf) $ \t ->+  isWellScoped conf (t :: Term)+

+ src/full/Agda/TypeChecking/Tests.hs view

@@ -0,0 +1,93 @@+module Agda.TypeChecking.Tests where++import qualified Data.Set as Set+import Agda.Utils.QuickCheck++import Agda.Syntax.Internal+import Agda.TypeChecking.Test.Generators+import Agda.TypeChecking.Telescope+import Agda.TypeChecking.Substitute+import Agda.Utils.Size+import Agda.Utils.Permutation+import Agda.Utils.TestHelpers++---------------------------------------------------------------------------+-- * Tests for "Agda.Utils.Permutation"+---------------------------------------------------------------------------++---------------------------------------------------------------------------+-- * Tests for "Agda.TypeChecking.Telescope"+---------------------------------------------------------------------------++-- | @telFromList . telToList == id@+prop_telToListInv :: TermConfiguration -> Property+prop_telToListInv conf =+  forAll (genC conf) $ \tel ->+  telFromList (telToList tel) == tel++-- | All elements of 'flattenTel' are well-scoped under the original telescope.+prop_flattenTelScope :: TermConfiguration -> Property+prop_flattenTelScope conf =+  forAll (genC conf) $ \tel ->+  all (isWellScoped $ extendWithTelConf tel conf) (flattenTel tel)++-- | @unflattenTel . flattenTel == id@+prop_flattenTelInv :: TermConfiguration -> Property+prop_flattenTelInv conf =+  forAll (genC conf) $ \tel ->+  unflattenTel (teleNames tel) (flattenTel tel) == tel++-- | 'reorderTel' is stable.+prop_reorderTelStable :: TermConfiguration -> Property+prop_reorderTelStable conf =+  forAll (genC conf) $ \tel ->+  reorderTel (flattenTel tel) == idP (size tel)++-- | The result of splitting a telescope is well-scoped.+prop_splitTelescopeScope :: TermConfiguration -> Property+prop_splitTelescopeScope conf =+  forAll (genC conf)			    $ \tel ->+  forAll (listOfElements [0..size tel - 1]) $ \vs ->+  let SplitTel tel1 tel2 perm = splitTelescope (Set.fromList vs) tel+      tel' = telFromList (telToList tel1 ++ telToList tel2)+  in  isWellScoped conf tel'++-- | The permutation generated when splitting a telescope preserves scoping.+prop_splitTelescopePermScope :: TermConfiguration -> Property+prop_splitTelescopePermScope conf =+      forAllShrink (genC conf) (shrinkC conf)		     $ \tel ->+      forAllShrink (listOfElements [0..size tel - 1]) shrink $ \vs ->+  let SplitTel tel1 tel2 perm = splitTelescope (Set.fromList vs) tel+      conf1 = extendWithTelConf tel1 conf+      conf2 = conf1 { tcFreeVariables = map (size tel2 +) (tcFreeVariables conf1) }+      conf' = conf  { tcFreeVariables = map (size tel +) (tcFreeVariables conf) ++ vs }+  in  forAllShrink (genC conf') (shrinkC conf') $ \t ->+      isWellScoped conf2 (substs (renamingR $ invertP perm) (t :: Term))++{-+-- | The permutation generated when splitting a telescope correctly translates+--   between the old and the new telescope.+prop_splitTelescopePermInv :: TermConfiguration -> Property+prop_splitTelescopePermInv conf =+      forAll (wellScopedTel conf)		$ \tel ->+      forAll (listOfElements [0..size tel - 1]) $ \vs ->+  let SplitTel tel1 tel2 perm = splitTelescope (Set.fromList vs) tel+      tel' = telFromList (telToList tel1 ++ telToList tel2)+      conf1 = extendWithTelConf tel  conf+      conf2 = extendWithTelConf tel' conf+  in  forAll (wellScopedTerm conf1) $ \t1 ->+      forAll (wellScopedTerm conf2) $ \t2 ->+  let t1' = rename (invertP perm) $ rename perm t1+      t2' = rename perm $ rename (invertP perm) t2+  in  t1 == t1' && t2 == t2'+-}++tests :: IO Bool+tests = runTests "Agda.TypeChecking.Tests"+  [ quickCheck' prop_telToListInv+  , quickCheck' prop_flattenTelScope+  , quickCheck' prop_flattenTelInv+  , quickCheck' prop_reorderTelStable+  , quickCheck' prop_splitTelescopeScope+  , quickCheck' prop_splitTelescopePermScope+  ]

+ src/full/Agda/TypeChecking/With.hs view

@@ -0,0 +1,262 @@+{-# LANGUAGE CPP #-}+module Agda.TypeChecking.With where++import Control.Applicative+import Control.Monad+import Control.Monad.State+import qualified Data.Traversable as T (mapM)+import Data.List++import Agda.Syntax.Common+import Agda.Syntax.Internal+import Agda.Syntax.Abstract (LHS(..), RHS(..))+import qualified Agda.Syntax.Abstract as A+import Agda.Syntax.Position++import Agda.TypeChecking.Monad+import Agda.TypeChecking.Substitute+import Agda.TypeChecking.Reduce+import Agda.TypeChecking.Primitive hiding (Nat)+import Agda.TypeChecking.Pretty+import Agda.TypeChecking.Rules.LHS.Implicit+import Agda.TypeChecking.Abstract+import Agda.TypeChecking.EtaContract++import Agda.Utils.Permutation+import Agda.Utils.Size++#include "../undefined.h"+import Agda.Utils.Impossible++showPat (VarP x)    = text x+showPat (DotP t)    = comma <> text (showsPrec 10 t "")+showPat (ConP c ps) = parens $ prettyTCM c <+> fsep (map (showPat . unArg) ps)+showPat (LitP l)    = text (show l)++withFunctionType :: Telescope -> [Term] -> [Type] -> Telescope -> Type -> TCM Type+withFunctionType delta1 vs as delta2 b = do+  vas <- etaContract <$> normalise (zip vs as)+  b   <- etaContract <$> normalise (telePi_ delta2 b)+  return $ telePi_ delta1 $ foldr (uncurry piAbstractTerm) b vas++-- | Compute the clauses for the with-function given the original patterns.+buildWithFunction :: QName -> Telescope -> [Arg Pattern] -> Permutation ->+                     Nat -> Nat -> [A.Clause] -> TCM [A.Clause]+buildWithFunction aux gamma qs perm n1 n cs = mapM buildWithClause cs+  where+    buildWithClause (A.Clause (LHS i _ ps wps) rhs wh) = do+      let (wps0, wps1) = genericSplitAt n wps+          ps0          = map (Arg NotHidden . unnamed) wps0+      rhs <- buildRHS rhs+      (ps1, ps2)  <- genericSplitAt n1 <$> stripWithClausePatterns gamma qs perm ps+      return $ A.Clause (LHS i aux (ps1 ++ ps0 ++ ps2) wps1) rhs wh++    buildRHS rhs@(RHS _)     = return rhs+    buildRHS rhs@AbsurdRHS   = return rhs+    buildRHS (WithRHS q es cs) = WithRHS q es <$> mapM buildWithClause cs++{-| @stripWithClausePatterns Γ qs π ps = ps'@++    @Δ@ - context bound by lhs of original function (not an argument)++    @Γ@ - type of arguments to original function++    @qs@ - internal patterns for original function++    @π@ - permutation taking @vars(qs)@ to @support(Δ)@++    @ps@ - patterns in with clause (presumably of type @Γ@)++    @ps'@ - patterns for with function (presumably of type @Δ@)+-}+stripWithClausePatterns :: Telescope -> [Arg Pattern] -> Permutation -> [NamedArg A.Pattern] -> TCM [NamedArg A.Pattern]+stripWithClausePatterns gamma qs perm ps = do+  psi <- insertImplicitPatterns ps gamma+  unless (size psi == size gamma) $ fail $ "wrong number of arguments in with clause: given " ++ show (size psi) ++ ", expected " ++ show (size gamma)+  reportSDoc "tc.with.strip" 10 $ vcat+    [ text "stripping patterns"+    , nest 2 $ text "gamma = " <+> prettyTCM gamma+    , nest 2 $ text "psi = " <+> fsep (punctuate comma $ map prettyA psi)+    , nest 2 $ text "qs  = " <+> fsep (punctuate comma $ map (showPat . unArg) qs)+    ]+  ps' <- strip gamma psi qs+  reportSDoc "tc.with.strip" 10 $ vcat+    [ nest 2 $ text "ps' = " <+> fsep (punctuate comma $ map prettyA ps')+    , nest 2 $ text "psp = " <+> fsep (punctuate comma $ map prettyA $ permute perm ps')+    ]++  return $ permute perm ps'+  where+    -- implicit args inserted at top level+    -- all three arguments should have the same size+    strip :: Telescope -> [NamedArg A.Pattern] -> [Arg Pattern] -> TCM [NamedArg A.Pattern]+    strip _           []      (_ : _) = __IMPOSSIBLE__+    strip _           (_ : _) []      = __IMPOSSIBLE__+    strip EmptyTel    (_ : _) _       = __IMPOSSIBLE__+    strip ExtendTel{} []      _       = __IMPOSSIBLE__+    strip EmptyTel    []      []      | 0 == 0 = return []+    strip (ExtendTel a tel) (p : ps) (q : qs) = do+      reportSDoc "tc.with.strip" 15 $ vcat+        [ text "strip" +        , nest 2 $ text "ps =" <+> fsep (punctuate comma $ map prettyA (p : ps))+        , nest 2 $ text "qs =" <+> fsep (punctuate comma $ map (showPat . unArg) (q : qs))+        , nest 2 $ text "tel=" <+> prettyTCM (ExtendTel a tel)+        ]+      case unArg q of+        VarP _  -> do+          ps <- underAbstraction a tel $ \tel -> strip tel ps qs+          return $ p : ps++        DotP v  -> case namedThing $ unArg p of+          A.DotP _ _    -> ok+          A.ImplicitP _ -> ok+          _ -> do+            d <- prettyA p+            typeError $ GenericError $+                "Inaccessible (dotted) patterns from the parent clause must " +++                "also be inaccesible in the with clause, when checking the " +++                "pattern " ++ show d ++ ","+          where+            ok = do+              ps <- strip (tel `absApp` v) ps qs+              return $ p : ps++        ConP c qs' -> case namedThing $ unArg p of+          A.ConP _ (A.AmbQ cs') ps' -> do+          +            Con c' [] <- constructorForm =<< reduce (Con c [])+            c <- return $ c' `withRangeOf` c+            let getCon (Con c []) = c+                getCon _ = __IMPOSSIBLE__+            cs' <- map getCon <$> (mapM constructorForm =<< mapM (\c' -> reduce $ Con c' []) cs')++            unless (elem c cs') mismatch++            -- The type is a datatype+            Def d us <- normalise $ unEl (unArg a)++            -- Compute the argument telescope for the constructor+            Con c []    <- constructorForm =<< normalise (Con c [])+            Defn _ ct _ _ Constructor{conPars = np}  <- getConstInfo c+            ct <- normalise ct+            let ct'         = flip apply (genericTake np us) ct+                TelV tel' _ = telView ct'+++            reportSDoc "tc.with.strip" 20 $+              vcat [ text "ct  = " <+> prettyTCM ct+                   , text "ct' = " <+> prettyTCM ct'+                   , text "np  = " <+> text (show np)+                   , text "us  = " <+> prettyList (map prettyTCM us)+                   , text "us' = " <+> prettyList (map prettyTCM $ genericTake np us)+                   ]++            -- Compute the new telescope+            let v     = Con c $ reverse [ Arg h (Var i []) | (i, Arg h _) <- zip [0..] $ reverse qs' ]+                tel'' = tel' `abstract` absApp (raise (size tel') tel) v++            reportSDoc "tc.with.strip" 15 $ sep+              [ text "inserting implicit"+              , nest 2 $ prettyList $ map prettyA (ps' ++ ps)+              , nest 2 $ text ":" <+> prettyTCM tel''+              ]++            -- Insert implicit patterns (just for the constructor arguments)+            psi' <- insertImplicitPatterns ps' tel'+            unless (size psi' == size tel') $ typeError $ WrongNumberOfConstructorArguments c (size tel') (size psi')++            -- Do it again for everything (is this necessary?)+            psi' <- insertImplicitPatterns (psi' ++ ps) tel''++            -- Keep going+            strip tel'' psi' (qs' ++ qs)+          _ -> mismatch++        LitP lit -> case namedThing $ unArg p of+          A.LitP lit' | lit == lit' -> strip (tel `absApp` Lit lit) ps qs+          _ -> mismatch+      where+        mismatch = typeError $ WithClausePatternMismatch (namedThing $ unArg p) (unArg q)+    strip tel ps qs = error $ "huh? " ++ show (size tel) ++ " " ++ show (size ps) ++ " " ++ show (size qs)++-- | Construct the display form for a with function. It will display+--   applications of the with function as applications to the original function.+--   For instance, @aux a b c@ as @f (suc a) (suc b) | c@+withDisplayForm :: QName -> QName -> Telescope -> Telescope -> Nat -> [Arg Pattern] -> Permutation -> TCM DisplayForm+withDisplayForm f aux delta1 delta2 n qs perm = do+  topArgs <- raise (n + size delta1 + size delta2) <$> getContextArgs+  x <- freshNoName_+  let wild = Def (qualify (mnameFromList []) x) []++  let top = genericLength topArgs+      vs = topArgs ++ raiseFrom (size delta2) n (substs (sub wild) $ patsToTerms qs)+      dt = DWithApp (map DTerm $ Def f vs : withArgs) []+      withArgs = reverse $ map var [size delta2..size delta2 + n - 1]+      pats = genericReplicate (n + size delta1 + size delta2 + top) (Var 0 [])++  let display = Display (n + size delta1 + size delta2 + top) pats dt++  reportSDoc "tc.with.display" 20 $ vcat+    [ text "withDisplayForm"+    , nest 2 $ vcat+      [ text "f      =" <+> text (show f)+      , text "aux    =" <+> text (show aux)+      , text "delta1 =" <+> prettyTCM delta1+      , text "delta2 =" <+> prettyTCM delta2+      , text "perm   =" <+> text (show perm)+      , text "dt     =" <+> prettyTCM dt+      , text "raw    =" <+> text (show display)+      ]+    ]++  return display+  where+    var i = Var i []+    sub wild = map term [0..] -- m - 1]+      where+        Perm m xs = reverseP perm+        term i = case findIndex (i ==) xs of+          Nothing -> wild+          Just j  -> Var (fromIntegral j) []++patsToTerms :: [Arg Pattern] -> [Arg Term]+patsToTerms ps = evalState (toTerms ps) 0+  where+    mapMr f xs = reverse <$> mapM f (reverse xs)++    var :: State Nat Nat+    var = do+      i <- get+      put (i + 1)+      return i++    toTerms :: [Arg Pattern] -> State Nat [Arg Term]+    toTerms ps = mapMr toArg ps++    toArg :: Arg Pattern -> State Nat (Arg Term)+    toArg = T.mapM toTerm++    toTerm :: Pattern -> State Nat Term+    toTerm p = case p of+      VarP _    -> var >>= \i -> return $ Var i []+      DotP t    -> return t+      ConP c ps -> Con c <$> toTerms ps+      LitP l    -> return $ Lit l++data ConPos = Here+            | ArgPat Int ConPos++updateWithConstructorRanges ::+  [Telescope] -> [Arg Pattern] -> A.RHS -> [Arg Pattern]+updateWithConstructorRanges tel ps A.RHS{}            = ps+updateWithConstructorRanges tel ps A.AbsurdRHS{}      = ps+updateWithConstructorRanges tel ps (A.WithRHS _ _ cs) = ps++constructorsInClauses :: ConPos -> [A.Clause] -> [Range]+constructorsInClauses pos cs = concatMap (constructorsInClause pos) cs++constructorsInClause :: ConPos -> A.Clause -> [Range]+constructorsInClause pos (A.Clause (A.LHS _ _ ps wps) rhs _) = []+++

+ src/full/Agda/Utils/Char.hs view

@@ -0,0 +1,15 @@++module Agda.Utils.Char where++import Data.Char++decDigit :: Char -> Int+decDigit c = ord c - ord '0'++hexDigit :: Char -> Int+hexDigit c | isDigit c	= decDigit c+           | otherwise	= ord (toLower c) - ord 'a' + 10++octDigit :: Char -> Int+octDigit = decDigit+

+ src/full/Agda/Utils/Either.hs view

@@ -0,0 +1,40 @@+------------------------------------------------------------------------+-- | Utilities for the 'Either' type+------------------------------------------------------------------------++module Agda.Utils.Either+  ( rights+  , isLeft, isRight+  , tests+  ) where++import Control.Arrow+import Agda.Utils.TestHelpers++-- | Extracts the right elements from the list.++rights :: [Either a b] -> [b]+rights xs = [ x | Right x <- xs ]++-- | Extracts the left elements from the list.++lefts :: [Either a b] -> [a]+lefts xs = [ x | Left x <- xs ]++-- | Returns 'True' iff the argument is @'Right' x@ for some @x@.++isRight :: Either a b -> Bool+isRight (Right _) = True+isRight (Left  _) = False++-- | Returns 'True' iff the argument is @'Left' x@ for some @x@.++isLeft :: Either a b -> Bool+isLeft (Right _) = False+isLeft (Left _)  = True++------------------------------------------------------------------------+-- All tests++tests :: IO Bool+tests = runTests "Agda.Utils.Either" []

+ src/full/Agda/Utils/FileName.hs view

@@ -0,0 +1,243 @@+{-# LANGUAGE CPP #-}++{-| Operations on file names. -}+module Agda.Utils.FileName where++import Agda.Utils.TestHelpers+import Agda.Utils.QuickCheck+import Data.List+import Control.Monad+import System.Directory++splitFilePath :: FilePath -> (FilePath, String, String)+#ifdef mingw32_HOST_OS+splitFilePath (drive:':':s) = let (path, file, ext) = splitFilePath s+                              in (drive:':':path, file, ext)+#endif+splitFilePath s =+    case span (`notElem` slashes) $ reverse s of+	(elif, sl:htap)+	    | sl `elem` slashes -> let (n,e) = splitExt $ reverse elif in+                                    (reverse (slash:htap), n, e)+	(elif, "")	    -> let (n,e) = splitExt $ reverse elif in+				("", n, e)+	_		    -> error $ "impossible: splitFilePath " ++ show s++-- | The extension includes the dot+splitExt :: FilePath -> (String, String)+splitExt x =+    case span (/='.') $ reverse x of+	(txe, '.':elif)	-> (reverse elif, '.' : reverse txe)+	(elif, "")	-> (reverse elif, "")+	_		-> error $ "impossible: splitExt " ++ show x++-- | Change the extension of a filename+setExtension :: String -> FilePath -> FilePath+setExtension ext x = p ++ n ++ ext+    where+	(p,n,_) = splitFilePath x++-- | Breaks up a path (possibly including a file) into a list of+-- drives\/directories (with the file at the end).++splitPath :: FilePath -> [FilePath]+#ifdef mingw32_HOST_OS+splitPath (drive:':':cs) = case splitPath cs of+                             (path:paths) -> (drive:':':path):paths+                             []           -> [[drive,':',slash]]+#endif+splitPath "" = []+splitPath (c : cs) | c `elem` slashes = split cs+                   | otherwise        = split (c : cs)+  where+  split path = case span (`notElem` slashes) path of+    ("", "")        -> []+    (dir, "")       -> [dir]+    (dir, _ : path) -> dir : split path++-- | The moral inverse of splitPath.++unsplitPath :: [FilePath] -> FilePath+#ifdef mingw32_HOST_OS+unsplitPath ((drive:':':path):paths) = drive:':':unsplitPath (path:paths)+#endif+unsplitPath dirs = concat $ intersperse [slash] $ "" : dirs ++ [""]++prop_splitPath_unsplitPath =+  forAll (listOf name) $ \dirs ->+    splitPath (unsplitPath dirs) == dirs++prop_splitPath =+  forAll positive		   $ \n ->+  forAll (vectorOf n nonEmptyName) $ \dirs ->+    let path = concat $ intersperse [slash] dirs+    in+    genericLength (splitPath   path)                    == n+    &&+    genericLength (splitPath $ slash : path)            == n+    &&+    genericLength (splitPath $ path ++ [slash])         == n+    &&+    genericLength (splitPath $ slash : path ++ [slash]) == n++-- | Given a path (not including a file) @'dropDirectory' n@ removes+-- the last @n@ directories in the path (if any).+--+-- Precondition: @n '>=' 0@.++dropDirectory :: Integral i => i -> FilePath -> FilePath+dropDirectory n =+  unsplitPath . reverse . genericDrop n . reverse . splitPath++-- The complexity of the following property, coupled with the+-- simplicity of dropDirectory, indicates that another representation+-- of paths should be used.++prop_dropDirectory =+  forAll natural	  $ \n ->+  forAll path		  $ \p ->+  forAll (pathOfLength n) $ \dirs ->+  forAll nonEmptyName $ \name ->+    dropDirectory n "" == "/"+    &&+    dropDirectory n [slash] == "/"+    &&+    dropDirectory n (addSlash p) == dropDirectory n p+    &&+    let p' = p ++ name in+    dropDirectory n (p' ++ dirs) =^= p'+  where+  infix 4 =^=+  p1 =^= p2 = surround p1 == surround p2++  surround = addSlash . addInitSlash+  addInitSlash cs@(c : _) | c == slash = cs+  addInitSlash cs                      = slash : cs++#if 0+#ifdef mingw32_HOST_OS+canonify (drive:':':xs) ys =+    case ys of+	drive':':':ys'+	    | drive == drive'	-> canonify' xs ys'+	    | otherwise		-> ys+	_			-> canonify' xs ys+#endif+canonify xs ys = canonify' xs ys++canonify' (x:xs) (y:ys)+    | x == y	    = canonify' xs ys+canonify' [] ys	    = ys+canonify' (s:_) ys+    | s == slash    = ys+canonify' xs ys	    = dotdot xs ++ ys++dotdot []	    = []+dotdot (s:xs)+    | s == slash    = slash : dotdot xs+dotdot xs	    =+    case break (== slash) xs of+	(_, xs)	-> ".." ++ dotdot xs+#endif++addSlash "" = ""+addSlash [c]+    | c `elem` slashes = [slash]+    | otherwise	       = [c,slash]+addSlash (c:s) = c : addSlash s++#ifdef mingw32_HOST_OS+slash   = '\\'+slashes = ['\\','/']+#else+slash = '/'+slashes = ['/']+#endif++-- | Removes duplicate file names from the list. Nonexisting files are+-- compared by name only. Two existing files are considered to be+-- equal if+--+-- * 'canonicalizePath' returns the same canonical path for them,+--+-- * and they have the same modification time.+--+-- Nonexisting and existing files are not compared.+--+-- The size test for existing files is included since the first method+-- may not always give correct results. I would want to check the+-- files' sizes instead of their modification times, but+-- "System.Directory" does not contain a function for querying the+-- size of a file.+--+-- This function is of course prone to errors if files are changed+-- while it is running.+--+-- To summarise: There are no guarantees that this function gives+-- correct results. Do not use it for mission-critical code.++nubFiles :: [FilePath] -> IO [FilePath]+nubFiles fs = do+  infos <- mapM getInfo fs+  return (map (either id fst) . nub $ infos)+  where+  getInfo f = do+    ex <- doesFileExist f+    if ex then do+      f' <- canonicalizePath f+      t  <- getModificationTime f+      return $ Right (f', t)+     else+      return $ Left f++------------------------------------------------------------------------+-- Generators++-- | Generates a character distinct from 'slash' (it may be @\'.\'@).++nameChar :: Gen Char+nameChar = elements $ filter (not . (`elem` forbidden)) chars+  where+  chars = "." ++ ['a' .. 'g']+  forbidden = [slash]++-- | Generates a possibly empty string of 'nameChar's.++name :: Gen FilePath+name = listOf nameChar++-- | Generates a non-empty string of 'nameChar's.++nonEmptyName :: Gen FilePath+nonEmptyName = listOf1 nameChar++-- | Generates a possibly empty path (without any drive).++path :: Gen FilePath+path = listOfElements chars+  where+  chars = "/." ++ ['a' .. 'g']++-- | @'pathOfLength' n@ generates a path which contains @n '+' 1@+-- 'slash'es and starts and ends with a 'slash'.++pathOfLength :: Int -> Gen FilePath+pathOfLength n = fmap ((++ [slash]) . concat) $+  vectorOf n (fmap (slash :) name)++prop_pathOfLength =+  forAll natural	  $ \n ->+  forAll (pathOfLength n) $ \path ->+    dropDirectory n path == [slash]+    &&+    genericLength (filter (== slash) path) == n + 1++------------------------------------------------------------------------+-- All tests++tests = runTests "Agda.Utils.FileName"+  [ quickCheck' prop_splitPath_unsplitPath+  , quickCheck' prop_splitPath+  , quickCheck' prop_dropDirectory+  , quickCheck' prop_pathOfLength+  ]

+ src/full/Agda/Utils/Fresh.hs view

@@ -0,0 +1,24 @@+{-# LANGUAGE MultiParamTypeClasses #-}++{-| A common interface for monads which allow some kind of fresh name+    generation.+-}+module Agda.Utils.Fresh where++import Control.Monad.State+import Control.Monad.Reader++class HasFresh i a where+    nextFresh :: a -> (i,a)++fresh :: (HasFresh i s, MonadState s m) => m i+fresh =+    do	(i,s) <- gets nextFresh+	put s+	return i++withFresh :: (HasFresh i e, MonadReader e m) => (i -> m a) -> m a+withFresh ret =+    do	(i,e) <- asks nextFresh+	local (const e) $ ret i+

+ src/full/Agda/Utils/Function.hs view

@@ -0,0 +1,12 @@++module Agda.Utils.Function where++-- | @'iterate'' n f x@ applies @f@ to @x@ @n@ times and returns the+-- result.+--+-- The applications are calculated strictly.++iterate' :: Integral i => i -> (a -> a) -> a -> a+iterate' 0 f x             = x+iterate' n f x | n > 0     = iterate' (n - 1) f $! f x+               | otherwise = error "iterate': Negative input."

+ src/full/Agda/Utils/Generics.hs view

@@ -0,0 +1,28 @@+{-# LANGUAGE Rank2Types #-}+{-| Contains some generic utility functions.+-}+module Agda.Utils.Generics where++import Data.Generics++isString :: GenericQ Bool+isString = mkQ False (const True :: String -> Bool)++everythingBut :: (r -> r -> r) -> GenericQ Bool -> GenericQ r -> GenericQ r+everythingBut (+) stop collect x+    | stop x	= collect x+    | otherwise	= foldr1 (+) $+		    collect x : gmapQ (everythingBut (+) stop collect) x++-- | Same as everywhereBut except that when the stop condition becomes+--   true, the function is called on the top level term (but not on the+--   children).+everywhereBut' :: GenericQ Bool -> GenericT -> GenericT+everywhereBut' q f x+    | q x       = f x+    | otherwise = f (gmapT (everywhereBut' q f) x)++everywhereButM' :: Monad m => GenericQ Bool -> GenericM m -> GenericM m+everywhereButM' q f x+    | q x	= f x+    | otherwise	= f =<< gmapM (everywhereButM' q f) x

+ src/full/Agda/Utils/Graph.hs view

@@ -0,0 +1,77 @@++module Agda.Utils.Graph where++import qualified Data.Map as Map+import qualified Data.Set as Set+import Data.Map (Map)+import Data.Set (Set)++import Agda.Utils.SemiRing++-- Only one edge between any two nodes.+newtype Graph n e = Graph { unGraph :: Map n (Map n e) }++edges :: Ord n => Graph n e -> [(n, n, e)]+edges g = concatMap onNode $ Map.assocs $ unGraph g+  where+    onNode (from, es) = map (onNeighbour from) $ Map.assocs es+    onNeighbour from (to, w) = (from, to, w)++nodes :: Ord n => Graph n e -> Set n+nodes = Set.fromList . concatMap f . edges+  where f (a, b, _) = [a, b]++fromList :: (SemiRing e, Ord n) => [(n, n, e)] -> Graph n e+fromList es = unions [ singleton a b w | (a, b, w) <- es ]++empty :: Graph n e+empty = Graph Map.empty++singleton :: n -> n -> e -> Graph n e+singleton a b w = Graph $ Map.singleton a (Map.singleton b w)++insert :: (SemiRing e, Ord n) => n -> n -> e -> Graph n e -> Graph n e+insert from to w g = union (singleton from to w) g++union :: (SemiRing e, Ord n) => Graph n e -> Graph n e -> Graph n e+union (Graph g1) (Graph g2) =+  Graph $ Map.unionWith (Map.unionWith oplus) g1 g2++unions :: (SemiRing e, Ord n) => [Graph n e] -> Graph n e+unions = foldr union empty++lookup :: Ord n => n -> n -> Graph n e -> Maybe e+lookup a b g = Map.lookup b =<< Map.lookup a (unGraph g)++neighbours :: Ord n => n -> Graph n e -> [(n, e)]+neighbours a g = maybe [] Map.assocs $ Map.lookup a $ unGraph g++growGraph :: (SemiRing e, Ord n) => Graph n e -> Graph n e+growGraph g = foldr union g $ map newEdges $ edges g+  where+    newEdges (a, b, w) = case Map.lookup b (unGraph g) of+        Just es -> Graph $ Map.singleton a $ Map.map (otimes w) es+        Nothing -> empty++transitiveClosure :: (SemiRing e, Ord n) => Graph n e -> Graph n e+transitiveClosure g = iterate growGraph g !! n+  where n = Set.size $ nodes g++findPath :: (SemiRing e, Ord n) => (e -> Bool) -> n -> n -> Graph n e -> Maybe e+findPath good a b g = case filter good $ allPaths good a b g of+  []    -> Nothing+  w : _ -> Just w++allPaths :: (SemiRing e, Ord n, Ord c) => (e -> c) -> n -> n -> Graph n e -> [e]+allPaths classify a b g = paths Set.empty a+  where+    paths visited a = concatMap step $ neighbours a g+      where+        step (c, w)+          | Set.member tag visited = []+          | otherwise = found +++                        map (otimes w)+                          (paths (Set.insert tag visited) c)+          where tag = (c, classify w)+                found | b == c    = [w]+                      | otherwise = []

+ src/full/Agda/Utils/Hash.hs view

@@ -0,0 +1,12 @@++module Agda.Utils.Hash where++hash :: String -> Integer+hash = foldr step 0+  where+    step c n = mod (fromIntegral (fromEnum c) * prime1 + n * prime2) prime3++    prime1 = 1230371+    prime2 = 446441+    prime3 = 275604541+

+ src/full/Agda/Utils/IO.hs view

@@ -0,0 +1,27 @@+module Agda.Utils.IO+  ( readBinaryFile'+  , readTextFile+  , module System.IO.UTF8+  ) where++import System.IO.UTF8+import qualified System.IO.UTF8 as UTF8+import qualified System.IO as IO+import qualified Data.ByteString.Lazy as BS+import Control.Applicative++import Agda.Utils.Unicode++-- | Returns a close function for the file together with the contents.++readBinaryFile' :: FilePath -> IO (BS.ByteString, IO ())+readBinaryFile' file = do+    h <- IO.openBinaryFile file IO.ReadMode+    s <- BS.hGetContents h+    return (s, IO.hClose h)++-- | Reads a UTF8-encoded file in binary mode and converts all Unicode+-- line endings into '\n'.++readTextFile :: FilePath -> IO String+readTextFile file = convertLineEndings <$> UTF8.readFile file

+ src/full/Agda/Utils/Impossible.hs view

@@ -0,0 +1,32 @@+------------------------------------------------------------------------+-- | An interface for reporting \"impossible\" errors+------------------------------------------------------------------------++{-# LANGUAGE DeriveDataTypeable #-}++module Agda.Utils.Impossible where++import Control.Exception+import Data.Typeable++-- | \"Impossible\" errors, annotated with a file name and a line+-- number corresponding to the source code location of the error.++data Impossible = Impossible String Integer deriving Typeable++instance Show Impossible where+  show (Impossible file line) = unlines+    [ "An internal error has occurred. Please report this as a bug."+    , "Location of the error: " ++ file ++ ":" ++ show line+    ]++-- | Abort by throwing an \"impossible\" error. You should not use+-- this function directly. Instead use the macro in @undefined.h@.++throwImpossible :: Impossible -> a+throwImpossible i = throwDyn i++-- | Catch an \"impossible\" error, if possible.++catchImpossible :: IO a -> (Impossible -> IO a) -> IO a+catchImpossible = catchDyn

+ src/full/Agda/Utils/List.hs view

@@ -0,0 +1,116 @@++{-| Utitlity functions on lists.+-}+module Agda.Utils.List where++import Agda.Utils.TestHelpers+import Agda.Utils.QuickCheck+import Agda.Utils.Tuple++import Text.Show.Functions+import Data.List+import Data.Function++type Prefix a = [a]+type Suffix a = [a] ++-- | Check if a list has a given prefix. If so, return the list+--   minus the prefix.+maybePrefixMatch :: Eq a => Prefix a -> [a] -> Maybe (Suffix a)+maybePrefixMatch []    rest = Just rest+maybePrefixMatch (_:_) []   = Nothing+maybePrefixMatch (p:pat) (r:rest)+  | p == r    = maybePrefixMatch pat rest+  | otherwise = Nothing++-- | Split a list into sublists. Generalisation of the prelude function+--   @words@.+--+--   > words xs == wordsBy isSpace xs+wordsBy :: (a -> Bool) -> [a] -> [[a]]+wordsBy p xs = yesP xs+    where+	yesP xs = noP (dropWhile p xs)++	noP []	= []+	noP xs	= ys : yesP zs+	    where+		(ys,zs) = break p xs++-- | Chop up a list in chunks of a given length.+chop :: Int -> [a] -> [[a]]+chop _ [] = []+chop n xs = ys : chop n zs+    where (ys,zs) = splitAt n xs++-- | All ways of removing one element from a list.+holes :: [a] -> [(a, [a])]+holes []     = []+holes (x:xs) = (x, xs) : map (id -*- (x:)) (holes xs)++-- | Check whether all elements in a list are distinct from each+-- other. Assumes that the 'Eq' instance stands for an equivalence+-- relation.+distinct :: Eq a => [a] -> Bool+distinct []	= True+distinct (x:xs) = x `notElem` xs && distinct xs++-- | Checks if all the elements in the list are equal. Assumes that+-- the 'Eq' instance stands for an equivalence relation.+allEqual :: Eq a => [a] -> Bool+allEqual []       = True+allEqual (x : xs) = all (== x) xs++-- | A variant of 'groupBy' which applies the predicate to consecutive+-- pairs.++groupBy' :: (a -> a -> Bool) -> [a] -> [[a]]+groupBy' _ []           = []+groupBy' p xxs@(x : xs) = grp x $ zipWith (\x y -> (p x y, y)) xxs xs+  where+  grp x ys = (x : map snd xs) : tail+    where (xs, rest) = span fst ys+          tail = case rest of+                   []            -> []+                   ((_, z) : zs) -> grp z zs++prop_groupBy' :: (Bool -> Bool -> Bool) -> [Bool] -> Property+prop_groupBy' p xs =+  classify (length xs - length gs >= 3) "interesting" $+    concat gs == xs+    &&+    and [not (null zs) | zs <- gs]+    &&+    and [and (pairInitTail zs zs) | zs <- gs]+    &&+    (null gs || not (or (pairInitTail (map last gs) (map head gs))))+  where gs = groupBy' p xs+        pairInitTail xs ys = zipWith p (init xs) (tail ys)++-- | @'groupOn' f = 'groupBy' (('==') \`on\` f) '.' 'sortBy' ('compare' \`on\` f)@.++groupOn :: Ord b => (a -> b) -> [a] -> [[a]]+groupOn f = groupBy ((==) `on` f) . sortBy (compare `on` f)++-- | @'extractNthElement' n xs@ gives the @n@-th element in @xs@+-- (counting from 0), plus the remaining elements (preserving order).++extractNthElement :: Integral i => i -> [a] -> (a, [a])+extractNthElement n xs = (elem, left ++ right)+  where+  (left, elem : right) = genericSplitAt n xs++prop_extractNthElement :: Integer -> [Integer] -> Property+prop_extractNthElement n xs =+  0 <= n && n < genericLength xs ==>+    genericTake n rest ++ [elem] ++ genericDrop n rest == xs+  where (elem, rest) = extractNthElement n xs++------------------------------------------------------------------------+-- All tests++tests :: IO Bool+tests = runTests "Agda.Utils.List"+  [ quickCheck' prop_groupBy'+  , quickCheck' prop_extractNthElement+  ]

+ src/full/Agda/Utils/Map.hs view

@@ -0,0 +1,40 @@+{-# LANGUAGE CPP #-}++module Agda.Utils.Map where++import Prelude hiding (map, lookup, mapM)+import Control.Applicative+import Data.Map+import Data.Traversable+import Agda.Utils.Monad++#include "../undefined.h"+import Agda.Utils.Impossible++data EitherOrBoth a b = L a | B a b | R b++-- | Not very efficient (goes via a list), but it'll do.+unionWithM :: (Ord k, Functor m, Monad m) => (a -> a -> m a) -> Map k a -> Map k a -> m (Map k a)+unionWithM f m1 m2 = fromList <$> mapM combine (toList m)+    where+	m = unionWith both (map L m1) (map R m2)++	both (L a) (R b) = B a b+	both _     _	 = __IMPOSSIBLE__++	combine (k, B a b) = (,) k <$> f a b+	combine (k, L a)   = return (k, a)+	combine (k, R b)   = return (k, b)++insertWithKeyM :: (Ord k, Monad m) => (k -> a -> a -> m a) -> k -> a -> Map k a -> m (Map k a)+insertWithKeyM clash k x m =+    case lookup k m of+	Just y	-> do+	    z <- clash k x y+	    return $ insert k z m+	Nothing	-> return $ insert k x m++-- | Filter a map based on the keys.+filterKeys :: Ord k => (k -> Bool) -> Map k a -> Map k a+filterKeys p = filterWithKey (const . p)+

+ src/full/Agda/Utils/Maybe.hs view

@@ -0,0 +1,13 @@+{-# LANGUAGE CPP #-}++module Agda.Utils.Maybe+    ( module Agda.Utils.Maybe+    , module Data.Maybe+    ) where++import Data.Monoid+import Data.Maybe++fromMaybeM :: Monad m => m a -> m (Maybe a) -> m a+fromMaybeM m mm = maybe m return =<< mm+

+ src/full/Agda/Utils/Monad.hs view

@@ -0,0 +1,111 @@+{-# LANGUAGE CPP #-}++module Agda.Utils.Monad+    ( module Agda.Utils.Monad+    , (<$>), (<*>)+    )+    where++import Prelude		   hiding (concat)+import Control.Monad+import Control.Monad.Error+import Control.Monad.Reader+import Control.Monad.State+import Control.Monad.Writer+import Control.Applicative+import Data.Traversable+import Data.Foldable+import Data.Monoid++#include "../undefined.h"+import Agda.Utils.Impossible++-- Instances --------------------------------------------------------------++instance Applicative (Reader env) where+  pure  = return+  (<*>) = ap++instance Monad m => Applicative (ReaderT env m) where+  pure  = return+  (<*>) = ap++instance Monad m => Applicative (StateT s m) where+  pure  = return+  (<*>) = ap++instance (Monoid o, Monad m) => Applicative (WriterT o m) where+  pure	= return+  (<*>)	= ap++instance Applicative (State s) where+  pure	= return+  (<*>)	= ap++-- Monads -----------------------------------------------------------------++infixl 8 <.>++(<.>) :: Monad m => (b -> m c) -> (a -> m b) -> a -> m c+f <.> g = \x -> f =<< g x++whenM :: Monad m => m Bool -> m () -> m ()+whenM c m = do	b <- c+		when b m++unlessM :: Monad m => m Bool -> m () -> m ()+unlessM c m = do    b <- c+		    unless b m++ifM :: Monad m => m Bool -> m a -> m a -> m a+ifM c m m' =+    do	b <- c+	if b then m else m'++forgetM :: Applicative m => m a -> m ()+forgetM m = const () <$> m++concatMapM :: Applicative m => (a -> m [b]) -> [a] -> m [b]+concatMapM f xs = concat <$> traverse f xs++-- | Depending on the monad you have to look at the result for+--   the force to be effective. For the 'IO' monad you do.+forceM :: Monad m => [a] -> m ()+forceM xs = do () <- length xs `seq` return ()+	       return ()++commuteM :: (Traversable f, Applicative m) => f (m a) -> m (f a)+commuteM = traverse id++type Cont r a = (a -> r) -> r++-- | 'Control.Monad.mapM' for the continuation monad. Terribly useful.+thread :: (a -> Cont r b) -> [a] -> Cont r [b]+thread f [] ret = ret []+thread f (x:xs) ret =+    f x $ \y -> thread f xs $ \ys -> ret (y:ys)++-- | Requires both lists to have the same lengths.+zipWithM' :: Monad m => (a -> b -> m c) -> [a] -> [b] -> m [c]+zipWithM' f []	     []	      = return []+zipWithM' f (x : xs) (y : ys) = liftM2 (:) (f x y) (zipWithM' f xs ys)+zipWithM' f []	     (_ : _)  = {- ' -} __IMPOSSIBLE__+zipWithM' f (_ : _)  []	      = {- ' -} __IMPOSSIBLE__++-- Maybe ------------------------------------------------------------------++mapMaybeM :: Applicative m => (a -> m b) -> Maybe a -> m (Maybe b)+mapMaybeM f = maybe (pure Nothing) (\x -> Just <$> f x)++-- Either -----------------------------------------------------------------++liftEither :: MonadError e m => Either e a -> m a+liftEither = either throwError return++-- Read -------------------------------------------------------------------++readM :: (Monad m, Read a) => String -> m a+readM s = case reads s of+	    [(x,"")]	-> return x+	    _		-> fail $ "readM: parse error string " ++ s+

+ src/full/Agda/Utils/Monad/Undo.hs view

@@ -0,0 +1,63 @@+{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies,+             FlexibleInstances, UndecidableInstances,+             GeneralizedNewtypeDeriving+  #-}+module Agda.Utils.Monad.Undo where++import Control.Monad.Trans+import Control.Monad.State.Strict+import Control.Monad.Reader+import Control.Monad.Error++import Agda.Utils.Monad++-- | An undo monad is a state monad with backtracking.+class (Functor m, MonadState s m) => MonadUndo s m | m -> s where+    undo    :: m ()+    setUndo :: m ()+    getUndoStack :: m [s]+    putUndoStack :: [s] -> m ()++-- | The undo monad transformer turns any state monad into an undo monad.+newtype UndoT s m a = UndoT { unUndoT :: StateT [s] m a }+    deriving (Functor, Monad, MonadTrans, MonadIO)++instance (MonadState s m, Monad m) => MonadUndo s (UndoT s m) where+    undo =+	do  xs <- UndoT get+	    case xs of+		[]   -> return ()+		x:xs ->+		    do	UndoT $ put xs+			lift $ put x+    setUndo =+	do  x <- lift get+	    UndoT $ modify (x:)++    getUndoStack    = UndoT $ get+    putUndoStack ss = UndoT $ put ss++instance MonadState s m => MonadState s (UndoT s' m) where+    get = lift get+    put = lift . put++instance MonadReader e m => MonadReader e (UndoT s m) where+    ask	      = lift ask+    local f m = UndoT $ local f $ unUndoT m++instance MonadError e m => MonadError e (UndoT s m) where+    throwError	   = lift . throwError+    catchError m h = UndoT $ catchError (unUndoT m) (unUndoT . h)++runUndoT :: Monad m => UndoT s m a -> m a+runUndoT (UndoT sm) = evalStateT sm []++mapUndoT :: (m (a, [s]) -> n (b, [s])) -> UndoT s m a -> UndoT s n b+mapUndoT f = UndoT . mapStateT f . unUndoT++getUndoStateNumber :: MonadUndo s m => m Int+getUndoStateNumber = length <$> getUndoStack++clearUndoHistory :: MonadUndo s m => m ()+clearUndoHistory = putUndoStack []+

+ src/full/Agda/Utils/Permutation.hs view

@@ -0,0 +1,83 @@+{-# LANGUAGE DeriveDataTypeable #-}+module Agda.Utils.Permutation where++import Data.Generics (Typeable, Data)+import Data.List+import Agda.Utils.Size++-- | @permute [2,3,1] [x,y,z] = [y,z,x]@+data Permutation = Perm Integer [Integer]+  deriving (Show, Eq, Data, Typeable)++instance Sized Permutation where+  size (Perm _ xs) = size xs++permute :: Permutation -> [a] -> [a]+permute (Perm _ is) xs = map ((xs !!) . fromIntegral) is++idP :: Integer -> Permutation+idP n = Perm n [0..n - 1]++-- | @permute (compose p1 p2) == permute p1 . permute p2@+composeP :: Permutation -> Permutation -> Permutation+composeP p1 (Perm n xs) = Perm n $ permute p1 xs+  {- proof:+      permute (compose (Perm xs) (Perm ys)) zs+      == permute (Perm (permute (Perm xs) ys)) zs+      == map (zs !!) (permute (Perm xs) ys)+      == map (zs !!) (map (ys !!) xs)+      == map (zs !! . ys !!) xs+      == map (\x -> zs !! (ys !! x)) xs+      == map (\x -> map (zs !!) ys !! x) xs  {- map f xs !! n == f (xs !! n) -}+      == map (map (zs !!) ys !!) xs+      == permute (Perm xs) (permute (Perm ys) zs)+  -}++invertP :: Permutation -> Permutation+invertP p@(Perm n xs) = Perm (size xs) $ map inv [0..n - 1]+  where+    inv x = case findIndex (x ==) xs of+	      Just y  -> fromIntegral y+	      Nothing -> error $ "invertP: non-surjective permutation " ++ show p++-- | Turn a possible non-surjective permutation into a surjective permutation.+compactP :: Permutation -> Permutation+compactP (Perm n xs) = Perm m $ map adjust xs+  where+    m            = genericLength xs+    missing      = [0..n - 1] \\ xs+    holesBelow k = genericLength $ filter (< k) missing+    adjust k = k - holesBelow k++reverseP :: Permutation -> Permutation+reverseP (Perm n xs) = Perm n $ map ((n - 1) -) $ reverse xs++-- | @expandP i n π@ in the domain of @π@ replace the /i/th element by /n/ elements.+expandP :: Integer -> Integer -> Permutation -> Permutation+expandP i n (Perm m xs) = Perm (m + n - 1) $ concatMap expand xs+  where+    expand j+      | j == i	  = [i..i + n - 1]+      | j < i	  = [j]+      | otherwise = [j + n - 1]++-- | Stable topologic sort. The first argument decides whether its first+--   argument is an immediate parent to its second argument.+topoSort :: (a -> a -> Bool) -> [a] -> Maybe Permutation+topoSort parent xs = fmap (Perm (size xs)) $ topo g+  where+    nodes     = zip [0..] xs+    g	      = [ (n, parents x) | (n, x) <- nodes ]+    parents x = [ n | (n, y) <- nodes, parent y x ]++    topo :: Eq node => [(node, [node])] -> Maybe [node]+    topo [] = return []+    topo g  = case xs of+      []    -> fail "cycle detected"+      x : _ -> do+	ys <- topo $ remove x g+	return $ x : ys+      where+	xs = [ x | (x, []) <- g ]+	remove x g = [ (y, filter (/= x) ys) | (y, ys) <- g, x /= y ]+

+ src/full/Agda/Utils/Pointer.hs view

@@ -0,0 +1,25 @@++-- | Wrappers for 'IORef's.+module Agda.Utils.Pointer where++import Control.Monad.Trans+import Data.IORef++type Ptr a = IORef a++deref :: MonadIO io => Ptr a -> io a+deref p = liftIO $ readIORef p++store :: MonadIO io => Ptr a -> a -> io ()+store p x = liftIO $ writeIORef p x++alloc :: MonadIO io => a -> io (Ptr a)+alloc x = liftIO $ newIORef x++updatePtr :: MonadIO io => Ptr a -> (a -> io a) -> io a+updatePtr p f = do+    x <- deref p+    y <- f x+    store p y+    return y+

+ src/full/Agda/Utils/Pretty.hs view

@@ -0,0 +1,29 @@+{-| Pretty printing functions.+-}+module Agda.Utils.Pretty+    ( module Agda.Utils.Pretty+    , module Text.PrettyPrint+    ) where++import Text.PrettyPrint++class Pretty a where+    pretty	:: a -> Doc+    prettyPrec	:: Int -> a -> Doc++    pretty	= prettyPrec 0+    prettyPrec	= const pretty++instance Pretty Doc where+    pretty = id++pwords :: String -> [Doc]+pwords = map text . words++fwords :: String -> Doc+fwords = fsep . pwords++mparens :: Bool -> Doc -> Doc+mparens True  = parens+mparens False = id+

+ src/full/Agda/Utils/QuickCheck.hs view

@@ -0,0 +1,24 @@++module Agda.Utils.QuickCheck+  ( module Test.QuickCheck+  , module Agda.Utils.QuickCheck+  ) where++import Control.Monad+import Control.Applicative+import Test.QuickCheck++isSuccess :: Result -> Bool+isSuccess Success{} = True+isSuccess _         = False++quickCheck' :: Testable prop => prop -> IO Bool+quickCheck' p = fmap isSuccess $ quickCheckResult p++quickCheckWith' :: Testable prop => Args -> prop -> IO Bool+quickCheckWith' args p = fmap isSuccess $ quickCheckWithResult args p++instance Applicative Gen where+  pure = return+  (<*>) = ap+

+ src/full/Agda/Utils/ReadP.hs view

@@ -0,0 +1,486 @@+{-# OPTIONS_GHC -fglasgow-exts #-} -- unboxed integers+-----------------------------------------------------------------------------+-- |++-- This is a modified version of the ReadP module from the standard libraries.+-- The changes are:++--  1) ReadP is parameterised over the token type (hard-wired to 'Char' in the library).+--  2) Added a 'parse' function to run a parser.+--  3) Removed Read instances.++-- Module      :  "Text.ParserCombinators.ReadP"+-- Copyright   :  (c) The University of Glasgow 2002+-- License     :  BSD-style (see the file libraries/base/LICENSE)+-- +-- Maintainer  :  libraries@haskell.org+-- Stability   :  provisional+-- Portability :  non-portable (local universal quantification)+--+-- This is a library of parser combinators, originally written by Koen Claessen.+-- It parses all alternatives in parallel, so it never keeps hold of +-- the beginning of the input string, a common source of space leaks with+-- other parsers.  The '(+++)' choice combinator is genuinely commutative;+-- it makes no difference which branch is \"shorter\".++-----------------------------------------------------------------------------++module Agda.Utils.ReadP+  ( +  -- * The 'ReadP' type+  ReadP,      -- :: * -> *; instance Functor, Monad, MonadPlus+  +  -- * Primitive operations+  get,        -- :: ReadP Char+  look,       -- :: ReadP String+  (+++),      -- :: ReadP a -> ReadP a -> ReadP a+  (<++),      -- :: ReadP a -> ReadP a -> ReadP a+  gather,     -- :: ReadP a -> ReadP (String, a)++  -- * Parse+  parse,      -- :: ReadP tok a -> [tok] -> [a]++  -- * Other operations+  pfail,      -- :: ReadP a+  satisfy,    -- :: (Char -> Bool) -> ReadP Char+  char,       -- :: Char -> ReadP Char+  string,     -- :: String -> ReadP String+  munch,      -- :: (Char -> Bool) -> ReadP String+  munch1,     -- :: (Char -> Bool) -> ReadP String+  skipSpaces, -- :: ReadP ()+  choice,     -- :: [ReadP a] -> ReadP a+  count,      -- :: Int -> ReadP a -> ReadP [a]+  between,    -- :: ReadP open -> ReadP close -> ReadP a -> ReadP a+  option,     -- :: a -> ReadP a -> ReadP a+  optional,   -- :: ReadP a -> ReadP ()+  many,       -- :: ReadP a -> ReadP [a]+  many1,      -- :: ReadP a -> ReadP [a]+  skipMany,   -- :: ReadP a -> ReadP ()+  skipMany1,  -- :: ReadP a -> ReadP ()+  sepBy,      -- :: ReadP a -> ReadP sep -> ReadP [a]+  sepBy1,     -- :: ReadP a -> ReadP sep -> ReadP [a]+  endBy,      -- :: ReadP a -> ReadP sep -> ReadP [a]+  endBy1,     -- :: ReadP a -> ReadP sep -> ReadP [a]+  chainr,     -- :: ReadP a -> ReadP (a -> a -> a) -> a -> ReadP a+  chainl,     -- :: ReadP a -> ReadP (a -> a -> a) -> a -> ReadP a+  chainl1,    -- :: ReadP a -> ReadP (a -> a -> a) -> ReadP a+  chainr1,    -- :: ReadP a -> ReadP (a -> a -> a) -> ReadP a+  manyTill,   -- :: ReadP a -> ReadP end -> ReadP [a]++  -- * Properties+  -- $properties+  )+ where++import Control.Monad+import GHC.Prim+import Data.Char++infixr 5 +++, <++++-- ---------------------------------------------------------------------------+-- The P type+-- is representation type -- should be kept abstract++data P t a+  = Get (t -> P t a)+  | Look ([t] -> P t a)+  | Fail+  | Result a (P t a)+  | Final [(a,[t])] -- invariant: list is non-empty!++-- Monad, MonadPlus++instance Monad (P t) where+  return x = Result x Fail++  (Get f)      >>= k = Get (\c -> f c >>= k)+  (Look f)     >>= k = Look (\s -> f s >>= k)+  Fail         >>= k = Fail+  (Result x p) >>= k = k x `mplus` (p >>= k)+  (Final r)    >>= k = final [ys' | (x,s) <- r, ys' <- run (k x) s]++  fail _ = Fail++instance MonadPlus (P t) where+  mzero = Fail++  -- most common case: two gets are combined+  Get f1     `mplus` Get f2     = Get (\c -> f1 c `mplus` f2 c)+  +  -- results are delivered as soon as possible+  Result x p `mplus` q          = Result x (p `mplus` q)+  p          `mplus` Result x q = Result x (p `mplus` q)++  -- fail disappears+  Fail       `mplus` p          = p+  p          `mplus` Fail       = p++  -- two finals are combined+  -- final + look becomes one look and one final (=optimization)+  -- final + sthg else becomes one look and one final+  Final r    `mplus` Final t    = Final (r ++ t)+  Final r    `mplus` Look f     = Look (\s -> Final (r ++ run (f s) s))+  Final r    `mplus` p          = Look (\s -> Final (r ++ run p s))+  Look f     `mplus` Final r    = Look (\s -> Final (run (f s) s ++ r))+  p          `mplus` Final r    = Look (\s -> Final (run p s ++ r))++  -- two looks are combined (=optimization)+  -- look + sthg else floats upwards+  Look f     `mplus` Look g     = Look (\s -> f s `mplus` g s)+  Look f     `mplus` p          = Look (\s -> f s `mplus` p)+  p          `mplus` Look f     = Look (\s -> p `mplus` f s)++-- ---------------------------------------------------------------------------+-- The ReadP type++newtype ReadP t a = R (forall b . (a -> P t b) -> P t b)++-- Functor, Monad, MonadPlus++instance Functor (ReadP t) where+  fmap h (R f) = R (\k -> f (k . h))++instance Monad (ReadP t) where+  return x  = R (\k -> k x)+  fail _    = R (\_ -> Fail)+  R m >>= f = R (\k -> m (\a -> let R m' = f a in m' k))++instance MonadPlus (ReadP t) where+  mzero = pfail+  mplus = (+++)++-- ---------------------------------------------------------------------------+-- Operations over P++final :: [(a,[t])] -> P t a+-- Maintains invariant for Final constructor+final [] = Fail+final r  = Final r++run :: P t a -> [t] -> [(a,[t])]+run (Get f)      (c:s) = run (f c) s+run (Look f)     s     = run (f s) s+run (Result x p) s     = (x,s) : run p s+run (Final r)    _     = r+run _            _     = []++-- ---------------------------------------------------------------------------+-- Operations over ReadP++-- | Run a parser on a list of tokens. Returns the list of complete matches.+parse :: ReadP t a -> [t] -> [a]+parse p ts = case complete p of+    R f	-> map fst $ run (f return) ts++get :: ReadP t t+-- ^ Consumes and returns the next character.+--   Fails if there is no input left.+get = R Get++look :: ReadP t [t]+-- ^ Look-ahead: returns the part of the input that is left, without+--   consuming it.+look = R Look++pfail :: ReadP t a+-- ^ Always fails.+pfail = R (\_ -> Fail)++(+++) :: ReadP t a -> ReadP t a -> ReadP t a+-- ^ Symmetric choice.+R f1 +++ R f2 = R (\k -> f1 k `mplus` f2 k)++(<++) :: ReadP t a -> ReadP t a -> ReadP t a+-- ^ Local, exclusive, left-biased choice: If left parser+--   locally produces any result at all, then right parser is+--   not used.+R f <++ q =+  do s <- look+     probe (f return) s 0#+ where+  probe (Get f)        (c:s) n = probe (f c) s (n+#1#)+  probe (Look f)       s     n = probe (f s) s n+  probe p@(Result _ _) _     n = discard n >> R (p >>=)+  probe (Final r)      _     _ = R (Final r >>=)+  probe _              _     _ = q++  discard 0# = return ()+  discard n  = get >> discard (n-#1#)++gather :: ReadP t a -> ReadP t ([t], a)+-- ^ Transforms a parser into one that does the same, but+--   in addition returns the exact characters read.+--   IMPORTANT NOTE: 'gather' gives a runtime error if its first argument+--   is built using any occurrences of readS_to_P. +gather (R m) =+  R (\k -> gath id (m (\a -> return (\s -> k (s,a)))))  + where+  gath l (Get f)      = Get (\c -> gath (l.(c:)) (f c))+  gath l Fail         = Fail+  gath l (Look f)     = Look (\s -> gath l (f s))+  gath l (Result k p) = k (l []) `mplus` gath l p+  gath l (Final r)    = error "do not use readS_to_P in gather!"++-- ---------------------------------------------------------------------------+-- Derived operations++satisfy :: (t -> Bool) -> ReadP t t+-- ^ Consumes and returns the next character, if it satisfies the+--   specified predicate.+satisfy p = do c <- get; if p c then return c else pfail++char :: Eq t => t-> ReadP t t+-- ^ Parses and returns the specified character.+char c = satisfy (c ==)++string :: Eq t => [t] -> ReadP t [t]+-- ^ Parses and returns the specified string.+string this = do s <- look; scan this s+ where+  scan []     _               = do return this+  scan (x:xs) (y:ys) | x == y = do get; scan xs ys+  scan _      _               = do pfail++eof :: ReadP tok ()+eof = do+    ts <- look+    unless (null ts) pfail++complete :: ReadP tok a -> ReadP tok a+complete p = do+    x <- p+    eof+    return x++munch :: (t -> Bool) -> ReadP t [t]+-- ^ Parses the first zero or more characters satisfying the predicate.+munch p =+  do s <- look+     scan s+ where+  scan (c:cs) | p c = do get; s <- scan cs; return (c:s)+  scan _            = do return []++munch1 :: (t -> Bool) -> ReadP t [t]+-- ^ Parses the first one or more characters satisfying the predicate.+munch1 p =+  do c <- get+     if p c then do s <- munch p; return (c:s) else pfail++choice :: [ReadP t a] -> ReadP t a+-- ^ Combines all parsers in the specified list.+choice []     = pfail+choice [p]    = p+choice (p:ps) = p +++ choice ps++skipSpaces :: ReadP Char ()+-- ^ Skips all whitespace.+skipSpaces =+  do s <- look+     skip s+ where+  skip (c:s) | isSpace c = do get; skip s+  skip _                 = do return ()++count :: Int -> ReadP t a -> ReadP t [a]+-- ^ @count n p@ parses @n@ occurrences of @p@ in sequence. A list of+--   results is returned.+count n p = sequence (replicate n p)++between :: ReadP t open -> ReadP t close -> ReadP t a -> ReadP t a+-- ^ @between open close p@ parses @open@, followed by @p@ and finally+--   @close@. Only the value of @p@ is returned.+between open close p = do open+                          x <- p+                          close+                          return x++option :: a -> ReadP t a -> ReadP t a+-- ^ @option x p@ will either parse @p@ or return @x@ without consuming+--   any input.+option x p = p +++ return x++optional :: ReadP t a -> ReadP t ()+-- ^ @optional p@ optionally parses @p@ and always returns @()@.+optional p = (p >> return ()) +++ return ()++many :: ReadP t a -> ReadP t [a]+-- ^ Parses zero or more occurrences of the given parser.+many p = return [] +++ many1 p++many1 :: ReadP t a -> ReadP t [a]+-- ^ Parses one or more occurrences of the given parser.+many1 p = liftM2 (:) p (many p)++skipMany :: ReadP t a -> ReadP t ()+-- ^ Like 'many', but discards the result.+skipMany p = many p >> return ()++skipMany1 :: ReadP t a -> ReadP t ()+-- ^ Like 'many1', but discards the result.+skipMany1 p = p >> skipMany p++sepBy :: ReadP t a -> ReadP t sep -> ReadP t [a]+-- ^ @sepBy p sep@ parses zero or more occurrences of @p@, separated by @sep@.+--   Returns a list of values returned by @p@.+sepBy p sep = sepBy1 p sep +++ return []++sepBy1 :: ReadP t a -> ReadP t sep -> ReadP t [a]+-- ^ @sepBy1 p sep@ parses one or more occurrences of @p@, separated by @sep@.+--   Returns a list of values returned by @p@.+sepBy1 p sep = liftM2 (:) p (many (sep >> p))++endBy :: ReadP t a -> ReadP t sep -> ReadP t [a]+-- ^ @endBy p sep@ parses zero or more occurrences of @p@, separated and ended+--   by @sep@.+endBy p sep = many (do x <- p ; sep ; return x)++endBy1 :: ReadP t a -> ReadP t sep -> ReadP t [a]+-- ^ @endBy p sep@ parses one or more occurrences of @p@, separated and ended+--   by @sep@.+endBy1 p sep = many1 (do x <- p ; sep ; return x)++chainr :: ReadP t a -> ReadP t (a -> a -> a) -> a -> ReadP t a+-- ^ @chainr p op x@ parses zero or more occurrences of @p@, separated by @op@.+--   Returns a value produced by a /right/ associative application of all+--   functions returned by @op@. If there are no occurrences of @p@, @x@ is+--   returned.+chainr p op x = chainr1 p op +++ return x++chainl :: ReadP t a -> ReadP t (a -> a -> a) -> a -> ReadP t a+-- ^ @chainl p op x@ parses zero or more occurrences of @p@, separated by @op@.+--   Returns a value produced by a /left/ associative application of all+--   functions returned by @op@. If there are no occurrences of @p@, @x@ is+--   returned.+chainl p op x = chainl1 p op +++ return x++chainr1 :: ReadP t a -> ReadP t (a -> a -> a) -> ReadP t a+-- ^ Like 'chainr', but parses one or more occurrences of @p@.+chainr1 p op = scan+  where scan   = p >>= rest+        rest x = do f <- op+                    y <- scan+                    return (f x y)+                 +++ return x++chainl1 :: ReadP t a -> ReadP t (a -> a -> a) -> ReadP t a+-- ^ Like 'chainl', but parses one or more occurrences of @p@.+chainl1 p op = p >>= rest+  where rest x = do f <- op+                    y <- p+                    rest (f x y)+                 +++ return x++manyTill :: ReadP t a -> ReadP t end -> ReadP t [a]+-- ^ @manyTill p end@ parses zero or more occurrences of @p@, until @end@+--   succeeds. Returns a list of values returned by @p@.+manyTill p end = scan+  where scan = (end >> return []) <++ (liftM2 (:) p scan)++-- ---------------------------------------------------------------------------+-- Converting between ReadP and Read++readP_to_S :: ReadP Char a -> ReadS a+-- ^ Converts a parser into a Haskell ReadS-style function.+--   This is the main way in which you can \"run\" a 'ReadP' parser:+--   the expanded type is+-- @ readP_to_S :: ReadP a -> String -> [(a,String)] @+readP_to_S (R f) = run (f return)++readS_to_P :: ReadS a -> ReadP Char a+-- ^ Converts a Haskell ReadS-style function into a parser.+--   Warning: This introduces local backtracking in the resulting+--   parser, and therefore a possible inefficiency.+readS_to_P r =+  R (\k -> Look (\s -> final [bs'' | (a,s') <- r s, bs'' <- run (k a) s']))++-- ---------------------------------------------------------------------------+-- QuickCheck properties that hold for the combinators++{- $properties+The following are QuickCheck specifications of what the combinators do.+These can be seen as formal specifications of the behavior of the+combinators.++We use bags to give semantics to the combinators.++>  type Bag a = [a]++Equality on bags does not care about the order of elements.++>  (=~) :: Ord a => Bag a -> Bag a -> Bool+>  xs =~ ys = sort xs == sort ys++A special equality operator to avoid unresolved overloading+when testing the properties.++>  (=~.) :: Bag (Int,String) -> Bag (Int,String) -> Bool+>  (=~.) = (=~)++Here follow the properties:++>  prop_Get_Nil =+>    readP_to_S get [] =~ []+>+>  prop_Get_Cons c s =+>    readP_to_S get (c:s) =~ [(c,s)]+>+>  prop_Look s =+>    readP_to_S look s =~ [(s,s)]+>+>  prop_Fail s =+>    readP_to_S pfail s =~. []+>+>  prop_Return x s =+>    readP_to_S (return x) s =~. [(x,s)]+>+>  prop_Bind p k s =+>    readP_to_S (p >>= k) s =~.+>      [ ys''+>      | (x,s') <- readP_to_S p s+>      , ys''   <- readP_to_S (k (x::Int)) s'+>      ]+>+>  prop_Plus p q s =+>    readP_to_S (p +++ q) s =~.+>      (readP_to_S p s ++ readP_to_S q s)+>+>  prop_LeftPlus p q s =+>    readP_to_S (p <++ q) s =~.+>      (readP_to_S p s +<+ readP_to_S q s)+>   where+>    [] +<+ ys = ys+>    xs +<+ _  = xs+>+>  prop_Gather s =+>    forAll readPWithoutReadS $ \p -> +>      readP_to_S (gather p) s =~+>	 [ ((pre,x::Int),s')+>	 | (x,s') <- readP_to_S p s+>	 , let pre = take (length s - length s') s+>	 ]+>+>  prop_String_Yes this s =+>    readP_to_S (string this) (this ++ s) =~+>      [(this,s)]+>+>  prop_String_Maybe this s =+>    readP_to_S (string this) s =~+>      [(this, drop (length this) s) | this `isPrefixOf` s]+>+>  prop_Munch p s =+>    readP_to_S (munch p) s =~+>      [(takeWhile p s, dropWhile p s)]+>+>  prop_Munch1 p s =+>    readP_to_S (munch1 p) s =~+>      [(res,s') | let (res,s') = (takeWhile p s, dropWhile p s), not (null res)]+>+>  prop_Choice ps s =+>    readP_to_S (choice ps) s =~.+>      readP_to_S (foldr (+++) pfail ps) s+>+>  prop_ReadS r s =+>    readP_to_S (readS_to_P r) s =~. r s+-}

+ src/full/Agda/Utils/SemiRing.hs view

@@ -0,0 +1,16 @@++module Agda.Utils.SemiRing where++class SemiRing a where+  oplus  :: a -> a -> a+  otimes :: a -> a -> a++instance SemiRing a => SemiRing (Maybe a) where+  oplus Nothing y = y+  oplus x Nothing = x+  oplus (Just x) (Just y) = Just (oplus x y)++  otimes Nothing _ = Nothing+  otimes _ Nothing = Nothing+  otimes (Just x) (Just y) = Just (otimes x y)+

+ src/full/Agda/Utils/Serialise.hs view

@@ -0,0 +1,163 @@+{-# LANGUAGE TypeSynonymInstances #-}+module Agda.Utils.Serialise where++import Control.Monad+import Data.Generics+import qualified Data.Map as Map+import Data.Map (Map)+import Data.Maybe+import Data.Either+import qualified Data.ByteString.Lazy as BS+import Data.ByteString.Lazy (ByteString)+import Codec.Binary.UTF8.String as UTF8++import Agda.Utils.Tuple++newtype Printer a = Printer { runPrinter :: a -> ShowS }+newtype Parser  a = Parser  { runParser :: ByteString -> (a, ByteString) }++data IFun a b = IFun (a -> b) (b -> a)++class BiMonad m where+    charS   :: m Char+    stringS :: Int -> m String+    returnS :: a -> m a+    bindS   :: (b -> a) -> m a -> (a -> m b) -> m b++instance BiMonad Printer where+    charS = Printer (:)+    stringS _ = Printer $ \s rest -> UTF8.encodeString s ++ rest+    returnS _ = Printer $ const id+    bindS mkA (Printer prA) k =+	Printer $ \b -> let a = mkA b in prA a . runPrinter (k a) b++bsToString :: ByteString -> String+bsToString = UTF8.decodeString . map (toEnum . fromIntegral) . BS.unpack++instance BiMonad Parser where+    charS		 = Parser $ \s -> (toEnum . fromIntegral $ BS.head s, BS.tail s)+    stringS n		 = Parser $ \s -> let (s0,rest) = BS.splitAt (fromIntegral n) s+					  in (bsToString s0, rest)+    returnS x		 = Parser $ \s -> (x,s)+    bindS _ (Parser m) k = Parser $ \s -> let (x,s') = m s in runParser (k x) s'++mapS :: BiMonad m => IFun a b -> m a -> m b+mapS (IFun f g) sa = bindS g sa $ returnS . f++(>->) :: BiMonad m => m a -> m b -> m (a,b)+sa >-> sb = bindS fst sa $ \a -> +	    bindS snd sb $ \b ->+	    returnS (a,b)++sequenceS :: BiMonad m => [m a] -> m [a]+sequenceS []	 = returnS []+sequenceS (s:ss) =+    bindS head s	      $ \x ->+    bindS tail (sequenceS ss) $ \xs ->+    returnS (x : xs)++replicateS :: BiMonad m => Int -> m a -> m [a]+replicateS n = sequenceS . replicate n++class Serialisable a where+    serialiser :: BiMonad m => m a++instance Serialisable () where+    serialiser = returnS ()++instance Serialisable Char where+    serialiser = {-# SCC "charS" #-} charS++instance Serialisable Int where+    serialiser = {-# SCC "intS" #-} bindS small serialiser $ \c -> case c of+	'\255'	-> mapS (fromChars `IFun` toChars) $ replicateS nChars serialiser+	_	-> returnS $ fromEnum c+	where+	    nChars = 4++	    small n | n >= 0 && n < 255	= toEnum n+		    | otherwise		= '\255'++	    toChars :: Int -> [Char]+	    toChars n = map (toEnum . (`mod` 256))+			$ scanl (\n _ -> div n 256) n+			$ replicate (nChars - 1) ()++	    fromChars :: [Char] -> Int+	    fromChars bs = foldr (\b n -> fromEnum b + 256 * n) 0 bs++instance Serialisable Bool where+    serialiser = mapS (fromChar `IFun` toChar) serialiser+	where+	    fromChar 't' = True+	    fromChar 'f' = False+	    fromChar _   = error "deserialise Bool: no parse"+	    toChar True  = 't'+	    toChar False = 'f'++instance Serialisable a => Serialisable (Maybe a) where+    serialiser = bindS code serialiser $ \c -> case c of+		    'j' -> mapS (IFun Just fromJust) serialiser+		    'n' -> returnS Nothing+		    _	-> error "deserialise Maybe: no parse"+	where+	    code Nothing  = 'n'+	    code (Just _) = 'j'++instance (Serialisable a, Serialisable b) => Serialisable (Either a b) where+    serialiser = bindS code serialiser $ \c -> case c of+		    'l' -> mapS (IFun Left  fromLeft ) serialiser+		    'r' -> mapS (IFun Right fromRight) serialiser+		    _	-> error "deserialise Either: no parse"+	where+	    code (Left  _) = 'l'+	    code (Right _) = 'r'+	    fromLeft  (Left x) = x+	    fromLeft  _	       = error "fromLeft"+	    fromRight (Right x) = x+	    fromRight _	       = error "fromRight"++instance (Serialisable a, Serialisable b) => Serialisable (a,b) where+    serialiser = serialiser >-> serialiser++instance (Serialisable a, Serialisable b, Serialisable c) => Serialisable (a,b,c) where+    serialiser = mapS (IFun (\(x,(y,z)) -> (x,y,z)) (\(x,y,z) -> (x,(y,z))))+		 serialiser++instance (Serialisable a, Serialisable b, Serialisable c, Serialisable d)+	=> Serialisable (a,b,c,d) where+    serialiser = mapS (IFun (\((x,y),(z,w)) -> (x,y,z,w)) (\(x,y,z,w) -> ((x,y),(z,w))))+		 serialiser++instance (Serialisable a, Serialisable b, Serialisable c, Serialisable d, Serialisable e)+	=> Serialisable (a,b,c,d,e) where+    serialiser = mapS (IFun (\((x,y),(z,w,u)) -> (x,y,z,w,u)) (\(x,y,z,w,u) -> ((x,y),(z,w,u))))+		 serialiser++instance (Serialisable a, Serialisable b, Serialisable c, Serialisable d, Serialisable e, Serialisable f)+	=> Serialisable (a,b,c,d,e,f) where+    serialiser = mapS (IFun (\((x,y,v),(z,w,u)) -> (x,y,v,z,w,u)) (\(x,y,v,z,w,u) -> ((x,y,v),(z,w,u))))+		 serialiser++instance Serialisable String where+    serialiser = {-# SCC "stringS" #-} bindS (length . UTF8.encodeString) serialiser stringS++instance Serialisable a => Serialisable [a] where+    serialiser = {-# SCC "listS" #-} bindS length serialiser $ \n -> replicateS n serialiser++instance (Ord k, Serialisable k, Serialisable v) => Serialisable (Map k v) where+    serialiser = mapS (Map.fromList `IFun` Map.toList) serialiser++serialise :: Serialisable a => a -> String+serialise x = runPrinter serialiser x ""++deserialise :: Serialisable a => ByteString -> a+deserialise s = case deserialiseLazy s of+    (x,True) -> x+    _	     -> error "deserialise: no parse"++-- | Force the Bool to force the a. True means ok and false means left-over garbage.+deserialiseLazy :: Serialisable a => ByteString -> (a, Bool)+deserialiseLazy s = case runParser serialiser s of+    (x, s)  -> (x, BS.null s)+

+ src/full/Agda/Utils/Size.hs view

@@ -0,0 +1,21 @@++module Agda.Utils.Size ( Sized(..) ) where++import Data.Map (Map)+import qualified Data.Map as Map+import Data.Set (Set)+import qualified Data.Set as Set+import Data.List++class Sized a where+  size :: Integral n => a -> n++instance Sized [a] where+  size = genericLength++instance Sized (Map k a) where+  size = fromIntegral . Map.size++instance Sized (Set a) where+  size = fromIntegral . Set.size+

+ src/full/Agda/Utils/String.hs view

@@ -0,0 +1,38 @@+module Agda.Utils.String+  ( quote+  , addFinalNewLine+  , indent+  ) where++import Data.List++-- | 'quote' adds double quotes around the string, and escapes double+-- quotes and backslashes within the string. This is different from+-- the behaviour of 'show':+--+-- @+-- \> 'System.IO.UTF8.putStrLn' $ 'show' \"\\x2200\"+-- \"\\8704\"+-- \> 'System.IO.UTF8.putStrLn' $ 'quote' \"\\x2200\"+-- \"&#x2200;\"+-- @++quote :: String -> String+quote s = "\"" ++ concatMap escape s ++ "\""+  where+  escape c | c `elem` escapeChars = ['\\', c]+           | otherwise            = [c]++  escapeChars = "\"\\"++-- | Adds a final newline if there is not already one.++addFinalNewLine :: String -> String+addFinalNewLine "" = "\n"+addFinalNewLine s | last s == '\n' = s+                  | otherwise      = s ++ "\n"++-- | Indents every line the given number of steps.++indent :: Integral i => i -> String -> String+indent i = unlines . map (genericReplicate i ' ' ++) . lines

+ src/full/Agda/Utils/Suffix.hs view

@@ -0,0 +1,24 @@+{-# LANGUAGE PatternGuards #-}+module Agda.Utils.Suffix where++import Data.Char++data Suffix = NoSuffix | Prime Int | Index Int++nextSuffix NoSuffix  = Prime 1+nextSuffix (Prime _) = Index 0	-- we only use single primes in generated names+nextSuffix (Index i) = Index $ i + 1++suffixView :: String -> (String, Suffix)+suffixView s+    | (ps@(_:_), s') <- span (=='\'') rs = (reverse s', Prime $ length ps)+    | (ns@(_:_), s') <- span isDigit rs	 = (reverse s', Index $ read $ reverse ns)+    | otherwise				 = (s, NoSuffix)+    where+	rs = reverse s++addSuffix :: String -> Suffix -> String+addSuffix s NoSuffix = s+addSuffix s (Prime n) = s ++ replicate n '\''+addSuffix s (Index i) = s ++ show i+

+ src/full/Agda/Utils/TestHelpers.hs view

@@ -0,0 +1,129 @@+-- | Some functions and generators suitable for writing QuickCheck+-- properties.++module Agda.Utils.TestHelpers+  ( -- * Algebraic properties+    associative+  , commutative+  , isZero+  , identity+  , leftDistributive+  , rightDistributive+    -- * Generators+  , natural+  , positive+  , maybeGen+  , maybeCoGen+  , listOfElements+    -- * Test driver.+  , runTests+  )+  where++import Agda.Utils.QuickCheck+import Data.List+import qualified System.IO.UTF8 as UTF8++------------------------------------------------------------------------+-- Algebraic properties++-- | Is the operator associative?++associative :: (Arbitrary a, Eq a, Show a)+            => (a -> a -> a)+            -> a -> a -> a -> Bool+associative (+) = \x y z ->+  x + (y + z) == (x + y) + z++-- | Is the operator commutative?++commutative :: (Arbitrary a, Eq a, Show a)+            => (a -> a -> a)+            -> a -> a -> Bool+commutative (+) = \x y ->+  x + y == y + x++-- | Is the element a zero for the operator?++isZero :: (Arbitrary a, Eq a, Show a)+     => a -> (a -> a -> a)+     -> a -> Bool+isZero zer (*) = \x ->+  (zer * x == zer)+  &&+  (x * zer == zer)++-- | Is the element a unit for the operator?++identity :: (Arbitrary a, Eq a, Show a)+         => a -> (a -> a -> a)+         -> a -> Bool+identity one (*) = \x ->+  (one * x == x)+  &&+  (x * one == x)++-- | Does the first operator distribute (from the left) over the+-- second one?++leftDistributive+  :: (Arbitrary a, Eq a, Show a)+  => (a -> a -> a) -> (a -> a -> a)+  -> a -> a -> a -> Bool+leftDistributive (*) (+) = \x y z ->+  x * (y + z) == (x * y) + (x * z)++-- | Does the first operator distribute (from the right) over the+-- second one?++rightDistributive+  :: (Arbitrary a, Eq a, Show a)+  => (a -> a -> a) -> (a -> a -> a)+  -> a -> a -> a -> Bool+rightDistributive (*) (+) = \x y z ->+  (x + y) * z == (x * z) + (y * z)++------------------------------------------------------------------------+-- Generators++-- | Generates natural numbers.++natural :: (Integral i) => Gen i+natural = fmap (abs . fromInteger) arbitrary++-- | Generates positive numbers.++positive :: (Integral i) => Gen i+positive = fmap ((+ 1) . abs . fromInteger) arbitrary++-- | Generates a list of elements picked from a given list.+listOfElements :: [a] -> Gen [a]+listOfElements [] = return []+listOfElements xs = listOf $ elements xs++-- | Generates values of 'Maybe' type, using the given generator to+-- generate the contents of the 'Just' constructor.++maybeGen :: Gen a -> Gen (Maybe a)+maybeGen gen = frequency [ (1, return Nothing)+                         , (9, fmap Just gen)+                         ]++-- | 'Coarbitrary' \"generator\" for 'Maybe'.++maybeCoGen :: (a -> Gen b -> Gen b) -> (Maybe a -> Gen b -> Gen b)+maybeCoGen f Nothing  = variant 0+maybeCoGen f (Just x) = variant 1 . f x++------------------------------------------------------------------------+-- Test driver++-- | Runs the tests, and returns 'True' if all tests were successful.++runTests :: String    -- ^ A label for the tests. Used for+                      --   informational purposes.+         -> [IO Bool]+         -> IO Bool+runTests name tests = do+  UTF8.putStrLn name+  fmap and $ sequence tests

+ src/full/Agda/Utils/Trace.hs view

@@ -0,0 +1,48 @@+{-# LANGUAGE DeriveDataTypeable #-}+module Agda.Utils.Trace where++import Control.Monad+import Data.Monoid+import Data.Generics (Typeable, Data)++type Trace = CurrentCall+type SiblingCall = ChildCall++data CurrentCall a+    = Current a (ParentCall a) [SiblingCall a] [ChildCall a]+    | TopLevel [ChildCall a]+  deriving (Typeable, Data)+data ParentCall a+    = Parent  a (ParentCall a) [SiblingCall a]+    | NoParent+  deriving (Typeable, Data)+data ChildCall a = Child a [ChildCall a]+  deriving (Typeable, Data)++newCall :: a -> Trace a -> Trace a+newCall c (TopLevel cs)	       = Current c NoParent cs []+newCall c (Current c' p ss cs) = Current c (Parent c' p ss) cs []++updateCall :: a -> Trace a -> Trace a+updateCall c (TopLevel _)	 = error $ "updateCall: no a in progress"+updateCall c (Current _ p ss cs) = case p of+    NoParent	     -> TopLevel $ Child c cs : ss+    Parent c' p' ss' -> Current c' p' ss' $ Child c cs : ss++matchCall :: (call -> Maybe a) -> Trace call -> Maybe a+matchCall f tr = case matchTrace f' tr of+    []	  -> Nothing+    x : _ -> Just x+    where+	f' (Child c _) = maybe [] (:[]) $ f c++matchCalls :: (call -> Maybe a) -> Trace call -> [a]+matchCalls f = matchTrace f'+  where+    f' (Child c _) = maybe [] (:[]) $ f c++matchTrace :: Monoid m => (ChildCall call -> m) -> Trace call -> m+matchTrace f (TopLevel _) = mempty+matchTrace f t@(Current c _ _ cs) =+    f (Child c cs) `mappend` matchTrace f (updateCall c t)+

+ src/full/Agda/Utils/Trie.hs view

@@ -0,0 +1,130 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Unstable.Org.Lochan.Trie+-- Copyright   :  (c) Keith Wansbrough 2005+-- License     :  BSD-style+-- +-- Maintainer  :  keith.hlib at lochan.org+--             :  modified and extended by Ulf Norell+-- Stability   :  experimental+-- Portability :  portable+--+--  This module provides a very basic implementation of the Trie data type,+--  with no great concern for efficiency, or for completeness of API.+--+-----------------------------------------------------------------------------++module Agda.Utils.Trie+    (+    -- * Data type+    Trie,+    -- * Constructors+    empty, singleton, union, unionWith,+    insert, insertWith,+    -- * Primitive accessors and mutators+    value, children, value_u, children_u,+    lookup, lookupPath,+    -- * Basic operations+    preOrder, upwards, downwards,+    -- * Derived operations+    takeWhile, takeWhile_V, fringe,+    ) where+                ++import Prelude hiding (takeWhile, lookup)+import Data.Map (Map)+import qualified Data.Map as Map+import Data.Maybe+import Control.Monad++-- |A Trie with key elements of type @k@ (keys of type @[k]@) and values of type @v@.+data Trie k v = Trie { value    :: Maybe v+                     , children :: Map k (Trie k v)+                     }+  deriving Show++-- |Modify the 'children' field of a trie.+value_u :: (Maybe v -> Maybe v) -> Trie k v -> Trie k v+value_u f p = p { value = f (value p) }++-- |Modify the 'children' field of a trie.+children_u :: (Map k (Trie k v) -> Map k (Trie k v)) -> Trie k v -> Trie k v+children_u f p = p { children = f (children p) }++-- |The empty trie.+empty :: Trie k v+empty = Trie { value = Nothing, children = Map.empty }++-- |The singleton trie.+singleton :: Ord k => [k] -> v -> Trie k v+singleton [] x     = Trie { value = Just x, children = Map.empty }+singleton (k:ks) x = Trie { value = Nothing, children = Map.singleton k (singleton ks x) }++-- |Combining two tries.  The first shadows the second.+union :: Ord k => Trie k v -> Trie k v -> Trie k v+union p1 p2 =+    Trie {+          value    = mplus (value p1) (value p2),+          children = Map.unionWith union (children p1) (children p2)+         }++-- |Combining two tries.  If the two define the same key, the+-- specified combining function is used.+unionWith :: Ord k => (v -> v -> v) -> Trie k v -> Trie k v -> Trie k v+unionWith f p1 p2 =+    Trie { value    = lift f (value p1) (value p2)+         , children = Map.unionWith (unionWith f) (children p1) (children p2)+         }+    where lift _ Nothing y = y+          lift _ x Nothing = x+          lift _ (Just x) (Just y) = Just (f x y)+    ++-- |Insertion.+insert :: Ord k => [k] -> v -> Trie k v -> Trie k v+insert k v t = union (singleton k v) t++insertWith :: Ord k => (v -> v -> v) -> [k] -> v -> Trie k v -> Trie k v+insertWith f k v t = unionWith f (singleton k v) t++-- |Lookup an element.+lookup :: Ord k => [k] -> Trie k v -> Maybe v+lookup []       t = value t+lookup (k : ks) t = lookup ks =<< Map.lookup k (children t)++-- |Lookup and return all values on the path.+lookupPath :: Ord k => [k] -> Trie k v -> [v]+lookupPath ks t = case ks of+  []     -> list $ value t+  k : ks -> concat $ list (value t) : list (fmap (lookupPath ks) (Map.lookup k $ children t))+  where+    list = maybe [] (:[])++-- |Enumerate all (key,value) pairs, in preorder.+preOrder :: Ord k => [k] -> Trie k v -> [([k],v)]+preOrder ks p = getNode p+                ++ concatMap (\(k,p') -> preOrder (ks++[k]) p')+                             (Map.toList (children p))+    where getNode p = maybe [] (\ v -> [(ks,v)]) (value p)++-- |An upwards accumulation on the trie.+upwards :: Ord k => (Trie k v -> Trie k v) -> Trie k v -> Trie k v+upwards f = f . children_u (Map.map (upwards f))++-- |A downwards accumulation on the trie.+downwards :: Ord k => (Trie k v -> Trie k v) -> Trie k v -> Trie k v+downwards f = children_u (Map.map (downwards f)) . f++-- |Return the prefix of the trie satisfying @f@.+takeWhile :: Ord k => (Trie k v -> Bool) -> Trie k v -> Trie k v+takeWhile f = downwards (children_u (Map.filter f))++-- |Return the prefix of the trie satisfying @f@ on all values present.+takeWhile_V :: Ord k => (v -> Bool) -> Trie k v -> Trie k v+takeWhile_V f = takeWhile (maybe True f . value)++-- |Return the fringe of the trie (the trie composed of only the leaf nodes).+fringe :: Ord k => Trie k v -> Trie k v+fringe = upwards (\ p -> if Map.null (children p) then p else value_u (const Nothing) p)++

+ src/full/Agda/Utils/Tuple.hs view

@@ -0,0 +1,15 @@++module Agda.Utils.Tuple where++infix 2 -*-+infix 3 /\ -- backslashes at EOL interacts badly with CPP...++(-*-) :: (a -> c) -> (b -> d) -> (a,b) -> (c,d)+(f -*- g) (x,y) = (f x, g y)++(/\) :: (a -> b) -> (a -> c) -> a -> (b,c)+(f /\ g) x = (f x, g x)++uncurry3 :: (a -> b -> c -> d) -> (a,b,c) -> d+uncurry3 f (x,y,z) = f x y z+

+ src/full/Agda/Utils/Unicode.hs view

@@ -0,0 +1,25 @@++module Agda.Utils.Unicode+    ( isUnicodeId+    , convertLineEndings+    ) where++import Data.Char++-- Unicode ----------------------------------------------------------------++isUnicodeId :: Char -> Bool+isUnicodeId c = isPrint c && not (isAscii c)++-- | Converts all Unicode line endings into '\n'.++convertLineEndings :: String -> String+convertLineEndings ('\x000D' : '\x000A' : s) = '\n' : convertLineEndings s+convertLineEndings ('\x000A'            : s) = '\n' : convertLineEndings s+convertLineEndings ('\x000D'            : s) = '\n' : convertLineEndings s+convertLineEndings ('\x0085'            : s) = '\n' : convertLineEndings s+convertLineEndings ('\x000C'            : s) = '\n' : convertLineEndings s+convertLineEndings ('\x2028'            : s) = '\n' : convertLineEndings s+convertLineEndings ('\x2029'            : s) = '\n' : convertLineEndings s+convertLineEndings (c                   : s) = c    : convertLineEndings s+convertLineEndings ""                        = ""

+ src/full/Agda/Utils/Warshall.hs view

@@ -0,0 +1,526 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+module Agda.Utils.Warshall where++{- construct a graph from constraints++   x + n <= y   becomes   x ---(-n)---> y+   x <= n + y   becomes   x ---(+n)---> y++the default edge (= no edge is) labelled with infinity++building the graph involves keeping track of the node names.+We do this in a finite map, assigning consecutive numbers to nodes.+-}++import Control.Applicative+import Control.Monad.State+import Data.Maybe -- fromJust+import Data.Array+import Data.List+import Data.Map (Map)+import qualified Data.Map as Map+import Test.QuickCheck+import Agda.Utils.TestHelpers+import Agda.Syntax.Common+import Agda.Utils.QuickCheck+import Agda.Utils.SemiRing++import Debug.Trace++type Matrix a = Array (Int,Int) a++-- assuming a square matrix+warshall :: SemiRing a => Matrix a -> Matrix a+warshall a0 = loop r a0 where +  b@((r,c),(r',c')) = bounds a0 -- assuming r == c and r' == c'+  loop k a | k <= r' = +    loop (k+1) (array b [ ((i,j), +                           (a!(i,j)) `oplus` ((a!(i,k)) `otimes` (a!(k,j))))+                        | i <- [r..r'], j <- [c..c'] ])+           | otherwise = a++-- Warshall's algorithm on a graph represented as an adjacency list.+type AdjList node edge = Map node [(node, edge)]++warshallG :: (SemiRing edge, Ord node) => AdjList node edge -> AdjList node edge+warshallG g = fromMatrix $ warshall m+  where+    nodes = zip (nub $ Map.keys g ++ map fst (concat $ Map.elems g))+                [0..]+    len   = length nodes+    b     = ((0,0), (len - 1,len - 1))++    edge i j = do+      es <- Map.lookup i g+      foldr oplus Nothing [ Just v | (j', v) <- es, j == j' ]++    m = array b [ ((n, m), edge i j) | (i, n) <- nodes, (j, m) <- nodes ] ++    fromMatrix matrix = Map.fromList $ do+      (i, n) <- nodes+      let es = [ (fst (nodes !! m), e)+               | m <- [0..len - 1]+               , Just e <- [matrix ! (n, m)]+               ]+      return (i, es)++-- edge weight in the graph, forming a semi ring ++data Weight = Finite Int | Infinite +              deriving (Eq)++inc :: Weight -> Int -> Weight+inc Infinite   n = Infinite+inc (Finite k) n = Finite (k + n)++instance Show Weight where+  show (Finite i) = show i+  show Infinite   = "."++instance Ord Weight where+  a <= Infinite = True+  Infinite <= b = False+  Finite a <= Finite b = a <= b++instance SemiRing Weight where+  oplus = min++  otimes Infinite _ = Infinite+  otimes _ Infinite = Infinite+  otimes (Finite a) (Finite b) = Finite (a + b)++-- constraints ---------------------------------------------------++-- nodes of the graph are either +-- * flexible variables (with identifiers drawn from Int), +-- * rigid variables (also identified by Ints), or +-- * constants (like 0, infinity, or anything between)++data Node = Rigid Rigid+          | Flex  FlexId+            deriving (Eq, Ord)++data Rigid = RConst Weight+           | RVar RigidId+             deriving (Eq, Ord, Show)++type NodeId  = Int+type RigidId = Int+type FlexId  = Int+type Scope   = RigidId -> Bool  +-- which rigid variables a flex may be instatiated to++instance Show Node where+  show (Flex  i) = "?" ++ show i+  show (Rigid (RVar i)) = "v" ++ show i+  show (Rigid (RConst Infinite))   = "#"+  show (Rigid (RConst (Finite n))) = show n++infinite (RConst Infinite) = True+infinite _ = False++-- isBelow r w r'  +-- checks, if r and r' are connected by w (meaning w not infinite)+-- wether r + w <= r'+-- precondition: not the same rigid variable+isBelow :: Rigid -> Weight -> Rigid -> Bool+isBelow _ Infinite _ = True+isBelow _ n (RConst Infinite) = True+-- isBelow (RConst Infinite)   n (RConst (Finite _)) = False+isBelow (RConst (Finite i)) (Finite n) (RConst (Finite j)) = i + n <= j+isBelow _ _ _ = False -- rigid variables are not related++-- a constraint is an edge in the graph+data Constraint = NewFlex FlexId Scope+                | Arc Node Int Node+-- Arc v1 k v2  at least one of v1,v2 is a VMeta (Flex), +--              the other a VMeta or a VGen (Rigid)+-- if k <= 0 this means  $^(-k) v1 <= v2+-- otherwise                    v1 <= $^k v3++instance Show Constraint where+  show (NewFlex i s) = "SizeMeta(?" ++ show i ++ ")"+  show (Arc v1 k v2) | k == 0 = show v1 ++ "<=" ++ show v2+                     | k < 0  = show v1 ++ "+" ++ show (-k) ++ "<=" ++ show v2+                     | otherwise  = show v1 ++ "<=" ++ show v2 ++ "+" ++ show k++type Constraints = [Constraint]++emptyConstraints = []++-- graph (matrix) ------------------------------------------------++data Graph = Graph +  { flexScope :: Map FlexId Scope        -- scope for each flexible var+  , nodeMap :: Map Node NodeId           -- node labels to node numbers+  , intMap  :: Map NodeId Node           -- node numbers to node labels+  , nextNode :: NodeId                   -- number of nodes (n)+  , graph :: NodeId -> NodeId -> Weight  -- the edges (restrict to [0..n[)+  }++-- the empty graph: no nodes, edges are all undefined (infinity weight)+initGraph = Graph Map.empty Map.empty Map.empty 0 (\ x y -> Infinite)++-- the Graph Monad, for constructing a graph iteratively+type GM = State Graph++addFlex :: FlexId -> Scope -> GM ()+addFlex x scope = do+  st <- get+  put $ st { flexScope = Map.insert x scope (flexScope st) }+  addNode (Flex x)+  return ()+++-- i <- addNode n  returns number of node n. if not present, it is added first+addNode :: Node -> GM Int+addNode n = do+  st <- get+  case Map.lookup n (nodeMap st) of+    Just i -> return i+    Nothing -> do let i = nextNode st+                  put $ st { nodeMap = Map.insert n i (nodeMap st)+                           , intMap = Map.insert i n (intMap st)+                           , nextNode = i + 1+                           }+                  return i++-- addEdge n1 k n2  +-- improves the weight of egde n1->n2 to be at most k+-- also adds nodes if not yet present+addEdge :: Node -> Int -> Node -> GM ()+addEdge n1 k n2 = do+  i1 <- addNode n1+  i2 <- addNode n2+  st <- get+  let graph' x y = if (x,y) == (i1,i2) then Finite k `oplus` (graph st) x y+                   else graph st x y+  put $ st { graph = graph' }++addConstraint :: Constraint -> GM ()+addConstraint (NewFlex x scope) = addFlex x scope+addConstraint (Arc n1 k n2)     = addEdge n1 k n2++buildGraph :: Constraints -> Graph+buildGraph cs = execState (mapM_ addConstraint cs) initGraph++mkMatrix :: Int -> (Int -> Int -> Weight) -> Matrix Weight+mkMatrix n g = array ((0,0),(n-1,n-1)) +                 [ ((i,j), g i j) | i <- [0..n-1], j <- [0..n-1]]++-- displaying matrices with row and column labels --------------------++-- a matrix with row descriptions in b and column descriptions in c+data LegendMatrix a b c = LegendMatrix +  { matrix   :: Matrix a+  , rowdescr :: Int -> b+  , coldescr :: Int -> c+  }++instance (Show a, Show b, Show c) => Show (LegendMatrix a b c) where+  show (LegendMatrix m rd cd) =+    -- first show column description+    let ((r,c),(r',c')) = bounds m+    in foldr (\ j s -> "\t" ++ show (cd j) ++ s) "" [c .. c'] ++ +    -- then output rows+       foldr (\ i s -> "\n" ++ show (rd i) +++                foldr (\ j t -> "\t" ++ show (m!(i,j)) ++ t) +                      (s) +                      [c .. c'])+             "" [r .. r'] ++-- solving the constraints -------------------------------------------++-- a solution assigns to each flexible variable a size expression+-- which is either a constant or a v + n for a rigid variable v+type Solution = Map Int SizeExpr++emptySolution = Map.empty+extendSolution subst k v = Map.insert k v subst++data SizeExpr = SizeVar Int Int   -- e.g. x + 5+              | SizeConst Weight  -- a number or infinity++instance Show SizeExpr where+  show (SizeVar n 0) = show (Rigid (RVar n))+  show (SizeVar n k) = show (Rigid (RVar n)) ++ "+" ++ show k+  show (SizeConst w) = show w++-- sizeRigid r n  returns the size expression corresponding to r + n+sizeRigid :: Rigid -> Int -> SizeExpr+sizeRigid (RConst k) n = SizeConst (inc k n)+sizeRigid (RVar i)   n = SizeVar i n ++{-+apply :: SizeExpr -> Solution -> SizeExpr+apply e@(SizeExpr (Rigid _) _) phi = e+apply e@(SizeExpr (Flex  x) i) phi = case Map.lookup x phi of+  Nothing -> e+  Just (SizeExpr v j) -> SizeExpr v (i + j) + +after :: Solution -> Solution -> Solution+after psi phi = Map.map (\ e -> e `apply` phi) psi+-}++{-+solve :: Constraints -> Maybe Solution+solve cs = if any (\ x -> x < Finite 0) d then Nothing+     else Map.+   where gr = buildGraph cs+         n  = nextNode gr+         m  = mkMatrix n (graph gr)+         m' = warshall m+         d  = [ m!(i,i) | i <- [0 .. (n-1)] ]+         ns = keys (nodeMap gr)+-}++{- compute solution++a solution CANNOT exist if++  v < v  for a rigid variable v++  v <= v' for rigid variables v,v'++  x < v   for a flexible variable x and a rigid variable v++thus, for each flexible x, only one of the following cases is possible++  r+n <= x+m <= infty  for a unique rigid r  (meaning r --(m-n)--> x)+  x <= r+n             for a unique rigid r  (meaning x --(n)--> r)++we are looking for the least values for flexible variables that solve+the constraints.  Algorithm++while flexible variables and rigid rows left+  find a rigid variable row i+    for all flexible columns j+      if i --n--> j with n<=0 (meaning i+n <= j) then j = i + n++while flexible variables j left+  search the row j for entry i+    if j --n--> i with n >= 0 (meaning j <= i + n) then j = i + n++-}++solve :: Constraints -> Maybe Solution+solve cs = -- trace (show cs) $ +   -- trace (show lm0) $ +    -- trace (show lm) $ -- trace (show d) $+     let solution = if solvable then loop1 flexs rigids emptySolution+                    else Nothing+     in -- trace (show solution) $ +         solution+   where -- compute the graph and its transitive closure m+         gr  = buildGraph cs+         n   = nextNode gr            -- number of nodes+         m0  = mkMatrix n (graph gr)+         m   = warshall m0++         -- tracing only: build output version of transitive graph+         legend i = fromJust $ Map.lookup i (intMap gr) -- trace only+         lm0 = LegendMatrix m0 legend legend            -- trace only+         lm  = LegendMatrix m legend legend             -- trace only++         -- compute the sets of flexible and rigid node numbers+         ns  = Map.keys (nodeMap gr)                    +         -- a set of flexible variables+         flexs  = foldl (\ l k -> case k of (Flex i) -> i : l+                                            (Rigid _) -> l) [] ns+         -- a set of rigid variables+         rigids = foldl (\ l k -> case k of (Flex _) -> l+                                            (Rigid i) -> i : l) [] ns++         -- rigid matrix indices+         rInds = foldl (\ l r -> let Just i = Map.lookup (Rigid r) (nodeMap gr)+                                 in i : l) [] rigids++         -- check whether there is a solution+         -- d   = [ m!(i,i) | i <- [0 .. (n-1)] ]  -- diagonal+-- a rigid variable might not be less than it self, so no -.. on the +-- rigid part of the diagonal+         solvable = all (\ x -> x >= Finite 0) [ m!(i,i) | i <- rInds ] &&+-- a rigid variable might not be bounded below by infinity or+-- bounded above by a constant+-- it might not be related to another rigid variable+           all (\ (r,  r') -> r == r' || +                let Just row = (Map.lookup (Rigid r)  (nodeMap gr))+                    Just col = (Map.lookup (Rigid r') (nodeMap gr))+                    edge = m!(row,col)+                in  isBelow r edge r' ) +             [ (r,r') | r <- rigids, r' <- rigids ]+           &&+-- a flexible variable might not be strictly below a rigid variable+           all (\ (x, v) -> +                let Just row = (Map.lookup (Flex x)  (nodeMap gr))+                    Just col = (Map.lookup (Rigid (RVar v)) (nodeMap gr))+                    edge = m!(row,col)+                in  edge >= Finite 0)+             [ (x,v) | x <- flexs, (RVar v) <- rigids ]+++         inScope :: FlexId -> Rigid -> Bool+         inScope x (RConst _) = True+         inScope x (RVar v)   = scope v+             where Just scope = Map.lookup x (flexScope gr)++{- loop1++while flexible variables and rigid rows left+  find a rigid variable row i+    for all flexible columns j+      if i --n--> j with n<=0 (meaning i + n <= j) then j = i + n++-}+         loop1 :: [FlexId] -> [Rigid] -> Solution -> Maybe Solution+         loop1 [] rgds subst = Just subst+         loop1 flxs [] subst = loop2 flxs subst+         loop1 flxs (r:rgds) subst = +            let row = fromJust $ Map.lookup (Rigid r) (nodeMap gr)+                (flxs',subst') =+                  foldl (\ (flx,sub) f -> +                          let col = fromJust $ Map.lookup (Flex f) (nodeMap gr)+                          in  case (inScope f r, m!(row,col)) of+--                                Finite z | z <= 0 -> +                                (True, Finite z) -> +                                   let trunc z | z >= 0 = 0+                                            | otherwise = -z+                                   in (flx, extendSolution sub f (sizeRigid r (trunc z)))+                                _ -> (f : flx, sub)+                     ) ([], subst) flxs       +            in loop1 flxs' rgds subst'++{- loop2++while flexible variables j left+  search the row j for entry i+    if j --n--> i with n >= 0 (meaning j <= i + n) then j = i ++-}+         loop2 :: [FlexId] -> Solution -> Maybe Solution+         loop2 [] subst = Just subst +         loop2 (f:flxs) subst = loop3 0 subst+           where row = fromJust $ Map.lookup (Flex f) (nodeMap gr)+                 loop3 col subst | col >= n = +                   -- default to infinity+                    loop2 flxs (extendSolution subst f (SizeConst Infinite)) +                 loop3 col subst =+                   case Map.lookup col (intMap gr) of+                     Just (Rigid r) | not (infinite r) -> +                       case (inScope f r, m!(row,col)) of+                        (True, Finite z) | z >= 0 -> +                            loop2 flxs (extendSolution subst f (sizeRigid r z)) +                        (_, Infinite) -> loop3 (col+1) subst+                        _ -> -- trace ("unusable rigid: " ++ show r ++ " for flex " ++ show f)+                              Nothing  -- NOT: loop3 (col+1) subst+                     _ -> loop3 (col+1) subst++++-- Testing ----------------------------------------------------------------++genGraph :: Ord node => Float -> Gen edge -> [node] -> Gen (AdjList node edge)+genGraph density edge nodes = do+  Map.fromList . concat <$> mapM neighbours nodes+  where+    k = round (100 * density)+    neighbours n = do+      ns <- concat <$> mapM neighbour nodes+      case ns of+        []  -> elements [[(n, [])], []]+        _   -> return [(n, ns)]+    neighbour n = frequency+      [ (k, do e <- edge+               ns <- neighbour n+               return ((n, e):ns))+      , (100 - k, return [])+      ]++newtype Distance = Dist Nat+  deriving (Eq, Ord, Num, Integral, Show, Enum, Real)++instance SemiRing Distance where+  oplus  (Dist a) (Dist b) = Dist (min a b)+  otimes (Dist a) (Dist b) = Dist (a + b)++genGraph_ :: Nat -> Gen (AdjList Nat Distance)+genGraph_ n =+  genGraph 0.2 (Dist <$> natural) [0..n - 1]++lookupEdge :: Ord n => n -> n -> AdjList n e -> Maybe e+lookupEdge i j g = lookup j =<< Map.lookup i g++edges :: Ord n => AdjList n e -> [(n,n,e)]+edges g = do+  (i, ns) <- Map.toList g+  (j, e)  <- ns+  return (i, j, e)++-- | Check that no edges get longer when completing a graph.+prop_smaller n' =+  forAll (genGraph_ n) $ \g ->+  let g' = warshallG g in+  and [ lookupEdge i j g' =< e+      | (i, j, e) <- edges g+      ]+  where+    n = abs (div n' 2)+    Nothing =< _ = False+    Just x  =< y = x <= y++newEdge i j e = Map.insertWith (++) i [(j, e)]++genPath :: Nat -> Nat -> Nat -> AdjList Nat Distance -> Gen (AdjList Nat Distance)+genPath n i j g = do+  es <- listOf $ (,) <$> node <*> edge+  v  <- edge+  return $ addPath i (es ++ [(j, v)]) g+  where+    edge = Dist <$> natural+    node = choose (0, n - 1)+    addPath _ [] g = g+    addPath i ((j, v):es) g =+      newEdge i j v $ addPath j es g++-- | Check that all transitive edges are added.+prop_path n' =+  forAll (genGraph_ n) $ \g ->+  forAll (replicateM 2 $ choose (0, n - 1)) $ \[i, j] ->+  forAll (genPath n i j g) $ \g' ->+  isJust (lookupEdge i j $ warshallG g')+  where+    n = abs (div n' 2) + 1++mapNodes :: (Ord node, Ord node') => (node -> node') -> AdjList node edge -> AdjList node' edge+mapNodes f = Map.map f' . Map.mapKeys f+  where+    f' es = [ (f n, e) | (n,e) <- es ]++-- | Check that no edges are added between components.+prop_disjoint n' =+  forAll (replicateM 2 $ genGraph_ n) $ \[g1, g2] ->+  let g  = Map.union (mapNodes Left g1) (mapNodes Right g2)+      g' = warshallG g+  in all disjoint (Map.assocs g')+  where+    n = abs (div n' 3)+    disjoint (Left i, es)  = all (isLeft . fst) es+    disjoint (Right i, es) = all (isRight . fst) es+    isLeft = either (const True) (const False)+    isRight = not . isLeft++prop_stable n' =+  forAll (genGraph_ n) $ \g ->+  let g' = warshallG g in+  g' =~= warshallG g'+  where+    n = abs (div n' 2)+    g =~= g' = sort (edges g) == sort (edges g')++tests :: IO Bool+tests = runTests "Agda.Utils.Warshall"+  [ quickCheck' prop_smaller+  , quickCheck' prop_path+  , quickCheck' prop_disjoint+  , quickCheck' prop_stable+  ]

+ src/full/Agda/Version.hs view

@@ -0,0 +1,13 @@++module Agda.Version where++import Data.Version+import Data.List++import qualified Paths_Agda as PA++-- | The version of Agda.++version :: String+version = intercalate "." $ map show $+            versionBranch PA.version

+ src/full/Agda/undefined.h view

@@ -0,0 +1,1 @@+#define __IMPOSSIBLE__ (throwImpossible (Impossible __FILE__ __LINE__))