packages feed

MiniAgda (empty) → 0.2014.1.9

raw patch · 466 files changed

+32982/−0 lines, 466 filesdep +IfElsedep +arraydep +basesetup-changed

Dependencies added: IfElse, array, base, containers, haskell-src-exts, mtl, pretty

Files

+ Abstract.hs view
@@ -0,0 +1,2213 @@+-- Some optimizations (-O) destroy the expected behavior of unsafePerformIO+-- So, special options are needed, plus NOINLINE for the affected functions.+{-# OPTIONS -fno-cse -fno-full-laziness #-}++{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeSynonymInstances,+  GeneralizedNewtypeDeriving, DeriveFunctor, DeriveFoldable, DeriveTraversable,+  NamedFieldPuns #-}+{-# LANGUAGE NoImplicitPrelude #-}++module Abstract where++import Prelude hiding (showList, map, concat, foldl, pi, null)++import Control.Applicative hiding (empty)+import Control.Monad.Writer (Writer, tell, All(..))+import Control.Monad.Trans++import Data.Monoid hiding ((<>))+import Data.Foldable (Foldable, foldMap)+import qualified Data.Foldable as Foldable+import Data.Traversable as Traversable+import Data.Unique++import Data.List (map)+import qualified Data.List as List+import Data.Map (Map)+import qualified Data.Map as Map+import Data.Set (Set)+import qualified Data.Set as Set++import Debug.Trace+import Data.IORef+import System.IO.Unsafe++import Text.PrettyPrint as PP++import Collection (Collection)+import qualified Collection as Coll+import Polarity as Pol+import TreeShapedOrder (TSO)+import qualified TreeShapedOrder as TSO+import Util hiding (parens, brackets)+import qualified Util+import {-# SOURCE #-} Value (TeleVal)++-- * Names carry a name suggestion and a unique identifier++-- | Each Name is classified as "User", "EtaAlias", or "Quote".+data WhatName+  = UserName+  | EtaAliasName -- ^ a name for the eta-expanded name of a definition+  | QuoteName+    deriving (Eq, Ord, Show)++data Name = Name+  { suggestion :: String    -- ^ suggestion for printing the name.+  , what       :: WhatName+  , uid        :: Unique -- !Unique+  }++-- | Names are compared according to their UID.+instance Eq Name where+  x == x' = uid x == uid x'++instance Ord Name where+  compare x x' = compare (uid x) (uid x')++instance Show Name where+  show (Name n _ u) = n -- n ++ "`" ++ show (hashUnique u `mod` 13)++-- | @fresh s@ generates a new name with 'suggestion' @s@.+--+--   To a void a monad here, we use imperative features (@unsafePerformIO@).+fresh :: String -> Name+fresh n = Name n UserName $ unsafePerformIO newUnique+{-# NOINLINE fresh #-}++freshen :: Name -> Name+freshen n = fresh (suggestion n)++-- | A non-unique empty name.  Use only inconstant functions!+noName :: Name+noName = fresh ""++-- | Check whether name is @""@.+emptyName :: Name -> Bool+emptyName n = null (suggestion n)++nonEmptyName :: Name -> String -> Name+nonEmptyName n s | emptyName n = n { suggestion = s }+                 | otherwise   = n++-- | Get the first non-empty name from a non-empty list of names.+bestName :: [Name] -> Name+bestName [n]    = n+bestName (n:ns)+  | emptyName n = bestName ns+  | otherwise   = n++-- temporary hack for reification++iAmNotUnique :: Unique+iAmNotUnique = unsafePerformIO newUnique+{-# NOINLINE iAmNotUnique #-}++unsafeName :: String -> Name+unsafeName s = Name s QuoteName iAmNotUnique++-- | External reference to recursive function (outside of the body).+mkExtName :: Name -> Name+mkExtName n = Name (suggestion n) EtaAliasName $ unsafePerformIO newUnique+-- mkExtName n = "_" ++ n+{-# NOINLINE mkExtName #-}++mkExtRef  n = letdef (mkExtName n)++isEtaAlias :: Name -> Bool+isEtaAlias n = what n == EtaAliasName++-- | Internal name for compiler-generated stuff.+internal :: Name -> Name+internal n = freshen n+-- internal n = "__" ++ n+-- internal names are prefixed by a double underscore (not legal concrete syntax)++-- | Convert a dot pattern into an identifier which should not look too confusing.+spaceToUnderscore = List.map (\ c -> if c==' ' then '_' else c)+{-+exprToName e = spaceToUnderscore $ show e+patToName p  = spaceToUnderscore $ show p+-}++-- | Qualified name.+data QName+  = Qual  { qual :: Name, name :: Name }+  | QName { name :: Name }+  deriving (Eq, Ord)++instance Show QName where+  show (Qual m n) = show m ++ "." ++ show n+  show (QName n)  = show n++-- | An unqualified name is an instance of a qualified name.+nameInstanceOf (QName n) (Qual _ n') = n == n'+nameInstanceOf n         n'          = n == n'++-- | Fails if qualified name.+unqual (QName n) = n+unqual n         = error $ "Abstract.unqual: " ++ show n++data Sized = Sized | NotSized+             deriving (Eq,Ord,Show)++data Co = Ind+        | CoInd+          deriving (Eq,Ord,Show)++showFun :: Co -> String+showFun Ind   = "fun"+showFun CoInd = "cofun"++data LtLe = Lt | Le deriving (Eq,Ord)++instance Show LtLe where+  show Lt = "<"+  show Le = "<="++-- decoration of Pi-types --------------------------------------------++-- 1. whether argument is irrelevant / its polarity+-- further possibilities:+-- 2. hidden++data Decoration pos+    = Dec { thePolarity :: pos }+    | Hidden+  deriving (Eq, Ord, Functor, Foldable, Traversable, Show)++polarity :: Polarity pol => Decoration pol -> pol+polarity Hidden    = hidden+polarity (Dec pol) = pol++instance Polarity a => Polarity (Decoration a) where+  erased        = erased . polarity+  compose  p p' = Dec $ compose (polarity p) (polarity p')+  neutral       = Dec neutral+  promote       = Dec . promote . polarity+  demote        = Dec . demote . polarity+  hidden        = Hidden++type Dec = Decoration Pol+type UDec = Decoration PProd++class LensPol a where+  getPol :: a -> Pol+  setPol :: Pol -> a -> a+  setPol = mapPol . const+  mapPol :: (Pol -> Pol) -> a -> a+  mapPol f a = setPol (f (getPol a)) a++instance LensPol Dec where+  getPol = polarity+  setPol p Hidden = Hidden+  setPol p dec    = dec { thePolarity = p }++udec :: Dec -> UDec+udec = fmap pprod++irrelevantDec = Dec Pol.Const+paramDec = Dec Param+defaultDec = Dec defaultPol+-- defaultDec = paramDec -- TODO: Dec { polarity = Rec }+defaultUpperDec = Dec $ pprod SPos+  -- a variable may not be erased and its polarity must be below SPos+-- notErased = Dec False+-- resurrectDec d = d { erased = False }++-- | Composing with 'neutralDec' should do nothing.+neutralDec = Dec SPos++coDomainDec :: Dec -> Dec+coDomainDec Hidden = Dec Param -- REDUNDANT+coDomainDec dec+    | polarity dec == Pol.Const = Dec Param+    | otherwise                 = Dec Rec++-- compDec dec dec'+-- composition of decoration, used when type checking arguments+-- of functions decorated with dec+compDec :: Dec -> UDec -> UDec+compDec dec udec = compose (fmap pprod dec) udec++{-+instance Show pos => Show (Decoration pos) where+    show p =+      (if erased p then Util.brackets else Util.parens) $ show $ polarity p+-}+++{- OLD CODE+data Decoration pos = Dec { erased :: Bool, polarity :: pos }+           deriving (Eq, Ord, Functor, Foldable, Traversable)++type Dec = Decoration Pol+type UDec = Decoration PProd++irrelevantDec = Dec { erased = True, polarity = Pol.Const }+defaultDec = Dec { erased = False, polarity = Rec }+defaultUpperDec = Dec { erased = False, polarity = pprod SPos }+  -- a variable may not be erased and its polarity must be below SPos+-- notErased = Dec False+resurrectDec d = d { erased = False }++{- RETIRED+-- invCompDec dec dec'+-- inverse composition of decoration, used when type checking arguments+-- of functions decorated with dec+invCompDec :: Dec -> Dec -> Dec+invCompDec (Dec er pol) (Dec er' pol') = Dec+  (if er then False else er')+  (invComp pol pol')+-}++-- compDec dec dec'+-- composition of decoration, used when type checking arguments+-- of functions decorated with dec+compDec :: Dec -> UDec -> UDec+compDec (Dec er pol) (Dec er' pol') = Dec+  (er || er')      -- erasing once is sufficient+  (polProd (pprod pol) pol')++instance Show pos => Show (Decoration pos) where+    show (Dec erased polarity) =+      (if erased then Util.brackets else Util.parens) $ show polarity+-}++-- size expressions --------------------------------------------------++class HasPred a where+  predecessor :: a -> Maybe a++instance HasPred Expr where+  predecessor (Succ e) = Just e+  predecessor _ = Nothing++sizeSuccE :: Expr -> Expr+sizeSuccE Infty = Infty+sizeSuccE e     = Succ e++minSizeE :: Expr -> Expr -> Expr+minSizeE Infty e2 = e2+minSizeE e1 Infty = e1+minSizeE Zero  e2 = Zero+minSizeE e1 Zero  = Zero+minSizeE (Succ e1) (Succ e2) = Succ (minSizeE e1 e2)+minSizeE e1 e2 = error $ "minSizeE " ++ (Util.parens $ show e1) ++ " " ++ (Util.parens $ show e2)++maxSizeE :: Expr -> Expr -> Expr+maxSizeE Infty e2 = Infty+maxSizeE e1 Infty = Infty+maxSizeE Zero  e2 = e2+maxSizeE e1 Zero  = e1+maxSizeE (Succ e1) (Succ e2) = Succ (maxSizeE e1 e2)+maxSizeE e1 e2 = Max [e1, e2]+-- maxSizeE e1 e2 = error $ "maxSizeE " ++ (Util.parens $ show e1) ++ " " ++ (Util.parens $ show e2)++flattenMax :: Expr -> [Expr] -> [Expr]+flattenMax Infty          acc = [Infty]+flattenMax Zero           acc = acc+flattenMax (Max [])       acc = acc+flattenMax (Max (e : es)) acc = flattenMax e $ flattenMax (Max es) acc+flattenMax e              acc = e : acc++-- smart constructor for MAX+maxE :: [Expr] -> Expr+maxE es = Max $ foldr flattenMax [] es++sizeVarsToInfty :: Expr -> Expr+sizeVarsToInfty Zero = Zero+sizeVarsToInfty (Succ e) = sizeSuccE (sizeVarsToInfty e)+sizeVarsToInfty _ = Infty++leqSizeE :: Expr -> Expr -> Bool+leqSizeE Zero e  = True+leqSizeE e Zero  = False+leqSizeE e Infty = True+leqSizeE (Succ e) (Succ e') = leqSizeE e e'+leqSizeE Infty e = False++-- plus :: Expr -> Expr -> Expr++-- sorts -------------------------------------------------------------++data Class+  = Tm      -- sort of terms, only needed for erasure+--  | Ty    -- use Set 0!  -- sort of type(constructor)s, only needed for erasure+--  | Ki      -- sort of kinds  -- use Set 0 ... for mor precision+  | Size    -- sort of sizes+  | TSize   -- sort of Size+  -- | Type    -- no longer used+    deriving (Eq, Ord, Show)++predClass :: Class -> Class+-- predClass Ty    = Tm+predClass TSize = Size+predClass Tm    = Tm+predClass Size  = Size++data Sort a+  = SortC Class -- sort constant (Size, TSize)+  | Set a       -- Set 0 = CoSet #, Set 1 = Type 1, Set 2 = Type 2, ...+  | CoSet a     -- sized version of Set+    deriving (Eq, Ord, Functor, Foldable, Traversable)++{-+instance Show a => Show (Sort a) where+  show (SortC c) = show c+  show (Set a)   = "Set " ++ show a+  show (CoSet a) = "CoSet " ++ show a+-}++instance Show (Sort Expr) where+  show (SortC c) = show c+  show (Set Zero) = "Set"+  show (CoSet Infty) = "Set"+  show (Set e) = Util.parens $ ("Set " ++ show e)+  show (CoSet e) = Util.parens $ ("CoSet " ++ show e)++topSort :: Sort Expr+topSort = Set Infty++-- | The expression representing the type Size.+tSize :: Expr+tSize = Sort (SortC Size)++-- | Checking whether an expression represents type Size.+isSize :: Expr -> Bool+isSize (Sort (SortC Size)) = True+isSize (Below Le Infty)    = True+isSize _                   = False++predSort :: Sort Expr -> Sort Expr+predSort (SortC  c)     = SortC (predClass c)+predSort (CoSet  e)     = SortC Tm+predSort (Set Zero)     = SortC Tm+predSort (Set (Succ e)) = Set e+predSort (Set Infty)    = Set Infty+predSort s@(Set Var{})  = s+predSort s = error $ "internal error: predSort " ++ show s++-- only for sorts appearing in kinds:++succSort :: Sort Expr -> Sort Expr+succSort (SortC Size) = SortC TSize+succSort (SortC Tm)   = Set Zero+succSort (Set e)      = Set (sizeSuccE e)++minSort :: Sort Expr -> Sort Expr -> Sort Expr+minSort (SortC Tm) (Set e) = SortC Tm+minSort (Set e) (SortC Tm) = SortC Tm+minSort (Set e) (Set e') = Set (minSizeE e e')+-- minSort (SortC c) (SortC c') | c == c' = SortC c+minSort (SortC c) (SortC c') = SortC $ minClass c c'+minSort s s' = error $ "minSort (" ++ show s ++ ") (" ++ show s' ++ ") not implemented"++-- 2012-01-21: that should not be necessary, but to move on...+minClass :: Class -> Class -> Class+minClass Tm c = Tm+minClass c Tm = Tm+minClass Size c = Size+minClass c Size = Size+minClass TSize TSize = TSize+maxClass :: Class -> Class -> Class++maxClass Tm c = c+maxClass c Tm = c+maxClass Size c = c+maxClass c Size = c+maxClass TSize TSize = TSize++maxSort :: Sort Expr -> Sort Expr -> Sort Expr+maxSort (SortC Tm) (Set e) = Set e+maxSort (Set e) (SortC Tm) = Set e+maxSort (Set e) (Set e') = Set (maxSizeE e e')+-- maxSort (SortC c) (SortC c') | c == c' = SortC c+maxSort (SortC c) (SortC c') = SortC $ maxClass c c'+maxSort s s' = error $ "maxSort (" ++ show s ++ ") (" ++ show s' ++ ") not implemented"++{-+leSort :: Sort -> Sort -> Bool+leSort _ Type = True+leSort Type _ = False+leSort s s'   = s == s'+-}++-- s `irrSortFor` s' if a variable of kind s cannot compuationally+-- contribute to produce a value of kind s'+irrSortFor :: Sort Expr -> Sort Expr -> Bool+irrSortFor (SortC Tm) _          = False -- terms matter for terms and everything+irrSortFor _          (SortC Tm) = True  -- nothing else can be eliminated into a term+irrSortFor (SortC Size) _        = False -- sizes matter for everything but terms+irrSortFor _        (SortC Size) = True  -- nothing else can be eliminated into a size+irrSortFor (SortC TSize) _        = False -- sizes matter for everything but terms+irrSortFor _        (SortC TSize) = True  -- nothing else can be eliminated into a size+irrSortFor (Set e) (Set e')      = not $ leqSizeE e e'++-- kinds -------------------------------------------------------------++-- kinds classify expressions into terms, types, universes, ...+-- since the analysis is not precise, we give an interval of classes++data Kind+  = Kind { lowerKind :: Sort Expr , upperKind :: Sort Expr }+  | NoKind   -- absurd clauses, neutral wrt. union+  | AnyKind  -- not yet classified, neutral wrt. intersection+    deriving (Eq, Ord)++--defaultKind = Kind (SortC Tm) topSort -- no classification, could be anything+defaultKind = AnyKind++preciseKind s = Kind s s+kSize   = preciseKind (SortC Size)+kTSize  = preciseKind (SortC TSize)+kTerm   = preciseKind (SortC Tm)+kType   = preciseKind (Set Zero)+kUniv e = preciseKind (Set (Succ (sizeVarsToInfty e))) -- used in TypeChecker++instance Show Kind where+  show NoKind = "()"+  show AnyKind = "?"+--  show k | k == defaultKind = "?"+  show (Kind kl ku) | kl == ku = show kl+  show (Kind kl ku) = show kl ++ ".." ++ show ku++-- print kind in four letters+prettyKind :: Kind -> String+prettyKind NoKind                       = "none"+prettyKind AnyKind                      = "anyk"+-- prettyKind k | k == defaultKind         = "anyk"+prettyKind (Kind _ (SortC Tm))          = "term"+prettyKind (Kind _ (SortC Size))        = "size"+prettyKind k | k == kType               = "type"+prettyKind (Kind (Set (Succ Zero)) _)   = "univ"+prettyKind (Kind (Set Zero) _)          = "ty-u"+prettyKind (Kind (SortC Tm) (Set Zero)) = "tmty"+prettyKind k                            = "mixk"++-- if D : T and T has kind ki, then D has kind dataKind ki+dataKind :: Kind -> Kind+dataKind (Kind _ (Set (Succ e))) = Kind (Set Zero) (Set e)++-- in (x : A) -> B, if x : A and A has kind ki, then x has kind argKind ki+argKind :: Kind -> Kind+argKind NoKind = NoKind+argKind AnyKind = AnyKind+argKind (Kind s s') = Kind (predSort s) (predSort s')++-- if e : A and A has kind ki, then e has kind predKind ki+predKind :: Kind -> Kind+predKind NoKind = NoKind+predKind AnyKind = AnyKind+-- predecessors in the kind hierarchy+predKind ki@(Kind _ (SortC Size))  = error $ "predKind " ++ show ki+predKind (Kind _ (SortC TSize)) = kSize+-- proper types are only inhabited by terms+predKind (Kind _ (Set Zero)) = kTerm+-- proper universes are inhabited by types and universes+predKind (Kind (Set (Succ e)) s) = Kind (Set Zero) (predSort s)+-- something which is a type or a universe can be inhabited by a term+predKind (Kind _ s) = Kind (SortC Tm) (predSort s)++succKind :: Kind -> Kind+succKind AnyKind = AnyKind+succKind (Kind _ (SortC Tm)) = kType+succKind (Kind _ (SortC Size)) = kTSize+succKind (Kind s _) = Kind (succSort s) (Set Infty) -- no upper bound++-- partial operation!+intersectKind :: Kind -> Kind -> Kind+intersectKind NoKind ki = ki -- NoKind means here "intersection is not happening"+intersectKind ki NoKind = ki+intersectKind AnyKind ki = ki+intersectKind ki AnyKind = ki+intersectKind (Kind x1 x2) (Kind y1 y2) =+  Kind (maxSort x1 y1) (minSort x2 y2)++unionKind :: Kind -> Kind -> Kind+unionKind ki1 ki2 = -- trace (show ki1 ++ " `unionKind` " ++ show ki2) $+  case (ki1,ki2) of+    (NoKind, ki) -> ki+    (ki, NoKind) -> ki+    (AnyKind, ki) -> AnyKind+    (ki, AnyKind) -> AnyKind+    (Kind x1 x2, Kind y1 y2) ->+      Kind (minSort x1 y1) (maxSort x2 y2)++-- ki `irrelevantFor` ki' if an argument of kind ki cannot+-- computationally contribute to a result of kind ki'+irrelevantFor :: Kind -> Kind -> Bool+irrelevantFor NoKind _ = False -- do not make a statement if there is no info+irrelevantFor _ NoKind = False+irrelevantFor AnyKind _ = False+irrelevantFor _ AnyKind = False+irrelevantFor (Kind s _) (Kind _ s') = irrSortFor s s'+-- worst case szenario: the least kind of the argument is still+-- irrelevant for the biggest kind of the result++data Kinded a = Kinded { kindOf :: Kind, valueOf :: a }+                deriving (Eq, Ord, Functor, Foldable, Traversable)++instance Show a => Show (Kinded a) where+--  show (Kinded ki a) | ki == defaultKind = show a+  show (Kinded ki a) = show a ++ "::" ++ show ki++-- function domains --------------------------------------------------++data Dom a = Domain { typ :: a, kind :: Kind, decor :: Dec }+             deriving (Eq, Ord, Functor, Foldable, Traversable)++instance Show a => Show (Dom a) where+    show (Domain ty ki dec) = show dec ++ show ty ++ "::" ++ show ki++defaultDomain a = Domain a defaultKind defaultDec+domFromKinded (Kinded ki t) = Domain t ki defaultDec+defaultIrrDom a = Domain a defaultKind irrelevantDec++sizeDomain :: Dec -> Dom Expr+sizeDomain dec = Domain tSize kTSize dec++belowDomain :: Dec -> LtLe -> Expr -> Dom Expr+belowDomain dec ltle e = Domain (Below ltle e) kTSize dec++class LensDec a where+  getDec :: a -> Dec+  setDec :: Dec -> a -> a+  setDec d = mapDec $ const d+  mapDec :: (Dec -> Dec) -> a -> a+  mapDec f a = setDec (f $ getDec a) a++instance LensDec (Dom a) where+  getDec = decor+  setDec d dom = dom { decor = d }++instance LensPol (Dom a) where+  getPol = getPol . getDec+  mapPol = mapDec . mapPol++{-+instance Functor Dom where+  fmap f dom = dom { typ = f (typ dom) }++-- traverse :: Applicative f => (a -> f b) -> t a -> f (t b)+instance Traversable Dom where+  traverse f dom = (\ ty -> dom { typ = ty }) <$> f (typ dom)+-}++-- identifiers -------------------------------------------------------++-- |+data ConK+  = Cons    -- ^ a constructor+  | CoCons  -- ^ a coconstructor+  | DefPat  -- ^ a defined pattern+    deriving (Eq, Ord, Show)++data IdKind+  = DatK       -- ^ data/codata+  | ConK ConK  -- ^ constructor (ind/coind/defined)+  | FunK       -- ^ fun/cofun+  | LetK       -- ^ let definition+    deriving (Eq, Ord)++instance Show IdKind where+    show DatK   = "data"+    show ConK{} = "con"+    show FunK   = "fun"+    show LetK   = "let"++conKind (ConK _) = True+conKind _        = False++coToConK Ind = Cons+coToConK CoInd = CoCons++data DefId = DefId { idKind :: IdKind, idName :: QName }+           deriving (Eq, Ord)++instance Show DefId where+    show d = show (idName d) -- ++ "@" ++ show (idKind d)++type MVar = Int -- metavariables are numbered++-- typed bindings in Pi, LLet, Telescope -----------------------------++data TBinding a = TBind+  { boundName :: Name        -- ^ @emptyName@ if non-dependent.+  , boundDom  :: Dom a       -- ^ @x : T@ or @i < j@.+  }+  | TMeasure (Measure Expr)  -- ^ Measure @|m|@.+  | TBound   (Bound Expr)    -- ^ Constraint @|m| <(=) |m'|@.+    deriving (Eq,Ord,Show,Functor,Foldable,Traversable)++type LBind = TBinding (Maybe Type)+type TBind = TBinding Type++noBind :: Dom a -> TBinding a+noBind = TBind (fresh "")++boundType :: TBind -> Type+boundType = typ . boundDom++instance LensDec (TBinding a) where+  getDec = getDec . boundDom+  mapDec f (TBind x dom) = TBind x (dom { decor = f (decor dom) })+  mapDec f tb = tb++mapDecM :: (Applicative m) => (Dec -> m Dec) -> TBind -> m TBind+mapDecM f tb@TBind{} = flip setDec tb <$> f (getDec tb)+mapDecM f tb         = pure tb++-- measures ----------------------------------------------------------++newtype Measure a = Measure { measure :: [a] }    -- mu+    deriving (Eq,Ord,Functor,Foldable,Traversable)++instance Show a => Show (Measure a) where+    show (Measure l) = "|" ++ showList "," show l ++ "|"++succMeasure :: (a -> a) -> Measure a -> Measure a+succMeasure succ mu = maybe (error "cannot take successor of empty measure") id $ applyLastM (Just . succ) mu++{-+succMeasure succ (Measure mu) = Measure (succMeas mu)+  where succMeas []     = error "cannot take successor of empty measure"+        succMeas [e]    = [succ e]+        succMeas (e:es) = e : succMeas es+-}++applyLastM :: Monad m => (a -> m a) -> Measure a -> m (Measure a)+applyLastM f (Measure mu) = loop mu >>= return . Measure+  where loop []     = fail "empty measure"+        loop [e]    = f e >>= return . (:[])+        loop (e:es) = loop es >>= return . (e:)++instance HasPred a => HasPred (Measure a) where+  predecessor mu = applyLastM predecessor mu++data Bound a = Bound { ltle :: LtLe, leftBound :: Measure a, rightBound :: Measure a }  -- mu < mur  of mu <= mu'+    deriving (Eq,Ord,Functor,Foldable,Traversable)++instance Show a => Show (Bound a) where+  show (Bound Lt mu1 mu2) = show mu1 ++ " < " ++ show mu2+  show (Bound Le mu1 mu2) = show mu1 ++ " <= " ++ show mu2++{-+instance (HasPred a, Show a) => Show (Bound a) where+    show (Bound mu1 mu2) = case predecessor mu2 of+      Just mu2 -> show mu1 ++ " <= " ++ show mu2+      Nothing  -> show mu1 ++ " < " ++ show mu2+-}++-- TODO: properly implement bounds mu <= mu' such that mu <= # is+-- represented correctly++-- tagging expressions -----------------------------------------------++data Tag+  = Erased -- ^ Expression will be erased.+  | Cast   -- ^ Expression will need to be casted.+  deriving (Eq,Ord,Show)++type Tags = [Tag]++inTags :: Tag -> Tags -> Bool+inTags = elem++noTags = []++data Tagged a = Tagged { tags :: Tags , unTag :: a }+  deriving (Eq,Ord,Functor,Foldable,Traversable)++instance Show a => Show (Tagged a) where+  show (Tagged tags a) =+   bracketsIf (Erased `inTags` tags) $+     showCast (Cast `inTags` tags) $+       show  a++showCast :: Bool -> String -> String+showCast True  s = "'cast" ++ Util.parens s+showCast False s = s++instance Pretty a => Pretty (Tagged a) where+  prettyPrec k (Tagged []   a) = prettyPrec k a+  prettyPrec _ (Tagged tags a) =+    prettyErased (Erased `inTags` tags) $+      prettyCast (Cast `inTags` tags) $+        pretty a++prettyErased True  doc = brackets doc+prettyErased False doc = doc++prettyCast True  doc = text "'cast" <> PP.parens doc+prettyCast False doc = doc++-- expressions -------------------------------------------------------++data Expr+  = Sort (Sort Expr)   -- ^ @Size@ @Set@ @CoSet@+  -- sizes+  | Zero+  | Succ Expr+  | Infty+  | Max [Expr]   -- ^ (list has at least 2 elements)+  | Plus [Expr]  -- ^ (list has at least 2 elements)+  -- identifiers+  | Meta MVar    -- ^ meta-variable+  | Var Name     -- ^ variables are named+  | Def DefId    -- ^ identifiers in the signature+{-+  | Con Co Name [Expr] -- constructors applied to arguments+  | Def Name     -- fun/cofun ?+  | Let Name     -- definition (non-recursive)+-}+  -- dependently typed lambda calculus+  | Record RecInfo [(Name,Expr)] -- ^ record { p1 = e1; ...; pn = en }+  | Proj PrePost Name            -- ^ proj _  or  _ .proj+  | Pair Expr Expr+  | Case Expr (Maybe Type) [Clause]+    -- ^ Type is @Nothing@ in input, @Just@ after t.c.+  | LLet LBind Telescope Expr Expr+    -- ^ @let [x : A] = t in u@, @let [x] tel = t in u@+    --   after t.c. @Telescope@ is empty (fused into @LBind@)+  | App Expr Expr+  | Lam Dec Name Expr+  | Quant PiSigma TBind Expr+  | Sing Expr Expr  -- <t : A> singleton type+  -- instead of bounded quantification, a type for subsets+  -- use as @Pi/Sigma (TBind ... (Below ltle a)) b@+  | Below LtLe Expr                     -- ^ <(a : Size) or <=(a : Size)+  -- for extraction+  | Ann (Tagged Expr) -- ^ annotated expr, e.g. with Erased tag+  | Irr -- ^ for instance the term correponding to the absurd pattern+    deriving (Eq,Ord)++data PrePost = Pre | Post deriving (Eq, Ord, Show)+data PiSigma = Pi | Sigma deriving (Eq, Ord)++instance Show PiSigma where+  show Pi    = "->"+  show Sigma = "&"++-- | Optional constructor name of a record value.+data RecInfo+  = AnonRec                           -- ^ anonymous record+  | NamedRec { recConK :: ConK+             , recConName :: QName    -- ^ record constructor+             , recNamedFields :: Bool -- ^ print field names?+             , recDottedRef :: Dotted -- ^ coming from dotted constructor (unconfirmed)+             }+  deriving (Eq, Ord)++newtype Dotted = Dotted { dottedRef :: IORef Bool }++instance Eq   Dotted where x == y = True+instance Ord  Dotted where x <= y = True+instance Show Dotted where show d = fwhen (isDotted d) ("un" ++) "confirmed"++-- A bit of imperative programming++mkDotted :: MonadIO m => Bool -> m Dotted+mkDotted b = liftIO $ Dotted <$> newIORef b++-- default value, shared over all instances+{-# NOINLINE notDotted #-}+notDotted :: Dotted+notDotted = unsafePerformIO $ mkDotted False++isDotted :: Dotted -> Bool+isDotted = unsafePerformIO . readIORef . dottedRef++clearDotted :: MonadIO m => Dotted -> m ()+clearDotted d | isDotted d = liftIO $ do+      -- putStrLn ("clearing a dot")+      writeIORef (dottedRef d) False+  | otherwise = return ()++alignDotted :: MonadIO m => Dotted -> Dotted -> m ()+alignDotted d1 d2 = case (isDotted d1, isDotted d2) of+  (True, False) -> clearDotted d1+  (False, True) -> clearDotted d2+  _             -> return ()++recDotted :: RecInfo -> Bool+recDotted NamedRec{recDottedRef} = isDotted recDottedRef+recDotted AnonRec = False++instance Show RecInfo where+  show AnonRec              = ""+  show ri@NamedRec{recConName} = (if recDotted ri then "." else "") ++ show recConName++-- * smart constructors++-- | Create a universal binding.  Fuse hidden bindings.+pi :: TBind -> Expr -> Expr+pi = piSig Pi++piSig :: PiSigma -> TBind -> Expr -> Expr+piSig = Quant+{-+piSig piSig ta e =+  case ta of+    ta@TBind{ boundDom = Domain{ decor = Hidden }} ->+      case e of+        Quant piSig' tel tb c | piSig == piSig'+          -> Quant piSig (Telescope $ ta : telescope tel) tb c+        _ -> error $ "lone hidden binding" ++ show ta+    _ -> Quant piSig emptyTel ta e+-}++proj :: Expr -> PrePost -> Name -> Expr+proj e Pre n  = App (Proj Pre n) e+proj e Post n = App e (Proj Post n)++-- | Non-dependent function type.+funType a b = Quant Pi (noBind a) b++erasedExpr e = Ann (Tagged [Erased] e)+castExpr   e = Ann (Tagged [Cast]   e)++succView :: Expr -> (Int, Expr)+succView (Succ e) = inc (succView e) where inc (n, e) = (n+1, e)+succView e = (0, e)++-- Clauses and patterns ----------------------------------------------++data Clause = Clause+  { clTele     :: TeleVal      -- top-level telescope of type values for PVars+  , clPatterns :: [Pattern]+  , clExpr     :: Maybe Expr   -- Nothing if absurd clause+  } deriving (Eq,Ord,Show)++-- clause = Clause (error "internal error: no telescope in clause before typechecking!")+clause = Clause [] -- empty clTele++data PatternInfo = PatternInfo+  { coPat          :: ConK    -- (co)constructor+  , irrefutablePat :: Bool    -- constructor of a record (UNUSED)+  , dottedPat      :: Bool+  } deriving (Eq,Ord,Show)++type Pattern = Pat Expr++-- | Patterns parametrized by type of dot patterns.+data Pat e+  = VarP Name                      -- ^ x+  | ConP PatternInfo QName [Pat e] -- ^ (c ps) and (.c ps)+  | SuccP (Pat e)                  -- ^ ($ p)+  | SizeP e Name                   -- ^ (x > y) (# > y) ($x > y)+  | PairP (Pat e) (Pat e)          -- ^ (p, p')+  | ProjP Name                     -- ^ .proj+  | DotP e                         -- ^ .e+  | AbsurdP                        -- ^ ()+  | ErasedP (Pat e)                -- ^ pattern which got erased+  | UnusableP (Pat e)+{- ^ a pattern which results from matching a coinductive type and+the corresponding size index is not in the coinductive result type of+the function.  Such a pattern is not usable for termination+checking. -}+{-+             | IrrefutableP (Pat e) -- pattern made from record constructors+                                    -- can be matched by applying destructors+  NOT GOOD ENOUGH.  Irrefutable constructors might be mixed with others, e.g.++    pair x refl++  The whole pattern is not irrefutable, but still you want the pair destructed+  lazily by projections.+-}+--  | IrrP -- pattern which got erased+               deriving (Eq,Ord)++{-+-- which pattern shapes are irrefutable?+-- only ConP and SuccP might be refutable+irrefutable :: Pattern -> Bool+irrefutable ConP{} = False+irrefutable SuccP{} = False+irrefutable VarP{}         = True+irrefutable SizeP{}        = True+irrefutable IrrefutableP{} = True+irrefutable DotP{}         = True+irrefutable AbsurdP{}      = True+irrefutable ErasedP{}      = True+-}++type Case = (Pattern,Expr)++type Subst = Map MVar Expr++con co n = Def $ DefId (ConK co) n+-- con co n = Con co n []+fun n    = Def $ DefId FunK n+dat n    = Def $ DefId DatK n+letdef n = Def $ DefId LetK $ QName n++type SpineView = (Expr, [Expr])++-- collect applications to expose head+spineView :: Expr -> SpineView+spineView = aux []+  where aux sp (App f e) = aux (e:sp) f+        aux sp e = (e, sp)++test_spineView = spineView ((Var x `App` Var y) `App` Var z)+  where x = fresh "x"+        y = fresh "y"+        z = fresh "z"+{-+  where x = Name "x" $ unsafePerformIO newUnique+        y = Name "y" $ unsafePerformIO newUnique+        z = Name "z" $ unsafePerformIO newUnique+-}++{-+-- sort expressions+set  = Sort Set+size = Sort Size+-}++isErasedExpr :: Expr -> (Bool, Expr)+isErasedExpr (Ann (Tagged tags e)) =+  let (b, e') = isErasedExpr e+  in  (b || Erased `inTags` tags, e')+isErasedExpr e = (False, e)++type Extr = Expr -- extracted expressions+type EType = Type -- extracted types++-- declarations --------------------------------------------------++data Declaration+  = DataDecl Name Sized Co [Pol] Telescope Type [Constructor] [Name] -- data/codata+  | RecordDecl Name Telescope Type Constructor [Name] -- record+  | MutualFunDecl Bool Co [Fun]     -- mutual fun block / mutual cofun block, bool for measured+  | FunDecl Co Fun  -- fun, possibly inside MutualDecl+  | LetDecl Bool Name Telescope (Maybe Type) Expr+      -- ^ Bool for eval.  After t.c., tel. is empty and type is Just.+  | PatternDecl Name [Name] Pattern+  | MutualDecl Bool [Declaration]  -- mutual data/fun block, bool for measured+  | OverrideDecl Override [Declaration]    -- expect/ignore some type error+    deriving (Eq,Ord,Show)++data Override+  = Fail            -- ^ expect an error, ignore block+  | Check           -- ^ expect no error, still ignore block+  | TrustMe         -- ^ ignore recoverable errors+  | Impredicative   -- ^ use impredicativity for these declarations+    deriving (Eq,Ord,Show)++data TySig a = TypeSig { namePart :: Name, typePart :: a }+               deriving (Eq,Ord,Show,Functor)+type TypeSig = TySig Type++type Type = Expr++-- | Constructor declaration.  Top-level scope (independent of data pars).+data Constructor = Constructor+ { ctorName :: QName       -- ^ Name of the constructor.+ , ctorPars :: ParamPats   -- ^ Constructor patterns (if new style params).+ , ctorType :: Type        -- ^ Constructor type (@fields -> target@).+ } deriving (Eq, Ord, Show)++type ParamPats = Maybe (Telescope, [Pattern])++newtype Telescope = Telescope { telescope :: [TBind] }+  deriving (Eq, Ord, Show, Size, Null)++emptyTel = Telescope []++data Arity = Arity+  { fullArity    :: Int        -- ^ arity of the function+  , isProjection :: Maybe Int  -- ^ projection? then number of parameters+  } deriving (Eq, Ord, Show)++data Fun = Fun+  { funTypeSig :: TypeSig      -- ^ internal name and type+  , funExtName :: Name         -- ^ external name (for associated eta-expanded fun)+  , funArity   :: Arity+  , funClauses :: [Clause]+  } deriving (Eq, Ord, Show)++{-+letToFun :: TypeSig -> Expr -> Fun+letToFun ts e = (ts, (0, [Clause [] $ Just e]))+-}++-- extracted declarations --------------------------------------------++type EDeclaration = Declaration+type EClause      = Clause+type EPattern     = Pattern+type EConstructor = Constructor+type ETypeSig     = TypeSig+type EFun         = Fun+type ETelescope   = Telescope++-- boilerplate -------------------------------------------------------++{-+instance Functor TySig where+  fmap f ts = ts { typePart = f (typePart ts) }+-}++-- eraseMeasure (Delta -> mu -> T) = Delta -> T+eraseMeasure :: Expr -> Expr+eraseMeasure (Quant Pi (TMeasure{}) b) = b -- there can only be one measure!+eraseMeasure (Quant Pi a@(TBind{}) b)  = Quant Pi a $ eraseMeasure b+eraseMeasure (Quant Pi a@(TBound{}) b) = Quant Pi a $ eraseMeasure b+eraseMeasure (LLet a tel e b) = LLet a tel e $ eraseMeasure b+eraseMeasure t = t++-- inferable term = True/False+-- not needed for types or sizes+inferable :: Expr -> Bool+inferable Var{}   = True+inferable Sort{}  = True+inferable Zero{}  = True+inferable Infty{} = True+--inferable Con{}   = True+-- 2012-01-22 constructors are no longer inferable, since parameters are missing+inferable (Def (DefId { idKind = ConK{} }))  = False+inferable Def{} = True+inferable (App f e) = inferable f+-- inferable (Pair f e) = inferable f && inferable e  -- pairs are not inferable due to irrelevant sigma!+-- inferable Sing{}  = True  -- not with universes+inferable _       = False++-- | Collect the variables from the binders+class BoundVars a where+  boundVars :: Collection c Name => a -> c++instance BoundVars a => BoundVars [a] where+  boundVars = foldMap boundVars++instance BoundVars a => BoundVars (Maybe a) where+  boundVars = foldMap boundVars++instance (BoundVars a, BoundVars b) => BoundVars (a, b) where+  boundVars (a, b) = mconcat [boundVars a, boundVars b]++instance (BoundVars a, BoundVars b, BoundVars c) => BoundVars (a, b, c) where+  boundVars (a, b, c) = mconcat [boundVars a, boundVars b, boundVars c]++instance BoundVars (TBinding a) where+  boundVars (TBind x a)  = Coll.singleton x+  boundVars (TMeasure m) = mempty+  boundVars (TBound b)   = mempty++instance BoundVars Telescope where+  boundVars = boundVars . telescope++instance BoundVars (Pat e) where+  boundVars (VarP name)   = Coll.singleton name+  boundVars (SizeP x y)   = Coll.singleton y+  boundVars (SuccP p)     = boundVars p+  boundVars (ConP _ _ ps) = boundVars ps+  boundVars (PairP p p')  = boundVars (p, p')+  boundVars (ProjP _)     = mempty+  boundVars (DotP _)      = mempty+  boundVars (ErasedP p)   = boundVars p+  boundVars (AbsurdP)     = mempty+  boundVars (UnusableP p) = mempty++++-- | Boilerplate to extract free variables in the usual sense.+class FreeVars a where+  freeVars :: a -> Set Name++instance FreeVars a => FreeVars [a] where+  freeVars = foldMap freeVars++instance FreeVars a => FreeVars (Maybe a) where+  freeVars = foldMap freeVars++instance FreeVars a => FreeVars (Sort a) where+  freeVars = foldMap freeVars++instance FreeVars a => FreeVars (Dom a) where+  freeVars = foldMap freeVars++instance FreeVars a => FreeVars (Measure a) where+  freeVars = foldMap freeVars++instance FreeVars a => FreeVars (Bound a) where+  freeVars = foldMap freeVars++instance FreeVars a => FreeVars (Tagged a) where+  freeVars = foldMap freeVars++instance (FreeVars a, FreeVars b) => FreeVars (a, b) where+  freeVars (a, b) = mconcat [freeVars a, freeVars b]++instance (FreeVars a, FreeVars b, FreeVars c) => FreeVars (a, b, c) where+  freeVars (a, b, c) = mconcat [freeVars a, freeVars b, freeVars c]++instance FreeVars a => FreeVars (TBinding a) where+  freeVars (TBind x a)  = freeVars a  -- Note: x is bound in the stuff to come, not in a.+  freeVars (TMeasure m) = freeVars m+  freeVars (TBound b)   = freeVars b++instance FreeVars Telescope where+  freeVars (Telescope [])         = mempty+  freeVars (Telescope (tb : tel)) = freeVars tb `Set.union`+                          (freeVars (Telescope tel) Set.\\ boundVars tb)++instance FreeVars Expr where+  freeVars e0 =+    case e0 of+      Sort s    -> freeVars s+      Zero      -> mempty+      Succ e    -> freeVars e+      Infty     -> mempty+      Var name  -> Set.singleton name+      Def{}     -> mempty+      Case e mt cls+                -> freeVars (e, mt, cls)+      LLet (TBind x dom) tel t u | null tel+                -> freeVars (dom, t) `Set.union` Set.delete x (freeVars u)+      Pair f e  -> freeVars (f, e)+      App  f e  -> freeVars (f, e)+      Max  es   -> freeVars es+      Plus es   -> freeVars es+      Lam _ x e -> Set.delete x (freeVars e)+      Quant pisig ta b -> freeVars ta `Set.union` (freeVars b Set.\\ boundVars ta)+{-+      Quant pisig tel ta b+                -> freeVars tel' `Set.union` (freeVars b Set.\\ boundVars tel')+                     where tel' = Telescope $ telescope tel ++ [ta]+-}+      Sing e t  -> freeVars (e, t)+      Below _ e -> freeVars e+      Ann te    -> freeVars te+      Irr       -> mempty+      e         -> error $ "freeVars " ++ show e ++ " not implemented"++instance FreeVars Clause where+  freeVars (Clause _ ps Nothing)  = mempty  -- absurd clause+  freeVars (Clause _ ps (Just e)) = freeVars e Set.\\ boundVars ps++patternVars :: Pattern -> [Name]+patternVars = boundVars+{-+patternVars (VarP name)   = [name]+patternVars (SizeP x y)   = [y]+patternVars (SuccP p)     = patternVars p+patternVars (ConP _ _ ps) = List.concat $ List.map patternVars ps+patternVars (PairP p p')  = patternVars p ++ patternVars p'+patternVars (DotP _)      = []+patternVars (ErasedP p)   = patternVars p+patternVars (AbsurdP)     = []+-}++-- | Get all the definitions that are refered to in expression.+--   This is used e.g. to check whether a (co)fun is recursive.+class UsedDefs a where+  usedDefs :: a -> [Name]++instance UsedDefs a => UsedDefs [a] where+  usedDefs = foldMap usedDefs++instance UsedDefs a => UsedDefs (Maybe a) where+  usedDefs = foldMap usedDefs++instance UsedDefs a => UsedDefs (Sort a) where+  usedDefs = foldMap usedDefs++instance UsedDefs a => UsedDefs (Dom a) where+  usedDefs = foldMap usedDefs++instance UsedDefs a => UsedDefs (Measure a) where+  usedDefs = foldMap usedDefs++instance UsedDefs a => UsedDefs (Bound a) where+  usedDefs = foldMap usedDefs++instance UsedDefs a => UsedDefs (Tagged a) where+  usedDefs = foldMap usedDefs++instance (UsedDefs a, UsedDefs b) => UsedDefs (a, b) where+  usedDefs (a, b) = mconcat [usedDefs a, usedDefs b]++instance (UsedDefs a, UsedDefs b, UsedDefs c) => UsedDefs (a, b, c) where+  usedDefs (a, b, c) = mconcat [usedDefs a, usedDefs b, usedDefs c]++instance (UsedDefs a, UsedDefs b, UsedDefs c, UsedDefs d) => UsedDefs (a, b, c, d) where+  usedDefs (a, b, c, d) = mconcat [usedDefs a, usedDefs b, usedDefs c, usedDefs d]++instance UsedDefs a => UsedDefs (TBinding a) where+  usedDefs (TBind _ e)  = usedDefs e+  usedDefs (TMeasure m) = usedDefs m+  usedDefs (TBound b)   = usedDefs b++instance UsedDefs Telescope where+  usedDefs = usedDefs . telescope++instance UsedDefs DefId where+  usedDefs id+    | idKind id `elem` [FunK, DatK] = [unqual $ idName id]+    | otherwise                     = []++instance UsedDefs Clause where+  usedDefs = usedDefs . clExpr++instance UsedDefs Expr where+  usedDefs (Def id)           = usedDefs id+  usedDefs (Pair f e)         = usedDefs (f, e)+  usedDefs (App f e)          = usedDefs (f, e)+  usedDefs (Max es)           = usedDefs es+  usedDefs (Plus es)          = usedDefs es+  usedDefs (Lam _ x e)        = usedDefs e+  usedDefs (Sing a b)         = usedDefs (a, b)+  usedDefs (Below _ b)        = usedDefs b+--  usedDefs (Quant _ tel tb b) = usedDefs (tel, tb, b)+  usedDefs (Quant _ tb b)     = usedDefs (tb, b)+  usedDefs (LLet tb tel e1 e2)= usedDefs (tb, tel, e1, e2)+  usedDefs (Succ e)           = usedDefs e+  usedDefs (Case e mt cls)    = usedDefs (e, mt, cls)+  usedDefs (Ann e)            = usedDefs e+  usedDefs (Sort s)           = usedDefs s+  usedDefs Zero               = []+  usedDefs Infty              = []+  usedDefs Meta{}             = []+  usedDefs Var{}              = []+  usedDefs Proj{}             = []+  usedDefs (Record ri rs)     = foldMap (usedDefs . snd) rs+  usedDefs e                  = error $ "usedDefs " ++ show e ++ " not implemented"++rhsDefs :: [Clause] -> [Name]+rhsDefs cls = List.foldl (\ ns (Clause _ ps e) -> maybe [] usedDefs e ++ ns) [] cls++-- pretty printing expressions ---------------------------------------++[precArrL, precAppL, precAppR] = [1..3]++instance Pretty Name where+--  pretty x = text $ suggestion x+  pretty x = text $ show x++instance Pretty QName where+  pretty (Qual m n) = pretty m <> text "." <> pretty n+  pretty (QName n)  = pretty n++instance Pretty DefId where+--    pretty d = pretty $ name d+    pretty d = text $ show d++instance Pretty Expr where+  prettyPrec _ Irr         = text "."+  prettyPrec k (Sort s)    = prettyPrec k s+  prettyPrec _ Zero        = text "0"+  prettyPrec _ Infty       = text "#"+  prettyPrec _ (Meta i)    = text $ "?" ++ show i+  prettyPrec _ (Var n)     = pretty n+--  prettyPrec _ (Con _ n)   = text n+  prettyPrec _ (Def id)    = pretty id+--  prettyPrec _ (Let n)     = text n+  prettyPrec _ (Sing e t)  = angleBrackets $ pretty e <+> colon <+> pretty t+  prettyPrec k e@Succ{}    =+    case succView e of+      (n, Zero) -> text $ show n+      (n, e)    -> text (replicate n '$') <> prettyPrec precAppR e+--  prettyPrec k (Succ e)    = text "$" <> prettyPrec precAppR e+{-  prettyPrec k (Succ e)    = parensIf (precAppR <= k) $+                              text "$" <+> prettyPrec precAppR e   -}+  prettyPrec k (Max es)  = parensIf (precAppR <= k) $+    List.foldl (\ d e -> d <+> prettyPrec precAppR e) (text "max") es+  prettyPrec k (Plus (e:es))  = parensIf (1 < k) $+    List.foldl (\ d e -> d <+> text "+" <+> prettyPrec 1 e) (prettyPrec 1 e) es+  prettyPrec k (Proj Pre n)   = pretty n+  prettyPrec k (Proj Post n)  = text "." <> pretty n+  prettyPrec k (Record AnonRec []) = text "record" <+> braces empty+  prettyPrec k (Record AnonRec rs) = text "record" <+> prettyRecFields rs+  prettyPrec k (Record (NamedRec _ n _ dotted) []) = dotIf dotted $ pretty n+  prettyPrec k (Record (NamedRec _ n True dotted) rs) = dotIf dotted $ pretty n <+> prettyRecFields rs+  prettyPrec k (Record (NamedRec _ n False dotted) rs) =+   parensIf (not (null rs) && precAppR <= k) $ dotIf dotted $+     pretty n <+> hsep (List.map (prettyPrec precAppR . snd) rs)+  prettyPrec k (Pair e1 e2) = parens $ pretty e1 <+> comma <+> pretty e2+  prettyPrec k (App f e)  = parensIf (precAppR <= k) $+    prettyPrec precAppL f <+> prettyPrec precAppR e+--   prettyPrec k (App e [])  = prettyPrec k e+--   prettyPrec k (App e es)  = parensIf (precAppR <= k) $+--     List.foldl (\ d e -> d <+> prettyPrec precAppR e) (prettyPrec precAppL e) es+  prettyPrec k (Case e mt cs) = parensIf (0 < k) $+    (text "case" <+> pretty e) <+> (maybe empty (\ t -> colon <+> pretty t) mt) $$ (vlist $ List.map prettyCase cs)+  prettyPrec k (Lam dec x e) = parensIf (0 < k) $+    (if erased dec then brackets else id) (text "\\" <+> pretty x <+> text "->")+      <+> pretty e+  prettyPrec k (LLet (TBind n (Domain mt ki dec)) tel e1 e2) | null tel = parensIf (0 < k) $+    (text "let" <+> ((if erased dec then lbrack else PP.empty) <>+       pretty n <+> vcat [ maybe empty (\ t -> colon <+> pretty t) mt+                           <> (if erased dec then rbrack else PP.empty)+                       , equals <+> pretty e1 ]))+    $$ (text "in" <+> pretty e2)+  prettyPrec k (LLet (TBind n (Domain mt ki dec)) tel e1 e2) = parensIf (0 < k) $+    (text "let" <+> ((if erased dec then brackets else id) $ pretty n)+                <+> pretty tel+                <+> vcat [ maybe empty (\ t -> colon <+> pretty t) mt+                         , equals <+> pretty e1 ])+    $$ (text "in" <+> pretty e2)+{-+  prettyPrec k (LLet (TBind n (Domain Nothing ki dec)) e1 e2) = parensIf (0 < k) $+    (text "let" <+> ((if erased dec then lbrack else PP.empty) <>+       pretty n <+> vcat [ if erased dec then rbrack else PP.empty+                         , equals <+> pretty e1 ]))+    $$ (text "in" <+> pretty e2)+-}+  prettyPrec k (Below ltle e) = pretty ltle <+> prettyPrec k e+  prettyPrec k (Quant Pi (TMeasure mu) t2) = parensIf (precArrL <= k) $+    (pretty mu <+> text "->" <+> pretty t2)+  prettyPrec k (Quant Pi (TBound beta) t2) = parensIf (precArrL <= k) $+    (pretty beta <+> text "->" <+> pretty t2)++  prettyPrec k (Quant pisig (TBind x (Domain t1 ki dec)) t2) | null (suggestion x) = parensIf (precArrL <= k) $+    ((if erased dec then ppol <> brackets (pretty t1)+       else ppol <+> prettyPrec precArrL t1)+      <+> pretty pisig <+> pretty t2)+    where pol = polarity dec+          ppol = if pol==defaultPol then PP.empty else text $ show pol++  prettyPrec k (Quant pisig (TBind x (Domain (Below ltle t1) ki dec)) t2) = parensIf (precArrL <= k) $+    ppol <>+    ((if erased dec then brackets else parens) $+      pretty x <+> pretty ltle <+> pretty t1) <+> pretty pisig <+> pretty t2+    where pol = polarity dec+          ppol = if pol==defaultPol then PP.empty else text $ show pol++  prettyPrec k (Quant pisig (TBind x (Domain t1 ki dec)) t2) = parensIf (precArrL <= k) $+    ppol <>+    ((if erased dec then brackets else parens) $+      pretty x <+> colon <+> pretty t1) <+> pretty pisig <+> pretty t2+    where pol = polarity dec+          ppol = if pol==defaultPol then PP.empty else text $ show pol++  prettyPrec k (Ann e) = pretty e++class DotIf a where+  dotIf :: a -> Doc -> Doc++instance DotIf Bool where+  dotIf False d = d+  dotIf True  d = text "." <> d++instance DotIf Dotted where+  dotIf c = dotIf (isDotted c)++instance Pretty TBind where+  prettyPrec k (TMeasure mu) = pretty mu+  prettyPrec k (TBound beta) = pretty beta++  prettyPrec k (TBind x (Domain (Below ltle t1) ki dec)) =+    ppol <>+    ((if erased dec then brackets else parens) $+      pretty x <+> pretty ltle <+> pretty t1)+    where pol = polarity dec+          ppol = if pol==defaultPol then PP.empty else text $ show pol++  prettyPrec k (TBind x (Domain t1 ki dec)) =+    ppol <>+    ((if erased dec then brackets else parens) $+      pretty x <+> colon <+> pretty t1)+    where pol = polarity dec+          ppol = if pol==defaultPol then PP.empty else text $ show pol++instance Pretty Telescope where+  prettyPrec k tel = sep $ map pretty $ telescope tel++prettyRecFields rs =+    let l:ls = List.map (\ (n, e) -> pretty n <+> equals <+> prettyPrec 0 e) rs+    in  cat $ (lbrace <+> l) : List.map (semi <+>) ls ++ [empty <+> rbrace]++prettyCase (Clause _ [p] Nothing)  = pretty p+prettyCase (Clause _ [p] (Just e)) = pretty p <+> text "->" <+> pretty e++instance Pretty PiSigma where+  pretty Pi    = text "->"+  pretty Sigma = text "&"++vlist :: [Doc] -> Doc+vlist [] = lbrace <> rbrace+vlist ds = (vcat $ zipWith (<+>) (lbrace : repeat semi) ds) $$ rbrace++instance Pretty (Measure Expr) where+  pretty (Measure es) = text "|" <> hsepBy comma (List.map pretty es) <> text "|"++instance Pretty LtLe where+  pretty Lt = text "<"+  pretty Le = text "<="++instance Pretty (Bound Expr) where+  pretty (Bound ltle mu mu') = pretty mu <+> pretty ltle <+> pretty mu'++{-+instance Pretty (Bound Expr) where+  pretty (Bound mu mu') = case predecessor mu' of+    Nothing -> pretty mu <+> text "<" <+> pretty mu'+    Just mu' -> pretty mu <+> text "<=" <+> pretty mu'+-}+++instance Pretty (Sort Expr) where+  prettyPrec k (SortC c)  = text $ show c+  prettyPrec k (Set Zero) = text "Set" -- print as Set for backwards compat.+  prettyPrec k (Set e) =  parensIf (precAppR <= k) $+    text "Set" <+> prettyPrec precAppR e+  prettyPrec k (CoSet e) = parensIf (precAppR <= k) $+    text "CoSet" <+> prettyPrec precAppR e++instance Pretty Pattern where+  prettyPrec k (VarP x)       = pretty x+  prettyPrec k (ConP co c ps) = parensIf (not (null ps) && precAppR <= k) $+    -- (if dottedPat co then text "." else empty) <>+    dotIf (dottedPat co) $ pretty c <+> hsep (List.map (prettyPrec precAppR) ps)+  prettyPrec k (SuccP p)      = text "$" <> prettyPrec k p+  prettyPrec k (SizeP x y)    = parensIf (precAppR <= k) $ pretty y <+> text "<" <+> pretty x+  prettyPrec k (PairP p p')   = parens $ pretty p <> comma <+> pretty p'+  prettyPrec k (UnusableP p)  = prettyPrec k p+  prettyPrec k (ProjP x)      = text "." <> pretty x+  prettyPrec k (DotP p)       = text "." <> prettyPrec precAppR p+  prettyPrec k (AbsurdP)      = text "()"+  prettyPrec k (ErasedP p)    = brackets $ prettyPrec 0 p+++instance Show Expr where+  showsPrec k e s = render (prettyPrec k e) ++ s+  -- show = render . pretty -- showExpr++instance Show Pattern where+  show = render . pretty++showCase (Clause _ [p] Nothing) = render (prettyPrec precAppR p)+showCase (Clause _ [p] (Just e)) = render (prettyPrec precAppR p) ++ " -> " ++ show e+showCases = showList "; " showCase++++-- substitution ------------------------------------------------------++{-+class PatSubst p where+  patSubst :: [(Name, Expr)] -> p -> p++instance PatSubst Name where+  patSubst phi n = maybe p id $ lookup n phi+-}++-- | substitute into pattern+patSubst :: [(Name, Pattern)] -> Pattern -> Pattern+patSubst phi p =+  let phi' x = maybe (Var x) patternToExpr $ lookup x phi+  in+  case p of+    VarP n -> maybe p id $ lookup n phi+    ConP pi n ps -> ConP pi n $ List.map (patSubst phi) ps+    SuccP p      -> SuccP $ patSubst phi p+    SizeP e y    -> SizeP (parSubst phi' e) y+    PairP p1 p2  -> PairP (patSubst phi p1) (patSubst phi p2)+    ProjP x      -> p+    DotP e       -> DotP $ parSubst phi' e+    AbsurdP      -> p+    ErasedP p    -> ErasedP $ patSubst phi p+    UnusableP p   -> UnusableP $ patSubst phi p++-- parallel substitution (CAUTION! NOT CAPTURE AVOIDING!)+-- only needed to generate destructors+-- does not substitute into patterns of a Case++class ParSubst a where+  parSubst :: (Name -> Expr) -> a -> a++instance ParSubst a => ParSubst [a] where+  parSubst = map . parSubst++instance ParSubst a => ParSubst (Maybe a) where+  parSubst = fmap . parSubst++instance ParSubst a => ParSubst (Dom a) where+  parSubst = fmap . parSubst++instance ParSubst a => ParSubst (Measure a) where+  parSubst = fmap . parSubst++instance ParSubst a => ParSubst (Bound a) where+  parSubst = fmap . parSubst++instance ParSubst a => ParSubst (Tagged a) where+  parSubst = fmap . parSubst++instance ParSubst a => ParSubst (TBinding a) where+  parSubst phi (TBind x a)  = TBind x  $ parSubst phi a+  parSubst phi (TMeasure m) = TMeasure $ parSubst phi m+  parSubst phi (TBound b)   = TBound   $ parSubst phi b++instance ParSubst a => ParSubst (Sort a) where+  parSubst phi (CoSet e) = CoSet $ parSubst phi e+  parSubst phi (Set e)   = Set   $ parSubst phi e+  parSubst phi s         = s++instance ParSubst Telescope where+  parSubst phi = Telescope . parSubst phi . telescope++instance ParSubst Clause where+  parSubst phi (Clause tel ps e) = Clause tel ps $ parSubst phi e++-- TODO: Refactor!+instance ParSubst Expr where+  parSubst phi (Sort s)              =  Sort $ parSubst phi s+  parSubst phi (Succ e)              = Succ (parSubst phi e)+  parSubst phi e@Zero                = e+  parSubst phi e@Infty               = e+  parSubst phi e@Meta{}              = e+  parSubst phi e@Proj{}              = e+  parSubst phi (Var x)               = phi x+  parSubst phi e@Def{}               = e+  parSubst phi (Case e mt cls)       = Case (parSubst phi e) (parSubst phi mt) (parSubst phi cls)+  parSubst phi (LLet ta tel b c)     = LLet (parSubst phi ta) (parSubst phi tel) (parSubst phi b) (parSubst phi c)+  parSubst phi (Pair f e)            = Pair (parSubst phi f) (parSubst phi e)+  parSubst phi (App f e)             = App (parSubst phi f) (parSubst phi e)+  parSubst phi (Record ri rs)        = Record ri (mapAssoc (parSubst phi) rs)+  parSubst phi (Max es)              = Max (parSubst phi es)+  parSubst phi (Plus es)             = Plus (parSubst phi es)+  parSubst phi (Lam dec x e)         = Lam dec x (parSubst phi e)+  parSubst phi (Below ltle e)        = Below ltle (parSubst phi e)+  parSubst phi (Quant pisig a b)     = Quant pisig (parSubst phi a) (parSubst phi b)+--  parSubst phi (Quant pisig tel a b) = Quant pisig (parSubst phi tel) (parSubst phi a) (parSubst phi b)+  parSubst phi (Sing a b)            = Sing (parSubst phi a) (parSubst phi b)+  parSubst phi (Ann e)               = Ann $ parSubst phi e+  parSubst phi e                     = error $ "Abstract.parSubst phi (" ++ show e ++ ") undefined"+  {- NOT NEEDED+  sgSubst :: Name -> Expr -> Expr -> Expr+  sgSubst x t u = parSubst (\ y -> if x == y then t else Var y) u+  -}+++-- | Metavariable substitution. (BY INTENTION NOT CAPTURE AVOIDING!)+--   Does not substitute in patterns!+class Substitute a where+  subst :: Subst -> a -> a++instance Substitute a => Substitute [a] where+  subst = map . subst++instance Substitute a => Substitute (Maybe a) where+  subst = fmap . subst++instance Substitute a => Substitute (Dom a) where+  subst = fmap . subst++instance Substitute a => Substitute (Measure a) where+  subst = fmap . subst++instance Substitute a => Substitute (Bound a) where+  subst = fmap . subst++instance Substitute a => Substitute (Tagged a) where+  subst = fmap . subst++instance Substitute a => Substitute (TBinding a) where+  subst phi (TBind x a)  = TBind x  $ subst phi a+  subst phi (TMeasure m) = TMeasure $ subst phi m+  subst phi (TBound b)   = TBound   $ subst phi b++instance Substitute a => Substitute (Sort a) where+  subst phi (CoSet e) = CoSet $ subst phi e+  subst phi (Set e)   = Set   $ subst phi e+  subst phi s         = s++instance Substitute Telescope where+  subst phi = Telescope . subst phi . telescope++instance Substitute Clause where+  subst phi (Clause tel ps e) = Clause tel ps $ subst phi e++instance Substitute Expr where+  subst phi (Sort s)              = Sort $ subst phi s+  subst phi (Succ e)              = Succ (subst phi e)+  subst phi e@Zero                = e+  subst phi e@Infty               = e+  subst phi e@(Meta i)            = Map.findWithDefault e i phi+  subst phi e@Var{}               = e+  subst phi e@Def{}               = e+  subst phi e@Proj{}              = e+  subst phi (Case e mt cls)       = Case (subst phi e) (subst phi mt) (subst phi cls)+  subst phi (LLet ta tel b c)     = LLet (subst phi ta) (subst phi tel) (subst phi b) (subst phi c)+  subst phi (Pair f e)            = Pair (subst phi f) (subst phi e)+  subst phi (App f e)             = App (subst phi f) (subst phi e)+  subst phi (Record ri rs)        = Record ri (mapAssoc (subst phi) rs)+  subst phi (Max es)              = Max (subst phi es)+  subst phi (Plus es)             = Plus (subst phi es)+  subst phi (Lam dec x e)         = Lam dec x (subst phi e)+  subst phi (Below ltle e)        = Below ltle (subst phi e)+  subst phi (Quant pisig a b)     = Quant pisig (subst phi a) (subst phi b)+--  subst phi (Quant pisig tel a b) = Quant pisig (subst phi tel) (subst phi a) (subst phi b)+  subst phi (Sing a b)            = Sing (subst phi a) (subst phi b)+  subst phi (Ann e)               = Ann $ subst phi e+  subst phi e                     = error $ "Abstract.subst phi (" ++ show e ++ ") undefined"++-- Printing declarations ---------------------------------------------++{-+instance Show Declaration where+  show = render . pretty++instance Pretty Declaration+  pretty (DataD+-}++-- pretty print a function body+prettyFun :: Name -> [Clause] -> Doc+prettyFun f cls = vlist $ List.map (prettyClause f) cls++prettyClause f (Clause _ ps Nothing) = pretty f <+> hsep (List.map (prettyPrec precAppR) ps)+prettyClause f (Clause _ ps (Just e)) = pretty f+  <+> hsep (List.map (prettyPrec precAppR) ps)+  <+> equals <+> pretty e++-- Constructor analysis ----------------------------------------------++data FieldClass+  = Index                    -- ^ E.g., the length in Vector.+  | NotErasableIndex         -- ^ E.g., @c : (index : A) -> D (f index)@+  | Field (Maybe Destructor) -- ^ An actual field, not free in the target.+    deriving (Eq, Show)++type Destructor = (Type, Arity, Clause)++data FieldInfo = FieldInfo+  { fDec   :: Dec+  , fName  :: Name        -- ^ Empty "" for anonymous fields.+  , fType  :: Type        -- ^ Naked type (no preceeding telescope).+--  , fLazy  :: Bool        -- lazy (coinductive occ) or strict (everything else) -- see TCM.hs ConSig+  , fClass :: FieldClass+  }++instance Show FieldInfo where+  show (FieldInfo dec name t fcl) =+    (if fcl == Index then "index " else "field ") +++    bracketsIf (erased dec) (show name ++ " : " -- ++ (if lazy then "?" else "")+                                      ++ show t)++data PatternsType+  = NotPatterns        -- at least "pattern" is none+  | LinearPatterns     -- the patterns do not share a common var+  | NonLinearPatterns  -- the patterns share a common var+    deriving (Eq, Ord, Show)++data ConstructorInfo = ConstructorInfo+  { cName   :: QName+--  , cType   :: TVal+  , cPars   :: ParamPats  -- ^ Constructor parameters if unequal to data parameters.+  , cFields :: [FieldInfo]+  , cTyCore :: Type+  , cPatFam :: (PatternsType, [Pattern])+  , cEtaExp :: Bool -- all destructors are defined, family pattern is non-overlapping with family patterns of other constructors+  , cRec    :: Bool -- constructor has recursive fields+  } deriving Show++corePat :: ConstructorInfo -> [Pattern]+corePat = snd . cPatFam++{- Old comment:+a record type is a data type that fulfills 3 conditions+   1. non-recursive+   2. exactly 1 constructor+   3. constructor carries names for each of its arguments++Non-indexed case: generate destructors++  data Sigma (A : Set) (B : A -> Set) : Set+  { pair : (fst : A) -> (snd : B fst) -> Sigma A B+  }+  fst : [A : Set] -> [B : A -> Set] -> (p : Sigma A B) -> A+  { fst A B (pair _fst _snd) = _fst }+  snd : [A : Set] -> [B : A -> Set] -> (p : Sigma A B) -> B (fst p)+  { snd A B (pair _fst _snd) = _snd }++-}+{- Indexed case: For the constructor++  vcons : (n : Nat) -> (head : A) -> (tail : Vec A n) -> Vec A (suc n)++cName   = "vcons"+-- cType   = evaluation of (A : Set) -> (n : Nat) -> ...+cFields = [("n",Nat,Index),("head",A,Field),("tail",Vec A n,Field)]+cTyCore = Vec A (suc n)+cPatFam = (True, [A, suc n])+cEtaExp = True, but may be set to False later since the constructor is recursive++We generate the destructors++  head : (A : Set) -> (n : Nat) -> (x : Vec A (suc n)) -> A+  head A n (vcons .n _head _tail) = _head++  tail : (A : Set) -> (n : Nat) -> (x : Vec A (suc n)) -> Vec A n+  tail A n (vcons .n _head _tail) = _tail++in the implementation we use "constructed_by_head" for "x"++discriminate index arguments from fields+  - split constructor type into telescope and core+    [(n : Nat),(head : A),(tail : Vec A n)], Vec A (suc n)+  - find free variables of core: [A,n]+  - create a list of (name,type,classification) for each constructor arg,+    where classification in {index,field}++-}++-- TODO: analyze value, not expression!+-- get all the variables which are under injective functions++class InjectiveVars a where+  injectiveVars :: a -> Set Name++instance InjectiveVars a => InjectiveVars [a] where+  injectiveVars = foldMap injectiveVars++instance InjectiveVars a => InjectiveVars (Maybe a) where+  injectiveVars = foldMap injectiveVars++instance InjectiveVars a => InjectiveVars (Sort a) where+  injectiveVars = foldMap injectiveVars++instance InjectiveVars a => InjectiveVars (Dom a) where+  injectiveVars = foldMap injectiveVars++instance InjectiveVars a => InjectiveVars (Measure a) where+  injectiveVars = foldMap injectiveVars++instance InjectiveVars a => InjectiveVars (Bound a) where+  injectiveVars = foldMap injectiveVars++instance InjectiveVars a => InjectiveVars (Tagged a) where+  injectiveVars = foldMap injectiveVars++instance (InjectiveVars a, InjectiveVars b) => InjectiveVars (a, b) where+  injectiveVars (a, b) = mconcat [injectiveVars a, injectiveVars b]++instance (InjectiveVars a, InjectiveVars b, InjectiveVars c) => InjectiveVars (a, b, c) where+  injectiveVars (a, b, c) = mconcat [injectiveVars a, injectiveVars b, injectiveVars c]++instance InjectiveVars a => InjectiveVars (TBinding a) where+  injectiveVars (TBind x a)  = injectiveVars a+  injectiveVars (TMeasure m) = injectiveVars m+  injectiveVars (TBound b)   = injectiveVars b++instance InjectiveVars Telescope where+  injectiveVars (Telescope []) = mempty+  injectiveVars (Telescope (tb : tel)) = injectiveVars tb `Set.union`+                          (injectiveVars (Telescope tel) Set.\\ boundVars tb)++instance InjectiveVars Expr where+  injectiveVars e =+   case spineView e of+    (Var name            , []) -> Set.singleton name+    (Def (DefId DatK{} _), es) -> injectiveVars es+    (Def (DefId ConK{} _), es) -> injectiveVars es+    (Record ri rs        , []) -> Set.unions $ List.map (injectiveVars . snd) rs+    (Succ e              , []) -> injectiveVars e+    (Lam _ x e           , []) -> Set.delete x (injectiveVars e)+    (Quant _ ta b , []) -> injectiveVars ta `Set.union` (injectiveVars b Set.\\ boundVars ta)+--     (Quant _ tel ta b , []) ->+--       injectiveVars tel' `Set.union` (injectiveVars b Set.\\ boundVars tel')+--         where tel' = Telescope $ telescope tel ++ [ta]+--     (Sort s             , []) -> injectiveVars s+    (Ann e              , []) -> injectiveVars e+    _                         -> Set.empty++classifyFields :: Co -> Name -> Type -> [FieldInfo]+classifyFields co dataName ty = List.map (classifyField fvs) $ telescope tele+  where (tele, core) = typeToTele ty+        fvs = freeVars core+        ivs = injectiveVars core+        classifyField fvs (TBind name (Domain ty ki dec)) = FieldInfo+          { fDec = dec+          , fName  = name+          , fType  = ty+--          , fLazy  = co == CoInd && maybeRecursiveOccurrence dataName ty+          , fClass = if name `Set.member` fvs then+                       if name `Set.member` ivs then Index else NotErasableIndex+                      else Field Nothing+          }++isField :: FieldClass -> Bool+isField Field{} = True+isField _       = False++isNamedField :: FieldInfo -> Bool+isNamedField f = isField (fClass f) && not (erased $ fDec f) && not (emptyName $ fName f)++destructorNames :: [FieldInfo] -> [Name]+destructorNames fields = List.map fName $ filter isNamedField fields++analyzeConstructor :: Co -> Name -> Telescope -> Constructor -> ConstructorInfo+analyzeConstructor co dataName dataPars (Constructor constrName conPars ty) =+  let (_, core)  = typeToTele ty+      pars       = maybe dataPars fst conPars+      fields     = classifyFields co dataName ty+      -- freshenFieldName fi = fi { fName = freshen $ fName fi }+      -- freshfields = List.map freshenFieldName fields+      -- generate destructors+      -- choose a name for the record to destroy+      indices    = filter (\ f -> fClass f == Index) fields+      indexTele  = Telescope $ List.map (\ f -> TBind (fName f) $ Domain (fType f) defaultKind (fDec f)) indices+      indexNames  = List.map fName indices+      -- do not generated destructors for erased arguments+      destrNames = destructorNames fields+      recName    = internal $ name constrName -- "constructed_by_" ++ constrName+      parNames   = List.map boundName $ telescope pars+      parAndIndexNames = parNames ++ indexNames+      -- substitute variable "fst" by application "fst A B p"+      phi x = if x `elem` destrNames+                then List.foldl App ({-fun x-} letdef x) (List.map Var (parAndIndexNames ++ [recName]))+                else Var x+      -- prefix d =  "destructor_argument_" ++ d+      prefix d = d { suggestion = "#" ++ suggestion d }+      -- modifiedDestrNames = List.map prefix destrNames+      -- TODO: Index arguments are not always before fields+      pattern = ConP (PatternInfo (coToConK co) False False) -- to bootstrap destructor, not irrefutable+          constrName+          ( -- 2012-01-22 PARS GONE!   List.map (DotP . Var) parNames +++            List.map (\ fi -> (case fClass fi of+                            Index   -> DotP . Var+                            Field{} -> VarP . prefix)+                         (fName fi))+              fields)+      destrType t = -- teleToTypeErase (pars ++ indexTele)+                    teleToTypeErase pars $ teleToType indexTele $+                      pi (TBind recName $ defaultDomain core) $ parSubst phi t+      destrBody (dn) = clause (List.map VarP parAndIndexNames ++ [pattern]) (Just (Var dn))+      fields' = mapOver fields $+        \ f -> if isNamedField f then+                  f { fClass = Field $ Just+                         ( destrType (fType f)+                         , let npars = size pars+                           in  Arity { fullArity = npars + size indexTele + 1+                                     , isProjection = Just npars+                                     }+                         , destrBody (prefix (fName f)) )}+                else f+      computeLinearity :: (Bool, [Pattern]) -> (PatternsType, [Pattern])+      computeLinearity (False, ps) = (NotPatterns, ps)+      computeLinearity (True , ps) = (if linear then LinearPatterns else NonLinearPatterns, ps) where+        linear = List.null ps || (List.null $ List.foldl1 List.intersect $ List.map patternVars ps)++      result = ConstructorInfo+       { cName   = constrName+       , cPars   = conPars+       , cFields = fields'+       , cTyCore = core+       -- check whether core is D ps and store pats; also compute whether ps are linear+       , cPatFam = computeLinearity $ fromAllWriter $ isPatIndFamC core+       , cEtaExp = destructorNamesPresent fields+       , cRec    = True  -- we don't know here, assume the worst+       }+   in -- trace ("analyzeConstructor returns " ++ show result) $+        result++-- can only eta expand if I can generate all destructors+destructorNamesPresent :: [FieldInfo] -> Bool+destructorNamesPresent fields =+  all (\ f -> fClass f /= NotErasableIndex &&  -- no bad index+              (fClass f == Index ||+               not (erased $ fDec f) && not (emptyName $ fName f))) -- no erased or unnamed field+    fields++-- | Analyze all constructors of a data type at once+--   so that we can also check which constructors patterns are irrefutable.+analyzeConstructors :: Co -> Name -> Telescope -> [Constructor] -> [ConstructorInfo]+analyzeConstructors co dataName pars cs =+  let cis = List.map (analyzeConstructor co dataName pars) cs+      -- check if patterns overlaps with any other+      overlapList = zipWith (\ ci n -> any (overlaps (corePat ci)) $ List.map corePat $ take n cis ++ drop (n+1) cis) cis [0..] -- worst case quadratic, could be improved by exploiting symmetry+      result = zipWith (\ ci ov -> if ov then ci { cEtaExp = False } else ci) cis overlapList+  in result++-- | Build constructor type from constructor info, erasing all indices.+reassembleConstructor :: ConstructorInfo -> Constructor+reassembleConstructor ci = Constructor (cName ci) (cPars ci) (reassembleConstructorType ci)++-- | Assumes that all the indices (even from data telescope) are contained+--   in fields.+reassembleConstructorType :: ConstructorInfo -> Type+reassembleConstructorType ci = buildPi (cFields ci) where+  buildPi [] = cTyCore ci+  buildPi (f:fs) = pi (TBind (fName f) $ Domain (fType f) defaultKind (decor (fDec f) (fClass f))) $ buildPi fs+    where decor dec Index = irrelevantDec -- DONE: SWITCH ON!+          decor dec _     = dec++-- Pattern inductive families ----------------------------------------++-- isPatIndFam takes a list of type signatures (constructor decls.)+-- and checks whether we have a pattern inductive family+-- in this case, a list of constructors with the associated+-- type indices (translated into pattern list) is returned+-- type parameters are dropped+{-+isPatIndFam :: Int -> [Constructor] -> Maybe [(Name,[Pattern])]+isPatIndFam numPars= mapM (\ tysig ->+                             fmap (\ ps -> (namePart tysig, drop numPars ps))+                                  (isPatIndFamC (typePart tysig)))+-}++-- isPatIndFamC checks whether an expression (the type of s constructor)+-- is of the form+--   Gamma -> D ps+-- and returns the list ps of patterns if it is the case+isPatIndFamC :: Expr -> Writer All [Pattern]+isPatIndFamC (Def id) = return []+isPatIndFamC (App f e) = do+  ps <- isPatIndFamC f+  p  <- exprToDotPat' e+  return $ ps ++ [p]+-- isPatIndFamC (App e es) = do+--   ps  <- isPatIndFamC e+--   ps' <- mapM exprToDotPat' es+--   return $ ps ++ ps'+isPatIndFamC (Quant Pi _ e) = isPatIndFamC e+isPatIndFamC _ = tell (All False) >> return []++-- Pattern auxiliary functions ---------------------------------------++-- extract all subpatterns of the form y > x and arrange them in a+-- TreeShapedOrder+tsoFromPatterns :: [Pattern] -> TSO Name+tsoFromPatterns ps = TSO.fromList $ List.concat $ List.map loop ps where+  loop (SizeP (Var father) son) = [(son,(1,father))]+  loop (SizeP (Succ (Var father)) son) = [(son,(0,father))]+  loop (SizeP e      son) = []+  loop (ConP _ _ ps)      = List.concat $ List.map loop ps+  loop (PairP p p')       = loop p ++ loop p'+  loop (SuccP   p)        = loop p+  loop (ErasedP p)        = loop p+  loop ProjP{}            = []+  loop VarP{}             = []+  loop DotP{}             = []+  loop UnusableP{}        = []++-- for non-dot patterns, patterns overlap if one matches against the other+-- infinity size is represented as (DotP Infty)+-- I reprogram it here, since it does not need a monad+overlap :: Pattern -> Pattern -> Bool+overlap (VarP _) p' = True+overlap p (VarP _)  = True+overlap (ConP _ c ps) (ConP _ c' ps') = c == c' && overlaps ps ps' -- only source of non-overlap+overlap (PairP p1 p2) (PairP p1' p2') = overlaps [p1,p2] [p1',p2']+overlap (ProjP n) (ProjP n') = n == n' -- another source of non-overlap+-- size patterns always overlap+overlap (SuccP p) _ = True+overlap _ (SuccP p) = True+overlap SizeP{} _   = True+overlap _ SizeP{}   = True+-- dot patterns always overlap (safe approximation)+overlap (DotP _) _ = True+overlap _ (DotP _) = True+{-+overlap (SuccP p) (SuccP p') = overlap p p'+overlap (SuccP p) (DotP Infty) = overlap p (DotP Infty)+overlap (DotP Infty) (SuccP p') = overlap (DotP Infty) p'+overlap (DotP Infty) (DotP Infty) = True+-}++overlaps :: [Pattern] -> [Pattern] -> Bool+overlaps ps ps' = and $ zipWith overlap ps ps'++-- | @exprToPattern@ is used in the termination checker to convert+--   dot patterns into proper patterns.+exprToPattern :: Expr -> Maybe Pattern+exprToPattern (Def (DefId (ConK co) n)) = return $ ConP pi n []+  where pi = PatternInfo co False False -- not irrefutable (TODO: good enough?)+exprToPattern (Var n)       = return $ VarP n+exprToPattern (Pair e e')   = PairP <$> exprToPattern e <*> exprToPattern e'+exprToPattern (Succ e)      = SuccP <$> exprToPattern e+exprToPattern (Proj Post n) = return $ ProjP n+exprToPattern (App f e)     = patApp ==<< (exprToPattern f, exprToPattern e)+-- exprToPattern (Infty)    = return $ DotP Infty -- leads to non-term in compareExpr+exprToPattern _ = fail "exprToPattern"++-- | Only constructor patterns can be applied to a pattern.+patApp :: Pattern -> Pattern -> Maybe Pattern+patApp (ConP co n ps) p = Just $ ConP co n (ps ++ [p])+patApp _              _ = Nothing++-- | @exprToDotPat@ turns an expression into a pattern.+-- The @Bool@ is @True@ if the pattern is proper, i.e., does not contain+-- @DotP@ except @DotP Infty@.+exprToDotPat :: Expr -> (Bool, Pattern)+exprToDotPat = fromAllWriter . exprToDotPat'++exprToDotPat' :: Expr -> Writer All Pattern+exprToDotPat' e = do+  let fallback = tell (All False) >> return (DotP e)+  case e of+    Def (DefId (ConK co) n) -> return $ ConP pi n [] where+      pi = PatternInfo co False False -- not irrefutable (TODO: good enough?)+    Proj Post n -> return $ ProjP n+    Var n       -> return $ VarP n+    Pair e e'   -> PairP <$> exprToDotPat' e <*> exprToDotPat' e'+    Infty       -> return $ DotP Infty+    Succ e      -> SuccP <$> exprToDotPat' e+    App f e     -> maybe fallback return =<< do+      patApp <$> exprToDotPat' f <*> exprToDotPat' e+{-+    (App f e') -> do+      pf <- exprToDotPat' f+      case pf of+         (ConP co c ps) -> do pe <- exprToDotPat' e'+                              return $ ConP co c (ps ++ [pe])+         _ -> fallback+-}+    _ -> fallback++patternToExpr :: Pattern -> Expr+patternToExpr (VarP n)       = Var n+patternToExpr (SizeP m n)    = Var n+patternToExpr (ConP pi n ps) = List.foldl App (con (coPat pi) n) (List.map patternToExpr ps)+-- patternToExpr (ConP co n ps) = Con co n `App` (List.map patternToExpr ps)+patternToExpr (PairP p p')   = Pair (patternToExpr p) (patternToExpr p')+patternToExpr (SuccP p)      = Succ (patternToExpr p)+patternToExpr (UnusableP p)  = patternToExpr p+patternToExpr (ProjP n)      = Proj Post n+patternToExpr (DotP e)       = e -- cannot put Irr here because introPatType wants to compute the value of a dot pattern (after all bindings have been introduced)+patternToExpr (ErasedP p)    = erasedExpr $ patternToExpr p+patternToExpr (AbsurdP)      = Irr++-- | Dot all constructor subpatterns.  Used when expanding a dotted patsyn.+dotConstructors :: Pattern -> Pattern+dotConstructors p =+  case p of+    ConP pi c ps -> ConP pi{ dottedPat = True } c $ List.map dotConstructors ps+    PairP p1 p2  -> PairP (dotConstructors p1) (dotConstructors p2)+    _            -> p++-- admissible pattern ------------------------------------------------++-- completeP is used in admPattern, should not be True for UnusableP+completeP :: Pattern -> Bool+completeP (DotP _) = True+completeP (VarP _) = True+completeP SizeP{}  = False -- True+completeP (UnusableP p) = completeP p+completeP (ErasedP p)   = completeP p+completeP _ = False++isDotPattern :: Pattern -> Bool+isDotPattern (DotP _ ) = True+isDotPattern _ = False++-- isSuccessorPattern is used in admPattern, should not be True for UnusableP+isSuccessorPattern :: Pattern -> Bool+isSuccessorPattern (SuccP _)   = True+isSuccessorPattern (DotP e)    = isSuccessor e+isSuccessorPattern (ErasedP p) = isSuccessorPattern p+isSuccessorPattern _ = False++isSuccessor :: Expr -> Bool+isSuccessor (Ann e)  = isSuccessor (unTag e)+isSuccessor (Succ e) = True+isSuccessor _        = False++shallowSuccP :: Pattern -> Bool+shallowSuccP p = case p of+     (SuccP p)   -> isVarP p+     (ErasedP p) -> shallowSuccP p+     (DotP e)    -> shallowSuccE e+     _           -> False++   where isVarP (VarP _)         = True+         isVarP (DotP e)         = isVarE e+         isVarP (ErasedP p)      = isVarP p+         isVarP _                = False++         isVarE (Ann e)          = isVarE (unTag e)+         isVarE (Var _)          = True+         isVarE _                = False++         shallowSuccE (Ann e)    = shallowSuccE (unTag e)+         shallowSuccE (Succ e)   = isVarE e+         shallowSuccE _          = False++-- telescopes --------------------------------------------------------++---- construction++-- | typeToTele ((x : A) -> (y : B) -> C) = ([(x,A),(y,B)], C)+typeToTele :: Type -> (Telescope, Type)+typeToTele = typeToTele' (-1) -- take all Pis into the telescope++-- | @typeToTele' k t@.+--   If @k > 0@ it takes at most @k@ leading @Pi@s into the telescope+--   STALE: (hidden bindings do not count).+typeToTele' :: Int -> Type -> (Telescope, Type)+typeToTele' k t = mapFst Telescope $ ttt k t []+    where+      ttt :: Int -> Type -> [TBind] -> ([TBind], Type)+--      ttt k (Quant Pi htel tb t2) tel | k /= 0 = ttt (k-1) t2 (telescope htel ++ tb : tel)+      ttt k (Quant Pi tb t2) tel | k /= 0 = ttt (k-1) t2 (tb : tel)+      ttt k t tel = (reverse tel, t)++---- modification++instance LensDec Telescope where+  getDec   = error "getDec not defined for Telescope"+  mapDec f = Telescope . List.map (mapDec f) . telescope++---- destruction++teleLam :: Telescope -> Expr -> Expr+teleLam tel e = foldr (uncurry Lam) e $+  List.map (\ tb -> (decor $ boundDom tb, boundName tb)) $ telescope tel++teleToType' :: (Dec -> Dec) -> Telescope -> Type -> Type+teleToType' mod tel t = foldr (\ tb -> pi (mapDec mod tb)) t $ telescope tel+{-+teleToType' mod []       t = t+teleToType' mod (tb:tel) t = Pi (mapDec mod tb) (teleToType' mod tel t)+-}++teleToType :: Telescope -> Type -> Type+teleToType = teleToType' id++teleToTypeErase :: Telescope -> Type -> Type+teleToTypeErase = teleToType' demote -- (\ dec -> dec { erased = True })++adjustTopDecs :: (Dec -> Dec) -> Type -> Type+adjustTopDecs f t = teleToType' f tel core where+  (tel, core) = typeToTele t++teleToTypeM :: (Applicative m) => (Dec -> m Dec) -> Telescope -> Type -> m Type+teleToTypeM mod tel t =+  foldr (\ tb mt -> pi <$> mapDecM mod tb <*> mt) (pure t) $ telescope tel++adjustTopDecsM :: (Applicative m) => (Dec -> m Dec) -> Type -> m Type+adjustTopDecsM f t = teleToTypeM f tel core where+  (tel, core) = typeToTele t+++{- How to translate a clause with patterns into one that does irrefutable+   matching on records++f (zero, (x, (y, z))) true (x', false) = rhs++ translates to++f (zero, xyz) true (x', false) rhs'  where rhs = subst+  [ fst xyz       / x,+    fst (snd xyz) / y,+    snd (snd xyz) / z,+    x' / x'+  ] rhs'++We walk through the patterns from left to right, to get the de Bruijn indices+for the pattern variables (dot patterns also have a de Bruijn index).++  Gamma, pi, n |- x --> Gamma(pi(n)), n+1, [n/n]++  Gamma, pi, n |- .t --> infer++If we return from a record pattern whose components were all irrefutable, we+apply a substitution to Telescope+++-}
+ Abstract.hs-boot view
@@ -0,0 +1,4 @@+module Abstract where++data TBinding a+
+ Collection.hs view
@@ -0,0 +1,39 @@+{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances #-}++module Collection where++import Data.List as List+import Data.Monoid++import Data.Set (Set)+import qualified Data.Set as Set++class Monoid c => Collection c e | c -> e where+{-+  empty     :: c+  append    :: c -> c -> c+  concat    :: [c] -> c+-}+  singleton :: e -> c+  delete    :: e -> c -> c+  (\\)      :: c -> c -> c++instance Eq a => Collection [a] a where+{-+  empty     = []+  append    = (++)+  concat    = List.concat+-}+  singleton = (:[])+  delete    = List.delete+  (\\)      = (List.\\)++instance Ord a => Collection (Set a) a where+{-+  empty     = Set.empty+  append    = Set.union+  concat    = Set.unions+-}+  singleton = Set.singleton+  delete    = Set.delete+  (\\)      = (Set.\\)
+ Concrete.hs view
@@ -0,0 +1,324 @@+{-# LANGUAGE NamedFieldPuns #-}+-- concrete syntax+module Concrete where++import Prelude hiding (null)++import Util+import Abstract (Co,Sized,PiSigma(..),Decoration(..),Dec,Override(..),Measure(..),Bound(..),HasPred(..),LtLe(..),polarity)+import qualified Abstract as A+import Polarity++-- | Concrete names.+data Name = Name { theName :: String }+  deriving (Eq,Ord)++instance Show Name where+  show (Name n) = n++-- | Possibly qualified names.+data QName+  = Qual  { qual :: Name, name :: Name }  -- ^ @X.x@ e.g. qualified constructor.+  | QName { name :: Name }                -- ^ @x@.+  deriving (Eq,Ord)++unqual (QName n) = n++instance Show QName where+  show (Qual m n) = show m ++ "." ++ show n+  show (QName n)  = show n++set0 = Set Zero+ident n = Ident (QName n)++-- | Concrete expressions syntax.+data Expr+  = Set Expr                        -- ^ Universe @Set e@; @Set@ for @Set 0@.+  | CoSet Expr+  | Size                            -- ^ @Size@ type of sizes.+  | Succ Expr                       -- ^ @$e@.+  | Zero                            -- ^ @0@.+  | Infty                           -- ^ @#@.+  | Max                             -- ^ @max@.+  | Plus Expr Expr                  -- ^ @e + e'@.+  | RApp Expr Expr                  -- ^ @e |> f@.+  | App Expr [Expr]                 -- ^ @f e1 ... en@ or @f <| e@.+  | Lam Name Expr                   -- ^ @\ x -> e@.+  | Case Expr (Maybe Type) [Clause] -- ^ @case e : A { cls }@.+  | LLet LetDef Expr                -- ^ @let x = e in e'@ local let.+  | Quant PiSigma Telescope Expr    -- ^ @(x : A) -> B@, @[x : A] -> B@, @(x : A) & B@.+  | Pair Expr Expr                  -- ^ @e , e'@.+  | Record [([Name],Expr)]          -- ^ @record { x = e, x' y = e' }@.+  | Proj Name                       -- ^ @.x@.+  | Ident QName                     -- ^ @x@ or @D.c@.+  | Unknown                         -- ^ @_@.+  | Sing Expr Expr                  -- ^ @<e : A>@ singleton type.+--  | EBind TBind Expr                -- ^ @[x : A] B@+  deriving (Eq)++data LetDef = LetDef+  { letDefDec :: Dec+  , letDefName :: Name+  , letDefTel  ::  Telescope+  , letDefType :: (Maybe Type)+  , letDefExpr :: Expr+  } deriving (Eq, Show)++instance Show Expr where+    show = prettyExpr++instance HasPred Expr where+  predecessor (Succ e) = Just e+  predecessor _ = Nothing++data Declaration+  = DataDecl Name Sized Co Telescope Type [Constructor]+      [Name] -- list of field names+  | RecordDecl Name Telescope Type Constructor+      [Name] -- list of field names+  | FunDecl Co TypeSig [Clause]+  | LetDecl Bool LetDef -- True = if eval+--  | LetDecl Bool Name Telescope (Maybe Type) Expr -- True = if eval+  | PatternDecl Name [Name] Pattern+  | MutualDecl [Declaration]+  | OverrideDecl Override [Declaration] -- fail etc.+    deriving (Eq,Show)++data TypeSig = TypeSig Name Type+             deriving (Eq)++instance Show TypeSig where+  show (TypeSig n t) = show n ++ " : " ++ show t++type Type = Expr++data Constructor = Constructor+  { conName :: Name+  , conTel  :: Telescope+  , conType :: Maybe Type -- can be omitted *but* for families+  } deriving (Eq)++instance Show Constructor where+  show (Constructor n tel (Just t)) = show n ++ " " ++ show tel ++ " : " ++ show t+  show (Constructor n tel  Nothing) = show n ++ " " ++ show tel++type TBind = TBinding Type+type LBind = TBinding (Maybe Type)  -- possibly domain-free++data TBinding a = TBind+  { boundDec   :: Dec+  , boundNames :: [Name] -- [] if no name is given, then its a single bind+  , boundType  :: a+  }+  | TBounded  -- bounded quantification+  { boundDec   :: Dec+  , boundName  :: Name -- [] if no name is given, then its a single bind+  , ltle       :: LtLe+  , upperBound :: Expr+--  , boundMType :: Maybe Type -- type is inferred from upperBound+  }+  | TMeasure (Measure Expr)+  | TBound (Bound Expr)+--  | TSized { boundName :: Name } -- the size parameter of a sized record+    deriving (Eq,Show)++type Telescope = [TBind]++data DefClause = DefClause+   Name         -- function identifier+   [Elim]+   (Maybe Expr) -- Nothing for absurd pattern clause+ deriving (Eq,Show)++data Elim+  = EApp Pattern          -- application to a pattern+  | EProj Name [Pattern]  -- projection with arguments+    deriving (Eq,Show)++data Clause = Clause+                (Maybe Name) -- Just funId | Nothing for case clauses+                [Pattern]+                (Maybe Expr) -- Nothing for absurd pattern clause+            deriving (Eq,Show)++data Pattern+  = ConP Bool QName [Pattern] -- ^ @(c ps)@ if @False; @(.c ps)@ if @True@.+  | PairP Pattern Pattern     -- ^ @(p, p')@+  | SuccP Pattern             -- ^ @($ p)@+  | DotP Expr                 -- ^ @.e@+  | IdentP QName              -- ^ @x@ or @c@ or @D.c@.+  | SizeP Expr Name           -- ^ @(x > y)@ or @y < #@ or ...+  | AbsurdP                   -- ^ @()@+    deriving (Eq,Show)++type Case = (Pattern,Expr)++-- | Used in Parser.+patApp :: Pattern -> [Pattern] -> Pattern+patApp (IdentP c)         ps' = ConP False  c ps'+patApp (ConP dotted c ps) ps' = ConP dotted c (ps ++ ps')++-- * Pretty printing.++prettyLBind :: LBind -> String+-- prettyLBind (TSized x)                   = prettyTBind False (TSized x)+prettyLBind (TMeasure mu)                = prettyTBind False (TMeasure mu)+prettyLBind (TBound (Bound ltle mu mu')) = prettyTBind False (TBound (Bound ltle mu mu'))+prettyLBind (TBounded dec x ltle e)      = prettyTBind False (TBounded dec x ltle e)+prettyLBind (TBind dec xs (Just t))      = prettyTBind False (TBind dec xs t)+prettyLBind (TBind dec xs Nothing) =+  if erased dec then addPol False $ brackets binding+   else addPol True binding+  where binding = Util.showList " " show xs+        pol = polarity dec+        addPol b x = if pol==defaultPol+                      then x+                      else show pol ++ (if b then " " else "") ++ x+++prettyTBind :: Bool -> TBind -> String+-- prettyTBind inPi (TSized x) = parens ("sized " ++ x)+prettyTBind inPi (TMeasure mu) = "|" +++  (Util.showList ","  prettyExpr (measure mu)) ++ "|"+prettyTBind inPi (TBound (Bound ltle mu mu')) = "|" +++  (Util.showList ","  prettyExpr (measure mu))  ++ "| " ++ show ltle ++ " |" +++  (Util.showList ","  prettyExpr (measure mu')) ++ "|"+prettyTBind inPi (TBind dec xs t) =+  if erased dec then addPol False $ brackets binding+   else if (null xs) then addPol True s+   else addPol (not inPi) $ (if inPi then parens else id) binding+  where s = prettyExpr t+        binding = if null xs then s else+          foldr (\ x s -> show x ++ " " ++ s) (": " ++ s) xs+        pol = polarity dec+        addPol b x = if pol==defaultPol+                      then x+                      else show pol ++ (if b then " " else "") ++ x+prettyTBind inPi (TBounded dec x ltle e) =+  if erased dec then addPol False $ brackets binding+   else addPol (not inPi) $ (if inPi then parens else id) binding+  where binding = show x ++ " < " ++ prettyExpr e+        pol = polarity dec+        addPol b x = if pol==defaultPol+                      then x+                      else show pol ++ (if b then " " else "") ++ x+{-+prettyTBind :: Bool -> TBind -> String+prettyTBind inPi (TBind dec x t) =+  if erased dec then addPol False $ brackets binding+   else if x=="" then addPol True s+   else addPol (not inPi) $ (if inPi then parens else id) binding+  where s = prettyExpr t+        binding = if x == "" then s else x ++ " : " ++ s+        pol = polarity dec+        addPol b x = if pol==Mixed then x+                      else show pol ++ (if b then " " else "") ++ x+-}+prettyLetBody :: String -> Expr -> String+prettyLetBody s e = parens $ s ++ " in " ++ prettyExpr e++prettyLetAssign :: String -> Expr -> String+prettyLetAssign s e = "let " ++ s ++ " = " ++ prettyExpr e++prettyLetDef :: LetDef -> String+prettyLetDef (LetDef dec n [] mt e) = prettyLetAssign (prettyLBind tb) e+  where tb = TBind dec [n] mt+prettyLetDef (LetDef dec n tel mt e) = prettyLetAssign s e+  where s = prettyDecId dec n ++ " " ++ prettyTel False tel ++ prettyMaybeType mt++prettyDecId :: Dec -> Name -> String+prettyDecId dec x+  | erased dec = brackets $ show x+  | otherwise  =+     let pol = polarity dec+     in  if pol == defaultPol then show x else show pol ++ show x++prettyTel :: Bool -> Telescope -> String+prettyTel inPi = Util.showList " " (prettyTBind inPi)++prettyMaybeType = maybe "" $ \ t -> " : " ++ prettyExpr t++prettyExpr :: Expr -> String+prettyExpr e =+    case e of+      -- Type e          -> "Type " ++ prettyExpr e+      CoSet e         -> "CoSet " ++ prettyExpr e+      Set e         -> "CoSet " ++ prettyExpr e+      -- Set             -> "Set"+      Size            -> "Size"+      Max             -> "max"+      Succ e          -> "$ " ++ prettyExpr e -- ++ ")"+      Zero            -> "0"+      Infty           -> "#"+      Plus e1 e2      -> "(" ++ prettyExpr e1 ++ " + " ++  prettyExpr e2 ++ ")"+      Pair e1 e2      -> "(" ++ prettyExpr e1 ++ " , " ++  prettyExpr e2 ++ ")"+      App e1 el       -> "(" ++ prettyExprs (e1:el) ++ ")"+      Lam x e1        -> "(\\" ++ show x ++ " -> " ++ prettyExpr e1 ++ ")"+      Case e Nothing cs -> "case " ++ prettyExpr e ++ " { " ++ Util.showList "; " prettyCase cs ++ " } "+      Case e (Just t) cs -> "case " ++ prettyExpr e ++ " : " ++ prettyExpr t ++ " { " ++ Util.showList "; " prettyCase cs ++ " } "+      LLet letdef e -> prettyLetBody (prettyLetDef letdef) e+{-+      LLet tb e1 e2 -> "(let " ++ prettyLBind tb ++ " = " ++ prettyExpr e1 ++ " in " ++ prettyExpr e2 ++ ")"+-}+      Record rs       -> "record {" ++ Util.showList "; " prettyRecordLine rs ++ "}"+      Proj n          -> "." ++ show n+      Ident n         -> show n+      Unknown         -> "_"+      Sing e t        -> "<" ++ prettyExpr e ++ " : " ++ prettyExpr t ++ ">"+--      Quant pisig tb t2 -> parens $ prettyTBind True tb+      Quant pisig tel t2 -> parens $ prettyTel True tel+                                  ++ " " ++ show pisig ++ " " ++ prettyExpr t2++prettyRecordLine (xs, e) = Util.showList " " show xs ++ " = " ++ prettyExpr e++prettyCase (Clause Nothing [p] Nothing)  = prettyPattern p+prettyCase (Clause Nothing [p] (Just e)) = prettyPattern p ++ " -> " ++ prettyExpr e++prettyPattern :: Pattern -> String+prettyPattern (ConP dotted c ps) = parens $ foldl (\ acc p -> acc ++ " " ++ prettyPattern p) (if dotted then "." ++ show c else show c) ps+prettyPattern (PairP p1 p2) = parens $ prettyPattern p1 ++ ", " +++                                prettyPattern p2+prettyPattern (SuccP p)   = parens $ "$ " ++ prettyPattern p+prettyPattern (DotP e)    = "." ++ prettyExpr e+prettyPattern (IdentP x)  = show x+prettyPattern (SizeP e y) = parens $ prettyExpr e ++ " > " ++ show y+prettyPattern (AbsurdP)   = parens ""++prettyExprs :: [Expr] -> String+prettyExprs = Util.showList " " prettyExpr++prettyDecl (PatternDecl n ns p) = "pattern " ++ (Util.showList " " show (n:ns)) ++ " = " ++ prettyPattern p++teleToType :: Telescope -> Type -> Type+teleToType [] t = t+teleToType (tb:tel) t2 = Quant Pi [tb] (teleToType tel t2)+--teleToType (PosTB dec n t:tel) t2 = Pi dec n t (teleToType tel t2)++typeToTele :: Type -> (Telescope, Type)+typeToTele (Quant Pi tel0 c) =+  let (tel, a) = typeToTele c in (tel0 ++ tel, a)+typeToTele a = ([],a)++{-+teleToType :: Telescope -> Type -> Type+teleToType [] t = t+teleToType (tb:tel) t2 = Quant Pi tb (teleToType tel t2)+--teleToType (PosTB dec n t:tel) t2 = Pi dec n t (teleToType tel t2)++typeToTele :: Type -> (Telescope, Type)+typeToTele = typeToTele' (-1)++typeToTele' :: Int -> Type -> (Telescope, Type)+typeToTele' k (Quant A.Pi tb c) | k /= 0 =+  let (tel, a) = typeToTele' (k-1) c in (tb:tel, a)+typeToTele' _ a = ([],a)+-}++teleNames :: Telescope -> [Name]+teleNames tel = concat $ map tbindNames tel++tbindNames :: TBind -> [Name]+tbindNames TBind{ boundNames }   = boundNames+tbindNames TBounded{ boundName } = [boundName]+-- tbindNames TSized{ boundName }   = [boundName]+tbindNames tb = error $ "tbindNames (" ++ show tb ++ ")"
+ Eval.hs view
@@ -0,0 +1,2358 @@+{-# LANGUAGE TupleSections, FlexibleInstances, NamedFieldPuns #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE CPP #-}++-- Activate this flag if i < $i should only hold for i < #.+-- #define STRICTINFTY++module Eval where++import Prelude hiding (mapM, null, pi)++import Control.Applicative+import Control.Monad.Identity hiding (mapM)+import Control.Monad.State hiding (mapM)+import Control.Monad.Error hiding (mapM)+import Control.Monad.Reader hiding (mapM)+import Control.Monad.IfElse  -- unlessM+-- import Control.Monad.HT      -- andLazy  -- because liftM2 (&&) is NOT lazy!++import qualified Data.Array as Array+import Data.Maybe -- fromMaybe+import Data.Monoid hiding ((<>))+import Data.List as List hiding (null) -- find+import Data.Map (Map)+import qualified Data.Map as Map+import Data.Foldable (foldMap)+import Data.Traversable (Traversable, mapM, traverse)+import qualified Data.Traversable as Traversable++import Debug.Trace++import Abstract+import Polarity as Pol+import Value+import TCM+import PrettyTCM+import Warshall  -- positivity checking++import TraceError+import Util+++traceEta msg a = a -- trace msg a+traceEtaM msg = return () -- traceM msg+{-+traceEta msg a = trace msg a+traceEtaM msg = traceM msg+-}++traceRecord msg a = a+traceRecordM msg = return ()+++traceMatch msg a = a -- trace msg a+traceMatchM msg = return () -- traceM msg+{-+traceMatch msg a = trace msg a+traceMatchM msg = traceM msg+-}++traceLoop msg a = a -- trace msg a+traceLoopM msg = return () -- traceM msg+{-+traceLoop msg a = trace msg a+traceLoopM msg = traceM msg+-}++traceSize msg a = a -- trace msg a+traceSizeM msg = return () -- traceM msg+{-+traceSize msg a = trace msg a+traceSizeM msg = traceM msg+-}++-- evaluation with rewriting -------------------------------------++{-++Rewriting rules have the form++  blocked --> pattern++this means that at the root, at most one rewriting step is possible.+Rewriting rules are considered computational, since they trigger new+(symbolic) computations.  At least they have to be applied in++- pattern matching+- equality checking+When a new rule b --> p is added, b should be in --> normal form.+Otherwise there could be inconsistencies, like adding both rules++  b --> true+  b --> false++If after adding b --> true b is rewritten to nf, then the second rule+would be true --> false, which can be captured by MiniAgda.++Also, after adding a new rule, it could be used to rewrite the old rules.++Implementation:++- add a set of local rewriting rules to the context (not to the state)+- keep values in --> weak head normal form+- untyped equality test between values++ -}++class Reval a where+  reval' :: Valuation -> a -> TypeCheck a+  reval  :: a -> TypeCheck a+  reval = reval' emptyVal++instance Reval a => Reval (Maybe a) where+  reval' valu ma = Traversable.traverse (reval' valu) ma++instance Reval b => Reval (a,b) where+  reval' valu (x,v) = (x,) <$> reval' valu v++instance Reval a => Reval [a] where+  reval' valu vs = mapM (reval' valu) vs++instance Reval Env where+  reval' valu (Environ rho mmeas) =+   flip Environ mmeas <$> reval' valu rho+   -- no need to reevaluate mmeas, since only sizes++-- | When combining valuations, the old one takes priority.+--   @[sigma][tau]v = [[sigma]tau]v@+instance Reval Valuation where+  reval' valu (Valuation valu') = Valuation . (++ valuation valu) <$>+    reval' valu valu'++instance Reval a => Reval (Measure a) where+  reval' valu beta = Traversable.traverse (reval' valu) beta++instance Reval a => Reval (Bound a) where+  reval' valu beta = Traversable.traverse (reval' valu) beta++instance Reval Val where+  reval' valu u = traceLoop ("reval " ++ show u) $ do+    let reval v   = reval' valu v+        reEnv rho = reval' valu rho+        reFun fv  = reval' valu fv+    case u of+      VSort (CoSet v) -> VSort . CoSet <$> reval v+      VSort{} -> return u+      VInfty  -> return u+      VZero   -> return u+      VSucc{} -> return u  -- no rewriting in size expressions+      VMax{}  -> return u+      VPlus{}  -> return u+      VProj{}  -> return u -- cannot rewrite projection+      VPair v1 v2 -> VPair <$> reval v1 <*> reval v2+      VRecord ri rho -> VRecord ri <$> mapAssocM reval rho++      VApp v vl          -> do+        v'  <- reval v+        vl' <- mapM reval vl+        w   <- foldM app v' vl'+        reduce w  -- since we only have rewrite rules at base types+                  -- we do not need to reduces prefixes of w++      VDef{} -> return $ VApp u [] -- restore invariant+                                   -- CAN'T rewrite defined fun/data+      VGen i -> reduce (valuateGen i valu)  -- CAN rewrite variable++      VCase v tv env cl -> do+        v' <- reval v+        tv' <- reval tv+        env' <- reEnv env+        evalCase v' tv' env' cl++      VBelow ltle v         -> VBelow ltle <$> reval v+      VGuard beta v         -> VGuard <$> reval beta <*> reval v+      VQuant pisig x dom fv ->+        VQuant pisig x+          <$> Traversable.mapM reval dom+          <*> reFun fv+    {-+      VQuant pisig x dom env b -> do+        dom' <- Traversable.mapM reval dom+        env' <- reEnv env+        return $ VQuant pisig x dom' env' b+    -}+      VConst v           -> VConst <$> reval' valu v+      VLam x env e       -> flip (VLam x) e <$> reval' valu env+      VAbs x i v valu'   -> VAbs x i v <$> reval' valu valu'+      VUp v tv           -> up False ==<< (reval' valu v, reval' valu tv)  -- do not force at this point++      VClos env e        -> do env' <- reEnv env+                               return $ VClos env' e++      VMeta i env k      -> do env' <- reEnv env+                               return $ VMeta i env' k++      VSing v tv         -> vSing ==<< (reval v, reval tv)+      VIrr -> return u+      v -> throwErrorMsg $ "NYI : reval " ++ show v+++-- TODO: singleton Sigma types+-- <t : Pi x:a.f> = Pi x:a <t x : f x>+-- <t : A -> B  > = Pi x:A <t x : B>+-- <t : <t' : a>> = <t' : a>+vSing :: Val -> TVal -> TypeCheck TVal+vSing v (VQuant Pi x' dom fv) = do+  let x = fresh $ if emptyName x' then "xSing#" else suggestion x'+  VQuant Pi x dom <$> do+  underAbs_ x dom fv $ \ i xv bv -> do+    v <- app v xv+    vAbs x i <$> vSing v bv+vSing _ tv@(VSing{}) = return $ tv+vSing v tv           = return $ VSing v tv+{-+-- This is a bit of a hack (finding a fresh name)+-- <t : Pi x:a.b> = Pi x:a <t x : b>+-- <t : Pi x:a.f> = Pi x:a <t x : f x>+-- <t : <t' : a>> = <t' : a>+vSing :: Val -> TVal -> TVal+vSing v (VQuant Pi x dom env b)+  | not (emptyName x) = -- xv `seq` x' `seq`+     (VQuant Pi x dom (update env xv v) $ Sing (App (Var xv) (Var x)) b)+      where xv = fresh ("vSing#" ++ suggestion x)+vSing v (VQuant Pi x dom env b) =+--  | otherwise =+     (VQuant Pi x' dom (update env xv v) $ Sing (App (Var xv) (Var x')) b')+      where xv = fresh ("vSing#" ++ suggestion x)+            x' = fresh $ if emptyName x then "xSing#" else suggestion x+            b' = parSubst (\ y -> Var $ if y == x then x' else y) b+vSing _ tv@(VSing{}) = tv+vSing v tv           = VSing v tv+-}++-- reduce the root of a value+reduce :: Val -> TypeCheck Val+reduce v = traceLoop ("reduce " ++ show v) $+ do+  rewrules <- asks rewrites+  mr <- findM (\ rr -> equal v (lhs rr)) rewrules+  case mr of+     Nothing -> return v+     Just rr -> traceRew ("firing " ++ show rr) $ return (rhs rr)++-- equal v v'  tests values for untyped equality+-- precond: v v' are in --> whnf+equal :: Val -> Val -> TypeCheck Bool+equal u1 u2 = traceLoop ("equal " ++ show u1 ++ " =?= " ++ show u2) $+  case (u1,u2) of+    (v1,v2) | v1 == v2 -> return True -- includes all size expressions+--    (VSucc v1, VSucc v2) -> equal v1 v2  -- NO REDUCING NECC. HERE (Size expr)+    (VApp v1 vl1, VApp v2 vl2) ->+       (equal v1 v2) `andLazy` (equals' vl1 vl2)+    (VQuant pisig1 x1 dom1 fv1, VQuant pisig2 x2 dom2 fv2) | pisig1 == pisig2 ->+       andLazy (equal (typ dom1) (typ dom2)) $  -- NO RED. NECC. (Type)+         new x1 dom1 $ \ vx -> equal ==<< (app fv1 vx, app fv2 vx)+    (VProj _ p, VProj _ q) -> return $ p == q+    (VPair v1 w1, VPair v2 w2) -> (equal v1 v2) `andLazy` (equal w1 w2)+    (VBelow ltle1 v1, VBelow ltle2 v2) | ltle1 == ltle2 -> equal v1 v2+    (VSing v1 tv1, VSing v2 tv2) -> (equal v1 v2) `andLazy` (equal tv1 tv2)++    (fv1, fv2) | isFun fv1, isFun fv2 -> -- PROBLEM: DOM. MISSING, CAN'T "up" fresh variable+      addName (bestName [absName fv1, absName fv2]) $ \ vx ->+        equal ==<< (app fv1 vx, app fv2 vx)+{-+    (VLam x1 env1 b1, VLam x2 env2 b2) -> -- PROBLEM: DOMAIN MISSING+         addName x1 $ \ vx -> do          -- CAN'T "up" fresh variable+               do v1 <- whnf (update env1 x1 vx) b1+                  v2 <- whnf (update env2 x2 vx) b2+                  equal v1 v2+-}+    (VRecord ri1 rho1, VRecord ri2 rho2) | notDifferentNames ri1 ri2 -> and <$>+      zipWithM (\ (n1,v1) (n2,v2) -> ((n1 == n2) &&) <$> equal' v1 v2) rho1 rho2+    _ -> return False++notDifferentNames :: RecInfo -> RecInfo -> Bool+notDifferentNames (NamedRec _ n _ _) (NamedRec _ n' _ _) = n == n'+notDifferentNames _ _ = True++equals' :: [Val] -> [Val] -> TypeCheck Bool+equals' [] []             = return True+equals' (w1:vs1) (w2:vs2) = (equal' w1 w2) `andLazy` (equals' vs1 vs2)+equals' vl1 vl2           = return False++equal' w1 w2 = whnfClos w1 >>= \ v1 -> equal v1 =<< whnfClos w2++{- LEADS TO NON-TERMINATION+-- equal' v1 v2  tests values for untyped equality+-- v1 v2 are not necessarily in --> whnf+equal' v1 v2 = do+  v1' <- reduce v1+  v2' <- reduce v2+  equal v1' v2'+-}++-- normalization -----------------------------------------------------++reify :: Val -> TypeCheck Expr+reify v = reify' (5, True) v++-- normalize to depth m+reify' :: (Int, Bool) -> Val -> TypeCheck Expr+reify' m v0 = do+  let reify = reify' m  -- default recursive call+  case v0 of+    (VClos rho e)        -> whnf rho e >>= reify+    (VZero)              -> return $ Zero+    (VInfty)             -> return $ Infty+    (VSucc v)            -> Succ <$> reify v+    (VMax vs)            -> maxE <$> mapM reify vs+    (VPlus vs)           -> Plus <$> mapM reify vs+    (VMeta x rho n)      -> -- error $ "cannot reify meta-variable " ++ show v0+                            return $ iterate Succ (Meta x) !! n+    (VSort (CoSet v))    -> Sort . CoSet <$> reify v+    (VSort s)            -> return $ Sort $ vSortToSort s+    (VBelow ltle v)      -> Below ltle <$> reify v+    (VQuant pisig x dom fv) -> do+          dom' <- Traversable.mapM reify dom+          underAbs_ x dom fv $ \ k xv vb -> do+            let x' = unsafeName (suggestion x ++ "~" ++ show k)+            piSig pisig (TBind x' dom') <$> reify vb+    (VSing v tv)         -> liftM2 Sing (reify v) (reify tv)+    fv | isFun fv        -> do+          let x = absName fv+          addName x $ \ xv@(VGen k) -> do+            vb <- app fv xv+            let x' = unsafeName (suggestion x ++ "~" ++ show k)+            Lam defaultDec x' <$> reify vb  -- TODO: dec!?+    (VUp v tv)           -> reify v -- TODO: type directed reification+    (VGen k)             -> return $ Var $ unsafeName $ "~" ++ show k+    (VDef d)             -> return $ Def d+    (VProj fx n)         -> return $ Proj fx n+    (VPair v1 v2)        -> Pair <$> reify v1 <*> reify v2+    (VRecord ri rho)     -> Record ri <$> mapAssocM reify rho+    (VApp v vl)          -> if fst m > 0 && snd m+                             then force v0 >>= reify' (fst m - 1, True) -- forgotten the meaning of the boolean, WAS: False)+                             else let m' = (fst m, True) in+                               liftM2 (foldl App) (reify' m' v) (mapM (reify' m') vl)+    (VCase v tv rho cls) -> do+          e <- reify v+          t <- reify tv+          return $ Case e (Just t) cls -- TODO: properly evaluate clauses!!+    (VIrr)               -> return $ Irr+    v -> failDoc (text "Eval.reify" <+> prettyTCM v <+> text "not implemented")++-- printing (conversion to Expr) -------------------------------------++-- similar to reify+toExpr :: Val -> TypeCheck Expr+toExpr v =+  case v of+    VClos rho e     -> closToExpr rho e+    VZero           -> return $ Zero+    VInfty          -> return $ Infty+    (VSucc v)       -> Succ <$> toExpr v+    VMax vs         -> maxE <$> mapM toExpr vs+    VPlus vs        -> Plus <$> mapM toExpr vs+    VMeta x rho n   -> metaToExpr x rho n+    VSort s         -> Sort <$> mapM toExpr s+{-+    VSort (CoSet v) -> (Sort . CoSet) <$> toExpr v+    VSort (Set v)   -> (Sort . Set) <$> toExpr v+    VSort (SortC s) -> return $ Sort (SortC s)+-}+    VMeasured mu bv -> pi <$> (TMeasure <$> mapM toExpr mu) <*> toExpr bv+    VGuard beta bv  -> pi <$> (TBound <$> mapM toExpr beta) <*> toExpr bv+    VBelow Le VInfty -> return $ Sort $ SortC Size+    VBelow ltle bv  -> Below ltle <$> toExpr bv+    VQuant pisig x dom fv -> underAbs' x fv $ \ xv bv ->+      piSig pisig <$> (TBind x <$> mapM toExpr dom) <*> toExpr bv+    VSing v tv      -> Sing <$> toExpr v <*> toExpr tv+    fv | isFun fv   -> addName (absName fv) $ \ xv -> toExpr =<< app fv xv+{-+    VLam x rho e    -> addNameEnv x rho $ \ x rho ->+      Lam defaultDec x <$> closToExpr rho e+-}+    VUp v tv        -> toExpr v+    VGen k          -> Var <$> nameOfGen k+    VDef d          -> return $ Def d+    VProj fx n      -> return $ Proj fx n+    VPair v1 v2     -> Pair <$> toExpr v1 <*> toExpr v2+    VRecord ri rho  -> Record ri <$> mapAssocM toExpr rho+    VApp v vl       -> liftM2 (foldl App) (toExpr v) (mapM toExpr vl)+    VCase v tv rho cls -> Case <$> toExpr v <*> (Just <$> toExpr tv) <*> mapM (clauseToExpr rho) cls+    VIrr            -> return $ Irr++{-+addBindEnv :: TBind -> Env -> (Env -> TypeCheck a) -> TypeCheck a+addBindEnv (TBind x dom) rho cont = do+  let dom' = fmap (VClos rho) dom+  newWithGen x dom' $ \ k _ ->+    cont (update rho x (VGen k))+-}++addNameEnv :: Name -> Env -> (Name -> Env -> TypeCheck a) -> TypeCheck a+--addNameEnv "" rho cont = cont "" rho+addNameEnv x rho cont = do+  let dom' = defaultDomain VIrr -- error $ "internal error: variable " ++ show x ++ " comes without domain"+  newWithGen x dom' $ \ k _ -> do+    x' <- nameOfGen k+    cont x' (update rho x (VGen k))++addPatternEnv :: Pattern -> Env -> (Pattern -> Env -> TypeCheck a) -> TypeCheck a+addPatternEnv p rho cont =+  case p of+    VarP x       -> addNameEnv     x  rho $ cont . VarP -- \ x rho -> cont (VarP x) rho+    SizeP e x    -> addNameEnv     x  rho $ cont . VarP+    PairP p1 p2  -> addPatternEnv  p1 rho $ \ p1 rho ->+                     addPatternEnv p2 rho $ \ p2 rho -> cont (PairP p1 p2) rho+    ConP pi n ps -> addPatternsEnv ps rho $ cont . ConP pi n -- \ ps rho -> cont (ConP pi n ps) rho+    SuccP p      -> addPatternEnv  p  rho $ cont . SuccP+    UnusableP p  -> addPatternEnv  p  rho $ cont . UnusableP+    DotP e       -> do { e <- closToExpr rho e ; cont (DotP e) rho }+    AbsurdP      -> cont AbsurdP rho+    ErasedP p    -> addPatternEnv  p  rho $ cont . ErasedP++addPatternsEnv :: [Pattern] -> Env -> ([Pattern] -> Env -> TypeCheck a) -> TypeCheck a+addPatternsEnv []     rho cont = cont [] rho+addPatternsEnv (p:ps) rho cont =+  addPatternEnv p rho $ \ p rho ->+    addPatternsEnv ps rho $ \ ps rho ->+      cont (p:ps) rho++{-+class BindClosToExpr a where+  bindClosToExpr :: Env -> a -> (Env -> a -> TCM b) -> TCM b++instance ClosToExpr a => BindClosToExpr (TBinding a) where+  bindClosToExpr+-}++class ClosToExpr a where+  closToExpr     :: Env -> a -> TypeCheck a+  bindClosToExpr :: Env -> a -> (Env -> a -> TypeCheck b) -> TypeCheck b++  -- default : no binding+  closToExpr rho a = bindClosToExpr rho a $ \ rho a -> return a+  bindClosToExpr rho a cont = cont rho =<< closToExpr rho a++instance ClosToExpr a => ClosToExpr [a] where+  closToExpr = traverse . closToExpr++instance ClosToExpr a => ClosToExpr (Maybe a) where+  closToExpr = traverse . closToExpr++instance ClosToExpr a => ClosToExpr (Dom a) where+  closToExpr = traverse . closToExpr++instance ClosToExpr a => ClosToExpr (Sort a) where+  closToExpr = traverse . closToExpr++instance ClosToExpr a => ClosToExpr (Measure a) where+  closToExpr = traverse . closToExpr++instance ClosToExpr a => ClosToExpr (Bound a) where+  closToExpr = traverse . closToExpr++instance ClosToExpr a => ClosToExpr (Tagged a) where+  closToExpr = traverse . closToExpr++instance ClosToExpr a => ClosToExpr (TBinding a) where+  bindClosToExpr rho (TBind x a) cont = do+    a <- closToExpr rho a+    addNameEnv x rho $ \ x rho -> cont rho $ TBind x a+  bindClosToExpr rho (TMeasure mu) cont = cont rho . TMeasure =<< closToExpr rho mu+  bindClosToExpr rho (TBound beta) cont = cont rho . TBound =<< closToExpr rho beta++instance ClosToExpr Telescope where+  bindClosToExpr rho (Telescope tel) cont = loop rho tel $ \ rho -> cont rho . Telescope+    where+      loop rho []         cont = cont rho []+      loop rho (tb : tel) cont = bindClosToExpr rho tb $ \ rho tb ->+        loop rho tel $ \ rho tel -> cont rho $ tb : tel++instance ClosToExpr Expr where+  closToExpr rho e =+    case e of+      Sort s         -> Sort <$> closToExpr rho s+      Zero           -> return e+      Succ e         -> Succ <$> closToExpr rho e+      Infty          -> return e+      Max es         -> Max  <$> closToExpr rho es+      Plus es        -> Plus <$> closToExpr rho es+      Meta x         -> return e+      Var x          -> toExpr =<< whnf rho e+      Def d          -> return e+      Case e mt cls  -> Case <$> closToExpr rho e <*> closToExpr rho mt <*> mapM (clauseToExpr rho) cls+      LLet tb tel e1 e2 | null tel -> do+        e1 <- closToExpr rho e1+        bindClosToExpr rho tb $ \ rho tb -> LLet tb tel e1 <$> closToExpr rho e2+      Proj fx n      -> return e+      Record ri rs   -> Record ri <$> mapAssocM (closToExpr rho) rs+      Pair e1 e2     -> Pair <$> closToExpr rho e1 <*> closToExpr rho e2+      App e1 e2      -> App <$> closToExpr rho e1 <*> closToExpr rho e2+      Lam dec x e    -> addNameEnv x rho $ \ x rho ->+        Lam dec x <$> closToExpr rho e+      Below ltle e   -> Below ltle <$> closToExpr rho e+{-+      Quant Pi tel mu@TMeasure{} e | null tel -> pi <$> closToExpr rho mu   <*> closToExpr rho e+      Quant Pi tel beta@TBound{} e | null tel -> pi <$> closToExpr rho beta <*> closToExpr rho e+-}+      Quant piSig tb e -> bindClosToExpr rho tb $ \ rho tb -> Quant piSig tb <$> closToExpr rho e+--       Quant piSig tel tb e -> bindClosToExpr rho tel $ \ rho tel ->+--         bindClosToExpr rho tb $ \ rho tb -> Quant piSig tel tb <$> closToExpr rho e+      Sing e1 e2     -> Sing <$> closToExpr rho e1 <*> closToExpr rho e2+      Ann taggedE    -> Ann <$> closToExpr rho taggedE+      Irr            -> return e++metaToExpr :: Int -> Env -> Int -> TypeCheck Expr+metaToExpr x rho k = return $ iterate Succ (Meta x) !! k++clauseToExpr :: Env -> Clause -> TypeCheck Clause+clauseToExpr rho (Clause vtel ps me) = addPatternsEnv ps rho $ \ ps rho ->+   Clause vtel ps <$> mapM (closToExpr rho) me++-- evaluation --------------------------------------------------------++-- | Weak head normal form.+--   Monadic, since it reads the globally defined constants from the signature.+--   @let@s are expanded away.++whnf :: Env -> Expr -> TypeCheck Val+whnf env e = enter ("whnf " ++ show e) $+  case e of+    Meta i -> do let v = VMeta i env 0+                 traceMetaM $ "whnf meta " ++ show v+                 return v+    LLet (TBind x dom) tel e1 e2 | null tel -> do+      let v1 = mkClos env e1+      whnf (update env x v1) e2+{-+-- ALT: remove erased lambdas entirely+    Lam dec x e1 | erased dec -> whnf env e1+                 | otherwise -> return $ VLam x env e1+-}+    Lam dec x e1 -> return $ vLam x env e1+    Below ltle e -> VBelow ltle <$> whnf env e+    Quant pisig (TBind x dom) b -> do+      dom' <- Traversable.mapM (whnf env) dom  -- Pi is strict in its first argument+      return $ VQuant pisig x dom' $ vLam x env b++    -- a measured type evaluates to+    -- * a bounded type if measure present in environment (rhs of funs)+    -- * otherwise to a measured type (lhs of funs)+    Quant Pi (TMeasure mu) b -> do+      muv <- whnfMeasure env mu+      bv  <- whnf env b -- not adding measure constraint to context!+      case (envBound env) of+        Nothing   -> return $ VMeasured muv bv+           -- fail $ "panic: whnf " ++ show e ++ " : no measure in environment " ++ show env+        Just muv' -> return $ VGuard (Bound Lt muv muv') bv++    Quant Pi (TBound (Bound ltle mu mu')) b -> do+          muv  <- whnfMeasure env mu+          muv' <- whnfMeasure env mu'+          bv   <- whnf env b  -- not adding measure constraint to context!+          return $ VGuard (Bound ltle muv muv') bv++    Sing e t  -> do tv <- whnf env t+                    sing env e tv++    Pair e1 e2 -> VPair <$> whnf env e1 <*> whnf env e2+    Proj fx n  -> return $ VProj fx n++    Record ri@(NamedRec Cons _ _ _) rs -> VRecord ri <$> mapAssocM (whnf env) rs++    -- coinductive and anonymous records are treated lazily:+    Record ri rs -> return $ VRecord ri $ mapAssoc (mkClos env) rs++{-+-- ALT: filter out all erased arguments from application+    App e1 el -> do v1 <- whnf env e1+                    vl <- liftM (filter (/= VIrr)) $ mapM (whnf env) el+                    app v1 vl+-}+    App f e   -> do vf <- whnf env f+                    let ve = mkClos env e+                    app vf ve+{-+    App e1 el -> do v1 <- whnf env e1+                    vl <- mapM (whnf env) el+                    app v1 vl+-}++    Case e (Just t) cs -> do+      v  <- whnf env e+      vt <- whnf env t+      evalCase v vt env cs+                  -- trace ("case head evaluates to " ++ showVal v) $ return ()++    Sort s -> whnfSort env s >>= return . vSort+    Infty -> return VInfty+    Zero -> return VZero+    Succ e1 -> do v <- whnf env e1           -- succ is strict+                  return $ succSize v++    Max es  -> do vs <- mapM (whnf env) es   -- max is strict+                  return $ maxSize vs+    Plus es -> do vs <- mapM (whnf env) es   -- plus is strict+                  return $ plusSizes vs++    Def (DefId LetK n) -> do+        item <- lookupSymbQ n+        whnfClos (definingVal item)++    Def (DefId (ConK DefPat) n) -> whnfClos . definingVal =<< lookupSymbQ n+--    Def (DefId (ConK DefPat) n) -> fail $ "internal error: whnf of defined pattern " ++ show n+    Def id   -> return $ vDef id+{-+    Con co n -> return $ VCon co n++    Def n -> return $ VDef n++    Let n -> do sig <- gets signature+                let (LetSig _ v) = lookupSig n sig+                return v+--                let (LetSig _ e) = lookupSig n sig+--                whnf [] e+-}+    Var y -> lookupEnv env y >>= whnfClos+    Ann e -> whnf env (unTag e) -- return VIrr -- NEED TO KEEP because of eta-exp!+    Irr -> return VIrr+    e   -> fail $ "NYI whnf " ++ show e++whnfMeasure :: Env -> Measure Expr -> TypeCheck (Measure Val)+whnfMeasure rho (Measure mu) = mapM (whnf rho) mu >>= return . Measure++whnfSort :: Env -> Sort Expr -> TypeCheck (Sort Val)+whnfSort rho (SortC c) = return $ SortC c+whnfSort rho (CoSet e) = whnf rho e >>= return . CoSet+whnfSort rho (Set e)   = whnf rho e >>= return . Set++whnfClos :: Clos -> TypeCheck Val+whnfClos v = -- trace ("whnfClos " ++ show v) $+  case v of+    (VClos e rho) -> whnf e rho+    -- (VApp (VProj Pre n) [u]) -> app u (VProj Post n) -- NO EFFECT+    (VApp (VDef (DefId FunK n)) vl) -> appDef n vl -- THIS IS TO SOLVE A PROBLEM+    v -> return v+{- THE PROBLEM IS that+  (tail (x Up Stream)) Up Stream is a whnf, because Up Stream is lazy+  in equality checking this is a problem when the Up is removed.+-}++-- evaluate in standard environment+whnf' :: Expr -> TypeCheck Val+whnf' e = do+  env <- getEnv+  whnf env e++-- <t : Pi x:a.b> = Pi x:a <t x : b>+-- <t : <t' : a>> = <t' : a>+sing :: Env -> Expr -> TVal -> TypeCheck TVal+sing rho e tv = do+  let v = mkClos rho e -- v <- whnf rho e+  vSing v tv+{-+sing env' e (VPi dec x av env b)  = do+  return $ VPi dec x' av env'' (Sing (App e (Var x')) b)+    where env'' = env' ++ env  -- super ugly HACK+          x'    = if x == "" then fresh env'' else x+    -- Should work with just x since shadowing is forbidden+sing _ _ tv@(VSing{}) = return $ tv+sing env e tv = do v <- whnf env e      -- singleton strict, is this OK?!+                   return $ VSing v tv+-}++sing' :: Expr -> TVal -> TypeCheck TVal+sing' e tv = do+  env <- getEnv+  sing env e tv++evalCase :: Val -> TVal -> Env -> [Clause] -> TypeCheck Val+evalCase v tv env cs = do+  m  <- matchClauses env cs [v]+  case m of+    Nothing -> return $ VCase v tv env cs+    Just v' -> return $ v'++piApp :: TVal -> Clos -> TypeCheck TVal+piApp (VGuard beta bv) w = piApp bv w+piApp (VQuant Pi x dom fv) w = app fv w+piApp tv@(VApp (VDef (DefId DatK n)) vl) (VProj Post p) = projectType tv p VIrr -- no rec value here+piApp tv w = failDoc (text "piApp: IMPOSSIBLE to instantiate" <+> prettyTCM tv <+> text "to argument" <+> prettyTCM w)++piApps :: TVal -> [Clos] -> TypeCheck TVal+piApps tv [] = return tv+piApps tv (v:vs) = do tv' <- piApp tv v+                      piApps tv' vs++updateValu valu i v = reval' (sgVal i v) valu++-- in app u v, u might be a VDef (e.g. when coming from reval)+app :: Val -> Clos -> TypeCheck Val+app = app' True++-- | Application of arguments and projections.+app' :: Bool -> Val -> Clos -> TypeCheck Val+app' expandDefs u v = do+         let app = app' expandDefs+             appDef' True  f vs = appDef f vs+             appDef' False f vs = return $ VDef (DefId FunK f) `VApp` vs+             appDef_ = appDef' expandDefs+         case u of+            VProj Pre n -> flip (app' expandDefs) (VProj Post n) =<< whnfClos v+            VRecord ri rho -> do+              let VProj Post n = v+              maybe (fail $ "app: projection " ++ show n ++ " not found in " ++ show u)+                whnfClos (lookup n rho)+            VDef (DefId FunK n) -> appDef_ n [v]+            VApp (VDef (DefId FunK n)) vl -> appDef_ n (vl ++ [v])+            VApp h@(VDef (DefId (ConK Cons) n)) vl -> do+              v <- whnfClos v      -- inductive constructors are strict!+              return $ VApp h (vl ++ [v])+--            VDef n -> appDef n [v]+--            VApp (VDef id) vl -> VApp (VDef id) (vl ++ [v])+            VApp v1 vl -> return $ VApp v1 (vl ++ [v])++-- VSing is a type!+--           VSing u (VQuant Pi x dom fu) -> vSing <$> app u v <*> app fu v++            VLam x env e    -> whnf (update env x v) e+            VConst u        -> whnfClos u+            VAbs x i u valu -> flip reval' u =<< updateValu valu i v+            VUp u (VQuant Pi x dom fu) -> up False ==<< (app u v, app fu v)++{-+            VUp u1 (VQuant Pi x dom rho b) -> do+{-+-- ALT: erased functions are not applied to their argument!+              v1 <- if erased dec then return v else app v [w]  -- eta-expand w ??+-}+              v1 <- app u1 v  -- eta-expand v ??+              bv <- whnf (update rho x v) b+              up False v1 bv+-}+            VUp u1 (VApp (VDef (DefId DatK n)) vl) -> do+              u' <- force u+              app u' v++            VIrr -> return VIrr+{- 2010-11-01 this breaks extraction for System U example+            VIrr -> fail $ "app internal error: " ++ show (VApp u [v])+-}+            _ -> return $ VApp u [v]+--+-- app :: Val -> [Val] -> TypeCheck Val+-- app u [] = return $ u+-- app u c = do+--          case (u,c) of+--             (VApp u2 c2,_) -> app u2 (c2 ++ c)+--             (VLam x env e,(v:vl))  -> do v' <- whnf (update env x v) e+--                                          app v' vl+--             (VDef n,_) -> appDef n c+--             (VUp v (VPi dec x av rho b), w:wl) -> do+-- {-+-- -- ALT: erased functions are not applied to their argument!+--               v1 <- if erased dec then return v else app v [w]  -- eta-expand w ??+-- -}+--               v1 <- app v [w]  -- eta-expand w ??+--               bv <- whnf (update rho x w) b+--               v2 <- up v1 bv+--               app v2 wl+-- {-+-- -- ALT: VIrr consumes applications+--             (VIrr,_) -> return VIrr+--  -}+--             (VIrr,_) -> fail $ "app internal error: " ++ show (VApp u c)+--             _ -> return $ VApp u c+++-- unroll a corecursive definition one time (until constructor appears)+force' :: Bool -> Val -> TypeCheck (Bool, Val)+force' b (VSing v tv) = do  -- for singleton types, force type!+  (b',tv') <- force' b tv+  return (b', VSing v tv')+force' b (VUp v tv) = up True v tv >>= \ v' -> return (True, v')  -- force eta expansion+force' b (VClos rho e) = do+  v <- whnf rho e+  force' b v+force' b v@(VDef (DefId FunK n)) = failValInv v+{-+ --trace ("force " ++ show v) $+    do sig <- gets signature+       case lookupSig n sig of+         (FunSig CoInd t cl True) -> do m <- matchClauses [] cl []+                                        case m of+                                          Just v' -> force v'+                                          Nothing -> return v+         _ -> return v+-}+force' b v@(VApp (VDef (DefId FunK n)) vl) = enterDoc (text "force" <+> prettyTCM v) $+    do sig <- gets signature+       case Map.lookup n sig of+         Just (FunSig isCo t ki ar cl True _) -> traceMatch ("forcing " ++ show v) $+            do m <- matchClauses emptyEnv cl vl+               case m of+                 Just v' -> traceMatch ("forcing " ++ show n ++ " succeeded") $+                   force' True v'+                 Nothing -> traceMatch ("forcing " ++ show n ++ " failed") $+                   return (b, v)+         _ -> return (b, v)+force' b v = return (b, v)++force :: Val -> TypeCheck Val+force v = -- trace ("forcing " ++ show v) $+  liftM snd $ force' False v++-- apply a recursive function+-- corecursive ones are not expanded even if the arity is exceeded+-- this is because a coinductive type needs to be destructed by pattern matching+appDef :: QName -> [Val] -> TypeCheck Val+appDef n vl = --trace ("appDef " ++ n) $+    do+      -- identifier might not be in signature yet, e.g. ind.-rec.def.+      sig <- gets signature+      case (Map.lookup n sig) of+        Just (FunSig { isCo = Ind, arity = ar, clauses = cl, isTypeChecked = True })+         | length vl >= fullArity ar -> do+           m <- matchClauses emptyEnv cl vl+           case m of+              Nothing -> return $ VApp (VDef (DefId FunK n)) vl+              Just v2 -> return v2+        _ -> return $ VApp (VDef (DefId FunK n)) vl++-- reflection and reification  ---------------------------------------++-- TODO: eta for builtin sigma-types !?++-- up force v tv+-- force==True also expands at coinductive type+up :: Bool -> Val -> TVal -> TypeCheck Val+up f (VUp v tv') tv                              = up f v tv+up f v           tv@VQuant{ vqPiSig = Pi }       = return $ VUp v tv+up f _           (VSing v vt)                    = up f v vt+up f v           (VDef d)                        = failValInv $ VDef d+up f v           (VApp (VDef (DefId DatK d)) vl) = upData f v d vl+up f v           _                               = return v++{- Most of the code to eta expand on data types is in+   TypeChecker.hs "typeCheckDeclaration"++ Currently, eta expansion only happens at data *types* with exactly+one constructor.  In a first step, this will be extended to+non-recursive pattern inductive families.++The strategy is: match type value with result type for all the constructors+0. if there are no matches, eta expand to * (VIrr)+1. if there is exactly one match, eta expand accordingly using destructors+2. if there are more matches, do not eta-expand++up{Vec A (suc n)} x = vcons A n (head A n x) (tail A n x)++up{Vec Bool (suc zero)} x+  = vcons Bool zero (head Bool zero x) (tail Bool zero x)++For vcons+- the patterns of  Vec : (A : Set) -> Nat -> Set  are  [A,suc n]+- matching  Bool,suc zero  against  A,suc n  yields A=Bool,n=zero+- this means we can eta expand to vcons+- go through the fields of vcons+  - if Index use value obtained by matching+  - if Field destr, use  destr <all pars> <all indices> x++-}++-- matchingConstructors is for use in checkPattern+-- matchingConstructors (D vs)  returns all the constructors+-- each as tuple (ci,rho)+-- of family D whose target matches (D vs) under substitution rho+matchingConstructors :: Val -> TypeCheck (Maybe [(ConstructorInfo,Env)])+matchingConstructors v@(VDef d) = failValInv v -- matchingConstructors' d []+matchingConstructors (VApp (VDef (DefId DatK d)) vl) = matchingConstructors' d vl >>= return . Just+matchingConstructors v = return Nothing+-- fail $ "matchingConstructors: not a data type: " ++ show v -- return []++matchingConstructors' :: QName -> [Val] -> TypeCheck [(ConstructorInfo,Env)]+matchingConstructors' n vl = do+  sige <- lookupSymbQ n+  case sige of+    (DataSig {symbTyp = dv, constructors = cs}) -> -- if (null cs) then ret [] else do -- no constructor+      matchingConstructors'' True vl dv cs++-- matchingConstructors''+-- Arguments:+--   symm     symmetric match+--   vl       arguments to D (instance of D)+--   dv       complete type value of D+--   cs       constructors+-- Returns a list [(ci,rho)] of matching constructors together with the+--   environments which are solutions for the free variables in the constr.type+-- this is also for use in upData+matchingConstructors'' :: Bool -> [Val] -> Val -> [ConstructorInfo] -> TypeCheck [(ConstructorInfo,Env)]+matchingConstructors'' symm vl dv cs = do+  vl <- mapM whnfClos vl+  compressMaybes <$> do+    forM cs $ \ ci -> do+      let ps = snd (cPatFam ci)+          -- list of patterns ps where D ps is the constructor target+      fmap (ci,) <$> nonLinMatchList symm emptyEnv ps vl dv+++data MatchingConstructors a+  = NoConstructor+  | OneConstructor a+  | ManyConstructors+  | UnknownConstructors+    deriving (Eq,Show)++getMatchingConstructor+  :: Bool           -- eta   : must the field etaExpand be set of the data type+  -> QName          -- d     : the name of the data types+  -> [Val]          -- vl    : the arguments of the data type+  -> TypeCheck (MatchingConstructors+     ( Co           -- co    : coinductive type?+     , [Val]        -- parvs : the parameter half of the arguments+     , Env          -- rho   : the substitution for the index variables to arrive at d vl+     , [Val]        -- indvs : the index values of the constructor+     , ConstructorInfo -- ci : the only matching constructor+     ))+getMatchingConstructor eta n vl = traceRecord ("getMatchingConstructor " ++ show (n, vl)) $+ do+  -- when checking a mutual data decl, the sig entry of the second data+  -- is not yet in place when checking the first, thus, lookup may fail+  sig <- gets signature+  case Map.lookup n sig of+    Just (DataSig {symbTyp = dv, numPars = npars, isCo = co, constructors = cs, etaExpand}) | eta `implies` etaExpand ->+     if (null cs) then return NoConstructor else do -- no constructor: empty type+       -- for each constructor, match its core against the type+      -- produces a list of maybe (c.info, environment)+      cenvs <- matchingConstructors'' False vl dv cs+      traceRecordM $ "Matching constructors: " ++ show cenvs+      case cenvs of+        -- exactly one matching constructor: can eta expand+--        [(ci,env)] -> if not (eta `implies` cEtaExp ci) then return UnknownConstructors else do+        [(ci,env)] -> if eta && not (cEtaExp ci) then return UnknownConstructors else do+          -- get list of index values from environment+          let fis = cFields ci+          let indices = filter (\ fi -> fClass fi == Index) fis+          let indvs = map (\ fi -> lookupPure env (fName fi)) indices+          let (pars, _) = splitAt npars vl+          return $ OneConstructor (co, pars, env, indvs, ci)+        -- more or less than one matching constructors: cannot eta expand+        l -> -- trace ("getMatchingConstructor: " ++ show (length l) ++ " patterns match at type " ++ show n ++ show vl) $+               return ManyConstructors+    _ -> traceRecord ("no eta expandable type") $ return UnknownConstructors++getFieldsAtType+  :: QName          -- d     : the name of the data types+  -> [Val]          -- vl    : the arguments of the data type+  -> TypeCheck+     (Maybe         -- Nothing if not a record type+       [(Name       -- list of projection names+        ,TVal)])    -- and their instantiated type R ... -> C+getFieldsAtType n vl = do+  mc <- getMatchingConstructor False n vl+  case mc of+    OneConstructor (_, pars, _, indvs, ci) -> do+      let pi = pars ++ indvs+      -- for each argument of constructor, get value+      let arg (FieldInfo { fName = x, fClass = Index }) = return []+          arg (FieldInfo { fName = d, fClass = Field _ }) = do+            -- lookup type sig  t  of destructor  d+            t <- lookupSymbTyp d+            -- pi-apply destructor type to parameters and indices+            t' <- piApps t pi+            return [(d,t')]+      Just . concat <$> mapM arg (cFields ci)+    _ -> return Nothing++-- similar to piApp, but for record types and projections+projectType :: TVal -> Name -> Val -> TypeCheck TVal+projectType tv p rv = do+  let fail1 = failDoc (text "expected record type when taking the projection" <+> prettyTCM (Proj Post p) <> comma <+> text "but found type" <+> prettyTCM tv)+  let fail2 = failDoc (text "record type" <+> prettyTCM tv <+> text "does not have field" <+> prettyTCM p)+  case tv of+    VApp (VDef (DefId DatK d)) vl -> do+      mfs <- getFieldsAtType d vl+      case mfs of+        Nothing -> fail1+        Just ptvs ->+          case lookup p ptvs of+            Nothing -> fail2+            Just tv -> piApp tv rv -- apply to record arg+    _ -> fail1++-- eta expand  v  at data type  n vl+upData :: Bool -> Val -> QName -> [Val] -> TypeCheck Val+upData force v n vl = -- trace ("upData " ++ show v ++ " at " ++ n ++ show vl) $+ do+  let ret v' = traceEta ("Eta-expanding: " ++ show v ++ " --> " ++ show v' ++ " at type " ++ show n ++ show vl) $ return v'+  mc <- getMatchingConstructor True n vl+  case mc of+    NoConstructor -> ret VIrr+    OneConstructor (co, pars, env, indvs, ci) ->+      -- lazy eta-expansion for coinductive records like streams!+      if (co==CoInd && not force) then return $ VUp v (VApp (VDef $ DefId DatK n) vl) else do+          -- get list of index values from environment+          let fis = cFields ci+          let piv = pars ++ indvs ++ [v]+          -- for each argument of constructor, get value+          let arg (FieldInfo { fName = x, fClass = Index }) =+                lookupEnv env x+              arg (FieldInfo { fName = d, fClass = Field _ }) = do+                -- lookup type sig  t  of destructor  d+                LetSig {symbTyp = t, definingVal = w} <- lookupSymb d+                -- pi-apply destructor type to parameters, indices and value v+                t' <- piApps t piv+                -- recursively eta expand  (d <pars> v)+                -- OLD, defined projections:+                -- w <- foldM (app' False) w piv -- LAZY: only unfolds let, not def+                -- NEW, builtin projections:+                w <- app' False v (VProj Post d)+                up False w t' -- now: LAZY++          vs <- mapM arg fis+          let fs = map fName fis+              v' = VRecord (NamedRec (coToConK co) (cName ci) False notDotted) $ zip fs vs+--          v' <- foldM app (vCon (coToConK co) (cName ci)) vs -- 2012-01-22 PARS GONE: (pars ++ vs)+          ret v'+    -- more constructors or unknown situation: do not eta expand+    _ -> return v++{-+-- eta expand  v  at data type  n vl+upData :: Bool -> Val -> Name -> [Val] -> TypeCheck Val+upData force v n vl = -- trace ("upData " ++ show v ++ " at " ++ n ++ show vl) $+ do+  let ret v' = traceEta ("Eta-expanding: " ++ show v ++ " --> " ++ show v' ++ " at type " ++ n ++ show vl) $ return v'+  -- when checking a mutual data decl, the sig entry of the second data+  -- is not yet in place when checking the first, thus, lookup may fail+  sig <- gets signature+  case Map.lookup n sig of+    Just (DataSig {symbTyp = dv, numPars = npars, isCo = co, constructors = cs, etaExpand = True}) -> if (null cs) then ret VIrr else do -- no constructor: empty type+      let (pars, inds) = splitAt npars vl+      -- for each constructor, match its core against the type+      -- produces a list of maybe (c.info, environment)+      cenvs <- matchingConstructors'' False vl dv cs+      -- traceM $ "Matching constructors: " ++ show cenvs+      case cenvs of+        -- exactly one matching constructor: can eta expand+        [(ci,env)] -> if not (cEtaExp ci) then return v else+         if (co==CoInd && not force) then return $ VUp v (VApp (VDef $ DefId Dat n) vl) else do+          -- get list of index values from environment+          let fis = cFields ci+          let indices = filter (\ fi -> fClass fi == Index) fis+          let indvs = map (\ fi -> lookupPure env (fName fi)) indices+          let piv = pars ++ indvs ++ [v]+          -- for each argument of constructor, get value+          let arg (FieldInfo { fName = x, fClass = Index }) =+                lookupEnv env x+              arg (FieldInfo { fName = d, fClass = Field _ }) = do+                -- lookup type sig  t  of destructor  d+                t <- lookupSymbTyp d+                -- pi-apply destructor type to parameters, indices and value v+                t' <- piApps t piv+                -- recursively eta expand  (d <pars> v)+                -- WAS: up (VDef (DefId Fun d) `VApp` piv) t'+                up False (VDef (DefId Fun d) `VApp` piv) t' -- now: LAZY+          vs <- mapM arg fis+          v' <- foldM app (vCon co (cName ci)) (pars ++ vs)+          ret v'+        -- more or less than one matching constructors: cannot eta expand+        l -> -- trace ("Eta: " ++ show (length l) ++ " patterns match at type " ++ show n ++ show vl) $+               return v+    _ -> return v+-}++{-+      let matchC (c, ps, ds) =+            do menv <- nonLinMatchList [] ps inds dv+               case menv of+                 Nothing -> return False+                 Just env -> do+                   let grps = groupBy (\ (x,_) (y,_) -> x == y) env+                   -- TODO: now compare elements in the group+                   -- NEED types for equality check+                   -- trivial if groups are singletons+                   return $ all (\ l -> length l <= 1) grps+      cs' <- filterM matchC cs+      case cs' of+        [] -> return $ VIrr+        [(c,_,ds)] ->  do+          let parsv = pars ++ [v]+          let aux d = do+               -- lookup type sig  t  of destructor  d+               let FunSig { symbTyp = t } = lookupSig d sig+               -- pi-apply destructor type to parameters and value v+               t' <- piApps t parsv+               -- recursively eta expand  (d <pars> v)+               up (VDef d `VApp` parsv) t'+          vs <- mapM aux ds+          app (VCon co c) (pars ++ vs)+        _ -> return v+    _ -> return v+-}++{-+refl : [A : Set] -> [a : A] -> Id A a a+up{Id T t t'} x+  Id T t t' =?= Id A a a  --> A = T, a = t, a = t'+-}++{- OLD CODE FOR NON-DEPENDENT RECORDS ONLY+    -- erase if n is a empty type+    (DataSig {constructors = []}) -> return $ VIrr+    -- eta expand v if n is a tuple type+    (DataSig {isCo = co, constructors = [c], destructors = Just ds}) -> do+       let vlv = vl ++ [v]+       let aux d = do -- lookup type sig  t  of destructor  d+                      let FunSig { symbTyp = t } = lookupSig d sig+                      -- pi-apply destructor type to parameters and value v+                      t' <- piApps t vlv+                      -- recursively eta expand  (d <pars> v)+                      up (VDef d `VApp` vlv) t'+       vs <- mapM aux ds+       app (VCon co c) (vl ++ vs) -- (map (\d -> VDef d `VApp` (vl ++ [v])) ds)+    _ -> return v+END OLD CODE -}++-- pattern matching ---------------------------------------------------++matchClauses :: Env -> [Clause] -> [Val] -> TypeCheck (Maybe Val)+matchClauses env cl vl0 = do+  vl <- mapM reduce vl0  -- REWRITE before matching (2010-07-12 dysfunctional because of lazy?)+  loop cl vl+    where loop [] vl = return Nothing+          loop (Clause _ pl Nothing : cl2) vl = loop cl2 vl -- no need to try absurd clauses+          loop (Clause _ pl (Just rhs) : cl2) vl =+              do x <- matchClause env pl rhs vl+                 case x of+                   Nothing -> loop cl2 vl+                   Just v -> return $ Just v++bindMaybe :: Monad m => m (Maybe a) -> (a -> m (Maybe b)) -> m (Maybe b)+bindMaybe mma k = mma >>= maybe (return Nothing) k++matchClause :: Env -> [Pattern] -> Expr -> [Val] -> TypeCheck (Maybe Val)+matchClause env pl rhs vl =+  case (pl, vl) of+    (p:pl, v:vl) -> match env p v `bindMaybe` \ env' -> matchClause env' pl rhs vl++    -- done matching: eval clause body in env and apply it to remaining arsg+    ([], _)      -> Just <$> do flip (foldM app) vl =<< whnf env rhs++    -- too few arguments to fire clause: give up+    (_, [])      -> return Nothing+++match :: Env -> Pattern -> Val -> TypeCheck (Maybe Env)+match env p v0 = --trace (show env ++ show v0) $+  do+    -- force against constructor pattern or pair pattern+    v <- case p of+           ConP{}  -> do v <- force v0; traceMatch ("matching pattern " ++ show (p,v)) $ return v+           PairP{} -> do v <- force v0; traceMatch ("matching pattern " ++ show (p,v)) $ return v+           _ -> whnfClos v0+    case (p,v) of+--      (ErasedP _,_) -> return $ Just env  -- TOO BAD, DOES NOT WORK (eta!)+      (ErasedP p,_) -> match env p v+      (AbsurdP{},_) -> return $ Just env+      (DotP _,   _) -> return $ Just env+      (VarP x,   _) -> return $ Just (update env x v)+      (SizeP _ x,_) -> return $ Just (update env x v)+      (ProjP x, VProj Post y) | x == y -> return $ Just env+      (PairP p1 p2, VPair v1 v2) -> matchList env [p1,p2] [v1,v2]+      (ConP _ x [],VDef (DefId (ConK _) y)) -> failValInv v -- | x == y -> return $ Just env+--  The following case is NOT IMPOSSIBLE:+--      (ConP _ x pl,VApp (VDef (DefId (ConK _) y)) vl) -> failValInv v+      (ConP _ x pl,VApp (VDef (DefId (ConK _) y)) vl) | nameInstanceOf x  y -> matchList env pl vl+      -- If a value is a dotted record value, we do not succeed, since+      -- it is not sure this is the correct constructor.+      (ConP _ x pl,VRecord (NamedRec ri y _ dotted) rs) | nameInstanceOf x y && not (isDotted dotted) ->+         matchList env pl $ map snd rs+      (p@(ConP pi _ _), v) | coPat pi == DefPat -> do+        p <- expandDefPat p+        match env p v+      (SuccP p', v) -> (predSize <$> whnfClos v) `bindMaybe` match env p'+      (UnusableP p,_) -> throwErrorMsg ("internal error: match " ++ show (p,v))+      _ -> return Nothing++matchList :: Env -> [Pattern] -> [Val] -> TypeCheck (Maybe Env)+matchList env []     []     = return $ Just env+matchList env (p:pl) (v:vl) =+  match env p v `bindMaybe` \ env' ->+  matchList env' pl vl+matchList env pl     vl     = fail $ "matchList internal error: inequal length while trying to match patterns " ++ show pl ++ " against values " ++ show vl++-- * Typed Non-linear Matching -----------------------------------------++type GenToPattern = [(Int,Pattern)]+type MatchState = (Env, GenToPattern)++-- @nonLinMatch True@ allows also instantiation in v0+-- this is useful for finding all matching constructors+-- for an erased argument in checkPattern+nonLinMatch :: Bool -> Bool -> MatchState -> Pattern -> Val -> TVal -> TypeCheck (Maybe MatchState)+nonLinMatch undot symm st p v0 tv = traceMatch ("matching pattern " ++ show (p,v0)) $ do+  -- force against constructor pattern+  v <- case p of+         ConP{}  -> force v0+         PairP{} -> force v0+         _ -> whnfClos v0+  case (p,v) of+    (ErasedP{}, _) -> return $ Just st+    (DotP{}   , _) -> return $ Just st+    (_,    VGen i) | symm -> return $ Just $ mapSnd ((i,p):) st -- no check in case of non-lin!+    (VarP    x, _) -> matchVarP x v+    (SizeP _ x, _) -> matchVarP x v+    (ProjP x,     VProj Post y) | x == y -> return $ Just st+    (ConP _ c pl, VApp (VDef (DefId (ConK _) c')) vl) | nameInstanceOf c c' -> do+      vc <- conLType c tv+      nonLinMatchList' undot symm st pl vl vc+    -- Here, we do accept dotted constructors, since we are abusing this for unification.+    (ConP _ c pl, VRecord (NamedRec _ c' _ dotted) rs) | nameInstanceOf c c' -> do+      when undot $ clearDotted dotted+      vc <- conLType c tv+      nonLinMatchList' undot symm st pl (map snd rs) vc+    -- if the match against an unconfirmed constructor+    -- we can succeed, but not compute a sensible environment+    (_, VRecord (NamedRec _ c' _ dotted) rs) | isDotted dotted && not undot -> return $ Just st+    (p@(ConP pi _ _), v) | coPat pi == DefPat -> do+      p <- expandDefPat p+      nonLinMatch undot symm st p v tv+    (PairP p1 p2, VPair v1 v2) -> do+      tv <- force tv+      case tv of+        VQuant Sigma x dom fv -> do+          nonLinMatch undot symm st p1 v1 (typ dom) `bindMaybe` \ st -> do+          nonLinMatch undot symm st p2 v2 =<< app fv v1+        _ -> failDoc $ text "nonLinMatch: expected" <+> prettyTCM tv <+> text "to be a Sigma-type (&)"+    (SuccP p', v) -> (predSize <$> whnfClos v) `bindMaybe` \ v' ->+      nonLinMatch undot symm st p' v' tv+    _ -> return Nothing+  where+    -- Check that the previous solution for @x@ is equal to @v@.+    -- Here, we need the type!+    matchVarP x v = do+      let env = fst st+      case find ((x ==) . fst) $ envMap $ fst st of+        Nothing     -> return $ Just $ mapFst (\ env -> update env x v) st+        Just (y,v') -> ifM (eqValBool tv v v') (return $ Just st) (return Nothing)++-- nonLinMatchList symm env ps vs tv+-- typed non-linear matching of patterns ps against values vs at type tv+--   env   is the accumulator for the solution of the matching+nonLinMatchList :: Bool -> Env -> [Pattern] -> [Val] -> TVal -> TypeCheck (Maybe Env)+nonLinMatchList symm env ps vs tv =+  fmap fst <$> nonLinMatchList' False symm (env, []) ps vs tv++nonLinMatchList' :: Bool -> Bool -> MatchState -> [Pattern] -> [Val] -> TVal -> TypeCheck (Maybe MatchState)+nonLinMatchList' undot symm st [] [] tv = return $ Just st+nonLinMatchList' undot symm st (p:pl) (v:vl) tv = do+  tv <- force tv+  case tv of+    VQuant Pi x dom fv ->+      nonLinMatch undot symm st p v (typ dom) `bindMaybe` \ st' ->+      nonLinMatchList' undot symm st' pl vl =<< app fv v+    _ -> fail $ "nonLinMatchList': cannot match in absence of pi-type"+nonLinMatchList' _ _ _ _ _ _ = return Nothing+++-- | Expand a top-level pattern synonym+expandDefPat :: Pattern -> TypeCheck Pattern+expandDefPat p@(ConP pi c ps) | coPat pi == DefPat = do+  PatSig ns pat v <- lookupSymbQ c+  unless (length ns == length ps) $+    fail ("underapplied defined pattern in " ++ show p)+  let pat' = if dottedPat pi then dotConstructors pat else pat+  return $ patSubst (zip ns ps) pat'+expandDefPat p = return p++---------------------------------------------------------------------------+-- * Unification+---------------------------------------------------------------------------++instance Monoid (TypeCheck Bool) where+  mempty  = return True+  mappend = andLazy+  mconcat = andM++-- | Occurrence check @nocc ks v@ (used by 'SPos' and 'TypeCheck').+--   Checks that generic values @ks@ does not occur in value @v@.+--   In the process, @tv@ is normalized.+class Nocc a where+  nocc :: [Int] -> a -> TypeCheck Bool++instance Nocc a => Nocc [a] where+  nocc = foldMap . nocc++instance Nocc a => Nocc (Dom a) where+  nocc = foldMap . nocc++instance Nocc a => Nocc (Measure a) where+  nocc = foldMap . nocc++instance Nocc a => Nocc (Bound a) where+  nocc = foldMap . nocc++instance (Nocc a, Nocc b) => Nocc (a,b) where+  nocc ks (a, b) = nocc ks a `andLazy` nocc ks b++instance Nocc a => Nocc (Sort a) where+  nocc ks (Set   v) = nocc ks v+  nocc ks (CoSet v) = nocc ks v+  nocc ks (SortC _) = mempty++instance Nocc Val where+  nocc ks v = do+    -- traceM ("nocc " ++ show v)+    v <- whnfClos v+    case v of+      -- neutrals+      VGen k                -> return $ not $ k `elem` ks+      VApp v1 vl            -> nocc ks $ v1 : vl+      VDef{}                -> mempty+      VProj{}               -> mempty+      -- Binders:+      -- ALT: do not evaluate under binders (just check environment).+      -- This is less precise but more efficient. Can give false alarms.+      -- Still sound. (Should maybe done first, like in Agda).+      VQuant pisig x dom fv -> nocc ks dom `mappend` do+                               underAbs  x dom  fv $ \ _i _xv bv -> nocc ks bv+      fv@(VLam x env b)     -> underAbs' x      fv $ \ _xv bv -> nocc ks bv+      fv@(VAbs x i u valu)  -> underAbs' x      fv $ \ _xv bv -> nocc ks bv+      fv@(VConst v)         -> underAbs' noName fv $ \ _xv bv -> nocc ks bv+      -- pairs+      VRecord _ rs          -> nocc ks $ map snd rs+      VPair v w             -> nocc ks (v, w)+      -- sizes+      VZero                 -> mempty+      VSucc v               -> nocc ks v+      VInfty                -> mempty+      VMax vl               -> nocc ks vl+      VPlus vl              -> nocc ks vl+      VSort s               -> nocc ks s+      VMeasured mu tv       -> nocc ks (mu, tv)+      VGuard beta tv        -> nocc ks (beta, tv)+      VBelow ltle v         -> nocc ks v+      VSing v tv            -> nocc ks (v, tv)+      VUp v tv              -> nocc ks (v, tv)+      VIrr                  -> mempty+      VCase v tv env cls    -> nocc ks $ v : tv : map snd (envMap env)+      -- impossible: closure (reduced away)+      VClos{}               -> fail $ "internal error: nocc " ++ show (ks,v)+++-- heterogeneous typed equality and subtyping ------------------------++eqValBool :: TVal -> Val -> Val -> TypeCheck Bool+eqValBool tv v v' = errorToBool $ eqVal tv v v'+-- eqValBool tv v v' = (eqVal tv v v' >> return True) `catchError` (\ _ -> return False)++eqVal :: TVal -> Val -> Val -> TypeCheck ()+eqVal tv = leqVal' N mixed (Just (One tv))+++-- force history+data Force = N | L | R -- not yet, left , right+    deriving (Eq,Show)++class Switchable a where+  switch :: a -> a++instance Switchable Force where+  switch L = R+  switch R = L+  switch N = N++instance Switchable Pol where+  switch = polNeg++instance Switchable (a,a) where+  switch (a,b) = (b,a)++instance Switchable a => Switchable (Maybe a) where+  switch = fmap switch++{-+-- WONTFIX: FOR THE FOLLOWING TO BE SOUND, ONE NEEDS COERCIVE SUBTYPING!+-- the problem is that after extraction, erased arguments are gone!+-- a function which does not use its argument can be used as just a function+-- [A] -> A <= A -> A+-- A <= [A]+leqDec :: Pol -> Dec -> Dec -> Bool+leqDec SPos  dec1 dec2 = erased dec2 || not (erased dec1)+leqDec Neg   dec1 dec2 = erased dec1 || not (erased dec2)+leqDec mixed   dec1 dec2 = erased dec1 == erased dec2+-}++-- subtyping for erasure disabled+-- but subtyping for polarities!+leqDec :: Pol -> Dec -> Dec -> Bool+leqDec p dec1 dec2 = erased dec1 == erased dec2+  && relPol p leqPol (polarity dec1) (polarity dec2)++-- subtyping ---------------------------------------------------------++subtype :: Val -> Val -> TypeCheck ()+subtype v1 v2 = -- enter ("subtype " ++ show v1 ++ "  <=  " ++ show v2) $+  leqVal' N Pos Nothing v1 v2++-- Pol ::= Pos | Neg | mixed+leqVal :: Pol -> TVal -> Val -> Val -> TypeCheck ()+leqVal p tv = leqVal' N p (Just (One tv))++type MT12 = Maybe (OneOrTwo TVal)++-- view the shape of a type or a pair of types+data TypeShape+  = ShQuant PiSigma+            (OneOrTwo Name)+            (OneOrTwo Domain)+            (OneOrTwo FVal)      -- both are function types+  | ShSort  SortShape            -- sort of same shape+  | ShData  QName (OneOrTwo TVal)-- same data, but with possibly different args+  | ShNe    (OneOrTwo TVal)      -- both neutral+  | ShSing  Val TVal             -- 1 and singleton+  | ShSingL Val TVal TVal        -- 2 and the left is a singleton+  | ShSingR TVal Val TVal        -- 2 and the right is a singleton+  | ShNone+    deriving (Eq, Ord)++data SortShape+  = ShSortC Class              -- same sort constant+  | ShSet   (OneOrTwo Val)     -- Set i and Set j+  | ShCoSet (OneOrTwo Val)     -- CoSet i and CoSet j+    deriving (Eq, Ord)++shSize = ShSort (ShSortC Size)++-- typeView does not normalize!+typeView :: TVal -> TypeShape+typeView tv =+  case tv of+    VQuant pisig x dom fv        -> ShQuant pisig (One x) (One dom) (One fv)+    VBelow{}                     -> shSize+    VSort s                      -> ShSort (sortView s)+    VSing v tv                   -> ShSing v tv+    VApp (VDef (DefId DatK n)) vs -> ShData n (One tv)+    VApp (VDef (DefId FunK n)) vs -> ShNe (One tv)  -- stuck fun+    VApp (VGen i) vs             -> ShNe (One tv)  -- type variable+    VGen i                       -> ShNe (One tv)  -- type variable+    VCase{}                      -> ShNe (One tv)  -- stuck case+    _                            -> ShNone -- error $ "typeView " ++ show tv++sortView :: Sort Val -> SortShape+sortView s =+  case s of+    SortC c -> ShSortC c+    Set   v -> ShSet   (One v)+    CoSet v -> ShCoSet (One v)++typeView12 :: (Functor m, Error e, MonadError e m) => OneOrTwo TVal -> m TypeShape+-- typeView12 :: OneOrTwo TVal -> TypeCheck TypeShape+typeView12 (One tv) = return $ typeView tv+typeView12 (Two tv1 tv2) =+  case (tv1, tv2) of+    (VQuant pisig1 x1 dom1 fv1, VQuant pisig2 x2 dom2 fv2)+      | pisig1 == pisig2 && erased (decor dom1) == erased (decor dom2) ->+        return $ ShQuant pisig1 (Two x1 x2) (Two dom1 dom2) (Two fv1 fv2)+    (VSort s1, VSort s2) -> ShSort <$> sortView12 (Two s1 s2)+    (VSing v tv, _)      -> return $ ShSingL v tv tv2+    (_, VSing v tv)      -> return $ ShSingR tv1 v tv+    _ -> case (typeView tv1, typeView tv2) of+           (ShSort s1, ShSort s2) | s1 == s2 -> return $ ShSort $ s1+           (ShData n1 _, ShData n2 _) | n1 == n2 -> return $ ShData n1 (Two tv1 tv2)+           (ShNe{}     , ShNe{}     )            -> return $ ShNe (Two tv1 tv2)+           _ -> throwError $ strMsg $ "type " ++ show tv1 ++ " has different shape than " ++ show tv2++sortView12 :: (Monad m) => OneOrTwo (Sort Val) -> m SortShape+sortView12 (One s) = return $ sortView s+sortView12 (Two s1 s2) =+  case (s1, s2) of+    (SortC c1, SortC c2) | c1 == c2 -> return $ ShSortC c1+    (Set v1, Set v2)                -> return $ ShSet (Two v1 v2)+    (CoSet v1, CoSet v2)            -> return $ ShCoSet (Two v1 v2)+    _ -> fail $ "sort " ++ show s1 ++ " has different shape than " ++ show s2++whnf12 :: OneOrTwo Env -> OneOrTwo Expr -> TypeCheck (OneOrTwo Val)+whnf12 env12 e12 = Traversable.traverse id $ zipWith12 whnf env12 e12++app12 ::  OneOrTwo Val -> OneOrTwo Val -> TypeCheck (OneOrTwo Val)+app12 fv12 v12 = Traversable.traverse id $ zipWith12 app fv12 v12++-- if m12 = Nothing, we are checking subtyping, otherwise we are+-- comparing objects or higher-kinded types+-- if two types are given (heterogeneous equality), they need to be+-- of the same shape, otherwise they cannot contain common terms+leqVal' :: Force -> Pol -> MT12 -> Val -> Val -> TypeCheck ()+leqVal' f p mt12 u1' u2' = local (\ cxt -> cxt { consistencyCheck = False }) $ do+ -- 2013-03-30 During subtyping, it is fine to add any size hypotheses.+ l <- getLen+ ren <- getRen+ enterDoc (case mt12 of+  Nothing -> -- text ("leqVal' (subtyping) " ++ show  (Map.toList $ ren) ++ " |-")+             text "leqVal' (subtyping) "+             <+> prettyTCM u1' <+> text (" <=" ++ show p ++ " ")+             <+> prettyTCM u2'+  Just (One tv) -> -- text ("leqVal' " ++ show  (Map.toList $ ren) ++ " |-")+             text "leqVal' "+             <+> prettyTCM u1' <+> text (" <=" ++ show p ++ " ")+             <+> prettyTCM u2' <+> colon+             <+> prettyTCM tv+  Just (Two tv1 tv2) -> -- text ("leqVal' " ++ show  (Map.toList $ ren) ++ " |-")+             text "leqVal' "+             <+> prettyTCM u1' <+> colon+             <+> prettyTCM tv1 <+> text (" <=" ++ show p ++ " ")+             <+> prettyTCM u2' <+> colon+             <+> prettyTCM tv2) $ do+{-+    ce <- ask+    trace  (("rewrites: " +?+ show (rewrites ce)) ++ "  leqVal': " ++ show ce ++ "\n |- " ++ show u1' ++ "\n  <=" ++ show p ++ "  " ++ show u2') $+-}+    mt12f <- mapM (mapM force) mt12 -- leads to LOOP, see HungryEta.ma+    sh12 <- case mt12f of+              Nothing -> return Nothing+              Just tv12 -> case typeView12 tv12 of+                Right sh -> return $ Just sh+                Left err -> (recoverFail err) >> return Nothing+    case sh12 of++      -- subtyping directed by common type shape++      Just (ShSing{}) -> return () -- two terms are equal at singleton type!+      Just (ShSingL v1 tv1' tv2) -> leqVal' f p (Just (Two tv1' tv2)) v1 u2'+      Just (ShSingR tv1 v2 tv2') -> leqVal' f p (Just (Two tv1 tv2')) u1' v2+      Just (ShSort (ShSortC Size)) -> leqSize p u1' u2'++{-  functions are compared pointwise++   Gamma, p(x:A) |- t x : B  <=  Gamma', p'(x:A') |- t' x : B'+   ----------------------------------------------------------+   Gamma |- t : p(x:A) -> B  <=  Gamma' |- t' : p'(x:A') -> B'+-}+      Just (ShQuant Pi x12 dom12 fv12) -> do+         x <- do+           let x = name12 x12+           if null (suggestion x) then do+             case (u1', u2') of+               (VLam x _ _, _) -> return x+               (_, VLam x _ _) -> return x+               _ -> return x+            else return x+         newVar x dom12 $ \ _ xv12 -> do+            u1' <- app u1' (first12  xv12)+            u2' <- app u2' (second12 xv12)+            tv12 <- app12 fv12 xv12+            leqVal' f p (Just tv12) u1' u2'+{-+      Just (VPi x1 dom1 env1 b1, VPi x2 dom2 env2 b2)  ->+         new2 x1 (dom1, dom2) $ \ (xv1, xv2) -> do+            u1' <- app u1' xv1+            u2' <- app u2' xv2+            tv1' <- whnf (update env1 x1 xv1) b1+            tv2' <- whnf (update env2 x2 xv2) b2+            leqVal' f p (Just (tv1', tv2')) u1' u2'+-}+++      -- structural subtyping (not directed by types)++      _ -> do+       u1 <- reduce =<< whnfClos u1'+       u2 <- reduce =<< whnfClos u2'++       let tryForcing fallback = do+            (f1,u1f) <- force' False u1+            (f2,u2f) <- force' False u2+            case (f1,f2) of -- (u1f /= u1,u2f /= u2) of++              (True,False) | f /= R -> -- only unroll one side+                 enter ("forcing LHS") $+                           leqVal' L p mt12 u1f u2+              (False,True) | f /= L ->+                 enter ("forcing RHS") $+                           leqVal' R p mt12 u1 u2f+              _ -> -- enter ("not forcing " ++ show (f1,f2,f)) $+                     fallback++           leqCons n1 vl1 n2 vl2 = do+                 unless (n1 == n2) $+                  recoverFail $+                    "leqVal': head mismatch "  ++ show u1 ++ " != " ++ show u2+                 case mt12 of+                   Nothing -> recoverFail $ "leqVal': cannot compare constructor terms without type"+                   Just tv12 -> do+                     ct12 <- Traversable.mapM (conType n1) tv12+                     leqVals' f p ct12 vl1 vl2+                     return ()+{-+       leqStructural u1 u2 where+          leqStructural u1 u2 =+-}+       case (u1,u2) of++{-+  C = C'  (proper: C' entails C, but I do not want to implement entailment)+  Gamma, C |- A  <=  Gamma', C' |- A'+  -----------------------------------------+  Gamma |- C ==> A  <=  Gamma' |- C' ==> A'+-}+              (VGuard beta1 bv1, VGuard beta2 bv2) -> do+                 entailsGuard (switch p) beta1 beta2+                 leqVal' f p Nothing bv1 bv2++              (VGuard beta u1, u2) | p `elem` [Neg,Pos] ->+                addOrCheckGuard (switch p) beta $+                  leqVal' f p Nothing u1 u2++              (u1, VGuard beta u2) | p `elem` [Neg,Pos] ->+                addOrCheckGuard p beta $+                  leqVal' f p Nothing u1 u2+ {-+  p' <= p+  Gamma' |- A' <= Gamma |- A+  Gamma, p(x:A) |- B <= Gamma', p'(x:A') |- B'+  ---------------------------------------------------------+  Gamma |- p(x:A) -> B : s <= Gamma' |- p'(x:A') -> B' : s'+-}+              (VQuant piSig1 x1 dom1@(Domain av1 _ dec1) fv1,+               VQuant piSig2 x2 dom2@(Domain av2 _ dec2) fv2) -> do+                 let p' = if piSig1 == Pi then switch p else p+                 if piSig1 /= piSig2 || not (leqDec p' dec1 dec2) then+                    recoverFailDoc $ text "subtyping" <+> prettyTCM u1 <+> text (" <=" ++ show p ++ " ") <+> prettyTCM u2 <+> text "failed"+                  else do+                    leqVal' (switch f) p' Nothing av1 av2+                    -- take smaller domain+                    let dom = if (p' == Neg) then dom2 else dom1+                    let x = bestName $ if p' == Neg then [x2,x1] else [x1,x2]+                    new x dom $ \ xv -> do+                      bv1 <- app fv1 xv+                      bv2 <- app fv2 xv+                      enterDoc (text "comparing codomain" <+> prettyTCM bv1 <+> text "with" <+> prettyTCM bv2) $+                        leqVal' f p Nothing bv1 bv2++              (VSing v1 av1, VSing v2 av2) -> do+                  leqVal' f p Nothing av1 av2+                  leqVal' N mixed (Just (Two av1 av2)) v1 v2  -- compare for eq.++              (VSing v1 av1, VBelow ltle v2) | av1 == vSize && p == Pos -> do+                 v1 <- whnfClos v1+                 leSize ltle p v1 v2++{- 2012-01-28 now vSize is VBelow Le Infty++              -- extra cases since vSize is not implemented as VBelow Le Infty+              (u1,u2) | isVSize u1 && isVSize u2 -> return ()+              (VSort (SortC Size), VBelow{}) -> leqStructural (VBelow Le VInfty) u2+              (VBelow{}, VSort (SortC Size)) -> leqStructural u1 (VBelow Le VInfty)+-}+              -- care needed to not make <=# a subtype of <#+              (VBelow ltle1 v1, VBelow ltle2 v2) ->+                case (p, ltle1, ltle2) of+                  _ | ltle1 == ltle2 -> leSize Le p v1 v2+                  (Neg, Le, Lt) -> leSize Le p (vSucc v1) v2+                  (Neg, Lt, Le) -> leSize Lt p v1 v2  -- careful here+                  (p  , Lt, Le) -> leSize Le p v1 (vSucc v2)+                  (p  , Le, Lt) -> leSize Lt p v1 v2  -- careful here++              -- unresolved eta-expansions (e.g. at coinductive type)+              (VUp v1 av1, VUp v2 av2) -> do+                  -- leqVal' f p Nothing av1 av2      -- do not compare types+                  leqVal' f p (Just (Two av1 av2)) v1 v2  -- OR: Just(tv1,tv2) ?+              (VUp v1 av1, u2) -> leqVal' f p mt12 v1 u2+              (u1, VUp v2 av2) -> leqVal' f p mt12 u1 v2++              (VRecord (NamedRec _ n1 _ _) rs1, VRecord (NamedRec _ n2 _ _) rs2) ->+                 leqCons n1 (map snd rs1) n2 (map snd rs2)++{-+              -- the following three cases should be impossible+              -- but aren't.  I gave up on this bug -- 2012-01-25+              -- FOUND IT++              (VRecord (NamedRec _ n1 _) rs1,+               VApp v2@(VDef (DefId (ConK _) n2)) vl2) -> leqCons n1 (map snd rs1) n2 vl2++              (VApp v1@(VDef (DefId (ConK _) n1)) vl1,+               VRecord (NamedRec _ n2 _) rs2) -> leqCons n1 vl1 n2 (map snd rs2)++              (VApp v1@(VDef (DefId (ConK _) n1)) vl1,+               VApp v2@(VDef (DefId (ConK _) n2)) vl2) -> leqCons n1 vl1 n2 vl2+-}++              -- smart equality is not transitive+              (VCase v1 tv1 env1 cl1, VCase v2 tv2 env2 cl2) -> do+                 leqVal' f p (Just (Two tv1 tv2)) v1 v2 -- FIXED: do not have type here, but v1,v2 are neutral+                 leqClauses f p mt12 v1 tv1 env1 cl1 env2 cl2++{- REMOVED, NOT TRANSITIVE+              (VCase v env cl, v2) -> leqCases (switch f) (switch p) (switch mt12) v2 v env cl+              (v1, VCase v env cl) -> leqCases f p mt12 v1 v env cl+-}+              (VSing v1 av1, av2)  -> leqVal' f p Nothing av1 av2  -- subtyping ax+              (VSort s1, VSort s2) -> leqSort p s1 s2+              (a1,a2) | a1 == a2 -> return ()+              (u1,u2) -> tryForcing $+                case (u1,u2) of+                  (VApp v1 vl1, VApp v2 vl2) -> leqApp f p v1 vl1 v2 vl2+                  (VApp v1 vl1, u2) -> leqApp f p v1 vl1 u2 []+                  (u1, VApp v2 vl2) -> leqApp f p u1 []  v2 vl2+                  _ -> leqApp f p u1 [] u2 []++leqClauses :: Force -> Pol -> MT12 -> Val -> TVal -> Env -> [Clause] -> Env -> [Clause] -> TypeCheck ()+leqClauses f pol mt12 v tvp env1 cls1 env2 cls2 = loop cls1 cls2 where+  loop cls1 cls2 = case (cls1,cls2) of+    ([],[]) -> return ()+    (Clause _ [p1] mrhs1 : cls1', Clause _ [p2] mrhs2 : cls2') -> do+      ns <- flip execStateT [] $ alphaPattern p1 p2+      case (mrhs1, mrhs2) of+        (Nothing, Nothing) -> return ()+        (Just e1, Just e2) -> do+            let tv = maybe vTopSort first12 mt12+            let tv012 = maybe [] toList12 mt12+            addPattern (tvp `arrow` tv) p2 env2 $ \ _ pv env2' ->+              addRewrite (Rewrite v pv) tv012 $ \ tv012 -> do+                let env1' = env2' { envMap = compAssoc ns (envMap env2') }+                v1  <- whnf (appendEnv env1' env1) e1+                v2  <- whnf (appendEnv env2' env2) e2+                leqVal' f pol (toMaybe12 tv012) v1 v2+            loop cls1' cls2'+{-+-- naive implementation for now+leqClauses :: Force -> Pol -> MT12 -> Val -> TVal -> Env -> [Clause] -> Env -> [Clause] -> TypeCheck ()+leqClauses f pol mt12 v tvp env1 cls1 env2 cls2 = loop cls1 cls2 where+  loop cls1 cls2 = case (cls1,cls2) of+    ([],[]) -> return ()+    (Clause _ [p1] mrhs1 : cls1', Clause _ [p2] mrhs2 : cls2') -> do+      eqPattern p1 p2+      case (mrhs1, mrhs2) of+        (Nothing, Nothing) -> return ()+        (Just e1, Just e2) -> do+            let tv = maybe vTopSort first12 mt12+            let tv012 = maybe [] toList12 mt12+            addPattern (tvp `arrow` tv) p1 env1 $ \ _ pv env' ->+              addRewrite (Rewrite v pv) tv012 $ \ tv012 -> do+                v1  <- whnf (appendEnv env' env1) e1+                v2  <- whnf (appendEnv env' env2) e2+                leqVal' f pol (toMaybe12 tv012) v1 v2+            loop cls1' cls2'++eqPattern :: Pattern -> Pattern -> TypeCheck ()+eqPattern p1 p2 = if p1 == p2 then return () else fail $ "pattern " ++ show p1 ++ " != " ++ show p2+-}++type NameMap = [(Name,Name)]++alphaPattern :: Pattern -> Pattern -> StateT NameMap TypeCheck ()+alphaPattern p1 p2 = do+  let failure = fail $ "pattern " ++ show p1 ++ " != " ++ show p2+      alpha x1 x2 = do+        ns <- get+        case lookup x1 ns of+          Nothing -> put $ (x1,x2) : ns+          Just x2' | x2 == x2' -> return ()+                   | otherwise -> failure+  case (p1,p2) of+    (VarP x1, VarP x2) -> alpha x1 x2+    (ConP pi1 n1 ps1, ConP pi2 n2 ps2) | pi1 == pi2 && n1 == n2 ->+      zipWithM_ alphaPattern ps1 ps2+    (SuccP p1, SuccP p2) -> alphaPattern p1 p2+    (SizeP _ x1, SizeP _ x2) -> alpha x1 x2+    (PairP p11 p12, PairP p21 p22) -> do+      alphaPattern p11 p21+      alphaPattern p12 p22+    (ProjP n1, ProjP n2) -> unless (n1 == n2) failure+    (DotP _, DotP _) -> return ()+    (AbsurdP, AbsurdP) -> return ()+    (ErasedP p1, ErasedP p2) -> alphaPattern p1 p2+    (UnusableP p1, UnusableP p2) -> alphaPattern p1 p2+    _ -> failure++-- leqCases f p tv1 v1 v tv env cl+-- checks whether  v1 <=p (VCase v tv env cl) : tv1+leqCases :: Force -> Pol -> MT12 -> Val -> Val -> TVal -> Env -> [Clause] -> TypeCheck ()+leqCases f pol mt12 v1 v tvp env cl = do+  vcase <- evalCase v tvp env cl+  case vcase of+    (VCase v tvp env cl) -> mapM_ (leqCase f pol mt12 v1 v tvp env) cl+    v2 -> leqVal' f pol mt12 v1 v2++-- absurd cases need not be checked+leqCase :: Force -> Pol -> MT12 -> Val -> Val -> TVal -> Env -> Clause -> TypeCheck ()+leqCase f pol mt12 v1 v tvp env (Clause _ [p] Nothing) = return ()+leqCase f pol mt12 v1 v tvp env (Clause _ [p] (Just e)) = enterDoc (text "leqCase" <+> prettyTCM v <+> text " --> " <+> text (show p ++ "  |- ") <+> prettyTCM v1 <+> text (" <=" ++ show pol ++ " ") <+> prettyTCM (VClos env e)) $ do    -- ++ "  :  " ++ show mt12) $+-- the dot patterns inside p are only valid in environment env+  let tv = case mt12 of+             Nothing -> vTopSort+             Just tv12 -> second12 tv12+  addPattern (tvp `arrow` tv) p env $ \ _ pv env' ->+    addRewrite (Rewrite v pv) [tv,v1] $ \ [tv',v1'] -> do+      v2  <- whnf (appendEnv env' env) e+      v2' <- reval v2 -- 2010-09-10, WHY?+      let mt12' = fmap (mapSecond12 (const tv')) mt12+      leqVal' f pol mt12' v1' v2'++-- compare spines (see rule Al-App-Ne, Abel, MSCS 08)+-- q ::= mixed | Pos | Neg+leqVals' :: Force -> Pol -> OneOrTwo TVal -> [Val] -> [Val] -> TypeCheck (OneOrTwo TVal)+leqVals' f q tv12 vl1 vl2 = do+  sh12 <- typeView12 =<< mapM force tv12+  case (vl1, vl2, sh12) of++    ([], [], _) -> return tv12++    (VProj Post p1 : vs1, VProj Post p2 : vs2, ShData d _) -> do+      unless (p1 == p2) $+        recoverFailDoc $ text "projections"+          <+> prettyTCM p1 <+> text "and"+          <+> prettyTCM p2 <+> text "differ!"+        -- recoverFail $ "projections " ++ show p1 ++ " and " ++ show p2 ++ " differ!"+      tv12 <- mapM (\ tv -> projectType tv p1 VIrr) tv12+      leqVals' f q tv12 vs1 vs2++    (w1:vs1, w2:vs2, ShQuant Pi x12 dom12 fv12) -> do+      let p = oneOrTwo id polAnd (fmap (polarity . decor) dom12)+      let dec = Dec p -- WAS: , erased = erased $ decor $ first12 dom12 }+      v1 <- whnfClos w1+      v2 <- whnfClos w2+      tv12 <- do+        if erased p -- WAS: (erased dec || p == Pol.Const)+         -- we have skipped an argument, so proceed with two types!+         then app12 (toTwo fv12) (Two v1 v2)+         else do+           let q' = polComp p q+           applyDec dec $+             leqVal' f q' (Just $ fmap typ dom12) v1 v2+           -- we have not skipped comparison, so proceed (1/2) as we came in+           case fv12 of+             Two{}  -> app12 fv12 (Two v1 v2)+             One fv -> One <$> app fv v1+               -- type is invariant, so it does not matter which one we take+      leqVals' f q tv12 vs1 vs2++    _ -> failDoc $ text "leqVals': not (compatible) function types or mismatch number of arguments when comparing "+           <+> prettyTCM vl1 <+> text " to "+           <+> prettyTCM vl2 <+> text " at type "+           <+> prettyTCM tv12+--    _ -> fail $ "leqVals': not (compatible) function types or mismatch number of arguments when comparing  " ++ show vl1 ++ "  to  " ++ show vl2 ++ "  at type  " ++ show tv12++{-+leqVals' f q (VPi x1 dom1@(Domain av1 _ dec1) env1 b1,+              VPi x2 dom2@(Domain av2 _ dec2) env2 b2)+         (w1:vs1) (w2:vs2) | dec1 == dec2 = do+  let p = polarity dec1+  v1 <- whnfClos w1+  v2 <- whnfClos w2+  when (not (erased dec1)) $+    applyDec dec1 $ leqVal' f (polComp p q) (Just (av1,av2)) v1 v2+  tv1 <- whnf (update env1 x1 v1) b1+  tv2 <- whnf (update env2 x2 v2) b2+  leqVals' f q (tv1,tv2) vs1 vs2+-}++{-+leqNe :: Force -> Val -> Val -> TypeCheck TVal+leqNe f v1 v2 = --trace ("leqNe " ++ show v1 ++ "<=" ++ show v2) $+  do case (v1,v2) of+      (VGen k1, VGen k2) -> if k1 == k2 then do+                                 dom <- lookupGem k1+                                 return $ typ dom+                               else throwErrorMsg $ "gen mismatch "  ++ show k1 ++ " " ++ show k2+-}++-- leqApp f pol v1 vs1 v2 vs2    checks   v1 vs1 <=pol v2 vs2+-- pol ::= Param | Pos | Neg+leqApp :: Force -> Pol -> Val -> [Val] -> Val -> [Val] -> TypeCheck ()+leqApp f pol v1 w1 v2 w2 = {- trace ("leqApp: " -- ++ show delta ++ " |- "+                                  ++ show v1 ++ show w1 ++ " <=" ++ show pol ++ " " ++ show v2 ++ show w2) $ -}+{-+  do let headMismatch = recoverFail $+            "leqApp: head mismatch "  ++ show v1 ++ " != " ++ show v2+-}+  do let headMismatch = recoverFailDoc $ text "leqApp: head mismatch"+           <+> prettyTCM v1 <+> text "!=" <+> prettyTCM v2+     let emptyOrUnit u1 u2 =+          unlessM (isEmptyType u1) $ unlessM (isUnitType u2) $ headMismatch+     case (v1,v2) of+{-  IMPOSSIBLE:+      (VApp v1 [], v2) -> leqApp f pol v1 w1 v2 w2+      (v1, VApp v2 []) -> leqApp f pol v1 w1 v2 w2+-}+{-+      (VApp{}, _)    -> throwErrorMsg $ "leqApp: internal error: hit application v1 = " ++ show v1+      (_, VApp{})    -> throwErrorMsg $ "leqApp: internal error: hit application v2 = " ++ show v2+-}++      (VUp v1 _, v2) -> leqApp f pol v1 w1 v2 w2+      (v1, VUp v2 _) -> leqApp f pol v1 w1 v2 w2++      (VGen k1, VGen k2) | k1 == k2 -> do+        tv12 <- (fmap typ . domain) <$> lookupGen k1+        leqVals' f pol tv12 w1 w2+        return ()+{-+      (VGen k1, VGen k2) ->+        if k1 /= k2+          then headMismatch+          else do tv12 <- (fmap typ . domain) <$> lookupGen k1+                  leqVals' f pol tv12 w1 w2+                  return ()+-}+{-+      (VCon _ n, VCon _ m) ->+        if n /= m+         then throwErrorMsg $+            "leqApp: head mismatch "  ++ show v1 ++ " != " ++ show v2+         else do+          sige <- lookupSymb n+          case sige of+            (ConSig tv) -> -- constructor+               leqVals' f tv (repeat mixed) w1 w2 >> return ()+-}++      (VDef n, VDef m) | n == m ->  do+        tv <- lookupSymbTypQ (idName n)+        leqVals' f pol (One tv) w1 w2+        return ()++      -- check for least or greatest type++      (u1,u2) -> if pol == Pos then emptyOrUnit u1 u2 else+                 if pol == Neg then emptyOrUnit u2 u1 else headMismatch++{-+      -- least type+      (VDef (DefId DatK n), v2) | pol == Pos ->+        ifM (isEmptyData n) (return ()) headMismatch+      (v1, VDef (DefId DatK n)) | pol == Neg ->+        ifM (isEmptyData n) (return ()) headMismatch+-}+{-+      (VDef n, VDef m) ->+        if (name n) /= (name m) then do+           bot <- if pol==Neg then isEmptyData $ name m else+                  if pol==Pos then isEmptyData $ name n else return False+           if bot then return () else headMismatch+         else do+           tv <- lookupSymbTyp (name n)+           leqVals' f pol (One tv) w1 w2+           return ()+-}+{-+          sig <- gets signature+          case lookupSig (name n) sig of+            (DataSig{ numPars = p, positivity = pos, isSized = s, isCo = co, symbTyp = tv }) -> -- data type+               let positivitySizeIndex = if s /= Sized then mixed else+                                           if co == Ind then Pos else Neg+                   pos' = -- trace ("leqApp:  posOrig = " ++ show (pos ++ [positivitySizeIndex])) $+                     map (polComp pol) (pos ++ positivitySizeIndex : repeat mixed) -- the polComp will replace all SPos by Pos+               in leqVals' f tv pos' w1 w2+                    >> return ()++-- otherwise, we are dealing with a (co) recursive function or a constructor+            entry -> leqVals' f (symbTyp entry) (repeat mixed) w1 w2 >> return ()+-}++{-+      _ -> headMismatch++      _ -> recoverFail $ "leqApp: " ++ show v1 ++ show w1 ++ " !<=" ++ show pol ++ " " ++ show v2 ++ show w2+-}++isEmptyType :: TVal -> TypeCheck Bool+isEmptyType (VDef (DefId DatK n)) = isEmptyData n+isEmptyType _ = return False++isUnitType :: TVal -> TypeCheck Bool+isUnitType (VDef (DefId DatK n)) = isUnitData n+isUnitType _ = return False++-- comparing sorts and sizes -----------------------------------------++leqSort :: Pol -> Sort Val -> Sort Val -> TypeCheck ()+leqSort p = relPolM p leqSort'+{-+leqSort mixed s1 s2 = leqSort' s1 s2 >> leqSort' s2 s1+leqSort Neg s1 s2 = leqSort' s2 s1+leqSort Pos s1 s2 = leqSort' s1 s2+-}++leqSort' :: Sort Val -> Sort Val -> TypeCheck ()+leqSort' s1 s2 = do+--  let err = "universe test " ++ show s1 ++ " <= " ++ show s2 ++ " failed"+  let err = text "universe test"+            <+> prettyTCM s1 <+> text "<="+            <+> prettyTCM s2 <+> text "failed"+  case (s1,s2) of+     (_            , Set VInfty)         -> return ()+     (SortC c      , SortC c') | c == c' -> return ()+     (Set v1       , Set v2)             -> leqSize Pos v1 v2+     (CoSet VInfty , Set v)              -> return ()+     (Set VZero    , CoSet{})            -> return ()+     (CoSet v1     , CoSet v2)           -> leqSize Neg v1 v2+     _ -> recoverFailDoc err++minSize :: Val -> Val -> Maybe Val+minSize v1 v2 =+  case (v1,v2) of+    (VZero,_)  -> return VZero+    (_,VZero)  -> return VZero+    (VInfty,_) -> return v2+    (_,VInfty) -> return v1+    (VMax vs,_) -> maxMins $ map (\ v -> minSize v v2) vs+    (_,VMax vs) -> maxMins $ map (\ v -> minSize v1 v) vs+    (VSucc v1', VSucc v2') -> fmap succSize $ minSize v1' v2'+    (VGen i, VGen j) -> if i == j then return $ VGen i else Nothing+    (VSucc v1', VGen j) -> minSize v1' v2+    (VGen i, VSucc v2') -> minSize v1 v2'++maxMins :: [Maybe Val] -> Maybe Val+maxMins mvs = case compressMaybes mvs of+                     [] -> Nothing+                     vs' -> return $ maxSize vs'++-- substaging on size values+leqSize :: Pol -> Val -> Val -> TypeCheck ()+leqSize = leSize Le++ltSize :: Val -> Val -> TypeCheck ()+ltSize = leSize Lt Pos++leSize :: LtLe -> Pol -> Val -> Val -> TypeCheck ()+leSize ltle pol v1 v2 = enterDoc (text "leSize"+      <+> prettyTCM v1 <+> text (show ltle ++ show pol)+      <+> prettyTCM v2) $+-- enter ("leSize " ++ show v1 ++ " " ++ show ltle ++ show pol ++ " " ++ show v2) $+    traceSize ("leSize " ++ show v1 ++ " " ++ show ltle ++ show pol ++ " " ++ show v2) $+    do case (v1,v2) of+         _ | v1 == v2 && ltle == Le -> return () -- TODO: better handling of sums!+         (VSucc v1,VSucc v2) -> leSize ltle pol v1 v2+{-+         (VGen i1,VGen i2) -> do+           d <- getSizeDiff i1 i2 -- check size relation from constraints+           case d of+             Nothing -> recoverFail $ "leqSize: head mismatch: " ++ show v1 ++ " !<= " ++ show v2+             Just k -> case (pol,k) of+               (_, 0) | pol == mixed -> return ()+               (Pos, _) | k >= 0 -> return ()+               (Neg, _) | k <= 0 -> return ()+               _ ->  recoverFail $ "leqSize: " ++ show v1 ++ " !<=" ++ show pol ++ " " ++ show v2 ++ " failed"+-}+{-+           if v1 == v2 then return ()+           else throwErrorMsg $ "leqSize: head mismatch: " ++ show v1 ++ " !<= " ++ show v2+-}+         (VInfty,VInfty) | ltle == Le -> return ()+                         | otherwise -> recoverFail "leSize: # < # failed"+         (VApp h1 tl1,VApp h2 tl2) -> leqApp N pol h1 tl1 h2 tl2+         _ -> relPolM pol (leSize' ltle) v1 v2++leqSize' :: Val -> Val -> TypeCheck ()+leqSize' = leSize' Le++leSize' :: LtLe -> Val -> Val -> TypeCheck ()+leSize' ltle v1 v2 = -- enter ("leSize' " ++ show v1 ++ " " ++ show ltle ++ " " ++ show v2) $+  enterDoc (text "leSize'" <+> prettyTCM v1 <+> text (show ltle) <+> prettyTCM v2) $+    traceSize ("leSize' " ++ show v1 ++ " " ++ show ltle ++ " " ++ show v2) $+    do let failure = recoverFailDoc $ text "leSize':"+             <+> prettyTCM v1 <+> text (show ltle)+             <+> prettyTCM v2 <+> text "failed"+           -- err = "leSize': " ++ show v1 ++ " " ++ show ltle ++ " " ++ show v2 ++ " failed"+       case (v1,v2) of+         (VZero,_) | ltle == Le -> return ()+         (VSucc{}, VZero) -> failure+         (VInfty, VZero) -> failure+         (VGen{}, VZero) -> failure+         (VMax vs,_) -> mapM_ (\ v -> leSize' ltle v v2) vs -- all v in vs <= v2+         (_,VMax vs)  -> foldr1 orM $ map (leSize' ltle v1) vs -- this produces a disjunction+--         (_,VMax _)  -> addLe ltle v1 v2 -- this produces a disjunction+         (_,VInfty) | ltle == Le -> return ()+         (VZero, VInfty) -> return ()+         (VMeta{},VZero) -> addLe ltle v1 v2+{-+         (0,VMeta i n', VMeta j m') ->+           let (n,m) = if bal <= 0 then (n', m' - bal) else (n' + bal, m') in+-}+         (VMeta i rho n, VMeta j rho' m) ->+               addLe ltle (VMeta i rho  (n - min n m))+                        (VMeta j rho' (m - min n m))+         (VMeta i rho n, VSucc v2) | n > 0 -> leSize' ltle (VMeta i rho (n-1)) v2+         (VMeta i rho n, v2)  -> addLe ltle v1 v2+         (VSucc v1, VMeta i rho n) | n > 0 -> leSize' ltle v1 (VMeta i rho (n-1))+         (v1,VMeta i rho n) -> addLe ltle v1 v2+         _ -> leSize'' ltle 0 v1 v2+{- HANDLED BY leSize'' ltle+         (VSucc{}, VGen{}) -> fail err+         (VSucc{}, VPlus{}) -> fail err+-}+-- leSize'' ltle bal v v'  checks whether  Succ^bal v `lt` v'+-- invariant: bal is zero in cases for VMax and VMeta+leSize'' :: LtLe -> Int -> Val -> Val -> TypeCheck ()+leSize'' ltle bal v1 v2 = traceSize ("leSize'' " ++ show v1 ++ " + " ++ show bal ++ " " ++ show ltle ++ " " ++ show v2) $+    do let failure = recoverFailDoc (text "leSize'':" <+> prettyTCM v1 <+> text ("+ " ++ show bal) <+> text (show ltle) <+> prettyTCM v2 <+> text "failed")+           check mb = ifM mb (return ()) failure+           ltlez = case ltle of { Le -> 0 ; Lt -> -1 }+       case (v1,v2) of+#ifdef STRICTINFTY+-- Only cancel variables < #+         _ | v1 == v2 && ltle == Le && bal <= 0 -> return ()+         (VGen i, VGen j) | i == j && bal <= -1 -> check $ isBelowInfty i+#else+-- Allow cancelling of all variables+         _ | v1 == v2 && bal <= ltlez -> return () -- TODO: better handling of sums!+#endif+         (VGen i, VInfty) | ltle == Lt -> check $ isBelowInfty i+         (VZero,_) | bal <= ltlez -> return ()+         (VZero,VInfty) -> return ()+         (VZero,VGen _) | bal > ltlez -> recoverFailDoc $ text "0 not <" <+> prettyTCM v2+         (VSucc v1, v2) -> leSize'' ltle (bal + 1) v1 v2+         (v1, VSucc v2) -> leSize'' ltle (bal - 1) v1 v2+         (VPlus vs1, VPlus vs2) -> leSizePlus ltle bal vs1 vs2+         (VPlus vs1, VZero) -> leSizePlus ltle bal vs1 []+         (VZero, VPlus vs2) -> leSizePlus ltle bal [] vs2+         (VPlus vs1, _) -> leSizePlus ltle bal vs1 [v2]+         (_, VPlus vs2) -> leSizePlus ltle bal [v1] vs2+         (VZero,_) -> leSizePlus ltle bal [] [v2]+         (_,VZero) -> leSizePlus ltle bal [v1] []+         _ -> leSizePlus ltle bal [v1] [v2]++#if (defined STRICTINFTY)+{-  2012-02-06 this modification cancels only variables < #+    However, omega-instantiation is valid [i < #] -> F i subseteq F #+    because every chain has a limit at #.+-}+leSizePlus :: LtLe -> Int -> [Val] -> [Val] -> TypeCheck ()+leSizePlus Lt bal vs1 vs2 = do+  vs2' <- filterM varBelowInfty vs2+  vs1' <- filterM varBelowInfty vs1+  leSizePlus' Lt bal (vs1 List.\\ vs2') (vs2 List.\\ vs1')+leSizePlus Le bal vs1 vs2 =+  leSizePlus' Le bal (vs1 List.\\ vs2) (vs2 List.\\ vs1)+#else+leSizePlus :: LtLe -> Int -> [Val] -> [Val] -> TypeCheck ()+leSizePlus ltle bal vs1 vs2 =+  leSizePlus' ltle bal (vs1 List.\\ vs2) (vs2 List.\\ vs1)+#endif+++varBelowInfty :: Val -> TypeCheck Bool+varBelowInfty (VGen i) = isBelowInfty i+varBelowInfty _        = return False++leSizePlus' :: LtLe -> Int -> [Val] -> [Val] -> TypeCheck ()+leSizePlus' ltle bal vs1 vs2 = do+  let v1 = plusSizes vs1+  let v2 = plusSizes vs2+  let exit True  = return ()+      exit False | bal >= 0  = recoverFailDoc (text "leSize:" <+> prettyTCM v1 <+> text ("+ " ++ show bal ++ " " ++ show ltle) <+> prettyTCM v2 <+> text "failed")+                 | otherwise = recoverFailDoc (text "leSize:" <+> prettyTCM v1 <+> text (show ltle) <+> prettyTCM v2 <+> text ("+ " ++ show (-bal) ++ " failed"))+  traceSizeM ("leSizePlus' ltle " ++ show v1 ++ " + " ++ show bal ++ " " ++ show ltle ++ " " ++ show v2)+  let ltlez = case ltle of { Le -> 0 ; Lt -> -1 }+  case (vs1,vs2) of+    ([],_) | bal <= ltlez -> return ()+    ([],[VGen i]) -> do+      n <- getMinSize i+      -- traceM ("getMinSize = " ++ show n)+      case n of+        Nothing -> exit False -- height of VGen i == 0+        Just n  -> exit (bal <= n + ltlez)+    ([VGen i1],[VGen i2]) -> do+      d <- sizeVarBelow i1 i2+      traceSizeM ("sizeVarBelow " ++ show (i1,i2) ++ " returns " ++ show d)+      case d of+        Nothing -> tryIrregularBound i1 i2 (ltlez - bal)+-- recoverFail $ "leSize: head mismatch: " ++ show v1 ++ " " ++ show ltle ++ " " ++ show v2+        Just k -> exit (bal <= k + ltlez)+    _ -> exit False++-- BAD HACK!+-- check (VGen i1) <= (VGen i2) + k+tryIrregularBound :: Int -> Int -> Int -> TypeCheck ()+tryIrregularBound i1 i2 k = do+  betas <- asks bounds+  let beta = Bound Le (Measure [VGen i1]) (Measure [iterate VSucc (VGen i2) !! k])+  foldl (\ result beta' -> result `orM` entailsGuard Pos beta' beta)+    (recoverFail "bound not entailed")+    betas++{-+leqSize' :: Val -> Val -> TypeCheck ()+leqSize' v1 v2 = --trace ("leqSize' " ++ show v1 ++ show v2) $+    do case (v1,v2) of+         (VMax vs,_) -> mapM_ (\ v -> leqSize' v v2) vs -- all v in vs <= v2+         (_,VMax _)  -> addLeq v1 v2 -- this produces a disjunction+         (VSucc v1,VSucc v2) -> leqSize' v1 v2+         (VGen v1,VGen v2) -> do+           d <- getSizeDiff v1 v2+           case d of+             Nothing -> throwErrorMsg $ "leqSize: head mismatch: " ++ show v1 ++ " !<= " ++ show v2+             Just k -> if k >= 0 then return () else throwErrorMsg $ "leqSize: " ++ show v1 ++ " !<= " ++ show v2 ++ " failed"+         (_,VInfty) -> return ()+         (VMeta i n, VSucc v2) | n > 0 -> leqSize' (VMeta i (n-1)) v2+         (VMeta i n, VMeta j m) -> addLeq (VMeta i (n - min n m))+                                          (VMeta j (m - min n m))+         (VMeta i n, v2) -> addLeq v1 v2+         (VSucc v1, VMeta i n) | n > 0 -> leqSize' v1 (VMeta i (n-1))+         (v1,VMeta i n) -> addLeq v1 v2+         (v1,VSucc v2) -> leqSize' v1 v2+         _ -> throwErrorMsg $ "leqSize: " ++ show v1 ++ " !<= " ++ show v2+-}++-- measures and guards -----------------------------------------------++{-+-- compare lexicographically+-- precondition: same length+ltMeasure :: Measure Val -> Measure Val -> TypeCheck ()+ltMeasure  (Measure mu1) (Measure mu2) =+  -- enter ("checking " ++ show mu1 ++ " < " ++ show mu2) $+    lexSizes Lt mu1 mu2+-}++{-+leqMeasure :: Pol -> Measure Val -> Measure Val -> TypeCheck ()+leqMeasure mixed (Measure mu1) (Measure mu2) = do+  zipWithM (leqSize mixed) mu1 mu2+  return ()+leqMeasure Pos (Measure mu1) (Measure mu2) = lexSizes mu1 mu2+leqMeasure Neg (Measure mu1) (Measure mu2) = lexSizes mu2 mu1+-}++-- lexSizes True  mu mu' checkes mu <  mu'+-- lexSizes False mu mu' checkes mu <= mu'+lexSizes :: LtLe -> [Val] -> [Val] -> TypeCheck ()+lexSizes ltle mu1 mu2 = traceSize ("lexSizes " ++ show (ltle,mu1,mu2)) $+  case (ltle, mu1, mu2) of+    (Lt, [], []) -> recoverFail $ "lexSizes: no descent detected"+    (Le, [], []) -> return ()+    (lt, a1:mu1, a2:mu2) -> do+      b <- newAssertionHandling Failure $ errorToBool $ leSize ltle Pos a1 a2+      case (lt,b) of+        (Le,False) -> recoverFailDoc $ text "lexSizes: expected" <+> prettyTCM a1 <+> text "<=" <+> prettyTCM a2+            -- recoverFail $ "lexSizes: expected " ++ show a1 ++ " <= " ++ show a2+        (Lt,True) -> return ()+        _ -> lexSizes ltle mu1 mu2++{-+      r <- compareSize a1 a2+      case r of+        LT -> return ()+        EQ -> lexSizes ltle mu1 mu2+        GT -> recoverFail $ "lexSizes: expected " ++ show a1 ++ " <= " ++ show a2+-}++{-+-- TODO: reprogram leqSize in terms of a proper compareSize+compareSize :: Val -> Val -> TypeCheck Ordering+compareSize a1 a2 = do+  let ret o = trace ("compareSize: " ++ show a1 ++ " compared to " ++ show a2 ++ " returns " ++ show o) $ return o+  le <- newAssertionHandling Failure $ errorToBool $ leqSize Pos a1 a2+  ge <- newAssertionHandling Failure $ errorToBool $ leqSize Pos a2 a1+  case (le,ge) of+    (True,False) -> ret LT -- THIS IS COMPLETE BOGUS!!!+    (True,True)  -> ret EQ+    (False,True) -> ret GT+    (False,False) -> fail $ "compareSize (" ++ show a1 ++ ", " ++ show a2 ++ "): sizes incomparable"+-}++{- Bound entailment++1. (mu1 <  mu1') ==> (mu2 <  mu2') if mu2 <= mu1 and mu1' <= mu2'+2. (mu1 <= mu1') ==> (mu2 <  mu2') one of these <= strict (<)+3. (mu1 <  mu1') ==> (mu2 <= mu2') as 1.+4. (mu1 <= mu1') ==> (mu2 <= mu2') as 1.++-}+entailsGuard :: Pol -> Bound Val -> Bound Val -> TypeCheck ()+entailsGuard pol beta1@(Bound ltle1 (Measure mu1) (Measure mu1')) beta2@(Bound ltle2 (Measure mu2) (Measure mu2')) = enterDoc (text ("entailsGuard:") <+> prettyTCM beta1 <+> text (show pol ++ "==>") <+> prettyTCM beta2) $ do+  case pol of+    _ | pol == mixed -> do+      assert (ltle1 == ltle2) $ "unequal bound types"+      zipWithM (leqSize mixed) mu1  mu2+      zipWithM (leqSize mixed) mu1' mu2'+      return ()+    Pos | ltle1 == Lt || ltle2 == Le  -> do+      lexSizes Le mu2  mu1  -- not strictly smaller+      lexSizes Le mu1' mu2'+      return ()+    Pos -> do+      (lexSizes Lt mu2  mu1 >> lexSizes Le mu1' mu2')+      `orM`+      (lexSizes Le mu2  mu1 >> lexSizes Lt mu1' mu2')+    Neg   -> entailsGuard (switch pol) beta2 beta1++{-+eqGuard :: Bound Val -> Bound Val -> TypeCheck ()+eqGuard (Bound (Measure mu1) (Measure mu1')) (Bound (Measure mu2) (Measure mu2')) = do+  zipWithM (leqSize mixed) mu1 mu2+  zipWithM (leqSize mixed) mu1' mu2'+  return ()+-}++checkGuard :: Bound Val -> TypeCheck ()+checkGuard beta@(Bound ltle mu mu') =+  enterDoc (text "checkGuard" <+> prettyTCM beta) $+    lexSizes ltle (measure mu) (measure mu')++addOrCheckGuard :: Pol -> Bound Val -> TypeCheck a -> TypeCheck a+addOrCheckGuard Neg beta cont = checkGuard beta >> cont+addOrCheckGuard Pos beta cont = addBoundHyp beta cont++-- comparing polarities -------------------------------------------------++leqPolM :: Pol -> PProd -> TypeCheck ()+leqPolM p (PProd Pol.Const _) = return ()+leqPolM p (PProd q m) | Map.null m && not (isPVar p) =+  if leqPol p q then return ()+   else recoverFail $ "polarity check " ++ show p ++ " <= " ++ show q ++ " failed"+leqPolM p q = do+  traceM $ "adding polarity constraint " ++ show p ++ " <= " ++ show q++leqPolPoly :: Pol -> PPoly -> TypeCheck ()+leqPolPoly p (PPoly l) = mapM_ (leqPolM p) l++-- adding an edge to the positivity graph+addPosEdge :: DefId -> DefId -> PProd -> TypeCheck ()+addPosEdge src tgt p = unless (src == tgt && isSPos p) $ do+  -- traceM ("adding interesting positivity graph edge  " ++ show src ++ " --[ " ++ show p ++ " ]--> " ++ show tgt)+  st <- get+  put $ st { positivityGraph = Arc (Rigid src) (ppoly p) (Rigid tgt) : positivityGraph st }++checkPositivityGraph :: TypeCheck ()+checkPositivityGraph = enter ("checking positivity") $ do+  st <- get+  let cs = positivityGraph st+  let gr = buildGraph cs+  let n  = nextNode gr+  let m0 = mkMatrix n (graph gr)+  let m  = warshall m0+  let isDataId i = case Map.lookup i (intMap gr) of+                     Just (Rigid (DefId DatK _)) -> True+                     _ -> False+  let dataDiag = [ m Array.! (i,i) | i <- [0..n-1], isDataId i ]+  mapM_ (\ x -> leqPolPoly oone x) dataDiag+{-+  let solvable = all (\ x -> leqPol oone x)+  unless solvable $ recoverFail $ "positivity check failed"+-}+  -- TODO: solve constraints+  put $ st { positivityGraph = [] }++-- telescopes --------------------------------------------------------++telView :: TVal -> TypeCheck ([(Val, TBinding TVal)], TVal)+telView tv = do+  case tv of+    VQuant Pi x dom fv -> underAbs_ x dom fv $ \ _ xv bv -> do+      (vTel, core) <- telView bv+      return ((xv, TBind x dom) : vTel, core)+    _ -> return ([], tv)++-- | Turn a fully applied constructor value into a named record value.+mkConVal :: Dotted -> ConK -> QName -> [Val] -> TVal -> TypeCheck Val+mkConVal dotted co n vs vc = do+  (vTel, _) <- telView vc+  let fieldNames = map (boundName . snd) vTel+  return $ VRecord (NamedRec co n False dotted) $ zip fieldNames vs
+ Eval.hs-boot view
@@ -0,0 +1,39 @@+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}++module Eval where++import Abstract+import Value+import {-# SOURCE #-} TCM (TypeCheck)++class Reval a where+  reval' :: Valuation -> a -> TypeCheck a+  reval  :: a -> TypeCheck a+  reval = reval' emptyVal++instance Reval Val+instance Reval Env++toExpr :: Val -> TypeCheck Expr++whnf  :: Env -> Expr -> TypeCheck Val+whnf' :: Expr -> TypeCheck Val+app   :: Val -> Val -> TypeCheck Val++whnfClos :: Val -> TypeCheck Val+force :: Val -> TypeCheck Val+piApps :: TVal -> [Clos] -> TypeCheck TVal++matchList :: Env -> [Pattern] -> [Val] -> TypeCheck (Maybe Env)++type GenToPattern = [(Int,Pattern)]+type MatchState = (Env, GenToPattern)+nonLinMatchList' :: Bool -> Bool -> MatchState -> [Pattern] -> [Val] -> TVal -> TypeCheck (Maybe MatchState)++projectType :: TVal -> Name -> Val -> TypeCheck TVal++up    :: Bool -> Val -> TVal -> TypeCheck Val++leqSize' :: Val -> Val -> TypeCheck ()++mkConVal :: Dotted -> ConK -> QName -> [Val] -> TVal -> TypeCheck Val
+ Extract.hs view
@@ -0,0 +1,690 @@+{-# LANGUAGE TupleSections, NamedFieldPuns #-}++module Extract where++{- extract to Fomega++Examples:+---------++MiniAgda++  data Vec (A : Set) : Nat -> Set+  { vnil  : Vec A zero+  ; vcons : [n : Nat] -> (head : A) -> (tail : Vec A n) -> Vec A (suc n)+  } fields head, tail++  fun length : [A : Set] -> [n : Nat] -> Vec A n -> <n : Nat>+  { length .A .zero    (vnil A)         = zero+  ; length .A .(suc n) (vcons A n a as) = suc (length A n as)+  }++Fomega++  data Vec (A : Set) : Set+  { vnil  : Vec A+  ; vcons : (head : A) -> (tail : Vec A) -> Vec A+  }++  fun head : [A : Set] -> Vec A -> A+  { head (vcons 'head 'tail) = 'head+  }++  fun tail : [A : Set] -> Vec A -> A+  { head (vcons 'head 'tail) = 'tail+  }++  fun length : [A : Set] -> Vec A -> Nat+  { length [A]  vnil             = zero+  ; length [A] (vcons [.A] a as) = suc (length [A] as)+  }+++Bidirectional extraction+========================++Types++  Base ::= D As         data type+         | ?            inexpressible type++  A,B ::= Base | A -> B | [x:K] -> B | [] -> B  with erasure markers+  A0, B0 ::= Base | A0 -> B0 | [x:K0] -> B0     without erasure markers++  |.| erase erasure markers++Inference mode:++  Term extraction:  Gamma |- t :> A  --> e    |Gamma| |- e : |A|+  Type extraction:  Gamma |- T :> K  --> A    |Gamma| |- A : |K|+  Kind extraction:  Gamma |- U :> [] --> K    |Gamma| |- K : []++Checking mode:++  Term extraction:  Gamma |- t <: A  --> e    |Gamma| |- e : |A|+  Type extraction:  Gamma |- T <: K  --> A    |Gamma| |- A : |K|+  Kind extraction:  Gamma |- U <: [] --> K    |Gamma| |- K : []++Type and kind extraction keep erasure markers!++Checking abstraction:++  Relevant abstraction:+  Gamma, x:A |- t <: B --> e+  --------------------------------+  Gamma |- \x.t <: A -> B --> \x.e++  Type abstraction:+  Gamma, x:K |- t <: B --> e : B0+  ----------------------------------------+  Gamma |- \[x].t <: [x:K] -> B --> \[x].e+      also \xt++  Irrelevant abstraction:+  Gamma |- t : B --> e+  -------------------------------+  Gamma |- \[x].t : [] -> B --> e+      also \xt++  Relevant abstraction at unknown type:+  Gamma, x:? |- t : ? --> e+  --------------------------+  Gamma |- \x.t : ? --> \x.e++  Irrelevant abstraction at unknown type:+  Gamma |- t : ? --> e+  -------------------------+  Gamma |- \[x].t : ? --> e++Checking by inference:++  Gamma |- t :> A --> e    e : |A| <: |B| --> e'+  ----------------------------------------------+  Gamma |- t <: B --> e' : B0++Casting:++  ------------------ A0 does not contain ?+  e : A0 <: A0 --> e++  ----------------------- A0 != B0 or one does contain ?+  e : A0 <: B0 --> cast e++Inferring variable:++  ----------------------------+  Gamma |- x :> Gamma(x) --> x++Inferring application:++  Relevant application:+  Gamma |- t :> A -> B --> f     Gamma |- u <: A --> e+  ----------------------------------------------------+  Gamma |- t u :> B --> f e++  Type application:+  Gamma |- t :> [x:K] -> B --> f   Gamma |- u <: K --> A+  ------------------------------------------------------+  Gamma |- t [u] :> : B[A/x] --> f [A]+      also  t u++  Irrelevant application:+  Gamma |- t :> [] -> B --> f+  ---------------------------+  Gamma |- t [u] :> B --> f+      also  t u++  Relevant application at unknown type:+  Gamma |- t :> ? --> f     Gamma |- u <: ? --> e+  -----------------------------------------------+  Gamma |- t u :> ? --> f e++  Irrelevant application at unknown type:+  Gamma |- t :> ? --> f+  -------------------------+  Gamma |- t [u] :> ? --> f++++-}++import Prelude hiding (pi, null)++import Control.Applicative+import Control.Monad+import Control.Monad.Error+import Control.Monad.Reader+import Control.Monad.Writer+import Control.Monad.State++import Data.Char+import Data.Traversable (Traversable)+import qualified Data.Traversable as Traversable+import Data.Map (Map)+import qualified Data.Map as Map+import qualified Data.Maybe as Maybe++import Text.PrettyPrint++import Polarity as Pol+import Abstract+import Value+import Eval+import TCM+import TraceError+import Util++traceExtrM s = return ()++runExtract sig k = runErrorT (runReaderT (runStateT k (initWithSig sig)) emptyContext)++-- extraction++type FExpr        = Expr+type FDeclaration = Declaration+type FClause      = Clause+type FPattern     = Pattern+type FConstructor = Constructor+type FTypeSig     = TypeSig+type FFun         = Fun+type FTelescope   = Telescope++type FTVal        = TVal++extractDecls :: [EDeclaration] -> TypeCheck [FDeclaration]+extractDecls ds = concat <$> mapM extractDecl ds++extractDecl :: EDeclaration -> TypeCheck [FDeclaration]+extractDecl d =+  case d of+    MutualDecl _ ds -> extractDecls ds -- TODO!+    OverrideDecl{} -> fail $ "extractDecls internal error: overrides impossible"+    MutualFunDecl _ co funs -> extractFuns co funs+    FunDecl co fun -> extractFun co fun+    LetDecl evl x tel (Just t) e | null tel -> extractLet evl x t e+    PatternDecl{}    -> return []+    DataDecl n _ co _ tel ty cs fields -> extractDataDecl n co tel ty cs++extractFuns :: Co -> [Fun] -> TypeCheck [FDeclaration]+extractFuns co funs = do+  funs <- concat <$> mapM extractFunTypeSig funs+  concat <$> mapM (extractFun co) funs++extractFun :: Co -> Fun -> TypeCheck [FDeclaration]+extractFun co (Fun (TypeSig n t) n' ar cls) = do+  tv <- whnf' t+  cls <- concat <$> mapM (extractClause n tv) cls+  return [ FunDecl co $ Fun (TypeSig n t) n' ar cls+         -- , LetDecl False (TypeSig n' t) (Var n)  -- no longer needed, since n and n' print the same+         ]++{- OLD+extractFun :: Co -> Fun -> TypeCheck [FDeclaration]+extractFun co (TypeSig n t, (ar, cls)) = extractIfTerm n $ do+  tv0 <- whnf' t+  t <- extractType tv0+  setExtrTyp n t+  let n' = mkExtName n+  setExtrTyp n' t+  tv <- whnf' t+  cls <- concat <$> mapM (extractClause n tv) cls+  return [ FunDecl co (TypeSig n t, (ar, cls))+         , LetDecl False (TypeSig n' t) (Var n)+         ]+-}+{-+extractFunTypeSigs :: [Fun] -> TypeCheck [Fun]+extractFunTypeSigs = mapM extractFunTypeSig+-}++-- only extract type sigs+extractFunTypeSig :: Fun -> TypeCheck [Fun]+extractFunTypeSig (Fun ts@(TypeSig n t) n' ar cls) = extractIfTerm n $ do+  ts@(TypeSig n t) <- extractTypeSig ts+  setExtrTyp n' t+  return [Fun ts n' ar cls]++extractLet :: Bool -> Name -> Type -> Expr -> TypeCheck [FDeclaration]+extractLet evl n t e = extractIfTerm n $ do+  TypeSig n t <- extractTypeSig (TypeSig n t)+  e <- extractCheck e =<< whnf' t+  return [LetDecl evl n emptyTel (Just t) e]++extractTypeSig :: TypeSig -> TypeCheck FTypeSig+extractTypeSig (TypeSig n t) = do+  t <- extractType =<< whnf' t+  setExtrTyp n t+  return $ TypeSig n t++extractIfTerm :: Name -> TypeCheck [a] -> TypeCheck [a]+extractIfTerm n cont = do+  k <- symbolKind <$> lookupSymb n+  if k == NoKind || lowerKind k == SortC Tm then cont else return []++extractDataDecl :: Name -> Co -> Telescope -> Type -> [Constructor] -> TypeCheck [FDeclaration]+extractDataDecl n co tel ty cs = do+  -- k    <- extrTyp <$> lookupSymb n+  tel' <- extractKindTel tel+  Just core <- addBinds tel $ extractKind =<< whnf' ty+  -- (_, core) = typeToTele' (length tel') k+  cs   <- mapM (extractConstructor tel) cs+  return [DataDecl n NotSized co [] tel' core cs []]++extractConstructor :: Telescope -> Constructor -> TypeCheck FConstructor+extractConstructor tel0 (Constructor n pars t) = do+{- fails for HEq+  -- 2012-01-22: remove irrelevant parameters+  let tel = filter (\ (TBind _ dom) -> not $ erased $ decor dom)  tel0+-}+  let tel = tel0+  -- compute full extracted constructor type and add to the signature+  t' <- extractType =<< whnf emptyEnv (teleToTypeErase tel t)+  setExtrTypQ n t'+  let (tel',core) = typeToTele' (size tel) t'+  return $ Constructor n pars core+  -- compute type minus telescope+  -- TypeSig n <$> (extractType =<< whnf' t)++extractClause :: Name -> FTVal -> Clause -> TypeCheck [FClause]+extractClause f tv (Clause _ pl Nothing) = return [] -- discard absurd clauses+extractClause f tv cl@(Clause vtel pl (Just rhs)) = do+  traceM ("extracting clause " ++ render (prettyClause f cl)+          ++ "\n at type " ++ show tv)+{-+  tel <- introPatterns pl tv0 $ \ _ _ -> do+           vtel <- getContextTele+           extractTeleVal vtel+  addBinds tel $+-}+  introPatVars pl $+    extractPatterns tv pl $ \ pl tv -> do+      rhs <- extractCheck rhs tv+      return [Clause vtel pl (Just rhs)] -- TODO: return FTelescope (type!)++-- the pattern variables are already in context+extractPatterns :: FTVal -> [Pattern] ->+                   ([FPattern] -> FTVal -> TypeCheck a) -> TypeCheck a+extractPatterns tv [] cont = cont [] tv+extractPatterns tv (p:ps) cont =+  extractPattern tv p $ \ pl tv ->+    extractPatterns tv ps $ \ ps tv ->+      cont (pl ++ ps) tv++extractPattern :: FTVal -> Pattern ->+                  ([FPattern] -> FTVal -> TypeCheck a) -> TypeCheck a+extractPattern tv p cont = do+  traceM ("extracting pattern " ++ render (pretty p) ++ " at type " ++ show tv)+  fv <- funView tv+  case fv of+    EraseArg tv -> cont [] tv  -- skip erased patterns++    Forall x dom fv -> do+      xv <- whnf' (patternToExpr p) -- pattern variables are already in scope+      bv <- app fv xv -- TODO!+      case p of+        ErasedP (VarP y) -> setTypeOfName y dom $ cont [] bv+        _ -> cont [] bv+{-+    Forall x ki env t -> new x ki $ \ xv ->+      cont [] =<< whnf (update env x xv) t -- TODO!+-}+    Arrow av bv -> extractPattern' av p (flip cont bv)++extractPattern' :: FTVal -> Pattern ->+                  ([FPattern] -> TypeCheck a) -> TypeCheck a+extractPattern' av p cont =+      case p of+        VarP y -> setTypeOfName y (defaultDomain av) $+          cont [VarP y]+        PairP p1 p2 -> do+          view <- prodView av+          -- hack to avoid IMPOSSIBLE+          let (av1, av2) = case view of+                             Prod av1 av2 -> (av1, av2)+                             _ -> (av, av) -- HACK+          extractPattern' av1 p1 $ \ ps1 -> do+            extractPattern' av2 p2 $ \ ps2 ->+               let ps [] ps2    = ps2+                   ps ps1 []    = ps1+                   ps [p1] [p2] = [PairP p1 p2]+               in  cont $ ps ps1 ps2++{-+          case view of+            Prod av1 av2 ->+              extractPattern' av1 p1 $ \ [p1] -> do+                extractPattern' av2 p2 $ \ [p2] -> cont [PairP p1 p2]+            _ -> fail $ "extractPattern': IMPOSSIBLE: pattern " +++                          show p ++ " : " ++ show av+-}+        ConP pi n ps -> do+--          tv <- whnf' =<< extrTyp <$> lookupSymb n+          tv <- extrConType n av+          extractPatterns tv ps $ \ ps _ ->+            cont [ConP pi n ps]+        _ -> cont []++extrConType :: QName -> FTVal -> TypeCheck FTVal+extrConType c av = do+  ConSig { conPars, extrTyp, dataPars } <- lookupSymbQ c+  traceExtrM ("extrConType " ++ show c ++ " has extrTyp = " ++ show extrTyp)+  tv <- whnf' extrTyp+  numPars <- maybe (return dataPars) (const $ fail $ "NYI: extrConType for pattern parameters") conPars+  case numPars of+   0 -> return tv+   _ -> do+    case av of+      VApp (VDef (DefId DatK d)) vs -> do+        DataSig { positivity } <- lookupSymbQ d+        traceExtrM ("extrConType " ++ show c ++ "; data type has positivity = " ++ show positivity)+        let pars 0 pols vs = []+            pars n (pol:pols) vs | erased pol = VIrr : pars (n-1) pols vs+            pars n (pol:pols) (v:vs) = v : pars (n-1) pols vs+            pars n pols vs = error $ "pars " ++ show n ++ show pols ++ show vs+        piApps tv $ pars numPars positivity $ vs ++ repeat VIrr+{-+        let (pars, inds) = splitAt numPars vs+        piApps tv pars+-}+      _ -> piApps tv $ replicate numPars VIrr+--      _ -> fail $ "extrConType " ++ show c ++ ": expected datatype, found " ++ show av++-- extracting a term from a term -------------------------------------++extractInfer :: Expr -> TypeCheck (FExpr, FTVal)+extractInfer e = do+  case e of++    Var x -> (Var x,) . typ . domain <$> lookupName1 x++    App f e0 -> do+      let (er, e) = isErasedExpr e0+      (f, tv) <- extractInfer f+      fv <- funView tv+      case fv of+        EraseArg bv -> return (f,bv)+        Forall x dom fv -> do+          e <- extractTypeAt e (typ dom)+          bv <- app fv =<< whnf' e+          return $ (App f (erasedExpr e), bv)+        Arrow av bv -> return (if er then f else App f e, bv)+        NotFun -> return (if er then f else castExpr f `App` e, VIrr)++    Def f -> (Def f,) <$> do (whnf' . extrTyp) =<< lookupSymbQ (idName f)++    Pair{} -> fail $ "extractInfer: IMPOSSIBLE: pair " ++ show e+    -- other expressions are erased or types++    _ -> return (Irr, VIrr)++extractCheck :: Expr -> FTVal -> TypeCheck (FExpr)+extractCheck e tv = do+  case e of+    Lam dec y e -> do+      fv <- funView tv+      case fv of+        EraseArg bv        -> extractCheck e bv -- discard lambda+        Forall x dom fv    ->+          Lam (decor dom) y <$> do+            newWithGen y dom $ \ i xv ->+              extractCheck e =<< app fv (VGen i) -- no eta-expansion+        Arrow av bv        ->+          if erased dec then extractCheck e bv+           else Lam dec y <$> do+             new' y (defaultDomain av) $+               extractCheck e bv+        NotFun            -> castExpr <$>+          if erased dec then extractCheck e VIrr+           else Lam dec y <$> do+             new' y (defaultDomain VIrr) $+               extractCheck e VIrr++    LLet (TBind x dom0) tel e1 e2 | null tel -> do+      let dom = fmap Maybe.fromJust dom0+      if erased (decor dom) then extractCheck e2 tv else do -- discard let+       vdom <- Traversable.mapM whnf' dom         -- MiniAgda type val+       dom  <- Traversable.mapM extractType vdom  -- Fomega type+       vdom <- Traversable.mapM whnf' dom         -- Fomega type val+       e1  <- extractCheck e1 (typ vdom)+       LLet (TBind x (fmap Just dom)) emptyTel e1 <$> do+         new' x vdom $ extractCheck e2 tv++    Pair e1 e2 -> do+      view <- prodView tv+      let (av1,av2) = case view of+                        Prod av1 av2 -> (av1, av2)+                        _ -> (tv,tv) -- HACK!!+      Pair <$> extractCheck e1 av1 <*> extractCheck e2 av2+{-+      case view of+        Prod av1 av2 -> Pair <$> extractCheck e1 av1 <*> extractCheck e2 av2+        _ -> fail $ "extractCheck: tuple type expected " ++ show e ++ " : " ++ show tv+-}++    -- TODO: case++    _ -> fallback+  where+    fallback = do+      (e,tv') <- extractInfer e+      insertCast e tv tv'++insertCast :: FExpr -> FTVal -> FTVal -> TypeCheck FExpr+insertCast e tv1 tv2 = loop tv1 tv2 where+  loop tv1 tv2 =+    case (tv1,tv2) of+      (VIrr,_) -> return $ castExpr e+      (_,VIrr) -> return $ castExpr e+      _  -> return e -- TODO!++funView :: FTVal -> TypeCheck FunView+funView tv =+  case tv of+    -- erasure mark+    VQuant Pi x dom fv | erased (decor dom) && typ dom == VIrr ->+      EraseArg <$> app fv VIrr+    -- forall+    VQuant Pi x dom fv | erased (decor dom) ->+      return $ Forall x dom fv+    -- function type+    VQuant Pi x dom fv ->+      Arrow (typ dom) <$> app fv VIrr+    -- any other type can be a function type, but this needs casts!+    _ -> return NotFun -- $ Arrow VIrr VIrr++data FunView+  = Arrow    FTVal FTVal            -- A -> B+  | Forall   Name Domain FTVal      -- forall X:K. A+  | EraseArg FTVal                  -- [] -> B+  | NotFun                          -- ()++prodView :: FTVal -> TypeCheck ProdView+prodView tv =+  case tv of+    VQuant Sigma x dom fv -> Prod (typ dom) <$> app fv VIrr+    _                     -> return $ NotProd++data ProdView+  = Prod FTVal FTVal -- A * B+  | NotProd++-- extracting a kind from a value ------------------------------------++type FKind = Expr -- FKind ::= Set | FKind -> FKind | [Irr] -> FKind++star :: FKind+star = Sort $ Set Zero++extractSet :: Sort Val -> Maybe FKind+extractSet s =+  case s of+    SortC _ -> Nothing+    Set _   -> Just $ star+    CoSet _ -> Just $ star++-- keep irrelevant entries+extractKindTel :: Telescope -> TypeCheck FTelescope+extractKindTel (Telescope tel) = Telescope <$> loop tel where+  loop [] = return []+  loop (TBind x dom : tel) = do+    dom  <- Traversable.mapM whnf' dom+    dom' <- extractKindDom dom+    if erased (decor dom') then+      newIrr x $+        (TBind x dom' :) <$> loop tel+     else newTyVar x (typ dom') $ \ i -> do+        x <- nameOfGen i+        (TBind x dom' :) <$> loop tel++{-+-- keep irrelevant entries+extractKindTel :: Telescope -> TypeCheck FTelescope+extractKindTel tel = do+  tv     <- whnf' (teleToType tel star)+  Just k <- extractKind tv+  let (tel, s) = typeToTele k+  return tel+  -- throw away erasure marks+  -- return $ filter (\ tb -> not $ erased $ decor $ boundDom tb) tel+-}++extractKindDom :: Domain -> TypeCheck (Dom FKind)+extractKindDom dom =+  maybe (defaultIrrDom Irr) defaultDomain <$>+    if erased (decor dom) then return Nothing+     else extractKind (typ dom)++extractKind :: TVal -> TypeCheck (Maybe FKind)+extractKind tv =+  case tv of+    VSort s -> return $ extractSet s+    VMeasured mu vb -> extractKind vb+    VGuard beta vb -> extractKind vb+    VQuant Pi x dom fv -> new' x dom $ do+       bv  <- app fv VIrr+       mk' <- extractKind bv+       case mk' of+         Nothing -> return Nothing+         Just k' -> do+           dom' <- extractKindDom dom+           let x = fresh ""+           return $ Just $ pi (TBind x dom') k'+    _ -> return Nothing++-- extracting a type constructor from a value ------------------------++type FType = Expr+{- FType ::= Irr                 -- not expressible in Fomega+           | D FTypes            -- data type+           | X FTypes            -- type variable+           | FType -> FType      -- function type+           | [X:FKind] -> FType  -- polymorphic type+           | [Irr] -> FType      -- erasure marker+ -}++-- tyVarName i = fresh $ "a" ++ show i++newTyVar :: Name -> FKind -> (Int -> TypeCheck a) -> TypeCheck a+newTyVar x k cont = newWithGen x (defaultDomain (VClos emptyEnv k)) $+  \ i _ -> cont i                  -- store kinds unevaluated++addFKindTel :: FTelescope -> TypeCheck a -> TypeCheck a+addFKindTel (Telescope tel) = loop tel where+  loop []                  cont = cont+  loop (TBind x dom : tel) cont = newTyVar x (typ dom) $ \ _ ->+    loop tel cont++extractTeleVal :: TeleVal -> TypeCheck FTelescope+extractTeleVal = Telescope <.> loop where+  loop []          = return []+  loop (tb : vtel) = do+    tb <- Traversable.mapM extractType tb+    addBind tb $ do+      (tb :) <$> loop vtel++extractType :: TVal -> TypeCheck FType+extractType = extractTypeAt star++extractTypeAt :: FKind -> TVal -> TypeCheck FType+extractTypeAt k tv = do+  case (tv,k) of++    (VMeasured mu vb, _) -> extractTypeAt k vb+    (VGuard beta vb, _) -> extractTypeAt k vb++    -- relevant function space / sigma type --> non-dependent+    (VQuant pisig x dom fv, _) | not (erased (decor dom)) -> do+      a <- extractType (typ dom)+      -- new' x dom $ do+      bv <- app fv VIrr+      b  <- extractType bv+      let x = fresh ""+      return $ piSig pisig (TBind x (defaultDomain a)) b++    -- irrelevant function space --> forall or erasure marker+    (VQuant Pi x dom fv, _) | erased (decor dom) -> do+      mk <- extractKind (typ dom)+      case mk of+        Nothing -> do -- new' x dom $ do+          bv <- app fv VIrr+          b  <- extractType bv+          let x = fresh ""+          return $ pi (TBind x (defaultIrrDom Irr)) b+        Just k' -> do+          newTyVar x k' $ \ i -> do+            bv <- app fv $ VGen i+            b  <- extractType bv+            x  <- nameOfGen i+            return $ pi (TBind x (defaultIrrDom k')) b++    (VApp (VDef (DefId DatK n)) vs, _) -> do+      k  <- extrTyp <$> lookupSymbQ n  -- get kind of dname from signature+      as <- extractTypes k vs  -- turn vs into types as at kind k+      return $ foldl App (Def (DefId DatK n)) as++    (VGen i,_) -> do+--      VClos _ k <- (typ . fromOne . domain) <$> lookupGen i  -- get kind of var from cxt+      Var <$> nameOfGen i+      -- return $ Var (tyVarName i)++    (VApp (VGen i) vs,_) -> do+      VClos _ k <- (typ . fromOne . domain) <$> lookupGen i  -- get kind of var from cxt+      as <- extractTypes k vs  -- turn vs into types as at kind k+      x <- nameOfGen i+      return $ foldl App (Var x) as++    (VLam x env e, Quant Pi (TBind _ dom) k) | erased (decor dom) -> do+      tv <- whnf (update env x VIrr) e+      extractTypeAt k tv++    (VLam x env e, Quant Pi (TBind _ dom) k) -> newTyVar x (typ dom) $ \ i -> do+      tv <- whnf (update env x (VGen i)) e+      x  <- nameOfGen i+      Lam defaultDec x <$> extractTypeAt k tv++    (VLam{},_) -> error $ "panic! extractTypeAt " ++ show (tv,k)++    (VSing _ tv,_) -> extractTypeAt k tv++    (VUp v _,_)    -> extractTypeAt k v++    _ -> return Irr++extractTypes :: FKind -> [TVal] -> TypeCheck [FType]+extractTypes k vs =+  case (k,vs) of+    (_, []) -> return []+    (Quant Pi (TBind _ dom) k, v:vs) | erased (decor dom) -> extractTypes k vs+    (Quant Pi (TBind _ dom) k, v:vs) -> do+      v  <- whnfClos v+      a  <- extractTypeAt (typ dom) v+      as <- extractTypes k vs+      return $ a : as+    _ -> error $ "panic! extractTypes  " ++ show k ++ "  " ++ show vs++-- auxiliary functions -----------------------------------------------++{- this is setExtrTyp+addFTypeSig :: Name -> FType -> TypeCheck ()+addFTypeSig n t = modifySig n (\ item -> item { extrTyp = t })+-}
+ HsSyntax.hs view
@@ -0,0 +1,129 @@+{- 2010-09-17 haskell syntax tools -}++module HsSyntax where++import Abstract (PiSigma(..))+import Language.Haskell.Exts.Syntax++noLoc :: SrcLoc+noLoc = SrcLoc "" 0 0++mkQual :: String -> String -> QName+mkQual m s = Qual (ModuleName m) (Ident s)++mkModule :: [Decl] -> Module+mkModule hs = Module noLoc main_mod pragmas warning exports imports decls where+  pragmas = [ LanguagePragma noLoc $ map Ident+    [ "NoImplicitPrelude"+    , "GADTs"+    , "KindSignatures"+    ]]+  warning = Nothing+  exports = Nothing+  imports =+    [ mkQualImport "GHC.Show" "Show"+    , mkQualImport "System.IO" "IO"+    , mkQualImport "Unsafe.Coerce" "Coerce"+    ]+  decls   = hs +++    [ TypeSig noLoc [ main_name ] io+    , FunBind [ mkClause main_name [] rhs ]+    ] where rhs  = Var (mkQual "IO" "putStrLn") `App` Lit (String "Hello, world!")+            io   = TyCon (mkQual "IO" "IO") `TyApp` unit_tycon++mkQualImport :: String -> String -> ImportDecl+mkQualImport modName asName =+  ImportDecl+  { importLoc       = noLoc+  , importModule    = ModuleName modName+  , importQualified = True+  , importSrc       = False+  , importPkg       = Nothing+  , importAs        = Just $ ModuleName asName+  , importSpecs     = Nothing+  }++noContext = []+noDeriving = []+noTyVarBind = []+showDeriving = (mkQual "Show" "Show", [])++mkDataDecl :: Name -> [TyVarBind] -> Kind -> [GadtDecl] -> Decl+mkDataDecl n tel k cs = GDataDecl noLoc DataType noContext n tel (Just k) cs [showDeriving]++mkConDecl :: Name -> Type -> GadtDecl+mkConDecl n t = GadtDecl noLoc n t++mkKindFun :: Kind -> Kind -> Kind+mkKindFun = KindFn+{-+mkKindFun k k' = parens k `KindFn` k'+      where parens H.KindStar = H.KindStar+            parens k          = H.KindParen k+-}++mkTyPiSig :: PiSigma -> Type -> Type -> Type+mkTyPiSig Pi    = mkTyFun+mkTyPiSig Sigma = mkTyProd++mkTyProd :: Type -> Type -> Type+mkTyProd a b = TyTuple Boxed [a,b]++mkTyFun :: Type -> Type -> Type+mkTyFun = TyFun+-- mkTyFun a b = mkTyParen a `TyFun` b++mkForall :: Name -> Kind -> Type -> Type+mkForall x k t = TyForall (Just $ [KindedVar x k]) noContext t++mkTyParen :: Type -> Type+mkTyParen a@(TyVar{}) = a+mkTyParen a@(TyCon{}) = a+mkTyParen a = TyParen a++mkTyApp :: Type -> Type -> Type+mkTyApp f a = TyApp f a++noBinds = BDecls []++mkTypeSig :: Name -> Type -> Decl+mkTypeSig x t = TypeSig noLoc [x] t++-- create a simple function clause x = t+mkLet :: Name -> Exp -> Decl+mkLet x e = FunBind [mkClause x [] e]++mkClause :: Name -> [Pat] -> Exp -> Match+mkClause f ps e = Match noLoc f ps Nothing (UnGuardedRhs e) noBinds++mkCast :: Exp -> Exp+mkCast e = Var (mkQual "Coerce" "unsafeCoerce") `App` e++mkCon :: Name -> Exp+mkCon = Con . UnQual++mkVar :: Name -> Exp+mkVar = Var . UnQual++mkLam :: Name -> Exp -> Exp+mkLam x (Lambda _ ps e) = Lambda noLoc (PVar x : ps) e+mkLam x  e              = Lambda noLoc [PVar x] e++mkParen :: Exp -> Exp+mkParen e@(Var{}) = e+mkParen e@(Con{}) = e+mkParen e = Paren e++mkApp :: Exp -> Exp -> Exp+mkApp f e = App f e -- (mkParen e)++mkLLet :: Name -> Maybe Type -> Exp -> Exp -> Exp+mkLLet x t e e' = Let (BDecls [mkLet x e]) e'++mkPair :: Exp -> Exp -> Exp+mkPair e1 e2 = Tuple Boxed [e1,e2]++{- this is already predefined as unit_con+hsDummyExp :: HsExp+hsDummyExp = HsCon $ Special $ HsUnitCon  -- Haskell's '()'+-}
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2007-2014 Andreas Abel and Karl Mehltretter.++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be+included in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ Lexer.x view
@@ -0,0 +1,208 @@++{++module Lexer where++}++%wrapper "posn"++$digit = 0-9			-- digits+$alpha = [a-zA-Z]		-- alphabetic characters+$u     = [ . \n ]               -- universal: any character+@ident = $alpha ($alpha | $digit | \_ | \')*  -- identifier++tokens :-++$white+				;+"--".*				;+"{-" ([$u # \-] | \- [$u # \}])* ("-")+ "}" ;+++sized	    	     	   	{ tok (\p s -> Sized p) }+data				{ tok (\p s -> Data p) }+codata				{ tok (\p s -> CoData p) }+record				{ tok (\p s -> Record p) }+fields                          { tok (\p s -> Fields p) }+fun				{ tok (\p s -> Fun p) }+cofun				{ tok (\p s -> CoFun p) }+pattern                         { tok (\p s -> Pattern p) }+case                            { tok (\p s -> Case p) }+def				{ tok (\p s -> Def p) }+let				{ tok (\p s -> Let p) }+in				{ tok (\p s -> In p) }+eval				{ tok (\p s -> Eval p)}+fail				{ tok (\p s -> Fail p)}+check				{ tok (\p s -> Check p)}+trustme				{ tok (\p s -> TrustMe p)}+impredicative                 	{ tok (\p s -> Impredicative p)}+mutual				{ tok (\p s -> Mutual p) }+Type				{ tok (\p s -> Type p) }+Set				{ tok (\p s -> Set p) }+CoSet				{ tok (\p s -> CoSet p) }+"<|"                            { tok (\p s -> LTri p) }+"|>"                            { tok (\p s -> RTri p) }+Size				{ tok (\p s -> Size p) }+\#				{ tok (\p s -> Infty p) }+\$				{ tok (\p s -> Succ p) }+max                             { tok (\p s -> Max p) }++\{				{ tok (\p s -> BrOpen p) }+\}				{ tok (\p s -> BrClose p) }+\[				{ tok (\p s -> BracketOpen p) }+\]				{ tok (\p s -> BracketClose p) }+\(				{ tok (\p s -> PrOpen p) }+\)				{ tok (\p s -> PrClose p) }+\|				{ tok (\p s -> Bar p) }+\;				{ tok (\p s -> Sem p) }+\:				{ tok (\p s -> Col p) }+\,				{ tok (\p s -> Comma p) }+\.				{ tok (\p s -> Dot p) }+\+\+                            { tok (\p s -> PlusPlus p) }+\+				{ tok (\p s -> Plus p) }+\-				{ tok (\p s -> Minus p) }+\/				{ tok (\p s -> Slash p) }+\*				{ tok (\p s -> Times p) }+\^				{ tok (\p s -> Hat p) }+\&				{ tok (\p s -> Amp p) }+"->"				{ tok (\p s -> Arrow p)  }+"<="                            { tok (\p s -> Leq p)  }+=				{ tok (\p s -> Eq p) }+\\				{ tok (\p s -> Lam p) }+\_				{ tok (\p s -> Underscore p) }+\<                              { tok (\p s -> AngleOpen p) }+\>                              { tok (\p s -> AngleClose p) }++[$digit]+		        { tok (\p s -> (Number s p )) }+@ident                          { tok (\p s -> (Id s p )) }+@ident \. @ident                { tok (\p s -> (qualId s p)) }++{+data Token = Id String AlexPosn+           | QualId (String, String) AlexPosn+     	   | Number String AlexPosn+     	   | Sized AlexPosn+           | Data AlexPosn+	   | CoData AlexPosn+	   | Record AlexPosn+	   | Fields AlexPosn+	   | Mutual AlexPosn+           | Fun AlexPosn+           | CoFun AlexPosn+           | Pattern AlexPosn+	   | Case AlexPosn+	   | Def AlexPosn+	   | Let AlexPosn+	   | In AlexPosn+           | Type AlexPosn+           | Set AlexPosn+           | CoSet AlexPosn+	   | Eval AlexPosn+	   | Fail AlexPosn+	   | Check AlexPosn+	   | TrustMe AlexPosn+	   | Impredicative AlexPosn+           -- size type+           | Size AlexPosn+           | Infty AlexPosn+           | Succ AlexPosn+           | Max AlexPosn+           --+           | LTri AlexPosn+           | RTri AlexPosn+           | AngleOpen AlexPosn+           | AngleClose AlexPosn+           | BrOpen AlexPosn+           | BrClose AlexPosn+           | BracketOpen AlexPosn+           | BracketClose AlexPosn+           | PrOpen AlexPosn+           | PrClose AlexPosn+           | Bar AlexPosn+           | Sem AlexPosn+           | Col AlexPosn+	   | Comma AlexPosn+	   | Dot AlexPosn+           | Arrow AlexPosn+           | Leq AlexPosn+           | Eq AlexPosn+	   | PlusPlus AlexPosn+	   | Plus AlexPosn+	   | Minus AlexPosn+	   | Slash AlexPosn+	   | Times AlexPosn+	   | Hat AlexPosn+	   | Amp AlexPosn+           | Lam AlexPosn+           | Underscore AlexPosn+           | NotUsed AlexPosn -- so happy doesn't generate overlap case pattern warning+             deriving (Eq)++qualId s p = let (m, '.':n) = break (== '.') s in QualId (m,n) p++prettyTok :: Token -> String+prettyTok c = "\"" ++ tk ++ "\" at " ++ (prettyAlexPosn pos) where+  (tk,pos) = case c of+    (Id s p) -> (show s,p)+    (QualId (m, n) p) -> (show m ++ "." ++ show n, p)+    (Number i p) -> (i,p)+    Sized p -> ("sized",p)+    Data p -> ("data",p)+    CoData p -> ("codata",p)+    Record p -> ("record",p)+    Fields p -> ("fields",p)+    Mutual p -> ("mutual",p)+    Fun p -> ("fun",p)+    CoFun p -> ("cofun",p)+    Pattern p -> ("pattern",p)+    Case p -> ("case",p)+    Def p -> ("def",p)+    Let p -> ("let",p)+    In p -> ("in",p)+    Eval p -> ("eval",p)+    Fail p -> ("fail",p)+    Check p -> ("check",p)+    TrustMe p -> ("trustme",p)+    Impredicative p -> ("impredicative",p)+    Type p -> ("Type",p)+    Set p -> ("Set",p)+    CoSet p -> ("CoSet",p)+    Size p -> ("Size",p)+    Infty p -> ("#",p)+    Succ p -> ("$",p)+    Max p -> ("max",p)+    LTri p -> ("<|",p)+    RTri p -> ("|>",p)+    AngleOpen p -> ("<",p)+    AngleClose p -> (">",p)+    BrOpen p -> ("{",p)+    BrClose p -> ("}",p)+    BracketOpen p -> ("[",p)+    BracketClose p -> ("]",p)+    PrOpen p -> ("(",p)+    PrClose p -> (")",p)+    Bar p -> ("|",p)+    Sem p -> (";",p)+    Col p -> (":",p)+    Comma p -> (",",p)+    Dot p -> (".",p)+    Arrow p -> ("->",p)+    Leq p -> ("<=",p)+    Eq p -> ("=",p)+    PlusPlus p -> ("++",p)+    Plus p -> ("+",p)+    Minus p -> ("-",p)+    Slash p -> ("/",p)+    Times p -> ("*",p)+    Hat p -> ("^",p)+    Amp p -> ("&",p)+    Lam p -> ("\\",p)+    Underscore p -> ("_",p)+    _ -> error "not used"+++prettyAlexPosn (AlexPn _ line row) = "line " ++ show line ++ ", row " ++ show row++tok f p s = f p s++}
+ Main.hs view
@@ -0,0 +1,136 @@+module Main where++import Prelude hiding (null)++import System.Environment+import System.Exit+import System.IO (stdout, hSetBuffering, BufferMode(..))++import qualified Language.Haskell.Exts.Syntax as H+import qualified Language.Haskell.Exts.Pretty as H++import Lexer+import Parser++import qualified Concrete as C+import qualified Abstract as A+import Abstract (Name)+import ScopeChecker+import Value+import TCM+import TypeChecker+import Extract+import ToHaskell++import Util++main :: IO ()+main = do+  hSetBuffering stdout NoBuffering+  putStrLn "MiniAgda by Andreas Abel and Karl Mehltretter"+  args <- getArgs+  mapM_ mainFile args++mainFile :: String -> IO ()+mainFile fileName = do+  putStrLn $ "--- opening " ++ show fileName ++ " ---"+  file <- readFile fileName+  let t = alexScanTokens file+  let cdecls =  parse t+  -- putStrLn "--- parsing ---"+  -- mapM (putStrLn . show) cdecls+  putStrLn "--- scope checking ---"+  adecls <- doScopeCheck cdecls+  -- mapM (putStrLn . show) adecls+  putStrLn "--- type checking ---"+  (edecls, sig) <- doTypeCheck adecls+  putStrLn "--- evaluating ---"+  showAll sig adecls+{-+  putStrLn "--- extracting ---"+  edecls <- doExtract sig edecls+  hsmodule <- doTranslate edecls+  putStrLn $ H.prettyPrint hsmodule+  -- printHsDecls hsdecls+-}+  putStrLn $ "--- closing " ++ show fileName ++ " ---"++-- print extracted program++ppHsMode :: H.PPHsMode+ppHsMode = H.PPHsMode  -- H.defaultMode+  { H.classIndent  = 2+  , H.doIndent     = 3+  , H.caseIndent   = 3+  , H.letIndent    = 4+  , H.whereIndent  = 2+  , H.onsideIndent = 1+  , H.spacing      = False+  , H.layout       = H.PPOffsideRule+  , H.linePragmas  = False+  }++printHsDecls :: [H.Decl] -> IO ()+printHsDecls hs = mapM_ (putStrLn . H.prettyPrintWithMode ppHsMode) hs++-- all let declarations+allLet :: Signature -> [A.Declaration] -> [(Name,A.Expr)]+allLet sig [] = []+allLet sig (decl:xs) =+    case decl of+      (A.LetDecl True n tel _ e) | null tel ->+          (n,e):(allLet sig xs)+      _ -> allLet sig xs+++showAll :: Signature -> [A.Declaration] -> IO ()+showAll sig decl = mapM_ (showLet sig) $ allLet sig decl++showLet :: Signature -> (Name,A.Expr) -> IO ()+showLet sig (n,e) = do+  r <- doWhnf sig e+  case r of+    Right (v,_) -> putStrLn $ show n ++ " has whnf " ++ show v+    Left err    -> do putStrLn $ "error during evaluation:\n" ++ show err+                      exitFailure+  r <- doNf sig e+  case r of+    Right (v,_) -> putStrLn $ show n ++ " evaluates to " ++ show v+    Left err    -> do putStrLn $ "error during evaluation:\n" ++ show err+                      exitFailure++doExtract :: Signature -> [A.EDeclaration] -> IO [A.EDeclaration]+doExtract sig decls = do+  k <- runExtract sig $ extractDecls decls+  case k of+    Left err -> do+      putStrLn $ "error during extraction:\n" ++ show err+      exitFailure+    Right (hs, _) ->+      return hs++doTranslate :: [A.EDeclaration] -> IO H.Module+doTranslate decls = do+  k <- runTranslate $ translateModule decls+  case k of+    Left err -> do+      putStrLn $ "error during extraction:\n" ++ show err+      exitFailure+    Right hs ->+      return hs++doTypeCheck :: [A.Declaration] -> IO ([A.EDeclaration], Signature)+doTypeCheck decls = do+  k <- typeCheck decls+  case k of+    Left err -> do+      putStrLn $ "error during typechecking:\n" ++ show err+      exitFailure+    Right (edecls, st) ->+      return (edecls, signature st)++doScopeCheck :: [C.Declaration] -> IO [A.Declaration]+doScopeCheck decl = case scopeCheck decl of+     Left err -> do putStrLn $ "scope check error: " ++ show err+                    exitFailure+     Right (decl',_) -> return $ decl'
+ Makefile view
@@ -0,0 +1,111 @@+# Makefile for miniagda++files=Abstract Collection Concrete Eval Extract HsSyntax Lexer Main Parser Polarity PrettyTCM ScopeChecker Semiring SparseMatrix TCM Termination ToHaskell Tokens TraceError TreeShapedOrder TypeChecker Util Value Warshall+hsfiles=$(foreach file,$(files),$(file).hs)+ghcflags=-ignore-package monads-fd -rtsopts+# -fglasgow-exts +optflags=+# -O  #slow compilation, not much speedup+profflags=-prof -auto-all+distfiles=*.hs *.hs-boot Lexer.x Parser.y Makefile +distdirs=test/succeed test/fail examples++cabalp=cabal install -p --enable-executable-profiling++.PHONY : test succeed fail examples lib current default all clean veryclean++default : Main test+all : Main test examples lib++prof-current : miniagda-prof+	miniagda-prof examples/FiCS12/fics12-06.ma +RTS -prof -s+#	miniagda-prof test/succeed/Zero.ma +RTS -prof -s+#	miniagda-prof privateExamples/NisseContNorm/negative-2010-11-23.ma +RTS -prof+current : Main+#	Main test/fail/BoundedFake.ma+	Main examples/Existential/StreamProcCase.ma+#	Main test/features/Existential/list.ma+#	Main test/features/Existential/nat.ma+#	Main examples/RBTree/RBTreeConor.ma+#	Main test/fail/InvalidField.ma+#	Main test/succeed/BuiltinSigma.ma+#	Main test/features/records.ma+#	Main test/succeed/MeasuredHerSubst2.ma+#	Main examples/Coinductive/SubjectReductionProblem.ma+#	Main examples/Sized/Maximum.ma+#	Main examples/Irrelevance/Vector.ma+#	Main examples/JeffTerellCoqClub20100120.ma+#	Main examples/HugoCantor/tryLoopInjData.ma+#	Main examples/HugoCantor/InjDataLoop.ma+#	Main test/features/countConstructors.ma+#	Main examples/HugoCantor/injectiveData.ma+#	Main examples/BoveCapretta/Eval.ma # vec.ma # examples/List.ma+#	Main test/fail/OverlappingPatternIndFam.ma # vec.ma # examples/List.ma++# ship : ../dist/miniagda-2009-07-03.tgz # 06-27.tgz+# +# ../dist/%.tgz : $(distfiles)+# 	tar czf $@ $^ $(distdirs)+# ++miniagda-prof : Main.hs $(hsfiles)+	ghc $(ghcflags) $(profflags) $< --make -o $@++Main : Main.hs $(hsfiles)+	ghc $(ghcflags) $(optflags) $< --make -o $@++install-prof-libs :+	$(cabalp) transformers+	$(cabalp) mtl+	$(cabalp) syb+	$(cabalp) parsec+	$(cabalp) preprocessor-tools+	$(cabalp) cpphs+	$(cabalp) haskell-src-exts+	$(cabalp) IfElse+	$(cabalp) utility-ht++SCT : SCT.hs Lexer.hs SCTParser.hs SCTSyntax.hs+	ghc $(ghcflags) $< --make -o $@++Lexer.hs : Lexer.x+	alex $<++%arser.hs : %arser.y Lexer.hs+	happy --info=$<-grm.txt $<++test : Main succeed fail++succeed : +	@echo "======================================================================"+	@echo "===================== Suite of successfull tests ====================="+	@echo "======================================================================"+	make -C test/succeed++fail : +	@echo "======================================================================"+	@echo "======================= Suite of failing tests ======================="+	@echo "======================================================================"+	make -C test/fail++examples : Main+	@echo "======================================================================"+	@echo "========================== Suite of examples ========================="+	@echo "======================================================================"+	make -C examples++lib : Main+	@echo "======================================================================"+	@echo "=============================== Library =============================="+	@echo "======================================================================"+	make -C lib+++clean : +	-rm *.o *.hi Main miniagda-prof+# 	make -C test/fail clean++veryclean : clean+	make -C test/fail clean++# EOF
+ MiniAgda.cabal view
@@ -0,0 +1,88 @@+name:            MiniAgda+version:         0.2014.1.9+build-type:      Simple+cabal-version:   >= 1.8 +license:         OtherLicense+license-file:    LICENSE+author:          Andreas Abel and Karl Mehltretter+maintainer:      Andreas Abel <andreas.abel@ifi.lmu.de>+homepage:        http://www.tcs.ifi.lmu.de/~abel/miniagda/+bug-reports:     http://hub.darcs.net/abel/miniagda/issues+category:        Dependent types+synopsis:        A toy dependently typed programming language with type-based termination.+description:+  MiniAgda is a tiny dependently-typed programming language in the style+  of Agda. It serves as a laboratory to test potential additions to the+  language and type system of Agda. MiniAgda's termination checker is a+  fusion of sized types and size-change termination and supports+  coinduction. Equality incorporates eta-expansion at record and+  singleton types. Function arguments can be declared as static; such+  arguments are discarded during equality checking and compilation.++  Recent features include bounded size quantification and destructor+  patterns for a more general handling of coinduction. ++tested-with:        GHC == 7.6.3++extra-source-files: Makefile++data-files:         test/succeed/Makefile+                    test/succeed/*.ma+                    test/fail/Makefile+                    test/fail/*.ma+                    test/fail/*.err+                    test/fail/adm/*.ma+                    test/fail/adm/*.err+                    lib/*.ma+source-repository head+  type:     darcs+  location: http://hub.darcs.net/abel/miniagda++executable miniagda+  hs-source-dirs:   .+  build-depends:    array >= 0.3 && < 0.5,+                    base >= 4.2 && < 4.7,+                    containers >= 0.3 && < 0.6,+                    haskell-src-exts >= 1.14 && < 1.15,+                    -- mtl-2.1 contains a severe bug+                    mtl >= 2.0 && < 2.1 || >= 2.1.1 && < 2.2,+                    pretty >= 1.0 && < 1.2,+--                    utility-ht >= 0.0.1 && < 1.0,+                    IfElse >= 0.85 && < 2.0+  build-tools:      happy >= 1.15 && < 2,+                    alex >= 3.0 && < 4+  extensions:       CPP+                    MultiParamTypeClasses+                    TypeSynonymInstances+                    FlexibleInstances+                    FlexibleContexts+                    GeneralizedNewtypeDeriving+                    NoMonomorphismRestriction+                    PatternGuards+                    TupleSections+                    NamedFieldPuns+  main-is:          Main.hs+  other-modules:    Abstract+                    Collection+                    Concrete+                    Eval+                    Extract+                    HsSyntax+                    Lexer+                    Main+                    Parser+                    Polarity+                    PrettyTCM+                    ScopeChecker+                    Semiring+                    SparseMatrix+                    TCM+                    Termination+                    ToHaskell+                    Tokens+                    TraceError+                    TreeShapedOrder+                    TypeChecker+                    Util+                    Value+                    Warshall
+ Parser.y view
@@ -0,0 +1,520 @@+{+{-# LANGUAGE BangPatterns #-}+module Parser where++import qualified Lexer as T+import qualified Concrete as C++import Abstract (Decoration(..),Dec,defaultDec,Override(..))+import Polarity (Pol(..))+import qualified Abstract as A+import qualified Polarity as A+import Concrete (Name,patApp)+}++%name parse+%tokentype { T.Token }+%error { parseError }++%token++id      { T.Id $$ _ }+qualid  { T.QualId $$ _ }+number  { T.Number $$ _ }+data    { T.Data _ }+codata  { T.CoData _ }+record  { T.Record _ }+sized   { T.Sized _ }+fields  { T.Fields _ }+mutual  { T.Mutual _ }+fun     { T.Fun _ }+cofun   { T.CoFun _ }+pattern { T.Pattern _ }+case    { T.Case _ }+def     { T.Def _ }+let     { T.Let _ }+in      { T.In _ }+eval    { T.Eval _ }+fail    { T.Fail _ }+check   { T.Check _ }+trustme { T.TrustMe _ }+impredicative { T.Impredicative _ }+type    { T.Type _ }+set     { T.Set _ }+coset   { T.CoSet _ }+size    { T.Size _ }+infty   { T.Infty _ }+succ    { T.Succ _ }+max     { T.Max _ }+'<|'    { T.LTri _ }+'|>'    { T.RTri _ }+'<'     { T.AngleOpen _ }+'>'     { T.AngleClose _ }+'{'     { T.BrOpen _ }+'}'     { T.BrClose _ }+'['     { T.BracketOpen _ }+']'     { T.BracketClose _ }+'('     { T.PrOpen _ }+')'     { T.PrClose _ }+'|'     { T.Bar _ }+','     { T.Comma _ }+';'     { T.Sem _ }+':'     { T.Col _ }+'.'     { T.Dot _ }+'->'    { T.Arrow _ }+'<='    { T.Leq _ }+'='     { T.Eq _ }+'++'    { T.PlusPlus _ }+'+'     { T.Plus _ }+'-'     { T.Minus _ }+'/'     { T.Slash _ } -- UNUSED+'*'     { T.Times _ } -- UNUSED+'^'     { T.Hat _ }+'&'     { T.Amp _ }+'\\'    { T.Lam _ }+'_'     { T.Underscore _ }++%%++TopLevel :: { [C.Declaration] }+TopLevel : Declarations { reverse $1}+++Declarations :: { [C.Declaration] }+Declarations : {- empty -} { [] }+             | Declarations Declaration { $2 : $1 }++Declaration :: { C.Declaration }+Declaration : Data                      { $1 }+           | CoData                     { $1 }+           | SizedData                  { $1 }+           | SizedCoData                { $1 }+           | RecordDecl                 { $1 }+           | Fun                        { $1 }+           | CoFun                      { $1 }+           | Mutual                     { $1 }+           | Let                        { $1 }+           | PatternDecl                { $1 }+           | impredicative Declaration          { C.OverrideDecl Impredicative [$2] }+           | impredicative '{' Declarations '}' { C.OverrideDecl Impredicative $3 }+           | fail Declaration             { C.OverrideDecl Fail [$2] }+           | fail '{' Declarations '}'    { C.OverrideDecl Fail $3 }+           | check Declaration            { C.OverrideDecl Check [$2] }+           | check '{' Declarations '}'   { C.OverrideDecl Check $3 }+           | trustme Declaration          { C.OverrideDecl TrustMe [$2] }+           | trustme '{' Declarations '}' { C.OverrideDecl TrustMe $3 }+{-+Data :: { C.Declaration }+Data : data Id DataTelescope ':' Expr '{' Constructors '}' OptFields+   { C.DataDecl $2 A.NotSized A.Ind $3 $5 (reverse $7) $9 }++SizedData :: { C.Declaration }+SizedData : sized data Id DataTelescope ':' Expr '{' Constructors '}' OptFields+   { C.DataDecl $3 A.Sized A.Ind $4 $6 (reverse $8) $10 }++CoData :: { C.Declaration }+CoData : codata Id DataTelescope ':' Expr '{' Constructors '}' OptFields+       { C.DataDecl $2 A.NotSized A.CoInd $3 $5 (reverse $7) $9 }++SizedCoData :: { C.Declaration }+SizedCoData : sized codata Id DataTelescope ':' Expr '{' Constructors '}' OptFields+       { C.DataDecl $3 A.Sized A.CoInd $4 $6 (reverse $8) $10 }++RecordDecl :: { C.Declaration }+RecordDecl : record Id DataTelescope ':' Expr '{' Constructor '}'  OptFields+   { C.RecordDecl $2 $3 $5 $7 $9 }+-}++Data :: { C.Declaration }+Data : data DataDef+  { let (n,tel,t,cs,fs) = $2 in C.DataDecl n A.NotSized A.Ind tel t cs fs }++SizedData :: { C.Declaration }+SizedData : sized data DataDef+  { let (n,tel,t,cs,fs) = $3 in C.DataDecl n A.Sized A.Ind tel t cs fs }++CoData :: { C.Declaration }+CoData : codata DataDef+  { let (n,tel,t,cs,fs) = $2 in C.DataDecl n A.NotSized A.CoInd tel t cs fs }++SizedCoData :: { C.Declaration }+SizedCoData : sized codata DataDef+  { let (n,tel,t,cs,fs) = $3 in C.DataDecl n A.Sized A.CoInd tel t cs fs }++RecordDecl :: { C.Declaration }+RecordDecl : record DataDef1+  { let (n,tel,t,c,fs) = $2 in C.RecordDecl n tel t c fs }++DataDef :: { (C.Name, C.Telescope, C.Type, [C.Constructor], [C.Name]) }+DataDef : Id DataTelescope ':' Expr '{' Constructors '}' OptFields+            { ($1, $2, $4, reverse $6, $8)}+        | Id DataTelescope '{' Constructors '}' OptFields+            { ($1, $2, C.set0, reverse $4, $6)}++DataDef1 :: { (C.Name, C.Telescope, C.Type, C.Constructor, [C.Name]) }+DataDef1 : Id DataTelescope ':' Expr '{' Constructor '}' OptFields+            { ($1, $2, $4, $6, $8)}+         | Id DataTelescope '{' Constructor '}' OptFields+            { ($1, $2, C.set0, $4, $6)}++Fun :: { C.Declaration }+Fun : fun TypeSig '{' Clauses '}' { C.FunDecl A.Ind $2 $4 }++CoFun :: { C.Declaration }+CoFun : cofun TypeSig '{' Clauses '}' { C.FunDecl A.CoInd $2 $4  }++Mutual :: { C.Declaration }+Mutual : mutual '{' Declarations '}' { C.MutualDecl (reverse $3) }++Let :: { C.Declaration }+Let : Eval let LetDef { C.LetDecl $1 $3 }++{-+Let : Eval let Id Telescope TypeOpt '=' ExprT { C.LetDecl $1 $3 $4 $5 $7 }+-- Let : Eval let Id Telescope ':' Expr '=' ExprT { C.LetDecl $1 $3 $4 $6 $8 }+-}++LetDef :: { C.LetDef }+LetDef : PolId Telescope TypeOpt '=' ExprT { let (dec,n) = $1 in C.LetDef dec n $2 $3 $5 }++Eval :: { Bool }+Eval : {- nothing -}  { False }+     | eval           { True  }++TypeOpt :: { Maybe C.Type }+TypeOpt : {- nothing -} { Nothing }+        | ':' Expr      { Just $2 }++{-+Let :: { C.Declaration }+Let : let TypeSig '=' ExprT { C.LetDecl False $2 $4 }+      | eval let TypeSig '=' ExprT { C.LetDecl True $3 $5 }+-}++PatternDecl :: { C.Declaration }+PatternDecl : pattern SpcIds '=' PairP { C.PatternDecl (head $2) (tail $2) $4 }+++OptFields :: { [Name] }+OptFields : {- empty -}  { [] }+          | fields Ids   { $2 }+-----++Id :: { Name }+Id : id { C.Name $1 }+-- no longer  number { $1 }++SpcIds :: { [Name] } -- non-empty list+SpcIds : Id     { [$1] }+       | Id SpcIds { $1 : $2 }++Ids :: { [Name] } -- non-empty list+Ids : Id              { [$1] }+    | Id ',' Ids { $1 : $3 }++Pol :: { Pol }+Pol : '++'         { SPos  }+    | '+'          { Pos   }+    | '-'          { Neg   }+    | '.'          { Const } -- use bracket [..]+    | '^'          { Param }+    | '*'          { Rec   } -- recursive+--    | {- empty -}  { Mixed }++Measure :: { A.Measure C.Expr }+Measure : '|' Meas { A.Measure $2 }++Meas :: { [C.Expr] }+Meas : Expr '|'      { [$1] }+     | Expr ',' Meas { $1 : $3 }++Bound :: { A.Bound C.Expr }+Bound : Measure '<' Measure { A.Bound A.Lt $1 $3 }+      | Measure '<=' Measure { A.Bound A.Le $1 $3 } {- (A.succMeasure C.Succ $3) } -}++EIds :: { [Name] } -- non-empty list+EIds : ExprList       { let { f (C.Ident (C.QName x)) = x+                            ; f e = error ("not an identifier: " ++ C.prettyExpr e)+                            } in map f $1+                      }++Telescope :: { C.Telescope }+Telescope :  {- empty -}          { [] }+              | TBind Telescope { $1 : $2 }+              | Measure Telescope { C.TMeasure $1 : $2 }++-- Binding.+TBind :: { C.TBind }+TBind+  :     '(' EIds ':' Expr ')' { C.TBind   (Dec Default) $2      $4 }+  |     '(' Id  '<'  Expr ')' { C.TBounded A.defaultDec $2 A.Lt $4 }+  |     '(' Id  '<=' Expr ')' { C.TBounded A.defaultDec $2 A.Le $4 }+  | Pol '(' EIds ':' Expr ')' { C.TBind    (Dec $1)     $3      $5 }+  | Pol '(' Id  '<'  Expr ')' { C.TBounded (Dec $1)     $3 A.Lt $5 }+  | Pol '(' Id '<='  Expr ')' { C.TBounded (Dec $1)     $3 A.Le $5 }+  | EBind                     { $1 }+  | HBind                     { $1 }++-- Erased binding+EBind :: { C.TBind }+EBind+  : '[' Ids ':' Expr ']' { C.TBind    A.irrelevantDec $2      $4 }+  | '[' Id '<'  Expr ']' { C.TBounded A.irrelevantDec $2 A.Lt $4 }+  | '[' Id '<=' Expr ']' { C.TBounded A.irrelevantDec $2 A.Le $4 }++-- Hidden binding+HBind :: { C.TBind }+HBind+  : '{' Ids ':' Expr '}' { C.TBind    A.Hidden $2      $4 }+  | '{' Id '<'  Expr '}' { C.TBounded A.Hidden $2 A.Lt $4 }+  | '{' Id '<=' Expr '}' { C.TBounded A.Hidden $2 A.Le $4 }+++UntypedBind :: { C.LBind }+UntypedBind : Id              { C.TBind A.defaultDec [$1] Nothing }+            | '[' Id ']'      { C.TBind A.irrelevantDec [$2] Nothing }+            | Pol Id          { C.TBind (Dec $1) [$2] Nothing }+            | Pol '(' Id ')'  { C.TBind (Dec $1) [$3] Nothing }++PolId :: { (Dec, C.Name) }+PolId : Id              {  (A.defaultDec   , $1) }+      | '[' Id ']'      {  (A.irrelevantDec, $2) }+      | Pol Id          {  (Dec $1         , $2) }++LLetDef :: { C.LetDef }+LLetDef : LetDef        { $1 }+-- legacy forms+        |  '[' Id ':' Expr ']' '=' Expr     { C.LetDef A.irrelevantDec $2 [] (Just $4) $7 }  -- erased binding+        |  Pol '(' Id ':' Expr ')' '=' Expr { C.LetDef (Dec $1) $3 [] (Just $5) $8 } -- ordinary binding++-- let binding+LBind :: { C.LBind }+LBind :  UntypedBind         { $1 }+      |  Id ':' Expr         { C.TBind A.defaultDec [$1] (Just $3) } -- ordinary binding+      |  '(' Id ':' Expr ')' { C.TBind A.defaultDec [$2] (Just $4) } -- ordinary binding+      |  '[' Id ':' Expr ']' { C.TBind A.irrelevantDec [$2] (Just $4) }  -- erased binding+      |  Pol '(' Id ':' Expr ')' { C.TBind (Dec $1) [$3] (Just $5) } -- ordinary binding+--      |  Pol '[' Id ':' Expr ']' { C.TBind (Dec True $1) [$3] $5 }  -- erased binding++Domain :: { C.Telescope }+Domain : Expr0             { [C.TBind (Dec Default) {- A.defaultDec -} [] $1] }+       | '[' Expr ']'      { [C.TBind A.irrelevantDec [] $2] }+       | Pol Expr0         { [C.TBind (Dec $1) [] $2] }+--       | Pol '[' Expr ']'  { [C.TBind (Dec True  $1) [] $3] }+       | TBind             { [$1] }+       | Measure           { [C.TMeasure $1] }+       | Bound             { [C.TBound $1] }+       | Telescope         { $1 }+++-- expressions which can be tuples e , e'+ExprT :: { C.Expr}+ExprT : ExprList           { foldr1 C.Pair $1 }++ExprList :: { [C.Expr] }+ExprList : Expr               { [$1] }+         | Expr ',' ExprList     { $1 : $3 }+++-- general form of expression+Expr :: { C.Expr }+Expr : Domain '->' Expr                 { C.Quant A.Pi $1 $3 }+     | '\\' SpcIds '->' ExprT           { foldr C.Lam $4 $2 }+     | let LLetDef in ExprT             { C.LLet $2 $4 }+     | case ExprT TypeOpt '{' Cases '}' { C.Case $2 $3 $5 }+     | Expr0                            { $1 }                -- Sigma type+     | Expr1 '+' Expr                   { C.Plus $1 $3 }+     | Expr1 '<|' Expr                  { C.App $1 [$3] }+     | Expr1 '|>' Expr                  { C.App $3 [$1] }++-- Sigma types (A & B, (x : A) & B)+Expr0 :: { C.Expr }+Expr0 : Expr1                            { $1 }+      | SigDom '&' Expr0                 { C.Quant A.Sigma [$1] $3 }++-- SigDom ~ Domain, but no Telescope and no Expr0+SigDom :: { C.TBind }+SigDom : Expr1             { C.TBind (Dec Default) {- A.defaultDec -} [] $1 }+       | '[' Expr ']'      { C.TBind A.irrelevantDec [] $2 }+       | Pol Expr1         { C.TBind (Dec $1) [] $2 }+--       | Pol '[' Expr ']'  { C.TBind (Dec True  $1) [] $3 }+       | TBind             { $1 }+       | Measure           { C.TMeasure $1 }+       | Bound             { C.TBound $1   }  -- constraint++-- perform applications+Expr1 :: { C.Expr }+Expr1 : Expr2 { let (f : args) = reverse $1 in+                if null args then f else C.App f args+	      }+       | coset Expr3      { C.CoSet $2 }+       | set              { C.Set C.Zero }+       | set Expr3        { C.Set $2 }+       | number '*' Expr1 { let n = read $1 in+                            if n==0 then C.Zero else+                            iterate (C.Plus $3) $3 !! (n-1) }+--       | EBind Expr1      { C.EBind $1 $2 }++-- gather applications+Expr2 :: { [C.Expr] }+Expr2 : Expr3 { [$1] }+       | Expr2 Expr3 { $2 : $1 }+       | Expr2 '.' Id { C.Proj $3 : $1 }+       | Expr2 set   { C.Set C.Zero : $1 }+--       | succ SE { [C.Succ $2] }++-- atoms+Expr3 :: { C.Expr }+Expr3 : size                      { C.Size }+      | max                       { C.Max }+      | infty                     { C.Infty }+      | QName                     { C.Ident $1}+      | '<' ExprT ':' Expr '>'    { C.Sing $2 $4 }+      | '(' ExprT ')'             { $2 }+      | '_'                       { C.Unknown }+      | succ Expr3                { C.Succ $2 }  -- succ is a prefix op+      | number                    { iterate C.Succ C.Zero !! (read $1) }+      | record '{' RecordDefs '}' { C.Record $3 }++QName :: { C.QName }+QName : qualid { let (m,n) = $1 in C.Qual (C.Name m) (C.Name n) }+      | Id     { C.QName $1}++{-+-- general form of type expression+Type :: { C.Expr }+Type : Domain '->' Type                 { C.Quant A.Pi $1 $3 }+     | let LBind '=' ExprT in Type      { C.LLet $2 $4 $6 }+     | case ExprT '{' Cases '}'         { C.Case $2 $4 }+     | Type1                            { $1 }++-- perform applications+Type1 :: { C.Expr }+Type1 : Type2 { let (f : args) = reverse $1 in+                if null args then f else C.App f args+	      }+       | coset Expr3                      { C.CoSet $2 }+       | set                              { C.Set C.Zero }+       | set Expr3                        { C.Set $2 }+       | Domain '&' Type1                 { C.Quant A.Sigma $1 $3 }++-- gather applications+Type2 :: { [C.Expr] }+Type2 : Type3 { [$1] }+      | Type2 Expr3 { $2 : $1 }+      | Type2 '.' Id { C.Proj $3 : $1 }+      | Type2 set   { C.Set C.Zero : $1 }++-- type atoms+Type3 :: { C.Expr }+Type3 : size                      { C.Size }+      | Id                        { C.Ident $1}+      | '(' Type ')'              { $2 }+      | '_'                       { C.Unknown }+-}++RecordDefs :: { [([Name],C.Expr)] }+RecordDefs+  : RecordDef ';' RecordDefs   { $1 : $3 }+  | RecordDef                  { [$1] }+  | {- empty -}                { [] }++RecordDef :: { ([Name],C.Expr) }+RecordDef : SpcIds '=' ExprT    { ($1,$3) }++TypeSig :: { C.TypeSig }+TypeSig : Id ':' Expr { C.TypeSig $1 $3 }++Constructor :: { C.Constructor }+Constructor : Id Telescope ':' Expr { C.Constructor $1 $2 (Just $4) }+            | Id Telescope          { C.Constructor $1 $2 Nothing }++Constructors :: { [C.Constructor ] }+Constructors :+      Constructors ';' Constructor { $3 : $1 }+    | Constructors ';' { $1 }+    | Constructor { [$1] }+    | {- empty -} { [] }++Cases :: { [C.Clause] }+Cases : Pattern '->' ExprT ';' Cases  { (C.Clause Nothing [$1] (Just $3)) : $5 }+      | Pattern '->' ExprT            { (C.Clause Nothing [$1] (Just $3)) : [] }+      | Pattern ';' Cases             { (C.Clause Nothing [$1] Nothing) : $3 }+      | Pattern                       { (C.Clause Nothing [$1] Nothing) : [] }+      | {- empty -}                   { [] }++Clause :: { C.Clause }+Clause : Id LHS '=' ExprT { C.Clause (Just $1) $2 (Just $4) }+       | Id LHS           { C.Clause (Just $1) $2 Nothing }++LHS :: { [C.Pattern] }+LHS : Patterns { reverse $1 }++Patterns :: { [C.Pattern] }+Patterns : {- empty -} { [] }+--    | Pattern Patterns { $1 : $2 }+    | Patterns Pattern { $2 : $1 }+    | Patterns '<|' ElemP { $3 : $1 }++-- atomic patterns+Pattern :: { C.Pattern }+Pattern : '(' ')'            { C.AbsurdP     }+        | '(' PairP ')'      { $2            }+        | DotId              { $1            }+        | succ Pattern       { C.SuccP $2    }+        | '.' set            { C.DotP (C.Set C.Zero) }+        | '.' Expr3          { C.DotP $2     }++-- pattern tuples+PairP :: { C.Pattern }+PairP : ElemP ',' PairP     { C.PairP $1 $3 }+      | ElemP               { $1 }++ElemP :: { C.Pattern }+ElemP : ConP                { $1 }+      | Expr3 '>' Id        { C.SizeP $1 $3 }+      | Id '<' Expr3        { C.SizeP $3 $1 }+      | Pattern             { $1 }+      | ConP '<|' ElemP     { patApp $1 [$3] } -- '<|' is Haskell's '$' (appl.)++-- constructor with at least one argument pattern+ConP :: { C.Pattern }+ConP : DotId Pattern       { patApp $1 [$2] }+     | ConP Pattern        { patApp $1 [$2] }++DotId :: { C.Pattern }+DotId : Id                 { C.IdentP (C.QName $1) }+      | '.' Id             { C.ConP True (C.QName $2) [] }+++Clauses :: { [C.Clause] }+Clauses : RClauses { reverse $1 }++RClauses :: { [C.Clause ] }+RClauses+ : RClauses ';' Clause { $3 : $1 }+ | RClauses ';'        { $1      }+ | Clause              { [$1]    }+ | {- empty -}         { []      }++-- Binding in data telescope, supports (+ X : Set) for backwards compatibility+TBindSP :: { C.TBind }+TBindSP+  :     '(' Ids ':' Expr ')' { C.TBind (Dec Default) $2 $4 } -- ordinary binding+  |     '[' Ids ':' Expr ']' { C.TBind A.irrelevantDec $2 $4 }  -- erased bind.+  | Pol '(' Ids ':' Expr ')' { C.TBind (Dec $1) $3 $5 }+  | '(' '+' Ids ':' Expr ')' { C.TBind (Dec SPos) $3 $5 }++--  | '(' sized Id ')'     { C.TSized $3 }++DataTelescope :: { C.Telescope }+DataTelescope :  {- empty -}          { [] }+              | TBindSP DataTelescope { $1 : $2 }++{++parseError :: [T.Token] -> a+parseError [] = error "Parse error at EOF"+parseError (x : xs) = error ("Parse error at token " ++ T.prettyTok x)++}
+ Polarity.hs view
@@ -0,0 +1,421 @@+{- In the context of polarities, we use "recursive" in the sense of+"computable" rather than syntactic recursion. -}++module Polarity where++import Util+import Warshall++import Data.Map (Map)+import qualified Data.Map as Map+import qualified Data.List as List++{- 2010-10-09 Fusing polarity and irrelevance++     .      constant (= irrelevant) function+    / \+  ++   |    strictly positive function (types only)+   |   |+   +   -    positive/negative function (types only)+    \ /+     ^      parametric function (lambda cube), default for types+     |+     *      recursive function (pattern matching), default for terms+++ Composition (AC)++  . p = .+  * p = *  (p not .)+  ^ p = ^  (p not .,*)+ ++ p = p+  + p = p  (p not ++)+  - - = +++Equality/subtyping <=p++  x <=. y  iff  true+  x <=- y  iff  x >= y+  x <=^ y  iff  x == y+  x <=* y  iff  x == y+ -}++-- polarities and strict positivity ----------------------------------++class Polarity pol where+  erased    :: pol -> Bool+  compose   :: pol -> pol -> pol+  neutral   :: pol                 -- ^ neutral for compose.+  promote   :: pol -> pol+  demote    :: pol -> pol+  hidden    :: pol                 -- ^ corresponding to hidden quantification++type PVarId = Int++data Pol+  = Const -- non-occurring, irrelevant+  | SPos  -- strictly positive+  | Pos   -- positive+  | Neg   -- negative, used internally for contravariance of sized codata+  | Param -- parametric (lambda) function+  | Rec   -- recursive (takes decision)+  | Default     -- no polarity given (for parsing)+  | PVar PVarId -- flexible polarity variable+         deriving (Eq,Ord)++mixed = Rec+defaultPol = Rec+{-+mixed = Param -- TODO: Rec+defaultPol = Param -- TODO: Rec+-}+instance Polarity Pol where+  erased  = (==) Const+  compose = polComp+  neutral = SPos+  promote = invComp Const+  demote  = invComp Rec+  hidden  = Const++instance Show Pol where+  show Const = "."+  show SPos  = "++"+  show Pos   = "+"+  show Neg   = "-"+  show Param = "^"+  show Rec   = "*"+  show Default = "{default polarity}"+  show (PVar i) = showPVar i++showPVar i = "?p" ++ show i++isPVar (PVar{}) = True+isPVar _ = False++-- information ordering+leqPol :: Pol -> Pol -> Bool+leqPol x Const  = True   -- Const is top+leqPol Const x  = False+leqPol Rec y    = True   -- Rec is bottom+leqPol x Rec    = False+leqPol Param y  = True   -- Param is second bottom+leqPol x Param  = False+leqPol Pos SPos = True+leqPol x   y    = x == y++{- RETIRED+isSPos :: Pol -> Bool+isSPos SPos = True+isSPos Const = True+isSPos _ = False+-}++{- NOT USED+isPos :: Pol -> Bool+isPos Pos = True+isPos x = isSPos x+-}++-- polarity negation+-- used in Eval.hs leqVals' for switching sides+-- this means it is only applied to Pos, Neg, Param,+-- never to SPos, Const, or polarity expressions+polNeg :: Pol -> Pol+polNeg Const  = Const+polNeg SPos  = Neg+polNeg Pos   = Neg+polNeg Neg   = Pos+polNeg Param = Param+polNeg Rec   = Rec++-- polarity composition+-- used in Eval.hs leqVals'+polComp :: Pol -> Pol -> Pol+polComp Const  x  = Const   -- most dominant+polComp x Const   = Const+polComp Rec x     = Rec  -- dominant except for Const+polComp x Rec     = Rec+polComp Param x   = Param  -- dominant except for Const, Rec+polComp x Param   = Param+polComp SPos  x   = x      -- neutral+polComp x SPos    = x+polComp Pos  x    = x      -- neutral except for SPos+polComp x Pos     = x+polComp Neg Neg   = Pos    -- order 2+{- pol.comp. is ass., comm., with neutral ++, and infinity Const+   cancellation does not hold, since composition with anything by ++ is+   information loss:+     q p <= q p' ==> p <= p'+   only if q = ++ (then it is trivial anyway) -}++-- polarity inverse composition (see Abel, MSCS 2008)+-- invComp p q1 <= q2  <==> q1 <= polComp p q2+-- used in TCM.hs cxtApplyDec+invComp :: Pol -> Pol -> Pol+invComp Rec   Rec   = Rec       -- in rec. arg. keep only rec. vars+invComp Rec   x     = Const     -- all others are declared unusable+invComp Param Param = Param     -- in parametric mixed arg, keep only mixed vars+invComp Param x     = Const+invComp Const x     = Param     -- a constant function can take any argument+invComp SPos  x     = x         -- SPos is the identity+invComp p     SPos  = Const     -- SPos preserved only under SPos+invComp Pos   x     = x         -- x not SPos+invComp Neg   x     = polNeg x  -- x not SPos++{- UNUSED+invCompExpr :: Pol -> PExpr -> PExpr+invCompExpr q (PValue p)   = PValue $ invComp q p+invCompExpr q (PExpr q' i) = PExpr (polComp q q') i+-}++-- polarity conjuction (infimum)+-- used in comparing spines+polAnd :: Pol -> Pol -> Pol+polAnd Const x = x      -- most information+polAnd x Const = x+polAnd Rec   x = Rec   -- least information+polAnd x   Rec = Rec+{-+polAnd Param x  = Param   -- 2nd least information+polAnd x Param  = Param+-}+polAnd x y | x == y = x       -- same information+polAnd SPos Pos = Pos     -- SPos is more informative than Pos+polAnd Pos SPos = Pos+{-+polAnd SPos Neg = Param+polAnd Neg SPos = Param+-}+polAnd _ _      = Param     -- remaining cases: conflicting info or Param++instance SemiRing Pol where+  oplus  = polAnd+  otimes = polComp+  ozero  = Const    -- dominant for composition, neutral for infimum+  oone   = SPos     -- neutral  for composition++-- computing a relation from <=+relPol :: Pol -> (a -> a -> Bool) -> (a -> a -> Bool)+relPol Const r a b = True+relPol Rec   r a b = r a b && r b a+relPol Param r a b = r a b && r b a+relPol Neg   r a b = r b a+relPol Pos   r a b = r a b+relPol SPos  r a b = r a b++relPolM :: (Monad m) => Pol -> (a -> a -> m ()) -> (a -> a -> m ())+relPolM Const r a b = return ()+relPolM Rec   r a b = r a b >> r b a+relPolM Param r a b = r a b >> r b a+relPolM Neg   r a b = r b a+relPolM Pos   r a b = r a b+relPolM SPos  r a b = r a b++-- polarity product (composition of polarities) ----------------------++data Multiplicity = POne | PTwo deriving (Eq, Ord)++instance Show Multiplicity where+  show POne = "1"+  show PTwo = "2"++-- addition modulo 2+addMultiplicity :: Multiplicity -> Multiplicity -> Multiplicity+addMultiplicity PTwo y = y+addMultiplicity x PTwo = x+addMultiplicity POne POne = PTwo++type VarMults = Map PVarId Multiplicity -- multiplicity of variables (1 or 2)++showMults :: VarMults -> String+showMults mults =+  let ml = Map.toList mults  -- get list of (key,value) pairs+      l  = concat $ map f ml where+             f (k, POne) = [k]+             f (k, PTwo) = [k,k]+  in Util.showList "." showPVar l++multsEmpty = Map.empty++multsSingle :: Int -> VarMults+multsSingle i = Map.insert i POne multsEmpty+++data PProd = PProd+  { coeff    :: Pol      -- a coefficient, excluding PVar+  , varMults :: VarMults -- multiplicity of variables (1 or 2)+  } deriving (Eq,Ord)++instance Polarity PProd where+  erased  = erased . coeff+  compose = polProd+  neutral = PProd SPos multsEmpty+  demote  = undefined+  promote = undefined+  hidden  = PProd hidden multsEmpty++instance Show PProd where+  show (PProd Const _) = show Const+  show (PProd SPos m) = if Map.null m then show SPos else showMults m+  show (PProd q m) = separate "." (show q) (showMults m)++pprod :: Pol -> PProd+pprod (PVar i) = PProd SPos (multsSingle i)+pprod q = PProd q multsEmpty++-- | fails if not a simple polarity+fromPProd :: PProd -> Maybe Pol+fromPProd (PProd Const _)          = Just Const+fromPProd (PProd p m) | Map.null m = Just p+fromPProd _                        = Nothing++isSPos :: PProd -> Bool+isSPos (PProd Const _) = True+isSPos (PProd SPos m) = Map.null m+isSPos _ = False++-- multiply two products++polProd :: PProd -> PProd -> PProd+polProd (PProd q1 m1) (PProd q2 m2) = PProd (polComp q1 q2) $+  Map.unionWith addMultiplicity m1 m2++-- polarity expressions are polynomials ------------------------------++data PPoly = PPoly { monomials :: [PProd] } deriving (Eq,Ord)++instance Show PPoly where+  show (PPoly []) = show Const+  show (PPoly [m]) = show m+  show (PPoly l)   = Util.showList "/\\" show l++ppoly :: PProd -> PPoly+ppoly (PProd Const _) = PPoly []+ppoly pp = PPoly [pp]++polSum :: PPoly -> PPoly -> PPoly+polSum (PPoly x) (PPoly y) = PPoly $ List.nub $ x ++ y++polProduct :: PPoly -> PPoly -> PPoly+polProduct (PPoly l1) (PPoly l2) =+  let ps = [ polProd x y | x <- l1, y <- l2]+  in PPoly $ List.nub $ ps++instance SemiRing PPoly where+  oplus  = polSum+  otimes = polProduct+  ozero  = PPoly []+  oone   = PPoly [PProd SPos Map.empty]++{-+data PExpr+  = PValue Pol     -- constant polarity+  | PExpr Pol Int  -- PExpr q pi means q^_1 pi  (pi is the number of the var)++-- a polarity variable+pvar :: Int -> PExpr+pvar = PExpr SPos  -- ++ is the neutral element of inverse polarity composition++instance Show PExpr where+  show (PValue p) = show p+  show (PExpr SPos i) = "?p" ++ show i+  show (PExpr q i) = show q ++ "^-1(?p" ++ show i ++ ")"+-}+++{- ML-style Polarity inference++Preliminaries:+1. constructor types are mixed-variant function types only+2. matching is only allowed on mixed-variant arguments+  1+2 are both consequences that only type-valued functions have variance+  and 1. data constructors are not types, 2. types are not matched on++Concrete syntax++  f : (xs : As) -> C   (C not a Pi-type)+  f = t++is parsed as abstract syntax++  f : pis(xs : As) -> C+  f = t++where pi_1..n are fresh polarity variables++Then t is type-checked to infer the polarity variables, e.g.++  f xs = t++  pis(xs : As) |- t : C++Now what can happen?++Variable:  t = x_i.  Then we add a constraint  pi_i <= ++++Application t = u v  where u : q(x:B) -> D++  q^-1(pis(xs: As)) |- v : B++  A term q^-1 pi arises where q is a polarity constant (!, ML-inference)+  or a polarity variable (recursion!, e.g. u = f)+  and pi is a polarity expression++In the context, keep SOLL and HABEN++  SOLL  is the original polarity (variable or constant)+  HABEN is a (ordered) list of pol.vars. and a pol.const. (default: ++)++Variable   : add constraint SOLL <= HABEN+Application: add q to HABEN by polarity multiplication (q is a var or const)+Abstraction: \xt : q(x:A) -> B:  continue with x (SOLL = q, HABEN = ++)++What kind of constraints do arise+1) q  <= pi    [ from variables , pi is a Pol-product ]+2) ++ <= pis  [ from positivity graph, pis is a sum of Pol-products ]+   this means ++ <= pi for all pi in pis++Solving constraints++- discard  o <= pi  and q <= /  (do not even need to add them)+- all pvars which are not bounded below (appearing in one q in 1)+  can be instantiated to /  which will remove some constraints+++-}++{- Mutual recursion++In mutual declarations, use the following Ansatz:  data/codata ++, functions o++  A = B -> A+  B = A -> B++A (B) is positive in its own body and negative in the body of B (A)++  F A B = B -> A   F(-,++)+  G A B = A -> B   G(-,++)++  F A B = G A B -> F A B+  G A B = F A B -> G A B++  Polarities:+  F : fa * -> fb * -> *+  G : ga * -> gb * -> *++  A : -fa, B : -fb |- G A B : *  ==> -fa <= ga, -fb <= gb+  A : -ga, B : -gb |- F A B : *  ==> -ga <= fa, -gb <= fb++-}++{- Pure polarity inference++Judgement:  pis(xs:As) |- t : B ---> C++Variable:   pis(xs:As) |- xi : Ai ---> pi_i <= ++++Application: Delta |- u : q(x:A) -> B ---> C1+             Delta |- v : A           ---> C2+             --------------------------------------------------+             Delta |- u v : B[u/x] ---> C1,C2,q(Delta) <= Delta+-}
+ PrettyTCM.hs view
@@ -0,0 +1,104 @@+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}+{-# LANGUAGE NoImplicitPrelude #-}++module PrettyTCM where++import Prelude hiding (sequence, mapM)++import Abstract+import {-# SOURCE #-} Eval+import {-# SOURCE #-} TCM+import qualified Util+import Value++import Control.Applicative hiding (empty)+import Control.Monad ((<=<))+import Data.Traversable++import qualified Text.PrettyPrint as P+++-- from Agda.TypeChecking.Pretty++type Doc = P.Doc++empty, comma, colon :: Monad m => m Doc++empty	   = return P.empty+comma	   = return P.comma+colon      = text ":"+pretty x   = return $ Util.pretty x+-- prettyA x  = P.prettyA x+text s	   = return $ P.text s+pwords s   = map return $ Util.pwords s+fwords s   = return $ Util.fwords s+sep ds	   = P.sep <$> sequence ds+fsep ds    = P.fsep <$> sequence ds+hsep ds    = P.hsep <$> sequence ds+vcat ds    = P.vcat <$> sequence ds+d1 $$ d2   = (P.$$) <$> d1 <*> d2+d1 <> d2   = (P.<>) <$> d1 <*> d2+d1 <+> d2  = (P.<+>) <$> d1 <*> d2+nest n d   = P.nest n <$> d+braces d   = P.braces <$> d+brackets d = P.brackets <$> d+parens d   = P.parens <$> d++prettyList ds = brackets $ fsep $ punctuate comma ds++punctuate _ [] = []+punctuate d ds = zipWith (<>) ds (replicate n d ++ [empty])+    where+	n = length ds - 1++-- monadic pretty printing++class ToExpr a where+  toExpression :: a -> TypeCheck Expr++instance ToExpr Expr where+  toExpression = return++instance ToExpr Val where+  toExpression = toExpr+++class PrettyTCM a where+  prettyTCM :: a -> TypeCheck Doc++instance PrettyTCM Name where+  prettyTCM = pretty++instance PrettyTCM Pattern where+  prettyTCM = pretty++instance PrettyTCM [Pattern] where+  prettyTCM = sep . map pretty++instance PrettyTCM Expr where+  prettyTCM = pretty++instance PrettyTCM (Sort Expr) where+  prettyTCM = pretty++instance PrettyTCM Val where+  prettyTCM = pretty <=< toExpr++instance PrettyTCM [Val] where+  prettyTCM = sep . map (pretty <=< toExpr)++instance PrettyTCM (Sort Val) where+  prettyTCM = pretty <=< mapM toExpr++instance PrettyTCM a => PrettyTCM (OneOrTwo a) where+  prettyTCM (One a)     = prettyTCM a+  prettyTCM (Two a1 a2) = prettyTCM a1 <+> text "||" <+> prettyTCM a2++instance (ToExpr a) => PrettyTCM (Measure a) where+  prettyTCM mu = pretty =<< mapM toExpression mu++instance (ToExpr a) => PrettyTCM (Bound a) where+  prettyTCM beta = pretty =<< mapM toExpression beta++instance (PrettyTCM a, PrettyTCM b) => PrettyTCM (a,b) where+  prettyTCM (a,b) = parens $ prettyTCM a <> comma <+> prettyTCM b
+ ScopeChecker.hs view
@@ -0,0 +1,1125 @@+-- NOTE: insertion of polarity variables disabled here, must be done+-- in TypeChecker++{-# LANGUAGE TupleSections, DeriveFunctor, GeneralizedNewtypeDeriving,+      FlexibleContexts, FlexibleInstances, UndecidableInstances,+      MultiParamTypeClasses #-}++module ScopeChecker (scopeCheck) where++import Prelude hiding (mapM, null)++import Control.Applicative -- <$>+import Control.Monad.IfElse+import Control.Monad.Identity hiding (mapM)+import Control.Monad.Reader hiding (mapM)+import Control.Monad.State hiding (mapM)+import Control.Monad.Error hiding (mapM)++import Data.List as List hiding (null)+import Data.Maybe+import Data.Traversable (mapM)++import Debug.Trace++import Polarity(Pol(..))+import qualified Polarity as A+import Abstract (Sized,mkExtRef,Co,ConK(..),PrePost(..),MVar,Decoration(..),Override(..),Measure(..),adjustTopDecsM,Arity,polarity,LensPol(..))+import qualified Abstract as A+import qualified Concrete as C++import TraceError++import Util++-- * scope checker+-- check that all identifiers are in scope and global identifiers are only used once+-- replaces Ident with Con, Def, Let or Var+-- replaces IdentP with ConP or VarP in patterns+-- replaces Unknown by a new Meta-Variable+-- check pattern length is equal in each clause+-- group mutual declarations++-- | Entry point for scope checker.+scopeCheck :: [C.Declaration] -> Either TraceError ([A.Declaration],SCState)+scopeCheck dl = runScopeCheck initCtx initSt (scopeCheckDecls dl)++-- * Local identifiers.++-- ** local environment of scope checker++data SCCxt = SCCxt+  { stack             :: Stack     -- ^ Local names in scope.+    -- We keep a stack of these to disallow shadowing on the same level.+  , defaultPolarity   :: Pol       -- ^ Replacement for @Default@ polarity.+  , constraintAllowed :: Bool      -- ^ Is a constraint @|m| < |m'|@ legal now, since we just parsed a quantifier?+  }++type Stack = [Context]++initCtx :: SCCxt+initCtx = SCCxt+  { stack             = [[]]  -- one empty context to begin with+  , defaultPolarity   = A.Rec -- POL VARS DISABLED!!+  , constraintAllowed = False+  }++-- ** A lens for @constraintAllowed@++class LensConstraintAllowed a where+  mapConstraintAllowed :: (Bool -> Bool) -> a -> a+  setConstraintAllowed :: Bool -> a -> a+  setConstraintAllowed b = mapConstraintAllowed (const b)++instance LensConstraintAllowed SCCxt where+  mapConstraintAllowed f sc = sc { constraintAllowed = f (constraintAllowed sc) }++instance (LensConstraintAllowed r, MonadReader r m) => LensConstraintAllowed (m a) where+  mapConstraintAllowed f = local (mapConstraintAllowed f)++-- ** Managing the stack of local contexts.++newLevel :: ScopeCheck a -> ScopeCheck a+newLevel = local $ \ cxt -> cxt { stack = [] : stack cxt }++thisLevel :: SCCxt -> Context+thisLevel cxt = head (stack cxt)++instance Push Local SCCxt where+  push nx sc = sc { stack = push nx (stack sc) }++-- ** translating concrete names to abstract names++type Local   = (C.Name,A.Name)+type Context = [Local]++emptyCtx :: Context+emptyCtx = []++newLocal :: Push Local b => C.Name -> b -> (A.Name, b)+newLocal n cxt = (x, push (n, x) cxt)+  where x = A.fresh $ C.theName n++lookupLocal :: C.Name -> ScopeCheck (Maybe A.Name)+lookupLocal n = retrieve n <$> asks stack++lookupGlobal :: C.QName -> ScopeCheck (Maybe DefI)+lookupGlobal n = lookupSig n <$> getSig++addContext :: Context -> SCCxt -> SCCxt+addContext delta sc = sc { stack = delta : stack sc }++-- * Global identifiers.++-- | Kind of identifier.+data IKind+  = DataK+  | ConK ConK+  | FunK Bool  -- ^ @False@ = inside body, @True@ = outside body+  | ProjK      -- ^ a record projection+  | LetK++-- | Global identifier.+data DefI = DefI { ikind :: IKind, aname :: A.QName }++-- | Scope check signature.+type Sig = [(C.QName,DefI)]++emptySig :: Sig+emptySig = []++lookupSigU :: C.Name -> Sig -> Maybe DefI+lookupSigU n = lookupSig (C.QName n)++lookupSig :: C.QName -> Sig -> Maybe DefI+lookupSig n [] = Nothing+lookupSig n ((x,k):xs) = if (x == n) then Just k else lookupSig n xs++-- ** State of scope checker.++data SCState = SCState+  { signature  :: Sig+  , nextMeta   :: MVar+  , nextPolVar :: MVar+  }++initSt = SCState emptySig 0 0++-- * The scope checking monad.++-- | Scope checking monad.+--+-- Reader monad for local environment of variables (used in expresssions and patterns).+-- State monad (hidden) for global signature.+-- Error monad for reporting scope violations.+newtype ScopeCheck a = ScopeCheck { unScopeCheck ::+  ReaderT SCCxt (StateT SCState (ErrorT TraceError Identity)) a }+  deriving (Functor, Applicative, Monad,+    MonadReader SCCxt, MonadError TraceError)++runScopeCheck+  :: SCCxt          -- ^ Local variable mapping.+  -> SCState        -- ^ Global identifier mapping.+  -> ScopeCheck a   -- ^ The computation.+  -> Either TraceError (a, SCState)+runScopeCheck ctx st (ScopeCheck sc) = runIdentity $ runErrorT $+  runStateT (runReaderT sc ctx) st++-- ** Local state.++-- | Add a local identifier.+--   (Not tail recursive, since it also returns the generate id.)+addBind' :: Show e => e -> C.Name -> (A.Name -> ScopeCheck a) -> ScopeCheck (A.Name, a)+addBind' e n k = do+  ctx <- ask+  case retrieve n (thisLevel ctx) of+    Just _  -> errorAlreadyInContext e n+    Nothing -> do+      let (x, ctx') = newLocal n ctx -- addCtx' n ctx+      a <- local (const ctx') $ k x+      return (x, a)++addBind :: Show e => e -> C.Name -> ScopeCheck a -> ScopeCheck (A.Name, a)+addBind e n k = addBind' e n $ const k++addBinds :: Show e => e -> [C.Name] -> ScopeCheck a -> ScopeCheck ([A.Name], a)+addBinds e ns k = foldr step start ns where+  start    = do+    a <- k+    return ([], a)+  step n k = do+    (x, (xs, a)) <- addBind e n k+    return (x:xs, a)++-- | Add local variable without checking shadowing.+addLocal :: C.Name -> (A.Name -> ScopeCheck a) -> ScopeCheck a+addLocal n k = do+  ctx <- ask+  let (x, ctx') = newLocal n ctx+  local (const ctx') $ k x++addTel :: C.Telescope -> A.Telescope -> ScopeCheck a -> ScopeCheck a+addTel ctel atel = local (addContext nxs)+  where nxs = reverse $ zipTels ctel atel++zipTels :: C.Telescope -> A.Telescope -> [(C.Name,A.Name)]+zipTels ctel atel = zip ns xs+  where ns = collectTelescopeNames ctel+        xs = map A.boundName $ A.telescope atel++-- ** Global state.++getSig :: ScopeCheck Sig+getSig = ScopeCheck $ gets signature++-- | Add a global identifier.+addName :: IKind -> C.Name -> ScopeCheck A.Name+addName k n = do+  sig <- getSig+  when (isJust (lookupSig (C.QName n) sig)) $+    errorAlreadyInSignature "shadowing of global definitions forbidden" n+  let x = A.fresh $ C.theName n+  addANameU k n x+  return x++-- addNameU :: IKind -> C.Name -> ScopeCheck A.Name+-- addNameU k n = A.unqual <$> addName k (C.QName n)++-- | Add an already translated global identifier.+addAName :: IKind -> C.QName -> A.QName -> ScopeCheck ()+addAName k n x = ScopeCheck $ modify $ \ st ->+  st { signature = (n, DefI k x) : signature st }++addANameU :: IKind -> C.Name -> A.Name -> ScopeCheck ()+addANameU ki n x = addAName ki (C.QName n) (A.QName x)++-- | Add or reuse an unqualified name.+overloadName :: IKind -> C.Name -> ScopeCheck A.Name+overloadName k n = do+  sig <- getSig+  case lookupSigU n sig of+    Nothing -> do+      let x = A.fresh $ C.theName n+      addANameU k n x+      return x+    Just (DefI k' (A.QName x)) -> return x++{- UNUSED+addDecl :: C.Declaration -> ScopeCheck A.Name+addDecl (C.DataDecl n _ _ _ _ _ _) = addName DataK n+addDecl (C.RecordDecl n _ _ _ _)   = addName DataK n+-}+{- UNUSED+addFunDecl :: Bool -> C.Declaration -> ScopeCheck A.Name+addFunDecl b (C.FunDecl _ ts _) = addTypeSig (FunK b) ts+-}++addTypeSig :: IKind -> C.TypeSig -> A.TypeSig -> ScopeCheck ()+addTypeSig kind (C.TypeSig n _) (A.TypeSig x _) = addANameU kind n x++{- UNUSED+-- | Add a global identifier.  Fail if already in signature.+addGlobal :: Show d => d -> IKind -> C.Name -> ScopeCheck A.Name+addGlobal d k n = enterShow n $ do+  sig <- getSig+  case lookupSig n sig of+    Just _  -> errorAlreadyInSignature d n+    Nothing -> addName k n+-}++-- | Create a meta variable.+nextMVar :: (MVar -> ScopeCheck a) -> ScopeCheck a+nextMVar f = ScopeCheck $ do+  st <- get+  put $ st { nextMeta = nextMeta st + 1 }+  unScopeCheck $ f (nextMeta st)++-- | Create a polarity meta variable.+nextPVar :: (MVar -> ScopeCheck a) -> ScopeCheck a+nextPVar f = ScopeCheck $ do+  st <- get+  put $ st { nextPolVar = nextPolVar st + 1 }+  unScopeCheck $ f (nextPolVar st)++-- ** Additional services of scope monad.++-- | Default polarity is context-sensitive.+setDefaultPolarity :: Pol -> ScopeCheck a -> ScopeCheck a+setDefaultPolarity p = local (\ sccxt -> sccxt { defaultPolarity = p })+{-+insertingPolVars :: Bool -> ScopeCheck a -> ScopeCheck a+insertingPolVars b = local (\ sccxt -> sccxt { insertPolVars = b })+-}++-- | Insert polarity variables for omitted polarities.+generalizeDec :: A.Dec -> ScopeCheck A.Dec+generalizeDec dec@A.Hidden = return dec+generalizeDec dec@A.Dec{}  =+  if (polarity dec == Default) then do+    p0 <- asks defaultPolarity+    case p0 of+      PVar{} -> nextPVar $ \ i ->+                  return $ setPol (PVar i) dec+      _      -> return $ setPol p0 dec+   else return dec++generalizeTBind :: C.TBind -> ScopeCheck C.TBind+generalizeTBind tb@C.TMeasure{} = return tb+generalizeTBind tb = do+  dec' <- generalizeDec (C.boundDec tb)+  return $ tb { C.boundDec = dec' }++-- | Insert polarity variables in telescope.+generalizeTel :: C.Telescope -> ScopeCheck C.Telescope+generalizeTel = mapM generalizeTBind++-- * Scope checking concrete syntax.+----------------------------------------------------------------------++scopeCheckDecls :: [C.Declaration] -> ScopeCheck [A.Declaration]+scopeCheckDecls = mapM scopeCheckDeclaration++scopeCheckDeclaration :: C.Declaration -> ScopeCheck A.Declaration++scopeCheckDeclaration (C.OverrideDecl Check ds) = ScopeCheck $ do+  st <- get+  as <- unScopeCheck $ scopeCheckDecls ds -- declarations need to scope check+  put st                   -- but then forget their effect: restore old state+  return $ A.OverrideDecl Check as++scopeCheckDeclaration (C.OverrideDecl Fail ds) = ScopeCheck $ do+  st <- get+  as <- unScopeCheck $ scopeCheckDecls ds+               `catchError` (const $ return [])  --on error discard block+  put st+  return $ A.OverrideDecl Fail as+{-+scopeCheckDeclaration (C.OverrideDecl Fail ds) = do+  st <- get+  (as,st') <- (do as  <- scopeCheckDecls ds+                  st' <- get+                  return (as,st'))+               `catchError` (const $ return ([],st))  --on error discard block+  put st'+  return $ A.OverrideDecl Fail as+-}+scopeCheckDeclaration (C.OverrideDecl override ds) = do -- TrustMe,Impredicative+  as <- scopeCheckDecls ds+  return $ A.OverrideDecl override as++scopeCheckDeclaration (C.RecordDecl n tel t c fields) =+  scopeCheckRecordDecl n tel t c fields++scopeCheckDeclaration d@(C.DataDecl{}) =+  scopeCheckDataDecl d -- >>= return . (:[])++scopeCheckDeclaration d@(C.FunDecl co _ _) =+  scopeCheckFunDecls co [d] -- >>= return . (:[])++scopeCheckDeclaration (C.LetDecl eval letdef@C.LetDef{ C.letDefDec = dec, C.letDefName = n }) = do+  unless (dec == A.defaultDec) $+    throwErrorMsg $ "polarity annotation not supported in global let definition of " ++ show n+  (tel, mt, e) <- scopeCheckLetDef letdef+  x <- addName LetK n+  return $ A.LetDecl eval x tel mt e++scopeCheckDeclaration d@(C.PatternDecl n ns p) = do+  let errorHead = "invalid pattern declaration\n" ++ C.prettyDecl d ++ "\n"+  -- check pattern+  (p, delta) <- runStateT (scopeCheckPattern p) emptyCtx+  p <- local (addContext delta) $ scopeCheckDotPattern p+  -- ensure that pattern variables are the declared variables+  unless (sort ns == sort (map fst delta)) $ do+    let usedNames = map fst delta+        unusedNames = ns \\ usedNames+        undeclaredNames = usedNames \\ ns+    when (not (null unusedNames)) $ throwErrorMsg $+      errorHead ++ "unsed variables in pattern: "+        ++ Util.showList " " show unusedNames+    when (not (null undeclaredNames)) $ throwErrorMsg $+      errorHead ++ "undeclared variables in pattern: "+        ++ Util.showList " " show undeclaredNames+  --  when (n `elem` ns) $ throwErrorMsg $ errorHead ++ "pattern"+  x <- addName (ConK DefPat) n+  let xs = map (fromJust . flip lookup delta) ns+  return (A.PatternDecl x xs p)++-- we support+-- - mutual (co)funs+-- - mutual (co)data++scopeCheckDeclaration (C.MutualDecl []) = throwErrorMsg "empty mutual block"+scopeCheckDeclaration (C.MutualDecl l@(C.DataDecl{}:xl)) =+  scopeCheckMutual l+scopeCheckDeclaration (C.MutualDecl l@(C.FunDecl  co _ _:xl)) =+  scopeCheckFunDecls co l  -- >>= return . (:[])+scopeCheckDeclaration (C.MutualDecl _) = throwErrorMsg "mutual combination not supported"++scopeCheckLetDef :: C.LetDef -> ScopeCheck (A.Telescope, Maybe (A.Type), A.Expr)+scopeCheckLetDef (C.LetDef dec n tel mt e) =  setDefaultPolarity A.Rec $ do+  tel <- generalizeTel tel+  (tel, (mt, e)) <- scopeCheckTele tel $ do+     (,) <$> mapM scopeCheckExprN mt  -- allow shadowing after : in type+         <*> scopeCheckExprN e        -- allow shadowing after =+  return (tel, mt, e)++{- scopeCheck Mutual block+first check signatures+then bodies+-}+scopeCheckMutual :: [C.Declaration] -> ScopeCheck A.Declaration+scopeCheckMutual ds0 = do+  -- flatten nested mutual blocks and override decls+  ds <- mutualFlattenDecls ds0+  -- extract, check, and add type signatures+  let ktsigs = map mutualGetTypeSig ds+  (mmm, tsigs') <- unzip <$> mapM checkAndAddTypeSig ktsigs+  -- funs have been added with internal names+  -- check that all functions are unmeasured or have a same length measure+  let (ns, mll) = unzip $ compressMaybes mmm+  let measured = null mll || isJust (head mll)+  let ok = null mll || all ((head mll)==) (tail mll)+  when (not ok) $ fail $ "in a mutual function block, either all functions must be without measure or have a measure of the same length"+{-+  -- switch to internal fun ids+  let funNames = [ n | (FunK _ , A.TypeSig n _) <- ktsigs ] -- internal fun names+{- SAME W/O COMPR+  let funNames = map (\ (_, C.TypeSig n _) -> n) $ filter aux ktsigs where+                   aux (FunK _, _) = True+                   aux _ = False+-}+  mapM_ (addName (FunK False)) funNames -- TODO+-}+  -- check bodies of declarations+  ds' <- mapM (setDefaultPolarity A.Rec . checkBody) (zip tsigs' ds)+  -- switch back to external fun ids+  let funNames = [ x | A.FunDecl _ (A.Fun _ x _ _) <- ds' ] -- external fun names+  zipWithM_ (addANameU (LetK)) ns funNames+--  zipWithM_ (addAName (FunK True)) ns funNames+  return $ A.MutualDecl measured ds'++scopeCheckTele :: C.Telescope -> ScopeCheck a -> ScopeCheck (A.Telescope, a)+scopeCheckTele []         cont = (A.emptyTel,) <$> cont+scopeCheckTele (tb : tel) cont = do+  (tbs, (A.Telescope tel, a)) <- scopeCheckTBind tb $ scopeCheckTele tel cont+  return (A.Telescope $ tbs ++ tel, a)++scopeCheckTBind :: C.TBind -> ScopeCheck a -> ScopeCheck ([A.TBind], a)+scopeCheckTBind tb cont = do+  let contYes = setConstraintAllowed True  cont+      contNo  = setConstraintAllowed False cont+  case tb of+    C.TBind dec [] t -> do -- non-dependent function type+      t       <- scopeCheckExprN t+      ([A.noBind $ A.Domain t A.defaultKind dec],) <$> contNo+    C.TBind dec ns t -> do+      t       <- scopeCheckExprN t+      (xs, a) <- addBinds tb ns $ contYes+      return (map (\ x -> A.TBind x (A.Domain t A.defaultKind dec)) xs, a)+    C.TBounded dec n ltle e -> do+      e <- scopeCheckExprN e+      (x, a) <- addBind tb n $ contYes+      return ([A.TBind x (A.Domain (A.Below ltle e) A.defaultKind dec)], a)+    C.TMeasure mu -> do+      mu <- scopeCheckMeasure mu+      ([A.TMeasure mu],) <$> cont+--    C.TMeasure mu -> throwErrorMsg $ "measure not allowed in telescope"+    C.TBound beta -> do+      unlessM (asks constraintAllowed) $+        errorConstraintNotAllowed beta+      beta <- scopeCheckBound beta+      ([A.TBound beta],) <$> cont++checkBody :: (A.TypeSig, C.Declaration) -> ScopeCheck A.Declaration+checkBody (A.TypeSig x tt, C.DataDecl n sz co tel _ cs fields) =+  checkDataBody tt n x sz co tel cs fields+checkBody (ts@(A.TypeSig n t), d@(C.FunDecl co tsig cls)) = do+  (ar,cls') <- scopeCheckFunClauses d+  let n' = A.mkExtName n+  return $ A.FunDecl co $ A.Fun ts n' ar cls'++mutualFlattenDecls :: [C.Declaration] -> ScopeCheck [C.Declaration]+mutualFlattenDecls ds = mapM mutualFlattenDecl ds >>= return . concat++mutualFlattenDecl :: C.Declaration -> ScopeCheck [C.Declaration]+mutualFlattenDecl (C.MutualDecl ds) = mutualFlattenDecls ds+mutualFlattenDecl (C.OverrideDecl Fail _) = fail $ "fail declaration not supported in mutual block"+mutualFlattenDecl (C.OverrideDecl o ds) = do+  ds' <- mutualFlattenDecls ds+  return $ map (\ d -> C.OverrideDecl o [d]) ds'+mutualFlattenDecl (C.LetDecl{}) = fail $ "let in mutual block not supported"+mutualFlattenDecl d = return $ [d]++-- extract type sigs of a mutual block in order, error on nested mutual+mutualGetTypeSig :: C.Declaration -> (IKind, C.TypeSig)+mutualGetTypeSig (C.DataDecl n sz co tel t cs fields) =+  (DataK, C.TypeSig n (C.teleToType tel t))+mutualGetTypeSig (C.FunDecl co tsig cls) =+  (FunK False, tsig) -- fun id for use inside defining body+mutualGetTypeSig (C.LetDecl ev (C.LetDef dec n tel Nothing e)) =+  error $ "let declaration of " ++ show n ++ ": type required in mutual block"+mutualGetTypeSig (C.LetDecl ev (C.LetDef dec n tel (Just t) e)) =+  (LetK, C.TypeSig n (C.teleToType tel t))+{- mutualGetTypeSig (C.LetDecl ev tsig e) =+  (LetK, tsig) -}+mutualGetTypeSig (C.OverrideDecl _ [d]) =+  mutualGetTypeSig d+++scopeCheckRecordDecl :: C.Name -> C.Telescope -> C.Type -> C.Constructor -> [C.Name] ->+  ScopeCheck A.Declaration+scopeCheckRecordDecl n tel t c cfields = enterShow n $ do+  setDefaultPolarity A.Param $ do+    tel <- generalizeTel tel+    -- STALE COMMENT: we do not infer at all: -- do not infer polarities in index arguments+    (A.TypeSig x tt') <- scopeCheckTypeSig (C.TypeSig n $ C.teleToType tel t)+    addANameU DataK n x+    let names = collectTelescopeNames tel+        target = C.App (C.ident n) (map C.ident names)  -- R pars+        (tel',t') = A.typeToTele' (length names) tt'+    c' <- scopeCheckConstructor n x (zipTels tel tel') A.CoInd target c+    let delta = contextFromConstructors c c'+    afields <- addFields ProjK delta cfields+    return $ A.RecordDecl x tel' t' c' afields++contextFromConstructors :: C.Constructor -> A.Constructor -> Context+contextFromConstructors (C.Constructor _ ctel0 mct) (A.Constructor _ _ at) = delta+  where ctel = maybe [] (fst . C.typeToTele) mct+        (atel, _) = A.typeToTele at+        delta = zipTels (ctel0 ++ ctel) atel++scopeCheckField :: Context -> C.Name -> ScopeCheck A.Name+scopeCheckField delta n =+  case lookup n delta of+    Nothing -> errorNotAField n+    Just x  -> return $ x++addFields :: IKind -> Context -> [C.Name] -> ScopeCheck [A.Name]+addFields kind delta cfields = do+    afields <- mapM (scopeCheckField delta) cfields+    mapM (uncurry $ addANameU kind) $ zip cfields afields+    return afields++scopeCheckDataDecl :: C.Declaration -> ScopeCheck A.Declaration+scopeCheckDataDecl decl@(C.DataDecl n sz co tel0 t cs fields) = enterShow n $ do+  setDefaultPolarity A.Param $ do+    tel <- generalizeTel tel0+    -- STALE: -- do not infer polarities in index arguments+    (A.TypeSig x tt') <- scopeCheckTypeSig (C.TypeSig n $ C.teleToType tel t)+    addANameU DataK n x+    checkDataBody tt' n x sz co tel cs fields++-- precondition: name already added to signature+checkDataBody :: A.Type -> C.Name -> A.Name -> Sized -> Co -> C.Telescope -> [C.Constructor] -> [C.Name] -> ScopeCheck A.Declaration+checkDataBody tt' n x sz co tel cs fields = do+      let cnames = collectTelescopeNames tel         -- parameters+          target = C.App (C.ident n) $ map C.ident cnames  -- D pars+          (tel',t') = A.typeToTele' (length cnames) tt'+      cs' <- mapM (scopeCheckConstructor n x (zipTels tel tel') co target) cs+{- NO LONGER INFER DESTRUCTORS+      -- traceM ("constructors: " ++ show cs')+--      when (t' == A.Sort A.Set && length cs' == 1) $ do+--      when (length cs' == 1) $ do  -- TOO STRICT, DOES NOT TREAT Vec right+      let cis = A.analyzeConstructors co n tel' cs'+      flip mapM_ cis $ \ ci -> when (A.cEtaExp ci) $ do+-- Add destructor names+        let fields = A.cFields ci -- A.classifyFields co n (A.typePart c)+        -- TODO Check for recursive occurrence!+        -- when (A.etaExpandable fields) $+        let destrNames =  A.destructorNames fields+        --when (not (null (destrNames))) $+        -- traceM ("fields: " ++ show fields)+        -- traceM ("destructors: " ++ show destrNames)+        mapM_ (addName (FunK True)) $ destrNames -- destructors are also upped+ {-+        let (ctel,_) = A.typeToTele (A.typePart (head cs'))+        let destrNames = map (\(_,x,_) -> x) ctel+        when (all (/= "") destrNames) $+          mapM_ (addName (FunK True)) destrNames -- destructors are also upped+-}+-}+      -- add declared destructor names+      let delta = concat $ map (uncurry contextFromConstructors) $ zip cs cs'+      -- fields <- addFields (LetK) delta fields+      -- 2012-01-26 register as projections+      fields <- addFields ProjK delta fields+      let pos = map (A.polarity . A.decor . A.boundDom) $ A.telescope tel'+      return $ A.DataDecl x sz co pos tel' t' cs' fields++-- check whether all declarations in mutual block are (co)funs+checkFunMutual :: Co -> [C.Declaration] -> ScopeCheck ()+checkFunMutual co [] = return ()+checkFunMutual co (C.FunDecl co' _ _:xl) | co == co' = checkFunMutual co xl+checkFunMutual _ _ = throwErrorMsg "mutual combination not supported"++scopeCheckFunDecls :: Co -> [C.Declaration] -> ScopeCheck A.Declaration+scopeCheckFunDecls co l = do+  -- check for uniformity of mutual block (all funs/all cofuns)+  checkFunMutual co l+  -- check signatures and look for measures+  r <- mapM (\ (C.FunDecl _ tysig _) -> scopeCheckFunSig tysig) l+  let (ml:mll, tsl') = unzip r+  let ok = all (ml==) mll+  when (not ok) $ fail $ "in a mutual function block, either all functions must be without measure or have a measure of the same length"+  -- add names as internal ids and check bodies+  let nxs = zipWith (\ (C.FunDecl _ (C.TypeSig n _) _) (A.TypeSig x _) -> (n,x)) l tsl'+  --let addFuns b = mapM (uncurry $ addAName $ FunK b) nxs+--  let addFuns b = mapM (\ (n,x) -> addAName (FunK b) n x) nxs+  -- addFuns False+  mapM (uncurry $ addANameU $ FunK False) nxs+  arcll' <- mapM (setDefaultPolarity A.Rec . scopeCheckFunClauses) l+  -- add names as external ids+  --addFuns True+  let nxs' = map (mapPair id A.mkExtName) nxs+  mapM (uncurry $ addANameU (LetK)) nxs'+--  mapM (uncurry $ addAName (FunK True)) nxs'+  return $ A.MutualFunDecl (isJust ml) co $+    zipWith3 (\ ts (_, x') (ar, cls) -> A.Fun ts x' ar cls) tsl' nxs' arcll'++-- | Does not add name to signature.+scopeCheckFunSig :: C.TypeSig -> ScopeCheck (Maybe Int, A.TypeSig)+scopeCheckFunSig d@(C.TypeSig n t) = checkInSig d n $ \ x -> do+    (ml, t') <- scopeCheckFunType t+    return (ml, A.TypeSig x t')++-- scope check type of mutual function, return length of measure (if present)+-- a fun type is a telescope followed by (maybe) a measure and a type expression+scopeCheckFunType :: C.Expr -> ScopeCheck (Maybe Int, A.Expr)+scopeCheckFunType t =+  case t of++      -- found a measure: continue normal scope checking+      C.Quant A.Pi [C.TMeasure mu] e1 -> do+        mu' <- scopeCheckMeasure mu+        e1' <- scopeCheckExprN e1+        return (Just $ length (measure mu'), A.pi (A.TMeasure mu') e1')++      -- bounds are allowed here, since we check a function type+      C.Quant A.Pi [C.TBound beta] e1 -> do+        beta'     <- scopeCheckBound beta+        (ml, e1') <- scopeCheckFunType e1+        return (ml, A.pi (A.TBound beta') e1')++      C.Quant A.Pi tel e -> do+        tel <- generalizeTel tel+        (tel, (ml, e)) <- setDefaultPolarity A.Rec $ setConstraintAllowed False $+          scopeCheckTele tel $ setConstraintAllowed True $ scopeCheckFunType e+        ml' <- findMeasure tel+        ml <- case (ml,ml') of+                 (Nothing,ml') -> return ml'+                 (ml, Nothing) -> return ml+                 (Just{}, Just{}) -> errorOnlyOneMeasure+        return (ml, A.teleToType tel e)++      t -> (Nothing,) <$> scopeCheckExpr t -- no measure found++findMeasure :: A.Telescope -> ScopeCheck (Maybe Int)+findMeasure (A.Telescope tel) =+  case [ mu | A.TMeasure mu <- tel ] of+    []           -> return Nothing+    [Measure mu] -> return $ Just $ length mu+    _            -> errorOnlyOneMeasure++-- | Check whether concrete name is already in signature.+--   If yes, fail. If no, create abstract name and continue.+checkInSig :: Show d => d -> C.Name -> (A.Name -> ScopeCheck a) -> ScopeCheck a+checkInSig d n k = enterShow n $ do+  sig <- getSig+  case lookupSig (C.QName n) sig of+    Just _  -> errorAlreadyInSignature d n+    Nothing -> k (A.fresh $ C.theName n)++-- checkInSigU :: Show d => d -> C.Name -> (A.Name -> ScopeCheck a) -> ScopeCheck a+-- checkInSigU d n k = checkInSig d (C.QName n) (k . A.unqual)++scopeCheckFunClauses :: C.Declaration -> ScopeCheck (Arity, [A.Clause])+scopeCheckFunClauses (C.FunDecl _ (C.TypeSig n _) cl) = enterShow n $ do+  cl <- mapM (scopeCheckClause (Just n)) cl+  let m = if null cl then 0 else+       List.foldl1 min $ map (length . A.clPatterns) cl+  return (A.Arity m Nothing, cl)+{-+       let b = checkPatternLength cl+       case b of+          Just m  -> return $ (A.Arity m Nothing, cl)+          Nothing -> throwErrorMsg $ " pattern length differs"+-}++-- | Check the type of a signature and generate abstract name.+--   Does not add abstract name to signature.+scopeCheckTypeSig :: C.TypeSig -> ScopeCheck A.TypeSig+scopeCheckTypeSig d@(C.TypeSig n t) = checkInSig d n $ \ x -> do+    t' <- scopeCheckExpr t+    return $ A.TypeSig x t'++-- | Results:+--+--     @Nothing@            Not a function declaration.+--+--     @Just (n, Nothing)@  Unmeasured function.+--+--     @Just (n, Just m)@   Function with measure of length m+checkAndAddTypeSig :: (IKind, C.TypeSig) -> ScopeCheck (Maybe (C.Name, Maybe Int), A.TypeSig)+checkAndAddTypeSig (kind, ts@(C.TypeSig n _)) = do+  (mm, ts'@(A.TypeSig x _)) <-+    case kind of+      FunK _ -> mapPair (Just . (n,)) id <$> scopeCheckFunSig ts+{-+        do+        (mi, ts) <- scopeCheckFunSig ts+        return (Just mi, ts)+-}+      _ -> (Nothing,) <$> scopeCheckTypeSig ts+  addANameU kind n x  -- or: addTypeSig kind ts ts'+  return (mm, ts')++collectTelescopeNames :: C.Telescope -> [C.Name]+collectTelescopeNames = concat . map C.boundNames++-- | Check whether concrete name is already in signature.+--   If yes, fail. If no, create abstract name and continue.+checkConsInSig :: Show decl => decl -> C.Name -> A.Name -> IKind -> C.Name -> (A.QName -> ScopeCheck a) -> ScopeCheck a+checkConsInSig decl d dx ki n cont = enterShow n $ do+  -- first check whether the datatype has this constructor already+  ifJustM (lookupSig (C.Qual d n) <$> getSig) (const $ errorAlreadyInSignature decl n) $ do+  -- then check the overloaded name and possibly add it+  x <- overloadName ki n+  -- the qualified name is added in the continuation+  cont $ A.Qual dx x++-- | @cxt@ is the data telescope.+scopeCheckConstructor :: C.Name -> A.Name -> Context -> Co -> C.Type -> C.Constructor -> ScopeCheck A.Constructor+scopeCheckConstructor d dx cxt co t0 a@(C.Constructor n tel mt) = do+  let ki = ConK $ A.coToConK co+  checkConsInSig a d dx ki n $ \ x -> do++  let finish t mcxt = local (addContext $ maybe cxt id mcxt) $ do+       t <- setDefaultPolarity A.Param $ scopeCheckExpr $ C.teleToType tel t+       t <- adjustTopDecsM defaultToParam t+       addAName ki (C.Qual d n) x+       let dummyDom = A.Domain A.Irr A.NoKind $ A.Dec Param+           mtel     = fmap (map (\ (n,x) -> A.TBind x dummyDom)) mcxt+           ps       = [] -- patterns computed during type checking+       return $ A.Constructor x (fmap ((,ps) . A.Telescope) mtel) t++  case mt of++    -- no target given, then add the data tel to the scope+    Nothing -> finish t0 Nothing++    -- target given, then the target binds the parameter names+    Just t -> do+      -- get the final target+      let (_, target) = C.typeToTele t++          fallback = finish t Nothing+          continue d' es = do+            -- unless (d == d') $ errorWrongTarget n d d'+            if (d /= d') then fallback else do+            -- get the parameters of target+            let (pars, inds) = splitAt (length cxt) es+            unless (length pars == length cxt) $ errorNotEnoughParameters n target+            -- if parameters are just data parameters, do it old style+            if and (zipWith isTelPar cxt pars) then fallback else do+            -- scopeCheck the parameters as patterns+            finish t . Just =<< parameterVariables pars++      case target of+        C.Ident (C.QName d')            -> continue d' []+        C.App (C.Ident (C.QName d')) es -> continue d' es+        _ -> fallback -- errorTargetMustBeAppliedName n target++{- OLD CODE+scopeCheckConstructor :: C.Telescope -> A.Telescope -> Co -> C.Type -> C.Constructor -> ScopeCheck A.Constructor+scopeCheckConstructor ctel atel co t0 a@(C.Constructor n tel mt) = addTel ctel atel $ checkInSig a n $ \ x -> do+    let t = maybe t0 id mt+    t <- setDefaultPolarity A.Param $ scopeCheckExpr $ C.teleToType tel t+    t <- adjustTopDecsM defaultToParam t+    addAName (ConK $ A.coToConK co) n x+    return $ A.TypeSig x t+-}+  where isTelPar (c,_) (C.Ident (C.QName x)) = c == x+        isTelPar _     _                     = False+        defaultToParam dec = case (A.polarity dec) of+          A.Default -> return $ setPol A.Param dec+          A.Param   -> return dec+          A.Const   -> return dec+          A.PVar{}  -> return dec+          _         -> fail $ "illegal polarity " ++ show (polarity dec) ++ " in type of constructor " ++ show a++-- | Allow shadowing of previous locals.+--   Always if we enter a subexpression which is not the body+--   of a binder.+scopeCheckExprN :: C.Expr -> ScopeCheck A.Expr+scopeCheckExprN = newLevel . scopeCheckExpr++scopeCheckExpr :: C.Expr -> ScopeCheck A.Expr+scopeCheckExpr e = setConstraintAllowed False $ scopeCheckExpr' e++scopeCheckExpr' :: C.Expr -> ScopeCheck A.Expr+scopeCheckExpr' e =+    case e of+      -- replace underscore by next meta-variable+      C.Unknown -> nextMVar (return . A.Meta)+      C.Set   e -> A.Sort . A.Set   <$> scopeCheckExprN e+      C.CoSet e -> A.Sort . A.CoSet <$> scopeCheckExprN e+      C.Size    -> return $ A.Sort (A.SortC A.Size)+      C.Succ e1 -> A.Succ <$> scopeCheckExprN e1+      C.Zero    -> return A.Zero+      C.Infty   -> return A.Infty+      C.Plus e1 e2 -> do+        e1 <- scopeCheckExprN e1+        e2 <- scopeCheckExprN e2+        return $ A.Plus [e1, e2]+      C.Pair e1 e2   -> A.Pair <$> scopeCheckExprN e1 <*> scopeCheckExprN e2+      C.Sing e1 et   -> A.Sing <$> scopeCheckExprN e1 <*> scopeCheckExprN et+      C.App C.Max el -> do+        el' <- mapM scopeCheckExprN el+        when (length el' < 2) $ throwErrorMsg "max expects at least 2 arguments"+        return $ A.Max el'+      C.App e1 el -> foldl A.App <$> scopeCheckExprN e1 <*> mapM scopeCheckExprN el+      C.Case e mt cl -> do+        e'  <- scopeCheckExprN e+        mt' <- mapM scopeCheckExprN mt+        cl' <- mapM (scopeCheckClause Nothing) cl+        return $ A.Case e' mt' cl'++      -- measure & bound+      -- measures can only appear in fun sigs!+      C.Quant pisig [C.TMeasure mu] e1 -> do+        fail $ "measure not allowed in expression " ++ show e++      -- measure bound mu < mu'+      C.Quant A.Pi [C.TBound beta] e1 -> do+        unlessM (asks constraintAllowed) $ errorConstraintNotAllowed beta+        beta' <- scopeCheckBound beta+        e1'   <- scopeCheckExpr' e1+        return $ A.pi (A.TBound beta') e1'++      C.Quant A.Sigma [C.TBound beta] e1 -> fail $+        "measure bound not allowed in expression " ++ show e++      C.Quant pisig tel e -> do+        tel <- generalizeTel tel+        pol <- asks defaultPolarity+        (A.Telescope tel, e) <- setDefaultPolarity A.Rec $ setConstraintAllowed False $ scopeCheckTele tel $+           setDefaultPolarity pol $ scopeCheckExpr' e+        return $ quant pisig tel e where+--          quant A.Sigma [tb] = A.Quant A.Sigma tb+          quant A.Sigma tel e = foldr (A.Quant A.Sigma) e tel+          quant A.Pi    tel e = A.teleToType (A.Telescope tel) e++      C.Lam n e1 -> do+        (n, e1') <- addBind e n $ scopeCheckExpr e1+        return $ A.Lam A.defaultDec n e1' -- dec. in Lam is ignored in t.c.++      C.LLet letdef e2 -> do+        let dec = C.letDefDec letdef+        (tel, mt, e1) <- scopeCheckLetDef letdef+        (x, e2) <- addBind e (C.letDefName letdef) $ scopeCheckExpr e2+        return $ A.LLet (A.TBind x $ A.Domain mt A.defaultKind dec) tel e1 e2++      C.Record rs -> do+        let fields = map fst rs+        if (hasDuplicate fields) then (errorDuplicateField e) else do+          rs <- mapM scopeCheckRecordLine rs+          return $ A.Record A.AnonRec rs++      C.Proj n -> A.Proj Post <$> scopeCheckProj n++      C.Ident n@C.Qual{} -> scopeCheckGlobalVar n++      C.Ident n@C.QName{} -> do+        res <- lookupLocal (C.name n)+        case res of+          Just x -> return $ A.Var x+          Nothing -> scopeCheckGlobalVar n++      _ -> fail $ "NYI: scopeCheckExpr " ++ show e++scopeCheckGlobalVar :: C.QName -> ScopeCheck A.Expr+scopeCheckGlobalVar n = do+  res <- lookupGlobal n+  case res of+    Just (DefI k x) -> case k of+      (ConK co)  -> return $ A.con co x+      LetK       -> return $ A.letdef (A.unqual x)+      -- references to recursive functions are coded differently+      -- outside the mutual block+      FunK True  -> return $ A.fun x -- A.letdef x -- A.mkExtRef x+      FunK False -> return $ A.fun x+      DataK      -> return $ A.dat x+      ProjK      -> return $ A.Proj A.Pre (A.unqual x) -- errorProjectionUsedAsExpression n+    Nothing -> errorIdentifierUndefined n++scopeCheckLocalVar :: C.Name -> ScopeCheck A.Name+scopeCheckLocalVar n = maybe (errorIdentifierUndefined n) return =<< do+  lookupLocal n++scopeCheckRecordLine :: ([C.Name], C.Expr) -> ScopeCheck (A.Name, A.Expr)+scopeCheckRecordLine (n : ns, e) = do+  x <- scopeCheckProj n+  (x,) <$> scopeCheckExprN (foldr C.Lam e ns)++scopeCheckProj :: C.Name -> ScopeCheck A.Name+scopeCheckProj n = do+  sig <- getSig+  case lookupSigU n sig of+    Just (DefI ProjK x) -> return $ A.unqual x+    _                   -> errorNotAField n+++-- | @isProjIdent n = n@ if defined and the name of a projection.+isProjIdent :: C.QName -> ScopeCheck (Maybe A.Name)+isProjIdent n = do+  sig <- getSig+  return $+    case lookupSig n sig of+      Just (DefI ProjK x) -> Just $ A.unqual x+      _ -> Nothing++isProjection :: C.Expr -> ScopeCheck (Maybe A.Name)+isProjection (C.Ident n) = isProjIdent n+isProjection _           = return Nothing++scopeCheckMeasure :: A.Measure C.Expr -> ScopeCheck (A.Measure A.Expr)+scopeCheckMeasure (A.Measure es) = do+  es' <- mapM scopeCheckExprN es+  return $ A.Measure es'++scopeCheckBound :: A.Bound C.Expr -> ScopeCheck (A.Bound A.Expr)+scopeCheckBound (A.Bound ltle e1 e2) = do+  [e1',e2'] <- mapM scopeCheckMeasure [e1,e2]+  return $ A.Bound ltle e1' e2'++checkPatternLength :: [C.Clause] -> Maybe Int+checkPatternLength [] = Just 0 -- arity 0+checkPatternLength (C.Clause _ pl _:cl) = cpl (length pl) cl+ where+   cpl k [] = Just k+   cpl k (C.Clause _ pl _ : cl) = if (length pl == k) then (cpl k cl) else Nothing++scopeCheckClause :: Maybe C.Name -> C.Clause -> ScopeCheck A.Clause+scopeCheckClause mname' (C.Clause mname pl mrhs) = do+  when (mname /= mname') $ errorClauseIdentifier mname mname'+  (pl, delta) <- runStateT (mapM scopeCheckPattern pl) emptyCtx+  local (addContext delta) $ do+    pl <- mapM scopeCheckDotPattern pl+    case mrhs of+      Nothing  -> return $ A.clause pl Nothing+      Just rhs -> A.clause pl . Just <$> scopeCheckExprN rhs+++type PatCtx = Context+type SPS = StateT PatCtx ScopeCheck++scopeCheckPatVar :: C.QName -> SPS (A.Pat C.Expr)+scopeCheckPatVar n = do+      sig <- lift $ getSig+      case lookupSig n sig of+        Just (DefI (ConK co) n) -> return $ A.ConP (A.PatternInfo co False False) n []+                             -- a nullary constructor+        Just _  -> errorPatternNotConstructor n+        Nothing -> A.VarP <$> addUnique (C.unqual n)++scopeCheckPattern :: C.Pattern -> SPS (A.Pat C.Expr)+scopeCheckPattern p =+  case p of++    -- case n+    C.IdentP n        -> scopeCheckPatVar n+    C.ConP False n [] -> scopeCheckPatVar n++    -- case (i > j):+    C.SizeP m n -> do+      -- m   <- lift $ scopeCheckLocalVar m+      A.SizeP m <$> addUnique n++    -- case $p+    C.SuccP p2    -> A.SuccP <$> scopeCheckPattern p2++    -- case (p1,p2)+    C.PairP p1 p2 -> A.PairP <$> scopeCheckPattern p1 <*> scopeCheckPattern p2++    -- case .n+    C.ConP True n [] -> do+      -- try projection+      ifJustM (lift $ isProjIdent n) (return . A.ProjP) $ do+      -- try constructor+      sig <- lift $ getSig+      case lookupSig n sig of+        Just (DefI (ConK co) n) ->+              return $ A.ConP (A.PatternInfo co False True) n []+      -- fallback: dot pattern+        _  -> return $ A.DotP (C.Ident n)++    -- case [.]c ps+    C.ConP dotted n pl -> do+      sig <- lift $ getSig+      case lookupSig n sig of+        Just (DefI (ConK co) x) ->+          A.ConP (A.PatternInfo co False dotted) x <$> mapM scopeCheckPattern pl+        _  -> errorPatternNotConstructor n++    -- case .e+    C.DotP e  -> do+      isProj <- lift $ isProjection e+      case isProj of+       Just n  -> return $ A.ProjP n+       Nothing -> return $ A.DotP e -- dot patterns checked later++    -- case ()+    C.AbsurdP -> return $ A.AbsurdP++-- | Add pattern variable to pattern context, must not be present yet.+addUnique :: C.Name -> SPS A.Name+addUnique = addPatVar True++addNonUnique :: C.Name -> SPS A.Name+addNonUnique = addPatVar False++addPatVar :: Bool -> C.Name -> SPS A.Name+addPatVar linear n = do+  delta <- get+  case retrieve n delta of+    Just x -> if linear then errorPatternNotLinear n else return x+    Nothing -> do+      let (x, delta') = newLocal n delta+      put delta'+      return x++scopeCheckDotPattern :: A.Pat C.Expr -> ScopeCheck A.Pattern+scopeCheckDotPattern p =+    case p of+      A.DotP e -> A.DotP <$> scopeCheckExprN e+      A.PairP p1 p2 -> A.PairP <$> scopeCheckDotPattern p1 <*>  scopeCheckDotPattern p2+      A.SuccP p -> A.SuccP <$> scopeCheckDotPattern p+      A.ConP co n pl -> A.ConP co n <$> mapM scopeCheckDotPattern pl+--      A.SizeP m n -> flip A.SizeP n <$> scopeCheckLocalVar m -- return $ A.SizeP m n+      A.SizeP e n    -> flip A.SizeP n <$> scopeCheckExprN e+      A.VarP n       -> return $ A.VarP n  -- even though p = A.VarP n, it has wrong type!!+      A.ProjP n      -> return $ A.ProjP n+      A.AbsurdP      -> return $ A.AbsurdP+      -- impossible cases: ErasedP, UnusableP+++-- * Scope checking parameters++parameterVariables :: [C.Expr] -> ScopeCheck Context+parameterVariables es = do+  execStateT (mapM_ scopeCheckParameter es) emptyCtx++-- | Extract variables bound by data parameters.+--   We consider a more liberal set of patterns, everything+--   that is injective and does not bind variables.+scopeCheckParameter :: C.Expr -> SPS ()+scopeCheckParameter e =+  case e of+    C.Set e'             -> scopeCheckParameter e'+    C.CoSet e'           -> scopeCheckParameter e'+    C.Size               -> return ()+    C.Succ e'            -> scopeCheckParameter e'+    C.Zero               -> return ()+    C.Infty              -> return ()+    C.Pair e1 e2         -> scopeCheckParameter e1 >> scopeCheckParameter e2+    C.Record fs          -> mapM_ (scpField e) fs+    C.Ident n            -> scpApp e n []+    C.App (C.Ident n) es -> scpApp e n es+    C.App C.App{} es     -> fail $ "scopeCheckParameter " ++ show e ++ ": internal invariant violated"+    _ -> errorInvalidParameter e+  where+    -- we can only treat a record expression as pattern+    -- if it does not bind any variables+    scpField :: C.Expr -> ([C.Name], C.Expr) -> SPS ()+    scpField e ([f], e') = scopeCheckParameter e'+    scpField e _         = errorInvalidParameter e++    scpApp :: C.Expr -> C.QName -> [C.Expr] -> SPS ()+    scpApp e n es = do+      sig <- lift $ getSig+      case lookupSig n sig of+        Just (DefI ConK{} n) -> mapM_ scopeCheckParameter es+        Just (DefI DataK  n) -> mapM_ scopeCheckParameter es+        Just _  -> errorInvalidParameter e+        Nothing -> void $ addNonUnique (C.unqual n) -- allow non-linearity++-- * Scope checking errors++errorAlreadyInSignature s n = throwErrorMsg $ show s  ++ ": Identifier " ++ show n ++ " already in signature"++errorAlreadyInContext s n = throwErrorMsg $ show s ++ ": Identifier " ++ show n ++ " already in context"++-- errorPatternNotVariable n = throwErrorMsg $ "pattern " ++ n ++ ": Identifier expected"++errorPatternNotConstructor n = throwErrorMsg $ "pattern " ++ show n ++ " is not a constructor"++errorNotAField n = throwErrorMsg $ "record field " ++ show n ++ " unknown"+-- errorUnknownProjection n = throwErrorMsg $ "projection " ++ n ++ " unknown"++errorDuplicateField r = throwErrorMsg $ show r ++ " assigns a field twice"+++errorProjectionUsedAsExpression n = throwErrorMsg $ "projection " ++ show n ++ " used as expression"++errorIdentifierUndefined n = throwErrorMsg $ "Identifier " ++ show n ++ " undefined"++errorPatternNotLinear n = throwErrorMsg $ "pattern not linear: " ++ show n++errorClauseIdentifier (Just n) (Just n') = throwErrorMsg $ "Expected identifier " ++ show n' ++ " as clause head, found " ++ show n++errorOnlyOneMeasure = throwErrorMsg "only one measure allowed in a function type"++errorConstraintNotAllowed beta = throwErrorMsg $+  show beta ++ ": constraints must follow a quantifier"++errorTargetMustBeAppliedName n t = throwErrorMsg $+  "constructor " ++ show n ++ ": target must be data/record type applied to parameters and indices; however, I found " ++ show t++errorWrongTarget c d d' = throwErrorMsg $+  "constructor " ++ show c ++ " should target data/record type " ++ show d ++ "; however, I found " ++ show d'++errorNotEnoughParameters c t = throwErrorMsg $+  "constructor " ++ show c ++ ": target " ++ show t ++ " is missing parameters"++errorInvalidParameter e = throwErrorMsg $+  "expression " ++ show e ++ " is not valid in a parameter"
+ Semiring.hs view
@@ -0,0 +1,101 @@+-- {-# LANGUAGE UndecidableInstances #-}++-- | Semirings.  Original: Agda.Terminatio.Semiring++module Semiring+  ( HasZero(..), SemiRing(..)+  , Semiring(..)+--  , semiringInvariant+  , integerSemiring+  , boolSemiring+  ) where++import Data.Monoid+++{- | SemiRing type class.  Additive monoid with multiplication operation.+Inherit addition and zero from Monoid. -}++class (Eq a, Monoid a) => SemiRing a where+--  isZero   :: a -> Bool+  multiply :: a -> a -> a+++-- | @HasZero@ is needed for sparse matrices, to tell which is the element+--   that does not have to be stored.+--   It is a cut-down version of @SemiRing@ which is definable+--   without the implicit @?cutoff@.+class Eq a => HasZero a where+  zeroElement :: a++-- | Semirings.++data Semiring a+  = Semiring { add  :: a -> a -> a  -- ^ Addition.+             , mul  :: a -> a -> a  -- ^ Multiplication.+             , zero :: a            -- ^ Zero.+-- The one is never used in matrix multiplication+--             , one  :: a            -- ^ One.+             }++-- | Semiring invariant.++-- I think it's OK to use the same x, y, z triple for all the+-- properties below.++{-+semiringInvariant :: (Arbitrary a, Eq a, Show a)+                  => Semiring a+                  -> a -> a -> a -> Bool+semiringInvariant (Semiring { add = (+), mul = (*)+                            , zero = zero --, one = one+                            }) = \x y z ->+  associative (+)           x y z &&+  identity zero (+)         x     &&+  commutative (+)           x y   &&+  associative (*)           x y z &&+--  identity one (*)          x     &&+  leftDistributive (*) (+)  x y z &&+  rightDistributive (*) (+) x y z &&+  isZero zero (*)           x+-}++------------------------------------------------------------------------+-- Specific semirings++-- | The standard semiring on 'Integer's.++instance HasZero Integer where+  zeroElement = 0++instance Monoid Integer where+  mempty = 0+  mappend = (+)++instance SemiRing Integer where+  multiply = (*)+++integerSemiring :: Semiring Integer+integerSemiring = Semiring { add = (+), mul = (*), zero = 0 } -- , one = 1 }++-- prop_integerSemiring = semiringInvariant integerSemiring++-- | The standard semiring on 'Bool's.++boolSemiring :: Semiring Bool+boolSemiring =+  Semiring { add = (||), mul = (&&), zero = False } --, one = True }++-- prop_boolSemiring = semiringInvariant boolSemiring++------------------------------------------------------------------------+-- All tests++{-+tests :: IO Bool+tests = runTests "Agda.Termination.Semiring"+  [ quickCheck' prop_integerSemiring+  , quickCheck' prop_boolSemiring+  ]+-}
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ SparseMatrix.hs view
@@ -0,0 +1,459 @@+{- | Sparse matrices.  Original: Agda.Termination.SparseMatrix++We assume the matrices to be very sparse, so we just implement them as+sorted association lists.++ -}++module SparseMatrix+  ( -- * Basic data types+    Matrix(M)+  , matrixInvariant+  , Size(..)+  , sizeInvariant+  , MIx (..)+  , mIxInvariant+    -- * Generating and creating matrices+  , fromLists+  , fromIndexList+  , toLists+--  , matrix+--  , matrixUsingRowGen+    -- * Combining and querying matrices+  , size+  , square+  , isEmpty+  , isSingleton+  , SparseMatrix.all, SparseMatrix.any+  , add, intersectWith, SparseMatrix.zip+  , mul+  , transpose+  , diagonal+    -- * Modifying matrices+  , addRow+  , addColumn+    -- * Tests+  ) where++import Data.Array+import qualified Data.List as List+import Data.Monoid++-- import Test.QuickCheck++import Semiring (HasZero(..), SemiRing, Semiring)+import qualified Semiring as Semiring++++------------------------------------------------------------------------+-- Basic data types++-- | This matrix type is used for tests.++type TM = Matrix Integer Integer++-- | Size of a matrix.++data Size i = Size { rows :: i, cols :: i }+  deriving (Eq, Ord, Show)++sizeInvariant :: (Ord i, Num i) => Size i -> Bool+sizeInvariant sz = rows sz >= 0 && cols sz >= 0++{-+instance (Arbitrary i, Integral i) => Arbitrary (Size i) where+  arbitrary = do+    r <- natural+    c <- natural+    return $ Size { rows = fromInteger r, cols = fromInteger c }++instance CoArbitrary i => CoArbitrary (Size i) where+  coarbitrary (Size rs cs) = coarbitrary rs . coarbitrary cs++prop_Arbitrary_Size :: Size Integer -> Bool+prop_Arbitrary_Size = sizeInvariant+-}++-- | Converts a size to a set of bounds suitable for use with+-- the matrices in this module.++toBounds :: Num i => Size i -> (MIx i, MIx i)+toBounds sz = (MIx { row = 1, col = 1 }, MIx { row = rows sz, col = cols sz })++-- | Type of matrix indices (row, column).++data MIx i = MIx { row, col :: i }+  deriving (Eq, Show, Ix, Ord)++{-+instance (Arbitrary i, Integral i) => Arbitrary (MIx i) where+  arbitrary = do+    r <- positive+    c <- positive+    return $ MIx { row = r, col = c }++instance CoArbitrary i => CoArbitrary (MIx i) where+  coarbitrary (MIx r c) = coarbitrary r . coarbitrary c+-}++-- | No nonpositive indices are allowed.++mIxInvariant :: (Ord i, Num i) => MIx i -> Bool+mIxInvariant i = row i >= 1 && col i >= 1++prop_Arbitrary_MIx :: MIx Integer -> Bool+prop_Arbitrary_MIx = mIxInvariant++-- | Type of matrices, parameterised on the type of values.++data Matrix i b = M { size :: Size i, unM :: [(MIx i, b)] }+  deriving (Ord)++instance (Ord i, Eq a, HasZero a) => Eq (Matrix i a) where+  m1 == m2 = size m1 == size m2 && +    SparseMatrix.all (uncurry (==)) (SparseMatrix.zip m1 m2)++instance Functor (Matrix i) where+  fmap f (M sz m) = M sz (map (\ (i,a) -> (i, f a)) m)++matrixInvariant :: (Num i, Ix i) => Matrix i b -> Bool+matrixInvariant m = List.all (\ (MIx i j, b) -> 1 <= i && i <= rows sz+                                             && 1 <= j && j <= cols sz) (unM m)+  && strictlySorted (MIx 0 0) (unM m)+  && sizeInvariant sz+  where sz = size m++-- matrix indices are lexicographically sorted with no duplicates+-- Ord MIx should be the lexicographic one already (Haskell report)++strictlySorted :: (Ord i) => i -> [(i, b)] -> Bool+strictlySorted i [] = True+strictlySorted i ((i', b) : l) = i < i' && strictlySorted i' l+{-+strictlySorted (MIx i j) [] = True+strictlySorted (MIx i j) ((MIx i' j', b) : l) =+  (i < i' || i == i' &&  j < j' ) && strictlySorted (MIx i' j') b+-}++instance (Ord i, Integral i, Enum i, Show i, Show b, HasZero b) => Show (Matrix i b) where+  showsPrec _ m =+    showString "SparseMatrix.fromLists " . shows (size m) .+    showString " " . shows (toLists m)++{-+instance (Integral i, HasZero b, Pretty b) =>+         Pretty (Matrix i b) where+  pretty = vcat . map (hsep . map pretty) . toLists++instance (Arbitrary i, Num i, Integral i, Arbitrary b, HasZero b)+         => Arbitrary (Matrix i b) where+  arbitrary     = matrix =<< arbitrary++instance (Ord i, Integral i, Enum i, CoArbitrary b, HasZero b) => CoArbitrary (Matrix i b) where+  coarbitrary m = coarbitrary (toLists m)+++prop_Arbitrary_Matrix :: TM -> Bool+prop_Arbitrary_Matrix = matrixInvariant+-}++------------------------------------------------------------------------+-- Generating and creating matrices++-- | Generates a matrix of the given size, using the given generator+-- to generate the rows.++{-+matrixUsingRowGen :: (Arbitrary i, Integral i, Arbitrary b, HasZero b)+  => Size i+  -> (i -> Gen [b])+     -- ^ The generator is parameterised on the size of the row.+  -> Gen (Matrix i b)+matrixUsingRowGen sz rowGen = do+  rows <- vectorOf (fromIntegral $ rows sz) (rowGen $ cols sz)+  return $ fromLists sz rows+-}++-- | Generates a matrix of the given size.++{-+matrix :: (Arbitrary i, Integral i, Arbitrary b, HasZero b)+  => Size i -> Gen (Matrix i b)+matrix sz = matrixUsingRowGen sz (\n -> vectorOf (fromIntegral n) arbitrary)++prop_matrix sz = forAll (matrix sz :: Gen TM) $ \m ->+--  matrixInvariant m &&+  size m == sz+-}++-- | Constructs a matrix from a list of (index, value)-pairs.++-- compareElt = (\ (i,_) (j,_) -> compare i j)+-- normalize = filter (\ (i,b) -> b /= zeroElement)++fromIndexList :: (Ord i, HasZero b) => Size i -> [(MIx i, b)] -> Matrix i b+fromIndexList sz = M sz . List.sortBy (\ (i,_) (j,_) -> compare i j) . filter (\ (i,b) -> b /= zeroElement)++prop_fromIndexList :: TM -> Bool+prop_fromIndexList m = matrixInvariant m' && m' == m+  where vs = unM m+        m' = fromIndexList (size m) vs++-- | @'fromLists' sz rs@ constructs a matrix from a list of lists of+-- values (a list of rows).+--+-- Precondition: @'length' rs '==' 'rows' sz '&&' 'all' (('==' 'cols' sz) . 'length') rs@.++fromLists :: (Ord i, Num i, Enum i, HasZero b) => Size i -> [[b]] -> Matrix i b+fromLists sz bs = fromIndexList sz $ +  List.zip ([ MIx i j | i <- [1..rows sz] , j <- [1..cols sz]]) (concat bs)++-- | Converts a sparse matrix to a sparse list of rows++toSparseRows :: (Num i, Enum i, Eq i) => Matrix i b -> [(i,[(i,b)])]+toSparseRows m = aux 1 [] (unM m)+  where aux i' [] []  = []+        aux i' row [] = [(i', reverse row)]+        aux i' row ((MIx i j, b) : m)+            | i' == i   = aux i' ((j,b):row) m+            | otherwise = (i', reverse row) : aux i [(j,b)] m++-- sparse vectors cannot have two entries in one column+blowUpSparseVec :: (Eq i, Ord i, Num i, Enum i, Show i) => b -> i -> [(i,b)] -> [b]+blowUpSparseVec zero n l = aux 1 l+  where aux i [] | i > n = []+                 | otherwise = zero : aux (i+1) []+        aux i ((j,b):l) | i <= n && j == i = b : aux (succ i) l+        aux i ((j,b):l) | i <= n && j >= i = zero : aux (succ i) ((j,b):l)+        aux i l = error $ "blowUpSparseVec (n = " ++ show n ++ ") aux i=" ++ show i ++ " j=" ++ show (fst (head l)) ++ " length l = " ++ show (length l)+-- __IMPOSSIBLE__++-- | Converts a matrix to a list of row lists.++toLists :: (Ord i, Integral i, Enum i, HasZero b, Show i) => Matrix i b -> [[b]]+toLists m = blowUpSparseVec emptyRow (rows sz) $+    map (\ (i,r) -> (i, blowUpSparseVec zeroElement (cols sz) r)) $ toSparseRows m+--            [ [ maybe zeroElement id $ lookup (MIx { row = r, col = c }) (unM m)+--            | c <- [1 .. cols sz] ] | r <- [1 .. rows sz] ]+  where sz = size m+        emptyRow = take (fromIntegral (cols sz)) $ repeat zeroElement++prop_fromLists_toLists :: TM -> Bool+prop_fromLists_toLists m = fromLists (size m) (toLists m) == m++------------------------------------------------------------------------+-- Combining and querying matrices++-- | The size of a matrix.++{-+size :: Ix i => Matrix i b -> Size i+size m = Size { rows = row b, cols = col b }+  where (_, b) = bounds $ unM m+-}++prop_size :: TM -> Bool+prop_size m = sizeInvariant (size m)+++prop_size_fromIndexList :: Size Int -> Bool+prop_size_fromIndexList sz =+  size (fromIndexList sz ([] :: [(MIx Int, Integer)])) == sz++-- | 'True' iff the matrix is square.++square :: Ix i => Matrix i b -> Bool+square m = rows (size m) == cols (size m)++-- | Returns 'True' iff the matrix is empty.++isEmpty :: (Num i, Ix i) => Matrix i b -> Bool+isEmpty m = rows sz <= 0 || cols sz <= 0+  where sz = size m++-- | Returns 'Just b' iff it is a 1x1 matrix with just one entry 'b'.++isSingleton :: (Num i, Ix i, HasZero b) => Matrix i b -> Maybe b+isSingleton m = if (rows sz == 1 || cols sz == 1) then+    case unM m of+      [(_,b)] -> Just b+      []      -> Just zeroElement+  else Nothing+  where sz = size m++-- | Transposition+transposeSize (Size { rows = n, cols = m }) = Size { rows = m, cols = n }+transpose m = M { size = transposeSize (size m)+                , unM  = List.sortBy (\ (i,a) (j,b) -> compare i j) $+                           map (\(MIx i j, b) -> (MIx j i, b)) $ unM m }++all :: (a -> Bool) -> Matrix i a -> Bool+all p m = List.all (\ (i,a) -> p a) (unM m)++any :: (a -> Bool) -> Matrix i a -> Bool+any p m = List.any (\ (i,a) -> p a) (unM m)++-- | @'zip' m1 m2@ zips @m1@ and @m2@. +--+-- Precondition: @'size' m1 == 'size' m2@.++zip :: (Ord i, HasZero a) => Matrix i a -> Matrix i a -> Matrix i (a,a)+zip m1 m2 = M (size m1) $ zips (unM m1) (unM m2) where+  zips [] m = map (\ (i,b) -> (i,(zeroElement,b))) m+  zips l [] = map (\ (i,a) -> (i,(a,zeroElement))) l+  zips l@((i,a):l') m@((j,b):m')+    | i < j = (i,(a,zeroElement)) : zips l' m+    | i > j = (j,(zeroElement,b)) : zips l m'+    | otherwise = (i,(a,b)) : zips l' m'++-- | @'add' (+) m1 m2@ adds @m1@ and @m2@. Uses @(+)@ to add values.+--+-- Precondition: @'size' m1 == 'size' m2@.++add :: (Ord i) => (a -> a -> a) -> Matrix i a -> Matrix i a -> Matrix i a+add plus m1 m2 = M (size m1) $ mergeAssocWith plus (unM m1) (unM m2)++-- | assoc list union+mergeAssocWith :: (Ord i) => (a -> a -> a) -> [(i,a)] -> [(i,a)] -> [(i,a)]+mergeAssocWith f [] m = m+mergeAssocWith f l [] = l+mergeAssocWith f l@((i,a):l') m@((j,b):m')+    | i < j = (i,a) : mergeAssocWith f l' m+    | i > j = (j,b) : mergeAssocWith f l m'+    | otherwise = (i, f a b) : mergeAssocWith f l' m'++-- | @'intersectWith' f m1 m2@ build the pointwise conjunction @m1@ and @m2@.+--   Uses @f@ to combine non-zero values.+--+-- Precondition: @'size' m1 == 'size' m2@.++intersectWith :: (Ord i) => (a -> a -> a) -> Matrix i a -> Matrix i a -> Matrix i a+intersectWith f m1 m2 = M (size m1) $ interAssocWith f (unM m1) (unM m2)++-- | assoc list intersection+interAssocWith :: (Ord i) => (a -> a -> a) -> [(i,a)] -> [(i,a)] -> [(i,a)]+interAssocWith f [] m = []+interAssocWith f l [] = []+interAssocWith f l@((i,a):l') m@((j,b):m')+    | i < j = interAssocWith f l' m+    | i > j = interAssocWith f l m'+    | otherwise = (i, f a b) : interAssocWith f l' m'++{-+prop_add sz =+  forAll (three (matrix sz :: Gen TM)) $ \(m1, m2, m3) ->+    let m' = add (+) m1 m2 in+      associative (add (+)) m1 m2 m3 &&+      commutative (add (+)) m1 m2 &&+      matrixInvariant m' &&+      size m' == size m1+-}++-- | @'mul' semiring m1 m2@ multiplies @m1@ and @m2@. Uses the+-- operations of the semiring @semiring@ to perform the+-- multiplication.+--+-- Precondition: @'cols' ('size' m1) == rows ('size' m2)@.++{- mul A B works as follows:+* turn A into a list of sparse rows and the transposed B as well+* form the crossproduct using the inner vector product to compute els+* the inner vector product is summing up+  after intersecting with the muliplication op of the semiring+-}++mul :: (Enum i, Num i, Ix i, Eq a)+    => Semiring a -> Matrix i a -> Matrix i a -> Matrix i a+mul semiring m1 m2 = M (Size { rows = rows (size m1), cols = cols (size m2) }) $+  filter (\ (i,b) -> b /= Semiring.zero semiring) $+  [ (MIx i j, foldl (Semiring.add semiring) (Semiring.zero semiring) $+                map snd $ interAssocWith (Semiring.mul semiring) v w)+    | (i,v) <- toSparseRows m1+    , (j,w) <- toSparseRows $ transpose m2 ]++{-+prop_mul sz =+  sized $ \n -> resize (n `div` 2) $+  forAll (two natural) $ \(c2, c3) ->+  forAll (matrix sz :: Gen TM) $ \m1 ->+  forAll (matrix (Size { rows = cols sz, cols = c2 })) $ \m2 ->+  forAll (matrix (Size { rows = c2, cols = c3 })) $ \m3 ->+    let m' = mult m1 m2 in+      associative mult m1 m2 m3 &&+      matrixInvariant m' &&+      size m' == Size { rows = rows sz, cols = c2 }+  where mult = mul Semiring.integerSemiring+-}++-- | @'diagonal' m@ extracts the diagonal of @m@.+--+-- Precondition: @'square' m@.++diagonal :: (Enum i, Num i, Ix i, Show i, HasZero b) => Matrix i b -> [b]+diagonal m = blowUpSparseVec zeroElement (rows sz) $+  map (\ ((MIx i j),b) -> (i,b)) $ filter (\ ((MIx i j),b) -> i==j) (unM m)+  where sz = size m++{-+diagonal :: (Enum i, Num i, Ix i, HasZero b) => Matrix i b -> Array i b+diagonal m = listArray (1, rows sz) $ blowUpSparseVec zeroElement (rows sz) $+  map (\ ((MIx i j),b) -> (i,b)) $ filter (\ ((MIx i j),b) -> i==j) (unM m)+  where sz = size m+-}++{-+prop_diagonal =+  forAll natural $ \n ->+  forAll (matrix (Size n n) :: Gen TM) $ \m ->+    bounds (diagonal m) == (1, n)+-}++------------------------------------------------------------------------+-- Modifying matrices++-- | @'addColumn' x m@ adds a new column to @m@, after the columns+-- already existing in the matrix. All elements in the new column get+-- set to @x@.++addColumn :: (Num i, HasZero b) => b -> Matrix i b -> Matrix i b+addColumn x m | x == zeroElement = m { size = (size m) { cols = cols (size m) + 1 }}+--              | otherwise = __IMPOSSIBLE__++{-+prop_addColumn :: TM -> Bool+prop_addColumn m =+  matrixInvariant m'+  &&+  map init (toLists m') == toLists m+  where+  m' = addColumn zeroElement m+-}++-- | @'addRow' x m@ adds a new row to @m@, after the rows already+-- existing in the matrix. All elements in the new row get set to @x@.++addRow :: (Num i, HasZero b) => b -> Matrix i b -> Matrix i b+addRow x m | x == zeroElement = m { size = (size m) { rows = rows (size m) + 1 }}+--           | otherwise = __IMPOSSIBLE__++prop_addRow :: TM -> Bool+prop_addRow m =+  matrixInvariant m'+  &&+  init (toLists m') == toLists m+  where+  m' = addRow zeroElement m++------------------------------------------------------------------------+-- Zipping (assumes non-empty matrices)++{- use mergeAssocList or interAssocList instead+zipWith :: (a -> b -> c) ->+           Matrix Integer a -> Matrix Integer b -> Matrix Integer c+zipWith f m1 m2+  = fromLists (Size { rows = toInteger $ length ll,+                      cols = toInteger $ length (head ll) }) ll+    where ll = List.zipWith (List.zipWith f) (toLists m1) (toLists m2)+-}+
+ TCM.hs view
@@ -0,0 +1,1523 @@+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, PatternGuards, FlexibleContexts, NamedFieldPuns, DeriveFunctor, DeriveFoldable, DeriveTraversable, TupleSections #-}++module TCM where++import Prelude hiding (null)++import Control.Monad+import Control.Monad.IfElse+import Control.Monad.Identity+import Control.Monad.State+import Control.Monad.Error+import Control.Monad.Reader++import Control.Applicative+import Data.Foldable (Foldable)+import qualified Data.Foldable as Foldable+import Data.Traversable (Traversable)+import qualified Data.Traversable as Traversable+import Data.Monoid++import Data.Map (Map)+import qualified Data.Map as Map+import qualified Data.Maybe as Maybe++import Debug.Trace++import Abstract+import Polarity+import Value+import {-# SOURCE #-} Eval -- (up,whnf')+import PrettyTCM++-- import CallStack+import TraceError++import TreeShapedOrder (TSO)+import qualified TreeShapedOrder as TSO++import Util++import Warshall++-- traceSig msg a = trace msg a+traceSig msg a = a++traceRew msg a = a -- trace msg a+traceRewM msg = return () -- traceM msg+{-+traceRew msg a = trace msg a+traceRewM msg = traceM msg+-}++-- metavariables and constraints++traceMeta msg a = a -- trace msg a+traceMetaM msg = return () -- traceM msg+{-+traceMeta msg a = trace msg a+traceMetaM msg = traceM msg+-}+++-- type checking monad -----------------------------------------------++class (MonadCxt m, MonadSig m, MonadMeta m, MonadError TraceError m) =>+  MonadTCM m where+++-- lists of exactly one or two elements ------------------------------++-- this would have been better implemented by just lists and a view+--   type OneOrTwo a = [a]+--   data View12 a = One a | Two a a+--   fromList12+-- then one could still get completeness of pattern matching!+-- now we have lots of boilerplate code++data OneOrTwo a = One a | Two a a deriving (Eq, Ord, Functor, Foldable, Traversable)++instance Show a => Show (OneOrTwo a) where+  show (One a)   = show a+  show (Two a b) = show a ++ "||" ++ show b++name12 :: OneOrTwo Name -> Name+name12 (One n) = n+name12 (Two n1 n2)+  | null (suggestion n2) = n1+  | null (suggestion n1) = n2+  | suggestion n1 == suggestion n2 = n1+  | otherwise = fresh (suggestion n1 ++ "||" ++ suggestion n2)++{-+instance Functor OneOrTwo where+  fmap f (One a)   = One (f a)+  fmap f (Two a b) = Two (f a) (f b)++instance Foldable OneOrTwo where+  foldMap f (One a) = f a+  foldMap f (Two a b) = f a `mappend` f b++-- traverse :: Applicative f => (a -> f b) -> t a -> f (t b)+instance Traversable OneOrTwo where+  traverse f (One a) = One <$> f a+  traverse f (Two a b) = Two <$> f a <*> f b+-}++-- eliminator+oneOrTwo :: (a -> b) -> (a -> a -> b) -> OneOrTwo a -> b+oneOrTwo f g (One a) = f a+oneOrTwo f g (Two a1 a2) = g a1 a2++fromOne :: OneOrTwo a -> a+fromOne (One a) = a++toTwo :: OneOrTwo a -> OneOrTwo a+toTwo = oneOrTwo (\ a -> Two a a) Two++first12 :: OneOrTwo a -> a+first12 (One a) = a+first12 (Two a1 a2) = a1++second12 :: OneOrTwo a -> a+second12 (One a) = a+second12 (Two a1 a2) = a2++mapSecond12 :: (a -> a) -> OneOrTwo a -> OneOrTwo a+mapSecond12 f (One a) = One (f a)+mapSecond12 f (Two a1 a2) = Two a1 (f a2)++zipWith12 :: (a -> b -> c) -> OneOrTwo a -> OneOrTwo b -> OneOrTwo c+zipWith12 f (One a) (One b) = One (f a b)+zipWith12 f (Two a a') (Two b b') = Two (f a b) (f a' b')++zipWith123 :: (a -> b -> c -> d) ->+              OneOrTwo a -> OneOrTwo b -> OneOrTwo c -> OneOrTwo d+zipWith123 f (One a) (One b) (One c) = One (f a b c)+zipWith123 f (Two a a') (Two b b') (Two c c') = Two (f a b c) (f a' b' c')++toList12 :: OneOrTwo a -> [a]+toList12 (One a) = [a]+toList12 (Two a1 a2) = [a1,a2]++fromList12 :: Show a => [a] -> OneOrTwo a+fromList12 [a]     = One a+fromList12 [a1,a2] = Two a1 a2+fromList12 l = error $ "fromList12 " ++ show l++toMaybe12 :: Show a => [a] -> Maybe (OneOrTwo a)+toMaybe12 []      = Nothing+toMaybe12 [a]     = Just $ One a+toMaybe12 [a1,a2] = Just $ Two a1 a2+toMaybe12 l = error $ "toMaybe12 " ++ show l+++-- reader monad for local environment++data TCContext = TCContext+  { context   :: SemCxt+  , renaming  :: Ren       -- assigning de Bruijn Levels to names+  , naming    :: Map Int Name  -- assigning names to de Bruijn levels+--  , nameVariants :: Map Name Int -- how many variants of the name+  , environ   :: Env2+  , rewrites  :: Rewrites+  , sizeRels  :: TSO Int   -- relations of universal (rigid) size variables+                           -- collected from size patterns (x > y)+  , belowInfty:: [Int]     -- list of size variables < #+  , bounds    :: [Bound Val]  -- bound hyps that do not fit in sizeRels+  , consistencyCheck :: Bool -- ^ Do we need to check that new size relations are consistent with every valuation of the current @sizeRels@? [See ICFP 2013 paper]+  , checkingConType :: Bool  -- different PTS rules for constructor types (parametric function space!)+  , assertionHandling :: AssertionHandling -- recover from errors?+  , impredicative :: Bool       -- use impredicative PTS rules+  -- checking measured functions+  , funsTemplate :: Map Name (Kinded Fun) -- types of mutual funs with measures checking body+  , mutualFuns :: Map Name SigDef -- types of mutual funs while checking body+  , mutualCo :: Co                -- mutual block (co)recursive ?+  , mutualNames :: [Name] -- ^ The defined names of the current mutual block (and parents).+  , checkingMutualName :: Maybe DefId -- which body of a mutual block am I checking?+  , callStack :: [QName] -- ^ Used to avoid looping when going into recursive data definitions.+  }++instance Show TCContext where+    show ce = show (environ ce) ++ "; " ++ show (context ce)++emptyContext = TCContext+  { context  = cxtEmpty+  , renaming = Map.empty+  , naming   = Map.empty+  , environ  = emptyEnv+  , rewrites = emptyRewrites+  , sizeRels = TSO.empty+  , belowInfty = []+  , bounds   = []+  , consistencyCheck = False -- initially, no consistency check, turned on when entering rhs+  , checkingConType = False+  , assertionHandling = Failure  -- default is not to ignore any errors+  , impredicative = False+  , funsTemplate = Map.empty+  , mutualFuns = Map.empty+  , mutualCo = Ind+  , mutualNames = []+  , checkingMutualName = Nothing+  , callStack = []+  }++-- state monad for global signature++data TCState = TCState+  { signature   :: Signature+  , metaVars    :: MetaVars+  , constraints :: Constraints+  , positivityGraph :: PositivityGraph+  -- , dots        :: Dots -- UNUSED+  }++type MetaVars = Map MVar MetaVar+emptyMetaVars = Map.empty++type MScope = [Name] -- ^ names of size variables which are in scope of mvar+data MetaVar = MetaVar+  { mscope   :: MScope+  , solution :: Maybe Val+  }++type PosConstrnt = Constrnt PPoly DefId ()+type PositivityGraph = [PosConstrnt]+emptyPosGraph = []++-- type TypeCheck = StateT TCState (ReaderT TCContext (CallStackT String IO))+type TypeCheck = StateT TCState (ReaderT TCContext (ErrorT TraceError IO))++instance MonadAssert TypeCheck where+  assert b s = do+    h <- asks assertionHandling+    assert' h b s+  newAssertionHandling h = local ( \ ce -> ce { assertionHandling = h })++{- mtl-2 provides these instances+-- TypeCheck is applicative since every monad is.+-- I do not know why this ain't in the libraries...+instance Applicative TypeCheck where+  pure      = return+  mf <*> ma = mf >>= \ f -> ma >>= \ a -> pure (f a)+-}++{- NOT NEEDED++-- | Dotted constructors (the top one in the pattern).+type Dots = [(Dotted,Pattern)]++emptyDots = []++class LensDots a where+  getDots :: a -> Dots+  setDots :: Dots -> a -> a+  setDots = mapDots . const+  mapDots :: (Dots -> Dots) -> a -> a+  mapDots f a = setDots (f (getDots a)) a++instance LensDots TCState where+  getDots = dots+  setDots d st = st { dots = d }++newDotted :: Pattern -> TypeCheck Dotted+newDotted p = do+  d <- mkDotted True+  modify $ mapDots $ ((d,p):)+  return d++clearDots :: TypeCheck ()+clearDots = modify $ setDots emptyDots++openDots :: TypeCheck [Pattern]+openDots = map snd . filter (isDotted . fst) <$> gets dots+-}++-- rewriting rules -----------------------------------------------++data Rewrite  = Rewrite { lhs :: Val,  rhs :: Val }+type Rewrites = [Rewrite]++emptyRewrites = []++instance Show Rewrite where+  show rr = show (lhs rr) ++ " --> " ++ show (rhs rr)++{- renaming ------------------------------------------------------++  A renaming maps names to de Bruijn levels (= generic values).+-}++type Ren = Map Name Int++type Env2 = Environ (OneOrTwo Val)++type Context a = Map Int a+type Context2 a = Context (OneOrTwo a)++{- context -------------------------------------------------------++A context maps generic values to their type value.++During type checking, named variables are mapped to+generic values via a renaming.  Thus, looking up the type of a+name involves first looking up the generic value, and then its type.++-}++{-+-- data Domain = Domain { typ :: TVal, decor :: Dec }+data Domain = Domain { typ :: TVal, kind :: Class, decor :: Dec }++mapTyp :: (TVal -> TVal) -> Domain -> Domain+mapTyp f dom = dom { typ = f (typ dom) }++mapTypM :: Monad m => (TVal -> m TVal) -> Domain -> m Domain+mapTypM f dom = do+  t' <- f (typ dom)+  return $ dom { typ = t' }++instance Show Domain where+  show item = (if erased (decor item) then brackets else id) (show (typ item))+-}++-- During heterogeneous equality, a variable might have+-- two different types, one on the left and one on the right.+-- We implement this as Two tl tr.++data CxtE a = CxtEntry { domain :: a, upperDec :: UDec }+type CxtEntry  = CxtE (OneOrTwo Domain)+type CxtEntry1 = CxtE Domain++data SemCxt = SemCxt+  { len   :: Int+  , cxt   :: Context2 Domain  -- fixed part of context+  , upperDecs :: Context UDec -- the "should be below" decoration for each var.; this is updated by resurrection+  }+{- invariant: length (cxt delta) = length (upperDecs delta) = len+     cxt(i) = Two ... iff  upperDecs(i) = Two ...+ -}++instance Show SemCxt where+  show delta =+    show $ zip (Map.elems (cxt delta))+               (Map.elems (upperDecs delta))+{-+  show delta = show $ zip (+    zipWith3 (zipWith12 Domain)+--    zipWith (\ entry dec -> fmap ((flip Domain) dec) entry)+      (Map.elems (cxt delta))+      (Map.elems (kinds delta))+      (Map.elems (decs delta))+    ) (Map.elems (upperDecs delta))+-}+cxtEmpty = SemCxt+  { len = 0+  , cxt = Map.empty+--  , kinds = Map.empty+--  , decs = Map.empty+  , upperDecs = Map.empty+  }++-- push a new type declaration on context+cxtPush' :: OneOrTwo Domain -> SemCxt -> SemCxt+cxtPush' entry delta =+  delta { len = k + 1+        , cxt  = Map.insert k entry (cxt delta)+--        , cxt  = Map.insert k (fmap typ   entry) (cxt delta)+--        , decs = Map.insert k (fmap decor entry) (decs delta)+        , upperDecs = Map.insert k defaultUpperDec (upperDecs delta)+        }+  where k = len delta+{-+cxtPush' (tv12, dec) delta =+  delta { len = k + 1+        , cxt  = Map.insert k tv12 (cxt delta)+        , decs = Map.insert k dec (decs delta) }+  where k = len delta+-}+{-+cxtPush :: Dec -> TVal -> SemCxt -> (Int, SemCxt)+cxtPush dec v delta = (len delta, cxtPush' (One (Domain v dec)) delta)+-- cxtPush dec v delta = (len delta, cxtPush' (One v, dec) delta)+-}++cxtPushEntry :: OneOrTwo Domain -> SemCxt -> (Int, SemCxt)+cxtPushEntry ce delta = (len delta, cxtPush' ce delta)++cxtPush :: Domain -> SemCxt -> (Int, SemCxt)+cxtPush dom delta = cxtPushEntry (One dom) delta+-- cxtPush dec v delta = (len delta, cxtPush' (One v, dec) delta)++-- push a variable with a left and a right type+cxtPush2 :: Domain -> Domain -> SemCxt -> (Int, SemCxt)+cxtPush2 doml domr delta = cxtPushEntry (Two doml domr) delta+--  (len delta, cxtPush' (Two doml domr) delta)++{-+-- push a variable with a left and a right type+cxtPush2 :: Dec -> TVal -> TVal -> SemCxt -> (Int, SemCxt)+cxtPush2 dec tvl tvr delta =+  (len delta, cxtPush' (Two tvl tvr, dec) delta)+-}++cxtPushGen ::  Name -> SemCxt -> (Int, SemCxt)+cxtPushGen x delta = cxtPush bot delta+  where bot = error $ "IMPOSSIBLE: name " ++ show x ++ " is not bound to any type"++-- only defined for single bindings+cxtSetType :: Int -> Domain -> SemCxt -> SemCxt+cxtSetType k dom delta =+  delta { cxt  = Map.insert k (One dom) (cxt delta)+        -- upperDecs need not be updated+        }++{-+-- only defined for single bindings+cxtSetType :: Int -> Dec -> TVal -> SemCxt -> SemCxt+cxtSetType k dec tv delta =+  delta { cxt  = Map.insert k (One tv) (cxt delta)+        , decs = Map.insert k (One dec) (decs delta)+        -- upperDecs need not be updated+        }+--        , decs = Map.insert k dec (decs delta) }+-}+{-+cxtLookupGen :: Monad m => SemCxt -> Int -> m Domain+cxtLookupGen delta k = do+  One tv  <- lookupM k (cxt delta)+  One dec <- lookupM k (decs delta)+--  dec    <- lookupM k (decs delta)+  return $ Domain { typ = tv, decor = dec }++cxtLookupGen :: Monad m => SemCxt -> Int -> m CxtEntry+cxtLookupGen delta k = do+  tv12  <- lookupM k (cxt delta)+  dec12 <- lookupM k (decs delta)+  udec  <- lookupM k (upperDecs delta)+  return $ CxtEntry (zipWith12 Domain tv12 dec12) udec+-}+cxtLookupGen :: Monad m => SemCxt -> Int -> m CxtEntry+cxtLookupGen delta k = do+  dom12 <- lookupM k (cxt delta)+  udec  <- lookupM k (upperDecs delta)+  return $ CxtEntry dom12 udec++cxtLookupName :: Monad m => SemCxt -> Ren -> Name -> m CxtEntry+cxtLookupName delta ren x = do+  i <- lookupM x ren+  cxtLookupGen delta i++{-+cxtLookupName :: Monad m => SemCxt -> Ren -> Name -> m Domain+cxtLookupName delta ren x = do+  i <- lookupM x ren+  cxtLookupGen delta i+-}++-- apply decoration, possibly resurrecting (see Pfenning, LICS 2001)+-- and changing polarities (see Abel, MSCS 2008)+cxtApplyDec :: Dec -> SemCxt -> SemCxt+cxtApplyDec dec delta = delta { upperDecs = Map.map (compDec dec) (upperDecs delta) }+-- cxtApplyDec dec delta =  delta { decs = Map.map (fmap $ invCompDec dec) (decs delta) }++{- RETIRED, use cxtApplyDec instead+-- clear all "erased" flags (see Pfenning, LICS 2001)+-- UPDATE: resurrection sets "target" status to erased+--         (as opposed to setting "source" status to non-erased)+cxtResurrect :: SemCxt -> SemCxt+cxtResurrect delta = delta { upperDecs = Map.map (\ dec -> dec { erased = True}) (upperDecs delta) }+-- cxtResurrect delta = delta { decs = Map.map (fmap resurrectDec) (decs delta) }+-}++-- manipulating the context ------------------------------------------++{-+-- | Size decrements in bounded quantification do not count for termination+data LamPi+  = LamBind -- ^ add a lambda binding to the context+  | PiBind  -- ^ add a pi binding to the context+-}++class Monad m => MonadCxt m where+--  bind     :: Name -> Domain -> Val -> m a -> m a+--  new performs eta-expansion "up" of new gen+  -- adding types (Two t1 t2) returns values (Two (Up t1 vi) (Up t2 vi))+  newVar     :: Name -> OneOrTwo Domain -> (Int -> OneOrTwo Val -> m a) -> m a+  newWithGen :: Name -> Domain -> (Int -> Val -> m a) -> m a+  newWithGen x d k = newVar x (One d)+    (\ i (One v) -> k i v)+  new2WithGen:: Name -> (Domain, Domain) -> (Int -> (Val, Val) -> m a) -> m a+  new2WithGen x (doml, domr) k = newVar x (Two doml domr)+    (\ i (Two vl vr) -> k i (vl, vr))+  new        :: Name -> Domain -> (Val -> m a) -> m a+  new x d cont = newWithGen x d (\ _ -> cont)+  new2       :: Name -> (Domain, Domain) -> ((Val, Val) -> m a) -> m a+  new2 x d cont = new2WithGen x d (\ _ -> cont)+{-+  new2       :: Name -> (TVal, TVal, Dec) -> ((Val, Val) -> m a) -> m a+  new2 x d cont = new2WithGen x d (\ _ -> cont)+-}+  new'       :: Name -> Domain -> m a -> m a+  new' x d cont = new x d (\ _ -> cont)+  newIrr     :: Name -> m a -> m a  -- only add binding x = VIrr to env+  addName    :: Name -> (Val -> m a) -> m a+{- RETIRED+  addTypeSigs :: [TySig TVal] -> m a -> m a+  addTypeSigs [] k = k+  addTypeSigs (TypeSig n tv : tss) k =+    new' n (defaultDomain tv) $ addTypeSigs tss k+-}+  addKindedTypeSigs :: [Kinded (TySig TVal)] -> m a -> m a+  addKindedTypeSigs [] k = k+  addKindedTypeSigs (Kinded ki (TypeSig n tv) : ktss) k =+    new' n (Domain tv ki defaultDec) $ addKindedTypeSigs ktss k+--  addName x = new x dontCare+  setType    :: Int -> Domain -> m a -> m a+  setTypeOfName :: Name -> Domain -> m a -> m a+  genOfName  :: Name -> m Int+  nameOfGen  :: Int -> m Name+--  nameTaken  :: Name -> m Bool+  uniqueName :: Name -> Int -> m Name+  uniqueName x _ = return x -- $ freshen x -- TODO!  now freshen causes problems in extraction+{-+  uniqueName x k = ifM (nameTaken x) (return $ show x ++ "~" ++ show k) (return x)+-}+  lookupGen  :: Int -> m CxtEntry+  lookupGenType2 :: Int -> m (TVal, TVal)+  lookupGenType2 i = do+    entry <- lookupGen i+    case domain entry of+      One d1    -> return (typ d1, typ d1)+      Two d1 d2 -> return (typ d1, typ d2)+  lookupName :: Name -> m CxtEntry+  lookupName1 :: Name -> m CxtEntry1+  lookupName1 x = do+    e <- lookupName x+    return $ CxtEntry (fromOne (domain e)) (upperDec e)++  getContextTele :: m TeleVal  -- return context as telescope of type values+  getLen     :: m Int       -- return length of the context+  getEnv     :: m Env       -- return current environment+  getRen     :: m Ren       -- return current renaming+  applyDec   :: Dec -> m a -> m a  -- resurrect/adjust polarities+  resurrect  :: m a -> m a -- resurrect all erased variables in context+  resurrect = applyDec irrelevantDec+  addRewrite :: Rewrite -> [Val] -> ([Val] -> m a) -> m a+  addPattern :: TVal -> Pattern -> Env -> (TVal -> Val -> Env -> m a) -> m a -- step under pat+  addPatterns:: TVal -> [Pattern] -> Env -> (TVal -> [Val] -> Env -> m a) -> m a+  addSizeRel  :: Int -> Int -> Int -> m a -> m a+  addBelowInfty :: Int -> m a -> m a+  addBoundHyp :: Bound Val -> m a -> m a+  isBelowInfty :: Int -> m Bool+  sizeVarBelow :: Int -> Int -> m (Maybe Int)+--  getSizeDiff :: Int -> Int -> m (Maybe Int)+  getMinSize  :: Int -> m (Maybe Int)+  getSizeVarsInScope :: m [Name]+  checkingCon :: Bool -> m a -> m a+  checkingDom :: m a -> m a  -- check domain A of Pi x:A.B (takes care of polarities)+  setCo :: Co -> m a -> m a -- entering a recursive or corecursive function?+  installFuns :: Co -> [Kinded Fun] -> m a -> m a+  setMeasure  :: Measure Val -> m a -> m a+  activateFuns :: m a -> m a -- create instance of mutually recursive functions bounded by measure+  goImpredicative :: m a -> m a+  checkingMutual :: Maybe DefId -> m a -> m a++dontCare = error "Internal error: tried to retrieve unassigned type of variable"++instance MonadCxt TypeCheck where++  newIrr x = local (\ ce -> ce { environ = update (environ ce) x (One VIrr) })++  -- UPDATE to 2?+  addName x f = enter ("new " ++ show x ++ " : _") $ do+    cxtenv <- ask+    let (k, delta) = cxtPushGen x (context cxtenv)+    let v = VGen k+    let rho = update (environ cxtenv) x (One v)+    x' <- uniqueName x k+    local (\ cxt -> cxt { context = delta+                        , renaming = Map.insert x k (renaming cxtenv)+                        , naming = Map.insert k x' (naming cxt)+                        , environ = rho }) (f v)+++  newVar x dom12@(One (Domain (VBelow ltle v) ki dec)) f = do+    enter ("new " ++ show x ++ " " ++ show ltle ++ " " ++ show v) $ do+      cxtenv <- ask+      let (k, delta) = cxtPushEntry (One (Domain vSize kSize dec)) (context cxtenv)+      let xv  = VGen k+      let v12 = One xv+      let rho = update (environ cxtenv) x v12+      let beta = Bound ltle (Measure [xv]) (Measure [v])+      x' <- uniqueName x k+      local (\ cxt -> cxt { context = delta+                          , renaming = Map.insert x k (renaming cxtenv)+                          , naming = Map.insert k x' (naming cxtenv)+                          , environ = rho }) $+        addBoundHyp beta $ (f k v12)+++  newVar x dom12 f = do+    let tv12 = fmap typ dom12+    enter ("new " ++ show x ++ " : " ++ show tv12) $ do+      cxtenv <- ask+      let (k, delta) = cxtPushEntry dom12 (context cxtenv)+      v12 <- Traversable.mapM (up False (VGen k)) tv12+      let rho = update (environ cxtenv) x v12+      x' <- uniqueName x k+      local (\ cxt -> cxt { context = delta+                          , renaming = Map.insert x k (renaming cxtenv)+                          , naming = Map.insert k x' (naming cxtenv)+                          , environ = rho }) (f k v12)+{-+  newVar x (tv12, dec) f = enter ("new " ++ x ++ " : " ++ show tv12) $ do+    cxtenv <- ask+    let (k, delta) = cxtPushEntry (tv12, dec) (context cxtenv)+    v12 <- Traversable.mapM (up (VGen k)) tv12+    let rho = update (environ cxtenv) x v12+    local (\ cxt -> cxt { context = delta+                        , renaming = Map.insert x k (renaming cxtenv)+                        , environ = rho }) (f k v12)+-}+  setType k dom =+    local (\ ce -> ce { context = cxtSetType k dom (context ce) })++  setTypeOfName x dom cont = do+    ce <- ask+    let Just k = Map.lookup x (renaming ce)+    setType k dom cont++  genOfName x = do+    ce <- ask+    case Map.lookup x (renaming ce) of+      Nothing -> fail $ "internal error: variable not bound: " ++ show x+      Just k -> return k++  nameOfGen k = do+    ce <- ask+    case Map.lookup k (naming ce) of+      Nothing -> return $ fresh $ "error_unnamed_gen" ++ show k+       -- fail $ "internal error: no name for variable " ++ show k+      Just x -> return x++{-+  nameTaken "" = return True+  nameTaken x = do+    ce <- ask+    st <- get+    return (Map.member x (renaming ce) || Map.member x (signature st))+-}++  lookupGen k = do+    ce <- ask+    cxtLookupGen (context ce) k++  lookupName x = do+    ce <- ask+    cxtLookupName (context ce) (renaming ce) x++  -- does not work with shadowing!+  getContextTele = do+    ce <- ask+    let cxt = context ce+    let ren = renaming ce+    let env = envMap $ environ ce+    let mkTBind (x,_) = (TBind x .fromOne . domain) <$> cxtLookupName cxt ren x+    mapM mkTBind env++  getLen = do+    ce <- ask+    return $ len (context ce)++  getRen = do+    ce <- ask+    return $ renaming ce++  -- since we only use getEnv during type checking, no case for Two+  -- (during equality/subtype checking, we have values)+  getEnv = do+    ce <- ask+    let (Environ rho mmeas) = environ ce+    return $ Environ (map (\ (x, One v) -> (x, v)) rho) mmeas++  applyDec dec = local (\ ce -> ce { context = cxtApplyDec dec (context ce) })+--  applyDec dec = local (\ ce -> ce { upperDecs = Map.map (compDec dec) (upperDecs ce) })++  -- resurrection sets "target" status to erased+  -- (as opposed to setting "source" status to non-erased)+{-+  resurrect = local (\ ce -> ce { upperDecs =+    Map.map (\ dec -> dec { erased = True }) (upperDecs ce) })+-}+{-+  resurrect = local (\ ce -> ce { context = cxtResurrect (context ce) })+-}+++  -- PROBABLY TOO INEFFICIENT+  addRewrite rew vs cont = traceRew ("adding rewrite " ++ show rew) $+    -- add rewriting rule+    local (\ cxt -> cxt { rewrites = rew : (rewrites cxt) }) $ do+      ce <- ask+      -- normalize all types in context+      traceRewM "normalizing types in context"+      cx' <- mapMapM (Traversable.mapM (Traversable.mapM reval)) (cxt (context ce))  -- LOOP!+      -- normalize environment+      traceRewM "normalizing environment"+      let Environ rho mmeas = environ ce+      rho' <- mapM (\ (x,v12) -> Traversable.mapM reval v12 >>= \ v12' -> return (x, v12')) rho+      let en' = Environ rho' mmeas -- no need to rewrite in measure since only size expressions+      -- normalize given values+      vs' <- mapM reval vs+      -- continue in updated context+      local (\ ce -> ce { context = (context ce) { cxt = cx' }+                        , environ = en' }) $ cont vs'++  -- addPattern :: TVal -> Pattern -> (TVal -> Val -> Env -> m a) -> m a+  addPattern tv@(VQuant Pi x dom fv) p rho cont =+       case p of+          VarP y -> underAbs y dom fv $ \ _ xv bv -> do+              cont bv xv (update rho y xv)++          SizeP e y -> underAbs y dom fv $ \ j xv bv -> do+              ve <- whnf' e+              addBoundHyp (Bound Lt (Measure [xv]) (Measure [ve])) $+                cont bv xv (update rho y xv)+{-+          SizeP z y -> newWithGen y dom $ \ j xv -> do+              bv <- whnf (update env x xv) b+              VGen k <- whnf' (Var z)+              addSizeRel j 1 k $+                cont bv xv (update rho y xv)+-}+          ConP pi n pl -> do+              sige <- lookupSymbQ n+              vc <- conLType n (typ dom)+              addPatterns vc pl rho $ \ vc' vpl rho -> do -- apply dom to pl?+                pv0 <- mkConVal notDotted (coPat pi) n vpl vc+                pv  <- up False pv0 (typ dom)+                vb  <- app fv pv+                cont vb pv rho+{-+          ConP pi n pl -> do+              sige <- lookupSymb n+              let vc = symbTyp sige+              addPatterns vc pl rho $ \ vc' vpl rho -> do -- apply dom to pl?+                pv0 <- foldM app (vCon (coPat pi) n) vpl+                pv  <- up False pv0 (typ dom)+                vb  <- whnf (update env x pv) b+                cont vb pv rho+-}+          SuccP p2 -> do+              addPattern (vSize `arrow` vSize) p2 rho $ \ _ vp2 rho -> do+                let pv = succSize vp2+                vb  <- app fv pv+                cont vb pv rho++          ErasedP p -> addPattern tv p rho cont++-- for dot patterns, we have to do something smart, because they might+-- contain identifiers which are not yet in scope, only after adding+-- other patterns+-- the following trivial solution only works for trivial dot patterns, i.e.,+-- such that do not use yet undeclared identifiers++          DotP e -> do+              v  <- whnf rho e+              vb <- app fv v+              cont vb v rho -- [(x,v)]+++  addPatterns tv [] rho cont = cont tv [] rho+  addPatterns tv (p:ps) rho cont =+    addPattern tv p rho $ \ tv' v env ->+      addPatterns tv' ps env $ \ tv'' vs env' ->+        cont tv'' (v:vs) env' -- (env' ++ env)++  addSizeRel son dist father k = do+    let s = "v" ++ show son ++ " + " ++ show dist ++ " <= v" ++ show father+    enter -- enterTrace+      ("adding size rel. " ++ s) $ do+    let modBI belowInfty = if father `elem` belowInfty || dist > 0 then son : belowInfty else belowInfty+    whenM (asks consistencyCheck `andLazy` do+           TSO.increasesHeight son (dist, father) <$> asks sizeRels) $ do+      recoverFail $ "cannot add hypothesis " ++ s ++ " because it is not satisfyable under all possible valuations of the current hypotheses"+    -- if the new son is an ancestor of the father, we are cyclic+    awhenM (TSO.isAncestor father son <$> asks sizeRels) $ \ n -> -- n steps from father up to son+      when (dist > - n) $ -- still ok if dist == n == 0, otherwise fail+        recoverFail$ "cannot add hypothesis " ++ s ++ " because it makes the set of hyptheses unsatisfiable"+    local (\ cxt -> cxt+      { sizeRels = TSO.insert son (dist, father) (sizeRels cxt)+      , belowInfty = modBI (belowInfty cxt)+      }) k++  addBelowInfty i = local $ \ cxt -> cxt { belowInfty = i : belowInfty cxt }++  addBoundHyp beta@(Bound ltle (Measure mu) (Measure mu')) cont =+    case (ltle, mu, mu') of+      (Le, _, [VInfty]) -> cont+--      (Lt, _, [VInfty]) -> failure  -- handle j < #+      (ltle, [v], [v']) -> loop (if ltle==Lt then 1 else 0) v v'+      _ -> failure+    where failure = do+--            recoverFail $ "adding hypothetical constraint " ++ show beta ++ " not supported"+            assertDoc' Warning False (text "hypothetical constraint" <+> prettyTCM beta <+> text "ignored")+            cont++          loop n (VGen i) VInfty = addBelowInfty i cont+          loop n (VGen i) (VGen j) | n >= 0 = addSizeRel i n j cont+                                   | otherwise = addIrregularBound i j (-n) cont+          loop n (VSucc v) v' = loop (n + 1) v v'+          loop n v (VSucc v') = loop (n - 1) v v'+          loop _ _ _ = failure++          addIrregularBound i j n = local (\ ce -> ce { bounds = beta : bounds ce }) where+              v' = iterate VSucc (VGen j) !! n+              beta = Bound Le (Measure [VGen i]) (Measure [v'])++  isBelowInfty i = (i `elem`) <$> asks belowInfty++{-+  isBelowInfty i = do+    belowInfty <- asks belowInfty+    if (i `elem` belowInfty) then return True else do+      tso <- asks sizeRels+      loop $ parents i tso where+        loop [] = return False+        loop [(_,j)] = return $ j `elem` belowInfty+        loop (x:xs)  = loop xs+-}++  sizeVarBelow son ancestor = do+    cxt <- ask+    return $ TSO.isAncestor son ancestor (sizeRels cxt)+{-+  getSizeDiff son ancestor = do+    cxt <- ask+    return $ TSO.diff son ancestor (sizeRels cxt)+-}+  getMinSize parent = do+    cxt <- ask+    return $ TSO.height parent (sizeRels cxt)++  getSizeVarsInScope = do+    TCContext { context = delta, naming = nam } <- ask+    -- get all the size variables with positive or mixed polarity+    let fSize (i, tv12) =+          case tv12 of+            One dom -> isVSize $ typ dom+            _ -> -- trace ("not a size variable " ++ show i ++ " : " ++ show tv12) $+                   False+    -- create a list of key (gen) and Domain pairs for the size variables+    let idl = filter fSize $ Map.toAscList (cxt delta)+    let udecs = upperDecs delta+    let fPos (i, One dom) =+         case fromPProd (polarity (Maybe.fromJust (Map.lookup i udecs))) of+           Just p -> leqPol (polarity (decor dom)) p+           Nothing -> False+    let fName (i, _) = Maybe.fromJust $ Map.lookup i nam+    return $ map fName $ filter fPos idl+++  checkingCon b = local (\ cxt -> cxt { checkingConType = b})++{-+  checkingDom = local $ \ cxt ->+    if checkingConType cxt then cxt+     else cxt { context = cxtApplyDec (Dec False Neg) (context cxt) }+-}+  -- check domain A of (x : A) -> B+  checkingDom k = do+    b <- asks checkingConType+    if b then k else applyDec (Dec Neg) k++  setCo co = local (\ cxt -> cxt { mutualCo = co })++  -- install functions for checking function clauses+  -- ==> use internal names+  installFuns co kfuns k = do+    let funt = foldl (\ m fun@(Kinded _ (Fun (TypeSig n _) n' _ _)) -> Map.insert n fun m)+                     Map.empty+                     kfuns+    local (\ cxt -> cxt { mutualCo = co, funsTemplate = funt }) k++  setMeasure mu k =  do+      rho0 <- getEnv+      let rho = rho0 { envBound = Just mu }+      local (\ cxt -> cxt+        { environ    = (environ cxt) { envBound = Just mu }+        }) k++  activateFuns k = do+      rho <- getEnv+      case (envBound rho) of+         Nothing -> k+         Just mu ->+           local (\ cxt -> cxt+             { mutualFuns =+                 Map.map (boundFun rho (mutualCo cxt)) (funsTemplate cxt)+             }) k+    where boundFun :: Env -> Co -> Kinded Fun -> SigDef+          boundFun rho co (Kinded ki (Fun (TypeSig n t) n' ar cls)) =+            FunSig co (VClos rho t) ki ar cls False undefined++{-+  activateFuns mu k = do+      rho0 <- getEnv+      let rho = rho0 { envBound = Just mu }+      local (\ cxt -> cxt+        { environ    = (environ cxt) { envBound = Just mu }+        , mutualFuns =+            Map.map (boundFun rho (mutualCo cxt)) (funsTemplate cxt)+        }) k+    where boundFun :: Env -> Co -> Fun -> SigDef+          boundFun rho co (TypeSig n t, (ar, cls)) =+            FunSig co (VClos rho t) ar cls False+ -}++  goImpredicative = local (\ cxt -> cxt { impredicative = True })++  checkingMutual mn = local (\ cxt -> cxt { checkingMutualName = mn })++-- | Go into the codomain of a Pi-type or open an abstraction.+underAbs  :: Name -> Domain -> FVal -> (Int -> Val -> Val -> TypeCheck a) -> TypeCheck a+underAbs x dom fv cont = newWithGen x dom $ \ i xv -> cont i xv =<< app fv xv++-- | Do not check consistency preservation of context.+underAbs_  :: Name -> Domain -> FVal -> (Int -> Val -> Val -> TypeCheck a) -> TypeCheck a+underAbs_ x dom fv cont = noConsistencyChecking $ underAbs x dom fv cont++noConsistencyChecking = local $ \ cxt -> cxt { consistencyCheck = False }++-- | No eta, no hypotheses.  First returned val is a @VGen i@.+underAbs' :: Name -> FVal -> (Val -> Val -> TypeCheck a) -> TypeCheck a+underAbs' x fv cont = addName x $ \ xv -> cont xv =<< app fv xv++-- addBind :: MonadTCM m => TBind -> m a -> m a+addBind :: TBind -> TypeCheck a -> TypeCheck a+addBind (TBind x dom) cont = do+  dom' <- (Traversable.mapM whnf' dom)+  new' x dom' cont++addBinds :: Telescope -> TypeCheck a -> TypeCheck a+addBinds tel k0 = foldr addBind k0 $ telescope tel++-- introduce patterns into context and environment -------------------+-- DOES NOT ETA-EXPAND VARIABLES!! -----------------------------------++introPatterns :: [Pattern] -> TVal -> ([(Pattern,Val)] -> TVal -> TypeCheck a) -> TypeCheck a+introPatterns ps tv cont =                -- Problem: NO ETA EXPANSION!+  introPatVars ps $ do                    -- first bind pattern variables+    vs <- mapM (whnf' . patternToExpr) ps -- now we can evaluate patterns+    let pvs = zip ps vs+    introPatTypes pvs tv (cont pvs)       -- now we can assign types to pvars++-- introduce variables bound in pattern into the environment+-- extend delta by generic values but do not introduce their types+-- this is to deal with dot patterns+introPatVar :: Pattern -> TypeCheck a -> TypeCheck a+introPatVar p cont =+    case p of+      VarP n -> addName n $ \ _ -> cont+      SizeP m n -> addName n $ \ _ -> cont+      ConP co n pl -> introPatVars pl cont+      PairP p1 p2 -> introPatVars [p1,p2] cont+      SuccP p -> introPatVar p cont+      ProjP{} -> cont+      DotP e -> cont+      AbsurdP -> cont+      ErasedP p -> introPatVar p cont++introPatVars :: [Pattern] -> TypeCheck a -> TypeCheck a+introPatVars [] cont = cont+introPatVars (p:ps) cont = introPatVar p $ introPatVars ps $ cont++-- if the bindings name->gen are already in the environment+-- we can now bind the gen to their types+introPatType :: (Pattern,Val) -> TVal -> (TVal -> TypeCheck a) -> TypeCheck a+introPatType (p,v) tv cont = do+  case tv of+    VGuard beta bv -> addBoundHyp beta $ introPatType (p,v) bv cont+    VApp (VDef (DefId DatK d)) vl ->+      case p of+        ProjP n -> cont =<< projectType tv n VIrr -- no record value here+        _       -> fail $ "introPatType: internal error, expected projection pattern, found " ++ show p ++ " at type " ++ show tv+    VQuant Pi x dom fv -> do+       v  <- whnfClos v+       matchPatType (p,v) dom . cont =<< app fv v+    _ -> fail $ "introPatType: internal error, expected Pi-type, found " ++ show tv++introPatTypes :: [(Pattern,Val)] -> TVal -> (TVal -> TypeCheck a) -> TypeCheck a+introPatTypes pvs tv f = do+  case pvs of+    [] -> f tv+    (pv:pvs') -> introPatType pv tv $ \ tv' -> introPatTypes pvs' tv' f++matchPatType :: (Pattern, Val) -> Domain -> TypeCheck a -> TypeCheck a+matchPatType (p,v) dom cont =+       case (p,v) of+                                                   -- erasure does not matter!+          (VarP y, VGen k) -> setType k dom $ cont++          (SizeP z y, VGen k) -> setType k dom $ cont++          (ConP co n [], _) -> cont++          (ConP co n pl, VApp (VDef (DefId ConK{} _)) vl) -> do+{-+             sige <- lookupSymb n+             let vc = symbTyp sige+-}+             vc <- conType n =<< force (typ dom)+             introPatTypes (zip pl vl) vc $ \ _ -> cont++          (SuccP p2, VSucc v2) -> matchPatType (p2, v2) (defaultDomain vSize) $ cont++          (PairP p1 p2, VPair v1 v2) -> do+             av <- force (typ dom)+             case av of+               VQuant Sigma x dom1@(Domain av1 ki dec) fv -> do+                 matchPatType (p1,v1) dom1 $ do+                   bv <- app fv v1+                   matchPatType (p2,v2) (Domain bv ki dec) cont+               _ -> fail $ "matchPatType: IMPOSSIBLE " ++ show p ++ "  :  " ++ show dom++          (DotP e, _) -> cont+          (AbsurdP, _) -> cont+          (ErasedP p,_) -> matchPatType (p,v) dom cont+          _ -> fail $ "matchPatType: IMPOSSIBLE " ++ show (p,v)+++-- Signature -----------------------------------------------------++-- input to and output of the type-checker++type Signature = Map QName SigDef++-- a signature entry is either+-- * a fun/cofun,+-- * a defined constant,+-- * a constructor, or+-- * a data type id with its kind+-- they share "symbTyp", the type signature of the definition+data SigDef+  = FunSig  { isCo          :: Co+            , symbTyp       :: TVal+            , symbolKind    :: Kind+            , arity         :: Arity+            , clauses       :: [Clause]+            , isTypeChecked :: Bool+            , extrTyp       :: Expr   -- ^ Fomega type.+            }+  | LetSig  { symbTyp       :: TVal+            , symbolKind    :: Kind+            , definingVal   :: Val+--            , definingExpr  :: Expr+            , extrTyp       :: Expr   -- ^ Fomega type.+            }+  | PatSig  { patVars       :: [Name]+            , definingPat   :: Pattern+            , definingVal   :: Val+            }+  | ConSig  { conPars       :: ConPars+              -- ^ Parameter patterns and no. of variable they bind.+              --   @Nothing@ if old-style parameters.+            , lhsTyp        :: LHSType+              -- ^ LHS type of constructor for pattern matching, e.g.+   -- rhs @cons : [A : Set] [i : Size]         -> A -> List A i -> List A $i@+   -- lhs @cons : [A : Set] [i : Size] [j < i] -> A -> List A j -> List A i@+   -- @Name@ is the name of the size parameter.+            , recOccs       :: [Bool]+              -- ^ @True@ if argument contains rec.occs.of the (co)data type?+            , symbTyp       :: TVal   -- ^ (RHS) type, includs parameter tel.+            , dataName      :: Name   -- ^ Its datatype.+            , dataPars      :: Int    -- ^ No. of parameters of its datatype.+            , extrTyp       :: Expr   -- ^ Fomega type.+            }+  | DataSig { numPars       :: Int+            , positivity    :: [Pol]+            , isSized       :: Sized+            , isCo          :: Co+            , symbTyp       :: TVal+            , symbolKind    :: Kind+            -- the following information is only needed for eta-expansion+            -- hence it is only provided for suitable ind.fams.+            , constructors  :: [ConstructorInfo]+            , etaExpand     :: Bool -- non-overlapping pattern inductive family+                                    -- with at least one eta-expandable constructor+            , isTuple       :: Bool -- each constructor is irrefutable+                                    -- must be (NEW: non-overlapping) pattern inductive family+                                    -- qualifies for target of corecursive fun+                                    -- NO LONGER: exactly one constructor+                                    -- NOW: at least one constructor+                                    -- can be recursive+            , extrTyp       :: Expr -- Fomega kind+{-+            , destructors   :: Maybe [Name] -- Nothing if not a record+            , isFamily      :: Bool+-}+            } -- # parameters, positivity of parameters  , sized , co , type+              deriving (Show)++-- | Parameter patterns and no. of variables they bind.+type ConPars = Maybe ([Name], [Pattern])++-- | LHS type plus name of size index.+type LHSType = Maybe (Name, TVal)++isEmptyData :: QName -> TypeCheck Bool+isEmptyData n = do+  sig <- lookupSymbQ n+  case sig of+    DataSig { constructors } -> return $ null constructors+    _ -> throwErrorMsg $ "internal error: isEmptyData " ++ show n ++ ": name of data type expected"++isUnitData :: QName -> TypeCheck Bool+isUnitData n = do+  sig <- lookupSymbQ n+  case sig of+    DataSig { constructors = [c], isTuple } -> return $+      isTuple && null (cFields c) && cPatFam c == (LinearPatterns, [])+    DataSig { constructors } -> return False+    _ -> throwErrorMsg $ "internal error: isUnitData " ++ show n ++ ": name of data type expected"+++undefinedFType :: QName -> Expr+undefinedFType n = Irr+-- undefinedFType n = error $ "no extracted type for " ++ show n++symbKind :: SigDef -> Kind+symbKind ConSig{}  = kTerm          -- constructors are always terms+symbKind d         = symbolKind d   -- else: lookup+{- Data types can be big!!+symbKind DataSig{} = kType          -- data types are never universes+-}++emptySig = Map.empty++-- Handling constructor types  ------------------------------------------++data DataView+  = Data Name [Clos]+  | NoData++-- | Check if type @tv@ is a datatype @D vs@.+dataView :: TVal -> TypeCheck DataView+dataView tv = do+  tv <- force tv+  case tv of+{- 2012-01-31 EVIL, LEADS TO UNBOUND VARS:+    VQuant Pi x dom env b         -> do+      new x dom $ \ xv -> dataView =<< whnf (update env x xv) b+-}+    VApp (VDef (DefId DatK n)) vs -> return $ Data (unqual n) vs+    VSing v dv                    -> dataView =<< whnfClos dv+    _                             -> return $ NoData++-- | Disambiguate possibly overloaded constructor @c@ at given type @tv@.+disambigCon ::  QName -> TVal -> TypeCheck QName+disambigCon c tv =+  case c of+    Qual{}  -> return c+    QName n -> do+      dv <- dataView tv+      case dv of+        Data d _ -> return $ Qual d n+        _ -> fail $ "cannot resolve constructor " ++ show n++-- | @conType c tv@ returns the type of constructor @c@ at datatype @tv@+--   with parameters instantiated.+conType :: QName -> TVal -> TypeCheck TVal+conType c tv = do+  c <- disambigCon c tv+  ConSig { conPars, symbTyp, dataName, dataPars } <- lookupSymbQ c+  instConType c conPars symbTyp dataName dataPars tv++-- | Get LHS type of constructor.+--+--   Constructors or sized data types internally have a lhs type+--   that differs from its rhs type.  E.g.,+--   rhs @suc : [i : Size] -> Nat i -> Nat $i@+--   lhs @suc : [i : Size] [j < i] -> Nat j -> Nat i@.+--   In the lhs type, @i@ turns into an additional parameter.+conLType :: QName -> TVal -> TypeCheck TVal+conLType c tv = do+  c <- disambigCon c tv+  ConSig { conPars, lhsTyp, symbTyp, dataName, dataPars } <- lookupSymbQ c+  case lhsTyp of+    Nothing        -> instConType c conPars symbTyp dataName dataPars tv+    Just (x, lTyp) -> instConType c (fmap (inc x) conPars) lTyp dataName (dataPars+1) tv+  where inc x (xs, ps) = (xs ++ [x], ps ++ [VarP x])++-- | Instantiate type of constructor to parameters obtained from+--   the data type.+--+--   @instConType c n symbTyp dataName tv@+--   instantiates type @symbTyp@ of constructor @c@ with first @n@ arguments+--   that @dataName@ is applied to in @tv@.+--   @@+--      instConType c n ((x1:A1..xn:An) -> B) d (d v1..vn ws) = B[vs/xs]+--   @@+instConType :: QName -> ConPars -> TVal -> Name -> Int -> TVal -> TypeCheck TVal+instConType c conPars symbTyp dataName dataPars tv =+  instConLType' c conPars symbTyp Nothing (Just dataName) dataPars tv+{-+instConType c numPars symbTyp dataName tv = do+  dv <- dataView tv+  case dv of+    NoData    -> failDoc (text ("conType " ++ show c ++ ": expected")+                   <+> prettyTCM tv <+> text "to be a data type")+    Data d vs -> do+      unless (d == dataName) $ fail $ "expected constructor of datatype " ++ show d ++ ", but found one of datatype " ++ show dataName+      let (pars, inds) = splitAt numPars vs+      unless (length pars == numPars) $+        failDoc (text ("conType " ++ show c ++ ": expected")+                   <+> prettyTCM tv+                   <+> text ("to be a data type applied to all of its " +++                     show numPars ++ " parameters"))+      piApps symbTyp pars+-}++-- | Get correct lhs type for constructor pattern.+--+--   @instConLType c numPars symbTyp Nothing isFlex tv@ behaves like+--   @instConLType c numPars symbType _ tv@.+--+--   But if the data types is sized and the constructor has a lhs type,+--   @instConLType c numPars symbTyp (Just ltv) isFlex tv@+--   uses the lhs type @ltv@ unless the variable instantiated for+--   the size argument is flexible (because then it wants to be+--   unified with the successor pattern of the rhs type.+instConLType :: QName -> ConPars -> TVal -> LHSType -> (Val -> Bool) -> Int -> TVal -> TypeCheck TVal+instConLType c conPars rhsTyp lhsTyp isFlex dataPars dataTyp =+  instConLType' c conPars rhsTyp (fmap (,isFlex) lhsTyp) Nothing dataPars dataTyp++-- | The common pattern behind @instConType@ and @instConLType@.+instConLType' :: QName -> ConPars -> TVal -> Maybe ((Name, TVal), Val -> Bool) -> Maybe Name -> Int -> TVal -> TypeCheck TVal+instConLType' c conPars symbTyp isSized md dataPars tv =+  enter ("instConLType'") $ do+  let failure = failDoc (text ("conType " ++ show c ++ ": expected")+                   <+> prettyTCM tv+                   <+> text ("to be a data type applied to all of its " +++                     show dataPars ++ " parameters"))+  dv <- dataView tv+  case dv of+    NoData    -> failDoc (text ("conType " ++ show c ++ ": expected")+                   <+> prettyTCM tv <+> text "to be a data type")+    Data d vs -> do+      whenJust md $ \ d' ->+        unless (d == d') $ fail $ "expected constructor of datatype " ++ show d ++ ", but found one of datatype " ++ show d'+      -- whenJust conPars $ fail $ "NYI: constructor with pattern parameters"+      let (pars, inds) = splitAt dataPars vs+      unless (length pars == dataPars) failure+      case (isSized, inds) of+        (Just _, []) -> failure+        -- if size index not flexible, use lhs type+        (Just ((x,ltv), isFlex), sizeInd:_) | not (isFlex sizeInd) ->+          continue d [x] ltv (pars ++ [sizeInd])+        -- otherwise, use rhs type+        _ -> continue d [] symbTyp pars+  where+    continue d ys tv pars = case conPars of+      Nothing      -> piApps tv pars+      Just (xs, ps) -> do+        let failure = failDoc $ sep+              [ text "instConType:"+              , text "cannot match parameters" <+> prettyList (map prettyTCM pars)+              , text "against patterns" <+> prettyList (map prettyTCM ps)+              , text "when instantiating type" <+> prettyTCM tv+              , text ("of constructor " ++ show c)+              ]+        -- clear dots here:+        mst <- nonLinMatchList' True True (emptyEnv, []) ps pars =<< lookupSymbTyp d+        case mst of+          Nothing  -> failure+          Just (Environ{ envMap = env0 }, psub) -> do+            let env = env0 ++ [ (x, VGen i) | (i, VarP x) <- psub ]+            -- if length env /= length xs then failure else do+            vs <- forM (xs ++ ys) $ \ x -> maybe failure return $ lookup x env+            piApps tv vs+{-+        menv <- matchList emptyEnv ps pars+        case menv of+          Nothing  -> failure+          Just Environ{ envMap = env } -> if length env /= length xs then failure else do+            vs <- forM (xs ++ ys) $ \ x -> maybe failure return $ lookup x env+            piApps tv vs+-}++{-+      case isSized of+        Nothing  -> piApps symbTyp pars+        Just ltv -> do+          when (null inds) failure+          let sizeInd = head inds+          if isFlex sizeInd then piApps symbTyp pars else piApps ltv (pars ++ [sizeInd])+-}++-- Signature specification -------------------------------------------++class MonadCxt m => MonadSig m where+  lookupSymbTypQ :: QName -> m TVal+  lookupSymbQ    :: QName -> m SigDef+  addSigQ        :: QName -> SigDef -> m ()+  modifySigQ     :: QName -> (SigDef -> SigDef) -> m ()+  setExtrTypQ    :: QName -> Expr -> m ()++  lookupSymbTyp  :: Name -> m TVal+  lookupSymbTyp  = lookupSymbTypQ . QName++  lookupSymb     :: Name -> m SigDef+  lookupSymb     = lookupSymbQ . QName++  addSig         :: Name -> SigDef -> m ()+  addSig         = addSigQ . QName++  modifySig      :: Name -> (SigDef -> SigDef) -> m ()+  modifySig      = modifySigQ . QName++  setExtrTyp     :: Name -> Expr -> m ()+  setExtrTyp     = setExtrTypQ . QName++-- Signature implementation ------------------------------------------++instance MonadSig TypeCheck where++  -- first in context, then in signature+  -- lookupSymbTyp :: Name -> TypeCheck TVal+  lookupSymbTyp n = do+    mdom <- errorToMaybe $ lookupName1 n+    case mdom of+      Just (CxtEntry dom udec) -> return (typ dom)+      Nothing -> symbTyp <$> lookupSymb n++  lookupSymbTypQ (QName n) = lookupSymbTyp n+  lookupSymbTypQ n@Qual{}  = symbTyp <$> lookupSymbQ n++  -- lookupSymb :: Name -> TypeCheck SigDef+  lookupSymb n = do+    cxt <- ask+    case Map.lookup n (mutualFuns cxt) of+      Just k  -> return $ k+      Nothing -> lookupSymbInSig (QName n)++  lookupSymbQ (QName n) = lookupSymb n+  lookupSymbQ n@Qual{}  = lookupSymbInSig n++  -- addSig :: Name -> SigDef -> TypeCheck ()+  addSigQ n def = traceSig ("addSig: " ++ show n ++ " is bound to " ++ show def) $do+    st <- get+    put $ st { signature = Map.insert n def $ signature st }++  -- modifySig :: Name -> (SigDef -> SigDef) -> TypeCheck ()+  modifySigQ n f = do+    st <- get+    put $ st { signature = Map.adjust f n $ signature st }++  -- setExtrTyp :: Name -> Expr -> TypeCheck ()+  setExtrTypQ n t = modifySigQ n (\ d -> d { extrTyp = t })++lookupSymbInSig :: QName -> TypeCheck SigDef+lookupSymbInSig n = lookupSig n =<< gets signature+    where+      -- lookupSig :: Name -> Signature -> TypeCheck SigDef+      lookupSig n sig =+        case (Map.lookup n sig) of+          Nothing -> fail $ "identifier " ++ show n ++ " not in signature "  ++ show (Map.keys sig)+          Just k -> return k+++-- more on the type checking monad -------------------------------++initSt :: TCState+initSt = TCState emptySig emptyMetaVars emptyConstraints emptyPosGraph -- emptyDots++initWithSig :: Signature -> TCState+initWithSig sig = initSt { signature = sig }++-- Meta-variable and constraint handling specification ---------------++class Monad m => MonadMeta m where+  resetConstraints :: m ()+  mkConstraint     :: Val -> Val -> m (Maybe Constraint)+  addMeta          :: Ren -> MVar -> m ()+  addLeq           :: Val -> Val -> m ()++  addLe            :: LtLe -> Val -> Val -> m ()+  addLe Le v1 v2 = addLeq v1 v2+  addLe Lt v1 v2 = addLeq (succSize v1) v2 -- broken for #++  solveConstraints :: m Solution++  -- solve constraints and substitute solution into the analyzed expressions+  solveAndModify   :: [Expr] -> Env -> m [Expr]+  solveAndModify es rho = do+        sol <- solveConstraints+        let es' = map (subst (solToSubst sol rho)) es+        resetConstraints+        return es'++-- Constraints implementation ----------------------------------------++instance MonadMeta TypeCheck where++  --resetConstraints :: TypeCheck ()+  resetConstraints = do+    st <- get+    put $ st { constraints = emptyConstraints }++  -- mkConstraint :: Val -> Val -> TypeCheck (Maybe Constraint)+  mkConstraint v (VMax vs) = do+    bs <- mapM (errorToBool . leqSize' v) vs+    if any id bs then return Nothing else+     fail $ "cannot handle constraint " ++ show v ++ " <= " ++ show (VMax vs)+  mkConstraint w@(VMax vs) v = fail $ "cannot handle constraint " ++ show w ++ " <= " ++ show v+  mkConstraint (VMeta i rho n) (VMeta j rho' m) = retret $ arc (Flex i) (m-n) (Flex j)+  mkConstraint (VMeta i rho n) VInfty      = retret $ arc (Flex i) 0 (Rigid (RConst Infinite))+  mkConstraint (VMeta i rho n) v           = retret $ arc (Flex i) (m-n) (Rigid (RVar j))+    where (j,m) = vGenSuccs v 0+  mkConstraint VInfty (VMeta i rho n)      = retret $ arc (Rigid (RConst Infinite)) 0 (Flex i)+  mkConstraint v (VMeta j rho m)           = retret $ arc (Rigid (RVar i)) (m-n) (Flex j)+    where (i,n) = vGenSuccs v 0+  mkConstraint v1 v2 = fail $ "mkConstraint undefined for " ++ show (v1,v2)++  -- addMeta k x  adds a metavariable which can refer to VGens < k+  -- addMeta :: Ren -> MVar -> TypeCheck ()+  addMeta ren i = do+    scope <- getSizeVarsInScope+    traceMetaM ("addMeta " ++ show i ++ " scope " ++ show scope)+    st <- get+    put $ st { metaVars = Map.insert i (MetaVar scope Nothing) (metaVars st)+             , constraints = NewFlex i (\ k' -> True) -- k' < k)+            -- DO NOT ADD constraints of form <= infty !!+            --               : arc (Flex i) 0 (Rigid (RConst Infinite))+                           : constraints st }++  -- addLeq :: Val -> Val -> TypeCheck ()+  addLeq v1 v2 = traceMeta ("Constraint: " ++ show v1 ++ " <= " ++ show v2) $+    do mc <- mkConstraint v1 v2+       case mc of+         Nothing -> return ()+         Just c -> do+           st <- get+           put $ st { constraints = c : constraints st }++  -- solveConstraints :: TypeCheck Solution+  solveConstraints = do+    cs <- gets constraints+    if null cs then return emptySolution+     else case solve cs of+        Just subst -> traceMeta ("solution" ++ show subst) $+                      return subst+        Nothing    -> fail $ "size constraints " ++ show cs ++ " unsolvable"+++nameOf :: EnvMap -> Int -> Maybe Name+nameOf [] j = Nothing+nameOf ((x,VGen i):rho) j | i == j = Just x+nameOf (_:rho) j = nameOf rho j++vGenSuccs (VGen k)  m = (k,m)+vGenSuccs (VSucc v) m = vGenSuccs v (m+1)+vGenSuccs v m = error $ "vGenSuccs fails on " ++ Util.parens (show v) ++ " " ++ show m++retret = return . return++sizeExprToExpr :: Env -> SizeExpr -> Expr+sizeExprToExpr rho (SizeConst Infinite) = Infty+sizeExprToExpr rho (SizeVar i n) | Just x <- nameOf (envMap rho) i = add (Var x) n+  where add e n | n <= 0 = e+                | otherwise = add (Succ e) (n-1)+sizeExprToExpr rho e@(SizeVar i n) | Nothing <- nameOf (envMap rho) i = error $ "panic: sizeExprToExpr " ++ Util.parens (show e) ++ ": variable v" ++ show i ++ " not in scope " ++ show (envMap rho)+++maxExpr :: [Expr] -> Expr+maxExpr [] = Infty+maxExpr [e] = e+maxExpr l = if Infty `elem` l then Infty else Max l++solToSubst :: Solution -> Env -> Subst+solToSubst sol rho = Map.map (maxExpr . map (sizeExprToExpr rho)) sol+++{-+solToSubst :: Solution -> Env -> Subst+solToSubst sol rho = Map.foldWithKey step Map.empty sol+  where step k (SizeVar i n) sub | Just x <- nameOf rho i =+           Map.insert k (add (Var x) n) sub+        step k (SizeConst Infinite) sub = Map.insert k Infty sub+        step _ _ sub = sub++        add e n | n <= 0 = e+                | otherwise = add (Succ e) (n-1)+-}++-- pattern to Value ----------------------------------------------++{- RETIRED+patternToVal :: Pattern -> TypeCheck Val+patternToVal p = do+  k <- getLen+  return $ fst (p2v k p)++-- turn a pattern into a value+-- dot patterns get variables corresponding to their flexible generic value+p2v :: Int -> Pattern -> (Val,Int)+p2v k p =+    case p of+      VarP n -> (VGen k,k+1)+      ConP co n [] -> (VCon co n,k)+      ConP co n pl -> let (vl,k') = ps2vs k pl+                      in (VApp (VCon co n) vl,k')+      SuccP p -> let (v,k') = p2v k p+                 in (VSucc v,k')+      DotP e -> (VGen k,k+1)++ps2vs :: Int -> [Pattern] -> ([Val],Int)+ps2vs k []  = ([],k)+ps2vs k (p:pl) = let (v,k') = p2v k p+                     (vl,k'') = ps2vs k' pl+                 in+                   (v:vl,k'')+-}
+ TCM.hs-boot view
@@ -0,0 +1,17 @@+module TCM where++-- import CallStack+import TraceError++import Control.Monad.Identity+import Control.Monad.State+import Control.Monad.Error+import Control.Monad.Reader++data OneOrTwo a = One a | Two a a++data TCContext+data TCState++-- type TypeCheck = StateT TCState (ReaderT TCContext (CallStackT String IO))+type TypeCheck = StateT TCState (ReaderT TCContext (ErrorT TraceError IO))
+ Termination.hs view
@@ -0,0 +1,896 @@+{-# LANGUAGE ImplicitParams, PatternGuards #-}++module Termination where++import Prelude hiding (null)++import Data.Monoid+import Control.Monad.Writer -- (Writer, runWriter, tell, listen, Any(..), ...)++import Data.List as List hiding (null)+import Data.Set (Set)+import qualified Data.Set as Set+import Data.Foldable (Foldable, foldMap)+import qualified Data.Foldable as Foldable++import Debug.Trace++--import System++import Abstract+import TraceError+import Util++import Semiring+import qualified SparseMatrix as M++import TreeShapedOrder (TSO)+import qualified TreeShapedOrder as TSO++traceTerm msg a = a -- trace msg a+traceTermM msg = return () -- traceM msg+{-+traceTerm msg a = trace msg a+traceTermM msg = traceM msg+-}+++traceProg msg a =  a+traceProgM msg = return ()+{-+traceProg msg a = trace msg a+traceProgM msg = traceM msg+-}++-- cutoff:  How far can we count?+-- cutoff = 0 : decrease of -infty,0,1 (original SCT)+-- cutoff = 1 : "           -infty,-1,0,1,2+-- etc.+-- this is a parameter to the termination checker++cutoff :: Int+cutoff = 2  -- we can trace descend of 3, ascend of 2+++type Matrix a = M.Matrix Int a++empty :: Matrix a+empty = M.M (M.Size 0 0) []++-- greater numbers shall mean more information for the term.checker.+data Order = Decr Int -- positive numbers: decrease, neg. numbers: increase+           | Un       -- infinite increase (- infty)+           | Mat (Matrix Order) -- square matrices only (rows = call arguments, cols = parameters of caller)+           deriving (Show,Eq,Ord)++instance HasZero Order where+  zeroElement = Un++-- smart constructor+orderMat :: Matrix Order -> Order+orderMat m | M.isEmpty m                = Decr 0+           | Just o <- M.isSingleton m  = o+           | otherwise                  = Mat m+{-+orderMat []    = Decr 0   -- 0x0 Matrix = neutral element+orderMat [[o]] = o        -- 1x1 Matrix+orderMat oss   = Mat oss  -- nxn Matrix+-}++-- smart constructor+decr :: (?cutoff :: Int) => Int -> Order+decr i | i < - ?cutoff = Un+       | i > ?cutoff  = Decr (?cutoff + 1)+       | otherwise   = Decr i++-- present order in terms of <,<=,?+abstract :: Order -> Order+abstract (Decr k) | k > 0 = Decr 1+                  | k == 0 = Decr 0+                  | k < 0  = Un+abstract Un = Un+abstract (Mat m) = Mat $ absCM m++absCM :: Matrix Order -> Matrix Order+absCM = fmap abstract+-- absCM = map (map abstract)++-- the one is never needed for matrix multiplication+ordRing :: (?cutoff :: Int) => Semiring Order+ordRing = Semiring { add = maxO , mul = comp , zero = Un } -- , one = Decr 0 }++-- composition = sequence of calls+comp :: (?cutoff :: Int) => Order -> Order -> Order+comp _ Un = Un+comp Un _ = Un+comp (Decr k) (Decr l) = decr (k + l)+comp (Mat m1) (Mat m2) = if (composable m1 m2) then+                             Mat $ M.mul ordRing m1 m2+                         else+                             comp (collapse m1) (collapse m2)+comp (Decr 0) (Mat m) = Mat m+comp (Mat m) (Decr 0) = Mat m+comp o (Mat m) = comp o (collapse m)+comp (Mat m) o = comp (collapse m) o++maxO :: (?cutoff :: Int) => Order -> Order -> Order+maxO o1 o2 = case (o1,o2) of+               (Un,_) -> o2+               (_,Un) -> o1+               (Decr k, Decr l) -> Decr (max k l) -- cutoff not needed+               (Mat m1, Mat m2) -> if (sameSize m1 m2) then+                                       Mat $ M.add maxO m1 m2+                                   else+                                       maxO (collapse m1) (collapse m2)+               (Mat m1,_) -> maxO (collapse m1) o2+               (_,Mat m2) -> maxO o1 (collapse m2)++minO :: (?cutoff :: Int) => Order -> Order -> Order+minO o1 o2 = case (o1,o2) of+               (Un,_) -> Un+               (_,Un) -> Un+               (Decr k, Decr l) -> decr (min k l)+               (Mat m1, Mat m2) -> if (sameSize m1 m2) then+                                       Mat $ minM m1 m2+                                   else+                                       minO (collapse m1) (collapse m2)+               (Mat m1,_) -> minO (collapse m1) o2+               (_,Mat m2) -> minO o1 (collapse m2)++{-+-- for non empty lists:+minimumO :: (?cutoff :: Int) => [Order] -> Order+minimumO = foldl1 minO+-}++-- | pointwise minimum+minM :: (?cutoff :: Int) => Matrix Order -> Matrix Order -> Matrix Order+minM = M.intersectWith minO+{-+minM m1 m2 = [ minV x y | (x,y) <- zip m1 m2]+ where+   minV :: Vector Order -> Vector Order -> Vector Order+   minV v1 v2 = [ minO x y | (x,y) <- zip v1 v2]+-}++maxL :: (?cutoff :: Int) => [Order] -> Order+maxL = foldl1 maxO++minL :: (?cutoff :: Int) => [Order] -> Order+minL = foldl1 minO++{- collapse m++We assume that m codes a permutation:  each row has at most one column+that is not Un.++To collapse a matrix into a single value, we take the best value of+each column and multiply them.  That means if one column is all Un,+i.e., no argument relates to that parameter, than the collapsed value+is also Un.++This makes order multiplication associative.+++collapse :: (?cutoff :: Int) => Matrix Order -> Order+collapse m = foldl1 comp (map maxL (M.transpose m))++-}+++{- collapse m++We assume that m codes a permutation:  each row has at most one column+that is not Un.++To collapse a matrix into a single value, we take the best value of+each column and multiply them.  That means if one column is all Un,+i.e., no argument relates to that parameter, than the collapsed value+is also Un.++This makes order multiplication associative.++-}+collapse :: (?cutoff :: Int) => Matrix Order -> Order+collapse m = case M.toLists (M.transpose m) of+--   [] -> __IMPOSSIBLE__   -- This can never happen if order matrices are generated by the smart constructor+   m' -> foldl1 comp $ map (foldl1 maxO) m'++++type Vector a = [a]+type NaiveMatrix a = [Vector a]++---+-- matrix stuff++{-+data Semiring a = Semiring { add :: (a -> a -> a) , mul :: (a -> a -> a) , one :: a , zero :: a }+-}++ssum :: Semiring a -> Vector a -> a+ssum sem v = foldl (add sem) (zero sem) v++vadd :: Semiring a -> Vector a -> Vector a -> Vector a+vadd sem v1 v2 = [ (add sem) x y | (x,y) <- zip v1 v2]++scalarProdukt :: Semiring a -> Vector a -> Vector a -> a+scalarProdukt sem xs ys = ssum sem [(mul sem) x y  | (x,y) <- zip xs ys]++madd :: Semiring a -> NaiveMatrix a -> NaiveMatrix a -> NaiveMatrix a+madd sem m1 m2 = [ vadd sem x y | (x,y) <- zip m1 m2]++transp :: NaiveMatrix a -> NaiveMatrix a+transp [] = []+transp y = [[ z!!j | z<-y] | j<-[0..s]]+    where+    s = length (head y)-1++mmul :: Show a => Semiring a -> NaiveMatrix a -> NaiveMatrix a -> NaiveMatrix a+mmul sem m1 m2 = let m =+                         [[scalarProdukt sem r c | c <- transp m2] | r<-m1 ]+                 in m+diag :: NaiveMatrix a -> Vector a+diag [] = []+diag m = [ (m !! j) !! j | j <- [ 0..s] ]+   where+     s = length (head m) - 1++elems :: NaiveMatrix a -> Vector a+elems m = concat m++{-+ok :: Matrix a -> Matrix a -> Bool+ok m1 m2 = (length m1) == length m2+-}++sameSize :: Matrix a -> Matrix a -> Bool+sameSize m1 m2 = M.size m1 == M.size m2++composable :: Matrix a -> Matrix a -> Bool+composable m1 m2 = M.rows (M.size m1) == M.cols (M.size m2)++---++-- create a call matrix+-- each row is for one argument  of the callee+-- each column for one parameter of the caller+compareArgs :: (?cutoff :: Int) => TSO Name -> [Pattern] -> [Expr] -> Arity -> Matrix Order+compareArgs tso _ [] _ = empty+compareArgs tso [] _ _ = empty+compareArgs tso pl el ar_g =+  M.fromLists (M.Size { M.rows = fullArity ar_g , M.cols = length pl }) $+    map (\ e -> map (\ p -> --traceTerm ("comparing " ++ show e ++ " to " ++ show p) $+                                    compareExpr tso e p) pl) el+{-+compareArgs tso pl el ar_g =+        let+            diff = ar_g - length el+            fill = if diff > 0 then+                       replicate diff (replicate (length pl) Un)+                   else []+            cmp = map (\ e -> (map (\ p -> --traceTerm ("comparing " ++ show e ++ " to " ++ show p) $+                                    compareExpr tso e p) pl)) el+        in+          cmp ++ fill+-}++{-+compareExpr :: (?cutoff :: Int) => Expr -> Pattern -> Order+compareExpr e p =+   case (e,p) of+      (_,UnusableP _) -> Un+      (_,DotP e') -> case exprToPattern e' of+                       Nothing -> if e == e' then Decr 0 else Un+                       Just p' -> compareExpr e p'+      (Var i,p) -> traceTerm ("compareVar " ++ show i ++ " " ++ show p) $ compareVar i p+      (App (Var i) _,p) -> compareVar i p+      (Con _ n1,ConP _ n2 [])  | n1 == n2 -> Decr 0+      (App (Con _ n1) [e1],ConP _ n2 [p1]) | n1 == n2 -> compareExpr e1 p1+      (App (Con _ n1) args,ConP _ n2 pl) | n1 == n2 && length args == length pl ->+              Mat (map (\ e -> (map (compareExpr e) pl)) args)+              -- without extended order :  minL $ zipWith compareExpr args pl+      (Succ e2,SuccP p2) -> compareExpr e2 p2+      -- new cases for counting constructors+      (Succ e2,p) -> Decr (-1) `comp` compareExpr e2 p+      (App (Con _ n1) args@(_:_), p) -> Decr (-1) `comp` minL (map (\e -> compareExpr e p) args)+      _ -> Un+-}++++compareExpr :: (?cutoff :: Int) => TSO Name -> Expr -> Pattern -> Order+compareExpr tso e p =+  let ret o = traceTerm ("comparing expression " ++ show e ++ " to pattern " ++ show p ++ " returns " ++ show o) o in+    ret $ compareExpr' tso e p++compareExpr' :: (?cutoff :: Int) => TSO Name -> Expr -> Pattern -> Order+compareExpr' tso (Ann e) p = compareExpr' tso (unTag e) p+compareExpr' tso e p =+   case (conView $ spineView e, p) of+      (_,UnusableP _) -> Un+--      (Erased e,_)    -> compareExpr' tso e p+      (_,ErasedP p)   -> compareExpr' tso e p+      (_,DotP e') -> case exprToPattern e' of+                       Nothing ->  if e == e' then Decr 0 else Un+                       Just p' -> compareExpr' tso e p'+      ((Var i,_), p) -> -- traceTerm ("compareVar " ++ show i ++ " " ++ show p) $+                         compareVar tso i p+--      (Con _ n1,ConP _ n2 [])  | n1 == n2 -> Decr 0+--      (App (Con _ n1) [e1],ConP _ n2 [p1]) | n1 == n2 -> compareExpr' tso e1 p1+      ((Def (DefId (ConK _) n1),args),ConP _ n2 pl) | n1 == n2 && length args == length pl ->+          let os = zipWith (compareExpr' tso) args pl+          in  trace ("compareExpr (con/con case): os = " ++ show os) $+              if null os then Decr 0 else minL os+{- 2011-12-16 deactivate structured (matrix) orders+          orderMat $+            M.fromLists (M.Size { M.rows = length args, M.cols = length pl }) $+               map (\ e -> map (compareExpr' tso e) pl) args+              -- without extended order :  minL $ zipWith compareExpr' tso args pl+-}+      ((Succ e2,_),SuccP p2) ->  compareExpr' tso e2 p2+      -- new cases for counting constructors+      ((Succ e2,_),p) ->  Decr (-1) `comp` compareExpr' tso e2 p+      ((Def (DefId (ConK Cons) n1),args@(_:_)), p) ->  Decr (-1) `comp` minL (map (\e -> compareExpr' tso e p) args)+      ((Proj Post n1,[]), ProjP n2) | n1 == n2 -> Decr 0+      _ -> Un++conView (Record (NamedRec co n _ _) rs, es) = (Def (DefId (ConK co) n), map snd rs ++ es)+conView p = p++compareVar :: (?cutoff :: Int) => TSO Name -> Name -> Pattern -> Order+compareVar tso n p =+  let ret o = o in -- traceTerm ("comparing variable " ++ n ++ " to " ++ show p ++ " returns " ++ show o) o in+    case p of+      UnusableP _ -> ret Un+      ErasedP p   -> compareVar tso n p+      VarP n2 -> if n == n2 then Decr 0 else+        case TSO.diff n n2 tso of -- if n2 is the k-th father of n, then it is a decrease by k+          Nothing -> ret Un+          Just k -> ret $ decr k+      SizeP n1 n2 -> if n == n2 then Decr 0 else+        case TSO.diff n n2 tso of -- if n2 is the k-th father of n, then it is a decrease by k+          Nothing -> ret Un+          Just k -> ret $ decr k+      PairP p1 p2 -> maxL (map (compareVar tso n) [p1,p2])+         -- no decrease in pair:  ALT: comp (Decr 1) (...)+      ConP pi c (p:pl) | coPat pi == Cons ->+        comp (Decr 1) (maxL (map (compareVar tso n) (p:pl)))+      ConP{}   -> ret Un+      ProjP{}  -> ret Un+      SuccP p2 -> comp (Decr 1) (compareVar tso n p2)+      DotP e -> case (exprToPattern e) of+                    Nothing -> ret $ Un+                    Just p' -> compareVar tso n p'+      _ -> error $ "NYI: compareVar " ++ show n ++ " to " ++ show p -- ret $ Un++---++type Index = Name++data Call = Call { source :: Index , target :: Index , matrix :: CallMatrix }+            deriving (Eq,Show,Ord)++-- call matrix:+-- each row is for one argument  of the callee (target)+-- each column for one parameter of the caller (source)++type CallMatrix = Matrix Order++-- for two matrices m m' of the same dimensions,+-- m `subsumes` m'  if  pointwise the entries of m are smaller than of m'+subsumes :: Matrix Order -> Matrix Order -> Bool+subsumes m m' = M.all (uncurry leq) mm'+  where mm' = M.zip m m' -- create one matrix of pairs+{-+subsumes m m' = all (all (uncurry leq)) mm'+  where mm' = zipWith zip m m' -- create one matrix of pairs+-}++-- Order forms itself a partial order+leq :: Order -> Order -> Bool+leq Un _ = True+leq (Decr k) (Decr l) = k <= l+leq (Mat m) (Mat m') = subsumes m m'+leq _ _ = False++-- for two matrices m m' such that m `subsumes` m'+-- m `progress` m'  any positive entry in m' is smaller in m+progress :: Matrix Order -> Matrix Order -> Bool+progress m m' = M.any (uncurry decrToward0) mm'+  where mm' = M.zip m m' -- create one matrix of pairs+{-+progress m m' = any (any (uncurry decrToward0)) mm'+  where mm' = zipWith zip m m' -- create one matrix of pairs+-}++decrToward0 :: Order -> Order -> Bool+decrToward0 Un (Decr l) = True && l >= 0+decrToward0 (Decr k) (Decr l) = k < l  && l >= 0+decrToward0 (Mat m) (Mat m') = progress m m'+decrToward0 _ _ = False+++{- call pathes++  are lists of names of length >=2++  [f,g,h] = f --> g --> h+-}++newtype CallPath = CallPath { getCallPath :: [Name] } deriving Eq++instance Show CallPath where+  show (CallPath [g]) = show g+  show (CallPath (f:l)) = show f ++ "-->" ++ show (CallPath l)++emptyCP :: CallPath+emptyCP = CallPath []++mkCP :: Name -> Name -> CallPath+mkCP src tgt = CallPath [src, tgt]++mulCP :: CallPath -> CallPath -> CallPath+mulCP cp1@(CallPath one) cp2@(CallPath (g:two)) =+  if last one == g then CallPath (one ++ two)+  else error ("internal error: Termination.mulCP: trying to compose callpath " ++ show cp1 ++ " with " ++ show cp2)++compatibleCP :: CallPath -> CallPath -> Bool+compatibleCP (CallPath one) (CallPath two) = head one == head two && last one == last two++{-+addCP :: CallPath -> CallPath -> CallPath+addCP (CallPath []) cp = cp+addCP cp (CallPath []) = cp+addCP cp1 cp2 = if cp1 == cp2 then cp1 else error ("internal error: Termination.addCP: trying to blend non-equal callpathes " ++ show cp1 ++ " and " ++ show cp2)++cpRing :: Semiring CallPath+cpRing = Semiring { add = addCP , mul = mulCP , one = undefined , zero = emptyCP }+-}++-- composed calls++type CompCall = (CallPath, CallMatrix)++mulCC :: (?cutoff :: Int) => CompCall -> CompCall -> CompCall+mulCC cc1@(cp1, m1) cc2@(cp2, m2) = zipPair mulCP (flip (M.mul ordRing)) cc1 cc2++subsumesCC :: CompCall -> CompCall -> Bool+subsumesCC cc1@(cp1, m1) cc2@(cp2, m2) =+  if compatibleCP cp1 cp2 then m1 `subsumes` m2+   else error ("internal error: Termination.subsumesCC: trying to compare composed call " ++ show cc2 ++ " with " ++ show cc1)++progressCC :: CompCall -> CompCall -> Bool+progressCC cc1@(cp1, m1) cc2@(cp2, m2) = progress m1 m2+++{- call graph completion++organize call graph as a square matrix++  Name * Name -> Set CallMatrix++the completion process finds new calls by composing old calls.+There are two qualities of new calls.++  1) a completely new call or a call matrix in which one cell+     progressed from (Decr k | k > 0) towards -infty, i.e. a positive+     entry got smaller++  2) a negative entry got smaller++As long as 1-calls are found, continue completion.+[ I think 2-calls can be ignored when deciding whether to cont. ]++ -}++-- sets of call matrices++type CMSet    = [CompCall]  -- normal form: no CM subsumes another++cmRing :: (?cutoff :: Int) => Semiring CMSet+cmRing = Semiring { add = unionCMSet , mul = mulCMSet , zero = [] } -- one = undefined ,++type Progress = Writer Any+type ProgressH = Writer (Any, Any)++firstHalf = (Any True, Any False)+secondHalf = (Any False, Any True)++-- fullProgress = Sum 2+-- halfProgress = Sum 1++-- we keep CMSets always in normal form+-- progress reported if m is "better" than one of ms+-- progress can only be reported if m is being added, i.e., not subsumed+addCMh :: CompCall -> CMSet -> ProgressH CMSet+addCMh m [] = traceProg ("adding new call " ++ show m) $ do+  tell firstHalf+  return $ [m]+addCMh m (m':ms) =+  if m' `subsumesCC` m then traceTerm ("discarding new call " ++ show m) $+     return $ m':ms -- terminate early+   else do (ms', (Any h1, Any h2)) <- listen $ addCMh m ms+           when (h1 && not h2 && m `progressCC` m') $ do+             traceProgM ("progress made by " ++ show m ++ " over " ++ show m')+             tell secondHalf -- $ Any True+           if m `subsumesCC` m' then traceTerm ("discarding old call " ++ show m') $+                 return ms'+            else return $ m' : ms'++addCM' :: CompCall -> CMSet -> Progress CMSet+addCM' m ms = mapWriter (\(ms, (Any h1, Any h2)) -> (ms, Any $ h1 && h2)) (addCMh m ms)++-- progress is reported if one of ms is "better" than ms'+-- or if the oldset was empty and is no longer+-- unionCMSet' addition oldset+unionCMSet' :: CMSet -> CMSet -> Progress CMSet+unionCMSet' [] []  = return []+unionCMSet' ms []  = tell (Any True) >> return ms+unionCMSet' ms ms' = foldM (flip addCM') ms' ms++-- non-monadic versions+addCM :: CompCall -> CMSet -> CMSet+addCM m ms = fst $ runWriter (addCM' m ms)++unionCMSet :: CMSet -> CMSet -> CMSet+unionCMSet ms ms' = fst $ runWriter (unionCMSet' ms ms')++mulCMSet :: (?cutoff :: Int) => CMSet -> CMSet -> CMSet+mulCMSet ms ms' = foldl (flip addCM) [] $ [ mulCC m m' | m <- ms, m' <- ms' ]++{- call graph entries++type CGEntry = (CallPath, CMSet)++cgeRing :: Semiring CGEntry+cgeRing = Semiring { add = zipPair addCP unionCMSet,+                     mul = zipPair mulCP mulCMSet,+                     one = undefined,+                     zero = (emptyCP, []) }++addCGEntry' :: CGEntry -> CGEntry -> Progress CGEntry+addCGEntry' (cp1, ms1) (cp2, ms2) = do+  let cp = addCP cp1 cp2+  traceTermM ("call")+  ms <- unionCMSet' ms1 ms2+  return $ (cp, ms)+-}++-- call graphs++type CallGraph = NaiveMatrix CMSet -- CGEntry++stepCG :: (?cutoff :: Int) => CallGraph -> Progress CallGraph+stepCG cg = do+  traceProgM ("next iteration")+  traceProgM ("old cg " ++ show cg)+  traceProgM ("composed calls " ++ show cg')+  traceProgM ("adding new calls to callgraph...")+  zipWithM (zipWithM unionCMSet') cg' cg+  where cg' = mmul cmRing cg cg++{- "each idempotent call f->f has a decreasing arg" is an invariant+   of good call graphs.  Thus, we can stop call graph completion+   as soon as we see it violated.++   "idempotent" is defined on abstracted call matrices, i.e.,+   those that only have <, <=, ? and are not counting.+ -}+complCGraph :: (?cutoff :: Int) => CallGraph -> CallGraph+complCGraph cg =+  let (cg', Any prog) = runWriter $ stepCG cg+  in  if prog && checkAll cg' then complCGraph cg' else cg'++checkAll :: (?cutoff :: Int) => CallGraph -> Bool+checkAll cg = all (all (checkIdem . snd)) $ diag cg++-- each idempotent call needs a decreasing diagonal entry+checkIdem :: (?cutoff :: Int) => CallMatrix -> Bool+checkIdem cm =+  let cm'   = M.mul ordRing cm cm+      eqAbs = (absCM cm) == (absCM cm')+      d     = M.diagonal cm+  in  traceTerm ("checkIdem: cm = " ++ show cm ++ " cm' = " ++ show cm ++ " eqAbs = " ++ show eqAbs ++ " d = " ++ show d) $+      -- if cm `subsumes` cm'+      if eqAbs+       then any isDecr d else True++{- generate a call graph from a list of names and list of calls+1. group calls by source, obtaining a list of row+-}++{- THIS IS WRONG:+makeCG :: [Name] -> [Call] -> CallGraph+makeCG names calls = map (\ tgt -> mkRow tgt [ c | c <- calls, target c == tgt ]) names+  where mkRow tgt calls = map (\ src ->  unionCMSet [ (mkCP src tgt, matrix c) | c <- calls, source c == src ] []) names+-}++makeCG :: [Name] -> [Call] -> CallGraph+makeCG names calls = map (\ src -> mkRow src [ c | c <- calls, source c == src ]) names+  where mkRow src calls = map (\ tgt ->  unionCMSet [ (mkCP src tgt, matrix c) | c <- calls, target c == tgt ] []) names++{-+callComb :: Call -> Call -> Call+callComb (Call s1 t1 m1) (Call s2 t2 m2) = Call s2 t1 (mmul ordRing m1 m2)++cgComb :: [Call] -> [Call] -> [Call]+cgComb cg1 cg2 = [ callComb c1 c2 | c1 <- cg1 , c2 <- cg2 , (source c1 == target c2)]++complete :: [Call] -> [Call]+complete cg = traceTerm ("call graph: " ++ show cg) $+  let cg' = complete' cg -- $ Set.fromList cg+  in -- traceTerm ("complete " ++ show cg')+       cg' -- Set.toList cg'++complete' :: [Call] -> [Call]  -- Set Call -> Set Call+complete' cg =+              let cgs = Set.fromList cg+                  cgs' = Set.union cgs (Set.fromList $ cgComb cg cg )+                  cg' = Set.toList cgs'+              in+                if (cgs == cgs') then cg else complete' cg'++checkAll :: [Call] -> Bool+checkAll x = all checkIdem x++-- each idempotent call needs a decreasing diagonal entry+checkIdem :: Call -> Bool+checkIdem c = let cc = callComb c c+                  d = diag (matrix cc)+                  containsDecr = any isDecr d+              in (not (c == cc)) || containsDecr+-}+isDecr :: Order -> Bool+isDecr o = case o of+             (Decr k) -> k > 0+             (Mat m) -> any isDecr (M.diagonal m)+             _ -> False+++-------------------++-- top level function+terminationCheck :: MonadAssert m => [Fun] -> m ()+terminationCheck funs = do+       let ?cutoff = cutoff+       traceTermM $ "terminationCheck " ++ show funs+       let tl = terminationCheckFuns funs+       let nl = map fst tl+       let bl = map snd tl+       let nl2 = [ n | (n,b) <- tl , b == False ]+       case (and bl) of+            True -> return ()+            False -> case nl of+                    [f] -> recoverFail ("Termination check for function " ++ show f ++ " fails ")+                    _   -> recoverFail ("Termination check for mutual block " ++ show nl ++ " fails for " ++ show nl2)+++terminationCheckFuns :: (?cutoff :: Int) => [Fun] -> [(Name,Bool)]+terminationCheckFuns funs =+   let namar = map (\ (Fun (TypeSig n _) _ ar _) -> (n, ar)) funs+               -- collectNames funs+       names = map fst namar+       cg0 = collectCGFunDecl namar funs+   in sizeChangeTermination names cg0++sizeChangeTermination :: (?cutoff :: Int) => [Name] -> [Call] -> [(Name,Bool)]+sizeChangeTermination names cg0 =+   let cg1 = makeCG names cg0+       cg = complCGraph $ cg1+       beh = zip names $ map (all (checkIdem . snd)) $ diag cg+   in traceTerm ("collected names: " ++ show names) $+      traceTerm ("call graph: " ++ show cg0) $+      traceTerm ("normalized call graph: " ++ show cg1) $+      traceTerm ("completed call graph: " ++ show cg) $+      traceTerm ("recursion behaviours" ++ show beh) $+      beh+++{-+terminationCheckFuns :: [ (TypeSig,[Clause]) ] -> [(Name,Bool)]+terminationCheckFuns funs =+    let beh = recBehaviours funs+    in+      traceTerm ("recursion behaviours" ++ show beh) $+        zip (map fst beh) (map (checkAll . snd ) beh )++-- This is the main driver.+recBehaviours :: [ (TypeSig,[Clause]) ] -> [(Name,[Call])]+recBehaviours funs = let names = map fst $ collectNames funs+                         cg0 = collectCGFunDecl funs+                         cg = complete cg0+                     in traceTerm ("collected names: " ++ show names) $+                        traceTerm ("call graph: " ++ show cg0) $+                        groupCalls names [ c | c <- cg , (target c == source c) ]+++groupCalls :: [Name] -> [Call] -> [(Name,[Call])]+groupCalls [] _ = []+groupCalls (n:nl) cl = (n, [ c | c <- cl , (source c == n) ]) : groupCalls nl cl+-}++{-+ccFunDecl :: [ ( TypeSig,[Clause]) ] -> [Call]+ccFunDecl funs = complete $ collectCGFunDecl funs+-}++collectCGFunDecl :: (?cutoff :: Int) => [(Name,Arity)] -> [Fun] -> [Call]+collectCGFunDecl names funs =+      concatMap (collectClauses names) funs+          where+            collectClauses :: [(Name,Arity)] -> Fun -> [Call]+            collectClauses names (Fun (TypeSig n _) _ ar cll) = collectClause names n cll+            collectClause :: [(Name,Arity)] -> Name -> [Clause] -> [Call]+            collectClause names n ((Clause _ pl Nothing):rest) = collectClause names n rest+            collectClause names n ((Clause _ pl (Just rhs)):rest) =+              traceTerm ("collecting calls in " ++ show rhs) $+                (collectCallsExpr names n pl rhs) ++ (collectClause names n rest)+            collectClause names n [] = []++{- RETIRED+arity :: [Clause] -> Int+arity [] = 0+arity (Clause pl e:l) = length pl+-}++{- RETIRED (map)+collectNames :: [Fun] -> [(Name,Arity)]+collectNames [] = []+collectNames (Fun (TypeSig n _) ar cls : rest) = (n,ar) : (collectNames rest)+-}++-- | harvest i > j  from  case i { $ j -> ...}+tsoCase :: TSO Name -> Expr -> [Clause] -> TSO Name+tsoCase tso (Var x) [Clause _ [SuccP (VarP y)] _] = TSO.insert y (1,x) tso+tsoCase tso _ _ = tso++-- | harvest i < j  from (i < j) -> ... or (i < j) & ...+tsoBind :: TSO Name -> TBind -> TSO Name+tsoBind tso (TBind x (Domain (Below ltle (Var y)) _ _)) = TSO.insert x (n ltle,y) tso+  where n Lt = 1+        n Le = 0+tsoBind tso _ = tso++collectCallsExpr :: (?cutoff :: Int) => [(Name,Arity)] -> Name -> [Pattern] -> Expr -> [Call]+collectCallsExpr nl f pl e = traceTerm ("collectCallsExpr " ++ show e) $+  loop tso e where+    tso = tsoFromPatterns pl+    loop tso (Ann e) = loop tso (unTag e)+    loop tso e = headcalls ++ argcalls where+      (hd, args) = spineView e -- $ ignoreTopErasure e+      argcalls = concatMap (loop tso) args+      headcalls = case hd of+          (Def (DefId FunK (QName g))) ->+              case lookup g nl of+                Nothing -> []+                Just ar_g ->+                  traceTerm ("found call from " ++ show f ++ " to " ++ show g) $+                             let (Just ar_f) = lookup f nl+                                 (Just f') = List.elemIndex (f,ar_f) nl+                                 (Just g') = List.elemIndex (g,ar_g) nl+                                 m = compareArgs tso pl args ar_g+                                 cg = Call { source = f+                                           , target = g+                                           , matrix = m }+                             in+                               traceTerm ("found call " ++ show cg) $+                                 [cg]+          (Case e _ cls) -> loop tso e ++ concatMap (loop (tsoCase tso e cls)) (map (maybe Irr id . clExpr) cls)+          (Lam _ _ e1) -> loop tso e1+          (LLet tb tel e1 e2) | null tel->+             (loop tso e1) ++ -- type won't get evaluated+             (loop tso e2)+          (Quant _ tb@(TBind x dom) e2) -> (loop tso (typ dom)) ++ (loop (tsoBind tso tb) e2)+          (Quant _ (TMeasure mu) e2) -> Foldable.foldMap (loop tso) mu ++ (loop tso e2)+          (Quant _ (TBound beta) e2) -> Foldable.foldMap (loop tso) beta ++ (loop tso e2)+          (Below ltle e) -> loop tso e+          (Sing e1 e2) -> (loop tso e1) ++ (loop tso e2)+          (Pair e1 e2) -> (loop tso e1) ++ (loop tso e2)+          (Succ e) -> loop tso e+          (Max es) -> concatMap (loop tso) es+          (Plus es) -> concatMap (loop tso) es+          Sort (SortC{})  -> []+          Sort (Set e)    -> loop tso e+          Sort (CoSet e)  -> loop tso e+          Var{}   -> []+          Zero{} -> []+          Infty{} -> []+          Def{}   -> []+          Irr{}   -> []+          Proj{}   -> []+          Record ri rs -> Foldable.foldMap (loop tso . snd) rs+          Ann e1 -> loop tso (unTag e1)+--          Con{}   -> []+--          Let{}   -> []+          Meta{}  -> error $ "collect calls in unresolved meta variable " ++ show e+          _ -> error $ "NYI: collect calls in " ++ show e++{-+collectCallsExpr :: (?cutoff :: Int) => [(Name,Int)] -> Name -> [Pattern] -> Expr -> [Call]+collectCallsExpr nl f pl e =+  traceTerm ("collectCallsExpr " ++ show e) $+    case e of+      (App (Def g) args) ->+        let calls = concatMap (collectCallsExpr nl f pl) args+            gIn = lookup g nl+        in+         traceTerm ("found call from " ++ f ++ " to " ++ g) $+          case gIn of+            Nothing -> calls+            Just ar_g -> let (Just ar_f) = lookup f nl+                             (Just f') = List.elemIndex (f,ar_f) nl+                             (Just g') = List.elemIndex (g,ar_g) nl+                             m = compareArgs pl args ar_g+                             cg = Call { source = f+                                       , target = g+                                       , matrix = m }+                         in+                           traceTerm ("found call " ++ show cg) $+                             cg:calls+      (Def g) ->  collectCallsExpr nl f pl (App (Def g) [])+      (App e args) -> concatMap (collectCallsExpr nl f pl) (e:args)+      (Case e cls) -> concatMap (collectCallsExpr nl f pl) (e:map clExpr cls)+      (Lam _ _ e1) -> collectCallsExpr nl f pl e1+      (LLet _ e1 t1 e2) ->  (collectCallsExpr nl f pl e1) ++ -- type won't get evaluated+                            (collectCallsExpr nl f pl e2)+      (Pi _ _ e1 e2) -> (collectCallsExpr nl f pl e1) +++                              (collectCallsExpr nl f pl e2)+      (Sing e1 e2) -> (collectCallsExpr nl f pl e1) +++                              (collectCallsExpr nl f pl e2)+      (Succ e1) -> collectCallsExpr nl f pl e1+      Sort{}  -> []+      Var{}   -> []+      Infty{} -> []+      Con{}   -> []+      Let{}   -> []+      Meta{}  -> error $ "collect calls in unresolved meta variable " ++ show e+      _ -> error $ "NYI: collect calls in " ++ show e+-}++----------------------------------------------------------------------+{- Foetus II - Counting Lexicographic Termination (delta-Foetus)++delta-SCT [Ben-Amram 2006] is too inefficient, at least with the bound+given in the paper.++  B(G) = (k + 1)2^k · m^2 · 2^(2k+1) (m∆)^(3k+1) (k + 1)^(3k^2+3k+1)++is an upper bound on the length of the longest path to be looked at to+exclude non-termination.++I guess that both argument permutation and counting is not very+common.  So an approach would be++- try to show termination with SCT+- try to show termination with delta-Foetus++Call graph completion in delta-Foetus++1. Iterate as long new simple cycles show up (i.e. cycles with no subcycles)++2. Find the possible lexicographic termination orders to for each function++3. Continue iterating while any of the arguments involved in any of the termination orders gets worse.  Some termination order hypotheses might collapse.++4. Stop when all hypotheses have collapsed (FAIL) or when no standing hypotheses gets any worse (SUCCESS).++Implementation:++After 1. save for each function and each of its arguments the worst+recursive behavior in any of the calls.  This map will be used to+monitor progress.+++Careful:++  f x = f (x-1) | g (x - 100)+  g x = g (x+1) | f (x - 100)++Bad call f->f only found after 201 iterations of g!++Idea:  regular expressions over call matrices!++  (m1 + m2^*)^*++-}
+ ToHaskell.hs view
@@ -0,0 +1,292 @@+module ToHaskell where++{- type-directed extraction of Haskell programs with a lot of unsafeCoerce++Examples:+---------++MiniAgda++  data Vec (A : Set) : Nat -> Set+  { vnil  : Vec A zero+  ; vcons : [n : Nat] -> (head : A) -> (tail : Vec A n) -> Vec A (suc n)+  }++  fun length : [A : Set] -> [n : Nat] -> Vec A n -> <n : Nat>+  { length .A .zero    (vnil A)         = zero+  ; length .A .(suc n) (vcons A n a as) = suc (length A n as)+  }++Haskell++  {-# LANGUAGE NoImplicitPrelude #-}+  module Main where+  import qualified Text.Show as Show++  data Vec (a :: *)+    = Vec_vnil+    | Vec_vcons { vec_head :: a , vec_tail :: Vec a }+      deriving Show.Show++  length :: forall a. Vec a -> Nat+  length  Vec_vnil        = Nat_zero+  length (Vec_vcons a as) = Nat_suc (length as)++Components:+-----------++Translation from MiniAgda identifiers to Haskell identifiers++-}++import Prelude hiding (null)++import Data.Char++import Control.Applicative+import Control.Monad+import Control.Monad.Error+import Control.Monad.Reader+import Control.Monad.Writer+import Control.Monad.State++import Data.Map (Map)+import qualified Data.Map as Map+import qualified Data.Traversable as Trav++import qualified Language.Haskell.Exts.Syntax as H+import Text.PrettyPrint++import Polarity+import Abstract+import Extract+import qualified HsSyntax as H+import TraceError+import Util++-- translation monad++type Translate = StateT TState (ReaderT TContext (ErrorT TraceError IO))++{- no longer needed with mtl-2+instance Applicative Translate where+  pure      = return+  mf <*> ma = do { f <- mf; a <- ma; return (f a) }+-}++data TState = TState++initSt :: TState+initSt = TState++data TContext = TContext++initCxt :: TContext+initCxt = TContext++runTranslate :: Translate a -> IO (Either TraceError a)+runTranslate t = runErrorT (runReaderT (evalStateT t initSt) initCxt)++-- translation++translateModule :: [EDeclaration] -> Translate (H.Module)+translateModule ds = do+  hs <- translateDecls ds+  return $ H.mkModule hs++translateDecls :: [EDeclaration] -> Translate [H.Decl]+translateDecls ds = concat <$> mapM translateDecl ds++translateDecl :: EDeclaration -> Translate [H.Decl]+translateDecl d =+  case d of+    MutualDecl _ ds -> translateDecls ds+    OverrideDecl{} -> fail $ "translateDecls internal error: overrides impossible"+    MutualFunDecl _ _ funs -> translateFuns funs+    FunDecl _ fun -> translateFun fun+    LetDecl _ x tel (Just t) e | null tel -> translateLet x t e+    DataDecl n _ _ _ tel fkind cs _ -> translateDataDecl n tel fkind cs++translateFuns :: [Fun] -> Translate [H.Decl]+translateFuns funs = concat <$> mapM translateFun funs++translateFun :: Fun -> Translate [H.Decl]+translateFun (Fun ts@(TypeSig n t) n' ar cls) = do+  ts@(H.TypeSig _ [n] t) <- translateTypeSig ts+  cls <- concat <$> mapM (translateClause n) cls+  return [ts, H.FunBind cls]++translateLet :: Name -> Type -> FExpr -> Translate [H.Decl]+translateLet n t e+  | isEtaAlias n = return []  -- skip internal decls+  | otherwise = do+      ts <- translateTypeSig $ TypeSig n t+      e  <- translateExpr e+      n  <- hsName (DefId LetK $ QName n)+      return [ ts, H.mkLet n e ]++translateTypeSig :: TypeSig -> Translate H.Decl+translateTypeSig (TypeSig n t) = do+  n <- hsName (DefId LetK $ QName n)+  t <- translateType t+  return $ H.mkTypeSig n t++translateDataDecl :: Name -> FTelescope -> FKind -> [FConstructor] -> Translate [H.Decl]+translateDataDecl n tel k cs = do+  n   <- hsName (DefId DatK $ QName n)+  tel <- translateTelescope tel+  let k' = translateKind k+  cs  <- mapM translateConstructor cs+  return [H.mkDataDecl n tel k' cs]++translateConstructor :: FConstructor -> Translate H.GadtDecl+translateConstructor (Constructor n pars t) = do+  n  <- hsName (DefId (ConK Cons) n)+  t' <- translateType t+  return $ H.mkConDecl n t'++translateClause :: H.Name -> Clause -> Translate [H.Match]+translateClause n (Clause _ ps (Just rhs)) = do+  ps <- mapM translatePattern ps+  rhs <- translateExpr rhs+  return [H.mkClause n ps rhs]++translateTelescope :: FTelescope -> Translate [H.TyVarBind]+translateTelescope (Telescope tel) = mapM translateTBind tel'+  -- throw away erasure marks+  where tel' = filter (\ tb -> not $ erased $ decor $ boundDom tb) tel++translateTBind :: TBind -> Translate H.TyVarBind+translateTBind (TBind x dom) = do+  x <- hsVarName x+  return $ H.KindedVar x $ translateKind (typ dom)++translateKind :: FKind -> H.Kind+translateKind k =+  case k of+    k | k == star -> H.KindStar+    Quant Pi (TBind _ dom) k' | erased (decor dom) -> translateKind k'+    Quant Pi (TBind _ dom) k' ->+      translateKind (typ dom) `H.mkKindFun` translateKind k'++translateType :: FType -> Translate H.Type+translateType t =+  case t of++    Irr -> return $ H.unit_tycon++    Quant piSig (TBind _ dom) b | not (erased (decor dom)) ->+      H.mkTyPiSig piSig <$> translateType (typ dom) <*> translateType b++    Quant Pi (TBind _ dom) b | typ dom == Irr -> translateType b++    Quant Pi (TBind x dom) b -> do+      x <- hsVarName x+      let k = translateKind (typ dom)+      -- todo: add x to context+      t <- translateType b+      return $ H.mkForall x k t++    App f a -> H.mkTyApp <$> translateType f <*> translateType a++    Def d@(DefId DatK n) -> (H.TyCon . H.UnQual) <$> hsName d++    Var x -> H.TyVar <$> hsVarName x++    _ -> return H.unit_tycon++{- TODO:+    _ -> fail $ "no Haskell representation for type " ++ show t+ -}++translateExpr :: FExpr -> Translate H.Exp+translateExpr e =+  case e of++    Var x -> H.mkVar <$> hsVarName x++    -- constructors+    Def f@(DefId (ConK{}) n) -> H.mkCon <$> hsName f++    -- function identifiers+    Def f@(DefId _ n) -> H.mkVar <$> hsName f++    -- discard type arguments+    App f e0 -> do+      f <- translateExpr f+      let (er, e) = isErasedExpr e0+      if er then return f else H.mkApp f <$> translateExpr e++    -- discard type lambdas+    Lam dec y e -> do+      y <- hsVarName y+      e <- translateExpr e+      return $ if erased dec then e else H.mkLam y e++    LLet (TBind x dom) tel e1 e2 | null tel-> do+      x  <- hsVarName x+      e2 <- translateExpr e2+      if erased (decor dom) then return e2 else do+        t  <- Trav.mapM translateType (typ dom)+        e1 <- translateExpr e1+        return $ H.mkLLet x t e1 e2++    Pair e1 e2 -> H.mkPair <$> translateExpr e1 <*> translateExpr e2++    -- TODO++    Ann (Tagged [Cast] e) -> H.mkCast <$> translateExpr e++    _ -> return $ H.unit_con++translatePattern :: Pattern -> Translate H.Pat+translatePattern p =+  case p of+    VarP y       -> H.PVar <$> hsVarName y+    PairP p1 p2  -> H.PTuple H.Boxed <$> mapM translatePattern [p1,p2]+    ConP pi n ps ->+       H.PApp <$> (H.UnQual <$> hsName (DefId (ConK $ coPat pi) n))+              <*> mapM translatePattern ps++{-+Name translation++  data names        : check capitalization, identity translation+  constructor names : prefix with Dataname_+  destructor names  : ditto+  type-valued lets  : check capitalization, identity+  type-valued funs  : reject!+  lets              : check lowercase+  funs/cofuns       : check lowercase+-}++hsVarName :: Name -> Translate H.Name+hsVarName x = return $ H.Ident $ show x++hsName :: DefId -> Translate H.Name+hsName id = enter ("error translating identifier " ++ show id) $+  case id of+  (DefId DatK (QName x)) -> do+    let n = suggestion x+    unless (isUpper $ head n) $+      fail $ "data names need to be capitalized"+    return $ H.Ident n+  (DefId (ConK co) (Qual d x)) -> do+    let n = suggestion x+        m = suggestion d+    return $ H.Ident $ m ++ "_" ++ n+    -- dataName <- getDataName x+    -- return $ H.Ident $ dataName ++ "_" ++ n+  -- lets, funs, cofuns. TODO: type-valued funs!+--   (DefId Let ('_':n)) | -> return $ H.Ident n+  (DefId _ x) -> do+    let n = suggestion $ unqual x+{- ignore for now+     unless (isLower $ head n) $+       fail $ "function names need to start with a lowercase letter"+ -}+    return $ H.Ident n++-- getDataName constructorName = return dataNamec+getDataName :: Name -> Translate String+getDataName n = return "DATA"
+ Tokens.hs view
@@ -0,0 +1,29 @@+module Tokens where++data Token +  = Id String+  | Data+  | Fun+  | Def+  | Mutual+  | Pattern+  | Set+  | Case+  -- size type+  | Size+  | Infty+  | Succ+  --+  | BrOpen+  | BrClose+  | PrOpen+  | PrClose+  | Sem+  | Col+  | Arrow+  | Eq+  | Lam+  | UScore+  | NotUsed -- so happy doesn't generate overlap case pattern warning+    deriving (Eq,Ord,Show)+
+ TraceError.hs view
@@ -0,0 +1,102 @@+{-# LANGUAGE MultiParamTypeClasses, FlexibleContexts #-}++module TraceError where++import Control.Monad.Error+import Debug.Trace++import Util+import Text.PrettyPrint++data TraceError = Err String | TrErr String TraceError++instance Error TraceError where+    noMsg = Err "no message"+    strMsg s = Err s++instance Show TraceError where+    show (Err str) = str+    show (TrErr str err) = str ++ "\n/// " ++ show err++throwErrorMsg m = throwError (Err m)++-- newErrorMsg :: (MonadError TraceError m) => m a -> String -> m a+newErrorMsg c s = c `catchError` (\ _ -> throwErrorMsg s)+-- addErrorMsg c s = c `catchError` (\ s' -> throwErrorMsg (s' ++ "\n" ++ s))++-- extend the current error message by n+throwTrace x n = x `catchError` ( \e -> throwError $ TrErr n e)+enter n x = throwTrace x n+enterTrace n x = trace n $ throwTrace x n+enterShow n = enter (show n)++enterDoc :: (MonadError TraceError m, Pretty d) => m d -> m a -> m a+enterDoc md cont = do+  d <- md+  enter (render (pretty d)) cont++failDoc :: (Monad m) => m Doc -> m a+failDoc d = fail . render =<< d++newErrorDoc :: (MonadError TraceError m) => m a -> m Doc -> m a+newErrorDoc c d = c `catchError` (\ _ -> failDoc d)++errorToMaybe :: (MonadError e m) => m a -> m (Maybe a)+errorToMaybe m = (m >>= return . Just) `catchError` (const $ return Nothing)++errorToBool :: (MonadError e m) => m () -> m Bool+errorToBool m = (m >> return True) `catchError` (\ _ -> return False)++boolToErrorDoc :: (Monad m) => m Doc -> Bool -> m ()+boolToErrorDoc d True  = return ()+boolToErrorDoc d False = failDoc d++boolToError :: (Monad m) => String -> Bool -> m ()+boolToError msg True  = return ()+boolToError msg False = fail msg++instance MonadError () Maybe where+  catchError Nothing k = k ()+  catchError (Just a) k = Just a+  throwError () = Nothing++orM :: (MonadError e m) => m a -> m a -> m a+orM m1 m2 = m1 `catchError` (const m2)++-- recoverable errors++data AssertionHandling = Failure | Warning | Ignore+                       deriving (Eq,Ord,Show)++assert' :: (MonadIO m) => AssertionHandling -> Bool -> String -> m ()+assert' Ignore b s      = return ()+assert' h True s        = return ()+assert' Warning False s = liftIO $ putStrLn $ "warning: ignoring error: " ++ s+assert' Failure False s = fail s++assertDoc' :: (MonadIO m) => AssertionHandling -> Bool -> m Doc -> m ()+assertDoc' h b md = assert' h b . render =<< md++class Monad m => MonadAssert m where+  assert :: Bool -> String -> m ()+  assertDoc :: Bool -> m Doc -> m ()+  assertDoc b md = assert b . render =<< md+  newAssertionHandling :: AssertionHandling -> m a -> m a+  recoverFail :: String -> m ()+  recoverFail = assert False+  recoverFailDoc :: m Doc -> m ()+  recoverFailDoc = assertDoc False++{-+assert' :: (MonadIO m) => AssertionHandling -> Bool -> String -> m a -> m a+assert' Ignore b s k = k+assert' h True s k = k+assert' Warning False s k = do+  liftIO $ putStrLn s+  k+assert' Failure False s k = fail s++class Monad m => MonadAssert m where+  assert :: Bool -> String -> m a -> m a+  newAssertionHandling :: AssertionHandling -> m a -> m a+-}
+ TreeShapedOrder.hs view
@@ -0,0 +1,164 @@+{- A data structure to represent a forest of upside down trees,+similar to union-find.  The idea is to manage a tree-shaped form of+strict inequations++  i1 > i2 > i3+     > j2 > j3 > j4 > j5+          > k3+          > l3 > l4++  m1 > m2++  n1++Checking inequalty x < y is then performed by just enumerating the+parents of x and checking wether y is a member of it.++2010-11-12 UPDATE: We generalize this to ">=" and more by attaching to+each link a non-negative number.++  0  means  >=+  1  means  >+  n  means  at least n units greater+-}++module TreeShapedOrder where++import Prelude hiding (null)+import Data.List hiding (insert, null) -- groupBy++import Data.Map (Map)+import qualified Data.Map as Map++import Data.Tree (Tree(..), Forest) -- rose trees+import qualified Data.Tree as Tree++import Util -- headM++-- | Tree-structured partial orders.+--   Represented as maps from children to parents plus a non-negative distance.+newtype TSO a = TSO { unTSO :: Map a (Int,a) } deriving (Eq, Ord)++-- | Empty TSO.+empty :: TSO a+empty = TSO $ Map.empty++-- | @insert a b o@  inserts a with parent b into order o.+-- It does not check whether the tree structure is preserved.+insert :: (Ord a, Eq a) => a -> (Int, a) -> TSO a -> TSO a+insert a b (TSO o) = TSO $ Map.insert a b o++-- | Construction from a list of child-distance-parent tuples.+fromList :: (Ord a, Eq a) => [(a,(Int,a))] -> TSO a+fromList l = foldl (\ o (a,b) -> insert a b o) empty l++-- | @parents a0 o = [(d1,a1),..,(dn,an)]@ lists the parents of @a0@ in order,+-- i.e., a(i+1) is parent of a(i) with distance d(i+1).+parents :: (Ord a, Eq a) => a -> TSO a -> [(Int,a)]+parents a (TSO o) = loop (Map.lookup a o) where+  loop Nothing  = []+  loop (Just (n,b)) = (n,b) : loop (Map.lookup b o)++-- | @parent a o@ returns the immediate parent, if it exists.+parent :: (Ord a, Eq a) => a -> TSO a -> Maybe (Int,a)+parent a t = headM $ parents a t++-- | @isAncestor a b o = Just n@ if there are n steps up from a to b.+isAncestor :: (Ord a, Eq a) => a -> a -> TSO a -> Maybe Int+isAncestor a b o = loop 0 ((0,a) : parents a o)+   where loop acc [] = Nothing+         loop acc ((n,a) : ps) | a == b    = Just (acc + n)+                               | otherwise = loop (acc + n) ps++-- | @diff a b o = Just k@ if there are k steps up from a to b+-- or (-k) steps down from b to a.+diff ::  (Ord a, Eq a) => a -> a -> TSO a -> Maybe Int+diff a b o = maybe (fmap (\ k -> -k) $ isAncestor b a o) Just $ isAncestor a b o++-- | create a map from parents to list of sons, leaves have an empty list+invert :: (Ord a, Eq a) => TSO a -> Map a [(Int,a)]+invert (TSO o) = Map.foldrWithKey step Map.empty o where+  step son (dist, parent) m = Map.insertWith (++) son [] $+    Map.insertWith (++) parent [(dist, son)] m++-- | @height a t = Just k@ if $k$ is the length of the+--   longest path from @a@ to a leaf. @Nothing@ if @a@ not in @t@.+height :: (Ord a, Eq a) => a -> TSO a -> Maybe Int+height a t = do+  let m = invert t+  let loop parent = do+        sons <- Map.lookup parent m+        return $ if null sons then 0 else+                  maximum $ map (\ (n,son) -> maybe 0 (n +) $ loop son) sons+  loop a++-- | @increasesHeight a (n,b) t = True@ if @n > height b t@, i.e., if+--   the insertion of a with parent b will destroy an existing+--   minimal valuation of @t@+increasesHeight :: (Ord a, Eq a) => a -> (Int, a) -> TSO a -> Bool+increasesHeight a (n,b) t = n > maybe 0 id (height b t)++-- | get the leaves of the TSO forest+leaves :: (Ord a, Eq a) => TSO a -> [a]+leaves o = map fst $ filter (\ (parent,sons) -> null sons) $ Map.toList (invert o)++{- FLAWED BOTTOM-UP-ATTEMPT, DOES NOT WORK+{- How to invert a TSO?++1. Create a Map from parents to their list of children.++2. Keep a working set of nodes.+   Find the leafs in this working set (nodes that do not have children).+   Cluster them by their parents.+   Turn their parents into trees,+   Continue with the parents.+-}+-- | invert a tree shaped order into a forest.  This can be used for printing+toForest :: (Ord a, Eq a) => TSO a -> Forest a+toForest o = loop (step initialTrees) where+  initialTrees = map (flip Node []) $ leaves o+  -- step :: (Ord a, Eq a) => Forest a -> [(Maybe a, Forest a)]+  step ts = map (\ l -> (fst (head l), map snd l)) $+    groupBy (\ (p,t) (p',t') -> p == p') $+    sortBy (\ (p,t) (p',t') -> compare p p') $+    map (\ t -> (parent (rootLabel t) o, t)) ts+  -- loop :: (Ord a, Eq a) => [(Maybe a, Forest a)] -> Forest a+  loop [] = []+  -- the trees whose roots have no parents are parts of the final forest+  loop ((Nothing, roots) : nonroots) = roots ++ loop nonroots+  -- the trees whose roots have a parent are iterated+  loop nonroots = loop $ step $ map (\ (Just p, ts) -> Node p ts) nonroots+-}++-- take a lexicographically sorted list of pathes+-- and turn it into a forest by+-- gathering the lists by common prefixes+pathesToForest :: (Ord a, Eq a) => [[(Int,a)]] -> Forest (Int, a)+pathesToForest [] = []+pathesToForest ll =+  map (\ l -> Node (head (head l))+                   (pathesToForest $ filter (not . null) $ map tail l)) $+    groupBy (\ l l' -> head l == head l') ll++-- | invert a tree shaped order into a forest.  This can be used for printing.+toForest :: (Ord a, Eq a) => TSO a -> Forest (Int,a)+toForest o = pathesToForest $ sort $ map (\ a -> reverse ((0,a) : parents a o)) $ leaves o -- lex. sort++instance (Ord a, Eq a, Show a) => Show (TSO a) where+  show o = Tree.drawForest $ map (fmap show) $ toForest o++{-+draw :: (Ord a, Eq a, Show a) => TSO a -> String+draw o = Tree.drawForest $ map (fmap show) $ toForest o+-}++-- test++l1 = map (\ (k,l) -> ("i" ++ show k, (1, "i" ++ show l))) [(0,1),(1,2),(2,3),(3,4)]+     ++ [("j2",(1,"i3"))]+o1 = fromList l1+t1 = diff "i2" "i1" o1+t2 = diff "i2" "j2" o1+t3 = height "i2" o1+t4 = height "i4" o1+t5 = height "k" o1
+ TypeChecker.hs view
@@ -0,0 +1,3302 @@+{-# LANGUAGE FlexibleInstances, TypeSynonymInstances,+      PatternGuards, TupleSections, NamedFieldPuns #-}++module TypeChecker where++import Prelude hiding (null)++import Control.Applicative hiding (Const) -- ((<$>))+import Control.Monad+import Control.Monad.IfElse+import Control.Monad.Identity+import Control.Monad.State+import Control.Monad.Error+import Control.Monad.Reader++import qualified Data.List as List+import Data.Map (Map)+import qualified Data.Map as Map+import Data.Maybe+import qualified Data.Foldable as Foldable+import qualified Data.Traversable as Traversable++import Debug.Trace++import qualified Text.PrettyPrint as PP++import Util+import qualified Util as Util++import Abstract hiding (Substitute)+import Polarity as Pol+import Value+import TCM+import Eval+import Extract+-- import SPos (nocc) -- RETIRED+-- import CallStack+import PrettyTCM+import TraceError++import Warshall hiding (Flex) -- size constraint checking++import Termination++-- import Completness+++traceCheck msg a = a -- trace msg a+traceCheckM msg = return () -- traceM msg+{-+traceCheck msg a = trace msg a+traceCheckM msg = traceM msg+-}++traceSing msg a = a -- trace msg a+traceSingM msg = return () -- traceM msg+{-+traceSing msg a = trace msg a+traceSingM msg = traceM msg+-}++traceAdm msg a = a -- trace msg a+traceAdmM msg = return () -- traceM msg+{-+traceAdm msg a = trace msg a+traceAdmM msg = traceM msg+-}++{- DEAD CODE+runWhnf :: Signature -> TypeCheck a -> IO (Either TraceError (a,Signature))+runWhnf sig tc = (runErrorT (runStateT tc  sig))+-}++doNf sig e = runErrorT (runReaderT (runStateT (whnf emptyEnv e >>= reify) (initWithSig sig)) emptyContext)+doWhnf sig e = runErrorT (runReaderT (runStateT (whnf emptyEnv e >>= whnfClos) (initWithSig sig)) emptyContext)+++-- top-level functions -------------------------------------------++runTypeCheck :: TCState -> TypeCheck a -> IO (Either TraceError (a,TCState))+runTypeCheck st tc = runErrorT (runReaderT (runStateT tc st) emptyContext)+-- runTypeCheck st tc = runCallStackT (runReaderT (runStateT tc st) emptyContext) []++typeCheck dl = runTypeCheck initSt (typeCheckDecls dl)++-- checking top-level declarations -------------------------------++echo :: MonadIO m => String -> m ()+echo = liftIO . putStrLn++echoR = echo+-- echoR s = echo $ "R> " ++ s++echoTySig :: (Show n, MonadIO m) => n -> Expr -> m ()+echoTySig n t = return () -- echo $ "I> " ++ n ++ " : " ++ show t++echoKindedTySig :: (Show n, MonadIO m) => Kind -> n -> Expr -> m ()+echoKindedTySig ki n t = echo $ prettyKind ki ++ "  " ++ show n ++ " : " ++ show t++echoKindedDef :: (Show n, MonadIO m) => Kind -> n -> Expr -> m ()+echoKindedDef ki n t = echo $ prettyKind ki ++ "  " ++ show n ++ " = " ++ show t++echoEPrefix = "E> "++echoTySigE :: (Show n, MonadIO m) => n -> Expr -> m ()+echoTySigE n t = echo $ echoEPrefix ++ show n ++ " : " ++ show t++echoDefE :: (Show n, MonadIO m) => n -> Expr -> m ()+echoDefE n t = echo $ echoEPrefix ++ show n ++ " = " ++ show t++-- the type checker returns pruned (extracted) terms+-- with irrelevant subterms replaced by Irr+typeCheckDecls :: [Declaration] -> TypeCheck [EDeclaration]+typeCheckDecls []     = return []+typeCheckDecls (d:ds) = do+  de  <- typeCheckDeclaration d+  dse <- typeCheckDecls ds+  return (de ++ dse)++-- since a data declaration generates destructor declarations+-- we need to return a list here+typeCheckDeclaration :: Declaration -> TypeCheck [EDeclaration]+typeCheckDeclaration (OverrideDecl Check ds) = do+  st <- get+  typeCheckDecls ds+  put st             -- forget the effect of these decls+  return []+typeCheckDeclaration (OverrideDecl Fail ds) = do+  st <- get+  r <- (typeCheckDecls ds >> return True) `catchError`+        (\ s -> do liftIO $ putStrLn ("block fails as expected, error message:\n" ++ show s)+                   return False)+  if r then fail "unexpected success" else do+    put st+    return []++typeCheckDeclaration (OverrideDecl TrustMe ds) =+  newAssertionHandling Warning $ typeCheckDecls ds++typeCheckDeclaration (OverrideDecl Impredicative ds) =+  goImpredicative $ typeCheckDecls ds++typeCheckDeclaration (RecordDecl n tel t0 c fields) =+  -- just one "mutual" declaration+  checkingMutual (Just $ DefId DatK $ QName n) $ do+    result <- typeCheckDataDecl n NotSized CoInd [] tel t0 [c] fields+    checkPositivityGraph+    return result++typeCheckDeclaration (DataDecl n sz co pos0 tel t0 cs fields) =+  -- just one "mutual" declaration+  checkingMutual (Just $ DefId DatK $ QName n) $ do+    result <- typeCheckDataDecl n sz co pos0 tel t0 cs fields+    checkPositivityGraph+    return result++typeCheckDeclaration (LetDecl eval n tel mt e) = enter (show n) $ do+{- MOVED to checkLetDef+  (tel, (vt, te, Kinded ki ee)) <- checkTele tel $ checkOrInfer neutralDec e mt+  te <- return $ teleToType tel te+  ee <- return $ teleLam tel ee+  vt <- whnf' te+-}+  (vt, te, Kinded ki ee) <- checkLetDef neutralDec tel mt e+  rho <- getEnv -- is emptyEnv+  -- TODO: solve size constraints+  -- does not work with emptyEnv+  -- [te, ee] <- solveAndModify [te, ee] rho  -- solve size constraints+  let v = mkClos rho ee -- delay whnf computation+  -- v  <- whnf' ee -- WAS: whnf' e'+  addSig n (LetSig vt ki v $ undefinedFType $ QName n)    -- late (var -> expr) binding, but ok since no shadowing+--  addSig n (LetSig vt e')    -- late (var -> expr) binding, but ok since no shadowing+  echoKindedTySig ki n te+--  echoTySigE n te+--  echoDefE   n ee+  echoKindedDef ki n ee+  return [LetDecl eval n emptyTel (Just te) ee]++typeCheckDeclaration d@(PatternDecl x xs p) = do+{- WHY DOES THIS NOT TYPECHECK?+  let doc = (PP.text "pattern") <+> (PP.hsep (List.map Util.pretty (x:xs))) <+> PP.equals <+> Util.pretty p+  echo $ PP.render $ doc+-}+  echo $ "pattern " ++ Util.showList " " show (x:xs) ++ " = " ++ show p+  v <- whnf' $ foldr (Lam defaultDec) (patternToExpr p) xs+  addSig x (PatSig xs p v)+  return [d]++typeCheckDeclaration (MutualFunDecl False co funs) =+  -- traceCheck ("type checking a function block") $+  do+    funse <- typeCheckFuns co funs+    return $ [MutualFunDecl False co funse]++typeCheckDeclaration (MutualFunDecl True co funs) =+  -- traceCheck ("type checking a block of measured function") $+  do+    funse <- typeCheckMeasuredFuns co funs+    return $ [MutualFunDecl False co funse]++typeCheckDeclaration (MutualDecl measured ds) = do+  -- first check type signatures+  -- we add the typings into the context, not the signature+  ktss <- typeCheckMutualSigs ds+  -- register the mutually defined names+  let ns = for ktss $ \ (Kinded _ (TypeSig n _)) -> n+      addMutualNames = local $ \ e -> e { mutualNames = ns ++ mutualNames e }+  -- then check bodies+  -- we need to construct a positivity graph+  edss <- addKindedTypeSigs ktss $ addMutualNames $+    zipWithM (typeCheckMutualBody measured) (map (predKind . kindOf) ktss) ds+  -- check and reset positivity graph+  checkPositivityGraph+  return $ concat edss+++-- check signatures of a flattened mutual block+typeCheckMutualSigs :: [Declaration] -> TypeCheck [Kinded (TySig TVal)]+typeCheckMutualSigs [] = return []+typeCheckMutualSigs (d:ds) = do+  kts@(Kinded ki (TypeSig n tv)) <- typeCheckMutualSig d+  new' n (Domain tv ki defaultDec) $ do+    ktss <- typeCheckMutualSigs ds+    return $ kts : ktss++typeCheckSignature :: TySig Type -> TypeCheck (Kinded (TySig TVal))+typeCheckSignature (TypeSig n t) = do+  echoTySig n t+  Kinded ki te <- checkType t+  tv <- whnf' te+  return $ Kinded (predKind ki) $ TypeSig n tv++typeCheckMutualSig :: Declaration -> TypeCheck (Kinded (TySig TVal))+typeCheckMutualSig (LetDecl ev n tel (Just t) e) =+  typeCheckSignature $ TypeSig n $ teleToType tel t+typeCheckMutualSig (DataDecl n sz co pos tel t cs fields) = do+  Kinded ki ts <- typeCheckSignature (TypeSig n (teleToType tel t))+  return $ Kinded ki ts+typeCheckMutualSig (FunDecl co (Fun ts n' ar cls)) =+  typeCheckSignature ts+typeCheckMutualSig (OverrideDecl TrustMe [d]) =+  newAssertionHandling Warning $ typeCheckMutualSig d+typeCheckMutualSig (OverrideDecl Impredicative [d]) =+  goImpredicative $ typeCheckMutualSig d+typeCheckMutualSig d = fail $ "typeCheckMutualSig: panic: unexpected declaration " ++ show d++-- typeCheckMutualBody measured kindCandidate+typeCheckMutualBody :: Bool -> Kind -> Declaration -> TypeCheck [EDeclaration]+typeCheckMutualBody measured _ (DataDecl n sz co pos tel t cs fields) = do+  -- set name of mutual thing whose body we are checking+  checkingMutual (Just $ DefId DatK $ QName n) $+    --+    typeCheckDataDecl n sz co pos tel t cs fields+typeCheckMutualBody measured@False ki (FunDecl co fun@(Fun ts@(TypeSig n t) n' ar cls)) = do+  checkingMutual (Just $ DefId FunK $ QName n) $ do+    fun' <- typeCheckFunBody co ki fun+    return $ [FunDecl co fun']++typeCheckDataDecl :: Name -> Sized -> Co -> [Pol] -> Telescope -> Type -> [Constructor] -> [Name] -> TypeCheck [EDeclaration]+typeCheckDataDecl n sz co pos0 tel0 t0 cs0 fields = enter (show n) $+ (do -- sig <- gets signature+     let params = size tel0+     -- in case we are dealing with a sized type, check that+     -- the polarity annotation (if present) at the size arg. is correct.+     (p', pos, t) <- do+       case sz of+         Sized    -> do+           let polsz = if co==Ind then Pos else Neg+           t <- case t0 of+             Quant Pi (TBind x (Domain domt ki dec)) b | isSize domt ->+               case (polarity dec) of+                 -- insert correct polarity annotation if none was there+                 pol | pol `elem` [Param,Rec] -> return $ Quant Pi (TBind x $ Domain tSize kSize $ setPol polsz dec) b+                 pol | pol == polsz -> return t0+                 pol -> fail $ "sized type " ++ show n ++ " has wrong polarity annotation " ++ show pol ++ " at Size argument, it should be " ++ show polsz+             t0 -> return t0+           return (params + 1, pos0 ++ [polsz], t)+         NotSized -> return (params, pos0, t0)+     -- compute full type signature (including parameter telescope)+     let dt = (teleToType tel0 t)+     echoTySig n dt+     {- mmh, this does not work,  e.g.  data Id (A : Set)(a : A) : A -> Set+        then A -> Set is not distinguishable from Set -> Set (GADT)+        unclear what to do...+     dte <- checkTele tel $ \ tele -> do+       te <- checkSmallType t+       return (teleToType tele te)+      -}+     -- get the target sort ds of the datatype+     Kinded ki0 (ds, dte) <- checkDataType p' dt -- TODO?: use above code?+     let ki = dataKind ki0+     echoKindedTySig ki n dte+--     echoTySigE n dte+     v <- whnf emptyEnv dte+     Just fkind <- extractKind v+     -- get the updated telescope which contains the kinds+     let (tel, dtcore) = typeToTele' params dte+     -- compute the constructor telescopes+     cs0 <- mapM (insertConstructorTele tel dtcore) cs0+     let cis = analyzeConstructors co n tel cs0+     let cs  = map reassembleConstructor cis+     addSig n (DataSig { numPars = params+                       , positivity = pos+                       , isSized = sz+                       , isCo = co+                       , symbTyp = v+                       , symbolKind = ki+                       , constructors = cis+                       , etaExpand = False+                       , isTuple = False+-- if cs==[] then Just [] else Nothing+{- OLD CODE+                       , constructors = map namePart cs+                       -- at first, do not add destructors, get them out later+                       , destructors  = Nothing+                       , isFamily = t /= Set  -- currently UNUSED+ -}+                       , extrTyp = fkind+                       })+     when (sz == Sized) $+           szType co params v++     (isRecList, kcse) <- liftM unzip $+       mapM (typeCheckConstructor n dte sz co pos tel) cs++     -- compute the kind of the data type from the kinds of the+     -- constructor arguments  (mmh, DOES NOT WORK FOR MUTUAL DATA!)+     let newki = case (foldl unionKind NoKind (map kindOf kcse)) of+          NoKind  -> kType -- no non-rec constructor arguments+          AnyKind -> AnyKind+          Kind s s' -> Kind (Set Zero) s' -- a data type is always also a type+     -- echoKindedTySig newki n dte -- 2012-01-26 disabled (repetitive)++     -- solve for size variables+     sol <- solveConstraints+     -- TODO: substitute+     resetConstraints++     -- add destructors only for the constructors that are non-overlapping+     let decls = concat $ map mkDestrs cis+         -- cEtaExp = True means that all field names are present+         -- and constructor is not overlapping with others+         mkDestrs ci | cEtaExp ci = concat $ map mkDestr (cFields ci)+                     | otherwise  = []+         mkDestr fi =+          case (fClass fi) of+             Field (Just (ty, arity, cl)) | not (erased $ fDec fi) && not (emptyName $ fName fi) ->+               let n' = fName fi+                   n  = internal n'+               in+               [MutualFunDecl False Ind [Fun (TypeSig n ty) n' arity [cl]]]+             _ -> []++     when (not (null decls)) $+        traceCheckM $ "generated destructors: " ++ show decls+     declse <- mapM (\ d@(MutualFunDecl False co [Fun (TypeSig n t) n' ar cls]) -> do+                       -- echo $ "G> " ++ showFun co ++ " " ++ show n ++ " : " ++ show t+                       -- echo $ "G> " ++ PP.render (prettyFun n cls)+                       checkingMutual Nothing $ typeCheckDeclaration d)+                 decls++     -- decide whether to eta-expand at this type+     -- all patterns need to be proper and non-overlapping+     -- at least one constructor needs to be eta-expandable+     let isPatIndFam = all (\ ci -> fst (cPatFam ci) /= NotPatterns && cEtaExp ci) cis+--                    && not (or overlapList)+     -- do not eta-expand recursive constructors (might not terminate)+     let disableRec ci {-ov-} rec' = ci+          { cRec    = rec'+          , cEtaExp =  cEtaExp ci               -- all destructors present+           && fst (cPatFam ci) /= NotPatterns -- proper pattern to compute indices+--           && not ov                          -- non-overlapping+           && not (co==Ind && rec') }         -- non-recursive+     let cis' = zipWith disableRec cis {-overlapList-} isRecList+     let typeEtaExpandable = isPatIndFam && (null cis || any cEtaExp cis')+     traceEtaM $ "data " ++ show n ++ " eta-expandable " ++ show typeEtaExpandable ++ " constructors " ++ show cis'+     modifySig n (\ dataSig ->+                      dataSig { symbolKind = newki+                              , etaExpand = typeEtaExpandable+                              , constructors = cis'+                              , isTuple = length cis' >= 1 && isPatIndFam+                              })+     -- compute extracted data decl+     let (tele, te) = typeToTele' (size tel) dte+     return $ (DataDecl n sz co pos tele te (map valueOf kcse) fields) : concat declse++   ) -- `throwTrace` n  -- in case of an error, add name n to the trace+++insertConstructorTele :: Telescope -> Type -> Constructor -> TypeCheck Constructor+insertConstructorTele dtel dt c@(Constructor n Nothing t) = return c+insertConstructorTele dtel dt c@(Constructor n Just{}  t) = do+  res <- computeConstructorTele dtel dt t+  return $ Constructor n (Just res) t++-- | @computeConstructorTele dtel t = return ctel@+--   Computes the constructor telescope from the target.+computeConstructorTele :: Telescope -> Type -> Type -> TypeCheck (Telescope, [Pattern])+computeConstructorTele dtel dt t = do+  -- target is data name applied to parameters and indices+  let (_, target) = typeToTele t+      (_, es)     = spineView target+      pars = take (size dtel) es+  (cxt, ps) <- checkConstructorParams pars  =<< whnf' (teleToType dtel dt)+  (,ps) . setDec (Dec Param) <$> do local (const cxt) $ contextToTele cxt++-- | @checkConstructorParams pars tv = return cxt@+--   Checks that parameters @pars@ are patterns elimating the datatype @tv@.+--   Returns a context @cxt@ that binds the pattern variables in+--   left-to-right order.+checkConstructorParams :: [Expr] -> TVal -> TypeCheck (TCContext, [Pattern])+checkConstructorParams es tv = do+  -- for now, we only allow patterns in parameters+  -- could be extended to unifyable expressions in general+  ps <- mapM (\ e -> maybe (errorParamNotPattern e) return $ exprToPattern e) es+  -- no goals from dot patterns, no absurd pattern+  ([],_,cxt,_,_,_,False) <- checkPatterns defaultDec [] emptySub tv ps+  return (cxt, ps)++  where+    errorParamNotPattern e = fail $+      "expected parameter to be a pattern, but I found " ++ show es++-- |+--   Precondition: @ce@ is included in the current context.+contextToTele :: TCContext -> TypeCheck Telescope+contextToTele ce = do+  let n     :: Int+      n     = len (context ce)           -- context length+      delta :: Map Int (OneOrTwo Domain)+      delta = cxt (context ce)           -- types for dB levels+      names :: Map Int Name+      names = naming ce                  -- names for dB levels+  -- traverse the context from left to right+  Telescope <$> do+    forM [0..n-1] $ \ k -> do+      x       <- lookupM k names+      One dom <- lookupM k delta+      TBind x <$> Traversable.traverse toExpr dom++-- | @typeCheckConstructor d dt sz co pols tel (TypeSig c t)@+--+--   returns True if constructor has recursive argument+typeCheckConstructor :: Name -> Type -> Sized -> Co -> [Pol] -> Telescope -> Constructor -> TypeCheck (Bool, Kinded EConstructor)+typeCheckConstructor d dt sz co pos dtel (Constructor n mctel t) = enter ("constructor " ++ show n) $ do+  let tel = maybe dtel fst mctel+{-+  tel <- case cpars of+    -- old style data parameters+    Nothing -> return dtel+    -- new style pattern parameters+    Just{}  -> computeConstructorTele dtel dt t+-}+  sig <- gets signature+  let telE = setDec irrelevantDec tel -- need kinded tel!!+    -- parameters are erased in types of constructors+  let tt = teleToType telE t+  echoTySig n tt+  let params = size tel+  -- when checking constructor types,  do NOT resurrect telescope+  --   data T [A : Set] : Set { inn : A -> T A }+  -- should be rejected, since A ~= T A, and T A = T B means A ~=B for arb. A, B!+  -- add data name as spos var, to check positivity+  -- and as NoKind, to compute the true kind from the constructors+  let telWithD = Telescope $ (TBind d $ Domain dt NoKind $ Dec SPos) : telescope tel+  Kinded ki te <- addBinds telWithD $+    checkConType sz t -- do NOT resurrect telescope!!++  -- Check target of constructor.+  dv <- whnf' dt+  let (Telescope argts,target) = typeToTele te+  whenNothing mctel $ -- only for old-style parameters+    addBinds telWithD $ addBinds (Telescope argts) $ checkTarget d dv tel target++  -- Make type of a constructor a singleton type.+  let mkName i n | emptyName n = fresh $ "y" ++ show i+                 | otherwise   = n+      fields = map boundName argts+      argns  = zipWith mkName [0..] $ fields+      argtbs = zipWith (\ n tb -> tb { boundName = n }) argns argts+--      core   = (foldl App (con (coToConK co) n) $ map Var argns)+      core   = Record (NamedRec (coToConK co) n False notDotted) $ zip fields $ map Var argns+      tsing  = teleToType (Telescope argtbs) $ Sing core target++  let tte = teleToType telE tsing -- te -- DO resurrect here!+  vt <- whnf' tte++  -- Now, compute the remaining information concerning the constructor.++  {- old code was more accurate, since it evaluated before checking+     for recursive occurrence.+  recOccs <- sposConstructor d 0 pos vt -- get recursive occurrences+  -}+  mutualNames <- asks mutualNames+  let mutOcc tb = not $ null $ List.intersect (d:mutualNames) $ usedDefs $ boundType tb+      recOccs   = map mutOcc argts+      isRec     = or recOccs+  -- fType <- extractType vt -- moved to Extract+  let fType = undefinedFType n+  isSz <- if sz /= Sized then return Nothing else do+    szConstructor d co params vt -- check correct use of sizes+    if co == CoInd then return $ Just $ error "impossible lhs type of coconstructor" else do+    let (x, lte) = mapSnd (teleToType telE) $ mkConLType params te+    echoKindedTySig kTerm n lte+    ltv <- whnf' lte+    return $ Just (x, ltv)++  -- Add the type constructor to the signature.+  let cpars = fmap (mapFst (map boundName . telescope)) mctel -- deletes types, keeps names+  addSigQ n (ConSig cpars isSz recOccs vt d (size dtel) fType)+--  let (tele, te) = typeToTele (length tel) tte -- NOT NECESSARY+  echoKindedTySig kTerm n tte+  -- traceM ("kind of " ++ n ++ "'s args: " ++ show ki)+--  echoTySigE n tte+  return (isRec, Kinded ki $ Constructor n (fmap (mapFst (const telE)) mctel) te)++typeCheckMeasuredFuns :: Co -> [Fun] -> TypeCheck [EFun]+typeCheckMeasuredFuns co funs0 = do+    -- echo $ show funs+    kfse <- mapM typeCheckFunSig funs0 -- NO LONGER erases measure+    -- use erased type signatures with retaines measure+    let funs = zipWith (\ (Kinded ki ts) f -> f { funTypeSig = ts }) kfse funs0++    -- type check and solve size constraints+    -- return clauses with meta vars resolved+    kcle <- installFuns co (zipWith Kinded (map kindOf kfse) funs) $+      mapM typeCheckFunClauses funs+    let kis  = map kindOf kcle+    let clse = map valueOf kcle+{-+    -- replace old clauses by new ones in funs+    let funs' = zipWith (\(tysig,(ar,cls)) cls' -> (tysig,(ar,cls'))) funs clss+-}+    -- get the list of mutually defined function names+    let funse = List.zipWith4 Fun+                  (map (fmap eraseMeasure . valueOf) kfse)+                  (map funExtName funs)+                  (map funArity funs)+                  clse+    -- print reconstructed clauses+    mapM_ (\ (Fun (TypeSig n t) n' ar cls) -> do+        -- echoR $ n ++ " : " ++ show t+        echoR $ (PP.render $ prettyFun n cls))+      funse+    -- replace in signature by erased clauses+    zipWithM (enableSig co) (zipWith intersectKind kis $ map kindOf kfse) funse+    return $ funse++  where+    enableSig :: Co -> Kind -> Fun -> TypeCheck ()+    enableSig co ki (Fun (TypeSig n t) n' ar' cl') = do+      vt <- whnf' t+      addSig n (FunSig co vt ki ar' cl' True $ undefinedFType $ QName n)+      -- add a let binding for external use+      v <- up False (vFun n) vt+      addSig n' (LetSig vt ki v $ undefinedFType $ QName n')++++-- type check the body of one function in a mutual block+-- type signature is already checked and added to local context+typeCheckFunBody :: Co -> Kind -> Fun -> TypeCheck EFun+typeCheckFunBody co ki0 fun@(Fun ts@(TypeSig n t) n' ar cls0) = do+    -- echo $ show fun+    addFunSig co $ Kinded ki0 fun+    -- type check and solve size constraints+    -- return clauses with meta vars resolved+    Kinded ki clse <- setCo co $ typeCheckFunClauses fun++    -- check new clauses for admissibility, inserting "unusuable" flags in the patterns where necessary+    -- TODO: proper cleanup, proper removal of admissibility check!+    -- clse <- admCheckFunSig co names ts clse++    -- print reconstructed clauses+    -- echoR $ n ++ " : " ++ show t+    echoR $ (PP.render $ prettyFun n clse)+    -- replace in signature by erased clauses+    let fune = Fun ts n' ar clse+    enableSig ki fune+    return fune+++typeCheckFuns :: Co -> [Fun] -> TypeCheck [EFun]+typeCheckFuns co funs0 = do+    -- echo $ show funs+    kfse <- mapM typeCheckFunSig funs0+    let kfuns = zipWith (\ (Kinded ki ts) (Fun ts0 n' ar cls) -> Kinded ki (Fun ts n' ar cls)) kfse funs0+    -- zipWithM (addFunSig co) (map kindOf kfse) funs+    mapM (addFunSig co) kfuns+    let funs = map valueOf kfuns+    -- type check and solve size constraints+    -- return clauses with meta vars resolved+    kce <- setCo co $ mapM typeCheckFunClauses funs+    let kis = map kindOf kce+    let clse = map valueOf kce+    -- get the list of mutually defined function names+    let names   = map (\ (Fun (TypeSig n t) n' ar cls) -> n) funs+    -- check new clauses for admissibility, inserting "unusuable" flags in the patterns where necessary+    -- TODO: proper cleanup, proper removal of admissibility check!+    clse <- zipWithM (\ (Fun tysig _ _ _) cls' -> admCheckFunSig co names tysig cls') funs clse+    -- replace old clauses by new ones in funs+    let funse = List.zipWith4 Fun+                  (map valueOf kfse)+                  (map funExtName funs)+                  (map funArity funs)+                  clse+--    let funse = zipWith (\(tysig,(ar,cls)) cls' -> (tysig,(ar,cls'))) funs clse+    -- print reconstructed clauses+    mapM_ (\ (Fun (TypeSig n t) n' ar cls) -> do+        -- echoR $ n ++ " : " ++ show t+        echoR $ (PP.render $ prettyFun n cls))+      funse+    terminationCheck funse+    -- replace in signature by erased clauses+    zipWithM enableSig kis funse+    return $ funse++addFunSig :: Co -> Kinded Fun -> TypeCheck ()+addFunSig co (Kinded ki (Fun (TypeSig n t) n' ar cl)) = do+    sig <- gets signature+    vt <- whnf' t -- TODO: PROBLEM for internal extraction (would need te here)+    addSig n (FunSig co vt ki ar cl False $ undefinedFType $ QName n) --not yet type checked / termination checked++-- ADMCHECK FOR COFUN is not taking place in checking the lhs+-- TODO: proper analysis for size patterns!+-- admCheckFunSig mutualNames (TypeSig thisName thisType, clauses)+admCheckFunSig :: Co -> [Name] -> TypeSig -> [Clause] -> TypeCheck [Clause]+admCheckFunSig CoInd  mutualNames (TypeSig n t) cls = return cls+admCheckFunSig co@Ind mutualNames (TypeSig n t) cls = traceAdm ("admCheckFunSig: checking admissibility of " ++ show n ++ " : " ++ show t) $+   (+    do -- a function is not recursive if did does not mention any of the+       -- mutually defined function names+       let usedNames = rhsDefs cls+       let notRecursive = all (\ n -> not (n `elem` usedNames)) mutualNames+       -- for non-recursive functions, we can skip the admissibility check+       if notRecursive then+          -- trace ("function " ++ n ++ " is not recursive") $+            return cls+        else -- trace ("function " ++ n ++ " is recursive ") $+          do vt <- whnf' t+             admFunDef co cls vt+    ) `throwTrace` ("checking type of " ++ show n ++ " for admissibility")+++enableSig :: Kind -> Fun -> TypeCheck ()+enableSig ki (Fun (TypeSig n _) n' ar' cl') = do+  (FunSig co vt ki0 ar cl _ ftyp) <- lookupSymb n+  addSig n (FunSig co vt (intersectKind ki ki0) ar cl' True ftyp)+  -- add a let binding for external use+  v <- up False (vFun n) vt+  addSig n' (LetSig vt ki v ftyp)+++-- typeCheckFunSig (TypeSig thisName thisType, clauses)+typeCheckFunSig :: Fun -> TypeCheck (Kinded ETypeSig)+typeCheckFunSig (Fun (TypeSig n t) n' ar cls) = enter ("type of " ++ show n) $ do+  echoTySig n t+  Kinded ki0 te <- checkType t+  -- let te = eraseMeasure te0+  let ki = predKind ki0+  echoKindedTySig ki n (eraseMeasure te)+--  echoTySigE n te+  return $ Kinded ki $ TypeSig n te++typeCheckFunClauses :: Fun -> TypeCheck (Kinded [EClause])+typeCheckFunClauses (Fun (TypeSig n t) n' ar cl) = enter (show n) $+   do result@(Kinded _ cle) <- checkFun t cl+      -- traceCheck (show (TypeSig n t)) $+       -- traceCheck (show cl') $+      -- echo $ PP.render $ prettyFun n cle+      return result++-- checkConType sz t = Kinded ki te+-- the returned kind is the kind of the constructor arguments+-- check that result is a universe+--  ( params were already checked by checkDataType and are not included in t )+-- called initially in the context consisting of the parameter telescope+checkConType :: Sized -> Expr -> TypeCheck (Kinded Extr)+checkConType NotSized t = checkConType' t+checkConType Sized t =+    case t of+      Quant Pi tb@(TBind _ (Domain t1 _ _)) t2 | isSize t1 -> do+             addBind (mapDec (const paramDec) tb) $ do  -- size is parametric in constructor type+               Kinded ki t2e <- checkConType' t2+               return $ Kinded ki $ Quant Pi (mapDec (const irrelevantDec) tb) t2e -- size is irrelevant in constructor+      _ -> fail $ "checkConType: expecting size quantification, found " ++ show t++checkConType' :: Expr -> TypeCheck (Kinded Extr)+checkConType' t = do+  (s, kte) <- checkingCon True $ inferType t+  case s of+    Set{} -> return kte+    CoSet{} -> return kte+    _ -> fail $ "checkConType: type " ++ show t ++ " of constructor not a universe"++-- check that the data type and the parameter arguments (written down like declared in telescope)+-- precondition: target tg type checks in current context+checkTarget :: Name -> TVal -> Telescope -> Type -> TypeCheck ()+checkTarget d dv tel tg = do+  tv <- whnf' tg+  case tv of+    VApp (VDef (DefId DatK (QName n))) vs | n == d -> do+      telvs <- mapM (\ tb -> whnf' (Var (boundName tb))) $ telescope tel+      enter ("checking datatype parameters in constructor target") $+        leqVals' N mixed (One dv) (take (size tel) vs) telvs+      return ()+    _ -> fail $ "constructor should produce something in data type " ++ show d++{- RETIRED (syntactic check)+checkTarget :: Name -> Telescope -> Type -> TypeCheck ()+checkTarget d tel tg =+    case spineView tg of+      (Def (DefId Dat n), args) | n == d -> checkParams tel (take (length tel) args)+      _ -> throwErrorMsg $ "target mismatch"  ++ show tg++    where checkParams :: Telescope -> [Expr] -> TypeCheck ()+          checkParams [] [] = return ()+          checkParams (tb : tl) ((Var n') : el) | boundName tb == n'+            = checkParams tl el+          checkParams tl al = throwErrorMsg $ "target param mismatch " +++            d ++ " " ++ show tel ++ " != " ++ show tg ++ "\ncheckParams " ++ show tl ++ " " ++ show al ++ " failed"+-}++-- check that params are types+-- check that arguments are stypes+-- check that target is set+checkDataType :: Int -> Expr -> TypeCheck (Kinded (Sort Expr, Extr))+checkDataType p e = do+  traceCheckM ("checkDataType " ++ show e ++ " p=" ++ show p)+  case e of+     Quant Pi tb@(TBind x (Domain t1 _ dec)) t2 -> do+       k <- getLen+       traceCheckM ("length of context = " ++ show k)+       -- t1e <- checkingDom $ if k <= p then checkType t1 else checkSmallType t1+       (s1, Kinded ki0 t1e) <- checkingDom $ inferType t1+       let ki1 = predKind ki0+       addBind (TBind x (Domain t1 ki1 defaultDec)) $ do+         Kinded ki2 (s, t2e) <- checkDataType p t2+         -- when k <= p $ ltSort s1 s -- check size of indices (disabled)+         return $ Kinded ki2 (s, Quant Pi (TBind x (Domain t1e ki1 dec)) t2e)+     Sort s@(Set e1)   -> do+       (_, e1e) <- checkLevel e1+       return $ Kinded (kUniv e1e) (s, Sort $ Set e1e)+     Sort s@(CoSet e1) -> do+       e1e <- checkSize e1+       return $ Kinded (kUniv Zero) (s, Sort $ CoSet e1e)+     _ -> throwErrorMsg "doesn't target Set or CoSet"++{-+checkSize :: Expr -> TypeCheck Extr+checkSize Infty = return Infty+checkSize e = valueOf <$> checkExpr e vSize+-}++checkSize :: Expr -> TypeCheck Extr+checkSize e =+  case e of+    Meta i  -> do+      ren <- asks renaming+      addMeta ren i+      return e+    e       -> inferSize e++inferSize :: Expr -> TypeCheck Extr+inferSize e =+  case e of+    Zero  -> return e+    Infty -> return e+    Succ e  -> Succ <$> checkSize e+    Plus es -> Plus <$> mapM checkSize es+    Max  es -> maxE <$> mapM checkSize es+    e -> do+      (v, Kinded ki e) <- inferExpr e+      subtype v vSize+      return e++checkBelow :: Expr -> LtLe -> Val -> TypeCheck Extr+checkBelow e Le VInfty = checkSize e+checkBelow e ltle v = do+  e' <- checkSize e+  v' <- whnf' e+  leSize ltle Pos v' v+  return e'+++-- checkLevel e = (value of e, ee)+-- if e : Size and value of e != Infty+checkLevel :: Expr -> TypeCheck (Val, Extr)+checkLevel e = do+  Kinded _ ee <- checkExpr e vSize+  v  <- whnf' e+  when (v == VInfty) $ recoverFail $ "# is not a valid universe level"+  return (v, ee)++{- Kind inference++          i    : Size              : Type+      t : Nat  : Set  : Set1 : ... : Type = Set\omega+  p : P : Prop : Set  : ...++Functional, cumulative PTS (s,s',s') written (s,s')++  (Size,s)   s != Size    size-dependency+  (s,Prop)                impredicative Prop+  (Set_i,Set_j)  i <= j   predicativity++Kind    can be used to construct Kinds+term t  terms, types, universes, proofs, propositions+type T  types, universes, propositions+size i  types, universes, propositions+prf  p  proofs+pred P  types, universes, propositions++We like to infer kinds of expressions++  Tm < Set < Set1 < Set2 < ...++For  t : A  if kind(A) = Tm then t is a term,+                       = Set then t is a type,+                       = Set1 then t is a type1 (e.g, a universe) ...++Then,  if  t : (x : A) -> B+      and  kind(A) `irrelevantFor` kind(B)   [ with irrelevantFor := > ]++we can change the type signature to++           t : [x : A] -> B++This is because you cannot eliminate a type to produce a term.++  kind(Set)  = Set+  kind(Size) = Size -- this means that we treat sizes as types, they cannot+  kind(s)    = s    -- if s is a sort+  kind((x : A) -> B) = kind(B)+  kind(A : Set0) = Tm+  kind(A : Prop) = Prf+  kind(A : Size) = <<impossible>>+  kind(A : Setk) = k-1++irrFor Tm  _    = False+irrFor Ty Tm    = True+irrFor Ty Prf   = True+irrFor Ty _     = False+irrFor Size Tm  = True+irrFor Size Prf = True++One problem is that we cannot infer exact kinds, e.g.++  fun T : Bool -> Set 1 -- T is a type+  { T true  = Bool      -- T true is a type+  ; T false = Set 0     -- T false is a universe+  }++T is either a type or a universe.  So we can only assign intervals.+This is like in Augustsson's Cayenne [not in his paper, though].++A datatype is always a type.  A size is a type.+A constructor is always a term.++-}+++-- type checking++-- checkExpr e tv = (e', ki)+-- e' is the version of e with erasure marker at irrelevant positions+-- ki is the kind of e (Tm, Ty, Set ...)+-- ki is at most the predecessor of the sort of tv+--+-- this is *internal* extraction in the style of Barras and Bernardo+-- e.g., does not prune t : Id A a b+-- thus, we can use the pruned version for evaluation!+checkExpr :: Expr -> TVal -> TypeCheck (Kinded Extr)+checkExpr e v = do+  l <- getLen+  enterDoc (text ("checkExpr " ++ show l ++ " |-") <+> prettyTCM e <+> colon <+> prettyTCM v) $ do++   ce <- ask+   traceCheck ("checkExpr: " ++ show (renaming ce) ++ ";" ++ show (context ce) ++ " |- " ++ show e ++ " : " ++ show v ++ " in env" ++ show (environ ce)) $ do++    (case (e, v) of++{- In the presence of full bracket types,+   we could implement the following "resurrecting version of let"++   Gamma |- s : [A]+   Gamma, x:A |- t : C   Gamma, x:A, y:A |- t = t[y/x] : C+   -------------------------------------------------------+   Gamma |- let x:[A] = s in t : C++ -}++      (App (Lam dec x f) e, v) | inferable e -> checkLet dec x emptyTel Nothing e f v++{-+      (LLet (TBind x (Domain Nothing _ dec)) e1 e2, v) -> checkUntypedLet x dec e1 e2 v+      (LLet (TBind x (Domain (Just t1) _ dec)) e1 e2, v) -> checkTypedLet x t1 dec e1 e2 v+-}+      (LLet (TBind x (Domain mt _ dec)) tel e1 e2, v) -> checkLet dec x tel mt e1 e2 v++      (Case (Var x) Nothing [Clause _ [SuccP (VarP y)] (Just rhs)], v) -> do+          (tv, _) <- resurrect $ inferExpr (Var x)+          subtype tv vSize+          vx@(VGen i) <- whnf' (Var x)+          endsInSizedCo i v+          let dom = Domain vSize kSize defaultDec+          newWithGen y dom $ \ j vy -> do+            let vp = VSucc vy+            addSizeRel j 1 i $+              addRewrite (Rewrite vx vp) [v] $ \ [v'] -> do+                Kinded ki2 rhse <- checkRHS emptySub rhs v'+                return $ Kinded ki2 $ Case (Var x) (Just tSize) [Clause [TBind y dom] [SuccP (VarP y)] (Just rhse)]+++      (Case e mt cs, v) -> do+          (tv, t, Kinded ki1 ee) <- checkOrInfer neutralDec e mt+          ve <- whnf' ee+          -- tv' <- sing' ee tv -- DOES NOT WORK+          Kinded ki2 cle <- checkCases ve (arrow tv v) cs+          return $ Kinded ki2 $ Case ee (Just t) cle+{-+      (Case e Nothing cs, _) -> do+          (tv, Kinded ki1 ee) <- inferExpr e+          ve <- whnf' ee+          -- tv' <- sing' ee tv -- DOES NOT WORK+          Kinded ki2 cle <- checkCases ve (arrow tv v) cs+          t <- toExpr tv+          return $ Kinded ki2 $ Case ee (Just t) cle+-}+      (_, VGuard beta bv) ->+        addBoundHyp beta $ checkExpr e bv++      (e,v) | inferable e -> do+          (v2, Kinded ki1 ee) <- inferExpr e+          checkSubtype ee v2 v+          return $ Kinded ki1 ee++      _ -> checkForced e v++      ) -- >> (trace ("checkExpr successful: " ++ show e ++ ":" ++ show v) $ return ())++-- | checkLet @let .x tel : t = e1 in e2@+checkLet :: Dec -> Name -> Telescope -> Maybe Type -> Expr -> Expr -> TVal -> TypeCheck (Kinded Extr)+checkLet dec x tel mt1 e1 e2 v = do+  (v_t1, t1e, Kinded ki1 e1e) <- checkLetDef dec tel mt1 e1+--  (v_t1, t1e, Kinded ki1 e1e) <- checkOrInfer dec e1 mt1+  checkLetBody x t1e v_t1 ki1 dec e1e e2 v++-- | checkLetDef @.x tel : t = e@ becomes @.x : tel -> t = \ tel -> e@+checkLetDef :: Dec -> Telescope -> Maybe Type -> Expr -> TypeCheck (TVal, EType, Kinded Extr)+checkLetDef dec tel mt e = local (\ cxt -> cxt {consistencyCheck = True}) $ do+  -- 2013-04-01+  -- since a let telescope is treated like a lambda abstraction+  -- and the let-defined symbol reduces by itself, we need to+  -- do the context consistency check at each introduction.+  (tel, (vt, te, Kinded ki ee)) <- checkTele tel $ checkOrInfer dec e mt+  te <- return $ teleToType tel te+  ee <- return $ teleLam tel ee+  vt <- whnf' te+  return (vt, te, Kinded ki ee)++{-+checkTypedLet :: Name -> Type -> Dec -> Expr -> Expr -> TVal -> TypeCheck (Kinded Extr)+checkTypedLet x t1 dec e1 e2 v = do+  Kinded kit t1e <- checkType t1+  v_t1 <- whnf' t1+  Kinded ki0 e1e <- applyDec dec $ checkExpr e1 v_t1+  let ki1 = intersectKind ki0 (predKind kit)+  checkLetBody x t1e v_t1 ki1 dec e1e e2 v+{-+  v_e1 <- whnf' e1+  new x (Domain v_t1 ki1 dec) $ \ vx -> do+    addRewrite (Rewrite vx v_e1) [v] $ \ [v'] -> do+      Kinded ki2 e2e <- checkExpr e2 v'+      return $ Kinded ki2 $ LLet (TBind x (Domain t1e ki1 dec)) e1e e2e  -- if e2e==Irr then Irr else LLet n t1e e1e e2e+-}++checkUntypedLet :: Name -> Dec -> Expr -> Expr -> TVal -> TypeCheck (Kinded Extr)+checkUntypedLet x dec e1 e2 v = do+  (v_t1, Kinded ki1 e1e) <- applyDec dec $ inferExpr e1+  v_e1 <- whnf' e1+  t1e <- toExpr v_t1+  checkLetBody x t1e v_t1 ki1 dec e1e e2 v+-}++checkLetBody :: Name -> EType -> TVal -> Kind -> Dec -> Extr -> Expr -> TVal -> TypeCheck (Kinded Extr)+checkLetBody x t1e v_t1 ki1 dec e1e e2 v = do+  v_e1 <- whnf' e1e+  new x (Domain v_t1 ki1 dec) $ \ vx -> do+    addRewrite (Rewrite vx v_e1) [v] $ \ [v'] -> do+      Kinded ki2 e2e <- checkExpr e2 v'+      return $ Kinded ki2 $ LLet (TBind x (Domain (Just t1e) ki1 dec)) emptyTel e1e e2e+{-+-- Dependent let: not checkable in rho;Delta style+--            v_e1 <- whnf rho e1+--            checkExpr (update rho n v_e1) (v_t1 : delta) e2 v+-}++-- | @checkPair e1 e2 y dom env b@ checks @Pair e1 e2@ against+--   @VQuant Sigma y dom env b@.+checkPair :: Expr -> Expr -> Name -> Domain -> FVal -> TypeCheck (Kinded Expr)+checkPair e1 e2 y dom@(Domain av ki dec) fv = do+  case av of+    VBelow Lt VInfty -> do+      lowerSemi <- underAbs y dom fv $ \ i _ bv -> lowerSemiCont i bv+      continue $ if lowerSemi then VBelow Le VInfty else av+    _ -> continue av+  where+    continue av = do+      Kinded k1 e1 <- applyDec dec $ checkExpr e1 av+      v1 <- whnf' e1+      bv <- app fv v1+      Kinded k2 e2 <- checkExpr e2 bv+      return $ Kinded (unionKind k1 k2) $ Pair (maybeErase dec e1) e2++-- check expression after forcing the type+checkForced :: Expr -> TVal -> TypeCheck (Kinded Expr)+checkForced e v = do+  ren <- asks renaming+  v   <- force v+--  enter ("checkForced " ++ show ren ++ " |- " ++ show e ++ " : " ++ show v) $ do+  enterDoc (text ("checkForced " ++ show ren ++ " |-") <+> prettyTCM e <+> colon <+> prettyTCM v) $ do+    case (e,v) of+{-+      (_, VGuard (Bound (Measure [VGen i]) (Measure [VGen j])) bv) ->+        addSizeRel i j $ checkForced e bv+-}+      (_, VGuard beta bv) ->+        addBoundHyp beta $ checkForced e bv++      (Pair e1 e2, VQuant Sigma y dom@(Domain av ki dec) fv) ->+        checkPair e1 e2 y dom fv++      (Record ri rs, t@(VApp (VDef (DefId DatK d)) vl)) -> do+         let fail1 = failDoc (text "expected" <+> prettyTCM t <+> text "to be a record type")+--         DataSig { numPars, isTuple } <- lookupSymb d+--         unless isTuple $ fail1+         mfs <- getFieldsAtType d vl+         case mfs of+           Nothing -> fail1+           Just ptv -> do+             let checkField :: (Name, Expr) -> TypeCheck (Kinded [(Name,Expr)]) -> TypeCheck (Kinded [(Name,Expr)])+                 checkField (p,e) cont =+                  case lookup p ptv of+                    Nothing -> failDoc (prettyTCM p <+> text "is not a field of record" <+> prettyTCM t)+                    Just tv -> do+                      tv <- piApp tv VIrr -- remove record argument (cannot be dependent!)+                      Kinded k e <- checkExpr e tv+                      Kinded k' es <- cont+                      return $ Kinded (unionKind k k') ((p,e) : es)+             Kinded k rs <- foldr checkField (return $ Kinded NoKind []) rs+             return $ Kinded k $ Record ri rs+++{- OLD:+Following Awodey/Bauer 2001, the following rule is valid++   Gamma, x:A |- t : B    Gamma, x:A, y:A |- t = t[y/x] : B+   --------------------------------------------------------+   Gamma |- \xt : Pi x:[A]. B++      (Lam _ y e1, VPi dec x va env t1) -> do+          rho <- getEnv  -- get the environment corresponding to Gamma+          new y (Domain va (resurrectDec dec)) $ \ vy -> do+            v_t1 <- whnf (update env x vy) t1+            -- traceCheckM $ "checking " ++ show e1 ++ " : " ++ show v_t1+            e1e <- checkExpr e1 v_t1+            when (erased dec) $ do  -- now check invariance of the e1+              new y (Domain va (resurrectDec dec)) $ \ vy' -> do+                ve  <- whnf (update rho y vy)  e1e+                ve' <- whnf (update rho y vy') e1e+                eqVal v_t1 ve ve'  -- BUT: ve' does not have type v_t1 !?+            -- prune the lambda if body has been pruned+            return $ if e1e==Irr then Irr else Lam y e1e+ -}++-- NOW just my rule (LICS 2010 draft) a la Barras/Bernardo++      (Lam _ y e1, VQuant Pi x dom fv) -> do+          -- rho <- getEnv  -- get the environment corresponding to Gamma+          underAbs y dom fv $ \ _ vy bv -> do+            -- traceCheckM $ "checking " ++ show e1 ++ " : " ++ show v_t1+            Kinded ki1 e1e <- checkExpr e1 bv+            -- the kind of a lambda is the kind of its body+            return $ Kinded ki1 $ Lam (decor dom) y e1e++      -- lone projection: eta-expand!+      (Proj Pre p, VQuant Pi x dom fv) -> do+         let y = nonEmptyName x "y"+         checkForced (Lam (decor dom) y $ App e (Var y)) v+{-+      -- should be subsumed by checkBelow:+      (e, v) | isVSize v -> Kinded kSize <$> checkSize e+-}+{-  MOVED to checkSize++      -- metavariables must have type size+      (Meta i, _) | isVSize v -> do+        addMeta ren i+        return $ Kinded kSize $ Meta i++     (Infty, v) | isVSize v -> return $ Kinded kSize $ Infty+      (Zero, v) | isVSize v -> return $ Kinded kSize $ Zero++      (Plus es, v) | isVSize v -> do+              ese <- mapM checkSize es+              return $ Kinded kSize $ Plus ese++      (Max es, v) | isVSize v -> do+              ese <- mapM checkSize es+              return $ Kinded kSize $ Max ese++      (Succ e2, v) | isVSize v -> do+              e2e <- checkSize e2+              return $ Kinded kSize $ Succ e2e+-}++      (e, VBelow ltle v) -> Kinded kSize <$> checkBelow e ltle v+{-+              -- prune sizes+              return $ if e2e==Irr then Irr else Succ e2e+-}+      (e,v) -> do+        case spineView e of++          -- unfold defined patterns+          (h@(Def (DefId (ConK DefPat) c)), es) -> do+             PatSig xs pat _ <- lookupSymbQ c+             let (xs1, xs2) = splitAt (length es) xs+                 phi x      = maybe (Var x) id $ lookup x (zip xs1 es)+                 body       = parSubst phi (patternToExpr pat)+                 e          = foldr (Lam defaultDec) body xs2+             checkForced e v++          -- check constructor term+          (h@(Def (DefId (ConK co) c)), es) -> checkConTerm co c es v+{-+          (h@(Def (DefId (ConK co) c)), es) -> do+             tv <- conType c v+             (knes, dv) <- checkSpine es tv+             let e = foldl App h $ map (snd . valueOf) knes+             checkSubtype e dv v+             e <- etaExpandPis e dv -- a bit similiar to checkSubtype, which computes a singleton+             return $ Kinded kTerm $ e+-}+          -- else infer+          _ -> do+            (v2,kee) <- inferExpr e+            checkSubtype (valueOf kee) v2 v+            return kee++-- | Check (partially applied) constructor term, eta-expand it and turn it+--   into a named record.+checkConTerm :: ConK -> QName -> [Expr] -> TVal -> TypeCheck (Kinded Extr)+checkConTerm co c es v = do+  case v of+    VQuant Pi x dom fv -> do+      let y = freshen $ nonEmptyName x "y"+      underAbs y dom fv $ \ _ _ bv -> do+        Kinded ki ee <- checkConTerm co c (es ++ [Var y]) bv+        return $ Kinded ki $ Lam (decor dom) y ee+    _ -> do+      c <- disambigCon c v+      tv <- conType c v+      (knes, dv) <- checkSpine es tv+      let ee = Record (NamedRec co c False notDotted) $ map valueOf knes+      checkSubtype ee dv v+      return $ Kinded kTerm ee++{-+-- | Check (partially applied) constructor term, eta-expand it and turn it+--   into a named record.+checkConTerm :: ConK -> Name -> [Expr] -> TVal -> TypeCheck (Kinded Extr)+checkConTerm co c es v = do+  tv <- conType c v+  (knes, dv) <- checkSpine es tv+  let e0 = foldl App (Def (DefId (ConK co) c)) $ map (snd . valueOf) knes+  checkSubtype e0 dv v+  (vTel, _) <- telView dv+  let xs   = map (boundName . snd) vTel+      decs = map (decor . boundDom . snd) vTel+      ys   = map freshen xs+      rs   = map valueOf knes ++ (zip xs $ map Var ys)+      e1   = Record (NamedRec co c False) rs+      e    = foldr (uncurry Lam) e1 (zip decs ys)+  return $ Kinded kTerm e+-}++{-+-- | Only eta-expand at function types, do not force.+etaExpandPis :: Expr -> TVal -> TypeCheck Expr+etaExpandPis e tv = do+  case tv of+    VQuant Pi x dom env b -> new x dom $ \ xv -> do+      let y = freshen x+      Lam (decor dom) y <$> do+        etaExpandPis (App e (Var y)) =<< whnf (update env x xv) b+    _ -> return e+-}++checkSpine :: [Expr] -> TVal -> TypeCheck ([Kinded (Name, Extr)], TVal)+checkSpine [] tv = return ([], tv)+checkSpine (e : es) tv = do+  (kne, tv) <- checkApp e tv+  (knes, tv) <- checkSpine es tv+  return (kne : knes, tv)++maybeErase dec = if erased dec then erasedExpr else id++-- | checking e against (x : A) -> B returns (x,e) and B[e/x]+checkApp :: Expr -> TVal -> TypeCheck (Kinded (Name, Extr), TVal)+checkApp e2 v = do+  v <- force v -- if v is a corecursively defined type in Set, unfold!+  enter ("checkApp " ++ show v ++ " eliminated by " ++ show e2) $ do+  case v of+    VQuant Pi x dom@(Domain av@(VBelow Lt VInfty) _ dec) fv -> do+      upperSemi <- underAbs x dom fv $ \ i _ bv -> upperSemiCont i bv+      continue $ if upperSemi then VQuant Pi x dom{ typ = VBelow Le VInfty} fv+                 else v+    _ -> continue v+ where+  continue v = case v of+    VQuant Pi x (Domain av _ dec) fv -> do+       (ki, v2, e2e) <- do+         if inferable e2 then do+       -- if e2 has a singleton type, we should not take v2 = whnf e2+       -- but use the single value of e2+       -- this is against the spirit of bidir. checking+              -- if checking a type we need to resurrect+              (av', Kinded ki e2e) <- applyDec dec $ inferExpr e2+              case av' of+                 VSing v2 av'' -> do subtype av' av+                                     return (ki, v2, e2e)+                 _ -> do checkSubtype e2e av' av+                         v2 <- whnf' e2e+                         return (ki, v2, e2e)+            else do+              Kinded ki e2e <- applyDec dec $ checkExpr e2 av+              v2 <- whnf' e2e+              return (ki, v2, e2e)+       bv <- app fv v2+       -- the kind of the application is the kind of its head+       return (Kinded ki $ (x,) $ maybeErase dec e2e, bv)+       -- if e1e==Irr then Irr else if e2e==Irr then e1e else App e1e [e2e])+    _ -> throwErrorMsg $ "checking application to " ++ show e2 ++ ": expected function type, found " ++ show v+++-- checkSubtype  expr : infered_type <= ascribed_type+checkSubtype :: Expr -> TVal -> TVal -> TypeCheck ()+checkSubtype e v2 v = do+    rho <- getEnv+    traceSingM $ "computing singleton <" ++ show e ++ " : " ++ show v2 ++ ">" -- ++ " in environment " ++ show rho+    v2principal <- sing rho e v2+    traceSingM $ "subtype checking " ++ show v2principal ++ " ?<= " ++ show v ++ " in environment " ++ show rho+    subtype v2principal v+++-- ptsRule s1 s2 = s  if (s1,s2,s) is a valid rule+-- precondition: s1,s2 are proper sorts, i.e., not Size or Tm+ptsRule :: Bool -> Sort Val -> Sort Val -> TypeCheck (Sort Val)+ptsRule er s1 s2 = do+  cxt <- ask+  let parametric = checkingConType cxt  -- are we dealing with a parametric pi?+  let err = "ptsRule " ++ show (s1,s2) ++ " " ++ (if parametric then "(in type of constructor)" else "") ++ ": "+  case (s1,s2) of+    (Set VInfty,_) -> fail $ err ++ "domain too big"+    (Set v1, Set v2) ->+      if parametric then do+         unless er $ leqSize Pos v1 v2 -- when we are checking a constructor, to reject+         {- data Bad : Set { bad : Set -> Bad } -}+         return s2+       else return $ Set $ maxSize [v1,v2]+    (CoSet v1, Set VZero)+       | parametric   -> return $ CoSet v1+       | v1 == VInfty -> return $ Set VZero+       | otherwise    -> fail $ err ++ "domain cannot be sized"+    (CoSet v1, CoSet v2)+       | parametric   -> do+           let v2' = maybe v2 id $ predSize v2+           case minSize v1 v2 of+             Just v  -> return $ CoSet v+             Nothing -> fail $ err ++ "min" ++ show (v1,v2) ++ " does not exist"+       | v1 == VInfty -> return $ CoSet $ succSize v2+       | otherwise    -> fail $ err ++ "domain cannot be sized"+    _ -> return s2++checkOrInfer :: Dec -> Expr -> Maybe Type -> TypeCheck (TVal, EType, Kinded Extr)+checkOrInfer dec e Nothing = do+  (tv, ke) <- applyDec dec $ inferExpr e+  te <- toExpr tv+  return (tv, te, ke)+checkOrInfer dec e (Just t) = do+  Kinded kt te <- checkType t+  tv <- whnf' te+  Kinded ke ee <- applyDec dec $ checkExpr e tv+  let ki = intersectKind ke $ predKind kt+  return $ (tv, te, Kinded ki ee)++-- inferType t = (s, te)+inferType :: Expr -> TypeCheck (Sort Val, Kinded Extr)+inferType t = do+  (sv, te) <- inferExpr t+  case sv of+    VSort s | not (s `elem` map SortC [Tm,Size]) -> return (s,te)+    _ -> fail $ "inferExpr: expected " ++ show t ++ " to be a type!"++-- inferExpr e = (tv, s, ee)+-- input : expr e | inferable e+-- output: type tv, kind s, and erased form ee of e+-- the kind tells whether e is a term, a size, a set, ...+inferExpr :: Expr -> TypeCheck (TVal, Kinded Extr)+inferExpr e = do+  (tv, ee) <- inferExpr' e+  case tv of+    VGuard beta vb -> do+      checkGuard beta+      return (vb, ee)+    _ -> return (tv, ee)++inferProj :: Expr -> PrePost -> Name -> TypeCheck (TVal, Kinded Extr)+inferProj e1 fx p = checkingCon False $ do+            (v, Kinded ki1 e1e) <- inferExpr e1+{-+            let fail1 = failDoc (text "expected" <+> prettyTCM e1 <+> text "to be of record type when taking the projection" <+> text p <> comma <+> text "but found type" <+> prettyTCM v)+            let fail2 = failDoc (text "record" <+> prettyTCM e1 <+> text "of type" <+> prettyTCM v <+> text "does not have field" <+> text p)+-}+            v <- force v -- if v is a corecursively defined type in Set, unfold!+            tv <- projectType v p =<< whnf' e1e+            return (tv, Kinded ki1 (proj e1e fx p))+{-+            case v of+              VApp (VDef (DefId Dat d)) vl -> do+                mfs <- getFieldsAtType d vl+                case mfs of+                  Nothing -> fail1+                  Just ptvs ->+                    case lookup p ptvs of+                      Nothing -> fail2+                      Just tv -> do+                        tv <- piApp tv VIrr -- cut of record arg+                        return (tv, Kinded ki1 (App e1e (Proj p)))+              _ -> fail1+-}+++-- inferExpr' might return a VGuard, this is removed in inferExpr+-- the returned kind for constructor type is computed as the union+-- of the kinds of the non-erased arguments+-- otherwise it is the kind of the target+inferExpr' :: Expr -> TypeCheck (TVal, Kinded Extr)+inferExpr' e = enter ("inferExpr' " ++ show e) $+  let returnSing (Kinded ki ee) tv = do+        tv' <- sing' ee tv+        return (tv', Kinded ki ee)+  in+    (case e of++      Var x -> do+        traceCheckM ("infer variable " ++ show x)+        item <- lookupName1 x+        traceCheckM ("infer variable: retrieved item ")+        let dom = domain item+            av  = typ dom+        traceCheckM ("infer variable: " ++ show av)+        enterDoc (text "inferExpr: variable" <+> prettyTCM x <+> colon <+> prettyTCM av <+> text "may not occur") $ do+          let dec  = decor dom+              udec = upperDec item+              pol  = polarity dec+              upol = polarity udec+          when (erased dec && not (erased udec)) $+            recoverFail ", because it is marked as erased"+          enter ", because of polarity" $+            leqPolM pol upol+        traceCheckM ("infer variable returns")+        traceCheckM ("infer variable " ++ show x ++ " : " ++ show av)+        return $ (av, Kinded (kind dom) $ Var x)+{-+        let err = "inferExpr: variable " ++ x ++ " : " ++ show (typ item) +++                  " may not occur"+        let dec = decor item+        let pol = polarity dec+        if erased dec then+          fail $ err ++ ", because it is marked as erased"+         else if not (leqPol pol SPos) then+          fail $ err ++ ", because it has polarity " ++ show pol+         else do+           -- traceCheckM ("infer variable " ++ x ++ " : " ++ show  (typ item))+           return $ (typ item, Var x) -- TODO: (typ item, kind item, Var x)+-}++      -- for constants, the kind coincides with the type!+      Sort (CoSet e) -> do+        ee <- checkSize e+        return (VSort (Set (VSucc VZero)), Kinded (kUniv Zero) $ Sort $ CoSet ee)+      Sort (Set e) ->  do+        (v, ee) <- checkLevel e+        return (VSort (Set (succSize v)), Kinded (kUniv ee) $ Sort $ Set ee)+      Sort (SortC Size) -> return (vTSize, Kinded kTSize $ e)+      Zero -> return (vSize, Kinded kSize Zero)+      Infty -> return (vSize, Kinded kSize Infty)+      Below ltle e -> do+        ee <- checkSize e+        return (vTSize, Kinded kTSize $ Below ltle ee)++      Quant pisig (TBind n (Domain t1 _ dec)) t2 -> do+        -- make sure that in a constructor declaration the constructor args are+        -- mixed-variant (there is no subtyping between constrs anyway)+        checkCon <- asks checkingConType+{- TODO+        when (checkCon && polarity dec /= Mixed) $+          fail $ "constructor arguments must be declared mixed-variant"+-}+        (s1, Kinded ki0 t1e) <- (if pisig==Pi then checkingDom else id) $+          checkingCon False $ inferType t1 -- switch off parametric Pi+        -- the kind of the bound variable is the precedessor of the kind of its type+        let ki1 = predKind ki0+        addBind (TBind n (Domain t1e ki1 $ defaultDec)) $ do -- ignore erasure flag AND polarity in Pi! (except for irrelevant, only becomes parametric)+        -- TODO:+        -- addBind (TBind n (Domain t1e ki1 $ coDomainDec dec)) $ do -- ignore erasure flag AND polarity in Pi! (except for irrelevant, only becomes parametric)+          (s2, Kinded ki2 t2e) <- inferType t2+          ce <- ask+          let er = erased dec+          s <- if impredicative ce && er && s2 == Set VZero then return s2 else ptsRule er s1 s2 -- Impredicativity!+          -- improve erasure annotation: irrelevant arguments can be erased!+          let (ki',dec') = if checkCon then+                 -- in case of constructor types the kind is the union+                 -- of the kinds of the constructor arguments+                 if ki0 == kTSize then (ki2, irrelevantDec)+                  else if erased dec then (ki2, dec) -- do not count erased args in+                 else (unionKind ki0 ki2, dec)+                else (ki2, if argKind ki0 `irrelevantFor` (predKind ki2)+                            then irrelevantDec+                            else dec)+          -- the kind of the Pi-type is the kind of its target (codomain)+          return (VSort s, Kinded ki' $ Quant pisig (TBind n (Domain t1e ki1 dec')) t2e)++      Quant Pi (TMeasure (Measure mu)) t2 -> do+        mue <- mapM checkSize mu+        (s, Kinded ki2 t2e) <- inferType t2+        return (VSort s, Kinded ki2 $ Quant Pi (TMeasure (Measure mue)) t2e)++      Quant Pi (TBound (Bound ltle (Measure mu) (Measure mu'))) t2 -> do+        (mue,mue') <- checkingDom $ do+          mue  <- checkingDom $ mapM checkSize mu+          mue' <- mapM checkSize mu'+          return (mue,mue')+        (s, Kinded ki2 t2e) <- inferType t2+        return (VSort s, Kinded ki2 $ Quant Pi (TBound (Bound ltle (Measure mue) (Measure mue'))) t2e)++      Sing e1 t -> do+        (s, Kinded ki te) <- inferType t+        tv <- whnf' te+        Kinded ki1 e1e <- checkExpr e1 tv+        return (VSort $ s, Kinded (intersectKind ki $ succKind ki1) -- not sure how useful the intersection is, maybe just ki is good enough+                             $ Sing e1e te)++{- Not safe to infer pairs because of irrelevance!+      Pair e1 e2 -> do+        (tv1, Kinded k1 e1) <- inferExpr e1+        (tv2, Kinded k2 e2) <- inferExpr e2+        let ki = unionKind k1 k2+            tv = prod tv1 tv2+        return (tv, Kinded ki $ Pair e1 e2)+-}++      App (Proj Pre p) e  -> inferProj e Pre p+      App e (Proj Post p) -> inferProj e Post p++      App e1 e2 -> checkingCon False $ do+        (v, Kinded ki1 e1e) <- inferExpr e1+        (Kinded ki2 (_, e2e), bv) <- checkApp e2 v+        -- the kind of the application is the kind of its head+        return (bv, Kinded ki1 $ App e1e e2e)+{-+            v <- force v -- if v is a corecursively defined type in Set, unfold!+            case v of+               VQuant Pi x (Domain av _ dec) env b -> do+                  (v2,e2e) <-+                    if inferable e2 then do+                  -- if e2 has a singleton type, we should not take v2 = whnf e2+                  -- but use the single value of e2+                  -- this is against the spirit of bidir. checking+                           -- if checking a type we need to resurrect+                           (av', Kinded _ e2e) <- applyDec dec $ inferExpr e2+                           case av' of+                              VSing v2 av'' -> do subtype av' av+                                                  return (v2,e2e)+                              _ -> do checkSubtype e2e av' av+                                      v2 <- whnf' e2e+                                      return (v2, e2e)+                         else do+                           Kinded _ e2e <- applyDec dec $ checkExpr e2 av+                           v2 <- whnf' e2+                           return (v2, e2e)+                  bv <- whnf (update env x v2) b+                  -- the kind of the application is the kind of its head+                  return (bv, Kinded ki1 $ App e1e (if erased dec then erasedExpr e2e else e2e))+-- if e1e==Irr then Irr else if e2e==Irr then e1e else App e1e [e2e])+               _ -> throwErrorMsg $ "inferExpr : expected Pi with expression : " ++ show e1 ++ "," ++ show v+-}++--      App e1 (e2:el) -> inferExpr $ (e1 `App` [e2]) `App` el+      -- 2012-01-22 no longer infer constructors+      (Def id@(DefId {idKind, idName = name})) | not (conKind idKind) -> do -- traceCheckM ("infer defined head " ++ show n)+         mitem <- errorToMaybe $ lookupName1 $ unqual name+         case mitem of -- first check if it is also a var name+           Just item -> do -- we are inside a mutual declaration (not erased!)+             let pol  = (polarity $ decor $ domain item)+             let upol = (polarity $ upperDec item)+             mId <- asks checkingMutualName+             case mId of+               Just srcId ->+                 -- we are checking constructors or function bodies+                 addPosEdge srcId id upol+               Nothing ->+                 -- we are checking signatures+                 enter ("recursive occurrence of " ++ show name ++ " not strictly positive") $+                   leqPolM pol upol+             return (typ $ domain item, Kinded (kind $ domain item) $ e)+           Nothing -> -- otherwise, it is not the data type name just being defined+                 do sige <- lookupSymbQ name+                    case sige of+                      -- data types have always kind Set 0!+                      (DataSig { symbTyp = tv }) -> return (tv, Kinded (symbolKind sige) e)+                      (FunSig  { symbTyp = tv }) -> return (tv, Kinded (symbolKind sige) e)+                      -- constructors are always terms+                      (ConSig  { symbTyp = tv }) -> returnSing (Kinded kTerm e) tv  -- constructors have sing.type!+                      (LetSig  { symbTyp = tv }) -> return (tv, Kinded (symbolKind sige) e) -- return $ vSing v tv+{-+      (Con _ n) -> do sig <- gets signature+                      case (lookupSig n sig) of+      (Let n) -> do sig <- gets signature+                    case (lookupSig n sig) of+-}+      _ -> throwErrorMsg $ "cannot infer type of " ++ show e+     ) >>= \ tv -> ask >>= \ ce ->+         traceCheck ("inferExpr: " ++ show (renaming ce) ++ ";" ++ show (context ce) ++ " |- " ++ show e ++ " :=> " ++ show tv ++ " in env" ++ show (environ ce)) $+--         traceCheck ("inferExpr: " ++ show e ++ " :=> " ++ show tv) $+           return tv+++{- BAD IDEA!+improveDec :: Dec -> TVal -> Dec+improveDec dec v = if v == VSet || v == VSize then erased else dec+-}++{-+-- entry point 3: resurrects+checkType :: Expr -> TypeCheck Extr+checkType e = (resurrect $ checkType' e) `throwTrace` ("not a type: " ++ show e )++checkType' :: Expr -> TypeCheck Extr+checkType' e = case e of+    Sort s -> return e+    Pi dec x t1 t2 -> do+        t1e <- checkType' t1+        -- ignore erasure flag in types!+--        t1v <- whnf' t1e+--        new' x (Domain (Dec False) t1v) $ do+        addBind x (Dec False) t1e $ do+          t2e <- checkType' t2+          return $ Pi dec x t1e t2e  -- Pi (improveDec dec t1v) x t1e t2e+    _ -> checkExpr' e $ VSort Set+-}++checkType :: Expr -> TypeCheck (Kinded Extr)+checkType t =+  enter ("not a type: " ++ show t) $+    resurrect $ do+      (s, te) <- inferType t+      leqSort Pos s (Set VInfty)+      return te++checkSmallType :: Expr -> TypeCheck (Kinded Extr)+checkSmallType t =+  enter ("not a set: " ++ show t) $+    resurrect $ do+      (s, te) <- inferType t+      case s of+        Set VZero -> return te+        CoSet{} -> return te+        _ -> fail $ "expected " ++ show s ++ " to be Set or CoSet _"++{-+-- small type+checkSmallType :: Expr -> TypeCheck Extr+checkSmallType e  = (resurrect $ checkExpr' e $ VSort Set) `throwTrace` ("not a set: " ++ show e )+-}++-- check telescope and add bindings to contexts+checkTele :: Telescope -> TypeCheck a -> TypeCheck (ETelescope, a)+checkTele (Telescope tel) k = loop tel where+  loop tel = case tel of+    []                                  -> (emptyTel,) <$> k+    tb@(TBind x (Domain t _ dec)) : tel -> do+      Kinded ki te <- checkType t+      let tb = TBind x (Domain te (predKind ki) dec)+      (tel, a) <- addBind tb $ loop tel+      return (Telescope $ tb : telescope tel, a)++-- the integer argument is the number of the clause, used just for user feedback+checkCases :: Val -> TVal -> [Clause] -> TypeCheck (Kinded [EClause])+checkCases = checkCases' 1++checkCases' :: Int -> Val -> TVal -> [Clause] -> TypeCheck (Kinded [EClause])+checkCases' i v tv [] = return $ Kinded NoKind []+checkCases' i v tv (c : cl) = do+    Kinded k1 ce  <- checkCase i v tv c+    Kinded k2 cle <- checkCases' (i + 1) v tv cl+    return $ Kinded (unionKind k1 k2) $ ce : cle++checkCase :: Int -> Val -> TVal -> Clause -> TypeCheck (Kinded EClause)+checkCase i v tv cl@(Clause _ [p] mrhs) = enter ("case " ++ show i) $+  -- traceCheck ("checking case " ++ show i) $+    do+      -- clearDots -- NOT NEEDED+      (flex,ins,cxt,vt,pe,pv,absp) <- checkPattern neutral [] emptySub tv p+      local (\ _ -> cxt) $ do+        mapM (checkGoal ins) flex+        tel <- getContextTele -- TODO!+        case (absp,mrhs) of+           (True,Nothing) -> return $ Kinded NoKind (Clause tel [pe] Nothing)+           (False,Nothing) -> fail ("missing right hand side in case " ++ showCase cl)+           (True,Just rhs) -> fail ("absurd pattern requires no right hand side in case " ++ showCase cl)+           (False,Just rhs) -> do+              -- pv <- whnf' (patternToExpr p) -- DIFFICULT FOR DOT PATTERNS!+      --        vp <- patternToVal p -- BUG: INTRODUCES FRESH GENS, BUT THEY HAVE ALREADY BEEN INTRODUCED IN checkPattern+              addRewrite (Rewrite v pv) [vt] $ \ [vt'] -> do+                Kinded ki rhse <- checkRHS ins rhs vt'+                return $ Kinded ki (Clause tel [pe] (Just rhse))+                -- [rhs'] <- solveAndModify [rhs] (environ cxt)+                -- return (Clause [p] rhs')++-- type check a function++checkFun :: Type -> [Clause] -> TypeCheck (Kinded [EClause])+checkFun t cl = do+  tv <- whnf' t+  checkClauses tv cl++-- the integer argument is the number of the clause, used just for user feedback+checkClauses :: TVal -> [Clause] -> TypeCheck (Kinded [EClause])+checkClauses = checkClauses' 1++checkClauses' :: Int -> TVal -> [Clause] -> TypeCheck (Kinded [EClause])+checkClauses' i tv [] = return $ Kinded NoKind ([])+checkClauses' i tv (c:cl) = do+    Kinded ki1 ce  <- checkClause i tv c+    Kinded ki2 cle <- checkClauses' (i + 1) tv cl+    return $ Kinded (unionKind ki1 ki2) $ (ce : cle)++-- checkClause i tv cl = (cl', cle)+-- checking one equation cl of a function at type tv+-- solve size constraints+-- substitute solution into clause, resulting in cl'+-- return also extracted clause cle+checkClause :: Int -> TVal -> Clause -> TypeCheck (Kinded EClause)+checkClause i tv cl@(Clause _ pl mrhs) = enter ("clause " ++ show i) $ do+  -- traceCheck ("checking function clause " ++ show i) $+    -- clearDots -- NOT NEEDED+    (flex,ins,cxt,tv0,ple,plv,absp) <- checkPatterns neutral [] emptySub tv pl+    -- 2013-03-30 When checking the rhs, we only allow new size hypotheses+    -- if they do not break any valuation of the existing hypotheses.+    -- See ICFP 2013 paper.+    -- We exclude cofuns here, for experimentation.+    -- Note that cofuns need not be SN, so the strict consistency may be+    -- not necessary.+    local (\ _ -> cxt { consistencyCheck = (mutualCo cxt == Ind) }) $ do+      mapM (checkGoal ins) flex+{-+      dots <- openDots+      unless (null dots) $+        recoverFailDoc $ text "the following dotted constructors could not be confirmed: " <+> prettyTCM dots+-}+      -- TODO: insert meta var solution in dot patterns+      tel <- getContextTele -- WRONG TELE, has VGens for DotPs+      case (absp,mrhs) of+         (True,Nothing) -> return $ Kinded NoKind (Clause tel ple Nothing)+         (False,Nothing) -> fail ("missing right hand side in clause " ++ show cl)+         (True,Just rhs) -> fail ("absurd pattern requires no right hand side in clause " ++ show cl)+         (False,Just rhs) -> do+            Kinded ki rhse <- checkRHS ins rhs tv0+            env  <- getEnv+            [rhse] <- solveAndModify [rhse] env+            return $ Kinded ki (Clause tel ple (Just rhse))+++-- * Pattern checking ------------------------------------------------++type Substitution = Valuation -- [(Int,Val)]++emptySub    = emptyVal+sgSub       = sgVal+lookupSub i = lookup i . valuation++type DotFlex = (Int,(Expr,Domain))++-- left over goals+data Goal+    = DotFlex Int (Maybe Expr) Domain+      -- ^ @Just@ : Flexible variable from inaccessible pattern.+      -- ^ @Nothing@ : Flexible variable from hidden function type.+    | MaxMatches Int TVal+    | DottedCons Dotted Pattern TVal+  deriving Show++-- checkPatterns is initially called with an empty local context+-- in the type checking monad+checkPatterns :: Dec -> [Goal] -> Substitution -> TVal -> [Pattern] -> TypeCheck ([Goal],Substitution,TCContext,TVal,[EPattern],[Val],Bool)+checkPatterns dec0 flex ins v pl =+  case v of+    VMeasured mu vb -> setMeasure mu $ checkPatterns dec0 flex ins vb pl+    VGuard beta vb -> addBoundHyp beta $ checkPatterns dec0 flex ins vb pl+{-+    VGuard beta vb -> fail $ "checkPattern at type " ++ show v ++ " --- introduction of constraints not supported"+-}+    _ -> case pl of+      [] -> do cxt <- ask+               return (flex,ins,cxt,v,[],[],False)+      (p:pl') -> do (flex',ins',cxt',v',pe,pv,absp) <- checkPattern dec0 flex ins v p+                    local (\ _ -> cxt') $ do+                      (flex'',ins'',cxt'',v'',ple,plv,absps) <- checkPatterns dec0 flex' ins' v' pl'+                      return (flex'',ins'',cxt'',v'', pe:ple, pv:plv, absp || absps) -- if pe==IrrP then ple else pe:ple)++{-+checkPattern dec0 flex subst tv p = (flex', subst', cxt', tv', pe, pv, absp)++Input :+  dec0  : context in which pattern occurs (irrelevant, parametric, recursive)+          are we checking an erased argument? (constr. pat. needs to be forced!)+  flex  : list of pairs (flexible variable, its dot pattern + supposed type)+  subst : list of pairs (flexible variable, its valuation)+  cxt   : in monad, containing+    rho   : binding of variables to values+    delta : binding of generic values to their types+  tv    : type of the expression \ p -> t+  p     : the pattern to check++Output+  tv'   : type of t+  pe    : erased pattern+  pv    : value of pattern (this is in essence whnf' pe,+            but we cannot evaluate because of dot patterns)+  absp  : did we encounter an absurd pattern+-}++checkPattern :: Dec -> [Goal] -> Substitution -> TVal -> Pattern -> TypeCheck ([Goal],Substitution,TCContext,TVal,EPattern,Val,Bool)+checkPattern dec0 flex ins tv p = -- ask >>= \ TCContext { context = delta, environ = rho } -> trace ("checkPattern" ++ ("\n  dot pats: " +?+ show flex) ++ ("\n  substion: " +?+ show ins) ++ ("\n  environ : " +?+ show rho) ++ ("\n  context : " +?+ show delta) ++ "\n  pattern : " ++ show p ++ "\n  at type : " ++ show tv ++ "\t<>") $+ enter ("pattern " ++ show p) $ do+  tv <- force tv+  case tv of+    -- record type can be eliminated+    VApp (VDef (DefId DatK d)) vl ->+      case p of+        ProjP proj -> do+          tv <- projectType tv proj VIrr -- do not have record value here+          cxt <- ask+          return (flex, ins, cxt, tv, p, VProj Post proj, False)+{-+          mfs <- getFieldsAtType d vl+          case mfs of+            Nothing -> failDoc (text "cannot eliminate type" <+> prettyTCM tv <+> text "with projection pattern" <+> prettyTCM p)+            Just ptvs ->+              case lookup proj ptvs of+                Nothing -> failDoc (text "record type" <+> prettyTCM tv <+> text "does not know projection" <+> text proj)+                Just tv -> do+                  tv <- piApp tv VIrr -- cut of record arg+                  cxt <- ask+                  return (flex, ins, cxt, tv, p, VProj proj, False)+-}+        _ -> failDoc (text "cannot eliminate type" <+> prettyTCM tv <+> text "with a non-projection pattern")++    -- intersection type+    VQuant Pi x dom@(Domain av ki Hidden) fv -> do+      -- introduce new flexible variable+      newWithGen x dom $ \ i xv -> do+        tv <- fv `app` xv+        checkPattern dec0 (DotFlex i Nothing dom : flex) ins tv p++    -- function type can be eliminated+    VQuant Pi x (Domain av ki dec) fv -> do+{-+       let erased' = er || erased dec+       let decEr   = if erased' then irrelevantDec else dec -- dec {erased = erased'}+-}+       let decEr = dec `compose` dec0+       let domEr   =  (Domain av ki decEr)+       case p of++         -- treat successor pattern here, because of admissibility check+         SuccP p2 -> do+                 when (av /= vSize) $ throwErrorMsg "checkPattern: expected type Size"+                 when (isSuccessorPattern p2) $ cannotMatchDeep p tv++                 co <- asks mutualCo+                 when (co /= CoInd) $+                   fail ("successor pattern only allowed in cofun")++                 enterDoc (text ("checkPattern " ++ show p ++" : matching on size, checking that target") <+> prettyTCM tv <+> text "ends in correct coinductive sized type") $+                   underAbs x domEr fv $ \ i _ bv -> endsInSizedCo i bv++                 cxt <- ask+                 -- 2012-02-05 assume size variable in SuccP to be < #+                 let sucTy = (vFinSize `arrow` vFinSize)+                 (flex',ins',cxt',tv',p2e,p2v,absp) <- checkPattern decEr flex ins sucTy p2+                 -- leqVal Mixed delta' VSet VSize av -- av = VSize+                 let pe = SuccP p2e+                 let pv = VSucc p2v+--                 pv0 <- local (\ _ -> cxt') $ whnf' $ patternToExpr pe+                 -- pv0 <- patternToVal p -- RETIRE patternToVal+                 -- pv  <- up False pv0 av -- STUPID what can be eta-exanded at type Size??+                 vb  <- app fv pv+{-+                 endsInCoind <- endsInSizedCo pv vb+                 when (not endsInCoind) $ throwErrorMsg $ "checkPattern " ++ show p ++" : cannot match on size since target " ++ show tv ++ " does not end in correct coinductive sized type"+-}+                 return (flex',ins',cxt',vb,pe,pv,absp)++         -- other patterns: no need to know about result type+         _ -> do+           (flex',ins',cxt',pe,pv,absp) <- checkPattern' flex ins domEr p+           -- traceM ("checkPattern' returns " ++ show (flex',ins',cxt',pe,pv,absp))+           vb  <- app fv pv+           vb  <- substitute ins' vb  -- from ConP case -- ?? why not first subst and then whnf?+           -- traceCheckM ("Returning type " ++ show vb)+           return (flex',ins',cxt',vb,pe,pv,absp)++    _ -> throwErrorMsg $ "checkPattern: expected function type, found " ++ show tv++-- TODO: refactor with monad transformers+-- put absp into writer monad++turnIntoVarPatAtUnitType :: TVal -> Pattern -> TypeCheck Pattern+turnIntoVarPatAtUnitType (VApp (VDef (DefId DatK n)) _) p@(ConP pi c []) =+  flip (ifM $ isUnitData n) (return p) $ do+    let x = fresh "un!t"+    return $ VarP x+turnIntoVarPatAtUnitType _ p = return p++checkPattern' :: [Goal] -> Substitution -> Domain -> Pattern -> TypeCheck ([Goal],Substitution,TCContext,EPattern,Val,Bool)+checkPattern' flex ins domEr@(Domain av ki decEr) p = do+       p <- turnIntoVarPatAtUnitType av p+       case p of+          SuccP{} -> failDoc (text "successor pattern" <+> prettyTCM p <+> text "not allowed here")++          PairP p1 p2 -> do+            av <- force av+            case av of+             VQuant Sigma y dom1@(Domain av1 ki1 dec1) fv -> do+              (flex, ins, cxt, pe1, pv1, absp1) <-+                 checkPattern' flex ins (Domain av1 ki1 $ dec1 `compose` decEr) p1+              av2 <- app fv pv1+              (flex, ins, cxt, pe2, pv2, absp2) <-+                 local (const cxt) $+                   checkPattern' flex ins (Domain av2 ki decEr) p2+              return (flex, ins, cxt, PairP pe1 pe2, VPair pv1 pv2, absp1 || absp2)+             _ -> failDoc (text "pair pattern" <+> prettyTCM p <+> text "could not be checked against type" <+> prettyTCM av)+{-+   (x : Sigma y:A. B) -> C+     =iso= (y : A) -> (x' : B) -> C[(y,x')/x]++   (x : Sigma y:V. <B;rho1>) -> <C;rho2>+     =iso= (y : V) -> <(x': B) -> C; ?? x=(y,x')>+ -}+{-+            case av of+              VQuant Sigma y dom1@(Domain av1 ki1 dec1) env1 a2 -> do+                let x' = x ++ "#2"+                    ep = Pair (Var y) (Var x')+                    tv = VQuant Pi y dom1 env1 $+                           Quant x' (Domain a2+-}++          ProjP proj -> failDoc (text "cannot eliminate type" <+> prettyTCM av <+> text "with projection pattern" <+> prettyTCM p)++          VarP y -> do+            new y domEr $ \ xv -> do+              cxt' <- ask+              p' <- case av of+                       VBelow Lt v -> flip SizeP y <$> toExpr v+                       _ -> return p+              return (flex, ins, cxt', maybeErase $ p', xv, False)++{- checking bounded size patterns++    ex : [i : Size] -> [j : Below< i] -> ...+    ex i (j < i) = ...++  type of pattern : Below< i needs to cover type of parameter Below< i++    zero : [j : Size] -> Nat $j   -- need to hold a "sized con type"+    zero : [j < i]    -> Nat i++    ex : [i : Size] -> (n : Nat i) -> ...+    ex i (zero (j < i) = ...++  type of size-pat : Below< i++-}+          SizeP e y -> do -- pattern (z > y), y is the bound variable, z the bound of z+            e <- resurrect $ checkSize e -- (Var z)+            newWithGen y domEr $ \ j xv -> do+{-+               VGen k <- whnf' (Var z)+               addSizeRel j 1 k $ do  -- j < k+-}+               ve <- whnf' e+               addBoundHyp (Bound Lt (Measure [xv]) (Measure [ve])) $ do+                 subtype av (VBelow Lt ve)+                 cxt' <- ask+                 return (flex, ins, cxt', maybeErase $ SizeP e y, xv, False)++          AbsurdP -> do+                 when (isFunType av) $ fail ("absurd pattern " ++ show p ++ " does not match function types, like " ++ show av)+                 cxt' <- ask+                 return (MaxMatches 0 av : flex, ins, cxt', maybeErase $ AbsurdP, VIrr, True)+{-+                 cenvs <- matchingConstructors av  -- TODO: av might be MVar+                                                   -- need to be postponed+                 case cenvs of+                    [] -> do bv   <- whnf (update env x VIrr) b+                             cxt' <- ask+                             return (flex, ins, cxt', bv, maybeErase $ AbsurdP, True)+                    _ -> throwErrorMsg $ "type " ++ show av ++ " of absurd pattern not empty"+-}++          -- always expand defined patterns!+          p@(ConP pi n ps) | coPat pi == DefPat -> do+            checkPattern' flex ins domEr =<< expandDefPat p++--          ConP pi n pl | not $ dottedPat pi -> do+          ConP pi n pl -> do++                 -- disambiguate constructor first+                 n <- disambigCon n av++                 let co     = coPat pi+                     dotted = dottedPat pi++                 -- First check that we do not match against an irrelevant argument.+                 unless dotted $ nonDottedConstructorChecks n co pl+{- TODO+                 enter ("can only match non parametric arguments") $+                   leqPolM (polarity dec) (pprod defaultPol)+-}+                 (vc,(flex',ins',cxt',vc',ple,pvs,absp)) <- checkConstructorPattern co n pl++                 when (isFunType vc') $ fail ("higher-order matching of pattern " ++ show p ++ " of type " ++ show vc' ++ " not allowed")+                 let flexgen = concat $ map (\ g -> case g of+                        DotFlex i _ _ -> [i]+                        _ -> []) flex'+                     -- fst $ unzip flex'+--                  av1 <- sing (environ cxt') (patternToExpr p) vc'+--                  av2 <- sing (environ cxt') (patternToExpr p) av+--                  subst <- local (\ _ -> cxt') $ inst flexgen VSet av1 av2+++                 -- need to evaluate the erased pattern!+                 let pe = ConP pi n ple -- erased pattern+                 -- dot <- if dottedPat pi then newDotted p else return notDotted+                 dot <- if dottedPat pi then mkDotted True else return notDotted+                 pv0 <- mkConVal dot co n pvs vc+                 -- OLD: let pv0 = VDef (DefId (ConK co) n) `VApp` pvs+{-+                 let epe = patternToExpr pe+                 pv0 <- local (\ _ -> cxt') $ whnf' epe+--                 pv0 <- patternToVal p -- THIS USE should be ok, since the new GENs are not in the global context yet, only in cxt' -- NO LONGER ok with erasure!+                 -- traceM $ "sucessfully computed value " ++ show pv0 ++ " of pattern " ++ show epe+-}++                 subst <- local (\ _ -> cxt') $ do+                   case av of  -- TODO: need subtyping-unify instead of unify??+                     VSing vav av0 -> do+                       vav <- whnfClos vav+                       inst Pos flexgen av0 pv0 vav+                     _ -> unifyIndices flexgen vc' av  -- vc' <= av ?!+                   -- THIS IMPLEMENTATION RELIES HEAVILY ON INJECTIVITY OF DATAS++{- moved to checkRHS+                 -- apply substitution to measures in environment+                 let mmu = (envBound . environ) cxt'+                 mmu' <- Traversable.mapM (substitute subst) mmu+-}+{-+                 ins'' <- compSubst ins' subst+                 vb <- substitute ins'' vb+                 delta' <- substitute ins'' delta'+-}+                 ins''   <- compSubst ins' subst -- 2010-07-27 not ok to switch!+                 delta'' <- substitute ins'' (context cxt')+                 traceCheckM $ "delta'' = " ++ show delta''+                 av  <- substitute ins'' av  -- 2010-09-22: update av+                 pv  <- up False pv0 av++                 -- if the constructor was dotted, make sure it is the only match+                 let flex'' = fwhen dotted (DottedCons dot p av :) flex'+                 return (flex'', ins'', cxt' { context = delta'' },+                         maybeErase pe, pv, absp)+{- DO NOT UPDATE measure here, its done in checkRHS+                 return (flex', ins'', cxt' { context = delta'', environ = (environ cxt') { envBound = mmu' } }, vb',+                         maybeErase pe, absp)+-}+++{- UNUSED+          -- If we encounter a dotted constructor, we simply+          -- compute the pattern variable context+          -- and then treat the pattern as dot pattern.+          p@(ConP pi n ps) | dottedPat pi -> do+            (vc,(flex',ins',cxt',vc',ple,pvs,absp)) <-+              checkConstructorPattern (coPat pi) n ps+            local (const cxt') $+              checkPattern' flex ins domEr $ DotP $ patternToExpr p+-}++          DotP e -> do+            -- create an informative, but irrelevant identifier for dot pattern+            let xp = fresh $ "." ++ case e of Var z -> suggestion z; _ -> Util.parens $ show e+            newWithGen xp domEr $ \ k xv -> do+                       cxt' <- ask+                       -- traceCheck ("Returning type " ++ show vb) $+                       return (DotFlex k (Just e) domEr : flex+                              ,ins+                              ,cxt'+                              ,maybeErase $ DotP e -- $ Var xp -- DotP $ Meta k -- e -- Meta k+                              -- ,maybeErase $ -- AbsurdP -- VarP $ show e+                              ,xv+                              ,False) -- TODO: Erase in e/ Meta subst!+{- original code+                    do let (k, delta') = cxtPush dec av delta+                       vb <- whnf (update env x (VGen k)) b+                       return ((k,(e,Domain av dec)):flex+                              ,ins+                              ,rho+                              ,delta'+                              ,vb)+-}++    where+      maybeErase p = if erased decEr then ErasedP p else p++      checkConstructorPattern co n pl = do+                 when (isFunType av) $ fail ("higher-order matching of pattern " ++ show p ++ " at type " ++ show av ++ " not allowed")+-- TODO: ensure that matchings against erased arguments are forced+--                 when (erased dec) $ throwErrorMsg $ "checkPattern: cannot match on erased argument " ++ show p ++ " : " ++ show av++                 ConSig {conPars, lhsTyp = sz, recOccs, symbTyp = vc, dataName, dataPars} <- lookupSymbQ n++                 -- the following is a hack to still support old-style+                 --   add .($ i) (zero i) ...+                 -- fun defs:  if (zero i) is matched against (Nat flexvar$i)+                 -- we use the old constructor type [i : Size] -> Nat $i+                 -- else, the new one [j < i] -> Nat i+                 let flexK k (DotFlex k' _ _) = k == k'+                     flexK k _ = False+                     -- use lhs con type only if sizeindex is not a rigid var+                     isFlex (VGen k) = List.any (flexK k) flex+                     isFlex _ = True+                     isSz = if co == Cons then sz else Nothing+                 vc <- instConLType n conPars vc isSz isFlex dataPars =<< force av+{-+                 vc <- case sz of+                         Nothing -> instConType n nPars vc =<< force av+                         Just vc -> instConType n (nPars+1) vc =<< force av+-}++                 -- (flex',ins',cxt',vc',ple,pvs,absp) <-+                 (vc,) <$> checkPatterns decEr flex ins vc pl+++      -- These checks are only relevant if a constructor is an actual match.+      nonDottedConstructorChecks n co pl = do+        ConSig {conPars, lhsTyp = sz, recOccs, symbTyp = vc, dataName, dataPars} <- lookupSymbQ n++        -- check that size argument of coconstr is dotted+        when (co == CoCons && isJust sz) $ do+          let sizep = head pl  -- 2012-01-22: WAS (pl !! nPars)+          unless (isDotPattern sizep) $+            fail $ "in pattern " ++ show p  ++ ", coinductive size sub pattern " ++ show sizep ++ " must be dotted"++        when (not $ decEr `elem` map Dec [Const,Rec]) $+          recoverFail $ "cannot match pattern " ++ show p ++ " against non-computational argument"+        -- check not to match non-trivially against erased stuff+        when (decEr == Dec Const) $ do+          let failNotForced = recoverFail $ "checkPattern: constructor " ++ show n ++ " of non-computational argument " ++ show p ++ " : " ++ show av ++ " not forced"+          mcenvs <- matchingConstructors av+          case mcenvs of+             Nothing -> do -- now check whether dataName is a record type+               DataSig { constructors } <- lookupSymb dataName+               unless (length constructors == 1) $ failNotForced+               return ()+             Just [] -> recoverFail $ "checkPattern: no constructor matches type " ++ show av+             Just [(ci, _)] | cName ci == n -> return ()+             _ -> failNotForced+++++{- New treatment of size matching  (see examples/Sized/Cody.ma)++sized data O : Size -> Set+{ Z : [i : Size] -> O ($ i)+; S : [i : Size] -> O i -> O ($ i)+; L : [i : Size] -> (Nat -> O i) -> O ($ i)+; M : [i : Size] -> O i -> O i -> O ($ i)+}++fun deep : [i : Size] -> O i -> Nat -> Nat+{ deep i4 (M i3 (L j2 f) (S i2 (S i1 (S i x)))) n+  = deep _ (M _ (L _ (pre _ f)) (S _ (f n))) (succ (succ (succ n)))+; deep i x n = n+}++Explicit form:  Size variables and their constraints are noted explicitely,+to be able to do untyped call extraction in the termination module.++ deep i4+  (M (i4 > i3)+       (L (i3 > j2) f)+       (S (i3 > i2)+            (S (i2 > i1)+                 (S (i1 > i) x)))) n+  = deep _ (M _ (L _ (pre _ f)) (S _ (f n))) (succ (succ (succ n)))++i4, i3, ... are all rigid variables with constraints between them.+There is a tree hierarchy, but I do not know whether I can exploit+this.++  i4 > i3 > i2 > i1 > i+          > j3++This could be stored in a union-find-like data structure, or just in+the constraint matrix.++How to pattern match?++  id : [i : Size] -> List i -> List i+  id i (cons (i > j) x xs) = cons j x (id j xs)++Only a size variable matches a size arguments++  match  (cons (i > j) x xs)   against   List i+  get    cons : [j : Size] -> Nat -> List j -> List ($ j)+  yield  x : Nat, xs : List j, cons j x xs : List ($ j)+  check  List ($ j) <= List i+ -}++{- RETIRED+-- checkDot does not need to extract+checkDot :: Substitution -> DotFlex -> TypeCheck ()+checkDot subst (i,(e,it)) = enter ("dot pattern " ++ show e) $+  case (lookup i subst) of+    Nothing -> fail $ "not instantiated"+    Just v -> do+      tv <- substitute subst (typ it)+      ask >>= \ ce -> traceCheckM ("checking dot pattern " ++ show ce ++ " |- " ++ show e ++ " : " ++ show (decor it) ++ " " ++ show tv)+      applyDec (decor it) $ do+        checkExpr e tv+        v' <-  whnf' e -- TODO: has subst erased terms?+        enter ("inferred value " ++ show v ++ " does not match given dot pattern value " ++ show v') $+          eqVal Pos tv v v'+-}++-- checkDot does not need to extract+-- 2012-01-25 now we do since "extraction" turns also con.terms into records+checkGoal :: Substitution -> Goal -> TypeCheck ()+checkGoal subst (DotFlex i me it) = enter ("dot pattern " ++ show me) $+  case lookupSub i subst of+    Nothing -> recoverFail $ "not instantiated"+    Just v -> whenJust me $ \ e -> do+      tv <- substitute subst (typ it)+      ask >>= \ ce -> traceCheckM ("checking dot pattern " ++ show ce ++ " |- " ++ show e ++ " : " ++ show (decor it) ++ " " ++ show tv)+--      applyDec (decor it) $ do+      resurrect $ do -- consider a DotP e always as irrelevant!+        e <- valueOf <$> checkExpr e tv+        v' <-  whnf' e -- TODO: has subst erased terms?+        enterDoc (text "inferred value" <+> prettyTCM v <+> text "does not match given dot pattern value" <+> prettyTCM v') $+          leqVal Pos tv v v' -- WAS: eqVal+checkGoal subst (MaxMatches n av) = do+  traceCheckM ("checkGoal _ $ MaxMatches " ++ show n ++ " $ " ++ show av)+  av' <- substitute subst av+  traceCheckM ("checkGoal _ $ MaxMatches " ++ show n ++ " $ " ++ show av')+  -- av' <- reval av'+  -- traceCheckM ("checkGoal: reevalutated " ++ show av')+  mcenvs <- matchingConstructors av'+  traceCheckM ("checkGoal matching constructors = " ++ show mcenvs)+  maybe (recoverFail $ "not a data type: " ++ show av')+   (\ cenvs ->+      if length cenvs > n then recoverFail $+        if n==0 then "absurd pattern does not match since type " ++ show av' ++ " is not empty"+         else+           "more than one constructor matches type " ++ show av'+       else return ())+   mcenvs+checkGoal subst (DottedCons dot p av)+  | isDotted dot =+      enterDoc (text "confirming dotted constructor" <+> prettyTCM p) $ do+        checkGoal subst (MaxMatches 1 av)+  | otherwise    = return ()++checkRHS :: Substitution -> Expr -> TVal -> TypeCheck (Kinded Extr)+checkRHS ins rhs v = do+   traceCheckM ("checking rhs " ++ show rhs ++ " : " ++ show v)+   enter "right hand side" $ do+     -- first update measure according to substitution for dot variables+     cxt <- ask+     let rho = environ cxt+     mmu' <- Traversable.mapM (substitute ins) (envBound rho)+     local (\ _ -> cxt { environ = rho { envBound = mmu' }}) $+       activateFuns $+         checkExpr rhs v++++-- TODO type directed unification++-- unifyIndices flex tv1 tv2+-- tv1 = D pars  inds  is the type of the pattern+-- tv2 = D pars' inds' is the type matched against+-- Note that in this case we can unify without using the principle of+-- injective data type constructors,+-- we are only calling unifyIndices from the constructor pattern case+-- in Checkpattern+unifyIndices :: [Int] -> Val -> Val -> TypeCheck Substitution+unifyIndices flex v1 v2 = ask >>= \ cxt -> enterDoc (text ("unifyIndices " ++ show (context cxt) ++ " |-") <+> prettyTCM v1 <+> text ("?<=" ++ show Pos) <+> prettyTCM v2) $ do+-- {-+  case (v1,v2) of+    (VSing _ v1, VApp (VDef (DefId DatK d2)) vl2) ->+      flip (unifyIndices flex) v2 =<< whnfClos v1+    (VApp (VDef (DefId DatK d1)) vl1, VApp (VDef (DefId DatK d2)) vl2) | d1 == d2 -> do+      (DataSig { numPars = np, symbTyp = tv, positivity = posl}) <- lookupSymbQ d1+      instList posl flex tv vl1 vl2 -- unify also parameters to solve dot patterns+    _ ->+-- -}+         inst Pos flex vTopSort v1 v2+-- throwErrorMsg ("unifyIndices " ++ show v1 ++ " =?= " ++ show v2 ++ " failed, not applied to data types")++-- unify, but first produce whnf+instWh :: Pol -> [Int] -> TVal -> Val -> Val -> TypeCheck Substitution+instWh pos flex tv w1 w2 = do+  v1 <- whnfClos w1+  v2 <- whnfClos w2+  inst pos flex tv v1 v2++-- | Check occurrence and return singleton substitution.+assignFlex :: Int -> Val -> TypeCheck Substitution+assignFlex k v = do+  unlessM (nocc [k] v) $+    failDoc $+      text "variable " <+> prettyTCM (VGen k) <+>+      text " may not occur in " <+> prettyTCM v+  return $ sgSub k v++-- match v1 against v2 by unification , yielding a substition+inst :: Pol -> [Int] -> TVal -> Val -> Val -> TypeCheck Substitution+inst pos flex tv v1 v2 = ask >>= \ cxt -> enterDoc (text ("inst " ++ show (context cxt) ++ " |-") <+> prettyTCM v1 <+> text ("?<=" ++ show pos) <+> prettyTCM v2 <+> colon <+> prettyTCM tv) $ do+--  case tv of+--    (VPi dec x av env b) ->+  case (v1,v2) of+    (VGen k, VGen j) | k == j -> return emptySub+    (VGen k, _) | elem k flex -> assignFlex k v2+    (_, VGen k) | elem k flex -> assignFlex k v1++    -- injectivity of data type constructors is unsound in general+    (VApp (VDef (DefId DatK d1)) vl1,+     VApp (VDef (DefId DatK d2)) vl2) | d1 == d2 ->  do+         (DataSig { numPars, symbTyp = tv, positivity = posl }) <- lookupSymbQ d1+         instList' numPars posl flex tv vl1 vl2+           -- ignore parameters (first numPars args)+           -- this is sound because we have irrelevance for parameters+           -- we assume injectivity for indices++    -- Constructor applications are represented as VRecord+    (VRecord (NamedRec _ c1 _ dot1) rs1,+     VRecord (NamedRec _ c2 _ dot2) rs2) | c1 == c2 -> do+         alignDotted dot1 dot2+         sige <- lookupSymbQ c1+         instList [] flex (symbTyp sige) (map snd rs1) (map snd rs2)++    (VSucc v1',     VSucc v2')     -> instWh pos flex tv v1' v2'+    (VSucc v,       VInfty)        -> instWh pos flex tv v   VInfty+    (VSing v1' tv1, VSing v2' tv2) -> do+      subst <- inst pos flex tv tv1 tv2+      u1 <- substitute subst v1'+      u2 <- substitute subst v2'+      tv1' <- substitute subst tv1+      inst pos flex tv1' u1 u2 >>= compSubst subst++-- HACK AHEAD+    (VUp v1 _, _) -> inst pos flex tv v1 v2+    (_, VUp v2 _) -> inst pos flex tv v1 v2+--    (VUp v1' a1, VUp v2' a2) -> instList flex [a1,v1'] [a2,v2']+--     (VPi dec x1 av1 env1 b1, VPi dec x2 av2 env2 b2) ->++{- TODO: REPAIR THIS+    _ -> traceCheck ("inst: WARNING! assuming " ++ show (context cxt) ++ " |- " ++ show v1 ++ " == " ++ show v2) $+           return [] -- throwErrorMsg $ "inst: NYI"+ -}+    _ -> do leqVal pos tv v1 v2 `throwTrace` ("inst: leqVal " ++ show v1 ++ " ?<=" ++ show pos ++ " " ++ show v2 ++ " : " ++ show tv ++ " failed")+            return emptySub++instList :: [Pol] -> [Int] -> TVal -> [Val] -> [Val] -> TypeCheck Substitution+instList = instList' 0++-- unify lists, ignoring the first np items+instList' :: Int -> [Pol] -> [Int] -> TVal -> [Val] -> [Val] -> TypeCheck Substitution+instList' np posl flex tv [] [] = return emptySub+instList' np posl flex tv (v1:vl1) (v2:vl2) = do+  v1 <- whnfClos v1+  v2 <- whnfClos v2+  if (np <= 0 || isMeta flex v1 || isMeta flex v2) then+    case tv of+      (VQuant Pi x dom fv) -> do+        let pol = getPol dom  -- WAS: (headPosl posl)+        subst <- inst pol flex (typ dom) v1 v2+        vl1' <- mapM (substitute subst) vl1+        vl2' <- mapM (substitute subst) vl2+        v    <- substitute subst v1+        fv   <- substitute subst fv+        vb   <- app fv v+        subst' <- instList' (np - 1) (tailPosl posl) flex vb vl1' vl2'+        compSubst subst subst'+   else+    case tv of+      (VQuant Pi x dom fv) -> do+        vb   <- app fv v2+        instList' (np - 1) (tailPosl posl) flex vb vl1 vl2+instList' np pos flex tv vl1 vl2 = fail $ "internal error: instList' " ++ show (np,pos,flex,tv,vl1,vl2) ++ " not handled"++headPosl :: [Pol] -> Pol+headPosl [] = mixed+headPosl (pos:_) = pos++tailPosl :: [Pol] -> [Pol]+tailPosl [] = []+tailPosl (_:posl) = posl+++isMeta :: [Int] -> Val -> Bool+isMeta flex (VGen k) = k `elem` flex+isMeta _ _ = False++----------------------------------------------------------------------+-- * Substitution into values+----------------------------------------------------------------------++-- | Overloaded substitution of values for generic values (free variables).+class Substitute a where+  substitute :: Substitution -> a -> TypeCheck a++instance Substitute v => Substitute (x,v) where+  substitute subst (x,v) = (x,) <$> substitute subst v++instance Substitute v => Substitute [v] where+  substitute = mapM . substitute++instance Substitute v => Substitute (Maybe v) where+  substitute = Traversable.mapM . substitute++instance Substitute v => Substitute (Map k v) where+  substitute = Traversable.mapM . substitute++instance Substitute v => Substitute (OneOrTwo v) where+  substitute = Traversable.mapM . substitute++instance Substitute v => Substitute (Dom v) where+  substitute = Traversable.mapM . substitute++instance Substitute v => Substitute (Measure v) where+  substitute = Traversable.mapM . substitute++instance Substitute v => Substitute (Bound v) where+  substitute = Traversable.mapM . substitute++instance Substitute v => Substitute (Sort v) where+  substitute = Traversable.mapM . substitute++-- substitute generic variable in value+instance Substitute Val where+  substitute subst v = do -- enterDoc (text "substitute" <$> prettyTCM v) $ do+    let sub v = substitute subst v+    case v of+      VGen k                -> return $ valuateGen k subst+      VApp v1 vl            -> foldM app ==<< (sub v1, sub vl)+      VSing v1 vt           -> vSing ==<< (sub v1, sub vt) -- TODO: Check reevaluation necessary?++      VSucc v1              -> succSize  <$> substitute subst v1+      VMax  vs              -> maxSize   <$> mapM (substitute subst) vs+      VPlus vs              -> plusSizes <$> mapM (substitute subst) vs++      VCase v1 tv1 env cl   -> VCase <$> sub v1 <*> sub tv1 <*> sub env <*> return cl+      VMeasured mu bv       -> VMeasured <$> sub mu <*> sub bv+      VGuard beta bv        -> VGuard <$> sub beta <*> sub bv++      VBelow ltle v         -> VBelow ltle <$> substitute subst v++      VQuant pisig x dom fv -> VQuant pisig x <$> sub dom <*> sub fv+      VRecord ri rs         -> VRecord ri <$> sub rs+      VPair v1 v2           -> VPair <$> sub v1 <*> sub v2+      VProj{}               -> return v++      VLam x env b          -> flip (VLam x) b <$> sub env+      VConst v              -> VConst <$> sub v+      VAbs x i v valu       -> VAbs x i v <$> sub valu+      VClos env e           -> flip VClos e <$> sub env+      VUp v1 vt             -> up False ==<< (sub v1, sub vt)+      VSort s               -> VSort <$> sub s+      VZero                 -> return $ v+      VInfty                -> return $ v+      VIrr                  -> return $ v+      VDef id               -> return $ vDef id  -- because empty list of apps will be rem.+      VMeta x env n         -> flip (VMeta x) n <$> sub env+{- REDUNDANT+      _ -> error $ "substitute: internal error: not defined for " ++ show v+-}++instance Substitute SemCxt where+  substitute subst delta = do+    cxt' <- substitute subst (cxt delta)+    return $ delta { cxt = cxt' }++-- | Substitute in environment.+instance Substitute Env where+  substitute subst (Environ rho mmeas) =+    Environ <$> substitute subst rho <*> substitute subst mmeas++instance Substitute Substitution where+  substitute subst2 subst1 = compSubst subst1 subst2++-- | "merge" substitutions by first applying the second to the first, then+--   appending them @t[sigma][tau] = t[sigma . tau]@+compSubst :: Substitution -> Substitution -> TypeCheck Substitution+compSubst (Valuation subst1) subst2@(Valuation subst2') =+    Valuation . (++ subst2') <$> substitute subst2 subst1++----------------------------------------------------------------------+-- * Size checking+----------------------------------------------------------------------++{- TODO: From a sized data declaration++  sized data D pars : Size -> t+  { c : [j : Size] -> args -> D pars $j ts+  }++  with constructor type++   c : .pars -> [j : Size] -> args -> D pars $j ts++  extract new-style constructor type++   c :  .pars -> [i : Size] -> [j < i : Size] -> args -> D pars i ts++  Then replace in ConSig filed isSized :: Sized  by :: Maybe Expr+  which stores the new-style constructor type++-}++mkConLType :: Int -> Expr -> (Name, Expr)+mkConLType npars t =+  let (Telescope (sizetb : tel), t0) = typeToTele t+  in case spineView t0 of+    (d@(Def (DefId DatK _)), args) ->+      let (pars, sizeindex : inds) = splitAt npars args+          i     = fresh "s!ze"+          args' = pars ++ Var i : inds+          core  = foldl App d args'+          tbi   = TBind i $ sizeDomain irrelevantDec+          tbj   = sizetb { boundDom = belowDomain irrelevantDec Lt (Var i) }+          tel'  = Telescope $ tbi : tbj : tel+      in (i, teleToType tel' core)+    _ -> error $ "conLType " ++ show npars ++ " (" ++ show t ++ "): illformed constructor type"++++-- * check wether the data type is sized type+++-- check data declaration type+-- called from typeCheckDeclaration (DataDecl{})+-- parameters : number of params, type+szType :: Co -> Int -> TVal -> TypeCheck ()+szType co p tv = doVParams p tv $ \ tv' -> do+    let polsz = if co==Ind then Pos else Neg+    case tv' of+      VQuant Pi x (Domain av ki dec) fv | isVSize av && not (erased dec) && polarity dec == polsz -> return ()+      _ -> throwErrorMsg $ "not a sized type, target " ++ show tv' ++ " must have non-erased domain " ++ show Size ++ " with polarity " ++ show polsz++-- * constructors of sized type++-- check data constructors+-- called from typeCheckConstructor+szConstructor :: Name -> Co -> Int -> TVal -> TypeCheck ()+szConstructor n co p tv = enterDoc (text ("szConstructor " ++ show n ++ " :") <+> prettyTCM tv) $ do+  doVParams p tv $ \ tv' ->+    case tv' of+       VQuant Pi x dom fv | isVSize (typ dom) ->+          underAbs x dom fv $ \ k xv bv -> do+            szSizeVarUsage n co p k bv+       _ -> fail $ "not a valid sized constructor: expected size quantification"++szSizeVarUsage :: Name -> Co -> Int -> Int -> TVal -> TypeCheck ()+szSizeVarUsage n co p i tv = enterDoc (text "szSizeVarUsage of" <+> prettyTCM (VGen i) <+> text "in" <+> prettyTCM tv) $+    case tv of+       VQuant Pi x dom fv -> do+          let av = typ dom+          szSizeVarDataArgs n p i av  -- recursive calls of for D..i..+          enterDoc (text "checking" <+> prettyTCM av <+> text (" to be " +++              (if co == CoInd then "antitone" else "isotone") ++ " in variable")+              <+> prettyTCM (VGen i)) $+            szMono co i av                -- monotone in i+          underAbs x dom fv $ \ _ xv bv -> do+            szSizeVarUsage n co p i bv++       _ -> szSizeVarTarget p i tv++-- check that Target is of form D ... (Succ i) ...+szSizeVarTarget :: Int -> Int -> TVal -> TypeCheck ()+szSizeVarTarget p i tv = enterDoc (text "szSizeVarTarget, variable" <+> prettyTCM (VGen i) <+> text ("argument no. " ++ show p ++ " in") <+> prettyTCM tv) $ do+    let err = text "expected target" <+> prettyTCM tv <+> text "of size" <+> prettyTCM (VSucc (VGen i))+    case tv of+       VSing _ tv -> szSizeVarTarget p i =<< whnfClos tv+       VApp d vl -> do+               v0 <- whnfClos (vl !! p)+               case v0 of+                 (VSucc (VGen i')) | i == i' -> return ()+                 _ -> failDoc err+       _ -> failDoc err+++-- check that rec. arguments are of form D ... i ....+-- and size used nowhere else ?? -- Andreas, 2009-11-27 TOO STRICT!+{- accepts, for instance++   Nat -> Ord i      as argument of a constructor of  Ord ($ i)+   List (Rose A i)   as argument of a constructor of  Rose A ($i)+ -}+szSizeVarDataArgs :: Name -> Int -> Int -> TVal -> TypeCheck ()+szSizeVarDataArgs n p i tv = enterDoc (text "sizeVarDataArgs" <+> prettyTCM (VGen i) <+> text "in" <+> prettyTCM tv) $ do+   case tv of++     {- case D pars sizeArg args -}+     VApp (VDef (DefId DatK (QName m))) vl | n == m -> do+        let (pars, v0 : idxs) = splitAt p vl+        v0 <- whnfClos v0+        case v0 of+          VGen i' | i' == i -> do+            forM_ (pars ++ idxs) $ \ v -> nocc [i] v >>= do+              boolToErrorDoc $+                text "variable" <+> prettyTCM (VGen i) <+>+                text "may not occur in" <+> prettyTCM v+          _ -> failDoc $+                text "wrong size index" <+> prettyTCM v0 <+>+                text "at recursive occurrence" <+> prettyTCM tv++-- not necessary: check for monotonicity above+--     {- case D' pars sizeArg args -}+--     VApp (VDef m) vl | n /= m -> do++     VApp v1 vl -> mapM_ (\ v -> whnfClos v >>= szSizeVarDataArgs n p i) (v1:vl)++     VQuant Pi x dom fv -> do+       szSizeVarDataArgs n p i (typ dom)+       underAbs x dom fv $ \ _ xv bv -> do+          szSizeVarDataArgs n p i bv++     fv | isFun fv ->+       addName (absName fv) $ \ xv -> szSizeVarDataArgs n p i =<< app fv xv+{-+     VLam x env b ->+       addName x $ \ xv -> do+         bv <- whnf (update env x xv) b+         szSizeVarDataArgs n p i bv+-}+     _ -> return ()++{- REMOVED, 2009-11-28, replaced by monotonicity check+     VGen i' -> return $ i' /= i+     VSucc tv' -> szSizeVarDataArgs n p i tv'+ -}++-- doVParams number_of_params constructor_or_datatype_signature+-- skip over parameters of type signature of a constructor/data type+doVParams :: Int -> TVal -> (TVal -> TypeCheck a) -> TypeCheck a+doVParams 0 tv k = k tv+doVParams p (VQuant Pi x dom fv) k =+  underAbs x dom fv $ \ _ xv bv -> do+    doVParams (p - 1) bv k++--------------------------------------+-- check for admissible  type++{-++ - admissibility needs to be check clausewise, because of Karl's example++   fun nonAdmissibleType : Unit -> Set++   fun diverge : (u : Unit) -> nonAdmissibleType u+   {+     diverge unit patterns = badRhs+   }++ - the type must be admissible in the current position+   only if the size pattern is a successor.+   If the pattern is a variable, then there is no induction on that size+   argument, so no limit case, so no upper semi-continuity necessary+   for the type.++ - when checking++     ... (s i) ps  admissible  (j : Size) -> A++   we will check++     A  admissible in j++   and continue with++     ... ps  admissible  A[s i / j]++   just to maintain type wellformedness.  The (s i) in A does not+   really matter, since there is no case distinction on ordinals.++ - a size pattern which is not inductive (meaning there is an+    inductive type indexed by that size) nor coinductive (meaning that+    the result type is coinductive and is indexed by that size) must+    be flagged unusable for termination checking.++ - the fun/cofun distinction could be inferred by the termination checker+   or be clausewise as in Agda 2++-}+++admFunDef :: Co -> [Clause] -> TVal -> TypeCheck [Clause]+admFunDef co cls tv = do+  (cls, inco) <- admClauses cls tv+  when (co==CoInd && not (co `elem` inco)) $+    fail $ show tv ++ " is not a type of a cofun" -- ++ if co==Ind then "fun" else "cofun"+  return cls++admClauses :: [Clause] -> TVal -> TypeCheck ([Clause], [Co])+admClauses [] tv = return ([], [])+admClauses (cl:cls) tv = do+  (cl',inco) <- admClause cl tv+  (cls',inco') <- admClauses cls tv+  return (cl' : cls', inco ++ inco')++admClause :: Clause -> TVal -> TypeCheck (Clause, [Co])+admClause (Clause tel ps e) tv = traceAdm ("admClause: admissibility of patterns " ++ show ps) $+   introPatterns ps tv $ \ pvs _ -> do+       (ps', inco) <- admPatterns pvs tv+       return (Clause tel ps' e, inco)++admPatterns :: [(Pattern,Val)] -> TVal -> TypeCheck ([Pattern], [Co])+admPatterns [] tv = do+  isCo <- endsInCo tv+  return ([], if isCo then [CoInd] else [])+admPatterns ((p,v):pvs) tv = do+   (p, inco1)  <- admPattern p tv+   bv <- piApp tv v+   (ps, inco2) <- admPatterns pvs bv+   return (p:ps, inco1 ++ inco2)++{-+-- turn a pattern into a value+-- extend delta by generic values but do not introduce their types+evalPat :: Pattern -> (Val -> TypeCheck a) -> TypeCheck a+evalPat p f =+    case p of+      VarP n -> addName n f+      ConP co n [] -> f (VCon co n)+      ConP co n pl -> evalPats pl $ \ vl -> f (VApp (VCon co n) vl)+      SuccP p -> evalPat p $ \ v -> f (VSucc v)+-- DOES NOT WORK SINCE e has unbound variables+      DotP e -> do+        v <- whnf' e+        f v++evalPats :: [Pattern] -> ([Val] -> TypeCheck a) -> TypeCheck a+evalPats [] f = f []+evalPats (p:ps) f = evalPat p $ \ v -> evalPats ps $ \ vs -> f (v:vs)+-}++{-+evalPat :: Pattern -> TypeCheck (State TCContext Val)+evalPat p =+    case p of+      VarP n -> return $ State $ \ ce ->+        let (k, delta) = cxtPushGen (context ce)+            rho = update n (VGen k) (environ ce)+        in  (VGen k, TCContext { context = delta, environ = rho })+      ConP co n [] -> return (VCon co n)+      ConP co n pl -> do+        vl <- mapM evalPat pl+        return (VApp (VCon co n) vl)+      SuccP p -> do+       v <- evalPat p+       return (VSucc v)+-- TODO: does not work!+--      DotP e -> return $ State $ \ ce ->+-}+++++{- 2013-03-31 On instantiation of quantifiers [i < #] - F i++If F is upper semi-continuous then++  [i < #] -> F i   is a sub"set" of   F #++so we can instantiate i to #.  (Hughes et al., POPL 96; Abel, LMCS 08)++1) Consider the special case++  F i = [j < i] -> G i++Because # is a limit, thus, j < i < #  iff j < #, we reason:++  F # = [j < #] -> G j++  [i < #] -> F i+      = [i < #] -> [j < i] -> G j  (since # is a limit)+      = [j < #] -> G j++2) Consider the special case++  F i = [j <= i] -> G j++We have++  F # = [j <= #] -> G j+      = G # /\ ([j < #] -> G j)++  [i < #] -> F i+      = [i < #] -> [j <= i] -> G j+      = [j < #] -> G j++So if G is upper semi-continuous, so is F.++-}+++-- | Check whether a type is upper semi-continuous.+lowerSemiCont :: Int -> TVal -> TypeCheck Bool+lowerSemiCont i tv = errorToBool $ lowerSemiContinuous i tv++docNotLowerSemi i av = text "type " <+> prettyTCM av <+>+  text " not lower semi continuous in " <+> prettyTCM (VGen i)++lowerSemiContinuous :: Int -> TVal -> TypeCheck ()+lowerSemiContinuous i av = do+  av <- force av+  let fallback = szAntitone i av `newErrorDoc` docNotLowerSemi i av++  case av of++    -- [j < i] & F j  is lower semi-cont in i+    -- because [i < #] & [j < i] & F j is the same as [j < #] & F j+    -- [but what if i in FV(F j)? should not matter!] 2013-04-01+    VQuant Sigma x dom@Domain{ typ = VBelow Lt (VGen i') } fv | i == i' -> return ()++    -- [j <= i] & F j  is lower semi-cont in i if F is+    VQuant Sigma x dom@Domain{ typ = VBelow Le (VGen i') } fv | i == i' -> do+      underAbs x dom fv $ \ j xv bv -> lowerSemiContinuous j bv++    -- Sigma-type general case+    VQuant Sigma x dom@Domain{ typ = av } fv -> do+      lowerSemiContinuous i av+      underAbs x dom fv $ \ _ xv bv -> lowerSemiContinuous i bv++    VApp (VDef (DefId DatK n)) vl -> do+      sige <- lookupSymbQ n+      case sige of++        -- finite tuple type+        DataSig { symbTyp = dv, constructors = cis, isTuple = True } -> do+          -- match target of constructor against tv to instantiate+          --  c : ... -> D ps  -- ps = snd (cPatFam ci)+          mrhoci <- Util.firstJustM $ map (\ ci -> fmap (,ci) <$> nonLinMatchList False emptyEnv (snd $ cPatFam ci) vl dv) cis+          case mrhoci of+            Nothing -> fallback+            Just (rho,ci) -> if (cRec ci) then fallback else do+              -- infinite tuples (recursive constructor) are not lower semi cont+              enter ("lowerSemiContinuous: detected tuple type, checking components") $+                allComponentTypes (cFields ci) rho (lowerSemiContinuous i)++       -- i-sized inductive types are lower semi-cont in i+        DataSig { numPars, isSized = Sized, isCo = Ind } | length vl > numPars -> do+          s <- whnfClos $ vl !! numPars -- the size argument is the first fgter the parameters+          case s of+            VGen i' | i == i' -> return ()+            _ -> fallback++        -- finite inductive type+        DataSig { symbTyp = dv, constructors = cis, isCo = Ind } ->+          -- if any cRec cis then fallback else do -- we loop on recursive data, so exclude+          -- check that we do not loop on the same data names...+          ifM ((n `elem`) <$> asks callStack) fallback $ do+          local (\ ce -> ce { callStack = n : callStack ce }) $ do+          -- match target of constructor against tv to instantiate+          --  c : ... -> D ps  -- ps = snd (cPatFam ci)+          forM_ cis $ \ ci -> do+            match <- nonLinMatchList False emptyEnv (snd $ cPatFam ci) vl dv+            Foldable.forM_ match $ \ rho -> do+                enter ("lowerSemiContinuous: detected tuple type, checking components") $+                  allComponentTypes (cFields ci) rho (lowerSemiContinuous i)++        _ -> fallback+    _ -> fallback++-- | Check whether a type is upper semi-continuous.+upperSemiCont :: Int -> TVal -> TypeCheck Bool+upperSemiCont i tv = errorToBool $ endsInSizedCo' False i tv+  -- 2013-03-30+  -- endsInSizedCo needs tv[0/i] = Top+  -- upperSemiCont does not need this, the target can also be constant in i++-- | @endsInSizedCo i tv@ checks that @tv@ is lower semi-continuous in @i@+--   and that @tv[0/i] = Top@.+endsInSizedCo :: Int -> TVal -> TypeCheck ()+endsInSizedCo = endsInSizedCo' True++-- | @endsInSizedCo' False i tv@ checks that @tv@ is lower semi-continuous in @i@.+--   @endsInSizedCo' True i tv@ additionally checks that @tv[0/i] = Top@.+endsInSizedCo' :: Bool -> Int -> TVal -> TypeCheck ()+endsInSizedCo' endInCo i tv  = enterDoc (text "endsInSizedCo:" <+> prettyTCM tv) $ do+   tv <- force tv+   let fallback+         | endInCo = failDoc $ text "endsInSizedCo: target" <+> prettyTCM tv <+> text "of corecursive function is neither a CoSet or codata of size" <+> prettyTCM (VGen i) <+> text "nor a tuple type"+         | otherwise = szMonotone i tv+   case tv of+      VSort (CoSet (VGen i)) -> return ()+      VMeasured mu bv -> endsInSizedCo' endInCo i bv++      -- case forall j <= i. C j coinductive in i+      VQuant Pi x dom@Domain{ typ = VBelow Le (VGen i') } fv | i == i' ->+        underAbs x dom fv $ \ j xv bv ->+          endsInSizedCo' endInCo j bv+      VGuard (Bound Le (Measure [VGen j]) (Measure [VGen i'])) bv | i == i' ->+        endsInSizedCo' endInCo j bv++      -- same case again, written as j < i+1. C j+      VQuant Pi x dom@Domain{ typ = VBelow Lt (VSucc (VGen i')) } fv | i == i' ->+        underAbs x dom fv $ \ j xv bv ->+          endsInSizedCo' endInCo j bv+      VGuard (Bound Lt (Measure [VGen j]) (Measure [VSucc (VGen i')])) bv | i == i' ->+        endsInSizedCo' endInCo j bv++      -- case forall j < i. C j:  already coinductive in i !!+      -- Trivially, forall j < 0. C j is the top type.+      -- And, forall i < # forall j < i  is equivalent to forall j < #+      -- so we can instantiate i to #.+      VGuard (Bound Lt (Measure [VGen j]) (Measure [VGen i'])) bv | i == i' ->+        return ()+      VQuant Pi x dom@Domain{ typ = VBelow Lt (VGen i') } fv | i == i' -> return ()++      VQuant Pi x dom fv -> do+         lowerSemiContinuous i $ typ dom+         underAbs x dom fv $ \ _ xv bv -> endsInSizedCo' endInCo i bv++      VSing _ tv -> endsInSizedCo' endInCo i =<< whnfClos tv+      VApp (VDef (DefId DatK n)) vl -> do+         sige <- lookupSymbQ n+         case sige of+            DataSig { numPars = np, isSized = Sized, isCo = CoInd }+              | length vl > np -> do+                 v <- whnfClos $ vl !! np+                 if isVGeni v then return () else fallback+                   where isVGeni (VGen i) = True+                         isVGeni (VPlus vs) = and $ map isVGeni vs+                         isVGeni (VMax vs)  = and $ map isVGeni vs+                         isVGeni VZero = True+                         isVGeni _ = False+{- WE DO NOT HAVE SUBST ON VALUES!+                 case vl !! np of+                   VGen j -> if i == j then return () else fail1+                   VZero -> return ()+                   VClos rho e -> do+                     v <- whnf (update rho i VZero) e -- BUGGER+                     if v == VZero then return () else fail1+-}+-- we also allow the target to be a tuple if all of its components+-- fulfill "endsInSizedCo"+            DataSig { symbTyp = dv, constructors = cis, isTuple = True } -> do+              allTypesOfTuple tv vl dv cis (endsInSizedCo' endInCo i)+{-+              -- match target of constructor against tv to instantiate+              --  c : ... -> D ps  -- ps = snd (cPatFam ci)+              mrhoci <- Util.firstJustM $ map (\ ci -> fmap (,ci) <$> nonLinMatchList False emptyEnv (snd $ cPatFam ci) vl dv) cis+              case mrhoci of+                Nothing -> failDoc $ text "endsInSizedCo: panic: target type" <+> prettyTCM tv <+> text "is not an instance of any constructor"+                Just (rho,ci) -> enter ("endsInSizedCo: detected tuple target, checking components") $+                  fieldsEndInSizedCo endInCo i (cFields ci) rho+-}+            _ -> fallback+      _ -> fallback+{- failDoc $ text "endsInSizedCo: target" <+> prettyTCM tv <+> text "of corecursive function is neither a function type nor a codata nor a tuple type"+-}++-- | @allTypesOfTyples args dv cis check@ performs @check@ on all component+--   types of tuple type @tv = d args@ where @dv@ is the type of @d@.+allTypesOfTuple :: TVal -> [Val] -> TVal -> [ConstructorInfo] -> (TVal -> TypeCheck ()) -> TypeCheck ()+allTypesOfTuple tv vl dv cis check = do+  -- match target of constructor against tv to instantiate+  --  c : ... -> D ps  -- ps = snd (cPatFam ci)+  mrhoci <- Util.firstJustM $+    map (\ ci -> fmap (,ci) <$> nonLinMatchList False emptyEnv (snd $ cPatFam ci) vl dv) cis+  -- we know that only one constructor can match, otherwise it would not be a tuple type+  case mrhoci of+    Nothing -> failDoc $ text "allTypesOfTuple: panic: target type" <+> prettyTCM tv <+> text "is not an instance of any constructor"+    Just (rho,ci) -> enter ("allTypesOfTuple: detected tuple target, checking components") $+      allComponentTypes (cFields ci) rho check++{-+fieldsEndInSizedCo :: Bool -> Int -> [FieldInfo] -> Env -> TypeCheck ()+fieldsEndInSizedCo endInCo i fis rho0 = allComponentTypes fis rho0 (endsInSizedCo' endInCo i)+fieldsEndInSizedCo endInCo i fis rho0 = enter ("fieldsEndInSizedCo: checking fields of tuple type " ++ show fis ++ " in environment " ++ show rho0) $+  loop fis rho0 where+    loop [] rho = return ()+    -- nothing to check for erased index fields+    loop (f : fs) rho | fClass f == Index && erased (fDec f) =+      loop fs rho+    loop (f : fs) rho | fClass f == Index = do+      tv <- whnf rho (fType f)+      endsInSizedCo' endInCo i tv+      loop fs rho+    loop (f : fs) rho = do+      tv <- whnf rho (fType f)+      when (not $ erased (fDec f)) $ endsInSizedCo' endInCo i tv+      -- for non-index fields, value is not given by matching, so introduce+      -- generic value+      new (fName f) (Domain tv defaultKind (fDec f)) $ \ xv -> do+        let rho' = update rho (fName f) xv+        -- do not need to check erased fields?+        loop fs rho'+-}++-- | @allComponentTypes fis env check@ applies @check@ to all field types+--   in @fis@ (evaluated wrt to environment @env@).+--   Erased fields are skipped.  (Is this correct?)+allComponentTypes :: [FieldInfo] -> Env -> (TVal -> TypeCheck ()) -> TypeCheck ()+allComponentTypes fis rho0 check = enter ("allComponentTypes: checking fields of tuple type " ++ show fis ++ " in environment " ++ show rho0) $+  loop fis rho0 where+    loop [] rho = return ()++    -- nothing to check for erased index fields+    loop (f : fs) rho | fClass f == Index && erased (fDec f) =+      loop fs rho++    -- ordinary index field types are checked+    loop (f : fs) rho | fClass f == Index = do+      check =<< whnf rho (fType f)+      loop fs rho++    -- proper fields+    loop (f : fs) rho = do+      tv <- whnf rho (fType f)+      -- do not need to check erased fields?+      when (not $ erased (fDec f)) $ check tv+      -- for non-index fields, value is not given by matching, so introduce+      -- generic value+      new (fName f) (Domain tv defaultKind (fDec f)) $ \ xv -> do+        loop fs $ update rho (fName f) xv++++endsInCo :: TVal -> TypeCheck Bool+endsInCo tv  = -- traceCheck ("endsInCo: " ++ show tv) $+   case tv of+      VQuant Pi x dom fv -> underAbs x dom fv $ \ _ _ bv -> endsInCo bv++      VApp (VDef (DefId DatK n)) vl -> do+         sige <- lookupSymbQ n+         case sige of+            DataSig { isCo = CoInd } -> -- traceCheck ("found non-sized coinductive target") $+               return True+            _ -> return False+      _ -> return False++-- precondition: Pattern does not contain "Unusable"+admPattern :: Pattern -> TVal -> TypeCheck (Pattern, [Co])+admPattern p tv = traceAdm ("admPattern " ++ show p ++ " type: " ++ show tv) $+  case tv of+      VGuard beta bv -> addBoundHyp beta $ admPattern p bv+      VApp (VDef (DefId DatK d)) vl -> do+         case p of+           ProjP n -> return (p, [])+           _ -> fail "admPattern: IMPOSSIBLE: non-projection pattern for record type"+      VQuant Pi x dom fv -> underAbs x dom fv $ \ k xv bv -> do+  {-+         if p is successor pattern+         check that bv is admissible in k, returning subset of [Ind, CoInd]+         p is usable if either CoInd or it is a var or dot pattern and Ind+-}+         if isSuccessorPattern p then do+           inco <- admType k bv+           when (CoInd `elem` inco && not (shallowSuccP p)) $ cannotMatchDeep p tv+           if (CoInd `elem` inco)+              || (inco /= [] && completeP p)+            then return (p, inco)+            else return (UnusableP p, inco)+          else return (p, [])++      _ -> fail "admPattern: IMPOSSIBLE: pattern for a non-function type"++cannotMatchDeep p tv = recoverFailDoc $+  text "cannot match against deep successor pattern"+    <+> text (show p) <+> text "at type" <+> prettyTCM tv++admType :: Int -> TVal -> TypeCheck [Co]+admType i tv = enter ("admType: checking " ++ show tv ++ " admissible in v" ++ show i) $+    case tv of+       VQuant Pi x dom@(Domain av _ _) fv -> do+          isInd <- szUsed Ind i av+          when (not isInd) $+            szAntitone i av `newErrorDoc` docNotLowerSemi i av+          underAbs x dom fv $ \ gen _ bv -> do+            inco <- admType i bv+            if isInd then return (Ind : inco) else return inco+       _ -> do+          isCoind <- szUsed CoInd  i tv+          if isCoind then return [CoInd]+           else do+            szMonotone i tv+            return []++szUsed :: Co -> Int -> TVal -> TypeCheck Bool+szUsed co i tv = traceAdm ("szUsed: " ++ show tv ++ " " ++ show co ++ " in v" ++ show i) $+    case tv of+         (VApp (VDef (DefId DatK n)) vl) ->+             do sige <- lookupSymbQ n+                case sige of+                  DataSig { numPars = p+                          , isSized = Sized+                          , isCo = co' } | co == co' && length vl > p ->+                      -- p is the number of parameters+                      -- it is also the index of the size argument+                      do s <- whnfClos $ vl !! p+                         case s of+                           VGen i' | i == i' -> return True+                           _ -> return False+                  _ -> return False+         _ -> return False++++-- for inductive fun, and for every size argument i+-- - every argument needs to be either inductive or antitone in i+-- - the result needs to be monotone in i++{- szCheckIndFun admpos delta tv++ entry point for admissibility check for recursive functions+ - scans for the first size quantification+ - passes on to szCheckIndFunSize+ - currently: also continues to look for the next size quantification...+ -}++szCheckIndFun :: [Int] -> TVal -> TypeCheck ()+szCheckIndFun admpos tv = -- traceCheck ("szCheckIndFun: " ++ show delta ++ " |- " ++ show tv ++ " adm?") $+      case tv of+       VQuant Pi x dom fv -> underAbs x dom fv $ \ k _ bv -> do+         -- bv <- whnf' b+         if isVSize (typ dom) then do+             when (k `elem` admpos) $+               szCheckIndFunSize k bv+             szCheckIndFun admpos bv -- this is for lexicographic induction on sizes, I suppose?  Probably should me more fine grained!  Andreas, 2008-12-01+          else szCheckIndFun admpos bv+       _ -> return ()+++{- szCheckIndFunSize delta i tv++ checks whether type tv is admissible for recursion in index i+ - every argument needs to be either inductive or antitone in i+ - the result needs to be monotone in i+ -}++szCheckIndFunSize :: Int -> TVal -> TypeCheck ()+szCheckIndFunSize i tv = -- traceCheck ("szCheckIndFunSize: " ++ show delta ++ " |- " ++ show tv ++ " adm(v" ++ show i ++ ")?") $+    case tv of+       VQuant Pi x dom fv -> do+            szLowerSemiCont i (typ dom)+--            new x dom $ \ k _  -> szCheckIndFunSize i =<< app fv (VGen k)+            underAbs x dom fv $ \ _ _ bv -> szCheckIndFunSize i bv+{-+            new' x dom $ do+              bv <- whnf' b+              szCheckIndFunSize i bv+-}+       _ -> szMonotone i tv++{- szLowerSemiCont++ - check for lower semi-continuity [Abel, CSL 2006]+ - current approximation: inductive type or antitone+ -}+szLowerSemiCont :: Int -> TVal -> TypeCheck ()+szLowerSemiCont i av = -- traceCheck ("szlowerSemiCont: checking " ++ show av ++ " lower semi continuous in v" ++ show i) $+   (szAntitone i av `catchError`+      (\ msg -> -- traceCheck (show msg) $+                   szInductive i av))+        `newErrorDoc` docNotLowerSemi i av+++{- checking cofun-types for admissibility++conditions:++1. type must end in coinductive type or in sized coinductive type+   indexed by just a variable i which has been quantified in the type++2. in the second case, each argument must be inductive or antitone in i+   optimization:+     arguments types before the quantification over i can be ignored+-}++data CoFunType+  = CoFun             -- yes, but not sized cotermination+  | SizedCoFun Int    -- yes an admissible sized type (the Int specifies the number of the recursive size argument)++{-+design:++admCoFun delta tv : IsCoFunType++   endsInCo delta tv (len delta) id++admEndsInCo delta tv firstVar jobs : IsCoFunType++   traverse tv, gather continutations in jobs, check for CoInd in the end++   if tv = (x:A) -> B+      push A on delta+      add the following task to jobs:+        check A for lower semicontinuity in delta+      continue on B++   if tv = Codata^i+      run (jobs i)+      if they return (), return YesSized Int, otherwise No++   if tv = Codata+      return Yes++   otherwise+      return No+ -}++-- {- TODO: FINISH THIS!!++admCoFun :: TVal -> TypeCheck CoFunType+admCoFun tv = do+  l <- getLen+  admEndsInCo tv l (\ i -> return ())++admEndsInCo :: TVal -> Int -> (Int -> TypeCheck ()) -> TypeCheck CoFunType+admEndsInCo tv firstVar jobs = -- traceCheck ("admEndsInCo: " ++ show tv) $+   case tv of+      VQuant Pi x dom fv -> do+         l <- getLen+         let jobs' = (addJob l (typ dom) jobs)+         underAbs x dom fv $ \ _ _ bv -> admEndsInCo bv firstVar jobs'+{-+         new' x dom $ do+           bv <- whnf' b+           admEndsInCo bv firstVar jobs'+-}++{-+      -- if not applied, it cannot be a sized type+      VDef n -> do+         sig <- gets signature+         case (lookupSig n sig) of+            DataSig { isCo = CoInd } -> -- traceCheck ("found non-sized coinductive target") $+               return CoFun+            _ -> throwErrorMsg $ "type of cofun does not end in coinductive type"+-}++      VApp (VDef (DefId DatK n)) vl -> do+         sige <- lookupSymbQ n+         case sige of+            DataSig { isSized = NotSized, isCo = CoInd } -> -- traceCheck ("found non-sized coinductive target") $+               return CoFun+            DataSig { numPars = p, isSized = Sized, isCo = CoInd } | length vl > p -> -- traceCheck ("found sized coinductive target") $+              do+               -- p is the number of parameters+               -- it is also the index of the size argument+               s <- whnfClos $ vl !! p+               case s of+                  VGen i -> do+                     jobs i+                     return $ SizedCoFun $ i - firstVar+                  _ -> throwErrorMsg $ "size argument in result type must be a variable"+            _ -> throwErrorMsg $ "type of cofun does not end in coinductive type"++addJob :: Int -> TVal -> (Int -> TypeCheck ())+       -> (Int -> TypeCheck ())+addJob l tv jobs recVar = do+  -- is the "recursive" size variable actually in scope?+  jobs recVar+  when (recVar < l) $ szLowerSemiCont recVar tv++-- -}+++{- szCheckCoFun  OBSOLETE!!++ entry point for admissibility check for corecursive functions+ - scans for the first size quantification+ - passes on to szCheckIndFunSize+ - currently: also continues to look for the next size quantification+ - and checks in the end whether the target is a coinductive type+++-- STALE COMMENT: for a cofun : arguments nocc i and result coinductive in i+szCheckCoFun :: SemCxt -> TVal -> TypeCheck ()+szCheckCoFun delta tv =+      case tv of+       VPi dec x av env b -> do+                let (k, delta') = cxtPush dec av delta+                bv <- whnf (update env x (VGen k)) b+                case av of+                  VSize -> do szCheckCoFunSize delta' k bv+                              szCheckCoFun delta' bv+                  _ -> szCheckCoFun delta' bv+       -- result+       (VApp (VDef n) vl) ->+          do sig <- gets signature+             case (lookupSig n sig) of+               (DataSig _ _ _ CoInd _) ->+                   return ()+               _ -> throwErrorMsg $ "cofun doesn't target coinductive type"+       (VDef n)  ->+          do sig <- gets signature+             case (lookupSig n sig) of+               (DataSig _ _ _ CoInd _) ->+                   return ()+               _ -> throwErrorMsg $ "cofun doesn't target coinductive type"+       _ -> throwErrorMsg $ "cofun doesn't target coinductive type"++szCheckCoFunSize :: SemCxt -> Int -> TVal -> TypeCheck ()+szCheckCoFunSize delta i tv = -- traceCheck ("szco " ++ show tv) $+      case tv of+       VPi dec x av env b ->  do+             let (k, delta') = cxtPush dec av delta+             bv <- whnf (update env x (VGen k)) b+             szLowerSemiCont delta i av+             szCheckCoFunSize delta' i bv+       -- result must be coinductive+       _ -> szCoInductive delta i tv++-}++szMono :: Co -> Int -> TVal -> TypeCheck ()+szMono co i tv =+    case co of+         Ind   -> szMonotone i tv+         CoInd -> szAntitone i tv++szMonotone :: Int -> TVal -> TypeCheck ()+szMonotone i tv = traceCheck ("szMonotone: " -- ++ show delta ++ " |- "+                              ++ show tv ++ " mon(v" ++ show i ++ ")?") $+ do+   let si = VSucc (VGen i)+   tv' <- substitute (sgSub i si) tv+   leqVal Pos vTopSort tv tv'++szAntitone :: Int -> TVal -> TypeCheck ()+szAntitone i tv = traceCheck ("szAntitone: " -- ++ show delta ++ " |- "+                              ++ show tv ++ " anti(v" ++ show i ++ ")?") $+ do+   let si = VSucc (VGen i)+   tv' <- substitute (sgSub i si) tv+   leqVal Neg vTopSort tv tv'++-- checks if tv is a sized inductive type of size i+szInductive :: Int -> TVal -> TypeCheck ()+szInductive i tv = szUsed' Ind i tv++-- checks if tv is a sized coinductive type of size i+szCoInductive :: Int -> TVal -> TypeCheck ()+szCoInductive i tv = szUsed' CoInd i tv++szUsed' :: Co -> Int -> TVal -> TypeCheck ()+szUsed' co i tv =+    case tv of+         (VApp (VDef (DefId DatK n)) vl) ->+             do sige <- lookupSymbQ n+                case sige of+                  DataSig { numPars = p, isSized = Sized, isCo =  co' } | co == co' && length vl > p ->+                      -- p is the number of parameters+                      -- it is also the index of the size argument+                      do s <- whnfClos $ vl !! p+                         case s of+                           VGen i' | i == i' -> return ()+                           _ -> fail $ "expected size variable"+                  _ -> fail $ "expected (co)inductive sized type"+         _ -> fail $ "expected (co)inductive sized type"
+ Util.hs view
@@ -0,0 +1,241 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE TupleSections, NoMonomorphismRestriction,+      FlexibleInstances, MultiParamTypeClasses, FunctionalDependencies #-}++module Util where++import Prelude hiding (showList, null)++import Control.Applicative hiding (empty)+import Control.Monad.Writer (Writer, runWriter, All, getAll)++import qualified Data.List as List+import Data.Map (Map)+import qualified Data.Map as Map+import Debug.Trace++import Text.PrettyPrint as PP++(+?+) :: String -> String -> String+(+?+) xs "[]" = []+(+?+) xs ys = xs ++ ys++implies :: Bool -> Bool -> Bool+implies a b = if a then b else True++class Pretty a where+    pretty	:: a -> Doc+    prettyPrec	:: Int -> a -> Doc++    pretty	= prettyPrec 0+    prettyPrec	= const pretty++instance Pretty Doc where+    pretty = id++angleBrackets :: Doc -> Doc+angleBrackets d = text "<" <+> d <+> text ">"++-- | Apply when condition is @True@.+fwhen :: Bool -> (a -> a) -> a -> a+fwhen True  f a = f a+fwhen False f a = a++parensIf :: Bool -> Doc -> Doc+parensIf b = fwhen b PP.parens++hsepBy :: Doc -> [Doc] -> Doc+hsepBy sep [] = empty+hsepBy sep [d] = d+hsepBy sep (d:ds) = d <> sep <> hsepBy sep ds++pwords :: String -> [Doc]+pwords = map text . words++fwords :: String -> Doc+fwords = fsep . pwords++fromAllWriter :: Writer All a -> (Bool, a)+fromAllWriter m = let (a, w) = runWriter m+                  in  (getAll w, a)++traceM :: (Monad m) => String -> m ()+traceM msg = trace msg $ return ()++infixr 9 <.>++-- | Composition: pure function after monadic function.+(<.>) :: Functor m => (b -> c) -> (a -> m b) -> a -> m c+(f <.> g) a = f <$> g a++liftMaybe :: (Monad m) => Maybe a -> m a+liftMaybe = maybe (fail "Util.liftMaybe: unexpected Nothing") return++whenJust :: (Monad m) => Maybe a -> (a -> m ()) -> m ()+whenJust (Just a) k = k a+whenJust Nothing  k = return ()++whenNothing :: (Monad m) => Maybe a -> m () -> m ()+whenNothing Nothing m = m+whenNothing Just{}  m = return ()++ifNothingM :: (Monad m) => m (Maybe a) -> m b -> (a -> m b) -> m b+ifNothingM mma mb f = maybe mb f =<< mma++ifJustM :: (Monad m) => m (Maybe a) -> (a -> m b) -> m b -> m b+ifJustM mma f mb = maybe mb f =<< mma++lookupM :: (Monad m, Show k, Ord k) => k -> Map k v -> m v+lookupM k m = maybe (fail $ "lookupM: unbound key " ++ show k) return $ Map.lookup k m++mapMapM :: (Monad m, Ord k) => (a -> m b) -> Map k a -> m (Map k b)+mapMapM f = Map.foldrWithKey step (return $ Map.empty)+  where step k a m = do a' <- f a+                        m' <- m+                        return $ Map.insert k a' m'++ifM :: Monad m => m Bool -> m a -> m a -> m a+ifM c d e = do { b <- c ; if b then d else e }++{- Control.Monad.IfElse+whenM :: Monad m => m Bool -> m () -> m ()+whenM c d = do { b <- c; if b then d else return () }++unlessM :: Monad m => m Bool -> m () -> m ()+unlessM c e = do { b <- c; if b then return () else e }+-}++andLazy :: Monad m => m Bool -> m Bool -> m Bool+andLazy ma mb = ifM ma mb $ return False++andM  :: Monad m => [m Bool] -> m Bool+andM []     = return True+andM (m:ms) = m `andLazy` andM ms++findM :: Monad m => (a -> m Bool) -> [a] -> m (Maybe a)+findM p []       = return Nothing+findM p (x : xs) = do b <- p x+                      if b then return (Just x) else findM p xs++-- | Binary version of @=<<@.+(==<<) :: Monad m => (a -> b -> m c) -> (m a, m b) -> m c+f ==<< (ma, mb) = do { a <- ma; f a =<< mb }++parens :: String -> String+parens s = "(" ++ s ++ ")"++brackets :: String -> String+brackets s = "[" ++ s ++ "]"++bracketsIf :: Bool -> String -> String+bracketsIf False s = s+bracketsIf True  s = "[" ++ s ++ "]"++separate :: String -> String -> String -> String+separate sep "" y = y+separate sep x "" = x+separate sep x y  = x ++ sep ++ y++showList :: String -> (a -> String) -> [a] -> String+showList sep f [] = ""+showList sep f [e] = f e+showList sep f (e:es) = f e ++ sep ++ showList sep f es+-- OR: showList sep f es = foldl separate "" $ map f es++hasDuplicate :: (Eq a) => [a] -> Bool+hasDuplicate [] = False+hasDuplicate (x : xs) = x `elem` xs || hasDuplicate xs++compressMaybes :: [Maybe a] -> [a]+compressMaybes = concat . map (maybe [] (\ a -> [a]))++mapFst :: (a -> c) -> (a,d) -> (c,d)+mapFst f (a,b) = (f a, b)++mapSnd :: (b -> d) -> (a,b) -> (a,d)+mapSnd f (a,b) = (a, f b)++mapPair :: (a -> c) -> (b -> d) -> (a,b) -> (c,d)+mapPair f g (a,b) = (f a, g b)++zipPair :: (a -> b -> c) -> (d -> e -> f) -> (a,d) -> (b,e) -> (c,f)+zipPair f g (a,d) (b,e) = (f a b, g d e)++headMaybe :: [a] -> Maybe a+headMaybe [] = Nothing+headMaybe (a:as) = Just a++headM :: Monad m => [a] -> m a+headM [] = fail "headM"+headM (a:as) = return a++firstJust :: [Maybe a] -> Maybe a+firstJust = headMaybe . compressMaybes++firstJustM :: Monad m => [m (Maybe a)] -> m (Maybe a)+firstJustM [] = return Nothing+firstJustM (mm : mms) = do+  m <- mm+  case m of+    Nothing -> firstJustM mms+    Just{}  -> return m++mapOver :: (Functor f) => f a -> (a -> b) -> f b+mapOver = flip fmap++for = mapOver++mapAssoc :: (a -> b) -> [(n,a)] -> [(n,b)]+mapAssoc f = map (\ (n, a) -> (n, f a))++mapAssocM :: (Applicative m, Monad m) => (a -> m b) -> [(n,a)] -> m [(n,b)]+mapAssocM f = mapM (\ (n, a) -> (n,) <$> f a)++compAssoc :: Eq b => [(a,b)] -> [(b,c)] -> [(a,c)]+compAssoc xs ys = [ (a,c) | (a,b) <- xs, (b',c) <- ys, b == b' ]++-- * Lists and stacks of lists++class Push a b where+  push    :: a -> b -> b++instance Push a [a] where+  push = (:)++instance Push a [[a]] where+  push a (b:bs) = (a : b) : bs++-- TOO HARD for ghc:+-- instance Push a b => Push a [b] where+--   push a (b:bs) = push a b : bs++class Retrieve a b c | b -> c where+  retrieve :: Eq a => a -> b -> Maybe c++instance Retrieve a [(a,b)] b where+  retrieve = lookup++instance Retrieve a [[(a,b)]] b where+  retrieve a = retrieve a . concat++-- instance Retrieve a b c => Retrieve a [b] c where+--   retrieve a = firstJust . map (retrieve a)++{-+class ListLike a where+  length :: a -> Int+  null   :: a -> Bool+  nil    :: a+-}++class Size a where+  size :: a -> Int++instance Size [a] where+  size = length++class Null a where+  null :: a -> Bool++instance Null [a] where+  null = List.null
+ Value.hs view
@@ -0,0 +1,410 @@+{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}++module Value where++import Prelude hiding (null)++import Control.Applicative++import qualified Data.List as List+import Data.Set (Set)+import qualified Data.Set as Set+import Debug.Trace++import Abstract+import Polarity+import Util+import TraceError -- orM++-- call-by-value+-- cofuns are not forced++data Val+  -- sizes+  = VInfty+  | VZero+  | VSucc Val+  | VMax [Val]+  | VPlus [Val]+  | VMeta MVar Env Int           -- X rho + n  (n-fold successor of X rho)+  -- types+  | VSort (Sort Val)+  | VMeasured (Measure Val) Val  -- mu -> A  (only in checkPattern)+  | VGuard (Bound Val) Val       -- mu<mu' -> A+  | VBelow LtLe Val              -- domain in bounded size quant.+  | VQuant+    { vqPiSig :: PiSigma+    , vqName  :: Name+    , vqDom   :: Domain+    , vqFun   :: FVal+    }+  | VSing Val TVal               -- Singleton type (TVal not Pi)+  -- functions+  | VLam Name Env Expr+  | VAbs Name Int Val Valuation  -- abstract free variable+  | VConst Val                   -- constant function+  | VUp Val TVal                 -- delayed eta expansion; TVal is a Pi+  -- values+  | VRecord RecInfo EnvMap       -- a record value / fully applied constructor+  | VPair Val Val                -- eager pair+  -- neutrals+  | VGen Int                     -- free variable (de Bruijn level)+  | VDef DefId                   -- co(data/constructor/fun)+                                 -- VDef occurs only inside a VApp!+  | VCase Val TVal Env [Clause]+  | VApp Val [Clos]+  -- closures+  | VProj PrePost Name           -- a projection as an argument to a neutral+  | VClos Env Expr               -- closure for cbn evaluation+  -- don't care+  | VIrr                         -- erased hypothetical inhabitant of empty type+    deriving (Eq,Ord)++-- | Makes constant function if name is empty.+vLam :: Name -> Env -> Expr -> FVal+vLam x env e+  | emptyName x = VConst $ VClos env e+  | otherwise   = VLam x env e++-- | Is a value a function?  May become more @True@ after forcing the @VUp@.+isFun :: Val -> Bool+isFun VLam{}                         = True+isFun VAbs{}                         = True+isFun VConst{}                       = True+isFun (VUp _ VQuant{ vqPiSig = Pi }) = True+isFun v                              = False++absName :: FVal -> Name+absName fv =+  case fv of+    VLam x _ _              -> x+    VAbs x _ _ _            -> x+    VUp _ (VQuant Pi x _ _) -> x+    _                       -> noName++type FVal = Val+type TVal = Val -- type value+type Clos = Val+type Domain = Dom TVal++-- | Valuation of free variables.+newtype Valuation = Valuation { valuation :: [(Int,Val)] }+  deriving (Eq,Ord)++emptyVal  = Valuation []+sgVal i v = Valuation [(i,v)]++valuateGen :: Int -> Valuation -> Val+valuateGen i valu = maybe (VGen i) id $ lookup i $ valuation valu++type TeleVal = [TBinding Val]++data Environ a = Environ+  { envMap   :: [(Name,a)]          -- the actual map from names to values+  , envBound :: Maybe (Measure Val) -- optionally the current termination measure+  }+               deriving (Eq,Ord,Show)++type EnvMap = [(Name,Val)]+type Env = Environ Val++{-+data MeasVal = MeasVal [Val]  -- lexicographic termination measure+               deriving (Eq,Ord,Show)+-}++-- smart constructors ------------------------------------------------++-- | The value representing type Size.+vSize :: Val+vSize = VBelow Le VInfty -- 2012-01-28 non-termination bug I have not found+-- vSize = VSort $ SortC Size++vFinSize = VBelow Lt VInfty++-- | Ensure we construct the correct value representing Size.+vSort :: Sort Val -> Val+vSort (SortC Size) = vSize+vSort s            = VSort s++isVSize :: Val -> Bool+isVSize (VSort (SortC Size)) = True+isVSize (VBelow Le VInfty)   = True+isVSize _                    = False++vTSize = VSort $ SortC TSize++vTopSort :: Val+vTopSort = VSort $ Set VInfty++mkClos :: Env -> Expr -> Val+mkClos rho Infty       = VInfty+mkClos rho Zero        = VZero+-- mkClos rho (Succ e)    = VSucc (mkClos rho e)  -- violates an invariant!! succeed/crazys+mkClos rho (Below ltle e) = VBelow ltle (mkClos rho e)+mkClos rho (Proj fx n) = VProj fx n+mkClos rho (Var x) = lookupPure rho x+mkClos rho (Ann e) = mkClos rho $ unTag e+mkClos rho e = VClos rho e+  -- Problem with MetaVars: freeVars of a meta var is unknown in this repr.!+  -- VClos (rho { envMap = filterEnv (freeVars e) (envMap rho)}) e++filterEnv :: Set Name -> EnvMap -> EnvMap+filterEnv ns [] = []+filterEnv ns ((x,v) : rho) =+  if Set.member x ns then (x,v) : filterEnv (Set.delete x ns) rho+   else filterEnv ns rho++vDef id   = VDef id `VApp` []+vCon co n = vDef $ DefId (ConK co) n+-- vCon co n = vDef $ DefId (ConK (coToConK co)) n+vFun n    = vDef $ DefId FunK $ QName n+vDat n    = vDef $ DefId DatK n++{- POSSIBLY BREAKS INVARIANT!+vApp :: Val -> [Val] -> Val+vApp f [] = f+vApp f vs = VApp f vs+-}++failValInv :: (Monad m) => Val -> m a+failValInv v = fail $ "internal error: value " ++ show v ++ " violates representation invariant"++vAbs :: Name -> Int -> Val -> FVal+vAbs x i v = VAbs x i v emptyVal++arrow , prod :: TVal -> TVal -> TVal+arrow = quant Pi+prod  = quant Sigma++quant piSig a b = VQuant piSig x (defaultDomain a) (VConst b)+  where x   = fresh ""+-- quant piSig a b = VQuant piSig x (defaultDomain a) (Environ [(bla,b)] Nothing) (Var bla)+--   where x   = fresh ""+--         bla = fresh "#codom"+++-- * Sizes ------------------------------------------------------------++-- Sizes form a commutative semiring with multiplication (Plus) and+-- idempotent addition (Max)+--+-- Wellformed size values are polynomials, i.e., sums (Max) of products (Plus).+-- A monomial m takes one of the forms (k stands for a variable: VGen or VMeta)+-- 0. VSucc^* VZero+-- 1. VSucc^* k+-- 2. VSucc^* (VPlus [k1,...,kn])   where n>=2+-- A polynomial takes one of the forms+-- 0. VInfty+-- 1. m+-- 2. VMax ms  where length ms >= 2 and each mi different+{- OLD+-- * VSucc^* VGen+-- * VMax vs where each v_i = VSucc^* (VGen k_i) and all k_i different+--           and vs has length >= 2+-}+--+-- the smart constructors construct wellformed size values using the laws+-- $ #             = #                Infty+-- max # k         = #+-- $ (max i j)     = max ($ i) ($ j)  $ distributes over max+-- max (max i j) k = max i j k        Assoc-Commut of max+-- max i i         = i                Idempotency of max+succSize :: Val -> Val+succSize v = case v of+            VInfty -> VInfty+            VMax vs -> maxSize $ map succSize vs+            VMeta i rho n -> VMeta i rho (n + 1)  -- TODO: integrate + and mvar+            _ -> VSucc v+vSucc = succSize++-- "multiplication" of sizes+plusSize :: Val -> Val -> Val+plusSize VZero v = v+plusSize v VZero = v+plusSize VInfty v = VInfty+plusSize v VInfty = VInfty+plusSize (VMax vs) v = maxSize $ map (plusSize v) vs+plusSize v (VMax vs) = maxSize $ map (plusSize v) vs+plusSize (VSucc v) v' = succSize $ plusSize v v'+plusSize v' (VSucc v) = succSize $ plusSize v v'+plusSize (VPlus vs) (VPlus vs') = VPlus $ List.sort (vs ++ vs') -- every summand is a var!  -- TODO: more efficient sorting!+plusSize (VPlus vs) v = VPlus $ List.insert v vs+plusSize v (VPlus vs) = VPlus $ List.insert v vs+plusSize v v' = VPlus $ List.sort [v,v']++plusSizes :: [Val] -> Val+plusSizes [] = VZero+plusSizes [v] = v+plusSizes (v:vs) = v `plusSize` (plusSizes vs)++-- maxSize vs = VInfty                 if any v_i=Infty+--            = VMax (sort (nub (flatten vs)) else+-- precondition vs++maxSize :: [Val] -> Val+maxSize vs = case Set.toList . Set.fromList <$> flatten vs of+   Nothing -> VInfty+   Just [] -> VZero+   Just [v] -> v+   Just vs' -> VMax vs'+  where flatten (VZero:vs) = flatten vs+        flatten (VInfty:_) = Nothing+        flatten (VMax vs:vs') = flatten vs' >>= return . (vs++)+        flatten (v:vs) = flatten vs >>= return . (v:)+        flatten [] = return []++{-+maxSize :: [Val] -> Val+maxSize vs = case flatten [] vs of+   [] -> VInfty+   [v] -> v+   vs' -> VMax vs'+  where flatten acc (VInfty:_) = []+        flatten acc (VMax vs:vs') = flatten (vs ++ acc) vs'+        flatten acc (v:vs) = flatten (v:acc) vs+        flatten acc [] = Set.toList $ Set.fromList acc -- sort, nub+-}++-- * destructors -------------------------------------------------------++vSortToSort :: Sort Val -> Sort Expr+vSortToSort (SortC c)    = SortC c+vSortToSort (Set VInfty) = Set Infty++predSize :: Val -> Maybe Val+predSize VInfty = Just VInfty+predSize (VSucc v) = Just v+predSize (VMax vs) = do vs' <- mapM predSize vs+                        return $ maxSize vs'+predSize (VMeta v rho n) | n > 0 = return $ VMeta v rho (n-1)+predSize _ = Nothing -- variable or zero or sum++instance HasPred Val where+  predecessor VInfty = Nothing -- for printing bounds+  predecessor v = predSize v++isFunType :: TVal -> Bool+isFunType VQuant{ vqPiSig = Pi } = True+isFunType _                      = False++isDataType :: TVal -> Bool+isDataType (VApp (VDef (DefId DatK _)) _) = True+isDataType (VSing v tv) = isDataType tv+isDataType _ = False++-- * ugly printing -----------------------------------------------------++instance Show (Sort Val) where+  show (SortC c) = show c+  show (Set VZero) = "Set"+  show (CoSet VInfty) = "Set"+  show (Set v) = parens $ ("Set " ++ show v)+  show (CoSet v) = parens $ ("CoSet " ++ show v)++instance Show Val where+  show v | isVSize v = "Size"+  show (VSort s) = show s+  show VInfty = "#"+  show VZero = "0"+  show (VSucc v) = "($ " ++ show v ++ ")"+  show (VMax vl) = "(max " ++ showVals vl ++ ")"+  show (VPlus (v:vl)) = parens $ foldr (\ v s -> show v ++ " + " ++ s) (show v) vl+  show (VApp v []) = show v+  show (VApp v vl) = "(" ++ show v ++ " " ++ showVals vl ++ ")"+  show (VDef id) = show id+  show (VProj Pre id) = show id+  show (VProj Post id) = "." ++ show id+  show (VPair v1 v2) = "(" ++ show v1 ++ ", " ++ show v2 ++ ")"+  show (VGen k) = "v" ++ show k+  show (VMeta k rho 0) = "?" ++ show k ++ showEnv rho+  show (VMeta k rho 1) = "$?" ++ show k ++ showEnv rho+  show (VMeta k rho n) = "(?" ++ show k ++ showEnv rho ++ " + " ++ show n ++")"+  show (VRecord ri env) = show ri ++ "{" ++ Util.showList "; " (\ (n, v) -> show n ++ " = " ++ show v) env ++ "}"+  show (VCase v vt env cs) = "case " ++ show v ++ " : " ++ show vt ++ " { " ++ showCases cs ++ " } " ++ showEnv env+  show (VClos (Environ [] Nothing) e) = showsPrec precAppR e ""+  show (VClos env e) = "{" ++ show e ++ " " ++ showEnv env ++ "}"+  show (VSing v vt) = "<" ++ show v ++ " : " ++ show vt ++ ">"+  show VIrr  = "."+  show (VMeasured mu tv) = parens $ show mu ++ " -> " ++ show tv+  show (VGuard beta tv) = parens $ show beta ++ " -> " ++ show tv+  show (VBelow ltle v) = show ltle ++ " " ++ show v++  show (VQuant pisig x (Domain (VBelow ltle v) ki dec) bv)+       | (ltle,v) /= (Le,VInfty) =+       parens $ (\ p -> if p==defaultPol then "" else show p) (polarity dec) +++                (if erased dec then brackets binding else parens binding)+                 ++ " " ++ show pisig ++ " " ++ showSkipLambda bv+            where binding = show x ++ " " ++ show ltle ++ " " ++ show v++  show (VQuant pisig x (Domain av ki dec) bv) =+        parens $ (\ p -> if p==defaultPol then "" else show p) (polarity dec) +++                (if erased dec then brackets binding+                  else if emptyName x then s1 else parens binding)+                    ++ " " ++ show pisig ++ " " ++ showSkipLambda bv+             where s1 = s2 ++ s0+                   s2 = show av+                   s3 = show ki+                   s0 = if ki == defaultKind || s2 == s3 then "" else "::" ++ s3+                   binding = if emptyName x then  s1 else show x ++ " : " ++ s1++  show (VLam x env e) = "(\\" ++ show x ++ " -> " ++ show e ++ showEnv env ++ ")"+  show (VConst v) = "(\\ _ -> " ++ show v ++ ")"+  show (VAbs x i v valu) = "(\\" ++ show x ++ "@" ++ show i ++ show v ++ showValuation valu ++ ")"+  show (VUp v vt) = "(" ++ show v ++ " Up " ++ show vt ++ ")"++showSkipLambda v =+  case v of+    (VLam x env e)    -> show e ++ showEnv env+    (VConst v)        -> show v+    (VAbs x i v valu) -> show v ++ showValuation valu+    v                 -> show v++showVals :: [Val] -> String+showVals [] = ""+showVals (v:vl) = show v ++ (if null vl then "" else " " ++ showVals vl)++-- environment ---------------------------------------------------++emptyEnv :: Environ a+emptyEnv = Environ [] Nothing++appendEnv :: Environ a -> Environ a -> Environ a+appendEnv (Environ rho mmeas) (Environ rho' mmeas') =+  Environ (rho ++ rho') (orM mmeas mmeas')++-- | enviroment extension / update+update :: Environ a -> Name -> a -> Environ a+update env n v | emptyName n = env+               | otherwise   = env { envMap = (n,v) : envMap env }++lookupPure :: Show a => Environ a -> Name -> a+lookupPure rho x =+    case lookup x (envMap rho) of+      Just v -> v+      Nothing -> error $ "lookupPure: unbound identifier " ++ show x ++ " in environment " ++ show rho++lookupEnv :: Monad m => Environ a -> Name -> m a+lookupEnv rho x =+    case lookup x (envMap rho) of+      Just v -> return $ v+      Nothing -> fail $ "lookupEnv: unbound identifier " ++ show x --  ++ " in environment " ++ show rho+{-+lookupEnv :: Monad m => Environ a -> Name -> m a+lookupEnv [] n = fail $ "lookupEnv: identifier " ++ show n ++ " not bound"+lookupEnv ((x,v):xs) n = if x == n then return v+                          else lookupEnv xs n+-}++showValuation :: Valuation -> String+showValuation (Valuation [])  = ""+showValuation (Valuation tau) = "{" ++ Util.showList ", " (\(i,v) -> show i ++ " = " ++ show v) tau ++ "}"++showEnv :: Environ Val -> String+showEnv (Environ [] Nothing)   = ""+showEnv (Environ rho Nothing)  = "{" ++ showEnv' rho ++ "}"+showEnv (Environ [] (Just mu)) = "{ measure=" ++ show mu ++ " }"+showEnv (Environ rho (Just mu)) = "{" ++ showEnv' rho ++ " | measure=" ++ show mu ++ " }"++showEnv' :: EnvMap -> String+showEnv' = Util.showList ", " (\ (n,v) -> show n ++ " = " ++ show v)
+ Value.hs-boot view
@@ -0,0 +1,10 @@+module Value where++import {-# SOURCE #-} Abstract++data Val+instance Eq Val+instance Ord Val+instance Show Val++type TeleVal = [TBinding Val]
+ Warshall.hs view
@@ -0,0 +1,433 @@+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}++module Warshall where++{- construct a graph from constraints++   x + n <= y   becomes   x ---(-n)---> y+   x <= n + y   becomes   x ---(+n)---> y++the default edge (= no edge is) labelled with infinity++building the graph involves keeping track of the node names.+We do this in a finite map, assigning consecutive numbers to nodes.+-}+++import Control.Monad.State+import Data.Maybe -- fromJust+import Data.Array+import Data.Map (Map)+import qualified Data.Map as Map+import qualified Data.List as List++import Debug.Trace+import Util+++traceSolve msg a = a -- trace msg a +traceSolveM msg = return () -- traceM msg+{-+traceSolve msg a = trace msg a +traceSolveM msg = traceM msg+-}+++-- semi rings ----------------------------------------------------++class SemiRing a where+  oplus  :: a -> a -> a+  otimes :: a -> a -> a+  ozero  :: a -- neutral for oplus, dominant for otimes+  oone   :: a -- neutral for otimes++type Matrix a = Array (Int,Int) a++-- assuming a square matrix+warshall :: SemiRing a => Matrix a -> Matrix a+warshall a0 = loop r a0 where +  b@((r,c),(r',c')) = bounds a0 -- assuming r == c and r' == c'+  loop k a | k <= r' = +    loop (k+1) (array b [ ((i,j), +                           (a!(i,j)) `oplus` ((a!(i,k)) `otimes` (a!(k,j))))+                        | i <- [r..r'], j <- [c..c'] ])+           | otherwise = a++-- edge weight in the graph, forming a semi ring ++data Weight = Finite Int | Infinite +              deriving (Eq)++inc :: Weight -> Int -> Weight+inc Infinite   n = Infinite+inc (Finite k) n = Finite (k + n)++instance Show Weight where+  show (Finite i) = show i+  show Infinite   = "."++instance Ord Weight where+  a <= Infinite = True+  Infinite <= b = False+  Finite a <= Finite b = a <= b++instance SemiRing Weight where+  oplus = min++  otimes Infinite _ = Infinite+  otimes _ Infinite = Infinite+  otimes (Finite a) (Finite b) = Finite (a + b)++  ozero = Infinite+  oone  = Finite 0+ +-- constraints ---------------------------------------------------++-- nodes of the graph are either +-- * flexible variables (with identifiers drawn from Int), +-- * rigid variables (also identified by Ints), or +-- * constants (like 0, infinity, or anything between)++data Node rigid+  = Rigid rigid+  | Flex  FlexId+    deriving (Eq, Ord)++instance Show rigid => Show (Node rigid) where+  show (Flex  i) = "?" ++ show i+  show (Rigid r) = show r++data Rigid = RConst Weight+           | RVar RigidId+             deriving (Eq, Ord)++instance Show Rigid where+  show (RVar i) = "v" ++ show i+  show (RConst Infinite)   = "#"+  show (RConst (Finite n)) = show n++type NodeId  = Int+type RigidId = Int+type FlexId  = Int+type Scope   = RigidId -> Bool  +-- which rigid variables a flex may be instatiated to++infinite (RConst Infinite) = True+infinite _ = False++-- isBelow r w r'  +-- checks, if r and r' are connected by w (meaning w not infinite)+-- wether r + w <= r'+-- precondition: not the same rigid variable+isBelow :: Rigid -> Weight -> Rigid -> Bool+isBelow _ Infinite _ = True+isBelow _ n (RConst Infinite) = True+-- isBelow (RConst Infinite)   n (RConst (Finite _)) = False+isBelow (RConst (Finite i)) (Finite n) (RConst (Finite j)) = i + n <= j+isBelow _ _ _ = False -- rigid variables are not related++-- a constraint is an edge in the graph+data Constrnt edgeLabel rigid flexScope+  = NewFlex FlexId flexScope+  | Arc (Node rigid) edgeLabel (Node rigid)+-- Arc v1 k v2  at least one of v1,v2 is a VMeta (Flex), +--              the other a VMeta or a VGen (Rigid)+-- if k <= 0 this means  $^(-k) v1 <= v2+-- otherwise                    v1 <= $^k v3++type Constraint = Constrnt Weight Rigid Scope++arc :: Node Rigid -> Int -> Node Rigid -> Constraint+arc a k b = Arc a (Finite k) b++instance Show Constraint where+  show (NewFlex i s) = "SizeMeta(?" ++ show i ++ ")"+  show (Arc v1 (Finite k) v2) +    | k == 0 = show v1 ++ "<=" ++ show v2+    | k < 0  = show v1 ++ "+" ++ show (-k) ++ "<=" ++ show v2+    | otherwise  = show v1 ++ "<=" ++ show v2 ++ "+" ++ show k++type Constraints = [Constraint]++emptyConstraints = []++-- graph (matrix) ------------------------------------------------++data Graph edgeLabel rigid flexScope = Graph +  { flexScope :: Map FlexId flexScope       -- scope for each flexible var+  , nodeMap :: Map (Node rigid) NodeId      -- node labels to node numbers+  , intMap  :: Map NodeId (Node rigid)      -- node numbers to node labels+  , nextNode :: NodeId                      -- number of nodes (n)+  , graph :: NodeId -> NodeId -> edgeLabel  -- the edges (restrict to [0..n[)+  }++-- the empty graph: no nodes, edges are all undefined (infinity weight)+initGraph :: SemiRing edgeLabel => Graph edgeLabel rigid flexScope+initGraph = Graph Map.empty Map.empty Map.empty 0 (\ x y -> ozero)++-- the Graph Monad, for constructing a graph iteratively+type GM edgeLabel rigid flexScope = State (Graph edgeLabel rigid flexScope)++addFlex :: FlexId -> flexScope -> GM edgeLabel rigid flexScope ()+addFlex x scope = do+  st <- get+  put $ st { flexScope = Map.insert x scope (flexScope st) }+++-- i <- addNode n  returns number of node n. if not present, it is added first+addNode :: (Eq rigid, Ord rigid) => (Node rigid) -> GM edgeLabel rigid flexScope Int+addNode n = do+  st <- get+  case Map.lookup n (nodeMap st) of+    Just i -> return i+    Nothing -> do let i = nextNode st+                  put $ st { nodeMap = Map.insert n i (nodeMap st)+                           , intMap = Map.insert i n (intMap st)+                           , nextNode = i + 1+                           }+                  return i++-- addEdge n1 k n2  +-- improves the weight of egde n1->n2 to be at most k+-- also adds nodes if not yet present+addEdge :: (Eq rigid, Ord rigid, SemiRing edgeLabel) => (Node rigid) -> edgeLabel -> (Node rigid) -> GM edgeLabel rigid flexScope ()+addEdge n1 k n2 = do+  i1 <- addNode n1+  i2 <- addNode n2+  st <- get+  let graph' x y = if (x,y) == (i1,i2) then k `oplus` (graph st) x y+                   else graph st x y+  put $ st { graph = graph' }++addConstraint :: (Eq rigid, Ord rigid, SemiRing edgeLabel) =>  +  Constrnt edgeLabel rigid flexScope -> GM edgeLabel rigid flexScope ()+addConstraint (NewFlex x scope) = do+  addFlex x scope+  addEdge (Flex x) oone (Flex x) -- add dummy edge to make sure each meta variable+                              -- is in the matrix and gets solved+addConstraint (Arc n1 k n2)     = addEdge n1 k n2++buildGraph :: (Eq rigid, Ord rigid, SemiRing edgeLabel) =>  +  [Constrnt edgeLabel rigid flexScope] -> Graph edgeLabel rigid flexScope+buildGraph cs = execState (mapM_ addConstraint cs) initGraph++mkMatrix :: Int -> (Int -> Int -> a) -> Matrix a+mkMatrix n g = array ((0,0),(n-1,n-1)) +                 [ ((i,j), g i j) | i <- [0..n-1], j <- [0..n-1]]++-- displaying matrices with row and column labels --------------------++-- a matrix with row descriptions in b and column descriptions in c+data LegendMatrix a b c = LegendMatrix +  { matrix   :: Matrix a+  , rowdescr :: Int -> b+  , coldescr :: Int -> c+  }++instance (Show a, Show b, Show c) => Show (LegendMatrix a b c) where+  show (LegendMatrix m rd cd) =+    -- first show column description+    let ((r,c),(r',c')) = bounds m+    in foldr (\ j s -> "\t" ++ show (cd j) ++ s) "" [c .. c'] ++ +    -- then output rows+       foldr (\ i s -> "\n" ++ show (rd i) +++                foldr (\ j t -> "\t" ++ show (m!(i,j)) ++ t) +                      (s) +                      [c .. c'])+             "" [r .. r'] ++-- solving the constraints -------------------------------------------++-- a solution assigns to each flexible variable a size expression+-- which is either a constant or a v + n for a rigid variable v+type Solution = Map Int MaxExpr++emptySolution :: Solution+emptySolution = Map.empty++extendSolution :: Solution -> Int -> SizeExpr -> Solution+extendSolution subst k v = Map.insertWith (++) k [v] subst++type MaxExpr = [SizeExpr]+-- newtype MaxExpr = MaxExpr { sizeExprs :: [SizeExpr] } deriving (Show)++data SizeExpr = SizeVar Int Int   -- e.g. x + 5+              | SizeConst Weight  -- a number or infinity++instance Show SizeExpr where+  show (SizeVar n 0) = show (Rigid (RVar n))+  show (SizeVar n k) = show (Rigid (RVar n)) ++ "+" ++ show k+  show (SizeConst (Finite i)) = show i+  show (SizeConst Infinite)   = "#"++-- sizeRigid r n  returns the size expression corresponding to r + n+sizeRigid :: Rigid -> Int -> SizeExpr+sizeRigid (RConst k) n = SizeConst (inc k n)+sizeRigid (RVar i)   n = SizeVar i n ++{-+apply :: SizeExpr -> Solution -> SizeExpr+apply e@(SizeExpr (Rigid _) _) phi = e+apply e@(SizeExpr (Flex  x) i) phi = case Map.lookup x phi of+  Nothing -> e+  Just (SizeExpr v j) -> SizeExpr v (i + j) + +after :: Solution -> Solution -> Solution+after psi phi = Map.map (\ e -> e `apply` phi) psi+-}++{-+solve :: Constraints -> Maybe Solution+solve cs = if any (\ x -> x < Finite 0) d then Nothing+     else Map.+   where gr = buildGraph cs+         n  = nextNode gr+         m  = mkMatrix n (graph gr)+         m' = warshall m+         d  = [ m!(i,i) | i <- [0 .. (n-1)] ]+         ns = keys (nodeMap gr)+-}++{- compute solution++a solution CANNOT exist if++  v < v  for a rigid variable v++  v <= v' for rigid variables v,v'++  x < v   for a flexible variable x and a rigid variable v++thus, for each flexible x, only one of the following cases is possible++  r+n <= x+m <= infty  for a unique rigid r  (meaning r --(m-n)--> x)+  x <= r+n             for a unique rigid r  (meaning x --(n)--> r)++we are looking for the least values for flexible variables that solve+the constraints.  Algorithm++while flexible variables and rigid rows left+  find a rigid variable row i+    for all flexible columns j+      if i --n--> j with n<=0 (meaning i+n <= j) then j = i + n++while flexible variables j left+  search the row j for entry i+    if j --n--> i with n >= 0 (meaning j <= i + n) then j = i +++-}++solve :: Constraints -> Maybe Solution+solve cs = traceSolve (show lm0) $ traceSolve (show lm) $ traceSolve (show cs) $+     let solution = if solvable then loop1 rigids emptySolution+                    else Nothing+     in traceSolve ("solution = " ++ show solution) $ +          solution+   where -- compute the graph and its transitive closure m+         gr  = buildGraph cs+         n   = nextNode gr            -- number of nodes+         m0  = mkMatrix n (graph gr)+         m   = warshall m0++         -- tracing only: build output version of transitive graph+         legend i = fromJust $ Map.lookup i (intMap gr) -- trace only+         lm0 = LegendMatrix m0 legend legend            -- trace only+         lm  = LegendMatrix m legend legend             -- trace only++         -- compute the sets of flexible and rigid node numbers+         ns  = Map.keys (nodeMap gr)                    +         -- a set of flexible variables+         flexs  = foldl (\ l k -> case k of (Flex i) -> i : l+                                            (Rigid _) -> l) [] ns+         -- a set of rigid variables+         rigids = foldl (\ l k -> case k of (Flex _) -> l+                                            (Rigid i) -> i : l) [] ns++         -- rigid matrix indices+         rInds = foldl (\ l r -> let Just i = Map.lookup (Rigid r) (nodeMap gr)+                                 in i : l) [] rigids++         -- check whether there is a solution+         -- d   = [ m!(i,i) | i <- [0 .. (n-1)] ]  -- diagonal+-- a rigid variable might not be less than it self, so no -.. on the +-- rigid part of the diagonal+         solvable = all (\ x -> x >= oone) [ m!(i,i) | i <- rInds ] &&+-- a rigid variable might not be bounded below by infinity or+-- bounded above by a constant+-- it might not be related to another rigid variable+           all (\ (r,  r') -> r == r' || +                let Just row = (Map.lookup (Rigid r)  (nodeMap gr))+                    Just col = (Map.lookup (Rigid r') (nodeMap gr))+                    edge = m!(row,col)+                in  isBelow r edge r' ) +             [ (r,r') | r <- rigids, r' <- rigids ]+           &&+-- a flexible variable might not be strictly below a rigid variable+           all (\ (x, v) -> +                let Just row = (Map.lookup (Flex x)  (nodeMap gr))+                    Just col = (Map.lookup (Rigid (RVar v)) (nodeMap gr))+                    edge = m!(row,col)+                in  edge >= Finite 0)+             [ (x,v) | x <- flexs, (RVar v) <- rigids ]+++         inScope :: FlexId -> Rigid -> Bool+         inScope x (RConst _) = True+         inScope x (RVar v)   = case Map.lookup x (flexScope gr) of+                     Just scope -> scope v+                     Nothing    -> error $ "Warshall.inScope panic: flexible " ++ show x ++ " does not carry scope info when assigning it rigid variable " ++ show v  ++{- loop1++while flexible variables and rigid rows left+  find a rigid variable row i+    for all flexible columns j+      if i --n--> j with n<=0 (meaning i + n <= j) then +        add i + n to the solution of j++-}++         loop1 :: [Rigid] -> Solution -> Maybe Solution+         loop1 (r:rgds) subst = loop1 rgds subst' where +            row = fromJust $ Map.lookup (Rigid r) (nodeMap gr)+            subst' =+                  foldl (\ sub f -> +                          let col = fromJust $ Map.lookup (Flex f) (nodeMap gr)+                          in  case (True -- inScope f r  -- SEEMS WRONG TO IGNORE THINGS NOT IN SCOPE+                                   , m!(row,col)) of+--                                Finite z | z <= 0 -> +                                (True, Finite z) -> +                                   let trunc z | z >= 0 = 0+                                            | otherwise = -z+                                   in extendSolution sub f (sizeRigid r (trunc z))+                                _ -> sub+                     ) subst flexs       +         loop1 [] subst = case flexs List.\\ (Map.keys subst) of+            [] -> Just subst+            flexs' -> loop2 flexs' subst++{- loop2++while flexible variables j left+  search the row j for entry i+    if j --n--> i with n >= 0 (meaning j <= i + n) then j = i ++-}+         loop2 :: [FlexId] -> Solution -> Maybe Solution+         loop2 [] subst = Just subst +         loop2 (f:flxs) subst = loop3 0 subst+           where row = fromJust $ Map.lookup (Flex f) (nodeMap gr)+                 loop3 col subst | col >= n = +                   -- default to infinity+                    loop2 flxs (extendSolution subst f (SizeConst Infinite)) +                 loop3 col subst =+                   case Map.lookup col (intMap gr) of+                     Just (Rigid r) | not (infinite r) -> +                       case (True -- inScope f r+                            ,m!(row,col)) of+                        (True, Finite z) | z >= 0 -> +                            loop2 flxs (extendSolution subst f (sizeRigid r z))+                        (_, Infinite) -> loop3 (col+1) subst +                        _ -> Nothing +                     _ -> loop3 (col+1) subst
+ dist/build/miniagda/miniagda-tmp/Lexer.hs view
@@ -0,0 +1,572 @@+{-# LANGUAGE CPP,MagicHash #-}+{-# LINE 2 "Lexer.x" #-}+++module Lexer where+++#if __GLASGOW_HASKELL__ >= 603+#include "ghcconfig.h"+#elif defined(__GLASGOW_HASKELL__)+#include "config.h"+#endif+#if __GLASGOW_HASKELL__ >= 503+import Data.Array+import Data.Char (ord)+import Data.Array.Base (unsafeAt)+#else+import Array+import Char (ord)+#endif+#if __GLASGOW_HASKELL__ >= 503+import GHC.Exts+#else+import GlaExts+#endif+{-# LINE 1 "templates/wrappers.hs" #-}+{-# LINE 1 "templates/wrappers.hs" #-}+{-# LINE 1 "<built-in>" #-}+{-# LINE 1 "<command-line>" #-}+{-# LINE 1 "templates/wrappers.hs" #-}+-- -----------------------------------------------------------------------------+-- Alex wrapper code.+--+-- This code is in the PUBLIC DOMAIN; you may copy it freely and use+-- it for any purpose whatsoever.++import Data.Word (Word8)+{-# LINE 22 "templates/wrappers.hs" #-}++import qualified Data.Bits++-- | Encode a Haskell String to a list of Word8 values, in UTF8 format.+utf8Encode :: Char -> [Word8]+utf8Encode = map fromIntegral . go . ord+ where+  go oc+   | oc <= 0x7f       = [oc]++   | oc <= 0x7ff      = [ 0xc0 + (oc `Data.Bits.shiftR` 6)+                        , 0x80 + oc Data.Bits..&. 0x3f+                        ]++   | oc <= 0xffff     = [ 0xe0 + (oc `Data.Bits.shiftR` 12)+                        , 0x80 + ((oc `Data.Bits.shiftR` 6) Data.Bits..&. 0x3f)+                        , 0x80 + oc Data.Bits..&. 0x3f+                        ]+   | otherwise        = [ 0xf0 + (oc `Data.Bits.shiftR` 18)+                        , 0x80 + ((oc `Data.Bits.shiftR` 12) Data.Bits..&. 0x3f)+                        , 0x80 + ((oc `Data.Bits.shiftR` 6) Data.Bits..&. 0x3f)+                        , 0x80 + oc Data.Bits..&. 0x3f+                        ]++++type Byte = Word8++-- -----------------------------------------------------------------------------+-- The input type+++type AlexInput = (AlexPosn,     -- current position,+                  Char,         -- previous char+                  [Byte],       -- pending bytes on current char+                  String)       -- current input string++ignorePendingBytes :: AlexInput -> AlexInput+ignorePendingBytes (p,c,ps,s) = (p,c,[],s)++alexInputPrevChar :: AlexInput -> Char+alexInputPrevChar (p,c,bs,s) = c++alexGetByte :: AlexInput -> Maybe (Byte,AlexInput)+alexGetByte (p,c,(b:bs),s) = Just (b,(p,c,bs,s))+alexGetByte (p,c,[],[]) = Nothing+alexGetByte (p,_,[],(c:s))  = let p' = alexMove p c +                                  (b:bs) = utf8Encode c+                              in p' `seq`  Just (b, (p', c, bs, s))+++{-# LINE 89 "templates/wrappers.hs" #-}++{-# LINE 103 "templates/wrappers.hs" #-}++{-# LINE 118 "templates/wrappers.hs" #-}++-- -----------------------------------------------------------------------------+-- Token positions++-- `Posn' records the location of a token in the input text.  It has three+-- fields: the address (number of chacaters preceding the token), line number+-- and column of a token within the file. `start_pos' gives the position of the+-- start of the file and `eof_pos' a standard encoding for the end of file.+-- `move_pos' calculates the new position after traversing a given character,+-- assuming the usual eight character tab stops.+++data AlexPosn = AlexPn !Int !Int !Int+        deriving (Eq,Show)++alexStartPos :: AlexPosn+alexStartPos = AlexPn 0 1 1++alexMove :: AlexPosn -> Char -> AlexPosn+alexMove (AlexPn a l c) '\t' = AlexPn (a+1)  l     (((c+7) `div` 8)*8+1)+alexMove (AlexPn a l c) '\n' = AlexPn (a+1) (l+1)   1+alexMove (AlexPn a l c) _    = AlexPn (a+1)  l     (c+1)+++-- -----------------------------------------------------------------------------+-- Default monad++{-# LINE 231 "templates/wrappers.hs" #-}+++-- -----------------------------------------------------------------------------+-- Monad (with ByteString input)++{-# LINE 320 "templates/wrappers.hs" #-}+++-- -----------------------------------------------------------------------------+-- Basic wrapper++{-# LINE 346 "templates/wrappers.hs" #-}+++-- -----------------------------------------------------------------------------+-- Basic wrapper, ByteString version++{-# LINE 364 "templates/wrappers.hs" #-}++{-# LINE 377 "templates/wrappers.hs" #-}+++-- -----------------------------------------------------------------------------+-- Posn wrapper++-- Adds text positions to the basic model.+++--alexScanTokens :: String -> [token]+alexScanTokens str = go (alexStartPos,'\n',[],str)+  where go inp@(pos,_,_,str) =+          case alexScan inp 0 of+                AlexEOF -> []+                AlexError ((AlexPn _ line column),_,_,_) -> error $ "lexical error at " ++ (show line) ++ " line, " ++ (show column) ++ " column"+                AlexSkip  inp' len     -> go inp'+                AlexToken inp' len act -> act pos (take len str) : go inp'++++-- -----------------------------------------------------------------------------+-- Posn wrapper, ByteString version++{-# LINE 409 "templates/wrappers.hs" #-}+++-- -----------------------------------------------------------------------------+-- GScan wrapper++-- For compatibility with previous versions of Alex, and because we can.++alex_base :: AlexAddr+alex_base = AlexA# "\xf8\xff\xff\xff\x0a\x00\x00\x00\xdd\x00\x00\x00\xca\x00\x00\x00\x5d\x01\x00\x00\x30\x02\x00\x00\xb0\x02\x00\x00\x9f\x01\x00\x00\x00\x00\x00\x00\x21\x03\x00\x00\x00\x00\x00\x00\xa1\x03\x00\x00\x21\x04\x00\x00\x21\x05\x00\x00\xe1\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x52\x05\x00\x00\x00\x00\x00\x00\x93\x05\x00\x00\x93\x06\x00\x00\x53\x06\x00\x00\x00\x00\x00\x00\xfd\xff\xff\xff\x49\x07\x00\x00\x1c\x08\x00\x00\x00\x00\x00\x00\x2d\x07\x00\x00\xf5\x08\x00\x00\x49\x09\x00\x00\x9d\x09\x00\x00\xf1\x09\x00\x00\x45\x0a\x00\x00\x99\x0a\x00\x00\xed\x0a\x00\x00\x41\x0b\x00\x00\x95\x0b\x00\x00\xe9\x0b\x00\x00\x3d\x0c\x00\x00\x91\x0c\x00\x00\xe5\x0c\x00\x00\x39\x0d\x00\x00\x8d\x0d\x00\x00\xe1\x0d\x00\x00\x35\x0e\x00\x00\x89\x0e\x00\x00\xdd\x0e\x00\x00\x31\x0f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x85\x0f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd9\x0f\x00\x00\xde\xff\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xce\xff\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe2\xff\xff\xff\xe1\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\xdc\xff\xff\xff\x00\x00\x00\x00\x46\x00\x00\x00\x2d\x10\x00\x00\x81\x10\x00\x00\xd5\x10\x00\x00\x29\x11\x00\x00\x7d\x11\x00\x00\xd1\x11\x00\x00\x25\x12\x00\x00\x79\x12\x00\x00\xcd\x12\x00\x00\x21\x13\x00\x00\x75\x13\x00\x00\xc9\x13\x00\x00\x1d\x14\x00\x00\x71\x14\x00\x00\xc5\x14\x00\x00\x19\x15\x00\x00\x6d\x15\x00\x00\xc1\x15\x00\x00\x15\x16\x00\x00\x69\x16\x00\x00\xbd\x16\x00\x00\x11\x17\x00\x00\x65\x17\x00\x00\xb9\x17\x00\x00\x0d\x18\x00\x00\x61\x18\x00\x00\xb5\x18\x00\x00\x09\x19\x00\x00\x5d\x19\x00\x00\xb1\x19\x00\x00\x05\x1a\x00\x00\x59\x1a\x00\x00\xad\x1a\x00\x00\x01\x1b\x00\x00\x55\x1b\x00\x00\xa9\x1b\x00\x00\xfd\x1b\x00\x00\x51\x1c\x00\x00\xa5\x1c\x00\x00\xf9\x1c\x00\x00\x4d\x1d\x00\x00\xa1\x1d\x00\x00\xf5\x1d\x00\x00\x49\x1e\x00\x00\x9d\x1e\x00\x00\xf1\x1e\x00\x00\x45\x1f\x00\x00\x99\x1f\x00\x00\xed\x1f\x00\x00\x41\x20\x00\x00\x95\x20\x00\x00\xe9\x20\x00\x00\x3d\x21\x00\x00\x91\x21\x00\x00\xe5\x21\x00\x00\x39\x22\x00\x00\x8d\x22\x00\x00\xe1\x22\x00\x00\x35\x23\x00\x00\x89\x23\x00\x00\xdd\x23\x00\x00\x31\x24\x00\x00\x85\x24\x00\x00\xd9\x24\x00\x00\x2d\x25\x00\x00\x81\x25\x00\x00\xd5\x25\x00\x00\x29\x26\x00\x00\x7d\x26\x00\x00\xd1\x26\x00\x00\x25\x27\x00\x00\x79\x27\x00\x00\xcd\x27\x00\x00\x21\x28\x00\x00\x75\x28\x00\x00\xc9\x28\x00\x00\x1d\x29\x00\x00\x71\x29\x00\x00\xc5\x29\x00\x00\x19\x2a\x00\x00\x6d\x2a\x00\x00"#++alex_table :: AlexAddr+alex_table = AlexA# "\x00\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x05\x00\x31\x00\x41\x00\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x17\x00\x49\x00\x00\x00\x33\x00\x34\x00\x17\x00\x47\x00\x48\x00\x3a\x00\x3b\x00\x45\x00\x42\x00\x3f\x00\x43\x00\x40\x00\x44\x00\x4f\x00\x4f\x00\x4f\x00\x4f\x00\x4f\x00\x4f\x00\x4f\x00\x4f\x00\x4f\x00\x4f\x00\x3e\x00\x3d\x00\x4d\x00\x4a\x00\x4e\x00\x02\x00\x00\x00\x7c\x00\x7c\x00\x74\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x64\x00\x6e\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x38\x00\x4b\x00\x39\x00\x46\x00\x4c\x00\x30\x00\x7c\x00\x7c\x00\x6a\x00\x5d\x00\x86\x00\x5a\x00\x7c\x00\x7c\x00\x98\x00\x7c\x00\x7c\x00\x5e\x00\x66\x00\x7c\x00\x7c\x00\x78\x00\x7c\x00\x75\x00\x70\x00\x80\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x36\x00\x3c\x00\x37\x00\x4f\x00\x4f\x00\x4f\x00\x4f\x00\x4f\x00\x4f\x00\x4f\x00\x4f\x00\x4f\x00\x4f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\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\x0d\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0e\x00\x0c\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x07\x00\x0b\x00\x0a\x00\x0a\x00\x0a\x00\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x01\x00\xa0\x00\xa0\x00\xa0\x00\xa0\x00\xa0\x00\xa0\x00\xa0\x00\xa0\x00\xa0\x00\xa0\x00\xa0\x00\xa0\x00\xa0\x00\xa0\x00\xa0\x00\xa0\x00\xa0\x00\xa0\x00\xa0\x00\xa0\x00\xa0\x00\xa0\x00\xa0\x00\xa0\x00\xa0\x00\xa0\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa0\x00\xa0\x00\xa0\x00\xa0\x00\xa0\x00\xa0\x00\xa0\x00\xa0\x00\xa0\x00\xa0\x00\xa0\x00\xa0\x00\xa0\x00\xa0\x00\xa0\x00\xa0\x00\xa0\x00\xa0\x00\xa0\x00\xa0\x00\xa0\x00\xa0\x00\xa0\x00\xa0\x00\xa0\x00\xa0\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\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\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\x0d\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0e\x00\x0c\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x07\x00\x0b\x00\x0a\x00\x0a\x00\x0a\x00\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x14\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x01\x00\x0e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0d\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0e\x00\x0c\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x07\x00\x0b\x00\x0a\x00\x0a\x00\x0a\x00\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x04\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x07\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0c\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x0d\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x13\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\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\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\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\x14\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x15\x00\x04\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x13\x00\x06\x00\x10\x00\x10\x00\x10\x00\x11\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0d\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0e\x00\x0c\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x07\x00\x0b\x00\x0a\x00\x0a\x00\x0a\x00\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x1c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x1d\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x1f\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x23\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x29\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x2a\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x2b\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x2d\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x32\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x9f\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x60\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x72\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x9d\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x9c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x53\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x91\x00\x7c\x00\x7c\x00\x7c\x00\x9a\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x99\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x97\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x96\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x7c\x00\x7c\x00\x54\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x55\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x95\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x94\x00\x7c\x00\x7c\x00\x7c\x00\x8a\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x93\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x92\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x82\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x90\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x8f\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x8d\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x5c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x6b\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x87\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x61\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x8c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x63\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x8b\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x65\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x89\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x7c\x00\x7c\x00\x68\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x88\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x85\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x6f\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x71\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x73\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x83\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x81\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x7c\x00\x7c\x00\x77\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x79\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7f\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7e\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7b\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7a\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x76\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x84\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x6d\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x6c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x69\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x62\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x5f\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x67\x00\x7c\x00\x5b\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x8e\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x59\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x58\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x57\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x56\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x9b\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x52\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x9e\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x51\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x50\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x35\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x2f\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x2e\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x2c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x28\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x27\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7d\x00\x26\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x25\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x24\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x22\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x21\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x20\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x1e\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x7c\x00\x7c\x00\x7c\x00\x1b\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\x7c\x00\xa0\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa0\x00\xa0\x00\xa0\x00\xa0\x00\xa0\x00\xa0\x00\xa0\x00\xa0\x00\xa0\x00\xa0\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa0\x00\xa0\x00\xa0\x00\xa0\x00\xa0\x00\xa0\x00\xa0\x00\xa0\x00\xa0\x00\xa0\x00\xa0\x00\xa0\x00\xa0\x00\xa0\x00\xa0\x00\xa0\x00\xa0\x00\xa0\x00\xa0\x00\xa0\x00\xa0\x00\xa0\x00\xa0\x00\xa0\x00\xa0\x00\xa0\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa0\x00\x00\x00\xa0\x00\xa0\x00\xa0\x00\xa0\x00\xa0\x00\xa0\x00\xa0\x00\xa0\x00\xa0\x00\xa0\x00\xa0\x00\xa0\x00\xa0\x00\xa0\x00\xa0\x00\xa0\x00\xa0\x00\xa0\x00\xa0\x00\xa0\x00\xa0\x00\xa0\x00\xa0\x00\xa0\x00\xa0\x00\xa0\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\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\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x2d\x00\x3e\x00\x2b\x00\x2d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\x3d\x00\xff\xff\x23\x00\x24\x00\x20\x00\x26\x00\x3e\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\x2d\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x7c\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\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\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\x7d\x00\xff\xff\xff\xff\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x2d\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\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\xff\xff\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\x7d\x00\xff\xff\xff\xff\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x2d\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\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\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\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\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\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\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\xff\xff\xff\xff\xff\xff\xff\xff\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x2d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\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\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\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\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\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\x05\x00\x05\x00\xff\xff\xff\xff\x05\x00\xff\xff\x0f\x00\x0f\x00\x08\x00\x08\x00\xff\xff\xff\xff\x05\x00\x05\x00\x05\x00\x12\x00\x12\x00\x16\x00\x16\x00\x18\x00\x18\x00\x18\x00\xff\xff\x18\x00\x05\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\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,160) [[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[(AlexAccSkip)],[(AlexAccSkip)],[(AlexAccSkip)],[(AlexAccSkip)],[(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_56))],[(AlexAcc (alex_action_56))],[(AlexAcc (alex_action_56))],[(AlexAcc (alex_action_56))],[(AlexAcc (alex_action_56))],[(AlexAcc (alex_action_56))],[(AlexAcc (alex_action_56))],[(AlexAcc (alex_action_56))],[(AlexAcc (alex_action_56))],[(AlexAcc (alex_action_56))],[(AlexAcc (alex_action_56))],[(AlexAcc (alex_action_56))],[(AlexAcc (alex_action_56))],[(AlexAcc (alex_action_56))],[(AlexAcc (alex_action_56))],[(AlexAcc (alex_action_56))],[(AlexAcc (alex_action_56))],[(AlexAcc (alex_action_56))],[(AlexAcc (alex_action_56))],[(AlexAcc (alex_action_56))],[(AlexAcc (alex_action_56))],[(AlexAcc (alex_action_56))],[(AlexAcc (alex_action_56))],[(AlexAcc (alex_action_56))],[(AlexAcc (alex_action_56))],[(AlexAcc (alex_action_56))],[(AlexAcc (alex_action_56))],[(AlexAcc (alex_action_56))],[(AlexAcc (alex_action_56))],[(AlexAcc (alex_action_56))],[(AlexAcc (alex_action_56))],[(AlexAcc (alex_action_56))],[(AlexAcc (alex_action_56))],[(AlexAcc (alex_action_56))],[(AlexAcc (alex_action_56))],[(AlexAcc (alex_action_56))],[(AlexAcc (alex_action_56))],[(AlexAcc (alex_action_56))],[(AlexAcc (alex_action_56))],[(AlexAcc (alex_action_56))],[(AlexAcc (alex_action_56))],[(AlexAcc (alex_action_56))],[(AlexAcc (alex_action_56))],[(AlexAcc (alex_action_56))],[(AlexAcc (alex_action_56))],[(AlexAcc (alex_action_56))],[(AlexAcc (alex_action_56))],[(AlexAcc (alex_action_56))],[(AlexAcc (alex_action_56))],[(AlexAcc (alex_action_56))],[(AlexAcc (alex_action_56))],[(AlexAcc (alex_action_56))],[(AlexAcc (alex_action_56))],[(AlexAcc (alex_action_56))],[(AlexAcc (alex_action_56))],[(AlexAcc (alex_action_56))],[(AlexAcc (alex_action_56))],[(AlexAcc (alex_action_56))],[(AlexAcc (alex_action_56))],[(AlexAcc (alex_action_56))],[(AlexAcc (alex_action_56))],[(AlexAcc (alex_action_56))],[(AlexAcc (alex_action_56))],[(AlexAcc (alex_action_56))],[(AlexAcc (alex_action_56))],[(AlexAcc (alex_action_56))],[(AlexAcc (alex_action_56))],[(AlexAcc (alex_action_56))],[(AlexAcc (alex_action_56))],[(AlexAcc (alex_action_56))],[(AlexAcc (alex_action_56))],[(AlexAcc (alex_action_56))],[(AlexAcc (alex_action_56))],[(AlexAcc (alex_action_56))],[(AlexAcc (alex_action_56))],[(AlexAcc (alex_action_56))],[(AlexAcc (alex_action_56))],[(AlexAcc (alex_action_56))],[(AlexAcc (alex_action_56))],[(AlexAcc (alex_action_56))],[(AlexAcc (alex_action_57))]]+{-# LINE 80 "Lexer.x" #-}++data Token = Id String AlexPosn+           | QualId (String, String) AlexPosn+     	   | Number String AlexPosn+     	   | Sized AlexPosn+           | Data AlexPosn+	   | CoData AlexPosn+	   | Record AlexPosn+	   | Fields AlexPosn+	   | Mutual AlexPosn+           | Fun AlexPosn+           | CoFun AlexPosn+           | Pattern AlexPosn+	   | Case AlexPosn+	   | Def AlexPosn+	   | Let AlexPosn+	   | In AlexPosn+           | Type AlexPosn+           | Set AlexPosn+           | CoSet AlexPosn+	   | Eval AlexPosn+	   | Fail AlexPosn+	   | Check AlexPosn+	   | TrustMe AlexPosn+	   | Impredicative AlexPosn+           -- size type+           | Size AlexPosn+           | Infty AlexPosn+           | Succ AlexPosn+           | Max AlexPosn+           --+           | LTri AlexPosn+           | RTri AlexPosn+           | AngleOpen AlexPosn+           | AngleClose AlexPosn+           | BrOpen AlexPosn+           | BrClose AlexPosn+           | BracketOpen AlexPosn+           | BracketClose AlexPosn+           | PrOpen AlexPosn+           | PrClose AlexPosn+           | Bar AlexPosn+           | Sem AlexPosn+           | Col AlexPosn+	   | Comma AlexPosn+	   | Dot AlexPosn+           | Arrow AlexPosn+           | Leq AlexPosn+           | Eq AlexPosn+	   | PlusPlus AlexPosn+	   | Plus AlexPosn+	   | Minus AlexPosn+	   | Slash AlexPosn+	   | Times AlexPosn+	   | Hat AlexPosn+	   | Amp AlexPosn+           | Lam AlexPosn+           | Underscore AlexPosn+           | NotUsed AlexPosn -- so happy doesn't generate overlap case pattern warning+             deriving (Eq)++qualId s p = let (m, '.':n) = break (== '.') s in QualId (m,n) p++prettyTok :: Token -> String+prettyTok c = "\"" ++ tk ++ "\" at " ++ (prettyAlexPosn pos) where+  (tk,pos) = case c of+    (Id s p) -> (show s,p)+    (QualId (m, n) p) -> (show m ++ "." ++ show n, p)+    (Number i p) -> (i,p)+    Sized p -> ("sized",p)+    Data p -> ("data",p)+    CoData p -> ("codata",p)+    Record p -> ("record",p)+    Fields p -> ("fields",p)+    Mutual p -> ("mutual",p)+    Fun p -> ("fun",p)+    CoFun p -> ("cofun",p)+    Pattern p -> ("pattern",p)+    Case p -> ("case",p)+    Def p -> ("def",p)+    Let p -> ("let",p)+    In p -> ("in",p)+    Eval p -> ("eval",p)+    Fail p -> ("fail",p)+    Check p -> ("check",p)+    TrustMe p -> ("trustme",p)+    Impredicative p -> ("impredicative",p)+    Type p -> ("Type",p)+    Set p -> ("Set",p)+    CoSet p -> ("CoSet",p)+    Size p -> ("Size",p)+    Infty p -> ("#",p)+    Succ p -> ("$",p)+    Max p -> ("max",p)+    LTri p -> ("<|",p)+    RTri p -> ("|>",p)+    AngleOpen p -> ("<",p)+    AngleClose p -> (">",p)+    BrOpen p -> ("{",p)+    BrClose p -> ("}",p)+    BracketOpen p -> ("[",p)+    BracketClose p -> ("]",p)+    PrOpen p -> ("(",p)+    PrClose p -> (")",p)+    Bar p -> ("|",p)+    Sem p -> (";",p)+    Col p -> (":",p)+    Comma p -> (",",p)+    Dot p -> (".",p)+    Arrow p -> ("->",p)+    Leq p -> ("<=",p)+    Eq p -> ("=",p)+    PlusPlus p -> ("++",p)+    Plus p -> ("+",p)+    Minus p -> ("-",p)+    Slash p -> ("/",p)+    Times p -> ("*",p)+    Hat p -> ("^",p)+    Amp p -> ("&",p)+    Lam p -> ("\\",p)+    Underscore p -> ("_",p)+    _ -> error "not used"+++prettyAlexPosn (AlexPn _ line row) = "line " ++ show line ++ ", row " ++ show row++tok f p s = f p s+++alex_action_3 =  tok (\p s -> Sized p) +alex_action_4 =  tok (\p s -> Data p) +alex_action_5 =  tok (\p s -> CoData p) +alex_action_6 =  tok (\p s -> Record p) +alex_action_7 =  tok (\p s -> Fields p) +alex_action_8 =  tok (\p s -> Fun p) +alex_action_9 =  tok (\p s -> CoFun p) +alex_action_10 =  tok (\p s -> Pattern p) +alex_action_11 =  tok (\p s -> Case p) +alex_action_12 =  tok (\p s -> Def p) +alex_action_13 =  tok (\p s -> Let p) +alex_action_14 =  tok (\p s -> In p) +alex_action_15 =  tok (\p s -> Eval p)+alex_action_16 =  tok (\p s -> Fail p)+alex_action_17 =  tok (\p s -> Check p)+alex_action_18 =  tok (\p s -> TrustMe p)+alex_action_19 =  tok (\p s -> Impredicative p)+alex_action_20 =  tok (\p s -> Mutual p) +alex_action_21 =  tok (\p s -> Type p) +alex_action_22 =  tok (\p s -> Set p) +alex_action_23 =  tok (\p s -> CoSet p) +alex_action_24 =  tok (\p s -> LTri p) +alex_action_25 =  tok (\p s -> RTri p) +alex_action_26 =  tok (\p s -> Size p) +alex_action_27 =  tok (\p s -> Infty p) +alex_action_28 =  tok (\p s -> Succ p) +alex_action_29 =  tok (\p s -> Max p) +alex_action_30 =  tok (\p s -> BrOpen p) +alex_action_31 =  tok (\p s -> BrClose p) +alex_action_32 =  tok (\p s -> BracketOpen p) +alex_action_33 =  tok (\p s -> BracketClose p) +alex_action_34 =  tok (\p s -> PrOpen p) +alex_action_35 =  tok (\p s -> PrClose p) +alex_action_36 =  tok (\p s -> Bar p) +alex_action_37 =  tok (\p s -> Sem p) +alex_action_38 =  tok (\p s -> Col p) +alex_action_39 =  tok (\p s -> Comma p) +alex_action_40 =  tok (\p s -> Dot p) +alex_action_41 =  tok (\p s -> PlusPlus p) +alex_action_42 =  tok (\p s -> Plus p) +alex_action_43 =  tok (\p s -> Minus p) +alex_action_44 =  tok (\p s -> Slash p) +alex_action_45 =  tok (\p s -> Times p) +alex_action_46 =  tok (\p s -> Hat p) +alex_action_47 =  tok (\p s -> Amp p) +alex_action_48 =  tok (\p s -> Arrow p)  +alex_action_49 =  tok (\p s -> Leq p)  +alex_action_50 =  tok (\p s -> Eq p) +alex_action_51 =  tok (\p s -> Lam p) +alex_action_52 =  tok (\p s -> Underscore p) +alex_action_53 =  tok (\p s -> AngleOpen p) +alex_action_54 =  tok (\p s -> AngleClose p) +alex_action_55 =  tok (\p s -> (Number s p )) +alex_action_56 =  tok (\p s -> (Id s p )) +alex_action_57 =  tok (\p s -> (qualId s p)) +{-# LINE 1 "templates/GenericTemplate.hs" #-}+{-# LINE 1 "templates/GenericTemplate.hs" #-}+{-# LINE 1 "<built-in>" #-}+{-# LINE 1 "<command-line>" #-}+{-# LINE 1 "templates/GenericTemplate.hs" #-}+-- -----------------------------------------------------------------------------+-- ALEX TEMPLATE+--+-- This code is in the PUBLIC DOMAIN; you may copy it freely and use+-- it for any purpose whatsoever.++-- -----------------------------------------------------------------------------+-- INTERNALS and main scanner engine++{-# LINE 37 "templates/GenericTemplate.hs" #-}++{-# LINE 47 "templates/GenericTemplate.hs" #-}+++data AlexAddr = AlexA# Addr#++#if __GLASGOW_HASKELL__ < 503+uncheckedShiftL# = shiftL#+#endif++{-# INLINE alexIndexInt16OffAddr #-}+alexIndexInt16OffAddr (AlexA# arr) off =+#ifdef WORDS_BIGENDIAN+  narrow16Int# i+  where+        i    = word2Int# ((high `uncheckedShiftL#` 8#) `or#` low)+        high = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#)))+        low  = int2Word# (ord# (indexCharOffAddr# arr off'))+        off' = off *# 2#+#else+  indexInt16OffAddr# arr off+#endif++++++{-# INLINE alexIndexInt32OffAddr #-}+alexIndexInt32OffAddr (AlexA# arr) off = +#ifdef WORDS_BIGENDIAN+  narrow32Int# i+  where+   !i    = word2Int# ((b3 `uncheckedShiftL#` 24#) `or#`+		     (b2 `uncheckedShiftL#` 16#) `or#`+		     (b1 `uncheckedShiftL#` 8#) `or#` b0)+   !b3   = int2Word# (ord# (indexCharOffAddr# arr (off' +# 3#)))+   !b2   = int2Word# (ord# (indexCharOffAddr# arr (off' +# 2#)))+   !b1   = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#)))+   !b0   = int2Word# (ord# (indexCharOffAddr# arr off'))+   !off' = off *# 4#+#else+  indexInt32OffAddr# arr off+#endif++++++#if __GLASGOW_HASKELL__ < 503+quickIndex arr i = arr ! i+#else+-- GHC >= 503, unsafeAt is available from Data.Array.Base.+quickIndex = unsafeAt+#endif+++++-- -----------------------------------------------------------------------------+-- Main lexing routines++data AlexReturn a+  = AlexEOF+  | AlexError  !AlexInput+  | AlexSkip   !AlexInput !Int+  | AlexToken  !AlexInput !Int a++-- alexScan :: AlexInput -> StartCode -> AlexReturn a+alexScan input (I# (sc))+  = alexScanUser undefined input (I# (sc))++alexScanUser user input (I# (sc))+  = case alex_scan_tkn user input 0# input sc AlexNone of+	(AlexNone, input') ->+		case alexGetByte input of+			Nothing -> ++++				   AlexEOF+			Just _ ->++++				   AlexError input'++	(AlexLastSkip input'' len, _) ->++++		AlexSkip input'' len++	(AlexLastAcc k input''' len, _) ->++++		AlexToken input''' len k+++-- Push the input through the DFA, remembering the most recent accepting+-- state it encountered.++alex_scan_tkn user orig_input len input s last_acc =+  input `seq` -- strict in the input+  let +	new_acc = (check_accs (alex_accept `quickIndex` (I# (s))))+  in+  new_acc `seq`+  case alexGetByte input of+     Nothing -> (new_acc, input)+     Just (c, new_input) -> ++++	let+		(base) = alexIndexInt32OffAddr alex_base s+		((I# (ord_c))) = fromIntegral c+		(offset) = (base +# ord_c)+		(check)  = alexIndexInt16OffAddr alex_check offset+		+		(new_s) = if (offset >=# 0#) && (check ==# ord_c)+			  then alexIndexInt16OffAddr alex_table offset+			  else alexIndexInt16OffAddr alex_deflt s+	in+	case new_s of +	    -1# -> (new_acc, input)+		-- on an error, we want to keep the input *before* the+		-- character that failed, not after.+    	    _ -> alex_scan_tkn user orig_input (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 [] = last_acc+	check_accs (AlexAcc a : _) = AlexLastAcc a input (I# (len))+	check_accs (AlexAccSkip : _)  = AlexLastSkip  input (I# (len))+	check_accs (AlexAccPred a predx : rest)+	   | predx user orig_input (I# (len)) input+	   = AlexLastAcc a input (I# (len))+	check_accs (AlexAccSkipPred predx : rest)+	   | predx user orig_input (I# (len)) input+	   = AlexLastSkip input (I# (len))+	check_accs (_ : rest) = check_accs rest++data AlexLastAcc a+  = AlexNone+  | AlexLastAcc a !AlexInput !Int+  | AlexLastSkip  !AlexInput !Int++instance Functor AlexLastAcc where+    fmap f AlexNone = AlexNone+    fmap f (AlexLastAcc x y z) = AlexLastAcc (f x) y z+    fmap f (AlexLastSkip x y) = AlexLastSkip x y++data AlexAcc a user+  = AlexAcc a+  | AlexAccSkip+  | AlexAccPred a (AlexAccPred user)+  | AlexAccSkipPred (AlexAccPred user)++type AlexAccPred user = user -> AlexInput -> Int -> AlexInput -> Bool++-- -----------------------------------------------------------------------------+-- Predicates on a rule++alexAndPred p1 p2 user in1 len in2+  = p1 user in1 len in2 && p2 user in1 len in2++--alexPrevCharIsPred :: Char -> AlexAccPred _ +alexPrevCharIs c _ input _ _ = c == alexInputPrevChar input++alexPrevCharMatches f _ input _ _ = f (alexInputPrevChar input)++--alexPrevCharIsOneOfPred :: Array Char Bool -> AlexAccPred _ +alexPrevCharIsOneOf arr _ input _ _ = arr ! alexInputPrevChar input++--alexRightContext :: Int -> AlexAccPred _+alexRightContext (I# (sc)) user _ _ input = +     case alex_scan_tkn user input 0# input sc AlexNone of+	  (AlexNone, _) -> False+	  _ -> True+	-- TODO: there's no need to find the longest+	-- match when checking the right context, just+	-- the first match will do.++-- used by wrappers+iUnbox (I# (i)) = i
+ dist/build/miniagda/miniagda-tmp/Parser.hs view
@@ -0,0 +1,2685 @@+{-# OPTIONS_GHC -w #-}+{-# OPTIONS -fglasgow-exts -cpp #-}+{-# LANGUAGE BangPatterns #-}+module Parser where++import qualified Lexer as T+import qualified Concrete as C++import Abstract (Decoration(..),Dec,defaultDec,Override(..))+import Polarity (Pol(..))+import qualified Abstract as A+import qualified Polarity as A+import Concrete (Name,patApp)+import qualified Data.Array as Happy_Data_Array+import qualified GHC.Exts as Happy_GHC_Exts++-- parser produced by Happy Version 1.18.9++newtype HappyAbsSyn  = HappyAbsSyn HappyAny+#if __GLASGOW_HASKELL__ >= 607+type HappyAny = Happy_GHC_Exts.Any+#else+type HappyAny = forall a . a+#endif+happyIn4 :: ([C.Declaration]) -> (HappyAbsSyn )+happyIn4 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn4 #-}+happyOut4 :: (HappyAbsSyn ) -> ([C.Declaration])+happyOut4 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut4 #-}+happyIn5 :: ([C.Declaration]) -> (HappyAbsSyn )+happyIn5 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn5 #-}+happyOut5 :: (HappyAbsSyn ) -> ([C.Declaration])+happyOut5 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut5 #-}+happyIn6 :: (C.Declaration) -> (HappyAbsSyn )+happyIn6 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn6 #-}+happyOut6 :: (HappyAbsSyn ) -> (C.Declaration)+happyOut6 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut6 #-}+happyIn7 :: (C.Declaration) -> (HappyAbsSyn )+happyIn7 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn7 #-}+happyOut7 :: (HappyAbsSyn ) -> (C.Declaration)+happyOut7 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut7 #-}+happyIn8 :: (C.Declaration) -> (HappyAbsSyn )+happyIn8 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn8 #-}+happyOut8 :: (HappyAbsSyn ) -> (C.Declaration)+happyOut8 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut8 #-}+happyIn9 :: (C.Declaration) -> (HappyAbsSyn )+happyIn9 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn9 #-}+happyOut9 :: (HappyAbsSyn ) -> (C.Declaration)+happyOut9 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut9 #-}+happyIn10 :: (C.Declaration) -> (HappyAbsSyn )+happyIn10 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn10 #-}+happyOut10 :: (HappyAbsSyn ) -> (C.Declaration)+happyOut10 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut10 #-}+happyIn11 :: (C.Declaration) -> (HappyAbsSyn )+happyIn11 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn11 #-}+happyOut11 :: (HappyAbsSyn ) -> (C.Declaration)+happyOut11 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut11 #-}+happyIn12 :: ((C.Name, C.Telescope, C.Type, [C.Constructor], [C.Name])) -> (HappyAbsSyn )+happyIn12 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn12 #-}+happyOut12 :: (HappyAbsSyn ) -> ((C.Name, C.Telescope, C.Type, [C.Constructor], [C.Name]))+happyOut12 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut12 #-}+happyIn13 :: ((C.Name, C.Telescope, C.Type, C.Constructor, [C.Name])) -> (HappyAbsSyn )+happyIn13 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn13 #-}+happyOut13 :: (HappyAbsSyn ) -> ((C.Name, C.Telescope, C.Type, C.Constructor, [C.Name]))+happyOut13 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut13 #-}+happyIn14 :: (C.Declaration) -> (HappyAbsSyn )+happyIn14 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn14 #-}+happyOut14 :: (HappyAbsSyn ) -> (C.Declaration)+happyOut14 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut14 #-}+happyIn15 :: (C.Declaration) -> (HappyAbsSyn )+happyIn15 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn15 #-}+happyOut15 :: (HappyAbsSyn ) -> (C.Declaration)+happyOut15 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut15 #-}+happyIn16 :: (C.Declaration) -> (HappyAbsSyn )+happyIn16 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn16 #-}+happyOut16 :: (HappyAbsSyn ) -> (C.Declaration)+happyOut16 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut16 #-}+happyIn17 :: (C.Declaration) -> (HappyAbsSyn )+happyIn17 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn17 #-}+happyOut17 :: (HappyAbsSyn ) -> (C.Declaration)+happyOut17 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut17 #-}+happyIn18 :: (C.LetDef) -> (HappyAbsSyn )+happyIn18 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn18 #-}+happyOut18 :: (HappyAbsSyn ) -> (C.LetDef)+happyOut18 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut18 #-}+happyIn19 :: (Bool) -> (HappyAbsSyn )+happyIn19 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn19 #-}+happyOut19 :: (HappyAbsSyn ) -> (Bool)+happyOut19 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut19 #-}+happyIn20 :: (Maybe C.Type) -> (HappyAbsSyn )+happyIn20 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn20 #-}+happyOut20 :: (HappyAbsSyn ) -> (Maybe C.Type)+happyOut20 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut20 #-}+happyIn21 :: (C.Declaration) -> (HappyAbsSyn )+happyIn21 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn21 #-}+happyOut21 :: (HappyAbsSyn ) -> (C.Declaration)+happyOut21 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut21 #-}+happyIn22 :: ([Name]) -> (HappyAbsSyn )+happyIn22 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn22 #-}+happyOut22 :: (HappyAbsSyn ) -> ([Name])+happyOut22 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut22 #-}+happyIn23 :: (Name) -> (HappyAbsSyn )+happyIn23 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn23 #-}+happyOut23 :: (HappyAbsSyn ) -> (Name)+happyOut23 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut23 #-}+happyIn24 :: ([Name]) -> (HappyAbsSyn )+happyIn24 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn24 #-}+happyOut24 :: (HappyAbsSyn ) -> ([Name])+happyOut24 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut24 #-}+happyIn25 :: ([Name]) -> (HappyAbsSyn )+happyIn25 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn25 #-}+happyOut25 :: (HappyAbsSyn ) -> ([Name])+happyOut25 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut25 #-}+happyIn26 :: (Pol) -> (HappyAbsSyn )+happyIn26 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn26 #-}+happyOut26 :: (HappyAbsSyn ) -> (Pol)+happyOut26 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut26 #-}+happyIn27 :: (A.Measure C.Expr) -> (HappyAbsSyn )+happyIn27 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn27 #-}+happyOut27 :: (HappyAbsSyn ) -> (A.Measure C.Expr)+happyOut27 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut27 #-}+happyIn28 :: ([C.Expr]) -> (HappyAbsSyn )+happyIn28 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn28 #-}+happyOut28 :: (HappyAbsSyn ) -> ([C.Expr])+happyOut28 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut28 #-}+happyIn29 :: (A.Bound C.Expr) -> (HappyAbsSyn )+happyIn29 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn29 #-}+happyOut29 :: (HappyAbsSyn ) -> (A.Bound C.Expr)+happyOut29 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut29 #-}+happyIn30 :: ([Name]) -> (HappyAbsSyn )+happyIn30 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn30 #-}+happyOut30 :: (HappyAbsSyn ) -> ([Name])+happyOut30 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut30 #-}+happyIn31 :: (C.Telescope) -> (HappyAbsSyn )+happyIn31 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn31 #-}+happyOut31 :: (HappyAbsSyn ) -> (C.Telescope)+happyOut31 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut31 #-}+happyIn32 :: (C.TBind) -> (HappyAbsSyn )+happyIn32 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn32 #-}+happyOut32 :: (HappyAbsSyn ) -> (C.TBind)+happyOut32 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut32 #-}+happyIn33 :: (C.TBind) -> (HappyAbsSyn )+happyIn33 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn33 #-}+happyOut33 :: (HappyAbsSyn ) -> (C.TBind)+happyOut33 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut33 #-}+happyIn34 :: (C.TBind) -> (HappyAbsSyn )+happyIn34 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn34 #-}+happyOut34 :: (HappyAbsSyn ) -> (C.TBind)+happyOut34 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut34 #-}+happyIn35 :: (C.LBind) -> (HappyAbsSyn )+happyIn35 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn35 #-}+happyOut35 :: (HappyAbsSyn ) -> (C.LBind)+happyOut35 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut35 #-}+happyIn36 :: ((Dec, C.Name)) -> (HappyAbsSyn )+happyIn36 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn36 #-}+happyOut36 :: (HappyAbsSyn ) -> ((Dec, C.Name))+happyOut36 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut36 #-}+happyIn37 :: (C.LetDef) -> (HappyAbsSyn )+happyIn37 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn37 #-}+happyOut37 :: (HappyAbsSyn ) -> (C.LetDef)+happyOut37 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut37 #-}+happyIn38 :: (C.LBind) -> (HappyAbsSyn )+happyIn38 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn38 #-}+happyOut38 :: (HappyAbsSyn ) -> (C.LBind)+happyOut38 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut38 #-}+happyIn39 :: (C.Telescope) -> (HappyAbsSyn )+happyIn39 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn39 #-}+happyOut39 :: (HappyAbsSyn ) -> (C.Telescope)+happyOut39 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut39 #-}+happyIn40 :: (C.Expr) -> (HappyAbsSyn )+happyIn40 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn40 #-}+happyOut40 :: (HappyAbsSyn ) -> (C.Expr)+happyOut40 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut40 #-}+happyIn41 :: ([C.Expr]) -> (HappyAbsSyn )+happyIn41 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn41 #-}+happyOut41 :: (HappyAbsSyn ) -> ([C.Expr])+happyOut41 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut41 #-}+happyIn42 :: (C.Expr) -> (HappyAbsSyn )+happyIn42 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn42 #-}+happyOut42 :: (HappyAbsSyn ) -> (C.Expr)+happyOut42 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut42 #-}+happyIn43 :: (C.Expr) -> (HappyAbsSyn )+happyIn43 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn43 #-}+happyOut43 :: (HappyAbsSyn ) -> (C.Expr)+happyOut43 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut43 #-}+happyIn44 :: (C.TBind) -> (HappyAbsSyn )+happyIn44 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn44 #-}+happyOut44 :: (HappyAbsSyn ) -> (C.TBind)+happyOut44 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut44 #-}+happyIn45 :: (C.Expr) -> (HappyAbsSyn )+happyIn45 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn45 #-}+happyOut45 :: (HappyAbsSyn ) -> (C.Expr)+happyOut45 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut45 #-}+happyIn46 :: ([C.Expr]) -> (HappyAbsSyn )+happyIn46 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn46 #-}+happyOut46 :: (HappyAbsSyn ) -> ([C.Expr])+happyOut46 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut46 #-}+happyIn47 :: (C.Expr) -> (HappyAbsSyn )+happyIn47 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn47 #-}+happyOut47 :: (HappyAbsSyn ) -> (C.Expr)+happyOut47 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut47 #-}+happyIn48 :: (C.QName) -> (HappyAbsSyn )+happyIn48 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn48 #-}+happyOut48 :: (HappyAbsSyn ) -> (C.QName)+happyOut48 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut48 #-}+happyIn49 :: ([([Name],C.Expr)]) -> (HappyAbsSyn )+happyIn49 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn49 #-}+happyOut49 :: (HappyAbsSyn ) -> ([([Name],C.Expr)])+happyOut49 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut49 #-}+happyIn50 :: (([Name],C.Expr)) -> (HappyAbsSyn )+happyIn50 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn50 #-}+happyOut50 :: (HappyAbsSyn ) -> (([Name],C.Expr))+happyOut50 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut50 #-}+happyIn51 :: (C.TypeSig) -> (HappyAbsSyn )+happyIn51 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn51 #-}+happyOut51 :: (HappyAbsSyn ) -> (C.TypeSig)+happyOut51 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut51 #-}+happyIn52 :: (C.Constructor) -> (HappyAbsSyn )+happyIn52 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn52 #-}+happyOut52 :: (HappyAbsSyn ) -> (C.Constructor)+happyOut52 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut52 #-}+happyIn53 :: ([C.Constructor ]) -> (HappyAbsSyn )+happyIn53 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn53 #-}+happyOut53 :: (HappyAbsSyn ) -> ([C.Constructor ])+happyOut53 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut53 #-}+happyIn54 :: ([C.Clause]) -> (HappyAbsSyn )+happyIn54 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn54 #-}+happyOut54 :: (HappyAbsSyn ) -> ([C.Clause])+happyOut54 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut54 #-}+happyIn55 :: (C.Clause) -> (HappyAbsSyn )+happyIn55 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn55 #-}+happyOut55 :: (HappyAbsSyn ) -> (C.Clause)+happyOut55 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut55 #-}+happyIn56 :: ([C.Pattern]) -> (HappyAbsSyn )+happyIn56 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn56 #-}+happyOut56 :: (HappyAbsSyn ) -> ([C.Pattern])+happyOut56 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut56 #-}+happyIn57 :: ([C.Pattern]) -> (HappyAbsSyn )+happyIn57 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn57 #-}+happyOut57 :: (HappyAbsSyn ) -> ([C.Pattern])+happyOut57 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut57 #-}+happyIn58 :: (C.Pattern) -> (HappyAbsSyn )+happyIn58 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn58 #-}+happyOut58 :: (HappyAbsSyn ) -> (C.Pattern)+happyOut58 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut58 #-}+happyIn59 :: (C.Pattern) -> (HappyAbsSyn )+happyIn59 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn59 #-}+happyOut59 :: (HappyAbsSyn ) -> (C.Pattern)+happyOut59 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut59 #-}+happyIn60 :: (C.Pattern) -> (HappyAbsSyn )+happyIn60 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn60 #-}+happyOut60 :: (HappyAbsSyn ) -> (C.Pattern)+happyOut60 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut60 #-}+happyIn61 :: (C.Pattern) -> (HappyAbsSyn )+happyIn61 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn61 #-}+happyOut61 :: (HappyAbsSyn ) -> (C.Pattern)+happyOut61 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut61 #-}+happyIn62 :: (C.Pattern) -> (HappyAbsSyn )+happyIn62 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn62 #-}+happyOut62 :: (HappyAbsSyn ) -> (C.Pattern)+happyOut62 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut62 #-}+happyIn63 :: ([C.Clause]) -> (HappyAbsSyn )+happyIn63 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn63 #-}+happyOut63 :: (HappyAbsSyn ) -> ([C.Clause])+happyOut63 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut63 #-}+happyIn64 :: ([C.Clause ]) -> (HappyAbsSyn )+happyIn64 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn64 #-}+happyOut64 :: (HappyAbsSyn ) -> ([C.Clause ])+happyOut64 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut64 #-}+happyIn65 :: (C.TBind) -> (HappyAbsSyn )+happyIn65 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn65 #-}+happyOut65 :: (HappyAbsSyn ) -> (C.TBind)+happyOut65 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut65 #-}+happyIn66 :: (C.Telescope) -> (HappyAbsSyn )+happyIn66 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn66 #-}+happyOut66 :: (HappyAbsSyn ) -> (C.Telescope)+happyOut66 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut66 #-}+happyInTok :: (T.Token) -> (HappyAbsSyn )+happyInTok x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyInTok #-}+happyOutTok :: (HappyAbsSyn ) -> (T.Token)+happyOutTok x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOutTok #-}+++happyActOffsets :: HappyAddr+happyActOffsets = HappyA# "\x00\x00\x00\x00\xfe\x01\x55\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x72\x03\x00\x00\x7f\x03\x7f\x03\x7f\x03\xfa\x01\x5e\x03\x7d\x03\x7d\x03\x7d\x03\x00\x00\x3c\x03\x2a\x03\x18\x03\x06\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7d\x03\x49\x03\x00\x00\x4a\x03\x52\x03\x46\x03\x00\x00\x65\x03\x65\x03\x00\x00\xfe\x08\x00\x00\xfe\x08\x00\x00\xbe\x01\x00\x00\x00\x00\x65\x03\xf7\x08\x65\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x03\xfe\x08\x20\x01\x58\x03\x03\x00\x55\x00\x00\x00\x00\x00\xf4\x02\x58\x03\x58\x03\xc1\x00\xc1\x01\x00\x00\xe2\x02\xd0\x02\xbe\x02\xac\x02\x00\x00\x00\x00\x00\x00\x00\x00\x31\x00\x44\x03\x00\x00\x00\x00\x00\x00\x32\x03\x2d\x00\x30\x00\x00\x00\x00\x00\x33\x03\x00\x00\x00\x00\xc1\x01\x00\x00\xc1\x00\x8a\x00\xb4\x01\x00\x00\x00\x00\x0f\x01\xcf\x08\x21\x03\x00\x00\xe3\x08\x00\x00\x00\x00\x2b\x03\x00\x00\x29\x03\x1e\x03\xee\x01\x87\x01\x00\x00\x1f\x03\xc1\x00\x6b\x00\xe1\x01\xe1\x01\xe1\x01\x4b\x03\xc1\x00\xc1\x00\xc1\x00\x4b\x03\x00\x00\x00\x00\x28\x03\x20\x03\x22\x03\x00\x00\x39\x03\xc1\x00\x10\x03\x0d\x03\x31\x03\xfe\x02\x25\x03\xc1\x00\x00\x00\x25\x03\x01\x03\xfb\x02\xf7\x08\xeb\x02\xf7\x08\x13\x03\xc1\x00\x00\x00\xa7\x00\xe9\x02\x00\x00\xe6\x02\x99\x01\xd9\x02\x00\x00\xd4\x02\xc1\x00\x00\x00\xc1\x00\x00\x00\xd7\x02\xdb\x02\xf7\x08\x00\x00\x52\x01\xc1\x00\xc7\x02\xc1\x00\xef\x02\xce\x02\xc8\x02\x00\x00\xde\x02\x00\x00\xb0\x02\x24\x00\xb1\x02\x00\x00\xce\x01\xb2\x02\xa3\x02\x7d\x02\xa8\x02\x5b\x00\xa1\x02\x00\x00\xc1\x00\x00\x00\x00\x00\x00\x00\x50\x00\xb6\x02\xbb\x02\x91\x02\x00\x00\x66\x01\x00\x00\x00\x00\xb9\x02\xc1\x00\xc1\x00\xc1\x00\xe8\x00\xc1\x00\x92\x02\x92\x02\x57\x01\x59\x00\x00\x00\x00\x00\x00\x00\x7f\x02\xc1\x00\xc1\x00\x01\x00\x00\x00\x00\x00\x8c\x02\x83\x02\x8a\x00\x00\x00\xb4\x01\x7e\x02\x5c\x00\x00\x00\x00\x00\xa5\x02\x00\x00\x00\x00\x30\x00\x36\x01\x00\x00\x8e\x01\x8e\x01\xa5\x02\xe1\x01\x00\x00\x00\x00\x00\x00\x00\x00\x76\x02\x80\x02\x61\x02\xc1\x00\x00\x02\x00\x00\x45\x00\x79\x02\x6b\x02\x00\x00\xc1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x52\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x68\x02\xe5\xff\xc1\x00\x7a\x02\xc1\x00\xc1\x00\xc1\x00\x51\x02\xc1\x00\xc1\x00\x00\x00\x00\x00\xc1\x00\xc1\x00\x00\x00\x8e\x01\xc1\x00\x00\x00\x72\x02\x78\x02\x00\x00\x4f\x02\xc1\x00\x44\x02\x6c\x02\x66\x02\x3c\x02\x64\x02\xc1\x00\xf2\xff\x31\x02\x00\x00\xc1\x00\xc1\x00\xc1\x00\xc1\x00\xc1\x00\xc1\x00\x3a\x02\x34\x02\x29\x02\x00\x00\x2a\x02\x00\x00\xc1\x00\xc1\x00\xc1\x00\x27\x02\x42\x01\xc1\x00\x00\x00\x00\x00\x3e\x02\x00\x00\x1a\x02\x00\x00\x1c\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x19\x02\x0c\x02\x11\x02\x10\x02\x08\x02\x02\x02\x00\x00\xc1\x00\x30\x00\x00\x00\xc1\x00\xc1\x00\xc1\x00\xc1\x00\x09\x02\x1f\x02\x00\x00\xc1\x00\x00\x00\x00\x00\x00\x00\xc2\x01\xfc\x01\xf3\x01\xf1\x01\xf4\x01\x74\x00\xf0\x01\xc1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x02\x00\x00\x00\x00\x00\x00\x06\x02\x00\x00\xe7\x01\xd3\x01\xd1\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa6\x01\x9a\x01\x30\x00\xc1\x00\x00\x00\xbb\x01\xb0\x01\x6a\x01\x93\x01\x00\x00\xc1\x00\x92\x01\xc1\x00\x00\x00\x30\x00\x00\x00\x00\x00\x00\x00"#++happyGotoOffsets :: HappyAddr+happyGotoOffsets = HappyA# "\x65\x01\xb3\x01\x81\x09\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x62\x01\x1c\x01\x0f\x00\x00\x00\x00\x00\xa0\x00\x99\x00\xe0\x01\x00\x00\x71\x09\x61\x09\x51\x09\x41\x09\x00\x00\xaf\x01\x00\x00\xaa\x01\x00\x00\x97\x01\x00\x00\x86\x01\xcb\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x76\x01\x12\x01\x0e\x01\x00\x00\x79\x00\x00\x00\x6a\x00\x00\x00\x07\x02\x00\x00\x00\x00\x34\x01\x86\x09\x2a\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x54\x00\x00\x00\xa8\x01\x82\x01\x00\x00\x00\x00\x00\x00\x31\x09\x97\x00\x41\x00\x8d\x08\x60\x02\x00\x00\x31\x09\x31\x09\x31\x09\x31\x09\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd2\x00\xd0\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xee\xff\x00\x00\x97\x04\x46\x02\x83\x01\x00\x00\x00\x00\xc1\x08\x7d\x09\x00\x00\x00\x00\xc5\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x79\x01\x00\x00\x00\x00\x7d\x04\x0e\x02\x67\x01\x4d\x01\x28\x01\x71\x01\x19\x05\x79\x03\xff\x04\x43\x01\x9d\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1d\x00\x73\x08\x00\x00\x00\x00\x1e\x01\x00\x00\xcb\x00\x59\x08\x00\x00\x0d\x01\x00\x00\x00\x00\xab\x08\x13\x01\x77\x02\xcc\x00\x63\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3f\x08\x00\x00\x49\x04\x00\x00\x00\x00\x00\x00\x35\x02\x00\x00\x00\x00\x25\x08\x00\x00\x0b\x08\xb6\x00\x00\x00\x00\x00\x00\x00\x2b\x00\x00\x00\x00\x00\xc3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2f\x04\x00\x00\x00\x00\x00\x00\xfb\x00\x00\x00\xda\x00\xd7\x00\x00\x00\x70\x01\x00\x00\x00\x00\x9f\x00\xf1\x07\xd7\x07\xbd\x07\xa7\x08\xa3\x07\xae\x00\xa8\x00\x22\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe5\x04\x5f\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1e\x02\x00\x00\x01\x01\x00\x00\x00\x00\x00\x00\x00\x00\x35\x01\x00\x00\x00\x00\xb9\x00\x4b\x02\x00\x00\x75\x02\x9e\x01\x85\x00\xf2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x89\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x45\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\x15\x04\x80\x00\x6f\x07\x55\x07\x3b\x07\x00\x00\x21\x07\x07\x07\x00\x00\x00\x00\xcb\x04\xfb\x03\x00\x00\x65\x02\xe1\x03\x00\x00\x77\x00\x04\x00\x00\x00\x00\x00\xed\x06\x00\x00\x69\x00\xfb\xff\x00\x00\xf0\xff\xd3\x06\x00\x00\x00\x00\x00\x00\xc7\x03\xb9\x06\xb1\x04\x9f\x06\x85\x06\x6b\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x51\x06\x37\x06\x1d\x06\x00\x00\x00\x00\x03\x06\x00\x00\x00\x00\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\xe9\x05\xc4\x00\x00\x00\xcf\x05\xb5\x05\x9b\x05\x81\x05\x00\x00\x31\x01\x00\x00\xad\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x67\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x61\x00\x00\x00\x00\x00\x00\x00\x35\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x9b\x00\x93\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x05\x00\x00\x33\x05\x00\x00\x82\x00\x00\x00\x00\x00\x00\x00"#++happyDefActions :: HappyAddr+happyDefActions = HappyA# "\xfd\xff\x00\x00\xdb\xff\x00\x00\xfc\xff\xfb\xff\xf9\xff\xfa\xff\xf8\xff\xf7\xff\xf6\xff\xf5\xff\xf4\xff\xf3\xff\x00\x00\xf2\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xda\xff\xdb\xff\xdb\xff\xdb\xff\xdb\xff\xf1\xff\xfd\xff\xeb\xff\xfd\xff\xed\xff\xfd\xff\xef\xff\xfd\xff\xd3\xff\x00\x00\xd4\xff\x00\x00\x00\x00\x00\x00\xfd\xff\x00\x00\x00\x00\xe5\xff\x44\xff\xe7\xff\x44\xff\xe9\xff\x00\x00\xdd\xff\xae\xff\x00\x00\xc3\xff\x00\x00\xcc\xff\xcf\xff\xce\xff\xcd\xff\xca\xff\xcb\xff\x00\x00\x44\xff\x00\x00\x00\x00\x00\x00\x00\x00\xe6\xff\xe8\xff\xdb\xff\x49\xff\x49\xff\xc3\xff\x00\x00\xd2\xff\xdb\xff\xdb\xff\xdb\xff\xdb\xff\xf0\xff\xea\xff\xec\xff\xee\xff\x75\xff\x00\x00\x7d\xff\x53\xff\xd7\xff\x57\xff\x56\xff\x5c\xff\x76\xff\x78\xff\x00\x00\x80\xff\x7e\xff\x00\x00\x7f\xff\xc3\xff\xc3\xff\x00\x00\x7a\xff\x75\xff\x00\x00\x8b\xff\x9e\xff\x9d\xff\x8c\xff\xba\xff\xb9\xff\x00\x00\x70\xff\x95\xff\x00\x00\x91\xff\x89\xff\x84\xff\x78\xff\xc3\xff\x00\x00\x87\xff\x00\x00\x00\x00\x00\x00\xc3\xff\xc3\xff\xc3\xff\x00\x00\x61\xff\x4a\xff\x00\x00\x4d\xff\x00\x00\xde\xff\x00\x00\xc3\xff\xd1\xff\x00\x00\x00\x00\x00\x00\x6a\xff\xc3\xff\x43\xff\x00\x00\x00\x00\x00\x00\xc3\xff\xd9\xff\xc3\xff\x00\x00\xc3\xff\xac\xff\x75\xff\x00\x00\xc4\xff\x9b\xff\xd1\xff\x00\x00\xc2\xff\x00\x00\xc3\xff\xc1\xff\xc3\xff\xad\xff\x00\x00\x00\x00\xc3\xff\x6b\xff\x00\x00\xc3\xff\x00\x00\xc3\xff\x00\x00\x00\x00\x00\x00\xe0\xff\x4b\xff\xdf\xff\x63\xff\x62\xff\x00\x00\xc9\xff\x00\x00\x00\x00\x9c\xff\x75\xff\x00\x00\xd1\xff\x00\x00\x79\xff\xc3\xff\x88\xff\x86\xff\xab\xff\x00\x00\x00\x00\x00\x00\xd9\xff\x9c\xff\x00\x00\x83\xff\x81\xff\x00\x00\xc3\xff\xc3\xff\xc3\xff\x00\x00\xc3\xff\x00\x00\x00\x00\x00\x00\x8b\xff\x8a\xff\x8c\xff\xa1\xff\x91\xff\xc3\xff\xc3\xff\x4e\xff\x59\xff\x5a\xff\x84\xff\x00\x00\xc3\xff\x5e\xff\xcc\xff\x00\x00\x75\xff\x5b\xff\x5c\xff\x72\xff\x4f\xff\x51\xff\x00\x00\x00\x00\x50\xff\x00\x00\x00\x00\x00\x00\x00\x00\x54\xff\x55\xff\x58\xff\x52\xff\x00\x00\x00\x00\x73\xff\xc3\xff\x75\xff\x5d\xff\x75\xff\x00\x00\x00\x00\x8d\xff\xc3\xff\xc5\xff\xc6\xff\x99\xff\x90\xff\x91\xff\x94\xff\x92\xff\x93\xff\x82\xff\x85\xff\x00\x00\x00\x00\xc3\xff\x00\x00\xc3\xff\xc3\xff\xc3\xff\xa2\xff\xc3\xff\xc3\xff\x7b\xff\xc8\xff\xc3\xff\xc3\xff\x60\xff\x00\x00\xc3\xff\x4c\xff\xd6\xff\x00\x00\xd0\xff\x00\x00\xc3\xff\x00\x00\xd6\xff\x6c\xff\x6e\xff\x6a\xff\xc3\xff\x75\xff\x00\x00\xd8\xff\xc3\xff\xc3\xff\xc3\xff\xc3\xff\xc3\xff\xc3\xff\x00\x00\x00\x00\x00\x00\x9a\xff\x00\x00\xdc\xff\xc3\xff\xc3\xff\xc3\xff\x00\x00\x00\x00\xc3\xff\x6d\xff\xe3\xff\x00\x00\x47\xff\x00\x00\x48\xff\x00\x00\xe1\xff\x64\xff\x5f\xff\x98\xff\xc7\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x97\xff\xc3\xff\x65\xff\x8e\xff\xc3\xff\xc3\xff\xc3\xff\xc3\xff\x00\x00\x72\xff\x77\xff\xc3\xff\x71\xff\x74\xff\x7c\xff\x84\xff\x00\x00\x00\x00\x00\x00\x00\x00\x66\xff\x00\x00\xc3\xff\xb5\xff\xb4\xff\xb3\xff\xb7\xff\xb6\xff\xd6\xff\x45\xff\xd5\xff\x6f\xff\xd6\xff\x46\xff\x00\x00\x00\x00\x00\x00\xb8\xff\xc0\xff\xbf\xff\xbe\xff\xbd\xff\xbc\xff\xbb\xff\xe4\xff\xe2\xff\x00\x00\x00\x00\x65\xff\xc3\xff\x96\xff\xbd\xff\xbc\xff\xbb\xff\x68\xff\x67\xff\xc3\xff\x00\x00\xc3\xff\xaa\xff\x65\xff\x69\xff\xa9\xff"#++happyCheck :: HappyAddr+happyCheck = HappyA# "\xff\xff\x13\x00\x01\x00\x13\x00\x01\x00\x04\x00\x05\x00\x06\x00\x07\x00\x24\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x13\x00\x2a\x00\x0f\x00\x1f\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x13\x00\x09\x00\x2b\x00\x2c\x00\x13\x00\x1b\x00\x15\x00\x1d\x00\x2d\x00\x30\x00\x31\x00\x13\x00\x22\x00\x36\x00\x01\x00\x25\x00\x26\x00\x3a\x00\x28\x00\x29\x00\x30\x00\x2b\x00\x2c\x00\x01\x00\x2e\x00\x13\x00\x01\x00\x01\x00\x30\x00\x30\x00\x04\x00\x05\x00\x06\x00\x07\x00\x38\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x13\x00\x1b\x00\x0f\x00\x1d\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x12\x00\x1b\x00\x25\x00\x1d\x00\x1b\x00\x1b\x00\x30\x00\x1d\x00\x2b\x00\x1f\x00\x01\x00\x25\x00\x22\x00\x13\x00\x25\x00\x25\x00\x26\x00\x2b\x00\x28\x00\x29\x00\x2b\x00\x2b\x00\x01\x00\x33\x00\x2e\x00\x04\x00\x05\x00\x06\x00\x07\x00\x1f\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x38\x00\x16\x00\x0f\x00\x01\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x2d\x00\x12\x00\x33\x00\x25\x00\x21\x00\x1b\x00\x1f\x00\x1d\x00\x1f\x00\x12\x00\x3b\x00\x3c\x00\x22\x00\x2a\x00\x16\x00\x25\x00\x26\x00\x28\x00\x28\x00\x29\x00\x2d\x00\x2b\x00\x2d\x00\x12\x00\x2e\x00\x01\x00\x02\x00\x03\x00\x23\x00\x16\x00\x06\x00\x3d\x00\x3e\x00\x13\x00\x38\x00\x13\x00\x2b\x00\x0d\x00\x13\x00\x0f\x00\x2f\x00\x30\x00\x31\x00\x29\x00\x33\x00\x34\x00\x2c\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x3d\x00\x3e\x00\x1f\x00\x13\x00\x21\x00\x13\x00\x23\x00\x13\x00\x25\x00\x26\x00\x27\x00\x13\x00\x13\x00\x32\x00\x2b\x00\x3d\x00\x3e\x00\x36\x00\x2f\x00\x30\x00\x31\x00\x3a\x00\x33\x00\x34\x00\x17\x00\x36\x00\x37\x00\x01\x00\x02\x00\x03\x00\x17\x00\x1f\x00\x06\x00\x2f\x00\x13\x00\x33\x00\x15\x00\x13\x00\x32\x00\x0d\x00\x2f\x00\x0f\x00\x36\x00\x3b\x00\x3c\x00\x2d\x00\x3a\x00\x13\x00\x13\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x13\x00\x13\x00\x1f\x00\x15\x00\x21\x00\x13\x00\x23\x00\x13\x00\x25\x00\x10\x00\x27\x00\x01\x00\x02\x00\x03\x00\x2b\x00\x13\x00\x06\x00\x36\x00\x2f\x00\x30\x00\x31\x00\x3a\x00\x33\x00\x34\x00\x32\x00\x36\x00\x37\x00\x36\x00\x36\x00\x30\x00\x31\x00\x3a\x00\x3a\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x13\x00\x36\x00\x1f\x00\x36\x00\x21\x00\x3a\x00\x23\x00\x3a\x00\x25\x00\x13\x00\x27\x00\x01\x00\x02\x00\x03\x00\x2b\x00\x13\x00\x06\x00\x08\x00\x2f\x00\x30\x00\x31\x00\x08\x00\x33\x00\x34\x00\x2b\x00\x2c\x00\x37\x00\x13\x00\x13\x00\x15\x00\x10\x00\x08\x00\x13\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x2b\x00\x2c\x00\x1f\x00\x13\x00\x21\x00\x13\x00\x23\x00\x15\x00\x25\x00\x13\x00\x27\x00\x01\x00\x02\x00\x03\x00\x2b\x00\x13\x00\x06\x00\x13\x00\x2f\x00\x30\x00\x31\x00\x21\x00\x33\x00\x34\x00\x13\x00\x14\x00\x37\x00\x13\x00\x13\x00\x14\x00\x2a\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x2b\x00\x2c\x00\x1f\x00\x13\x00\x14\x00\x01\x00\x02\x00\x03\x00\x25\x00\x26\x00\x06\x00\x2d\x00\x2e\x00\x13\x00\x2b\x00\x2d\x00\x2e\x00\x22\x00\x00\x00\x01\x00\x01\x00\x02\x00\x03\x00\x08\x00\x29\x00\x06\x00\x37\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x22\x00\x13\x00\x1f\x00\x01\x00\x2b\x00\x2c\x00\x13\x00\x29\x00\x25\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x13\x00\x13\x00\x1f\x00\x15\x00\x01\x00\x01\x00\x02\x00\x03\x00\x25\x00\x13\x00\x06\x00\x37\x00\x01\x00\x02\x00\x03\x00\x2b\x00\x2c\x00\x06\x00\x13\x00\x13\x00\x15\x00\x01\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x37\x00\x17\x00\x35\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x2b\x00\x2c\x00\x1f\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x01\x00\x25\x00\x1f\x00\x2b\x00\x2c\x00\x01\x00\x13\x00\x2b\x00\x25\x00\x01\x00\x01\x00\x02\x00\x03\x00\x1f\x00\x2b\x00\x06\x00\x13\x00\x29\x00\x15\x00\x37\x00\x01\x00\x2e\x00\x28\x00\x01\x00\x02\x00\x03\x00\x37\x00\x2d\x00\x06\x00\x2e\x00\x2b\x00\x2c\x00\x17\x00\x26\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x34\x00\x35\x00\x1f\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x25\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x13\x00\x14\x00\x1f\x00\x23\x00\x01\x00\x02\x00\x03\x00\x35\x00\x25\x00\x06\x00\x26\x00\x2b\x00\x28\x00\x37\x00\x2b\x00\x2f\x00\x30\x00\x31\x00\x35\x00\x33\x00\x34\x00\x13\x00\x14\x00\x27\x00\x28\x00\x26\x00\x37\x00\x26\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x04\x00\x05\x00\x1f\x00\x01\x00\x04\x00\x05\x00\x06\x00\x07\x00\x25\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x1d\x00\x1e\x00\x26\x00\x08\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x24\x00\x0e\x00\x22\x00\x26\x00\x37\x00\x26\x00\x13\x00\x1b\x00\x0e\x00\x16\x00\x30\x00\x1f\x00\x01\x00\x13\x00\x26\x00\x35\x00\x16\x00\x25\x00\x26\x00\x20\x00\x28\x00\x20\x00\x22\x00\x2b\x00\x2a\x00\x2d\x00\x20\x00\x21\x00\x24\x00\x13\x00\x22\x00\x22\x00\x16\x00\x17\x00\x38\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x24\x00\x22\x00\x01\x00\x26\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x16\x00\x17\x00\x26\x00\x24\x00\x26\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x13\x00\x26\x00\x2a\x00\x16\x00\x17\x00\x13\x00\x19\x00\x26\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x01\x00\x2a\x00\x01\x00\x24\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x13\x00\x08\x00\x26\x00\x2b\x00\x2c\x00\x13\x00\x01\x00\x08\x00\x01\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x35\x00\x35\x00\x13\x00\x21\x00\x29\x00\x2b\x00\x2c\x00\x16\x00\x17\x00\x24\x00\x2b\x00\x2c\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x36\x00\x1f\x00\x38\x00\x39\x00\x3a\x00\x2b\x00\x2c\x00\x22\x00\x2a\x00\x2e\x00\x28\x00\x01\x00\x2a\x00\x2a\x00\x26\x00\x2d\x00\x36\x00\x20\x00\x38\x00\x39\x00\x3a\x00\x04\x00\x05\x00\x06\x00\x07\x00\x35\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x27\x00\x01\x00\x2a\x00\x01\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x04\x00\x05\x00\x06\x00\x07\x00\x10\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x2a\x00\x24\x00\x2a\x00\x22\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x04\x00\x05\x00\x06\x00\x07\x00\x26\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x2c\x00\x2e\x00\x01\x00\x22\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x04\x00\x05\x00\x06\x00\x07\x00\x22\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x21\x00\x01\x00\x2a\x00\x22\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x04\x00\x05\x00\x06\x00\x07\x00\x21\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x2a\x00\x2e\x00\x2a\x00\x22\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x04\x00\x05\x00\x06\x00\x07\x00\x28\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x2a\x00\x01\x00\x2a\x00\x22\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x04\x00\x05\x00\x06\x00\x07\x00\x25\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x24\x00\x01\x00\x21\x00\x2a\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x04\x00\x05\x00\x06\x00\x07\x00\x01\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x2a\x00\x28\x00\x21\x00\x01\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x04\x00\x05\x00\x06\x00\x07\x00\x22\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x29\x00\x22\x00\x21\x00\x01\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x33\x00\x35\x00\x21\x00\x2c\x00\x35\x00\x2c\x00\x13\x00\x01\x00\x28\x00\x16\x00\x17\x00\x21\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x20\x00\x25\x00\x01\x00\x21\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x13\x00\x21\x00\x2a\x00\x16\x00\x17\x00\x2e\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x01\x00\x21\x00\x01\x00\x0f\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x13\x00\x38\x00\xff\xff\x16\x00\x17\x00\xff\xff\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x13\x00\xff\xff\xff\xff\x16\x00\x17\x00\xff\xff\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x13\x00\xff\xff\xff\xff\x16\x00\x17\x00\xff\xff\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x13\x00\xff\xff\xff\xff\x16\x00\x17\x00\xff\xff\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x13\x00\xff\xff\xff\xff\x16\x00\x17\x00\xff\xff\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x13\x00\xff\xff\xff\xff\x16\x00\x17\x00\xff\xff\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x13\x00\xff\xff\xff\xff\x16\x00\x17\x00\xff\xff\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x13\x00\xff\xff\xff\xff\x16\x00\x17\x00\xff\xff\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x13\x00\xff\xff\xff\xff\x16\x00\x17\x00\xff\xff\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x23\x00\xff\xff\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x13\x00\xff\xff\xff\xff\x16\x00\x17\x00\xff\xff\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x23\x00\xff\xff\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x13\x00\xff\xff\xff\xff\x16\x00\x17\x00\xff\xff\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x13\x00\xff\xff\xff\xff\x16\x00\x17\x00\xff\xff\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x13\x00\xff\xff\xff\xff\x16\x00\x17\x00\xff\xff\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x23\x00\xff\xff\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x13\x00\xff\xff\xff\xff\x16\x00\x17\x00\x18\x00\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x23\x00\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x13\x00\xff\xff\x15\x00\x16\x00\x17\x00\xff\xff\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x23\x00\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x13\x00\xff\xff\xff\xff\x16\x00\x17\x00\x18\x00\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x23\x00\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x13\x00\xff\xff\x15\x00\x16\x00\x17\x00\xff\xff\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x23\x00\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x13\x00\xff\xff\xff\xff\x16\x00\x17\x00\xff\xff\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x23\x00\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x13\x00\xff\xff\xff\xff\x16\x00\x17\x00\xff\xff\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x23\x00\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x13\x00\xff\xff\xff\xff\x16\x00\x17\x00\xff\xff\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x23\x00\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x13\x00\xff\xff\xff\xff\x16\x00\x17\x00\xff\xff\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x23\x00\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x13\x00\xff\xff\xff\xff\x16\x00\x17\x00\xff\xff\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x23\x00\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x13\x00\xff\xff\xff\xff\x16\x00\x17\x00\xff\xff\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x23\x00\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x13\x00\xff\xff\xff\xff\x16\x00\x17\x00\xff\xff\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x23\x00\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x13\x00\xff\xff\xff\xff\x16\x00\x17\x00\xff\xff\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x23\x00\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x13\x00\xff\xff\xff\xff\x16\x00\x17\x00\xff\xff\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x23\x00\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x13\x00\xff\xff\xff\xff\x16\x00\x17\x00\xff\xff\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x23\x00\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x13\x00\xff\xff\xff\xff\x16\x00\x17\x00\xff\xff\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x23\x00\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x13\x00\xff\xff\xff\xff\x16\x00\x17\x00\xff\xff\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x23\x00\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x13\x00\xff\xff\xff\xff\x16\x00\x17\x00\xff\xff\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x23\x00\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x13\x00\xff\xff\xff\xff\x16\x00\x17\x00\xff\xff\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x23\x00\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x13\x00\xff\xff\xff\xff\x16\x00\x17\x00\xff\xff\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x23\x00\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x13\x00\xff\xff\xff\xff\x16\x00\x17\x00\xff\xff\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x23\x00\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x13\x00\xff\xff\xff\xff\x16\x00\x17\x00\xff\xff\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x23\x00\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x13\x00\xff\xff\xff\xff\x16\x00\x17\x00\xff\xff\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x23\x00\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x13\x00\xff\xff\xff\xff\x16\x00\x17\x00\xff\xff\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x23\x00\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x13\x00\xff\xff\xff\xff\x16\x00\x17\x00\xff\xff\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x23\x00\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x13\x00\xff\xff\xff\xff\x16\x00\x17\x00\xff\xff\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x23\x00\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x13\x00\xff\xff\xff\xff\x16\x00\x17\x00\xff\xff\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x23\x00\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x13\x00\xff\xff\xff\xff\x16\x00\x17\x00\xff\xff\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x23\x00\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x13\x00\xff\xff\xff\xff\x16\x00\x17\x00\xff\xff\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x23\x00\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x13\x00\xff\xff\xff\xff\x16\x00\x17\x00\xff\xff\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x23\x00\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x13\x00\xff\xff\xff\xff\x16\x00\x17\x00\xff\xff\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x23\x00\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x13\x00\xff\xff\xff\xff\x16\x00\x17\x00\xff\xff\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x23\x00\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x13\x00\xff\xff\xff\xff\x16\x00\x17\x00\xff\xff\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x23\x00\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x13\x00\xff\xff\xff\xff\x16\x00\x17\x00\xff\xff\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x23\x00\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x13\x00\xff\xff\xff\xff\x16\x00\x17\x00\xff\xff\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x23\x00\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x13\x00\xff\xff\xff\xff\x16\x00\x17\x00\xff\xff\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x23\x00\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x13\x00\xff\xff\xff\xff\x16\x00\x17\x00\xff\xff\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x23\x00\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x13\x00\xff\xff\xff\xff\x16\x00\x17\x00\xff\xff\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x23\x00\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x13\x00\xff\xff\xff\xff\x16\x00\x17\x00\xff\xff\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x23\x00\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x13\x00\xff\xff\xff\xff\x16\x00\x17\x00\xff\xff\x19\x00\x16\x00\x17\x00\x1c\x00\x1d\x00\x1e\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x13\x00\xff\xff\xff\xff\x16\x00\x17\x00\xff\xff\x19\x00\x16\x00\x17\x00\x1c\x00\x1d\x00\x1e\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x1f\x00\xff\xff\x21\x00\xff\xff\x23\x00\xff\xff\x25\x00\xff\xff\x27\x00\xff\xff\xff\xff\xff\xff\x2b\x00\x2c\x00\x2d\x00\xff\xff\x2f\x00\x30\x00\x31\x00\xff\xff\x33\x00\x34\x00\x21\x00\xff\xff\x23\x00\xff\xff\x25\x00\xff\xff\x27\x00\xff\xff\xff\xff\xff\xff\x2b\x00\x2c\x00\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\xff\xff\x33\x00\x34\x00\x21\x00\xff\xff\x23\x00\xff\xff\x25\x00\xff\xff\x27\x00\xff\xff\xff\xff\x23\x00\x2b\x00\x25\x00\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x2b\x00\x33\x00\x34\x00\xff\xff\x2f\x00\x30\x00\x31\x00\xff\xff\x33\x00\x34\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\xff\xff\xff\xff\x0a\x00\x0b\x00\x0c\x00\x0d\x00\xff\xff\x0f\x00\xff\xff\x11\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\xff\xff\xff\xff\x0a\x00\x0b\x00\x0c\x00\x0d\x00\xff\xff\x0f\x00\xff\xff\x11\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\xff\xff\xff\xff\x0a\x00\x0b\x00\x0c\x00\x0d\x00\xff\xff\x0f\x00\xff\xff\x11\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\xff\xff\xff\xff\x0a\x00\x0b\x00\x0c\x00\x0d\x00\xff\xff\x0f\x00\xff\xff\x11\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\xff\xff\xff\xff\x0a\x00\x0b\x00\x0c\x00\x0d\x00\xff\xff\x0f\x00\xff\xff\x11\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\xff\xff\xff\xff\x0a\x00\x0b\x00\x0c\x00\x0d\x00\xff\xff\x0f\x00\xff\xff\x11\x00\x16\x00\x17\x00\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x16\x00\x17\x00\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\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"#++happyTable :: HappyAddr+happyTable = HappyA# "\x00\x00\xe5\x00\x4e\xff\xa8\x00\x28\x00\x4e\xff\x4e\xff\x4e\xff\x4e\xff\xa6\x00\x4e\xff\x4e\xff\x4e\xff\x4e\xff\xa8\x00\x51\x01\x4e\xff\x39\x01\x4e\xff\x4e\xff\x4e\xff\x4e\xff\x4e\xff\xa8\x00\x2e\x00\xbf\x00\x57\x00\x8a\x00\x4e\xff\x6d\x01\x4e\xff\x3a\x01\xa9\x00\x3b\x01\x2f\x00\x4e\xff\xe6\x00\x28\x00\x4e\xff\x4e\xff\xe7\x00\x4e\xff\x4e\xff\x3d\x01\x4e\xff\x4e\xff\x28\x00\x4e\xff\xa8\x00\x28\x00\x4f\xff\x8d\x00\x43\x01\x4f\xff\x4f\xff\x4f\xff\x4f\xff\x4e\xff\x4f\xff\x4f\xff\x4f\xff\x4f\xff\x82\x00\xec\x00\x4f\xff\x1b\x01\x4f\xff\x4f\xff\x4f\xff\x4f\xff\x4f\xff\x7b\x01\xec\x00\xed\x00\xef\x00\xec\x00\x4f\xff\xb0\x00\x4f\xff\x67\x00\xf2\x00\x28\x00\xed\x00\x4f\xff\x82\x00\xed\x00\x4f\xff\x4f\xff\x67\x00\x4f\xff\x4f\xff\x67\x00\x4f\xff\x4f\xff\x1c\x01\x4f\xff\x4f\xff\x4f\xff\x4f\xff\x4f\xff\x55\x01\x4f\xff\x4f\xff\x4f\xff\x4f\xff\x4f\xff\x3f\x00\x4f\xff\x28\x00\x4f\xff\x4f\xff\x4f\xff\x4f\xff\x4f\xff\x56\x01\x7c\x01\x83\x00\x0f\x01\x89\x00\x4f\xff\xd3\x00\x4f\xff\x11\x01\x3e\x01\x84\x00\x85\x00\x4f\xff\x8a\x00\x3f\x00\x4f\xff\x4f\xff\xaf\x00\x4f\xff\x4f\xff\xd4\x00\x4f\xff\x12\x01\x44\x01\x4f\xff\x28\x00\x5e\x00\x78\x00\xc7\x00\x3f\x00\x60\x00\x40\x00\x90\x00\x4e\x01\x4f\xff\xe9\x00\x3a\x00\x79\x00\xf3\x00\x7a\x00\x3b\x00\x3c\x00\x3d\x00\x80\x01\x3e\x00\x3f\x00\x81\x01\x7b\x00\x7c\x00\x61\x00\x62\x00\x63\x00\x64\x00\x40\x00\x41\x00\x65\x00\x82\x00\x7e\x00\x28\x00\x7f\x00\xe9\x00\xe2\x00\xe3\x00\x81\x00\x09\x01\x28\x00\x8c\x01\xe4\x00\x40\x00\x44\x00\x63\x01\x3b\x00\x3c\x00\x3d\x00\xe7\x00\x3e\x00\x3f\x00\x01\x01\x82\x00\x68\x00\x28\x00\x5e\x00\x78\x00\x02\x01\x30\x01\x60\x00\x29\x00\x8a\x00\x83\x00\x1f\x01\xe9\x00\x86\x01\x79\x00\x2a\x00\x7a\x00\x63\x01\x86\x00\x85\x00\x31\x01\xe7\x00\xe9\x00\xe9\x00\x7b\x00\x7c\x00\x61\x00\x62\x00\x7d\x00\x64\x00\xa8\x00\x9e\x00\x65\x00\x9f\x00\x7e\x00\xe9\x00\x7f\x00\xe9\x00\x80\x00\x0b\x01\x81\x00\x28\x00\x5e\x00\x78\x00\x3a\x00\x0c\x01\x60\x00\xe6\x00\x3b\x00\x3c\x00\x3d\x00\xe7\x00\x3e\x00\x3f\x00\x62\x01\x82\x00\x68\x00\x19\x01\x63\x01\xa9\x00\xaa\x00\xe7\x00\xe7\x00\x7b\x00\x7c\x00\x61\x00\x62\x00\x7d\x00\x64\x00\x68\x00\xea\x00\x65\x00\xed\x00\x7e\x00\xe7\x00\xdb\x00\xe7\x00\x80\x00\x99\x00\x81\x00\x28\x00\x5e\x00\x78\x00\x3a\x00\xdc\x00\x60\x00\x45\x00\x3b\x00\x3c\x00\x3d\x00\x46\x00\x3e\x00\x3f\x00\xf2\x00\x57\x00\x68\x00\x8a\x00\x31\x00\xa6\x00\xa1\x00\x30\x00\x31\x00\x7b\x00\x7c\x00\x61\x00\x62\x00\x7d\x00\x64\x00\xdd\x00\x57\x00\x65\x00\x31\x00\x7e\x00\x8a\x00\xdb\x00\xac\x00\xdc\x00\x68\x00\x81\x00\x28\x00\x5e\x00\x5f\x00\x3a\x00\x68\x00\x60\x00\x92\x00\x3b\x00\x3c\x00\x3d\x00\x8f\x00\x3e\x00\x3f\x00\x25\x00\xf6\x00\x68\x00\x99\x00\x25\x00\xf6\x00\x90\x00\xff\x00\x75\x00\x76\x00\x57\x00\x61\x00\x62\x00\x63\x00\x64\x00\xbf\x00\x57\x00\x65\x00\x25\x00\xb6\x00\x28\x00\x5e\x00\x78\x00\x66\x00\xe3\x00\x60\x00\x5c\x01\xf8\x00\x68\x00\x67\x00\xf7\x00\xf8\x00\x70\x01\x03\x00\x02\x00\x28\x00\x5e\x00\x78\x00\x32\x00\x25\x01\x60\x00\x68\x00\x7b\x00\x7c\x00\x61\x00\x62\x00\x7d\x00\x64\x00\x24\x01\x31\x00\x65\x00\x47\x00\xc1\x00\x57\x00\x68\x00\x25\x01\x01\x01\x7b\x00\x7c\x00\x61\x00\x62\x00\x7d\x00\x64\x00\x68\x00\xbd\x00\x65\x00\xbe\x00\x4d\x00\x28\x00\x5e\x00\x5f\x00\xc1\x00\x68\x00\x60\x00\x68\x00\x28\x00\x5e\x00\x5f\x00\xc2\x00\x57\x00\x60\x00\x8a\x00\xdc\x00\x8b\x00\x4e\x00\x0a\x01\x75\x00\x76\x00\x57\x00\x68\x00\xcc\x00\xbb\xff\x61\x00\x62\x00\x7d\x00\x64\x00\xca\x00\x57\x00\x65\x00\x61\x00\x62\x00\x63\x00\x64\x00\x4f\x00\xc1\x00\x65\x00\xdd\x00\x57\x00\x50\x00\x55\x00\xcd\x00\x66\x00\x02\x00\x28\x00\x5e\x00\x5f\x00\x14\x01\x67\x00\x60\x00\x8a\x00\x8c\x01\x8d\x00\x68\x00\x28\x00\x8a\x01\xaf\x00\x28\x00\x5e\x00\x5f\x00\x68\x00\x15\x01\x60\x00\x88\x01\x56\x00\x57\x00\xdf\x00\x89\x01\x61\x00\x62\x00\x7d\x00\x64\x00\xb4\x00\xb5\x00\x65\x00\x58\x00\xf4\x00\x5a\x00\x5b\x00\x5c\x00\xc1\x00\x61\x00\x62\x00\x63\x00\x64\x00\x25\x00\x4c\x00\x65\x00\x39\x00\x28\x00\x5e\x00\x5f\x00\xbc\xff\x66\x00\x60\x00\x54\xff\x3a\x00\x54\xff\x68\x00\x67\x00\x3b\x00\x3c\x00\x3d\x00\xbd\xff\x3e\x00\x3f\x00\x25\x00\x26\x00\x17\x01\x18\x01\x79\x01\x68\x00\x7a\x01\x61\x00\x62\x00\x7d\x00\x64\x00\x2d\x00\x2e\x00\x65\x00\x4f\xff\x11\x00\x12\x00\x13\x00\x14\x00\xc1\x00\x15\x00\x16\x00\x17\x00\x18\x00\xce\x00\xcf\x00\x7b\x01\x40\x01\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x7f\x01\x34\x00\x82\x01\x83\x01\x68\x00\x84\x01\x35\x00\x4f\xff\xc3\x00\x36\x00\xd0\x00\x57\x01\x28\x00\x35\x00\x85\x01\x8f\xff\xc4\x00\x4f\xff\x4f\xff\x37\x00\x4f\xff\x5e\x01\x67\x01\x4f\xff\x66\x01\x31\x01\x37\x00\xc5\x00\x6a\x01\xfa\x00\x68\x01\x69\x01\x69\x00\x6a\x00\xfe\xff\x6b\x00\x9b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x6b\x01\x6c\x01\x28\x00\x6d\x01\x70\x00\xb9\x00\xba\x00\x9d\x00\x72\x00\x73\x00\x74\x00\x75\x00\xdf\x00\x57\x00\x93\x00\x94\x00\x71\x01\x75\x01\x76\x01\x25\x01\x96\x00\x6e\x00\x6f\x00\x58\x00\xe0\x00\x5a\x00\x5b\x00\x5c\x00\x55\x00\x77\x01\x38\x01\x69\x00\x6a\x00\x55\x00\x6b\x00\x78\x01\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x28\x00\x3d\x01\x28\x00\x41\x01\x70\x00\xb9\x00\xc8\x00\x9d\x00\x72\x00\x73\x00\x74\x00\x75\x00\xdf\x00\x57\x00\x55\x00\x40\x01\x43\x01\x56\x00\x57\x00\x55\x00\x28\x00\x40\x01\x28\x00\x58\x00\xe0\x00\x5a\x00\x5b\x00\x5c\x00\x58\x00\xe0\x00\x5a\x00\x5b\x00\x5c\x00\x8e\xff\x8f\xff\x55\x00\x52\x01\x59\x01\x56\x00\x57\x00\x93\x00\x94\x00\x53\x01\x56\x00\x57\x00\xa0\x00\x96\x00\x6e\x00\x6f\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x58\x00\x14\x01\x46\x01\x5b\x00\x5c\x00\x56\x00\x57\x00\x5a\x01\x54\x01\x5b\x01\xaf\x00\x28\x00\xd1\xff\xfa\x00\xfc\x00\x15\x01\x58\x00\xf1\x00\xf5\x00\x5b\x00\x5c\x00\x11\x00\x12\x00\x13\x00\x14\x00\x8d\xff\x15\x00\x16\x00\x17\x00\x18\x00\x81\x00\x28\x00\xa3\x00\x28\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x11\x00\x12\x00\x13\x00\x14\x00\x0e\x01\x15\x00\x16\x00\x17\x00\x18\x00\x10\x01\x13\x01\xc4\xff\x52\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x11\x00\x12\x00\x13\x00\x14\x00\x16\x01\x15\x00\x16\x00\x17\x00\x18\x00\x19\x01\x1c\x01\x28\x00\x53\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x11\x00\x12\x00\x13\x00\x14\x00\x1e\x01\x15\x00\x16\x00\x17\x00\x18\x00\x1f\x01\x28\x00\x22\x01\x54\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x11\x00\x12\x00\x13\x00\x14\x00\x27\x01\x15\x00\x16\x00\x17\x00\x18\x00\x28\x01\x2c\x01\x2d\x01\x55\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x11\x00\x12\x00\x13\x00\x14\x00\x2e\x01\x15\x00\x16\x00\x17\x00\x18\x00\x2f\x01\x28\x00\xa3\x00\x88\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x11\x00\x12\x00\x13\x00\x14\x00\xa5\x00\x15\x00\x16\x00\x17\x00\x18\x00\xa6\x00\x28\x00\x1f\x00\xac\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x11\x00\x12\x00\x13\x00\x14\x00\x28\x00\x15\x00\x16\x00\x17\x00\x18\x00\xae\x00\xaf\x00\x21\x00\x28\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x11\x00\x12\x00\x13\x00\x14\x00\xb2\x00\x15\x00\x16\x00\x17\x00\x18\x00\xb3\x00\xb4\x00\x23\x00\x28\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\xca\x00\xd1\x00\xe9\x00\xa3\xff\x8a\xff\xd2\x00\x28\x01\x28\x00\xf0\x00\x69\x00\x6a\x00\x25\x00\x6b\x00\x29\x01\x6c\x00\x6d\x00\x6e\x00\x6f\x00\xf1\x00\x92\x00\x28\x00\x49\x00\x70\x00\xb9\x00\xba\x00\x9d\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x57\x00\xfc\x00\x4a\x00\x4b\x00\x69\x00\x6a\x00\x4c\x00\x6b\x00\xfd\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x28\x00\x2c\x00\x28\x00\x34\x00\x70\x00\xb9\x00\xba\x00\x9d\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x57\x00\x9a\x00\xff\xff\x00\x00\x69\x00\x6a\x00\x00\x00\x6b\x00\x9b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x70\x00\xb9\x00\xba\x00\x9d\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x57\x00\x68\x00\x00\x00\x00\x00\x69\x00\x6a\x00\x00\x00\x6b\x00\x00\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x70\x00\x85\x01\xc8\x00\x9d\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x57\x00\x68\x00\x00\x00\x00\x00\x69\x00\x6a\x00\x00\x00\x6b\x00\x00\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x70\x00\x5b\x01\xc8\x00\x9d\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x57\x00\x68\x00\x00\x00\x00\x00\x69\x00\x6a\x00\x00\x00\x6b\x00\x00\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x70\x00\x36\x01\xc8\x00\x9d\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x57\x00\x68\x00\x00\x00\x00\x00\x69\x00\x6a\x00\x00\x00\x6b\x00\x00\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x70\x00\x45\x01\xc8\x00\x9d\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x57\x00\x68\x00\x00\x00\x00\x00\x69\x00\x6a\x00\x00\x00\x6b\x00\x00\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x70\x00\x47\x01\xc8\x00\x9d\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x57\x00\x68\x00\x00\x00\x00\x00\x69\x00\x6a\x00\x00\x00\x6b\x00\x00\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x70\x00\x4f\x01\xc8\x00\x9d\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x57\x00\x68\x00\x00\x00\x00\x00\x69\x00\x6a\x00\x00\x00\x6b\x00\x00\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x70\x00\xb9\x00\xc8\x00\x9d\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x57\x00\x28\x01\x00\x00\x00\x00\x69\x00\x6a\x00\x00\x00\x6b\x00\x29\x01\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x70\x00\x00\x00\x9c\x00\x9d\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x57\x00\x9a\x00\x00\x00\x00\x00\x69\x00\x6a\x00\x00\x00\x6b\x00\x9b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x70\x00\x00\x00\x9c\x00\x9d\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x57\x00\x68\x00\x00\x00\x00\x00\x69\x00\x6a\x00\x00\x00\x6b\x00\x00\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x70\x00\xc7\x00\xc8\x00\x9d\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x57\x00\x68\x00\x00\x00\x00\x00\x69\x00\x6a\x00\x00\x00\x6b\x00\x00\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x70\x00\xe4\x00\xc8\x00\x9d\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x57\x00\x68\x00\x00\x00\x00\x00\x69\x00\x6a\x00\x00\x00\x6b\x00\x00\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x70\x00\x00\x00\x34\x01\x9d\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x57\x00\x68\x00\x00\x00\x00\x00\x69\x00\x6a\x00\x48\x01\x6b\x00\x00\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x70\x00\x00\x00\x00\x00\xb8\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x57\x00\xbb\x00\x00\x00\x9f\x00\x69\x00\x6a\x00\x00\x00\x6b\x00\x00\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x70\x00\x00\x00\x00\x00\xfe\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x57\x00\x68\x00\x00\x00\x00\x00\x69\x00\x6a\x00\xb7\x00\x6b\x00\x00\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x70\x00\x00\x00\x00\x00\xb8\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x57\x00\xbb\x00\x00\x00\x9f\x00\x69\x00\x6a\x00\x00\x00\x6b\x00\x00\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x70\x00\x00\x00\x00\x00\xbc\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x57\x00\x68\x00\x00\x00\x00\x00\x69\x00\x6a\x00\x00\x00\x6b\x00\x00\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x70\x00\x00\x00\x00\x00\x8d\x01\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x57\x00\x68\x00\x00\x00\x00\x00\x69\x00\x6a\x00\x00\x00\x6b\x00\x00\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x70\x00\x00\x00\x00\x00\x8a\x01\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x57\x00\x68\x00\x00\x00\x00\x00\x69\x00\x6a\x00\x00\x00\x6b\x00\x00\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x70\x00\x00\x00\x00\x00\x7d\x01\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x57\x00\x68\x00\x00\x00\x00\x00\x69\x00\x6a\x00\x00\x00\x6b\x00\x00\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x70\x00\x00\x00\x00\x00\x32\x01\x72\x00\x73\x00\x74\x00\x75\x00\x5e\x01\x57\x00\x68\x00\x00\x00\x00\x00\x69\x00\x6a\x00\x00\x00\x6b\x00\x00\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x70\x00\x00\x00\x00\x00\x5f\x01\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x57\x00\x68\x00\x00\x00\x00\x00\x69\x00\x6a\x00\x00\x00\x6b\x00\x00\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x70\x00\x00\x00\x00\x00\x60\x01\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x57\x00\x68\x00\x00\x00\x00\x00\x69\x00\x6a\x00\x00\x00\x6b\x00\x00\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x70\x00\x00\x00\x00\x00\x61\x01\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x57\x00\x68\x00\x00\x00\x00\x00\x69\x00\x6a\x00\x00\x00\x6b\x00\x00\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x70\x00\x00\x00\x00\x00\x64\x01\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x57\x00\x68\x00\x00\x00\x00\x00\x69\x00\x6a\x00\x00\x00\x6b\x00\x00\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x70\x00\x00\x00\x00\x00\x6e\x01\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x57\x00\x68\x00\x00\x00\x00\x00\x69\x00\x6a\x00\x00\x00\x6b\x00\x00\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x70\x00\x00\x00\x00\x00\x71\x01\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x57\x00\x68\x00\x00\x00\x00\x00\x69\x00\x6a\x00\x00\x00\x6b\x00\x00\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x70\x00\x00\x00\x00\x00\x72\x01\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x57\x00\x68\x00\x00\x00\x00\x00\x69\x00\x6a\x00\x00\x00\x6b\x00\x00\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x70\x00\x00\x00\x00\x00\x73\x01\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x57\x00\x68\x00\x00\x00\x00\x00\x69\x00\x6a\x00\x00\x00\x6b\x00\x00\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x70\x00\x00\x00\x00\x00\x31\x01\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x57\x00\x68\x00\x00\x00\x00\x00\x69\x00\x6a\x00\x00\x00\x6b\x00\x00\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x70\x00\x00\x00\x00\x00\x32\x01\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x57\x00\x68\x00\x00\x00\x00\x00\x69\x00\x6a\x00\x00\x00\x6b\x00\x00\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x70\x00\x00\x00\x00\x00\x33\x01\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x57\x00\x68\x00\x00\x00\x00\x00\x69\x00\x6a\x00\x00\x00\x6b\x00\x00\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x70\x00\x00\x00\x00\x00\x35\x01\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x57\x00\x68\x00\x00\x00\x00\x00\x69\x00\x6a\x00\x00\x00\x6b\x00\x00\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x70\x00\x00\x00\x00\x00\x3a\x01\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x57\x00\x68\x00\x00\x00\x00\x00\x69\x00\x6a\x00\x00\x00\x6b\x00\x00\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x70\x00\x00\x00\x00\x00\x41\x01\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x57\x00\x68\x00\x00\x00\x00\x00\x69\x00\x6a\x00\x00\x00\x6b\x00\x00\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x70\x00\x00\x00\x00\x00\x49\x01\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x57\x00\x68\x00\x00\x00\x00\x00\x69\x00\x6a\x00\x00\x00\x6b\x00\x00\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x70\x00\x00\x00\x00\x00\x4a\x01\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x57\x00\x68\x00\x00\x00\x00\x00\x69\x00\x6a\x00\x00\x00\x6b\x00\x00\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x70\x00\x00\x00\x00\x00\x4b\x01\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x57\x00\x68\x00\x00\x00\x00\x00\x69\x00\x6a\x00\x00\x00\x6b\x00\x00\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x70\x00\x00\x00\x00\x00\x4c\x01\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x57\x00\x68\x00\x00\x00\x00\x00\x69\x00\x6a\x00\x00\x00\x6b\x00\x00\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x70\x00\x00\x00\x00\x00\x4d\x01\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x57\x00\x68\x00\x00\x00\x00\x00\x69\x00\x6a\x00\x00\x00\x6b\x00\x00\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x70\x00\x00\x00\x00\x00\x57\x01\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x57\x00\x68\x00\x00\x00\x00\x00\x69\x00\x6a\x00\x00\x00\x6b\x00\x00\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x70\x00\x00\x00\x00\x00\x03\x01\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x57\x00\x68\x00\x00\x00\x00\x00\x69\x00\x6a\x00\x00\x00\x6b\x00\x00\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x70\x00\x00\x00\x00\x00\x06\x01\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x57\x00\x68\x00\x00\x00\x00\x00\x69\x00\x6a\x00\x00\x00\x6b\x00\x00\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x70\x00\x00\x00\x00\x00\x07\x01\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x57\x00\x68\x00\x00\x00\x00\x00\x69\x00\x6a\x00\x00\x00\x6b\x00\x00\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x70\x00\x00\x00\x00\x00\x08\x01\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x57\x00\x68\x00\x00\x00\x00\x00\x69\x00\x6a\x00\x00\x00\x6b\x00\x00\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x70\x00\x00\x00\x00\x00\x20\x01\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x57\x00\x68\x00\x00\x00\x00\x00\x69\x00\x6a\x00\x00\x00\x6b\x00\x00\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x70\x00\x00\x00\x00\x00\x22\x01\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x57\x00\x68\x00\x00\x00\x00\x00\x69\x00\x6a\x00\x00\x00\x6b\x00\x00\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x70\x00\x00\x00\x00\x00\x2a\x01\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x57\x00\x68\x00\x00\x00\x00\x00\x69\x00\x6a\x00\x00\x00\x6b\x00\x00\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x70\x00\x00\x00\x00\x00\xa7\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x57\x00\x68\x00\x00\x00\x00\x00\x69\x00\x6a\x00\x00\x00\x6b\x00\x00\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x70\x00\x00\x00\x00\x00\xaf\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x57\x00\x68\x00\x00\x00\x00\x00\x69\x00\x6a\x00\x00\x00\x6b\x00\x00\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x70\x00\x00\x00\x00\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x57\x00\x68\x00\x00\x00\x00\x00\xd4\x00\xd5\x00\x00\x00\xd6\x00\x93\x00\x94\x00\xd7\x00\x6e\x00\x6f\x00\xa3\x00\x96\x00\x6e\x00\x6f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x01\x73\x00\x05\x01\x75\x00\x76\x00\x57\x00\x68\x00\x00\x00\x00\x00\xd4\x00\xd5\x00\x00\x00\xd6\x00\x93\x00\x94\x00\xd7\x00\x6e\x00\x6f\x00\xa0\x00\x96\x00\x6e\x00\x6f\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd8\x00\x73\x00\xd9\x00\x75\x00\x76\x00\x57\x00\xd3\x00\x00\x00\x7e\x00\x00\x00\x98\x00\x00\x00\x99\x00\x00\x00\x81\x00\x00\x00\x00\x00\x00\x00\x3a\x00\x9f\xff\xd4\x00\x00\x00\x3b\x00\x3c\x00\x3d\x00\x00\x00\x3e\x00\x3f\x00\x7e\x00\x00\x00\x98\x00\x00\x00\x99\x00\x00\x00\x81\x00\x00\x00\x00\x00\x00\x00\x3a\x00\xa0\xff\x00\x00\x00\x00\x3b\x00\x3c\x00\x3d\x00\x00\x00\x3e\x00\x3f\x00\x7e\x00\x00\x00\x98\x00\x00\x00\x99\x00\x00\x00\x81\x00\x00\x00\x00\x00\x43\x00\x3a\x00\x44\x00\x00\x00\x00\x00\x3b\x00\x3c\x00\x3d\x00\x3a\x00\x3e\x00\x3f\x00\x00\x00\x3b\x00\x3c\x00\x3d\x00\x00\x00\x3e\x00\x3f\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x00\x00\x00\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x00\x00\x0e\x00\x00\x00\x0f\x00\x1d\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x00\x00\x00\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x00\x00\x0e\x00\x00\x00\x0f\x00\x1f\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x00\x00\x00\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x00\x00\x0e\x00\x00\x00\x0f\x00\x21\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x00\x00\x00\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x00\x00\x0e\x00\x00\x00\x0f\x00\x23\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x00\x00\x00\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x00\x00\x0e\x00\x00\x00\x0f\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x00\x00\x00\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x00\x00\x0e\x00\x00\x00\x0f\x00\x93\x00\x94\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x96\x00\x6e\x00\x6f\x00\x93\x00\x94\x00\x00\x00\x00\x00\x00\x00\x95\x00\x96\x00\x6e\x00\x6f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\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 (1, 188) [+	(1 , happyReduce_1),+	(2 , happyReduce_2),+	(3 , happyReduce_3),+	(4 , happyReduce_4),+	(5 , happyReduce_5),+	(6 , happyReduce_6),+	(7 , happyReduce_7),+	(8 , happyReduce_8),+	(9 , happyReduce_9),+	(10 , happyReduce_10),+	(11 , happyReduce_11),+	(12 , happyReduce_12),+	(13 , happyReduce_13),+	(14 , happyReduce_14),+	(15 , happyReduce_15),+	(16 , happyReduce_16),+	(17 , happyReduce_17),+	(18 , happyReduce_18),+	(19 , happyReduce_19),+	(20 , happyReduce_20),+	(21 , happyReduce_21),+	(22 , happyReduce_22),+	(23 , happyReduce_23),+	(24 , happyReduce_24),+	(25 , happyReduce_25),+	(26 , happyReduce_26),+	(27 , happyReduce_27),+	(28 , happyReduce_28),+	(29 , happyReduce_29),+	(30 , happyReduce_30),+	(31 , happyReduce_31),+	(32 , happyReduce_32),+	(33 , happyReduce_33),+	(34 , happyReduce_34),+	(35 , happyReduce_35),+	(36 , happyReduce_36),+	(37 , happyReduce_37),+	(38 , happyReduce_38),+	(39 , happyReduce_39),+	(40 , happyReduce_40),+	(41 , happyReduce_41),+	(42 , happyReduce_42),+	(43 , happyReduce_43),+	(44 , happyReduce_44),+	(45 , happyReduce_45),+	(46 , happyReduce_46),+	(47 , happyReduce_47),+	(48 , happyReduce_48),+	(49 , happyReduce_49),+	(50 , happyReduce_50),+	(51 , happyReduce_51),+	(52 , happyReduce_52),+	(53 , happyReduce_53),+	(54 , happyReduce_54),+	(55 , happyReduce_55),+	(56 , happyReduce_56),+	(57 , happyReduce_57),+	(58 , happyReduce_58),+	(59 , happyReduce_59),+	(60 , happyReduce_60),+	(61 , happyReduce_61),+	(62 , happyReduce_62),+	(63 , happyReduce_63),+	(64 , happyReduce_64),+	(65 , happyReduce_65),+	(66 , happyReduce_66),+	(67 , happyReduce_67),+	(68 , happyReduce_68),+	(69 , happyReduce_69),+	(70 , happyReduce_70),+	(71 , happyReduce_71),+	(72 , happyReduce_72),+	(73 , happyReduce_73),+	(74 , happyReduce_74),+	(75 , happyReduce_75),+	(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)+	]++happy_n_terms = 57 :: Int+happy_n_nonterms = 63 :: Int++happyReduce_1 = happySpecReduce_1  0# happyReduction_1+happyReduction_1 happy_x_1+	 =  case happyOut5 happy_x_1 of { happy_var_1 -> +	happyIn4+		 (reverse happy_var_1+	)}++happyReduce_2 = happySpecReduce_0  1# happyReduction_2+happyReduction_2  =  happyIn5+		 ([]+	)++happyReduce_3 = happySpecReduce_2  1# happyReduction_3+happyReduction_3 happy_x_2+	happy_x_1+	 =  case happyOut5 happy_x_1 of { happy_var_1 -> +	case happyOut6 happy_x_2 of { happy_var_2 -> +	happyIn5+		 (happy_var_2 : happy_var_1+	)}}++happyReduce_4 = happySpecReduce_1  2# happyReduction_4+happyReduction_4 happy_x_1+	 =  case happyOut7 happy_x_1 of { happy_var_1 -> +	happyIn6+		 (happy_var_1+	)}++happyReduce_5 = happySpecReduce_1  2# happyReduction_5+happyReduction_5 happy_x_1+	 =  case happyOut9 happy_x_1 of { happy_var_1 -> +	happyIn6+		 (happy_var_1+	)}++happyReduce_6 = happySpecReduce_1  2# happyReduction_6+happyReduction_6 happy_x_1+	 =  case happyOut8 happy_x_1 of { happy_var_1 -> +	happyIn6+		 (happy_var_1+	)}++happyReduce_7 = happySpecReduce_1  2# happyReduction_7+happyReduction_7 happy_x_1+	 =  case happyOut10 happy_x_1 of { happy_var_1 -> +	happyIn6+		 (happy_var_1+	)}++happyReduce_8 = happySpecReduce_1  2# happyReduction_8+happyReduction_8 happy_x_1+	 =  case happyOut11 happy_x_1 of { happy_var_1 -> +	happyIn6+		 (happy_var_1+	)}++happyReduce_9 = happySpecReduce_1  2# happyReduction_9+happyReduction_9 happy_x_1+	 =  case happyOut14 happy_x_1 of { happy_var_1 -> +	happyIn6+		 (happy_var_1+	)}++happyReduce_10 = happySpecReduce_1  2# happyReduction_10+happyReduction_10 happy_x_1+	 =  case happyOut15 happy_x_1 of { happy_var_1 -> +	happyIn6+		 (happy_var_1+	)}++happyReduce_11 = happySpecReduce_1  2# happyReduction_11+happyReduction_11 happy_x_1+	 =  case happyOut16 happy_x_1 of { happy_var_1 -> +	happyIn6+		 (happy_var_1+	)}++happyReduce_12 = happySpecReduce_1  2# happyReduction_12+happyReduction_12 happy_x_1+	 =  case happyOut17 happy_x_1 of { happy_var_1 -> +	happyIn6+		 (happy_var_1+	)}++happyReduce_13 = happySpecReduce_1  2# happyReduction_13+happyReduction_13 happy_x_1+	 =  case happyOut21 happy_x_1 of { happy_var_1 -> +	happyIn6+		 (happy_var_1+	)}++happyReduce_14 = happySpecReduce_2  2# happyReduction_14+happyReduction_14 happy_x_2+	happy_x_1+	 =  case happyOut6 happy_x_2 of { happy_var_2 -> +	happyIn6+		 (C.OverrideDecl Impredicative [happy_var_2]+	)}++happyReduce_15 = happyReduce 4# 2# happyReduction_15+happyReduction_15 (happy_x_4 `HappyStk`+	happy_x_3 `HappyStk`+	happy_x_2 `HappyStk`+	happy_x_1 `HappyStk`+	happyRest)+	 = case happyOut5 happy_x_3 of { happy_var_3 -> +	happyIn6+		 (C.OverrideDecl Impredicative happy_var_3+	) `HappyStk` happyRest}++happyReduce_16 = happySpecReduce_2  2# happyReduction_16+happyReduction_16 happy_x_2+	happy_x_1+	 =  case happyOut6 happy_x_2 of { happy_var_2 -> +	happyIn6+		 (C.OverrideDecl Fail [happy_var_2]+	)}++happyReduce_17 = happyReduce 4# 2# happyReduction_17+happyReduction_17 (happy_x_4 `HappyStk`+	happy_x_3 `HappyStk`+	happy_x_2 `HappyStk`+	happy_x_1 `HappyStk`+	happyRest)+	 = case happyOut5 happy_x_3 of { happy_var_3 -> +	happyIn6+		 (C.OverrideDecl Fail happy_var_3+	) `HappyStk` happyRest}++happyReduce_18 = happySpecReduce_2  2# happyReduction_18+happyReduction_18 happy_x_2+	happy_x_1+	 =  case happyOut6 happy_x_2 of { happy_var_2 -> +	happyIn6+		 (C.OverrideDecl Check [happy_var_2]+	)}++happyReduce_19 = happyReduce 4# 2# happyReduction_19+happyReduction_19 (happy_x_4 `HappyStk`+	happy_x_3 `HappyStk`+	happy_x_2 `HappyStk`+	happy_x_1 `HappyStk`+	happyRest)+	 = case happyOut5 happy_x_3 of { happy_var_3 -> +	happyIn6+		 (C.OverrideDecl Check happy_var_3+	) `HappyStk` happyRest}++happyReduce_20 = happySpecReduce_2  2# happyReduction_20+happyReduction_20 happy_x_2+	happy_x_1+	 =  case happyOut6 happy_x_2 of { happy_var_2 -> +	happyIn6+		 (C.OverrideDecl TrustMe [happy_var_2]+	)}++happyReduce_21 = happyReduce 4# 2# happyReduction_21+happyReduction_21 (happy_x_4 `HappyStk`+	happy_x_3 `HappyStk`+	happy_x_2 `HappyStk`+	happy_x_1 `HappyStk`+	happyRest)+	 = case happyOut5 happy_x_3 of { happy_var_3 -> +	happyIn6+		 (C.OverrideDecl TrustMe happy_var_3+	) `HappyStk` happyRest}++happyReduce_22 = happySpecReduce_2  3# happyReduction_22+happyReduction_22 happy_x_2+	happy_x_1+	 =  case happyOut12 happy_x_2 of { happy_var_2 -> +	happyIn7+		 (let (n,tel,t,cs,fs) = happy_var_2 in C.DataDecl n A.NotSized A.Ind tel t cs fs+	)}++happyReduce_23 = happySpecReduce_3  4# happyReduction_23+happyReduction_23 happy_x_3+	happy_x_2+	happy_x_1+	 =  case happyOut12 happy_x_3 of { happy_var_3 -> +	happyIn8+		 (let (n,tel,t,cs,fs) = happy_var_3 in C.DataDecl n A.Sized A.Ind tel t cs fs+	)}++happyReduce_24 = happySpecReduce_2  5# happyReduction_24+happyReduction_24 happy_x_2+	happy_x_1+	 =  case happyOut12 happy_x_2 of { happy_var_2 -> +	happyIn9+		 (let (n,tel,t,cs,fs) = happy_var_2 in C.DataDecl n A.NotSized A.CoInd tel t cs fs+	)}++happyReduce_25 = happySpecReduce_3  6# happyReduction_25+happyReduction_25 happy_x_3+	happy_x_2+	happy_x_1+	 =  case happyOut12 happy_x_3 of { happy_var_3 -> +	happyIn10+		 (let (n,tel,t,cs,fs) = happy_var_3 in C.DataDecl n A.Sized A.CoInd tel t cs fs+	)}++happyReduce_26 = happySpecReduce_2  7# happyReduction_26+happyReduction_26 happy_x_2+	happy_x_1+	 =  case happyOut13 happy_x_2 of { happy_var_2 -> +	happyIn11+		 (let (n,tel,t,c,fs) = happy_var_2 in C.RecordDecl n tel t c fs+	)}++happyReduce_27 = happyReduce 8# 8# happyReduction_27+happyReduction_27 (happy_x_8 `HappyStk`+	happy_x_7 `HappyStk`+	happy_x_6 `HappyStk`+	happy_x_5 `HappyStk`+	happy_x_4 `HappyStk`+	happy_x_3 `HappyStk`+	happy_x_2 `HappyStk`+	happy_x_1 `HappyStk`+	happyRest)+	 = case happyOut23 happy_x_1 of { happy_var_1 -> +	case happyOut66 happy_x_2 of { happy_var_2 -> +	case happyOut42 happy_x_4 of { happy_var_4 -> +	case happyOut53 happy_x_6 of { happy_var_6 -> +	case happyOut22 happy_x_8 of { happy_var_8 -> +	happyIn12+		 ((happy_var_1, happy_var_2, happy_var_4, reverse happy_var_6, happy_var_8)+	) `HappyStk` happyRest}}}}}++happyReduce_28 = happyReduce 6# 8# happyReduction_28+happyReduction_28 (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 happyOut23 happy_x_1 of { happy_var_1 -> +	case happyOut66 happy_x_2 of { happy_var_2 -> +	case happyOut53 happy_x_4 of { happy_var_4 -> +	case happyOut22 happy_x_6 of { happy_var_6 -> +	happyIn12+		 ((happy_var_1, happy_var_2, C.set0, reverse happy_var_4, happy_var_6)+	) `HappyStk` happyRest}}}}++happyReduce_29 = happyReduce 8# 9# happyReduction_29+happyReduction_29 (happy_x_8 `HappyStk`+	happy_x_7 `HappyStk`+	happy_x_6 `HappyStk`+	happy_x_5 `HappyStk`+	happy_x_4 `HappyStk`+	happy_x_3 `HappyStk`+	happy_x_2 `HappyStk`+	happy_x_1 `HappyStk`+	happyRest)+	 = case happyOut23 happy_x_1 of { happy_var_1 -> +	case happyOut66 happy_x_2 of { happy_var_2 -> +	case happyOut42 happy_x_4 of { happy_var_4 -> +	case happyOut52 happy_x_6 of { happy_var_6 -> +	case happyOut22 happy_x_8 of { happy_var_8 -> +	happyIn13+		 ((happy_var_1, happy_var_2, happy_var_4, happy_var_6, happy_var_8)+	) `HappyStk` happyRest}}}}}++happyReduce_30 = happyReduce 6# 9# happyReduction_30+happyReduction_30 (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 happyOut23 happy_x_1 of { happy_var_1 -> +	case happyOut66 happy_x_2 of { happy_var_2 -> +	case happyOut52 happy_x_4 of { happy_var_4 -> +	case happyOut22 happy_x_6 of { happy_var_6 -> +	happyIn13+		 ((happy_var_1, happy_var_2, C.set0, happy_var_4, happy_var_6)+	) `HappyStk` happyRest}}}}++happyReduce_31 = happyReduce 5# 10# happyReduction_31+happyReduction_31 (happy_x_5 `HappyStk`+	happy_x_4 `HappyStk`+	happy_x_3 `HappyStk`+	happy_x_2 `HappyStk`+	happy_x_1 `HappyStk`+	happyRest)+	 = case happyOut51 happy_x_2 of { happy_var_2 -> +	case happyOut63 happy_x_4 of { happy_var_4 -> +	happyIn14+		 (C.FunDecl A.Ind happy_var_2 happy_var_4+	) `HappyStk` happyRest}}++happyReduce_32 = happyReduce 5# 11# happyReduction_32+happyReduction_32 (happy_x_5 `HappyStk`+	happy_x_4 `HappyStk`+	happy_x_3 `HappyStk`+	happy_x_2 `HappyStk`+	happy_x_1 `HappyStk`+	happyRest)+	 = case happyOut51 happy_x_2 of { happy_var_2 -> +	case happyOut63 happy_x_4 of { happy_var_4 -> +	happyIn15+		 (C.FunDecl A.CoInd happy_var_2 happy_var_4+	) `HappyStk` happyRest}}++happyReduce_33 = happyReduce 4# 12# happyReduction_33+happyReduction_33 (happy_x_4 `HappyStk`+	happy_x_3 `HappyStk`+	happy_x_2 `HappyStk`+	happy_x_1 `HappyStk`+	happyRest)+	 = case happyOut5 happy_x_3 of { happy_var_3 -> +	happyIn16+		 (C.MutualDecl (reverse happy_var_3)+	) `HappyStk` happyRest}++happyReduce_34 = happySpecReduce_3  13# happyReduction_34+happyReduction_34 happy_x_3+	happy_x_2+	happy_x_1+	 =  case happyOut19 happy_x_1 of { happy_var_1 -> +	case happyOut18 happy_x_3 of { happy_var_3 -> +	happyIn17+		 (C.LetDecl happy_var_1 happy_var_3+	)}}++happyReduce_35 = happyReduce 5# 14# happyReduction_35+happyReduction_35 (happy_x_5 `HappyStk`+	happy_x_4 `HappyStk`+	happy_x_3 `HappyStk`+	happy_x_2 `HappyStk`+	happy_x_1 `HappyStk`+	happyRest)+	 = case happyOut36 happy_x_1 of { happy_var_1 -> +	case happyOut31 happy_x_2 of { happy_var_2 -> +	case happyOut20 happy_x_3 of { happy_var_3 -> +	case happyOut40 happy_x_5 of { happy_var_5 -> +	happyIn18+		 (let (dec,n) = happy_var_1 in C.LetDef dec n happy_var_2 happy_var_3 happy_var_5+	) `HappyStk` happyRest}}}}++happyReduce_36 = happySpecReduce_0  15# happyReduction_36+happyReduction_36  =  happyIn19+		 (False+	)++happyReduce_37 = happySpecReduce_1  15# happyReduction_37+happyReduction_37 happy_x_1+	 =  happyIn19+		 (True+	)++happyReduce_38 = happySpecReduce_0  16# happyReduction_38+happyReduction_38  =  happyIn20+		 (Nothing+	)++happyReduce_39 = happySpecReduce_2  16# happyReduction_39+happyReduction_39 happy_x_2+	happy_x_1+	 =  case happyOut42 happy_x_2 of { happy_var_2 -> +	happyIn20+		 (Just happy_var_2+	)}++happyReduce_40 = happyReduce 4# 17# happyReduction_40+happyReduction_40 (happy_x_4 `HappyStk`+	happy_x_3 `HappyStk`+	happy_x_2 `HappyStk`+	happy_x_1 `HappyStk`+	happyRest)+	 = case happyOut24 happy_x_2 of { happy_var_2 -> +	case happyOut59 happy_x_4 of { happy_var_4 -> +	happyIn21+		 (C.PatternDecl (head happy_var_2) (tail happy_var_2) happy_var_4+	) `HappyStk` happyRest}}++happyReduce_41 = happySpecReduce_0  18# happyReduction_41+happyReduction_41  =  happyIn22+		 ([]+	)++happyReduce_42 = happySpecReduce_2  18# happyReduction_42+happyReduction_42 happy_x_2+	happy_x_1+	 =  case happyOut25 happy_x_2 of { happy_var_2 -> +	happyIn22+		 (happy_var_2+	)}++happyReduce_43 = happySpecReduce_1  19# happyReduction_43+happyReduction_43 happy_x_1+	 =  case happyOutTok happy_x_1 of { (T.Id happy_var_1 _) -> +	happyIn23+		 (C.Name happy_var_1+	)}++happyReduce_44 = happySpecReduce_1  20# happyReduction_44+happyReduction_44 happy_x_1+	 =  case happyOut23 happy_x_1 of { happy_var_1 -> +	happyIn24+		 ([happy_var_1]+	)}++happyReduce_45 = happySpecReduce_2  20# happyReduction_45+happyReduction_45 happy_x_2+	happy_x_1+	 =  case happyOut23 happy_x_1 of { happy_var_1 -> +	case happyOut24 happy_x_2 of { happy_var_2 -> +	happyIn24+		 (happy_var_1 : happy_var_2+	)}}++happyReduce_46 = happySpecReduce_1  21# happyReduction_46+happyReduction_46 happy_x_1+	 =  case happyOut23 happy_x_1 of { happy_var_1 -> +	happyIn25+		 ([happy_var_1]+	)}++happyReduce_47 = happySpecReduce_3  21# happyReduction_47+happyReduction_47 happy_x_3+	happy_x_2+	happy_x_1+	 =  case happyOut23 happy_x_1 of { happy_var_1 -> +	case happyOut25 happy_x_3 of { happy_var_3 -> +	happyIn25+		 (happy_var_1 : happy_var_3+	)}}++happyReduce_48 = happySpecReduce_1  22# happyReduction_48+happyReduction_48 happy_x_1+	 =  happyIn26+		 (SPos+	)++happyReduce_49 = happySpecReduce_1  22# happyReduction_49+happyReduction_49 happy_x_1+	 =  happyIn26+		 (Pos+	)++happyReduce_50 = happySpecReduce_1  22# happyReduction_50+happyReduction_50 happy_x_1+	 =  happyIn26+		 (Neg+	)++happyReduce_51 = happySpecReduce_1  22# happyReduction_51+happyReduction_51 happy_x_1+	 =  happyIn26+		 (Const+	)++happyReduce_52 = happySpecReduce_1  22# happyReduction_52+happyReduction_52 happy_x_1+	 =  happyIn26+		 (Param+	)++happyReduce_53 = happySpecReduce_1  22# happyReduction_53+happyReduction_53 happy_x_1+	 =  happyIn26+		 (Rec+	)++happyReduce_54 = happySpecReduce_2  23# happyReduction_54+happyReduction_54 happy_x_2+	happy_x_1+	 =  case happyOut28 happy_x_2 of { happy_var_2 -> +	happyIn27+		 (A.Measure happy_var_2+	)}++happyReduce_55 = happySpecReduce_2  24# happyReduction_55+happyReduction_55 happy_x_2+	happy_x_1+	 =  case happyOut42 happy_x_1 of { happy_var_1 -> +	happyIn28+		 ([happy_var_1]+	)}++happyReduce_56 = happySpecReduce_3  24# happyReduction_56+happyReduction_56 happy_x_3+	happy_x_2+	happy_x_1+	 =  case happyOut42 happy_x_1 of { happy_var_1 -> +	case happyOut28 happy_x_3 of { happy_var_3 -> +	happyIn28+		 (happy_var_1 : happy_var_3+	)}}++happyReduce_57 = happySpecReduce_3  25# happyReduction_57+happyReduction_57 happy_x_3+	happy_x_2+	happy_x_1+	 =  case happyOut27 happy_x_1 of { happy_var_1 -> +	case happyOut27 happy_x_3 of { happy_var_3 -> +	happyIn29+		 (A.Bound A.Lt happy_var_1 happy_var_3+	)}}++happyReduce_58 = happySpecReduce_3  25# happyReduction_58+happyReduction_58 happy_x_3+	happy_x_2+	happy_x_1+	 =  case happyOut27 happy_x_1 of { happy_var_1 -> +	case happyOut27 happy_x_3 of { happy_var_3 -> +	happyIn29+		 (A.Bound A.Le happy_var_1 happy_var_3+	)}}++happyReduce_59 = happySpecReduce_1  26# happyReduction_59+happyReduction_59 happy_x_1+	 =  case happyOut41 happy_x_1 of { happy_var_1 -> +	happyIn30+		 (let { f (C.Ident (C.QName x)) = x+                            ; f e = error ("not an identifier: " ++ C.prettyExpr e)+                            } in map f happy_var_1+	)}++happyReduce_60 = happySpecReduce_0  27# happyReduction_60+happyReduction_60  =  happyIn31+		 ([]+	)++happyReduce_61 = happySpecReduce_2  27# happyReduction_61+happyReduction_61 happy_x_2+	happy_x_1+	 =  case happyOut32 happy_x_1 of { happy_var_1 -> +	case happyOut31 happy_x_2 of { happy_var_2 -> +	happyIn31+		 (happy_var_1 : happy_var_2+	)}}++happyReduce_62 = happySpecReduce_2  27# happyReduction_62+happyReduction_62 happy_x_2+	happy_x_1+	 =  case happyOut27 happy_x_1 of { happy_var_1 -> +	case happyOut31 happy_x_2 of { happy_var_2 -> +	happyIn31+		 (C.TMeasure happy_var_1 : happy_var_2+	)}}++happyReduce_63 = happyReduce 5# 28# happyReduction_63+happyReduction_63 (happy_x_5 `HappyStk`+	happy_x_4 `HappyStk`+	happy_x_3 `HappyStk`+	happy_x_2 `HappyStk`+	happy_x_1 `HappyStk`+	happyRest)+	 = case happyOut30 happy_x_2 of { happy_var_2 -> +	case happyOut42 happy_x_4 of { happy_var_4 -> +	happyIn32+		 (C.TBind   (Dec Default) happy_var_2      happy_var_4+	) `HappyStk` happyRest}}++happyReduce_64 = happyReduce 5# 28# happyReduction_64+happyReduction_64 (happy_x_5 `HappyStk`+	happy_x_4 `HappyStk`+	happy_x_3 `HappyStk`+	happy_x_2 `HappyStk`+	happy_x_1 `HappyStk`+	happyRest)+	 = case happyOut23 happy_x_2 of { happy_var_2 -> +	case happyOut42 happy_x_4 of { happy_var_4 -> +	happyIn32+		 (C.TBounded A.defaultDec happy_var_2 A.Lt happy_var_4+	) `HappyStk` happyRest}}++happyReduce_65 = happyReduce 5# 28# happyReduction_65+happyReduction_65 (happy_x_5 `HappyStk`+	happy_x_4 `HappyStk`+	happy_x_3 `HappyStk`+	happy_x_2 `HappyStk`+	happy_x_1 `HappyStk`+	happyRest)+	 = case happyOut23 happy_x_2 of { happy_var_2 -> +	case happyOut42 happy_x_4 of { happy_var_4 -> +	happyIn32+		 (C.TBounded A.defaultDec happy_var_2 A.Le happy_var_4+	) `HappyStk` happyRest}}++happyReduce_66 = happyReduce 6# 28# happyReduction_66+happyReduction_66 (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 happyOut26 happy_x_1 of { happy_var_1 -> +	case happyOut30 happy_x_3 of { happy_var_3 -> +	case happyOut42 happy_x_5 of { happy_var_5 -> +	happyIn32+		 (C.TBind    (Dec happy_var_1)     happy_var_3      happy_var_5+	) `HappyStk` happyRest}}}++happyReduce_67 = happyReduce 6# 28# happyReduction_67+happyReduction_67 (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 happyOut26 happy_x_1 of { happy_var_1 -> +	case happyOut23 happy_x_3 of { happy_var_3 -> +	case happyOut42 happy_x_5 of { happy_var_5 -> +	happyIn32+		 (C.TBounded (Dec happy_var_1)     happy_var_3 A.Lt happy_var_5+	) `HappyStk` happyRest}}}++happyReduce_68 = happyReduce 6# 28# happyReduction_68+happyReduction_68 (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 happyOut26 happy_x_1 of { happy_var_1 -> +	case happyOut23 happy_x_3 of { happy_var_3 -> +	case happyOut42 happy_x_5 of { happy_var_5 -> +	happyIn32+		 (C.TBounded (Dec happy_var_1)     happy_var_3 A.Le happy_var_5+	) `HappyStk` happyRest}}}++happyReduce_69 = happySpecReduce_1  28# happyReduction_69+happyReduction_69 happy_x_1+	 =  case happyOut33 happy_x_1 of { happy_var_1 -> +	happyIn32+		 (happy_var_1+	)}++happyReduce_70 = happySpecReduce_1  28# happyReduction_70+happyReduction_70 happy_x_1+	 =  case happyOut34 happy_x_1 of { happy_var_1 -> +	happyIn32+		 (happy_var_1+	)}++happyReduce_71 = happyReduce 5# 29# happyReduction_71+happyReduction_71 (happy_x_5 `HappyStk`+	happy_x_4 `HappyStk`+	happy_x_3 `HappyStk`+	happy_x_2 `HappyStk`+	happy_x_1 `HappyStk`+	happyRest)+	 = case happyOut25 happy_x_2 of { happy_var_2 -> +	case happyOut42 happy_x_4 of { happy_var_4 -> +	happyIn33+		 (C.TBind    A.irrelevantDec happy_var_2      happy_var_4+	) `HappyStk` happyRest}}++happyReduce_72 = happyReduce 5# 29# happyReduction_72+happyReduction_72 (happy_x_5 `HappyStk`+	happy_x_4 `HappyStk`+	happy_x_3 `HappyStk`+	happy_x_2 `HappyStk`+	happy_x_1 `HappyStk`+	happyRest)+	 = case happyOut23 happy_x_2 of { happy_var_2 -> +	case happyOut42 happy_x_4 of { happy_var_4 -> +	happyIn33+		 (C.TBounded A.irrelevantDec happy_var_2 A.Lt happy_var_4+	) `HappyStk` happyRest}}++happyReduce_73 = happyReduce 5# 29# happyReduction_73+happyReduction_73 (happy_x_5 `HappyStk`+	happy_x_4 `HappyStk`+	happy_x_3 `HappyStk`+	happy_x_2 `HappyStk`+	happy_x_1 `HappyStk`+	happyRest)+	 = case happyOut23 happy_x_2 of { happy_var_2 -> +	case happyOut42 happy_x_4 of { happy_var_4 -> +	happyIn33+		 (C.TBounded A.irrelevantDec happy_var_2 A.Le happy_var_4+	) `HappyStk` happyRest}}++happyReduce_74 = happyReduce 5# 30# 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 happyOut25 happy_x_2 of { happy_var_2 -> +	case happyOut42 happy_x_4 of { happy_var_4 -> +	happyIn34+		 (C.TBind    A.Hidden happy_var_2      happy_var_4+	) `HappyStk` happyRest}}++happyReduce_75 = happyReduce 5# 30# happyReduction_75+happyReduction_75 (happy_x_5 `HappyStk`+	happy_x_4 `HappyStk`+	happy_x_3 `HappyStk`+	happy_x_2 `HappyStk`+	happy_x_1 `HappyStk`+	happyRest)+	 = case happyOut23 happy_x_2 of { happy_var_2 -> +	case happyOut42 happy_x_4 of { happy_var_4 -> +	happyIn34+		 (C.TBounded A.Hidden happy_var_2 A.Lt happy_var_4+	) `HappyStk` happyRest}}++happyReduce_76 = happyReduce 5# 30# 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 happyOut23 happy_x_2 of { happy_var_2 -> +	case happyOut42 happy_x_4 of { happy_var_4 -> +	happyIn34+		 (C.TBounded A.Hidden happy_var_2 A.Le happy_var_4+	) `HappyStk` happyRest}}++happyReduce_77 = happySpecReduce_1  31# happyReduction_77+happyReduction_77 happy_x_1+	 =  case happyOut23 happy_x_1 of { happy_var_1 -> +	happyIn35+		 (C.TBind A.defaultDec [happy_var_1] Nothing+	)}++happyReduce_78 = happySpecReduce_3  31# happyReduction_78+happyReduction_78 happy_x_3+	happy_x_2+	happy_x_1+	 =  case happyOut23 happy_x_2 of { happy_var_2 -> +	happyIn35+		 (C.TBind A.irrelevantDec [happy_var_2] Nothing+	)}++happyReduce_79 = happySpecReduce_2  31# happyReduction_79+happyReduction_79 happy_x_2+	happy_x_1+	 =  case happyOut26 happy_x_1 of { happy_var_1 -> +	case happyOut23 happy_x_2 of { happy_var_2 -> +	happyIn35+		 (C.TBind (Dec happy_var_1) [happy_var_2] Nothing+	)}}++happyReduce_80 = happyReduce 4# 31# happyReduction_80+happyReduction_80 (happy_x_4 `HappyStk`+	happy_x_3 `HappyStk`+	happy_x_2 `HappyStk`+	happy_x_1 `HappyStk`+	happyRest)+	 = case happyOut26 happy_x_1 of { happy_var_1 -> +	case happyOut23 happy_x_3 of { happy_var_3 -> +	happyIn35+		 (C.TBind (Dec happy_var_1) [happy_var_3] Nothing+	) `HappyStk` happyRest}}++happyReduce_81 = happySpecReduce_1  32# happyReduction_81+happyReduction_81 happy_x_1+	 =  case happyOut23 happy_x_1 of { happy_var_1 -> +	happyIn36+		 ((A.defaultDec   , happy_var_1)+	)}++happyReduce_82 = happySpecReduce_3  32# happyReduction_82+happyReduction_82 happy_x_3+	happy_x_2+	happy_x_1+	 =  case happyOut23 happy_x_2 of { happy_var_2 -> +	happyIn36+		 ((A.irrelevantDec, happy_var_2)+	)}++happyReduce_83 = happySpecReduce_2  32# happyReduction_83+happyReduction_83 happy_x_2+	happy_x_1+	 =  case happyOut26 happy_x_1 of { happy_var_1 -> +	case happyOut23 happy_x_2 of { happy_var_2 -> +	happyIn36+		 ((Dec happy_var_1         , happy_var_2)+	)}}++happyReduce_84 = happySpecReduce_1  33# happyReduction_84+happyReduction_84 happy_x_1+	 =  case happyOut18 happy_x_1 of { happy_var_1 -> +	happyIn37+		 (happy_var_1+	)}++happyReduce_85 = happyReduce 7# 33# happyReduction_85+happyReduction_85 (happy_x_7 `HappyStk`+	happy_x_6 `HappyStk`+	happy_x_5 `HappyStk`+	happy_x_4 `HappyStk`+	happy_x_3 `HappyStk`+	happy_x_2 `HappyStk`+	happy_x_1 `HappyStk`+	happyRest)+	 = case happyOut23 happy_x_2 of { happy_var_2 -> +	case happyOut42 happy_x_4 of { happy_var_4 -> +	case happyOut42 happy_x_7 of { happy_var_7 -> +	happyIn37+		 (C.LetDef A.irrelevantDec happy_var_2 [] (Just happy_var_4) happy_var_7+	) `HappyStk` happyRest}}}++happyReduce_86 = happyReduce 8# 33# happyReduction_86+happyReduction_86 (happy_x_8 `HappyStk`+	happy_x_7 `HappyStk`+	happy_x_6 `HappyStk`+	happy_x_5 `HappyStk`+	happy_x_4 `HappyStk`+	happy_x_3 `HappyStk`+	happy_x_2 `HappyStk`+	happy_x_1 `HappyStk`+	happyRest)+	 = case happyOut26 happy_x_1 of { happy_var_1 -> +	case happyOut23 happy_x_3 of { happy_var_3 -> +	case happyOut42 happy_x_5 of { happy_var_5 -> +	case happyOut42 happy_x_8 of { happy_var_8 -> +	happyIn37+		 (C.LetDef (Dec happy_var_1) happy_var_3 [] (Just happy_var_5) happy_var_8+	) `HappyStk` happyRest}}}}++happyReduce_87 = happySpecReduce_1  34# happyReduction_87+happyReduction_87 happy_x_1+	 =  case happyOut35 happy_x_1 of { happy_var_1 -> +	happyIn38+		 (happy_var_1+	)}++happyReduce_88 = happySpecReduce_3  34# happyReduction_88+happyReduction_88 happy_x_3+	happy_x_2+	happy_x_1+	 =  case happyOut23 happy_x_1 of { happy_var_1 -> +	case happyOut42 happy_x_3 of { happy_var_3 -> +	happyIn38+		 (C.TBind A.defaultDec [happy_var_1] (Just happy_var_3)+	)}}++happyReduce_89 = happyReduce 5# 34# happyReduction_89+happyReduction_89 (happy_x_5 `HappyStk`+	happy_x_4 `HappyStk`+	happy_x_3 `HappyStk`+	happy_x_2 `HappyStk`+	happy_x_1 `HappyStk`+	happyRest)+	 = case happyOut23 happy_x_2 of { happy_var_2 -> +	case happyOut42 happy_x_4 of { happy_var_4 -> +	happyIn38+		 (C.TBind A.defaultDec [happy_var_2] (Just happy_var_4)+	) `HappyStk` happyRest}}++happyReduce_90 = happyReduce 5# 34# happyReduction_90+happyReduction_90 (happy_x_5 `HappyStk`+	happy_x_4 `HappyStk`+	happy_x_3 `HappyStk`+	happy_x_2 `HappyStk`+	happy_x_1 `HappyStk`+	happyRest)+	 = case happyOut23 happy_x_2 of { happy_var_2 -> +	case happyOut42 happy_x_4 of { happy_var_4 -> +	happyIn38+		 (C.TBind A.irrelevantDec [happy_var_2] (Just happy_var_4)+	) `HappyStk` happyRest}}++happyReduce_91 = happyReduce 6# 34# happyReduction_91+happyReduction_91 (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 happyOut26 happy_x_1 of { happy_var_1 -> +	case happyOut23 happy_x_3 of { happy_var_3 -> +	case happyOut42 happy_x_5 of { happy_var_5 -> +	happyIn38+		 (C.TBind (Dec happy_var_1) [happy_var_3] (Just happy_var_5)+	) `HappyStk` happyRest}}}++happyReduce_92 = happySpecReduce_1  35# happyReduction_92+happyReduction_92 happy_x_1+	 =  case happyOut43 happy_x_1 of { happy_var_1 -> +	happyIn39+		 ([C.TBind (Dec Default) {- A.defaultDec -} [] happy_var_1]+	)}++happyReduce_93 = happySpecReduce_3  35# happyReduction_93+happyReduction_93 happy_x_3+	happy_x_2+	happy_x_1+	 =  case happyOut42 happy_x_2 of { happy_var_2 -> +	happyIn39+		 ([C.TBind A.irrelevantDec [] happy_var_2]+	)}++happyReduce_94 = happySpecReduce_2  35# happyReduction_94+happyReduction_94 happy_x_2+	happy_x_1+	 =  case happyOut26 happy_x_1 of { happy_var_1 -> +	case happyOut43 happy_x_2 of { happy_var_2 -> +	happyIn39+		 ([C.TBind (Dec happy_var_1) [] happy_var_2]+	)}}++happyReduce_95 = happySpecReduce_1  35# happyReduction_95+happyReduction_95 happy_x_1+	 =  case happyOut32 happy_x_1 of { happy_var_1 -> +	happyIn39+		 ([happy_var_1]+	)}++happyReduce_96 = happySpecReduce_1  35# happyReduction_96+happyReduction_96 happy_x_1+	 =  case happyOut27 happy_x_1 of { happy_var_1 -> +	happyIn39+		 ([C.TMeasure happy_var_1]+	)}++happyReduce_97 = happySpecReduce_1  35# happyReduction_97+happyReduction_97 happy_x_1+	 =  case happyOut29 happy_x_1 of { happy_var_1 -> +	happyIn39+		 ([C.TBound happy_var_1]+	)}++happyReduce_98 = happySpecReduce_1  35# happyReduction_98+happyReduction_98 happy_x_1+	 =  case happyOut31 happy_x_1 of { happy_var_1 -> +	happyIn39+		 (happy_var_1+	)}++happyReduce_99 = happySpecReduce_1  36# happyReduction_99+happyReduction_99 happy_x_1+	 =  case happyOut41 happy_x_1 of { happy_var_1 -> +	happyIn40+		 (foldr1 C.Pair happy_var_1+	)}++happyReduce_100 = happySpecReduce_1  37# happyReduction_100+happyReduction_100 happy_x_1+	 =  case happyOut42 happy_x_1 of { happy_var_1 -> +	happyIn41+		 ([happy_var_1]+	)}++happyReduce_101 = happySpecReduce_3  37# happyReduction_101+happyReduction_101 happy_x_3+	happy_x_2+	happy_x_1+	 =  case happyOut42 happy_x_1 of { happy_var_1 -> +	case happyOut41 happy_x_3 of { happy_var_3 -> +	happyIn41+		 (happy_var_1 : happy_var_3+	)}}++happyReduce_102 = happySpecReduce_3  38# happyReduction_102+happyReduction_102 happy_x_3+	happy_x_2+	happy_x_1+	 =  case happyOut39 happy_x_1 of { happy_var_1 -> +	case happyOut42 happy_x_3 of { happy_var_3 -> +	happyIn42+		 (C.Quant A.Pi happy_var_1 happy_var_3+	)}}++happyReduce_103 = happyReduce 4# 38# happyReduction_103+happyReduction_103 (happy_x_4 `HappyStk`+	happy_x_3 `HappyStk`+	happy_x_2 `HappyStk`+	happy_x_1 `HappyStk`+	happyRest)+	 = case happyOut24 happy_x_2 of { happy_var_2 -> +	case happyOut40 happy_x_4 of { happy_var_4 -> +	happyIn42+		 (foldr C.Lam happy_var_4 happy_var_2+	) `HappyStk` happyRest}}++happyReduce_104 = happyReduce 4# 38# happyReduction_104+happyReduction_104 (happy_x_4 `HappyStk`+	happy_x_3 `HappyStk`+	happy_x_2 `HappyStk`+	happy_x_1 `HappyStk`+	happyRest)+	 = case happyOut37 happy_x_2 of { happy_var_2 -> +	case happyOut40 happy_x_4 of { happy_var_4 -> +	happyIn42+		 (C.LLet happy_var_2 happy_var_4+	) `HappyStk` happyRest}}++happyReduce_105 = happyReduce 6# 38# happyReduction_105+happyReduction_105 (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 happyOut40 happy_x_2 of { happy_var_2 -> +	case happyOut20 happy_x_3 of { happy_var_3 -> +	case happyOut54 happy_x_5 of { happy_var_5 -> +	happyIn42+		 (C.Case happy_var_2 happy_var_3 happy_var_5+	) `HappyStk` happyRest}}}++happyReduce_106 = happySpecReduce_1  38# happyReduction_106+happyReduction_106 happy_x_1+	 =  case happyOut43 happy_x_1 of { happy_var_1 -> +	happyIn42+		 (happy_var_1+	)}++happyReduce_107 = happySpecReduce_3  38# happyReduction_107+happyReduction_107 happy_x_3+	happy_x_2+	happy_x_1+	 =  case happyOut45 happy_x_1 of { happy_var_1 -> +	case happyOut42 happy_x_3 of { happy_var_3 -> +	happyIn42+		 (C.Plus happy_var_1 happy_var_3+	)}}++happyReduce_108 = happySpecReduce_3  38# happyReduction_108+happyReduction_108 happy_x_3+	happy_x_2+	happy_x_1+	 =  case happyOut45 happy_x_1 of { happy_var_1 -> +	case happyOut42 happy_x_3 of { happy_var_3 -> +	happyIn42+		 (C.App happy_var_1 [happy_var_3]+	)}}++happyReduce_109 = happySpecReduce_3  38# happyReduction_109+happyReduction_109 happy_x_3+	happy_x_2+	happy_x_1+	 =  case happyOut45 happy_x_1 of { happy_var_1 -> +	case happyOut42 happy_x_3 of { happy_var_3 -> +	happyIn42+		 (C.App happy_var_3 [happy_var_1]+	)}}++happyReduce_110 = happySpecReduce_1  39# happyReduction_110+happyReduction_110 happy_x_1+	 =  case happyOut45 happy_x_1 of { happy_var_1 -> +	happyIn43+		 (happy_var_1+	)}++happyReduce_111 = happySpecReduce_3  39# happyReduction_111+happyReduction_111 happy_x_3+	happy_x_2+	happy_x_1+	 =  case happyOut44 happy_x_1 of { happy_var_1 -> +	case happyOut43 happy_x_3 of { happy_var_3 -> +	happyIn43+		 (C.Quant A.Sigma [happy_var_1] happy_var_3+	)}}++happyReduce_112 = happySpecReduce_1  40# happyReduction_112+happyReduction_112 happy_x_1+	 =  case happyOut45 happy_x_1 of { happy_var_1 -> +	happyIn44+		 (C.TBind (Dec Default) {- A.defaultDec -} [] happy_var_1+	)}++happyReduce_113 = happySpecReduce_3  40# happyReduction_113+happyReduction_113 happy_x_3+	happy_x_2+	happy_x_1+	 =  case happyOut42 happy_x_2 of { happy_var_2 -> +	happyIn44+		 (C.TBind A.irrelevantDec [] happy_var_2+	)}++happyReduce_114 = happySpecReduce_2  40# happyReduction_114+happyReduction_114 happy_x_2+	happy_x_1+	 =  case happyOut26 happy_x_1 of { happy_var_1 -> +	case happyOut45 happy_x_2 of { happy_var_2 -> +	happyIn44+		 (C.TBind (Dec happy_var_1) [] happy_var_2+	)}}++happyReduce_115 = happySpecReduce_1  40# happyReduction_115+happyReduction_115 happy_x_1+	 =  case happyOut32 happy_x_1 of { happy_var_1 -> +	happyIn44+		 (happy_var_1+	)}++happyReduce_116 = happySpecReduce_1  40# happyReduction_116+happyReduction_116 happy_x_1+	 =  case happyOut27 happy_x_1 of { happy_var_1 -> +	happyIn44+		 (C.TMeasure happy_var_1+	)}++happyReduce_117 = happySpecReduce_1  40# happyReduction_117+happyReduction_117 happy_x_1+	 =  case happyOut29 happy_x_1 of { happy_var_1 -> +	happyIn44+		 (C.TBound happy_var_1+	)}++happyReduce_118 = happySpecReduce_1  41# happyReduction_118+happyReduction_118 happy_x_1+	 =  case happyOut46 happy_x_1 of { happy_var_1 -> +	happyIn45+		 (let (f : args) = reverse happy_var_1 in+                if null args then f else C.App f args+	)}++happyReduce_119 = happySpecReduce_2  41# happyReduction_119+happyReduction_119 happy_x_2+	happy_x_1+	 =  case happyOut47 happy_x_2 of { happy_var_2 -> +	happyIn45+		 (C.CoSet happy_var_2+	)}++happyReduce_120 = happySpecReduce_1  41# happyReduction_120+happyReduction_120 happy_x_1+	 =  happyIn45+		 (C.Set C.Zero+	)++happyReduce_121 = happySpecReduce_2  41# happyReduction_121+happyReduction_121 happy_x_2+	happy_x_1+	 =  case happyOut47 happy_x_2 of { happy_var_2 -> +	happyIn45+		 (C.Set happy_var_2+	)}++happyReduce_122 = happySpecReduce_3  41# happyReduction_122+happyReduction_122 happy_x_3+	happy_x_2+	happy_x_1+	 =  case happyOutTok happy_x_1 of { (T.Number happy_var_1 _) -> +	case happyOut45 happy_x_3 of { happy_var_3 -> +	happyIn45+		 (let n = read happy_var_1 in+                            if n==0 then C.Zero else+                            iterate (C.Plus happy_var_3) happy_var_3 !! (n-1)+	)}}++happyReduce_123 = happySpecReduce_1  42# happyReduction_123+happyReduction_123 happy_x_1+	 =  case happyOut47 happy_x_1 of { happy_var_1 -> +	happyIn46+		 ([happy_var_1]+	)}++happyReduce_124 = happySpecReduce_2  42# happyReduction_124+happyReduction_124 happy_x_2+	happy_x_1+	 =  case happyOut46 happy_x_1 of { happy_var_1 -> +	case happyOut47 happy_x_2 of { happy_var_2 -> +	happyIn46+		 (happy_var_2 : happy_var_1+	)}}++happyReduce_125 = happySpecReduce_3  42# happyReduction_125+happyReduction_125 happy_x_3+	happy_x_2+	happy_x_1+	 =  case happyOut46 happy_x_1 of { happy_var_1 -> +	case happyOut23 happy_x_3 of { happy_var_3 -> +	happyIn46+		 (C.Proj happy_var_3 : happy_var_1+	)}}++happyReduce_126 = happySpecReduce_2  42# happyReduction_126+happyReduction_126 happy_x_2+	happy_x_1+	 =  case happyOut46 happy_x_1 of { happy_var_1 -> +	happyIn46+		 (C.Set C.Zero : happy_var_1+	)}++happyReduce_127 = happySpecReduce_1  43# happyReduction_127+happyReduction_127 happy_x_1+	 =  happyIn47+		 (C.Size+	)++happyReduce_128 = happySpecReduce_1  43# happyReduction_128+happyReduction_128 happy_x_1+	 =  happyIn47+		 (C.Max+	)++happyReduce_129 = happySpecReduce_1  43# happyReduction_129+happyReduction_129 happy_x_1+	 =  happyIn47+		 (C.Infty+	)++happyReduce_130 = happySpecReduce_1  43# happyReduction_130+happyReduction_130 happy_x_1+	 =  case happyOut48 happy_x_1 of { happy_var_1 -> +	happyIn47+		 (C.Ident happy_var_1+	)}++happyReduce_131 = happyReduce 5# 43# happyReduction_131+happyReduction_131 (happy_x_5 `HappyStk`+	happy_x_4 `HappyStk`+	happy_x_3 `HappyStk`+	happy_x_2 `HappyStk`+	happy_x_1 `HappyStk`+	happyRest)+	 = case happyOut40 happy_x_2 of { happy_var_2 -> +	case happyOut42 happy_x_4 of { happy_var_4 -> +	happyIn47+		 (C.Sing happy_var_2 happy_var_4+	) `HappyStk` happyRest}}++happyReduce_132 = happySpecReduce_3  43# happyReduction_132+happyReduction_132 happy_x_3+	happy_x_2+	happy_x_1+	 =  case happyOut40 happy_x_2 of { happy_var_2 -> +	happyIn47+		 (happy_var_2+	)}++happyReduce_133 = happySpecReduce_1  43# happyReduction_133+happyReduction_133 happy_x_1+	 =  happyIn47+		 (C.Unknown+	)++happyReduce_134 = happySpecReduce_2  43# happyReduction_134+happyReduction_134 happy_x_2+	happy_x_1+	 =  case happyOut47 happy_x_2 of { happy_var_2 -> +	happyIn47+		 (C.Succ happy_var_2+	)}++happyReduce_135 = happySpecReduce_1  43# happyReduction_135+happyReduction_135 happy_x_1+	 =  case happyOutTok happy_x_1 of { (T.Number happy_var_1 _) -> +	happyIn47+		 (iterate C.Succ C.Zero !! (read happy_var_1)+	)}++happyReduce_136 = happyReduce 4# 43# happyReduction_136+happyReduction_136 (happy_x_4 `HappyStk`+	happy_x_3 `HappyStk`+	happy_x_2 `HappyStk`+	happy_x_1 `HappyStk`+	happyRest)+	 = case happyOut49 happy_x_3 of { happy_var_3 -> +	happyIn47+		 (C.Record happy_var_3+	) `HappyStk` happyRest}++happyReduce_137 = happySpecReduce_1  44# happyReduction_137+happyReduction_137 happy_x_1+	 =  case happyOutTok happy_x_1 of { (T.QualId happy_var_1 _) -> +	happyIn48+		 (let (m,n) = happy_var_1 in C.Qual (C.Name m) (C.Name n)+	)}++happyReduce_138 = happySpecReduce_1  44# happyReduction_138+happyReduction_138 happy_x_1+	 =  case happyOut23 happy_x_1 of { happy_var_1 -> +	happyIn48+		 (C.QName happy_var_1+	)}++happyReduce_139 = happySpecReduce_3  45# happyReduction_139+happyReduction_139 happy_x_3+	happy_x_2+	happy_x_1+	 =  case happyOut50 happy_x_1 of { happy_var_1 -> +	case happyOut49 happy_x_3 of { happy_var_3 -> +	happyIn49+		 (happy_var_1 : happy_var_3+	)}}++happyReduce_140 = happySpecReduce_1  45# happyReduction_140+happyReduction_140 happy_x_1+	 =  case happyOut50 happy_x_1 of { happy_var_1 -> +	happyIn49+		 ([happy_var_1]+	)}++happyReduce_141 = happySpecReduce_0  45# happyReduction_141+happyReduction_141  =  happyIn49+		 ([]+	)++happyReduce_142 = happySpecReduce_3  46# happyReduction_142+happyReduction_142 happy_x_3+	happy_x_2+	happy_x_1+	 =  case happyOut24 happy_x_1 of { happy_var_1 -> +	case happyOut40 happy_x_3 of { happy_var_3 -> +	happyIn50+		 ((happy_var_1,happy_var_3)+	)}}++happyReduce_143 = happySpecReduce_3  47# happyReduction_143+happyReduction_143 happy_x_3+	happy_x_2+	happy_x_1+	 =  case happyOut23 happy_x_1 of { happy_var_1 -> +	case happyOut42 happy_x_3 of { happy_var_3 -> +	happyIn51+		 (C.TypeSig happy_var_1 happy_var_3+	)}}++happyReduce_144 = happyReduce 4# 48# happyReduction_144+happyReduction_144 (happy_x_4 `HappyStk`+	happy_x_3 `HappyStk`+	happy_x_2 `HappyStk`+	happy_x_1 `HappyStk`+	happyRest)+	 = case happyOut23 happy_x_1 of { happy_var_1 -> +	case happyOut31 happy_x_2 of { happy_var_2 -> +	case happyOut42 happy_x_4 of { happy_var_4 -> +	happyIn52+		 (C.Constructor happy_var_1 happy_var_2 (Just happy_var_4)+	) `HappyStk` happyRest}}}++happyReduce_145 = happySpecReduce_2  48# happyReduction_145+happyReduction_145 happy_x_2+	happy_x_1+	 =  case happyOut23 happy_x_1 of { happy_var_1 -> +	case happyOut31 happy_x_2 of { happy_var_2 -> +	happyIn52+		 (C.Constructor happy_var_1 happy_var_2 Nothing+	)}}++happyReduce_146 = happySpecReduce_3  49# happyReduction_146+happyReduction_146 happy_x_3+	happy_x_2+	happy_x_1+	 =  case happyOut53 happy_x_1 of { happy_var_1 -> +	case happyOut52 happy_x_3 of { happy_var_3 -> +	happyIn53+		 (happy_var_3 : happy_var_1+	)}}++happyReduce_147 = happySpecReduce_2  49# happyReduction_147+happyReduction_147 happy_x_2+	happy_x_1+	 =  case happyOut53 happy_x_1 of { happy_var_1 -> +	happyIn53+		 (happy_var_1+	)}++happyReduce_148 = happySpecReduce_1  49# happyReduction_148+happyReduction_148 happy_x_1+	 =  case happyOut52 happy_x_1 of { happy_var_1 -> +	happyIn53+		 ([happy_var_1]+	)}++happyReduce_149 = happySpecReduce_0  49# happyReduction_149+happyReduction_149  =  happyIn53+		 ([]+	)++happyReduce_150 = happyReduce 5# 50# happyReduction_150+happyReduction_150 (happy_x_5 `HappyStk`+	happy_x_4 `HappyStk`+	happy_x_3 `HappyStk`+	happy_x_2 `HappyStk`+	happy_x_1 `HappyStk`+	happyRest)+	 = case happyOut58 happy_x_1 of { happy_var_1 -> +	case happyOut40 happy_x_3 of { happy_var_3 -> +	case happyOut54 happy_x_5 of { happy_var_5 -> +	happyIn54+		 ((C.Clause Nothing [happy_var_1] (Just happy_var_3)) : happy_var_5+	) `HappyStk` happyRest}}}++happyReduce_151 = happySpecReduce_3  50# happyReduction_151+happyReduction_151 happy_x_3+	happy_x_2+	happy_x_1+	 =  case happyOut58 happy_x_1 of { happy_var_1 -> +	case happyOut40 happy_x_3 of { happy_var_3 -> +	happyIn54+		 ((C.Clause Nothing [happy_var_1] (Just happy_var_3)) : []+	)}}++happyReduce_152 = happySpecReduce_3  50# happyReduction_152+happyReduction_152 happy_x_3+	happy_x_2+	happy_x_1+	 =  case happyOut58 happy_x_1 of { happy_var_1 -> +	case happyOut54 happy_x_3 of { happy_var_3 -> +	happyIn54+		 ((C.Clause Nothing [happy_var_1] Nothing) : happy_var_3+	)}}++happyReduce_153 = happySpecReduce_1  50# happyReduction_153+happyReduction_153 happy_x_1+	 =  case happyOut58 happy_x_1 of { happy_var_1 -> +	happyIn54+		 ((C.Clause Nothing [happy_var_1] Nothing) : []+	)}++happyReduce_154 = happySpecReduce_0  50# happyReduction_154+happyReduction_154  =  happyIn54+		 ([]+	)++happyReduce_155 = happyReduce 4# 51# happyReduction_155+happyReduction_155 (happy_x_4 `HappyStk`+	happy_x_3 `HappyStk`+	happy_x_2 `HappyStk`+	happy_x_1 `HappyStk`+	happyRest)+	 = case happyOut23 happy_x_1 of { happy_var_1 -> +	case happyOut56 happy_x_2 of { happy_var_2 -> +	case happyOut40 happy_x_4 of { happy_var_4 -> +	happyIn55+		 (C.Clause (Just happy_var_1) happy_var_2 (Just happy_var_4)+	) `HappyStk` happyRest}}}++happyReduce_156 = happySpecReduce_2  51# happyReduction_156+happyReduction_156 happy_x_2+	happy_x_1+	 =  case happyOut23 happy_x_1 of { happy_var_1 -> +	case happyOut56 happy_x_2 of { happy_var_2 -> +	happyIn55+		 (C.Clause (Just happy_var_1) happy_var_2 Nothing+	)}}++happyReduce_157 = happySpecReduce_1  52# happyReduction_157+happyReduction_157 happy_x_1+	 =  case happyOut57 happy_x_1 of { happy_var_1 -> +	happyIn56+		 (reverse happy_var_1+	)}++happyReduce_158 = happySpecReduce_0  53# happyReduction_158+happyReduction_158  =  happyIn57+		 ([]+	)++happyReduce_159 = happySpecReduce_2  53# happyReduction_159+happyReduction_159 happy_x_2+	happy_x_1+	 =  case happyOut57 happy_x_1 of { happy_var_1 -> +	case happyOut58 happy_x_2 of { happy_var_2 -> +	happyIn57+		 (happy_var_2 : happy_var_1+	)}}++happyReduce_160 = happySpecReduce_3  53# happyReduction_160+happyReduction_160 happy_x_3+	happy_x_2+	happy_x_1+	 =  case happyOut57 happy_x_1 of { happy_var_1 -> +	case happyOut60 happy_x_3 of { happy_var_3 -> +	happyIn57+		 (happy_var_3 : happy_var_1+	)}}++happyReduce_161 = happySpecReduce_2  54# happyReduction_161+happyReduction_161 happy_x_2+	happy_x_1+	 =  happyIn58+		 (C.AbsurdP+	)++happyReduce_162 = happySpecReduce_3  54# happyReduction_162+happyReduction_162 happy_x_3+	happy_x_2+	happy_x_1+	 =  case happyOut59 happy_x_2 of { happy_var_2 -> +	happyIn58+		 (happy_var_2+	)}++happyReduce_163 = happySpecReduce_1  54# happyReduction_163+happyReduction_163 happy_x_1+	 =  case happyOut62 happy_x_1 of { happy_var_1 -> +	happyIn58+		 (happy_var_1+	)}++happyReduce_164 = happySpecReduce_2  54# happyReduction_164+happyReduction_164 happy_x_2+	happy_x_1+	 =  case happyOut58 happy_x_2 of { happy_var_2 -> +	happyIn58+		 (C.SuccP happy_var_2+	)}++happyReduce_165 = happySpecReduce_2  54# happyReduction_165+happyReduction_165 happy_x_2+	happy_x_1+	 =  happyIn58+		 (C.DotP (C.Set C.Zero)+	)++happyReduce_166 = happySpecReduce_2  54# happyReduction_166+happyReduction_166 happy_x_2+	happy_x_1+	 =  case happyOut47 happy_x_2 of { happy_var_2 -> +	happyIn58+		 (C.DotP happy_var_2+	)}++happyReduce_167 = happySpecReduce_3  55# happyReduction_167+happyReduction_167 happy_x_3+	happy_x_2+	happy_x_1+	 =  case happyOut60 happy_x_1 of { happy_var_1 -> +	case happyOut59 happy_x_3 of { happy_var_3 -> +	happyIn59+		 (C.PairP happy_var_1 happy_var_3+	)}}++happyReduce_168 = happySpecReduce_1  55# happyReduction_168+happyReduction_168 happy_x_1+	 =  case happyOut60 happy_x_1 of { happy_var_1 -> +	happyIn59+		 (happy_var_1+	)}++happyReduce_169 = happySpecReduce_1  56# happyReduction_169+happyReduction_169 happy_x_1+	 =  case happyOut61 happy_x_1 of { happy_var_1 -> +	happyIn60+		 (happy_var_1+	)}++happyReduce_170 = happySpecReduce_3  56# happyReduction_170+happyReduction_170 happy_x_3+	happy_x_2+	happy_x_1+	 =  case happyOut47 happy_x_1 of { happy_var_1 -> +	case happyOut23 happy_x_3 of { happy_var_3 -> +	happyIn60+		 (C.SizeP happy_var_1 happy_var_3+	)}}++happyReduce_171 = happySpecReduce_3  56# happyReduction_171+happyReduction_171 happy_x_3+	happy_x_2+	happy_x_1+	 =  case happyOut23 happy_x_1 of { happy_var_1 -> +	case happyOut47 happy_x_3 of { happy_var_3 -> +	happyIn60+		 (C.SizeP happy_var_3 happy_var_1+	)}}++happyReduce_172 = happySpecReduce_1  56# happyReduction_172+happyReduction_172 happy_x_1+	 =  case happyOut58 happy_x_1 of { happy_var_1 -> +	happyIn60+		 (happy_var_1+	)}++happyReduce_173 = happySpecReduce_3  56# happyReduction_173+happyReduction_173 happy_x_3+	happy_x_2+	happy_x_1+	 =  case happyOut61 happy_x_1 of { happy_var_1 -> +	case happyOut60 happy_x_3 of { happy_var_3 -> +	happyIn60+		 (patApp happy_var_1 [happy_var_3]+	)}}++happyReduce_174 = happySpecReduce_2  57# happyReduction_174+happyReduction_174 happy_x_2+	happy_x_1+	 =  case happyOut62 happy_x_1 of { happy_var_1 -> +	case happyOut58 happy_x_2 of { happy_var_2 -> +	happyIn61+		 (patApp happy_var_1 [happy_var_2]+	)}}++happyReduce_175 = happySpecReduce_2  57# happyReduction_175+happyReduction_175 happy_x_2+	happy_x_1+	 =  case happyOut61 happy_x_1 of { happy_var_1 -> +	case happyOut58 happy_x_2 of { happy_var_2 -> +	happyIn61+		 (patApp happy_var_1 [happy_var_2]+	)}}++happyReduce_176 = happySpecReduce_1  58# happyReduction_176+happyReduction_176 happy_x_1+	 =  case happyOut23 happy_x_1 of { happy_var_1 -> +	happyIn62+		 (C.IdentP (C.QName happy_var_1)+	)}++happyReduce_177 = happySpecReduce_2  58# happyReduction_177+happyReduction_177 happy_x_2+	happy_x_1+	 =  case happyOut23 happy_x_2 of { happy_var_2 -> +	happyIn62+		 (C.ConP True (C.QName happy_var_2) []+	)}++happyReduce_178 = happySpecReduce_1  59# happyReduction_178+happyReduction_178 happy_x_1+	 =  case happyOut64 happy_x_1 of { happy_var_1 -> +	happyIn63+		 (reverse happy_var_1+	)}++happyReduce_179 = happySpecReduce_3  60# happyReduction_179+happyReduction_179 happy_x_3+	happy_x_2+	happy_x_1+	 =  case happyOut64 happy_x_1 of { happy_var_1 -> +	case happyOut55 happy_x_3 of { happy_var_3 -> +	happyIn64+		 (happy_var_3 : happy_var_1+	)}}++happyReduce_180 = happySpecReduce_2  60# happyReduction_180+happyReduction_180 happy_x_2+	happy_x_1+	 =  case happyOut64 happy_x_1 of { happy_var_1 -> +	happyIn64+		 (happy_var_1+	)}++happyReduce_181 = happySpecReduce_1  60# happyReduction_181+happyReduction_181 happy_x_1+	 =  case happyOut55 happy_x_1 of { happy_var_1 -> +	happyIn64+		 ([happy_var_1]+	)}++happyReduce_182 = happySpecReduce_0  60# happyReduction_182+happyReduction_182  =  happyIn64+		 ([]+	)++happyReduce_183 = happyReduce 5# 61# happyReduction_183+happyReduction_183 (happy_x_5 `HappyStk`+	happy_x_4 `HappyStk`+	happy_x_3 `HappyStk`+	happy_x_2 `HappyStk`+	happy_x_1 `HappyStk`+	happyRest)+	 = case happyOut25 happy_x_2 of { happy_var_2 -> +	case happyOut42 happy_x_4 of { happy_var_4 -> +	happyIn65+		 (C.TBind (Dec Default) happy_var_2 happy_var_4+	) `HappyStk` happyRest}}++happyReduce_184 = happyReduce 5# 61# happyReduction_184+happyReduction_184 (happy_x_5 `HappyStk`+	happy_x_4 `HappyStk`+	happy_x_3 `HappyStk`+	happy_x_2 `HappyStk`+	happy_x_1 `HappyStk`+	happyRest)+	 = case happyOut25 happy_x_2 of { happy_var_2 -> +	case happyOut42 happy_x_4 of { happy_var_4 -> +	happyIn65+		 (C.TBind A.irrelevantDec happy_var_2 happy_var_4+	) `HappyStk` happyRest}}++happyReduce_185 = happyReduce 6# 61# happyReduction_185+happyReduction_185 (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 happyOut26 happy_x_1 of { happy_var_1 -> +	case happyOut25 happy_x_3 of { happy_var_3 -> +	case happyOut42 happy_x_5 of { happy_var_5 -> +	happyIn65+		 (C.TBind (Dec happy_var_1) happy_var_3 happy_var_5+	) `HappyStk` happyRest}}}++happyReduce_186 = happyReduce 6# 61# happyReduction_186+happyReduction_186 (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 happyOut25 happy_x_3 of { happy_var_3 -> +	case happyOut42 happy_x_5 of { happy_var_5 -> +	happyIn65+		 (C.TBind (Dec SPos) happy_var_3 happy_var_5+	) `HappyStk` happyRest}}++happyReduce_187 = happySpecReduce_0  62# happyReduction_187+happyReduction_187  =  happyIn66+		 ([]+	)++happyReduce_188 = happySpecReduce_2  62# happyReduction_188+happyReduction_188 happy_x_2+	happy_x_1+	 =  case happyOut65 happy_x_1 of { happy_var_1 -> +	case happyOut66 happy_x_2 of { happy_var_2 -> +	happyIn66+		 (happy_var_1 : happy_var_2+	)}}++happyNewToken action sts stk [] =+	happyDoAction 56# notHappyAtAll action sts stk []++happyNewToken action sts stk (tk:tks) =+	let cont i = happyDoAction i tk action sts stk tks in+	case tk of {+	T.Id happy_dollar_dollar _ -> cont 1#;+	T.QualId happy_dollar_dollar _ -> cont 2#;+	T.Number happy_dollar_dollar _ -> cont 3#;+	T.Data _ -> cont 4#;+	T.CoData _ -> cont 5#;+	T.Record _ -> cont 6#;+	T.Sized _ -> cont 7#;+	T.Fields _ -> cont 8#;+	T.Mutual _ -> cont 9#;+	T.Fun _ -> cont 10#;+	T.CoFun _ -> cont 11#;+	T.Pattern _ -> cont 12#;+	T.Case _ -> cont 13#;+	T.Def _ -> cont 14#;+	T.Let _ -> cont 15#;+	T.In _ -> cont 16#;+	T.Eval _ -> cont 17#;+	T.Fail _ -> cont 18#;+	T.Check _ -> cont 19#;+	T.TrustMe _ -> cont 20#;+	T.Impredicative _ -> cont 21#;+	T.Type _ -> cont 22#;+	T.Set _ -> cont 23#;+	T.CoSet _ -> cont 24#;+	T.Size _ -> cont 25#;+	T.Infty _ -> cont 26#;+	T.Succ _ -> cont 27#;+	T.Max _ -> cont 28#;+	T.LTri _ -> cont 29#;+	T.RTri _ -> cont 30#;+	T.AngleOpen _ -> cont 31#;+	T.AngleClose _ -> cont 32#;+	T.BrOpen _ -> cont 33#;+	T.BrClose _ -> cont 34#;+	T.BracketOpen _ -> cont 35#;+	T.BracketClose _ -> cont 36#;+	T.PrOpen _ -> cont 37#;+	T.PrClose _ -> cont 38#;+	T.Bar _ -> cont 39#;+	T.Comma _ -> cont 40#;+	T.Sem _ -> cont 41#;+	T.Col _ -> cont 42#;+	T.Dot _ -> cont 43#;+	T.Arrow _ -> cont 44#;+	T.Leq _ -> cont 45#;+	T.Eq _ -> cont 46#;+	T.PlusPlus _ -> cont 47#;+	T.Plus _ -> cont 48#;+	T.Minus _ -> cont 49#;+	T.Slash _ -> cont 50#;+	T.Times _ -> cont 51#;+	T.Hat _ -> cont 52#;+	T.Amp _ -> cont 53#;+	T.Lam _ -> cont 54#;+	T.Underscore _ -> cont 55#;+	_ -> happyError' (tk:tks)+	}++happyError_ 56# tk tks = happyError' tks+happyError_ _ tk tks = happyError' (tk:tks)++newtype HappyIdentity a = HappyIdentity a+happyIdentity = HappyIdentity+happyRunIdentity (HappyIdentity a) = a++instance Monad HappyIdentity where+    return = HappyIdentity+    (HappyIdentity p) >>= q = q p++happyThen :: () => HappyIdentity a -> (a -> HappyIdentity b) -> HappyIdentity b+happyThen = (>>=)+happyReturn :: () => a -> HappyIdentity a+happyReturn = (return)+happyThen1 m k tks = (>>=) m (\a -> k a tks)+happyReturn1 :: () => a -> b -> HappyIdentity a+happyReturn1 = \a tks -> (return) a+happyError' :: () => [(T.Token)] -> HappyIdentity a+happyError' = HappyIdentity . parseError++parse tks = happyRunIdentity happySomeParser where+  happySomeParser = happyThen (happyParse 0# tks) (\x -> happyReturn (happyOut4 x))++happySeq = happyDontSeq+++parseError :: [T.Token] -> a+parseError [] = error "Parse error at EOF"+parseError (x : xs) = error ("Parse error at token " ++ T.prettyTok x)+{-# LINE 1 "templates/GenericTemplate.hs" #-}+{-# LINE 1 "templates/GenericTemplate.hs" #-}+{-# LINE 1 "<built-in>" #-}+{-# LINE 1 "<command-line>" #-}+{-# LINE 1 "templates/GenericTemplate.hs" #-}+-- Id: GenericTemplate.hs,v 1.26 2005/01/14 14:47:22 simonmar Exp ++{-# LINE 30 "templates/GenericTemplate.hs" #-}+++data Happy_IntList = HappyCons Happy_GHC_Exts.Int# Happy_IntList++++++{-# LINE 51 "templates/GenericTemplate.hs" #-}++{-# LINE 61 "templates/GenericTemplate.hs" #-}++{-# LINE 70 "templates/GenericTemplate.hs" #-}++infixr 9 `HappyStk`+data HappyStk a = HappyStk a (HappyStk a)++-----------------------------------------------------------------------------+-- starting the parse++happyParse start_state = happyNewToken start_state notHappyAtAll notHappyAtAll++-----------------------------------------------------------------------------+-- Accepting the parse++-- If the current token is 0#, it means we've just accepted a partial+-- parse (a %partial parser).  We must ignore the saved token on the top of+-- the stack in this case.+happyAccept 0# tk st sts (_ `HappyStk` ans `HappyStk` _) =+	happyReturn1 ans+happyAccept j tk st sts (HappyStk ans _) = +	(happyTcHack j (happyTcHack st)) (happyReturn1 ans)++-----------------------------------------------------------------------------+-- Arrays only: do the next action++++happyDoAction i tk st+	= {- nothing -}+++	  case action of+		0#		  -> {- nothing -}+				     happyFail i tk st+		-1# 	  -> {- nothing -}+				     happyAccept i tk st+		n | (n Happy_GHC_Exts.<# (0# :: Happy_GHC_Exts.Int#)) -> {- nothing -}++				     (happyReduceArr Happy_Data_Array.! rule) i tk st+				     where rule = (Happy_GHC_Exts.I# ((Happy_GHC_Exts.negateInt# ((n Happy_GHC_Exts.+# (1# :: Happy_GHC_Exts.Int#))))))+		n		  -> {- nothing -}+++				     happyShift new_state i tk st+				     where (new_state) = (n Happy_GHC_Exts.-# (1# :: Happy_GHC_Exts.Int#))+   where (off)    = indexShortOffAddr happyActOffsets st+         (off_i)  = (off Happy_GHC_Exts.+# i)+	 check  = if (off_i Happy_GHC_Exts.>=# (0# :: Happy_GHC_Exts.Int#))+			then (indexShortOffAddr happyCheck off_i Happy_GHC_Exts.==#  i)+			else False+         (action)+          | check     = indexShortOffAddr happyTable off_i+          | otherwise = indexShortOffAddr happyDefActions st++{-# LINE 130 "templates/GenericTemplate.hs" #-}+++indexShortOffAddr (HappyA# arr) off =+	Happy_GHC_Exts.narrow16Int# i+  where+        i = Happy_GHC_Exts.word2Int# (Happy_GHC_Exts.or# (Happy_GHC_Exts.uncheckedShiftL# high 8#) low)+        high = Happy_GHC_Exts.int2Word# (Happy_GHC_Exts.ord# (Happy_GHC_Exts.indexCharOffAddr# arr (off' Happy_GHC_Exts.+# 1#)))+        low  = Happy_GHC_Exts.int2Word# (Happy_GHC_Exts.ord# (Happy_GHC_Exts.indexCharOffAddr# arr off'))+        off' = off Happy_GHC_Exts.*# 2#++++++data HappyAddr = HappyA# Happy_GHC_Exts.Addr#+++++-----------------------------------------------------------------------------+-- HappyState data type (not arrays)++{-# LINE 163 "templates/GenericTemplate.hs" #-}++-----------------------------------------------------------------------------+-- Shifting a token++happyShift new_state 0# tk st sts stk@(x `HappyStk` _) =+     let (i) = (case Happy_GHC_Exts.unsafeCoerce# x of { (Happy_GHC_Exts.I# (i)) -> i }) in+--     trace "shifting the error token" $+     happyDoAction i tk new_state (HappyCons (st) (sts)) (stk)++happyShift new_state i tk st sts stk =+     happyNewToken new_state (HappyCons (st) (sts)) ((happyInTok (tk))`HappyStk`stk)++-- happyReduce is specialised for the common cases.++happySpecReduce_0 i fn 0# tk st sts stk+     = happyFail 0# tk st sts stk+happySpecReduce_0 nt fn j tk st@((action)) sts stk+     = happyGoto nt j tk st (HappyCons (st) (sts)) (fn `HappyStk` stk)++happySpecReduce_1 i fn 0# tk st sts stk+     = happyFail 0# tk st sts stk+happySpecReduce_1 nt fn j tk _ sts@((HappyCons (st@(action)) (_))) (v1`HappyStk`stk')+     = let r = fn v1 in+       happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk'))++happySpecReduce_2 i fn 0# tk st sts stk+     = happyFail 0# tk st sts stk+happySpecReduce_2 nt fn j tk _ (HappyCons (_) (sts@((HappyCons (st@(action)) (_))))) (v1`HappyStk`v2`HappyStk`stk')+     = let r = fn v1 v2 in+       happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk'))++happySpecReduce_3 i fn 0# tk st sts stk+     = happyFail 0# tk st sts stk+happySpecReduce_3 nt fn j tk _ (HappyCons (_) ((HappyCons (_) (sts@((HappyCons (st@(action)) (_))))))) (v1`HappyStk`v2`HappyStk`v3`HappyStk`stk')+     = let r = fn v1 v2 v3 in+       happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk'))++happyReduce k i fn 0# tk st sts stk+     = happyFail 0# tk st sts stk+happyReduce k nt fn j tk st sts stk+     = case happyDrop (k Happy_GHC_Exts.-# (1# :: Happy_GHC_Exts.Int#)) sts of+	 sts1@((HappyCons (st1@(action)) (_))) ->+        	let r = fn stk in  -- it doesn't hurt to always seq here...+       		happyDoSeq r (happyGoto nt j tk st1 sts1 r)++happyMonadReduce k nt fn 0# tk st sts stk+     = happyFail 0# tk st sts stk+happyMonadReduce k nt fn j tk st sts stk =+        happyThen1 (fn stk tk) (\r -> happyGoto nt j tk st1 sts1 (r `HappyStk` drop_stk))+       where (sts1@((HappyCons (st1@(action)) (_)))) = happyDrop k (HappyCons (st) (sts))+             drop_stk = happyDropStk k stk++happyMonad2Reduce k nt fn 0# tk st sts stk+     = happyFail 0# tk st sts stk+happyMonad2Reduce k nt fn j tk st sts stk =+       happyThen1 (fn stk tk) (\r -> happyNewToken new_state sts1 (r `HappyStk` drop_stk))+       where (sts1@((HappyCons (st1@(action)) (_)))) = happyDrop k (HappyCons (st) (sts))+             drop_stk = happyDropStk k stk++             (off) = indexShortOffAddr happyGotoOffsets st1+             (off_i) = (off Happy_GHC_Exts.+# nt)+             (new_state) = indexShortOffAddr happyTable off_i+++++happyDrop 0# l = l+happyDrop n (HappyCons (_) (t)) = happyDrop (n Happy_GHC_Exts.-# (1# :: Happy_GHC_Exts.Int#)) t++happyDropStk 0# l = l+happyDropStk n (x `HappyStk` xs) = happyDropStk (n Happy_GHC_Exts.-# (1#::Happy_GHC_Exts.Int#)) xs++-----------------------------------------------------------------------------+-- Moving to a new state after a reduction+++happyGoto nt j tk st = +   {- nothing -}+   happyDoAction j tk new_state+   where (off) = indexShortOffAddr happyGotoOffsets st+         (off_i) = (off Happy_GHC_Exts.+# nt)+         (new_state) = indexShortOffAddr happyTable off_i+++++-----------------------------------------------------------------------------+-- Error recovery (0# is the error token)++-- parse error if we are in recovery and we fail again+happyFail 0# tk old_st _ stk@(x `HappyStk` _) =+     let (i) = (case Happy_GHC_Exts.unsafeCoerce# x of { (Happy_GHC_Exts.I# (i)) -> i }) in+--	trace "failing" $ +        happyError_ i tk++{-  We don't need state discarding for our restricted implementation of+    "error".  In fact, it can cause some bogus parses, so I've disabled it+    for now --SDM++-- discard a state+happyFail  0# tk old_st (HappyCons ((action)) (sts)) +						(saved_tok `HappyStk` _ `HappyStk` stk) =+--	trace ("discarding state, depth " ++ show (length stk))  $+	happyDoAction 0# tk action sts ((saved_tok`HappyStk`stk))+-}++-- Enter error recovery: generate an error token,+--                       save the old token and carry on.+happyFail  i tk (action) sts stk =+--      trace "entering error recovery" $+	happyDoAction 0# tk action sts ( (Happy_GHC_Exts.unsafeCoerce# (Happy_GHC_Exts.I# (i))) `HappyStk` stk)++-- Internal happy errors:++notHappyAtAll :: a+notHappyAtAll = error "Internal Happy error\n"++-----------------------------------------------------------------------------+-- Hack to get the typechecker to accept our action functions+++happyTcHack :: Happy_GHC_Exts.Int# -> a -> a+happyTcHack x y = y+{-# INLINE happyTcHack #-}+++-----------------------------------------------------------------------------+-- Seq-ing.  If the --strict flag is given, then Happy emits +--	happySeq = happyDoSeq+-- otherwise it emits+-- 	happySeq = happyDontSeq++happyDoSeq, happyDontSeq :: a -> b -> b+happyDoSeq   a b = a `seq` b+happyDontSeq a b = b++-----------------------------------------------------------------------------+-- Don't inline any functions from the template.  GHC has a nasty habit+-- of deciding to inline happyGoto everywhere, which increases the size of+-- the generated parser quite a bit.+++{-# NOINLINE happyDoAction #-}+{-# NOINLINE happyTable #-}+{-# NOINLINE happyCheck #-}+{-# NOINLINE happyActOffsets #-}+{-# NOINLINE happyGotoOffsets #-}+{-# NOINLINE happyDefActions #-}++{-# NOINLINE happyShift #-}+{-# NOINLINE happySpecReduce_0 #-}+{-# NOINLINE happySpecReduce_1 #-}+{-# NOINLINE happySpecReduce_2 #-}+{-# NOINLINE happySpecReduce_3 #-}+{-# NOINLINE happyReduce #-}+{-# NOINLINE happyMonadReduce #-}+{-# NOINLINE happyGoto #-}+{-# NOINLINE happyFail #-}++-- end of Happy Template.
+ lib/base.ma view
@@ -0,0 +1,94 @@+-- 2012-02-01 MiniAgda Library (not universe polymorphic)++-- Leibniz equality  (the only family)++data Id [A : Set](a : A) : A -> Set+{ refl : Id A a a+}++fun subst : [A : Set] -> [P : A -> Set] -> [a, b : A] -> Id A a b -> P a -> P b+{ subst A P a .a refl h = h+}++fun cong : [A : Set] -> [B : A -> Set] -> [f : (x : A) -> B x] ->+  [a, b : A] -> (p : Id A a b) ->+  Id (B b) (subst A B a b p (f a)) (f b)+{ cong A B f a .a refl = refl+}++-- Enumerations and sums++data Empty {}+data Unit { unit }++-- * Booleans++data Bool { true; false }++fun if : [A : Set] -> (b : Bool) -> (t, e : A) -> A+{ if A true  t e = t+; if A false t e = e+}++fun If : (b : Bool) -> ++(A, B : Set) -> Set+{ If true  A B = A+; If false A B = B+}++-- * Either: disjoint sum type++let Either ++(A, B : Set) = (b : Bool) & If b B A+pattern left  a = (false, a)+pattern right b = (true, b)++fun either : [A, B : Set] -> [C : Either A B -> Set] ->+  ((a : A) -> C (left a)) ->+  ((b : B) -> C (right b)) ->+  (x : Either A B) -> C x+{ either A B C l r (left  a) = l a+; either A B C l r (right b) = r b+}++fun EitherT : [A, B : Set] -> (A -> Set) -> (B -> Set) -> Either A B -> Set+{ EitherT A B l r (left  a) = l a+; EitherT A B l r (right b) = r b+}++let mapEither [A, B, A', B' : Set] (f : A -> A') (g : B -> B')+  : Either A B -> Either A' B'+  = either A B (\ x -> Either A' B') (\ a -> left (f a)) (\ b -> right (g b))++-- * Maybe: option type++let Maybe ++(A : Set) = Either Unit A+pattern nothing = left unit+pattern just a  = right a++let maybe [A, B : Set] (n : B) (j : A -> B) : Maybe A -> B+  = either Unit A (\ x -> B) (\ u -> n) j++let mapMaybe [A, B : Set] (f : A -> B) : Maybe A -> Maybe B+  = mapEither Unit A Unit B (\ u -> u) f++-- * Trichonomy++data Three { one; two; three }++fun ThreeT : (t : Three) -> ++(A, B, C : Set) -> Set+{ ThreeT one   A B C = A+; ThreeT two   A B C = B+; ThreeT three A B C = C+}++let Tri ++(A, B, C : Set) = (t : Three) & ThreeT t A B C+pattern first  a = (one, a)+pattern second b = (two, b)+pattern third  c = (three, c)++-- * Recursion principle++fun fix : [A : Size -> Set] ->+          ([i : Size] -> ([j < i] -> A j) -> A i) ->+          [i : Size] -> |i| -> A i+{ fix A f i = f i (fix A f)+}
+ lib/bintree.ma view
@@ -0,0 +1,11 @@+-- bintree.ma  Binary trees++cofun BinTree : ++(A : Set) -> +(i : Size) -> Set +{ BinTree A i = let ++T = [j < i] & BinTree A j+                in  Maybe (T & A & T)+}+pattern leaf       = nothing+pattern node l a r = just (l, a, r)+++
+ lib/colist.ma view
@@ -0,0 +1,59 @@+-- colist.ma -- MiniAgda colist library++cofun CoList : ++(A : Set) -> -(i : Size) -> Set+{ CoList A i = Maybe (A & ([i' < i] -> CoList A i')) +}++fun colist : [A : Set] -> [i : Size] -> |i| -> List A i -> CoList A i+{ colist A i nil               = nil+; colist A i (cons a (i', as)) = cons a (\ i'' -> colist A (max i' i'') as)+}  ++fun cotake : [A : Set] -> [i : Size] -> Nat i -> CoList A i -> List A i+{ cotake A i zero          as         = nil+; cotake A i n             nil        = nil+; cotake A i (suc (i', n)) (cons a l) = cons a (i', cotake A i' n (l i'))+}++fun codrop : [A : Set ] -> +             [i : Size] -> Nat i -> +             [j : Size] -> CoList A (j+i) -> CoList A j+{ codrop A i zero          j l          = l+; codrop A i n             j nil        = nil+; codrop A i (suc (i', n)) j (cons a l) = codrop A i' n j (l (j+i'))+}++-- direct encoding of tail+check+fun cotail : [A : Set] [i : Size] (l : CoList A $i) -> CoList A i+{ cotail A i nil        = nil+; cotail A i (cons a l) = l i +}++-- tail as instance of drop+let cotail [A : Set] : [i : Size] (l : CoList A $i) -> CoList A i+  = codrop A $0 (suc (0, zero))++fun coappend : [A : Set] -> [i : Size] -> |i| -> +               CoList A i -> CoList A i -> CoList A i+{ coappend A i nil        bs = bs+; coappend A i (cons a l) bs = cons a (\ i' -> coappend A i' (l i') bs)+}++-- list take++let take [A : Set] [i : Size] (n : Nat i) (as : List A i) : List A i +  = cotake A i n (colist A i as) ++{-++fun cotail : [A : Set] -> [i : Size] -> CoList A $i -> CoList A i+{ cotail A i l = case l+   { nil -> nil+   ; (cons a as) -> cons a (\ j -> as $j++mapMaybe (A & ([i' < $i] -> CoList A i'))  +                        (A & ([i' < i] -> CoList A i'))+    +}+-}
+ lib/list.ma view
@@ -0,0 +1,94 @@+-- list.ma -- MiniAgda list library++cofun List : ++(A : Set) -> +(i : Size) -> Set+{ List A i = Maybe (A & [i' < i] & List A i')+}+pattern nil      = nothing+pattern cons a l = just (a, l)++let consL [A : Set] [i : Size] (a : A) (as : List A i) : List A $i+  = cons a (i, as)++-- foldr++fun foldr : [A : Set] -> [B : Size -> Set] ->+  ([i : Size] -> A -> [j < i] -> B j -> B i) ->+  ([i : Size] -> B i) ->+  [i : Size] -> List A i -> B i+{ foldr A B f b i nil                = b i+; foldr A B f b i (cons a (j<i, as)) = f i a j (foldr A B f b j as)+}++-- map++check+let mapList : [A, B : Set] -> (A -> B) -> [i : Size] -> List A i -> List B i+  = \ A B f -> foldr A (List B)+       (\ i a j bs -> cons (f a) (j, bs))+       (\ i -> nil)++fun mapList : [A, B : Set] -> (A -> B) -> [i : Size] -> List A i -> List B i+{ mapList A B f i nil = nil+; mapList A B f i (cons a (j, as)) = cons (f a) (j, mapList A B f j as)+}++-- append++check+let append : [A : Set] ->+             [i : Size] -> List A i ->+             [j : Size] -> List A j -> List A (i+j)+  = \ A i as j bs ->+      foldr A (\ i -> List A (i+j))+        (\ i b i' bs -> cons b (i'+j, bs))+        (\ i -> bs)+        i+        as++fun append : [A : Set] ->+             [i : Size] -> |i| -> List A i ->+             [j : Size] -> List A j -> List A (i+j)+{ append A i nil                 j bs = bs+; append A i (cons a (i'<i, as)) j bs = cons a (i'+j, append A i' as j bs)+}++-- drop++fun drop : [A : Set ] -> Nat # ->+           [j : Size] -> List A j -> List A j+{ drop A zero j l                     = l+; drop A n    j nil                   = nil+; drop A n    j (cons a (j' < j, as)) = drop A (pred # n) j' as+}++-- take for lists is take for colists after embedding++-- fold left++check+fun foldl : [A, B : Set] -> (B -> A -> B) -> B ->+            [i : Size] -> List A i -> B+{ foldl A B f acc i nil = acc+; foldl A B f acc i (cons a (j, as)) = foldl A B f (f acc a) j as+}++-- fold left from fold right++let foldl' : [A : Set] -> [B : Set] -> (B -> A -> B) ->+  [i : Size] -> List A i -> B -> B+  = \ A B f -> foldr A (\ i -> B -> B)+      (\ i a j r acc -> r (f acc a))+      (\ i acc -> acc)++let foldl : [A : Set] -> [B : Set] -> (B -> A -> B) -> B ->+  [i : Size] -> List A i -> B+  = \ A B f b i l -> foldl' A B f i l b++-- reverse++let revApp [A : Set] (as : List A #) (bs : List A #) : List A #+  = foldl A (List A #) (\ as a -> consL A # a as) bs # as++let reverse [A : Set] (as : List A #) : List A #+  = revApp A as nil+
+ lib/nat.ma view
@@ -0,0 +1,115 @@+-- nat.ma++-- Natural numbers++cofun Nat : +Size -> Set+{ Nat i = Maybe ([j < i] & Nat j)+}+pattern zero  = nothing+pattern suc n = just n++let succ [i : Size] (n : Nat i) : Nat $i = suc (i, n)++let oneN   : Nat 1 = suc (0, zero)+let twoN   : Nat 2 = suc (1, oneN)+let threeN : Nat 3 = suc (2, twoN)+let fourN  : Nat 4 = suc (3, threeN)++fun caseNat : [i : Size] -> |i| -> (n : Nat $i) -> +  [C : Set] -> C -> ([i : Size] -> (m : Nat i) -> C) -> C+{ caseNat i zero          C z s = z+; caseNat i (suc (i', n)) C z s = s i' n+}++{- ERROR in TypeChecker!+fun caseNat : [i : Size] -> |i| -> (n : Nat $i) -> +  [C : [j : Size] -> Nat j -> Set] ->+  C 0 zero ->+  ([i : Size] -> (m : Nat i) -> C i m) ->+  C $i n+{ caseNat i zero          C z s = z+; caseNat i (suc (i', n)) C z s = s i' n+}+-}++fun iterNat : [A : Set](f : A -> A)(a : A)[i : Size](n : Nat i) -> A+{ iterNat A f a i zero          = a+; iterNat A f a i (suc (i', n)) = iterNat A f (f a) i' n+}++fun pred : [i : Size] -> (n : Nat $i) -> Nat i+{ pred i zero = zero+; pred i (suc (j, n)) = n+}++fun plus : [i : Size] -> |i| -> (n : Nat i) -> +           [j : Size] ->        (m : Nat j) -> Nat (i+j)+{ plus i zero          j m = m+; plus i (suc (i', n)) j m = suc (i'+j, plus i' n j m)+}++fun times : [i : Size] -> |i| -> (n : Nat i) -> (m : Nat #) -> Nat #+{ times i zero m = zero+; times i (suc (i', n)) m = plus # m # (times i' n m)+}++fun minus : [i : Size] ->        (n : Nat i) -> +            [j : Size] -> |j| -> (m : Nat j) -> Nat i+{ minus i zero          j m             = zero+; minus i n             j zero          = n+; minus i (suc (i', n)) j (suc (j', m)) = minus i' n j' m+}++-- computes ceil(n/(m+1))+fun div' : [i : Size] -> |i| -> (n : Nat i) -> (m : Nat #) -> Nat i+{ div' i zero          m = zero+; div' i (suc (i', n)) m = suc (i', div' i' (minus i' n # m) m)+}++-- computes floor(n/m) if m>0, and 0 otherwise+check  -- Alternative definition +  let div [i : Size] (n : Nat i) (m : Nat #) : Nat i+    = caseNat # m (Nat i) +        zero +        (\ oo pred_m -> div' i (minus i n # pred_m) pred_m)++check  -- Alternative definition +  fun div : [i : Size] -> (n : Nat i) -> (m : Nat #) -> Nat i+  { div i n zero = zero+  ; div i n m    = div' i (minus i n # (pred # m)) (pred # m)+  }++-- computes floor(n/m) if m>0, and 0 otherwise+fun div : [i : Size] -> (n : Nat i) -> (m : Nat #) -> Nat i+{ div i n zero          = zero+; div i n (suc (j, m')) = div' i (minus i n # m') m'+}++-- Comparing natural numbers++let Compare +(i, j : Size) = Tri (Nat i) Unit (Nat j)+pattern greater n = first n+pattern equal     = second unit+pattern less m    = third m++-- compares two numbers and returns the difference+fun compare : [i : Size] -> |i| -> (n : Nat i) ->+              [j : Size] ->        (m : Nat j) -> Compare i j+{ compare i zero          j zero          = equal+; compare i n             j zero          = greater n+; compare i zero          j m             = less m+; compare i (suc (i', n)) j (suc (j', m)) = compare i' n j' m+}++-- greatest common divisor+fun gcd : [i : Size] -> (n : Nat i) ->+          [j : Size] -> (m : Nat j) -> |i,j| -> Nat (max i j)+{ gcd i zero          j m             = m+; gcd i n             j zero          = n+; gcd i (suc (i', n)) j (suc (j', m)) = case compare i' n j' m+  { (equal)      -> suc (i', n)+  ; (greater n') -> gcd i' n' j (suc (j', m))+  ; (less m')    -> gcd i (suc (i', n)) j' m'+  }+}+
+ lib/stl.ma view
@@ -0,0 +1,131 @@+-- stl.ma  Simply Typed Lambda calculus, implemented with de Bruijn indices++-- Types are unlabeled binary trees++let Ty = BinTree Unit+pattern base = leaf+pattern arrow a b = node a unit b++let arr [i : Size] (a, b : Ty i) : Ty $i+  = arrow (i, a) (i, b)++-- Contexts are lists of types+let Context = List (Ty #)++let extend [i : Size] (a : Ty #) (cxt : Context i) : Context $i+  = consL (Ty #) i a cxt++-- Well-typed variables++fun Var : [i : Size] -> |i| -> (cxt : Context i) -> ^(c : Ty #) -> Set+{ Var i nil               c = Empty+; Var i (cons a (j, cxt)) c = Either (Id (Ty #) a c) (Var j cxt c)+} ++-- Variables are a variant of natural numbers+pattern vzero   = left refl+pattern vsucc x = right x++let vzer (cxt : Context #) (a : Ty #) : Var # (extend # a cxt) a +  = vzero++let vsuc (cxt : Context #) (a, b : Ty #) (x : Var # cxt a) +  : Var # (extend # b cxt) a+  = vsucc x++-- Well-typed terms++cofun Term :  +(i : Size) -> (cxt : Context #) -> (c : Ty #) -> Set+{ Term i cxt c = +    let ++T (cxt : Context #) (c : Ty #) = [j < i] & Term j cxt c +    in  Tri (Var # cxt c)                              -- var+            ((a : Ty #) & T cxt (arr # a c) & T cxt a) -- app+            (case c                                    -- abs+             { (base)                -> Empty+             ; (arrow (j, a) (k, b)) -> T (extend # a cxt) b +             })+}+pattern var x     = first x+pattern app a t u = second (a, t, u)+pattern abs t     = third t++-- Example terms++pattern v0 = vzero+pattern v1 = vsucc v0+pattern v2 = vsucc v1+pattern v3 = vsucc v2++pattern var0 = var v0+pattern var1 = var v1+pattern var2 = var v2+pattern var3 = var v3++let tyId : Ty # = arr # base base+let tmId : Term # nil tyId = abs (0, var0) ++let tyK : Ty # = arr # base tyId+let tmK : Term # nil tyK = abs (1, abs (0, var1))++let tyS : Ty # = arr # tyK (arr # tyId tyId)+let tmS : Term # nil tyS = abs (4, abs (3, abs (2, app base+  (1, app base (0, var2) (0, var0)) +  (1, app base (0, var1) (0, var0)))))++-- Renamings++let Renaming (gamma, delta : Context #)+  = (a : Ty #) -> Var # delta a -> Var # gamma a++check+fun liftRen : (gamma, delta : Context #) -> (c : Ty #) -> +  (rho : Renaming gamma delta) -> Renaming (extend # c gamma) (extend # c delta)+{ liftRen gamma delta c rho .c vzero    = vzero+; liftRen gamma delta c rho a (vsucc x) = vsucc (rho a x) +}++let liftRen (gamma, delta : Context #) (c : Ty #) (rho : Renaming gamma delta) +  : Renaming (extend # c gamma) (extend # c delta)+  = \ a y -> case y+    { (left p)  -> left p+    ; (right x) -> right (rho a x)+    }++fun rename : (gamma, delta : Context #) -> (c : Ty #) -> +  [i : Size] -> Term i delta c -> Renaming gamma delta -> Term i gamma c+{ rename gamma delta c i (var x)             rho = var (rho c x)+; rename gamma delta c i (app a (j,t) (k,u)) rho = +    app a (j, rename gamma delta (arr # a c) j t rho)+          (k, rename gamma delta  a          k u rho)+; rename gamma delta base                  i (abs ())    rho +; rename gamma delta (arrow (k1,a) (k2,b)) i (abs (j,t)) rho = +    abs (j, rename (extend # a gamma) (extend # a delta) b j t +              (liftRen gamma delta a rho))+}++-- Substitutions++let Substitution +(i : Size) (gamma, delta : Context #)+  = (a : Ty #) -> Var # delta a -> Term i gamma a++let liftSubst (gamma, delta : Context #) (c : Ty #) +      [i : Size] (sigma : Substitution i gamma delta) +  : Substitution i (extend # c gamma) (extend # c delta)+  = \ a y -> case y+    { (left p)  -> var (left p)+    ; (right x) -> rename (extend # c gamma) gamma a i +                     (sigma a x) (\ b x -> vsucc x)+    }++fun substitute : (gamma, delta : Context #) -> (c : Ty #) -> +  [i : Size] -> |i| -> Term i delta c -> +  [j : Size] -> Substitution j gamma delta -> Term (i+j) gamma c+{ substitute gamma delta c i (var x) j sigma = sigma c x+; substitute gamma delta c i (app a (i1, t) (i2, u)) j sigma =+    app a (i1+j, substitute gamma delta (arr # a c) i1 t j sigma)+          (i2+j, substitute gamma delta a           i2 u j sigma)+; substitute gamma delta base                    i (abs ())      j sigma +; substitute gamma delta (arrow (k1, a) (k2, b)) i (abs (i', t)) j sigma =+    abs (i' + j, substitute (extend # a gamma) (extend # a delta) b i' t j +                   (liftSubst gamma delta a j sigma))+}
+ test/fail/AccCoqTermination.err view
@@ -0,0 +1,49 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "AccCoqTermination.ma" ---+--- scope checking ---+--- type checking ---+type  Acc : ^(A : Set) -> ^(Lt : A -> A -> Set) -> ^ A -> Set+term  Acc.acc : .[A : Set] -> .[Lt : A -> A -> Set] -> .[b : A] -> ^(y1 : (a : A) -> Lt a b -> Acc A Lt a) -> < Acc.acc b y1 : Acc A Lt b >+type  Nat : Set+term  Nat.zero : < Nat.zero : Nat >+term  Nat.succ : ^(y0 : Nat) -> < Nat.succ y0 : Nat >+type  R : ^ Nat -> ^ Nat -> Set+term  R.r1 : .[x : Nat] -> < R.r1 x : R (Nat.succ (Nat.succ x)) (Nat.succ Nat.zero) >+term  R.r2 : < R.r2 : R (Nat.succ Nat.zero) Nat.zero >+term  acc2 : (n : Nat) -> Acc Nat R (Nat.succ (Nat.succ n))+term  acc2 = \ n -> Acc.acc [Nat.succ (Nat.succ n)] (\ a -> \ p -> case p : R a (Nat.succ (Nat.succ n))+                                                      {})+term  aux1 : (a : Nat) -> (p : R a (Nat.succ Nat.zero)) -> Acc Nat R a+{ aux1 (Nat.succ (Nat.succ x)) (R.r1 [.x]) = acc2 x+}+term  acc1 : Acc Nat R (Nat.succ Nat.zero)+term  acc1 = Acc.acc [Nat.succ Nat.zero] aux1+term  aux0 : (a : Nat) -> (p : R a Nat.zero) -> Acc Nat R a+{ aux0 .(succ zero) R.r2 = acc1+}+term  acc0 : Acc Nat R Nat.zero+term  acc0 = Acc.acc [Nat.zero] aux0+term  accR : (n : Nat) -> Acc Nat R n+{ accR Nat.zero = acc0+; accR (Nat.succ Nat.zero) = acc1+; accR (Nat.succ (Nat.succ n)) = acc2 n+}+term  acc_dest : (n : Nat) -> (p : Acc Nat R n) -> (m : Nat) -> R m n -> Acc Nat R m+{ acc_dest .n (Acc.acc [n] p) = p+}+term  f : (x : Nat) -> Acc Nat R x -> Nat+{ f x (Acc.acc [.x] p) = case x : Nat+                         { Nat.zero -> f (Nat.succ x) (p (Nat.succ x) R.r2)+                         ; Nat.succ Nat.zero -> f (Nat.succ x) (p (Nat.succ x) (R.r1 [Nat.zero]))+                         ; Nat.succ (Nat.succ y) -> Nat.zero+                         }+}+term  g : (x : Nat) -> .[Acc Nat R x] -> Nat+{ g x [p] = case x : Nat+            { Nat.zero -> g (Nat.succ x) [acc_dest Nat.zero p (Nat.succ x) R.r2]+            ; Nat.succ Nat.zero -> g (Nat.succ x) [acc_dest (Nat.succ Nat.zero) p (Nat.succ x) (R.r1 [Nat.zero])]+            ; Nat.succ (Nat.succ y) -> Nat.zero+            }+}+error during typechecking:+Termination check for function g fails
+ test/fail/AccCoqTermination.ma view
@@ -0,0 +1,90 @@+{-+-- to debug make test/fail+fun f : (A : Set) -> A+{ f A = f A+}+-}++data Acc ( A : Set) ( Lt : A -> A -> Set) : A -> Set+{+  acc :  (b : A) ->+        ((a : A) -> Lt a b -> Acc A Lt a) +        -> Acc A Lt b+} ++data Nat : Set  +{+	zero : Nat ;+	succ : Nat -> Nat+}++{- R (S x) x  if x < 2+ -} +data R : Nat -> Nat -> Set+{ r1 : (x : Nat) -> R (succ (succ x)) (succ zero)+; r2 : R (succ zero) zero +} ++{-+fun succR : (n : Nat) -> R (succ n) n+{ succR zero = r2+; succR (succ n) = +-}++let acc2 : (n : Nat) -> Acc Nat R (succ (succ n))+  = \ n -> acc (succ (succ n)) (\ a -> \ p -> case p {})++fun aux1 : (a : Nat) -> (p : R a (succ zero)) -> Acc Nat R a+{ aux1 (succ (succ x)) (r1 .x) = acc2 x+}+-- 2010-09-20 here I would like to have internally+-- externally, there should be no dot patterns!+-- aux1 (.succ (.succ x)) (r1 .x) = acc2 x++let acc1 : Acc Nat R (succ zero)+  = acc (succ zero) aux1++fun aux0 : (a : Nat) -> (p : R a zero) -> Acc Nat R a+{ aux0 .(succ zero) r2 = acc1+}++let acc0 : Acc Nat R zero+  = acc zero aux0+ +fun accR : (n : Nat) -> Acc Nat R n+{ accR zero = acc0+; accR (succ zero) = acc1+; accR (succ (succ n)) = acc2 n   +}++fun acc_dest : (n : Nat) -> (p : Acc Nat R n) -> +               (m : Nat) -> R m n -> Acc Nat R m+{ acc_dest .n (acc n p) = p+}++fun f : (x : Nat) -> Acc Nat R x -> Nat +{ f x (acc .x p) = case x+  { zero -> f (succ x) (p (succ x) r2)+  ; (succ zero) -> f (succ x) (p (succ x) (r1 zero))+  ; (succ (succ y)) -> zero+  }+}++-- In Coq, g and h are accepted by the termination checker+fun g : (x : Nat) -> [Acc Nat R x] -> Nat +{ g x p = case x+  { zero -> g (succ x) (acc_dest zero p (succ x) r2)+  ; (succ zero) -> g (succ x) (acc_dest (succ zero) p (succ x) (r1 zero))+  ; (succ (succ y)) -> zero+  }+}+-- MiniAgda refuses g and h++fun h : (x : Nat) -> [Acc Nat R x] -> Nat +{ h zero p = h (succ zero) (acc_dest zero p (succ zero) r2)+; h (succ zero) p = h (succ (succ zero)) (acc_dest (succ zero) p (succ (succ zero)) (r1 zero))+; h (succ (succ y)) p = zero+}++eval let bla : Nat+  = f zero acc0
+ test/fail/AccImplicit.err view
@@ -0,0 +1,63 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "AccImplicit.ma" ---+--- scope checking ---+--- type checking ---+type  Acc : ^(A : Set) -> ^(Lt : A -> A -> Set) -> (b : A) -> Set+term  Acc.acc : .[A : Set] -> .[Lt : A -> A -> Set] -> .[b : A] -> ^(accOut : (a : A) -> Lt a b -> Acc A Lt a) -> < Acc.acc accOut : Acc A Lt b >+term  accOut : .[A : Set] -> .[Lt : A -> A -> Set] -> (b : A) -> (acc : Acc A Lt b) -> (a : A) -> Lt a b -> Acc A Lt a+{ accOut [A] [Lt] b (Acc.acc #accOut) = #accOut+}+type  Nat : Set+term  Nat.zero : < Nat.zero : Nat >+term  Nat.succ : ^(y0 : Nat) -> < Nat.succ y0 : Nat >+type  R : ^ Nat -> ^ Nat -> Set+term  R.r1 : .[x : Nat] -> < R.r1 x : R (Nat.succ (Nat.succ x)) (Nat.succ Nat.zero) >+term  R.r2 : < R.r2 : R (Nat.succ Nat.zero) Nat.zero >+term  acc2 : (n : Nat) -> Acc Nat R (Nat.succ (Nat.succ n))+term  acc2 = \ n -> Acc.acc (\ a -> \ p -> case p : R a (Nat.succ (Nat.succ n))+                              {})+term  aux1 : (a : Nat) -> (p : R a (Nat.succ Nat.zero)) -> Acc Nat R a+{ aux1 (Nat.succ (Nat.succ x)) (R.r1 [.x]) = acc2 x+}+term  acc1 : Acc Nat R (Nat.succ Nat.zero)+term  acc1 = Acc.acc aux1+term  aux0 : (a : Nat) -> (p : R a Nat.zero) -> Acc Nat R a+{ aux0 .(succ zero) R.r2 = acc1+}+term  acc0 : Acc Nat R Nat.zero+term  acc0 = Acc.acc aux0+term  accR : (n : Nat) -> Acc Nat R n+{ accR Nat.zero = acc0+; accR (Nat.succ Nat.zero) = acc1+; accR (Nat.succ (Nat.succ n)) = acc2 n+}+term  acc_dest : .[n : Nat] -> (p : Acc Nat R n) -> (m : Nat) -> R m n -> Acc Nat R m+{ acc_dest [n] (Acc.acc p) = p+}+term  f : (x : Nat) -> Acc Nat R x -> Nat+{ f x (Acc.acc p) = case x : Nat+                    { Nat.zero -> f (Nat.succ x) (p (Nat.succ x) R.r2)+                    ; Nat.succ Nat.zero -> f (Nat.succ x) (p (Nat.succ x) (R.r1 [Nat.zero]))+                    ; Nat.succ (Nat.succ y) -> Nat.zero+                    }+}+term  h : (x : Nat) -> .[Acc Nat R x] -> Nat+{ h Nat.zero [Acc.acc [p]] = h (Nat.succ Nat.zero) [p (Nat.succ Nat.zero) R.r2]+; h (Nat.succ Nat.zero) [Acc.acc [p]] = h (Nat.succ (Nat.succ Nat.zero)) [p (Nat.succ (Nat.succ Nat.zero)) (R.r1 [Nat.zero])]+; h (Nat.succ (Nat.succ y)) [p] = Nat.zero+}+term  bla : Nat+term  bla = f Nat.zero acc0+type  Id : ^(A : Set) -> ^(a : A) -> ^ A -> Set+term  Id.refl : .[A : Set] -> .[a : A] -> < Id.refl : Id A a a >+error during typechecking:+p1+/// checkExpr 0 |- \ p -> refl : (p : Acc Nat R Nat.zero) -> Id Nat (h Nat.zero [p]) (h Nat.zero [acc0])+/// checkForced fromList [] |- \ p -> refl : (p : Acc Nat R Nat.zero) -> Id Nat (h Nat.zero [p]) (h Nat.zero [acc0])+/// new p : (Acc Nat R Nat.zero)+/// checkExpr 1 |- refl : Id Nat (h Nat.zero [p]) (h Nat.zero [acc0])+/// checkForced fromList [(p,0)] |- refl : Id Nat (h Nat.zero [p]) (h Nat.zero [acc0])+/// leqVal' (subtyping)  < Id.refl : Id Nat (h Nat.zero [p]) (h Nat.zero [p]) >  <=+  Id Nat (h Nat.zero [p]) (h Nat.zero [acc0])+/// leqVal' (subtyping)  Id Nat (h Nat.zero [p]) (h Nat.zero [p])  <=+  Id Nat (h Nat.zero [p]) (h Nat.zero [acc0])+/// leqVal'  h Nat.zero p  <=^  Nat.zero : Nat+/// leqApp: head mismatch h != Nat.zero
+ test/fail/AccImplicit.ma view
@@ -0,0 +1,98 @@+data Acc ( A : Set) (Lt : A -> A -> Set) *(b : A) : Set+{ acc :  (accOut : (a : A) -> Lt a b -> Acc A Lt a) -> Acc A Lt b+} ++data Nat : Set  +{ zero : Nat +; succ : Nat -> Nat+}++{- R (S x) x  if x < 2+ -} +data R : Nat -> Nat -> Set+{ r1 : (x : Nat) -> R (succ (succ x)) (succ zero)+; r2 : R (succ zero) zero +} ++{-+fun succR : (n : Nat) -> R (succ n) n+{ succR zero = r2+; succR (succ n) = +-}++let acc2 : (n : Nat) -> Acc Nat R (succ (succ n))+  = \ n -> acc (\ a -> \ p -> case p {})++fun aux1 : (a : Nat) -> (p : R a (succ zero)) -> Acc Nat R a+{ aux1 (succ (succ x)) (r1 .x) = acc2 x+}++let acc1 : Acc Nat R (succ zero)+  = acc aux1++fun aux0 : (a : Nat) -> (p : R a zero) -> Acc Nat R a+{ aux0 .(succ zero) r2 = acc1+}++let acc0 : Acc Nat R zero+  = acc aux0+ +fun accR : (n : Nat) -> Acc Nat R n+{ accR zero = acc0+; accR (succ zero) = acc1+; accR (succ (succ n)) = acc2 n   +}++fun acc_dest : [n : Nat] -> (p : Acc Nat R n) -> +               (m : Nat) -> R m n -> Acc Nat R m+{ acc_dest n (acc p) = p+}++fun f : (x : Nat) -> Acc Nat R x -> Nat +{ f x (acc p) = case x+  { zero -> f (succ x) (p (succ x) r2)+  ; (succ zero) -> f (succ x) (p (succ x) (r1 zero))+  ; (succ (succ y)) -> zero+  }+}++{-+-- In Coq, g and h are accepted by the termination checker+fun g : (x : Nat) -> [Acc Nat R x] -> Nat +{ g x p = case x+  { zero -> g (succ x) (acc_dest zero p (succ x) r2)+  ; (succ zero) -> g (succ x) (acc_dest (succ zero) p (succ x) (r1 zero))+  ; (succ (succ y)) -> zero+  }+}++fun h : (x : Nat) -> [Acc Nat R x] -> Nat +{ h zero p = h (succ zero) (acc_dest zero p (succ zero) r2)+; h (succ zero) p = h (succ (succ zero)) (acc_dest (succ zero) p (succ (succ zero)) (r1 zero))+; h (succ (succ y)) p = zero+}+-}++fun h : (x : Nat) -> [Acc Nat R x] -> Nat +{ h zero (acc p) = h (succ zero) (p (succ zero) r2)+; h (succ zero) (acc p) = h (succ (succ zero)) (p (succ (succ zero)) (r1 zero))+; h (succ (succ y)) p = zero+}+{- The definition of h should be fine since++   q : Acc Nat R zero   iff  q = acc .Nat .R zero p++so the forced match does not refine the type [Acc Nat R x] further.+This means that h can be translated to case trees without any case on q,+it just uses the destructor. -} ++eval let bla : Nat+  = f zero acc0++data Id (A : Set) (a : A) : A -> Set+{ refl : Id A a a+}++let p1 : (p : Acc Nat R zero) -> Id Nat (h zero p) (h zero acc0)+       = \ p -> refl +{- In a case tree representation of h this would type check! -}
+ test/fail/BadConstraint.err view
@@ -0,0 +1,5 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "BadConstraint.ma" ---+--- scope checking ---+scope check error: f+/// |i| < |i|: constraints must follow a quantifier
+ test/fail/BadConstraint.ma view
@@ -0,0 +1,2 @@+-- 2013-03-30 constraints must follow quantifier+fun f : [A : Set] -> [i : Size] -> (|i| < |i| -> A) -> A {}
+ test/fail/BadConstraint1.err view
@@ -0,0 +1,5 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "BadConstraint1.ma" ---+--- scope checking ---+scope check error: f+/// |i| < |i|: constraints must follow a quantifier
+ test/fail/BadConstraint1.ma view
@@ -0,0 +1,2 @@+-- 2013-03-30 constraints must follow quantifier+fun f : [A : Set] -> [i : Size] -> (A -> |i| < |i| -> A) -> A {}
+ test/fail/BadSizeLambda.err view
@@ -0,0 +1,22 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "BadSizeLambda.ma" ---+--- scope checking ---+--- type checking ---+type  Unit : Set+term  Unit.unit : < Unit.unit : Unit >+term  sabotage : .[i : Size] -> (.[j < i] -> Unit) -> Unit+{ sabotage [i] f = Unit.unit+}+term  wtf : .[i : Size] -> Unit+error during typechecking:+wtf+/// clause 1+/// right hand side+/// checkExpr 1 |- sabotage i (\ j -> wtf j) : Unit+/// inferExpr' sabotage i (\ j -> wtf j)+/// checkApp ((.[j < v0] -> Unit{i = v0})::Tm -> {Unit {i = v0}}) eliminated by \ j -> wtf j+/// checkExpr 1 |- \ j -> wtf j : .[j < i] -> Unit+/// checkForced fromList [(i,0)] |- \ j -> wtf j : .[j < i] -> Unit+/// new j < v0+/// adding size rel. v1 + 1 <= v0+/// cannot add hypothesis v1 + 1 <= v0 because it is not satisfyable under all possible valuations of the current hypotheses
+ test/fail/BadSizeLambda.ma view
@@ -0,0 +1,14 @@+-- 2013-03-30 ICFP 2013 paper++data Unit { unit }++-- primitive counterexample++fun sabotage : [i : Size] -> ([j < i] -> Unit) -> Unit+{ sabotage i f = unit+}++-- not strongly normalizing+fun wtf : [i : Size] -> |i| -> Unit+{ wtf i = sabotage i (\ j -> wtf j)+}
+ test/fail/BadSizeLambdaCoinductive.err view
@@ -0,0 +1,27 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "BadSizeLambdaCoinductive.ma" ---+--- scope checking ---+--- type checking ---+type  S : -(i : Size) -> Set+term  S.inn : .[i : Size] -> ^(out : .[j < i] -> S j) -> < S.inn out : S i >+term  out : .[i : Size] -> (inn : S i) -> .[j < i] -> S j+{ out [i] (S.inn #out) = #out+}+term  eta : .[i : Size] -> (.[j < i] -> S $j) -> S i+{ eta [i] f .out [j < i] = f [j] .out [j]+}+term  cons : .[i : Size] -> (s : S i) -> S $i+term  cons = [\ i ->] \ s -> S.inn ([\ j ->] s)+term  inf : .[i : Size] -> S i+error during typechecking:+inf+/// clause 1+/// right hand side+/// checkExpr 1 |- eta i (\ j -> cons j (inf j)) : S i+/// inferExpr' eta i (\ j -> cons j (inf j))+/// checkApp ((.[j < v0] -> S $j{i = v0})::Tm -> {S i {i = v0}}) eliminated by \ j -> cons j (inf j)+/// checkExpr 1 |- \ j -> cons j (inf j) : .[j < i] -> S $j+/// checkForced fromList [(i,0)] |- \ j -> cons j (inf j) : .[j < i] -> S $j+/// new j < v0+/// adding size rel. v1 + 1 <= v0+/// cannot add hypothesis v1 + 1 <= v0 because it is not satisfyable under all possible valuations of the current hypotheses
+ test/fail/BadSizeLambdaCoinductive.ma view
@@ -0,0 +1,18 @@+-- 2013-03-30 illegal size lambda \ j < i in rhs++-- coinductive counterexample++data S -(i : Size) { inn (out : [j < i] -> S j) }+fields out++fun eta : [i : Size] -> ([j < i] -> S $j) -> S i+{ eta i f .out j = f j .out j+}++let cons [i : Size] (s : S i) : S $i+  = inn (\ j -> s)++-- not strongly normalizing:+fun inf : [i : Size] -> |i| -> S i+{ inf i = eta i (\ j -> cons j (inf j))+}
+ test/fail/BadSizeLambdaInductive.err view
@@ -0,0 +1,30 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "BadSizeLambdaInductive.ma" ---+--- scope checking ---+--- type checking ---+type  Unit : Set+term  Unit.unit : < Unit.unit : Unit >+type  Nat : +(i : Size) -> Set+term  Nat.zero : .[i : Size] -> .[j < i] -> < Nat.zero j : Nat i >+term  Nat.suc : .[i : Size] -> .[j < i] -> ^(n : Nat j) -> < Nat.suc j n : Nat i >+term  apply : .[i : Size] -> (.[j < i] -> Nat $j -> Unit) -> Nat i -> Unit+{ apply [i] f (Nat.zero [j < i]) = f [j] (Nat.zero [j])+; apply [i] f (Nat.suc [j < i] x) = f [j] (Nat.suc [j] x)+}+term  caseN : .[i : Size] -> Unit -> (Nat i -> Unit) -> Nat $i -> Unit+{ caseN [i] z s (Nat.zero [j < $i]) = z+; caseN [i] z s (Nat.suc [j < $i] x) = s x+}+term  run : .[i : Size] -> Nat i -> Unit+error during typechecking:+run+/// clause 1+/// right hand side+/// checkExpr 1 |- apply i (\ j -> caseN j unit (run j)) : Nat i -> Unit+/// inferExpr' apply i (\ j -> caseN j unit (run j))+/// checkApp ((.[j < v0] -> Nat $j -> Unit{i = v0})::Tm -> {Nat i -> Unit {i = v0}}) eliminated by \ j -> caseN j unit (run j)+/// checkExpr 1 |- \ j -> caseN j unit (run j) : .[j < i] -> Nat $j -> Unit+/// checkForced fromList [(i,0)] |- \ j -> caseN j unit (run j) : .[j < i] -> Nat $j -> Unit+/// new j < v0+/// adding size rel. v1 + 1 <= v0+/// cannot add hypothesis v1 + 1 <= v0 because it is not satisfyable under all possible valuations of the current hypotheses
+ test/fail/BadSizeLambdaInductive.ma view
@@ -0,0 +1,24 @@+-- 2013-03-30++-- inductive counterexample++data Unit { unit }++data Nat +(i : Size)+{ zero [j < i]+; suc  [j < i] (n : Nat j) }++fun apply : [i : Size] -> ([j < i] -> Nat $j -> Unit) -> Nat i -> Unit+{ apply i f (zero j)  = f j (zero j)+; apply i f (suc j x) = f j (suc j x)+}++fun caseN : [i : Size] -> Unit -> (Nat i -> Unit) -> Nat $i -> Unit+{ caseN i z s (zero j)  = z+; caseN i z s (suc j x) = s x+}++-- not strongly normalizing:+fun run : [i : Size] -> |i| -> Nat i -> Unit+{ run i = apply i (\ j -> caseN j unit (run j))+}
+ test/fail/BigDataInSet0.err view
@@ -0,0 +1,18 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "BigDataInSet0.ma" ---+--- scope checking ---+--- type checking ---+ty-u  BigOk : Set 1+term  BigOk.bigOk : ^(y0 : Set) -> < BigOk.bigOk y0 : BigOk >+type  BigIrr : Set+term  BigIrr.bigIrr : .[y0 : Set] -> < BigIrr.bigIrr y0 : BigIrr >+type  Big : Set+error during typechecking:+Big+/// constructor Big.big+/// new Big : Set+/// inferExpr' ^ Set -> Big+/// new  : Set+/// leSize 1 <=+ 0+/// leSize' 1 <= 0+/// leSize': 1 <= 0 failed
+ test/fail/BigDataInSet0.ma view
@@ -0,0 +1,15 @@+-- 2010-09-20++data BigOk : Set 1+{ bigOk : Set 0 -> BigOk+}++-- 2012-10-10 suceeds, because of irrelevance+data BigIrr : Set+{ bigIrr : .Set -> BigIrr+}++data Big : Set 0+{ big : Set 0 -> Big+}+-- needs to fail, constructor lives in Set 1
+ test/fail/BoundedFake.err view
@@ -0,0 +1,15 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "BoundedFake.ma" ---+--- scope checking ---+--- type checking ---+term  bad : .[i : Size] -> .[j : Size] -> .[A : Set] -> A+error during typechecking:+bad+/// clause 1+/// pattern j < i+/// new j <= #+/// adding size rel. v1 + 1 <= v0+/// leqVal' (subtyping)  Size  <=+  < i+/// leSize # <+ i+/// leSize' # < i+/// leSize: # + 0 < i failed
+ test/fail/BoundedFake.ma view
@@ -0,0 +1,9 @@+-- 2012-01-22++-- need to check that bounds are forced!+fun bad : [i, j : Size] -> [A : Set] -> A+{ bad i (j < i) A = bad j j A+}++let bot : [A : Set] -> A+  = bad # #
+ test/fail/BoundedQStrict.err view
@@ -0,0 +1,29 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "BoundedQStrict.ma" ---+--- scope checking ---+--- type checking ---+type  Nat : + Size -> Set+term  Nat.zero : .[s!ze : Size] -> .[i < s!ze] -> Nat s!ze+term  Nat.zero : .[i : Size] -> < Nat.zero i : Nat $i >+term  Nat.succ : .[s!ze : Size] -> .[i < s!ze] -> ^ Nat i -> Nat s!ze+term  Nat.succ : .[i : Size] -> ^(y1 : Nat i) -> < Nat.succ i y1 : Nat $i >+term  mySucc : .[i : Size] -> .[j : Size] -> |j| < |i| -> Nat j -> Nat i+{ mySucc [i] [j] n = Nat.succ [j] n+}+error during typechecking:+bla+/// checkExpr 0 |- \ i -> \ j -> \ n -> mySucc i j n : .[i : Size] -> .[j : Size] -> |j| <= |i| -> Nat j -> Nat i+/// checkForced fromList [] |- \ i -> \ j -> \ n -> mySucc i j n : .[i : Size] -> .[j : Size] -> |j| <= |i| -> Nat j -> Nat i+/// new i <= #+/// checkExpr 1 |- \ j -> \ n -> mySucc i j n : .[j : Size] -> |j| <= |i| -> Nat j -> Nat i+/// checkForced fromList [(i,0)] |- \ j -> \ n -> mySucc i j n : .[j : Size] -> |j| <= |i| -> Nat j -> Nat i+/// new j <= #+/// checkExpr 2 |- \ n -> mySucc i j n : |j| <= |i| -> Nat j -> Nat i+/// adding size rel. v1 + 0 <= v0+/// checkExpr 2 |- \ n -> mySucc i j n : Nat j -> Nat i+/// checkForced fromList [(j,1),(i,0)] |- \ n -> mySucc i j n : Nat j -> Nat i+/// new n : (Nat v1)+/// checkExpr 3 |- mySucc i j n : Nat i+/// inferExpr' mySucc i j n+/// checkGuard |j| < |i|+/// lexSizes: no descent detected
+ test/fail/BoundedQStrict.ma view
@@ -0,0 +1,21 @@+-- 2010-11-12++{-  another way to look at sized types:++sized data Nat (i : Size) : Set+{ zero : Nat i+; succ : [j : Size] -> |j| < |i| -> Nat j -> Nat i+}++-}+sized data Nat : Size -> Set+{ zero : [i : Size] -> Nat $i+; succ : [i : Size] -> Nat i -> Nat $i+}++fun mySucc : [i : Size] -> [j : Size] -> |j| < |i| -> Nat j -> Nat i+{ mySucc i j n = succ j n }++let bla : [i : Size] -> [j : Size] -> |j| <= |i| -> Nat j -> Nat i+  = \ i j n -> mySucc i j n+-- needs to fail
+ test/fail/BoundedQWrong.err view
@@ -0,0 +1,42 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "BoundedQWrong.ma" ---+--- scope checking ---+--- type checking ---+type  Nat : + Size -> Set+term  Nat.zero : .[s!ze : Size] -> .[i < s!ze] -> Nat s!ze+term  Nat.zero : .[i : Size] -> < Nat.zero i : Nat $i >+term  Nat.succ : .[s!ze : Size] -> .[i < s!ze] -> ^ Nat i -> Nat s!ze+term  Nat.succ : .[i : Size] -> ^(y1 : Nat i) -> < Nat.succ i y1 : Nat $i >+term  mySucc : .[i : Size] -> .[j < i] -> Nat i -> Nat j+block fails as expected, error message:+mySucc+/// clause 1+/// right hand side+/// checkExpr 3 |- succ j n : Nat j+/// checkForced fromList [(j,1),(i,0),(n,2)] |- succ j n : Nat j+/// checkApp (^(y1 : (Nat v1)::()) -> < Nat.succ i y1 : Nat $i >{i = v1}) eliminated by n+/// leqVal' (subtyping)  < n : Nat i >  <=+  Nat j+/// leqVal' (subtyping)  Nat i  <=+  Nat j+/// leqVal'  i  <=+  j : Size+/// leSize i <=+ j+/// leSize' i <= j+/// bound not entailed+error during typechecking:+explicitCast+/// checkExpr 0 |- \ i -> \ j -> \ n -> n : .[i : Size] -> .[j <= i] -> Nat i -> Nat j+/// checkForced fromList [] |- \ i -> \ j -> \ n -> n : .[i : Size] -> .[j <= i] -> Nat i -> Nat j+/// new i <= #+/// checkExpr 1 |- \ j -> \ n -> n : .[j <= i] -> Nat i -> Nat j+/// checkForced fromList [(i,0)] |- \ j -> \ n -> n : .[j <= i] -> Nat i -> Nat j+/// new j <= v0+/// adding size rel. v1 + 0 <= v0+/// checkExpr 2 |- \ n -> n : Nat i -> Nat j+/// checkForced fromList [(j,1),(i,0)] |- \ n -> n : Nat i -> Nat j+/// new n : (Nat v0)+/// checkExpr 3 |- n : Nat j+/// leqVal' (subtyping)  < n : Nat i >  <=+  Nat j+/// leqVal' (subtyping)  Nat i  <=+  Nat j+/// leqVal'  i  <=+  j : Size+/// leSize i <=+ j+/// leSize' i <= j+/// bound not entailed
+ test/fail/BoundedQWrong.ma view
@@ -0,0 +1,21 @@+-- 2010-11-12++{-  another way to look at sized types:++sized data Nat (i : Size) : Set+{ zero : Nat i+; succ : [j : Size] -> |j| < |i| -> Nat j -> Nat i+}++-}+sized data Nat : Size -> Set+{ zero : [i : Size] -> Nat $i+; succ : [i : Size] -> Nat i -> Nat $i+}++fail+fun mySucc : [i : Size] -> [j < i] -> Nat i -> Nat j+{ mySucc i j n = succ j n }++let explicitCast : [i : Size] -> [j <= i] -> Nat i -> Nat j+  = \ i j n -> n
+ test/fail/BoxNeg.err view
@@ -0,0 +1,11 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "BoxNeg.ma" ---+--- scope checking ---+--- type checking ---+type  Box : ^(A : Set) -> Set+term  Box.box : .[A : Set] -> ^(y0 : A) -> < Box.box y0 : Box A >+type  Neg : Set+term  Neg.neg : ^(y0 : Box Neg -> Neg) -> < Neg.neg y0 : Neg >+error during typechecking:+checking positivity+/// polarity check ++ <= ^ failed
+ test/fail/BoxNeg.ma view
@@ -0,0 +1,9 @@+-- 2010-06-11, Nisse++data Box (A : Set) : Set+{ box : A -> Box A+}++data Neg : Set+{ neg : (Box Neg -> Neg) -> Neg+}
+ test/fail/CheatSubtypingPos.err view
@@ -0,0 +1,12 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "CheatSubtypingPos.ma" ---+--- scope checking ---+--- type checking ---+error during typechecking:+MakePos+/// checkExpr 0 |- \ F -> F : (- Set -> Set) -> + Set -> Set+/// checkForced fromList [] |- \ F -> F : (- Set -> Set) -> + Set -> Set+/// new F : (-Set -> Set)+/// checkExpr 1 |- F : + Set -> Set+/// leqVal' (subtyping)  -(xSing# : Set) -> < F xSing# : Set >  <=+  + Set -> Set+/// subtyping -(xSing# : Set) -> < F xSing# : Set >  <=+  + Set -> Set failed
+ test/fail/CheatSubtypingPos.ma view
@@ -0,0 +1,3 @@+-- 2010-07-11++let MakePos : (-Set -> Set) -> (+Set -> Set) = \ F -> F
+ test/fail/CoNotLowerSemi.err view
@@ -0,0 +1,27 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "CoNotLowerSemi.ma" ---+--- scope checking ---+--- type checking ---+type  Nat : +(i : Size) -> Set+term  Nat.zero : .[i : Size] -> < Nat.zero : Nat i >+term  Nat.suc : .[i : Size] -> ^(jn : .[j < i] & Nat j) -> < Nat.suc jn : Nat i >+type  Stream : ++(A : Set) -> -(i : Size) -> Set+term  Stream.cons : .[A : Set] -> .[i : Size] -> ^(head : A) -> ^(tail : .[j < i] -> Stream A j) -> < Stream.cons head tail : Stream A i >+term  head : .[A : Set] -> .[i : Size] -> (cons : Stream A i) -> A+{ head [A] [i] (Stream.cons #head #tail) = #head+}+term  tail : .[A : Set] -> .[i : Size] -> (cons : Stream A i) -> .[j < i] -> Stream A j+{ tail [A] [i] (Stream.cons #head #tail) = #tail+}+term  repeat : .[A : Set] -> (a : A) -> .[i : Size] -> Stream A i+{ repeat [A] a [i] = Stream.cons a ([\ j ->] repeat [A] a [j])+}+error during typechecking:+lsc+/// new s : (Stream (Nat #) #)+/// checkExpr 1 |- (# , s) : .[j < #] & Stream (Nat j) #+/// checkForced fromList [(s,0)] |- (# , s) : .[j < #] & Stream (Nat j) #+/// checkExpr 1 |- # : < #+/// leqVal' (subtyping)  < # : Size >  <=+  < #+/// leSize # <+ #+/// leSize: # < # failed
+ test/fail/CoNotLowerSemi.ma view
@@ -0,0 +1,17 @@+data Nat +(i : Size)+{ zero+; suc (jn : [j < i] & Nat j)+}++data Stream ++(A : Set) -(i : Size)+{ cons (head : A) (tail : [j < i] -> Stream A j)+}++cofun repeat : [A : Set] (a : A) [i : Size] |i| -> Stream A i+{ repeat A a i = cons a (\ j -> repeat A a j)+}++-- infinite tuples not lsc++let lsc (s : Stream (Nat #) #) : [j < #] & Stream (Nat j) #+  = (#, s)
+ test/fail/CoNotLowerSemi1.err view
@@ -0,0 +1,24 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "CoNotLowerSemi1.ma" ---+--- scope checking ---+--- type checking ---+type  Nat : +(i : Size) -> Set+term  Nat.zero : .[i : Size] -> < Nat.zero : Nat i >+term  Nat.suc : .[i : Size] -> ^(jn : .[j < i] & Nat j) -> < Nat.suc jn : Nat i >+type  Stream : ++(A : Set) -> Set+term  Stream.cons : .[A : Set] -> ^(head : A) -> ^(tail : Stream A) -> < Stream.cons head tail : Stream A >+term  head : .[A : Set] -> (cons : Stream A) -> A+{ head [A] (Stream.cons #head #tail) = #head+}+term  tail : .[A : Set] -> (cons : Stream A) -> Stream A+{ tail [A] (Stream.cons #head #tail) = #tail+}+error during typechecking:+lsc+/// new s : (Stream (Nat #))+/// checkExpr 1 |- (# , s) : .[j < #] & Stream (Nat j)+/// checkForced fromList [(s,0)] |- (# , s) : .[j < #] & Stream (Nat j)+/// checkExpr 1 |- # : < #+/// leqVal' (subtyping)  < # : Size >  <=+  < #+/// leSize # <+ #+/// leSize: # < # failed
+ test/fail/CoNotLowerSemi1.ma view
@@ -0,0 +1,19 @@+data Nat +(i : Size)+{ zero+; suc (jn : [j < i] & Nat j)+}++codata Stream ++(A : Set)+{ cons (head : A) (tail : Stream A)+}++-- infinite tuples not lsc++let lsc (s : Stream (Nat #)) : [j < #] & Stream (Nat j)+  = (#, s)++{-+cofun repeat : [A : Set] (a : A) [i : Size] |i| -> Stream A i+{ repeat A a i = cons a (\ j -> repeat A a j)+}+-}
+ test/fail/ConorMcBrideCalco09inflationary.err view
@@ -0,0 +1,20 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "ConorMcBrideCalco09inflationary.ma" ---+--- scope checking ---+--- type checking ---+type  Map : (F : Set -> Set) -> Set (max 1)+type  Map = \ F -> .[A : Set] -> .[B : Set] -> (A -> B) -> F A -> F B+type  Nu : (F : + Set -> Set) -> -(i : Size) -> Set+{ Nu F i = .[j < i] -> F (Nu F j)+}+error during typechecking:+out+/// new F : (+Set -> Set)+/// new i <= #+/// new r : (Nu (v0 Up (+Set -> Set)) {$i {i = v1, F = (v0 Up (+Set -> Set))}})+/// checkExpr 3 |- r i : F (Nu F i)+/// inferExpr' r i+/// leqVal' (subtyping) [(i,1),(F,0),(r,2)] |- < i : <= # >  <=+  < $i+/// leSize v1 <+ ($ v1)+/// leSize' v1 < ($ v1)+/// leSize'': i + -1 < i failed
+ test/fail/D.err view
@@ -0,0 +1,29 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "D.ma" ---+--- scope checking ---+--- type checking ---+type  D : Set+term  D.abs : ^(y0 : ^ D -> D) -> < D.abs y0 : D >+warning: ignoring error: polarity check ++ <= - failed+warning: ignoring error: polarity check ++ <= + failed+term  app : D -> ^ D -> D+{ app (D.abs f) d = f d+}+term  sapp : D -> D+{ sapp x = app x x+}+error during typechecking:+delta+/// checkExpr 0 |- abs (\ x -> sapp x) : D+/// checkForced fromList [] |- abs (\ x -> sapp x) : D+/// checkApp (^(y0 : (^D::() -> D)::()) -> < D.abs y0 : D >) eliminated by \ x -> sapp x+/// checkExpr 0 |- \ x -> sapp x : ^ D -> D+/// checkForced fromList [] |- \ x -> sapp x : ^ D -> D+/// new x : D+/// checkExpr 1 |- sapp x : D+/// inferExpr' sapp x+/// checkApp (D::Tm -> D) eliminated by x+/// inferExpr' x+/// inferExpr: variable x : D may not occur+/// , because of polarity+/// polarity check ^ <= * failed
+ test/fail/D.ma view
@@ -0,0 +1,19 @@+-- 2010-11-06++-- this might be accepted without trustme in future versions?!+trustme+data D : Set +{ abs : ^(^D -> D) -> D+}++fun app : D -> ^D -> D+{ app (abs f) d = f d+}++fun sapp : D -> D+{ sapp x = app x x+}++-- this needs to fail, since x is not parametric in application!+let delta : D+  = abs (\ x -> sapp x)
+ test/fail/D1.err view
@@ -0,0 +1,14 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "D1.ma" ---+--- scope checking ---+--- type checking ---+type  D : Set+term  D.abs : ^(y0 : ^ D -> D) -> < D.abs y0 : D >+warning: ignoring error: polarity check ++ <= - failed+warning: ignoring error: polarity check ++ <= + failed+term  app : ^ D -> ^ D -> D+error during typechecking:+app+/// clause 1+/// pattern abs f+/// cannot match pattern abs f against non-computational argument
+ test/fail/D1.ma view
@@ -0,0 +1,15 @@+-- 2010-11-06++-- this might be accepted without trustme in future versions?!+trustme+data D : Set +{ abs : (^D -> D) -> D+}++-- this must fail!+fun app : ^D -> ^D -> D  +{ app (abs f) d = f d+}+{- abs must not be characterized as a forced match!+only terminating eta-expansions are forced matches+-}
+ test/fail/DataAtSetInfty.err view
@@ -0,0 +1,7 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "DataAtSetInfty.ma" ---+--- scope checking ---+--- type checking ---+error during typechecking:+U+/// # is not a valid universe level
+ test/fail/DataAtSetInfty.ma view
@@ -0,0 +1,10 @@+-- 2010-09-14++-- this needs to be rejected++data U : Set #+{ inn : [i : Size] -> (out : Set i) -> U+}++let U' : U = inn # U+
+ test/fail/DeepForcedConstructors.err view
@@ -0,0 +1,21 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "DeepForcedConstructors.ma" ---+--- scope checking ---+--- type checking ---+type  Bool : Set+term  Bool.true : < Bool.true : Bool >+term  Bool.false : < Bool.false : Bool >+term  not : Bool -> Bool+{ not Bool.true = Bool.false+; not Bool.false = Bool.true+}+type  Nat : ^ Bool -> Set+term  Nat.zero : < Nat.zero : Nat Bool.true >+term  Nat.succ : ^(b : Bool) -> ^(y1 : Nat b) -> < Nat.succ b y1 : Nat Bool.false >+term  f : (b : Bool) -> .[Nat b] -> Bool+error during typechecking:+f+/// clause 2+/// pattern succ .true zero+/// pattern zero+/// checkPattern: constructor Nat.zero of non-computational argument zero : (Nat .Bool.true{}) not forced
+ test/fail/DeepForcedConstructors.ma view
@@ -0,0 +1,23 @@+-- 2010-01-25+-- 2010-07-08++data Bool : Set+{ true : Bool+; false : Bool+}++fun not : Bool -> Bool+{ not true = false+; not false = true+}++data Nat : Bool -> Set+{ zero : Nat true+; succ : (b : Bool) -> Nat b -> Nat false+}++fun f : (b : Bool) -> [Nat b] -> Bool+{ f true zero = true+; f false (succ .true zero) = false+}+-- should not type check, since match "zero" inside (succ ...) is not forced
+ test/fail/DescendAscend.err view
@@ -0,0 +1,17 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "DescendAscend.ma" ---+--- scope checking ---+--- type checking ---+type  Nat : Set+term  Nat.zero : < Nat.zero : Nat >+term  Nat.succ : ^(y0 : Nat) -> < Nat.succ y0 : Nat >+term  plus : Nat -> Nat -> Nat+{}+term  f : Nat -> Nat+term  g : Nat -> Nat -> Nat+{ f (Nat.succ (Nat.succ (Nat.succ n))) = g n n+}+{ g (Nat.succ n) m = plus (g n (Nat.succ m)) (f m)+}+error during typechecking:+Termination check for mutual block [f,g] fails for [f,g]
+ test/fail/DescendAscend.ma view
@@ -0,0 +1,17 @@+data Nat : Set+{ zero : Nat+; succ : Nat -> Nat+}++fun plus : Nat -> Nat -> Nat {}++mutual {++  fun f : Nat -> Nat+  { f (succ (succ (succ n))) = g n n+  }++  fun g : Nat -> Nat -> Nat+  { g (succ n) m = plus (g n (succ m)) (f m)+  }+}
+ test/fail/DescendAscend2.err view
@@ -0,0 +1,18 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "DescendAscend2.ma" ---+--- scope checking ---+--- type checking ---+type  Nat : Set+term  Nat.zero : < Nat.zero : Nat >+term  Nat.succ : ^(y0 : Nat) -> < Nat.succ y0 : Nat >+term  plus : Nat -> Nat -> Nat+{}+term  f : Nat -> Nat -> Nat+term  g : Nat -> Nat -> Nat+{ f (Nat.succ n) m = f n (Nat.succ m)+; f (Nat.succ (Nat.succ (Nat.succ n))) m = plus m (g n n)+}+{ g (Nat.succ n) m = plus (g n (Nat.succ m)) (f m n)+}+error during typechecking:+Termination check for mutual block [f,g] fails for [g]
+ test/fail/DescendAscend2.ma view
@@ -0,0 +1,19 @@+data Nat : Set+{ zero : Nat+; succ : Nat -> Nat+}++fun plus : Nat -> Nat -> Nat {}++mutual {++  fun f : Nat -> Nat -> Nat+  { +    f (succ n) m = f n (succ m) ; -- ADDING THIS LINE leads to success??+    f (succ (succ (succ n))) m = plus (m) (g n n)+  }++  fun g : Nat -> Nat -> Nat+  { g (succ n) m = plus (g n (succ m)) (f m n)+  }+}
+ test/fail/DoNotEraseDataTeleForConTypes.err view
@@ -0,0 +1,14 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "DoNotEraseDataTeleForConTypes.ma" ---+--- scope checking ---+--- type checking ---+type  Wrap : .[A : Set] -> Set+error during typechecking:+Wrap+/// constructor Wrap.inn+/// new Wrap : (.[A : Set] -> Set)+/// new A : Set+/// inferExpr' ^(out : A) -> Wrap A+/// inferExpr' A+/// inferExpr: variable A : Set may not occur+/// , because it is marked as erased
+ test/fail/DoNotEraseDataTeleForConTypes.ma view
@@ -0,0 +1,11 @@+-- 2010-06-18++-- the following definition needs to be rejected!+data Wrap [A : Set] : Set+{ inn : (out : A) -> Wrap A+}+fields out++fun cast : [A : Set] -> [B : Set] -> A -> B+{ cast A B a = out {- B -} (inn {- A -} a)+}
+ test/fail/DottedConstructorsWrong.err view
@@ -0,0 +1,27 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "DottedConstructorsWrong.ma" ---+--- scope checking ---+--- type checking ---+type  Unit : Set+term  Unit.unit : < Unit.unit : Unit >+term  top : Unit -> Unit+{ top un!t = Unit.unit+}+type  Bool : Set+term  Bool.true : < Bool.true : Bool >+term  Bool.false : < Bool.false : Bool >+term  not : Bool -> Bool+block fails as expected, error message:+not+/// clause 1+/// confirming dotted constructor .true+/// more than one constructor matches type Bool+type  Nat : Set+term  Nat.zero : < Nat.zero : Nat >+term  Nat.suc : ^(n : Nat) -> < Nat.suc n : Nat >+term  pred : Nat -> Nat+error during typechecking:+pred+/// clause 2+/// confirming dotted constructor .suc x+/// more than one constructor matches type Nat
+ test/fail/DottedConstructorsWrong.ma view
@@ -0,0 +1,21 @@+-- 2013-04-08++data Unit { unit }++fun top : Unit -> Unit+{ top .unit = unit }++data Bool { true ; false }++fail+fun not : Bool -> Bool+{ not .true = false+; not false = true+}++data Nat { zero ; suc (n : Nat) }++fun pred : Nat -> Nat+{ pred zero = zero+; pred (.suc x) = x+}
+ test/fail/EndsCoInEmpty.err view
@@ -0,0 +1,32 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "EndsCoInEmpty.ma" ---+--- scope checking ---+--- type checking ---+type  Bool : Set+term  Bool.true : < Bool.true : Bool >+term  Bool.false : < Bool.false : Bool >+type  EmptyOr : ++(A : Set) -> ^ Bool -> Set+term  EmptyOr.inn : .[A : Set] -> ^(out : A) -> < EmptyOr.inn out : EmptyOr A Bool.true >+term  out : .[A : Set] -> (inn : EmptyOr A Bool.true) -> A+{ out [A] (EmptyOr.inn #out) = #out+}+term  exFalso : .[A : Set] -> .[B : Set] -> EmptyOr A Bool.false -> B+{ exFalso [A] [B] ()+}+type  Stream : ++(A : Set) -> - Size -> Set+term  Stream.cons : .[A : Set] -> .[i : Size] -> ^(head : A) -> ^(tail : Stream A i) -> < Stream.cons i head tail : Stream A $i >+term  head : .[A : Set] -> .[i : Size] -> (cons : Stream A $i) -> A+{ head [A] [i] (Stream.cons [.i] #head #tail) = #head+}+term  tail : .[A : Set] -> .[i : Size] -> (cons : Stream A $i) -> Stream A i+{ tail [A] [i] (Stream.cons [.i] #head #tail) = #tail+}+term  bla : .[A : Set] -> .[i : Size] -> EmptyOr (Stream A i) Bool.false+error during typechecking:+bla+/// clause 1+/// pattern $i+/// checkPattern $i : matching on size, checking that target .[i : Size] -> EmptyOr (Stream A i) Bool.false ends in correct coinductive sized type+/// new i <= #+/// endsInSizedCo: EmptyOr (Stream A i) Bool.false+/// allTypesOfTuple: panic: target type EmptyOr (Stream A i) Bool.false is not an instance of any constructor
+ test/fail/EndsCoInEmpty.ma view
@@ -0,0 +1,29 @@+-- 2010-09-05+-- Tried to trick MiniAgda into believing that an empty type is a tuple type+-- but it did not follow me.  Good!++data Bool : Set +{ true  : Bool+; false : Bool+}++-- a fake tuple type+data EmptyOr ++(A : Set) : Bool -> Set+{ inn : (out : A) -> EmptyOr A true+}++fun exFalso : [A, B : Set] -> EmptyOr A false -> B+{ exFalso A B ()+}++sized codata Stream ++(A : Set) : Size -> Set +{ cons : [i : Size] -> (head : A) -> (tail : Stream A i) -> Stream A $i+}++cofun bla : [A : Set] -> [i : Size] -> EmptyOr (Stream A i) false+{ bla A ($ i) = exFalso (Stream A i) (EmptyOr (Stream A $i) false) (bla A i)+}++fun anything : [A : Set] -> A+{ anything A = exFalso (EmptyOr (Stream Bool #) false) A (bla Bool #)+}
+ test/fail/ExistsSPos.err view
@@ -0,0 +1,17 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "ExistsSPos.ma" ---+--- scope checking ---+--- type checking ---+type  Exists : ^(A : Set) -> ++(B : A -> Set) -> Set+term  Exists.exI : .[A : Set] -> .[B : A -> Set] -> ^(witness : A) -> ^(proof : B witness) -> < Exists.exI witness proof : Exists A B >+term  witness : .[A : Set] -> .[B : A -> Set] -> (exI : Exists A B) -> A+{ witness [A] [B] (Exists.exI #witness #proof) = #witness+}+term  proof : .[A : Set] -> .[B : A -> Set] -> (exI : Exists A B) -> B (witness [A] [B] exI)+{ proof [A] [B] (Exists.exI #witness #proof) = #proof+}+type  Foo : Set+term  Foo.foo : ^(y0 : Exists Foo (\ x -> Foo)) -> < Foo.foo y0 : Foo >+error during typechecking:+checking positivity+/// polarity check ++ <= ^ failed
+ test/fail/ExistsSPos.ma view
@@ -0,0 +1,9 @@+-- 2010-06-11, Nisse++data Exists (A : Set) (+ B : A -> Set) : Set+{ exI : (witness : A) -> (proof : B witness) -> Exists A B+}++data Foo : Set+{ foo : Exists Foo (\ x -> Foo) -> Foo+}
+ test/fail/Fib2.err view
@@ -0,0 +1,47 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "Fib2.ma" ---+--- scope checking ---+--- type checking ---+type  SNat : + Size -> Set+term  SNat.zero : .[s!ze : Size] -> .[i < s!ze] -> SNat s!ze+term  SNat.zero : .[i : Size] -> < SNat.zero i : SNat $i >+term  SNat.succ : .[s!ze : Size] -> .[i < s!ze] -> ^ SNat i -> SNat s!ze+term  SNat.succ : .[i : Size] -> ^(y1 : SNat i) -> < SNat.succ i y1 : SNat $i >+type  Nat : Set+type  Nat = SNat #+term  add : Nat -> Nat -> Nat+{ add (SNat.zero [.#]) = \ y -> y+; add (SNat.succ [.#] x) = \ y -> SNat.succ [#] (add x y)+}+type  Stream : ++(A : Set) -> - Size -> Set+term  Stream.cons : .[A : Set] -> .[i : Size] -> ^(head : A) -> ^(tail : Stream A i) -> < Stream.cons i head tail : Stream A $i >+term  head : .[A : Set] -> .[i : Size] -> (cons : Stream A $i) -> A+{ head [A] [i] (Stream.cons [.i] #head #tail) = #head+}+term  tail : .[A : Set] -> .[i : Size] -> (cons : Stream A $i) -> Stream A i+{ tail [A] [i] (Stream.cons [.i] #head #tail) = #tail+}+term  zipWith : .[A : Set] -> .[B : Set] -> .[C : Set] -> (A -> B -> C) -> .[i : Size] -> Stream A i -> Stream B i -> Stream C i+{ zipWith [A] [B] [C] f $[i < #] (Stream.cons [.i] a as) (Stream.cons [.i] b bs) = Stream.cons [i] (f a b) (zipWith [A] [B] [C] f [i] as bs)+}+term  n0 : Nat+term  n0 = SNat.zero [#]+term  n1 : Nat+term  n1 = SNat.succ [#] n0+term  fib : .[i : Size] -> Stream Nat i+{ fib $[i < #] = Stream.cons [i] n0 (zipWith [Nat] [Nat] [Nat] add [i] (Stream.cons [i] n1 (fib [i])) (fib [i]))+}+term  fib2 : .[i : Size] -> Stream Nat (i + i)+error during typechecking:+fib2+/// clause 1+/// right hand side+/// checkExpr 1 |- cons (i + i) n0 (zipWith Nat Nat Nat add (i + i) (cons (i + i) n1 (fib2 i)) (fib2 i)) : Stream Nat ($i + $i)+/// checkForced fromList [(i,0)] |- cons (i + i) n0 (zipWith Nat Nat Nat add (i + i) (cons (i + i) n1 (fib2 i)) (fib2 i)) : Stream Nat ($i + $i)+/// leqVal' (subtyping)  < Stream.cons (i + i) (SNat.zero #) (zipWith Nat Nat Nat add (i + i) (Stream.cons [i + i] n1 (fib2 [i])) (fib2 [i])) : Stream Nat $(i + i) >  <=+  Stream Nat ($i + $i)+/// leqVal' (subtyping)  Stream Nat $(i + i)  <=+  Stream Nat ($i + $i)+/// leqVal'  $(i + i)  <=-  $$(i + i) : Size+/// leSize $(i + i) <=- $$(i + i)+/// leSize i + i <=- $(i + i)+/// leSize' $(i + i) <= i + i+/// leSize: 0 + 1 <= 0 failed
+ test/fail/Fib2.ma view
@@ -0,0 +1,52 @@+-- 2010-11-01++-- Nat ---------------------------------------------------------------++sized data SNat : Size -> Set +{ zero : [i : Size] -> SNat ($ i)+; succ : [i : Size] -> SNat i -> SNat ($ i) +}++let Nat : Set = SNat #++fun add : Nat -> Nat -> Nat +{ add (zero .#)   = \ y -> y+; add (succ .# x) = \ y -> succ # (add x y)+}++-- Stream ------------------------------------------------------------++sized codata Stream ++(A : Set) : -Size -> Set +{ cons : [i : Size] -> (head : A) -> (tail : Stream A i) -> Stream A ($ i)+}+fields head, tail++cofun zipWith : [A : Set] -> [B : Set] -> [C : Set] ->+                (A -> B -> C) -> [i : Size] ->+		Stream A i -> Stream B i -> Stream C i +{+  zipWith A B C f ($ i) (cons .i a as) (cons .i b bs) = +	cons i (f a b)  (zipWith A B C f i as bs) +}+++-- Fibonacci stream --------------------------------------------------++let n0 : Nat = zero #+let n1 : Nat = succ # n0++cofun fib : [i : Size] -> Stream Nat i+{+  fib ($ i) = cons i n0 (zipWith Nat Nat Nat add i +    (cons i n1 (fib i)) (fib i))+}++cofun fib2 : [i : Size] -> Stream Nat (i + i)+{+  fib2 ($ i) = -- RHS illtyped, produces only Stream Nat $(i + i)+    cons (i + i) n0 +      (zipWith Nat Nat Nat add (i + i) +        (cons (i + i) n1 (fib2 i)) +        (fib2 i))+}+
+ test/fail/FinBranchMutualWrong.err view
@@ -0,0 +1,19 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "FinBranchMutualWrong.ma" ---+--- scope checking ---+--- type checking ---+type  Nat : Set+term  Nat.zero : < Nat.zero : Nat >+term  Nat.suc : ^(y0 : Nat) -> < Nat.suc y0 : Nat >+type  Unit : Set+term  Unit.unit : < Unit.unit : Unit >+type  Prod : -(A : Set) -> ++(B : Set) -> Set+term  Prod.pair : .[A : Set] -> .[B : Set] -> ^(y0 : A -> B) -> < Prod.pair y0 : Prod A B >+type  Tree : Set+term  Tree.node : ^(numBranches : Nat) -> ^(y1 : VecTree numBranches) -> < Tree.node numBranches y1 : Tree >+{ VecTree Nat.zero = Unit+; VecTree (Nat.suc n) = Prod Tree (VecTree n)+}+error during typechecking:+checking positivity+/// polarity check ++ <= - failed
+ test/fail/FinBranchMutualWrong.ma view
@@ -0,0 +1,26 @@+-- 2010-08-30++data Nat : Set+{ zero : Nat+; suc  : Nat -> Nat+}++data Unit : Set { unit : Unit }++-- fake product, is fun space+data Prod -(A : Set) ++(B : Set) : Set+{ pair : (A -> B) -> Prod A B+}++mutual {++  data Tree : Set+  { node : (numBranches : Nat) -> VecTree numBranches -> Tree+  }++  fun VecTree : Nat -> Set+  { VecTree zero    = Unit+  ; VecTree (suc n) = Prod Tree (VecTree n)+  }++}
+ test/fail/FunctionExtensionality.err view
@@ -0,0 +1,28 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "FunctionExtensionality.ma" ---+--- scope checking ---+--- type checking ---+type  Id : ^(A : Set) -> ^(a : A) -> ^ A -> Set+term  Id.refl : .[A : Set] -> .[a : A] -> < Id.refl : Id A a a >+term  subst : .[A : Set] -> .[a : A] -> .[b : A] -> .[q : Id A a b] -> .[P : A -> Set] -> P a -> P b+{ subst [A] [a] [.a] [Id.refl] [P] h = h+}+term  J : .[A : Set] -> .[P : (a : A) -> (b : A) -> Id A a b -> Set] -> (h : (a : A) -> P a a Id.refl) -> (a : A) -> (b : A) -> .[q : Id A a b] -> P a b q+{ J [A] [P] h a .a [Id.refl] = h a+}+term  subst : .[A : Set] -> (a : A) -> (b : A) -> (q : Id A a b) -> .[P : A -> Set] -> P a -> P b+term  subst = [\ A ->] \ a -> \ b -> \ q -> [\ P ->] J [A] [\ x -> \ y -> \ p -> P x -> P y] (\ y -> \ p -> p) a b [q]+term  ext : .[A : Set] -> .[B : A -> Set] -> .[f : (x : A) -> B x] -> .[g : (x : A) -> B x] -> (h : .[x : A] -> Id (B x) (f x) (g x)) -> Id ((x : A) -> B x) f g+{}+error during typechecking:+extReducesNot+/// new A : Set+/// new a : v0+/// new f : (v0::Tm -> {A {a = v1, A = v0}})+/// new p : (.[x : v0::Tm] -> Id A x (f x){f = (v2 Up (v0::Tm -> {A {a = v1, A = v0}})), a = v1, A = v0})+/// checkExpr 4 |- refl : Id A a (subst [A -> A] (\ x -> x) (f ) (ext [A] [\ x -> A] [\ x -> x] [f ] (p x)) [\ x -> A] a)+/// checkForced fromList [(A,0),(a,1),(f,2),(p,3)] |- refl : Id A a (subst [A -> A] (\ x -> x) (f ) (ext [A] [\ x -> A] [\ x -> x] [f ] (p x)) [\ x -> A] a)+/// leqVal' (subtyping)  < Id.refl : Id A a a >  <=+  Id A a (subst [A -> A] (\ x -> x) (f ) (ext [A] [\ x -> A] [\ x -> x] [f ] (p x)) [\ x -> A] a)+/// leqVal' (subtyping)  Id A a a  <=+  Id A a (subst [A -> A] (\ x -> x) (f ) (ext [A] [\ x -> A] [\ x -> x] [f ] (p x)) [\ x -> A] a)+/// leqVal'  a  <=^  J (A -> A) (\ x -> \ y -> \ p -> A x -> A y) (\ y -> \ p -> p) (\ x -> x) (f ) (ext [A] [\ x -> A] [\ x -> x] [f ] (p x)) a : A+/// leqApp: head mismatch a != J
+ test/fail/FunctionExtensionality.ma view
@@ -0,0 +1,32 @@+-- 2012-03-07 chat with Nicolai Kraus++data Id (A : Set) (a : A) : A -> Set+{ refl : Id A a a+}+check+fun subst : [A : Set] [a, b : A] [q : Id A a b]+            [P : A -> Set] -> P a -> P b+{ subst A a .a refl P h = h+}++fun J : [A : Set] [P : (a,b : A) -> Id A a b -> Set]+  (h : (a : A) -> P a a refl) (a,b : A) [q : Id A a b] -> P a b q+{ J A P h a .a refl = h a+}++-- defining subst from J+let subst [A : Set] (a, b : A) (q : Id A a b)+          [P : A -> Set] : P a -> P b+  = J A (\ x y p -> P x -> P y) (\ y p -> p) a b q++-- extensionality axiom+fun ext : [A : Set] [B : A -> Set] [f, g : (x : A) -> B x]+  (h : [x : A] -> Id (B x) (f x) (g x)) ->+  Id ((x : A) -> B x) f g {}++let extReducesNot [A : Set] [a : A] [f : A -> A] [p : [x : A] -> Id A x (f x)] :+  Id A a (subst (A -> A) (\ x -> x) f+           (ext A (\ x -> A) (\ x -> x) f p)+           (\ x -> A)+           a)+  = refl
+ test/fail/HOMatching.err view
@@ -0,0 +1,12 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "HOMatching.ma" ---+--- scope checking ---+--- type checking ---+type  Succ : Set+term  Succ.succ : ^(y0 : Succ) -> < Succ.succ y0 : Succ >+type  homatch : (Succ -> Succ) -> Set+error during typechecking:+homatch+/// clause 1+/// pattern succ+/// cannot resolve constructor succ
+ test/fail/HOMatching.ma view
@@ -0,0 +1,15 @@+data Succ : Set+{ succ : Succ -> Succ+}++fun homatch : (Succ -> Succ) -> Set+{ homatch succ = Succ+}++{-+data Lim (A : Set) : Set+{ lim : (A -> Lim A) -> Lim A+}++fun bla : (A : Set) -> Lim A -> +-}
+ test/fail/HetIdFoolingEta.err view
@@ -0,0 +1,31 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "HetIdFoolingEta.ma" ---+--- scope checking ---+--- type checking ---+ty-u  Id : ^(A : Set) -> ^(a : A) -> ^(B : Set) -> ^ B -> Set 1+term  Id.refl : .[A : Set] -> .[a : A] -> < Id.refl : Id A a A a >+error during typechecking:+offDia+/// not a type: (f : (A : Set) -> (B : Set) -> (a : A) -> (b : B) -> Id A a B b) -> (A : Set) -> (B : Set) -> (a : A) -> (b : B) -> Id (Id A B a b) (f A B a b) (Id A a A a) (refl A a)+/// inferExpr' (f : (A : Set) -> (B : Set) -> (a : A) -> (b : B) -> Id A a B b) -> (A : Set) -> (B : Set) -> (a : A) -> (b : B) -> Id (Id A B a b) (f A B a b) (Id A a A a) (refl A a)+/// new f : (.[A : Set] -> .[B : Set] -> (a : A) -> (b : B) -> Id A a B b)+/// inferExpr' (A : Set) -> (B : Set) -> (a : A) -> (b : B) -> Id (Id A B a b) (f A B a b) (Id A a A a) (refl A a)+/// new A : Set+/// inferExpr' (B : Set) -> (a : A) -> (b : B) -> Id (Id A B a b) (f A B a b) (Id A a A a) (refl A a)+/// new B : Set+/// inferExpr' (a : A) -> (b : B) -> Id (Id A B a b) (f A B a b) (Id A a A a) (refl A a)+/// new a : v1+/// inferExpr' (b : B) -> Id (Id A B a b) (f A B a b) (Id A a A a) (refl A a)+/// new b : v2+/// inferExpr' Id (Id A B a b) (f A B a b) (Id A a A a) (refl A a)+/// inferExpr' Id (Id A B a b) (f A B a b) (Id A a A a)+/// inferExpr' Id (Id A B a b) (f A B a b)+/// inferExpr' Id (Id A B a b)+/// checkApp (^(A : Set) -> ^(a : A) -> ^(B : Set) -> ^ B -> Set 1) eliminated by Id A B a b+/// inferExpr' Id A B a b+/// inferExpr' Id A B a+/// inferExpr' Id A B+/// checkApp (^(a : v1::Tm) -> ^(B : Set) -> ^ B -> Set 1{A = v1}) eliminated by B+/// leqVal' (subtyping)  < B : Set >  <=+  A+/// leqVal' (subtyping)  Set  <=+  A+/// leqApp: head mismatch Set != A
+ test/fail/HetIdFoolingEta.ma view
@@ -0,0 +1,10 @@+data Id (A : Set) (a : A) : (B : Set) -> B -> Set 1+{ refl : Id A a A a +}++-- this does not typecheck since f A a B b expands to *, not to refl+let offDia : (f : (A : Set) -> (B : Set) -> (a : A) -> (b : B) -> Id A a B b) ->+             (A : Set) -> (B : Set) -> (a : A) -> (b : B) -> +              Id (Id A B a b)  (f A B a b)+                 (Id A a A a)  (refl A a)  +  = \ f -> \ A -> \ B -> \ a -> \ b -> refl (Id A a A a) (refl A a)
+ test/fail/HungryEtaRecord.err view
@@ -0,0 +1,23 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "HungryEtaRecord.ma" ---+--- scope checking ---+--- type checking ---+type  Hungry : -(i : Size) -> Set+term  Hungry.inn : .[i : Size] -> ^(out : .[j < i] -> Hungry j) -> < Hungry.inn out : Hungry i >+term  out : .[i : Size] -> (inn : Hungry i) -> .[j < i] -> Hungry j+{ out [i] (Hungry.inn #out) = #out+}+type  D : .[i : Size] -> Hungry i -> Set+{}+error during typechecking:+unique+/// new i <= #+/// new x : (Hungry v0)+/// new y : (Hungry v0)+/// new d : (D v0 (v1 Up (Hungry v0)))+/// checkExpr 4 |- d : D i y+/// leqVal' (subtyping)  < d : D i x >  <=+  D i y+/// leqVal' (subtyping)  D i x  <=+  D i y+/// leqVal'  x : Hungry i  <=*  y : Hungry i+/// leqVal'  x : Hungry i  <=*  y : Hungry i+/// leqApp: head mismatch x != y
+ test/fail/HungryEtaRecord.ma view
@@ -0,0 +1,13 @@+-- 2012-02-07++-- a recursive unit type+record Hungry -(i : Size) : Set+{ inn (out : [j < i] -> Hungry j)+} fields out++fun D : [i : Size] -> Hungry i -> Set {}++let unique [i : Size] (x, y : Hungry i) (d : D i x) : D i y+  = d+-- loops! because of infinite eta-expansion performed in equality testing+-- similar to recursive record problem
+ test/fail/IdFoolingEta.err view
@@ -0,0 +1,29 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "IdFoolingEta.ma" ---+--- scope checking ---+--- type checking ---+type  Id : ^(A : Set) -> ^(a : A) -> ^ A -> Set+term  Id.refl : .[A : Set] -> .[a : A] -> < Id.refl : Id A a a >+term  subst : .[A : Set] -> (a : A) -> (b : A) -> Id A a b -> .[P : A -> Set] -> P a -> P b+{ subst [A] a .a Id.refl [P] x = x+}+error during typechecking:+offDia+/// checkExpr 0 |- \ f -> \ A -> \ a -> \ b -> refl : (f : .[A : Set] -> (a : A) -> (b : A) -> Id A a b) -> .[A : Set] -> (a : A) -> (b : A) -> Id (Id A a b) (f [A] a b) (subst [A] a b (f [A] a b) [Id A a] Id.refl)+/// checkForced fromList [] |- \ f -> \ A -> \ a -> \ b -> refl : (f : .[A : Set] -> (a : A) -> (b : A) -> Id A a b) -> .[A : Set] -> (a : A) -> (b : A) -> Id (Id A a b) (f [A] a b) (subst [A] a b (f [A] a b) [Id A a] Id.refl)+/// new f : (.[A : Set] -> (a : A) -> (b : A) -> Id A a b)+/// checkExpr 1 |- \ A -> \ a -> \ b -> refl : .[A : Set] -> (a : A) -> (b : A) -> Id (Id A a b) (f A a b [A] a b) (subst [A] a b (f A a b [A] a b) [Id A a] Id.refl)+/// checkForced fromList [(f,0)] |- \ A -> \ a -> \ b -> refl : .[A : Set] -> (a : A) -> (b : A) -> Id (Id A a b) (f A a b [A] a b) (subst [A] a b (f A a b [A] a b) [Id A a] Id.refl)+/// new A : Set+/// checkExpr 2 |- \ a -> \ b -> refl : (a : A) -> (b : A) -> Id (Id A a b) (f A a b [A] a b) (subst [A] a b (f A a b [A] a b) [Id A a] Id.refl)+/// checkForced fromList [(A,1),(f,0)] |- \ a -> \ b -> refl : (a : A) -> (b : A) -> Id (Id A a b) (f A a b [A] a b) (subst [A] a b (f A a b [A] a b) [Id A a] Id.refl)+/// new a : v1+/// checkExpr 3 |- \ b -> refl : (b : A) -> Id (Id A a b) (f A a b [A] a b) (subst [A] a b (f A a b [A] a b) [Id A a] Id.refl)+/// checkForced fromList [(A,1),(f,0),(a,2)] |- \ b -> refl : (b : A) -> Id (Id A a b) (f A a b [A] a b) (subst [A] a b (f A a b [A] a b) [Id A a] Id.refl)+/// new b : v1+/// checkExpr 4 |- refl : Id (Id A a b) (f A a b [A] a b) (subst [A] a b (f A a b [A] a b) [Id A a] Id.refl)+/// checkForced fromList [(A,1),(f,0),(a,2),(b,3)] |- refl : Id (Id A a b) (f A a b [A] a b) (subst [A] a b (f A a b [A] a b) [Id A a] Id.refl)+/// leqVal' (subtyping)  < Id.refl : Id (Id A a b) (f A a b [A] a b) (f A a b [A] a b) >  <=+  Id (Id A a b) (f A a b [A] a b) (subst [A] a b (f A a b [A] a b) [Id A a] Id.refl)+/// leqVal' (subtyping)  Id (Id A a b) (f A a b [A] a b) (f A a b [A] a b)  <=+  Id (Id A a b) (f A a b [A] a b) (subst [A] a b (f A a b [A] a b) [Id A a] Id.refl)+/// leqVal'  f A a b  <=^  subst A a b (f A a b [A] a b) (Id A a) Id.refl : Id A a b+/// leqApp: head mismatch f != subst
+ test/fail/IdFoolingEta.ma view
@@ -0,0 +1,16 @@+data Id (A : Set) (a : A) : A -> Set +{ refl : Id A a a +}++fun subst : (A : Set) -> (a : A) -> (b : A) -> Id A a b -> +  (P : A -> Set) -> P a -> P b+{ subst A a .a (refl) P x = x+}++-- this does not typecheck since f A a b expands to * but subst blocks+let offDia : (f : (A : Set) -> (a : A) -> (b : A) -> Id A a b) ->+             (A : Set) -> (a : A) -> (b : A) -> +              Id (Id A a b) +               (f A a b) +               (subst A a b (f A a b) (Id A a) (refl))+  = \ f -> \ A -> \ a -> \ b -> refl {- (Id A a b) (subst A a b (f A a b) (Id A a) (refl A a)) -}
+ test/fail/IllegalParameter.err view
@@ -0,0 +1,6 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "IllegalParameter.ma" ---+--- scope checking ---+scope check error: D+/// c+/// expression (\A -> A) is not valid in a parameter
+ test/fail/IllegalParameter.ma view
@@ -0,0 +1,4 @@+-- 2013-04-05++data D (F : Set -> Set)+{ c : D (\ A -> A) }
+ test/fail/InconsistentHypotheses.err view
@@ -0,0 +1,10 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "InconsistentHypotheses.ma" ---+--- scope checking ---+--- type checking ---+type  f : .[i : Size] -> .[j < i] -> |i| < |j| -> Set+error during typechecking:+f+/// clause 1+/// adding size rel. v0 + 1 <= v1+/// cannot add hypothesis v0 + 1 <= v1 because it makes the set of hyptheses unsatisfiable
+ test/fail/InconsistentHypotheses.ma view
@@ -0,0 +1,3 @@+-- 2013-04-04 This should not termination check:+fun f : [i : Size] |i| [j < i] -> |i| < |j| -> Set+{ f i j = f j i }
+ test/fail/InjDataLoop.err view
@@ -0,0 +1,28 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "InjDataLoop.ma" ---+--- scope checking ---+--- type checking ---+type  Empty : Set+type  Eq : .[i : Size] -> ^(A : Set i) -> ^(a : A) -> ^ A -> Set+term  Eq.refl : .[i : Size] -> .[A : Set i] -> .[a : A] -> < Eq.refl : Eq [i] A a a >+type  I : ^(F : Set -> Set) -> Set+ty-u  InvI : ^(A : Set) -> Set 1+term  InvI.inv : .[A : Set] -> ^(Inverse : Set -> Set) -> ^(y1 : Eq [1] Set (I Inverse) A) -> < InvI.inv Inverse y1 : InvI A >+tmty  invertible : (A : Set) -> InvI A+{}+type  cantor : Set -> Set+type  cantor = \ A -> case invertible A : InvI A+       { InvI.inv X p -> X A -> Empty+       }+type  cIc : Set+type  cIc = cantor (I cantor)+error during typechecking:+delta+/// checkExpr 0 |- case invertible (I cantor)+               { inv .cantor refl -> \ f -> f f+               } : case invertible (I cantor) : InvI (I cantor)+                   { InvI.inv X p -> X (I cantor) -> Empty+                   }+/// case 1+/// dot pattern Just cantor+/// not instantiated
+ test/fail/InjDataLoop.ma view
@@ -0,0 +1,47 @@+{- 2010-01-15++Non-termination from inconsistency and injectivity of data type constructors+by the use of smart case.++2010-06-25 Switching to predicative polymorphism+-}++data Empty : Set {}++data Eq [i : Size](A : Set i)(a : A) : A -> Set+{ refl : Eq i A a a+} ++data I (F : Set -> Set) : Set {}+ +data InvI (A : Set) : Set 1+{ inv : (Inverse : Set -> Set) -> Eq 1 Set (I Inverse) A -> InvI A+} ++fun invertible : (A : Set) -> InvI A {}  -- postulate ++-- self-application on the type level+let cantor : Set -> Set+= \ A -> case (invertible A) +  { (inv X p) -> X A -> Empty+  }++let cIc : Set+        = cantor (I cantor)++-- type checker loops!+let delta : cIc+= case (invertible (I cantor))+  { (inv {-.(I cantor)-} .cantor (refl {-.1 .Set .(I cantor)-}))  -> +   -- in the branch, cIc --> cIc -> Empty --> (cIc -> Empty) -> Empty -->...+        \ f -> f f+  }++let delta' : cIc -> Empty+= case (invertible (I cantor))+  { (inv {-.(I cantor)-} .cantor (refl {-.Set .(I cantor)-})) -> +        \ f ->  f f            +  }++let omega : Empty+          = delta' delta
+ test/fail/InjDataLoop2.err view
@@ -0,0 +1,30 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "InjDataLoop2.ma" ---+--- scope checking ---+--- type checking ---+type  Empty : Set+type  Eq : .[i : Size] -> ^(A : Set i) -> ^(a : A) -> ^ A -> Set+term  Eq.refl : .[i : Size] -> .[A : Set i] -> .[a : A] -> < Eq.refl : Eq [i] A a a >+type  I : ^(F : Set -> Set) -> Set+ty-u  InvI : ^(A : Set) -> Set 1+term  InvI.inv : .[A : Set] -> ^(Inverse : Set -> Set) -> ^(isInverse : Eq [1] Set (I Inverse) A) -> < InvI.inv Inverse isInverse : InvI A >+type  Inverse : .[A : Set] -> (inv : InvI A) -> Set -> Set+{ Inverse [A] (InvI.inv #Inverse #isInverse) = #Inverse+}+term  isInverse : .[A : Set] -> (inv : InvI A) -> Eq [1] Set (I (Inverse [A] inv)) A+{ isInverse [A] (InvI.inv #Inverse #isInverse) = #isInverse+}+tmty  invertible : (A : Set) -> InvI A+{}+type  cantor : Set -> Set+type  cantor = \ A -> Inverse (invertible A) A -> Empty+type  cIc : Set+type  cIc = cantor (I cantor)+error during typechecking:+delta+/// checkExpr 0 |- case invertible (I cantor) : InvI (I cantor)+               { inv .cantor refl -> \ f -> f f+               } : invertible (I cantor) .Inverse (I cantor) -> Empty+/// case 1+/// dot pattern Just cantor+/// not instantiated
+ test/fail/InjDataLoop2.ma view
@@ -0,0 +1,50 @@+{- 2010-01-15++Non-termination from inconsistency and injectivity of data type constructors+by the use of smart case.++2010-06-25 Switching to predicative polymorphism+-}++data Empty : Set {}++data Eq [i : Size](A : Set i)(a : A) : A -> Set+{ refl : Eq i A a a+} ++data I (F : Set -> Set) : Set {}+ +data InvI (A : Set) : Set 1+{ inv : (Inverse   : Set -> Set) -> +        (isInverse : Eq 1 Set (I Inverse) A) -> +        InvI A+} +fields Inverse, isInverse++fun invertible : (A : Set) -> InvI A {}  -- postulate ++-- self-application on the type level+let cantor : Set -> Set+= \ A -> Inverse (invertible A) A -> Empty +  -- not using smart case here, gives a different message++let cIc : Set+        = cantor (I cantor)++-- type checker loops!+let delta : cIc+= case (invertible (I cantor)) : InvI (I cantor)+  { (inv .cantor refl) ->+   -- in the branch, cIc --> cIc -> Empty --> (cIc -> Empty) -> Empty -->...+        \ f -> f f+  }+-- HERE, one gets error "dot pattern cantor not instantiated"++let delta' : cIc -> Empty+= case (invertible (I cantor))+  { (inv .cantor refl) ->+        \ f ->  f f            +  }++let omega : Empty+          = delta' delta
+ test/fail/InvalidField.err view
@@ -0,0 +1,5 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "InvalidField.ma" ---+--- scope checking ---+scope check error: D+/// record field f unknown
+ test/fail/InvalidField.ma view
@@ -0,0 +1,1 @@+data D : Set { c : D } fields f
+ test/fail/InvalidSizeP.err view
@@ -0,0 +1,22 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "InvalidSizeP.ma" ---+--- scope checking ---+--- type checking ---+type  SNat : + Size -> Set+term  SNat.zero : .[s!ze : Size] -> .[i < s!ze] -> SNat s!ze+term  SNat.zero : .[i : Size] -> < SNat.zero i : SNat $i >+term  SNat.succ : .[s!ze : Size] -> .[i < s!ze] -> ^ SNat i -> SNat s!ze+term  SNat.succ : .[i : Size] -> ^(y1 : SNat i) -> < SNat.succ i y1 : SNat $i >+term  test : .[i : Size] -> SNat i -> SNat i -> SNat i+error during typechecking:+test+/// clause 1+/// pattern succ (l < k) y+/// pattern l < k+/// new l < v0+/// adding size rel. v3 + 1 <= v0+/// adding size rel. v3 + 1 <= v1+/// leqVal' (subtyping)  < i  <=+  < k+/// leSize i <=+ k+/// leSize' i <= k+/// bound not entailed
+ test/fail/InvalidSizeP.ma view
@@ -0,0 +1,14 @@+-- bug reported by David Thibodeau, Nov 2011+-- fixed 2012-01-24++sized data SNat : Size -> Set+{ zero : (i : Size) -> SNat ($ i)+; succ : (i : Size) -> SNat i -> SNat ($ i)+}++-- the following should fail:++fun test : [i : Size] -> SNat i -> SNat i -> SNat i+{ test i (succ (i > k) x) (succ (k > l) y) = test i (succ l y) (succ k x)+}+-- the second successor pattern has not the correct upper bound (k instead i)
+ test/fail/IrrHeterogeneousEta.err view
@@ -0,0 +1,97 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "IrrHeterogeneousEta.ma" ---+--- scope checking ---+--- type checking ---+type  Unit : Set+term  Unit.unit : < Unit.unit : Unit >+type  Bool : Set+term  Bool.true : < Bool.true : Bool >+term  Bool.false : < Bool.false : Bool >+type  T : Bool -> Set+{ T Bool.true = Bool -> Bool+; T Bool.false = Bool+}+block fails as expected, error message:+etaFun'+/// checkExpr 0 |- \ F -> \ g -> \ h -> g (h true) : .[F : .[b : Bool] -> (T b -> T b) -> Bool -> Set] -> (g : F Bool.false (\ x -> x) Bool.true -> Bool) -> (h : (a : Bool) -> F Bool.true (\ x -> \ y -> x y) a) -> Bool+/// checkForced fromList [] |- \ F -> \ g -> \ h -> g (h true) : .[F : .[b : Bool] -> (T b -> T b) -> Bool -> Set] -> (g : F Bool.false (\ x -> x) Bool.true -> Bool) -> (h : (a : Bool) -> F Bool.true (\ x -> \ y -> x y) a) -> Bool+/// new F : (.[b : Bool::Tm] -> (T b -> T b) -> Bool -> Set)+/// checkExpr 1 |- \ g -> \ h -> g (h true) : (g : F Bool.false (\ x -> x) Bool.true -> Bool) -> (h : (a : Bool) -> F Bool.true (\ x -> \ y -> x y) a) -> Bool+/// checkForced fromList [(F,0)] |- \ g -> \ h -> g (h true) : (g : F Bool.false (\ x -> x) Bool.true -> Bool) -> (h : (a : Bool) -> F Bool.true (\ x -> \ y -> x y) a) -> Bool+/// new g : ((v0 {Bool.false {F = (v0 Up (.[b : Bool::Tm] -> (T b -> T b) -> Bool -> Set))}} {\ x -> x {F = (v0 Up (.[b : Bool::Tm] -> (T b -> T b) -> Bool -> Set))}} {Bool.true {F = (v0 Up (.[b : Bool::Tm] -> (T b -> T b) -> Bool -> Set))}})::Tm -> {Bool {F = (v0 Up (.[b : Bool::Tm] -> (T b -> T b) -> Bool -> Set))}})+/// checkExpr 2 |- \ h -> g (h true) : (h : (a : Bool) -> F Bool.true (\ x -> \ y -> x y) a) -> Bool+/// checkForced fromList [(g,1),(F,0)] |- \ h -> g (h true) : (h : (a : Bool) -> F Bool.true (\ x -> \ y -> x y) a) -> Bool+/// new h : ((a : Bool::Tm) -> F [Bool.true] (\ x -> \ y -> x y) a{g = (v1 Up ((v0 {Bool.false {F = (v0 Up (.[b : Bool::Tm] -> (T b -> T b) -> Bool -> Set))}} {\ x -> x {F = (v0 Up (.[b : Bool::Tm] -> (T b -> T b) -> Bool -> Set))}} {Bool.true {F = (v0 Up (.[b : Bool::Tm] -> (T b -> T b) -> Bool -> Set))}})::Tm -> {Bool {F = (v0 Up (.[b : Bool::Tm] -> (T b -> T b) -> Bool -> Set))}})), F = (v0 Up (.[b : Bool::Tm] -> (T b -> T b) -> Bool -> Set))})+/// checkExpr 3 |- g (h true) : Bool+/// inferExpr' g (h true)+/// checkApp ((v0 {Bool.false {F = (v0 Up (.[b : Bool::Tm] -> (T b -> T b) -> Bool -> Set))}} {\ x -> x {F = (v0 Up (.[b : Bool::Tm] -> (T b -> T b) -> Bool -> Set))}} {Bool.true {F = (v0 Up (.[b : Bool::Tm] -> (T b -> T b) -> Bool -> Set))}})::Tm -> {Bool {F = (v0 Up (.[b : Bool::Tm] -> (T b -> T b) -> Bool -> Set))}}) eliminated by h true+/// leqVal' (subtyping)  < h a Bool.true : F Bool.true (\ x -> \ y -> x y) Bool.true >  <=+  F Bool.false (\ x -> x) Bool.true+/// leqVal' (subtyping)  F Bool.true (\ x -> \ y -> x y) Bool.true  <=+  F Bool.false (\ x -> x) Bool.true+/// leqVal'  x y : (Bool -> Bool) -> Bool -> Bool  <=*  x : Bool -> Bool+/// new x : (Bool::Tm -> Bool)||Bool+/// leqVal'  x y : Bool -> Bool  <=*  x : Bool+/// type (Bool::Tm -> Bool) has different shape than Bool+block fails as expected, error message:+etaFun+/// checkExpr 0 |- \ F -> \ g -> \ a -> g a : .[F : .[b : Bool] -> (T b -> T b) -> Set] -> (g : F Bool.false (\ x -> x) -> Bool) -> (a : F Bool.true (\ x -> \ y -> x y)) -> Bool+/// checkForced fromList [] |- \ F -> \ g -> \ a -> g a : .[F : .[b : Bool] -> (T b -> T b) -> Set] -> (g : F Bool.false (\ x -> x) -> Bool) -> (a : F Bool.true (\ x -> \ y -> x y)) -> Bool+/// new F : (.[b : Bool::Tm] -> (T b -> T b) -> Set)+/// checkExpr 1 |- \ g -> \ a -> g a : (g : F Bool.false (\ x -> x) -> Bool) -> (a : F Bool.true (\ x -> \ y -> x y)) -> Bool+/// checkForced fromList [(F,0)] |- \ g -> \ a -> g a : (g : F Bool.false (\ x -> x) -> Bool) -> (a : F Bool.true (\ x -> \ y -> x y)) -> Bool+/// new g : ((v0 {Bool.false {F = (v0 Up (.[b : Bool::Tm] -> (T b -> T b) -> Set))}} {\ x -> x {F = (v0 Up (.[b : Bool::Tm] -> (T b -> T b) -> Set))}})::Tm -> {Bool {F = (v0 Up (.[b : Bool::Tm] -> (T b -> T b) -> Set))}})+/// checkExpr 2 |- \ a -> g a : (a : F Bool.true (\ x -> \ y -> x y)) -> Bool+/// checkForced fromList [(g,1),(F,0)] |- \ a -> g a : (a : F Bool.true (\ x -> \ y -> x y)) -> Bool+/// new a : (v0 {Bool.true {g = (v1 Up ((v0 {Bool.false {F = (v0 Up (.[b : Bool::Tm] -> (T b -> T b) -> Set))}} {\ x -> x {F = (v0 Up (.[b : Bool::Tm] -> (T b -> T b) -> Set))}})::Tm -> {Bool {F = (v0 Up (.[b : Bool::Tm] -> (T b -> T b) -> Set))}})), F = (v0 Up (.[b : Bool::Tm] -> (T b -> T b) -> Set))}} {\ x -> \ y -> x y {g = (v1 Up ((v0 {Bool.false {F = (v0 Up (.[b : Bool::Tm] -> (T b -> T b) -> Set))}} {\ x -> x {F = (v0 Up (.[b : Bool::Tm] -> (T b -> T b) -> Set))}})::Tm -> {Bool {F = (v0 Up (.[b : Bool::Tm] -> (T b -> T b) -> Set))}})), F = (v0 Up (.[b : Bool::Tm] -> (T b -> T b) -> Set))}})+/// checkExpr 3 |- g a : Bool+/// inferExpr' g a+/// checkApp ((v0 {Bool.false {F = (v0 Up (.[b : Bool::Tm] -> (T b -> T b) -> Set))}} {\ x -> x {F = (v0 Up (.[b : Bool::Tm] -> (T b -> T b) -> Set))}})::Tm -> {Bool {F = (v0 Up (.[b : Bool::Tm] -> (T b -> T b) -> Set))}}) eliminated by a+/// leqVal' (subtyping)  < a : F Bool.true (\ x -> \ y -> x y) >  <=+  F Bool.false (\ x -> x)+/// leqVal' (subtyping)  F Bool.true (\ x -> \ y -> x y)  <=+  F Bool.false (\ x -> x)+/// leqVal'  x y : (Bool -> Bool) -> Bool -> Bool  <=*  x : Bool -> Bool+/// new x : (Bool::Tm -> Bool)||Bool+/// leqVal'  x y : Bool -> Bool  <=*  x : Bool+/// type (Bool::Tm -> Bool) has different shape than Bool+type  U : Bool -> Set+{ U Bool.true = Unit+; U Bool.false = Bool+}+block fails as expected, error message:+etaUnit'+/// checkExpr 0 |- \ F -> \ g -> \ h -> g (h true) : .[F : .[b : Bool] -> (U b -> U b) -> Bool -> Set] -> (g : F Bool.false (\ x -> x) Bool.true -> Bool) -> (h : (a : Bool) -> F Bool.true (\ x -> Unit.unit) a) -> Bool+/// checkForced fromList [] |- \ F -> \ g -> \ h -> g (h true) : .[F : .[b : Bool] -> (U b -> U b) -> Bool -> Set] -> (g : F Bool.false (\ x -> x) Bool.true -> Bool) -> (h : (a : Bool) -> F Bool.true (\ x -> Unit.unit) a) -> Bool+/// new F : (.[b : Bool::Tm] -> (U b -> U b) -> Bool -> Set)+/// checkExpr 1 |- \ g -> \ h -> g (h true) : (g : F Bool.false (\ x -> x) Bool.true -> Bool) -> (h : (a : Bool) -> F Bool.true (\ x -> Unit.unit) a) -> Bool+/// checkForced fromList [(F,0)] |- \ g -> \ h -> g (h true) : (g : F Bool.false (\ x -> x) Bool.true -> Bool) -> (h : (a : Bool) -> F Bool.true (\ x -> Unit.unit) a) -> Bool+/// new g : ((v0 {Bool.false {F = (v0 Up (.[b : Bool::Tm] -> (U b -> U b) -> Bool -> Set))}} {\ x -> x {F = (v0 Up (.[b : Bool::Tm] -> (U b -> U b) -> Bool -> Set))}} {Bool.true {F = (v0 Up (.[b : Bool::Tm] -> (U b -> U b) -> Bool -> Set))}})::Tm -> {Bool {F = (v0 Up (.[b : Bool::Tm] -> (U b -> U b) -> Bool -> Set))}})+/// checkExpr 2 |- \ h -> g (h true) : (h : (a : Bool) -> F Bool.true (\ x -> Unit.unit) a) -> Bool+/// checkForced fromList [(g,1),(F,0)] |- \ h -> g (h true) : (h : (a : Bool) -> F Bool.true (\ x -> Unit.unit) a) -> Bool+/// new h : ((a : Bool::Tm) -> F [Bool.true] (\ x -> Unit.unit) a{g = (v1 Up ((v0 {Bool.false {F = (v0 Up (.[b : Bool::Tm] -> (U b -> U b) -> Bool -> Set))}} {\ x -> x {F = (v0 Up (.[b : Bool::Tm] -> (U b -> U b) -> Bool -> Set))}} {Bool.true {F = (v0 Up (.[b : Bool::Tm] -> (U b -> U b) -> Bool -> Set))}})::Tm -> {Bool {F = (v0 Up (.[b : Bool::Tm] -> (U b -> U b) -> Bool -> Set))}})), F = (v0 Up (.[b : Bool::Tm] -> (U b -> U b) -> Bool -> Set))})+/// checkExpr 3 |- g (h true) : Bool+/// inferExpr' g (h true)+/// checkApp ((v0 {Bool.false {F = (v0 Up (.[b : Bool::Tm] -> (U b -> U b) -> Bool -> Set))}} {\ x -> x {F = (v0 Up (.[b : Bool::Tm] -> (U b -> U b) -> Bool -> Set))}} {Bool.true {F = (v0 Up (.[b : Bool::Tm] -> (U b -> U b) -> Bool -> Set))}})::Tm -> {Bool {F = (v0 Up (.[b : Bool::Tm] -> (U b -> U b) -> Bool -> Set))}}) eliminated by h true+/// leqVal' (subtyping)  < h a Bool.true : F Bool.true (\ x -> Unit.unit) Bool.true >  <=+  F Bool.false (\ x -> x) Bool.true+/// leqVal' (subtyping)  F Bool.true (\ x -> Unit.unit) Bool.true  <=+  F Bool.false (\ x -> x) Bool.true+/// leqVal'  Unit.unit : Unit -> Unit  <=*  x : Bool -> Bool+/// new x : Unit||Bool+/// leqVal'  Unit.unit : Unit  <=*  x : Bool+/// type Unit has different shape than Bool+error during typechecking:+etaUnit+/// checkExpr 0 |- \ F -> \ g -> \ a -> g a : .[F : .[b : Bool] -> (U b -> U b) -> Set] -> (g : F Bool.false (\ x -> x) -> Bool) -> (a : F Bool.true (\ x -> Unit.unit)) -> Bool+/// checkForced fromList [] |- \ F -> \ g -> \ a -> g a : .[F : .[b : Bool] -> (U b -> U b) -> Set] -> (g : F Bool.false (\ x -> x) -> Bool) -> (a : F Bool.true (\ x -> Unit.unit)) -> Bool+/// new F : (.[b : Bool::Tm] -> (U b -> U b) -> Set)+/// checkExpr 1 |- \ g -> \ a -> g a : (g : F Bool.false (\ x -> x) -> Bool) -> (a : F Bool.true (\ x -> Unit.unit)) -> Bool+/// checkForced fromList [(F,0)] |- \ g -> \ a -> g a : (g : F Bool.false (\ x -> x) -> Bool) -> (a : F Bool.true (\ x -> Unit.unit)) -> Bool+/// new g : ((v0 {Bool.false {F = (v0 Up (.[b : Bool::Tm] -> (U b -> U b) -> Set))}} {\ x -> x {F = (v0 Up (.[b : Bool::Tm] -> (U b -> U b) -> Set))}})::Tm -> {Bool {F = (v0 Up (.[b : Bool::Tm] -> (U b -> U b) -> Set))}})+/// checkExpr 2 |- \ a -> g a : (a : F Bool.true (\ x -> Unit.unit)) -> Bool+/// checkForced fromList [(g,1),(F,0)] |- \ a -> g a : (a : F Bool.true (\ x -> Unit.unit)) -> Bool+/// new a : (v0 {Bool.true {g = (v1 Up ((v0 {Bool.false {F = (v0 Up (.[b : Bool::Tm] -> (U b -> U b) -> Set))}} {\ x -> x {F = (v0 Up (.[b : Bool::Tm] -> (U b -> U b) -> Set))}})::Tm -> {Bool {F = (v0 Up (.[b : Bool::Tm] -> (U b -> U b) -> Set))}})), F = (v0 Up (.[b : Bool::Tm] -> (U b -> U b) -> Set))}} {\ x -> Unit.unit {g = (v1 Up ((v0 {Bool.false {F = (v0 Up (.[b : Bool::Tm] -> (U b -> U b) -> Set))}} {\ x -> x {F = (v0 Up (.[b : Bool::Tm] -> (U b -> U b) -> Set))}})::Tm -> {Bool {F = (v0 Up (.[b : Bool::Tm] -> (U b -> U b) -> Set))}})), F = (v0 Up (.[b : Bool::Tm] -> (U b -> U b) -> Set))}})+/// checkExpr 3 |- g a : Bool+/// inferExpr' g a+/// checkApp ((v0 {Bool.false {F = (v0 Up (.[b : Bool::Tm] -> (U b -> U b) -> Set))}} {\ x -> x {F = (v0 Up (.[b : Bool::Tm] -> (U b -> U b) -> Set))}})::Tm -> {Bool {F = (v0 Up (.[b : Bool::Tm] -> (U b -> U b) -> Set))}}) eliminated by a+/// leqVal' (subtyping)  < a : F Bool.true (\ x -> Unit.unit) >  <=+  F Bool.false (\ x -> x)+/// leqVal' (subtyping)  F Bool.true (\ x -> Unit.unit)  <=+  F Bool.false (\ x -> x)+/// leqVal'  Unit.unit : Unit -> Unit  <=*  x : Bool -> Bool+/// new x : Unit||Bool+/// leqVal'  Unit.unit : Unit  <=*  x : Bool+/// type Unit has different shape than Bool
+ test/fail/IrrHeterogeneousEta.ma view
@@ -0,0 +1,82 @@+-- 2010-10-09++-- an example with different types in context during eq. checking+-- derived from Ulf's counterexample++data Unit : Set+{ unit : Unit+}++data Bool : Set+{ true  : Bool+; false : Bool+}++fun T : Bool -> Set+{ T true  = Bool -> Bool+; T false = Bool+}++-- fails with "Bool -> Bool has different shape than Bool"+fail+let etaFun' : +    [F : [b : Bool] -> (T b -> T b) -> Bool -> Set] ->+    (g : F false (\ x -> x) true -> Bool) -> +    (h : (a : Bool) -> F true (\ x y -> x y) a) ->+    Bool+  = \ F g h -> g (h true)+-- but succeeds in ICC++{- compares (cannot eta-expand lhs!)++    F false (\ x -> x) true ?= F true (\ x y -> x y) true+    x : Bool |- x : Bool    ?= x : Bool -> Bool |- \ y -> x y : Bool -> Bool++-}++fail+let etaFun : +    [F : [b : Bool] -> (T b -> T b) -> Set] ->+    (g : F false (\ x -> x) -> Bool) -> +    (a : F true (\ x y -> x y)) ->+    Bool+  = \ F g a -> g a++{- compares (cannot eta-expand lhs!)++    F false (\ x -> x) true ?= F true (\ x y -> x y) true+    x : Bool |- x : Bool    ?= x : Bool -> Bool |- \ y -> x y : Bool -> Bool++  works with eta-contraction, but...+-}++fun U : Bool -> Set+{ U true  = Unit+; U false = Bool+}++fail+let etaUnit' : +    [F : [b : Bool] -> (U b -> U b) -> Bool -> Set] ->+    (g : F false (\ x -> x) true -> Bool) -> +    (h : (a : Bool) -> F true (\ x -> unit) a) ->+    Bool+  = \ F g h -> g (h true)++{- +    F false (\ x -> x) true ?= F true (\ x -> unit) true+    x : Bool |- x : Bool    ?= x : Unit |- unit : Unit+-}++let etaUnit : +    [F : [b : Bool] -> (U b -> U b) -> Set] ->+    (g : F false (\ x -> x) -> Bool) -> +    (a : F true (\ x -> unit)) ->+    Bool+  = \ F g a -> g a++{- +    F false (\ x -> x) true ?= F true (\ x -> unit) true+    x : Bool |- x : Bool    ?= x : Unit |- unit : Unit+-}+
+ test/fail/IrrHeterogeneousFun.err view
@@ -0,0 +1,47 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "IrrHeterogeneousFun.ma" ---+--- scope checking ---+--- type checking ---+type  Bool : Set+term  Bool.true : < Bool.true : Bool >+term  Bool.false : < Bool.false : Bool >+type  Nat : Set+term  Nat.zero : < Nat.zero : Nat >+term  Nat.succ : ^(y0 : Nat) -> < Nat.succ y0 : Nat >+type  T : Bool -> Set+{ T Bool.true = Nat+; T Bool.false = Bool+}+term  good : .[F : Nat -> Set] -> .[f : .[b : Bool] -> (.[T b] -> Nat) -> Nat] -> (g : (n : Nat) -> F (f [Bool.true] ([\ x ->] n))) -> (h : F (f [Bool.false] ([\ x ->] Nat.zero)) -> Bool) -> Bool+{ good [F] [f] g h = h (g Nat.zero)+}+term  good' : .[F : .[b : Bool] -> (.[T b] -> Nat) -> Set] -> (g : F [Bool.false] ([\ x ->] Nat.zero) -> Bool) -> (h : (n : Nat) -> F [Bool.true] ([\ x ->] n)) -> Bool+term  good' = [\ F ->] \ g -> \ h -> g (h Nat.zero)+warning: ignoring error: type Nat has different shape than Bool+term  bad1 : .[F : .[b : Bool] -> (T b -> T b) -> Nat -> Set] -> (g : F [Bool.false] (\ x -> x) Nat.zero -> Bool) -> (h : (n : Nat) -> F [Bool.true] (\ x -> x) n) -> Bool+term  bad1 = [\ F ->] \ g -> \ h -> g (h Nat.zero)+term  f : (b : Bool) -> T b -> T b+{ f Bool.true x = x+; f Bool.false Bool.true = Bool.false+; f Bool.false Bool.false = Bool.true+}+error during typechecking:+bad2+/// checkExpr 0 |- \ F -> \ g -> \ h -> g (h zero) : .[F : .[b : Bool] -> (T b -> T b) -> Nat -> Set] -> (g : F Bool.false (\ x -> f Bool.false x) Nat.zero -> Bool) -> (h : (n : Nat) -> F Bool.true (\ x -> f Bool.true x) n) -> Bool+/// checkForced fromList [] |- \ F -> \ g -> \ h -> g (h zero) : .[F : .[b : Bool] -> (T b -> T b) -> Nat -> Set] -> (g : F Bool.false (\ x -> f Bool.false x) Nat.zero -> Bool) -> (h : (n : Nat) -> F Bool.true (\ x -> f Bool.true x) n) -> Bool+/// new F : (.[b : Bool::Tm] -> (T b -> T b) -> Nat -> Set)+/// checkExpr 1 |- \ g -> \ h -> g (h zero) : (g : F Bool.false (\ x -> f Bool.false x) Nat.zero -> Bool) -> (h : (n : Nat) -> F Bool.true (\ x -> f Bool.true x) n) -> Bool+/// checkForced fromList [(F,0)] |- \ g -> \ h -> g (h zero) : (g : F Bool.false (\ x -> f Bool.false x) Nat.zero -> Bool) -> (h : (n : Nat) -> F Bool.true (\ x -> f Bool.true x) n) -> Bool+/// new g : ((v0 {Bool.false {F = (v0 Up (.[b : Bool::Tm] -> (T b -> T b) -> Nat -> Set))}} {\ x -> f Bool.false x {F = (v0 Up (.[b : Bool::Tm] -> (T b -> T b) -> Nat -> Set))}} {Nat.zero {F = (v0 Up (.[b : Bool::Tm] -> (T b -> T b) -> Nat -> Set))}})::Tm -> {Bool {F = (v0 Up (.[b : Bool::Tm] -> (T b -> T b) -> Nat -> Set))}})+/// checkExpr 2 |- \ h -> g (h zero) : (h : (n : Nat) -> F Bool.true (\ x -> f Bool.true x) n) -> Bool+/// checkForced fromList [(g,1),(F,0)] |- \ h -> g (h zero) : (h : (n : Nat) -> F Bool.true (\ x -> f Bool.true x) n) -> Bool+/// new h : ((n : Nat::Tm) -> F [Bool.true] (\ x -> f Bool.true x) n{g = (v1 Up ((v0 {Bool.false {F = (v0 Up (.[b : Bool::Tm] -> (T b -> T b) -> Nat -> Set))}} {\ x -> f Bool.false x {F = (v0 Up (.[b : Bool::Tm] -> (T b -> T b) -> Nat -> Set))}} {Nat.zero {F = (v0 Up (.[b : Bool::Tm] -> (T b -> T b) -> Nat -> Set))}})::Tm -> {Bool {F = (v0 Up (.[b : Bool::Tm] -> (T b -> T b) -> Nat -> Set))}})), F = (v0 Up (.[b : Bool::Tm] -> (T b -> T b) -> Nat -> Set))})+/// checkExpr 3 |- g (h zero) : Bool+/// inferExpr' g (h zero)+/// checkApp ((v0 {Bool.false {F = (v0 Up (.[b : Bool::Tm] -> (T b -> T b) -> Nat -> Set))}} {\ x -> f Bool.false x {F = (v0 Up (.[b : Bool::Tm] -> (T b -> T b) -> Nat -> Set))}} {Nat.zero {F = (v0 Up (.[b : Bool::Tm] -> (T b -> T b) -> Nat -> Set))}})::Tm -> {Bool {F = (v0 Up (.[b : Bool::Tm] -> (T b -> T b) -> Nat -> Set))}}) eliminated by h zero+/// leqVal' (subtyping)  < h n Nat.zero : F Bool.true (\ x -> f Bool.true x) Nat.zero >  <=+  F Bool.false (\ x -> f Bool.false x) Nat.zero+/// leqVal' (subtyping)  F Bool.true (\ x -> f Bool.true x) Nat.zero  <=+  F Bool.false (\ x -> f Bool.false x) Nat.zero+/// leqVal'  x : Nat -> Nat  <=*  f Bool.false x : Bool -> Bool+/// new x : Nat||Bool+/// leqVal'  x : Nat  <=*  f Bool.false x : Bool+/// type Nat has different shape than Bool
+ test/fail/IrrHeterogeneousFun.ma view
@@ -0,0 +1,65 @@+-- 2010-10-01++-- an example with different types in context during eq. checking+-- derived from Ulf's counterexample++data Bool : Set+{ true  : Bool+; false : Bool+}++data Nat : Set+{ zero : Nat+; succ : Nat -> Nat+}++fun T : Bool -> Set+{ T true  = Nat+; T false = Bool+}++fun good : +  [F : Nat -> Set] ->+  [f : [b : Bool] -> ([T b] -> Nat) -> Nat] ->+  (g : (n : Nat) -> F (f true (\ x -> n))) ->+  (h : F (f false (\ x -> zero)) -> Bool) -> +  Bool+{ good F f g h = h (g zero)+}++let good' : +    [F : [b : Bool] -> ([T b] -> Nat) -> Set] ->+    (g : F false (\ x -> zero) -> Bool) -> +    (h : (n : Nat) -> F true (\ x -> n)) ->+    Bool+  = \ F g h -> g (h zero)++-- fails with "Nat has different shape than Bool"+trustme+let bad1 : +    [F : [b : Bool] -> (T b -> T b) -> Nat -> Set] ->+    (g : F false (\ x -> x) zero -> Bool) -> +    (h : (n : Nat) -> F true (\ x -> x) n) ->+    Bool+  = \ F g h -> g (h zero)++{- compare  +    F false (\ x -> x) zero ?= F true (\ x -> x) zero+    x : Bool |- x : Bool    ?= x : Nat |- x : Nat+-}++fun f : (b : Bool) -> T b -> T b+{ f true  x     =  x+; f false true  = false+; f false  false = true+} ++-- this should of course fail+let bad2 : +    [F : [b : Bool] -> (T b -> T b) -> Nat -> Set] ->+    (g : F false (\ x -> f false x) zero -> Bool) -> +    (h : (n : Nat) -> F true (\ x -> f true x) n) ->+    Bool+  = \ F g h -> g (h zero)++
+ test/fail/Makefile view
@@ -0,0 +1,101 @@+# MiniAgda+# Makefile for failing tests+# Author: Andreas Abel+# Created: 2004-12-06, 2008-09-03++# How this file works+# ===================+#+# Whenever a .ma file is modified,+# a corresponding .err file is generated to save the model error message+# for this file.  When the test suite is processed the next time, e.g.,+# after some hacking on the MiniAgda implementation, the new error message+# is compared to the saved one.  If they do not match, this is considered+# an error.  Then one has to verify the new error message is actually the+# intended one (manually), and remove the .err file.++mugda=../../Main++# Enable read -n+SHELL=bash++# Getting all agda files+allagda=$(shell find . -name '*.ma')+allstems=$(patsubst %.ma,%,$(allagda))+allout=$(patsubst %.ma,%.err,$(allagda))++.PHONY : $(allstems)++default : all+all : $(allstems)++debug : +	@echo $(allagda)++# No error recorded++$(allout) : %.err : %.ma+	@echo "----------------------------------------------------------------------"+	@echo "$*.ma"+	@echo "----------------------------------------------------------------------"+	@if $(mugda) $(shell if [ -e $*.flags ]; then cat $*.flags; fi) $< > $*.tmp; \+		then echo "Unexpected success"; rm -f $*.tmp; false; \+    else if [ -s $*.tmp ]; \+				 then sed -e "s/[^ ]*test.fail.//g" $*.tmp > $@; cat $@; rm -f $*.tmp; true; \+				 else rm -f $@ $*.tmp; false; \+				 fi; \+		fi++# Existing error+++#				 echo `cat $*.err` > $*.tmp.2; \+#				 echo `cat $*.tmp` > $*.tmp.3; \++# NO WITH SPACES AFTER \ AT END OF LINE++$(allstems) : % : %.err+	@echo "----------------------------------------------------------------------"+	@echo "$*.ma"+	@echo "----------------------------------------------------------------------"+	@if $(mugda) $(shell if [ -e $*.flags ]; then cat $*.flags; fi) $*.ma \+		 > $*.tmp.2; \+		then echo "Unexpected success"; rm -f $*.tmp.2; false; \+    else sed -e "s/[^ ]*test.fail.//g" $*.tmp.2 > $*.tmp; \+				 echo `tail -1 $*.err` > $*.tmp.2; \+				 echo `tail -1 $*.tmp` > $*.tmp.3; \+				 true; \+		fi;+	@if cmp $*.tmp.2 $*.tmp.3; \+	   then if cmp $*.tmp $*.err; \+                   then rm -f $*.tmp $*.tmp.2 $*.tmp.3; true; \+                   else mv $*.tmp $*.err; \+                        rm -f $*.tmp.2 $*.tmp.3; true; \+                fi; \+	   else echo "== Old error ==="; \+		cat $*.err; \+		echo "== New error ==="; \+		cat $*.tmp; \+		/bin/echo -n "Accept new error [y/N]? "; \+		read -n 1; \+		echo ""; \+		if [ "fckShPrg$$REPLY" != "fckShPrgy"  ]; \+                  then echo "Keeping old error"; false; \+		  else echo "Replacing error, continuing..."; \+                    mv $*.tmp $*.err; \+		    rm -f $*.tmp.2 $*.tmp.3; true; \+                fi; \+	    fi++# CAUTION: NO SPACE AFTER \+# RETARDED!!!!!!!++#		echo rm -f $*.tmp; echo rm -f $*.tmp.2; \+#		false; ++# Clean++clean :+	-rm -f *.err *.tmp *.tmp.* *~ adm/*.err adm/*.tmp*++# EOF
+ test/fail/MeasureInTelescope.err view
@@ -0,0 +1,3 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "MeasureInTelescope.ma" ---+--- scope checking ---
+ test/fail/MeasureInTelescope.ma view
@@ -0,0 +1,4 @@+-- 2012-01-12++let [i : Size] |i| = i+-- should give a parse or scope checking error
+ test/fail/MeasureInValue.err view
@@ -0,0 +1,5 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "MeasureInValue.ma" ---+--- scope checking ---+scope check error: f+/// measure not allowed in expression (|i| -> CoSet 0)
+ test/fail/MeasureInValue.ma view
@@ -0,0 +1,10 @@+-- 2010-07-17 ++-- measures can only appear in fun-decls+-- caught by the scope-checker++fun f : (i,j : Size) -> |i| -> Set 1 +{ f i j = |i| -> Set+}++
+ test/fail/MeasuresTypo.err view
@@ -0,0 +1,26 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "MeasuresTypo.ma" ---+--- scope checking ---+--- type checking ---+type  Bool : Set+term  Bool.true : < Bool.true : Bool >+term  Bool.false : < Bool.false : Bool >+type  N : Set+term  N.zz : < N.zz : N >+term  N.ss : ^(y0 : N) -> < N.ss y0 : N >+type  Nat : + Size -> Set+term  Nat.zero : .[s!ze : Size] -> .[i < s!ze] -> Nat s!ze+term  Nat.zero : .[i : Size] -> < Nat.zero i : Nat $i >+term  Nat.succ : .[s!ze : Size] -> .[i < s!ze] -> ^ Nat i -> Nat s!ze+term  Nat.succ : .[i : Size] -> ^(y1 : Nat i) -> < Nat.succ i y1 : Nat $i >+term  even : .[i : Size] -> Nat i -> Bool+term  even' : .[i : Size] -> Nat i -> Bool+term  odd' : .[i : Size] -> Nat i -> Bool+error during typechecking:+even'+/// clause 2+/// right hand side+/// checkExpr 3 |- odd' i n : Bool+/// inferExpr' odd' i n+/// checkGuard |i,0| < |i,0|+/// lexSizes: no descent detected
+ test/fail/MeasuresTypo.ma view
@@ -0,0 +1,33 @@+-- 2010-07-26 explicit measures++data Bool : Set+{ true : Bool+; false : Bool+}++data N : Set+{ zz : N+; ss : N -> N+}++sized data Nat : Size -> Set+{ zero : [i : Size] -> Nat ($ i)+; succ : [i : Size] -> Nat i -> Nat ($ i)+}++mutual {++  fun even  : [i : Size] -> |i,$0| -> Nat i -> Bool+  { even i n = even' i n+  }++  fun even' : [i : Size] -> |i,0|  -> Nat i -> Bool+  { even' i (zero (i > j))   = true+  ; even' i (succ (i > j) n) = odd' i n  -- typo here, should be j+  } ++  fun odd'  : [i : Size] -> |i,0|  -> Nat i -> Bool+  { odd' i (zero (i > j))   = false+  ; odd' i (succ (i > j) n) = even j n+  } +}
+ test/fail/MixedMeasureLength.err view
@@ -0,0 +1,4 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "MixedMeasureLength.ma" ---+--- scope checking ---+scope check error: in a mutual function block, either all functions must be without measure or have a measure of the same length
+ test/fail/MixedMeasureLength.ma view
@@ -0,0 +1,10 @@+-- 2010-07-17 ++-- measured functions need to have the same length measure+-- caught by the scope-checker++mutual {+  fun f : (i,j : Size) -> |i| -> Set {}+  fun g : (i,j : Size) -> |i,j| -> Set {}+}+
+ test/fail/MixedMeasuredUnmeasured.err view
@@ -0,0 +1,4 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "MixedMeasuredUnmeasured.ma" ---+--- scope checking ---+scope check error: in a mutual function block, either all functions must be without measure or have a measure of the same length
+ test/fail/MixedMeasuredUnmeasured.ma view
@@ -0,0 +1,10 @@+-- 2010-07-17 ++-- mixing measured functions with unmeasured is illegal, +-- caught by the scope-checker++mutual {+  fun f : (i : Size) -> |i| -> Set {}+  fun g : (i : Size) -> Set {}+}+
+ test/fail/MuOnlyPosNotSPos.err view
@@ -0,0 +1,19 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "MuOnlyPosNotSPos.ma" ---+--- scope checking ---+--- type checking ---+type  Mu : ++(F : + Set -> Set) -> Set+error during typechecking:+Mu+/// constructor Mu.inn+/// new Mu : (++(F : (+Set -> Set)::Set) -> Set)+/// new F : (+Set -> {Set {Mu = (v0 Up (++(F : (+Set -> Set)::Set) -> Set))}})+/// inferExpr' ^ F (Mu F) -> Mu F+/// inferExpr' F (Mu F)+/// checkApp (+Set -> {Set {Mu = (v0 Up (++(F : (+Set -> Set)::Set) -> Set))}}) eliminated by Mu F+/// inferExpr' Mu F+/// checkApp (++(F : (+Set -> Set)::Set) -> Set) eliminated by F+/// inferExpr' F+/// inferExpr: variable F : + Set -> Set may not occur+/// , because of polarity+/// polarity check ++ <= + failed
+ test/fail/MuOnlyPosNotSPos.ma view
@@ -0,0 +1,6 @@+-- 2010-06-20++-- F needs to be ++ (spos) not just pos+data Mu ++(F : +Set -> Set) : Set+{ inn : F (Mu F) -> Mu F+}
+ test/fail/MustBeCofun.err view
@@ -0,0 +1,13 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "MustBeCofun.ma" ---+--- scope checking ---+--- type checking ---+type  CoList : ^(A : Set) -> - Size -> Set+term  CoList.conil : .[A : Set] -> .[i : Size] -> < CoList.conil i : CoList A $i >+term  CoList.cocons : .[A : Set] -> .[i : Size] -> ^(y1 : A) -> ^(y2 : CoList A i) -> < CoList.cocons i y1 y2 : CoList A $i >+term  repeat : .[A : Set] -> (a : A) -> .[i : Size] -> CoList A i+error during typechecking:+repeat+/// clause 1+/// pattern $i+/// successor pattern only allowed in cofun
+ test/fail/MustBeCofun.ma view
@@ -0,0 +1,14 @@+-- 2010-08-18++sized codata CoList (A : Set) : Size -> Set +{ conil  : [i : Size] -> CoList A $i+; cocons : [i : Size] -> A -> CoList A i -> CoList A $i+}++-- the following declaration must be cofun otherwise non-termination+fun repeat : [A : Set] -> (a : A) -> [i : Size] -> CoList A i+{ repeat A a ($ i) = cocons A i a (repeat A a i)+}++data Unit : Set { unit : Unit }+eval let units : CoList Unit # = repeat Unit unit #
+ test/fail/MutualDataNotMon.err view
@@ -0,0 +1,22 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "MutualDataNotMon.ma" ---+--- scope checking ---+--- type checking ---+type  L : +(A : Set) -> Set+term  L.l1 : .[A : Set] -> ^(y0 : A) -> ^(y1 : L A) -> < L.l1 y0 y1 : L A >+term  L.l2 : .[A : Set] -> ^(y0 : T A) -> < L.l2 y0 : L A >+type  T : +(A : Set) -> Set+term  T.t1 : .[A : Set] -> ^(y0 : L A) -> < T.t1 y0 : T A >+error during typechecking:+new L : (+(A : Set) -> Set)+/// new T : (+(A : Set) -> Set{L = (v0 Up (+(A : Set) -> Set))})+/// T+/// constructor T.t2+/// new T : (+(A : Set) -> Set{T = (v1 Up (+(A : Set) -> Set{L = (v0 Up (+(A : Set) -> Set))})), L = (v0 Up (+(A : Set) -> Set))})+/// new A : Set+/// inferExpr' ^ (A -> T A) -> T A+/// inferExpr' A -> T A+/// inferExpr' A+/// inferExpr: variable A : Set may not occur+/// , because of polarity+/// polarity check + <= - failed
+ test/fail/MutualDataNotMon.ma view
@@ -0,0 +1,15 @@+-- 2010-08-31++mutual {++  data L +(A : Set) : Set +  { l1 : A -> L A -> L A+  ; l2 : T A -> L A+  }++  data T +(A : Set) : Set+  { t1 : L A -> T A+  ; t2 : (A -> T A) -> T A+  }++}
+ test/fail/MutualNeg.err view
@@ -0,0 +1,11 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "MutualNeg.ma" ---+--- scope checking ---+--- type checking ---+type  D : Set+term  D.absD : ^(y0 : E -> D) -> < D.absD y0 : D >+type  E : Set+term  E.absE : ^(y0 : D -> E) -> < E.absE y0 : E >+error during typechecking:+checking positivity+/// polarity check ++ <= + failed
+ test/fail/MutualNeg.ma view
@@ -0,0 +1,10 @@+-- 2010-08-30++-- this is positive, but not strictly positive++mutual {++  data D : Set { absD : (E -> D) -> D }+  data E : Set { absE : (D -> E) -> E }++}
+ test/fail/MutualNeg2.err view
@@ -0,0 +1,11 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "MutualNeg2.ma" ---+--- scope checking ---+--- type checking ---+type  D : Set+term  D.absD : ^(y0 : E -> D) -> < D.absD y0 : D >+type  E : Set+term  E.inE : ^(y0 : D) -> < E.inE y0 : E >+error during typechecking:+checking positivity+/// polarity check ++ <= - failed
+ test/fail/MutualNeg2.ma view
@@ -0,0 +1,10 @@+-- 2010-08-30++-- this is negative++mutual {++  data D : Set { absD : (E -> D) -> D }+  data E : Set { inE  : D -> E }++}
+ test/fail/NatToSize.err view
@@ -0,0 +1,17 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "NatToSize.ma" ---+--- scope checking ---+--- type checking ---+type  Nat : Set+term  Nat.zero : < Nat.zero : Nat >+term  Nat.suc : ^(y0 : Nat) -> < Nat.suc y0 : Nat >+size  toSize : Nat -> Size+{ toSize Nat.zero = 0+; toSize (Nat.suc n) = $(toSize n)+}+size  toSizeNT : Nat -> Size+{ toSizeNT Nat.zero = 0+; toSizeNT (Nat.suc n) = $(toSizeNT (Nat.suc n))+}+error during typechecking:+Termination check for function toSizeNT fails
+ test/fail/NatToSize.ma view
@@ -0,0 +1,16 @@+-- 2010-11-01++data Nat : Set +{ zero : Nat+; suc : Nat -> Nat+}++fun toSize : Nat -> Size+{ toSize zero = 0+; toSize (suc n) = $(toSize n)+}++fun toSizeNT : Nat -> Size+{ toSizeNT zero = 0+; toSizeNT (suc n) = $(toSizeNT (suc n))+}
+ test/fail/NegPol.err view
@@ -0,0 +1,16 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "NegPol.ma" ---+--- scope checking ---+--- type checking ---+error during typechecking:+U+/// checkExpr 0 |- \ X -> X -> X : + Set -> Set+/// checkForced fromList [] |- \ X -> X -> X : + Set -> Set+/// new X : Set+/// checkExpr 1 |- X -> X : Set+/// checkForced fromList [(X,0)] |- X -> X : Set+/// inferExpr' X -> X+/// inferExpr' X+/// inferExpr: variable X : Set may not occur+/// , because of polarity+/// polarity check + <= - failed
+ test/fail/NegPol.ma view
@@ -0,0 +1,4 @@+-- 2010-08-19+let U : +Set -> Set+      = \ X -> X -> X+
+ test/fail/NonLinearParameter.err view
@@ -0,0 +1,16 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "NonLinearParameter.ma" ---+--- scope checking ---+--- type checking ---+type  Prod : ^(A : Set) -> ^(B : Set) -> Set+term  Prod.pair : .[A : Set] -> .[B : Set] -> ^(a : A) -> ^(b : B) -> < Prod.pair a b : Prod A B >+term  a : .[A : Set] -> .[B : Set] -> (pair : Prod A B) -> A+{ a [A] [B] (Prod.pair #a #b) = #a+}+term  b : .[A : Set] -> .[B : Set] -> (pair : Prod A B) -> B+{ b [A] [B] (Prod.pair #a #b) = #b+}+type  D : ^(A : Set 1) -> Set+error during typechecking:+D+/// expected parameter to be a pattern, but I found [Prod A A]
+ test/fail/NonLinearParameter.ma view
@@ -0,0 +1,6 @@+-- 2013-04-05++data Prod (A, B : Set) { pair (a : A) (b : B) }++data D (A : Set 1)+{ c : D (Prod A A) } -- not a pattern, currenlty not accepted
+ test/fail/NonLinearParameterPattern.err view
@@ -0,0 +1,33 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "NonLinearParameterPattern.ma" ---+--- scope checking ---+--- type checking ---+type  Bool : Set+term  Bool.false : < Bool.false : Bool >+term  Bool.true : < Bool.true : Bool >+type  D : ^(x : Bool) -> ^(y : Bool) -> Set+term  D.c : .[x : Bool] -> .[x : Bool] -> < D.c : D x x >+type  g : D Bool.true Bool.true -> Set+{ g D.c = Bool+}+type  f : D Bool.true Bool.false -> Set+block fails as expected, error message:+f+/// clause 1+/// pattern c+/// instConLType'+/// instConType:+cannot match parameters [Bool.true, Bool.false]+against patterns [x, x]+when instantiating type .[x : Bool] -> .[x : Bool] -> < D.c : D x x >+of constructor D.c+error during typechecking:+v+/// checkExpr 0 |- c : D Bool.true Bool.false+/// checkForced fromList [] |- c : D Bool.true Bool.false+/// instConLType'+/// instConType:+cannot match parameters [Bool.true, Bool.false]+against patterns [x, x]+when instantiating type .[x : Bool] -> .[x : Bool] -> < D.c : D x x >+of constructor D.c
+ test/fail/NonLinearParameterPattern.ma view
@@ -0,0 +1,15 @@+data Bool { false ; true }++data D (x, y : Bool)+{ c : D x x }++fun g : D true true -> Set+{ g c = Bool }++fail+fun f : D true false -> Set+{ f c = Bool }+-- should not match!++let v : D true false = c+-- should also fail
+ test/fail/NonLinearPatterns.err view
@@ -0,0 +1,5 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "NonLinearPatterns.ma" ---+--- scope checking ---+scope check error: nonlin+/// pattern not linear: X
+ test/fail/NonLinearPatterns.ma view
@@ -0,0 +1,3 @@+fun nonlin : Set -> Set -> Set+{ nonlin X X = X+}
+ test/fail/NonPosBoundedData.err view
@@ -0,0 +1,21 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "NonPosBoundedData.ma" ---+--- scope checking ---+--- type checking ---+type  D : +(i : Size) -> Set+{ D i = .[j < i] & D j -> D j+}+type  D : +(i : Size) -> Set+error during typechecking:+D+/// clause 1+/// right hand side+/// checkExpr 1 |- (.[j < i] & D j) -> .[j < i] & D j : Set+/// checkForced fromList [(i,0)] |- (.[j < i] & D j) -> .[j < i] & D j : Set+/// inferExpr' (.[j < i] & D j) -> .[j < i] & D j+/// inferExpr' .[j < i] & D j+/// inferExpr' < i+/// inferExpr' i+/// inferExpr: variable i : Size may not occur+/// , because of polarity+/// polarity check + <= - failed
+ test/fail/NonPosBoundedData.ma view
@@ -0,0 +1,15 @@+-- 2012-02-04++-- Putting the bound on the outside ensures positivity+check+cofun D : +(i : Size) -> Set+{ D i = [j < i] & (D j -> D j)+}++-- If we place the bound directly before the recursive occurrence+-- we need strictly positive functionals++cofun D : +(i : Size) -> Set+{ D i = [j < i] & D j -> [j < i] & D j+}+-- fails
+ test/fail/NotEnoughParameters.err view
@@ -0,0 +1,6 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "NotEnoughParameters.ma" ---+--- scope checking ---+scope check error: D+/// c+/// constructor c: target (D A) is missing parameters
+ test/fail/NotEnoughParameters.ma view
@@ -0,0 +1,3 @@+-- 2013-04-05++data D (A, B : Set) { c : D A }
+ test/fail/NotForcedConstructors.err view
@@ -0,0 +1,20 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "NotForcedConstructors.ma" ---+--- scope checking ---+--- type checking ---+type  Bool : Set+term  Bool.true : < Bool.true : Bool >+term  Bool.false : < Bool.false : Bool >+term  not : Bool -> Bool+{ not Bool.true = Bool.false+; not Bool.false = Bool.true+}+type  Nat : ^ Bool -> Set+term  Nat.zero : < Nat.zero : Nat Bool.true >+term  Nat.succ : ^(b : Bool) -> ^(y1 : Nat b) -> < Nat.succ b y1 : Nat (not b) >+term  f : (b : Bool) -> .[Nat b] -> Bool+error during typechecking:+f+/// clause 1+/// pattern zero+/// checkPattern: constructor Nat.zero of non-computational argument zero : (Nat Bool.true{}) not forced
+ test/fail/NotForcedConstructors.ma view
@@ -0,0 +1,19 @@+data Bool : Set+{ true : Bool+; false : Bool+}++fun not : Bool -> Bool+{ not true = false+; not false = true+}++data Nat : Bool -> Set+{ zero : Nat true+; succ : (b : Bool) -> Nat b -> Nat (not b)+}++fun f : (b : Bool) -> [Nat b] -> Bool+{ f true zero = true+; f false (succ n) = false+}
+ test/fail/NumbersAsIds.err view
@@ -0,0 +1,3 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "NumbersAsIds.ma" ---+--- scope checking ---
+ test/fail/NumbersAsIds.ma view
@@ -0,0 +1,7 @@+--2010-06-25 feature "numbers as ids" removed, numbers are now sizes+data 3 : Set +{ 0 : 3+; 1 : 3+; 2 : 3+}+
+ test/fail/OverlappingPatternIndFam-sound.err view
@@ -0,0 +1,32 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "OverlappingPatternIndFam-sound.ma" ---+--- scope checking ---+--- type checking ---+type  Bool : Set+term  Bool.true : < Bool.true : Bool >+term  Bool.false : < Bool.false : Bool >+type  Id : ^(A : Set) -> ^(a : A) -> ^ A -> Set+term  Id.refl : .[A : Set] -> .[a : A] -> < Id.refl : Id A a a >+term  subst : .[A : Set] -> (a : A) -> (b : A) -> Id A a b -> .[P : A -> Set] -> P a -> P b+{ subst [A] a .a Id.refl [P] x = x+}+type  DecEq : ^(A : Set) -> ^(a : A) -> ^ A -> Set+term  DecEq.eq : .[A : Set] -> .[a : A] -> < DecEq.eq : DecEq A a a >+term  DecEq.notEq : .[A : Set] -> .[a : A] -> .[b : A] -> < DecEq.notEq b : DecEq A a b >+error during typechecking:+fDiag+/// checkExpr 0 |- \ f -> \ A -> \ a -> refl : (f : .[A : Set] -> (a : A) -> (b : A) -> DecEq A a b) -> .[A : Set] -> (a : A) -> Id (DecEq A a a) (f [A] a a) DecEq.eq+/// checkForced fromList [] |- \ f -> \ A -> \ a -> refl : (f : .[A : Set] -> (a : A) -> (b : A) -> DecEq A a b) -> .[A : Set] -> (a : A) -> Id (DecEq A a a) (f [A] a a) DecEq.eq+/// new f : (.[A : Set] -> (a : A) -> (b : A) -> DecEq A a b)+/// checkExpr 1 |- \ A -> \ a -> refl : .[A : Set] -> (a : A) -> Id (DecEq A a a) (f A a b [A] a a) DecEq.eq+/// checkForced fromList [(f,0)] |- \ A -> \ a -> refl : .[A : Set] -> (a : A) -> Id (DecEq A a a) (f A a b [A] a a) DecEq.eq+/// new A : Set+/// checkExpr 2 |- \ a -> refl : (a : A) -> Id (DecEq A a a) (f A a b [A] a a) DecEq.eq+/// checkForced fromList [(A,1),(f,0)] |- \ a -> refl : (a : A) -> Id (DecEq A a a) (f A a b [A] a a) DecEq.eq+/// new a : v1+/// checkExpr 3 |- refl : Id (DecEq A a a) (f A a b [A] a a) DecEq.eq+/// checkForced fromList [(A,1),(f,0),(a,2)] |- refl : Id (DecEq A a a) (f A a b [A] a a) DecEq.eq+/// leqVal' (subtyping)  < Id.refl : Id (DecEq A a a) (f A a b [A] a a) (f A a b [A] a a) >  <=+  Id (DecEq A a a) (f A a b [A] a a) DecEq.eq+/// leqVal' (subtyping)  Id (DecEq A a a) (f A a b [A] a a) (f A a b [A] a a)  <=+  Id (DecEq A a a) (f A a b [A] a a) DecEq.eq+/// leqVal'  f A a a  <=^  DecEq.eq : DecEq A a a+/// leqApp: head mismatch f != DecEq.eq
+ test/fail/OverlappingPatternIndFam-sound.ma view
@@ -0,0 +1,28 @@+data Bool : Set+{ true  : Bool+; false : Bool+}++data Id (A : Set) (a : A) : A -> Set +{ refl : Id A a a +}++fun subst : (A : Set) -> (a : A) -> (b : A) -> Id A a b -> +  (P : A -> Set) -> P a -> P b+{ subst A a .a refl P x = x+}++-- an overlapping ind. fam.+data DecEq (A : Set)(a : A) : A -> Set +{ eq    : DecEq A a a+; notEq : (b : A) -> DecEq A a b+}++-- this rightfully does not type check, since f A a a does not expand to eq+-- (both patterns match)+let fDiag : (f : (A : Set) -> (a : A) -> (b : A) -> DecEq A a b) ->+             (A : Set) -> (a : A) -> Id (DecEq A a a) (f A a a) eq+  = \ f -> \ A -> \ a -> refl++let incons : (A : Set) -> (a : A) -> Id (DecEq A a a) (notEq a) eq+  = fDiag notEq
+ test/fail/OverlappingPatternIndFam.err view
@@ -0,0 +1,34 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "OverlappingPatternIndFam.ma" ---+--- scope checking ---+--- type checking ---+type  Bool : Set+term  Bool.true : < Bool.true : Bool >+term  Bool.false : < Bool.false : Bool >+type  Id : ^(A : Set) -> ^(a : A) -> ^ A -> Set+term  Id.refl : .[A : Set] -> .[a : A] -> < Id.refl : Id A a a >+term  subst : .[A : Set] -> (a : A) -> (b : A) -> Id A a b -> .[P : A -> Set] -> P a -> P b+{ subst [A] a .a Id.refl [P] x = x+}+type  DecEq : ^(A : Set) -> ^(a : A) -> ^ A -> Set+term  DecEq.eq : .[A : Set] -> .[a : A] -> < DecEq.eq : DecEq A a a >+term  DecEq.notEq : .[A : Set] -> .[a : A] -> .[b : A] -> < DecEq.notEq b : DecEq A a b >+error during typechecking:+offDiag+/// not a type: (A : Set) -> (f : (a : A) -> (b : A) -> DecEq A a b) -> (a : A) -> (b : A) -> Id (DecEq A a b) (f a b) (notEq A a b)+/// inferExpr' (A : Set) -> (f : (a : A) -> (b : A) -> DecEq A a b) -> (a : A) -> (b : A) -> Id (DecEq A a b) (f a b) (notEq A a b)+/// new A : Set+/// inferExpr' (f : (a : A) -> (b : A) -> DecEq A a b) -> (a : A) -> (b : A) -> Id (DecEq A a b) (f a b) (notEq A a b)+/// new f : ((a : v0::Tm) -> (b : A) -> DecEq A a b{A = v0})+/// inferExpr' (a : A) -> (b : A) -> Id (DecEq A a b) (f a b) (notEq A a b)+/// new a : v0+/// inferExpr' (b : A) -> Id (DecEq A a b) (f a b) (notEq A a b)+/// new b : v0+/// inferExpr' Id (DecEq A a b) (f a b) (notEq A a b)+/// checkApp (^(DecEq v0 v2 v3)::Tm -> {Set {a = (v1 v2 v3), A = (DecEq v0 v2 v3)}}) eliminated by notEq A a b+/// checkExpr 4 |- notEq A a b : DecEq A a b+/// checkForced fromList [(A,0),(f,1),(a,2),(b,3)] |- notEq A a b : DecEq A a b+/// checkApp (.[b : v0::Tm] -> < DecEq.notEq b : DecEq A a b >{a = v2, A = v0}) eliminated by A+/// leqVal' (subtyping)  < A : Set >  <=+  A+/// leqVal' (subtyping)  Set  <=+  A+/// leqApp: head mismatch Set != A
+ test/fail/OverlappingPatternIndFam.ma view
@@ -0,0 +1,43 @@+-- 2009-09-19 +-- unsound eta-expansion as noted by Anton Setzer++data Bool : Set+{ true  : Bool+; false : Bool+}++data Id (A : Set) (a : A) : A -> Set +{ refl : Id A a a +}++fun subst : (A : Set) -> (a : A) -> (b : A) -> Id A a b -> +  (P : A -> Set) -> P a -> P b+{ subst A a .a (refl) P x = x+}++-- an overlapping ind. fam.+data DecEq (A : Set)(a : A) : A -> Set +{ eq    : DecEq A a a+; notEq : (b : A) -> DecEq A a b+}++-- every function into DecEq is the constant notEq one+-- that is provable in the current implementation of eta, but is unsound+let offDiag : (A : Set) -> (f : (a : A) -> (b : A) -> DecEq A a b) ->+              (a : A) -> (b : A) -> +              Id (DecEq A a b) (f a b) (notEq A a b)+  = \ A -> \ f -> \ a -> \ b -> refl -- (DecEq A a b) (notEq A a b)++-- let incons : (A : Set) -> (a : A) -> Id (DecEq A a a) (eq A a) (notEq A a a)+--   = \ A -> \ a -> offDiag (\ A' -> \ a' -> \ b -> eq A' a') A a a ++fun f : (x : Bool) -> (y : Bool) -> DecEq Bool x y+{ f true true = eq Bool true+; f true false = notEq Bool true false+; f false true = notEq Bool false true+; f false false = eq Bool false+}++-- now we can show that two constructors are equal+let incons : Id (DecEq Bool true true) (eq Bool true) (notEq Bool true true)+ = offDiag Bool f true true
+ test/fail/PolarityWrongCast.err view
@@ -0,0 +1,35 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "PolarityWrongCast.ma" ---+--- scope checking ---+--- type checking ---+type  DNeg : Set -> + Set -> Set+type  DNeg = \ B -> \ A -> (A -> B) -> B+type  Empty : Set+type  Nat : + Size -> Set+term  Nat.zero : .[s!ze : Size] -> .[i < s!ze] -> Nat s!ze+term  Nat.zero : .[i : Size] -> < Nat.zero i : Nat $i >+term  Nat.succ : .[s!ze : Size] -> .[i < s!ze] -> ^ Nat i -> Nat s!ze+term  Nat.succ : .[i : Size] -> ^(y1 : Nat i) -> < Nat.succ i y1 : Nat $i >+type  Id : Nat # -> ++ Set -> Set+{ Id (Nat.zero [.#]) A = A+; Id (Nat.succ [.#] n) A = A+}+error during typechecking:+kast+/// checkExpr 0 |- \ i -> \ n -> \ x -> x : .[i : Size] -> .[n : Nat i] -> Id n (Nat #) -> Id n (Nat i)+/// checkForced fromList [] |- \ i -> \ n -> \ x -> x : .[i : Size] -> .[n : Nat i] -> Id n (Nat #) -> Id n (Nat i)+/// new i <= #+/// checkExpr 1 |- \ n -> \ x -> x : .[n : Nat i] -> Id n (Nat #) -> Id n (Nat i)+/// checkForced fromList [(i,0)] |- \ n -> \ x -> x : .[n : Nat i] -> Id n (Nat #) -> Id n (Nat i)+/// new n : (Nat v0)+/// checkExpr 2 |- \ x -> x : Id n (Nat #) -> Id n (Nat i)+/// checkForced fromList [(n,1),(i,0)] |- \ x -> x : Id n (Nat #) -> Id n (Nat i)+/// new x : (Id v1 {Nat # {n = v1, i = v0}})+/// checkExpr 3 |- x : Id n (Nat i)+/// leqVal' (subtyping)  < x : Id n (Nat #) >  <=+  Id n (Nat i)+/// leqVal' (subtyping)  Id n (Nat #)  <=+  Id n (Nat i)+/// leqVal'  Nat #  <=+  Nat i : Set+/// leqVal'  #  <=+  i : Size+/// leSize # <=+ i+/// leSize' # <= i+/// leSize: # + 0 <= i failed
+ test/fail/PolarityWrongCast.ma view
@@ -0,0 +1,22 @@+-- 2010-06-19++let DNeg : Set -> +Set -> Set+         = \ B -> \ A -> (A -> B) -> B++data Empty : Set {}++sized data Nat : Size -> Set+{ zero : [i : Size] -> Nat ($ i)+; succ : [i : Size] -> Nat i -> Nat ($ i)+}++-- hide positivity behind recursion+fun Id : Nat # -> ++Set -> Set+{ Id (zero .#)   A = A+; Id (succ .# n) A = A+}++-- SUBTYPING the wrong way round+let kast : [i : Size] -> [n : Nat i] -> Id n (Nat #) -> Id n (Nat i)+         = \ i -> \ n -> \ x -> x+
+ test/fail/RecurseOnErased.err view
@@ -0,0 +1,13 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "RecurseOnErased.ma" ---+--- scope checking ---+--- type checking ---+type  Nat : Set+term  Nat.zero : < Nat.zero : Nat >+term  Nat.succ : ^(y0 : Nat) -> < Nat.succ y0 : Nat >+term  f : .[Nat] -> Nat -> Nat+error during typechecking:+f+/// clause 1+/// pattern zero+/// checkPattern: constructor Nat.zero of non-computational argument zero : Nat not forced
+ test/fail/RecurseOnErased.ma view
@@ -0,0 +1,21 @@+data Nat : Set+{ zero : Nat+; succ : Nat -> Nat+}++-- matching on irrelevant arguments needs to be forbidden+fun f : [Nat] -> Nat -> Nat+{ f zero n = n  -- this should not be allowed!+; f m zero = zero+; f m (succ n) = n+}++data Id (A : Set) (a : A) : A -> Set+{ refl : Id A a a+}++-- because of irrelevance of first argument of f+-- this should hold:+let p1 : (n : Nat) -> Id Nat (f zero n) (f (succ zero) n)+       = \ n -> refl Nat (f zero n)+
+ test/fail/ResurrectFromErasedPattern.err view
@@ -0,0 +1,24 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "ResurrectFromErasedPattern.ma" ---+--- scope checking ---+--- type checking ---+type  Bool : Set+term  Bool.true : < Bool.true : Bool >+term  Bool.false : < Bool.false : Bool >+type  Nat : ^ Bool -> Set+term  Nat.zero : < Nat.zero : Nat Bool.true >+term  Nat.succ : .[b : Bool] -> ^(y1 : Nat b) -> < Nat.succ b y1 : Nat Bool.false >+term  f : (b : Bool) -> .[Nat b] -> Nat Bool.false+error during typechecking:+f+/// clause 2+/// right hand side+/// checkExpr 2 |- succ false (succ b n) : Nat Bool.false+/// checkForced fromList [(n,1),(b,0)] |- succ false (succ b n) : Nat Bool.false+/// checkApp (^(y1 : (Nat Bool.false{})::()) -> < Nat.succ b y1 : Nat Bool.false >{b = Bool.false{}}) eliminated by succ b n+/// checkExpr 2 |- succ b n : Nat Bool.false+/// checkForced fromList [(n,1),(b,0)] |- succ b n : Nat Bool.false+/// checkApp (^(y1 : (Nat v0)::()) -> < Nat.succ b y1 : Nat Bool.false >{b = v0}) eliminated by n+/// inferExpr' n+/// inferExpr: variable n : Nat b may not occur+/// , because it is marked as erased
+ test/fail/ResurrectFromErasedPattern.ma view
@@ -0,0 +1,14 @@+data Bool : Set+{ true : Bool+; false : Bool+}++data Nat : Bool -> Set+{ zero : Nat true+; succ : [b : Bool] -> Nat b -> Nat false+}++fun f : (b : Bool) -> [Nat b] -> Nat false+{ f true zero = succ true zero+; f false (succ b n) = succ false (succ b n)+}
+ test/fail/SPosNotPos.err view
@@ -0,0 +1,20 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "SPosNotPos.ma" ---+--- scope checking ---+--- type checking ---+error during typechecking:+DNeg+/// checkExpr 0 |- \ B -> \ A -> (A -> B) -> B : Set -> ++ Set -> Set+/// checkForced fromList [] |- \ B -> \ A -> (A -> B) -> B : Set -> ++ Set -> Set+/// new B : Set+/// checkExpr 1 |- \ A -> (A -> B) -> B : ++ Set -> Set+/// checkForced fromList [(B,0)] |- \ A -> (A -> B) -> B : ++ Set -> Set+/// new A : Set+/// checkExpr 2 |- (A -> B) -> B : Set+/// checkForced fromList [(A,1),(B,0)] |- (A -> B) -> B : Set+/// inferExpr' (A -> B) -> B+/// inferExpr' A -> B+/// inferExpr' A+/// inferExpr: variable A : Set may not occur+/// , because of polarity+/// polarity check ++ <= + failed
+ test/fail/SPosNotPos.ma view
@@ -0,0 +1,6 @@+-- 2010-06-19++-- A only pos, not strictly pos.++let DNeg : Set -> ++Set -> Set+         = \ B -> \ A -> (A -> B) -> B
+ test/fail/ShadowBinding.err view
@@ -0,0 +1,4 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "ShadowBinding.ma" ---+--- scope checking ---+scope check error: (let A = A in A): Identifier A already in context
+ test/fail/ShadowBinding.ma view
@@ -0,0 +1,42 @@+-- 2013-04-06++fail+fun Bla1 : (A, A : Set) -> Set+{ Bla1 A B = A+}++fail+fun Bla2 : (A, B : Set) -> Set+{ Bla2 = \ A A -> A+}++fail+fun Bla1' : (A : Set) -> (A : Set) -> Set+{ Bla1' A B = A+}++check+let Bla3 (A : Set) : (A : Set) -> Set = \ B -> A++fail+let Bla3 (A : Set) (A : Set) : Set = A++check+let Bla4 (A : Set) : Set -> Set = \ A -> A++fail+let Bla5 : Set -> Set -> Set = \ A A -> A++fail+let Bla6 : Set -> Set -> Set1 = \ A A -> Set++fail+let Hurz : Set = \ M i s s i s s i p p i -> i++check+let Bla7 (A : Set) : Set =+  let A = A in A++let Bla7 (A : Set) : Set =+  let A = A in+  let A = A in A
+ test/fail/ShadowParameter.err view
@@ -0,0 +1,6 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "ShadowParameter.ma" ---+--- scope checking ---+scope check error: Sg+/// sg+/// TBind {boundDec = Dec {thePolarity = ^}, boundNames = [n], boundType = Nat}: Identifier n already in context
+ test/fail/ShadowParameter.ma view
@@ -0,0 +1,8 @@+-- 2013-04-06+data Nat { zero ; suc (n : Nat) }++data Sg (n : Nat)+{ sg (n : Nat) : Sg n+}+-- this should be illegal shadowing, because it is confusing+-- (even the type checker gets confused)
+ test/fail/ShadowPatternParameter.err view
@@ -0,0 +1,6 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "ShadowPatternParameter.ma" ---+--- scope checking ---+scope check error: D+/// c+/// TBind {boundDec = Dec {thePolarity = ^}, boundNames = [n], boundType = Nat}: Identifier n already in context
+ test/fail/ShadowPatternParameter.ma view
@@ -0,0 +1,7 @@+-- 2013-04-06++data Nat { zero ; suc (n : Nat) }++data D (n : Nat)+{ c (n : Nat) : D (suc n)+}
+ test/fail/SizedDataWrongPol.err view
@@ -0,0 +1,7 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "SizedDataWrongPol.ma" ---+--- scope checking ---+--- type checking ---+error during typechecking:+Nat+/// sized type Nat has wrong polarity annotation - at Size argument, it should be +
+ test/fail/SizedDataWrongPol.ma view
@@ -0,0 +1,1 @@+sized data Nat : -Size -> Set {}
+ test/fail/StoreSize.err view
@@ -0,0 +1,16 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "StoreSize.ma" ---+--- scope checking ---+--- type checking ---+ty-u  WrapSize : Set 1+term  WrapSize.inn : .[out : Size] -> < WrapSize.inn out : WrapSize >+size  out : (inn : WrapSize) -> Size+error during typechecking:+WrapSize+/// out+/// clause 1+/// right hand side+/// checkExpr 1 |- #out : Size+/// inferExpr' #out+/// inferExpr: variable #out : Size may not occur+/// , because it is marked as erased
+ test/fail/StoreSize.ma view
@@ -0,0 +1,7 @@+-- 2010-09-20 ++data WrapSize : Set 1+{ inn : (out : Size) -> WrapSize+}+-- bug: MiniAgda tries to generate a destructor, even though out+-- is not a proper field (it is erased internally)
+ test/fail/StreamDupl.err view
@@ -0,0 +1,26 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "StreamDupl.ma" ---+--- scope checking ---+--- type checking ---+type  Stream : ++(A : Set) -> - Size -> Set+term  Stream.cons : .[A : Set] -> .[i : Size] -> ^(head : A) -> ^(tail : Stream A i) -> < Stream.cons i head tail : Stream A $i >+term  head : .[A : Set] -> .[i : Size] -> (cons : Stream A $i) -> A+{ head [A] [i] (Stream.cons [.i] #head #tail) = #head+}+term  tail : .[A : Set] -> .[i : Size] -> (cons : Stream A $i) -> Stream A i+{ tail [A] [i] (Stream.cons [.i] #head #tail) = #tail+}+term  evens : .[A : Set] -> .[i : Size] -> .[j : Size] -> Stream A (i + j) -> Stream A i+error during typechecking:+evens+/// clause 1+/// pattern cons .(i + j + 1) a (cons .(i + j) b as)+/// unifyIndices [(Dec {thePolarity = .}Set::Set,Dec {thePolarity = ++}),(Dec {thePolarity = .}Size::Size,Dec {thePolarity = ++}),(Dec {thePolarity = .}Size::Size,Dec {thePolarity = ++}),(Dec {thePolarity = .}Size::Size,Dec {thePolarity = ++}),(Dec {thePolarity = *}v0::Tm,Dec {thePolarity = ++}),(Dec {thePolarity = .}Size::Size,Dec {thePolarity = ++}),(Dec {thePolarity = *}v0::Tm,Dec {thePolarity = ++}),(Dec {thePolarity = *}(Stream v0 v5)::(),Dec {thePolarity = ++})] |- < Stream.cons $.(i + j) a (Stream.cons .(i + j) b as) : Stream A $$.(i + j) > ?<=+ Stream A ($i + j)+/// unifyIndices [(Dec {thePolarity = .}Set::Set,Dec {thePolarity = ++}),(Dec {thePolarity = .}Size::Size,Dec {thePolarity = ++}),(Dec {thePolarity = .}Size::Size,Dec {thePolarity = ++}),(Dec {thePolarity = .}Size::Size,Dec {thePolarity = ++}),(Dec {thePolarity = *}v0::Tm,Dec {thePolarity = ++}),(Dec {thePolarity = .}Size::Size,Dec {thePolarity = ++}),(Dec {thePolarity = *}v0::Tm,Dec {thePolarity = ++}),(Dec {thePolarity = *}(Stream v0 v5)::(),Dec {thePolarity = ++})] |- Stream A $$.(i + j) ?<=+ Stream A ($i + j)+/// inst [(Dec {thePolarity = .}Set::Set,Dec {thePolarity = ++}),(Dec {thePolarity = .}Size::Size,Dec {thePolarity = ++}),(Dec {thePolarity = .}Size::Size,Dec {thePolarity = ++}),(Dec {thePolarity = .}Size::Size,Dec {thePolarity = ++}),(Dec {thePolarity = *}v0::Tm,Dec {thePolarity = ++}),(Dec {thePolarity = .}Size::Size,Dec {thePolarity = ++}),(Dec {thePolarity = *}v0::Tm,Dec {thePolarity = ++}),(Dec {thePolarity = *}(Stream v0 v5)::(),Dec {thePolarity = ++})] |- $$.(i + j) ?<=- $(i + j) : Size+/// inst [(Dec {thePolarity = .}Set::Set,Dec {thePolarity = ++}),(Dec {thePolarity = .}Size::Size,Dec {thePolarity = ++}),(Dec {thePolarity = .}Size::Size,Dec {thePolarity = ++}),(Dec {thePolarity = .}Size::Size,Dec {thePolarity = ++}),(Dec {thePolarity = *}v0::Tm,Dec {thePolarity = ++}),(Dec {thePolarity = .}Size::Size,Dec {thePolarity = ++}),(Dec {thePolarity = *}v0::Tm,Dec {thePolarity = ++}),(Dec {thePolarity = *}(Stream v0 v5)::(),Dec {thePolarity = ++})] |- $.(i + j) ?<=- i + j : Size+/// inst: leqVal ($ v5) ?<=- (v2 + v1) : Size failed+/// leqVal'  $.(i + j)  <=-  i + j : Size+/// leSize $.(i + j) <=- i + j+/// leSize' i + j <= $.(i + j)+/// leSize: i + j <= .(i + j) + 1 failed
+ test/fail/StreamDupl.ma view
@@ -0,0 +1,12 @@+-- 2010-11-01 ++sized codata Stream ++(A : Set) : -Size -> Set +{ cons : [i : Size] -> (head : A) -> (tail : Stream A i) -> Stream A $i+}+ +cofun evens : [A : Set] -> [i, j : Size] -> Stream A (i + j) -> Stream A i+{ evens A ($i) j (cons .(i + j + 1) a (cons .(i + j) b as)) =+   cons i a (evens A i as)+}+-- this should fail because we cannot match the input stream to depth 2+-- since only i is replaced by $i
+ test/fail/StreamNotSemiCont.err view
@@ -0,0 +1,25 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "StreamNotSemiCont.ma" ---+--- scope checking ---+--- type checking ---+type  Unit : Set+term  Unit.unit : < Unit.unit : Unit >+type  Stream : +(A : Set) -> - Size -> Set+term  Stream.cons : .[A : Set] -> .[i : Size] -> ^(head : A) -> ^(tail : Stream A i) -> < Stream.cons i head tail : Stream A $i >+term  head : .[A : Set] -> .[i : Size] -> (cons : Stream A $i) -> A+{ head [A] [i] (Stream.cons [.i] #head #tail) = #head+}+term  tail : .[A : Set] -> .[i : Size] -> (cons : Stream A $i) -> Stream A i+{ tail [A] [i] (Stream.cons [.i] #head #tail) = #tail+}+term  bad : .[i : Size] -> .[A : Set] -> (Stream A i -> Stream A i) -> Stream A i+error during typechecking:+bad+/// clause 1+/// pattern $i+/// checkPattern $i : matching on size, checking that target .[i : Size] -> .[A : Set] -> (Stream A i -> Stream A i) -> Stream A i ends in correct coinductive sized type+/// new i <= #+/// endsInSizedCo: .[A : Set] -> (Stream A i -> Stream A i) -> Stream A i+/// new A : Set+/// endsInSizedCo: (Stream A i -> Stream A i) -> Stream A i+/// type  Stream A i -> Stream A i  not lower semi continuous in  i
+ test/fail/StreamNotSemiCont.ma view
@@ -0,0 +1,20 @@+-- 2010-07-01  Following a question of Nisse, this example explains+--   the need for continuity check.++data Unit : Set +{ unit : Unit +}++sized codata Stream +(A : Set) : Size -> Set+{ cons : [i : Size] -> (head : A) -> (tail : Stream A i) -> Stream A $i+}+fields head, tail++cofun bad : [i : Size] -> [A : Set] -> (Stream A i -> Stream A i) -> Stream A i+{ bad ($ i) A f = f (cons A i (bad i A f))+}++let undef : Stream Unit # = bad # Unit (tail #)++eval let diverge : Unit = head # undef +
+ test/fail/Tm.err view
@@ -0,0 +1,47 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "Tm.ma" ---+--- scope checking ---+--- type checking ---+type  Stream : ++(A : Set) -> - Size -> Set+term  Stream.cons : .[A : Set] -> .[i : Size] -> ^(head : A) -> ^(tail : Stream A i) -> < Stream.cons i head tail : Stream A $i >+term  head : .[A : Set] -> .[i : Size] -> (cons : Stream A $i) -> A+{ head [A] [i] (Stream.cons [.i] #head #tail) = #head+}+term  tail : .[A : Set] -> .[i : Size] -> (cons : Stream A $i) -> Stream A i+{ tail [A] [i] (Stream.cons [.i] #head #tail) = #tail+}+term  iterate : .[A : Set] -> (step : A -> A) -> (start : A) -> .[i : Size] -> Stream A i+{ iterate [A] step start $[i < #] = Stream.cons [i] start (iterate [A] step (step start) [i])+}+type  Tm : Set+term  Tm.abs : ^(y0 : ^ Tm -> Tm) -> < Tm.abs y0 : Tm >+term  Tm.app : ^(y0 : Tm) -> ^(y1 : Tm) -> < Tm.app y0 y1 : Tm >+warning: ignoring error: polarity check ++ <= - failed+warning: ignoring error: polarity check ++ <= + failed+term  sapp : ^ Tm -> Tm+{ sapp x = Tm.app x x+}+term  delta : Tm+term  delta = Tm.abs (\ x -> sapp x)+term  omega : Tm+term  omega = Tm.app delta delta+term  step : Tm -> Tm+error during typechecking:+step+/// clause 3+/// right hand side+/// checkExpr 1 |- abs (\ x -> step (f x)) : Tm+/// checkForced fromList [(f,0)] |- abs (\ x -> step (f x)) : Tm+/// checkApp (^(y0 : (^Tm::() -> Tm)::()) -> < Tm.abs y0 : Tm >) eliminated by \ x -> step (f x)+/// checkExpr 1 |- \ x -> step (f x) : ^ Tm -> Tm+/// checkForced fromList [(f,0)] |- \ x -> step (f x) : ^ Tm -> Tm+/// new x : Tm+/// checkExpr 2 |- step (f x) : Tm+/// inferExpr' step (f x)+/// checkApp (Tm -> Tm) eliminated by f x+/// inferExpr' f x+/// checkApp (^Tm::() -> Tm) eliminated by x+/// inferExpr' x+/// inferExpr: variable x : Tm may not occur+/// , because of polarity+/// polarity check ^ <= * failed
+ test/fail/Tm.ma view
@@ -0,0 +1,41 @@+-- 2010-11-06++sized codata Stream ++ (A : Set) : -Size -> Set+{ cons : [i : Size] -> (head : A) -> (tail : Stream A i) -> Stream A $i+} fields head, tail++cofun iterate +  : [A : Set ] -> (step : A -> A) -> (start : A) ->+    [i : Size] -> Stream A i+{ iterate A step start ($ i) = cons i start (iterate A step (step start) i)+}+               +-- this might be accepted without trustme in future versions?!+trustme+data Tm : Set +{ abs : ^(^Tm -> Tm) -> Tm+; app : ^Tm -> ^Tm -> Tm+}++fun sapp : ^Tm -> Tm+{ sapp x = app x x+}++let delta : Tm+  = abs (\ x -> sapp x)++let omega : Tm+  = app delta delta++fun step : Tm -> Tm+{ step (app (abs f) t) = f t+; step (app t u) = app (step t) u+; step (abs f)   = abs (\ x -> step (f x)) +  -- rejected, since x not parametric+  -- think of f=id, then step would analyze x !+}++let steps : Tm -> Stream Tm #+  = \ start -> iterate Tm step start # ++eval let omegas : Stream Tm # = steps omega
+ test/fail/TypeInTypeViaSetInfty.err view
@@ -0,0 +1,9 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "TypeInTypeViaSetInfty.ma" ---+--- scope checking ---+--- type checking ---+error during typechecking:+star+/// not a type: Set #+/// inferExpr' Set #+/// # is not a valid universe level
+ test/fail/TypeInTypeViaSetInfty.ma view
@@ -0,0 +1,3 @@+-- 2010-09-03++let star : Set # = Set #
+ test/fail/UlfsCounterexample.err view
@@ -0,0 +1,27 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "UlfsCounterexample.ma" ---+--- scope checking ---+--- type checking ---+type  Bool : Set+term  Bool.true : < Bool.true : Bool >+term  Bool.false : < Bool.false : Bool >+type  Nat : Set+term  Nat.zero : < Nat.zero : Nat >+term  Nat.succ : ^(y0 : Nat) -> < Nat.succ y0 : Nat >+type  T : Bool -> Set+{ T Bool.true = Nat+; T Bool.false = Bool+}+term  bad : .[F : Nat -> Set] -> .[f : .[x : Bool] -> T x -> Nat] -> (g : (n : Nat) -> F (f [Bool.true] n)) -> (h : F (f [Bool.false] Bool.false) -> Bool) -> Bool+error during typechecking:+bad+/// clause 1+/// right hand side+/// checkExpr 4 |- h (g zero) : Bool+/// inferExpr' h (g zero)+/// checkApp ((v0 {f [Bool.false] Bool.false {g = (v2 Up ((n : Nat::Tm) -> F (f [Bool.true] n){f = (v1 Up (.[x : Bool::Tm] -> T x -> Nat{F = (v0 Up (Nat::Tm -> Set))})), F = (v0 Up (Nat::Tm -> Set))})), f = (v1 Up (.[x : Bool::Tm] -> T x -> Nat{F = (v0 Up (Nat::Tm -> Set))})), F = (v0 Up (Nat::Tm -> Set))}})::Tm -> {Bool {g = (v2 Up ((n : Nat::Tm) -> F (f [Bool.true] n){f = (v1 Up (.[x : Bool::Tm] -> T x -> Nat{F = (v0 Up (Nat::Tm -> Set))})), F = (v0 Up (Nat::Tm -> Set))})), f = (v1 Up (.[x : Bool::Tm] -> T x -> Nat{F = (v0 Up (Nat::Tm -> Set))})), F = (v0 Up (Nat::Tm -> Set))}}) eliminated by g zero+/// leqVal' (subtyping)  < g n Nat.zero : F (f x  [Bool.true] Nat.zero) >  <=+  F (f x  [Bool.false] Bool.false)+/// leqVal' (subtyping)  F (f x  [Bool.true] Nat.zero)  <=+  F (f x  [Bool.false] Bool.false)+/// leqVal'  f Bool.true Nat.zero  <=*  f Bool.false Bool.false : Nat+/// leqVal'  Nat.zero : Nat  <=*  Bool.false : Bool+/// type Nat has different shape than Bool
+ test/fail/UlfsCounterexample.ma view
@@ -0,0 +1,36 @@+data Bool : Set+{ true  : Bool+; false : Bool+}++data Nat : Set+{ zero : Nat+; succ : Nat -> Nat+}++fun T : Bool -> Set+{ T true  = Nat+; T false = Bool+}++-- type checking fails with message "zero != false"+-- can be harmful if constructors can be reused in different types+fun bad : +  [F : Nat -> Set] ->+  [f : [x : Bool] -> T x -> Nat] ->+  (g : (n : Nat) -> F (f true n)) ->+  (h : F (f false false) -> Bool) -> +  Bool+{ bad F f g h = h (g zero)+}++{- h  expects  _ : F (f false false)+   but    g zero : F (f true  zero)++?  F (f true zero) <= F (f false false)+?  f true zero : Nat = f false false : Nat+?  zero : (T x)[true/x] = false : (T x)[false/x]+?  zero : Nat = false : Bool++should abort with message Nat != Bool+-}
+ test/fail/UlfsCounterexample2.err view
@@ -0,0 +1,26 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "UlfsCounterexample2.ma" ---+--- scope checking ---+--- type checking ---+type  Bool : Set+term  Bool.true : < Bool.true : Bool >+term  Bool.false : < Bool.false : Bool >+type  Nat : Set+term  Nat.zero : < Nat.zero : Nat >+term  Nat.succ : ^(y0 : Nat) -> < Nat.succ y0 : Nat >+type  T : ^ Bool -> Set+term  T.nat : ^(y0 : Nat) -> < T.nat y0 : T Bool.true >+term  T.bool : ^(y0 : Bool) -> < T.bool y0 : T Bool.false >+term  bad : .[F : Nat -> Set] -> ^(f : .[x : Bool] -> T x -> Nat) -> (g : (n : Nat) -> F (f [Bool.true] (T.nat n))) -> (h : F (f [Bool.false] (T.bool Bool.false)) -> Bool) -> Bool+error during typechecking:+bad+/// clause 1+/// right hand side+/// checkExpr 4 |- h (g zero) : Bool+/// inferExpr' h (g zero)+/// checkApp ((v0 {f [Bool.false] (T.bool Bool.false) {g = (v2 Up ((n : Nat::Tm) -> F (f [Bool.true] (T.nat n)){f = (v1 Up (.[x : Bool::Tm] -> T x -> Nat{F = (v0 Up (Nat::Tm -> Set))})), F = (v0 Up (Nat::Tm -> Set))})), f = (v1 Up (.[x : Bool::Tm] -> T x -> Nat{F = (v0 Up (Nat::Tm -> Set))})), F = (v0 Up (Nat::Tm -> Set))}})::Tm -> {Bool {g = (v2 Up ((n : Nat::Tm) -> F (f [Bool.true] (T.nat n)){f = (v1 Up (.[x : Bool::Tm] -> T x -> Nat{F = (v0 Up (Nat::Tm -> Set))})), F = (v0 Up (Nat::Tm -> Set))})), f = (v1 Up (.[x : Bool::Tm] -> T x -> Nat{F = (v0 Up (Nat::Tm -> Set))})), F = (v0 Up (Nat::Tm -> Set))}}) eliminated by g zero+/// leqVal' (subtyping)  < g n Nat.zero : F (f x  [Bool.true] (T.nat Nat.zero)) >  <=+  F (f x  [Bool.false] (T.bool Bool.false))+/// leqVal' (subtyping)  F (f x  [Bool.true] (T.nat Nat.zero))  <=+  F (f x  [Bool.false] (T.bool Bool.false))+/// leqVal'  f Bool.true (T.nat Nat.zero)  <=*  f Bool.false (T.bool Bool.false) : Nat+/// leqVal'  T.nat Nat.zero : T Bool.true  <=*  T.bool Bool.false : T Bool.false+/// leqVal': head mismatch T.nat{y0 = Nat.zero{}} != T.bool{y0 = Bool.false{}}
+ test/fail/UlfsCounterexample2.ma view
@@ -0,0 +1,27 @@+data Bool : Set+{ true  : Bool+; false : Bool+}++data Nat : Set+{ zero : Nat+; succ : Nat -> Nat+}++data T : Bool -> Set+{ nat  : Nat  -> T true +; bool : Bool -> T false+}++-- type checking fails with message "nat != bool"+-- can be harmful if constructors can be reused in different types+fun bad : +  [F : Nat -> Set] ->+  ^(f : [x : Bool] -> T x -> Nat) ->+  (g : (n : Nat) -> F (f true (nat n))) ->+  (h : F (f false (bool false)) -> Bool) -> +  Bool+{ bad F f g h = h (g zero)+}+-- 2010-10-01 now it is checked before that +-- nat and bool are in the same family T
+ test/fail/VectorPatternNotForced.err view
@@ -0,0 +1,42 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "VectorPatternNotForced.ma" ---+--- scope checking ---+--- type checking ---+type  Nat : Set+term  Nat.zero : < Nat.zero : Nat >+term  Nat.succ : ^(y0 : Nat) -> < Nat.succ y0 : Nat >+term  add : Nat -> Nat -> Nat+{ add Nat.zero y = y+; add (Nat.succ x) y = Nat.succ (add x y)+}+type  Vec : ^(A : Set) -> ^ Nat -> Set+term  Vec.nil : .[A : Set] -> < Vec.nil : Vec A Nat.zero >+term  Vec.cons : .[A : Set] -> .[n : Nat] -> ^(y1 : A) -> ^(y2 : Vec A n) -> < Vec.cons n y1 y2 : Vec A (Nat.succ n) >+term  length : .[A : Set] -> .[n : Nat] -> Vec A n -> < n : Nat >+{ length [A] [.Nat.zero] Vec.nil = Nat.zero+; length [A] [.(succ n)] (Vec.cons [n] a v) = Nat.succ (length [A] [n] v)+}+term  head : .[A : Set] -> .[n : Nat] -> Vec A (Nat.succ n) -> A+{ head [A] [.n] (Vec.cons [n] a v) = a+}+term  tail : .[A : Set] -> .[n : Nat] -> Vec A (Nat.succ n) -> Vec A n+{ tail [A] [.n] (Vec.cons [n] a v) = v+}+term  zeroes : (n : Nat) -> Vec Nat n+{ zeroes Nat.zero = Vec.nil+; zeroes (Nat.succ x) = Vec.cons [x] Nat.zero (zeroes x)+}+type  Fin : ^ Nat -> Set+term  Fin.fzero : .[n : Nat] -> < Fin.fzero n : Fin (Nat.succ n) >+term  Fin.fsucc : .[n : Nat] -> ^(y1 : Fin n) -> < Fin.fsucc n y1 : Fin (Nat.succ n) >+term  lookup : .[A : Set] -> .[n : Nat] -> Vec A n -> Fin n -> A+{ lookup [A] [.(succ n)] (Vec.cons [n] a v) (Fin.fzero [.n]) = a+; lookup [A] [.(succ n)] (Vec.cons [n] a v) (Fin.fsucc [.n] i) = lookup [A] [n] v i+; lookup [A] [.Nat.zero] Vec.nil ()+}+term  downFrom : .[n : Nat] -> Vec Nat n+error during typechecking:+downFrom+/// clause 1+/// pattern zero+/// checkPattern: constructor Nat.zero of non-computational argument zero : Nat not forced
+ test/fail/VectorPatternNotForced.ma view
@@ -0,0 +1,48 @@+data Nat : Set+{ zero : Nat+; succ : Nat -> Nat+}++fun add : Nat -> Nat -> Nat+{ add zero     y = y+; add (succ x) y = succ (add x y) +}++data Vec (A : Set) : Nat -> Set+{ nil  : Vec A zero+; cons : [n : Nat] -> A -> Vec A n -> Vec A (succ n)+}++fun length : [A : Set] -> [n : Nat] -> Vec A n -> < n : Nat >+{ length A .zero     nil          = zero+; length A .(succ n) (cons n a v) = succ (length A n v)+}++fun head : [A : Set] -> [n : Nat] -> Vec A (succ n) -> A +{ head A .n (cons n a v) = a+}+fun tail : [A : Set] -> [n : Nat] -> Vec A (succ n) -> Vec A n+{ tail A .n (cons n a v) = v+}++fun zeroes : (n : Nat) -> Vec Nat n+{ zeroes zero     = nil +; zeroes (succ x) = cons x zero (zeroes x)+}++data Fin : Nat -> Set+{ fzero : [n : Nat] -> Fin (succ n)+; fsucc : [n : Nat] -> Fin n -> Fin (succ n)+}++fun lookup : [A : Set] -> [n : Nat] -> Vec A n -> Fin n -> A+{ lookup A .(succ n) (cons n a v) (fzero .n)   = a+; lookup A .(succ n) (cons n a v) (fsucc .n i) = lookup A n v i+; lookup A .zero     nil        ()  -- IMPOSSIBLE+}++-- the following should give an error, since we cannot match on [n : Nat]+fun downFrom : [n : Nat] -> Vec Nat n+{ downFrom zero     = nil+; downFrom (succ n) = cons n n (downFrom n)+}
+ test/fail/VeiledParameter.err view
@@ -0,0 +1,6 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "VeiledParameter.ma" ---+--- scope checking ---+scope check error: D+/// c+/// expression (If true A B) is not valid in a parameter
+ test/fail/VeiledParameter.ma view
@@ -0,0 +1,11 @@+-- 2013-04-05++data Bool { false ; true }++fun If : Bool -> ++(A, B : Set) -> Set+{ If true  A B = A+; If false A B = B+}++data D (A, B : Set)+{ c : D (If true A B) (If false A B) }
+ test/fail/absurdPatUnit.err view
@@ -0,0 +1,11 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "absurdPatUnit.ma" ---+--- scope checking ---+--- type checking ---+type  Unit : Set+term  Unit.unit : < Unit.unit : Unit >+type  bla : Unit -> Set+error during typechecking:+bla+/// clause 1+/// absurd pattern does not match since type Unit is not empty
+ test/fail/absurdPatUnit.ma view
@@ -0,0 +1,8 @@+-- Absurd pattern used on non-empty type++data Unit : Set+{ unit : Unit }++fun bla : Unit -> Set+{ bla ()+}
+ test/fail/adm/adm1.err view
@@ -0,0 +1,17 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "adm/adm1.ma" ---+--- scope checking ---+--- type checking ---+type  Nat : + Size -> Set+term  Nat.zero : .[s!ze : Size] -> .[i < s!ze] -> Nat s!ze+term  Nat.zero : .[i : Size] -> < Nat.zero i : Nat $i >+term  Nat.succ : .[s!ze : Size] -> .[i < s!ze] -> ^ Nat i -> Nat s!ze+term  Nat.succ : .[i : Size] -> ^(y1 : Nat i) -> < Nat.succ i y1 : Nat $i >+term  foo : .[i : Size] -> Nat i+{}+type  foo2 : (i : Size) -> Nat $i -> Set+{ foo2 i (Nat.zero [.i]) = foo2 i (Nat.zero [i])+; foo2 i (Nat.succ [.i] x) = Nat #+}+error during typechecking:+Termination check for function foo2 fails
+ test/fail/adm/adm1.ma view
@@ -0,0 +1,22 @@+sized data Nat : Size -> Set+{+zero : ( i : Size ) -> Nat ($ i);+succ : ( i : Size ) -> Nat i -> Nat ($ i);+}+++-- size not used+fun foo : (i : Size ) -> Nat i+{+--foo ($ i) = foo i -- subtyping +}+++-- 2010-03-10, this is admissible, but not terminating!+fun foo2 : ( i : Size ) -> Nat ($ i) -> Set+{+foo2 i (zero .i) = foo2 i (zero i);+foo2 i (succ .i x) = Nat #+}++
+ test/fail/adm/adm2.err view
@@ -0,0 +1,15 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "adm/adm2.ma" ---+--- scope checking ---+--- type checking ---+type  Nat : + Size -> Set+term  Nat.zero : .[s!ze : Size] -> .[i < s!ze] -> Nat s!ze+term  Nat.zero : .[i : Size] -> < Nat.zero i : Nat $i >+term  Nat.succ : .[s!ze : Size] -> .[i < s!ze] -> ^ Nat i -> Nat s!ze+term  Nat.succ : .[i : Size] -> ^(y1 : Nat i) -> < Nat.succ i y1 : Nat $i >+term  foo : .[i : Size] -> Nat i+error during typechecking:+foo+/// clause 1+/// pattern $i+/// successor pattern only allowed in cofun
+ test/fail/adm/adm2.ma view
@@ -0,0 +1,15 @@+sized data Nat : Size -> Set+{+zero : ( i : Size ) -> Nat ($ i);+succ : ( i : Size ) -> Nat i -> Nat ($ i)+}++-- 2010-03-10+-- termination checking fails because this pattern is declared unusable+-- it would be clearer if the pattern ($ i) was rejected because+-- Nat i is not coinductive+-- 2010-08-18 now clearer+fun foo : (i : Size ) -> Nat i+{+foo ($ i) = foo i+}
+ test/fail/adm/adm3.err view
@@ -0,0 +1,19 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "adm/adm3.ma" ---+--- scope checking ---+--- type checking ---+type  Maybe : ^(A : Set) -> Set+term  Maybe.nothing : .[A : Set] -> < Maybe.nothing : Maybe A >+term  Maybe.just : .[A : Set] -> ^(y0 : A) -> < Maybe.just y0 : Maybe A >+type  SNat : + Size -> Set+term  SNat.zero : .[s!ze : Size] -> .[i < s!ze] -> SNat s!ze+term  SNat.zero : .[i : Size] -> < SNat.zero i : SNat $i >+term  SNat.succ : .[s!ze : Size] -> .[i < s!ze] -> ^ SNat i -> SNat s!ze+term  SNat.succ : .[i : Size] -> ^(y1 : SNat i) -> < SNat.succ i y1 : SNat $i >+term  bla : .[i : Size] -> SNat $i -> SNat i+error during typechecking:+bla+/// clause 1+/// pattern zero $i+/// pattern $i+/// successor pattern only allowed in cofun
+ test/fail/adm/adm3.ma view
@@ -0,0 +1,33 @@+data Maybe (A : Set) : Set +{ nothing : Maybe A+; just : A -> Maybe A+}++sized data SNat : Size -> Set+{+zero : (i : Size ) -> SNat ($ i);+succ : (i : Size ) -> SNat i -> SNat ($ i)+}++-- no complete pattern matching+fun bla : (i : Size ) -> SNat ($ i) -> SNat i+{+bla .($ i) (zero ($ i)) = zero i; -- no complete pattern matching+bla .i (succ i x) = x +}+-- 2010-08-18 new error: successor pattern only allowed in cofun++-- termination check fails because ($ i) is unusable+fun loop : (i : Size ) -> (SNat i) -> Set+{+loop ($ i) x = loop i (bla i x)+}++eval let diverge : Set = loop # (zero #)++fun deconstruct_nat : (i : Size) -> SNat ($ i) -> Maybe (SNat i)+{+ deconstruct_nat i (zero .i) = nothing (SNat i);+ deconstruct_nat i (succ .i n) = just (SNat i) n+}+
+ test/fail/bfSizePatternIncomplete.err view
@@ -0,0 +1,31 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "bfSizePatternIncomplete.ma" ---+--- scope checking ---+--- type checking ---+type  Prod : ++(A : Set) -> ++(B : Set) -> Set+term  Prod.pair : .[A : Set] -> .[B : Set] -> ^(y0 : A) -> ^(y1 : B) -> < Prod.pair y0 y1 : Prod A B >+term  split : .[A : Set] -> .[B : Set] -> Prod A B -> .[C : Set] -> (A -> B -> C) -> C+{ split [A] [B] (Prod.pair a b) [C] f = f a b+}+type  List : ++(A : Set) -> + Size -> Set+term  List.nil : .[A : Set] -> .[s!ze : Size] -> .[i < s!ze] -> List A s!ze+term  List.nil : .[A : Set] -> .[i : Size] -> < List.nil i : List A $i >+term  List.cons : .[A : Set] -> .[s!ze : Size] -> .[i < s!ze] -> ^ A -> ^ List A i -> List A s!ze+term  List.cons : .[A : Set] -> .[i : Size] -> ^(y1 : A) -> ^(y2 : List A i) -> < List.cons i y1 y2 : List A $i >+term  append : .[A : Set] -> List A # -> List A # -> List A #+{ append [A] (List.nil [.#]) l = l+; append [A] (List.cons [.#] a as) l = List.cons [#] a (append [A] as l)+}+type  Rose : ++(A : Set) -> + Size -> Set+term  Rose.rose : .[A : Set] -> .[s!ze : Size] -> .[i < s!ze] -> ^ A -> ^ List (Rose A i) # -> Rose A s!ze+term  Rose.rose : .[A : Set] -> .[i : Size] -> ^(y1 : A) -> ^(y2 : List (Rose A i) #) -> < Rose.rose i y1 y2 : Rose A $i >+term  step : .[j : Size] -> .[A : Set] -> .[i : Size] -> List (Rose A $i) j -> Prod (List A j) (List (Rose A i) #)+{ step [.$j] [A] [i] (List.nil [j]) = Prod.pair (List.nil [j]) (List.nil [#])+; step [.$j] [A] [.i] (List.cons [j] (Rose.rose [i] a rs') rs) = split [List A j] [List (Rose A i) #] (step [j] [A] [i] rs) [Prod (List A $j) (List (Rose A i) #)] (\ as -> \ rs'' -> Prod.pair (List.cons [j] a as) (append [Rose A i] rs' rs''))+}+term  bf' : .[A : Set] -> .[i : Size] -> List A # -> List (Rose A i) # -> List A #+error during typechecking:+bf'+/// clause 1+/// pattern $i+/// successor pattern only allowed in cofun
+ test/fail/bfSizePatternIncomplete.ma view
@@ -0,0 +1,71 @@+data Prod (+A : Set) (+B : Set) : Set+{+  pair : A -> B -> Prod A B+}++fun split : (A : Set) -> (B : Set) -> Prod A B ->  +            (C : Set) -> (A -> B -> C) -> C  +{+  split A B (pair a b) C f = f a b+}++sized data List (+ A : Set) : Size -> Set +{+  nil  : (i : Size) -> List A ($ i) ;+  cons : (i : Size) -> A -> List A i -> List A ($ i)+}++fun append : (A : Set) -> List A # -> List A # -> List A #+{+  append A (nil .#) l = l;+  append A (cons .# a as) l = cons # a (append A as l)+}++sized data Rose (+A : Set) : Size -> Set+{+  rose : (i : Size) -> A -> List (Rose A i) # -> Rose A ($ i)+}++++fun step : (j : Size) -> (A : Set) -> (i : Size) ->+           List (Rose A ($ i)) j -> +           Prod (List A j) (List (Rose A i) #) ++{+  step .($ j) A i (nil {- .(Rose A ($ i)) -} j) = +    pair {- (List A _) (List (Rose A _) _) -}+      (nil _) +      (nil {- (Rose A i) -} _);++  step .($ j) A .i (cons {- .(Rose A ($ i)) -} j (rose i a rs') rs) =+    split (List A j) (List (Rose A i) #) +       (step j A i rs) +          (Prod (List A ($ j)) (List (Rose A i) #))+       (\ as -> \ rs'' -> pair {- (List A _) (List (Rose A _) #) -}+           (cons _ a as) +           (append (Rose A i) rs' rs'')) ++}++-- 2010-08-18 new error: successor pattern only allowed in cofun+fun bf' : (A : Set) -> (i : Size) -> List A # -> List (Rose A i) # -> List A # +{+  bf' A ($ i) as (nil {-.(Rose A ($ i))-} .#) = as;+  bf' A ($ i) as (cons {-.(Rose A ($ i))-} .# r rs) = append A as +    (split+        (List A #) (List (Rose A i) #) +      (step # A i (cons {-(Rose A ($ i))-} _ r rs))+        (List A #) +      (bf' A i) +    )+}++{-+fun bf : (i : Size) -> (A : Set) -> Rose A i -> List (Rose A i) # -> List A #+{++  bf i A r rs++}+-}
+ test/fail/bfTypeNotAdmissible.err view
@@ -0,0 +1,39 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "bfTypeNotAdmissible.ma" ---+--- scope checking ---+--- type checking ---+type  Prod : ++(A : Set) -> ++(B : Set) -> Set+term  Prod.pair : .[A : Set] -> .[B : Set] -> ^(y0 : A) -> ^(y1 : B) -> < Prod.pair y0 y1 : Prod A B >+term  split : .[A : Set] -> .[B : Set] -> Prod A B -> .[C : Set] -> (A -> B -> C) -> C+{ split [A] [B] (Prod.pair a b) [C] f = f a b+}+type  List : ++(A : Set) -> + Size -> Set+term  List.nil : .[A : Set] -> .[s!ze : Size] -> .[i < s!ze] -> List A s!ze+term  List.nil : .[A : Set] -> .[i : Size] -> < List.nil i : List A $i >+term  List.cons : .[A : Set] -> .[s!ze : Size] -> .[i < s!ze] -> ^ A -> ^ List A i -> List A s!ze+term  List.cons : .[A : Set] -> .[i : Size] -> ^(y1 : A) -> ^(y2 : List A i) -> < List.cons i y1 y2 : List A $i >+term  append : .[A : Set] -> List A # -> List A # -> List A #+{ append [A] (List.nil [.#]) l = l+; append [A] (List.cons [.#] a as) l = List.cons [#] a (append [A] as l)+}+type  Rose : ++(A : Set) -> + Size -> Set+term  Rose.rose : .[A : Set] -> .[s!ze : Size] -> .[i < s!ze] -> ^ A -> ^ List (Rose A i) # -> Rose A s!ze+term  Rose.rose : .[A : Set] -> .[i : Size] -> ^(y1 : A) -> ^(y2 : List (Rose A i) #) -> < Rose.rose i y1 y2 : Rose A $i >+term  step : .[j : Size] -> .[A : Set] -> .[i : Size] -> List (Rose A $i) j -> Prod (List A j) (List (Rose A i) #)+{ step [.$j] [A] [i] (List.nil [j]) = Prod.pair (List.nil [j]) (List.nil [#])+; step [.$j] [A] [.i] (List.cons [j] (Rose.rose [i] a rs') rs) = split [List A j] [List (Rose A i) #] (step [j] [A] [i] rs) [Prod (List A $j) (List (Rose A i) #)] (\ as -> \ rs'' -> Prod.pair (List.cons [j] a as) (append [Rose A i] rs' rs''))+}+term  bf' : .[A : Set] -> .[i : Size] -> List A # -> List (Rose A i) # -> List A #+error during typechecking:+checking type of bf' for admissibility+/// new A : _+/// new as : _+/// new i : _+/// new a : _+/// new r : _+/// new rs : _+/// new i <= #+/// admType: checking ((List v0 #)::Tm -> {List (Rose A i) # -> List A # {i = v6, A = v0}}) admissible in v6+/// new  : (List v0 #)+/// admType: checking ((List {Rose A i {i = v6, A = v0}} #)::Tm -> {List A # {i = v6, A = v0}}) admissible in v6+/// type  List (Rose A i) #  not lower semi continuous in  i
+ test/fail/bfTypeNotAdmissible.ma view
@@ -0,0 +1,84 @@+data Prod (+A : Set) (+B : Set) : Set+{+  pair : A -> B -> Prod A B+}++fun split : (A : Set) -> (B : Set) -> Prod A B ->  +            (C : Set) -> (A -> B -> C) -> C  +{+  split A B (pair a b) C f = f a b+}++sized data List (+ A : Set) : Size -> Set +{+  nil  : (i : Size) -> List A ($ i) ;+  cons : (i : Size) -> A -> List A i -> List A ($ i)+}++fun append : (A : Set) -> List A # -> List A # -> List A #+{+  append A (nil .#) l = l;+  append A (cons .# a as) l = cons # a (append A as l)+}++sized data Rose (+A : Set) : Size -> Set+{+  rose : (i : Size) -> A -> List (Rose A i) # -> Rose A ($ i)+}++++fun step : (j : Size) -> (A : Set) -> (i : Size) ->+           List (Rose A ($ i)) j -> +           Prod (List A j) (List (Rose A i) #) ++{+  step .($ j) A i (nil j) = pair (nil _) (nil _);++  step .($ j) A .i (cons j (rose i a rs') rs) =+    split (List A j) (List (Rose A i) #) +       (step j A i rs) +          (Prod (List A ($ j)) (List (Rose A i) #))+       (\ as -> \ rs'' -> pair+           (cons _ a as) +           (append (Rose A i) rs' rs'')) ++}++fun bf' : (A : Set) -> (i : Size) -> List A # -> List (Rose A i) # -> List A # +{+  bf' A i as (nil .#) = as;+  bf' A .($ i) as (cons .# (rose i a r) rs) = append A as +    (split+        (List A #) (List (Rose A i) #) +      (step # A i (cons  _ (rose _ a r) rs))+        (List A #) +      (bf' A i) +    )+}++{-+mutual {++  fun bf' : (A : Set) -> (i : Size) -> List A # -> List (Rose A i) # -> List A # +  {+    bf' A ($ i) as (nil .(Rose A ($ i)) .#) = as;+    bf' A ($ i) as (cons .(Rose A ($ i)) .# r rs) =+      append A as (bf A i r rs)+  }+  +  fun bf : (A : Set) -> (i : Size) -> Rose A i -> List (Rose A i) # -> List A #+  {+  +    bf A i r rs = +      (split+          (List A #) (List (Rose A i) #) +        (step # A i (cons (Rose A ($ i)) _ r rs))+          (List A #) +        (bf' A i) +      )+  }+  +}++-}
+ test/fail/bigData.err view
@@ -0,0 +1,14 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "bigData.ma" ---+--- scope checking ---+--- type checking ---+type  Any : Set+error during typechecking:+Any+/// constructor Any.inn+/// new Any : Set+/// inferExpr' ^(Out : Set) -> Any+/// new Out : Set+/// leSize 1 <=+ 0+/// leSize' 1 <= 0+/// leSize': 1 <= 0 failed
+ test/fail/bigData.ma view
@@ -0,0 +1,15 @@+-- 2010-06-25 removed Set:Set, so this should not pass++data Any : Set +{ inn : (Out : Set) -> Any }++data Big : Set -> Set+{+  big : (A : Set) -> (B : Set) -> Big (A -> B)+}++fun bla : (A : Set) -> Big A -> Big A+{+  bla .(A -> B) (big A B) = big A B+--  bla (.(A) -> .(B)) (big A B) = big A B+}
+ test/fail/coSetOmega.err view
@@ -0,0 +1,14 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "coSetOmega.ma" ---+--- scope checking ---+--- type checking ---+type  D : (i : Size) -> CoSet i+error during typechecking:+D+/// clause 1+/// right hand side+/// checkExpr 1 |- D i -> D i : CoSet $i+/// checkForced fromList [(i,0)] |- D i -> D i : CoSet $i+/// inferExpr' D i -> D i+/// new  : (D v0)+/// ptsRule ((CoSet v0),(CoSet v0)) : domain cannot be sized
+ test/fail/coSetOmega.ma view
@@ -0,0 +1,10 @@+cofun D : (i : Size) -> CoSet i+{ D ($ i) = D i -> D i+}++let sapp : D # -> D # +    = \ x -> x x++eval let omega : D # -> D #+               = sapp sapp+
+ test/fail/coSizeInFun.err view
@@ -0,0 +1,17 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "coSizeInFun.ma" ---+--- scope checking ---+--- type checking ---+type  SNat : + Size -> Set+term  SNat.zero : .[s!ze : Size] -> .[i < s!ze] -> SNat s!ze+term  SNat.zero : .[i : Size] -> < SNat.zero i : SNat $i >+term  SNat.succ : .[s!ze : Size] -> .[i < s!ze] -> ^ SNat i -> SNat s!ze+term  SNat.succ : .[i : Size] -> ^(y1 : SNat i) -> < SNat.succ i y1 : SNat $i >+type  Stream : - Size -> Set+term  Stream.cons : .[i : Size] -> ^(y1 : SNat #) -> ^(y2 : Stream i) -> < Stream.cons i y1 y2 : Stream $i >+term  bla : .[i : Size] -> SNat i -> .[j : Size] -> Stream j -> .[A : Set] -> A+error during typechecking:+bla+/// clause 1+/// pattern $j+/// successor pattern only allowed in cofun
+ test/fail/coSizeInFun.ma view
@@ -0,0 +1,31 @@++sized data SNat : Size -> Set+{+  zero : (i : Size) -> SNat ($ i);+  succ : (i : Size) -> SNat i -> SNat ($ i)+}++sized codata Stream : Size -> Set {+  cons : (i : Size) -> SNat # -> Stream i -> Stream ($ i)+}++-- This is a fake lexicographic induction on (j,i)++-- 2010-03-10: size pattern in co constructors must be dotted+-- but the pattern ($ j) fails since target is not Stream j+fun bla : (i : Size) -> SNat i -> (j : Size) -> Stream j -> (A : Set) -> A+{+  bla .($ i) (zero i) ($ j) (cons .j x xs) = bla # x j xs ;+  bla .($ i) (succ i y)   j            xs  = bla i y j xs+}+-- 2010-08-18: ($ j) only in cofun++-- OLD:+-- Analysis declares j unusable for termination, so termination check fails+fun blo : (i : Size) -> SNat i -> (j : Size) -> Stream j -> (A : Set) -> A+{+  blo .($ i) (zero i) .($ j) (cons j x xs) = blo # x j xs ;+  blo .($ i) (succ i y)   j            xs  = blo i y j xs+}+-- NEW:+-- size patterns in coconstructors must be dotted!
+ test/fail/codataNotMonotone.err view
@@ -0,0 +1,23 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "codataNotMonotone.ma" ---+--- scope checking ---+--- type checking ---+type  SNat : + Size -> Set+term  SNat.zero : .[s!ze : Size] -> .[i < s!ze] -> SNat s!ze+term  SNat.zero : .[i : Size] -> < SNat.zero i : SNat $i >+term  SNat.succ : .[s!ze : Size] -> .[i < s!ze] -> ^ SNat i -> SNat s!ze+term  SNat.succ : .[i : Size] -> ^(y1 : SNat i) -> < SNat.succ i y1 : SNat $i >+type  NatEq : -(i : Size) -> ^ SNat i -> ^ SNat i -> Set+term  NatEq.eqz : .[i : Size] -> < NatEq.eqz i : NatEq $i (SNat.zero [i]) (SNat.zero [i]) >+error during typechecking:+NatEq+/// constructor NatEq.eqs+/// szConstructor NatEq : .[i : Size] -> .[n : SNat i] -> .[m : SNat i] -> ^(y3 : NatEq i n m) -> < NatEq.eqs i n m y3 : NatEq $i (SNat.succ [i] n) (SNat.succ [i] m) >+/// new i <= #+/// szSizeVarUsage of i in .[n : SNat i] -> .[m : SNat i] -> ^(y3 : NatEq i n m) -> < NatEq.eqs i n m y3 : NatEq $i (SNat.succ [i] n) (SNat.succ [i] m) >+/// checking SNat i  to be antitone in variable i+/// leqVal'  SNat i  <=-  SNat $i : Set #+/// leqVal'  i  <=-  $i : Size+/// leSize i <=- $i+/// leSize' $i <= i+/// leSize: 0 + 1 <= 0 failed
+ test/fail/codataNotMonotone.ma view
@@ -0,0 +1,12 @@+-- 2010-05-06++sized data SNat : Size -> Set +{ zero : [i : Size] -> SNat ($ i)+; succ : [i : Size] -> SNat i -> SNat ($ i) +}++sized codata NatEq : (i : Size) -> SNat i -> SNat i -> Set+{ eqz : [i : Size] -> NatEq ($ i) (zero i) (zero i)+; eqs : [i : Size] -> (n : SNat i) -> (m : SNat i) -> +   NatEq i n m -> NatEq ($ i) (succ i n) (succ i m)+}
+ test/fail/codyPatternConditionExplicit.err view
@@ -0,0 +1,60 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "codyPatternConditionExplicit.ma" ---+--- scope checking ---+--- type checking ---+type  Nat : Set+term  Nat.zero : < Nat.zero : Nat >+term  Nat.succ : ^(y0 : Nat) -> < Nat.succ y0 : Nat >+type  O : + Size -> Set+term  O.Z : .[s!ze : Size] -> .[i < s!ze] -> O s!ze+term  O.Z : .[i : Size] -> < O.Z i : O $i >+term  O.S : .[s!ze : Size] -> .[i < s!ze] -> ^ O i -> O s!ze+term  O.S : .[i : Size] -> ^(y1 : O i) -> < O.S i y1 : O $i >+term  O.L : .[s!ze : Size] -> .[i < s!ze] -> ^ (Nat -> O i) -> O s!ze+term  O.L : .[i : Size] -> ^(y1 : Nat -> O i) -> < O.L i y1 : O $i >+term  O.M : .[s!ze : Size] -> .[i < s!ze] -> ^ O i -> ^ O i -> O s!ze+term  O.M : .[i : Size] -> ^(y1 : O i) -> ^(y2 : O i) -> < O.M i y1 y2 : O $i >+term  f01 : .[i : Size] -> Nat -> O $$$i+{ f01 [i] Nat.zero = O.Z [i]+; f01 [i] (Nat.succ Nat.zero) = O.S [$i] (O.Z [i])+; f01 [i] (Nat.succ (Nat.succ n)) = O.S [$$i] (O.S [$i] (O.Z [i]))+}+term  v5 : .[i : Size] -> O $$$$$i+term  v5 = [\ i ->] O.M [$$$$i] (O.L [$$$i] (f01 [i])) (O.S [$$$i] (O.S [$$i] (O.S [$i] (O.Z [i]))))+term  emb : Nat -> O #+{ emb Nat.zero = O.Z [#]+; emb (Nat.succ n) = O.S [#] (emb n)+}+term  pre : .[i : Size] -> (Nat -> O $$i) -> Nat -> O $i+term  pre = [\ i ->] \ f -> \ n -> case f (Nat.succ n) : O $$i+                       { O.Z [.$i] -> O.Z [i]+                       ; O.S [.$i] x -> x+                       ; O.L [.$i] g -> g n+                       ; O.M [.$i] a b -> a+                       }+term  deep : .[i : Size] -> O i -> Nat -> Nat+error during typechecking:+deep+/// clause 1+/// right hand side+/// checkExpr 9 |- deep $$$i (M $$i (L $i (pre i f)) (S j2 (f n))) (succ (succ (succ n))) : Nat+/// inferExpr' deep $$$i (M $$i (L $i (pre i f)) (S j2 (f n))) (succ (succ (succ n)))+/// inferExpr' deep $$$i (M $$i (L $i (pre i f)) (S j2 (f n)))+/// checkApp ((O ($ ($ ($ v6))))::Tm -> {Nat -> Nat {i = ($ ($ ($ v6)))}}) eliminated by M $$i (L $i (pre i f)) (S j2 (f n))+/// checkExpr 9 |- M $$i (L $i (pre i f)) (S j2 (f n)) : O $$$i+/// checkForced fromList [(i4,0),(i3,1),(j2,2),(f,3),(i2,4),(i1,5),(i,6),(x,7),(n,8)] |- M $$i (L $i (pre i f)) (S j2 (f n)) : O $$$i+/// checkApp (^(y1 : (O ($ ($ v6)))::()) -> ^(y2 : O i) -> < O.M i y1 y2 : O $i >{i = ($ ($ v6))}) eliminated by L $i (pre i f)+/// checkExpr 9 |- L $i (pre i f) : O $$i+/// checkForced fromList [(i4,0),(i3,1),(j2,2),(f,3),(i2,4),(i1,5),(i,6),(x,7),(n,8)] |- L $i (pre i f) : O $$i+/// checkApp (^(y1 : (Nat::Tm -> {O i {i = ($ v6)}})::()) -> < O.L i y1 : O $i >{i = ($ v6)}) eliminated by pre i f+/// inferExpr' pre i f+/// checkApp ((Nat::Tm -> {O $$i {i = v6}})::Tm -> {Nat -> O $i {i = v6}}) eliminated by f+/// leqVal' (subtyping)  (xSing# : Nat) -> < f xSing# : O j2 >  <=+  Nat -> O $$i+/// new xSing# : Nat+/// comparing codomain < f xSing# : O j2 > with O $$i+/// leqVal' (subtyping)  < f xSing# : O j2 >  <=+  O $$i+/// leqVal' (subtyping)  O j2  <=+  O $$i+/// leqVal'  j2  <=+  $$i : Size+/// leSize j2 <=+ $$i+/// leSize' j2 <= $$i+/// bound not entailed
+ test/fail/codyPatternConditionExplicit.ma view
@@ -0,0 +1,62 @@+{- 2010-02-02 Cody Roux communicated and observation of Frederic+   Blanqui that the "non-linear" size-assignment for constructors (see+   M below) does not allow to express the precise sizes in a deep+   match involving a limit ordinal (see L below).  From this I could+   construct a non-looping term in MiniAgda.+ +   2010-03-09  +   This file tests whether the loop is still accepted after the fix.+ -}++data Nat : Set+{ zero : Nat+; succ : Nat -> Nat+}++sized data O : Size -> Set+{ Z : [i : Size] -> O ($ i)+; S : [i : Size] -> O i -> O ($ i)+; L : [i : Size] -> (Nat -> O i) -> O ($ i)+; M : [i : Size] -> O i -> O i -> O ($ i)+}++{- 2010-03-08 construct a value of size 5 -}++fun f01 : [i : Size] -> Nat -> O ($$$ i)+{ f01 i zero = Z i+; f01 i (succ zero) = S _ (Z i)+; f01 i (succ (succ n)) = S _ (S _ (Z i))+}++let v5 : [i : Size] -> O ($$$$$ i)+  = \ i -> M $$$$i (L $$$i (f01 i)) (S $$$i (S $$i (S $i (Z i))))++fun emb : Nat -> O #+{ emb zero = Z #+; emb (succ n) = S # (emb n)+}++let pre : [i : Size] -> (Nat -> O ($ ($ i))) -> Nat -> O ($ i)+  = \ i -> \ f -> \ n -> case (f (succ n))+    { (Z .($ i))   -> Z i+    ; (S .($ i) x) -> x+    ; (L .($ i) g) -> g n+    ; (M .($ i) a b) -> a+    } ++fun deep : [i : Size] -> O i -> Nat -> Nat+{ deep i4 +   (M (i4 > i3) +        (L (i3 > j2) f) +        (S (i3 > i2)  +             (S (i2 > i1) +                  (S (i1 > i) x)))) n+  = deep ($$$ i) (M ($$ i) (L ($ i) (pre i f)) (S j2 (f n))) (succ (succ (succ n)))+; deep i x n = n   +}+++let four : Nat +  = succ (succ (succ (succ zero)))++eval let loop : Nat = deep # (M # (L # emb) (emb four)) four
+ test/fail/codyPatternConditionExplicit2.err view
@@ -0,0 +1,60 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "codyPatternConditionExplicit2.ma" ---+--- scope checking ---+--- type checking ---+type  Nat : Set+term  Nat.zero : < Nat.zero : Nat >+term  Nat.succ : ^(y0 : Nat) -> < Nat.succ y0 : Nat >+type  O : + Size -> Set+term  O.Z : .[s!ze : Size] -> .[i < s!ze] -> O s!ze+term  O.Z : .[i : Size] -> < O.Z i : O $i >+term  O.S : .[s!ze : Size] -> .[i < s!ze] -> ^ O i -> O s!ze+term  O.S : .[i : Size] -> ^(y1 : O i) -> < O.S i y1 : O $i >+term  O.L : .[s!ze : Size] -> .[i < s!ze] -> ^ (Nat -> O i) -> O s!ze+term  O.L : .[i : Size] -> ^(y1 : Nat -> O i) -> < O.L i y1 : O $i >+term  O.M : .[s!ze : Size] -> .[i < s!ze] -> ^ O i -> ^ O i -> O s!ze+term  O.M : .[i : Size] -> ^(y1 : O i) -> ^(y2 : O i) -> < O.M i y1 y2 : O $i >+term  f01 : .[i : Size] -> Nat -> O $$$i+{ f01 [i] Nat.zero = O.Z [i]+; f01 [i] (Nat.succ Nat.zero) = O.S [$i] (O.Z [i])+; f01 [i] (Nat.succ (Nat.succ n)) = O.S [$$i] (O.S [$i] (O.Z [i]))+}+term  v5 : .[i : Size] -> O $$$$$i+term  v5 = [\ i ->] O.M [$$$$i] (O.L [$$$i] (f01 [i])) (O.S [$$$i] (O.S [$$i] (O.S [$i] (O.Z [i]))))+term  emb : Nat -> O #+{ emb Nat.zero = O.Z [#]+; emb (Nat.succ n) = O.S [#] (emb n)+}+term  pre : .[i : Size] -> (Nat -> O $$i) -> Nat -> O $i+term  pre = [\ i ->] \ f -> \ n -> case f (Nat.succ n) : O $$i+                       { O.Z [.$i] -> O.Z [i]+                       ; O.S [.$i] x -> x+                       ; O.L [.$i] g -> g n+                       ; O.M [.$i] a b -> a+                       }+term  deep : .[i : Size] -> O i -> Nat -> Nat+error during typechecking:+deep+/// clause 1+/// right hand side+/// checkExpr 9 |- deep (max $$$i $$j2) (M (max $$i $j2) (L $i (pre $$i f)) (S j2 (f n))) (succ (succ (succ n))) : Nat+/// inferExpr' deep (max $$$i $$j2) (M (max $$i $j2) (L $i (pre $$i f)) (S j2 (f n))) (succ (succ (succ n)))+/// inferExpr' deep (max $$$i $$j2) (M (max $$i $j2) (L $i (pre $$i f)) (S j2 (f n)))+/// checkApp ((O (max ($ ($ ($ v6))) ($ ($ v2))))::Tm -> {Nat -> Nat {i = (max ($ ($ ($ v6))) ($ ($ v2)))}}) eliminated by M (max $$i $j2) (L $i (pre $$i f)) (S j2 (f n))+/// checkExpr 9 |- M (max $$i $j2) (L $i (pre $$i f)) (S j2 (f n)) : O (max $$$i $$j2)+/// checkForced fromList [(i4,0),(i3,1),(j2,2),(f,3),(i2,4),(i1,5),(i,6),(x,7),(n,8)] |- M (max $$i $j2) (L $i (pre $$i f)) (S j2 (f n)) : O (max $$$i $$j2)+/// checkApp (^(y1 : (O (max ($ ($ v6)) ($ v2)))::()) -> ^(y2 : O i) -> < O.M i y1 y2 : O $i >{i = (max ($ ($ v6)) ($ v2))}) eliminated by L $i (pre $$i f)+/// checkExpr 9 |- L $i (pre $$i f) : O (max $$i $j2)+/// checkForced fromList [(i4,0),(i3,1),(j2,2),(f,3),(i2,4),(i1,5),(i,6),(x,7),(n,8)] |- L $i (pre $$i f) : O (max $$i $j2)+/// checkApp (^(y1 : (Nat::Tm -> {O i {i = ($ v6)}})::()) -> < O.L i y1 : O $i >{i = ($ v6)}) eliminated by pre $$i f+/// inferExpr' pre $$i f+/// checkApp ((Nat::Tm -> {O $$i {i = ($ ($ v6))}})::Tm -> {Nat -> O $i {i = ($ ($ v6))}}) eliminated by f+/// leqVal' (subtyping)  (xSing# : Nat) -> < f xSing# : O j2 >  <=+  Nat -> O $$$$i+/// new xSing# : Nat+/// comparing codomain < f xSing# : O j2 > with O $$$$i+/// leqVal' (subtyping)  < f xSing# : O j2 >  <=+  O $$$$i+/// leqVal' (subtyping)  O j2  <=+  O $$$$i+/// leqVal'  j2  <=+  $$$$i : Size+/// leSize j2 <=+ $$$$i+/// leSize' j2 <= $$$$i+/// bound not entailed
+ test/fail/codyPatternConditionExplicit2.ma view
@@ -0,0 +1,63 @@+{- 2010-02-02 Cody Roux communicated and observation of Frederic+   Blanqui that the "non-linear" size-assignment for constructors (see+   M below) does not allow to express the precise sizes in a deep+   match involving a limit ordinal (see L below).  From this I could+   construct a non-looping term in MiniAgda.+ +   2010-03-09  +   This file tests whether the loop is still accepted after the fix.+ -}++data Nat : Set+{ zero : Nat+; succ : Nat -> Nat+}++sized data O : Size -> Set+{ Z : [i : Size] -> O ($ i)+; S : [i : Size] -> O i -> O ($ i)+; L : [i : Size] -> (Nat -> O i) -> O ($ i)+; M : [i : Size] -> O i -> O i -> O ($ i)+}++{- 2010-03-08 construct a value of size 5 -}++fun f01 : [i : Size] -> Nat -> O ($$$ i)+{ f01 i zero = Z i+; f01 i (succ zero) = S _ (Z i)+; f01 i (succ (succ n)) = S _ (S _ (Z i))+}++let v5 : [i : Size] -> O ($$$$$ i)+  = \ i -> M $$$$i (L $$$i (f01 i)) (S $$$i (S $$i (S $i (Z i))))++fun emb : Nat -> O #+{ emb zero = Z #+; emb (succ n) = S # (emb n)+}++let pre : [i : Size] -> (Nat -> O ($ ($ i))) -> Nat -> O ($ i)+  = \ i -> \ f -> \ n -> case (f (succ n))+    { (Z .($ i))   -> Z i+    ; (S .($ i) x) -> x+    ; (L .($ i) g) -> g n+    ; (M .($ i) a b) -> a+    } ++fun deep : [i : Size] -> O i -> Nat -> Nat+{ deep i4 +   (M (i4 > i3) +        (L (i3 > j2) f) +        (S (i3 > i2)  +             (S (i2 > i1) +                  (S (i1 > i) x)))) n                        -- illtyped! vv+  = deep (max ($$$ i) ($$ j2)) (M (max ($$ i) ($ j2)) (L ($ i) (pre ($$ i) f)) (S j2 (f n))) (succ (succ (succ n)))+      --   8          9        10        11       12+; deep i x n = n   +}+++let four : Nat +  = succ (succ (succ (succ zero)))++eval let loop : Nat = deep # (M # (L # emb) (emb four)) four
+ test/fail/cofunIntoBoolTimesStream.err view
@@ -0,0 +1,37 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "cofunIntoBoolTimesStream.ma" ---+--- scope checking ---+--- type checking ---+type  Bool : Set+term  Bool.true : < Bool.true : Bool >+term  Bool.false : < Bool.false : Bool >+type  Prod : ++(A : Set) -> ++(B : Set) -> Set+term  Prod.pair : .[A : Set] -> .[B : Set] -> ^(fst : A) -> ^(snd : B) -> < Prod.pair fst snd : Prod A B >+term  fst : .[A : Set] -> .[B : Set] -> (pair : Prod A B) -> A+{ fst [A] [B] (Prod.pair #fst #snd) = #fst+}+term  snd : .[A : Set] -> .[B : Set] -> (pair : Prod A B) -> B+{ snd [A] [B] (Prod.pair #fst #snd) = #snd+}+type  BStr : - Size -> Set+term  BStr.cons : .[i : Size] -> ^(head : Bool) -> ^(tail : BStr i) -> < BStr.cons i head tail : BStr $i >+term  head : .[i : Size] -> (cons : BStr $i) -> Bool+{ head [i] (BStr.cons [.i] #head #tail) = #head+}+term  tail : .[i : Size] -> (cons : BStr $i) -> BStr i+{ tail [i] (BStr.cons [.i] #head #tail) = #tail+}+term  idAndLast : .[i : Size] -> BStr i -> Prod Bool (BStr i)+error during typechecking:+idAndLast+/// clause 1+/// pattern $i+/// checkPattern $i : matching on size, checking that target .[i : Size] -> BStr i -> Prod Bool (BStr i) ends in correct coinductive sized type+/// new i <= #+/// endsInSizedCo: BStr i -> Prod Bool (BStr i)+/// new  : (BStr v0)+/// endsInSizedCo: Prod Bool (BStr i)+/// allTypesOfTuple: detected tuple target, checking components+/// allComponentTypes: checking fields of tuple type [field fst : A,field snd : B] in environment Environ {envMap = [(B,(BStr v0)),(A,Bool)], envBound = Nothing}+/// endsInSizedCo: Bool+/// endsInSizedCo: target Bool of corecursive function is neither a CoSet or codata of size i nor a tuple type
+ test/fail/cofunIntoBoolTimesStream.ma view
@@ -0,0 +1,32 @@+-- 2010-05-19++data Bool : Set +{ true  : Bool+; false : Bool+}++data Prod (+ A : Set) (+ B : Set) : Set+{ pair : (fst : A) -> (snd : B) -> Prod A B+}+fields fst, snd++sized codata BStr : Size -> Set+{ cons : [i : Size] -> (head : Bool) -> (tail : BStr i) -> BStr ($ i) +}+fields head, tail++-- this code needs to be rejected by the type checker! :+-- a "function" returning the input stream plus its "last" bit+cofun idAndLast : [i : Size] -> BStr i -> Prod Bool (BStr i)+{ idAndLast ($ i) (cons .i b bs) = pair {- Bool (BStr ($ i)) -}+   (fst {- Bool (BStr i) -} (idAndLast i bs))+   (cons i b                (idAndLast i bs))+}++cofun trues : [i : Size] -> BStr i+{ trues ($ i) = cons i true (trues i)+}++-- this will loop:+eval let last : Bool = snd {- Bool (BStr #) -}  (idAndLast # (trues #))+
+ test/fail/cofunIntoStreamPlusStream.err view
@@ -0,0 +1,35 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "cofunIntoStreamPlusStream.ma" ---+--- scope checking ---+--- type checking ---+type  Unit : Set+term  Unit.unit : < Unit.unit : Unit >+type  Bool : Set+term  Bool.true : < Bool.true : Bool >+term  Bool.false : < Bool.false : Bool >+type  Twice : ++(A : Set) -> Set+term  Twice.inl : .[A : Set] -> ^(y0 : A) -> < Twice.inl y0 : Twice A >+term  Twice.inr : .[A : Set] -> ^(y0 : A) -> < Twice.inr y0 : Twice A >+term  fmap : .[A : Set] -> .[B : Set] -> (A -> B) -> Twice A -> Twice B+{ fmap [A] [B] f (Twice.inl a) = Twice.inl (f a)+; fmap [A] [B] f (Twice.inr a) = Twice.inr (f a)+}+type  BStr : - Size -> Set+term  BStr.cons : .[i : Size] -> ^(head : Bool) -> ^(tail : BStr i) -> < BStr.cons i head tail : BStr $i >+term  head : .[i : Size] -> (cons : BStr $i) -> Bool+{ head [i] (BStr.cons [.i] #head #tail) = #head+}+term  tail : .[i : Size] -> (cons : BStr $i) -> BStr i+{ tail [i] (BStr.cons [.i] #head #tail) = #tail+}+term  idAndLast : .[i : Size] -> BStr i -> Twice (BStr i)+error during typechecking:+idAndLast+/// clause 1+/// pattern $i+/// checkPattern $i : matching on size, checking that target .[i : Size] -> BStr i -> Twice (BStr i) ends in correct coinductive sized type+/// new i <= #+/// endsInSizedCo: BStr i -> Twice (BStr i)+/// new  : (BStr v0)+/// endsInSizedCo: Twice (BStr i)+/// endsInSizedCo: target Twice (BStr i) of corecursive function is neither a CoSet or codata of size i nor a tuple type
+ test/fail/cofunIntoStreamPlusStream.ma view
@@ -0,0 +1,40 @@+-- 2010-05-19++data Unit : Set+{ unit : Unit+}++data Bool : Set +{ true  : Bool+; false : Bool+}++data Twice (+ A : Set) : Set+{ inl : A -> Twice A+; inr : A -> Twice A+}++fun fmap : [A : Set] -> [B : Set] -> (A -> B) -> Twice A -> Twice B+{ fmap A B f (inl a) = inl (f a)+; fmap A B f (inr a) = inr (f a)+}++sized codata BStr : Size -> Set+{ cons : [i : Size] -> (head : Bool) -> (tail : BStr i) -> BStr ($ i) +}++-- this code needs to be rejected by the type checker! :+-- a "function" returning the input stream plus its "last" bit+cofun idAndLast : [i : Size] -> BStr i -> Twice (BStr i) +{ idAndLast ($ i) (cons .i b bs) = fmap (BStr i) (BStr ($ i))+   (cons i b) (idAndLast i bs)+}++cofun trues : [i : Size] -> BStr i+{ trues ($ i) = cons i true (trues i)+}++-- this will loop:+eval let last : Twice Unit = +  fmap (BStr #) Unit (\ x -> unit) (idAndLast # (trues #))+
+ test/fail/countingBT.err view
@@ -0,0 +1,15 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "countingBT.ma" ---+--- scope checking ---+--- type checking ---+type  BT : Set+term  BT.lf : < BT.lf : BT >+term  BT.node : ^(y0 : BT) -> ^(y1 : BT) -> < BT.node y0 y1 : BT >+term  f : BT -> BT+term  g : BT -> BT -> BT+{ f (BT.node l (BT.node rl rr)) = g l rr+}+{ g t u = f (BT.node t u)+}+error during typechecking:+Termination check for mutual block [f,g] fails for [f,g]
+ test/fail/countingBT.ma view
@@ -0,0 +1,13 @@+data BT : Set +{ lf : BT+; node : BT -> BT -> BT+}++mutual {+ fun f : BT -> BT+ { f (node l (node rl rr)) = g l rr + }+ fun g : BT -> BT -> BT+ { g t u = f (node t u)+ }+}
+ test/fail/countingMerge.err view
@@ -0,0 +1,26 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "countingMerge.ma" ---+--- scope checking ---+--- type checking ---+type  Bool : Set+term  Bool.true : < Bool.true : Bool >+term  Bool.false : < Bool.false : Bool >+type  Nat : Set+term  Nat.zero : < Nat.zero : Nat >+term  Nat.suc : ^(y0 : Nat) -> < Nat.suc y0 : Nat >+type  List : Set+term  List.nil : < List.nil : List >+term  List.cons : ^(y0 : Nat) -> ^(y1 : List) -> < List.cons y0 y1 : List >+term  leq : Nat -> Nat -> Bool+{}+term  merge : List -> List -> List+term  merge_aux : Nat -> List -> Nat -> List -> Bool -> List+{ merge List.nil l = l+; merge l List.nil = l+; merge (List.cons x xs) (List.cons y ys) = merge_aux x xs y ys (leq x y)+}+{ merge_aux x xs y ys Bool.true = List.cons x (merge xs (List.cons y ys))+; merge_aux x xs y ys Bool.false = List.cons y (merge (List.cons x xs) ys)+}+error during typechecking:+Termination check for mutual block [merge,merge_aux] fails for [merge,merge_aux]
+ test/fail/countingMerge.ma view
@@ -0,0 +1,36 @@+data Bool : Set+{ true  : Bool+; false : Bool+}++data Nat : Set+{ zero : Nat+; suc  : Nat -> Nat+}++data List : Set+{ nil  : List  +; cons : Nat -> List -> List+}++fun leq : Nat -> Nat -> Bool {}++-- merge as would be represented with "with" in Agda+mutual {+  fun merge : List -> List -> List+  { merge nil l = l+  ; merge l nil = l+  ; merge (cons x xs) (cons y ys) = merge_aux x xs y ys (leq x y)+  }+  fun merge_aux : Nat -> List -> Nat -> List -> Bool -> List+  { merge_aux x xs y ys true  = cons x (merge xs (cons y ys))+  ; merge_aux x xs y ys false = cons y (merge (cons x xs) ys) +  }+}++{- this is not recognized terminating since ++  cons y ys  is in no relation with y or ys++its size is max(y,ys) + 1, but we do not honor max in termination checking +-}
+ test/fail/dataNotMonotone.err view
@@ -0,0 +1,20 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "dataNotMonotone.ma" ---+--- scope checking ---+--- type checking ---+type  Stream : ^(A : Set) -> - Size -> Set+term  Stream.consStream : .[A : Set] -> .[i : Size] -> ^(y1 : A) -> ^(y2 : Stream A i) -> < Stream.consStream i y1 y2 : Stream A $i >+type  NotMon : ^(A : Set) -> + Size -> Set+error during typechecking:+NotMon+/// constructor NotMon.consBla+/// szConstructor NotMon : .[A : Set] -> .[i : Size] -> ^(y1 : Stream A i) -> ^(y2 : NotMon A i) -> < NotMon.consBla i y1 y2 : NotMon A $i >+/// new A : Set+/// new i <= #+/// szSizeVarUsage of i in ^(y1 : Stream A i) -> ^(y2 : NotMon A i) -> < NotMon.consBla i y1 y2 : NotMon A $i >+/// checking Stream A i  to be isotone in variable i+/// leqVal'  Stream A i  <=+  Stream A $i : Set #+/// leqVal'  i  <=-  $i : Size+/// leSize i <=- $i+/// leSize' $i <= i+/// leSize: 0 + 1 <= 0 failed
+ test/fail/dataNotMonotone.ma view
@@ -0,0 +1,10 @@+-- 2009-11-28+-- illegal use of size index (destroys monotonicity)++sized codata Stream (A : Set) : Size -> Set+{ consStream : (i : Size) -> A -> Stream A i -> Stream A ($ i)+}++sized data NotMon (A : Set) : Size -> Set+{ consBla : (i : Size) -> Stream A i -> NotMon A i -> NotMon A ($ i)+}
+ test/fail/drop.err view
@@ -0,0 +1,23 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "drop.ma" ---+--- scope checking ---+--- type checking ---+type  SNat : + Size -> Set+term  SNat.zero : .[s!ze : Size] -> .[i < s!ze] -> SNat s!ze+term  SNat.zero : .[i : Size] -> < SNat.zero i : SNat $i >+term  SNat.succ : .[s!ze : Size] -> .[i < s!ze] -> ^ SNat i -> SNat s!ze+term  SNat.succ : .[i : Size] -> ^(y1 : SNat i) -> < SNat.succ i y1 : SNat $i >+type  Stream : - Size -> Set+term  Stream.cons : .[i : Size] -> ^(y1 : SNat #) -> ^(y2 : Stream i) -> < Stream.cons i y1 y2 : Stream $i >+term  drop : .[i : Size] -> SNat i -> .[j : Size] -> Stream j -> Stream j+error during typechecking:+drop+/// clause 2+/// right hand side+/// checkExpr 7 |- drop i y j xs : Stream $j+/// leqVal' (subtyping)  < drop [i] y [j] xs : Stream j >  <=+  Stream $j+/// leqVal' (subtyping)  Stream j  <=+  Stream $j+/// leqVal'  j  <=-  $j : Size+/// leSize j <=- $j+/// leSize' $j <= j+/// leSize: 0 + 1 <= 0 failed
+ test/fail/drop.ma view
@@ -0,0 +1,18 @@++sized data SNat : Size -> Set+{+  zero : (i : Size) -> SNat ($ i);+  succ : (i : Size) -> SNat i -> SNat ($ i)+}++sized codata Stream : Size -> Set {+  cons : (i : Size) -> SNat # -> Stream i -> Stream ($ i)+}++-- drop the first elements of a stream++cofun drop : (i : Size) -> SNat i -> (j : Size) -> Stream j -> Stream j+{+  drop .($ i) (zero i)   j       xs           = xs ;+  drop .($ i) (succ i y) ($ j) (cons .j x xs) = drop i y j xs+}
+ test/fail/erased1.err view
@@ -0,0 +1,16 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "erased1.ma" ---+--- scope checking ---+--- type checking ---+error during typechecking:+id+/// checkExpr 0 |- \ A -> \ x -> x : .[A : Set] -> .[A] -> A+/// checkForced fromList [] |- \ A -> \ x -> x : .[A : Set] -> .[A] -> A+/// new A : Set+/// checkExpr 1 |- \ x -> x : .[A] -> A+/// checkForced fromList [(A,0)] |- \ x -> x : .[A] -> A+/// new x : v0+/// checkExpr 2 |- x : A+/// inferExpr' x+/// inferExpr: variable x : A may not occur+/// , because it is marked as erased
+ test/fail/erased1.ma view
@@ -0,0 +1,5 @@+-- invalid use of erased data++let id : (A : Set) -> [A] -> A +       = \ A -> \ x -> x+
+ test/fail/f_x_is_f_0.err view
@@ -0,0 +1,15 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "f_x_is_f_0.ma" ---+--- scope checking ---+--- type checking ---+type  SNat : + Size -> Set+term  SNat.zero : .[s!ze : Size] -> .[i < s!ze] -> SNat s!ze+term  SNat.zero : .[i : Size] -> < SNat.zero i : SNat $i >+term  SNat.succ : .[s!ze : Size] -> .[i < s!ze] -> ^ SNat i -> SNat s!ze+term  SNat.succ : .[i : Size] -> ^(y1 : SNat i) -> < SNat.succ i y1 : SNat $i >+term  f : .[i : Size] -> SNat i -> SNat #+error during typechecking:+f+/// clause 1+/// pattern $$i+/// cannot match against deep successor pattern $$i at type .[i : Size] -> SNat i -> SNat #
+ test/fail/f_x_is_f_0.ma view
@@ -0,0 +1,11 @@++sized data SNat : Size -> Set+{+zero : (i : Size) -> SNat ($ i);+succ : (i : Size) -> SNat i -> SNat ($ i)+}++fun f : (i : Size) -> SNat i -> SNat #+{+f ($ ($ i)) x = f ($ i) (zero i) +}
+ test/fail/fail1.err view
@@ -0,0 +1,14 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "fail1.ma" ---+--- scope checking ---+--- type checking ---+type  SNat : + Size -> Set+term  SNat.zero : .[s!ze : Size] -> .[i < s!ze] -> SNat s!ze+term  SNat.zero : .[i : Size] -> < SNat.zero i : SNat $i >+term  SNat.succ : .[s!ze : Size] -> .[i < s!ze] -> ^ SNat i -> SNat s!ze+term  SNat.succ : .[i : Size] -> ^(y1 : SNat i) -> < SNat.succ i y1 : SNat $i >+term  inc : .[i : Size] -> .[j : Size] -> SNat i -> SNat j+error during typechecking:+inc+/// clause 1+/// size constraints [?0+1<=v1,v0<=?0,SizeMeta(?0)] unsolvable
+ test/fail/fail1.ma view
@@ -0,0 +1,12 @@+-- rigid variable clash++sized data SNat : Size -> Set+{+zero : (i : Size) -> SNat ($ i);+succ : (i : Size) -> SNat i -> SNat ($ i)+}++fun inc : (i : Size) -> (j : Size) -> SNat i -> SNat j+{+inc i j x = succ _ x;+}
+ test/fail/fibStream.err view
@@ -0,0 +1,29 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "fibStream.ma" ---+--- scope checking ---+--- type checking ---+type  Nat : Set+term  Nat.zero : < Nat.zero : Nat >+term  Nat.succ : ^(y0 : Nat) -> < Nat.succ y0 : Nat >+term  add : Nat -> Nat -> Nat+{ add Nat.zero = \ y -> y+; add (Nat.succ x) = \ y -> Nat.succ (add x y)+}+type  Stream : ++(A : Set) -> - Size -> Set+term  Stream.cons : .[A : Set] -> .[i : Size] -> ^(y1 : A) -> ^(y2 : Stream A i) -> < Stream.cons i y1 y2 : Stream A $i >+term  tail : .[A : Set] -> .[i : Size] -> Stream A $i -> Stream A i+{ tail [A] [i] (Stream.cons [.i] x xs) = xs+}+term  zipWith : .[A : Set] -> .[B : Set] -> .[C : Set] -> (A -> B -> C) -> .[i : Size] -> Stream A i -> Stream B i -> Stream C i+{ zipWith [A] [B] [C] f $[i < #] (Stream.cons [.i] a as) (Stream.cons [.i] b bs) = Stream.cons [i] (f a b) (zipWith [A] [B] [C] f [i] as bs)+}+term  n0 : Nat+term  n0 = Nat.zero+term  n1 : Nat+term  n1 = Nat.succ n0+term  fib : .[i : Size] -> Stream Nat i+error during typechecking:+fib+/// clause 1+/// pattern $$i+/// cannot match against deep successor pattern $$i at type .[i : Size] -> Stream Nat i
+ test/fail/fibStream.ma view
@@ -0,0 +1,37 @@++data Nat : Set {+  zero : Nat;+  succ : Nat -> Nat +}++fun add : Nat -> Nat -> Nat {+  add zero = \y -> y;+  add (succ x) = \y -> succ (add x y)+}++sized codata Stream (+ A : Set) : Size -> Set {+  cons : (i : Size) -> A -> Stream A i -> Stream A ($ i)+}+ +fun tail : (A : Set) -> (i : Size) -> Stream A ($ i) -> Stream A i+{+  tail A i (cons .i x xs) = xs+}++cofun zipWith : (A : Set) -> (B : Set) -> (C : Set) ->+                (A -> B -> C) -> (i : Size) ->+		Stream A i -> Stream B i -> Stream C i +{+  zipWith A B C f ($ i) (cons .i a as) (cons .i b bs) = +	cons i (f a b)  (zipWith A B C f i as bs) +}++let n0 : Nat = zero+let n1 : Nat = succ n0++-- although this is productive, matching ($ ($ i)) is disallowed for cofun+cofun fib : (i : Size) -> Stream Nat i+{+  fib ($ ($ i)) = cons _ n0 (cons _ n1 (zipWith Nat Nat Nat add+    i (fib i) (tail Nat i (fib ($ i)))))+}
+ test/fail/hang.err view
@@ -0,0 +1,5 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "hang.ma" ---+--- scope checking ---+scope check error: f+/// Identifier F undefined
+ test/fail/hang.ma view
@@ -0,0 +1,19 @@+data Empty : Set+{+}++mutual +{+++fun F : Set -> Set+{+F x = F x+}++fun f  : Empty -> F Empty+{+f x = x+}++}
+ test/fail/hang2.err view
@@ -0,0 +1,13 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "hang2.ma" ---+--- scope checking ---+--- type checking ---+type  Empty : Set+term  F : Empty -> Empty+term  f : Empty -> Empty+{ F x = F x+}+{ f x = f (F x)+}+error during typechecking:+Termination check for mutual block [F,f] fails for [F,f]
+ test/fail/hang2.ma view
@@ -0,0 +1,19 @@+data Empty : Set+{+}++mutual +{++fun F : Empty -> Empty+{+F x = F x+}++-- should this scope check ? +fun f  : Empty -> Empty+{+f x = f (F x)+}++}
+ test/fail/huetHullotReverse.err view
@@ -0,0 +1,27 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "huetHullotReverse.ma" ---+--- scope checking ---+--- type checking ---+type  Enum : Set+term  Enum.aa : < Enum.aa : Enum >+term  Enum.bb : < Enum.bb : Enum >+term  Enum.cc : < Enum.cc : Enum >+type  List : ^(A : Set) -> Set+term  List.nil : .[A : Set] -> < List.nil : List A >+term  List.cons : .[A : Set] -> ^(y0 : A) -> ^(y1 : List A) -> < List.cons y0 y1 : List A >+term  list : List Enum+term  list = List.cons Enum.aa (List.cons Enum.bb (List.cons Enum.cc List.nil))+term  rev : .[A : Set] -> List A -> List A+term  rev1 : .[A : Set] -> A -> List A -> A+term  rev2 : .[A : Set] -> A -> List A -> List A+{ rev [A] List.nil = List.nil+; rev [A] (List.cons x xs) = List.cons (rev1 [A] x xs) (rev2 [A] x xs)+}+{ rev1 [A] a List.nil = a+; rev1 [A] a (List.cons x xs) = rev1 [A] x xs+}+{ rev2 [A] a List.nil = List.nil+; rev2 [A] a (List.cons x xs) = rev [A] (List.cons a (rev [A] (rev2 [A] x xs)))+}+error during typechecking:+Termination check for mutual block [rev,rev1,rev2] fails for [rev,rev2]
+ test/fail/huetHullotReverse.ma view
@@ -0,0 +1,51 @@+data Enum : Set+{+	aa : Enum ;+	bb : Enum ; +	cc : Enum +}++data List ( A : Set ) : Set +{++nil : List A;+cons : A -> List A -> List A   +}++let list : List Enum = cons aa (cons bb (cons cc (nil ))) +mutual +{++	fun rev : ( A : Set ) -> List A  -> List A +	{++	rev A (nil ) = nil ;+	rev A (cons x xs) = cons (rev1 A x xs) (rev2 A x xs)++	}++	fun rev1 : ( A : Set ) -> A -> List A -> A+	{++	rev1 A a (nil ) = a; +	rev1 A a (cons x xs) = rev1 A x xs++	}++	fun rev2 : (A : Set ) -> A -> List A -> List A +	{++	rev2 A a (nil ) = nil ;+	rev2 A a (cons x xs) = rev A (cons a (rev A (rev2 A x xs)))	+	}+}++let revlist : List Enum = rev Enum list++fun flat : (A : Set ) -> List (List A) -> List A+{+flat A (nil  .(List A)) = nil;+flat A (cons .(List A) (nil) yl) = flat A yl;+flat A (cons .(List A) (cons x xl) yl)  = cons x (flat A (cons xl yl))+}+
+ test/fail/incompleteSizePattern1.err view
@@ -0,0 +1,14 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "incompleteSizePattern1.ma" ---+--- scope checking ---+--- type checking ---+type  Empty : Set+term  bad' : .[Size] -> Empty+error during typechecking:+bad'+/// clause 1+/// pattern $i+/// checkPattern $i : matching on size, checking that target .[Size] -> Empty ends in correct coinductive sized type+/// new  <= #+/// endsInSizedCo: Empty+/// endsInSizedCo: target Empty of corecursive function is neither a CoSet or codata of size  nor a tuple type
+ test/fail/incompleteSizePattern1.ma view
@@ -0,0 +1,11 @@++data Empty : Set+{+}++-- recursion on Size fails since ($ i) is not a complete pattern match+cofun bad' : Size -> Empty+{+  bad' ($ i) = bad' _+}+
+ test/fail/incompleteSizePattern2.err view
@@ -0,0 +1,13 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "incompleteSizePattern2.ma" ---+--- scope checking ---+--- type checking ---+type  Bool : Set+term  Bool.tt : < Bool.tt : Bool >+term  Bool.ff : < Bool.ff : Bool >+term  bad'' : .[Size] -> Bool+error during typechecking:+bad''+/// clause 1+/// pattern $i+/// successor pattern only allowed in cofun
+ test/fail/incompleteSizePattern2.ma view
@@ -0,0 +1,13 @@++data Bool : Set+{+  tt : Bool;+  ff : Bool+}++fun bad'' : Size -> Bool+{+  bad'' ($ i) = bad'' _;+  bad'' i = tt+}+-- 2010-08-18  ($ i) only allowed in cofun
+ test/fail/inconsistentAssumption.err view
@@ -0,0 +1,27 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "inconsistentAssumption.ma" ---+--- scope checking ---+--- type checking ---+type  SNat : + Size -> Set+term  SNat.zero : .[s!ze : Size] -> .[i < s!ze] -> SNat s!ze+term  SNat.zero : .[i : Size] -> < SNat.zero i : SNat $i >+term  SNat.succ : .[s!ze : Size] -> .[i < s!ze] -> ^ SNat i -> SNat s!ze+term  SNat.succ : .[i : Size] -> ^(y1 : SNat i) -> < SNat.succ i y1 : SNat $i >+type  Eq : ^(A : Set) -> ^(a : A) -> ^ A -> Set+term  Eq.refl : .[A : Set] -> .[a : A] -> < Eq.refl : Eq A a a >+term  subst : .[A : Set] -> .[P : A -> Set] -> (i : A) -> (j : A) -> Eq A i j -> P i -> P j+{ subst [A] [P] i .i Eq.refl p = p+}+error during typechecking:+type of h+/// not a type: (ass : (i : Size) -> Eq Size $i i) -> (i : Size) -> SNat i -> SNat #+/// inferExpr' (ass : (i : Size) -> Eq Size $i i) -> (i : Size) -> SNat i -> SNat #+/// inferExpr' (i : Size) -> Eq Size $i i+/// new i <= #+/// inferExpr' Eq Size $i i+/// inferExpr' Eq Size $i+/// inferExpr' Eq Size+/// checkApp (^(A : Set) -> ^(a : A) -> ^ A -> Set) eliminated by Size+/// leqVal' (subtyping)  < Size : TSize >  <=+  Set+/// leqVal' (subtyping)  TSize  <=+  Set+/// universe test TSize <= Set failed
+ test/fail/inconsistentAssumption.ma view
@@ -0,0 +1,38 @@+sized data SNat : Size -> Set+{+	zero : (i : Size) -> SNat ($ i);+	succ : (i : Size) -> SNat i -> SNat ($ i)+}++data Eq (A : Set) (a : A) : A -> Set+{+  refl : Eq A a a+}++fun subst : (A : Set) -> (P : A -> Set) -> (i : A) -> (j : A) ->+            Eq A i j -> P i -> P j+{+  subst A P i .i (refl) p = p+}++fun h : (ass : (i : Size) -> Eq Size ($ i) i) -> (i : Size) -> SNat i -> SNat #+{+  h ass .($ i) (zero i)   = h ass i (subst Size SNat ($ i) i (ass i) (zero i));+  h ass .($ i) (succ i n) = h ass i n+}+++let loop : (ass : (i : Size) -> Eq Size ($ i) i) -> SNat # +         = \ ass -> h ass # (zero #) +++-- the following program has to be rejected +-- because of incomplete pattern matching+fun g : (ass : (i : Size) -> Eq Size ($ i) i) -> (i : Size) -> SNat i -> SNat #+{+  g ass ($ i) x = g ass i (subst Size SNat ($ i) i (ass i) x)+}++-- let  yy : (ass : (i : Size) -> Eq Size ($ i) i) -> +--	     Eq (SNat #) (zero #) (g ass # (zero #)) +--         = \ ass -> refl (SNat #) (zero #)
+ test/fail/inconsistentAssumption2.err view
@@ -0,0 +1,27 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "inconsistentAssumption2.ma" ---+--- scope checking ---+--- type checking ---+type  SNat : + Size -> Set+term  SNat.zero : .[s!ze : Size] -> .[i < s!ze] -> SNat s!ze+term  SNat.zero : .[i : Size] -> < SNat.zero i : SNat $i >+term  SNat.succ : .[s!ze : Size] -> .[i < s!ze] -> ^ SNat i -> SNat s!ze+term  SNat.succ : .[i : Size] -> ^(y1 : SNat i) -> < SNat.succ i y1 : SNat $i >+type  Eq : ^(A : Set) -> ^(a : A) -> ^ A -> Set+term  Eq.refl : .[A : Set] -> .[a : A] -> < Eq.refl : Eq A a a >+term  subst : .[A : Set] -> .[P : A -> Set] -> (i : A) -> (j : A) -> Eq A i j -> P i -> P j+{ subst [A] [P] i .i Eq.refl p = p+}+error during typechecking:+type of h+/// not a type: (ass : (i : Size) -> Eq Size $i i) -> (i : Size) -> SNat i -> SNat #+/// inferExpr' (ass : (i : Size) -> Eq Size $i i) -> (i : Size) -> SNat i -> SNat #+/// inferExpr' (i : Size) -> Eq Size $i i+/// new i <= #+/// inferExpr' Eq Size $i i+/// inferExpr' Eq Size $i+/// inferExpr' Eq Size+/// checkApp (^(A : Set) -> ^(a : A) -> ^ A -> Set) eliminated by Size+/// leqVal' (subtyping)  < Size : TSize >  <=+  Set+/// leqVal' (subtyping)  TSize  <=+  Set+/// universe test TSize <= Set failed
+ test/fail/inconsistentAssumption2.ma view
@@ -0,0 +1,32 @@+sized data SNat : Size -> Set+{+	zero : (i : Size) -> SNat ($ i);+	succ : (i : Size) -> SNat i -> SNat ($ i)+}++data Eq (A : Set) (a : A) : A -> Set+{+  refl : Eq A a a+}++fun subst : (A : Set) -> (P : A -> Set) -> (i : A) -> (j : A) ->+            Eq A i j -> P i -> P j+{+  subst A P i .i (refl) p = p+}++-- h is not a problem since the right hand side of the first clause+-- does not reduce if ass i is not refl+fun h : (ass : (i : Size) -> Eq Size ($ i) i) -> (i : Size) -> SNat i -> SNat #+{+  h ass .($ i) (zero i)   = h ass i (subst Size SNat ($ i) i (ass i) (zero i));+  h ass .($ i) (succ i n) = h ass i n+}+++let loop : (ass : (i : Size) -> Eq Size ($ i) i) -> SNat # +         = \ ass -> h ass # (zero #) ++let  yy : (ass : (i : Size) -> Eq Size ($ i) i) -> +	     Eq (SNat #) (zero #) (h ass # (zero #)) +        = \ ass -> refl
+ test/fail/inductiveNotDotPattern.err view
@@ -0,0 +1,20 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "inductiveNotDotPattern.ma" ---+--- scope checking ---+--- type checking ---+type  SNat : + Size -> Set+term  SNat.zero : .[s!ze : Size] -> .[i < s!ze] -> SNat s!ze+term  SNat.zero : .[i : Size] -> < SNat.zero i : SNat $i >+term  SNat.succ : .[s!ze : Size] -> .[i < s!ze] -> ^ SNat i -> SNat s!ze+term  SNat.succ : .[i : Size] -> ^(y1 : SNat i) -> < SNat.succ i y1 : SNat $i >+term  bla : .[i : Size] -> SNat $i -> SNat i+error during typechecking:+bla+/// clause 1+/// pattern zero $i+/// pattern $i+/// checkPattern $i : matching on size, checking that target .[i : Size] -> < SNat.zero i : SNat $i > ends in correct coinductive sized type+/// new i <= #+/// endsInSizedCo: < SNat.zero i : SNat $i >+/// endsInSizedCo: SNat $i+/// endsInSizedCo: target SNat $i of corecursive function is neither a CoSet or codata of size i nor a tuple type
+ test/fail/inductiveNotDotPattern.ma view
@@ -0,0 +1,20 @@+sized data SNat : Size -> Set+{+zero : (i : Size ) -> SNat ($ i);+succ : (i : Size ) -> SNat i -> SNat ($ i)+}++-- no complete pattern matching+cofun bla : (i : Size ) -> SNat ($ i) -> SNat i+{+bla .($ i) (zero ($ i)) = zero _; -- no complete pattern matching+bla .i (succ i x) = x +}++fun loop : (i : Size ) -> (SNat i) -> Set+{+loop ($ i) x = loop _ (bla _ x)+}++-- eval let diverge : Set = loop # (zero #)+
+ test/fail/lengthCoList.err view
@@ -0,0 +1,21 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "lengthCoList.ma" ---+--- scope checking ---+--- type checking ---+type  Nat : + Size -> Set+term  Nat.zero : .[s!ze : Size] -> .[i < s!ze] -> Nat s!ze+term  Nat.zero : .[i : Size] -> < Nat.zero i : Nat $i >+term  Nat.succ : .[s!ze : Size] -> .[i < s!ze] -> ^ Nat i -> Nat s!ze+term  Nat.succ : .[i : Size] -> ^(y1 : Nat i) -> < Nat.succ i y1 : Nat $i >+type  Colist : ^(A : Set) -> - Size -> Set+term  Colist.nil : .[A : Set] -> .[i : Size] -> < Colist.nil i : Colist A $i >+term  Colist.cons : .[A : Set] -> .[i : Size] -> ^(y1 : A) -> ^(y2 : Colist A i) -> < Colist.cons i y1 y2 : Colist A $i >+term  olist' : .[i : Size] -> Colist (Nat #) i+{ olist' $[i < #] = Colist.cons [i] (Nat.zero [#]) (olist' [i])+}+term  length : .[i : Size] -> .[A : Set] -> Colist A i -> Nat i+error during typechecking:+length+/// clause 1+/// pattern nil i+/// in pattern nil i, coinductive size sub pattern i must be dotted
+ test/fail/lengthCoList.ma view
@@ -0,0 +1,86 @@+sized data Nat : Size -> Set+{+  zero : [i : Size] -> Nat ($ i);+  succ : [i : Size] -> Nat i -> Nat ($ i);+}+++sized codata Colist (A : Set) : Size -> Set+{+  nil  : [i : Size] -> Colist A ($ i);+  cons : [i : Size] -> A -> Colist A i -> Colist A ($ i)+}++cofun olist' : [i : Size] -> Colist (Nat #) i+{+olist' ($ i) = cons i (zero #) (olist' i)+}++-- not allowed because no inductive argument with i +fun length : [i : Size] -> [A : Set] -> Colist A i -> Nat i+{+length .($ i) A (nil i) = zero i ;+length .($ i) A (cons i a as) = succ i (length i A as)+}++eval let diverge : Nat # = length # (Nat #) (olist' #)+++-- the rest is fine --------------------------------------------------++sized codata CoNat : Size -> Set+{+  cozero : [i : Size] -> CoNat ($ i);+  cosucc : [i : Size] -> CoNat i -> CoNat ($ i)+}++let z : CoNat # = cozero #++-- allowed because i used in coinductive result+cofun length2 : [i : Size] -> [A : Set] -> Colist A i -> CoNat i+{+length2 ($ i) A (nil .i) = cozero i;+length2 ($ i) A (cons .i a as) = cosucc i (length2 i A as) +}++cofun omega' : [i : Size] -> CoNat i+{+omega' ($ i) = cosucc i (omega' i)+}++let omega : CoNat # = omega' #++-- not ok because size not used in inductive argument +-- fun convert1 : [i : Size] -> CoNat i -> Nat i+-- {+-- convert1 ($ i) (cozero .i) = zero i;+-- convert1 ($ i) (cosucc i x) = succ i (convert1 i x) +-- }++-- ok +fun convert2 : [i : Size] -> Nat i -> CoNat i+{+convert2 ($ i) (zero .i) = cozero i;+convert2 ($ i) (succ .i x) = cosucc i (convert2 i x) +}++-- also ok+fun convert2' : [i : Size] -> Nat i -> CoNat i+{ convert2' i (zero (i > j))   = cozero j+; convert2' i (succ (i > j) x) = cosucc j (convert2' j x)+}++-- also ok+fun convert3 : [i : Size] -> Nat i -> CoNat #+{+convert3 i (zero (i > j)) = cozero #;+convert3 i (succ (i > j) x) = omega' #+}++-- also ok+cofun convert4 : [i : Size] -> Nat i -> CoNat i+{+convert4 ($ i) (zero .i) = cozero ($ i) ;+convert4 ($ i) (succ .i x) = cosucc i (convert4 i x) +}+
+ test/fail/lengthCoList2.err view
@@ -0,0 +1,5 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "lengthCoList2.ma" ---+--- scope checking ---+scope check error: convert3+/// Identifier omega' undefined
+ test/fail/lengthCoList2.ma view
@@ -0,0 +1,42 @@+sized data Nat : Size -> Set+{+  zero : [i : Size] -> Nat ($ i);+  succ : [i : Size] -> Nat i -> Nat ($ i);+}++sized codata CoNat : Size -> Set+{+  cozero : [i : Size] -> CoNat ($ i);+  cosucc : [i : Size] -> CoNat i -> CoNat ($ i)+}++let z : CoNat # = cozero #++-- ok +fun convert2 : [i : Size] -> Nat i -> CoNat i+{+convert2 ($ i) (zero .i) = cozero i;+convert2 ($ i) (succ .i x) = cosucc i (convert2 i x) +}++-- NOT ok+fun convert2' : [i : Size] -> Nat i -> CoNat i+{ convert2' i (zero (i > j))   = cozero j+; convert2' i (succ (i > j) x) = cosucc j (convert2' j x)+}+-- since $j <= i but noth otherwise!++-- ok+fun convert3 : [i : Size] -> Nat i -> CoNat #+{+convert3 i (zero (i > j)) = cozero #;+convert3 i (succ (i > j) x) = omega' #+}++-- also ok+cofun convert4 : [i : Size] -> Nat i -> CoNat i+{+convert4 ($ i) (zero .i) = cozero ($ i) ;+convert4 ($ i) (succ .i x) = cosucc i (convert4 i x) +}+
+ test/fail/loop.err view
@@ -0,0 +1,44 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "loop.ma" ---+--- scope checking ---+--- type checking ---+type  SNat : + Size -> Set+term  SNat.zero : .[s!ze : Size] -> .[i < s!ze] -> SNat s!ze+term  SNat.zero : .[i : Size] -> < SNat.zero i : SNat $i >+term  SNat.succ : .[s!ze : Size] -> .[i < s!ze] -> ^ SNat i -> SNat s!ze+term  SNat.succ : .[i : Size] -> ^(y1 : SNat i) -> < SNat.succ i y1 : SNat $i >+type  Nat : Set+type  Nat = SNat #+type  Unit : Set+term  Unit.unit : < Unit.unit : Unit >+type  Maybe : ++(A : Set) -> Set+term  Maybe.nothing : .[A : Set] -> < Maybe.nothing : Maybe A >+term  Maybe.just : .[A : Set] -> ^(y0 : A) -> < Maybe.just y0 : Maybe A >+term  shift_case : .[i : Size] -> Maybe (SNat $i) -> Maybe (SNat i)+{ shift_case [i] Maybe.nothing = Maybe.nothing+; shift_case [.i] (Maybe.just (SNat.zero [i])) = Maybe.nothing+; shift_case [.i] (Maybe.just (SNat.succ [i] x)) = Maybe.just x+}+term  shift : .[i : Size] -> (Nat -> Maybe (SNat $i)) -> Nat -> Maybe (SNat i)+term  shift = [\ i ->] \ f -> \ n -> shift_case [i] (f (SNat.succ [#] n))+term  loop : .[i : Size] -> SNat i -> (Nat -> Maybe (SNat i)) -> Unit+term  loop_case : .[i : Size] -> (Nat -> Maybe (SNat i)) -> Maybe (SNat i) -> Unit+error during typechecking:+loop+/// clause 2+/// right hand side+/// checkExpr 4 |- loop j n (shift j f) : Unit+/// inferExpr' loop j n (shift j f)+/// checkApp (((SNat #)::Tm -> {Maybe (SNat i) {i = v1}})::Tm -> {Unit {i = v1}}) eliminated by shift j f+/// inferExpr' shift j f+/// checkApp (((SNat #)::Tm -> {Maybe (SNat $i) {i = v1}})::Tm -> {Nat -> Maybe (SNat i) {i = v1}}) eliminated by f+/// leqVal' (subtyping)  (xSing# : SNat #) -> < f xSing# : Maybe (SNat i) >  <=+  SNat # -> Maybe (SNat $j)+/// new xSing# : (SNat #)+/// comparing codomain < f xSing# : Maybe (SNat i) > with Maybe (SNat $j)+/// leqVal' (subtyping)  < f xSing# : Maybe (SNat i) >  <=+  Maybe (SNat $j)+/// leqVal' (subtyping)  Maybe (SNat i)  <=+  Maybe (SNat $j)+/// leqVal'  SNat i  <=+  SNat $j : Set+/// leqVal'  i  <=+  $j : Size+/// leSize i <=+ $j+/// leSize' i <= $j+/// bound not entailed
+ test/fail/loop.ma view
@@ -0,0 +1,52 @@+sized data SNat : Size -> Set+{ zero : [i : Size] -> SNat ($ i)+; succ : [i : Size] -> SNat i -> SNat ($ i)+}++let Nat : Set = SNat #++data Unit : Set+{ unit : Unit+}++data Maybe (+ A : Set) : Set+{ nothing : Maybe A+; just : A -> Maybe A+}++fun shift_case : [i : Size] -> Maybe (SNat ($ i)) -> Maybe (SNat i)+{ shift_case  i (nothing {-.(SNat ($ i))-})         = nothing -- (SNat i)+; shift_case .i (just {-.(SNat ($ i))-} (zero i))   = nothing -- (SNat i)+; shift_case .i (just {-.(SNat ($ i))-} (succ i x)) = just x -- (SNat i) x+}++let shift : [i : Size] -> (Nat -> Maybe (SNat ($ i))) ->+                           Nat -> Maybe (SNat i) =+  \i -> \f -> \n -> shift_case i (f (succ # n))++mutual+{++  fun loop : [i : Size] -> SNat i -> (Nat -> Maybe (SNat i)) -> Unit+  { loop i (zero (i > j)  ) f = loop_case i f (f (zero j))+  ; loop i (succ (i > j) n) f = loop j n (shift j f)+  }+  -- loop j n : (Nat -> Maybe (SNat j)) -> Unit+  -- f        : Nat -> Maybe (SNat i)+  -- no way to go (with j < i)+  --   from Nat -> Maybe (SNat i)+  --   to   Nat -> Maybe (SNat j)++  fun loop_case : [i : Size] -> (Nat -> Maybe (SNat i)) ->+                                Maybe (SNat i) -> Unit+  { loop_case i f (nothing) = unit+  ; loop_case i f (just (zero (i > j)  )) = unit+  ; loop_case i f (just (succ (i > j) y)) = loop j y (shift j f)+      -- f : Nat -> Maybe (SNat i)  should have type  Nat -> Maybe (SNat ($ j))+      -- but we only know $ j <= i  and not equality+  }+}++let inc : Nat -> Maybe Nat = \n -> just (succ # n)++eval let diverge : Unit = loop # (zero #) inc
+ test/fail/loopAdmStream-Nat.err view
@@ -0,0 +1,27 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "loopAdmStream-Nat.ma" ---+--- scope checking ---+--- type checking ---+type  Nat : Set+term  Nat.zero : < Nat.zero : Nat >+term  Nat.succ : ^(y0 : Nat) -> < Nat.succ y0 : Nat >+type  Stream : ++(A : Set) -> - Size -> Set+term  Stream.cons : .[A : Set] -> .[i : Size] -> ^(head : A) -> ^(tail : Stream A i) -> < Stream.cons i head tail : Stream A $i >+term  head : .[A : Set] -> .[i : Size] -> (cons : Stream A $i) -> A+{ head [A] [i] (Stream.cons [.i] #head #tail) = #head+}+term  tail : .[A : Set] -> .[i : Size] -> (cons : Stream A $i) -> Stream A i+{ tail [A] [i] (Stream.cons [.i] #head #tail) = #tail+}+term  guard : .[j : Size] -> (Stream Nat $j -> Stream Nat #) -> Stream Nat j -> Stream Nat #+{ guard [j] g xs = g (Stream.cons [j] Nat.zero xs)+}+term  f : .[i : Size] -> (Stream Nat i -> Stream Nat #) -> Stream Nat i+error during typechecking:+f+/// clause 1+/// pattern $j+/// checkPattern $j : matching on size, checking that target .[i : Size] -> (Stream Nat i -> Stream Nat #) -> Stream Nat i ends in correct coinductive sized type+/// new i <= #+/// endsInSizedCo: (Stream Nat i -> Stream Nat #) -> Stream Nat i+/// type  Stream Nat i -> Stream Nat #  not lower semi continuous in  i
+ test/fail/loopAdmStream-Nat.ma view
@@ -0,0 +1,36 @@+-- 2010-05-11++data Nat : Set+{ zero : Nat+; succ : Nat -> Nat+}++sized codata Stream (+ A : Set) : Size -> Set +{ cons : [i : Size] -> (head : A) -> (tail : Stream A i) -> Stream A ($ i)+}+fields head, tail++fun guard : [j : Size] -> (Stream Nat ($ j) -> Stream Nat #)+                       -> (Stream Nat j     -> Stream Nat #)+{ guard j g xs = g (cons j zero xs)+}+ +-- the type of f is not admissible+cofun f : [i : Size] -> (Stream Nat i -> Stream Nat #) -> Stream Nat i+{ f ($ j) g = guard j g (f j (guard j g))+}++-- LOOP!+eval let loop : Nat = head # (f # (tail #))++{- +-- the type of f is not admissible+cofun f : (Stream Nat # -> Stream Nat #) ->+  [i : Size] -> (Stream Nat i -> Stream Nat #) -> Stream Nat i+{ f h ($ j) g = h (g (cons j zero +    (f (\ x -> h (h x)) +       j +       (\ x -> g (cons j zero x))))) +}++-}
+ test/fail/loopAdmStream-simplified.err view
@@ -0,0 +1,18 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "loopAdmStream-simplified.ma" ---+--- scope checking ---+--- type checking ---+type  StreamUnit : - Size -> Set+term  StreamUnit.cons : .[i : Size] -> ^(tail : StreamUnit i) -> < StreamUnit.cons i tail : StreamUnit $i >+term  tail : .[i : Size] -> (cons : StreamUnit $i) -> StreamUnit i+{ tail [i] (StreamUnit.cons [.i] #tail) = #tail+}+term  f : (StreamUnit # -> StreamUnit #) -> .[i : Size] -> (StreamUnit i -> StreamUnit #) -> StreamUnit i+error during typechecking:+f+/// clause 1+/// pattern $j+/// checkPattern $j : matching on size, checking that target .[i : Size] -> (StreamUnit i -> StreamUnit #) -> StreamUnit i ends in correct coinductive sized type+/// new i <= #+/// endsInSizedCo: (StreamUnit i -> StreamUnit #) -> StreamUnit i+/// type  StreamUnit i -> StreamUnit #  not lower semi continuous in  i
+ test/fail/loopAdmStream-simplified.ma view
@@ -0,0 +1,17 @@+-- 2010-05-11++sized codata StreamUnit : Size -> Set +{ cons : [i : Size] -> (tail : StreamUnit i) -> StreamUnit ($ i)+}+fields tail+ +-- the type of f is not admissible+cofun f : (StreamUnit # -> StreamUnit #) ->+  (i : Size) -> (StreamUnit i -> StreamUnit #) -> StreamUnit i+{ f h ($ j) g = h (g (cons j (f (\ x -> h (h x)) j (\ x -> g (cons j x))))) +}++let bla : StreamUnit # = f (tail #) # (\ x -> x)++-- LOOP!+eval let us : StreamUnit # = tail # bla
+ test/fail/loopAdmStream.err view
@@ -0,0 +1,23 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "loopAdmStream.ma" ---+--- scope checking ---+--- type checking ---+type  Unit : Set+term  Unit.unit : < Unit.unit : Unit >+type  Stream : ++(A : Set) -> - Size -> Set+term  Stream.cons : .[A : Set] -> .[i : Size] -> ^(head : A) -> ^(tail : Stream A i) -> < Stream.cons i head tail : Stream A $i >+term  head : .[A : Set] -> .[i : Size] -> (cons : Stream A $i) -> A+{ head [A] [i] (Stream.cons [.i] #head #tail) = #head+}+term  tail : .[A : Set] -> .[i : Size] -> (cons : Stream A $i) -> Stream A i+{ tail [A] [i] (Stream.cons [.i] #head #tail) = #tail+}+term  f : (Stream Unit # -> Stream Unit #) -> .[i : Size] -> (Stream Unit i -> Stream Unit #) -> Stream Unit i+error during typechecking:+f+/// clause 1+/// pattern $j+/// checkPattern $j : matching on size, checking that target .[i : Size] -> (Stream Unit i -> Stream Unit #) -> Stream Unit i ends in correct coinductive sized type+/// new i <= #+/// endsInSizedCo: (Stream Unit i -> Stream Unit #) -> Stream Unit i+/// type  Stream Unit i -> Stream Unit #  not lower semi continuous in  i
+ test/fail/loopAdmStream.ma view
@@ -0,0 +1,23 @@+-- 2010-05-11++data Unit : Set+{ unit : Unit +}++sized codata Stream (+ A : Set) : Size -> Set +{ cons : [i : Size] -> (head : A) -> (tail : Stream A i) -> Stream A ($ i)+}+fields head, tail+ +-- the type of f is not admissible+cofun f : (Stream Unit # -> Stream Unit #) ->+  (i : Size) -> (Stream Unit i -> Stream Unit #) -> Stream Unit i+{ f h ($ j) g = +    h (g (cons j unit (f (\ x -> h (h x)) j (\ x -> g (cons j unit x))))) +}++let bla : Stream Unit # = f (tail #) # (\ x -> x)++-- LOOP!+eval let u : Unit = head # bla+eval let us : Stream Unit # = tail # bla
+ test/fail/loopBadTypesHidden.err view
@@ -0,0 +1,43 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "loopBadTypesHidden.ma" ---+--- scope checking ---+--- type checking ---+type  SNat : + Size -> Set+term  SNat.zero : .[s!ze : Size] -> .[i < s!ze] -> SNat s!ze+term  SNat.zero : .[i : Size] -> < SNat.zero i : SNat $i >+term  SNat.succ : .[s!ze : Size] -> .[i < s!ze] -> ^ SNat i -> SNat s!ze+term  SNat.succ : .[i : Size] -> ^(y1 : SNat i) -> < SNat.succ i y1 : SNat $i >+type  Maybe : ++(A : Set) -> Set+term  Maybe.nothing : .[A : Set] -> < Maybe.nothing : Maybe A >+term  Maybe.just : .[A : Set] -> ^(y0 : A) -> < Maybe.just y0 : Maybe A >+type  Nat : Set+type  Nat = SNat #+term  shift_case : .[i : Size] -> Maybe (SNat $i) -> Maybe (SNat i)+{ shift_case [i] Maybe.nothing = Maybe.nothing+; shift_case [.i] (Maybe.just (SNat.zero [i])) = Maybe.nothing+; shift_case [.i] (Maybe.just (SNat.succ [i] x)) = Maybe.just x+}+term  shift : .[i : Size] -> (Nat -> Maybe (SNat $i)) -> Nat -> Maybe (SNat i)+term  shift = [\ i ->] \ f -> \ n -> shift_case [i] (f (SNat.succ [#] n))+term  inc : Nat -> Maybe Nat+term  inc = \ n -> Maybe.just (SNat.succ [#] n)+type  Unit : Set+term  Unit.unit : < Unit.unit : Unit >+type  loopType : Unit -> Set+{ loopType un!t = .[i : Size] -> SNat i -> (Nat -> Maybe (SNat i)) -> Unit+}+type  loopCaseType : Unit -> Set+{ loopCaseType un!t = .[i : Size] -> (Nat -> Maybe (SNat i)) -> Maybe (SNat i) -> Unit+}+term  loop : (u : Unit) -> loopType u+term  loop_case : (u : Unit) -> loopCaseType u+error during typechecking:+checking type of loop for admissibility+/// new un!t : _+/// new i : _+/// new f : _+/// new i <= #+/// admType: checking ((SNat v3)::Tm -> {(Nat -> Maybe (SNat i)) -> Unit {i = v3, un!t = v0}}) admissible in v3+/// new  : (SNat v3)+/// admType: checking (((SNat #)::Tm -> {Maybe (SNat i) {i = v3, un!t = v0}})::Tm -> {Unit {i = v3, un!t = v0}}) admissible in v3+/// type  SNat # -> Maybe (SNat i)  not lower semi continuous in  i
+ test/fail/loopBadTypesHidden.ma view
@@ -0,0 +1,63 @@+sized data SNat : Size -> Set+{+	zero : (i : Size) -> SNat ($ i);+	succ : (i : Size) -> SNat i -> SNat ($ i)+}++data Maybe (+ A : Set) : Set+{+  nothing : Maybe A;+  just : A -> Maybe A+}++let Nat : Set = SNat #++fun shift_case : (i : Size) -> Maybe (SNat ($ i)) -> Maybe (SNat i)+{++shift_case i nothing = nothing;+shift_case .i (just (zero i)) = nothing;+shift_case .i (just (succ i x)) = just x++}++let shift : (i : Size) -> (Nat -> Maybe (SNat ($ i))) -> Nat -> Maybe (SNat i) = +\i -> \f -> \n -> shift_case i (f (succ # n))++let inc : Nat -> Maybe Nat = \n -> just (succ # n)++data Unit : Set+{+	unit : Unit+}++fun loopType : Unit -> Set +{+loopType unit = (i : Size) -> SNat i -> (Nat -> Maybe (SNat i)) -> Unit+}++fun loopCaseType : Unit -> Set+{+loopCaseType unit = (i : Size) -> (Nat -> Maybe (SNat i)) -> Maybe (SNat i) -> Unit+}+++-- hide bad types ....+mutual +{++fun loop : (u : Unit) -> loopType u  +{+loop unit .($ i) (zero i) f = loop_case unit ($ i) f (f (zero i)); +loop unit .($ i) (succ i n) f = loop unit i n (shift i f)+}++fun loop_case : (u : Unit) -> loopCaseType u +{+loop_case unit i       f (nothing) = unit;+loop_case unit .($ i)  f (just  (zero i)) = unit;+loop_case unit .($ i)  f (just (succ i y)) = loop unit i y (shift i f) +}+}++eval let diverge : Unit = loop unit # (zero #) inc
+ test/fail/loopBounded.err view
@@ -0,0 +1,44 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "loopBounded.ma" ---+--- scope checking ---+--- type checking ---+type  Empty : Set+type  Unit : Set+term  Unit.unit : < Unit.unit : Unit >+type  Maybe : ++(A : Set) -> Set+term  Maybe.nothing : .[A : Set] -> < Maybe.nothing : Maybe A >+term  Maybe.just : .[A : Set] -> ^(a : A) -> < Maybe.just a : Maybe A >+type  Nat : + Size -> Set+{ Nat i = Maybe (.[j < i] & Nat j)+}+pattern zero = nothing+pattern suc i n = just (i, n)+term  pred : .[i : Size] -> Nat $i -> Nat i+{ pred [i] Maybe.nothing = Maybe.nothing+; pred [i] (Maybe.just ([j < $i], n)) = n+}+term  wfix : .[A : Size -> Set] -> (f : .[i : Size] -> (.[j < i] -> A j) -> A i) -> .[i : Size] -> A i+{ wfix [A] f [i] = f [i] (wfix [A] f)+}+term  fix : .[A : Size -> Set] -> (f : .[i : Size] -> A i -> A $i) -> .[i : Size] -> A i+block fails as expected, error message:+fix+/// clause 1+/// right hand side+/// checkExpr 3 |- f i (fix A f) : A i+/// inferExpr' f i (fix A f)+/// checkApp ((v0 v2)::Tm -> {A $i {i = v2, A = (v0 Up (Size -> Set))}}) eliminated by fix A f+/// leqVal' (subtyping)  .[i : Size] -> < fix [A ] (f i ) i : A i >  <=+  A i+/// leqApp: head mismatch .[i : Size] -> < fix [A ] (f i ) i : A i > != A+type  A : -(i : Size) -> Set+type  A = \ i -> (Nat # -> Nat i) -> Nat #+term  fix : (f : .[i : Size] -> A i -> A $i) -> .[i : Size] -> A i+error during typechecking:+fix+/// clause 1+/// right hand side+/// checkExpr 2 |- f i (fix f i) : (Nat # -> Nat i) -> Nat #+/// inferExpr' f i (fix f i)+/// checkApp ((((Nat #)::Tm -> {Nat i {i = v1}})::Tm -> {Nat # {i = v1}})::Tm -> {A $i {i = v1}}) eliminated by fix f i+/// checkGuard |i| < |i|+/// lexSizes: no descent detected
+ test/fail/loopBounded.ma view
@@ -0,0 +1,39 @@+-- 2012-02-04++data Empty {}+data Unit { unit }+data Maybe ++(A : Set) { nothing ; just (a : A) }++cofun Nat : +Size -> Set+{ Nat i = Maybe ([j < i] & Nat j) +}+pattern zero    = nothing+pattern suc i n = just (i, n)++fun pred : [i : Size] -> Nat $i -> Nat i+{ pred i zero      = zero+; pred i (suc j n) = n+}++{-+fun loop : [i : Size] -> Nat i -> Unit+{ loop i zero      = unit+; loop i (suc j n) = loop j (pred j (suc j n))+}+-}++fun wfix : [A : Size -> Set] (f : [i : Size] -> ([j < i] -> A j) -> A i)  +  [i : Size]  -> |i| -> A i+{ wfix A f i = f i (wfix A f)+}++fail+fun fix : [A : Size -> Set] (f : [i : Size] -> A i -> A $i) [i : Size] -> A i+{ fix A f i = f i (fix A f)+}++let A -(i : Size) = (Nat # -> Nat i) -> Nat #++fun fix : (f : [i : Size] -> A i -> A $i) [i : Size] -> |i| -> A i+{ fix f i = f i (fix f i)+}
+ test/fail/loopOldNoSizePattern.err view
@@ -0,0 +1,36 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "loopOldNoSizePattern.ma" ---+--- scope checking ---+--- type checking ---+type  SNat : + Size -> Set+term  SNat.zero : .[s!ze : Size] -> .[i < s!ze] -> SNat s!ze+term  SNat.zero : .[i : Size] -> < SNat.zero i : SNat $i >+term  SNat.succ : .[s!ze : Size] -> .[i < s!ze] -> ^ SNat i -> SNat s!ze+term  SNat.succ : .[i : Size] -> ^(y1 : SNat i) -> < SNat.succ i y1 : SNat $i >+type  Maybe : ++(A : Set) -> Set+term  Maybe.nothing : .[A : Set] -> < Maybe.nothing : Maybe A >+term  Maybe.just : .[A : Set] -> ^(y0 : A) -> < Maybe.just y0 : Maybe A >+type  Nat : Set+type  Nat = SNat #+term  shift_case : .[i : Size] -> Maybe (SNat $i) -> Maybe (SNat i)+{ shift_case [i] Maybe.nothing = Maybe.nothing+; shift_case [.i] (Maybe.just (SNat.zero [i])) = Maybe.nothing+; shift_case [.i] (Maybe.just (SNat.succ [i] x)) = Maybe.just x+}+term  shift : .[i : Size] -> (Nat -> Maybe (SNat $i)) -> Nat -> Maybe (SNat i)+term  shift = [\ i ->] \ f -> \ n -> shift_case [i] (f (SNat.succ [#] n))+term  inc : Nat -> Maybe Nat+term  inc = \ n -> Maybe.just (SNat.succ [#] n)+type  Unit : Set+term  Unit.unit : < Unit.unit : Unit >+term  loop : .[i : Size] -> SNat i -> (Nat -> Maybe (SNat i)) -> Unit+term  loop_case : .[i : Size] -> (Nat -> Maybe (SNat i)) -> Maybe (SNat i) -> Unit+error during typechecking:+checking type of loop for admissibility+/// new i : _+/// new f : _+/// new i <= #+/// admType: checking ((SNat v2)::Tm -> {(Nat -> Maybe (SNat i)) -> Unit {i = v2}}) admissible in v2+/// new  : (SNat v2)+/// admType: checking (((SNat #)::Tm -> {Maybe (SNat i) {i = v2}})::Tm -> {Unit {i = v2}}) admissible in v2+/// type  SNat # -> Maybe (SNat i)  not lower semi continuous in  i
+ test/fail/loopOldNoSizePattern.ma view
@@ -0,0 +1,52 @@+sized data SNat : Size -> Set+{+  zero : (i : Size ) -> SNat ($ i);+  succ : (i : Size) -> SNat i -> SNat ($ i)+}++data Maybe (+ A : Set) : Set+{+  nothing : Maybe A;+  just : A -> Maybe A+}++let Nat : Set = SNat #++fun shift_case : (i : Size) -> Maybe (SNat ($ i)) -> +                               Maybe (SNat i)+{+  shift_case  i nothing           = nothing;+  shift_case .i (just (zero i))   = nothing;+  shift_case .i (just (succ i x)) = just x  +}++let shift : (i : Size) -> (Nat -> Maybe (SNat ($ i))) -> +                           Nat -> Maybe (SNat i) = +\i -> \f -> \n -> shift_case i (f (succ # n))++let inc : Nat -> Maybe Nat = \n -> just (succ # n)++data Unit : Set+{+  unit : Unit+}++mutual +{+  +  fun loop : (i : Size) -> SNat i -> (Nat -> Maybe (SNat i)) -> Unit+  {+    loop .($ i) (zero i)   f = loop_case ($ i) f (f (zero i)); +    loop .($ i) (succ i n) f = loop i n (shift i f)+  }+  +  fun loop_case : (i : Size) -> (Nat -> Maybe (SNat i)) -> +                                Maybe (SNat i) -> Unit+  {+    loop_case i       f (nothing) = unit;+    loop_case .($ i)  f (just (zero i)) = unit;+    loop_case .($ i)  f (just (succ i y)) = loop i y (shift i f) +  }+}++eval let diverge : Unit = loop # (zero #) inc
+ test/fail/loopTypesHiddenInData.err view
@@ -0,0 +1,3 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "loopTypesHiddenInData.ma" ---+--- scope checking ---
+ test/fail/loopTypesHiddenInData.ma view
@@ -0,0 +1,63 @@+sized data SNat : Size -> Set+{+	zero : [i : Size] -> SNat ($ i);+	succ : [i : Size] -> SNat i -> SNat ($ i)+}++data Maybe ( + A : Set ) : Set+{+  nothing : Maybe A;+  just : A -> Maybe A+}++let Nat : Set = SNat #++fun shift_case : (i : Size) -> Maybe (SNat ($ i)) -> Maybe (SNat i)+{++shift_case i (nothing ) = nothing;+shift_case .i (just (zero i)) = nothing;+shift_case .i (just (succ i x)) = just x++}++let shift : (i : Size) -> (Nat -> Maybe (SNat ($ i))) -> Nat -> Maybe (SNat i) = +\i -> \f -> \n -> shift_case i (f (succ # n))++let inc : Nat -> Maybe Nat = \n -> just (succ # n)++data Unit : Set+{+	unit : Unit+}++data loopType : Set +{+lt : [i : Size] -> SNat i -> (Nat -> Maybe (SNat i)) -> loopType+}++data loopCaseType : Set+{+lct : [i : Size] -> (Nat -> Maybe (SNat i)) -> Maybe (SNat i) -> loopCaseType+}+++-- hide bad types ....+mutual +{++fun loop : loopType -> Unit+{+loop (lt .($ i) (zero i) f) = loop_case (lct ($ i) f (f (zero i))); +loop (lt .($ i) (succ i n) f) = loop (lt i n (shift i f))+}++fun loop_case : loopCaseType -> Unit +{+loop_case (lct i f (nothing) = unit;+loop_case (lct .($ i)  f (just  (zero i))) = unit;+loop_case (lct .($ i)  f (just (succ i y))) = loop (lt i y (shift i f)) +}+}++eval let diverge : Unit = loop (lt # (zero #) inc)
+ test/fail/mapStream2.err view
@@ -0,0 +1,16 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "mapStream2.ma" ---+--- scope checking ---+--- type checking ---+type  Stream : ++(A : Set) -> - Size -> Set+term  Stream.cons : .[A : Set] -> .[i : Size] -> ^(y1 : A) -> ^(y2 : Stream A i) -> < Stream.cons i y1 y2 : Stream A $i >+type  Nat : Set+term  Nat.zero : < Nat.zero : Nat >+term  Nat.succ : ^(y0 : Nat) -> < Nat.succ y0 : Nat >+term  map2 : .[i : Size] -> (Nat -> Nat) -> Stream Nat i -> Stream Nat i+error during typechecking:+map2+/// clause 1+/// pattern cons .$i u (cons i x xl)+/// pattern cons i x xl+/// in pattern cons i x xl, coinductive size sub pattern i must be dotted
+ test/fail/mapStream2.ma view
@@ -0,0 +1,33 @@++sized codata Stream (+ A : Set) : Size -> Set {+  cons : (i : Size) -> A -> Stream A i -> Stream A ($ i)+}+ +data Nat : Set {+  zero : Nat;+  succ : Nat -> Nat +}++-- THIS SHOULD NOT TYPECHECK!!+cofun map2 : (i : Size) -> (Nat -> Nat) -> Stream Nat i -> Stream Nat i +{+map2 .($ ($ i)) f (cons .($ i) u (cons i x xl)) = +  cons _ (f u) (cons _ (f x) (map2 _ f xl))+}++{- a better explanation why this does not work:++- the quantification  (i : Size) -> ... Stream Nat i  is a CoSize quant.+- disallow dot patterns for CoSize ++cofun map2 : (i : Size) -> (Nat -> Nat) -> Stream Nat i -> Stream Nat i +{+map2 ($ ($ i)) f (cons .Nat .($ i) u (cons .Nat .i x xl)) = +  cons Nat _ (f u) (cons Nat _ (f x) (map2 _ f xl))+}++- this then fails since deep matching is not allowed+- for the CoSizes inside the cons we would still have to allow dot patterns+- how to separate these two uses?+- maybe: the size pattern inside cocons can only be a dot pattern?!+-}
+ test/fail/mapStream2sizeMatchDepth2.err view
@@ -0,0 +1,15 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "mapStream2sizeMatchDepth2.ma" ---+--- scope checking ---+--- type checking ---+type  Stream : ++(A : Set) -> - Size -> Set+term  Stream.cons : .[A : Set] -> .[i : Size] -> ^(y1 : A) -> ^(y2 : Stream A i) -> < Stream.cons i y1 y2 : Stream A $i >+type  Nat : Set+term  Nat.zero : < Nat.zero : Nat >+term  Nat.succ : ^(y0 : Nat) -> < Nat.succ y0 : Nat >+term  map2 : .[i : Size] -> (Nat -> Nat) -> Stream Nat i -> Stream Nat i+error during typechecking:+map2+/// clause 1+/// pattern $$i+/// cannot match against deep successor pattern $$i at type .[i : Size] -> (Nat -> Nat) -> Stream Nat i -> Stream Nat i
+ test/fail/mapStream2sizeMatchDepth2.ma view
@@ -0,0 +1,37 @@++sized codata Stream (+ A : Set) : Size -> Set {+  cons : (i : Size) -> A -> Stream A i -> Stream A ($ i)+}+ +data Nat : Set {+  zero : Nat;+  succ : Nat -> Nat +}++{-+-- This is now illegal since cosize patterns must be dotted in coconstructors.+cofun map2 : (i : Size) -> (Nat -> Nat) -> Stream Nat i -> Stream Nat i +{+map2 .($ ($ i)) f (cons .Nat .($ i) u (cons .Nat i x xl)) = +  cons Nat _ (f u) (cons Nat _ (f x) (map2 _ f xl))+}+-}++{- a better explanation why this does not work:++- the quantification  (i : Size) -> ... Stream Nat i  is a CoSize quant.+- disallow dot patterns for CoSize +-}++cofun map2 : (i : Size) -> (Nat -> Nat) -> Stream Nat i -> Stream Nat i +{+map2 ($ ($ i)) f (cons .Nat .($ i) u (cons .Nat .i x xl)) = +  cons Nat _ (f u) (cons Nat _ (f x) (map2 _ f xl))+}++{-+- this then fails since deep matching is not allowed+- for the CoSizes inside the cons we would still have to allow dot patterns+- how to separate these two uses?+- maybe: the size pattern inside cocons can only be a dot pattern?!+-}
+ test/fail/matchOnNatSuccI.err view
@@ -0,0 +1,17 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "matchOnNatSuccI.ma" ---+--- scope checking ---+--- type checking ---+type  Nat : + Size -> Set+term  Nat.zero : .[s!ze : Size] -> .[i < s!ze] -> Nat s!ze+term  Nat.zero : .[i : Size] -> < Nat.zero i : Nat $i >+term  Nat.succ : .[s!ze : Size] -> .[i < s!ze] -> ^ Nat i -> Nat s!ze+term  Nat.succ : .[i : Size] -> ^(y1 : Nat i) -> < Nat.succ i y1 : Nat $i >+term  foo : .[i : Size] -> Nat i+{}+type  foo2 : (i : Size) -> Nat $i -> Set+{ foo2 i (Nat.zero [.i]) = foo2 # (Nat.zero [#])+; foo2 i (Nat.succ [.i] x) = Nat #+}+error during typechecking:+Termination check for function foo2 fails
+ test/fail/matchOnNatSuccI.ma view
@@ -0,0 +1,22 @@+sized data Nat : Size -> Set+{+zero : ( i : Size ) -> Nat ($ i);+succ : ( i : Size ) -> Nat i -> Nat ($ i);+}+++-- size not used+fun foo : (i : Size ) -> Nat i+{+--foo ($ i) = foo i -- subtyping +}+++-- not inductive in i+fun foo2 : (i : Size ) -> Nat ($ i) -> Set+{+foo2 i (zero .i) = foo2 _ (zero _);+foo2 i (succ .i x) = Nat _+}++-- I think the analysis declares i unusable for termination, and then the check fails
+ test/fail/match_erased.err view
@@ -0,0 +1,13 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "match_erased.ma" ---+--- scope checking ---+--- type checking ---+type  Nat : Set+term  Nat.zero : < Nat.zero : Nat >+term  Nat.succ : ^(y0 : Nat) -> < Nat.succ y0 : Nat >+term  illegal_match : Nat -> .[Nat] -> Nat+error during typechecking:+illegal_match+/// clause 1+/// pattern zero+/// checkPattern: constructor Nat.zero of non-computational argument zero : Nat not forced
+ test/fail/match_erased.ma view
@@ -0,0 +1,12 @@+data Nat : Set+{+  zero : Nat;+  succ : Nat -> Nat+}++-- The following should not type check.+fun illegal_match : Nat -> [Nat] -> Nat+{+  illegal_match x zero = x;+  illegal_match x (succ y) = x+}
+ test/fail/match_on_set.err view
@@ -0,0 +1,5 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "match_on_set.ma" ---+--- scope checking ---+scope check error: bla+/// pattern A is not a constructor
+ test/fail/match_on_set.ma view
@@ -0,0 +1,8 @@+data A : Set {}+data B : Set {}++fun bla : Set -> Set+{+  bla A = B;+  bla B = A+}
+ test/fail/negativeFam.err view
@@ -0,0 +1,13 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "negativeFam.ma" ---+--- scope checking ---+--- type checking ---+type  Nat : Set+term  Nat.zero : < Nat.zero : Nat >+term  Nat.suc : ^(y0 : Nat) -> < Nat.suc y0 : Nat >+type  D : ^ Nat -> Set+term  D.abs : ^(y0 : D Nat.zero -> D Nat.zero) -> < D.abs y0 : D Nat.zero >+term  D.app : .[n : Nat] -> ^(y1 : D n) -> ^(y2 : D n) -> < D.app n y1 y2 : D n >+error during typechecking:+checking positivity+/// polarity check ++ <= - failed
+ test/fail/negativeFam.ma view
@@ -0,0 +1,11 @@+data Nat : Set+{+  zero : Nat;+  suc : Nat -> Nat+}++data D : Nat -> Set +{+  abs : (D zero -> D zero) -> D zero;+  app : (n : Nat) -> D n -> D n -> D n+}
+ test/fail/notAdmMonotoneArg.err view
@@ -0,0 +1,17 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "notAdmMonotoneArg.ma" ---+--- scope checking ---+--- type checking ---+type  Stream : ++(A : Set) -> - Size -> Set+term  Stream.cons : .[A : Set] -> .[i : Size] -> ^(y1 : A) -> ^(y2 : Stream A i) -> < Stream.cons i y1 y2 : Stream A $i >+type  Unit : Set+term  Unit.triv : < Unit.triv : Unit >+term  bla : .[i : Size] -> (Stream Unit i -> Stream Unit i) -> Stream Unit i+error during typechecking:+bla+/// clause 1+/// pattern $i+/// checkPattern $i : matching on size, checking that target .[i : Size] -> (Stream Unit i -> Stream Unit i) -> Stream Unit i ends in correct coinductive sized type+/// new i <= #+/// endsInSizedCo: (Stream Unit i -> Stream Unit i) -> Stream Unit i+/// type  Stream Unit i -> Stream Unit i  not lower semi continuous in  i
+ test/fail/notAdmMonotoneArg.ma view
@@ -0,0 +1,13 @@++sized codata Stream (+ A : Set) : Size -> Set {+  cons : (i : Size) -> A -> Stream A i -> Stream A ($ i)+}++data Unit : Set {+  triv : Unit+}+ +cofun bla : (i : Size) -> (Stream Unit i -> Stream Unit i) -> Stream Unit i+{+ bla ($ i) f = f (cons Unit i triv (bla i f)) +}
+ test/fail/omegaInst.err view
@@ -0,0 +1,20 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "omegaInst.ma" ---+--- scope checking ---+--- type checking ---+term  ok : .[F : Size -> Set] -> .[i < #] -> (f : .[j < $i] -> F j) -> F i+term  ok = [\ F ->] [\ i ->] \ f -> f [i]+term  bad : .[F : Size -> Set] -> .[i <= #] -> (f : .[j < $i] -> F j) -> F i+term  bad = [\ F ->] [\ i ->] \ f -> f [i]+term  inst : .[F : Size -> Set] -> (f : .[j < #] -> F j) -> F #+term  inst = [\ F ->] \ f -> bad [F] [#] f+error during typechecking:+bot+/// new F : (Size -> Set)+/// new f : (.[j < #] -> F j{F = (v0 Up (Size -> Set))})+/// checkExpr 2 |- f # : F #+/// inferExpr' f #+/// checkApp (.[j < #] -> F j{F = (v0 Up (Size -> Set))}) eliminated by #+/// leqVal' (subtyping)  < # : Size >  <=+  < #+/// leSize # <+ #+/// leSize: # < # failed
+ test/fail/omegaInst.ma view
@@ -0,0 +1,17 @@+-- 2012-02-06  Make sure not to violate < - Constraints by going through infty++let ok  [F : Size -> Set] [i <  #] (f : [j < $i] -> F j) : F i+  = f i++-- this needs to fail, because i can be instantiated to #+let bad [F : Size -> Set] [i <= #] (f : [j < $i] -> F j) : F i+  = f i++let inst [F : Size -> Set] (f : [j < #] -> F j) : F #+  = bad F # f++let bot [F : Size -> Set] (f : [j < #] -> F j) : F #+  = f #+-- DOUBTS: is this so bad after all?+-- each descending chain f has a limit.  +-- If # is that closure ordinal, this should be ok.
+ test/fail/omegaInst1.err view
@@ -0,0 +1,22 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "omegaInst1.ma" ---+--- scope checking ---+--- type checking ---+term  fix : .[F : Size -> Set] -> (phi : .[i <= #] -> (f : .[j < i] -> F j) -> F i) -> .[i <= #] -> F i+{ fix [F] phi [i] = phi [i] (fix [F] phi)+}+type  Bot : +(i : Size) -> Set+{ Bot i = .[j < i] & Bot j+}+type  Top : -(i : Size) -> Set+{ Top i = .[j < i] -> Top j+}+error during typechecking:+out+/// new i <= #+/// new r : (Top {$i {i = v0}})+/// checkExpr 2 |- \ j -> r $j j : Top i+/// checkForced fromList [(i,0),(r,1)] |- \ j -> r $j j : .[j < i] -> Top j+/// new j < v0+/// adding size rel. v2 + 1 <= v0+/// cannot add hypothesis v2 + 1 <= v0 because it is not satisfyable under all possible valuations of the current hypotheses
+ test/fail/omegaInst1.ma view
@@ -0,0 +1,27 @@+-- 2012-02-06  Make sure not to violate < - Constraints by going through infty+-- (not finished)++fun fix : [F : Size -> Set]+          (phi : [i <= #] (f : [j < i] -> F j) -> F i)+          [i <= #] -> |i| -> F i+{ fix F phi i = phi i (fix F phi)+}++cofun Bot : +(i : Size) -> Set+{ Bot i = [j < i] & Bot j+}++cofun Top : -(i : Size) -> Set+{ Top i = [j < i] -> Top j+}++let out [i : Size] (r :  Top $i) : Top i+  = \ j -> r $j j++let inn [i : Size] (t : Top i) : Top $i+  = \ j -> t++let bad [F : Size -> Set] [i <= #] (f : [j < $i] -> F j) : F i+  = f i++let test [F : Size -> Set] = fix F (bad F)
+ test/fail/onesStreamUnguarded.err view
@@ -0,0 +1,20 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "onesStreamUnguarded.ma" ---+--- scope checking ---+--- type checking ---+type  Stream : ++(A : Set) -> - Size -> Set+term  Stream.cons : .[A : Set] -> .[i : Size] -> ^(y1 : A) -> ^(y2 : Stream A i) -> < Stream.cons i y1 y2 : Stream A $i >+type  Nat : Set+term  Nat.zero : < Nat.zero : Nat >+term  Nat.succ : ^(y0 : Nat) -> < Nat.succ y0 : Nat >+term  copyFirst : .[i : Size] -> Stream Nat i -> Stream Nat $i+error during typechecking:+copyFirst+/// clause 1+/// pattern $i+/// checkPattern $i : matching on size, checking that target .[i : Size] -> Stream Nat i -> Stream Nat $i ends in correct coinductive sized type+/// new i <= #+/// endsInSizedCo: Stream Nat i -> Stream Nat $i+/// new  : (Stream {Nat {i = v0}} v0)+/// endsInSizedCo: Stream Nat $i+/// endsInSizedCo: target Stream Nat $i of corecursive function is neither a CoSet or codata of size i nor a tuple type
+ test/fail/onesStreamUnguarded.ma view
@@ -0,0 +1,19 @@++sized codata Stream (+ A : Set) : Size -> Set {+  cons : [i : Size] -> A -> Stream A i -> Stream A ($ i)+}+ +data Nat : Set {+  zero : Nat;+  succ : Nat -> Nat +}++-- the following needs to be rejected+-- the matching on size is illegal since the target is not Stream Nat i+cofun copyFirst : (i : Size) -> Stream Nat i -> Stream Nat ($ i)+{ copyFirst ($ i) (cons .Nat .i x xs) = cons Nat ($ i) x (cons Nat i x xs)+}++cofun ones : (i : Size) -> Stream Nat i+{ ones ($ i) = copyFirst i (ones i)+}
+ test/fail/partialFunction.err view
@@ -0,0 +1,18 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "partialFunction.ma" ---+--- scope checking ---+--- type checking ---+type  Subset : ^(A : Set) -> ^(P : A -> Set) -> Set+term  Subset.put : .[A : Set] -> .[P : A -> Set] -> ^(a : A) -> .[y1 : P a] -> < Subset.put a y1 : Subset A P >+type  PFun : ^(A : Set) -> ^(B : Set) -> Set+error during typechecking:+PFun+/// constructor PFun.mkPFun+/// new PFun : (^(A : Set) -> ^(B : Set) -> Set)+/// new A : Set+/// new B : Set+/// inferExpr' ^(dom : A -> Set) -> ^(app : Subset A dom -> B) -> PFun A B+/// new dom : (v1::Tm -> {Set {B = v2, A = v1, PFun = (v0 Up (^(A : Set) -> ^(B : Set) -> Set))}})+/// leSize 1 <=+ 0+/// leSize' 1 <= 0+/// leSize': 1 <= 0 failed
+ test/fail/partialFunction.ma view
@@ -0,0 +1,9 @@+data Subset (A : Set) (P : A -> Set) : Set+{+  put : (a : A) -> [P a] -> Subset A P +}++data PFun (A : Set)(B : Set) : Set+{ mkPFun : (dom : A -> Set) -> (app : Subset A dom -> B) -> PFun A B+}+-- should fail unless Set : Set
+ test/fail/relevantArgErasedMagicVec.err view
@@ -0,0 +1,32 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "relevantArgErasedMagicVec.ma" ---+--- scope checking ---+--- type checking ---+type  Sigma : ^(A : Set) -> ^(B : A -> Set) -> Set+term  Sigma.pair : .[A : Set] -> .[B : A -> Set] -> ^(fst : A) -> ^(snd : B fst) -> < Sigma.pair fst snd : Sigma A B >+term  fst : .[A : Set] -> .[B : A -> Set] -> (pair : Sigma A B) -> A+{ fst [A] [B] (Sigma.pair #fst #snd) = #fst+}+term  snd : .[A : Set] -> .[B : A -> Set] -> (pair : Sigma A B) -> B (fst [A] [B] pair)+{ snd [A] [B] (Sigma.pair #fst #snd) = #snd+}+type  Nat : Set+term  Nat.zero : < Nat.zero : Nat >+term  Nat.succ : ^(y0 : Nat) -> < Nat.succ y0 : Nat >+type  Empty : Set+term  magic : .[A : Set] -> .[p : Empty] -> A+{}+type  Unit : Set+term  Unit.unit : < Unit.unit : Unit >+type  Vec : .[A : Set] -> (n : Nat) -> Set+error during typechecking:+Vec+/// clause 2+/// right hand side+/// checkExpr 2 |- Sigma A (\ z -> Vec A n) : Set+/// inferExpr' Sigma A (\ z -> Vec A n)+/// inferExpr' Sigma A+/// checkApp (^(A : Set) -> ^(B : A -> Set) -> Set) eliminated by A+/// inferExpr' A+/// inferExpr: variable A : Set may not occur+/// , because it is marked as erased
+ test/fail/relevantArgErasedMagicVec.ma view
@@ -0,0 +1,44 @@+-- proof irrelevance via polymorphism++data Sigma (A : Set) (B : A -> Set) : Set+{ pair : (fst : A) -> (snd : B fst) -> Sigma A B+}+fields fst, snd++data Nat : Set+{ zero : Nat+; succ : Nat -> Nat+}++data Empty : Set+{+}++-- magic = abort  does not need the inhabitant p : Empty+fun magic : [A : Set] -> [p : Empty] -> A+{ +}++data Unit : Set+{ unit : Unit+}++fun Vec : [A : Set] -> (n : Nat) -> Set+{ Vec A zero     = Empty+; Vec A (succ n) = Sigma A (\ z -> Vec A n)+}++fun Leq : (n : Nat) -> (m : Nat) -> Set+{ Leq  zero     m        =  Unit+; Leq (succ n)  zero     =  Empty+; Leq (succ n) (succ m)  =  Leq n m+}+let Lt : (n : Nat) -> (m : Nat) -> Set+       = \ n -> \ m -> Leq (succ n) m++fun lookup : [A : Set] -> (n : Nat) -> (m : Nat) -> [Lt m n] -> Vec A n -> A+{ lookup A  zero    m        p v = magic A p+; lookup A (succ n) zero     p v = fst v -- fst A (\ z -> Vec A n) v+; lookup A (succ n) (succ m) p v = lookup A n m p <| snd v -- (snd A (\ z -> Vec A n) v)+}+
+ test/fail/scolist_not_lsc1.err view
@@ -0,0 +1,20 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "scolist_not_lsc1.ma" ---+--- scope checking ---+--- type checking ---+type  Nat : ^ Size -> Set+term  Nat.zero : .[i : Size] -> < Nat.zero i : Nat $i >+term  Nat.succ : .[i : Size] -> ^(y1 : Nat i) -> < Nat.succ i y1 : Nat $i >+type  Colist : ^(A : Set) -> ^ Size -> Set+term  Colist.nil : .[A : Set] -> .[i : Size] -> < Colist.nil i : Colist A $i >+term  Colist.cons : .[A : Set] -> .[i : Size] -> ^(y1 : A) -> ^(y2 : Colist A i) -> < Colist.cons i y1 y2 : Colist A $i >+term  length : .[i : Size] -> .[A : Set] -> Colist A i -> Nat i+error during typechecking:+checking type of length for admissibility+/// new A : _+/// new i : _+/// new i <= #+/// admType: checking (.[A : Set] -> Colist A i -> Nat i{i = v2}) admissible in v2+/// new A : Set+/// admType: checking ((Colist v3 v2)::Tm -> {Nat i {A = v3, i = v2}}) admissible in v2+/// type  Colist A i  not lower semi continuous in  i
+ test/fail/scolist_not_lsc1.ma view
@@ -0,0 +1,79 @@+-- keyword "sized" forgotten++data Nat : Size -> Set+{+  zero : (i : Size ) -> Nat ($ i);+  succ : (i : Size ) -> Nat i -> Nat ($ i);+}+++codata Colist (A : Set) : Size -> Set+{+  nil  : (i : Size ) -> Colist A ($ i);+  cons : (i : Size ) -> A -> Colist A i -> Colist A ($ i)+}++-- not allowed because no inductive argument with i +fun length : (i : Size ) -> (A : Set) -> Colist A i -> Nat i+{+length .($ i) A (nil i) = zero i ;+length .($ i) A (cons i a as) = succ i (length i A as)+}++codata CoNat : Size -> Set+{+  cozero : (i : Size ) -> CoNat ($ i);+  cosucc : (i : Size ) -> CoNat i -> CoNat ($ i)+}++let z : CoNat # = cozero #++-- allowed because i used in coinductive result+cofun length2 : (i : Size ) -> ( A : Set ) -> Colist A i -> CoNat i+{+length2 .($ i) A (nil i) = cozero i;+length2 .($ i) A (cons i a as) = cosucc i (length2 i A as) +}++cofun omega' : ( i : Size ) -> CoNat i+{+omega' ($ i) = cosucc i (omega' i)+}++let omega : CoNat # = omega' #++cofun olist' : ( i : Size ) -> Colist (Nat #) i+{+olist' ($ i) = cons i (zero #) (olist' i)+}++eval let diverge : Nat # = length # (Nat #) (olist' #)++-- not ok because size not used in inductive argument +-- fun convert1 : (i : Size ) -> CoNat i -> Nat i+-- {+-- convert1 .($ i) (cozero i) = zero i;+-- convert1 .($ i) (cosucc i x) = succ i (convert1 i x) +-- }++-- ok +fun convert2 : ( i : Size ) -> Nat i -> CoNat i+{+convert2 .($ i) (zero i) = cozero i;+convert2 .($ i) (succ i x) = cosucc i (convert2 i x) +}++-- also ok+fun convert3 : ( i : Size ) -> Nat i -> CoNat #+{+convert3 .($ i) (zero i) = cozero #;+convert3 .($ i) (succ i x) = omega' #+}++-- also ok+cofun convert4 : ( i : Size ) -> Nat i -> CoNat i+{+convert4 .($ i) (zero i) = cozero ($ i) ;+convert4 .($ i) (succ i x) = cosucc i (convert4 i x) +}+
+ test/fail/scolist_not_lsc2.err view
@@ -0,0 +1,30 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "scolist_not_lsc2.ma" ---+--- scope checking ---+--- type checking ---+type  Nat : + Size -> Set+term  Nat.zero : .[s!ze : Size] -> .[i < s!ze] -> Nat s!ze+term  Nat.zero : .[i : Size] -> < Nat.zero i : Nat $i >+term  Nat.succ : .[s!ze : Size] -> .[i < s!ze] -> ^ Nat i -> Nat s!ze+term  Nat.succ : .[i : Size] -> ^(y1 : Nat i) -> < Nat.succ i y1 : Nat $i >+type  Colist : ^(A : Set) -> ^ Size -> Set+term  Colist.nil : .[A : Set] -> .[i : Size] -> < Colist.nil i : Colist A $i >+term  Colist.cons : .[A : Set] -> .[i : Size] -> ^(y1 : A) -> ^(y2 : Colist A i) -> < Colist.cons i y1 y2 : Colist A $i >+type  CoNat : ^ Size -> Set+term  CoNat.cozero : .[i : Size] -> < CoNat.cozero i : CoNat $i >+term  CoNat.cosucc : .[i : Size] -> ^(y1 : CoNat i) -> < CoNat.cosucc i y1 : CoNat $i >+term  z : CoNat #+term  z = CoNat.cozero [#]+term  length2 : .[i : Size] -> .[A : Set] -> Colist A i -> CoNat i+{ length2 [.$i] [A] (Colist.nil [i]) = CoNat.cozero [i]+; length2 [.$i] [A] (Colist.cons [i] a as) = CoNat.cosucc [i] (length2 [i] [A] as)+}+term  omega' : .[i : Size] -> CoNat i+error during typechecking:+omega'+/// clause 1+/// pattern $i+/// checkPattern $i : matching on size, checking that target .[i : Size] -> CoNat i ends in correct coinductive sized type+/// new i <= #+/// endsInSizedCo: CoNat i+/// endsInSizedCo: target CoNat i of corecursive function is neither a CoSet or codata of size i nor a tuple type
+ test/fail/scolist_not_lsc2.ma view
@@ -0,0 +1,79 @@+sized data Nat : Size -> Set+{+  zero : (i : Size ) -> Nat ($ i);+  succ : (i : Size ) -> Nat i -> Nat ($ i);+}+++codata Colist (A : Set) : Size -> Set+{+  nil  : (i : Size ) -> Colist A ($ i);+  cons : (i : Size ) -> A -> Colist A i -> Colist A ($ i)+}++-- -- not allowed because no inductive argument with i +-- fun length : (i : Size ) -> (A : Set) -> Colist A i -> Nat i+-- {+-- length .($ i) .A (nil A i) = zero i ;+-- length .($ i) .A (cons A i a as) = succ i (length i A as)+-- }++-- not a sized codata !!+codata CoNat : Size -> Set+{+  cozero : (i : Size ) -> CoNat ($ i);+  cosucc : (i : Size ) -> CoNat i -> CoNat ($ i)+}++let z : CoNat # = cozero #++-- allowed because i used in coinductive result+cofun length2 : (i : Size ) -> ( A : Set ) -> Colist A i -> CoNat i+{+length2 .($ i) A (nil i) = cozero i;+length2 .($ i) A (cons i a as) = cosucc i (length2 i A as) +}++cofun omega' : ( i : Size ) -> CoNat i+{+omega' ($ i) = cosucc i (omega' i)+}++let omega : CoNat # = omega' #++cofun olist' : ( i : Size ) -> Colist (Nat #) i+{+olist' ($ i) = cons i (zero #) (olist' i)+}++-- Diverges:+-- eval let diverge : Nat # = length # (Nat #) (olist' #)++-- not ok because size not used in inductive argument +-- fun convert1 : (i : Size ) -> CoNat i -> Nat i+-- {+-- convert1 .($ i) (cozero i) = zero i;+-- convert1 .($ i) (cosucc i x) = succ i (convert1 i x) +-- }++-- ok +fun convert2 : ( i : Size ) -> Nat i -> CoNat i+{+convert2 .($ i) (zero i) = cozero i;+convert2 .($ i) (succ i x) = cosucc i (convert2 i x) +}++-- also ok+fun convert3 : ( i : Size ) -> Nat i -> CoNat #+{+convert3 .($ i) (zero i) = cozero #;+convert3 .($ i) (succ i x) = omega' #+}++-- also ok+cofun convert4 : ( i : Size ) -> Nat i -> CoNat i+{+convert4 .($ i) (zero i) = cozero ($ i) ;+convert4 .($ i) (succ i x) = cosucc i (convert4 i x) +}+
+ test/fail/shadowGlobal.err view
@@ -0,0 +1,4 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "shadowGlobal.ma" ---+--- scope checking ---+scope check error: "shadowing of global definitions forbidden": Identifier bla already in signature
+ test/fail/shadowGlobal.ma view
@@ -0,0 +1,3 @@+-- 2012-01-27 shadowing of globals not allowed+let bla : Size = 0+let bla : Size = 0
+ test/fail/shouldBeDotPattern_snat.err view
@@ -0,0 +1,23 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "shouldBeDotPattern_snat.ma" ---+--- scope checking ---+--- type checking ---+type  SNat : + Size -> Set+term  SNat.zero : .[s!ze : Size] -> .[i < s!ze] -> SNat s!ze+term  SNat.zero : .[i : Size] -> < SNat.zero i : SNat $i >+term  SNat.succ : .[s!ze : Size] -> .[i < s!ze] -> ^ SNat i -> SNat s!ze+term  SNat.succ : .[i : Size] -> ^(y1 : SNat i) -> < SNat.succ i y1 : SNat $i >+term  z : SNat #+term  z = SNat.zero [#]+term  one : SNat #+term  one = SNat.succ [#] z+term  two : SNat #+term  two = SNat.succ [#] one+term  three : SNat #+term  three = SNat.succ [#] two+term  add : .[i : Size] -> .[j : Size] -> SNat i -> SNat j -> SNat #+error during typechecking:+add+/// clause 1+/// pattern $i+/// successor pattern only allowed in cofun
+ test/fail/shouldBeDotPattern_snat.ma view
@@ -0,0 +1,82 @@+sized data SNat : Size -> Set+{+	zero : (i : Size) -> SNat ($ i);+	succ : (i : Size) -> SNat i -> SNat ($ i)+}++let z : SNat # = zero #+let one : SNat # = succ # z+let two : SNat # = succ # one+let three : SNat # = succ # two+++-- 2010-08-18 all these functions fail because ($ i) is restricted to cofun++fun add : (i : Size) -> (j : Size) -> SNat i -> SNat j -> SNat #+{++add ($ i) j (zero .i) y = y; +add ($ i) j (succ .i x) y = succ # (add i j x y) ++}++let four : SNat # = add # # two two+let six : SNat # = add # # four two++fun minus : (i : Size) -> (j : Size) -> SNat i -> SNat j -> SNat i+{++minus ($ i) ($ j)  (zero .i)    y           = zero i;+minus ($ i) ($ j)  x            (zero .j)  = x ;+minus ($ i) ($ j)  (succ .i x)  (succ .j y) = minus i j x y++}++let min4_2 : SNat # = minus # #  four two++-- not structurally recursive without sizes ... +fun div : (i : Size) -> (j : Size) ->  SNat i -> SNat j -> SNat i+{++div ($ i) ($ j)  (zero .i)   y = (zero i) ;+div ($ i) ($ j)  x           (zero .j) = (zero i);+div ($ i) ($ j)  (succ .i x) (succ .j y) = succ i (div i ($ j) (minus i j x y) (succ j y))++}++let div4_4 : SNat # = div # # four four+++fun compare : (i : Size) -> (j : Size) -> (SNat i) -> (SNat j)+    -> (A : Set) -> A -> A -> A+{+compare ($ i) ($ j) x (zero .j)                   A a a' = a ;+compare ($ i) ($ j) (zero .i) (succ .j y')        A a a' = a';+compare ($ i) ($ j) (succ .i x) (succ .j y)       A a a' = compare i j x y A a a'+}++fun gcd : (i : Size) -> (j : Size) -> (SNat i) -> (SNat j) -> (SNat #)+{+gcd ($ i)  j    (zero .i)    y         = y ;+gcd  i    ($ j)  x         (zero .j)   = x ;+gcd ($ i) ($ j) (succ .i x) (succ .j y) = +    compare i j x y (SNat #)+               (gcd i ($ j) (minus i j x y) (succ j y))+               (gcd ($ i) j (succ i x) (minus j i y x))+}++let gcd6_4 : SNat # = gcd # # six four++data SEmpty : Size -> Set+{+}++fun bad : (i : Size) -> SNat i -> SEmpty i+{+bad i x = x+}++fun bad2 : (A : Set) -> (B : Set) -> A -> B+{+bad2 A B x = x+}
+ test/fail/singleton.err view
@@ -0,0 +1,19 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "singleton.ma" ---+--- scope checking ---+--- type checking ---+error during typechecking:+K+/// checkExpr 0 |- \ A -> \ x -> \ y -> y : .[A : Set] -> (x : A) -> (y : A) -> < x : A >+/// checkForced fromList [] |- \ A -> \ x -> \ y -> y : .[A : Set] -> (x : A) -> (y : A) -> < x : A >+/// new A : Set+/// checkExpr 1 |- \ x -> \ y -> y : (x : A) -> (y : A) -> < x : A >+/// checkForced fromList [(A,0)] |- \ x -> \ y -> y : (x : A) -> (y : A) -> < x : A >+/// new x : v0+/// checkExpr 2 |- \ y -> y : (y : A) -> < x : A >+/// checkForced fromList [(x,1),(A,0)] |- \ y -> y : (y : A) -> < x : A >+/// new y : v0+/// checkExpr 3 |- y : < x : A >+/// leqVal' (subtyping)  < y : A >  <=+  < x : A >+/// leqVal'  y : A  <=*  x : A+/// leqApp: head mismatch y != x
+ test/fail/singleton.ma view
@@ -0,0 +1,6 @@+-- 2009-11-29 ++let K : (A : Set) -> (x : A) -> (y : A) -> <x : A>+      = \ A -> \ x -> \ y -> y++
+ test/fail/sizePatternSucc.err view
@@ -0,0 +1,17 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "sizePatternSucc.ma" ---+--- scope checking ---+--- type checking ---+type  SNat : + Size -> Set+term  SNat.zero : .[s!ze : Size] -> .[i < s!ze] -> SNat s!ze+term  SNat.zero : .[i : Size] -> < SNat.zero i : SNat $i >+term  SNat.succ : .[s!ze : Size] -> .[i < s!ze] -> ^ SNat i -> SNat s!ze+term  SNat.succ : .[i : Size] -> ^(y1 : SNat i) -> < SNat.succ i y1 : SNat $i >+type  Empty : Set+term  bad : .[i : Size] -> SNat i -> Empty+error during typechecking:+bad+/// clause 2+/// pattern zero $i+/// pattern $i+/// successor pattern only allowed in cofun
+ test/fail/sizePatternSucc.ma view
@@ -0,0 +1,18 @@++sized data SNat : Size -> Set+{+zero : (i : Size) -> SNat ($ i);+succ : (i : Size) -> SNat i -> SNat ($ i)+}++data Empty : Set+{+}++-- ($ i) appearing as a size pattern++fun bad : (i : Size) -> SNat i -> Empty+{+bad .($ i)     (succ i x)   = bad _ x;+bad .($ ($ i)) (zero ($ i)) = bad _ (zero _);+}
+ test/fail/stream.err view
@@ -0,0 +1,6 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "stream.ma" ---+--- scope checking ---+scope check error: Stream+/// cons+/// Identifier Nat undefined
+ test/fail/stream.ma view
@@ -0,0 +1,29 @@++sized codata Stream : Size -> Set {+  cons : (i : Size) -> Nat -> Stream i -> Stream ($ i)+}++fun tail : Stream # -> Stream # {+  tail (cons .# x xs) = xs+}++fun head : Stream # -> Nat {+  head (cons .# x xs) = x+}+++ +cofun lookbad : (i : Size ) -> Stream i+{+lookbad ($ i) = +	first (Stream _) (Stream _) +	  (cons _ zero (lookbad _))+          (lookbad _)+}++--let proof2 : Eq (Stream #) (cons # zero (lookbad #)) (lookbad #) = refl (Stream #) (lookbad #)+--let proof3 : Eq (Stream #) (cons # zero (lookbad #)) (tail (lookbad #)) = refl (Stream #) (tail (lookbad #)++let proof2 : Eq (Stream #) (cons # zero (lookbad #)) (lookbad #) = refl (Stream #) (lookbad #)+let proof3 : Eq (Stream #) (cons # zero (lookbad #)) (tail (lookbad #)) = refl (Stream #) (tail (lookbad #))+
+ test/fail/streamMisc.err view
@@ -0,0 +1,5 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "streamMisc.ma" ---+--- scope checking ---+scope check error: wkStream2+/// pattern not linear: A
+ test/fail/streamMisc.ma view
@@ -0,0 +1,188 @@+data Nat : Set  +{+	zero : Nat ;+	succ : Nat -> Nat+}++fun add : Nat -> Nat -> Nat+{+add x zero = x;+add x (succ y) = succ (add x y);+}++eval let one : Nat = succ zero++sized codata Stream (A : Set) : Size -> Set +{+  cons : (i : Size) -> A -> Stream A i -> Stream A ($ i)+}++cofun zeroes : (i : Size ) -> Stream Nat i+{+zeroes ($ i) = cons Nat i zero (zeroes i)+}+ +cofun ones : (i : Size) -> Stream Nat i+{+ones ($ i) = cons Nat i one (ones i)+}++eval let ones' : Stream Nat # = ones #++cofun map : (A : Set) -> (B : Set) -> (i : Size) ->+          (A -> B) -> Stream A # -> Stream B i+{+map A B ($ i) f (cons .A .# a as) = cons B i (f a) (map A B i f as)+} ++eval let twos : Stream Nat # = map Nat Nat # ( \ x -> succ x) ones'++++-- tail is a fun+fun tail : (A : Set) -> Stream A # -> Stream A #+{+tail A (cons .A .# a as) = as+}+++eval let twos' : Stream Nat # = tail Nat twos++fun head : (A : Set) -> Stream A # -> A+{+head A (cons .A .# a as) = a+}++eval let two : Nat = head Nat twos +eval let two' : Nat = head Nat twos'++eval let twos2 : Stream Nat # = map Nat Nat # ( \ x -> succ x) ones'+eval let twos2' : Stream Nat # = tail Nat twos2++cofun zipWith : ( A : Set ) -> ( B : Set ) -> (C : Set) -> ( i : Size ) ->+	(A -> B -> C) -> Stream A # -> Stream B # -> Stream C i+{+zipWith A B C ($ i) f (cons .A .# a as) (cons .B .# b bs) = +  cons C i (f a b) (zipWith A B C i f as bs)+}++++fun nth : Nat -> Stream Nat # -> Nat+{+nth zero ns = head Nat ns;+nth (succ x) ns = nth x (tail Nat ns) +}++eval let fours : Stream Nat # = zipWith Nat Nat Nat # add twos twos+eval let four : Nat = head Nat fours++++cofun fib : (x : Nat ) -> (y : Nat ) -> (i : Size ) -> Stream Nat i+{+fib x y ($ i) = (cons Nat ($ i) x (cons Nat i y (fib y (add x y) i)))+} ++eval let fib' : Stream Nat # = tail Nat (fib zero zero #) +++eval let fib8 : Nat = nth (add four four) (fib zero zero #)++eval let fib2 : Nat  = head Nat (tail Nat (fib zero zero #))++cofun nats : (i : Size ) -> Nat -> Stream Nat i+{+nats ($ i) x = (cons Nat i x (nats i (succ x)))+}++eval let nats' : Stream Nat # = tail Nat (nats # zero)+++--- weakening+eval let wkStream : ( A : Set ) -> ( i : Size ) -> Stream A ($ i) -> Stream A i = \ A -> \ i -> \ s -> s++-- should be ok but does not pass admissibility check+cofun wkStream_ok : ( A : Set ) -> (i : Size ) -> Stream A ($ i) -> Stream A i+{+wkStream_ok A ($ i) (cons .A .($ i) x xs) = cons A i x (wkStream A i xs) +}+++     +--bad +--not admissble+cofun wkStream2 : ( A : Set ) -> ( i : Size ) -> Stream A i -> Stream A ($ i)+{+wkStream2 A ($ i) (cons A .i x xs) = cons A ($ i) x (wkStream2 A i xs)+}+++-- an unproductive stream+cofun unp : (i : Size ) -> Stream Nat i +{+unp i = unp i+}++-- another one, not type correect+{-+cofun unp2 : (i : Size ) -> Stream Nat i+{+unp2 ($ i) = cons Nat i zero (tail Nat (unp2 ($ i)))+}+-} +++--eval let bla2 : Nat = nth four (unp #)++mutual+{++cofun alt1 : ( i : Size ) -> Stream Nat i+{+alt1 ($ i) = cons Nat i zero (alt2 i)+}++cofun alt2 : ( i : Size ) -> Stream Nat i+{+alt2 ($ i) = cons Nat i one (alt1 i)+}++}++data Bool : Set+{+tt : Bool;+ff : Bool+}++-- tt if a stream starts with 2 zeroes+fun twozeroes : Stream Nat # -> Bool+{+twozeroes (cons .Nat .# zero (cons .Nat .# zero str)) = tt;+twozeroes (cons .Nat .# zero (cons .Nat .# (succ x) str)) = ff;+twozeroes (cons .Nat .# (succ x) str) = ff+}++eval let twozeroes'zeroes : Bool = twozeroes (zeroes #) ++data Eq ( A : Set ) : A -> A -> Set+{+refl : (a : A) -> Eq A a a +}++-- hangs on unproductive stream+--  let zz : Eq (Stream Nat #) (unp #) (cons Nat # zero (unp #)) = refl (Stream Nat #) (unp #) ++sized data Unit : Size -> Set+{+unit : (i : Size ) -> Unit ($ i)+}++-- bad.  2010-03-10 WHY?  I think it is ok!+fun head2 : (i : Size ) -> Unit i -> Stream Nat i -> Nat+{+head2 .($ i) (unit i) (cons .Nat .i x xl) = x +}++
+ test/fail/stream_x_is_cons_x_tail_x.err view
@@ -0,0 +1,28 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "stream_x_is_cons_x_tail_x.ma" ---+--- scope checking ---+--- type checking ---+type  Nat : Set+term  Nat.zero : < Nat.zero : Nat >+term  Nat.succ : ^(y0 : Nat) -> < Nat.succ y0 : Nat >+term  n0 : Nat+term  n0 = Nat.zero+term  n1 : Nat+term  n1 = Nat.succ n0+term  n2 : Nat+term  n2 = Nat.succ n1+term  n3 : Nat+term  n3 = Nat.succ n2+term  n4 : Nat+term  n4 = Nat.succ n3+type  Stream : ++(A : Set) -> - Size -> Set+term  Stream.cons : .[A : Set] -> .[i : Size] -> ^(y1 : A) -> ^(y2 : Stream A i) -> < Stream.cons i y1 y2 : Stream A $i >+term  tail : .[A : Set] -> .[i : Size] -> Stream A $i -> Stream A i+{ tail [A] [i] (Stream.cons [.i] x xs) = xs+}+term  bad : .[i : Size] -> Stream Nat i+error during typechecking:+bad+/// clause 1+/// pattern $$i+/// cannot match against deep successor pattern $$i at type .[i : Size] -> Stream Nat i
+ test/fail/stream_x_is_cons_x_tail_x.ma view
@@ -0,0 +1,26 @@++data Nat : Set {+  zero : Nat;+  succ : Nat -> Nat +}++let n0 : Nat = zero+let n1 : Nat = succ n0+let n2 : Nat = succ n1+let n3 : Nat = succ n2+let n4 : Nat = succ n3+++sized codata Stream (+ A : Set) : Size -> Set {+  cons : (i : Size) -> A -> Stream A i -> Stream A ($ i)+}+ +fun tail : (A : Set) -> (i : Size) -> Stream A ($ i) -> Stream A i+{+  tail A i (cons .i x xs) = xs+}++cofun bad : (i : Size) -> Stream Nat i+{+  bad ($ ($ i)) = cons _ n0 (tail Nat _ (bad ($ i)))+}
+ test/fail/subtyping_erased.err view
@@ -0,0 +1,15 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "subtyping_erased.ma" ---+--- scope checking ---+--- type checking ---+error during typechecking:+id+/// checkExpr 0 |- \ A -> \ x -> x : .[A : Set] -> (.[A] -> A) -> A -> A+/// checkForced fromList [] |- \ A -> \ x -> x : .[A : Set] -> (.[A] -> A) -> A -> A+/// new A : Set+/// checkExpr 1 |- \ x -> x : (.[A] -> A) -> A -> A+/// checkForced fromList [(A,0)] |- \ x -> x : (.[A] -> A) -> A -> A+/// new x : (.[v0::Tm] -> {A {A = v0}})+/// checkExpr 2 |- x : A -> A+/// leqVal' (subtyping)  .[xSing# : A] -> < x xSing# : A >  <=+  A -> A+/// subtyping .[xSing# : A] -> < x xSing# : A >  <=+  A -> A failed
+ test/fail/subtyping_erased.ma view
@@ -0,0 +1,6 @@+-- every function which does not use its argument is a function+-- this is UNSOUND under erasure!++let id : [A : Set] -> ([A] -> A) -> (A -> A)+       = \ A -> \ x -> x+
+ test/fail/subtyping_erased_wrongdir.err view
@@ -0,0 +1,15 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "subtyping_erased_wrongdir.ma" ---+--- scope checking ---+--- type checking ---+error during typechecking:+id+/// checkExpr 0 |- \ A -> \ x -> x : .[A : Set] -> (A -> A) -> .[A] -> A+/// checkForced fromList [] |- \ A -> \ x -> x : .[A : Set] -> (A -> A) -> .[A] -> A+/// new A : Set+/// checkExpr 1 |- \ x -> x : (A -> A) -> .[A] -> A+/// checkForced fromList [(A,0)] |- \ x -> x : (A -> A) -> .[A] -> A+/// new x : (v0::Tm -> {A {A = v0}})+/// checkExpr 2 |- x : .[A] -> A+/// leqVal' (subtyping)  (xSing# : A) -> < x xSing# : A >  <=+  .[A] -> A+/// subtyping (xSing# : A) -> < x xSing# : A >  <=+  .[A] -> A failed
+ test/fail/subtyping_erased_wrongdir.ma view
@@ -0,0 +1,6 @@+-- wrong direction of subtyping+-- not every function is a function which does not use its argument++let id : [A : Set] -> (A -> A) -> ([A] -> A)+       = \ A -> \ x -> x+
+ test/fail/swapVariablesWithoutDecrease.err view
@@ -0,0 +1,14 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "swapVariablesWithoutDecrease.ma" ---+--- scope checking ---+--- type checking ---+type  SNat : + Size -> Set+term  SNat.zero : .[s!ze : Size] -> .[i < s!ze] -> SNat s!ze+term  SNat.zero : .[i : Size] -> < SNat.zero i : SNat $i >+term  SNat.succ : .[s!ze : Size] -> .[i < s!ze] -> ^ SNat i -> SNat s!ze+term  SNat.succ : .[i : Size] -> ^(y1 : SNat i) -> < SNat.succ i y1 : SNat $i >+term  bla : .[i : Size] -> .[j : Size] -> SNat i -> SNat j -> SNat #+{ bla [.$i] [j] (SNat.succ [i] x) y = bla [$j] [i] (SNat.succ [j] y) x+}+error during typechecking:+Termination check for function bla fails
+ test/fail/swapVariablesWithoutDecrease.ma view
@@ -0,0 +1,12 @@+-- termination fails with variable swapping++sized data SNat : Size -> Set+{+zero : (i : Size) -> SNat ($ i);+succ : (i : Size) -> SNat i -> SNat ($ i)+}++fun bla : (i : Size) -> (j : Size) -> SNat i -> SNat j -> SNat #+{+bla .($ i) j (succ i x) y = bla _ _ (succ _ y) x;+}
+ test/fail/tailBad.err view
@@ -0,0 +1,11 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "tailBad.ma" ---+--- scope checking ---+--- type checking ---+type  Stream : ++(A : Set) -> - Size -> Set+term  Stream.cons : .[A : Set] -> .[i : Size] -> ^(y1 : A) -> ^(y2 : Stream A i) -> < Stream.cons i y1 y2 : Stream A $i >+term  sid : .[A : Set] -> .[i : Size] -> Stream A $i -> Stream A i+error during typechecking:+sid+/// clause 1+/// size constraints [v1<=?0+1,?0<=?1,?1+1<=v1,SizeMeta(?1),SizeMeta(?0)] unsolvable
+ test/fail/tailBad.ma view
@@ -0,0 +1,11 @@++sized codata Stream (+ A : Set) : Size -> Set {+  cons : (i : Size) -> A -> Stream A i -> Stream A ($ i)+}++-- the type of this identity is not the type of a fun+fun sid : (A : Set) -> (i : Size) -> Stream A ($ i) -> Stream A i+{+  sid A i (cons .i x xs) = cons _ x (sid A _ xs)+}+-- size constraints unsolvable
+ test/fail/vec_eta.err view
@@ -0,0 +1,42 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "vec_eta.ma" ---+--- scope checking ---+--- type checking ---+type  Nat : Set+term  Nat.zero : < Nat.zero : Nat >+term  Nat.succ : ^(pred : Nat) -> < Nat.succ pred : Nat >+term  add : Nat -> Nat -> Nat+{ add Nat.zero y = y+; add (Nat.succ x) y = Nat.succ (add x y)+}+type  Vec : ++(A : Set) -> ^ Nat -> Set+term  Vec.vnil : .[A : Set] -> < Vec.vnil : Vec A Nat.zero >+term  Vec.vcons : .[A : Set] -> ^(head : A) -> .[n : Nat] -> ^(tail : Vec A n) -> < Vec.vcons head n tail : Vec A (Nat.succ n) >+term  head : .[A : Set] -> .[n : Nat] -> (vcons : Vec A (Nat.succ n)) -> A+{ head [A] [n] (Vec.vcons #head [.n] #tail) = #head+}+term  tail : .[A : Set] -> .[n : Nat] -> (vcons : Vec A (Nat.succ n)) -> Vec A n+{ tail [A] [n] (Vec.vcons #head [.n] #tail) = #tail+}+type  Id : ^(A : Set) -> ^(a : A) -> ^ A -> Set+term  Id.refl : .[A : Set] -> .[a : A] -> < Id.refl : Id A a a >+error during typechecking:+vec0vnil+/// checkExpr 0 |- \ A -> \ n -> \ v -> \ v' -> refl : .[A : Set] -> (n : Nat) -> (v : Vec A n) -> (v' : Vec A n) -> Id (Vec A n) v v'+/// checkForced fromList [] |- \ A -> \ n -> \ v -> \ v' -> refl : .[A : Set] -> (n : Nat) -> (v : Vec A n) -> (v' : Vec A n) -> Id (Vec A n) v v'+/// new A : Set+/// checkExpr 1 |- \ n -> \ v -> \ v' -> refl : (n : Nat) -> (v : Vec A n) -> (v' : Vec A n) -> Id (Vec A n) v v'+/// checkForced fromList [(A,0)] |- \ n -> \ v -> \ v' -> refl : (n : Nat) -> (v : Vec A n) -> (v' : Vec A n) -> Id (Vec A n) v v'+/// new n : Nat+/// checkExpr 2 |- \ v -> \ v' -> refl : (v : Vec A n) -> (v' : Vec A n) -> Id (Vec A n) v v'+/// checkForced fromList [(n,1),(A,0)] |- \ v -> \ v' -> refl : (v : Vec A n) -> (v' : Vec A n) -> Id (Vec A n) v v'+/// new v : (Vec v0 v1)+/// checkExpr 3 |- \ v' -> refl : (v' : Vec A n) -> Id (Vec A n) v v'+/// checkForced fromList [(n,1),(A,0),(v,2)] |- \ v' -> refl : (v' : Vec A n) -> Id (Vec A n) v v'+/// new v' : (Vec v0 v1)+/// checkExpr 4 |- refl : Id (Vec A n) v v'+/// checkForced fromList [(n,1),(A,0),(v,2),(v',3)] |- refl : Id (Vec A n) v v'+/// leqVal' (subtyping)  < Id.refl : Id (Vec A n) v v >  <=+  Id (Vec A n) v v'+/// leqVal' (subtyping)  Id (Vec A n) v v  <=+  Id (Vec A n) v v'+/// leqVal'  v  <=^  v' : Vec A n+/// leqApp: head mismatch v != v'
+ test/fail/vec_eta.ma view
@@ -0,0 +1,27 @@+data Nat : Set+{+  zero : Nat;+  succ : (pred : Nat) -> Nat+}++fun add : Nat -> Nat -> Nat+{+  add zero y = y;+  add (succ x) y = succ (add x y)+}++data Vec (+A : Set) : Nat -> Set+{+  vnil  : Vec A zero;+  vcons : (head : A) -> [n : Nat] -> (tail : Vec A n) -> Vec A (succ n)  +}++data Id (A : Set)(a : A) : A -> Set+{ refl : Id A a a+}++let vec0vnil : (A : Set) -> (n : Nat) -> (v : Vec A n) -> (v' : Vec A n) ->+               Id (Vec A n) v v'+             = \ A -> \ n -> \ v -> \ v' -> refl -- (Vec A n) v++
+ test/fail/vec_length.err view
@@ -0,0 +1,25 @@+MiniAgda by Andreas Abel and Karl Mehltretter+--- opening "vec_length.ma" ---+--- scope checking ---+--- type checking ---+type  Nat : Set+term  Nat.zero : < Nat.zero : Nat >+term  Nat.succ : ^(y0 : Nat) -> < Nat.succ y0 : Nat >+term  add : Nat -> Nat -> Nat+{ add Nat.zero y = y+; add (Nat.succ x) y = Nat.succ (add x y)+}+type  Vec : ++(A : Set) -> ^ Nat -> Set+term  Vec.vnil : .[A : Set] -> < Vec.vnil : Vec A Nat.zero >+term  Vec.vcons : .[A : Set] -> ^(y0 : A) -> .[n : Nat] -> ^(y2 : Vec A n) -> < Vec.vcons y0 n y2 : Vec A (Nat.succ n) >+term  length : .[A : Set] -> .[n : Nat] -> Vec A n -> Nat+error during typechecking:+length+/// clause 2+/// right hand side+/// checkExpr 5 |- succ n : Nat+/// checkForced fromList [(.(succ n),1),(A,0),(x,2),(n,3),(xs,4)] |- succ n : Nat+/// checkApp (^(y0 : Nat::()) -> < Nat.succ y0 : Nat >) eliminated by n+/// inferExpr' n+/// inferExpr: variable n : Nat may not occur+/// , because it is marked as erased
+ test/fail/vec_length.ma view
@@ -0,0 +1,23 @@+data Nat : Set+{+  zero : Nat;+  succ : Nat -> Nat+}++fun add : Nat -> Nat -> Nat+{+  add zero y = y;+  add (succ x) y = succ (add x y)+}++data Vec (+A : Set) : Nat -> Set+{+  vnil  : Vec A zero;+  vcons : A -> [n : Nat] -> Vec A n -> Vec A (succ n)  +}++fun length : [A : Set] -> [n : Nat] -> Vec A n -> Nat+{+  length A .zero (vnil) = zero;+  length A .(succ n) (vcons x n xs) = succ n  -- error: erased n may not occ.+}
+ test/succeed/AbsurdMatchNonLin.ma view
@@ -0,0 +1,32 @@+-- 2010-07-08++data Bool : Set+{ true  : Bool+; false : Bool+}++data BB : Bool -> Set+{ tt : BB true+; ff : BB false+}++data Empty : Set {}+data Unit : Set { unit : Unit }++fun True : Bool -> Set+{ True true  = Unit+; True false = Empty+}++fun not : Bool -> Bool+{ not true = false+; not false = true+}++-- the information that True b is empty is not available early enough+-- if we process left to right+-- works if test for emptiness is postponed till after checking patterns+fun bla : (b : Bool) -> True b -> True (not b) -> BB b -> Empty+{ bla .false () x ff+; bla .true x () tt+}
+ test/succeed/AccDestructorErasedIndex.ma view
@@ -0,0 +1,111 @@+-- 2010-01-22 bug noted+-- 2010-07-08 bug fixed+-- 2012-01-22 parameters gone from constructors++data Nat : Set  +{ zero : Nat +; succ : Nat -> Nat+}++{- R (S x) x  if x < 2+ -} +data R : Nat -> Nat -> Set+{ r1 : (x : Nat) -> R (succ (succ x)) (succ zero)+; r2 : R (succ zero) zero +} ++-- ERROR: data AccPar [A : Set](Lt : A -> A -> Set)(b : A) : Set+data Acc (A : Set) (Lt : A -> A -> Set) *(b : A) : Set+{ acc :  (accParOut : (a : A) -> Lt a b -> Acc A Lt a) -> Acc A Lt b+} ++{- 2011-04-23 does not work due to new polarities+data AccOk (A : Set)(Lt : A -> A -> Set) : A -> Set+{ accOk :  [b : A] -> (accOkOut : (a : A) -> Lt a b -> AccOk A Lt a) -> AccOk A Lt b+} +-- WAS: BUG+-- destructor generation does not work if indices are not erased+data Acc (A : Set) (Lt : A -> A -> Set) : A -> Set+{ acc :  (b : A) -> (accOut : (a : A) -> Lt a b -> Acc A Lt a) -> Acc A Lt b+} +-}++fun acc_dest : (n : Nat) -> (p : Acc Nat R n) -> +               (m : Nat) -> R m n -> Acc Nat R m+{ acc_dest n (acc p) = p+}++{-+fun succR : (n : Nat) -> R (succ n) n+{ succR zero = r2+; succR (succ n) = +-}++let acc2 : (n : Nat) -> Acc Nat R (succ (succ n))+  = \ n -> acc -- Nat R (succ (succ n)) +             (\ a -> \ p -> case p {})++fun aux1 : (a : Nat) -> (p : R a (succ zero)) -> Acc Nat R a+{ aux1 (succ (succ x)) (r1 .x) = acc2 x+}++let acc1 : Acc Nat R (succ zero)+  = acc -- Nat R (succ zero) +        aux1++fun aux0 : (a : Nat) -> (p : R a zero) -> Acc Nat R a+{ aux0 .(succ zero) r2 = acc1+}++eval let acc0 : Acc Nat R zero+  = acc -- Nat R zero +        aux0+ +fun accR : (n : Nat) -> Acc Nat R n+{ accR zero = acc0+; accR (succ zero) = acc1+; accR (succ (succ n)) = acc2 n   +}++fun f : (x : Nat) -> Acc Nat R x -> Nat +{ f x (acc {-.Nat .R .x-} p) = case x+  { zero -> f (succ x) (p (succ x) r2)+  ; (succ zero) -> f (succ x) (p (succ x) (r1 zero))+  ; (succ (succ y)) -> zero+  }+}++{-+-- In Coq, g and h are accepted by the termination checker+fun g : (x : Nat) -> [Acc Nat R x] -> Nat +{ g x p = case x+  { zero -> g (succ x) (acc_dest zero p (succ x) r2)+  ; (succ zero) -> g (succ x) (acc_dest (succ zero) p (succ x) (r1 zero))+  ; (succ (succ y)) -> zero+  }+}++fun h : (x : Nat) -> [Acc Nat R x] -> Nat +{ h zero p = h (succ zero) (acc_dest zero p (succ zero) r2)+; h (succ zero) p = h (succ (succ zero)) (acc_dest (succ zero) p (succ (succ zero)) (r1 zero))+; h (succ (succ y)) p = zero+}+-}++-- h needs to be rejected, Acc cannot be erased at compile-time!+fun h : (x : Nat) -> [Acc Nat R x] -> Nat +{ h zero (acc {-.Nat .R .zero-} p) = h (succ zero) (p (succ zero) r2)+; h (succ zero) (acc {-.Nat .R .(succ zero)-} p) = h (succ (succ zero)) (p (succ (succ zero)) (r1 zero))+; h (succ (succ y)) p = zero+}++eval let bla : Nat+  = h zero acc0++data Id (A : Set) (a : A) : A -> Set+{ refl : Id A a a+}++-- fails, since (h zero p) does not reduce, but (h zero acc0) --> zero+fail let p1 : (p : Acc Nat R zero) -> Id Nat (h zero p) (h zero acc0)+            = \ p -> refl -- Nat (h zero acc0)
+ test/succeed/AppendAddSize.ma view
@@ -0,0 +1,12 @@+-- 2010-11-01+-- 2012-01-22 parameters gone from constructors++sized data List (A : Set) : +Size -> Set+{ nil  : [i : Size] -> List A $i+; cons : [i : Size] -> A -> List A i -> List A $i+}++fun append : [A : Set] -> [i, j : Size] -> List A i -> List A $j -> List A (i + j)+{ append A i j (nil (i > i')) l = l+; append A i j (cons (i > i') a as) l = cons (i' + j) a (append A i' j as l)+}
+ test/succeed/BelowLeInfty.ma view
@@ -0,0 +1,27 @@+sized data Nat : +(i <= #) -> Set+{ zero [i <= #]             : Nat $i+; succ [i <= #] (n : Nat i) : Nat $i+}++let sib00 : ([i : Size] -> Nat i) -> ([i : Size] -> Nat i)  = \ x -> x +let sib01 : ([i : Size] -> Nat i) -> ([i <  #] -> Nat i)  = \ x -> x +let sib11 : ([i <  #] -> Nat i) -> ([i <  #] -> Nat i)  = \ x -> x++fail let sib10 : ([i <  #] -> Nat i) -> ([i : Size] -> Nat i)  = \ x -> x ++let sub00 : ([i <= #] -> Nat i) -> ([i <= #] -> Nat i)  = \ x -> x +let sub01 : ([i <= #] -> Nat i) -> ([i <  #] -> Nat i)  = \ x -> x +let sub11 : ([i <  #] -> Nat i) -> ([i <  #] -> Nat i)  = \ x -> x++fail let sub10 : ([i <  #] -> Nat i) -> ([i <= #] -> Nat i)  = \ x -> x ++let sub1 : ([i : Size] -> Nat i) -> ([i <= #] -> Nat i)+  = \ x -> x++let sub2 : ([i <= #] -> Nat i) -> ([i : Size] -> Nat i)+  = \ x -> x++sized data MNat : +(i <= #) -> Set+{ mzero [i : Size]            : MNat $i+; msucc [i <= #] (n : MNat i) : MNat $i+}
+ test/succeed/BigWrap.ma view
@@ -0,0 +1,37 @@+-- 2010-09-20 big data type++data BigWrap : Set 1+{ inn : (out : Set) -> BigWrap+}++-- 2012-10-10: automatic irrelevance analysis (forcing)+-- turns this into [A : Set] -> NotBig A+data NotBig : Set -> Set+{ notBig : (A : Set) -> NotBig A+}++data Nat : Set+{ zero : Nat+; succ : Nat -> Nat+}++data NAT : Set 1+{ ZERO : NAT+; SUCC : NAT -> NAT+}++fun NATnat : NAT -> Nat+{ NATnat ZERO = zero+; NATnat (SUCC n) = succ (NATnat n)+}++-- small kind+data Exists : Set+{ inEx : [A : Set] -> (outEx : A) -> Exists+}++-- big kind+data EXISTS : Set 1+{ inEX : (OutType : Set) -> (outValue : OutType) -> EXISTS+}+
+ test/succeed/BoundedQ.ma view
@@ -0,0 +1,26 @@+-- 2010-11-12++{-  another way to look at sized types:++sized data Nat (i : Size) : Set+{ zero : Nat i+; succ : [j : Size] -> |j| < |i| -> Nat j -> Nat i+}++-}+sized data Nat : Size -> Set+{ zero : [i : Size] -> Nat $i+; succ : [i : Size] -> Nat i -> Nat $i+}++fun mySucc : [i : Size] -> [j < i] -> Nat j -> Nat i+{ mySucc i j n = succ j n  }++let boundedId [i : Size] [j <= i] (n : Nat j) : Nat j = n++let explicitCast : [i : Size] -> [j <= i] -> Nat j -> Nat i+  = \ i j n -> n++fun explicitCast' : [i : Size] -> [j : Size] -> |j| <= |i| -> Nat j -> Nat i+{ explicitCast' i j n = n+}
+ test/succeed/BuiltinSigma.ma view
@@ -0,0 +1,46 @@+-- 2011-12-17+-- non-dependent pairs++fun fst' : (A, B : Set) -> (A & B) -> A+{ fst' A B (a, b) = a+}++fun snd' : (A, B : Set) -> A & B -> B+{ snd' A B (a, b) = b+}++let swap : (A, B : Set) -> A & B -> B & A+  = \ A B p -> (snd' A B p, fst' A B p)++fun reassoc' : (A, B, C : Set) -> (A & B) & C -> A & B & C+{ reassoc' A B C ((a , b) , c) = let bc : B & C = b , c in a , bc +}++fun reassoc'' : (A, B, C : Set) -> (A & B) & C -> A & B & C+{ reassoc'' A B C ((a , b) , c) = a , b , c+}++fun reassoc3 : (A, B, C, D : Set) -> ((A & B) & C) & D -> A & B & C & D+{ reassoc3 A B C D (((a , b) , c) , d) = a , b , c , d+}++-- dependent pairs++fun fst : (A : Set) -> (B : A -> Set) -> (x : A) & B x -> A+{ fst A B (a, b) = a+}++fun snd : (A : Set) -> (B : A -> Set) -> (p : (x : A) & B x) -> B (fst A B p)+{ snd A B (a, b) = b+}++let curry : (A : Set) -> (B : A -> Set) -> (C : (x : A) -> B x -> Set) -> +   ((p : (x : A) & B x) -> C (fst A B p) (snd A B p)) -> +   ((x : A) -> (y : B x) -> C x y) +  = \ A B C f x y -> f (x , y)++fun uncurry : (A : Set) -> (B : A -> Set) -> (C : (x : A) -> B x -> Set) -> +  ((x : A) -> (y : B x) -> C x y) -> +  (p : (x : A) & B x) -> C (fst A B p) (snd A B p)+{ uncurry A B C f (x , y) = f x y+}
+ test/succeed/CoFunReturnsProduct.ma view
@@ -0,0 +1,88 @@+-- 2010-05-20, -06-08 Andreas Abel+-- breadth-first relabeling of possibly infinite trees (Jones and Gibbons, 1993)+-- see Nils Anders Danielsson, Beating the Productivity Checker (PAR 2010, FLoC)+-- 2012-01-22 parameters gone from constructors++data Prod (+ A : Set)(+ B : Set) : Set +{ pair : (fst : A) -> (snd : B) -> Prod A B+} fields fst, snd++sized codata Stream (+ A : Set) : Size -> Set+{ cons : [i : Size] -> (head : A) -> (tail : Stream A i) -> Stream A ($ i)+} fields head, tail++sized codata Tree (+ A : Set) : Size -> Set +{ leaf : [i : Size] -> Tree A ($ i)+; node : [i : Size] -> A -> Tree A i -> Tree A i -> Tree A ($ i)+}++-- this definition is fine since the result type is a product+-- where each of its components is coinductive in i (TLCA, 2003)+cofun lab : [i : Size] -> [A : Set] -> [B : Set] ->+   Tree A i -> Stream (Stream B #) i -> +   Prod (Tree B i) (Stream (Stream B #) i)+{+  lab ($ i) A B (leaf {-.A-} .i) bss = +    pair {- (Tree B ($ i)) (Stream (Stream B #) ($ i)) -} (leaf {-B-} i) bss++; lab ($ i) A B (node {-.A-} .i x l r) +    (cons {- .(Stream B #) -} .i (cons {-.B-} .# b bs) bss) =++      -- recursive call on left subtree+      let    pl   : Prod (Tree B i) (Stream (Stream B #) i)+                  = lab i A B l bss ++      -- recursive call on right subtree, threading the label stream-stream+      in let pr   : Prod (Tree B i) (Stream (Stream B #) i)+                  = lab i A B r (snd {- (Tree B i) (Stream (Stream B #) i) -} pl) ++      in pair {- (Tree B ($ i)) (Stream (Stream B #) ($ i)) -}+           (node {-B-} i b (fst {- (Tree B i) (Stream (Stream B #) i) -} pl)+                       (fst {- (Tree B i) (Stream (Stream B #) i) -} pr))+           (cons {- (Stream B #) -} i bs +                       (snd {- (Tree B i) (Stream (Stream B #) i) -} pr))+}+++-- this auxiliary function replaces the original circular program+cofun label2 : [i : Size] -> [A : Set] -> [B : Set] -> +  Tree A i -> Stream B # -> Stream (Stream B #) i +{ label2 ($ i) A B t bs = snd {- (Tree B ($ i)) (Stream (Stream B #) ($ i)) -}+    (lab ($ i) A B t (cons {- (Stream B #)-} i bs (label2 i A B t bs)))+}++-- main program+fun label : [i : Size] -> [A : Set] -> [B : Set] -> +  Tree A i -> Stream B # -> Tree B i+{ label i A B t bs = fst {- (Tree B i) (Stream (Stream B #) i) -}+   (lab i A B t (cons {-(Stream B #)-} i bs (label2 i A B t bs)))+}++-- testing...++data Unit : Set+{ unit : Unit+}++data Nat : Set +{ Z : Nat+; S : Nat -> Nat+}++cofun nats : [i : Size] -> Nat -> Stream Nat i+{ nats ($ i) n = cons {-Nat-} i n (nats i (S n))+}++fun finTree : Nat -> Tree Unit #+{ finTree Z = leaf {- Unit -} #+; finTree (S n) = node {- Unit -} # unit (finTree n) (finTree n)+}++eval let t0 : Tree Nat # = label # Unit Nat (finTree Z) (nats # Z)+eval let t1 : Tree Nat # = label # Unit Nat (finTree (S Z)) (nats # Z)+eval let t2 : Tree Nat # = label # Unit Nat (finTree (S (S Z))) (nats # Z)+eval let t3 : Tree Nat # = label # Unit Nat (finTree (S (S (S Z)))) (nats # Z)++++
+ test/succeed/ConorMcBrideCalco09inflationary.ma view
@@ -0,0 +1,88 @@+-- 2012-02-05  Check whether we can define dependent case in MiniAgda+-- 2013-04-02  Musings on fixed-point++let Map (F : Set -> Set)+  = [A, B : Set] -> (A -> B) -> F A -> F B++cofun Nu : (F : Set -> Set) -(i : Size) -> Set+{ Nu F i = [j < i] -> F (Nu F j)+}++-- * we have Nu F # <==> [i < #] -> Nu F i++cofun Inf : (G : Size -> Set) -(i : Size) -> Set+{ Inf G i = [j < i] -> G j }++let usc [F : Set -> Set] (r : Inf (Nu F) #) : Nu F #+  = r # -- uses upper semi cont++cofun toInf : (F : Set -> Set) (r : Nu F #) -> Inf (Nu F) #+{ toInf F r i j = r j }++-- * we also have Nu F # <==> [i <= #] -> Nu F i++let All (G : Size -> Set) = [i : Size] -> G i++let fromAll [F : Set -> Set] (r : All (Nu F)) : Nu F #+  = r #  -- trivial++cofun toAll : (F : Set -> Set) (r : Nu F #) -> All (Nu F)+{ toAll F r i j = r j }++-- post-fixed point+-- the reasoning usually is+-- Nu F # = Nu F $# = [j < $#] -> F (Nu F j) ==> F (Nu F #)+fail -- 2013-04-05 should work, but needs implementation+fun postfp : [F : Set -> Set] (r : Nu F #) -> F (Nu F #)+{ postfp F r = r # }++-- destructor++let out [F : Set -> Set] [i : Size] (r :  Nu F $i) : F (Nu F i)+  = r i+-- fails to typecheck #ifdef STRICTINFTY (would succeed if i<#)+-- r : [j < $i] -> F (Nu F j)+-- r i : |i| < |$i| -> F (Nu F i)++-- constructor (needs monotonicity of F)++check+fun inn : [F : +Set -> Set] [i : Size] -> F (Nu F i) -> Nu F $i+{ inn F i t j = t+}++let inn [F : +Set -> Set] [i : Size] (t : F (Nu F i)) : Nu F $i+  = \ j -> t++-- coiteration+-- 2013-03-30 this must be a cofun, since not SN.+cofun coit : [F : +Set -> Set] (map : Map F)+  [S : Set] (step : S -> F S)+  [i : Size] -> |i| -> (start : S) -> Nu F i+{ coit F map S step i+    = \ start j -> map S (Nu F j) (coit F map S step j) (step start)+}++{- not needed (eta is built-in)+-- eta++let eta [F : +Set -> Set] [i : Size] (r : Nu F $i) : Nu F $i+  = \ j -> r j++fun caseNu : [F : +Set -> Set]+  [P : (i : Size) -> Nu F i -> Set]+  (f : [i : Size] -> (t : F (Nu F i)) -> P $i (inn F i t))+  [i : Size] (x : Nu F $i) -> P $i (eta F i x)+{ caseNu F P f i x = f i (x i)+}+-}++-- case++let caseNu+  [F : +Set -> Set]+  [P : (i : Size) -> Nu F i -> Set]+  (f : [i : Size] -> (t : F (Nu F i)) -> P $i (inn F i t))+  [i : Size]+  (x : Nu F $i) : P $i x+                = f i (x i)
+ test/succeed/ConstructorTelescopes.ma view
@@ -0,0 +1,19 @@+-- 2012-01-25 parsing telescopes in constructor declarations++data List ++(A : Set) ++(i : Size) : Set+{ nil  [j < i]                         : List A i+; cons [j < i] (x : A) (xs : List A j) : List A i+}++sized data SList ++(A : Set) : +Size -> Set+{ snil  [i : Size]                          : SList A $i+; scons [i : Size] (x : A) (xs : SList A i) : SList A $i+}++{-+sized data IList ++(A : Set) : +Size -> Set+{ inil  [i <= #]                          : IList A $i+; icons [i <= #] (x : A) (xs : IList A i) : IList A $i+}+-}+
+ test/succeed/ConstructorVeiledTarget.ma view
@@ -0,0 +1,9 @@+-- 2010-09-14+-- 2013-04-05 This should maybe no longer enjoy support, merely obfuscating anyway++let Id ++(A : Set) = A++data Bool : Set+{ true : Bool+; false : Id Bool+}
+ test/succeed/DataTypesNotFamilies.ma view
@@ -0,0 +1,13 @@+-- 2012-01-26 omitting types in data type (not family) definitions++data Bool : Set { true ; false }++data List ++(A : Set) : Set+{ nil ; cons (head : A) (tail : List A)+} ++record Prod ++(A, B : Set) : Set+{ pair (fst : A) (snd : B)+} fields fst, snd++fail data Id (a : Bool) : Bool -> Set { refl }
+ test/succeed/DeepMatch.ma view
@@ -0,0 +1,16 @@++data Nat : Set +{ Z : Nat+; S : Nat -> Nat+}++fun plus : Nat -> Nat -> Nat+{ plus Z m = m+; plus (S n) m = S (plus n m)+}++fun fib : Nat -> Nat+{ fib Z         = S Z+; fib (S Z)     = S Z+; fib (S (S n)) = plus (fib n) (fib (S n))+}
+ test/succeed/DescendAscendTerm.ma view
@@ -0,0 +1,17 @@+data Nat : Set+{ zero : Nat+; succ : Nat -> Nat+}++fun plus : Nat -> Nat -> Nat {}++mutual {++  fun f : Nat -> Nat+  { f (succ (succ (succ n))) = g n n+  }++  fun g : Nat -> Nat -> Nat+  { g (succ n) m = plus (g n (succ m)) (f n)+  }+}
+ test/succeed/DotPatternNotLeftToRightBinding.ma view
@@ -0,0 +1,55 @@+-- 2010-09-22+-- 2012-01-22 parameters gone from constructors++fun A : Set {}+fun B : Set {}+fun f : A -> A {}++data Fix *(a : A) : A -> Set+{ fix : Fix a (f a)+}++-- eta not definable unconditionally (like for Id)+fun eta : (a, b : A) -> Fix a b -> Fix a b+{ eta a .(f a) (fix) = fix+} ++-- variable a used in dot pattern left of its binding+fun bla : (b, a : A) -> Fix a b -> A+{ bla .(f a) a (fix) = a+} ++-- Function inverse++data Inv (g : A -> B) : B -> Set+{ mkInv : (getInv : A) -> Inv g (g getInv)+}+-- MiniAgda does not generate destructor getInv++fun getInv : (g : A -> B) -> (b : B) -> Inv g b -> A+  { getInv g .(g a) (mkInv a) = a +  }++{- Analysis:++  mkInv : (getInv : A) -> Inv g b  where b = (g getInv)++bind b in destructor type after parameters++  getInv : (g : A -> B) -> (b : B) -> Inv g b -> A++put its value (g a) down as dot-pattern instead of b++  getInv g .(g a) (mkInv .g a) = a++-}++{-+data Id (A : Set)(a : A) : A -> Set+{ refl : Id A a a+}++fun f : (A : Set) -> (c : A -> A) -> (a : A) -> (b : A) -> Id A (c b) b -> A+{ f A c .(c b) b (refl .A .b) = b+}+-}
+ test/succeed/DottedConstructors.ma view
@@ -0,0 +1,127 @@+-- 2013-04-08 Dotted constructors++data Unit { unit }++data Nat { zero ; suc (n : Nat) }++fun plus : Nat -> Nat -> Nat+{ plus zero    m = m+; plus (suc n) m = suc (plus n m)+}++data List ++(A : Set) { nil ; cons (x : A) (xs : List A) }++data Vec ++(A : Set) (n : Nat)+{ vnil                                : Vec A zero+; vcons (vhead : A) (vtail : Vec A n) : Vec A (suc n)+} fields vhead, vtail++fun append : [A : Set] [n : Nat] [m : Nat] -> Vec A n -> Vec A m -> Vec A (plus n m)+{ append A .zero    m vnil         ys = ys+; append A (.suc n) m (vcons x xs) ys = vcons x (append A n m xs ys)+}++data Fin (n : Nat)+{ fzero            : Fin (suc n)+; fsuc (i : Fin n) : Fin (suc n)+}++fun lookup : [A : Set] [n : Nat] (i : Fin n) (xs : Vec A n) -> A+{ lookup A .zero    ()       vnil+; lookup A (.suc n) fzero    (.vcons x xs) = x+; lookup A (.suc n) (fsuc i) (.vcons x xs) = lookup A n i xs+}++{- untyped terms++data Tm (n : Nat)+{ var (x    : Fin n)+; app (r, s : Tm n)+; abs (t    : Tm (suc n))+}++let Subst (n, m : Nat) = Vec (Tm m) n++fun liftSubst : (n : Nat) [m : Nat] -> Subst n m -> Subst (suc n) (suc m)+{}++fun subst : (n : Nat) [m : Nat] -> Tm n -> Subst n m -> Tm m+{ subst n m (var i)   rho = lookup (Tm m) n i rho+; subst n m (app r s) rho = app (subst n m r rho) (subst n m s rho)+; subst n m (abs t)   rho = abs (subst (suc n) (suc m) t (liftSubst n m rho))+}+-}++data Ty { nat ; arr (a, b : Ty) }++let Cxt = List Ty++data Var (cxt : Cxt) (a : Ty)+{ vzero                 : Var (cons a cxt) a+; vsuc  (x : Var cxt b) : Var (cons a cxt) b+}++data Tm (cxt : Cxt) (a : Ty)++{ var (x : Var cxt a)          : Tm cxt a++; app [a : Ty]+      (r : Tm cxt (arr a b))+      (s : Tm cxt a)           : Tm cxt b++; abs (t : Tm (cons a cxt) b)  : Tm cxt (arr a b)+}++fun Sem : Ty -> Set+{ Sem nat       = Nat+; Sem (arr a b) = Sem a -> Sem b+}++fun Env : Cxt -> Set+{ Env nil         = Unit+; Env (cons a as) = Sem a & Env as+}++fun val : [cxt : Cxt] [a : Ty] -> Var cxt a -> Env cxt -> Sem a+{ val (.cons a cxt) .a vzero   (v, vs) = v+; val (.cons a cxt) b (vsuc x) (v, vs) = val cxt b x vs+}++fun sem : [cxt : Cxt] [a : Ty] -> Tm cxt a -> Env cxt -> Sem a+{ sem cxt a          (var x)     rho   = val cxt a x rho+; sem cxt b          (app a r s) rho   = (sem cxt (arr a b) r rho) (sem cxt a s rho)+; sem cxt (.arr a b) (abs t)     rho v = sem (cons a cxt) b t (v, rho)+}++++{- How to check a data constructor++Case 1: no target given, e.g.++    cons (x : A) (xs : List A)++  Bring the parameters of the data telescope into scope, then+  check constructor telescope++Case 2: target given, e.g.++    vcons (vhead : A) (vtail : Vec A n) : Vec A (suc n)++  Take the parameters off the target, treat them like patterns,+  and check them against the data telecope (or type of data name).+  We get out a context++    A : Set+    n : Nat++  use this context to check full type of constructor.+  Also, check that no binding in constructor type shadows the+  pattern variables of the target (would be confusing).+  In the end, prepend the context to the constructor type.++Case 3: target is function type.++  Extract final target and proceed as in 2.++-}
+ test/succeed/DottedPatSyn.ma view
@@ -0,0 +1,15 @@+-- 2013-04-08++data Bool { false ; true }+data Maybe (A : Set) { nothing ; just (fromJust : A) }++let Three = Maybe Bool+pattern one   = nothing+pattern two   = just false+pattern three = just true++data D (b : Three)+{ c : D three }++fun f : [b : Three] -> D b -> Set 1+{ f .three c = Set }
+ test/succeed/Empty.ma view
@@ -0,0 +1,34 @@+-- 2012-01-28 the empty type as least type++data Empty {}++let abort [A : Set] (x : Empty) : A = x++let abort1 [A : Set] (x : Empty) : A -> A = x+let abort2 [F : +Set -> Set] [A : Set] (x : F Empty) : F A = x++let toEmp [A, B : Set] (x : A -> B) : Empty -> B = x++data Unit { unit }++let abort3 (x : Empty) : Unit = x+-- let abort4 (x : Empty) : |0| < |0| -> Unit = x -- constraint disallowed here+let abort5 (x : Empty) : [i < 0] -> Unit = x++-- unit type as the biggest type++data Bool { true; false }++fun f : Bool -> Unit+{ f x = x+}++let noReturnNeeded [M : +Set -> Set] [A : Set] (x : M A) : M Unit+  = x++fun g : Unit -> Bool+{ g unit = true -- this should translate into a variable pattern+}++let test [T : Bool -> Set] (x : T (g unit)) : T true+  = x
+ test/succeed/EvalBoveCaprettaNotSized.ma view
@@ -0,0 +1,93 @@+-- 2009-11-29  A partial normalizer for untyped lambda calculus in MiniAgda+-- 2012-01-22 parameters gone from constructors++data Nat : Set +{ zero : Nat+; succ : Nat -> Nat+}++data List (+A : Set) : Set+{ nil : List A+; cons : A -> List A -> List A+}++-- de Bruijn terms++data Exp : Set+{ var : Nat -> Exp+; abs : Exp -> Exp +; app : Exp -> Exp -> Exp+}++-- set of values++data D : Set+{ clos : Exp -> (List D) -> D+}++-- environment operations++let Env : Set+      = List D++let empty : Env+      = nil++let update : Env -> D -> Env+      = \ rho -> \ d -> cons d rho       ++let dummy : D+          = clos (var zero) empty++fun lookup : Env -> Nat -> D+{ lookup (nil) n = dummy+; lookup (cons d rho) zero = d+; lookup (cons d rho) (succ n) = lookup rho n+}++-- inductive graph of the evaluation function++data Eval : Exp -> Env -> D -> Set+{ evVar : [k : Nat] -> [rho : Env] ->  ++          -------------------------------+          Eval (var k) rho (lookup rho k)++; evAbs : [e : Exp] -> [rho : Env] -> ++          -----------------------------+          Eval (abs e) rho (clos e rho)  ++; evApp : [f : Exp] -> [e : Exp] -> [rho : Env] -> +          (evldFun : Exp) -> (evldEnv : Env) -> (evldArg : D) -> [d' : D] -> ++          (theFun : Eval f rho (clos evldFun evldEnv)) ->+          (theArg : Eval e rho evldArg) ->+          (theApp : Eval evldFun (update evldEnv evldArg) d') ->+          -----------------------------  +          Eval (app f e) rho d'+}++-- evaluation as a partial function+{- after erasure, the function takes the form++    evaluate : Exp -> Env -> D+-}++mutual {++  fun evaluate : (e : Exp) -> (rho : Env) -> +                 [d : D] -> [Eval e rho d] -> <d : D>+  { evaluate (var k) rho .(lookup rho k) (evVar .k .rho) = lookup rho k+  ; evaluate (abs e) rho .(clos e rho)   (evAbs .e .rho) = clos e rho+  ; evaluate (app f e) rho .d' (evApp .f .e .rho f' rho' d d' evF evE evF')+      = apply f' rho' (evaluate f rho (clos f' rho') evF)+                      (evaluate e rho d evE)  d' evF'+  }++  fun apply : [f' : Exp] -> [rho' : Env] -> <clos f' rho' : D> -> +              (d : D) -> [d' : D] -> [Eval f' (update rho' d) d'] -> <d' : D> +  { apply .f' .rho' (clos f' rho') d d' p = evaluate f' (update rho' d) d' p  +  }+}+
+ test/succeed/EvenOdd.ma view
@@ -0,0 +1,31 @@+-- 2010-08-28 mutual data types++mutual {++  data Even : Set +  { ev0 : Even+  ; evS : Odd -> Even+  }++  data Odd : Set+  { oddS : Even -> Odd+  }++}++data Nat : Set+{ zero : Nat+; suc  : Nat -> Nat+}++mutual {++  fun evenToNat : Even -> Nat+  { evenToNat ev0 = zero+  ; evenToNat (evS o) = suc (oddToNat o)+  }++  fun oddToNat : Odd -> Nat+  { oddToNat (oddS e) = suc (evenToNat e)+  }+}
+ test/succeed/Evens.ma view
@@ -0,0 +1,18 @@+-- 2010-11-01 +-- 2012-01-22 parameters gone from constructors++sized codata Stream ++(A : Set) : -Size -> Set +{ cons : [i : Size] -> (head : A) -> (tail : Stream A i) -> Stream A $i+}++-- suggested by Florent Balestrini+cofun evens : [A : Set] -> [i : Size] -> Stream A (i + i) -> Stream A i+{ evens A ($i) (cons .(i + i + 1) a (cons .(i + i) b as)) =+   cons i a (evens A i as)+}++cofun map2 : [A, B : Set] -> (A -> B) -> +             [i : Size] -> Stream A (2 * i) -> Stream B (2 * i)+{ map2 A B f ($ i) (cons .$(2 * i) a1 (cons .(2 * i) a2 as)) =+    cons $(2 * i) (f a1) (cons (2 * i) (f a2) (map2 A B f i as))+}
+ test/succeed/ExtractLets.ma view
@@ -0,0 +1,15 @@+-- 2010-10-04 extract let definitions++-- the polymorphic identity++let id : [A : Set] -> A -> A+ = \ A x -> x++let s  : [A, B, C : Set] -> (A -> B -> C) -> (A -> B) -> A -> C+  = \ A B C x y z -> x z (y z)++let k : [A, B : Set] -> A -> B -> A+  = \ A B x y -> x++let skk : [A : Set] -> A -> A+  = \ A -> s A (A -> A) A (k A (A -> A)) (k A A)
+ test/succeed/FakeMutual.ma view
@@ -0,0 +1,47 @@+-- 2010-08-28  fake mutuals, to test positivity checker++-- real mutuals++mutual { +  data E : Set { e0 : E+               ; eS : O -> E }+  data O : Set { oS : E -> O }+}++mutual {+  data D1 : Set { d1 : D2 -> D1 }   -- D1 /  D2 ++ D3 /+  data D2 : Set { d2 : D3 -> D2 }   -- D1 /  D2 /  D3 +++  data D3 : Set { d3 : D1 -> D3 }   -- D1 ++ D2 /  D3 /+  {- to see that D1 is spos, we have to traverse the calls through D2 and D3 -}+}++-- fake mutuals++mutual {  ++  -- A is spos in its def.+  data A : Set +  { a1 : A+  ; a2 : A -> A+  }++  -- but not in B+  data B : Set +  { b1  : B+  ; b2  : (A -> B) -> B+  }+}++mutual {++  -- D is spos in its definition+  data D : Set +  { c : D+  ; d : D -> D+  }+  -- D is not spos in T+  fun T : Set -> Set+  { T X = D -> X+  }++}
+ test/succeed/Fields.ma view
@@ -0,0 +1,19 @@+data Nat : Set+{ zero : Nat+; suc  : Nat -> Nat+}++fun f : Nat -> Nat+{}++-- 2010-09-03 currently, MiniAgda parses "index" as an index+-- but it is not computable from D A (f index)+data D ++(A : Nat -> Set) : Nat -> Set+{ mkD : (index : Nat) -> (content : A index) -> D A (f index)+} ++{- generates+fun content : [A : Nat -> Set] -> (index : Nat) -> (d : D A (_f index)) -> A index+{ content A index (mkD .A .index c) = c+}+-}
+ test/succeed/FinBranchMutual.ma view
@@ -0,0 +1,25 @@+-- 2010-08-28++data Nat : Set+{ zero : Nat+; suc  : Nat -> Nat+}++data Unit : Set { unit : Unit }++data Prod ++(A, B : Set) : Set+{ pair : (fst : A) -> (snd : B) -> Prod A B+}++mutual {++  data Tree : Set+  { node : (numBranches : Nat) -> VecTree numBranches -> Tree+  }++  fun VecTree : Nat -> Set+  { VecTree zero    = Unit+  ; VecTree (suc n) = Prod Tree (VecTree n)+  }++}
+ test/succeed/Fix.ma view
@@ -0,0 +1,7 @@+-- 2012-01-27  fix-point principle++fun fix : [A : Size -> Set] -> +  (f : [i : Size] -> ([j < i] -> A j) -> A i) ->+  [i : Size] -> |i| -> A i +{ fix A f i = f i (fix A f)+}
+ test/succeed/ForceInConType.ma view
@@ -0,0 +1,28 @@+-- 2012-02-24, reported by Nisse++data Id ++(A : Set) (x : A) : A -> Set+{ refl : Id A x x+}++data Either ++(A, B : Set) : Set+{ left  : A -> Either A B+; right : B -> Either A B+}++cofun P : ++(A : Set) -> Set+{ P A = Either A A+}++fun Foo : ++(A : Set) -> P A -> Set+{ Foo A x = (z : A) & Id (P A) x (left z)+}++fun foo : ++(A : Set) -> (x : P A) -> Foo A x+{ foo A (left x) = (x, refl)+}++-- leqVal' [(x,1),(A,0)] |- left x  <=^  left x : P A+-- conType left: expected P A to be a data type++-- P is a cofun (and in my original code it is actually corecursive). Is+-- MiniAgda too lazy here?
+ test/succeed/ForcedMatch.ma view
@@ -0,0 +1,15 @@+data Bool : Set+{ true : Bool+; false : Bool+}++data D : Bool -> Bool -> Set+{ d00 : D false false+; d01 : D false true+; d11 : D true true+}++fun f : (b : Bool) -> [D b b] -> Bool+{ f false d00 = false+; f true d11 = true+}
+ test/succeed/ForcedMatchIdType.ma view
@@ -0,0 +1,35 @@+-- 2012-01-22 parameters gone from constructors++data Id (A : Set) (a : A) : A -> Set+{ refl : Id A a a+}++fun subst : [A : Set] -> [a : A] -> [b : A] -> [Id A a b] ->+            [P : A -> Set] -> P a -> P b+{ subst A a .a refl P h = h+}+++{- This is ok, due to the eta-expansion at identity type++  since  p -->eta refl A a+  both sides reduce and, hence, equality can be shown.++  However, at compile time, the matching against refl cannot be removed,+  because of the non-linearity of subst!+-}++let p1 : [A : Set] -> [a : A] -> [p : Id A a a] ->+         [P : A -> Set] -> (h : P a) ->+         Id (P a) (subst A a a p P h) (subst A a a refl P h)+    = \ A a p P h -> refl++let p2 [A : Set] [a : A] [p : Id A a a] [P : A -> Set] (h : P a) :+         Id (P a) (subst A a a p P h) h+    = refl++-- this one is uncontroversial:+let p3 : [A : Set] -> [a, b : A] -> [p, q : Id A a b] ->+         [P : A -> Set] -> (h : P a) ->+         Id (P b) (subst A a b p P h) (subst A a b q P h)+    = \ A -> \ a b -> \ p q -> \ P -> \ h -> refl -- (P b) (subst A a b p P h)
+ test/succeed/ForestRose.ma view
@@ -0,0 +1,19 @@+-- 2010-09-01++data List ++(A : Set) : Set+{ nil  : List A+; cons : A -> List A -> List A+} ++mutual {++  data Rose ++ (A : Set) : Set+  { rose : (label : A) -> (subtrees : Forest A) -> Rose A+  }++  fun Forest : ++ Set -> Set+  { Forest A = List (Rose A)+  }++}+
+ test/succeed/GADT.ma view
@@ -0,0 +1,21 @@+-- 2010-10-03++data Bool : Set+{ true : Bool+; false : Bool+}++data Nat : Set+{ zero : Nat+; suc : Nat -> Nat+}++data Pair (A, B : Set) : Set+{ pair : A -> B -> Pair A B+}++data Exp : Set -> Set 1+{ nat  : Nat  -> Exp Nat+; bool : Bool -> Exp Bool+; tup  : (A, B : Set) -> Pair A B -> Exp (Pair A B)+}
+ test/succeed/GoodConstraint.ma view
@@ -0,0 +1,6 @@+-- 2013-03-30 constraints must follow quantifier+check+fun f : [A : Set] -> ([i : Size] -> |i| < |i| -> A) -> A {}++check+fun f : [A : Set] -> ([i : Size] -> |i| < |i| -> |i| < |i| -> A) -> A {}
+ test/succeed/HEq.ma view
@@ -0,0 +1,8 @@+data HEq [A : Set](a : A) : [B : Set] -> B -> Set+{ refl : HEq A a A a+}++data HEq' [i : Size][A : Set i](a : A) : [B : Set i] -> B -> Set+{ refl' : HEq' i A a A a+}+
+ test/succeed/HVec.ma view
@@ -0,0 +1,31 @@+-- 2010-06-30 heterogeneous vectors+-- 2012-01-22 parameters gone from constructors++data Unit : Set { unit : Unit }++data Prod [i : Size] (A : Set i) (B : Set i) : Set i+--{ pair : A -> B -> Prod i A B+{ pair : (fst : A) -> (snd : B) -> Prod i A B+}++fun fst' : [i : Size] -> [A : Set i] -> [B : Set i] -> Prod i A B -> A+{ fst' i A B (pair a b) = a+}++data List [i : Size] (A : Set i) : Set i+{ nil  : List i A+; cons : A -> List i A -> List i A+}++-- recursive heterogeneous vectors+fun HVecR : List 1 Set -> Set+{ HVecR (nil) = Unit+; HVecR (cons A As) = Prod 0 A (HVecR As)+}++-- inductive heterogeneous vectors+data HVec : List 1 Set -> Set 1+{ vnil  : HVec (nil)+; vcons : [A : Set] -> [As : List 1 Set] ->+          A -> HVec As -> HVec (cons A As)+}
+ test/succeed/HungryEtaRecord.ma view
@@ -0,0 +1,14 @@+-- 2012-02-07++-- a recursive unit type+-- 2013-03-30 must be a cofun since not SN+cofun Hungry : -(i : Size) -> Set+{ Hungry i = [j < i] -> Hungry j+}++fun D : [i : Size] -> Hungry i -> Set {}++-- Don't try this at home!+-- let unique [i : Size] (x, y : Hungry i) (d : D i x) : D i y = d+-- loops! because of infinite eta-expansion performed in equality testing+-- similar to recursive record problem
+ test/succeed/IdTypePos.ma view
@@ -0,0 +1,9 @@+-- 2010-06-20++data Id ++(A : Set)(a : A) : A -> Set+{ refl : Id A a a+}++data Exists (A : Set) ++(P : A -> Set) : Set+{ exI : (witness : A) -> (proof : P witness) -> Exists A P+}
+ test/succeed/IrrHeterogeneousFun.ma view
@@ -0,0 +1,37 @@+-- 2010-10-01++-- an example with different types in context during eq. checking+-- derived from Ulf's counterexample++data Bool : Set+{ true  : Bool+; false : Bool+}++data Nat : Set+{ zero : Nat+; succ : Nat -> Nat+}++fun T : Bool -> Set+{ T true  = Nat+; T false = Bool+}++fun good : +  [F : Nat -> Set] ->+  [f : [b : Bool] -> ([T b] -> Nat) -> Nat] ->+  (g : (n : Nat) -> F (f true (\ x -> n))) ->+  (h : F (f false (\ x -> zero)) -> Bool) -> +  Bool+{ good F f g h = h (g zero)+}++let good' : +    [F : [b : Bool] -> ([T b] -> Nat) -> Set] ->+    (g : F false (\ x -> zero) -> Bool) -> +    (h : (n : Nat) -> F true (\ x -> n)) ->+    Bool+  = \ F g h -> g (h zero)++
+ test/succeed/IrrHeterogeneousSingleton.ma view
@@ -0,0 +1,33 @@+-- 2010-10-01+-- Should heterogeneous equality x : <a : A> ?= a : A+-- succeed?  I'd say yes!++data Bool : Set+{ true  : Bool+; false : Bool+}++data Nat : Set+{ zero : Nat+; succ : Nat -> Nat+}++fun T : Bool -> Set+{ T true  = Nat+; T false = <zero : Nat>+}++fun good : +  [F : Nat -> Set] ->+  [f : [x : Bool] -> T x -> Nat] ->+  (z : T false) ->+  (g : (n : Nat) -> F (f true n)) ->+  (h : F (f false z) -> Bool) -> +  Bool+{ good F f z g h = h (g zero)+}++{- f true zero ?= f false z : Nat+   zero : Nat  ?= z : <zero : Nat>+-}+
+ test/succeed/IrrHeterogeneousSize.ma view
@@ -0,0 +1,22 @@+-- 2010-10-01+-- zero # : Nat # ?= zero i : Nat $i  succeeds+-- even though Nat # /= Nat $i++sized data Nat : Size -> Set+{ zero : [i : Size] -> Nat $i+; succ : [i : Size] -> Nat i -> Nat $i+}++fun good : +  [Size] -> +  [f : [i : Size] -> Nat i -> Set] ->+  (g : [i : Size] -> (n : Nat i) -> f i n) ->+  (h : f # (zero #) -> Set) -> +  Set+{ good i f g h = h (g $i (zero i))+}++{- f # (zero #) : Set  >=  f $i (zero i) : Set+   zero #     : Nat #  ?=  zero i     : Nat $i+-}+
+ test/succeed/LargeElim.ma view
@@ -0,0 +1,28 @@+-- 2010-10-16++data Nat : Set+{ zero : Nat+; succ : Nat -> Nat+}++fun add : Nat -> Nat -> Nat+{ add  zero    n = n+; add (succ m) n = succ (add m n)+}++fun Sum : Nat -> Set+{ Sum zero     = Nat+; Sum (succ n) = Nat -> Sum n+}++fun sum : (n : Nat) -> Nat -> Sum n +{ sum zero     x = x+; sum (succ n) x = \ y -> sum n (add x y)+}++let one   : Nat = succ zero+let two   : Nat = succ one+let three : Nat = succ two+let four  : Nat = succ three++eval let six : Nat = sum four three two one zero zero
+ test/succeed/LetTele.ma view
@@ -0,0 +1,19 @@+-- 2012-01-24 telescopes for let++let id0 : [i : Size] -> [A : Set i] -> (a : A) -> A +  = \ i A a -> a++let id [i : Size][A : Set i](a : A) : A = a++-- 2012-01-26 let and local let without type++let id' [i : Size][A : Set i](a : A) = a++let two [A : Set] (f : A -> A) (x : A) : A =+  let y = f x+  in  f y ++let two' : [A : Set] -> (f : A -> A) -> (x : A) -> A =+  \ A f x ->+  let y = f x+  in  f y
+ test/succeed/LowerSemiCont.ma view
@@ -0,0 +1,61 @@+-- If F is anitone, then it is lower semi-continuous++cofun sup : (F : Size -> Set) +(i : Size) -> Set+{ sup F i = [j < i] & F j }++let pairF [F : -Size -> Set] (a : F #) : sup F #+  = (#, a)++-- [j < i] & F j  is lower semi in i+let supsup [F : Size -> Set] (a : sup F #) : sup (sup F) #+  = (#, a)++cofun bsup : (F : Size -> Set) +(i : Size) -> Set+{ bsup F i = [j <= i] & F j }++-- [j <= i] & F j  is lower semi in i if F i+let bsupsup [F : Size -> Set] (a : sup F #) : bsup (sup F) #+  = (#, a)++sized data SNat : +Size -> Set+{ szero : [i : Size] -> SNat $i+; ssuc  : [i : Size] -> SNat i -> SNat $i+}++let pairSNat (a : SNat #) : [j < #] & SNat j+  = (#, a)++let pairSNat2 (a : SNat #) : [j < #] & SNat j & SNat j+  = (#, a, a)++data Fork ++(A : Set)+{ fork (fst : A) (snd : A)+} fields fst, snd++-- tuples of lsc things are lsc+let forkSNat (a : SNat #) : [j < #] & Fork (SNat j)+  = (#, fork a a)++data Maybe ++(A : Set)+{ nothing+; just (fromJust : A)+} fields fromJust++let maybeSNat (a : SNat #) : [j < #] & Maybe (SNat j)+  = (#, just a)++data List ++(A : Set)+{ nil+; cons (x : A)(xs : List A)+}++fail -- inductive types preserve lcs, but not supported yet+let listSNat (a : SNat #) : [j < #] & List (SNat j)+  = (#, cons a nil)++data Nat +(i : Size) : Set+{ zero : Nat i+; suc  : (jn : [j < i] & Nat j) -> Nat i+}++let one : Nat # = suc (#,zero)
+ test/succeed/Makefile view
@@ -0,0 +1,22 @@+# MiniAgda +# Makefile for successful tests+# Authors: Andreas Abel, Ulf Norell+# Created: 2004-12-03, 2008-09-03++mugda = ../../Main++# Getting all miniagda files+allagda=$(patsubst %.ma,%,$(shell find . -name "*.ma"))++all : $(allagda) ++$(allagda) : % : %.ma+	@echo "----------------------------------------------------------------------"+	@echo $<+	@echo "----------------------------------------------------------------------"+	@$(mugda) $<++clean :+	-rm *~++#EOF
+ test/succeed/MeasureInFunTele.ma view
@@ -0,0 +1,10 @@+-- 2012-02-22++cofun T : -(i : Size)|i| -> Set+{ T i = [j < i] -> T j+}++fun bla : [i : Size] |i| -> T i+{ bla i = bla+}+-- should succeed
+ test/succeed/MeasuredHerSubst1.ma view
@@ -0,0 +1,108 @@+-- 2010-07-27 Implementation of JFP-paper+-- Implementing a Normalizer Using Heterogeneous Sized Types+-- Version with subst/simsubst/normApp mutual++-- 2012-01-22 parameters gone from constructors++data Maybe (A : Set) : Set+{ nothing : Maybe A+; just    : A -> Maybe A+}++let just_ : [A : Set] -> A -> Maybe A = \ A a -> just a++fun mapMaybe : [A, B : Set] -> (A -> B) -> Maybe A -> Maybe B+{ mapMaybe A B f (nothing) = nothing+; mapMaybe A B f (just a)  = just (f a)+}++sized data Ty : Size -> Set +{ base : [i : Size] -> Ty $i+; arr  : [i : Size] -> Ty i -> Ty i -> Ty $i+}++sized data Tm (A : Set) : Size -> Set+{ var  : [i : Size] -> A -> Tm A $i+; app  : [i : Size] -> Tm A i -> Tm A i -> Tm A $i+; abs  : [i : Size] -> Ty # -> Tm (Maybe A) i -> Tm A $i+}++fun mapTm : [A, B : Set] -> [i : Size] -> |i| -> (A -> B) -> Tm A i -> Tm B i+{ mapTm A B i f (var (i > j) x)   = var j (f x)+; mapTm A B i f (app (i > j) r s) = app j (mapTm A B j f r) (mapTm A B j f s)+; mapTm A B i f (abs (i > j) a r) = +    abs j a (mapTm (Maybe A) (Maybe B) j (mapMaybe A B f) r)+}++let shiftTm : [A : Set] -> [i : Size] -> Tm A i -> Tm (Maybe A) i+  = \ A i t -> mapTm A (Maybe A) i (just_ A) t++-- result of substitution is carrying a type or not+data Res (A : Set) +(i : Size) : Set+{ ne : Tm A # -> Res A i+; nf : Tm A # -> Ty i -> Res A i+}++fun tm : [A : Set] -> [i : Size] -> Res A i -> Tm A #+{ tm A i (ne t)   = t+; tm A i (nf t a) = t+}++fun shiftRes : [A : Set] -> [i : Size] -> Res A i -> Res (Maybe A) i+{ shiftRes A i (ne t)   = ne (shiftTm A # t)+; shiftRes A i (nf t a) = nf (shiftTm A # t) a+}++-- construct results without type information+let varRes : [A : Set] -> [i : Size] -> A -> Res A i+  = \ A i x -> ne (var # x)++let absRes : [A : Set] -> [i : Size] -> Ty # -> Res (Maybe A) # -> Res A i+  = \ A i a r -> ne (abs # a (tm (Maybe A) # r))++let appRes : [A : Set] -> [i : Size] -> Res A # -> Res A # -> Res A i+  = \ A i t u -> ne (app # (tm A # t) (tm A # u))++-- environments (in paper: Val)++let Env : Set -> Set -> Size -> Set+  = \ A B i -> A -> Res B i++fun sg : [A : Set] -> [i : Size] -> Tm A # -> Ty i -> Env (Maybe A) A i+{ sg A i s a (nothing) = nf s a+; sg A i s a (just y)  = varRes A i y+}++fun lift : [A, B : Set] -> [i : Size] -> Env A B i -> Env (Maybe A) (Maybe B) i+{ lift A B i rho (nothing) = varRes (Maybe B) i (nothing)+; lift A B i rho (just x)  = shiftRes B i (rho x)+} ++-- hereditary substitution++mutual {++fun subst : [i : Size] -> |i,$$0,#| -> Ty i -> +            [A : Set] -> Tm A # -> Tm (Maybe A) # -> Tm A #+{ subst i a A s t = tm A i (simsubst i # (Maybe A) A t (sg A i s a))+}  ++fun simsubst : [i, j : Size] -> |i,$0,j| -> +               [A, B : Set] -> Tm A j -> Env A B i -> Res B i+{ simsubst i j A B (var (j > j') x) rho = rho x+; simsubst i j A B (abs (j > j') b t) rho = +    absRes B i b (simsubst i j' (Maybe A) (Maybe B) t (lift A B i rho)) +; simsubst i j A B (app (j > j') t u) rho =+    let t' : Res B i = simsubst i j' A B t rho in+    let u' : Res B i = simsubst i j' A B u rho in+      normApp i B t' u'+}++fun normApp : [i : Size] -> |i,0,#| -> +              [B : Set] -> Res B i -> Res B i -> Res B i+{ normApp i B (nf (abs .# b' r') (arr (i > i') b c)) u' =+    nf (subst i' b B (tm B i u') r') c+; normApp i B t' u' = appRes B i t' u'+}++}
+ test/succeed/MeasuredRose.ma view
@@ -0,0 +1,31 @@+-- 2010-07-27+-- 2012-01-22 parameters gone from constructors++data List (+ A : Set) : Set+{ nil  : List A+; cons : A -> List A -> List A+}++fun mapList : [A : Set] -> [B : Set] -> (A -> B) -> List A -> List B+{ mapList A B f (nil) = nil+; mapList A B f (cons a as) = cons (f a) (mapList A B f as)+}++-- sized Roses++sized data Rose (+ A : Set) : Size -> Set+{ rose : [i : Size] -> A -> List (Rose A i) -> Rose A ($ i) +}++fun mapRose : [A : Set] -> [B : Set] -> (A -> B) -> +              [i : Size] -> |i| -> Rose A i -> Rose B i+{ mapRose A B f i (rose (i > j) a rs) = +    rose j (f a) (mapList (Rose A j) (Rose B j) (mapRose A B f j) rs)+}++-- 2012-01-27 it is also possible to place the measure after the rec.arg.+fun mapRose' : [A : Set] -> [B : Set] -> (A -> B) -> +               [i : Size] -> Rose A i -> |i| -> Rose B i+{ mapRose' A B f i (rose (i > j) a rs) = +    rose j (f a) (mapList (Rose A j) (Rose B j) (mapRose' A B f j) rs)+}
+ test/succeed/MergeWith.ma view
@@ -0,0 +1,29 @@+data Bool : Set+{ true  : Bool+; false : Bool+}++data Nat : Set+{ zero : Nat+; suc  : Nat -> Nat+}++data List : Set+{ nil  : List +; cons : Nat -> List -> List+}++fun leq : Nat -> Nat -> Bool {}++-- merge as would be represented with "with" in Agda+mutual {+  fun merge : List -> List -> List+  { merge nil l = l+  ; merge l nil = l+  ; merge (cons x xs) (cons y ys) = merge_aux x xs (cons x xs) y ys (cons y ys) (leq x y)+  }+  fun merge_aux : Nat -> List -> List -> Nat -> List -> List -> Bool -> List+  { merge_aux x xs xxs y ys yys true  = cons x (merge xs yys)+  ; merge_aux x xs xxs y ys yys false = cons y (merge xxs ys) +  }+}
+ test/succeed/MockSig.ma view
@@ -0,0 +1,5 @@+-- 2010-06-19++data MockSig ++(A : Set) ++(B : .A -> Set) : Set+{ pair : (fst : A) -> (snd : B fst) -> MockSig A B+}
+ test/succeed/Mu.ma view
@@ -0,0 +1,46 @@+-- 2010-06-20+-- sized inductive types+-- 2012-01-22 parameters gone from constructors++data Empty : Set {}+data Unit  : Set { unit : Unit }+data Sum ++(A : Set) ++(B : Set) : Set+{ inl : A -> Sum A B+; inr : B -> Sum A B+}+data Prod ++(A : Set) ++(B : Set) : Set+{ pair : (fst : A) -> (snd : B) -> Prod A B +}++sized data Mu ++(F : ++Set -> Set) : +Size -> Set+{ inn : [i : Size] -> (out : F (Mu F i)) -> Mu F ($ i)+}++fun myout : [F : ++Set -> Set] -> [i : Size] -> Mu F ($ i) -> F (Mu F i)+{ myout F i (inn .i t) = t+}++-- iteration (universal property of Mu)+fun iter : [F : ++Set -> Set] -> +           (mapF : [A : Set] -> [B : Set] -> (A -> B) -> F A -> F B) ->+           [G : Set] -> (step : F G -> G) ->+           [i : Size] -> Mu F i -> G+{- iter F mapF G step .($ j) (inn .F j t) =+   step (mapF (Mu F j) G (iter F mapF G step j) t)+-}+{ iter F mapF G step i (inn (i > j) t) =+   step (mapF (Mu F j) G (iter F mapF G step j) t)+}++let NatF : ++Set -> Set         = \ X -> Sum Unit X+let Nat  : +Size -> Set         = Mu NatF++let zero : [i : Size] -> Nat ($ i)+         = \ i -> inn i (inl unit) ++let succ : [i : Size] -> Nat i -> Nat ($ i)+         = \ i -> \ n -> inn i (inr n) +++let ListF : ++Set -> ++Set -> Set = \ A -> \ X -> Sum Unit (Prod A X)+let List  : ++Set -> +Size -> Set = \ A -> Mu (ListF A)
+ test/succeed/MultiSigma.ma view
@@ -0,0 +1,3 @@+-- 2012-02-24++let test = (A, B : Set) & Set
+ test/succeed/MutualBigDataKindInf.ma view
@@ -0,0 +1,20 @@+-- 2010-09-20++data Unit : Set { unit : Unit }+mutual {+  +  data MaybeBig : Set 1+  { Nothing : MaybeBig+  ; Just    : Unit -> Big -> MaybeBig+  }++  data Big : Set 1+  { BigIn : (BigOut : Set) -> Big+  } fields BigOut++}++fun Maybe : MaybeBig -> Set -> (Set -> Set) -> Set+{ Maybe Nothing A F = A+; Maybe (Just u B) A F = F (BigOut B)+}
+ test/succeed/MutualRecordsNoEta.ma view
@@ -0,0 +1,24 @@+-- 2014-01-09++mutual {+  data D -(i : Size)+  { inn (out : R i) }++  data R -(i : Size)+  { delay (force : [j < i] -> D j)+  } fields force+}++fun inh : [i : Size] -> R i+{ inh i .force j = inn (inh j)+}++data Empty : Set {}++fun elim : D # -> (D # -> Empty) -> Empty+{ elim (inn r) f = f (r .force #)+}++-- Stack overflow because MiniAgda thinks D and R are not recursive+-- and does eta-expansion into all eternity+
+ test/succeed/Nested.ma view
@@ -0,0 +1,11 @@+-- 2010-07-01 Ana asked whether nesting is possible++sized data Nat : Size -> Set+{ zero : [i : Size] -> Nat $i+; succ : [i : Size] -> Nat i -> Nat $i+}++fun nested : [i : Size] -> Nat i -> Nat i+{ nested i (zero (i > j))   = zero j+; nested i (succ (i > j) n) = nested j (nested j n)+}
+ test/succeed/NewSyntaxTour.ma view
@@ -0,0 +1,50 @@+-- 2012-01-27++-- Telescopes in let-declarations+----------------------------------------------------------------------++-- instead of++let two : [A : Set] -> (f : A -> A) -> (a : A) -> A+  = \ A f a -> f (f a)++-- one can now write++let two1 [A : Set] (f : A -> A) (a : A) : A+  = f (f a)++-- since the type A of the let-body f (f a) is inferable+-- we can omit it++let two2 [A : Set] (f : A -> A) (a : A)+  = f (f a)++-- telescopes can also contain bounded size variables+-- 2013-04-01 however, these may violate the context consistency check.+fail let boundedSize (j <= #) (i < j) = i++-- Untyped local let+----------------------------------------------------------------------++-- inferable types of local let declarations can also be omitted++let twice [F : Set -> Set] (f : [A : Set] -> A -> F A)+          [A : Set] (a : A) : F (F A)+  = let [FA] = F A   in+    let fa   = f A a in f FA fa++-- local lets can also use telescopes+let localLetTel : Size =+  let two1 [A : Set] (f : A -> A) (a : A)+    = f (f a)+  in 0++-- and can still be made irrelevant+let localLetIrr [A : Set] (f : [A -> A] -> Size) [a : A] : Size =+  let [g] (x : A) = a+  in  f g++-- alternative with . instead of brackets+let localLetIrr1 [A : Set] (f : .(A -> A) -> Size) .(a : A) : Size =+  let .g (x : A) = a+  in  f g
+ test/succeed/Nisse2012-02-17.ma view
@@ -0,0 +1,32 @@+-- bug reported 2012-02-17++data Id ++(A : Set) (x : A) : A -> Set+{ refl : Id A x x+}++data Either ++(A, B : Set) : Set+{ left  : A -> Either A B+; right : B -> Either A B+}++cofun P : ++(A : Set) -> Set+{ P A = Either A A+}++fun Foo : ++(A : Set) -> P A -> Set+{ Foo A x = (z : A) & Id (P A) x (left z)+}++fun foo : ++(A : Set) -> (x : P A) -> Foo A x+{ foo A (left x) = (x, refl)+}++{-+/// leqVal' [(x,1),(A,0)] |- left x  <=^  left x : P A+/// conType left: expected P A to be a data type++P is a cofun (and in my original code it is actually corecursive). Is+MiniAgda too lazy here?++A: do not know, it works (2012-03-06)+-}
+ test/succeed/Nisse2012-03-06.ma view
@@ -0,0 +1,43 @@+-- 2012-03-06+-- more complicated case of comparing case clauses++data Id ++(A : Set) (x : A) : A -> Set+{ refl : Id A x x+}++data Unit : Set+{ unit : Unit+}++data Either ++(A, B : Set) : Set+{ left  : A -> Either A B+; right : B -> Either A B+}++let Maybe ++(A : Set) : Set =+  Either Unit A++pattern nothing = left unit+pattern just x  = right x++data Monad (F : +Set -> Set) : Set $0+{ monad :+    (return        : (A : Set) -> A -> F A) ->+    (bind          : (A, B : Set) -> F A -> (A -> F B) -> F B) ->+    (leftIdentity  : (A, B : Set) (x : A) (f : A -> F B) ->+                     Id (F B) (bind A B (return A x) f) (f x)) ->+    Monad F+}+fields return, bind, leftIdentity++let maybeT (F : +Set -> Set) (M : Monad F) : Monad (\A -> F (Maybe A))+  = monad (\A x -> return M (Maybe A) (just x))+          (\A B m f -> bind M (Maybe A) (Maybe B) m (\x -> case x+                         { nothing  -> return M (Maybe B) nothing+                         ; (just x) -> f x+                         }))+          (\A B x f -> leftIdentity M (Maybe A) (Maybe B) (just x)+                         (\x -> case x+                            { nothing  -> return M (Maybe B) nothing+                            ; (just x) -> f x+                            }))
+ test/succeed/OverloadedConstructors.ma view
@@ -0,0 +1,55 @@+-- 2013-04-26++data Nat { zero ; suc (n : Nat) }++let one : Nat = suc zero+let two : Nat = suc one++fun add : Nat -> Nat -> Nat+{ add zero n = n+; add (suc m) n = suc (add m n)+}++data Fin (n : Nat)+-- refines Nat+{ zero            : Fin (suc n)+; suc (i : Fin n) : Fin (suc n)+}++fun weakF1 : [m : Nat] -> Fin m -> Fin (suc m)+-- refines \ i -> i+{ weakF1 (.suc m) zero    = zero+; weakF1 (.suc m) (suc i) = suc (weakF1 m i)+}++fun weakF : (n : Nat) [m : Nat] -> Fin m -> Fin (add n m)+-- refines \ i -> i+{ weakF zero    m i = i+; weakF (suc n) m i = weakF1 (add n m) (weakF n m i)+}++fun addF : (n : Nat) [m : Nat] -> Fin n -> Fin m -> Fin (add n m)+-- refines add+{ addF (.suc n) m zero    j = weakF (suc n) m j+; addF (.suc n) m (suc i) j = suc (addF n m i j)+}+++data List ++(A : Set) { nil ; cons (x : A) (xs : List A) }++fun lookupL : [A : Set] (i : Nat) (xs : List A) -> A+{ lookupL A zero    (cons x xs) = x+; lookupL A (suc i) (cons x xs) = lookupL A i xs+}++data Vec ++(A : Set) (n : Nat)+-- refines List+{ nil                              : Vec A zero+; cons (head : A) (tail : Vec A n) : Vec A (suc n)+}++fun lookup : [A : Set] [n : Nat] (i : Fin n) (xs : Vec A n) -> A+-- refines LookupL+{ lookup A (.suc n) zero    (.cons x xs) = x+; lookup A (.suc n) (suc i) (.cons x xs) = lookup A n i xs+}
+ test/succeed/PTSRule.ma view
@@ -0,0 +1,11 @@+-- 2010-09-22++-- a buggy PTS rule might check whether the sort of the domain+-- is leq than the sort of the codomain++let T : (i : Size) -> Set ($$ i)+  = \ i -> Set ($ i) -> Set i++let U : (i : Size) -> Set _+  = \ i -> Set ($ _) -> Set _+
+ test/succeed/ParseMultBind.ma view
@@ -0,0 +1,15 @@+let K : (A, B : Set) -> Set+    = \ A B -> A++data Prod ++(A, B : Set) : Set+{ pair : A -> B -> Prod A B+}++fun fst : [A, B : Set] -> Prod A B -> A+{ fst A B (pair a b) = a+}++-- 2012-02-04 telescopes in pi types+fun snd : [A, B : Set] (p : Prod A B) -> B+{ snd A B (pair a b) = b+}
+ test/succeed/ParsePipeOperators.ma view
@@ -0,0 +1,80 @@+-- 2012-01-26 F# forward |> and backward pipe operators (<| is Haskell's $)++-- Backward pipe <|++-- backward pipe is a synonym for application, but associates to the right+-- and binds weaker than almost everything, exept ','+-- currently, it has same binding strength as -> and +++let three [A : Set] (f : A -> A) (x : A) : A+  = f <| f <| f x++let sbla (f : Size -> Size) (x, y : Size) -- : Size+  = f <| x + y++let threeId (f : [A : Set] -> A -> A) [A : Set] (x : A) -- : A+  = f A <| f A <| f A x++-- since <| and -> both associate to the right+-- first-come-first-serve++fail+let failure [F : Size -> Set] [i : Size] [B : Set] (x : F <| i -> B) : Size+  = 0+  -- parsed as F (i -> B)++let success [F : Size -> Set] [i : Size] [B : Set] (x : B -> F <| i) : Size+  = 0+  -- parsed as B -> F i++let one [A : Set] (f : A -> A) : A -> A +  = \ x -> f <| x+  -- parsed as \ x -> f x++-- Forward pipe |>++let binApp [A,B,C : Set] (f : A -> B -> C) (x : A) (y : B) : C+  = y |> f x+  -- parsed as f x y++let redex [A : Set] : A -> A+  = \ x -> x |> \ y -> y+  -- parsed as \ x -> (\ y -> y) x++data List (A : Set) : Set +{ nil                             : List A+; cons (head : A) (tail : List A) : List A+}++-- pipe back can be used in patterns+fun evens : [A : Set] -> List A -> List A+{ evens A nil = nil+; evens A <| cons x <| nil = nil+; evens A <| cons x <| cons y <| xs = cons x <| evens A xs+} ++-- ever tried parens?+{- fails+fun K : [A, B : Set] -> A -> B -> A+{ ((K A) B a) b = a+}+-}++record Prod ++(A, B : Set) : Set +{ pair (fst : A) (snd : B) : Prod A B+} fields fst, snd++-- pointless but parses+fun fork : [A : Set] -> (a : A) -> Prod A A+{ fork A a <| .fst = a+; fork A a <| .snd = a+}++{- fails rightly, parsed as (a. fst)+fun fork' : [A : Set] -> (a : A) -> Prod A A+{ fork' A <| a .fst = a+; fork' A <| a .snd = a+}+-}++
+ test/succeed/Pattern.ma view
@@ -0,0 +1,72 @@+-- 2012-01-23 pattern declarations++data Unit : Set { unit  : Unit }++-- * Booleans++data Bool : Set +{ true  : Bool+; false : Bool+}++fun if : [i : Size] -> (A : Set i) -> Bool -> ++(a, b : A) -> A+{ if i A true  a b = a+; if i A false a b = b+}++fun If : Bool -> ++(A, B : Set) -> Set+{ If true  A B = A+; If false A B = B+}++-- * disjoint sum++let Plus : ++(A, B : Set) -> Set+  = \ A B -> (b : Bool) & If b A B++pattern inl a = true  , a+pattern inr b = false , b++fun casePlus : [A, B, C : Set] -> (A -> C) -> (B -> C) -> Plus A B -> C+{ casePlus A B C f g (inl a) = f a+; casePlus A B C f g (inr b) = g b+}++-- * Maybe++let Maybe : ++(A : Set) -> Set+  = Plus Unit++pattern nothing = inl unit+pattern just a  = inr a++fun maybe : [A, B : Set] -> B -> (A -> B) -> Maybe A -> B+{ maybe A B b f nothing  = b+; maybe A B b f (just a) = f a+}++let mapMaybe : [A, B : Set] -> (A -> B) -> Maybe A -> Maybe B+  = \ A B f -> maybe A (Maybe B) nothing (\ a -> just (f a))++-- * Lists++let ListF : ++(A, X : Set) -> Set+  = \ A X -> Maybe (A & X)++cofun List : ++(A : Set) -> ++(i : Size) -> Set+{ List A i = (j < i) & ListF A (List A j)+}++pattern nil  j      = j , nothing+pattern cons j a as = j , just (a , as)++++{-+data Bit  : Set { b0 : Bit; b1 : Bit }++fun BitCase : Bit -> ++(A, B : Set) -> Set+{ BitCase b0 A B = A+; BitCase b1 A B = B+}+-}
+ test/succeed/PatternParameters.ma view
@@ -0,0 +1,137 @@+data Unit { unit }+data Bool { false ; true }++data Nat { zero ; suc (n : Nat) }++fun plus : Nat -> Nat -> Nat+{ plus zero    m = m+; plus (suc n) m = suc (plus n m)+}++data List ++(A : Set) { nil ; cons (x : A) (xs : List A) }++-- * Vectors++data OldVec ++(A : Set) : (n : Nat) -> Set+{ oldvnil                                                   : OldVec A zero+; oldvcons (n : Nat) (oldvhead : A) (oldvtail : OldVec A n) : OldVec A (suc n)+} fields oldvhead, oldvtail++data Vec ++(A : Set) (n : Nat)+{ vnil                                : Vec A zero+; vcons (vhead : A) (vtail : Vec A n) : Vec A (suc n)+} fields vhead, vtail++fun append : [A : Set] (n : Nat) [m : Nat] -> Vec A n -> Vec A m -> Vec A (plus n m)+{ append A zero    m vnil         ys = ys+; append A (suc n) m (vcons x xs) ys = vcons x (append A n m xs ys)+}++data Fin (n : Nat)+{ fzero            : Fin (suc n)+; fsuc (i : Fin n) : Fin (suc n)+}++fun lookup : [A : Set] (n : Nat) (i : Fin n) (xs : Vec A n) -> A+{ lookup A zero    ()       vnil+; lookup A (suc n) fzero    (vcons x xs) = x+; lookup A (suc n) (fsuc i) (vcons x xs) = lookup A n i xs+}++{- untyped terms++data Tm (n : Nat)+{ var (x    : Fin n)+; app (r, s : Tm n)+; abs (t    : Tm (suc n))+}++let Subst (n, m : Nat) = Vec (Tm m) n++fun liftSubst : (n : Nat) [m : Nat] -> Subst n m -> Subst (suc n) (suc m)+{}++fun subst : (n : Nat) [m : Nat] -> Tm n -> Subst n m -> Tm m+{ subst n m (var i)   rho = lookup (Tm m) n i rho+; subst n m (app r s) rho = app (subst n m r rho) (subst n m s rho)+; subst n m (abs t)   rho = abs (subst (suc n) (suc m) t (liftSubst n m rho))+}+-}++-- * Simply typed lambda terms.++data Ty { nat ; arr (a, b : Ty) }++let Cxt = List Ty++data Var (cxt : Cxt) (a : Ty)+{ vzero                 : Var (cons a cxt) a -- non-linearity ok!+; vsuc  (x : Var cxt b) : Var (cons a cxt) b+}++data Tm (cxt : Cxt) (a : Ty)+{ var (x : Var cxt a)                                : Tm cxt a+; app (a : Ty) (r : Tm cxt (arr a b)) (s : Tm cxt a) : Tm cxt b+; abs (t : Tm (cons a cxt) b)                        : Tm cxt (arr a b)+}++fun Sem : Ty -> Set+{ Sem nat       = Nat+; Sem (arr a b) = Sem a -> Sem b+}++fun Env : Cxt -> Set+{ Env nil         = Unit+; Env (cons a as) = Sem a & Env as+}++fun val : (cxt : Cxt) [a : Ty] -> Var cxt a -> Env cxt -> Sem a+{ val (cons a cxt) .a vzero   (v, vs) = v+; val (cons a cxt) b (vsuc x) (v, vs) = val cxt b x vs+}++fun sem : (cxt : Cxt) (a : Ty) -> Tm cxt a -> Env cxt -> Sem a+{ sem cxt a         (var x)     rho = val cxt a x rho+; sem cxt b         (app a r s) rho = sem cxt (arr a b) r rho (sem cxt a s rho)+; sem cxt (arr a b) (abs t)     rho v = sem (cons a cxt) b t (v, rho)+}++-- * Identity type.++data Id (A : Set) (x, y : A) { refl : Id A x x }++fun subst : [A : Set] [P : A -> Set] [x, y : A] -> Id A x y -> P x -> P y+{ subst A P x .x refl h = h }++fail let trueIsFalse : Id Bool true false = refl++{- How to check a data constructor++Case 1: no target given, e.g.++    cons (x : A) (xs : List A)++  Bring the parameters of the data telescope into scope, then+  check constructor telescope++Case 2: target given, e.g.++    vcons (vhead : A) (vtail : Vec A n) : Vec A (suc n)++  Take the parameters off the target, treat them like patterns,+  and check them against the data telecope (or type of data name).+  We get out a context++    A : Set+    n : Nat++  use this context to check full type of constructor.+  Also, check that no binding in constructor type shadows the+  pattern variables of the target (would be confusing).+  In the end, prepend the context to the constructor type.++Case 3: target is function type.++  Extract final target and proceed as in 2.++-}
+ test/succeed/Polarities.ma view
@@ -0,0 +1,89 @@+-- 2010-06-19, 2010-11-09++let Const : ++ Set -> . Set -> Set +          = \ A -> \ X -> A++let DNeg : ^ Set -> + Set -> Set+         = \ B -> \ A -> * (* A -> B) -> B++data Empty : Set {}++sized data Nat : + Size -> Set+{ zero : [i : Size] -> Nat ($ i)+; succ : [i : Size] -> ^ Nat i -> Nat ($ i)+}++let Cont' : + Set -> Set+         = DNeg Empty++-- the following holds already because of whnf computation+let cast' : [i : Size] -> ^ Cont' (Nat i) -> Cont' (Nat #)+         = \ i -> \ x -> x++data Cont +(A : Set) : Set +{ cont : (uncont : DNeg Empty A) -> Cont A+}++-- the following holds because Cont is a datatype (pol. already impl.)+let cast : [i : Size] -> ^ Cont (Nat i) -> Cont (Nat #)+         = \ i -> \ x -> x++-- hide positivity behind recursion+fun Id : * Nat # -> ++Set -> Set+{ Id (zero .#)   A = A+; Id (succ .# n) A = A+}++let kast : [i : Size] -> [n : Nat i] -> Id n (Nat i) -> Id n (Nat #)+         = \ i -> \ n -> \ x -> x++data Tree -(B : Set) ++(A : Set) : Set+{ leaf : Tree B A+; node : A -> (B -> Tree B A) -> Tree B A+}++sized data STree -(B : Set) ++(A : Set) : +Size -> Set+{ sleaf : [i : Size] -> STree B A ($ i)+; snode : [i : Size] -> A -> (B -> STree B A i) -> STree B A ($ i)+}++data Mu ++(F : ++Set -> Set) : Set+{ inn : F (Mu F) -> Mu F+}++{-+  .(p)  = o+  ++(p) = p+  +(++) = ++  +(p)  = p+  -(++) = -+  -(+)  = -+  -(-)  = ++  -(p)  = p +  o(o)  = o+  o(++) = .+  o(+)  = .+  o(-)  = .+  o(.)  = .++  -(Gamma) |- A : s  Gamma |- B : s+  ---------------------------------+  Gamma |- A -> B : s++  -(Gamma) |- A : s  Gamma, x : A |- B : s+  ----------------------------------------+  Gamma |- p(x : A) -> B : s++  --------------------------------  p in {++,+,o}+  Gamma, p(x : A), Gamma' |- x : A+  +  Gamma, p(x : A) |- t : B+  ----------------------------+  Gamma |- \xt : p(x : A) -> B++  Gamma |- r : p(x : A) -> B   p(Gamma) |- s : A+  ----------------------------------------------+  Gamma |- r s: B[s/x]+    ++-}
+ test/succeed/PredDepType.ma view
@@ -0,0 +1,21 @@+sized data Nat : Size -> Set+{ zero : [i : Size] -> Nat ($ i)+; succ : [i : Size] -> Nat i -> Nat ($ i)+}++fun Pred : (i : Size) -> (x : Nat ($ i)) -> Set+{ Pred i (succ .i n) = Nat i+; Pred i (zero .i)   = Nat ($ i)+}++fun pred : [i : Size] -> (x : Nat ($ i)) -> Pred i x+{ pred i (succ .i n) = n+; pred i (zero .i)   = zero i+}++{- DOES NOT WORK+fun minus : [i : Size] -> Nat i -> Nat # -> Nat i+{ minus i n (zero .#) = n+; minus i n (succ .# m) = minus i (pred i n) m +}+-}
+ test/succeed/Prelude.ma view
@@ -0,0 +1,38 @@+-- 2012-01-28  MiniAgda Prelude, PiSigma style++data Empty {}+data Unit { unit }+data Bool { true; false }++fun If : (b : Bool) -> ++(A, B : Set) -> Set+{ If true  A B = A+; If false A B = B+}++let Either ++(A, B : Set) = (b : Bool) & If b B A+pattern left  a = (false, a)+pattern right b = (true, b)++let Maybe ++(A : Set) = Either Unit A+pattern nothing = left unit+pattern just a  = right a++cofun Nat : +Size -> Set+{ Nat i = [j < i] & Maybe (Nat j)+}+pattern zero j   = (j, nothing)+pattern succ j n = (j, just n)++      let zer [i : Size]          : Nat $i = zero 0+check let suc [i < #] (n : Nat i) : Nat $i = succ i n++fun suc : [i : Size] (n : Nat i) -> Nat $i +{ suc i (i', m) = succ $i' (i', m)+}++fun plus : [i : Size] -> (n : Nat i) -> +           [j : Size] -> (m : Nat j) -> Nat (i+j)+{ plus i (zero i')   j m = m+; plus i (succ i' n) j m = suc (i'+j) <| plus i' n j m+}+-- 2012-02-01 type checker turns var pattern i' into size pattern (i' < i)
+ test/succeed/Prod.ma view
@@ -0,0 +1,3 @@+data Prod (A : Set)(B : Set) : Set+{ pair : (fst : A) -> (snd : B) -> Prod A B+}
+ test/succeed/Projections.ma view
@@ -0,0 +1,14 @@+-- 2012-01-25++-- record+data Sigma ++(A : Set) ++(B : A -> Set) : Set+{ pair (fst : A) (snd : B fst) : Sigma A B+} fields fst, snd++fun eta : [A, B : Set] -> Sigma A (\ x -> B) -> Sigma A (\ x -> B)+{ eta A B p = pair (fst p) (snd p)+}++let builtinEta [A, B : Set] (p : Sigma A (\ x -> B)) +  : < pair (fst p) (snd p) : Sigma A (\ x -> B) >+  = p
+ test/succeed/Rose.ma view
@@ -0,0 +1,19 @@+data List (+ A : Set) : Set+{ nil  : List A+; cons : A -> List A -> List A+}++fun mapList : [A : Set] -> [B : Set] -> (A -> B) -> List A -> List B+{ mapList A B f (nil) = nil+; mapList A B f (cons a as) = cons (f a) (mapList A B f as)+}++sized data Rose (+ A : Set) : Size -> Set+{ rose : [i : Size] -> A -> List (Rose A i) -> Rose A ($ i) +}++fun mapRose : [A : Set] -> [B : Set] -> (A -> B) -> +              [i : Size] -> Rose A i -> Rose B i+{ mapRose A B f .($ i) (rose i a rs) = +  rose i (f a) (mapList (Rose A i) (Rose B i) (mapRose A B f i) rs)+}
+ test/succeed/SP.ma view
@@ -0,0 +1,33 @@+{- 2010-03-24 Awaji Island++Mixed coinduction/induction.  Allow data with coinductive occurrences.+Interpreted as greatest fixpoint of a least fixpoint.+-}++sized codata Str (+ A : Set) : Size -> Set+{ cons : [i : Size] -> A -> Str A i -> Str A ($ i)+}++fun A : Set {}+fun B : Set {}++sized data SP' (+ X : Set) : Size -> Set +{ get : [j : Size] -> (A -> SP' X j) -> SP' X ($ j)+; out : [j : Size] -> X -> SP' X ($ j)+}++sized codata SP : Size -> Set +{ put : [i : Size] -> B -> SP' (SP i) # -> SP ($ i)+}++fun run' : [i : Size] -> (SP i -> Str A # -> Str B i) ->+           [j : Size] -> SP' (SP i) j -> Str A # -> Str B i+{ run' i r j (get {- .(SP i)-} (j > k) f) (cons .# a as) = run' i r k (f a) as+; run' i r j (out {- .(SP i)-} (j > k) sp) as            = r sp as+}++cofun run : [i : Size] -> SP i -> Str A # -> Str B i+{ run ($ i) (put .i b sp) as  = cons i b (run' i (run i) # sp as)+}++
+ test/succeed/ScopeCheckFunDef.ma view
@@ -0,0 +1,21 @@+data Bool : Set { true : Bool; false : Bool }++fun not : Bool -> Bool+{ not true = false+; not false = true+}++fun notnot : Bool -> Bool+{ notnot x = not (not x)+}++fun T : Bool -> Set+{ T true = Bool+; T false = Bool+}++fun f : (b : Bool) -> T b -> T b+{ f true  x = x+; f false x = x+}+
+ test/succeed/SgPredWrongMon.ma view
@@ -0,0 +1,16 @@+-- 2010-06-20++let Pred : -Set -> Set 1+         = \ A -> A -> Set++data Sg ++(A : Set) : A -> Set+{ sg : (elem : A) -> Sg A elem+}++sized data Nat : +Size -> Set+{ zero : [i : Size] -> Nat ($ i)+; succ : [i : Size] -> Nat i -> Nat ($ i)+}++let Sg' : +(A : Set) -> A -> Set+        = Sg
+ test/succeed/SolverBugStreamFixed.ma view
@@ -0,0 +1,227 @@+-- Booleans ----------------------------------------------------------++data Bool : Set +{ tt : Bool+; ff : Bool+}++fun ifthenelse : Bool -> [A : Set] -> A -> A -> A+{ ifthenelse tt A a1 a2 = a1+; ifthenelse ff A a1 a2 = a2+}++-- Nat ---------------------------------------------------------------++sized data SNat : Size -> Set +{ zero : [i : Size] -> SNat ($ i)+; succ : [i : Size] -> SNat i -> SNat ($ i) +}++let Nat : Set = SNat #++fun add : Nat -> Nat -> Nat +{ add (zero .#)   = \ y -> y+; add (succ .# x) = \ y -> succ # (add x y)+}++fun leq : Nat -> Nat -> Bool+{ leq (zero .#)    y          = tt+; leq (succ .# x) (zero .#)   = ff +; leq (succ .# x) (succ .# y) = leq x y +}++-- Stream ------------------------------------------------------------++sized codata Stream (+ A : Set) : Size -> Set +{ cons : [i : Size] -> A -> Stream A i -> Stream A ($ i)+}+ +fun tail : [A : Set] -> [i : Size] -> Stream A ($ i) -> Stream A i+{ tail A i (cons .i x xs) = xs+}++fun head : [A : Set] -> [i : Size] -> Stream A ($ i) -> A +{ head A i (cons .i x xs) = x+}++fun nth : [A : Set] -> [i : Size] -> SNat i -> Stream A i -> A +{ nth A i (zero (i > j))   xs = head A j xs+; nth A i (succ (i > j) n) xs = nth  A j n (tail A j xs) +}++-- map, zip, merge ---------------------------------------------------++cofun map : [A : Set] -> [B : Set] -> [i : Size] -> +            (A -> B) -> Stream A i -> Stream B i +{+map A B ($ i) f (cons .i x xl) = cons _ (f x) (map A B _ f xl)+}++cofun zipWith : [A : Set] -> [B : Set] -> [C : Set] ->+                (A -> B -> C) -> [i : Size] ->+		Stream A i -> Stream B i -> Stream C i +{+  zipWith A B C f ($ i) (cons .i a as) (cons .i b bs) = +	cons i (f a b)  (zipWith A B C f i as bs) +}++cofun merge : [i : Size] -> (Nat -> Nat -> Bool) -> +              Stream Nat i -> Stream Nat i -> Stream Nat i+{+merge ($ i) le (cons .i x xs) (cons .i y ys) = +      ifthenelse (le x y) (Stream Nat _)+         (cons _ x (merge _ le xs (cons _ y ys)))+	 (cons _ y (merge _ le (cons _ x xs) ys))     +}++{-+cofun merge : [i : Size] -> (Nat -> Nat -> Bool) -> +              Stream Nat i -> Stream Nat i -> Stream Nat i+{+merge .($ i) le (cons .i x xs) (cons i y ys) = +      ifthenelse (le x y) (Stream Nat _)+         (cons _ x (merge _ le xs (cons _ y ys)))+	 (cons _ y (merge _ le (cons _ x xs) ys))     +}+-}++-- Hamming function --------------------------------------------------++let n0 : Nat = zero #+let n1 : Nat = succ # n0+let n2 : Nat = succ # n1+let n3 : Nat = succ # n2+let n4 : Nat = succ # n3+let n5 : Nat = succ # n4++let double : Nat -> Nat+           = \ n -> add n n+let triple : Nat -> Nat+           = \ n -> add n (double n)++cofun ham : [i : Size] -> Stream Nat i+{+  ham ($ i) = cons _ n1 (merge i leq (map Nat Nat i double (ham i)) +                                    (map Nat Nat i triple (ham i)))+}+++{-+-- THIS SHOULD NOT TYPECHECK!!+cofun map2 : [i : Size] -> (Nat -> Nat) -> Stream Nat i -> Stream Nat i +{+map2 .($ ($ i)) f (cons .($ i) u (cons i x xl)) = +  cons _ (f u) (cons _ (f x) (map2 _ f xl))+}++cofun ham2 : [i : Size] -> Stream Nat i+{+  ham2 ($ i) = cons _ n1 (merge i leq (map2 i double (ham2 i)) +                                     (map2 i triple (ham2 i)))+}++-- THIS LOOPS!!!+eval let bla : Nat = nth n1 (ham2 #)+-}++-- Fibonacci stream --------------------------------------------------++{- NOT YET IMPLEMENTED: rational sizes+   WILL NOT IMPLEMENT -- see fibDeep.ma++cofun fib : [i : Size] -> Stream Nat (i + i)+{+  fib (i + 1) = cons _ n0 (cons _ n1 (zipWith Nat Nat Nat add+    i (fib i) (tail Nat i (fib (i + 1/2)))))+}++-}++{- distinguish fib from the following++cofun bad : [i : Size] -> Stream Nat i+{+  bad ($ ($ i)) = cons _ n0 (tail Nat _ (bad ($ i)))+}++-}++cofun fib : [i : Size] -> Stream Nat i+{+  fib ($ i) = cons _ n0 (zipWith Nat Nat Nat add i +    (cons _ n1 (fib i)) (fib i))+}++++cofun fibIter' : (x : Nat) -> (y : Nat) -> [i : Size] -> Stream Nat i +{+  fibIter' x y ($ i) = cons _ x (fibIter' y (add x y) _)+} +let fibIter : Stream Nat # = (fibIter' n1 n1 _)+++--------------------------------------------++-- fibIter(4) = 5 +eval let fibIter4 : Nat = nth Nat # n4 fibIter ++eval let fib1 : Nat = nth Nat # n1 (fib #)+eval let fib2 : Nat = nth Nat # n2 (fib #)+eval let fib3 : Nat = nth Nat # n3 (fib #)+eval let fib4 : Nat = nth Nat # n4 (fib #)+eval let fib5 : Nat = nth Nat # n5 (fib #)+++--------------------------------------------++data Leq : Nat -> Nat -> Set+{ lqz : (x : Nat) -> Leq (zero #) x +; lqs : (x : Nat) -> (y : Nat) -> Leq x y -> Leq (succ # x) (succ # y)+}++sized codata Increasing : Size -> Stream Nat # -> Set+{+inc : [i : Size] -> (x : Nat) -> (y : Nat) -> Leq x y -> (tl : Stream Nat #) -> +      Increasing i (cons # y tl) ->+      Increasing ($ i) (cons # x (cons # y tl)) +}+++data Eq (+ A : Set) : A -> A -> Set+{+refl : [a : A] -> Eq A a a+}++let proof : Eq (Stream Nat #) (tail Nat # fibIter) (tail Nat # fibIter) = +  refl (tail Nat # fibIter)+++-- 2010-07-07 this is just "nats" it should termination check+-- not so evil++let succ_ : [i : Size] -> SNat i -> SNat $i = \ i x -> succ i x++cofun evil : [i : Size] -> Stream Nat i+{+evil ($ i) = map Nat Nat _ (succ_ _) (cons _ (zero _) (evil _))+}++-- eval const zzz : Nat = head # (z #) ++++-- convolution (Shin-Cheng Mu)+ +let cons_ : [A : Set] -> [i : Size] -> A -> Stream A i -> Stream A $i+   = \ A i a as -> cons i a as++cofun dmerge : [A : Set] -> [i : Size] -> Stream (Stream A i) i -> Stream A i+{+dmerge A ($ i) (cons .i ys yss) = +  cons i (head A _ ys) (dmerge A i+    (zipWith A (Stream A _) (Stream A _) (cons_ A _) i +            (tail A _ ys) yss))+}++
+ test/succeed/Squash.ma view
@@ -0,0 +1,127 @@+-- 2010-07-09 Workshop on Dependently Typed Programming DTP-10+-- 2010-09-21 Email discussion on Agda list with Dan Doel+-- 2012-01-22 parameters gone from constructors++data Id [A : Set](a : A) : A -> Set+{ refl : Id A a a+}++fun elimId : [A : Set] -> [P : A -> Set] -> [a, b : A] -> [Id A a b] ->+             P a -> P b+{ elimId A P a .a refl h = h+}++-- Existentials ------------------------------------------------------++data Ex (A : Set)(P : A -> Set) : Set+{ exIntro : [a : A] -> P a -> Ex A P+}++-- Large existentials +impredicative data Exists [i : Size](A : Set i)(P : A -> Set) : Set+{ ExIntro : [a : A] -> P a -> Exists i A P+}++-- projections not definable (weak Sigma)+fail fun proj1 : [i : Size] -> [A : Set i] -> [P : A -> Set] -> +                 Exists i A P -> A+{ proj1 i A P (ExIntro a p) = a -- a cannot appear here!+}++-- Exists elimination+fun ExElim : [i : Size] -> [A : Set i] -> [P : A -> Set] -> +             Exists i A P -> [C : Set] -> ([a : A] -> P a -> C) -> C+{ ExElim i A P (ExIntro a p) C k = k a p+}++-- Subsets -----------------------------------------------------------++data Subset (A : Set) (P : A -> Set) : Set+{ inSub : (outSub : A) -> [P outSub] -> Subset A P+}++fun outSub' : [A : Set] -> [P : A -> Set] -> Subset A P -> A+{ outSub' A P (inSub a p) = a+}++-- Proof-irrelevant propositions (Proof types / bracket types) -------++data Prf ++(A : Set) : Set+{ prf : [A] -> Prf A+}++fun proofIrr : [A : Set] -> [a, b : Prf A] -> Id (Prf A) a b+{ proofIrr A (prf a) (prf b) = refl+}++fail fun proofIrr' : [A : Set] -> [a, b : Prf A] -> Id (Prf A) a b+{ proofIrr' A a b = refl+}++-- Monad Laws for Prf++fun mapPrf : [A, B : Set] -> (A -> B) -> Prf A -> Prf B+{ mapPrf A B f (prf a) = prf (f a)+}++fun joinPrf : [A : Set] -> Prf (Prf A) -> Prf A+{ joinPrf A (prf (prf a)) = prf a+}++fail fun bindPrf : [A, B : Set] -> Prf A -> (A -> Prf B) -> Prf B+{ bindPrf A B (prf a) f = f a  -- a cannot be used here+}++let bindPrf : [A, B : Set] -> Prf A -> (A -> Prf B) -> Prf B+  = \ A B pa f -> joinPrf B (mapPrf A (Prf B) f pa)++{- Dan Doel, eliminator for "Squash" = Prf++I believe this is equivalent to what the thesis refers to as token+type target erasure. It would make the Squash eliminator:++ elimSq : (A : Set) => (P : Squash A -> Set) =>+          (f : (x : A) => P (squash x)) ->+          (s : Squash A) => P s+ elimSq A P f (squash x) = f x++and in general, it would improve the eliminator of any singleton type+in the same way. However, the problem is that equality types are in+this class, and if you make those erasable, you get bad meta-theoretic+properties. -}++fun elimPrf : [A : Set] -> [P : Prf A -> Set] ->+              (f : [a : A] -> P (prf a)) ->+              [x : Prf A] -> P x+{ elimPrf A P f (prf a) = f a +}++-- More laws for bracket types++-- does not go this way+fail fun isoForall1 : [A : Set] -> [B : A -> Set] ->+                 ((x : A) -> Prf (B x)) -> Prf ((x : A) -> B x)+{ isoForall1 A B f = prf {-((x : A) -> B x)-} (\ x -> f x)+}++fun isoForall2 : [A : Set] -> [B : A -> Set] ->+                 Prf ((x : A) -> B x) -> (x : A) -> Prf (B x)+{ isoForall2 A B (prf {-.((x' : A) -> B x')-} f) x = prf {-(B x)-} (f x)+}+++data Prod ++(A, B : Set) : Set+{ pair : (fst : A) -> (snd : B) -> Prod A B+}++fun isoAnd1 : [A, B : Set] -> Prod (Prf A) (Prf B) -> Prf (Prod A B)+{ isoAnd1 A B (pair (prf a) (prf b)) =+    prf (pair a b)+}++fun isoAnd2 : [A, B : Set] -> Prf (Prod A B) -> Prod (Prf A) (Prf B)+{ isoAnd2 A B (prf (pair a b)) = +    pair (prf a) (prf b)+}++
+ test/succeed/Stack.ma view
@@ -0,0 +1,66 @@+-- 2010-07-13,-27  state-less stack object++data Maybe (A : Set) : Set+{ nothing : Maybe A+; just : A -> Maybe A+}++-- stack object+sized codata Stack (A : Set) : Size -> Set+{ stack : [i : Size] ->+  (top  : Maybe A) ->+  (pop  : Stack A i) ->+  (push : A -> Stack A i) -> Stack A $i+} ++-- functional to construct push action+cofun pushFunc : [A : Set] -> [i : Size] -> |i| ->+                 ([j : Size] -> |j| < |i| -> Stack A j -> A -> Stack A j) ->+                 Stack A i -> A -> Stack A i+{ pushFunc A ($ i) f s a = stack i (just a) s (f i (pushFunc A i f s a))+} +-- f : [j : Size] -> |j| < |$i| -> Stack A j -> A -> Stack A j+-- s : Stack A $i+-- by subtyping+-- f : [j : Size] -> |j| < |i| -> Stack A j -> A -> Stack A j+-- s : Stack A i+-- hence  pushFunc A i f s a : Stack A i+--   f i (...) : A -> Stack A i+-- rhs : Stack A $i++-- tying the knot+cofun pushFix  : [A : Set] -> [i : Size] -> |i| -> Stack A i -> A -> Stack A i+{ pushFix A ($ i) = pushFunc A ($ i) (pushFix A)+}+-- on the rhs, we have the typing of the recursive call+--   pushFix A : [j : Size] -> |j| < |$i| -> Stack A j -> A -> Stack A j++-- constructing the empty stack+cofun empty : [A : Set] -> [i : Size] -> |i| -> Stack A i+{ empty A ($ i) = stack i nothing (empty A i) (pushFix A i (empty A i))+}+ +{- original circular program++data Stack a = Stack +  { top  :: Maybe a+  , pop  :: Stack a+  , push :: a -> Stack a+  } ++-- circular auxiliary program to construct stacks +push' :: Stack a -> a -> Stack a+push' s a = s'+  where s' = Stack (Just a) s (push' s')++-- the empty stack+empty :: Stack a+empty = Stack Nothing empty (push' empty)++-}++{-++  push' s a = fix (\ s' -> Stack (Just a) s (push' s'))++-}
+ test/succeed/StreamDupl.ma view
@@ -0,0 +1,12 @@+-- 2010-11-01 ++sized codata Stream ++(A : Set) : -Size -> Set +{ cons : [i : Size] -> (head : A) -> (tail : Stream A i) -> Stream A $i+}+ +cofun evens : [A : Set] -> [i : Size] -> Stream A (i + i) -> Stream A i+{ evens A ($i) (cons .(i + i + 1) a (cons .(i + i) b as)) =+   cons i a (evens A i as)+}+-- this should fail because we cannot match the input stream to depth 2+-- since only i is replaced by $i
+ test/succeed/StrictBoundedQCoinductive.ma view
@@ -0,0 +1,19 @@+-- 2010-11-26++data Bool : Set+{ true : Bool+; false : Bool+}++let C : Size -> Set+      = \ i -> [j : Size] -> |j| < |i| -> Bool++cofun foo : [i : Size] -> C i+{ foo ($i) j = true+}++{- does not type check+cofun loop : [i : Size] -> C i+{ loop ($i) j = loop i j+}+-}
+ test/succeed/UPolyList.ma view
@@ -0,0 +1,5 @@+data List [i : Size](A : Set i) : Set i+{ nil  : List i A+; cons : A -> List i A -> List i A+}+
+ test/succeed/Universe.ma view
@@ -0,0 +1,19 @@+-- 2010-08-28++data Nat : Set+{ zero : Nat+; suc  : Nat -> Nat+}++mutual {++  data U : Set +  { nat : U+  ; pi  : (a : U) -> (El a -> U) -> U+  }++  fun El : U -> Set+  { El nat = Nat+  ; El (pi a f) = (x : El a) -> El (f x)+  }+}
+ test/succeed/VecNotErased.ma view
@@ -0,0 +1,48 @@+data Nat : Set+{+  zero : Nat;+  succ : (pred : Nat) -> Nat+}++fun add : Nat -> Nat -> Nat+{+  add zero y = y;+  add (succ x) y = succ (add x y)+}++data Vec' (+A : Set) : Nat -> Set+{+  vnil'  : Vec' A zero;+  vcons' :  (n : Nat) -> (head' : A) -> (tail' : Vec' A n) -> Vec' A (succ n)  +}++{-+data Vec (+A : Set) : Nat -> Set+{+  vnil  : Vec A zero;+  vcons : (head : A) -> [n : Nat] -> (tail : Vec A n) -> Vec A (succ n)  +}++fun length : [A : Set] -> [n : Nat] -> Vec A n -> Nat+{+  length .A .zero (vnil A) = zero;+  length .A .(succ n) (vcons A x n xs) = succ (length A n xs);+}++fun append : [A : Set] -> [n : Nat] -> Vec A n -> +                          [m : Nat] -> Vec A m -> Vec A (add n m)+{+  append .A .zero     (vnil A)         m ys = ys;+  append .A .(succ n) (vcons A x n xs) m ys = +    vcons A x (add n m) (append A n xs m ys)+}++data Id (A : Set)(a : A) : A -> Set+{ refl : Id A a a+}++let vec0vnil : (A : Set) -> (v : Vec A zero) -> Id (Vec A zero) v (vnil A)+             = \ A -> \ v -> refl (Vec A zero) v++ +-}
+ test/succeed/WrapAbsurd.ma view
@@ -0,0 +1,35 @@+-- 2010-07-08++data Wrap ++(A : Set) : Set+{ wrap : (unwrap : A) -> Wrap A+}++data Empty : Set {}++-- should succeed+fun wrap0Elim : Wrap Empty -> Empty+{ wrap0Elim (wrap ()) +}++data Unit : Set { unit : Unit }++-- should fail+fail fun wrap1Elim : Wrap Unit -> Empty+{ wrap1Elim (wrap ())+}++{- BEFORE BUG FIX:++checkPattern+  dot pats: [(0,(Unit,[(Set 0)]))]+  environ : [(".Unit",v0)]+  context : [[(Set 0)]]+  pattern : ()+  at type : ((unwrap : v0) -> Wrap A{A = v0})	<>++the test whether there are matchingConstructors is too optimistic+since v0 is not solved yet to be Unit, it finds no matching constructors+--> it should solve first++BUG FIX: postpone emptyness check till after pattern checking+-}
+ test/succeed/absurdPattern.ma view
@@ -0,0 +1,5 @@+data Empty : Set {}++fun magic : [A : Set] -> [x : Empty] -> A+{ magic A () +}
+ test/succeed/addWith.ma view
@@ -0,0 +1,28 @@+sized data SNat : Size -> Set+{+zero : (i : Size) -> SNat ($ i);+succ : (i : Size) -> SNat i -> SNat ($ i)+}++-- deep predecessor+-- a size preserving function+fun ote : (i : Size) -> SNat i -> SNat i+{+ote .($ i) (zero i) = zero i;+ote .($ $ i) (succ .($ i) (zero i)) = zero i; +ote .($ $ i) (succ .($ i) (succ i x)) = succ ($ i) (succ i (ote i x ))+}++-- add, applying f to both arguments in each step, permuting the arguments+-- "permutating size arguments"+fun addWith : ((k : Size ) -> SNat k -> SNat k ) -> (i : Size ) -> (j : Size ) -> SNat i -> SNat j -> SNat #+{+addWith f .($ i) j (zero i) y = y;+addWith f .($ i) j (succ i x) y = succ # (addWith f j i (f j y) (f i x)) +}++let three : SNat # = succ # (succ # (succ # (zero #))) +let four  : SNat # = succ # three++eval let bla : SNat # = addWith ote # # four three +
+ test/succeed/casePair.ma view
@@ -0,0 +1,23 @@+-- 2012-01-26 infer type of pair++data Bool : Set { true; false }++{- 2012-02-03 pair inference disabled because of irrelevance+   would need polarity annotation in first component in general++let xor (a, b : Bool) : Bool+  = case a, b   -- infers type of (a,b)+    { (true, true) -> false+    ; (false, true) -> true+    ; (true, false) -> true+    ; (false, false) -> false+    }+-}++let xor' (a, b : Bool) : Bool+  = case (a,b) : Bool & Bool+    { (true, true) -> false+    ; (false, true) -> true+    ; (true, false) -> true+    ; (false, false) -> false+    }
+ test/succeed/caseSList.ma view
@@ -0,0 +1,73 @@+-- 2012-01-22 parameters gone from constructors++data Nat : Set +{ zero : Nat+; suc  : Nat -> Nat+}++data Bool : Set+{ true  : Bool+; false : Bool +}++fun leq : Nat -> Nat -> Bool+{ leq zero n = true+; leq (suc m) zero = false+; leq (suc m) (suc n) = leq m n+}++data Id (A : Set) (a : A) : A -> Set+{ refl : Id A a a+}++fun True : ^Bool -> Set+{ True b = Id Bool b true+}+let triv : True true+         = refl++fun False : Bool -> Set+{ False b = Id Bool b false+}+let triv' : False false+          = refl++fun leFalse : (n : Nat) -> (m : Nat) -> False (leq n m) -> True (leq m n)+{ leFalse  n       zero   p = triv+; leFalse (suc n) (suc m) p = leFalse n m p+; leFalse zero    (suc m) () -- IMPOSSIBLE+}++data SList : Nat -> Set+{ snil  : SList zero+; scons : (shead : Nat) ->      -- I can erase this at compile-time, but+                                -- it should be present at run-time ??+          (stailindex : Nat) -> -- this should be erased at run-time ??+          [True (leq stailindex shead)] -> +          (stail : SList stailindex) -> +          SList shead+} ++fun maxN : Nat -> Nat -> Nat+{ maxN n m = case leq n m +  { true -> m+  ; false -> n+  }+}++fun maxLemma : (n : Nat) -> (m : Nat) -> (k : Nat) ->+              True (leq n k) -> True (leq m k) -> True (leq (maxN n m) k)+{ maxLemma n m k p q = case leq n m +  { true  -> q+  ; false -> p+  } +}++fun insert : (m : Nat) -> (n : Nat) -> SList n -> SList (maxN n m)+{ insert m .zero snil = scons m zero triv snil+; insert m n (scons .n k p l) = case leq n m +  { true  -> scons m n triv (scons n k p l)+  ; false -> scons n (maxN k m) (maxLemma k m n p (leFalse n m triv')) +                   (insert m k l)+  }+}
+ test/succeed/conat.ma view
@@ -0,0 +1,59 @@+sized codata CoNat : Size -> Set+{ zero : [i : Size] -> CoNat ($ i) +; succ : [i : Size] -> CoNat i -> CoNat ($ i)  +}++sized codata CoNatEq : (i : Size) -> CoNat i -> CoNat i -> Set+{ eqz : [i : Size] -> CoNatEq ($ i) (zero i) (zero i)+; eqs : [i : Size] -> (n : CoNat i) -> (m : CoNat i) -> +   CoNatEq i n m -> CoNatEq ($ i) (succ i n) (succ i m)+}++cofun add : [i : Size] -> CoNat i -> CoNat i -> CoNat i+{ add ($ i) (zero .i)   n = n+; add ($ i) (succ .i m) n = succ i (add i m n)+}++cofun mult : [i : Size] -> CoNat i -> CoNat i -> CoNat i+{ mult ($ i) (zero .i)   n           = zero i+; mult ($ i) (succ .i m) (zero .i  ) = zero i+; mult ($ i) (succ .i m) (succ .i n) = succ i (add i n (mult i m (succ i n)))+}++{-+-- addmult n m = n*m + m+cofun addmult : [i : Size] -> CoNat # -> CoNat i -> CoNat i+{ addmult i (zero .#) n = n+; addmult i (succ .# m) n = add i n (addmult i m n)+}+-}++-- (n + 1)^(m + 1) = (n+1) * (n+1) ^ m = (n+1) ^ m + n * (n+1) ^ m+-- expinc m n = (n+1) ^ m+-- expinc 0 n = 1+-- expinc (m+1) n = (n+1) * expinc m n = addmult n (expinc m n)++-- cofun expinc : [i : Size] -> CoNat # -> CoNat i -> CoNat i++-- pexp m n = (n+1)^m - 1+-- pexp 0     n     = 0+-- pexp (m+1) 0     = 0 +-- pexp (m+1) 1     = 2^(m+1) - 1 -- ??? +-- pexp (m+1) (n+2) = 1 + n + (n+2) * pexp m (n+2)+-- (n + 2)^(m + 1) = (n+2) * (n+2) ^ m = (n+2) ^ m + n * (n+1) ^ m+{-+cofun exp : [i : Size] -> CoNat i -> CoNat i -> CoNat i+{ exp ($ i) (zero .i  ) n           = succ i (zero i)+; exp ($ i) (succ .i m) (zero .i)   = zero i+; exp ($ i) (succ .i m) (succ .i n) = succ i (case i +  { ($ j) -> case n of+    { (zero .j) ->+    ; (succ .j n) ->+    } +   })+}++(zero .i)) = succ i (zero i)+; exp ($ i) (succ .i m) (succ .i (zero .i)) = succ i (zero i)++-}
+ test/succeed/countConstructors.ma view
@@ -0,0 +1,35 @@+-- 2010-01-13++data Nat : Set +{ zero : Nat+; succ : Nat -> Nat+}++fun plus : Nat -> Nat -> Nat {}++mutual {+  fun f1 : Nat -> Nat+  { f1 zero = zero+  ; f1 (succ zero) = zero+  ; f1 (succ (succ n)) = g1 n+  }++  fun g1 : Nat -> Nat+  { g1 zero = zero+  ; g1 (succ n) = f1 (succ (succ n))+  }+}++mutual {+  fun f : Nat -> Nat+  { f zero = zero+  ; f (succ zero) = zero+  ; f (succ (succ n)) = g n+  }++  fun g : Nat -> Nat+  { g zero = zero+  ; g (succ n) = plus (f n) (plus (f (succ n)) (f (succ (succ n))))+  }+}+
+ test/succeed/crazys.ma view
@@ -0,0 +1,19 @@+sized data SNat : Size -> Set+{+zero : (i : Size ) -> SNat ($ i);+succ : (i : Size ) -> SNat i -> SNat ($ i)+}++fun o2e : (i : Size ) -> SNat i -> SNat i+{+o2e .($ i) (zero i) = zero _;+o2e .($ $ i) (succ .($ i) (zero i)) = zero _; +o2e .($ $ i) (succ .($ i) (succ i x)) = succ _ (succ _ (o2e _ x ))+}++-- "permutating size arguments"+fun crazy : (i : Size ) -> (j : Size ) -> SNat i -> SNat j -> SNat #+{+crazy .($ i) j (zero i) y = y;+crazy .($ i) j (succ i x) y = succ _ (crazy _ _ y (o2e _ x)) +}
+ test/succeed/drop.ma view
@@ -0,0 +1,18 @@++sized data SNat : Size -> Set+{+  zero : (i : Size) -> SNat ($ i);+  succ : (i : Size) -> SNat i -> SNat ($ i)+}++sized codata Stream : Size -> Set {+  cons : (i : Size) -> SNat # -> Stream i -> Stream ($ i)+}++-- drop the first elements of a stream++fun drop : (i : Size) -> SNat i -> Stream # -> Stream #+{+  drop .($ i) (zero i)    xs           = xs ;+  drop .($ i) (succ i y) (cons .# x xs) = drop i y xs+}
+ test/succeed/eta.ma view
@@ -0,0 +1,10 @@+data P (A : Set) : (A -> A) -> Set +{+  inn : (out : A -> A) -> P A out+}++fun bla : (A : Set) -> (f : (A -> A) -> (A -> A)) -> +  P (A -> A) f ->  P (A -> A) (\ x -> f x)+{+  bla A f p = p    -- (c .(A -> A) f) = c (A -> A) (\ x -> f x)+}
+ test/succeed/eta_unit.ma view
@@ -0,0 +1,47 @@+-- 2009-06-25 eta expansion for the unit type++data Unit : Set +{+  unit : Unit+}++fun P : Unit -> Set+{+  P unit = Unit+}++fun p : (u : Unit) -> P u+{+  p x = unit+}++fun q : (u : Unit) -> P u+{+  q unit = unit+}++-- what also should work is+-- q .unit = unit++-- 2009-09-19++data Bool : Set+{ true  : Bool+; false : Bool+}+   +let r' : Bool -> Unit+       = \ b -> unit++let pr' : (b : Bool) -> P (r' b)+       = \ b -> unit +   +fun r : Bool -> Unit+{ r true = unit+; r false = unit+}++-- definitions need also to be eta-expanded+-- otherwise the following does not typecheck+let pr : (b : Bool) -> P (r b)+       = \ b -> unit
+ test/succeed/exists.ma view
@@ -0,0 +1,28 @@+-- 2010-03-28 Exists and Bracket via parametric function types+-- 2012-01-22 parameters gone from constructors++data Sigma (A : Set)(B : A -> Set) : Set+{ pair : (fst : A) -> (snd : B fst) -> Sigma A B+}++data Subset (A : Set)(B : A -> Set) : Set+{ put : (get : A) -> [prf : B get] -> Subset A B+}++data Exists (A : Set)(B : A -> Set) : Set+{ exI : [a : A] -> (prop : B a) -> Exists A B+}++fun exE : [A : Set] -> [B : A -> Set] -> [C : Set] -> +      Exists A B -> ([a : A] -> B a -> C) -> C +{ exE A B C (exI a b) k = k a b+}++data Bracket (A : Set) : Set+{ bI : [a : A] -> Bracket A+}++fun bE : [A : Set] -> [C : Set] -> Bracket A -> ([A] -> C) -> C+{ bE A C (bI a) k = k a+}+
+ test/succeed/fib.ma view
@@ -0,0 +1,137 @@+-- 2012-01-22 parameters gone from constructors++data Nat : Set {+  zero : Nat;+  succ : (n : Nat) -> Nat +}++fun add : Nat -> Nat -> Nat {+  add zero = \y -> y;+  add (succ x) = \y -> succ (add x y)+}++sized codata Stream : Size -> Set {+  cons : (i : Size) -> Nat -> Stream i -> Stream ($ i)+}+ +fun tail : Stream # -> Stream # {+  tail (cons .# x xs) = xs+}++fun head : Stream # -> Nat {+  head (cons .# x xs) = x+}++{-+norec head : (i : Size) -> Stream ($ i) -> Nat {+  head .($ i) (cons i n ns) = n+}++cofun zipWith :  (Nat -> Nat -> Nat ) -> ( i : Size ) +		-> Stream i -> Stream i -> Stream i {+  zipWith f ($ i) as bs = +	cons i (f (head i as) (head i bs))  (zipWith f i (tail i as) (tail i bs)) +}+-}++fun nth : Nat -> Stream # -> Nat {+  nth zero xs = head xs;+  nth (succ x) xs = nth x (tail xs) +}++let one : Nat = (succ zero)++cofun fib' : (x : Nat ) -> (y : Nat ) -> (i : Size ) -> Stream i +{+  fib' x y ($ i) = cons _ x (fib' y (add x y) _)+} +let fib : Stream # = (fib' one one _)+++let four : Nat = (succ (succ (succ one)))++-- fib(four) = 5 +eval let fibfour : Nat = nth four fib +++--------------------------------------------+--------------------------------------------++data Leq : Nat -> Nat -> Set+{+lqz : (x : Nat ) -> Leq zero x ;+lqs : (x : Nat ) -> (y : Nat ) -> Leq x y -> Leq (succ x) (succ y)+}++sized codata Increasing : Size -> Stream # -> Set+{+inc : (i : Size ) -> (x : Nat ) -> (y : Nat ) -> Leq x y -> (tl : Stream # ) -> +      Increasing i (cons # y tl) ->+      Increasing ($ i) (cons # x (cons # y tl)) +}+++data Eq (+ A : Set)(a : A) : A -> Set+{ refl : Eq A a a+}++let proof : Eq (Stream #) (tail fib) (tail fib) = refl++++let double : Stream # -> Stream # = \s -> cons _ (head s) s++data Bool : Set +{+tt : Bool;+ff : Bool+}++fun leq : Nat -> Nat -> Bool+{+leq zero y = tt;+leq (succ x) zero = ff ;+leq (succ x) (succ y) = leq x y +}++fun ite : Bool -> (A : Set ) -> A -> A -> A+{+ite tt A a1 a2 = a1;+ite ff A a1 a2 = a2+}++cofun merge : (i : Size ) -> (Nat -> Nat -> Bool) -> Stream # -> Stream # -> Stream i+{+merge ($ i) le (cons .# x xs) (cons .# y ys) = +      ite (le x y) (Stream _)+         (cons _ x (merge _ le xs (cons _ y ys)))+	 (cons _ y (merge _ le (cons _ x xs) ys))     +}++fun first : (A : Set ) -> (B : Set ) -> A -> B -> A+{+first A B a b = a+}++--------------------++cofun map : (i : Size) -> (Nat -> Nat) -> Stream i -> Stream i +{+map ($ i) f (cons .i x xl) = cons _ (f x) (map _ f xl)+}++{-+-- 2012-01-22 constructor are no longer inferable!+let suc : Nat -> Nat = \ x -> succ x+-- 2012-01-25 constructor recognition also for function types+-}++cofun evil : (i : Size) -> Stream i+{+evil ($ i) = map _ succ (cons _ zero (evil _))+}++-- eval const zzz : Nat = head # (z #) +++
+ test/succeed/fibDeep.ma view
@@ -0,0 +1,87 @@+-- 2012-01-22 parameters gone from constructors++data Nat : Set +{ zero : Nat+; succ : Nat -> Nat +}++fun add : Nat -> Nat -> Nat +{ add zero     = \ y -> y+; add (succ x) = \ y -> succ (add x y)+}++sized codata Stream (+ A : Set) : Size -> Set {+  cons : [i : Size] -> A -> Stream A i -> Stream A ($ i)+}++fun head : [A : Set] -> [i : Size] -> Stream A ($ i) -> A +{ head A i (cons .i a as) = a+}++fun tail : [A : Set] -> [i : Size] -> Stream A ($ i) -> Stream A i+{ tail A i (cons .i a as) = as+}++cofun zipWith : [A : Set] -> [B : Set] -> [C : Set] -> (A -> B -> C) -> +                [i : Size] -> Stream A i -> Stream B i -> Stream C i +{ zipWith A B C f ($ i) (cons .i a as) (cons .i b bs) = +    cons i (f a b)  (zipWith A B C f i as bs) +}++cofun adds : [i : Size] -> Stream Nat i -> Stream Nat i -> Stream Nat i +{ adds ($ i) (cons .i a as) (cons .i b bs) = +    cons i (add a b) (adds i as bs)+}++let one : Nat = succ zero++{- Size matching++at type  [i : Size] -> Co i  one can match i against ($ j) +since for i = 0,  Co i is the set of all terms++type checking rule++    i:Size, j < i, i --> $ j |- e : Gamma -> Co ($ j)+    -------------------------------------------------+    case i { ($ j) -> e } : Gamma -> Co i ++basically, there is an analysis whether the type of the case is+"everything"  (opposite of empty).++ -}++cofun fib' : [i : Size] -> Stream Nat i+{+  fib' i = case i+   { ($ j) -> cons j zero (case j +   { ($ k) -> cons k one (zipWith Nat Nat Nat add k +                              (fib' k) +                              (tail Nat k (fib' ($ k))))})}+}++{- we can pull one case into the pattern match, but not both -}++cofun fib : [i : Size] -> Stream Nat i+{ fib ($ i) = cons i zero (case i +    { ($ j) -> cons j one (adds j (fib j) (tail Nat j (fib i)))})+} ++{- blueprint+cofun fib : [i : Size] -> Stream Nat i+{ fib ? = cons ? zero +    (cons ? one (adds ? (fib ?) (tail Nat ? (fib ?))))+} +-- UNSOUND+cofun fib : [i : Size] -> Stream Nat i+{ fib ($$ i) = cons ($ i) zero +    (cons i one (adds i (fib i) (tail Nat ($ i) (fib ($ i)))))+} +-}++{- the question is how to facilitate inference for this? +   We need to insert case splits at the appropriate positions.+   Why not, this is a form of type reconstruction.+   Relies on bidirectional type checking.+   Currently, MiniAgda does not check constructors, but infers them, which is bad. + -}
+ test/succeed/gcd-either.ma view
@@ -0,0 +1,44 @@+-- 2011-12-16 Andreas, gcd example++sized data Nat : Size -> Set +{ zero : [i : Size] -> Nat ($ i)+; suc  : [i : Size] -> Nat i -> Nat ($ i)+}++-- subtracting two numbers with minus yields the difference+-- plus a bit indicating the bigger number of the two++data Either : +Size -> +Size -> Set+{ left  : [i,j : Size] -> Nat i -> Either i j+; right : [i,j : Size] -> Nat j -> Either i j+}++fun minus : [i,j : Size] -> Nat i -> Nat j -> Either i j+{ minus i j (zero (i > i'))   m                 = right i j m +; minus i j (suc  (i > i') n) (zero (j > j'))   = left i j (suc i' n)+; minus i j (suc  (i > i') n) (suc  (j > j') m) = minus i' j' n m+}++{- UNUSED+fun esuc : [i,j : Size] -> Either i j -> Either $i $j+{ esuc i j (left  .i .j n) = left  $i $j (suc i n)+; esuc i j (right .i .j n) = right $i $j (suc j n)+}+-}++mutual {++  fun gcd : [i,j : Size] -> Nat i -> Nat j -> Nat #+  { gcd i j (zero (i > i')) m = m+  ; gcd i j (suc (i > i') n) (zero (j > j')) = suc i' n+  ; gcd i j (suc (i > i') n) (suc (j > j') m) = +      gcd_aux i j i' j' n m (minus i' j' n m)+  }++  fun gcd_aux : [i,j : Size] -> [i' < i] -> [j' < j] -> Nat i' -> Nat j' ->+                Either i' j' -> Nat #+  { gcd_aux i j i' j' n m (left  .i' .j' n') = gcd i' j n' (suc j' m)+  ; gcd_aux i j i' j' n m (right .i' .j' m') = gcd i j' (suc i' n) m'+  }++}
+ test/succeed/hamming.ma view
@@ -0,0 +1,55 @@+-- 2012-01-22 parameters gone from constructors++-- Nat ---------------------------------------------------------------++data Nat : Set +{ zero : Nat+; succ : Nat -> Nat +}++fun add : Nat -> Nat -> Nat +{ add  zero    = \y -> y+; add (succ x) = \y -> succ (add x y)+}++let double : Nat -> Nat+           = \ n -> add n n+let triple : Nat -> Nat+           = \ n -> add n (double n)++fun leq : Nat -> Nat -> [C : Set] -> C -> C -> C+{ leq  zero     y       C tt ff = tt+; leq (succ x)  zero    C tt ff = ff+; leq (succ x) (succ y) C tt ff = leq x y C tt ff +}++-- Stream ------------------------------------------------------------++sized codata Stream (+ A : Set) : Size -> Set +{+  cons : [i : Size] -> A -> Stream A i -> Stream A ($ i)+}++cofun map : [A : Set] -> [B : Set] -> [i : Size] -> +            (A -> B) -> Stream A i -> Stream B i +{+  map A B ($ i) f (cons .i x xl) = cons _ (f x) (map A B _ f xl)+}++cofun merge : [i : Size] -> Stream Nat i -> Stream Nat i -> Stream Nat i+{+  merge ($ i) (cons .i x xs) (cons .i y ys) = +      leq x y (Stream Nat _)+         (cons _ x (merge _ xs (cons _ y ys)))+	 (cons _ y (merge _ (cons _ x xs) ys))     +}+++-- Hamming function --------------------------------------------------++cofun ham : [i : Size] -> Stream Nat i+{+  ham ($ i) = cons _ (succ zero) +                (merge i (map Nat Nat i double (ham i)) +                         (map Nat Nat i triple (ham i)))+}
+ test/succeed/ho.ma view
@@ -0,0 +1,21 @@+data Bool : Set+{+	tt : Bool;+	ff : Bool+}++fun apply : (Bool -> Bool) -> Bool -> Bool+{+apply f b = f b +}++fun neg : Bool -> Bool+{+neg	tt = ff;+neg	ff = tt	+}++let f : Bool = apply neg tt++let t : Bool = apply (\ x  -> tt) ff+
+ test/succeed/implicitSizeVarUsedExplicitely.ma view
@@ -0,0 +1,37 @@+data Bool : Set+{ true : Bool+; false : Bool+}++data Nat : Set+{ zero : Nat+; succ : Nat -> Nat+}++fun leq : Nat -> Nat -> Bool {}++fun plus : [A : Set] -> A -> A -> A {}++sized data List : Size -> Set+{ nil  : (i : Size) -> List ($ i) +; cons : [i : Size] -> Nat -> List i -> List ($ i)+}++fun filter : [i : Size] -> List i -> List i+{ filter .($ i) (nil i) = nil i  -- Size variables are resurrected+; filter .($ i) (cons i n l) = plus (List ($ i)) (filter _ l) (cons _ n (filter _ l))+}++fun quicksort : [i : Size] -> List i -> List #+{ quicksort .($ i) (nil i) = nil _+; quicksort .($ i) (cons i n l) = +    plus (List #) (quicksort _ (filter i l)) (cons _ n (quicksort _ (filter i l))) +}++data Id (A : Set)(a : A) : A -> Set+{ refl : Id A a a+}+{-+let p1 : (i : Size) -> Id (List #) (nil i) (nil #)+       = \ i -> refl (List #) (nil i)+-}
+ test/succeed/lengthCoList.ma view
@@ -0,0 +1,89 @@+-- 2012-01-22 parameters gone from constructors++sized data Nat : Size -> Set+{+  zero : [i : Size] -> Nat ($ i);+  succ : [i : Size] -> Nat i -> Nat ($ i);+}+++sized codata Colist (A : Set) : Size -> Set+{+  nil  : [i : Size] -> Colist A ($ i);+  cons : [i : Size] -> A -> Colist A i -> Colist A ($ i)+}++cofun olist' : [i : Size] -> Colist (Nat #) i+{+olist' ($ i) = cons i (zero #) (olist' i)+}++{-+-- not allowed because no inductive argument with i +fun length : [i : Size] -> [A : Set] -> Colist A i -> Nat i+{+length ($ i) .A (nil A .i) = zero i ;+length ($ i) .A (cons A .i a as) = succ i (length i A as)+}++eval let diverge : Nat # = length # (Nat #) (olist' #)+-}++sized codata CoNat : Size -> Set+{+  cozero : [i : Size] -> CoNat ($ i);+  cosucc : [i : Size] -> CoNat i -> CoNat ($ i)+}++let z : CoNat # = cozero #++-- allowed because i used in coinductive result+cofun length2 : [i : Size] -> [A : Set] -> Colist A i -> CoNat i+{+length2 ($ i) A (nil .i) = cozero i;+length2 ($ i) A (cons .i a as) = cosucc i (length2 i A as) +}++cofun omega' : [i : Size] -> CoNat i+{+omega' ($ i) = cosucc i (omega' i)+}++let omega : CoNat # = omega' #++-- not ok because size not used in inductive argument +-- fun convert1 : [i : Size] -> CoNat i -> Nat i+-- {+-- convert1 ($ i) (cozero .i) = zero i;+-- convert1 ($ i) (cosucc i x) = succ i (convert1 i x) +-- }++-- the following must be cofun  +cofun convert2 : [i : Size] -> Nat i -> CoNat i+{+convert2 ($ i) (zero .i) = cozero i;+convert2 ($ i) (succ .i x) = cosucc i (convert2 i x) +}++-- NOT ok+{-+fun convert2' : [i : Size] -> Nat i -> CoNat i+{ convert2' i (zero (i > j))   = cozero j+; convert2' i (succ (i > j) x) = cosucc j (convert2' j x)+}+-}++-- also ok+fun convert3 : [i : Size] -> Nat i -> CoNat #+{+convert3 i (zero (i > j)) = cozero #;+convert3 i (succ (i > j) x) = omega' #+}++-- also ok+cofun convert4 : [i : Size] -> Nat i -> CoNat i+{+convert4 ($ i) (zero .i) = cozero ($ i) ;+convert4 ($ i) (succ .i x) = cosucc i (convert4 i x) +}+
+ test/succeed/list.ma view
@@ -0,0 +1,5 @@+data List (A : Set) : Set+{+  nil  : List A ;+  cons : A -> List A -> List A+}
+ test/succeed/logic.ma view
@@ -0,0 +1,72 @@+-- 2012-01-22 parameters gone from constructors++data Id (A : Set) (a : A) : A -> Set +{ refl : Id A a a +}++fun subst : (A : Set) -> (a : A) -> (b : A) -> Id A a b -> +  (P : A -> Set) -> P a -> P b+{ subst A a .a (refl {-.A .a-}) P x = x+}++-- this demonstrates eta expansion at the identity type+let bla :  (A : Set) -> (a : A) -> (p : Id A a a) -> +           (P : A -> Set) -> (x : P a) -> +              Id (P a) x (subst A a a p P x)+        =  \ A -> \ a -> \ p -> \ P -> \ x -> refl -- (P a) x++fun resp : (A : Set) -> (a : A) -> (b : A) -> Id A a b -> +  (C : Set) -> (f : A -> C) -> Id C (f a) (f b)+{ resp A a .a (refl {-.A .a-}) C f = refl -- C (f a)+}+ +-- Needs heterogeneous equality+-- fun resp : (A : Set) -> (a : A) -> (b : A) -> Id A a b -> (P : A -> Set) -> (f : (x : A) -> P x) -> Id (P a) (f a) (f b)+-- { resp A a .a (refl .A .a) P f = refl (P a) (f a)+-- }+ +data True : Set +{ trueI : True+}++data False : Set+{ }++let falseIrr : (p : False) -> (q : False) -> Id False p q+             = \ p  -> \ q -> refl -- False p++fun falseE : False -> (A : Set) -> A+{ }++data And (A : Set) (B : Set) : Set +{ andI : (andE1 : A) -> (andE2 : B) -> And A B+}++data Forall (A : Set) (B : A -> Set) : Set+{ forallI : (forallE : (a : A) -> B a) -> Forall A B+}++fun shapeForallTrue : (A : Set) -> (p : Forall A (\ a -> True)) ->+  Id (Forall A (\ a -> True)) p (forallI {- A (\ a -> True)-} (\ a -> trueI))+{ shapeForallTrue A p = refl -- (Forall A (\ a -> True)) p+}++data Prop (A : Set) : Set+{ true   : Prop A+; false  : Prop A+; and    : Prop A -> Prop A -> Prop A+; forall : (A -> Prop A) -> Prop A+}+ +fun Proof : (A : Set) -> Prop A -> Set+{ Proof A (true) = True+; Proof A (false) = False+; Proof A (and p q) = And (Proof A p) (Proof A q)+; Proof A (forall h) = Forall A (\ a -> Proof A (h a))+}++fun proofIrr : (A : Set) -> (P : Prop A) -> (p : Proof A P) -> (q : Proof A P) -> Id (Proof A P) p q+{ proofIrr A (true) p q = refl -- True p +; proofIrr A (false) p q = refl -- False p +-- ; proofIrr A (and .A P Q) (andI .(Proof A P) .(Proof A Q) p1 p2) (andI .(Proof A P) .(Proof A Q) q1 q2) = (proofIrr A P p1 p2) (proofIrr A Q q1 q2) -- etc pp+}
+ test/succeed/lossyIdentityOnStreams.ma view
@@ -0,0 +1,10 @@+-- 2012-01-22 parameters gone from constructors++sized codata Stream (+ A : Set) : Size -> Set {+  cons : (i : Size) -> A -> Stream A i -> Stream A ($ i)+}++cofun sid : (A : Set) -> (i : Size) -> Stream A ($ i) -> Stream A i+{+  sid A ($ i) (cons .($ i) x xs) = cons _ x (sid A i xs)+}
+ test/succeed/magicVecLookupProofIrr.ma view
@@ -0,0 +1,43 @@+-- proof irrelevance via polymorphism++data Sigma (A : Set) (B : A -> Set) : Set+{ pair : (fst : A) -> (snd : B fst) -> Sigma A B+} fields fst, snd++data Nat : Set+{ zero : Nat+; succ : Nat -> Nat+}++data Empty : Set+{+}++-- magic = abort  does not need the inhabitant p : Empty+fun magic : [A : Set] -> [p : Empty] -> A+{ +}++data Unit : Set+{ unit : Unit+}++fun Vec : (A : Set) -> (n : Nat) -> Set+{ Vec A zero     = Empty+; Vec A (succ n) = Sigma A (\ z -> Vec A n)+}++fun Leq : (n : Nat) -> (m : Nat) -> Set+{ Leq  zero     m        =  Unit+; Leq (succ n)  zero     =  Empty+; Leq (succ n) (succ m)  =  Leq n m+}+let Lt : (n : Nat) -> (m : Nat) -> Set+       = \ n -> \ m -> Leq (succ n) m++fun lookup : [A : Set] -> (n : Nat) -> (m : Nat) -> [Lt m n] -> Vec A n -> A+{ lookup A  zero    m        p v = magic A p+; lookup A (succ n) zero     p v = fst v -- fst A (\ z -> Vec A n) v+; lookup A (succ n) (succ m) p v = lookup A n m p <| snd v -- (snd A (\ z -> Vec A n) v)+}+
+ test/succeed/mapStream.ma view
@@ -0,0 +1,11 @@+-- 2012-01-22 parameters gone from constructors++sized codata Stream (+ A : Set) : Size -> Set {+  cons : (i : Size) -> A -> Stream A i -> Stream A ($ i)+}++cofun map : (A : Set) -> (B : Set) -> (i : Size) -> +            (A -> B) -> Stream A i -> Stream B i +{+  map A B ($ i) f (cons .i x xl) = cons _ (f x) (map A B _ f xl)+}
+ test/succeed/max.ma view
@@ -0,0 +1,27 @@+data Nat : Set +{ zero : Nat+; suc  : Nat -> Nat+}++data Bool : Set+{ true  : Bool+; false : Bool +}++fun leq : Nat -> Nat -> Bool+{ leq zero n = true+; leq (suc m) zero = false+; leq (suc m) (suc n) = leq m n+}++fun maxN : Nat -> Nat -> Nat+{ maxN n m = case leq n m +  { true -> m+  ; false -> n+  }+}++let one : Nat = suc zero+let two : Nat = suc one+eval let cmp : Bool = leq one two+eval let bla : Nat = maxN one two
+ test/succeed/measures.ma view
@@ -0,0 +1,172 @@+-- 2010-03-11 explicit measures+-- inspired by Hongwei Xi, LICS 2001++data Bool : Set+{ true : Bool+; false : Bool+}++sized data Nat : Size -> Set+{ zero : [i : Size] -> Nat ($ i)+; succ : [i : Size] -> Nat i -> Nat ($ i)+}++{- rules++2010-07-16++When checking the patterns ps qs of f++  f : As -> mu -> Bs -> C+  f ps qs = ... g as ...+  +as we reach measure mu in the type, insert it into the context +(reader monad) as the current measure. ++When we reach a mutually defined identifier g of type+  +  g : Delta -> mu' -> D++we use it at type  ++ g : Delta -> mu' < mu -> D++The constraint mu' < mu guarantees that g is only called at smaller instances.++How to implement this?++When checking a mutual block where all identifiers carry a measure+(either all should be measured, or none (then use old termination+check)), we keep the signature of the mutual block around++  g1 : TV1+  ...+  gn : TVn++The types are evaluated.  We want a function+  +  bound :: MeasVal -> TVal -> TVal+  bound mu tv = tv'++such that++  bound mu (Delta -> mu' -> A) = Delta -> mu' < mu -> A++this can done lazyly, pushing the mu past the pi's until it meets the+measure.  If there is no measure, then it just gets propagated to the+end and vanishes.  This way, we can handle call to rec. fun.s outside+of the mutual block which can be used unrestrictedly.++If we have a mu-decoration to values, then we need a view function+which does the pushing in behind the curtains.  This could be+integrated in the whnf and closures.++We do not need to keep "bound-closures" at unevaluated applications,+since we do not treat measures as first-class, the cannot appear+everywhere in a term, only in the types of a mutual fun sig, so they+are just appearing after a telescope.++-- old rules ---------------------------------------------------------++When checking the patterns ps qs of f++  f : As -> mu -> Bs -> C+  f ps qs = ... g as ...+  +as we reach measure mu in the type, insert it into the context +(reader monad) as the current measure. ++When checking the application g as on the rhs, if g is in the set of+mutual functions with f, then during infering the type of g as we will+have its type as++   mu' -> D++at some point.  Then, we simply check whether++  mu' < mu++Yeah!++Typing rules for measures++  |-{mu}  t : A             |-{mu}  t : mu' -> A    mu' < mu+  -------------- mu-Intro   -------------------------------- mu-Elim+  |- t : mu -> A            |-{mu}  t : A+  +After finishing checking the mutual block, purge the measures from the+types of the mutual functions!++For nested functions, generalize the rule to:++  |-{mu}  t : A           +  ------------------- mu-Intro +  |-{mu'} t : mu -> A          +  +With this system, one cannot do lexicographic induction by nested induction.+++Explicit rules for measures ?+                                                        mu subtype mu'+  x : mu |- t : A             x : mu |- t : mu' -> A    mu' < mu+  -------------- mu-Intro     ---------------------------------- mu-Elim+  |- \xt : mu -> A            x : mu |- t x : A+  + -}++mutual {++  fun even  : [i : Size] -> |i,$0| -> Nat i -> Bool+  { even i n = even' i n+  }++  fun even' : [i : Size] -> |i,0|  -> Nat i -> Bool+  { even' i (zero (i > j))   = true+  ; even' i (succ (i > j) n) = odd' j n+  } ++  fun odd'  : [i : Size] -> |i,0|  -> Nat i -> Bool+  { odd' i (zero (i > j))   = false+  ; odd' i (succ (i > j) n) = even j n+  } +}++{-+mutual {++  fun even  : [i : Size] -> |i,$0| -> Nat i -> Bool+  { even i n = even' i n+  }++  fun even' : [i : Size] -> |i,0|  -> Nat i -> Bool+  { even' .($ i) (zero i)   = true+  ; even' .($ i) (succ i n) = odd' i n+  } ++  fun odd'  : [i : Size] -> |i,0|  -> Nat i -> Bool+  { odd' .($ i) (zero i)   = false+  ; odd' .($ i) (succ i n) = even i n+  } +}+-}+++{-+let infty : Size = #+let ssuc : Size -> Size = \ i -> $ i++fun maybeSuc : (b : Bool) -> Size -> Size+{ maybeSuc true i = $ i+; maybeSuc false i = i+}++fun addSize : N -> Size -> Size+{ addSize zz i = i+; addSize (ss n) i = $ (addSize n i)+}++fun addSNat : (n : N) -> (i : Size) -> Nat i -> Nat (addSize n i)+{ addSNat zz     i m = m+; addSNat (ss n) i m = succ (addSize n i) (addSNat n i m) +}+-}
+ test/succeed/msort-implicit.ma view
@@ -0,0 +1,105 @@+-- erased arguments+-- in the spirit of the implicit CC+-- we only specify the erasure in the types+-- 2012-01-22 parameters gone from constructors++-- booleans++data Bool : Set +{+  tt : Bool;+  ff : Bool+}++fun ifthenelse : [A : Set] -> Bool -> A -> A -> A+{+  ifthenelse A tt x y = x;+  ifthenelse A ff x y = y+}++-- homogeneous pairs++data Pair (+ A : Set) : Set +{+  pair : A -> A -> Pair A +}+-- this yields+--+--   pair : [A : Set] -> A -> A -> Pair A+--+-- parameter arguments to constructors are always implicit++fun pr1 : [A : Set] -> Pair A -> A+{+  pr1 A (pair a b) = a+}++fun pr2 : [A : Set] -> Pair A -> A+{+  pr2 A (pair a b) = b+}++-- sized Lists++sized data SList (+ A : Set) : Size -> Set +{+  nil  : [i : Size] -> SList A ($ i) ;+  cons : [i : Size] -> A -> SList A i -> SList A ($ i)+}++-- merge sort++fun split : [A : Set] -> +            [i : Size] -> SList A i -> Pair (SList A i)+{+split A .($ i)     (nil i)                    +  = pair (nil _) (nil _);++split A .($ ($ i)) (cons .($ i) a (nil i))+  = pair (cons _ a (nil _)) (nil _);++split A .($ ($ i)) (cons .($ i) a (cons i b as))  +  =  let rec : Pair (SList A i) = split A _ as+  in let l1 : SList A _ = pr1 (SList A _) rec+  in let l2 : SList A _ = pr2 (SList A _) rec+  in pair (cons _ a l1) (cons _ b l2)+}++fun merge : [A : Set] -> (leq : A -> A -> Bool) +            -> SList A # -> SList A # -> SList A #+{+merge A leq (nil .#) ys = ys;+merge A leq (cons .# x xs) (nil .#) = cons _ x xs;+merge A leq (cons .# x xs) (cons .# y ys) = ifthenelse (SList A _)+	(leq x y) (cons _ x (cons _ y (merge A leq xs ys)))+		  (cons _ y (cons _ x (merge A leq xs ys)))+}++fun msort : [A : Set] -> (leq : A -> A -> Bool) ->+            [i : Size] -> SList A i -> SList A #+{+  msort A leq .($ j) (nil j) = nil _ ;+  msort A leq .($ ($ i)) (cons .($ i) a (nil i)) = +     cons _ a (nil _) ;+  msort A leq .($ ($ i)) (cons .($ i) a (cons i b l)) =+        let sl : Pair (SList A _) = split A _ l      +     in let l1 : SList A # = msort A leq _ (cons _ a (pr1 (SList A _) sl))+     in let l2 : SList A # = msort A leq _ (cons _ b (pr2 (SList A _) sl))+     in merge A leq l1 l2+}+++fun msort' : [A : Set] -> (leq : A -> A -> Bool) ->+             ([i : Size] -> SList A i -> Pair (SList A i)) ->+             [i : Size] -> SList A i -> SList A #+{+  msort' A leq splt .($ j) (nil j) = nil _ ;+  msort' A leq splt .($ ($ i)) (cons .($ i) a (nil i)) = +     cons _ a (nil _) ;+  msort' A leq splt .($ ($ i)) (cons .($ i) a (cons i b l)) =+        let sl : Pair (SList A _) = splt _ l      +     in let l1 : SList A # = msort' A leq splt _ (cons _ a (pr1 (SList A _) sl))+     in let l2 : SList A # = msort' A leq splt _ (cons _ b (pr2 (SList A _) sl))+     in merge A leq l1 l2+}+
+ test/succeed/msort.ma view
@@ -0,0 +1,97 @@+-- 2012-01-22 parameters gone from constructors++-- booleans++data Bool : Set +{+  tt : Bool;+  ff : Bool+}++fun ifthenelse : (A : Set) -> Bool -> A -> A -> A+{+  ifthenelse A tt x y = x;+  ifthenelse A ff x y = y+}++-- homogeneous pairs++data Pair (+ A : Set) : Set +{+  pair : A -> A -> Pair A +}++fun pr1 : (A : Set) -> Pair A -> A+{+  pr1 A (pair a b) = a+}++fun pr2 : (A : Set) -> Pair A -> A+{+  pr2 A (pair a b) = b+}++-- sized Lists++sized data SList (+ A : Set) : Size -> Set +{+  nil  : (i : Size) -> SList A ($ i) ;+  cons : (i : Size) -> A -> SList A i -> SList A ($ i)+}++-- merge sort++fun split : (A : Set) -> +            (i : Size) -> SList A i -> Pair (SList A i)+{+split A .($ i)     (nil i)                    +  = pair (nil _) (nil _);++split A .($ ($ i)) (cons .($ i) a (nil i))+  = pair (cons _ a (nil _)) (nil _);++split A .($ ($ i)) (cons .($ i) a (cons i b as))  +  =  let rec : Pair (SList A i) = split A _ as+  in let l1 : SList A _ = pr1 (SList A _) rec+  in let l2 : SList A _ = pr2 (SList A _) rec+  in pair (cons _ a l1) (cons _ b l2)+}++fun merge : (A : Set) -> (leq : A -> A -> Bool) +            -> SList A # -> SList A # -> SList A #+{+merge A leq (nil .#) ys = ys;+merge A leq (cons .# x xs) (nil .#) = cons _ x xs;+merge A leq (cons .# x xs) (cons .# y ys) = ifthenelse (SList A _)+	(leq x y) (cons _ x (cons _ y (merge A leq xs ys)))+		  (cons _ y (cons _ x (merge A leq xs ys)))+}++fun msort : (A : Set) -> (leq : A -> A -> Bool) ->+            (i : Size) -> SList A i -> SList A #+{+  msort A leq .($ j) (nil j) = nil _ ;+  msort A leq .($ ($ i)) (cons .($ i) a (nil i)) = +     cons _ a (nil _) ;+  msort A leq .($ ($ i)) (cons .($ i) a (cons i b l)) =+        let sl : Pair (SList A _) = split A _ l      +     in let l1 : SList A # = msort A leq _ (cons _ a (pr1 (SList A _) sl))+     in let l2 : SList A # = msort A leq _ (cons _ b (pr2 (SList A _) sl))+     in merge A leq l1 l2+}+++fun msort' : (A : Set) -> (leq : A -> A -> Bool) ->+             ((i : Size) -> SList A i -> Pair (SList A i)) ->+             (i : Size) -> SList A i -> SList A #+{+  msort' A leq splt .($ j) (nil j) = nil _ ;+  msort' A leq splt .($ ($ i)) (cons .($ i) a (nil i)) = +     cons _ a (nil _) ;+  msort' A leq splt .($ ($ i)) (cons .($ i) a (cons i b l)) =+        let sl : Pair (SList A _) = splt _ l      +     in let l1 : SList A # = msort' A leq splt _ (cons _ a (pr1 (SList A _) sl))+     in let l2 : SList A # = msort' A leq splt _ (cons _ b (pr2 (SList A _) sl))+     in merge A leq l1 l2+}+
+ test/succeed/nat.ma view
@@ -0,0 +1,53 @@+-- Mugda (Karl Mehltretter's master thesis)+-- sized natural numbers++sized data SNat : Size -> Set+{+zero : [i : Size] -> SNat ($ i);+succ : [i : Size] -> SNat i -> SNat ($ i)+}++fun add : SNat # -> SNat # -> SNat #+{+add (zero .#)   y = y; +add (succ .# x) y = succ # (add x y) +}++fun inc : (i : Size) -> (j : Size) -> SNat i -> SNat ($ i)+{+inc i j x = succ _ x;+}++fun minus : [i : Size] -> SNat i -> SNat # -> SNat i+{ minus i (zero (i > j))   y           = zero j+; minus i       x          (zero .#)   = x+; minus i (succ (i > j) x) (succ .# y) = minus j x y    -- subtyping j < i+}++eval let test : SNat # = +  minus # (succ # (succ # (zero #))) (succ # (zero #))++-- div n m = floor(n/(m+1)) +fun div : [i : Size] -> SNat i -> SNat # -> SNat i+{ div i (zero (i > j))   y = zero j +; div i (succ (i > j) x) y = succ j (div j (minus j x y) y)+}++data Bool : Set+{+  tt : Bool;+  ff : Bool+}++fun true : [i : Size] -> SNat i -> Bool+{+true .($ i) (zero i) = tt;+true .($ i) (succ i x) = true _ x+}++-- ok size variable is a valid pattern++fun ok : Size -> Bool+{+  ok i = tt+}
+ test/succeed/non-record.ma view
@@ -0,0 +1,4 @@+data NotARecord (A : Set) (B : Set) : Set+{+  pair : (fst : A) -> B -> NotARecord A B+}
+ test/succeed/old_stream.ma view
@@ -0,0 +1,223 @@+-- 2012-01-22 parameters gone from constructors++-- Booleans ----------------------------------------------------------++data Bool : Set +{ tt : Bool+; ff : Bool+}++fun ifthenelse : Bool -> (A : Set) -> A -> A -> A+{ ifthenelse tt A a1 a2 = a1+; ifthenelse ff A a1 a2 = a2+}++-- Nat ---------------------------------------------------------------++data Nat : Set +{ zero : Nat+; succ : Nat -> Nat +}++fun add : Nat -> Nat -> Nat +{ add zero     = \ y -> y+; add (succ x) = \ y -> succ (add x y)+}++fun leq : Nat -> Nat -> Bool+{ leq  zero     y       = tt+; leq (succ x)  zero    = ff +; leq (succ x) (succ y) = leq x y +}++-- Stream ------------------------------------------------------------++sized codata Stream (+ A : Set) : Size -> Set +{ cons : (i : Size) -> A -> Stream A i -> Stream A ($ i)+}+ +fun tail : (A : Set) -> (i : Size) -> Stream A ($ i) -> Stream A i+{ tail A i (cons .i x xs) = xs+}++fun head : (A : Set) -> (i : Size) -> Stream A ($ i) -> A +{ head A i (cons .i x xs) = x+}++fun nth : Nat -> Stream Nat # -> Nat +{ nth zero xs     = head Nat # xs+; nth (succ x) xs = nth x (tail Nat # xs) +}++-- map, zip, merge ---------------------------------------------------++cofun map : (A : Set) -> (B : Set) -> (i : Size) -> +            (A -> B) -> Stream A i -> Stream B i +{+map A B ($ i) f (cons .i x xl) = cons _ (f x) (map A B _ f xl)+}++cofun zipWith : (A : Set) -> (B : Set) -> (C : Set) ->+                (A -> B -> C) -> (i : Size) ->+		Stream A i -> Stream B i -> Stream C i +{+  zipWith A B C f ($ i) (cons .i a as) (cons .i b bs) = +	cons i (f a b)  (zipWith A B C f i as bs) +}++cofun merge : (i : Size) -> (Nat -> Nat -> Bool) -> +              Stream Nat i -> Stream Nat i -> Stream Nat i+{+merge ($ i) le (cons .i x xs) (cons .i y ys) = +      ifthenelse (le x y) (Stream Nat _)+         (cons _ x (merge _ le xs (cons _ y ys)))+	 (cons _ y (merge _ le (cons _ x xs) ys))     +}++{-+cofun merge : (i : Size) -> (Nat -> Nat -> Bool) -> +              Stream Nat i -> Stream Nat i -> Stream Nat i+{+merge .($ i) le (cons .i x xs) (cons i y ys) = +      ifthenelse (le x y) (Stream Nat _)+         (cons _ x (merge _ le xs (cons _ y ys)))+	 (cons _ y (merge _ le (cons _ x xs) ys))     +}+-}++-- Hamming function --------------------------------------------------++let one   : Nat = succ zero+let two   : Nat = succ one+let three : Nat = succ two+let four  : Nat = succ three+let five  : Nat = succ four++let double : Nat -> Nat+           = \ n -> add n n+let triple : Nat -> Nat+           = \ n -> add n (double n)++cofun ham : (i : Size) -> Stream Nat i+{+  ham ($ i) = cons _ one (merge i leq (map Nat Nat i double (ham i)) +                                    (map Nat Nat i triple (ham i)))+}+++{-+-- THIS SHOULD NOT TYPECHECK!!+cofun map2 : (i : Size) -> (Nat -> Nat) -> Stream Nat i -> Stream Nat i +{+map2 .($ ($ i)) f (cons .Nat .($ i) u (cons .Nat i x xl)) = +  cons _ (f u) (cons _ (f x) (map2 _ f xl))+}++cofun ham2 : (i : Size) -> Stream Nat i+{+  ham2 ($ i) = cons _ one (merge i leq (map2 i double (ham2 i)) +                                     (map2 i triple (ham2 i)))+}++-- THIS LOOPS!!!+eval let bla : Nat = nth one (ham2 #)+-}++-- Fibonacci stream --------------------------------------------------++{- NOT YET IMPLEMENTED: rational sizes+   WILL NOT IMPLEMENT -- see fibDeep.ma++cofun fib : (i : Size) -> Stream Nat (i + i)+{+  fib (i + 1) = cons _ zero (cons _ one (zipWith Nat Nat Nat add+    i (fib i) (tail Nat i (fib (i + 1/2)))))+}++-}++{- distinguish fib from the following++cofun bad : [i : Size] -> Stream Nat i+{+  bad ($ ($ i)) = cons _ zero (tail Nat _ (bad ($ i)))+}++-}++cofun fib : (i : Size) -> Stream Nat i+{+  fib ($ i) = cons _ zero (zipWith Nat Nat Nat add i +    (cons _ one (fib i)) (fib i))+}++++cofun fibIter' : (x : Nat ) -> (y : Nat ) -> (i : Size) -> Stream Nat i +{+  fibIter' x y ($ i) = cons _ x (fibIter' y (add x y) _)+} +let fibIter : Stream Nat # = (fibIter' one one _)+++--------------------------------------------++-- fibIter(4) = 5 +eval let fibIter4 : Nat = nth four fibIter ++eval let fib1 : Nat = nth one   (fib #)+eval let fib2 : Nat = nth two   (fib #)+eval let fib3 : Nat = nth three (fib #)+eval let fib4 : Nat = nth four  (fib #)+eval let fib5 : Nat = nth five  (fib #)+++--------------------------------------------++data Leq : Nat -> Nat -> Set+{+lqz : (x : Nat ) -> Leq zero x ;+lqs : (x : Nat ) -> (y : Nat ) -> Leq x y -> Leq (succ x) (succ y)+}++sized codata Increasing : Size -> Stream Nat # -> Set+{+inc : (i : Size) -> (x : Nat) -> (y : Nat) -> Leq x y -> (tl : Stream Nat #) -> +      Increasing i (cons # y tl) ->+      Increasing ($ i) (cons # x (cons # y tl)) +}+++data Eq (+ A : Set ) : A -> A -> Set+{+refl : (a : A) -> Eq A a a+}++let proof : Eq (Stream Nat #) (tail Nat # fibIter) (tail Nat # fibIter) = refl (tail Nat # fibIter)+++let succ_ : Nat -> Nat = \ x -> succ x++cofun evil : (i : Size ) -> Stream Nat i+{+evil ($ i) = map Nat Nat _ succ_ (cons _ zero (evil _))+}++-- eval const zzz : Nat = head # (z #) ++++-- convolution (Shin-Cheng Mu)++let cons_ : [A : Set] -> [i : Size] -> A -> Stream A i -> Stream A $i+   = \ A i a as -> cons i a as+ +cofun dmerge : (A : Set) -> (i : Size) -> Stream (Stream A i) i -> Stream A i+{+dmerge A ($ i) (cons .i ys yss) = +  cons i (head A _ ys) (dmerge A i+    (zipWith A (Stream A _) (Stream A _) (cons_ A _) i +            (tail A _ ys) yss))+}++
+ test/succeed/oldnat.ma view
@@ -0,0 +1,55 @@+-- Mugda (Karl Mehltretter's master thesis)+-- sized natural numbers++sized data SNat : Size -> Set+{+zero : [i : Size] -> SNat ($ i);+succ : [i : Size] -> SNat i -> SNat ($ i)+}++fun add : SNat # -> SNat # -> SNat #+{+add (zero .#)   y = y; +add (succ .# x) y = succ # (add x y) +}++fun inc : (i : Size) -> (j : Size) -> SNat i -> SNat ($ i)+{+inc i j x = succ _ x;+}++fun minus : [i : Size] -> SNat i -> SNat # -> SNat i+{+minus .($ i) (zero i)   y           = zero _;+minus i      x          (zero .#)   = x;+minus .($ i) (succ i x) (succ .# y) = minus _ x y    -- subtyping i < ($ i)+}++eval let test : SNat # = +  minus # (succ # (succ # (zero #))) (succ # (zero #))++-- div n m = floor(n/(m+1)) +fun div : [i : Size] -> SNat i -> SNat # -> SNat i+{+div .($ i) (zero i)   y = zero _ ;+div .($ i) (succ i x) y = succ _ (div _ (minus _ x y) y)+}++data Bool : Set+{+  tt : Bool;+  ff : Bool+}++fun true : [i : Size] -> SNat i -> Bool+{+true .($ i) (zero i) = tt;+true .($ i) (succ i x) = true _ x+}++-- ok size variable is a valid pattern++fun ok : Size -> Bool+{+  ok i = tt+}
+ test/succeed/omegaInst1.ma view
@@ -0,0 +1,28 @@+-- 2012-02-06  Make sure not to violate < - Constraints by going through infty+-- (not finished)++fun fix : [F : Size -> Set]+          (phi : [i <= #] (f : [j < i] -> F j) -> F i)+          [i <= #] -> |i| -> F i+{ fix F phi i = phi i (fix F phi)+}++cofun Bot : +(i : Size) -> Set+{ Bot i = [j < i] & Bot j+}++cofun Top : -(i : Size) -> Set+{ Top i = [j < i] -> Top j+}++fun out : [i : Size] (r :  Top $i) -> Top i+{ out i r j = r $j j }++let inn [i : Size] (t : Top i) : Top $i+  = \ j -> t++let bad [F : Size -> Set] [i <= #] (f : [j < $i] -> F j) : F i+  = f i++fail+let test [F : Size -> Set] = fix F (bad F)
+ test/succeed/omegaInstTailInfty.ma view
@@ -0,0 +1,106 @@+{- 2013-03-31 On instantiation of quantifiers [i < #] - F i++If F is upper semi-continuous then++  [i < #] -> F i   is a sub"set" of   F #++so we can instantiate i to #.  (Hughes et al., POPL 96; Abel, LMCS 08)++1) Consider the special case++  F i = [j < i] -> G i++If G is antitone we have a decreasing chain++  G 0 >= G 1 >= ...++Since all chains are shorter than #, we have a "fixpoint" G gamma+for some gamma < #.++  F # = [j < #] -> G j = G gamma++  [i < #] -> F i+      = [i < #] -> [j < i] -> G j  (since # is a limit)+      = [j < #] -> G j = G gamma++Anyway, G does not have to have special properties, it is sufficient+that # is a limit, because++  i < #  iff  i + 1 < #++so++  j < i < #  iff j < #++2) Consider the special case++  F i = [j <= i] -> G j++We have++  F # = [j <= #] -> G j+      = G # /\ ([j < #] -> G j)++  [i < #] -> F i+      = [i < #] -> [j <= i] -> G j+      = [j < #] -> G j++So if G is upper semi-continuous, so is F.++-}++cofun Inf : (F : Size -> Set) -(i : Size) -> Set+{ Inf F i = [j < i] -> F j }++-- uses that  [j < i] -> F j  is upper semi-continuous in i+fun uppersemi : [F : Size -> Set] (f : Inf (Inf F) #) -> Inf F #+{ uppersemi F f j  = f # j }+{-+   have f   : [i < #] -> [j < i] -> F j+   show f # : [j < #] -> F j++-}++data Stream +(A : Set) -(i : Size)+{ scons (shead : [j < i] -> A) (stail : [j < i] -> Stream A j)+} fields shead, stail++check+cofun repeat : [A : Set] (a : A) [i : Size] |i| -> Stream A i+{ repeat A a ($ i) = scons (\ j -> a) (\ j -> repeat A a j)+}++check+let tailInf [A : Set] (s : Stream A #) : Stream A #+  = s .stail #+++-- front streams++data Front +(A : Set) -(i : Size)+{ cons (head : A) (tail : [j < i] -> Front A j)+} fields head, tail++fun eta : [F : Size -> Set] [i : Size] (f : [j < i] -> F j) [j < i] -> F j+{ eta F i f j = f j }++fun repeat : [A : Set] (a : A) [i : Size] |i| -> Front A i+{ repeat A a i = cons a (repeat A a)+  -- Or:+; repeat A a i = cons a (eta (Front A) i (repeat A a))+}++let tailInf [A : Set] (s : Front A #) : Front A #+  = s .tail #+++-- semicontinuity can be used to instantiate quantifiers+-- related to bound normalization++trustme -- only if F upper semi-continuous+let uppersemicont [F : Size -> Set] (f : [i < #] -> F i) : F #+  = f #++trustme --only if F lower semi-continuous+let lowersemicont [F : Size -> Set] (a : F #) : [i < #] & F i+  = (#, a)
+ test/succeed/pred.ma view
@@ -0,0 +1,19 @@+sized data SNat : Size -> Set+{ zero : [i : Size] -> SNat ($ i)+; succ : [i : Size] -> SNat i -> SNat ($ i)+}++data MaybeNat (i : Size) : Set+{ nothing : MaybeNat i+; just    : SNat i -> MaybeNat i+}++fun pred' : [i : Size] -> SNat ($ i) -> MaybeNat i+{ pred' i (succ .i n) = just n+; pred' i (zero .i)   = nothing+}++fun pred : (i : Size) -> SNat ($$ i) -> SNat ($ i)+{ pred i (succ .($ i) n) = n+; pred i (zero .($ i))   = zero i+}
+ test/succeed/qsapp.ma view
@@ -0,0 +1,80 @@+-- 2010-06-21 Andreas Abel  +-- Quicksort (implementation using partition) in MiniAgda++-- Booleans++data Bool : Set+{ true : Bool+; false : Bool+}++fun if : [A : Set] -> Bool -> A -> A -> A+{ if A true  t e = t+; if A false t e = e+}++-- Natural numbers++data Nat : Set+{ zero : Nat+; succ : Nat -> Nat+}++fun leq : Nat -> Nat -> Bool +{ leq  zero     n       = true+; leq (succ m)  zero    = false+; leq (succ m) (succ n) = leq m n+}++-- Lists over natural numbers as a sized inductive type++sized data List : Size -> Set+{ nil  : [i : Size] -> List ($ i) +; cons : [i : Size] -> Nat -> List i -> List ($ i)+}++-- Partition a list, continuation-style+-- the lists passed to the continuation k are at most as big as the input list++fun partition : (Nat -> Bool) -> [i : Size] -> List i -> +  [A : Set] -> (List i -> List i -> A) -> A+{ partition p i (nil  (i > j))     A k = k (nil j) (nil j)+; partition p i (cons (i > j) n l) A k = if A (p n)+   (partition p j l A (\ l1 -> \ l2 -> k (cons j n l1) l2)) -- then +   (partition p j l A (\ l1 -> \ l2 -> k l1 (cons j n l2))) -- else+}++-- Quicksort-append+-- qsapp i l1 l2 = append (sort l1) l2++fun qsapp : [i : Size] -> List i -> List # -> List #+{ qsapp i (nil (i > j))      acc = acc+; qsapp i (cons (i > j) n l) acc = partition (\ m -> leq m n) j l (List #)+    (\ l1 -> \ l2 -> qsapp j l1 (cons # n (qsapp j l2 acc)))+}++-- Quicksort ++let quicksort : List # -> List # = \ l -> qsapp # l (nil #)++-- Testing++let n0 : Nat = zero+let n1 : Nat = succ n0+let n2 : Nat = succ n1+let n3 : Nat = succ n2+let n4 : Nat = succ n3+let n5 : Nat = succ n4+let n6 : Nat = succ n5+let n7 : Nat = succ n6+let n8 : Nat = succ n7+let n9 : Nat = succ n8++-- qsapp is fast enough even with MiniAgda CBN+let l : List # = +  (cons # n4 (cons # n9 (cons # n1 (cons # n7 (cons # n6 +  (cons # n4 (cons # n0 (cons # n0 +  (cons # n3 (cons # n3 (cons # n3 (cons # n2 (cons # n3 (nil #))))))))))))))+-- eval  -- 2012-02-25 NO LONGER +let l' : List # = quicksort l+
+ test/succeed/quicksort-filter-fragment.ma view
@@ -0,0 +1,36 @@+data Bool : Set+{ true : Bool+; false : Bool+}++data Nat : Set+{ zero : Nat+; succ : Nat -> Nat+}++fun leq : Nat -> Nat -> Bool {}++fun plus : [A : Set] -> A -> A -> A {}++sized data List : Size -> Set+{ nil  : [i : Size] -> List ($ i) +; cons : [i : Size] -> Nat -> List i -> List ($ i)+}++fun filter : [i : Size] -> List i -> List i+{ filter .($ i) (nil i) = nil i+; filter .($ i) (cons i n l) = plus (List ($ i)) (filter _ l) (cons _ n (filter _ l))+}++fun quicksort : [i : Size] -> List i -> List #+{ quicksort .($ i) (nil i) = nil _+; quicksort .($ i) (cons i n l) = +    plus (List #) (quicksort _ (filter i l)) (cons _ n (quicksort _ (filter i l))) +}++data Id (A : Set)(a : A) : A -> Set+{ refl : Id A a a+}++let p1 : (i : Size) -> Id (List #) (nil i) (nil #)+       = \ i -> refl -- (List #) (nil i)
+ test/succeed/quicksort-filter.ma view
@@ -0,0 +1,82 @@+-- 2010-06-21 Andreas Abel  +-- Quicksort (naive implementation using filter) in MiniAgda++-- Booleans++data Bool : Set+{ true : Bool+; false : Bool+}++fun if : [A : Set] -> Bool -> A -> A -> A+{ if A true  t e = t+; if A false t e = e+}++-- Natural numbers++data Nat : Set+{ zero : Nat+; succ : Nat -> Nat+}++fun leq : Nat -> Nat -> Bool +{ leq  zero     n       = true+; leq (succ m)  zero    = false+; leq (succ m) (succ n) = leq m n+}++-- Lists over natural numbers as a sized inductive type++sized data List : Size -> Set+{ nil  : [i : Size] -> List ($ i) +; cons : [i : Size] -> Nat -> List i -> List ($ i)+}++-- Append lists (yields no size information)++fun append : List # -> List # -> List #+{ append (nil .#)       l = l+; append (cons .# x xs) l = cons # x (append xs l)+}++-- Filter a list (the output list is as most as long as the input list)++fun filter : (Nat -> Bool) -> [i : Size] -> List i -> List i+{ filter p i (nil  (i > j))     = nil j+; filter p i (cons (i > j) n l) = if (List ($ j)) (p n)+   (cons j n (filter p j l)) -- then+   (filter p j l)            -- else+}++-- Quicksort ++fun quicksort : [i : Size] -> List i -> List #+{ quicksort i (nil (i > j))      = nil j+; quicksort i (cons (i > j) n l) = +      append (quicksort j (filter (\ m -> leq m n) j l)) +    (cons # n (quicksort j (filter (leq (succ n)) j l))) +}++-- Testing++let n0 : Nat = zero+let n1 : Nat = succ n0+let n2 : Nat = succ n1+let n3 : Nat = succ n2+let n4 : Nat = succ n3+let n5 : Nat = succ n4+let n6 : Nat = succ n5+let n7 : Nat = succ n6+let n8 : Nat = succ n7+let n9 : Nat = succ n8++{- MiniAgda CBN is too inefficient to do this in reasonable time+let l : List # = +  (cons # 4 (cons # 9 (cons # 1 (cons # 7 (cons # 6 +  (cons # 4 (cons # 0 (cons # 0 +  (cons # 3 (cons # 3 (cons # 3 (cons # 2 (cons # 3 (nil #))))))))))))))+-}+let l : List # = cons # n1 (cons # n3 (cons # n0 (cons # n2 (nil #))))+eval let l' : List # = quicksort # l+
+ test/succeed/quicksort.ma view
@@ -0,0 +1,82 @@+-- 2010-06-21 Andreas Abel  +-- Quicksort (implementation using partition) in MiniAgda+-- more efficient implementation see qsapp.ma++-- Booleans++data Bool : Set+{ true : Bool+; false : Bool+}++fun if : [A : Set] -> Bool -> A -> A -> A+{ if A true  t e = t+; if A false t e = e+}++-- Natural numbers++data Nat : Set+{ zero : Nat+; succ : Nat -> Nat+}++fun leq : Nat -> Nat -> Bool +{ leq  zero     n       = true+; leq (succ m)  zero    = false+; leq (succ m) (succ n) = leq m n+}++-- Lists over natural numbers as a sized inductive type++sized data List : Size -> Set+{ nil  : [i : Size] -> List ($ i) +; cons : [i : Size] -> Nat -> List i -> List ($ i)+}++-- Append lists (yields no size information)++fun append : List # -> List # -> List #+{ append (nil .#)       l = l+; append (cons .# x xs) l = cons # x (append xs l)+}++-- Partition a list, continuation-style++fun partition : (Nat -> Bool) -> [i : Size] -> List i -> +  [A : Set] -> (List i -> List i -> A) -> A+{ partition p i (nil  (i > j))     A k = k (nil j) (nil j)+; partition p i (cons (i > j) n l) A k = if A (p n)+   (partition p j l A (\ l1 -> \ l2 -> k (cons j n l1) l2)) -- then +   (partition p j l A (\ l1 -> \ l2 -> k l1 (cons j n l2))) -- else+}++-- Quicksort ++fun quicksort : [i : Size] -> List i -> List #+{ quicksort i (nil  (i > j))     = nil j+; quicksort i (cons (i > j) n l) = partition (\ m -> leq m n) j l (List #)+    (\ l1 -> \ l2 -> append (quicksort j l1) (cons # n (quicksort j l2)))+}++-- Testing++let n0 : Nat = zero+let n1 : Nat = succ n0+let n2 : Nat = succ n1+let n3 : Nat = succ n2+let n4 : Nat = succ n3+let n5 : Nat = succ n4+let n6 : Nat = succ n5+let n7 : Nat = succ n6+let n8 : Nat = succ n7+let n9 : Nat = succ n8++{- MiniAgda CBN is too inefficient to do this in reasonable time+let l : List # = +  (cons # 4 (cons # 9 (cons # 1 (cons # 7 (cons # 6 +  (cons # 4 (cons # 0 (cons # 0 +  (cons # 3 (cons # 3 (cons # 3 (cons # 2 (cons # 3 (nil #))))))))))))))+-}+let l : List # = cons # n1 (cons # n3 (cons # n0 (cons # n2 (nil #))))+eval let l' : List # = quicksort # l
+ test/succeed/rank2SizeQuantStream.ma view
@@ -0,0 +1,13 @@++sized codata Stream (+ A : Set) : Size -> Set {+  cons : (i : Size) -> A -> Stream A i -> Stream A ($ i)+}++data Unit : Set {+  triv : Unit+}+ +cofun bla : (i : Size) -> ((j : Size) -> Stream Unit j -> Stream Unit j) -> Stream Unit i+{+ bla ($ i) f = f ($ i) (cons i triv (bla i f)) +}
+ test/succeed/record.ma view
@@ -0,0 +1,33 @@+-- a non-dependent record++data Pair (A : Set) (B : Set) : Set+{+  pair : (fst : A) -> (snd : B) -> Pair A B+}+fields fst, snd++fun swap : (A : Set) -> Pair A A -> Pair A A+{+  swap A p = pair (snd p) (fst p)+}++-- eta law+-- p = pair (fst p) (snd p) : Pair A B++-- a record with dependent destructors++data Sigma (A : Set) (B : A -> Set) : Set+{+  pair' : (fst' : A) -> (snd' : B fst') -> Sigma A B+}+fields fst', snd'++{- destructors++fst' : (A : Set) -> (B : A -> Set) -> (p : Sigma A B) -> A+snd' : (A : Set) -> (B : A -> Set) -> (p : Sigma A B) -> B (fst p)++-- eta law+-- p = pair' (fst' p) (snd' p) : Sigma A B++-}
+ test/succeed/shadowDataParam.ma view
@@ -0,0 +1,19 @@+-- 2010-08-31 shadowing test++-- no complaint here, because constructor name introduced after checking its sig+data D (name : Set) : Set +{ name : D name+} ++-- usage fine+fun id : [A : Set] -> D A -> D A+{ id A (name) = name+}++-- but complaint here, because constructor name in scope+-- 2010-10-01 this is now fine!+data E (name : Set) : Set+{ e : E name+}++-- a bit weird, still...
+ test/succeed/sigma.ma view
@@ -0,0 +1,49 @@+data Sigma ++(A : Set) ++(B : A -> Set) : Set+{ pair : (fst : A) -> (snd : B fst) -> Sigma A B+}+fields fst, snd++-- Destructors generated:+--+-- fun fst : [A : Set] -> [B : A -> Set] -> (p : Sigma A B) -> A+-- { fst A B (pair .A .B a b) = a }+-- fun snd : [A : Set] -> [B : A -> Set] -> (p : Sigma A B) -> B (fst A B p)+-- { snd A B (pair .A .B a b) = b }++-- infinite trees+codata IT : Set+{ it : Sigma IT (\ x -> IT) -> IT+}+++data Id ++(A : Set)(a : A) : A -> Set+{ refl : Id A a a+}++-- eta equality for neutral terms+let etaSigma : (A : Set) -> (B : A -> Set) -> (p : Sigma A B) -> +               Id (Sigma A B) p (pair (fst p) (snd p))+             = \ A -> \ B -> \ p -> refl -- (Sigma A B) p+data Bool : Set+{ true : Bool+; false : Bool+}++let Bool2 : Set +          =  Sigma Bool (\ b -> Bool)+let pair2 : Bool -> Bool -> Bool2+          = \ b1 b2 -> pair {- Bool (\ b -> Bool)-} b1 b2+let fst2  : Bool2 -> Bool+          = fst -- Bool (\ b -> Bool)+let snd2  : Bool2 -> Bool+          = snd -- Bool (\ b -> Bool)++fun bla : Bool -> Bool2+{ bla true  = pair2 true false+; bla false = pair2 false false+}+++-- eta equality for arbitrary terms+let etaBool2 : (b : Bool) -> Id Bool2 (bla b) (pair2 (fst2 (bla b)) (snd2 (bla b)))+             = \ b -> refl -- Bool2 (bla b)
+ test/succeed/simple_nat.ma view
@@ -0,0 +1,10 @@+data Nat : Set +{ zero : Nat+; suc  : Nat -> Nat+}++fun add : Nat -> Nat -> Nat +{ add zero x = x +; add (suc y) x = suc (add y x)+}+
+ test/succeed/singleton.ma view
@@ -0,0 +1,89 @@+-- 2009-11-29  A few examples about singleton types++let id : (A : Set) -> (x : A) -> <x : A>+       = \ A -> \ x -> x++data Nat : Set +{ zero : Nat+; succ : Nat -> Nat+}++let zero' +    : <zero : Nat>+    = zero++let succ'+    : (x : Nat) -> <succ x : Nat>+    = \ x -> succ x++fun pred : [x : Nat] -> <succ x : Nat> -> <x : Nat>+{ pred .x (succ x) = x+} ++-- the recursive constant zero function+fun kzero : (x : Nat) -> <zero : Nat>+{ kzero zero     = zero+; kzero (succ x) = kzero x +}+-- eta-expansion turns this into the non-recursive+--   kzero x = zero ++data IsZero : Nat -> Set+{ isZero : IsZero zero+} ++let p : (x : Nat) -> IsZero (kzero x)+      = \ x -> isZero+{- Checking works as follows:+  ? x : Nat |- isZero : IsZero (kzero x)+  ? IsZero zero <= IsZero (kzero x)+  ? zero = kzero x : Nat+  . zero = zero : Nat+-}+++fun pzero : (<zero : Nat> -> Nat) -> Nat -> <zero : Nat>+{ pzero f zero     = zero+; pzero f (succ x) = kzero (f (pzero f x)) +}+{- type checking the second clause succees with bidirectional t.c.+   Gamma = f : <zero> -> Nat+           pzero f : Nat -> <zero>+           x : Nat++   ? Gamma |- f (pzero f x) : Nat+   ? Gamma |- pzero f x : <zero>+ -}++fun qzero : ((n : Nat) -> IsZero n -> Nat) -> Nat -> <zero : Nat>+{ qzero f zero     = zero+; qzero f (succ x) = kzero (f (qzero f x) isZero) +}+{- type checking the second clause FAILS with bidirectional t.c.+   Gamma = f       : (n : Nat) -> IsZero n -> Nat+           qzero f : Nat -> <zero>+           x       : Nat++   ? Gamma |- f (qzero f x) isZero : Nat+     ?1 Gamma |- qzero f x : Nat+     ?2 Gamma |- isZero : IsZero (qzero f x) ++  Here we fail, since we just substituted the value (qzero f x) for n.+  The information qzero f x = 0 is lost.++One solution here world be to use the eta-expanded form of qzero also+when checking the body of qzero.  -}++-- simplified example++data Unit  : Set { unit : Unit }+data Empty : Set {}++fun Zero : (n : Nat) -> Set+{ Zero zero = Unit+; Zero (succ x) = Empty+}++let bla : ((n : Nat) -> Zero n -> Nat) -> (Nat -> <zero : Nat>) -> Nat -> Nat+        = \ f -> \ g -> \ x -> f (g x) unit+-- THIS DOES NOT DO the job, since g x is eta-expanded to zero.
+ test/succeed/sizeFunctions.ma view
@@ -0,0 +1,35 @@+-- 2010-03-11 size functions++data Bool : Set+{ true : Bool+; false : Bool+}++data N : Set+{ zz : N+; ss : N -> N+}++sized data Nat : Size -> Set+{ zero : [i : Size] -> Nat ($ i)+; succ : [i : Size] -> Nat i -> Nat ($ i)+}++let infty : Size = #+let ssuc : Size -> Size = \ i -> $ i++fun maybeSuc : (b : Bool) -> Size -> Size+{ maybeSuc true i = $ i+; maybeSuc false i = i+}++fun addSize : N -> Size -> Size+{ addSize zz i = i+; addSize (ss n) i = $ (addSize n i)+}++fun addSNat : (n : N) -> (i : Size) -> Nat i -> Nat (addSize n i)+{ addSNat zz     i m = m+; addSNat (ss n) i m = succ (addSize n i) (addSNat n i m) +}+
+ test/succeed/sizedFinitelyBranchingTrees.ma view
@@ -0,0 +1,20 @@+data Nat : Set+{ zero : Nat+; succ : Nat -> Nat+}++data Fin : Nat -> Set+{ fzero : [n : Nat] -> Fin (succ n)+; fsucc : [n : Nat] -> Fin n -> Fin (succ n)+}++sized data Tree (A : Set) : Size -> Set+{ leaf : [i : Size] -> A -> Tree A ($ i)+; node : [i : Size] -> (n : Nat) -> (Fin n -> Tree A i) -> Tree A ($ i)+}++fun map : [A : Set] -> [B : Set] -> (A -> B) -> +          [i : Size] -> Tree A i -> Tree B i+{ map A B f i (leaf (i > j) a)   = leaf j (f a)+; map A B f i (node (i > j) n s) = node j n (\ k -> map A B f j (s k)) +}
+ test/succeed/sizedMax.ma view
@@ -0,0 +1,36 @@+sized data Nat : Size -> Set+{ zero : [i : Size] -> Nat ($ i)+; succ : [i : Size] -> Nat i -> Nat ($ i)+}++check fun maxN : [i : Size] -> Nat i -> Nat i -> Nat i +{ maxN .($ i) (zero .i) (zero i)   = zero i+; maxN .($ i) (zero .i) (succ i n) = succ i n+; maxN .($ i) (succ .i n) (zero i) = succ i n+; maxN .($ i) (succ .i n) (succ i m) = succ i (maxN i n m)+}+ +fun maxN : [i : Size] -> Nat i -> Nat i -> Nat i +{ maxN i (zero (i > j)  ) (zero (i > k)  ) = zero j+; maxN i (zero (i > j)  ) (succ (i > k) m) = succ k m+; maxN i (succ (i > j) n) (zero (i > k)  ) = succ j n+; maxN i (succ (i > j) n) (succ (i > k) m) = succ (max j k) +                                            (maxN (max j k) n m)+}++{-+-- termination checker++  max j k ?<? i++-- constaint solving with max?++; maxN i (succ (i > j) n) (succ (i > k) m) = succ _X (maxN _Y n m)++  _X + 1 <= i+  j <= _Y+  k <= _Y+  _Y <= _X+  +Needs to be solved as _X = _Y = max j k +-}
+ test/succeed/sizedMergeWith.ma view
@@ -0,0 +1,29 @@+data Bool : Set+{ true  : Bool+; false : Bool+}++data Nat : Set+{ zero : Nat+; suc  : Nat -> Nat+}++sized data List : Size -> Set+{ nil  : (i : Size) -> List ($ i)  +; cons : (i : Size) -> Nat -> List i -> List ($ i)+}++fun leq : Nat -> Nat -> Bool {}++-- merge as would be represented with "with" in Agda+mutual {+  fun merge : (i : Size) -> List i -> (j : Size) -> List j -> List #+  { merge .($ i) (nil i) j l = l+  ; merge i l .($ j) (nil j) = l+  ; merge .($ i) (cons i x xs) .($ j) (cons j y ys) = merge_aux i x xs j y ys (leq x y)+  }+  fun merge_aux : (i : Size) -> Nat -> List i -> (j : Size) -> Nat -> List j -> Bool -> List #+  { merge_aux i x xs j y ys true  = cons # x (merge i xs ($ j) (cons j y ys))+  ; merge_aux i x xs j y ys false = cons # y (merge ($ i) (cons i x xs) j ys) +  }+}
+ test/succeed/sizedOrd.ma view
@@ -0,0 +1,26 @@+data Nat : Set+{ zero : Nat+; succ : Nat -> Nat+}++sized data Ord : Size -> Set+{ ozero : [i : Size] -> Ord ($ i)+; osucc : [i : Size] -> Ord i -> Ord ($ i)+; olim  : [i : Size] -> (Nat -> Ord i) -> Ord ($ i)+}++fun maxO : [i : Size] -> Ord i -> Ord i -> Ord i+{ maxO i (ozero (i > j)) q = q+; maxO i p (ozero (i > k)) = p+; maxO i (olim (i > j) f) (olim (i > k) g) = +   olim (max j k) (\ n -> maxO (max j k) (f n) (g n))+; maxO i (osucc (i > j) p) (osucc (i > k) q) =+   osucc (max j k) (maxO (max j k) p q)+-- CANNOT DEFINE MISSION CLAUSES+}++fun idO : [i : Size] -> Ord i -> Ord i+{ idO i (ozero (i > j)  ) = ozero j+; idO i (osucc (i > j) p) = osucc j (idO j p)+; idO i (olim  (i > j) f) = olim  j (\ n -> idO j (f n))+}
+ test/succeed/streamIdentityNatRecursive.ma view
@@ -0,0 +1,20 @@++sized data SNat : Size -> Set+{+  zero : (i : Size) -> SNat ($ i);+  succ : (i : Size) -> SNat i -> SNat ($ i)+}++sized codata Stream : Size -> Set {+  cons : (i : Size) -> SNat # -> Stream i -> Stream ($ i)+}+++-- a silly stream identity+-- this is refuted by Karl's overly restrictive admissibility test++fun sid : (i : Size) -> SNat i -> (j : Size) -> Stream j -> Stream j+{+  sid .($ i) (zero i)   j xs = xs ;+  sid .($ i) (succ i y) j xs = sid i y j xs+}
+ test/succeed/subset.ma view
@@ -0,0 +1,43 @@+-- 2012-01-22 parameters gone from constructors++data Subset (A : Set) (P : A -> Set) : Set+{+  put : (get : A) -> [P get] -> Subset A P +}++data Nat : Set+{ +  zero : Nat;+  succ : Nat -> Nat+}++data Odd : Nat -> Set+{+  odd1  : Odd (succ zero);+  odd3  : Odd (succ (succ (succ zero)));+  oddSS : [n : Nat] -> Odd n -> Odd (succ (succ n))+}+++data Eq (A : Set)(a : A) : A -> Set+{+  refl : Eq A a a+}++let OddN : Set +         = Subset Nat Odd++let one  : Nat+         = succ zero++let three : Nat+          = succ (succ one) ++let o3   : OddN+         = put three odd3++let o3'  : OddN+         = put three (oddSS one odd1)++let p    : Eq OddN o3 o3'+         = refl
+ test/succeed/tailStream.ma view
@@ -0,0 +1,11 @@++sized codata Stream (+ A : Set) : Size -> Set {+  cons : (i : Size) -> A -> Stream A i -> Stream A ($ i)+}++-- tail is fine since it is non-recursive, so the type need not be+-- admissible +fun tail : (A : Set) -> (i : Size) -> Stream A ($ i) -> Stream A i+{+  tail A i (cons .i x xs) = xs+}
+ test/succeed/vec.ma view
@@ -0,0 +1,46 @@+data Nat : Set+{+  zero : Nat;+  succ : (pred : Nat) -> Nat+}++fun add : Nat -> Nat -> Nat+{+  add zero y = y;+  add (succ x) y = succ (add x y)+}++data Vec' (+A : Set) : Nat -> Set+{+  vnil'  : Vec' A zero;+  vcons' :  [n : Nat] -> (head' : A) -> (tail' : Vec' A n) -> Vec' A (succ n)  +}++data Vec (+A : Set) : Nat -> Set+{+  vnil  : Vec A zero;+  vcons : (head : A) -> [n : Nat] -> (tail : Vec A n) -> Vec A (succ n)  +}++fun length : [A : Set] -> [n : Nat] -> Vec A n -> Nat+{+  length A .zero vnil = zero;+  length A .(succ n) (vcons x n xs) = succ (length A n xs);+}++fun append : [A : Set] -> [n : Nat] -> Vec A n -> +                          [m : Nat] -> Vec A m -> Vec A (add n m)+{+  append A .zero     vnil         m ys = ys;+  append A .(succ n) (vcons x n xs) m ys = +    vcons x (add n m) (append A n xs m ys)+}++data Id (A : Set)(a : A) : A -> Set+{ refl : Id A a a+}++let vec0vnil : (A : Set) -> (v : Vec A zero) -> Id (Vec A zero) v vnil+             = \ A -> \ v -> refl++
+ test/succeed/wkStream.ma view
@@ -0,0 +1,111 @@+data Nat : Set  +{+	zero : Nat ;+	succ : (x : Nat) -> Nat+}++fun add : Nat -> Nat -> Nat+{+add x zero = x;+add x (succ y) = succ (add x y);+}++eval let one : Nat = succ zero++sized codata Stream (A : Set) : Size -> Set +{+  cons : (i : Size) -> A -> Stream A i -> Stream A ($ i)+}++cofun zeroes : (i : Size ) -> Stream Nat i+{+zeroes ($ i) = cons i zero (zeroes i)+}+ +cofun ones : (i : Size) -> Stream Nat i+{+ones ($ i) = cons i one (ones i)+}++eval let ones' : Stream Nat # = ones #++cofun map : (A : Set) -> (B : Set) -> (i : Size) ->+          (A -> B) -> Stream A # -> Stream B i+{+map A B ($ i) f (cons .# a as) = cons i (f a) (map A B i f as)+} ++eval let twos : Stream Nat # = map Nat Nat # ( \ x -> succ x) ones'++++-- tail is a fun+fun tail : (A : Set) -> Stream A # -> Stream A #+{+tail A (cons .# a as) = as+}+++eval let twos' : Stream Nat # = tail Nat twos++fun head : (A : Set) -> Stream A # -> A+{+head A (cons .# a as) = a+}++eval let two : Nat = head Nat twos +eval let two' : Nat = head Nat twos'++eval let twos2 : Stream Nat # = map Nat Nat # succ ones'+eval let twos2' : Stream Nat # = tail Nat twos2++cofun zipWith : ( A : Set ) -> ( B : Set ) -> (C : Set) -> ( i : Size ) ->+	(A -> B -> C) -> Stream A # -> Stream B # -> Stream C i+{+zipWith A B C ($ i) f (cons .# a as) (cons .# b bs) = +  cons i (f a b) (zipWith A B C i f as bs)+}++++fun nth : Nat -> Stream Nat # -> Nat+{+nth zero ns = head Nat ns;+nth (succ x) ns = nth x (tail Nat ns) +}++eval let fours : Stream Nat # = zipWith Nat Nat Nat # add twos twos+eval let four : Nat = head Nat fours++++cofun fib : (x : Nat ) -> (y : Nat ) -> (i : Size ) -> Stream Nat i+{+fib x y ($ i) = (cons ($ i) x (cons i y (fib y (add x y) i)))+} ++eval let fib' : Stream Nat # = tail Nat (fib zero zero #) +++eval let fib8 : Nat = nth (add four four) (fib zero zero #)++eval let fib2 : Nat  = head Nat (tail Nat (fib zero zero #))++cofun nats : (i : Size ) -> Nat -> Stream Nat i+{+nats ($ i) x = (cons i x (nats i (succ x)))+}++eval let nats' : Stream Nat # = tail Nat (nats # zero)+++--- weakening+eval let wkStream : ( A : Set ) -> ( i : Size ) -> Stream A ($ i) -> Stream A i = \ A -> \ i -> \ s -> s++-- should be ok but does not pass admissibility check+cofun wkStream_ok : ( A : Set ) -> (i : Size ) -> Stream A ($ i) -> Stream A i+{+wkStream_ok A ($ i) (cons .($ i) x xs) = cons i x (wkStream A i xs) +}++