packages feed

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 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