cryptol-2.2.6/ 0000755 0000000 0000000 00000000000 12637103426 011407 5 ustar 00 0000000 0000000 cryptol-2.2.6/cryptol.cabal 0000644 0000000 0000000 00000016151 12637103426 014073 0 ustar 00 0000000 0000000 Name: cryptol
Version: 2.2.6
Synopsis: Cryptol: The Language of Cryptography
Description: Cryptol is a domain-specific language for specifying cryptographic algorithms. A Cryptol implementation of an algorithm resembles its mathematical specification more closely than an implementation in a general purpose language. For more, see .
License: BSD3
License-files: LICENSE, LICENSE.rtf
Author: Galois, Inc.
Maintainer: cryptol@galois.com
Homepage: http://www.cryptol.net/
Bug-reports: https://github.com/GaloisInc/cryptol/issues
Copyright: 2013-2015 Galois Inc.
Category: Language
Build-type: Simple
Cabal-version: >= 1.20
data-files: *.cry
data-dir: lib
source-repository head
type: git
location: https://github.com/GaloisInc/cryptol.git
source-repository this
type: git
location: https://github.com/GaloisInc/cryptol.git
tag: v2.2.6
flag static
default: False
description: Create a statically-linked binary
flag relocatable
default: True
description: Don't use the Cabal-provided data directory for looking up Cryptol libraries. This is useful when the data directory can't be known ahead of time, like for a relocatable distribution.
flag self-contained
default: True
description: Compile the text of the Cryptol Prelude into the library
library
Default-language:
Haskell98
Build-depends: base >= 4.7 && < 5,
base-compat >= 0.6,
array >= 0.4,
async >= 2.0,
containers >= 0.5,
deepseq >= 1.3,
directory >= 1.2,
filepath >= 1.3,
gitrev >= 1.0,
GraphSCC >= 1.0.4,
monadLib >= 3.7.2,
old-time >= 1.1,
presburger >= 1.3,
pretty >= 1.1,
process >= 1.2,
QuickCheck >= 2.7,
random >= 1.0.1,
sbv >= 5.7,
smtLib >= 1.0.7,
syb >= 0.4,
text >= 1.1,
template-haskell,
tf-random >= 0.5,
transformers >= 0.3,
utf8-string >= 0.3
Build-tools: alex, happy
hs-source-dirs: src
Exposed-modules: Cryptol.Prims.Syntax,
Cryptol.Prims.Types,
Cryptol.Prims.Eval,
Cryptol.Prims.Doc,
Cryptol.Parser,
Cryptol.Parser.Lexer,
Cryptol.Parser.AST,
Cryptol.Parser.Position,
Cryptol.Parser.Names,
Cryptol.Parser.NoPat,
Cryptol.Parser.NoInclude,
Cryptol.Parser.Utils,
Cryptol.Parser.Unlit,
Cryptol.Utils.PP,
Cryptol.Utils.Panic,
Cryptol.Utils.Debug,
Cryptol.Version,
Cryptol.ModuleSystem,
Cryptol.ModuleSystem.Base,
Cryptol.ModuleSystem.Env,
Cryptol.ModuleSystem.Interface,
Cryptol.ModuleSystem.Monad,
Cryptol.ModuleSystem.NamingEnv,
Cryptol.ModuleSystem.Renamer,
Cryptol.TypeCheck,
Cryptol.TypeCheck.AST,
Cryptol.TypeCheck.Monad,
Cryptol.TypeCheck.Infer,
Cryptol.TypeCheck.InferTypes,
Cryptol.TypeCheck.Kind,
Cryptol.TypeCheck.Subst,
Cryptol.TypeCheck.Instantiate,
Cryptol.TypeCheck.Unify,
Cryptol.TypeCheck.Depends,
Cryptol.TypeCheck.PP,
Cryptol.TypeCheck.Solve,
Cryptol.TypeCheck.TypeMap,
Cryptol.TypeCheck.TypeOf,
Cryptol.TypeCheck.Defaulting,
Cryptol.TypeCheck.Solver.Eval,
Cryptol.TypeCheck.Solver.FinOrd,
Cryptol.TypeCheck.Solver.InfNat,
Cryptol.TypeCheck.Solver.Interval,
Cryptol.TypeCheck.Solver.Smtlib,
Cryptol.TypeCheck.Solver.Numeric,
Cryptol.TypeCheck.Solver.Class,
Cryptol.TypeCheck.Solver.Selector,
Cryptol.TypeCheck.Solver.CrySAT,
Cryptol.TypeCheck.Solver.Utils,
Cryptol.Transform.MonoValues,
Cryptol.Transform.Specialize,
Cryptol.Eval,
Cryptol.Eval.Arch,
Cryptol.Eval.Env,
Cryptol.Eval.Error,
Cryptol.Eval.Type,
Cryptol.Eval.Value,
Cryptol.Testing.Eval,
Cryptol.Testing.Exhaust,
Cryptol.Testing.Random,
Cryptol.Symbolic,
Cryptol.Symbolic.Prims,
Cryptol.Symbolic.Value,
Cryptol.REPL.Command,
Cryptol.REPL.Monad,
Cryptol.REPL.Trie
Other-modules: Cryptol.Parser.LexerUtils,
Cryptol.Parser.ParserUtils,
Cryptol.Prelude,
Paths_cryptol,
GitRev
default-extensions: CPP
GHC-options: -Wall -O2
ghc-prof-options: -fprof-auto -prof
if flag(relocatable)
cpp-options: -DRELOCATABLE
if flag(self-contained)
build-depends: heredoc >= 0.2
cpp-options: -DSELF_CONTAINED
executable cryptol
Default-language:
Haskell98
Main-is: Main.hs
hs-source-dirs: cryptol
Other-modules: OptParser,
REPL.Haskeline,
REPL.Logo,
Paths_cryptol
build-depends: ansi-terminal
, base
, containers
, cryptol
, deepseq
, directory
, filepath
, haskeline
, monadLib
, process
, random
, sbv
, tf-random
, transformers
default-extensions: CPP
GHC-options: -Wall -O2
ghc-prof-options: -auto-all -prof -rtsopts
if os(linux) && flag(static)
ld-options: -static -pthread
cryptol-2.2.6/LICENSE 0000644 0000000 0000000 00000002740 12637103426 012417 0 ustar 00 0000000 0000000 Copyright (c) 2013-2015 Galois Inc.
All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions
are met:
* Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.
* Redistributions in binary form must reproduce the above copyright
notice, this list of conditions and the following disclaimer in
the documentation and/or other materials provided with the
distribution.
* Neither the name of Galois, Inc. nor the names of its contributors
may be used to endorse or promote products derived from this
software without specific prior written permission.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
cryptol-2.2.6/LICENSE.rtf 0000644 0000000 0000000 00000003455 12637103426 013215 0 ustar 00 0000000 0000000 {\rtf1\ansi\ansicpg1252\cocoartf1265\cocoasubrtf190
{\fonttbl\f0\fswiss\fcharset0 Helvetica;}
{\colortbl;\red255\green255\blue255;}
\margl1440\margr1440\vieww12600\viewh7800\viewkind0
\pard\tx720\tx1440\tx2160\tx2880\tx3600\tx4320\tx5040\tx5760\tx6480\tx7200\tx7920\tx8640\pardirnatural
\f0\fs24 \cf0 Copyright (c) 2013-2015 Galois Inc.\
All rights reserved.\
\
Redistribution and use in source and binary forms, with or without\
modification, are permitted provided that the following conditions\
are met:\
\
* Redistributions of source code must retain the above copyright\
notice, this list of conditions and the following disclaimer.\
\
* Redistributions in binary form must reproduce the above copyright\
notice, this list of conditions and the following disclaimer in\
the documentation and/or other materials provided with the\
distribution.\
\
* Neither the name of Galois, Inc. nor the names of its contributors\
may be used to endorse or promote products derived from this\
software without specific prior written permission.\
\
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS\
IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED\
TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A\
PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER\
OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,\
EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,\
PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR\
PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF\
LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING\
NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS\
SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.\
} cryptol-2.2.6/Setup.hs 0000644 0000000 0000000 00000000361 12637103426 013043 0 ustar 00 0000000 0000000 -- |
-- Module : $Header$
-- Copyright : (c) 2013-2015 Galois, Inc.
-- License : BSD3
-- Maintainer : cryptol@galois.com
-- Stability : provisional
-- Portability : portable
import Distribution.Simple
main = defaultMain
cryptol-2.2.6/cryptol/ 0000755 0000000 0000000 00000000000 12637103426 013103 5 ustar 00 0000000 0000000 cryptol-2.2.6/cryptol/Main.hs 0000644 0000000 0000000 00000014657 12637103426 014340 0 ustar 00 0000000 0000000 -- |
-- Module : $Header$
-- Copyright : (c) 2013-2015 Galois, Inc.
-- License : BSD3
-- Maintainer : cryptol@galois.com
-- Stability : provisional
-- Portability : portable
{-# LANGUAGE CPP #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
module Main where
import OptParser
import Cryptol.REPL.Command (loadCmd,loadPrelude)
import Cryptol.REPL.Monad (REPL,updateREPLTitle,setUpdateREPLTitle,
io,prependSearchPath,setSearchPath)
import qualified Cryptol.REPL.Monad as REPL
import REPL.Haskeline
import REPL.Logo
import Cryptol.Utils.PP
import Cryptol.Version (commitHash, commitBranch, commitDirty)
import Paths_cryptol (version)
import Data.Version (showVersion)
import GHC.IO.Encoding (setLocaleEncoding, utf8)
import System.Console.GetOpt
(OptDescr(..),ArgOrder(..),ArgDescr(..),getOpt,usageInfo)
import System.Environment (getArgs, getProgName, lookupEnv)
import System.Exit (exitFailure)
import System.FilePath (searchPathSeparator, splitSearchPath, takeDirectory)
#if __GLASGOW_HASKELL__ < 710
import Data.Monoid (mconcat)
#endif
data Options = Options
{ optLoad :: [FilePath]
, optVersion :: Bool
, optHelp :: Bool
, optBatch :: Maybe FilePath
, optCryptolrc :: Cryptolrc
, optCryptolPathOnly :: Bool
} deriving (Show)
defaultOptions :: Options
defaultOptions = Options
{ optLoad = []
, optVersion = False
, optHelp = False
, optBatch = Nothing
, optCryptolrc = CryrcDefault
, optCryptolPathOnly = False
}
options :: [OptDescr (OptParser Options)]
options =
[ Option "b" ["batch"] (ReqArg setBatchScript "FILE")
"run the script provided and exit"
, Option "v" ["version"] (NoArg setVersion)
"display version number"
, Option "h" ["help"] (NoArg setHelp)
"display this message"
, Option "" ["ignore-cryptolrc"] (NoArg setCryrcDisabled)
"disable reading of .cryptolrc files"
, Option "" ["cryptolrc-script"] (ReqArg addCryrc "FILE")
"read additional .cryptolrc files"
, Option "" ["cryptolpath-only"] (NoArg setCryptolPathOnly)
"only look for .cry files in CRYPTOLPATH; don't use built-in locations"
]
-- | Set a single file to be loaded. This should be extended in the future, if
-- we ever plan to allow multiple files to be loaded at the same time.
addFile :: String -> OptParser Options
addFile path = modify $ \ opts -> opts { optLoad = [ path ] }
-- | Set a batch script to be run.
setBatchScript :: String -> OptParser Options
setBatchScript path = modify $ \ opts -> opts { optBatch = Just path }
-- | Signal that version should be displayed.
setVersion :: OptParser Options
setVersion = modify $ \ opts -> opts { optVersion = True }
-- | Signal that help should be displayed.
setHelp :: OptParser Options
setHelp = modify $ \ opts -> opts { optHelp = True }
-- | Disable .cryptolrc files entirely
setCryrcDisabled :: OptParser Options
setCryrcDisabled = modify $ \ opts -> opts { optCryptolrc = CryrcDisabled }
-- | Add another file to read as a @.cryptolrc@ file, unless @.cryptolrc@
-- files have been disabled
addCryrc :: String -> OptParser Options
addCryrc path = modify $ \ opts ->
case optCryptolrc opts of
CryrcDefault -> opts { optCryptolrc = CryrcFiles [path] }
CryrcDisabled -> opts
CryrcFiles xs -> opts { optCryptolrc = CryrcFiles (path:xs) }
setCryptolPathOnly :: OptParser Options
setCryptolPathOnly = modify $ \opts -> opts { optCryptolPathOnly = True }
-- | Parse arguments.
parseArgs :: [String] -> Either [String] Options
parseArgs args = case getOpt (ReturnInOrder addFile) options args of
(ps,[],[]) -> runOptParser defaultOptions (mconcat ps)
(_,_,errs) -> Left errs
displayVersion :: IO ()
displayVersion = do
let ver = showVersion version
putStrLn ("Cryptol " ++ ver)
putStrLn ("Git commit " ++ commitHash)
putStrLn (" branch " ++ commitBranch ++ dirtyLab)
where
dirtyLab | commitDirty = " (non-committed files present during build)"
| otherwise = ""
displayHelp :: [String] -> IO ()
displayHelp errs = do
prog <- getProgName
let banner = "Usage: " ++ prog ++ " [OPTIONS]"
paraLines = fsep . map text . words . unlines
ppEnv (varname, desc) = hang varname 4 (paraLines $ desc)
envs = [
( "CRYPTOLPATH"
, [ "A `" ++ [searchPathSeparator] ++ "`-separated"
, "list of directories to be searched for Cryptol modules in"
, "addition to the default locations"
]
)
, ( "SBV_{ABC,BOOLECTOR,CVC4,MATHSAT,YICES,Z3}_OPTIONS"
, [ "A string of command-line arguments to be passed to the"
, "corresponding solver invoked for `:sat` and `:prove`"
]
)
]
putStrLn (usageInfo (concat (errs ++ [banner])) options)
print $ hang "Influential environment variables:"
4 (vcat (map ppEnv envs))
main :: IO ()
main = do
setLocaleEncoding utf8
args <- getArgs
case parseArgs args of
Left errs -> do
displayHelp errs
exitFailure
Right opts
| optHelp opts -> displayHelp []
| optVersion opts -> displayVersion
| otherwise -> repl (optCryptolrc opts)
(optBatch opts)
(setupREPL opts)
setupREPL :: Options -> REPL ()
setupREPL opts = do
smoke <- REPL.smokeTest
case smoke of
[] -> return ()
_ -> io $ do
print (hang "Errors encountered on startup; exiting:"
4 (vcat (map pp smoke)))
exitFailure
displayLogo True
setUpdateREPLTitle setREPLTitle
updateREPLTitle
mCryptolPath <- io $ lookupEnv "CRYPTOLPATH"
case mCryptolPath of
Nothing -> return ()
Just path | optCryptolPathOnly opts -> setSearchPath path'
| otherwise -> prependSearchPath path'
#if defined(mingw32_HOST_OS) || defined(__MINGW32__)
-- Windows paths search from end to beginning
where path' = reverse (splitSearchPath path)
#else
where path' = splitSearchPath path
#endif
case optBatch opts of
Nothing -> return ()
-- add the directory containing the batch file to the module search path
Just file -> prependSearchPath [ takeDirectory file ]
case optLoad opts of
[] -> loadPrelude `REPL.catch` \x -> io $ print $ pp x
[l] -> loadCmd l `REPL.catch` \x -> io $ print $ pp x
_ -> io $ putStrLn "Only one file may be loaded at the command line."
cryptol-2.2.6/cryptol/OptParser.hs 0000644 0000000 0000000 00000001760 12637103426 015362 0 ustar 00 0000000 0000000 -- |
-- Module : $Header$
-- Copyright : (c) 2013-2015 Galois, Inc.
-- License : BSD3
-- Maintainer : cryptol@galois.com
-- Stability : provisional
-- Portability : portable
module OptParser where
import Data.Monoid (Endo(..))
#if __GLASGOW_HASKELL__ < 710
import Data.Monoid (Monoid(..))
#endif
data OptParser opt
= OptSuccess (Endo opt)
| OptFailure [String]
instance Monoid (OptParser opt) where
mempty = OptSuccess mempty
l `mappend` r = case (l,r) of
(OptSuccess f,OptSuccess g) -> OptSuccess (f `mappend` g)
(OptFailure a,OptFailure b) -> OptFailure (a `mappend` b)
(OptFailure _,_) -> l
(_,OptFailure _) -> r
runOptParser :: opt -> OptParser opt -> Either [String] opt
runOptParser def parse = case parse of
OptSuccess update -> Right (appEndo update def)
OptFailure msgs -> Left msgs
modify :: (opt -> opt) -> OptParser opt
modify f = OptSuccess (Endo f)
report :: String -> OptParser opt
report msg = OptFailure [msg]
cryptol-2.2.6/cryptol/REPL/ 0000755 0000000 0000000 00000000000 12637103426 013645 5 ustar 00 0000000 0000000 cryptol-2.2.6/cryptol/REPL/Haskeline.hs 0000644 0000000 0000000 00000017770 12637103426 016120 0 ustar 00 0000000 0000000 -- |
-- Module : $Header$
-- Copyright : (c) 2013-2015 Galois, Inc.
-- License : BSD3
-- Maintainer : cryptol@galois.com
-- Stability : provisional
-- Portability : portable
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE PatternGuards #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module REPL.Haskeline where
import Cryptol.REPL.Command
import Cryptol.REPL.Monad
import Cryptol.REPL.Trie
import Cryptol.Utils.PP
import qualified Control.Exception as X
import Control.Monad (guard, when)
import qualified Control.Monad.IO.Class as MTL
import qualified Control.Monad.Trans.Class as MTL
import Data.Char (isAlphaNum, isSpace)
import Data.Function (on)
import Data.List (isPrefixOf,nub,sortBy)
import System.Console.ANSI (setTitle)
import System.Console.Haskeline
import System.Directory ( doesFileExist
, getHomeDirectory
, getCurrentDirectory)
import System.FilePath ((>))
-- | Haskeline-specific repl implementation.
repl :: Cryptolrc -> Maybe FilePath -> REPL () -> IO ()
repl cryrc mbBatch begin =
do settings <- setHistoryFile (replSettings isBatch)
runREPL isBatch (runInputTBehavior behavior settings body)
where
body = withInterrupt $ do
MTL.lift evalCryptolrc
MTL.lift begin
loop
(isBatch,behavior) = case mbBatch of
Nothing -> (False,defaultBehavior)
Just path -> (True,useFile path)
loop = do
prompt <- MTL.lift getPrompt
mb <- handleInterrupt (return (Just "")) (getInputLines prompt [])
case mb of
Just line
| Just cmd <- parseCommand findCommandExact line -> do
continue <- MTL.lift $ do
handleInterrupt handleCtrlC (runCommand cmd)
shouldContinue
when continue loop
| otherwise -> loop
Nothing -> return ()
getInputLines prompt ls =
do mb <- getInputLine prompt
let newPropmpt = map (\_ -> ' ') prompt
case mb of
Nothing -> return Nothing
Just l | not (null l) && last l == '\\' ->
getInputLines newPropmpt (init l : ls)
| otherwise -> return $ Just $ unlines $ reverse $ l : ls
evalCryptolrc =
case cryrc of
CryrcDefault -> do
here <- io $ getCurrentDirectory
home <- io $ getHomeDirectory
let dcHere = here > ".cryptolrc"
dcHome = home > ".cryptolrc"
isHere <- io $ doesFileExist dcHere
isHome <- io $ doesFileExist dcHome
if | isHere -> slurp dcHere
| isHome -> slurp dcHome
| otherwise -> whenDebug $ io $ putStrLn "no .cryptolrc found"
CryrcFiles paths -> mapM_ slurp paths
CryrcDisabled -> return ()
-- | Actually read the contents of a file, but don't save the
-- history
--
-- XXX: friendlier error message would be nice if the file can't be
-- found, but since these will be specified on the command line it
-- should be obvious what's going wrong
slurp path = do
let settings' = defaultSettings { autoAddHistory = False }
runInputTBehavior (useFile path) settings' (withInterrupt loop)
-- | Try to set the history file.
setHistoryFile :: Settings REPL -> IO (Settings REPL)
setHistoryFile ss =
do dir <- getHomeDirectory
return ss { historyFile = Just (dir > ".cryptol_history") }
`X.catch` \(SomeException {}) -> return ss
-- | Haskeline settings for the REPL.
replSettings :: Bool -> Settings REPL
replSettings isBatch = Settings
{ complete = cryptolCommand
, historyFile = Nothing
, autoAddHistory = not isBatch
}
-- .cryptolrc ------------------------------------------------------------------
-- | Configuration of @.cryptolrc@ file behavior. The default option
-- searches the following locations in order, and evaluates the first
-- file that exists in batch mode on interpreter startup:
--
-- 1. $PWD/.cryptolrc
-- 2. $HOME/.cryptolrc
--
-- If files are specified, they will all be evaluated, but none of the
-- default files will be (unless they are explicitly specified).
--
-- The disabled option inhibits any reading of any .cryptolrc files.
data Cryptolrc =
CryrcDefault
| CryrcDisabled
| CryrcFiles [FilePath]
deriving (Show)
-- Utilities -------------------------------------------------------------------
instance MTL.MonadIO REPL where
liftIO = io
instance MonadException REPL where
controlIO branchIO = REPL $ \ ref -> do
runBody <- branchIO $ RunIO $ \ m -> do
a <- unREPL m ref
return (return a)
unREPL runBody ref
-- Titles ----------------------------------------------------------------------
mkTitle :: Maybe LoadedModule -> String
mkTitle lm = maybe "" (\ m -> pretty m ++ " - ") (lName =<< lm)
++ "cryptol"
setREPLTitle :: REPL ()
setREPLTitle = do
lm <- getLoadedMod
io (setTitle (mkTitle lm))
-- Completion ------------------------------------------------------------------
-- | Completion for cryptol commands.
cryptolCommand :: CompletionFunc REPL
cryptolCommand cursor@(l,r)
| ":" `isPrefixOf` l'
, Just (cmd,rest) <- splitCommand l' = case nub (findCommand cmd) of
[c] | null rest && not (any isSpace l') -> do
return (l, cmdComp cmd c)
| otherwise -> do
(rest',cs) <- cmdArgument (cBody c) (reverse (sanitize rest),r)
return (unwords [rest', reverse cmd],cs)
cmds ->
return (l, concat [ cmdComp l' c | c <- cmds ])
-- Complete all : commands when the line is just a :
| ":" == l' = return (l, concat [ cmdComp l' c | c <- nub (findCommand ":") ])
| otherwise = completeExpr cursor
where
l' = sanitize (reverse l)
-- | Generate completions from a REPL command definition.
cmdComp :: String -> CommandDescr -> [Completion]
cmdComp prefix c = do
cName <- cNames c
guard (prefix `isPrefixOf` cName)
return $ Completion
{ replacement = drop (length prefix) cName
, display = cName
, isFinished = True
}
-- | Dispatch to a completion function based on the kind of completion the
-- command is expecting.
cmdArgument :: CommandBody -> CompletionFunc REPL
cmdArgument ct cursor@(l,_) = case ct of
ExprArg _ -> completeExpr cursor
DeclsArg _ -> (completeExpr +++ completeType) cursor
ExprTypeArg _ -> (completeExpr +++ completeType) cursor
FilenameArg _ -> completeFilename cursor
ShellArg _ -> completeFilename cursor
OptionArg _ -> completeOption cursor
NoArg _ -> return (l,[])
-- | Complete a name from the expression environment.
completeExpr :: CompletionFunc REPL
completeExpr (l,_) = do
ns <- getExprNames
let n = reverse (takeWhile isIdentChar l)
vars = filter (n `isPrefixOf`) ns
return (l,map (nameComp n) vars)
-- | Complete a name from the type synonym environment.
completeType :: CompletionFunc REPL
completeType (l,_) = do
ns <- getTypeNames
let n = reverse (takeWhile isIdentChar l)
vars = filter (n `isPrefixOf`) ns
return (l,map (nameComp n) vars)
-- | Generate a completion from a prefix and a name.
nameComp :: String -> String -> Completion
nameComp prefix c = Completion
{ replacement = drop (length prefix) c
, display = c
, isFinished = True
}
isIdentChar :: Char -> Bool
isIdentChar c = isAlphaNum c || c `elem` "_\'"
-- | Join two completion functions together, merging and sorting their results.
(+++) :: CompletionFunc REPL -> CompletionFunc REPL -> CompletionFunc REPL
(as +++ bs) cursor = do
(_,acs) <- as cursor
(_,bcs) <- bs cursor
return (fst cursor, sortBy (compare `on` replacement) (acs ++ bcs))
-- | Complete an option from the options environment.
--
-- XXX this can do better, as it has access to the expected form of the value
completeOption :: CompletionFunc REPL
completeOption cursor@(l,_) = return (fst cursor, map comp opts)
where
n = reverse l
opts = lookupTrie n userOptions
comp opt = Completion
{ replacement = drop (length n) (optName opt)
, display = optName opt
, isFinished = False
}
cryptol-2.2.6/cryptol/REPL/Logo.hs 0000644 0000000 0000000 00000003002 12637103426 015074 0 ustar 00 0000000 0000000 -- |
-- Module : $Header$
-- Copyright : (c) 2013-2015 Galois, Inc.
-- License : BSD3
-- Maintainer : cryptol@galois.com
-- Stability : provisional
-- Portability : portable
module REPL.Logo where
import Cryptol.REPL.Monad
import Paths_cryptol (version)
import Cryptol.Version (commitShortHash)
import Data.Version (showVersion)
import System.Console.ANSI
type Version = String
type Logo = [String]
logo :: Bool -> Logo
logo useColor =
[ sgr [SetColor Foreground Dull White] ++ l | l <- ws ]
++ [ sgr [SetColor Foreground Vivid Blue ] ++ l | l <- vs ]
++ [ sgr [SetColor Foreground Dull Blue ] ++ l | l <- ds ]
++ [ sgr [Reset] ]
where
sgr | useColor = setSGRCode
| otherwise = const []
hashText | commitShortHash == "UNKNOWN" = ""
| otherwise = " (" ++ commitShortHash ++ ")"
versionText = "version " ++ showVersion version ++ hashText
ver = sgr [SetColor Foreground Dull White]
++ replicate (lineLen - 20 - length versionText) ' '
++ versionText
ls =
[ " _ _"
, " ___ _ __ _ _ _ __ | |_ ___ | |"
, " / __| \'__| | | | \'_ \\| __/ _ \\| |"
, " | (__| | | |_| | |_) | || (_) | |"
, " \\___|_| \\__, | .__/ \\__\\___/|_|"
, " |___/|_| " ++ ver
]
slen = length ls `div` 3
(ws,rest) = splitAt slen ls
(vs,ds) = splitAt slen rest
lineLen = length (head ls)
displayLogo :: Bool -> REPL ()
displayLogo useColor =unlessBatch (io (mapM_ putStrLn (logo useColor)))
cryptol-2.2.6/dist/ 0000755 0000000 0000000 00000000000 12637103425 012351 5 ustar 00 0000000 0000000 cryptol-2.2.6/dist/build/ 0000755 0000000 0000000 00000000000 12637103425 013450 5 ustar 00 0000000 0000000 cryptol-2.2.6/dist/build/Cryptol/ 0000755 0000000 0000000 00000000000 12637103425 015104 5 ustar 00 0000000 0000000 cryptol-2.2.6/dist/build/Cryptol/Parser.hs 0000644 0000000 0000000 00000562701 12637103425 016707 0 ustar 00 0000000 0000000 {-# OPTIONS_GHC -w #-}
{-# OPTIONS -fglasgow-exts -cpp #-}
{-# LANGUAGE Trustworthy #-}
module Cryptol.Parser
( parseModule
, parseProgram, parseProgramWith
, parseExpr, parseExprWith
, parseDecl, parseDeclWith
, parseDecls, parseDeclsWith
, parseLetDecl, parseLetDeclWith
, parseRepl, parseReplWith
, parseSchema, parseSchemaWith
, parseModName
, ParseError(..), ppError
, Layout(..)
, Config(..), defaultConfig
, guessPreProc, PreProc(..)
) where
import Data.Maybe(fromMaybe)
import Control.Monad(liftM2,msum)
import Cryptol.Prims.Syntax
import Cryptol.Parser.AST
import Cryptol.Parser.Position
import Cryptol.Parser.LexerUtils
import Cryptol.Parser.ParserUtils
import Cryptol.Parser.Unlit(PreProc(..), guessPreProc)
import Paths_cryptol
import qualified Data.Array as Happy_Data_Array
import qualified GHC.Exts as Happy_GHC_Exts
import Control.Applicative(Applicative(..))
import Control.Monad (ap)
-- parser produced by Happy Version 1.19.5
newtype HappyAbsSyn t55 = HappyAbsSyn HappyAny
#if __GLASGOW_HASKELL__ >= 607
type HappyAny = Happy_GHC_Exts.Any
#else
type HappyAny = forall a . a
#endif
happyIn14 :: (Module) -> (HappyAbsSyn t55)
happyIn14 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn14 #-}
happyOut14 :: (HappyAbsSyn t55) -> (Module)
happyOut14 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut14 #-}
happyIn15 :: (([Located Import], [TopDecl])) -> (HappyAbsSyn t55)
happyIn15 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn15 #-}
happyOut15 :: (HappyAbsSyn t55) -> (([Located Import], [TopDecl]))
happyOut15 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut15 #-}
happyIn16 :: ([Located Import]) -> (HappyAbsSyn t55)
happyIn16 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn16 #-}
happyOut16 :: (HappyAbsSyn t55) -> ([Located Import])
happyOut16 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut16 #-}
happyIn17 :: (Located Import) -> (HappyAbsSyn t55)
happyIn17 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn17 #-}
happyOut17 :: (HappyAbsSyn t55) -> (Located Import)
happyOut17 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut17 #-}
happyIn18 :: (Maybe (Located ModName)) -> (HappyAbsSyn t55)
happyIn18 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn18 #-}
happyOut18 :: (HappyAbsSyn t55) -> (Maybe (Located ModName))
happyOut18 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut18 #-}
happyIn19 :: (Maybe (Located ImportSpec)) -> (HappyAbsSyn t55)
happyIn19 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn19 #-}
happyOut19 :: (HappyAbsSyn t55) -> (Maybe (Located ImportSpec))
happyOut19 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut19 #-}
happyIn20 :: ([LName]) -> (HappyAbsSyn t55)
happyIn20 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn20 #-}
happyOut20 :: (HappyAbsSyn t55) -> ([LName])
happyOut20 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut20 #-}
happyIn21 :: ([Name] -> ImportSpec) -> (HappyAbsSyn t55)
happyIn21 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn21 #-}
happyOut21 :: (HappyAbsSyn t55) -> ([Name] -> ImportSpec)
happyOut21 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut21 #-}
happyIn22 :: (Program) -> (HappyAbsSyn t55)
happyIn22 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn22 #-}
happyOut22 :: (HappyAbsSyn t55) -> (Program)
happyOut22 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut22 #-}
happyIn23 :: (Program) -> (HappyAbsSyn t55)
happyIn23 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn23 #-}
happyOut23 :: (HappyAbsSyn t55) -> (Program)
happyOut23 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut23 #-}
happyIn24 :: ([TopDecl]) -> (HappyAbsSyn t55)
happyIn24 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn24 #-}
happyOut24 :: (HappyAbsSyn t55) -> ([TopDecl])
happyOut24 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut24 #-}
happyIn25 :: ([TopDecl]) -> (HappyAbsSyn t55)
happyIn25 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn25 #-}
happyOut25 :: (HappyAbsSyn t55) -> ([TopDecl])
happyOut25 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut25 #-}
happyIn26 :: ([TopDecl]) -> (HappyAbsSyn t55)
happyIn26 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn26 #-}
happyOut26 :: (HappyAbsSyn t55) -> ([TopDecl])
happyOut26 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut26 #-}
happyIn27 :: (TopDecl) -> (HappyAbsSyn t55)
happyIn27 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn27 #-}
happyOut27 :: (HappyAbsSyn t55) -> (TopDecl)
happyOut27 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut27 #-}
happyIn28 :: (Decl) -> (HappyAbsSyn t55)
happyIn28 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn28 #-}
happyOut28 :: (HappyAbsSyn t55) -> (Decl)
happyOut28 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut28 #-}
happyIn29 :: (Decl) -> (HappyAbsSyn t55)
happyIn29 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn29 #-}
happyOut29 :: (HappyAbsSyn t55) -> (Decl)
happyOut29 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut29 #-}
happyIn30 :: (Newtype) -> (HappyAbsSyn t55)
happyIn30 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn30 #-}
happyOut30 :: (HappyAbsSyn t55) -> (Newtype)
happyOut30 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut30 #-}
happyIn31 :: ([Named Type]) -> (HappyAbsSyn t55)
happyIn31 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn31 #-}
happyOut31 :: (HappyAbsSyn t55) -> ([Named Type])
happyOut31 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut31 #-}
happyIn32 :: ([ LName ]) -> (HappyAbsSyn t55)
happyIn32 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn32 #-}
happyOut32 :: (HappyAbsSyn t55) -> ([ LName ])
happyOut32 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut32 #-}
happyIn33 :: ([Pattern]) -> (HappyAbsSyn t55)
happyIn33 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn33 #-}
happyOut33 :: (HappyAbsSyn t55) -> ([Pattern])
happyOut33 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut33 #-}
happyIn34 :: ([Decl]) -> (HappyAbsSyn t55)
happyIn34 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn34 #-}
happyOut34 :: (HappyAbsSyn t55) -> ([Decl])
happyOut34 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut34 #-}
happyIn35 :: ([Decl]) -> (HappyAbsSyn t55)
happyIn35 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn35 #-}
happyOut35 :: (HappyAbsSyn t55) -> ([Decl])
happyOut35 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut35 #-}
happyIn36 :: ([Decl]) -> (HappyAbsSyn t55)
happyIn36 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn36 #-}
happyOut36 :: (HappyAbsSyn t55) -> ([Decl])
happyOut36 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut36 #-}
happyIn37 :: (ReplInput) -> (HappyAbsSyn t55)
happyIn37 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn37 #-}
happyOut37 :: (HappyAbsSyn t55) -> (ReplInput)
happyOut37 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut37 #-}
happyIn38 :: (Expr) -> (HappyAbsSyn t55)
happyIn38 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn38 #-}
happyOut38 :: (HappyAbsSyn t55) -> (Expr)
happyOut38 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut38 #-}
happyIn39 :: ([(Expr, Expr)]) -> (HappyAbsSyn t55)
happyIn39 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn39 #-}
happyOut39 :: (HappyAbsSyn t55) -> ([(Expr, Expr)])
happyOut39 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut39 #-}
happyIn40 :: ((Expr, Expr)) -> (HappyAbsSyn t55)
happyIn40 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn40 #-}
happyOut40 :: (HappyAbsSyn t55) -> ((Expr, Expr))
happyOut40 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut40 #-}
happyIn41 :: (Expr) -> (HappyAbsSyn t55)
happyIn41 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn41 #-}
happyOut41 :: (HappyAbsSyn t55) -> (Expr)
happyOut41 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut41 #-}
happyIn42 :: ([Expr]) -> (HappyAbsSyn t55)
happyIn42 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn42 #-}
happyOut42 :: (HappyAbsSyn t55) -> ([Expr])
happyOut42 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut42 #-}
happyIn43 :: (Expr) -> (HappyAbsSyn t55)
happyIn43 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn43 #-}
happyOut43 :: (HappyAbsSyn t55) -> (Expr)
happyOut43 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut43 #-}
happyIn44 :: ([(Bool, Integer)]) -> (HappyAbsSyn t55)
happyIn44 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn44 #-}
happyOut44 :: (HappyAbsSyn t55) -> ([(Bool, Integer)])
happyOut44 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut44 #-}
happyIn45 :: ((Bool, Integer)) -> (HappyAbsSyn t55)
happyIn45 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn45 #-}
happyOut45 :: (HappyAbsSyn t55) -> ((Bool, Integer))
happyOut45 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut45 #-}
happyIn46 :: (Located Selector) -> (HappyAbsSyn t55)
happyIn46 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn46 #-}
happyOut46 :: (HappyAbsSyn t55) -> (Located Selector)
happyOut46 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut46 #-}
happyIn47 :: ([Expr]) -> (HappyAbsSyn t55)
happyIn47 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn47 #-}
happyOut47 :: (HappyAbsSyn t55) -> ([Expr])
happyOut47 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut47 #-}
happyIn48 :: (Named Expr) -> (HappyAbsSyn t55)
happyIn48 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn48 #-}
happyOut48 :: (HappyAbsSyn t55) -> (Named Expr)
happyOut48 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut48 #-}
happyIn49 :: ([Named Expr]) -> (HappyAbsSyn t55)
happyIn49 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn49 #-}
happyOut49 :: (HappyAbsSyn t55) -> ([Named Expr])
happyOut49 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut49 #-}
happyIn50 :: (Expr) -> (HappyAbsSyn t55)
happyIn50 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn50 #-}
happyOut50 :: (HappyAbsSyn t55) -> (Expr)
happyOut50 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut50 #-}
happyIn51 :: ([[Match]]) -> (HappyAbsSyn t55)
happyIn51 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn51 #-}
happyOut51 :: (HappyAbsSyn t55) -> ([[Match]])
happyOut51 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut51 #-}
happyIn52 :: ([Match]) -> (HappyAbsSyn t55)
happyIn52 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn52 #-}
happyOut52 :: (HappyAbsSyn t55) -> ([Match])
happyOut52 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut52 #-}
happyIn53 :: (Match) -> (HappyAbsSyn t55)
happyIn53 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn53 #-}
happyOut53 :: (HappyAbsSyn t55) -> (Match)
happyOut53 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut53 #-}
happyIn54 :: (Pattern) -> (HappyAbsSyn t55)
happyIn54 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn54 #-}
happyOut54 :: (HappyAbsSyn t55) -> (Pattern)
happyOut54 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut54 #-}
happyIn55 :: t55 -> (HappyAbsSyn t55)
happyIn55 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn55 #-}
happyOut55 :: (HappyAbsSyn t55) -> t55
happyOut55 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut55 #-}
happyIn56 :: (Pattern) -> (HappyAbsSyn t55)
happyIn56 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn56 #-}
happyOut56 :: (HappyAbsSyn t55) -> (Pattern)
happyOut56 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut56 #-}
happyIn57 :: ([Pattern]) -> (HappyAbsSyn t55)
happyIn57 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn57 #-}
happyOut57 :: (HappyAbsSyn t55) -> ([Pattern])
happyOut57 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut57 #-}
happyIn58 :: (Named Pattern) -> (HappyAbsSyn t55)
happyIn58 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn58 #-}
happyOut58 :: (HappyAbsSyn t55) -> (Named Pattern)
happyOut58 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut58 #-}
happyIn59 :: ([Named Pattern]) -> (HappyAbsSyn t55)
happyIn59 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn59 #-}
happyOut59 :: (HappyAbsSyn t55) -> ([Named Pattern])
happyOut59 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut59 #-}
happyIn60 :: (Schema) -> (HappyAbsSyn t55)
happyIn60 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn60 #-}
happyOut60 :: (HappyAbsSyn t55) -> (Schema)
happyOut60 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut60 #-}
happyIn61 :: (Located [TParam]) -> (HappyAbsSyn t55)
happyIn61 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn61 #-}
happyOut61 :: (HappyAbsSyn t55) -> (Located [TParam])
happyOut61 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut61 #-}
happyIn62 :: (Located [Prop]) -> (HappyAbsSyn t55)
happyIn62 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn62 #-}
happyOut62 :: (HappyAbsSyn t55) -> (Located [Prop])
happyOut62 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut62 #-}
happyIn63 :: (Located Kind) -> (HappyAbsSyn t55)
happyIn63 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn63 #-}
happyOut63 :: (HappyAbsSyn t55) -> (Located Kind)
happyOut63 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut63 #-}
happyIn64 :: (TParam) -> (HappyAbsSyn t55)
happyIn64 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn64 #-}
happyOut64 :: (HappyAbsSyn t55) -> (TParam)
happyOut64 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut64 #-}
happyIn65 :: ([TParam]) -> (HappyAbsSyn t55)
happyIn65 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn65 #-}
happyOut65 :: (HappyAbsSyn t55) -> ([TParam])
happyOut65 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut65 #-}
happyIn66 :: (TParam) -> (HappyAbsSyn t55)
happyIn66 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn66 #-}
happyOut66 :: (HappyAbsSyn t55) -> (TParam)
happyOut66 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut66 #-}
happyIn67 :: ([TParam]) -> (HappyAbsSyn t55)
happyIn67 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn67 #-}
happyOut67 :: (HappyAbsSyn t55) -> ([TParam])
happyOut67 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut67 #-}
happyIn68 :: (Prop) -> (HappyAbsSyn t55)
happyIn68 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn68 #-}
happyOut68 :: (HappyAbsSyn t55) -> (Prop)
happyOut68 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut68 #-}
happyIn69 :: ([Prop]) -> (HappyAbsSyn t55)
happyIn69 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn69 #-}
happyOut69 :: (HappyAbsSyn t55) -> ([Prop])
happyOut69 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut69 #-}
happyIn70 :: (Type) -> (HappyAbsSyn t55)
happyIn70 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn70 #-}
happyOut70 :: (HappyAbsSyn t55) -> (Type)
happyOut70 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut70 #-}
happyIn71 :: (Type) -> (HappyAbsSyn t55)
happyIn71 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn71 #-}
happyOut71 :: (HappyAbsSyn t55) -> (Type)
happyOut71 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut71 #-}
happyIn72 :: (Type) -> (HappyAbsSyn t55)
happyIn72 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn72 #-}
happyOut72 :: (HappyAbsSyn t55) -> (Type)
happyOut72 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut72 #-}
happyIn73 :: ([ Type ]) -> (HappyAbsSyn t55)
happyIn73 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn73 #-}
happyOut73 :: (HappyAbsSyn t55) -> ([ Type ])
happyOut73 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut73 #-}
happyIn74 :: (Located [Type]) -> (HappyAbsSyn t55)
happyIn74 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn74 #-}
happyOut74 :: (HappyAbsSyn t55) -> (Located [Type])
happyOut74 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut74 #-}
happyIn75 :: ([Type]) -> (HappyAbsSyn t55)
happyIn75 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn75 #-}
happyOut75 :: (HappyAbsSyn t55) -> ([Type])
happyOut75 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut75 #-}
happyIn76 :: (Named Type) -> (HappyAbsSyn t55)
happyIn76 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn76 #-}
happyOut76 :: (HappyAbsSyn t55) -> (Named Type)
happyOut76 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut76 #-}
happyIn77 :: ([Named Type]) -> (HappyAbsSyn t55)
happyIn77 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn77 #-}
happyOut77 :: (HappyAbsSyn t55) -> ([Named Type])
happyOut77 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut77 #-}
happyIn78 :: ([LName]) -> (HappyAbsSyn t55)
happyIn78 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn78 #-}
happyOut78 :: (HappyAbsSyn t55) -> ([LName])
happyOut78 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut78 #-}
happyIn79 :: (LName) -> (HappyAbsSyn t55)
happyIn79 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn79 #-}
happyOut79 :: (HappyAbsSyn t55) -> (LName)
happyOut79 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut79 #-}
happyIn80 :: (Located ModName) -> (HappyAbsSyn t55)
happyIn80 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn80 #-}
happyOut80 :: (HappyAbsSyn t55) -> (Located ModName)
happyOut80 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut80 #-}
happyIn81 :: (Located QName) -> (HappyAbsSyn t55)
happyIn81 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn81 #-}
happyOut81 :: (HappyAbsSyn t55) -> (Located QName)
happyOut81 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut81 #-}
happyIn82 :: (Type) -> (HappyAbsSyn t55)
happyIn82 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn82 #-}
happyOut82 :: (HappyAbsSyn t55) -> (Type)
happyOut82 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut82 #-}
happyIn83 :: (Named Type) -> (HappyAbsSyn t55)
happyIn83 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn83 #-}
happyOut83 :: (HappyAbsSyn t55) -> (Named Type)
happyOut83 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut83 #-}
happyIn84 :: ([Named Type]) -> (HappyAbsSyn t55)
happyIn84 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyIn84 #-}
happyOut84 :: (HappyAbsSyn t55) -> ([Named Type])
happyOut84 x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOut84 #-}
happyInTok :: (Located Token) -> (HappyAbsSyn t55)
happyInTok x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyInTok #-}
happyOutTok :: (HappyAbsSyn t55) -> (Located Token)
happyOutTok x = Happy_GHC_Exts.unsafeCoerce# x
{-# INLINE happyOutTok #-}
happyActOffsets :: HappyAddr
happyActOffsets = HappyA# "\xf6\xff\xed\x03\x48\x03\x68\x01\xcd\x04\xcd\x04\x46\x03\x6a\x03\x28\x01\xc9\x02\x08\x05\x68\x03\x08\x05\x2b\x03\x00\x00\x15\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x03\xa3\x02\x2f\x03\x30\x03\xef\x07\x00\x00\x00\x00\x65\x03\x24\x03\x50\x03\x00\x00\x00\x00\x50\x03\x00\x00\x50\x03\x50\x03\x00\x00\x50\x03\x50\x03\x50\x03\x50\x03\x50\x03\x2f\x03\x31\x02\x72\x05\x00\x00\x00\x00\x04\x03\x42\x03\x13\x07\x1f\x05\x1e\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf3\x04\x68\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\xe7\x00\x01\x00\x6a\x05\x0a\x00\x4a\x02\xf3\x04\x68\x01\x68\x01\xef\x02\xef\x02\xf3\x01\x08\x03\xe2\x00\x63\x00\x01\x03\xbc\x04\x08\x05\xb3\x04\x9c\x04\x5f\x05\x00\x00\xdf\x02\x16\x00\xdf\x02\xe7\x01\xdf\x02\xed\x03\x00\x03\x00\x00\x36\x03\xd2\x02\xa3\x03\xec\x02\x80\x00\x00\x00\x5c\x00\x00\x00\x00\x00\x00\x00\x29\x03\x08\x05\xde\x02\x08\x05\x08\x05\x00\x00\x00\x00\xea\x02\x21\x01\x00\x00\x9e\x00\x00\x00\x50\x02\xe2\x02\x00\x00\x3c\x02\xd7\xff\x00\x00\x09\x02\x00\x00\x00\x00\x4e\x01\x33\x01\x00\x00\xff\x04\x87\x04\x00\x00\x68\x01\xe5\x02\x08\x05\x7d\x02\x00\x00\x00\x00\xf2\x00\x00\x00\x00\x00\x00\x00\x76\x04\x00\x00\x00\x00\x00\x00\x2f\x03\x0f\x03\xd6\xff\x00\x00\x00\x00\xa0\x02\x00\x00\x00\x00\x41\x02\x61\x04\x00\x00\xa8\x00\xd3\x01\x00\x00\xe3\x02\xa7\x00\xe0\x02\xdc\x02\xdb\x02\xd9\x02\xd4\x02\xd0\x02\xcf\x02\xc7\x02\xc1\x02\xbc\x02\xb4\x02\xb3\x02\xb1\x02\xaf\x02\xa1\x02\x9d\x02\x9a\x02\x96\x02\x91\x02\x8e\x02\x8d\x02\x77\x02\x74\x02\x6b\x02\x44\x04\x67\x02\x6d\x02\x00\x00\x07\x01\x65\x00\x00\x00\x3d\x02\xf3\x04\xda\x05\x25\x02\x2f\x03\x68\x01\x68\x01\x68\x01\x68\x01\x68\x01\x68\x01\x68\x01\x68\x01\x68\x01\x68\x01\x68\x01\x68\x01\x68\x01\x68\x01\x68\x01\x68\x01\x68\x01\x68\x01\x68\x01\x68\x01\x68\x01\x68\x01\x68\x01\x68\x01\x68\x01\x68\x01\x00\x00\x2a\x02\x00\x00\x16\x02\x0e\x02\x70\x05\x00\x00\xb8\x01\x56\x05\x96\x01\xe9\x02\x08\x02\x5c\x05\x47\x07\x50\x03\x00\x00\x2f\x03\x50\x03\x50\x03\x50\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x50\x03\x08\x05\x00\x00\x2f\x03\x2f\x03\x2f\x03\x2f\x03\x2f\x03\x2f\x03\x2f\x03\x2f\x03\x2f\x03\x2f\x03\x2f\x03\x00\x00\x7a\x08\x2f\x03\xef\x07\x14\x02\xff\x01\x7a\x08\x7a\x08\x7a\x08\x7a\x08\xe2\x01\xe2\x01\xe2\x01\xe2\x01\xc3\x05\xc3\x05\x7a\x08\x41\x07\x00\x00\x00\x00\x00\x00\x50\x03\x00\x00\x01\x07\x00\x00\x88\x01\xe9\x01\x00\x00\x00\x00\xdc\x07\x00\x00\x00\x00\x2f\x03\x00\x00\x2f\x03\xe3\x01\x57\x02\x60\x00\x08\x05\x00\x00\x08\x05\x00\x00\xba\x07\x00\x00\x00\x00\x00\x00\x00\x00\xc0\x07\xc0\x07\xc0\x07\xc0\x07\x9f\x07\x9f\x07\x9f\x07\x9f\x07\x84\x07\x84\x07\x84\x07\x84\x07\x69\x07\x4e\x07\xba\x07\x21\x03\x21\x03\x21\x03\x21\x03\x00\x08\x00\x08\x7a\x08\x00\x00\x00\x00\x00\x00\x50\x04\x68\x01\x68\x01\x68\x01\x68\x01\x00\x00\x68\x01\x68\x01\x00\x00\xf3\x04\x68\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x68\x01\x2a\x04\x68\x01\x08\x05\x00\x00\x19\x02\x00\x00\x19\x00\x08\x08\xf0\x01\xdb\x01\x00\x00\x8e\x01\x00\x00\xe2\x07\x00\x00\x68\x01\x20\x04\x00\x00\x20\x04\x00\x00\x00\x00\x00\x00\xfe\x01\x68\x01\x00\x00\xe3\x04\x00\x00\x08\x05\x2f\x03\x00\x00\xf3\x04\x00\x00\xf3\x04\x00\x00\x2f\x03\xf3\x04\x00\x00\xf3\x04\x08\x05\x00\x00\xd6\x03\xeb\x01\xba\x03\x00\x00\xba\x03\x00\x00\x65\x04\x13\x04\xba\x03\x04\x02\x00\x00\xa3\x03\xa3\x03\x00\x00\x00\x00\x5c\x00\x00\x00\x5c\x00\x69\x00\x08\x05\x5f\x00\x09\x04\x68\x01\x75\x01\xcc\x01\x00\x00\x00\x00\x54\x00\x00\x00\xd3\x03\x00\x00\x00\x00\x00\x00\xa1\x01\x7a\x08\x00\x00\x00\x00\x7a\x08\xa6\x01\x00\x00\x2f\x03\xa0\x01\x00\x00\x00\x00\x13\x07\x00\x00\x08\x05\x00\x00\x2f\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa0\x01\x68\x01\xa0\x01\x5e\x00\x9a\x01\x7d\x01\x00\x00\x7a\x01\x89\x01\x89\x01\x89\x01\x00\x00\x13\x07\x89\x01\x68\x01\x00\x00\x63\x01\x00\x00\x00\x00\x7a\x08\x00\x00\x00\x00\x00\x00\xef\x07\x00\x00\x7a\x08\x7a\x08\x2f\x03\x00\x00\x00\x00\x88\x01\xa3\x03\x5a\x01\xce\xff\x81\x01\x68\x01\xf3\x04\xf3\x04\x68\x01\x00\x00\x81\x01\x7a\x08\x5e\x01\x00\x00\x7a\x08\xce\xff\x00\x00\x00\x00\x00\x00\x39\x04\x4f\x01\x66\x01\x68\x01\x00\x00\x00\x00\x00\x00\x36\x01\x00\x00\x08\x05\x41\x01\x00\x00\x25\x01\x00\x00\x2b\x01\x3e\x01\x12\x01\x00\x00\x26\x01\x00\x00\x00\x00\x00\x00\x43\x01\x00\x00\x00\x00\x08\x05\x00\x00\x00\x00"#
happyGotoOffsets :: HappyAddr
happyGotoOffsets = HappyA# "\x37\x01\xf1\x00\x1b\x01\x23\x06\xab\x02\x5f\x02\x00\x01\xf5\x00\x6f\x05\x38\x08\xd6\x04\x00\x00\x58\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x46\x08\xad\x09\x00\x00\x00\x00\x00\x00\x00\x00\xc1\x09\x00\x00\xa7\x03\x00\x00\x00\x00\xbd\x09\x00\x00\xb9\x09\xb5\x09\x00\x00\xb1\x09\xfb\x06\x35\x05\xd2\x04\x70\x04\xa1\x09\x6f\x08\x7f\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xfa\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3c\x00\xae\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe8\x02\xbf\x04\x59\x00\xb8\x00\x5e\x02\x31\x01\x14\x07\x00\x07\x00\x00\x00\x00\x13\x01\x00\x00\x00\x00\x85\x02\x00\x00\xed\x00\xbb\x00\xce\x01\x6c\x01\xb7\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2a\x05\x00\x00\xab\x00\x00\x00\x00\x00\x00\x00\x00\x00\x8c\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x53\x04\x00\x00\xa5\x00\x7d\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xdf\x01\xdc\xff\x00\x00\x16\x06\x00\x00\x9d\x00\x29\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xdc\xff\x00\x00\x00\x00\x00\x00\x95\x09\x5e\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x92\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf7\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5a\x00\xf0\xff\x00\x00\x89\x09\xf3\x06\xeb\x06\xe7\x06\xe3\x06\xdf\x06\xd7\x06\xca\x06\xb6\x06\xae\x06\xaa\x06\xa1\x06\x9d\x06\x99\x06\x95\x06\x8d\x06\x81\x06\x6c\x06\x64\x06\x60\x06\x58\x06\x54\x06\x50\x06\x4c\x06\x43\x06\x37\x06\x1a\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x8d\x08\x00\x00\xb7\x02\x00\x00\xea\x03\x00\x00\x7d\x09\xc5\x03\xb7\x03\x52\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x31\x03\x9b\x00\x00\x00\x71\x09\x65\x09\x59\x09\x4d\x09\x41\x09\x35\x09\x29\x09\x1d\x09\x11\x09\x05\x09\xf9\x08\x00\x00\x00\x00\xed\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1c\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe1\x08\x00\x00\xd5\x08\x00\x00\x7b\x08\x52\x08\xfb\x00\x00\x00\x74\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xdc\xff\x0e\x06\x9f\x02\x68\x04\x08\x06\x00\x00\x02\x06\xf9\x05\x00\x00\x22\x03\xec\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd8\x05\xdc\xff\xcf\x05\x22\x00\x00\x00\x00\x00\x00\x00\xa1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x39\x02\x0d\x02\x00\x00\x72\x01\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x05\x00\x00\x7d\x00\x00\x00\x7a\x00\xc9\x08\x00\x00\xfd\x02\x00\x00\x6c\x02\x00\x00\xbd\x08\x38\x01\x00\x00\x07\x02\x4e\x00\x00\x00\x2c\x01\x04\x00\x4d\x05\x00\x00\x3f\x05\x00\x00\xcf\x01\xf4\xff\xa5\x03\x8e\x00\x00\x00\xfc\x01\x75\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x97\x00\xdf\x03\x00\x00\xdc\xff\xbc\x05\x7d\x00\x79\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb1\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xfd\xff\x00\x00\xa5\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb6\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa5\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x99\x08\x00\x00\x00\x00\x00\x00\x77\x03\x00\x00\x3f\x00\x00\x00\xae\x04\x82\x01\x51\x07\x87\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0f\x00\x00\x00\x00\x00\x00\x00\x86\x02\x07\x00\x00\x00\xd9\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc0\xff\x00\x00\x00\x00"#
happyDefActions :: HappyAddr
happyDefActions = HappyA# "\x00\x00\xdf\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xdf\xfe\xe6\xfe\x00\x00\xe4\xfe\xe1\xfe\xe0\xfe\xe2\xfe\xe3\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x26\xff\x04\xff\xfc\xfe\x00\x00\xde\xfe\xfb\xfe\xf8\xfe\xf7\xfe\x00\x00\xfa\xfe\x00\x00\x00\x00\xf9\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf0\xfe\xb8\xff\x00\x00\xb9\xff\xb7\xff\xaf\xff\x8f\xff\x8d\xff\x85\xff\x84\xff\x83\xff\x82\xff\x81\xff\x80\xff\x8a\xff\x00\x00\x00\x00\x8c\xff\x8b\xff\x89\xff\x88\xff\x7f\xff\x87\xff\x86\xff\x7e\xff\x7d\xff\x7b\xff\x7c\xff\x7a\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\xc4\xff\x00\x00\x00\x00\x00\x00\x00\x00\x34\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe0\xff\x00\x00\xd1\xff\x00\x00\x00\x00\xee\xff\x00\x00\xf0\xff\xeb\xff\xef\xff\xda\xff\xd7\xff\xd2\xff\x00\x00\x00\x00\xe2\xfe\x00\x00\x00\x00\xd0\xff\xdc\xff\x00\x00\x00\x00\xdd\xff\x00\x00\x28\xff\x00\x00\x00\x00\x2d\xff\x00\x00\x38\xff\x36\xff\x00\x00\x35\xff\x33\xff\x00\x00\x00\x00\x30\xff\x00\x00\x00\x00\xc2\xff\x00\x00\x00\x00\x00\x00\x00\x00\xc0\xff\xbe\xff\x00\x00\xba\xff\x90\xff\x91\xff\x00\x00\xdd\xfe\x72\xff\xdc\xfe\x00\x00\x00\x00\x00\x00\x54\xff\x52\xff\x51\xff\x56\xff\x49\xff\x00\x00\x00\x00\x76\xff\x00\x00\x00\x00\x77\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\x46\xff\x45\xff\x00\x00\x74\xff\x00\x00\x00\x00\xb2\xff\x00\x00\x35\xff\x00\x00\x8e\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\x19\xff\x00\x00\xe8\xfe\x00\x00\x1b\xff\x22\xff\x0d\xff\x00\x00\x00\x00\x00\x00\x00\x00\xf4\xfe\x00\x00\x00\x00\x00\x00\xfb\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x03\xff\x10\xff\x0e\xff\x0f\xff\xef\xfe\xfd\xfe\x00\x00\xfe\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1f\xff\x24\xff\x00\x00\x25\xff\x00\x00\x00\x00\x23\xff\x11\xff\x12\xff\x13\xff\x06\xff\x05\xff\x07\xff\x08\xff\x09\xff\x0a\xff\x0b\xff\x00\x00\xe5\xfe\xee\xfe\x02\xff\x00\x00\x00\xff\x00\x00\xff\xfe\xed\xfe\x00\x00\xf2\xfe\x20\xff\x00\x00\xf4\xfe\xf3\xfe\x00\x00\xf5\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf1\xfe\x00\x00\x21\xff\xa7\xff\xa8\xff\xa9\xff\xaa\xff\xab\xff\x93\xff\x92\xff\x95\xff\x94\xff\x96\xff\x97\xff\x98\xff\x99\xff\x9b\xff\x9a\xff\x9d\xff\x9c\xff\x9e\xff\x9f\xff\xa0\xff\xa2\xff\xa1\xff\xa3\xff\xa4\xff\xa5\xff\xa6\xff\xae\xff\x71\xff\x4f\xff\x4e\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x73\xff\x00\x00\x44\xff\x40\xff\x00\x00\x00\x00\x6c\xff\x6d\xff\x6e\xff\x6f\xff\x70\xff\x58\xff\x57\xff\x5a\xff\x59\xff\x5b\xff\x5c\xff\x5d\xff\x5e\xff\x60\xff\x5f\xff\x62\xff\x61\xff\x63\xff\x64\xff\x65\xff\x67\xff\x66\xff\x68\xff\x69\xff\x6a\xff\x6b\xff\x78\xff\x79\xff\x00\x00\x00\x00\x00\x00\x00\x00\x75\xff\x00\x00\x55\xff\x00\x00\x00\x00\x00\x00\xe6\xfe\xd5\xfe\x00\x00\xda\xfe\x00\x00\xc1\xff\x00\x00\x00\x00\xbb\xff\x00\x00\xcf\xff\xc3\xff\xbf\xff\xce\xff\x00\x00\x15\xff\x00\x00\x17\xff\x00\x00\x00\x00\x2e\xff\x00\x00\x2f\xff\x00\x00\x31\xff\x00\x00\x00\x00\x32\xff\x00\x00\x00\x00\x2c\xff\x00\x00\x00\x00\x00\x00\xde\xff\x00\x00\xdb\xff\x00\x00\x00\x00\x00\x00\xe8\xff\xd5\xff\x00\x00\x00\x00\xf3\xff\xed\xff\xf2\xff\xec\xff\xf1\xff\xe1\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd9\xff\xd8\xff\x00\x00\xb4\xff\x00\x00\xb6\xff\x27\xff\x29\xff\x37\xff\x39\xff\x2b\xff\x2a\xff\xcc\xff\x00\x00\x14\xff\x00\x00\xcd\xff\xbd\xff\xbc\xff\xac\xff\xdb\xfe\x00\x00\xd9\xfe\x00\x00\xd7\xfe\xd8\xfe\x53\xff\x50\xff\x48\xff\x4b\xff\x00\x00\x4d\xff\x4d\xff\x47\xff\x3e\xff\x3c\xff\x00\x00\x43\xff\x4c\xff\xb0\xff\xb1\xff\xad\xff\xca\xff\x00\x00\x18\xff\x1b\xff\xe7\xfe\x1a\xff\xe9\xfe\x1c\xff\x1d\xff\x0c\xff\x00\x00\x1e\xff\xeb\xfe\xea\xfe\x00\x00\xf6\xfe\x01\xff\xec\xfe\xee\xff\x00\x00\x00\x00\xc9\xff\x00\x00\x00\x00\x00\x00\x42\xff\x3f\xff\x4a\xff\xd6\xfe\x00\x00\xd4\xfe\xcb\xff\x00\x00\xb5\xff\xb3\xff\xc8\xff\x00\x00\x00\x00\xd3\xff\x00\x00\xd6\xff\xe9\xff\xea\xff\x00\x00\xe2\xff\xe3\xff\xd4\xff\xc7\xff\x00\x00\xc6\xff\x00\x00\x41\xff\x3d\xff\x3b\xff\x3a\xff\xf4\xff\x16\xff\xc5\xff\x00\x00\xe4\xff\xe7\xff\x00\x00\xe5\xff"#
happyCheck :: HappyAddr
happyCheck = HappyA# "\xff\xff\x41\x00\x01\x00\x02\x00\x03\x00\x04\x00\x2a\x00\x13\x00\x07\x00\x08\x00\x09\x00\x01\x00\x0b\x00\x0c\x00\x18\x00\x39\x00\x20\x00\x10\x00\x0e\x00\x3c\x00\x13\x00\x47\x00\x12\x00\x1d\x00\x11\x00\x15\x00\x01\x00\x45\x00\x1b\x00\x41\x00\x2a\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\x5f\x00\x2a\x00\x19\x00\x26\x00\x41\x00\x31\x00\x32\x00\x06\x00\x41\x00\x5f\x00\x36\x00\x42\x00\x38\x00\x40\x00\x41\x00\x3b\x00\x43\x00\x41\x00\x26\x00\x31\x00\x40\x00\x45\x00\x39\x00\x22\x00\x41\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\x01\x00\x02\x00\x41\x00\x04\x00\x02\x00\x2a\x00\x07\x00\x08\x00\x09\x00\x07\x00\x08\x00\x09\x00\x13\x00\x0e\x00\x41\x00\x31\x00\x08\x00\x12\x00\x13\x00\x14\x00\x15\x00\x60\x00\x19\x00\x03\x00\x16\x00\x2c\x00\x22\x00\x23\x00\x41\x00\x1e\x00\x1f\x00\x0b\x00\x0c\x00\x1d\x00\x0e\x00\x2a\x00\x10\x00\x26\x00\x12\x00\x34\x00\x26\x00\x11\x00\x2b\x00\x2e\x00\x2f\x00\x2b\x00\x41\x00\x34\x00\x31\x00\x04\x00\x34\x00\x31\x00\x30\x00\x36\x00\x43\x00\x44\x00\x36\x00\x41\x00\x41\x00\x05\x00\x34\x00\x07\x00\x2a\x00\x44\x00\x41\x00\x43\x00\x44\x00\x41\x00\x13\x00\x32\x00\x47\x00\x01\x00\x02\x00\x03\x00\x04\x00\x43\x00\x44\x00\x07\x00\x08\x00\x09\x00\x34\x00\x0b\x00\x0c\x00\x34\x00\x41\x00\x41\x00\x10\x00\x0d\x00\x0e\x00\x13\x00\x41\x00\x2a\x00\x12\x00\x41\x00\x5f\x00\x1f\x00\x19\x00\x1b\x00\x60\x00\x44\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\x41\x00\x36\x00\x2a\x00\x1e\x00\x1f\x00\x31\x00\x32\x00\x32\x00\x33\x00\x41\x00\x36\x00\x41\x00\x38\x00\x42\x00\x0e\x00\x3b\x00\x2c\x00\x2d\x00\x12\x00\x41\x00\x40\x00\x01\x00\x02\x00\x03\x00\x04\x00\x41\x00\x46\x00\x07\x00\x08\x00\x09\x00\x18\x00\x0b\x00\x0c\x00\x1b\x00\x1c\x00\x1d\x00\x10\x00\x41\x00\x08\x00\x13\x00\x0a\x00\x41\x00\x2a\x00\x0d\x00\x0e\x00\x13\x00\x5a\x00\x1b\x00\x12\x00\x0f\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\x41\x00\x33\x00\x16\x00\x2a\x00\x31\x00\x40\x00\x41\x00\x2a\x00\x43\x00\x36\x00\x3c\x00\x38\x00\x19\x00\x0e\x00\x3b\x00\x1c\x00\x09\x00\x12\x00\x34\x00\x40\x00\x15\x00\x01\x00\x02\x00\x03\x00\x04\x00\x46\x00\x41\x00\x07\x00\x08\x00\x09\x00\x41\x00\x0b\x00\x0c\x00\x43\x00\x44\x00\x00\x00\x10\x00\x3e\x00\x0e\x00\x13\x00\x41\x00\x2a\x00\x12\x00\x19\x00\x14\x00\x5a\x00\x1a\x00\x1b\x00\x13\x00\x33\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\x41\x00\x34\x00\x2a\x00\x19\x00\x33\x00\x31\x00\x19\x00\x2a\x00\x37\x00\x32\x00\x36\x00\x2c\x00\x38\x00\x29\x00\x2a\x00\x3b\x00\x43\x00\x44\x00\x33\x00\x31\x00\x40\x00\x01\x00\x02\x00\x03\x00\x04\x00\x41\x00\x46\x00\x07\x00\x08\x00\x09\x00\x41\x00\x0b\x00\x0c\x00\x32\x00\x33\x00\x02\x00\x10\x00\x41\x00\x2c\x00\x13\x00\x07\x00\x08\x00\x09\x00\x19\x00\x0e\x00\x33\x00\x5a\x00\x1b\x00\x12\x00\x36\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\x28\x00\x29\x00\x2a\x00\x2b\x00\x3a\x00\x31\x00\x19\x00\x26\x00\x2a\x00\x43\x00\x36\x00\x3c\x00\x38\x00\x19\x00\x19\x00\x3b\x00\x1c\x00\x1d\x00\x31\x00\x2d\x00\x40\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x41\x00\x46\x00\x3a\x00\x33\x00\x32\x00\x33\x00\x41\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x19\x00\x32\x00\x33\x00\x34\x00\x3e\x00\x3f\x00\x37\x00\x41\x00\x33\x00\x5a\x00\x41\x00\x3c\x00\x37\x00\x3e\x00\x3f\x00\x32\x00\x33\x00\x30\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\x3c\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x02\x00\x32\x00\x33\x00\x05\x00\x02\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x07\x00\x08\x00\x09\x00\x02\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x07\x00\x08\x00\x09\x00\x16\x00\x17\x00\x03\x00\x5f\x00\x16\x00\x36\x00\x34\x00\x35\x00\x32\x00\x33\x00\x0b\x00\x0c\x00\x16\x00\x0e\x00\x07\x00\x10\x00\x26\x00\x12\x00\x41\x00\x41\x00\x26\x00\x2b\x00\x34\x00\x35\x00\x3a\x00\x2b\x00\x19\x00\x31\x00\x26\x00\x01\x00\x0e\x00\x31\x00\x36\x00\x2b\x00\x12\x00\x41\x00\x36\x00\x3f\x00\x33\x00\x31\x00\x3c\x00\x2a\x00\x37\x00\x41\x00\x36\x00\x43\x00\x49\x00\x41\x00\x19\x00\x43\x00\x28\x00\x29\x00\x2a\x00\x01\x00\x02\x00\x41\x00\x04\x00\x43\x00\x2a\x00\x07\x00\x08\x00\x09\x00\x32\x00\x33\x00\x41\x00\x0d\x00\x0e\x00\x0f\x00\x42\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x3f\x00\x41\x00\x33\x00\x3c\x00\x01\x00\x02\x00\x37\x00\x41\x00\x1e\x00\x1f\x00\x07\x00\x08\x00\x09\x00\x1b\x00\x1c\x00\x1d\x00\x26\x00\x01\x00\x02\x00\x35\x00\x04\x00\x2b\x00\x33\x00\x07\x00\x08\x00\x09\x00\x37\x00\x31\x00\x32\x00\x0d\x00\x0e\x00\x0f\x00\x36\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x0e\x00\x32\x00\x33\x00\x26\x00\x12\x00\x41\x00\x14\x00\x33\x00\x1e\x00\x1f\x00\x3a\x00\x37\x00\x40\x00\x41\x00\x31\x00\x43\x00\x26\x00\x01\x00\x02\x00\x36\x00\x04\x00\x2b\x00\x33\x00\x07\x00\x08\x00\x09\x00\x37\x00\x31\x00\x2a\x00\x0d\x00\x0e\x00\x0f\x00\x36\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x0e\x00\x28\x00\x29\x00\x2a\x00\x12\x00\x41\x00\x2c\x00\x33\x00\x1e\x00\x1f\x00\x32\x00\x40\x00\x41\x00\x41\x00\x43\x00\x44\x00\x26\x00\x01\x00\x02\x00\x32\x00\x04\x00\x2b\x00\x32\x00\x07\x00\x08\x00\x09\x00\x41\x00\x31\x00\x2a\x00\x0d\x00\x0e\x00\x0f\x00\x36\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x0e\x00\x1b\x00\x1c\x00\x1d\x00\x12\x00\x41\x00\x32\x00\x32\x00\x1e\x00\x1f\x00\x32\x00\x3e\x00\x3f\x00\x41\x00\x41\x00\x32\x00\x26\x00\x01\x00\x02\x00\x32\x00\x04\x00\x2b\x00\x32\x00\x07\x00\x08\x00\x09\x00\x32\x00\x31\x00\x2a\x00\x0d\x00\x0e\x00\x0f\x00\x36\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x40\x00\x41\x00\x32\x00\x43\x00\x32\x00\x41\x00\x32\x00\x32\x00\x1e\x00\x1f\x00\x49\x00\x01\x00\x02\x00\x41\x00\x04\x00\x32\x00\x26\x00\x07\x00\x08\x00\x09\x00\x32\x00\x2b\x00\x3e\x00\x3f\x00\x0e\x00\x41\x00\x32\x00\x31\x00\x12\x00\x13\x00\x14\x00\x15\x00\x36\x00\x18\x00\x32\x00\x32\x00\x1b\x00\x1c\x00\x1d\x00\x32\x00\x1e\x00\x1f\x00\x21\x00\x41\x00\x32\x00\x24\x00\x32\x00\x32\x00\x26\x00\x01\x00\x02\x00\x32\x00\x04\x00\x2b\x00\x32\x00\x07\x00\x08\x00\x09\x00\x34\x00\x31\x00\x32\x00\x3a\x00\x0e\x00\x34\x00\x36\x00\x42\x00\x12\x00\x13\x00\x14\x00\x15\x00\x28\x00\x29\x00\x2a\x00\x40\x00\x41\x00\x41\x00\x43\x00\x03\x00\x1e\x00\x1f\x00\x43\x00\x01\x00\x02\x00\x60\x00\x04\x00\x34\x00\x26\x00\x07\x00\x08\x00\x09\x00\x03\x00\x2b\x00\x3a\x00\x34\x00\x0e\x00\x41\x00\x60\x00\x31\x00\x12\x00\x13\x00\x14\x00\x15\x00\x36\x00\x37\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x1e\x00\x1f\x00\x60\x00\x41\x00\x01\x00\x02\x00\x35\x00\x04\x00\x26\x00\x3a\x00\x07\x00\x08\x00\x09\x00\x2b\x00\x19\x00\x40\x00\x41\x00\x0e\x00\x43\x00\x31\x00\x3d\x00\x12\x00\x41\x00\x60\x00\x36\x00\x01\x00\x02\x00\x3d\x00\x04\x00\x49\x00\x3a\x00\x07\x00\x08\x00\x09\x00\x3f\x00\x41\x00\x40\x00\x41\x00\x0e\x00\x43\x00\x60\x00\x26\x00\x12\x00\x01\x00\x02\x00\x03\x00\x2b\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x18\x00\x31\x00\x0b\x00\x0c\x00\x1a\x00\x0e\x00\x36\x00\x10\x00\x42\x00\x12\x00\x42\x00\x26\x00\x3a\x00\x01\x00\x02\x00\x03\x00\x2b\x00\x41\x00\x40\x00\x41\x00\xff\xff\x43\x00\x31\x00\x0b\x00\x0c\x00\xff\xff\x0e\x00\x36\x00\x10\x00\xff\xff\x12\x00\x18\x00\xff\xff\x2a\x00\x1b\x00\x1c\x00\x1d\x00\x02\x00\x41\x00\xff\xff\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\xff\xff\xff\xff\x0b\x00\x0c\x00\xff\xff\x0e\x00\xff\xff\x10\x00\x2a\x00\x12\x00\x41\x00\x16\x00\x17\x00\xff\xff\x02\x00\x40\x00\x41\x00\x05\x00\x43\x00\x07\x00\x08\x00\x09\x00\x0a\x00\xff\xff\xff\xff\x40\x00\x41\x00\x26\x00\x43\x00\xff\xff\xff\xff\x41\x00\x2b\x00\x2a\x00\x16\x00\x17\x00\xff\xff\xff\xff\x31\x00\x02\x00\xff\xff\xff\xff\x02\x00\x36\x00\x07\x00\x08\x00\x09\x00\x07\x00\x08\x00\x09\x00\x26\x00\x3a\x00\x3b\x00\xff\xff\x41\x00\x2b\x00\x41\x00\x40\x00\x41\x00\x16\x00\x43\x00\x31\x00\x16\x00\xff\xff\xff\xff\x02\x00\x36\x00\x3a\x00\x05\x00\xff\xff\x07\x00\x08\x00\x09\x00\x40\x00\x41\x00\x26\x00\x43\x00\x41\x00\x26\x00\xff\xff\x2b\x00\x3a\x00\xff\xff\x2b\x00\xff\xff\x16\x00\x31\x00\x40\x00\x41\x00\x31\x00\x43\x00\x36\x00\x37\x00\x02\x00\x36\x00\x37\x00\xff\xff\xff\xff\x07\x00\x08\x00\x09\x00\x26\x00\x41\x00\x02\x00\xff\xff\x41\x00\x2b\x00\xff\xff\x07\x00\x08\x00\x09\x00\xff\xff\x31\x00\x40\x00\x41\x00\x42\x00\x02\x00\x36\x00\x3a\x00\xff\xff\xff\xff\x07\x00\x08\x00\x09\x00\x40\x00\x41\x00\x02\x00\x43\x00\x41\x00\x26\x00\xff\xff\x07\x00\x08\x00\x09\x00\x2b\x00\xff\xff\x16\x00\xff\xff\xff\xff\x26\x00\x31\x00\x02\x00\xff\xff\xff\xff\x2b\x00\x36\x00\x07\x00\x08\x00\x09\x00\x3a\x00\x31\x00\xff\xff\x26\x00\xff\xff\xff\xff\x36\x00\x41\x00\x2b\x00\xff\xff\x3a\x00\xff\xff\xff\xff\x26\x00\x31\x00\x02\x00\xff\xff\x41\x00\x2b\x00\x36\x00\x07\x00\x08\x00\x09\x00\xff\xff\x31\x00\xff\xff\x19\x00\xff\xff\x26\x00\x36\x00\x41\x00\xff\xff\x02\x00\x3a\x00\xff\xff\xff\xff\x02\x00\x07\x00\x08\x00\x09\x00\x41\x00\x07\x00\x08\x00\x09\x00\xff\xff\x37\x00\xff\xff\x2e\x00\x2f\x00\x30\x00\xff\xff\x26\x00\x33\x00\x02\x00\xff\xff\xff\xff\x2b\x00\xff\xff\x07\x00\x08\x00\x09\x00\x18\x00\x31\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x36\x00\x26\x00\xff\xff\x02\x00\x3a\x00\x26\x00\x2b\x00\xff\xff\x07\x00\x08\x00\x09\x00\x41\x00\x31\x00\x40\x00\x41\x00\x42\x00\x31\x00\x36\x00\x40\x00\x41\x00\x42\x00\x3a\x00\x26\x00\xff\xff\x02\x00\x3a\x00\xff\xff\x2b\x00\x41\x00\x07\x00\x08\x00\x09\x00\xff\xff\x31\x00\x40\x00\x41\x00\x3a\x00\x43\x00\x36\x00\x26\x00\xff\xff\xff\xff\x40\x00\x41\x00\x2b\x00\x43\x00\x3e\x00\x02\x00\xff\xff\x41\x00\x31\x00\xff\xff\x07\x00\x08\x00\x09\x00\x36\x00\x02\x00\xff\xff\xff\xff\x3a\x00\x26\x00\x07\x00\x08\x00\x09\x00\x18\x00\x2b\x00\x41\x00\x1b\x00\x1c\x00\x1d\x00\xff\xff\x31\x00\x32\x00\x02\x00\xff\xff\xff\xff\x36\x00\xff\xff\x07\x00\x08\x00\x09\x00\x18\x00\xff\xff\x26\x00\x1b\x00\x1c\x00\x1d\x00\x41\x00\x2b\x00\x2c\x00\x21\x00\xff\xff\x26\x00\x16\x00\x31\x00\x02\x00\xff\xff\x2b\x00\xff\xff\x36\x00\x07\x00\x08\x00\x09\x00\x31\x00\x40\x00\x41\x00\xff\xff\x43\x00\x36\x00\x26\x00\x41\x00\x02\x00\x3a\x00\xff\xff\x2b\x00\xff\xff\x07\x00\x08\x00\x09\x00\x41\x00\x31\x00\x40\x00\x41\x00\x02\x00\x43\x00\x36\x00\xff\xff\xff\xff\x07\x00\x08\x00\x09\x00\x26\x00\x02\x00\xff\xff\x3a\x00\xff\xff\x41\x00\x07\x00\x08\x00\x09\x00\x40\x00\x41\x00\x31\x00\x43\x00\x40\x00\x41\x00\x42\x00\x26\x00\xff\xff\xff\xff\xff\xff\x3a\x00\x2b\x00\xff\xff\x01\x00\x02\x00\x03\x00\x04\x00\x31\x00\x26\x00\x07\x00\x08\x00\x09\x00\x36\x00\x0b\x00\x0c\x00\xff\xff\xff\xff\x26\x00\x10\x00\x31\x00\xff\xff\x13\x00\xff\xff\x41\x00\x0b\x00\x0c\x00\xff\xff\x0e\x00\x3a\x00\x10\x00\xff\xff\x12\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\x0c\x00\xff\xff\x0e\x00\xff\xff\x10\x00\x31\x00\x12\x00\xff\xff\xff\xff\x2a\x00\x36\x00\xff\xff\x38\x00\xff\xff\x0c\x00\x3b\x00\x0e\x00\xff\xff\x10\x00\x02\x00\x12\x00\xff\xff\x02\x00\xff\xff\x07\x00\x08\x00\x09\x00\x07\x00\x08\x00\x09\x00\x2a\x00\xff\xff\x41\x00\x02\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x07\x00\x08\x00\x09\x00\x02\x00\x40\x00\x41\x00\x2a\x00\x43\x00\x07\x00\x08\x00\x09\x00\xff\xff\xff\xff\x0f\x00\xff\xff\x41\x00\xff\xff\x26\x00\xff\xff\xff\xff\x26\x00\x17\x00\x18\x00\x32\x00\x33\x00\x1b\x00\x1c\x00\x1d\x00\xff\xff\x41\x00\xff\xff\x26\x00\xff\xff\xff\xff\x37\x00\x3e\x00\xff\xff\x37\x00\xff\xff\x26\x00\xff\xff\xff\xff\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x37\x00\xff\xff\xff\xff\x34\x00\x4f\x00\xff\xff\xff\xff\xff\xff\x37\x00\x54\x00\x55\x00\xff\xff\xff\xff\x3e\x00\x40\x00\x41\x00\xff\xff\x43\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\xff\xff\xff\xff\x18\x00\xff\xff\x4f\x00\x1b\x00\x1c\x00\x1d\x00\xff\xff\x54\x00\x55\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\xff\xff\xff\xff\x18\x00\xff\xff\x60\x00\x1b\x00\x1c\x00\x1d\x00\x18\x00\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x18\x00\x01\x00\x02\x00\x1b\x00\x1c\x00\x1d\x00\xff\xff\x07\x00\x08\x00\x09\x00\xff\xff\x40\x00\x41\x00\x18\x00\x43\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\xff\xff\x40\x00\x41\x00\x18\x00\x43\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x40\x00\x41\x00\xff\xff\x43\x00\xff\xff\xff\xff\x40\x00\x41\x00\xff\xff\x43\x00\x26\x00\xff\xff\x40\x00\x41\x00\x18\x00\x43\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x47\x00\x48\x00\x49\x00\x4a\x00\xff\xff\x40\x00\x41\x00\x18\x00\x43\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\xff\xff\x40\x00\x41\x00\x18\x00\x43\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x18\x00\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x18\x00\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x40\x00\x41\x00\x18\x00\x43\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\xff\xff\x40\x00\x41\x00\x18\x00\x43\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\xff\xff\x40\x00\x41\x00\xff\xff\x43\x00\xff\xff\xff\xff\x40\x00\x41\x00\xff\xff\x43\x00\xff\xff\xff\xff\x40\x00\x41\x00\xff\xff\x43\x00\x1b\x00\x1c\x00\x1d\x00\xff\xff\x40\x00\x41\x00\xff\xff\x43\x00\x40\x00\x41\x00\xff\xff\x43\x00\x1b\x00\x1c\x00\x1d\x00\xff\xff\xff\xff\x40\x00\x41\x00\xff\xff\x43\x00\x1b\x00\x1c\x00\x1d\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\xff\xff\x40\x00\x41\x00\xff\xff\x43\x00\x1b\x00\x1c\x00\x1d\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\xff\xff\x40\x00\x41\x00\xff\xff\x43\x00\x1b\x00\x1c\x00\x1d\x00\xff\xff\xff\xff\x40\x00\x41\x00\xff\xff\x43\x00\x40\x00\x41\x00\xff\xff\x43\x00\x40\x00\x41\x00\xff\xff\x43\x00\x40\x00\x41\x00\xff\xff\x43\x00\x1b\x00\x1c\x00\x1d\x00\xff\xff\x40\x00\x41\x00\xff\xff\x43\x00\x40\x00\x41\x00\xff\xff\x43\x00\x1b\x00\x1c\x00\x1d\x00\xff\xff\x40\x00\x41\x00\xff\xff\x43\x00\x1b\x00\x1c\x00\x1d\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\xff\xff\xff\xff\x40\x00\x41\x00\xff\xff\x43\x00\x1b\x00\x1c\x00\x1d\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\xff\xff\x40\x00\x41\x00\xff\xff\x43\x00\x1b\x00\x1c\x00\x1d\x00\xff\xff\x40\x00\x41\x00\xff\xff\x43\x00\x40\x00\x41\x00\xff\xff\x43\x00\x40\x00\x41\x00\xff\xff\x43\x00\x40\x00\x41\x00\xff\xff\x43\x00\x1b\x00\x1c\x00\x1d\x00\xff\xff\xff\xff\x40\x00\x41\x00\xff\xff\x43\x00\x40\x00\x41\x00\xff\xff\x43\x00\x1b\x00\x1c\x00\x1d\x00\xff\xff\x40\x00\x41\x00\xff\xff\x43\x00\x1b\x00\x1c\x00\x1d\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\xff\xff\x40\x00\x41\x00\xff\xff\x43\x00\x1b\x00\x1c\x00\x1d\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\xff\xff\xff\xff\x40\x00\x41\x00\xff\xff\x43\x00\x1b\x00\x1c\x00\x1d\x00\xff\xff\x40\x00\x41\x00\xff\xff\x43\x00\x40\x00\x41\x00\xff\xff\x43\x00\x40\x00\x41\x00\xff\xff\x43\x00\x40\x00\x41\x00\x2c\x00\x43\x00\x1b\x00\x1c\x00\x1d\x00\xff\xff\x40\x00\x41\x00\x3a\x00\x43\x00\x40\x00\x41\x00\xff\xff\x43\x00\x40\x00\x41\x00\xff\xff\x43\x00\x3e\x00\x40\x00\x41\x00\xff\xff\x43\x00\xff\xff\xff\xff\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\xff\xff\xff\xff\xff\xff\x3c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x40\x00\x41\x00\xff\xff\x43\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\x2c\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x2c\x00\xff\xff\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\xff\xff\xff\xff\xff\xff\x3e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3e\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x41\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\xff\xff\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\xff\xff\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\xff\xff\xff\xff\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\xff\xff\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\xff\xff\xff\xff\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\xff\xff\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\xff\xff\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\xff\xff\xff\xff\xff\xff\x32\x00\x33\x00\x56\x00\x57\x00\x58\x00\x59\x00\x32\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x3e\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\xff\xff\x3e\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x3e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\xff\xff\x33\x00\xff\xff\xff\xff\x4f\x00\x37\x00\xff\xff\xff\xff\xff\xff\x54\x00\x55\x00\xff\xff\x3e\x00\x47\x00\x48\x00\x49\x00\x4a\x00\xff\xff\xff\xff\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\x2f\x00\x30\x00\xff\xff\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x36\x00\xff\xff\x38\x00\x39\x00\x3a\x00\xff\xff\x3c\x00\x2e\x00\x2f\x00\x30\x00\x40\x00\x41\x00\xff\xff\x43\x00\xff\xff\x36\x00\xff\xff\x38\x00\x39\x00\x3a\x00\xff\xff\x3c\x00\xff\xff\x30\x00\xff\xff\x40\x00\x41\x00\xff\xff\x43\x00\x36\x00\xff\xff\x38\x00\x39\x00\x3a\x00\xff\xff\x3c\x00\x31\x00\xff\xff\xff\xff\x40\x00\x41\x00\xff\xff\x43\x00\x38\x00\x39\x00\x3a\x00\xff\xff\x3c\x00\xff\xff\xff\xff\xff\xff\x40\x00\x41\x00\xff\xff\x43\x00\x38\x00\x39\x00\x3a\x00\xff\xff\x3c\x00\x3d\x00\xff\xff\xff\xff\x40\x00\x41\x00\xff\xff\x43\x00\xff\xff\x45\x00\x46\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\xff\xff\x3c\x00\x3d\x00\xff\xff\xff\xff\x40\x00\x41\x00\x36\x00\x43\x00\x38\x00\x39\x00\x3a\x00\xff\xff\x3c\x00\x3e\x00\xff\xff\xff\xff\x40\x00\x41\x00\xff\xff\x43\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x38\x00\x39\x00\x3a\x00\xff\xff\x3c\x00\x3d\x00\xff\xff\xff\xff\x40\x00\x41\x00\xff\xff\x43\x00\x38\x00\x39\x00\x3a\x00\xff\xff\x3c\x00\xff\xff\xff\xff\xff\xff\x40\x00\x41\x00\xff\xff\x43\x00\x38\x00\x39\x00\x3a\x00\xff\xff\x3c\x00\xff\xff\xff\xff\xff\xff\x40\x00\x41\x00\xff\xff\x43\x00\x38\x00\x39\x00\x3a\x00\xff\xff\x3c\x00\xff\xff\xff\xff\xff\xff\x40\x00\x41\x00\xff\xff\x43\x00\x38\x00\x39\x00\x3a\x00\xff\xff\x3c\x00\xff\xff\xff\xff\xff\xff\x40\x00\x41\x00\xff\xff\x43\x00\x38\x00\x39\x00\x3a\x00\xff\xff\x3c\x00\xff\xff\xff\xff\xff\xff\x40\x00\x41\x00\xff\xff\x43\x00\x38\x00\x39\x00\x3a\x00\xff\xff\x3c\x00\xff\xff\xff\xff\xff\xff\x40\x00\x41\x00\xff\xff\x43\x00\x38\x00\x39\x00\x3a\x00\xff\xff\x3c\x00\xff\xff\xff\xff\xff\xff\x40\x00\x41\x00\xff\xff\x43\x00\x38\x00\x39\x00\x3a\x00\xff\xff\x3c\x00\xff\xff\xff\xff\xff\xff\x40\x00\x41\x00\xff\xff\x43\x00\x38\x00\x39\x00\x3a\x00\xff\xff\x3c\x00\xff\xff\xff\xff\xff\xff\x40\x00\x41\x00\xff\xff\x43\x00\x38\x00\x39\x00\x3a\x00\xff\xff\x3c\x00\xff\xff\xff\xff\xff\xff\x40\x00\x41\x00\xff\xff\x43\x00\x38\x00\x39\x00\x3a\x00\xff\xff\x3c\x00\xff\xff\xff\xff\xff\xff\x40\x00\x41\x00\xff\xff\x43\x00\x38\x00\x39\x00\x3a\x00\xff\xff\x3c\x00\xff\xff\xff\xff\xff\xff\x40\x00\x41\x00\xff\xff\x43\x00\x38\x00\x39\x00\x3a\x00\xff\xff\x3c\x00\xff\xff\xff\xff\xff\xff\x40\x00\x41\x00\xff\xff\x43\x00\x38\x00\x39\x00\x3a\x00\xff\xff\x3c\x00\xff\xff\xff\xff\xff\xff\x40\x00\x41\x00\xff\xff\x43\x00\x38\x00\x39\x00\x3a\x00\xff\xff\x3c\x00\xff\xff\xff\xff\xff\xff\x40\x00\x41\x00\xff\xff\x43\x00\x38\x00\x39\x00\x3a\x00\xff\xff\x3c\x00\xff\xff\xff\xff\xff\xff\x40\x00\x41\x00\xff\xff\x43\x00\x38\x00\x39\x00\x3a\x00\xff\xff\x3c\x00\xff\xff\xff\xff\xff\xff\x40\x00\x41\x00\xff\xff\x43\x00\x38\x00\x39\x00\x3a\x00\xff\xff\x3c\x00\xff\xff\xff\xff\xff\xff\x40\x00\x41\x00\xff\xff\x43\x00\x38\x00\x39\x00\x3a\x00\xff\xff\x3c\x00\xff\xff\xff\xff\xff\xff\x40\x00\x41\x00\xff\xff\x43\x00\x38\x00\x39\x00\x3a\x00\xff\xff\x3c\x00\xff\xff\xff\xff\xff\xff\x40\x00\x41\x00\xff\xff\x43\x00\x38\x00\x39\x00\x3a\x00\xff\xff\x3c\x00\xff\xff\xff\xff\xff\xff\x40\x00\x41\x00\xff\xff\x43\x00\x38\x00\x39\x00\x3a\x00\xff\xff\x3c\x00\xff\xff\xff\xff\xff\xff\x40\x00\x41\x00\xff\xff\x43\x00\x38\x00\x39\x00\x3a\x00\xff\xff\x3c\x00\xff\xff\xff\xff\xff\xff\x40\x00\x41\x00\xff\xff\x43\x00\x38\x00\x39\x00\x3a\x00\xff\xff\x3c\x00\xff\xff\x3a\x00\xff\xff\x40\x00\x41\x00\x3a\x00\x43\x00\x40\x00\x41\x00\x3a\x00\x43\x00\x40\x00\x41\x00\x3a\x00\x43\x00\x40\x00\x41\x00\x3a\x00\x43\x00\x40\x00\x41\x00\xff\xff\x43\x00\x40\x00\x41\x00\xff\xff\x43\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"#
happyTable :: HappyAddr
happyTable = HappyA# "\x00\x00\x29\x02\x37\x00\x11\x00\x38\x00\x39\x00\x8e\x01\xbd\x01\x12\x00\x13\x00\x14\x00\xa0\x00\x3a\x00\x3b\x00\x0d\x00\x86\x01\x55\x01\x3c\x00\x92\x00\xa3\x01\x3d\x00\xf3\x01\x57\x00\xcd\x00\x1a\x02\xc3\x01\xa0\x00\x87\x01\x3f\x00\x85\x00\x8c\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x15\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\xf4\x01\x59\x00\x7d\x00\xa1\x00\x56\x01\x4d\x00\xa9\x00\x25\x02\x85\x00\xa4\x01\x4e\x00\x6b\x00\x4f\x00\x1d\x00\x0e\x00\x50\x00\x35\x00\x08\x02\xa1\x00\x1d\x02\x51\x00\x09\x02\xa2\x00\xdd\x01\x5a\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\x53\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\x20\x00\x11\x00\xa4\x00\x21\x00\x11\x00\xca\x00\x12\x00\x13\x00\x14\x00\x12\x00\x13\x00\x14\x00\x58\x01\x23\x00\x26\x02\xf0\x01\x18\x02\x26\x00\x27\x00\x28\x00\x29\x00\xff\xff\x7d\x00\xb6\x01\x5c\x00\xc7\x01\xa2\x00\xa3\x00\xcb\x00\x2a\x00\x2b\x00\xb7\x01\x6f\x00\x5b\x01\x70\x00\x8c\x00\x71\x00\x15\x00\x57\x00\x91\x01\x15\x00\x0e\x02\x2c\x00\x05\x02\x06\x02\x5d\x00\x7f\x00\xab\x01\xf4\x00\xba\x01\xab\x01\x5e\x00\x5c\x01\xf6\x00\x0e\x02\x93\x01\x5f\x00\xa4\x00\x85\x00\x15\x02\xe6\xff\x16\x02\x59\x00\xad\x01\x2f\x00\x14\x02\xad\x01\x60\x00\x80\x01\xed\x01\xf3\x01\x37\x00\x11\x00\x38\x00\x39\x00\xe6\xff\xe6\xff\x12\x00\x13\x00\x14\x00\xcf\x01\x3a\x00\x3b\x00\xb4\x01\xee\x01\x5a\x00\x3c\x00\x79\x00\x67\x00\x3d\x00\xce\x01\x8c\x00\x57\x00\x9a\x01\xf4\x01\xdb\x01\x7d\x00\x3f\x00\xff\xff\xb5\x01\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x15\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x85\x00\xa9\x01\x59\x00\x9d\x00\x9e\x00\x4d\x00\x7c\x01\x7f\x01\x80\x01\x22\x01\x4e\x00\x94\x01\x4f\x00\xaa\x01\x8e\x00\x50\x00\x7d\x00\x7e\x00\x57\x00\xaf\x01\x51\x00\x37\x00\x11\x00\x38\x00\x39\x00\x5a\x00\x52\x00\x12\x00\x13\x00\x14\x00\x19\x02\x3a\x00\x3b\x00\x32\x00\x33\x00\x34\x00\x3c\x00\x7f\x00\x64\x00\x3d\x00\x65\x00\x8a\x00\x59\x00\x66\x00\x67\x00\x8b\x00\x53\x00\x3f\x00\x57\x00\x53\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x15\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\xc7\x00\x5a\x00\x90\x00\x54\x00\x8c\x00\x4d\x00\x1d\x00\x0e\x00\x59\x00\x35\x00\x4e\x00\x91\x00\x4f\x00\x7d\x00\x92\x00\x50\x00\x5d\x01\x62\x00\x57\x00\x91\x01\x51\x00\x93\x00\x37\x00\x11\x00\x38\x00\x39\x00\x52\x00\x85\x00\x12\x00\x13\x00\x14\x00\x5a\x00\x3a\x00\x3b\x00\x92\x01\x93\x01\x69\x00\x3c\x00\xef\x01\x56\x00\x3d\x00\x2a\x01\x59\x00\x57\x00\x7d\x00\xc5\x01\x53\x00\x3e\x00\x3f\x00\x97\x00\x03\x02\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x15\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x5a\x00\xab\x01\x59\x00\x7d\x00\x37\x01\x4d\x00\x7d\x00\x8c\x00\x25\x02\x24\x02\x4e\x00\x9e\x01\x4f\x00\xc9\x01\x83\x00\x50\x00\xac\x01\xad\x01\x9f\x01\x19\x02\x51\x00\x37\x00\x11\x00\x38\x00\x39\x00\x5a\x00\x52\x00\x12\x00\x13\x00\x14\x00\x85\x00\x3a\x00\x3b\x00\x28\x02\x29\x02\x11\x00\x3c\x00\x85\x00\xa0\x01\x3d\x00\x12\x00\x13\x00\x14\x00\x7d\x00\xd2\x01\xa1\x01\x53\x00\x3f\x00\x57\x00\x10\x02\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x15\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x81\x00\x82\x00\x83\x00\x84\x00\xd9\x01\x4d\x00\x7d\x00\x15\x00\x59\x00\x23\x02\x4e\x00\x00\x02\x4f\x00\xf6\xfe\x7d\x00\x50\x00\xf6\xfe\xf6\xfe\x9c\x01\x02\x02\x51\x00\x20\x02\xe5\x01\x82\x00\x83\x00\x85\x00\x52\x00\x11\x02\x03\x02\xe9\x00\xea\x00\x5a\x00\xf6\xfe\xf6\xfe\xf6\xfe\xf6\xfe\xf6\xfe\x7d\x00\xf6\xfe\xf6\xfe\xf6\xfe\xeb\x00\xec\x00\xf6\xfe\xed\x00\xd7\x01\x53\x00\x85\x00\xf6\xfe\xd8\x01\xf6\xfe\xf6\xfe\x30\x01\x31\x01\x04\x02\xf6\xfe\xf6\xfe\xf6\xfe\xf6\xfe\xf6\xfe\xf6\xfe\xf6\xfe\xf6\xfe\xf6\xfe\xf6\xfe\xf6\xfe\xf6\xfe\xf6\xfe\xf6\xfe\xf6\xfe\xf6\xfe\xf6\xfe\xf6\xfe\xf6\xfe\xf6\xfe\xf6\xfe\xf6\xfe\xf6\xfe\x0c\x02\xf6\xfe\xf6\xfe\xf6\xfe\xf6\xfe\xf6\xfe\xf6\xfe\x11\x00\x34\x01\x35\x01\x73\x00\x11\x00\x12\x00\x13\x00\x75\x00\x76\x00\x12\x00\x13\x00\x14\x00\x11\x00\x87\x00\x82\x00\x83\x00\x88\x00\x12\x00\x13\x00\x14\x00\x5c\x00\x77\x00\xb8\x01\xa4\x01\x5c\x00\x10\x02\x98\x01\xbf\x01\x7e\x01\x5f\x01\xb9\x01\x6f\x00\x5c\x00\x70\x00\xbc\x01\x71\x00\x15\x00\x57\x00\x85\x00\x9a\x01\x15\x00\x5d\x00\x98\x01\x99\x01\xd9\x01\x5d\x00\x7d\x00\x5e\x00\x15\x00\xdd\x01\xd3\x01\x5e\x00\x5f\x00\x5d\x00\x57\x00\x9a\x01\x5f\x00\xf7\x01\x31\x01\x5e\x00\xfa\x01\x59\x00\xda\x01\x60\x00\x5f\x00\x7c\x00\x0c\x01\x60\x00\x16\x01\xc5\x01\xc8\x01\x82\x00\x83\x00\x20\x00\x11\x00\x60\x00\x21\x00\x95\x00\x59\x00\x12\x00\x13\x00\x14\x00\xa2\x01\x9f\x01\x5a\x00\x22\x00\x23\x00\x24\x00\xfe\x01\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2d\x01\x85\x00\x37\x01\x36\x01\x9b\x00\x11\x00\x38\x01\x5a\x00\x2a\x00\x2b\x00\x12\x00\x13\x00\x14\x00\xd4\x01\x33\x00\x34\x00\x15\x00\x20\x00\x11\x00\xcd\x00\x21\x00\x2c\x00\x39\x01\x12\x00\x13\x00\x14\x00\x3a\x01\xf4\x00\xf5\x00\x22\x00\x23\x00\x24\x00\xf6\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x56\x00\xa5\x01\xa1\x01\x15\x00\x57\x00\x2f\x00\x58\x00\x83\x01\x2a\x00\x2b\x00\x5a\x01\x84\x01\x1d\x00\x0e\x00\x9c\x00\x35\x00\x15\x00\x20\x00\x11\x00\x9d\x00\x21\x00\x2c\x00\xa7\x01\x12\x00\x13\x00\x14\x00\xa8\x01\xf4\x00\x59\x00\x22\x00\x23\x00\x24\x00\xf6\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x8e\x00\xcb\x01\x82\x00\x83\x00\x57\x00\x2f\x00\x5e\x01\x5f\x01\x2a\x00\x2b\x00\x64\x01\x1d\x00\x0e\x00\x5a\x00\x98\x00\x99\x00\x15\x00\x20\x00\x11\x00\x65\x01\x21\x00\x2c\x00\x66\x01\x12\x00\x13\x00\x14\x00\x85\x00\x2d\x00\x59\x00\x22\x00\x23\x00\x24\x00\x2e\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x60\x00\xea\x01\x33\x00\x34\x00\x57\x00\x2f\x00\x67\x01\x68\x01\x2a\x00\x2b\x00\x69\x01\xeb\x00\x1b\x02\x5a\x00\x2a\x01\x6a\x01\x15\x00\x20\x00\x11\x00\x6b\x01\x21\x00\x2c\x00\x6c\x01\x12\x00\x13\x00\x14\x00\x6d\x01\x2d\x00\x59\x00\x22\x00\x23\x00\x24\x00\xf6\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x1d\x00\x0e\x00\x6e\x01\x35\x00\x6f\x01\x2f\x00\x70\x01\x71\x01\x2a\x00\x2b\x00\x85\x01\x20\x00\x11\x00\x5a\x00\x21\x00\x72\x01\x15\x00\x12\x00\x13\x00\x14\x00\x73\x01\x2c\x00\xeb\x00\xec\x00\x23\x00\x2a\x01\x74\x01\x2d\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2e\x00\xc3\x00\x75\x01\x76\x01\x32\x00\x33\x00\x34\x00\x77\x01\x2a\x00\x2b\x00\xc4\x00\x2f\x00\x78\x01\xc5\x00\x79\x01\x7a\x01\x15\x00\x20\x00\x11\x00\x7b\x01\x21\x00\x2c\x00\x7d\x01\x12\x00\x13\x00\x14\x00\x96\x01\xf4\x00\x2f\x01\xa6\x01\x23\x00\xae\x01\xf6\x00\xb1\x01\x26\x00\x27\x00\x28\x00\x29\x00\xcc\x01\x82\x00\x83\x00\x1d\x00\x0e\x00\x2f\x00\x35\x00\xb3\x01\x2a\x00\x2b\x00\xb6\x01\x20\x00\x11\x00\xff\xff\x21\x00\x79\x00\x15\x00\x12\x00\x13\x00\x14\x00\x78\x00\x2c\x00\x8e\x00\x92\x00\x23\x00\x85\x00\xff\xff\xf4\x00\x26\x00\x27\x00\x28\x00\x29\x00\xf6\x00\x8d\x01\xe2\x01\xe3\x01\xe4\x01\xe5\x01\x82\x00\x83\x00\x2a\x00\x2b\x00\xff\xff\x2f\x00\x20\x00\x11\x00\xcd\x00\x21\x00\x15\x00\xfb\x01\x12\x00\x13\x00\x14\x00\x2c\x00\x7d\x00\x1d\x00\x0e\x00\x23\x00\xf8\x00\xf4\x00\x04\x01\x26\x00\x85\x00\xff\xff\xf6\x00\x20\x00\x11\x00\x04\x01\x21\x00\xd4\x00\x23\x01\x12\x00\x13\x00\x14\x00\x11\x01\x2f\x00\x1d\x00\x0e\x00\x23\x00\xf8\x00\xff\xff\x15\x00\x26\x00\xfe\x01\x6c\x00\x6d\x00\xfa\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\x0d\x00\xf4\x00\x6e\x00\x6f\x00\x3e\x00\x70\x00\xf6\x00\x71\x00\x56\x00\x57\x00\x64\x00\x15\x00\x24\x01\x6b\x00\x6c\x00\x6d\x00\x06\x01\x2f\x00\x1d\x00\x0e\x00\x00\x00\xf8\x00\xf4\x00\x6e\x00\x6f\x00\x00\x00\x70\x00\xf6\x00\x71\x00\x00\x00\x57\x00\x1e\x02\x00\x00\x59\x00\x32\x00\x33\x00\x34\x00\x11\x00\x2f\x00\x00\x00\x73\x00\x74\x00\x12\x00\x13\x00\x75\x00\x76\x00\x00\x00\x00\x00\xbc\x01\x6f\x00\x00\x00\x70\x00\x00\x00\x71\x00\x59\x00\x57\x00\x5a\x00\x5c\x00\x77\x00\x00\x00\x11\x00\x1d\x00\x0e\x00\x73\x00\xae\x01\x12\x00\x13\x00\x75\x00\x76\x00\x00\x00\x00\x00\x1d\x00\x0e\x00\x15\x00\x35\x00\x00\x00\x00\x00\x5a\x00\x5d\x00\x59\x00\x5c\x00\x77\x00\x00\x00\x00\x00\x5e\x00\x11\x00\x00\x00\x00\x00\x11\x00\x5f\x00\x12\x00\x13\x00\x14\x00\x12\x00\x13\x00\x14\x00\x15\x00\x01\x01\x02\x01\x00\x00\x60\x00\x5d\x00\x5a\x00\x1d\x00\x0e\x00\x5c\x00\xf8\x00\x5e\x00\x5c\x00\x00\x00\x00\x00\x11\x00\x5f\x00\x25\x01\x69\x00\x00\x00\x12\x00\x13\x00\x14\x00\x1d\x00\x0e\x00\x15\x00\xf8\x00\x60\x00\x15\x00\x00\x00\x5d\x00\x26\x01\x00\x00\x5d\x00\x00\x00\x5c\x00\x5e\x00\x1d\x00\x0e\x00\x5e\x00\xf8\x00\x5f\x00\x0d\x02\x11\x00\x5f\x00\xc7\x01\x00\x00\x00\x00\x12\x00\x13\x00\x14\x00\x15\x00\x60\x00\x11\x00\x00\x00\x60\x00\x5d\x00\x00\x00\x12\x00\x13\x00\x14\x00\x00\x00\x5e\x00\x0d\x00\x0e\x00\x14\x02\x11\x00\x5f\x00\x28\x01\x00\x00\x00\x00\x12\x00\x13\x00\x14\x00\x1d\x00\x0e\x00\x11\x00\xf8\x00\x60\x00\x15\x00\x00\x00\x12\x00\x13\x00\x14\x00\x5d\x00\x00\x00\x5c\x00\x00\x00\x00\x00\x15\x00\x5e\x00\x11\x00\x00\x00\x00\x00\x5d\x00\x5f\x00\x12\x00\x13\x00\x14\x00\x13\x02\x5e\x00\x00\x00\x15\x00\x00\x00\x00\x00\x5f\x00\x60\x00\x5d\x00\x00\x00\xbf\x01\x00\x00\x00\x00\x15\x00\x5e\x00\x11\x00\x00\x00\x60\x00\x5d\x00\x5f\x00\x12\x00\x13\x00\x14\x00\x00\x00\x5e\x00\x00\x00\x7d\x00\x00\x00\x15\x00\x5f\x00\x60\x00\x00\x00\x11\x00\xe0\x01\x00\x00\x00\x00\x11\x00\x12\x00\x13\x00\x14\x00\x60\x00\x12\x00\x13\x00\x14\x00\x00\x00\x1d\x02\x00\x00\x60\x01\x61\x01\x62\x01\x00\x00\x15\x00\x63\x01\x11\x00\x00\x00\x00\x00\x5d\x00\x00\x00\x12\x00\x13\x00\x14\x00\xc7\x00\x5e\x00\xe9\x01\x32\x00\x33\x00\x34\x00\x5f\x00\x15\x00\x00\x00\x11\x00\xed\x01\x15\x00\x5d\x00\x00\x00\x12\x00\x13\x00\x14\x00\x60\x00\x5e\x00\x0d\x00\x0e\x00\xb1\x01\x9c\x01\x5f\x00\x0d\x00\x0e\x00\x14\x01\x82\x01\x15\x00\x00\x00\x11\x00\xc1\x01\x00\x00\x5d\x00\x60\x00\x12\x00\x13\x00\x14\x00\x00\x00\x5e\x00\x1d\x00\x0e\x00\xf7\x00\x35\x00\x5f\x00\x15\x00\x00\x00\x00\x00\x1d\x00\x0e\x00\x5d\x00\xf8\x00\x90\x01\x11\x00\x00\x00\x60\x00\x5e\x00\x00\x00\x12\x00\x13\x00\x14\x00\x5f\x00\x11\x00\x00\x00\x00\x00\x98\x01\x15\x00\x12\x00\x13\x00\x14\x00\x21\x02\x5d\x00\x60\x00\x32\x00\x33\x00\x34\x00\x00\x00\x5e\x00\x87\x00\x11\x00\x00\x00\x00\x00\x5f\x00\x00\x00\x12\x00\x13\x00\x14\x00\xa6\x00\x00\x00\x15\x00\x32\x00\x33\x00\x34\x00\x60\x00\x5d\x00\x8a\x00\xa7\x00\x00\x00\x15\x00\x5c\x00\x5e\x00\x11\x00\x00\x00\x5d\x00\x00\x00\x5f\x00\x12\x00\x13\x00\x14\x00\x5e\x00\x1d\x00\x0e\x00\x00\x00\x35\x00\x5f\x00\x15\x00\x60\x00\x11\x00\x35\xff\x00\x00\x5d\x00\x00\x00\x12\x00\x13\x00\x14\x00\x60\x00\x5e\x00\x1d\x00\x0e\x00\x11\x00\x35\x00\x5f\x00\x00\x00\x00\x00\x12\x00\x13\x00\x14\x00\x15\x00\x11\x00\x00\x00\xfa\x00\x00\x00\x60\x00\x12\x00\x13\x00\x14\x00\x1d\x00\x0e\x00\x9c\x01\xf8\x00\x0d\x00\x0e\x00\x0f\x00\x15\x00\x00\x00\x00\x00\x00\x00\xd1\x01\x5d\x00\x00\x00\x37\x00\x11\x00\x38\x00\x39\x00\x5e\x00\x15\x00\x12\x00\x13\x00\x14\x00\x5f\x00\x3a\x00\x3b\x00\x00\x00\x00\x00\x15\x00\x3c\x00\x9c\x01\x00\x00\x3d\x00\x00\x00\x60\x00\x7a\x00\x6f\x00\x00\x00\x70\x00\x9d\x01\x71\x00\x00\x00\x57\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x15\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\xc1\x01\x00\x00\x70\x00\x00\x00\x71\x00\x4d\x00\x57\x00\x00\x00\x00\x00\x59\x00\x4e\x00\x00\x00\x4f\x00\x00\x00\xc2\x01\x50\x00\x70\x00\x00\x00\x71\x00\x11\x00\x57\x00\x00\x00\x11\x00\x00\x00\x12\x00\x13\x00\x14\x00\x12\x00\x13\x00\x14\x00\x59\x00\x00\x00\x5a\x00\x11\x00\x00\x00\x00\x00\xfb\x00\x00\x00\x12\x00\x13\x00\x14\x00\x11\x00\x1d\x00\x0e\x00\x59\x00\xf8\x00\x12\x00\x13\x00\x14\x00\x00\x00\x00\x00\x2f\x00\x00\x00\x5a\x00\x00\x00\x15\x00\x00\x00\x00\x00\x15\x00\x30\x00\x31\x00\x32\x01\x33\x01\x32\x00\x33\x00\x34\x00\x00\x00\x5a\x00\x00\x00\x15\x00\x00\x00\x00\x00\x2c\x01\x07\x01\x00\x00\x81\x00\x00\x00\x15\x00\x00\x00\x00\x00\x08\x01\x09\x01\x0a\x01\x0b\x01\x0c\x01\x0d\x01\xa6\x00\x00\x00\x00\x00\xf2\xfe\x0e\x01\x00\x00\x00\x00\x00\x00\xef\x00\x0f\x01\x10\x01\x00\x00\x00\x00\xf2\xfe\x1d\x00\x0e\x00\x00\x00\x35\x00\xf2\xfe\xf2\xfe\xf2\xfe\xf2\xfe\xf2\xfe\xf2\xfe\xf2\xfe\xf2\xfe\x00\x00\x00\x00\x00\x02\x00\x00\xf2\xfe\x32\x00\x33\x00\x34\x00\x00\x00\xf2\xfe\xf2\xfe\xc7\x00\xc8\x00\xc9\x00\x32\x00\x33\x00\x34\x00\x00\x00\x00\x00\x06\x02\x00\x00\xf2\xfe\x32\x00\x33\x00\x34\x00\x11\x02\x00\x00\x00\x00\x32\x00\x33\x00\x34\x00\xd1\x01\x58\x01\x11\x00\x32\x00\x33\x00\x34\x00\x00\x00\x12\x00\x13\x00\x14\x00\x00\x00\x1d\x00\x0e\x00\xde\x01\x35\x00\x00\x00\x32\x00\x33\x00\x34\x00\x00\x00\x1d\x00\x0e\x00\xe0\x01\x35\x00\x00\x00\x32\x00\x33\x00\x34\x00\x1d\x00\x0e\x00\x00\x00\x35\x00\x00\x00\x00\x00\x1d\x00\x0e\x00\x00\x00\x35\x00\x15\x00\x00\x00\x1d\x00\x0e\x00\xe1\x01\x35\x00\x00\x00\x32\x00\x33\x00\x34\x00\x0a\x01\x0b\x01\x0c\x01\x0d\x01\x00\x00\x1d\x00\x0e\x00\xe6\x01\x35\x00\x00\x00\x32\x00\x33\x00\x34\x00\x00\x00\x1d\x00\x0e\x00\xe7\x01\x35\x00\x00\x00\x32\x00\x33\x00\x34\x00\xe8\x01\x00\x00\x00\x00\x32\x00\x33\x00\x34\x00\xeb\x01\x00\x00\x00\x00\x32\x00\x33\x00\x34\x00\x1d\x00\x0e\x00\x96\x01\x35\x00\x00\x00\x32\x00\x33\x00\x34\x00\x00\x00\x3a\x01\x33\x00\x34\x00\x00\x00\x1d\x00\x0e\x00\x61\x00\x35\x00\x00\x00\x32\x00\x33\x00\x34\x00\x00\x00\x1d\x00\x0e\x00\x00\x00\x35\x00\x00\x00\x00\x00\x1d\x00\x0e\x00\x00\x00\x35\x00\x00\x00\x00\x00\x1d\x00\x0e\x00\x00\x00\x35\x00\x3b\x01\x33\x00\x34\x00\x00\x00\x1d\x00\x0e\x00\x00\x00\x35\x00\x1d\x00\x0e\x00\x00\x00\x35\x00\x3c\x01\x33\x00\x34\x00\x00\x00\x00\x00\x1d\x00\x0e\x00\x00\x00\x35\x00\x3d\x01\x33\x00\x34\x00\x00\x00\x3e\x01\x33\x00\x34\x00\x00\x00\x3f\x01\x33\x00\x34\x00\x00\x00\x40\x01\x33\x00\x34\x00\x00\x00\x1d\x00\x0e\x00\x00\x00\x35\x00\x41\x01\x33\x00\x34\x00\x00\x00\x42\x01\x33\x00\x34\x00\x00\x00\x1d\x00\x0e\x00\x00\x00\x35\x00\x43\x01\x33\x00\x34\x00\x00\x00\x00\x00\x1d\x00\x0e\x00\x00\x00\x35\x00\x1d\x00\x0e\x00\x00\x00\x35\x00\x1d\x00\x0e\x00\x00\x00\x35\x00\x1d\x00\x0e\x00\x00\x00\x35\x00\x44\x01\x33\x00\x34\x00\x00\x00\x1d\x00\x0e\x00\x00\x00\x35\x00\x1d\x00\x0e\x00\x00\x00\x35\x00\x45\x01\x33\x00\x34\x00\x00\x00\x1d\x00\x0e\x00\x00\x00\x35\x00\x46\x01\x33\x00\x34\x00\x00\x00\x47\x01\x33\x00\x34\x00\x00\x00\x48\x01\x33\x00\x34\x00\x00\x00\x49\x01\x33\x00\x34\x00\x00\x00\x00\x00\x1d\x00\x0e\x00\x00\x00\x35\x00\x4a\x01\x33\x00\x34\x00\x00\x00\x4b\x01\x33\x00\x34\x00\x00\x00\x1d\x00\x0e\x00\x00\x00\x35\x00\x4c\x01\x33\x00\x34\x00\x00\x00\x1d\x00\x0e\x00\x00\x00\x35\x00\x1d\x00\x0e\x00\x00\x00\x35\x00\x1d\x00\x0e\x00\x00\x00\x35\x00\x1d\x00\x0e\x00\x00\x00\x35\x00\x4d\x01\x33\x00\x34\x00\x00\x00\x00\x00\x1d\x00\x0e\x00\x00\x00\x35\x00\x1d\x00\x0e\x00\x00\x00\x35\x00\x4e\x01\x33\x00\x34\x00\x00\x00\x1d\x00\x0e\x00\x00\x00\x35\x00\x4f\x01\x33\x00\x34\x00\x00\x00\x50\x01\x33\x00\x34\x00\x00\x00\x51\x01\x33\x00\x34\x00\x00\x00\x52\x01\x33\x00\x34\x00\x00\x00\x1d\x00\x0e\x00\x00\x00\x35\x00\x53\x01\x33\x00\x34\x00\x00\x00\x96\x00\x33\x00\x34\x00\x00\x00\x00\x00\x1d\x00\x0e\x00\x00\x00\x35\x00\x95\x00\x33\x00\x34\x00\x00\x00\x1d\x00\x0e\x00\x00\x00\x35\x00\x1d\x00\x0e\x00\x00\x00\x35\x00\x1d\x00\x0e\x00\x00\x00\x35\x00\x1d\x00\x0e\x00\xfb\x01\x35\x00\x96\x00\x33\x00\x34\x00\x00\x00\x1d\x00\x0e\x00\xfc\x00\x35\x00\x1d\x00\x0e\x00\x00\x00\x35\x00\x1d\x00\x0e\x00\x00\x00\xf8\x00\x07\x01\x1d\x00\x0e\x00\x00\x00\x35\x00\x00\x00\x00\x00\x08\x01\x09\x01\x0a\x01\x0b\x01\x0c\x01\x0d\x01\x00\x00\x00\x00\x00\x00\xcf\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1d\x00\x0e\x00\x00\x00\x35\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\xfd\x01\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\x2a\x01\x00\x00\x00\x00\x00\x00\x1f\x02\xe4\x01\xe5\x01\x82\x00\x83\x00\x00\x00\x00\x00\x00\x00\x07\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x01\x08\x01\x09\x01\x0a\x01\x0b\x01\x0c\x01\x0d\x01\x08\x01\x09\x01\x0a\x01\x0b\x01\x0c\x01\x0d\x01\x85\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x00\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\x00\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x00\x00\x00\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\x00\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\x00\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\x00\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\x00\x00\x00\x00\x00\x00\x32\x01\x33\x01\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xd6\x01\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\x07\x01\xe5\x00\xe6\x00\xe7\x00\xe8\x00\x00\x00\x07\x01\x08\x01\x09\x01\x0a\x01\x0b\x01\x0c\x01\x0d\x01\x08\x01\x09\x01\x0a\x01\x0b\x01\x0c\x01\x0d\x01\x07\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x01\x09\x01\x0a\x01\x0b\x01\x0c\x01\x0d\x01\x00\x00\x33\x01\x00\x00\x00\x00\x0e\x01\xdb\x01\x00\x00\x00\x00\x00\x00\x0f\x01\x10\x01\x00\x00\x07\x01\xd2\x00\xd3\x00\xd4\x00\xd5\x00\x00\x00\x00\x00\x08\x01\x09\x01\x0a\x01\x0b\x01\x0c\x01\x0d\x01\x00\x00\x00\x00\x00\x00\x00\x00\x93\x01\x16\x00\x17\x00\x00\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\x18\x00\x00\x00\x19\x00\x1a\x00\x1b\x00\x00\x00\x1c\x00\x15\x00\x16\x00\x17\x00\x1d\x00\x0e\x00\x00\x00\x1e\x00\x00\x00\x18\x00\x00\x00\x19\x00\x1a\x00\x1b\x00\x00\x00\x1c\x00\x00\x00\x12\x01\x00\x00\x1d\x00\x0e\x00\x00\x00\x1e\x00\x18\x00\x00\x00\x13\x01\x1a\x00\x1b\x00\x00\x00\x1c\x00\xf0\x01\x00\x00\x00\x00\x1d\x00\x0e\x00\x00\x00\x1e\x00\xf1\x01\x1a\x00\x1b\x00\x00\x00\x1c\x00\x00\x00\x00\x00\x00\x00\x1d\x00\x0e\x00\x00\x00\x1e\x00\x87\x01\x1a\x00\x1b\x00\x00\x00\x1c\x00\x88\x01\x00\x00\x00\x00\x1d\x00\x89\x01\x00\x00\x1e\x00\x00\x00\x8a\x01\x8b\x01\xef\x00\xf0\x00\xf1\x00\x1a\x00\x1b\x00\x00\x00\x1c\x00\xf2\x00\x00\x00\x00\x00\x1d\x00\x0e\x00\xf4\x01\x1e\x00\xf5\x01\x1a\x00\x1b\x00\x00\x00\x1c\x00\x07\x01\x00\x00\x00\x00\x1d\x00\x0e\x00\x00\x00\x1e\x00\x08\x01\x09\x01\x0a\x01\x0b\x01\x0c\x01\x0d\x01\x2d\x01\x1a\x00\x1b\x00\x00\x00\x1c\x00\xf2\x00\x00\x00\x00\x00\x1d\x00\x0e\x00\x00\x00\x1e\x00\xf1\x01\x1a\x00\x1b\x00\x00\x00\x1c\x00\x00\x00\x00\x00\x00\x00\x1d\x00\x0e\x00\x00\x00\x1e\x00\x07\x02\x1a\x00\x1b\x00\x00\x00\x1c\x00\x00\x00\x00\x00\x00\x00\x1d\x00\x0e\x00\x00\x00\x1e\x00\x0a\x02\x1a\x00\x1b\x00\x00\x00\x1c\x00\x00\x00\x00\x00\x00\x00\x1d\x00\x0e\x00\x00\x00\x1e\x00\xca\x01\x1a\x00\x1b\x00\x00\x00\x1c\x00\x00\x00\x00\x00\x00\x00\x1d\x00\x0e\x00\x00\x00\x1e\x00\xcd\x01\x1a\x00\x1b\x00\x00\x00\x1c\x00\x00\x00\x00\x00\x00\x00\x1d\x00\x0e\x00\x00\x00\x1e\x00\xf7\x01\x1a\x00\x1b\x00\x00\x00\x1c\x00\x00\x00\x00\x00\x00\x00\x1d\x00\x0e\x00\x00\x00\x1e\x00\xf8\x01\x1a\x00\x1b\x00\x00\x00\x1c\x00\x00\x00\x00\x00\x00\x00\x1d\x00\x0e\x00\x00\x00\x1e\x00\x16\x01\x1a\x00\x1b\x00\x00\x00\x1c\x00\x00\x00\x00\x00\x00\x00\x1d\x00\x0e\x00\x00\x00\x1e\x00\x17\x01\x1a\x00\x1b\x00\x00\x00\x1c\x00\x00\x00\x00\x00\x00\x00\x1d\x00\x0e\x00\x00\x00\x1e\x00\x18\x01\x1a\x00\x1b\x00\x00\x00\x1c\x00\x00\x00\x00\x00\x00\x00\x1d\x00\x0e\x00\x00\x00\x1e\x00\x19\x01\x1a\x00\x1b\x00\x00\x00\x1c\x00\x00\x00\x00\x00\x00\x00\x1d\x00\x0e\x00\x00\x00\x1e\x00\x1a\x01\x1a\x00\x1b\x00\x00\x00\x1c\x00\x00\x00\x00\x00\x00\x00\x1d\x00\x0e\x00\x00\x00\x1e\x00\x1b\x01\x1a\x00\x1b\x00\x00\x00\x1c\x00\x00\x00\x00\x00\x00\x00\x1d\x00\x0e\x00\x00\x00\x1e\x00\x1c\x01\x1a\x00\x1b\x00\x00\x00\x1c\x00\x00\x00\x00\x00\x00\x00\x1d\x00\x0e\x00\x00\x00\x1e\x00\x1d\x01\x1a\x00\x1b\x00\x00\x00\x1c\x00\x00\x00\x00\x00\x00\x00\x1d\x00\x0e\x00\x00\x00\x1e\x00\x1e\x01\x1a\x00\x1b\x00\x00\x00\x1c\x00\x00\x00\x00\x00\x00\x00\x1d\x00\x0e\x00\x00\x00\x1e\x00\x1f\x01\x1a\x00\x1b\x00\x00\x00\x1c\x00\x00\x00\x00\x00\x00\x00\x1d\x00\x0e\x00\x00\x00\x1e\x00\x20\x01\x1a\x00\x1b\x00\x00\x00\x1c\x00\x00\x00\x00\x00\x00\x00\x1d\x00\x0e\x00\x00\x00\x1e\x00\x21\x01\x1a\x00\x1b\x00\x00\x00\x1c\x00\x00\x00\x00\x00\x00\x00\x1d\x00\x0e\x00\x00\x00\x1e\x00\x27\x01\x1a\x00\x1b\x00\x00\x00\x1c\x00\x00\x00\x00\x00\x00\x00\x1d\x00\x0e\x00\x00\x00\x1e\x00\x54\x01\x1a\x00\x1b\x00\x00\x00\x1c\x00\x00\x00\x00\x00\x00\x00\x1d\x00\x0e\x00\x00\x00\x1e\x00\x8d\x01\x1a\x00\x1b\x00\x00\x00\x1c\x00\x00\x00\x00\x00\x00\x00\x1d\x00\x0e\x00\x00\x00\x1e\x00\xf6\x00\x1a\x00\x1b\x00\x00\x00\x1c\x00\x00\x00\x00\x00\x00\x00\x1d\x00\x0e\x00\x00\x00\x1e\x00\x11\x01\x1a\x00\x1b\x00\x00\x00\x1c\x00\x00\x00\xfd\x00\x00\x00\x1d\x00\x0e\x00\xfe\x00\x1e\x00\x1d\x00\x0e\x00\xff\x00\xf8\x00\x1d\x00\x0e\x00\x00\x01\xf8\x00\x1d\x00\x0e\x00\x04\x01\xf8\x00\x1d\x00\x0e\x00\x00\x00\xf8\x00\x1d\x00\x0e\x00\x00\x00\xf8\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\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 (11, 299) [
(11 , happyReduce_11),
(12 , happyReduce_12),
(13 , happyReduce_13),
(14 , happyReduce_14),
(15 , happyReduce_15),
(16 , happyReduce_16),
(17 , happyReduce_17),
(18 , happyReduce_18),
(19 , happyReduce_19),
(20 , happyReduce_20),
(21 , happyReduce_21),
(22 , happyReduce_22),
(23 , happyReduce_23),
(24 , happyReduce_24),
(25 , happyReduce_25),
(26 , happyReduce_26),
(27 , happyReduce_27),
(28 , happyReduce_28),
(29 , happyReduce_29),
(30 , happyReduce_30),
(31 , happyReduce_31),
(32 , happyReduce_32),
(33 , happyReduce_33),
(34 , happyReduce_34),
(35 , happyReduce_35),
(36 , happyReduce_36),
(37 , happyReduce_37),
(38 , happyReduce_38),
(39 , happyReduce_39),
(40 , happyReduce_40),
(41 , happyReduce_41),
(42 , happyReduce_42),
(43 , happyReduce_43),
(44 , happyReduce_44),
(45 , happyReduce_45),
(46 , happyReduce_46),
(47 , happyReduce_47),
(48 , happyReduce_48),
(49 , happyReduce_49),
(50 , happyReduce_50),
(51 , happyReduce_51),
(52 , happyReduce_52),
(53 , happyReduce_53),
(54 , happyReduce_54),
(55 , happyReduce_55),
(56 , happyReduce_56),
(57 , happyReduce_57),
(58 , happyReduce_58),
(59 , happyReduce_59),
(60 , happyReduce_60),
(61 , happyReduce_61),
(62 , happyReduce_62),
(63 , happyReduce_63),
(64 , happyReduce_64),
(65 , happyReduce_65),
(66 , happyReduce_66),
(67 , happyReduce_67),
(68 , happyReduce_68),
(69 , happyReduce_69),
(70 , happyReduce_70),
(71 , happyReduce_71),
(72 , happyReduce_72),
(73 , happyReduce_73),
(74 , happyReduce_74),
(75 , happyReduce_75),
(76 , happyReduce_76),
(77 , happyReduce_77),
(78 , happyReduce_78),
(79 , happyReduce_79),
(80 , happyReduce_80),
(81 , happyReduce_81),
(82 , happyReduce_82),
(83 , happyReduce_83),
(84 , happyReduce_84),
(85 , happyReduce_85),
(86 , happyReduce_86),
(87 , happyReduce_87),
(88 , happyReduce_88),
(89 , happyReduce_89),
(90 , happyReduce_90),
(91 , happyReduce_91),
(92 , happyReduce_92),
(93 , happyReduce_93),
(94 , happyReduce_94),
(95 , happyReduce_95),
(96 , happyReduce_96),
(97 , happyReduce_97),
(98 , happyReduce_98),
(99 , happyReduce_99),
(100 , happyReduce_100),
(101 , happyReduce_101),
(102 , happyReduce_102),
(103 , happyReduce_103),
(104 , happyReduce_104),
(105 , happyReduce_105),
(106 , happyReduce_106),
(107 , happyReduce_107),
(108 , happyReduce_108),
(109 , happyReduce_109),
(110 , happyReduce_110),
(111 , happyReduce_111),
(112 , happyReduce_112),
(113 , happyReduce_113),
(114 , happyReduce_114),
(115 , happyReduce_115),
(116 , happyReduce_116),
(117 , happyReduce_117),
(118 , happyReduce_118),
(119 , happyReduce_119),
(120 , happyReduce_120),
(121 , happyReduce_121),
(122 , happyReduce_122),
(123 , happyReduce_123),
(124 , happyReduce_124),
(125 , happyReduce_125),
(126 , happyReduce_126),
(127 , happyReduce_127),
(128 , happyReduce_128),
(129 , happyReduce_129),
(130 , happyReduce_130),
(131 , happyReduce_131),
(132 , happyReduce_132),
(133 , happyReduce_133),
(134 , happyReduce_134),
(135 , happyReduce_135),
(136 , happyReduce_136),
(137 , happyReduce_137),
(138 , happyReduce_138),
(139 , happyReduce_139),
(140 , happyReduce_140),
(141 , happyReduce_141),
(142 , happyReduce_142),
(143 , happyReduce_143),
(144 , happyReduce_144),
(145 , happyReduce_145),
(146 , happyReduce_146),
(147 , happyReduce_147),
(148 , happyReduce_148),
(149 , happyReduce_149),
(150 , happyReduce_150),
(151 , happyReduce_151),
(152 , happyReduce_152),
(153 , happyReduce_153),
(154 , happyReduce_154),
(155 , happyReduce_155),
(156 , happyReduce_156),
(157 , happyReduce_157),
(158 , happyReduce_158),
(159 , happyReduce_159),
(160 , happyReduce_160),
(161 , happyReduce_161),
(162 , happyReduce_162),
(163 , happyReduce_163),
(164 , happyReduce_164),
(165 , happyReduce_165),
(166 , happyReduce_166),
(167 , happyReduce_167),
(168 , happyReduce_168),
(169 , happyReduce_169),
(170 , happyReduce_170),
(171 , happyReduce_171),
(172 , happyReduce_172),
(173 , happyReduce_173),
(174 , happyReduce_174),
(175 , happyReduce_175),
(176 , happyReduce_176),
(177 , happyReduce_177),
(178 , happyReduce_178),
(179 , happyReduce_179),
(180 , happyReduce_180),
(181 , happyReduce_181),
(182 , happyReduce_182),
(183 , happyReduce_183),
(184 , happyReduce_184),
(185 , happyReduce_185),
(186 , happyReduce_186),
(187 , happyReduce_187),
(188 , happyReduce_188),
(189 , happyReduce_189),
(190 , happyReduce_190),
(191 , happyReduce_191),
(192 , happyReduce_192),
(193 , happyReduce_193),
(194 , happyReduce_194),
(195 , happyReduce_195),
(196 , happyReduce_196),
(197 , happyReduce_197),
(198 , happyReduce_198),
(199 , happyReduce_199),
(200 , happyReduce_200),
(201 , happyReduce_201),
(202 , happyReduce_202),
(203 , happyReduce_203),
(204 , happyReduce_204),
(205 , happyReduce_205),
(206 , happyReduce_206),
(207 , happyReduce_207),
(208 , happyReduce_208),
(209 , happyReduce_209),
(210 , happyReduce_210),
(211 , happyReduce_211),
(212 , happyReduce_212),
(213 , happyReduce_213),
(214 , happyReduce_214),
(215 , happyReduce_215),
(216 , happyReduce_216),
(217 , happyReduce_217),
(218 , happyReduce_218),
(219 , happyReduce_219),
(220 , happyReduce_220),
(221 , happyReduce_221),
(222 , happyReduce_222),
(223 , happyReduce_223),
(224 , happyReduce_224),
(225 , happyReduce_225),
(226 , happyReduce_226),
(227 , happyReduce_227),
(228 , happyReduce_228),
(229 , happyReduce_229),
(230 , happyReduce_230),
(231 , happyReduce_231),
(232 , happyReduce_232),
(233 , happyReduce_233),
(234 , happyReduce_234),
(235 , happyReduce_235),
(236 , happyReduce_236),
(237 , happyReduce_237),
(238 , happyReduce_238),
(239 , happyReduce_239),
(240 , happyReduce_240),
(241 , happyReduce_241),
(242 , happyReduce_242),
(243 , happyReduce_243),
(244 , happyReduce_244),
(245 , happyReduce_245),
(246 , happyReduce_246),
(247 , happyReduce_247),
(248 , happyReduce_248),
(249 , happyReduce_249),
(250 , happyReduce_250),
(251 , happyReduce_251),
(252 , happyReduce_252),
(253 , happyReduce_253),
(254 , happyReduce_254),
(255 , happyReduce_255),
(256 , happyReduce_256),
(257 , happyReduce_257),
(258 , happyReduce_258),
(259 , happyReduce_259),
(260 , happyReduce_260),
(261 , happyReduce_261),
(262 , happyReduce_262),
(263 , happyReduce_263),
(264 , happyReduce_264),
(265 , happyReduce_265),
(266 , happyReduce_266),
(267 , happyReduce_267),
(268 , happyReduce_268),
(269 , happyReduce_269),
(270 , happyReduce_270),
(271 , happyReduce_271),
(272 , happyReduce_272),
(273 , happyReduce_273),
(274 , happyReduce_274),
(275 , happyReduce_275),
(276 , happyReduce_276),
(277 , happyReduce_277),
(278 , happyReduce_278),
(279 , happyReduce_279),
(280 , happyReduce_280),
(281 , happyReduce_281),
(282 , happyReduce_282),
(283 , happyReduce_283),
(284 , happyReduce_284),
(285 , happyReduce_285),
(286 , happyReduce_286),
(287 , happyReduce_287),
(288 , happyReduce_288),
(289 , happyReduce_289),
(290 , happyReduce_290),
(291 , happyReduce_291),
(292 , happyReduce_292),
(293 , happyReduce_293),
(294 , happyReduce_294),
(295 , happyReduce_295),
(296 , happyReduce_296),
(297 , happyReduce_297),
(298 , happyReduce_298),
(299 , happyReduce_299)
]
happy_n_terms = 97 :: Int
happy_n_nonterms = 71 :: Int
happyReduce_11 = happyReduce 6# 0# happyReduction_11
happyReduction_11 (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 happyOut80 happy_x_2 of { happy_var_2 ->
case happyOut15 happy_x_5 of { happy_var_5 ->
happyIn14
(let (is,ts) = happy_var_5 in Module happy_var_2 is ts
) `HappyStk` happyRest}}
happyReduce_12 = happySpecReduce_3 0# happyReduction_12
happyReduction_12 happy_x_3
happy_x_2
happy_x_1
= case happyOut15 happy_x_2 of { happy_var_2 ->
happyIn14
(let { (is,ts) = happy_var_2
-- XXX make a location from is and ts
; modName = Located { srcRange = emptyRange
, thing = ModName ["Main"]
}
} in Module modName is ts
)}
happyReduce_13 = happySpecReduce_3 1# happyReduction_13
happyReduction_13 happy_x_3
happy_x_2
happy_x_1
= case happyOut16 happy_x_1 of { happy_var_1 ->
case happyOut25 happy_x_3 of { happy_var_3 ->
happyIn15
((reverse happy_var_1, reverse happy_var_3)
)}}
happyReduce_14 = happySpecReduce_3 1# happyReduction_14
happyReduction_14 happy_x_3
happy_x_2
happy_x_1
= case happyOut16 happy_x_1 of { happy_var_1 ->
case happyOut25 happy_x_3 of { happy_var_3 ->
happyIn15
((reverse happy_var_1, reverse happy_var_3)
)}}
happyReduce_15 = happySpecReduce_1 1# happyReduction_15
happyReduction_15 happy_x_1
= case happyOut16 happy_x_1 of { happy_var_1 ->
happyIn15
((reverse happy_var_1, [])
)}
happyReduce_16 = happySpecReduce_1 1# happyReduction_16
happyReduction_16 happy_x_1
= case happyOut25 happy_x_1 of { happy_var_1 ->
happyIn15
(([], reverse happy_var_1)
)}
happyReduce_17 = happySpecReduce_0 1# happyReduction_17
happyReduction_17 = happyIn15
(([], [])
)
happyReduce_18 = happySpecReduce_3 2# happyReduction_18
happyReduction_18 happy_x_3
happy_x_2
happy_x_1
= case happyOut16 happy_x_1 of { happy_var_1 ->
case happyOut17 happy_x_3 of { happy_var_3 ->
happyIn16
(happy_var_3 : happy_var_1
)}}
happyReduce_19 = happySpecReduce_3 2# happyReduction_19
happyReduction_19 happy_x_3
happy_x_2
happy_x_1
= case happyOut16 happy_x_1 of { happy_var_1 ->
case happyOut17 happy_x_3 of { happy_var_3 ->
happyIn16
(happy_var_3 : happy_var_1
)}}
happyReduce_20 = happySpecReduce_1 2# happyReduction_20
happyReduction_20 happy_x_1
= case happyOut17 happy_x_1 of { happy_var_1 ->
happyIn16
([happy_var_1]
)}
happyReduce_21 = happyReduce 4# 3# happyReduction_21
happyReduction_21 (happy_x_4 `HappyStk`
happy_x_3 `HappyStk`
happy_x_2 `HappyStk`
happy_x_1 `HappyStk`
happyRest)
= case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (KW KW_import) _)) ->
case happyOut80 happy_x_2 of { happy_var_2 ->
case happyOut18 happy_x_3 of { happy_var_3 ->
case happyOut19 happy_x_4 of { happy_var_4 ->
happyIn17
(Located { srcRange = rComb happy_var_1
$ fromMaybe (srcRange happy_var_2)
$ msum [ fmap srcRange happy_var_4
, fmap srcRange happy_var_3
]
, thing = Import
{ iModule = thing happy_var_2
, iAs = fmap thing happy_var_3
, iSpec = fmap thing happy_var_4
}
}
) `HappyStk` happyRest}}}}
happyReduce_22 = happySpecReduce_2 4# happyReduction_22
happyReduction_22 happy_x_2
happy_x_1
= case happyOut80 happy_x_2 of { happy_var_2 ->
happyIn18
(Just happy_var_2
)}
happyReduce_23 = happySpecReduce_0 4# happyReduction_23
happyReduction_23 = happyIn18
(Nothing
)
happyReduce_24 = happyReduce 4# 5# happyReduction_24
happyReduction_24 (happy_x_4 `HappyStk`
happy_x_3 `HappyStk`
happy_x_2 `HappyStk`
happy_x_1 `HappyStk`
happyRest)
= case happyOut21 happy_x_1 of { happy_var_1 ->
case happyOut20 happy_x_3 of { happy_var_3 ->
happyIn19
(Just Located
{ srcRange = case happy_var_3 of
{ [] -> emptyRange
; xs -> rCombs (map srcRange xs) }
, thing = happy_var_1 (reverse (map thing happy_var_3))
}
) `HappyStk` happyRest}}
happyReduce_25 = happySpecReduce_0 5# happyReduction_25
happyReduction_25 = happyIn19
(Nothing
)
happyReduce_26 = happySpecReduce_3 6# happyReduction_26
happyReduction_26 happy_x_3
happy_x_2
happy_x_1
= case happyOut20 happy_x_1 of { happy_var_1 ->
case happyOut79 happy_x_3 of { happy_var_3 ->
happyIn20
(happy_var_3 : happy_var_1
)}}
happyReduce_27 = happySpecReduce_1 6# happyReduction_27
happyReduction_27 happy_x_1
= case happyOut79 happy_x_1 of { happy_var_1 ->
happyIn20
([happy_var_1]
)}
happyReduce_28 = happySpecReduce_0 6# happyReduction_28
happyReduction_28 = happyIn20
([]
)
happyReduce_29 = happySpecReduce_1 7# happyReduction_29
happyReduction_29 happy_x_1
= happyIn21
(Hiding
)
happyReduce_30 = happySpecReduce_0 7# happyReduction_30
happyReduction_30 = happyIn21
(Only
)
happyReduce_31 = happySpecReduce_1 8# happyReduction_31
happyReduction_31 happy_x_1
= case happyOut24 happy_x_1 of { happy_var_1 ->
happyIn22
(Program (reverse happy_var_1)
)}
happyReduce_32 = happySpecReduce_0 8# happyReduction_32
happyReduction_32 = happyIn22
(Program []
)
happyReduce_33 = happySpecReduce_3 9# happyReduction_33
happyReduction_33 happy_x_3
happy_x_2
happy_x_1
= case happyOut25 happy_x_2 of { happy_var_2 ->
happyIn23
(Program (reverse happy_var_2)
)}
happyReduce_34 = happySpecReduce_2 9# happyReduction_34
happyReduction_34 happy_x_2
happy_x_1
= happyIn23
(Program []
)
happyReduce_35 = happySpecReduce_2 10# happyReduction_35
happyReduction_35 happy_x_2
happy_x_1
= case happyOut27 happy_x_1 of { happy_var_1 ->
happyIn24
([happy_var_1]
)}
happyReduce_36 = happySpecReduce_3 10# happyReduction_36
happyReduction_36 happy_x_3
happy_x_2
happy_x_1
= case happyOut24 happy_x_1 of { happy_var_1 ->
case happyOut27 happy_x_2 of { happy_var_2 ->
happyIn24
(happy_var_2 : happy_var_1
)}}
happyReduce_37 = happySpecReduce_1 11# happyReduction_37
happyReduction_37 happy_x_1
= case happyOut26 happy_x_1 of { happy_var_1 ->
happyIn25
(happy_var_1
)}
happyReduce_38 = happySpecReduce_3 11# happyReduction_38
happyReduction_38 happy_x_3
happy_x_2
happy_x_1
= case happyOut25 happy_x_1 of { happy_var_1 ->
case happyOut26 happy_x_3 of { happy_var_3 ->
happyIn25
(happy_var_3 ++ happy_var_1
)}}
happyReduce_39 = happySpecReduce_3 11# happyReduction_39
happyReduction_39 happy_x_3
happy_x_2
happy_x_1
= case happyOut25 happy_x_1 of { happy_var_1 ->
case happyOut26 happy_x_3 of { happy_var_3 ->
happyIn25
(happy_var_3 ++ happy_var_1
)}}
happyReduce_40 = happySpecReduce_1 12# happyReduction_40
happyReduction_40 happy_x_1
= case happyOut28 happy_x_1 of { happy_var_1 ->
happyIn26
([exportDecl Public happy_var_1]
)}
happyReduce_41 = happyReduce 4# 12# happyReduction_41
happyReduction_41 (happy_x_4 `HappyStk`
happy_x_3 `HappyStk`
happy_x_2 `HappyStk`
happy_x_1 `HappyStk`
happyRest)
= case happyOut25 happy_x_3 of { happy_var_3 ->
happyIn26
(changeExport Private (reverse happy_var_3)
) `HappyStk` happyRest}
happyReduce_42 = happyMonadReduce 2# 12# happyReduction_42
happyReduction_42 (happy_x_2 `HappyStk`
happy_x_1 `HappyStk`
happyRest) tk
= happyThen (case happyOutTok happy_x_2 of { (happy_var_2@(Located _ (Token (StrLit {}) _))) ->
( (return . Include) `fmap` fromStrLit happy_var_2)}
) (\r -> happyReturn (happyIn26 r))
happyReduce_43 = happyReduce 5# 12# happyReduction_43
happyReduction_43 (happy_x_5 `HappyStk`
happy_x_4 `HappyStk`
happy_x_3 `HappyStk`
happy_x_2 `HappyStk`
happy_x_1 `HappyStk`
happyRest)
= case happyOut79 happy_x_2 of { happy_var_2 ->
case happyOut33 happy_x_3 of { happy_var_3 ->
case happyOut38 happy_x_5 of { happy_var_5 ->
happyIn26
([exportDecl Public (mkProperty happy_var_2 happy_var_3 happy_var_5)]
) `HappyStk` happyRest}}}
happyReduce_44 = happyReduce 4# 12# happyReduction_44
happyReduction_44 (happy_x_4 `HappyStk`
happy_x_3 `HappyStk`
happy_x_2 `HappyStk`
happy_x_1 `HappyStk`
happyRest)
= case happyOut79 happy_x_2 of { happy_var_2 ->
case happyOut38 happy_x_4 of { happy_var_4 ->
happyIn26
([exportDecl Public (mkProperty happy_var_2 [] happy_var_4)]
) `HappyStk` happyRest}}
happyReduce_45 = happySpecReduce_1 12# happyReduction_45
happyReduction_45 happy_x_1
= case happyOut30 happy_x_1 of { happy_var_1 ->
happyIn26
([exportNewtype Public happy_var_1]
)}
happyReduce_46 = happySpecReduce_1 13# happyReduction_46
happyReduction_46 happy_x_1
= case happyOut28 happy_x_1 of { happy_var_1 ->
happyIn27
(Decl (TopLevel {tlExport = Public, tlValue = happy_var_1})
)}
happyReduce_47 = happyMonadReduce 2# 13# happyReduction_47
happyReduction_47 (happy_x_2 `HappyStk`
happy_x_1 `HappyStk`
happyRest) tk
= happyThen (case happyOutTok happy_x_2 of { (happy_var_2@(Located _ (Token (StrLit {}) _))) ->
( Include `fmap` fromStrLit happy_var_2)}
) (\r -> happyReturn (happyIn27 r))
happyReduce_48 = happySpecReduce_3 14# happyReduction_48
happyReduction_48 happy_x_3
happy_x_2
happy_x_1
= case happyOut32 happy_x_1 of { happy_var_1 ->
case happyOut60 happy_x_3 of { happy_var_3 ->
happyIn28
(at (head happy_var_1,happy_var_3) $ DSignature (map (fmap mkUnqual) (reverse happy_var_1)) happy_var_3
)}}
happyReduce_49 = happySpecReduce_3 14# happyReduction_49
happyReduction_49 happy_x_3
happy_x_2
happy_x_1
= case happyOut56 happy_x_1 of { happy_var_1 ->
case happyOut38 happy_x_3 of { happy_var_3 ->
happyIn28
(at (happy_var_1,happy_var_3) $ DPatBind happy_var_1 happy_var_3
)}}
happyReduce_50 = happyReduce 4# 14# happyReduction_50
happyReduction_50 (happy_x_4 `HappyStk`
happy_x_3 `HappyStk`
happy_x_2 `HappyStk`
happy_x_1 `HappyStk`
happyRest)
= case happyOut79 happy_x_1 of { happy_var_1 ->
case happyOut33 happy_x_2 of { happy_var_2 ->
case happyOut38 happy_x_4 of { happy_var_4 ->
happyIn28
(at (happy_var_1,happy_var_4) $
DBind $ Bind { bName = fmap mkUnqual happy_var_1
, bParams = reverse happy_var_2
, bDef = happy_var_4
, bSignature = Nothing
, bPragmas = []
, bMono = False
}
) `HappyStk` happyRest}}}
happyReduce_51 = happyMonadReduce 4# 14# happyReduction_51
happyReduction_51 (happy_x_4 `HappyStk`
happy_x_3 `HappyStk`
happy_x_2 `HappyStk`
happy_x_1 `HappyStk`
happyRest) tk
= happyThen (case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (KW KW_type ) _)) ->
case happyOut79 happy_x_2 of { happy_var_2 ->
case happyOut70 happy_x_4 of { happy_var_4 ->
( at (happy_var_1,happy_var_4) `fmap` mkTySyn happy_var_2 [] happy_var_4)}}}
) (\r -> happyReturn (happyIn28 r))
happyReduce_52 = happyMonadReduce 5# 14# happyReduction_52
happyReduction_52 (happy_x_5 `HappyStk`
happy_x_4 `HappyStk`
happy_x_3 `HappyStk`
happy_x_2 `HappyStk`
happy_x_1 `HappyStk`
happyRest) tk
= happyThen (case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (KW KW_type ) _)) ->
case happyOut79 happy_x_2 of { happy_var_2 ->
case happyOut67 happy_x_3 of { happy_var_3 ->
case happyOut70 happy_x_5 of { happy_var_5 ->
( at (happy_var_1,happy_var_5) `fmap` mkTySyn happy_var_2 (reverse happy_var_3) happy_var_5)}}}}
) (\r -> happyReturn (happyIn28 r))
happyReduce_53 = happyReduce 4# 15# happyReduction_53
happyReduction_53 (happy_x_4 `HappyStk`
happy_x_3 `HappyStk`
happy_x_2 `HappyStk`
happy_x_1 `HappyStk`
happyRest)
= case happyOut56 happy_x_2 of { happy_var_2 ->
case happyOut38 happy_x_4 of { happy_var_4 ->
happyIn29
(at (happy_var_2,happy_var_4) $ DPatBind happy_var_2 happy_var_4
) `HappyStk` happyRest}}
happyReduce_54 = happyReduce 5# 15# happyReduction_54
happyReduction_54 (happy_x_5 `HappyStk`
happy_x_4 `HappyStk`
happy_x_3 `HappyStk`
happy_x_2 `HappyStk`
happy_x_1 `HappyStk`
happyRest)
= case happyOut79 happy_x_2 of { happy_var_2 ->
case happyOut33 happy_x_3 of { happy_var_3 ->
case happyOut38 happy_x_5 of { happy_var_5 ->
happyIn29
(at (happy_var_2,happy_var_5) $
DBind $ Bind { bName = fmap mkUnqual happy_var_2
, bParams = reverse happy_var_3
, bDef = happy_var_5
, bSignature = Nothing
, bPragmas = []
, bMono = False
}
) `HappyStk` happyRest}}}
happyReduce_55 = happyReduce 4# 16# happyReduction_55
happyReduction_55 (happy_x_4 `HappyStk`
happy_x_3 `HappyStk`
happy_x_2 `HappyStk`
happy_x_1 `HappyStk`
happyRest)
= case happyOut81 happy_x_2 of { happy_var_2 ->
case happyOut31 happy_x_4 of { happy_var_4 ->
happyIn30
(Newtype { nName = happy_var_2, nParams = [], nBody = happy_var_4 }
) `HappyStk` happyRest}}
happyReduce_56 = happyReduce 5# 16# happyReduction_56
happyReduction_56 (happy_x_5 `HappyStk`
happy_x_4 `HappyStk`
happy_x_3 `HappyStk`
happy_x_2 `HappyStk`
happy_x_1 `HappyStk`
happyRest)
= case happyOut81 happy_x_2 of { happy_var_2 ->
case happyOut67 happy_x_3 of { happy_var_3 ->
case happyOut31 happy_x_5 of { happy_var_5 ->
happyIn30
(Newtype { nName = happy_var_2, nParams = happy_var_3, nBody = happy_var_5 }
) `HappyStk` happyRest}}}
happyReduce_57 = happySpecReduce_2 17# happyReduction_57
happyReduction_57 happy_x_2
happy_x_1
= happyIn31
([]
)
happyReduce_58 = happySpecReduce_3 17# happyReduction_58
happyReduction_58 happy_x_3
happy_x_2
happy_x_1
= case happyOut77 happy_x_2 of { happy_var_2 ->
happyIn31
(happy_var_2
)}
happyReduce_59 = happySpecReduce_1 18# happyReduction_59
happyReduction_59 happy_x_1
= case happyOut79 happy_x_1 of { happy_var_1 ->
happyIn32
([ happy_var_1]
)}
happyReduce_60 = happySpecReduce_3 18# happyReduction_60
happyReduction_60 happy_x_3
happy_x_2
happy_x_1
= case happyOut32 happy_x_1 of { happy_var_1 ->
case happyOut79 happy_x_3 of { happy_var_3 ->
happyIn32
(happy_var_3 : happy_var_1
)}}
happyReduce_61 = happySpecReduce_1 19# happyReduction_61
happyReduction_61 happy_x_1
= case happyOut56 happy_x_1 of { happy_var_1 ->
happyIn33
([happy_var_1]
)}
happyReduce_62 = happySpecReduce_2 19# happyReduction_62
happyReduction_62 happy_x_2
happy_x_1
= case happyOut33 happy_x_1 of { happy_var_1 ->
case happyOut56 happy_x_2 of { happy_var_2 ->
happyIn33
(happy_var_2 : happy_var_1
)}}
happyReduce_63 = happySpecReduce_2 20# happyReduction_63
happyReduction_63 happy_x_2
happy_x_1
= case happyOut28 happy_x_1 of { happy_var_1 ->
happyIn34
([happy_var_1]
)}
happyReduce_64 = happySpecReduce_3 20# happyReduction_64
happyReduction_64 happy_x_3
happy_x_2
happy_x_1
= case happyOut34 happy_x_1 of { happy_var_1 ->
case happyOut28 happy_x_2 of { happy_var_2 ->
happyIn34
(happy_var_2 : happy_var_1
)}}
happyReduce_65 = happySpecReduce_1 21# happyReduction_65
happyReduction_65 happy_x_1
= case happyOut28 happy_x_1 of { happy_var_1 ->
happyIn35
([happy_var_1]
)}
happyReduce_66 = happySpecReduce_3 21# happyReduction_66
happyReduction_66 happy_x_3
happy_x_2
happy_x_1
= case happyOut35 happy_x_1 of { happy_var_1 ->
case happyOut28 happy_x_3 of { happy_var_3 ->
happyIn35
(happy_var_3 : happy_var_1
)}}
happyReduce_67 = happySpecReduce_3 21# happyReduction_67
happyReduction_67 happy_x_3
happy_x_2
happy_x_1
= case happyOut35 happy_x_1 of { happy_var_1 ->
case happyOut28 happy_x_3 of { happy_var_3 ->
happyIn35
(happy_var_3 : happy_var_1
)}}
happyReduce_68 = happySpecReduce_3 22# happyReduction_68
happyReduction_68 happy_x_3
happy_x_2
happy_x_1
= case happyOut35 happy_x_2 of { happy_var_2 ->
happyIn36
(happy_var_2
)}
happyReduce_69 = happySpecReduce_2 22# happyReduction_69
happyReduction_69 happy_x_2
happy_x_1
= happyIn36
([]
)
happyReduce_70 = happySpecReduce_1 23# happyReduction_70
happyReduction_70 happy_x_1
= case happyOut38 happy_x_1 of { happy_var_1 ->
happyIn37
(ExprInput happy_var_1
)}
happyReduce_71 = happySpecReduce_1 23# happyReduction_71
happyReduction_71 happy_x_1
= case happyOut29 happy_x_1 of { happy_var_1 ->
happyIn37
(LetInput happy_var_1
)}
happyReduce_72 = happySpecReduce_1 24# happyReduction_72
happyReduction_72 happy_x_1
= case happyOut41 happy_x_1 of { happy_var_1 ->
happyIn38
(happy_var_1
)}
happyReduce_73 = happyReduce 4# 24# happyReduction_73
happyReduction_73 (happy_x_4 `HappyStk`
happy_x_3 `HappyStk`
happy_x_2 `HappyStk`
happy_x_1 `HappyStk`
happyRest)
= case happyOut38 happy_x_1 of { happy_var_1 ->
case happyOutTok happy_x_4 of { (Located happy_var_4 (Token (Sym CurlyR ) _)) ->
happyIn38
(at (happy_var_1,happy_var_4) $ EWhere happy_var_1 []
) `HappyStk` happyRest}}
happyReduce_74 = happyReduce 5# 24# happyReduction_74
happyReduction_74 (happy_x_5 `HappyStk`
happy_x_4 `HappyStk`
happy_x_3 `HappyStk`
happy_x_2 `HappyStk`
happy_x_1 `HappyStk`
happyRest)
= case happyOut38 happy_x_1 of { happy_var_1 ->
case happyOut34 happy_x_4 of { happy_var_4 ->
case happyOutTok happy_x_5 of { (Located happy_var_5 (Token (Sym CurlyR ) _)) ->
happyIn38
(at (happy_var_1,happy_var_5) $ EWhere happy_var_1 (reverse happy_var_4)
) `HappyStk` happyRest}}}
happyReduce_75 = happyReduce 4# 24# happyReduction_75
happyReduction_75 (happy_x_4 `HappyStk`
happy_x_3 `HappyStk`
happy_x_2 `HappyStk`
happy_x_1 `HappyStk`
happyRest)
= case happyOut38 happy_x_1 of { happy_var_1 ->
case happyOutTok happy_x_2 of { (Located happy_var_2 (Token (KW KW_where ) _)) ->
happyIn38
(at (happy_var_1,happy_var_2) $ EWhere happy_var_1 []
) `HappyStk` happyRest}}
happyReduce_76 = happyReduce 5# 24# happyReduction_76
happyReduction_76 (happy_x_5 `HappyStk`
happy_x_4 `HappyStk`
happy_x_3 `HappyStk`
happy_x_2 `HappyStk`
happy_x_1 `HappyStk`
happyRest)
= case happyOut38 happy_x_1 of { happy_var_1 ->
case happyOut35 happy_x_4 of { happy_var_4 ->
happyIn38
(at (happy_var_1,happy_var_4) $ EWhere happy_var_1 (reverse happy_var_4)
) `HappyStk` happyRest}}
happyReduce_77 = happySpecReduce_1 25# happyReduction_77
happyReduction_77 happy_x_1
= case happyOut40 happy_x_1 of { happy_var_1 ->
happyIn39
([happy_var_1]
)}
happyReduce_78 = happySpecReduce_3 25# happyReduction_78
happyReduction_78 happy_x_3
happy_x_2
happy_x_1
= case happyOut39 happy_x_1 of { happy_var_1 ->
case happyOut40 happy_x_3 of { happy_var_3 ->
happyIn39
(happy_var_3 : happy_var_1
)}}
happyReduce_79 = happySpecReduce_3 26# happyReduction_79
happyReduction_79 happy_x_3
happy_x_2
happy_x_1
= case happyOut38 happy_x_1 of { happy_var_1 ->
case happyOut38 happy_x_3 of { happy_var_3 ->
happyIn40
((happy_var_1, happy_var_3)
)}}
happyReduce_80 = happySpecReduce_1 27# happyReduction_80
happyReduction_80 happy_x_1
= case happyOut42 happy_x_1 of { happy_var_1 ->
happyIn41
(mkEApp happy_var_1
)}
happyReduce_81 = happySpecReduce_3 27# happyReduction_81
happyReduction_81 happy_x_3
happy_x_2
happy_x_1
= case happyOut41 happy_x_1 of { happy_var_1 ->
case happyOut70 happy_x_3 of { happy_var_3 ->
happyIn41
(at (happy_var_1,happy_var_3) $ ETyped happy_var_1 happy_var_3
)}}
happyReduce_82 = happyReduce 4# 27# happyReduction_82
happyReduction_82 (happy_x_4 `HappyStk`
happy_x_3 `HappyStk`
happy_x_2 `HappyStk`
happy_x_1 `HappyStk`
happyRest)
= case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (KW KW_if ) _)) ->
case happyOut39 happy_x_2 of { happy_var_2 ->
case happyOut41 happy_x_4 of { happy_var_4 ->
happyIn41
(at (happy_var_1,happy_var_4) $ mkIf happy_var_2 happy_var_4
) `HappyStk` happyRest}}}
happyReduce_83 = happyReduce 4# 27# happyReduction_83
happyReduction_83 (happy_x_4 `HappyStk`
happy_x_3 `HappyStk`
happy_x_2 `HappyStk`
happy_x_1 `HappyStk`
happyRest)
= case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (Sym Lambda ) _)) ->
case happyOut33 happy_x_2 of { happy_var_2 ->
case happyOut41 happy_x_4 of { happy_var_4 ->
happyIn41
(at (happy_var_1,happy_var_4) $ EFun (reverse happy_var_2) happy_var_4
) `HappyStk` happyRest}}}
happyReduce_84 = happySpecReduce_3 27# happyReduction_84
happyReduction_84 happy_x_3
happy_x_2
happy_x_1
= case happyOut41 happy_x_1 of { happy_var_1 ->
case happyOutTok happy_x_2 of { (Located happy_var_2 (Token (Op At ) _)) ->
case happyOut41 happy_x_3 of { happy_var_3 ->
happyIn41
(binOp happy_var_1 (op ECAt happy_var_2) happy_var_3
)}}}
happyReduce_85 = happySpecReduce_3 27# happyReduction_85
happyReduction_85 happy_x_3
happy_x_2
happy_x_1
= case happyOut41 happy_x_1 of { happy_var_1 ->
case happyOutTok happy_x_2 of { (Located happy_var_2 (Token (Op AtAt ) _)) ->
case happyOut41 happy_x_3 of { happy_var_3 ->
happyIn41
(binOp happy_var_1 (op ECAtRange happy_var_2) happy_var_3
)}}}
happyReduce_86 = happySpecReduce_3 27# happyReduction_86
happyReduction_86 happy_x_3
happy_x_2
happy_x_1
= case happyOut41 happy_x_1 of { happy_var_1 ->
case happyOutTok happy_x_2 of { (Located happy_var_2 (Token (Op Bang ) _)) ->
case happyOut41 happy_x_3 of { happy_var_3 ->
happyIn41
(binOp happy_var_1 (op ECAtBack happy_var_2) happy_var_3
)}}}
happyReduce_87 = happySpecReduce_3 27# happyReduction_87
happyReduction_87 happy_x_3
happy_x_2
happy_x_1
= case happyOut41 happy_x_1 of { happy_var_1 ->
case happyOutTok happy_x_2 of { (Located happy_var_2 (Token (Op BangBang ) _)) ->
case happyOut41 happy_x_3 of { happy_var_3 ->
happyIn41
(binOp happy_var_1 (op ECAtRangeBack happy_var_2) happy_var_3
)}}}
happyReduce_88 = happySpecReduce_3 27# happyReduction_88
happyReduction_88 happy_x_3
happy_x_2
happy_x_1
= case happyOut41 happy_x_1 of { happy_var_1 ->
case happyOutTok happy_x_2 of { (Located happy_var_2 (Token (Op Hash ) _)) ->
case happyOut41 happy_x_3 of { happy_var_3 ->
happyIn41
(binOp happy_var_1 (op ECCat happy_var_2) happy_var_3
)}}}
happyReduce_89 = happySpecReduce_3 27# happyReduction_89
happyReduction_89 happy_x_3
happy_x_2
happy_x_1
= case happyOut41 happy_x_1 of { happy_var_1 ->
case happyOutTok happy_x_2 of { (Located happy_var_2 (Token (Op Plus ) _)) ->
case happyOut41 happy_x_3 of { happy_var_3 ->
happyIn41
(binOp happy_var_1 (op ECPlus happy_var_2) happy_var_3
)}}}
happyReduce_90 = happySpecReduce_3 27# happyReduction_90
happyReduction_90 happy_x_3
happy_x_2
happy_x_1
= case happyOut41 happy_x_1 of { happy_var_1 ->
case happyOutTok happy_x_2 of { (Located happy_var_2 (Token (Op Minus ) _)) ->
case happyOut41 happy_x_3 of { happy_var_3 ->
happyIn41
(binOp happy_var_1 (op ECMinus happy_var_2) happy_var_3
)}}}
happyReduce_91 = happySpecReduce_3 27# happyReduction_91
happyReduction_91 happy_x_3
happy_x_2
happy_x_1
= case happyOut41 happy_x_1 of { happy_var_1 ->
case happyOutTok happy_x_2 of { (Located happy_var_2 (Token (Op Mul ) _)) ->
case happyOut41 happy_x_3 of { happy_var_3 ->
happyIn41
(binOp happy_var_1 (op ECMul happy_var_2) happy_var_3
)}}}
happyReduce_92 = happySpecReduce_3 27# happyReduction_92
happyReduction_92 happy_x_3
happy_x_2
happy_x_1
= case happyOut41 happy_x_1 of { happy_var_1 ->
case happyOutTok happy_x_2 of { (Located happy_var_2 (Token (Op Div ) _)) ->
case happyOut41 happy_x_3 of { happy_var_3 ->
happyIn41
(binOp happy_var_1 (op ECDiv happy_var_2) happy_var_3
)}}}
happyReduce_93 = happySpecReduce_3 27# happyReduction_93
happyReduction_93 happy_x_3
happy_x_2
happy_x_1
= case happyOut41 happy_x_1 of { happy_var_1 ->
case happyOutTok happy_x_2 of { (Located happy_var_2 (Token (Op Mod ) _)) ->
case happyOut41 happy_x_3 of { happy_var_3 ->
happyIn41
(binOp happy_var_1 (op ECMod happy_var_2) happy_var_3
)}}}
happyReduce_94 = happySpecReduce_3 27# happyReduction_94
happyReduction_94 happy_x_3
happy_x_2
happy_x_1
= case happyOut41 happy_x_1 of { happy_var_1 ->
case happyOutTok happy_x_2 of { (Located happy_var_2 (Token (Op Exp ) _)) ->
case happyOut41 happy_x_3 of { happy_var_3 ->
happyIn41
(binOp happy_var_1 (op ECExp happy_var_2) happy_var_3
)}}}
happyReduce_95 = happySpecReduce_3 27# happyReduction_95
happyReduction_95 happy_x_3
happy_x_2
happy_x_1
= case happyOut41 happy_x_1 of { happy_var_1 ->
case happyOutTok happy_x_2 of { (Located happy_var_2 (Token (Op Xor ) _)) ->
case happyOut41 happy_x_3 of { happy_var_3 ->
happyIn41
(binOp happy_var_1 (op ECXor happy_var_2) happy_var_3
)}}}
happyReduce_96 = happySpecReduce_3 27# happyReduction_96
happyReduction_96 happy_x_3
happy_x_2
happy_x_1
= case happyOut41 happy_x_1 of { happy_var_1 ->
case happyOutTok happy_x_2 of { (Located happy_var_2 (Token (Op Disj ) _)) ->
case happyOut41 happy_x_3 of { happy_var_3 ->
happyIn41
(binOp happy_var_1 (op ECOr happy_var_2) happy_var_3
)}}}
happyReduce_97 = happySpecReduce_3 27# happyReduction_97
happyReduction_97 happy_x_3
happy_x_2
happy_x_1
= case happyOut41 happy_x_1 of { happy_var_1 ->
case happyOutTok happy_x_2 of { (Located happy_var_2 (Token (Op Conj ) _)) ->
case happyOut41 happy_x_3 of { happy_var_3 ->
happyIn41
(binOp happy_var_1 (op ECAnd happy_var_2) happy_var_3
)}}}
happyReduce_98 = happySpecReduce_3 27# happyReduction_98
happyReduction_98 happy_x_3
happy_x_2
happy_x_1
= case happyOut41 happy_x_1 of { happy_var_1 ->
case happyOutTok happy_x_2 of { (Located happy_var_2 (Token (Op Equal ) _)) ->
case happyOut41 happy_x_3 of { happy_var_3 ->
happyIn41
(binOp happy_var_1 (op ECEq happy_var_2) happy_var_3
)}}}
happyReduce_99 = happySpecReduce_3 27# happyReduction_99
happyReduction_99 happy_x_3
happy_x_2
happy_x_1
= case happyOut41 happy_x_1 of { happy_var_1 ->
case happyOutTok happy_x_2 of { (Located happy_var_2 (Token (Op NotEqual ) _)) ->
case happyOut41 happy_x_3 of { happy_var_3 ->
happyIn41
(binOp happy_var_1 (op ECNotEq happy_var_2) happy_var_3
)}}}
happyReduce_100 = happySpecReduce_3 27# happyReduction_100
happyReduction_100 happy_x_3
happy_x_2
happy_x_1
= case happyOut41 happy_x_1 of { happy_var_1 ->
case happyOutTok happy_x_2 of { (Located happy_var_2 (Token (Op EqualFun ) _)) ->
case happyOut41 happy_x_3 of { happy_var_3 ->
happyIn41
(binOp happy_var_1 (op ECFunEq happy_var_2) happy_var_3
)}}}
happyReduce_101 = happySpecReduce_3 27# happyReduction_101
happyReduction_101 happy_x_3
happy_x_2
happy_x_1
= case happyOut41 happy_x_1 of { happy_var_1 ->
case happyOutTok happy_x_2 of { (Located happy_var_2 (Token (Op NotEqualFun ) _)) ->
case happyOut41 happy_x_3 of { happy_var_3 ->
happyIn41
(binOp happy_var_1 (op ECFunNotEq happy_var_2) happy_var_3
)}}}
happyReduce_102 = happySpecReduce_3 27# happyReduction_102
happyReduction_102 happy_x_3
happy_x_2
happy_x_1
= case happyOut41 happy_x_1 of { happy_var_1 ->
case happyOutTok happy_x_2 of { (Located happy_var_2 (Token (Op GreaterThan ) _)) ->
case happyOut41 happy_x_3 of { happy_var_3 ->
happyIn41
(binOp happy_var_1 (op ECGt happy_var_2) happy_var_3
)}}}
happyReduce_103 = happySpecReduce_3 27# happyReduction_103
happyReduction_103 happy_x_3
happy_x_2
happy_x_1
= case happyOut41 happy_x_1 of { happy_var_1 ->
case happyOutTok happy_x_2 of { (Located happy_var_2 (Token (Op LessThan ) _)) ->
case happyOut41 happy_x_3 of { happy_var_3 ->
happyIn41
(binOp happy_var_1 (op ECLt happy_var_2) happy_var_3
)}}}
happyReduce_104 = happySpecReduce_3 27# happyReduction_104
happyReduction_104 happy_x_3
happy_x_2
happy_x_1
= case happyOut41 happy_x_1 of { happy_var_1 ->
case happyOutTok happy_x_2 of { (Located happy_var_2 (Token (Op LEQ ) _)) ->
case happyOut41 happy_x_3 of { happy_var_3 ->
happyIn41
(binOp happy_var_1 (op ECLtEq happy_var_2) happy_var_3
)}}}
happyReduce_105 = happySpecReduce_3 27# happyReduction_105
happyReduction_105 happy_x_3
happy_x_2
happy_x_1
= case happyOut41 happy_x_1 of { happy_var_1 ->
case happyOutTok happy_x_2 of { (Located happy_var_2 (Token (Op GEQ ) _)) ->
case happyOut41 happy_x_3 of { happy_var_3 ->
happyIn41
(binOp happy_var_1 (op ECGtEq happy_var_2) happy_var_3
)}}}
happyReduce_106 = happySpecReduce_3 27# happyReduction_106
happyReduction_106 happy_x_3
happy_x_2
happy_x_1
= case happyOut41 happy_x_1 of { happy_var_1 ->
case happyOutTok happy_x_2 of { (Located happy_var_2 (Token (Op ShiftL ) _)) ->
case happyOut41 happy_x_3 of { happy_var_3 ->
happyIn41
(binOp happy_var_1 (op ECShiftL happy_var_2) happy_var_3
)}}}
happyReduce_107 = happySpecReduce_3 27# happyReduction_107
happyReduction_107 happy_x_3
happy_x_2
happy_x_1
= case happyOut41 happy_x_1 of { happy_var_1 ->
case happyOutTok happy_x_2 of { (Located happy_var_2 (Token (Op ShiftR ) _)) ->
case happyOut41 happy_x_3 of { happy_var_3 ->
happyIn41
(binOp happy_var_1 (op ECShiftR happy_var_2) happy_var_3
)}}}
happyReduce_108 = happySpecReduce_3 27# happyReduction_108
happyReduction_108 happy_x_3
happy_x_2
happy_x_1
= case happyOut41 happy_x_1 of { happy_var_1 ->
case happyOutTok happy_x_2 of { (Located happy_var_2 (Token (Op RotL ) _)) ->
case happyOut41 happy_x_3 of { happy_var_3 ->
happyIn41
(binOp happy_var_1 (op ECRotL happy_var_2) happy_var_3
)}}}
happyReduce_109 = happySpecReduce_3 27# happyReduction_109
happyReduction_109 happy_x_3
happy_x_2
happy_x_1
= case happyOut41 happy_x_1 of { happy_var_1 ->
case happyOutTok happy_x_2 of { (Located happy_var_2 (Token (Op RotR ) _)) ->
case happyOut41 happy_x_3 of { happy_var_3 ->
happyIn41
(binOp happy_var_1 (op ECRotR happy_var_2) happy_var_3
)}}}
happyReduce_110 = happySpecReduce_2 27# happyReduction_110
happyReduction_110 happy_x_2
happy_x_1
= case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (Op Minus ) _)) ->
case happyOut41 happy_x_2 of { happy_var_2 ->
happyIn41
(unOp (op ECNeg happy_var_1) happy_var_2
)}}
happyReduce_111 = happySpecReduce_2 27# happyReduction_111
happyReduction_111 happy_x_2
happy_x_1
= case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (Op Complement ) _)) ->
case happyOut41 happy_x_2 of { happy_var_2 ->
happyIn41
(unOp (op ECCompl happy_var_1) happy_var_2
)}}
happyReduce_112 = happySpecReduce_1 28# happyReduction_112
happyReduction_112 happy_x_1
= case happyOut43 happy_x_1 of { happy_var_1 ->
happyIn42
([happy_var_1]
)}
happyReduce_113 = happySpecReduce_2 28# happyReduction_113
happyReduction_113 happy_x_2
happy_x_1
= case happyOut42 happy_x_1 of { happy_var_1 ->
case happyOut43 happy_x_2 of { happy_var_2 ->
happyIn42
(happy_var_2 : happy_var_1
)}}
happyReduce_114 = happySpecReduce_1 29# happyReduction_114
happyReduction_114 happy_x_1
= case happyOut81 happy_x_1 of { happy_var_1 ->
happyIn43
(at happy_var_1 $ EVar (thing happy_var_1)
)}
happyReduce_115 = happySpecReduce_1 29# happyReduction_115
happyReduction_115 happy_x_1
= case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (KW KW_min ) _)) ->
happyIn43
(at happy_var_1 $ ECon ECMin
)}
happyReduce_116 = happySpecReduce_1 29# happyReduction_116
happyReduction_116 happy_x_1
= case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (KW KW_max ) _)) ->
happyIn43
(at happy_var_1 $ ECon ECMax
)}
happyReduce_117 = happySpecReduce_1 29# happyReduction_117
happyReduction_117 happy_x_1
= case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (KW KW_lg2 ) _)) ->
happyIn43
(at happy_var_1 $ ECon ECLg2
)}
happyReduce_118 = happySpecReduce_1 29# happyReduction_118
happyReduction_118 happy_x_1
= case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (KW KW_zero ) _)) ->
happyIn43
(at happy_var_1 $ ECon ECZero
)}
happyReduce_119 = happySpecReduce_1 29# happyReduction_119
happyReduction_119 happy_x_1
= case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (KW KW_join ) _)) ->
happyIn43
(at happy_var_1 $ ECon ECJoin
)}
happyReduce_120 = happySpecReduce_1 29# happyReduction_120
happyReduction_120 happy_x_1
= case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (KW KW_split ) _)) ->
happyIn43
(at happy_var_1 $ ECon ECSplit
)}
happyReduce_121 = happySpecReduce_1 29# happyReduction_121
happyReduction_121 happy_x_1
= case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (KW KW_splitAt) _)) ->
happyIn43
(at happy_var_1 $ ECon ECSplitAt
)}
happyReduce_122 = happySpecReduce_1 29# happyReduction_122
happyReduction_122 happy_x_1
= case happyOutTok happy_x_1 of { (happy_var_1@(Located _ (Token (Num {}) _))) ->
happyIn43
(at happy_var_1 $ numLit (tokenType (thing happy_var_1))
)}
happyReduce_123 = happySpecReduce_1 29# happyReduction_123
happyReduction_123 happy_x_1
= case happyOutTok happy_x_1 of { (happy_var_1@(Located _ (Token (StrLit {}) _))) ->
happyIn43
(at happy_var_1 $ ELit $ ECString $ getStr happy_var_1
)}
happyReduce_124 = happySpecReduce_1 29# happyReduction_124
happyReduction_124 happy_x_1
= case happyOutTok happy_x_1 of { (happy_var_1@(Located _ (Token (ChrLit {}) _))) ->
happyIn43
(at happy_var_1 $ ELit $ ECNum (getNum happy_var_1) CharLit
)}
happyReduce_125 = happySpecReduce_1 29# happyReduction_125
happyReduction_125 happy_x_1
= case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (KW KW_False ) _)) ->
happyIn43
(at happy_var_1 $ ECon ECFalse
)}
happyReduce_126 = happySpecReduce_1 29# happyReduction_126
happyReduction_126 happy_x_1
= case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (KW KW_True ) _)) ->
happyIn43
(at happy_var_1 $ ECon ECTrue
)}
happyReduce_127 = happySpecReduce_1 29# happyReduction_127
happyReduction_127 happy_x_1
= case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (KW KW_error ) _)) ->
happyIn43
(at happy_var_1 $ ECon ECError
)}
happyReduce_128 = happySpecReduce_1 29# happyReduction_128
happyReduction_128 happy_x_1
= case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (KW KW_reverse) _)) ->
happyIn43
(at happy_var_1 $ ECon ECReverse
)}
happyReduce_129 = happySpecReduce_1 29# happyReduction_129
happyReduction_129 happy_x_1
= case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (KW KW_transpose) _)) ->
happyIn43
(at happy_var_1 $ ECon ECTranspose
)}
happyReduce_130 = happySpecReduce_1 29# happyReduction_130
happyReduction_130 happy_x_1
= case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (KW KW_pmult) _)) ->
happyIn43
(at happy_var_1 $ ECon ECPMul
)}
happyReduce_131 = happySpecReduce_1 29# happyReduction_131
happyReduction_131 happy_x_1
= case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (KW KW_pdiv) _)) ->
happyIn43
(at happy_var_1 $ ECon ECPDiv
)}
happyReduce_132 = happySpecReduce_1 29# happyReduction_132
happyReduction_132 happy_x_1
= case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (KW KW_pmod) _)) ->
happyIn43
(at happy_var_1 $ ECon ECPMod
)}
happyReduce_133 = happySpecReduce_1 29# happyReduction_133
happyReduction_133 happy_x_1
= case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (KW KW_random) _)) ->
happyIn43
(at happy_var_1 $ ECon ECRandom
)}
happyReduce_134 = happySpecReduce_3 29# happyReduction_134
happyReduction_134 happy_x_3
happy_x_2
happy_x_1
= case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (Sym ParenL ) _)) ->
case happyOut38 happy_x_2 of { happy_var_2 ->
case happyOutTok happy_x_3 of { (Located happy_var_3 (Token (Sym ParenR ) _)) ->
happyIn43
(at (happy_var_1,happy_var_3) happy_var_2
)}}}
happyReduce_135 = happySpecReduce_3 29# happyReduction_135
happyReduction_135 happy_x_3
happy_x_2
happy_x_1
= case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (Sym ParenL ) _)) ->
case happyOut47 happy_x_2 of { happy_var_2 ->
case happyOutTok happy_x_3 of { (Located happy_var_3 (Token (Sym ParenR ) _)) ->
happyIn43
(at (happy_var_1,happy_var_3) $ ETuple (reverse happy_var_2)
)}}}
happyReduce_136 = happySpecReduce_2 29# happyReduction_136
happyReduction_136 happy_x_2
happy_x_1
= case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (Sym ParenL ) _)) ->
case happyOutTok happy_x_2 of { (Located happy_var_2 (Token (Sym ParenR ) _)) ->
happyIn43
(at (happy_var_1,happy_var_2) $ ETuple []
)}}
happyReduce_137 = happySpecReduce_2 29# happyReduction_137
happyReduction_137 happy_x_2
happy_x_1
= case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (Sym CurlyL ) _)) ->
case happyOutTok happy_x_2 of { (Located happy_var_2 (Token (Sym CurlyR ) _)) ->
happyIn43
(at (happy_var_1,happy_var_2) $ ERecord []
)}}
happyReduce_138 = happySpecReduce_3 29# happyReduction_138
happyReduction_138 happy_x_3
happy_x_2
happy_x_1
= case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (Sym CurlyL ) _)) ->
case happyOut49 happy_x_2 of { happy_var_2 ->
case happyOutTok happy_x_3 of { (Located happy_var_3 (Token (Sym CurlyR ) _)) ->
happyIn43
(at (happy_var_1,happy_var_3) $ ERecord (reverse happy_var_2)
)}}}
happyReduce_139 = happySpecReduce_2 29# happyReduction_139
happyReduction_139 happy_x_2
happy_x_1
= case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (Sym BracketL) _)) ->
case happyOutTok happy_x_2 of { (Located happy_var_2 (Token (Sym BracketR) _)) ->
happyIn43
(at (happy_var_1,happy_var_2) $ EList []
)}}
happyReduce_140 = happySpecReduce_3 29# happyReduction_140
happyReduction_140 happy_x_3
happy_x_2
happy_x_1
= case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (Sym BracketL) _)) ->
case happyOut50 happy_x_2 of { happy_var_2 ->
case happyOutTok happy_x_3 of { (Located happy_var_3 (Token (Sym BracketR) _)) ->
happyIn43
(at (happy_var_1,happy_var_3) happy_var_2
)}}}
happyReduce_141 = happySpecReduce_2 29# happyReduction_141
happyReduction_141 happy_x_2
happy_x_1
= case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (Sym BackTick) _)) ->
case happyOut82 happy_x_2 of { happy_var_2 ->
happyIn43
(at (happy_var_1,happy_var_2) $ ETypeVal happy_var_2
)}}
happyReduce_142 = happySpecReduce_3 29# happyReduction_142
happyReduction_142 happy_x_3
happy_x_2
happy_x_1
= case happyOut43 happy_x_1 of { happy_var_1 ->
case happyOut46 happy_x_3 of { happy_var_3 ->
happyIn43
(at (happy_var_1,happy_var_3) $ ESel happy_var_1 (thing happy_var_3)
)}}
happyReduce_143 = happySpecReduce_3 29# happyReduction_143
happyReduction_143 happy_x_3
happy_x_2
happy_x_1
= case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (Sym ParenL ) _)) ->
case happyOutTok happy_x_3 of { (Located happy_var_3 (Token (Sym ParenR ) _)) ->
happyIn43
(at (happy_var_1,happy_var_3) $ ECon ECAt
)}}
happyReduce_144 = happySpecReduce_3 29# happyReduction_144
happyReduction_144 happy_x_3
happy_x_2
happy_x_1
= case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (Sym ParenL ) _)) ->
case happyOutTok happy_x_3 of { (Located happy_var_3 (Token (Sym ParenR ) _)) ->
happyIn43
(at (happy_var_1,happy_var_3) $ ECon ECAtRange
)}}
happyReduce_145 = happySpecReduce_3 29# happyReduction_145
happyReduction_145 happy_x_3
happy_x_2
happy_x_1
= case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (Sym ParenL ) _)) ->
case happyOutTok happy_x_3 of { (Located happy_var_3 (Token (Sym ParenR ) _)) ->
happyIn43
(at (happy_var_1,happy_var_3) $ ECon ECAtBack
)}}
happyReduce_146 = happySpecReduce_3 29# happyReduction_146
happyReduction_146 happy_x_3
happy_x_2
happy_x_1
= case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (Sym ParenL ) _)) ->
case happyOutTok happy_x_3 of { (Located happy_var_3 (Token (Sym ParenR ) _)) ->
happyIn43
(at (happy_var_1,happy_var_3) $ ECon ECAtRangeBack
)}}
happyReduce_147 = happySpecReduce_3 29# happyReduction_147
happyReduction_147 happy_x_3
happy_x_2
happy_x_1
= case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (Sym ParenL ) _)) ->
case happyOutTok happy_x_3 of { (Located happy_var_3 (Token (Sym ParenR ) _)) ->
happyIn43
(at (happy_var_1,happy_var_3) $ ECon ECCat
)}}
happyReduce_148 = happySpecReduce_3 29# happyReduction_148
happyReduction_148 happy_x_3
happy_x_2
happy_x_1
= case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (Sym ParenL ) _)) ->
case happyOutTok happy_x_3 of { (Located happy_var_3 (Token (Sym ParenR ) _)) ->
happyIn43
(at (happy_var_1,happy_var_3) $ ECon ECPlus
)}}
happyReduce_149 = happySpecReduce_3 29# happyReduction_149
happyReduction_149 happy_x_3
happy_x_2
happy_x_1
= case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (Sym ParenL ) _)) ->
case happyOutTok happy_x_3 of { (Located happy_var_3 (Token (Sym ParenR ) _)) ->
happyIn43
(at (happy_var_1,happy_var_3) $ ECon ECMinus
)}}
happyReduce_150 = happySpecReduce_3 29# happyReduction_150
happyReduction_150 happy_x_3
happy_x_2
happy_x_1
= case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (Sym ParenL ) _)) ->
case happyOutTok happy_x_3 of { (Located happy_var_3 (Token (Sym ParenR ) _)) ->
happyIn43
(at (happy_var_1,happy_var_3) $ ECon ECMul
)}}
happyReduce_151 = happySpecReduce_3 29# happyReduction_151
happyReduction_151 happy_x_3
happy_x_2
happy_x_1
= case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (Sym ParenL ) _)) ->
case happyOutTok happy_x_3 of { (Located happy_var_3 (Token (Sym ParenR ) _)) ->
happyIn43
(at (happy_var_1,happy_var_3) $ ECon ECDiv
)}}
happyReduce_152 = happySpecReduce_3 29# happyReduction_152
happyReduction_152 happy_x_3
happy_x_2
happy_x_1
= case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (Sym ParenL ) _)) ->
case happyOutTok happy_x_3 of { (Located happy_var_3 (Token (Sym ParenR ) _)) ->
happyIn43
(at (happy_var_1,happy_var_3) $ ECon ECMod
)}}
happyReduce_153 = happySpecReduce_3 29# happyReduction_153
happyReduction_153 happy_x_3
happy_x_2
happy_x_1
= case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (Sym ParenL ) _)) ->
case happyOutTok happy_x_3 of { (Located happy_var_3 (Token (Sym ParenR ) _)) ->
happyIn43
(at (happy_var_1,happy_var_3) $ ECon ECExp
)}}
happyReduce_154 = happySpecReduce_3 29# happyReduction_154
happyReduction_154 happy_x_3
happy_x_2
happy_x_1
= case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (Sym ParenL ) _)) ->
case happyOutTok happy_x_3 of { (Located happy_var_3 (Token (Sym ParenR ) _)) ->
happyIn43
(at (happy_var_1,happy_var_3) $ ECon ECXor
)}}
happyReduce_155 = happySpecReduce_3 29# happyReduction_155
happyReduction_155 happy_x_3
happy_x_2
happy_x_1
= case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (Sym ParenL ) _)) ->
case happyOutTok happy_x_3 of { (Located happy_var_3 (Token (Sym ParenR ) _)) ->
happyIn43
(at (happy_var_1,happy_var_3) $ ECon ECOr
)}}
happyReduce_156 = happySpecReduce_3 29# happyReduction_156
happyReduction_156 happy_x_3
happy_x_2
happy_x_1
= case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (Sym ParenL ) _)) ->
case happyOutTok happy_x_3 of { (Located happy_var_3 (Token (Sym ParenR ) _)) ->
happyIn43
(at (happy_var_1,happy_var_3) $ ECon ECAnd
)}}
happyReduce_157 = happySpecReduce_3 29# happyReduction_157
happyReduction_157 happy_x_3
happy_x_2
happy_x_1
= case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (Sym ParenL ) _)) ->
case happyOutTok happy_x_3 of { (Located happy_var_3 (Token (Sym ParenR ) _)) ->
happyIn43
(at (happy_var_1,happy_var_3) $ ECon ECEq
)}}
happyReduce_158 = happySpecReduce_3 29# happyReduction_158
happyReduction_158 happy_x_3
happy_x_2
happy_x_1
= case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (Sym ParenL ) _)) ->
case happyOutTok happy_x_3 of { (Located happy_var_3 (Token (Sym ParenR ) _)) ->
happyIn43
(at (happy_var_1,happy_var_3) $ ECon ECNotEq
)}}
happyReduce_159 = happySpecReduce_3 29# happyReduction_159
happyReduction_159 happy_x_3
happy_x_2
happy_x_1
= case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (Sym ParenL ) _)) ->
case happyOutTok happy_x_3 of { (Located happy_var_3 (Token (Sym ParenR ) _)) ->
happyIn43
(at (happy_var_1,happy_var_3) $ ECon ECFunEq
)}}
happyReduce_160 = happySpecReduce_3 29# happyReduction_160
happyReduction_160 happy_x_3
happy_x_2
happy_x_1
= case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (Sym ParenL ) _)) ->
case happyOutTok happy_x_3 of { (Located happy_var_3 (Token (Sym ParenR ) _)) ->
happyIn43
(at (happy_var_1,happy_var_3) $ ECon ECFunNotEq
)}}
happyReduce_161 = happySpecReduce_3 29# happyReduction_161
happyReduction_161 happy_x_3
happy_x_2
happy_x_1
= case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (Sym ParenL ) _)) ->
case happyOutTok happy_x_3 of { (Located happy_var_3 (Token (Sym ParenR ) _)) ->
happyIn43
(at (happy_var_1,happy_var_3) $ ECon ECGt
)}}
happyReduce_162 = happySpecReduce_3 29# happyReduction_162
happyReduction_162 happy_x_3
happy_x_2
happy_x_1
= case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (Sym ParenL ) _)) ->
case happyOutTok happy_x_3 of { (Located happy_var_3 (Token (Sym ParenR ) _)) ->
happyIn43
(at (happy_var_1,happy_var_3) $ ECon ECLt
)}}
happyReduce_163 = happySpecReduce_3 29# happyReduction_163
happyReduction_163 happy_x_3
happy_x_2
happy_x_1
= case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (Sym ParenL ) _)) ->
case happyOutTok happy_x_3 of { (Located happy_var_3 (Token (Sym ParenR ) _)) ->
happyIn43
(at (happy_var_1,happy_var_3) $ ECon ECLtEq
)}}
happyReduce_164 = happySpecReduce_3 29# happyReduction_164
happyReduction_164 happy_x_3
happy_x_2
happy_x_1
= case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (Sym ParenL ) _)) ->
case happyOutTok happy_x_3 of { (Located happy_var_3 (Token (Sym ParenR ) _)) ->
happyIn43
(at (happy_var_1,happy_var_3) $ ECon ECGtEq
)}}
happyReduce_165 = happySpecReduce_3 29# happyReduction_165
happyReduction_165 happy_x_3
happy_x_2
happy_x_1
= case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (Sym ParenL ) _)) ->
case happyOutTok happy_x_3 of { (Located happy_var_3 (Token (Sym ParenR ) _)) ->
happyIn43
(at (happy_var_1,happy_var_3) $ ECon ECShiftL
)}}
happyReduce_166 = happySpecReduce_3 29# happyReduction_166
happyReduction_166 happy_x_3
happy_x_2
happy_x_1
= case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (Sym ParenL ) _)) ->
case happyOutTok happy_x_3 of { (Located happy_var_3 (Token (Sym ParenR ) _)) ->
happyIn43
(at (happy_var_1,happy_var_3) $ ECon ECShiftR
)}}
happyReduce_167 = happySpecReduce_3 29# happyReduction_167
happyReduction_167 happy_x_3
happy_x_2
happy_x_1
= case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (Sym ParenL ) _)) ->
case happyOutTok happy_x_3 of { (Located happy_var_3 (Token (Sym ParenR ) _)) ->
happyIn43
(at (happy_var_1,happy_var_3) $ ECon ECRotL
)}}
happyReduce_168 = happySpecReduce_3 29# happyReduction_168
happyReduction_168 happy_x_3
happy_x_2
happy_x_1
= case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (Sym ParenL ) _)) ->
case happyOutTok happy_x_3 of { (Located happy_var_3 (Token (Sym ParenR ) _)) ->
happyIn43
(at (happy_var_1,happy_var_3) $ ECon ECRotR
)}}
happyReduce_169 = happyMonadReduce 2# 29# happyReduction_169
happyReduction_169 (happy_x_2 `HappyStk`
happy_x_1 `HappyStk`
happyRest) tk
= happyThen (case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (Sym TriL ) _)) ->
case happyOutTok happy_x_2 of { (Located happy_var_2 (Token (Sym TriR ) _)) ->
( mkPoly (rComb happy_var_1 happy_var_2) [])}}
) (\r -> happyReturn (happyIn43 r))
happyReduce_170 = happyMonadReduce 3# 29# happyReduction_170
happyReduction_170 (happy_x_3 `HappyStk`
happy_x_2 `HappyStk`
happy_x_1 `HappyStk`
happyRest) tk
= happyThen (case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (Sym TriL ) _)) ->
case happyOut44 happy_x_2 of { happy_var_2 ->
case happyOutTok happy_x_3 of { (Located happy_var_3 (Token (Sym TriR ) _)) ->
( mkPoly (rComb happy_var_1 happy_var_3) happy_var_2)}}}
) (\r -> happyReturn (happyIn43 r))
happyReduce_171 = happySpecReduce_1 30# happyReduction_171
happyReduction_171 happy_x_1
= case happyOut45 happy_x_1 of { happy_var_1 ->
happyIn44
([happy_var_1]
)}
happyReduce_172 = happySpecReduce_3 30# happyReduction_172
happyReduction_172 happy_x_3
happy_x_2
happy_x_1
= case happyOut44 happy_x_1 of { happy_var_1 ->
case happyOut45 happy_x_3 of { happy_var_3 ->
happyIn44
(happy_var_3 : happy_var_1
)}}
happyReduce_173 = happyMonadReduce 1# 31# happyReduction_173
happyReduction_173 (happy_x_1 `HappyStk`
happyRest) tk
= happyThen (case happyOutTok happy_x_1 of { (happy_var_1@(Located _ (Token (Num {}) _))) ->
( polyTerm (srcRange happy_var_1) (getNum happy_var_1) 0)}
) (\r -> happyReturn (happyIn45 r))
happyReduce_174 = happyMonadReduce 1# 31# happyReduction_174
happyReduction_174 (happy_x_1 `HappyStk`
happyRest) tk
= happyThen (case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (KW KW_x) _)) ->
( polyTerm happy_var_1 1 1)}
) (\r -> happyReturn (happyIn45 r))
happyReduce_175 = happyMonadReduce 3# 31# happyReduction_175
happyReduction_175 (happy_x_3 `HappyStk`
happy_x_2 `HappyStk`
happy_x_1 `HappyStk`
happyRest) tk
= happyThen (case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (KW KW_x) _)) ->
case happyOutTok happy_x_3 of { (happy_var_3@(Located _ (Token (Num {}) _))) ->
( polyTerm (rComb happy_var_1 (srcRange happy_var_3))
1 (getNum happy_var_3))}}
) (\r -> happyReturn (happyIn45 r))
happyReduce_176 = happySpecReduce_1 32# happyReduction_176
happyReduction_176 happy_x_1
= case happyOut79 happy_x_1 of { happy_var_1 ->
happyIn46
(fmap (`RecordSel` Nothing) happy_var_1
)}
happyReduce_177 = happyMonadReduce 1# 32# happyReduction_177
happyReduction_177 (happy_x_1 `HappyStk`
happyRest) tk
= happyThen (case happyOutTok happy_x_1 of { (happy_var_1@(Located _ (Token (Num {}) _))) ->
( mkTupleSel (srcRange happy_var_1) (getNum happy_var_1))}
) (\r -> happyReturn (happyIn46 r))
happyReduce_178 = happySpecReduce_3 33# happyReduction_178
happyReduction_178 happy_x_3
happy_x_2
happy_x_1
= case happyOut38 happy_x_1 of { happy_var_1 ->
case happyOut38 happy_x_3 of { happy_var_3 ->
happyIn47
([ happy_var_3, happy_var_1]
)}}
happyReduce_179 = happySpecReduce_3 33# happyReduction_179
happyReduction_179 happy_x_3
happy_x_2
happy_x_1
= case happyOut47 happy_x_1 of { happy_var_1 ->
case happyOut38 happy_x_3 of { happy_var_3 ->
happyIn47
(happy_var_3 : happy_var_1
)}}
happyReduce_180 = happySpecReduce_3 34# happyReduction_180
happyReduction_180 happy_x_3
happy_x_2
happy_x_1
= case happyOut79 happy_x_1 of { happy_var_1 ->
case happyOut38 happy_x_3 of { happy_var_3 ->
happyIn48
(Named { name = happy_var_1, value = happy_var_3 }
)}}
happyReduce_181 = happyReduce 4# 34# happyReduction_181
happyReduction_181 (happy_x_4 `HappyStk`
happy_x_3 `HappyStk`
happy_x_2 `HappyStk`
happy_x_1 `HappyStk`
happyRest)
= case happyOut79 happy_x_1 of { happy_var_1 ->
case happyOut33 happy_x_2 of { happy_var_2 ->
case happyOut38 happy_x_4 of { happy_var_4 ->
happyIn48
(Named { name = happy_var_1, value = EFun (reverse happy_var_2) happy_var_4 }
) `HappyStk` happyRest}}}
happyReduce_182 = happySpecReduce_1 35# happyReduction_182
happyReduction_182 happy_x_1
= case happyOut48 happy_x_1 of { happy_var_1 ->
happyIn49
([happy_var_1]
)}
happyReduce_183 = happySpecReduce_3 35# happyReduction_183
happyReduction_183 happy_x_3
happy_x_2
happy_x_1
= case happyOut49 happy_x_1 of { happy_var_1 ->
case happyOut48 happy_x_3 of { happy_var_3 ->
happyIn49
(happy_var_3 : happy_var_1
)}}
happyReduce_184 = happySpecReduce_3 36# happyReduction_184
happyReduction_184 happy_x_3
happy_x_2
happy_x_1
= case happyOut38 happy_x_1 of { happy_var_1 ->
case happyOut51 happy_x_3 of { happy_var_3 ->
happyIn50
(EComp happy_var_1 (reverse happy_var_3)
)}}
happyReduce_185 = happySpecReduce_1 36# happyReduction_185
happyReduction_185 happy_x_1
= case happyOut38 happy_x_1 of { happy_var_1 ->
happyIn50
(EList [happy_var_1]
)}
happyReduce_186 = happySpecReduce_1 36# happyReduction_186
happyReduction_186 happy_x_1
= case happyOut47 happy_x_1 of { happy_var_1 ->
happyIn50
(EList (reverse happy_var_1)
)}
happyReduce_187 = happyMonadReduce 2# 36# happyReduction_187
happyReduction_187 (happy_x_2 `HappyStk`
happy_x_1 `HappyStk`
happyRest) tk
= happyThen (case happyOut38 happy_x_1 of { happy_var_1 ->
case happyOutTok happy_x_2 of { (Located happy_var_2 (Token (Sym DotDot ) _)) ->
( eFromTo happy_var_2 happy_var_1 Nothing Nothing)}}
) (\r -> happyReturn (happyIn50 r))
happyReduce_188 = happyMonadReduce 3# 36# happyReduction_188
happyReduction_188 (happy_x_3 `HappyStk`
happy_x_2 `HappyStk`
happy_x_1 `HappyStk`
happyRest) tk
= happyThen (case happyOut38 happy_x_1 of { happy_var_1 ->
case happyOutTok happy_x_2 of { (Located happy_var_2 (Token (Sym DotDot ) _)) ->
case happyOut38 happy_x_3 of { happy_var_3 ->
( eFromTo happy_var_2 happy_var_1 Nothing (Just happy_var_3))}}}
) (\r -> happyReturn (happyIn50 r))
happyReduce_189 = happyMonadReduce 4# 36# happyReduction_189
happyReduction_189 (happy_x_4 `HappyStk`
happy_x_3 `HappyStk`
happy_x_2 `HappyStk`
happy_x_1 `HappyStk`
happyRest) tk
= happyThen (case happyOut38 happy_x_1 of { happy_var_1 ->
case happyOut38 happy_x_3 of { happy_var_3 ->
case happyOutTok happy_x_4 of { (Located happy_var_4 (Token (Sym DotDot ) _)) ->
( eFromTo happy_var_4 happy_var_1 (Just happy_var_3) Nothing)}}}
) (\r -> happyReturn (happyIn50 r))
happyReduce_190 = happyMonadReduce 5# 36# happyReduction_190
happyReduction_190 (happy_x_5 `HappyStk`
happy_x_4 `HappyStk`
happy_x_3 `HappyStk`
happy_x_2 `HappyStk`
happy_x_1 `HappyStk`
happyRest) tk
= happyThen (case happyOut38 happy_x_1 of { happy_var_1 ->
case happyOut38 happy_x_3 of { happy_var_3 ->
case happyOutTok happy_x_4 of { (Located happy_var_4 (Token (Sym DotDot ) _)) ->
case happyOut38 happy_x_5 of { happy_var_5 ->
( eFromTo happy_var_4 happy_var_1 (Just happy_var_3) (Just happy_var_5))}}}}
) (\r -> happyReturn (happyIn50 r))
happyReduce_191 = happySpecReduce_2 36# happyReduction_191
happyReduction_191 happy_x_2
happy_x_1
= case happyOut38 happy_x_1 of { happy_var_1 ->
happyIn50
(EInfFrom happy_var_1 Nothing
)}
happyReduce_192 = happyReduce 4# 36# happyReduction_192
happyReduction_192 (happy_x_4 `HappyStk`
happy_x_3 `HappyStk`
happy_x_2 `HappyStk`
happy_x_1 `HappyStk`
happyRest)
= case happyOut38 happy_x_1 of { happy_var_1 ->
case happyOut38 happy_x_3 of { happy_var_3 ->
happyIn50
(EInfFrom happy_var_1 (Just happy_var_3)
) `HappyStk` happyRest}}
happyReduce_193 = happySpecReduce_1 37# happyReduction_193
happyReduction_193 happy_x_1
= case happyOut52 happy_x_1 of { happy_var_1 ->
happyIn51
([ reverse happy_var_1 ]
)}
happyReduce_194 = happySpecReduce_3 37# happyReduction_194
happyReduction_194 happy_x_3
happy_x_2
happy_x_1
= case happyOut51 happy_x_1 of { happy_var_1 ->
case happyOut52 happy_x_3 of { happy_var_3 ->
happyIn51
(reverse happy_var_3 : happy_var_1
)}}
happyReduce_195 = happySpecReduce_1 38# happyReduction_195
happyReduction_195 happy_x_1
= case happyOut53 happy_x_1 of { happy_var_1 ->
happyIn52
([happy_var_1]
)}
happyReduce_196 = happySpecReduce_3 38# happyReduction_196
happyReduction_196 happy_x_3
happy_x_2
happy_x_1
= case happyOut52 happy_x_1 of { happy_var_1 ->
case happyOut53 happy_x_3 of { happy_var_3 ->
happyIn52
(happy_var_3 : happy_var_1
)}}
happyReduce_197 = happySpecReduce_3 39# happyReduction_197
happyReduction_197 happy_x_3
happy_x_2
happy_x_1
= case happyOut54 happy_x_1 of { happy_var_1 ->
case happyOut38 happy_x_3 of { happy_var_3 ->
happyIn53
(Match happy_var_1 happy_var_3
)}}
happyReduce_198 = happySpecReduce_3 40# happyReduction_198
happyReduction_198 happy_x_3
happy_x_2
happy_x_1
= case happyOut55 happy_x_1 of { happy_var_1 ->
case happyOut70 happy_x_3 of { happy_var_3 ->
happyIn54
(at (happy_var_1,happy_var_3) $ PTyped happy_var_1 happy_var_3
)}}
happyReduce_199 = happySpecReduce_1 40# happyReduction_199
happyReduction_199 happy_x_1
= case happyOut55 happy_x_1 of { happy_var_1 ->
happyIn54
(happy_var_1
)}
happyReduce_200 = happySpecReduce_3 41# happyReduction_200
happyReduction_200 happy_x_3
happy_x_2
happy_x_1
= case happyOut55 happy_x_1 of { happy_var_1 ->
case happyOut55 happy_x_3 of { happy_var_3 ->
happyIn55
(at (happy_var_1,happy_var_3) $ PSplit happy_var_1 happy_var_3
)}}
happyReduce_201 = happySpecReduce_1 41# happyReduction_201
happyReduction_201 happy_x_1
= case happyOut56 happy_x_1 of { happy_var_1 ->
happyIn55
(happy_var_1
)}
happyReduce_202 = happySpecReduce_1 42# happyReduction_202
happyReduction_202 happy_x_1
= case happyOut79 happy_x_1 of { happy_var_1 ->
happyIn56
(PVar happy_var_1
)}
happyReduce_203 = happySpecReduce_1 42# happyReduction_203
happyReduction_203 happy_x_1
= case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (Sym Underscore ) _)) ->
happyIn56
(at happy_var_1 $ PWild
)}
happyReduce_204 = happySpecReduce_2 42# happyReduction_204
happyReduction_204 happy_x_2
happy_x_1
= case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (Sym ParenL ) _)) ->
case happyOutTok happy_x_2 of { (Located happy_var_2 (Token (Sym ParenR ) _)) ->
happyIn56
(at (happy_var_1,happy_var_2) $ PTuple []
)}}
happyReduce_205 = happySpecReduce_3 42# happyReduction_205
happyReduction_205 happy_x_3
happy_x_2
happy_x_1
= case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (Sym ParenL ) _)) ->
case happyOut54 happy_x_2 of { happy_var_2 ->
case happyOutTok happy_x_3 of { (Located happy_var_3 (Token (Sym ParenR ) _)) ->
happyIn56
(at (happy_var_1,happy_var_3) happy_var_2
)}}}
happyReduce_206 = happySpecReduce_3 42# happyReduction_206
happyReduction_206 happy_x_3
happy_x_2
happy_x_1
= case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (Sym ParenL ) _)) ->
case happyOut57 happy_x_2 of { happy_var_2 ->
case happyOutTok happy_x_3 of { (Located happy_var_3 (Token (Sym ParenR ) _)) ->
happyIn56
(at (happy_var_1,happy_var_3) $ PTuple (reverse happy_var_2)
)}}}
happyReduce_207 = happySpecReduce_2 42# happyReduction_207
happyReduction_207 happy_x_2
happy_x_1
= case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (Sym BracketL) _)) ->
case happyOutTok happy_x_2 of { (Located happy_var_2 (Token (Sym BracketR) _)) ->
happyIn56
(at (happy_var_1,happy_var_2) $ PList []
)}}
happyReduce_208 = happySpecReduce_3 42# happyReduction_208
happyReduction_208 happy_x_3
happy_x_2
happy_x_1
= case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (Sym BracketL) _)) ->
case happyOut54 happy_x_2 of { happy_var_2 ->
case happyOutTok happy_x_3 of { (Located happy_var_3 (Token (Sym BracketR) _)) ->
happyIn56
(at (happy_var_1,happy_var_3) $ PList [happy_var_2]
)}}}
happyReduce_209 = happySpecReduce_3 42# happyReduction_209
happyReduction_209 happy_x_3
happy_x_2
happy_x_1
= case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (Sym BracketL) _)) ->
case happyOut57 happy_x_2 of { happy_var_2 ->
case happyOutTok happy_x_3 of { (Located happy_var_3 (Token (Sym BracketR) _)) ->
happyIn56
(at (happy_var_1,happy_var_3) $ PList (reverse happy_var_2)
)}}}
happyReduce_210 = happySpecReduce_2 42# happyReduction_210
happyReduction_210 happy_x_2
happy_x_1
= case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (Sym CurlyL ) _)) ->
case happyOutTok happy_x_2 of { (Located happy_var_2 (Token (Sym CurlyR ) _)) ->
happyIn56
(at (happy_var_1,happy_var_2) $ PRecord []
)}}
happyReduce_211 = happySpecReduce_3 42# happyReduction_211
happyReduction_211 happy_x_3
happy_x_2
happy_x_1
= case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (Sym CurlyL ) _)) ->
case happyOut59 happy_x_2 of { happy_var_2 ->
case happyOutTok happy_x_3 of { (Located happy_var_3 (Token (Sym CurlyR ) _)) ->
happyIn56
(at (happy_var_1,happy_var_3) $ PRecord (reverse happy_var_2)
)}}}
happyReduce_212 = happySpecReduce_3 43# happyReduction_212
happyReduction_212 happy_x_3
happy_x_2
happy_x_1
= case happyOut54 happy_x_1 of { happy_var_1 ->
case happyOut54 happy_x_3 of { happy_var_3 ->
happyIn57
([happy_var_3, happy_var_1]
)}}
happyReduce_213 = happySpecReduce_3 43# happyReduction_213
happyReduction_213 happy_x_3
happy_x_2
happy_x_1
= case happyOut57 happy_x_1 of { happy_var_1 ->
case happyOut54 happy_x_3 of { happy_var_3 ->
happyIn57
(happy_var_3 : happy_var_1
)}}
happyReduce_214 = happySpecReduce_3 44# happyReduction_214
happyReduction_214 happy_x_3
happy_x_2
happy_x_1
= case happyOut79 happy_x_1 of { happy_var_1 ->
case happyOut54 happy_x_3 of { happy_var_3 ->
happyIn58
(Named { name = happy_var_1, value = happy_var_3 }
)}}
happyReduce_215 = happySpecReduce_1 45# happyReduction_215
happyReduction_215 happy_x_1
= case happyOut58 happy_x_1 of { happy_var_1 ->
happyIn59
([happy_var_1]
)}
happyReduce_216 = happySpecReduce_3 45# happyReduction_216
happyReduction_216 happy_x_3
happy_x_2
happy_x_1
= case happyOut59 happy_x_1 of { happy_var_1 ->
case happyOut58 happy_x_3 of { happy_var_3 ->
happyIn59
(happy_var_3 : happy_var_1
)}}
happyReduce_217 = happySpecReduce_1 46# happyReduction_217
happyReduction_217 happy_x_1
= case happyOut70 happy_x_1 of { happy_var_1 ->
happyIn60
(at happy_var_1 $ mkSchema [] [] happy_var_1
)}
happyReduce_218 = happySpecReduce_2 46# happyReduction_218
happyReduction_218 happy_x_2
happy_x_1
= case happyOut61 happy_x_1 of { happy_var_1 ->
case happyOut70 happy_x_2 of { happy_var_2 ->
happyIn60
(at (happy_var_1,happy_var_2) $ mkSchema (thing happy_var_1) [] happy_var_2
)}}
happyReduce_219 = happySpecReduce_2 46# happyReduction_219
happyReduction_219 happy_x_2
happy_x_1
= case happyOut62 happy_x_1 of { happy_var_1 ->
case happyOut70 happy_x_2 of { happy_var_2 ->
happyIn60
(at (happy_var_1,happy_var_2) $ mkSchema [] (thing happy_var_1) happy_var_2
)}}
happyReduce_220 = happySpecReduce_3 46# happyReduction_220
happyReduction_220 happy_x_3
happy_x_2
happy_x_1
= case happyOut61 happy_x_1 of { happy_var_1 ->
case happyOut62 happy_x_2 of { happy_var_2 ->
case happyOut70 happy_x_3 of { happy_var_3 ->
happyIn60
(at (happy_var_1,happy_var_3) $ mkSchema (thing happy_var_1)
(thing happy_var_2) happy_var_3
)}}}
happyReduce_221 = happySpecReduce_2 47# happyReduction_221
happyReduction_221 happy_x_2
happy_x_1
= case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (Sym CurlyL ) _)) ->
case happyOutTok happy_x_2 of { (Located happy_var_2 (Token (Sym CurlyR ) _)) ->
happyIn61
(Located (rComb happy_var_1 happy_var_2) []
)}}
happyReduce_222 = happySpecReduce_3 47# happyReduction_222
happyReduction_222 happy_x_3
happy_x_2
happy_x_1
= case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (Sym CurlyL ) _)) ->
case happyOut65 happy_x_2 of { happy_var_2 ->
case happyOutTok happy_x_3 of { (Located happy_var_3 (Token (Sym CurlyR ) _)) ->
happyIn61
(Located (rComb happy_var_1 happy_var_3) (reverse happy_var_2)
)}}}
happyReduce_223 = happySpecReduce_3 48# happyReduction_223
happyReduction_223 happy_x_3
happy_x_2
happy_x_1
= case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (Sym ParenL ) _)) ->
case happyOutTok happy_x_3 of { (Located happy_var_3 (Token (Sym FatArrR ) _)) ->
happyIn62
(Located (rComb happy_var_1 happy_var_3) []
)}}
happyReduce_224 = happySpecReduce_2 48# happyReduction_224
happyReduction_224 happy_x_2
happy_x_1
= case happyOut68 happy_x_1 of { happy_var_1 ->
case happyOutTok happy_x_2 of { (Located happy_var_2 (Token (Sym FatArrR ) _)) ->
happyIn62
(Located
(rComb (fromMaybe happy_var_2 (getLoc happy_var_1)) happy_var_2) [happy_var_1]
)}}
happyReduce_225 = happyReduce 4# 48# happyReduction_225
happyReduction_225 (happy_x_4 `HappyStk`
happy_x_3 `HappyStk`
happy_x_2 `HappyStk`
happy_x_1 `HappyStk`
happyRest)
= case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (Sym ParenL ) _)) ->
case happyOut69 happy_x_2 of { happy_var_2 ->
case happyOutTok happy_x_4 of { (Located happy_var_4 (Token (Sym FatArrR ) _)) ->
happyIn62
(Located (rComb happy_var_1 happy_var_4) (reverse happy_var_2)
) `HappyStk` happyRest}}}
happyReduce_226 = happySpecReduce_1 49# happyReduction_226
happyReduction_226 happy_x_1
= case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (Op Hash ) _)) ->
happyIn63
(Located happy_var_1 KNum
)}
happyReduce_227 = happySpecReduce_1 49# happyReduction_227
happyReduction_227 happy_x_1
= case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (Op Mul ) _)) ->
happyIn63
(Located happy_var_1 KType
)}
happyReduce_228 = happyMonadReduce 1# 50# happyReduction_228
happyReduction_228 (happy_x_1 `HappyStk`
happyRest) tk
= happyThen (case happyOut79 happy_x_1 of { happy_var_1 ->
( mkTParam happy_var_1 Nothing)}
) (\r -> happyReturn (happyIn64 r))
happyReduce_229 = happyMonadReduce 3# 50# happyReduction_229
happyReduction_229 (happy_x_3 `HappyStk`
happy_x_2 `HappyStk`
happy_x_1 `HappyStk`
happyRest) tk
= happyThen (case happyOut79 happy_x_1 of { happy_var_1 ->
case happyOut63 happy_x_3 of { happy_var_3 ->
( mkTParam (at (happy_var_1,happy_var_3) happy_var_1) (Just (thing happy_var_3)))}}
) (\r -> happyReturn (happyIn64 r))
happyReduce_230 = happySpecReduce_1 51# happyReduction_230
happyReduction_230 happy_x_1
= case happyOut64 happy_x_1 of { happy_var_1 ->
happyIn65
([happy_var_1]
)}
happyReduce_231 = happySpecReduce_3 51# happyReduction_231
happyReduction_231 happy_x_3
happy_x_2
happy_x_1
= case happyOut65 happy_x_1 of { happy_var_1 ->
case happyOut64 happy_x_3 of { happy_var_3 ->
happyIn65
(happy_var_3 : happy_var_1
)}}
happyReduce_232 = happyMonadReduce 1# 52# happyReduction_232
happyReduction_232 (happy_x_1 `HappyStk`
happyRest) tk
= happyThen (case happyOut79 happy_x_1 of { happy_var_1 ->
( mkTParam happy_var_1 Nothing)}
) (\r -> happyReturn (happyIn66 r))
happyReduce_233 = happyMonadReduce 5# 52# happyReduction_233
happyReduction_233 (happy_x_5 `HappyStk`
happy_x_4 `HappyStk`
happy_x_3 `HappyStk`
happy_x_2 `HappyStk`
happy_x_1 `HappyStk`
happyRest) tk
= happyThen (case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (Sym ParenL ) _)) ->
case happyOut79 happy_x_2 of { happy_var_2 ->
case happyOut63 happy_x_4 of { happy_var_4 ->
case happyOutTok happy_x_5 of { (Located happy_var_5 (Token (Sym ParenR ) _)) ->
( mkTParam (at (happy_var_1,happy_var_5) happy_var_2) (Just (thing happy_var_4)))}}}}
) (\r -> happyReturn (happyIn66 r))
happyReduce_234 = happySpecReduce_1 53# happyReduction_234
happyReduction_234 happy_x_1
= case happyOut66 happy_x_1 of { happy_var_1 ->
happyIn67
([happy_var_1]
)}
happyReduce_235 = happySpecReduce_2 53# happyReduction_235
happyReduction_235 happy_x_2
happy_x_1
= case happyOut67 happy_x_1 of { happy_var_1 ->
case happyOut66 happy_x_2 of { happy_var_2 ->
happyIn67
(happy_var_2 : happy_var_1
)}}
happyReduce_236 = happySpecReduce_3 54# happyReduction_236
happyReduction_236 happy_x_3
happy_x_2
happy_x_1
= case happyOut70 happy_x_1 of { happy_var_1 ->
case happyOut70 happy_x_3 of { happy_var_3 ->
happyIn68
(at (happy_var_1,happy_var_3) $ CEqual happy_var_1 happy_var_3
)}}
happyReduce_237 = happySpecReduce_3 54# happyReduction_237
happyReduction_237 happy_x_3
happy_x_2
happy_x_1
= case happyOut70 happy_x_1 of { happy_var_1 ->
case happyOut70 happy_x_3 of { happy_var_3 ->
happyIn68
(at (happy_var_1,happy_var_3) $ CGeq happy_var_3 happy_var_1
)}}
happyReduce_238 = happySpecReduce_3 54# happyReduction_238
happyReduction_238 happy_x_3
happy_x_2
happy_x_1
= case happyOut70 happy_x_1 of { happy_var_1 ->
case happyOut70 happy_x_3 of { happy_var_3 ->
happyIn68
(at (happy_var_1,happy_var_3) $ CGeq happy_var_1 happy_var_3
)}}
happyReduce_239 = happySpecReduce_2 54# happyReduction_239
happyReduction_239 happy_x_2
happy_x_1
= case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (KW KW_fin ) _)) ->
case happyOut72 happy_x_2 of { happy_var_2 ->
happyIn68
(at (happy_var_1,happy_var_2) $ CFin happy_var_2
)}}
happyReduce_240 = happySpecReduce_2 54# happyReduction_240
happyReduction_240 happy_x_2
happy_x_1
= case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (KW KW_Arith ) _)) ->
case happyOut72 happy_x_2 of { happy_var_2 ->
happyIn68
(at (happy_var_1,happy_var_2) $ CArith happy_var_2
)}}
happyReduce_241 = happySpecReduce_2 54# happyReduction_241
happyReduction_241 happy_x_2
happy_x_1
= case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (KW KW_Cmp ) _)) ->
case happyOut72 happy_x_2 of { happy_var_2 ->
happyIn68
(at (happy_var_1,happy_var_2) $ CCmp happy_var_2
)}}
happyReduce_242 = happySpecReduce_1 55# happyReduction_242
happyReduction_242 happy_x_1
= case happyOut68 happy_x_1 of { happy_var_1 ->
happyIn69
([happy_var_1]
)}
happyReduce_243 = happySpecReduce_3 55# happyReduction_243
happyReduction_243 happy_x_3
happy_x_2
happy_x_1
= case happyOut69 happy_x_1 of { happy_var_1 ->
case happyOut68 happy_x_3 of { happy_var_3 ->
happyIn69
(happy_var_3 : happy_var_1
)}}
happyReduce_244 = happySpecReduce_3 56# happyReduction_244
happyReduction_244 happy_x_3
happy_x_2
happy_x_1
= case happyOut70 happy_x_1 of { happy_var_1 ->
case happyOut70 happy_x_3 of { happy_var_3 ->
happyIn70
(at (happy_var_1,happy_var_3) $ TFun happy_var_1 happy_var_3
)}}
happyReduce_245 = happySpecReduce_3 56# happyReduction_245
happyReduction_245 happy_x_3
happy_x_2
happy_x_1
= case happyOut70 happy_x_1 of { happy_var_1 ->
case happyOut70 happy_x_3 of { happy_var_3 ->
happyIn70
(at (happy_var_1,happy_var_3) $ TApp TCAdd [happy_var_1, happy_var_3]
)}}
happyReduce_246 = happySpecReduce_3 56# happyReduction_246
happyReduction_246 happy_x_3
happy_x_2
happy_x_1
= case happyOut70 happy_x_1 of { happy_var_1 ->
case happyOut70 happy_x_3 of { happy_var_3 ->
happyIn70
(at (happy_var_1,happy_var_3) $ TApp TCSub [happy_var_1, happy_var_3]
)}}
happyReduce_247 = happySpecReduce_3 56# happyReduction_247
happyReduction_247 happy_x_3
happy_x_2
happy_x_1
= case happyOut70 happy_x_1 of { happy_var_1 ->
case happyOut70 happy_x_3 of { happy_var_3 ->
happyIn70
(at (happy_var_1,happy_var_3) $ TApp TCMul [happy_var_1, happy_var_3]
)}}
happyReduce_248 = happySpecReduce_3 56# happyReduction_248
happyReduction_248 happy_x_3
happy_x_2
happy_x_1
= case happyOut70 happy_x_1 of { happy_var_1 ->
case happyOut70 happy_x_3 of { happy_var_3 ->
happyIn70
(at (happy_var_1,happy_var_3) $ TApp TCDiv [happy_var_1, happy_var_3]
)}}
happyReduce_249 = happySpecReduce_3 56# happyReduction_249
happyReduction_249 happy_x_3
happy_x_2
happy_x_1
= case happyOut70 happy_x_1 of { happy_var_1 ->
case happyOut70 happy_x_3 of { happy_var_3 ->
happyIn70
(at (happy_var_1,happy_var_3) $ TApp TCMod [happy_var_1, happy_var_3]
)}}
happyReduce_250 = happySpecReduce_3 56# happyReduction_250
happyReduction_250 happy_x_3
happy_x_2
happy_x_1
= case happyOut70 happy_x_1 of { happy_var_1 ->
case happyOut70 happy_x_3 of { happy_var_3 ->
happyIn70
(at (happy_var_1,happy_var_3) $ TApp TCExp [happy_var_1, happy_var_3]
)}}
happyReduce_251 = happySpecReduce_1 56# happyReduction_251
happyReduction_251 happy_x_1
= case happyOut71 happy_x_1 of { happy_var_1 ->
happyIn70
(happy_var_1
)}
happyReduce_252 = happySpecReduce_2 57# happyReduction_252
happyReduction_252 happy_x_2
happy_x_1
= case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (KW KW_lg2 ) _)) ->
case happyOut72 happy_x_2 of { happy_var_2 ->
happyIn71
(at (happy_var_1,happy_var_2) $ TApp TCLg2 [happy_var_2]
)}}
happyReduce_253 = happySpecReduce_3 57# happyReduction_253
happyReduction_253 happy_x_3
happy_x_2
happy_x_1
= case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (KW KW_lengthFromThen) _)) ->
case happyOut72 happy_x_2 of { happy_var_2 ->
case happyOut72 happy_x_3 of { happy_var_3 ->
happyIn71
(at (happy_var_1,happy_var_3) $ TApp TCLenFromThen [happy_var_2,happy_var_3]
)}}}
happyReduce_254 = happyReduce 4# 57# happyReduction_254
happyReduction_254 (happy_x_4 `HappyStk`
happy_x_3 `HappyStk`
happy_x_2 `HappyStk`
happy_x_1 `HappyStk`
happyRest)
= case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (KW KW_lengthFromThenTo) _)) ->
case happyOut72 happy_x_2 of { happy_var_2 ->
case happyOut72 happy_x_3 of { happy_var_3 ->
case happyOut72 happy_x_4 of { happy_var_4 ->
happyIn71
(at (happy_var_1,happy_var_4) $ TApp TCLenFromThen [happy_var_2,happy_var_3,happy_var_4]
) `HappyStk` happyRest}}}}
happyReduce_255 = happySpecReduce_3 57# happyReduction_255
happyReduction_255 happy_x_3
happy_x_2
happy_x_1
= case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (KW KW_min ) _)) ->
case happyOut72 happy_x_2 of { happy_var_2 ->
case happyOut72 happy_x_3 of { happy_var_3 ->
happyIn71
(at (happy_var_1,happy_var_3) $ TApp TCMin [happy_var_2,happy_var_3]
)}}}
happyReduce_256 = happySpecReduce_3 57# happyReduction_256
happyReduction_256 happy_x_3
happy_x_2
happy_x_1
= case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (KW KW_max ) _)) ->
case happyOut72 happy_x_2 of { happy_var_2 ->
case happyOut72 happy_x_3 of { happy_var_3 ->
happyIn71
(at (happy_var_1,happy_var_3) $ TApp TCMax [happy_var_2,happy_var_3]
)}}}
happyReduce_257 = happySpecReduce_2 57# happyReduction_257
happyReduction_257 happy_x_2
happy_x_1
= case happyOut74 happy_x_1 of { happy_var_1 ->
case happyOut72 happy_x_2 of { happy_var_2 ->
happyIn71
(at (happy_var_1,happy_var_2) $ foldr TSeq happy_var_2 (reverse (thing happy_var_1))
)}}
happyReduce_258 = happySpecReduce_2 57# happyReduction_258
happyReduction_258 happy_x_2
happy_x_1
= case happyOut81 happy_x_1 of { happy_var_1 ->
case happyOut73 happy_x_2 of { happy_var_2 ->
happyIn71
(at (happy_var_1,head happy_var_2)
$ TUser (thing happy_var_1) (reverse happy_var_2)
)}}
happyReduce_259 = happySpecReduce_1 57# happyReduction_259
happyReduction_259 happy_x_1
= case happyOut72 happy_x_1 of { happy_var_1 ->
happyIn71
(happy_var_1
)}
happyReduce_260 = happySpecReduce_1 58# happyReduction_260
happyReduction_260 happy_x_1
= case happyOut81 happy_x_1 of { happy_var_1 ->
happyIn72
(at happy_var_1 $ TUser (thing happy_var_1) []
)}
happyReduce_261 = happySpecReduce_1 58# happyReduction_261
happyReduction_261 happy_x_1
= case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (KW KW_Bit ) _)) ->
happyIn72
(at happy_var_1 $ TBit
)}
happyReduce_262 = happySpecReduce_1 58# happyReduction_262
happyReduction_262 happy_x_1
= case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (KW KW_inf ) _)) ->
happyIn72
(at happy_var_1 $ TInf
)}
happyReduce_263 = happySpecReduce_1 58# happyReduction_263
happyReduction_263 happy_x_1
= case happyOutTok happy_x_1 of { (happy_var_1@(Located _ (Token (Num {}) _))) ->
happyIn72
(at happy_var_1 $ TNum (getNum happy_var_1)
)}
happyReduce_264 = happySpecReduce_1 58# happyReduction_264
happyReduction_264 happy_x_1
= case happyOutTok happy_x_1 of { (happy_var_1@(Located _ (Token (ChrLit {}) _))) ->
happyIn72
(at happy_var_1 $ TChar (toEnum $ fromInteger
$ getNum happy_var_1)
)}
happyReduce_265 = happySpecReduce_3 58# happyReduction_265
happyReduction_265 happy_x_3
happy_x_2
happy_x_1
= case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (Sym BracketL) _)) ->
case happyOut70 happy_x_2 of { happy_var_2 ->
case happyOutTok happy_x_3 of { (Located happy_var_3 (Token (Sym BracketR) _)) ->
happyIn72
(at (happy_var_1,happy_var_3) $ TSeq happy_var_2 TBit
)}}}
happyReduce_266 = happySpecReduce_3 58# happyReduction_266
happyReduction_266 happy_x_3
happy_x_2
happy_x_1
= case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (Sym ParenL ) _)) ->
case happyOut70 happy_x_2 of { happy_var_2 ->
case happyOutTok happy_x_3 of { (Located happy_var_3 (Token (Sym ParenR ) _)) ->
happyIn72
(at (happy_var_1,happy_var_3) happy_var_2
)}}}
happyReduce_267 = happySpecReduce_2 58# happyReduction_267
happyReduction_267 happy_x_2
happy_x_1
= case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (Sym ParenL ) _)) ->
case happyOutTok happy_x_2 of { (Located happy_var_2 (Token (Sym ParenR ) _)) ->
happyIn72
(at (happy_var_1,happy_var_2) $ TTuple []
)}}
happyReduce_268 = happySpecReduce_3 58# happyReduction_268
happyReduction_268 happy_x_3
happy_x_2
happy_x_1
= case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (Sym ParenL ) _)) ->
case happyOut75 happy_x_2 of { happy_var_2 ->
case happyOutTok happy_x_3 of { (Located happy_var_3 (Token (Sym ParenR ) _)) ->
happyIn72
(at (happy_var_1,happy_var_3) $ TTuple (reverse happy_var_2)
)}}}
happyReduce_269 = happySpecReduce_2 58# happyReduction_269
happyReduction_269 happy_x_2
happy_x_1
= case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (Sym CurlyL ) _)) ->
case happyOutTok happy_x_2 of { (Located happy_var_2 (Token (Sym CurlyR ) _)) ->
happyIn72
(at (happy_var_1,happy_var_2) $ TRecord []
)}}
happyReduce_270 = happySpecReduce_3 58# happyReduction_270
happyReduction_270 happy_x_3
happy_x_2
happy_x_1
= case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (Sym CurlyL ) _)) ->
case happyOut77 happy_x_2 of { happy_var_2 ->
case happyOutTok happy_x_3 of { (Located happy_var_3 (Token (Sym CurlyR ) _)) ->
happyIn72
(at (happy_var_1,happy_var_3) $ TRecord (reverse happy_var_2)
)}}}
happyReduce_271 = happySpecReduce_1 58# happyReduction_271
happyReduction_271 happy_x_1
= case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (Sym Underscore ) _)) ->
happyIn72
(at happy_var_1 TWild
)}
happyReduce_272 = happySpecReduce_1 59# happyReduction_272
happyReduction_272 happy_x_1
= case happyOut72 happy_x_1 of { happy_var_1 ->
happyIn73
([ happy_var_1 ]
)}
happyReduce_273 = happySpecReduce_2 59# happyReduction_273
happyReduction_273 happy_x_2
happy_x_1
= case happyOut73 happy_x_1 of { happy_var_1 ->
case happyOut72 happy_x_2 of { happy_var_2 ->
happyIn73
(happy_var_2 : happy_var_1
)}}
happyReduce_274 = happySpecReduce_3 60# happyReduction_274
happyReduction_274 happy_x_3
happy_x_2
happy_x_1
= case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (Sym BracketL) _)) ->
case happyOut70 happy_x_2 of { happy_var_2 ->
case happyOutTok happy_x_3 of { (Located happy_var_3 (Token (Sym BracketR) _)) ->
happyIn74
(Located (rComb happy_var_1 happy_var_3) [ happy_var_2 ]
)}}}
happyReduce_275 = happyReduce 4# 60# happyReduction_275
happyReduction_275 (happy_x_4 `HappyStk`
happy_x_3 `HappyStk`
happy_x_2 `HappyStk`
happy_x_1 `HappyStk`
happyRest)
= case happyOut74 happy_x_1 of { happy_var_1 ->
case happyOut70 happy_x_3 of { happy_var_3 ->
case happyOutTok happy_x_4 of { (Located happy_var_4 (Token (Sym BracketR) _)) ->
happyIn74
(at (happy_var_1,happy_var_4) (fmap (happy_var_3 :) happy_var_1)
) `HappyStk` happyRest}}}
happyReduce_276 = happySpecReduce_3 61# happyReduction_276
happyReduction_276 happy_x_3
happy_x_2
happy_x_1
= case happyOut70 happy_x_1 of { happy_var_1 ->
case happyOut70 happy_x_3 of { happy_var_3 ->
happyIn75
([ happy_var_3, happy_var_1]
)}}
happyReduce_277 = happySpecReduce_3 61# happyReduction_277
happyReduction_277 happy_x_3
happy_x_2
happy_x_1
= case happyOut75 happy_x_1 of { happy_var_1 ->
case happyOut70 happy_x_3 of { happy_var_3 ->
happyIn75
(happy_var_3 : happy_var_1
)}}
happyReduce_278 = happySpecReduce_3 62# happyReduction_278
happyReduction_278 happy_x_3
happy_x_2
happy_x_1
= case happyOut79 happy_x_1 of { happy_var_1 ->
case happyOut70 happy_x_3 of { happy_var_3 ->
happyIn76
(Named { name = happy_var_1, value = happy_var_3 }
)}}
happyReduce_279 = happySpecReduce_1 63# happyReduction_279
happyReduction_279 happy_x_1
= case happyOut76 happy_x_1 of { happy_var_1 ->
happyIn77
([happy_var_1]
)}
happyReduce_280 = happySpecReduce_3 63# happyReduction_280
happyReduction_280 happy_x_3
happy_x_2
happy_x_1
= case happyOut77 happy_x_1 of { happy_var_1 ->
case happyOut76 happy_x_3 of { happy_var_3 ->
happyIn77
(happy_var_3 : happy_var_1
)}}
happyReduce_281 = happySpecReduce_1 64# happyReduction_281
happyReduction_281 happy_x_1
= case happyOut79 happy_x_1 of { happy_var_1 ->
happyIn78
([happy_var_1]
)}
happyReduce_282 = happySpecReduce_3 64# happyReduction_282
happyReduction_282 happy_x_3
happy_x_2
happy_x_1
= case happyOut78 happy_x_1 of { happy_var_1 ->
case happyOut79 happy_x_3 of { happy_var_3 ->
happyIn78
(happy_var_3 : happy_var_1
)}}
happyReduce_283 = happySpecReduce_1 65# happyReduction_283
happyReduction_283 happy_x_1
= case happyOutTok happy_x_1 of { (happy_var_1@(Located _ (Token (Ident {}) _))) ->
happyIn79
(happy_var_1 { thing = getName happy_var_1 }
)}
happyReduce_284 = happySpecReduce_1 65# happyReduction_284
happyReduction_284 happy_x_1
= case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (KW KW_x) _)) ->
happyIn79
(Located { srcRange = happy_var_1, thing = Name "x" }
)}
happyReduce_285 = happySpecReduce_1 65# happyReduction_285
happyReduction_285 happy_x_1
= case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (KW KW_private) _)) ->
happyIn79
(Located { srcRange = happy_var_1, thing = Name "private" }
)}
happyReduce_286 = happySpecReduce_1 65# happyReduction_286
happyReduction_286 happy_x_1
= case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (KW KW_as) _)) ->
happyIn79
(Located { srcRange = happy_var_1, thing = Name "as" }
)}
happyReduce_287 = happySpecReduce_1 65# happyReduction_287
happyReduction_287 happy_x_1
= case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (KW KW_hiding) _)) ->
happyIn79
(Located { srcRange = happy_var_1, thing = Name "hiding" }
)}
happyReduce_288 = happySpecReduce_1 66# happyReduction_288
happyReduction_288 happy_x_1
= case happyOut78 happy_x_1 of { happy_var_1 ->
happyIn80
(mkModName happy_var_1
)}
happyReduce_289 = happySpecReduce_1 67# happyReduction_289
happyReduction_289 happy_x_1
= case happyOut78 happy_x_1 of { happy_var_1 ->
happyIn81
(mkQName happy_var_1
)}
happyReduce_290 = happySpecReduce_1 68# happyReduction_290
happyReduction_290 happy_x_1
= case happyOut81 happy_x_1 of { happy_var_1 ->
happyIn82
(at happy_var_1 $ TUser (thing happy_var_1) []
)}
happyReduce_291 = happySpecReduce_1 68# happyReduction_291
happyReduction_291 happy_x_1
= case happyOutTok happy_x_1 of { (happy_var_1@(Located _ (Token (Num {}) _))) ->
happyIn82
(at happy_var_1 $ TNum (getNum happy_var_1)
)}
happyReduce_292 = happyMonadReduce 3# 68# happyReduction_292
happyReduction_292 (happy_x_3 `HappyStk`
happy_x_2 `HappyStk`
happy_x_1 `HappyStk`
happyRest) tk
= happyThen (case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (Sym ParenL ) _)) ->
case happyOut70 happy_x_2 of { happy_var_2 ->
case happyOutTok happy_x_3 of { (Located happy_var_3 (Token (Sym ParenR ) _)) ->
( validDemotedType (rComb happy_var_1 happy_var_3) happy_var_2)}}}
) (\r -> happyReturn (happyIn82 r))
happyReduce_293 = happySpecReduce_2 68# happyReduction_293
happyReduction_293 happy_x_2
happy_x_1
= case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (Sym CurlyL ) _)) ->
case happyOutTok happy_x_2 of { (Located happy_var_2 (Token (Sym CurlyR ) _)) ->
happyIn82
(at (happy_var_1,happy_var_2) (TRecord [])
)}}
happyReduce_294 = happySpecReduce_3 68# happyReduction_294
happyReduction_294 happy_x_3
happy_x_2
happy_x_1
= case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (Sym CurlyL ) _)) ->
case happyOut84 happy_x_2 of { happy_var_2 ->
case happyOutTok happy_x_3 of { (Located happy_var_3 (Token (Sym CurlyR ) _)) ->
happyIn82
(at (happy_var_1,happy_var_3) (TRecord (reverse happy_var_2))
)}}}
happyReduce_295 = happySpecReduce_3 68# happyReduction_295
happyReduction_295 happy_x_3
happy_x_2
happy_x_1
= case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (Sym CurlyL ) _)) ->
case happyOut70 happy_x_2 of { happy_var_2 ->
case happyOutTok happy_x_3 of { (Located happy_var_3 (Token (Sym CurlyR ) _)) ->
happyIn82
(anonRecord (getLoc (happy_var_1,happy_var_3)) [happy_var_2]
)}}}
happyReduce_296 = happySpecReduce_3 68# happyReduction_296
happyReduction_296 happy_x_3
happy_x_2
happy_x_1
= case happyOutTok happy_x_1 of { (Located happy_var_1 (Token (Sym CurlyL ) _)) ->
case happyOut75 happy_x_2 of { happy_var_2 ->
case happyOutTok happy_x_3 of { (Located happy_var_3 (Token (Sym CurlyR ) _)) ->
happyIn82
(anonRecord (getLoc (happy_var_1,happy_var_3)) (reverse happy_var_2)
)}}}
happyReduce_297 = happySpecReduce_3 69# happyReduction_297
happyReduction_297 happy_x_3
happy_x_2
happy_x_1
= case happyOut79 happy_x_1 of { happy_var_1 ->
case happyOut70 happy_x_3 of { happy_var_3 ->
happyIn83
(Named { name = happy_var_1, value = happy_var_3 }
)}}
happyReduce_298 = happySpecReduce_1 70# happyReduction_298
happyReduction_298 happy_x_1
= case happyOut83 happy_x_1 of { happy_var_1 ->
happyIn84
([happy_var_1]
)}
happyReduce_299 = happySpecReduce_3 70# happyReduction_299
happyReduction_299 happy_x_3
happy_x_2
happy_x_1
= case happyOut84 happy_x_1 of { happy_var_1 ->
case happyOut83 happy_x_3 of { happy_var_3 ->
happyIn84
(happy_var_3 : happy_var_1
)}}
happyNewToken action sts stk
= lexerP(\tk ->
let cont i = happyDoAction i tk action sts stk in
case tk of {
Located _ (Token EOF _) -> happyDoAction 96# tk action sts stk;
happy_dollar_dollar@(Located _ (Token (Num {}) _)) -> cont 1#;
happy_dollar_dollar@(Located _ (Token (Ident {}) _)) -> cont 2#;
happy_dollar_dollar@(Located _ (Token (StrLit {}) _)) -> cont 3#;
happy_dollar_dollar@(Located _ (Token (ChrLit {}) _)) -> cont 4#;
Located happy_dollar_dollar (Token (KW KW_include) _) -> cont 5#;
Located happy_dollar_dollar (Token (KW KW_import) _) -> cont 6#;
Located happy_dollar_dollar (Token (KW KW_as) _) -> cont 7#;
Located happy_dollar_dollar (Token (KW KW_hiding) _) -> cont 8#;
Located happy_dollar_dollar (Token (KW KW_private) _) -> cont 9#;
Located happy_dollar_dollar (Token (KW KW_property) _) -> cont 10#;
Located happy_dollar_dollar (Token (KW KW_False ) _) -> cont 11#;
Located happy_dollar_dollar (Token (KW KW_True ) _) -> cont 12#;
Located happy_dollar_dollar (Token (KW KW_Arith ) _) -> cont 13#;
Located happy_dollar_dollar (Token (KW KW_Bit ) _) -> cont 14#;
Located happy_dollar_dollar (Token (KW KW_Cmp ) _) -> cont 15#;
Located happy_dollar_dollar (Token (KW KW_error ) _) -> cont 16#;
Located happy_dollar_dollar (Token (KW KW_fin ) _) -> cont 17#;
Located happy_dollar_dollar (Token (KW KW_inf ) _) -> cont 18#;
Located happy_dollar_dollar (Token (KW KW_lg2 ) _) -> cont 19#;
Located happy_dollar_dollar (Token (KW KW_lengthFromThen) _) -> cont 20#;
Located happy_dollar_dollar (Token (KW KW_lengthFromThenTo) _) -> cont 21#;
Located happy_dollar_dollar (Token (KW KW_type ) _) -> cont 22#;
Located happy_dollar_dollar (Token (KW KW_newtype) _) -> cont 23#;
Located happy_dollar_dollar (Token (KW KW_module ) _) -> cont 24#;
Located happy_dollar_dollar (Token (KW KW_where ) _) -> cont 25#;
Located happy_dollar_dollar (Token (KW KW_let ) _) -> cont 26#;
Located happy_dollar_dollar (Token (KW KW_if ) _) -> cont 27#;
Located happy_dollar_dollar (Token (KW KW_then ) _) -> cont 28#;
Located happy_dollar_dollar (Token (KW KW_else ) _) -> cont 29#;
Located happy_dollar_dollar (Token (KW KW_min ) _) -> cont 30#;
Located happy_dollar_dollar (Token (KW KW_max ) _) -> cont 31#;
Located happy_dollar_dollar (Token (KW KW_zero ) _) -> cont 32#;
Located happy_dollar_dollar (Token (KW KW_join ) _) -> cont 33#;
Located happy_dollar_dollar (Token (KW KW_reverse) _) -> cont 34#;
Located happy_dollar_dollar (Token (KW KW_split ) _) -> cont 35#;
Located happy_dollar_dollar (Token (KW KW_splitAt) _) -> cont 36#;
Located happy_dollar_dollar (Token (KW KW_transpose) _) -> cont 37#;
Located happy_dollar_dollar (Token (KW KW_x) _) -> cont 38#;
Located happy_dollar_dollar (Token (KW KW_pmult) _) -> cont 39#;
Located happy_dollar_dollar (Token (KW KW_pmod) _) -> cont 40#;
Located happy_dollar_dollar (Token (KW KW_pdiv) _) -> cont 41#;
Located happy_dollar_dollar (Token (KW KW_random) _) -> cont 42#;
Located happy_dollar_dollar (Token (Sym BracketL) _) -> cont 43#;
Located happy_dollar_dollar (Token (Sym BracketR) _) -> cont 44#;
Located happy_dollar_dollar (Token (Sym ArrL ) _) -> cont 45#;
Located happy_dollar_dollar (Token (Sym DotDot ) _) -> cont 46#;
Located happy_dollar_dollar (Token (Sym DotDotDot) _) -> cont 47#;
Located happy_dollar_dollar (Token (Sym Bar ) _) -> cont 48#;
Located happy_dollar_dollar (Token (Sym ParenL ) _) -> cont 49#;
Located happy_dollar_dollar (Token (Sym ParenR ) _) -> cont 50#;
Located happy_dollar_dollar (Token (Sym Comma ) _) -> cont 51#;
Located happy_dollar_dollar (Token (Sym Semi ) _) -> cont 52#;
Located happy_dollar_dollar (Token (Sym Dot ) _) -> cont 53#;
Located happy_dollar_dollar (Token (Sym CurlyL ) _) -> cont 54#;
Located happy_dollar_dollar (Token (Sym CurlyR ) _) -> cont 55#;
Located happy_dollar_dollar (Token (Sym TriL ) _) -> cont 56#;
Located happy_dollar_dollar (Token (Sym TriR ) _) -> cont 57#;
Located happy_dollar_dollar (Token (Sym EqDef ) _) -> cont 58#;
Located happy_dollar_dollar (Token (Sym BackTick) _) -> cont 59#;
Located happy_dollar_dollar (Token (Sym Colon ) _) -> cont 60#;
Located happy_dollar_dollar (Token (Sym ColonColon) _) -> cont 61#;
Located happy_dollar_dollar (Token (Sym ArrR ) _) -> cont 62#;
Located happy_dollar_dollar (Token (Sym FatArrR ) _) -> cont 63#;
Located happy_dollar_dollar (Token (Sym Lambda ) _) -> cont 64#;
Located happy_dollar_dollar (Token (Sym Underscore ) _) -> cont 65#;
Located happy_dollar_dollar (Token (Virt VCurlyL) _) -> cont 66#;
Located happy_dollar_dollar (Token (Virt VCurlyR) _) -> cont 67#;
Located happy_dollar_dollar (Token (Virt VSemi) _) -> cont 68#;
Located happy_dollar_dollar (Token (Op Plus ) _) -> cont 69#;
Located happy_dollar_dollar (Token (Op Minus ) _) -> cont 70#;
Located happy_dollar_dollar (Token (Op Mul ) _) -> cont 71#;
Located happy_dollar_dollar (Token (Op Div ) _) -> cont 72#;
Located happy_dollar_dollar (Token (Op Exp ) _) -> cont 73#;
Located happy_dollar_dollar (Token (Op Mod ) _) -> cont 74#;
Located happy_dollar_dollar (Token (Op Xor ) _) -> cont 75#;
Located happy_dollar_dollar (Token (Op Disj ) _) -> cont 76#;
Located happy_dollar_dollar (Token (Op Conj ) _) -> cont 77#;
Located happy_dollar_dollar (Token (Op NotEqual ) _) -> cont 78#;
Located happy_dollar_dollar (Token (Op Equal ) _) -> cont 79#;
Located happy_dollar_dollar (Token (Op NotEqualFun ) _) -> cont 80#;
Located happy_dollar_dollar (Token (Op EqualFun ) _) -> cont 81#;
Located happy_dollar_dollar (Token (Op GreaterThan ) _) -> cont 82#;
Located happy_dollar_dollar (Token (Op LessThan ) _) -> cont 83#;
Located happy_dollar_dollar (Token (Op LEQ ) _) -> cont 84#;
Located happy_dollar_dollar (Token (Op GEQ ) _) -> cont 85#;
Located happy_dollar_dollar (Token (Op ShiftR ) _) -> cont 86#;
Located happy_dollar_dollar (Token (Op ShiftL ) _) -> cont 87#;
Located happy_dollar_dollar (Token (Op RotR ) _) -> cont 88#;
Located happy_dollar_dollar (Token (Op RotL ) _) -> cont 89#;
Located happy_dollar_dollar (Token (Op Complement ) _) -> cont 90#;
Located happy_dollar_dollar (Token (Op At ) _) -> cont 91#;
Located happy_dollar_dollar (Token (Op AtAt ) _) -> cont 92#;
Located happy_dollar_dollar (Token (Op Bang ) _) -> cont 93#;
Located happy_dollar_dollar (Token (Op BangBang ) _) -> cont 94#;
Located happy_dollar_dollar (Token (Op Hash ) _) -> cont 95#;
_ -> happyError' tk
})
happyError_ 96# tk = happyError' tk
happyError_ _ tk = happyError' tk
happyThen :: () => ParseM a -> (a -> ParseM b) -> ParseM b
happyThen = (>>=)
happyReturn :: () => a -> ParseM a
happyReturn = (return)
happyThen1 = happyThen
happyReturn1 :: () => a -> ParseM a
happyReturn1 = happyReturn
happyError' :: () => (Located Token) -> ParseM a
happyError' tk = (\token -> happyError) tk
vmodule = happySomeParser where
happySomeParser = happyThen (happyParse 0#) (\x -> happyReturn (happyOut14 x))
program = happySomeParser where
happySomeParser = happyThen (happyParse 1#) (\x -> happyReturn (happyOut22 x))
programLayout = happySomeParser where
happySomeParser = happyThen (happyParse 2#) (\x -> happyReturn (happyOut23 x))
expr = happySomeParser where
happySomeParser = happyThen (happyParse 3#) (\x -> happyReturn (happyOut38 x))
decl = happySomeParser where
happySomeParser = happyThen (happyParse 4#) (\x -> happyReturn (happyOut28 x))
decls = happySomeParser where
happySomeParser = happyThen (happyParse 5#) (\x -> happyReturn (happyOut34 x))
declsLayout = happySomeParser where
happySomeParser = happyThen (happyParse 6#) (\x -> happyReturn (happyOut36 x))
letDecl = happySomeParser where
happySomeParser = happyThen (happyParse 7#) (\x -> happyReturn (happyOut29 x))
repl = happySomeParser where
happySomeParser = happyThen (happyParse 8#) (\x -> happyReturn (happyOut37 x))
schema = happySomeParser where
happySomeParser = happyThen (happyParse 9#) (\x -> happyReturn (happyOut60 x))
modName = happySomeParser where
happySomeParser = happyThen (happyParse 10#) (\x -> happyReturn (happyOut80 x))
happySeq = happyDontSeq
parseModName :: String -> Maybe ModName
parseModName txt =
case parse defaultConfig { cfgModuleScope = False } modName txt of
Right a -> Just (thing a)
Left _ -> Nothing
addImplicitIncludes :: Config -> Program -> Program
addImplicitIncludes cfg (Program ds) =
Program $ map path (cfgAutoInclude cfg) ++ ds
where path p = Include Located { srcRange = rng, thing = p }
rng = Range { source = cfgSource cfg, from = start, to = start }
parseProgramWith :: Config -> String -> Either ParseError Program
parseProgramWith cfg s = case res s of
Left err -> Left err
Right a -> Right (addImplicitIncludes cfg a)
where
res = parse cfg $ case cfgLayout cfg of
Layout -> programLayout
NoLayout -> program
parseModule :: Config -> String -> Either ParseError Module
parseModule cfg = parse cfg { cfgModuleScope = True } vmodule
parseProgram :: Layout -> String -> Either ParseError Program
parseProgram l = parseProgramWith defaultConfig { cfgLayout = l }
parseExprWith :: Config -> String -> Either ParseError Expr
parseExprWith cfg = parse cfg { cfgModuleScope = False } expr
parseExpr :: String -> Either ParseError Expr
parseExpr = parseExprWith defaultConfig
parseDeclWith :: Config -> String -> Either ParseError Decl
parseDeclWith cfg = parse cfg { cfgModuleScope = False } decl
parseDecl :: String -> Either ParseError Decl
parseDecl = parseDeclWith defaultConfig
parseDeclsWith :: Config -> String -> Either ParseError [Decl]
parseDeclsWith cfg = parse cfg { cfgModuleScope = ms } decls'
where (ms, decls') = case cfgLayout cfg of
Layout -> (True, declsLayout)
NoLayout -> (False, decls)
parseDecls :: String -> Either ParseError [Decl]
parseDecls = parseDeclsWith defaultConfig
parseLetDeclWith :: Config -> String -> Either ParseError Decl
parseLetDeclWith cfg = parse cfg { cfgModuleScope = False } letDecl
parseLetDecl :: String -> Either ParseError Decl
parseLetDecl = parseLetDeclWith defaultConfig
parseReplWith :: Config -> String -> Either ParseError ReplInput
parseReplWith cfg = parse cfg { cfgModuleScope = False } repl
parseRepl :: String -> Either ParseError ReplInput
parseRepl = parseReplWith defaultConfig
parseSchemaWith :: Config -> String -> Either ParseError Schema
parseSchemaWith cfg = parse cfg { cfgModuleScope = False } schema
parseSchema :: String -> Either ParseError Schema
parseSchema = parseSchemaWith defaultConfig
-- vim: ft=haskell
{-# LINE 1 "templates/GenericTemplate.hs" #-}
{-# LINE 1 "templates/GenericTemplate.hs" #-}
{-# LINE 1 "" #-}
{-# LINE 1 "templates/GenericTemplate.hs" #-}
-- Id: GenericTemplate.hs,v 1.26 2005/01/14 14:47:22 simonmar Exp
{-# LINE 13 "templates/GenericTemplate.hs" #-}
-- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex.
#if __GLASGOW_HASKELL__ > 706
#define LT(n,m) ((Happy_GHC_Exts.tagToEnum# (n Happy_GHC_Exts.<# m)) :: Bool)
#define GTE(n,m) ((Happy_GHC_Exts.tagToEnum# (n Happy_GHC_Exts.>=# m)) :: Bool)
#define EQ(n,m) ((Happy_GHC_Exts.tagToEnum# (n Happy_GHC_Exts.==# m)) :: Bool)
#else
#define LT(n,m) (n Happy_GHC_Exts.<# m)
#define GTE(n,m) (n Happy_GHC_Exts.>=# m)
#define EQ(n,m) (n Happy_GHC_Exts.==# m)
#endif
{-# LINE 46 "templates/GenericTemplate.hs" #-}
data Happy_IntList = HappyCons Happy_GHC_Exts.Int# Happy_IntList
{-# LINE 67 "templates/GenericTemplate.hs" #-}
{-# LINE 77 "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 | LT(n,(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 GTE(off_i,(0# :: Happy_GHC_Exts.Int#))
then EQ(indexShortOffAddr happyCheck off_i, i)
else False
action
| check = indexShortOffAddr happyTable off_i
| otherwise = indexShortOffAddr happyDefActions st
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 170 "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 =
case happyDrop k (HappyCons (st) (sts)) of
sts1@((HappyCons (st1@(action)) (_))) ->
let drop_stk = happyDropStk k stk in
happyThen1 (fn stk tk) (\r -> happyGoto nt j tk st1 sts1 (r `HappyStk` drop_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 =
case happyDrop k (HappyCons (st) (sts)) of
sts1@((HappyCons (st1@(action)) (_))) ->
let drop_stk = happyDropStk k stk
off = indexShortOffAddr happyGotoOffsets st1
off_i = (off Happy_GHC_Exts.+# nt)
new_state = indexShortOffAddr happyTable off_i
in
happyThen1 (fn stk tk) (\r -> happyNewToken new_state sts1 (r `HappyStk` drop_stk))
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.
cryptol-2.2.6/dist/build/Cryptol/Parser/ 0000755 0000000 0000000 00000000000 12637103425 016340 5 ustar 00 0000000 0000000 cryptol-2.2.6/dist/build/Cryptol/Parser/Lexer.hs 0000644 0000000 0000000 00001531647 12637103426 017775 0 ustar 00 0000000 0000000 {-# OPTIONS_GHC -fno-warn-unused-binds -fno-warn-missing-signatures #-}
{-# LANGUAGE CPP,MagicHash #-}
{-# LINE 1 "src/Cryptol/Parser/Lexer.x" #-}
-- At present Alex generates code with too many warnings.
{-# LANGUAGE Trustworthy #-}
{-# OPTIONS_GHC -w #-}
module Cryptol.Parser.Lexer
( primLexer, lexer, Layout(..)
, Token(..), TokenT(..)
, TokenV(..), TokenKW(..), TokenErr(..), TokenOp(..), TokenSym(..), TokenW(..)
, Located(..)
, Config(..)
, defaultConfig
) where
import Cryptol.Parser.Position
import Cryptol.Parser.LexerUtils
import Cryptol.Parser.Unlit(unLit)
import qualified Data.Text.Lazy as Text
#if __GLASGOW_HASKELL__ >= 603
#include "ghcconfig.h"
#elif defined(__GLASGOW_HASKELL__)
#include "config.h"
#endif
#if __GLASGOW_HASKELL__ >= 503
import Data.Array
import Data.Array.Base (unsafeAt)
#else
import Array
#endif
#if __GLASGOW_HASKELL__ >= 503
import GHC.Exts
#else
import GlaExts
#endif
alex_tab_size :: Int
alex_tab_size = 8
alex_base :: AlexAddr
alex_base = AlexA# "\xf8\xff\xff\xff\x6d\x00\x00\x00\x63\x01\x00\x00\x59\x02\x00\x00\xe2\x00\x00\x00\xd9\x02\x00\x00\x59\x03\x00\x00\xd9\x03\x00\x00\x59\x04\x00\x00\xd9\x04\x00\x00\x59\x05\x00\x00\xd9\x05\x00\x00\x59\x06\x00\x00\xd9\x06\x00\x00\x59\x07\x00\x00\xd9\x07\x00\x00\x59\x08\x00\x00\x00\x00\x00\x00\xca\x08\x00\x00\x00\x00\x00\x00\x3b\x09\x00\x00\x00\x00\x00\x00\xac\x09\x00\x00\x00\x00\x00\x00\x1d\x0a\x00\x00\x00\x00\x00\x00\x8e\x0a\x00\x00\x00\x00\x00\x00\xff\x0a\x00\x00\x00\x00\x00\x00\x40\x0b\x00\x00\x00\x00\x00\x00\x81\x0b\x00\x00\x00\x00\x00\x00\xc2\x0b\x00\x00\x00\x00\x00\x00\x03\x0c\x00\x00\x00\x00\x00\x00\x44\x0c\x00\x00\x00\x00\x00\x00\x85\x0c\x00\x00\xe0\xff\xff\xff\xfb\x0c\x00\x00\x48\x00\x00\x00\xd7\xff\xff\xff\xdf\xff\xff\xff\xfb\x0d\x00\x00\xbb\x0d\x00\x00\x00\x00\x00\x00\xbb\x0e\x00\x00\x31\x0f\x00\x00\x7c\x0e\x00\x00\x00\x00\x00\x00\x31\x10\x00\x00\xf1\x0f\x00\x00\x00\x00\x00\x00\xf1\x10\x00\x00\x67\x11\x00\x00\xb2\x10\x00\x00\x00\x00\x00\x00\x67\x12\x00\x00\x27\x12\x00\x00\x00\x00\x00\x00\x27\x13\x00\x00\xe7\x12\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe2\xff\xff\xff\x00\x00\x00\x00\xe8\xff\xff\xff\x00\x00\x00\x00\xdd\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd3\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x79\x00\x00\x00\xc9\x15\x00\x00\xa2\x16\x00\x00\x13\x17\x00\x00\x84\x17\x00\x00\xf5\x17\x00\x00\x66\x18\x00\x00\xd7\x18\x00\x00\x48\x19\x00\x00\xb9\x19\x00\x00\x2a\x1a\x00\x00\x9b\x1a\x00\x00\x0c\x1b\x00\x00\x7d\x1b\x00\x00\xee\x1b\x00\x00\x5f\x1c\x00\x00\xd0\x1c\x00\x00\x41\x1d\x00\x00\xb2\x1d\x00\x00\x23\x1e\x00\x00\x94\x1e\x00\x00\x05\x1f\x00\x00\x76\x1f\x00\x00\xe7\x1f\x00\x00\x58\x20\x00\x00\xc9\x20\x00\x00\x3a\x21\x00\x00\xab\x21\x00\x00\x1c\x22\x00\x00\x8d\x22\x00\x00\xfe\x22\x00\x00\x6f\x23\x00\x00\xe0\x23\x00\x00\x51\x24\x00\x00\xc2\x24\x00\x00\x33\x25\x00\x00\xa4\x25\x00\x00\x15\x26\x00\x00\x86\x26\x00\x00\xf7\x26\x00\x00\x68\x27\x00\x00\xd9\x27\x00\x00\x4a\x28\x00\x00\xbb\x28\x00\x00\xe3\xff\xff\xff\x6a\x00\x00\x00\x7f\x00\x00\x00\x34\x02\x00\x00\x4c\x02\x00\x00\x2c\x29\x00\x00\x9d\x29\x00\x00\x0e\x2a\x00\x00\x7f\x2a\x00\x00\xf0\x2a\x00\x00\x61\x2b\x00\x00\xd2\x2b\x00\x00\x43\x2c\x00\x00\xb4\x2c\x00\x00\x25\x2d\x00\x00\x96\x2d\x00\x00\x07\x2e\x00\x00\x78\x2e\x00\x00\xe9\x2e\x00\x00\x5a\x2f\x00\x00\xcb\x2f\x00\x00\x3c\x30\x00\x00\xad\x30\x00\x00\x1e\x31\x00\x00\x8f\x31\x00\x00\x00\x32\x00\x00\x71\x32\x00\x00\xe2\x32\x00\x00\x53\x33\x00\x00\xc4\x33\x00\x00\x35\x34\x00\x00\xa6\x34\x00\x00\x17\x35\x00\x00\x88\x35\x00\x00\xf9\x35\x00\x00\x6a\x36\x00\x00\xdb\x36\x00\x00\x4c\x37\x00\x00\xbd\x37\x00\x00\x2e\x38\x00\x00\x9f\x38\x00\x00\x10\x39\x00\x00\x81\x39\x00\x00\xf2\x39\x00\x00\x63\x3a\x00\x00\xd4\x3a\x00\x00\x45\x3b\x00\x00\xb6\x3b\x00\x00\x27\x3c\x00\x00\x98\x3c\x00\x00\x09\x3d\x00\x00\x7a\x3d\x00\x00\xeb\x3d\x00\x00\x5c\x3e\x00\x00\xcd\x3e\x00\x00\x3e\x3f\x00\x00\xaf\x3f\x00\x00\x20\x40\x00\x00\x91\x40\x00\x00\x02\x41\x00\x00\x73\x41\x00\x00\xe4\x41\x00\x00\x55\x42\x00\x00\xc6\x42\x00\x00\x37\x43\x00\x00\xa8\x43\x00\x00\x19\x44\x00\x00\x8a\x44\x00\x00\xfb\x44\x00\x00\x6c\x45\x00\x00\xdd\x45\x00\x00\x4e\x46\x00\x00\xbf\x46\x00\x00\x30\x47\x00\x00\xa1\x47\x00\x00\x12\x48\x00\x00\x83\x48\x00\x00\xf4\x48\x00\x00\x65\x49\x00\x00\xd6\x49\x00\x00\x47\x4a\x00\x00\xb8\x4a\x00\x00\x29\x4b\x00\x00\x9a\x4b\x00\x00\x0b\x4c\x00\x00\x7c\x4c\x00\x00\xed\x4c\x00\x00\x5e\x4d\x00\x00\xcf\x4d\x00\x00\x40\x4e\x00\x00\xb1\x4e\x00\x00\x22\x4f\x00\x00\x93\x4f\x00\x00\x04\x50\x00\x00\x75\x50\x00\x00\xe6\x50\x00\x00\x57\x51\x00\x00\xc8\x51\x00\x00\x39\x52\x00\x00\xaa\x52\x00\x00\x1b\x53\x00\x00\x8c\x53\x00\x00\xfd\x53\x00\x00\x6e\x54\x00\x00\xdf\x54\x00\x00\x50\x55\x00\x00\xc1\x55\x00\x00\x32\x56\x00\x00\xa3\x56\x00\x00\x14\x57\x00\x00\x85\x57\x00\x00\xf6\x57\x00\x00\x67\x58\x00\x00\xd8\x58\x00\x00\x49\x59\x00\x00\xba\x59\x00\x00\x2b\x5a\x00\x00\x9c\x5a\x00\x00\x0d\x5b\x00\x00\x7e\x5b\x00\x00\xef\x5b\x00\x00\x60\x5c\x00\x00\xd1\x5c\x00\x00\x42\x5d\x00\x00\xb3\x5d\x00\x00\x24\x5e\x00\x00\x95\x5e\x00\x00\x06\x5f\x00\x00\x77\x5f\x00\x00\xe8\x5f\x00\x00\x59\x60\x00\x00\xca\x60\x00\x00\x3b\x61\x00\x00\xac\x61\x00\x00\x1d\x62\x00\x00\x8e\x62\x00\x00\xff\x62\x00\x00\x70\x63\x00\x00\x00\x00\x00\x00\xd8\xff\xff\xff\x00\x00\x00\x00\xed\xff\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\xfa\xff\xff\xff\x4a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x52\x00\x00\x00\x5b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x53\x00\x00\x00\xd9\xff\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x34\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x81\x00\x00\x00\x00\x00\x00\x00\x55\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x66\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x65\x00\x00\x00\x5c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x77\x00\x00\x00\x00\x00\x00\x00\x68\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\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_table :: AlexAddr
alex_table = AlexA# "\x00\x00\x50\x00\x50\x00\x50\x00\x50\x00\x50\x00\x1b\x01\x7d\x00\x7d\x00\x7d\x00\x7d\x00\x7d\x00\x7d\x00\x7d\x00\x7d\x00\x7c\x00\x7c\x00\x43\x00\x42\x00\x7c\x00\x7c\x00\x17\x01\x22\x01\x42\x00\x50\x00\x1c\x01\x37\x01\x20\x01\x51\x00\x0a\x01\x29\x00\x38\x01\x2f\x01\x30\x01\x08\x01\x06\x01\x26\x01\x07\x01\x28\x01\x09\x01\x7f\x00\x7e\x00\x7e\x00\x7e\x00\x7e\x00\x7e\x00\x7e\x00\x7e\x00\x7e\x00\x7e\x00\x29\x01\x27\x01\x11\x01\x25\x01\x10\x01\x0f\x01\x1e\x01\xd6\x00\x95\x00\x96\x00\xc2\x00\x85\x00\xb5\x00\xc2\x00\xc2\x00\xee\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xe0\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x31\x01\x21\x01\x32\x01\x19\x01\x81\x00\x2b\x01\x93\x00\xc2\x00\xc2\x00\xc2\x00\xdf\x00\x9b\x00\xc2\x00\xbd\x00\xfe\x00\xab\x00\xc2\x00\x9d\x00\x9f\x00\xbf\x00\xc2\x00\xdb\x00\xc2\x00\xbb\x00\xce\x00\xd7\x00\xc2\x00\xc2\x00\xcc\x00\x77\x00\xc2\x00\xb2\x00\x33\x01\x2e\x01\x34\x01\x18\x01\x4f\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x50\x00\x50\x00\x50\x00\x50\x00\x50\x00\x0e\x01\x23\x01\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x13\x01\x14\x01\x16\x01\x0b\x01\x2c\x01\x4d\x00\x1f\x01\x2a\x01\x15\x01\x12\x01\x50\x00\x7d\x00\x7d\x00\x7d\x00\x7d\x00\x7d\x00\x7d\x00\x7d\x00\x7d\x00\x1d\x01\x0d\x01\x24\x01\x2d\x01\x36\x01\x00\x00\x00\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x7e\x00\x7e\x00\x7e\x00\x7e\x00\x7e\x00\x7e\x00\x7e\x00\x7e\x00\x7e\x00\x7e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0c\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x2a\x00\x00\x00\x32\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x35\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\x1a\x01\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\x35\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x36\x00\x08\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x22\x00\x0e\x00\x15\x00\x15\x00\x15\x00\x16\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x47\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x44\x00\x00\x00\x00\x00\x00\x00\x00\x00\x46\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\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\x3f\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x40\x00\x05\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x28\x00\x0b\x00\x1b\x00\x1b\x00\x1b\x00\x1c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4b\x00\x7e\x00\x7e\x00\x7e\x00\x7e\x00\x7e\x00\x7e\x00\x7e\x00\x7e\x00\x7e\x00\x7e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x49\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x00\x00\x00\x00\x00\x00\x2d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2b\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x00\x00\x00\x00\x39\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\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\x3c\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3d\x00\x06\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x26\x00\x0c\x00\x19\x00\x19\x00\x19\x00\x1a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3f\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x3c\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x38\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x35\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x31\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x2e\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x05\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x06\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x07\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x08\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x09\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x0a\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1e\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\x20\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\x22\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\x24\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\x26\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\x28\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\x2f\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\x33\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\x36\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\x3a\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\x3d\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\x40\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x31\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x34\x00\x33\x00\x09\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x20\x00\x0f\x00\x13\x00\x13\x00\x13\x00\x14\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x38\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3a\x00\x07\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x24\x00\x0d\x00\x17\x00\x17\x00\x17\x00\x18\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\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\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\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3c\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3d\x00\x06\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x26\x00\x0c\x00\x19\x00\x19\x00\x19\x00\x1a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\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\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\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\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\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\x35\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x36\x00\x08\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x22\x00\x0e\x00\x15\x00\x15\x00\x15\x00\x16\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\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\x2e\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x2f\x00\x0a\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1e\x00\x10\x00\x11\x00\x11\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\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x88\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf3\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x55\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x57\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x58\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x59\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x5e\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x60\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x64\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x67\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x68\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\x69\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x6a\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x6e\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x6f\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x73\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x74\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x75\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x78\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x7a\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x7b\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x04\x01\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x03\x01\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x82\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x83\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x84\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x01\x01\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xff\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xfd\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xf1\x00\xc2\x00\xfb\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xfa\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xf9\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xf8\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xd1\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x8b\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xf6\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xf5\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xe7\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x8d\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x8e\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xf4\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xf2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x8f\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xef\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xed\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xec\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x9c\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xeb\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xea\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xe9\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xa0\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xa7\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xe5\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xe4\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xe3\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xe2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xe1\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xaf\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xd4\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc9\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xdc\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xd9\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xd2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xd0\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xcf\x00\xc2\x00\xc2\x00\xc2\x00\xc8\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xcd\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xca\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xb9\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xba\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc7\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc3\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc4\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc5\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc6\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xbe\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xbc\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xb8\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xb7\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xb4\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xb3\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xb1\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xb0\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xd8\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xda\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xae\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xad\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xdd\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xac\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xaa\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xa9\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xa8\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xa6\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc0\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xe6\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xa5\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xa4\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xa3\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xa1\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xa2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xb6\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xe8\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x9e\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x9a\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x99\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xde\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xd5\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x98\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x97\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x94\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xf0\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x92\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x91\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x90\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xf7\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x8c\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x8a\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x89\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\x87\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x86\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x01\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x02\x01\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x05\x01\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x79\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc1\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x76\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x72\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x71\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x70\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\x6d\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x6c\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x6b\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x66\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x65\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x63\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\x62\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xd3\x00\xc2\x00\xc2\x00\x61\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x5f\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x5d\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xcb\x00\xfc\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x5c\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x5b\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x5a\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x56\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x54\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x53\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x04\x00\x2a\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x52\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\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\x26\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x30\x00\x31\x00\x2f\x00\x2a\x00\x30\x00\x31\x00\x3c\x00\x3e\x00\x2a\x00\x20\x00\x21\x00\x22\x00\x23\x00\x2f\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\x3d\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\x0a\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x3d\x00\x2d\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x3d\x00\x3e\x00\x3e\x00\x5e\x00\x2e\x00\x27\x00\x40\x00\x3a\x00\x3c\x00\x3d\x00\x20\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x21\x00\x3d\x00\x3e\x00\x2e\x00\x3e\x00\xff\xff\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\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\x3d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xce\x00\xcf\x00\xff\xff\x5c\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\x7c\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\x7c\x00\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\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\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\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\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\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\x0a\x00\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x22\x00\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\xff\xff\xff\xff\xff\xff\x62\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\x6f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x78\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\xff\xff\xff\xff\x5c\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\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\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\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\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\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\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\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\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\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\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\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\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\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\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\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\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\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\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\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\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\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\x0a\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\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\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\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\x0a\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\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\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\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\x22\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\x5c\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\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\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5c\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\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\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\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\xff\xff\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\xce\x00\xcf\x00\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xce\x00\xcf\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"#
alex_deflt :: AlexAddr
alex_deflt = AlexA# "\xff\xff\x4c\x00\x45\x00\x48\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\x1d\x00\x1d\x00\x1f\x00\x1f\x00\x21\x00\x21\x00\x23\x00\x23\x00\x25\x00\x25\x00\x27\x00\x27\x00\x30\x00\x30\x00\x34\x00\x34\x00\x37\x00\x37\x00\x3b\x00\x3b\x00\x3e\x00\x3e\x00\x41\x00\x41\x00\xff\xff\xc2\x00\xff\xff\xff\xff\xff\xff\x51\x00\x51\x00\x51\x00\x4e\x00\x4e\x00\x4e\x00\x4e\x00\x4c\x00\x4c\x00\x4c\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x48\x00\x48\x00\x48\x00\x45\x00\x45\x00\x45\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x48\x00\xff\xff\xff\xff\xff\xff\x4c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x51\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"#
alex_accept = listArray (0::Int,312) [AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAcc (alex_action_0),AlexAcc (alex_action_1),AlexAcc (alex_action_2),AlexAcc (alex_action_2),AlexAcc (alex_action_2),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_17),AlexAcc (alex_action_18),AlexAcc (alex_action_19),AlexAcc (alex_action_20),AlexAcc (alex_action_21),AlexAcc (alex_action_22),AlexAcc (alex_action_23),AlexAcc (alex_action_24),AlexAcc (alex_action_25),AlexAcc (alex_action_26),AlexAcc (alex_action_27),AlexAcc (alex_action_28),AlexAcc (alex_action_29),AlexAcc (alex_action_30),AlexAcc (alex_action_31),AlexAcc (alex_action_32),AlexAcc (alex_action_33),AlexAcc (alex_action_34),AlexAcc (alex_action_35),AlexAcc (alex_action_36),AlexAcc (alex_action_37),AlexAcc (alex_action_38),AlexAcc (alex_action_39),AlexAcc (alex_action_40),AlexAcc (alex_action_41),AlexAcc (alex_action_42),AlexAcc (alex_action_43),AlexAcc (alex_action_44),AlexAcc (alex_action_45),AlexAcc (alex_action_46),AlexAcc (alex_action_47),AlexAcc (alex_action_48),AlexAcc (alex_action_49),AlexAcc (alex_action_50),AlexAcc (alex_action_51),AlexAcc (alex_action_52),AlexAcc (alex_action_53),AlexAcc (alex_action_54),AlexAcc (alex_action_55),AlexAcc (alex_action_57),AlexAcc (alex_action_58),AlexAcc (alex_action_59),AlexAcc (alex_action_59),AlexAcc (alex_action_60),AlexAcc (alex_action_61),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_62),AlexAcc (alex_action_63),AlexAcc (alex_action_64),AlexAcc (alex_action_65),AlexAcc (alex_action_66),AlexAcc (alex_action_67),AlexAcc (alex_action_68),AlexAcc (alex_action_69),AlexAcc (alex_action_70),AlexAcc (alex_action_71),AlexAcc (alex_action_72),AlexAcc (alex_action_73),AlexAcc (alex_action_74),AlexAcc (alex_action_75),AlexAcc (alex_action_76),AlexAcc (alex_action_77),AlexAcc (alex_action_78),AlexAcc (alex_action_79),AlexAcc (alex_action_80),AlexAcc (alex_action_81),AlexAcc (alex_action_82),AlexAcc (alex_action_83),AlexAcc (alex_action_84),AlexAcc (alex_action_85),AlexAcc (alex_action_86),AlexAcc (alex_action_87),AlexAcc (alex_action_88),AlexAcc (alex_action_89),AlexAcc (alex_action_90),AlexAcc (alex_action_91),AlexAcc (alex_action_92),AlexAcc (alex_action_93),AlexAcc (alex_action_94),AlexAcc (alex_action_95),AlexAcc (alex_action_96),AlexAcc (alex_action_97),AlexAcc (alex_action_98),AlexAcc (alex_action_99),AlexAcc (alex_action_100),AlexAcc (alex_action_101),AlexAcc (alex_action_102),AlexAcc (alex_action_103),AlexAcc (alex_action_104),AlexAcc (alex_action_105),AlexAcc (alex_action_106),AlexAcc (alex_action_107),AlexAcc (alex_action_108),AlexAcc (alex_action_109),AlexAcc (alex_action_110),AlexAcc (alex_action_111),AlexAcc (alex_action_112),AlexAcc (alex_action_113)]
{-# LINE 176 "src/Cryptol/Parser/Lexer.x" #-}
-- This code is here because it depends on `comment`, which is defined
-- in this file.
stateToInt :: LexS -> Int
stateToInt Normal = 0
stateToInt (InComment {}) = comment
stateToInt (InString {}) = string
stateToInt (InChar {}) = char
-- | Returns the tokens in the last position of the input that we processed.
-- White space is removed, and layout processing is done as requested.
-- This stream is fed to the parser.
lexer :: Config -> String -> ([Located Token], Position)
lexer cfg cs = ( case cfgLayout cfg of
Layout -> layout cfg lexemes
NoLayout -> lexemes
, finalPos
)
where (lex0, finalPos) = primLexer cfg cs
lexemes = dropWhite lex0
-- | Returns the tokens and the last position of the input that we processed.
-- The tokens include whte space tokens.
primLexer :: Config -> String -> ([Located Token], Position)
primLexer cfg cs = run inp Normal
where
inp = Inp { alexPos = start
, alexInputPrevChar = '\n'
, input = Text.unpack -- XXX: Use Text
$ unLit (cfgPreProc cfg)
$ Text.pack cs
, moreBytes = [] }
singleR p = Range p p (cfgSource cfg)
eofR p = Range p' p' (cfgSource cfg)
where
p' = Position { line = line p + 1, col = 0 }
run i s =
case alexScan i (stateToInt s) of
AlexEOF ->
case s of
Normal -> ([ Located (eofR $ alexPos i) (Token EOF "end of file") ]
, alexPos i
)
InComment p _ _ ->
( [ Located (singleR p)
$ Token (Err UnterminatedComment) "unterminated comment"
]
, alexPos i)
InString p _ ->
( [ Located (singleR p)
$ Token (Err UnterminatedString) "unterminated string"
]
, alexPos i)
InChar p _ ->
( [ Located (singleR p)
$ Token (Err UnterminatedChar) "unterminated character"
]
, alexPos i)
AlexError i' ->
let p1 = alexPos i
p2 = alexPos i'
inp = input i
bad = if line p1 == line p2
then take (col p2 - col p1) inp
else takeWhile (/= '\n') inp
in
( [ Located (Range (alexPos i) (alexPos i') (cfgSource cfg))
$ Token (Err LexicalError) bad ]
, alexPos i')
AlexSkip i' _ -> run i' s
AlexToken i' l act ->
let txt = take l (input i)
(mtok,s') = act cfg (alexPos i) txt s
(rest,pos) = run i' $! s'
in case mtok of
Nothing -> (rest, pos)
Just t -> (t : rest, pos)
-- vim: ft=haskell
char,comment,string :: Int
char = 1
comment = 2
string = 3
alex_action_0 = startComment
alex_action_1 = endComent
alex_action_2 = addToComment
alex_action_3 = addToComment
alex_action_4 = addToString
alex_action_5 = endString
alex_action_6 = addToString
alex_action_7 = endString
alex_action_8 = addToChar
alex_action_9 = endChar
alex_action_10 = addToChar
alex_action_11 = endChar
alex_action_12 = emit $ White Space
alex_action_13 = emit $ White LineComment
alex_action_14 = emit $ KW KW_Arith
alex_action_15 = emit $ KW KW_Bit
alex_action_16 = emit $ KW KW_Cmp
alex_action_17 = emit $ KW KW_False
alex_action_18 = emit $ KW KW_inf
alex_action_19 = emit $ KW KW_True
alex_action_20 = emit $ KW KW_else
alex_action_21 = emit $ KW KW_Eq
alex_action_22 = emit $ KW KW_error
alex_action_23 = emit $ KW KW_extern
alex_action_24 = emit $ KW KW_fin
alex_action_25 = emit $ KW KW_if
alex_action_26 = emit $ KW KW_private
alex_action_27 = emit $ KW KW_join
alex_action_28 = emit $ KW KW_include
alex_action_29 = emit $ KW KW_inf
alex_action_30 = emit $ KW KW_lg2
alex_action_31 = emit $ KW KW_lengthFromThen
alex_action_32 = emit $ KW KW_lengthFromThenTo
alex_action_33 = emit $ KW KW_max
alex_action_34 = emit $ KW KW_min
alex_action_35 = emit $ KW KW_module
alex_action_36 = emit $ KW KW_newtype
alex_action_37 = emit $ KW KW_pragma
alex_action_38 = emit $ KW KW_property
alex_action_39 = emit $ KW KW_pmult
alex_action_40 = emit $ KW KW_pdiv
alex_action_41 = emit $ KW KW_pmod
alex_action_42 = emit $ KW KW_random
alex_action_43 = emit $ KW KW_reverse
alex_action_44 = emit $ KW KW_split
alex_action_45 = emit $ KW KW_splitAt
alex_action_46 = emit $ KW KW_then
alex_action_47 = emit $ KW KW_transpose
alex_action_48 = emit $ KW KW_type
alex_action_49 = emit $ KW KW_where
alex_action_50 = emit $ KW KW_let
alex_action_51 = emit $ KW KW_x
alex_action_52 = emit $ KW KW_zero
alex_action_53 = emit $ KW KW_import
alex_action_54 = emit $ KW KW_as
alex_action_55 = emit $ KW KW_hiding
alex_action_56 = emit $ KW KW_newtype
alex_action_57 = emitS (numToken 2 . drop 2)
alex_action_58 = emitS (numToken 8 . drop 2)
alex_action_59 = emitS (numToken 10 . drop 0)
alex_action_60 = emitS (numToken 16 . drop 2)
alex_action_61 = emit $ Sym Underscore
alex_action_62 = mkIdent
alex_action_63 = emit $ Op Plus
alex_action_64 = emit $ Op Minus
alex_action_65 = emit $ Op Mul
alex_action_66 = emit $ Op Div
alex_action_67 = emit $ Op Mod
alex_action_68 = emit $ Op Exp
alex_action_69 = emit $ Op NotEqual
alex_action_70 = emit $ Op Equal
alex_action_71 = emit $ Op EqualFun
alex_action_72 = emit $ Op NotEqualFun
alex_action_73 = emit $ Op GreaterThan
alex_action_74 = emit $ Op LessThan
alex_action_75 = emit $ Op LEQ
alex_action_76 = emit $ Op GEQ
alex_action_77 = emit $ Op ShiftR
alex_action_78 = emit $ Op ShiftL
alex_action_79 = emit $ Op RotR
alex_action_80 = emit $ Op RotL
alex_action_81 = emit $ Op Complement
alex_action_82 = emit $ Op Xor
alex_action_83 = emit $ Op Disj
alex_action_84 = emit $ Op Conj
alex_action_85 = emit $ Op Bang
alex_action_86 = emit $ Op BangBang
alex_action_87 = emit $ Op At
alex_action_88 = emit $ Op AtAt
alex_action_89 = emit $ Op Hash
alex_action_90 = emit $ Sym Lambda
alex_action_91 = emit $ Sym ArrR
alex_action_92 = emit $ Sym ArrL
alex_action_93 = emit $ Sym FatArrR
alex_action_94 = emit $ Sym EqDef
alex_action_95 = emit $ Sym Comma
alex_action_96 = emit $ Sym Semi
alex_action_97 = emit $ Sym Dot
alex_action_98 = emit $ Sym Colon
alex_action_99 = emit $ Sym ColonColon
alex_action_100 = emit $ Sym BackTick
alex_action_101 = emit $ Sym DotDot
alex_action_102 = emit $ Sym DotDotDot
alex_action_103 = emit $ Sym Bar
alex_action_104 = emit $ Sym ParenL
alex_action_105 = emit $ Sym ParenR
alex_action_106 = emit $ Sym BracketL
alex_action_107 = emit $ Sym BracketR
alex_action_108 = emit $ Sym CurlyL
alex_action_109 = emit $ Sym CurlyR
alex_action_110 = emit $ Sym TriL
alex_action_111 = emit $ Sym TriR
alex_action_112 = startString
alex_action_113 = startChar
{-# LINE 1 "templates/GenericTemplate.hs" #-}
{-# LINE 1 "templates/GenericTemplate.hs" #-}
{-# LINE 1 "" #-}
{-# 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 21 "templates/GenericTemplate.hs" #-}
-- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex.
#if __GLASGOW_HASKELL__ > 706
#define GTE(n,m) (tagToEnum# (n >=# m))
#define EQ(n,m) (tagToEnum# (n ==# m))
#else
#define GTE(n,m) (n >=# m)
#define EQ(n,m) (n ==# m)
#endif
{-# LINE 51 "templates/GenericTemplate.hs" #-}
data AlexAddr = AlexA# Addr#
-- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex.
#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 GTE(offset,0#) && EQ(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 198 "templates/GenericTemplate.hs" #-}
data AlexLastAcc a
= AlexNone
| AlexLastAcc a !AlexInput !Int
| AlexLastSkip !AlexInput !Int
instance Functor AlexLastAcc where
fmap _ AlexNone = AlexNone
fmap f (AlexLastAcc x y z) = AlexLastAcc (f x) y z
fmap _ (AlexLastSkip x y) = AlexLastSkip x y
data AlexAcc a user
= AlexAccNone
| AlexAcc a
| AlexAccSkip
cryptol-2.2.6/lib/ 0000755 0000000 0000000 00000000000 12637103426 012155 5 ustar 00 0000000 0000000 cryptol-2.2.6/lib/Cryptol.cry 0000644 0000000 0000000 00000001511 12637103426 014326 0 ustar 00 0000000 0000000 /*
* Copyright (c) 2013-2015 Galois, Inc.
* Distributed under the terms of the BSD3 license (see LICENSE file)
*/
module Cryptol where
type Bool = Bit
type String n = [n][8]
type Word n = [n]
type Char = [8]
take : {front,back,elem} (fin front) => [front + back] elem -> [front] elem
take (x # _) = x
drop : {front,back,elem} (fin front) => [front + back] elem -> [back] elem
drop ((_ : [front] _) # y) = y
tail : {a, b} [1 + a]b -> [a]b
tail xs = drop`{1} xs
width : {bits,len,elem} (fin len, fin bits, bits >= width len) => [len] elem -> [bits]
width _ = `len
undefined : {a} a
undefined = error "undefined"
splitBy : {parts,each,elem} (fin each) =>
[parts * each] elem -> [parts][each]elem
splitBy = split
groupBy : {each,parts,elem} (fin each) =>
[parts * each] elem -> [parts][each]elem
groupBy = split`{parts=parts}
cryptol-2.2.6/src/ 0000755 0000000 0000000 00000000000 12637103426 012176 5 ustar 00 0000000 0000000 cryptol-2.2.6/src/GitRev.hs 0000644 0000000 0000000 00000001040 12637103426 013725 0 ustar 00 0000000 0000000 -- |
-- Module : $Header$
-- Copyright : (c) 2014-2015 Galois, Inc.
-- License : BSD3
-- Maintainer : cryptol@galois.com
-- Stability : provisional
-- Portability : portable
--
-- Include information about the current git status for use in error
-- messages and version info output
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE Trustworthy #-}
module GitRev (hash, branch, dirty) where
import Development.GitRev
hash :: String
hash = $(gitHash)
branch :: String
branch = $(gitBranch)
dirty :: Bool
dirty = $(gitDirty)
cryptol-2.2.6/src/Cryptol/ 0000755 0000000 0000000 00000000000 12637103426 013632 5 ustar 00 0000000 0000000 cryptol-2.2.6/src/Cryptol/Eval.hs 0000644 0000000 0000000 00000014347 12637103426 015066 0 ustar 00 0000000 0000000 -- |
-- Module : $Header$
-- Copyright : (c) 2013-2015 Galois, Inc.
-- License : BSD3
-- Maintainer : cryptol@galois.com
-- Stability : provisional
-- Portability : portable
{-# LANGUAGE Safe #-}
{-# LANGUAGE PatternGuards #-}
module Cryptol.Eval (
moduleEnv
, EvalEnv()
, emptyEnv
, evalExpr
, evalDecls
, EvalError(..)
, WithBase(..)
) where
import Cryptol.Eval.Error
import Cryptol.Eval.Env
import Cryptol.Eval.Type
import Cryptol.Eval.Value
import Cryptol.TypeCheck.AST
import Cryptol.Utils.Panic (panic)
import Cryptol.Utils.PP
import Cryptol.Prims.Eval
import Data.List (transpose)
import qualified Data.Map as Map
#if __GLASGOW_HASKELL__ < 710
import Data.Monoid (Monoid(..),mconcat)
#endif
-- Expression Evaluation -------------------------------------------------------
moduleEnv :: Module -> EvalEnv -> EvalEnv
moduleEnv m env = evalDecls (mDecls m) (evalNewtypes (mNewtypes m) env)
evalExpr :: EvalEnv -> Expr -> Value
evalExpr env expr = case expr of
ECon con -> evalECon con
EList es ty -> VSeq (isTBit (evalType env ty)) (map (evalExpr env) es)
ETuple es -> VTuple (map eval es)
ERec fields -> VRecord [ (f,eval e) | (f,e) <- fields ]
ESel e sel -> evalSel env e sel
EIf c t f | fromVBit (eval c) -> eval t
| otherwise -> eval f
EComp l h gs -> evalComp env (evalType env l) h gs
EVar n -> case lookupVar n env of
Just val -> val
Nothing -> panic "[Eval] evalExpr"
["var `" ++ show (pp n) ++ "` is not defined"
, pretty (WithBase defaultPPOpts env)
]
ETAbs tv b -> VPoly $ \ty -> evalExpr (bindType (tpVar tv) ty env) b
ETApp e ty -> case eval e of
VPoly f -> f (evalType env ty)
val -> panic "[Eval] evalExpr"
["expected a polymorphic value"
, show (ppV val), show e, show ty
]
EApp f x -> case eval f of
VFun f' -> f' (eval x)
it -> panic "[Eval] evalExpr" ["not a function", show (ppV it) ]
EAbs n _ty b -> VFun (\ val -> evalExpr (bindVar n val env) b )
-- XXX these will likely change once there is an evidence value
EProofAbs _ e -> evalExpr env e
EProofApp e -> evalExpr env e
ECast e _ty -> evalExpr env e
EWhere e ds -> evalExpr (evalDecls ds env) e
where
eval = evalExpr env
ppV = ppValue defaultPPOpts
-- Newtypes --------------------------------------------------------------------
evalNewtypes :: Map.Map QName Newtype -> EvalEnv -> EvalEnv
evalNewtypes nts env = Map.foldl (flip evalNewtype) env nts
-- | Introduce the constructor function for a newtype.
evalNewtype :: Newtype -> EvalEnv -> EvalEnv
evalNewtype nt = bindVar (ntName nt) (foldr tabs con (ntParams nt))
where
tabs _tp body = tlam (\ _ -> body)
con = VFun id
-- Declarations ----------------------------------------------------------------
evalDecls :: [DeclGroup] -> EvalEnv -> EvalEnv
evalDecls dgs env = foldl (flip evalDeclGroup) env dgs
evalDeclGroup :: DeclGroup -> EvalEnv -> EvalEnv
evalDeclGroup dg env = env'
where
-- the final environment is passed in for each declaration, to permit
-- recursive values.
env' = case dg of
Recursive ds -> foldr (evalDecl env') env ds
NonRecursive d -> evalDecl env d env
evalDecl :: ReadEnv -> Decl -> EvalEnv -> EvalEnv
evalDecl renv d = bindVar (dName d) (evalExpr renv (dDefinition d))
-- Selectors -------------------------------------------------------------------
evalSel :: ReadEnv -> Expr -> Selector -> Value
evalSel env e sel = case sel of
TupleSel n _ -> tupleSel n val
RecordSel n _ -> recordSel n val
ListSel ix _ -> fromSeq val !! ix
where
val = evalExpr env e
tupleSel n v =
case v of
VTuple vs -> vs !! n
VSeq False vs -> VSeq False [ tupleSel n v1 | v1 <- vs ]
VStream vs -> VStream [ tupleSel n v1 | v1 <- vs ]
VFun f -> VFun (\x -> tupleSel n (f x))
_ -> evalPanic "Cryptol.Eval.evalSel"
[ "Unexpected value in tuple selection"
, show (ppValue defaultPPOpts v) ]
recordSel n v =
case v of
VRecord {} -> lookupRecord n v
VSeq False vs -> VSeq False [ recordSel n v1 | v1 <- vs ]
VStream vs -> VStream [recordSel n v1 | v1 <- vs ]
VFun f -> VFun (\x -> recordSel n (f x))
_ -> evalPanic "Cryptol.Eval.evalSel"
[ "Unexpected value in record selection"
, show (ppValue defaultPPOpts v) ]
-- List Comprehensions ---------------------------------------------------------
-- | Evaluate a comprehension.
evalComp :: ReadEnv -> TValue -> Expr -> [[Match]] -> Value
evalComp env seqty body ms
| Just (len,el) <- isTSeq seqty = toSeq len el [ evalExpr e body | e <- envs ]
| otherwise = evalPanic "Cryptol.Eval" [ "evalComp given a non sequence"
, show seqty
]
-- XXX we could potentially print this as a number if the type was available.
where
-- generate a new environment for each iteration of each parallel branch
benvs = map (branchEnvs env) ms
-- take parallel slices of each environment. when the length of the list
-- drops below the number of branches, one branch has terminated.
allBranches es = length es == length ms
slices = takeWhile allBranches (transpose benvs)
-- join environments to produce environments at each step through the process.
envs = map mconcat slices
-- | Turn a list of matches into the final environments for each iteration of
-- the branch.
branchEnvs :: ReadEnv -> [Match] -> [EvalEnv]
branchEnvs env matches = case matches of
m:ms -> do
env' <- evalMatch env m
branchEnvs env' ms
[] -> return env
-- | Turn a match into the list of environments it represents.
evalMatch :: EvalEnv -> Match -> [EvalEnv]
evalMatch env m = case m of
-- many envs
From n _ty expr -> do
e <- fromSeq (evalExpr env expr)
return (bindVar n e env)
-- XXX we don't currently evaluate these as though they could be recursive, as
-- they are typechecked that way; the read environment to evalDecl is the same
-- as the environment to bind a new name in.
Let d -> [evalDecl env d env]
cryptol-2.2.6/src/Cryptol/ModuleSystem.hs 0000644 0000000 0000000 00000006175 12637103426 016631 0 ustar 00 0000000 0000000 -- |
-- Module : $Header$
-- Copyright : (c) 2013-2015 Galois, Inc.
-- License : BSD3
-- Maintainer : cryptol@galois.com
-- Stability : provisional
-- Portability : portable
module Cryptol.ModuleSystem (
-- * Module System
ModuleEnv(..), initialModuleEnv
, DynamicEnv(..)
, ModuleError(..), ModuleWarning(..)
, ModuleCmd, ModuleRes
, findModule
, loadModuleByPath
, loadModule
, checkExpr
, evalExpr
, checkDecls
, evalDecls
, noPat
, focusedEnv
-- * Interfaces
, Iface(..), IfaceDecls(..), genIface
, IfaceTySyn, IfaceDecl(..)
) where
import qualified Cryptol.Eval.Value as E
import Cryptol.ModuleSystem.Env
import Cryptol.ModuleSystem.Interface
import Cryptol.ModuleSystem.Monad
import Cryptol.ModuleSystem.Renamer (Rename)
import qualified Cryptol.ModuleSystem.Base as Base
import qualified Cryptol.Parser.AST as P
import Cryptol.Parser.NoPat (RemovePatterns)
import Cryptol.Parser.Position (HasLoc)
import qualified Cryptol.TypeCheck.AST as T
import qualified Cryptol.TypeCheck.Depends as T
-- Public Interface ------------------------------------------------------------
type ModuleCmd a = ModuleEnv -> IO (ModuleRes a)
type ModuleRes a = (Either ModuleError (a,ModuleEnv), [ModuleWarning])
-- | Find the file associated with a module name in the module search path.
findModule :: P.ModName -> ModuleCmd FilePath
findModule n env = runModuleM env (Base.findModule n)
-- | Load the module contained in the given file.
loadModuleByPath :: FilePath -> ModuleCmd T.Module
loadModuleByPath path env = runModuleM (resetModuleEnv env) $ do
-- unload the module if it already exists
unloadModule path
m <- Base.loadModuleByPath path
setFocusedModule (T.mName m)
return m
-- | Load the given parsed module.
loadModule :: FilePath -> P.Module -> ModuleCmd T.Module
loadModule path m env = runModuleM env $ do
-- unload the module if it already exists
unloadModule path
let n = P.thing (P.mName m)
m' <- loadingModule n (Base.loadModule path m)
setFocusedModule (T.mName m')
return m'
-- Extended Environments -------------------------------------------------------
-- These functions are particularly useful for interactive modes, as
-- they allow for expressions to be evaluated in an environment that
-- can extend dynamically outside of the context of a module.
-- | Check the type of an expression.
checkExpr :: P.Expr -> ModuleCmd (T.Expr,T.Schema)
checkExpr e env = runModuleM env (interactive (Base.checkExpr e))
-- | Evaluate an expression.
evalExpr :: T.Expr -> ModuleCmd E.Value
evalExpr e env = runModuleM env (interactive (Base.evalExpr e))
-- | Typecheck declarations.
checkDecls :: (HasLoc d, Rename d, T.FromDecl d) => [d] -> ModuleCmd [T.DeclGroup]
checkDecls ds env = runModuleM env (interactive (Base.checkDecls ds))
-- | Evaluate declarations and add them to the extended environment.
evalDecls :: [T.DeclGroup] -> ModuleCmd ()
evalDecls dgs env = runModuleM env (interactive (Base.evalDecls dgs))
noPat :: RemovePatterns a => a -> ModuleCmd a
noPat a env = runModuleM env (interactive (Base.noPat a))
cryptol-2.2.6/src/Cryptol/Parser.y 0000644 0000000 0000000 00000104503 12637103426 015263 0 ustar 00 0000000 0000000 {
{-# LANGUAGE Trustworthy #-}
module Cryptol.Parser
( parseModule
, parseProgram, parseProgramWith
, parseExpr, parseExprWith
, parseDecl, parseDeclWith
, parseDecls, parseDeclsWith
, parseLetDecl, parseLetDeclWith
, parseRepl, parseReplWith
, parseSchema, parseSchemaWith
, parseModName
, ParseError(..), ppError
, Layout(..)
, Config(..), defaultConfig
, guessPreProc, PreProc(..)
) where
import Data.Maybe(fromMaybe)
import Control.Monad(liftM2,msum)
import Cryptol.Prims.Syntax
import Cryptol.Parser.AST
import Cryptol.Parser.Position
import Cryptol.Parser.LexerUtils
import Cryptol.Parser.ParserUtils
import Cryptol.Parser.Unlit(PreProc(..), guessPreProc)
import Paths_cryptol
}
%token
NUM { $$@(Located _ (Token (Num {}) _))}
IDENT { $$@(Located _ (Token (Ident {}) _))}
STRLIT { $$@(Located _ (Token (StrLit {}) _))}
CHARLIT { $$@(Located _ (Token (ChrLit {}) _))}
'include' { Located $$ (Token (KW KW_include) _)}
'import' { Located $$ (Token (KW KW_import) _)}
'as' { Located $$ (Token (KW KW_as) _)}
'hiding' { Located $$ (Token (KW KW_hiding) _)}
'private' { Located $$ (Token (KW KW_private) _)}
'property' { Located $$ (Token (KW KW_property) _)}
'False' { Located $$ (Token (KW KW_False ) _)}
'True' { Located $$ (Token (KW KW_True ) _)}
'Arith' { Located $$ (Token (KW KW_Arith ) _)}
'Bit' { Located $$ (Token (KW KW_Bit ) _)}
'Cmp' { Located $$ (Token (KW KW_Cmp ) _)}
'error' { Located $$ (Token (KW KW_error ) _)}
'fin' { Located $$ (Token (KW KW_fin ) _)}
'inf' { Located $$ (Token (KW KW_inf ) _)}
'lg2' { Located $$ (Token (KW KW_lg2 ) _)}
'lengthFromThen' { Located $$ (Token (KW KW_lengthFromThen) _)}
'lengthFromThenTo' { Located $$ (Token (KW KW_lengthFromThenTo) _)}
'type' { Located $$ (Token (KW KW_type ) _)}
'newtype' { Located $$ (Token (KW KW_newtype) _)}
'module' { Located $$ (Token (KW KW_module ) _)}
'where' { Located $$ (Token (KW KW_where ) _)}
'let' { Located $$ (Token (KW KW_let ) _)}
'if' { Located $$ (Token (KW KW_if ) _)}
'then' { Located $$ (Token (KW KW_then ) _)}
'else' { Located $$ (Token (KW KW_else ) _)}
'min' { Located $$ (Token (KW KW_min ) _)}
'max' { Located $$ (Token (KW KW_max ) _)}
'zero' { Located $$ (Token (KW KW_zero ) _)}
'join' { Located $$ (Token (KW KW_join ) _)}
'reverse' { Located $$ (Token (KW KW_reverse) _)}
'split' { Located $$ (Token (KW KW_split ) _)}
'splitAt' { Located $$ (Token (KW KW_splitAt) _)}
'transpose' { Located $$ (Token (KW KW_transpose) _)}
'x' { Located $$ (Token (KW KW_x) _)}
'pmult' { Located $$ (Token (KW KW_pmult) _)}
'pmod' { Located $$ (Token (KW KW_pmod) _)}
'pdiv' { Located $$ (Token (KW KW_pdiv) _)}
'random' { Located $$ (Token (KW KW_random) _)}
'[' { Located $$ (Token (Sym BracketL) _)}
']' { Located $$ (Token (Sym BracketR) _)}
'<-' { Located $$ (Token (Sym ArrL ) _)}
'..' { Located $$ (Token (Sym DotDot ) _)}
'...' { Located $$ (Token (Sym DotDotDot) _)}
'|' { Located $$ (Token (Sym Bar ) _)}
'(' { Located $$ (Token (Sym ParenL ) _)}
')' { Located $$ (Token (Sym ParenR ) _)}
',' { Located $$ (Token (Sym Comma ) _)}
';' { Located $$ (Token (Sym Semi ) _)}
'.' { Located $$ (Token (Sym Dot ) _)}
'{' { Located $$ (Token (Sym CurlyL ) _)}
'}' { Located $$ (Token (Sym CurlyR ) _)}
'<|' { Located $$ (Token (Sym TriL ) _)}
'|>' { Located $$ (Token (Sym TriR ) _)}
'=' { Located $$ (Token (Sym EqDef ) _)}
'`' { Located $$ (Token (Sym BackTick) _)}
':' { Located $$ (Token (Sym Colon ) _)}
'::' { Located $$ (Token (Sym ColonColon) _)}
'->' { Located $$ (Token (Sym ArrR ) _)}
'=>' { Located $$ (Token (Sym FatArrR ) _)}
'\\' { Located $$ (Token (Sym Lambda ) _)}
'_' { Located $$ (Token (Sym Underscore ) _)}
'v{' { Located $$ (Token (Virt VCurlyL) _)}
'v}' { Located $$ (Token (Virt VCurlyR) _)}
'v;' { Located $$ (Token (Virt VSemi) _)}
'+' { Located $$ (Token (Op Plus ) _)}
'-' { Located $$ (Token (Op Minus ) _)}
'*' { Located $$ (Token (Op Mul ) _)}
'/' { Located $$ (Token (Op Div ) _)}
'^^' { Located $$ (Token (Op Exp ) _)}
'%' { Located $$ (Token (Op Mod ) _)}
'^' { Located $$ (Token (Op Xor ) _)}
'||' { Located $$ (Token (Op Disj ) _)}
'&&' { Located $$ (Token (Op Conj ) _)}
'!=' { Located $$ (Token (Op NotEqual ) _)}
'==' { Located $$ (Token (Op Equal ) _)}
'!==' { Located $$ (Token (Op NotEqualFun ) _)}
'===' { Located $$ (Token (Op EqualFun ) _)}
'>' { Located $$ (Token (Op GreaterThan ) _)}
'<' { Located $$ (Token (Op LessThan ) _)}
'<=' { Located $$ (Token (Op LEQ ) _)}
'>=' { Located $$ (Token (Op GEQ ) _)}
'>>' { Located $$ (Token (Op ShiftR ) _)}
'<<' { Located $$ (Token (Op ShiftL ) _)}
'>>>' { Located $$ (Token (Op RotR ) _)}
'<<<' { Located $$ (Token (Op RotL ) _)}
'~' { Located $$ (Token (Op Complement ) _)}
'@' { Located $$ (Token (Op At ) _)}
'@@' { Located $$ (Token (Op AtAt ) _)}
'!' { Located $$ (Token (Op Bang ) _)}
'!!' { Located $$ (Token (Op BangBang ) _)}
'#' { Located $$ (Token (Op Hash ) _)}
%name vmodule vmodule
%name program program
%name programLayout program_layout
%name expr expr
%name decl decl
%name decls decls
%name declsLayout decls_layout
%name letDecl let_decl
%name repl repl
%name schema schema
%name modName modName
%tokentype { Located Token }
%monad { ParseM }
%lexer { lexerP } { Located _ (Token EOF _) }
{- If you add additional operators, please update the corresponding
tables in the pretty printer. -}
%nonassoc '=>'
%right '->'
%left 'where'
%nonassoc 'then' 'else'
%nonassoc ':'
%left '||'
%left '&&'
%nonassoc '==' '!=' '===' '!=='
%nonassoc '<' '>' '<=' '>='
%left '^'
%right '#'
%left '<<' '>>' '<<<' '>>>'
%left '+' '-'
%left '*' '/' '%'
%right '^^'
%left '@' '@@' '!' '!!'
%right NEG '~'
%%
vmodule :: { Module }
: 'module' modName 'where' 'v{' vmod_body 'v}'
{ let (is,ts) = $5 in Module $2 is ts }
| 'v{' vmod_body 'v}'
{ let { (is,ts) = $2
-- XXX make a location from is and ts
; modName = Located { srcRange = emptyRange
, thing = ModName ["Main"]
}
} in Module modName is ts }
vmod_body :: { ([Located Import], [TopDecl]) }
: vimports 'v;' vtop_decls { (reverse $1, reverse $3) }
| vimports ';' vtop_decls { (reverse $1, reverse $3) }
| vimports { (reverse $1, []) }
| vtop_decls { ([], reverse $1) }
| {- empty -} { ([], []) }
vimports :: { [Located Import] }
: vimports 'v;' import { $3 : $1 }
| vimports ';' import { $3 : $1 }
| import { [$1] }
-- XXX replace rComb with uses of at
import :: { Located Import }
: 'import' modName mbAs mbImportSpec
{ Located { srcRange = rComb $1
$ fromMaybe (srcRange $2)
$ msum [ fmap srcRange $4
, fmap srcRange $3
]
, thing = Import
{ iModule = thing $2
, iAs = fmap thing $3
, iSpec = fmap thing $4
}
} }
mbAs :: { Maybe (Located ModName) }
: 'as' modName { Just $2 }
| {- empty -} { Nothing }
mbImportSpec :: { Maybe (Located ImportSpec) }
: mbHiding '(' name_list ')'{ Just Located
{ srcRange = case $3 of
{ [] -> emptyRange
; xs -> rCombs (map srcRange xs) }
, thing = $1 (reverse (map thing $3))
} }
| {- empty -} { Nothing }
name_list :: { [LName] }
: name_list ',' name { $3 : $1 }
| name { [$1] }
| {- empty -} { [] }
mbHiding :: { [Name] -> ImportSpec }
: 'hiding' { Hiding }
| {- empty -} { Only }
program :: { Program }
: top_decls { Program (reverse $1) }
| {- empty -} { Program [] }
program_layout :: { Program }
: 'v{' vtop_decls 'v}' { Program (reverse $2) }
| 'v{''v}' { Program [] }
top_decls :: { [TopDecl] }
: top_decl ';' { [$1] }
| top_decls top_decl ';' { $2 : $1 }
vtop_decls :: { [TopDecl] }
: vtop_decl { $1 }
| vtop_decls 'v;' vtop_decl { $3 ++ $1 }
| vtop_decls ';' vtop_decl { $3 ++ $1 }
vtop_decl :: { [TopDecl] }
: decl { [exportDecl Public $1] }
| 'private' 'v{' vtop_decls 'v}' { changeExport Private (reverse $3) }
| 'include' STRLIT {% (return . Include) `fmap` fromStrLit $2 }
| 'property' name apats '=' expr { [exportDecl Public (mkProperty $2 $3 $5)]}
| 'property' name '=' expr { [exportDecl Public (mkProperty $2 [] $4)]}
| newtype { [exportNewtype Public $1] }
top_decl :: { TopDecl }
: decl { Decl (TopLevel {tlExport = Public, tlValue = $1}) }
| 'include' STRLIT {% Include `fmap` fromStrLit $2 }
decl :: { Decl }
: vars_comma ':' schema { at (head $1,$3) $ DSignature (map (fmap mkUnqual) (reverse $1)) $3 }
| apat '=' expr { at ($1,$3) $ DPatBind $1 $3 }
| name apats '=' expr { at ($1,$4) $
DBind $ Bind { bName = fmap mkUnqual $1
, bParams = reverse $2
, bDef = $4
, bSignature = Nothing
, bPragmas = []
, bMono = False
} }
| 'type' name '=' type {% at ($1,$4) `fmap` mkTySyn $2 [] $4 }
| 'type' name tysyn_params '=' type
{% at ($1,$5) `fmap` mkTySyn $2 (reverse $3) $5 }
let_decl :: { Decl }
: 'let' apat '=' expr { at ($2,$4) $ DPatBind $2 $4 }
| 'let' name apats '=' expr { at ($2,$5) $
DBind $ Bind { bName = fmap mkUnqual $2
, bParams = reverse $3
, bDef = $5
, bSignature = Nothing
, bPragmas = []
, bMono = False
} }
newtype :: { Newtype }
: 'newtype' qname '=' newtype_body
{ Newtype { nName = $2, nParams = [], nBody = $4 } }
| 'newtype' qname tysyn_params '=' newtype_body
{ Newtype { nName = $2, nParams = $3, nBody = $5 } }
newtype_body :: { [Named Type] }
: '{' '}' { [] }
| '{' field_types '}' { $2 }
vars_comma :: { [ LName ] }
: name { [ $1] }
| vars_comma ',' name { $3 : $1 }
apats :: { [Pattern] }
: apat { [$1] }
| apats apat { $2 : $1 }
decls :: { [Decl] }
: decl ';' { [$1] }
| decls decl ';' { $2 : $1 }
vdecls :: { [Decl] }
: decl { [$1] }
| vdecls 'v;' decl { $3 : $1 }
| vdecls ';' decl { $3 : $1 }
decls_layout :: { [Decl] }
: 'v{' vdecls 'v}' { $2 }
| 'v{' 'v}' { [] }
repl :: { ReplInput }
: expr { ExprInput $1 }
| let_decl { LetInput $1 }
--------------------------------------------------------------------------------
-- if a then b else c : [10]
expr :: { Expr }
: iexpr { $1 }
| expr 'where' '{' '}' { at ($1,$4) $ EWhere $1 [] }
| expr 'where' '{' decls '}' { at ($1,$5) $ EWhere $1 (reverse $4) }
| expr 'where' 'v{' 'v}' { at ($1,$2) $ EWhere $1 [] }
| expr 'where' 'v{' vdecls 'v}' { at ($1,$4) $ EWhere $1 (reverse $4) }
ifBranches :: { [(Expr, Expr)] }
: ifBranch { [$1] }
| ifBranches '|' ifBranch { $3 : $1 }
ifBranch :: { (Expr, Expr) }
: expr 'then' expr { ($1, $3) }
iexpr :: { Expr }
: aexprs { mkEApp $1 }
| iexpr ':' type { at ($1,$3) $ ETyped $1 $3 }
| 'if' ifBranches 'else' iexpr { at ($1,$4) $ mkIf $2 $4 }
| '\\' apats '->' iexpr { at ($1,$4) $ EFun (reverse $2) $4 }
| iexpr '@' iexpr { binOp $1 (op ECAt $2) $3 }
| iexpr '@@' iexpr { binOp $1 (op ECAtRange $2) $3 }
| iexpr '!' iexpr { binOp $1 (op ECAtBack $2) $3 }
| iexpr '!!' iexpr { binOp $1 (op ECAtRangeBack $2) $3 }
| iexpr '#' iexpr { binOp $1 (op ECCat $2) $3 }
| iexpr '+' iexpr { binOp $1 (op ECPlus $2) $3 }
| iexpr '-' iexpr { binOp $1 (op ECMinus $2) $3 }
| iexpr '*' iexpr { binOp $1 (op ECMul $2) $3 }
| iexpr '/' iexpr { binOp $1 (op ECDiv $2) $3 }
| iexpr '%' iexpr { binOp $1 (op ECMod $2) $3 }
| iexpr '^^' iexpr { binOp $1 (op ECExp $2) $3 }
| iexpr '^' iexpr { binOp $1 (op ECXor $2) $3 }
| iexpr '||' iexpr { binOp $1 (op ECOr $2) $3 }
| iexpr '&&' iexpr { binOp $1 (op ECAnd $2) $3 }
| iexpr '==' iexpr { binOp $1 (op ECEq $2) $3 }
| iexpr '!=' iexpr { binOp $1 (op ECNotEq $2) $3 }
| iexpr '===' iexpr { binOp $1 (op ECFunEq $2) $3 }
| iexpr '!==' iexpr { binOp $1 (op ECFunNotEq $2) $3 }
| iexpr '>' iexpr { binOp $1 (op ECGt $2) $3 }
| iexpr '<' iexpr { binOp $1 (op ECLt $2) $3 }
| iexpr '<=' iexpr { binOp $1 (op ECLtEq $2) $3 }
| iexpr '>=' iexpr { binOp $1 (op ECGtEq $2) $3 }
| iexpr '<<' iexpr { binOp $1 (op ECShiftL $2) $3 }
| iexpr '>>' iexpr { binOp $1 (op ECShiftR $2) $3 }
| iexpr '<<<' iexpr { binOp $1 (op ECRotL $2) $3 }
| iexpr '>>>' iexpr { binOp $1 (op ECRotR $2) $3 }
| '-' iexpr %prec NEG { unOp (op ECNeg $1) $2 }
| '~' iexpr { unOp (op ECCompl $1) $2 }
aexprs :: { [Expr] }
: aexpr { [$1] }
| aexprs aexpr { $2 : $1 }
aexpr :: { Expr }
: qname { at $1 $ EVar (thing $1) }
| 'min' { at $1 $ ECon ECMin }
| 'max' { at $1 $ ECon ECMax }
| 'lg2' { at $1 $ ECon ECLg2 }
| 'zero' { at $1 $ ECon ECZero }
| 'join' { at $1 $ ECon ECJoin }
| 'split' { at $1 $ ECon ECSplit }
| 'splitAt' { at $1 $ ECon ECSplitAt }
| NUM { at $1 $ numLit (tokenType (thing $1)) }
| STRLIT { at $1 $ ELit $ ECString $ getStr $1 }
| CHARLIT { at $1 $ ELit $ ECNum (getNum $1) CharLit }
| 'False' { at $1 $ ECon ECFalse }
| 'True' { at $1 $ ECon ECTrue }
| 'error' { at $1 $ ECon ECError }
| 'reverse' { at $1 $ ECon ECReverse }
| 'transpose' { at $1 $ ECon ECTranspose }
| 'pmult' { at $1 $ ECon ECPMul }
| 'pdiv' { at $1 $ ECon ECPDiv }
| 'pmod' { at $1 $ ECon ECPMod }
| 'random' { at $1 $ ECon ECRandom }
| '(' expr ')' { at ($1,$3) $2 }
| '(' tuple_exprs ')' { at ($1,$3) $ ETuple (reverse $2) }
| '(' ')' { at ($1,$2) $ ETuple [] }
| '{' '}' { at ($1,$2) $ ERecord [] }
| '{' field_exprs '}' { at ($1,$3) $ ERecord (reverse $2) }
| '[' ']' { at ($1,$2) $ EList [] }
| '[' list_expr ']' { at ($1,$3) $2 }
| '`' tick_ty { at ($1,$2) $ ETypeVal $2 }
| aexpr '.' selector { at ($1,$3) $ ESel $1 (thing $3) }
| '(' '@' ')' { at ($1,$3) $ ECon ECAt }
| '(' '@@' ')' { at ($1,$3) $ ECon ECAtRange }
| '(' '!' ')' { at ($1,$3) $ ECon ECAtBack }
| '(' '!!' ')' { at ($1,$3) $ ECon ECAtRangeBack }
| '(' '#' ')' { at ($1,$3) $ ECon ECCat }
| '(' '+' ')' { at ($1,$3) $ ECon ECPlus }
| '(' '-' ')' { at ($1,$3) $ ECon ECMinus }
| '(' '*' ')' { at ($1,$3) $ ECon ECMul }
| '(' '/' ')' { at ($1,$3) $ ECon ECDiv }
| '(' '%' ')' { at ($1,$3) $ ECon ECMod }
| '(' '^^' ')' { at ($1,$3) $ ECon ECExp }
| '(' '^' ')' { at ($1,$3) $ ECon ECXor }
| '(' '||' ')' { at ($1,$3) $ ECon ECOr }
| '(' '&&' ')' { at ($1,$3) $ ECon ECAnd }
| '(' '==' ')' { at ($1,$3) $ ECon ECEq }
| '(' '!=' ')' { at ($1,$3) $ ECon ECNotEq }
| '(' '===' ')' { at ($1,$3) $ ECon ECFunEq }
| '(' '!==' ')' { at ($1,$3) $ ECon ECFunNotEq }
| '(' '>' ')' { at ($1,$3) $ ECon ECGt }
| '(' '<' ')' { at ($1,$3) $ ECon ECLt }
| '(' '<=' ')' { at ($1,$3) $ ECon ECLtEq }
| '(' '>=' ')' { at ($1,$3) $ ECon ECGtEq }
| '(' '<<' ')' { at ($1,$3) $ ECon ECShiftL }
| '(' '>>' ')' { at ($1,$3) $ ECon ECShiftR }
| '(' '<<<' ')' { at ($1,$3) $ ECon ECRotL }
| '(' '>>>' ')' { at ($1,$3) $ ECon ECRotR }
| '<|' '|>' {% mkPoly (rComb $1 $2) [] }
| '<|' poly_terms '|>' {% mkPoly (rComb $1 $3) $2 }
-- | error {%^ customError "expr" }
poly_terms :: { [(Bool, Integer)] }
: poly_term { [$1] }
| poly_terms '+' poly_term { $3 : $1 }
poly_term :: { (Bool, Integer) }
: NUM {% polyTerm (srcRange $1) (getNum $1) 0 }
| 'x' {% polyTerm $1 1 1 }
| 'x' '^^' NUM {% polyTerm (rComb $1 (srcRange $3))
1 (getNum $3) }
selector :: { Located Selector }
: name { fmap (`RecordSel` Nothing) $1 }
| NUM {% mkTupleSel (srcRange $1) (getNum $1) }
tuple_exprs :: { [Expr] }
: expr ',' expr { [ $3, $1] }
| tuple_exprs ',' expr { $3 : $1 }
field_expr :: { Named Expr }
: name '=' expr { Named { name = $1, value = $3 } }
| name apats '=' expr { Named { name = $1, value = EFun (reverse $2) $4 } }
field_exprs :: { [Named Expr] }
: field_expr { [$1] }
| field_exprs ',' field_expr { $3 : $1 }
list_expr :: { Expr }
: expr '|' list_alts { EComp $1 (reverse $3) }
| expr { EList [$1] }
| tuple_exprs { EList (reverse $1) }
{- The `expr` in the four productions that follow should be `type`.
This, however, leads to ambiguity because the syntax for types and
expressions overlaps and we need more than 1 look-ahead to resolve what
is being parsed. For this reason, we use `expr` temporarily and
then convert it to the corresponding type in the AST. -}
| expr '..' {% eFromTo $2 $1 Nothing Nothing }
| expr '..' expr {% eFromTo $2 $1 Nothing (Just $3) }
| expr ',' expr '..' {% eFromTo $4 $1 (Just $3) Nothing }
| expr ',' expr '..' expr {% eFromTo $4 $1 (Just $3) (Just $5) }
| expr '...' { EInfFrom $1 Nothing }
| expr ',' expr '...' { EInfFrom $1 (Just $3) }
list_alts :: { [[Match]] }
: matches { [ reverse $1 ] }
| list_alts '|' matches { reverse $3 : $1 }
matches :: { [Match] }
: match { [$1] }
| matches ',' match { $3 : $1 }
match :: { Match }
: pat '<-' expr { Match $1 $3 }
--------------------------------------------------------------------------------
pat :: { Pattern }
: ipat ':' type { at ($1,$3) $ PTyped $1 $3 }
| ipat { $1 }
ipat
: ipat '#' ipat { at ($1,$3) $ PSplit $1 $3 }
| apat { $1 }
apat :: { Pattern }
: name { PVar $1 }
| '_' { at $1 $ PWild }
| '(' ')' { at ($1,$2) $ PTuple [] }
| '(' pat ')' { at ($1,$3) $2 }
| '(' tuple_pats ')' { at ($1,$3) $ PTuple (reverse $2) }
| '[' ']' { at ($1,$2) $ PList [] }
| '[' pat ']' { at ($1,$3) $ PList [$2] }
| '[' tuple_pats ']' { at ($1,$3) $ PList (reverse $2) }
| '{' '}' { at ($1,$2) $ PRecord [] }
| '{' field_pats '}' { at ($1,$3) $ PRecord (reverse $2) }
tuple_pats :: { [Pattern] }
: pat ',' pat { [$3, $1] }
| tuple_pats ',' pat { $3 : $1 }
field_pat :: { Named Pattern }
: name '=' pat { Named { name = $1, value = $3 } }
field_pats :: { [Named Pattern] }
: field_pat { [$1] }
| field_pats ',' field_pat { $3 : $1 }
--------------------------------------------------------------------------------
schema :: { Schema }
: type { at $1 $ mkSchema [] [] $1 }
| schema_vars type { at ($1,$2) $ mkSchema (thing $1) [] $2 }
| schema_quals type { at ($1,$2) $ mkSchema [] (thing $1) $2 }
| schema_vars schema_quals type { at ($1,$3) $ mkSchema (thing $1)
(thing $2) $3 }
schema_vars :: { Located [TParam] }
: '{' '}' { Located (rComb $1 $2) [] }
| '{' schema_params '}' { Located (rComb $1 $3) (reverse $2) }
schema_quals :: { Located [Prop] }
: '(' ')' '=>' { Located (rComb $1 $3) [] }
| prop '=>' { Located
(rComb (fromMaybe $2 (getLoc $1)) $2) [$1] }
| '(' props ')' '=>' { Located (rComb $1 $4) (reverse $2) }
kind :: { Located Kind }
: '#' { Located $1 KNum }
| '*' { Located $1 KType }
schema_param :: { TParam }
: name {% mkTParam $1 Nothing }
| name ':' kind {% mkTParam (at ($1,$3) $1) (Just (thing $3)) }
schema_params :: { [TParam] }
: schema_param { [$1] }
| schema_params ',' schema_param { $3 : $1 }
tysyn_param :: { TParam }
: name {% mkTParam $1 Nothing }
| '(' name ':' kind ')' {% mkTParam (at ($1,$5) $2) (Just (thing $4)) }
tysyn_params :: { [TParam] }
: tysyn_param { [$1] }
| tysyn_params tysyn_param { $2 : $1 }
prop :: { Prop }
: type '==' type { at ($1,$3) $ CEqual $1 $3 }
| type '<=' type { at ($1,$3) $ CGeq $3 $1 }
| type '>=' type { at ($1,$3) $ CGeq $1 $3 }
| 'fin' atype { at ($1,$2) $ CFin $2 }
| 'Arith' atype { at ($1,$2) $ CArith $2 }
| 'Cmp' atype { at ($1,$2) $ CCmp $2 }
props :: { [Prop] }
: prop { [$1] }
| props ',' prop { $3 : $1 }
type :: { Type }
: type '->' type { at ($1,$3) $ TFun $1 $3 }
| type '+' type { at ($1,$3) $ TApp TCAdd [$1, $3] }
| type '-' type { at ($1,$3) $ TApp TCSub [$1, $3] }
| type '*' type { at ($1,$3) $ TApp TCMul [$1, $3] }
| type '/' type { at ($1,$3) $ TApp TCDiv [$1, $3] }
| type '%' type { at ($1,$3) $ TApp TCMod [$1, $3] }
| type '^^' type { at ($1,$3) $ TApp TCExp [$1, $3] }
| app_type { $1 }
app_type :: { Type }
: 'lg2' atype { at ($1,$2) $ TApp TCLg2 [$2] }
| 'lengthFromThen' atype atype { at ($1,$3) $ TApp TCLenFromThen [$2,$3] }
| 'lengthFromThenTo' atype atype
atype { at ($1,$4) $ TApp TCLenFromThen [$2,$3,$4] }
| 'min' atype atype { at ($1,$3) $ TApp TCMin [$2,$3] }
| 'max' atype atype { at ($1,$3) $ TApp TCMax [$2,$3] }
| dimensions atype { at ($1,$2) $ foldr TSeq $2 (reverse (thing $1)) }
| qname atypes { at ($1,head $2)
$ TUser (thing $1) (reverse $2) }
| atype { $1 }
atype :: { Type }
: qname { at $1 $ TUser (thing $1) [] }
| 'Bit' { at $1 $ TBit }
| 'inf' { at $1 $ TInf }
| NUM { at $1 $ TNum (getNum $1) }
| CHARLIT { at $1 $ TChar (toEnum $ fromInteger
$ getNum $1) }
| '[' type ']' { at ($1,$3) $ TSeq $2 TBit }
| '(' type ')' { at ($1,$3) $2 }
| '(' ')' { at ($1,$2) $ TTuple [] }
| '(' tuple_types ')' { at ($1,$3) $ TTuple (reverse $2) }
| '{' '}' { at ($1,$2) $ TRecord [] }
| '{' field_types '}' { at ($1,$3) $ TRecord (reverse $2) }
| '_' { at $1 TWild }
atypes :: { [ Type ] }
: atype { [ $1 ] }
| atypes atype { $2 : $1 }
dimensions :: { Located [Type] }
: '[' type ']' { Located (rComb $1 $3) [ $2 ] }
| dimensions '[' type ']' { at ($1,$4) (fmap ($3 :) $1) }
tuple_types :: { [Type] }
: type ',' type { [ $3, $1] }
| tuple_types ',' type { $3 : $1 }
field_type :: { Named Type }
: name ':' type { Named { name = $1, value = $3 } }
field_types :: { [Named Type] }
: field_type { [$1] }
| field_types ',' field_type { $3 : $1 }
qname_parts :: { [LName] } -- Reversed!
: name { [$1] }
| qname_parts '::' name { $3 : $1 }
name :: { LName }
: IDENT { $1 { thing = getName $1 } }
| 'x' { Located { srcRange = $1, thing = Name "x" }}
| 'private' { Located { srcRange = $1, thing = Name "private" } }
| 'as' { Located { srcRange = $1, thing = Name "as" } }
| 'hiding' { Located { srcRange = $1, thing = Name "hiding" } }
modName :: { Located ModName }
: qname_parts { mkModName $1 }
qname :: { Located QName }
: qname_parts { mkQName $1 }
{- The types that can come after a back-tick: either a type demotion,
or an explicit type application. Explicit type applications are converted
to records, which cannot be demoted. -}
tick_ty :: { Type }
: qname { at $1 $ TUser (thing $1) [] }
| NUM { at $1 $ TNum (getNum $1) }
| '(' type ')' {% validDemotedType (rComb $1 $3) $2 }
| '{' '}' { at ($1,$2) (TRecord []) }
| '{' field_ty_vals '}' { at ($1,$3) (TRecord (reverse $2)) }
| '{' type '}' { anonRecord (getLoc ($1,$3)) [$2] }
| '{' tuple_types '}' { anonRecord (getLoc ($1,$3)) (reverse $2) }
-- This for explicit type applications (e.g., f ` { front = 3 })
field_ty_val :: { Named Type }
: name '=' type { Named { name = $1, value = $3 } }
field_ty_vals :: { [Named Type] }
: field_ty_val { [$1] }
| field_ty_vals ',' field_ty_val { $3 : $1 }
{
parseModName :: String -> Maybe ModName
parseModName txt =
case parse defaultConfig { cfgModuleScope = False } modName txt of
Right a -> Just (thing a)
Left _ -> Nothing
addImplicitIncludes :: Config -> Program -> Program
addImplicitIncludes cfg (Program ds) =
Program $ map path (cfgAutoInclude cfg) ++ ds
where path p = Include Located { srcRange = rng, thing = p }
rng = Range { source = cfgSource cfg, from = start, to = start }
parseProgramWith :: Config -> String -> Either ParseError Program
parseProgramWith cfg s = case res s of
Left err -> Left err
Right a -> Right (addImplicitIncludes cfg a)
where
res = parse cfg $ case cfgLayout cfg of
Layout -> programLayout
NoLayout -> program
parseModule :: Config -> String -> Either ParseError Module
parseModule cfg = parse cfg { cfgModuleScope = True } vmodule
parseProgram :: Layout -> String -> Either ParseError Program
parseProgram l = parseProgramWith defaultConfig { cfgLayout = l }
parseExprWith :: Config -> String -> Either ParseError Expr
parseExprWith cfg = parse cfg { cfgModuleScope = False } expr
parseExpr :: String -> Either ParseError Expr
parseExpr = parseExprWith defaultConfig
parseDeclWith :: Config -> String -> Either ParseError Decl
parseDeclWith cfg = parse cfg { cfgModuleScope = False } decl
parseDecl :: String -> Either ParseError Decl
parseDecl = parseDeclWith defaultConfig
parseDeclsWith :: Config -> String -> Either ParseError [Decl]
parseDeclsWith cfg = parse cfg { cfgModuleScope = ms } decls'
where (ms, decls') = case cfgLayout cfg of
Layout -> (True, declsLayout)
NoLayout -> (False, decls)
parseDecls :: String -> Either ParseError [Decl]
parseDecls = parseDeclsWith defaultConfig
parseLetDeclWith :: Config -> String -> Either ParseError Decl
parseLetDeclWith cfg = parse cfg { cfgModuleScope = False } letDecl
parseLetDecl :: String -> Either ParseError Decl
parseLetDecl = parseLetDeclWith defaultConfig
parseReplWith :: Config -> String -> Either ParseError ReplInput
parseReplWith cfg = parse cfg { cfgModuleScope = False } repl
parseRepl :: String -> Either ParseError ReplInput
parseRepl = parseReplWith defaultConfig
parseSchemaWith :: Config -> String -> Either ParseError Schema
parseSchemaWith cfg = parse cfg { cfgModuleScope = False } schema
parseSchema :: String -> Either ParseError Schema
parseSchema = parseSchemaWith defaultConfig
-- vim: ft=haskell
}
cryptol-2.2.6/src/Cryptol/Prelude.hs 0000644 0000000 0000000 00000002174 12637103426 015572 0 ustar 00 0000000 0000000 -- |
-- Module : $Header$
-- Copyright : (c) 2015 Galois, Inc.
-- License : BSD3
-- Maintainer : cryptol@galois.com
-- Stability : provisional
-- Portability : portable
--
-- Include the prelude when building with -fself-contained
{-# LANGUAGE CPP #-}
{-# LANGUAGE QuasiQuotes #-}
module Cryptol.Prelude (writePreludeContents) where
import Cryptol.ModuleSystem.Monad
#ifdef SELF_CONTAINED
import System.Directory (getTemporaryDirectory)
import System.IO (hClose, hPutStr, openTempFile)
import Text.Heredoc (there)
preludeContents :: String
preludeContents = [there|lib/Cryptol.cry|]
-- | Write the contents of the Prelude to a temporary file so that
-- Cryptol can load the module.
writePreludeContents :: ModuleM FilePath
writePreludeContents = io $ do
tmpdir <- getTemporaryDirectory
(path, h) <- openTempFile tmpdir "Cryptol.cry"
hPutStr h preludeContents
hClose h
return path
#else
import Cryptol.Parser.AST as P
-- | If we're not self-contained, the Prelude is just missing
writePreludeContents :: ModuleM FilePath
writePreludeContents = moduleNotFound (P.ModName ["Cryptol"]) =<< getSearchPath
#endif
cryptol-2.2.6/src/Cryptol/Symbolic.hs 0000644 0000000 0000000 00000045467 12637103426 015767 0 ustar 00 0000000 0000000 -- |
-- Module : $Header$
-- Copyright : (c) 2013-2015 Galois, Inc.
-- License : BSD3
-- Maintainer : cryptol@galois.com
-- Stability : provisional
-- Portability : portable
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
module Cryptol.Symbolic where
import Control.Monad (replicateM, when, zipWithM)
import Data.List (transpose, intercalate)
import qualified Data.Map as Map
import qualified Control.Exception as X
import qualified Data.SBV.Dynamic as SBV
import qualified Cryptol.ModuleSystem as M
import qualified Cryptol.ModuleSystem.Env as M
import qualified Cryptol.ModuleSystem.Monad as M
import Cryptol.Symbolic.Prims
import Cryptol.Symbolic.Value
import qualified Cryptol.Eval.Value as Eval
import qualified Cryptol.Eval.Type (evalType)
import qualified Cryptol.Eval.Env (EvalEnv(..))
import Cryptol.TypeCheck.AST
import Cryptol.TypeCheck.Solver.InfNat (Nat'(..))
import Cryptol.Utils.PP
import Cryptol.Utils.Panic(panic)
#if __GLASGOW_HASKELL__ < 710
import Control.Applicative
import Data.Monoid (Monoid(..))
import Data.Traversable (traverse)
#endif
#if MIN_VERSION_sbv(5,1,0)
smtMode :: SBV.SMTLibVersion
smtMode = SBV.SMTLib2
#else
smtMode :: Bool
smtMode = True
#endif
-- External interface ----------------------------------------------------------
proverConfigs :: [(String, SBV.SMTConfig)]
proverConfigs =
[ ("cvc4" , SBV.cvc4 )
, ("yices" , SBV.yices )
, ("z3" , SBV.z3 )
, ("boolector", SBV.boolector)
, ("mathsat" , SBV.mathSAT )
, ("abc" , SBV.abc )
, ("offline" , SBV.defaultSMTCfg )
, ("any" , SBV.defaultSMTCfg )
]
proverNames :: [String]
proverNames = map fst proverConfigs
lookupProver :: String -> SBV.SMTConfig
lookupProver s =
case lookup s proverConfigs of
Just cfg -> cfg
-- should be caught by UI for setting prover user variable
Nothing -> panic "Cryptol.Symbolic" [ "invalid prover: " ++ s ]
type SatResult = [(Type, Expr, Eval.Value)]
data SatNum = AllSat | SomeSat Int
deriving (Show)
data QueryType = SatQuery SatNum | ProveQuery
deriving (Show)
data ProverCommand = ProverCommand {
pcQueryType :: QueryType
-- ^ The type of query to run
, pcProverName :: String
-- ^ Which prover to use (one of the strings in 'proverConfigs')
, pcVerbose :: Bool
-- ^ Verbosity flag passed to SBV
, pcExtraDecls :: [DeclGroup]
-- ^ Extra declarations to bring into scope for symbolic
-- simulation
, pcSmtFile :: Maybe FilePath
-- ^ Optionally output the SMTLIB query to a file
, pcExpr :: Expr
-- ^ The typechecked expression to evaluate
, pcSchema :: Schema
-- ^ The 'Schema' of @pcExpr@
}
-- | A prover result is either an error message, an empty result (eg
-- for the offline prover), a counterexample or a lazy list of
-- satisfying assignments.
data ProverResult = AllSatResult [SatResult] -- LAZY
| ThmResult [Type]
| EmptyResult
| ProverError String
satSMTResults :: SBV.SatResult -> [SBV.SMTResult]
satSMTResults (SBV.SatResult r) = [r]
allSatSMTResults :: SBV.AllSatResult -> [SBV.SMTResult]
allSatSMTResults (SBV.AllSatResult (_, rs)) = rs
thmSMTResults :: SBV.ThmResult -> [SBV.SMTResult]
thmSMTResults (SBV.ThmResult r) = [r]
proverError :: String -> M.ModuleCmd ProverResult
proverError msg modEnv = return (Right (ProverError msg, modEnv), [])
satProve :: ProverCommand -> M.ModuleCmd ProverResult
satProve ProverCommand {..} = protectStack proverError $ \modEnv ->
M.runModuleM modEnv $ do
let (isSat, mSatNum) = case pcQueryType of
ProveQuery -> (False, Nothing)
SatQuery sn -> case sn of
SomeSat n -> (True, Just n)
AllSat -> (True, Nothing)
let extDgs = allDeclGroups modEnv ++ pcExtraDecls
provers <-
case pcProverName of
"any" -> M.io SBV.sbvAvailableSolvers
_ -> return [(lookupProver pcProverName) { SBV.smtFile = pcSmtFile }]
let provers' = [ p { SBV.timing = pcVerbose, SBV.verbose = pcVerbose } | p <- provers ]
let tyFn = if isSat then existsFinType else forallFinType
let runProver fn tag e = do
case provers of
[prover] -> do
when pcVerbose $ M.io $
putStrLn $ "Trying proof with " ++ show prover
res <- M.io (fn prover e)
when pcVerbose $ M.io $
putStrLn $ "Got result from " ++ show prover
return (tag res)
_ ->
return [ SBV.ProofError
prover
[":sat with option prover=any requires option satNum=1"]
| prover <- provers ]
runProvers fn tag e = do
when pcVerbose $ M.io $
putStrLn $ "Trying proof with " ++
intercalate ", " (map show provers)
(firstProver, res) <- M.io $ fn provers' e
when pcVerbose $ M.io $
putStrLn $ "Got result from " ++ show firstProver
return (tag res)
let runFn = case pcQueryType of
ProveQuery -> runProvers SBV.proveWithAny thmSMTResults
SatQuery sn -> case sn of
SomeSat 1 -> runProvers SBV.satWithAny satSMTResults
_ -> runProver SBV.allSatWith allSatSMTResults
case predArgTypes pcSchema of
Left msg -> return (ProverError msg)
Right ts -> do when pcVerbose $ M.io $ putStrLn "Simulating..."
let env = evalDecls mempty extDgs
let v = evalExpr env pcExpr
results' <- runFn $ do
args <- mapM tyFn ts
b <- return $! fromVBit (foldl fromVFun v args)
return b
let results = maybe results' (\n -> take n results') mSatNum
esatexprs <- case results of
-- allSat can return more than one as long as
-- they're satisfiable
(SBV.Satisfiable {} : _) -> do
tevss <- mapM mkTevs results
return $ AllSatResult tevss
where
mkTevs result =
let Right (_, cws) = SBV.getModel result
(vs, _) = parseValues ts cws
sattys = unFinType <$> ts
satexprs = zipWithM Eval.toExpr sattys vs
in case zip3 sattys <$> satexprs <*> pure vs of
Nothing ->
panic "Cryptol.Symbolic.sat"
[ "unable to make assignment into expression" ]
Just tevs -> return $ tevs
-- prove returns only one
[SBV.Unsatisfiable {}] ->
return $ ThmResult (unFinType <$> ts)
-- unsat returns empty
[] -> return $ ThmResult (unFinType <$> ts)
-- otherwise something is wrong
_ -> return $ ProverError (rshow results)
where rshow | isSat = show . SBV.AllSatResult . (boom,)
| otherwise = show . SBV.ThmResult . head
boom = panic "Cryptol.Symbolic.sat"
[ "attempted to evaluate bogus boolean for pretty-printing" ]
return esatexprs
satProveOffline :: ProverCommand -> M.ModuleCmd (Either String String)
satProveOffline ProverCommand {..} =
protectStack (\msg modEnv -> return (Right (Left msg, modEnv), [])) $ \modEnv -> do
let isSat = case pcQueryType of
ProveQuery -> False
SatQuery _ -> True
let extDgs = allDeclGroups modEnv ++ pcExtraDecls
let tyFn = if isSat then existsFinType else forallFinType
case predArgTypes pcSchema of
Left msg -> return (Right (Left msg, modEnv), [])
Right ts ->
do when pcVerbose $ putStrLn "Simulating..."
let env = evalDecls mempty extDgs
let v = evalExpr env pcExpr
smtlib <- SBV.compileToSMTLib SBV.SMTLib2 isSat $ do
args <- mapM tyFn ts
b <- return $! fromVBit (foldl fromVFun v args)
return b
return (Right (Right smtlib, modEnv), [])
protectStack :: (String -> M.ModuleCmd a)
-> M.ModuleCmd a
-> M.ModuleCmd a
protectStack mkErr cmd modEnv =
X.catchJust isOverflow (cmd modEnv) handler
where isOverflow X.StackOverflow = Just ()
isOverflow _ = Nothing
msg = "Symbolic evaluation failed to terminate."
handler () = mkErr msg modEnv
parseValues :: [FinType] -> [SBV.CW] -> ([Eval.Value], [SBV.CW])
parseValues [] cws = ([], cws)
parseValues (t : ts) cws = (v : vs, cws'')
where (v, cws') = parseValue t cws
(vs, cws'') = parseValues ts cws'
parseValue :: FinType -> [SBV.CW] -> (Eval.Value, [SBV.CW])
parseValue FTBit [] = panic "Cryptol.Symbolic.parseValue" [ "empty FTBit" ]
parseValue FTBit (cw : cws) = (Eval.VBit (SBV.cwToBool cw), cws)
parseValue (FTSeq 0 FTBit) cws = (Eval.VWord (Eval.BV 0 0), cws)
parseValue (FTSeq n FTBit) cws =
case SBV.genParse (SBV.KBounded False n) cws of
Just (x, cws') -> (Eval.VWord (Eval.BV (toInteger n) x), cws')
Nothing -> (Eval.VSeq True vs, cws')
where (vs, cws') = parseValues (replicate n FTBit) cws
parseValue (FTSeq n t) cws = (Eval.VSeq False vs, cws')
where (vs, cws') = parseValues (replicate n t) cws
parseValue (FTTuple ts) cws = (Eval.VTuple vs, cws')
where (vs, cws') = parseValues ts cws
parseValue (FTRecord fs) cws = (Eval.VRecord (zip ns vs), cws')
where (ns, ts) = unzip fs
(vs, cws') = parseValues ts cws
allDeclGroups :: M.ModuleEnv -> [DeclGroup]
allDeclGroups = concatMap mDecls . M.loadedModules
data FinType
= FTBit
| FTSeq Int FinType
| FTTuple [FinType]
| FTRecord [(Name, FinType)]
numType :: Type -> Maybe Int
numType (TCon (TC (TCNum n)) [])
| 0 <= n && n <= toInteger (maxBound :: Int) = Just (fromInteger n)
numType (TUser _ _ t) = numType t
numType _ = Nothing
finType :: Type -> Maybe FinType
finType ty =
case ty of
TCon (TC TCBit) [] -> Just FTBit
TCon (TC TCSeq) [n, t] -> FTSeq <$> numType n <*> finType t
TCon (TC (TCTuple _)) ts -> FTTuple <$> traverse finType ts
TRec fields -> FTRecord <$> traverse (traverseSnd finType) fields
TUser _ _ t -> finType t
_ -> Nothing
unFinType :: FinType -> Type
unFinType fty =
case fty of
FTBit -> tBit
FTSeq l ety -> tSeq (tNum l) (unFinType ety)
FTTuple ftys -> tTuple (unFinType <$> ftys)
FTRecord fs -> tRec (zip fns tys)
where
fns = fst <$> fs
tys = unFinType . snd <$> fs
predArgTypes :: Schema -> Either String [FinType]
predArgTypes schema@(Forall ts ps ty)
| null ts && null ps =
case go ty of
Just fts -> Right fts
Nothing -> Left $ "Not a valid predicate type:\n" ++ show (pp schema)
| otherwise = Left $ "Not a monomorphic type:\n" ++ show (pp schema)
where
go (TCon (TC TCBit) []) = Just []
go (TCon (TC TCFun) [ty1, ty2]) = (:) <$> finType ty1 <*> go ty2
go (TUser _ _ t) = go t
go _ = Nothing
forallFinType :: FinType -> SBV.Symbolic Value
forallFinType ty =
case ty of
FTBit -> VBit <$> forallSBool_
FTSeq 0 FTBit -> return $ VWord (literalSWord 0 0)
FTSeq n FTBit -> VWord <$> (forallBV_ n)
FTSeq n t -> VSeq False <$> replicateM n (forallFinType t)
FTTuple ts -> VTuple <$> mapM forallFinType ts
FTRecord fs -> VRecord <$> mapM (traverseSnd forallFinType) fs
existsFinType :: FinType -> SBV.Symbolic Value
existsFinType ty =
case ty of
FTBit -> VBit <$> existsSBool_
FTSeq 0 FTBit -> return $ VWord (literalSWord 0 0)
FTSeq n FTBit -> VWord <$> existsBV_ n
FTSeq n t -> VSeq False <$> replicateM n (existsFinType t)
FTTuple ts -> VTuple <$> mapM existsFinType ts
FTRecord fs -> VRecord <$> mapM (traverseSnd existsFinType) fs
-- Simulation environment ------------------------------------------------------
data Env = Env
{ envVars :: Map.Map QName Value
, envTypes :: Map.Map TVar TValue
}
instance Monoid Env where
mempty = Env
{ envVars = Map.empty
, envTypes = Map.empty
}
mappend l r = Env
{ envVars = Map.union (envVars l) (envVars r)
, envTypes = Map.union (envTypes l) (envTypes r)
}
emptyEnv :: Env
emptyEnv = mempty
-- | Bind a variable in the evaluation environment.
bindVar :: (QName, Value) -> Env -> Env
bindVar (n, thunk) env = env { envVars = Map.insert n thunk (envVars env) }
-- | Lookup a variable in the environment.
lookupVar :: QName -> Env -> Maybe Value
lookupVar n env = Map.lookup n (envVars env)
-- | Bind a type variable of kind *.
bindType :: TVar -> TValue -> Env -> Env
bindType p ty env = env { envTypes = Map.insert p ty (envTypes env) }
-- | Lookup a type variable.
lookupType :: TVar -> Env -> Maybe TValue
lookupType p env = Map.lookup p (envTypes env)
-- Expressions -----------------------------------------------------------------
evalExpr :: Env -> Expr -> Value
evalExpr env expr =
case expr of
ECon econ -> evalECon econ
EList es ty -> VSeq (tIsBit ty) (map eval es)
ETuple es -> VTuple (map eval es)
ERec fields -> VRecord [ (f, eval e) | (f, e) <- fields ]
ESel e sel -> evalSel sel (eval e)
EIf b e1 e2 -> iteValue (fromVBit (eval b)) (eval e1) (eval e2)
EComp ty e mss -> evalComp env (evalType env ty) e mss
EVar n -> case lookupVar n env of
Just x -> x
_ -> panic "Cryptol.Symbolic.evalExpr" [ "Variable " ++ show n ++ " not found" ]
-- TODO: how to deal with uninterpreted functions?
ETAbs tv e -> VPoly $ \ty -> evalExpr (bindType (tpVar tv) ty env) e
ETApp e ty -> fromVPoly (eval e) (evalType env ty)
EApp e1 e2 -> fromVFun (eval e1) (eval e2)
EAbs n _ty e -> VFun $ \x -> evalExpr (bindVar (n, x) env) e
EProofAbs _prop e -> eval e
EProofApp e -> eval e
ECast e _ty -> eval e
EWhere e ds -> evalExpr (evalDecls env ds) e
where
eval e = evalExpr env e
evalType :: Env -> Type -> TValue
evalType env ty = Cryptol.Eval.Type.evalType env' ty
where env' = Cryptol.Eval.Env.EvalEnv Map.empty (envTypes env)
evalSel :: Selector -> Value -> Value
evalSel sel v =
case sel of
TupleSel n _ ->
case v of
VTuple xs -> xs !! n -- 0-based indexing
VSeq b xs -> VSeq b (map (evalSel sel) xs)
VStream xs -> VStream (map (evalSel sel) xs)
VFun f -> VFun (\x -> evalSel sel (f x))
_ -> panic "Cryptol.Symbolic.evalSel" [ "Tuple selector applied to incompatible type" ]
RecordSel n _ ->
case v of
VRecord bs -> case lookup n bs of
Just x -> x
_ -> panic "Cryptol.Symbolic.evalSel" [ "Selector " ++ show n ++ " not found" ]
VSeq b xs -> VSeq b (map (evalSel sel) xs)
VStream xs -> VStream (map (evalSel sel) xs)
VFun f -> VFun (\x -> evalSel sel (f x))
_ -> panic "Cryptol.Symbolic.evalSel" [ "Record selector applied to non-record" ]
ListSel n _ -> case v of
VWord s -> VBit (SBV.svTestBit s i)
where i = SBV.intSizeOf s - 1 - n
_ -> fromSeq v !! n -- 0-based indexing
-- Declarations ----------------------------------------------------------------
evalDecls :: Env -> [DeclGroup] -> Env
evalDecls = foldl evalDeclGroup
evalDeclGroup :: Env -> DeclGroup -> Env
evalDeclGroup env dg =
case dg of
NonRecursive d -> bindVar (evalDecl env d) env
Recursive ds -> let env' = foldr bindVar env lazyBindings
bindings = map (evalDecl env') ds
lazyBindings = [ (qname, copyBySchema env (dSignature d) v)
| (d, (qname, v)) <- zip ds bindings ]
in env'
evalDecl :: Env -> Decl -> (QName, Value)
evalDecl env d = (dName d, evalExpr env (dDefinition d))
-- | Make a copy of the given value, building the spine based only on
-- the type without forcing the value argument. This lets us avoid
-- strictness problems when evaluating recursive definitions.
copyBySchema :: Env -> Schema -> Value -> Value
copyBySchema env0 (Forall params _props ty) = go params env0
where
go [] env v = copyByType env (evalType env ty) v
go (p : ps) env v =
VPoly (\t -> go ps (bindType (tpVar p) t env) (fromVPoly v t))
copyByType :: Env -> TValue -> Value -> Value
copyByType env ty v
| isTBit ty = VBit (fromVBit v)
| Just (n, ety) <- isTSeq ty = case numTValue n of
Nat _ -> VSeq (isTBit ety) (fromSeq v)
Inf -> VStream (fromSeq v)
| Just (_, bty) <- isTFun ty = VFun (\x -> copyByType env bty (fromVFun v x))
| Just (_, tys) <- isTTuple ty = VTuple (zipWith (copyByType env) tys (fromVTuple v))
| Just fs <- isTRec ty = VRecord [ (f, copyByType env t (lookupRecord f v)) | (f, t) <- fs ]
| otherwise = v
-- copyByType env ty v = logicUnary id id (evalType env ty) v
-- List Comprehensions ---------------------------------------------------------
-- | Evaluate a comprehension.
evalComp :: Env -> TValue -> Expr -> [[Match]] -> Value
evalComp env seqty body ms
| Just (len,el) <- isTSeq seqty = toSeq len el [ evalExpr e body | e <- envs ]
| otherwise = evalPanic "Cryptol.Eval" [ "evalComp given a non sequence"
, show seqty
]
-- XXX we could potentially print this as a number if the type was available.
where
-- generate a new environment for each iteration of each parallel branch
benvs = map (branchEnvs env) ms
-- take parallel slices of each environment. when the length of the list
-- drops below the number of branches, one branch has terminated.
allBranches es = length es == length ms
slices = takeWhile allBranches (transpose benvs)
-- join environments to produce environments at each step through the process.
envs = map mconcat slices
-- | Turn a list of matches into the final environments for each iteration of
-- the branch.
branchEnvs :: Env -> [Match] -> [Env]
branchEnvs env matches =
case matches of
[] -> [env]
m : ms -> do env' <- evalMatch env m
branchEnvs env' ms
-- | Turn a match into the list of environments it represents.
evalMatch :: Env -> Match -> [Env]
evalMatch env m = case m of
From n _ty expr -> [ bindVar (n, v) env | v <- fromSeq (evalExpr env expr) ]
Let d -> [ bindVar (evalDecl env d) env ]
cryptol-2.2.6/src/Cryptol/TypeCheck.hs 0000644 0000000 0000000 00000006165 12637103426 016055 0 ustar 00 0000000 0000000 -- |
-- Module : $Header$
-- Copyright : (c) 2013-2015 Galois, Inc.
-- License : BSD3
-- Maintainer : cryptol@galois.com
-- Stability : provisional
-- Portability : portable
module Cryptol.TypeCheck
( tcModule
, tcExpr
, tcDecls
, InferInput(..)
, InferOutput(..)
, NameSeeds
, nameSeeds
, Error(..)
, Warning(..)
, ppWarning
, ppError
) where
import qualified Cryptol.Parser.AST as P
import Cryptol.Parser.Position(Range)
import Cryptol.TypeCheck.AST
import Cryptol.TypeCheck.Depends (FromDecl)
import Cryptol.TypeCheck.Monad
( runInferM
, InferInput(..)
, InferOutput(..)
, NameSeeds
, nameSeeds
, lookupVar
)
import Cryptol.Prims.Types(typeOf)
import Cryptol.TypeCheck.Infer (inferModule, inferBinds, inferDs)
import Cryptol.TypeCheck.InferTypes(Error(..),Warning(..),VarType(..))
import Cryptol.TypeCheck.Solve(simplifyAllConstraints)
import Cryptol.Utils.PP
import Cryptol.Utils.Panic(panic)
tcModule :: P.Module -> InferInput -> IO (InferOutput Module)
tcModule m inp = runInferM inp
$ do x <- inferModule m
simplifyAllConstraints
return x
tcExpr :: P.Expr -> InferInput -> IO (InferOutput (Expr,Schema))
tcExpr e0 inp = runInferM inp
$ do x <- go e0
simplifyAllConstraints
return x
where
go expr =
case expr of
P.ELocated e _ -> go e
P.ECon ec -> return (ECon ec, typeOf ec)
P.EVar x ->
do res <- lookupVar x
case res of
ExtVar s -> return (EVar x, s)
CurSCC e' t -> panic "Cryptol.TypeCheck.tcExpr"
[ "CurSCC outside binder checkig:"
, show e'
, show t
]
_ -> do res <- inferBinds True False
[ P.Bind
{ P.bName = P.Located (inpRange inp)
$ mkUnqual (P.Name "(expression)")
, P.bParams = []
, P.bDef = expr
, P.bPragmas = []
, P.bSignature = Nothing
, P.bMono = False
} ]
case res of
[d] -> return (dDefinition d, dSignature d)
_ -> panic "Cryptol.TypeCheck.tcExpr"
( "Multiple declarations when check expression:"
: map show res
)
tcDecls :: FromDecl d => [d] -> InferInput -> IO (InferOutput [DeclGroup])
tcDecls ds inp = runInferM inp $ inferDs ds $ \dgs -> do
simplifyAllConstraints
return dgs
ppWarning :: (Range,Warning) -> Doc
ppWarning (r,w) = text "[warning] at" <+> pp r <> colon $$ nest 2 (pp w)
ppError :: (Range,Error) -> Doc
ppError (r,w) = text "[error] at" <+> pp r <> colon $$ nest 2 (pp w)
cryptol-2.2.6/src/Cryptol/Version.hs 0000644 0000000 0000000 00000000744 12637103426 015620 0 ustar 00 0000000 0000000 -- |
-- Module : $Header$
-- Copyright : (c) 2013-2015 Galois, Inc.
-- License : BSD3
-- Maintainer : cryptol@galois.com
-- Stability : provisional
-- Portability : portable
{-# LANGUAGE Safe #-}
module Cryptol.Version where
import qualified GitRev
commitHash :: String
commitHash = GitRev.hash
commitShortHash :: String
commitShortHash = take 7 GitRev.hash
commitBranch :: String
commitBranch = GitRev.branch
commitDirty :: Bool
commitDirty = GitRev.dirty
cryptol-2.2.6/src/Cryptol/Eval/ 0000755 0000000 0000000 00000000000 12637103426 014521 5 ustar 00 0000000 0000000 cryptol-2.2.6/src/Cryptol/Eval/Arch.hs 0000644 0000000 0000000 00000001554 12637103426 015737 0 ustar 00 0000000 0000000 -- |
-- Module : $Header$
-- Copyright : (c) 2014-2015 Galois, Inc.
-- License : BSD3
-- Maintainer : cryptol@galois.com
-- Stability : provisional
-- Portability : portable
--
-- Architecture-specific parts of the concrete evaluator go here.
{-# LANGUAGE CPP #-}
module Cryptol.Eval.Arch where
-- | This is the widest word we can have before gmp will fail to
-- allocate and bring down the whole program. According to
--
-- the sizes are 2^32-1 for 32-bit, and 2^37 for 64-bit, however
-- experiments show that it's somewhere under 2^37 at least on 64-bit
-- Mac OS X.
maxBigIntWidth :: Integer
#if i386_HOST_ARCH
maxBigIntWidth = 2^(32 :: Integer) - 0x1
#elif x86_64_HOST_ARCH
maxBigIntWidth = 2^(37 :: Integer) - 0x100
#else
#error unknown max width for gmp on this architecture
#endif
cryptol-2.2.6/src/Cryptol/Eval/Env.hs 0000644 0000000 0000000 00000003366 12637103426 015615 0 ustar 00 0000000 0000000 -- |
-- Module : $Header$
-- Copyright : (c) 2013-2015 Galois, Inc.
-- License : BSD3
-- Maintainer : cryptol@galois.com
-- Stability : provisional
-- Portability : portable
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE Safe #-}
module Cryptol.Eval.Env where
import Cryptol.Eval.Value
import Cryptol.TypeCheck.AST
import Cryptol.Utils.PP
import qualified Data.Map as Map
#if __GLASGOW_HASKELL__ < 710
import Data.Monoid (Monoid(..))
#endif
-- Evaluation Environment ------------------------------------------------------
type ReadEnv = EvalEnv
data EvalEnv = EvalEnv
{ envVars :: Map.Map QName Value
, envTypes :: Map.Map TVar TValue
}
instance Monoid EvalEnv where
mempty = EvalEnv
{ envVars = Map.empty
, envTypes = Map.empty
}
mappend l r = EvalEnv
{ envVars = Map.union (envVars l) (envVars r)
, envTypes = Map.union (envTypes l) (envTypes r)
}
instance PP (WithBase EvalEnv) where
ppPrec _ (WithBase opts env) = brackets (fsep (map bind (Map.toList (envVars env))))
where
bind (k,v) = pp k <+> text "->" <+> ppValue opts v
emptyEnv :: EvalEnv
emptyEnv = mempty
-- | Bind a variable in the evaluation environment.
bindVar :: QName -> Value -> EvalEnv -> EvalEnv
bindVar n val env = env { envVars = Map.insert n val (envVars env) }
-- | Lookup a variable in the environment.
lookupVar :: QName -> EvalEnv -> Maybe Value
lookupVar n env = Map.lookup n (envVars env)
-- | Bind a type variable of kind *.
bindType :: TVar -> TValue -> EvalEnv -> EvalEnv
bindType p ty env = env { envTypes = Map.insert p ty (envTypes env) }
-- | Lookup a type variable.
lookupType :: TVar -> EvalEnv -> Maybe TValue
lookupType p env = Map.lookup p (envTypes env)
cryptol-2.2.6/src/Cryptol/Eval/Error.hs 0000644 0000000 0000000 00000003555 12637103426 016156 0 ustar 00 0000000 0000000 -- |
-- Module : $Header$
-- Copyright : (c) 2013-2015 Galois, Inc.
-- License : BSD3
-- Maintainer : cryptol@galois.com
-- Stability : provisional
-- Portability : portable
{-# LANGUAGE Safe #-}
{-# LANGUAGE DeriveDataTypeable #-}
module Cryptol.Eval.Error where
import Cryptol.Utils.Panic
import Cryptol.Utils.PP
import Cryptol.TypeCheck.AST(Type)
import Data.Typeable (Typeable)
import qualified Control.Exception as X
-- Errors ----------------------------------------------------------------------
-- | Panic from an Eval context.
evalPanic :: String -> [String] -> a
evalPanic cxt = panic ("[Eval] " ++ cxt)
data EvalError
= InvalidIndex Integer
| TypeCannotBeDemoted Type
| DivideByZero
| WordTooWide Integer
| UserError String
deriving (Typeable,Show)
instance PP EvalError where
ppPrec _ e = case e of
InvalidIndex i -> text "invalid sequence index:" <+> integer i
TypeCannotBeDemoted t -> text "type cannot be demoted:" <+> pp t
DivideByZero -> text "division by 0"
WordTooWide w ->
text "word too wide for memory:" <+> integer w <+> text "bits"
UserError x -> text "Run-time error:" <+> text x
instance X.Exception EvalError
-- | A sequencing operation has gotten an invalid index.
invalidIndex :: Integer -> a
invalidIndex i = X.throw (InvalidIndex i)
-- | For things like `(inf) or `(0-1)
typeCannotBeDemoted :: Type -> a
typeCannotBeDemoted t = X.throw (TypeCannotBeDemoted t)
-- | For division by 0.
divideByZero :: a
divideByZero = X.throw DivideByZero
-- | For when we know that a word is too wide and will exceed gmp's
-- limits (though words approaching this size will probably cause the
-- system to crash anyway due to lack of memory)
wordTooWide :: Integer -> a
wordTooWide w = X.throw (WordTooWide w)
-- | For `error`
cryUserError :: String -> a
cryUserError msg = X.throw (UserError msg)
cryptol-2.2.6/src/Cryptol/Eval/Type.hs 0000644 0000000 0000000 00000004371 12637103426 016003 0 ustar 00 0000000 0000000 -- |
-- Module : $Header$
-- Copyright : (c) 2013-2015 Galois, Inc.
-- License : BSD3
-- Maintainer : cryptol@galois.com
-- Stability : provisional
-- Portability : portable
{-# LANGUAGE Safe, PatternGuards #-}
module Cryptol.Eval.Type (evalType, evalTF) where
import Cryptol.Eval.Env
import Cryptol.Eval.Error
import Cryptol.Eval.Value(TValue(..),numTValue)
import Cryptol.TypeCheck.AST
import Cryptol.TypeCheck.Solver.InfNat
import Data.Maybe(fromMaybe)
-- Type Evaluation -------------------------------------------------------------
-- | Evaluation for types.
evalType :: EvalEnv -> Type -> TValue
evalType env = TValue . go
where
go ty =
case ty of
TVar tv ->
case lookupType tv env of
Just (TValue v) -> v
Nothing -> evalPanic "evalType" ["type variable not bound", show tv]
TCon (TF f) ts -> tValTy $ evalTF f $ map (evalType env) ts
TCon tc ts -> TCon tc (map go ts)
TUser _ _ ty' -> go ty'
TRec fields -> TRec [ (f,go t) | (f,t) <- fields ]
-- | Reduce type functions, rising an exception for undefined values.
evalTF :: TFun -> [TValue] -> TValue
evalTF tf vs = TValue $ cvt $ evalTF' tf $ map numTValue vs
-- | Reduce type functions, rising an exception for undefined values.
evalTF' :: TFun -> [Nat'] -> Nat'
evalTF' f vs
| TCAdd <- f, [x,y] <- vs = nAdd x y
| TCSub <- f, [x,y] <- vs = mb $ nSub x y
| TCMul <- f, [x,y] <- vs = nMul x y
| TCDiv <- f, [x,y] <- vs = mb $ nDiv x y
| TCMod <- f, [x,y] <- vs = mb $ nMod x y
| TCLg2 <- f, [x] <- vs = nLg2 x
| TCWidth <- f, [x] <- vs = nWidth x
| TCExp <- f, [x,y] <- vs = nExp x y
| TCMin <- f, [x,y] <- vs = nMin x y
| TCMax <- f, [x,y] <- vs = nMax x y
| TCLenFromThen <- f, [x,y,z] <- vs = mb $ nLenFromThen x y z
| TCLenFromThenTo <- f, [x,y,z] <- vs = mb $ nLenFromThenTo x y z
| otherwise = evalPanic "evalTF"
["Unexpected type function:", show ty]
where mb = fromMaybe (typeCannotBeDemoted ty)
ty = TCon (TF f) (map cvt vs)
cvt :: Nat' -> Type
cvt (Nat n) = tNum n
cvt Inf = tInf
cryptol-2.2.6/src/Cryptol/Eval/Value.hs 0000644 0000000 0000000 00000030247 12637103426 016137 0 ustar 00 0000000 0000000 -- |
-- Module : $Header$
-- Copyright : (c) 2013-2015 Galois, Inc.
-- License : BSD3
-- Maintainer : cryptol@galois.com
-- Stability : provisional
-- Portability : portable
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE Safe #-}
module Cryptol.Eval.Value where
import qualified Cryptol.Eval.Arch as Arch
import Cryptol.Eval.Error
import Cryptol.Prims.Syntax (ECon(..))
import Cryptol.TypeCheck.AST
import Cryptol.TypeCheck.Solver.InfNat(Nat'(..))
import Cryptol.Utils.PP
import Cryptol.Utils.Panic(panic)
import Control.Monad (guard, zipWithM)
import Data.List(genericTake)
import Data.Bits (setBit,testBit,(.&.),shiftL)
import Numeric (showIntAtBase)
-- Utilities -------------------------------------------------------------------
isTBit :: TValue -> Bool
isTBit (TValue ty) = case ty of
TCon (TC TCBit) [] -> True
_ -> False
isTSeq :: TValue -> Maybe (TValue, TValue)
isTSeq (TValue (TCon (TC TCSeq) [t1,t2])) = Just (TValue t1, TValue t2)
isTSeq _ = Nothing
isTFun :: TValue -> Maybe (TValue, TValue)
isTFun (TValue (TCon (TC TCFun) [t1,t2])) = Just (TValue t1, TValue t2)
isTFun _ = Nothing
isTTuple :: TValue -> Maybe (Int,[TValue])
isTTuple (TValue (TCon (TC (TCTuple n)) ts)) = Just (n, map TValue ts)
isTTuple _ = Nothing
isTRec :: TValue -> Maybe [(Name, TValue)]
isTRec (TValue (TRec fs)) = Just [ (x, TValue t) | (x,t) <- fs ]
isTRec _ = Nothing
tvSeq :: TValue -> TValue -> TValue
tvSeq (TValue x) (TValue y) = TValue (tSeq x y)
numTValue :: TValue -> Nat'
numTValue (TValue ty) =
case ty of
TCon (TC (TCNum x)) _ -> Nat x
TCon (TC TCInf) _ -> Inf
_ -> panic "Cryptol.Eval.Value.numTValue" [ "Not a numeric type:", show ty ]
toNumTValue :: Nat' -> TValue
toNumTValue (Nat n) = TValue (TCon (TC (TCNum n)) [])
toNumTValue Inf = TValue (TCon (TC TCInf) [])
finTValue :: TValue -> Integer
finTValue tval =
case numTValue tval of
Nat x -> x
Inf -> panic "Cryptol.Eval.Value.finTValue" [ "Unexpected `inf`" ]
-- Values ----------------------------------------------------------------------
data BV = BV !Integer !Integer -- ^ width, value
-- The value may contain junk bits
-- | Smart constructor for 'BV's that checks for the width limit
mkBv :: Integer -> Integer -> BV
mkBv w i | w >= Arch.maxBigIntWidth = wordTooWide w
| otherwise = BV w i
-- | Generic value type, parameterized by bit and word types.
data GenValue b w
= VRecord [(Name, GenValue b w)] -- @ { .. } @
| VTuple [GenValue b w] -- @ ( .. ) @
| VBit b -- @ Bit @
| VSeq Bool [GenValue b w] -- @ [n]a @
-- The boolean parameter indicates whether or not
-- this is a sequence of bits.
| VWord w -- @ [n]Bit @
| VStream [GenValue b w] -- @ [inf]a @
| VFun (GenValue b w -> GenValue b w) -- functions
| VPoly (TValue -> GenValue b w) -- polymorphic values (kind *)
type Value = GenValue Bool BV
-- | An evaluated type.
-- These types do not contain type variables, type synonyms, or type functions.
newtype TValue = TValue { tValTy :: Type }
instance Show TValue where
showsPrec p (TValue v) = showsPrec p v
-- Pretty Printing -------------------------------------------------------------
data PPOpts = PPOpts
{ useAscii :: Bool
, useBase :: Int
, useInfLength :: Int
}
defaultPPOpts :: PPOpts
defaultPPOpts = PPOpts { useAscii = False, useBase = 10, useInfLength = 5 }
ppValue :: PPOpts -> Value -> Doc
ppValue opts = loop
where
loop val = case val of
VRecord fs -> braces (sep (punctuate comma (map ppField fs)))
where
ppField (f,r) = pp f <+> char '=' <+> loop r
VTuple vals -> parens (sep (punctuate comma (map loop vals)))
VBit b | b -> text "True"
| otherwise -> text "False"
VSeq isWord vals
| isWord -> ppWord opts (fromVWord val)
| otherwise -> ppWordSeq vals
VWord (BV w i) -> ppWord opts (BV w (mask w i))
VStream vals -> brackets $ fsep
$ punctuate comma
( take (useInfLength opts) (map loop vals)
++ [text "..."]
)
VFun _ -> text ""
VPoly _ -> text ""
ppWordSeq ws =
case ws of
w : _
| Just l <- vWordLen w, asciiMode opts l ->
text $ show $ map (integerToChar . fromWord) ws
_ -> brackets (fsep (punctuate comma (map loop ws)))
asciiMode :: PPOpts -> Integer -> Bool
asciiMode opts width = useAscii opts && (width == 7 || width == 8)
integerToChar :: Integer -> Char
integerToChar = toEnum . fromInteger
data WithBase a = WithBase PPOpts a
deriving (Functor)
instance PP (WithBase Value) where
ppPrec _ (WithBase opts v) = ppValue opts v
ppWord :: PPOpts -> BV -> Doc
ppWord opts (BV width i)
| base > 36 = integer i -- not sure how to rule this out
| asciiMode opts width = text (show (toEnum (fromInteger i) :: Char))
| otherwise = prefix <> text value
where
base = useBase opts
padding bitsPerDigit = text (replicate padLen '0')
where
padLen | m > 0 = d + 1
| otherwise = d
(d,m) = (fromInteger width - (length value * bitsPerDigit))
`divMod` bitsPerDigit
prefix = case base of
2 -> text "0b" <> padding 1
8 -> text "0o" <> padding 3
10 -> empty
16 -> text "0x" <> padding 4
_ -> text "0" <> char '<' <> int base <> char '>'
value = showIntAtBase (toInteger base) (digits !!) i ""
digits = "0123456789abcdefghijklmnopqrstuvwxyz"
-- Big-endian Words ------------------------------------------------------------
class BitWord b w where
-- | NOTE this assumes that the sequence of bits is big-endian and finite, so the
-- first element of the list will be the most significant bit.
packWord :: [b] -> w
-- | NOTE this produces a list of bits that represent a big-endian word, so the
-- most significant bit is the first element of the list.
unpackWord :: w -> [b]
mask :: Integer -- ^ Bit-width
-> Integer -- ^ Value
-> Integer -- ^ Masked result
mask w i | w >= Arch.maxBigIntWidth = wordTooWide w
| otherwise = i .&. ((1 `shiftL` fromInteger w) - 1)
instance BitWord Bool BV where
packWord bits = BV (toInteger w) a
where
w = case length bits of
len | toInteger len >= Arch.maxBigIntWidth -> wordTooWide (toInteger len)
| otherwise -> len
a = foldl set 0 (zip [w - 1, w - 2 .. 0] bits)
set acc (n,b) | b = setBit acc n
| otherwise = acc
unpackWord (BV w a) = [ testBit a n | n <- [w' - 1, w' - 2 .. 0] ]
where
w' = fromInteger w
-- Value Constructors ----------------------------------------------------------
-- | Create a packed word of n bits.
word :: Integer -> Integer -> Value
word n i = VWord (mkBv n (mask n i))
lam :: (GenValue b w -> GenValue b w) -> GenValue b w
lam = VFun
-- | A type lambda that expects a @Type@.
tlam :: (TValue -> GenValue b w) -> GenValue b w
tlam = VPoly
-- | Generate a stream.
toStream :: [GenValue b w] -> GenValue b w
toStream = VStream
toFinSeq :: TValue -> [GenValue b w] -> GenValue b w
toFinSeq elty = VSeq (isTBit elty)
-- | This is strict!
boolToWord :: [Bool] -> Value
boolToWord = VWord . packWord
-- | Construct either a finite sequence, or a stream. In the finite case,
-- record whether or not the elements were bits, to aid pretty-printing.
toSeq :: TValue -> TValue -> [GenValue b w] -> GenValue b w
toSeq len elty vals = case numTValue len of
Nat n -> toFinSeq elty (genericTake n vals)
Inf -> toStream vals
-- | Construct one of:
-- * a word, when the sequence is finite and the elements are bits
-- * a sequence, when the sequence is finite but the elements aren't bits
-- * a stream, when the sequence is not finite
--
-- NOTE: do not use this constructor in the case where the thing may be a
-- finite, but recursive, sequence.
toPackedSeq :: TValue -> TValue -> [Value] -> Value
toPackedSeq len elty vals = case numTValue len of
-- finite sequence, pack a word if the elements are bits.
Nat _ | isTBit elty -> boolToWord (map fromVBit vals)
| otherwise -> VSeq False vals
-- infinite sequence, construct a stream
Inf -> VStream vals
-- Value Destructors -----------------------------------------------------------
-- | Extract a bit value.
fromVBit :: GenValue b w -> b
fromVBit val = case val of
VBit b -> b
_ -> evalPanic "fromVBit" ["not a Bit"]
-- | Extract a sequence.
fromSeq :: BitWord b w => GenValue b w -> [GenValue b w]
fromSeq val = case val of
VSeq _ vs -> vs
VWord bv -> map VBit (unpackWord bv)
VStream vs -> vs
_ -> evalPanic "fromSeq" ["not a sequence"]
fromStr :: Value -> String
fromStr = map (toEnum . fromInteger . fromWord) . fromSeq
-- | Extract a packed word.
-- Note that this does not clean-up any junk bits in the word.
fromVWord :: BitWord b w => GenValue b w -> w
fromVWord val = case val of
VWord bv -> bv -- this should always mask
VSeq isWord bs | isWord -> packWord (map fromVBit bs)
_ -> evalPanic "fromVWord" ["not a word"]
vWordLen :: Value -> Maybe Integer
vWordLen val = case val of
VWord (BV w _) -> Just w
VSeq isWord bs | isWord -> Just (toInteger (length bs))
_ -> Nothing
-- | Turn a value into an integer represented by w bits.
fromWord :: Value -> Integer
fromWord val = mask w a
where
BV w a = fromVWord val
-- | Extract a function from a value.
fromVFun :: GenValue b w -> (GenValue b w -> GenValue b w)
fromVFun val = case val of
VFun f -> f
_ -> evalPanic "fromVFun" ["not a function"]
-- | Extract a polymorphic function from a value.
fromVPoly :: GenValue b w -> (TValue -> GenValue b w)
fromVPoly val = case val of
VPoly f -> f
_ -> evalPanic "fromVPoly" ["not a polymorphic value"]
-- | Extract a tuple from a value.
fromVTuple :: GenValue b w -> [GenValue b w]
fromVTuple val = case val of
VTuple vs -> vs
_ -> evalPanic "fromVTuple" ["not a tuple"]
-- | Extract a record from a value.
fromVRecord :: GenValue b w -> [(Name, GenValue b w)]
fromVRecord val = case val of
VRecord fs -> fs
_ -> evalPanic "fromVRecord" ["not a record"]
-- | Lookup a field in a record.
lookupRecord :: Name -> GenValue b w -> GenValue b w
lookupRecord f rec = case lookup f (fromVRecord rec) of
Just val -> val
Nothing -> evalPanic "lookupRecord" ["malformed record"]
-- Value to Expression conversion ----------------------------------------------
-- | Given an expected type, returns an expression that evaluates to
-- this value, if we can determine it.
--
-- XXX: View patterns would probably clean up this definition a lot.
toExpr :: Type -> Value -> Maybe Expr
toExpr ty val = case (ty, val) of
(TRec tfs, VRecord vfs) -> do
let fns = map fst vfs
guard (map fst tfs == fns)
fes <- zipWithM toExpr (map snd tfs) (map snd vfs)
return $ ERec (zip fns fes)
(TCon (TC (TCTuple tl)) ts, VTuple tvs) -> do
guard (tl == (length tvs))
ETuple `fmap` zipWithM toExpr ts tvs
(TCon (TC TCBit) [], VBit True ) -> return $ ECon ECTrue
(TCon (TC TCBit) [], VBit False) -> return $ ECon ECFalse
(TCon (TC TCSeq) [a,b], VSeq _ []) -> do
guard (a == tZero)
return $ EList [] b
(TCon (TC TCSeq) [a,b], VSeq _ svs) -> do
guard (a == tNum (length svs))
ses <- mapM (toExpr b) svs
return $ EList ses b
(TCon (TC TCSeq) [a,(TCon (TC TCBit) [])], VWord (BV w v)) -> do
guard (a == tNum w)
return $ ETApp (ETApp (ECon ECDemote) (tNum v)) (tNum w)
(_, VStream _) -> fail "cannot construct infinite expressions"
(_, VFun _) -> fail "cannot convert function values to expressions"
(_, VPoly _) -> fail "cannot convert polymorphic values to expressions"
_ -> panic "Cryptol.Eval.Value.toExpr"
["type mismatch:"
, pretty ty
, render (ppValue defaultPPOpts val)
]
cryptol-2.2.6/src/Cryptol/ModuleSystem/ 0000755 0000000 0000000 00000000000 12637103426 016264 5 ustar 00 0000000 0000000 cryptol-2.2.6/src/Cryptol/ModuleSystem/Base.hs 0000644 0000000 0000000 00000026600 12637103426 017476 0 ustar 00 0000000 0000000 -- |
-- Module : $Header$
-- Copyright : (c) 2013-2015 Galois, Inc.
-- License : BSD3
-- Maintainer : cryptol@galois.com
-- Stability : provisional
-- Portability : portable
module Cryptol.ModuleSystem.Base where
import Cryptol.ModuleSystem.Env (DynamicEnv(..), deIfaceDecls)
import Cryptol.ModuleSystem.Interface
import Cryptol.ModuleSystem.Monad
import Cryptol.ModuleSystem.Env (lookupModule, LoadedModule(..))
import qualified Cryptol.Eval as E
import qualified Cryptol.Eval.Value as E
import qualified Cryptol.ModuleSystem.Renamer as R
import qualified Cryptol.Parser as P
import qualified Cryptol.Parser.Unlit as P
import Cryptol.Parser.AST as P
import Cryptol.Parser.NoPat (RemovePatterns(removePatterns))
import Cryptol.Parser.NoInclude (removeIncludesModule)
import Cryptol.Parser.Position (HasLoc(..), Range, emptyRange)
import qualified Cryptol.TypeCheck as T
import qualified Cryptol.TypeCheck.AST as T
import qualified Cryptol.TypeCheck.Depends as T
import Cryptol.Utils.PP (pretty)
import Cryptol.Prelude (writePreludeContents)
import Cryptol.Transform.MonoValues
import Control.DeepSeq
import qualified Control.Exception as X
import Control.Monad (unless)
import Data.Function (on)
import Data.List (nubBy)
import Data.Maybe (mapMaybe,fromMaybe)
import Data.Monoid ((<>))
import System.Directory (doesFileExist)
import System.FilePath ( addExtension
, isAbsolute
, joinPath
, (>)
, takeDirectory
, takeFileName
)
import qualified System.IO.Error as IOE
import qualified Data.Map as Map
#if __GLASGOW_HASKELL__ < 710
import Data.Foldable (foldMap)
#endif
-- Renaming --------------------------------------------------------------------
rename :: R.Rename a => R.NamingEnv -> a -> ModuleM a
rename env a = do
renamerWarnings ws
case res of
Right r -> return r
Left errs -> renamerErrors errs
where
(res,ws) = R.runRenamer env (R.rename a)
-- | Rename a module in the context of its imported modules.
renameModule :: P.Module -> ModuleM P.Module
renameModule m = do
iface <- importIfaces (map thing (P.mImports m))
let menv = R.namingEnv m
(es,ws) = R.checkNamingEnv menv
renamerWarnings ws
unless (null es) (renamerErrors es)
-- explicitly shadow the imported environment with the local environment
rename (menv `R.shadowing` R.namingEnv iface) m
-- | Rename an expression in the context of the focused module.
renameExpr :: P.Expr -> ModuleM P.Expr
renameExpr e = do
env <- getFocusedEnv
denv <- getDynEnv
rename (deNames denv `R.shadowing` R.namingEnv env) e
-- | Rename declarations in the context of the focused module.
renameDecls :: (R.Rename d, T.FromDecl d) => [d] -> ModuleM [d]
renameDecls ds = do
env <- getFocusedEnv
denv <- getDynEnv
rename (deNames denv `R.shadowing` R.namingEnv env) ds
-- NoPat -----------------------------------------------------------------------
-- | Run the noPat pass.
noPat :: RemovePatterns a => a -> ModuleM a
noPat a = do
let (a',errs) = removePatterns a
unless (null errs) (noPatErrors errs)
return a'
-- Parsing ---------------------------------------------------------------------
parseModule :: FilePath -> ModuleM P.Module
parseModule path = do
e <- io $ X.try $ do
bytes <- readFile path
return $!! bytes
bytes <- case (e :: Either X.IOException String) of
Right bytes -> return bytes
Left exn | IOE.isDoesNotExistError exn -> cantFindFile path
| otherwise -> otherIOError path exn
let cfg = P.defaultConfig
{ P.cfgSource = path
, P.cfgPreProc = P.guessPreProc path
}
case P.parseModule cfg bytes of
Right pm -> return pm
Left err -> moduleParseError path err
-- Modules ---------------------------------------------------------------------
-- | Load a module by its path.
loadModuleByPath :: FilePath -> ModuleM T.Module
loadModuleByPath path = withPrependedSearchPath [ takeDirectory path ] $ do
let fileName = takeFileName path
-- path' is the resolved, absolute path
path' <- findFile fileName
pm <- parseModule path'
let n = thing (P.mName pm)
-- Check whether this module name has already been loaded from a different file
env <- getModuleEnv
case lookupModule n env of
Nothing -> loadingModule n (loadModule path' pm)
Just lm
| path' == loaded -> return (lmModule lm)
| otherwise -> duplicateModuleName n path' loaded
where loaded = lmFilePath lm
-- | Load the module specified by an import.
loadImport :: Located P.Import -> ModuleM ()
loadImport li = do
let i = thing li
n = P.iModule i
alreadyLoaded <- isLoaded n
unless alreadyLoaded $
do path <- findModule n
pm <- parseModule path
loadingImport li $ do
-- make sure that this module is the one we expect
unless (n == thing (P.mName pm)) (moduleNameMismatch n (mName pm))
_ <- loadModule path pm
return ()
-- | Load dependencies, typecheck, and add to the eval environment.
loadModule :: FilePath -> P.Module -> ModuleM T.Module
loadModule path pm = do
let pm' = addPrelude pm
loadDeps pm'
-- XXX make it possible to configure output
io (putStrLn ("Loading module " ++ pretty (P.thing (P.mName pm'))))
tcm <- checkModule pm'
-- extend the eval env
modifyEvalEnv (E.moduleEnv tcm)
loadedModule path tcm
return tcm
-- | Rewrite an import declaration to be of the form:
--
-- > import foo as foo [ [hiding] (a,b,c) ]
fullyQualified :: P.Import -> P.Import
fullyQualified i = i { iAs = Just (iModule i) }
-- | Process the interface specified by an import.
importIface :: P.Import -> ModuleM Iface
importIface i = interpImport i `fmap` getIface (T.iModule i)
-- | Load a series of interfaces, merging their public interfaces.
importIfaces :: [P.Import] -> ModuleM IfaceDecls
importIfaces is = foldMap ifPublic `fmap` mapM importIface is
moduleFile :: ModName -> String -> FilePath
moduleFile (ModName ns) = addExtension (joinPath ns)
-- | Discover a module.
findModule :: ModName -> ModuleM FilePath
findModule n = do
paths <- getSearchPath
loop (possibleFiles paths)
where
loop paths = case paths of
path:rest -> do
b <- io (doesFileExist path)
if b then return path else loop rest
[] -> handleNotFound
handleNotFound =
case n of
m | m == preludeName -> writePreludeContents
_ -> moduleNotFound n =<< getSearchPath
-- generate all possible search paths
possibleFiles paths = do
path <- paths
ext <- P.knownExts
return (path > moduleFile n ext)
-- | Discover a file. This is distinct from 'findModule' in that we
-- assume we've already been given a particular file name.
findFile :: FilePath -> ModuleM FilePath
findFile path | isAbsolute path = do
-- No search path checking for absolute paths
b <- io (doesFileExist path)
if b then return path else cantFindFile path
findFile path = do
paths <- getSearchPath
loop (possibleFiles paths)
where
loop paths = case paths of
path':rest -> do
b <- io (doesFileExist path')
if b then return path' else loop rest
[] -> cantFindFile path
possibleFiles paths = map (> path) paths
preludeName :: P.ModName
preludeName = P.ModName ["Cryptol"]
-- | Add the prelude to the import list if it's not already mentioned.
addPrelude :: P.Module -> P.Module
addPrelude m
| preludeName == P.thing (P.mName m) = m
| preludeName `elem` importedMods = m
| otherwise = m { mImports = importPrelude : mImports m }
where
importedMods = map (P.iModule . P.thing) (P.mImports m)
importPrelude = P.Located
{ P.srcRange = emptyRange
, P.thing = P.Import
{ iModule = preludeName
, iAs = Nothing
, iSpec = Nothing
}
}
-- | Load the dependencies of a module into the environment.
loadDeps :: Module -> ModuleM ()
loadDeps m
| null needed = return ()
| otherwise = mapM_ load needed
where
needed = nubBy ((==) `on` P.iModule . thing) (P.mImports m)
load mn = loadImport mn
-- Type Checking ---------------------------------------------------------------
-- | Typecheck a single expression.
checkExpr :: P.Expr -> ModuleM (T.Expr,T.Schema)
checkExpr e = do
npe <- noPat e
denv <- getDynEnv
re <- renameExpr npe
env <- getQualifiedEnv
let env' = env <> deIfaceDecls denv
typecheck T.tcExpr re env'
-- | Typecheck a group of declarations.
checkDecls :: (HasLoc d, R.Rename d, T.FromDecl d) => [d] -> ModuleM [T.DeclGroup]
checkDecls ds = do
-- nopat must already be run
rds <- renameDecls ds
denv <- getDynEnv
env <- getQualifiedEnv
let env' = env <> deIfaceDecls denv
typecheck T.tcDecls rds env'
-- | Typecheck a module.
checkModule :: P.Module -> ModuleM T.Module
checkModule m = do
-- remove includes first
e <- io (removeIncludesModule m)
nim <- case e of
Right nim -> return nim
Left ierrs -> noIncludeErrors ierrs
-- remove pattern bindings
npm <- noPat nim
-- rename everything
scm <- renameModule npm
-- typecheck
tcm <- typecheck T.tcModule scm =<< importIfacesTc (map thing (P.mImports scm))
return (Cryptol.Transform.MonoValues.rewModule tcm)
type TCAction i o = i -> T.InferInput -> IO (T.InferOutput o)
typecheck :: HasLoc i => TCAction i o -> i -> IfaceDecls -> ModuleM o
typecheck action i env = do
let range = fromMaybe emptyRange (getLoc i)
input <- genInferInput range env
out <- io (action i input)
case out of
T.InferOK warns seeds o ->
do setNameSeeds seeds
typeCheckWarnings warns
return o
T.InferFailed warns errs ->
do typeCheckWarnings warns
typeCheckingFailed errs
-- | Process a list of imports, producing an aggregate interface suitable for use
-- when typechecking.
importIfacesTc :: [P.Import] -> ModuleM IfaceDecls
importIfacesTc is =
mergePublic `fmap` mapM (importIface . fullyQualified) is
where
mergePublic = foldMap ifPublic
-- | Generate input for the typechecker.
genInferInput :: Range -> IfaceDecls -> ModuleM T.InferInput
genInferInput r env = do
seeds <- getNameSeeds
monoBinds <- getMonoBinds
-- TODO: include the environment needed by the module
return T.InferInput
{ T.inpRange = r
, T.inpVars = Map.map ifDeclSig (filterEnv ifDecls)
, T.inpTSyns = filterEnv ifTySyns
, T.inpNewtypes = filterEnv ifNewtypes
, T.inpNameSeeds = seeds
, T.inpMonoBinds = monoBinds
}
where
-- at this point, the names used in the aggregate interface should be
-- unique
keepOne :: (QName,[a]) -> Maybe (QName,a)
keepOne (qn,syns) = case syns of
[syn] -> Just (qn,syn)
_ -> Nothing
-- keep symbols without duplicates. the renamer would have caught
-- duplication already, so this is safe.
filterEnv p = Map.fromList (mapMaybe keepOne (Map.toList (p env)))
-- Evaluation ------------------------------------------------------------------
evalExpr :: T.Expr -> ModuleM E.Value
evalExpr e = do
env <- getEvalEnv
denv <- getDynEnv
return (E.evalExpr (env <> deEnv denv) e)
evalDecls :: [T.DeclGroup] -> ModuleM ()
evalDecls dgs = do
env <- getEvalEnv
denv <- getDynEnv
let env' = env <> deEnv denv
denv' = denv { deDecls = deDecls denv ++ dgs
, deEnv = E.evalDecls dgs env'
}
setDynEnv denv'
cryptol-2.2.6/src/Cryptol/ModuleSystem/Env.hs 0000644 0000000 0000000 00000016174 12637103426 017361 0 ustar 00 0000000 0000000 -- |
-- Module : $Header$
-- Copyright : (c) 2013-2015 Galois, Inc.
-- License : BSD3
-- Maintainer : cryptol@galois.com
-- Stability : provisional
-- Portability : portable
{-# LANGUAGE CPP #-}
{-# LANGUAGE PatternGuards #-}
module Cryptol.ModuleSystem.Env where
#ifndef RELOCATABLE
import Paths_cryptol (getDataDir)
#endif
import Cryptol.Eval (EvalEnv)
import Cryptol.ModuleSystem.Interface
import qualified Cryptol.ModuleSystem.NamingEnv as R
import Cryptol.Parser.AST
import qualified Cryptol.TypeCheck as T
import qualified Cryptol.TypeCheck.AST as T
import Control.Monad (guard)
import Data.Foldable (fold)
import Data.Function (on)
import qualified Data.Map as Map
import Data.Monoid ((<>))
import System.Directory (getAppUserDataDirectory, getCurrentDirectory)
import System.Environment(getExecutablePath)
import System.FilePath ((>), normalise, joinPath, splitPath, takeDirectory)
import qualified Data.List as List
#if __GLASGOW_HASKELL__ < 710
import Data.Monoid (Monoid(..))
#endif
-- Module Environment ----------------------------------------------------------
data ModuleEnv = ModuleEnv
{ meLoadedModules :: LoadedModules
, meNameSeeds :: T.NameSeeds
, meEvalEnv :: EvalEnv
, meFocusedModule :: Maybe ModName
, meSearchPath :: [FilePath]
, meDynEnv :: DynamicEnv
, meMonoBinds :: !Bool
}
resetModuleEnv :: ModuleEnv -> ModuleEnv
resetModuleEnv env = env
{ meLoadedModules = mempty
, meNameSeeds = T.nameSeeds
, meEvalEnv = mempty
, meFocusedModule = Nothing
, meDynEnv = mempty
}
initialModuleEnv :: IO ModuleEnv
initialModuleEnv = do
curDir <- getCurrentDirectory
#ifndef RELOCATABLE
dataDir <- getDataDir
#endif
binDir <- takeDirectory `fmap` getExecutablePath
let instDir = normalise . joinPath . init . splitPath $ binDir
userDir <- getAppUserDataDirectory "cryptol"
return ModuleEnv
{ meLoadedModules = mempty
, meNameSeeds = T.nameSeeds
, meEvalEnv = mempty
, meFocusedModule = Nothing
-- we search these in order, taking the first match
, meSearchPath = [ curDir
-- something like $HOME/.cryptol
, userDir
#if defined(mingw32_HOST_OS) || defined(__MINGW32__)
-- ../cryptol on win32
, instDir > "cryptol"
#else
-- ../share/cryptol on others
, instDir > "share" > "cryptol"
#endif
#ifndef RELOCATABLE
-- Cabal-defined data directory. Since this
-- is usually a global location like
-- /usr/local, search this one last in case
-- someone has multiple Cryptols
, dataDir
#endif
]
, meDynEnv = mempty
, meMonoBinds = True
}
-- | Try to focus a loaded module in the module environment.
focusModule :: ModName -> ModuleEnv -> Maybe ModuleEnv
focusModule n me = do
guard (isLoaded n (meLoadedModules me))
return me { meFocusedModule = Just n }
-- | Get a list of all the loaded modules. Each module in the
-- resulting list depends only on other modules that precede it.
loadedModules :: ModuleEnv -> [T.Module]
loadedModules = map lmModule . getLoadedModules . meLoadedModules
-- | Produce an ifaceDecls that represents the focused environment of the module
-- system.
--
-- This could really do with some better error handling, just returning mempty
-- when one of the imports fails isn't really desirable.
focusedEnv :: ModuleEnv -> IfaceDecls
focusedEnv me = fold $ do
(iface,imports) <- loadModuleEnv interpImport me
let local = unqualified (ifPublic iface `mappend` ifPrivate iface)
return (local `shadowing` imports)
-- | Produce an ifaceDecls that represents the internal environment of the
-- module, used for typechecking.
qualifiedEnv :: ModuleEnv -> IfaceDecls
qualifiedEnv me = fold $ do
(iface,imports) <- loadModuleEnv (\ _ iface -> iface) me
return (mconcat [ ifPublic iface, ifPrivate iface, imports ])
loadModuleEnv :: (Import -> Iface -> Iface) -> ModuleEnv
-> Maybe (Iface,IfaceDecls)
loadModuleEnv processIface me = do
fm <- meFocusedModule me
lm <- lookupModule fm me
imports <- mapM loadImport (T.mImports (lmModule lm))
return (lmInterface lm, mconcat imports)
where
loadImport i = do
lm <- lookupModule (iModule i) me
return (ifPublic (processIface i (lmInterface lm)))
-- Loaded Modules --------------------------------------------------------------
newtype LoadedModules = LoadedModules
{ getLoadedModules :: [LoadedModule]
} deriving (Show)
-- ^ Invariant: All the dependencies of any module `m` must precede `m` in the list.
instance Monoid LoadedModules where
mempty = LoadedModules []
mappend l r = LoadedModules
$ List.unionBy ((==) `on` lmName) (getLoadedModules l) (getLoadedModules r)
data LoadedModule = LoadedModule
{ lmName :: ModName
, lmFilePath :: FilePath
, lmInterface :: Iface
, lmModule :: T.Module
} deriving (Show)
isLoaded :: ModName -> LoadedModules -> Bool
isLoaded mn lm = any ((mn ==) . lmName) (getLoadedModules lm)
lookupModule :: ModName -> ModuleEnv -> Maybe LoadedModule
lookupModule mn env = List.find ((mn ==) . lmName) (getLoadedModules (meLoadedModules env))
addLoadedModule :: FilePath -> T.Module -> LoadedModules -> LoadedModules
addLoadedModule path tm lm
| isLoaded (T.mName tm) lm = lm
| otherwise = LoadedModules (getLoadedModules lm ++ [loaded])
where
loaded = LoadedModule
{ lmName = T.mName tm
, lmFilePath = path
, lmInterface = genIface tm
, lmModule = tm
}
removeLoadedModule :: FilePath -> LoadedModules -> LoadedModules
removeLoadedModule path (LoadedModules ms) = LoadedModules (remove ms)
where
remove (lm:rest)
| lmFilePath lm == path = rest
| otherwise = lm : remove rest
remove [] = []
-- Dynamic Environments --------------------------------------------------------
-- | Extra information we need to carry around to dynamically extend
-- an environment outside the context of a single module. Particularly
-- useful when dealing with interactive declarations as in @:let@ or
-- @it@.
data DynamicEnv = DEnv
{ deNames :: R.NamingEnv
, deDecls :: [T.DeclGroup]
, deEnv :: EvalEnv
}
instance Monoid DynamicEnv where
mempty = DEnv
{ deNames = mempty
, deDecls = mempty
, deEnv = mempty
}
mappend de1 de2 = DEnv
{ deNames = deNames de1 <> deNames de2
, deDecls = deDecls de1 <> deDecls de2
, deEnv = deEnv de1 <> deEnv de2
}
-- | Build 'IfaceDecls' that correspond to all of the bindings in the
-- dynamic environment.
--
-- XXX: if we ever add type synonyms or newtypes at the REPL, revisit
-- this.
deIfaceDecls :: DynamicEnv -> IfaceDecls
deIfaceDecls DEnv { deDecls = dgs } =
mconcat [ IfaceDecls
{ ifTySyns = Map.empty
, ifNewtypes = Map.empty
, ifDecls = Map.singleton (ifDeclName ifd) [ifd]
}
| decl <- concatMap T.groupDecls dgs
, let ifd = mkIfaceDecl decl
]
cryptol-2.2.6/src/Cryptol/ModuleSystem/Interface.hs 0000644 0000000 0000000 00000012061 12637103426 020520 0 ustar 00 0000000 0000000 -- |
-- Module : $Header$
-- Copyright : (c) 2013-2015 Galois, Inc.
-- License : BSD3
-- Maintainer : cryptol@galois.com
-- Stability : provisional
-- Portability : portable
{-# LANGUAGE PatternGuards #-}
module Cryptol.ModuleSystem.Interface (
Iface(..)
, IfaceDecls(..)
, IfaceTySyn, ifTySynName
, IfaceNewtype
, IfaceDecl(..), mkIfaceDecl
, shadowing
, interpImport
, unqualified
, genIface
) where
import Cryptol.Parser.AST (mkQual)
import Cryptol.TypeCheck.AST
import qualified Data.Map as Map
#if __GLASGOW_HASKELL__ < 710
import Data.Monoid (Monoid(..))
#endif
-- | The resulting interface generated by a module that has been typechecked.
data Iface = Iface
{ ifModName :: ModName
, ifPublic :: IfaceDecls
, ifPrivate :: IfaceDecls
} deriving (Show)
data IfaceDecls = IfaceDecls
{ ifTySyns :: Map.Map QName [IfaceTySyn]
, ifNewtypes :: Map.Map QName [IfaceNewtype]
, ifDecls :: Map.Map QName [IfaceDecl]
} deriving (Show)
instance Monoid IfaceDecls where
mempty = IfaceDecls Map.empty Map.empty Map.empty
mappend l r = IfaceDecls
{ ifTySyns = Map.unionWith (mergeByName ifTySynName) (ifTySyns l) (ifTySyns r)
, ifNewtypes = Map.unionWith (mergeByName ntName) (ifNewtypes l) (ifNewtypes r)
, ifDecls = Map.unionWith (mergeByName ifDeclName) (ifDecls l) (ifDecls r)
}
mconcat ds = IfaceDecls
{ ifTySyns = Map.unionsWith (mergeByName ifTySynName) (map ifTySyns ds)
, ifNewtypes = Map.unionsWith (mergeByName ntName) (map ifNewtypes ds)
, ifDecls = Map.unionsWith (mergeByName ifDeclName) (map ifDecls ds)
}
-- | Merge the entries in the simple case.
mergeByName :: (a -> QName) -> [a] -> [a] -> [a]
mergeByName f ls rs
| [l] <- ls, [r] <- rs, f l == f r = ls
| otherwise = ls ++ rs
-- | Like mappend for IfaceDecls, but preferring entries on the left.
shadowing :: IfaceDecls -> IfaceDecls -> IfaceDecls
shadowing l r = IfaceDecls
{ ifTySyns = Map.union (ifTySyns l) (ifTySyns r)
, ifNewtypes = Map.union (ifNewtypes l) (ifNewtypes r)
, ifDecls = Map.union (ifDecls l) (ifDecls r)
}
type IfaceTySyn = TySyn
ifTySynName :: TySyn -> QName
ifTySynName = tsName
type IfaceNewtype = Newtype
data IfaceDecl = IfaceDecl
{ ifDeclName :: QName
, ifDeclSig :: Schema
, ifDeclPragmas :: [Pragma]
} deriving (Show)
mkIfaceDecl :: Decl -> IfaceDecl
mkIfaceDecl d = IfaceDecl
{ ifDeclName = dName d
, ifDeclSig = dSignature d
, ifDeclPragmas = dPragmas d
}
mapIfaceDecls :: (QName -> QName) -> IfaceDecls -> IfaceDecls
mapIfaceDecls f decls = IfaceDecls
{ ifTySyns = Map.mapKeys f (ifTySyns decls)
, ifNewtypes = Map.mapKeys f (ifNewtypes decls)
, ifDecls = Map.mapKeys f (ifDecls decls)
}
filterIfaceDecls :: (QName -> Bool) -> IfaceDecls -> IfaceDecls
filterIfaceDecls p decls = IfaceDecls
{ ifTySyns = Map.filterWithKey check (ifTySyns decls)
, ifNewtypes = Map.filterWithKey check (ifNewtypes decls)
, ifDecls = Map.filterWithKey check (ifDecls decls)
}
where
check :: QName -> a -> Bool
check k _ = p k
unqualified :: IfaceDecls -> IfaceDecls
unqualified = mapIfaceDecls (mkUnqual . unqual)
-- | Generate an Iface from a typechecked module.
genIface :: Module -> Iface
genIface m = Iface
{ ifModName = mName m
, ifPublic = IfaceDecls
{ ifTySyns = tsPub
, ifNewtypes = ntPub
, ifDecls = dPub
}
, ifPrivate = IfaceDecls
{ ifTySyns = tsPriv
, ifNewtypes = ntPriv
, ifDecls = dPriv
}
}
where
(tsPub,tsPriv) =
Map.partitionWithKey (\ qn _ -> qn `isExportedType` mExports m )
$ fmap return (mTySyns m)
(ntPub,ntPriv) =
Map.partitionWithKey (\ qn _ -> qn `isExportedType` mExports m )
$ fmap return (mNewtypes m)
(dPub,dPriv) =
Map.partitionWithKey (\ qn _ -> qn `isExportedBind` mExports m)
$ Map.fromList [ (qn,[mkIfaceDecl d]) | dg <- mDecls m
, d <- groupDecls dg
, let qn = dName d
]
-- | Interpret an import declaration in the scope of the interface it targets.
interpImport :: Import -> Iface -> Iface
interpImport i iface = Iface
{ ifModName = ifModName iface
, ifPublic = qualify restricted
, ifPrivate = mempty
}
where
-- the initial set of names is {unqualified => qualified}
public = unqualified (ifPublic iface)
-- qualify imported names
qualify | Just n <- iAs i = \ names -> qualifyNames n names
| otherwise = id
-- interpret an import spec to quotient a naming map
restricted
| Just (Hiding names) <- iSpec i =
let qnames = map mkUnqual names
in filterIfaceDecls (\qn -> not (qn `elem` qnames)) public
| Just (Only names) <- iSpec i =
let qnames = map mkUnqual names
in filterIfaceDecls (\qn -> qn `elem` qnames) public
| otherwise = public
-- this assumes that it's getting a list of _only_ unqualified names
qualifyNames pfx = mapIfaceDecls (\ n -> mkQual pfx (unqual n))
cryptol-2.2.6/src/Cryptol/ModuleSystem/Monad.hs 0000644 0000000 0000000 00000027165 12637103426 017671 0 ustar 00 0000000 0000000 -- |
-- Module : $Header$
-- Copyright : (c) 2013-2015 Galois, Inc.
-- License : BSD3
-- Maintainer : cryptol@galois.com
-- Stability : provisional
-- Portability : portable
{-# LANGUAGE FlexibleContexts #-}
module Cryptol.ModuleSystem.Monad where
import Cryptol.Eval.Env (EvalEnv)
import Cryptol.ModuleSystem.Env
import Cryptol.ModuleSystem.Interface
import Cryptol.ModuleSystem.Renamer (RenamerError(),RenamerWarning())
import qualified Cryptol.Parser as Parser
import qualified Cryptol.Parser.AST as P
import Cryptol.Parser.Position (Located)
import Cryptol.Utils.Panic (panic)
import qualified Cryptol.Parser.NoPat as NoPat
import qualified Cryptol.Parser.NoInclude as NoInc
import qualified Cryptol.TypeCheck as T
import qualified Cryptol.TypeCheck.AST as T
import Cryptol.Parser.Position (Range)
import Cryptol.Utils.PP
import Control.Exception (IOException)
import Data.Function (on)
import Data.Maybe (isJust)
import MonadLib
#if __GLASGOW_HASKELL__ < 710
import Control.Applicative (Applicative(..))
#endif
-- Errors ----------------------------------------------------------------------
data ImportSource
= FromModule P.ModName
| FromImport (Located P.Import)
deriving (Show)
instance Eq ImportSource where
(==) = (==) `on` importedModule
instance PP ImportSource where
ppPrec _ is = case is of
FromModule n -> text "module name" <+> pp n
FromImport li -> text "import of module" <+> pp (P.iModule (P.thing li))
importedModule :: ImportSource -> P.ModName
importedModule is = case is of
FromModule n -> n
FromImport li -> P.iModule (P.thing li)
data ModuleError
= ModuleNotFound P.ModName [FilePath]
-- ^ Unable to find the module given, tried looking in these paths
| CantFindFile FilePath
-- ^ Unable to open a file
| OtherIOError FilePath IOException
-- ^ Some other IO error occurred while reading this file
| ModuleParseError FilePath Parser.ParseError
-- ^ Generated this parse error when parsing the file for module m
| RecursiveModules [ImportSource]
-- ^ Recursive module group discovered
| RenamerErrors ImportSource [RenamerError]
-- ^ Problems during the renaming phase
| NoPatErrors ImportSource [NoPat.Error]
-- ^ Problems during the NoPat phase
| NoIncludeErrors ImportSource [NoInc.IncludeError]
-- ^ Problems during the NoInclude phase
| TypeCheckingFailed ImportSource [(Range,T.Error)]
-- ^ Problems during type checking
| OtherFailure String
-- ^ Problems after type checking, eg. specialization
| ModuleNameMismatch P.ModName (Located P.ModName)
-- ^ Module loaded by 'import' statement has the wrong module name
| DuplicateModuleName P.ModName FilePath FilePath
-- ^ Two modules loaded from different files have the same module name
deriving (Show)
instance PP ModuleError where
ppPrec _ e = case e of
ModuleNotFound src path ->
text "[error]" <+>
text "Could not find module" <+> pp src
$$
hang (text "Searched paths:")
4 (vcat (map text path))
$$
text "Set the CRYPTOLPATH environment variable to search more directories"
CantFindFile path ->
text "[error]" <+>
text "can't find file:" <+> text path
OtherIOError path exn ->
hang (text "[error]" <+>
text "IO error while loading file:" <+> text path <> colon)
4 (text (show exn))
ModuleParseError _source err -> Parser.ppError err
RecursiveModules mods ->
hang (text "[error] module imports form a cycle:")
4 (vcat (map pp (reverse mods)))
RenamerErrors _src errs -> vcat (map pp errs)
NoPatErrors _src errs -> vcat (map pp errs)
NoIncludeErrors _src errs -> vcat (map NoInc.ppIncludeError errs)
TypeCheckingFailed _src errs -> vcat (map T.ppError errs)
ModuleNameMismatch expected found ->
hang (text "[error]" <+> pp (P.srcRange found) <> char ':')
4 (vcat [ text "File name does not match module name:"
, text "Saw:" <+> pp (P.thing found)
, text "Expected:" <+> pp expected
])
DuplicateModuleName name path1 path2 ->
hang (text "[error] module" <+> pp name <+>
text "is defined in multiple files:")
4 (vcat [text path1, text path2])
OtherFailure x -> text x
moduleNotFound :: P.ModName -> [FilePath] -> ModuleM a
moduleNotFound name paths = ModuleT (raise (ModuleNotFound name paths))
cantFindFile :: FilePath -> ModuleM a
cantFindFile path = ModuleT (raise (CantFindFile path))
otherIOError :: FilePath -> IOException -> ModuleM a
otherIOError path exn = ModuleT (raise (OtherIOError path exn))
moduleParseError :: FilePath -> Parser.ParseError -> ModuleM a
moduleParseError path err =
ModuleT (raise (ModuleParseError path err))
recursiveModules :: [ImportSource] -> ModuleM a
recursiveModules loaded = ModuleT (raise (RecursiveModules loaded))
renamerErrors :: [RenamerError] -> ModuleM a
renamerErrors errs = do
src <- getImportSource
ModuleT (raise (RenamerErrors src errs))
noPatErrors :: [NoPat.Error] -> ModuleM a
noPatErrors errs = do
src <- getImportSource
ModuleT (raise (NoPatErrors src errs))
noIncludeErrors :: [NoInc.IncludeError] -> ModuleM a
noIncludeErrors errs = do
src <- getImportSource
ModuleT (raise (NoIncludeErrors src errs))
typeCheckingFailed :: [(Range,T.Error)] -> ModuleM a
typeCheckingFailed errs = do
src <- getImportSource
ModuleT (raise (TypeCheckingFailed src errs))
moduleNameMismatch :: P.ModName -> Located P.ModName -> ModuleM a
moduleNameMismatch expected found =
ModuleT (raise (ModuleNameMismatch expected found))
duplicateModuleName :: P.ModName -> FilePath -> FilePath -> ModuleM a
duplicateModuleName name path1 path2 =
ModuleT (raise (DuplicateModuleName name path1 path2))
-- Warnings --------------------------------------------------------------------
data ModuleWarning
= TypeCheckWarnings [(Range,T.Warning)]
| RenamerWarnings [RenamerWarning]
deriving (Show)
instance PP ModuleWarning where
ppPrec _ w = case w of
TypeCheckWarnings ws -> vcat (map T.ppWarning ws)
RenamerWarnings ws -> vcat (map pp ws)
warn :: [ModuleWarning] -> ModuleM ()
warn = ModuleT . put
typeCheckWarnings :: [(Range,T.Warning)] -> ModuleM ()
typeCheckWarnings ws
| null ws = return ()
| otherwise = warn [TypeCheckWarnings ws]
renamerWarnings :: [RenamerWarning] -> ModuleM ()
renamerWarnings ws
| null ws = return ()
| otherwise = warn [RenamerWarnings ws]
-- Module System Monad ---------------------------------------------------------
data RO = RO
{ roLoading :: [ImportSource]
}
emptyRO :: RO
emptyRO = RO { roLoading = [] }
newtype ModuleT m a = ModuleT
{ unModuleT :: ReaderT RO (StateT ModuleEnv
(ExceptionT ModuleError (WriterT [ModuleWarning] m))) a
}
instance Monad m => Functor (ModuleT m) where
{-# INLINE fmap #-}
fmap f m = ModuleT (fmap f (unModuleT m))
instance Monad m => Applicative (ModuleT m) where
{-# INLINE pure #-}
pure x = ModuleT (pure x)
{-# INLINE (<*>) #-}
l <*> r = ModuleT (unModuleT l <*> unModuleT r)
instance Monad m => Monad (ModuleT m) where
{-# INLINE return #-}
return x = ModuleT (return x)
{-# INLINE (>>=) #-}
m >>= f = ModuleT (unModuleT m >>= unModuleT . f)
{-# INLINE fail #-}
fail = ModuleT . raise . OtherFailure
instance MonadT ModuleT where
{-# INLINE lift #-}
lift = ModuleT . lift . lift . lift . lift
runModuleT :: Monad m
=> ModuleEnv
-> ModuleT m a
-> m (Either ModuleError (a, ModuleEnv), [ModuleWarning])
runModuleT env m =
runWriterT
$ runExceptionT
$ runStateT env
$ runReaderT emptyRO
$ unModuleT m
-- runM (unModuleT m) emptyRO env
type ModuleM = ModuleT IO
runModuleM :: ModuleEnv -> ModuleM a
-> IO (Either ModuleError (a,ModuleEnv),[ModuleWarning])
runModuleM = runModuleT
io :: BaseM m IO => IO a -> ModuleT m a
io m = ModuleT (inBase m)
getModuleEnv :: Monad m => ModuleT m ModuleEnv
getModuleEnv = ModuleT get
setModuleEnv :: Monad m => ModuleEnv -> ModuleT m ()
setModuleEnv = ModuleT . set
modifyModuleEnv :: Monad m => (ModuleEnv -> ModuleEnv) -> ModuleT m ()
modifyModuleEnv f = ModuleT $ do
env <- get
set $! f env
isLoaded :: P.ModName -> ModuleM Bool
isLoaded mn = ModuleT $ do
env <- get
return (isJust (lookupModule mn env))
loadingImport :: Located P.Import -> ModuleM a -> ModuleM a
loadingImport = loading . FromImport
loadingModule :: P.ModName -> ModuleM a -> ModuleM a
loadingModule = loading . FromModule
-- | Push an "interactive" context onto the loading stack. A bit of a hack, as
-- it uses a faked module name
interactive :: ModuleM a -> ModuleM a
interactive = loadingModule (P.ModName [""])
loading :: ImportSource -> ModuleM a -> ModuleM a
loading src m = ModuleT $ do
ro <- ask
let ro' = ro { roLoading = src : roLoading ro }
-- check for recursive modules
when (src `elem` roLoading ro) (raise (RecursiveModules (roLoading ro')))
local ro' (unModuleT m)
-- | Get the currently focused import source.
getImportSource :: ModuleM ImportSource
getImportSource = ModuleT $ do
ro <- ask
case roLoading ro of
is : _ -> return is
_ -> panic "ModuleSystem: getImportSource" ["Import stack is empty"]
getIface :: P.ModName -> ModuleM Iface
getIface mn = ModuleT $ do
env <- get
case lookupModule mn env of
Just lm -> return (lmInterface lm)
Nothing -> panic "ModuleSystem" ["Interface not available "]
getNameSeeds :: ModuleM T.NameSeeds
getNameSeeds = ModuleT (meNameSeeds `fmap` get)
getMonoBinds :: ModuleM Bool
getMonoBinds = ModuleT (meMonoBinds `fmap` get)
setMonoBinds :: Bool -> ModuleM ()
setMonoBinds b = ModuleT $ do
env <- get
set $! env { meMonoBinds = b }
setNameSeeds :: T.NameSeeds -> ModuleM ()
setNameSeeds seeds = ModuleT $ do
env <- get
set $! env { meNameSeeds = seeds }
-- | Remove a module from the set of loaded module, by its path.
unloadModule :: FilePath -> ModuleM ()
unloadModule path = ModuleT $ do
env <- get
set $! env { meLoadedModules = removeLoadedModule path (meLoadedModules env) }
loadedModule :: FilePath -> T.Module -> ModuleM ()
loadedModule path m = ModuleT $ do
env <- get
set $! env { meLoadedModules = addLoadedModule path m (meLoadedModules env) }
modifyEvalEnv :: (EvalEnv -> EvalEnv) -> ModuleM ()
modifyEvalEnv f = ModuleT $ do
env <- get
set $! env { meEvalEnv = f (meEvalEnv env) }
getEvalEnv :: ModuleM EvalEnv
getEvalEnv = ModuleT (meEvalEnv `fmap` get)
getFocusedModule :: ModuleM (Maybe P.ModName)
getFocusedModule = ModuleT (meFocusedModule `fmap` get)
setFocusedModule :: P.ModName -> ModuleM ()
setFocusedModule n = ModuleT $ do
me <- get
set $! me { meFocusedModule = Just n }
getSearchPath :: ModuleM [FilePath]
getSearchPath = ModuleT (meSearchPath `fmap` get)
-- | Run a 'ModuleM' action in a context with a prepended search
-- path. Useful for temporarily looking in other places while
-- resolving imports, for example.
withPrependedSearchPath :: [FilePath] -> ModuleM a -> ModuleM a
withPrependedSearchPath fps m = ModuleT $ do
env0 <- get
let fps0 = meSearchPath env0
set $! env0 { meSearchPath = fps ++ fps0 }
x <- unModuleT m
env <- get
set $! env { meSearchPath = fps0 }
return x
-- XXX improve error handling here
getFocusedEnv :: ModuleM IfaceDecls
getFocusedEnv = ModuleT (focusedEnv `fmap` get)
getQualifiedEnv :: ModuleM IfaceDecls
getQualifiedEnv = ModuleT (qualifiedEnv `fmap` get)
getDynEnv :: ModuleM DynamicEnv
getDynEnv = ModuleT (meDynEnv `fmap` get)
setDynEnv :: DynamicEnv -> ModuleM ()
setDynEnv denv = ModuleT $ do
me <- get
set $! me { meDynEnv = denv }
cryptol-2.2.6/src/Cryptol/ModuleSystem/NamingEnv.hs 0000644 0000000 0000000 00000017573 12637103426 020517 0 ustar 00 0000000 0000000 -- |
-- Module : $Header$
-- Copyright : (c) 2013-2015 Galois, Inc.
-- License : BSD3
-- Maintainer : cryptol@galois.com
-- Stability : provisional
-- Portability : portable
module Cryptol.ModuleSystem.NamingEnv where
import Cryptol.ModuleSystem.Interface
import Cryptol.Parser.AST
import Cryptol.Parser.Names (namesP)
import Cryptol.Parser.Position
import qualified Cryptol.TypeCheck.AST as T
import Cryptol.Utils.PP
import Cryptol.Utils.Panic (panic)
import qualified Data.Map as Map
#if __GLASGOW_HASKELL__ < 710
import Control.Applicative (Applicative, (<$>), (<*>))
import Data.Monoid (Monoid(..))
import Data.Foldable (foldMap)
import Data.Traversable (traverse)
#endif
-- Name Locations --------------------------------------------------------------
data NameOrigin = Local (Located QName)
| Imported QName
deriving (Show)
instance PP NameOrigin where
ppPrec _ o = case o of
Local lqn -> pp lqn
Imported (QName m n) -> pp n <+> trailer
where
trailer = case m of
Just mn -> text "from module" <+> pp mn
_ -> empty
-- Names -----------------------------------------------------------------------
data EName = EFromBind (Located QName)
| EFromNewtype (Located QName)
| EFromMod QName
deriving (Show)
data TName = TFromParam QName
| TFromSyn (Located QName)
| TFromNewtype (Located QName)
| TFromMod QName
deriving (Show)
class HasQName a where
qname :: a -> QName
origin :: a -> NameOrigin
instance HasQName TName where
qname tn = case tn of
TFromParam qn -> qn
TFromSyn lqn -> thing lqn
TFromNewtype lqn -> thing lqn
TFromMod qn -> qn
origin tn = case tn of
TFromParam qn -> Local Located { srcRange = emptyRange, thing = qn }
TFromSyn lqn -> Local lqn
TFromNewtype lqn -> Local lqn
TFromMod qn -> Imported qn
instance HasQName EName where
qname en = case en of
EFromBind lqn -> thing lqn
EFromNewtype lqn -> thing lqn
EFromMod qn -> qn
origin en = case en of
EFromBind lqn -> Local lqn
EFromNewtype lqn -> Local lqn
EFromMod qn -> Imported qn
-- Naming Environment ----------------------------------------------------------
data NamingEnv = NamingEnv { neExprs :: Map.Map QName [EName]
-- ^ Expr renaming environment
, neTypes :: Map.Map QName [TName]
-- ^ Type renaming environment
} deriving (Show)
instance Monoid NamingEnv where
mempty =
NamingEnv { neExprs = Map.empty
, neTypes = Map.empty }
mappend l r =
NamingEnv { neExprs = Map.unionWith (++) (neExprs l) (neExprs r)
, neTypes = Map.unionWith (++) (neTypes l) (neTypes r) }
mconcat envs =
NamingEnv { neExprs = Map.unionsWith (++) (map neExprs envs)
, neTypes = Map.unionsWith (++) (map neTypes envs) }
-- | Singleton type renaming environment.
singletonT :: QName -> TName -> NamingEnv
singletonT qn tn = mempty { neTypes = Map.singleton qn [tn] }
-- | Singleton expression renaming environment.
singletonE :: QName -> EName -> NamingEnv
singletonE qn en = mempty { neExprs = Map.singleton qn [en] }
-- | Like mappend, but when merging, prefer values on the lhs.
shadowing :: NamingEnv -> NamingEnv -> NamingEnv
shadowing l r = NamingEnv
{ neExprs = Map.union (neExprs l) (neExprs r)
, neTypes = Map.union (neTypes l) (neTypes r) }
travNamingEnv :: Applicative f => (QName -> f QName) -> NamingEnv -> f NamingEnv
travNamingEnv f ne = NamingEnv <$> neExprs' <*> neTypes'
where
neExprs' = traverse (traverse travE) (neExprs ne)
neTypes' = traverse (traverse travT) (neTypes ne)
travE en = case en of
EFromBind lqn -> EFromBind <$> travLoc lqn
EFromNewtype lqn -> EFromNewtype <$> travLoc lqn
EFromMod qn -> EFromMod <$> f qn
travT tn = case tn of
TFromParam qn -> TFromParam <$> f qn
TFromSyn lqn -> TFromSyn <$> travLoc lqn
TFromNewtype lqn -> TFromNewtype <$> travLoc lqn
TFromMod qn -> TFromMod <$> f qn
travLoc loc = Located (srcRange loc) <$> f (thing loc)
-- | Things that define exported names.
class BindsNames a where
namingEnv :: a -> NamingEnv
instance BindsNames NamingEnv where
namingEnv = id
instance BindsNames a => BindsNames (Maybe a) where
namingEnv = foldMap namingEnv
instance BindsNames a => BindsNames [a] where
namingEnv = foldMap namingEnv
-- | Generate a type renaming environment from the parameters that are bound by
-- this schema.
instance BindsNames Schema where
namingEnv (Forall ps _ _ _) = foldMap namingEnv ps
-- | Produce a naming environment from an interface file, that contains a
-- mapping only from unqualified names to qualified ones.
instance BindsNames Iface where
namingEnv = namingEnv . ifPublic
-- | Translate a set of declarations from an interface into a naming
-- environment.
instance BindsNames IfaceDecls where
namingEnv binds = mconcat [ types, newtypes, vars ]
where
types = mempty
{ neTypes = Map.map (map (TFromMod . ifTySynName)) (ifTySyns binds)
}
newtypes = mempty
{ neTypes = Map.map (map (TFromMod . T.ntName)) (ifNewtypes binds)
, neExprs = Map.map (map (EFromMod . T.ntName)) (ifNewtypes binds)
}
vars = mempty
{ neExprs = Map.map (map (EFromMod . ifDeclName)) (ifDecls binds)
}
-- | Translate names bound by the patterns of a match into a renaming
-- environment.
instance BindsNames Match where
namingEnv m = case m of
Match p _ -> namingEnv p
MatchLet b -> namingEnv b
instance BindsNames Bind where
namingEnv b = singletonE (thing qn) (EFromBind qn)
where
qn = bName b
-- | Generate the naming environment for a type parameter.
instance BindsNames TParam where
namingEnv p = singletonT qn (TFromParam qn)
where
qn = mkUnqual (tpName p)
-- | Generate an expression renaming environment from a pattern. This ignores
-- type parameters that can be bound by the pattern.
instance BindsNames Pattern where
namingEnv p = foldMap unqualBind (namesP p)
where
unqualBind qn = singletonE (thing qn) (EFromBind qn)
-- | The naming environment for a single module. This is the mapping from
-- unqualified internal names to fully qualified names.
instance BindsNames Module where
namingEnv m = foldMap topDeclEnv (mDecls m)
where
topDeclEnv td = case td of
Decl d -> declEnv (tlValue d)
TDNewtype n -> newtypeEnv (tlValue n)
Include _ -> mempty
qual = fmap (\qn -> mkQual (thing (mName m)) (unqual qn))
qualBind ln = singletonE (thing ln) (EFromBind (qual ln))
qualType ln = singletonT (thing ln) (TFromSyn (qual ln))
declEnv d = case d of
DSignature ns _sig -> foldMap qualBind ns
DPragma ns _p -> foldMap qualBind ns
DBind b -> qualBind (bName b)
DPatBind _pat _e -> panic "ModuleSystem" ["Unexpected pattern binding"]
DType (TySyn lqn _ _) -> qualType lqn
DLocated d' _ -> declEnv d'
newtypeEnv n = singletonT (thing qn) (TFromNewtype (qual qn))
`mappend` singletonE (thing qn) (EFromNewtype (qual qn))
where
qn = nName n
-- | The naming environment for a single declaration, unqualified. This is
-- meanat to be used for things like where clauses.
instance BindsNames Decl where
namingEnv d = case d of
DSignature ns _sig -> foldMap qualBind ns
DPragma ns _p -> foldMap qualBind ns
DBind b -> qualBind (bName b)
DPatBind _pat _e -> panic "ModuleSystem" ["Unexpected pattern binding"]
DType (TySyn lqn _ _) -> qualType lqn
DLocated d' _ -> namingEnv d'
where
qualBind ln = singletonE (thing ln) (EFromBind ln)
qualType ln = singletonT (thing ln) (TFromSyn ln)
cryptol-2.2.6/src/Cryptol/ModuleSystem/Renamer.hs 0000644 0000000 0000000 00000035762 12637103426 020226 0 ustar 00 0000000 0000000 -- |
-- Module : $Header$
-- Copyright : (c) 2013-2015 Galois, Inc.
-- License : BSD3
-- Maintainer : cryptol@galois.com
-- Stability : provisional
-- Portability : portable
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE FlexibleInstances #-}
module Cryptol.ModuleSystem.Renamer (
NamingEnv(), shadowing
, BindsNames(..)
, checkNamingEnv
, Rename(..), runRenamer
, RenamerError(..)
, RenamerWarning(..)
) where
import Cryptol.ModuleSystem.NamingEnv
import Cryptol.Prims.Syntax
import Cryptol.Parser.AST
import Cryptol.Parser.Names (tnamesP)
import Cryptol.Parser.Position
import Cryptol.Utils.Panic (panic)
import Cryptol.Utils.PP
import MonadLib
import qualified Data.Map as Map
#if __GLASGOW_HASKELL__ < 710
import Control.Applicative(Applicative(..),(<$>))
import Data.Foldable (foldMap)
import Data.Monoid (Monoid(..))
import Data.Traversable (traverse)
#endif
-- Errors ----------------------------------------------------------------------
data RenamerError
= MultipleSyms (Located QName) [NameOrigin]
-- ^ Multiple imported symbols contain this name
| UnboundExpr (Located QName)
-- ^ Expression name is not bound to any definition
| UnboundType (Located QName)
-- ^ Type name is not bound to any definition
| OverlappingSyms [NameOrigin]
-- ^ An environment has produced multiple overlapping symbols
| ExpectedValue (Located QName)
-- ^ When a value is expected from the naming environment, but one or more
-- types exist instead.
| ExpectedType (Located QName)
-- ^ When a type is missing from the naming environment, but one or more
-- values exist with the same name.
deriving (Show)
instance PP RenamerError where
ppPrec _ e = case e of
MultipleSyms lqn qns ->
hang (text "[error] at" <+> pp (srcRange lqn))
4 $ (text "Multiple definitions for symbol:" <+> pp (thing lqn))
$$ vcat (map pp qns)
UnboundExpr lqn ->
hang (text "[error] at" <+> pp (srcRange lqn))
4 (text "Value not in scope:" <+> pp (thing lqn))
UnboundType lqn ->
hang (text "[error] at" <+> pp (srcRange lqn))
4 (text "Type not in scope:" <+> pp (thing lqn))
OverlappingSyms qns ->
hang (text "[error]")
4 $ text "Overlapping symbols defined:"
$$ vcat (map pp qns)
ExpectedValue lqn ->
hang (text "[error] at" <+> pp (srcRange lqn))
4 (fsep [ text "Expected a value named", quotes (pp (thing lqn))
, text "but found a type instead"
, text "Did you mean `(" <> pp (thing lqn) <> text")?" ])
ExpectedType lqn ->
hang (text "[error] at" <+> pp (srcRange lqn))
4 (fsep [ text "Expected a type named", quotes (pp (thing lqn))
, text "but found a value instead" ])
-- Warnings --------------------------------------------------------------------
data RenamerWarning
= SymbolShadowed NameOrigin [NameOrigin]
deriving (Show)
instance PP RenamerWarning where
ppPrec _ (SymbolShadowed new originals) =
hang (text "[warning] at" <+> loc)
4 $ fsep [ text "This binding for" <+> sym
, text "shadows the existing binding" <> plural <+> text "from" ]
$$ vcat (map pp originals)
where
plural | length originals > 1 = char 's'
| otherwise = empty
(loc,sym) = case new of
Local lqn -> (pp (srcRange lqn), pp (thing lqn))
Imported qn -> (empty, pp qn)
-- Renaming Monad --------------------------------------------------------------
data RO = RO
{ roLoc :: Range
, roNames :: NamingEnv
}
data Out = Out
{ oWarnings :: [RenamerWarning]
, oErrors :: [RenamerError]
} deriving (Show)
instance Monoid Out where
mempty = Out [] []
mappend l r = Out (oWarnings l `mappend` oWarnings r)
(oErrors l `mappend` oErrors r)
newtype RenameM a = RenameM
{ unRenameM :: ReaderT RO (WriterT Out Id) a }
instance Functor RenameM where
{-# INLINE fmap #-}
fmap f m = RenameM (fmap f (unRenameM m))
instance Applicative RenameM where
{-# INLINE pure #-}
pure x = RenameM (pure x)
{-# INLINE (<*>) #-}
l <*> r = RenameM (unRenameM l <*> unRenameM r)
instance Monad RenameM where
{-# INLINE return #-}
return x = RenameM (return x)
{-# INLINE (>>=) #-}
m >>= k = RenameM (unRenameM m >>= unRenameM . k)
runRenamer :: NamingEnv -> RenameM a
-> (Either [RenamerError] a,[RenamerWarning])
runRenamer env m = (res,oWarnings out)
where
(a,out) = runM (unRenameM m) RO { roLoc = emptyRange, roNames = env }
res | null (oErrors out) = Right a
| otherwise = Left (oErrors out)
record :: RenamerError -> RenameM ()
record err = records [err]
records :: [RenamerError] -> RenameM ()
records errs = RenameM (put mempty { oErrors = errs })
located :: a -> RenameM (Located a)
located a = RenameM $ do
ro <- ask
return Located { srcRange = roLoc ro, thing = a }
withLoc :: HasLoc loc => loc -> RenameM a -> RenameM a
withLoc loc m = RenameM $ case getLoc loc of
Just range -> do
ro <- ask
local ro { roLoc = range } (unRenameM m)
Nothing -> unRenameM m
-- | Shadow the current naming environment with some more names.
shadowNames :: BindsNames env => env -> RenameM a -> RenameM a
shadowNames names m = RenameM $ do
let env = namingEnv names
ro <- ask
put (checkEnv env (roNames ro))
let ro' = ro { roNames = env `shadowing` roNames ro }
local ro' (unRenameM m)
-- | Generate warnings when the left environment shadows things defined in
-- the right. Additionally, generate errors when two names overlap in the
-- left environment.
checkEnv :: NamingEnv -> NamingEnv -> Out
checkEnv l r = Map.foldlWithKey (step neExprs) mempty (neExprs l)
`mappend` Map.foldlWithKey (step neTypes) mempty (neTypes l)
where
step prj acc k ns = acc `mappend` mempty
{ oWarnings = case Map.lookup k (prj r) of
Nothing -> []
Just os -> [SymbolShadowed (origin (head ns)) (map origin os)]
, oErrors = containsOverlap ns
}
-- | Check the RHS of a single name rewrite for conflicting sources.
containsOverlap :: HasQName a => [a] -> [RenamerError]
containsOverlap [_] = []
containsOverlap [] = panic "Renamer" ["Invalid naming environment"]
containsOverlap ns = [OverlappingSyms (map origin ns)]
-- | Throw errors for any names that overlap in a rewrite environment.
checkNamingEnv :: NamingEnv -> ([RenamerError],[RenamerWarning])
checkNamingEnv env = (out, [])
where
out = Map.foldr check outTys (neExprs env)
outTys = Map.foldr check mempty (neTypes env)
check ns acc = containsOverlap ns ++ acc
-- Renaming --------------------------------------------------------------------
class Rename a where
rename :: a -> RenameM a
instance Rename a => Rename [a] where
rename = traverse rename
instance Rename a => Rename (Maybe a) where
rename = traverse rename
instance Rename a => Rename (Located a) where
rename loc = withLoc loc $ do
a' <- rename (thing loc)
return loc { thing = a' }
instance Rename a => Rename (Named a) where
rename n = do
a' <-rename (value n)
return n { value = a' }
instance Rename Module where
rename m = do
decls' <- rename (mDecls m)
return m { mDecls = decls' }
instance Rename TopDecl where
rename td = case td of
Decl d -> Decl <$> rename d
TDNewtype n -> TDNewtype <$> rename n
Include{} -> return td
instance Rename a => Rename (TopLevel a) where
rename tl = do
a' <- rename (tlValue tl)
return tl { tlValue = a' }
instance Rename Decl where
rename d = case d of
DSignature ns sig -> DSignature ns <$> rename sig
DPragma ns p -> DPragma ns <$> rename p
DBind b -> DBind <$> rename b
DPatBind pat e -> DPatBind pat <$> shadowNames (namingEnv pat) (rename e)
DType syn -> DType <$> rename syn
DLocated d' r -> withLoc r
$ DLocated <$> rename d' <*> pure r
instance Rename Newtype where
rename n = do
name' <- renameLoc renameType (nName n)
body' <- shadowNames (nParams n) (rename (nBody n))
return Newtype { nName = name'
, nParams = nParams n
, nBody = body' }
renameExpr :: QName -> RenameM QName
renameExpr qn = do
ro <- RenameM ask
case Map.lookup qn (neExprs (roNames ro)) of
Just [en] -> return (qname en)
Just [] -> panic "Renamer" ["Invalid expression renaming environment"]
Just syms ->
do n <- located qn
record (MultipleSyms n (map origin syms))
return qn
Nothing ->
do n <- located qn
case Map.lookup qn (neTypes (roNames ro)) of
-- types existed with the name of the value expected
Just _ -> record (ExpectedValue n)
-- the value is just missing
Nothing -> record (UnboundExpr n)
return qn
renameType :: QName -> RenameM QName
renameType qn = do
ro <- RenameM ask
case Map.lookup qn (neTypes (roNames ro)) of
Just [tn] -> return (qname tn)
Just [] -> panic "Renamer" ["Invalid type renaming environment"]
Just syms ->
do n <- located qn
record (MultipleSyms n (map origin syms))
return qn
Nothing ->
do n <- located qn
case Map.lookup qn (neExprs (roNames ro)) of
-- values exist with the same name, so throw a different error
Just _ -> record (ExpectedType n)
-- no terms with the same name, so the type is just unbound
Nothing -> record (UnboundType n)
return qn
-- | Rename a schema, assuming that none of its type variables are already in
-- scope.
instance Rename Schema where
rename s@(Forall ps _ _ _) = shadowNames ps (renameSchema s)
-- | Rename a schema, assuming that the type variables have already been brought
-- into scope.
renameSchema :: Schema -> RenameM Schema
renameSchema (Forall ps p ty loc) = Forall ps <$> rename p <*> rename ty
<*> pure loc
instance Rename Prop where
rename p = case p of
CFin t -> CFin <$> rename t
CEqual l r -> CEqual <$> rename l <*> rename r
CGeq l r -> CGeq <$> rename l <*> rename r
CArith t -> CArith <$> rename t
CCmp t -> CCmp <$> rename t
CLocated p' r -> withLoc r
$ CLocated <$> rename p' <*> pure r
instance Rename Type where
rename t = case t of
TFun a b -> TFun <$> rename a <*> rename b
TSeq n a -> TSeq <$> rename n <*> rename a
TBit -> return t
TNum _ -> return t
TChar _ -> return t
TInf -> return t
TUser (QName Nothing (Name "width")) ps
-> TApp TCWidth <$> rename ps
TUser qn ps -> TUser <$> renameType qn <*> rename ps
TApp f xs -> TApp f <$> rename xs
TRecord fs -> TRecord <$> rename fs
TTuple fs -> TTuple <$> rename fs
TWild -> return t
TLocated t' r -> withLoc r
$ TLocated <$> rename t' <*> pure r
instance Rename Pragma where
rename p = case p of
PragmaNote _ -> return p
PragmaProperty -> return p
-- | The type renaming environment generated by a binding.
bindingTypeEnv :: Bind -> NamingEnv
bindingTypeEnv b = patParams `shadowing` sigParams
where
-- type parameters
sigParams = namingEnv (bSignature b)
-- pattern type parameters
patParams = foldMap (foldMap qualType . tnamesP) (bParams b)
qualType qn = singletonT qn (TFromParam qn)
-- | Rename a binding.
--
-- NOTE: this does not bind its own name into the naming context of its body.
-- The assumption here is that this has been done by the enclosing environment,
-- to allow for top-level renaming
instance Rename Bind where
rename b = do
n' <- renameLoc renameExpr (bName b)
shadowNames (bindingTypeEnv b) $ do
(patenv,pats') <- renamePats (bParams b)
sig' <- traverse renameSchema (bSignature b)
shadowNames patenv $
do e' <- rename (bDef b)
p' <- rename (bPragmas b)
return b { bName = n'
, bParams = pats'
, bDef = e'
, bSignature = sig'
, bPragmas = p'
}
-- NOTE: this only renames types within the pattern.
instance Rename Pattern where
rename p = case p of
PVar _ -> pure p
PWild -> pure p
PTuple ps -> PTuple <$> rename ps
PRecord nps -> PRecord <$> rename nps
PList elems -> PList <$> rename elems
PTyped p' t -> PTyped <$> rename p' <*> rename t
PSplit l r -> PSplit <$> rename l <*> rename r
PLocated p' loc -> withLoc loc
$ PLocated <$> rename p' <*> pure loc
instance Rename Expr where
rename e = case e of
EVar n -> EVar <$> renameExpr n
ECon _ -> return e
ELit _ -> return e
ETuple es -> ETuple <$> rename es
ERecord fs -> ERecord <$> rename fs
ESel e' s -> ESel <$> rename e' <*> pure s
EList es -> EList <$> rename es
EFromTo s n e'-> EFromTo <$> rename s <*> rename n <*> rename e'
EInfFrom a b -> EInfFrom<$> rename a <*> rename b
EComp e' bs -> do bs' <- mapM renameMatch bs
shadowNames (namingEnv bs')
(EComp <$> rename e' <*> pure bs')
EApp f x -> EApp <$> rename f <*> rename x
EAppT f ti -> EAppT <$> rename f <*> rename ti
EIf b t f -> EIf <$> rename b <*> rename t <*> rename f
EWhere e' ds -> shadowNames ds (EWhere <$> rename e' <*> rename ds)
ETyped e' ty -> ETyped <$> rename e' <*> rename ty
ETypeVal ty -> ETypeVal<$> rename ty
EFun ps e' -> do ps' <- rename ps
shadowNames ps' (EFun ps' <$> rename e')
ELocated e' r -> withLoc r
$ ELocated <$> rename e' <*> pure r
instance Rename TypeInst where
rename ti = case ti of
NamedInst nty -> NamedInst <$> rename nty
PosInst ty -> PosInst <$> rename ty
renameMatch :: [Match] -> RenameM [Match]
renameMatch = loop
where
loop ms = case ms of
m:rest -> do
m' <- rename m
(m':) <$> shadowNames m' (loop rest)
[] -> return []
renamePats :: [Pattern] -> RenameM (NamingEnv,[Pattern])
renamePats = loop
where
loop ps = case ps of
p:rest -> do
p' <- rename p
let pe = namingEnv p'
(env',rest') <- loop rest
return (pe `mappend` env', p':rest')
[] -> return (mempty, [])
instance Rename Match where
rename m = case m of
Match p e -> Match <$> rename p <*> rename e
MatchLet b -> shadowNames b (MatchLet <$> rename b)
instance Rename TySyn where
rename (TySyn n ps ty) =
shadowNames ps (TySyn <$> renameLoc renameType n <*> pure ps <*> rename ty)
renameLoc :: (a -> RenameM a) -> Located a -> RenameM (Located a)
renameLoc by loc = do
a' <- by (thing loc)
return loc { thing = a' }
cryptol-2.2.6/src/Cryptol/Parser/ 0000755 0000000 0000000 00000000000 12637103426 015066 5 ustar 00 0000000 0000000 cryptol-2.2.6/src/Cryptol/Parser/AST.hs 0000644 0000000 0000000 00000074421 12637103426 016061 0 ustar 00 0000000 0000000 -- |
-- Module : $Header$
-- Copyright : (c) 2013-2015 Galois, Inc.
-- License : BSD3
-- Maintainer : cryptol@galois.com
-- Stability : provisional
-- Portability : portable
{-# LANGUAGE Safe #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE RecordWildCards #-}
module Cryptol.Parser.AST
( -- * Names
ModName(..), {-splitNamespace, parseModName, nsChar,-} modRange
, QName(..), mkQual, mkUnqual, unqual
, Name(..)
, Named(..)
, Pass(..)
-- * Types
, Schema(..)
, TParam(..), tpQName
, Kind(..)
, Type(..)
, Prop(..)
-- * Declarations
, Module(..)
, Program(..)
, TopDecl(..)
, Decl(..)
, TySyn(..)
, Bind(..)
, Pragma(..)
, ExportType(..)
, ExportSpec(..), exportBind, exportType
, isExportedBind, isExportedType
, TopLevel(..)
, Import(..), ImportSpec(..)
, Newtype(..)
-- * Interactive
, ReplInput(..)
-- * Expressions
, Expr(..)
, Literal(..), NumInfo(..)
, Match(..)
, Pattern(..)
, Selector(..)
, TypeInst(..)
-- * Positions
, Located(..)
, LName, LQName, LString
, NoPos(..)
-- * Pretty-printing
, cppKind, ppSelector
) where
import Cryptol.Parser.Position
import Cryptol.Prims.Syntax
import Cryptol.Utils.PP
import qualified Data.Map as Map
import qualified Data.Set as Set
import Data.List(intersperse)
import Data.Bits(shiftR)
import Data.Maybe (catMaybes)
import Numeric(showIntAtBase)
#if __GLASGOW_HASKELL__ < 710
import Data.Monoid (Monoid(..))
#endif
-- | Module names are just namespaces.
--
-- INVARIANT: the list of strings should never be empty in a valid module name.
newtype ModName = ModName [String]
deriving (Eq,Ord,Show)
data Name = Name String
| NewName Pass Int
deriving (Eq,Ord,Show)
data QName = QName (Maybe ModName) Name
deriving (Eq,Ord,Show)
mkQual :: ModName -> Name -> QName
mkQual = QName . Just
mkUnqual :: Name -> QName
mkUnqual = QName Nothing
unqual :: QName -> Name
unqual (QName _ n) = n
data Pass = NoPat | MonoValues
deriving (Eq,Ord,Show)
-- | A name with location information.
type LName = Located Name
-- | A qualified name with location information.
type LQName = Located QName
-- | A string with location information.
type LString = Located String
newtype Program = Program [TopDecl]
deriving (Eq,Show)
data Module = Module { mName :: Located ModName
, mImports :: [Located Import]
, mDecls :: [TopDecl]
} deriving (Eq,Show)
modRange :: Module -> Range
modRange m = rCombs $ catMaybes
[ getLoc (mName m)
, getLoc (mImports m)
, getLoc (mDecls m)
, Just (Range { from = start, to = start, source = "" })
]
data TopDecl = Decl (TopLevel Decl)
| TDNewtype (TopLevel Newtype)
| Include (Located FilePath)
deriving (Eq,Show)
data Decl = DSignature [LQName] Schema
| DPragma [LQName] Pragma
| DBind Bind
| DPatBind Pattern Expr
| DType TySyn
| DLocated Decl Range
deriving (Eq,Show)
-- | An import declaration.
data Import = Import { iModule :: ModName
, iAs :: Maybe ModName
, iSpec :: Maybe ImportSpec
} deriving (Eq,Show)
-- | The list of names following an import.
--
-- INVARIANT: All of the 'Name' entries in the list are expected to be
-- unqualified names; the 'QName' or 'NewName' constructors should not be
-- present.
data ImportSpec = Hiding [Name]
| Only [Name]
deriving (Eq,Show)
data TySyn = TySyn LQName [TParam] Type
deriving (Eq,Show)
{- | Bindings. Notes:
* The parser does not associate type signatures and pragmas with
their bindings: this is done in a separate pass, after de-sugaring
pattern bindings. In this way we can associate pragmas and type
signatures with the variables defined by pattern bindings as well.
* Currently, there is no surface syntax for defining monomorphic
bindings (i.e., bindings that will not be automatically generalized
by the type checker. However, they are useful when de-sugaring
patterns.
-}
data Bind = Bind { bName :: LQName -- ^ Defined thing
, bParams :: [Pattern] -- ^ Parameters
, bDef :: Expr -- ^ Definition
, bSignature :: Maybe Schema -- ^ Optional type sig
, bPragmas :: [Pragma] -- ^ Optional pragmas
, bMono :: Bool -- ^ Is this a monomorphic binding
} deriving (Eq,Show)
data Pragma = PragmaNote String
| PragmaProperty
deriving (Eq,Show)
data Newtype = Newtype { nName :: LQName -- ^ Type name
, nParams :: [TParam] -- ^ Type params
, nBody :: [Named Type] -- ^ Constructor
} deriving (Eq,Show)
-- | Input at the REPL, which can either be an expression or a @let@
-- statement.
data ReplInput = ExprInput Expr
| LetInput Decl
deriving (Eq, Show)
-- | Export information for a declaration.
data ExportType = Public
| Private
deriving (Eq,Show,Ord)
data TopLevel a = TopLevel { tlExport :: ExportType
, tlValue :: a
} deriving (Show,Eq,Ord)
instance Functor TopLevel where
fmap f tl = tl { tlValue = f (tlValue tl) }
data ExportSpec = ExportSpec { eTypes :: Set.Set QName
, eBinds :: Set.Set QName
} deriving (Show)
instance Monoid ExportSpec where
mempty = ExportSpec { eTypes = mempty, eBinds = mempty }
mappend l r = ExportSpec { eTypes = mappend (eTypes l) (eTypes r)
, eBinds = mappend (eBinds l) (eBinds r)
}
-- | Add a binding name to the export list, if it should be exported.
exportBind :: TopLevel QName -> ExportSpec
exportBind n
| tlExport n == Public = mempty { eBinds = Set.singleton (tlValue n) }
| otherwise = mempty
-- | Check to see if a binding is exported.
isExportedBind :: QName -> ExportSpec -> Bool
isExportedBind n = Set.member n . eBinds
-- | Add a type synonym name to the export list, if it should be exported.
exportType :: TopLevel QName -> ExportSpec
exportType n
| tlExport n == Public = mempty { eTypes = Set.singleton (tlValue n) }
| otherwise = mempty
-- | Check to see if a type synonym is exported.
isExportedType :: QName -> ExportSpec -> Bool
isExportedType n = Set.member n . eTypes
-- | Infromation about the representation of a numeric constant.
data NumInfo = BinLit Int -- ^ n-digit binary literal
| OctLit Int -- ^ n-digit octal literal
| DecLit -- ^ overloaded decimal literal
| HexLit Int -- ^ n-digit hex literal
| CharLit -- ^ character literal
| PolyLit Int -- ^ polynomial literal
deriving (Eq,Show)
-- | Literals.
data Literal = ECNum Integer NumInfo -- ^ @0x10@ (HexLit 2)
| ECString String -- ^ @\"hello\"@
deriving (Eq,Show)
data Expr = EVar QName -- ^ @ x @
| ECon ECon -- ^ @ split @
| ELit Literal -- ^ @ 0x10 @
| ETuple [Expr] -- ^ @ (1,2,3) @
| ERecord [Named Expr] -- ^ @ { x = 1, y = 2 } @
| ESel Expr Selector -- ^ @ e.l @
| EList [Expr] -- ^ @ [1,2,3] @
| EFromTo Type (Maybe Type) (Maybe Type) -- ^ @[1, 5 .. 117 ] @
| EInfFrom Expr (Maybe Expr) -- ^ @ [1, 3 ...] @
| EComp Expr [[Match]] -- ^ @ [ 1 | x <- xs ] @
| EApp Expr Expr -- ^ @ f x @
| EAppT Expr [TypeInst] -- ^ @ f `{x = 8}, f`{8} @
| EIf Expr Expr Expr -- ^ @ if ok then e1 else e2 @
| EWhere Expr [Decl] -- ^ @ 1 + x where { x = 2 } @
| ETyped Expr Type -- ^ @ 1 : [8] @
| ETypeVal Type -- ^ @ `(x + 1)@, @x@ is a type
| EFun [Pattern] Expr -- ^ @ \\x y -> x @
| ELocated Expr Range -- ^ position annotation
deriving (Eq,Show)
data TypeInst = NamedInst (Named Type)
| PosInst Type
deriving (Eq,Show)
{- | Selectors are used for projecting from various components.
Each selector has an option spec to specify the shape of the thing
that is being selected. Currently, there is no surface syntax for
list selectors, but they are used during the desugaring of patterns.
-}
data Selector = TupleSel Int (Maybe Int)
-- ^ Zero-based tuple selection.
-- Optionally specifies the shape of the tuple (one-based).
| RecordSel Name (Maybe [Name])
-- ^ Record selection.
-- Optionally specifies the shape of the record.
| ListSel Int (Maybe Int)
-- ^ List selection.
-- Optionally specifies the length of the list.
deriving (Eq,Show,Ord)
data Match = Match Pattern Expr -- ^ p <- e
| MatchLet Bind
deriving (Eq,Show)
data Pattern = PVar LName -- ^ @ x @
| PWild -- ^ @ _ @
| PTuple [Pattern] -- ^ @ (x,y,z) @
| PRecord [ Named Pattern ] -- ^ @ { x = (a,b,c), y = z } @
| PList [ Pattern ] -- ^ @ [ x, y, z ] @
| PTyped Pattern Type -- ^ @ x : [8] @
| PSplit Pattern Pattern -- ^ @ (x # y) @
| PLocated Pattern Range -- ^ Location information
deriving (Eq,Show)
data Named a = Named { name :: Located Name, value :: a }
deriving (Eq,Show)
instance Functor Named where
fmap f x = x { value = f (value x) }
data Schema = Forall [TParam] [Prop] Type (Maybe Range)
deriving (Eq,Show)
data Kind = KNum | KType
deriving (Eq,Show)
data TParam = TParam { tpName :: Name
, tpKind :: Maybe Kind
, tpRange :: Maybe Range
}
deriving (Eq,Show)
tpQName :: TParam -> QName
tpQName = mkUnqual . tpName
data Type = TFun Type Type -- ^ @[8] -> [8]@
| TSeq Type Type -- ^ @[8] a@
| TBit -- ^ @Bit@
| TNum Integer -- ^ @10@
| TChar Char -- ^ @'a'@
| TInf -- ^ @inf@
| TUser QName [Type] -- ^ A type variable or synonym
| TApp TFun [Type] -- ^ @2 + x@
| TRecord [Named Type] -- ^ @{ x : [8], y : [32] }@
| TTuple [Type] -- ^ @([8], [32])@
| TWild -- ^ @_@, just some type.
| TLocated Type Range -- ^ Location information
deriving (Eq,Show)
data Prop = CFin Type -- ^ @ fin x @
| CEqual Type Type -- ^ @ x == 10 @
| CGeq Type Type -- ^ @ x >= 10 @
| CArith Type -- ^ @ Arith a @
| CCmp Type -- ^ @ Cmp a @
| CLocated Prop Range -- ^ Location information
deriving (Eq,Show)
--------------------------------------------------------------------------------
-- Note: When an explicit location is missing, we could use the sub-components
-- to try to estimate a location...
instance AddLoc Expr where
addLoc = ELocated
dropLoc (ELocated e _) = dropLoc e
dropLoc e = e
instance HasLoc Expr where
getLoc (ELocated _ r) = Just r
getLoc _ = Nothing
instance HasLoc TParam where
getLoc (TParam _ _ r) = r
instance AddLoc TParam where
addLoc (TParam a b _) l = TParam a b (Just l)
dropLoc (TParam a b _) = TParam a b Nothing
instance HasLoc Type where
getLoc (TLocated _ r) = Just r
getLoc _ = Nothing
instance AddLoc Type where
addLoc = TLocated
dropLoc (TLocated e _) = dropLoc e
dropLoc e = e
instance HasLoc Prop where
getLoc (CLocated _ r) = Just r
getLoc _ = Nothing
instance AddLoc Prop where
addLoc = CLocated
dropLoc (CLocated e _) = dropLoc e
dropLoc e = e
instance AddLoc Pattern where
addLoc = PLocated
dropLoc (PLocated e _) = dropLoc e
dropLoc e = e
instance HasLoc Pattern where
getLoc (PLocated _ r) = Just r
getLoc _ = Nothing
instance HasLoc Bind where
getLoc b = getLoc (bName b, bDef b)
instance HasLoc Match where
getLoc (Match p e) = getLoc (p,e)
getLoc (MatchLet b) = getLoc b
instance HasLoc a => HasLoc (Named a) where
getLoc l = getLoc (name l, value l)
instance HasLoc Schema where
getLoc (Forall _ _ _ r) = r
instance AddLoc Schema where
addLoc (Forall xs ps t _) r = Forall xs ps t (Just r)
dropLoc (Forall xs ps t _) = Forall xs ps t Nothing
instance HasLoc Decl where
getLoc (DLocated _ r) = Just r
getLoc _ = Nothing
instance AddLoc Decl where
addLoc d r = DLocated d r
dropLoc (DLocated d _) = dropLoc d
dropLoc d = d
instance HasLoc a => HasLoc (TopLevel a) where
getLoc = getLoc . tlValue
instance HasLoc TopDecl where
getLoc td = case td of
Decl tld -> getLoc tld
TDNewtype n -> getLoc n
Include lfp -> getLoc lfp
instance HasLoc Module where
getLoc m
| null locs = Nothing
| otherwise = Just (rCombs locs)
where
locs = catMaybes [ getLoc (mName m)
, getLoc (mImports m)
, getLoc (mDecls m)
]
instance HasLoc Newtype where
getLoc n
| null locs = Nothing
| otherwise = Just (rCombs locs)
where
locs = catMaybes [ getLoc (nName n), getLoc (nBody n) ]
--------------------------------------------------------------------------------
--------------------------------------------------------------------------------
-- Pretty printing
ppL :: PP a => Located a -> Doc
ppL = pp . thing
ppNamed :: PP a => String -> Named a -> Doc
ppNamed s x = ppL (name x) <+> text s <+> pp (value x)
instance PP Module where
ppPrec _ m = text "module" <+> ppL (mName m) <+> text "where"
$$ vcat (map ppL (mImports m))
$$ vcat (map pp (mDecls m))
instance PP Program where
ppPrec _ (Program ds) = vcat (map pp ds)
instance PP TopDecl where
ppPrec _ top_decl =
case top_decl of
Decl d -> pp d
TDNewtype n -> pp n
Include l -> text "include" <+> text (show (thing l))
instance PP Decl where
ppPrec n decl =
case decl of
DSignature xs s -> commaSep (map ppL xs) <+> text ":" <+> pp s
DPatBind p e -> pp p <+> text "=" <+> pp e
DBind b -> ppPrec n b
DPragma xs p -> ppPragma xs p
DType ts -> ppPrec n ts
DLocated d _ -> ppPrec n d
instance PP Newtype where
ppPrec _ nt = hsep
[ text "newtype", ppL (nName nt), hsep (map pp (nParams nt)), char '='
, braces (commaSep (map (ppNamed ":") (nBody nt))) ]
instance PP Import where
ppPrec _ d = text "import" <+> sep [ pp (iModule d), mbAs, mbSpec ]
where
mbAs = maybe empty (\ name -> text "as" <+> pp name ) (iAs d)
mbSpec = maybe empty pp (iSpec d)
instance PP ImportSpec where
ppPrec _ s = case s of
Hiding names -> text "hiding" <+> parens (commaSep (map pp names))
Only names -> parens (commaSep (map pp names))
-- TODO: come up with a good way of showing the export specification here
instance PP a => PP (TopLevel a) where
ppPrec _ tl = pp (tlValue tl)
instance PP Pragma where
ppPrec _ (PragmaNote x) = text x
ppPrec _ PragmaProperty = text "property"
ppPragma :: [LQName] -> Pragma -> Doc
ppPragma xs p =
text "/*" <+> text "pragma" <+> commaSep (map ppL xs) <+> text ":" <+> pp p
<+> text "*/"
instance PP Bind where
ppPrec _ b = sig $$ vcat [ ppPragma [f] p | p <- bPragmas b ] $$
hang (lhs <+> eq) 4 (pp (bDef b))
where f = bName b
sig = case bSignature b of
Nothing -> empty
Just s -> pp (DSignature [f] s)
eq = if bMono b then text ":=" else text "="
lhs = ppL f <+> fsep (map (ppPrec 3) (bParams b))
instance PP TySyn where
ppPrec _ (TySyn x xs t) = text "type" <+> ppL x <+> fsep (map (ppPrec 1) xs)
<+> text "=" <+> pp t
instance PP ModName where
ppPrec _ (ModName ns) = hcat (punctuate (text "::") (map text ns))
instance PP QName where
ppPrec _ (QName mb n) = mbNs <> pp n
where
mbNs = maybe empty (\ mn -> pp mn <> text "::") mb
instance PP Name where
ppPrec _ (Name x) = text x
-- XXX: This may clash with user-specified names.
ppPrec _ (NewName p x) = text "__" <> passName p <> int x
passName :: Pass -> Doc
passName pass =
case pass of
NoPat -> text "p"
MonoValues -> text "mv"
instance PP Literal where
ppPrec _ lit =
case lit of
ECNum n i -> ppNumLit n i
ECString s -> text (show s)
ppNumLit :: Integer -> NumInfo -> Doc
ppNumLit n info =
case info of
DecLit -> integer n
CharLit -> text (show (toEnum (fromInteger n) :: Char))
BinLit w -> pad 2 "0b" w
OctLit w -> pad 8 "0o" w
HexLit w -> pad 16 "0x" w
PolyLit w -> text "<|" <+> poly w <+> text "|>"
where
pad base pref w =
let txt = showIntAtBase base ("0123456789abcdef" !!) n ""
in text pref <> text (replicate (w - length txt) '0') <> text txt
poly w = let (res,deg) = bits Nothing [] 0 n
z | w == 0 = []
| Just d <- deg, d + 1 == w = []
| otherwise = [polyTerm0 (w-1)]
in fsep $ intersperse (text "+") $ z ++ map polyTerm res
polyTerm 0 = text "1"
polyTerm 1 = text "x"
polyTerm p = text "x" <> text "^^" <> int p
polyTerm0 0 = text "0"
polyTerm0 p = text "0" <> text "*" <> polyTerm p
bits d res p num
| num == 0 = (res,d)
| even num = bits d res (p + 1) (num `shiftR` 1)
| otherwise = bits (Just p) (p : res) (p + 1) (num `shiftR` 1)
wrap :: Int -> Int -> Doc -> Doc
wrap contextPrec myPrec doc = if myPrec < contextPrec then parens doc else doc
-- | Succeeds if the expression is an infix operator.
isInfixOp :: Expr -> Maybe (ECon, Assoc, Int)
isInfixOp (ELocated e _) = isInfixOp e
isInfixOp (ECon x) = do (a,p) <- Map.lookup x eBinOpPrec
return (x,a,p)
isInfixOp _ = Nothing
isPrefixOp :: Expr -> Maybe ECon
isPrefixOp (ELocated e _) = isPrefixOp e
isPrefixOp (ECon x) | x == ECNeg || x == ECCompl = Just x
isPrefixOp _ = Nothing
isEApp :: Expr -> Maybe (Expr, Expr)
isEApp (ELocated e _) = isEApp e
isEApp (EApp e1 e2) = Just (e1,e2)
isEApp _ = Nothing
asEApps :: Expr -> (Expr, [Expr])
asEApps expr = go expr []
where go e es = case isEApp e of
Nothing -> (e, es)
Just (e1, e2) -> go e1 (e2 : es)
isEInfix :: Expr -> Maybe (Infix ECon Expr)
isEInfix e =
do (e1,ieRight) <- isEApp e
(f,ieLeft) <- isEApp e1
(ieOp,ieAssoc,iePrec) <- isInfixOp f
return Infix { .. }
isTInfix :: Type -> Maybe (Infix TFun Type)
isTInfix (TLocated t _) = isTInfix t
isTInfix (TApp ieOp [ieLeft,ieRight]) =
do (ieAssoc,iePrec) <- Map.lookup ieOp tBinOpPrec
return Infix { .. }
isTInfix _ = Nothing
instance PP TypeInst where
ppPrec _ (PosInst t) = pp t
ppPrec _ (NamedInst x) = ppNamed "=" x
{- Precedences:
0: lambda, if, where, type annotation
2: infix expression (separate precedence table)
3: application, prefix expressions
-}
instance PP Expr where
-- Wrap if top level operator in expression is less than `n`
ppPrec n expr =
case expr of
-- atoms
EVar x -> pp x
ECon x -> ppPrefix x
ELit x -> pp x
ETuple es -> parens (commaSep (map pp es))
ERecord fs -> braces (commaSep (map (ppNamed "=") fs))
EList es -> brackets (commaSep (map pp es))
EFromTo e1 e2 e3 -> brackets (pp e1 <> step <+> text ".." <+> end)
where step = maybe empty (\e -> comma <+> pp e) e2
end = maybe empty pp e3
EInfFrom e1 e2 -> brackets (pp e1 <> step <+> text "...")
where step = maybe empty (\e -> comma <+> pp e) e2
EComp e mss -> brackets (pp e <+> vcat (map arm mss))
where arm ms = text "|" <+> commaSep (map pp ms)
ETypeVal t -> text "`" <> ppPrec 5 t -- XXX
EAppT e ts -> ppPrec 4 e <> text "`" <> braces (commaSep (map pp ts))
ESel e l -> ppPrec 4 e <> text "." <> pp l
-- low prec
EFun xs e -> wrap n 0 (text "\\" <> hsep (map (ppPrec 3) xs) <+>
text "->" <+> pp e)
EIf e1 e2 e3 -> wrap n 0 $ sep [ text "if" <+> pp e1
, text "then" <+> pp e2
, text "else" <+> pp e3 ]
ETyped e t -> wrap n 0 (ppPrec 2 e <+> text ":" <+> pp t)
EWhere e ds -> wrap n 0 (pp e
$$ text "where"
$$ nest 2 (vcat (map pp ds))
$$ text "")
-- applications
_ | Just einf <- isEInfix expr
-> optParens (n>2) $ ppInfix 2 isEInfix einf
EApp e1 e2
| Just op <- isPrefixOp e1
-> wrap n 3 (pp op <> ppPrec 3 e2)
EApp _ _ -> let (e, es) = asEApps expr in
wrap n 3 (ppPrec 3 e <+> fsep (map (ppPrec 4) es))
ELocated e _ -> ppPrec n e
instance PP Selector where
ppPrec _ sel =
case sel of
TupleSel x sig -> int x <+> ppSig tupleSig sig
RecordSel x sig -> pp x <+> ppSig recordSig sig
ListSel x sig -> int x <+> ppSig listSig sig
where
tupleSig n = int n
recordSig xs = braces $ fsep $ punctuate comma $ map pp xs
listSig n = int n
ppSig f = maybe empty (\x -> text "/* of" <+> f x <+> text "*/")
-- | Display the thing selected by the selector, nicely.
ppSelector :: Selector -> Doc
ppSelector sel =
case sel of
TupleSel x _ -> ordinal x <+> text "field"
RecordSel x _ -> text "field" <+> pp x
ListSel x _ -> ordinal x <+> text "element"
instance PP Pattern where
ppPrec n pat =
case pat of
PVar x -> pp (thing x)
PWild -> char '_'
PTuple ps -> parens (commaSep (map pp ps))
PRecord fs -> braces (commaSep (map (ppNamed "=") fs))
PList ps -> brackets (commaSep (map pp ps))
PTyped p t -> wrap n 0 (ppPrec 1 p <+> text ":" <+> pp t)
PSplit p1 p2 -> wrap n 1 (ppPrec 1 p1 <+> text "#" <+> ppPrec 1 p2)
PLocated p _ -> ppPrec n p
instance PP Match where
ppPrec _ (Match p e) = pp p <+> text "<-" <+> pp e
ppPrec _ (MatchLet b) = pp b
instance PP Schema where
ppPrec _ (Forall xs ps t _) = sep [vars <+> preds, pp t]
where vars = case xs of
[] -> empty
_ -> braces (commaSep (map pp xs))
preds = case ps of
[] -> empty
_ -> parens (commaSep (map pp ps)) <+> text "=>"
instance PP Kind where
ppPrec _ KType = text "*"
ppPrec _ KNum = text "#"
-- | "Conversational" printing of kinds (e.g., to use in error messages)
cppKind :: Kind -> Doc
cppKind KType = text "a value type"
cppKind KNum = text "a numeric type"
instance PP TParam where
ppPrec n (TParam p Nothing _) = ppPrec n p
ppPrec n (TParam p (Just k) _) = wrap n 1 (pp p <+> text ":" <+> pp k)
-- 4: wrap [_] t
-- 3: wrap application
-- 2: wrap function
-- 1:
instance PP Type where
ppPrec n ty =
case ty of
TWild -> text "_"
TTuple ts -> parens $ commaSep $ map pp ts
TRecord fs -> braces $ commaSep $ map (ppNamed ":") fs
TBit -> text "Bit"
TInf -> text "inf"
TNum x -> integer x
TChar x -> text (show x)
TSeq t1 TBit -> brackets (pp t1)
TSeq t1 t2 -> optParens (n > 3)
$ brackets (pp t1) <> ppPrec 3 t2
TApp _ [_,_]
| Just tinf <- isTInfix ty
-> optParens (n > 2)
$ ppInfix 2 isTInfix tinf
TApp f ts -> optParens (n > 2)
$ pp f <+> fsep (map (ppPrec 4) ts)
TUser f [] -> pp f
TUser f ts -> optParens (n > 2)
$ pp f <+> fsep (map (ppPrec 4) ts)
TFun t1 t2 -> optParens (n > 1)
$ sep [ppPrec 2 t1 <+> text "->", ppPrec 1 t2]
TLocated t _ -> ppPrec n t
instance PP Prop where
ppPrec n prop =
case prop of
CFin t -> text "fin" <+> ppPrec 4 t
CArith t -> text "Arith" <+> ppPrec 4 t
CCmp t -> text "Cmp" <+> ppPrec 4 t
CEqual t1 t2 -> ppPrec 2 t1 <+> text "==" <+> ppPrec 2 t2
CGeq t1 t2 -> ppPrec 2 t1 <+> text ">=" <+> ppPrec 2 t2
CLocated c _ -> ppPrec n c
--------------------------------------------------------------------------------
-- Drop all position information, so equality reflects program structure
class NoPos t where
noPos :: t -> t
-- WARNING: This does not call `noPos` on the `thing` inside
instance NoPos (Located t) where
noPos x = x { srcRange = rng }
where rng = Range { from = Position 0 0, to = Position 0 0, source = "" }
instance NoPos t => NoPos (Named t) where
noPos t = Named { name = noPos (name t), value = noPos (value t) }
instance NoPos t => NoPos [t] where noPos = fmap noPos
instance NoPos t => NoPos (Maybe t) where noPos = fmap noPos
instance NoPos Program where
noPos (Program x) = Program (noPos x)
instance NoPos Module where
noPos m = Module { mName = mName m
, mImports = noPos (mImports m)
, mDecls = noPos (mDecls m)
}
instance NoPos TopDecl where
noPos decl =
case decl of
Decl x -> Decl (noPos x)
TDNewtype n -> TDNewtype(noPos n)
Include x -> Include (noPos x)
instance NoPos a => NoPos (TopLevel a) where
noPos tl = tl { tlValue = noPos (tlValue tl) }
instance NoPos Decl where
noPos decl =
case decl of
DSignature x y -> DSignature (noPos x) (noPos y)
DPragma x y -> DPragma (noPos x) (noPos y)
DPatBind x y -> DPatBind (noPos x) (noPos y)
DBind x -> DBind (noPos x)
DType x -> DType (noPos x)
DLocated x _ -> noPos x
instance NoPos Newtype where
noPos n = Newtype { nName = noPos (nName n)
, nParams = nParams n
, nBody = noPos (nBody n)
}
instance NoPos Bind where
noPos x = Bind { bName = noPos (bName x)
, bParams = noPos (bParams x)
, bDef = noPos (bDef x)
, bSignature = noPos (bSignature x)
, bPragmas = noPos (bPragmas x)
, bMono = bMono x
}
instance NoPos Pragma where
noPos p@(PragmaNote {}) = p
noPos p@(PragmaProperty) = p
instance NoPos TySyn where
noPos (TySyn x y z) = TySyn (noPos x) (noPos y) (noPos z)
instance NoPos Expr where
noPos expr =
case expr of
EVar x -> EVar x
ECon x -> ECon x
ELit x -> ELit x
ETuple x -> ETuple (noPos x)
ERecord x -> ERecord (noPos x)
ESel x y -> ESel (noPos x) y
EList x -> EList (noPos x)
EFromTo x y z -> EFromTo (noPos x) (noPos y) (noPos z)
EInfFrom x y -> EInfFrom (noPos x) (noPos y)
EComp x y -> EComp (noPos x) (noPos y)
EApp x y -> EApp (noPos x) (noPos y)
EAppT x y -> EAppT (noPos x) (noPos y)
EIf x y z -> EIf (noPos x) (noPos y) (noPos z)
EWhere x y -> EWhere (noPos x) (noPos y)
ETyped x y -> ETyped (noPos x) (noPos y)
ETypeVal x -> ETypeVal (noPos x)
EFun x y -> EFun (noPos x) (noPos y)
ELocated x _ -> noPos x
instance NoPos TypeInst where
noPos (PosInst ts) = PosInst (noPos ts)
noPos (NamedInst fs) = NamedInst (noPos fs)
instance NoPos Match where
noPos (Match x y) = Match (noPos x) (noPos y)
noPos (MatchLet b) = MatchLet (noPos b)
instance NoPos Pattern where
noPos pat =
case pat of
PVar x -> PVar (noPos x)
PWild -> PWild
PTuple x -> PTuple (noPos x)
PRecord x -> PRecord (noPos x)
PList x -> PList (noPos x)
PTyped x y -> PTyped (noPos x) (noPos y)
PSplit x y -> PSplit (noPos x) (noPos y)
PLocated x _ -> noPos x
instance NoPos Schema where
noPos (Forall x y z _) = Forall (noPos x) (noPos y) (noPos z) Nothing
instance NoPos TParam where
noPos (TParam x y _) = TParam x y Nothing
instance NoPos Type where
noPos ty =
case ty of
TWild -> TWild
TApp x y -> TApp x (noPos y)
TUser x y -> TUser x (noPos y)
TRecord x -> TRecord (noPos x)
TTuple x -> TTuple (noPos x)
TFun x y -> TFun (noPos x) (noPos y)
TSeq x y -> TSeq (noPos x) (noPos y)
TBit -> TBit
TInf -> TInf
TNum n -> TNum n
TChar n -> TChar n
TLocated x _ -> noPos x
instance NoPos Prop where
noPos prop =
case prop of
CEqual x y -> CEqual (noPos x) (noPos y)
CGeq x y -> CGeq (noPos x) (noPos y)
CFin x -> CFin (noPos x)
CArith x -> CArith (noPos x)
CCmp x -> CCmp (noPos x)
CLocated c _ -> noPos c
cryptol-2.2.6/src/Cryptol/Parser/Lexer.x 0000644 0000000 0000000 00000021735 12637103426 016346 0 ustar 00 0000000 0000000 {
-- At present Alex generates code with too many warnings.
{-# LANGUAGE Trustworthy #-}
{-# OPTIONS_GHC -w #-}
module Cryptol.Parser.Lexer
( primLexer, lexer, Layout(..)
, Token(..), TokenT(..)
, TokenV(..), TokenKW(..), TokenErr(..), TokenOp(..), TokenSym(..), TokenW(..)
, Located(..)
, Config(..)
, defaultConfig
) where
import Cryptol.Parser.Position
import Cryptol.Parser.LexerUtils
import Cryptol.Parser.Unlit(unLit)
import qualified Data.Text.Lazy as Text
}
$id_first = [a-zA-Z_α-ωΑ-Ω]
$id_next = [a-zA-Z0-9_'α-ωΑ-Ω]
@num2 = "0b" [0-1]+
@num8 = "0o" [0-7]+
@num10 = [0-9]+
@num16 = "0x" [0-9A-Fa-f]+
@strPart = [^\\\"]+
@chrPart = [^\\\']+
:-
<0,comment> "/*" { startComment }
{
"*/" { endComent }
. { addToComment }
\n { addToComment }
}
{
@strPart { addToString }
\" { endString }
\\. { addToString }
\n { endString }
}
{
@chrPart { addToChar }
\' { endChar }
\\. { addToChar }
\n { endChar }
}
<0> {
$white+ { emit $ White Space }
"//" .* { emit $ White LineComment }
-- Please update the docs, if you add new entries.
"Arith" { emit $ KW KW_Arith }
"Bit" { emit $ KW KW_Bit }
"Cmp" { emit $ KW KW_Cmp }
"False" { emit $ KW KW_False }
"Inf" { emit $ KW KW_inf }
"True" { emit $ KW KW_True }
"else" { emit $ KW KW_else }
"Eq" { emit $ KW KW_Eq }
"error" { emit $ KW KW_error }
"extern" { emit $ KW KW_extern }
"fin" { emit $ KW KW_fin }
"if" { emit $ KW KW_if }
"private" { emit $ KW KW_private }
"join" { emit $ KW KW_join }
"include" { emit $ KW KW_include }
"inf" { emit $ KW KW_inf }
"lg2" { emit $ KW KW_lg2 }
"lengthFromThen" { emit $ KW KW_lengthFromThen }
"lengthFromThenTo" { emit $ KW KW_lengthFromThenTo }
"max" { emit $ KW KW_max }
"min" { emit $ KW KW_min }
"module" { emit $ KW KW_module }
"newtype" { emit $ KW KW_newtype }
"pragma" { emit $ KW KW_pragma }
"property" { emit $ KW KW_property }
"pmult" { emit $ KW KW_pmult }
"pdiv" { emit $ KW KW_pdiv }
"pmod" { emit $ KW KW_pmod }
"random" { emit $ KW KW_random }
"reverse" { emit $ KW KW_reverse }
"split" { emit $ KW KW_split }
"splitAt" { emit $ KW KW_splitAt }
"then" { emit $ KW KW_then }
"transpose" { emit $ KW KW_transpose }
"type" { emit $ KW KW_type }
"where" { emit $ KW KW_where }
"let" { emit $ KW KW_let }
"x" { emit $ KW KW_x }
"zero" { emit $ KW KW_zero }
"import" { emit $ KW KW_import }
"as" { emit $ KW KW_as }
"hiding" { emit $ KW KW_hiding }
"newtype" { emit $ KW KW_newtype }
@num2 { emitS (numToken 2 . drop 2) }
@num8 { emitS (numToken 8 . drop 2) }
@num10 { emitS (numToken 10 . drop 0) }
@num16 { emitS (numToken 16 . drop 2) }
"_" { emit $ Sym Underscore }
$id_first $id_next* { mkIdent }
"+" { emit $ Op Plus }
"-" { emit $ Op Minus }
"*" { emit $ Op Mul }
"/" { emit $ Op Div }
"%" { emit $ Op Mod }
"^^" { emit $ Op Exp }
"!=" { emit $ Op NotEqual }
"==" { emit $ Op Equal }
"===" { emit $ Op EqualFun }
"!==" { emit $ Op NotEqualFun }
">" { emit $ Op GreaterThan }
"<" { emit $ Op LessThan }
"<=" { emit $ Op LEQ }
">=" { emit $ Op GEQ }
">>" { emit $ Op ShiftR }
"<<" { emit $ Op ShiftL }
">>>" { emit $ Op RotR }
"<<<" { emit $ Op RotL }
"~" { emit $ Op Complement }
"^" { emit $ Op Xor }
"||" { emit $ Op Disj }
"&&" { emit $ Op Conj }
"!" { emit $ Op Bang }
"!!" { emit $ Op BangBang }
"@" { emit $ Op At }
"@@" { emit $ Op AtAt }
"#" { emit $ Op Hash }
"\" { emit $ Sym Lambda }
"->" { emit $ Sym ArrR }
"<-" { emit $ Sym ArrL }
"=>" { emit $ Sym FatArrR }
"=" { emit $ Sym EqDef }
"," { emit $ Sym Comma }
";" { emit $ Sym Semi }
"." { emit $ Sym Dot }
":" { emit $ Sym Colon }
"::" { emit $ Sym ColonColon }
"`" { emit $ Sym BackTick }
".." { emit $ Sym DotDot }
"..." { emit $ Sym DotDotDot }
"|" { emit $ Sym Bar }
"(" { emit $ Sym ParenL }
")" { emit $ Sym ParenR }
"[" { emit $ Sym BracketL }
"]" { emit $ Sym BracketR }
"{" { emit $ Sym CurlyL }
"}" { emit $ Sym CurlyR }
"<|" { emit $ Sym TriL }
"|>" { emit $ Sym TriR }
\" { startString }
\' { startChar }
}
{
-- This code is here because it depends on `comment`, which is defined
-- in this file.
stateToInt :: LexS -> Int
stateToInt Normal = 0
stateToInt (InComment {}) = comment
stateToInt (InString {}) = string
stateToInt (InChar {}) = char
-- | Returns the tokens in the last position of the input that we processed.
-- White space is removed, and layout processing is done as requested.
-- This stream is fed to the parser.
lexer :: Config -> String -> ([Located Token], Position)
lexer cfg cs = ( case cfgLayout cfg of
Layout -> layout cfg lexemes
NoLayout -> lexemes
, finalPos
)
where (lex0, finalPos) = primLexer cfg cs
lexemes = dropWhite lex0
-- | Returns the tokens and the last position of the input that we processed.
-- The tokens include whte space tokens.
primLexer :: Config -> String -> ([Located Token], Position)
primLexer cfg cs = run inp Normal
where
inp = Inp { alexPos = start
, alexInputPrevChar = '\n'
, input = Text.unpack -- XXX: Use Text
$ unLit (cfgPreProc cfg)
$ Text.pack cs
, moreBytes = [] }
singleR p = Range p p (cfgSource cfg)
eofR p = Range p' p' (cfgSource cfg)
where
p' = Position { line = line p + 1, col = 0 }
run i s =
case alexScan i (stateToInt s) of
AlexEOF ->
case s of
Normal -> ([ Located (eofR $ alexPos i) (Token EOF "end of file") ]
, alexPos i
)
InComment p _ _ ->
( [ Located (singleR p)
$ Token (Err UnterminatedComment) "unterminated comment"
]
, alexPos i)
InString p _ ->
( [ Located (singleR p)
$ Token (Err UnterminatedString) "unterminated string"
]
, alexPos i)
InChar p _ ->
( [ Located (singleR p)
$ Token (Err UnterminatedChar) "unterminated character"
]
, alexPos i)
AlexError i' ->
let p1 = alexPos i
p2 = alexPos i'
inp = input i
bad = if line p1 == line p2
then take (col p2 - col p1) inp
else takeWhile (/= '\n') inp
in
( [ Located (Range (alexPos i) (alexPos i') (cfgSource cfg))
$ Token (Err LexicalError) bad ]
, alexPos i')
AlexSkip i' _ -> run i' s
AlexToken i' l act ->
let txt = take l (input i)
(mtok,s') = act cfg (alexPos i) txt s
(rest,pos) = run i' $! s'
in case mtok of
Nothing -> (rest, pos)
Just t -> (t : rest, pos)
-- vim: ft=haskell
}
cryptol-2.2.6/src/Cryptol/Parser/LexerUtils.hs 0000644 0000000 0000000 00000032407 12637103426 017530 0 ustar 00 0000000 0000000 -- |
-- Module : $Header$
-- Copyright : (c) 2013-2015 Galois, Inc.
-- License : BSD3
-- Maintainer : cryptol@galois.com
-- Stability : provisional
-- Portability : portable
{-# LANGUAGE PatternGuards #-}
module Cryptol.Parser.LexerUtils where
import Cryptol.Parser.Position
import Cryptol.Parser.Unlit(PreProc(None))
import Cryptol.Utils.PP
import Cryptol.Utils.Panic
import Data.Char(toLower)
import Data.List(foldl')
import Data.Word(Word8)
import Codec.Binary.UTF8.String(encodeChar)
data Config = Config
{ cfgSource :: !FilePath -- ^ File that we are working on
, cfgLayout :: !Layout -- ^ Settings for layout processing
, cfgPreProc :: PreProc -- ^ Preprocessor settings
, cfgAutoInclude :: [FilePath] -- ^ Implicit includes
, cfgModuleScope :: Bool -- ^ When we do layout processing
-- should we add a vCurly (i.e., are
-- we parsing a list of things).
}
defaultConfig :: Config
defaultConfig = Config
{ cfgSource = ""
, cfgLayout = Layout
, cfgPreProc = None
, cfgAutoInclude = []
, cfgModuleScope = True
}
type Action = Config -> Position -> String -> LexS
-> (Maybe (Located Token), LexS)
data LexS = Normal
| InComment Position ![Position] [String]
| InString Position String
| InChar Position String
startComment :: Action
startComment _ p txt s = (Nothing, InComment p stack chunks)
where (stack,chunks) = case s of
Normal -> ([], [txt])
InComment q qs cs -> (q : qs, txt : cs)
_ -> panic "[Lexer] startComment" ["in a string"]
endComent :: Action
endComent cfg p txt s =
case s of
InComment f [] cs -> (Just (mkToken f cs), Normal)
InComment _ (q:qs) cs -> (Nothing, InComment q qs (txt : cs))
_ -> panic "[Lexer] endComment" ["outside commend"]
where
mkToken f cs =
let r = Range { from = f, to = moves p txt, source = cfgSource cfg }
str = concat $ reverse $ txt : cs
in Located { srcRange = r, thing = Token (White BlockComment) str }
addToComment :: Action
addToComment _ _ txt s = (Nothing, InComment p stack (txt : chunks))
where
(p, stack, chunks) =
case s of
InComment q qs cs -> (q,qs,cs)
_ -> panic "[Lexer] addToComment" ["outside comment"]
startString :: Action
startString _ p txt _ = (Nothing,InString p txt)
endString :: Action
endString cfg pe txt s = case s of
InString ps str -> (Just (mkToken ps str), Normal)
_ -> panic "[Lexer] endString" ["outside string"]
where
parseStr s1 = case reads s1 of
[(cs, "")] -> StrLit cs
_ -> Err InvalidString
mkToken ps str = Located { srcRange = Range
{ from = ps
, to = moves pe txt
, source = cfgSource cfg
}
, thing = Token
{ tokenType = parseStr (str ++ txt)
, tokenText = str ++ txt
}
}
addToString :: Action
addToString _ _ txt s = case s of
InString p str -> (Nothing,InString p (str ++ txt))
_ -> panic "[Lexer] addToString" ["outside string"]
startChar :: Action
startChar _ p txt _ = (Nothing,InChar p txt)
endChar :: Action
endChar cfg pe txt s =
case s of
InChar ps str -> (Just (mkToken ps str), Normal)
_ -> panic "[Lexer] endString" ["outside character"]
where
parseChar s1 = case reads s1 of
[(cs, "")] -> ChrLit cs
_ -> Err InvalidChar
mkToken ps str = Located { srcRange = Range
{ from = ps
, to = moves pe txt
, source = cfgSource cfg
}
, thing = Token
{ tokenType = parseChar (str ++ txt)
, tokenText = str ++ txt
}
}
addToChar :: Action
addToChar _ _ txt s = case s of
InChar p str -> (Nothing,InChar p (str ++ txt))
_ -> panic "[Lexer] addToChar" ["outside character"]
mkIdent :: Action
mkIdent cfg p s z = (Just Located { srcRange = r, thing = Token t s }, z)
where
r = Range { from = p, to = moves p s, source = cfgSource cfg }
t = Ident s
emit :: TokenT -> Action
emit t cfg p s z = (Just Located { srcRange = r, thing = Token t s }, z)
where r = Range { from = p, to = moves p s, source = cfgSource cfg }
emitS :: (String -> TokenT) -> Action
emitS t cfg p s z = emit (t s) cfg p s z
--------------------------------------------------------------------------------
numToken :: Integer -> String -> TokenT
numToken rad ds = Num (toVal ds) (fromInteger rad) (length ds)
where
toVal = foldl' (\x c -> rad * x + toDig c) 0
toDig = if rad == 16 then fromHexDigit else fromDecDigit
fromDecDigit :: Char -> Integer
fromDecDigit x = read [x]
fromHexDigit :: Char -> Integer
fromHexDigit x'
| 'a' <= x && x <= 'f' = fromIntegral (10 + fromEnum x - fromEnum 'a')
| otherwise = fromDecDigit x
where x = toLower x'
-------------------------------------------------------------------------------
data AlexInput = Inp { alexPos :: !Position
, alexInputPrevChar :: !Char
, input :: !String
, moreBytes :: ![Word8]
} deriving Show
alexGetByte :: AlexInput -> Maybe (Word8, AlexInput)
alexGetByte i =
case moreBytes i of
b : bs -> Just (b, i { moreBytes = bs })
[] ->
case input i of
c:cs -> alexGetByte Inp { alexPos = move (alexPos i) c
, alexInputPrevChar = c
, input = cs
, moreBytes = encodeChar c
}
[] -> Nothing
data Layout = Layout | NoLayout
--------------------------------------------------------------------------------
-- | Drop white-space tokens from the input.
dropWhite :: [Located Token] -> [Located Token]
dropWhite = filter (notWhite . tokenType . thing)
where notWhite (White _) = False
notWhite _ = True
data Block = Virtual Int -- ^ Virtual layout block
| Explicit TokenT -- ^ An explicit layout block, expecting this ending
-- token.
deriving (Show)
isExplicit :: Block -> Bool
isExplicit Explicit{} = True
isExplicit Virtual{} = False
startsLayout :: TokenT -> Bool
startsLayout (KW KW_where) = True
startsLayout (KW KW_private) = True
startsLayout _ = False
-- Add separators computed from layout
layout :: Config -> [Located Token] -> [Located Token]
layout cfg ts0 = loop implicitScope [] ts0
where
(_pos0,implicitScope) = case ts0 of
t : _ -> (from (srcRange t), cfgModuleScope cfg && tokenType (thing t) /= KW KW_module)
_ -> (start,False)
loop :: Bool -> [Block] -> [Located Token] -> [Located Token]
loop startBlock stack (t : ts)
| startsLayout ty = toks ++ loop True stack' ts
| Sym ParenL <- ty = toks ++ loop False (Explicit (Sym ParenR) : stack') ts
| Sym CurlyL <- ty = toks ++ loop False (Explicit (Sym CurlyR) : stack') ts
| Sym BracketL <- ty = toks ++ loop False (Explicit (Sym BracketR) : stack') ts
| EOF <- ty = toks
| otherwise = toks ++ loop False stack' ts
where
ty = tokenType (thing t)
pos = srcRange t
(toks,offStack) = offsides startToks t stack
-- add any block start tokens, and push a level on the stack
(startToks,stack')
| startBlock && ty == EOF = ( [ virt cfg (to pos) VCurlyR
, virt cfg (to pos) VCurlyL ]
, offStack )
| startBlock = ( [ virt cfg (to pos) VCurlyL ], Virtual (col (from pos)) : offStack )
| otherwise = ( [], offStack )
loop _ _ [] = panic "[Lexer] layout" ["Missing EOF token"]
offsides :: [Located Token] -> Located Token -> [Block] -> ([Located Token], [Block])
offsides startToks t = go startToks
where
go virts stack = case stack of
-- delimit or close a layout block
Virtual c : rest
-- commas only close to an explicit marker, so if there is none, the
-- comma doesn't close anything
| Sym Comma == ty ->
if any isExplicit rest
then go (virt cfg (to pos) VCurlyR : virts) rest
else done virts stack
| closingToken -> go (virt cfg (to pos) VCurlyR : virts) rest
| col (from pos) == c -> done (virt cfg (to pos) VSemi : virts) stack
| col (from pos) < c -> go (virt cfg (to pos) VCurlyR : virts) rest
-- close an explicit block
Explicit close : rest | close == ty -> done virts rest
| Sym Comma == ty -> done virts stack
_ -> done virts stack
ty = tokenType (thing t)
pos = srcRange t
done ts s = (reverse (t:ts), s)
closingToken = ty `elem` [ Sym ParenR, Sym BracketR, Sym CurlyR ]
virt :: Config -> Position -> TokenV -> Located Token
virt cfg pos x = Located { srcRange = Range
{ from = pos
, to = pos
, source = cfgSource cfg
}
, thing = t }
where t = Token (Virt x) $ case x of
VCurlyL -> "beginning of layout block"
VCurlyR -> "end of layout block"
VSemi -> "layout block separator"
--------------------------------------------------------------------------------
data Token = Token { tokenType :: TokenT, tokenText :: String }
deriving Show
-- | Virtual tokens, inserted by layout processing.
data TokenV = VCurlyL| VCurlyR | VSemi
deriving (Eq,Show)
data TokenW = BlockComment | LineComment | Space
deriving (Eq,Show)
data TokenKW = KW_Arith
| KW_Bit
| KW_Cmp
| KW_False
| KW_True
| KW_else
| KW_Eq
| KW_error
| KW_extern
| KW_fin
| KW_if
| KW_private
| KW_include
| KW_inf
| KW_join
| KW_lg2
| KW_lengthFromThen
| KW_lengthFromThenTo
| KW_max
| KW_min
| KW_module
| KW_newtype
| KW_pragma
| KW_pmult
| KW_pdiv
| KW_pmod
| KW_property
| KW_random
| KW_reverse
| KW_split
| KW_splitAt
| KW_then
| KW_transpose
| KW_type
| KW_where
| KW_let
| KW_x
| KW_zero
| KW_import
| KW_as
| KW_hiding
deriving (Eq,Show)
data TokenOp = Plus | Minus | Mul | Div | Exp | Mod
| NotEqual | Equal | LessThan | GreaterThan | LEQ | GEQ
| EqualFun | NotEqualFun
| ShiftL | ShiftR | RotL | RotR
| Conj | Disj | Xor
| Complement
| Bang | BangBang | At | AtAt | Hash
deriving (Eq,Show)
data TokenSym = Bar
| ArrL | ArrR | FatArrR
| Lambda
| EqDef
| Comma
| Semi
| Dot
| DotDot
| DotDotDot
| Colon
| ColonColon
| BackTick
| ParenL | ParenR
| BracketL | BracketR
| CurlyL | CurlyR
| TriL | TriR
| Underscore
deriving (Eq,Show)
data TokenErr = UnterminatedComment
| UnterminatedString
| UnterminatedChar
| InvalidString
| InvalidChar
| LexicalError
deriving (Eq,Show)
data TokenT = Num Integer Int Int -- ^ value, base, number of digits
| ChrLit Char -- ^ character literal
| Ident String -- ^ identifier
| StrLit String -- ^ string literal
| KW TokenKW -- ^ keyword
| Op TokenOp -- ^ operator
| Sym TokenSym -- ^ symbol
| Virt TokenV -- ^ virtual token (for layout)
| White TokenW -- ^ white space token
| Err TokenErr -- ^ error token
| EOF
deriving (Eq,Show)
instance PP Token where
ppPrec _ (Token _ s) = text s
cryptol-2.2.6/src/Cryptol/Parser/Names.hs 0000644 0000000 0000000 00000022407 12637103426 016472 0 ustar 00 0000000 0000000 -- |
-- Module : $Header$
-- Copyright : (c) 2013-2015 Galois, Inc.
-- License : BSD3
-- Maintainer : cryptol@galois.com
-- Stability : provisional
-- Portability : portable
--
-- This module defines the scoping rules for value- and type-level
-- names in Cryptol.
module Cryptol.Parser.Names where
import Cryptol.Parser.AST
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Foldable (fold)
modExports :: Module -> ExportSpec
modExports m = fold (concat [ exportedNames d | d <- mDecls m ])
where
names by td = [ td { tlValue = thing n } | n <- fst (by (tlValue td)) ]
exportedNames (Decl td) = map exportBind (names namesD td)
++ map exportType (names tnamesD td)
exportedNames (TDNewtype nt) = map exportType (names tnamesNT nt)
exportedNames (Include {}) = []
-- | The names defined by a newtype.
tnamesNT :: Newtype -> ([Located QName], ())
tnamesNT x = ([ nName x ], ())
-- | The names defined and used by a group of mutually recursive declarations.
namesDs :: [Decl] -> ([Located QName], Set QName)
namesDs ds = (defs, boundNames defs (Set.unions frees))
where
defs = concat defss
(defss,frees) = unzip (map namesD ds)
-- | The names defined and used by a single declarations.
namesD :: Decl -> ([Located QName], Set QName)
namesD decl =
case decl of
DBind b -> namesB b
DPatBind p e -> (namesP p, namesE e)
DSignature {} -> ([],Set.empty)
DPragma {} -> ([],Set.empty)
DType {} -> ([],Set.empty)
DLocated d _ -> namesD d
-- | The names defined and used by a single declarations in such a way
-- that they cannot be duplicated in a file. For example, it is fine
-- to use @x@ on the RHS of two bindings, but not on the LHS of two
-- type signatures.
allNamesD :: Decl -> [Located QName]
allNamesD decl =
case decl of
DBind b -> fst (namesB b)
DPatBind p _ -> namesP p
DSignature ns _ -> ns
DPragma ns _ -> ns
DType ts -> [tsName ts]
DLocated d _ -> allNamesD d
tsName :: TySyn -> Located QName
tsName (TySyn lqn _ _) = lqn
-- | The names defined and used by a single binding.
namesB :: Bind -> ([Located QName], Set QName)
namesB b = ([bName b], boundNames (namesPs (bParams b)) (namesE (bDef b)))
-- | The names used by an expression.
namesE :: Expr -> Set QName
namesE expr =
case expr of
EVar x -> Set.singleton x
ECon _ -> Set.empty
ELit _ -> Set.empty
ETuple es -> Set.unions (map namesE es)
ERecord fs -> Set.unions (map (namesE . value) fs)
ESel e _ -> namesE e
EList es -> Set.unions (map namesE es)
EFromTo _ _ _ -> Set.empty
EInfFrom e e' -> Set.union (namesE e) (maybe Set.empty namesE e')
EComp e arms -> let (dss,uss) = unzip (map namesArm arms)
in Set.union (boundNames (concat dss) (namesE e))
(Set.unions uss)
EApp e1 e2 -> Set.union (namesE e1) (namesE e2)
EAppT e _ -> namesE e
EIf e1 e2 e3 -> Set.union (namesE e1) (Set.union (namesE e2) (namesE e3))
EWhere e ds -> let (bs,xs) = namesDs ds
in Set.union (boundNames bs (namesE e)) xs
ETyped e _ -> namesE e
ETypeVal _ -> Set.empty
EFun ps e -> boundNames (namesPs ps) (namesE e)
ELocated e _ -> namesE e
-- | The names defined by a group of patterns.
namesPs :: [Pattern] -> [Located QName]
namesPs = concatMap namesP
-- | The names defined by a pattern. These will always be unqualified names.
namesP :: Pattern -> [Located QName]
namesP pat =
case pat of
PVar x -> [fmap mkUnqual x]
PWild -> []
PTuple ps -> namesPs ps
PRecord fs -> namesPs (map value fs)
PList ps -> namesPs ps
PTyped p _ -> namesP p
PSplit p1 p2 -> namesPs [p1,p2]
PLocated p _ -> namesP p
-- | The names defined and used by a match.
namesM :: Match -> ([Located QName], Set QName)
namesM (Match p e) = (namesP p, namesE e)
namesM (MatchLet b) = namesB b
-- | The names defined and used by an arm of alist comprehension.
namesArm :: [Match] -> ([Located QName], Set QName)
namesArm = foldr combine ([],Set.empty) . map namesM
where combine (ds1,fs1) (ds2,fs2) =
( filter ((`notElem` map thing ds2) . thing) ds1 ++ ds2
, Set.union fs1 (boundNames ds1 fs2)
)
-- | Remove some defined variables from a set of free variables.
boundNames :: [Located QName] -> Set QName -> Set QName
boundNames bs xs = Set.difference xs (Set.fromList (map thing bs))
-- | Given the set of type variables that are in scope,
-- compute the type synonyms used by a type.
namesT :: Set QName -> Type -> Set QName
namesT vs = go
where
go ty =
case ty of
TWild -> Set.empty
TFun t1 t2 -> Set.union (go t1) (go t2)
TSeq t1 t2 -> Set.union (go t1) (go t2)
TBit -> Set.empty
TNum _ -> Set.empty
TChar _ -> Set.empty
TInf -> Set.empty
TApp _ ts -> Set.unions (map go ts)
TTuple ts -> Set.unions (map go ts)
TRecord fs -> Set.unions (map (go . value) fs)
TLocated t _ -> go t
TUser x [] | x `Set.member` vs
-> Set.empty
TUser x ts -> Set.insert x (Set.unions (map go ts))
-- | The type names defined and used by a group of mutually recursive declarations.
tnamesDs :: [Decl] -> ([Located QName], Set QName)
tnamesDs ds = (defs, boundNames defs (Set.unions frees))
where
defs = concat defss
(defss,frees) = unzip (map tnamesD ds)
-- | The type names defined and used by a single declaration.
tnamesD :: Decl -> ([Located QName], Set QName)
tnamesD decl =
case decl of
DSignature _ s -> ([], tnamesS s)
DPragma {} -> ([], Set.empty)
DBind b -> ([], tnamesB b)
DPatBind _ e -> ([], tnamesE e)
DLocated d _ -> tnamesD d
DType (TySyn n ps t) -> ([n], Set.difference (tnamesT t) (Set.fromList (map tpQName ps)))
-- | The type names used by a single binding.
tnamesB :: Bind -> Set QName
tnamesB b = Set.unions [setS, setP, setE]
where
setS = maybe Set.empty tnamesS (bSignature b)
setP = Set.unions (map tnamesP (bParams b))
setE = tnamesE (bDef b)
-- | The type names used by an expression.
tnamesE :: Expr -> Set QName
tnamesE expr =
case expr of
EVar _ -> Set.empty
ECon _ -> Set.empty
ELit _ -> Set.empty
ETuple es -> Set.unions (map tnamesE es)
ERecord fs -> Set.unions (map (tnamesE . value) fs)
ESel e _ -> tnamesE e
EList es -> Set.unions (map tnamesE es)
EFromTo a b c -> Set.union (tnamesT a)
(Set.union (maybe Set.empty tnamesT b) (maybe Set.empty tnamesT c))
EInfFrom e e' -> Set.union (tnamesE e) (maybe Set.empty tnamesE e')
EComp e mss -> Set.union (tnamesE e) (Set.unions (map tnamesM (concat mss)))
EApp e1 e2 -> Set.union (tnamesE e1) (tnamesE e2)
EAppT e fs -> Set.union (tnamesE e) (Set.unions (map tnamesTI fs))
EIf e1 e2 e3 -> Set.union (tnamesE e1) (Set.union (tnamesE e2) (tnamesE e3))
EWhere e ds -> let (bs,xs) = tnamesDs ds
in Set.union (boundNames bs (tnamesE e)) xs
ETyped e t -> Set.union (tnamesE e) (tnamesT t)
ETypeVal t -> tnamesT t
EFun ps e -> Set.union (Set.unions (map tnamesP ps)) (tnamesE e)
ELocated e _ -> tnamesE e
tnamesTI :: TypeInst -> Set QName
tnamesTI (NamedInst f) = tnamesT (value f)
tnamesTI (PosInst t) = tnamesT t
-- | The type names used by a pattern.
tnamesP :: Pattern -> Set QName
tnamesP pat =
case pat of
PVar _ -> Set.empty
PWild -> Set.empty
PTuple ps -> Set.unions (map tnamesP ps)
PRecord fs -> Set.unions (map (tnamesP . value) fs)
PList ps -> Set.unions (map tnamesP ps)
PTyped p t -> Set.union (tnamesP p) (tnamesT t)
PSplit p1 p2 -> Set.union (tnamesP p1) (tnamesP p2)
PLocated p _ -> tnamesP p
-- | The type names used by a match.
tnamesM :: Match -> Set QName
tnamesM (Match p e) = Set.union (tnamesP p) (tnamesE e)
tnamesM (MatchLet b) = tnamesB b
-- | The type names used by a type schema.
tnamesS :: Schema -> Set QName
tnamesS (Forall params props ty _) =
Set.difference (Set.union (Set.unions (map tnamesC props)) (tnamesT ty))
(Set.fromList (map tpQName params))
-- | The type names used by a prop.
tnamesC :: Prop -> Set QName
tnamesC prop =
case prop of
CFin t -> tnamesT t
CEqual t1 t2 -> Set.union (tnamesT t1) (tnamesT t2)
CGeq t1 t2 -> Set.union (tnamesT t1) (tnamesT t2)
CArith t -> tnamesT t
CCmp t -> tnamesT t
CLocated p _ -> tnamesC p
-- | Compute the type synonyms/type variables used by a type.
tnamesT :: Type -> Set QName
tnamesT ty =
case ty of
TWild -> Set.empty
TFun t1 t2 -> Set.union (tnamesT t1) (tnamesT t2)
TSeq t1 t2 -> Set.union (tnamesT t1) (tnamesT t2)
TBit -> Set.empty
TNum _ -> Set.empty
TChar __ -> Set.empty
TInf -> Set.empty
TApp _ ts -> Set.unions (map tnamesT ts)
TTuple ts -> Set.unions (map tnamesT ts)
TRecord fs -> Set.unions (map (tnamesT . value) fs)
TLocated t _ -> tnamesT t
TUser x ts -> Set.insert x (Set.unions (map tnamesT ts))
cryptol-2.2.6/src/Cryptol/Parser/NoInclude.hs 0000644 0000000 0000000 00000010404 12637103426 017301 0 ustar 00 0000000 0000000 -- |
-- Module : $Header$
-- Copyright : (c) 2013-2015 Galois, Inc.
-- License : BSD3
-- Maintainer : cryptol@galois.com
-- Stability : provisional
-- Portability : portable
module Cryptol.Parser.NoInclude
( removeIncludes
, removeIncludesModule
, IncludeError(..), ppIncludeError
) where
import Cryptol.Parser (parseProgramWith)
import Cryptol.Parser.AST
import Cryptol.Parser.LexerUtils (Config(..),defaultConfig)
import Cryptol.Parser.ParserUtils
import Cryptol.Utils.PP
import qualified Control.Applicative as A
import Data.Either (partitionEithers)
import MonadLib
import qualified Control.Exception as X
removeIncludes :: Program -> IO (Either [IncludeError] Program)
removeIncludes prog = runNoIncM (noIncludeProgram prog)
removeIncludesModule :: Module -> IO (Either [IncludeError] Module)
removeIncludesModule m = runNoIncM (noIncludeModule m)
data IncludeError
= IncludeFailed (Located FilePath)
| IncludeParseError ParseError
| IncludeCycle [Located FilePath]
deriving (Show)
ppIncludeError :: IncludeError -> Doc
ppIncludeError ie = case ie of
IncludeFailed lp -> (char '`' <> text (thing lp) <> char '`')
<+> text "included at"
<+> pp (srcRange lp)
<+> text "was not found"
IncludeParseError pe -> ppError pe
IncludeCycle is -> text "includes form a cycle:"
$$ nest 2 (vcat (map (pp . srcRange) is))
newtype NoIncM a = M
{ unM :: ReaderT [Located FilePath] (ExceptionT [IncludeError] IO) a }
runNoIncM :: NoIncM a -> IO (Either [IncludeError] a)
runNoIncM m = runM (unM m) []
tryNoIncM :: NoIncM a -> NoIncM (Either [IncludeError] a)
tryNoIncM m = M (try (unM m))
instance Functor NoIncM where
fmap = liftM
instance A.Applicative NoIncM where
pure = return
(<*>) = ap
instance Monad NoIncM where
return x = M (return x)
m >>= f = M (unM m >>= unM . f)
fail x = M (fail x)
-- | Raise an 'IncludeFailed' error.
includeFailed :: Located FilePath -> NoIncM a
includeFailed path = M (raise [IncludeFailed path])
-- | Push a path on the stack of included files, and run an action. If the path
-- is already on the stack, an include cycle has happened, and an error is
-- raised.
pushPath :: Located FilePath -> NoIncM a -> NoIncM a
pushPath path m = M $ do
seen <- ask
let alreadyIncluded l = thing path == thing l
when (any alreadyIncluded seen) (raise [IncludeCycle seen])
local (path:seen) (unM m)
-- | Lift an IO operation, with a way to handle the exception that it might
-- throw.
failsWith :: X.Exception e => IO a -> (e -> NoIncM a) -> NoIncM a
failsWith m k = M $ do
e <- inBase (X.try m)
case e of
Right a -> return a
Left exn -> unM (k exn)
-- | Like 'mapM', but tries to collect as many errors as possible before
-- failing.
collectErrors :: (a -> NoIncM b) -> [a] -> NoIncM [b]
collectErrors f ts = do
es <- mapM (tryNoIncM . f) ts
let (ls,rs) = partitionEithers es
errs = concat ls
unless (null errs) (M (raise errs))
return rs
-- | Remove includes from a module.
noIncludeModule :: Module -> NoIncM Module
noIncludeModule m = update `fmap` collectErrors noIncTopDecl (mDecls m)
where
update tds = m { mDecls = concat tds }
-- | Remove includes from a program.
noIncludeProgram :: Program -> NoIncM Program
noIncludeProgram (Program tds) =
(Program . concat) `fmap` collectErrors noIncTopDecl tds
-- | Substitute top-level includes with the declarations from the files they
-- reference.
noIncTopDecl :: TopDecl -> NoIncM [TopDecl]
noIncTopDecl td = case td of
Decl _ -> return [td]
TDNewtype _-> return [td]
Include lf -> resolveInclude lf
-- | Resolve the file referenced by a include into a list of top-level
-- declarations.
resolveInclude :: Located FilePath -> NoIncM [TopDecl]
resolveInclude lf = pushPath lf $ do
source <- readInclude lf
case parseProgramWith (defaultConfig { cfgSource = thing lf }) source of
Right prog -> do
Program ds <- noIncludeProgram prog
return ds
Left err -> M (raise [IncludeParseError err])
-- | Read a file referenced by an include.
readInclude :: Located FilePath -> NoIncM String
readInclude path = do
source <- readFile (thing path) `failsWith` handler
return source
where
handler :: X.IOException -> NoIncM a
handler _ = includeFailed path
cryptol-2.2.6/src/Cryptol/Parser/NoPat.hs 0000644 0000000 0000000 00000034063 12637103426 016451 0 ustar 00 0000000 0000000 -- |
-- Module : $Header$
-- Copyright : (c) 2013-2015 Galois, Inc.
-- License : BSD3
-- Maintainer : cryptol@galois.com
-- Stability : provisional
-- Portability : portable
--
-- The purpose of this module is to convert all patterns to variable
-- patterns. It also eliminates pattern bindings by de-sugaring them
-- into `Bind`. Furthermore, here we associate signatures and pragmas
-- with the names to which they belong.
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE RecordWildCards #-}
module Cryptol.Parser.NoPat (RemovePatterns(..),Error(..)) where
import Cryptol.Prims.Syntax
import Cryptol.Parser.AST
import Cryptol.Parser.Position(Range(..),start)
import Cryptol.Utils.PP
import Cryptol.Utils.Panic(panic)
import MonadLib
import Data.Maybe(maybeToList)
import Data.Either(partitionEithers)
import qualified Data.Map as Map
#if __GLASGOW_HASKELL__ < 710
import Control.Applicative(Applicative(..),(<$>))
import Data.Traversable(traverse)
#endif
class RemovePatterns t where
-- | Eliminate all patterns in a program.
removePatterns :: t -> (t, [Error])
instance RemovePatterns Program where
removePatterns p = runNoPatM (noPatProg p)
instance RemovePatterns Expr where
removePatterns e = runNoPatM (noPatE e)
instance RemovePatterns Module where
removePatterns m = runNoPatM (noPatModule m)
instance RemovePatterns [Decl] where
removePatterns ds = runNoPatM (noPatDs ds)
simpleBind :: Located QName -> Expr -> Bind
simpleBind x e = Bind { bName = x, bParams = [], bDef = e
, bSignature = Nothing, bPragmas = []
, bMono = True
}
sel :: Pattern -> QName -> Selector -> Bind
sel p x s = let (a,ts) = splitSimpleP p
in simpleBind a (foldl ETyped (ESel (EVar x) s) ts)
-- | Given a pattern, transform it into a simple pattern and a set of bindings.
-- Simple patterns may only contain variables and type annotations.
-- XXX: We can replace the types in the selcetors with annotations on the bindings.
noPat :: Pattern -> NoPatM (Pattern, [Bind])
noPat pat =
case pat of
PVar x -> return (PVar x, [])
PWild ->
do x <- newName
r <- getRange
return (pVar r x, [])
PTuple ps ->
do (as,dss) <- unzip `fmap` mapM noPat ps
x <- newName
r <- getRange
let qx = mkUnqual x
let len = length ps
ty = TTuple (replicate len TWild)
getN a n = sel a qx (TupleSel n (Just len))
return (pTy r x ty, zipWith getN as [0..] ++ concat dss)
PList [] ->
do x <- newName
r <- getRange
return (pTy r x (TSeq (TNum 0) TWild), [])
PList ps ->
do (as,dss) <- unzip `fmap` mapM noPat ps
x <- newName
r <- getRange
let qx = mkUnqual x
len = length ps
ty = TSeq (TNum (fromIntegral len)) TWild
getN a n = sel a qx (ListSel n (Just len))
return (pTy r x ty, zipWith getN as [0..] ++ concat dss)
PRecord fs ->
do (as,dss) <- unzip `fmap` mapM (noPat . value) fs
x <- newName
r <- getRange
let qx = mkUnqual x
shape = map (thing . name) fs
ty = TRecord (map (fmap (\_ -> TWild)) fs)
getN a n = sel a qx (RecordSel n (Just shape))
return (pTy r x ty, zipWith getN as shape ++ concat dss)
PTyped p t ->
do (a,ds) <- noPat p
return (PTyped a t, ds)
-- XXX: Ww can do more with type annotations here
PSplit p1 p2 ->
do (a1,ds1) <- noPat p1
(a2,ds2) <- noPat p2
x <- newName
tmp <- newName
r <- getRange
let qx = mkUnqual x
qtmp = mkUnqual tmp
bTmp = simpleBind (Located r qtmp) (EApp (ECon ECSplitAt) (EVar qx))
b1 = sel a1 qtmp (TupleSel 0 (Just 2))
b2 = sel a2 qtmp (TupleSel 1 (Just 2))
return (pVar r x, bTmp : b1 : b2 : ds1 ++ ds2)
PLocated p r1 -> inRange r1 (noPat p)
where
pVar r x = PVar (Located r x)
pTy r x t = PTyped (PVar (Located r x)) t
splitSimpleP :: Pattern -> (Located QName, [Type])
splitSimpleP (PVar x) = (fmap mkUnqual x, [])
splitSimpleP (PTyped p t) = let (x,ts) = splitSimpleP p
in (x, t:ts)
splitSimpleP p = panic "splitSimpleP"
[ "Non-simple pattern", show p ]
--------------------------------------------------------------------------------
noPatE :: Expr -> NoPatM Expr
noPatE expr =
case expr of
EVar {} -> return expr
ECon {} -> return expr
ELit {} -> return expr
ETuple es -> ETuple <$> mapM noPatE es
ERecord es -> ERecord <$> mapM noPatF es
ESel e s -> ESel <$> noPatE e <*> return s
EList es -> EList <$> mapM noPatE es
EFromTo {} -> return expr
EInfFrom e e' -> EInfFrom <$> noPatE e <*> traverse noPatE e'
EComp e mss -> EComp <$> noPatE e <*> mapM noPatArm mss
EApp e1 e2 -> EApp <$> noPatE e1 <*> noPatE e2
EAppT e ts -> EAppT <$> noPatE e <*> return ts
EIf e1 e2 e3 -> EIf <$> noPatE e1 <*> noPatE e2 <*> noPatE e3
EWhere e ds -> EWhere <$> noPatE e <*> noPatDs ds
ETyped e t -> ETyped <$> noPatE e <*> return t
ETypeVal {} -> return expr
EFun ps e -> do (ps1,e1) <- noPatFun ps e
return (EFun ps1 e1)
ELocated e r1 -> ELocated <$> inRange r1 (noPatE e) <*> return r1
where noPatF x = do e <- noPatE (value x)
return x { value = e }
noPatFun :: [Pattern] -> Expr -> NoPatM ([Pattern], Expr)
noPatFun ps e =
do (xs,bs) <- unzip <$> mapM noPat ps
e1 <- noPatE e
let body = case concat bs of
[] -> e1
ds -> EWhere e1 $ map DBind ds
return (xs, body)
noPatArm :: [Match] -> NoPatM [Match]
noPatArm ms = concat <$> mapM noPatM ms
noPatM :: Match -> NoPatM [Match]
noPatM (Match p e) =
do (x,bs) <- noPat p
e1 <- noPatE e
return (Match x e1 : map MatchLet bs)
noPatM (MatchLet b) = (return . MatchLet) <$> noMatchB b
noMatchB :: Bind -> NoPatM Bind
noMatchB b =
do (ps,e) <- noPatFun (bParams b) (bDef b)
return b { bParams = ps, bDef = e }
noMatchD :: Decl -> NoPatM [Decl]
noMatchD decl =
case decl of
DSignature {} -> return [decl]
DPragma {} -> return [decl]
DBind b -> do b1 <- noMatchB b
return [DBind b1]
DPatBind p e -> do (p',bs) <- noPat p
let (x,ts) = splitSimpleP p'
e1 <- noPatE e
let e2 = foldl ETyped e1 ts
return $ DBind Bind { bName = x
, bParams = []
, bDef = e2
, bSignature = Nothing
, bPragmas = []
, bMono = False
} : map DBind bs
DType {} -> return [decl]
DLocated d r1 -> do bs <- inRange r1 $ noMatchD d
return $ map (`DLocated` r1) bs
noPatDs :: [Decl] -> NoPatM [Decl]
noPatDs ds =
do ds1 <- concat <$> mapM noMatchD ds
let pragmaMap = Map.fromListWith (++) $ concatMap toPragma ds1
sigMap = Map.fromListWith (++) $ concatMap toSig ds1
(ds2, (pMap,sMap)) <- runStateT (pragmaMap, sigMap) $ annotDs ds1
forM_ (Map.toList pMap) $ \(n,ps) ->
forM_ ps $ \p -> recordError $ PragmaNoBind (p { thing = n }) (thing p)
forM_ (Map.toList sMap) $ \(n,ss) ->
do _ <- checkSigs n ss
forM_ ss $ \s -> recordError $ SignatureNoBind (s { thing = n })
(thing s)
return ds2
noPatTopDs :: [TopLevel Decl] -> NoPatM [TopLevel Decl]
noPatTopDs tds =
do noPatGroups <- mapM (noMatchD . tlValue) tds
let allDecls = concat noPatGroups
pragmaMap = Map.fromListWith (++) $ concatMap toPragma allDecls
sigMap = Map.fromListWith (++) $ concatMap toSig allDecls
let exportGroups = zipWith (\ td ds -> td { tlValue = ds }) tds noPatGroups
(tds', (pMap,sMap)) <- runStateT (pragmaMap,sigMap) (annotTopDs exportGroups)
forM_ (Map.toList pMap) $ \(n,ps) ->
forM_ ps $ \p -> recordError $ PragmaNoBind (p { thing = n }) (thing p)
forM_ (Map.toList sMap) $ \(n,ss) ->
do _ <- checkSigs n ss
forM_ ss $ \s -> recordError $ SignatureNoBind (s { thing = n })
(thing s)
return tds'
noPatProg :: Program -> NoPatM Program
noPatProg (Program topDs) =
do let (ds, others) = partitionEithers (map isDecl topDs)
ds1 <- noPatTopDs ds
return $ Program $ others ++ map Decl ds1
where
isDecl (Decl d) = Left d
isDecl d = Right d
noPatModule :: Module -> NoPatM Module
noPatModule m =
do let (ds, others) = partitionEithers (map isDecl (mDecls m))
ds1 <- noPatTopDs ds
return m { mDecls = others ++ map Decl ds1 }
where
isDecl (Decl d) = Left d
isDecl d = Right d
--------------------------------------------------------------------------------
type AnnotMap = ( Map.Map QName [Located Pragma]
, Map.Map QName [Located Schema]
)
-- | Add annotations to exported declaration groups.
--
-- XXX: This isn't quite right: if a signature and binding have different
-- export specifications, this will favor the specification of the binding.
-- This is most likely the intended behavior, so it's probably fine, but it does
-- smell a bit.
annotTopDs :: [TopLevel [Decl]] -> StateT AnnotMap NoPatM [TopLevel Decl]
annotTopDs tds =
case tds of
(ds:dss) ->
do ds' <- annotDs (tlValue ds)
rest <- annotTopDs dss
if null ds'
then return rest
else return ([ ds { tlValue = d } | d <- ds' ] ++ rest)
[] -> return []
-- | Add annotations, keeping track of which annotation are not yet used up.
annotDs :: [Decl] -> StateT AnnotMap NoPatM [Decl]
annotDs (d : ds) =
do ignore <- runExceptionT (annotD d)
case ignore of
Left () -> annotDs ds
Right d1 -> (d1 :) <$> annotDs ds
annotDs [] = return []
-- | Add annotations, keeping track of which annotation are not yet used up.
-- The exception indicates which declarations are no longer needed.
annotD :: Decl -> ExceptionT () (StateT AnnotMap NoPatM) Decl
annotD decl =
case decl of
DBind b -> DBind <$> lift (annotB b)
DSignature {} -> raise ()
DPragma {} -> raise ()
DPatBind {} -> raise ()
DType {} -> return decl
DLocated d r -> (`DLocated` r) <$> annotD d
-- | Add pragma/signature annotations to a binding.
annotB :: Bind -> StateT AnnotMap NoPatM Bind
annotB Bind { .. } =
do (ps,ss) <- get
let name = thing bName
case ( Map.updateLookupWithKey (\_ _ -> Nothing) name ps
, Map.updateLookupWithKey (\_ _ -> Nothing) name ss
) of
( (thisPs, pragmas1) , (thisSigs, sigs1)) ->
do s <- lift $ checkSigs name (jn thisSigs)
set (pragmas1,sigs1)
return Bind { bSignature = s
, bPragmas = map thing (jn thisPs) ++ bPragmas
, ..
}
where jn x = concat (maybeToList x)
-- | Check for multiple signatures.
checkSigs :: QName -> [Located Schema] -> NoPatM (Maybe Schema)
checkSigs _ [] = return Nothing
checkSigs _ [s] = return (Just (thing s))
checkSigs f xs@(s : _ : _) = do recordError $ MultipleSignatures f xs
return (Just (thing s))
-- | Does this declaration provide some signatures?
toSig :: Decl -> [(QName, [Located Schema])]
toSig (DLocated d _) = toSig d
toSig (DSignature xs s) = [ (thing x,[Located (srcRange x) s]) | x <- xs ]
toSig _ = []
-- | Does this declaration provide some signatures?
toPragma :: Decl -> [(QName, [Located Pragma])]
toPragma (DLocated d _) = toPragma d
toPragma (DPragma xs s) = [ (thing x,[Located (srcRange x) s]) | x <- xs ]
toPragma _ = []
--------------------------------------------------------------------------------
newtype NoPatM a = M { unM :: ReaderT Range (StateT RW Id) a }
data RW = RW { names :: !Int, errors :: [Error] }
data Error = MultipleSignatures QName [Located Schema]
| SignatureNoBind (Located QName) Schema
| PragmaNoBind (Located QName) Pragma
deriving (Show)
instance Functor NoPatM where fmap = liftM
instance Applicative NoPatM where pure = return; (<*>) = ap
instance Monad NoPatM where
return x = M (return x)
fail x = M (fail x)
M x >>= k = M (x >>= unM . k)
-- | Pick a new name, to be used when desugaring patterns.
newName :: NoPatM Name
newName = M $ sets $ \s -> let x = names s
in (NewName NoPat x, s { names = x + 1 })
-- | Record an error.
recordError :: Error -> NoPatM ()
recordError e = M $ sets_ $ \s -> s { errors = e : errors s }
getRange :: NoPatM Range
getRange = M ask
inRange :: Range -> NoPatM a -> NoPatM a
inRange r m = M $ local r $ unM m
runNoPatM :: NoPatM a -> (a, [Error])
runNoPatM m
= getErrs
$ runId
$ runStateT RW { names = 0, errors = [] }
$ runReaderT (Range start start "") -- hm
$ unM m
where getErrs (a,rw) = (a, errors rw)
--------------------------------------------------------------------------------
instance PP Error where
ppPrec _ err =
case err of
MultipleSignatures x ss ->
text "Multiple type signatures for" <+> quotes (pp x)
$$ nest 2 (vcat (map pp ss))
SignatureNoBind x s ->
text "At" <+> pp (srcRange x) <> colon <+>
text "Type signature without a matching binding:"
$$ nest 2 (pp s)
PragmaNoBind x s ->
text "At" <+> pp (srcRange x) <> colon <+>
text "Pragma without a matching binding:"
$$ nest 2 (pp s)
cryptol-2.2.6/src/Cryptol/Parser/ParserUtils.hs 0000644 0000000 0000000 00000025615 12637103426 017710 0 ustar 00 0000000 0000000 -- |
-- Module : $Header$
-- Copyright : (c) 2013-2015 Galois, Inc.
-- License : BSD3
-- Maintainer : cryptol@galois.com
-- Stability : provisional
-- Portability : portable
{-# LANGUAGE Safe, PatternGuards #-}
module Cryptol.Parser.ParserUtils where
import Cryptol.Parser.AST
import Cryptol.Parser.Lexer
import Cryptol.Parser.Position
import Cryptol.Prims.Syntax
import Cryptol.Parser.Utils (translateExprToNumT)
import Cryptol.Utils.PP
import Cryptol.Utils.Panic
import Data.Maybe(listToMaybe,fromMaybe)
import Data.Bits(testBit,setBit)
import Control.Monad(liftM,ap)
#if __GLASGOW_HASKELL__ < 710
import Control.Applicative ((<$>),Applicative(..))
import Data.Traversable (mapM)
import Prelude hiding (mapM)
#endif
parse :: Config -> ParseM a -> String -> Either ParseError a
parse cfg p cs = case unP p cfg eofPos (S toks) of
Left err -> Left err
Right (a,_) -> Right a
where (toks,eofPos) = lexer cfg cs
{- The parser is parameterized by the pozition of the final token. -}
data ParseM a = P { unP :: Config -> Position -> S -> Either ParseError (a,S) }
lexerP :: (Located Token -> ParseM a) -> ParseM a
lexerP k = P $ \cfg p (S ts) ->
case ts of
t : _ | Err e <- tokenType it ->
Left $ HappyErrorMsg (srcRange t) $
case e of
UnterminatedComment -> "unterminated comment"
UnterminatedString -> "unterminated string"
UnterminatedChar -> "unterminated character"
InvalidString -> "invalid string literal: " ++ tokenText it
InvalidChar -> "invalid character literal: " ++ tokenText it
LexicalError -> "lexical error: " ++ tokenText it
where it = thing t
t : more -> unP (k t) cfg p (S more)
[] -> Left (HappyError (cfgSource cfg) p Nothing)
data ParseError = HappyError FilePath Position (Maybe Token)
| HappyErrorMsg Range String
deriving Show
newtype S = S [Located Token]
instance PP ParseError where
ppPrec _ (HappyError _ _ tok) = case tok of
Nothing -> text "end of input"
Just t -> pp t
ppPrec _ (HappyErrorMsg _ x) = text x
ppError :: ParseError -> Doc
ppError (HappyError path pos (Just tok))
| Err _ <- tokenType tok = text "Parse error at" <+>
text path <> char ':' <> pp pos <> comma <+>
pp tok
ppError e@(HappyError path pos _) =
text "Parse error at" <+>
text path <> char ':' <> pp pos <> comma <+>
text "unexpected" <+> pp e
ppError (HappyErrorMsg p x) = text "Parse error at" <+> pp p $$ nest 2 (text x)
instance Monad ParseM where
return a = P (\_ _ s -> Right (a,s))
fail s = panic "[Parser] fail" [s]
m >>= k = P (\cfg p s1 -> case unP m cfg p s1 of
Left e -> Left e
Right (a,s2) -> unP (k a) cfg p s2)
instance Functor ParseM where
fmap = liftM
instance Applicative ParseM where
pure = return
(<*>) = ap
happyError :: ParseM a
happyError = P $ \cfg p (S ls) ->
Left $ case listToMaybe ls of
Nothing -> HappyError (cfgSource cfg) p Nothing
Just l -> HappyError (cfgSource cfg) (from (srcRange l)) (Just (thing l))
errorMessage :: Range -> String -> ParseM a
errorMessage r x = P $ \_ _ _ -> Left (HappyErrorMsg r x)
customError :: String -> Located Token -> ParseM a
customError x t = P $ \_ _ _ -> Left (HappyErrorMsg (srcRange t) x)
mkModName :: {-reversed-} [LName] -> Located ModName
mkModName xs = Located { srcRange = rComb (srcRange f) (srcRange l)
, thing = ModName [ x | Name x <- map thing ns ]
}
where l : _ = xs
ns@(f : _) = reverse xs
mkQName :: {-reversed-} [LName] -> Located QName
mkQName [x] = fmap mkUnqual x
mkQName xs =
Located { srcRange = rComb (srcRange f) (srcRange l)
, thing = mkQual (ModName [ x | Name x <- map thing ns ]) (thing l)
}
where l : ls = xs
ns@(f : _) = reverse ls
-- Note that type variables are not resolved at this point: they are tcons.
mkSchema :: [TParam] -> [Prop] -> Type -> Schema
mkSchema xs ps t = Forall xs ps t Nothing
getName :: Located Token -> Name
getName l = case thing l of
Token (Ident x) _ -> Name x
_ -> panic "[Parser] getName" ["not an Ident:", show l]
getNum :: Located Token -> Integer
getNum l = case thing l of
Token (Num x _ _) _ -> x
Token (ChrLit x) _ -> fromIntegral (fromEnum x)
_ -> panic "[Parser] getNum" ["not a number:", show l]
getStr :: Located Token -> String
getStr l = case thing l of
Token (StrLit x) _ -> x
_ -> panic "[Parser] getStr" ["not a string:", show l]
numLit :: TokenT -> Expr
numLit (Num x base digs)
| base == 2 = ELit $ ECNum x (BinLit digs)
| base == 8 = ELit $ ECNum x (OctLit digs)
| base == 10 = ELit $ ECNum x DecLit
| base == 16 = ELit $ ECNum x (HexLit digs)
numLit x = panic "[Parser] numLit" ["invalid numeric literal", show x]
mkTupleSel :: Range -> Integer -> ParseM (Located Selector)
mkTupleSel pos n
| n < 0 = errorMessage pos
(show n ++ " is not a valid tuple selector (they start from 0).")
| toInteger asInt /= n = errorMessage pos "Tuple selector is too large."
| otherwise = return $ Located pos $ TupleSel asInt Nothing
where asInt = fromInteger n
fromStrLit :: Located Token -> ParseM (Located String)
fromStrLit loc = case tokenType (thing loc) of
StrLit str -> return loc { thing = str }
_ -> errorMessage (srcRange loc) "Expected a string literal"
validDemotedType :: Range -> Type -> ParseM Type
validDemotedType rng ty =
case ty of
TLocated t r -> validDemotedType r t
TRecord {} -> bad "Record types"
TTuple {} -> bad "Tuple types"
TFun {} -> bad "Function types"
TSeq {} -> bad "Sequence types"
TBit -> bad "Type bit"
TNum {} -> ok
TChar {} -> ok
TInf -> bad "Infinity type"
TWild -> bad "Wildcard types"
TUser {} -> ok
TApp {} -> ok
where bad x = errorMessage rng (x ++ " cannot be demoted.")
ok = return $ at rng ty
mkEApp :: [Expr] -> Expr
mkEApp es@(eLast : _) = at (eFirst,eLast) $ foldl EApp f xs
where
eFirst : rest = reverse es
f : xs = cvtTypeParams eFirst rest
{- Type applications are parsed as `ETypeVal (TRecord fs)` expressions.
Here we associate them with their corresponding functions,
converting them into `EAppT` constructs. For example:
[ f, x, `{ a = 2 }, y ]
becomes
[ f, x ` { a = 2 }, y ]
-}
cvtTypeParams e [] = [e]
cvtTypeParams e (p : ps) =
case toTypeParam p of
Just fs -> cvtTypeParams (EAppT e fs) ps
Nothing -> e : cvtTypeParams p ps
toTypeParam e =
case dropLoc e of
ETypeVal t -> case dropLoc t of
TRecord fs -> Just (map mkTypeInst fs)
_ -> Nothing
_ -> Nothing
mkEApp es = panic "[Parser] mkEApp" ["Unexpected:", show es]
op :: ECon -> Range -> Expr
op s r = at r (ECon s)
unOp :: Expr -> Expr -> Expr
unOp f x = at (f,x) $ EApp f x
binOp :: Expr -> Expr -> Expr -> Expr
binOp x f y = at (x,y) $ EApp (EApp f x) y
eFromTo :: Range -> Expr -> Maybe Expr -> Maybe Expr -> ParseM Expr
eFromTo r e1 e2 e3 = EFromTo <$> exprToNumT r e1
<*> mapM (exprToNumT r) e2
<*> mapM (exprToNumT r) e3
exprToNumT :: Range -> Expr -> ParseM Type
exprToNumT r expr =
case translateExprToNumT expr of
Just t -> return t
Nothing -> bad
where
bad = errorMessage (fromMaybe r (getLoc expr)) $ unlines
[ "The boundaries of .. sequences should be valid numeric types."
, "The expression `" ++ show (pp expr) ++ "` is not."
, ""
, "If you were trying to specify the width of the elements,"
, "you may add a type annotation outside the sequence. For example:"
, " [ 1 .. 10 ] : [_][16]"
]
-- | WARNING: This is a bit of a hack.
-- It is used to represent anonymous type applications.
anonRecord :: Maybe Range -> [Type] -> Type
anonRecord ~(Just r) ts = TRecord (map toField ts)
where noName = Located { srcRange = r, thing = Name "" }
toField t = Named { name = noName, value = t }
exportDecl :: ExportType -> Decl -> TopDecl
exportDecl e d = Decl TopLevel { tlExport = e, tlValue = d }
exportNewtype :: ExportType -> Newtype -> TopDecl
exportNewtype e n = TDNewtype TopLevel { tlExport = e, tlValue = n }
changeExport :: ExportType -> [TopDecl] -> [TopDecl]
changeExport e = map $ \ td -> case td of
Decl d -> Decl d { tlExport = e }
TDNewtype n -> TDNewtype n { tlExport = e }
Include _ -> td
mkTypeInst :: Named Type -> TypeInst
mkTypeInst x | thing (name x) == Name "" = PosInst (value x)
| otherwise = NamedInst x
mkTParam :: Located Name -> Maybe Kind -> ParseM TParam
mkTParam Located { srcRange = rng, thing = n } k
| Name "width" <- n = errorMessage rng "`width` is not a valid type parameter name."
| otherwise = return (TParam n k (Just rng))
mkTySyn :: Located Name -> [TParam] -> Type -> ParseM Decl
mkTySyn n ps b
| Name "width" <- thing n = errorMessage (srcRange n) "`width` is not a valid type synonym name."
| otherwise = return $ DType $ TySyn (fmap mkUnqual n) ps b
polyTerm :: Range -> Integer -> Integer -> ParseM (Bool, Integer)
polyTerm rng k p
| k == 0 = return (False, p)
| k == 1 = return (True, p)
| otherwise = errorMessage rng "Invalid polynomial coefficient"
mkPoly :: Range -> [ (Bool,Integer) ] -> ParseM Expr
mkPoly rng terms = mk 0 (map fromInteger bits)
where
w = case terms of
[] -> 0
_ -> 1 + maximum (map (fromInteger . snd) terms)
bits = [ n | (True,n) <- terms ]
mk res [] = return $ ELit $ ECNum res (PolyLit w)
mk res (n : ns)
| testBit res n = errorMessage rng
("Polynomial contains multiple terms with exponent "
++ show n)
| otherwise = mk (setBit res n) ns
-- NOTE: The list of patterns is reversed!
mkProperty :: LName -> [Pattern] -> Expr -> Decl
mkProperty f ps e = DBind Bind { bName = fmap mkUnqual f
, bParams = reverse ps
, bDef = ETyped e TBit
, bSignature = Nothing
, bPragmas = [PragmaProperty]
, bMono = False
}
mkIf :: [(Expr, Expr)] -> Expr -> Expr
mkIf ifThens theElse = foldr addIfThen theElse ifThens
where
addIfThen (cond, doexpr) elseExpr = EIf cond doexpr elseExpr
cryptol-2.2.6/src/Cryptol/Parser/Position.hs 0000644 0000000 0000000 00000005721 12637103426 017233 0 ustar 00 0000000 0000000 -- |
-- Module : $Header$
-- Copyright : (c) 2013-2015 Galois, Inc.
-- License : BSD3
-- Maintainer : cryptol@galois.com
-- Stability : provisional
-- Portability : portable
{-# LANGUAGE Safe #-}
module Cryptol.Parser.Position where
import Data.List(foldl')
import Cryptol.Utils.PP
data Located a = Located { srcRange :: !Range, thing :: a }
deriving (Eq,Show)
data Position = Position { line :: !Int, col :: !Int }
deriving (Eq,Ord,Show)
data Range = Range { from :: !Position
, to :: !Position
, source :: FilePath }
deriving (Eq,Show)
-- | An empty range.
--
-- Caution: using this on the LHS of a use of rComb will cause the empty source
-- to propegate.
emptyRange :: Range
emptyRange = Range { from = start, to = start, source = "" }
start :: Position
start = Position { line = 1, col = 1 }
move :: Position -> Char -> Position
move p c = case c of
'\t' -> p { col = ((col p + 7) `div` 8) * 8 + 1 }
'\n' -> p { col = 1, line = 1 + line p }
_ -> p { col = 1 + col p }
moves :: Position -> String -> Position
moves p cs = foldl' move p cs
rComb :: Range -> Range -> Range
rComb r1 r2 = Range { from = rFrom, to = rTo, source = source r1 }
where rFrom = min (from r1) (from r2)
rTo = max (to r1) (to r2)
rCombs :: [Range] -> Range
rCombs = foldl1 rComb
instance Functor Located where
fmap f l = l { thing = f (thing l) }
--------------------------------------------------------------------------------
instance PP Position where
ppPrec _ p = int (line p) <> colon <> int (col p)
instance PP Range where
ppPrec _ r = text (source r) <> char ':'
<> pp (from r) <> text "--" <> pp (to r)
instance PP a => PP (Located a) where
ppPrec _ l = parens (text "at" <+> pp (srcRange l) <> comma <+> pp (thing l))
--------------------------------------------------------------------------------
class HasLoc t where
getLoc :: t -> Maybe Range
instance HasLoc Range where
getLoc r = Just r
instance HasLoc (Located a) where
getLoc r = Just (srcRange r)
instance (HasLoc a, HasLoc b) => HasLoc (a,b) where
getLoc (f,t) = case getLoc f of
Nothing -> getLoc t
Just l ->
case getLoc t of
Nothing -> return l
Just l1 -> return (rComb l l1)
instance HasLoc a => HasLoc [a] where
getLoc = go Nothing
where
go x [] = x
go Nothing (x : xs) = go (getLoc x) xs
go (Just l) (x : xs) = case getLoc x of
Nothing -> go (Just l) xs
Just l1 -> go (Just (rComb l l1)) xs
class HasLoc t => AddLoc t where
addLoc :: t -> Range -> t
dropLoc :: t -> t
instance AddLoc (Located a) where
addLoc t r = t { srcRange = r }
dropLoc r = r
at :: (HasLoc l, AddLoc t) => l -> t -> t
at l e = maybe e (addLoc e) (getLoc l)
cryptol-2.2.6/src/Cryptol/Parser/Unlit.hs 0000644 0000000 0000000 00000007463 12637103426 016527 0 ustar 00 0000000 0000000 -- |
-- Module : $Header$
-- Copyright : (c) 2013-2015 Galois, Inc.
-- License : BSD3
-- Maintainer : cryptol@galois.com
-- Stability : provisional
-- Portability : portable
--
-- Convert a literate source file into an ordinary source file.
{-# LANGUAGE OverloadedStrings, Safe, PatternGuards #-}
module Cryptol.Parser.Unlit
( unLit, PreProc(..), guessPreProc, knownExts
) where
import Data.Text.Lazy (Text)
import qualified Data.Text.Lazy as Text
import Data.Char(isSpace)
import System.FilePath(takeExtension)
import Cryptol.Utils.Panic
data PreProc = None | Markdown | LaTeX
knownExts :: [String]
knownExts =
[ "cry"
, "tex"
, "markdown"
, "md"
]
guessPreProc :: FilePath -> PreProc
guessPreProc file = case takeExtension file of
".tex" -> LaTeX
".markdown" -> Markdown
".md" -> Markdown
_ -> None
unLit :: PreProc -> Text -> Text
unLit None = id
unLit proc = Text.unlines . concatMap toCryptol . preProc proc . Text.lines
preProc :: PreProc -> [Text] -> [Block]
preProc p =
case p of
None -> return . Code
Markdown -> markdown
LaTeX -> latex
data Block = Code [Text] | Comment [Text]
toCryptol :: Block -> [Text]
toCryptol (Code xs) = xs
toCryptol (Comment ls) =
case ls of
[] -> []
[l] -> [ "/* " `Text.append` l `Text.append` " */" ]
l1 : rest -> let (more, l) = splitLast rest
in "/* " `Text.append` l1 : more ++ [ l `Text.append` " */" ]
where
splitLast [] = panic "Cryptol.Parser.Unlit.toCryptol" [ "splitLast []" ]
splitLast [x] = ([], x)
splitLast (x : xs) = let (ys,y) = splitLast xs
in (x:ys,y)
mk :: ([Text] -> Block) -> [Text] -> [Block]
mk _ [] = []
mk c ls = [ c (reverse ls) ]
-- | The preprocessor for `markdown`
markdown :: [Text] -> [Block]
markdown = blanks []
where
comment current [] = mk Comment current
comment current (l : ls)
| isBlank l = blanks (l : current) ls
| otherwise = comment (l : current) ls
blanks current [] = mk Comment current
blanks current (l : ls)
| isCodeLine l = mk Comment current ++ code [l] ls
| Just op <- isOpenFence l = mk Comment (l : current) ++ fenced op [] ls
| isBlank l = blanks (l : current) ls
| otherwise = comment (l : current) ls
code current [] = mk Code current
code current (l : ls)
| isCodeLine l = code (l : current) ls
| otherwise = mk Code current ++ comment [] (l : ls)
fenced op current [] = mk op current -- XXX should this be an error?
fenced op current (l : ls)
| isCloseFence l = mk op current ++ comment [l] ls
| otherwise = fenced op (l : current) ls
isOpenFence l | "```cryptol" == l' = Just Code
| "```" == l' = Just Code
| "```" `Text.isPrefixOf` l' = Just Comment
| otherwise = Nothing
where
l' = Text.dropWhile isSpace l
isCloseFence l = "```" `Text.isPrefixOf` l
isBlank l = Text.all isSpace l
isCodeLine l = "\t" `Text.isPrefixOf` l || " " `Text.isPrefixOf` l
-- | The preprocessor for `latex`
latex :: [Text] -> [Block]
latex = comment []
where
comment current [] = mk Comment current
comment current (l : ls)
| isBeginCode l = mk Comment (l : current) ++ code [] ls
| otherwise = comment (l : current) ls
code current [] = mk Code current
code current (l : ls)
| isEndCode l = mk Code current ++ comment [l] ls
| otherwise = code (l : current) ls
isBeginCode l = "\\begin{code}" `Text.isPrefixOf` l
isEndCode l = "\\end{code}" `Text.isPrefixOf` l
cryptol-2.2.6/src/Cryptol/Parser/Utils.hs 0000644 0000000 0000000 00000003213 12637103426 016521 0 ustar 00 0000000 0000000 -- |
-- Module : $Header$
-- Copyright : (c) 2013-2015 Galois, Inc.
-- License : BSD3
-- Maintainer : cryptol@galois.com
-- Stability : provisional
-- Portability : portable
--
-- Utility functions that are also useful for translating programs
-- from previous Cryptol versions.
module Cryptol.Parser.Utils
( translateExprToNumT
) where
import Cryptol.Parser.AST
import Cryptol.Prims.Syntax
translateExprToNumT :: Expr -> Maybe Type
translateExprToNumT expr =
case expr of
ELocated e r -> (`TLocated` r) `fmap` translateExprToNumT e
EVar (QName Nothing (Name "width")) -> mkFun TCWidth
EVar x -> return (TUser x [])
ECon x -> cvtCon x
ELit x -> cvtLit x
EApp e1 e2 -> do t1 <- translateExprToNumT e1
t2 <- translateExprToNumT e2
tApp t1 t2
_ -> Nothing
where
tApp ty t =
case ty of
TLocated t1 r -> (`TLocated` r) `fmap` tApp t1 t
TApp f ts -> return (TApp f (ts ++ [t]))
TUser f ts -> return (TUser f (ts ++ [t]))
_ -> Nothing
mkFun f = return (TApp f [])
cvtLit (ECNum n CharLit) = return (TChar $ toEnum $ fromInteger n)
cvtLit (ECNum n _) = return (TNum n)
cvtLit (ECString _) = Nothing
cvtCon c =
case c of
ECPlus -> mkFun TCAdd
ECMinus -> mkFun TCSub
ECMul -> mkFun TCMul
ECDiv -> mkFun TCDiv
ECMod -> mkFun TCMod
ECExp -> mkFun TCExp
ECLg2 -> mkFun TCLg2
ECMin -> mkFun TCMin
ECMax -> mkFun TCMax
_ -> Nothing
cryptol-2.2.6/src/Cryptol/Prims/ 0000755 0000000 0000000 00000000000 12637103426 014724 5 ustar 00 0000000 0000000 cryptol-2.2.6/src/Cryptol/Prims/Doc.hs 0000644 0000000 0000000 00000024030 12637103426 015764 0 ustar 00 0000000 0000000 -- |
-- Module : $Header$
-- Copyright : (c) 2013-2015 Galois, Inc.
-- License : BSD3
-- Maintainer : cryptol@galois.com
-- Stability : provisional
-- Portability : portable
module Cryptol.Prims.Doc
( helpDoc
, description
) where
import Cryptol.Prims.Syntax
import Cryptol.Prims.Types(typeOf)
import Cryptol.Utils.PP
helpDoc :: ECon -> Doc
helpDoc prim =
vcat [ text "Description"
, text "-----------"
, text ""
, text " "
<> ppPrefix prim <+> text ":" <+> pp ty
, text ""
, description prim
]
where ty = typeOf prim
method :: String -> [Doc] -> [String] -> Doc
method txt _is notes =
hang (text txt) 2 (vcat [ text "*" <+> text i | i <- notes ])
-- XXX: Display what instances are supported.
noDoc :: Doc
noDoc = text "No documentation is available."
dBits, dWords, dSeqs, dTuples, dRecords, dFuns, dFinSeqs :: Doc
dCmps, dAriths, dEverything :: [Doc]
dBits = text "bits"
dWords = text "words"
dSeqs = text "sequences"
dFinSeqs = text "finite sequences"
dTuples = text "tuples"
dRecords = text "records"
dFuns = text "functions"
dCmps = [ dBits, dWords, dSeqs, dTuples, dRecords ]
dAriths = [ dWords, dSeqs, dTuples, dRecords, dFuns ]
dEverything = [ dBits, dWords, dSeqs, dTuples, dRecords, dFuns ]
description :: ECon -> Doc
description prim =
case prim of
ECTrue -> text "The constant True. Corresponds to the bit value 1."
ECFalse -> text "The constant False. Corresponds to the bit value 0."
ECDemote -> text "The value corresponding to a numeric type."
ECPlus -> method "Add two values."
dAriths
[ "For words, addition uses modulo arithmetic."
, "Structured values are added element-wise."
]
ECMinus -> method "Infix subtraction."
dAriths
[ "For words, subtraction uses modulo arithmetic."
, "Structured values are subtracted element-wise. Defined as:"
, "a - b = a + negate b"
, "See also: `negate'."
]
ECMul -> method "Multiplies two values."
dAriths
[ "For words, multiplies two words, modulus 2^^a."
, "Structured values are multiplied element-wise."
]
ECDiv -> method "Divides two values."
dAriths
[ "For words, divides two words, modulus 2^^a."
, "Structured values are divided element-wise."
]
ECMod -> method "Infix modulus."
dAriths
[ "For words, takes the modulus of two words, modulus 2^^a."
, "Over structured values, operates element-wise."
, "Be careful, as this will often give unexpected results due to interaction of the two moduli."
]
ECExp -> method "Exponentiation."
dAriths
[ "For words, takes the exponent of two words, modulus 2^^a."
, "Over structured values, operates element-wise."
, "Be careful, due to its fast-growing nature, exponentiation is prone to interacting poorly with defaulting."
]
ECLg2 -> method "Log base two"
dAriths
[ "For words, computes the ceiling of log, base 2, of a number."
, "Over structured values, operates element-wise."
]
ECNeg -> method "Unary negation"
dAriths
[ "Returns the twos complement of its argument."
, "Over structured values, operates element-wise."
, "negate a = ~a + 1" -- is this right?
]
ECLt -> method "Less than comparison"
dCmps
[ "Less-than. Only works on comparable arguments." ]
ECGt -> method "Greater than comparison"
dCmps
[ "Greater-than of two comparable arguments." ]
ECLtEq -> method "Less than or equal comparison"
dCmps
[ "Less-than or equal of two comparable arguments." ]
ECGtEq -> method "Greater than or equal comparison"
dCmps
[ "Greater-than or equal of two comparable arguments." ]
ECEq -> method "Equality test"
dEverything
[ "Compares any two values of the same type for equality." ]
ECNotEq -> method "Not-equals test"
dEverything
[ "Compares any two values of the same type for inequality." ]
ECFunEq -> noDoc
ECFunNotEq -> noDoc
ECMin -> method "Minimum of two arguments"
dCmps
[ "Returns the smaller of two comparable arguments." ]
ECMax -> method "Maximum of two arguments"
dCmps
[ "Returns the greater of two comparable arguments." ]
ECAnd -> method "Logical and"
dEverything
[ "Logical `and' over bits. Extends element-wise over sequences, tuples." ]
ECOr -> method "Logical or"
dEverything
[ "Logical `or' over bits. Extends element-wise over sequences, tuples." ]
ECXor -> method "Logical exclusive-or"
dEverything
[ "Logical `exclusive or' over bits. Extends element-wise over sequences, tuples." ]
ECCompl -> method "Logical complement"
dEverything
[ "Bitwise complement. Extends element-wise over sequences, tuples." ]
ECZero -> method "Polymorphic zero"
dEverything -- uh, no arguments?
[ "Gives an arbitrary shaped value whose bits are all False."
, "~zero likewise gives an arbitrary shaped value whose bits are all True."
]
ECShiftL -> method "Left shift"
[ dFinSeqs ]
[ "Left shift. The first argument is the sequence to shift, the second is the number of positions to shift by." ]
ECShiftR -> method "Right shift"
[ dFinSeqs ]
[ "Right shift. The first argument is the sequence to shift, the second is the number of positions to shift by." ]
ECRotL -> method "Left rotate"
[ dFinSeqs ]
[ "Left rotate. The first argument is the sequence to rotate, the second is the number of positions to rotate by." ]
ECRotR -> method "Right rotate"
[ dFinSeqs ]
[ "Right rotate. The first argument is the sequence to rotate, the second is the number of positions to rotate by." ]
ECCat -> noDoc
ECSplitAt -> method "Two-way split operator"
[ dSeqs ]
[ "Split a sequence into a tuple of sequences" ]
ECJoin -> method "Join sequences"
[ dSeqs ]
[ "Joins sequences" ]
ECSplit -> method "Polymorphic split operator"
[ dSeqs ]
[ "Splits a sequence into 'parts' groups with 'each' elements." ]
ECReverse -> method "Reverse a sequence"
[ dSeqs ]
[ "Reverses the elements in a sequence." ]
ECTranspose -> method "Matrix transposition"
[ dSeqs ]
[ "Transposes an [a][b] matrix into a [b][a] matrix." ]
ECAt -> method "Index select operator"
[ dSeqs ]
[ "Index operator. The first argument is a sequence."
,"The second argument is the zero-based index of the element to select from the sequence."
]
ECAtRange -> method "Bulk index operator"
[ dSeqs ]
[ "Bulk index operator. The first argument is a sequence."
,"The second argument is a sequence of the zero-based indices of the elements to select."
]
ECAtBack -> method "Reverse index select operator"
[ dFinSeqs ]
[ "Reverse index operator. The first argument is a finite sequence."
,"The second argument is the zero-based index of the element to select, starting from the end of the sequence."
]
ECAtRangeBack -> method "Bulk reverse index operator"
[ dFinSeqs ]
[ "Bulk reverse index operator. The first argument is a finite sequence."
,"The second argument is a sequence of the zero-based indices of the elements to select, starting from the end of the sequence."
]
ECFromThen -> noDoc
ECFromTo -> noDoc
ECFromThenTo -> noDoc
ECInfFrom -> noDoc
ECInfFromThen -> noDoc
ECError -> noDoc
ECPMul -> method "Polynomial multiplication"
[ dWords ]
[ "Performs multiplication of GF2^^8 polynomials." ]
ECPDiv -> method "Polynomial division"
[ dWords ]
[ "Performs division of GF2^^8 polynomials." ]
ECPMod -> method "Polynomial modulus"
[ dWords ]
[ "Performs modulus of GF2^^8 polynomials." ]
ECRandom -> method "Random value generation"
dCmps
[ "Generates random values from a seed."
,"When called with a function, currently generates a function that always returns zero."
]
cryptol-2.2.6/src/Cryptol/Prims/Eval.hs 0000644 0000000 0000000 00000056630 12637103426 016161 0 ustar 00 0000000 0000000 -- |
-- Module : $Header$
-- Copyright : (c) 2013-2015 Galois, Inc.
-- License : BSD3
-- Maintainer : cryptol@galois.com
-- Stability : provisional
-- Portability : portable
{-# LANGUAGE CPP #-}
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE BangPatterns #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Cryptol.Prims.Eval where
import Cryptol.Prims.Syntax (ECon(..))
import Cryptol.TypeCheck.AST
import Cryptol.TypeCheck.Solver.InfNat (Nat'(..),fromNat,genLog, nMul)
import qualified Cryptol.Eval.Arch as Arch
import Cryptol.Eval.Error
import Cryptol.Eval.Type(evalTF)
import Cryptol.Eval.Value
import Cryptol.Testing.Random (randomValue)
import Cryptol.Utils.Panic (panic)
import Data.List (sortBy,transpose,genericTake,genericReplicate,genericSplitAt,genericIndex)
import Data.Ord (comparing)
import Data.Bits (Bits(..))
import System.Random.TF (mkTFGen)
-- Utilities -------------------------------------------------------------------
#if __GLASGOW_HASKELL__ < 706
noNum = panic "Cryptol.Prims.Eval"
[ "Num instance for Bool shouldn't be used." ]
instance Num Bool where
_ + _ = noNum
_ * _ = noNum
_ - _ = noNum
negate _ = noNum
abs _ = noNum
signum _ = noNum
fromInteger _ = noNum
#endif
#if __GLASGOW_HASKELL__ < 708
instance Bits Bool where
(.&.) = (&&)
(.|.) = (||)
xor = (/=)
complement = not
shift a 0 = a
shift _ _ = False
rotate a _ = a
bitSize _ = 1
isSigned _ = False
testBit a 1 = a
testBit _ _ = False
bit 0 = True
bit _ = False
popCount a = if a then 1 else 0
#endif
-- Primitives ------------------------------------------------------------------
evalECon :: ECon -> Value
evalECon ec = case ec of
ECFalse -> VBit False
ECTrue -> VBit True
ECPlus -> binary (arithBinary (liftBinArith (+)))
ECMinus -> binary (arithBinary (liftBinArith (-)))
ECMul -> binary (arithBinary (liftBinArith (*)))
ECDiv -> binary (arithBinary (liftBinArith divWrap))
ECMod -> binary (arithBinary (liftBinArith modWrap))
ECExp -> binary (arithBinary modExp)
ECLg2 -> unary (arithUnary lg2)
ECNeg -> unary (arithUnary negate)
ECLt -> binary (cmpOrder (\o -> o == LT ))
ECGt -> binary (cmpOrder (\o -> o == GT ))
ECLtEq -> binary (cmpOrder (\o -> o == LT || o == EQ))
ECGtEq -> binary (cmpOrder (\o -> o == GT || o == EQ))
ECEq -> binary (cmpOrder (\o -> o == EQ))
ECNotEq -> binary (cmpOrder (\o -> o /= EQ))
ECMin -> binary (withOrder minV)
ECMax -> binary (withOrder maxV)
ECAnd -> binary (logicBinary (.&.))
ECOr -> binary (logicBinary (.|.))
ECXor -> binary (logicBinary xor)
ECCompl -> unary (logicUnary complement)
ECShiftL -> logicShift shiftLW shiftLS
ECShiftR -> logicShift shiftRW shiftRS
ECRotL -> logicShift rotateLW rotateLS
ECRotR -> logicShift rotateRW rotateRS
ECDemote -> ecDemoteV
ECCat -> tlam $ \ front ->
tlam $ \ back ->
tlam $ \ elty ->
lam $ \ l ->
lam $ \ r -> ccatV front back elty l r
ECAt -> indexPrimOne indexFront
ECAtRange -> indexPrimMany indexFrontRange
ECAtBack -> indexPrimOne indexBack
ECAtRangeBack -> indexPrimMany indexBackRange
ECFunEq -> funCmp (== EQ)
ECFunNotEq -> funCmp (/= EQ)
ECZero -> tlam zeroV
ECJoin -> tlam $ \ parts ->
tlam $ \ each ->
tlam $ \ a -> lam (joinV parts each a)
ECSplit -> ecSplitV
ECSplitAt -> tlam $ \ front ->
tlam $ \ back ->
tlam $ \ a -> lam (splitAtV front back a)
ECFromThen -> fromThenV
ECFromTo -> fromToV
ECFromThenTo -> fromThenToV
ECInfFrom ->
tlam $ \(finTValue -> bits) ->
lam $ \(fromWord -> first) ->
toStream (map (word bits) [ first .. ])
ECInfFromThen ->
tlam $ \(finTValue -> bits) ->
lam $ \(fromWord -> first) ->
lam $ \(fromWord -> next) ->
toStream [ word bits n | n <- [ first, next .. ] ]
ECError ->
tlam $ \_ ->
tlam $ \_ ->
lam $ \(fromStr -> s) -> cryUserError s
ECReverse ->
tlam $ \a ->
tlam $ \b ->
lam $ \(fromSeq -> xs) -> toSeq a b (reverse xs)
ECTranspose ->
tlam $ \a ->
tlam $ \b ->
tlam $ \c ->
lam $ \((map fromSeq . fromSeq) -> xs) ->
case numTValue a of
Nat 0 ->
let val = toSeq a c []
in case numTValue b of
Nat n -> toSeq b (tvSeq a c) $ genericReplicate n val
Inf -> VStream $ repeat val
_ -> toSeq b (tvSeq a c) $ map (toSeq a c) $ transpose xs
ECPMul ->
tlam $ \(finTValue -> a) ->
tlam $ \(finTValue -> b) ->
lam $ \(fromWord -> x) ->
lam $ \(fromWord -> y) -> word (max 1 (a + b) - 1) (mul 0 x y b)
where
mul !res !_ !_ 0 = res
mul res bs as n = mul (if even as then res else xor res bs)
(bs `shiftL` 1) (as `shiftR` 1) (n-1)
ECPDiv ->
tlam $ \(fromInteger . finTValue -> a) ->
tlam $ \(fromInteger . finTValue -> b) ->
lam $ \(fromWord -> x) ->
lam $ \(fromWord -> y) -> word (toInteger a)
(fst (divModPoly x a y b))
ECPMod ->
tlam $ \(fromInteger . finTValue -> a) ->
tlam $ \(fromInteger . finTValue -> b) ->
lam $ \(fromWord -> x) ->
lam $ \(fromWord -> y) -> word (toInteger b)
(snd (divModPoly x a y (b+1)))
ECRandom ->
tlam $ \a ->
lam $ \(fromWord -> x) -> randomV a x
-- | Make a numeric constant.
ecDemoteV :: Value
ecDemoteV = tlam $ \valT ->
tlam $ \bitT ->
case (numTValue valT, numTValue bitT) of
(Nat v, Nat bs) -> VWord (mkBv bs v)
_ -> evalPanic "Cryptol.Eval.Prim.evalConst"
["Unexpected Inf in constant."
, show valT
, show bitT
]
--------------------------------------------------------------------------------
divModPoly :: Integer -> Int -> Integer -> Int -> (Integer, Integer)
divModPoly xs xsLen ys ysLen
| ys == 0 = divideByZero
| otherwise = go 0 initR (xsLen - degree) todoBits
where
downIxes n = [ n - 1, n - 2 .. 0 ]
degree = head [ n | n <- downIxes ysLen, testBit ys n ]
initR = xs `shiftR` (xsLen - degree)
nextR r b = (r `shiftL` 1) .|. (if b then 1 else 0)
go !res !r !bitN todo =
let x = xor r ys
(res',r') | testBit x degree = (res, r)
| otherwise = (setBit res bitN, x)
in case todo of
b : bs -> go res' (nextR r' b) (bitN-1) bs
[] -> (res',r')
todoBits = map (testBit xs) (downIxes (xsLen - degree))
-- | Create a packed word
modExp :: Integer -- ^ bit size of the resulting word
-> Integer -- ^ base
-> Integer -- ^ exponent
-> Integer
modExp bits base e
| bits == 0 = 0
| base < 0 || bits < 0 = evalPanic "modExp"
[ "bad args: "
, " base = " ++ show base
, " e = " ++ show e
, " bits = " ++ show modulus
]
| otherwise = doubleAndAdd base e modulus
where
modulus = 0 `setBit` fromInteger bits
doubleAndAdd :: Integer -- ^ base
-> Integer -- ^ exponent mask
-> Integer -- ^ modulus
-> Integer
doubleAndAdd base0 expMask modulus = go 1 base0 expMask
where
go acc base k
| k > 0 = acc' `seq` base' `seq` go acc' base' (k `shiftR` 1)
| otherwise = acc
where
acc' | k `testBit` 0 = acc `modMul` base
| otherwise = acc
base' = base `modMul` base
modMul x y = (x * y) `mod` modulus
-- Operation Lifting -----------------------------------------------------------
type GenBinary b w = TValue -> GenValue b w -> GenValue b w -> GenValue b w
type Binary = GenBinary Bool BV
binary :: GenBinary b w -> GenValue b w
binary f = tlam $ \ ty ->
lam $ \ a ->
lam $ \ b -> f ty a b
type GenUnary b w = TValue -> GenValue b w -> GenValue b w
type Unary = GenUnary Bool BV
unary :: GenUnary b w -> GenValue b w
unary f = tlam $ \ ty ->
lam $ \ a -> f ty a
-- Arith -----------------------------------------------------------------------
-- | Turn a normal binop on Integers into one that can also deal with a bitsize.
liftBinArith :: (Integer -> Integer -> Integer) -> BinArith
liftBinArith op _ = op
type BinArith = Integer -> Integer -> Integer -> Integer
arithBinary :: BinArith -> Binary
arithBinary op = loop
where
loop ty l r
| Just (len,a) <- isTSeq ty = case numTValue len of
-- words and finite sequences
Nat w | isTBit a -> VWord (mkBv w (op w (fromWord l) (fromWord r)))
| otherwise -> VSeq False (zipWith (loop a) (fromSeq l) (fromSeq r))
-- streams
Inf -> toStream (zipWith (loop a) (fromSeq l) (fromSeq r))
-- functions
| Just (_,ety) <- isTFun ty =
lam $ \ x -> loop ety (fromVFun l x) (fromVFun r x)
-- tuples
| Just (_,tys) <- isTTuple ty =
let ls = fromVTuple l
rs = fromVTuple r
in VTuple (zipWith3 loop tys ls rs)
-- records
| Just fs <- isTRec ty =
VRecord [ (f, loop fty (lookupRecord f l) (lookupRecord f r))
| (f,fty) <- fs ]
| otherwise = evalPanic "arithBinop" ["Invalid arguments"]
arithUnary :: (Integer -> Integer) -> Unary
arithUnary op = loop
where
loop ty x
| Just (len,a) <- isTSeq ty = case numTValue len of
-- words and finite sequences
Nat w | isTBit a -> VWord (mkBv w (op (fromWord x)))
| otherwise -> VSeq False (map (loop a) (fromSeq x))
Inf -> toStream (map (loop a) (fromSeq x))
-- functions
| Just (_,ety) <- isTFun ty =
lam $ \ y -> loop ety (fromVFun x y)
-- tuples
| Just (_,tys) <- isTTuple ty =
let as = fromVTuple x
in VTuple (zipWith loop tys as)
-- records
| Just fs <- isTRec ty =
VRecord [ (f, loop fty (lookupRecord f x)) | (f,fty) <- fs ]
| otherwise = evalPanic "arithUnary" ["Invalid arguments"]
lg2 :: Integer -> Integer
lg2 i = case genLog i 2 of
Just (i',isExact) | isExact -> i'
| otherwise -> i' + 1
Nothing -> 0
divWrap :: Integral a => a -> a -> a
divWrap _ 0 = divideByZero
divWrap x y = x `div` y
modWrap :: Integral a => a -> a -> a
modWrap _ 0 = divideByZero
modWrap x y = x `mod` y
-- Cmp -------------------------------------------------------------------------
-- | Lexicographic ordering on two values.
lexCompare :: TValue -> Value -> Value -> Ordering
lexCompare ty l r
| isTBit ty =
compare (fromVBit l) (fromVBit r)
| Just (_,b) <- isTSeq ty, isTBit b =
compare (fromWord l) (fromWord r)
| Just (_,e) <- isTSeq ty =
zipLexCompare (repeat e) (fromSeq l) (fromSeq r)
-- tuples
| Just (_,etys) <- isTTuple ty =
zipLexCompare etys (fromVTuple l) (fromVTuple r)
-- records
| Just fields <- isTRec ty =
let tys = map snd (sortBy (comparing fst) fields)
ls = map snd (sortBy (comparing fst) (fromVRecord l))
rs = map snd (sortBy (comparing fst) (fromVRecord r))
in zipLexCompare tys ls rs
| otherwise = evalPanic "lexCompare" ["invalid type"]
-- XXX the lists are expected to be of the same length, as this should only be
-- used with values that come from type-correct expressions.
zipLexCompare :: [TValue] -> [Value] -> [Value] -> Ordering
zipLexCompare tys ls rs = foldr choose EQ (zipWith3 lexCompare tys ls rs)
where
choose c acc = case c of
EQ -> acc
_ -> c
-- | Process two elements based on their lexicographic ordering.
cmpOrder :: (Ordering -> Bool) -> Binary
cmpOrder op ty l r = VBit (op (lexCompare ty l r))
withOrder :: (Ordering -> TValue -> Value -> Value -> Value) -> Binary
withOrder choose ty l r = choose (lexCompare ty l r) ty l r
maxV :: Ordering -> TValue -> Value -> Value -> Value
maxV o _ l r = case o of
LT -> r
_ -> l
minV :: Ordering -> TValue -> Value -> Value -> Value
minV o _ l r = case o of
GT -> r
_ -> l
funCmp :: (Ordering -> Bool) -> Value
funCmp op =
tlam $ \ _a ->
tlam $ \ b ->
lam $ \ l ->
lam $ \ r ->
lam $ \ x -> cmpOrder op b (fromVFun l x) (fromVFun r x)
-- Logic -----------------------------------------------------------------------
zeroV :: TValue -> Value
zeroV ty
-- bits
| isTBit ty =
VBit False
-- sequences
| Just (n,ety) <- isTSeq ty =
case numTValue n of
Nat w | isTBit ety -> word w 0
| otherwise -> toSeq n ety (replicate (fromInteger w) (zeroV ety))
Inf -> toSeq n ety (repeat (zeroV ety))
-- functions
| Just (_,bty) <- isTFun ty =
lam (\ _ -> zeroV bty)
-- tuples
| Just (_,tys) <- isTTuple ty =
VTuple (map zeroV tys)
-- records
| Just fields <- isTRec ty =
VRecord [ (f,zeroV fty) | (f,fty) <- fields ]
| otherwise = evalPanic "zeroV" ["invalid type for zero"]
-- | Join a sequence of sequences into a single sequence.
joinV :: TValue -> TValue -> TValue -> Value -> Value
joinV parts each a val =
let len = toNumTValue (numTValue parts `nMul` numTValue each)
in toSeq len a (concatMap fromSeq (fromSeq val))
splitAtV :: TValue -> TValue -> TValue -> Value -> Value
splitAtV front back a val =
case numTValue back of
-- remember that words are big-endian in cryptol, so the masked portion
-- needs to be first, assuming that we're on a little-endian machine.
Nat rightWidth | aBit ->
let i = fromWord val
in VTuple [ word leftWidth (i `shiftR` fromInteger rightWidth)
, word rightWidth i ]
_ ->
let (ls,rs) = splitAt (fromInteger leftWidth) (fromSeq val)
in VTuple [VSeq aBit ls, toSeq back a rs]
where
aBit = isTBit a
leftWidth = case numTValue front of
Nat n -> n
_ -> evalPanic "splitAtV" ["invalid `front` len"]
-- | Split implementation.
ecSplitV :: Value
ecSplitV =
tlam $ \ parts ->
tlam $ \ each ->
tlam $ \ a ->
lam $ \ val ->
let mkChunks f = map (toFinSeq a) $ f $ fromSeq val
in case (numTValue parts, numTValue each) of
(Nat p, Nat e) -> VSeq False $ mkChunks (finChunksOf p e)
(Inf , Nat e) -> toStream $ mkChunks (infChunksOf e)
_ -> evalPanic "splitV" ["invalid type arguments to split"]
-- | Split into infinitely many chunks
infChunksOf :: Integer -> [a] -> [[a]]
infChunksOf each xs = let (as,bs) = genericSplitAt each xs
in as : infChunksOf each bs
-- | Split into finitely many chunks
finChunksOf :: Integer -> Integer -> [a] -> [[a]]
finChunksOf 0 _ _ = []
finChunksOf parts each xs = let (as,bs) = genericSplitAt each xs
in as : finChunksOf (parts - 1) each bs
ccatV :: TValue -> TValue -> TValue -> Value -> Value -> Value
ccatV front back elty l r =
toSeq (evalTF TCAdd [front,back]) elty (fromSeq l ++ fromSeq r)
-- | Merge two values given a binop. This is used for and, or and xor.
logicBinary :: (forall a. Bits a => a -> a -> a) -> Binary
logicBinary op = loop
where
loop ty l r
| isTBit ty = VBit (op (fromVBit l) (fromVBit r))
| Just (len,aty) <- isTSeq ty =
case numTValue len of
-- words or finite sequences
Nat w | isTBit aty -> VWord (mkBv w (op (fromWord l) (fromWord r)))
| otherwise -> VSeq False (zipWith (loop aty) (fromSeq l)
(fromSeq r))
-- streams
Inf -> toStream (zipWith (loop aty) (fromSeq l) (fromSeq r))
| Just (_,etys) <- isTTuple ty =
let ls = fromVTuple l
rs = fromVTuple r
in VTuple (zipWith3 loop etys ls rs)
| Just (_,bty) <- isTFun ty =
lam $ \ a -> loop bty (fromVFun l a) (fromVFun r a)
| Just fields <- isTRec ty =
VRecord [ (f,loop fty a b) | (f,fty) <- fields
, let a = lookupRecord f l
b = lookupRecord f r
]
| otherwise = evalPanic "logicBinary" ["invalid logic type"]
logicUnary :: (forall a. Bits a => a -> a) -> Unary
logicUnary op = loop
where
loop ty val
| isTBit ty = VBit (op (fromVBit val))
| Just (len,ety) <- isTSeq ty =
case numTValue len of
-- words or finite sequences
Nat w | isTBit ety -> VWord (mkBv w (op (fromWord val)))
| otherwise -> VSeq False (map (loop ety) (fromSeq val))
-- streams
Inf -> toStream (map (loop ety) (fromSeq val))
| Just (_,etys) <- isTTuple ty =
let as = fromVTuple val
in VTuple (zipWith loop etys as)
| Just (_,bty) <- isTFun ty =
lam $ \ a -> loop bty (fromVFun val a)
| Just fields <- isTRec ty =
VRecord [ (f,loop fty a) | (f,fty) <- fields, let a = lookupRecord f val ]
| otherwise = evalPanic "logicUnary" ["invalid logic type"]
logicShift :: (Integer -> Integer -> Int -> Integer)
-- ^ the Integer value (argument 2) may contain junk bits, but the
-- Int (argument 3) will always be clean
-> (TValue -> TValue -> [Value] -> Int -> [Value])
-> Value
logicShift opW opS
= tlam $ \ a ->
tlam $ \ _ ->
tlam $ \ c ->
lam $ \ l ->
lam $ \ r ->
if isTBit c
then -- words
let BV w i = fromVWord l
in VWord (BV w (opW w i (fromInteger (fromWord r))))
else toSeq a c (opS a c (fromSeq l) (fromInteger (fromWord r)))
-- Left shift for words.
shiftLW :: Integer -> Integer -> Int -> Integer
shiftLW w ival by
| toInteger by >= w = 0
| otherwise = shiftL ival by
shiftLS :: TValue -> TValue -> [Value] -> Int -> [Value]
shiftLS w ety vs by =
case numTValue w of
Nat len
| toInteger by < len -> genericTake len (drop by vs ++ repeat (zeroV ety))
| otherwise -> genericReplicate len (zeroV ety)
Inf -> drop by vs
shiftRW :: Integer -> Integer -> Int -> Integer
shiftRW w i by
| toInteger by >= w = 0
| otherwise = shiftR (mask w i) by
shiftRS :: TValue -> TValue -> [Value] -> Int -> [Value]
shiftRS w ety vs by =
case numTValue w of
Nat len
| toInteger by < len -> genericTake len (replicate by (zeroV ety) ++ vs)
| otherwise -> genericReplicate len (zeroV ety)
Inf -> replicate by (zeroV ety) ++ vs
-- XXX integer doesn't implement rotateL, as there's no bit bound
rotateLW :: Integer -> Integer -> Int -> Integer
rotateLW 0 i _ = i
rotateLW w i by = (i `shiftL` b) .|. (mask w i `shiftR` (fromInteger w - b))
where b = by `mod` fromInteger w
rotateLS :: TValue -> TValue -> [Value] -> Int -> [Value]
rotateLS w _ vs at =
case numTValue w of
Nat len -> let at' = toInteger at `mod` len
(ls,rs) = genericSplitAt at' vs
in rs ++ ls
_ -> panic "Cryptol.Eval.Prim.rotateLS" [ "unexpected infinite sequence" ]
-- XXX integer doesn't implement rotateR, as there's no bit bound
rotateRW :: Integer -> Integer -> Int -> Integer
rotateRW 0 i _ = i
rotateRW w i by = (mask w i `shiftR` b) .|. (i `shiftL` (fromInteger w - b))
where b = by `mod` fromInteger w
rotateRS :: TValue -> TValue -> [Value] -> Int -> [Value]
rotateRS w _ vs at =
case numTValue w of
Nat len -> let at' = toInteger at `mod` len
(ls,rs) = genericSplitAt (len - at') vs
in rs ++ ls
_ -> panic "Cryptol.Eval.Prim.rotateRS" [ "unexpected infinite sequence" ]
-- Sequence Primitives ---------------------------------------------------------
-- | Indexing operations that return one element.
indexPrimOne :: (Maybe Integer -> [Value] -> Integer -> Value) -> Value
indexPrimOne op =
tlam $ \ n ->
tlam $ \ _a ->
tlam $ \ _i ->
lam $ \ l ->
lam $ \ r ->
let vs = fromSeq l
ix = fromWord r
in op (fromNat (numTValue n)) vs ix
indexFront :: Maybe Integer -> [Value] -> Integer -> Value
indexFront mblen vs ix =
case mblen of
Just len | len <= ix -> invalidIndex ix
_ -> genericIndex vs ix
indexBack :: Maybe Integer -> [Value] -> Integer -> Value
indexBack mblen vs ix =
case mblen of
Just len | len > ix -> genericIndex vs (len - ix - 1)
| otherwise -> invalidIndex ix
Nothing -> evalPanic "indexBack"
["unexpected infinite sequence"]
-- | Indexing operations that return many elements.
indexPrimMany :: (Maybe Integer -> [Value] -> [Integer] -> [Value]) -> Value
indexPrimMany op =
tlam $ \ n ->
tlam $ \ a ->
tlam $ \ m ->
tlam $ \ _i ->
lam $ \ l ->
lam $ \ r ->
let vs = fromSeq l
ixs = map fromWord (fromSeq r)
in toSeq m a (op (fromNat (numTValue n)) vs ixs)
indexFrontRange :: Maybe Integer -> [Value] -> [Integer] -> [Value]
indexFrontRange mblen vs = map (indexFront mblen vs)
indexBackRange :: Maybe Integer -> [Value] -> [Integer] -> [Value]
indexBackRange mblen vs = map (indexBack mblen vs)
-- @[ 0, 1 .. ]@
fromThenV :: Value
fromThenV =
tlamN $ \ first ->
tlamN $ \ next ->
tlamN $ \ bits ->
tlamN $ \ len ->
case (first, next, len, bits) of
(_ , _ , _ , Nat bits')
| bits' >= Arch.maxBigIntWidth -> wordTooWide bits'
(Nat first', Nat next', Nat len', Nat bits') ->
let nums = enumFromThen first' next'
in VSeq False (genericTake len' (map (VWord . BV bits') nums))
_ -> evalPanic "fromThenV" ["invalid arguments"]
-- @[ 0 .. 10 ]@
fromToV :: Value
fromToV =
tlamN $ \ first ->
tlamN $ \ lst ->
tlamN $ \ bits ->
case (first, lst, bits) of
(_ , _ , Nat bits')
| bits' >= Arch.maxBigIntWidth -> wordTooWide bits'
(Nat first', Nat lst', Nat bits') ->
let nums = enumFromThenTo first' (first' + 1) lst'
len = 1 + (lst' - first')
in VSeq False (genericTake len (map (VWord . BV bits') nums))
_ -> evalPanic "fromThenV" ["invalid arguments"]
-- @[ 0, 1 .. 10 ]@
fromThenToV :: Value
fromThenToV =
tlamN $ \ first ->
tlamN $ \ next ->
tlamN $ \ lst ->
tlamN $ \ bits ->
tlamN $ \ len ->
case (first, next, lst, len, bits) of
(_ , _ , _ , _ , Nat bits')
| bits' >= Arch.maxBigIntWidth -> wordTooWide bits'
(Nat first', Nat next', Nat lst', Nat len', Nat bits') ->
let nums = enumFromThenTo first' next' lst'
in VSeq False (genericTake len' (map (VWord . BV bits') nums))
_ -> evalPanic "fromThenV" ["invalid arguments"]
-- Random Values ---------------------------------------------------------------
-- | Produce a random value with the given seed. If we do not support
-- making values of the given type, return zero of that type.
-- TODO: do better than returning zero
randomV :: TValue -> Integer -> Value
randomV ty seed =
case randomValue (tValTy ty) of
Nothing -> zeroV ty
Just gen -> fst $ gen 100 $ mkTFGen (fromIntegral seed)
-- Miscellaneous ---------------------------------------------------------------
tlamN :: (Nat' -> GenValue b w) -> GenValue b w
tlamN f = VPoly (\x -> f (numTValue x))
cryptol-2.2.6/src/Cryptol/Prims/Syntax.hs 0000644 0000000 0000000 00000012440 12637103426 016547 0 ustar 00 0000000 0000000 -- |
-- Module : $Header$
-- Copyright : (c) 2013-2015 Galois, Inc.
-- License : BSD3
-- Maintainer : cryptol@galois.com
-- Stability : provisional
-- Portability : portable
module Cryptol.Prims.Syntax
( TFun(..)
, ECon(..)
, eBinOpPrec
, tBinOpPrec
, ppPrefix
) where
import Cryptol.Utils.PP
import qualified Data.Map as Map
-- | Built-in types.
data TFun
= TCAdd -- ^ @ : Num -> Num -> Num @
| TCSub -- ^ @ : Num -> Num -> Num @
| TCMul -- ^ @ : Num -> Num -> Num @
| TCDiv -- ^ @ : Num -> Num -> Num @
| TCMod -- ^ @ : Num -> Num -> Num @
| TCLg2 -- ^ @ : Num -> Num @
| TCExp -- ^ @ : Num -> Num -> Num @
| TCWidth -- ^ @ : Num -> Num @
| TCMin -- ^ @ : Num -> Num -> Num @
| TCMax -- ^ @ : Num -> Num -> Num @
-- Computing the lengths of explicit enumerations
| TCLenFromThen -- ^ @ : Num -> Num -> Num -> Num@
-- Example: @[ 1, 5 .. ] :: [lengthFromThen 1 5 b][b]@
| TCLenFromThenTo -- ^ @ : Num -> Num -> Num -> Num@
-- Example: @[ 1, 5 .. 9 ] :: [lengthFromThenTo 1 5 9][b]@
deriving (Show, Eq, Ord, Bounded, Enum)
-- | Built-in constants.
data ECon
= ECTrue
| ECFalse
| ECDemote -- ^ Converts a numeric type into its corresponding value.
-- Arith
| ECPlus | ECMinus | ECMul | ECDiv | ECMod
| ECExp | ECLg2 | ECNeg
-- Cmp
| ECLt | ECGt | ECLtEq | ECGtEq | ECEq | ECNotEq
| ECFunEq | ECFunNotEq
| ECMin | ECMax
-- Logic
| ECAnd | ECOr | ECXor | ECCompl | ECZero
| ECShiftL | ECShiftR | ECRotL | ECRotR
-- Sequences
| ECCat | ECSplitAt
| ECJoin | ECSplit
| ECReverse | ECTranspose
| ECAt | ECAtRange | ECAtBack | ECAtRangeBack
-- Static word sequences
| ECFromThen | ECFromTo | ECFromThenTo
-- Infinite word sequences
| ECInfFrom | ECInfFromThen
-- Run-time error
| ECError
-- Polynomials
| ECPMul | ECPDiv | ECPMod
-- Random values
| ECRandom
deriving (Eq,Ord,Show,Bounded,Enum)
eBinOpPrec :: Map.Map ECon (Assoc,Int)
tBinOpPrec :: Map.Map TFun (Assoc,Int)
(eBinOpPrec, tBinOpPrec) = (mkMap e_table, mkMap t_table)
where
mkMap t = Map.fromList [ (op,(a,n)) | ((a,ops),n) <- zip t [0..] , op <- ops ]
-- lowest to highest
e_table =
[ (LeftAssoc, [ ECOr ])
, (LeftAssoc, [ ECXor ])
, (LeftAssoc, [ ECAnd ])
, (NonAssoc, [ ECEq, ECNotEq, ECFunEq, ECFunNotEq ])
, (NonAssoc, [ ECLt, ECGt, ECLtEq, ECGtEq ])
, (RightAssoc, [ ECCat ])
, (LeftAssoc, [ ECShiftL, ECShiftR, ECRotL, ECRotR ])
, (LeftAssoc, [ ECPlus, ECMinus ])
, (LeftAssoc, [ ECMul, ECDiv, ECMod ])
, (RightAssoc, [ ECExp ])
, (LeftAssoc, [ ECAt, ECAtRange, ECAtBack, ECAtRangeBack ])
]
t_table =
[ (LeftAssoc, [ TCAdd, TCSub ])
, (LeftAssoc, [ TCMul, TCDiv, TCMod ])
, (RightAssoc, [ TCExp ])
]
instance PP TFun where
ppPrec _ tcon =
case tcon of
TCAdd -> text "+"
TCSub -> text "-"
TCMul -> text "*"
TCDiv -> text "/"
TCMod -> text "%"
TCLg2 -> text "lg2"
TCExp -> text "^^"
TCWidth -> text "width"
TCMin -> text "min"
TCMax -> text "max"
TCLenFromThen -> text "lengthFromThen"
TCLenFromThenTo -> text "lengthFromThenTo"
instance PP ECon where
ppPrec _ con =
case con of
ECTrue -> text "True"
ECFalse -> text "False"
ECPlus -> text "+"
ECMinus -> text "-"
ECMul -> text "*"
ECDiv -> text "/"
ECMod -> text "%"
ECExp -> text "^^"
ECLg2 -> text "lg2"
ECNeg -> text "-"
ECLt -> text "<"
ECGt -> text ">"
ECLtEq -> text "<="
ECGtEq -> text ">="
ECEq -> text "=="
ECNotEq -> text "!="
ECFunEq -> text "==="
ECFunNotEq -> text "!=="
ECAnd -> text "&&"
ECOr -> text "||"
ECXor -> text "^"
ECCompl -> text "~"
ECShiftL -> text "<<"
ECShiftR -> text ">>"
ECRotL -> text "<<<"
ECRotR -> text ">>>"
ECCat -> text "#"
ECAt -> text "@"
ECAtRange -> text "@@"
ECAtBack -> text "!"
ECAtRangeBack -> text "!!"
ECMin -> text "min"
ECMax -> text "max"
ECSplitAt -> text "splitAt"
ECZero -> text "zero"
ECJoin -> text "join"
ECSplit -> text "split"
ECReverse -> text "reverse"
ECTranspose -> text "transpose"
ECDemote -> text "demote"
ECFromThen -> text "fromThen"
ECFromTo -> text "fromTo"
ECFromThenTo -> text "fromThenTo"
ECInfFrom -> text "infFrom"
ECInfFromThen -> text "infFromThen"
ECError -> text "error"
ECPMul -> text "pmult"
ECPDiv -> text "pdiv"
ECPMod -> text "pmod"
ECRandom -> text "random"
ppPrefix :: ECon -> Doc
ppPrefix con = optParens (Map.member con eBinOpPrec) (pp con)
cryptol-2.2.6/src/Cryptol/Prims/Types.hs 0000644 0000000 0000000 00000023526 12637103426 016374 0 ustar 00 0000000 0000000 -- |
-- Module : $Header$
-- Copyright : (c) 2013-2015 Galois, Inc.
-- License : BSD3
-- Maintainer : cryptol@galois.com
-- Stability : provisional
-- Portability : portable
module Cryptol.Prims.Types (typeOf) where
import Cryptol.Prims.Syntax
import Cryptol.TypeCheck.AST
import Cryptol.Utils.Panic(panic)
-- | Types of built-in constants.
typeOf :: ECon -> Schema
typeOf econ =
case econ of
ECTrue -> Forall [] [] tBit
ECFalse -> Forall [] [] tBit
-- {at,len} (fin len) => [len][8] -> at
ECError ->
let aT = var 0 KType
len = var 1 KNum
in forAllNamed [ (Just "at", aT), (Just "len",len) ]
[ pFin len ]
(tSeq len (tWord (tNum (8::Int))) `tFun` aT)
-- Infinite word sequences
-- {a} (fin a) => [a] -> [inf][a]
ECInfFrom ->
let bits = var 0 KNum
in forAllNamed [ (Just "bits", bits) ]
[ pFin bits ]
(tWord bits `tFun` tSeq tInf (tWord bits))
-- {a} (fin a) => [a] -> [a] -> [inf][a]
ECInfFromThen ->
let bits = var 0 KNum
in forAllNamed [ (Just "bits", bits) ]
[ pFin bits ]
(tWord bits `tFun` tWord bits `tFun` tSeq tInf (tWord bits))
-- Static word sequences
-- fromThen : {first,next,bits}
-- ( fin first, fin next, fin bits
-- , bits >= width first, bits >= width next
-- , lengthFromThen first next bits == len
-- )
-- => [len] [bits]
ECFromThen ->
let first = var 0 KNum
next = var 1 KNum
bits = var 3 KNum
len = var 4 KNum
in forAllNamed [ (Just "first", first)
, (Just "next", next)
, (Just "bits", bits)
, (Just "len", len)
]
[ pFin first, pFin next, pFin bits
, bits >== tWidth first, bits >== tWidth next
, tLenFromThen first next bits =#= len
]
(tSeq len (tWord bits))
{- { first, last, bits }
(fin last, fin bits, last >= first, bits >= width last)
=> [1 + (last - first)] [bits]
-}
ECFromTo ->
let first = var 0 KNum
lst = var 1 KNum
bits = var 3 KNum
in forAllNamed [ (Just "first", first)
, (Just "last", lst)
, (Just "bits", bits)
]
[ pFin lst, pFin bits, lst >== first, bits >== tWidth lst ]
(tSeq (tNum (1 :: Int) .+. (lst .-. first)) (tWord bits))
ECFromThenTo ->
let first = var 0 KNum
next = var 1 KNum
lst = var 2 KNum
bits = var 4 KNum
len = var 5 KNum
in forAllNamed [ (Just "first", first)
, (Just "next", next)
, (Just "last", lst)
, (Just "bits", bits)
, (Just "len", len)
]
[ pFin first, pFin next, pFin lst, pFin bits
, bits >== tWidth first, bits >== tWidth next, bits >== tWidth lst
, tLenFromThenTo first next lst =#= len
]
(tSeq len (tWord bits))
-- { val, bits } (fin val, fin bits, bits >= width val) => [bits]
ECDemote ->
let val = var 0 KNum
bits = var 1 KNum
in forAllNamed [ (Just "val", val), (Just "bits", bits) ]
[ pFin val, pFin bits, bits >== tWidth val ] (tWord bits)
-- Polynomials
-- {a,b} (fin a, fin b) => [a] -> [b] -> [max 1 (a + b) - 1]
ECPMul ->
let a = var 0 KNum
b = var 1 KNum
in forAllNamed [ (Nothing, a), (Nothing, b) ]
[ pFin a, pFin b ]
$ tWord a `tFun` tWord b `tFun`
tWord (tMax (tNum (1::Int)) (a .+. b) .-. tNum (1::Int))
-- {a,b} (fin a, fin b) => [a] -> [b] -> [a]
ECPDiv ->
let a = var 0 KNum
b = var 1 KNum
in forAllNamed [ (Nothing, a), (Nothing, b) ]
[ pFin a, pFin b ]
$ tWord a `tFun` tWord b `tFun` tWord a
-- {a,b} (fin a, fin b) => [a] -> [b+1] -> [b]
ECPMod ->
let a = var 0 KNum
b = var 1 KNum
in forAllNamed [ (Nothing, a), (Nothing, b) ]
[ pFin a, pFin b ]
$ tWord a `tFun` tWord (tNum (1::Int) .+. b) `tFun` tWord b
-- Arith
ECPlus -> arith2
ECMinus -> arith2
ECMul -> arith2
ECDiv -> arith2
ECMod -> arith2
ECExp -> arith2
ECLg2 -> arith1
ECNeg -> arith1
-- Cmp
ECLt -> rel2
ECGt -> rel2
ECLtEq -> rel2
ECGtEq -> rel2
ECEq -> rel2
ECNotEq -> rel2
ECFunEq -> cmpFun
ECFunNotEq -> cmpFun
ECMin -> cmp2
ECMax -> cmp2
-- Logic
ECAnd -> logic2
ECOr -> logic2
ECXor -> logic2
ECCompl -> logic1
ECZero -> logic0
ECShiftL -> logicShift
ECShiftR -> logicShift
ECRotL -> logicRot
ECRotR -> logicRot
-- {a,b,c} (fin b) => [a][b]c -> [a * b]c
ECJoin ->
let parts = var 0 KNum
each = var 1 KNum
a = var 2 KType
in forAllNamed
[ (Just "parts", parts)
, (Just "each", each)
, (Nothing, a)
]
[ pFin each ]
$ tSeq parts (tSeq each a) `tFun` tSeq (parts .*. each) a
-- {a,b,c} (fin b) => [a * b] c -> [a][b] c
ECSplit ->
let parts = var 0 KNum
each = var 1 KNum
a = var 2 KType
in forAllNamed
[ (Just "parts", parts)
, (Just "each", each)
, (Nothing, a)
]
[ pFin each ]
$ tSeq (parts .*. each) a `tFun` tSeq parts (tSeq each a)
-- {a,b} (fin a) => [a] b -> [a] b
ECReverse ->
let a = var 0 KNum
b = var 1 KType
in forAllNamed [ (Nothing, a), (Nothing, b) ]
[ pFin a ]
(tSeq a b `tFun` tSeq a b)
-- {a,b,c} [a][b]c -> [b][a]c
ECTranspose ->
let a = var 0 KNum
b = var 1 KNum
c = var 2 KType
in forAllNamed [ (Nothing, a), (Nothing, b), (Nothing, c) ]
[]
(tSeq a (tSeq b c) `tFun` tSeq b (tSeq a c))
-- Sequence selectors
ECAt ->
let n = var 0 KNum
a = var 1 KType
i = var 2 KNum
in forAll [n,a,i] [ pFin i ] (tSeq n a `tFun` tWord i `tFun` a)
ECAtRange ->
let n = var 0 KNum
a = var 1 KType
m = var 2 KNum
i = var 3 KNum
in forAll [n,a,m,i] [ pFin i ]
(tSeq n a `tFun` tSeq m (tWord i) `tFun` tSeq m a)
ECAtBack ->
let n = var 0 KNum
a = var 1 KType
i = var 2 KNum
in forAll [n,a,i] [ pFin n, pFin i ] (tSeq n a `tFun` tWord i `tFun` a)
ECAtRangeBack ->
let n = var 0 KNum
a = var 1 KType
m = var 2 KNum
i = var 3 KNum
in forAll [n,a,m,i] [ pFin n, pFin i ]
(tSeq n a `tFun` tSeq m (tWord i) `tFun` tSeq m a)
-- {a,b,c} (fin a) => [a+b] c -> ([a]c,[b]c)
ECSplitAt ->
let front = var 0 KNum
back = var 1 KNum
a = var 2 KType
in forAllNamed
[ (Just "front", front)
, (Just "back", back)
, (Nothing, a)
] [ pFin front ]
$ tSeq (front .+. back) a `tFun` tTuple [tSeq front a, tSeq back a]
-- {a,b,d} (fin a) => [a] d -> [b] d -> [a + b] d
ECCat ->
let a = var 0 KNum
b = var 1 KNum
d = var 3 KType
in forAllNamed [ (Just "front", a)
, (Just "back" , b)
, (Nothing,d)
] [ pFin a ]
$ tSeq a d `tFun` tSeq b d `tFun` tSeq (a .+. b) d
-- {a} => [32] -> a
ECRandom ->
let a = var 0 KType
in forAll [a] [] (tWord (tNum (32 :: Int)) `tFun` a)
where
var x k = TVar (TVBound x k)
toTP (mb,TVar (TVBound x k)) = TParam { tpName = fmap (mkUnqual . Name) mb
, tpUnique = x, tpKind = k }
toTP (_,x) = panic "Cryptol.Prims.Types.typeOf"
[ "Not TBound", show x ]
forAllNamed xs ys p = Forall (map toTP xs) ys p
forAll xs = forAllNamed (zip (repeat Nothing) xs)
-- {a} (Arith a) => a -> a -> a
arith2 = let a = var 0 KType
in forAll [a] [ pArith a ] $ a `tFun` a `tFun` a
-- {a} (Arith a) => a -> a
arith1 = let a = var 0 KType
in forAll [a] [ pArith a ] $ a `tFun` a
-- {a} (Cmp a) => a -> a -> Bit
rel2 = let a = var 0 KType
in forAll [a] [ pCmp a ] $ a `tFun` a `tFun` tBit
-- {a} (Cmp a) => a -> a -> a
cmp2 = let a = var 0 KType
in forAll [a] [ pCmp a ] $ a `tFun` a `tFun` a
-- {a b} (Cmp b) => (a -> b) -> (a -> b) -> a -> Bit
cmpFun = let a = var 0 KType
b = var 1 KType
in forAll [a,b] [ pCmp b ]
$ (a `tFun` b) `tFun` (a `tFun` b) `tFun` a `tFun` tBit
-- {a} a
logic0 = let a = var 0 KType
in forAll [a] [] a
-- {a} a -> a
logic1 = let a = var 0 KType
in forAll [a] [] (a `tFun` a)
-- {a} a -> a -> a
logic2 = let a = var 0 KType
in forAll [a] [] (a `tFun` a `tFun` a)
-- {m,n,a} (fin n) => [m] a -> [n] -> [m] a
logicShift = let m = var 0 KNum
n = var 1 KNum
a = var 2 KType
in forAll [m,n,a] [pFin n]
$ tSeq m a `tFun` tWord n `tFun` tSeq m a
-- {m,n,a} (fin n, fin m) => [m] a -> [n] -> [m] a
logicRot = let m = var 0 KNum
n = var 1 KNum
a = var 2 KType
in forAll [m,n,a] [pFin m, pFin n]
$ tSeq m a `tFun` tWord n `tFun` tSeq m a
cryptol-2.2.6/src/Cryptol/REPL/ 0000755 0000000 0000000 00000000000 12637103426 014374 5 ustar 00 0000000 0000000 cryptol-2.2.6/src/Cryptol/REPL/Command.hs 0000644 0000000 0000000 00000074656 12637103426 016330 0 ustar 00 0000000 0000000 -- |
-- Module : $Header$
-- Copyright : (c) 2013-2015 Galois, Inc.
-- License : BSD3
-- Maintainer : cryptol@galois.com
-- Stability : provisional
-- Portability : portable
{-# LANGUAGE CPP, PatternGuards, FlexibleContexts #-}
module Cryptol.REPL.Command (
-- * Commands
Command(..), CommandDescr(..), CommandBody(..)
, parseCommand
, runCommand
, splitCommand
, findCommand
, findCommandExact
, findNbCommand
, moduleCmd, loadCmd, loadPrelude
-- Misc utilities
, handleCtrlC
, sanitize
-- To support Notebook interface (might need to refactor)
, replParse
, liftModuleCmd
, moduleCmdResult
) where
import Cryptol.REPL.Monad
import Cryptol.REPL.Trie
import qualified Cryptol.ModuleSystem as M
import qualified Cryptol.ModuleSystem.Base as M (preludeName)
import qualified Cryptol.ModuleSystem.NamingEnv as M
import qualified Cryptol.ModuleSystem.Renamer as M (RenamerWarning(SymbolShadowed))
import qualified Cryptol.Eval.Value as E
import qualified Cryptol.Testing.Eval as Test
import qualified Cryptol.Testing.Random as TestR
import qualified Cryptol.Testing.Exhaust as TestX
import Cryptol.Parser
(parseExprWith,parseReplWith,ParseError(),Config(..),defaultConfig,parseModName)
import Cryptol.Parser.Position (emptyRange,getLoc)
import qualified Cryptol.TypeCheck.AST as T
import qualified Cryptol.TypeCheck.Subst as T
import qualified Cryptol.TypeCheck.InferTypes as T
import Cryptol.TypeCheck.PP (dump,ppWithNames)
import Cryptol.TypeCheck.Defaulting(defaultExpr)
import Cryptol.Utils.PP
import Cryptol.Utils.Panic(panic)
import qualified Cryptol.Parser.AST as P
import Cryptol.Prims.Doc(helpDoc)
import qualified Cryptol.Transform.Specialize as S
import Cryptol.Symbolic (ProverCommand(..), QueryType(..), SatNum(..))
import qualified Cryptol.Symbolic as Symbolic
import Control.DeepSeq
import qualified Control.Exception as X
import Control.Monad (guard,unless,forM_,when)
import Data.Char (isSpace,isPunctuation,isSymbol)
import Data.Function (on)
import Data.List (intercalate,isPrefixOf,nub)
import Data.Maybe (fromMaybe,mapMaybe)
import System.Environment (lookupEnv)
import System.Exit (ExitCode(ExitSuccess))
import System.Process (shell,createProcess,waitForProcess)
import qualified System.Process as Process(runCommand)
import System.FilePath((>), isPathSeparator)
import System.Directory(getHomeDirectory,setCurrentDirectory,doesDirectoryExist)
import qualified Data.Map as Map
import qualified Data.IntMap as IntMap
import System.IO(hFlush,stdout)
import System.Random.TF(newTFGen)
import Numeric (showFFloat)
#if __GLASGOW_HASKELL__ < 710
import Control.Applicative ((<$>))
import Data.Monoid (mempty)
#endif
-- Commands --------------------------------------------------------------------
-- | Commands.
data Command
= Command (REPL ()) -- ^ Successfully parsed command
| Ambiguous String [String] -- ^ Ambiguous command, list of conflicting
-- commands
| Unknown String -- ^ The unknown command
-- | Command builder.
data CommandDescr = CommandDescr
{ cNames :: [String]
, cBody :: CommandBody
, cHelp :: String
}
instance Show CommandDescr where
show = show . cNames
instance Eq CommandDescr where
(==) = (==) `on` cNames
instance Ord CommandDescr where
compare = compare `on` cNames
data CommandBody
= ExprArg (String -> REPL ())
| DeclsArg (String -> REPL ())
| ExprTypeArg (String -> REPL ())
| FilenameArg (FilePath -> REPL ())
| OptionArg (String -> REPL ())
| ShellArg (String -> REPL ())
| NoArg (REPL ())
-- | REPL command parsing.
commands :: CommandMap
commands = foldl insert emptyTrie commandList
where
insert m d = foldl (insertOne d) m (cNames d)
insertOne d m name = insertTrie name d m
-- | Notebook command parsing.
nbCommands :: CommandMap
nbCommands = foldl insert emptyTrie nbCommandList
where
insert m d = foldl (insertOne d) m (cNames d)
insertOne d m name = insertTrie name d m
-- | A subset of commands safe for Notebook execution
nbCommandList :: [CommandDescr]
nbCommandList =
[ CommandDescr [ ":t", ":type" ] (ExprArg typeOfCmd)
"check the type of an expression"
, CommandDescr [ ":b", ":browse" ] (ExprTypeArg browseCmd)
"display the current environment"
, CommandDescr [ ":?", ":help" ] (ExprArg helpCmd)
"display a brief description about a built-in operator"
, CommandDescr [ ":s", ":set" ] (OptionArg setOptionCmd)
"set an environmental option (:set on its own displays current values)"
, CommandDescr [ ":check" ] (ExprArg (qcCmd QCRandom))
"use random testing to check that the argument always returns true (if no argument, check all properties)"
, CommandDescr [ ":exhaust" ] (ExprArg (qcCmd QCExhaust))
"use exhaustive testing to prove that the argument always returns true (if no argument, check all properties)"
, CommandDescr [ ":prove" ] (ExprArg proveCmd)
"use an external solver to prove that the argument always returns true (if no argument, check all properties)"
, CommandDescr [ ":sat" ] (ExprArg satCmd)
"use a solver to find a satisfying assignment for which the argument returns true (if no argument, find an assignment for all properties)"
, CommandDescr [ ":debug_specialize" ] (ExprArg specializeCmd)
"do type specialization on a closed expression"
]
commandList :: [CommandDescr]
commandList =
nbCommandList ++
[ CommandDescr [ ":q", ":quit" ] (NoArg quitCmd)
"exit the REPL"
, CommandDescr [ ":l", ":load" ] (FilenameArg loadCmd)
"load a module"
, CommandDescr [ ":r", ":reload" ] (NoArg reloadCmd)
"reload the currently loaded module"
, CommandDescr [ ":e", ":edit" ] (FilenameArg editCmd)
"edit the currently loaded module"
, CommandDescr [ ":!" ] (ShellArg runShellCmd)
"execute a command in the shell"
, CommandDescr [ ":cd" ] (FilenameArg cdCmd)
"set the current working directory"
, CommandDescr [ ":m", ":module" ] (FilenameArg moduleCmd)
"load a module"
]
genHelp :: [CommandDescr] -> [String]
genHelp cs = map cmdHelp cs
where
cmdHelp cmd = concat [ " ", cmdNames cmd, pad (cmdNames cmd), cHelp cmd ]
cmdNames cmd = intercalate ", " (cNames cmd)
padding = 2 + maximum (map (length . cmdNames) cs)
pad n = replicate (max 0 (padding - length n)) ' '
-- Command Evaluation ----------------------------------------------------------
-- | Run a command.
runCommand :: Command -> REPL ()
runCommand c = case c of
Command cmd -> cmd `Cryptol.REPL.Monad.catch` handler
where
handler re = rPutStrLn "" >> rPrint (pp re)
Unknown cmd -> rPutStrLn ("Unknown command: " ++ cmd)
Ambiguous cmd cmds -> do
rPutStrLn (cmd ++ " is ambiguous, it could mean one of:")
rPutStrLn ("\t" ++ intercalate ", " cmds)
-- Get the setting we should use for displaying values.
getPPValOpts :: REPL E.PPOpts
getPPValOpts =
do EnvNum base <- getUser "base"
EnvBool ascii <- getUser "ascii"
EnvNum infLength <- getUser "infLength"
return E.PPOpts { E.useBase = base
, E.useAscii = ascii
, E.useInfLength = infLength
}
evalCmd :: String -> REPL ()
evalCmd str = do
letEnabled <- getLetEnabled
ri <- if letEnabled
then replParseInput str
else P.ExprInput <$> replParseExpr str
case ri of
P.ExprInput expr -> do
(val,_ty) <- replEvalExpr expr
ppOpts <- getPPValOpts
-- This is the point where the value gets forced. We deepseq the
-- pretty-printed representation of it, rather than the value
-- itself, leaving it up to the pretty-printer to determine how
-- much of the value to force
out <- io $ rethrowEvalError
$ return $!! show $ pp $ E.WithBase ppOpts val
rPutStrLn out
P.LetInput decl -> do
-- explicitly make this a top-level declaration, so that it will
-- be generalized if mono-binds is enabled
replEvalDecl decl
data QCMode = QCRandom | QCExhaust deriving (Eq, Show)
-- | Randomly test a property, or exhaustively check it if the number
-- of values in the type under test is smaller than the @tests@
-- environment variable, or we specify exhaustive testing.
qcCmd :: QCMode -> String -> REPL ()
qcCmd qcMode "" =
do xs <- getPropertyNames
if null xs
then rPutStrLn "There are no properties in scope."
else forM_ xs $ \x ->
do rPutStr $ "property " ++ x ++ " "
qcCmd qcMode x
qcCmd qcMode str =
do expr <- replParseExpr str
(val,ty) <- replEvalExpr expr
EnvNum testNum <- getUser "tests"
case TestX.testableType ty of
Just (sz,vss) | qcMode == QCExhaust || sz <= toInteger testNum ->
do rPutStrLn "Using exhaustive testing."
let doTest _ [] = panic "We've unexpectedly run out of test cases"
[]
doTest _ (vs : vss1) = do
result <- TestX.runOneTest val vs
return (result, vss1)
ok <- go doTest sz 0 vss
when ok $ rPutStrLn "Q.E.D."
n -> case TestR.testableType ty of
Nothing -> raise (TypeNotTestable ty)
Just gens ->
do rPutStrLn "Using random testing."
prt testingMsg
g <- io newTFGen
ok <- go (TestR.runOneTest val gens) testNum 0 g
when ok $
case n of
Just (valNum,_) ->
do let valNumD = fromIntegral valNum :: Double
percent = fromIntegral (testNum * 100)
/ valNumD
showValNum
| valNum > 2 ^ (20::Integer) =
"2^^" ++ show (round $ logBase 2 valNumD :: Integer)
| otherwise = show valNum
rPutStrLn $ "Coverage: "
++ showFFloat (Just 2) percent "% ("
++ show testNum ++ " of "
++ showValNum ++ " values)"
Nothing -> return ()
where
testingMsg = "testing..."
totProgressWidth = 4 -- 100%
prt msg = rPutStr msg >> io (hFlush stdout)
prtLn msg = rPutStrLn msg >> io (hFlush stdout)
ppProgress this tot = unlessBatch $
let percent = show (div (100 * this) tot) ++ "%"
width = length percent
pad = replicate (totProgressWidth - width) ' '
in prt (pad ++ percent)
del n = unlessBatch $ prt (replicate n '\BS')
delTesting = del (length testingMsg)
delProgress = del totProgressWidth
go _ totNum testNum _
| testNum >= totNum =
do delTesting
prtLn $ "passed " ++ show totNum ++ " tests."
return True
go doTest totNum testNum st =
do ppProgress testNum totNum
res <- io $ doTest (div (100 * (1 + testNum)) totNum) st
opts <- getPPValOpts
delProgress
case res of
(Test.Pass, st1) -> do delProgress
go doTest totNum (testNum + 1) st1
(failure, _g1) -> do
delTesting
case failure of
Test.FailFalse [] -> do
prtLn "FAILED"
Test.FailFalse vs -> do
prtLn "FAILED for the following inputs:"
mapM_ (rPrint . pp . E.WithBase opts) vs
Test.FailError err [] -> do
prtLn "ERROR"
rPrint (pp err)
Test.FailError err vs -> do
prtLn "ERROR for the following inputs:"
mapM_ (rPrint . pp . E.WithBase opts) vs
rPrint (pp err)
Test.Pass -> panic "Cryptol.REPL.Command" ["unexpected Test.Pass"]
return False
satCmd, proveCmd :: String -> REPL ()
satCmd = cmdProveSat True
proveCmd = cmdProveSat False
-- | Console-specific version of 'proveSat'. Prints output to the
-- console, and binds the @it@ variable to a record whose form depends
-- on the expression given. See ticket #66 for a discussion of this
-- design.
cmdProveSat :: Bool -> String -> REPL ()
cmdProveSat isSat "" =
do xs <- getPropertyNames
if null xs
then rPutStrLn "There are no properties in scope."
else forM_ xs $ \x ->
do if isSat
then rPutStr $ ":sat " ++ x ++ "\n\t"
else rPutStr $ ":prove " ++ x ++ "\n\t"
cmdProveSat isSat x
cmdProveSat isSat expr = do
let cexStr | isSat = "satisfying assignment"
| otherwise = "counterexample"
EnvString proverName <- getUser "prover"
EnvString fileName <- getUser "smtfile"
let mfile = if fileName == "-" then Nothing else Just fileName
case proverName of
"offline" -> do
result <- offlineProveSat isSat expr mfile
case result of
Left msg -> rPutStrLn msg
Right smtlib -> do
let filename = fromMaybe "standard output" mfile
let satWord | isSat = "satisfiability"
| otherwise = "validity"
rPutStrLn $
"Writing to SMT-Lib file " ++ filename ++ "..."
rPutStrLn $
"To determine the " ++ satWord ++
" of the expression, use an external SMT solver."
case mfile of
Just path -> io $ writeFile path smtlib
Nothing -> rPutStr smtlib
_ -> do
result <- onlineProveSat isSat expr proverName mfile
ppOpts <- getPPValOpts
case result of
Symbolic.EmptyResult ->
panic "REPL.Command" [ "got EmptyResult for online prover query" ]
Symbolic.ProverError msg -> rPutStrLn msg
Symbolic.ThmResult ts -> do
rPutStrLn (if isSat then "Unsatisfiable" else "Q.E.D.")
let (t, e) = mkSolverResult cexStr (not isSat) (Left ts)
bindItVariable t e
Symbolic.AllSatResult tevss -> do
let tess = map (map $ \(t,e,_) -> (t,e)) tevss
vss = map (map $ \(_,_,v) -> v) tevss
ppvs vs = do
parseExpr <- replParseExpr expr
let docs = map (pp . E.WithBase ppOpts) vs
-- function application has precedence 3
doc = ppPrec 3 parseExpr
rPrint $ hsep (doc : docs) <+>
text (if isSat then "= True" else "= False")
resultRecs = map (mkSolverResult cexStr isSat . Right) tess
collectTes tes = (t, es)
where
(ts, es) = unzip tes
t = case nub ts of
[t'] -> t'
_ -> panic "REPL.Command.onlineProveSat"
[ "satisfying assignments with different types" ]
(ty, exprs) =
case resultRecs of
[] -> panic "REPL.Command.onlineProveSat"
[ "no satisfying assignments after mkSovlerResult" ]
[(t, e)] -> (t, [e])
_ -> collectTes resultRecs
forM_ vss ppvs
case (ty, exprs) of
(t, [e]) -> bindItVariable t e
(t, es ) -> bindItVariables t es
onlineProveSat :: Bool
-> String -> String -> Maybe FilePath -> REPL Symbolic.ProverResult
onlineProveSat isSat str proverName mfile = do
EnvBool verbose <- getUser "debug"
satNum <- getUserSatNum
parseExpr <- replParseExpr str
(expr, schema) <- replCheckExpr parseExpr
decls <- fmap M.deDecls getDynEnv
let cmd = Symbolic.ProverCommand {
pcQueryType = if isSat then SatQuery satNum else ProveQuery
, pcProverName = proverName
, pcVerbose = verbose
, pcExtraDecls = decls
, pcSmtFile = mfile
, pcExpr = expr
, pcSchema = schema
}
liftModuleCmd $ Symbolic.satProve cmd
offlineProveSat :: Bool -> String -> Maybe FilePath -> REPL (Either String String)
offlineProveSat isSat str mfile = do
EnvBool verbose <- getUser "debug"
parseExpr <- replParseExpr str
(expr, schema) <- replCheckExpr parseExpr
decls <- fmap M.deDecls getDynEnv
let cmd = Symbolic.ProverCommand {
pcQueryType = if isSat then SatQuery (SomeSat 0) else ProveQuery
, pcProverName = "offline"
, pcVerbose = verbose
, pcExtraDecls = decls
, pcSmtFile = mfile
, pcExpr = expr
, pcSchema = schema
}
liftModuleCmd $ Symbolic.satProveOffline cmd
-- | Make a type/expression pair that is suitable for binding to @it@
-- after running @:sat@ or @:prove@
mkSolverResult :: String
-> Bool
-> Either [T.Type] [(T.Type, T.Expr)]
-> (T.Type, T.Expr)
mkSolverResult thing result earg = (rty, re)
where
rName = T.Name "result"
rty = T.TRec $ [(rName, T.tBit )] ++ map fst argF
re = T.ERec $ [(rName, resultE)] ++ map snd argF
resultE = if result then T.eTrue else T.eFalse
mkArgs tes = reverse (go tes [] (1 :: Int))
where
go [] fs _ = fs
go ((t, e):tes') fs n = go tes' (((argName, t), (argName, e)):fs) (n+1)
where argName = T.Name ("arg" ++ show n)
argF = case earg of
Left ts -> mkArgs $ (map addError) ts
where addError t = (t, T.eError t ("no " ++ thing ++ " available"))
Right tes -> mkArgs tes
specializeCmd :: String -> REPL ()
specializeCmd str = do
parseExpr <- replParseExpr str
(expr, schema) <- replCheckExpr parseExpr
spexpr <- replSpecExpr expr
rPutStrLn "Expression type:"
rPrint $ pp schema
rPutStrLn "Original expression:"
rPutStrLn $ dump expr
rPutStrLn "Specialized expression:"
rPutStrLn $ dump spexpr
typeOfCmd :: String -> REPL ()
typeOfCmd str = do
expr <- replParseExpr str
(def,sig) <- replCheckExpr expr
-- XXX need more warnings from the module system
--io (mapM_ printWarning ws)
whenDebug (rPutStrLn (dump def))
rPrint $ pp expr <+> text ":" <+> pp sig
reloadCmd :: REPL ()
reloadCmd = do
mb <- getLoadedMod
case mb of
Just m -> loadCmd (lPath m)
Nothing -> return ()
editCmd :: String -> REPL ()
editCmd path
| null path = do
mb <- getLoadedMod
case mb of
Just m -> do
success <- replEdit (lPath m)
if success
then loadCmd (lPath m)
else return ()
Nothing -> do
rPutStrLn "No files to edit."
return ()
| otherwise = do
_ <- replEdit path
mb <- getLoadedMod
case mb of
Nothing -> loadCmd path
Just _ -> return ()
moduleCmd :: String -> REPL ()
moduleCmd modString
| null modString = return ()
| otherwise = do
case parseModName modString of
Just m -> loadCmd =<< liftModuleCmd (M.findModule m)
Nothing -> rPutStrLn "Invalid module name."
loadPrelude :: REPL ()
loadPrelude = moduleCmd $ show $ pp M.preludeName
loadCmd :: FilePath -> REPL ()
loadCmd path
| null path = return ()
| otherwise = do
setLoadedMod LoadedModule
{ lName = Nothing
, lPath = path
}
m <- liftModuleCmd (M.loadModuleByPath path)
whenDebug (rPutStrLn (dump m))
setLoadedMod LoadedModule
{ lName = Just (T.mName m)
, lPath = path
}
setDynEnv mempty
quitCmd :: REPL ()
quitCmd = stop
browseCmd :: String -> REPL ()
browseCmd pfx = do
browseTSyns pfx
browseNewtypes pfx
browseVars pfx
browseTSyns :: String -> REPL ()
browseTSyns pfx = do
tsyns <- getTSyns
let tsyns' = Map.filterWithKey (\k _ -> pfx `isNamePrefix` k) tsyns
unless (Map.null tsyns') $ do
rPutStrLn "Type Synonyms"
rPutStrLn "============="
let ppSyn (qn,T.TySyn _ ps cs ty) = pp (T.TySyn qn ps cs ty)
rPrint (nest 4 (vcat (map ppSyn (Map.toList tsyns'))))
rPutStrLn ""
browseNewtypes :: String -> REPL ()
browseNewtypes pfx = do
nts <- getNewtypes
let nts' = Map.filterWithKey (\k _ -> pfx `isNamePrefix` k) nts
unless (Map.null nts') $ do
rPutStrLn "Newtypes"
rPutStrLn "========"
let ppNT (qn,nt) = T.ppNewtypeShort (nt { T.ntName = qn })
rPrint (nest 4 (vcat (map ppNT (Map.toList nts'))))
rPutStrLn ""
browseVars :: String -> REPL ()
browseVars pfx = do
vars <- getVars
let allNames = vars
{- This shows the built-ins as well:
Map.union vars
(Map.fromList [ (Name x,t) | (x,(_,t)) <- builtIns ]) -}
vars' = Map.filterWithKey (\k _ -> pfx `isNamePrefix` k) allNames
isProp p = T.PragmaProperty `elem` (M.ifDeclPragmas p)
(props,syms) = Map.partition isProp vars'
ppBlock "Properties" props
ppBlock "Symbols" syms
where
ppBlock name xs =
unless (Map.null xs) $ do
rPutStrLn name
rPutStrLn (replicate (length name) '=')
let step k d acc =
pp k <+> char ':' <+> pp (M.ifDeclSig d) : acc
rPrint (nest 4 (vcat (Map.foldrWithKey step [] xs)))
rPutStrLn ""
setOptionCmd :: String -> REPL ()
setOptionCmd str
| Just value <- mbValue = setUser key value
| null key = mapM_ (describe . optName) (leaves userOptions)
| otherwise = describe key
where
(before,after) = break (== '=') str
key = trim before
mbValue = case after of
_ : stuff -> Just (trim stuff)
_ -> Nothing
describe k = do
ev <- tryGetUser k
case ev of
Just (EnvString s) -> rPutStrLn (k ++ " = " ++ s)
Just (EnvNum n) -> rPutStrLn (k ++ " = " ++ show n)
Just (EnvBool True) -> rPutStrLn (k ++ " = on")
Just (EnvBool False) -> rPutStrLn (k ++ " = off")
Nothing -> do rPutStrLn ("Unknown user option: `" ++ k ++ "`")
when (any isSpace k) $ do
let (k1, k2) = break isSpace k
rPutStrLn ("Did you mean: `:set " ++ k1 ++ " =" ++ k2 ++ "`?")
helpCmd :: String -> REPL ()
helpCmd cmd
| null cmd = mapM_ rPutStrLn (genHelp commandList)
| Just (ec,_) <- lookup cmd builtIns =
rPrint $ helpDoc ec
| otherwise = do rPutStrLn $ "// No documentation is available."
typeOfCmd cmd
runShellCmd :: String -> REPL ()
runShellCmd cmd
= io $ do h <- Process.runCommand cmd
_ <- waitForProcess h
return ()
cdCmd :: FilePath -> REPL ()
cdCmd f | null f = rPutStrLn $ "[error] :cd requires a path argument"
| otherwise = do
exists <- io $ doesDirectoryExist f
if exists
then io $ setCurrentDirectory f
else raise $ DirectoryNotFound f
-- C-c Handlings ---------------------------------------------------------------
-- XXX this should probably do something a bit more specific.
handleCtrlC :: REPL ()
handleCtrlC = rPutStrLn "Ctrl-C"
-- Utilities -------------------------------------------------------------------
isNamePrefix :: String -> P.QName -> Bool
isNamePrefix pfx n = case n of
P.QName _ (P.Name _) -> pfx `isPrefixOf` pretty n
_ -> False
{-
printWarning :: (Range,Warning) -> IO ()
printWarning = print . ppWarning
printError :: (Range,Error) -> IO ()
printError = print . ppError
-}
-- | Lift a parsing action into the REPL monad.
replParse :: (String -> Either ParseError a) -> String -> REPL a
replParse parse str = case parse str of
Right a -> return a
Left e -> raise (ParseError e)
replParseInput :: String -> REPL P.ReplInput
replParseInput = replParse $ parseReplWith interactiveConfig
replParseExpr :: String -> REPL P.Expr
replParseExpr = replParse $ parseExprWith interactiveConfig
interactiveConfig :: Config
interactiveConfig = defaultConfig { cfgSource = "" }
liftModuleCmd :: M.ModuleCmd a -> REPL a
liftModuleCmd cmd = moduleCmdResult =<< io . cmd =<< getModuleEnv
moduleCmdResult :: M.ModuleRes a -> REPL a
moduleCmdResult (res,ws0) = do
EnvBool warnDefaulting <- getUser "warnDefaulting"
EnvBool warnShadowing <- getUser "warnShadowing"
-- XXX: let's generalize this pattern
let isDefaultWarn (T.DefaultingTo _ _) = True
isDefaultWarn _ = False
filterDefaults w | warnDefaulting = Just w
filterDefaults (M.TypeCheckWarnings xs) =
case filter (not . isDefaultWarn . snd) xs of
[] -> Nothing
ys -> Just (M.TypeCheckWarnings ys)
filterDefaults w = Just w
isShadowWarn (M.SymbolShadowed _ _) = True
filterShadowing w | warnShadowing = Just w
filterShadowing (M.RenamerWarnings xs) =
case filter (not . isShadowWarn) xs of
[] -> Nothing
ys -> Just (M.RenamerWarnings ys)
filterShadowing w = Just w
let ws = mapMaybe filterDefaults . mapMaybe filterShadowing $ ws0
mapM_ (rPrint . pp) ws
case res of
Right (a,me') -> setModuleEnv me' >> return a
Left err -> raise (ModuleSystemError err)
replCheckExpr :: P.Expr -> REPL (T.Expr,T.Schema)
replCheckExpr e = liftModuleCmd $ M.checkExpr e
-- | Check declarations as though they were defined at the top-level.
replCheckDecls :: [P.Decl] -> REPL [T.DeclGroup]
replCheckDecls ds = do
npds <- liftModuleCmd $ M.noPat ds
denv <- getDynEnv
let dnames = M.namingEnv npds
ne' <- M.travNamingEnv uniqify dnames
let denv' = denv { M.deNames = ne' `M.shadowing` M.deNames denv }
undo exn = do
-- if typechecking fails, we want to revert changes to the
-- dynamic environment and reraise
setDynEnv denv
raise exn
setDynEnv denv'
let topDecls = [ P.Decl (P.TopLevel P.Public d) | d <- npds ]
catch (liftModuleCmd $ M.checkDecls topDecls) undo
replSpecExpr :: T.Expr -> REPL T.Expr
replSpecExpr e = liftModuleCmd $ S.specialize e
replEvalExpr :: P.Expr -> REPL (E.Value, T.Type)
replEvalExpr expr =
do (def,sig) <- replCheckExpr expr
let range = fromMaybe emptyRange (getLoc expr)
(def1,ty) <-
case defaultExpr range def sig of
Nothing -> raise (EvalPolyError sig)
Just (tys,def1) ->
do let nms = T.addTNames (T.sVars sig) IntMap.empty
mapM_ (warnDefault nms) tys
let su = T.listSubst [ (T.tpVar a, t) | (a,t) <- tys ]
return (def1, T.apSubst su (T.sType sig))
val <- liftModuleCmd (M.evalExpr def1)
_ <- io $ rethrowEvalError $ X.evaluate val
whenDebug (rPutStrLn (dump def1))
-- add "it" to the namespace
bindItVariable ty def1
return (val,ty)
where
warnDefault ns (x,t) =
rPrint $ text "Assuming" <+> ppWithNames ns x <+> text "=" <+> pp t
-- | Creates a fresh binding of "it" to the expression given, and adds
-- it to the current dynamic environment
bindItVariable :: T.Type -> T.Expr -> REPL ()
bindItVariable ty expr = do
let it = T.QName Nothing (P.Name "it")
freshIt <- uniqify it
let dg = T.NonRecursive decl
schema = T.Forall { T.sVars = []
, T.sProps = []
, T.sType = ty
}
decl = T.Decl { T.dName = freshIt
, T.dSignature = schema
, T.dDefinition = expr
, T.dPragmas = []
}
liftModuleCmd (M.evalDecls [dg])
denv <- getDynEnv
let en = M.EFromBind (P.Located emptyRange freshIt)
nenv' = M.singletonE it en `M.shadowing` M.deNames denv
setDynEnv $ denv { M.deNames = nenv' }
-- | Creates a fresh binding of "it" to a finite sequence of
-- expressions of the same type, and adds that sequence to the current
-- dynamic environment
bindItVariables :: T.Type -> [T.Expr] -> REPL ()
bindItVariables ty exprs = bindItVariable seqTy seqExpr
where
len = length exprs
seqTy = T.tSeq (T.tNum len) ty
seqExpr = T.EList exprs ty
replEvalDecl :: P.Decl -> REPL ()
replEvalDecl decl = do
dgs <- replCheckDecls [decl]
whenDebug (mapM_ (\dg -> (rPutStrLn (dump dg))) dgs)
liftModuleCmd (M.evalDecls dgs)
replEdit :: String -> REPL Bool
replEdit file = do
mb <- io (lookupEnv "EDITOR")
let editor = fromMaybe "vim" mb
io $ do
(_,_,_,ph) <- createProcess (shell (unwords [editor, file]))
exit <- waitForProcess ph
return (exit == ExitSuccess)
type CommandMap = Trie CommandDescr
-- Command Parsing -------------------------------------------------------------
-- | Strip leading space.
sanitize :: String -> String
sanitize = dropWhile isSpace
-- | Strip trailing space.
sanitizeEnd :: String -> String
sanitizeEnd = reverse . sanitize . reverse
trim :: String -> String
trim = sanitizeEnd . sanitize
-- | Split at the first word boundary.
splitCommand :: String -> Maybe (String,String)
splitCommand txt =
case sanitize txt of
':' : more
| (as,bs) <- span (\x -> isPunctuation x || isSymbol x) more
, not (null as) -> Just (':' : as, sanitize bs)
| (as,bs) <- break isSpace more
, not (null as) -> Just (':' : as, sanitize bs)
| otherwise -> Nothing
expr -> guard (not (null expr)) >> return (expr,[])
-- | Uncons a list.
uncons :: [a] -> Maybe (a,[a])
uncons as = case as of
a:rest -> Just (a,rest)
_ -> Nothing
-- | Lookup a string in the command list.
findCommand :: String -> [CommandDescr]
findCommand str = lookupTrie str commands
-- | Lookup a string in the command list, returning an exact match
-- even if it's the prefix of another command.
findCommandExact :: String -> [CommandDescr]
findCommandExact str = lookupTrieExact str commands
-- | Lookup a string in the notebook-safe command list.
findNbCommand :: Bool -> String -> [CommandDescr]
findNbCommand True str = lookupTrieExact str nbCommands
findNbCommand False str = lookupTrie str nbCommands
-- | Parse a line as a command.
parseCommand :: (String -> [CommandDescr]) -> String -> Maybe Command
parseCommand findCmd line = do
(cmd,args) <- splitCommand line
let args' = sanitizeEnd args
case findCmd cmd of
[c] -> case cBody c of
ExprArg body -> Just (Command (body args'))
DeclsArg body -> Just (Command (body args'))
ExprTypeArg body -> Just (Command (body args'))
FilenameArg body -> Just (Command (body =<< expandHome args'))
OptionArg body -> Just (Command (body args'))
ShellArg body -> Just (Command (body args'))
NoArg body -> Just (Command body)
[] -> case uncons cmd of
Just (':',_) -> Just (Unknown cmd)
Just _ -> Just (Command (evalCmd line))
_ -> Nothing
cs -> Just (Ambiguous cmd (concatMap cNames cs))
where
expandHome path =
case path of
'~' : c : more | isPathSeparator c -> do dir <- io getHomeDirectory
return (dir > more)
_ -> return path
cryptol-2.2.6/src/Cryptol/REPL/Monad.hs 0000644 0000000 0000000 00000045342 12637103426 015776 0 ustar 00 0000000 0000000 -- |
-- Module : $Header$
-- Copyright : (c) 2013-2015 Galois, Inc.
-- License : BSD3
-- Maintainer : cryptol@galois.com
-- Stability : provisional
-- Portability : portable
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE LambdaCase #-}
module Cryptol.REPL.Monad (
-- * REPL Monad
REPL(..), runREPL
, io
, raise
, stop
, catch
, rPutStrLn
, rPutStr
, rPrint
-- ** Errors
, REPLException(..)
, rethrowEvalError
-- ** Environment
, getModuleEnv, setModuleEnv
, getDynEnv, setDynEnv
, uniqify
, getTSyns, getNewtypes, getVars
, whenDebug
, getExprNames
, getTypeNames
, getPropertyNames
, LoadedModule(..), getLoadedMod, setLoadedMod
, setSearchPath, prependSearchPath
, builtIns
, getPrompt
, shouldContinue
, unlessBatch
, asBatch
, disableLet
, enableLet
, getLetEnabled
, updateREPLTitle
, setUpdateREPLTitle
-- ** Config Options
, EnvVal(..)
, OptionDescr(..)
, setUser, getUser, tryGetUser
, userOptions
, getUserSatNum
-- ** Configurable Output
, getPutStr
, setPutStr
-- ** Smoke Test
, smokeTest
, Smoke(..)
) where
import Cryptol.REPL.Trie
import Cryptol.Prims.Types(typeOf)
import Cryptol.Prims.Syntax(ECon(..),ppPrefix)
import Cryptol.Eval (EvalError)
import qualified Cryptol.ModuleSystem as M
import qualified Cryptol.ModuleSystem.Env as M
import qualified Cryptol.ModuleSystem.NamingEnv as M
import Cryptol.Parser (ParseError,ppError)
import Cryptol.Parser.NoInclude (IncludeError,ppIncludeError)
import Cryptol.Parser.NoPat (Error)
import qualified Cryptol.TypeCheck.AST as T
import Cryptol.Utils.PP
import Cryptol.Utils.Panic (panic)
import qualified Cryptol.Parser.AST as P
import Cryptol.Symbolic (proverNames, lookupProver, SatNum(..))
import Control.Monad (ap,unless,when)
import Data.IORef
(IORef,newIORef,readIORef,modifyIORef)
import Data.List (intercalate, isPrefixOf)
import Data.Maybe (catMaybes)
import Data.Typeable (Typeable)
import System.Directory (findExecutable)
import qualified Control.Exception as X
import qualified Data.Map as Map
import Text.Read (readMaybe)
import Data.SBV.Dynamic (sbvCheckSolverInstallation)
#if __GLASGOW_HASKELL__ < 710
import Control.Applicative ((<$>), Applicative(..))
import Data.Monoid (Monoid(..))
#endif
-- REPL Environment ------------------------------------------------------------
data LoadedModule = LoadedModule
{ lName :: Maybe P.ModName -- ^ Focused module
, lPath :: FilePath -- ^ Focused file
}
-- | REPL RW Environment.
data RW = RW
{ eLoadedMod :: Maybe LoadedModule
, eContinue :: Bool
, eIsBatch :: Bool
, eModuleEnv :: M.ModuleEnv
, eNameSupply :: Int
, eUserEnv :: UserEnv
, ePutStr :: String -> IO ()
, eLetEnabled :: Bool
, eUpdateTitle :: REPL ()
}
-- | Initial, empty environment.
defaultRW :: Bool -> IO RW
defaultRW isBatch = do
env <- M.initialModuleEnv
return RW
{ eLoadedMod = Nothing
, eContinue = True
, eIsBatch = isBatch
, eModuleEnv = env
, eNameSupply = 0
, eUserEnv = mkUserEnv userOptions
, ePutStr = putStr
, eLetEnabled = True
, eUpdateTitle = return ()
}
-- | Build up the prompt for the REPL.
mkPrompt :: RW -> String
mkPrompt rw
| eIsBatch rw = ""
| otherwise = maybe "cryptol" pretty (lName =<< eLoadedMod rw) ++ "> "
-- REPL Monad ------------------------------------------------------------------
-- | REPL_ context with InputT handling.
newtype REPL a = REPL { unREPL :: IORef RW -> IO a }
-- | Run a REPL action with a fresh environment.
runREPL :: Bool -> REPL a -> IO a
runREPL isBatch m = do
ref <- newIORef =<< defaultRW isBatch
unREPL m ref
instance Functor REPL where
{-# INLINE fmap #-}
fmap f m = REPL (\ ref -> fmap f (unREPL m ref))
instance Applicative REPL where
{-# INLINE pure #-}
pure = return
{-# INLINE (<*>) #-}
(<*>) = ap
instance Monad REPL where
{-# INLINE return #-}
return x = REPL (\_ -> return x)
{-# INLINE (>>=) #-}
m >>= f = REPL $ \ref -> do
x <- unREPL m ref
unREPL (f x) ref
-- Exceptions ------------------------------------------------------------------
-- | REPL exceptions.
data REPLException
= ParseError ParseError
| FileNotFound FilePath
| DirectoryNotFound FilePath
| NoPatError [Error]
| NoIncludeError [IncludeError]
| EvalError EvalError
| ModuleSystemError M.ModuleError
| EvalPolyError T.Schema
| TypeNotTestable T.Type
deriving (Show,Typeable)
instance X.Exception REPLException
instance PP REPLException where
ppPrec _ re = case re of
ParseError e -> ppError e
FileNotFound path -> sep [ text "File"
, text ("`" ++ path ++ "'")
, text"not found"
]
DirectoryNotFound path -> sep [ text "Directory"
, text ("`" ++ path ++ "'")
, text"not found or not a directory"
]
NoPatError es -> vcat (map pp es)
NoIncludeError es -> vcat (map ppIncludeError es)
ModuleSystemError me -> pp me
EvalError e -> pp e
EvalPolyError s -> text "Cannot evaluate polymorphic value."
$$ text "Type:" <+> pp s
TypeNotTestable t -> text "The expression is not of a testable type."
$$ text "Type:" <+> pp t
-- | Raise an exception.
raise :: REPLException -> REPL a
raise exn = io (X.throwIO exn)
catch :: REPL a -> (REPLException -> REPL a) -> REPL a
catch m k = REPL (\ ref -> unREPL m ref `X.catch` \ e -> unREPL (k e) ref)
rethrowEvalError :: IO a -> IO a
rethrowEvalError m = run `X.catch` rethrow
where
run = do
a <- m
return $! a
rethrow :: EvalError -> IO a
rethrow exn = X.throwIO (EvalError exn)
-- Primitives ------------------------------------------------------------------
io :: IO a -> REPL a
io m = REPL (\ _ -> m)
getRW :: REPL RW
getRW = REPL readIORef
modifyRW_ :: (RW -> RW) -> REPL ()
modifyRW_ f = REPL (\ ref -> modifyIORef ref f)
-- | Construct the prompt for the current environment.
getPrompt :: REPL String
getPrompt = mkPrompt `fmap` getRW
-- | Set the name of the currently focused file, edited by @:e@ and loaded via
-- @:r@.
setLoadedMod :: LoadedModule -> REPL ()
setLoadedMod n = do
modifyRW_ (\ rw -> rw { eLoadedMod = Just n })
updateREPLTitle
getLoadedMod :: REPL (Maybe LoadedModule)
getLoadedMod = eLoadedMod `fmap` getRW
setSearchPath :: [FilePath] -> REPL ()
setSearchPath path = do
me <- getModuleEnv
setModuleEnv $ me { M.meSearchPath = path }
prependSearchPath :: [FilePath] -> REPL ()
prependSearchPath path = do
me <- getModuleEnv
setModuleEnv $ me { M.meSearchPath = path ++ M.meSearchPath me }
shouldContinue :: REPL Bool
shouldContinue = eContinue `fmap` getRW
stop :: REPL ()
stop = modifyRW_ (\ rw -> rw { eContinue = False })
unlessBatch :: REPL () -> REPL ()
unlessBatch body = do
rw <- getRW
unless (eIsBatch rw) body
-- | Run a computation in batch mode, restoring the previous isBatch
-- flag afterwards
asBatch :: REPL () -> REPL ()
asBatch body = do
wasBatch <- eIsBatch `fmap` getRW
modifyRW_ $ (\ rw -> rw { eIsBatch = True })
body
modifyRW_ $ (\ rw -> rw { eIsBatch = wasBatch })
disableLet :: REPL ()
disableLet = modifyRW_ (\ rw -> rw { eLetEnabled = False })
enableLet :: REPL ()
enableLet = modifyRW_ (\ rw -> rw { eLetEnabled = True })
-- | Are let-bindings enabled in this REPL?
getLetEnabled :: REPL Bool
getLetEnabled = fmap eLetEnabled getRW
-- | Update the title
updateREPLTitle :: REPL ()
updateREPLTitle = unlessBatch $ do
rw <- getRW
eUpdateTitle rw
-- | Set the function that will be called when updating the title
setUpdateREPLTitle :: REPL () -> REPL ()
setUpdateREPLTitle m = modifyRW_ (\rw -> rw { eUpdateTitle = m })
-- | Set the REPL's string-printer
setPutStr :: (String -> IO ()) -> REPL ()
setPutStr fn = modifyRW_ (\rw -> rw { ePutStr = fn })
-- | Get the REPL's string-printer
getPutStr :: REPL (String -> IO ())
getPutStr = fmap ePutStr getRW
-- | Use the configured output action to print a string
rPutStr :: String -> REPL ()
rPutStr str = do
rw <- getRW
io $ ePutStr rw str
-- | Use the configured output action to print a string with a trailing newline
rPutStrLn :: String -> REPL ()
rPutStrLn str = rPutStr $ str ++ "\n"
-- | Use the configured output action to print something using its Show instance
rPrint :: Show a => a -> REPL ()
rPrint x = rPutStrLn (show x)
builtIns :: [(String,(ECon,T.Schema))]
builtIns = map mk [ minBound .. maxBound :: ECon ]
where mk x = (show (ppPrefix x), (x, typeOf x))
-- | Only meant for use with one of getVars or getTSyns.
keepOne :: String -> [a] -> a
keepOne src as = case as of
[a] -> a
_ -> panic ("REPL: " ++ src) ["name clash in interface file"]
getVars :: REPL (Map.Map P.QName M.IfaceDecl)
getVars = do
me <- getModuleEnv
denv <- getDynEnv
-- the subtle part here is removing the #Uniq prefix from
-- interactively-bound variables, and also excluding any that are
-- shadowed and thus can no longer be referenced
let decls = M.focusedEnv me
edecls = M.ifDecls (M.deIfaceDecls denv)
-- is this QName something the user might actually type?
isShadowed (qn@(P.QName (Just (P.ModName ['#':_])) name), _) =
case Map.lookup localName neExprs of
Nothing -> False
Just uniqueNames -> isNamed uniqueNames
where localName = P.QName Nothing name
isNamed us = any (== qn) (map M.qname us)
neExprs = M.neExprs (M.deNames denv)
isShadowed _ = False
unqual ((P.QName _ name), ifds) = (P.QName Nothing name, ifds)
edecls' = Map.fromList
. map unqual
. filter isShadowed
$ Map.toList edecls
return (keepOne "getVars" `fmap` (M.ifDecls decls `mappend` edecls'))
getTSyns :: REPL (Map.Map P.QName T.TySyn)
getTSyns = do
me <- getModuleEnv
let decls = M.focusedEnv me
return (keepOne "getTSyns" `fmap` M.ifTySyns decls)
getNewtypes :: REPL (Map.Map P.QName T.Newtype)
getNewtypes = do
me <- getModuleEnv
let decls = M.focusedEnv me
return (keepOne "getNewtypes" `fmap` M.ifNewtypes decls)
-- | Get visible variable names.
getExprNames :: REPL [String]
getExprNames = do as <- (map getName . Map.keys) `fmap` getVars
return (map fst builtIns ++ as)
-- | Get visible type signature names.
getTypeNames :: REPL [String]
getTypeNames =
do tss <- getTSyns
nts <- getNewtypes
return $ map getName $ Map.keys tss ++ Map.keys nts
getPropertyNames :: REPL [String]
getPropertyNames =
do xs <- getVars
return [ getName x | (x,d) <- Map.toList xs,
T.PragmaProperty `elem` M.ifDeclPragmas d ]
getName :: P.QName -> String
getName = show . pp
getModuleEnv :: REPL M.ModuleEnv
getModuleEnv = eModuleEnv `fmap` getRW
setModuleEnv :: M.ModuleEnv -> REPL ()
setModuleEnv me = modifyRW_ (\rw -> rw { eModuleEnv = me })
getDynEnv :: REPL M.DynamicEnv
getDynEnv = (M.meDynEnv . eModuleEnv) `fmap` getRW
setDynEnv :: M.DynamicEnv -> REPL ()
setDynEnv denv = do
me <- getModuleEnv
setModuleEnv (me { M.meDynEnv = denv })
-- | Given an existing qualified name, prefix it with a
-- relatively-unique string. We make it unique by prefixing with a
-- character @#@ that is not lexically valid in a module name.
uniqify :: P.QName -> REPL P.QName
uniqify (P.QName Nothing name) = do
i <- eNameSupply `fmap` getRW
modifyRW_ (\rw -> rw { eNameSupply = i+1 })
let modname' = P.ModName [ '#' : ("Uniq_" ++ show i) ]
return (P.QName (Just modname') name)
uniqify qn =
panic "[REPL] uniqify" ["tried to uniqify a qualified name: " ++ pretty qn]
-- User Environment Interaction ------------------------------------------------
-- | User modifiable environment, for things like numeric base.
type UserEnv = Map.Map String EnvVal
data EnvVal
= EnvString String
| EnvNum !Int
| EnvBool Bool
deriving (Show)
-- | Generate a UserEnv from a description of the options map.
mkUserEnv :: OptionMap -> UserEnv
mkUserEnv opts = Map.fromList $ do
opt <- leaves opts
return (optName opt, optDefault opt)
-- | Set a user option.
setUser :: String -> String -> REPL ()
setUser name val = case lookupTrie name userOptions of
[opt] -> setUserOpt opt
[] -> io (putStrLn ("Unknown env value `" ++ name ++ "`"))
_ -> io (putStrLn ("Ambiguous env value `" ++ name ++ "`"))
where
setUserOpt opt = case optDefault opt of
EnvString _ -> do r <- io (optCheck opt (EnvString val))
case r of
Just err -> io (putStrLn err)
Nothing -> writeEnv (EnvString val)
EnvNum _ -> case reads val of
[(x,_)] -> do r <- io (optCheck opt (EnvNum x))
case r of
Just err -> io (putStrLn err)
Nothing -> writeEnv (EnvNum x)
_ -> io (putStrLn ("Failed to parse number for field, `" ++ name ++ "`"))
EnvBool _
| any (`isPrefixOf` val) ["enable","on","yes"] ->
writeEnv (EnvBool True)
| any (`isPrefixOf` val) ["disable","off","no"] ->
writeEnv (EnvBool False)
| otherwise ->
io (putStrLn ("Failed to parse boolean for field, `" ++ name ++ "`"))
where
writeEnv ev =
do optEff opt ev
modifyRW_ (\rw -> rw { eUserEnv = Map.insert name ev (eUserEnv rw) })
-- | Get a user option, using Maybe for failure.
tryGetUser :: String -> REPL (Maybe EnvVal)
tryGetUser name = do
rw <- getRW
return (Map.lookup name (eUserEnv rw))
-- | Get a user option, when it's known to exist. Fail with panic when it
-- doesn't.
getUser :: String -> REPL EnvVal
getUser name = do
mb <- tryGetUser name
case mb of
Just ev -> return ev
Nothing -> panic "[REPL] getUser" ["option `" ++ name ++ "` does not exist"]
-- Environment Options ---------------------------------------------------------
type OptionMap = Trie OptionDescr
mkOptionMap :: [OptionDescr] -> OptionMap
mkOptionMap = foldl insert emptyTrie
where
insert m d = insertTrie (optName d) d m
data OptionDescr = OptionDescr
{ optName :: String
, optDefault :: EnvVal
, optCheck :: EnvVal -> IO (Maybe String)
, optHelp :: String
, optEff :: EnvVal -> REPL ()
}
simpleOpt :: String -> EnvVal -> (EnvVal -> IO (Maybe String)) -> String
-> OptionDescr
simpleOpt optName optDefault optCheck optHelp =
OptionDescr { optEff = \ _ -> return (), .. }
userOptions :: OptionMap
userOptions = mkOptionMap
[ simpleOpt "base" (EnvNum 16) checkBase
"the base to display words at"
, simpleOpt "debug" (EnvBool False) (const $ return Nothing)
"enable debugging output"
, simpleOpt "ascii" (EnvBool False) (const $ return Nothing)
"display 7- or 8-bit words using ASCII notation."
, simpleOpt "infLength" (EnvNum 5) checkInfLength
"The number of elements to display for infinite sequences."
, simpleOpt "tests" (EnvNum 100) (const $ return Nothing)
"The number of random tests to try."
, simpleOpt "satNum" (EnvString "1") checkSatNum
"The maximum number of :sat solutions to display (\"all\" for no limit)."
, simpleOpt "prover" (EnvString "z3") checkProver $
"The external SMT solver for :prove and :sat (" ++ proverListString ++ ")."
, simpleOpt "warnDefaulting" (EnvBool True) (const $ return Nothing)
"Choose if we should display warnings when defaulting."
, simpleOpt "warnShadowing" (EnvBool True) (const $ return Nothing)
"Choose if we should display warnings when shadowing symbols."
, simpleOpt "smtfile" (EnvString "-") (const $ return Nothing)
"The file to use for SMT-Lib scripts (for debugging or offline proving)"
, OptionDescr "mono-binds" (EnvBool True) (const $ return Nothing)
"Whether or not to generalize bindings in a where-clause" $
\case EnvBool b -> do me <- getModuleEnv
setModuleEnv me { M.meMonoBinds = b }
_ -> return ()
]
-- | Check the value to the `base` option.
checkBase :: EnvVal -> IO (Maybe String)
checkBase val = case val of
EnvNum n
| n >= 2 && n <= 36 -> return Nothing
| otherwise -> return $ Just "base must fall between 2 and 36"
_ -> return $ Just "unable to parse a value for base"
checkInfLength :: EnvVal -> IO (Maybe String)
checkInfLength val = case val of
EnvNum n
| n >= 0 -> return Nothing
| otherwise -> return $ Just "the number of elements should be positive"
_ -> return $ Just "unable to parse a value for infLength"
checkProver :: EnvVal -> IO (Maybe String)
checkProver val = case val of
EnvString s
| s `notElem` proverNames -> return $ Just $ "Prover must be " ++ proverListString
| s `elem` ["offline", "any"] -> return Nothing
| otherwise -> do let prover = lookupProver s
available <- sbvCheckSolverInstallation prover
unless available $
putStrLn $ "Warning: " ++ s ++ " installation not found"
return Nothing
_ -> return $ Just "unable to parse a value for prover"
proverListString :: String
proverListString = concatMap (++ ", ") (init proverNames) ++ "or " ++ last proverNames
checkSatNum :: EnvVal -> IO (Maybe String)
checkSatNum val = case val of
EnvString "all" -> return Nothing
EnvString s ->
case readMaybe s :: Maybe Int of
Just n | n >= 1 -> return Nothing
_ -> return $ Just "must be an integer > 0 or \"all\""
_ -> return $ Just "unable to parse a value for satNum"
getUserSatNum :: REPL SatNum
getUserSatNum = do
EnvString s <- getUser "satNum"
case s of
"all" -> return AllSat
_ | Just n <- readMaybe s -> return (SomeSat n)
_ -> panic "REPL.Monad.getUserSatNum"
[ "invalid satNum option" ]
-- Environment Utilities -------------------------------------------------------
whenDebug :: REPL () -> REPL ()
whenDebug m = do
EnvBool b <- getUser "debug"
when b m
-- Smoke Testing ---------------------------------------------------------------
smokeTest :: REPL [Smoke]
smokeTest = catMaybes <$> sequence tests
where
tests = [ z3exists ]
type SmokeTest = REPL (Maybe Smoke)
data Smoke
= Z3NotFound
deriving (Show, Eq)
instance PP Smoke where
ppPrec _ smoke =
case smoke of
Z3NotFound -> text . intercalate " " $ [
"[error] z3 is required to run Cryptol, but was not found in the"
, "system path. See the Cryptol README for more on how to install z3."
]
z3exists :: SmokeTest
z3exists = do
mPath <- io $ findExecutable "z3"
case mPath of
Nothing -> return (Just Z3NotFound)
Just _ -> return Nothing
cryptol-2.2.6/src/Cryptol/REPL/Trie.hs 0000644 0000000 0000000 00000003305 12637103426 015634 0 ustar 00 0000000 0000000 -- |
-- Module : $Header$
-- Copyright : (c) 2013-2015 Galois, Inc.
-- License : BSD3
-- Maintainer : cryptol@galois.com
-- Stability : provisional
-- Portability : portable
module Cryptol.REPL.Trie where
import Cryptol.Utils.Panic (panic)
import qualified Data.Map as Map
import Data.Maybe (fromMaybe,maybeToList)
-- | Maps string names to values, allowing for partial key matches and querying.
data Trie a = Node (Map.Map Char (Trie a)) (Maybe a)
deriving (Show)
emptyTrie :: Trie a
emptyTrie = Node Map.empty Nothing
-- | Insert a value into the Trie. Will call `panic` if a value already exists
-- with that key.
insertTrie :: String -> a -> Trie a -> Trie a
insertTrie k a = loop k
where
loop key (Node m mb) = case key of
c:cs -> Node (Map.alter (Just . loop cs . fromMaybe emptyTrie) c m) mb
[] -> case mb of
Nothing -> Node m (Just a)
Just _ -> panic "[REPL] Trie" ["key already exists:", "\t" ++ k]
-- | Return all matches with the given prefix.
lookupTrie :: String -> Trie a -> [a]
lookupTrie key t@(Node mp _) = case key of
c:cs -> case Map.lookup c mp of
Just m' -> lookupTrie cs m'
Nothing -> []
[] -> leaves t
-- | Given a key, return either an exact match for that key, or all
-- matches with the given prefix.
lookupTrieExact :: String -> Trie a -> [a]
lookupTrieExact [] (Node _ (Just x)) = return x
lookupTrieExact [] t = leaves t
lookupTrieExact (c:cs) (Node mp _) =
case Map.lookup c mp of
Just m' -> lookupTrieExact cs m'
Nothing -> []
-- | Return all of the values from a Trie.
leaves :: Trie a -> [a]
leaves (Node mp mb) = maybeToList mb ++ concatMap leaves (Map.elems mp)
cryptol-2.2.6/src/Cryptol/Symbolic/ 0000755 0000000 0000000 00000000000 12637103426 015413 5 ustar 00 0000000 0000000 cryptol-2.2.6/src/Cryptol/Symbolic/Prims.hs 0000644 0000000 0000000 00000061412 12637103426 017045 0 ustar 00 0000000 0000000 -- |
-- Module : $Header$
-- Copyright : (c) 2013-2015 Galois, Inc.
-- License : BSD3
-- Maintainer : cryptol@galois.com
-- Stability : provisional
-- Portability : portable
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE FlexibleContexts #-}
module Cryptol.Symbolic.Prims where
import Data.Bits ()
import Data.List (genericDrop, genericReplicate, genericSplitAt, genericTake, sortBy, transpose)
import Data.Ord (comparing)
import Cryptol.Eval.Value (BitWord(..))
import Cryptol.Prims.Eval (binary, unary, tlamN)
import Cryptol.Prims.Syntax (ECon(..))
import Cryptol.Symbolic.Value
import Cryptol.TypeCheck.AST (Name)
import Cryptol.TypeCheck.Solver.InfNat(Nat'(..), nMul)
import Cryptol.Utils.Panic
import qualified Data.SBV.Dynamic as SBV
import Prelude ()
import Prelude.Compat
traverseSnd :: Functor f => (a -> f b) -> (t, a) -> f (t, b)
traverseSnd f (x, y) = (,) x <$> f y
-- Primitives ------------------------------------------------------------------
-- See also Cryptol.Prims.Eval.evalECon
evalECon :: ECon -> Value
evalECon econ =
case econ of
ECTrue -> VBit SBV.svTrue
ECFalse -> VBit SBV.svFalse
ECDemote -> ecDemoteV -- Converts a numeric type into its corresponding value.
-- { val, bits } (fin val, fin bits, bits >= width val) => [bits]
ECPlus -> binary (arithBinary SBV.svPlus) -- {a} (Arith a) => a -> a -> a
ECMinus -> binary (arithBinary SBV.svMinus) -- {a} (Arith a) => a -> a -> a
ECMul -> binary (arithBinary SBV.svTimes) -- {a} (Arith a) => a -> a -> a
ECDiv -> binary (arithBinary SBV.svQuot) -- {a} (Arith a) => a -> a -> a
ECMod -> binary (arithBinary SBV.svRem) -- {a} (Arith a) => a -> a -> a
ECExp -> binary (arithBinary sExp) -- {a} (Arith a) => a -> a -> a
ECLg2 -> unary (arithUnary sLg2) -- {a} (Arith a) => a -> a
ECNeg -> unary (arithUnary SBV.svUNeg)
ECLt -> binary (cmpBinary cmpLt cmpLt SBV.svFalse)
ECGt -> binary (cmpBinary cmpGt cmpGt SBV.svFalse)
ECLtEq -> binary (cmpBinary cmpLtEq cmpLtEq SBV.svTrue)
ECGtEq -> binary (cmpBinary cmpGtEq cmpGtEq SBV.svTrue)
ECEq -> binary (cmpBinary cmpEq cmpEq SBV.svTrue)
ECNotEq -> binary (cmpBinary cmpNotEq cmpNotEq SBV.svFalse)
-- FIXME: the next 4 "primitives" should be defined in the Cryptol prelude.
ECFunEq -> -- {a b} (Cmp b) => (a -> b) -> (a -> b) -> a -> Bit
-- (f === g) x = (f x == g x)
tlam $ \_ ->
tlam $ \b ->
VFun $ \f ->
VFun $ \g ->
VFun $ \x -> cmpBinary cmpEq cmpEq SBV.svTrue b (fromVFun f x) (fromVFun g x)
ECFunNotEq -> -- {a b} (Cmp b) => (a -> b) -> (a -> b) -> a -> Bit
-- (f !== g) x = (f x != g x)
tlam $ \_ ->
tlam $ \b ->
VFun $ \f ->
VFun $ \g ->
VFun $ \x -> cmpBinary cmpNotEq cmpNotEq SBV.svFalse b (fromVFun f x) (fromVFun g x)
ECMin -> -- {a} (Cmp a) => a -> a -> a
-- min x y = if x <= y then x else y
binary $ \a x y ->
let c = cmpBinary cmpLtEq cmpLtEq SBV.svFalse a x y
in iteValue (fromVBit c) x y
ECMax -> -- {a} (Cmp a) => a -> a -> a
-- max x y = if y <= x then x else y
binary $ \a x y ->
let c = cmpBinary cmpLtEq cmpLtEq SBV.svFalse a y x
in iteValue (fromVBit c) x y
ECAnd -> binary (logicBinary SBV.svAnd SBV.svAnd)
ECOr -> binary (logicBinary SBV.svOr SBV.svOr)
ECXor -> binary (logicBinary SBV.svXOr SBV.svXOr)
ECCompl -> unary (logicUnary SBV.svNot SBV.svNot)
ECZero -> VPoly zeroV
ECShiftL -> -- {m,n,a} (fin n) => [m] a -> [n] -> [m] a
tlam $ \m ->
tlam $ \_ ->
tlam $ \a ->
VFun $ \xs ->
VFun $ \y ->
case xs of
VWord x -> VWord (SBV.svShiftLeft x (fromVWord y))
_ -> selectV shl y
where
shl :: Integer -> Value
shl i =
case numTValue m of
Inf -> dropV i xs
Nat j | i >= j -> replicateV j a (zeroV a)
| otherwise -> catV (dropV i xs) (replicateV i a (zeroV a))
ECShiftR -> -- {m,n,a} (fin n) => [m] a -> [n] -> [m] a
tlam $ \m ->
tlam $ \_ ->
tlam $ \a ->
VFun $ \xs ->
VFun $ \y ->
case xs of
VWord x -> VWord (SBV.svShiftRight x (fromVWord y))
_ -> selectV shr y
where
shr :: Integer -> Value
shr i =
case numTValue m of
Inf -> catV (replicateV i a (zeroV a)) xs
Nat j | i >= j -> replicateV j a (zeroV a)
| otherwise -> catV (replicateV i a (zeroV a)) (takeV (j - i) xs)
ECRotL -> -- {m,n,a} (fin m, fin n) => [m] a -> [n] -> [m] a
tlam $ \m ->
tlam $ \_ ->
tlam $ \_ ->
VFun $ \xs ->
VFun $ \y ->
case xs of
VWord x -> VWord (SBV.svRotateLeft x (fromVWord y))
_ -> selectV rol y
where
rol :: Integer -> Value
rol i = catV (dropV k xs) (takeV k xs)
where k = i `mod` finTValue m
ECRotR -> -- {m,n,a} (fin m, fin n) => [m] a -> [n] -> [m] a
tlam $ \m ->
tlam $ \_ ->
tlam $ \_ ->
VFun $ \xs ->
VFun $ \y ->
case xs of
VWord x -> VWord (SBV.svRotateRight x (fromVWord y))
_ -> selectV ror y
where
ror :: Integer -> Value
ror i = catV (dropV k xs) (takeV k xs)
where k = (- i) `mod` finTValue m
ECCat -> -- {a,b,d} (fin a) => [a] d -> [b] d -> [a + b] d
tlam $ \_ ->
tlam $ \_ ->
tlam $ \_ ->
VFun $ \v1 ->
VFun $ \v2 -> catV v1 v2
ECSplitAt -> -- {a,b,c} (fin a) => [a+b] c -> ([a]c,[b]c)
tlam $ \(finTValue -> a) ->
tlam $ \_ ->
tlam $ \_ ->
VFun $ \v -> VTuple [takeV a v, dropV a v]
ECJoin -> tlam $ \ parts ->
tlam $ \ each ->
tlam $ \ a -> lam (joinV parts each a)
ECSplit -> ecSplitV
ECReverse ->
tlam $ \a ->
tlam $ \b ->
lam $ \(fromSeq -> xs) -> toSeq a b (reverse xs)
ECTranspose ->
tlam $ \a ->
tlam $ \b ->
tlam $ \c ->
lam $ \((map fromSeq . fromSeq) -> xs) ->
case numTValue a of
Nat 0 ->
let v = toSeq a c []
in case numTValue b of
Nat n -> toSeq b (tvSeq a c) $ genericReplicate n v
Inf -> VStream $ repeat v
_ -> toSeq b (tvSeq a c) $ map (toSeq a c) $ transpose xs
ECAt -> -- {n,a,i} (fin i) => [n]a -> [i] -> a
tlam $ \_ ->
tlam $ \a ->
tlam $ \_ ->
VFun $ \xs ->
VFun $ \y ->
let err = zeroV a -- default for out-of-bounds accesses
in selectV (\i -> nthV err xs i) y
ECAtRange -> -- {n,a,m,i} (fin i) => [n]a -> [m][i] -> [m]a
tlam $ \_ ->
tlam $ \a ->
tlam $ \_ ->
tlam $ \_ ->
VFun $ \xs ->
VFun $ \ys ->
let err = zeroV a -- default for out-of-bounds accesses
in mapV (isTBit a) (selectV (\i -> nthV err xs i)) ys
ECAtBack -> -- {n,a,i} (fin n, fin i) => [n]a -> [i] -> a
tlam $ \(finTValue -> n) ->
tlam $ \a ->
tlam $ \_ ->
VFun $ \xs ->
VFun $ \y ->
let err = zeroV a -- default for out-of-bounds accesses
in selectV (\i -> nthV err xs (n - 1 - i)) y
ECAtRangeBack -> -- {n,a,m,i} (fin n, fin i) => [n]a -> [m][i] -> [m]a
tlam $ \(finTValue -> n) ->
tlam $ \a ->
tlam $ \_ ->
tlam $ \_ ->
VFun $ \xs ->
VFun $ \ys ->
let err = zeroV a -- default for out-of-bounds accesses
in mapV (isTBit a) (selectV (\i -> nthV err xs (n - 1 - i))) ys
ECFromThen -> fromThenV
ECFromTo -> fromToV
ECFromThenTo -> fromThenToV
ECInfFrom ->
tlam $ \(finTValue -> bits) ->
lam $ \(fromVWord -> first) ->
toStream [ VWord (SBV.svPlus first (literalSWord (fromInteger bits) i)) | i <- [0 ..] ]
ECInfFromThen -> -- {a} (fin a) => [a] -> [a] -> [inf][a]
tlam $ \_ ->
lam $ \(fromVWord -> first) ->
lam $ \(fromVWord -> next) ->
toStream (map VWord (iterate (SBV.svPlus (SBV.svMinus next first)) first))
-- {at,len} (fin len) => [len][8] -> at
ECError ->
tlam $ \at ->
tlam $ \(finTValue -> _len) ->
VFun $ \_msg -> zeroV at -- error/undefined, is arbitrarily translated to 0
ECPMul -> -- {a,b} (fin a, fin b) => [a] -> [b] -> [max 1 (a + b) - 1]
tlam $ \(finTValue -> i) ->
tlam $ \(finTValue -> j) ->
VFun $ \v1 ->
VFun $ \v2 ->
let k = max 1 (i + j) - 1
mul _ [] ps = ps
mul as (b:bs) ps = mul (SBV.svFalse : as) bs (ites b (as `addPoly` ps) ps)
xs = map fromVBit (fromSeq v1)
ys = map fromVBit (fromSeq v2)
zs = take (fromInteger k) (mul xs ys [] ++ repeat SBV.svFalse)
in VSeq True (map VBit zs)
ECPDiv -> -- {a,b} (fin a, fin b) => [a] -> [b] -> [a]
tlam $ \(finTValue -> i) ->
tlam $ \_ ->
VFun $ \v1 ->
VFun $ \v2 ->
let xs = map fromVBit (fromSeq v1)
ys = map fromVBit (fromSeq v2)
zs = take (fromInteger i) (fst (mdp (reverse xs) (reverse ys)) ++ repeat SBV.svFalse)
in VSeq True (map VBit (reverse zs))
ECPMod -> -- {a,b} (fin a, fin b) => [a] -> [b+1] -> [b]
tlam $ \_ ->
tlam $ \(finTValue -> j) ->
VFun $ \v1 ->
VFun $ \v2 ->
let xs = map fromVBit (fromSeq v1)
ys = map fromVBit (fromSeq v2)
zs = take (fromInteger j) (snd (mdp (reverse xs) (reverse ys)) ++ repeat SBV.svFalse)
in VSeq True (map VBit (reverse zs))
ECRandom -> panic "Cryptol.Symbolic.Prims.evalECon"
[ "can't symbolically evaluae ECRandom" ]
selectV :: (Integer -> Value) -> Value -> Value
selectV f v = sel 0 bits
where
bits = map fromVBit (fromSeq v) -- index bits in big-endian order
sel :: Integer -> [SBool] -> Value
sel offset [] = f offset
sel offset (b : bs) = iteValue b m1 m2
where m1 = sel (offset + 2 ^ length bs) bs
m2 = sel offset bs
replicateV :: Integer -- ^ number of elements
-> TValue -- ^ type of element
-> Value -- ^ element
-> Value
replicateV n (toTypeVal -> TVBit) x = VSeq True (genericReplicate n x)
replicateV n _ x = VSeq False (genericReplicate n x)
nth :: a -> [a] -> Int -> a
nth def [] _ = def
nth def (x : xs) n
| n == 0 = x
| otherwise = nth def xs (n - 1)
nthV :: Value -> Value -> Integer -> Value
nthV err v n =
case v of
VStream xs -> nth err xs (fromInteger n)
VSeq _ xs -> nth err xs (fromInteger n)
VWord x -> let i = SBV.intSizeOf x - 1 - fromInteger n
in if i < 0 then err else
VBit (SBV.svTestBit x i)
_ -> err
mapV :: Bool -> (Value -> Value) -> Value -> Value
mapV isBit f v =
case v of
VSeq _ xs -> VSeq isBit (map f xs)
VStream xs -> VStream (map f xs)
_ -> panic "Cryptol.Symbolic.Prims.mapV" [ "non-mappable value" ]
catV :: Value -> Value -> Value
catV xs (VStream ys) = VStream (fromSeq xs ++ ys)
catV (VWord x) ys = VWord (SBV.svJoin x (fromVWord ys))
catV xs (VWord y) = VWord (SBV.svJoin (fromVWord xs) y)
catV (VSeq b xs) (VSeq _ ys) = VSeq b (xs ++ ys)
catV _ _ = panic "Cryptol.Symbolic.Prims.catV" [ "non-concatenable value" ]
dropV :: Integer -> Value -> Value
dropV 0 xs = xs
dropV n xs =
case xs of
VSeq b xs' -> VSeq b (genericDrop n xs')
VStream xs' -> VStream (genericDrop n xs')
VWord w -> VWord $ SBV.svExtract (SBV.intSizeOf w - 1 - fromInteger n) 0 w
_ -> panic "Cryptol.Symbolic.Prims.dropV" [ "non-droppable value" ]
takeV :: Integer -> Value -> Value
takeV n xs =
case xs of
VWord w -> VWord $ SBV.svExtract (SBV.intSizeOf w - 1) (SBV.intSizeOf w - fromInteger n) w
VSeq b xs' -> VSeq b (genericTake n xs')
VStream xs' -> VSeq b (genericTake n xs')
where b = case xs' of VBit _ : _ -> True
_ -> False
_ -> panic "Cryptol.Symbolic.Prims.takeV" [ "non-takeable value" ]
-- | Make a numeric constant.
-- { val, bits } (fin val, fin bits, bits >= width val) => [bits]
ecDemoteV :: Value
ecDemoteV = tlam $ \valT ->
tlam $ \bitT ->
case (numTValue valT, numTValue bitT) of
(Nat v, Nat bs) -> VWord (literalSWord (fromInteger bs) v)
_ -> evalPanic "Cryptol.Prove.evalECon"
["Unexpected Inf in constant."
, show valT
, show bitT
]
-- Type Values -----------------------------------------------------------------
-- | An easy-to-use alternative representation for type `TValue`.
data TypeVal
= TVBit
| TVSeq Int TypeVal
| TVStream TypeVal
| TVTuple [TypeVal]
| TVRecord [(Name, TypeVal)]
| TVFun TypeVal TypeVal
toTypeVal :: TValue -> TypeVal
toTypeVal ty
| isTBit ty = TVBit
| Just (n, ety) <- isTSeq ty = case numTValue n of
Nat w -> TVSeq (fromInteger w) (toTypeVal ety)
Inf -> TVStream (toTypeVal ety)
| Just (aty, bty) <- isTFun ty = TVFun (toTypeVal aty) (toTypeVal bty)
| Just (_, tys) <- isTTuple ty = TVTuple (map toTypeVal tys)
| Just fields <- isTRec ty = TVRecord [ (n, toTypeVal aty) | (n, aty) <- fields ]
| otherwise = panic "Cryptol.Symbolic.Prims.toTypeVal" [ "bad TValue" ]
-- Arith -----------------------------------------------------------------------
type Binary = TValue -> Value -> Value -> Value
type Unary = TValue -> Value -> Value
-- | Models functions of type `{a} (Arith a) => a -> a -> a`
arithBinary :: (SWord -> SWord -> SWord) -> Binary
arithBinary op = loop . toTypeVal
where
loop ty l r =
case ty of
TVBit -> evalPanic "arithBinop" ["Invalid arguments"]
TVSeq _ TVBit -> VWord (op (fromVWord l) (fromVWord r))
TVSeq _ t -> VSeq False (zipWith (loop t) (fromSeq l) (fromSeq r))
TVStream t -> VStream (zipWith (loop t) (fromSeq l) (fromSeq r))
TVTuple ts -> VTuple (zipWith3 loop ts (fromVTuple l) (fromVTuple r))
TVRecord fs -> VRecord [ (f, loop t (lookupRecord f l) (lookupRecord f r)) | (f, t) <- fs ]
TVFun _ t -> VFun (\x -> loop t (fromVFun l x) (fromVFun r x))
-- | Models functions of type `{a} (Arith a) => a -> a`
arithUnary :: (SWord -> SWord) -> Unary
arithUnary op = loop . toTypeVal
where
loop ty v =
case ty of
TVBit -> evalPanic "arithUnary" ["Invalid arguments"]
TVSeq _ TVBit -> VWord (op (fromVWord v))
TVSeq _ t -> VSeq False (map (loop t) (fromSeq v))
TVStream t -> VStream (map (loop t) (fromSeq v))
TVTuple ts -> VTuple (zipWith loop ts (fromVTuple v))
TVRecord fs -> VRecord [ (f, loop t (lookupRecord f v)) | (f, t) <- fs ]
TVFun _ t -> VFun (\x -> loop t (fromVFun v x))
sExp :: SWord -> SWord -> SWord
sExp x y = go (reverse (unpackWord y)) -- bits in little-endian order
where go [] = literalSWord (SBV.intSizeOf x) 1
go (b : bs) = SBV.svIte b (SBV.svTimes x s) s
where a = go bs
s = SBV.svTimes a a
-- | Ceiling (log_2 x)
sLg2 :: SWord -> SWord
sLg2 x = go 0
where
lit n = literalSWord (SBV.intSizeOf x) n
go i | i < SBV.intSizeOf x = SBV.svIte (SBV.svLessEq x (lit (2^i))) (lit (toInteger i)) (go (i + 1))
| otherwise = lit (toInteger i)
-- Cmp -------------------------------------------------------------------------
cmpValue :: (SBool -> SBool -> a -> a)
-> (SWord -> SWord -> a -> a)
-> (Value -> Value -> a -> a)
cmpValue fb fw = cmp
where
cmp v1 v2 k =
case (v1, v2) of
(VRecord fs1, VRecord fs2) -> let vals = map snd . sortBy (comparing fst)
in cmpValues (vals fs1) (vals fs2) k
(VTuple vs1 , VTuple vs2 ) -> cmpValues vs1 vs2 k
(VBit b1 , VBit b2 ) -> fb b1 b2 k
(VWord w1 , VWord w2 ) -> fw w1 w2 k
(VSeq _ vs1 , VSeq _ vs2 ) -> cmpValues vs1 vs2 k
(VStream {} , VStream {} ) -> panic "Cryptol.Symbolic.Prims.cmpValue"
[ "Infinite streams are not comparable" ]
(VFun {} , VFun {} ) -> panic "Cryptol.Symbolic.Prims.cmpValue"
[ "Functions are not comparable" ]
(VPoly {} , VPoly {} ) -> panic "Cryptol.Symbolic.Prims.cmpValue"
[ "Polymorphic values are not comparable" ]
(VWord w1 , _ ) -> fw w1 (fromVWord v2) k
(_ , VWord w2 ) -> fw (fromVWord v1) w2 k
(_ , _ ) -> panic "Cryptol.Symbolic.Prims.cmpValue"
[ "type mismatch" ]
cmpValues (x1 : xs1) (x2 : xs2) k = cmp x1 x2 (cmpValues xs1 xs2 k)
cmpValues _ _ k = k
cmpEq :: SWord -> SWord -> SBool -> SBool
cmpEq x y k = SBV.svAnd (SBV.svEqual x y) k
cmpNotEq :: SWord -> SWord -> SBool -> SBool
cmpNotEq x y k = SBV.svOr (SBV.svNotEqual x y) k
cmpLt, cmpGt :: SWord -> SWord -> SBool -> SBool
cmpLt x y k = SBV.svOr (SBV.svLessThan x y) (cmpEq x y k)
cmpGt x y k = SBV.svOr (SBV.svGreaterThan x y) (cmpEq x y k)
cmpLtEq, cmpGtEq :: SWord -> SWord -> SBool -> SBool
cmpLtEq x y k = SBV.svAnd (SBV.svLessEq x y) (cmpNotEq x y k)
cmpGtEq x y k = SBV.svAnd (SBV.svGreaterEq x y) (cmpNotEq x y k)
cmpBinary :: (SBool -> SBool -> SBool -> SBool)
-> (SWord -> SWord -> SBool -> SBool)
-> SBool -> Binary
cmpBinary fb fw b _ty v1 v2 = VBit (cmpValue fb fw v1 v2 b)
-- Logic -----------------------------------------------------------------------
errorV :: String -> TValue -> Value
errorV msg = go . toTypeVal
where
go ty =
case ty of
TVBit -> VBit (error msg)
TVSeq n t -> VSeq False (replicate n (go t))
TVStream t -> VStream (repeat (go t))
TVTuple ts -> VTuple [ go t | t <- ts ]
TVRecord fs -> VRecord [ (n, go t) | (n, t) <- fs ]
TVFun _ t -> VFun (const (go t))
zeroV :: TValue -> Value
zeroV = go . toTypeVal
where
go ty =
case ty of
TVBit -> VBit SBV.svFalse
TVSeq n TVBit -> VWord (literalSWord n 0)
TVSeq n t -> VSeq False (replicate n (go t))
TVStream t -> VStream (repeat (go t))
TVTuple ts -> VTuple [ go t | t <- ts ]
TVRecord fs -> VRecord [ (n, go t) | (n, t) <- fs ]
TVFun _ t -> VFun (const (go t))
-- | Join a sequence of sequences into a single sequence.
joinV :: TValue -> TValue -> TValue -> Value -> Value
joinV parts each a v =
let len = toNumTValue (numTValue parts `nMul` numTValue each)
in toSeq len a (concatMap fromSeq (fromSeq v))
-- | Split implementation.
ecSplitV :: Value
ecSplitV =
tlam $ \ parts ->
tlam $ \ each ->
tlam $ \ a ->
lam $ \ v ->
let mkChunks f = map (toFinSeq a) $ f $ fromSeq v
in case (numTValue parts, numTValue each) of
(Nat p, Nat e) -> VSeq False $ mkChunks (finChunksOf p e)
(Inf , Nat e) -> toStream $ mkChunks (infChunksOf e)
_ -> evalPanic "splitV" ["invalid type arguments to split"]
-- | Split into infinitely many chunks
infChunksOf :: Integer -> [a] -> [[a]]
infChunksOf each xs = let (as,bs) = genericSplitAt each xs
in as : infChunksOf each bs
-- | Split into finitely many chunks
finChunksOf :: Integer -> Integer -> [a] -> [[a]]
finChunksOf 0 _ _ = []
finChunksOf parts each xs = let (as,bs) = genericSplitAt each xs
in as : finChunksOf (parts - 1) each bs
-- | Merge two values given a binop. This is used for and, or and xor.
logicBinary :: (SBool -> SBool -> SBool) -> (SWord -> SWord -> SWord) -> Binary
logicBinary bop op = loop . toTypeVal
where
loop ty l r =
case ty of
TVBit -> VBit (bop (fromVBit l) (fromVBit r))
TVSeq _ TVBit -> VWord (op (fromVWord l) (fromVWord r))
TVSeq _ t -> VSeq False (zipWith (loop t) (fromSeq l) (fromSeq r))
TVStream t -> VStream (zipWith (loop t) (fromSeq l) (fromSeq r))
TVTuple ts -> VTuple (zipWith3 loop ts (fromVTuple l) (fromVTuple r))
TVRecord fs -> VRecord [ (f, loop t (lookupRecord f l) (lookupRecord f r)) | (f, t) <- fs ]
TVFun _ t -> VFun (\x -> loop t (fromVFun l x) (fromVFun r x))
logicUnary :: (SBool -> SBool) -> (SWord -> SWord) -> Unary
logicUnary bop op = loop . toTypeVal
where
loop ty v =
case ty of
TVBit -> VBit (bop (fromVBit v))
TVSeq _ TVBit -> VWord (op (fromVWord v))
TVSeq _ t -> VSeq False (map (loop t) (fromSeq v))
TVStream t -> VStream (map (loop t) (fromSeq v))
TVTuple ts -> VTuple (zipWith loop ts (fromVTuple v))
TVRecord fs -> VRecord [ (f, loop t (lookupRecord f v)) | (f, t) <- fs ]
TVFun _ t -> VFun (\x -> loop t (fromVFun v x))
-- @[ 0, 1 .. ]@
fromThenV :: Value
fromThenV =
tlamN $ \ first ->
tlamN $ \ next ->
tlamN $ \ bits ->
tlamN $ \ len ->
case (first, next, len, bits) of
(Nat first', Nat next', Nat len', Nat bits') ->
let nums = enumFromThen first' next'
lit i = VWord (literalSWord (fromInteger bits') i)
in VSeq False (genericTake len' (map lit nums))
_ -> evalPanic "fromThenV" ["invalid arguments"]
-- @[ 0 .. 10 ]@
fromToV :: Value
fromToV =
tlamN $ \ first ->
tlamN $ \ lst ->
tlamN $ \ bits ->
case (first, lst, bits) of
(Nat first', Nat lst', Nat bits') ->
let nums = enumFromThenTo first' (first' + 1) lst'
len = 1 + (lst' - first')
lit i = VWord (literalSWord (fromInteger bits') i)
in VSeq False (genericTake len (map lit nums))
_ -> evalPanic "fromThenV" ["invalid arguments"]
-- @[ 0, 1 .. 10 ]@
fromThenToV :: Value
fromThenToV =
tlamN $ \ first ->
tlamN $ \ next ->
tlamN $ \ lst ->
tlamN $ \ bits ->
tlamN $ \ len ->
case (first, next, lst, len, bits) of
(Nat first', Nat next', Nat lst', Nat len', Nat bits') ->
let nums = enumFromThenTo first' next' lst'
lit i = VWord (literalSWord (fromInteger bits') i)
in VSeq False (genericTake len' (map lit nums))
_ -> evalPanic "fromThenV" ["invalid arguments"]
-- Polynomials -----------------------------------------------------------------
-- TODO: Data.SBV.BitVectors.Polynomials should export ites, addPoly,
-- and mdp (the following definitions are copied from that module)
-- | Add two polynomials
addPoly :: [SBool] -> [SBool] -> [SBool]
addPoly xs [] = xs
addPoly [] ys = ys
addPoly (x:xs) (y:ys) = SBV.svXOr x y : addPoly xs ys
ites :: SBool -> [SBool] -> [SBool] -> [SBool]
ites s xs ys
| Just t <- SBV.svAsBool s
= if t then xs else ys
| True
= go xs ys
where go [] [] = []
go [] (b:bs) = SBV.svIte s SBV.svFalse b : go [] bs
go (a:as) [] = SBV.svIte s a SBV.svFalse : go as []
go (a:as) (b:bs) = SBV.svIte s a b : go as bs
-- conservative over-approximation of the degree
degree :: [SBool] -> Int
degree xs = walk (length xs - 1) $ reverse xs
where walk n [] = n
walk n (b:bs)
| Just t <- SBV.svAsBool b
= if t then n else walk (n-1) bs
| True
= n -- over-estimate
mdp :: [SBool] -> [SBool] -> ([SBool], [SBool])
mdp xs ys = go (length ys - 1) (reverse ys)
where degTop = degree xs
go _ [] = error "SBV.Polynomial.mdp: Impossible happened; exhausted ys before hitting 0"
go n (b:bs)
| n == 0 = (reverse qs, rs)
| True = let (rqs, rrs) = go (n-1) bs
in (ites b (reverse qs) rqs, ites b rs rrs)
where degQuot = degTop - n
ys' = replicate degQuot SBV.svFalse ++ ys
(qs, rs) = divx (degQuot+1) degTop xs ys'
-- return the element at index i; if not enough elements, return false
-- N.B. equivalent to '(xs ++ repeat false) !! i', but more efficient
idx :: [SBool] -> Int -> SBool
idx [] _ = SBV.svFalse
idx (x:_) 0 = x
idx (_:xs) i = idx xs (i-1)
divx :: Int -> Int -> [SBool] -> [SBool] -> ([SBool], [SBool])
divx n _ xs _ | n <= 0 = ([], xs)
divx n i xs ys' = (q:qs, rs)
where q = xs `idx` i
xs' = ites q (xs `addPoly` ys') xs
(qs, rs) = divx (n-1) (i-1) xs' (tail ys')
cryptol-2.2.6/src/Cryptol/Symbolic/Value.hs 0000644 0000000 0000000 00000010003 12637103426 017015 0 ustar 00 0000000 0000000 -- |
-- Module : $Header$
-- Copyright : (c) 2013-2015 Galois, Inc.
-- License : BSD3
-- Maintainer : cryptol@galois.com
-- Stability : provisional
-- Portability : portable
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Cryptol.Symbolic.Value
( SBool, SWord
, literalSWord
, fromBitsLE
, forallBV_, existsBV_
, forallSBool_, existsSBool_
, Value
, TValue, numTValue, toNumTValue, finTValue, isTBit, isTFun, isTSeq, isTTuple, isTRec, tvSeq
, GenValue(..), lam, tlam, toStream, toFinSeq, toSeq
, fromVBit, fromVFun, fromVPoly, fromVTuple, fromVRecord, lookupRecord
, fromSeq, fromVWord
, evalPanic
, iteValue, mergeValue
)
where
import Data.List (foldl')
import Data.SBV.Dynamic
import Cryptol.Eval.Value (TValue, numTValue, toNumTValue, finTValue, isTBit,
isTFun, isTSeq, isTTuple, isTRec, tvSeq, GenValue(..),
BitWord(..), lam, tlam, toStream, toFinSeq, toSeq,
fromSeq, fromVBit, fromVWord, fromVFun, fromVPoly,
fromVTuple, fromVRecord, lookupRecord)
import Cryptol.Utils.Panic (panic)
-- SBool and SWord -------------------------------------------------------------
type SBool = SVal
type SWord = SVal
fromBitsLE :: [SBool] -> SWord
fromBitsLE bs = foldl' f (literalSWord 0 0) bs
where f w b = svJoin (svToWord1 b) w
literalSWord :: Int -> Integer -> SWord
literalSWord w i = svInteger (KBounded False w) i
forallBV_ :: Int -> Symbolic SWord
forallBV_ w = svMkSymVar (Just ALL) (KBounded False w) Nothing
existsBV_ :: Int -> Symbolic SWord
existsBV_ w = svMkSymVar (Just EX) (KBounded False w) Nothing
forallSBool_ :: Symbolic SBool
forallSBool_ = svMkSymVar (Just ALL) KBool Nothing
existsSBool_ :: Symbolic SBool
existsSBool_ = svMkSymVar (Just EX) KBool Nothing
-- Values ----------------------------------------------------------------------
type Value = GenValue SBool SWord
-- Symbolic Conditionals -------------------------------------------------------
iteValue :: SBool -> Value -> Value -> Value
iteValue c x y =
case svAsBool c of
Just True -> x
Just False -> y
Nothing -> mergeValue True c x y
mergeValue :: Bool -> SBool -> Value -> Value -> Value
mergeValue f c v1 v2 =
case (v1, v2) of
(VRecord fs1, VRecord fs2) -> VRecord $ zipWith mergeField fs1 fs2
(VTuple vs1 , VTuple vs2 ) -> VTuple $ zipWith (mergeValue f c) vs1 vs2
(VBit b1 , VBit b2 ) -> VBit $ mergeBit b1 b2
(VWord w1 , VWord w2 ) -> VWord $ mergeWord w1 w2
(VSeq b1 vs1, VSeq _ vs2 ) -> VSeq b1 $ zipWith (mergeValue f c) vs1 vs2
(VStream vs1, VStream vs2) -> VStream $ mergeStream vs1 vs2
(VFun f1 , VFun f2 ) -> VFun $ \x -> mergeValue f c (f1 x) (f2 x)
(VPoly f1 , VPoly f2 ) -> VPoly $ \x -> mergeValue f c (f1 x) (f2 x)
(VWord w1 , _ ) -> VWord $ mergeWord w1 (fromVWord v2)
(_ , VWord w2 ) -> VWord $ mergeWord (fromVWord v1) w2
(_ , _ ) -> panic "Cryptol.Symbolic.Value"
[ "mergeValue: incompatible values" ]
where
mergeBit b1 b2 = svSymbolicMerge KBool f c b1 b2
mergeWord w1 w2 = svSymbolicMerge (kindOf w1) f c w1 w2
mergeField (n1, x1) (n2, x2)
| n1 == n2 = (n1, mergeValue f c x1 x2)
| otherwise = panic "Cryptol.Symbolic.Value"
[ "mergeValue.mergeField: incompatible values" ]
mergeStream xs ys =
mergeValue f c (head xs) (head ys) : mergeStream (tail xs) (tail ys)
-- Big-endian Words ------------------------------------------------------------
instance BitWord SBool SWord where
packWord bs = fromBitsLE (reverse bs)
unpackWord x = [ svTestBit x i | i <- reverse [0 .. intSizeOf x - 1] ]
-- Errors ----------------------------------------------------------------------
evalPanic :: String -> [String] -> a
evalPanic cxt = panic ("[Symbolic]" ++ cxt)
cryptol-2.2.6/src/Cryptol/Testing/ 0000755 0000000 0000000 00000000000 12637103426 015247 5 ustar 00 0000000 0000000 cryptol-2.2.6/src/Cryptol/Testing/Eval.hs 0000644 0000000 0000000 00000003175 12637103426 016500 0 ustar 00 0000000 0000000 {-# LANGUAGE TupleSections #-}
-- |
-- Module : $Header$
-- Copyright : (c) 2013-2015 Galois, Inc.
-- License : BSD3
-- Maintainer : cryptol@galois.com
-- Stability : provisional
-- Portability : portable
--
-- Evaluate test cases and handle exceptions appropriately
module Cryptol.Testing.Eval where
import Cryptol.Eval.Error
import Cryptol.Eval.Value
import Cryptol.Utils.Panic (panic)
import qualified Control.Exception as X
-- | A test result is either a pass, a failure due to evaluating to
-- @False@, or a failure due to an exception raised during evaluation
data TestResult
= Pass
| FailFalse [Value]
| FailError EvalError [Value]
-- | Apply a testable value to some arguments.
-- Note that this function assumes that the values come from a call to
-- `testableType` (i.e., things are type-correct). We run in the IO
-- monad in order to catch any @EvalError@s.
runOneTest :: Value -> [Value] -> IO TestResult
runOneTest v0 vs0 = run `X.catch` handle
where
run = do
result <- X.evaluate (go v0 vs0)
if result
then return Pass
else return (FailFalse vs0)
handle e = return (FailError e vs0)
go :: Value -> [Value] -> Bool
go (VFun f) (v : vs) = go (f v) vs
go (VFun _) [] = panic "Not enough arguments while applying function"
[]
go (VBit b) [] = b
go v vs = panic "Type error while running test" $
[ "Function:"
, show $ ppValue defaultPPOpts v
, "Arguments:"
] ++ map (show . ppValue defaultPPOpts) vs
cryptol-2.2.6/src/Cryptol/Testing/Exhaust.hs 0000644 0000000 0000000 00000006440 12637103426 017230 0 ustar 00 0000000 0000000 -- |
-- Module : $Header$
-- Copyright : (c) 2013-2015 Galois, Inc.
-- License : BSD3
-- Maintainer : cryptol@galois.com
-- Stability : provisional
-- Portability : portable
module Cryptol.Testing.Exhaust where
import qualified Cryptol.Testing.Eval as Eval
import Cryptol.TypeCheck.AST
import Cryptol.Eval.Value
import Data.List(genericReplicate)
#if __GLASGOW_HASKELL__ < 710
import Control.Applicative((<$>))
#endif
{- | Given a (function) type, compute all possible inputs for it.
We also return the total number of test (i.e., the length of the outer list. -}
testableType :: Type -> Maybe (Integer, [[Value]])
testableType ty =
case tNoUser ty of
TCon (TC TCFun) [t1,t2] ->
do sz <- typeSize t1
(tot,vss) <- testableType t2
return (sz * tot, [ v : vs | v <- typeValues t1, vs <- vss ])
TCon (TC TCBit) [] -> return (1, [[]])
_ -> Nothing
{- | Apply a testable value to some arguments.
Please note that this function assumes that the values come from
a call to `testableType` (i.e., things are type-correct)
-}
runOneTest :: Value -> [Value] -> IO Eval.TestResult
runOneTest = Eval.runOneTest
{- | Given a fully-evaluated type, try to compute the number of values in it.
Returns `Nothing` for infinite types, user-defined types, polymorhic types,
and, currently, function spaces. Of course, we can easily compute the
sizes of function spaces, but we can't easily enumerate their inhabitants. -}
typeSize :: Type -> Maybe Integer
typeSize ty =
case ty of
TVar _ -> Nothing
TUser _ _ t -> typeSize t
TRec fs -> product <$> mapM (typeSize . snd) fs
TCon (TC tc) ts ->
case (tc, ts) of
(TCNum _, _) -> Nothing
(TCInf, _) -> Nothing
(TCBit, _) -> Just 2
(TCSeq, [sz,el]) -> case tNoUser sz of
TCon (TC (TCNum n)) _ -> (^ n) <$> typeSize el
_ -> Nothing
(TCSeq, _) -> Nothing
(TCFun, _) -> Nothing
(TCTuple _, els) -> product <$> mapM typeSize els
(TCNewtype _, _) -> Nothing
TCon _ _ -> Nothing
{- | Returns all the values in a type. Returns an empty list of values,
for types where 'typeSize' returned 'Nothing'. -}
typeValues :: Type -> [Value]
typeValues ty =
case ty of
TVar _ -> []
TUser _ _ t -> typeValues t
TRec fs -> [ VRecord xs
| xs <- sequence [ [ (f,v) | v <- typeValues t ]
| (f,t) <- fs ]
]
TCon (TC tc) ts ->
case (tc, ts) of
(TCNum _, _) -> []
(TCInf, _) -> []
(TCBit, _) -> [ VBit False, VBit True ]
(TCSeq, ts1) ->
case map tNoUser ts1 of
[ TCon (TC (TCNum n)) _, TCon (TC TCBit) [] ] ->
[ VWord (BV n x) | x <- [ 0 .. 2^n - 1 ] ]
[ TCon (TC (TCNum n)) _, t ] ->
[ VSeq False xs | xs <- sequence $ genericReplicate n
$ typeValues t ]
_ -> []
(TCFun, _) -> [] -- We don't generate function values.
(TCTuple _, els) -> [ VTuple xs | xs <- sequence (map typeValues els)]
(TCNewtype _, _) -> []
TCon _ _ -> []
cryptol-2.2.6/src/Cryptol/Testing/Random.hs 0000644 0000000 0000000 00000011035 12637103426 017023 0 ustar 00 0000000 0000000 -- |
-- Module : $Header$
-- Copyright : (c) 2013-2015 Galois, Inc.
-- License : BSD3
-- Maintainer : cryptol@galois.com
-- Stability : provisional
-- Portability : portable
--
-- This module generates random values for Cryptol types.
{-# LANGUAGE BangPatterns #-}
module Cryptol.Testing.Random where
import Cryptol.Eval.Value (BV(..),Value,GenValue(..))
import qualified Cryptol.Testing.Eval as Eval
import Cryptol.TypeCheck.AST (Name,Type(..),TCon(..),TC(..),tNoUser)
import Control.Monad (forM)
import Data.List (unfoldr, genericTake)
import System.Random (RandomGen, split, random, randomR)
type Gen g = Int -> g -> (Value, g)
{- | Apply a testable value to some randomly-generated arguments.
Returns `Nothing` if the function returned `True`, or
`Just counterexample` if it returned `False`.
Please note that this function assumes that the generators match
the supplied value, otherwise we'll panic.
-}
runOneTest :: RandomGen g
=> Value -- ^ Function under test
-> [Gen g] -- ^ Argument generators
-> Int -- ^ Size
-> g
-> IO (Eval.TestResult, g)
runOneTest fun argGens sz g0 = do
let (args, g1) = foldr mkArg ([], g0) argGens
mkArg argGen (as, g) = let (a, g') = argGen sz g in (a:as, g')
result <- Eval.runOneTest fun args
return (result, g1)
{- | Given a (function) type, compute generators for
the function's arguments. Currently we do not support polymorphic functions.
In principle, we could apply these to random types, and test the results. -}
testableType :: RandomGen g => Type -> Maybe [Gen g]
testableType ty =
case tNoUser ty of
TCon (TC TCFun) [t1,t2] ->
do g <- randomValue t1
as <- testableType t2
return (g : as)
TCon (TC TCBit) [] -> return []
_ -> Nothing
{- | A generator for values of the given type. This fails if we are
given a type that lacks a suitable random value generator. -}
randomValue :: RandomGen g => Type -> Maybe (Gen g)
randomValue ty =
case ty of
TCon tc ts ->
case (tc, map tNoUser ts) of
(TC TCBit, []) -> Just randomBit
(TC TCSeq, [TCon (TC TCInf) [], el]) ->
do mk <- randomValue el
return (randomStream mk)
(TC TCSeq, [TCon (TC (TCNum n)) [], TCon (TC TCBit) []]) ->
return (randomWord n)
(TC TCSeq, [TCon (TC (TCNum n)) [], el]) ->
do mk <- randomValue el
return (randomSequence n mk)
(TC (TCTuple _), els) ->
do mks <- mapM randomValue els
return (randomTuple mks)
_ -> Nothing
TVar _ -> Nothing
TUser _ _ t -> randomValue t
TRec fs -> do gs <- forM fs $ \(l,t) -> do g <- randomValue t
return (l,g)
return (randomRecord gs)
-- | Generate a random bit value.
randomBit :: RandomGen g => Gen g
randomBit _ g =
let (b,g1) = random g
in (VBit b, g1)
-- | Generate a random word of the given length (i.e., a value of type @[w]@)
-- The size parameter is assumed to vary between 1 and 100, and we use
-- it to generate smaller numbers first.
randomWord :: RandomGen g => Integer -> Gen g
randomWord w _sz g =
let (val, g1) = randomR (0,2^w-1) g
in (VWord (BV w val), g1)
-- | Generate a random infinite stream value.
randomStream :: RandomGen g => Gen g -> Gen g
randomStream mkElem sz g =
let (g1,g2) = split g
in (VStream (unfoldr (Just . mkElem sz) g1), g2)
{- | Generate a random sequence. Generally, this should be used for sequences
other than bits. For sequences of bits use "randomWord". The difference
is mostly about how the results will be displayed. -}
randomSequence :: RandomGen g => Integer -> Gen g -> Gen g
randomSequence w mkElem sz g =
let (g1,g2) = split g
in (VSeq False $ genericTake w $ unfoldr (Just . mkElem sz) g1 , g2)
-- | Generate a random tuple value.
randomTuple :: RandomGen g => [Gen g] -> Gen g
randomTuple gens sz = go [] gens
where
go els [] g = (VTuple (reverse els), g)
go els (mkElem : more) g =
let (v, g1) = mkElem sz g
in go (v : els) more g1
-- | Generate a random record value.
randomRecord :: RandomGen g => [(Name, Gen g)] -> Gen g
randomRecord gens sz = go [] gens
where
go els [] g = (VRecord (reverse els), g)
go els ((l,mkElem) : more) g =
let (v, g1) = mkElem sz g
in go ((l,v) : els) more g1
{-
test = do
g <- newStdGen
let (s,_) = randomSequence 100 (randomWord 256) 100 g
print $ ppValue defaultPPOpts { useBase = 16 } s
-}
cryptol-2.2.6/src/Cryptol/Transform/ 0000755 0000000 0000000 00000000000 12637103426 015605 5 ustar 00 0000000 0000000 cryptol-2.2.6/src/Cryptol/Transform/MonoValues.hs 0000644 0000000 0000000 00000026577 12637103426 020252 0 ustar 00 0000000 0000000 -- |
-- Module : $Header$
-- Copyright : (c) 2013-2015 Galois, Inc.
-- License : BSD3
-- Maintainer : cryptol@galois.com
-- Stability : provisional
-- Portability : portable
--
-- This module implements a transformation, which tries to avoid exponential
-- slow down in some cases. What's the problem? Consider the following (common)
-- patterns:
--
-- fibs = [0,1] # [ x + y | x <- fibs, y <- drop`{1} fibs ]
--
-- The type of `fibs` is:
--
-- {a} (a >= 1, fin a) => [inf][a]
--
-- Here `a` is the number of bits to be used in the values computed by `fibs`.
-- When we evaluate `fibs`, `a` becomes a parameter to `fibs`, which works
-- except that now `fibs` is a function, and we don't get any of the memoization
-- we might expect! What looked like an efficient implementation has all
-- of a sudden become exponential!
--
-- Note that this is only a problem for polymorphic values: if `fibs` was
-- already a function, it would not be that surprising that it does not
-- get cached.
--
-- So, to avoid this, we try to spot recursive polymorphic values,
-- where the recursive occurrences have the exact same type parameters
-- as the definition. For example, this is the case in `fibs`: each
-- recursive call to `fibs` is instantiated with exactly the same
-- type parameter (i.e., `a`). The rewrite we do is as follows:
--
-- fibs : {a} (a >= 1, fin a) => [inf][a]
-- fibs = \{a} (a >= 1, fin a) -> fibs'
-- where fibs' : [inf][a]
-- fibs' = [0,1] # [ x + y | x <- fibs', y <- drop`{1} fibs' ]
--
-- After the rewrite, the recursion is monomorphic (i.e., we are always using
-- the same type). As a result, `fibs'` is an ordinary recursive value,
-- where we get the benefit of caching.
--
-- The rewrite is a bit more complex, when there are multiple mutually
-- recursive functions. Here is an example:
--
-- zig : {a} (a >= 2, fin a) => [inf][a]
-- zig = [1] # zag
--
-- zag : {a} (a >= 2, fin a) => [inf][a]
-- zag = [2] # zig
--
-- This gets rewritten to:
--
-- newName : {a} (a >= 2, fin a) => ([inf][a], [inf][a])
-- newName = \{a} (a >= 2, fin a) -> (zig', zag')
-- where
-- zig' : [inf][a]
-- zig' = [1] # zag'
--
-- zag' : [inf][a]
-- zag' = [2] # zig'
--
-- zig : {a} (a >= 2, fin a) => [inf][a]
-- zig = \{a} (a >= 2, fin a) -> (newName a <> <> ).1
--
-- zag : {a} (a >= 2, fin a) => [inf][a]
-- zag = \{a} (a >= 2, fin a) -> (newName a <> <> ).2
--
-- NOTE: We are assuming that no capture would occur with binders.
-- For values, this is because we replaces things with freshly chosen variables.
-- For types, this should be because there should be no shadowing in the types.
-- XXX: Make sure that this really is the case for types!!
{-# LANGUAGE PatternGuards, FlexibleInstances, MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleContexts #-}
module Cryptol.Transform.MonoValues (rewModule) where
import Cryptol.Parser.AST (Pass(MonoValues))
import Cryptol.TypeCheck.AST
import Cryptol.TypeCheck.TypeMap
import Data.List(sortBy,groupBy)
import Data.Either(partitionEithers)
import Data.Map (Map)
import MonadLib
#if __GLASGOW_HASKELL__ < 710
import Control.Applicative
#endif
{- (f,t,n) |--> x means that when we spot instantiations of `f` with `ts` and
`n` proof argument, we should replace them with `Var x` -}
newtype RewMap' a = RM (Map QName (TypesMap (Map Int a)))
type RewMap = RewMap' QName
instance TrieMap RewMap' (QName,[Type],Int) where
emptyTM = RM emptyTM
nullTM (RM m) = nullTM m
lookupTM (x,ts,n) (RM m) = do tM <- lookupTM x m
tP <- lookupTM ts tM
lookupTM n tP
alterTM (x,ts,n) f (RM m) = RM (alterTM x f1 m)
where
f1 Nothing = do a <- f Nothing
return (insertTM ts (insertTM n a emptyTM) emptyTM)
f1 (Just tM) = Just (alterTM ts f2 tM)
f2 Nothing = do a <- f Nothing
return (insertTM n a emptyTM)
f2 (Just pM) = Just (alterTM n f pM)
unionTM f (RM a) (RM b) = RM (unionTM (unionTM (unionTM f)) a b)
toListTM (RM m) = [ ((x,ts,n),y) | (x,tM) <- toListTM m
, (ts,pM) <- toListTM tM
, (n,y) <- toListTM pM ]
mapMaybeWithKeyTM f (RM m) =
RM (mapWithKeyTM (\qn tm ->
mapWithKeyTM (\tys is ->
mapMaybeWithKeyTM (\i a -> f (qn,tys,i) a) is) tm) m)
-- | Note that this assumes that this pass will be run only once for each
-- module, otherwise we will get name collisions.
rewModule :: Module -> Module
rewModule m = fst
$ runId
$ runStateT 0
$ runReaderT (Just (mName m))
$ do ds <- mapM (rewDeclGroup emptyTM) (mDecls m)
return m { mDecls = ds }
--------------------------------------------------------------------------------
type M = ReaderT RO (StateT RW Id)
type RO = Maybe ModName -- are we at the top level?
type RW = Int -- to generate names
newName :: M QName
newName =
do n <- sets $ \s -> (s, s + 1)
seq n $ return (QName Nothing (NewName MonoValues n))
newTopOrLocalName :: M QName
newTopOrLocalName =
do mb <- ask
n <- sets $ \s -> (s, s + 1)
seq n $ return (QName mb (NewName MonoValues n))
inLocal :: M a -> M a
inLocal = local Nothing
--------------------------------------------------------------------------------
rewE :: RewMap -> Expr -> M Expr -- XXX: not IO
rewE rews = go
where
tryRewrite (EVar x,tps,n) =
do y <- lookupTM (x,tps,n) rews
return (EVar y)
tryRewrite _ = Nothing
go expr =
case expr of
-- Interesting cases
ETApp e t -> case tryRewrite (splitTApp expr 0) of
Nothing -> ETApp <$> go e <*> return t
Just yes -> return yes
EProofApp e -> case tryRewrite (splitTApp e 1) of
Nothing -> EProofApp <$> go e
Just yes -> return yes
ECon {} -> return expr
EList es t -> EList <$> mapM go es <*> return t
ETuple es -> ETuple <$> mapM go es
ERec fs -> ERec <$> (forM fs $ \(f,e) -> do e1 <- go e
return (f,e1))
ESel e s -> ESel <$> go e <*> return s
EIf e1 e2 e3 -> EIf <$> go e1 <*> go e2 <*> go e3
EComp t e mss -> EComp t <$> go e <*> mapM (mapM (rewM rews)) mss
EVar _ -> return expr
ETAbs x e -> ETAbs x <$> go e
EApp e1 e2 -> EApp <$> go e1 <*> go e2
EAbs x t e -> EAbs x t <$> go e
EProofAbs x e -> EProofAbs x <$> go e
ECast e t -> ECast <$> go e <*> return t
EWhere e dgs -> EWhere <$> go e <*> inLocal
(mapM (rewDeclGroup rews) dgs)
rewM :: RewMap -> Match -> M Match
rewM rews ma =
case ma of
From x t e -> From x t <$> rewE rews e
-- These are not recursive.
Let d -> Let <$> rewD rews d
rewD :: RewMap -> Decl -> M Decl
rewD rews d = do e <- rewE rews (dDefinition d)
return d { dDefinition = e }
rewDeclGroup :: RewMap -> DeclGroup -> M DeclGroup
rewDeclGroup rews dg =
case dg of
NonRecursive d -> NonRecursive <$> rewD rews d
Recursive ds ->
do let (leave,rew) = partitionEithers (map consider ds)
rewGroups = groupBy sameTParams
$ sortBy compareTParams rew
ds1 <- mapM (rewD rews) leave
ds2 <- mapM rewSame rewGroups
return $ Recursive (ds1 ++ concat ds2)
where
sameTParams (_,tps1,x,_) (_,tps2,y,_) = tps1 == tps2 && x == y
compareTParams (_,tps1,x,_) (_,tps2,y,_) = compare (x,tps1) (y,tps2)
consider d = let (tps,props,e) = splitTParams (dDefinition d)
in if not (null tps) && notFun e
then Right (d, tps, props, e)
else Left d
rewSame ds =
do new <- forM ds $ \(d,_,_,e) ->
do x <- newName
return (d, x, e)
let (_,tps,props,_) : _ = ds
tys = map (TVar . tpVar) tps
proofNum = length props
addRew (d,x,_) = insertTM (dName d,tys,proofNum) x
newRews = foldr addRew rews new
newDs <- forM new $ \(d,newN,e) ->
do e1 <- rewE newRews e
return ( d
, d { dName = newN
, dSignature = (dSignature d)
{ sVars = [], sProps = [] }
, dDefinition = e1
}
)
case newDs of
[(f,f')] ->
return [ f { dDefinition =
let newBody = EVar (dName f')
newE = EWhere newBody
[ Recursive [f'] ]
in foldr ETAbs
(foldr EProofAbs newE props) tps
}
]
_ -> do tupName <- newTopOrLocalName
let (polyDs,monoDs) = unzip newDs
tupAr = length monoDs
addTPs = flip (foldr ETAbs) tps
. flip (foldr EProofAbs) props
-- tuple = \{a} p -> (f',g')
-- where f' = ...
-- g' = ...
tupD = Decl
{ dName = tupName
, dSignature =
Forall tps props $
TCon (TC (TCTuple tupAr))
(map (sType . dSignature) monoDs)
, dDefinition =
addTPs $
EWhere (ETuple [ EVar (dName d) | d <- monoDs ])
[ Recursive monoDs ]
, dPragmas = [] -- ?
}
mkProof e _ = EProofApp e
-- f = \{a} (p) -> (tuple @a p). n
mkFunDef n f =
f { dDefinition =
addTPs $ ESel ( flip (foldl mkProof) props
$ flip (foldl ETApp) tys
$ EVar tupName
) (TupleSel n (Just tupAr))
}
return (tupD : zipWith mkFunDef [ 0 .. ] polyDs)
--------------------------------------------------------------------------------
splitTParams :: Expr -> ([TParam], [Prop], Expr)
splitTParams e = let (tps, e1) = splitWhile splitTAbs e
(props, e2) = splitWhile splitProofAbs e1
in (tps,props,e2)
-- returns type instantitaion and how many "proofs" were there
splitTApp :: Expr -> Int -> (Expr, [Type], Int)
splitTApp (EProofApp e) n = splitTApp e $! (n + 1)
splitTApp e0 n = let (e1,ts) = splitTy e0 []
in (e1, ts, n)
where
splitTy (ETApp e t) ts = splitTy e (t:ts)
splitTy e ts = (e,ts)
notFun :: Expr -> Bool
notFun (EAbs {}) = False
notFun (EProofAbs _ e) = notFun e
notFun _ = True
cryptol-2.2.6/src/Cryptol/Transform/Specialize.hs 0000644 0000000 0000000 00000031117 12637103426 020234 0 ustar 00 0000000 0000000 -- |
-- Module : $Header$
-- Copyright : (c) 2013-2015 Galois, Inc.
-- License : BSD3
-- Maintainer : cryptol@galois.com
-- Stability : provisional
-- Portability : portable
module Cryptol.Transform.Specialize
where
import Cryptol.TypeCheck.AST
import Cryptol.TypeCheck.TypeMap
import Cryptol.TypeCheck.Subst
import qualified Cryptol.ModuleSystem as M
import qualified Cryptol.ModuleSystem.Env as M
import qualified Cryptol.ModuleSystem.Monad as M
import Data.List (intercalate)
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Maybe (catMaybes)
import MonadLib
#if __GLASGOW_HASKELL__ < 710
import Control.Applicative
import Data.Traversable (traverse)
#endif
-- Specializer Monad -----------------------------------------------------------
-- | A QName should have an entry in the SpecCache iff it is
-- specializable. Each QName starts out with an empty TypesMap.
type SpecCache = Map QName (Decl, TypesMap (QName, Maybe Decl))
-- | The specializer monad.
type SpecT m a = StateT SpecCache (M.ModuleT m) a
type SpecM a = SpecT IO a
runSpecT :: SpecCache -> SpecT m a -> M.ModuleT m (a, SpecCache)
runSpecT s m = runStateT s m
liftSpecT :: Monad m => M.ModuleT m a -> SpecT m a
liftSpecT m = lift m
getSpecCache :: Monad m => SpecT m SpecCache
getSpecCache = get
setSpecCache :: Monad m => SpecCache -> SpecT m ()
setSpecCache = set
modifySpecCache :: Monad m => (SpecCache -> SpecCache) -> SpecT m ()
modifySpecCache = modify
modify :: StateM m s => (s -> s) -> m ()
modify f = get >>= (set . f)
-- Specializer -----------------------------------------------------------------
-- | Add a `where` clause to the given expression containing
-- type-specialized versions of all functions called (transitively) by
-- the body of the expression.
specialize :: Expr -> M.ModuleCmd Expr
specialize expr modEnv = run $ do
let extDgs = allDeclGroups modEnv
let (tparams, expr') = destETAbs expr
spec' <- specializeEWhere expr' extDgs
return (foldr ETAbs spec' tparams)
where
run = M.runModuleT modEnv . fmap fst . runSpecT Map.empty
specializeExpr :: Expr -> SpecM Expr
specializeExpr expr =
case expr of
ECon _econ -> pure expr
EList es t -> EList <$> traverse specializeExpr es <*> pure t
ETuple es -> ETuple <$> traverse specializeExpr es
ERec fs -> ERec <$> traverse (traverseSnd specializeExpr) fs
ESel e s -> ESel <$> specializeExpr e <*> pure s
EIf e1 e2 e3 -> EIf <$> specializeExpr e1 <*> specializeExpr e2 <*> specializeExpr e3
EComp t e mss -> EComp t <$> specializeExpr e <*> traverse (traverse specializeMatch) mss
-- Bindings within list comprehensions always have monomorphic types.
EVar {} -> specializeConst expr
ETAbs t e -> do
cache <- getSpecCache
setSpecCache Map.empty
e' <- specializeExpr e
setSpecCache cache
return (ETAbs t e')
-- We need to make sure that after processing `e`, no specialized
-- decls mentioning type variable `t` escape outside the
-- `ETAbs`. To avoid this, we reset to an empty SpecCache while we
-- run `specializeExpr e`, and restore it afterward: this
-- effectively prevents the specializer from registering any type
-- instantiations involving `t` for any decls bound outside the
-- scope of `t`.
ETApp {} -> specializeConst expr
EApp e1 e2 -> EApp <$> specializeExpr e1 <*> specializeExpr e2
EAbs qn t e -> EAbs qn t <$> specializeExpr e
EProofAbs p e -> EProofAbs p <$> specializeExpr e
EProofApp {} -> specializeConst expr
ECast e t -> ECast <$> specializeExpr e <*> pure t
-- TODO: if typeOf e == t, then drop the coercion.
EWhere e dgs -> specializeEWhere e dgs
specializeMatch :: Match -> SpecM Match
specializeMatch (From qn t e) = From qn t <$> specializeExpr e
specializeMatch (Let decl)
| null (sVars (dSignature decl)) = return (Let decl)
| otherwise = fail "unimplemented: specializeMatch Let unimplemented"
-- TODO: should treat this case like EWhere.
-- | Add the declarations to the SpecCache, run the given monadic
-- action, and then pull the specialized declarations back out of the
-- SpecCache state. Return the result along with the declarations and
-- a table of names of specialized bindings.
withDeclGroups :: [DeclGroup] -> SpecM a
-> SpecM (a, [DeclGroup], Map QName (TypesMap QName))
withDeclGroups dgs action = do
let decls = concatMap groupDecls dgs
let newCache = Map.fromList [ (dName d, (d, emptyTM)) | d <- decls ]
-- We assume that the names bound in dgs are disjoint from the other names in scope.
modifySpecCache (Map.union newCache)
result <- action
-- Then reassemble the DeclGroups.
let splitDecl :: Decl -> SpecM [Decl]
splitDecl d = do
Just (_, tm) <- Map.lookup (dName d) <$> getSpecCache
return (catMaybes $ map (snd . snd) $ toListTM tm)
let splitDeclGroup :: DeclGroup -> SpecM [DeclGroup]
splitDeclGroup (Recursive ds) = do
ds' <- concat <$> traverse splitDecl ds
if null ds'
then return []
else return [Recursive ds']
splitDeclGroup (NonRecursive d) = map NonRecursive <$> splitDecl d
dgs' <- concat <$> traverse splitDeclGroup dgs
-- Get updated map of only the local entries we added.
newCache' <- flip Map.intersection newCache <$> getSpecCache
let nameTable = fmap (fmap fst . snd) newCache'
-- Remove local definitions from the cache.
modifySpecCache (flip Map.difference newCache)
return (result, dgs', nameTable)
-- | Compute the specialization of `EWhere e dgs`. A decl within `dgs`
-- is replicated once for each monomorphic type instance at which it
-- is used; decls not mentioned in `e` (even monomorphic ones) are
-- simply dropped.
specializeEWhere :: Expr -> [DeclGroup] -> SpecM Expr
specializeEWhere e dgs = do
(e', dgs', _) <- withDeclGroups dgs (specializeExpr e)
return $ if null dgs'
then e'
else EWhere e' dgs'
-- | Transform the given declaration groups into a set of monomorphic
-- declarations. All of the original declarations with monomorphic
-- types are kept; additionally the result set includes instantiated
-- versions of polymorphic decls that are referenced by the
-- monomorphic bindings. We also return a map relating generated names
-- to the names from the original declarations.
specializeDeclGroups :: [DeclGroup] -> SpecM ([DeclGroup], Map QName (TypesMap QName))
specializeDeclGroups dgs = do
let decls = concatMap groupDecls dgs
let isMono s = null (sVars s) && null (sProps s)
let monos = [ EVar (dName d) | d <- decls, isMono (dSignature d) ]
(_, dgs', names) <- withDeclGroups dgs $ mapM specializeExpr monos
return (dgs', names)
specializeConst :: Expr -> SpecM Expr
specializeConst e0 = do
let (e1, n) = destEProofApps e0
let (e2, ts) = destETApps e1
case e2 of
EVar qname ->
do cache <- getSpecCache
case Map.lookup qname cache of
Nothing -> return e0 -- Primitive/unspecializable variable; leave it alone
Just (decl, tm) ->
case lookupTM ts tm of
Just (qname', _) -> return (EVar qname') -- Already specialized
Nothing -> do -- A new type instance of this function
qname' <- freshName qname ts -- New type instance, record new name
sig' <- instantiateSchema ts n (dSignature decl)
modifySpecCache (Map.adjust (fmap (insertTM ts (qname', Nothing))) qname)
rhs' <- specializeExpr =<< instantiateExpr ts n (dDefinition decl)
let decl' = decl { dName = qname', dSignature = sig', dDefinition = rhs' }
modifySpecCache (Map.adjust (fmap (insertTM ts (qname', Just decl'))) qname)
return (EVar qname')
_ -> return e0 -- type/proof application to non-variable; not specializable
-- Utility Functions -----------------------------------------------------------
destEProofApps :: Expr -> (Expr, Int)
destEProofApps = go 0
where
go n (EProofApp e) = go (n + 1) e
go n e = (e, n)
destETApps :: Expr -> (Expr, [Type])
destETApps = go []
where
go ts (ETApp e t) = go (t : ts) e
go ts e = (e, ts)
destEProofAbs :: Expr -> ([Prop], Expr)
destEProofAbs = go []
where
go ps (EProofAbs p e) = go (p : ps) e
go ps e = (ps, e)
destETAbs :: Expr -> ([TParam], Expr)
destETAbs = go []
where
go ts (ETAbs t e) = go (t : ts) e
go ts e = (ts, e)
-- Any top-level declarations in the current module can be found in the
-- ModuleEnv's LoadedModules, and so we can count of freshName to avoid collisions with them.
-- Additionally, decls in 'where' clauses can only (currently) be parsed with unqualified names.
-- Any generated name for a specialized function will be qualified with the current @ModName@,
-- so genned names will not collide with local decls either.
freshName :: QName -> [Type] -> SpecM QName
freshName qn [] = return qn
freshName (QName m name) tys = do
let name' = reifyName name tys
bNames <- matchingBoundNames m
let loop i = let nm = name' ++ "_" ++ show i
in if nm `elem` bNames
then loop $ i + 1
else nm
let go = if name' `elem` bNames
then loop (1 :: Integer)
else name'
return $ QName m (Name go)
matchingBoundNames :: (Maybe ModName) -> SpecM [String]
matchingBoundNames m = do
qns <- allPublicQNames <$> liftSpecT M.getModuleEnv
return [ n | QName m' (Name n) <- qns , m == m' ]
reifyName :: Name -> [Type] -> String
reifyName name tys = intercalate "_" (showName name : concatMap showT tys)
where
tvInt (TVFree i _ _ _) = i
tvInt (TVBound i _) = i
showT typ =
case typ of
TCon tc ts -> showTCon tc : concatMap showT ts
TUser _ _ t -> showT t
TVar tv -> [ "a" ++ show (tvInt tv) ]
TRec tr -> "rec" : concatMap showRecFld tr
showTCon tCon =
case tCon of
TC tc -> showTC tc
PC pc -> showPC pc
TF tf -> showTF tf
showPC pc =
case pc of
PEqual -> "eq"
PNeq -> "neq"
PGeq -> "geq"
PFin -> "fin"
PHas sel -> "sel_" ++ showSel sel
PArith -> "arith"
PCmp -> "cmp"
showTC tc =
case tc of
TCNum n -> show n
TCInf -> "inf"
TCBit -> "bit"
TCSeq -> "seq"
TCFun -> "fun"
TCTuple n -> "t" ++ show n
TCNewtype _ -> "user"
showSel sel = intercalate "_" $
case sel of
TupleSel _ sig -> "tup" : maybe [] ((:[]) . show) sig
RecordSel x sig -> "rec" : showName x : map showName (maybe [] id sig)
ListSel _ sig -> "list" : maybe [] ((:[]) . show) sig
showName nm =
case nm of
Name s -> s
NewName _ n -> "x" ++ show n
showTF tf =
case tf of
TCAdd -> "add"
TCSub -> "sub"
TCMul -> "mul"
TCDiv -> "div"
TCMod -> "mod"
TCLg2 -> "lg2"
TCExp -> "exp"
TCWidth -> "width"
TCMin -> "min"
TCMax -> "max"
TCLenFromThen -> "len_from_then"
TCLenFromThenTo -> "len_from_then_to"
showRecFld (nm,t) = showName nm : showT t
instantiateSchema :: [Type] -> Int -> Schema -> SpecM Schema
instantiateSchema ts n (Forall params props ty)
| length params /= length ts = fail "instantiateSchema: wrong number of type arguments"
| length props /= n = fail "instantiateSchema: wrong number of prop arguments"
| otherwise = return $ Forall [] [] (apSubst sub ty)
where sub = listSubst [ (tpVar p, t) | (p, t) <- zip params ts ]
-- | Reduce `length ts` outermost type abstractions and `n` proof abstractions.
instantiateExpr :: [Type] -> Int -> Expr -> SpecM Expr
instantiateExpr [] 0 e = return e
instantiateExpr [] n (EProofAbs _ e) = instantiateExpr [] (n - 1) e
instantiateExpr (t : ts) n (ETAbs param e) =
instantiateExpr ts n (apSubst (singleSubst (tpVar param) t) e)
instantiateExpr _ _ _ = fail "instantiateExpr: wrong number of type/proof arguments"
allDeclGroups :: M.ModuleEnv -> [DeclGroup]
allDeclGroups =
concatMap mDecls
. M.loadedModules
allLoadedModules :: M.ModuleEnv -> [M.LoadedModule]
allLoadedModules =
M.getLoadedModules
. M.meLoadedModules
allPublicQNames :: M.ModuleEnv -> [QName]
allPublicQNames =
concatMap
( Map.keys
. M.ifDecls
. M.ifPublic
. M.lmInterface
)
. allLoadedModules
traverseSnd :: Functor f => (b -> f c) -> (a, b) -> f (a, c)
traverseSnd f (x, y) = (,) x <$> f y
cryptol-2.2.6/src/Cryptol/TypeCheck/ 0000755 0000000 0000000 00000000000 12637103426 015511 5 ustar 00 0000000 0000000 cryptol-2.2.6/src/Cryptol/TypeCheck/AST.hs 0000644 0000000 0000000 00000064062 12637103426 016504 0 ustar 00 0000000 0000000 -- |
-- Module : $Header$
-- Copyright : (c) 2013-2015 Galois, Inc.
-- License : BSD3
-- Maintainer : cryptol@galois.com
-- Stability : provisional
-- Portability : portable
{-# LANGUAGE Safe #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE FlexibleInstances, FlexibleContexts #-}
module Cryptol.TypeCheck.AST
( module Cryptol.TypeCheck.AST
, TFun(..)
, Name(..), QName(..), mkUnqual, unqual
, ModName(..)
, Selector(..)
, Import(..)
, ImportSpec(..)
, ExportType(..)
, ExportSpec(..), isExportedBind, isExportedType
, Pragma(..)
) where
import Cryptol.Prims.Syntax
import Cryptol.Parser.AST ( Name(..), Selector(..),Pragma(..), ppSelector
, Import(..), ImportSpec(..), ExportType(..)
, ExportSpec(..), ModName(..), isExportedBind
, isExportedType, QName(..), mkUnqual, unqual )
import Cryptol.Utils.Panic(panic)
import Cryptol.TypeCheck.PP
import Data.Map (Map)
import qualified Data.Map as Map
import qualified Data.IntMap as IntMap
import Data.Set (Set)
{- | A Cryptol module.
-}
data Module = Module { mName :: ModName
, mExports :: ExportSpec
, mImports :: [Import]
, mTySyns :: Map QName TySyn
, mNewtypes :: Map QName Newtype
, mDecls :: [DeclGroup]
} deriving Show
-- | Kinds, classify types.
data Kind = KType
| KNum
| KProp
| Kind :-> Kind
deriving (Eq,Show)
infixr 5 :->
-- | The types of polymorphic values.
data Schema = Forall { sVars :: [TParam], sProps :: [Prop], sType :: Type }
deriving (Eq, Show)
-- | Type synonym.
data TySyn = TySyn { tsName :: QName -- ^ Name
, tsParams :: [TParam] -- ^ Parameters
, tsConstraints :: [Prop] -- ^ Ensure body is OK
, tsDef :: Type -- ^ Definition
}
deriving (Eq, Show)
-- | Named records
data Newtype = Newtype { ntName :: QName
, ntParams :: [TParam]
, ntConstraints :: [Prop]
, ntFields :: [(Name,Type)]
} deriving (Show)
-- | Type parameters.
data TParam = TParam { tpUnique :: !Int -- ^ Parameter identifier
, tpKind :: Kind -- ^ Kind of parameter
, tpName :: Maybe QName-- ^ Name from source, if any.
}
deriving (Show)
instance Eq TParam where
x == y = tpUnique x == tpUnique y
instance Ord TParam where
compare x y = compare (tpUnique x) (tpUnique y)
tpVar :: TParam -> TVar
tpVar p = TVBound (tpUnique p) (tpKind p)
-- | The internal representation of types.
-- These are assumed to be kind correct.
data Type = TCon TCon [Type]
-- ^ Type constant with args
| TVar TVar
-- ^ Type variable (free or bound)
| TUser QName [Type] Type
{- ^ This is just a type annotation, for a type that
was written as a type synonym. It is useful so that we
can use it to report nicer errors.
Example: `TUser T ts t` is really just the type `t` that
was written as `T ts` by the user. -}
| TRec [(Name,Type)]
-- ^ Record type
deriving (Show,Eq,Ord)
-- | The type is supposed to be of kind `KProp`
type Prop = Type
-- | The type is "simple" (i.e., it contains no type functions).
type SType = Type
-- | Type variables.
data TVar = TVFree !Int Kind (Set TVar) Doc
-- ^ Unique, kind, ids of bound type variables that are in scope
-- The `Doc` is a description of how this type came to be.
| TVBound !Int Kind
deriving Show
-- | Type constants.
data TCon = TC TC | PC PC | TF TFun
deriving (Show,Eq,Ord)
-- | Built-in type constants.
-- | Predicate symbols.
data PC = PEqual -- ^ @_ == _@
| PNeq -- ^ @_ /= _@
| PGeq -- ^ @_ >= _@
| PFin -- ^ @fin _@
-- classes
| PHas Selector -- ^ @Has sel type field@ does not appear in schemas
| PArith -- ^ @Arith _@
| PCmp -- ^ @Cmp _@
deriving (Show,Eq,Ord)
-- | 1-1 constants.
data TC = TCNum Integer -- ^ Numbers
| TCInf -- ^ Inf
| TCBit -- ^ Bit
| TCSeq -- ^ @[_] _@
| TCFun -- ^ @_ -> _@
| TCTuple Int -- ^ @(_, _, _)@
| TCNewtype UserTC -- ^ user-defined, @T@
deriving (Show,Eq,Ord)
data UserTC = UserTC QName Kind
deriving Show
instance Eq UserTC where
UserTC x _ == UserTC y _ = x == y
instance Ord UserTC where
compare (UserTC x _) (UserTC y _) = compare x y
instance Eq TVar where
TVBound x _ == TVBound y _ = x == y
TVFree x _ _ _ == TVFree y _ _ _ = x == y
_ == _ = False
instance Ord TVar where
compare (TVFree x _ _ _) (TVFree y _ _ _) = compare x y
compare (TVFree _ _ _ _) _ = LT
compare _ (TVFree _ _ _ _) = GT
compare (TVBound x _) (TVBound y _) = compare x y
data Expr = ECon ECon -- ^ Built-in constant
| EList [Expr] Type -- ^ List value (with type of elements)
| ETuple [Expr] -- ^ Tuple value
| ERec [(Name,Expr)] -- ^ Record value
| ESel Expr Selector -- ^ Elimination for tuple/record/list
| EIf Expr Expr Expr -- ^ If-then-else
| EComp Type Expr [[Match]] -- ^ List comprehensions
-- The type caches the type of the
-- expr.
| EVar QName -- ^ Use of a bound variable
| ETAbs TParam Expr -- ^ Function Value
| ETApp Expr Type -- ^ Type application
| EApp Expr Expr -- ^ Function application
| EAbs QName Type Expr -- ^ Function value
{- | Proof abstraction. Because we don't keep proofs around
we don't need to name the assumption, but we still need to
record the assumption. The assumption is the `Type` term,
which should be of kind `KProp`.
-}
| EProofAbs {- x -} Prop Expr
{- | If `e : p => t`, then `EProofApp e : t`,
as long as we can prove `p`.
We don't record the actual proofs, as they are not
used for anything. It may be nice to keep them around
for sanity checking.
-}
| EProofApp Expr {- proof -}
{- | if e : t1, then cast e : t2
as long as we can prove that 't1 = t2'.
We could express this in terms of a built-in constant.
`cast :: {a,b} (a =*= b) => a -> b`
Using the constant is a bit verbose though, because we
end up with both the source and target type. So, instead
we use this language construct, which only stores the
target type, and the source type can be reconstructed
from the expression.
Another way to think of this is simply as an expression
with an explicit type annotation.
-}
| ECast Expr Type
| EWhere Expr [DeclGroup]
deriving Show
data Match = From QName Type Expr-- ^ do we need this type? it seems like it
-- can be computed from the expr
| Let Decl
deriving Show
data DeclGroup = Recursive [Decl] -- ^ Mutually recursive declarations
| NonRecursive Decl -- ^ Non-recursive declaration
deriving Show
groupDecls :: DeclGroup -> [Decl]
groupDecls dg = case dg of
Recursive ds -> ds
NonRecursive d -> [d]
data Decl = Decl { dName :: QName
, dSignature :: Schema
, dDefinition :: Expr
, dPragmas :: [Pragma]
} deriving (Show)
--------------------------------------------------------------------------------
isFreeTV :: TVar -> Bool
isFreeTV (TVFree {}) = True
isFreeTV _ = False
isBoundTV :: TVar -> Bool
isBoundTV (TVBound {}) = True
isBoundTV _ = False
--------------------------------------------------------------------------------
tIsNum :: Type -> Maybe Integer
tIsNum ty = case tNoUser ty of
TCon (TC (TCNum x)) [] -> Just x
_ -> Nothing
tIsInf :: Type -> Bool
tIsInf ty = case tNoUser ty of
TCon (TC TCInf) [] -> True
_ -> False
tIsVar :: Type -> Maybe TVar
tIsVar ty = case tNoUser ty of
TVar x -> Just x
_ -> Nothing
tIsFun :: Type -> Maybe (Type, Type)
tIsFun ty = case tNoUser ty of
TCon (TC TCFun) [a, b] -> Just (a, b)
_ -> Nothing
tIsSeq :: Type -> Maybe (Type, Type)
tIsSeq ty = case tNoUser ty of
TCon (TC TCSeq) [n, a] -> Just (n, a)
_ -> Nothing
tIsBit :: Type -> Bool
tIsBit ty = case tNoUser ty of
TCon (TC TCBit) [] -> True
_ -> False
tIsTuple :: Type -> Maybe [Type]
tIsTuple ty = case tNoUser ty of
TCon (TC (TCTuple _)) ts -> Just ts
_ -> Nothing
pIsFin :: Prop -> Maybe Type
pIsFin ty = case tNoUser ty of
TCon (PC PFin) [t1] -> Just t1
_ -> Nothing
pIsGeq :: Prop -> Maybe (Type,Type)
pIsGeq ty = case tNoUser ty of
TCon (PC PGeq) [t1,t2] -> Just (t1,t2)
_ -> Nothing
pIsEq :: Prop -> Maybe (Type,Type)
pIsEq ty = case tNoUser ty of
TCon (PC PEqual) [t1,t2] -> Just (t1,t2)
_ -> Nothing
pIsArith :: Prop -> Maybe Type
pIsArith ty = case tNoUser ty of
TCon (PC PArith) [t1] -> Just t1
_ -> Nothing
pIsCmp :: Prop -> Maybe Type
pIsCmp ty = case tNoUser ty of
TCon (PC PCmp) [t1] -> Just t1
_ -> Nothing
pIsNumeric :: Prop -> Bool
pIsNumeric (TCon (PC PEqual) _) = True
pIsNumeric (TCon (PC PNeq) _) = True
pIsNumeric (TCon (PC PGeq) _) = True
pIsNumeric (TCon (PC PFin) _) = True
pIsNumeric (TUser _ _ t) = pIsNumeric t
pIsNumeric _ = False
--------------------------------------------------------------------------------
tNum :: Integral a => a -> Type
tNum n = TCon (TC (TCNum (fromIntegral n))) []
tZero :: Type
tZero = tNum (0 :: Int)
tOne :: Type
tOne = tNum (1 :: Int)
tTwo :: Type
tTwo = tNum (2 :: Int)
tInf :: Type
tInf = TCon (TC TCInf) []
tBit :: Type
tBit = TCon (TC TCBit) []
eTrue :: Expr
eTrue = ECon ECTrue
eFalse :: Expr
eFalse = ECon ECFalse
tWord :: Type -> Type
tWord a = tSeq a tBit
tSeq :: Type -> Type -> Type
tSeq a b = TCon (TC TCSeq) [a,b]
tChar :: Type
tChar = tWord (tNum (8 :: Int))
eChar :: Char -> Expr
eChar c = ETApp (ETApp (ECon ECDemote) (tNum v)) (tNum w)
where v = fromEnum c
w = 8 :: Int
tString :: Int -> Type
tString len = tSeq (tNum len) tChar
eString :: String -> Expr
eString str = EList (map eChar str) tChar
-- | Make an expression that is `error` pre-applied to a type and a
-- message.
eError :: Type -> String -> Expr
eError t str =
EApp (ETApp (ETApp (ECon ECError) t) (tNum (length str))) (eString str)
tRec :: [(Name,Type)] -> Type
tRec = TRec
tTuple :: [Type] -> Type
tTuple ts = TCon (TC (TCTuple (length ts))) ts
infixr 5 `tFun`
-- | Make a function type.
tFun :: Type -> Type -> Type
tFun a b = TCon (TC TCFun) [a,b]
-- | Eliminate type synonyms.
tNoUser :: Type -> Type
tNoUser t = case t of
TUser _ _ a -> tNoUser a
_ -> t
tWidth :: Type -> Type
tWidth t = TCon (TF TCWidth) [t]
tLenFromThen :: Type -> Type -> Type -> Type
tLenFromThen t1 t2 t3 = TCon (TF TCLenFromThen) [t1,t2,t3]
tLenFromThenTo :: Type -> Type -> Type -> Type
tLenFromThenTo t1 t2 t3 = TCon (TF TCLenFromThenTo) [t1,t2,t3]
tMax :: Type -> Type -> Type
tMax t1 t2 = TCon (TF TCMax) [t1,t2]
infix 4 =#=, >==
infixl 6 .+.
infixl 7 .*.
-- | Equality for numeric types.
(=#=) :: Type -> Type -> Prop
x =#= y = TCon (PC PEqual) [x,y]
(=/=) :: Type -> Type -> Prop
x =/= y = TCon (PC PNeq) [x,y]
pArith :: Type -> Prop
pArith t = TCon (PC PArith) [t]
pCmp :: Type -> Prop
pCmp t = TCon (PC PCmp) [t]
-- | Make a greater-than-or-equal-to constraint.
(>==) :: Type -> Type -> Prop
x >== y = TCon (PC PGeq) [x,y]
-- | A `Has` constraint, used for tuple and record selection.
pHas :: Selector -> Type -> Type -> Prop
pHas l ty fi = TCon (PC (PHas l)) [ty,fi]
pFin :: Type -> Prop
pFin ty = TCon (PC PFin) [ty]
-- | Make multiplication type.
(.*.) :: Type -> Type -> Type
x .*. y = TCon (TF TCMul) [x,y]
-- | Make addition type.
(.+.) :: Type -> Type -> Type
x .+. y = TCon (TF TCAdd) [x,y]
(.-.) :: Type -> Type -> Type
x .-. y = TCon (TF TCSub) [x,y]
(.^.) :: Type -> Type -> Type
x .^. y = TCon (TF TCExp) [x,y]
tDiv :: Type -> Type -> Type
tDiv x y = TCon (TF TCDiv) [x,y]
tMod :: Type -> Type -> Type
tMod x y = TCon (TF TCMod) [x,y]
-- | Make a @min@ type.
tMin :: Type -> Type -> Type
tMin x y = TCon (TF TCMin) [x,y]
newtypeTyCon :: Newtype -> TCon
newtypeTyCon nt = TC $ TCNewtype $ UserTC (ntName nt) (kindOf nt)
newtypeConType :: Newtype -> Schema
newtypeConType nt =
Forall as (ntConstraints nt)
$ TRec (ntFields nt) `tFun` TCon (newtypeTyCon nt) (map (TVar . tpVar) as)
where
as = ntParams nt
--------------------------------------------------------------------------------
class HasKind t where
kindOf :: t -> Kind
instance HasKind TVar where
kindOf (TVFree _ k _ _) = k
kindOf (TVBound _ k) = k
instance HasKind TCon where
kindOf (TC tc) = kindOf tc
kindOf (PC pc) = kindOf pc
kindOf (TF tf) = kindOf tf
instance HasKind UserTC where
kindOf (UserTC _ k) = k
instance HasKind TC where
kindOf tcon =
case tcon of
TCNum _ -> KNum
TCInf -> KNum
TCBit -> KType
TCSeq -> KNum :-> KType :-> KType
TCFun -> KType :-> KType :-> KType
TCTuple n -> foldr (:->) KType (replicate n KType)
TCNewtype x -> kindOf x
instance HasKind PC where
kindOf pc =
case pc of
PEqual -> KNum :-> KNum :-> KProp
PNeq -> KNum :-> KNum :-> KProp
PGeq -> KNum :-> KNum :-> KProp
PFin -> KNum :-> KProp
PHas _ -> KType :-> KType :-> KProp
PArith -> KType :-> KProp
PCmp -> KType :-> KProp
instance HasKind TFun where
kindOf tfun =
case tfun of
TCWidth -> KNum :-> KNum
TCLg2 -> KNum :-> KNum
TCAdd -> KNum :-> KNum :-> KNum
TCSub -> KNum :-> KNum :-> KNum
TCMul -> KNum :-> KNum :-> KNum
TCDiv -> KNum :-> KNum :-> KNum
TCMod -> KNum :-> KNum :-> KNum
TCExp -> KNum :-> KNum :-> KNum
TCMin -> KNum :-> KNum :-> KNum
TCMax -> KNum :-> KNum :-> KNum
TCLenFromThen -> KNum :-> KNum :-> KNum :-> KNum
TCLenFromThenTo -> KNum :-> KNum :-> KNum :-> KNum
instance HasKind Type where
kindOf ty =
case ty of
TVar a -> kindOf a
TCon c ts -> quickApply (kindOf c) ts
TUser _ _ t -> kindOf t
TRec {} -> KType
instance HasKind TySyn where
kindOf (TySyn _ as _ t) = foldr (:->) (kindOf t) (map kindOf as)
instance HasKind Newtype where
kindOf nt = foldr (:->) KType (map kindOf (ntParams nt))
instance HasKind TParam where
kindOf p = tpKind p
quickApply :: Kind -> [a] -> Kind
quickApply k [] = k
quickApply (_ :-> k) (_ : ts) = quickApply k ts
quickApply k _ = panic "Cryptol.TypeCheck.AST.quickApply"
[ "Applying a non-function kind:", show k ]
-- Pretty Printing -------------------------------------------------------------
instance PP Kind where
ppPrec p k = case k of
KType -> char '*'
KNum -> char '#'
KProp -> text "Prop"
l :-> r -> optParens (p >= 1) (sep [ppPrec 1 l, text "->", ppPrec 0 r])
instance PP (WithNames TVar) where
ppPrec _ (WithNames (TVBound x _) mp) =
case IntMap.lookup x mp of
Just a -> text a
Nothing -> text ("a`" ++ show x)
ppPrec _ (WithNames (TVFree x _ _ _) _) =
char '?' <> text (intToName x)
instance PP TParam where
ppPrec = ppWithNamesPrec IntMap.empty
instance PP (WithNames TParam) where
ppPrec _ (WithNames p mp) = ppWithNames mp (tpVar p)
instance PP (WithNames Type) where
ppPrec prec ty0@(WithNames ty nmMap) =
case ty of
TVar a -> ppWithNames nmMap a
TRec fs -> braces $ fsep $ punctuate comma
[ pp l <+> text ":" <+> go 0 t | (l,t) <- fs ]
TUser c ts _ -> optParens (prec > 3) $ pp c <+> fsep (map (go 4) ts)
TCon (TC tc) ts ->
case (tc,ts) of
(TCNum n, []) -> integer n
(TCInf, []) -> text "inf"
(TCBit, []) -> text "Bit"
(TCSeq, [t1,TCon (TC TCBit) []]) -> brackets (go 0 t1)
(TCSeq, [t1,t2]) -> optParens (prec > 3)
$ brackets (go 0 t1) <> go 3 t2
(TCFun, [t1,t2]) -> optParens (prec > 1)
$ go 2 t1 <+> text "->" <+> go 1 t2
(TCTuple _, fs) -> parens $ fsep $ punctuate comma $ map (go 0) fs
(_, _) -> pp tc <+> fsep (map (go 4) ts)
TCon (PC pc) ts ->
case (pc,ts) of
(PEqual, [t1,t2]) -> go 0 t1 <+> text "==" <+> go 0 t2
(PNeq , [t1,t2]) -> go 0 t1 <+> text "/=" <+> go 0 t2
(PGeq, [t1,t2]) -> go 0 t1 <+> text ">=" <+> go 0 t2
(PFin, [t1]) -> text "fin" <+> (go 4 t1)
(PHas x, [t1,t2]) -> ppSelector x <+> text "of"
<+> go 0 t1 <+> text "is" <+> go 0 t2
(PArith, [t1]) -> pp pc <+> go 4 t1
(PCmp, [t1]) -> pp pc <+> go 4 t1
(_, _) -> pp pc <+> fsep (map (go 4) ts)
_ | Just tinf <- isTInfix ty0 -> optParens (prec > 2)
$ ppInfix 2 isTInfix tinf
TCon f ts -> optParens (prec > 3)
$ pp f <+> fsep (map (go 4) ts)
where
go p t = ppWithNamesPrec nmMap p t
isTInfix (WithNames (TCon (TF ieOp) [ieLeft',ieRight']) _) =
do let ieLeft = WithNames ieLeft' nmMap
ieRight = WithNames ieRight' nmMap
(ieAssoc,iePrec) <- Map.lookup ieOp tBinOpPrec
return Infix { .. }
isTInfix _ = Nothing
addTNames :: [TParam] -> NameMap -> NameMap
addTNames as ns = foldr (uncurry IntMap.insert) ns
$ named ++ zip unnamed avail
where avail = filter (`notElem` used) (nameList [])
named = [ (u,show (pp n))
| TParam { tpUnique = u, tpName = Just n } <- as ]
unnamed = [ u | TParam { tpUnique = u, tpName = Nothing } <- as ]
used = map snd named ++ IntMap.elems ns
ppNewtypeShort :: Newtype -> Doc
ppNewtypeShort nt =
text "newtype" <+> pp (ntName nt) <+> hsep (map (ppWithNamesPrec nm 9) ps)
where
ps = ntParams nt
nm = addTNames ps emptyNameMap
instance PP Schema where
ppPrec = ppWithNamesPrec IntMap.empty
instance PP (WithNames Schema) where
ppPrec _ (WithNames s ns) = vars <+> props <+> ppWithNames ns1 (sType s)
where
vars = case sVars s of
[] -> empty
vs -> braces $ commaSep $ map (ppWithNames ns1) vs
props = case sProps s of
[] -> empty
ps -> parens (commaSep (map (ppWithNames ns1) ps)) <+> text "=>"
ns1 = addTNames (sVars s) ns
instance PP TySyn where
ppPrec = ppWithNamesPrec IntMap.empty
instance PP (WithNames TySyn) where
ppPrec _ (WithNames (TySyn n ps _ ty) ns) =
text "type" <+> pp n <+> sep (map (ppWithNames ns1) ps) <+> char '='
<+> ppWithNames ns1 ty
where ns1 = addTNames ps ns
instance PP Type where
ppPrec n t = ppWithNamesPrec IntMap.empty n t
instance PP TCon where
ppPrec _ (TC tc) = pp tc
ppPrec _ (PC tc) = pp tc
ppPrec _ (TF tc) = pp tc
instance PP PC where
ppPrec _ x =
case x of
PEqual -> text "(==)"
PNeq -> text "(/=)"
PGeq -> text "(>=)"
PFin -> text "fin"
PHas sel -> parens (ppSelector sel)
PArith -> text "Arith"
PCmp -> text "Cmp"
instance PP TC where
ppPrec _ x =
case x of
TCNum n -> integer n
TCInf -> text "inf"
TCBit -> text "Bit"
TCSeq -> text "[]"
TCFun -> text "(->)"
TCTuple 0 -> text "()"
TCTuple 1 -> text "(one tuple?)"
TCTuple n -> parens $ hcat $ replicate (n-1) comma
TCNewtype u -> pp u
instance PP UserTC where
ppPrec p (UserTC x _) = ppPrec p x
instance PP (WithNames Expr) where
ppPrec prec (WithNames expr nm) =
case expr of
ECon c -> ppPrefix c
EList [] t -> optParens (prec > 0)
$ text "[]" <+> colon <+> ppWP prec t
EList es _ -> brackets $ sep $ punctuate comma $ map ppW es
ETuple es -> parens $ sep $ punctuate comma $ map ppW es
ERec fs -> braces $ sep $ punctuate comma
[ pp f <+> text "=" <+> ppW e | (f,e) <- fs ]
ESel e sel -> ppWP 4 e <+> text "." <> pp sel
EIf e1 e2 e3 -> optParens (prec > 0)
$ sep [ text "if" <+> ppW e1
, text "then" <+> ppW e2
, text "else" <+> ppW e3 ]
EComp _ e mss -> let arm ms = text "|" <+> commaSep (map ppW ms)
in brackets $ ppW e <+> vcat (map arm mss)
EVar x -> pp x
EAbs {} -> let (xs,e) = splitWhile splitAbs expr
in ppLam nm prec [] [] xs e
EProofAbs {} -> let (ps,e1) = splitWhile splitProofAbs expr
(xs,e2) = splitWhile splitAbs e1
in ppLam nm prec [] ps xs e2
ETAbs {} -> let (ts,e1) = splitWhile splitTAbs expr
(ps,e2) = splitWhile splitProofAbs e1
(xs,e3) = splitWhile splitAbs e2
in ppLam nm prec ts ps xs e3
EApp e1 e2 -> optParens (prec > 3)
$ ppWP 3 e1 <+> ppWP 4 e2
EProofApp e -> optParens (prec > 3)
$ ppWP 3 e <+> text "<>"
ETApp e t -> optParens (prec > 3)
$ ppWP 3 e <+> ppWP 4 t
ECast e t -> optParens (prec > 0)
( ppWP 2 e <+> text ":" <+> ppW t )
EWhere e ds -> optParens (prec > 0)
( ppW e $$ text "where"
$$ nest 2 (vcat (map ppW ds))
$$ text "" )
where
ppW x = ppWithNames nm x
ppWP x = ppWithNamesPrec nm x
ppLam :: NameMap -> Int -> [TParam] -> [Prop] -> [(QName,Type)] -> Expr -> Doc
ppLam nm prec [] [] [] e = ppWithNamesPrec nm prec e
ppLam nm prec ts ps xs e =
optParens (prec > 0) $
sep [ text "\\" <> tsD <+> psD <+> xsD <+> text "->"
, ppWithNames ns1 e
]
where
ns1 = addTNames ts nm
tsD = if null ts then empty else braces $ sep $ punctuate comma $ map ppT ts
psD = if null ps then empty else parens $ sep $ punctuate comma $ map ppP ps
xsD = if null xs then empty else sep $ map ppArg xs
ppT = ppWithNames ns1
ppP = ppWithNames ns1
ppArg (x,t) = parens (pp x <+> text ":" <+> ppWithNames ns1 t)
splitWhile :: (a -> Maybe (b,a)) -> a -> ([b],a)
splitWhile f e = case f e of
Nothing -> ([], e)
Just (x,e1) -> let (xs,e2) = splitWhile f e1
in (x:xs,e2)
splitAbs :: Expr -> Maybe ((QName,Type), Expr)
splitAbs (EAbs x t e) = Just ((x,t), e)
splitAbs _ = Nothing
splitTAbs :: Expr -> Maybe (TParam, Expr)
splitTAbs (ETAbs t e) = Just (t, e)
splitTAbs _ = Nothing
splitProofAbs :: Expr -> Maybe (Prop, Expr)
splitProofAbs (EProofAbs p e) = Just (p,e)
splitProofAbs _ = Nothing
instance PP Expr where
ppPrec n t = ppWithNamesPrec IntMap.empty n t
instance PP (WithNames Match) where
ppPrec _ (WithNames mat nm) =
case mat of
From x _ e -> pp x <+> text "<-" <+> ppWithNames nm e
Let d -> text "let" <+> ppWithNames nm d
instance PP Match where
ppPrec = ppWithNamesPrec IntMap.empty
instance PP (WithNames DeclGroup) where
ppPrec _ (WithNames dg nm) =
case dg of
Recursive ds -> text "/* Recursive */"
$$ vcat (map (ppWithNames nm) ds)
$$ text ""
NonRecursive d -> text "/* Not recursive */"
$$ ppWithNames nm d
$$ text ""
instance PP DeclGroup where
ppPrec = ppWithNamesPrec IntMap.empty
instance PP (WithNames Decl) where
ppPrec _ (WithNames Decl { .. } nm) =
pp dName <+> text ":" <+> ppWithNames nm dSignature $$
(if null dPragmas
then empty
else text "pragmas" <+> pp dName <+> sep (map pp dPragmas)
) $$
pp dName <+> text "=" <+> ppWithNames nm dDefinition
instance PP Decl where
ppPrec = ppWithNamesPrec IntMap.empty
instance PP Module where
ppPrec = ppWithNamesPrec IntMap.empty
instance PP (WithNames Module) where
ppPrec _ (WithNames Module { .. } nm) =
text "module" <+> pp mName $$
-- XXX: Print exports?
vcat (map pp mImports) $$
-- XXX: Print tysyns
vcat (map (ppWithNames nm) mDecls)
cryptol-2.2.6/src/Cryptol/TypeCheck/Defaulting.hs 0000644 0000000 0000000 00000017620 12637103426 020135 0 ustar 00 0000000 0000000 -- |
-- Module : $Header$
-- Copyright : (c) 2013-2015 Galois, Inc.
-- License : BSD3
-- Maintainer : cryptol@galois.com
-- Stability : provisional
-- Portability : portable
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE Safe #-}
module Cryptol.TypeCheck.Defaulting where
import Cryptol.Parser.Position(Range)
import Cryptol.TypeCheck.AST
import Cryptol.TypeCheck.InferTypes
(Solved(..),Goal(..),ConstraintSource(..), Warning(..))
import Cryptol.TypeCheck.Solver.Eval (assumedOrderModel,simpType)
import Cryptol.TypeCheck.Solver.FinOrd(noFacts,OrdFacts,ordFactsToGoals)
import Cryptol.TypeCheck.Solver.Numeric(numericStep,goalOrderModel)
import Cryptol.TypeCheck.Subst
(Subst,apSubst,listSubst,fvs,emptySubst,singleSubst)
import Cryptol.Utils.Panic(panic)
import Control.Monad(guard,msum)
import qualified Data.Map as Map
import qualified Data.Set as Set
import Data.List(nubBy)
import Data.Maybe(fromMaybe)
--------------------------------------------------------------------------------
-- This is what we use to avoid ambiguity when generalizing.
{- If a variable, `a`, is:
1. Of kind KNum
2. Generic (i.e., does not appear in the environment)
3. It appears only in constraints but not in the resulting type
(i.e., it is not on the RHS of =>)
4. It (say, the variable 'a') appears only in constraints like this:
3.1 `a >= t` with (`a` not in `fvs t`)
3.2 in the `s` of `fin s`
Then we replace `a` with `max(t1 .. tn)` where the `ts`
are from the constraints `a >= t`.
If `t1 .. tn` is empty, then we replace `a` with 0.
This function assumes that 1-3 have been checked, and implements the rest.
So, given some variables and constraints that are about to be generalized,
we return:
1. a new (same or smaller) set of variables to quantify,
2. a new set of constraints,
3. a substitution which indicates what got defaulted.
-}
tryDefault :: [TVar] -> [Goal] -> ([TVar], [Goal], Subst, [Warning])
tryDefault = tryDefaultWith noFacts
tryDefaultWith :: OrdFacts -> [TVar] -> [Goal] ->
([TVar], [Goal], Subst, [Warning])
tryDefaultWith ordM0 as ps =
classify (Map.fromList [ (a,([],Set.empty)) | a <- as ]) [] [] ps
where
-- leq: candidate definitions (i.e. of the form x >= t, x `notElem` fvs t)
-- for each of these, we keep the list of `t`, and the free vars in them.
-- fins: all `fin` constraints
-- others: any other constraints
classify leqs fins others [] =
let -- First, we use the `leqs` to choose some definitions.
(defs, newOthers) = select [] [] (fvs others) (Map.toList leqs)
su = listSubst defs
-- Do this to simplify the instantiated "fin" constraints.
(m, bad, oth) = goalOrderModel ordM0
(newOthers ++ others ++ apSubst su fins)
in case bad of
-- All good.
[] ->
let warn (x,t) =
case x of
TVFree _ _ _ d -> DefaultingTo d t
TVBound {} -> panic "Crypto.TypeCheck.Infer"
[ "tryDefault attempted to default a quantified variable."
]
in ( [ a | a <- as, a `notElem` map fst defs ]
, ordFactsToGoals m ++ nubBy (\x y -> goal x == goal y) oth
, su
, map warn defs
)
-- Something went wrong, don't default.
_ -> (as,ps,emptySubst,[])
classify leqs fins others (prop : more) =
case tNoUser (goal prop) of
TCon (PC PFin) [ _ ] -> classify leqs (prop : fins) others more
-- Things of the form: x >= T(x) are not defaulted.
TCon (PC PGeq) [ TVar x, t ]
| x `elem` as && x `Set.notMember` freeRHS ->
classify leqs' fins others more
where freeRHS = fvs t
add (xs1,vs1) (xs2,vs2) = (xs1 ++ xs2, Set.union vs1 vs2)
leqs' = Map.insertWith add x ([(t,prop)],freeRHS) leqs
_ -> classify leqs fins (prop : others) more
-- Pickout which variables may be defaulted and how.
select yes no _ [] = ([ (x, simpType noFacts t) | (x,t) <- yes ] ,no)
select yes no otherFree ((x,(rhsG,vs)) : more) =
select newYes newNo newFree newMore
where
(ts,gs) = unzip rhsG
-- `x` selected only if appears nowehere else.
-- this includes other candidates for defaulting.
(newYes,newNo,newFree,newMore)
-- Mentioned in other constraints, definately not defaultable.
| x `Set.member` otherFree = noDefaulting
| otherwise =
let deps = [ y | (y,(_,yvs)) <- more, x `Set.member` yvs ]
recs = filter (`Set.member` vs) deps
in if not (null recs) || isBoundTV x -- x >= S(y), y >= T(x)
then noDefaulting
-- x >= S, y >= T(x) or
-- x >= S(y), y >= S
else yesDefaulting
where
noDefaulting = ( yes, gs ++ no, vs `Set.union` otherFree, more )
yesDefaulting =
let ty = case ts of
[] -> tNum (0::Int)
_ -> foldr1 tMax ts
su1 = singleSubst x ty
in ( (x,ty) : [ (y,apSubst su1 t) | (y,t) <- yes ]
, no -- We know that `x` does not appear here
, otherFree -- We know that `x` did not appear here either
-- No need to update the `vs` because we've already
-- checked that there are no recursive dependencies.
, [ (y, (apSubst su1 ts1, vs1)) | (y,(ts1,vs1)) <- more ]
)
--------------------------------------------------------------------------------
-- This is used when we just want to instantiate things in the REPL.
-- | Try to pick a reasonable instantiation for an expression, with
-- the given type. This is useful when we do evaluation at the REPL.
-- The resaulting types should satisfy the constraints of the schema.
defaultExpr :: Range -> Expr -> Schema -> Maybe ([(TParam,Type)], Expr)
defaultExpr r e s =
do let vs = sVars s
guard $ all (\v -> kindOf v == KNum) vs -- only defautl numerics.
ps <- simplify [] $ map toGoal $ sProps s
soln <- go [] vs ps
tys <- mapM (`lookup` soln) vs
return (soln, foldl (\e1 _ -> EProofApp e1) (foldl ETApp e tys) (sProps s))
where
candidate :: Goal -> Maybe (TVar,Integer)
candidate p = do (t1,t2) <- pIsGeq $ simpType noFacts $ goal p
a <- tIsVar t1
n <- tIsNum t2
return (a,n)
go done [] [] = return done
go done ts [] = return (done ++ [ (tp, tNum (0::Integer)) | tp <- ts ])
go _ [] _ = Nothing
go done as@(tp0:_) ps =
do let (a,n) = fromMaybe (tpVar tp0, 0) $ msum (map candidate ps)
-- If no candidate works, we try to set the variable to 0
-- This handles a case when all we have letft are fin constraints.
(tp,tps) <- getParam a as
let ty = tNum n
su = singleSubst a ty
ps1 <- simplify [] (apSubst su ps)
go ((tp,ty) : done) tps ps1
getParam _ [] = Nothing
getParam v (tp : tps)
| tpVar tp == v = Just (tp,tps)
| otherwise = do (a,more) <- getParam v tps
return (a,tp:more)
simplify done [] = return done
simplify done (p : ps) =
case assumedOrderModel noFacts $ map goal (done ++ ps) of
Left _ -> Nothing
Right (m,_) ->
case numericStep m p of
Solved Nothing ps1 -> simplify done (ps1 ++ ps)
Solved (Just su) ps1 ->
simplify [] (ps1 ++ apSubst su done ++ apSubst su ps)
Unsolved -> simplify (p : done) ps
Unsolvable -> Nothing
toGoal p = Goal { goal = p
, goalSource = CtDefaulting
, goalRange = r
}
cryptol-2.2.6/src/Cryptol/TypeCheck/Depends.hs 0000644 0000000 0000000 00000011752 12637103426 017435 0 ustar 00 0000000 0000000 -- |
-- Module : $Header$
-- Copyright : (c) 2013-2015 Galois, Inc.
-- License : BSD3
-- Maintainer : cryptol@galois.com
-- Stability : provisional
-- Portability : portable
{-# LANGUAGE Safe #-}
module Cryptol.TypeCheck.Depends where
import qualified Cryptol.Parser.AST as P
import Cryptol.Parser.Position(Range, Located(..), thing)
import Cryptol.TypeCheck.AST(QName)
import Cryptol.Parser.Names (namesB, namesT)
import Cryptol.TypeCheck.Monad( InferM, recordError, getTVars
, Error(..))
import Data.List(sortBy, groupBy)
import Data.Function(on)
import Data.Maybe(mapMaybe)
import Data.Graph.SCC(stronglyConnComp)
import Data.Graph (SCC(..))
import Data.Map (Map)
import qualified Data.Map as Map
import qualified Data.Set as Set
data TyDecl = TS P.TySyn | NT P.Newtype
-- | Check for duplicate and recursive type synonyms.
-- Returns the type-synonyms in dependecy order.
orderTyDecls :: [TyDecl] -> InferM [TyDecl]
orderTyDecls ts =
do vs <- getTVars
ds <- combine $ map (toMap vs) ts
let ordered = mkScc [ (t,[x],deps)
| (x,(t,deps)) <- Map.toList (Map.map thing ds) ]
concat `fmap` mapM check ordered
where
toMap vs ty@(NT (P.Newtype x as fs)) =
( thing x
, x { thing = (ty, Set.toList $
Set.difference
(Set.unions (map (namesT vs . P.value) fs))
(Set.fromList (map P.tpQName as))
)
}
)
toMap vs ty@(TS (P.TySyn x as t)) =
(thing x
, x { thing = (ty, Set.toList $
Set.difference (namesT vs t)
(Set.fromList (map P.tpQName as)))
}
)
getN (TS (P.TySyn x _ _)) = x
getN (NT x) = P.nName x
check (AcyclicSCC x) = return [x]
-- We don't support any recursion, for now.
-- We could support recursion between newtypes, or newtypes and tysysn.
check (CyclicSCC xs) =
do recordError (RecursiveTypeDecls (map getN xs))
return [] -- XXX: This is likely to cause fake errors for missing
-- type synonyms. We could avoid this by, for example, checking
-- for recursive synonym errors, when looking up tycons.
-- | Associate type signatures with bindings and order bindings by dependency.
orderBinds :: [P.Bind] -> [SCC P.Bind]
orderBinds bs = mkScc [ (b, map thing defs, Set.toList uses)
| b <- bs
, let (defs,uses) = namesB b
]
class FromDecl d where
toBind :: d -> Maybe P.Bind
toTyDecl :: d -> Maybe TyDecl
isTopDecl :: d -> Bool
instance FromDecl P.TopDecl where
toBind (P.Decl x) = toBind (P.tlValue x)
toBind _ = Nothing
toTyDecl (P.TDNewtype d) = Just (NT (P.tlValue d))
toTyDecl (P.Decl x) = toTyDecl (P.tlValue x)
toTyDecl _ = Nothing
isTopDecl _ = True
instance FromDecl P.Decl where
toBind (P.DLocated d _) = toBind d
toBind (P.DBind b) = return b
toBind _ = Nothing
toTyDecl (P.DLocated d _) = toTyDecl d
toTyDecl (P.DType x) = Just (TS x)
toTyDecl _ = Nothing
isTopDecl _ = False
{- | Given a list of declarations, annoted with (i) the names that they
define, and (ii) the names that they use, we compute a list of strongly
connected components of the declarations. The SCCs are in dependency order. -}
mkScc :: [(a,[QName],[QName])] -> [SCC a]
mkScc ents = stronglyConnComp $ zipWith mkGr keys ents
where
keys = [ 0 :: Integer .. ]
mkGr i (x,_,uses) = (x,i,mapMaybe (`Map.lookup` nodeMap) uses)
-- Maps names to node ids.
nodeMap = Map.fromList $ concat $ zipWith mkNode keys ents
mkNode i (_,defs,_) = [ (d,i) | d <- defs ]
{- | Combine a bunch of definitions into a single map. Here we check
that each name is defined only onces. -}
combineMaps :: [Map QName (Located a)] -> InferM (Map QName (Located a))
combineMaps ms =
do mapM_ recordError $
do m <- ms
(x,rs) <- duplicates [ a { thing = x } | (x,a) <- Map.toList m ]
return (RepeatedDefinitions x rs)
return (Map.unions ms)
{- | Combine a bunch of definitions into a single map. Here we check
that each name is defined only onces. -}
combine :: [(QName, Located a)] -> InferM (Map QName (Located a))
combine m =
do mapM_ recordError $
do (x,rs) <- duplicates [ a { thing = x } | (x,a) <- m ]
return (RepeatedDefinitions x rs)
return (Map.fromList m)
-- | Identify multiple occurances of something.
duplicates :: Ord a => [Located a] -> [(a,[Range])]
duplicates = mapMaybe multiple
. groupBy ((==) `on` thing)
. sortBy (compare `on` thing)
where
multiple xs@(x : _ : _) = Just (thing x, map srcRange xs)
multiple _ = Nothing
cryptol-2.2.6/src/Cryptol/TypeCheck/Infer.hs 0000644 0000000 0000000 00000065302 12637103426 017116 0 ustar 00 0000000 0000000 -- |
-- Module : $Header$
-- Copyright : (c) 2013-2015 Galois, Inc.
-- License : BSD3
-- Maintainer : cryptol@galois.com
-- Stability : provisional
-- Portability : portable
--
-- Assumes that the `NoPat` pass has been run.
{-# LANGUAGE CPP #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE ViewPatterns #-}
#if __GLASGOW_HASKELL__ >= 706
{-# LANGUAGE RecursiveDo #-}
#else
{-# LANGUAGE DoRec, RecursiveDo #-}
#endif
{-# LANGUAGE Safe #-}
module Cryptol.TypeCheck.Infer where
import Cryptol.Prims.Syntax(ECon(..))
import Cryptol.Prims.Types(typeOf)
import Cryptol.Parser.Position
import qualified Cryptol.Parser.AST as P
import qualified Cryptol.Parser.Names as P
import Cryptol.TypeCheck.AST
import Cryptol.TypeCheck.Monad
import Cryptol.TypeCheck.Solve
import Cryptol.TypeCheck.Kind(checkType,checkSchema,checkTySyn,
checkNewtype)
import Cryptol.TypeCheck.Instantiate
import Cryptol.TypeCheck.Depends
import Cryptol.TypeCheck.Subst (listSubst,apSubst,fvs,(@@))
import Cryptol.TypeCheck.Solver.FinOrd(noFacts,OrdFacts)
import Cryptol.TypeCheck.Solver.Eval(simpType)
import Cryptol.TypeCheck.Solver.InfNat(genLog)
import Cryptol.TypeCheck.Defaulting(tryDefault)
import Cryptol.Utils.Panic(panic)
import Cryptol.Utils.PP
import qualified Data.Map as Map
import Data.Map (Map)
import qualified Data.Set as Set
import Data.Either(partitionEithers)
import Data.Maybe(mapMaybe,isJust)
import Data.List(partition,find)
import Data.Graph(SCC(..))
import Data.Traversable(forM)
import Control.Monad(when,zipWithM)
-- import Cryptol.Utils.Debug
inferModule :: P.Module -> InferM Module
inferModule m =
inferDs (P.mDecls m) $ \ds1 ->
do simplifyAllConstraints
ts <- getTSyns
nts <- getNewtypes
return Module { mName = thing (P.mName m)
, mExports = P.modExports m
, mImports = map thing (P.mImports m)
, mTySyns = Map.mapMaybe onlyLocal ts
, mNewtypes = Map.mapMaybe onlyLocal nts
, mDecls = ds1
}
where
onlyLocal (IsLocal, x) = Just x
onlyLocal (IsExternal, _) = Nothing
desugarLiteral :: Bool -> P.Literal -> InferM P.Expr
desugarLiteral fixDec lit =
do l <- curRange
let named (x,y) = P.NamedInst
P.Named { name = Located l (Name x), value = P.TNum y }
demote fs = P.EAppT (P.ECon ECDemote) (map named fs)
return $ case lit of
P.ECNum num info ->
demote $ [ ("val", num) ] ++ case info of
P.BinLit n -> [ ("bits", 1 * toInteger n) ]
P.OctLit n -> [ ("bits", 3 * toInteger n) ]
P.HexLit n -> [ ("bits", 4 * toInteger n) ]
P.CharLit -> [ ("bits", 8 :: Integer) ]
P.DecLit
| fixDec -> if num == 0
then [ ("bits", 0)]
else case genLog num 2 of
Just (x,_) -> [ ("bits", x + 1) ]
_ -> []
| otherwise -> [ ]
P.PolyLit _n -> [ ]
P.ECString s ->
P.ETyped (P.EList [ P.ELit (P.ECNum (fromIntegral (fromEnum c))
P.CharLit) | c <- s ])
(P.TSeq P.TWild (P.TSeq (P.TNum 8) P.TBit))
-- | Infer the type of an expression with an explicit instantiation.
appTys :: P.Expr -> [Located (Maybe QName,Type)] -> Type -> InferM Expr
appTys expr ts tGoal =
case expr of
P.EVar x ->
do res <- lookupVar x
(e',t) <- case res of
ExtVar s -> instantiateWith (EVar x) s ts
CurSCC e t -> instantiateWith e (Forall [] [] t) ts
checkHasType e' t tGoal
P.ELit l -> do e <- desugarLiteral False l
appTys e ts tGoal
P.ECon ec -> do let s1 = typeOf ec
(e',t) <- instantiateWith (ECon ec) s1 ts
checkHasType e' t tGoal
P.EAppT e fs ->
do ps <- mapM inferTyParam fs
appTys e (ps ++ ts) tGoal
-- Here is an example of why this might be useful:
-- f ` { x = T } where type T = ...
P.EWhere e ds ->
inferDs ds $ \ds1 -> do e1 <- appTys e ts tGoal
return (EWhere e1 ds1)
-- XXX: Is there a scoping issue here? I think not, but check.
P.ELocated e r ->
inRange r (appTys e ts tGoal)
P.ETuple {} -> mono
P.ERecord {} -> mono
P.ESel {} -> mono
P.EList {} -> mono
P.EFromTo {} -> mono
P.EInfFrom {} -> mono
P.EComp {} -> mono
P.EApp {} -> mono
P.EIf {} -> mono
P.ETyped {} -> mono
P.ETypeVal {} -> mono
P.EFun {} -> mono
where mono = do e' <- checkE expr tGoal
(ie,t) <- instantiateWith e' (Forall [] [] tGoal) ts
-- XXX seems weird to need to do this, as t should be the same
-- as tGoal
checkHasType ie t tGoal
inferTyParam :: P.TypeInst -> InferM (Located (Maybe QName, Type))
inferTyParam (P.NamedInst param) =
do let loc = srcRange (P.name param)
t <- inRange loc $ checkType (P.value param) Nothing
return $ Located loc (Just (mkUnqual (thing (P.name param))), t)
inferTyParam (P.PosInst param) =
do t <- checkType param Nothing
rng <- case getLoc param of
Nothing -> curRange
Just r -> return r
return Located { srcRange = rng, thing = (Nothing, t) }
checkTypeOfKind :: P.Type -> Kind -> InferM Type
checkTypeOfKind ty k = checkType ty (Just k)
-- | We use this when we want to ensure that the expr has exactly
-- (syntactically) the given type.
inferE :: Doc -> P.Expr -> InferM (Expr, Type)
inferE desc expr =
do t <- newType desc KType
e1 <- checkE expr t
return (e1,t)
-- | Infer the type of an expression, and translate it to a fully elaborated
-- core term.
checkE :: P.Expr -> Type -> InferM Expr
checkE expr tGoal =
case expr of
P.EVar x ->
do res <- lookupVar x
(e',t) <- case res of
ExtVar s -> instantiateWith (EVar x) s []
CurSCC e t -> return (e, t)
checkHasType e' t tGoal
P.ELit l -> (`checkE` tGoal) =<< desugarLiteral False l
P.ECon ec ->
do let s1 = typeOf ec
(e',t) <- instantiateWith (ECon ec) s1 []
checkHasType e' t tGoal
P.ETuple es ->
do etys <- expectTuple (length es) tGoal
es' <- zipWithM checkE es etys
return (ETuple es')
P.ERecord fs ->
do (ns,es,ts) <- unzip3 `fmap` expectRec fs tGoal
es' <- zipWithM checkE es ts
return (ERec (zip ns es'))
P.ESel e l ->
do let src = case l of
RecordSel _ _ -> text "type of record"
TupleSel _ _ -> text "type of tuple"
ListSel _ _ -> text "type of sequence"
(e',t) <- inferE src e
f <- newHasGoal l t tGoal
return (f e')
P.EList [] ->
do (len,a) <- expectSeq tGoal
expectFin 0 len
return (EList [] a)
P.EList es ->
do (len,a) <- expectSeq tGoal
expectFin (length es) len
es' <- mapM (`checkE` a) es
return (EList es' a)
P.EFromTo t1 Nothing Nothing ->
do rng <- curRange
bit <- newType (text "bit-width of enumeration sequnce") KNum
fstT <- checkTypeOfKind t1 KNum
let totLen = tNum (2::Int) .^. bit
lstT = totLen .-. tNum (1::Int)
appTys (P.ECon ECFromTo)
[ Located rng (Just (mkUnqual (Name x)), y)
| (x,y) <- [ ("first",fstT), ("last", lstT), ("bits", bit) ]
] tGoal
P.EFromTo t1 mbt2 mbt3 ->
do l <- curRange
let (c,fs) =
case (mbt2, mbt3) of
(Nothing, Nothing) -> tcPanic "checkE"
[ "EFromTo _ Nothing Nothing" ]
(Just t2, Nothing) ->
(ECFromThen, [ ("next", t2) ])
(Nothing, Just t3) ->
(ECFromTo, [ ("last", t3) ])
(Just t2, Just t3) ->
(ECFromThenTo, [ ("next",t2), ("last",t3) ])
let e' = P.EAppT (P.ECon c)
[ P.NamedInst P.Named { name = Located l (Name x), value = y }
| (x,y) <- ("first",t1) : fs
]
checkE e' tGoal
P.EInfFrom e1 Nothing ->
checkE (P.EApp (P.ECon ECInfFrom) e1) tGoal
P.EInfFrom e1 (Just e2) ->
checkE (P.EApp (P.EApp (P.ECon ECInfFromThen) e1) e2) tGoal
P.EComp e mss ->
do (mss', dss, ts) <- unzip3 `fmap` zipWithM inferCArm [ 1 .. ] mss
(len,a)<- expectSeq tGoal
newGoals CtComprehension =<< unify len =<< smallest ts
ds <- combineMaps dss
e' <- withMonoTypes ds (checkE e a)
return (EComp tGoal e' mss')
P.EAppT e fs ->
do ts <- mapM inferTyParam fs
appTys e ts tGoal
P.EApp fun@(dropLoc -> P.EApp (dropLoc -> P.ECon c) _)
arg@(dropLoc -> P.ELit l)
| c `elem` [ ECShiftL, ECShiftR, ECRotL, ECRotR, ECAt, ECAtBack ] ->
do newArg <- do l1 <- desugarLiteral True l
return $ case arg of
P.ELocated _ pos -> P.ELocated l1 pos
_ -> l1
checkE (P.EApp fun newArg) tGoal
P.EApp e1 e2 ->
do t1 <- newType (text "argument to function") KType
e1' <- checkE e1 (tFun t1 tGoal)
e2' <- checkE e2 t1
return (EApp e1' e2')
P.EIf e1 e2 e3 ->
do e1' <- checkE e1 tBit
e2' <- checkE e2 tGoal
e3' <- checkE e3 tGoal
return (EIf e1' e2' e3')
P.EWhere e ds ->
inferDs ds $ \ds1 -> do e1 <- checkE e tGoal
return (EWhere e1 ds1)
P.ETyped e t ->
do tSig <- checkTypeOfKind t KType
e' <- checkE e tSig
checkHasType e' tSig tGoal
P.ETypeVal t ->
do l <- curRange
checkE (P.EAppT (P.ECon ECDemote)
[P.NamedInst
P.Named { name = Located l (Name "val"), value = t }]) tGoal
P.EFun ps e -> checkFun (text "anonymous function") ps e tGoal
P.ELocated e r -> inRange r (checkE e tGoal)
expectSeq :: Type -> InferM (Type,Type)
expectSeq ty =
case ty of
TUser _ _ ty' ->
expectSeq ty'
TCon (TC TCSeq) [a,b] ->
return (a,b)
TVar _ ->
do tys@(a,b) <- genTys
newGoals CtExactType =<< unify (tSeq a b) ty
return tys
_ ->
do tys@(a,b) <- genTys
recordError (TypeMismatch (tSeq a b) ty)
return tys
where
genTys =
do a <- newType (text "size of the sequence") KNum
b <- newType (text "type of sequence elements") KType
return (a,b)
expectTuple :: Int -> Type -> InferM [Type]
expectTuple n ty =
case ty of
TUser _ _ ty' ->
expectTuple n ty'
TCon (TC (TCTuple n')) tys | n == n' ->
return tys
TVar _ ->
do tys <- genTys
newGoals CtExactType =<< unify (tTuple tys) ty
return tys
_ ->
do tys <- genTys
recordError (TypeMismatch (tTuple tys) ty)
return tys
where
genTys =forM [ 0 .. n - 1 ] $ \ i ->
let desc = text "type of"
<+> ordinal i
<+> text "tuple field"
in newType desc KType
expectRec :: [P.Named a] -> Type -> InferM [(Name,a,Type)]
expectRec fs ty =
case ty of
TUser _ _ ty' ->
expectRec fs ty'
TRec ls | Just tys <- mapM checkField ls ->
return tys
_ ->
do (tys,res) <- genTys
case ty of
TVar TVFree{} -> do ps <- unify (TRec tys) ty
newGoals CtExactType ps
_ -> recordError (TypeMismatch (TRec tys) ty)
return res
where
checkField (n,t) =
do f <- find (\f -> thing (P.name f) == n) fs
return (thing (P.name f), P.value f, t)
genTys =
do res <- forM fs $ \ f ->
do let field = thing (P.name f)
t <- newType (text "type of field" <+> quotes (pp field)) KType
return (field, P.value f, t)
let (ls,_,ts) = unzip3 res
return (zip ls ts, res)
expectFin :: Int -> Type -> InferM ()
expectFin n ty =
case ty of
TUser _ _ ty' ->
expectFin n ty'
TCon (TC (TCNum n')) [] | toInteger n == n' ->
return ()
TVar TVFree{} ->
do newGoals CtExactType =<< unify (tNum n) ty
_ ->
recordError (TypeMismatch (tNum n) ty)
expectFun :: Int -> Type -> InferM ([Type],Type)
expectFun = go []
where
go tys arity ty
| arity > 0 =
case ty of
TUser _ _ ty' ->
go tys arity ty'
TCon (TC TCFun) [a,b] ->
go (a:tys) (arity - 1) b
_ ->
do args <- genArgs arity
res <- newType (text "result of function") KType
case ty of
TVar TVFree{} -> do ps <- unify (foldr tFun res args) ty
newGoals CtExactType ps
_ -> recordError (TypeMismatch (foldr tFun res args) ty)
return (reverse tys ++ args, res)
| otherwise =
return (reverse tys, ty)
genArgs arity = forM [ 1 .. arity ] $ \ ix ->
newType (text "argument" <+> ordinal ix) KType
checkHasType :: Expr -> Type -> Type -> InferM Expr
checkHasType e inferredType givenType =
do ps <- unify givenType inferredType
case ps of
[] -> return e
_ -> newGoals CtExactType ps >> return (ECast e givenType)
checkFun :: Doc -> [P.Pattern] -> P.Expr -> Type -> InferM Expr
checkFun _ [] e tGoal = checkE e tGoal
checkFun desc ps e tGoal =
inNewScope $
do let descs = [ text "type of" <+> ordinal n <+> text "argument"
<+> text "of" <+> desc | n <- [ 1 :: Int .. ] ]
(tys,tRes) <- expectFun (length ps) tGoal
largs <- sequence (zipWith3 checkP descs ps tys)
let ds = Map.fromList [ (thing x, x { thing = t }) | (x,t) <- zip largs tys ]
e1 <- withMonoTypes ds (checkE e tRes)
let args = [ (thing x, t) | (x,t) <- zip largs tys ]
return (foldr (\(x,t) b -> EAbs x t b) e1 args)
{-| The type the is the smallest of all -}
smallest :: [Type] -> InferM Type
smallest [] = newType (text "length of list comprehension") KNum
smallest [t] = return t
smallest ts = do a <- newType (text "length of list comprehension") KNum
newGoals CtComprehension [ a =#= foldr1 tMin ts ]
return a
checkP :: Doc -> P.Pattern -> Type -> InferM (Located QName)
checkP desc p tGoal =
do (x, t) <- inferP desc p
ps <- unify tGoal (thing t)
case ps of
[] -> return (Located (srcRange t) x)
_ -> tcPanic "checkP" [ "Unexpected constraints:", show ps ]
{-| Infer the type of a pattern. Assumes that the pattern will be just
a variable. -}
inferP :: Doc -> P.Pattern -> InferM (QName, Located Type)
inferP desc pat =
case pat of
P.PVar x0 ->
do a <- newType desc KType
let x = thing x0
return (mkUnqual x, x0 { thing = a })
P.PTyped p t ->
do tSig <- checkTypeOfKind t KType
ln <- checkP desc p tSig
return (thing ln, ln { thing = tSig })
_ -> tcPanic "inferP" [ "Unexpected pattern:", show pat ]
-- | Infer the type of one match in a list comprehension.
inferMatch :: P.Match -> InferM (Match, QName, Located Type, Type)
inferMatch (P.Match p e) =
do (x,t) <- inferP (text "XXX:MATCH") p
n <- newType (text "sequence length of comprehension match") KNum
e' <- checkE e (tSeq n (thing t))
return (From x (thing t) e', x, t, n)
inferMatch (P.MatchLet b)
| P.bMono b =
do a <- newType (text "`let` binding in comprehension") KType
b1 <- checkMonoB b a
return (Let b1, dName b1, Located (srcRange (P.bName b)) a, tNum (1::Int))
| otherwise = tcPanic "inferMatch"
[ "Unexpected polymorphic match let:", show b ]
-- | Infer the type of one arm of a list comprehension.
inferCArm :: Int -> [P.Match] -> InferM
( [Match]
, Map QName (Located Type)-- defined vars
, Type -- length of sequence
)
inferCArm _ [] = do n <- newType (text "lenght of empty comprehension") KNum
-- shouldn't really happen
return ([], Map.empty, n)
inferCArm _ [m] =
do (m1, x, t, n) <- inferMatch m
return ([m1], Map.singleton x t, n)
inferCArm armNum (m : ms) =
do (m1, x, t, n) <- inferMatch m
(ms', ds, n') <- withMonoType (x,t) (inferCArm armNum ms)
-- XXX: Well, this is just the lenght of this sub-sequence
let src = text "length of" <+> ordinal armNum <+>
text "arm of list comprehension"
sz <- newType src KNum
newGoals CtComprehension [ sz =#= (n .*. n') ]
return (m1 : ms', Map.insertWith (\_ old -> old) x t ds, sz)
-- | @inferBinds isTopLevel isRec binds@ performs inference for a
-- strongly-connected component of 'P.Bind's. If @isTopLevel@ is true,
-- any bindings without type signatures will be generalized. If it is
-- false, and the mono-binds flag is enabled, no bindings without type
-- signatures will be generalized, but bindings with signatures will
-- be unaffected.
inferBinds :: Bool -> Bool -> [P.Bind] -> InferM [Decl]
inferBinds isTopLevel isRec binds =
mdo let exprMap = Map.fromList [ (x,inst (EVar x) (dDefinition b))
| b <- genBs, let x = dName b ] -- REC.
inst e (ETAbs x e1) = inst (ETApp e (TVar (tpVar x))) e1
inst e (EProofAbs _ e1) = inst (EProofApp e) e1
inst e _ = e
-- when mono-binds is enabled, and we're not checking top-level
-- declarations, mark all bindings lacking signatures as monomorphic
monoBinds <- getMonoBinds
let binds' | monoBinds && not isTopLevel = sigs ++ monos
| otherwise = binds
(sigs,noSigs) = partition (isJust . P.bSignature) binds
monos = [ b { P.bMono = True } | b <- noSigs ]
((doneBs, genCandidates), cs) <-
collectGoals $
{- Guess type is here, because while we check user supplied signatures
we may generate additional constraints. For example, `x - y` would
generate an additional constraint `x >= y`. -}
do (newEnv,todos) <- unzip `fmap` mapM (guessType exprMap) binds'
let extEnv = if isRec then withVarTypes newEnv else id
extEnv $
do let (sigsAndMonos,noSigGen) = partitionEithers todos
genCs <- sequence noSigGen
done <- sequence sigsAndMonos
simplifyAllConstraints
return (done, genCs)
genBs <- generalize genCandidates cs -- RECURSION
return (doneBs ++ genBs)
{- | Come up with a type for recursive calls to a function, and decide
how we are going to be checking the binding.
Returns: (Name, type or schema, computation to check binding)
The `exprMap` is a thunk where we can lookup the final expressions
and we should be careful not to force it.
-}
guessType :: Map QName Expr -> P.Bind ->
InferM ( (QName, VarType)
, Either (InferM Decl) -- no generalization
(InferM Decl) -- generalize these
)
guessType exprMap b@(P.Bind { .. }) =
case bSignature of
Just s ->
do s1 <- checkSchema s
return ((name, ExtVar (fst s1)), Left (checkSigB b s1))
Nothing
| bMono ->
do t <- newType (text "defintion of" <+> quotes (pp name)) KType
let schema = Forall [] [] t
return ((name, ExtVar schema), Left (checkMonoB b t))
| otherwise ->
do t <- newType (text "definition of" <+> quotes (pp name)) KType
let noWay = tcPanic "guessType" [ "Missing expression for:" ,
show name ]
expr = Map.findWithDefault noWay name exprMap
return ((name, CurSCC expr t), Right (checkMonoB b t))
where
name = thing bName
-- | Try to evaluate the inferred type of a mono-binding
simpMonoBind :: OrdFacts -> Decl -> Decl
simpMonoBind m d =
case dSignature d of
Forall [] [] t ->
let t1 = simpType m t
in if t == t1 then d else d { dSignature = Forall [] [] t1
, dDefinition = ECast (dDefinition d) t1
}
_ -> d
-- | The inputs should be declarations with monomorphic types
-- (i.e., of the form `Forall [] [] t`).
generalize :: [Decl] -> [Goal] -> InferM [Decl]
{- This may happen because we have monomorphic bindings.
In this case we may get some goal, due to the monomorphic bindings,
but the group of components is empty. -}
generalize [] gs0 =
do addGoals gs0
return []
generalize bs0 gs0 =
do gs <- forM gs0 $ \g -> applySubst g
-- XXX: Why would these bindings have signatures??
bs1 <- forM bs0 $ \b -> do s <- applySubst (dSignature b)
return b { dSignature = s }
ordM <- case assumedOrderModel noFacts (map goal gs) of
Left (ordModel,p) ->
do mapM_ recordError
[ UnusableFunction n p | n <- map dName bs1]
return ordModel
Right (ordModel,_) -> return ordModel
let bs = map (simpMonoBind ordM) bs1
let goalFVS g = Set.filter isFreeTV $ fvs $ goal g
inGoals = Set.unions $ map goalFVS gs
inSigs = Set.filter isFreeTV $ fvs $ map dSignature bs
candidates = Set.union inGoals inSigs
asmpVs <- varsWithAsmps
let gen0 = Set.difference candidates asmpVs
stays g = any (`Set.member` gen0) $ Set.toList $ goalFVS g
(here0,later) = partition stays gs
-- Figure our what might be ambigious
let (maybeAmbig, ambig) = partition ((KNum ==) . kindOf)
$ Set.toList
$ Set.difference gen0 inSigs
when (not (null ambig)) $ recordError $ AmbiguousType $ map dName bs
let (as0,here1,defSu,ws) = tryDefault maybeAmbig here0
mapM_ recordWarning ws
let here = map goal here1
let as = as0 ++ Set.toList (Set.difference inSigs asmpVs)
asPs = [ TParam { tpUnique = x, tpKind = k, tpName = Nothing }
| TVFree x k _ _ <- as ]
totSu <- getSubst
let
su = listSubst (zip as (map (TVar . tpVar) asPs)) @@ defSu @@ totSu
qs = map (apSubst su) here
genE e = foldr ETAbs (foldr EProofAbs (apSubst su e) qs) asPs
genB d = d { dDefinition = genE (dDefinition d)
, dSignature = Forall asPs qs
$ apSubst su $ sType $ dSignature d
}
addGoals later
return (map genB bs)
checkMonoB :: P.Bind -> Type -> InferM Decl
checkMonoB b t =
inRangeMb (getLoc b) $
do e1 <- checkFun (pp (thing (P.bName b))) (P.bParams b) (P.bDef b) t
let f = thing (P.bName b)
return Decl { dName = f
, dSignature = Forall [] [] t
, dDefinition = e1
, dPragmas = P.bPragmas b
}
-- XXX: Do we really need to do the defaulting business in two different places?
checkSigB :: P.Bind -> (Schema,[Goal]) -> InferM Decl
checkSigB b (Forall as asmps0 t0, validSchema) =
inRangeMb (getLoc b) $
withTParams as $
do (e1,cs0) <- collectGoals $
do e1 <- checkFun (pp (thing (P.bName b))) (P.bParams b) (P.bDef b) t0
() <- simplifyAllConstraints -- XXX: using `asmps` also...
return e1
cs <- applySubst cs0
let letGo qs c = Set.null (qs `Set.intersection` fvs (goal c))
splitPreds qs n ps =
let (l,n1) = partition (letGo qs) ps
in if null n1
then (l,n)
else splitPreds (fvs (map goal n1) `Set.union` qs) (n1 ++ n) l
(later0,now) = splitPreds (Set.fromList (map tpVar as)) [] cs
asmps1 <- applySubst asmps0
defSu1 <- proveImplication (P.bName b) as asmps1 (validSchema ++ now)
let later = apSubst defSu1 later0
asmps = apSubst defSu1 asmps1
-- Now we check for any remaining variables that are not mentioned
-- in the environment. The plan is to try to default these to something
-- reasonable.
do let laterVs = fvs (map goal later)
asmpVs <- varsWithAsmps
let genVs = laterVs `Set.difference` asmpVs
(maybeAmbig,ambig) = partition ((== KNum) . kindOf)
(Set.toList genVs)
when (not (null ambig)) $ recordError
$ AmbiguousType [ thing (P.bName b) ]
let (_,_,defSu2,ws) = tryDefault maybeAmbig later
mapM_ recordWarning ws
extendSubst defSu2
addGoals later
su <- getSubst
let su' = defSu1 @@ su
t = apSubst su' t0
e2 = apSubst su' e1
return Decl
{ dName = thing (P.bName b)
, dSignature = Forall as asmps t
, dDefinition = foldr ETAbs (foldr EProofAbs e2 asmps) as
, dPragmas = P.bPragmas b
}
inferDs :: FromDecl d => [d] -> ([DeclGroup] -> InferM a) -> InferM a
inferDs ds continue = checkTyDecls =<< orderTyDecls (mapMaybe toTyDecl ds)
where
isTopLevel = isTopDecl (head ds)
checkTyDecls (TS t : ts) =
do t1 <- checkTySyn t
withTySyn t1 (checkTyDecls ts)
checkTyDecls (NT t : ts) =
do t1 <- checkNewtype t
withNewtype t1 (checkTyDecls ts)
-- We checked all type synonyms, now continue with value-level definitions:
checkTyDecls [] = checkBinds [] $ orderBinds $ mapMaybe toBind ds
checkBinds decls (CyclicSCC bs : more) =
do bs1 <- inferBinds isTopLevel True bs
foldr (\b m -> withVar (dName b) (dSignature b) m)
(checkBinds (Recursive bs1 : decls) more)
bs1
checkBinds decls (AcyclicSCC c : more) =
do [b] <- inferBinds isTopLevel False [c]
withVar (dName b) (dSignature b) $
checkBinds (NonRecursive b : decls) more
-- We are done with all value-level definitions.
-- Now continue with anything that's in scope of the declarations.
checkBinds decls [] = continue (reverse decls)
tcPanic :: String -> [String] -> a
tcPanic l msg = panic ("[TypeCheck] " ++ l) msg
cryptol-2.2.6/src/Cryptol/TypeCheck/InferTypes.hs 0000644 0000000 0000000 00000044503 12637103426 020143 0 ustar 00 0000000 0000000 -- |
-- Module : $Header$
-- Copyright : (c) 2013-2015 Galois, Inc.
-- License : BSD3
-- Maintainer : cryptol@galois.com
-- Stability : provisional
-- Portability : portable
--
-- This module contains types used during type inference.
{-# LANGUAGE Safe #-}
{-# LANGUAGE FlexibleInstances, FlexibleContexts #-}
module Cryptol.TypeCheck.InferTypes where
import Cryptol.TypeCheck.AST
import Cryptol.TypeCheck.Subst
import Cryptol.TypeCheck.TypeMap
import Cryptol.Parser.Position
import qualified Cryptol.Parser.AST as P
import Cryptol.Parser.AST(LQName)
import Cryptol.Prims.Syntax(ECon(..))
import Cryptol.Utils.PP
import Cryptol.TypeCheck.PP
import Cryptol.Utils.Panic(panic)
import qualified Data.Set as Set
import qualified Data.Map as Map
import qualified Data.IntMap as IntMap
-- | The types of variables in the environment.
data VarType = ExtVar Schema -- ^ Known type
| CurSCC Expr Type -- ^ Part of current SCC
newtype Goals = Goals (TypeMap Goal)
deriving (Show)
emptyGoals :: Goals
emptyGoals = Goals emptyTM
nullGoals :: Goals -> Bool
nullGoals (Goals tm) = nullTM tm
fromGoals :: Goals -> [Goal]
fromGoals (Goals tm) = membersTM tm
insertGoal :: Goal -> Goals -> Goals
insertGoal g (Goals tm) = Goals (insertTM (goal g) g tm)
-- | Something that we need to find evidence for.
data Goal = Goal
{ goalSource :: ConstraintSource -- ^ With it is about
, goalRange :: Range -- ^ Part of source code that caused goal
, goal :: Prop -- ^ What needs to be proved
} deriving Show
data HasGoal = HasGoal
{ hasName :: !Int
, hasGoal :: Goal
} deriving Show
-- | Delayed implication constraints, arising from user-specified type sigs.
data DelayedCt = DelayedCt
{ dctSource :: LQName -- ^ Signature that gave rise to this constraint
, dctForall :: [TParam]
, dctAsmps :: [Prop]
, dctGoals :: [Goal]
} deriving Show
data Solved = Solved (Maybe Subst) [Goal] -- ^ Solved, assumeing the sub-goals.
| Unsolved -- ^ We could not solved the goal.
| Unsolvable -- ^ The goal can never be solved
deriving (Show)
data Warning = DefaultingKind P.TParam P.Kind
| DefaultingWildType P.Kind
| DefaultingTo Doc Type
deriving Show
-- | Various errors that might happen during type checking/inference
data Error = ErrorMsg Doc
-- ^ Just say this
| KindMismatch Kind Kind
-- ^ Expected kind, inferred kind
| TooManyTypeParams Int Kind
-- ^ Number of extra parameters, kind of resut
-- (which should not be of the form @_ -> _@)
| TooManyTySynParams QName Int
-- ^ Type-synonym, number of extra params
| TooFewTySynParams QName Int
-- ^ Type-synonym, number of missing params
| RepeatedTyParams [P.TParam]
-- ^ Type parameters with the same name (in definition)
| RepeatedDefinitions QName [Range]
-- ^ Multiple definitions for the same name
| RecursiveTypeDecls [LQName]
-- ^ The type synonym declarations are recursive
| UndefinedTypeSynonym QName
-- ^ Use of a type synonym that was not defined
| UndefinedVariable QName
-- ^ Use of a variable that was not defined
| UndefinedTypeParam QName
-- ^ Attempt to explicitly instantiate a non-existent param.
| MultipleTypeParamDefs QName [Range]
-- ^ Multiple definitions for the same type parameter
| TypeMismatch Type Type
-- ^ Expected type, inferred type
| RecursiveType Type Type
-- ^ Unification results in a recursive type
| UnsolvedGoal Goal
-- ^ A constraint that we could not solve
| UnsolvedDelcayedCt DelayedCt
-- ^ A constraint (with context) that we could not solve
| UnexpectedTypeWildCard
-- ^ Type wild cards are not allowed in this context
-- (e.g., definitions of type synonyms).
| TypeVariableEscaped Type [TVar]
-- ^ Unification variable depends on quantified variables
-- that are not in scope.
| NotForAll TVar Type
-- ^ Quantified type variables (of kind *) needs to
-- match the given type, so it does not work for all types.
| UnusableFunction QName Prop
-- ^ The given constraint causes the signature of the
-- function to be not-satisfiable.
| TooManyPositionalTypeParams
-- ^ Too many positional type arguments, in an explicit
-- type instantiation
| CannotMixPositionalAndNamedTypeParams
| AmbiguousType [QName]
deriving Show
-- | Information about how a constraint came to be, used in error reporting.
data ConstraintSource
= CtComprehension -- ^ Computing shape of list comprehension
| CtSplitPat -- ^ Use of a split pattern
| CtTypeSig -- ^ A type signature in a pattern or expression
| CtInst Expr -- ^ Instantiation of this expreesion
| CtSelector
| CtExactType
| CtEnumeration
| CtDefaulting -- ^ Just defaulting on the command line
| CtPartialTypeFun TyFunName -- ^ Use of a partial type function.
deriving Show
data TyFunName = UserTyFun QName | BuiltInTyFun TFun
deriving Show
instance PP TyFunName where
ppPrec c (UserTyFun x) = ppPrec c x
ppPrec c (BuiltInTyFun x) = ppPrec c x
instance TVars ConstraintSource where
apSubst su src =
case src of
CtComprehension -> src
CtSplitPat -> src
CtTypeSig -> src
CtInst e -> CtInst (apSubst su e)
CtSelector -> src
CtExactType -> src
CtEnumeration -> src
CtDefaulting -> src
CtPartialTypeFun _ -> src
instance TVars Warning where
apSubst su warn =
case warn of
DefaultingKind {} -> warn
DefaultingWildType {} -> warn
DefaultingTo d ty -> DefaultingTo d (apSubst su ty)
instance FVS Warning where
fvs warn =
case warn of
DefaultingKind {} -> Set.empty
DefaultingWildType {} -> Set.empty
DefaultingTo _ ty -> fvs ty
instance TVars Error where
apSubst su err =
case err of
ErrorMsg _ -> err
KindMismatch {} -> err
TooManyTypeParams {} -> err
TooManyTySynParams {} -> err
TooFewTySynParams {} -> err
RepeatedTyParams {} -> err
RepeatedDefinitions {} -> err
RecursiveTypeDecls {} -> err
UndefinedTypeSynonym {} -> err
UndefinedVariable {} -> err
UndefinedTypeParam {} -> err
MultipleTypeParamDefs {} -> err
TypeMismatch t1 t2 -> TypeMismatch (apSubst su t1) (apSubst su t2)
RecursiveType t1 t2 -> RecursiveType (apSubst su t1) (apSubst su t2)
UnsolvedGoal g -> UnsolvedGoal (apSubst su g)
UnsolvedDelcayedCt g -> UnsolvedDelcayedCt (apSubst su g)
UnexpectedTypeWildCard -> err
TypeVariableEscaped t xs -> TypeVariableEscaped (apSubst su t) xs
NotForAll x t -> NotForAll x (apSubst su t)
UnusableFunction f p -> UnusableFunction f (apSubst su p)
TooManyPositionalTypeParams -> err
CannotMixPositionalAndNamedTypeParams -> err
AmbiguousType _ -> err
instance FVS Error where
fvs err =
case err of
ErrorMsg {} -> Set.empty
KindMismatch {} -> Set.empty
TooManyTypeParams {} -> Set.empty
TooManyTySynParams {} -> Set.empty
TooFewTySynParams {} -> Set.empty
RepeatedTyParams {} -> Set.empty
RepeatedDefinitions {} -> Set.empty
RecursiveTypeDecls {} -> Set.empty
UndefinedTypeSynonym {} -> Set.empty
UndefinedVariable {} -> Set.empty
UndefinedTypeParam {} -> Set.empty
MultipleTypeParamDefs {} -> Set.empty
TypeMismatch t1 t2 -> fvs (t1,t2)
RecursiveType t1 t2 -> fvs (t1,t2)
UnsolvedGoal g -> fvs g
UnsolvedDelcayedCt g -> fvs g
UnexpectedTypeWildCard -> Set.empty
TypeVariableEscaped t _ -> fvs t
NotForAll _ t -> fvs t
UnusableFunction _ p -> fvs p
TooManyPositionalTypeParams -> Set.empty
CannotMixPositionalAndNamedTypeParams -> Set.empty
AmbiguousType _ -> Set.empty
instance FVS Goal where
fvs g = fvs (goal g)
instance FVS DelayedCt where
fvs d = fvs (dctAsmps d, dctGoals d) `Set.difference`
Set.fromList (map tpVar (dctForall d))
-- This first applies the substitution to the keys of the goal map, then to the
-- values that remain, as applying the substitution to the keys will only ever
-- reduce the number of values that remain.
instance TVars Goals where
apSubst su (Goals goals) =
Goals (mapWithKeyTM setGoal (apSubstTypeMapKeys su goals))
where
-- as the key for the goal map is the same as the goal, and the substitution
-- has been applied to the key already, just replace the existing goal with
-- the key.
setGoal key g = g { goalSource = apSubst su (goalSource g)
, goal = key
}
instance TVars Goal where
apSubst su g = Goal { goalSource = apSubst su (goalSource g)
, goalRange = goalRange g
, goal = apSubst su (goal g)
}
instance TVars HasGoal where
apSubst su h = h { hasGoal = apSubst su (hasGoal h) }
instance TVars DelayedCt where
apSubst su g
| Set.null captured =
DelayedCt { dctSource = dctSource g
, dctForall = dctForall g
, dctAsmps = apSubst su1 (dctAsmps g)
, dctGoals = apSubst su1 (dctGoals g)
}
| otherwise = panic "Cryptol.TypeCheck.Subst.apSubst (DelayedCt)"
[ "Captured quantified variables:"
, "Substitution: " ++ show m1
, "Variables: " ++ show captured
, "Constraint: " ++ show g
]
where
used = fvs (dctAsmps g, map goal (dctGoals g)) `Set.difference`
Set.fromList (map tpVar (dctForall g))
m1 = Map.filterWithKey (\k _ -> k `Set.member` used) (suMap su)
su1 = S { suMap = m1, suDefaulting = suDefaulting su }
captured = Set.fromList (map tpVar (dctForall g)) `Set.intersection`
fvs (Map.elems m1)
-- | For use in error messages
cppKind :: Kind -> Doc
cppKind ki =
case ki of
KNum -> text "a numeric type"
KType -> text "a value type"
KProp -> text "a constraint"
_ -> pp ki
addTVarsDescs :: FVS t => NameMap -> t -> Doc -> Doc
addTVarsDescs nm t d
| Set.null vs = d
| otherwise = d $$ text "where" $$ vcat (map desc (Set.toList vs))
where
vs = Set.filter isFreeTV (fvs t)
desc v@(TVFree _ _ _ x) = ppWithNames nm v <+> text "is" <+> x
desc (TVBound {}) = empty
instance PP Warning where
ppPrec = ppWithNamesPrec IntMap.empty
instance PP Error where
ppPrec = ppWithNamesPrec IntMap.empty
instance PP (WithNames Warning) where
ppPrec _ (WithNames warn names) =
addTVarsDescs names warn $
case warn of
DefaultingKind x k ->
text "Assuming " <+> pp x <+> text "to have" <+> P.cppKind k
DefaultingWildType k ->
text "Assuming _ to have" <+> P.cppKind k
DefaultingTo d ty ->
text "Defaulting" <+> d $$ text "to" <+> ppWithNames names ty
instance PP (WithNames Error) where
ppPrec _ (WithNames err names) =
addTVarsDescs names err $
case err of
ErrorMsg msg -> msg
RecursiveType t1 t2 ->
nested (text "Matching would result in an infinite type.")
(text "The type: " <+> ppWithNames names t1 $$
text "occurs in:" <+> ppWithNames names t2)
UnexpectedTypeWildCard ->
nested (text "Wild card types are not allowed in this context")
(text "(e.g., they cannot be used in type synonyms).")
KindMismatch k1 k2 ->
nested (text "Incorrect type form.")
(text "Expected:" <+> cppKind k1 $$
text "Inferred:" <+> cppKind k2)
TooManyTypeParams extra k ->
nested (text "Malformed type.")
(text "Kind" <+> quotes (pp k) <+> text "is not a function," $$
text "but it was applied to" <+> pl extra "parameter" <> text ".")
TooManyTySynParams t extra ->
nested (text "Malformed type.")
(text "Type synonym" <+> nm t <+> text "was applied to" <+>
pl extra "extra parameter" <> text ".")
TooFewTySynParams t few ->
nested (text "Malformed type.")
(text "Type" <+> nm t <+> text "is missing" <+>
int few <+> text "parameters.")
RepeatedTyParams ps ->
nested (text "Different type parameters use the same name:")
(vmulti [ nm (P.tpName p) <+>
text "defined at" <+> mb (P.tpRange p) | p <- ps ] )
where mb Nothing = text "unknown location"
mb (Just x) = pp x
RepeatedDefinitions x ps ->
nested (text "Multiple definitions for the same name:")
(vmulti [ nm x <+> text "defined at" <+> pp p | p <- ps ])
RecursiveTypeDecls ts ->
nested (text "Recursive type declarations:")
(fsep $ punctuate comma $ map nm ts)
UndefinedTypeSynonym x ->
text "Type synonym" <+> nm x <+> text "is not defined."
UndefinedVariable x ->
text "Variable" <+> nm x <+> text "was not defined."
UndefinedTypeParam x ->
text "Type variable" <+> nm x <+> text "was not defined."
MultipleTypeParamDefs x ps ->
nested (text "Multiple definitions for the same type parameter"
<+> nm x <> text ":")
(vmulti [ text "defined at" <+> pp p | p <- ps ])
TypeMismatch t1 t2 ->
nested (text "Type mismatch:")
(text "Expected type:" <+> ppWithNames names t1 $$
text "Inferred type:" <+> ppWithNames names t2)
UnsolvedGoal g ->
nested (text "Unsolved constraint:") (ppWithNames names g)
UnsolvedDelcayedCt g ->
nested (text "Failed to validate user-specified signature.")
(ppWithNames names g)
TypeVariableEscaped t xs ->
nested (text "The type" <+> ppWithNames names t <+>
text "is not sufficiently polymorphic.")
(text "It cannot depend on quantified variables:" <+>
sep (punctuate comma (map (ppWithNames names) xs)))
NotForAll x t ->
nested (text "Inferred type is not sufficiently polymorphic.")
(text "Quantified variable:" <+> ppWithNames names x $$
text "cannot match type:" <+> ppWithNames names t)
UnusableFunction f p ->
nested (text "The constraints in the type signature of"
<+> quotes (pp f) <+> text "are unsolvable.")
(text "Detected while analyzing constraint:" $$ ppWithNames names p)
TooManyPositionalTypeParams ->
text "Too many positional type-parameters in explicit type application"
CannotMixPositionalAndNamedTypeParams ->
text "Named and positional type applications may not be mixed."
AmbiguousType xs ->
text "The inferred type for" <+> commaSep (map pp xs)
<+> text "is ambiguous."
where
nested x y = x $$ nest 2 y
pl 1 x = text "1" <+> text x
pl n x = text (show n) <+> text x <> text "s"
nm x = text "`" <> pp x <> text "`"
vmulti = vcat . multi
multi [] = []
multi [x] = [x <> text "."]
multi [x,y] = [x <> text ", and", y <> text "." ]
multi (x : xs) = x <> text "," : multi xs
instance PP ConstraintSource where
ppPrec _ src =
case src of
CtComprehension -> text "list comprehension"
CtSplitPat -> text "split (#) pattern"
CtTypeSig -> text "type signature"
CtInst e -> text "use of" <+> ppUse e
CtSelector -> text "use of selector"
CtExactType -> text "matching types"
CtEnumeration -> text "list enumeration"
CtDefaulting -> text "defaulting"
CtPartialTypeFun f -> text "use of partial type function" <+> pp f
ppUse :: Expr -> Doc
ppUse expr =
case expr of
ECon ECDemote -> text "literal or demoted expression"
ECon ECInfFrom -> text "infinite enumeration"
ECon ECInfFromThen -> text "infinite enumeration (with step)"
ECon ECFromThen -> text "finite enumeration"
ECon ECFromTo -> text "finite enumeration"
ECon ECFromThenTo -> text "finite enumeration"
_ -> text "expression" <+> pp expr
instance PP (WithNames Goal) where
ppPrec _ (WithNames g names) =
(ppWithNames names (goal g)) $$
nest 2 (text "arising from" $$
pp (goalSource g) $$
text "at" <+> pp (goalRange g))
instance PP (WithNames DelayedCt) where
ppPrec _ (WithNames d names) =
sig $$ nest 2 (vars $$ asmps $$ vcat (map (ppWithNames ns1) (dctGoals d)))
where
sig = text "In the definition of" <+> quotes (pp (thing name)) <>
comma <+> text "at" <+> pp (srcRange name) <> colon
name = dctSource d
vars = case dctForall d of
[] -> empty
xs -> text "for any type" <+>
fsep (punctuate comma (map (ppWithNames ns1 ) xs))
asmps = case dctAsmps d of
[] -> empty
xs -> nest 2 (vcat (map (ppWithNames ns1) xs)) $$ text "=>"
ns1 = addTNames (dctForall d) names
instance PP Solved where
ppPrec _ res =
case res of
Solved mb gs -> text "solved" $$ nest 2 (suDoc $$ vcat (map (pp . goal) gs))
where suDoc = maybe empty pp mb
Unsolved -> text "unsolved"
Unsolvable -> text "unsolvable"
cryptol-2.2.6/src/Cryptol/TypeCheck/Instantiate.hs 0000644 0000000 0000000 00000012576 12637103426 020343 0 ustar 00 0000000 0000000 -- |
-- Module : $Header$
-- Copyright : (c) 2013-2015 Galois, Inc.
-- License : BSD3
-- Maintainer : cryptol@galois.com
-- Stability : provisional
-- Portability : portable
module Cryptol.TypeCheck.Instantiate (instantiateWith) where
import Cryptol.TypeCheck.AST
import Cryptol.TypeCheck.Monad
import Cryptol.TypeCheck.Subst (listSubst,apSubst)
import Cryptol.Parser.Position (Located(..))
import Cryptol.Utils.PP
import Data.Function (on)
import Data.List(sortBy, groupBy, find)
import Data.Maybe(mapMaybe,isJust)
import Data.Either(partitionEithers)
import MonadLib
instantiateWith :: Expr -> Schema -> [Located (Maybe QName,Type)]
-> InferM (Expr,Type)
instantiateWith e s ts
| null named = instantiateWithPos e s positional
| null positional = instantiateWithNames e s named
| otherwise = do recordError CannotMixPositionalAndNamedTypeParams
instantiateWithNames e s named
where
(named,positional) = partitionEithers (map classify ts)
classify t = case thing t of
(Just n,ty) -> Left t { thing = (n,ty) }
(Nothing,ty) -> Right ty
instantiateWithPos :: Expr -> Schema -> [Type] -> InferM (Expr,Type)
instantiateWithPos e (Forall as ps t) ts =
do su <- makeSu (1::Int) [] as ts
doInst su e ps t
where
isNamed q = isJust (tpName q)
makeSu n su (q : qs) (ty : tys)
| not (isNamed q) = do r <- unnamed n q
makeSu (n+1) (r : su) qs (ty : tys)
| k1 == k2 = makeSu (n+1) ((tpVar q, ty) : su) qs tys
| otherwise = do recordError $ KindMismatch k1 k2
r <- unnamed n q
makeSu (n+1) (r : su) qs tys
where k1 = kindOf q
k2 = kindOf ty
makeSu _ su [] [] = return (reverse su)
makeSu n su (q : qs) [] = do r <- unnamed n q
makeSu (n+1) (r : su) qs []
makeSu _ su [] _ = do recordError TooManyPositionalTypeParams
return (reverse su)
unnamed n q = do r <- curRange
let src = ordinal n <+> text "type parameter"
$$ text "of" <+> ppUse e
$$ text "at" <+> pp r
ty <- newType src (kindOf q)
return (tpVar q, ty)
{- | Instantiate an expression of the given polymorphic type.
The arguments that are provided will be instantiated as requested,
the rest will be instantiated with fresh type variables.
Note that we assume that type parameters are not normalized.
Generally, the resulting expression will look something like this:
ECast (EProofApp (ETApp e t)) t1
where
- There will be one `ETApp t` for each insantiated type parameter;
- there will be one `EProofApp` for each constraint on the schema;
- there will be `ECast` if we had equality constraints from normalization.
-}
instantiateWithNames :: Expr -> Schema -> [Located (QName,Type)]
-> InferM (Expr,Type)
instantiateWithNames e (Forall as ps t) xs =
do sequence_ repeatedParams
sequence_ undefParams
su' <- mapM paramInst as
doInst su' e ps t
where
-- Choose the type for type parameter `x`
paramInst x =
do let v = tpVar x
k = kindOf v
lkp name = find (\th -> fst (thing th) == name) xs
src r = text "type parameter" <+> (case tpName x of
Just n -> quotes (pp n)
Nothing -> empty)
$$ text "of" <+> ppUse e
$$ text "at" <+> pp r
ty <- case lkp =<< tpName x of
Just lty
| k1 == k -> return ty
| otherwise -> do let r = srcRange lty
inRange r $ recordError (KindMismatch k k1)
newType (src r) k
where ty = snd (thing lty)
k1 = kindOf ty
Nothing -> do r <- curRange
newType (src r) k
return (v,ty)
-- Errors from multiple values for the same parameter.
repeatedParams = mapMaybe isRepeated
$ groupBy ((==) `on` pName)
$ sortBy (compare `on` pName) xs
isRepeated ys@(a : _ : _) = Just $ recordError
$ MultipleTypeParamDefs (fst (thing a))
(map srcRange ys)
isRepeated _ = Nothing
-- Errors from parameters that are defined, but do not exist in the schema.
undefParams = do x <- xs
let name = pName x
guard (name `notElem` mapMaybe tpName as)
return $ inRange (srcRange x)
$ recordError $ UndefinedTypeParam name
pName = fst . thing
doInst :: [(TVar, Type)] -> Expr -> [Prop] -> Type -> InferM (Expr,Type)
doInst su' e ps t =
do let su = listSubst su'
newGoals (CtInst e) (map (apSubst su) ps)
let t1 = apSubst su t
return ( addProofParams
$ addTyParams (map snd su') e
, t1)
where
-- Add type parameters
addTyParams ts e1 = foldl ETApp e1 ts
-- Add proof parameters (the proofs are ommited but we mark where they'd go)
addProofParams e1 = foldl (\e2 _ -> EProofApp e2) e1 ps
cryptol-2.2.6/src/Cryptol/TypeCheck/Kind.hs 0000644 0000000 0000000 00000025704 12637103426 016742 0 ustar 00 0000000 0000000 -- |
-- Module : $Header$
-- Copyright : (c) 2013-2015 Galois, Inc.
-- License : BSD3
-- Maintainer : cryptol@galois.com
-- Stability : provisional
-- Portability : portable
{-# LANGUAGE CPP #-}
#if __GLASGOW_HASKELL__ >= 706
{-# LANGUAGE RecursiveDo #-}
#else
{-# LANGUAGE DoRec, RecursiveDo #-}
#endif
{-# LANGUAGE Safe #-}
module Cryptol.TypeCheck.Kind
( checkType
, checkSchema
, checkNewtype
, checkTySyn
) where
import qualified Cryptol.Parser.AST as P
import Cryptol.Parser.AST (Named(..))
import Cryptol.Parser.Position
import Cryptol.TypeCheck.AST
import Cryptol.TypeCheck.Monad hiding (withTParams)
import Cryptol.TypeCheck.Solve (simplifyAllConstraints
,checkTypeFunction)
import Cryptol.Utils.PP
import qualified Data.Map as Map
import Data.List(sortBy,groupBy)
import Data.Maybe(fromMaybe)
import Data.Function(on)
import Control.Monad(unless,forM)
-- | Check a type signature.
checkSchema :: P.Schema -> InferM (Schema, [Goal])
checkSchema (P.Forall xs ps t mb) =
do ((xs1,(ps1,t1)), gs) <-
collectGoals $
rng $ withTParams True xs $
do ps1 <- mapM checkProp ps
t1 <- doCheckType t (Just KType)
return (ps1,t1)
return (Forall xs1 ps1 t1, gs)
where
rng = case mb of
Nothing -> id
Just r -> inRange r
-- | Check a type-synonym declaration.
checkTySyn :: P.TySyn -> InferM TySyn
checkTySyn (P.TySyn x as t) =
do ((as1,t1),gs) <- collectGoals
$ inRange (srcRange x)
$ do r <- withTParams False as (doCheckType t Nothing)
simplifyAllConstraints
return r
return TySyn { tsName = thing x
, tsParams = as1
, tsConstraints = map goal gs
, tsDef = t1
}
-- | Check a newtype declaration.
-- XXX: Do something with constraints.
checkNewtype :: P.Newtype -> InferM Newtype
checkNewtype (P.Newtype x as fs) =
do ((as1,fs1),gs) <- collectGoals $
inRange (srcRange x) $
do r <- withTParams False as $
forM fs $ \field ->
let n = name field
in kInRange (srcRange n) $
do t1 <- doCheckType (value field) (Just KType)
return (thing n, t1)
simplifyAllConstraints
return r
return Newtype { ntName = thing x
, ntParams = as1
, ntConstraints = map goal gs
, ntFields = fs1
}
checkType :: P.Type -> Maybe Kind -> InferM Type
checkType t k =
do (_, t1) <- withTParams True [] $ doCheckType t k
return t1
{- | Check someting with type parameters.
When we check things with type parameters (i.e., type schemas, and type
synonym declarations) we do kind inference based only on the immediately
visible body. Type parameters that are not mentioned in the body are
defaulted to kind 'KNum'. If this is not the desired behavior, programmers
may add explicit kind annotations on the type parameters.
Here is an example of how this may show up:
> f : {n}. [8] -> [8]
> f x = x + `n
Note that @n@ does not appear in the body of the schema, so we will
default it to 'KNum', which is the correct thing in this case.
To use such a function, we'd have to provide an explicit type application:
> f `{n = 3}
There are two reasons for this choice:
1. It makes it possible to figure if something is correct without
having to look trough arbitrary amounts of code.
2. It is a bit easier to implement, and it covers the large majority
of use cases, with a very small inconvenience (an explicit kind
annotation) in the rest.
-}
withTParams :: Bool -> [P.TParam] -> KindM a -> InferM ([TParam], a)
withTParams allowWildCards xs m =
mdo mapM_ recordError duplicates
(a, vars) <- runKindM allowWildCards (zip' xs ts) m
(as, ts) <- unzip `fmap` mapM (newTP vars) xs
return (as,a)
where
getKind vs tp =
case Map.lookup (P.tpQName tp) vs of
Just k -> return k
Nothing -> do recordWarning (DefaultingKind tp P.KNum)
return KNum
newTP vs tp = do k <- getKind vs tp
n <- newTParam (Just (mkUnqual (P.tpName tp))) k
return (n, TVar (tpVar n))
{- Note that we only zip based on the first argument.
This is needed to make the monadic recursion work correctly,
because the data dependency is only on the part that is known. -}
zip' [] _ = []
zip' (a:as) ~(t:ts) = (mkUnqual (P.tpName a), fmap cvtK (P.tpKind a), t) : zip' as ts
cvtK P.KNum = KNum
cvtK P.KType = KType
duplicates = [ RepeatedTyParams ds
| ds@(_ : _ : _) <- groupBy ((==) `on` P.tpName)
$ sortBy (compare `on` P.tpName) xs ]
-- | Check an application of a type constant.
tcon :: TCon -- ^ Type constant being applied
-> [P.Type] -- ^ Type parameters
-> Maybe Kind -- ^ Expected kind
-> KindM Type -- ^ Resulting type
tcon tc ts0 k =
do (ts1,k1) <- appTy ts0 (kindOf tc)
checkKind (TCon tc ts1) k k1
-- | Check a use of a type-synonym, newtype, or scoped-type variable.
tySyn :: Bool -- ^ Should we check for scoped type vars.
-> QName -- ^ Name of type sysnonym
-> [P.Type] -- ^ Type synonym parameters
-> Maybe Kind -- ^ Expected kind
-> KindM Type -- ^ Resulting type
tySyn scoped x ts k =
do mb <- kLookupTSyn x
case mb of
Just (tysyn@(TySyn f as ps def)) ->
do (ts1,k1) <- appTy ts (kindOf tysyn)
ts2 <- checkParams as ts1
let su = zip as ts2
ps1 <- mapM (`kInstantiateT` su) ps
kNewGoals (CtPartialTypeFun (UserTyFun f)) ps1
t1 <- kInstantiateT def su
checkKind (TUser x ts1 t1) k k1
-- Maybe it is a newtype?
Nothing ->
do mbN <- kLookupNewtype x
case mbN of
Just nt ->
do let tc = newtypeTyCon nt
(ts1,_) <- appTy ts (kindOf tc)
ts2 <- checkParams (ntParams nt) ts1
return (TCon tc ts2)
-- Maybe it is a scoped type variable?
Nothing
| scoped -> kExistTVar x $ fromMaybe KNum k
| otherwise ->
do kRecordError $ UndefinedTypeSynonym x
kNewType (text "type synonym" <+> pp x) $ fromMaybe KNum k
where
checkParams as ts1
| paramHave == paramNeed = return ts1
| paramHave < paramNeed =
do kRecordError (TooFewTySynParams x (paramNeed-paramHave))
let src = text "missing prameter of" <+> pp x
fake <- mapM (kNewType src . kindOf . tpVar)
(drop paramHave as)
return (ts1 ++ fake)
| otherwise = do kRecordError (TooManyTySynParams x (paramHave-paramNeed))
return (take paramNeed ts1)
where paramHave = length ts1
paramNeed = length as
-- | Check a type-application.
appTy :: [P.Type] -- ^ Parameters to type function
-> Kind -- ^ Kind of type function
-> KindM ([Type], Kind) -- ^ Validated parameters, resulting kind
appTy [] k1 = return ([],k1)
appTy (t : ts) (k1 :-> k2) =
do t1 <- doCheckType t (Just k1)
(ts1,k) <- appTy ts k2
return (t1 : ts1, k)
appTy ts k1 =
do kRecordError (TooManyTypeParams (length ts) k1)
return ([], k1)
-- | Validate a parsed type.
doCheckType :: P.Type -- ^ Type that needs to be checked
-> Maybe Kind -- ^ Expected kind (if any)
-> KindM Type -- ^ Checked type
doCheckType ty k =
case ty of
P.TWild ->
do ok <- kWildOK
unless ok $ kRecordError UnexpectedTypeWildCard
theKind <- case k of
Just k1 -> return k1
Nothing -> do kRecordWarning (DefaultingWildType P.KNum)
return KNum
kNewType (text "wildcard") theKind
P.TFun t1 t2 -> tcon (TC TCFun) [t1,t2] k
P.TSeq t1 t2 -> tcon (TC TCSeq) [t1,t2] k
P.TBit -> tcon (TC TCBit) [] k
P.TNum n -> tcon (TC (TCNum n)) [] k
P.TChar n -> tcon (TC (TCNum $ fromIntegral $ fromEnum n)) [] k
P.TInf -> tcon (TC TCInf) [] k
P.TApp tf ts ->
do it <- tcon (TF tf) ts k
-- Now check for additional well-formedness
-- constraints.
case it of
TCon (TF f) ts' ->
case checkTypeFunction f ts' of
[] -> return ()
ps -> kNewGoals (CtPartialTypeFun (BuiltInTyFun f)) ps
_ -> return ()
return it
P.TTuple ts -> tcon (TC (TCTuple (length ts))) ts k
P.TRecord fs -> do t1 <- TRec `fmap` mapM checkF fs
checkKind t1 k KType
P.TLocated t r1 -> kInRange r1 $ doCheckType t k
P.TUser x [] -> checkTyThing x k
P.TUser x ts -> tySyn False x ts k
where
checkF f = do t <- kInRange (srcRange (name f))
$ doCheckType (value f) (Just KType)
return (thing (name f), t)
-- | Check a type-variable or type-synonym.
checkTyThing :: QName -- ^ Name of thing that needs checking
-> Maybe Kind -- ^ Expected kind
-> KindM Type
checkTyThing x k =
do it <- kLookupTyVar x
case it of
Just (TLocalVar t mbk) ->
case k of
Nothing -> return t
Just k1 ->
case mbk of
Nothing -> kSetKind x k1 >> return t
Just k2 -> checkKind t k k2
Just (TOuterVar t) -> checkKind t k (kindOf t)
Nothing -> tySyn True x [] k
-- | Validate a parsed proposition.
checkProp :: P.Prop -- ^ Proposition that need to be checked
-> KindM Type -- ^ Checked representation
checkProp prop =
case prop of
P.CFin t1 -> tcon (PC PFin) [t1] (Just KProp)
P.CEqual t1 t2 -> tcon (PC PEqual) [t1,t2] (Just KProp)
P.CGeq t1 t2 -> tcon (PC PGeq) [t1,t2] (Just KProp)
P.CArith t1 -> tcon (PC PArith) [t1] (Just KProp)
P.CCmp t1 -> tcon (PC PCmp) [t1] (Just KProp)
P.CLocated p r1 -> kInRange r1 (checkProp p)
-- | Check that a type has the expected kind.
checkKind :: Type -- ^ Kind-checked type
-> Maybe Kind -- ^ Expected kind (if any)
-> Kind -- ^ Inferred kind
-> KindM Type -- ^ A type consistent with expectations.
checkKind _ (Just k1) k2
| k1 /= k2 = do kRecordError (KindMismatch k1 k2)
kNewType (text "kind error") k1
checkKind t _ _ = return t
cryptol-2.2.6/src/Cryptol/TypeCheck/Monad.hs 0000644 0000000 0000000 00000060222 12637103426 017105 0 ustar 00 0000000 0000000 -- |
-- Module : $Header$
-- Copyright : (c) 2013-2015 Galois, Inc.
-- License : BSD3
-- Maintainer : cryptol@galois.com
-- Stability : provisional
-- Portability : portable
{-# LANGUAGE RecordWildCards, CPP, Safe #-}
#if __GLASGOW_HASKELL__ >= 706
{-# LANGUAGE RecursiveDo #-}
#else
{-# LANGUAGE DoRec #-}
#endif
module Cryptol.TypeCheck.Monad
( module Cryptol.TypeCheck.Monad
, module Cryptol.TypeCheck.InferTypes
) where
import Cryptol.Parser.Position
import qualified Cryptol.Parser.AST as P
import Cryptol.TypeCheck.AST
import Cryptol.TypeCheck.Subst
import Cryptol.TypeCheck.Unify(mgu, Result(..), UnificationError(..))
import Cryptol.TypeCheck.InferTypes
import Cryptol.Utils.PP(pp, (<+>), Doc, text, quotes)
import Cryptol.Utils.Panic(panic)
import qualified Data.Map as Map
import qualified Data.Set as Set
import Data.Map (Map)
import Data.Set (Set)
import Data.List(find)
import Data.Maybe(mapMaybe)
import MonadLib
import qualified Control.Applicative as A
import Control.Monad.Fix(MonadFix(..))
#if __GLASGOW_HASKELL__ < 710
import Data.Functor
#endif
-- | Information needed for type inference.
data InferInput = InferInput
{ inpRange :: Range -- ^ Location of program source
, inpVars :: Map QName Schema -- ^ Variables that are in scope
, inpTSyns :: Map QName TySyn -- ^ Type synonyms that are in scope
, inpNewtypes :: Map QName Newtype -- ^ Newtypes in scope
, inpNameSeeds :: NameSeeds -- ^ Private state of type-checker
, inpMonoBinds :: Bool -- ^ Should local bindings without
-- signatures be monomorphized?
} deriving Show
-- | This is used for generating various names.
data NameSeeds = NameSeeds
{ seedTVar :: !Int
, seedGoal :: !Int
} deriving Show
-- | The initial seeds, used when checking a fresh program.
nameSeeds :: NameSeeds
nameSeeds = NameSeeds { seedTVar = 10, seedGoal = 0 }
-- | The results of type inference.
data InferOutput a
= InferFailed [(Range,Warning)] [(Range,Error)]
-- ^ We found some errors
| InferOK [(Range,Warning)] NameSeeds a
-- ^ Type inference was successful.
deriving Show
runInferM :: TVars a => InferInput -> InferM a -> IO (InferOutput a)
runInferM info (IM m) =
do rec ro <- return RO { iRange = inpRange info
, iVars = Map.map ExtVar (inpVars info)
, iTVars = []
, iTSyns = fmap mkExternal (inpTSyns info)
, iNewtypes = fmap mkExternal (inpNewtypes info)
, iSolvedHasLazy = iSolvedHas finalRW -- RECURSION
, iMonoBinds = inpMonoBinds info
}
(result, finalRW) <- runStateT rw $ runReaderT ro m -- RECURSION
let theSu = iSubst finalRW
defSu = defaultingSubst theSu
warns = [(r,apSubst theSu w) | (r,w) <- iWarnings finalRW ]
case iErrors finalRW of
[] ->
case (iCts finalRW, iHasCts finalRW) of
(cts,[])
| nullGoals cts
-> return $ InferOK warns
(iNameSeeds finalRW)
(apSubst defSu result)
(cts,has) -> return $ InferFailed warns
[ ( goalRange g
, UnsolvedGoal (apSubst theSu g)
) | g <- fromGoals cts ++ map hasGoal has
]
errs -> return $ InferFailed warns [(r,apSubst theSu e) | (r,e) <- errs]
where
mkExternal x = (IsExternal, x)
rw = RW { iErrors = []
, iWarnings = []
, iSubst = emptySubst
, iExistTVars = []
, iNameSeeds = inpNameSeeds info
, iCts = emptyGoals
, iHasCts = []
, iSolvedHas = Map.empty
}
newtype InferM a = IM { unIM :: ReaderT RO (StateT RW IO) a }
data DefLoc = IsLocal | IsExternal
-- | Read-only component of the monad.
data RO = RO
{ iRange :: Range -- ^ Source code being analysed
, iVars :: Map QName VarType -- ^ Type of variable that are in scope
{- NOTE: We assume no shadowing between these two, so it does not matter
where we look first. Similarly, we assume no shadowing with
the existential type variable (in RW). See `checkTShadowing`. -}
, iTVars :: [TParam] -- ^ Type variable that are in scope
, iTSyns :: Map QName (DefLoc, TySyn) -- ^ Type synonyms that are in scope
, iNewtypes :: Map QName (DefLoc, Newtype)
-- ^ Newtype declarations in scope
--
-- NOTE: type synonyms take precedence over newtype. The reason is
-- that we can define local type synonyms, but not local newtypes.
-- So, either a type-synonym shadows a newtype, or it was declared
-- at the top-level, but then there can't be a newtype with the
-- same name (this should be caught by the renamer).
, iSolvedHasLazy :: Map Int (Expr -> Expr)
-- ^ NOTE: This field is lazy in an important way! It is the
-- final version of `iSolvedHas` in `RW`, and the two are tied
-- together through recursion. The field is here so that we can
-- look thing up before they are defined, which is OK because we
-- don't need to know the results until everything is done.
, iMonoBinds :: Bool
-- ^ When this flag is set to true, bindings that lack signatures
-- in where-blocks will never be generalized. Bindings with type
-- signatures, and all bindings at top level are unaffected.
}
-- | Read-write component of the monad.
data RW = RW
{ iErrors :: ![(Range,Error)] -- ^ Collected errors
, iWarnings :: ![(Range,Warning)] -- ^ Collected warnings
, iSubst :: !Subst -- ^ Accumulated substitution
, iExistTVars :: [Map QName Type]
-- ^ These keeps track of what existential type variables are available.
-- When we start checking a function, we push a new scope for
-- its arguments, and we pop it when we are done checking the function
-- body. The front element of the list is the current scope, which is
-- the only thing that will be modified, as follows. When we encounter
-- a existential type variable:
-- 1. we look in all scopes to see if it is already defined.
-- 2. if it was not defined, we create a fresh type variable,
-- and we add it to the current scope.
-- 3. it is an error if we encounter an existential variable but we
-- have no current scope.
, iSolvedHas :: Map Int (Expr -> Expr)
-- ^ Selector constraints that have been solved (ref. iSolvedSelectorsLazy)
-- Generating names
, iNameSeeds :: !NameSeeds
-- Constraints that need solving
, iCts :: !Goals -- ^ Ordinary constraints
, iHasCts :: ![HasGoal]
{- ^ Tuple/record projection constraints. The `Int` is the "name"
of the constraint, used so that we can name it solution properly. -}
}
instance Functor InferM where
fmap f (IM m) = IM (fmap f m)
instance A.Applicative InferM where
pure = return
(<*>) = ap
instance Monad InferM where
return x = IM (return x)
fail x = IM (fail x)
IM m >>= f = IM (m >>= unIM . f)
instance MonadFix InferM where
mfix f = IM (mfix (unIM . f))
io :: IO a -> InferM a
io m = IM $ inBase m
-- | The monadic computation is about the given range of source code.
-- This is useful for error reporting.
inRange :: Range -> InferM a -> InferM a
inRange r (IM m) = IM $ mapReader (\ro -> ro { iRange = r }) m
inRangeMb :: Maybe Range -> InferM a -> InferM a
inRangeMb Nothing m = m
inRangeMb (Just r) m = inRange r m
-- | This is the current range that we are working on.
curRange :: InferM Range
curRange = IM $ asks iRange
-- | Report an error.
recordError :: Error -> InferM ()
recordError e =
do r <- curRange
IM $ sets_ $ \s -> s { iErrors = (r,e) : iErrors s }
recordWarning :: Warning -> InferM ()
recordWarning w =
do r <- curRange
IM $ sets_ $ \s -> s { iWarnings = (r,w) : iWarnings s }
--------------------------------------------------------------------------------
newGoal :: ConstraintSource -> Prop -> InferM Goal
newGoal goalSource goal =
do goalRange <- curRange
return Goal { .. }
-- | Record some constraints that need to be solved.
-- The string explains where the constraints came from.
newGoals :: ConstraintSource -> [Prop] -> InferM ()
newGoals src ps = addGoals =<< mapM (newGoal src) ps
{- | The constraints are removed, and returned to the caller.
The substitution IS applied to them. -}
getGoals :: InferM [Goal]
getGoals =
do goals <- applySubst =<< IM (sets $ \s -> (iCts s, s { iCts = emptyGoals }))
return (fromGoals goals)
-- | Add a bunch of goals that need solving.
addGoals :: [Goal] -> InferM ()
addGoals gs = IM $ sets_ $ \s -> s { iCts = foldl (flip insertGoal) (iCts s) gs }
-- | Collect the goals emitted by the given sub-computation.
-- Does not emit any new goals.
collectGoals :: InferM a -> InferM (a, [Goal])
collectGoals m =
do origGs <- applySubst =<< getGoals'
a <- m
newGs <- getGoals
setGoals' origGs
return (a, newGs)
where
-- retrieve the type map only
getGoals' = IM $ sets $ \ RW { .. } -> (iCts, RW { iCts = emptyGoals, .. })
-- set the type map directly
setGoals' gs = IM $ sets $ \ RW { .. } -> ((), RW { iCts = gs, .. })
{- | Record a constraint that when we select from the first type,
we should get a value of the second type.
The returned function should be used to wrap the expression from
which we are selecting (i.e., the record or tuple). Plese note
that the resulting expression should not be forced before the
constraint is solved.
-}
newHasGoal :: P.Selector -> Type -> Type -> InferM (Expr -> Expr)
newHasGoal l ty f =
do goalName <- newGoalName
g <- newGoal CtSelector (pHas l ty f)
IM $ sets_ $ \s -> s { iHasCts = HasGoal goalName g : iHasCts s }
solns <- IM $ fmap iSolvedHasLazy ask
return $ case Map.lookup goalName solns of
Just e1 -> e1
Nothing -> panic "newHasGoal" ["Unsolved has goal in result"]
-- | Add a previously generate has constrained
addHasGoal :: HasGoal -> InferM ()
addHasGoal g = IM $ sets_ $ \s -> s { iHasCts = g : iHasCts s }
-- | Get the `Has` constraints. Each of this should either be solved,
-- or added back using `addHasGoal`.
getHasGoals :: InferM [HasGoal]
getHasGoals = do gs <- IM $ sets $ \s -> (iHasCts s, s { iHasCts = [] })
applySubst gs
-- | Specify the solution (`Expr -> Expr`) for the given constraint (`Int`).
solveHasGoal :: Int -> (Expr -> Expr) -> InferM ()
solveHasGoal n e =
IM $ sets_ $ \s -> s { iSolvedHas = Map.insert n e (iSolvedHas s) }
--------------------------------------------------------------------------------
newName :: (NameSeeds -> (a , NameSeeds)) -> InferM a
newName upd = IM $ sets $ \s -> let (x,seeds) = upd (iNameSeeds s)
in (x, s { iNameSeeds = seeds })
-- | Generate a new name for a goal.
newGoalName :: InferM Int
newGoalName = newName $ \s -> let x = seedGoal s
in (x, s { seedGoal = x + 1})
-- | Generate a new free type variable.
newTVar :: Doc -> Kind -> InferM TVar
newTVar src k = newTVar' src Set.empty k
-- | Generate a new free type variable that depends on these additional
-- type parameters.
newTVar' :: Doc -> Set TVar -> Kind -> InferM TVar
newTVar' src extraBound k =
do bound <- getBoundInScope
let vs = Set.union extraBound bound
newName $ \s -> let x = seedTVar s
in (TVFree x k vs src, s { seedTVar = x + 1 })
-- | Generate a new free type variable.
newTParam :: Maybe QName -> Kind -> InferM TParam
newTParam nm k = newName $ \s -> let x = seedTVar s
in (TParam { tpUnique = x
, tpKind = k
, tpName = nm
}
, s { seedTVar = x + 1 })
-- | Generate an unknown type. The doc is a note about what is this type about.
newType :: Doc -> Kind -> InferM Type
newType src k = TVar `fmap` newTVar src k
--------------------------------------------------------------------------------
-- | Record that the two types should be syntactically equal.
unify :: Type -> Type -> InferM [Prop]
unify t1 t2 =
do t1' <- applySubst t1
t2' <- applySubst t2
case mgu t1' t2' of
OK (su1,ps) -> extendSubst su1 >> return ps
Error err ->
do case err of
UniTypeLenMismatch _ _ -> recordError (TypeMismatch t1' t2')
UniTypeMismatch s1 s2 -> recordError (TypeMismatch s1 s2)
UniKindMismatch k1 k2 -> recordError (KindMismatch k1 k2)
UniRecursive x t -> recordError (RecursiveType (TVar x) t)
UniNonPolyDepends x vs -> recordError
(TypeVariableEscaped (TVar x) vs)
UniNonPoly x t -> recordError (NotForAll x t)
return []
-- | Apply the accumulated substitution to something with free type variables.
applySubst :: TVars t => t -> InferM t
applySubst t =
do su <- getSubst
return (apSubst su t)
-- | Get the substitution that we have accumulated so far.
getSubst :: InferM Subst
getSubst = IM $ fmap iSubst get
-- | Add to the accumulated substitution.
extendSubst :: Subst -> InferM ()
extendSubst su = IM $ sets_ $ \s -> s { iSubst = su @@ iSubst s }
-- | Variables that are either mentioned in the environment or in
-- a selector constraint.
varsWithAsmps :: InferM (Set TVar)
varsWithAsmps =
do env <- IM $ fmap (Map.elems . iVars) ask
fromEnv <- forM env $ \v ->
case v of
ExtVar sch -> getVars sch
CurSCC _ t -> getVars t
sels <- IM $ fmap (map (goal . hasGoal) . iHasCts) get
fromSels <- mapM getVars sels
fromEx <- (getVars . concatMap Map.elems) =<< IM (fmap iExistTVars get)
return (Set.unions fromEnv `Set.union` Set.unions fromSels
`Set.union` fromEx)
where
getVars x = fvs `fmap` applySubst x
--------------------------------------------------------------------------------
-- | Lookup the type of a variable.
lookupVar :: QName -> InferM VarType
lookupVar x =
do mb <- IM $ asks $ Map.lookup x . iVars
case mb of
Just t -> return t
Nothing ->
do mbNT <- lookupNewtype x
case mbNT of
Just nt -> return (ExtVar (newtypeConType nt))
Nothing -> do recordError $ UndefinedVariable x
a <- newType (text "type of" <+> pp x) KType
return $ ExtVar $ Forall [] [] a
-- | Lookup a type variable. Return `Nothing` if there is no such variable
-- in scope, in which case we must be dealing with a type constant.
lookupTVar :: QName -> InferM (Maybe Type)
lookupTVar x = IM $ asks $ fmap (TVar . tpVar) . find this . iTVars
where this tp = tpName tp == Just x
-- | Lookup the definition of a type synonym.
lookupTSyn :: QName -> InferM (Maybe TySyn)
lookupTSyn x = fmap (fmap snd . Map.lookup x) getTSyns
-- | Lookup the definition of a newtype
lookupNewtype :: QName -> InferM (Maybe Newtype)
lookupNewtype x = fmap (fmap snd . Map.lookup x) getNewtypes
-- | Check if we already have a name for this existential type variable and,
-- if so, return the definition. If not, try to create a new definition,
-- if this is allowed. If not, returns nothing.
existVar :: QName -> Kind -> InferM Type
existVar x k =
do scopes <- iExistTVars <$> IM get
case msum (map (Map.lookup x) scopes) of
Just ty -> return ty
Nothing ->
case scopes of
[] ->
do recordError $ ErrorMsg $
text "Undefined type" <+> quotes (pp x)
newType (text "undefined existential type varible" <+>
quotes (pp x)) k
sc : more ->
do ty <- newType (text "existential type variable"
<+> quotes (pp x)) k
IM $ sets_ $ \s -> s{ iExistTVars = Map.insert x ty sc : more }
return ty
-- | Returns the type synonyms that are currently in scope.
getTSyns :: InferM (Map QName (DefLoc,TySyn))
getTSyns = IM $ asks iTSyns
-- | Returns the newtype declarations that are in scope.
getNewtypes :: InferM (Map QName (DefLoc,Newtype))
getNewtypes = IM $ asks iNewtypes
-- | Get the set of bound type variables that are in scope.
getTVars :: InferM (Set QName)
getTVars = IM $ asks $ Set.fromList . mapMaybe tpName . iTVars
-- | Return the keys of the bound variables that are in scope.
getBoundInScope :: InferM (Set TVar)
getBoundInScope = IM $ asks $ Set.fromList . map tpVar . iTVars
-- | Retrieve the value of the `mono-binds` option.
getMonoBinds :: InferM Bool
getMonoBinds = IM (asks iMonoBinds)
{- | We disallow shadowing between type synonyms and type variables
because it is confusing. As a bonus, in the implementation we don't
need to worry about where we lookup things (i.e., in the variable or
type synonym environment. -}
checkTShadowing :: String -> QName -> InferM ()
checkTShadowing this new =
do ro <- IM ask
rw <- IM get
let shadowed =
do _ <- Map.lookup new (iTSyns ro)
return "type synonym"
`mplus`
do guard (new `elem` mapMaybe tpName (iTVars ro))
return "type variable"
`mplus`
do _ <- msum (map (Map.lookup new) (iExistTVars rw))
return "type"
case shadowed of
Nothing -> return ()
Just that ->
recordError $ ErrorMsg $
text "Type" <+> text this <+> quotes (pp new) <+>
text "shadows an existing" <+>
text that <+> text "with the same name."
-- | The sub-computation is performed with the given type parameter in scope.
withTParam :: TParam -> InferM a -> InferM a
withTParam p (IM m) =
do case tpName p of
Just x -> checkTShadowing "variable" x
Nothing -> return ()
IM $ mapReader (\r -> r { iTVars = p : iTVars r }) m
withTParams :: [TParam] -> InferM a -> InferM a
withTParams ps m = foldr withTParam m ps
-- | The sub-computation is performed with the given type-synonym in scope.
withTySyn :: TySyn -> InferM a -> InferM a
withTySyn t (IM m) =
do let x = tsName t
checkTShadowing "synonym" x
IM $ mapReader (\r -> r { iTSyns = Map.insert x (IsLocal,t) (iTSyns r) }) m
withNewtype :: Newtype -> InferM a -> InferM a
withNewtype t (IM m) =
IM $ mapReader
(\r -> r { iNewtypes = Map.insert (ntName t) (IsLocal,t)
(iNewtypes r) }) m
-- | The sub-computation is performed with the given variable in scope.
withVarType :: QName -> VarType -> InferM a -> InferM a
withVarType x s (IM m) =
IM $ mapReader (\r -> r { iVars = Map.insert x s (iVars r) }) m
withVarTypes :: [(QName,VarType)] -> InferM a -> InferM a
withVarTypes xs m = foldr (uncurry withVarType) m xs
withVar :: QName -> Schema -> InferM a -> InferM a
withVar x s = withVarType x (ExtVar s)
-- | The sub-computation is performed with the given variables in scope.
withMonoType :: (QName,Located Type) -> InferM a -> InferM a
withMonoType (x,lt) = withVar x (Forall [] [] (thing lt))
-- | The sub-computation is performed with the given variables in scope.
withMonoTypes :: Map QName (Located Type) -> InferM a -> InferM a
withMonoTypes xs m = foldr withMonoType m (Map.toList xs)
-- | The sub-computation is performed with the given type synonyms
-- and variables in scope.
withDecls :: ([TySyn], Map QName Schema) -> InferM a -> InferM a
withDecls (ts,vs) m = foldr withTySyn (foldr add m (Map.toList vs)) ts
where
add (x,t) = withVar x t
-- | Perform the given computation in a new scope (i.e., the subcomputation
-- may use existential type variables).
inNewScope :: InferM a -> InferM a
inNewScope m =
do curScopes <- iExistTVars <$> IM get
IM $ sets_ $ \s -> s { iExistTVars = Map.empty : curScopes }
a <- m
IM $ sets_ $ \s -> s { iExistTVars = curScopes }
return a
--------------------------------------------------------------------------------
-- Kind checking
newtype KindM a = KM { unKM :: ReaderT KRO (StateT KRW InferM) a }
data KRO = KRO { lazyTVars :: Map QName Type -- ^ lazy map, with tyvars.
, allowWild :: Bool -- ^ are type-wild cards allowed?
}
data KRW = KRW { typeParams :: Map QName Kind -- ^ kinds of (known) vars.
}
instance Functor KindM where
fmap f (KM m) = KM (fmap f m)
instance A.Applicative KindM where
pure = return
(<*>) = ap
instance Monad KindM where
return x = KM (return x)
fail x = KM (fail x)
KM m >>= k = KM (m >>= unKM . k)
{- | The arguments to this function are as follows:
(type param. name, kind signature (opt.), a type representing the param)
The type representing the parameter is just a thunk that we should not force.
The reason is that the type depnds on the kind of parameter, that we are
in the process of computing.
As a result we return the value of the sub-computation and the computed
kinds of the type parameters. -}
runKindM :: Bool -- Are type-wild cards allowed?
-> [(QName, Maybe Kind, Type)] -- ^ See comment
-> KindM a -> InferM (a, Map QName Kind)
runKindM wildOK vs (KM m) =
do (a,kw) <- runStateT krw (runReaderT kro m)
return (a, typeParams kw)
where
tys = Map.fromList [ (x,t) | (x,_,t) <- vs ]
kro = KRO { allowWild = wildOK, lazyTVars = tys }
krw = KRW { typeParams = Map.fromList [ (x,k) | (x,Just k,_) <- vs ] }
-- | This is what's returned when we lookup variables during kind checking.
data LkpTyVar = TLocalVar Type (Maybe Kind) -- ^ Locally bound variable.
| TOuterVar Type -- ^ An outer binding.
-- | Check if a name refers to a type variable.
kLookupTyVar :: QName -> KindM (Maybe LkpTyVar)
kLookupTyVar x = KM $
do vs <- lazyTVars `fmap` ask
ss <- get
case Map.lookup x vs of
Just t -> return $ Just $ TLocalVar t $ Map.lookup x $ typeParams ss
Nothing -> lift $ lift $ do t <- lookupTVar x
return (fmap TOuterVar t)
-- | Are type wild-cards OK in this context?
kWildOK :: KindM Bool
kWildOK = KM $ fmap allowWild ask
-- | Reports an error.
kRecordError :: Error -> KindM ()
kRecordError e = kInInferM $ recordError e
kRecordWarning :: Warning -> KindM ()
kRecordWarning w = kInInferM $ recordWarning w
-- | Generate a fresh unification variable of the given kind.
kNewType :: Doc -> Kind -> KindM Type
kNewType src k =
do tps <- KM $ do vs <- asks lazyTVars
return $ Set.fromList [ tv | TVar tv <- Map.elems vs ]
kInInferM $ TVar `fmap` newTVar' src tps k
-- | Lookup the definition of a type synonym.
kLookupTSyn :: QName -> KindM (Maybe TySyn)
kLookupTSyn x = kInInferM $ lookupTSyn x
-- | Lookup the definition of a newtype.
kLookupNewtype :: QName -> KindM (Maybe Newtype)
kLookupNewtype x = kInInferM $ lookupNewtype x
kExistTVar :: QName -> Kind -> KindM Type
kExistTVar x k = kInInferM $ existVar x k
-- | Replace the given bound variables with concrete types.
kInstantiateT :: Type -> [(TParam,Type)] -> KindM Type
kInstantiateT t as = return (apSubst su t)
where su = listSubst [ (tpVar x, t1) | (x,t1) <- as ]
{- | Record the kind for a local type variable.
This assumes that we already checked that there was no other valid
kind for the variable (if there was one, it gets over-written). -}
kSetKind :: QName -> Kind -> KindM ()
kSetKind v k = KM $ sets_ $ \s -> s{ typeParams = Map.insert v k (typeParams s)}
-- | The sub-computation is about the given range of the source code.
kInRange :: Range -> KindM a -> KindM a
kInRange r (KM m) = KM $
do e <- ask
s <- get
(a,s1) <- lift $ lift $ inRange r $ runStateT s $ runReaderT e m
set s1
return a
kNewGoals :: ConstraintSource -> [Prop] -> KindM ()
kNewGoals c ps = kInInferM $ newGoals c ps
kInInferM :: InferM a -> KindM a
kInInferM m = KM $ lift $ lift m
cryptol-2.2.6/src/Cryptol/TypeCheck/PP.hs 0000644 0000000 0000000 00000003364 12637103426 016372 0 ustar 00 0000000 0000000 -- |
-- Module : $Header$
-- Copyright : (c) 2013-2015 Galois, Inc.
-- License : BSD3
-- Maintainer : cryptol@galois.com
-- Stability : provisional
-- Portability : portable
{-# LANGUAGE Safe #-}
{-# LANGUAGE FlexibleInstances, FlexibleContexts #-}
module Cryptol.TypeCheck.PP
( NameMap, WithNames(..)
, emptyNameMap
, ppWithNamesPrec, ppWithNames
, intToName, nameList
, dump
, module Cryptol.Utils.PP
) where
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import Data.List(transpose)
import Cryptol.Utils.PP
type NameMap = IntMap String
emptyNameMap :: NameMap
emptyNameMap = IntMap.empty
-- | This packages together a type with some names to be used to display
-- the variables. It is used for pretty printing types.
data WithNames a = WithNames a NameMap
ppWithNamesPrec :: PP (WithNames a) => NameMap -> Int -> a -> Doc
ppWithNamesPrec names prec t = ppPrec prec (WithNames t names)
ppWithNames :: PP (WithNames a) => NameMap -> a -> Doc
ppWithNames names t = ppWithNamesPrec names 0 t
dump :: PP (WithNames a) => a -> String
dump x = show (ppWithNames IntMap.empty x)
-- | Compute the n-th variant of a name (e.g., @a5@).
nameVariant :: Int -> String -> String
nameVariant 0 x = x
nameVariant n x = x ++ show n
-- | Compute all variants of a name: @a, a1, a2, a3, ...@
nameVariants :: String -> [String]
nameVariants x = map (`nameVariant` x) [ 0 .. ]
-- | Expand a list of base names into an infinite list of variations.
nameList :: [String] -> [String]
nameList names = concat $ transpose $ map nameVariants baseNames
where
baseNames | null names = map (:[]) [ 'a' .. 'z' ]
| otherwise = names
intToName :: Int -> String
intToName x = nameList [] !! x
cryptol-2.2.6/src/Cryptol/TypeCheck/Solve.hs 0000644 0000000 0000000 00000011625 12637103426 017142 0 ustar 00 0000000 0000000 -- |
-- Module : $Header$
-- Copyright : (c) 2013-2015 Galois, Inc.
-- License : BSD3
-- Maintainer : cryptol@galois.com
-- Stability : provisional
-- Portability : portable
{-# LANGUAGE PatternGuards, BangPatterns #-}
{-# LANGUAGE Safe #-}
module Cryptol.TypeCheck.Solve
( simplifyAllConstraints
, proveImplication
, assumedOrderModel
, checkTypeFunction
) where
import Cryptol.Parser.AST(LQName,thing)
import Cryptol.TypeCheck.AST
import Cryptol.TypeCheck.Monad
import Cryptol.TypeCheck.Subst(apSubst,fvs,emptySubst,Subst)
import Cryptol.TypeCheck.Solver.Eval
import Cryptol.TypeCheck.Solver.FinOrd
import Cryptol.TypeCheck.Solver.Numeric
import Cryptol.TypeCheck.Solver.Class
import Cryptol.TypeCheck.Solver.Selector(tryHasGoal)
import qualified Cryptol.TypeCheck.Solver.Smtlib as SMT
import Cryptol.TypeCheck.Defaulting(tryDefaultWith)
import Control.Monad(unless)
import Data.List(partition)
import qualified Data.Set as Set
-- Add additional constraints that ensure validity of type function.
checkTypeFunction :: TFun -> [Type] -> [Prop]
checkTypeFunction TCSub [a,b] = [ a >== b, pFin b]
checkTypeFunction TCDiv [a,b] = [ b >== tOne, pFin a ]
checkTypeFunction TCMod [a,b] = [ b >== tOne, pFin a ]
checkTypeFunction TCLenFromThen [a,b,c] = [ pFin a, pFin b, pFin c, a =/= b ]
checkTypeFunction TCLenFromThenTo [a,b,c] = [ pFin a, pFin b, pFin c, a =/= b ]
checkTypeFunction _ _ = []
-- XXX at the moment, we try to solve class constraints before solving fin
-- constraints, as they could yield fin constraints. At some point, it would
-- probably be good to try solving all of these in one big loop.
simplifyAllConstraints :: InferM ()
simplifyAllConstraints =
do mapM_ tryHasGoal =<< getHasGoals
simplifyGoals noFacts =<< getGoals
proveImplication :: LQName -> [TParam] -> [Prop] -> [Goal] -> InferM Subst
proveImplication lname as asmps0 goals =
case assumedOrderModel noFacts (concatMap expandProp asmps0) of
Left (_m,p) -> do recordError (UnusableFunction (thing lname) p)
return emptySubst
Right (m,asmps) ->
do let gs = [ g { goal = q } | g <- goals
, let p = goal g
q = simpType m p
, p `notElem` asmps
, q `notElem` asmps
]
(_,gs1) <- collectGoals (simplifyGoals m gs)
let numAsmps = filter pIsNumeric asmps
(numGs,otherGs) = partition (pIsNumeric . goal) gs1
gs2 <- io $ SMT.simpDelayed as m numAsmps numGs
case otherGs ++ gs2 of
[] -> return emptySubst
unsolved ->
-- Last resort, let's try to default something.
do let vs = Set.filter isFreeTV $ fvs $ map goal unsolved
evars <- varsWithAsmps
let candidates = vs `Set.difference` evars
if Set.null vs
then reportErr unsolved >> return emptySubst
else do let (_,uns,su,ws) =
tryDefaultWith m (Set.toList candidates) unsolved
mapM_ recordWarning ws
unless (null uns) (reportErr uns)
return su
where
reportErr us = recordError $ UnsolvedDelcayedCt
DelayedCt { dctSource = lname
, dctForall = as
, dctAsmps = asmps0
, dctGoals = us
}
-- | Assumes that the substitution has been applied to the goals
simplifyGoals :: OrdFacts -> [Goal] -> InferM ()
simplifyGoals initOrd gs1 = solveSomeGoals [] False gs1
where
solveSomeGoals others !changes [] =
if changes
then solveSomeGoals [] False others
else addGoals others
solveSomeGoals others !changes (g : gs) =
do let (m, bad, _) = goalOrderModel initOrd (others ++ gs)
if not (null bad)
then mapM_ (recordError . UnsolvedGoal) bad
else
case makeStep m g of
Unsolved -> solveSomeGoals (g : others) changes gs
Unsolvable ->
do recordError (UnsolvedGoal g)
solveSomeGoals others changes gs
Solved Nothing [] -> solveSomeGoals others changes gs
Solved Nothing subs -> solveSomeGoals others True (subs ++ gs)
Solved (Just su) subs ->
do extendSubst su
solveSomeGoals (apSubst su others) True
(subs ++ apSubst su gs)
makeStep m g = case numericStep m g of
Unsolved -> classStep g
x -> x
cryptol-2.2.6/src/Cryptol/TypeCheck/Subst.hs 0000644 0000000 0000000 00000017154 12637103426 017155 0 ustar 00 0000000 0000000 -- |
-- Module : $Header$
-- Copyright : (c) 2013-2015 Galois, Inc.
-- License : BSD3
-- Maintainer : cryptol@galois.com
-- Stability : provisional
-- Portability : portable
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE Safe #-}
module Cryptol.TypeCheck.Subst where
import Data.Either (partitionEithers)
import qualified Data.Map as Map
import qualified Data.IntMap as IntMap
import Data.Set (Set)
import qualified Data.Set as Set
import Cryptol.TypeCheck.AST
import Cryptol.TypeCheck.PP
import Cryptol.TypeCheck.TypeMap
import Cryptol.Utils.Panic(panic)
data Subst = S { suMap :: Map.Map TVar Type, suDefaulting :: !Bool }
deriving Show
emptySubst :: Subst
emptySubst = S { suMap = Map.empty, suDefaulting = False }
singleSubst :: TVar -> Type -> Subst
singleSubst x t = S { suMap = Map.singleton x t, suDefaulting = False }
(@@) :: Subst -> Subst -> Subst
s2 @@ s1 = S { suMap = Map.map (apSubst s2) (suMap s1) `Map.union` suMap s2
, suDefaulting = suDefaulting s1 || suDefaulting s2
}
defaultingSubst :: Subst -> Subst
defaultingSubst s = s { suDefaulting = True }
-- | Makes a substitution out of a list.
-- WARNING: We do not validate the list in any way, so the caller should
-- ensure that we end up with a valid (e.g., idempotent) substitution.
listSubst :: [(TVar,Type)] -> Subst
listSubst xs = S { suMap = Map.fromList xs, suDefaulting = False }
isEmptySubst :: Subst -> Bool
isEmptySubst su = Map.null (suMap su)
-- Returns `Nothing` if this is a deaulting substitution
substToList :: Subst -> Maybe [ (TVar, Type) ]
substToList su | suDefaulting su = Nothing
| otherwise = Just $ Map.toList $ suMap su
instance PP (WithNames Subst) where
ppPrec _ (WithNames s mp) = text "Substitution:" $$ nest 2
(vcat $ map pp1 $ Map.toList $ suMap s)
where pp1 (x,t) = ppWithNames mp x <+> text "=" <+> ppWithNames mp t
instance PP Subst where
ppPrec n = ppWithNamesPrec IntMap.empty n
class FVS t where
fvs :: t -> Set TVar
instance FVS Type where
fvs = go
where
go ty =
case ty of
TCon _ ts -> Set.unions (map go ts)
TVar x -> Set.singleton x
TUser _ _ t -> go t
TRec fs -> Set.unions (map (go . snd) fs)
instance FVS a => FVS [a] where
fvs xs = Set.unions (map fvs xs)
instance (FVS a, FVS b) => FVS (a,b) where
fvs (x,y) = Set.union (fvs x) (fvs y)
instance FVS Schema where
fvs (Forall as ps t) =
Set.difference (Set.union (fvs ps) (fvs t)) bound
where bound = Set.fromList (map tpVar as)
class TVars t where
apSubst :: Subst -> t -> t -- ^ replaces free vars
instance TVars t => TVars (Maybe t) where
apSubst s = fmap (apSubst s)
instance TVars t => TVars [t] where
apSubst s = map (apSubst s)
instance (TVars s, TVars t) => TVars (s,t) where
apSubst s (x,y) = (apSubst s x, apSubst s y)
instance TVars Type where
apSubst su ty =
case ty of
TCon t ts -> TCon t (apSubst su ts)
TUser f ts t -> TUser f (apSubst su ts) (apSubst su t)
TRec fs -> TRec [ (x,apSubst su s) | (x,s) <- fs ]
TVar x
| Just t <- Map.lookup x (suMap su) ->
if suDefaulting su
then apSubst (defaultingSubst emptySubst) t
else t
| suDefaulting su -> defaultFreeVar x
| otherwise -> ty
-- | Pick types for unconstrained unification variables.
defaultFreeVar :: TVar -> Type
defaultFreeVar x@(TVBound {}) = TVar x
defaultFreeVar (TVFree _ k _ d) =
case k of
KType -> tBit
KNum -> tNum (0 :: Int)
_ -> panic "Cryptol.TypeCheck.Subst.defaultFreeVar"
[ "Free variable of unexpected kind."
, "Source: " ++ show d
, "Kind: " ++ show k ]
instance (Functor m, TVars a) => TVars (List m a) where
apSubst su = fmap (apSubst su)
instance TVars a => TVars (TypeMap a) where
apSubst su = fmap (apSubst su)
-- | Apply the substitution to the keys of a type map.
apSubstTypeMapKeys :: Subst -> TypeMap a -> TypeMap a
apSubstTypeMapKeys su = go (\_ x -> x) id
where
go :: (a -> a -> a) -> (a -> a) -> TypeMap a -> TypeMap a
go merge atNode TM { .. } = foldl addKey tm' tys
where
addKey tm (ty,a) = insertWithTM merge ty a tm
tm' = TM { tvar = Map.fromList vars
, tcon = fmap (lgo merge atNode) tcon
, trec = fmap (lgo merge atNode) trec
}
-- partition out variables that have been replaced with more specific types
(vars,tys) = partitionEithers
[ case Map.lookup v (suMap su) of
Just ty -> Right (ty,a')
Nothing -> Left (v, a')
| (v,a) <- Map.toList tvar
, let a' = atNode a
]
lgo :: (a -> a -> a) -> (a -> a) -> List TypeMap a -> List TypeMap a
lgo merge atNode k = k { nil = fmap atNode (nil k)
, cons = go (unionTM merge)
(lgo merge atNode)
(cons k)
}
{- | WARNING: This instance assumes that the quantified variables in the
types in the substitution will not get captured by the quantified variables.
This is reasonable because there should be no shadowing of quantified
variables but, just in case, we make a sanity check and panic if somehow
capture did occur. -}
instance TVars Schema where
apSubst su sch@(Forall xs ps t)
| Set.null captured = Forall xs (apSubst su1 ps) (apSubst su1 t)
| otherwise = panic "Cryptol.TypeCheck.Subst.apSubst (Schema)"
[ "Captured quantified variables:"
, "Substitution: " ++ show m1
, "Schema: " ++ show sch
, "Variables: " ++ show captured
]
where
used = fvs sch
m1 = Map.filterWithKey (\k _ -> k `Set.member` used) (suMap su)
su1 = S { suMap = m1, suDefaulting = suDefaulting su }
captured = Set.fromList (map tpVar xs) `Set.intersection`
fvs (Map.elems m1)
instance TVars Expr where
apSubst su = go
where
go expr =
case expr of
EApp e1 e2 -> EApp (go e1) (go e2)
EAbs x t e1 -> EAbs x (apSubst su t) (go e1)
ETAbs a e -> ETAbs a (go e)
ETApp e t -> ETApp (go e) (apSubst su t)
EProofAbs p e -> EProofAbs (apSubst su p) (go e)
EProofApp e -> EProofApp (go e)
ECast e t -> ECast (go e) (apSubst su t)
EVar {} -> expr
ECon {} -> expr
ETuple es -> ETuple (map go es)
ERec fs -> ERec [ (f, go e) | (f,e) <- fs ]
EList es t -> EList (map go es) (apSubst su t)
ESel e s -> ESel (go e) s
EComp t e mss -> EComp (apSubst su t) (go e) (apSubst su mss)
EIf e1 e2 e3 -> EIf (go e1) (go e2) (go e3)
EWhere e ds -> EWhere (go e) (apSubst su ds)
instance TVars Match where
apSubst su (From x t e) = From x (apSubst su t) (apSubst su e)
apSubst su (Let b) = Let (apSubst su b)
instance TVars DeclGroup where
apSubst su (NonRecursive d) = NonRecursive (apSubst su d)
apSubst su (Recursive ds) = Recursive (apSubst su ds)
instance TVars Decl where
apSubst su d = d { dSignature = apSubst su (dSignature d)
, dDefinition = apSubst su (dDefinition d)
}
instance TVars Module where
apSubst su m = m { mDecls = apSubst su (mDecls m) }
cryptol-2.2.6/src/Cryptol/TypeCheck/TypeMap.hs 0000644 0000000 0000000 00000012772 12637103426 017435 0 ustar 00 0000000 0000000 -- |
-- Module : $Header$
-- Copyright : (c) 2013-2015 Galois, Inc.
-- License : BSD3
-- Maintainer : cryptol@galois.com
-- Stability : provisional
-- Portability : portable
{-# LANGUAGE Safe #-}
{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-}
{-# LANGUAGE UndecidableInstances, FlexibleInstances #-}
{-# LANGUAGE DeriveFunctor #-}
module Cryptol.TypeCheck.TypeMap
( TypeMap(..), TypesMap, TrieMap(..)
, insertTM, insertWithTM
, membersTM
, mapTM, mapWithKeyTM, mapMaybeTM
, List(..)
) where
import Cryptol.TypeCheck.AST
import qualified Data.Map as Map
import Data.Map (Map)
import Data.Maybe(fromMaybe,maybeToList)
import Control.Monad((<=<))
import Data.List(sortBy)
import Data.Maybe (isNothing)
import Data.Ord(comparing)
class TrieMap m k | m -> k where
emptyTM :: m a
nullTM :: m a -> Bool
lookupTM :: k -> m a -> Maybe a
alterTM :: k -> (Maybe a -> Maybe a) -> m a -> m a
unionTM :: (a -> a -> a) -> m a -> m a -> m a
toListTM :: m a -> [(k,a)]
mapMaybeWithKeyTM :: (k -> a -> Maybe b) -> m a -> m b
membersTM :: TrieMap m k => m a -> [a]
membersTM = map snd . toListTM
insertTM :: TrieMap m k => k -> a -> m a -> m a
insertTM t a = alterTM t (\_ -> Just a)
insertWithTM :: TrieMap m k => (a -> a -> a) -> k -> a -> m a -> m a
insertWithTM f t new = alterTM t $ \mb -> Just $ case mb of
Nothing -> new
Just old -> f old new
{-# INLINE mapTM #-}
mapTM :: TrieMap m k => (a -> b) -> m a -> m b
mapTM f = mapMaybeWithKeyTM (\ _ a -> Just (f a))
{-# INLINE mapWithKeyTM #-}
mapWithKeyTM :: TrieMap m k => (k -> a -> b) -> m a -> m b
mapWithKeyTM f = mapMaybeWithKeyTM (\ k a -> Just (f k a))
{-# INLINE mapMaybeTM #-}
mapMaybeTM :: TrieMap m k => (a -> Maybe b) -> m a -> m b
mapMaybeTM f = mapMaybeWithKeyTM (\_ -> f)
data List m a = L { nil :: Maybe a
, cons :: m (List m a)
} deriving (Functor)
instance TrieMap m a => TrieMap (List m) [a] where
emptyTM = L { nil = Nothing, cons = emptyTM }
nullTM k = isNothing (nil k) && nullTM (cons k)
lookupTM k =
case k of
[] -> nil
x : xs -> lookupTM xs <=< lookupTM x . cons
alterTM k f m =
case k of
[] -> m { nil = f (nil m) }
x:xs -> m { cons = alterTM x (updSub xs f) (cons m) }
toListTM m =
[ ([], v) | v <- maybeToList (nil m) ] ++
[ (x:xs,v) | (x,m1) <- toListTM (cons m), (xs,v) <- toListTM m1 ]
unionTM f m1 m2 = L { nil = case (nil m1, nil m2) of
(Just x, Just y) -> Just (f x y)
(Just x, _) -> Just x
(_, Just y) -> Just y
_ -> Nothing
, cons = unionTM (unionTM f) (cons m1) (cons m2)
}
mapMaybeWithKeyTM f = go []
where
go acc l = L { nil = f (reverse acc) =<< nil l
, cons = mapMaybeWithKeyTM (\k a -> Just (go (k:acc) a)) (cons l)
}
instance Ord a => TrieMap (Map a) a where
emptyTM = Map.empty
nullTM = Map.null
lookupTM = Map.lookup
alterTM = flip Map.alter
toListTM = Map.toList
unionTM = Map.unionWith
mapMaybeWithKeyTM = Map.mapMaybeWithKey
type TypesMap = List TypeMap
data TypeMap a = TM { tvar :: Map TVar a
, tcon :: Map TCon (List TypeMap a)
, trec :: Map [Name] (List TypeMap a)
} deriving (Functor)
instance TrieMap TypeMap Type where
emptyTM = TM { tvar = emptyTM, tcon = emptyTM, trec = emptyTM }
nullTM ty = and [ nullTM (tvar ty)
, nullTM (tcon ty)
, nullTM (trec ty) ]
lookupTM ty =
case ty of
TUser _ _ t -> lookupTM t
TVar x -> lookupTM x . tvar
TCon c ts -> lookupTM ts <=< lookupTM c . tcon
TRec fs -> let (xs,ts) = unzip $ sortBy (comparing fst) fs
in lookupTM ts <=< lookupTM xs . trec
alterTM ty f m =
case ty of
TUser _ _ t -> alterTM t f m
TVar x -> m { tvar = alterTM x f (tvar m) }
TCon c ts -> m { tcon = alterTM c (updSub ts f) (tcon m) }
TRec fs -> let (xs,ts) = unzip $ sortBy (comparing fst) fs
in m { trec = alterTM xs (updSub ts f) (trec m) }
toListTM m =
[ (TVar x, v) | (x,v) <- toListTM (tvar m) ] ++
[ (TCon c ts, v) | (c,m1) <- toListTM (tcon m)
, (ts,v) <- toListTM m1 ] ++
[ (TRec (zip fs ts), v) | (fs,m1) <- toListTM (trec m)
, (ts,v) <- toListTM m1 ]
unionTM f m1 m2 = TM { tvar = unionTM f (tvar m1) (tvar m2)
, tcon = unionTM (unionTM f) (tcon m1) (tcon m2)
, trec = unionTM (unionTM f) (trec m1) (trec m2)
}
mapMaybeWithKeyTM f m =
TM { tvar = mapMaybeWithKeyTM (\v -> f (TVar v)) (tvar m)
, tcon = mapWithKeyTM (\c l -> mapMaybeWithKeyTM
(\ts a -> f (TCon c ts) a) l) (tcon m)
, trec = mapWithKeyTM (\fs l -> mapMaybeWithKeyTM
(\ts a -> f (TRec (zip fs ts)) a) l) (trec m)
}
updSub :: TrieMap m k => k -> (Maybe a -> Maybe a) -> Maybe (m a) -> Maybe (m a)
updSub k f = Just . alterTM k f . fromMaybe emptyTM
instance Show a => Show (TypeMap a) where
showsPrec p xs = showsPrec p (toListTM xs)
cryptol-2.2.6/src/Cryptol/TypeCheck/TypeOf.hs 0000644 0000000 0000000 00000010741 12637103426 017256 0 ustar 00 0000000 0000000 -- |
-- Module : $Header$
-- Copyright : (c) 2014-2015 Galois, Inc.
-- License : BSD3
-- Maintainer : cryptol@galois.com
-- Stability : provisional
-- Portability : portable
{-# LANGUAGE Safe #-}
{-# LANGUAGE ViewPatterns #-}
module Cryptol.TypeCheck.TypeOf
( fastTypeOf
, fastSchemaOf
) where
import Cryptol.TypeCheck.AST
import Cryptol.TypeCheck.Subst
import Cryptol.Prims.Types (typeOf)
import Cryptol.Utils.Panic
import Cryptol.Utils.PP
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Maybe (fromJust)
-- | Given a typing environment and an expression, compute the type of
-- the expression as quickly as possible, assuming that the expression
-- is well formed with correct type annotations.
fastTypeOf :: Map QName Schema -> Expr -> Type
fastTypeOf tyenv expr =
case expr of
-- Monomorphic fragment
EList es t -> tSeq (tNum (length es)) t
ETuple es -> tTuple (map (fastTypeOf tyenv) es)
ERec fields -> tRec [ (name, fastTypeOf tyenv e) | (name, e) <- fields ]
ESel e sel -> typeSelect (fastTypeOf tyenv e) sel
EIf _ e _ -> fastTypeOf tyenv e
EComp t _ _ -> t
EAbs x t e -> tFun t (fastTypeOf (Map.insert x (Forall [] [] t) tyenv) e)
EApp e _ -> case tIsFun (fastTypeOf tyenv e) of
Just (_, t) -> t
Nothing -> panic "Cryptol.TypeCheck.TypeOf.fastTypeOf"
[ "EApp with non-function operator" ]
ECast _ t -> t
-- Polymorphic fragment
ECon {} -> polymorphic
EVar {} -> polymorphic
ETAbs {} -> polymorphic
ETApp {} -> polymorphic
EProofAbs {} -> polymorphic
EProofApp {} -> polymorphic
EWhere {} -> polymorphic
where
polymorphic =
case fastSchemaOf tyenv expr of
Forall [] [] ty -> ty
_ -> panic "Cryptol.TypeCheck.TypeOf.fastTypeOf"
[ "unexpected polymorphic type" ]
fastSchemaOf :: Map QName Schema -> Expr -> Schema
fastSchemaOf tyenv expr =
case expr of
-- Polymorphic fragment
ECon econ -> typeOf econ
EVar x -> fromJust (Map.lookup x tyenv)
ETAbs tparam e -> case fastSchemaOf tyenv e of
Forall tparams props ty -> Forall (tparam : tparams) props ty
ETApp e t -> case fastSchemaOf tyenv e of
Forall (tparam : tparams) props ty -> Forall tparams (apSubst s props) (apSubst s ty)
where s = singleSubst (tpVar tparam) t
_ -> panic "Cryptol.TypeCheck.TypeOf.fastSchemaOf"
[ "ETApp body with no type parameters" ]
EProofAbs p e -> case fastSchemaOf tyenv e of
Forall [] props ty -> Forall [] (p : props) ty
_ -> panic "Cryptol.TypeCheck.TypeOf.fastSchemaOf"
[ "EProofAbs with polymorphic expression" ]
EProofApp e -> case fastSchemaOf tyenv e of
Forall [] (_ : props) ty -> Forall [] props ty
_ -> panic "Cryptol.TypeCheck.TypeOf.fastSchemaOf"
[ "EProofApp with polymorphic expression or"
, "no props in scope"
]
EWhere e dgs -> fastSchemaOf (foldr addDeclGroup tyenv dgs) e
where addDeclGroup (Recursive ds) = flip (foldr addDecl) ds
addDeclGroup (NonRecursive d) = addDecl d
addDecl d = Map.insert (dName d) (dSignature d)
-- Monomorphic fragment
EList {} -> monomorphic
ETuple {} -> monomorphic
ERec {} -> monomorphic
ESel {} -> monomorphic
EIf {} -> monomorphic
EComp {} -> monomorphic
EApp {} -> monomorphic
EAbs {} -> monomorphic
ECast {} -> monomorphic
where
monomorphic = Forall [] [] (fastTypeOf tyenv expr)
-- | Yields the return type of the selector on the given argument type.
typeSelect :: Type -> Selector -> Type
typeSelect (TCon _tctuple ts) (TupleSel i _) = ts !! i
typeSelect (TRec fields) (RecordSel n _) = fromJust (lookup n fields)
typeSelect (TCon _tcseq [_, a]) (ListSel _ _) = a
typeSelect ty _ = panic "Cryptol.TypeCheck.TypeOf.typeSelect"
[ "cannot apply selector to value of type", render (pp ty) ]
cryptol-2.2.6/src/Cryptol/TypeCheck/Unify.hs 0000644 0000000 0000000 00000007103 12637103426 017140 0 ustar 00 0000000 0000000 -- |
-- Module : $Header$
-- Copyright : (c) 2013-2015 Galois, Inc.
-- License : BSD3
-- Maintainer : cryptol@galois.com
-- Stability : provisional
-- Portability : portable
{-# LANGUAGE Safe #-}
{-# LANGUAGE PatternGuards, ViewPatterns #-}
{-# LANGUAGE DeriveFunctor #-}
module Cryptol.TypeCheck.Unify where
import Cryptol.TypeCheck.AST
import Cryptol.TypeCheck.Subst
import Cryptol.Utils.Panic (panic)
import Data.Ord(comparing)
import Data.List(sortBy)
import qualified Data.Set as Set
#if __GLASGOW_HASKELL__ < 710
import Control.Applicative (Applicative(..))
#endif
-- | The most general unifier is a substitution and a set of constraints
-- on bound variables.
type MGU = (Subst,[Prop])
data Result a = OK a | Error UnificationError
deriving (Functor)
data UnificationError
= UniTypeMismatch Type Type
| UniKindMismatch Kind Kind
| UniTypeLenMismatch Int Int
| UniRecursive TVar Type
| UniNonPolyDepends TVar [TVar]
| UniNonPoly TVar Type
instance Applicative Result where
pure = OK
OK f <*> OK x = OK (f x)
OK _ <*> Error e = Error e
Error e <*> _ = Error e
instance Monad Result where
return a = OK a
OK a >>= k = k a
Error x >>= _ = Error x
fail x = panic "Cryptol.TypeCheck.Unify.fail" [x]
uniError :: UnificationError -> Result a
uniError e = Error e
emptyMGU :: MGU
emptyMGU = (emptySubst, [])
mgu :: Type -> Type -> Result MGU
mgu (TUser c1 ts1 _) (TUser c2 ts2 _)
| c1 == c2 && ts1 == ts2 = return emptyMGU
mgu (TVar x) t = bindVar x t
mgu t (TVar x) = bindVar x t
mgu (TUser _ _ t1) t2 = mgu t1 t2
mgu t1 (TUser _ _ t2) = mgu t1 t2
mgu (TCon (TC tc1) ts1) (TCon (TC tc2) ts2)
| tc1 == tc2 = mguMany ts1 ts2
mgu (TCon (TF f1) ts1) (TCon (TF f2) ts2)
| f1 == f2 && ts1 == ts2 = return emptyMGU
mgu t1 t2
| TCon (TF _) _ <- t1, isNum, k1 == k2 = return (emptySubst, [t1 =#= t2])
| TCon (TF _) _ <- t2, isNum, k1 == k2 = return (emptySubst, [t1 =#= t2])
where
k1 = kindOf t1
k2 = kindOf t2
isNum = k1 == KNum
mgu (TRec fs1) (TRec fs2)
| ns1 == ns2 = mguMany ts1 ts2
where
(ns1,ts1) = sortFields fs1
(ns2,ts2) = sortFields fs2
sortFields = unzip . sortBy (comparing fst)
mgu t1 t2
| not (k1 == k2) = uniError $ UniKindMismatch k1 k2
| otherwise = uniError $ UniTypeMismatch t1 t2
where
k1 = kindOf t1
k2 = kindOf t2
mguMany :: [Type] -> [Type] -> Result MGU
mguMany [] [] = return emptyMGU
mguMany (t1 : ts1) (t2 : ts2) =
do (su1,ps1) <- mgu t1 t2
(su2,ps2) <- mguMany (apSubst su1 ts1) (apSubst su1 ts2)
return (su2 @@ su1, ps1 ++ ps2)
mguMany t1 t2 = uniError $ UniTypeLenMismatch (length t1) (length t2)
bindVar :: TVar -> Type -> Result MGU
bindVar x (tNoUser -> TVar y)
| x == y = return emptyMGU
bindVar v@(TVBound {}) (tNoUser -> TVar v1@(TVFree {})) = bindVar v1 (TVar v)
bindVar v@(TVBound _ k) t
| k == kindOf t = if k == KNum
then return (emptySubst, [TVar v =#= t])
else uniError $ UniNonPoly v t
| otherwise = uniError $ UniKindMismatch k (kindOf t)
bindVar x@(TVFree _ k inScope _d) t
| not (k == kindOf t) = uniError $ UniKindMismatch k (kindOf t)
| recTy && k == KType = uniError $ UniRecursive x t
| not (Set.null escaped) = uniError $ UniNonPolyDepends x$ Set.toList escaped
| recTy = return (emptySubst, [TVar x =#= t])
| otherwise = return (singleSubst x t, [])
where
vs = fvs t
escaped = Set.filter isBoundTV vs `Set.difference` inScope
recTy = x `Set.member` vs
cryptol-2.2.6/src/Cryptol/TypeCheck/Solver/ 0000755 0000000 0000000 00000000000 12637103426 016763 5 ustar 00 0000000 0000000 cryptol-2.2.6/src/Cryptol/TypeCheck/Solver/Class.hs 0000644 0000000 0000000 00000006576 12637103426 020402 0 ustar 00 0000000 0000000 -- |
-- Module : $Header$
-- Copyright : (c) 2013-2015 Galois, Inc.
-- License : BSD3
-- Maintainer : cryptol@galois.com
-- Stability : provisional
-- Portability : portable
--
-- Solving class constraints.
{-# LANGUAGE PatternGuards #-}
module Cryptol.TypeCheck.Solver.Class (classStep, expandProp) where
import Cryptol.TypeCheck.AST
import Cryptol.TypeCheck.InferTypes(Goal(..), Solved(..))
-- | Solve class constraints.
classStep :: Goal -> Solved
classStep g = case goal g of
TCon (PC PArith) [ty] -> solveArithInst g (tNoUser ty)
TCon (PC PCmp) [ty] -> solveCmpInst g (tNoUser ty)
_ -> Unsolved
-- | Solve an original goal in terms of the give sub-goals.
solved :: Goal -> [Prop] -> Solved
solved g ps = Solved Nothing [ g { goal = p } | p <- ps ]
-- | Solve an Arith constraint by instance, if possible.
solveArithInst :: Goal -> Type -> Solved
solveArithInst g ty = case ty of
-- Arith [n]e
TCon (TC TCSeq) [n, e] -> solveArithSeq g n e
-- Arith b => Arith (a -> b)
TCon (TC TCFun) [_,b] -> solved g [ pArith b ]
-- (Arith a, Arith b) => Arith (a,b)
TCon (TC (TCTuple _)) es -> solved g [ pArith e | e <- es ]
-- (Arith a, Arith b) => Arith { x1 : a, x2 : b }
TRec fs -> solved g [ pArith ety | (_,ety) <- fs ]
_ -> Unsolved
-- | Solve an Arith constraint for a sequence. The type passed here is the
-- element type of the sequence.
solveArithSeq :: Goal -> Type -> Type -> Solved
solveArithSeq g n ty = case ty of
-- fin n => Arith [n]Bit
TCon (TC TCBit) [] -> solved g [ pFin n ]
-- variables are not solvable.
TVar {} -> Unsolved
-- Arith ty => Arith [n]ty
_ -> solved g [ pArith ty ]
-- | Solve Cmp constraints.
solveCmpInst :: Goal -> Type -> Solved
solveCmpInst g ty = case ty of
-- Cmp Bit
TCon (TC TCBit) [] -> solved g []
-- (fin n, Cmp a) => Cmp [n]a
TCon (TC TCSeq) [n,a] -> solved g [ pFin n, pCmp a ]
-- (Cmp a, Cmp b) => Cmp (a,b)
TCon (TC (TCTuple _)) es -> solved g (map pCmp es)
-- (Cmp a, Cmp b) => Cmp { x:a, y:b }
TRec fs -> solved g [ pCmp e | (_,e) <- fs ]
_ -> Unsolved
-- | Add propositions that are implied by the given one.
-- The result contains the orignal proposition, and maybe some more.
expandProp :: Prop -> [Prop]
expandProp prop =
prop :
case tNoUser prop of
TCon (PC pc) [ty] ->
case (pc, tNoUser ty) of
-- Arith [n]Bit => fin n
-- (Arith [n]a, a/=Bit) => Arith a
(PArith, TCon (TC TCSeq) [n,a])
| TCon (TC TCBit) _ <- ty1 -> [pFin n]
| TCon _ _ <- ty1 -> expandProp (pArith ty1)
| TRec {} <- ty1 -> expandProp (pArith ty1)
where
ty1 = tNoUser a
-- Arith (a -> b) => Arith b
(PArith, TCon (TC TCFun) [_,b]) -> expandProp (pArith b)
-- Arith (a,b) => (Arith a, Arith b)
(PArith, TCon (TC (TCTuple _)) ts) -> concatMap (expandProp . pArith) ts
-- Arith { x1 : a, x2 : b } => (Arith a, Arith b)
(PArith, TRec fs) -> concatMap (expandProp . pArith. snd) fs
-- Cmp [n]a => (fin n, Cmp a)
(PCmp, TCon (TC TCSeq) [n,a]) -> pFin n : expandProp (pCmp a)
-- Cmp (a,b) => (Cmp a, Cmp b)
(PCmp, TCon (TC (TCTuple _)) ts) -> concatMap (expandProp . pCmp) ts
-- Cmp { x:a, y:b } => (Cmp a, Cmp b)
(PCmp, TRec fs) -> concatMap (expandProp . pCmp . snd) fs
_ -> []
_ -> []
cryptol-2.2.6/src/Cryptol/TypeCheck/Solver/CrySAT.hs 0000644 0000000 0000000 00000050714 12637103426 020433 0 ustar 00 0000000 0000000 -- |
-- Module : $Header$
-- Copyright : (c) 2013-2015 Galois, Inc.
-- License : BSD3
-- Maintainer : cryptol@galois.com
-- Stability : provisional
-- Portability : portable
{-# LANGUAGE Safe, PatternGuards #-}
module Cryptol.TypeCheck.Solver.CrySAT
(debug
, Prop(..)
, Expr(..)
, PropSet
, noProps
, assert
, checkSat
, Result(..)
, InfNat(..)
, Name
, toName
, fromName
) where
import qualified Data.Integer.SAT as SAT
import Data.Set(Set)
import qualified Data.Set as Set
import Data.Either (partitionEithers)
import MonadLib
import Control.Applicative
import Cryptol.Utils.Panic
infixr 2 :||
infixr 3 :&&
infix 4 :==, :>, :>=
infixl 6 :+, :-
infixl 7 :*
data Name = UserName Int | SysName Int
deriving (Show,Eq,Ord)
toName :: Int -> Name
toName = UserName
fromName :: Name -> Maybe Int
fromName (UserName x) = Just x
fromName (SysName _) = Nothing
exportName :: Name -> SAT.Name
exportName n = SAT.toName $ case n of
UserName i -> 2 * i
SysName i -> 2 * i + 1
satVar :: Name -> SAT.Expr
satVar = SAT.Var . exportName
importName :: Int -> Name
importName x = case divMod x 2 of
(q,r) | r == 0 -> UserName q
| otherwise -> SysName q
satCheckSat :: SAT.PropSet -> Maybe [ (Name,Integer) ]
satCheckSat = fmap (map imp) . SAT.checkSat
where imp (x,v) = (importName x, v)
data Prop = Fin Expr
| Expr :== Expr | Expr :/= Expr
| Expr :>= Expr | Expr :> Expr
| Prop :&& Prop | Prop :|| Prop
| Not Prop
deriving Show
data Expr = K InfNat
| Var Name
| Expr :+ Expr
| Expr :- Expr
| Expr :* Expr
| Div Expr Expr
| Mod Expr Expr
| Expr :^^ Expr
| Min Expr Expr
| Max Expr Expr
| Lg2 Expr
| Width Expr
| LenFromThen Expr Expr Expr
| LenFromThenTo Expr Expr Expr
deriving Show
debug :: PropSet -> [S]
debug (PS m) = runId $ findAll m
newtype PropSet = PS (ChoiceT Id S)
noProps :: PropSet
noProps = PS $ return S { finVars = Set.empty
, infVars = Set.empty
, linear = SAT.noProps
, nonLin = []
, waitVars = Set.empty
, changes = False
, nextVar = 0
}
assert :: Prop -> PropSet -> PropSet
assert p (PS m) =
PS $ do s <- m
(_,s1) <- runStateT s
$ unFM
$ cvt p >> checkConsistent
return s1
where
cvt (p1 :&& p2) = cvt p1 `mkAnd` cvt p2
cvt (p1 :|| p2) = cvt p1 `mkOr` cvt p2
cvt (Not p1) = cvt (mkNot p1)
cvt (Fin t) = cryDefined t `mkAnd` cryIsFin t
cvt (t1 :== t2) = cryDefined t1 `mkAnd` cryDefined t2 `mkAnd` cryIsEq t1 t2
cvt (t1 :/= t2) = cryDefined t1 `mkAnd` cryDefined t2 `mkAnd` cryIsNeq t1 t2
cvt (t1 :>= t2) = cryDefined t1 `mkAnd` cryDefined t2 `mkAnd` cryIsGeq t1 t2
cvt (t1 :> t2) = cryDefined t1 `mkAnd` cryDefined t2 `mkAnd` cryIsGt t1 t2
mkNot q = case q of
p1 :&& p2 -> mkNot p1 :|| mkNot p2
p1 :|| p2 -> mkNot p1 :&& mkNot p2
Not p1 -> p1
Fin e -> e :== K Inf
t1 :== t2 -> t1 :/= t2
t1 :/= t2 -> t1 :== t2
t1 :>= t2 -> t2 :> t1
t1 :> t2 -> t2 :>= t1
data InfNat = Nat Integer | Inf
deriving (Eq,Ord,Show)
data Result = Sat [(Int,InfNat)]
| Unsat
| Unknown
deriving Show
checkSat :: PropSet -> Result
checkSat (PS ch) =
runId $
do mb <- runChoiceT ch
return $ case mb of
Nothing -> Unsat
Just (s, more) ->
case getModel s of
Just m -> Sat m
Nothing -> case checkSat (PS more) of
Unsat -> Unknown
x -> x
getModel :: S -> Maybe [(Int,InfNat)]
getModel s =
do let ps = linear s
m <- satCheckSat ps
let exact = [ satVar x SAT.:== SAT.K v | (x,v) <- m ]
m1 <- satCheckSat $ foldr SAT.assert SAT.noProps
$ exact ++
[ satVar x SAT.:== cvt m nl | (x,nl) <- nonLin s ]
return [ (x,v) | (UserName x, v)
<- [ (x,Inf) | x <- Set.toList (infVars s) ] ++
[ (x,Nat v) | (x,v) <- m1 ] ]
where
lkp m x = case lookup x m of
Nothing -> 0
Just n -> n
cvt m nl =
case nl of
NLDiv e x -> SAT.Div e (lkp m x)
NLMod e x -> SAT.Mod e (lkp m x)
NLExp x y -> SAT.K $ lkp m x ^ lkp m y
NLExpL k y -> SAT.K $ k ^ lkp m y
NLExpR x k -> SAT.K $ lkp m x ^ k
NLMul x y -> SAT.K $ lkp m x * lkp m y
NLLg2 x -> SAT.K $ nLg2 (lkp m x)
--------------------------------------------------------------------------------
data NonLin = NLDiv SAT.Expr Name
| NLMod SAT.Expr Name
| NLExp Name Name
| NLExpL Integer Name
| NLExpR Name Integer
| NLMul Name Name
| NLLg2 Name
deriving Show
setNL :: Name -> Integer -> (Name,NonLin) -> Either (Name,NonLin) SAT.Prop
setNL x n (v, nl) = case it of
Left nl1 -> Left (x,nl1)
Right e -> Right (satVar v SAT.:== e)
where
it = case nl of
NLDiv e y | x == y -> Right $ SAT.Div e n
NLMod e y | x == y -> Right $ SAT.Mod e n
NLMul y z | y == z && x == y -> Right $ SAT.K $ n * n
| x == y -> Right $ n SAT.:* satVar z
| x == z -> Right $ n SAT.:* satVar y
NLExp y z | y == z && x == y -> Right $ SAT.K $ n ^ n
| x == y -> Left $ NLExpL n z
| x == z -> Left $ NLExpR y n
NLExpL k z | x == z -> Right $ SAT.K $ k ^ n
NLExpR y k | x == y -> Right $ SAT.K $ n ^ k
NLLg2 y | x == y -> Right $ SAT.K $ nLg2 n
_ -> Left nl
data S = S
{ finVars :: Set Name -- all of these are ordinary finite vars
, infVars :: Set Name -- these vars are all equal to Inf (XXX: subst?)
, linear :: SAT.PropSet -- linear constraints
, nonLin :: [(Name,NonLin)] -- non-linear (delayed) constraints
, waitVars :: Set Name -- waiting for improvements to these
-- improvements here may turn non-lin into lin
-- INV: these are a subset of finVars
, changes :: Bool -- temp: did something improve last time?
-- if so we should restart.
, nextVar :: !Int -- source of new variables
}
newtype FM a = FM { unFM :: StateT S (ChoiceT Id) a }
instance Functor FM where
fmap f (FM m) = FM (fmap f m)
instance Applicative FM where
pure x = FM (pure x)
FM mf <*> FM mx = FM (mf <*> mx)
instance Alternative FM where
empty = mzero
(<|>) = mplus
instance Monad FM where
return x = FM (return x)
FM mf >>= k = FM (mf >>= unFM . k)
instance MonadPlus FM where
mzero = FM mzero
mplus (FM m1) (FM m2) = FM (mplus m1 m2)
noChanges :: F
noChanges = FM $ sets_ $ \s -> s { changes = False }
addLin :: SAT.Prop -> F
addLin p = FM $ sets_ $ \s -> s { linear = SAT.assert p (linear s)
, changes = True }
checkConsistent :: F
checkConsistent =
do s <- FM get
when (changes s) $
case satCheckSat (linear s) of
Nothing -> mzero
Just m ->
do noChanges
mapM_ tryImprove [ (x,v) | (x,v) <- m, x `Set.member` waitVars s ]
checkConsistent
tryImprove :: (Name,Integer) -> F
tryImprove (x,n) =
do s <- FM get
case satCheckSat (SAT.assert (satVar x SAT.:/= SAT.K n) (linear s)) of
Nothing -> doImprove x n
Just _ -> return ()
doImprove :: Name -> Integer -> F
doImprove x n =
do resumed <- FM $ sets $ \s ->
let (stay, go) = partitionEithers $ map (setNL x n) (nonLin s)
in (go, s { nonLin = stay, waitVars = Set.delete x (waitVars s) })
mapM_ addLin resumed
getLin :: FM SAT.PropSet
getLin = FM $ linear `fmap` get
newName :: FM Name
newName = FM $ sets $ \s -> let x = nextVar s
in (SysName x, s { nextVar = x + 1 })
addNonLin :: NonLin -> FM SAT.Expr
addNonLin nl =
do x <- newName
FM $ sets_ $ \s -> s { nonLin = (x,nl) : nonLin s }
isFin x
return $ satVar x
type F = FM ()
mkAnd :: F -> F -> F
mkAnd f1 f2 = f1 >> f2
mkOr :: F -> F -> F
mkOr f1 f2 = f1 `mplus` f2
tt :: F
tt = return ()
ff :: F
ff = mzero
isEq :: Expr -> Expr -> F
isEq t1 t2 = addLin =<< ((SAT.:==) <$> mkLin t1 <*> mkLin t2)
isGt :: Expr -> Expr -> F
isGt t1 t2 = addLin =<< ((SAT.:>) <$> mkLin t1 <*> mkLin t2)
isFin :: Name -> F
isFin x = do FM $ do s <- get
guard (Set.notMember x (infVars s))
set s { finVars = Set.insert x (finVars s) }
addLin (satVar x SAT.:>= SAT.K 0)
isInf :: Name -> F
isInf x = FM $ do s <- get
guard (Set.notMember x (finVars s))
set s { infVars = Set.insert x (infVars s) }
--------------------------------------------------------------------------------
cryIsEq :: Expr -> Expr -> F
cryIsEq t1 t2 = (cryIsInf t1 `mkAnd` cryIsInf t2) `mkOr`
(cryIsFin t1 `mkAnd` cryIsFin t2 `mkAnd` isEq t1 t2)
cryIsNeq :: Expr -> Expr -> F
cryIsNeq t1 t2 = cryIsGt t1 t2 `mkOr` cryIsGt t2 t1
cryIsGt :: Expr -> Expr -> F
cryIsGt t1 t2 = (cryIsInf t1 `mkAnd` cryIsFin t2) `mkOr`
(cryIsFin t1 `mkAnd` cryIsFin t2 `mkAnd` isGt t1 t2)
cryIsGeq :: Expr -> Expr -> F
cryIsGeq t1 t2 = cryIsEq t1 t2 `mkOr` cryIsGt t1 t2
cryIsDifferent :: Expr -> Expr -> F
cryIsDifferent t1 t2 = cryIsGt t1 t2 `mkOr` cryIsGt t2 t1
{- XXX: Are we being a bit too strict here?
Some oprtations may be defined even if one of their arguments
is not. For example, perhaps the following should not be rejected:
inf + undefined -> inf
0 - undefined -> 0
0 * undefined -> 0
mod undefined 1 -> 0
1 ^ undefined -> 1
undefined ^ 0 -> 1`
min 0 undefined -> 0
max inf undefined -> inf
-}
cryDefined :: Expr -> F
cryDefined ty =
case ty of
K _ -> tt
Var _ -> tt
t1 :+ t2 -> cryDefined t1 `mkAnd` cryDefined t2
t1 :- t2 -> cryDefined t1 `mkAnd` cryDefined t2 `mkAnd`
cryIsFin t2 `mkAnd` cryIsGeq t1 t2
t1 :* t2 -> cryDefined t1 `mkAnd` cryDefined t2
Div t1 t2 -> cryDefined t1 `mkAnd` cryDefined t2 `mkAnd`
cryIsFin t1 `mkAnd` cryIsGt t2 (K $ Nat 0)
Mod t1 t2 -> cryDefined t1 `mkAnd` cryDefined t2 `mkAnd`
cryIsFin t1 `mkAnd` cryIsGt t2 (K $ Nat 0)
t1 :^^ t2 -> cryDefined t1 `mkAnd` cryDefined t2
Min t1 t2 -> cryDefined t1 `mkAnd` cryDefined t2
Max t1 t2 -> cryDefined t1 `mkAnd` cryDefined t2
Lg2 t1 -> cryDefined t1
Width t1 -> cryDefined t1
LenFromThen t1 t2 t3 ->
cryDefined t1 `mkAnd` cryDefined t2 `mkAnd`
cryDefined t3 `mkAnd` cryIsFin t1 `mkAnd`
cryIsFin t2 `mkAnd` cryIsFin t3 `mkAnd`
cryIsDifferent t1 t2
LenFromThenTo t1 t2 t3 ->
cryDefined t1 `mkAnd` cryDefined t2 `mkAnd`
cryDefined t3 `mkAnd` cryIsFin t1 `mkAnd`
cryIsFin t2 `mkAnd` cryIsFin t3 `mkAnd`
cryIsDifferent t1 t2
-- Assuming a defined input.
cryIsInf :: Expr -> F
cryIsInf ty =
case ty of
K Inf -> tt
K (Nat _) -> ff
Var x -> isInf x
t1 :+ t2 -> cryIsInf t1 `mkOr` cryIsInf t2
t1 :- _ -> cryIsInf t1
t1 :* t2 -> (cryIsInf t1 `mkAnd` cryIsGt t2 (K $ Nat 0))`mkOr`
(cryIsInf t2 `mkAnd` cryIsGt t1 (K $ Nat 0))
Div t1 _ -> cryIsInf t1
Mod _ _ -> ff
t1 :^^ t2 -> (cryIsInf t1 `mkAnd` cryIsGt t2 (K $ Nat 0))`mkOr`
(cryIsInf t2 `mkAnd` cryIsGt t1 (K $ Nat 1))
Min t1 t2 -> cryIsInf t1 `mkAnd` cryIsInf t2
Max t1 t2 -> cryIsInf t1 `mkOr` cryIsInf t2
Lg2 t1 -> cryIsInf t1
Width t1 -> cryIsInf t1
LenFromThen _ _ _ -> ff
LenFromThenTo _ _ _ -> ff
-- Assuming a defined input.
cryIsFin :: Expr -> F
cryIsFin ty =
case ty of
K Inf -> ff
K (Nat _) -> tt
Var x -> isFin x
t1 :+ t2 -> cryIsFin t1 `mkAnd` cryIsFin t2
t1 :- _ -> cryIsFin t1
t1 :* t2 -> (cryIsFin t1 `mkAnd` cryIsFin t2) `mkOr`
cryIsEq t1 (K $ Nat 0) `mkOr`
cryIsEq t2 (K $ Nat 0)
Div t1 _ -> cryIsFin t1
Mod _ _ -> tt
t1 :^^ t2 -> (cryIsFin t1 `mkAnd` cryIsFin t2) `mkOr`
cryIsEq t1 (K $ Nat 0) `mkOr`
cryIsEq t1 (K $ Nat 1) `mkOr`
cryIsEq t2 (K $ Nat 0)
Min t1 t2 -> (cryIsFin t1 `mkAnd` cryIsGeq t2 t1) `mkOr`
(cryIsFin t2 `mkAnd` cryIsGeq t1 t2)
Max t1 t2 -> cryIsFin t1 `mkAnd` cryIsFin t2
Lg2 t1 -> cryIsFin t1
Width t1 -> cryIsFin t1
LenFromThen _ _ _ -> tt
LenFromThenTo _ _ _ -> tt
-- eliminate Inf terms from finite values
cryNoInf :: Expr -> FM Expr
cryNoInf ty =
case ty of
K Inf :+ _ -> mzero
_ :+ K Inf -> mzero
K Inf :- _ -> mzero
_ :- K Inf -> mzero
K Inf :* t2 -> cryIsEq t2 (K $ Nat 0) >> return (K $ Nat 0)
t1 :* K Inf -> cryIsEq t1 (K $ Nat 0) >> return (K $ Nat 0)
Div (K Inf) _ -> mzero
Div _ (K Inf) -> return $ K $ Nat 0
Mod (K Inf) _ -> mzero
Mod t1 (K Inf) -> cryNoInf t1
K Inf :^^ t2 -> cryIsEq t2 (K $ Nat 0) >> return (K $ Nat 1)
t1 :^^ K Inf -> msum [ cryIsEq t1 (K $ Nat 0) >> return (K $ Nat 0)
, cryIsEq t1 (K $ Nat 1) >> return (K $ Nat 1)
]
Min (K Inf) t2 -> cryNoInf t2
Min t1 (K Inf) -> cryNoInf t1
Max (K Inf) _ -> mzero
Max _ (K Inf) -> mzero
Lg2 (K Inf) -> mzero
Width (K Inf) -> mzero
LenFromThen (K Inf) _ _ -> mzero
LenFromThen _ (K Inf) _ -> mzero
LenFromThen _ _ (K Inf) -> mzero
LenFromThenTo (K Inf) _ _ -> mzero
LenFromThenTo _ (K Inf) _ -> mzero
LenFromThenTo _ _ (K Inf) -> mzero
K Inf -> mzero
_ -> return ty
-- Assumes a finite, and defined input.
mkLin :: Expr -> FM SAT.Expr
mkLin ty0 =
cryNoInf ty0 >>= \ty ->
case ty of
K Inf -> panic "Cryptol.TypeCheck.Solver.CrySAT.mkLin"
[ "K Inf after cryNoInf" ]
K (Nat n) -> return (SAT.K n)
Var x -> isFin x >> return (satVar x)
t1 :+ t2 -> (SAT.:+) <$> mkLin t1 <*> mkLin t2
t1 :- t2 -> (SAT.:-) <$> mkLin t1 <*> mkLin t2
t1 :* t2 -> join $ mkMul <$> mkLin t1 <*> mkLin t2
Div t1 t2 -> join $ mkDiv <$> mkLin t1 <*> mkLin t2
Mod t1 t2 -> join $ mkMod <$> mkLin t1 <*> mkLin t2
t1 :^^ t2 -> join $ mkExp <$> mkLin t1 <*> mkLin t2
Min t1 t2 -> mkMin <$> mkLin t1 <*> mkLin t2
Max t1 t2 -> mkMax <$> mkLin t1 <*> mkLin t2
Lg2 t1 -> join $ mkLg2 <$> mkLin t1
Width t1 -> join $ mkWidth <$> mkLin t1
LenFromThen t1 t2 t3 -> join $ mkLenFromThen <$> mkLin t1
<*> mkLin t2
<*> mkLin t3
LenFromThenTo t1 t2 t3 -> join $ mkLenFromThenTo <$> mkLin t1
<*> mkLin t2
<*> mkLin t3
where
mkMin t1 t2 = SAT.If (t1 SAT.:< t2) t1 t2
mkMax t1 t2 = SAT.If (t1 SAT.:< t2) t2 t1
mkMul t1 t2 =
do mb <- toConst t1
case mb of
Just n -> return (n SAT.:* t2)
Nothing ->
do mb1 <- toConst t2
case mb1 of
Just n -> return (n SAT.:* t1)
Nothing -> do x <- toVar t1
y <- toVar t2
addNonLin (NLMul x y)
mkDiv t1 t2 =
do mb <- toConst t2
case mb of
Just n -> return (SAT.Div t1 n)
Nothing -> do x <- toVar t2
addNonLin (NLDiv t1 x)
mkMod t1 t2 =
do mb <- toConst t2
case mb of
Just n -> return (SAT.Mod t1 n)
Nothing -> do x <- toVar t2
addNonLin (NLMod t1 x)
mkLg2 t1 =
do mb <- toConst t1
case mb of
Just n -> return $ SAT.K $ nLg2 n
Nothing -> do x <- toVar t1
addNonLin (NLLg2 x)
mkWidth t1 = mkLg2 (SAT.K 1 SAT.:+ t1)
mkExp t1 t2 =
do mb <- toConst t1
case mb of
Just n ->
do mb1 <- toConst t2
case mb1 of
Just m -> return $ SAT.K $ n ^ m
Nothing -> do y <- toVar t2
addNonLin (NLExpL n y)
Nothing -> do x <- toVar t1
y <- toVar t2
addNonLin (NLExp x y)
-- derived
mkLenFromThen x y w =
do upTo <- msum [ do addLin (y SAT.:> x)
w1 <- mkExp (SAT.K 2) w
return (w1 SAT.:- SAT.K 1)
, do addLin (x SAT.:> y)
return (SAT.K 0)
]
mkLenFromThenTo x y upTo
mkLenFromThenTo x y z =
msum [ do addLin (x SAT.:> y) -- going down
msum [ addLin (z SAT.:> x) >> return (SAT.K 0)
, addLin (z SAT.:== x) >> return (SAT.K 1)
, do addLin (z SAT.:< x)
t <- mkDiv (x SAT.:- z) (x SAT.:- y)
return (SAT.K 1 SAT.:+ t)
]
, do addLin (x SAT.:< y) -- going up
msum [ addLin (z SAT.:< x) >> return (SAT.K 0)
, addLin (z SAT.:== x) >> return (SAT.K 1)
, do addLin (z SAT.:> x)
t <- mkDiv (z SAT.:- x) (y SAT.:- x)
return (SAT.K 1 SAT.:+ t)
]
]
toConst :: SAT.Expr -> FM (Maybe Integer)
toConst (SAT.K n) = return (Just n)
toConst t = do l <- getLin
case SAT.getExprRange t l of
Nothing -> return Nothing
Just vs -> msum $ map (return . Just) vs
toVar :: SAT.Expr -> FM Name
toVar (SAT.Var x) | Just n <- SAT.fromName x = return $ importName n
toVar e = do x <- newName
addLin (satVar x SAT.:== e)
FM $ sets_ $ \s -> s { waitVars = Set.insert x (waitVars s) }
return x
--------------------------------------------------------------------------------
-- | Rounds up.
-- @lg2 x = y@, iff @y@ is the smallest number such that @x <= 2 ^ y@
nLg2 :: Integer -> Integer
nLg2 0 = 0
nLg2 n = case genLog n 2 of
Just (x,exact) | exact -> x
| otherwise -> x + 1
Nothing -> panic "Cryptol.TypeCheck.Solver.CrySAT.nLg2"
[ "genLog returned Nothing" ]
--------------------------------------------------------------------------------
-- | Compute the logarithm of a number in the given base, rounded down to the
-- closest integer. The boolean indicates if we the result is exact
-- (i.e., True means no rounding happened, False means we rounded down).
-- The logarithm base is the second argument.
genLog :: Integer -> Integer -> Maybe (Integer, Bool)
genLog x 0 = if x == 1 then Just (0, True) else Nothing
genLog _ 1 = Nothing
genLog 0 _ = Nothing
genLog x base = Just (exactLoop 0 x)
where
exactLoop s i
| i == 1 = (s,True)
| i < base = (s,False)
| otherwise =
let s1 = s + 1
in s1 `seq` case divMod i base of
(j,r)
| r == 0 -> exactLoop s1 j
| otherwise -> (underLoop s1 j, False)
underLoop s i
| i < base = s
| otherwise = let s1 = s + 1 in s1 `seq` underLoop s1 (div i base)
cryptol-2.2.6/src/Cryptol/TypeCheck/Solver/Eval.hs 0000644 0000000 0000000 00000036262 12637103426 020217 0 ustar 00 0000000 0000000 -- |
-- Module : $Header$
-- Copyright : (c) 2013-2015 Galois, Inc.
-- License : BSD3
-- Maintainer : cryptol@galois.com
-- Stability : provisional
-- Portability : portable
--
-- We define the behavior of Cryptol's type-level functions on
-- integers.
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE Safe #-}
module Cryptol.TypeCheck.Solver.Eval where
import Cryptol.TypeCheck.AST
import Cryptol.TypeCheck.Solver.InfNat
import Cryptol.TypeCheck.Solver.FinOrd
import Cryptol.TypeCheck.Solver.Interval
import Cryptol.TypeCheck.Solver.Utils(splitConstSummand)
import Data.List(sortBy)
--------------------------------------------------------------------------------
-- Simplify a type
-- NOTE: These functions assume zonked types.
{- DO THIS
-- XXX
reAssocArgs :: OrdFacts -> TFun -> [Type] -> [Type]
reAssocArgs info TCAdd [ t1, TCon (TF TCAdd) [t2, t3]]
| Just t4 <- tfAdd info t1 t2 = reAssocArgs info TCAdd [t4,t3]
reAssocArgs _ TCAdd [ TCon (TF TCAdd) [t1, t2], t3] = [ t1, t2 .+. t3 ]
reAssocArgs info TCMul [ t1, TCon (TF TCMul) [t2, t3]]
| Just t4 <- tfMul info t1 t2 = reAssocArgs info TMul [t4, t3]
reAssocArgs _ TCMul [ TCon (TF TCMul) [t1, t2], t3] = [ t1, t2 .*. t3 ]
reAssocArgs _ _ ts = ts
-}
--------------------------------------------------------------------------------
{- | Collect `fin` and simple `<=` constraints in the ord model
Returns `Left` if we find a goal which is incompatible with the others.
Otherwise, we return `Right` with a model, and the remaining
(i.e., the non-order related) properties.
These sorts of facts are quite useful during type simplification, because
they provide information which potentially useful for cancellation
(e.g., this variables is finite and not 0)
-}
assumedOrderModel :: OrdFacts -> [Prop] ->
Either (OrdFacts,Prop) (OrdFacts, [Prop])
assumedOrderModel m0 todo = go m0 [] False (map (simpType m0) todo)
where
go m others changes []
| changes = assumedOrderModel m others
| otherwise =
case concatMap (derivedOrd m) others of
[] -> Right (m, others)
derived -> case assumedOrderModel m derived of
Left err -> Left err
Right (m1,os) -> Right (m1,os++others)
go m others changes (g : gs) =
case addFact g m of
OrdAlreadyKnown -> go m others changes gs
OrdAdded m1 -> go m1 others True gs
OrdCannot -> go m (g : others) changes gs
OrdImprove t1 t2 -> go m ((t1 =#= t2) : others) changes gs
OrdImpossible -> Left (m,g)
-- | This returns order properties that are implied by the give property.
-- It is important that the returned properties are propoer ordering
-- properties (i.e., `addFact` will not return `OrdCannot`).
derivedOrd :: OrdFacts -> Prop -> [Prop]
derivedOrd m prop =
case prop of
TUser _ _ p -> derivedOrd m p
TCon (PC PGeq) [TVar x, t2] | notSimple t2 -> lowerCt x (typeInterval m t2)
TCon (PC PGeq) [t1,TVar x] | notSimple t1 -> upperCt x (typeInterval m t1)
TCon (PC PEqual) [TVar x, t]
| notSimple t -> equalCt x (typeInterval m t)
TCon (PC PEqual) [t, TVar x]
| notSimple t -> equalCt x (typeInterval m t)
_ -> []
where
notSimple = not . isSimpleType
equalCt x i = lowerCt x i ++ upperCt x i
lowerCt x i = [ TVar x >== fromNat' (lowerBound i) ]
upperCt x i = case upperBound i of
Nat n -> [ tNum n >== TVar x ]
Inf | isFinite i -> [ pFin (TVar x) ]
| otherwise -> []
isSimpleType :: Type -> Bool
isSimpleType (TCon (TC TCInf) _) = True
isSimpleType (TCon (TC (TCNum _)) _) = True
isSimpleType (TVar _) = True
isSimpleType _ = False
--------------------------------------------------------------------------------
-- Performs only forward evaluation.
simpType :: OrdFacts -> Type -> Type
simpType i ty =
case ty of
TUser f ts t -> TUser f (map (simpType i) ts) (simpType i t)
TCon (TF f) ts -> let ts1 = reorderArgs f (map (simpType i) ts)
in case evalTFun i f ts1 of
Nothing -> TCon (TF f) ts1
Just t1 -> simpType i t1
TCon tc ts -> TCon tc (map (simpType i) ts)
TRec fs -> TRec [ (l,simpType i t) | (l,t) <- fs ]
_ -> ty
reorderArgs :: TFun -> [Type] -> [Type]
reorderArgs TCAdd ts = commuteArgs ts
reorderArgs TCMul ts = commuteArgs ts
reorderArgs _ ts = ts
-- Move constants to the front, followed by free variables, followed by
-- bound variables, followed by other expressions.
commuteArgs :: [Type] -> [Type]
commuteArgs = sortBy cmp
where
cmp (TCon (TC (TCNum x)) _) (TCon (TC (TCNum y)) _) = compare x y
cmp (TCon (TC (TCNum _)) _) _ = LT
cmp _ (TCon (TC (TCNum _)) _) = GT
cmp (TCon (TC TCInf) _) (TCon (TC TCInf) _) = EQ
cmp (TCon (TC TCInf) _) _ = LT
cmp _ (TCon (TC TCInf) _) = GT
cmp (TVar x) (TVar y) = compare x y
cmp (TVar _) _ = LT
cmp _ (TVar _) = GT
cmp _ _ = EQ
evalTFun :: OrdFacts -> TFun -> [Type] -> Maybe Type
evalTFun i tfun args =
case (tfun, args) of
(TCAdd, [t1,t2]) -> tfAdd i t1 t2
(TCSub, [t1,t2]) -> tfSub i t1 t2
(TCMul, [t1,t2]) -> tfMul i t1 t2
(TCDiv, [t1,t2]) -> tfDiv i t1 t2
(TCMod, [t1,t2]) -> tfMod i t1 t2
(TCExp, [t1,t2]) -> tfExp i t1 t2
(TCMin, [t1,t2]) -> tfMin i t1 t2
(TCMax, [t1,t2]) -> tfMax i t1 t2
(TCLg2, [t1]) -> tfLg2 i t1
(TCWidth, [t1]) -> tfWidth i t1
(TCLenFromThen, [t1,t2,t3]) -> tfLenFromThen i t1 t2 t3
(TCLenFromThenTo,[t1,t2,t3]) -> tfLenFromThenTo i t1 t2 t3
_ -> Nothing
typeInterval :: OrdFacts -> Type -> Interval
typeInterval i = go . simpType i
where
go ty =
case ty of
TVar {} -> knownInterval i ty
TUser _ _ t -> go t
TCon (TC (TCNum x)) _ -> iConst (Nat x)
TCon (TF f) ts ->
case (f,ts) of
(TCAdd, [t1,t2]) -> iAdd (go t1) (go t2)
(TCSub, [t1,t2]) -> iSub (go t1) (go t2)
(TCMul, [t1,t2]) -> iMul (go t1) (go t2)
(TCDiv, [t1,t2]) -> iDiv (go t1) (go t2)
(TCMod, [t1,t2]) -> iMod (go t1) (go t2)
(TCExp, [t1,t2]) -> iExp (go t1) (go t2)
(TCLg2, [t1]) -> iLg2 (go t1)
(TCWidth, [t1]) -> iWidth (go t1)
(TCLenFromThen, [t1,t2,t3]) -> iLenFromThen (go t1) (go t2) (go t3)
(TCLenFromThenTo,[t1,t2,t3]) -> iLenFromThenTo (go t1) (go t2) (go t3)
_ -> anything
_ -> anything
typeKnownLeq :: OrdFacts -> Type -> Type -> Bool
typeKnownLeq _ _ (TCon (TC TCInf) _) = True
typeKnownLeq _ (TCon (TC (TCNum 0)) _) _ = True
typeKnownLeq _ t1 t2 | t1 == t2 = True
typeKnownLeq m t1 t2 | upperBound i1 <= lowerBound i2 = True
where i1 = typeInterval m t1
i2 = typeInterval m t2
typeKnownLeq _ t1 t2
| Just (_,t2') <- splitConstSummand t2, t1 == t2' = True
typeKnownLeq m t1 t2 = isKnownLeq m t1 t2
typeKnownFin :: OrdFacts -> Type -> Bool
typeKnownFin m t = isFinite (typeInterval m t)
--------------------------------------------------------------------------------
tfAdd :: OrdFacts -> Type -> Type -> Maybe Type
tfAdd m t1 t2
| Just Inf <- arg1 = Just tInf
| Just (Nat 0) <- arg1 = Just t2
| Just Inf <- arg2 = Just tInf
| Just (Nat 0) <- arg2 = Just t1
| Just (Nat x) <- arg1
, Just (Nat y) <- arg2 = Just $ tNum $ x + y
-- k1 + (k2 + t) = (k1 + k1) + t
| Just (Nat k1) <- arg1
, TCon (TF TCAdd) [ s1, s2 ] <- tNoUser t2
, Just (Nat k2) <- toNat' s1 = Just $ tNum (k1 + k2) .+. s2
-- Simplification for `k1 + (t - k2)`
-- This is only OK as long as we know that `t - k2` is well-defined.
| Just (Nat x) <- arg1
, TCon (TF TCSub) [ s1, s2 ] <- t2
, Just (Nat y) <- toNat' s2
, let i = lowerBound (typeInterval m s1)
, i >= Nat y = Just (if x >= y then tNum (x - y) .+. s1
else s1 .-. tNum (y - x))
-- a + a = 2 * a
| t1 == t2 = Just (tNum (2 :: Int) .*. t1)
-- k * a + a = (k + 1) * a
| TCon (TF TCMul) [s1,s2] <- tNoUser t1
, Just x <- toNat' s1
, s2 == t2 = factorConst x (Nat 1) t2
-- a + k * a = (k + 1) * a
| TCon (TF TCMul) [s1,s2] <- tNoUser t2
, Just x <- toNat' s1
, s2 == t1 = factorConst x (Nat 1) t1
-- k1 * a + k2 * a = (k1 + k1) * a
| TCon (TF TCMul) [s1,s2] <- tNoUser t1
, Just x <- toNat' s1
, TCon (TF TCMul) [p1,p2] <- tNoUser t2
, Just y <- toNat' p1
, s2 == p2 = factorConst x y p1
| otherwise = Nothing
where arg1 = toNat' t1
arg2 = toNat' t2
factorConst k1 k2 t = Just $ fromNat' (nAdd k1 k2) .*. t
{- | @tfSub x y = Just z@ iff @z@ is the unique value such that
@tfAdd y z = Just x@ -}
tfSub :: OrdFacts -> Type -> Type -> Maybe Type
tfSub i t1 t2
| Just (Nat 0) <- arg2 = Just t1
| Just Inf <- arg1
, typeKnownFin i t2 = Just tInf
-- k1 - k2
| Just (Nat x) <- arg1
, Just (Nat y) <- arg2
, x >= y = Just $ tNum (x - y)
-- (x - y) - z = x - (y + z)
| TCon (TF TCSub) [s1,s2] <- t1 = Just (s1 .-. (s2 .+. t2))
-- (k1 + t) - k2
| TCon (TF TCAdd) [s1,s2] <- t1
, Just k1 <- toNat' s1
, Just k2 <- arg2 = case (nSub k1 k2, nSub k2 k1) of
-- = (k1 - k2) + t
(Just a, _) -> Just (fromNat' a .+. s2)
-- = t - (k2 - k1)
(_, Just a) -> Just (s2 .-. fromNat' a)
_ -> Nothing
| otherwise = Nothing
where arg1 = toNat' t1
arg2 = toNat' t2
-- | It is important that the 0 rules come before the `Inf` ones
tfMul :: OrdFacts -> Type -> Type -> Maybe Type
tfMul i t1 t2
| Just (Nat 0) <- arg1 = Just t1
| Just (Nat 1) <- arg1 = Just t2
| Just (Nat 0) <- arg2 = Just t2
| Just (Nat 1) <- arg2 = Just t1
| Just Inf <- arg1
, oneOrMore i t2 = Just tInf
| Just Inf <- arg2
, oneOrMore i t1 = Just tInf
| Just (Nat x) <- arg1
, Just (Nat y) <- arg2 = Just $ tNum $ x * y
-- k1 * (k2 * t) = (k1 * k2) * t
| Just k1 <- arg1
, TCon (TF TCMul) [s1,s2] <- t2
, Just k2 <- toNat' s1 = Just $ fromNat' (nMul k1 k2) .*. s2
| otherwise = Nothing
where arg1 = toNat' t1
arg2 = toNat' t2
{- y * q + r = x
x / y = q with remainder r
0 <= r && r < y -}
tfDiv :: OrdFacts -> Type -> Type -> Maybe Type
tfDiv i t1 t2
| Just (Nat 1) <- arg2 = Just t1
| Just Inf <- arg2
, typeKnownFin i t1 = Just $ tNum (0 :: Int)
| Just (Nat 0) <- arg1
, Nat 1 <= lowerBound iT2 = Just $ tNum (0 :: Int)
| Just Inf <- arg1
, Nat 1 <= lowerBound iT2 &&
isFinite iT2 = Just tInf
| Just (Nat x) <- arg1
, Just (Nat y) <- arg2
, 1 <= y = Just $ tNum $ div x y
-- (k1 * t) / k2 = (k1/k2) * t , as long as the division is exact
| TCon (TF TCMul) [ s1, s2 ] <- tNoUser t1
, Just k1 <- toNat' s1
, Just k2 <- arg2
, Just res <- nDiv k1 k2 = Just $ fromNat' res .*. s2
| otherwise = Nothing
where arg1 = toNat' t1
arg2 = toNat' t2
iT2 = knownInterval i t2
tfMod :: OrdFacts -> Type -> Type -> Maybe Type
tfMod i t1 t2
| Just (Nat 1) <- arg2 = Just $ tNum (0 :: Int)
| Just Inf <- arg2
, typeKnownFin i t1 = Just t1
| Just (Nat 0) <- arg1
, Nat 1 <= lowerBound iT2 = Just $ tNum (0 :: Int)
-- There is no unique remainder in the case when we are dividing
-- @Inf@ by a natural number.
| Just (Nat x) <- arg1
, Just (Nat y) <- arg2
, 1 <= y = Just $ tNum $ mod x y
| otherwise = Nothing
where arg1 = toNat' t1
arg2 = toNat' t2
iT2 = knownInterval i t2
tfMin :: OrdFacts -> Type -> Type -> Maybe Type
tfMin i t1 t2
| typeKnownLeq i t1 t2 = Just t1
| typeKnownLeq i t2 t1 = Just t2
| otherwise = Nothing
tfMax :: OrdFacts -> Type -> Type -> Maybe Type
tfMax i t1 t2
| typeKnownLeq i t1 t2 = Just t2
| typeKnownLeq i t2 t1 = Just t1
| otherwise = Nothing
-- x ^ 0 = 1
-- x ^ (n + 1) = x * (x ^ n)
-- x ^ (m + n) = (x ^ m) * (x ^ n)
-- x ^ (m * n) = (x ^ m) ^ n
tfExp :: OrdFacts -> Type -> Type -> Maybe Type
tfExp i t1 t2
| Just (Nat 0) <- arg1
, oneOrMore i t2 = Just $ tNum (0 :: Int)
| Just (Nat 1) <- arg1 = Just $ tNum (1 :: Int)
| Just Inf <- arg1
, oneOrMore i t2 = Just tInf
| Just (Nat 0) <- arg2 = Just $ tNum (1 :: Int)
| Just (Nat 1) <- arg2 = Just t1
| Just Inf <- arg2
, twoOrMore i t1 = Just tInf
| Just (Nat x) <- arg1
, Just (Nat y) <- arg2 = Just $ tNum $ x ^ y
| otherwise = Nothing
where arg1 = toNat' t1
arg2 = toNat' t2
-- | Rounds up
-- @lg2 x = Just y@, if @y@ is the smallest number such that @x <= 2 ^ y@
tfLg2 :: OrdFacts -> Type -> Maybe Type
tfLg2 _ t
| Just (Nat 0) <- arg = Just $ tNum (0 :: Int) -- XXX: should this be defined?
| Just (Nat x) <- arg = do (n,exact) <- genLog x 2
return $ tNum $ if exact then n else n + 1
| Just Inf <- arg = Just tInf
| otherwise = Nothing
where arg = toNat' t
-- | XXX: @width@ and @lg2@ are almost the same!
-- @width n == lg2 (n + 1)@
tfWidth :: OrdFacts -> Type -> Maybe Type
-- width (2 ^ a - 1) = a
tfWidth _ ty
| TCon (TF TCSub) [ t1, TCon (TC (TCNum 1)) _ ] <- ty
, TCon (TF TCExp) [ TCon (TC (TCNum 2)) _, t2 ] <- t1 = Just t2
tfWidth _ t
| Just (Nat x) <- arg = return $ tNum (widthInteger x)
| Just Inf <- arg = Just tInf
| otherwise = Nothing
where arg = toNat' t
-- len [ t1, t2 .. ] : [_][t3]
tfLenFromThen :: OrdFacts -> Type -> Type -> Type -> Maybe Type
tfLenFromThen i t1 t2 t3
-- (t2 >= t1) => len [ t1, t2 .. ] = len [ t1, t2, .. 0 ]
| typeKnownLeq i t2 t1 = tfLenFromThenTo i t1 t2 (tNum (0 :: Int))
| Just x <- arg1
, Just y <- arg2
, Just z <- arg3 = fmap fromNat' (nLenFromThen x y z)
| otherwise = Nothing
where
arg1 = toNat' t1
arg2 = toNat' t2
arg3 = toNat' t3
tfLenFromThenTo :: OrdFacts -> Type -> Type -> Type -> Maybe Type
tfLenFromThenTo _ t1 t2 t3
| Just x <- toNat' t1
, Just y <- toNat' t2
, Just z <- toNat' t3 = fmap fromNat' (nLenFromThenTo x y z)
| otherwise = Nothing
--------------------------------------------------------------------------------
toNat' :: Type -> Maybe Nat'
toNat' ty =
case ty of
TUser _ _ t -> toNat' t
TCon (TC TCInf) _ -> Just Inf
TCon (TC (TCNum x)) _ -> Just (Nat x)
_ -> Nothing
fromNat' :: Nat' -> Type
fromNat' Inf = tInf
fromNat' (Nat x) = tNum x
oneOrMore :: OrdFacts -> Type -> Bool
oneOrMore i t = typeKnownLeq i (tNum (1::Int)) t
twoOrMore :: OrdFacts -> Type -> Bool
twoOrMore i t = typeKnownLeq i (tNum (2::Int)) t
cryptol-2.2.6/src/Cryptol/TypeCheck/Solver/FinOrd.hs 0000644 0000000 0000000 00000042061 12637103426 020503 0 ustar 00 0000000 0000000 -- |
-- Module : $Header$
-- Copyright : (c) 2013-2015 Galois, Inc.
-- License : BSD3
-- Maintainer : cryptol@galois.com
-- Stability : provisional
-- Portability : portable
--
-- This module contains machinery to reason about ordering of
-- variables, their finiteness, and their possible intervals.
{-# LANGUAGE Safe #-}
{-# LANGUAGE PatternGuards, TypeSynonymInstances #-}
module Cryptol.TypeCheck.Solver.FinOrd
( OrdFacts, AssertResult(..)
, noFacts, addFact
, isKnownLeq
, knownInterval
, ordFactsToGoals
, ordFactsToProps
, dumpDot
, dumpDoc
, IsFact(..)
) where
import Cryptol.TypeCheck.Solver.InfNat
import Cryptol.TypeCheck.Solver.Interval
import Cryptol.TypeCheck.AST
import Cryptol.TypeCheck.InferTypes
import Cryptol.TypeCheck.TypeMap
import Cryptol.Parser.Position
import qualified Cryptol.Utils.Panic as P
import Cryptol.Utils.PP(Doc,pp,vcat,text,(<+>))
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Map (Map)
import qualified Data.Map as Map
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import Data.Maybe(fromMaybe,maybeToList)
import Control.Monad(guard)
-- Please change this, if renaming the module.
panic :: String -> [String] -> a
panic x y = P.panic ("Cryptol.TypeCheck.Solver.FinOrd." ++ x) y
-- | Add a `(>=)` or `fin` goal into the model.
-- Assumes that the types are normalized (i.e., no type functions).
class IsFact t where
factProp :: t -> Prop
factChangeProp :: t -> Prop -> t
factSource :: t -> EdgeSrc
instance IsFact Goal where
factProp = goal
factChangeProp g p = g { goal = p }
factSource g = FromGoal (goalSource g) (goalRange g)
instance IsFact Prop where
factProp = id
factChangeProp _ x = x
factSource _ = NoGoal
addFact :: IsFact t => t -> OrdFacts -> AssertResult
addFact g m =
case tNoUser (factProp g) of
TCon (PC PFin) [t] ->
let (x,m1) = nameTerm m t
in insertFin src x m1
TCon (PC PGeq) [t1,t2] ->
let (x,m1) = nameTerm m t1
(y,m2) = nameTerm m1 t2
in insertLeq src y x m2
_ -> OrdCannot
where
src = factSource g
-- | Possible outcomes, when asserting a fact.
data AssertResult
= OrdAdded OrdFacts -- ^ We added a new fact
| OrdAlreadyKnown -- ^ We already knew this
| OrdImprove Type Type -- ^ Only if the two types are equal
| OrdImpossible -- ^ The fact is known to be false
| OrdCannot -- ^ We could not perform opertaion.
deriving Show
-- | Query if the one type is known to be smaller than, or equal to, the other.
-- Assumes that the type is simple (i.e., no type functions).
isKnownLeq :: OrdFacts -> Type -> Type -> Bool
isKnownLeq m t1 t2 =
let (x,m1) = nameTerm m t1
(y,m2) = nameTerm m1 t2
in isLeq m2 x y
-- | Compute an interval, that we know definately contains the given type.
-- Assumes that the type is normalized (i.e., no type functions).
knownInterval :: OrdFacts -> Type -> Interval
knownInterval m t =
fromMaybe anything $
do a <- numType t
return $
case (cvtLower (getLowerBound m a), cvtUpper (getUpperBound m a)) of
(x,(y,z)) -> Interval { lowerBound = x
, upperBound = y
, isFinite = z
}
where
cvtLower (Nat'' x) = Nat x
cvtLower FinNat'' = panic "knownInterval"
[ "`FinNat` used as a lower bound for:"
, show t
]
cvtLower Inf'' = Inf
cvtUpper (Nat'' x) = (Nat x, True)
cvtUpper FinNat'' = (Inf, True)
cvtUpper Inf'' = (Inf, False)
ordFactsToGoals :: OrdFacts -> [Goal]
ordFactsToGoals = ordFactsToList onlyGoals
where
onlyGoals (FromGoal c r) = Just $ \p -> Goal { goalSource = c
, goalRange = r
, goal = p }
onlyGoals NoGoal = Nothing
ordFactsToProps :: OrdFacts -> [Prop]
ordFactsToProps = ordFactsToList (\_ -> Just id)
ordFactsToList :: (EdgeSrc -> Maybe (Prop -> a)) -> OrdFacts -> [a]
ordFactsToList consider (OrdFacts m ts) = concatMap getGoals (Map.toList m)
where
getGoals (ty, es) =
do (lower,notNum) <-
case ty of
NTNat FinNat'' -> []
NTNat Inf'' -> []
NTNat (Nat'' n) -> guard (n > 0) >> [ (tNum n, False) ]
NTVar v -> [ (TVar v, True) ]
NTNamed x -> [ (getNamed x, True) ]
Edge { target = t, eSource = src } <- Set.toList (above es)
f <- maybeToList (consider src)
g <- case t of
NTNat FinNat'' -> guard notNum >> [ pFin lower ]
NTNat Inf'' -> []
NTNat (Nat'' n) -> guard notNum >> [ tNum n >== lower ]
NTVar x -> [ TVar x >== lower ]
NTNamed x -> [ getNamed x >== lower ]
return (f g)
getNamed x = case IntMap.lookup x (nameToType ts) of
Just t -> t
Nothing -> panic "ordFactsToList" [ "Missing name" ]
--------------------------------------------------------------------------------
data OrdFacts = OrdFacts (Map NumType Edges) OrdTerms
deriving Show
-- | Names for non-primitive terms
data OrdTerms = OrdTerms
{ typeToName :: TypeMap Int
-- ^ Maps terms to their name
, nameToType :: IntMap Type
-- ^ Maps names to terms
, nextId :: Int -- ^ For naming new terms.
} deriving Show
data Edges = Edges { above :: Set Edge, below :: Set Edge }
deriving Show
data Edge = Edge { target :: NumType, eSource :: EdgeSrc }
deriving Show
-- | Where did this edge come from?
-- This is used so that we can turn edges back into goals.
data EdgeSrc = FromGoal ConstraintSource Range
| NoGoal
deriving Show
instance Eq Edge where
x == y = target x == target y
instance Ord Edge where
compare x y = compare (target x) (target y)
{- | A varaation on `Nat'`, which allows us to support `fin` constraints:
we add an extra element `FinNat''`, which is larger than all natural numbers,
but smaller than infinity. Then, we can express `fin t` as `t <= fin`.
This is only internal to the implementation and is not visible outside
this module. -}
data Nat'' = Nat'' Integer
| FinNat'' -- Upper bound for known finite
| Inf''
deriving (Eq,Ord,Show)
-- NOTE: It is important that constants come before variables in the
-- ordering (used in `insNode`)
data NumType = NTNat Nat'' | NTVar TVar | NTNamed Int
deriving (Eq,Ord,Show)
nameTerm :: OrdFacts -> Type -> (NumType, OrdFacts)
nameTerm fs t | Just n <- numType t = (n, fs)
nameTerm fs@(OrdFacts xs ts) t =
case lookupTM t (typeToName ts) of
Just n -> (NTNamed n, fs)
Nothing ->
let name = nextId ts
ts1 = OrdTerms { nameToType = IntMap.insert name t (nameToType ts)
, typeToName = insertTM t name (typeToName ts)
, nextId = name + 1
}
in (NTNamed name, OrdFacts xs ts1)
zero :: NumType
zero = NTNat (Nat'' 0)
-- | A finite number larger than all ordinary numbers.
-- Used to represent `fin` predicates.
fin :: NumType
fin = NTNat FinNat''
inf :: NumType
inf = NTNat Inf''
numType :: Type -> Maybe NumType
numType ty =
case tNoUser ty of
TCon (TC (TCNum n)) _ -> Just $ NTNat $ Nat'' n
TCon (TC TCInf) _ -> Just $ NTNat $ Inf''
TVar x | kindOf x == KNum -> Just $ NTVar x
_ -> Nothing
fromNumType :: OrdTerms -> NumType -> Maybe Type
fromNumType _ (NTVar x) = Just (TVar x)
fromNumType _ (NTNat Inf'') = Just tInf
fromNumType _ (NTNat FinNat'') = Nothing
fromNumType _ (NTNat (Nat'' x)) = Just (tNum x)
fromNumType ts (NTNamed x) = IntMap.lookup x (nameToType ts)
isVar :: NumType -> Bool
isVar (NTVar _) = True
isVar (NTNamed _) = True
isVar (NTNat _) = False
noFacts :: OrdFacts
noFacts = snd $ insNode inf
$ snd $ insNode fin
$ snd $ insNode zero
$ OrdFacts Map.empty OrdTerms { typeToName = emptyTM
, nameToType = IntMap.empty
, nextId = 0
}
noEdges :: Edges
noEdges = Edges { above = Set.empty, below = Set.empty }
-- | Get the edges immediately above or bellow a node.
imm :: (Edges -> Set Edge) -> OrdFacts -> NumType -> Set Edge
imm dir (OrdFacts m _) t = maybe Set.empty dir (Map.lookup t m)
-- Try to find a path from one node to another.
reachable :: OrdFacts -> NumType -> NumType -> Bool
reachable m smaller larger =
search Set.empty (Set.singleton Edge { target = smaller, eSource = NoGoal })
where
search visited todo
| Just (Edge { target = term }, rest) <- Set.minView todo =
if term == larger
then True
else let new = imm above m term
vis = Set.insert term visited
notDone = Set.filter (not . (`Set.member` vis) . target)
in search vis (notDone new `Set.union` notDone rest)
| otherwise = False
{-
The linking function is a bit complex because we keep the ordering database
minimal.
This diagram illustrates what we do when we link two nodes (`link`).
We start with a situation like on the left, and we are adding an
edge from L to U. The final result is illustrated on the right.
Before After
a a
/| /
/ | /
U | U\
| L \L
| / /
|/ /
d d
L: lower
U: upper
a: a member of "above uedges" (uus)
d: a member of "below ledges" (lls)
-}
{- XXX: It would be useful to return the edges that were removed because these
edges can be solved in term of the existing facts, so if some of them correspond
to wanted constrainst we can discharge them straight aways. We still get
the same effect in `reExamineWanteds` but in a much less effecieant way. -}
link :: EdgeSrc -> (NumType,Edges) -> (NumType,Edges)
-> OrdFacts -> (Edges,Edges,OrdFacts)
link src (lower, ledges) (upper, uedges) m0 =
let uus = Set.mapMonotonic target (above uedges)
lls = Set.mapMonotonic target (below ledges)
rm x = Set.filter (not . (`Set.member` x) . target)
{- As soon as we insert someghing above a node, we remove any
links to `Inf''` because, inductively, the thing above will
already be connected -}
newLedges = ledges { above = Set.insert Edge { target = upper
, eSource = src }
$ rm (Set.insert inf uus) -- see comment
$ above ledges
}
newUedges = uedges { below = Set.insert Edge { target = lower
, eSource = src }
$ rm lls
$ below uedges
}
del x = Set.delete Edge { target = x, eSource = NoGoal }
adjust f t (OrdFacts m xs) = OrdFacts (Map.adjust f t m) xs
insert k x (OrdFacts m xs) = OrdFacts (Map.insert k x m) xs
adjAbove = adjust (\e -> e { above = del upper (above e) })
adjBelow = adjust (\e -> e { below = del lower (below e) })
fold f xs x = Set.fold f x xs
in ( newLedges
, newUedges
, insert lower newLedges
$ insert upper newUedges
$ fold adjAbove lls
$ fold adjBelow uus
m0
)
-- | Insert a new node in a collection of facts.
-- Returns the edges surrounding the new node.
-- * Variable nodes are always linked to 0 and Inf'' (directly or indirectly).
-- * Constant nodes are always linked to neighbouring constant nodes.
insNode :: NumType -> OrdFacts -> (Edges, OrdFacts)
insNode t model@(OrdFacts m0 xs) =
case Map.splitLookup t m0 of
(_, Just r, _) -> (r, model)
(left, Nothing, right) ->
let m1 = OrdFacts (Map.insert t noEdges m0) xs
in if isVar t
-- New variabeles are always linkes to 0 and inf.
then
case Map.lookup zero m0 of
Just zes ->
let (_,es1,m2@(OrdFacts m2M _)) = link NoGoal (zero,zes) (t,noEdges) m1
in case Map.lookup inf m2M of
Just ies ->
let (es2,_,m3) = link NoGoal (t,es1) (inf,ies) m2
in (es2,m3)
Nothing -> panic "insNode"
[ "infinity is missing from the model"
, show m0
]
Nothing -> panic "insNode"
[ "0 is missing from the model"
, show m0
]
-- Constants are linked to their neighbours.
else
-- link to a smaller constnat, if any
let ans2@(es2, m2) =
case toNum Map.findMax left of
Nothing -> (noEdges,m1)
Just l ->
let (_,x,y) = link NoGoal l (t,noEdges) m1
in (x,y)
-- link to a larger constant, if any
in case toNum Map.findMin right of
Nothing -> ans2
Just u ->
let (x,_,y) = link NoGoal (t,es2) u m2
in (x,y)
where
toNum f x = do guard (not (Map.null x))
let it@(n,_) = f x
guard (not (isVar n))
return it
isLeq :: OrdFacts -> NumType -> NumType -> Bool
isLeq m t1 t2 = reachable m2 t1 t2
where (_,m1) = insNode t1 m
(_,m2) = insNode t2 m1
insertLeq :: EdgeSrc -> NumType -> NumType -> OrdFacts -> AssertResult
insertLeq _ (NTNat Inf'') (NTNat Inf'') _ = OrdAlreadyKnown
insertLeq _ (NTNat Inf'') (NTNat FinNat'') _ = OrdImpossible
insertLeq _ (NTNat Inf'') (NTNat (Nat'' _)) _ = OrdImpossible
insertLeq _ (NTNat FinNat'') (NTNat Inf'') _ = OrdAlreadyKnown
insertLeq _ (NTNat FinNat'') (NTNat FinNat'') _ = OrdAlreadyKnown -- can't happen
insertLeq _ (NTNat FinNat'') (NTNat (Nat'' _)) _= OrdImpossible -- ditto
insertLeq _ (NTNat (Nat'' _)) (NTNat Inf'') _ = OrdAlreadyKnown
insertLeq _ (NTNat (Nat'' _)) (NTNat FinNat'') _ = OrdAlreadyKnown
insertLeq _ (NTNat (Nat'' x)) (NTNat (Nat'' y)) _
| x <= y = OrdAlreadyKnown
| otherwise = OrdImpossible
insertLeq src t1 t2 m0
| reachable m2 t2 t1 = case (fromNumType terms t1, fromNumType terms t2) of
(Just a, Just b) -> OrdImprove a b
_ -> OrdCannot -- should not happen
| otherwise =
if reachable m2 t1 t2
then OrdAlreadyKnown
else let (_,_,m3) = link src (t1,n1) (t2,n2) m2
in OrdAdded m3
where (_,m1) = insNode t1 m0
(n2,m2@(OrdFacts m2M terms)) = insNode t2 m1
Just n1 = Map.lookup t1 m2M
insertFin :: EdgeSrc -> NumType -> OrdFacts -> AssertResult
insertFin src t m = insertLeq src t (NTNat FinNat'') m
getLowerBound :: OrdFacts -> NumType -> Nat''
getLowerBound _ (NTNat n) = n
getLowerBound fs@(OrdFacts m _) t =
case Map.lookup t m of
Nothing -> Nat'' 0
Just es -> case map (getLowerBound fs . target) $ Set.toList $ below es of
[] -> Nat'' 0
xs -> maximum xs
getUpperBound :: OrdFacts -> NumType -> Nat''
getUpperBound _ (NTNat n) = n
getUpperBound fs@(OrdFacts m _) t =
case Map.lookup t m of
Nothing -> Inf''
Just es -> case map (getUpperBound fs . target) $ Set.toList $ above es of
[] -> Inf''
xs -> minimum xs
--------------------------------------------------------------------------------
-- Testing
-- | Render facts in `dot` notation. The boolean says if we want the arrows
-- to point up.
dumpDot :: Bool -> OrdFacts -> String
dumpDot isUp (OrdFacts m _) = "digraph {" ++ concatMap edges (Map.toList m) ++ "}"
where
edge x e = x ++ " -> " ++ node (target e) ++ "[color=\"blue\"];"
dir = if isUp then above else below
edges (x,es) = let n = node x
in n ++ ";" ++
concatMap (edge n) (Set.toList (dir es))
node (NTNat (Nat'' x)) = show (show x)
node (NTNat FinNat'') = show "fin"
node (NTNat Inf'') = show "inf"
node (NTVar (TVFree x _ _ _)) = show ("?v" ++ show x)
node (NTVar (TVBound x _)) = show ("v" ++ show x)
node (NTNamed x) = show ("<" ++ show x ++ ">")
dumpDoc :: OrdFacts -> Doc
dumpDoc = vcat . ordFactsToList mk
where
mk src = Just $ \x -> case src of
NoGoal -> text "[G]" <+> pp x
FromGoal {} -> text "[W]" <+> pp x
cryptol-2.2.6/src/Cryptol/TypeCheck/Solver/InfNat.hs 0000644 0000000 0000000 00000012101 12637103426 020471 0 ustar 00 0000000 0000000 -- |
-- Module : $Header$
-- Copyright : (c) 2013-2015 Galois, Inc.
-- License : BSD3
-- Maintainer : cryptol@galois.com
-- Stability : provisional
-- Portability : portable
--
-- This module defines natural numbers with an additional infinity
-- element, and various arithmetic operators on them.
{-# LANGUAGE Safe #-}
module Cryptol.TypeCheck.Solver.InfNat where
import Data.Bits
import Cryptol.Utils.Panic
-- | Natural numbers with an infinity element
data Nat' = Nat Integer | Inf
deriving (Show,Eq,Ord)
fromNat :: Nat' -> Maybe Integer
fromNat n' =
case n' of
Nat i -> Just i
_ -> Nothing
nAdd :: Nat' -> Nat' -> Nat'
nAdd Inf _ = Inf
nAdd _ Inf = Inf
nAdd (Nat x) (Nat y) = Nat (x + y)
{-| Some algerbaic properties of interest:
> 1 * x = x
> x * (y * z) = (x * y) * z
> 0 * x = 0
> x * y = y * x
> x * (a + b) = x * a + x * b
-}
nMul :: Nat' -> Nat' -> Nat'
nMul (Nat 0) _ = Nat 0
nMul _ (Nat 0) = Nat 0
nMul Inf _ = Inf
nMul _ Inf = Inf
nMul (Nat x) (Nat y) = Nat (x * y)
{-| Some algeibraic properties of interest:
> x ^ 0 = 1
> x ^ (n + 1) = x * (x ^ n)
> x ^ (m + n) = (x ^ m) * (x ^ n)
> x ^ (m * n) = (x ^ m) ^ n
-}
nExp :: Nat' -> Nat' -> Nat'
nExp _ (Nat 0) = Nat 1
nExp Inf _ = Inf
nExp (Nat 0) Inf = Nat 0
nExp (Nat 1) Inf = Nat 1
nExp (Nat _) Inf = Inf
nExp (Nat x) (Nat y) = Nat (x ^ y)
nMin :: Nat' -> Nat' -> Nat'
nMin Inf x = x
nMin x Inf = x
nMin (Nat x) (Nat y) = Nat (min x y)
nMax :: Nat' -> Nat' -> Nat'
nMax Inf _ = Inf
nMax _ Inf = Inf
nMax (Nat x) (Nat y) = Nat (max x y)
{- | @nSub x y = Just z@ iff @z@ is the unique value
such that @Add y z = Just x@. -}
nSub :: Nat' -> Nat' -> Maybe Nat'
nSub Inf (Nat _) = Just Inf
nSub (Nat x) (Nat y)
| x >= y = Just (Nat (x - y))
nSub _ _ = Nothing
{- | Rounds down.
> y * q + r = x
> x / y = q with remainder r
> 0 <= r && r < y
We don't allow `Inf` in the first argument for two reasons:
1. It matches the behavior of `nMod`,
2. The well-formedness constraints can be expressed as a conjunction.
-}
nDiv :: Nat' -> Nat' -> Maybe Nat'
nDiv _ (Nat 0) = Nothing
nDiv Inf _ = Nothing
nDiv (Nat x) (Nat y) = Just (Nat (div x y))
nDiv (Nat _) Inf = Just (Nat 0)
nMod :: Nat' -> Nat' -> Maybe Nat'
nMod _ (Nat 0) = Nothing
nMod Inf _ = Nothing
nMod (Nat x) (Nat y) = Just (Nat (mod x y))
nMod (Nat x) Inf = Just (Nat x) -- inf * 0 + x = 0 + x
-- | Rounds up.
-- @lg2 x = y@, iff @y@ is the smallest number such that @x <= 2 ^ y@
nLg2 :: Nat' -> Nat'
nLg2 Inf = Inf
nLg2 (Nat 0) = Nat 0
nLg2 (Nat n) = case genLog n 2 of
Just (x,exact) | exact -> Nat x
| otherwise -> Nat (x + 1)
Nothing -> panic "Cryptol.TypeCheck.Solver.InfNat.nLg2"
[ "genLog returned Nothing" ]
-- | @nWidth n@ is number of bits needed to represent all numbers
-- from 0 to n, inclusive. @nWidth x = nLg2 (x + 1)@.
nWidth :: Nat' -> Nat'
nWidth Inf = Inf
nWidth (Nat n) = Nat (widthInteger n)
nLenFromThen :: Nat' -> Nat' -> Nat' -> Maybe Nat'
nLenFromThen a@(Nat x) b@(Nat y) (Nat w)
| y > x = nLenFromThenTo a b (Nat (2^w - 1))
| y < x = nLenFromThenTo a b (Nat 0)
nLenFromThen _ _ _ = Nothing
nLenFromThenTo :: Nat' -> Nat' -> Nat' -> Maybe Nat'
nLenFromThenTo (Nat x) (Nat y) (Nat z)
| step /= 0 = let len = div dist step + 1
in Just $ Nat $ max 0 (if x > y then if z > x then 0 else len
else if z < x then 0 else len)
where
step = abs (x - y)
dist = abs (x - z)
nLenFromThenTo _ _ _ = Nothing
--------------------------------------------------------------------------------
-- | Compute the logarithm of a number in the given base, rounded down to the
-- closest integer. The boolean indicates if we the result is exact
-- (i.e., True means no rounding happened, False means we rounded down).
-- The logarithm base is the second argument.
genLog :: Integer -> Integer -> Maybe (Integer, Bool)
genLog x 0 = if x == 1 then Just (0, True) else Nothing
genLog _ 1 = Nothing
genLog 0 _ = Nothing
genLog x base = Just (exactLoop 0 x)
where
exactLoop s i
| i == 1 = (s,True)
| i < base = (s,False)
| otherwise =
let s1 = s + 1
in s1 `seq` case divMod i base of
(j,r)
| r == 0 -> exactLoop s1 j
| otherwise -> (underLoop s1 j, False)
underLoop s i
| i < base = s
| otherwise = let s1 = s + 1 in s1 `seq` underLoop s1 (div i base)
-- | Compute the number of bits required to represent the given integer.
widthInteger :: Integer -> Integer
widthInteger x = go' 0 (if x < 0 then complement x else x)
where
go s 0 = s
go s n = let s' = s + 1 in s' `seq` go s' (n `shiftR` 1)
go' s n
| n < bit 32 = go s n
| otherwise = let s' = s + 32 in s' `seq` go' s' (n `shiftR` 32)
cryptol-2.2.6/src/Cryptol/TypeCheck/Solver/Interval.hs 0000644 0000000 0000000 00000012374 12637103426 021112 0 ustar 00 0000000 0000000 -- |
-- Module : $Header$
-- Copyright : (c) 2013-2015 Galois, Inc.
-- License : BSD3
-- Maintainer : cryptol@galois.com
-- Stability : provisional
-- Portability : portable
--
-- This module defines intervals and interval arithmetic.
{-# LANGUAGE Safe #-}
module Cryptol.TypeCheck.Solver.Interval
( Interval(..)
, anything
, iConst
, iAdd, iMul, iExp
, iMin, iMax
, iLg2, iWidth
, iSub, iDiv, iMod
, iLenFromThen, iLenFromTo, iLenFromThenTo
, iLeq, iLt, iDisjoint
) where
import Cryptol.TypeCheck.Solver.InfNat
{- | Representation of intervals.
Intervals always include the lower bound.
Intervals include the upper bound if:
* either the upper bound is finite, or
* the upper bound is 'Inf' and @isFinite == False@.
Invariant: if the upper bound is finite, then `isFinite == True`.
> [x,y] Interval (Nat x) (Nat y) True
> [x,inf] Interval (Nat x) Inf False
> [x,inf) Interval (Nat x) Inf True
-}
data Interval = Interval
{ lowerBound :: Nat' -- ^ Lower bound
, upperBound :: Nat' -- ^ Upper bound
, isFinite :: Bool -- ^ Do we know this to be a finite value.
-- Note that for @[inf,inf]@ this field is `False`
-- (i.e., this field is not talking about the size of the interval,
-- but, rather, about if it contains infinity).
} deriving Show
-- | Any possible value.
anything :: Interval
anything = Interval { lowerBound = Nat 0
, upperBound = Inf
, isFinite = False
}
anyFinite :: Interval
anyFinite = anything { isFinite = True }
iConst :: Nat' -> Interval
iConst x = Interval { lowerBound = x, upperBound = x, isFinite = x < Inf }
iAdd :: Interval -> Interval -> Interval
iAdd = liftMono2 nAdd (&&)
iMul :: Interval -> Interval -> Interval
iMul = liftMono2 nMul (&&)
iMin :: Interval -> Interval -> Interval
iMin = liftMono2 nMin (||)
iMax :: Interval -> Interval -> Interval
iMax = liftMono2 nMax (&&)
iLg2 :: Interval -> Interval
iLg2 = liftMono1 nLg2
iWidth :: Interval -> Interval
iWidth = liftMono1 nWidth
iExp :: Interval -> Interval -> Interval
iExp i1 i2 = fixUp (liftMono2 nExp (&&) i1 i2)
where
-- exp k : is a monotonic function for k >= 1
-- exp 0 : is a monotonic from 1 onwards
-- Example of why we need fixing, consdier:
-- [0,0] ^ [0,5]
-- Monotonic computation results in:
-- [1,0]
fixUp i3
| lowerBound i1 == Nat 0 &&
lowerBound i2 == Nat 0 &&
upperBound i2 >= Nat 1 =
Interval { lowerBound = Nat 0
, upperBound = nMax (Nat 1) (upperBound i3)
, isFinite = isFinite i3
}
fixUp i3 = i3
iSub :: Interval -> Interval -> Interval
iSub = liftPosNeg nSub
iDiv :: Interval -> Interval -> Interval
iDiv = liftPosNeg nDiv
iMod :: Interval -> Interval -> Interval
iMod _ i2 = Interval { lowerBound = Nat 0
, upperBound = case upperBound i2 of
Inf -> Inf
Nat n -> Nat (n - 1)
, isFinite = True -- we never have infinite reminder.
}
-- XXX
iLenFromThen :: Interval -> Interval -> Interval -> Interval
iLenFromThen _ _ _ = anyFinite
-- XXX
iLenFromTo :: Interval -> Interval -> Interval
iLenFromTo _ _ = anyFinite
-- XXX
iLenFromThenTo :: Interval -> Interval -> Interval -> Interval
iLenFromThenTo _ _ _ = anyFinite
-- | The first interval is definiately smaller
iLeq :: Interval -> Interval -> Bool
iLeq i1 i2 = upperBound i1 <= lowerBound i2
-- | The first interval is definiately smaller
iLt :: Interval -> Interval -> Bool
iLt i1 i2 = upperBound i1 < lowerBound i2
|| (isFinite i1 && lowerBound i2 == Inf)
-- | The two intervals do not overlap.
iDisjoint :: Interval -> Interval -> Bool
iDisjoint i1 i2 = iLt i1 i2 || iLt i2 i1
--------------------------------------------------------------------------------
liftMono1 :: (Nat' -> Nat') -- ^ Binary monotonic fun. to lift
-> Interval -> Interval
liftMono1 f i =
let u = f (upperBound i)
in Interval { lowerBound = f (lowerBound i)
, upperBound = u
, isFinite = mkFin (isFinite i) u
}
liftMono2 :: (Nat' -> Nat' -> Nat') -- ^ Binary monotonic fun. to lift
-> (Bool -> Bool -> Bool) -- ^ Compute finitneness
-> Interval -> Interval -> Interval
liftMono2 f isF i1 i2 =
let u = f (upperBound i1) (upperBound i2)
in Interval { lowerBound = f (lowerBound i1) (lowerBound i2)
, upperBound = u
, isFinite = mkFin (isF (isFinite i1) (isFinite i2)) u
}
-- For div and sub, increase in first argument, decrease in second.
liftPosNeg :: (Nat' -> Nat' -> Maybe Nat')
-> Interval -> Interval -> Interval
liftPosNeg f i1 i2 =
Interval { lowerBound = case f (lowerBound i1) (upperBound i2) of
Nothing -> Nat 0
Just n -> n
, upperBound = case f (upperBound i1) (lowerBound i2) of
Just n -> n
Nothing -> upperBound i1
, isFinite = isFinite i1
}
mkFin :: Bool -> Nat' -> Bool
mkFin ifInf ub = case ub of
Nat _ -> True
Inf -> ifInf
cryptol-2.2.6/src/Cryptol/TypeCheck/Solver/Numeric.hs 0000644 0000000 0000000 00000023276 12637103426 020733 0 ustar 00 0000000 0000000 -- |
-- Module : $Header$
-- Copyright : (c) 2013-2015 Galois, Inc.
-- License : BSD3
-- Maintainer : cryptol@galois.com
-- Stability : provisional
-- Portability : portable
--
-- Solver code that does not depend on the type inference monad.
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE Safe #-}
module Cryptol.TypeCheck.Solver.Numeric
( numericStep
, simpFin
, goalOrderModel
) where
import Cryptol.Utils.Panic(panic)
import Cryptol.TypeCheck.AST
import Cryptol.TypeCheck.Unify(mgu,Result(..))
import Cryptol.TypeCheck.Subst(fvs)
import Cryptol.TypeCheck.InferTypes(Goal(..), Solved(..))
import Cryptol.TypeCheck.Solver.FinOrd(OrdFacts, AssertResult(..),addFact)
import Cryptol.TypeCheck.Solver.Interval(Interval(..),iDisjoint)
import Cryptol.TypeCheck.Solver.Eval(typeInterval,simpType,
typeKnownFin,typeKnownLeq,
assumedOrderModel,
derivedOrd
)
import Cryptol.TypeCheck.Solver.InfNat(Nat'(..))
import Cryptol.TypeCheck.Solver.Utils
import Control.Monad(guard,msum)
import qualified Data.Set as Set
-- | Try to perform a single step of simplification for a
-- numeric goal. We assume that the substitution has been applied to the
-- goal.
numericStep :: OrdFacts -> Goal -> Solved
numericStep m g =
case tNoUser (simpType m (goal g)) of
-- First we check if things are exactly the same, or we can
-- substitutie in a variable (e.g., ?a = 1 + x)
TCon (PC PEqual) [t1,t2]
| OK (su,[]) <- unifier -> solvedS (Just su) []
| Error _ <- unifier -> Unsolvable
where unifier = mgu t1 t2
TCon (PC PEqual) [t1,t2]
-- Check if Inf is the only possible solution
| Just prop <- checkOnlyInf m t1 t2 -> solved [prop]
-- k1 + t1 = k2 + t2
| Just (k1,t1') <- splitConstSummand t1
, Just (k2,t2') <- splitConstSummand t2 ->
let sub = case compare k1 k2 of
EQ -> t1' =#= t2'
LT -> t1' =#= (tNum (k2 - k1) .+. t2')
GT -> (tNum (k1 - k2) .+. t1') =#= t2'
in solved [sub]
-- fin a => a + t1 = a + t2
| Just p <- eqByCancel m t1 t2 -> solved [p]
-- k1 * t1 = k2 * t2
| Just (k1,t1') <- splitConstFactor t1
, Just (k2,t2') <- splitConstFactor t2
, let c = gcd k1 k2
, c > 1 -> solved [ tNum (div k1 c) .*. t1' =#= tNum (div k2 c) .*. t2' ]
-- (x < b, x = min a b) => (x = a)
| TCon (TF TCMin) [a,b] <- t1
, Just ps <- simpEqMin m t2 a b -> solved ps
| TCon (TF TCMin) [a,b] <- t2
, Just ps <- simpEqMin m t1 a b -> solved ps
-- (k >= 1, a = min (a + k, t)) => a = t
| TVar a <- tNoUser t1
, Just ps <- aIsMin m a (splitMins t2) -> solved ps
| TVar a <- tNoUser t2
, Just ps <- aIsMin m a (splitMins t1) -> solved ps
-- (?x + s = t, s <= t, fin s) => (?x = t - s)
-- useful as long as `?x` not in `fvs (s,t)`
| Just ps <- eqBySub m t1 t2 -> solved ps
-- Impossible
| iDisjoint i1 i2 -> Unsolvable
where i1 = typeInterval m t1
i2 = typeInterval m t2
-- We know these are not simple because they would have ended up
-- in the OrdFacts
TCon (PC PGeq) [t1,t2]
| typeKnownLeq m t2 t1 -> solved []
| otherwise -> Unsolved
prop | Just ps <- simpFin m prop -> solved ps
_ -> Unsolved
where
solved = solvedS Nothing
solvedS su xs = Solved su [ g { goal = x } | x <- xs ]
-- t1 == min t2 t3
simpEqMin :: OrdFacts -> Type -> Type -> Type -> Maybe [Prop]
simpEqMin m t1 t2 t3
| t1 == t2 = Just [ t3 >== t1 ] -- t1 = min t1 t3
| t1 == t3 = Just [ t2 >== t1 ] -- t1 = min t2 t1
| knownSmaller m t1 t2 = Just [ t1 =#= t3 ]
| knownSmaller m t1 t3 = Just [ t1 =#= t2 ]
| otherwise = Nothing
-- | Check to see if we know that `t1` is strictly smaller than `t2`
-- XXX: It'd be nice to combine this with knownLeq
-- XXX: There can be all kinds of rules here.
knownSmaller :: OrdFacts -> Type -> Type -> Bool
knownSmaller m t1 t2
-- just a simple common case, arising from things like ([0] # something)
| Just (_,t2') <- splitConstSummand t2
, isFinite (typeInterval m t1)
, t1 == t2' = True
knownSmaller _ _ _ = False
simpFin :: OrdFacts -> Prop -> Maybe [Prop]
simpFin m prop =
case tNoUser prop of
TCon (PC PFin) [ty] -> simpFinTy m ty
_ -> Nothing
simpFinTy :: OrdFacts -> Type -> Maybe [Prop]
simpFinTy _ ty | TCon (TC (TCNum _)) _ <- tNoUser ty = Just []
simpFinTy m ty | typeKnownFin m ty = Just []
simpFinTy m ty =
case tNoUser ty of
TCon (TF tf) [t1]
| TCLg2 <- tf -> Just [pFin t1]
| TCWidth <- tf -> Just [pFin t1]
TCon (TF tf) [t1,t2]
| TCAdd <- tf -> Just [pFin t1, pFin t2]
| TCSub <- tf -> Just [pFin t1]
| TCMul <- tf
, Nat n1 <- lowerBound i1, n1 >= 1
, Nat n2 <- lowerBound i2, n2 >= 1
-> Just [pFin t1, pFin t2]
| TCDiv <- tf -> Just [pFin t1]
| TCMod <- tf -> Just [] -- hm
| TCExp <- tf -> Just [pFin t1, pFin t2]
| TCMin <- tf -> Nothing
| TCMax <- tf -> Just [pFin t1, pFin t2]
where i1 = typeInterval m t1
i2 = typeInterval m t2
TCon (TF tf) [_,_,_]
| TCLenFromThen <- tf -> Just []
| TCLenFromThenTo <- tf -> Just []
_ -> Nothing
{- | Detect equations of the form:
a = p + a // fin p, p >= 1
inf = p + a // fin p
inf = p * a // fin p, p >= 1
The only solution to such equations is when `a = inf`, which is what we return.
When in doubt, it is OK to return `Nothing`
-}
checkOnlyInf :: OrdFacts -> Type -> Type -> Maybe Prop
checkOnlyInf ordM t1 t2 =
case (tNoUser t1, tNoUser t2) of
(TCon (TC TCInf) _, ty) -> checkInf ty
(ty, TCon (TC TCInf) _) -> checkInf ty
(TVar x, ty) -> checkVar x ty
(ty, TVar x) -> checkVar x ty
(_,_) -> Nothing
where
checkVar a ty =
do ty1 <- splitVarSummand a ty
guard (validP 1 ty1)
return (TVar a =#= tInf)
validP lb p = let i = typeInterval ordM p
in isFinite i && lowerBound i >= Nat lb
checkInf ty = case ty of
TCon (TF TCAdd) [l,r]
| validP 0 l -> Just (r =#= tInf)
| validP 0 r -> Just (l =#= tInf)
TCon (TF TCMul) [l,r]
| validP 1 l -> Just (r =#= tInf)
| validP 1 r -> Just (l =#= tInf)
_ -> Nothing
-- (?x + s = t, fin s) <=> (t >= s, ?x = t - s)
-- useful as long as `?x` not in `fvs (s,t)`
eqBySub :: OrdFacts -> Type -> Type -> Maybe [Prop]
eqBySub ordM t1 t2 = msum $ zipWith attempt (splitVarSummands t1) (repeat t2) ++
zipWith attempt (splitVarSummands t2) (repeat t1)
where
attempt (x,s) t
| not (x `Set.member` fvs (s,t)) && typeKnownFin ordM s =
Just [ TVar x =#= (t .-. s), t >== s ]
| otherwise = Nothing
-- (fin a, a + x == a + y) => (x == y)
eqByCancel :: OrdFacts -> Type -> Type -> Maybe Prop
eqByCancel ordM t1 t2 =
msum [ check x | x <- Set.toList (fvs t1), typeKnownFin ordM (TVar x) ]
where
check x = do t1' <- splitVarSummand x t1
t2' <- splitVarSummand x t2
return (t1' =#= t2')
-- (a == min (k + a, t), k >= 1) => a == t
aIsMin :: OrdFacts -> TVar -> [Type] -> Maybe [Prop]
aIsMin _ _ [] = Nothing
aIsMin _ _ [_] = Nothing
aIsMin m a ts0 = attempt [] ts0
where
tMins [] = panic "Cryptol.TypeCheck.Solver.Numeric" [ "tMins []" ]
tMins [t] = t
tMins ts = foldr1 tMin ts
attempt _ [] = Nothing
attempt others (t:ts)
| isAparat m a t = Just [ TVar a =#= tMins (ts ++ others) ]
| otherwise = attempt (t:others) ts
-- Either this or splitVars summand could be fancier and go through functions
isAparat :: OrdFacts -> TVar -> Type -> Bool
isAparat m x ty = case splitVarSummand x ty of
Just t1 -> typeKnownLeq m (tNum (1::Int)) t1
_ -> False
-- | Collect `fin` and `<=` constraints in the ord model
-- Returns (new model, bad goals, other goals).
-- "bad goals" are goals that are incompatible with the model
-- "other goals" are ones that are not "<=" or "fin"
goalOrderModel :: OrdFacts -> [Goal] -> (OrdFacts, [Goal], [Goal])
goalOrderModel m0 todo =
go m0 [] [] False [ g { goal = simpType m0 (goal g) } | g <- todo ]
where
go m bad others changes []
| changes = let (m1,newBad,newOthers) = goalOrderModel m others
in (m1, newBad ++ bad, newOthers)
| otherwise = case concatMap (derivedOrd m) (map goal others) of
[] -> (m,bad,others)
der -> case assumedOrderModel m der of
-- we know that these goals cannot be solved
-- but we don't have a good way to report the err
-- For now, we just leave the goals alone
Left _err -> (m,bad,others)
Right (m1,_) -> (m1,bad,others)
go m bad others changes (g : gs)
| Just ps <- simpFin m (goal g) =
go m bad others changes ([ g { goal = p } | p <- ps ] ++ gs)
go m bad others changes (g : gs) =
case addFact g m of
OrdAlreadyKnown -> go m bad others changes gs
OrdAdded m1 -> go m1 bad others True gs
OrdCannot -> go m bad (g : others) changes gs
OrdImprove t1 t2 -> go m bad (g { goal = t1 =#= t2 } : others) changes gs
OrdImpossible -> go m (g : bad) others changes gs
cryptol-2.2.6/src/Cryptol/TypeCheck/Solver/Selector.hs 0000644 0000000 0000000 00000010456 12637103426 021105 0 ustar 00 0000000 0000000 -- |
-- Module : $Header$
-- Copyright : (c) 2013-2015 Galois, Inc.
-- License : BSD3
-- Maintainer : cryptol@galois.com
-- Stability : provisional
-- Portability : portable
{-# LANGUAGE PatternGuards #-}
module Cryptol.TypeCheck.Solver.Selector (tryHasGoal) where
import Cryptol.TypeCheck.AST
import Cryptol.TypeCheck.InferTypes
import Cryptol.TypeCheck.Monad( InferM, unify, newGoals, lookupNewtype
, newType, applySubst, addHasGoal, solveHasGoal
)
import Cryptol.TypeCheck.Subst(listSubst,apSubst)
import Cryptol.Utils.PP(text,pp,ordinal,(<+>))
import Cryptol.Utils.Panic(panic)
import Control.Monad(forM,guard)
recordType :: [Name] -> InferM Type
recordType labels =
do fields <- forM labels $ \l ->
do t <- newType (text "record field" <+> pp l) KType
return (l,t)
return (TRec fields)
tupleType :: Int -> InferM Type
tupleType n =
do fields <- mapM (\x -> newType (ordinal x <+> text "tuple field") KType)
[ 0 .. (n-1) ]
return (tTuple fields)
listType :: Int -> InferM Type
listType n =
do elems <- newType (text "sequence element type") KType
return (tSeq (tNum n) elems)
improveSelector :: Selector -> Type -> InferM (Expr -> Expr)
improveSelector sel outerT =
case sel of
RecordSel _ mb -> cvt recordType mb
TupleSel _ mb -> cvt tupleType mb
ListSel _ mb -> cvt listType mb
where
cvt _ Nothing = return id
cvt f (Just a) = do ty <- f a
cs <- unify ty outerT
case cs of
[] -> return id
_ -> do newGoals CtExactType cs
return (`ECast` ty)
{- | Compute the type of a field based on the selector.
The given type should be "zonked" (i.e., substitution was applied to it),
and (outermost) type synonyms have been expanded.
-}
solveSelector :: Selector -> Type -> InferM (Maybe Type)
solveSelector sel outerT =
case (sel, outerT) of
(RecordSel l _, ty) ->
case ty of
TRec fs -> return (lookup l fs)
TCon (TC TCSeq) [len,el] -> liftSeq len el
TCon (TC TCFun) [t1,t2] -> liftFun t1 t2
TCon (TC (TCNewtype (UserTC x _))) ts ->
do mb <- lookupNewtype x
case mb of
Nothing -> return Nothing
Just nt ->
case lookup l (ntFields nt) of
Nothing -> return Nothing
Just t ->
do let su = listSubst (zip (map tpVar (ntParams nt)) ts)
newGoals (CtPartialTypeFun $ UserTyFun x)
$ apSubst su $ ntConstraints nt
return $ Just $ apSubst su t
_ -> return Nothing
(TupleSel n _, ty) ->
case ty of
TCon (TC (TCTuple m)) ts ->
return $ do guard (0 <= n && n < m)
return $ ts !! n
TCon (TC TCSeq) [len,el] -> liftSeq len el
TCon (TC TCFun) [t1,t2] -> liftFun t1 t2
_ -> return Nothing
(ListSel n _, TCon (TC TCSeq) [l,t]) ->
do newGoals CtSelector [ (l .+. tNum (1::Int)) >== tNum n ]
return (Just t)
_ -> return Nothing
where
liftSeq len el =
do mb <- solveSelector sel el
return $ do el' <- mb
return (TCon (TC TCSeq) [len,el'])
liftFun t1 t2 =
do mb <- solveSelector sel t2
return $ do t2' <- mb
return (TCon (TC TCFun) [t1,t2'])
-- | Solve has-constraints.
tryHasGoal :: HasGoal -> InferM ()
tryHasGoal has
| TCon (PC (PHas sel)) [ th, ft ] <- goal (hasGoal has) =
do outerCast <- improveSelector sel th
outerT <- tNoUser `fmap` applySubst th
mbInnerT <- solveSelector sel outerT
case mbInnerT of
Nothing -> addHasGoal has
Just innerT ->
do cs <- unify innerT ft
innerCast <- case cs of
[] -> return id
_ -> do newGoals CtExactType cs
return (`ECast` ft)
solveHasGoal (hasName has) (innerCast . (`ESel` sel) . outerCast)
| otherwise = panic "hasGoalSolved"
[ "Unexpected selector proposition:"
, show (hasGoal has)
]
cryptol-2.2.6/src/Cryptol/TypeCheck/Solver/Smtlib.hs 0000644 0000000 0000000 00000012641 12637103426 020555 0 ustar 00 0000000 0000000 -- |
-- Module : $Header$
-- Copyright : (c) 2013-2015 Galois, Inc.
-- License : BSD3
-- Maintainer : cryptol@galois.com
-- Stability : provisional
-- Portability : portable
{-# LANGUAGE OverloadedStrings, RecordWildCards, PatternGuards #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Cryptol.TypeCheck.Solver.Smtlib (simpDelayed) where
import Cryptol.TypeCheck.AST as Cry
import Cryptol.TypeCheck.Subst (fvs)
import Cryptol.TypeCheck.InferTypes(Goal(..))
import Cryptol.TypeCheck.Solver.FinOrd
import SMTLib2 as SMT
import SMTLib2.Int as SMT
import SMTLib2.Core as SMT
import qualified Control.Exception as X
import Data.String(fromString)
import Data.List(partition)
import Data.Maybe(mapMaybe)
import qualified Data.Set as Set
import System.Directory(findExecutable)
import System.Environment(getExecutablePath)
import System.FilePath((>), takeDirectory)
import System.Process(readProcessWithExitCode)
import System.Exit(ExitCode(..))
simpDelayed :: [TParam] -> OrdFacts -> [Prop] -> [Goal] -> IO [Goal]
simpDelayed _qvars ordAsmp origAsmps goals =
do ans <- mapM tryGoal goals
let (_natsDone,natsNot) = partition snd ans
-- XXX: check that `natsDone` also hold for the infinite case
return (map fst natsNot)
where
vs = map toVar (Set.toList (fvs (ordFactsToProps ordAsmp,
(origAsmps,map goal goals))))
asmps = mapMaybe toPred (ordFactsToProps ordAsmp ++ origAsmps)
tryGoal g = case toPred (goal g) of
Just q -> do res <- z3 (toScript vs asmps q)
return (g, res == Unsat)
-- i.e., solved for Nats, anyway
Nothing -> return (g, False)
toTerm :: Cry.Type -> Maybe SMT.Expr
toTerm ty =
case ty of
TCon tc ts ->
do es <- mapM toTerm ts
case (tc, es) of
(TC (TCNum x), []) -> return (SMT.num x)
(TF TCAdd, [e1,e2]) -> return (SMT.nAdd e1 e2)
(TF TCSub, [e1,e2]) -> return (SMT.nSub e1 e2)
(TF TCMul, [e1,e2]) -> return (SMT.nMul e1 e2)
(TF TCDiv, [e1,e2]) -> return (SMT.nDiv e1 e2)
(TF TCMod, [e1,e2]) -> return (SMT.nMod e1 e2)
(TF TCMin, [e1,e2]) -> return (SMT.ite (SMT.nLeq e1 e2) e1 e2)
(TF TCMax, [e1,e2]) -> return (SMT.ite (SMT.nLeq e1 e2) e2 e1)
(TF TCLg2, [_]) -> Nothing
(TF TCExp, [e1,e2])
| Lit (LitNum x) <- e2
, x >= 0 -> return $
if x == 0
then SMT.num (1 :: Int)
else foldr1 SMT.nMul
$ replicate (fromInteger x) e1
| otherwise -> Nothing
(TF TCWidth, [_]) -> Nothing -- == lg2 (e + 1)
(TF TCLenFromThen, _) -> Nothing
(TF TCLenFromThenTo, _) -> Nothing
_ -> Nothing
Cry.TVar x -> return (smtVar (toVar x))
TUser _ _ t -> toTerm t
TRec _ -> Nothing
toVar :: TVar -> SMT.Name
toVar (TVFree x _ _ _) = fromString ("free" ++ show x)
toVar (TVBound x _) = fromString ("bound" ++ show x)
smtVar :: SMT.Name -> SMT.Expr
smtVar x = app (I x []) []
toPred :: Cry.Prop -> Maybe SMT.Expr
toPred ty =
case ty of
TCon tc ts ->
do es <- mapM toTerm ts
case (tc,es) of
(PC PEqual, [e1,e2]) -> return (e1 === e2)
(PC PGeq, [e1,e2]) -> return (SMT.nLeq e2 e1)
_ -> Nothing
Cry.TVar {} -> Nothing
TUser _ _ t -> toPred t
TRec {} -> Nothing
toScript :: [SMT.Name] -> [SMT.Expr] -> SMT.Expr -> SMT.Script
toScript vs pes q =
Script $
[ SMT.CmdSetLogic "QF_LIA" ] ++
[ SMT.CmdDeclareFun x [] SMT.tInt | x <- vs ] ++
[ SMT.CmdAssert (SMT.nLeq (SMT.num (0::Int)) (smtVar x)) | x <- vs ] ++
[ SMT.CmdAssert p | p <- pes ] ++
[ SMT.CmdAssert (SMT.not q) ] ++
[ SMT.CmdCheckSat ]
data SMTResult = Sat | Unsat | Unknown
deriving (Eq,Show)
-- | First look for @z3@ in the path, but failing that, assume that it's
-- installed side-by-side with Cryptol.
findZ3 :: IO FilePath
findZ3 = do
mfp <- findExecutable "z3"
case mfp of
Just fp -> return fp
Nothing -> do
bindir <- takeDirectory `fmap` getExecutablePath
return (bindir > "z3")
z3 :: SMT.Script -> IO SMTResult
z3 script =
X.handle (\(_::X.IOException) -> return Unknown) $
do let txt = show (SMT.pp script)
z3path <- findZ3
(ex,out,err) <- readProcessWithExitCode z3path ["-smt2","-in"] txt
case ex of
ExitFailure 10 -> return Sat
ExitFailure 20 -> return Unsat
ExitFailure 127 -> return Unknown -- z3 program not found
ExitSuccess
| out == "sat\n" -> return Sat
| out == "unsat\n" -> return Unsat
| out == "unknown\n" -> return Unknown
-- XXX: We should not print to STDOUT here.
-- Report to a separate logger.
x -> do putStrLn "Called to Z3 failed!!!"
putStrLn ("Exit code: " ++ show x)
putStrLn "Script"
putStrLn txt
putStrLn "Standard out:"
putStrLn out
putStrLn "Standard error:"
putStrLn err
return Unknown -- or error
cryptol-2.2.6/src/Cryptol/TypeCheck/Solver/Utils.hs 0000644 0000000 0000000 00000005005 12637103426 020417 0 ustar 00 0000000 0000000 -- |
-- Module : $Header$
-- Copyright : (c) 2013-2015 Galois, Inc.
-- License : BSD3
-- Maintainer : cryptol@galois.com
-- Stability : provisional
-- Portability : portable
module Cryptol.TypeCheck.Solver.Utils where
import Cryptol.TypeCheck.AST
import Control.Monad(mplus,guard)
import Data.Maybe(listToMaybe)
-- min (a,min(b,c)) -> [a,b,c]
splitMins :: Type -> [Type]
splitMins ty =
case tNoUser ty of
TCon (TF TCMin) [t1,t2] -> splitMins t1 ++ splitMins t2
_ -> [ty]
-- | All ways to split a type in the form: `a + t1`, where `a` is a variable.
splitVarSummands :: Type -> [(TVar,Type)]
splitVarSummands ty0 = [ (x,t1) | (x,t1) <- go ty0, tNum (0::Int) /= t1 ]
where
go ty = case ty of
TVar x -> return (x, tNum (0::Int))
TRec {} -> []
TUser _ _ t -> go t
TCon (TF TCAdd) [t1,t2] ->
do (a,yes) <- go t1
return (a, yes .+. t2)
`mplus`
do (a,yes) <- go t2
return (a, t1 .+. yes)
TCon _ _ -> [] -- XXX: we could do some distributivity etc
-- | Check if we can express a type in the form: `a + t1`.
splitVarSummand :: TVar -> Type -> Maybe Type
splitVarSummand a ty = listToMaybe [ t | (x,t) <- splitVarSummands ty, x == a ]
{- | Check if we can express a type in the form: `k + t1`,
where `k` is a constant > 0.
This assumes that the type has been simplified already,
so that constants are floated to the left. -}
splitConstSummand :: Type -> Maybe (Integer, Type)
splitConstSummand ty =
case ty of
TVar {} -> Nothing
TRec {} -> Nothing
TUser _ _ t -> splitConstSummand t
TCon (TF TCAdd) [t1,t2] ->
do (k,t1') <- splitConstSummand t1
case t1' of
TCon (TC (TCNum 0)) [] -> return (k, t2)
_ -> return (k, t1' .+. t2)
TCon (TC (TCNum k)) [] -> guard (k > 0) >> return (k, tNum (0::Int))
TCon {} -> Nothing
{- | Check if we can express a type in the form: `k * t1`,
where `k` is a constant > 1
This assumes that the type has been simplified already,
so that constants are floated to the left. -}
splitConstFactor :: Type -> Maybe (Integer, Type)
splitConstFactor ty =
case ty of
TVar {} -> Nothing
TRec {} -> Nothing
TUser _ _ t -> splitConstFactor t
TCon (TF TCMul) [t1,t2] ->
do (k,t1') <- splitConstFactor t1
return (k, t1' .*. t2)
TCon (TC (TCNum k)) [] -> guard (k > 1) >> return (k, tNum (1::Int))
TCon {} -> Nothing
cryptol-2.2.6/src/Cryptol/Utils/ 0000755 0000000 0000000 00000000000 12637103426 014732 5 ustar 00 0000000 0000000 cryptol-2.2.6/src/Cryptol/Utils/Debug.hs 0000644 0000000 0000000 00000001064 12637103426 016315 0 ustar 00 0000000 0000000 -- |
-- Module : $Header$
-- Copyright : (c) 2013-2015 Galois, Inc.
-- License : BSD3
-- Maintainer : cryptol@galois.com
-- Stability : provisional
-- Portability : portable
{-# LANGUAGE CPP #-}
#define DEBUG
#ifdef DEBUG
{-# LANGUAGE Trustworthy #-}
#else
{-# LANGUAGE Safe #-}
#endif
module Cryptol.Utils.Debug where
import Cryptol.Utils.PP
#ifdef DEBUG
import qualified Debug.Trace as X
trace :: String -> b -> b
trace = X.trace
#else
trace :: String -> b -> b
trace _ x = x
#endif
ppTrace :: Doc -> b -> b
ppTrace d = trace (show d)
cryptol-2.2.6/src/Cryptol/Utils/Panic.hs 0000644 0000000 0000000 00000003210 12637103426 016314 0 ustar 00 0000000 0000000 -- |
-- Module : $Header$
-- Copyright : (c) 2013-2015 Galois, Inc.
-- License : BSD3
-- Maintainer : cryptol@galois.com
-- Stability : provisional
-- Portability : portable
{-# LANGUAGE Safe #-}
{-# LANGUAGE DeriveDataTypeable, RecordWildCards #-}
module Cryptol.Utils.Panic (panic) where
import Cryptol.Version
import Control.Exception as X
import Data.Typeable(Typeable)
import Data.Maybe(fromMaybe,listToMaybe)
panic :: String -> [String] -> a
panic panicLoc panicMsg = throw CryptolPanic { .. }
data CryptolPanic = CryptolPanic { panicLoc :: String
, panicMsg :: [String]
} deriving Typeable
instance Show CryptolPanic where
show p = unlines $
[ "You have encountered a bug in Cryptol's implementation."
, "*** Please create an issue at https://github.com/galoisinc/cryptol/issues"
, ""
, "%< --------------------------------------------------- "
] ++ rev ++
[ locLab ++ panicLoc p
, msgLab ++ fromMaybe "" (listToMaybe msgLines)
]
++ map (tabs ++) (drop 1 msgLines) ++
[ "%< --------------------------------------------------- "
]
where msgLab = " Message: "
revLab = " Revision: "
branchLab = " Branch: "
dirtyLab = " (non-committed files present during build)"
locLab = " Location: "
tabs = map (const ' ') msgLab
msgLines = panicMsg p
rev | null commitHash = []
| otherwise = [ revLab ++ commitHash
, branchLab ++ commitBranch ++ dirtyLab ]
instance Exception CryptolPanic
cryptol-2.2.6/src/Cryptol/Utils/PP.hs 0000644 0000000 0000000 00000004542 12637103426 015612 0 ustar 00 0000000 0000000 -- |
-- Module : $Header$
-- Copyright : (c) 2013-2015 Galois, Inc.
-- License : BSD3
-- Maintainer : cryptol@galois.com
-- Stability : provisional
-- Portability : portable
{-# LANGUAGE Safe #-}
{-# LANGUAGE PatternGuards #-}
module Cryptol.Utils.PP
( PP(..)
, pp
, pretty
, optParens
, ppInfix
, Assoc(..)
, Infix(..)
, module Text.PrettyPrint
, ordinal
, ordSuffix
, commaSep
) where
import Text.PrettyPrint
class PP a where
ppPrec :: Int -> a -> Doc
pp :: PP a => a -> Doc
pp = ppPrec 0
pretty :: PP a => a -> String
pretty = show . pp
optParens :: Bool -> Doc -> Doc
optParens b body | b = parens body
| otherwise = body
-- | Information about associativity.
data Assoc = LeftAssoc | RightAssoc | NonAssoc
deriving (Show,Eq)
-- | Information about an infix expression of some sort.
data Infix op thing = Infix
{ ieOp :: op -- ^ operator
, ieLeft :: thing -- ^ left argument
, ieRight :: thing -- ^ right argumrnt
, iePrec :: Int -- ^ operator precedence
, ieAssoc :: Assoc -- ^ operator associativity
}
commaSep :: [Doc] -> Doc
commaSep = fsep . punctuate comma
-- | Pretty print an infix expression of some sort.
ppInfix :: (PP thing, PP op)
=> Int -- ^ Non-infix leaves are printed with this precedence
-> (thing -> Maybe (Infix op thing))
-- ^ pattern to check if sub-thing is also infix
-> Infix op thing -- ^ Pretty print this infix expression
-> Doc
ppInfix lp isInfix expr =
sep [ ppSub (wrapSub LeftAssoc ) (ieLeft expr) <+> pp (ieOp expr)
, ppSub (wrapSub RightAssoc) (ieRight expr) ]
where
wrapSub dir p = p < iePrec expr || p == iePrec expr && ieAssoc expr /= dir
ppSub w e
| Just e1 <- isInfix e = optParens (w (iePrec e1)) (ppInfix lp isInfix e1)
ppSub _ e = ppPrec lp e
-- | Display a numeric values as an ordinar (e.g., 2nd)
ordinal :: (Integral a, Show a, Eq a) => a -> Doc
ordinal x = text (show x) <> text (ordSuffix x)
-- | The suffix to use when displaying a number as an oridinal
ordSuffix :: (Integral a, Eq a) => a -> String
ordSuffix n0 =
case n `mod` 10 of
1 | notTeen -> "st"
2 | notTeen -> "nd"
3 | notTeen -> "rd"
_ -> "th"
where
n = abs n0
m = n `mod` 100
notTeen = m < 11 || m > 19