hoq 0.1.0.0 → 0.2
raw patch · 44 files changed
+2407/−3756 lines, 44 filesdep +bifunctorsdep +bytestringdep +filepathdep −BNFCdep ~basesetup-changed
Dependencies added: bifunctors, bytestring, filepath, void
Dependencies removed: BNFC
Dependency ranges changed: base
Files
- Setup.hs +1/−22
- data/hoq.vim +5/−2
- dist/build/hoq/hoq-tmp/Syntax/BNFC/LexGrammar.hs +0/−388
- dist/build/hoq/hoq-tmp/Syntax/BNFC/ParGrammar.hs +0/−1277
- examples/Paths.hoq +37/−0
- examples/basics.hoq +32/−5
- examples/circle.hoq +72/−95
- examples/hlevel.hoq +9/−29
- examples/lem.hoq +6/−11
- hoq.cabal +17/−15
- src/File/Load.hs +50/−19
- src/Main.hs +3/−1
- src/Normalization.hs +86/−87
- src/REPL.hs +23/−23
- src/Semantics.hs +164/−0
- src/Semantics/Value.hs +147/−0
- src/Syntax.hs +70/−0
- src/Syntax/BNFC/LexGrammar.x +0/−209
- src/Syntax/BNFC/ParGrammar.y +0/−215
- src/Syntax/Expr.hs +0/−43
- src/Syntax/Grammar.cf +0/−81
- src/Syntax/Parser.hs +85/−0
- src/Syntax/Parser/Lexer.x +164/−0
- src/Syntax/Parser/Parser.y +194/−0
- src/Syntax/Pattern.hs +0/−14
- src/Syntax/PrettyPrinter.hs +80/−76
- src/Syntax/Scope.hs +0/−105
- src/Syntax/Term.hs +73/−177
- src/TypeChecking/Context.hs +27/−13
- src/TypeChecking/Definitions.hs +23/−37
- src/TypeChecking/Definitions/Conditions.hs +0/−140
- src/TypeChecking/Definitions/Coverage.hs +0/−89
- src/TypeChecking/Definitions/DataTypes.hs +76/−91
- src/TypeChecking/Definitions/Functions.hs +39/−28
- src/TypeChecking/Definitions/Patterns.hs +0/−79
- src/TypeChecking/Definitions/Termination.hs +29/−48
- src/TypeChecking/Expressions.hs +388/−278
- src/TypeChecking/Expressions/Conditions.hs +138/−0
- src/TypeChecking/Expressions/Coverage.hs +100/−0
- src/TypeChecking/Expressions/Patterns.hs +81/−0
- src/TypeChecking/Expressions/Utils.hs +86/−0
- src/TypeChecking/Monad.hs +22/−28
- src/TypeChecking/Monad/Scope.hs +68/−31
- src/TypeChecking/Monad/Warn.hs +12/−0
Setup.hs view
@@ -1,24 +1,3 @@ import Distribution.Simple-import Control.Monad-import System.Directory-import System.Process-import System.Exit -main :: IO ()-main = do- b <- doesFileExist "src/Syntax/BNFC/AbsGrammar.hs"- unless b bnfc- t1 <- getModificationTime $ "src/" ++ grammar- t2 <- getModificationTime "src/Syntax/BNFC"- if t1 > t2 then bnfc else defaultMain- where- grammar = "Syntax/Grammar.cf"- bnfc = do- dir <- getCurrentDirectory- setCurrentDirectory "src"- status <- system $ "bnfc -p Syntax.BNFC " ++ grammar- setCurrentDirectory dir- case status of- ExitSuccess -> defaultMain- _ -> return ()- exitWith status+main = defaultMain
data/hoq.vim view
@@ -4,12 +4,14 @@ finish endif -syn keyword hoqConstructor left right path coe iso squeeze-syn keyword hoqType data I Path with+syn keyword hoqKeyword import case of infix infixl infixr+syn keyword hoqConstructor left right path coe iso squeeze contr+syn keyword hoqType data I Path with Contr Prop syn match hoqLineComment "---*\([^-!#$%&\*\+./<=>\?@\\^|~].*\)\?$" syn region hoqBlockComment start="{-" end="-}" contains=hoqBlockComment syn match hoqNumber "\<[0-9]\+\>" syn match hoqType "\<Type[0-9]*\>"+syn match hoqType "\<Set[0-9]*\>" " syn match hoqDelimiter "(\|)\|;\|_\|{\|}" syn match hoqOperator "=\|:\|->\|\\\|@" @@ -21,6 +23,7 @@ command -nargs=+ HiLink hi def link <args> endif + HiLink hoqKeyword Keyword HiLink hoqConstructor Keyword HiLink hoqLineComment hoqComment HiLink hoqBlockComment hoqComment
− dist/build/hoq/hoq-tmp/Syntax/BNFC/LexGrammar.hs
@@ -1,388 +0,0 @@-{-# LANGUAGE CPP,MagicHash #-}-{-# LINE 3 "src/Syntax/BNFC/LexGrammar.x" #-}--{-# OPTIONS -fno-warn-incomplete-patterns #-}-{-# OPTIONS_GHC -w #-}-module Syntax.BNFC.LexGrammar where----import qualified Data.Bits-import Data.Word (Word8)--#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\xd9\xff\xff\xff\x49\x00\x00\x00\x1c\x01\x00\x00\x9c\x01\x00\x00\x6f\x02\x00\x00\xef\x02\x00\x00\xef\x03\x00\x00\xb7\xff\xff\xff\x00\x00\x00\x00\xe0\x03\x00\x00\x00\x00\x00\x00\x8b\x00\x00\x00\x1d\x02\x00\x00\xe0\x04\x00\x00\xa0\x04\x00\x00\x00\x00\x00\x00\x96\x05\x00\x00\x69\x06\x00\x00\x00\x00\x00\x00\xfe\xff\xff\xff\xdf\xff\xff\xff\x00\x00\x00\x00\x42\x07\x00\x00\xa5\x07\x00\x00\x08\x08\x00\x00\x6b\x08\x00\x00\xce\x08\x00\x00\x31\x09\x00\x00\x94\x09\x00\x00\xf7\x09\x00\x00\x5a\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbd\x0a\x00\x00\x20\x0b\x00\x00\x83\x0b\x00\x00\xe6\x0b\x00\x00\x49\x0c\x00\x00\xac\x0c\x00\x00\x0f\x0d\x00\x00\x72\x0d\x00\x00\xd5\x0d\x00\x00\x38\x0e\x00\x00\x9b\x0e\x00\x00\xfe\x0e\x00\x00\x61\x0f\x00\x00\xc4\x0f\x00\x00\x27\x10\x00\x00\x8a\x10\x00\x00\xed\x10\x00\x00\x50\x11\x00\x00\xb3\x11\x00\x00\x16\x12\x00\x00\x79\x12\x00\x00\xdc\x12\x00\x00\x3f\x13\x00\x00\xa2\x13\x00\x00\x05\x14\x00\x00\x68\x14\x00\x00\xcb\x14\x00\x00"#--alex_table :: AlexAddr-alex_table = AlexA# "\x00\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x11\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x16\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x21\x00\x16\x00\x00\x00\x00\x00\x00\x00\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\x16\x00\x16\x00\x00\x00\x16\x00\x00\x00\x00\x00\x16\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x18\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x2c\x00\x33\x00\x33\x00\x33\x00\x29\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x20\x00\x00\x00\x00\x00\x22\x00\x00\x00\x33\x00\x33\x00\x27\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x28\x00\x33\x00\x33\x00\x2a\x00\x33\x00\x33\x00\x33\x00\x2d\x00\x33\x00\x2f\x00\x32\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x15\x00\x16\x00\x16\x00\x03\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\x00\x00\x00\x00\x00\x00\x00\x00\x0d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x13\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x07\x00\x08\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\x02\x00\x0f\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\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x12\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x07\x00\x08\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\x0e\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x02\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x07\x00\x08\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\x04\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\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\x0c\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\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\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x0f\x00\x04\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0c\x00\x06\x00\x09\x00\x09\x00\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\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\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x07\x00\x08\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\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x00\x00\x00\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x00\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x00\x00\x00\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x0d\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x00\x00\x00\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x0d\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x00\x00\x00\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x0d\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x00\x00\x00\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x0d\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x00\x00\x00\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x0d\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x00\x00\x00\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x0d\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x00\x00\x00\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x0d\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x00\x00\x00\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x0d\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x00\x00\x00\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x0d\x00\x33\x00\x33\x00\x33\x00\x33\x00\x17\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x00\x00\x00\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x0d\x00\x33\x00\x33\x00\x33\x00\x33\x00\x1d\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x00\x00\x00\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x0d\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x1e\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x00\x00\x00\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x0d\x00\x33\x00\x33\x00\x33\x00\x33\x00\x1f\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x00\x00\x00\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x0d\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x24\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x00\x00\x00\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x0d\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x25\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x00\x00\x00\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x0d\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x39\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x00\x00\x00\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x0d\x00\x33\x00\x33\x00\x33\x00\x33\x00\x38\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x00\x00\x00\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x0d\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x37\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x00\x00\x00\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x0d\x00\x36\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x00\x00\x00\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x0d\x00\x35\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x00\x00\x00\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x0d\x00\x33\x00\x33\x00\x33\x00\x33\x00\x34\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x00\x00\x00\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x0d\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x2b\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x00\x00\x00\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x0d\x00\x33\x00\x33\x00\x33\x00\x33\x00\x2e\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x00\x00\x00\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x0d\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x30\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x00\x00\x00\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x0d\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x31\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x00\x00\x00\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x0d\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x00\x00\x00\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x0d\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x26\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x00\x00\x00\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x0d\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x3a\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x00\x00\x00\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x0d\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x3b\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x00\x00\x00\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x0d\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x3c\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x00\x00\x00\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x0d\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x3d\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x00\x00\x00\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x0d\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x23\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x00\x00\x00\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x0d\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x1c\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x00\x00\x00\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x0d\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x1b\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x00\x00\x00\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x0d\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x1a\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x00\x00\x00\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x0d\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x19\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\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\x2d\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x2d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3e\x00\x20\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\x28\x00\x29\x00\xff\xff\xff\xff\xff\xff\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\x3a\x00\x3b\x00\xff\xff\x3d\x00\xff\xff\xff\xff\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\xff\xff\x5c\x00\xff\xff\xff\xff\x5f\x00\xff\xff\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\x2d\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\xff\xff\xff\xff\xff\xff\xff\xff\xc3\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7d\x00\xff\xff\xff\xff\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\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x2d\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\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\x7d\x00\xff\xff\xff\xff\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\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\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\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x2d\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\xff\xff\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xff\xff\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\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\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\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\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\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x00\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\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\x7f\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x00\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\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\x7f\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\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\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\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\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x00\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\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\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x00\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\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\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xc3\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x00\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\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\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xc3\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x00\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\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\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xc3\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x00\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\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\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xc3\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x00\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\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\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xc3\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x00\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\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\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xc3\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x00\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\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\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xc3\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x00\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\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\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xc3\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x00\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\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\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xc3\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x00\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\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\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xc3\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x00\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\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\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xc3\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x00\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\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\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xc3\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x00\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\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\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xc3\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x00\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\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\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xc3\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x00\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\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\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xc3\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x00\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\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\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xc3\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x00\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\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\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xc3\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x00\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\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\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xc3\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x00\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\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\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xc3\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x00\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\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\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xc3\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x00\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\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\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xc3\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x00\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\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\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xc3\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x00\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\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\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xc3\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x00\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\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\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xc3\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x00\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\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\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xc3\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x00\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\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\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xc3\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x00\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\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\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xc3\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x00\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\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\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xc3\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x00\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\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\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xc3\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x00\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\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\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xc3\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x00\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\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\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xc3\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x00\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\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\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xc3\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x00\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\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\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xc3\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x00\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\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\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xc3\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x00\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\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\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xc3\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc3\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"#--alex_deflt :: AlexAddr-alex_deflt = AlexA# "\xff\xff\xff\xff\x05\x00\x05\x00\xff\xff\x05\x00\xff\xff\x05\x00\x05\x00\x0b\x00\x0b\x00\x10\x00\x10\x00\xff\xff\x11\x00\x11\x00\x11\x00\x11\x00\x05\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"#--alex_accept = listArray (0::Int,61) [AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccSkip,AlexAccSkip,AlexAccSkip,AlexAccSkip,AlexAcc (alex_action_3),AlexAcc (alex_action_3),AlexAcc (alex_action_4),AlexAcc (alex_action_5),AlexAcc (alex_action_6),AlexAcc (alex_action_7),AlexAcc (alex_action_8),AlexAcc (alex_action_9),AlexAcc (alex_action_10),AlexAcc (alex_action_11),AlexAcc (alex_action_12),AlexAcc (alex_action_13),AlexAcc (alex_action_14),AlexAcc (alex_action_15),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_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_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_16),AlexAcc (alex_action_16),AlexAcc (alex_action_16),AlexAcc (alex_action_16),AlexAcc (alex_action_16),AlexAcc (alex_action_16)]-{-# LINE 51 "src/Syntax/BNFC/LexGrammar.x" #-}---tok f p s = f p s--share :: String -> String-share = id--data Tok =- TS !String !Int -- reserved words and symbols- | TL !String -- string literals- | TI !String -- integer literals- | TV !String -- identifiers- | TD !String -- double precision float literals- | TC !String -- character literals- | T_U !String- | T_I !String- | T_PLeft !String- | T_PRight !String- | T_PPath !String- | T_Ppath !String- | T_PCoe !String- | T_PIso !String- | T_PSqueeze !String- | T_PLam !String- | T_PPar !String- | T_Pus !String- | T_PIdent !String-- deriving (Eq,Show,Ord)--data Token = - PT Posn Tok- | Err Posn- deriving (Eq,Show,Ord)--tokenPos (PT (Pn _ l _) _ :_) = "line " ++ show l-tokenPos (Err (Pn _ l _) :_) = "line " ++ show l-tokenPos _ = "end of file"--tokenPosn (PT p _) = p-tokenPosn (Err p) = p-tokenLineCol = posLineCol . tokenPosn-posLineCol (Pn _ l c) = (l,c)-mkPosToken t@(PT p _) = (posLineCol p, prToken t)--prToken t = case t of- PT _ (TS s _) -> s- PT _ (TL s) -> s- PT _ (TI s) -> s- PT _ (TV s) -> s- PT _ (TD s) -> s- PT _ (TC s) -> s- PT _ (T_U s) -> s- PT _ (T_I s) -> s- PT _ (T_PLeft s) -> s- PT _ (T_PRight s) -> s- PT _ (T_PPath s) -> s- PT _ (T_Ppath s) -> s- PT _ (T_PCoe s) -> s- PT _ (T_PIso s) -> s- PT _ (T_PSqueeze s) -> s- PT _ (T_PLam s) -> s- PT _ (T_PPar s) -> s- PT _ (T_Pus s) -> s- PT _ (T_PIdent s) -> s---data BTree = N | B String Tok BTree BTree deriving (Show)--eitherResIdent :: (String -> Tok) -> String -> Tok-eitherResIdent tv s = treeFind resWords- where- treeFind N = tv s- treeFind (B a t left right) | s < a = treeFind left- | s > a = treeFind right- | s == a = t--resWords = b "@" 6 (b ":" 3 (b "->" 2 (b ")" 1 N N) N) (b "=" 5 (b ";" 4 N N) N)) (b "{" 9 (b "with" 8 (b "data" 7 N N) N) (b "}" 11 (b "|" 10 N N) N))- where b s n = let bs = id s- in B bs (TS bs n)--unescapeInitTail :: String -> String-unescapeInitTail = id . unesc . tail . id where- unesc s = case s of- '\\':c:cs | elem c ['\"', '\\', '\''] -> c : unesc cs- '\\':'n':cs -> '\n' : unesc cs- '\\':'t':cs -> '\t' : unesc cs- '"':[] -> []- c:cs -> c : unesc cs- _ -> []------------------------------------------------------------------------ Alex wrapper code.--- A modified "posn" wrapper.----------------------------------------------------------------------data Posn = Pn !Int !Int !Int- deriving (Eq, Show,Ord)--alexStartPos :: Posn-alexStartPos = Pn 0 1 1--alexMove :: Posn -> Char -> Posn-alexMove (Pn a l c) '\t' = Pn (a+1) l (((c+7) `div` 8)*8+1)-alexMove (Pn a l c) '\n' = Pn (a+1) (l+1) 1-alexMove (Pn a l c) _ = Pn (a+1) l (c+1)--type Byte = Word8--type AlexInput = (Posn, -- current position,- Char, -- previous char- [Byte], -- pending bytes on the current char- String) -- current input string--tokens :: String -> [Token]-tokens str = go (alexStartPos, '\n', [], str)- where- go :: AlexInput -> [Token]- go inp@(pos, _, _, str) =- case alexScan inp 0 of- AlexEOF -> []- AlexError (pos, _, _, _) -> [Err pos]- AlexSkip inp' len -> go inp'- AlexToken inp' len act -> act pos (take len str) : (go inp')--alexGetByte :: AlexInput -> Maybe (Byte,AlexInput)-alexGetByte (p, c, (b:bs), s) = Just (b, (p, c, bs, s))-alexGetByte (p, _, [], s) =- case s of- [] -> Nothing- (c:s) ->- let p' = alexMove p c- (b:bs) = utf8Encode c- in p' `seq` Just (b, (p', c, bs, s))--alexInputPrevChar :: AlexInput -> Char-alexInputPrevChar (p, c, bs, s) = c-- -- | Encode a Haskell String to a list of Word8 values, in UTF8 format.-utf8Encode :: Char -> [Word8]-utf8Encode = map fromIntegral . go . ord- where- go oc- | oc <= 0x7f = [oc]-- | oc <= 0x7ff = [ 0xc0 + (oc `Data.Bits.shiftR` 6)- , 0x80 + oc Data.Bits..&. 0x3f- ]-- | oc <= 0xffff = [ 0xe0 + (oc `Data.Bits.shiftR` 12)- , 0x80 + ((oc `Data.Bits.shiftR` 6) Data.Bits..&. 0x3f)- , 0x80 + oc Data.Bits..&. 0x3f- ]- | otherwise = [ 0xf0 + (oc `Data.Bits.shiftR` 18)- , 0x80 + ((oc `Data.Bits.shiftR` 12) Data.Bits..&. 0x3f)- , 0x80 + ((oc `Data.Bits.shiftR` 6) Data.Bits..&. 0x3f)- , 0x80 + oc Data.Bits..&. 0x3f- ]--alex_action_3 = tok (\p s -> PT p (eitherResIdent (TV . share) s)) -alex_action_4 = tok (\p s -> PT p (eitherResIdent (T_U . share) s)) -alex_action_5 = tok (\p s -> PT p (eitherResIdent (T_I . share) s)) -alex_action_6 = tok (\p s -> PT p (eitherResIdent (T_PLeft . share) s)) -alex_action_7 = tok (\p s -> PT p (eitherResIdent (T_PRight . share) s)) -alex_action_8 = tok (\p s -> PT p (eitherResIdent (T_PPath . share) s)) -alex_action_9 = tok (\p s -> PT p (eitherResIdent (T_Ppath . share) s)) -alex_action_10 = tok (\p s -> PT p (eitherResIdent (T_PCoe . share) s)) -alex_action_11 = tok (\p s -> PT p (eitherResIdent (T_PIso . share) s)) -alex_action_12 = tok (\p s -> PT p (eitherResIdent (T_PSqueeze . share) s)) -alex_action_13 = tok (\p s -> PT p (eitherResIdent (T_PLam . share) s)) -alex_action_14 = tok (\p s -> PT p (eitherResIdent (T_PPar . share) s)) -alex_action_15 = tok (\p s -> PT p (eitherResIdent (T_Pus . share) s)) -alex_action_16 = tok (\p s -> PT p (eitherResIdent (T_PIdent . share) s)) -alex_action_17 = tok (\p s -> PT p (eitherResIdent (TV . share) s)) -{-# LINE 1 "templates/GenericTemplate.hs" #-}-{-# LINE 1 "templates/GenericTemplate.hs" #-}-{-# 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 alexGetByte 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 alexGetByte input of- Nothing -> (new_acc, input)- Just (c, new_input) -> ---- case fromIntegral c of { (I# (ord_c)) ->- let- base = alexIndexInt32OffAddr alex_base s- 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 (if c < 0x80 || c >= 0xC0 then (len +# 1#) else len)- -- note that the length is increased ONLY if this is the 1st byte in a char encoding)- new_input new_s new_acc- }- where- check_accs (AlexAccNone) = last_acc- check_accs (AlexAcc a ) = AlexLastAcc a input (I# (len))- check_accs (AlexAccSkip) = AlexLastSkip input (I# (len))-{-# LINE 191 "templates/GenericTemplate.hs" #-}--data AlexLastAcc a- = AlexNone- | AlexLastAcc a !AlexInput !Int- | AlexLastSkip !AlexInput !Int--instance Functor AlexLastAcc where- fmap f AlexNone = AlexNone- fmap f (AlexLastAcc x y z) = AlexLastAcc (f x) y z- fmap f (AlexLastSkip x y) = AlexLastSkip x y--data AlexAcc a user- = AlexAccNone- | AlexAcc a- | AlexAccSkip-{-# LINE 235 "templates/GenericTemplate.hs" #-}---- used by wrappers-iUnbox (I# (i)) = i
− dist/build/hoq/hoq-tmp/Syntax/BNFC/ParGrammar.hs
@@ -1,1277 +0,0 @@-{-# OPTIONS_GHC -w #-}-{-# OPTIONS -fglasgow-exts -cpp #-}-{-# OPTIONS_GHC -fno-warn-incomplete-patterns -fno-warn-overlapping-patterns #-}-module Syntax.BNFC.ParGrammar where-import Syntax.BNFC.AbsGrammar-import Syntax.BNFC.LexGrammar-import Syntax.BNFC.ErrM-import qualified Data.Array as Happy_Data_Array-import qualified GHC.Exts as Happy_GHC_Exts---- parser produced by Happy Version 1.18.10--newtype HappyAbsSyn = HappyAbsSyn HappyAny-#if __GLASGOW_HASKELL__ >= 607-type HappyAny = Happy_GHC_Exts.Any-#else-type HappyAny = forall a . a-#endif-happyIn5 :: (U) -> (HappyAbsSyn )-happyIn5 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn5 #-}-happyOut5 :: (HappyAbsSyn ) -> (U)-happyOut5 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut5 #-}-happyIn6 :: (I) -> (HappyAbsSyn )-happyIn6 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn6 #-}-happyOut6 :: (HappyAbsSyn ) -> (I)-happyOut6 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut6 #-}-happyIn7 :: (PLeft) -> (HappyAbsSyn )-happyIn7 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn7 #-}-happyOut7 :: (HappyAbsSyn ) -> (PLeft)-happyOut7 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut7 #-}-happyIn8 :: (PRight) -> (HappyAbsSyn )-happyIn8 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn8 #-}-happyOut8 :: (HappyAbsSyn ) -> (PRight)-happyOut8 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut8 #-}-happyIn9 :: (PPath) -> (HappyAbsSyn )-happyIn9 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn9 #-}-happyOut9 :: (HappyAbsSyn ) -> (PPath)-happyOut9 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut9 #-}-happyIn10 :: (Ppath) -> (HappyAbsSyn )-happyIn10 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn10 #-}-happyOut10 :: (HappyAbsSyn ) -> (Ppath)-happyOut10 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut10 #-}-happyIn11 :: (PCoe) -> (HappyAbsSyn )-happyIn11 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn11 #-}-happyOut11 :: (HappyAbsSyn ) -> (PCoe)-happyOut11 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut11 #-}-happyIn12 :: (PIso) -> (HappyAbsSyn )-happyIn12 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn12 #-}-happyOut12 :: (HappyAbsSyn ) -> (PIso)-happyOut12 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut12 #-}-happyIn13 :: (PSqueeze) -> (HappyAbsSyn )-happyIn13 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn13 #-}-happyOut13 :: (HappyAbsSyn ) -> (PSqueeze)-happyOut13 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut13 #-}-happyIn14 :: (PLam) -> (HappyAbsSyn )-happyIn14 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn14 #-}-happyOut14 :: (HappyAbsSyn ) -> (PLam)-happyOut14 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut14 #-}-happyIn15 :: (PPar) -> (HappyAbsSyn )-happyIn15 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn15 #-}-happyOut15 :: (HappyAbsSyn ) -> (PPar)-happyOut15 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut15 #-}-happyIn16 :: (Pus) -> (HappyAbsSyn )-happyIn16 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn16 #-}-happyOut16 :: (HappyAbsSyn ) -> (Pus)-happyOut16 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut16 #-}-happyIn17 :: (PIdent) -> (HappyAbsSyn )-happyIn17 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn17 #-}-happyOut17 :: (HappyAbsSyn ) -> (PIdent)-happyOut17 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut17 #-}-happyIn18 :: (Defs) -> (HappyAbsSyn )-happyIn18 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn18 #-}-happyOut18 :: (HappyAbsSyn ) -> (Defs)-happyOut18 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut18 #-}-happyIn19 :: (Def) -> (HappyAbsSyn )-happyIn19 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn19 #-}-happyOut19 :: (HappyAbsSyn ) -> (Def)-happyOut19 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut19 #-}-happyIn20 :: ([Def]) -> (HappyAbsSyn )-happyIn20 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn20 #-}-happyOut20 :: (HappyAbsSyn ) -> ([Def])-happyOut20 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut20 #-}-happyIn21 :: (FunCase) -> (HappyAbsSyn )-happyIn21 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn21 #-}-happyOut21 :: (HappyAbsSyn ) -> (FunCase)-happyOut21 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut21 #-}-happyIn22 :: ([FunCase]) -> (HappyAbsSyn )-happyIn22 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn22 #-}-happyOut22 :: (HappyAbsSyn ) -> ([FunCase])-happyOut22 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut22 #-}-happyIn23 :: (Pattern) -> (HappyAbsSyn )-happyIn23 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn23 #-}-happyOut23 :: (HappyAbsSyn ) -> (Pattern)-happyOut23 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut23 #-}-happyIn24 :: (ParPat) -> (HappyAbsSyn )-happyIn24 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn24 #-}-happyOut24 :: (HappyAbsSyn ) -> (ParPat)-happyOut24 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut24 #-}-happyIn25 :: ([ParPat]) -> (HappyAbsSyn )-happyIn25 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn25 #-}-happyOut25 :: (HappyAbsSyn ) -> ([ParPat])-happyOut25 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut25 #-}-happyIn26 :: (Con) -> (HappyAbsSyn )-happyIn26 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn26 #-}-happyOut26 :: (HappyAbsSyn ) -> (Con)-happyOut26 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut26 #-}-happyIn27 :: ([Con]) -> (HappyAbsSyn )-happyIn27 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn27 #-}-happyOut27 :: (HappyAbsSyn ) -> ([Con])-happyOut27 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut27 #-}-happyIn28 :: (ConTele) -> (HappyAbsSyn )-happyIn28 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn28 #-}-happyOut28 :: (HappyAbsSyn ) -> (ConTele)-happyOut28 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut28 #-}-happyIn29 :: ([ConTele]) -> (HappyAbsSyn )-happyIn29 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn29 #-}-happyOut29 :: (HappyAbsSyn ) -> ([ConTele])-happyOut29 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut29 #-}-happyIn30 :: (DataTele) -> (HappyAbsSyn )-happyIn30 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn30 #-}-happyOut30 :: (HappyAbsSyn ) -> (DataTele)-happyOut30 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut30 #-}-happyIn31 :: ([DataTele]) -> (HappyAbsSyn )-happyIn31 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn31 #-}-happyOut31 :: (HappyAbsSyn ) -> ([DataTele])-happyOut31 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut31 #-}-happyIn32 :: (PiTele) -> (HappyAbsSyn )-happyIn32 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn32 #-}-happyOut32 :: (HappyAbsSyn ) -> (PiTele)-happyOut32 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut32 #-}-happyIn33 :: ([PiTele]) -> (HappyAbsSyn )-happyIn33 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn33 #-}-happyOut33 :: (HappyAbsSyn ) -> ([PiTele])-happyOut33 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut33 #-}-happyIn34 :: (Expr) -> (HappyAbsSyn )-happyIn34 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn34 #-}-happyOut34 :: (HappyAbsSyn ) -> (Expr)-happyOut34 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut34 #-}-happyIn35 :: (Expr) -> (HappyAbsSyn )-happyIn35 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn35 #-}-happyOut35 :: (HappyAbsSyn ) -> (Expr)-happyOut35 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut35 #-}-happyIn36 :: (Expr) -> (HappyAbsSyn )-happyIn36 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn36 #-}-happyOut36 :: (HappyAbsSyn ) -> (Expr)-happyOut36 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut36 #-}-happyIn37 :: (Expr) -> (HappyAbsSyn )-happyIn37 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn37 #-}-happyOut37 :: (HappyAbsSyn ) -> (Expr)-happyOut37 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut37 #-}-happyIn38 :: (Expr) -> (HappyAbsSyn )-happyIn38 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn38 #-}-happyOut38 :: (HappyAbsSyn ) -> (Expr)-happyOut38 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut38 #-}-happyIn39 :: (Expr) -> (HappyAbsSyn )-happyIn39 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn39 #-}-happyOut39 :: (HappyAbsSyn ) -> (Expr)-happyOut39 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut39 #-}-happyIn40 :: (Arg) -> (HappyAbsSyn )-happyIn40 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn40 #-}-happyOut40 :: (HappyAbsSyn ) -> (Arg)-happyOut40 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut40 #-}-happyIn41 :: ([Arg]) -> (HappyAbsSyn )-happyIn41 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn41 #-}-happyOut41 :: (HappyAbsSyn ) -> ([Arg])-happyOut41 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut41 #-}-happyInTok :: (Token) -> (HappyAbsSyn )-happyInTok x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyInTok #-}-happyOutTok :: (HappyAbsSyn ) -> (Token)-happyOutTok x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOutTok #-}---happyActOffsets :: HappyAddr-happyActOffsets = HappyA# "\x36\x01\xbb\x01\xab\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x72\x00\xbb\x01\x00\x00\x00\x00\x9f\x01\xb2\x01\x85\x01\x00\x00\xaf\x01\x82\x00\xc8\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\xad\x01\x78\x01\x82\x01\x00\x00\x00\x00\x7d\x01\x6c\x01\x00\x00\xbb\x01\x36\x01\x67\x01\xbb\x01\xbb\x01\x00\x00\xc8\x01\xc8\x01\xc8\x01\xc8\x01\xbb\x01\x00\x00\x25\x00\x40\x00\x4b\x01\xbb\x01\x00\x00\x00\x00\xbb\x01\x49\x01\x00\x00\x00\x00\xc8\x01\x3e\x01\x1c\x01\x00\x00\x00\x00\x00\x00\x6d\x01\x00\x00\x00\x00\x00\x00\x00\x00\x2b\x01\xbb\x01\x00\x00\x04\x01\x00\x00\x1a\x01\x00\x00\x19\x01\x00\x00\x00\x00\x00\x00\x00\x00\x06\x01\xe4\x00\xe8\x00\xbb\x01\xe1\x00\xd1\x00\xc8\x01\xbb\x01\x00\x00\x00\x00\x00\x00\xd1\x00\xde\x00\x00\x00\xb7\x00\xaf\x00\xb4\x00\x24\x00\xbb\x01\x00\x00\xa0\x00\x00\x00\xad\x00\x00\x00\x00\x00"#--happyGotoOffsets :: HappyAddr-happyGotoOffsets = HappyA# "\xd5\x01\x03\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x9c\x01\xf6\x00\x00\x00\x00\x00\x57\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x96\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\x69\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x00\x3c\x00\xd2\x00\xda\x01\xa3\x01\xc5\x00\xa1\x00\x00\x00\x58\x01\x89\x01\x34\x01\x27\x01\x94\x00\x00\x00\x00\x00\x98\x01\x00\x00\x70\x00\x00\x00\x00\x00\x63\x00\x00\x00\x00\x00\x00\x00\x96\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3f\x01\x00\x00\x00\x00\x00\x00\x00\x00\x6a\x01\x3f\x00\x00\x00\x9d\x01\x38\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x00\x00\x00\x00\x32\x00\x00\x00\x6b\x01\x65\x01\x0e\x00\x00\x00\x00\x00\x00\x00\xdf\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\xb1\x01\x00\x00\x00\x00\x00\x00\x00\x00"#--happyDefActions :: HappyAddr-happyDefActions = HappyA# "\xe9\xff\x00\x00\x00\x00\xfd\xff\xc1\xff\xc0\xff\xbf\xff\xbe\xff\xbd\xff\xbc\xff\xbb\xff\xba\xff\xb9\xff\x00\x00\x00\x00\xb6\xff\xb7\xff\xcf\xff\x00\x00\x00\x00\xcc\xff\xc9\xff\xc7\xff\xc5\xff\xc3\xff\xc2\xff\xfc\xff\xfb\xff\xfa\xff\xf9\xff\xf8\xff\xf7\xff\xf6\xff\xf5\xff\xf4\xff\xf3\xff\xf2\xff\xf1\xff\xdc\xff\x00\x00\xe8\xff\xf0\xff\xee\xff\xed\xff\x00\x00\xd2\xff\x00\x00\xe9\xff\xe2\xff\x00\x00\x00\x00\xc4\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xce\xff\x00\x00\xb5\xff\x00\x00\x00\x00\xb4\xff\xb8\xff\x00\x00\x00\x00\xca\xff\xcb\xff\xc6\xff\xc8\xff\x00\x00\xef\xff\xe0\xff\xdf\xff\x00\x00\xdb\xff\xe1\xff\xe7\xff\xe6\xff\xea\xff\x00\x00\xd1\xff\x00\x00\xdc\xff\x00\x00\xde\xff\x00\x00\xcd\xff\xd0\xff\xdd\xff\xd5\xff\xd9\xff\xec\xff\x00\x00\x00\x00\x00\x00\x00\x00\xda\xff\x00\x00\xd4\xff\xd6\xff\xd8\xff\xe5\xff\x00\x00\xd3\xff\xe4\xff\x00\x00\x00\x00\x00\x00\x00\x00\xeb\xff\xe5\xff\xe3\xff\x00\x00\xd7\xff"#--happyCheck :: HappyAddr-happyCheck = HappyA# "\xff\xff\x00\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\x00\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\x18\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x01\x00\x01\x00\x03\x00\x03\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x00\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\x00\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\x14\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x1a\x00\x17\x00\x18\x00\x0c\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x00\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\x00\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\x14\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x05\x00\x06\x00\x17\x00\x18\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x00\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\x00\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\x01\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x18\x00\x05\x00\x0b\x00\x04\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x00\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\x00\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\x01\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x18\x00\x09\x00\x03\x00\x08\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x00\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\x00\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\x0a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x01\x00\x01\x00\x18\x00\x01\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x05\x00\x0a\x00\x0b\x00\x0c\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x07\x00\x0a\x00\x0b\x00\x0c\x00\x16\x00\x1b\x00\x1c\x00\x06\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x0c\x00\x03\x00\x02\x00\x18\x00\x1b\x00\x1c\x00\x12\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x0a\x00\x0a\x00\x0b\x00\x0c\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x01\x00\x0a\x00\x0b\x00\x0c\x00\x1b\x00\x1c\x00\x0a\x00\x0e\x00\x0f\x00\x0c\x00\x20\x00\x21\x00\x22\x00\x23\x00\x17\x00\x16\x00\x17\x00\x18\x00\x15\x00\x16\x00\x05\x00\x19\x00\x18\x00\x18\x00\x04\x00\x22\x00\x23\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x1a\x00\x0a\x00\x0b\x00\x0c\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x1a\x00\x0a\x00\x0b\x00\x0c\x00\x0b\x00\x0c\x00\x02\x00\x03\x00\x0b\x00\x0c\x00\x0c\x00\x21\x00\x22\x00\x23\x00\x0a\x00\x0b\x00\x0c\x00\x03\x00\x02\x00\x15\x00\x16\x00\x02\x00\x16\x00\x13\x00\x0c\x00\x22\x00\x23\x00\xff\xff\x23\x00\x24\x00\x0c\x00\xff\xff\x23\x00\x24\x00\x10\x00\x11\x00\x12\x00\xff\xff\xff\xff\x23\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\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\xff\xff\x16\x00\x17\x00\x18\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x0c\x00\x12\x00\x0e\x00\x0f\x00\x10\x00\x0c\x00\x12\x00\xff\xff\xff\xff\x10\x00\x11\x00\x12\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"#--happyTable :: HappyAddr-happyTable = HappyA# "\x00\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\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\x61\x00\x11\x00\x12\x00\x71\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x40\x00\x40\x00\x6e\x00\x41\x00\x11\x00\x12\x00\x6c\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\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\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\x30\x00\x11\x00\x12\x00\x67\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x4f\x00\x25\x00\x26\x00\x2d\x00\x11\x00\x12\x00\x5d\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\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\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\x30\x00\x11\x00\x12\x00\x56\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x35\x00\x36\x00\x25\x00\x26\x00\x11\x00\x12\x00\x57\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\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\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\x73\x00\x11\x00\x12\x00\x41\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x26\x00\x2f\x00\x6f\x00\x70\x00\x11\x00\x12\x00\x46\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\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\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\x69\x00\x11\x00\x12\x00\x47\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x26\x00\x67\x00\x5f\x00\x60\x00\x11\x00\x12\x00\x4e\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\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\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\x61\x00\x11\x00\x12\x00\x3a\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x59\x00\x5a\x00\x26\x00\x40\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x53\x00\x0e\x00\x0f\x00\x10\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x2d\x00\x0e\x00\x0f\x00\x10\x00\x24\x00\x11\x00\x12\x00\x36\x00\x42\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x53\x00\x41\x00\x3e\x00\x26\x00\x11\x00\x12\x00\x54\x00\x43\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x38\x00\x32\x00\x0f\x00\x10\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x56\x00\x62\x00\x0f\x00\x10\x00\x11\x00\x39\x00\x50\x00\x1c\x00\x1d\x00\x5a\x00\x45\x00\x17\x00\x18\x00\x19\x00\x63\x00\x24\x00\x25\x00\x26\x00\x5b\x00\x65\x00\x2f\x00\x51\x00\x26\x00\x26\x00\x30\x00\x64\x00\x19\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\xff\xff\x32\x00\x0f\x00\x10\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\xff\xff\x32\x00\x0f\x00\x10\x00\x0f\x00\x10\x00\x48\x00\x49\x00\x0f\x00\x10\x00\x5a\x00\x44\x00\x18\x00\x19\x00\x4a\x00\x0f\x00\x10\x00\x32\x00\x37\x00\x5b\x00\x5c\x00\x38\x00\x24\x00\x4b\x00\x04\x00\x33\x00\x19\x00\x00\x00\x3b\x00\x3e\x00\x53\x00\x00\x00\x3b\x00\x3c\x00\x69\x00\x70\x00\x6b\x00\x00\x00\x00\x00\x4c\x00\x04\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\x04\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x24\x00\x25\x00\x26\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x26\x00\x2b\x00\x28\x00\x4d\x00\x2a\x00\x53\x00\x2b\x00\x00\x00\x00\x00\x69\x00\x6a\x00\x6b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\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 = Happy_Data_Array.array (2, 75) [- (2 , happyReduce_2),- (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)- ]--happy_n_terms = 27 :: Int-happy_n_nonterms = 37 :: Int--happyReduce_2 = happySpecReduce_1 0# happyReduction_2-happyReduction_2 happy_x_1- = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn5- (U (mkPosToken happy_var_1)- )}--happyReduce_3 = happySpecReduce_1 1# happyReduction_3-happyReduction_3 happy_x_1- = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn6- (I (mkPosToken happy_var_1)- )}--happyReduce_4 = happySpecReduce_1 2# happyReduction_4-happyReduction_4 happy_x_1- = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn7- (PLeft (mkPosToken happy_var_1)- )}--happyReduce_5 = happySpecReduce_1 3# happyReduction_5-happyReduction_5 happy_x_1- = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn8- (PRight (mkPosToken happy_var_1)- )}--happyReduce_6 = happySpecReduce_1 4# happyReduction_6-happyReduction_6 happy_x_1- = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn9- (PPath (mkPosToken happy_var_1)- )}--happyReduce_7 = happySpecReduce_1 5# happyReduction_7-happyReduction_7 happy_x_1- = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn10- (Ppath (mkPosToken happy_var_1)- )}--happyReduce_8 = happySpecReduce_1 6# happyReduction_8-happyReduction_8 happy_x_1- = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn11- (PCoe (mkPosToken happy_var_1)- )}--happyReduce_9 = happySpecReduce_1 7# happyReduction_9-happyReduction_9 happy_x_1- = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn12- (PIso (mkPosToken happy_var_1)- )}--happyReduce_10 = happySpecReduce_1 8# happyReduction_10-happyReduction_10 happy_x_1- = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn13- (PSqueeze (mkPosToken happy_var_1)- )}--happyReduce_11 = happySpecReduce_1 9# happyReduction_11-happyReduction_11 happy_x_1- = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn14- (PLam (mkPosToken happy_var_1)- )}--happyReduce_12 = happySpecReduce_1 10# happyReduction_12-happyReduction_12 happy_x_1- = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn15- (PPar (mkPosToken happy_var_1)- )}--happyReduce_13 = happySpecReduce_1 11# happyReduction_13-happyReduction_13 happy_x_1- = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn16- (Pus (mkPosToken happy_var_1)- )}--happyReduce_14 = happySpecReduce_1 12# happyReduction_14-happyReduction_14 happy_x_1- = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn17- (PIdent (mkPosToken happy_var_1)- )}--happyReduce_15 = happySpecReduce_1 13# happyReduction_15-happyReduction_15 happy_x_1- = case happyOut20 happy_x_1 of { happy_var_1 -> - happyIn18- (Defs happy_var_1- )}--happyReduce_16 = happySpecReduce_3 14# happyReduction_16-happyReduction_16 happy_x_3- happy_x_2- happy_x_1- = case happyOut17 happy_x_1 of { happy_var_1 -> - case happyOut34 happy_x_3 of { happy_var_3 -> - happyIn19- (DefType happy_var_1 happy_var_3- )}}--happyReduce_17 = happySpecReduce_1 14# happyReduction_17-happyReduction_17 happy_x_1- = case happyOut21 happy_x_1 of { happy_var_1 -> - happyIn19- (DefFun happy_var_1- )}--happyReduce_18 = happySpecReduce_1 14# happyReduction_18-happyReduction_18 happy_x_1- = case happyOut23 happy_x_1 of { happy_var_1 -> - happyIn19- (DefFunEmpty happy_var_1- )}--happyReduce_19 = happyReduce 5# 14# happyReduction_19-happyReduction_19 (happy_x_5 `HappyStk`- happy_x_4 `HappyStk`- happy_x_3 `HappyStk`- happy_x_2 `HappyStk`- happy_x_1 `HappyStk`- happyRest)- = case happyOut17 happy_x_2 of { happy_var_2 -> - case happyOut31 happy_x_3 of { happy_var_3 -> - case happyOut27 happy_x_5 of { happy_var_5 -> - happyIn19- (DefData happy_var_2 (reverse happy_var_3) happy_var_5- ) `HappyStk` happyRest}}}--happyReduce_20 = happyReduce 9# 14# happyReduction_20-happyReduction_20 (happy_x_9 `HappyStk`- happy_x_8 `HappyStk`- 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 happyOut17 happy_x_2 of { happy_var_2 -> - case happyOut31 happy_x_3 of { happy_var_3 -> - case happyOut27 happy_x_5 of { happy_var_5 -> - case happyOut22 happy_x_8 of { happy_var_8 -> - happyIn19- (DefDataWith happy_var_2 (reverse happy_var_3) happy_var_5 happy_var_8- ) `HappyStk` happyRest}}}}--happyReduce_21 = happySpecReduce_3 14# happyReduction_21-happyReduction_21 happy_x_3- happy_x_2- happy_x_1- = case happyOut17 happy_x_2 of { happy_var_2 -> - case happyOut31 happy_x_3 of { happy_var_3 -> - happyIn19- (DefDataEmpty happy_var_2 (reverse happy_var_3)- )}}--happyReduce_22 = happySpecReduce_0 15# happyReduction_22-happyReduction_22 = happyIn20- ([]- )--happyReduce_23 = happySpecReduce_1 15# happyReduction_23-happyReduction_23 happy_x_1- = case happyOut19 happy_x_1 of { happy_var_1 -> - happyIn20- ((:[]) happy_var_1- )}--happyReduce_24 = happySpecReduce_3 15# happyReduction_24-happyReduction_24 happy_x_3- happy_x_2- happy_x_1- = case happyOut19 happy_x_1 of { happy_var_1 -> - case happyOut20 happy_x_3 of { happy_var_3 -> - happyIn20- ((:) happy_var_1 happy_var_3- )}}--happyReduce_25 = happySpecReduce_3 16# happyReduction_25-happyReduction_25 happy_x_3- happy_x_2- happy_x_1- = case happyOut23 happy_x_1 of { happy_var_1 -> - case happyOut34 happy_x_3 of { happy_var_3 -> - happyIn21- (FunCase happy_var_1 happy_var_3- )}}--happyReduce_26 = happySpecReduce_0 17# happyReduction_26-happyReduction_26 = happyIn22- ([]- )--happyReduce_27 = happySpecReduce_1 17# happyReduction_27-happyReduction_27 happy_x_1- = case happyOut21 happy_x_1 of { happy_var_1 -> - happyIn22- ((:[]) happy_var_1- )}--happyReduce_28 = happySpecReduce_3 17# happyReduction_28-happyReduction_28 happy_x_3- happy_x_2- happy_x_1- = case happyOut21 happy_x_1 of { happy_var_1 -> - case happyOut22 happy_x_3 of { happy_var_3 -> - happyIn22- ((:) happy_var_1 happy_var_3- )}}--happyReduce_29 = happySpecReduce_2 18# happyReduction_29-happyReduction_29 happy_x_2- happy_x_1- = case happyOut17 happy_x_1 of { happy_var_1 -> - case happyOut25 happy_x_2 of { happy_var_2 -> - happyIn23- (Pattern happy_var_1 (reverse happy_var_2)- )}}--happyReduce_30 = happySpecReduce_1 19# happyReduction_30-happyReduction_30 happy_x_1- = case happyOut40 happy_x_1 of { happy_var_1 -> - happyIn24- (ParVar happy_var_1- )}--happyReduce_31 = happySpecReduce_1 19# happyReduction_31-happyReduction_31 happy_x_1- = case happyOut7 happy_x_1 of { happy_var_1 -> - happyIn24- (ParLeft happy_var_1- )}--happyReduce_32 = happySpecReduce_1 19# happyReduction_32-happyReduction_32 happy_x_1- = case happyOut8 happy_x_1 of { happy_var_1 -> - happyIn24- (ParRight happy_var_1- )}--happyReduce_33 = happySpecReduce_2 19# happyReduction_33-happyReduction_33 happy_x_2- happy_x_1- = case happyOut15 happy_x_1 of { happy_var_1 -> - happyIn24- (ParEmpty happy_var_1- )}--happyReduce_34 = happySpecReduce_3 19# happyReduction_34-happyReduction_34 happy_x_3- happy_x_2- happy_x_1- = case happyOut15 happy_x_1 of { happy_var_1 -> - case happyOut23 happy_x_2 of { happy_var_2 -> - happyIn24- (ParPat happy_var_1 happy_var_2- )}}--happyReduce_35 = happySpecReduce_0 20# happyReduction_35-happyReduction_35 = happyIn25- ([]- )--happyReduce_36 = happySpecReduce_2 20# happyReduction_36-happyReduction_36 happy_x_2- happy_x_1- = case happyOut25 happy_x_1 of { happy_var_1 -> - case happyOut24 happy_x_2 of { happy_var_2 -> - happyIn25- (flip (:) happy_var_1 happy_var_2- )}}--happyReduce_37 = happySpecReduce_2 21# happyReduction_37-happyReduction_37 happy_x_2- happy_x_1- = case happyOut17 happy_x_1 of { happy_var_1 -> - case happyOut29 happy_x_2 of { happy_var_2 -> - happyIn26- (Con happy_var_1 (reverse happy_var_2)- )}}--happyReduce_38 = happySpecReduce_1 22# happyReduction_38-happyReduction_38 happy_x_1- = case happyOut26 happy_x_1 of { happy_var_1 -> - happyIn27- ((:[]) happy_var_1- )}--happyReduce_39 = happySpecReduce_3 22# happyReduction_39-happyReduction_39 happy_x_3- happy_x_2- happy_x_1- = case happyOut26 happy_x_1 of { happy_var_1 -> - case happyOut27 happy_x_3 of { happy_var_3 -> - happyIn27- ((:) happy_var_1 happy_var_3- )}}--happyReduce_40 = happyReduce 5# 23# happyReduction_40-happyReduction_40 (happy_x_5 `HappyStk`- happy_x_4 `HappyStk`- happy_x_3 `HappyStk`- happy_x_2 `HappyStk`- happy_x_1 `HappyStk`- happyRest)- = case happyOut15 happy_x_1 of { happy_var_1 -> - case happyOut34 happy_x_2 of { happy_var_2 -> - case happyOut34 happy_x_4 of { happy_var_4 -> - happyIn28- (VarTele happy_var_1 happy_var_2 happy_var_4- ) `HappyStk` happyRest}}}--happyReduce_41 = happySpecReduce_1 23# happyReduction_41-happyReduction_41 happy_x_1- = case happyOut39 happy_x_1 of { happy_var_1 -> - happyIn28- (TypeTele happy_var_1- )}--happyReduce_42 = happySpecReduce_0 24# happyReduction_42-happyReduction_42 = happyIn29- ([]- )--happyReduce_43 = happySpecReduce_2 24# happyReduction_43-happyReduction_43 happy_x_2- happy_x_1- = case happyOut29 happy_x_1 of { happy_var_1 -> - case happyOut28 happy_x_2 of { happy_var_2 -> - happyIn29- (flip (:) happy_var_1 happy_var_2- )}}--happyReduce_44 = happyReduce 5# 25# happyReduction_44-happyReduction_44 (happy_x_5 `HappyStk`- happy_x_4 `HappyStk`- happy_x_3 `HappyStk`- happy_x_2 `HappyStk`- happy_x_1 `HappyStk`- happyRest)- = case happyOut15 happy_x_1 of { happy_var_1 -> - case happyOut34 happy_x_2 of { happy_var_2 -> - case happyOut34 happy_x_4 of { happy_var_4 -> - happyIn30- (DataTele happy_var_1 happy_var_2 happy_var_4- ) `HappyStk` happyRest}}}--happyReduce_45 = happySpecReduce_0 26# happyReduction_45-happyReduction_45 = happyIn31- ([]- )--happyReduce_46 = happySpecReduce_2 26# happyReduction_46-happyReduction_46 happy_x_2- happy_x_1- = case happyOut31 happy_x_1 of { happy_var_1 -> - case happyOut30 happy_x_2 of { happy_var_2 -> - happyIn31- (flip (:) happy_var_1 happy_var_2- )}}--happyReduce_47 = happyReduce 5# 27# happyReduction_47-happyReduction_47 (happy_x_5 `HappyStk`- happy_x_4 `HappyStk`- happy_x_3 `HappyStk`- happy_x_2 `HappyStk`- happy_x_1 `HappyStk`- happyRest)- = case happyOut15 happy_x_1 of { happy_var_1 -> - case happyOut34 happy_x_2 of { happy_var_2 -> - case happyOut34 happy_x_4 of { happy_var_4 -> - happyIn32- (PiTele happy_var_1 happy_var_2 happy_var_4- ) `HappyStk` happyRest}}}--happyReduce_48 = happySpecReduce_1 28# happyReduction_48-happyReduction_48 happy_x_1- = case happyOut32 happy_x_1 of { happy_var_1 -> - happyIn33- ((:[]) happy_var_1- )}--happyReduce_49 = happySpecReduce_2 28# happyReduction_49-happyReduction_49 happy_x_2- happy_x_1- = case happyOut32 happy_x_1 of { happy_var_1 -> - case happyOut33 happy_x_2 of { happy_var_2 -> - happyIn33- ((:) happy_var_1 happy_var_2- )}}--happyReduce_50 = happyReduce 4# 29# happyReduction_50-happyReduction_50 (happy_x_4 `HappyStk`- happy_x_3 `HappyStk`- happy_x_2 `HappyStk`- happy_x_1 `HappyStk`- happyRest)- = case happyOut14 happy_x_1 of { happy_var_1 -> - case happyOut41 happy_x_2 of { happy_var_2 -> - case happyOut34 happy_x_4 of { happy_var_4 -> - happyIn34- (Lam happy_var_1 happy_var_2 happy_var_4- ) `HappyStk` happyRest}}}--happyReduce_51 = happySpecReduce_1 29# happyReduction_51-happyReduction_51 happy_x_1- = case happyOut35 happy_x_1 of { happy_var_1 -> - happyIn34- (happy_var_1- )}--happyReduce_52 = happySpecReduce_3 30# happyReduction_52-happyReduction_52 happy_x_3- happy_x_2- happy_x_1- = case happyOut36 happy_x_1 of { happy_var_1 -> - case happyOut35 happy_x_3 of { happy_var_3 -> - happyIn35- (Arr happy_var_1 happy_var_3- )}}--happyReduce_53 = happySpecReduce_3 30# happyReduction_53-happyReduction_53 happy_x_3- happy_x_2- happy_x_1- = case happyOut33 happy_x_1 of { happy_var_1 -> - case happyOut35 happy_x_3 of { happy_var_3 -> - happyIn35- (Pi happy_var_1 happy_var_3- )}}--happyReduce_54 = happySpecReduce_1 30# happyReduction_54-happyReduction_54 happy_x_1- = case happyOut36 happy_x_1 of { happy_var_1 -> - happyIn35- (happy_var_1- )}--happyReduce_55 = happySpecReduce_3 31# happyReduction_55-happyReduction_55 happy_x_3- happy_x_2- happy_x_1- = case happyOut37 happy_x_1 of { happy_var_1 -> - case happyOut37 happy_x_3 of { happy_var_3 -> - happyIn36- (PathImp happy_var_1 happy_var_3- )}}--happyReduce_56 = happySpecReduce_1 31# happyReduction_56-happyReduction_56 happy_x_1- = case happyOut37 happy_x_1 of { happy_var_1 -> - happyIn36- (happy_var_1- )}--happyReduce_57 = happySpecReduce_3 32# happyReduction_57-happyReduction_57 happy_x_3- happy_x_2- happy_x_1- = case happyOut37 happy_x_1 of { happy_var_1 -> - case happyOut38 happy_x_3 of { happy_var_3 -> - happyIn37- (At happy_var_1 happy_var_3- )}}--happyReduce_58 = happySpecReduce_1 32# happyReduction_58-happyReduction_58 happy_x_1- = case happyOut38 happy_x_1 of { happy_var_1 -> - happyIn37- (happy_var_1- )}--happyReduce_59 = happySpecReduce_2 33# happyReduction_59-happyReduction_59 happy_x_2- happy_x_1- = case happyOut38 happy_x_1 of { happy_var_1 -> - case happyOut39 happy_x_2 of { happy_var_2 -> - happyIn38- (App happy_var_1 happy_var_2- )}}--happyReduce_60 = happySpecReduce_1 33# happyReduction_60-happyReduction_60 happy_x_1- = case happyOut39 happy_x_1 of { happy_var_1 -> - happyIn38- (happy_var_1- )}--happyReduce_61 = happySpecReduce_1 34# happyReduction_61-happyReduction_61 happy_x_1- = case happyOut40 happy_x_1 of { happy_var_1 -> - happyIn39- (Var happy_var_1- )}--happyReduce_62 = happySpecReduce_1 34# happyReduction_62-happyReduction_62 happy_x_1- = case happyOut5 happy_x_1 of { happy_var_1 -> - happyIn39- (Universe happy_var_1- )}--happyReduce_63 = happySpecReduce_1 34# happyReduction_63-happyReduction_63 happy_x_1- = case happyOut6 happy_x_1 of { happy_var_1 -> - happyIn39- (Interval happy_var_1- )}--happyReduce_64 = happySpecReduce_1 34# happyReduction_64-happyReduction_64 happy_x_1- = case happyOut7 happy_x_1 of { happy_var_1 -> - happyIn39- (ELeft happy_var_1- )}--happyReduce_65 = happySpecReduce_1 34# happyReduction_65-happyReduction_65 happy_x_1- = case happyOut8 happy_x_1 of { happy_var_1 -> - happyIn39- (ERight happy_var_1- )}--happyReduce_66 = happySpecReduce_1 34# happyReduction_66-happyReduction_66 happy_x_1- = case happyOut9 happy_x_1 of { happy_var_1 -> - happyIn39- (Path happy_var_1- )}--happyReduce_67 = happySpecReduce_1 34# happyReduction_67-happyReduction_67 happy_x_1- = case happyOut10 happy_x_1 of { happy_var_1 -> - happyIn39- (PathCon happy_var_1- )}--happyReduce_68 = happySpecReduce_1 34# happyReduction_68-happyReduction_68 happy_x_1- = case happyOut11 happy_x_1 of { happy_var_1 -> - happyIn39- (Coe happy_var_1- )}--happyReduce_69 = happySpecReduce_1 34# happyReduction_69-happyReduction_69 happy_x_1- = case happyOut12 happy_x_1 of { happy_var_1 -> - happyIn39- (Iso happy_var_1- )}--happyReduce_70 = happySpecReduce_1 34# happyReduction_70-happyReduction_70 happy_x_1- = case happyOut13 happy_x_1 of { happy_var_1 -> - happyIn39- (Squeeze happy_var_1- )}--happyReduce_71 = happySpecReduce_3 34# happyReduction_71-happyReduction_71 happy_x_3- happy_x_2- happy_x_1- = case happyOut15 happy_x_1 of { happy_var_1 -> - case happyOut34 happy_x_2 of { happy_var_2 -> - happyIn39- (Paren happy_var_1 happy_var_2- )}}--happyReduce_72 = happySpecReduce_1 35# happyReduction_72-happyReduction_72 happy_x_1- = case happyOut17 happy_x_1 of { happy_var_1 -> - happyIn40- (Arg happy_var_1- )}--happyReduce_73 = happySpecReduce_1 35# happyReduction_73-happyReduction_73 happy_x_1- = case happyOut16 happy_x_1 of { happy_var_1 -> - happyIn40- (NoArg happy_var_1- )}--happyReduce_74 = happySpecReduce_1 36# happyReduction_74-happyReduction_74 happy_x_1- = case happyOut40 happy_x_1 of { happy_var_1 -> - happyIn41- ((:[]) happy_var_1- )}--happyReduce_75 = happySpecReduce_2 36# happyReduction_75-happyReduction_75 happy_x_2- happy_x_1- = case happyOut40 happy_x_1 of { happy_var_1 -> - case happyOut41 happy_x_2 of { happy_var_2 -> - happyIn41- ((:) happy_var_1 happy_var_2- )}}--happyNewToken action sts stk [] =- happyDoAction 26# notHappyAtAll action sts stk []--happyNewToken action sts stk (tk:tks) =- let cont i = happyDoAction i tk action sts stk tks in- case tk of {- PT _ (TS _ 1) -> cont 1#;- PT _ (TS _ 2) -> cont 2#;- PT _ (TS _ 3) -> cont 3#;- PT _ (TS _ 4) -> cont 4#;- PT _ (TS _ 5) -> cont 5#;- PT _ (TS _ 6) -> cont 6#;- PT _ (TS _ 7) -> cont 7#;- PT _ (TS _ 8) -> cont 8#;- PT _ (TS _ 9) -> cont 9#;- PT _ (TS _ 10) -> cont 10#;- PT _ (TS _ 11) -> cont 11#;- PT _ (T_U _) -> cont 12#;- PT _ (T_I _) -> cont 13#;- PT _ (T_PLeft _) -> cont 14#;- PT _ (T_PRight _) -> cont 15#;- PT _ (T_PPath _) -> cont 16#;- PT _ (T_Ppath _) -> cont 17#;- PT _ (T_PCoe _) -> cont 18#;- PT _ (T_PIso _) -> cont 19#;- PT _ (T_PSqueeze _) -> cont 20#;- PT _ (T_PLam _) -> cont 21#;- PT _ (T_PPar _) -> cont 22#;- PT _ (T_Pus _) -> cont 23#;- PT _ (T_PIdent _) -> cont 24#;- _ -> cont 25#;- _ -> happyError' (tk:tks)- }--happyError_ 26# tk tks = happyError' tks-happyError_ _ tk tks = happyError' (tk:tks)--happyThen :: () => Err a -> (a -> Err b) -> Err b-happyThen = (thenM)-happyReturn :: () => a -> Err a-happyReturn = (returnM)-happyThen1 m k tks = (thenM) m (\a -> k a tks)-happyReturn1 :: () => a -> b -> Err a-happyReturn1 = \a tks -> (returnM) a-happyError' :: () => [(Token)] -> Err a-happyError' = happyError--pDefs tks = happySomeParser where- happySomeParser = happyThen (happyParse 0# tks) (\x -> happyReturn (happyOut18 x))--pExpr tks = happySomeParser where- happySomeParser = happyThen (happyParse 1# tks) (\x -> happyReturn (happyOut34 x))--happySeq = happyDontSeq---returnM :: a -> Err a-returnM = return--thenM :: Err a -> (a -> Err b) -> Err b-thenM = (>>=)--happyError :: [Token] -> Err a-happyError ts =- Bad $ "syntax error at " ++ tokenPos ts ++ - case ts of- [] -> []- [Err _] -> " due to lexer error"- _ -> " before " ++ unwords (map (id . prToken) (take 4 ts))--myLexer = tokens-{-# LINE 1 "templates/GenericTemplate.hs" #-}-{-# LINE 1 "templates/GenericTemplate.hs" #-}-{-# LINE 1 "<command-line>" #-}-{-# LINE 1 "templates/GenericTemplate.hs" #-}--- Id: GenericTemplate.hs,v 1.26 2005/01/14 14:47:22 simonmar Exp --{-# LINE 30 "templates/GenericTemplate.hs" #-}---data Happy_IntList = HappyCons Happy_GHC_Exts.Int# Happy_IntList------{-# LINE 51 "templates/GenericTemplate.hs" #-}--{-# LINE 61 "templates/GenericTemplate.hs" #-}--{-# LINE 70 "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 Happy_GHC_Exts.<# (0# :: Happy_GHC_Exts.Int#)) -> {- nothing -}-- (happyReduceArr Happy_Data_Array.! rule) i tk st- where rule = (Happy_GHC_Exts.I# ((Happy_GHC_Exts.negateInt# ((n Happy_GHC_Exts.+# (1# :: Happy_GHC_Exts.Int#))))))- n -> {- nothing -}--- happyShift new_state i tk st- where (new_state) = (n Happy_GHC_Exts.-# (1# :: Happy_GHC_Exts.Int#))- where (off) = indexShortOffAddr happyActOffsets st- (off_i) = (off Happy_GHC_Exts.+# i)- check = if (off_i Happy_GHC_Exts.>=# (0# :: Happy_GHC_Exts.Int#))- then (indexShortOffAddr happyCheck off_i Happy_GHC_Exts.==# i)- else False- (action)- | check = indexShortOffAddr happyTable off_i- | otherwise = indexShortOffAddr happyDefActions st--{-# LINE 130 "templates/GenericTemplate.hs" #-}---indexShortOffAddr (HappyA# arr) off =- Happy_GHC_Exts.narrow16Int# i- where- i = Happy_GHC_Exts.word2Int# (Happy_GHC_Exts.or# (Happy_GHC_Exts.uncheckedShiftL# high 8#) low)- high = Happy_GHC_Exts.int2Word# (Happy_GHC_Exts.ord# (Happy_GHC_Exts.indexCharOffAddr# arr (off' Happy_GHC_Exts.+# 1#)))- low = Happy_GHC_Exts.int2Word# (Happy_GHC_Exts.ord# (Happy_GHC_Exts.indexCharOffAddr# arr off'))- off' = off Happy_GHC_Exts.*# 2#------data HappyAddr = HappyA# Happy_GHC_Exts.Addr#------------------------------------------------------------------------------------- HappyState data type (not arrays)--{-# LINE 163 "templates/GenericTemplate.hs" #-}---------------------------------------------------------------------------------- Shifting a token--happyShift new_state 0# tk st sts stk@(x `HappyStk` _) =- let (i) = (case Happy_GHC_Exts.unsafeCoerce# x of { (Happy_GHC_Exts.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 Happy_GHC_Exts.-# (1# :: Happy_GHC_Exts.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 Happy_GHC_Exts.+# nt)- (new_state) = indexShortOffAddr happyTable off_i-----happyDrop 0# l = l-happyDrop n (HappyCons (_) (t)) = happyDrop (n Happy_GHC_Exts.-# (1# :: Happy_GHC_Exts.Int#)) t--happyDropStk 0# l = l-happyDropStk n (x `HappyStk` xs) = happyDropStk (n Happy_GHC_Exts.-# (1#::Happy_GHC_Exts.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 Happy_GHC_Exts.+# 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@(x `HappyStk` _) =- let (i) = (case Happy_GHC_Exts.unsafeCoerce# x of { (Happy_GHC_Exts.I# (i)) -> i }) in--- trace "failing" $ - happyError_ i 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 ( (Happy_GHC_Exts.unsafeCoerce# (Happy_GHC_Exts.I# (i))) `HappyStk` stk)---- Internal happy errors:--notHappyAtAll :: a-notHappyAtAll = error "Internal Happy error\n"---------------------------------------------------------------------------------- Hack to get the typechecker to accept our action functions---happyTcHack :: Happy_GHC_Exts.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.
+ examples/Paths.hoq view
@@ -0,0 +1,37 @@+infixr 5 $+($) : {A B : Type} -> (A -> B) -> A -> B+($) _ _ f a = f a++idp : {A : Type} {a : A} -> a = a+idp _ a = path (\_ -> a)++transport : {A : Type} (B : A -> Type) {a a' : A} -> a = a' -> B a -> B a'+transport _ B _ _ p x = coe (\i -> B (p @ i)) left x right++psqueeze : {A : Type} {a a' : A} (p : a = a') (i : I) -> a = p @ i+psqueeze _ _ _ p i = path (\j -> p @ squeeze i j)++J : {A : Type} {a : A} (B : {a' : A} -> a = a' -> Type) -> B idp -> {a' : A} (p : a = a') -> B p+J A a B b a' p = coe (\i -> B (psqueeze p i)) left b right++inv : {A : Type} {a a' : A} -> a = a' -> a' = a+inv _ a _ p = transport (\x -> x = a) p idp++(*) : {A : Type} {a a' a'' : A} -> a = a' -> a' = a'' -> a = a''+(*) _ a _ _ p q = transport (\x -> a = x) q p++inv-comp : {A : Type} {a a' : A} (p : a = a') -> inv p * p = idp+inv-comp _ _ _ p = J (\_ q -> inv q * q = idp) idp p++data QED = qed++(!) : {A : Type} -> (a : A) -> QED -> a = a+(!) _ _ _ = idp++infix 3 ==<+(==<) : {A : Type} (a : A) {a' : A} -> a = a' -> a = a'+(==<) _ _ _ p = p++infixr 2 >==+(>==) : {A : Type} {a a' a'' : A} -> a = a' -> a' = a'' -> a = a''+(>==) _ _ _ _ = (*)
examples/basics.hoq view
@@ -1,7 +1,14 @@ -- Pi types id : (A : Type) -> A -> A-id A a = a+id _ a = a +-- Implicit arguments+id' : {A : Type} -> A -> A+id' _ a = a++test : (A : Type) -> (A -> A) -> (A -> A)+test _ f = id' f+ -- Universes -- Type and Type0 are synonyms universes : (f : Type1 -> Type0) -> f Type0 -> f Type0@@ -23,14 +30,16 @@ data List (A : Type) = nil | cons A (List A) -- Pattern matching-not : Bool -> Bool-not true = false-not false = true- and : Bool -> Bool -> Bool and true true = true and _ _ = false +-- Case construction+not : Bool -> Bool+not b = case b of+ true -> false+ false -> true+ -- Recursive functions plus : Nat -> Nat -> Nat plus zero y = y@@ -41,6 +50,13 @@ ack (suc m) zero = ack m (suc zero) ack (suc m) (suc n) = ack m (ack (suc m) n) +-- Infix operators+infixl 60 `plus`+infixl 70 *+(*) : Nat -> Nat -> Nat+(*) zero _ = zero+(*) (suc x) y = y `plus` x * y+ -- Interval type -- I is a type with constructors left : I and right : I -- coe and squeeze are primitive operators which satisfy the following rules:@@ -73,6 +89,15 @@ ext : (A : Type) (B : A -> Type) (f g : (a : A) -> B a) -> ((a : A) -> f a = g a) -> f = g ext A B f g p = path (\i a -> p a @ i) +-- There are three special subuniverses of Type: Contr, Prop, and Set_i+-- For each A : Contr, we have contr : A+-- A path in Set belongs to Prop, and a path in Prop belongs to Contr, that is+-- Path : (A : I -> Set) -> A left -> A right -> Prop+-- Path : (A : I -> Prop) -> A left -> A right -> Contr+-- Data types which use only types in Set (note that I does not belong to Set) also belong to Set+Nat-isSet : (x y : Nat) (p q : x = y) -> p = q+Nat-isSet _ _ _ _ = contr+ -- Univalence not-not : (x : Bool) -> not (not x) = x not-not true = idp Bool true@@ -101,10 +126,12 @@ succ (negative (suc x)) = negative x -- but this don't+{- succ' : Z -> Z succ' (positive x) = positive (suc x) succ' (negative zero) = positive zero succ' (negative (suc x)) = negative x+-} -- We can define higher inductive types using data types with conditions and the interval object data Circle = base | loop I with
examples/circle.hoq view
@@ -1,11 +1,10 @@+import Paths+ data Nat = zero | suc Nat data Z = positive Nat | negative Nat with negative zero = positive zero -Z-isSet : (x y : Z) (p q : x = y) -> p = q-Z-isSet = NotImplemented- succ : Z -> Z succ (positive x) = positive (suc x) succ (negative zero) = positive (suc zero)@@ -20,133 +19,111 @@ loop left = base loop right = base -idp : (A : Type) (a : A) -> a = a-idp A a = path (\_ -> a)--transport : (A : Type) (B : A -> Type) (a a' : A) -> a = a' -> B a -> B a'-transport A B _ _ p x = coe (\i -> B (p @ i)) left x right--psqueeze : (A : Type) (a a' : A) (p : a = a') (i : I) -> a = p @ i-psqueeze A a a' p i = path (\j -> p @ squeeze i j)--J : (A : Type) (a : A) (B : (a' : A) -> a = a' -> Type) -> B a (idp A a) -> (a' : A) (p : a = a') -> B a' p-J A a B b a' p = coe (\i -> B (p @ i) (psqueeze A a a' p i)) left b right--inv : (A : Type) (a a' : A) -> a = a' -> a' = a-inv A a a' p = transport A (\x -> x = a) a a' p (idp A a)--comp : (A : Type) (a a' a'' : A) -> a = a' -> a' = a'' -> a = a''-comp A a a' a'' p q = transport A (\x -> a = x) a' a'' q p--comp' : base = base -> base = base -> base = base-comp' = comp Circle base base base--inv' : base = base -> base = base-inv' = inv Circle base base- wind : Z -> base = base-wind (positive zero) = idp Circle base-wind (positive (suc x)) = comp' (wind (positive x)) (path loop)-wind (negative (suc x)) = comp' (wind (negative x)) (inv' (path loop))+wind (positive zero) = idp+wind (positive (suc x)) = wind (positive x) * path loop+wind (negative (suc x)) = wind (negative x) * inv (path loop) pred-succ : (x : Z) -> pred (succ x) = x-pred-succ (positive x) = idp Z (positive x)-pred-succ (negative (suc x)) = idp Z (negative (suc x))+pred-succ (positive x) = idp+pred-succ (negative (suc x)) = idp succ-pred : (x : Z) -> succ (pred x) = x-succ-pred (positive zero) = idp Z (positive zero)-succ-pred (positive (suc x)) = idp Z (positive (suc x))-succ-pred (negative x) = idp Z (negative x)+succ-pred (positive zero) = idp+succ-pred (positive (suc x)) = idp+succ-pred (negative x) = idp -iter : I -> Type+iter : I -> Set iter i = iso Z Z succ pred pred-succ succ-pred i -code : Circle -> Type+code : Circle -> Set code base = Z code (loop i) = iter i -encode : (x : Circle) -> base = x -> code x+encode : {x : Circle} -> base = x -> code x encode _ p = coe (\i -> code (p @ i)) left (positive zero) right -assoc : (p q r : base = base) -> comp' (comp' p q) r = comp' p (comp' q r)-assoc p q = J Circle base- (\x s -> comp Circle base base x (comp' p q) s = comp Circle base base x p (comp Circle base base x q s))- (idp (base = base) (comp' p q)) base--map : (A B : Type) (f : A -> B) -> (a a' : A) -> a = a' -> f a = f a'-map A B f a a' p = transport A (\x -> f a = f x) a a' p (idp B (f a))+assoc : (p q r : base = base) -> (p * q) * r = p * (q * r)+assoc p q = J (\x s -> (p * q) * s = p * (q * s)) idp -inv-idp : (p : base = base) -> comp' (inv' p) p = idp Circle base-inv-idp = J Circle base (\x q -> comp Circle x base x (inv Circle base x q) q = idp Circle x)- (idp (base = base) (idp Circle base)) base+map : {A B : Type} (f : A -> B) -> {a a' : A} -> a = a' -> f a = f a'+map _ _ f a _ p = transport (\x -> f a = f x) p idp -wind-succ-loop-neg : (x : Nat) -> comp' (wind (pred (negative x))) (path loop) = wind (negative x)+wind-succ-loop-neg : (x : Nat) -> wind (pred (negative x)) * path loop = wind (negative x) wind-succ-loop-neg x =- comp (base = base) (comp' (comp' (wind (negative x)) (inv' (path loop))) (path loop))- (comp' (wind (negative x)) (comp' (inv' (path loop)) (path loop)))- (wind (negative x))- (assoc (wind (negative x)) (inv' (path loop)) (path loop))- (map (base = base) (base = base) (comp' (wind (negative x)))- (comp' (inv' (path loop)) (path loop)) (idp Circle base) (inv-idp (path loop)))+ assoc (wind (negative x)) (inv (path loop)) (path loop) *+ map (\p -> wind (negative x) * p) (inv-comp (path loop)) -wind-succ-loop : (x : Z) -> comp' (wind (pred x)) (path loop) = wind x+wind-succ-loop : (x : Z) -> wind (pred x) * path loop = wind x wind-succ-loop (positive zero) = wind-succ-loop-neg zero-wind-succ-loop (positive (suc x)) = idp (base = base) (wind (positive (suc x)))+wind-succ-loop (positive (suc x)) = idp wind-succ-loop (negative x) = wind-succ-loop-neg x decode : (x : Circle) -> code x -> base = x decode base = wind decode (loop i) = coe (\j -> Path (\k -> iter k -> base = loop k) wind (\y -> wind-succ-loop y @ j)) left- (path (\k y -> comp Circle base base (loop k) (wind (coe iter k y left)) (psqueeze Circle base base (path loop) k)))+ (path (\k y -> wind (coe iter k y left) * psqueeze (path loop) k)) right @ i -encode-decode : (x : Circle) (p : base = x) -> decode x (encode x p) = p-encode-decode = J Circle base (\x p -> decode x (encode x p) = p) (idp (base = base) (idp Circle base))+encode-decode : {x : Circle} (p : base = x) -> decode x (encode p) = p+encode-decode _ = J (\x p -> decode x (encode p) = p) idp coe-comp : (p q : base = base) (z : Z) ->- coe (\i -> code (comp' p q @ i)) left z right =+ coe (\i -> code (p * q @ i)) left z right = coe (\i -> code (q @ i)) left (coe (\i -> code (p @ i)) left z right) right-coe-comp p q z = J Circle base (\x s -> coe (\i -> code (comp Circle base base x p s @ i)) left z right =- coe (\i -> code (s @ i)) left (coe (\i -> code (p @ i)) left z right) right)- (idp Z (coe (\i -> code (p @ i)) left z right)) base q+coe-comp p q z = J (\x s -> coe (\i -> code (p * s @ i)) left z right =+ coe (\i -> code (s @ i)) left (coe (\i -> code (p @ i)) left z right) right) idp q -coe-inv : (p : base = base) (z : Z) -> coe (\i -> code (inv' p @ i)) left z right = coe (\i -> code (p @ i)) right z left-coe-inv = J Circle base (\x s -> (y : code x) ->- coe (\i -> code (inv Circle base x s @ i)) left y right = coe (\i -> code (s @ i)) right y left) (idp Z) base+coe-inv : (p : base = base) (z : Z) -> coe (\i -> code (inv p @ i)) left z right = coe (\i -> code (p @ i)) right z left+coe-inv = J (\x s -> (y : code x) ->+ coe (\i -> code (inv s @ i)) left y right = coe (\i -> code (s @ i)) right y left) (\_ -> idp) -decode-encode-base : (z : Z) -> encode base (wind z) = z-decode-encode-base (positive zero) = idp Z (positive zero)+decode-encode-base : (z : Z) -> encode (wind z) = z+decode-encode-base (positive zero) = idp decode-encode-base (positive (suc x)) =- comp Z (coe (\i -> code (comp' (wind (positive x)) (path loop) @ i)) left (positive zero) right)- (succ (coe (\i -> code (wind (positive x) @ i)) left (positive zero) right))- (positive (suc x))- (coe-comp (wind (positive x)) (path loop) (positive zero))- (map Z Z succ (coe (\i -> code (wind (positive x) @ i)) left (positive zero) right) (positive x)- (decode-encode-base (positive x)))+ coe-comp (wind (positive x)) (path loop) (positive zero) * map succ (decode-encode-base (positive x)) decode-encode-base (negative (suc x)) =- comp Z (coe (\i -> code (comp' (wind (negative x)) (inv' (path loop)) @ i)) left (positive zero) right)- (coe (\i -> code (inv' (path loop) @ i)) left (coe (\i -> code (wind (negative x) @ i)) left (positive zero) right) right)- (negative (suc x))- (coe-comp (wind (negative x)) (inv' (path loop)) (positive zero))- (comp Z (coe (\i -> code (inv' (path loop) @ i)) left (coe (\i -> code (wind (negative x) @ i)) left (positive zero) right) right)- (pred (coe (\i -> code (wind (negative x) @ i)) left (positive zero) right))- (negative (suc x))- (coe-inv (path loop) (coe (\i -> code (wind (negative x) @ i)) left (positive zero) right))- (map Z Z pred (coe (\i -> code (wind (negative x) @ i)) left (positive zero) right) (negative x) (decode-encode-base (negative x)))- )+ + encode (wind (negative (suc x)))+ + ==< idp >==+ + coe (\i -> code (wind (negative x) * inv (path loop) @ i)) left (positive zero) right+ + ==< coe-comp (wind (negative x)) (inv (path loop)) (positive zero) >==+ + coe (\i -> code (inv (path loop) @ i)) left (coe (\i -> code (wind (negative x) @ i)) left (positive zero) right) right+ + ==< coe-inv (path loop) (coe (\i -> code (wind (negative x) @ i)) left (positive zero) right) >==+ + coe (\i -> code (loop i)) right (coe (\i -> code (wind (negative x) @ i)) left (positive zero) right) left+ + ==< idp >==+ + pred (encode (wind (negative x)))+ + ==< map pred (decode-encode-base (negative x)) >==+ + pred (negative x)+ + ==< idp >==+ + negative (suc x)+ + !qed -Circle-elim' : (P : Circle -> Type) (b : P base) -> transport Circle P base base (path loop) b = b -> (x : Circle) -> P x-Circle-elim' P b t base = b-Circle-elim' P b t (loop i) = - coe (\j -> Path (\k -> P (loop k)) b (t @ j)) left+Prop-Contr : {A : Prop} (a a' : A) -> a = a'+Prop-Contr _ _ _ = contr++Circle-elim-Prop : (P : Circle -> Prop) (b : P base) -> (x : Circle) -> P x+Circle-elim-Prop P b base = b+Circle-elim-Prop P b (loop i) = + coe (\j -> Path (\k -> P (loop k)) b (Prop-Contr (transport P (path loop) b) b @ j)) left (path (\j -> coe (\k -> P (loop k)) left b j)) right @ i -decode-encode : (x : Circle) (z : code x) -> encode x (decode x z) = z-decode-encode = Circle-elim' (\x -> (z : code x) -> encode x (decode x z) = z) decode-encode-base- (path (\i z -> Z-isSet (coe (\i -> code (wind z @ i)) left (positive zero) right) z- (transport Circle (\x -> (z : code x) -> encode x (decode x z) = z) base base (path loop) decode-encode-base z)- (decode-encode-base z) @ i))+decode-encode : (x : Circle) (z : code x) -> encode (decode x z) = z+decode-encode = Circle-elim-Prop (\x -> (z : code x) -> encode (decode x z) = z) decode-encode-base Circle-loop-space-is-Z : (base = base) = Z-Circle-loop-space-is-Z = path (iso (base = base) Z (encode base) (decode base) (encode-decode base) (decode-encode base))+Circle-loop-space-is-Z = path (iso (base = base) Z encode (decode base) encode-decode (decode-encode base))
examples/hlevel.hoq view
@@ -1,3 +1,5 @@+import Paths+ data Nat = zero | suc Nat data Sigma (A : Type) (B : A -> Type) = pair (a : A) (B a)@@ -27,33 +29,11 @@ h1-prop : (A : Type) -> of-hlevel (suc zero) A -> isProp A h1-prop A f a a' = proj1 (a = a') (\p -> (p' : a = a') -> p = p') (f a a') -idp : (A : Type) (a : A) -> a = a-idp A a = path (\_ -> a)--transport : (A : Type) (B : A -> Type) (a a' : A) -> a = a' -> B a -> B a'-transport A B _ _ p x = coe (\i -> B (p @ i)) left x right--psqueeze : (A : Type) (a a' : A) (p : a = a') (i : I) -> a = p @ i-psqueeze A a a' p i = path (\j -> p @ squeeze i j)--J : (A : Type) (a : A) (B : (a' : A) -> a = a' -> Type) -> B a (idp A a) -> (a' : A) (p : a = a') -> B a' p-J A a B b a' p = coe (\i -> B (p @ i) (psqueeze A a a' p i)) left b right--inv : (A : Type) (a a' : A) -> a = a' -> a' = a-inv A a a' p = transport A (\x -> x = a) a a' p (idp A a)--comp : (A : Type) (a a' a'' : A) -> a = a' -> a' = a'' -> a = a''-comp A a a' a'' p q = transport A (\x -> a = x) a' a'' q p--inv-comp : (A : Type) (a a' : A) (p : a = a') -> comp A a' a a' (inv A a a' p) p = idp A a'-inv-comp A a a' p = J A a (\x q -> comp A x a x (inv A a x q) q = idp A x) (idp (a = a) (idp A a)) a' p- contr-prop : (A : Type) -> isContr A -> isProp A-contr-prop A (pair c f) a a' = comp A a c a' (inv A c a (f a)) (f a')+contr-prop A (pair c f) a a' = inv (f a) * f a' prop-h1 : (A : Type) -> isProp A -> of-hlevel (suc zero) A-prop-h1 A f a a' = pair (comp A a a a' (inv A a a (f a a)) (f a a'))- (J A a (\x q -> comp A a a x (inv A a a (f a a)) (f a x) = q) (inv-comp A a a (f a a)) a')+prop-h1 A f a a' = pair (inv (f a a) * f a a') (J (\x q -> inv (f a a) * f a x = q) (inv-comp (f a a))) prop-set : (A : Type) -> isProp A -> isSet A prop-set A p a a' = contr-prop (a = a') (prop-h1 A p a a')@@ -62,15 +42,15 @@ isProp-isProp A f g = path (\i a a' -> prop-set A f a a' (f a a') (g a a') @ i) Sigma-eq : (A : Type) (B : A -> Type) (a a' : A) (b : B a) (b' : B a') (p : a = a')- -> transport A B a a' p b = b' -> Path (\_ -> Sigma A B) (pair a b) (pair a' b')-Sigma-eq A B a a' b b' p = J A a- (\a' p -> (b' : B a') -> transport A B a a' p b = b' -> Path (\_ -> Sigma A B) (pair a b) (pair a' b'))- (\b' q -> path (\i -> pair a (q @ i))) a' p b'+ -> transport B p b = b' -> Path (\_ -> Sigma A B) (pair a b) (pair a' b')+Sigma-eq A B a a' b b' p = J+ (\a' p -> (b' : B a') -> transport B p b = b' -> Path (\_ -> Sigma A B) (pair a b) (pair a' b'))+ (\b' q -> path (\i -> pair a (q @ i))) p b' isContr-isProp : (A : Type) -> isProp (isContr A) isContr-isProp A (pair a1 f1) (pair a2 f2) = Sigma-eq A (\a -> (a' : A) -> a = a') a1 a2 f1 f2 (f1 a2) (path (\i a' -> prop-set A (contr-prop A (pair a1 f1)) a2 a'- (transport A (\a -> (a' : A) -> a = a') a1 a2 (f1 a2) f1 a') (f2 a') @ i))+ (transport (\a -> (a' : A) -> a = a') (f1 a2) f1 a') (f2 a') @ i)) of-hlevel-isProp : (n : Nat) (A : Type) -> isProp (of-hlevel n A) of-hlevel-isProp zero A = isContr-isProp A
examples/lem.hoq view
@@ -1,3 +1,5 @@+import Paths+ data E data S = s data B = true | false@@ -18,20 +20,13 @@ not-not false = path (\_ -> false) biso : I -> Type-biso i = iso B B not not not-not not-not i+biso = iso B B not not not-not not-not not-eq : (b : B) -> not b = b -> E not-eq true p = coe (\i -> T (p @ i)) right s left not-eq false p = coe (\i -> T (p @ i)) left s right -transport : (A : Type) (B : A -> Type) (a a' : A) -> a = a' -> B a -> B a'-transport A B _ _ p x = coe (\i -> B (p @ i)) left x right--comp : (A : Type) (a a' a'' : A) -> a = a' -> a' = a'' -> a = a''-comp A a a' a'' p q = transport A (\x -> a = x) a' a'' q p- not-lem : ((A : Type) -> ((A -> E) -> E) -> A) -> E-not-lem f = not-eq (f B (\g -> g true))- (comp B (not (f B (\g -> g true))) (f B (\g -> g false)) (f B (\g -> g true))- (path (\i -> coe biso i (f (biso i) (\g -> g (coe biso left true i))) right))- (path (\i -> f B (\g -> g (E-elim (false = true) (g true) @ i)))))+not-lem f = not-eq (f B (\g -> g true)) $+ path (\i -> coe biso i (f (biso i) (\g -> g (coe biso left true i))) right) *+ path (\i -> f B (\g -> g (E-elim (false = true) (g true) @ i)))
hoq.cabal view
@@ -1,12 +1,12 @@ name: hoq-version: 0.1.0.0-synopsis: A language based on homotopy type theory with an interval object+version: 0.2+synopsis: A language based on homotopy type theory with an interval type -- description: tested-with: GHC == 7.6.3 homepage: http://github.com/valis/hoq license: GPL-2 license-file: LICENSE-author: isaev+author: Valery Isaev maintainer: valery.isaev@gmail.com category: Dependent Types build-type: Custom@@ -14,7 +14,7 @@ data-dir: data data-files: hoq.vim extra-source-files: README.md,- src/Syntax/Grammar.cf,+ examples/Paths.hoq, examples/basics.hoq, examples/hlevel.hoq, examples/circle.hoq,@@ -29,27 +29,29 @@ other-modules: REPL, Normalization, File.Load,- Syntax.BNFC.ParGrammar,- Syntax.BNFC.LexGrammar,- Syntax.Term, Syntax.Scope,- Syntax.Expr, Syntax.PrettyPrinter,- Syntax.ErrorDoc, Syntax.Pattern,- TypeChecking.Definitions.Patterns,- TypeChecking.Definitions.Coverage,+ Syntax, Syntax.Term, Syntax.Parser,+ Syntax.PrettyPrinter, Syntax.ErrorDoc,+ Syntax.Parser.Lexer, Syntax.Parser.Parser,+ Semantics, Semantics.Value, TypeChecking.Definitions.DataTypes, TypeChecking.Definitions.Functions,- TypeChecking.Definitions.Conditions, TypeChecking.Definitions.Termination, TypeChecking.Definitions,+ TypeChecking.Expressions.Utils,+ TypeChecking.Expressions.Patterns,+ TypeChecking.Expressions.Coverage,+ TypeChecking.Expressions.Conditions, TypeChecking.Expressions, TypeChecking.Monad.Scope, TypeChecking.Monad.Warn, TypeChecking.Monad, TypeChecking.Context- build-depends: base >=4.6 && <4.7, mtl >=2.1,- BNFC >= 2.5, array >= 0.4, pretty >=1.1,+ build-depends: base >=4 && <5, mtl >=2.1, filepath >=1.3,+ bytestring >=0.10, void >= 0.6,+ bifunctors >= 4.0,+ array >= 0.4, pretty >=1.1, prelude-extras >=0.4, readline >=1.0 build-tools: happy >= 1.15 && < 2,- alex >= 2.3.1 && < 3.1+ alex >= 2.3.1 hs-source-dirs: src default-language: Haskell2010
src/File/Load.hs view
@@ -3,33 +3,64 @@ ) where import System.IO+import System.FilePath+import Control.Monad import Control.Monad.Fix import Control.Monad.Trans+import Control.Monad.State import Control.Exception+import qualified Data.ByteString as B -import Syntax.BNFC.ErrM-import Syntax.BNFC.ParGrammar-import Syntax.BNFC.LayoutGrammar+import Syntax+import Syntax.Parser import Syntax.ErrorDoc import Syntax.PrettyPrinter()-import Syntax.Expr+import TypeChecking.Expressions.Utils import TypeChecking.Definitions import TypeChecking.Monad -loadFile :: (MonadIO m, MonadFix m) => String -> ScopeM m ()+loadFile :: (MonadIO m, MonadFix m) => String -> ScopeT m [(Name,Fixity)] loadFile filename = do- (errs, _) <- runWarnT $ do- mcnt <- liftIO $ fmap Right (readFile filename)- `catch` \e -> return $ Left $ show (e :: SomeException)- case mcnt of- Right cnt -> parseDefs cnt- Left err -> warn [emsg err enull]- liftIO $ mapM_ (hPutStrLn stderr . erenderWithFilename filename) errs+ ((errs, _), (_, tab)) <- runStateT (runWarnT $ loadFile' [] filename) ([],[])+ liftIO $ mapM_ (\(fn, err) -> hPutStrLn stderr $ erenderWithFilename fn $ errorMsg err) errs+ return tab -parseDefs :: MonadFix m => String -> TCM m ()-parseDefs s = case parser s of- Ok (Defs defs) -> typeCheckDefs defs- Bad err -> warn [emsg err enull]- where- parser :: String -> Err Defs- parser = pDefs . resolveLayout True . myLexer+loadFile' :: (MonadIO m, MonadFix m) => [String] -> String+ -> WarnT [(String,Error)] (StateT ([String],[(Name,Fixity)]) (ScopeT m)) ()+loadFile' checking filename = do+ mcnt <- liftIO $ fmap Right (B.readFile filename)+ `catch` \e -> return $ Left $ show (e :: SomeException)+ case mcnt of+ Right cnt -> parseDefs filename checking cnt+ Left err -> warn [(filename, Error Other $ emsg err enull)]++parseDefs :: (MonadIO m, MonadFix m) => String -> [String] -> B.ByteString+ -> WarnT [(String,Error)] (StateT ([String],[(Name,Fixity)]) (ScopeT m)) ()+parseDefs cur checking s = do+ defs <- mapWarnT (map $ \e -> (cur,e)) (pDefs s)+ defs' <- forM defs $ \def -> case def of+ DefImport moduleName -> do+ let filename = foldr1 combine moduleName <.> "hoq"+ if filename `elem` checking+ then warn [(cur, Error Other $ emsg ("Modules " ++ cur ++ " and " ++ filename ++ " form a cycle") enull)]+ else do+ (checked,_) <- lift get+ if filename `elem` checked then return () else loadFile' (cur:checking) filename+ return def+ DefFixity pos inf pr ops -> do+ forM_ ops $ \op -> do+ (fns,tab) <- lift get+ case lookup op tab of+ Just ft ->+ let msg = "Multiple fixity declarations for " ++ nameToInfix op ++ " [" ++ show ft ++ "]"+ in warn [(cur, Error Other $ emsgLC pos msg enull)]+ Nothing -> return ()+ lift $ put (fns, (op, Infix inf pr):tab)+ return def+ _ -> lift get >>= \(_,tab) -> mapWarnT (map $ \e -> (cur,e)) (fixFixityDef tab def)+ lift $ modify $ \(fns,tab) -> (cur:fns,tab)+ (es,mr) <- lift $ lift $ runWarnT (typeCheckDefs defs')+ let es' = map (\e -> (cur,e)) es+ case mr of+ Nothing -> throwError es'+ Just r -> warn es' >> return r
src/Main.hs view
@@ -9,4 +9,6 @@ main :: IO () main = do args <- getArgs- runScopeT $ mapM_ loadFile args >> repl+ runScopeT $ do+ tabs <- mapM loadFile args+ repl (concat tabs)
src/Normalization.hs view
@@ -1,104 +1,103 @@ module Normalization ( NF(..), nf- , nfType, nfScope+ , nfType ) where import Control.Monad import Data.Traversable -import Syntax.Term+import Semantics+import qualified Syntax as S+import Semantics.Value -data NF = NF | HNF | WHNF deriving Eq+data NF = NF | Step | WHNF deriving Eq -nf :: Eq a => NF -> Term a -> Term a-nf mode e = go e []- where- go (App a b) ts = go a (b:ts)- go e@Var{} ts = apps e (nfs mode ts)- go e@Universe{} _ = e- go (Pi a b lvl) _ | mode == NF = Pi (nfType NF a) (nfScope b) lvl- go e@Pi{} _ = e- go e@Interval _ = e- go e@(ICon _) _ = e- go (PCon Nothing) [] = PCon Nothing- go (PCon Nothing) (e:_) = PCon $ Just $ if mode == NF then nf NF e else e- go (PCon (Just e)) _ = PCon $ Just $ if mode == NF then nf NF e else e- go (Con c lc n [] es) [] = Con c lc n [] $ nfs mode es- go (Con c lc n [] es) ts = Con c lc n [] $ nfs mode (es ++ ts)- go (DataType d e es) [] = DataType d e $ nfs mode es- go (DataType d e es) ts = DataType d e $ nfs mode (es ++ ts)- go (Path h ma es) [] = Path h (if mode == NF then fmap (nf NF) ma else ma) $ nfs mode es- go (Path h ma es) ts = Path h (if mode == NF then fmap (nf NF) ma else ma) $ nfs mode (es ++ ts)- go (Lam (Scope1 v t)) [] = Lam $ Scope1 v $ if mode == WHNF then t else nf mode t- go (Lam (Scope1 _ s)) (t:ts) = go (instantiate1 t s) ts- go (FunSyn _ term) ts = go term ts- go (Con c lc n conds es) ts =- let es' = if null ts then es else es ++ ts in- case instantiateCases conds es' of- Just (r,ts') -> go r ts'- Nothing -> Con c lc n conds (if mode == NF then map (nf NF) es' else es')- go fc@(FunCall _ _ []) ts = apps fc (nfs mode ts)- go fc@(FunCall _ _ clauses) ts = case instantiateCases clauses ts of- Just (r,ts') -> go r ts'- Nothing -> apps fc (nfs mode ts)- go (At a b e1 e2) ts = case (nf WHNF e1, nf WHNF e2) of- (_, ICon ILeft) -> go a ts- (_, ICon IRight) -> go b ts- (PCon (Just t1), t2) -> go t1 (t2:ts)- (t1, t2) -> apps (At (go a []) (go b []) (go t1 []) (go t2 [])) (nfs mode ts)- go (Coe es) ts = case es ++ ts of- es'@(e1:e2:e3:e4:es'') ->- let e1' = nf WHNF e1- e2' = nf NF e2- e4' = nf NF e4- in case (e2' == e4' || isStationary e1', e2' == ICon ILeft && e4' == ICon IRight,- e2' == ICon IRight && e4' == ICon ILeft, e1') of- (True, _, _, _) -> go e3 es''- (_, b1, b2, Iso [t1,t2,t3,t4,t5,t6]) | b1 || b2 -> go (App (if b1 then t3 else t4) e3) es''- (_, b1, b2, _) | b1 || b2 -> case nf NF $ App (fmap Free e1') (Var Bound) of- Iso [t1,t2,t3,t4,t5,t6, Var Bound] -> case sequenceA $ Iso [t1,t2,t3,t4,t5,t6] of- Free (Iso [t1',t2',t3',t4',t5',t6']) -> go (App (if b1 then t3' else t4') e3) es''- _ -> Coe (nfs mode es')- _ -> Coe (nfs mode es')- _ -> Coe (nfs mode es')- es' -> Coe (nfs mode es')- go (Iso es) ts = case map (nf WHNF) (es ++ ts) of- t1:t2:t3:t4:t5:t6: ICon ILeft : _ -> go t1 []- t1:t2:t3:t4:t5:t6: ICon IRight : _ -> go t2 []- _ -> Iso $ nfs mode (es ++ ts)- go (Squeeze es) ts = case map (nf WHNF) (es ++ ts) of- ICon ILeft : _ : _ -> ICon ILeft- ICon IRight : j : _ -> if mode == WHNF then j else nf mode j- _ : ICon ILeft : _ -> ICon ILeft- i : ICon IRight : _ -> if mode == WHNF then i else nf mode i- es' -> Squeeze $ nfs mode (es ++ ts)+nf :: Eq a => NF -> Term Semantics a -> Term Semantics a+nf mode (Var a ts) = Var a (nfs mode ts)+nf mode (Apply t ts) = nfSemantics mode t ts+nf mode (Lambda t) = Lambda $ if mode == WHNF then t else nf mode t -nfType :: Eq a => NF -> Type a -> Type a-nfType mode (Type t lvl) = Type (nf mode t) lvl+nfSemantics :: Eq a => NF -> Semantics -> [Term Semantics a] -> Term Semantics a+nfSemantics mode (Semantics (S.Lam (_:vs)) Lam) (Lambda a@Lambda{} : t : ts) =+ nfStep mode $ Apply (Semantics (S.Lam vs) Lam) (instantiate1 t a : ts)+nfSemantics mode (Semantics _ Lam) (Lambda s : t : ts) = nfStep mode $ apps (instantiate1 t s) ts+nfSemantics mode t@(Semantics _ (Con (DCon _ _ (PatEval conds)))) ts = case instantiateClauses conds ts of+ Just (t', ts') -> nfStep mode (apps t' ts')+ _ -> Apply t (nfs mode ts)+nfSemantics mode (Semantics _ (FunCall _ (SynEval (Closed t)))) ts = nfStep mode (apps t ts)+nfSemantics mode t@(Semantics _ (FunCall _ (PatEval clauses))) ts = case instantiateClauses clauses ts of+ Just (t', ts') -> nfStep mode (apps t' ts')+ _ -> Apply t (nfs mode ts)+nfSemantics mode t@(Semantics _ At) (t1:t2:t3:t4:ts) = case (nf WHNF t3, nf WHNF t4) of+ (_, Apply (Semantics _ (Con (ICon ILeft))) _) -> nfStep mode (apps t1 ts)+ (_, Apply (Semantics _ (Con (ICon IRight))) _) -> nfStep mode (apps t2 ts)+ (Apply (Semantics _ (Con PCon)) [t3'], t4') -> nfStep mode $ apps t3' (t4':ts)+ (t3', t4') -> Apply t $ nfs mode (t1:t2:t3':t4':ts)+nfSemantics mode t@(Semantics _ Coe) (t1:t2:t3:t4:ts) =+ let t1' = nf WHNF t1+ t2' = nf NF t2+ t4' = nf NF t4+ isICon c (Apply (Semantics _ (Con (ICon c'))) _) = c == c'+ isICon _ _ = False+ r = Apply t $ if mode == WHNF then t1':t2':t3:t4':ts else nf mode t1' : t2' : nf mode t3 : t4' : map (nf mode) ts+ in case (t2' == t4' || isStationary t1', isICon ILeft t2' && isICon IRight t4',+ isICon IRight t2' && isICon ILeft t4', t1') of+ (True, _, _, _) -> nfStep mode (apps t3 ts)+ (_, True, _, (Apply (Semantics _ Iso) [_,_,c,_,_,_])) -> nfStep mode $ apps c (t3:ts)+ (_, _, True, (Apply (Semantics _ Iso) [_,_,_,c,_,_])) -> nfStep mode $ apps c (t3:ts)+ (_, b1, b2, _) | b1 || b2 -> case nf NF $ apps (fmap Free t1') [bvar] of+ Apply (Semantics _ Iso) [c1, c2, c3, c4, c5, c6, Var Bound []] -> case map sequenceA [c1,c2,c3,c4,c5,c6] of+ [Free{}, Free{}, Free c3', Free c4', Free{}, Free{}] -> nfStep mode $ apps (if b1 then c3' else c4') (t3:ts)+ _ -> r+ _ -> r+ _ -> r+nfSemantics mode t@(Semantics _ Iso) ts@[t1,t2,_,_,_,_,t7] = case nf WHNF t7 of+ Apply (Semantics _ (Con (ICon ILeft))) _ -> nfStep mode t1+ Apply (Semantics _ (Con (ICon IRight))) _ -> nfStep mode t2+ _ -> Apply t (nfs mode ts)+nfSemantics mode t@(Semantics _ Squeeze) [t1,t2] = case (nf WHNF t1, nf WHNF t2) of+ (Apply t@(Semantics _ (Con (ICon ILeft))) _, _) -> capply t+ (Apply (Semantics _ (Con (ICon IRight))) _, j) -> if mode == Step then j else nf mode j+ (_, Apply t@(Semantics _ (Con (ICon ILeft))) _) -> capply t+ (i, Apply (Semantics _ (Con (ICon IRight))) _) -> if mode == Step then i else nf mode i+ (t1',t2') -> Apply t $ nfs mode [t1',t2']+nfSemantics mode t@(Semantics _ (Case pats)) (term:terms) =+ let (terms1,terms2) = splitAt (length pats) terms+ in case instantiateCaseClauses (zipWith (\pat te -> ([pat], te)) pats terms1) [term] of+ Just (t', ts') -> nfStep mode $ apps t' (ts' ++ terms2)+ _ -> Apply t $ nfs mode (term:terms)+nfSemantics mode a as = Apply a (nfs mode as) -nfScope :: Eq a => Scope s Term a -> Scope s Term a-nfScope (ScopeTerm t) = ScopeTerm (nf NF t)-nfScope (Scope v s) = Scope v (nfScope s)+nfStep :: Eq a => NF -> Term Semantics a -> Term Semantics a+nfStep Step t = t+nfStep mode t = nf mode t -isStationary :: Eq a => Term a -> Bool-isStationary t = case sequenceA (nf NF $ App (fmap Free t) $ Var Bound) of- Free _ -> True- Bound -> False+nfType :: Eq a => NF -> Type Semantics a -> Type Semantics a+nfType mode (Type t lvl) = Type (nf mode t) lvl -nfs :: Eq a => NF -> [Term a] -> [Term a]-nfs NF terms = map (nf NF) terms-nfs _ terms = terms+isStationary :: Eq a => Term Semantics a -> Bool+isStationary t = case sequenceA $ nf NF $ apps (fmap Free t) [bvar] of+ Free _ -> True+ Bound -> False -instantiatePat :: Eq a => [Pattern c] -> Scope b Term a -> [Term a] -> Maybe (Term a, [Term a])-instantiatePat [] (ScopeTerm term) terms = Just (term, terms)-instantiatePat (PatternVar _ : pats) (Scope _ scope) (term:terms) = instantiatePat pats (instantiateScope term scope) terms-instantiatePat (PatternI con : pats) scope (term:terms) = case nf WHNF term of- ICon i | i == con -> instantiatePat pats scope terms- _ -> Nothing-instantiatePat (Pattern (PatternCon con _ _ _) pats1 : pats) scope (term:terms) = case nf WHNF term of- Con i _ n _ terms1 | i == con -> instantiatePat (pats1 ++ pats) scope (terms1 ++ terms)+nfs :: Eq a => NF -> [Term Semantics a] -> [Term Semantics a]+nfs WHNF terms = terms+nfs mode terms = map (nf mode) terms++instantiatePat :: Eq a => [Term (s, SCon) t] -> Term Semantics a -> [Term Semantics a] -> Maybe (Term Semantics a, [Term Semantics a])+instantiatePat [] Lambda{} _ = Nothing+instantiatePat [] term terms = Just (term, terms)+instantiatePat (Var{} : pats) (Lambda s) (term:terms) = instantiatePat pats (instantiate1 term s) terms+instantiatePat (Apply (_, con) pats1 : pats) s (term:terms) = case nf WHNF term of+ Apply (Semantics _ (Con con')) terms1 | con == con' && length pats1 == length terms1 ->+ instantiatePat (pats1 ++ pats) s (terms1 ++ terms) _ -> Nothing instantiatePat _ _ _ = Nothing -instantiateCases :: Eq a => [([Pattern c], Closed (Scope b Term))] -> [Term a] -> Maybe (Term a, [Term a])-instantiateCases clauses terms = msum $ map (\(pats, Closed scope) -> instantiatePat pats scope terms) clauses+instantiateClauses :: Eq a => [([Term (s, SCon) t], Closed (Term Semantics))]+ -> [Term Semantics a] -> Maybe (Term Semantics a, [Term Semantics a])+instantiateClauses clauses terms = msum $ map (\(pats, Closed s) -> instantiatePat pats s terms) clauses++instantiateCaseClauses :: Eq a => [([Term (s, SCon) t], Term Semantics a)]+ -> [Term Semantics a] -> Maybe (Term Semantics a, [Term Semantics a])+instantiateCaseClauses clauses terms = msum $ map (\(pats, s) -> instantiatePat pats s terms) clauses
src/REPL.hs view
@@ -8,38 +8,38 @@ import Control.Monad import Control.Monad.Trans import Text.PrettyPrint+import qualified Data.ByteString.Char8 as C+import Data.Bifunctor -import Syntax.BNFC.ParGrammar-import Syntax.BNFC.ErrM-import Syntax.Term+import Syntax+import Semantics+import Syntax.Parser import Syntax.PrettyPrinter import Syntax.ErrorDoc import TypeChecking.Monad import TypeChecking.Expressions+import TypeChecking.Expressions.Utils import Normalization -parseExpr :: Monad m => String -> TCM m (Term String)-parseExpr s = case pExpr (myLexer s) of- Bad err -> throwError [emsg err enull]- Ok expr -> liftM fst (typeCheck expr Nothing)--ep :: NF -> String -> ScopeM IO ()-ep mode str = do- mres <- runWarnT (parseExpr str)+ep :: [(Name,Fixity)] -> NF -> String -> ScopeT IO ()+ep tab mode str = do+ mres <- runWarnT $ do+ term <- pExpr tab (C.pack str)+ (term',_) <- typeCheck term Nothing+ return term' liftIO $ case mres of- ([], Nothing) -> return ()- ([], Just term) -> putStrLn $ render $ ppTerm (nf mode term)- (errs, _) -> mapM_ (hPutStrLn stderr . erender) errs+ ([], Just term) -> putStrLn $ render $ ppTerm $ first syntax (nf mode term)+ (errs, _) -> mapM_ (hPutStrLn stderr . erender . errorMsg) errs -processCmd :: String -> String -> ScopeM IO ()-processCmd "quit" _ = liftIO exitSuccess-processCmd "nf" str = ep NF str-processCmd "hnf" str = ep HNF str-processCmd "whnf" str = ep WHNF str-processCmd cmd _ = liftIO $ hPutStrLn stderr $ "Unknown command " ++ cmd+processCmd :: [(Name,Fixity)] -> String -> String -> ScopeT IO ()+processCmd _ "quit" _ = liftIO exitSuccess+processCmd tab "nf" str = ep tab NF str+processCmd tab "step" str = ep tab Step str+processCmd tab "whnf" str = ep tab WHNF str+processCmd _ cmd _ = liftIO $ hPutStrLn stderr $ "Unknown command " ++ cmd -repl :: ScopeM IO ()-repl = go ""+repl :: [(Name,Fixity)] -> ScopeT IO ()+repl tab = go "" where go last = do mline <- liftIO $ readline "> "@@ -49,5 +49,5 @@ ("",_) -> go last (c:cmd,line') -> do when (line /= last) $ liftIO (addHistory line)- if c == ':' then processCmd cmd line' else ep NF line+ if c == ':' then processCmd tab cmd line' else ep tab NF line go line
+ src/Semantics.hs view
@@ -0,0 +1,164 @@+{-# LANGUAGE FlexibleInstances #-}++module Semantics+ ( Semantics(..), Type(..)+ , SCon, SValue, SEval+ , cmpTerms, pcmpTerms+ , dropOnePi, iCon, universe+ , path, interval+ , module Syntax.Term+ ) where++import Prelude.Extras+import Data.Foldable(Foldable(..))+import Data.Traversable(Traversable,traverse,sequenceA,fmapDefault,foldMapDefault)+import Data.Bifunctor++import Syntax.Term+import qualified Syntax as S+import Semantics.Value++data Semantics = Semantics+ { syntax :: S.Syntax+ , value :: SValue+ }++type SCon = Con (Closed (Term Semantics))+type SValue = Value (Closed (Term Semantics))+type SEval = Eval (Closed (Term Semantics))++instance Eq Semantics where+ s1 == s2 = value s1 == value s2++data Type p a = Type { getType :: Term p a, getSort :: Sort }++instance Functor (Type p) where fmap = fmapDefault+instance Foldable (Type p) where foldMap = foldMapDefault++instance Traversable (Type p) where+ traverse f (Type t k) = fmap (\t' -> Type t' k) (traverse f t)++cmpTerms :: Eq a => Term Semantics (Either k a) -> Term Semantics (Either n a)+ -> (Bool, ([(k, Term Semantics a)], [(n, Term Semantics a)]))+cmpTerms (Var (Right a) as) (Var (Right a') as') = if a == a' then cmpTermsList as as' else (False, ([],[]))+cmpTerms (Var (Left k) []) t' = (True, (case sequenceA t' of { Left{} -> []; Right r -> [(k,r)] }, []))+cmpTerms t (Var (Left k) []) = (True, ([], case sequenceA t of { Left{} -> []; Right r -> [(k,r)] }))+cmpTerms (Var Left{} _) _ = (True, ([], []))+cmpTerms _ (Var Left{} _) = (True, ([], []))+cmpTerms (Lambda t) (Lambda t') = flowerResult $ cmpTerms (fmap sequenceA t) (fmap sequenceA t')+cmpTerms (Apply (Semantics (S.Lam (_:vs)) Lam) [Lambda t]) (Apply (Semantics (S.Lam (_:vs')) Lam) [Lambda t']) =+ flowerResult $ cmpTerms (Apply (Semantics (S.Lam vs) Lam) [fmap sequenceA t]) (Apply (Semantics (S.Lam vs') Lam) [fmap sequenceA t'])+cmpTerms (Apply (Semantics (S.Lam (_:vs)) Lam) [Lambda t]) t' =+ flowerResult $ cmpTerms (Apply (Semantics (S.Lam vs) Lam) [fmap sequenceA t]) (apps (fmap (sequenceA . Free) t') [fmap Right bvar])+cmpTerms (Apply (Semantics _ Lam) [t]) t' = cmpTerms t t'+cmpTerms t (Apply (Semantics (S.Lam (_:vs')) Lam) [Lambda t']) =+ flowerResult $ cmpTerms (apps (fmap (sequenceA . Free) t) [fmap Right bvar]) (Apply (Semantics (S.Lam vs') Lam) [fmap sequenceA t'])+cmpTerms t (Apply (Semantics _ Lam) [t']) = cmpTerms t t'+cmpTerms t@(Apply (Semantics _ Pi{}) _) t'@(Apply (Semantics _ Pi{}) _) = first (== Just EQ) (pcmpTerms t t')+cmpTerms (Apply (Semantics _ (Con PCon)) ts) (Apply (Semantics _ (Con PCon)) ts') = cmpTermsList ts ts'+cmpTerms (Apply (Semantics _ (Con PCon)) [Apply (Semantics _ Lam) [Lambda (Apply (Semantics _ At) [_, _, t, Var Bound []])]]) t' =+ flowerResult $ cmpTerms (fmap sequenceA t) (fmap (sequenceA . Free) t')+cmpTerms t (Apply (Semantics _ (Con PCon)) [Apply (Semantics _ Lam) [Lambda (Apply (Semantics _ At) [_, _, t', Var Bound []])]]) =+ flowerResult $ cmpTerms (fmap (sequenceA . Free) t) (fmap sequenceA t')+cmpTerms (Apply (Semantics _ At) (_:_:ts)) (Apply (Semantics _ At) (_:_:ts')) = cmpTermsList ts ts'+cmpTerms (Apply s ts) (Apply s' ts') = if s == s'+ then cmpTermsList ts ts'+ else (not (isInj $ value s) && hasLefts ts || not (isInj $ value s') && hasLefts ts', ([],[]))+ where+ isInj :: Value t -> Bool+ isInj Lam = True+ isInj Pi{} = True+ isInj (Con PCon{}) = True+ isInj (Con ICon{}) = True+ isInj (Con (DCon _ _ (PatEval []))) = True+ isInj (Con DCon{}) = False+ isInj CCon = True+ isInj FunCall{} = False+ isInj Universe{} = True+ isInj DataType{} = True+ isInj Interval{} = True+ isInj Path{} = True+ isInj At{} = False+ isInj Coe{} = False+ isInj Iso{} = False+ isInj Squeeze{} = False+ isInj Case{} = False+ + hasLefts :: [Term Semantics (Either k a)] -> Bool+ hasLefts = any $ \t -> case sequenceA t of+ Left{} -> True+ Right{} -> False+cmpTerms _ _ = (False,([],[]))++cmpTermsList :: Eq a => [Term Semantics (Either k a)] -> [Term Semantics (Either n a)]+ -> (Bool, ([(k, Term Semantics a)], [(n, Term Semantics a)]))+cmpTermsList as as' = bimap and (bimap concat concat . unzip) $ unzip (zipWith cmpTerms as as')++flowerResult :: (b, ([(k, Term Semantics (Scoped a))], [(n, Term Semantics (Scoped a))]))+ -> (b, ([(k, Term Semantics a)], [(n, Term Semantics a)]))+flowerResult (b, (t1,t2)) = (b, (lowerResult t1, lowerResult t2))++lowerResult :: [(k, Term Semantics (Scoped a))] -> [(k, Term Semantics a)]+lowerResult ts = ts >>= \(k,t) -> case sequenceA t of+ Free t' -> [(k,t')]+ Bound -> []++pcmpTerms :: Eq a => Term Semantics (Either k a) -> Term Semantics (Either n a)+ -> (Maybe Ordering, ([(k, Term Semantics a)], [(n, Term Semantics a)]))+pcmpTerms (Apply (Semantics (S.Pi e vs) p@Pi{}) [a, b@Lambda{}]) (Apply (Semantics (S.Pi e' vs') p'@Pi{}) [a', b'@Lambda{}]) =+ fcontraCovariant (pcmpTerms a a') (go vs a b vs' a' b')+ where+ go :: Eq a => [String] -> Term Semantics (Either k a) -> Term Semantics (Either k a)+ -> [String] -> Term Semantics (Either n a) -> Term Semantics (Either n a)+ -> (Maybe Ordering, ([(k, Term Semantics a)], [(n, Term Semantics a)]))+ go (_:vs) a (Lambda b) (_:vs') a' (Lambda b') = flowerResult $+ go vs (fmap (sequenceA . Free) a) (fmap sequenceA b) vs' (fmap (sequenceA . Free) a') (fmap sequenceA b')+ go vs a b@Lambda{} _ _ b' = pcmpTerms (Apply (Semantics (S.Pi e vs) p) [a, b]) b'+ go _ _ b vs' a' b'@Lambda{} = pcmpTerms b $ Apply (Semantics (S.Pi e' vs') p') [a', b']+ go _ _ b _ _ b' = pcmpTerms b b'+pcmpTerms (Apply (Semantics S.Pi{} p@Pi{}) [a, Lambda b]) (Apply (Semantics S.Pi{} p'@Pi{}) [a', b']) =+ fcontraCovariant (pcmpTerms a a') $ flowerResult $ pcmpTerms (fmap sequenceA b) (fmap (sequenceA . Free) b')+pcmpTerms (Apply (Semantics _ Pi{}) [a, b]) (Apply (Semantics _ Pi{}) [a', Lambda b']) =+ fcontraCovariant (pcmpTerms a a') $ flowerResult $ pcmpTerms (fmap (sequenceA . Free) b) (fmap sequenceA b')+pcmpTerms (Apply (Semantics _ Pi{}) [a, b]) (Apply (Semantics _ Pi{}) [a', b']) =+ fcontraCovariant (pcmpTerms a a') (pcmpTerms b b')+pcmpTerms (Apply (Semantics _ (Universe k)) _) (Apply (Semantics _ (Universe k')) _) = (pcompare k k', ([], []))+pcmpTerms t t' = first (\b -> if b then Just EQ else Nothing) (cmpTerms t t')++contraCovariant :: Maybe Ordering -> Maybe Ordering -> Maybe Ordering+contraCovariant (Just LT) (Just r) | r == EQ || r == GT = Just GT+contraCovariant (Just EQ) (Just r) = Just r+contraCovariant (Just GT) (Just r) | r == LT || r == EQ = Just LT+contraCovariant _ _ = Nothing++fcontraCovariant :: (Maybe Ordering, ([u],[v])) -> (Maybe Ordering, ([u],[v])) -> (Maybe Ordering, ([u],[v]))+fcontraCovariant (mo1,(us1,vs1)) (mo2,(us2,vs2)) = (contraCovariant mo1 mo2, (us1 ++ us2, vs1 ++ vs2))++instance Eq a => Eq (Term Semantics a) where+ t == t' = fst $ cmpTerms (fmap Right t) (fmap Right t')++instance Eq1 (Term Semantics) where (==#) = (==)++instance Eq a => Eq (Type Semantics a) where+ Type t _ == Type t' _ = t == t'++instance Eq a => POrd (Term Semantics a) where+ pcompare t t' = fst $ pcmpTerms (fmap Right t) (fmap Right t')++dropOnePi :: Semantics -> Term Semantics a -> Term Semantics a -> (String, Term Semantics (Scoped a))+dropOnePi (Semantics (S.Pi _ [v]) _) a (Lambda b) = (v, b)+dropOnePi (Semantics (S.Pi e (v:vs)) s) a (Lambda b) = (v, Apply (Semantics (S.Pi e vs) s) [fmap Free a, b])+dropOnePi _ _ b = ("_", fmap Free b)++iCon :: ICon -> Term Semantics a+iCon ILeft = capply $ Semantics (S.Name S.Prefix $ S.Ident "left") $ Con (ICon ILeft)+iCon IRight = capply $ Semantics (S.Name S.Prefix $ S.Ident "right") $ Con (ICon IRight)++path :: [Term Semantics a] -> Term Semantics a+path = Apply $ Semantics (S.Name S.Prefix $ S.Ident "path") (Con PCon)++interval :: Term Semantics a+interval = capply $ Semantics (S.Name S.Prefix $ S.Ident "I") Interval++universe :: Sort -> Term Semantics a+universe k = capply $ Semantics (S.Name S.Prefix $ S.Ident $ show k) (Universe k)
+ src/Semantics/Value.hs view
@@ -0,0 +1,147 @@+module Semantics.Value+ ( Value(..), Eval(..)+ , Level(..), level+ , Con(..), ICon(..)+ , ID, Sort(..)+ , POrd(..), DOrd(..), lessOrEqual+ ) where++import Syntax.Term++data Value t+ = Lam+ | Pi Sort Sort+ | Con (Con t)+ | CCon+ | FunCall ID (Eval t)+ | Universe Sort+ | DataType ID Int+ | Interval+ | Path Sort+ | At+ | Coe+ | Iso+ | Squeeze+ | Case [Term (String, Con t) String]++data Con t = DCon Int Int (Eval t) | PCon | ICon ICon+data ICon = ILeft | IRight deriving Eq++data Eval t = SynEval t | PatEval [([Term (String, Con t) String], t)]++type ID = Int+data Level = Level Int | NoLevel+data Sort = TypeK Level | Set Level | Prop | Contr deriving Eq++instance Eq (Value t) where+ Lam == Lam = True+ Pi{} == Pi{} = True+ Con c == Con c' = c == c'+ CCon == CCon = True+ FunCall n _ == FunCall n' _ = n == n'+ Universe k == Universe k' = k == k'+ DataType n _ == DataType n' _ = n == n'+ Interval == Interval = True+ Path{} == Path{} = True+ At == At = True+ Coe == Coe = True+ Iso == Iso = True+ Squeeze == Squeeze = True+ Case pats == Case pats' = and (zipWith cmpPats pats pats')+ where+ cmpPats :: Term (s, Con t) u -> Term (s', Con t) u' -> Bool+ cmpPats Var{} Var{} = True+ cmpPats (Apply (_,c) pats) (Apply (_,c') pats') = c == c' && and (zipWith cmpPats pats pats')+ cmpPats _ _ = False+ _ == _ = False++instance Eq (Con t) where+ DCon i _ _ == DCon i' _ _ = i == i'+ ICon c == ICon c' = c == c'+ PCon == PCon = True+ _ == _ = False++instance Eq Level where+ l1 == l2 = level l1 == level l2++instance Ord Level where+ compare l1 l2 = compare (level l1) (level l2)++instance Show Level where+ show NoLevel = ""+ show (Level l) = show l++instance Read Level where+ readsPrec _ s = case reads s of+ [] -> [(NoLevel, s)]+ is -> map (\(i,r) -> (Level i, r)) is++instance Enum Level where+ toEnum 0 = NoLevel+ toEnum n = Level n+ fromEnum = level++level :: Level -> Int+level (Level l) = l+level NoLevel = 0++class POrd a where+ pcompare :: a -> a -> Maybe Ordering++class POrd a => DOrd a where+ dmax :: a -> a -> a+ dmaximum :: [a] -> a+ dmaximum [] = error "dmaximum: empty list"+ dmaximum xs = foldl1 dmax xs++lessOrEqual :: POrd a => a -> a -> Bool+lessOrEqual t t' = case pcompare t t' of+ Just r | r == EQ || r == LT -> True+ _ -> False++instance POrd Sort where+ pcompare Contr Contr = Just EQ+ pcompare Contr _ = Just LT+ pcompare _ Contr = Just GT+ pcompare Prop Prop = Just EQ+ pcompare Prop _ = Just LT+ pcompare _ Prop = Just GT+ pcompare (Set a) (Set b) = Just (compare a b)+ pcompare (TypeK a) (TypeK b) = Just (compare a b)+ pcompare (Set a) (TypeK b) = if a <= b then Just LT else Nothing+ pcompare (TypeK a) (Set b) = if a >= b then Just GT else Nothing++instance DOrd Sort where+ dmax a b = case pcompare a b of+ Just LT -> b+ Just _ -> a+ Nothing -> case (a, b) of+ (Set l1, TypeK l2) -> TypeK (max l1 l2)+ (TypeK l1, Set l2) -> TypeK (max l1 l2)+ _ -> a+ dmaximum [] = TypeK NoLevel+ dmaximum ks = foldl1 dmax ks++instance Show Sort where+ show Contr = "Contr"+ show Prop = "Prop"+ show (Set a) = "Set" ++ show a+ show (TypeK a) = "Type" ++ show a++instance Read Sort where+ readsPrec _ ('C':'o':'n':'t':'r':s) = [(Contr,s)]+ readsPrec _ ('P':'r':'o':'p':s) = [(Prop,s)]+ readsPrec _ ('S':'e':'t':s) = map (\(l,s) -> (Set l, s)) (reads s)+ readsPrec _ ('T':'y':'p':'e':s) = map (\(l,s) -> (TypeK l, s)) (reads s)+ readsPrec _ _ = []++instance Enum Sort where+ succ Contr = Prop+ succ Prop = Set NoLevel+ succ (Set l) = TypeK (succ l)+ succ (TypeK l) = TypeK (succ l)+ toEnum n = TypeK (toEnum n)+ fromEnum Contr = -2+ fromEnum Prop = -1+ fromEnum (Set l) = fromEnum l+ fromEnum (TypeK l) = fromEnum l
+ src/Syntax.hs view
@@ -0,0 +1,70 @@+module Syntax+ ( Syntax(..), Explicit(..)+ , RawExpr, PIdent(..)+ , Clause(..), Con(..)+ , Import, Def(..), Tele(..)+ , Infix(..), Fixity(..)+ , Posn, Name(..), PName+ , nameToString, nameToInfix, nameToPrefix+ , module Syntax.Term+ ) where++import Data.Void++import Syntax.Term++data PIdent = PIdent { getPos :: Posn, getName :: String }+data Clause = Clause PName [Term PName Void] RawExpr+type Import = [String]+data Tele = VarsTele [PIdent] RawExpr | TypeTele RawExpr+data Con = ConDef PIdent [Tele]+data Infix = InfixL | InfixR | InfixNA deriving Eq+data Fixity = Infix Infix Int | Prefix deriving Eq++type Posn = (Int, Int)+data Name = Ident String | Operator String deriving Eq+type PName = (Posn, Name)++data Def+ = DefType PName RawExpr+ | DefFun PName [Term PName Void] (Maybe RawExpr)+ | DefData PName [Tele] [Con] [Clause]+ | DefImport Import+ | DefFixity Posn Infix Int [Name]++data Syntax+ = Lam [String]+ | Pi Explicit [String]+ | PathImp+ | At+ | Name Fixity Name+ | Case [Term PName String]+ | Null++data Explicit = Explicit | Implicit deriving Eq++type RawExpr = Term (Posn, Syntax) Void++instance Eq PIdent where+ PIdent _ s == PIdent _ s' = s == s'++instance Show Infix where+ show InfixL = "infixl"+ show InfixR = "infixr"+ show InfixNA = "infix"++instance Show Fixity where+ show (Infix ia p) = show ia ++ " " ++ show p+ show Prefix = "prefix"++nameToString :: Name -> String+nameToString (Ident s) = s+nameToString (Operator s) = s++nameToInfix :: Name -> String+nameToInfix (Ident s) = "`" ++ s ++ "`"+nameToInfix (Operator s) = s++nameToPrefix :: Name -> String+nameToPrefix (Ident s) = s+nameToPrefix (Operator s) = "(" ++ s ++ ")"
− src/Syntax/BNFC/LexGrammar.x
@@ -1,209 +0,0 @@--- -*- haskell -*---- This Alex file was machine-generated by the BNF converter-{-{-# OPTIONS -fno-warn-incomplete-patterns #-}-{-# OPTIONS_GHC -w #-}-module Syntax.BNFC.LexGrammar where----import qualified Data.Bits-import Data.Word (Word8)-}---$l = [a-zA-Z\192 - \255] # [\215 \247] -- isolatin1 letter FIXME-$c = [A-Z\192-\221] # [\215] -- capital isolatin1 letter FIXME-$s = [a-z\222-\255] # [\247] -- small isolatin1 letter FIXME-$d = [0-9] -- digit-$i = [$l $d _ '] -- identifier character-$u = [\0-\255] -- universal: any character--@rsyms = -- symbols and non-identifier-like reserved words- \: | \= | \{ | \} | \; | \) | \| | \- \> | \@--:--"--" [.]* ; -- Toss single line comments-"{-" ([$u # \-] | \- [$u # \}])* ("-")+ "}" ; --$white+ ;-@rsyms { tok (\p s -> PT p (eitherResIdent (TV . share) s)) }-T y p e $d * { tok (\p s -> PT p (eitherResIdent (T_U . share) s)) }-I { tok (\p s -> PT p (eitherResIdent (T_I . share) s)) }-l e f t { tok (\p s -> PT p (eitherResIdent (T_PLeft . share) s)) }-r i g h t { tok (\p s -> PT p (eitherResIdent (T_PRight . share) s)) }-P a t h { tok (\p s -> PT p (eitherResIdent (T_PPath . share) s)) }-p a t h { tok (\p s -> PT p (eitherResIdent (T_Ppath . share) s)) }-c o e { tok (\p s -> PT p (eitherResIdent (T_PCoe . share) s)) }-i s o { tok (\p s -> PT p (eitherResIdent (T_PIso . share) s)) }-s q u e e z e { tok (\p s -> PT p (eitherResIdent (T_PSqueeze . share) s)) }-\\ { tok (\p s -> PT p (eitherResIdent (T_PLam . share) s)) }-\( { tok (\p s -> PT p (eitherResIdent (T_PPar . share) s)) }-\_ { tok (\p s -> PT p (eitherResIdent (T_Pus . share) s)) }-$l ($l | $d | \' | \_ | \-)* { tok (\p s -> PT p (eitherResIdent (T_PIdent . share) s)) }--$l $i* { tok (\p s -> PT p (eitherResIdent (TV . share) s)) }------{--tok f p s = f p s--share :: String -> String-share = id--data Tok =- TS !String !Int -- reserved words and symbols- | TL !String -- string literals- | TI !String -- integer literals- | TV !String -- identifiers- | TD !String -- double precision float literals- | TC !String -- character literals- | T_U !String- | T_I !String- | T_PLeft !String- | T_PRight !String- | T_PPath !String- | T_Ppath !String- | T_PCoe !String- | T_PIso !String- | T_PSqueeze !String- | T_PLam !String- | T_PPar !String- | T_Pus !String- | T_PIdent !String-- deriving (Eq,Show,Ord)--data Token = - PT Posn Tok- | Err Posn- deriving (Eq,Show,Ord)--tokenPos (PT (Pn _ l _) _ :_) = "line " ++ show l-tokenPos (Err (Pn _ l _) :_) = "line " ++ show l-tokenPos _ = "end of file"--tokenPosn (PT p _) = p-tokenPosn (Err p) = p-tokenLineCol = posLineCol . tokenPosn-posLineCol (Pn _ l c) = (l,c)-mkPosToken t@(PT p _) = (posLineCol p, prToken t)--prToken t = case t of- PT _ (TS s _) -> s- PT _ (TL s) -> s- PT _ (TI s) -> s- PT _ (TV s) -> s- PT _ (TD s) -> s- PT _ (TC s) -> s- PT _ (T_U s) -> s- PT _ (T_I s) -> s- PT _ (T_PLeft s) -> s- PT _ (T_PRight s) -> s- PT _ (T_PPath s) -> s- PT _ (T_Ppath s) -> s- PT _ (T_PCoe s) -> s- PT _ (T_PIso s) -> s- PT _ (T_PSqueeze s) -> s- PT _ (T_PLam s) -> s- PT _ (T_PPar s) -> s- PT _ (T_Pus s) -> s- PT _ (T_PIdent s) -> s---data BTree = N | B String Tok BTree BTree deriving (Show)--eitherResIdent :: (String -> Tok) -> String -> Tok-eitherResIdent tv s = treeFind resWords- where- treeFind N = tv s- treeFind (B a t left right) | s < a = treeFind left- | s > a = treeFind right- | s == a = t--resWords = b "@" 6 (b ":" 3 (b "->" 2 (b ")" 1 N N) N) (b "=" 5 (b ";" 4 N N) N)) (b "{" 9 (b "with" 8 (b "data" 7 N N) N) (b "}" 11 (b "|" 10 N N) N))- where b s n = let bs = id s- in B bs (TS bs n)--unescapeInitTail :: String -> String-unescapeInitTail = id . unesc . tail . id where- unesc s = case s of- '\\':c:cs | elem c ['\"', '\\', '\''] -> c : unesc cs- '\\':'n':cs -> '\n' : unesc cs- '\\':'t':cs -> '\t' : unesc cs- '"':[] -> []- c:cs -> c : unesc cs- _ -> []------------------------------------------------------------------------ Alex wrapper code.--- A modified "posn" wrapper.----------------------------------------------------------------------data Posn = Pn !Int !Int !Int- deriving (Eq, Show,Ord)--alexStartPos :: Posn-alexStartPos = Pn 0 1 1--alexMove :: Posn -> Char -> Posn-alexMove (Pn a l c) '\t' = Pn (a+1) l (((c+7) `div` 8)*8+1)-alexMove (Pn a l c) '\n' = Pn (a+1) (l+1) 1-alexMove (Pn a l c) _ = Pn (a+1) l (c+1)--type Byte = Word8--type AlexInput = (Posn, -- current position,- Char, -- previous char- [Byte], -- pending bytes on the current char- String) -- current input string--tokens :: String -> [Token]-tokens str = go (alexStartPos, '\n', [], str)- where- go :: AlexInput -> [Token]- go inp@(pos, _, _, str) =- case alexScan inp 0 of- AlexEOF -> []- AlexError (pos, _, _, _) -> [Err pos]- AlexSkip inp' len -> go inp'- AlexToken inp' len act -> act pos (take len str) : (go inp')--alexGetByte :: AlexInput -> Maybe (Byte,AlexInput)-alexGetByte (p, c, (b:bs), s) = Just (b, (p, c, bs, s))-alexGetByte (p, _, [], s) =- case s of- [] -> Nothing- (c:s) ->- let p' = alexMove p c- (b:bs) = utf8Encode c- in p' `seq` Just (b, (p', c, bs, s))--alexInputPrevChar :: AlexInput -> Char-alexInputPrevChar (p, c, bs, s) = c-- -- | Encode a Haskell String to a list of Word8 values, in UTF8 format.-utf8Encode :: Char -> [Word8]-utf8Encode = map fromIntegral . go . ord- where- go oc- | oc <= 0x7f = [oc]-- | oc <= 0x7ff = [ 0xc0 + (oc `Data.Bits.shiftR` 6)- , 0x80 + oc Data.Bits..&. 0x3f- ]-- | oc <= 0xffff = [ 0xe0 + (oc `Data.Bits.shiftR` 12)- , 0x80 + ((oc `Data.Bits.shiftR` 6) Data.Bits..&. 0x3f)- , 0x80 + oc Data.Bits..&. 0x3f- ]- | otherwise = [ 0xf0 + (oc `Data.Bits.shiftR` 18)- , 0x80 + ((oc `Data.Bits.shiftR` 12) Data.Bits..&. 0x3f)- , 0x80 + ((oc `Data.Bits.shiftR` 6) Data.Bits..&. 0x3f)- , 0x80 + oc Data.Bits..&. 0x3f- ]-}
− src/Syntax/BNFC/ParGrammar.y
@@ -1,215 +0,0 @@--- This Happy file was machine-generated by the BNF converter-{-{-# OPTIONS_GHC -fno-warn-incomplete-patterns -fno-warn-overlapping-patterns #-}-module Syntax.BNFC.ParGrammar where-import Syntax.BNFC.AbsGrammar-import Syntax.BNFC.LexGrammar-import Syntax.BNFC.ErrM--}--%name pDefs Defs-%name pExpr Expr---- no lexer declaration-%monad { Err } { thenM } { returnM }-%tokentype { Token }--%token - ')' { PT _ (TS _ 1) }- '->' { PT _ (TS _ 2) }- ':' { PT _ (TS _ 3) }- ';' { PT _ (TS _ 4) }- '=' { PT _ (TS _ 5) }- '@' { PT _ (TS _ 6) }- 'data' { PT _ (TS _ 7) }- 'with' { PT _ (TS _ 8) }- '{' { PT _ (TS _ 9) }- '|' { PT _ (TS _ 10) }- '}' { PT _ (TS _ 11) }--L_U { PT _ (T_U _) }-L_I { PT _ (T_I _) }-L_PLeft { PT _ (T_PLeft _) }-L_PRight { PT _ (T_PRight _) }-L_PPath { PT _ (T_PPath _) }-L_Ppath { PT _ (T_Ppath _) }-L_PCoe { PT _ (T_PCoe _) }-L_PIso { PT _ (T_PIso _) }-L_PSqueeze { PT _ (T_PSqueeze _) }-L_PLam { PT _ (T_PLam _) }-L_PPar { PT _ (T_PPar _) }-L_Pus { PT _ (T_Pus _) }-L_PIdent { PT _ (T_PIdent _) }-L_err { _ }---%%--U :: { U} : L_U { U (mkPosToken $1)}-I :: { I} : L_I { I (mkPosToken $1)}-PLeft :: { PLeft} : L_PLeft { PLeft (mkPosToken $1)}-PRight :: { PRight} : L_PRight { PRight (mkPosToken $1)}-PPath :: { PPath} : L_PPath { PPath (mkPosToken $1)}-Ppath :: { Ppath} : L_Ppath { Ppath (mkPosToken $1)}-PCoe :: { PCoe} : L_PCoe { PCoe (mkPosToken $1)}-PIso :: { PIso} : L_PIso { PIso (mkPosToken $1)}-PSqueeze :: { PSqueeze} : L_PSqueeze { PSqueeze (mkPosToken $1)}-PLam :: { PLam} : L_PLam { PLam (mkPosToken $1)}-PPar :: { PPar} : L_PPar { PPar (mkPosToken $1)}-Pus :: { Pus} : L_Pus { Pus (mkPosToken $1)}-PIdent :: { PIdent} : L_PIdent { PIdent (mkPosToken $1)}--Defs :: { Defs }-Defs : ListDef { Defs $1 } ---Def :: { Def }-Def : PIdent ':' Expr { DefType $1 $3 } - | FunCase { DefFun $1 }- | Pattern { DefFunEmpty $1 }- | 'data' PIdent ListDataTele '=' ListCon { DefData $2 (reverse $3) $5 }- | 'data' PIdent ListDataTele '=' ListCon 'with' '{' ListFunCase '}' { DefDataWith $2 (reverse $3) $5 $8 }- | 'data' PIdent ListDataTele { DefDataEmpty $2 (reverse $3) }---ListDef :: { [Def] }-ListDef : {- empty -} { [] } - | Def { (:[]) $1 }- | Def ';' ListDef { (:) $1 $3 }---FunCase :: { FunCase }-FunCase : Pattern '=' Expr { FunCase $1 $3 } ---ListFunCase :: { [FunCase] }-ListFunCase : {- empty -} { [] } - | FunCase { (:[]) $1 }- | FunCase ';' ListFunCase { (:) $1 $3 }---Pattern :: { Pattern }-Pattern : PIdent ListParPat { Pattern $1 (reverse $2) } ---ParPat :: { ParPat }-ParPat : Arg { ParVar $1 } - | PLeft { ParLeft $1 }- | PRight { ParRight $1 }- | PPar ')' { ParEmpty $1 }- | PPar Pattern ')' { ParPat $1 $2 }---ListParPat :: { [ParPat] }-ListParPat : {- empty -} { [] } - | ListParPat ParPat { flip (:) $1 $2 }---Con :: { Con }-Con : PIdent ListConTele { Con $1 (reverse $2) } ---ListCon :: { [Con] }-ListCon : Con { (:[]) $1 } - | Con '|' ListCon { (:) $1 $3 }---ConTele :: { ConTele }-ConTele : PPar Expr ':' Expr ')' { VarTele $1 $2 $4 } - | Expr5 { TypeTele $1 }---ListConTele :: { [ConTele] }-ListConTele : {- empty -} { [] } - | ListConTele ConTele { flip (:) $1 $2 }---DataTele :: { DataTele }-DataTele : PPar Expr ':' Expr ')' { DataTele $1 $2 $4 } ---ListDataTele :: { [DataTele] }-ListDataTele : {- empty -} { [] } - | ListDataTele DataTele { flip (:) $1 $2 }---PiTele :: { PiTele }-PiTele : PPar Expr ':' Expr ')' { PiTele $1 $2 $4 } ---ListPiTele :: { [PiTele] }-ListPiTele : PiTele { (:[]) $1 } - | PiTele ListPiTele { (:) $1 $2 }---Expr :: { Expr }-Expr : PLam ListArg '->' Expr { Lam $1 $2 $4 } - | Expr1 { $1 }---Expr1 :: { Expr }-Expr1 : Expr2 '->' Expr1 { Arr $1 $3 } - | ListPiTele '->' Expr1 { Pi $1 $3 }- | Expr2 { $1 }---Expr2 :: { Expr }-Expr2 : Expr3 '=' Expr3 { PathImp $1 $3 } - | Expr3 { $1 }---Expr3 :: { Expr }-Expr3 : Expr3 '@' Expr4 { At $1 $3 } - | Expr4 { $1 }---Expr4 :: { Expr }-Expr4 : Expr4 Expr5 { App $1 $2 } - | Expr5 { $1 }---Expr5 :: { Expr }-Expr5 : Arg { Var $1 } - | U { Universe $1 }- | I { Interval $1 }- | PLeft { ELeft $1 }- | PRight { ERight $1 }- | PPath { Path $1 }- | Ppath { PathCon $1 }- | PCoe { Coe $1 }- | PIso { Iso $1 }- | PSqueeze { Squeeze $1 }- | PPar Expr ')' { Paren $1 $2 }---Arg :: { Arg }-Arg : PIdent { Arg $1 } - | Pus { NoArg $1 }---ListArg :: { [Arg] }-ListArg : Arg { (:[]) $1 } - | Arg ListArg { (:) $1 $2 }----{--returnM :: a -> Err a-returnM = return--thenM :: Err a -> (a -> Err b) -> Err b-thenM = (>>=)--happyError :: [Token] -> Err a-happyError ts =- Bad $ "syntax error at " ++ tokenPos ts ++ - case ts of- [] -> []- [Err _] -> " due to lexer error"- _ -> " before " ++ unwords (map (id . prToken) (take 4 ts))--myLexer = tokens-}-
− src/Syntax/Expr.hs
@@ -1,43 +0,0 @@-module Syntax.Expr- ( module Syntax.BNFC.AbsGrammar- , getPos, argGetPos, parPatGetPos- , unArg- ) where--import Syntax.BNFC.AbsGrammar--getPos :: Expr -> (Int,Int)-getPos (Lam (PLam (p,_)) _ _) = p-getPos (Arr e _) = getPos e-getPos (Pi [] e) = getPos e-getPos (Pi (PiTele (PPar (p,_)) _ _ : _) _) = p-getPos (App e _) = getPos e-getPos (Var (Arg (PIdent (p,_)))) = p-getPos (Var (NoArg (Pus (p,_)))) = p-getPos (Universe (U (p,_))) = p-getPos (Paren (PPar (p,_)) _) = p-getPos (PathImp e _) = getPos e-getPos (Interval (I (p,_))) = p-getPos (ELeft (PLeft (p,_))) = p-getPos (ERight (PRight (p,_))) = p-getPos (Path (PPath (p,_))) = p-getPos (PathCon (Ppath (p,_))) = p-getPos (At e _) = getPos e-getPos (Coe (PCoe (p,_))) = p-getPos (Iso (PIso (p,_))) = p-getPos (Squeeze (PSqueeze (p,_))) = p--argGetPos :: Arg -> (Int,Int)-argGetPos (Arg (PIdent (p,_))) = p-argGetPos (NoArg (Pus (p,_))) = p--parPatGetPos :: ParPat -> (Int,Int)-parPatGetPos (ParVar arg) = argGetPos arg-parPatGetPos (ParEmpty (PPar (p,_))) = p-parPatGetPos (ParPat (PPar (p,_)) _) = p-parPatGetPos (ParLeft (PLeft (p,_))) = p-parPatGetPos (ParRight (PRight (p,_))) = p--unArg :: Arg -> String-unArg NoArg{} = "_"-unArg (Arg (PIdent (_,s))) = s
− src/Syntax/Grammar.cf
@@ -1,81 +0,0 @@-entrypoints Defs, Expr;--comment "--";-comment "{-" "-}";--layout "with";-layout toplevel;--Defs. Defs ::= [Def];-DefType. Def ::= PIdent ":" Expr;-DefFun. Def ::= FunCase;-DefFunEmpty. Def ::= Pattern;-DefData. Def ::= "data" PIdent [DataTele] "=" [Con];-DefDataWith. Def ::= "data" PIdent [DataTele] "=" [Con] "with" "{" [FunCase] "}";-DefDataEmpty. Def ::= "data" PIdent [DataTele];-separator Def ";";--FunCase. FunCase ::= Pattern "=" Expr;-separator FunCase ";";--Pattern. Pattern ::= PIdent [ParPat];-ParVar. ParPat ::= Arg;-ParLeft. ParPat ::= PLeft;-ParRight. ParPat ::= PRight;-ParEmpty. ParPat ::= PPar ")";-ParPat. ParPat ::= PPar Pattern ")";-terminator ParPat "";--Con. Con ::= PIdent [ConTele];-separator nonempty Con "|";--VarTele. ConTele ::= PPar Expr ":" Expr ")";-TypeTele. ConTele ::= Expr5;-terminator ConTele "";--DataTele. DataTele ::= PPar Expr ":" Expr ")";-terminator DataTele "";--PiTele. PiTele ::= PPar Expr ":" Expr ")";-terminator nonempty PiTele "";--Lam. Expr ::= PLam [Arg] "->" Expr;-Arr. Expr1 ::= Expr2 "->" Expr1;-Pi. Expr1 ::= [PiTele] "->" Expr1;-PathImp. Expr2 ::= Expr3 "=" Expr3;-At. Expr3 ::= Expr3 "@" Expr4;-App. Expr4 ::= Expr4 Expr5;-Var. Expr5 ::= Arg;-Universe. Expr5 ::= U;-Interval. Expr5 ::= I;-ELeft. Expr5 ::= PLeft;-ERight. Expr5 ::= PRight;-Path. Expr5 ::= PPath;-PathCon. Expr5 ::= Ppath;-Coe. Expr5 ::= PCoe;-Iso. Expr5 ::= PIso;-Squeeze. Expr5 ::= PSqueeze;-_. Expr ::= Expr1;-_. Expr1 ::= Expr2;-_. Expr2 ::= Expr3;-_. Expr3 ::= Expr4;-_. Expr4 ::= Expr5;-Paren. Expr5 ::= PPar Expr ")";--Arg. Arg ::= PIdent;-NoArg. Arg ::= Pus;-separator nonempty Arg "";--position token U ('T' 'y' 'p' 'e' digit*);-position token I 'I';-position token PLeft 'l' 'e' 'f' 't';-position token PRight 'r' 'i' 'g' 'h' 't';-position token PPath 'P' 'a' 't' 'h';-position token Ppath 'p' 'a' 't' 'h';-position token PCoe 'c' 'o' 'e';-position token PIso 'i' 's' 'o';-position token PSqueeze 's' 'q' 'u' 'e' 'e' 'z' 'e';-position token PLam '\\';-position token PPar '(';-position token Pus '_';-position token PIdent (letter(letter|digit|'\''|'_'|'-')*);
+ src/Syntax/Parser.hs view
@@ -0,0 +1,85 @@+module Syntax.Parser+ ( pDefs, pExpr+ , fixFixity, fixFixityDef+ ) where++import Data.Maybe+import Control.Monad.State+import qualified Data.ByteString as B++import Syntax+import Syntax.ErrorDoc+import Syntax.Parser.Lexer+import qualified Syntax.Parser.Parser as P+import TypeChecking.Monad.Warn+import TypeChecking.Expressions.Utils++pDefs :: Monad m => B.ByteString -> WarnT [Error] m [Def]+pDefs = liftM reverse . runParser P.pDefs++pExpr :: Monad m => [(Name,Fixity)] -> B.ByteString -> WarnT [Error] m RawExpr+pExpr tab str = runParser P.pExpr str >>= fixFixity tab++runParser :: Monad m => Parser a -> B.ByteString -> WarnT [Error] m a+runParser p s = case evalState (runWarnT $ p ((1, 1), s)) [Layout 1] of+ (errs, Nothing) -> throwError (mapErrs errs)+ (errs, Just a) -> warn (mapErrs errs) >> return a+ where+ mapErrs = map $ \(pos, err) -> Error Other $ emsgLC pos err enull++data Tree p a = Branch Fixity Name Syntax (Tree p a) (Tree p a) | Leaf (Term (p, Syntax) a)++fixFixity :: Monad m => [(Name,Fixity)] -> Term (Posn, Syntax) a -> WarnT [Error] m (Term (Posn, Syntax) a)+fixFixity tab = go+ where+ go :: Monad m => Term (Posn, Syntax) a -> WarnT [Error] m (Term (Posn, Syntax) a)+ go = liftM treeToExpr . exprToTree+ + exprToTree :: Monad m => Term (Posn, Syntax) a -> WarnT [Error] m (Tree Posn a)+ exprToTree (Var a ts) = liftM (Leaf . Var a) (mapM go ts)+ exprToTree (Lambda t) = liftM (Leaf . Lambda) (go t)+ exprToTree (Apply (_, Name Infix{} s) [t1, t2]) = do+ t1' <- exprToTree t1+ t2' <- go t2+ let ft = fromMaybe (Infix InfixL 90) (lookup s tab)+ branch ft s (Name ft s) t1' (Leaf t2')+ exprToTree (Apply (_, At) [t1,t2]) = do+ t1' <- exprToTree t1+ t2' <- go t2+ branch (Infix InfixL 90) (Operator "@") At t1' (Leaf t2')+ exprToTree (Apply (_, Null) (t:ts)) = liftM Leaf $ go (apps t ts)+ exprToTree (Apply s ts) = liftM (Leaf . Apply s) (mapM go ts)+ + treeToExpr :: Tree Posn a -> Term (Posn, Syntax) a+ treeToExpr (Leaf t) = t+ treeToExpr (Branch ft _ s t1 t2) =+ let t1' = treeToExpr t1+ in Apply (termPos t1', s) [t1', treeToExpr t2]+ + branch :: Monad m => Fixity -> Name -> Syntax -> Tree Posn a -> Tree Posn a -> WarnT [Error] m (Tree Posn a)+ branch ft@(Infix ia p) n s (Branch ft'@(Infix ia' p') n' s' a1 a2) b | p' < p || p == p' && ia == InfixR && ia' == InfixR = do+ a2' <- branch ft n s a2 b+ return (Branch ft' n' s' a1 a2')+ branch ft@(Infix ia p) n s a@(Branch ft'@(Infix ia' p') n' _ _ _) b | p == p' && not (ia == InfixL && ia' == InfixL) = do+ let showOp ft'' s'' = nameToInfix s'' ++ " [" ++ show ft'' ++ "]"+ msg = "Precedence parsing error: cannot mix " ++ showOp ft n +++ " and " ++ showOp ft' n' ++ " in the same infix expression"+ warn [Error Other $ emsgLC (termPos $ treeToExpr a) msg enull]+ return (Branch ft n s a b)+ branch ft name syn a b = return (Branch ft name syn a b)++fixFixityDef :: Monad m => [(Name,Fixity)] -> Def -> WarnT [Error] m Def+fixFixityDef tab (DefType name expr) = liftM (DefType name) (fixFixity tab expr)+fixFixityDef tab (DefFun name pats (Just expr)) = liftM (DefFun name pats . Just) (fixFixity tab expr)+fixFixityDef _ d@DefFun{} = return d+fixFixityDef tab (DefData name params cons clauses) = do+ params' <- forM params (fixFixityTele tab)+ cons' <- forM cons $ \(ConDef con teles) -> liftM (ConDef con) $ forM teles (fixFixityTele tab)+ clauses' <- forM clauses $ \(Clause name pats expr) -> liftM (Clause name pats) (fixFixity tab expr)+ return (DefData name params' cons' clauses')+fixFixityDef _ d@DefImport{} = return d+fixFixityDef _ d@DefFixity{} = return d++fixFixityTele :: Monad m => [(Name,Fixity)] -> Tele -> WarnT [Error] m Tele+fixFixityTele tab (VarsTele vars expr) = liftM (VarsTele vars) (fixFixity tab expr)+fixFixityTele tab (TypeTele expr) = liftM TypeTele (fixFixity tab expr)
+ src/Syntax/Parser/Lexer.x view
@@ -0,0 +1,164 @@+{+module Syntax.Parser.Lexer+ ( alexScanTokens+ , Token(..), tokGetPos+ , Parser, ParserErr+ , Layout(..)+ ) where++import Data.Word+import Data.Char(isAlpha,isSpace)+import qualified Data.ByteString as B+import qualified Data.ByteString.Char8 as C+import Control.Monad.State++import TypeChecking.Monad.Warn+import Syntax+}++$alpha = [a-zA-Z]+$digit = [0-9]+$any = [\x00-\x10ffff]+$operator = [\~\!\@\#\$\%\^\&\*\-\+\=\|\?\<\>\,\.\/\:\;\[\]\{\}]+@ident = ($alpha | \_) ($alpha | $digit | \' | \- | \_)*+@lcomm = "--".*+@mcomm = "{-" ([$any # \-] | \- [$any # \}])* "-}"+@skip = $white | @lcomm | @mcomm+@newline = \n @skip*+@with = "with" @skip*+@of = "of" @skip*+@import = "import" $white+ @ident ("." @ident)*++:-++[$white # \n]+;+@lcomm;+@mcomm;++@import { \_ s -> TokImport $ breaks '.' $+ dropWhile (\c -> not (isAlpha c) && c /= '_') (drop 6 s) }+"data" { \_ _ -> TokData }+"case" { \p _ -> TokCase p }+@of { \_ _ -> TokOf 0 }+@with { \_ _ -> TokWith 0 }+\\ { \p _ -> TokLam p }+\( { \p _ -> TokLParen p }+\: { \_ _ -> TokColon }+\= { \_ _ -> TokEquals }+\{ { \p _ -> TokLBrace p }+\} { \_ _ -> TokRBrace }+\; { \_ _ -> TokSemicolon }+\) { \_ _ -> TokRParen }+\| { \_ _ -> TokPipe }+\@ { \_ _ -> TokAt }+\` { \_ _ -> TokApos }+"->" { \_ _ -> TokArrow }+$operator+ { \p s -> TokOperator (PIdent p s) }+$digit+ { \p s -> TokInteger (p, read s) }+"infixl" { \p _ -> TokInfix (p, InfixL) }+"infixr" { \p _ -> TokInfix (p, InfixR) }+"infix" { \p _ -> TokInfix (p, InfixNA) }+@ident { \p s -> TokIdent (PIdent p s) }+@newline { \_ _ -> TokNewLine }++{+data Token+ = TokIdent !PIdent+ | TokOperator !PIdent+ | TokLam !Posn+ | TokLParen !Posn+ | TokImport ![String]+ | TokData+ | TokCase !Posn+ | TokOf !Int+ | TokColon+ | TokEquals+ | TokLBrace !Posn+ | TokRBrace+ | TokSemicolon+ | TokDot+ | TokRParen+ | TokPipe+ | TokAt+ | TokApos+ | TokArrow+ | TokWith !Int+ | TokNewLine+ | TokInfix !(Posn, Infix)+ | TokInteger !(Posn, Int)+ | TokEOF++tokGetPos :: Token -> Maybe Posn+tokGetPos (TokIdent (PIdent pos _)) = Just pos+tokGetPos (TokLam pos) = Just pos+tokGetPos (TokLParen pos) = Just pos+tokGetPos (TokOperator (PIdent pos _)) = Just pos+tokGetPos _ = Nothing++breaks :: Eq a => a -> [a] -> [[a]]+breaks a as = case break (== a) as of+ (as1, []) -> [as1]+ (as1, _:as2) -> as1 : breaks a as2++type AlexInput = (Posn, B.ByteString)++data Layout = Layout Int | NoLayout deriving Eq++type ParserErr a = WarnT [(Posn, String)] (State [Layout]) a+type Parser a = AlexInput -> ParserErr a++alexScanTokens :: (Token -> Parser a) -> Parser a+alexScanTokens cont = go+ where+ go inp@(pos,str) = case alexScan inp 0 of+ AlexEOF -> cont TokEOF inp+ AlexError inp' -> do+ warn [(pos, "Lexer error")]+ (go . findAGoodSymbol . skippingTheBadOne) inp'+ AlexSkip inp' _ -> go inp'+ AlexToken inp'@((_, c), _) len act -> case act pos $ C.unpack (B.take len str) of+ TokNewLine -> do+ layout:layouts <- lift get+ case layout of+ NoLayout -> go inp'+ Layout n -> case compare n c of+ LT -> go inp'+ EQ -> cont TokSemicolon inp'+ GT -> do+ lift (put layouts)+ cont TokRBrace inp+ TokRBrace -> do+ layout <- lift get+ if NoLayout `elem` layout+ then do+ lift $ put (tail layout)+ cont TokRBrace $ if head layout == NoLayout then inp' else inp+ else do+ warn [(pos, "Misplaced '}'")]+ go inp'+ TokWith{} -> cont (TokWith c) inp'+ TokOf{} -> cont (TokOf c) inp'+ tok -> cont tok inp'++findAGoodSymbol :: AlexInput -> AlexInput+findAGoodSymbol ((l, c), str) =+ let (f,s) = C.break (\c -> isAlpha c || isSpace c || c `elem` "~!@#$%^&*-+=|?<>,./:l[]{}()\\_") str+ in ((l, c + B.length f), s)++skippingTheBadOne :: AlexInput -> AlexInput+skippingTheBadOne inp@((l, c), str) = if B.null str then inp else ((l, c + 1), B.tail str)++alexGetByte :: AlexInput -> Maybe (Word8, AlexInput)+alexGetByte (pos, str) = fmap (\(h,t) -> (h, (alexMove pos $ C.head str, t))) (B.uncons str)++tabSize :: Int+tabSize = 4++alexMove :: Posn -> Char -> Posn+alexMove (l, c) '\t' = (l, ((c + tabSize - 1) `div` tabSize) * tabSize + 1)+alexMove (l, c) '\n' = (l + 1, 1)+alexMove (l, c) _ = (l , c + 1)++alexInputPrevChar :: AlexInput -> Char+alexInputPrevChar = error "alexInputPrevChar"+}
+ src/Syntax/Parser/Parser.y view
@@ -0,0 +1,194 @@+--+{+module Syntax.Parser.Parser+ ( pDefs, pExpr+ ) where++import Control.Monad.Trans+import Control.Monad.State+import Control.Monad.Error+import Data.Bifunctor+import Data.Void+import Data.Maybe++import Syntax.Parser.Lexer+import Syntax+import TypeChecking.Monad.Warn+}++%name pDefs Defs+%name pExpr Expr+%tokentype { Token }+%error { parseError }+%monad { Parser } { bind } { return' }+%lexer { alexScanTokens } { TokEOF }++%token+ PIdent { TokIdent $$ }+ Import { TokImport $$ }+ Operator { TokOperator $$ }+ Infix { TokInfix $$ }+ Integer { TokInteger $$ }+ '\\' { TokLam $$ }+ '(' { TokLParen $$ }+ 'case' { TokCase $$ }+ 'of' { TokOf $$ }+ 'data' { TokData }+ ':' { TokColon }+ '=' { TokEquals }+ '{' { TokLBrace $$ }+ '}' { TokRBrace }+ ';' { TokSemicolon }+ ')' { TokRParen }+ '|' { TokPipe }+ '@' { TokAt }+ '`' { TokApos }+ '->' { TokArrow }+ 'with' { TokWith $$ }++%%++Name :: { PName }+ : PIdent { (getPos $1, Ident (getName $1)) }+ | '(' Operator ')' { (getPos $2, Operator (getName $2)) }++InfixOp :: { PName }+ : Operator { (getPos $1, Operator (getName $1)) }+ | '`' PIdent '`' { (getPos $2, Ident (getName $2)) }++InfixOps :: { [PName] }+ : InfixOp { [$1] }+ | InfixOps InfixOp { $2:$1 }++LBrace :: { Posn }+ : '{' {% \_ -> lift (modify (NoLayout :)) >> return $1 }++with :: { () }+ : 'with' '{' {% \_ -> lift $ modify (NoLayout :) }+ | 'with' error {% \_ -> lift $ modify (Layout $1 :) }++of :: { () }+ : 'of' '{' {% \_ -> lift $ modify (NoLayout :) }+ | 'of' error {% \_ -> lift $ modify (Layout $1 :) }++Def :: { Def }+ : Name ':' Expr { DefType $1 $3 }+ | Name Patterns '=' Expr { DefFun $1 (reverse $2) (Just $4) }+ | Name Patterns { DefFun $1 (reverse $2) Nothing }+ | 'data' Name Teles { DefData $2 (reverse $3) [] [] }+ | 'data' Name Teles '=' Cons { DefData $2 (reverse $3) (reverse $5) [] }+ | 'data' Name Teles '=' Cons with FunClauses '}' { DefData $2 (reverse $3) (reverse $5) (reverse $7) }+ | Infix Integer InfixOps { DefFixity (fst $1) (snd $1) (snd $2) (map snd $3) }+ | Import { DefImport $1 }++Defs :: { [Def] }+ : {- empty -} { [] }+ | Def { [$1] }+ | Defs ';' { $1 }+ | Defs ';' Def { $3:$1 }++FunClauses :: { [Clause] }+ : Name Patterns '=' Expr { [Clause $1 (reverse $2) $4] }+ | FunClauses ';' { $1 }+ | FunClauses ';' Name Patterns '=' Expr { Clause $3 (reverse $4) $6 : $1 }++Pattern :: { Term PName Void }+ : PIdent { Apply (getPos $1, Ident $ getName $1) [] }+ | '(' ')' { Apply ($1, Operator "") [] }+ | '(' PIdent Patterns ')' { Apply (getPos $2, Ident $ getName $2) (reverse $3) }++Patterns :: { [Term PName Void] }+ : {- empty -} { [] }+ | Patterns Pattern { $2:$1 }++Con :: { Con }+ : PIdent Teles { ConDef $1 (reverse $2) } ++Cons :: { [Con] }+ : Con { [$1] } + | Cons '|' Con { $3:$1 }++Tele :: { Tele }+ : Expr5 { TypeTele $1 }+ | '(' Exprs ':' Expr ')' {% \_ -> mapM exprToVar $2 >>= \vars -> return (VarsTele (reverse vars) $4) }++Teles :: { [Tele] }+ : {- empty -} { [] }+ | Teles Tele { $2:$1 }++PiTele :: { (Explicit,PiTele) }+ : '(' Exprs ':' Expr ')' { (Explicit, PiTele $1 (reverse $2) $4) }+ | LBrace Exprs ':' Expr '}' { (Implicit, PiTele $1 (reverse $2) $4) }++PiTeles :: { [(Explicit,PiTele)] }+ : PiTele { [$1] }+ | PiTeles PiTele { $2:$1 }++PIdents :: { [PIdent] }+ : PIdent { [$1] }+ | PIdents PIdent { $2:$1 }++Expr :: { RawExpr }+ : Expr1 { $1 }+ | '\\' PIdents '->' Expr { Apply ($1, Lam $ reverse $ map getName $2) [$4] }++Expr1 :: { RawExpr }+ : Expr2 { $1 }+ | Expr2 '->' Expr1 { Apply (termPos $1, Pi Explicit []) [$1, $3] }+ | PiTeles '->' Expr1 {% \_ -> piExpr (reverse $1) $3 }++Expr2 :: { RawExpr }+ : Expr3 { $1 }+ | Expr3 '=' Expr3 { Apply (termPos $1, PathImp) [$1,$3] }++Expr3 :: { RawExpr }+ : Expr4 { Apply (termPos $1, Null) [$1] }+ | Expr3 '@' Expr4 { Apply (termPos $1, At) [$1, $3] }+ | Expr3 InfixOp Expr4 { Apply (termPos $1, Name (Infix InfixL 90) $ snd $2) [$1, $3] }++Expr4 :: { RawExpr }+ : Exprs { let e:es = reverse $1 in apps e es }++Exprs :: { [RawExpr] }+ : Expr5 { [$1] }+ | Exprs Expr5 { $2:$1 }++Expr5 :: { RawExpr }+ : Name { Apply (fst $1, Name Prefix $ snd $1) [] }+ | '(' Expr ')' { $2 }+ | 'case' Expr of CaseClauses '}' { Apply ($1, Case $ map vacuous $ reverse $ fst $4) ($2 : reverse (snd $4)) }++CaseClauses :: { ([Term PName Void], [RawExpr]) }+ : Name Patterns '->' Expr { ([Apply $1 $2], [$4]) }+ | CaseClauses ';' { $1 }+ | CaseClauses ';' Name Patterns '->' Expr { (Apply $3 $4 : fst $1, $6 : snd $1) }++{+return' :: a -> Parser a+return' a _ = return a++bind :: Parser a -> (a -> Parser b) -> Parser b+bind p k e = p e >>= \a -> k a e++data PiTele = PiTele Posn [RawExpr] RawExpr++piExpr :: [(Explicit,PiTele)] -> RawExpr -> ParserErr RawExpr+piExpr [] term = return term+piExpr ((e, PiTele pos t1 t2) : teles) term = do+ vars <- mapM exprToVar t1+ term' <- piExpr teles term+ return $ Apply (pos, Pi e $ map getName vars) [t2,term']++termPos :: RawExpr -> Posn+termPos (Apply (pos, _) _) = pos+termPos _ = error "termPos"++exprToVar :: RawExpr -> ParserErr PIdent+exprToVar (Apply (pos, Name Prefix (Ident v)) []) = return (PIdent pos v)+exprToVar term = throwError [(termPos term, "Expected a list of identifiers")]++parseError :: Token -> Parser a+parseError tok (pos,_) = throwError [(maybe pos id (tokGetPos tok), "Syntax error")]++myLexer = alexScanTokens+}
− src/Syntax/Pattern.hs
@@ -1,14 +0,0 @@-module Syntax.Pattern where--data ICon = ILeft | IRight deriving Eq-data PatternCon c = PatternCon Int Int String [([Pattern c], c)]-data Pattern c = Pattern (PatternCon c) [Pattern c] | PatternVar String | PatternI ICon--instance Eq (PatternCon c) where- PatternCon i _ _ _ == PatternCon i' _ _ _ = i == i'--instance Eq (Pattern c) where- PatternI c == PatternI c' = c == c'- PatternVar _ == PatternVar _ = True- Pattern c _ == Pattern c' _ = c == c'- _ == _ = False
src/Syntax/PrettyPrinter.hs view
@@ -1,97 +1,101 @@+{-# LANGUAGE FlexibleInstances #-}+ module Syntax.PrettyPrinter ( ppTerm- , scopeToTerm ) where import Text.PrettyPrint-import Data.Foldable+import Data.Bifunctor+import Data.Bifoldable+import Data.Void -import Syntax.Term+import Syntax import qualified Syntax.ErrorDoc as E -instance E.Pretty1 Term where- pretty1 t = ppTermCtx (toList $ fmap render t) t+instance E.Pretty1 (Term Syntax) where+ pretty1 t = ppTermCtx (freeVars t) t -ppTerm :: Term String -> Doc-ppTerm t = ppTermCtx (toList t) (fmap text t)+freeVars :: Term Syntax a -> [String]+freeVars = biconcatMap (\t -> case t of+ Name _ (Ident s) -> [s]+ _ -> []) (const []) -ppTermCtx :: [String] -> Term Doc -> Doc-ppTermCtx _ (Var d) = d-ppTermCtx _ (Universe NoLevel) = text "Type"-ppTermCtx _ (Universe l) = text $ "Type" ++ show l-ppTermCtx ctx t@(App e1 e2) = ppTermPrec (prec t) ctx e1 <+> ppTermPrec (prec t + 1) ctx e2-ppTermCtx ctx t@(Pi (Type a _) b _) =- let (vs, b') = ppScopePrec (prec t) ctx b- in (if null vs then ppTermPrec (prec t + 1) ctx a else parens $ hsep vs <+> colon <+> ppTermCtx ctx a) <+> b'-ppTermCtx ctx t@Lam{} = go ctx [] t- where- go ctx vars (Lam (Scope1 n s)) =- let (ctx', n') = renameName n ctx- in go ctx' (text n' : vars) $ instantiate1 (Var $ text n') s- go ctx vars t' = text "\\" <> hsep (reverse vars) <+> arrow <+> ppTermPrec (prec t) ctx t'-ppTermCtx ctx t@(Con _ _ n _ as) = text n <+> ppList ctx t as-ppTermCtx _ (FunSyn n _) = text n-ppTermCtx _ (FunCall _ n _) = text n-ppTermCtx ctx t@(DataType d _ as) = text d <+> ppList ctx t as-ppTermCtx _ Interval = text "I"-ppTermCtx _ (ICon ILeft) = text "left"-ppTermCtx _ (ICon IRight) = text "right"-ppTermCtx ctx t@(Path Implicit _ [e2,e3]) = ppTermPrec (prec t + 1) ctx e2 <+> equals <+> ppTermPrec (prec t + 1) ctx e3-ppTermCtx ctx t@(Path _ me es) = text "Path" <+> ppList ctx t (maybe (Var $ text "_") id me : es)-ppTermCtx ctx t@(PCon me) = text "path" <+> maybe empty (ppTermPrec (prec t + 1) ctx) me-ppTermCtx ctx t@(At _ _ e1 e2) = ppTermPrec (prec t) ctx e1 <+> text "@" <+> ppTermPrec (prec t + 1) ctx e2-ppTermCtx ctx t@(Coe es) = text "coe" <+> ppList ctx t es-ppTermCtx ctx t@(Iso es) = text "iso" <+> ppList ctx t es-ppTermCtx ctx t@(Squeeze es) = text "squeeze" <+> ppList ctx t es+ppTerm :: Term Syntax Void -> Doc+ppTerm t = ppTermCtx (freeVars t) (vacuous t) -ppList :: [String] -> Term Doc -> [Term Doc] -> Doc-ppList ctx t ts = hsep $ map (ppTermPrec (prec t + 1) ctx) ts+ppTermCtx :: [String] -> Term Syntax Doc -> Doc+ppTermCtx ctx (Var d ts) = d <+> ppList ctx ts+ppTermCtx ctx (Apply s ts) = ppSyntax ctx s ts+ppTermCtx ctx (Lambda t) = ppTermCtx ctx $ fmap (\v -> case v of+ Bound -> text "(error: Bound)"+ Free d -> d) t -ppScopePrec :: Int -> [String] -> Scope String Term Doc -> ([Doc], Doc)-ppScopePrec p ctx t =- let (vars, b, ctx', t') = scopeToTerm ctx text t- in (map text vars, (if null vars || b then arrow else empty) <+> ppTermPrec p ctx' t')+ppSyntax :: [String] -> Syntax -> [Term Syntax Doc] -> Doc+ppSyntax ctx p@(Pi e vs) (t1:t2:ts) =+ let r = (if null vs then ppTermPrec (prec p + 1) ctx t1+ else (if e == Explicit then parens else braces) $ hsep (map text vs) <+> colon <+> ppTermCtx ctx t1)+ <+> arrow <+> ppBound (prec p) ctx vs t2+ in if null ts then r else parens r <+> ppList ctx ts+ppSyntax ctx l@(Lam vs) (t:ts) = bparens (not $ null ts) (text "\\" <> hsep (map text vs) <+> arrow <+> ppBound (prec l) ctx vs t) <+> ppList ctx ts+ppSyntax ctx t@PathImp [_,t2,t3] = ppTermPrec (prec t + 1) ctx t2 <+> equals <+> ppTermPrec (prec t + 1) ctx t3+ppSyntax ctx t@At (_:_:t3:t4:ts) = bparens (not $ null ts)+ (ppTermPrec (prec t) ctx t3 <+> text "@" <+> ppTermPrec (prec t + 1) ctx t4) <+> ppList ctx ts+ppSyntax ctx t@(Name (Infix ft _) n) (t1:t2:ts) =+ bparens (not $ null ts) (ppTermPrec (opFixity InfixL ft $ prec t) ctx t1 <+> text (nameToInfix n)+ <+> ppTermPrec (opFixity InfixR ft $ prec t) ctx t2) <+> ppList ctx ts+ppSyntax ctx (Name _ n) ts = text (nameToPrefix n) <+> ppList ctx ts+ppSyntax ctx (Case pats) (expr:terms) = hang (text "case" <+> ppTermCtx ctx expr <+> text "of") 4 $ vcat $+ map (\(pat,term) -> ppTermCtx ctx (bimap (Name Prefix . snd) text pat) <+> arrow <+>+ ppBound 0 ctx (bifoldMap (const []) return pat) term) (zip pats terms)+ppSyntax ctx Null [t] = ppTermCtx ctx t+ppSyntax _ Null _ = empty+ppSyntax _ Lam{} [] = error "ppSyntax: Lam"+ppSyntax _ Pi{} _ = error "ppSyntax: Pi"+ppSyntax _ PathImp{} _ = error "ppSyntax: PathImp"+ppSyntax _ At _ = error "ppSyntax: At"+ppSyntax _ Case{} [] = error "ppSyntax: Case" -scopeToTerm :: [String] -> (String -> a) -> Scope String Term a -> ([String], Bool, [String], Term a)-scopeToTerm ctx f (ScopeTerm t@(Pi _ ScopeTerm{} _)) = ([], False, ctx, t)-scopeToTerm ctx f (ScopeTerm t) = ([], True, ctx, t)-scopeToTerm ctx f (Scope v s) =- let (ctx', v') = renameName v ctx- (vs, b, ctx'', d) = scopeToTerm ctx' f $ instantiateScope (Var $ f v') s- in (v' : vs, b, ctx'', d)+opFixity :: Infix -> Infix -> Int -> Int+opFixity ft ft' p = if ft == ft' then p else p + 1 -ppTermPrec :: Int -> [String] -> Term Doc -> Doc-ppTermPrec p ctx t = if p > prec t then parens (ppTermCtx ctx t) else ppTermCtx ctx t+ppList :: [String] -> [Term Syntax Doc] -> Doc+ppList ctx ts = hsep $ map (ppTermPrec 100 ctx) ts +ppBound :: Int -> [String] -> [String] -> Term Syntax Doc -> Doc+ppBound p ctx (v:vs) (Lambda t) =+ let (ctx',v') = renameName2 v ctx (freeVars t)+ in ppBound p ctx' vs $ instantiate1 (capply $ Name Prefix $ Ident v') t+ppBound p ctx _ t = ppTermPrec p ctx t++ppTermPrec :: Int -> [String] -> Term Syntax Doc -> Doc+ppTermPrec p ctx t = bparens (p > precTerm t) (ppTermCtx ctx t)++bparens :: Bool -> Doc -> Doc+bparens True d = parens d+bparens False d = d+ arrow :: Doc arrow = text "->" renameName :: String -> [String] -> ([String], String) renameName var ctx = if var `Prelude.elem` ctx then renameName (var ++ "'") ctx else (var:ctx,var) -prec :: Term a -> Int-prec Var{} = 10-prec Universe{} = 10-prec FunSyn{} = 10-prec FunCall{} = 10-prec (Con _ _ _ _ []) = 10-prec (DataType _ _ []) = 10-prec (Path Explicit Nothing []) = 10-prec (PCon Nothing) = 10-prec Interval = 10-prec ICon{} = 10-prec (Coe []) = 10-prec (Iso []) = 10-prec (Squeeze []) = 10-prec App{} = 9-prec Con{} = 9-prec DataType{} = 9-prec (Path Explicit _ _) = 9-prec PCon{} = 9-prec Coe{} = 9-prec Iso{} = 9-prec Squeeze{} = 9-prec At{} = 8-prec (Path Implicit _ _) = 7-prec Pi{} = 6-prec Lam{} = 5+renameName2 :: String -> [String] -> [String] -> ([String], String)+renameName2 var ctx ctx' = if var `elem` ctx && var `elem` ctx'+ then renameName (var ++ "'") ctx'+ else (var:ctx,var)++prec :: Syntax -> Int+prec (Name Prefix _) = 100+prec (Name (Infix _ p) _) = p+prec At = 80+prec PathImp{} = 70+prec Pi{} = 60+prec Lam{} = 50+prec _ = 0++precTerm :: Term Syntax a -> Int+precTerm Var{} = 100+precTerm (Apply Name{} (_:_)) = 90+precTerm (Apply s _) = prec s+precTerm (Lambda t) = precTerm t
− src/Syntax/Scope.hs
@@ -1,105 +0,0 @@-{-# LANGUAGE RankNTypes #-}--module Syntax.Scope where--import Prelude.Extras-import Control.Monad-import Control.Applicative-import Data.Maybe-import Data.Monoid-import Data.Foldable-import Data.Traversable--newtype Closed f = Closed (forall a. f a)--data Scoped a = Free a | Bound deriving Eq--instance Functor Scoped where- fmap _ Bound = Bound- fmap f (Free a) = Free (f a)--instance Foldable Scoped where- foldMap _ Bound = mempty- foldMap f (Free a) = f a--instance Traversable Scoped where- traverse _ Bound = pure Bound- traverse f (Free a) = Free <$> f a--instance Applicative Scoped where- pure = Free- Bound <*> _ = Bound- _ <*> Bound = Bound- Free f <*> Free a = Free (f a)--class MonadF t where- (>>>=) :: Monad f => t f a -> (a -> f b) -> t f b--data Scope1 s f a = Scope1 s (f (Scoped a))--unScope1 :: Scope1 s f a -> f (Scoped a)-unScope1 (Scope1 _ t) = t--instance (Eq1 f, Eq a) => Eq (Scope1 s f a) where- Scope1 _ t1 == Scope1 _ t2 = t1 ==# t2--instance Functor f => Functor (Scope1 s f) where- fmap f (Scope1 s t) = Scope1 s $ fmap (fmap f) t--instance Foldable f => Foldable (Scope1 s f) where- foldMap f (Scope1 _ t) = foldMap (foldMap f) t--instance Traversable f => Traversable (Scope1 s f) where- traverse f (Scope1 s t) = Scope1 s <$> traverse (traverse f) t--instance MonadF (Scope1 s) where- Scope1 s t >>>= k = Scope1 s $ t >>= \v -> case v of- Bound -> return Bound- Free a -> liftM Free (k a)--instantiate1 :: Monad f => f a -> f (Scoped a) -> f a-instantiate1 s t = t >>= \v -> case v of- Bound -> s- Free a -> return a--data Scope s f a = ScopeTerm (f a) | Scope s (Scope s f (Scoped a))--instance (Eq1 f, Eq a) => Eq (Scope s f a) where- ScopeTerm t1 == ScopeTerm t2 = t1 ==# t2- Scope _ t1 == Scope _ t2 = t1 == t2- _ == _ = False--instance Functor f => Functor (Scope s f) where- fmap f (ScopeTerm t) = ScopeTerm (fmap f t)- fmap f (Scope s t) = Scope s $ fmap (fmap f) t--instance Foldable f => Foldable (Scope s f) where- foldMap f (ScopeTerm t) = foldMap f t- foldMap f (Scope _ t) = foldMap (foldMap f) t--instance Traversable f => Traversable (Scope s f) where- traverse f (ScopeTerm t) = ScopeTerm <$> traverse f t- traverse f (Scope s t) = Scope s <$> traverse (traverse f) t--instance MonadF (Scope s) where- ScopeTerm t >>>= k = ScopeTerm (t >>= k)- Scope s t >>>= k = Scope s $ t >>>= \v -> case v of- Bound -> return Bound- Free a -> liftM Free (k a)--instantiateScope :: Monad f => f a -> Scope s f (Scoped a) -> Scope s f a-instantiateScope t s = s >>>= \v -> case v of- Bound -> t- Free a -> return a--instantiate :: Monad f => [f a] -> Scope s f a -> f a-instantiate t (ScopeTerm s) = s-instantiate [] _ = error "instantiate"-instantiate (t:ts) (Scope _ s) = instantiate ts (instantiateScope t s)--closed :: Traversable f => f a -> Closed f-closed t = Closed $ fromJust $ traverse (const Nothing) t--mapScope :: (s -> t) -> Scope s f a -> Scope t f a-mapScope _ (ScopeTerm t) = ScopeTerm t-mapScope f (Scope s t) = Scope (f s) (mapScope f t)
src/Syntax/Term.hs view
@@ -1,200 +1,96 @@+{-# LANGUAGE RankNTypes #-}+ module Syntax.Term- ( Term(..), Type(..)- , Level(..), level- , Explicit(..), PatternC- , module Syntax.Scope, module Syntax.Pattern- , POrd(..), lessOrEqual- , apps, collect, dropOnePi+ ( Term(..), Scoped(..)+ , capply, cvar, bvar, apps+ , instantiate1+ , Closed(..), closed ) where -import Prelude.Extras-import Data.Function-import Data.Traversable hiding (mapM)-import Data.Foldable hiding (msum)+import Data.Maybe+import Data.Monoid+import Data.Foldable+import Data.Traversable+import Data.Bifunctor+import Data.Bifoldable+import Data.Bitraversable import Control.Applicative import Control.Monad -import Syntax.Scope-import Syntax.Pattern--data Level = Level Int | NoLevel--instance Eq Level where- (==) = (==) `on` level--instance Ord Level where- compare = compare `on` level--instance Show Level where- show = show . level--instance Enum Level where- toEnum 0 = NoLevel- toEnum n = Level n- fromEnum = level--level :: Level -> Int-level (Level l) = l-level NoLevel = 0+data Term p a+ = Var a [Term p a]+ | Apply p [Term p a]+ | Lambda (Term p (Scoped a)) -data Term a- = Var a- | App (Term a) (Term a)- | Lam (Scope1 String Term a)- | Pi (Type a) (Scope String Term a) Level- | Con Int (Int,Int) String [([PatternC], Closed (Scope String Term))] [Term a]- | FunCall (Int,Int) String [([PatternC], Closed (Scope String Term))]- | FunSyn String (Term a)- | Universe Level- | DataType String Int [Term a]- | Interval- | ICon ICon- | Path Explicit (Maybe (Term a)) [Term a]- | PCon (Maybe (Term a))- | At (Term a) (Term a) (Term a) (Term a)- | Coe [Term a]- | Iso [Term a]- | Squeeze [Term a]-data Type a = Type (Term a) Level-data Explicit = Explicit | Implicit-type PatternC = Pattern (Closed (Scope String Term))+instance Functor (Term p) where fmap = fmapDefault+instance Foldable (Term p) where foldMap = foldMapDefault+instance Bifunctor Term where bimap = bimapDefault+instance Bifoldable Term where bifoldMap = bifoldMapDefault+instance Traversable (Term p) where traverse = bitraverse pure -instance Eq a => Eq (Term a) where- e1 == e2 = go e1 [] e2 []- where- go :: Eq a => Term a -> [Term a] -> Term a -> [Term a] -> Bool- go (Var a) es (Var a') es' = a == a' && es == es'- go (App a b) es e2 es' = go a (b:es) e2 es'- go e1 es (App a b) es' = go e1 es a (b:es')- go (Lam s) es (Lam s') es' = s == s' && es == es'- go (Lam (Scope1 _ s)) es t es' =- let (l1,l2) = splitAt (length es' - length es) es'- in l2 == es && go s [] (fmap Free t) (map (fmap Free) l1 ++ [Var Bound])- go t es t'@Lam{} es' = go t' es' t es- go e1@Pi{} es e2@Pi{} es' = pcompare e1 e2 == Just EQ && es == es'- go (Con c _ _ _ as) es (Con c' _ _ _ as') es' = c == c' && as ++ es == as' ++ es'- go (FunCall _ n _) es (FunCall _ n' _) es' = n == n' && es == es'- go (FunSyn n _) es (FunSyn n' _) es' = n == n' && es == es'- go (Universe u) es (Universe u') es' = u == u' && es == es'- go (DataType d _ as) es (DataType d' _ as') es' = d == d' && as ++ es == as' ++ es'- go Interval es Interval es' = es == es'- go (ICon c) es (ICon c') es' = c == c' && es == es'- go (Path Explicit a as) es (Path Explicit a' as') es' = a == a' && as ++ es == as' ++ es'- go (Path _ _ as) es (Path _ _ as') es' = as ++ es == as' ++ es'- go (PCon f) es (PCon f') es' = maybe [] return f ++ es == maybe [] return f' ++ es'- go (PCon e) es e' es' = case maybe [] return e ++ es of- e1:es1 -> e1 == Lam (Scope1 "" $ At (error "") (error "") (fmap Free e') $ Var Bound) && es1 == es'- _ -> False- go e es e'@PCon{} es' = go e' es' e es- go (At _ _ a b) es (At _ _ a' b') es' = a == a' && b == b' && es == es'- go (Coe as) es (Coe as') es' = as ++ es == as' ++ es'- go (Iso as) es (Iso as') es' = as ++ es == as' ++ es'- go (Squeeze as) es (Squeeze as') es' = as ++ es == as' ++ es'- go _ _ _ _ = False+instance Bitraversable Term where+ bitraverse f g (Var a ts) = Var <$> g a <*> traverse (bitraverse f g) ts+ bitraverse f g (Apply p ts) = Apply <$> f p <*> traverse (bitraverse f g) ts+ bitraverse f g (Lambda t) = Lambda <$> bitraverse f (traverse g) t -instance Eq a => Eq (Type a) where- Type t _ == Type t' _ = t == t'+instance Applicative (Term p) where+ pure = cvar+ (<*>) = ap -instance Eq1 Term where (==#) = (==)+instance Monad (Term p) where+ return = cvar+ Var a ts >>= k = apps (k a) $ map (>>= k) ts+ Apply p ts >>= k = Apply p $ map (>>= k) ts+ Lambda s >>= k = Lambda $ s >>= \v -> case v of+ Free a -> fmap Free (k a)+ Bound -> return Bound -class POrd a where- pcompare :: a -> a -> Maybe Ordering+capply :: p -> Term p a+capply p = Apply p [] -instance Eq a => POrd (Term a) where- pcompare (Pi a (ScopeTerm b) _) (Pi a' b'@Scope{} lvl') =- contraCovariant (pcompare a a') $ pcompare (fmap Free b) (unScope1 $ dropOnePi a' b' lvl')- pcompare (Pi a b@Scope{} lvl) (Pi a' (ScopeTerm b') _) =- contraCovariant (pcompare a a') $ pcompare (unScope1 $ dropOnePi a b lvl) (fmap Free b')- pcompare (Pi a b lvl) (Pi a' b' lvl') = contraCovariant (pcompare a a') $ pcompareScopes a b lvl a' b' lvl'- where- pcompareScopes :: Eq a => Type a -> Scope String Term a -> Level -> Type a -> Scope String Term a -> Level -> Maybe Ordering- pcompareScopes _ (ScopeTerm b) _ _ (ScopeTerm b') _ = pcompare b b'- pcompareScopes _ (ScopeTerm b) _ a' b' lvl' = pcompare b (Pi a' b' lvl')- pcompareScopes a b lvl _ (ScopeTerm b') _ = pcompare (Pi a b lvl) b'- pcompareScopes a (Scope _ b) lvl a' (Scope _ b') lvl' = pcompareScopes (fmap Free a) b lvl (fmap Free a') b' lvl'- pcompare (Universe u) (Universe u') = Just $ compare (level u) (level u')- pcompare e1 e2 = if e1 == e2 then Just EQ else Nothing+cvar :: a -> Term p a+cvar a = Var a [] -instance Eq a => POrd (Type a) where- pcompare (Type t _) (Type t' _) = pcompare t t'+bvar :: Term p (Scoped a)+bvar = cvar Bound -contraCovariant :: Maybe Ordering -> Maybe Ordering -> Maybe Ordering-contraCovariant (Just LT) (Just r) | r == EQ || r == GT = Just GT-contraCovariant (Just EQ) r = r-contraCovariant (Just GT) (Just r) | r == LT || r == EQ = Just LT-contraCovariant _ _ = Nothing+apps :: Term s a -> [Term s a] -> Term s a+apps t [] = t+apps (Lambda t) (t1:ts) = apps (instantiate1 t1 t) ts+apps (Apply a as) ts = Apply a (as ++ ts)+apps (Var a as) ts = Var a (as ++ ts) -lessOrEqual :: POrd a => a -> a -> Bool-lessOrEqual a b = case pcompare a b of- Just r | r == EQ || r == LT -> True- _ -> False+newtype Closed f = Closed { open :: forall a. f a } -instance Functor Term where fmap = fmapDefault-instance Foldable Term where foldMap = foldMapDefault+data Scoped a = Free a | Bound -instance Functor Type where- fmap f (Type t l) = Type (fmap f t) l+instance Eq a => Eq (Scoped a) where+ Bound == Bound = True+ Free a == Free a' = a == a'+ _ == _ = False -instance Applicative Term where- pure = Var- (<*>) = ap+instance Functor Scoped where+ fmap _ Bound = Bound+ fmap f (Free a) = Free (f a) -instance Traversable Term where- traverse f (Var a) = Var <$> f a- traverse f (App e1 e2) = App <$> traverse f e1 <*> traverse f e2- traverse f (Lam s) = Lam <$> traverse f s- traverse f (At e1 e2 e3 e4) = At <$> traverse f e1 <*> traverse f e2 <*> traverse f e3 <*> traverse f e4- traverse f (Pi (Type e1 lvl1) e2 lvl2) = (\e1' e2' -> Pi (Type e1' lvl1) e2' lvl2) <$> traverse f e1 <*> traverse f e2- traverse f (Path h me es) = Path h <$> traverse (traverse f) me <*> traverse (traverse f) es- traverse f (PCon e) = PCon <$> traverse (traverse f) e- traverse f (Con c lc n cs as) = Con c lc n cs <$> traverse (traverse f) as- traverse f (Coe as) = Coe <$> traverse (traverse f) as- traverse f (Iso as) = Iso <$> traverse (traverse f) as- traverse f (Squeeze as) = Squeeze <$> traverse (traverse f) as- traverse f (FunSyn n e) = FunSyn n <$> traverse f e- traverse f (DataType d e as) = DataType d e <$> traverse (traverse f) as- traverse _ (FunCall lc n cs) = pure (FunCall lc n cs)- traverse _ (Universe l) = pure (Universe l)- traverse _ Interval = pure Interval- traverse _ (ICon c) = pure (ICon c)+instance Foldable Scoped where+ foldMap _ Bound = mempty+ foldMap f (Free a) = f a -instance Monad Term where- return = Var- Var a >>= k = k a- App e1 e2 >>= k = App (e1 >>= k) (e2 >>= k)- Lam e >>= k = Lam (e >>>= k)- Pi (Type e1 lvl1) e2 lvl2 >>= k = Pi (Type (e1 >>= k) lvl1) (e2 >>>= k) lvl2- Con c lc n cs as >>= k = Con c lc n cs (map (>>= k) as)- FunCall lc n cs >>= k = FunCall lc n cs- FunSyn n e >>= k = FunSyn n (e >>= k)- Universe l >>= _ = Universe l- DataType d e as >>= k = DataType d e $ map (>>= k) as- Interval >>= _ = Interval- ICon c >>= _ = ICon c- Path h me1 es >>= k = Path h (fmap (>>= k) me1) $ map (>>= k) es- PCon e >>= k = PCon $ fmap (>>= k) e- At e1 e2 e3 e4 >>= k = At (e1 >>= k) (e2 >>= k) (e3 >>= k) (e4 >>= k)- Coe es >>= k = Coe $ map (>>= k) es- Iso es >>= k = Iso $ map (>>= k) es- Squeeze es >>= k = Squeeze $ map (>>= k) es+instance Traversable Scoped where+ traverse _ Bound = pure Bound+ traverse f (Free a) = Free <$> f a -apps :: Term a -> [Term a] -> Term a-apps e [] = e-apps e1 (e2:es) = apps (App e1 e2) es+instance Applicative Scoped where+ pure = Free+ Bound <*> _ = Bound+ _ <*> Bound = Bound+ Free f <*> Free a = Free (f a) -collect :: Term a -> Term a-collect term = go term []- where- go (App e1 e2) ts = go e1 (e2:ts)- go (Con a b c d es) ts = Con a b c d (es ++ ts)- go (DataType a b es) ts = DataType a b (es ++ ts)- go (Path a b es) ts = Path a b (es ++ ts)- go (Coe es) ts = Coe (es ++ ts)- go (Iso es) ts = Iso (es ++ ts)- go (Squeeze es) ts = Squeeze (es ++ ts)- go _ _ = term+instantiate1 :: Monad f => f a -> f (Scoped a) -> f a+instantiate1 s t = t >>= \v -> case v of+ Bound -> s+ Free a -> return a -dropOnePi :: Type a -> Scope String Term a -> Level -> Scope1 String Term a-dropOnePi _ (ScopeTerm b) _ = Scope1 "_" (fmap Free b)-dropOnePi _ (Scope s (ScopeTerm b)) _ = Scope1 s b-dropOnePi a (Scope s b) lvl = Scope1 s $ Pi (fmap Free a) b lvl+closed :: Traversable f => f a -> Closed f+closed t = Closed $ fromJust $ traverse (const Nothing) t
src/TypeChecking/Context.hs view
@@ -4,7 +4,7 @@ import Control.Monad -import Syntax.Scope+import Syntax.Term data Ctx s f b a where Nil :: Ctx s f b b@@ -20,23 +20,37 @@ lookupCtx :: (Monad g, Functor f, Eq s) => s -> Ctx s f b a -> Maybe (g a, f a) lookupCtx _ Nil = Nothing-lookupCtx s (Snoc ctx s' t) = if s == s'+lookupCtx b (Snoc ctx s t) = if s == b then Just (return Bound, fmap Free t)- else fmap (\(te, ty) -> (liftM Free te, fmap Free ty)) (lookupCtx s ctx)+ else fmap (\(te, ty) -> (liftM Free te, fmap Free ty)) (lookupCtx b ctx) -close :: Monad f => Ctx b g b a -> f a -> f b+ctxToVars :: Monad g => Ctx s f b a -> [g a]+ctxToVars = reverse . go+ where+ go :: Monad g => Ctx s f b a -> [g a]+ go Nil = []+ go (Snoc ctx s _) = return Bound : map (liftM Free) (go ctx)++close :: Functor f => Ctx c g b a -> f (Either c a) -> f (Either c b) close Nil t = t-close (Snoc ctx s _) t = close ctx $ t >>= \v -> return $ case v of- Bound -> liftBase ctx s- Free a -> a+close (Snoc ctx s _) t = close ctx $ fmap (\v -> case v of+ Left c -> Left c+ Right Bound -> Left s+ Right (Free a) -> Right a) t liftBase :: Ctx s f b a -> b -> a liftBase Nil = id liftBase (Snoc ctx _ _) = Free . liftBase ctx -abstractTermInCtx :: Ctx s g b a -> f a -> Scope s f b-abstractTermInCtx ctx term = go ctx (ScopeTerm term)- where- go :: Ctx s g b a -> Scope s f a -> Scope s f b- go Nil t = t- go (Snoc ctx s _) t = go ctx (Scope s t)+toBase :: Ctx s f b a -> a -> Maybe b+toBase Nil b = Just b+toBase Snoc{} Bound = Nothing+toBase (Snoc ctx _ _) (Free a) = toBase ctx a++ctxVars :: Ctx s f b a -> [s]+ctxVars Nil = []+ctxVars (Snoc ctx v _) = v : ctxVars ctx++abstractTerm :: Ctx s f b a -> Term p a -> Term p b+abstractTerm Nil term = term+abstractTerm (Snoc ctx v _) term = abstractTerm ctx (Lambda term)
src/TypeChecking/Definitions.hs view
@@ -2,61 +2,47 @@ ( typeCheckDefs ) where -import Control.Monad-import Control.Monad.Error+import Control.Monad.Fix+import Data.Void -import Syntax.Expr as E-import Syntax.Term as T+import Syntax+import Semantics.Value import Syntax.ErrorDoc import TypeChecking.Expressions+import TypeChecking.Expressions.Utils import TypeChecking.Definitions.DataTypes import TypeChecking.Definitions.Functions import TypeChecking.Monad -type Tele = [([Arg], Expr)]- typeCheckDefs :: MonadFix m => [Def] -> TCM m () typeCheckDefs [] = return ()-typeCheckDefs (DefType p@(PIdent (lc,name)) ty : defs) =+typeCheckDefs (DefImport{} : defs) = typeCheckDefs defs+typeCheckDefs (DefFixity{} : defs) = typeCheckDefs defs+typeCheckDefs (DefType p@(pos, name) ty : defs) = case span (theSameAs name) defs of ([],_) -> do- warn [emsgLC lc ("Missing a realization of function " ++ show name) enull]+ warn [Error Other $ emsgLC pos ("Missing a realization of function " ++ show (nameToString name)) enull] typeCheckDefs defs (defs1,defs2) -> do- typeCheckFunction p ty (map defToPDef defs1)+ typeCheckFunction p ty (map (\d -> case d of+ DefFun (pos, _) pats expr -> (pos, pats, expr)+ _ -> error "typeCheckDefs") defs1)+ `catchError` \errs -> warn errs >> return () typeCheckDefs defs2- where- defToPDef :: Def -> ((Int, Int), [ParPat], Maybe Expr)- defToPDef (DefFun (FunCase (E.Pattern (PIdent (lc,_)) pats) expr)) = (lc, pats, Just expr)- defToPDef (DefFunEmpty (E.Pattern (PIdent (lc,_)) pats)) = (lc, pats, Nothing)- defToPDef _ = error "defToPDef"-typeCheckDefs (DefFun (FunCase (E.Pattern p@(PIdent (_,name)) []) expr) : defs) = do+typeCheckDefs (DefFun p@(pos, name) [] (Just expr) : defs) = do (term, ty) <- typeCheck expr Nothing- addFunctionCheck p (FunSyn name term) ty+ addFunctionCheck p (SynEval $ closed term) $ Closed (vacuous ty) typeCheckDefs defs-typeCheckDefs (DefFun (FunCase (E.Pattern (PIdent (lc,name)) _) _) : defs) = do- warn [inferErrorMsg lc "the argument"]- typeCheckDefs $ dropWhile (theSameAs name) defs-typeCheckDefs (DefFunEmpty (E.Pattern (PIdent (lc,name)) []) : defs) = do- warn [emsgLC lc "Expected right hand side" enull]+typeCheckDefs (DefFun (pos, name) [] Nothing : defs) = do+ warn [Error Other $ emsgLC pos "Expected right hand side" enull] typeCheckDefs $ dropWhile (theSameAs name) defs-typeCheckDefs (DefFunEmpty (E.Pattern (PIdent (lc,name)) _) : defs) = do- warn [inferErrorMsg lc "the argument"]+typeCheckDefs (DefFun (pos, name) _ _ : defs) = do+ warn [inferErrorMsg pos "the argument"] typeCheckDefs $ dropWhile (theSameAs name) defs-typeCheckDefs (DefDataEmpty p teles : defs) = typeCheckDefs (DefDataWith p teles [] [] : defs)-typeCheckDefs (DefData p teles cons : defs) = typeCheckDefs (DefDataWith p teles cons [] : defs)-typeCheckDefs (DefDataWith p teles cons conds : defs) = do- dataTeles <- forM teles $ \(DataTele _ e1 e2) -> liftM (\vs -> (vs, e2)) (exprToVars e1)- conTeles <- forM cons $ \(E.Con p teles) -> do- teles' <- forM teles $ \tele ->- case tele of- VarTele _ e1 e2 -> liftM (\vs -> (vs, e2)) (exprToVars e1)- TypeTele e2 -> return ([], e2)- return (p, teles')- typeCheckDataType p dataTeles conTeles $ map (\(FunCase pat expr) -> (pat, expr)) conds+typeCheckDefs (DefData dt ty cons conds : defs) = do+ typeCheckDataType dt ty cons conds typeCheckDefs defs -theSameAs :: String -> Def -> Bool-theSameAs name (DefFun (FunCase (E.Pattern (PIdent (_,name')) _) _)) = name == name'-theSameAs name (DefFunEmpty (E.Pattern (PIdent (_,name')) _)) = name == name'+theSameAs :: Name -> Def -> Bool+theSameAs name (DefFun (_, name') _ _) = name == name' theSameAs _ _ = False
− src/TypeChecking/Definitions/Conditions.hs
@@ -1,140 +0,0 @@-{-# LANGUAGE GADTs, ExistentialQuantification #-}--module TypeChecking.Definitions.Conditions- ( checkConditions- ) where--import Control.Monad-import Control.Monad.State-import Data.Maybe--import Syntax.Term-import Syntax.ErrorDoc-import Syntax.PrettyPrinter-import TypeChecking.Context-import Normalization--checkConditions :: (Int,Int) -> Closed Term -> [([PatternC], Closed (Scope String Term))] -> [EMsg Term]-checkConditions lc func cs =- maybeToList $ msum $ map (\(p, scope) -> fmap (uncurry msg) $ checkPatterns func (map fst cs) p scope) cs- where- msg :: Scope String Term String -> Scope String Term String -> EMsg Term- msg t1 t2 = emsgLC lc "Conditions check failed:" $- scopeToEDoc t1 <+> pretty "is not equal to" <+> scopeToEDoc t2- - scopeToEDoc :: Scope String Term String -> EDoc Term- scopeToEDoc t = epretty $ fmap pretty $ let (_,_,_,t') = scopeToTerm [] id t in t'--data TermInCtx f b = forall a. TermInCtx (Ctx String f b a) (f a)-data TermsInCtx f b = forall a. TermsInCtx (Ctx String f b a) [f a]-data TermsInCtx2 f b = forall a. TermsInCtx2 (Ctx String f b a) [f a] [f a]--checkPatterns :: Closed Term -> [[PatternC]] -> [PatternC] -> Closed (Scope String Term)- -> Maybe (Scope String Term String, Scope String Term String)-checkPatterns (Closed func) cs pats (Closed scope) =- listToMaybe $ findSuspiciousPairs cs pats >>= \(TermsInCtx2 ctx terms terms') ->- let nscope1 = nfAppsScope $ abstractTermInCtx ctx (apps func terms)- nscope2 = abstractTermInCtx ctx (instantiate terms' scope)- in if nfScope nscope1 == nfScope nscope2 then [] else [(nscope1,nscope2)]- where- nfApps :: Eq a => Term a -> Term a- nfApps (App a b) = App (nfApps a) (nf WHNF b)- nfApps (Con i lc name conds terms) = Con i lc name conds $ map (nf WHNF) terms- nfApps t = t- - nfAppsScope :: Eq a => Scope String Term a -> Scope String Term a- nfAppsScope (ScopeTerm t) = ScopeTerm (nfApps t)- nfAppsScope (Scope v t) = Scope v (nfAppsScope t)--findSuspiciousPairs :: [[PatternC]] -> [PatternC] -> [TermsInCtx2 Term b]-findSuspiciousPairs _ [] = []-findSuspiciousPairs cs (pat@(PatternI con) : pats) = map ext $ findSuspiciousPairs (mapTail pat cs) pats- where ext (TermsInCtx2 ctx terms1 terms2) = (TermsInCtx2 ctx (ICon con : terms1) terms2)-findSuspiciousPairs cs (pat@(PatternVar var) : pats) =- check ILeft ++ check IRight ++ map ext (findSuspiciousPairs (mapTail pat cs) pats)- where- ext (TermsInCtx2 ctx terms1 terms2) = TermsInCtx2 (Snoc ctx var $ error "") (Var Bound : map (fmap Free) terms1)- (Var Bound : map (fmap Free) terms2)- check con = if null $ filter (\p -> p == PatternI con) (mapHead cs)- then []- else case patternsToTerms pats of- TermsInCtx ctx terms -> [TermsInCtx2 ctx (ICon con : terms) (ICon con : ctxToVars ctx)]-findSuspiciousPairs cs (pat@(Pattern con@(PatternCon i _ name conds) args) : pats) =- (conds >>= \(cond,_) -> case unifyPatternLists args cond of- Nothing -> []- Just args' -> [ext0 args $ patternsToTerms args']) ++- map ext1 (findSuspiciousPairs cs' args) ++ case patternsToTerms args of- TermsInCtx ctx terms -> map (ext2 ctx terms) (findSuspiciousPairs (mapTail pat cs) pats)- where- cs' = cs >>= \as -> case as of- Pattern con' args' : _ | con == con' -> [args']- _ -> []- - ext0 :: [PatternC] -> TermsInCtx Term b -> TermsInCtx2 Term b- ext0 args (TermsInCtx ctx terms) = case patternsToTerms pats of- TermsInCtx ctx' terms' -> TermsInCtx2 (ctx +++ ctx')- (fmap (liftBase ctx') (Con i (0,0) name conds $ substPatterns args terms) : terms')- (map (fmap $ liftBase ctx') terms ++ ctxToVars ctx')- - ext1 :: TermsInCtx2 Term b -> TermsInCtx2 Term b- ext1 (TermsInCtx2 ctx terms1 terms2) = case patternsToTerms pats of- TermsInCtx ctx' terms' -> TermsInCtx2 (ctx +++ ctx') (fmap (liftBase ctx') (Con i (0,0) name conds terms1) : terms')- (map (fmap $ liftBase ctx') terms2 ++ ctxToVars ctx')- - ext2 :: Ctx String Term a b -> [Term b] -> TermsInCtx2 Term b -> TermsInCtx2 Term a- ext2 ctx terms (TermsInCtx2 ctx' terms1 terms2) =- TermsInCtx2 (ctx +++ ctx') (fmap (liftBase ctx') (Con i (0,0) name conds terms) : terms1)- (map (fmap $ liftBase ctx') (ctxToVars ctx) ++ terms2)--unifyPatterns :: PatternC -> PatternC -> Maybe [PatternC]-unifyPatterns (PatternI con) (PatternI con') | con == con' = Just []-unifyPatterns (PatternVar _) p = Just [p]-unifyPatterns p (PatternVar _) = Just (varList p)-unifyPatterns (Pattern con pats) (Pattern con' pats') | con == con' = unifyPatternLists pats pats'-unifyPatterns _ _ = Nothing--unifyPatternLists :: [PatternC] -> [PatternC] -> Maybe [PatternC]-unifyPatternLists pats pats' = fmap concat $ sequence (zipWith unifyPatterns pats pats')--varList :: Pattern c -> [Pattern c]-varList (PatternI _) = []-varList pat@(PatternVar _) = [pat]-varList (Pattern _ pats) = pats >>= varList--substPatterns :: [PatternC] -> [Term a] -> [Term a]-substPatterns pats terms = evalState (mapM substPattern pats) terms- where- substPattern :: PatternC -> State [Term a] (Term a)- substPattern (PatternI con) = return (ICon con)- substPattern (PatternVar _) = do- term:terms <- get- put terms- return term- substPattern (Pattern (PatternCon i _ name conds) pats) = do- terms <- mapM substPattern pats- return (Con i (0,0) name conds terms)--patternToTerm :: PatternC -> TermInCtx Term a-patternToTerm (PatternI con) = TermInCtx Nil (ICon con)-patternToTerm (PatternVar var) = TermInCtx (Snoc Nil var $ error "") (Var Bound)-patternToTerm (Pattern (PatternCon i _ name conds) pats) = case patternsToTerms pats of- TermsInCtx ctx' terms -> TermInCtx ctx' $ Con i (0,0) name conds terms--patternsToTerms :: [PatternC] -> TermsInCtx Term a-patternsToTerms [] = TermsInCtx Nil []-patternsToTerms (pat:pats) = case patternToTerm pat of- TermInCtx ctx' term -> case patternsToTerms pats of- TermsInCtx ctx'' terms -> TermsInCtx (ctx' +++ ctx'') $ fmap (liftBase ctx'') term : terms--ctxToVars :: Ctx s f b a -> [Term a]-ctxToVars = reverse . go- where- go :: Ctx s f b a -> [Term a]- go Nil = []- go (Snoc ctx _ _) = Var Bound : map (fmap Free) (go ctx)--mapHead :: [[a]] -> [a]-mapHead cs = cs >>= \as -> if null as then [] else [head as]--mapTail :: Eq a => a -> [[a]] -> [[a]]-mapTail a cs = cs >>= \as -> if null as || not (head as == a) then [] else [tail as]
− src/TypeChecking/Definitions/Coverage.hs
@@ -1,89 +0,0 @@-module TypeChecking.Definitions.Coverage- ( checkCoverage- ) where--import Data.List--import Syntax.Pattern--data PatternType c = Interval | DataType Int [(Int, [Pattern c])] | Unknown--data OK = OK | Incomplete deriving Eq-data Result = Result OK [Int]--checkCoverage :: [((Int,Int),[Pattern c])] -> Maybe [(Int,Int)]-checkCoverage [] = Just []-checkCoverage clauses = case checkClauses (map snd clauses) of- Result Incomplete _ -> Nothing- Result OK used -> Just $ map (\i -> fst $ clauses !! i) $ [0 .. length clauses - 1] \\ used--checkClauses :: [[Pattern c]] -> Result-checkClauses [] = Result Incomplete []-checkClauses clauses =- let (t, clauses', b) = checkNull 0 Unknown clauses in- case (b, checkNonEmptyClauses t clauses') of- (Just i, Result Incomplete u) -> Result OK (i:u)- (_, r) -> r--checkNull :: Int -> PatternType c -> [[Pattern c]] -> (PatternType c, [(Pattern c, [Pattern c])], Maybe Int)-checkNull _ t [] = (t, [], Nothing)-checkNull i t ([] : cs) = (t, [], Just i)-checkNull i t ((pat:pats) : cs) =- let (t1, cs', b) = checkNull (i + 1) t cs- t2 = case pat of- PatternI _ -> Interval- PatternVar _ -> t1- Pattern (PatternCon _ n _ _) _ ->- let heads = pat : concatMap (\c -> if null c then [] else [head c]) cs- in DataType n $ heads >>= \p -> case p of- Pattern (PatternCon i _ _ conds) _ -> map (\(cond,_) -> (i,cond)) conds- _ -> []- in (t2, (pat, pats) : cs', b)--checkNonEmptyClauses :: PatternType c -> [(Pattern c, [Pattern c])] -> Result-checkNonEmptyClauses _ [] = Result Incomplete []-checkNonEmptyClauses Interval clauses = checkIntervalClauses clauses-checkNonEmptyClauses (DataType n conds) clauses = checkDataTypeClauses n conds clauses-checkNonEmptyClauses Unknown clauses = checkClauses (map snd clauses)--checkIntervalClauses :: [(Pattern c, [Pattern c])] -> Result-checkIntervalClauses clauses =- let get con = map (\(i,(_,ps)) -> (i,ps)) $ filterWithIndex (\(c,_) -> c == con) clauses- lefts = get (PatternI ILeft)- rights = get (PatternI IRight)- vars = get (PatternVar "")- Result _ is0 = checkClauses (map snd lefts)- Result _ is1 = checkClauses (map snd rights)- Result ok is2 = checkClauses (map snd vars)- in Result ok $ getIndices lefts is0 ++ getIndices rights is1 ++ getIndices vars is2--checkDataTypeClauses :: Int -> [(Int, [Pattern c])] -> [(Pattern c, [Pattern c])] -> Result-checkDataTypeClauses n conds clauses = getResults $ flip map [0 .. n-1] $ \j ->- let getLength [] = 0- getLength (Pattern (PatternCon i _ _ _) args : _) | i == j = length args- getLength (_ : pats) = getLength pats- len = getLength (map fst clauses)- - getPatterns (Pattern _ pats) = pats- getPatterns _ = replicate len (PatternVar "_")- in map (\(i,(p,ps)) -> (i, getPatterns p ++ ps))- (filterWithIndex (\(c,_) -> c == Pattern (PatternCon j n "" []) [] || c == PatternVar "") clauses)- ++ (conds >>= \(c,ps) -> if j == c then [(-1, ps)] else [])- where- getResults :: [[(Int, [Pattern c])]] -> Result- getResults [] = Result OK []- getResults (con:cons) =- let Result ok1 is1 = checkClauses (map snd con)- Result ok2 is2 = getResults cons- in Result (if ok1 == OK && ok2 == OK then OK else Incomplete) (getIndices con is1 ++ is2)--getIndices :: [(Int,b)] -> [Int] -> [Int]-getIndices list = filter (>= 0) . map (\i -> fst $ list !! i)--filterWithIndex :: (a -> Bool) -> [a] -> [(Int,a)]-filterWithIndex p = go 0- where- go _ [] = []- go i (x:xs) =- let rs = go (i + 1) xs- in if p x then (i,x):rs else rs
src/TypeChecking/Definitions/DataTypes.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE RecursiveDo #-}+{-# LANGUAGE RecursiveDo, ExistentialQuantification #-} module TypeChecking.Definitions.DataTypes ( typeCheckDataType@@ -7,109 +7,94 @@ import Control.Monad import Control.Monad.Fix import Data.List+import Data.Bifunctor+import Data.Bifoldable+import Data.Void -import Syntax.Expr as E-import Syntax.Term as T+import Syntax as S+import Semantics+import Semantics.Value as V import Syntax.ErrorDoc import TypeChecking.Monad import TypeChecking.Context import TypeChecking.Expressions-import TypeChecking.Definitions.Patterns-import TypeChecking.Definitions.Conditions+import TypeChecking.Expressions.Utils+import TypeChecking.Expressions.Patterns+import TypeChecking.Expressions.Conditions import TypeChecking.Definitions.Termination import Normalization -type Tele = [([Arg], Expr)]--typeCheckDataType :: MonadFix m => PIdent -> Tele -> [(PIdent,Tele)] -> [(E.Pattern, Expr)] -> TCM m ()-typeCheckDataType p@(PIdent (lc,dt)) params cons conds = mdo+typeCheckDataType :: MonadFix m => PName -> [Tele] -> [S.Con] -> [Clause] -> TCM m ()+typeCheckDataType p@(pos, dt) params cons conds = mdo let lcons = length cons- (SomeEq ctx, dataType@(Type dtTerm _)) <- checkTele Nil params $ Closed (T.Universe NoLevel)- addDataTypeCheck p dataType lcons- cons' <- forW (zip cons [0..]) $ \((con@(PIdent (lc,conName)),tele),i) -> do- (_, Type conType conLevel) <- checkTele ctx tele $ Closed $ DataType dt lcons []- checkPositivity p (nf WHNF conType)- let conTerm = T.Con i lc conName (map snd $ filter (\(c,_) -> c == conName) conds') []- return $ Just (con, conTerm, Type conType conLevel)- forM_ cons' $ \(con, te, Type ty lvl) ->- addConstructorCheck con dt lcons (abstractTermInCtx ctx te) (abstractTermInCtx ctx ty) lvl- conds' <- forW conds $ \(E.Pattern (E.PIdent (lc,con)) pats,expr) ->- case find (\(PIdent (_,c),_,_) -> c == con) cons' of- Nothing -> do- warn [notInScope lc "data constructor" con]- return Nothing- Just (_, _, ty) -> do+ (SomeEq ctx, dataType@(Type dtTerm _)) <- checkTele Nil params $ universe (Set NoLevel)+ dtid <- addDataTypeCheck p lcons $ Closed (vacuous dataType)+ cons' <- forW (zip cons [0..]) $ \(ConDef con@(PIdent pos conName) tele, i) -> do+ (_, Type conType conSort) <- checkTele ctx tele $ Apply (Semantics (Name Prefix dt) $ DataType dtid lcons) (ctxToVars ctx)+ case findOccurrence dtid (nf WHNF conType) of+ Just n | n > 1 -> throwError [Error Other $ emsgLC pos "Data type is not strictly positive" enull]+ _ -> return ()+ let conds'' = map snd $ filter (\(c,_) -> c == conName) conds'+ conTerm = Semantics (Name Prefix $ Ident conName) $ Con $ DCon i lcons (PatEval conds'')+ return $ Just (con, (i, conds'', conTerm), Type conType conSort)+ let ks = map (\(_, _, Type _ k) -> k) cons'+ mk = if null ks then Prop else dmaximum ks+ forM_ cons' $ \(PIdent pcon con, (i, cs, _), Type ty k) ->+ addConstructorCheck (pcon, Ident con) dtid i lcons (PatEval cs) $ Closed $ Type (vacuous $ abstractTerm ctx ty) mk+ conds' <- forW conds $ \(Clause (pos, con) pats expr) ->+ case find (\((PIdent _ c), _, _) -> Ident c == con) cons' of+ Just (PIdent _ conName, (i, _, _), ty) -> do (bf, TermsInCtx ctx' _ ty', rtpats) <- typeCheckPatterns ctx (nfType WHNF ty) pats- when bf $ warn [emsgLC lc "Absurd patterns are not allowed in conditions" enull]- (term, _) <- typeCheckCtx (ctx +++ ctx') expr (Just ty')- let scope = closed (abstractTermInCtx ctx' term)- throwErrors (checkTermination con rtpats scope)- return $ Just (con, (rtpats, scope))- lift $ deleteDataType dt- let lvls = map (\(_, _, Type _ lvl) -> lvl) cons'- lvl = if null lvls then NoLevel else maximum lvls- lift $ addDataType dt (Type (replaceLevel dtTerm lvl) lvl) lcons- forM_ cons' $ \(_, T.Con i lc' conName conConds [], _) -> do- warn $ checkConditions lc (Closed $ T.Con i lc' conName conConds []) conConds+ when bf $ warn [Error Other $ emsgLC pos "Absurd patterns are not allowed in conditions" enull]+ (term, _) <- typeCheckCtx (ctx +++ ctx') expr $ Just (nfType WHNF ty')+ let scope = closed (abstractTerm ctx' term)+ throwErrors $ checkTermination (Left i) pos (map (first snd) rtpats) scope+ return $ Just (conName, (rtpats, scope))+ _ -> do+ warn [notInScope pos "data constructor" (nameToString con)]+ return Nothing+ lift $ replaceDataType dt lcons $ Closed $ Type (vacuous $ replaceSort dtTerm mk) mk+ forM_ cons' $ \(PIdent pos _, (_, conds, con), _) -> warn $+ checkConditions pos Nil (capply con) $ map (\(p, Closed t) -> (p, t)) conds -checkTele :: (Monad m, Eq a) => Ctx String Type String a -> Tele -> Closed Term- -> TCM m (SomeEq (Ctx String Type String), Type a)-checkTele ctx [] (Closed term) = return (SomeEq ctx, Type term NoLevel)-checkTele ctx ((args,expr):tele) term = do- (r1, Type t1 _) <- typeCheckCtx ctx expr Nothing- lvl1 <- checkIsType ctx expr (nf WHNF t1)- case extendCtx (map unArg args) Nil (Type r1 lvl1) of- SomeEq ctx' -> do- (rctx, Type r2 lvl2) <- checkTele (ctx +++ ctx') tele term- return (rctx, Type (T.Pi (Type r1 lvl1) (abstractTermInCtx ctx' r2) lvl2) $ max lvl1 lvl2)+data SomeEq f = forall a. Eq a => SomeEq (f a) -replaceLevel :: Term a -> Level -> Term a-replaceLevel (T.Pi r1 r2 lvl2) lvl = T.Pi r1 (replaceLevelScope r2) lvl2- where- replaceLevelScope :: Scope String Term a -> Scope String Term a- replaceLevelScope (ScopeTerm t) = ScopeTerm (replaceLevel t lvl)- replaceLevelScope (Scope v t) = Scope v (replaceLevelScope t)-replaceLevel _ lvl = T.Universe lvl+extendCtx :: (Functor t, Eq a) => [s] -> Ctx s t b a -> t a -> SomeEq (Ctx s t b)+extendCtx [] ctx _ = SomeEq ctx+extendCtx (x:xs) ctx t = extendCtx xs (Snoc ctx x t) (fmap Free t) -checkPositivity :: (Eq a, Monad m) => PIdent -> Term a -> EDocM m ()-checkPositivity dt (T.Pi (Type a _) b _) = checkNoNegative dt (nf WHNF a) >> checkPositivityScope b- where- checkPositivityScope :: (Eq a, Monad m) => Scope String Term a -> EDocM m ()- checkPositivityScope (ScopeTerm t) = checkPositivity dt (nf WHNF t)- checkPositivityScope (Scope v t) = checkPositivityScope t-checkPositivity _ _ = return ()+checkTele :: (Monad m, Eq a) => Ctx String (Type Semantics) Void a -> [Tele] -> Term Semantics a+ -> TCM m (SomeEq (Ctx String (Type Semantics) Void), Type Semantics a)+checkTele ctx [] term = return (SomeEq ctx, Type term $ Set NoLevel)+checkTele ctx (VarsTele vars expr : tele) term = do+ (r1, Type t1 _) <- typeCheckCtx ctx expr Nothing+ k1 <- checkIsType ctx (termPos expr) (nf WHNF t1)+ case extendCtx (map getName vars) Nil (Type r1 k1) of+ SomeEq ctx' -> do+ (rctx, Type r2 k2) <- checkTele (ctx +++ ctx') tele $ fmap (liftBase ctx') term+ let sem = Semantics (S.Pi Explicit $ reverse $ ctxVars ctx') (V.Pi k1 k2)+ return (rctx, Type (Apply sem [r1, abstractTerm ctx' r2]) $ dmax k1 k2)+checkTele ctx (TypeTele expr : tele) term = do+ (r1, Type t1 _) <- typeCheckCtx ctx expr Nothing+ k1 <- checkIsType ctx (termPos expr) (nf WHNF t1)+ (rctx, Type r2 k2) <- checkTele ctx tele term+ return (rctx, Type (Apply (Semantics (S.Pi Explicit []) $ V.Pi k1 k2) [r1,r2]) $ dmax k1 k2) -checkNoNegative :: (Eq a, Monad m) => PIdent -> Term a -> EDocM m ()-checkNoNegative dt (T.Pi (Type a _) b _) = checkNoDataType dt a >> checkNoNegativeScope b- where- checkNoNegativeScope :: (Eq a, Monad m) => Scope String Term a -> EDocM m ()- checkNoNegativeScope (ScopeTerm t) = checkNoNegative dt (nf WHNF t)- checkNoNegativeScope (Scope v t) = checkNoNegativeScope t-checkNoNegative _ _ = return ()+replaceSort :: Term Semantics a -> Sort -> Term Semantics a+replaceSort (Apply p@(Semantics _ V.Pi{}) [a,b]) k = Apply p [a, replaceSort b k]+replaceSort (Lambda t) k = Lambda (replaceSort t k)+replaceSort _ k = universe k -checkNoDataType :: Monad m => PIdent -> Term a -> EDocM m ()-checkNoDataType (PIdent (lc,dt)) t = when (dt `elem` collectDataTypes t) $- throwError [emsgLC lc "Data type is not strictly positive" enull]+findOccurrence :: Eq a => ID -> Term Semantics a -> Maybe Int+findOccurrence dt (Apply (Semantics _ V.Pi{}) [a,b]) = case (findOccurrence dt $ nf WHNF a, findOccurrence dt $ nf WHNF b) of+ (Nothing, Nothing) -> Nothing+ (Nothing, Just b') -> Just b'+ (Just a', Nothing) -> Just (succ a')+ (Just a', Just b') -> Just $ max (succ a') b'+findOccurrence dt (Lambda t) = findOccurrence dt (nf WHNF t)+findOccurrence dt t = if dt `elem` collectDataTypes t then Just 0 else Nothing -collectDataTypes :: Term a -> [String]-collectDataTypes T.Var{} = []-collectDataTypes (T.App e1 e2) = collectDataTypes e1 ++ collectDataTypes e2-collectDataTypes (T.Lam (Scope1 _ e)) = collectDataTypes e-collectDataTypes (T.Pi (Type e _) s _) = collectDataTypes e ++ go s- where- go :: Scope s Term a -> [String]- go (ScopeTerm t) = collectDataTypes t- go (Scope _ s) = go s-collectDataTypes (T.Con _ _ _ _ as) = as >>= collectDataTypes-collectDataTypes FunCall{} = []-collectDataTypes FunSyn{} = []-collectDataTypes (DataType d _ as) = d : (as >>= collectDataTypes)-collectDataTypes T.Universe{} = []-collectDataTypes T.Interval = []-collectDataTypes ICon{} = []-collectDataTypes (T.Path _ me1 es) = maybe [] collectDataTypes me1 ++ (es >>= collectDataTypes)-collectDataTypes (PCon me) = maybe [] collectDataTypes me-collectDataTypes (T.At _ _ e3 e4) = collectDataTypes e3 ++ collectDataTypes e4-collectDataTypes (T.Coe es) = es >>= collectDataTypes-collectDataTypes (T.Iso es) = es >>= collectDataTypes-collectDataTypes (T.Squeeze es) = es >>= collectDataTypes+collectDataTypes :: Term Semantics a -> [ID]+collectDataTypes = biconcatMap (\t -> case t of+ Semantics _ (DataType dt _) -> [dt]+ _ -> []) (const [])
src/TypeChecking/Definitions/Functions.hs view
@@ -1,53 +1,64 @@-{-# LANGUAGE RecursiveDo #-}- module TypeChecking.Definitions.Functions ( typeCheckFunction ) where -import Control.Monad-import Control.Monad.Fix import Data.Maybe+import Data.Void+import Data.Bifunctor -import Syntax.Expr as E-import Syntax.Term as T+import Syntax+import Semantics+import Semantics.Value import Syntax.ErrorDoc import TypeChecking.Monad import TypeChecking.Context import TypeChecking.Expressions-import TypeChecking.Definitions.Patterns-import TypeChecking.Definitions.Coverage-import TypeChecking.Definitions.Conditions+import TypeChecking.Expressions.Utils+import TypeChecking.Expressions.Patterns+import TypeChecking.Expressions.Coverage+import TypeChecking.Expressions.Conditions import TypeChecking.Definitions.Termination import Normalization -typeCheckFunction :: MonadFix m => PIdent -> Expr -> [((Int, Int), [ParPat], Maybe Expr)] -> TCM m ()-typeCheckFunction p@(PIdent (lc,name)) ety clauses = mdo+typeCheckFunction :: Monad m => PName -> Term (Posn, Syntax) Void+ -> [(Posn, [Term PName Void], Maybe (Term (Posn, Syntax) Void))] -> TCM m ()+typeCheckFunction p@(pos, name) ety clauses = do (ty, Type u _) <- typeCheck ety Nothing- lvl <- case u of- T.Universe lvl -> return lvl- _ -> throwError [emsgLC (getPos ety) "" $ pretty "Expected a type" $$- pretty "Actual type:" <+> prettyOpen Nil ty]- addFunctionCheck p (FunCall lc name clauses') (Type ty lvl)- clausesAndPats <- forW clauses $ \(lc,pats,mexpr) -> do- (bf, TermsInCtx ctx _ ty', rtpats) <- typeCheckPatterns Nil (Type (nf WHNF ty) lvl) pats+ k <- case nf WHNF u of+ Apply (Semantics _ (Universe k)) _ -> return k+ u' -> throwError [Error TypeMismatch $ emsgLC (termPos ety) "" $ pretty "Expected a type"+ $$ pretty "Actual type:" <+> prettyOpen Nil u']+ let cty = Closed $ Type (vacuous ty) k+ fcid <- addFunctionCheck p (PatEval []) cty+ clausesAndPats <- forW clauses $ \(pos,pats,mexpr) -> do+ (bf, TermsInCtx ctx _ ty', rtpats) <- typeCheckPatterns Nil (Type (nf WHNF ty) k) pats case (bf,mexpr) of (True, Nothing) -> return Nothing (False, Nothing) -> do let msg = "The right hand side can be omitted only if the absurd pattern is given"- warn [emsgLC lc msg enull]+ warn [Error Other $ emsgLC pos msg enull] return Nothing (True, Just expr) -> do let msg = "If the absurd pattern is given the right hand side must be omitted"- warn [emsgLC (getPos expr) msg enull]+ warn [Error Other $ emsgLC (termPos expr) msg enull] return Nothing (False, Just expr) -> do- (term, _) <- typeCheckCtx ctx expr (Just ty')- let scope = closed (abstractTermInCtx ctx term)- throwErrors (checkTermination name rtpats scope)- return $ Just ((rtpats, scope), (lc, rtpats))+ (term, _) <- typeCheckCtx ctx expr $ Just (nfType WHNF ty')+ let scope = closed (abstractTerm ctx term)+ rtpats' = map (first snd) rtpats+ throwErrors $ checkTermination (Right fcid) pos rtpats' scope+ return $ Just ((rtpats, scope), (pos, rtpats')) let clauses' = map fst clausesAndPats+ eval = PatEval $ map (fmap $ \(Closed scope) -> Closed $ replaceFunCalls fcid fc scope) clauses'+ fc = Closed $ capply $ Semantics (Name Prefix name) (FunCall fcid eval)+ lift $ replaceFunction name eval cty case checkCoverage (map snd clausesAndPats) of- Nothing -> when (length clausesAndPats == length (filter (\(_,_,me) -> isJust me) clauses)) $- warn [emsgLC lc "Incomplete pattern matching" enull]- Just uc -> warn $ map (\lc -> emsgLC lc "Unreachable clause" enull) uc- warn $ checkConditions lc (Closed $ FunCall lc name clauses') (map fst clausesAndPats)+ Nothing | length clausesAndPats /= length (filter (\(_,_,me) -> isJust me) clauses) -> return ()+ r -> warn (coverageErrorMsg pos r)+ warn $ checkConditions pos Nil (open fc) $ map (\((p,Closed t),_) -> (p,t)) clausesAndPats++replaceFunCalls :: ID -> Closed (Term Semantics) -> Term Semantics a -> Term Semantics a+replaceFunCalls name fc (Var a ts) = Var a $ map (replaceFunCalls name fc) ts+replaceFunCalls name fc (Apply (Semantics _ (FunCall name' _)) ts) | name == name' = apps (open fc) ts+replaceFunCalls name fc (Apply s ts) = Apply s $ map (replaceFunCalls name fc) ts+replaceFunCalls name fc (Lambda t) = Lambda (replaceFunCalls name fc t)
− src/TypeChecking/Definitions/Patterns.hs
@@ -1,79 +0,0 @@-{-# LANGUAGE ExistentialQuantification #-}--module TypeChecking.Definitions.Patterns- ( typeCheckPatterns- , TermsInCtx(..)- ) where--import Syntax.Expr as E-import Syntax.Term as T-import Syntax.ErrorDoc-import TypeChecking.Context-import TypeChecking.Monad-import TypeChecking.Expressions-import Normalization--data TermInCtx b = forall a. Eq a => TermInCtx (Ctx String Type b a) (Term a)-data TermsInCtx b = forall a. Eq a => TermsInCtx (Ctx String Type b a) [Term a] (Type a)--typeCheckPattern :: (Monad m, Eq a) => Ctx String Type String a- -> Type a -> ParPat -> TCM m (Bool, Maybe (TermInCtx a), T.Pattern (Closed (Scope String Term)))-typeCheckPattern ctx (Type T.Interval _) (ParLeft _) = return (False, Just $ TermInCtx Nil $ ICon ILeft , PatternI ILeft)-typeCheckPattern ctx (Type T.Interval _) (ParRight _) = return (False, Just $ TermInCtx Nil $ ICon IRight, PatternI IRight)-typeCheckPattern ctx (Type (DataType _ 0 _) _) (ParEmpty _) = return (True, Nothing, PatternVar "_")-typeCheckPattern ctx (Type ty _) (ParEmpty (PPar (lc,_))) =- throwError [emsgLC lc "" $ pretty "Expected non-empty type:" <+> prettyOpen ctx ty]-typeCheckPattern ctx _ (ParVar (NoArg _)) = return (False, Nothing, PatternVar "_")-typeCheckPattern ctx ty@(Type (DataType dt _ params) _) (ParVar (Arg (PIdent (lc,var)))) = do- cons <- lift $ getConstructor var (Just dt)- case cons of- [] -> return (False, Just $ TermInCtx (Snoc Nil var ty) $ T.Var Bound, PatternVar var)- (n,con,(conType,_)):_ -> if isDataType conType- then let con'@(T.Con i _ conName conds _) = instantiate params $ fmap (liftBase ctx) con- in return (False, Just $ TermInCtx Nil con', T.Pattern (PatternCon i n conName conds) [])- else throwError [emsgLC lc ("Not enough arguments to " ++ show var) enull]- where- isDataType :: Scope a Term b -> Bool- isDataType (ScopeTerm DataType{}) = True- isDataType (ScopeTerm _) = False- isDataType (Scope _ t) = isDataType t-typeCheckPattern ctx ty (ParVar (Arg (PIdent (lc,var)))) =- return (False, Just $ TermInCtx (Snoc Nil var ty) $ T.Var Bound, PatternVar var)-typeCheckPattern ctx (Type (DataType dt _ params) _) (ParPat _ (E.Pattern (PIdent (lc,conName)) pats)) = do- cons <- lift $ getConstructor conName (Just dt)- case cons of- [] -> throwError [notInScope lc "data constructor" conName]- (n,con,(conType,lvl)):_ -> do- let T.Con i _ _ conds _ = instantiate params $ fmap (liftBase ctx) con- conType' = Type (nf WHNF $ instantiate params $ fmap (liftBase ctx) conType) lvl- (bf, TermsInCtx ctx' terms (Type ty _), rtpats) <- typeCheckPatterns ctx conType' pats- let res = TermInCtx ctx' (T.Con i lc conName conds terms)- case nf WHNF ty of- DataType{} -> return (bf, Just res, T.Pattern (PatternCon i n conName conds) rtpats)- _ -> throwError [emsgLC lc "Not enough arguments" enull]-typeCheckPattern ctx (Type ty _) pat =- throwError [emsgLC (parPatGetPos pat) "" $ pretty "Unexpected pattern" $$- pretty "Expected type:" <+> prettyOpen ctx ty]--typeCheckPatterns :: (Monad m, Eq a) => Ctx String Type String a -> Type a -> [ParPat]- -> TCM m (Bool, TermsInCtx a, [T.Pattern (Closed (Scope String Term))])-typeCheckPatterns _ ty [] = return (False, TermsInCtx Nil [] ty, [])-typeCheckPatterns ctx (Type (T.Pi a b lvl) _) (pat:pats) = do- let a' = nfType WHNF a- (bf1, mte, rtpat) <- typeCheckPattern ctx a' pat- TermInCtx ctx' te <- case mte of- Nothing ->- let var = case b of- Scope v _ -> v- _ -> "_"- in return $ TermInCtx (Snoc Nil var a') (T.Var Bound)- Just te -> return te- let b' = instantiate1 te $ fmap (fmap $ liftBase ctx') $ unScope1 (dropOnePi a b lvl)- (bf2, TermsInCtx ctx'' tes ty, rtpats) <- typeCheckPatterns (ctx +++ ctx') (Type (nf WHNF b') lvl) pats- return (bf1 || bf2, TermsInCtx (ctx' +++ ctx'') (fmap (liftBase ctx'') te : tes) ty, rtpat:rtpats)-typeCheckPatterns _ _ (pat:_) = throwError [emsgLC (parPatGetPos pat) "Too many arguments" enull]--getVariables :: ParPat -> [PIdent]-getVariables (ParPat _ (E.Pattern _ pats)) = pats >>= getVariables-getVariables (ParVar (Arg var)) = [var]-getVariables _ = []
src/TypeChecking/Definitions/Termination.hs view
@@ -6,42 +6,43 @@ import Control.Monad.State -import Syntax.Term+import qualified Syntax as S+import Semantics.Value+import Semantics import Syntax.ErrorDoc import TypeChecking.Context+import TypeChecking.Expressions.Utils -checkTermination :: String -> [PatternC] -> Closed (Scope String Term) -> [EMsg Term]-checkTermination name pats (Closed scope) = map msg $ case scopeToCtx Nil scope of- TermInCtx ctx term -> collectFunCalls ctx name [] term >>= \(lc,mts) -> case mts of- Nothing -> [lc]- Just (TermsInCtx ctx ts) -> if evalState (checkTerms ctx pats ts) 0 == LT then [] else [lc]+checkTermination :: Either Int ID -> S.Posn -> [Term (Con t) String] -> Closed (Term Semantics) -> [Error]+checkTermination name pos pats (Closed scope) = map msg $ case scopeToCtx Nil scope of+ TermInCtx ctx term -> collectFunCalls ctx name term >>= \mts -> case mts of+ TermsInCtx ctx' terms -> if evalState (checkTerms ctx' pats terms) 0 == LT then [] else [pos] where- msg :: (Int,Int) -> EMsg Term- msg lc = emsgLC lc "Termination check failed" enull+ msg :: S.Posn -> Error+ msg pos = Error Other $ emsgLC pos "Termination check failed" enull -checkTerm :: Ctx String Term String a -> PatternC -> Term a -> State Int Ordering-checkTerm ctx (PatternI con) (ICon con') | con == con' = return EQ-checkTerm ctx (PatternVar _) (Var v) = do+checkTerm :: Ctx String (Term Semantics) String a -> Term (Con t) String -> Term Semantics a -> State Int Ordering+checkTerm _ (Apply (ICon con) _) (Apply (Semantics _ (Con (ICon con'))) []) | con == con' = return EQ+checkTerm ctx Var{} (Var v []) = do s <- get put (s + 1) return $ if s == lengthCtx ctx - 1 - index ctx v then EQ else GT where- index :: Ctx String Term b a -> a -> Int+ index :: Ctx String (Term Semantics) b a -> a -> Int index Nil _ = 0 index (Snoc ctx _ _) Bound = 0 index (Snoc ctx _ _) (Free a) = index ctx a + 1-checkTerm ctx (Pattern (PatternCon i _ _ _) pats) term = do+checkTerm ctx (Apply (DCon i _ _) pats) term = do s <- get results <- mapM (\pat -> checkTerm ctx pat term) pats- let result = minimum (GT:results)- if result /= GT then return LT else case collect term of- Con i' _ _ _ terms | i == i' -> do+ if minimum (GT:results) /= GT then return LT else case term of+ Apply (Semantics _ (Con (DCon i' _ _))) terms | i == i' -> do put s checkTerms ctx pats terms _ -> return GT checkTerm _ _ _ = return GT -checkTerms :: Ctx String Term String a -> [PatternC] -> [Term a] -> State Int Ordering+checkTerms :: Ctx String (Term Semantics) String a -> [Term (Con t) String] -> [Term Semantics a] -> State Int Ordering checkTerms _ [] _ = return EQ checkTerms _ _ [] = return EQ checkTerms ctx (pat:pats) (term:terms) = do@@ -53,35 +54,15 @@ data TermInCtx s f b = forall a. TermInCtx (Ctx s f b a) (f a) data TermsInCtx s f b = forall a. TermsInCtx (Ctx s f b a) [f a] -scopeToCtx :: Ctx s f b a -> Scope s f a -> TermInCtx s f b-scopeToCtx ctx (ScopeTerm t) = TermInCtx ctx t-scopeToCtx ctx (Scope s t) = scopeToCtx (Snoc ctx s $ error "") t--collectFunCalls :: Ctx String Term b a -> String -> [Term a] -> Term a -> [((Int,Int), Maybe (TermsInCtx String Term b))]-collectFunCalls _ _ _ Var{} = []-collectFunCalls ctx name ts (App e1 e2) = collectFunCalls ctx name (e2:ts) e1 ++ collectFunCalls ctx name [] e2-collectFunCalls ctx name _ (Lam (Scope1 v e)) = collectFunCalls (Snoc ctx v $ error "") name [] e-collectFunCalls ctx name _ (Pi (Type e _) s _) = collectFunCalls ctx name [] e ++ go ctx s- where- go :: Ctx String Term b a -> Scope String Term a -> [((Int,Int), Maybe (TermsInCtx String Term b))]- go ctx (ScopeTerm t) = collectFunCalls ctx name [] t- go ctx (Scope v t) = go (Snoc ctx v $ error "") t-collectFunCalls ctx name ts (Con _ lc name' _ as) =- (if name == name' then [(lc, Just $ TermsInCtx ctx $ as ++ ts)] else []) ++ (as >>= collectFunCalls ctx name [])-collectFunCalls ctx name ts (FunCall lc name' _) = if name == name' then [(lc, Just $ TermsInCtx ctx ts)] else []-collectFunCalls ctx name _ FunSyn{} = []-collectFunCalls ctx name _ (DataType _ _ as) = as >>= collectFunCalls ctx name []-collectFunCalls ctx name _ Universe{} = []-collectFunCalls ctx name _ Interval = []-collectFunCalls ctx name _ ICon{} = []-collectFunCalls ctx name _ (Path _ me1 es) =- maybe [] (collectFunCalls ctx name []) me1 ++ (es >>= collectFunCalls ctx name [])-collectFunCalls ctx name _ (PCon me) = maybe [] (collectFunCalls ctx name []) me-collectFunCalls ctx name _ (At _ _ e3 e4) = collectFunCalls ctx name [] e3 ++ collectFunCalls ctx name [] e4-collectFunCalls ctx name _ (Coe es) = es >>= collectFunCalls ctx name []-collectFunCalls ctx name _ (Iso es) = es >>= collectFunCalls ctx name []-collectFunCalls ctx name _ (Squeeze es) = es >>= collectFunCalls ctx name []+scopeToCtx :: Ctx s (Term Semantics) b a -> Term Semantics a -> TermInCtx s (Term Semantics) b+scopeToCtx ctx (Lambda t) = scopeToCtx (Snoc ctx (error "") $ error "") t+scopeToCtx ctx t = TermInCtx ctx t -scopedToMaybe :: Scoped a -> Maybe a-scopedToMaybe Bound = Nothing-scopedToMaybe (Free a) = Just a+collectFunCalls :: Ctx String (Term Semantics) b a -> Either Int ID+ -> Term Semantics a -> [TermsInCtx String (Term Semantics) b]+collectFunCalls ctx name (Lambda t) = collectFunCalls (Snoc ctx (error "") $ error "") name t+collectFunCalls ctx name (Var _ as) = as >>= collectFunCalls ctx name+collectFunCalls ctx name (Apply a as) = (case a of+ Semantics _ (Con (DCon name' _ _)) | name == Left name' -> [TermsInCtx ctx as]+ Semantics _ (FunCall name' _) | name == Right name' -> [TermsInCtx ctx as]+ _ -> []) ++ (as >>= collectFunCalls ctx name)
src/TypeChecking/Expressions.hs view
@@ -1,306 +1,416 @@-{-# LANGUAGE FlexibleContexts, ExistentialQuantification #-}- module TypeChecking.Expressions ( typeCheck, typeCheckCtx- , notInScope, inferErrorMsg, inferParamsErrorMsg- , prettyOpen, exprToVars- , checkUniverses, checkIsType- , SomeEq(..), extendCtx ) where import Control.Monad-import Data.List+import Data.Either import Data.Maybe+import Data.Void+import Data.Bifunctor+import Data.Bitraversable+import Data.Traversable(sequenceA) -import Syntax.Expr as E-import Syntax.Term as T+import Syntax as S+import Semantics+import Semantics.Value as V import Syntax.ErrorDoc import TypeChecking.Monad import TypeChecking.Context+import TypeChecking.Expressions.Utils+import TypeChecking.Expressions.Patterns+import TypeChecking.Expressions.Conditions+import TypeChecking.Expressions.Coverage import Normalization -notInScope :: Show a => (Int,Int) -> String -> a -> EMsg f-notInScope lc s a = emsgLC lc ("Not in scope: " ++ (if null s then "" else s ++ " ") ++ show a) enull--inferErrorMsg :: (Int,Int) -> String -> EMsg f-inferErrorMsg lc s = emsgLC lc ("Cannot infer type of " ++ s) enull+type Context = Ctx String (Type Semantics) Void -inferParamsErrorMsg :: Show a => (Int,Int) -> a -> EMsg f-inferParamsErrorMsg lc d = emsgLC lc ("Cannot infer parameters of data constructor " ++ show d) enull+intType :: Type Semantics a+intType = Type interval (TypeK NoLevel) -expectedArgErrorMsg :: Show a => (Int,Int) -> a -> EMsg f-expectedArgErrorMsg lc d = emsgLC lc ("Expected an argument to " ++ show d) enull+pathExp :: Sort -> Semantics+pathExp k = Semantics (Name Prefix $ Ident "Path") (Path k) -prettyOpen :: (Pretty b f, Monad f) => Ctx b g b a -> f a -> EDoc f-prettyOpen ctx term = epretty $ liftM pretty (close ctx term)+pathImp :: Sort -> Semantics+pathImp k = Semantics PathImp (Path k) -exprToVars :: Monad m => Expr -> EDocM m [Arg]-exprToVars = liftM reverse . go- where- go (E.Var a) = return [a]- go (E.App as (E.Var a)) = liftM (a:) (go as)- go e = throwError [emsgLC (getPos e) "Expected a list of identifiers" enull]+sortPred :: Sort -> Sort+sortPred Prop = Contr+sortPred Set{} = Prop+sortPred k = k -checkUniverses :: (Pretty b Term, Monad m) => Ctx b g b a1 -> Ctx b g b a2- -> Expr -> Expr -> Term a1 -> Term a2 -> EDocM m Level-checkUniverses ctx1 ctx2 e1 e2 (T.Universe lvl1) (T.Universe lvl2) = return (max lvl1 lvl2)-checkUniverses ctx1 _ e1 _ t1 (T.Universe _) = throwError [typeErrorMsg ctx1 e1 t1]-checkUniverses _ ctx2 _ e2 (T.Universe _) t2 = throwError [typeErrorMsg ctx2 e2 t2]-checkUniverses ctx1 ctx2 e1 e2 t1 t2 = throwError [typeErrorMsg ctx1 e1 t1, typeErrorMsg ctx2 e2 t2]+prettyOpen' :: Ctx String (Type Semantics) Void a -> Term Semantics (Either k a) -> EDoc (Term Syntax)+prettyOpen' ctx term = epretty $ fmap (pretty . either id absurd) $ close ctx $+ first syntax term >>= fmap Right . either (const $ capply $ Name Prefix $ Ident "?") return -checkIsType :: (Pretty b Term, Monad m) => Ctx b g b a -> Expr -> Term a -> EDocM m Level-checkIsType _ _ (T.Universe lvl) = return lvl-checkIsType ctx e t = throwError [typeErrorMsg ctx e t]+typeCheck :: Monad m => Term (Posn, Syntax) Void -> Maybe (Type Semantics Void) -> TCM m (Term Semantics Void, Type Semantics Void)+typeCheck = typeCheckCtx Nil -typeErrorMsg :: Pretty b Term => Ctx b g b a -> Expr -> Term a -> EMsg Term-typeErrorMsg ctx e t = emsgLC (getPos e) "" $ pretty "Expected type: Type" $$- pretty "Actual type:" <+> prettyOpen ctx t+typeCheckCtx :: (Monad m, Eq a) => Context a -> Term (Posn, Syntax) Void+ -> Maybe (Type Semantics a) -> TCM m (Term Semantics a, Type Semantics a)+typeCheckCtx ctx term mty = do+ (te, ty, _) <- typeCheckCtx' ctx term $ fmap (\(Type t k) -> Type (fmap Right t) k) mty+ return (te, ty) -intType :: Type a-intType = Type T.Interval NoLevel+typeCheckCtx' :: (Monad m, Eq a) => Context a -> Term (Posn, Syntax) Void -> Maybe (Type Semantics (Either Argument a))+ -> TCM m (Term Semantics a, Type Semantics a, [(Argument, Term Semantics a)])+typeCheckCtx' ctx (Apply (pos, Name ft var) ts) mty = typeCheckName ctx pos ft var ts mty+typeCheckCtx' ctx (Apply (_, S.Lam []) [te]) mty = typeCheckCtx' ctx te mty+typeCheckCtx' ctx (Apply (pos, S.Lam (v:vs)) [te]) (Just (Type (Apply p@(Semantics (S.Pi e _) (V.Pi k1 k2)) [a,b]) k3)) =+ case bitraverse Right id a of+ Left{} -> throwError [inferErrorMsg pos "the argument"]+ Right a' -> do+ (te', Type b' k2', tab) <- typeCheckCtx' (Snoc ctx v $ Type a' k1) (Apply (pos, S.Lam vs) [te]) $+ Just $ Type (nf WHNF $ fmap sequenceA $ snd $ dropOnePi p a b) k2+ let te'' = case te' of+ Apply (Semantics (S.Lam vs') _) [t] -> Apply (Semantics (S.Lam $ v:vs') V.Lam) [Lambda t]+ _ -> Apply (Semantics (S.Lam [v]) V.Lam) [Lambda te']+ tab' = tab >>= \(kp, term) -> case sequenceA term of+ Bound -> []+ Free t -> [(kp, t)]+ return (te'', Type (Apply (Semantics (S.Pi e [v]) $ V.Pi k1 k2') [a', Lambda b']) k3, tab')+typeCheckCtx' ctx (Apply (pos, S.Lam{}) [_]) (Just (Type (Var Left{} _) _)) =+ throwError [inferErrorMsg pos "lambda expressions"]+typeCheckCtx' ctx (Apply (pos, S.Lam{}) [_]) (Just (Type ty _)) =+ throwError [Error TypeMismatch $ emsgLC pos "" $ pretty "Expected type:" <+> prettyOpen' ctx ty+ $$ pretty "But lambda expression has pi type"]+typeCheckCtx' ctx (Apply (pos, S.Lam{}) _) _ = throwError [inferErrorMsg pos "the argument"]+typeCheckCtx' ctx (Apply (pos, S.Pi e vs) (a:b:ts)) Nothing = do+ (a', Type ty1 _) <- typeCheckCtx ctx a Nothing+ k1 <- checkIsType ctx (termPos a) ty1+ (b', k2) <- extend ctx vs (Type a' k1)+ unless (null ts) $ warn [argsErrorMsg pos "A type"]+ let k = case (k1, k2) of+ (_, Contr) -> Contr+ (_, Prop) -> Prop+ (Set l1, Set l2) -> Set (max l1 l2)+ (TypeK l1, Set l2) -> Set (max l1 l2)+ (_, Set l) -> Set l+ (Set l1, TypeK l2) -> TypeK (max l1 l2)+ (TypeK l1, TypeK l2) -> TypeK (max l1 l2)+ (_, TypeK l) -> TypeK l+ return (Apply (Semantics (S.Pi e vs) (V.Pi k1 k2)) [a', b'], Type (universe k) $ succ k, [])+ where+ extend :: (Monad m, Eq a) => Context a -> [String] -> Type Semantics a -> TCM m (Term Semantics a, Sort)+ extend ctx [] _ = do+ (te, Type ty _) <- typeCheckCtx ctx b Nothing+ k <- checkIsType ctx (termPos b) ty+ return (te, k)+ extend ctx (v:vs) a = do+ (te, k) <- extend (Snoc ctx v a) vs (fmap Free a)+ return (Lambda te, k)+typeCheckCtx' ctx (Apply (pos, PathImp) (a1:a2:ts)) Nothing = do+ unless (null ts) $ warn [argsErrorMsg pos "A type"]+ (r1, Type t1 k) <- typeCheckCtx ctx a1 Nothing+ (r2, _) <- typeCheckCtx ctx a2 $ Just $ Type (nf WHNF t1) k+ return (Apply (pathImp k) [Apply (Semantics (S.Lam ["_"]) V.Lam)+ [Lambda $ fmap Free t1], r1, r2], Type (universe $ sortPred k) $ succ $ sortPred k, [])+typeCheckCtx' ctx (Apply (pos, S.At) (b:c:ts)) mty = do+ (r1, Type t1 k) <- typeCheckCtx ctx b Nothing+ (r2, _) <- typeCheckCtx ctx c (Just intType)+ case nf WHNF t1 of+ Apply (Semantics _ Path{}) [a,b',c'] -> do+ (tes, ty, tab) <- typeCheckApps pos (Just $ Operator "@") ctx ts (Type (apps a [r2]) k) mty+ return (Apply (Semantics S.At V.At) (b':c':r1:r2:tes), ty, tab)+ t1' -> throwError [Error TypeMismatch $ emsgLC pos "" $ pretty "Expected type: Path"+ $$ pretty "Actual type:" <+> prettyOpen ctx t1']+typeCheckCtx' ctx (Apply (pos, (S.Case (pat:pats))) (expr:terms)) mty = do+ (exprTerm, exprType) <- typeCheckCtx ctx expr Nothing+ let (term1:terms1,terms2) = splitAt (length pats + 1) terms+ typeCheckClause mtype (pat,term) = do+ (bf, mt, pat') <- typeCheckPattern ctx exprType pat+ when bf $ warn [Error Other $ emsgLC (termPos pat) "Absurd patterns are not allowed in case constructions" enull]+ case fromMaybe (TermInCtx (Snoc Nil "_" exprType) $ error "") mt of+ TermInCtx ctx' _ -> do+ (te, Type ty k, tab) <- typeCheckCtx' (ctx +++ ctx') term $ fmap (fmap $ fmap $ liftBase ctx') mtype+ let tab' = tab >>= \(kp, t) -> case sequenceA $ fmap (toBase ctx') t of+ Nothing -> []+ Just t' -> [(kp, t')]+ return (pat', abstractTerm ctx' te, Type (abstractTerm ctx' ty) k, tab')+ (pat', term1', Type type1 k, tab1) <- typeCheckClause (if null terms2 then mty else Nothing) (pat,term1)+ type1' <- case isStationary type1 of+ Nothing -> throwError [Error Other $+ emsgLC pos "Type of expressions in case constructions cannot be dependent" enull]+ Just r -> return (Type r k)+ patsAndTerms <- mapM (liftM (\(p,t,_,_) -> (p,t)) . typeCheckClause (Just $ nfType WHNF $ fmap Right type1')) (zip pats terms1)+ (terms2', ty, tab2) <- if null terms2+ then return ([], type1', [])+ else typeCheckApps pos Nothing ctx terms2 type1' mty+ let (pats',terms1') = unzip patsAndTerms+ sem = Semantics (S.Case $ map (first $ \(s,_) -> ((0,0), Ident s)) $ pat':pats') $ V.Case (pat':pats')+ terms' = term1' : terms1' ++ terms2'+ warn $ coverageErrorMsg pos $ checkCoverage $ zipWith (\p1 p2 -> (termPos p1, [first snd p2])) (pat:pats) (pat':pats')+ warn $ checkConditions pos ctx (Lambda $ Apply sem $ bvar : map (fmap Free) terms') $+ map (\(p,t) -> ([p],t)) $ (pat',term1'):patsAndTerms+ return (Apply sem $ exprTerm:terms', ty, tab1 ++ tab2)+ where+ isStationary :: Term a b -> Maybe (Term a b)+ isStationary (Lambda t) = case sequenceA t of+ Bound -> Nothing+ Free t' -> isStationary t'+ isStationary t = Just t+typeCheckCtx' ctx te (Just (Type ty _)) = do+ (te', Type ty' k') <- typeCheckCtx ctx te Nothing+ tab <- actExpType True ctx (fmap Right ty') ty (termPos te)+ return (te', Type ty' k', tab)+typeCheckCtx' _ _ _ = error "typeCheckCtx" -data SomeEq f = forall a. Eq a => SomeEq (f a)+typeCheckName :: (Monad m, Eq a) => Context a -> Posn -> Fixity -> Name -> [Term (Posn, Syntax) Void]+ -> Maybe (Type Semantics (Either Argument a)) -> TCM m (Term Semantics a, Type Semantics a, [(Argument, Term Semantics a)])+typeCheckName ctx pos ft var ts mty = do+ when (nameToString var == "_") $ throwError [inferExprErrorMsg pos]+ eres <- case lookupCtx (nameToString var) ctx of+ Just r -> return (Left r)+ Nothing -> do+ let mdt = case mty of+ Just (Type (Apply (Semantics _ (DataType dti _)) params) _) -> Just (dti,params)+ _ -> Nothing+ mt <- lift $ getEntry var mdt+ case mt of+ [] -> liftM Right (typeCheckKeyword ctx pos (nameToString var) ts mty)+ [(s, ty)] ->+ let s' = case syntax s of+ Name ft' _ | ft == ft' -> s+ _ -> s { syntax = Name ft var }+ in case sequenceA ty of+ Left kp -> throwError (inferArgErrorMsg kp)+ Right ty' -> return $ Left (capply s', ty')+ _ -> throwError [Error Other $ emsgLC pos ("Ambiguous identifier: " ++ show (nameToString var)) enull]+ case eres of+ Left (te, ty) -> do+ (tes, ty', tab) <- typeCheckApps pos (Just var) ctx ts ty mty+ return (apps te tes, ty', tab)+ Right res -> return res -extendCtx :: Eq a => [s] -> Ctx s Type b a -> Type a -> SomeEq (Ctx s Type b)-extendCtx [] ctx _ = SomeEq ctx-extendCtx (x:xs) ctx t = extendCtx xs (Snoc ctx x t) (fmap Free t)+typeCheckKeyword :: (Monad m, Eq a) => Context a -> Posn -> String -> [Term (Posn, Syntax) Void]+ -> Maybe (Type Semantics (Either Argument a)) -> TCM m (Term Semantics a, Type Semantics a, [(Argument, Term Semantics a)])+typeCheckKeyword _ pos u as Nothing | (k,""):_ <- reads u = do+ unless (null as) $ warn [argsErrorMsg pos "A type"]+ return (universe k, Type (universe $ succ k) $ succ $ succ k, [])+typeCheckKeyword ctx pos "contr" [] (Just (Type ty k)) = do+ case k of+ Contr -> return ()+ _ -> warn [Error TypeMismatch $ emsgLC pos "" $ pretty "Expected a contractible type"+ $$ pretty "Actual type:" <+> prettyOpen' ctx ty]+ case sequenceA ty of+ Left kp -> throwError (inferArgErrorMsg kp)+ Right ty' -> return (capply $ Semantics (Name Prefix $ Ident "contr") CCon, Type ty' k, [])+typeCheckKeyword _ pos "contr" _ _ = throwError [inferErrorMsg pos "contr"]+typeCheckKeyword _ pos "I" as Nothing = do+ unless (null as) $ warn [argsErrorMsg pos "A type"]+ return (interval, Type (universe $ TypeK NoLevel) $ TypeK $ Level 1, [])+typeCheckKeyword _ pos "left" as Nothing = do+ unless (null as) $ warn [argsErrorMsg pos $ show "left"]+ return (iCon ILeft, intType, [])+typeCheckKeyword _ pos "right" as Nothing = do+ unless (null as) $ warn [argsErrorMsg pos $ show "right"]+ return (iCon IRight, intType, [])+typeCheckKeyword _ pos "Path" [] _ = throwError [expectedArgErrorMsg pos "Path"]+typeCheckKeyword ctx pos "Path" (a:as) Nothing = do+ (r1, _, (v, t1)) <- typeCheckLambda ctx a intType+ k <- checkIsType (Snoc ctx v $ error "") (termPos a) t1+ let r1' c = apps r1 [iCon c]+ k' = sortPred k+ mkType t = Type t (succ k')+ case as of+ [] -> return (Apply (pathExp k) [r1], mkType $ Apply (Semantics (S.Pi Explicit []) $ V.Pi k $ succ k)+ [r1' ILeft, Apply (Semantics (S.Pi Explicit []) $ V.Pi k $ succ k) [r1' IRight, universe k']], [])+ [a2] -> do+ (r2, _) <- typeCheckCtx ctx a2 $ Just $ Type (nf WHNF $ r1' ILeft) k+ return (Apply (pathExp k) [r1,r2], mkType $ Apply (Semantics (S.Pi Explicit []) $ V.Pi k $ succ k) [r1' IRight, universe k'], [])+ a2:a3:as' -> do+ unless (null as') $ warn [argsErrorMsg pos "A type"]+ (r2, _) <- typeCheckCtx ctx a2 $ Just $ Type (nf WHNF $ r1' ILeft) k+ (r3, _) <- typeCheckCtx ctx a3 $ Just $ Type (nf WHNF $ r1' IRight) k+ return (Apply (pathExp k) [r1,r2,r3], mkType $ universe k', [])+typeCheckKeyword _ pos "path" [] _ = throwError [expectedArgErrorMsg pos "path"]+typeCheckKeyword ctx pos "path" (a:as) mty = do+ unless (null as) $ warn [argsErrorMsg pos "A path"]+ case mty of+ Nothing -> do+ (te, Type _ k, (_, ty)) <- typeCheckLambda ctx a intType+ return (path [te], Type (Apply (pathImp k) [Apply (Semantics (S.Lam ["_"]) V.Lam) [Lambda ty], apps te [iCon ILeft], apps te [iCon IRight]]) k, [])+ Just (Type (Var (Left kp) _) _) -> do+ (te, Type _ k, (_, ty)) <- typeCheckLambda ctx a intType+ let ty' = Apply (pathImp k) [Apply (Semantics (S.Lam ["_"]) V.Lam) [Lambda ty], apps te [iCon ILeft], apps te [iCon IRight]]+ return (path [te], Type ty' k, [(kp,ty')])+ Just (Type ety@(Apply (Semantics _ (Path k1)) [t1,_,_]) k) -> do+ let sem = Semantics (S.Pi Explicit ["i"]) $ V.Pi (TypeK NoLevel) k1+ aty = Apply sem [interval, Lambda $ apps (fmap Free t1) [bvar]]+ (r, Type ty' _, tab1) <- typeCheckCtx' ctx a $ Just (Type aty k1)+ case nf WHNF ty' of+ Apply (Semantics (S.Pi e vs) p) [ta, tb] -> do+ let tb' = case tb of+ Lambda t@Lambda{} -> Apply (Semantics (S.Lam ["i"]) V.Lam)+ [Lambda $ Apply (Semantics (S.Pi e $ tail vs) p) [fmap Free ta, t]]+ Lambda{} -> Apply (Semantics (S.Lam ["i"]) V.Lam) [tb]+ _ -> Apply (Semantics (S.Lam ["_"]) V.Lam) [Lambda $ fmap Free tb]+ aty = Apply (pathImp k1) [tb', apps r [iCon ILeft], apps r [iCon IRight]]+ tab2 <- actExpType True ctx (fmap Right aty) ety pos+ return (path [r], Type aty k, tab1 ++ tab2)+ _ -> error "typeCheckKeyword: path"+ Just (Type ty _) -> throwError [Error TypeMismatch $ emsgLC pos "" $ pretty "Expected type:" <+> prettyOpen' ctx ty+ $$ pretty "Actual type: Path"]+typeCheckKeyword _ pos "coe" [] _ = throwError [expectedArgErrorMsg pos "coe"]+typeCheckKeyword ctx pos "coe" (a1:as) Nothing = do+ (r1, _, (v, t1)) <- typeCheckLambda ctx a1 intType+ k <- checkIsType (Snoc ctx v $ error "") (termPos a1) t1+ let res = Apply (Semantics (S.Pi Explicit ["r"]) $ V.Pi (TypeK NoLevel) k) [interval, Lambda $ apps (fmap Free r1) [bvar]]+ coe = Semantics (Name Prefix $ Ident "coe") Coe+ case as of+ [] -> return (Apply coe [r1], Type (Apply (Semantics (S.Pi Explicit ["l"]) $ V.Pi (TypeK NoLevel) k) [interval, Lambda $+ Apply (Semantics (S.Pi Explicit []) $ V.Pi k k) [apps (fmap Free r1) [bvar], fmap Free res]]) k, [])+ a2:as1 -> do+ (r2, _) <- typeCheckCtx ctx a2 (Just intType)+ case as1 of+ [] -> return (Apply coe [r1,r2], Type (Apply (Semantics (S.Pi Explicit []) $ V.Pi k k) [apps r1 [r2], res]) k, [])+ a3:as2 -> do+ (r3, _) <- typeCheckCtx ctx a3 $ Just $ Type (nf WHNF $ apps r1 [r2]) k+ case as2 of+ [] -> return (Apply coe [r1,r2,r3], Type res k, [])+ a4:as3 -> do+ (r4, _) <- typeCheckCtx ctx a4 (Just intType)+ (tes, ty, _) <- typeCheckApps pos Nothing ctx as3 (Type (apps r1 [r4]) k) Nothing+ return (Apply coe $ [r1,r2,r3,r4] ++ tes, ty, [])+typeCheckKeyword ctx pos "iso" (a1:a2:a3:a4:a5:a6:as) Nothing = do+ (r1, Type t1 _) <- typeCheckCtx ctx a1 Nothing+ (r2, Type t2 _) <- typeCheckCtx ctx a2 Nothing+ let t1' = nf WHNF t1+ t2' = nf WHNF t2+ k1 <- checkIsType ctx (termPos a1) t1'+ k2 <- checkIsType ctx (termPos a2) t2'+ let k = dmax k1 k2+ (r3, _) <- typeCheckCtx ctx a3 $ Just $ Type (Apply (Semantics (S.Pi Explicit []) $ V.Pi k1 k2) [r1,r2]) k+ (r4, _) <- typeCheckCtx ctx a4 $ Just $ Type (Apply (Semantics (S.Pi Explicit []) $ V.Pi k2 k1) [r2,r1]) k+ let h e s1 s3 s4 tk = typeCheckCtx ctx e $ Just $ Type (Apply (Semantics (S.Pi Explicit ["x"]) $ V.Pi tk tk) [s1, Lambda $+ Apply (pathImp tk) [Apply (Semantics (S.Lam ["_"]) V.Lam) [Lambda $ fmap (Free . Free) s1],+ apps (fmap Free s4) [apps (fmap Free s3) [bvar]], bvar]]) tk+ iso = Semantics (Name Prefix $ Ident "iso") Iso+ (r5, _) <- h a5 r1 r3 r4 k1+ (r6, _) <- h a6 r2 r4 r3 k2+ case as of+ [] -> return (Apply iso [r1,r2,r3,r4,r5,r6],+ Type (Apply (Semantics (S.Pi Explicit []) $ V.Pi (TypeK NoLevel) $ succ k) [interval, universe k]) $ succ k, [])+ a7:as' -> do+ unless (null as') $ warn [argsErrorMsg pos "A type"]+ (r7, _) <- typeCheckCtx ctx a7 (Just intType)+ return (Apply iso [r1,r2,r3,r4,r5,r6,r7], Type (universe k) $ succ k, [])+typeCheckKeyword _ pos "iso" _ Nothing =+ throwError [Error NotEnoughArgs $ emsgLC pos "Expected at least 6 arguments to \"iso\"" enull]+typeCheckKeyword ctx pos "squeeze" as Nothing =+ let mkType t = Apply (Semantics (S.Pi Explicit []) $ V.Pi (TypeK NoLevel) $ TypeK NoLevel) [interval, t]+ squeeze = Semantics (Name Prefix $ Ident "squeeze") Squeeze+ in case as of+ [] -> return (capply squeeze, Type (mkType $ mkType interval) $ TypeK NoLevel, [])+ [a1] -> do+ (r1, _) <- typeCheckCtx ctx a1 (Just intType)+ return (Apply squeeze [r1], Type (mkType interval) $ TypeK NoLevel, [])+ [a1,a2] -> do+ (r1, _) <- typeCheckCtx ctx a1 (Just intType)+ (r2, _) <- typeCheckCtx ctx a2 (Just intType)+ return (Apply squeeze [r1,r2], intType, [])+ _ -> throwError [argsErrorMsg pos "squeeze _ _"]+typeCheckKeyword ctx pos var ts (Just (Type ty _)) = do+ (te', Type ty' k', _) <- typeCheckKeyword ctx pos var ts Nothing+ tab <- actExpType True ctx (fmap Right ty') ty pos+ return (te', Type ty' k', tab)+typeCheckKeyword _ pos var _ _ = throwError [notInScope pos "" var] -typeCheck :: Monad m => Expr -> Maybe (Type String) -> TCM m (Term String, Type String)-typeCheck = typeCheckCtx Nil+actExpType :: (Monad m, Eq a) => Bool -> Context a -> Term Semantics (Either Argument a)+ -> Term Semantics (Either Argument a) -> Posn -> EDocM m [(Argument, Term Semantics a)]+actExpType w ctx act exp pos = do+ let act' = nf NF act+ exp' = nf NF exp+ (mo,(l1,l2)) = pcmpTerms act' exp'+ l = if w then l2 else l1+ unless (mo == Just EQ || mo == Just LT) $+ throwError [Error TypeMismatch $ emsgLC pos "" $ pretty "Expected type:" <+> prettyOpen' ctx exp'+ $$ pretty "Actual type:" <+> prettyOpen' ctx act']+ return l -typeCheckCtx :: (Monad m, Eq a) => Ctx String Type String a -> Expr -> Maybe (Type a) -> TCM m (Term a, Type a)-typeCheckCtx ctx expr ty = go ctx expr [] $ fmap (nfType WHNF) ty+typeCheckApps :: (Monad m, Eq a) => Posn -> Maybe Name -> Context a -> [Term (Posn, Syntax) Void]+ -> Type Semantics a -> Maybe (Type Semantics (Either Argument a))+ -> TCM m ([Term Semantics a], Type Semantics a, [(Argument, Term Semantics a)])+typeCheckApps pos mname ctx allTerms ty mety = go 0 [] [] (map (\t -> (Explicit, Left t)) allTerms) nty where- go :: (Monad m, Eq a) => Ctx String Type String a -> Expr -> [Expr] -> Maybe (Type a) -> TCM m (Term a, Type a)- go ctx (Paren _ e) exprs ty = go ctx e exprs ty- go ctx (E.App e1 e2) exprs ty = go ctx e1 (e2:exprs) ty- go ctx (E.Lam _ [] e) exprs ty = go ctx e exprs ty- go ctx (E.Lam p (arg : args) e) [] (Just (Type ty@(T.Pi a@(Type _ lvl1) b lvl2) lvl)) = do- let var = unArg arg- (te, _) <- go (Snoc ctx var a) (E.Lam p args e) [] $ Just $ Type (nf WHNF $ unScope1 $ dropOnePi a b lvl2) lvl2- return (T.Lam $ Scope1 var te, Type ty $ min lvl $ max lvl1 lvl2)- go ctx (E.Lam p (arg : args) e) [] (Just (Type ty _)) =- throwError [emsgLC (argGetPos arg) "" $ pretty "Expected type:" <+> prettyOpen ctx ty $$- pretty "But lambda expression has pi type"]- go _ e@E.Lam{} _ _ = throwError [inferErrorMsg (getPos e) "the argument"]- go ctx (E.Var (NoArg (Pus (lc,_)))) exprs mty = throwError [emsgLC lc "Expected an identifier" enull]- go ctx (E.Var (Arg (PIdent (lc,var)))) exprs mty = do- (te, Type ty lvl) <- case lookupCtx var ctx of- Just r -> return r- Nothing -> do- mt <- lift $ getEntry var $ case mty of- Just (Type (DataType d _ _) _) -> Just d- _ -> Nothing- let replaceConPos (T.Con i _ name conds args) = T.Con i lc name conds args- replaceConPos t = t- case mt of- [FunctionE (FunCall _ name clauses) ty] -> return (FunCall lc name clauses, fmap (liftBase ctx) ty)- [FunctionE te ty] -> return (fmap (liftBase ctx) te , fmap (liftBase ctx) ty)- DataTypeE ty e : _ -> return (DataType var e [] , fmap (liftBase ctx) ty)- [ConstructorE _ (ScopeTerm con) (ScopeTerm ty, lvl)] ->- return (fmap (liftBase ctx) (replaceConPos con), Type (fmap (liftBase ctx) ty) lvl)- [ConstructorE _ con (ty, lvl)] -> case mty of- Just (Type (DataType _ _ params) _) ->- let liftTerm = instantiate params . fmap (liftBase ctx)- in return (replaceConPos (liftTerm con), Type (liftTerm ty) lvl)- Just (Type ty _) -> throwError [emsgLC lc "" $ pretty "Expected type:" <+> prettyOpen ctx ty $$- pretty ("But given data constructor " ++ show var)]- Nothing -> throwError [inferParamsErrorMsg lc var]- [] -> do- cons <- lift (getConstructorDataTypes var)- let Type (DataType dataType _ _) _ = fromJust mty- case cons of- [] -> throwError [notInScope lc "" var]- [act] -> throwError [emsgLC lc "" $- pretty ("Expected data type: " ++ dataType) $$- pretty ("Actual data type: " ++ act)]- acts -> throwError [emsgLC lc "" $- pretty ("Expected data type: " ++ dataType) $$- pretty ("Posible data types: " ++ intercalate ", " acts)]- _ -> throwError [inferErrorMsg lc $ show var]- (tes, Type ty' lvl') <- typeCheckApps lc ctx exprs (Type ty lvl)- case (mty, ty') of- (Nothing, _) -> return ()- (Just (Type (DataType edt _ _) _), DataType adt _ []) -> unless (edt == adt) $- throwError [emsgLC lc "" $ pretty ("Expected data type: " ++ edt) $$- pretty ("Actual data type: " ++ adt)]- (Just (Type ety _), _) -> actExpType ctx ty' ety lc- return (apps te tes, Type ty' $ maybe lvl' (\(Type _ lvl'') -> min lvl' lvl'') mty)- go _ (ELeft _) [] Nothing = return (ICon ILeft, intType)- go _ e@ELeft{} _ Nothing = throwError [emsgLC (getPos e) "\"left\" is applied to arguments" enull]- go _ (ERight _) [] Nothing = return (ICon IRight, intType)- go _ e@ERight{} _ Nothing = throwError [emsgLC (getPos e) "\"right\" is applied to arguments" enull]- go ctx e@PathCon{} es _ | length es > 1 = throwError [emsgLC (getPos e) "A path is applied to arguments" enull]- go ctx e@PathCon{} [] Nothing = throwError [inferErrorMsg (getPos e) "path"]- go ctx PathCon{} [e] Nothing = do- (r, Scope1 v t, lvl) <- typeCheckLambda ctx e intType- return (r, Type (T.Pi intType (Scope v (ScopeTerm t)) lvl) lvl)- go ctx e@PathCon{} [] _ = throwError [expectedArgErrorMsg (getPos e) "path"]- go ctx e'@PathCon{} [e] (Just (Type ty@(T.Path h mt1 _) lvl)) = do- (r,t) <- go ctx e [] $ fmap (\t1 -> Type- (T.Pi intType (Scope "i" $ ScopeTerm $ T.App (fmap Free t1) $ T.Var Bound) lvl) lvl) mt1- let left = T.App r (ICon ILeft)- right = T.App r (ICon IRight)- actExpType ctx (T.Path Implicit Nothing [left,right]) ty (getPos e')- return (PCon (Just r), Type ty lvl)- go ctx e'@PathCon{} [e] (Just (Type ty _)) =- throwError [emsgLC (getPos e') "" $ pretty "Expected type:" <+> prettyOpen ctx ty $$- pretty "Actual type: Path"]- go ctx (E.At e1 e2) es Nothing = do- (r1, Type t1 lvl) <- go ctx e1 [] Nothing- (r2, _) <- go ctx e2 [] (Just intType)- case nf WHNF t1 of- T.Path _ (Just a) [b,c] -> do- (tes, ty) <- typeCheckApps (getPos e1) ctx es $ Type (T.App a r2) lvl- return (apps (T.At b c r1 r2) tes, ty)- T.Path _ Nothing _ -> throwError [emsgLC (getPos e1) "Cannot infer type" enull]- t1' -> throwError [emsgLC (getPos e1) "" $ pretty "Expected type: Path" $$- pretty "Actual type:" <+> prettyOpen ctx t1']- go ctx e@E.Coe{} [] Nothing = throwError [expectedArgErrorMsg (getPos e) "coe"]- go ctx e@E.Coe{} (e1:es) Nothing = do- (r1, Scope1 v t1, _) <- typeCheckLambda ctx e1 intType- lvl <- checkIsType (Snoc ctx v $ error "") e1 t1- let res = T.Pi intType (Scope "r" $ ScopeTerm $ T.App (fmap Free r1) $ T.Var Bound) lvl- case es of- [] -> return (T.Coe [r1], Type (T.Pi intType (Scope "l" $ ScopeTerm $- T.Pi (Type (T.App (fmap Free r1) $ T.Var Bound) lvl) (ScopeTerm $ fmap Free res) lvl) lvl) lvl)- e2:es1 -> do- (r2, _) <- go ctx e2 [] $ Just intType- case es1 of- [] -> return (T.Coe [r1,r2], Type (T.Pi (Type (T.App r1 r2) lvl) (ScopeTerm res) lvl) lvl)- e3:es2 -> do- (r3, _) <- go ctx e3 [] $ Just $ Type (nf WHNF $ T.App r1 r2) lvl- case es2 of- [] -> return (T.Coe [r1,r2,r3], Type res lvl)- e4:es3 -> do- (r4, _) <- go ctx e4 [] $ Just intType- (tes, ty) <- typeCheckApps (getPos e) ctx es3 $ Type (T.App r1 r4) lvl- return (T.Coe $ [r1,r2,r3,r4] ++ tes, ty)- go ctx e@E.Iso{} es Nothing | length es < 6 =- throwError [emsgLC (getPos e) "Expected at least 6 arguments to \"iso\"" enull]- go ctx E.Iso{} (e1:e2:e3:e4:e5:e6:es) Nothing | length es <= 1 = do- (r1, Type t1 _) <- go ctx e1 [] Nothing- (r2, Type t2 _) <- go ctx e2 [] Nothing- let t1' = nf WHNF t1- t2' = nf WHNF t2- lvl1 <- checkIsType ctx e1 t1'- lvl2 <- checkIsType ctx e2 t2'- let lvl = max lvl1 lvl2- (r3, _) <- go ctx e3 [] $ Just $ Type (T.Pi (Type r1 lvl1) (ScopeTerm r2) lvl2) lvl- (r4, _) <- go ctx e4 [] $ Just $ Type (T.Pi (Type r2 lvl2) (ScopeTerm r1) lvl1) lvl- let h e s1 s3 s4 tlvl = go ctx e [] $ Just $ Type (T.Pi (Type s1 tlvl) (Scope "x" $- ScopeTerm $ T.Path Implicit (Just $ T.Pi intType (ScopeTerm $ fmap Free s1) tlvl)- [T.App (fmap Free s4) $ T.App (fmap Free s3) $ T.Var Bound, T.Var Bound]) tlvl) tlvl- (r5, _) <- h e5 r1 r3 r4 lvl1- (r6, _) <- h e6 r2 r4 r3 lvl2- case es of- [] -> return (T.Iso [r1,r2,r3,r4,r5,r6],- Type (T.Pi intType (ScopeTerm $ T.Universe lvl) $ succ lvl) $ succ lvl)- e7:_ -> do- (r7, _) <- go ctx e7 [] $ Just intType- return (T.Iso [r1,r2,r3,r4,r5,r6,r7], Type (T.Universe lvl) $ succ lvl)- go ctx e@E.Squeeze{} [] Nothing = return (T.Squeeze [],- Type (T.Pi intType (ScopeTerm $ T.Pi intType (ScopeTerm T.Interval) NoLevel) NoLevel) NoLevel)- go ctx e@E.Squeeze{} [e1] Nothing = do- (r1, _) <- go ctx e1 [] $ Just intType- return (T.Squeeze [r1], Type (T.Pi intType (ScopeTerm T.Interval) NoLevel) NoLevel)- go ctx E.Squeeze{} [e1,e2] Nothing = do- (r1, _) <- go ctx e1 [] $ Just intType- (r2, _) <- go ctx e2 [] $ Just intType- return (T.Squeeze [r1,r2], intType)- go ctx (E.Pi [] e) [] Nothing = go ctx e [] Nothing- go ctx expr@(E.Pi (PiTele _ e1 e2 : tvs) e) [] Nothing = do- args <- exprToVars e1- (r1, Type t1 _) <- typeCheckCtx ctx e2 Nothing- lvl1 <- checkIsType ctx e2 (nf WHNF t1)- case extendCtx (map unArg args) Nil (Type r1 lvl1) of- SomeEq ctx' -> do- (r2, Type t2 _) <- go (ctx +++ ctx') (E.Pi tvs e) [] Nothing- lvl2 <- checkIsType (ctx +++ ctx') (E.Pi tvs e) (nf WHNF t2)- let lvl = max lvl1 lvl2- return (T.Pi (Type r1 lvl1) (abstractTermInCtx ctx' r2) lvl2, Type (T.Universe lvl) $ succ lvl)- go ctx (E.Arr e1 e2) [] Nothing = do- (r1, Type t1 _) <- go ctx e1 [] Nothing- (r2, Type t2 _) <- go ctx e2 [] Nothing- lvl1 <- checkIsType ctx e1 (nf WHNF t1)- lvl2 <- checkIsType ctx e1 (nf WHNF t2)- let lvl = max lvl1 lvl2- return (T.Pi (Type r1 lvl1) (ScopeTerm r2) lvl2, Type (T.Universe lvl) $ succ lvl)- go _ (E.Universe (U (_,u))) [] Nothing =- let l = parseLevel u- l' = Level (level l + 1)- in return (T.Universe l, Type (T.Universe l') $ succ l')- where- parseLevel :: String -> Level- parseLevel "Type" = NoLevel- parseLevel ('T':'y':'p':'e':s) = Level (read s)- parseLevel s = error $ "parseLevel: " ++ s- go _ E.Interval{} [] Nothing = return (T.Interval, Type (T.Universe NoLevel) $ Level 1)- go ctx e@E.Path{} [] _ = throwError [expectedArgErrorMsg (getPos e) "Path"]- go ctx E.Path{} (e1:es) Nothing | length es < 3 = do- (r1, Scope1 v t1, _) <- typeCheckLambda ctx e1 intType- lvl <- checkIsType (Snoc ctx v $ error "") e1 t1- let r1' c = Type (T.App r1 $ ICon c) lvl- mkType t = Type t (succ lvl)- case es of- [] -> return (T.Path Explicit (Just r1) [], mkType $- T.Pi (r1' ILeft) (ScopeTerm $ T.Pi (r1' IRight) (ScopeTerm $ T.Universe lvl) $ succ lvl) $ succ lvl)- [e2] -> do- (r2,_) <- go ctx e2 [] $ Just $ nfType WHNF (r1' ILeft)- return (T.Path Explicit (Just r1) [r2], mkType $- T.Pi (r1' IRight) (ScopeTerm $ T.Universe lvl) $ succ lvl)- [e2,e3] -> do- (r2,_) <- go ctx e2 [] $ Just $ nfType WHNF (r1' ILeft)- (r3,_) <- go ctx e3 [] $ Just $ nfType WHNF (r1' IRight)- return (T.Path Explicit (Just r1) [r2,r3], mkType $ T.Universe lvl)- _ -> error "typeCheckCtx.Path"- go ctx (E.PathImp e1 e2) [] Nothing = do- (r1, Type t1 lvl) <- go ctx e1 [] Nothing- (r2, _) <- go ctx e2 [] $ Just $ Type (nf WHNF t1) lvl- return (T.Path Implicit (Just $ T.Lam $ Scope1 "_" $ fmap Free t1) [r1,r2], Type (T.Universe lvl) $ succ lvl)- go _ e _ Nothing = throwError [emsgLC (getPos e) "A type is applied to arguments" enull]- go ctx e es (Just (Type ty lvl)) = do- (r, Type t _) <- go ctx e es Nothing- actExpType ctx t ty (getPos e)- return (r, Type ty lvl)+ nty = nfType WHNF (fmap Right ty)+ + go n acc rest ((e1, term@(Left (Apply (pos', Name _ (Ident "_")) []))) : terms) (Type (Apply p@(Semantics (S.Pi e2 _) (V.Pi _ k2)) [a,b]) _) | e1 == e2 =+ go (n + 1) (Left (inferArgErrorMsg $ Argument n pos' mname) : acc) ((e1,term):rest) terms $+ Type (nf WHNF $ instantiate1 (cvar $ Left (Argument n pos' mname)) $ snd $ dropOnePi p a b) k2+ go n acc rest ((e1,term):terms) (Type (Apply p@(Semantics (S.Pi e2 _) (V.Pi k1 k2)) [a,b]) _) | e1 == e2 = do+ mres <- case term of+ Left t -> let catchErrs = catchErrorType [Inference]+ in liftM (\(a,b,c) -> Right (a, Just b, c))+ (typeCheckCtx' ctx t $ Just $ Type (nf WHNF a) k1) `catchErrs` (return . Left)+ Right (te, maty) -> do+ case maty of+ Just (Type aty _) -> actExpType True ctx (fmap Right aty) a pos+ Nothing -> return []+ return $ Right (te, maty, [])+ case mres of+ Left errs -> go (n + 1) (Left errs : acc) ((e1,term):rest) terms $+ Type (nf WHNF $ instantiate1 (cvar $ Left $ NoArgument errs) $ snd $ dropOnePi p a b) k2+ Right (term', mty, tab) ->+ let ty' = Right (term', mty)+ in if useful tab+ then go 0 [] [] (replaceTerms (reverse rest ++ [(e1, ty')] ++ terms) tab) nty+ else go (n + 1) (ty' : acc) ((e1, ty') : rest) terms $ Type (nf WHNF $ case b of+ Lambda{} -> instantiate1 (fmap Right term') $ snd (dropOnePi p a b)+ _ -> b) k2+ go n acc rest terms (Type (Apply p@(Semantics (S.Pi Implicit _) (V.Pi _ k2)) [a,b]) _) =+ go (n + 1) (Left (inferArgErrorMsg $ Argument n pos mname) : acc)+ ((Implicit, Left (capply (pos, Name Prefix $ Ident "_"))) : rest) terms $+ Type (nf WHNF $ instantiate1 (cvar $ Left (Argument n pos mname)) $ snd $ dropOnePi p a b) k2+ go _ acc rest [] (Type aty k) =+ let checkAty = case sequenceA aty of+ Left kp -> throwError (inferArgErrorMsg kp)+ Right aty' -> case partitionEithers (reverse acc) of+ ([], rights) -> return (map fst rights, Type aty' k, [])+ (left:_, _) -> throwError left+ in case mety of+ Just (Type ety _) -> do+ tab <- actExpType False ctx aty ety pos+ if useful tab+ then go 0 [] [] (replaceTerms (reverse rest) tab) nty+ else do+ (acc', Type aty' k', _) <- checkAty+ tab' <- actExpType True ctx (fmap Right aty') ety pos+ return (acc', Type aty' k', tab')+ Nothing -> checkAty+ go _ _ _ _ (Type (Var (Left kp) _) _) = throwError (inferArgErrorMsg kp)+ go _ _ _ _ (Type ty _) = throwError [Error TypeMismatch $ emsgLC pos "" $ pretty "Expected pi type"+ $$ pretty "Actual type:" <+> prettyOpen' ctx ty]+ + replaceTerms :: [(e, Either t (s, Maybe u))] -> [(Argument, s)] -> [(e, Either t (s, Maybe u))]+ replaceTerms ts [] = ts+ replaceTerms ts ((Argument k _ _, t):tab) =+ let (ts1,ts2) = splitAt k (replaceTerms ts tab)+ in if null ts2 then ts1 else ts1 ++ [(fst $ head ts2, Right (t, Nothing))] ++ tail ts2+ replaceTerms ts ((NoArgument{},_):tab) = replaceTerms ts tab -typeCheckLambda :: (Monad m, Eq a) => Ctx String Type String a -> Expr -> Type a- -> TCM m (Term a, Scope1 String Term a, Level)-typeCheckLambda ctx (Paren _ e) ty = typeCheckLambda ctx e ty-typeCheckLambda ctx (E.Lam _ [] e) ty = typeCheckLambda ctx e ty-typeCheckLambda ctx (E.Lam p (arg:args) e) ty = do- let var = unArg arg- (te, Type ty' lvl) <- typeCheckCtx (Snoc ctx var ty) (E.Lam p args e) Nothing- return (T.Lam $ Scope1 var te, Scope1 var ty', lvl)-typeCheckLambda ctx e ty = do- (te, Type ty' _) <- typeCheckCtx ctx e Nothing+useful :: [(Argument,a)] -> Bool+useful = not . null . filter (\(arg,_) -> case arg of+ Argument{} -> True+ NoArgument{} -> False)++typeCheckLambda :: (Monad m, Eq a) => Context a -> Term (Posn, Syntax) Void -> Type Semantics a+ -> TCM m (Term Semantics a, Type Semantics a, (String, Term Semantics (Scoped a)))+typeCheckLambda ctx (Apply (pos, S.Lam (v:vs)) [te]) (Type ty k) = do+ (te', Type ty' k') <- typeCheckCtx (Snoc ctx v $ Type ty k) (if null vs then te else Apply (pos, S.Lam vs) [te]) Nothing+ let te'' = case te' of+ Apply (Semantics (S.Lam vs') _) [te''] -> Apply (Semantics (S.Lam $ v:vs') V.Lam) [Lambda te'']+ _ -> Apply (Semantics (S.Lam [v]) V.Lam) [Lambda te']+ return (te'', Type (Apply (Semantics (S.Pi Explicit [v]) (V.Pi k k')) [ty, Lambda ty']) $ dmax k k', (v, ty'))+typeCheckLambda ctx te ty = do+ (te', Type ty' k') <- typeCheckCtx ctx te Nothing case nf WHNF ty' of- T.Pi a b lvlb ->- let Type na lvla = nfType NF a- Type nty lvlty = nfType NF ty+ ty''@(Apply p@(Semantics sp (V.Pi ka kb)) [a,b]) ->+ let na = nf NF a+ Type nty kty = nfType NF ty in if (nty `lessOrEqual` na)- then return (te, dropOnePi a b lvlb, lvlb)- else throwError [emsgLC (getPos e) "" $- pretty "Expected type:" <+> prettyOpen ctx (T.Pi (Type nty lvla) b lvlb) $$- pretty "Actual type:" <+> prettyOpen ctx (T.Pi (Type na lvlty) b lvlb)]- _ -> throwError [emsgLC (getPos e) "" $ pretty "Expected pi type" $$- pretty "Actual type:" <+> prettyOpen ctx ty']--actExpType :: (Monad m, Eq a) => Ctx String Type String a -> Term a -> Term a -> (Int,Int) -> EDocM m ()-actExpType ctx act exp lc =- let act' = nf NF act- exp' = nf NF exp- in unless (act' `lessOrEqual` exp') $- throwError [emsgLC lc "" $ pretty "Expected type:" <+> prettyOpen ctx exp' $$- pretty "Actual type:" <+> prettyOpen ctx act']--typeCheckApps :: (Monad m, Eq a) => (Int,Int) -> Ctx String Type String a -> [Expr] -> Type a -> TCM m ([Term a], Type a)-typeCheckApps lc ctx exprs ty = go exprs (nfType WHNF ty)- where- go [] ty = return ([], ty)- go (expr:exprs) (Type (T.Pi a b lvl') _) = do- (term, _) <- typeCheckCtx ctx expr (Just a)- (terms, ty) <- go exprs $ Type (nf WHNF $ instantiate1 term $ unScope1 $ dropOnePi a b lvl') lvl'- return (term:terms, ty)- go _ (Type ty _) = throwError [emsgLC lc "" $ pretty "Expected pi type" $$- pretty "Actual type:" <+> prettyOpen ctx ty]+ then return (te', Type ty'' k', dropOnePi p a b)+ else throwError [Error TypeMismatch $ emsgLC (termPos te) "" $+ pretty "Expected type:" <+> prettyOpen ctx (Apply (Semantics sp $ V.Pi kty kb) [nty,b]) $$+ pretty "Actual type:" <+> prettyOpen ctx (Apply p [na,b])]+ _ -> throwError [Error TypeMismatch $ emsgLC (termPos te) "" $ pretty "Expected pi type"+ $$ pretty "Actual type:" <+> prettyOpen ctx ty']
+ src/TypeChecking/Expressions/Conditions.hs view
@@ -0,0 +1,138 @@+{-# LANGUAGE GADTs, ExistentialQuantification, FlexibleInstances #-}++module TypeChecking.Expressions.Conditions+ ( checkConditions+ ) where++import Control.Monad+import Control.Monad.State+import Data.Maybe+import Data.Bifunctor+import Data.Void++import qualified Syntax as S+import Semantics+import Semantics.Value+import Syntax.ErrorDoc+import TypeChecking.Context+import TypeChecking.Expressions.Utils+import Normalization++instance Eq (Term (s, Con t) a) where+ Apply (_,s) _ == Apply (_,s') _ = s == s'+ Var{} == Var{} = True+ _ == _ = False++checkConditions :: Eq a => S.Posn -> Ctx String f Void a => Term Semantics a+ -> [([Term (String,SCon) String], Term Semantics a)] -> [Error]+checkConditions pos ctx func cs =+ maybeToList $ msum $ map (\(p, scope) -> fmap (msg ctx) $ checkPatterns func (map fst cs) p scope) cs+ where+ msg :: Ctx String f Void a -> ([String], Term Semantics a, Term Semantics a) -> Error+ msg ctx (vs, t1, t2) = Error Conditions $ emsgLC pos "Conditions check failed:" $+ scopeToEDoc ctx vs t1 <+> pretty "is not equal to" <+> scopeToEDoc ctx vs t2+ + scopeToEDoc :: Ctx String f Void a -> [String] -> Term Semantics a -> EDoc (Term S.Syntax)+ scopeToEDoc ctx vs t = epretty $ bimap syntax pretty $ apps (vacuous $ abstractTerm ctx t) $ map cvar (ctxVars ctx ++ vs)++data TermInCtx f b = forall a. TermInCtx (Ctx String f b a) (f a)+data TermsInCtx f b = forall a. TermsInCtx (Ctx String f b a) [f a]+data TermsInCtx2 f b = forall a. TermsInCtx2 (Ctx String f b a) [f a] [f a]++checkPatterns :: Eq a => Term Semantics a -> [[Term (String,SCon) String]] -> [Term (String,SCon) String]+ -> Term Semantics a -> Maybe ([String], Term Semantics a, Term Semantics a)+checkPatterns func cs pats scope = listToMaybe $ findSuspiciousPairs cs pats >>= \(TermsInCtx2 ctx terms terms') ->+ let nscope1 = nfApps $ abstractTerm ctx $ apps (fmap (liftBase ctx) func) terms+ nscope2 = abstractTerm ctx $ apps (fmap (liftBase ctx) scope) terms'+ in if nf NF nscope1 == nf NF nscope2 then [] else [(reverse $ ctxVars ctx, nscope1, nscope2)]+ where+ nfApps :: Eq a => Term Semantics a -> Term Semantics a+ nfApps (Apply a as) = Apply a $ map (nf WHNF) as+ nfApps (Lambda t) = Lambda (nfApps t)+ nfApps t = t++findSuspiciousPairs :: [[Term (String,SCon) String]] -> [Term (String,SCon) String] -> [TermsInCtx2 (Term Semantics) b]+findSuspiciousPairs _ [] = []+findSuspiciousPairs cs (pat@(Var var _) : pats) =+ check ILeft ++ check IRight ++ map ext (findSuspiciousPairs (mapTail pat cs) pats)+ where+ ext (TermsInCtx2 ctx terms1 terms2) = TermsInCtx2 (Snoc ctx var $ error "") (bvar : map (fmap Free) terms1)+ (bvar : map (fmap Free) terms2)+ check con = if null $ filter (== Apply ("", ICon con) []) (mapHead cs)+ then []+ else case patternsToTerms pats of+ TermsInCtx ctx terms -> [TermsInCtx2 ctx (iCon con : terms) (iCon con : ctxToVars ctx)]+findSuspiciousPairs cs (pat@(Apply (name, con) args) : pats) =+ (case con of+ DCon _ _ (PatEval conds) -> conds >>= \(cond,_) -> case unifyPatternLists args cond of+ Nothing -> []+ Just args' -> [ext0 args $ patternsToTerms args']+ _ -> []) +++ map ext1 (findSuspiciousPairs cs' args) ++ case patternsToTerms args of+ TermsInCtx ctx terms -> map (ext2 ctx terms) (findSuspiciousPairs (mapTail pat cs) pats)+ where+ cs' = cs >>= \as -> case as of+ Apply (_, con') args' : _ | con == con' -> [args']+ _ -> []+ + ext0 :: [Term (String,SCon) String] -> TermsInCtx (Term Semantics) b -> TermsInCtx2 (Term Semantics) b+ ext0 args (TermsInCtx ctx terms) = case patternsToTerms pats of+ TermsInCtx ctx' terms' -> TermsInCtx2 (ctx +++ ctx')+ (fmap (liftBase ctx') (Apply (Semantics (S.Name S.Prefix $ S.Ident name) (Con con)) $ substPatterns args terms) : terms')+ (map (fmap $ liftBase ctx') terms ++ ctxToVars ctx')+ + ext1 :: TermsInCtx2 (Term Semantics) b -> TermsInCtx2 (Term Semantics) b+ ext1 (TermsInCtx2 ctx terms1 terms2) = case patternsToTerms pats of+ TermsInCtx ctx' terms' -> TermsInCtx2 (ctx +++ ctx') (fmap (liftBase ctx') (Apply (Semantics (S.Name S.Prefix $ S.Ident name) (Con con)) terms1) : terms')+ (map (fmap $ liftBase ctx') terms2 ++ ctxToVars ctx')+ + ext2 :: Ctx String (Term Semantics) a b -> [Term Semantics b] -> TermsInCtx2 (Term Semantics) b -> TermsInCtx2 (Term Semantics) a+ ext2 ctx terms (TermsInCtx2 ctx' terms1 terms2) =+ TermsInCtx2 (ctx +++ ctx') (fmap (liftBase ctx') (Apply (Semantics (S.Name S.Prefix $ S.Ident name) (Con con)) terms) : terms1)+ (map (fmap $ liftBase ctx') (ctxToVars ctx) ++ terms2)+findSuspiciousPairs _ (Lambda{} : _) = error "findSuspiciousPairs"++unifyPatterns :: Term (String,SCon) String -> Term (String,SCon) String -> Maybe [Term (String,SCon) String]+unifyPatterns (Apply (_,con) pats) (Apply (_,con') pats') | con == con' = unifyPatternLists pats pats'+unifyPatterns Var{} p = Just [p]+unifyPatterns p Var{} = Just (varList p)+unifyPatterns _ _ = Nothing++unifyPatternLists :: [Term (String,SCon) String] -> [Term (String,SCon) String] -> Maybe [Term (String,SCon) String]+unifyPatternLists pats pats' = fmap concat $ sequence (zipWith unifyPatterns pats pats')++varList :: Term (String,SCon) String -> [Term (String,SCon) String]+varList pat@Var{} = [pat]+varList (Apply _ pats) = pats >>= varList+varList _ = []++substPatterns :: [Term (String,SCon) String] -> [Term Semantics a] -> [Term Semantics a]+substPatterns pats terms = evalState (mapM substPattern pats) terms+ where+ substPattern :: Term (String,SCon) String -> State [Term Semantics a] (Term Semantics a)+ substPattern Var{} = do+ term:terms <- get+ put terms+ return term+ substPattern (Apply (name, con) pats) = do+ terms <- mapM substPattern pats+ return $ Apply (Semantics (S.Name S.Prefix $ S.Ident name) (Con con)) terms+ substPattern Lambda{} = error "substPattern"++patternToTerm :: Term (String,SCon) String -> TermInCtx (Term Semantics) a+patternToTerm (Var var _) = TermInCtx (Snoc Nil var $ error "") bvar+patternToTerm (Apply (name, con) pats) = case patternsToTerms pats of+ TermsInCtx ctx' terms -> TermInCtx ctx' $ Apply (Semantics (S.Name S.Prefix $ S.Ident name) (Con con)) terms+patternToTerm Lambda{} = error "patternToTerm"++patternsToTerms :: [Term (String,SCon) String] -> TermsInCtx (Term Semantics) a+patternsToTerms [] = TermsInCtx Nil []+patternsToTerms (pat:pats) = case patternToTerm pat of+ TermInCtx ctx' term -> case patternsToTerms pats of+ TermsInCtx ctx'' terms -> TermsInCtx (ctx' +++ ctx'') $ fmap (liftBase ctx'') term : terms++mapHead :: [[a]] -> [a]+mapHead cs = cs >>= \as -> if null as then [] else [head as]++mapTail :: Eq a => a -> [[a]] -> [[a]]+mapTail a cs = cs >>= \as -> if null as || head as /= a then [] else [tail as]
+ src/TypeChecking/Expressions/Coverage.hs view
@@ -0,0 +1,100 @@+module TypeChecking.Expressions.Coverage+ ( checkCoverage+ ) where++import Data.List+import Data.Bifunctor++import Syntax.Term+import Semantics.Value hiding (Value(..))++instance Eq s => Eq (Term s a) where+ Apply s _ == Apply s' _ = s == s'+ Var{} == Var{} = True+ _ == _ = False++data PatternType t = Interval | DataType Int [(Int, [Term (Con t) String])] | Path | Unknown++data OK = OK | Incomplete deriving Eq+data Result = Result OK [Int]++checkCoverage :: [((Int,Int),[Term (Con t) String])] -> Maybe [(Int,Int)]+checkCoverage [] = Just []+checkCoverage clauses = case checkClauses (map snd clauses) of+ Result Incomplete _ -> Nothing+ Result OK used -> Just $ map (\i -> fst $ clauses !! i) $ [0 .. length clauses - 1] \\ used++checkClauses :: [[Term (Con t) String]] -> Result+checkClauses [] = Result Incomplete []+checkClauses clauses =+ let (t, clauses', b) = checkNull 0 Unknown clauses in+ case (b, checkNonEmptyClauses t clauses') of+ (Just i, Result Incomplete u) -> Result OK (i:u)+ (_, r) -> r++checkNull :: Int -> PatternType t -> [[Term (Con t) String]] ->+ (PatternType t, [(Term (Con t) String, [Term (Con t) String])], Maybe Int)+checkNull _ t [] = (t, [], Nothing)+checkNull i t ([] : cs) = (t, [], Just i)+checkNull i t ((pat:pats) : cs) =+ let (t1, cs', b) = checkNull (i + 1) t cs+ t2 = case pat of+ Var{} -> t1+ Apply ICon{} _ -> Interval+ Apply PCon _ -> Path+ Apply (DCon _ n _) _ ->+ let heads = pat : concatMap (\c -> if null c then [] else [head c]) cs+ in DataType n $ heads >>= \p -> case p of+ Apply (DCon i _ (PatEval conds)) _ -> map (\(cond,_) -> (i, map (first snd) cond)) conds+ _ -> []+ Lambda{} -> error "checkNull"+ in (t2, (pat, pats) : cs', b)++checkNonEmptyClauses :: PatternType t -> [(Term (Con t) String, [Term (Con t) String])] -> Result+checkNonEmptyClauses _ [] = Result Incomplete []+checkNonEmptyClauses Interval clauses = checkIntervalClauses clauses+checkNonEmptyClauses (DataType n conds) clauses = checkDataTypeClauses n conds clauses+checkNonEmptyClauses Path clauses = checkClauses (map snd clauses)+checkNonEmptyClauses Unknown clauses = checkClauses (map snd clauses)++checkIntervalClauses :: [(Term (Con t) String, [Term (Con t) String])] -> Result+checkIntervalClauses clauses =+ let get con = map (\(i,(_,ps)) -> (i,ps)) $ filterWithIndex (\(c,_) -> c == con) clauses+ lefts = get $ Apply (ICon ILeft) []+ rights = get $ Apply (ICon IRight) []+ vars = get $ Var (error "") []+ Result _ is0 = checkClauses (map snd lefts)+ Result _ is1 = checkClauses (map snd rights)+ Result ok is2 = checkClauses (map snd vars)+ in Result ok $ getIndices lefts is0 ++ getIndices rights is1 ++ getIndices vars is2++checkDataTypeClauses :: Int -> [(Int, [Term (Con t) String])] -> [(Term (Con t) String, [Term (Con t) String])] -> Result+checkDataTypeClauses n conds clauses = getResults $ flip map [0 .. n-1] $ \j ->+ let getLength [] = 0+ getLength (Apply (DCon i _ _) args : _) | i == j = length args+ getLength (_ : pats) = getLength pats+ len = getLength (map fst clauses)+ + getPatterns (Apply _ pats) = pats+ getPatterns _ = replicate len $ Var (error "") []+ in map (\(i,(p,ps)) -> (i, getPatterns p ++ ps))+ (filterWithIndex (\(c,_) -> c == Apply (DCon j n $ PatEval []) [] || c == Var (error "") []) clauses)+ ++ (conds >>= \(c,ps) -> if j == c then [(-1, ps)] else [])+ where+ getResults :: [[(Int, [Term (Con t) String])]] -> Result+ getResults [] = Result OK []+ getResults (con:cons) =+ let Result ok1 is1 = checkClauses (map snd con)+ Result ok2 is2 = getResults cons+ in Result (if ok1 == OK && ok2 == OK then OK else Incomplete) (getIndices con is1 ++ is2)++getIndices :: [(Int,b)] -> [Int] -> [Int]+getIndices list = filter (>= 0) . map (\i -> fst $ list !! i)++filterWithIndex :: (a -> Bool) -> [a] -> [(Int,a)]+filterWithIndex p = go 0+ where+ go _ [] = []+ go i (x:xs) =+ let rs = go (i + 1) xs+ in if p x then (i,x):rs else rs
+ src/TypeChecking/Expressions/Patterns.hs view
@@ -0,0 +1,81 @@+{-# LANGUAGE ExistentialQuantification #-}++module TypeChecking.Expressions.Patterns+ ( typeCheckPatterns, typeCheckPattern+ , TermsInCtx(..), TermInCtx(..)+ ) where++import Data.Void+import Control.Monad++import Semantics+import Semantics.Value as V+import Syntax as S+import Syntax.ErrorDoc+import TypeChecking.Context+import TypeChecking.Monad+import TypeChecking.Expressions.Utils+import Normalization++data TermInCtx b = forall a. Eq a => TermInCtx (Ctx String (Type Semantics) b a) (Term Semantics a)+data TermsInCtx b = forall a. Eq a => TermsInCtx (Ctx String (Type Semantics) b a) [Term Semantics a] (Type Semantics a)++typeCheckPattern :: (Monad m, Eq a) => Ctx String (Type Semantics) Void a -> Type Semantics a+ -> Term PName b -> TCM m (Bool, Maybe (TermInCtx a), Term (String,SCon) String)+typeCheckPattern ctx (Type (Apply (Semantics _ Interval) _) _) (Apply (pos, Ident "left") pats) = do+ unless (null pats) $ warn [tooManyArgs pos]+ return (False, Just $ TermInCtx Nil $ iCon ILeft, Apply ("left", ICon ILeft) [])+typeCheckPattern ctx (Type (Apply (Semantics _ Interval) _) _) (Apply (pos, Ident "right") pats) = do+ unless (null pats) $ warn [tooManyArgs pos]+ return (False, Just $ TermInCtx Nil $ iCon IRight, Apply ("right", ICon IRight) [])+typeCheckPattern ctx (Type (Apply (Semantics _ (DataType _ 0)) _) _) (Apply (_, Operator "") _) =+ return (True, Nothing, Var "_" [])+typeCheckPattern ctx (Type ty _) (Apply (pos, Operator "") _) =+ throwError [Error Other $ emsgLC pos "" $ pretty "Expected non-empty type:" <+> prettyOpen ctx ty]+typeCheckPattern ctx _ (Apply (_, Ident "_") []) = return (False, Nothing, Var "_" [])+typeCheckPattern ctx (Type ty@(Apply (Semantics _ (DataType dt _)) _) k) (Apply (pos, Ident var) []) = do+ cons <- lift $ getConstructor (Ident var) (Just dt)+ case cons of+ (con@(Semantics _ (Con (DCon i n conds))), Closed (Type conType _)):_ -> if isDataType conType+ then return (False, Just $ TermInCtx Nil $ capply con, Apply (var, DCon i n conds) [])+ else throwError [notEnoughArgs pos var]+ _ -> return (False, Just $ TermInCtx (Snoc Nil var $ Type ty k) bvar, Var var [])+ where+ isDataType :: Term Semantics a -> Bool+ isDataType (Lambda t) = isDataType t+ isDataType (Apply (Semantics _ DataType{}) _) = True+ isDataType _ = False+typeCheckPattern ctx (Type ty k) (Apply (pos, Ident var) []) =+ return (False, Just $ TermInCtx (Snoc Nil var $ Type ty k) bvar, cvar var)+typeCheckPattern ctx (Type (Apply (Semantics _ (DataType dt _)) params) _) (Apply (pos, Ident conName) pats) = do+ cons <- lift $ getConstructor (Ident conName) (Just dt)+ case cons of+ (con@(Semantics _ (Con (DCon i n conds))), Closed (Type conType k)):_ -> do+ let conType' = Type (nf WHNF $ apps conType params) k+ (bf, TermsInCtx ctx' terms (Type ty' _), rtpats) <- typeCheckPatterns ctx conType' pats+ case nf WHNF ty' of+ Apply (Semantics _ DataType{}) _ ->+ return (bf, Just $ TermInCtx ctx' (Apply con terms), Apply (conName, DCon i n conds) rtpats)+ _ -> throwError [notEnoughArgs pos conName]+ _ -> throwError [notInScope pos "data constructor" conName]+typeCheckPattern ctx (Type ty _) (Apply (pos, _) _) =+ throwError [Error TypeMismatch $ emsgLC pos "" $ pretty "Unexpected pattern"+ $$ pretty "Expected type:" <+> prettyOpen ctx ty]+typeCheckPattern _ _ _ = error "typeCheckPattern"++typeCheckPatterns :: (Monad m, Eq a) => Ctx String (Type Semantics) Void a -> Type Semantics a+ -> [Term PName b] -> TCM m (Bool, TermsInCtx a, [Term (String,SCon) String])+typeCheckPatterns _ ty [] = return (False, TermsInCtx Nil [] ty, [])+typeCheckPatterns ctx (Type (Apply p@(Semantics _ (V.Pi k1 k2)) [a, b]) _) (pat:pats) = do+ let a' = Type (nf WHNF a) k1+ (bf1, mte, rtpat) <- typeCheckPattern ctx a' pat+ TermInCtx ctx' te <- case mte of+ Nothing -> return $ TermInCtx (Snoc Nil "_" a') bvar+ Just te -> return te+ let b' = case b of+ Lambda{} -> instantiate1 te $ fmap (fmap $ liftBase ctx') $ snd (dropOnePi p a b)+ _ -> fmap (liftBase ctx') b+ (bf2, TermsInCtx ctx'' tes ty, rtpats) <- typeCheckPatterns (ctx +++ ctx') (Type (nf WHNF b') k2) pats+ return (bf1 || bf2, TermsInCtx (ctx' +++ ctx'') (fmap (liftBase ctx'') te : tes) ty, rtpat:rtpats)+typeCheckPatterns _ _ (Apply (pos, _) _ : _) = throwError [tooManyArgs pos]+typeCheckPatterns _ _ _ = error "typeCheckPatterns"
+ src/TypeChecking/Expressions/Utils.hs view
@@ -0,0 +1,86 @@+module TypeChecking.Expressions.Utils where++import Data.Bifunctor+import Data.Void++import Syntax+import Syntax.ErrorDoc+import Semantics+import Semantics.Value+import TypeChecking.Context+import TypeChecking.Monad.Warn++data Error = Error { errorType :: ErrorType, errorMsg :: EMsg (Term Syntax) }++instance Eq Error where+ Error e _ == Error e' _ = e == e'++data ErrorType+ = NotInScope+ | Inference+ | TooManyArgs+ | NotEnoughArgs+ | Coverage+ | TypeMismatch+ | Conditions+ | Other+ deriving Eq++data Argument = Argument Int Posn (Maybe Name) | NoArgument [Error]++instance Eq Argument where+ Argument k p _ == Argument k' p' _ = k == k' && p == p'+ _ == _ = False++notInScope :: Show a => Posn -> String -> a -> Error+notInScope pos s a = Error NotInScope $ emsgLC pos ("Not in scope: " ++ (if null s then "" else s ++ " ") ++ show a) enull++inferErrorMsg :: Posn -> String -> Error+inferErrorMsg pos s = Error Inference $ emsgLC pos ("Cannot infer type of " ++ s) enull++inferExprErrorMsg :: Posn -> Error+inferExprErrorMsg pos = Error Inference $ emsgLC pos "Cannot infer an expressions" enull++inferArgErrorMsg :: Argument -> [Error]+inferArgErrorMsg (Argument k pos mname) = [Error Inference $ emsgLC pos+ ("Cannot infer " ++ nth (k + 1) ++ " argument" ++ maybe "" (\name -> " for " ++ nameToPrefix name) mname) enull]+ where+ nth 1 = "first"+ nth 2 = "second"+ nth 3 = "third"+ nth n = show n ++ "th"+inferArgErrorMsg (NoArgument errs) = errs++inferParamsErrorMsg :: Show a => Posn -> a -> Error+inferParamsErrorMsg pos d = Error Inference $ emsgLC pos ("Cannot infer parameters of data constructor " ++ show d) enull++argsErrorMsg :: Posn -> String -> Error+argsErrorMsg pos s = Error TooManyArgs $ emsgLC pos (s ++ " is applied to arguments") enull++expectedArgErrorMsg :: Show a => Posn -> a -> Error+expectedArgErrorMsg lc d = Error NotEnoughArgs $ emsgLC lc ("Expected an argument to " ++ show d) enull++coverageErrorMsg :: Posn -> Maybe [Posn] -> [Error]+coverageErrorMsg pos Nothing = [Error Coverage $ emsgLC pos "Incomplete pattern matching" enull]+coverageErrorMsg _ (Just uc) = map (\pos -> Error Coverage $ emsgLC pos "Unreachable clause" enull) uc++notEnoughArgs :: Show a => Posn -> a -> Error+notEnoughArgs pos a = Error NotEnoughArgs $ emsgLC pos ("Not enough arguments to " ++ show a) enull++tooManyArgs :: Posn -> Error+tooManyArgs pos = Error TooManyArgs $ emsgLC pos "Too many arguments" enull++prettyOpen :: Ctx String (Type Semantics) Void a -> Term Semantics a -> EDoc (Term Syntax)+prettyOpen ctx term = epretty $ fmap (pretty . either id absurd) $ close ctx (bimap syntax Right term)++checkIsType :: Monad m => Ctx String (Type Semantics) Void a -> Posn -> Term Semantics a -> WarnT [Error] m Sort+checkIsType _ _ (Apply (Semantics _ (Universe k)) _) = return k+checkIsType ctx pos t = throwError [Error TypeMismatch $ emsgLC pos "" $ pretty "Expected type: Type"+ $$ pretty "Actual type:" <+> prettyOpen ctx t]++termPos :: Term (Posn, s) a -> Posn+termPos (Apply (pos, _) _) = pos+termPos _ = error "termPos"++catchErrorType :: Monad m => [ErrorType] -> WarnT [Error] m a -> ([Error] -> WarnT [Error] m a) -> WarnT [Error] m a+catchErrorType errs = catchErrorBy $ \(Error err _) -> err `elem` errs
src/TypeChecking/Monad.hs view
@@ -1,5 +1,5 @@ module TypeChecking.Monad- ( EDocM, ScopeM, TCM, runTCM+ ( EDocM, TCM, runTCM , addFunctionCheck, addDataTypeCheck, addConstructorCheck , module TypeChecking.Monad.Warn , module TypeChecking.Monad.Scope@@ -9,42 +9,36 @@ import Control.Monad import Control.Monad.Trans(lift) +import TypeChecking.Expressions.Utils import TypeChecking.Monad.Warn import TypeChecking.Monad.Scope-import Syntax.Term-import Syntax.Expr+import Syntax+import Semantics+import Semantics.Value import Syntax.ErrorDoc -type EDocM = WarnT [EMsg Term]-type ScopeM = ScopeT (Term String) (Type String) (Scope String Term String) (Scope String Term String, Level)-type TCM m = EDocM (ScopeM m)+type EDocM = WarnT [Error]+type TCM m = EDocM (ScopeT m) runTCM :: Monad m => TCM m a -> m (Maybe a) runTCM = liftM snd . runScopeT . runWarnT -multipleDeclaration :: (Int,Int) -> String -> EMsg f-multipleDeclaration lc var = emsgLC lc ("Multiple declarations of " ++ show var) enull+multipleDeclaration :: Posn -> Name -> Error+multipleDeclaration pos var = Error Other $ emsgLC pos ("Multiple declarations of " ++ show (nameToString var)) enull -addFunctionCheck :: Monad m => PIdent -> Term String -> Type String -> TCM m ()-addFunctionCheck (PIdent (lc,var)) te ty = do+addFunctionCheck :: Monad m => PName -> SEval -> Closed (Type Semantics) -> TCM m ID+addFunctionCheck (pos, var) e ty = do mr <- lift (getEntry var Nothing)- case mr of- [] -> lift (addFunction var te ty)- _ -> warn [multipleDeclaration lc var]+ if null mr then lift (addFunction var e ty) else throwError [multipleDeclaration pos var] -addDataTypeCheck :: Monad m => PIdent -> Type String -> Int -> TCM m ()-addDataTypeCheck (PIdent (lc,var)) ty b = do- mr <- lift (getEntry var Nothing)- case mr of- FunctionE _ _ : _ -> warn [multipleDeclaration lc var]- DataTypeE _ _ : _ -> warn [multipleDeclaration lc var]- _ -> lift (addDataType var ty b)+addDataTypeCheck :: Monad m => PName -> Int -> Closed (Type Semantics) -> TCM m ID+addDataTypeCheck (pos, var) n ty = do+ mf <- lift (getFunction var)+ md <- lift (getDataType var)+ if null mf && null md then lift (addDataType var n ty) else throwError [multipleDeclaration pos var] -addConstructorCheck :: Monad m => PIdent -> String -> Int- -> Scope String Term String -> Scope String Term String -> Level -> TCM m ()-addConstructorCheck (PIdent (lc,var)) dt n te ty lvl = do- mr <- lift $ getEntry var (Just dt)- case mr of- FunctionE _ _ : _ -> warn [multipleDeclaration lc var]- ConstructorE _ _ _ : _ -> warn [multipleDeclaration lc var]- _ -> lift $ addConstructor var dt n te (ty,lvl)+addConstructorCheck :: Monad m => PName -> ID -> Int -> Int -> SEval -> Closed (Type Semantics) -> TCM m ()+addConstructorCheck (pos, var) dt i n e ty = do+ mf <- lift (getFunction var)+ mc <- lift $ getConstructor var (Just dt)+ if null mf && null mc then lift (addConstructor var dt i n e ty) else warn [multipleDeclaration pos var]
src/TypeChecking/Monad/Scope.hs view
@@ -3,57 +3,94 @@ module TypeChecking.Monad.Scope ( ScopeT, runScopeT , addFunction, addConstructor, addDataType- , deleteDataType- , getConstructor, getConstructorDataTypes- , Entry(..), getEntry+ , replaceDataType, replaceFunction+ , getDataType, getFunction+ , getConstructor, getEntry ) where import Control.Monad import Control.Monad.Fix import Control.Monad.State import Control.Applicative-import Data.List import Data.Maybe -data Entry a b c d = FunctionE a b | DataTypeE b Int | ConstructorE Int c d+import Syntax+import Semantics+import Semantics.Value -data ScopeState a b c d = ScopeState- { functions :: [(String, (a, b))]- , dataTypes :: [(String, (b, Int))]- , constructors :: [((String, String), (Int, c, d))]+data ScopeState = ScopeState+ { functions :: [(Name, (Semantics, Closed (Type Semantics)))]+ , dataTypes :: [(Name, (Semantics, Closed (Type Semantics)))]+ , constructors :: [((Name, ID), (Semantics, Closed (Type Semantics)))]+ , counter :: ID } -newtype ScopeT a b c d m a' = ScopeT { unScopeT :: StateT (ScopeState a b c d) m a' }+newtype ScopeT m a = ScopeT { unScopeT :: StateT ScopeState m a } deriving (Functor,Monad,MonadTrans,MonadIO,MonadFix,Applicative) -addFunction :: Monad m => String -> a -> b -> ScopeT a b c d m ()-addFunction v te ty = ScopeT $ modify $ \scope -> scope { functions = (v, (te, ty)) : functions scope }+addFunction :: Monad m => Name -> SEval -> Closed (Type Semantics) -> ScopeT m ID+addFunction v e ty = ScopeT $ do+ scope <- get+ let (fc,scope') = updScopeFunction v e ty scope+ put scope'+ return fc -addDataType :: Monad m => String -> b -> Int -> ScopeT a b c d m ()-addDataType v ty b = ScopeT $ modify $ \scope -> scope { dataTypes = (v, (ty, b)) : dataTypes scope }+replaceFunction :: Monad m => Name -> SEval -> Closed (Type Semantics) -> ScopeT m ()+replaceFunction v e ty = ScopeT $ modify $ \scope -> case lookupDelete v (functions scope) of+ Just ((Semantics s (FunCall i _),_), functions') -> scope { functions = (v, (Semantics s (FunCall i e), ty)) : functions' }+ _ -> snd (updScopeFunction v e ty scope) -addConstructor :: Monad m => String -> String -> Int -> c -> d -> ScopeT a b c d m ()-addConstructor con dt n te ty = ScopeT $ modify $ \scope ->- scope { constructors = ((con, dt), (n, te, ty)) : constructors scope }+updScopeFunction :: Name -> SEval -> Closed (Type Semantics) -> ScopeState -> (ID, ScopeState)+updScopeFunction v e ty scope = (counter scope, scope+ { functions = (v, (Semantics (Name Prefix v) (FunCall (counter scope) e), ty)) : functions scope+ , counter = counter scope + 1+ }) -deleteDataType :: Monad m => String -> ScopeT a b c d m ()-deleteDataType dt = ScopeT $ modify $ \scope ->- scope { dataTypes = deleteBy (\(v1,_) (v2,_) -> v1 == v2) (dt, error "") (dataTypes scope) }+getFunction :: Monad m => Name -> ScopeT m [(Semantics, Closed (Type Semantics))]+getFunction v = ScopeT $ liftM (map snd . filter (\(v',_) -> v == v') . functions) get -getConstructor :: Monad m => String -> Maybe String -> ScopeT a b c d m [(Int, c, d)]+addDataType :: Monad m => Name -> Int -> Closed (Type Semantics) -> ScopeT m ID+addDataType v n ty = ScopeT $ do+ scope <- get+ let (dt,scope') = updScopeDataType v n ty scope+ put scope'+ return dt++replaceDataType :: Monad m => Name -> Int -> Closed (Type Semantics) -> ScopeT m ()+replaceDataType v n ty = ScopeT $ modify $ \scope -> case lookupDelete v (dataTypes scope) of+ Just ((Semantics s (DataType i _), _), dataTypes') -> scope { dataTypes = (v, (Semantics s (DataType i n), ty)) : dataTypes' }+ _ -> snd (updScopeDataType v n ty scope)++updScopeDataType :: Name -> Int -> Closed (Type Semantics) -> ScopeState -> (ID, ScopeState)+updScopeDataType v n ty scope = (counter scope, scope+ { dataTypes = (v, (Semantics (Name Prefix v) (DataType (counter scope) n), ty)) : dataTypes scope+ , counter = counter scope + 1+ })++getDataType :: Monad m => Name -> ScopeT m [(Semantics, Closed (Type Semantics))]+getDataType v = ScopeT $ liftM (map snd . filter (\(v',_) -> v == v') . dataTypes) get++lookupDelete :: Eq a => a -> [(a,b)] -> Maybe (b, [(a,b)])+lookupDelete _ [] = Nothing+lookupDelete a' ((a,b):xs) | a == a' = Just (b, xs)+ | otherwise = fmap (\(b',xs') -> (b', (a,b):xs')) (lookupDelete a' xs)++addConstructor :: Monad m => Name -> ID -> Int -> Int -> SEval -> Closed (Type Semantics) -> ScopeT m ()+addConstructor con dt i n e ty = ScopeT $ modify $ \scope -> scope+ { constructors = ((con, dt), (Semantics (Name Prefix con) (Con $ DCon i n e), ty)) : constructors scope+ }++getConstructor :: Monad m => Name -> Maybe ID -> ScopeT m [(Semantics, Closed (Type Semantics))] getConstructor con (Just dt) = ScopeT $ liftM (maybeToList . lookup (con, dt) . constructors) get getConstructor con Nothing = ScopeT $ liftM (map snd . filter (\((c,_),_) -> con == c) . constructors) get -getConstructorDataTypes :: Monad m => String -> ScopeT a b c d m [String]-getConstructorDataTypes con = ScopeT $ liftM (map (snd . fst) . filter (\((c,_),_) -> con == c) . constructors) get--getEntry :: Monad m => String -> Maybe String -> ScopeT a b c d m [Entry a b c d]+getEntry :: Monad m => Name -> Maybe (ID, [Term Semantics a]) -> ScopeT m [(Semantics, Type Semantics a)] getEntry v dt = ScopeT $ do- cons <- unScopeT (getConstructor v dt)+ cons <- unScopeT $ getConstructor v (fmap fst dt) scope <- get- return $ map (uncurry FunctionE) (maybeToList $ lookup v $ functions scope)- ++ (if isNothing dt then map (uncurry DataTypeE) (maybeToList $ lookup v $ dataTypes scope) else [])- ++ map (\(i,c,d) -> ConstructorE i c d) cons+ let dts = if isNothing dt then maybeToList $ lookup v $ dataTypes scope else []+ return $ map (\(s,t) -> (s, open t)) (maybeToList (lookup v $ functions scope) ++ dts)+ ++ if null dts then (map (\(s, Closed (Type t l)) -> (s, Type (apps t (maybe [] snd dt)) l)) cons) else [] -runScopeT :: Monad m => ScopeT a b c d m a' -> m a'-runScopeT (ScopeT f) = evalStateT f $ ScopeState [] [] []+runScopeT :: Monad m => ScopeT m a -> m a+runScopeT (ScopeT f) = evalStateT f $ ScopeState [] [] [] 0
src/TypeChecking/Monad/Warn.hs view
@@ -3,7 +3,9 @@ module TypeChecking.Monad.Warn ( WarnT, warn, runWarnT , throwError, catchError+ , catchErrorBy , forW, throwErrors+ , mapWarnT ) where import Control.Monad@@ -13,6 +15,7 @@ import Control.Applicative import Data.Monoid hiding ((<>)) import Data.Maybe+import Data.Either newtype WarnT w m a = WarnT { runWarnT :: m (w, Maybe a) } @@ -55,3 +58,12 @@ throwErrors :: Monad m => [w] -> WarnT [w] m () throwErrors [] = return () throwErrors ws = throwError ws++catchErrorBy :: Monad m => (w -> Bool) -> WarnT [w] m a -> ([w] -> WarnT [w] m a) -> WarnT [w] m a+catchErrorBy p m h = WarnT $ runWarnT m >>= \(errs, ma) ->+ case partitionEithers $ map (\err -> if p err then Left err else Right err) errs of+ ([],_) -> return (errs,ma)+ (errs1,errs2) -> runWarnT $ warn errs2 >> h errs1++mapWarnT :: Monad m => (w -> w') -> WarnT w m a -> WarnT w' m a+mapWarnT f (WarnT m) = WarnT $ liftM (\(w,a) -> (f w, a)) m