packages feed

idris 0.1.7.1 → 0.9.0

raw patch · 99 files changed

+10926/−17174 lines, 99 filesdep +bytestringdep +filepathdep +haskelinedep −arraydep −haskell98dep −ivordep ~epicbuild-type:Customsetup-changed

Dependencies added: bytestring, filepath, haskeline, process, transformers

Dependencies removed: array, haskell98, ivor, old-locale, old-time, readline

Dependency ranges changed: epic

Files

− CHANGELOG 
@@ -1,30 +0,0 @@-New in 0.1.6---------------* Changed dependent pair syntax to <| x, y |> so that << and >> can be-  integer shift operators.-* Removed '#' as type of types (must use 'Set' now).-* searchcontext tactic-* equalities.idr in the library-* codata keyword-* proof and tryproof keywords for invoking a decision procedure in a-  term-* Syntactic sugar for Cons lists-* Lots of smaller changes and bug fixes--New in 0.1.5---------------* Changed '#' to Set for the type of types-  - old syntax works, but is deprecated and will be removed soon.-* 'syntax' definitions-* %spec works in pattern clauses as well as CAFs-* Added 'Proof' type for marking computationally irrelevant terms.-* Added List permutation proofs to the library (perm.idr)-* Various new functions in the library.-* Lots of bug fixes--New in 0.1.4---------------* Namespaces
− Idris/AbsSyntax.lhs 
@@ -1,1496 +0,0 @@-> {-# OPTIONS_GHC -fglasgow-exts #-}--> module Idris.AbsSyntax(module Idris.AbsSyntax, ->                        module Idris.Context) where--> import Control.Monad-> import Control.Monad.State-> import qualified Data.Map as Map-> import Debug.Trace-> import Data.Typeable-> import Data.Maybe-> import Data.List-> import Char--> import Ivor.TT-> import Ivor.Primitives--> import Idris.Context--> data Result r = Success r->               | Failure String String Int->     deriving (Show, Eq)-> -> instance Monad Result where->     (Success r)   >>= k = k r->     (Failure err fn line) >>= k = Failure err fn line->     return              = Success->     fail s              = Failure s "(no file)" 0-> -> instance MonadPlus Result where->     mzero = Failure "Error" "(no file)" 0->     mplus (Success x) _ = (Success x)->     mplus (Failure _ _ _) y = y-> --A program is a collection of datatype and function definitions.-We store everything directly as a 'ViewTerm' from Ivor.--> data Decl = DataDecl Datatype | Fwd Id RawTerm [CGFlag]->           | PInclude FilePath->           | Fun Function [CGFlag] | TermDef Id RawTerm [CGFlag] | Constructor->           | Prf Proof Bool -- 'True' means proof is allowed to fail->           | LatexDefs [(Id,String)]->           | Using [(Id, RawTerm)] [Decl] -- default implicit args->           | Params [(Id, RawTerm)] [Decl] -- default implicit args->           | DoUsing Id Id [Decl] -- bind and return names->           | Idiom Id Id [Decl] -- pure and ap names->           | Namespace Id [Decl] -- bind and return names->           | CLib String | CInclude String->           | Fixity String Fixity Int->           | Transform RawTerm RawTerm->           | SynDef Id [Id] RawTerm ->           | Freeze String Int [Id] Id->    deriving Show--Flags for controlling compilation. In particular, some functions exist only-run compile-time function generation, so we never want to generate code-(e.g. generating foreign functiond defs).-Also, some functions should be evaluated completely before code generation-(e.g. for statically knowing the C function to compile)-Functions may be exported to C, if they have a simple type (no polymorphism, no dependencies).--> data CGFlag = NoCG | CGEval | CExport String | Inline | CGSpec [(Id, Int)]->             | Vis Visibility->    deriving (Show, Eq)--Public: Name, type and definition visible globally-Abstract: Only name and type visible (i.e. no constructors, or definition)-  outside the namespace.-Private: Nothing visible outside the namespace.--> data Visibility = Public | Private | Abstract->    deriving (Show, Eq)--User defined operators have associativity and precedence--> data Fixity = LeftAssoc | RightAssoc | NonAssoc->    deriving (Show, Eq, Enum)--> type Fixities = [(String, (Fixity, Int))]--> data UserOps = UO { fixityDecls :: Fixities,->                     transforms :: [(ViewTerm, ViewTerm)],->                     frozen :: [Id],->                     syndefs :: Ctxt Syntax }->              deriving Show--Function types and clauses are given separately, so we'll parse them-separately then collect them together into a list of Decls--A FunClauseP is a clause which is probably the wrong type, but instructs-the system to insert a hole for a proof that turns it into the right type.--> data ParseDecl = RealDecl Decl->                | FunType Id RawTerm [CGFlag] String Int ->                | FunClause RawTerm [RawTerm] RawTerm [CGFlag]->                | FunClauseP RawTerm [RawTerm] RawTerm Id->                | WithClause RawTerm [RawTerm] Bool RawTerm [ParseDecl]->                | ProofScript Id [ITactic]->                | PUsing [(Id,RawTerm)] [ParseDecl]->                | PParams [(Id, RawTerm)] [ParseDecl]->                | PDoUsing (Id, Id) [ParseDecl]->                | PIdiom (Id, Id) [ParseDecl]->                | PNamespace Id [ParseDecl]->    deriving Show--> collectDecls :: [ParseDecl] -> Result [Decl]-> collectDecls pds = cds [] [] pds->   where cds rds fwds ((RealDecl d):ds) = cds (d:rds) fwds ds->         cds rds fwds ((FunType n t fl file line):ds) ->             = getClauses RPlaceholder rds fwds n (t, file, line) fl [] ds->         cds rds fwds ((FunClause (RVar f l n _) [] ret fl):ds) ->                 = cds ((TermDef n ret fl):rds) fwds ds->         cds rds fwds ds@((FunClause app [] ret fl):_) ->             = case getFnName app of->                 Just (n, file, line) -> ->                    case (lookup n fwds) of->                      Nothing -> fail $ "No type declaration for " ++ show n->                      Just (ty,fl) -> getClauses app rds fwds n (ty, file, line) fl [] ds->                 _ -> fail $ "Invalid pattern clause"->         cds rds fwds ((ProofScript n prf):ds)->             = case lookup n fwds of->                      Nothing ->->                          cds ((Prf (Proof n Nothing prf) False):rds) fwds ds->                      Just (ty, fl) -> ->                          cds ((Prf (Proof n (Just ty) prf) False):rds) fwds ds->         cds rds fwds ((PUsing uses pds):ds) = ->                case (cds [] [] pds) of->                   Success d ->->                       cds ((Using uses d):rds) fwds ds->                   failure -> failure->         cds rds fwds ((PParams params pds):ds) = ->                case (cds [] [] pds) of->                   Success d ->->                       cds ((Params params d):rds) fwds ds->                   failure -> failure->         cds rds fwds ((PDoUsing (ub,ur) pds):ds) = ->                case (cds [] [] pds) of->                   Success d ->->                       cds ((DoUsing ub ur d):rds) fwds ds->                   failure -> failure->         cds rds fwds ((PNamespace ns pds):ds) = ->                case (cds [] [] pds) of->                   Success d ->->                       cds ((Namespace ns d):rds) fwds ds->                   failure -> failure->         cds rds fwds ((PIdiom (up,ua) pds):ds) = ->                case (cds [] [] pds) of->                   Success d ->->                       cds ((Idiom up ua d):rds) fwds ds->                   failure -> failure->         cds rds fwds (d:ds) = fail $ "Invalid declaration: " ++ show d->         cds rds fwds [] = return (reverse rds)--->         getClauses parent rds fwds n t fl clauses ((FunClause RPlaceholder [with] ret fl'):ds)->             = getClauses parent rds fwds n t fl clauses ((FunClause parent [with] ret fl'):ds)->         getClauses parent rds fwds n t fl clauses ((FunClause pat withs ret fl'):ds)->             | Just (f,l) <- isnm n (getFn pat)->                = getClauses parent rds fwds n t fl ((n, RawClause (mkApp f l pat withs) ret):clauses) ds->         getClauses parent rds fwds n t fl clauses ((FunClauseP RPlaceholder [with] ret mv):ds)->             = getClauses parent rds fwds n t fl clauses ((FunClauseP parent [with] ret mv):ds)->         getClauses parent rds fwds n t fl clauses ((FunClauseP pat withs ret mv):ds)->             | Just (f,l) <- isnm n (getFn pat)->                 = getClauses parent rds fwds n t fl ->                       ((n, RawClause (mkApp f l pat withs) (mkhret mv ret)):clauses) ds->         getClauses parent rds fwds n t fl clauses ((WithClause RPlaceholder [with] prf ret fl'):ds)->             = getClauses parent rds fwds n t fl clauses ((WithClause parent [with] prf ret fl'):ds)->         getClauses parent rds fwds n t fl clauses ((WithClause pat withs prf scr defs):ds)->             | Just (f,l) <- isnm n (getFn pat)->                 = do wcl <- collectWiths (mkApp f l pat withs) rds fwds n t fl defs->                      getClauses parent rds fwds n t fl ->                          ((n, RawWithClause (mkApp f l pat withs) prf scr wcl):clauses) ds->         getClauses parent rds fwds n (t, _, _) fl [] ds ->                = cds ((Fwd n t fl):rds) ((n,(t,fl)):fwds) ds->         getClauses parent rds fwds n (t,file,line) fl clauses ds =->             cds ((Fun (Function n t (reverse clauses) file line) fl):rds) fwds ds-->         isnm n (RVar f l nm _) | nm == n = Just (f,l)->         isnm _ _ = Nothing-->         collectWiths parent rds fwds n t fl cs = ->              do cls <- getClauses parent [] [] n t fl [] cs->                 case cls of->                     [Fun (Function _ _ cl _ _) _] -> return (map snd cl)->                     _ -> fail $ "Invalid with clause for " ++ show n--         collectWiths rds fwds n t fl ((FunClause pat ex rhs []):cs) =-             | (RVar n) == getFn pat-                 = RawClause (mkApp pat withs)-->         mkhret mv v = RBind (UN "value") (RLet v RPlaceholder) ->                             (RMetavar mv)--> data Datatype = Datatype {->                           tyId :: Id,->                           tyType :: RawTerm,->                           tyConstructors :: [(Id, RawTerm)],->                           tyImplicits :: [(Id, RawTerm)],->                           tyOpts :: [TyOpt],->                           tyFile :: String,->                           tyLine :: Int->                          }->               | Latatype { tyId :: Id,->                            tyType :: RawTerm,->                            tyFile :: String,->                            tyLine :: Int ->                          } -- forward declaration->   deriving Show--> data TyOpt = NoElim | Collapsible | Codata->   deriving (Show, Eq, Enum)--> tyHasElim dt = not (elem NoElim (tyOpts dt))-> collapsible dt = elem Collapsible (tyOpts dt)--> data Function = Function {->                           funId :: Id,->                           funType :: RawTerm,->                           funClauses :: [(Id, RawClause)],->                           funFile :: String,->                           funLine :: Int->                          }->   deriving Show--> data Proof = Proof {->                     proofId :: Id,->                     proofType :: Maybe RawTerm,->                     proofScript :: [ITactic]->                    }->   deriving Show--> getId :: Decl -> Id-> getId (Fun f _) = funId f-> getId (DataDecl d) = tyId d-> getId (TermDef n tm _) = n--Raw terms, as written by the programmer with no implicit arguments added.--> data RawTerm = RVar String Int Id NameType->              | RVars String Int [Id]->              | RExpVar String Int Id -- variable with all explicit args->              | RApp String Int RawTerm RawTerm->              | RAppImp String Int Id RawTerm RawTerm -- Name the argument we make explicit->              | RBind Id RBinder RawTerm->              | RConst String Int Constant->              | RPlaceholder->              | RMetavar Id->              | RMetavarPrf Id [ITactic] Bool -- Bool for if proof is allowed to fail->              | RInfix String Int Op RawTerm RawTerm->              | RUserInfix String Int Bool String RawTerm RawTerm->              | RDo [Do]->              | RReturn String Int->              | RIdiom RawTerm->              | RPure RawTerm -- a term to apply normally inside idiom brackets->              | RRefl->              | RError String Int String -- Hackety. Found an error in processing, report when you can.->    deriving (Show, Eq)--> data RBinder = Pi Plicit [ArgOpt] RawTerm->              | Lam RawTerm->              | RLet RawTerm RawTerm->    deriving (Show, Eq)--> data Plicit = Im | Ex->    deriving (Show, Eq, Enum)--> data ArgOpt = Lazy | Static->    deriving (Show, Eq, Enum)--> data Do = DoBinding String Int Id RawTerm RawTerm->         | DoLet String Int Id RawTerm RawTerm->         | DoExp String Int RawTerm->     deriving (Show, Eq)--> data ITactic = Intro [Id]->              | Refine Id->              | Exists RawTerm->              | Generalise RawTerm->              | ReflP->              | Induction RawTerm->              | Fill RawTerm->              | Trivial->              | SimpleSearch->              | Case RawTerm->              | Rewrite Bool Bool RawTerm->              | Unfold Id->              | Compute->              | Equiv RawTerm->              | Believe RawTerm->              | Use RawTerm->              | Decide RawTerm->              | Undo->              | Abandon->              | ProofTerm->              | RunTactic RawTerm -- tactic computed from lib/tactics.idr->              | Qed->     deriving (Show, Eq)--> getArgOpt :: ArgOpt -> RawTerm -> [Int]-> getArgOpt ao tm = gl' 0 tm->   where gl' i (RBind n (Pi _ opts _) sc) ->               | ao `elem` opts = i:(gl' (i+1) sc)->         gl' i (RBind n (Pi Ex _ _) sc) = gl' (i+1) sc->         gl' i (RBind n (Pi Im _ _) sc) = gl' i sc->         gl' i x = []--> getLazy = getArgOpt Lazy-> getStatic = getArgOpt Static--> mkLazy :: ViewTerm -> ViewTerm-> mkLazy t = App (App (Name Unknown (name "__lazy")) Placeholder) t--> getFileLine :: RawTerm -> (String, Int)-> getFileLine (RApp f l _ _) = (f, l)-> getFileLine (RAppImp f l _ _ _) = (f, l)-> getFileLine (RVar f l _ _) = (f, l)-> getFileLine (RExpVar f l _) = (f, l)-> getFileLine (RInfix f l _ _ _) = (f, l)-> getFileLine (RUserInfix f l _ _ _ _) = (f, l)-> getFileLine (RConst f l _) = (f, l)-> getFileLine (RBind _ (Pi _ _ ty) _) = getFileLine ty-> getFileLine (RBind _ (Lam ty) _) = getFileLine ty-> getFileLine _ = ("(unknown)", 0)--> getFn :: RawTerm -> RawTerm-> getFn (RApp _ _ f a) = getFn f-> getFn (RAppImp _ _ _ f a) = getFn f-> getFn f = f--> getArgTypes :: RawTerm -> [(Id,RawTerm)]-> getArgTypes tm = gat tm [] where->     gat (RBind n (Pi _ _ ty) sc) acc = gat sc ((n,ty):acc)->     gat sc acc = reverse acc--> getRetType :: RawTerm -> RawTerm-> getRetType (RBind n (Pi _ _ ty) sc) = getRetType sc-> getRetType x = x--> getFnName f = case getFn f of->                 (RVar f l n _) -> Just (n,f,l)->                 _ -> Nothing--> getRawArgs :: RawTerm -> [RawTerm]-> getRawArgs x = args [] x->    where args acc (RApp _ _ f a) = args (a:acc) f->          args acc (RAppImp _ _ _ f a) = args (a:acc) f->          args acc f = acc--> getExplicitArgs :: RawTerm -> [RawTerm]-> getExplicitArgs x = args [] x->    where args acc (RApp _ _ f a) = args (a:acc) f->          args acc (RAppImp _ _ _ f a) = args acc f->          args [] (RInfix _ _ _ x y) = [x,y]->          args [] (RUserInfix _ _ _ _ x y) = [x,y]->          args acc f = acc--Binders; Pi (either implicit or explicitly written), Lambda and Let with-value.--> data Constant = Num Int->               | Str String->               | Bo Bool->               | Ch Char->               | Fl Double->               | TYPE->               | LTYPE->               | StringType->               | IntType->               | FloatType->               | CharType->               | PtrType->               | Builtin String -- builtin type, eg Handle or Lock->    deriving (Eq, Ord)--> instance ViewConst Char where->     typeof x = (name "Char")--> instance Show Constant where->     show (Num i) = show i->     show (Str s) = show s->     show (Bo b) = show b->     show (Ch c) = show c->     show (Fl d) = show d->     show TYPE = "Set"->     show LTYPE = "LSet"->     show IntType = "Int"->     show FloatType = "Float"->     show CharType = "Char"->     show StringType = "String"->     show PtrType = "Ptr"->     show (Builtin s) = s--Operators, more precisely, are built-in functions on primitive types which both the -typechecker and compiler need to know how to run. First we have the usual set of infix -operators (plus John Major equality):--> data Op = Plus  | Minus  | Times  | Divide | Modulo | Concat | JMEq->         | FPlus | FMinus | FTimes | FDivide->         | OpEq  | OpLT   | OpLEq  | OpGT   | OpGEq  ->         | OpFEq | OpFLT  | OpFLEq | OpFGT  | OpFGEq ->         | OpOr  | OpAnd | ShL    | ShR--Then built-in functions for coercing between types-->         | ToString | ToInt ->         | FloatToString | StringToFloat->         | IntToChar | CharToInt--Finally some primitive operations on primitive types.-->         | StringLength | StringGetIndex | StringSubstr->         | StringHead | StringTail | StringCons | StringRev->         | StringFind | StringSub->    deriving (Eq, Enum)--> allOps = [Plus,Minus,Times,Divide,Modulo,FPlus,FMinus,FTimes,FDivide,->           Concat,ShL,ShR,JMEq,OpEq,OpLT,OpLEq,OpGT,OpGEq,->           OpFEq,OpFLT,OpFLEq,OpFGT,OpFGEq]--> instance Show Op where->     show Plus = "+"->     show Minus = "-"->     show Times = "*"->     show Divide = "/"->     show Modulo = "%"->     show FPlus = "+."->     show FMinus = "-."->     show FTimes = "*."->     show FDivide = "/."->     show Concat = "++"->     show JMEq = "="->     show OpEq = "=="->     show OpLT = "<"->     show OpLEq = "<="->     show OpGT = ">"->     show OpGEq = ">="->     show OpFEq = "==."->     show OpFLT = "<."->     show OpFLEq = "<=."->     show OpFGT = ">."->     show OpFGEq = ">=."->     show OpOr = "||"->     show OpAnd = "&&"->     show ShL = "<<"->     show ShR = ">>"--> opFn Plus = (name "__addInt")-> opFn Minus = (name "__subInt")-> opFn Times = (name "__mulInt")-> opFn Divide = (name "__divInt")-> opFn Modulo = (name "__modInt")-> opFn FPlus = (name "__addFloat")-> opFn FMinus = (name "__subFloat")-> opFn FTimes = (name "__mulFloat")-> opFn FDivide = (name "__divFloat")-> opFn Concat = (name "__concat")-> opFn JMEq = (name "Eq")-> opFn OpEq = (name "__eq")-> opFn OpLT = (name "__intlt")-> opFn OpLEq = (name "__intleq")-> opFn OpGT = (name "__intgt")-> opFn OpGEq = (name "__intgeq")-> opFn OpFEq = (name "__feq")-> opFn OpFLT = (name "__floatlt")-> opFn OpFLEq = (name "__floatleq")-> opFn OpFGT = (name "__floatgt")-> opFn OpFGEq = (name "__floatgeq")-> opFn OpOr = (name "__or")-> opFn OpAnd = (name "__and")-> opFn ShL = (name "__shl")-> opFn ShR = (name "__shr")--> opFn ToInt = (name "__toInt")-> opFn ToString = (name "__toString")-> opFn StringToFloat = (name "__stringToFloat")-> opFn FloatToString = (name "__floatToString")-> opFn CharToInt = (name "__charToInt")-> opFn IntToChar = (name "__intToChar")--> opFn StringLength = (name "__strlen")-> opFn StringGetIndex = (name "__strgetIdx")-> opFn StringSubstr = (name "__substr")-> opFn StringHead = (name "__strHead")-> opFn StringTail = (name "__strTail")-> opFn StringRev = (name "__strRev")-> opFn StringFind = (name "__strFind")-> opFn StringSub = (name "__substr")-> opFn StringCons = (name "__strCons")--> useropFn fn = UN $ "__op_" ++ concat (map opC fn) where->     opC c = "_" ++ show (fromEnum c)--Pattern clauses--> data RawClause = RawClause { lhs :: RawTerm,->                              rhs :: RawTerm }->                | RawWithClause { lhs :: RawTerm,->                                  addproof :: Bool,->                                  scrutinee :: RawTerm,->                                  defn :: [RawClause] }->    deriving Show--> mkApp :: String -> Int -> RawTerm -> [RawTerm] -> RawTerm-> mkApp file line f [] = f-> mkApp file line f (a:as) = mkApp file line (RApp file line f a) as--For each raw definition, we'll translate it into something Ivor will understand-with all the placeholders added. For this we'll need to know how many-implicit arguments each function has.--> data IvorFun = IvorFun {->       ivorFName :: Maybe Name,->       ivorFType :: (Maybe ViewTerm),->       implicitArgs :: Int,->       -- paramArgs :: Int,->       ivorDef :: Maybe IvorDef,->       rawDecl :: Decl, -- handy to keep around for display + extra data->       funFlags :: [CGFlag],->       lazyArgs :: [Int],->       staticArgs :: [Int]->     }->              | IvorProblem String->    deriving Show--> getNameType :: IvorFun -> NameType-> getNameType i = case rawDecl i of->                   Fun _ _ -> Free->                   TermDef _ _ _ -> Free->                   Prf _ _ -> Free->                   Fwd _ _ _ -> Free->                   Constructor -> DataCon->                   _ -> Unknown--> mkNameMap :: Ctxt IvorFun -> [(Name, Id)]-> mkNameMap ctxt = mapMaybe mknm (ctxtAlist ctxt)->   where mknm (n, IvorProblem _) = Nothing->         mknm (n, i) = do iname <- ivorFName i->                          return (iname, n)--Get all the pattern definitions. Get the user specified one, not the-Ivor expanded one (i.e. with the placeholders as the user specified) so-that we avoid pattern matching where the programmer didn't ask us to.--> getRawPatternDefs :: Ctxt IvorFun -> Context ->->                      [(Name, (ViewTerm, Patterns))]-> getRawPatternDefs raw ctxt = gdefs (ctxtAlist raw) where->     gdefs [] = []->     gdefs ((n, IvorFun _ _ _ _ (decl@(LatexDefs _)) _ _ _):ds) = gdefs ds->     gdefs ((n, IvorFun _ _ _ _ (decl@(Fixity _ _ _)) _ _ _):ds) = gdefs ds->     gdefs ((n, IvorFun _ _ _ _ (decl@(Transform _ _)) _ _ _):ds) = gdefs ds->     gdefs ((n, IvorFun _ _ _ _ (decl@(SynDef _ _ _)) _ _ _):ds) = gdefs ds->     gdefs ((n, IvorFun _ _ _ _ (decl@(Freeze _ _ _ _)) _ _ _):ds) = gdefs ds->     gdefs ((n, ifun):ds)->        = let Just iname = ivorFName ifun in->             case (ivorFType ifun, ivorDef ifun) of->               (Just ty, Just (PattDef ps)) -> ->                   (iname, (ty,ps)):(gdefs ds)->               _ -> case getPatternDef ctxt iname of->                      Right (ty,ps) -> (iname, (ty,ps)):(gdefs ds)->                      _ -> gdefs ds--Name definitions Ivor-side.--> data IvorDef = PattDef !Patterns -- pattern matching function->              | ITyCon -- Type constructor->              | IDataCon -- Data constructor->              | SimpleDef !ViewTerm -- simple function definition->              | DataDef !Inductive Bool -- data type definition, generate elim->              | IProof [ITactic] Bool -- True if failable->              | Later -- forward declaration->              | LataDef -- forward declared data->    deriving Show--A transformation is a function converting a ViewTerm to a new form.--> data Transform = Trans String ->                        (Maybe (ViewTerm -> ViewTerm)) ->                        (Maybe TransData)--A syntax definition is a syntax level transformation from one term to another-(macros, essentially).--> data Syntax = Syntax Id [Id] RawTerm->   deriving Show--Concrete transformation data, used for rebuilding constructor transforms--> data TransData = Force (Maybe (Name, Name)) Int Name [Name] ->                        [(Name, ViewTerm)] Int->                | Collapse Name Name ViewTerm Int->                | Drop Name ViewTerm [Int] Int--> data Opt = NoErasure | ShowRunTime | NoSpec | Verbose->    deriving (Show, Eq, Enum)--> type Statics = [(Name, ([Int], Int, ViewTerm))]--Things we've partially evaluated that transform rules already exist for-(so don't make another one)--> type StaticUsed = [(Name, [ViewTerm])]--> data IdrisState = IState {->       idris_context :: Ctxt IvorFun, -- function definitions->       idris_decls :: [Decl], -- all checked declarations->       idris_metavars :: [(Name, ViewTerm)], -- things still to prove->       idris_options :: [Opt], -- global options->       idris_fixities :: UserOps, -- infix operators and precedences->       idris_transforms :: [Transform], -- optimisations->       idris_syntax :: Ctxt Syntax, -- syntax macros->       idris_imports :: [FilePath], -- included files->       idris_names :: [(Name, Id)], -- map ivor names back to idris names->       idris_static :: Statics, -- map from functions to static args->       idris_static_used :: StaticUsed->     }--> instance Show (Ctxt Syntax) where->     show xs = show (ctxtAlist xs)--> initState :: [Opt] -> IdrisState-> initState opts = IState newCtxt [] [] opts (UO [] [] [] newCtxt) [] newCtxt [] [] [] []--Add implicit arguments to a raw term representing a type for each undefined -name in the scope, returning the number of implicit arguments the resulting-type has.--We only want names which appear *in argument position*, e.g. P a we'd add a -but not P. [[We also don't want names which appear in the return type, since-they'll never be inferrable at the call site. (Not done this. Not convinced.) ]]--> addImpl :: Ctxt IvorFun -> RawTerm -> (RawTerm, Int) -> addImpl = addImpl' True [] [] []--> addImplWith :: Implicit -> Ctxt IvorFun -> RawTerm -> (RawTerm, Int) -> addImplWith (Imp using params paramnames ns) = addImpl' True using params ns--Bool says whether to pi bind unknown names-Also take a mapping of names to types ('using') --- if any name we need to -bind is  in the list, use the given type. Also sort the resulting bindings -so that they are in the same order as in 'using', and appear after any-other introduced bindings.--'params' is the arguments that the current group of definitions is parameterised over.-These should be added as *explicit* arguments.--Need to do it twice, in case the first pass added names in the indices-(from using)--> addImpl' :: Bool -> [(Id, RawTerm)] -> [(Id, RawTerm)] -> [Id] -> Ctxt IvorFun -> ->             RawTerm -> (RawTerm, Int) -> addImpl' pi using params namespace ctxt raw' ->             = let raw = parambind params raw'->                   (newargs, totimp) = execState (addImplB [] raw True) ([],0) in->                   if pi then ->                      let added = pibind Im (mknew newargs) raw in->                         if null using->                           then (added, totimp)->                           else let (added', totimp') = addImpl' True [] [] namespace ctxt added in->                                (added', totimp')->                      else (raw, totimp)->     where addImplB :: [Id] -> RawTerm -> Bool -> State ([Id], Int) ()->           addImplB env (RVar f l i _) argpos->               | i `elem` env = return ()->               | Right _ <- ctxtLookup ctxt namespace i = return ()--Only do it in argument position-->               | argpos = do (nms, tot) <- get->                             if (i `elem` nms) then return ()->                                 else put (i:nms, tot+1)->               | otherwise = return ()->           addImplB env ap@(RApp _ _ f a) argpos->                    = do addImplB env f False->                         addImplB env a True->           addImplB env (RAppImp _ _ _ f a) argpos ->                    = do addImplB env f False->                         addImplB env a True->           addImplB env (RBind n (Pi Im _ ty) sc) argpos->                    = do (nms, tot) <- get->                         put (nms, tot+1)->                         addImplB env ty argpos->                         addImplB (n:env) sc argpos->           addImplB env (RBind n (Pi Ex _ ty) sc) argpos->                    = do addImplB env ty True->                         addImplB (n:env) sc argpos->           addImplB env (RBind n (Lam ty) sc) argpos->                    = do addImplB env ty argpos->                         addImplB (n:env) sc argpos->           addImplB env (RBind n (RLet val ty) sc) argpos->                    = do addImplB env val argpos->                         addImplB env ty argpos->                         addImplB (n:env) sc argpos->           addImplB env (RInfix _ _ op l r) argpos->                    = do addImplB env l argpos->                         addImplB env r argpos->           addImplB env (RUserInfix _ _ _ op l r) argpos->                    = do addImplB env l argpos->                         addImplB env r argpos->           addImplB env _ _ = return ()-->           mknew :: [Id] -> [(Id, RawTerm)]->           mknew args = map fst (sortBy ordIdx (map addTy args))-->           ordIdx (a, x) (b, y) = compare x y-->           addTy n = case lookupIdx n using of->                        Just (t, i) -> ((n,t), i)->                        _ -> ((n,RPlaceholder), -1)-->           parambind :: [(Id, RawTerm)] -> RawTerm -> RawTerm->           parambind xs (RBind n b@(Pi Im strict ty) sc) = RBind n b (parambind xs sc)->           parambind xs sc = pibind Ex xs sc--> pibind :: Plicit -> [(Id, RawTerm)] -> RawTerm -> RawTerm-> pibind plicit [] raw = raw-> pibind plicit ((n, ty):ns) raw->     = RBind n (Pi plicit [] ty) (pibind plicit ns raw)--Is this, or something like it, in the Haskell libraries?--> lookupIdx :: Eq a => a -> [(a,b)] -> Maybe (b, Int)-> lookupIdx x xs = li' 0 x xs->    where li' i x [] = Nothing->          li' i x ((y,v):ys) | x == y = Just (v, i)->                             | otherwise = li' (i+1) x ys--Convert a raw term with all the implicit things added into an ivor term-ready for typechecking--> toIvorName :: Id -> Name-> toIvorName i = name (show i)--Lookup the original Idris name of a name from Ivor. Makes up a name if-the name doesn't exist.--> fromIvorName :: IdrisState -> Name -> Id-> fromIvorName ist i = case lookup i (idris_names ist) of->                        Just n -> n->                        _ -> UN (show i)--Make up a plausible Idris name from a name from Ivor (only really useful-for display purposes, or if it really doesn't matter whether the name exists -or not)--> fromIvorName_ :: Name -> Id-> fromIvorName_ i = UN (show i)--For desugaring -- do blocks, idiom brackets and syntax definitions--> data UndoInfo = UI Id Int -- bind, bind implicit->                    Id Int -- return, return implicit->                    Id Int -- pure, pure implicit->                    Id Int -- ap, ap implicit--> data ModInfo = MI Id -- namespace->                   [(Id, RawTerm)] -- parameters--Implicit argument information; current using clause and parameters. We also need to know -the functions in the current block, and which arguments to add automatically, because the-programmer doesn't have to write them down inside the param block.--> data Implicit = Imp { impUsing :: [(Id, RawTerm)], -- 'using'->                       params :: [(Id, RawTerm)], -- extra params->                       paramNames :: [(Id, [Id])], -- functions and params in the current block->                       thisNamespace :: [Id]->                     }--> noImplicit = Imp [] [] [] []--> addUsing :: Implicit -> Implicit -> Implicit-> addUsing (Imp a b pns ns) (Imp a' b' pns' ns') -- ns always == ns'->              = Imp (a++a') (b++b') (pns++pns') ns--> addParams :: Implicit -> [(Id, RawTerm)] -> Implicit-> addParams (Imp a b pns ns) newps = Imp a (b++newps) pns ns--> addNS :: Implicit -> Id -> Implicit-> addNS (Imp a b pns ns) n = Imp a b pns (n:ns)--> fullName :: Implicit -> Id -> Id-> fullName imp n = mkName (thisNamespace imp) n--> addParamName :: Implicit -> Id -> Implicit-> addParamName imp@(Imp u ps pns ns) n->     = case lookup n pns of->          Just _ -> imp->          Nothing -> Imp u ps ((n, (map fst ps)):pns) ns--> bindName = ioname "bind"-> ibindName = ioname "ibind"-> retName = ioname "ret"-> ioretName = ioname "IOReturn"-> iodoName = ioname "IODo"-> ioliftName = ioname "IOLift"-> applyName = ioname "apply"--> bindNamei = toIvorName bindName-> ibindNamei = toIvorName ibindName-> retNamei = toIvorName retName-> ioretNamei = toIvorName ioretName-> iodoNamei = toIvorName iodoName-> ioliftNamei = toIvorName ioliftName-> applyNamei = toIvorName applyName--> ioname n = NS [UN "IO"] (UN n)-> ionamei n = toIvorName (ioname n)--> defDo = UI bindName 2 retName 1 retName 1 applyName 2--Give names to unnamed metavariables, and record any associated proof-scripts--> insertMetas :: Id -> RawTerm -> State (Int, [(Id, [ITactic], Bool)]) RawTerm-> insertMetas fname tm = im tm->     where im (RMetavarPrf (UN "") tacs prf)->                 = do (h, ts) <- get->                      let nm = mkName fname h->                      put (h+1, (nm, tacs, prf):ts)->                      return $ RMetavar nm->           im (RApp f l x a) ->               = do x' <- im x->                    a' <- im a->                    return $ RApp f l x' a'->           im (RAppImp f l arg x a) ->               = do x' <- im x->                    a' <- im a->                    return $ RAppImp f l arg x' a'->           im (RBind n bind t)->               = do bind' <- imb bind->                    t' <- im t->                    return $ RBind n bind' t->           im (RInfix f l op x y)->               = do x' <- im x->                    y' <- im y->                    return $ RInfix f l op x' y'->           im (RUserInfix f l b op x y)->               = do x' <- im x->                    y' <- im y->                    return $ RUserInfix f l b op x' y'->           im (RDo ds) = do ds' <- mapM imd ds->                            return $ RDo ds'->           im (RIdiom t) = do t' <- im t->                              return $ RIdiom t'->           im (RPure t) = do t' <- im t->                             return $ RPure t'->           im x = return x-->           imb (Pi p opts t) = do t' <- im t->                                  return $ Pi p opts t'->           imb (Lam t) = do t' <- im t->                            return $ Lam t->           imb (RLet t v) = do t' <- im t->                               v' <- im v->                               return $ RLet t' v'-->           imd (DoBinding f l i x y)->               = do x' <- im x->                    y' <- im y->                    return $ DoBinding f l i x' y'->           imd (DoLet f l i x y)->               = do x' <- im x->                    y' <- im y->                    return $ DoLet f l i x' y'->           imd (DoExp f l x)->               = do x' <- im x->                    return $ DoExp f l x'-->           mkName (UN n) i = UN ("__"++n++"_"++show i)->           mkName (MN n j) i = MN ("__"++n++"_"++show i) j---> insertMetasClauses :: Id -> [(Id, RawClause)] -> ->                       State (Int, [(Id, [ITactic], Bool)]) [(Id, RawClause)]-> insertMetasClauses fn xs = mapM imcp xs where->     imcp (n, t) = do t' <- imc t->                      return (n, t')->     imc (RawClause lhs rhs) = ->         do lhs' <- insertMetas fn lhs->            rhs' <- insertMetas fn rhs->            return (RawClause lhs' rhs')->     imc (RawWithClause lhs prf scr def) =->         do lhs' <- insertMetas fn lhs->            scr' <- insertMetas fn scr->            def' <- mapM imc def->            return (RawWithClause lhs' prf scr' def')--> toIvor :: UserOps -> UndoInfo -> Id -> RawTerm -> ViewTerm-> toIvor uo ui fname tm = evalState (toIvorS tm) (0,1)->   where->     toIvorS :: RawTerm -> State (Int, Int) ViewTerm->     toIvorS (RVar f l n ty) = return $ Annotation (FileLoc f l) (Name ty (toIvorName n))->     toIvorS (RVars f l ns) = return $ Annotation (FileLoc f l) (Overloaded (map toIvorName ns))->     toIvorS ap@(RApp file line f a)->            = do f' <- toIvorS f->                 a' <- toIvorS a->                 return (Annotation (FileLoc file line) (App f' a'))->     toIvorS (RBind (MN "X" 0) (Pi _ _ ty) sc) ->            = do ty' <- toIvorS ty->                 sc' <- toIvorS sc->                 (i, x) <- get->                 put (i+1, x)->                 return $ Forall (toIvorName (MN "X" i)) ty' sc'->     toIvorS (RBind n (Pi _ _ ty) sc) ->            = do ty' <- toIvorS ty->                 sc' <- toIvorS sc->                 return $ Forall (toIvorName n) ty' sc'->     toIvorS (RBind n (Lam ty) sc) ->            = do ty' <- toIvorS ty->                 sc' <- toIvorS sc->                 return $ Lambda (toIvorName n) ty' sc'->     toIvorS (RBind n (RLet val ty) sc) ->            = do ty' <- toIvorS ty->                 val' <- toIvorS val->                 sc' <- toIvorS sc->                 return $ Let (toIvorName n) ty' val' sc'->     toIvorS (RConst _ _ c) = return $ toIvorConst c->     toIvorS RPlaceholder = return Placeholder->     toIvorS (RMetavar (UN "")) -- no name, so make on eup->                 = do (i, h) <- get->                      put (i, h+1)->                      return $ Metavar (toIvorName (mkName fname h))->     toIvorS (RMetavar n) = return $ Metavar (toIvorName n)->     toIvorS (RInfix file line JMEq l r) ->                 = do l' <- toIvorS l->                      r' <- toIvorS r->                      return $ Annotation (FileLoc file line) ->                                 (apply (Name Unknown (opFn JMEq)) ->                                 [Placeholder, Placeholder,l',r'])->     toIvorS (RInfix file line OpEq l r) ->                 = do l' <- toIvorS l->                      r' <- toIvorS r->                      return $ Annotation (FileLoc file line)->                                 (apply (Name Unknown (opFn OpEq))->                                 [Placeholder,l',r'])->     toIvorS (RInfix file line op l r) ->                 = do l' <- toIvorS l->                      r' <- toIvorS r->                      return $ Annotation (FileLoc file line)->                               (apply (Name Unknown (opFn op)) [l',r'])->     toIvorS (RDo dos) = do tm <- undo ui dos->                            toIvorS tm->     toIvorS (RReturn f l)->       = do let (UI _ _ ret retImpl _ _ _ _) = ui->            toIvorS $ mkApp f l (RVar f l ret Unknown) (take retImpl (repeat RPlaceholder))->     toIvorS (RIdiom tm) = do let tm' = unidiom ui tm->                              toIvorS tm'->     toIvorS (RPure t) = toIvorS t->     toIvorS RRefl = return $ apply (Name Unknown (name "refl")) [Placeholder]->     toIvorS (RError f l x) = error (f ++ ":" ++ show l ++ ":" ++ x)->     toIvorS x = error ("Can't happen, toIvorS: " ++ show x)-->     mkName (UN n) i = UN (n++"_"++show i)->     mkName (MN n j) i = MN (n++"_"++show i) j--> toIvorConst (Num x) = Constant x-> toIvorConst (Str str) = Constant str-> toIvorConst (Bo True) = Name Unknown (name "true")-> toIvorConst (Bo False) = Name Unknown (name "false")-> toIvorConst (Ch c) = Constant c-> toIvorConst (Fl f) = Constant f-> toIvorConst TYPE = Star-> toIvorConst LTYPE = LinStar-> toIvorConst StringType = Name Unknown (name "String")-> toIvorConst IntType = Name Unknown (name "Int")-> toIvorConst FloatType = Name Unknown (name "Float")-> toIvorConst CharType = Name Unknown (name "Char")-> toIvorConst PtrType = Name Unknown (name "Ptr")-> toIvorConst (Builtin ty) = Name Unknown (name ty)--Convert a raw term to an ivor term, adding placeholders--> makeIvorTerm :: Implicit -> UndoInfo -> UserOps -> Id -> Ctxt IvorFun -> RawTerm -> ViewTerm-> makeIvorTerm using ui uo n ctxt tm ->                  = let expraw = addPlaceholders ctxt using uo tm in->                                 toIvor uo ui n expraw--Apply syntax macros, and fixity declarations. -Assume they are terminating (perhaps check this by not-allowing recursion in them).--> syntax :: Ctxt IvorFun -> Implicit -> UserOps -> RawTerm -> RawTerm-> syntax ctxt using (UO uo _ _ syns) tm ->   = let ans = shiftimpl (syn (fixes tm)) in->        -- trace ("BEFORE: " ++ showImp False (fixes tm) ++ "\nAFTER: " ++->         --      showImp False ans) ->         ans->     where syn (RVar f l n _) = doSynN f l n syns->           syn app@(RApp file line f a) ->                   = doSyn (RApp file line (syn f) (syn a)) ->                            syns (syn f) [syn a]->           syn (RAppImp file line n f a) = RAppImp file line n (syn f) (syn a)->           syn (RBind n (Pi p opts t) sc)->               = RBind n (Pi p opts (syn t)) (syn sc)->           syn (RBind n (Lam t) sc)->               = RBind n (Lam (syn t)) (syn sc)->           syn (RBind n (RLet v t) sc)->               = RBind n (RLet (syn v) (syn t)) (syn sc)->           syn (RInfix f l op x y)->               = RInfix f l op (syn x) (syn y)->           syn (RUserInfix file line b op l r)->               = RUserInfix file line b op (syn l) (syn r)->               -- = RUserInfix f l b op (syn x) (syn y)->           syn (RDo ds) = RDo $ map synd ds->           syn (RIdiom t) = RIdiom (syn t)->           syn (RPure t) = RPure (syn t)->           syn t = t-->           synd (DoBinding f l n x y) ->                = DoBinding f l n (syn x) (syn y)->           synd (DoLet f l n x y) ->                = DoLet f l n (syn x) (syn y)->           synd (DoExp f l x) ->                = DoExp f l (syn x)-->           doSyn o syns (RApp _ _ f a) args = doSyn o syns f (a:args)->           doSyn o syns v args ->                = case v of->                      RVar f l n _ -> ->                        case findSyn n syns of->                          Just (a, rhs) -> -- trace (show (n, rhs, a, args)) $ ->                              if (length a == length args)->                                 then syn $ replSyn f l rhs (zip a args)->                                 else o->                          Nothing -> o->                      _ -> o-->           doSynN f l n syns = case findSyn n syns of->                             Just ([], rhs) -> syn $ replSyn f l rhs []->                             _ -> RVar f l n Unknown-->           findSyn n synct =->               case ctxtLookup synct (thisNamespace using) n of->                 (Right (Syntax f as rhs)) -> Just (as, rhs)->                 (Left err) -> Nothing -- FIXME: need to report an error->                                       -- if it's ambiguous-->           -- findSyn n [] = Nothing->           -- findSyn n ((Syntax f as rhs):xs) | n == f = Just (as, rhs)->           --                                  | otherwise = findSyn n xs-->           replSyn f l t@(RVar _ _ n ty) as = case lookup n as of->                                                Just v -> v->                                                Nothing -> RVar f l n ty->           replSyn f l (RApp _ _ fn a) as ->                 = RApp f l (replSyn f l fn as) (replSyn f l a as)->           replSyn f l (RInfix _ _ op x y) as ->                 = RInfix f l op (replSyn f l x as) (replSyn f l y as)->           replSyn f l (RUserInfix _ _ b op x y) as ->                 = RUserInfix f l b op (replSyn f l x as) (replSyn f l y as)->           replSyn f l (RAppImp _ _ x fn a) as->                 = RAppImp f l x (replSyn f l fn as) (replSyn f l a as)->           replSyn f l (RBind n b t) as->                 = RBind n (replBind f l b as) ->                           (replSyn f l t (filter (\ (x,_) -> x /= n) as))->           replSyn _ _ x _ = x-->           replBind f l (Pi p os t) as = Pi p os (replSyn f l t as)->           replBind f l (Lam t) as = Lam (replSyn f l t as)->           replBind f l (RLet v t) as = RLet (replSyn f l v as) (replSyn f l t as)-->           fixes fix@(RUserInfix _ _ _ _ _ _) =->               case fixFix uo fix of->                 (RUserInfix file line _ op l r) ->->                    fixes (RApp file line ->                           (RApp file line ->                            (RVar file line (useropFn op) Free) l) r)->                 (RError f l x) -> RError f l x->           fixes (RApp file line f a) = RApp file line (fixes f) (fixes a)->           fixes (RAppImp file line n f a) ->                     = RAppImp file line n (fixes f) (fixes a)->           fixes (RBind n (Lam t) sc) = RBind n (Lam (fixes t)) (fixes sc)->           fixes (RBind n (Pi p opts t) sc)->                 = RBind n (Pi p opts (fixes t)) (fixes sc)->           fixes (RBind n (RLet v t) sc)->                 = RBind n (RLet (fixes v) (fixes t)) (fixes sc)->           fixes (RInfix file line op l r)->                 = RInfix file line op (fixes l) (fixes r)->           fixes (RIdiom t) = RIdiom (fixes t)->           fixes (RPure t) = RPure (fixes t)->           fixes (RDo d) = RDo (map fixesd d)->           fixes t = t-->           fixesd (DoBinding f l n x y) = DoBinding f l n (fixes x) (fixes y)->           fixesd (DoLet f l n x y) = DoLet f l n (fixes x) (fixes y)->           fixesd (DoExp f l x) = DoExp f l (fixes x)-->           shiftimpl x = let (imps, t) = simp [] x in->                         pibind Im (reverse imps) t->           simp imps (RBind n (Pi Im _ t) sc) ->                 = simp ((n,t):imps) sc->           simp imps (RBind n (Pi p o t) sc) ->                 = let (imps', sc') = simp imps sc in->                       (imps', RBind n (Pi p o t) sc')->           simp imps x = (imps, x)--> syntaxClause :: Ctxt IvorFun -> Implicit -> UserOps -> RawClause ->->                 RawClause-> syntaxClause ctxt imp uo (RawClause l r)->      = (RawClause (syntax ctxt imp uo l)->                   (syntax ctxt imp uo r))-> syntaxClause ctxt imp uo (RawWithClause lhs prf scr def)->      = (RawWithClause (syntax ctxt imp uo lhs) prf->                       (syntax ctxt imp uo scr)->                       (map (syntaxClause ctxt imp uo) def))--Add placeholders so that implicit arguments can be filled in. Also desugar user infix apps.-FIXME: I think this'll fail if names are shadowed.--> addPlaceholders :: Ctxt IvorFun -> Implicit -> UserOps -> RawTerm -> RawTerm-> addPlaceholders ctxt using uops@(UO uo _ _ syns) tm ->                     = ap [] (syntax ctxt using uops tm)->     -- Count the number of args we've made explicit in an application->     -- and don't add placeholders for them. Reset the counter if we get->     -- out of an application->     where ap ex v@(RVar f l n _)->            = case ctxtLookupName ctxt (thisNamespace using) n of->                   -- leave syntax definitions alone and expand later->                   Right (IvorFun _ _ _ _ (SynDef _ _ _) _ _ _, _)->                       -> RVar f l n Unknown->                   Right (ifn@(IvorFun _ (Just ty) imp _ _ _ _ _), fulln) -> ->                     let pargs = case lookup n pnames of->                                   Nothing -> []->                                   Just ids -> map (\i -> RVar f l i Bound) ids in->                     mkApp f l (RVar f l fulln (getNameType ifn))->                               ((mkImplicitArgs ->                                (map fst (fst (getBinders ty []))) imp ex) ++ pargs)->                   Left err@(Ambiguous _ ns) -> RError f l (show err) -- RVars f l ns->                   Left err@(WrongNamespace _ _) -> RError f l (show err)->                   Right (ifn, fulln) -> RVar f l fulln (getNameType ifn)->                   _ -> RVar f l n Unknown->           ap ex (RExpVar f l n)->               = case ctxtLookupName ctxt (thisNamespace using) n of->                   Right (ifn@(IvorFun _ (Just ty) imp _ _ _ _ _), fulln) -> RVar f l fulln (getNameType ifn)->                   Left err@(Ambiguous _ _) -> RError f l (show err)->                   Left err@(WrongNamespace _ _) -> RError f l (show err)->                   Right (ifn, fulln) -> RVar f l fulln (getNameType ifn)->                   _ -> RVar f l n Unknown->           ap ex (RAppImp file line n f a) = (ap ((toIvorName n,(ap [] a)):ex) f)->           ap ex app@(RApp file line f a) = ->                   RApp file line (ap ex f) (ap [] a)->           ap ex (RBind n (Pi p l ty) sc)->               = RBind n (Pi p l (ap [] ty)) (ap [] sc)->           ap ex (RBind n (Lam ty) sc)->               = RBind n (Lam (ap [] ty)) (ap [] sc)->           ap ex (RBind n (RLet val ty) sc)->               = RBind n (RLet (ap [] val) (ap [] ty)) (ap [] sc)->           ap ex (RInfix file line op l r) = RInfix file line op (ap [] l) (ap [] r)->           ap ex fix@(RUserInfix file line _ op l r)->               = -- case fixFix uo fix of->                 --  (RUserInfix file line _ op l r) ->->                 ap ex (RApp file line ->                              (RApp file line (RVar file line (useropFn op) Free) l) r)->                 --  (RError f l x) -> RError f l x->           ap ex (RDo ds) = RDo (map apdo ds)->           ap ex (RIdiom tm) = RIdiom (ap [] tm)->           ap ex (RPure tm) = RPure (ap [] tm)->           ap ex r = r-->           apdo (DoExp f l r) = DoExp f l (ap [] r)->           apdo (DoBinding file line x t r) = DoBinding file line x (ap [] t) (ap [] r)->           apdo (DoLet file line x t r) = DoLet file line x (ap [] t) (ap [] r)-->           pnames = paramNames using--Go through the arguments; if an implicit argument has the same name as one-in our list of explicit names to add, add it.--> mkImplicitArgs :: [Name] -> Int -> [(Name, RawTerm)] -> [RawTerm]-> mkImplicitArgs _ 0 _ = [] -- No more implicit-> mkImplicitArgs [] i ns = [] -- No more args-> mkImplicitArgs (n:ns) i imps->      = case lookup n imps of->          Nothing -> RPlaceholder:(mkImplicitArgs ns (i-1) imps)->          Just v -> v:(mkImplicitArgs ns (i-1) imps)--> getBinders (Forall n ty sc) acc = (getBinders sc ((n,ty):acc))-> getBinders (Annotation _ t) acc = getBinders t acc-> getBinders sc acc = (reverse acc, sc)---> undo :: UndoInfo -> [Do] -> State (Int, Int) RawTerm-> undo ui [] = fail "The last statement in a 'do' block must be an expression"-> undo ui [DoExp f l last] = return last-> undo ui@(UI bind bindimpl _ _ _ _ _ _) ((DoBinding file line v' ty exp):ds)->          = -- bind exp (\v' . [[ds]])->            do ds' <- undo ui ds->               let k = RBind v' (Lam ty) ds'->               return $ mkApp file line (RVar file line bind Unknown) ->                          ((take bindimpl (repeat RPlaceholder)) ++ [exp, k])-> undo ui ((DoLet file line v' ty exp):ds)->          = do ds' <- undo ui ds->               return $ RBind v' (RLet exp ty) ds'-> undo ui@(UI bind bindimpl _ _ _ _ _ _) ((DoExp file line exp):ds)->          = -- bind exp (\_ . [[ds]])->            do ds' <- undo ui ds->               (i, h) <- get->               put (i+1, h)->               let k = RBind (MN "x" i) (Lam RPlaceholder) ds'->               return $ mkApp file line (RVar file line bind Unknown) ->                          ((take bindimpl (repeat RPlaceholder)) ++ [exp, k])---- > unret :: UndoInfo -> RawTerm -> RawTerm--- > unret (UI _ _ ret retImpl _ _ _ _) (RApp f l (RVar _ _ (UN "return")) arg)--- >       = mkApp f l (RVar f l ret) ((take retImpl (repeat RPlaceholder)) ++ [arg])--- > unret ui (RApp f l x a) = RApp f l (unret ui x) (unret ui a)--- > unret ui (RAppImp f l n x a) = RAppImp f l n (unret ui x) (unret ui a)--- > unret ui (RInfix f l op x y) = RInfix f l op (unret ui x) (unret ui y)--- > unret ui (RBind n (Pi pl z tm) sc) = RBind n (Pi pl z (unret ui tm)) (unret ui sc)--- > unret ui (RBind n (Lam tm) sc) = RBind n (Lam (unret ui tm)) (unret ui sc)--- > unret ui (RBind n (RLet tm ty) sc) = RBind n (RLet (unret ui tm) (unret ui ty)) (unret ui sc)--- > unret ui (RUserInfix f l b n x y) = RUserInfix f l b n (unret ui x) (unret ui y)--- > unret ui (RIdiom tm) = RIdiom (unret ui tm)--- > unret ui (RPure tm) = RPure (unret ui tm)--- > unret ui x = x--TODO: Get names out of UndoInfo--> unidiom :: UndoInfo -> RawTerm -> RawTerm-> unidiom ui@(UI _ _ _ _ pure pureImpl _ _) (RApp file line f (RPure x)) ->         = mkApp file line (RVar file line pure Unknown)->                ((take pureImpl (repeat RPlaceholder)) ++ [mkApp file line f [x]])-> unidiom ui@(UI _ _ _ _ pure pureImpl _ _) (RApp file line f RPlaceholder) ->         = mkApp file line (RVar file line pure Unknown)->                ((take pureImpl (repeat RPlaceholder)) ++ [mkApp file line f [RPlaceholder]])-> unidiom ui@(UI _ _ _ _ _ _ ap apImpl) (RApp file line f x) ->              = mkApp file line (RVar file line ap Unknown)->                     ((take apImpl (repeat RPlaceholder)) ++->                     [unidiom ui f, x])-> unidiom ui@(UI _ _ _ _ pure pureImpl _ _) x ->              = let (file, line) = getFileLine x in->               mkApp file line (RVar file line pure Unknown)->                     ((take pureImpl (repeat RPlaceholder)) ++ [x])--> testCtxt = addEntry newCtxt [] (UN "Vect") undefined--> dump :: Ctxt IvorFun -> String-> dump ctxt = concat $ map dumpFn (ctxtAlist ctxt)->   where dumpFn (_,IvorFun n ty imp def _ _ _ _) =->             show n ++ " : " ++ show ty ++ "\n" ++->             "   " ++ show imp ++ " implicit\n" ++->             show def ++ "\n\n"--> mkRName n = UN (show n)--> getOp v allops ->     = let ops = mapMaybe (\x -> if opFn x == v ->                                 then Just x ->                                 else Nothing) allops->          in if null ops then Nothing->                         else Just (head ops)--Convert an ivor term back to a raw term, for pretty printing purposes.-Use the context to decide which arguments to make implicit--FIXME: If a name is bound locally, don't add implicit args.--> unIvor :: Ctxt IvorFun -> ViewTerm -> RawTerm-> unIvor ctxt tm = unI tm [] where--Built-in constants firsts-->     unI (Name _ v) []->         | v == name "Int" = RConst "[val]" 0 IntType->         | v == name "String" = RConst "[val]" 0 StringType->     unI (Name _ v) [x,y]->         | v == name "refl" = RApp "[val]" 0 RRefl y--Now built-in operators-->     unI (Name _ v) [_,_,x,y]->         | v == opFn JMEq = RInfix "[val]" 0 JMEq x y->     unI (Name _ v) [_,x,y]->         | v == opFn OpEq = RInfix "[val]" 0 OpEq x y->     unI (Name _ v) [x,y]->         | Just op <- getOp v allOps = RInfix "[val]" 0 op x y->     unI (Name _ v) args ->        = case ctxtLookup ctxt [] (mkRName v) of->            Right fdata -> mkImpApp "[val]" 0 (implicitArgs fdata) ->                                   (argNames (ivorFType fdata)) (RVar "[val]" 0 (mkRName v) Unknown) args->            _ -> unwind (RVar "[val]" 0 (mkRName v) Unknown) args->     unI (App f a) args = unI f ((unI a []):args)->     unI (Lambda v ty sc) args = unwind (RBind (mkRName v) (Lam (unI ty [])) (unI sc [])) args->     unI (Forall v ty sc) args = unwind (RBind (mkRName v) (Pi Ex [] (unI ty [])) (unI sc [])) args->     unI (Let v ty val sc) args = unwind (RBind (mkRName v) ->                                          (RLet (unI val []) (unI ty [])) ->                                          (unI sc [])) args->     unI Star [] = RConst "[val]" 0 TYPE->     unI LinStar [] = RConst "[val]" 0 LTYPE->     unI (Constant c) [] = let try f = fmap (RConst "[val]" 0 . f) $ cast c->                           in  fromJust $ msum [try Num, try Str, try Ch, try Fl]->     unI (Annotation _ x) args = unI x args->     unI (Metavar n) args = RMetavar (mkRName n)->     unI Placeholder args = RPlaceholder->     unI x args = error (show x)-->     unwind = mkImpApp "[val]" 0 0 []--> argNames :: Maybe ViewTerm -> [Id]-> argNames Nothing = []-> argNames (Just ty) = an ty where->     an (Forall n ty sc) = (mkRName n):(an sc)->     an (Annotation _ t) = an t->     an x = []--> mkImpApp :: String -> Int -> Int -> [Id] -> RawTerm -> [RawTerm] -> RawTerm-> mkImpApp file line i (n:ns) tm (a:as) ->      | i>0 = mkImpApp file line (i-1) ns (RAppImp file line n tm a) as->      | otherwise = mkImpApp file line 0 ns (RApp file line tm a) as-> mkImpApp file line _ _ tm (a:as) = mkImpApp file line 0 [] (RApp file line tm a) as-> mkImpApp _ _ _ _ tm _ = tm---Show a raw term; either show or hide implicit arguments according to-boolean flag (true for showing them)--> showImp :: Bool -> RawTerm -> String-> showImp imp tm = showP 10 tm where->     showP p (RVar _ _ (UN "__Unit") _) = "()"->     showP p (RVar _ _ (UN "__Empty") _) = "_|_"->     showP p (RVar _ _ i _) = case (getOpName i) of->                                (True, o) -> "(" ++ o ++ ")"->                                (False, o) -> o->     showP p RRefl = "refl"->     showP p (RApp _ _ f a) = bracket p 1 $ showP 1 f ++ " " ++ showP 0 a->     showP p (RAppImp _ _ n f a)->           | imp = bracket p 1 $ showP 1 f ++ " {"++show n ++ " = " ++ showP 0 a ++ "} "->           | otherwise = showP 1 f->     showP p (RBind n (Lam ty) sc)->           = bracket p 2 $ ->             "\\ " ++ show n ++ " : " ++ showP 10 ty ++ " => " ++ showP 10 sc->     showP p (RBind n (Pi im _ ty) sc)->           | internal n && not imp -- hack for spotting unused names quickly!->              = bracket p 2 $ showP 1 ty ++ " -> " ++ showP 10 sc->           | otherwise->              = bracket p 2 $->                ob im ++ show n ++ " : " ++ showP 10 ty ++ cb im ++ " -> " ++->                showP 10 sc->        where ob Im = "{"->              ob Ex = "("->              cb Im = "}"->              cb Ex = ")"->              internal (UN ('_':'_':_)) = True->              internal (MN _ _) = True->              internal _ = False->     showP p (RBind n (RLet val ty) sc)->           = bracket p 2 $->             "let " ++ show n ++ " : " ++ showP 10 ty ++ " = " ++ showP 10 val->                    ++ " in " ++ showP 10 sc->     showP p (RConst _ _ c) = show c->     showP p (RInfix _ _ op l r) = bracket p 5 $->                                   showP 4 l ++ show op ++ showP 4 r->     showP _ x = show x->     bracket outer inner str | inner>outer = "("++str++")"->                             | otherwise = str--> showVT :: Ctxt IvorFun -> ViewTerm -> String-> showVT ivs t = showImp False (unIvor ivs t)--If we haven't got a line number for an error message, pick where the definition-starts as a best guess.--> guessContext :: IvorFun -> TTError -> TTError-> guessContext _ e@(ErrContext _ _) = e-> guessContext ifn e = case (ivorFType ifn) of->                        Just (Annotation (FileLoc f l) _) ->->                            ErrContext (f ++ ":" ++ show l ++ ":") e->                        _ -> e -- ErrContext (show (ivorFType ifn)) e--> idrisError :: Ctxt IvorFun -> TTError -> String-> idrisError ivs (CantUnify x y) = "Can't unify " ++ (showVT ivs x) ++ " and " ++ ->                                                    (showVT ivs y)-> idrisError ivs (Message str) = str-> idrisError ivs (Unbound clause clty rhs rhsty names) ->                = "Unbound names in " ++ showVT ivs rhs ++ ->                  " : " ++ showVT ivs clty ++->                  "  " ++ show names-> idrisError ivs (NoSuchVar n) = "No such variable as " ++ show n-> idrisError ivs (CantInfer n tm) = "Can't infer value for " ++ show n ++ " in " ++ (showVT ivs tm)-> idrisError ivs (ErrContext s e) = s ++ idrisError ivs e-> idrisError ivs (AmbiguousName ns) = "Ambiguous name " ++ show ns-> idrisError ivs (NotConvertible x y) = "Not convertible: " ++ (showVT ivs x) ++ " and " ++ (showVT ivs y)---> getOpName (UN ('_':'_':'o':'p':'_':op)) = (True, showOp op) where->          showOp ('_':cs) = case span isDigit cs of->                               (op, rest) -> toEnum (read op) : showOp rest->          showOp _ = ""-> getOpName s = (False, show s)--Correct the precedences in a user defined infix operator term using Dijkstra's-Shunting Yard algorithm.--> fixFix :: Fixities -> RawTerm -> RawTerm-> fixFix ops top@(RUserInfix f l b op x y) ->            = let toks = tok top ->                  shunted = shunt ops [] toks in->                  rebuild [] shunted-> fixFix ops x = x--> data OpTok = Op String Int String->            | OTm RawTerm->            | OpenB->            | CloseB->   deriving Show--> tok (RUserInfix f l False op x y) ->         = tok x ++ ((Op f l op):tok y)-> tok (RUserInfix f l True op x y) ->         = OpenB:(tok x ++ (Op f l op):tok y) ++ [CloseB]-> tok x = [OTm x]--> shunt :: Fixities -> [OpTok] -> [OpTok] -> [OpTok]-> shunt ops stk (OTm x:toks) = OTm x:(shunt ops stk toks)-> shunt ops stk (op@(Op f l _):toks) ->           = let (stk', out) = prec [] stk op in->                 out ++ shunt ops stk' toks->    where prec out (op2@(Op f2 l2 o2):opstk) op1@(Op f1 l1 o1)->              = case (lookup o1 ops, lookup o2 ops) of->                   (Just (LeftAssoc, prec1), Just (assoc2, prec2))->                      -> if (prec1<=prec2) then ->                               prec (op2:out) opstk op1->                             else ->                               (op1:op2:opstk, reverse out)->                   (Just (RightAssoc, prec1), Just (assoc2, prec2))->                      -> if (prec1<prec2) then ->                               prec (op2:out) opstk op1->                             else ->                               (op1:op2:opstk, reverse out)->                   (Nothing, Nothing) -> (opstk, OTm (RError f1 l1 (":unknown operators " ++ show o1 ++ " and " ++ show o2)):out)->                   (Nothing, _) -> (opstk, OTm (RError f1 l1 (":unknown operator " ++ show o1)):out)->                   (_, Nothing) -> (opstk, OTm (RError f2 l2 (":unknown operator " ++ show o2)):out)->          prec out opstk op1 = (op1:opstk, reverse out)--> shunt ops stk (OpenB:toks) = shunt ops (OpenB:stk) toks-> shunt ops stk (CloseB:toks) = let (stk',out) = popToLeft [] stk in->                                   out ++ shunt ops stk' toks->    where popToLeft out (OpenB:stk) = (stk, reverse out)->          popToLeft out (x:stk) = popToLeft (x:out) stk->          popToLeft out [] = error "Can't happen, no left paren"-> shunt ops (x:stk) [] = x:(shunt ops stk [])-> shunt ops [] [] = []--> rebuild :: [RawTerm] -> [OpTok] -> RawTerm-> rebuild stk (OTm x:xs) = rebuild (x:stk) xs-> rebuild (x:y:stk) (Op f l op:xs) ->       = rebuild ((RUserInfix f l True op y x):stk) xs-> rebuild (x:[]) [] = x-> rebuild stk xs = error $ "Can't happen: rebuild " ++ show (stk, xs)--Old version:---Only need to worry if the left term is not bracketed. Otherwise leave it alone.-Also need to sort out inner ops first.-- fixFix ops top@(RUserInfix f l b op x y)-     = let fixed = fixFix' ops top in -- (RUserInfix f l b op x y)-           if (fixed==top) then fixed else fixFix ops fixed- fixFix ops x = x------> fixFix' ops top@(RUserInfix file line _ opr ->                 (RUserInfix _ _ False opl a b) c) = ->     case (lookup opl ops, lookup opr ops) of->       (Just (assocl, precl), Just (assocr, precr)) ->->         doFix assocl precl assocr precr a opl b opr c->       (Nothing, Nothing) -> RError file line $ ":unknown operators " ++ show opl ++ " and " ++ show opr->       (Nothing, _) -> RError file line (":unknown operator " ++ show opl)->       (_, Nothing) -> RError file line (":unknown operator " ++ show opr)->  where->    doFix al pl ar pr a opl b opr c ->          | pr > pl = mkOp False opl (fixFix' ops a) (fixFix' ops (mkOp False opr b c))->          | pr < pl = mkOp False opr (fixFix' ops (mkOp False opl a b)) (fixFix' ops c)--In the following cases, change the top level operator, put explicit brackets in, then-rewrite the whole thing again. Termination guaranteed since the size of the expression-we check (i.e. the non-bracketed part) is smaller.-->          | pr == pl && al == LeftAssoc && ar == LeftAssoc->                    = fixFix ops $ mkOp False opr (mkOp True opl a b) c->          | pr == pl && al == RightAssoc && ar == RightAssoc->                    = fixFix ops $ mkOp False opl a (mkOp True opr b c)->          | otherwise = RError file line $ ":ambiguous operators, please add brackets"-->    mkOp t op l r = RUserInfix file line t op l r---Everything else, we ony work at the top level.--> fixFix' _ x = x--> (!!!) xs (x, msg) = if x >= length xs then error msg else xs!!x
− Idris/Compiler.lhs 
@@ -1,396 +0,0 @@-> module Idris.Compiler(comp, addTransforms) where--> import Idris.AbsSyntax-> import Idris.PMComp-> import Idris.LambdaLift-> import Idris.ConTrans-> import Idris.SCTrans-> import Idris.Lib-> import Ivor.TT hiding (transform, SimpleCase(..), CaseAlt(..))--> import System-> import System.IO-> import System.Environment-> import System.Directory-> import Monad-> import Debug.Trace--Get every definition from the context. Convert them all to simple case-trees. Ignore constructors, types, etc. Simple definitions are, of course, -already simple case trees.--> addTransforms :: IdrisState -> Context -> IdrisState-> addTransforms ist ctxt ->      = let raw = idris_context ist->            erasure = not $ NoErasure `elem` (idris_options ist) ->            ctrans = makeConTransforms raw ctxt->            atrans = makeArgTransforms raw ctxt ctrans->            trans = if erasure then makeIDTransforms raw ctxt atrans->                       else [] in->              ist { idris_transforms = trans }--> comp :: IdrisState -> Context -> Id -> FilePath -> IO Bool-> comp ist ctxt nm ofile ->          = do let raw = idris_context ist->               let decls = idris_decls ist->               let erasure = not $ NoErasure `elem` (idris_options ist)->               let pdefs = getCompileDefs raw ctxt->               let trans = idris_transforms ist->               let vtrans = transforms (idris_fixities ist)->               let pcomp = map (pmCompDef raw ctxt erasure trans vtrans) pdefs->               let declouts = filter (/="") (map epicDecl decls)->               let clink = filter (/="") (map epicLink decls)->               -- dumpNames pcomp->               let scs = map (\ (n, inl, sc) -> (n, inl, transformSC erasure sc)) ->                           $ allSCs pcomp->               catch (do compileAll raw ctxt ofile erasure clink declouts scs->                         return True)->                     (\e -> do putStrLn "Compilation error"->                               print e->                               return False)->    where allSCs [] = []->          allSCs ((x,gen,(args,def)):xs) ->                       = -- trace (show (x,args)) $->                         let lifted = lambdaLift ctxt ist x args def->                             scfuns = map (\ (n,args,sc) -> ->                                          (n, scFun ctxt ist (fromIvorName ist n) args sc)) lifted->                             xs' = allSCs xs in->                             mkGen gen scfuns ++ xs'->          mkGen gen ((n, d):ds) = (n,gen,d):(mkGen True ds)->          mkGen gen [] = []--Convert top level declarations to epic output.-This is just for the directives to link in C headers, .o file, etc.--> epicDecl :: Decl -> String-> epicDecl (CInclude i) = "%include " ++ show i-> epicDecl _ = ""--> epicLink :: Decl -> String-> epicLink (CLib l) = l-> epicLink _ = ""--Get all the definitions we want to compile (i.e., skipping NoCG ones)--Get the user specified pattern definition, if it exists, not the Ivor-expanded one (i.e. with the placeholders as the user specified) so-that we avoid pattern matching where the programmer didn't ask us to.--> getCompileDefs :: Ctxt IvorFun -> Context -> [(Name, (ViewTerm, Patterns))]-> getCompileDefs raw ctxt = defs' [] (ctxtAlist raw) ->    where alldefs = map getOrig (getAllPatternDefs ctxt)->          defs' acc [] = dropAll acc alldefs->          defs' acc ((n,ifun):ds) ->              = let flags = funFlags ifun ->                    inm = toIvorName n in->                case (NoCG `elem` flags) of->                     True -> {- trace ("Not compiling " ++ show n) -}->                                defs' (inm:acc) ds->                     _ -> defs' acc ds->          dropAll drops [] = []->          dropAll drops ((n,def):ds) | n `elem` drops = dropAll drops ds->                                     | otherwise = (n,def):(dropAll drops ds)->          getOrig (n, (ty, ps)) = (n, (ty, ps))--                  = case ctxtLookup raw (mkRName n) of-                      (Just ifun) ->-                          case (ivorDef ifun) of-                            PattDef ps' -> (n, (ty, (mergePats ps ps')))-                            _ -> (n, (ty, ps))-                      _ -> (n, (ty, ps))--> mergePats :: Patterns -> Patterns -> Patterns-> mergePats (Patterns ps) (Patterns ps') = Patterns (mp ps ps')->   where->     mp [] [] = []->     mp ((PClause a _ r):ps) ((PClause a' _ r'):ps') =->             (PClause a' [] r):(mp ps ps')--> pmCompDef :: Ctxt IvorFun -> Context -> ->              Bool -> -- erasure on->              [Transform] -> -- optimisations->              [(ViewTerm, ViewTerm)] -> -- user level transforms->              (Name, (ViewTerm, Patterns)) -> ->              (Name, Bool, ([Name], SimpleCase))-> pmCompDef raw ctxt erase ctrans vtrans (n, (ty,ps)) -> --    = let flags = getFlags n raw in-> --          case ((NoCG `elem` flags), (CGEval `elem` flags)) of -> --             (True, _) -> trace ("Not compiling " ++ show n) (n, [])-> --             (False, False)e -> ->       =  let transpm = transform ctxt ctrans vtrans n ps ->              gen = isAuxPattern ctxt n->              compiledp = pmcomp raw ctxt erase n ty transpm in->              -- trace (if n == name "copyRecInt" then show n ++ "\n" ++ show compiledp else "")->              (n, gen, compiledp)--     where getFlags n raw = case ctxtLookup raw n of-                              Just i -> funFlags i-                              Nothing -> []---> compileAll :: Ctxt IvorFun -> Context -> FilePath -> Bool ->->               [String] -> -- options to pass to epic->               [String] -> -- raw epic output->               [(Name, Bool, SCFun)] -> IO ()-> compileAll raw ctxt ofile erasure clink outputs scs = do->      (efile, eH) <- tempfile->      prel <- readLibFile defaultLibPath "Prelude.e"->      hPutStrLn eH prel->      mapM_ (hPutStrLn eH) outputs->      -- dumpNames scs->      mapM_ (writeDef eH erasure) scs->      hClose eH->      let cmd = "epic " ++ efile ++ " -o " ++ ofile ++->                " -checking 0 " ++ ->                concat (map (' ':) clink) ->      -- putStrLn cmd->      exit <- system cmd->      -- removeFile efile->      if (exit /= ExitSuccess) ->         then fail "EPIC FAIL"->         else return ()--> quotename [] = ""-> quotename ('[':cs) = "_OB_"++quotename cs-> quotename (']':cs) = "_CB_"++quotename cs-> quotename ('.':cs) = "_NS_"++quotename cs-> quotename (c:cs) = c:(quotename cs)--> dumpNames [] = return ()-> dumpNames (x:xs) = do putStr "Name: "->                       putStrLn ((\ (a, b, c) -> show a) x)->                       dumpNames xs--> writeDef :: Handle -> Bool -> (Name, Bool, SCFun) -> IO ()-> writeDef h erasure (n,gen,(SCFun scopts args def)) = do->   -- putStrLn $ "Writing " ++ show n->   when (gen || elem SCInline scopts) $ hPutStr h "%inline "->   when (elem SCStrict scopts) $ hPutStr h "%strict "->   maybe (return ()) (\ c -> hPutStrLn h ("export " ++ show c ++ " ")) (getEName scopts)->   hPutStrLn h (quotename (show n) ++ " (" ++ list args ++ ") -> Any = \n" ++->                writeSC n erasure def)->   -- putStrLn $ "Written " ++ show n->    where list [] = ""->          list [a] = quotename (show a) ++ " : Any"->          list (x:xs) = quotename (show x) ++ " : Any, " ++ list xs--Write out a constructor name, turning constructors of IO commands into-the relevant IO operation--> writeSC :: Name -> Bool -> SCBody -> String-> writeSC fname erasure b = writeSC' b where-->   list [] = ""->   list [a] = writeSC' a->   list (x:xs) = writeSC' x ++ ", " ++ list xs-->   writeSC' (SVar n) = quotename (show n)->   writeSC' (SCon n i) = writeCon n i ++ "()"->   writeSC' (SApp (SCon n i) (fn:args:[]))->     | n == ionamei "Foreign" = writeFCall fn erasure args fname->   writeSC' (SApp (SCon n i) (_:args))->     | n == ionamei "WhileAcc" = writeCon n i ++ "(" ++ list args ++ ")"->   writeSC' (SApp (SCon n i) args) = writeCon n i ++ "(" ++ list args ++ ")"--Fork is a special case, because its argument needs to be evaluated lazily-or it'll be evaluated by the time we run the thread!-->   writeSC' (SApp (SVar n) [arg])->     | n == name "fork" =->         "fork(lazy("++writeSC' arg++"))"--TMP HACK until we do coercions on primitives properly-->     | n == name "__toInt" =->         "__epic_toInt(" ++ writeSC' arg ++ ")"->     | n == name "__toString" =->         "__epic_toString(" ++ writeSC' arg ++ ")"->     | n == name "__floatToString" =->         "__epic_floatToString(" ++ writeSC' arg ++ ")"->     | n == name "__stringToFloat" =->         "__epic_stringToFloat(" ++ writeSC' arg ++ ")"->     | n == name "__charToInt" =->         writeSC' arg->     | n == name "__intToChar" =->         writeSC' arg->     | n == name "__strlen" =->         "__epic_strlen(" ++ writeSC' arg ++ ")"->     | n == name "unsafeNative" =->         "__epic_native(" ++ writeSC' arg ++ ")"--HACK for explicit laziness, and marking effectfullness-->   writeSC' (SApp (SVar lazy) [_,v])->     | lazy == name "__lazy" =->         "lazy(" ++ writeSC' v ++ ")"->   writeSC' (SApp (SVar effect) [_,v])->     | effect == name "__effect" =->         "%effect(" ++ writeSC' v ++ ")"--Manual allocation-->   writeSC' (SApp (SVar malloc) [_,b,v])->     | malloc == name "malloc" =->         "%memory(%fixed," ++ writeSC' b ++ "," ++ writeSC' v ++ ")"--Epic has if/then/else, so just use that-->   writeSC' (SApp (SVar ite) [_,v,SLazy t,SLazy e])->     | ite == name "if_then_else" =->         writeSC' (SIf v t e)->   writeSC' (SApp (SVar ite) [_,v,t,e])->     | ite == name "if_then_else" =->         writeSC' (SIf v t e)-->   writeSC' (SApp (SVar n) [arg1, arg2, arg3])->     | n == name "__substr" =->         "__epic_substr("++writeSC' arg1++", " ++ writeSC' arg2 ++ ", " ++->                           writeSC' arg3 ++ ")"--HACK for string equality-->   writeSC' (SApp (SVar n) [arg1, arg2])->     | n == name "__strEq" =->         "__epic_streq("++writeSC' arg1++", " ++ writeSC' arg2 ++ ")"->     | n == name "__charEq" =->         "__epic_chareq("++writeSC' arg1++", " ++ writeSC' arg2 ++ ")"->     | n == name "__strLT" =->         "__epic_strlt("++writeSC' arg1++", " ++ writeSC' arg2 ++ ")"-->     | n == name "__strCons" =->         "__epic_strcons("++writeSC' arg1++", " ++ writeSC' arg2 ++ ")"->     | n == name "__strFind" =->         "__epic_strFind("++writeSC' arg1++", " ++ writeSC' arg2 ++ ")"-->   writeSC' (SApp (SVar n) [arg1])->     | n == name "__strHead" =->         "__epic_strhead("++writeSC' arg1++ ")"->     | n == name "__strTail" =->         "__epic_strtail("++writeSC' arg1++ ")"->     | n == name "__strRev" =->         "__epic_strrev("++writeSC' arg1++ ")"-->   writeSC' (SApp b args) = "(" ++ writeSC' b ++")(" ++ list args ++ ")"->       where list [] = ""->             list [a] = writeSC' a->             list (x:xs) = writeSC' x ++ ", " ++ list xs->   writeSC' (SLet n val b) = "let " ++ quotename (show n) ++ " : Any = " ++ writeSC' val->                          ++ " in ("  ++ writeSC' b ++ ")"->   writeSC' (SCCase b alts@((SConstAlt _ _):_))->                    = writeConstAlts fname erasure (writeSC' b) alts->   writeSC' (SCCase b alts) = "case " ++ writeSC' b ++ " of { " ++ ->                              writeAlts fname erasure alts->                             ++ "}"->   writeSC' (SIf x t e) = "(if (" ++ writeSC' x ++ ") then (" ++->                          writeSC' t ++ ") else (" ++ writeSC' e ++ "))"->   writeSC' (SIfZero x t e) = "(if (" ++ writeSC' x ++ "==0) then (" ++->                          writeSC' t ++ ") else (" ++ writeSC' e ++ "))"->   writeSC' (SInfix op l r) = boolOp erasure op (writeOp op (writeSC' l) (writeSC' r))->   writeSC' (SConst c) = writeConst c->   writeSC' (SLazy b) = "lazy(" ++ writeSC' b ++ ")"->   writeSC' SUnit = "%unused"->   writeSC' SError = "error \"error\""--> writeCon :: Name -> Int -> String-> writeCon n i->   | n == ionamei "PutStr" = "__epic_putStr"->   | n == ionamei "GetStr" = "__epic_readStr"->   | n == ionamei "NewRef" = "__epic_newRef"->   | n == ionamei "ReadRef" = "__epic_readRef"->   | n == ionamei "WriteRef" = "__epic_writeRef"->   | n == ionamei "NewLock" = "__epic_newLock"->   | n == ionamei "DoLock" = "__epic_doLock"->   | n == ionamei "DoUnlock" = "__epic_doUnlock"->   | n == ionamei "Fork" = "__epic_fork"->   | n == ionamei "Within" = "__epic_within"->   | n == ionamei "While" = "%while"->   | n == ionamei "WhileAcc" = "%while"->   | otherwise = "Con " ++ show i--> writeOp Concat l r = "__epic_append(" ++ l ++", " ++ r ++")"-> writeOp op l r = "(" ++ l ++ ") " ++ show op ++ " (" ++ r ++ ")"--> boolOp erasure op c = if (not erasure) && (retBool op) then->                   "__epic_bool(" ++ c ++ ")" else c->    where retBool OpLT = True->          retBool OpEq = True->          retBool OpLEq = True->          retBool OpGT = True->          retBool OpGEq = True->          retBool _ = False--> writeAlts n e [] = ""-> writeAlts n e [a] = writeAlt n e a-> writeAlts n e (x:xs) = writeAlt n e x ++ " | " ++ writeAlts n e xs--> writeAlt n e (SAlt _ t args b) = "Con " ++ show t ++ " (" ++ list args ++ ") -> "->                                ++ writeSC n e b->    where list [] = ""->          list [a] = quotename (show a) ++ ":Any"->          list (x:xs) = quotename (show x) ++ ":Any, " ++ list xs-> writeAlt n e (SDefault b) = "Default -> " ++ writeSC n e b-> writeAlt n e _ = "Default -> error \"unhandled case in " ++ show n ++ "\""--> writeConstAlts n e b [] = "error \" unhandled case in " ++ show n ++ "\""-> writeConstAlts n e b [a] = writeConstAlt n e b a-> writeConstAlts n e b (x:xs) = writeConstAlt n e b x ++->                             " else (" ++ writeConstAlts n e b xs ++ ")"--> writeConstAlt n e b (SConstAlt (Num x) ret) ->                   = " if (" ++ b ++ " == " ++ show x ++") then ("->                        ++ writeSC n e ret ++ ") "-> writeConstAlt n e b (SConstAlt (Str x) ret) ->                   = " if (__epic_streq(" ++ b ++ ", " ++ show x ++")) then ("->                        ++ writeSC n e ret ++ ") "-> writeConstAlt n e b (SDefault ret) = writeSC n e ret--Chars are just treated as Ints by the compiler, so convert here.--> writeConst (Ch c) = show $ fromEnum c-> writeConst c = show c--> writeFCall :: SCBody -> Bool -> SCBody -> Name -> String-> writeFCall (SApp (SCon ffun _) [SConst (Str fname),argtys,retty]) e arglist topname = ->     "foreign " ++ fToEpic retty ++ " " ++ show fname ++ ->               " (" ++ build (zip (extract arglist) (extract argtys)) ++ ")"->     where build [] = ""->           build [(x,ty)] = writeSC topname e x ++ ":" ++ (fToEpic ty)->           build ((x,ty):xs) = writeSC topname e x ++ ":" ++ (fToEpic ty) ++ ->                               ", " ++ build xs--This'll work for FArgList and List, because the penultimate is always the -element and last is always the tail. Should therefore also work before and-after forcing optimisation...-->           extract (SCon _ 0) = []->           extract (SApp (SCon _ 0) _) = []->           extract (SApp (SCon _ 1) args) = (last (init args)):->                                               (extract (last args))->           extract x = error (show x)->           exTy arg = fToEpic arg--> writeFCall _ _ _ _ = error "Ill-formed foreign function call"---Convert a constructor application of type 'FType' to an epic type. Just do-this on tag, we know the type. Check 'FType' in io.idr.--> fToEpic :: SCBody -> String-> fToEpic (SCon _ 0) = "Unit"-> fToEpic (SCon _ 1) = "Int"-> fToEpic (SCon _ 2) = "String"-> fToEpic (SCon _ 3) = "Ptr"-> fToEpic (SCon _ 4) = "Float"-> fToEpic _ = "Any" -- idris data type--> tempfile :: IO (FilePath, Handle)-> tempfile = do env <- environment "TMPDIR"->               let dir = case env of->                               Nothing -> "/tmp"->                               (Just d) -> d->               openTempFile dir "idris"--> environment :: String -> IO (Maybe String)-> environment x = catch (do e <- getEnv x->                           return (Just e))->                       (\_ -> return Nothing)
− Idris/ConTrans.lhs 
@@ -1,540 +0,0 @@-> {-# OPTIONS_GHC -fglasgow-exts #-}--Apply Forcing/Detagging/Collapsing optimisations from Edwin Brady's thesis.--> module Idris.ConTrans(makeConTransforms, makeArgTransforms, makeIDTransforms,->                       applyTransforms, transform, rebuildTrans) where--> import Idris.AbsSyntax-> import Ivor.TT hiding (transform)-> import qualified Ivor.ViewTerm(transform)--> import Maybe-> import List--> import Debug.Trace--Algorithm is approximately:--1. Make sure all constructors are fully applied. This means all transformations-will be uniform whether on LHS or RHS of pattern defs.-Also it means that any constructors which aren't fully applied on the LHS-of a pattern turn into '_' patterns. This is fine...-2. Generate transformation rules as ViewTerm transformations by applying-forcing, detagging and collapsing to every data structure.-3. Apply rules on LHS and RHS of all definitions.--Do all this before any pattern match compilation or lambda lifting.--To do this uniformly, turn a pattern def into an application of the lhs, -then turn it back into a pclause--Also apply user level transforms (vts) at this stage.--Throughout, we don't care about the bound arguments in a PClause any more,-so just ignore them.--> transform :: Context -> [Transform] -> [(ViewTerm, ViewTerm)] -> ->              Name -> Patterns -> Patterns-> transform ctxt ts vts n (Patterns ps) = Patterns $ (map doTrans ps)->    where doTrans (PClause args _ ret) ->              = let lhs = apply (Name Unknown n) args->                    lhs' = applyTransforms ctxt (filter lhsSafe ts) lhs->                    ret' = applyTransforms ctxt ts (allTrans vts ret)->                    args' = getFnArgs lhs' in->                    PClause args' [] ret'->          doTrans (PWithClause prf args scr (Patterns pats))->              = let pats' = Patterns $ (map doTrans pats)->                    lhs = apply (Name Unknown n) args->                    lhs' = applyTransforms ctxt ts lhs->                    scr' = applyTransforms ctxt ts scr->                    args' = getFnArgs lhs' in->                    PWithClause prf args' scr' pats'--HACK: better to have a flag when building the transform. FIXME!-->          lhsSafe (Trans nm _ _) = not (isSuffixOf "_ID" nm)--> allTrans ts tm = foldl (\tm (l,r) -> Ivor.ViewTerm.transform l r tm) tm (ts++ts)--Look at all the definitions in the context, and make the relevant constructor-transformations for forcing, detagging and collapsing.--HACK: We do three passes, to pick up collapsible things from the last pass to -help. This still won't get everything right.-If Ivor returned things in the order they were defined this wouldn't-be necessary - better fix Ivor.--> makeConTransforms :: Ctxt IvorFun -> Context -> [Transform]-> makeConTransforms raw ctxt ->    = let pass1 = mkT' (getAllInductives ctxt) [] []->          pass2 = mkT' (getAllInductives ctxt) [] pass1 in->          mkT' (getAllInductives ctxt) [] pass2->   where mkT' [] acc p1 = acc->         mkT' (x:xs) acc p1 = mkT' xs ((makeTransform ctxt x (p1++acc))++acc) p1--Apply the constructor transforms before making the function transforms-so that we don't needlessly keep arguments dropped by forcing.--> makeArgTransforms :: Ctxt IvorFun -> Context -> [Transform] -> [Transform]-> makeArgTransforms raw ctxt ctrans ->    = let pass1 = mkP' (getRawPatternDefs raw ctxt) ctrans []->          pass2 = mkP' (getRawPatternDefs raw ctxt) ctrans pass1 in->          mkP' (getRawPatternDefs raw ctxt) ctrans pass2->   where mkP' [] acc p1 = acc->         mkP' (x:xs) acc p1 ->              = mkP' xs ((makePTransform raw ctxt (ctrans++p1++acc) x)++acc) p1--Look for functions which have become identity functions as a result of previous-transforms--> makeIDTransforms :: Ctxt IvorFun -> Context -> [Transform] -> [Transform]-> makeIDTransforms raw ctxt trans->    = mkP' (getRawPatternDefs raw ctxt) trans->   where mkP' [] acc = acc->         mkP' (x:xs) acc ->              = mkP' xs ((makeIDTransform raw ctxt (trans++acc) x)++acc)--Make all the transformations for a type--Step 1. Forcing-   On each constructor, find namess that appear constructor -   guarded in that constructor's return type. Any argument with these-   names is forceable.-   If the type of the argument is collapsible, it's also forceable.--   If there's only one constructor left, of the form C x, transform it to just x.-   (Relies on totality)--Step 2: Detagging-   Check if there is an argument position in the return type which has a-   different constructor at the head on each constructor. If so,-   remove the tags on all constructor.-Step 3: Collapsing-   If the only remaining arguments in all constructors are recursive (i.e.-   return the type we're working with) or themselves collapsible, -   translate all to Unit.-   If this doesn't apply, undo step 2.--Using the transforms so far (in acc) - we can also eliminate arguments-which are themselves collapsible.--> makeTransform :: Context -> (Name, Inductive) -> [Transform] -> [Transform]-> makeTransform ctxt (n, ity) acc->    = let cons = constructors ity->          detagin = (map (getFnArgs.getReturnType) (map snd cons))->          forceable = nub (map (\ (x,y) -> (x, force ctxt y acc, Ivor.TT.getArgTypes y)) cons)->          detaggable = pdisjoint ctxt detagin->          recursive = nub (map (\ (x,y) -> (x, recArgs n y acc, Ivor.TT.getArgTypes y)) cons)->          collapsible = (detaggable && all droppedAll (combine forceable recursive)) || (n == name "Proof")->          nattable = isNat forceable recursive->               in->          -- trace (show n ++ " " ++ show (nattable) ++ " " ++ show (forceable, recursive)) $ -- FORCING \n\t" ++ show forceable) ->            if collapsible then->                map (collapseTrans n) cons->                else mapMaybe (forceTrans nattable (length cons)) forceable--Combine assumes constructors are in each list in the same order. Since they-were built the same way, this is okay. Just combines the forceable and-recursive arguments, so we can see if this gets all of them-->   where combine [] [] = []->         combine ((con, d, all):cs) ((con',d',all'):cs')->             | con == con' = (con, nub (d++d'), all):(combine cs cs')->         droppedAll (con, d, args) = length d == length args--Horrible hack, sorry. It's an easy way to tell if a constructor is -from a collapsible type...--> isCollapsible x t = (show x++"_COLLAPSE") `elem` (transNames t)-> transNames = map tname->    where tname (Trans n _ _) = n--> isNat :: [(Name, [Name], [(Name, ViewTerm)])] ->->          [(Name, [Name], [(Name, ViewTerm)])] ->->           Maybe (Name, Name)-> isNat force recs = nt' force recs [] where->     nt' [] [] acc = nattable' (sortBy cmprec acc)->     nt' ((f, fargs, targs):fs) ((r, rargs, _):rs) acc->     -- we know f = r, from how they were built->          = nt' fs rs ((f, length targs, length fargs, length rargs):acc)->     cmprec (_,_,_,x) (_,_,_,y) = compare x y--Ordered by number of recursive arguments-If there's two constructors, one with 0 recursive arguments and all others -force, one with 1 recursive argument and all others force, it can be -transformed to Nat.--> nattable' :: [(Name, Int, Int, Int)] -> Maybe (Name, Name)-> nattable' [(z, ztot, zforce, 0), (s, stot, sforce, 1)]->       | (ztot==zforce) && (stot-1 == sforce) ->            = Just (z, s)-> nattable' _ = Nothing--> collapseTrans :: Name -> (Name, ViewTerm) -> Transform-> collapseTrans n (c, ty) = Trans ((show n)++"_COLLAPSE")->                            (Just (mkCollapseTrans n c ty (length (Ivor.TT.getArgTypes ty))))->                            (Just (Collapse n c ty (length (Ivor.TT.getArgTypes ty))))--> mkCollapseTrans n c ty num = mkCollapse num->    where mkCollapse num tm->             | Name nty con <- getApp tm->                 = let args = getFnArgs tm in->                       if con == c && length args == num then->                          Placeholder -- lose the lot->                          else tm->          mkCollapse _ tm = tm--> forceTrans :: Maybe (Name, Name) -> Int ->->               (Name, [Name], [(Name, ViewTerm)]) -> Maybe Transform-> forceTrans Nothing _ (x, [], _) = Nothing-> forceTrans nat ncons (n, forced, tys)->      = Just (Trans ((show n)++"_FORCE") (Just (mkForceTrans nat ncons n forced tys (length tys))) (Just (Force nat ncons n forced tys (length tys))))--If a term is n applied to (length tys) arguments, change it to-n applied to arguments minus the ones in forceable positions--> mkForceTrans nat ncons n forced tys num = mkForce num->    where mkForce num tm->             | Name nty con <- getApp tm->                 = let fn = getApp tm->                       args = getFnArgs tm ->                       nargs = zip (map fst tys) args in->                   if con == n && length args == num then->                       let app = forceapply ncons (Name nty (newname nat con)) ->                                       (map snd (filter notForced nargs)) in->                           -- trace (show (app, con, nargs)) ->                           app->                       else tm->          mkForce _ tm = tm->          forceapply 1 _ [x] = x->          forceapply _ n args = apply n args->          notForced (f, tm) = not (f `elem` forced)->          newname Nothing n = n--If the type has the shape of a Nat, transform the constructors.-->          newname (Just (z, s)) n | n == z = name "O"->                                  | n == s = name "S"--Given a constructor type, return all the names bound in it which-need not be stored (i.e. need not be bound)--> force :: Context -> ViewTerm -> [Transform] -> [Name]-> force ctxt tm acc = let rt = getReturnType tm->                         atypes = Ivor.TT.getArgTypes tm->                         rtargs = getFnArgs rt in->                         nub $ concat (map conGuarded rtargs) ++ ->                            (map fst (filter collapse atypes))->     where isVar n | elem n boundnames = True->                   | otherwise =->                       case nameType ctxt n of->                         Right _ -> False->                         _ -> True->           boundnames = map fst (Ivor.TT.getArgTypes tm)->           conGuarded t = cg [] t->           cg acc (Name Bound x) | isVar x = x:acc -- variable name->           cg acc (Name Free x) | isVar x = x:acc -- variable name->           cg acc (Name DataCon _) = acc->           cg acc (Name t x) = []->           cg acc (App f a) = cg (acc++(cg [] a)) f->           cg acc _ = []->           collapse (n, ty)->                | Name _ apn <- getApp ty->                     = isCollapsible apn acc->           collapse _ = False--Given a constructor type, return all the names bound in it which-are to recursive arguments of the datatype.-(TODO: Higher order recursive arguments too.)--> recArgs :: Name -> ViewTerm -> [Transform] -> [Name]-> recArgs tyname tm trans = map fst (filter isRec (Ivor.TT.getArgTypes tm))->     where isRec (n, ty)->                 | Name _ apn <- getApp ty->                    = apn == tyname || isCollapsible apn trans->           isRec _ = False---Return whether constructor types are pairwise disjoint in their indices---- takes a list of indices for each constructor--> pdisjoint :: Context -> [[ViewTerm]] -> Bool-> pdisjoint c [] = True-> pdisjoint c [x] = True-> pdisjoint c (x:xs) = pdisjoint c xs && (pdisjointWith x xs)->   where pdisjointWith x [] = True->         pdisjointWith x (y:ys) = disjoint (zip x y) && pdisjointWith x ys--Is there an argument position with a different constructor at the head?-->         disjoint xs = or (map disjointCon xs)->         disjointCon (x, y)->              | Name _ xn <- getApp x->              , Name _ yn <- getApp y->                 = case (nameType c xn, nameType c yn) of->                     (Right DataCon, Right DataCon) -> ->                         if (xn /= yn) then True->                            else disjoint (zip (getFnArgs x) (getFnArgs y)) ->                     _ -> False->         disjointCon _ = False--If an argument position is a placeholder in all clauses in the idris-definition, and the corresponding argument position in the Ivor definition-is either a pattern or unused (modulo recursion), do this to it:--[[x]] => x -[[complex term]] => _--> getPlaceholders :: Context -> Name -> Patterns -> Patterns -> [Int]-> getPlaceholders ctxt n (Patterns ps) (Patterns ivps) ->        = getPlPos (noDiscriminate [0..(args ps)-1] ps) ps ivps->    where->      getPlPos acc [] [] = acc->      getPlPos acc ((PClause args _ r):ps) ((PClause args' _ r'):ps')->            = getPlPos (filter (plArg args args' r') acc) ps ps'->      getPlPos acc ((PWithClause _ args _ _):ps) ((PClause args' _ r'):ps')->            = getPlPos (filter (plArg args args' r') acc) ps ps'->      getPlPos acc (_:ps) (_:ps')->            = getPlPos acc ps ps'->      getPlPos acc p p' = error $ "getPlPos : " ++ show (n,acc,p,p')-->      plArg args args' r' x ->            = x<length args && args!!x == Placeholder && recGuard x n r' (namesIn (args'!!!(x,"args' fail")))->      args ((PClause args _ r):_) = length args->      args ((PWithClause _ args _ (Patterns rest)):_) = length args->      args [] = 0--Remove argument positions from the list where those arguments are needed-to discriminate. i.e., make sure the patterns are still pairwise disjoint -after removing them.-->      noDiscriminate :: [Int] -> [PClause] -> [Int]->      noDiscriminate phs ps = indiscriminate phs (map pargs ps)->          where pargs (PClause args _ _) = args->                pargs (PWithClause _ args _ _) = args--Drop argument x, from all patterns, see if they are still pairwise disjoint.-If so, x can remain a placeholder position.-->      indiscriminate (x:xs) pats ->         = let pats' = map (blot x) pats->               ok = pdisjoint ctxt pats' in->              if ok then x:(indiscriminate xs pats') -- remove->                    else indiscriminate xs pats -- don't remove->      indiscriminate [] _ = []-->      blot i xs = take (i-1) xs ++ Placeholder:(drop (i+1) xs)-->      recGuard :: Int -> Name -> ViewTerm -> [Name] -> Bool--z must be used only as part of the ith argument to a call to fn. Anywhere-else, it can't be dropped.-->      recGuard i fn ret zs = and (map (recGuard' i fn ret) zs)->      recGuard' i fn ret z ->          | Left _ <- nameType ctxt z->        = let res = rgOK ret in->           -- trace ("GUARD " ++ show (i,fn,z,ret,res)) ->            res                    ->        where rgOK ap@(App f a) = nthOK (getApp ap) (getFnArgs ap)->              rgOK (Name _ x) = x /= z->              rgOK (Lambda _ _ sc) = rgOK sc->              rgOK (Let _ _ val sc) = rgOK val && rgOK sc->              rgOK _ = True-->              nthOK (Name _ x) args->                    | x == fn = and (map nOK (zip [0..] args))->              nthOK f args = rgOK f && (and (map rgOK args))->              nOK (argno, arg) | argno == i = True->              nOK (_,arg) = rgOK arg->      recGuard' i fn ret z = True---          trace ("GUARD OK " ++ show (i,fn,tm,ret)) True--True -- Complex term, just drop it.--> makePTransform :: Ctxt IvorFun -> Context -> [Transform] ->->                   (Name, (ViewTerm, Patterns)) -> [Transform]-> makePTransform raw ctxt ctrans (n, (ty, patsin)) ->   = let pats = transform ctxt ctrans [] n patsin in->       case getPatternDef ctxt n of->        Right (_, idpatsin) ->->            let idpats = transform ctxt ctrans [] n idpatsin->                numargs = args pats->                placeholders = getPlaceholders ctxt n pats idpats in ->             -- trace (show (placeholders, n)) $->                if (null placeholders) ->                 then []->                 else [Trans (show n ++ "_dropargs") ->                             (Just (mkDropTrans n ty placeholders numargs))->                             (Just (Drop n ty placeholders numargs))]->        _ -> []->    where->      args (Patterns ((PClause args _ r):_)) = length args->      args _ = 0--> mkDropTrans n ty pls num = doDrop pls num where->      doDrop pls num tm->         | Name nty fname <- getApp tm->             = let fn = getApp tm->                   args = getFnArgs tm in->               if fname == n && length args == num then->                   apply (Name nty fname) ->                         (map (simplArg pls) (zip [0..] args))->                   else tm->      doDrop _ _ tm = tm->      -- simplArg pls (a, n@(Name _ _)) = n->      simplArg pls (a, t) | a `elem` pls = Placeholder->                          | otherwise = t--Look for arguments which are invariant across all patterns and calls. -If there's only one left, in position i, replace recursive calls with the -argument in position i. If the LHS and RHS of all patterns is the same in -the result, it's an identity function, so replace it with (id x) where x is-the argument in position i.--> makeIDTransform :: Ctxt IvorFun -> Context -> [Transform] ->->                    (Name, (ViewTerm, Patterns)) -> [Transform]-> makeIDTransform raw ctxt ctrans (n, (ty, patsin@(Patterns (_:_))))->   = let Patterns pats = transform ctxt ctrans [] n patsin ->         argpos = zip [0..] (arguments (pats!!!(0,"pats fail")))->         keepArgs = [0..length argpos-1] \\ (invariants argpos (map arguments pats))->         trans = Trans (show n ++ "_ID") ->                       (Just (mkIDTrans n keepArgs (length argpos)))->                       Nothing->         stripInvs = map (stripInv trans) pats in->          -- trace (show (n,stripInvs)) $->          if (all (idClause keepArgs) stripInvs) ->             then [trans] else []-->    where invariants :: [(Int, ViewTerm)] -> [[ViewTerm]] -> [Int]->          invariants invs [] = map fst invs->          invariants invs (x:xs) = invariants (checkInv invs (zip [0..] x)) xs-->          checkInv [] args = args->          checkInv ((p,a):invs) args ->              = checkInv invs (filter (isNotInv p a) args)--If the argument in the given position is not invariant, drop it. Otherwise-keep it, for now. (We're either looking at a different position, or it-is indeed invariant)-->          isNotInv p a (x,a') | p==x && a/=a' = False->                              | otherwise = True-->          stripInv t (PClause args _ ret) = PClause args [] (doTrans t ret)->          stripInv t w = w->          idClause [k] t@(PClause args _ ret) | k<length args = args!!!(k,"idClause fail") == ret->          idClause _ _ = False--> makeIDTransform raw ctxt ctrans _ = []--> mkIDTrans n [keep] arity tm->         | Name nty fname <- getApp tm->             = let fn = getApp tm->                   args = getFnArgs tm in->               if fname == n && length args == arity && keep<length args then->                   args!!!(keep, "mkIDfail")->                   else tm--> mkIDTrans _ _ _ tm = tm--Dangerous: doesn't take account of argument lengths. Top level function-is transformed anyway.-- mkIDTrans n [keep] arity tm@(Name nty fname)-     = if fname == n then App (Name nty (name "id")) Placeholder else tm---Apply all transforms in order to a term, eta expanding constructors first.--> applyTransforms :: Context -> [Transform] -> ViewTerm -> ViewTerm-> applyTransforms ctxt ts term ->     = foldl (flip doTrans) (etaExpand ctxt term) ts--> doTrans :: Transform -> ViewTerm -> ViewTerm-> doTrans (Trans nm (Just trans) _) tm = tr tm where->     tr tm = {- if (nm=="Next_FORCE") then (trace (show tm) (tr' tm)) else -}->             tr' tm->     tr' (App f a) = trans (App (tr f) (tr a))->     tr' (Lambda v ty sc) = trans (Lambda v (tr ty) (tr sc))->     tr' (Forall v ty sc) = trans (Forall v (tr ty) (tr sc))->     tr' (Let v ty val sc) = trans (Let v (tr ty) (tr val) (tr sc))->     tr' (Annotation a t) = Annotation a (tr t)->     tr' t = trans t--> etaExpand :: Context -> ViewTerm -> ViewTerm-> etaExpand ctxt tm = ec tm->   where->     ec ap@(App f a) ->         | Right (ar, con, args) <- needsExp (App f a)->              = etaExp ar con args->     ec ap@(App _ _) = let f = getApp ap->                           args = getFnArgs ap in->                           apply f (map ec args)->     ec (Lambda n ty sc) = Lambda n (ec ty) (ec sc)--That's all the terms we care about.-->     ec x = x-->     needsExp ap = needsExp' ap []->     needsExp' (App f a) as = needsExp' f ((ec a):as)->     needsExp' nm@(Name _ n) as ->         = do ar <- getConstructorArity ctxt n->              if (ar == length as) then ttfail "FAIL"->                  else Right (ar, nm, as)->     needsExp' _ _ = ttfail "FAIL"--We don't care about the type on the lambda here, We'll never look at it-even when compiling, it's just for the sake of having constructors fully-applied.-->     etaExp ar con args ->         = -- trace ("ETA " ++ show (ar,con,args)) $ ->             let newargs = map (\n -> (toIvorName (MN "exp" n)))->                            [1..(ar-(length args))] in->               addLam newargs (apply con (args++(map (Name Unknown) newargs)))->     addLam [] t = t->     addLam (n:ns) t = Lambda n Star (addLam ns t)---Get the type of the constructor, look for constructor guarded arguments-in the return type, strip them.--If, in addition, there is an index with disjoint constructors *and* all -remaining arguments are recursive, transform all constructors to Unit.-- mkConTrans :: Ctxt IvorFun -> Context -> Name -> Name -> [Transform]- mkConTrans raw ctxt ty = -     let Just cons = getConstructors ctxt ty--Given a constructor name, return the names and types of the arguments-which are not removed--> getRemaining :: Context -> Name -> [(Name, ViewTerm)]-> getRemaining = undefined--Given a constructor name, the names of arguments it has, and the names-of arguments to keep, make a transformation rule.--> mkTrans :: Name -> [Name] -> [Name] -> Transform-> mkTrans con args keep = Trans (show con ++ "_force") (Just trans) undefined->    where trans tm = let (f,fargs) = (getApp tm, getFnArgs tm) in->                        (tCon f fargs tm)->          tCon fc@(Name _ fcon) fargs tm->            | con == fcon = if (length args == length fargs)->                              then apply fc (dropArgs fargs args keep)->                              else tm->          tCon _ _ t = t->          dropArgs (f:fs) (a:as) keep->                   | a `elem` keep = f:(dropArgs fs as keep)->                   | otherwise = dropArgs fs as keep->          dropArgs _ _ keep = []->          --> rebuildTrans :: TransData -> ViewTerm -> ViewTerm-> rebuildTrans (Force a b c d e f) = mkForceTrans a b c d e f-> rebuildTrans (Collapse a b c d) = mkCollapseTrans a b c d-> rebuildTrans (Drop a b c d) = mkDropTrans a b c d
− Idris/Context.lhs 
@@ -1,242 +0,0 @@-> module Idris.Context(Ctxt, Id(..), addEntry, ctxtLookup, ctxtLookupName,->                      ctxtAlist, newCtxt, appCtxt, alistCtxt, mkName,->                      Err(..)) where--> import Data.List-> import qualified Data.Map as Map-> import Control.Monad.Error--> import Data.Binary-> import Data.Typeable-> import Control.Monad--> import Char--> import Debug.Trace--> data Id = UN String | MN String Int | NS [Id] Id -- NS is decorated name->    deriving (Eq, Ord)--> instance Show Id where->     show (UN s) = s->     show (MN s i) = "__" ++ s ++ "_" ++ show i->     show (NS ns n) = showSep ns ++ show n->       where showSep ns = concat (map ((++".").show) ns)--> instance Binary Id where->     put (UN x) = do put (0 :: Word8)->                     put x->     put (MN x i) = do put (1 :: Word8)->                       put x; put i->     put (NS n i) = do put (2 :: Word8)->                       put n; put i-->     get = do tag <- getWord8->              case tag of->                0 -> liftM UN get->                1 -> liftM2 MN get get->                2 -> liftM2 NS get get--> type Dict k v = Map.Map k v--Lifted this lot out since I had to change for backwards compatibility. --> dictInsert :: Ord k => k -> v -> Dict k v -> Dict k v-> dictInsert = Map.insert-> dictElems = Map.elems-> dictAlist = Map.assocs-> dictEmpty = Map.empty--> dictLookup :: Ord k => k -> Dict k v -> Maybe v-> dictLookup = Map.lookup--Contexts containing names and type information A context is just a map-from a to b, but we'll keep it abstract in case we need or want-something better later--Contexts are divided into namespaces. Entries are added either to a defined namespace, or-the global namespace. Lookup will look for names in the current namespace then the global-namespace, and report an error on ambiguous names.--FIXME: Needs to be a map from names to all possibilities, which are then disambiguated.-- type Ctxt a = Dict [Id] [(Id, a)]--We keep a context as an alist *and* a Dict. This is because we want to retain-ordering, have multiple entries, append *and* have fast lookup. Rather than-have a cleverer data structure, this is an easy way.--> data Ctxt a = Ctxt {->                 alist :: [(Id, a)], -- for retaining ordering->                 cdict :: Dict Id [(Id, a)] ->               }--> instance Binary a => Binary (Ctxt a) where->     put (Ctxt a b) = do put a; put b->     get = liftM2 Ctxt get get--> data Err = NoName Id->          | Ambiguous Id [Id]->          | WrongNamespace Id [Id]->          | OtherErr String--> instance Show Err where->     show (NoName n) = "No such name " ++ show n->     show (Ambiguous n xs) = "Ambiguous name " ++ show n ++ " " ++ show xs ->     show (WrongNamespace n ns) = show n ++ " not defined in namespace " ++ show (NS ns (UN ""))--> instance Error Err where->     noMsg = OtherErr "Unknown error"->     strMsg s = OtherErr s--All operations are passed a [Id], which is the namespace we are currently in.-[] is the outermost namespace. --> mkName :: [Id] -> Id -> Id-> mkName [] name = name-> mkName ns name@(NS ns' x) = name-> mkName ns x = NS ns x--> lastName :: Id -> Id-> lastName (NS ns i) = lastName i-> lastName x = x--> globalNS :: Id -> Bool-> globalNS (NS [] _) = True-> globalNS (NS _ _) = False-> globalNS _ = True--> currentNS :: [Id] -> Id -> Bool-> currentNS ns (NS ns' _) = ns == ns'-> currentNS _ _ = True -- used as a global name, okay if not ambiguous--> getNS :: Id -> [Id]-> getNS (NS n _) = n-> getNS x = [x]--> addToD :: Dict Id [(Id,a)] -> Id -> a -> Dict Id [(Id, a)]-> addToD d n v = case dictLookup (lastName n) d of->                  Nothing -> dictInsert (lastName n) [(n,v)] d->                  Just nvs -> case lookup n nvs of->                     Nothing -> dictInsert (lastName n) ((n,v):nvs) d->                     Just _ -> dictInsert (lastName n) ((n,v):(dropN n nvs)) d->   where dropN n [] = []->         dropN n ((n',v):xs) | n == n' = xs->                             | otherwise = (n',v):(dropN n xs)--If the root of the given name n appears multiple times in the dictionary,-then only return a value if it's an exact match, otherwise issue an -ambiguous name error--> lookupD :: Dict Id [(Id,a)] -> [Id] -> Id -> Either Err (a, Id) -> lookupD d ns n = case dictLookup (lastName n) d of->                 Nothing -> Left (NoName n)->                 Just [] -> Left (NoName n)->                 Just [(n',v)] -> if (n==n' || currentNS ns n) then Right (v, n')->                                    else Left (WrongNamespace (lastName n)->                                                              (getNS n))->                 Just xs -> case lookup n xs of->                              Just v -> Right (v, n)->                              Nothing -> Left (Ambiguous n (map fst xs))--> addEntry :: Ctxt a -> [Id] -> Id -> a -> Ctxt a-> addEntry (Ctxt ca cd) ns name val ->    = let name' = mkName ns name in->          Ctxt ((name', val):ca) (addToD cd name' val)--> ctxtLookupName :: (Show a) => Ctxt a -> [Id] -> Id -> Either Err (a, Id)-> ctxtLookupName (Ctxt _ d) ns n = lookupD d ns (mkName ns n)--> ctxtLookup :: (Show a) => Ctxt a -> [Id] -> Id -> Either Err a-> ctxtLookup ctxt namespace k = case ctxtLookupName ctxt namespace k of->                                 Right (x, k) -> Right x->                                 Left err -> Left err--> ctxtAlist :: Ctxt a -> [(Id,a)]-> ctxtAlist (Ctxt ca _) = reverse ca--> alistCtxt :: [(Id, a)] -> Ctxt a-> alistCtxt a = Ctxt a (mkD dictEmpty a) where->     mkD acc [] = acc->     mkD acc ((n,v):ns) = mkD (addToD acc n v) ns--> newCtxt = Ctxt [] dictEmpty--> appCtxt :: Ctxt a -> Ctxt a -> Ctxt a-> appCtxt (Ctxt l _)  (Ctxt r _) = alistCtxt (l++r)---> {--> addEntry :: Ctxt a -> [Id] -> Id -> a -> Ctxt a-> addEntry ctxt using k v = let vs = cnames using ctxt in->                               dictInsert using ((k,v):vs) ctxt--If name is fully qualified, just look in the right namespace.-Otherwise, first look in current namespace, then in global namespace.--> ctxtLookupName :: (Show a) => Ctxt a -> [Id] -> Id -> Either Err (a, Id)-> ctxtLookupName ctxt [] k->         = case lookup k (cnames [] ctxt) of->                    Just v -> Right (v, k)->                    _ -> Left "No such var"--> cnames ns ctxt = case dictLookup ns ctxt of->                      Just vs -> vs->                      _ -> []--> ctxtLookup :: (Show a) => Ctxt a -> [Id] -> Id -> Either Err a-> ctxtLookup ctxt namespace k = case ctxtLookupName ctxt namespace k of->                                 Right (x, k) -> Right x->                                 Left err -> Left err--> ctxtAlist :: Ctxt a -> [(Id,a)]-> ctxtAlist cs = reverse $ concat (Map.elems cs)--> alistCtxt :: [(Id, a)] -> Ctxt a-> alistCtxt [] = newCtxt-> alistCtxt ((x,y):xs) = addEntry (alistCtxt xs) [] x y--> newCtxt = dictEmpty--> appCtxt :: Ctxt a -> Ctxt a -> Ctxt a-> appCtxt xs ys = app' (nub (Map.keys xs)++(Map.keys ys))->   where app' [] = dictEmpty->         app' (n:ns) = let bothnames = (cnames n xs ++ cnames n ys) in->                           dictInsert n bothnames (app' ns)-> -}--We need to keep insertion order, because when we add to ivor, we'd better insert them in-dependency order.--This doesn't quite work. We need a multimap or some other trickery, because things may be -declared, used, then defined with the same name, and that name has to map each time.--> {---> type Ctxt a = Dict Id [(a, Int)]--> type Err = String--> addEntry :: Ctxt a -> Maybe Id -> Id -> a -> Ctxt a-> addEntry ctxt using k v = dictInsert k (v, Map.size ctxt) ctxt--> ctxtLookupName :: (Show a) => Ctxt a -> Maybe Id -> Id -> Either Err (a, Id)-> ctxtLookupName ctxt namespace k = case dictLookup k ctxt of->                                 Just (x, _) -> Right (x, k)->                                 Nothing -> Left "No such var"--> ctxtLookup :: (Show a) => Ctxt a -> Maybe Id -> Id -> Either Err a-> ctxtLookup ctxt namespace k = case ctxtLookupName ctxt namespace k of->                                 Right (x, k) -> Right x->                                 Left err -> Left err--> ctxtAlist :: Ctxt a -> [(Id,a)]-> ctxtAlist xs = map (\ (x, (d, o)) -> (x, d)) $ sortBy dep (dictAlist xs)->     where dep (n, (def, o)) (n', (def', o')) = compare o o'--> newCtxt = dictEmpty--> appCtxt :: Ctxt a -> Ctxt a -> Ctxt a-> appCtxt xs ys = Map.union xs ys--> -}
− Idris/Fontlock.lhs 
@@ -1,280 +0,0 @@-> module Idris.Fontlock(htmlise,latexise) where--> import Data.Char-> import List--> import Idris.AbsSyntax-> import Idris.Lexer-> import Idris.Context--> data Markup = DC | TC | FN | CM | VV | KW | ST | CH | LCM->             | BRK | SEC | SUBSEC ->             | TITLE | AUTHOR | HTML | LATEX | None->   deriving Show--> hclass DC = "datacon"-> hclass TC = "typecon"-> hclass FN = "function"-> hclass CM = "comment"-> hclass VV = "variable"-> hclass KW = "keyword"-> hclass ST = "string"-> hclass CH = "string"-> hclass _ = ""--> mkMarkups :: Ctxt IvorFun -> [(String, Markup)]-> mkMarkups ctxt = map mkMarkup (map (\ (x,y) -> (x, rawDecl y)) (ctxtAlist ctxt))--> mkMarkup :: (Id, Decl) -> (String, Markup)-> mkMarkup (NS _ i, f) = mkMarkup (i, f)-> mkMarkup (n, Fun _ _) = (show n, FN)-> mkMarkup (n, Fwd _ _ _) = (show n, FN)-> mkMarkup (n, TermDef _ _ _) = (show n, FN)-> mkMarkup (n, Prf _ _) = (show n, FN)-> mkMarkup (n, DataDecl _) = (show n, TC)-> mkMarkup (n, Constructor) = (show n, DC)-> mkMarkup (n, _) = (show n, VV)--> getMarkup :: String -> [(String, Markup)] -> Markup-> getMarkup x ms = case lookup x ms of->                    Just m -> m->                    Nothing -> VV--> markupText :: [(String, Markup)] -> String -> [(Markup, String)]-> markupText ms ('-':'-':' ':'I':'G':'N':'O':'R':'E':xs) = endIgnore ms xs-> markupText ms ('-':'-':'\n':xs) = (BRK, ""):markupText ms xs-> markupText ms ('-':'-':' ':'S':'e':'c':'t':'i':'o':'n':':':' ':xs) ->                = markupSECtoNewline SEC "" ms xs-> markupText ms ('-':'-':' ':'T':'i':'t':'l':'e':':':' ':xs) ->                = markupSECtoNewline TITLE "" ms xs-> markupText ms ('-':'-':' ':'L':'a':'T':'e':'X':':':' ':xs) ->                = markupSECtoNewline LATEX "" ms xs-> markupText ms ('-':'-':' ':'H':'T':'M':'L':':':' ':xs) ->                = markupSECtoNewline HTML "" ms xs-> markupText ms ('-':'-':' ':'A':'u':'t':'h':'o':'r':':':' ':xs) ->                = markupSECtoNewline AUTHOR "" ms xs-> markupText ms ('-':'-':' ':'S':'u':'b':'s':'e':'c':'t':'i':'o':'n':':':' ':xs) ->                = markupSECtoNewline SUBSEC "" ms xs-> markupText ms ('-':'-':xs) = markupCMtoNewline "" ms xs-> markupText ms ('{':'-':'>':xs) = markupText ms xs-> markupText ms ('>':'-':'}':xs) = markupText ms xs-> markupText ms ('{':'-':'-':xs) = markupLCM "" ms xs-> markupText ms ('{':'-':xs) = markupCM "" ms xs-> markupText ms ('\'':c:'\'':xs) = (CH, ['\'',c,'\'']):markupText ms xs-> markupText ms ('"':xs) = markupString ms xs-> markupText ms ('%':xs) = markupSpecial ms xs-> markupText ms ('\t':xs) = (None, "        "):markupText ms xs-> markupText ms (c:cs)->       | isAlpha c || c=='_' = markupVar ms (c:cs)-> markupText ms (c:cs) = (None, [c]):markupText ms cs--> markupText ms [] = []--> keywords = ["proof","data","using","idiom","params","namespace","module",->             "import","export","inline","where","partial","syntax","lazy",->             "infix","infixl","infixr","do","refl","if","then","else","let",->             "in","return","include","exists", "with"]-> types = ["String","Int","Char","Float","Ptr","Lock","Handle","Set"]--> markupSpecial ms cs = case span isAllowed cs of->      (var,rest) -> (None, '%':var):(markupText ms rest)--> markupVar ms cs = case span isAllowed cs of->      (var,rest) -> if (var `elem` keywords) ->                       then (KW, var):(markupText ms rest)->                       else if (var `elem` types) ->                         then (TC, var):(markupText ms rest)->                         else (getMarkup var ms, var):(markupText ms rest)--> markupCMtoNewline acc ms ('\n':xs) = (CM, "--"++reverse acc):->                                        markupText ms ('\n':xs)-> markupCMtoNewline acc ms (x:xs) = markupCMtoNewline (x:acc) ms xs-> markupCMtoNewline acc ms [] = (CM, "--"++reverse acc):[]--> markupSECtoNewline sec acc ms ('\n':xs) = (sec, reverse acc):->                                        markupText ms ('\n':xs)-> markupSECtoNewline sec acc ms (x:xs) = markupSECtoNewline sec (x:acc) ms xs-> markupSECtoNewline sec acc ms [] = (sec, reverse acc):[]--> markupCM acc ms ('-':'}':xs) = (CM, "{-"++reverse acc++"-}"):markupText ms xs-> markupCM acc ms (x:xs) = markupCM (x:acc) ms xs-> markupCM acc ms [] = (CM, "{-"++reverse acc):[]--> markupLCM acc ms ('-':'-':'}':xs) = (LCM, reverse acc):markupText ms xs-> markupLCM acc ms (x:xs) = markupLCM (x:acc) ms xs-> markupLCM acc ms [] = (LCM, reverse acc):[]--> endIgnore ms ('-':'-':' ':'S':'T':'A':'R':'T':'\n':xs) = markupText ms xs-> endIgnore ms (x:xs) = endIgnore ms xs-> endIgnore ms [] = []--> markupString ms xs = case getstr xs of->                        Just (str, rest, nls) -> (ST, show str):markupText ms rest--> htmlise :: Ctxt IvorFun -> FilePath -> FilePath -> Maybe FilePath -> IO ()-> htmlise ctxt fp outf style ->                      = do txt <- readFile fp->                           let ms = mkMarkups ctxt->                           let mtxt = markupText ms txt->                           writeFile outf (renderHTML fp style mtxt)--> latexise :: Ctxt IvorFun -> FilePath -> FilePath -> IO ()-> latexise ctxt fp outf = do txt <- readFile fp->                            let ms = mkMarkups ctxt->                            let mtxt = markupText ms txt->                            writeFile outf (renderLatex mtxt)--> skipnl :: [(Markup, String)] -> [(Markup, String)]-> skipnl ((None, "\n"):xs) = skipnl xs-> skipnl xs = xs--> skipIfBrk :: [(Markup, String)] -> [(Markup, String)]-> skipIfBrk xs = si xs xs->    where si orig next@((BRK, _):xs) = next->          si orig next@((TITLE, _):xs) = next->          si orig next@((HTML, _):xs) = next->          si orig next@((LATEX, _):xs) = next->          si orig next@((AUTHOR, _):xs) = next->          si orig next@((SEC, _):xs) = next->          si orig next@((SUBSEC, _):xs) = next->          si orig next@((LCM, _):xs) = next->          si orig ((None, "\n"):xs) = si orig xs->          si orig _ = orig--> renderHTML :: String -> Maybe String -> [(Markup, String)] -> String-> renderHTML title style ms = htmlHeader title style ++ ->                       "<code>\n" ++ html (skipIfBrk ms) ++ "\n</code>\n\n</body></html>"->   where ->     html [] = ""->     html ((None, "\n"):xs) = tHtml "\n" ++ html (skipIfBrk xs)->     html ((None, t):xs) = tHtml t ++ html xs->     html ((TITLE, t):xs) ->        = "</code>\n\n<h2>" ++ t ++ "</h2>\n\n<code>" ++ html (skipnl xs)->     html ((HTML, t):xs) ->        = "</code>\n\n<p>" ++ t ++ "</p>\n\n<code>" ++ html (skipnl xs)->     html ((LATEX, t):xs) ->        = html (skipnl xs)->     html ((AUTHOR, t):xs) ->        = "</code>\n\n<h4>" ++ t ++ "</h4>\n\n<code>" ++ ->          "</code>" ++ sechead xs ++ "\n\n<code>" ++ html (skipnl xs)->     html ((SEC, t):xs) ->        = "</code><a name=\"" ++ secname t ++ "\">\n\n<h3>" ++ t ++ "</h3>\n\n<code>" ++ html (skipnl xs)->     html ((SUBSEC, t):xs) ->        = "</code>\n\n<h4>" ++ t ++ "</h4>\n\n<code>" ++ html (skipnl xs)->     html ((BRK, t):xs) = tHtml t ++ html xs->     html ((LCM, t):xs) = "</code>\n\n<p class=\"explanation\">" ++ tpara 0 t ++ "</p>\n\n<code>" ++ html (skipnl xs)->     html ((m, t):xs) = "<span class=\"" ++ hclass m ++ "\">" ++ tHtml t ++ ->                        "</span>" ++ html xs->     tHtml = concat.(map th) -->     th ' ' = "&nbsp;"->     th '\n' = "</code><br>\n<code>"->     th x = [x]-->     tpara l [] = ""->     tpara l ('"':xs) = case getstr xs of->                        Just (str,rest,_) -> "<code>" ++ tpara l str ++ "</code>" ++->                                             tpara l rest->                        _ -> error xs->     tpara l ('U':'R':'L':'[':xs) =->         case span (/=']') xs of->           (url, ']':rest) -> "<a href=\"" ++ url ++ "\">" ++ url ++ "</a>"->                          ++ tpara l rest->     tpara l ('\\':'/':xs) = '/':tpara l xs ->     tpara l ('\\':'\\':xs) = '\\':tpara l xs ->     tpara l ('\\':'"':xs) = '"':tpara l xs ->     tpara l ('\\':'*':xs) = '*':tpara l xs ->     tpara l ('/':xs) =->         case span (/='/') xs of->           (txt, '/':rest) -> "<em>" ++ txt ++ "</em>" ++ tpara l rest->     tpara l ('*':xs) = case span (=='*') xs of->                          (_,rest) -> "<li>" ++ tpara l rest->     tpara l ('\n':'\n':'*':xs) = "<ul>\n" ++ tpara (l+1) ('*':xs)->     tpara l ('\n':'\n':xs) = "\n</p>\n<p>\n" ++ tpara l xs->     tpara l ('\n':'-':xs) = if (l>0) then "</ul>" ++ tpara (l-1) xs ->                                       else "</p><p>" ++ tpara l xs->     tpara l ('<':xs) = "&lt;"++ tpara l xs->     tpara l (x:xs) = x:(tpara l xs)--> htmlHeader title style->                = "<!DOCTYPE html PUBLIC \"-//W3C//DTD HTML 4.01//EN\">" ++->                  "<html><head><title>" ++ title ++ "</title>\n" ++->                  defaultStyle style ++ "</head><body>"--> secname t = take 10 (filter isAlpha t)--> getsecs [] = []-> getsecs ((SEC,t):xs) = ("<a href=\"#" ++ (secname t) ++"\">"++ t ++ "</a>"):(getsecs xs)-> getsecs (_:xs) = getsecs xs--> sechead ms = let ss = getsecs ms in->              if null ss then "" ->                         else concat (intersperse " | " (getsecs ms)) ++ "<br>"--> defaultStyle Nothing ->                  = "<style type=\"text/css\">\n" ++->                    "." ++ hclass DC ++ " {\n  color:red; font-family: Courier;\n}\n" ++ ->                    "." ++ hclass TC ++ " {\n  color:blue; font-family: Courier;\n}\n" ++ ->                    "." ++ hclass FN ++ " {\n  color:green; font-family: Courier;\n}\n" ++ ->                    "." ++ hclass VV ++ " {\n  color:purple; font-family: Courier;\n}\n" ++ ->                    "." ++ hclass CM ++ " {\n  color:darkred; font-family: Courier;\n}\n" ++ ->                    "." ++ hclass ST ++ " {\n  color:gray; font-family: Courier;\n}\n" ++ ->                    "." ++ hclass KW ++ " {\n  color:black;\n  font-family: Courier; font-weight:bold;\n}\n" ++ ->                    "p.explanation {\n  color:black;\n}\n" ++->                    "BODY, SPAN {\n  font-family: Tahoma;\n" ++->                    "  color:  #000020;\n  background: #f0f0f0;\n}\n" ++->                    "</style>"-> defaultStyle (Just s) = "<link rel=\"stylesheet\" type=\"text/css\" href=\"" ++ s ++ "\">"--> renderLatex :: [(Markup, String)] -> String-> renderLatex ms = latexHeader ++ latex 0 (skipIfBrk ms) ++ "\n\n\\end{document}"->   where ->     latex i [] = usev i->     latex i ((None, "\n"):xs) = "\n" ++ latex i (skipIfBrk xs)->     latex i ((None, t):xs) = t ++ latex i xs->     latex i ((BRK, t):xs) = usev i ++ startv (i+1) ++ latex (i+1) xs->     latex i ((TITLE, t):xs) = "\\title{" ++ t ++ "}\n" ++ latex i (skipnl xs)->     latex i ((HTML, t):xs) = latex i (skipnl xs)->     latex i ((AUTHOR, t):xs) = "\\author{" ++ t ++ "}\n\\maketitle\n\n" ++ startv i ++ latex i (skipnl xs)->     latex i ((SEC, t):xs) = usev i ++ "\\section{" ++ t ++ "}\n\n" ++ startv (i+1) ++ latex (i+1) (skipnl xs)->     latex i ((SUBSEC, t):xs) = usev i ++ "\\subsection{" ++ t ++ "}\n\n" ++ startv (i+1) ++ latex (i+1) (skipnl xs)->     latex i ((LCM, t):xs) = usev i ++ tpara 0 t ++ "\n\n" ++ startv (i+1) ++ latex (i+1) (skipnl xs)->     latex i ((LATEX, t):xs) = usev i ++ tpara 0 t ++ "\n\n" ++ startv (i+1) ++ latex (i+1) (skipnl xs)->     latex i ((m, t):xs) = "^" ++ show m ++ "@" ++ t ++ "!"->                               ++ latex i xs-->     tpara l [] = ""->     tpara l ('"':xs) = case getstr xs of->                        Just (str,rest,_) -> "\\texttt{" ++ tpara l str ++ "}" ++->                                             tpara l rest->     tpara l ('U':'R':'L':'[':xs) =->         case span (/=']') xs of->           (url, ']':rest) -> "\\url{" ++ url ++ "}" ++ tpara l rest->     tpara l ('/':'/':xs) = '/':tpara l xs->     tpara l ('/':xs) =->         case span (/='/') xs of->           (txt, '/':rest) -> "\\emph{" ++ txt ++ "}" ++ tpara l rest->           (txt, rest) -> "\\emph{" ++ txt ++ "}" ++ tpara l rest->     tpara l ('~':xs) = "\\~{ }" ++ tpara l xs->     tpara l ('#':xs) = "\\#" ++ tpara l xs->     tpara l ('\n':'\n':'*':xs) = "\n\\begin{itemize}\n" ++ tpara (l+1) ('*':xs)->     tpara l ('\n':'-':xs) = if (l>0) then "\\end{itemize}" ++ tpara (l-1) xs ->                                       else "\n\n" ++ tpara l xs->     tpara l ('*':xs) = case span (=='*') xs of->                          (_,rest) -> "\\item " ++ tpara l rest->     tpara l (x:xs) = x:(tpara l xs)-->     usev i = "\n\\end{SaveVerbatim}\n\\BUseVerbatim{vbtm" ++ show i ++ "}\n\n"->     startv i = "\\begin{SaveVerbatim}[commandchars=^@!]{vbtm" ++ show i ++ "}\n\n"---> latexHeader = "\\documentclass[a4paper]{article}\n" ++->   "\n\\usepackage{fancyvrb}\n\\usepackage{color}\n\\usepackage{url}\n\n\\begin{document}\n\n" ++->   "\\newcommand{\\" ++ show DC ++ "}[1]{\\textcolor[rgb]{0.8,0,0}{#1}}\n" ++->   "\\newcommand{\\" ++ show TC ++ "}[1]{\\textcolor[rgb]{0,0,0.8}{#1}}\n" ++->   "\\newcommand{\\" ++ show FN ++ "}[1]{\\textcolor[rgb]{0,0.5,0}{#1}}\n" ++->   "\\newcommand{\\" ++ show VV ++ "}[1]{\\textcolor[rgb]{0.5,0,0.5}{#1}}\n" ++->   "\\newcommand{\\" ++ show CM ++ "}[1]{\\textcolor[rgb]{0.4,0.2,0.2}{#1}}\n" ++->   "\\newcommand{\\" ++ show KW ++ "}[1]{\\textcolor[rgb]{0,0,0}{#1}}\n" ++->   "\\newcommand{\\" ++ show ST ++ "}[1]{\\textcolor[rgb]{0.4,0.4,0.4}{#1}}\n"-
− Idris/LambdaLift.lhs 
@@ -1,322 +0,0 @@-> {-# OPTIONS_GHC -fglasgow-exts #-}--> module Idris.LambdaLift where--> import Idris.AbsSyntax-> import Idris.PMComp-> import Ivor.TT hiding (SimpleCase(..), CaseAlt(..))-> -> import Control.Monad.State-> import Data.Typeable-> import Debug.Trace-> import Maybe--> import List--This is the language we're converting directly into Epic code, and the-output of the lambda lifter--SCFun is a top level function, with C export name, list of args, code for the body.--> data SCFun = SCFun [SCOpt] [Name] SCBody ->    deriving Show--> data SCOpt = SCInline | SCStrict | SCExport String->    deriving (Show, Eq)--> getEName [] = Nothing-> getEName (SCExport n : xs) = Just n-> getEName (_:xs) = getEName xs--> data SCBody = SVar Name->             | SCon Name Int->             | SApp SCBody [SCBody]->             | SLet Name SCBody SCBody->             | SCCase SCBody [SCAlt]->             | SIf SCBody SCBody SCBody->             | SIfZero SCBody SCBody SCBody->             | SUnit -- for anything that has no runtime meaning, eg types->             | SInfix Op SCBody SCBody->             | SIOOp SCIO->             | SConst Constant->             | SLazy SCBody->             | SError->    deriving (Show, Eq)--Case alternatives, could be a constructor (with tag), a constant, or-a default case--> data SCAlt = SAlt Name Int [Name] SCBody->            | SConstAlt Constant SCBody->            | SDefault SCBody->    deriving (Show, Eq)--It's useful to be able to sort alternatives by tag, for transformation -purposes, since once they're compiled order doesn't matter.--> instance Ord SCAlt where->   compare (SAlt _ t _ _) (SAlt _ u _ _) = compare t u->   compare (SConstAlt c _) (SConstAlt d _) = compare c d->   compare (SDefault _) (SDefault _) = EQ->   compare (SAlt _ _ _ _) _ = LT->   compare (SConstAlt _ _) (SAlt _ _ _ _) = GT->   compare (SConstAlt _ _) (SDefault _) = LT->   compare (SDefault _) _ = GT--Built-in IO operations --> data SCIO = PutStr SCBody->           | GetStr ->           | Fork SCBody->           | NewLock SCBody->           | DoLock SCBody->           | DoUnlock SCBody->           | NewRef->           | ReadRef SCBody->           | WriteRef SCBody SCBody->    deriving (Show, Eq)--Any lambdas in the body need to be made functions in their own right,-with names in scope passed as arguments.--We should try to collect sequences of lambdas, e.g. \x \y \z . e -and lift x,y,z all at once.--We are assuming that all names are already unique, and we're not going-to be inventing any new variable names, just new function names. This-should be guaranteed in the underlying Ivor term.--Inside every ViewTerm, pull out the new SCs and replace lambdas with -application of new SC. First step, just lift lambda out. --Note that we're not fussy about maintaining types here (we've already broken-things by making the case trees anyway). It would, perhaps, be useful to keep-an eye on where the primitive types are though.--LiftState carries the next name, and a list of new functions with -name, arguments, body--> data LiftState = SCS Int [(Name, [Name], SimpleCase)] --> lambdaLift :: Context -> IdrisState -> Name -> [Name] -> ->               SimpleCase -> [(Name, [Name], SimpleCase)]-> lambdaLift ctxt ist root args sc ->        = let -- scEta = expandCons ctxt sc -- Forcing does this! If we->              -- do it again, we undo some of the work forcing has done since->              -- we've reduced arity there.->              (body, SCS _ defs) = runState (liftSC args sc) (SCS 0 []) in->                  addRoot root args body defs->    where liftSC env (SCase tm alts) = do tm' <- lift env tm->                                          alts' <- mapM (liftAlt env) alts->                                          return (SCase tm' (sort alts'))->          liftSC env (Tm t) = do t' <- lift env t->                                 return (Tm t')->          liftSC env x = return x-->          liftAlt env (Alt c i args sc) = do sc' <- liftSC (env++args) sc->                                             return (Alt c i args sc')->          liftAlt env (ConstAlt c sc) = do sc' <- liftSC env sc->                                           return (ConstAlt c sc')->          liftAlt env (Default sc) = do sc' <- liftSC env sc->                                        return (Default sc')--First argument says whether to eta expand-->          lift env (Lambda n ty sc) = liftLam env [n] sc->          lift env (App f a) = do f' <- lift env f->                                  a' <- lift env a->                                  return (App f' a')-->          lift env (Let n ty val sc) = do val' <- lift env val->                                          sc' <- lift (n:env) sc->                                          return (Let n ty val' sc')->          lift env (Annotation a t) = do t' <- lift env t->                                         return (Annotation a t')->          -- and that's all the nested terms we care about->          lift env x = return x--Hoover up all the arguments to nested lambdsa, and make a new function.-with env and newargs. Apply it to the environment only.--FIXME: Invent a unique name for the lifted arg n. Epic can deal with it, but it's still-a bit unpleasant.-->          liftLam env newargs (Lambda n ty sc) ->                      = liftLam env (newargs++[n]) sc->          liftLam env newargs x = do->              x' <- lift (env++newargs) x->              newFn <- getNewSC->              -- new function is \ env newargs -> x'->              addFn newFn (env++newargs) (Tm x')->              -- new body is (newFn @ env)->              return (apply (Name Unknown newFn)->                            (map (Name Unknown) env))-->          getNewSC = do SCS i bs <- get->                        put (SCS (i+1) bs)->                        return (name (show (MN (show root) i)))-->          addFn name args body = do SCS i bs <- get->                                    put (SCS i ((name,args,body):bs))--We need to make sure all constructors are fully applied before we start--> expandCons ctxt sc = ec' sc->   where->     ec' (Tm tm) = Tm (ec tm)->     ec' (SCase tm alts) = SCase (ec tm) (map ecalt alts)->     ec' x = x->     ecalt (Alt n i ns sc) = Alt n i ns (ec' sc)->     ecalt (ConstAlt c sc) = ConstAlt c (ec' sc)->     ecalt (Default sc) = Default (ec' sc)-->     ec ap@(App f a) ->         | Right (ar, con, args) <- needsExp (App f a)->              = etaExp ar con args->     ec (App f a) = App f (ec a)->     ec (Lambda n ty sc) = Lambda n (ec ty) (ec sc)--That's all the terms we care about.-->     ec x = x-->     needsExp ap = needsExp' ap []->     needsExp' (App f a) as = needsExp' f ((ec a):as)->     needsExp' nm@(Name _ n) as ->         = do ar <- getConstructorArity ctxt n->              if (ar == length as) then ttfail "FAIL"->                  else Right (ar, nm, as)->     needsExp' _ _ = ttfail "FAIL"--We don't care about the type on the lambda here, We'll never look at it-even when compiling, it's just for the sake of having constructors fully-applied.-->     etaExp ar con args ->         = let newargs = map (\n -> (toIvorName (MN "exp" n)))->                            [1..(ar-(length args))] in->               addLam newargs (apply con (args++(map (Name Unknown) newargs)))->     addLam [] t = t->     addLam (n:ns) t = Lambda n Star (addLam ns t)--Second step, turn the lambda lifted SimpleCases into SCFuns, translating -IO operations and do notation as we go. Pass relevant function flags through--> scFun :: Context -> IdrisState -> Id -> [Name] -> SimpleCase -> SCFun-> scFun ctxt ist fn args lifted = SCFun mkOpts args (toSC ctxt ist lifted)->    where mkOpts' = do ifn <- ctxtLookup (idris_context ist) [] fn->                       let decl = rawDecl ifn->                       let opts = if (null (lazyArgs ifn)) ->                                    then [SCStrict] else []->                       return $ opts ++ mapMaybe mkSCOpt (funFlags ifn)->                       {- exp <- case decl of->                           Fun _ fls -> getExpFlag fls->                           TermDef _ _ fls -> getExpFlag fls->                            _ -> fail "" -}-->          mkOpts = case mkOpts' of->                         Left _ -> []->                         Right x -> x-->          mkSCOpt (CExport str) = Just $ SCExport str->          mkSCOpt Inline = Just $ SCInline->          mkSCOpt _ = Nothing--> class ToSC a where->     toSC :: Context -> IdrisState -> a -> SCBody--> instance ToSC SimpleCase where->     toSC c ist ErrorCase = SError->     toSC c ist Impossible = SError->     toSC c ist (Tm vt) = toSC c ist vt->     toSC c ist (SCase vt alts) = SCCase (toSC c ist vt) (map toSCa alts)->        where toSCa (Alt n i ns sc) = SAlt n i ns (toSC c ist sc)->              toSCa (ConstAlt v sc) = SConstAlt v (toSC c ist sc)->              toSCa (Default sc)  = SDefault (toSC c ist sc)--> instance ToSC ViewTerm where->     toSC ctxt ist t = sc' t [] where->        sc' (Name ty n) args ->          | n == toIvorName (UN "__Prove_Anything")->            -- we can't actually use this value!->             = SCon (toIvorName (UN "__FAKE")) 0 ->          | n == toIvorName (UN "__Suspend_Disbelief") -- arbitrary refl->             = scapply ist (SCon (toIvorName (UN "refl")) 0) args -- can't actually use this either->          | ty == DataCon->             = case getConstructorTag ctxt n of->                   Right i -> scapply ist (SCon n i) args->          | otherwise->             = case nameType ctxt n of->                   Right TypeCon -> SUnit->                   _ -> scapply ist (SVar n) args->        sc' (App f a) args = sc' f ((sc' a []):args)->        sc' (Let n ty val x) args ->                = scapply ist (SLet n (sc' val []) (sc' x [])) args--Chars are just treated as Ints by the compiler, so convert here.-->        sc' (Constant c) [] ->            = case (cast c)::Maybe Int of->                 Just i -> SConst (Num i)->                 Nothing -> ->                    case (cast c)::Maybe String of->                           Just s -> SConst (Str s)->                           Nothing -> case (cast c)::Maybe Char of->                                        Just c -> SConst (Num (fromEnum c))->                                        Nothing -> case (cast c)::Maybe Double of->                                                     Just c -> SConst (Fl c)->        sc' (Annotation _ x) args = sc' x args->        sc' Placeholder args = SUnit->        sc' x args = SUnit -- no runtime meaning--scapply deals with special cases for infix operators, IO, etc.--> scapply :: IdrisState -> SCBody -> [SCBody] -> SCBody--Infix operators--> scapply ist (SVar n) [x,y]->         | Just op <- getOp n allOps = SInfix op x y-> scapply ist (SVar n) [_,_,_,_]->         | n == opFn JMEq = SUnit-- scapply ist (SVar n) [_,x,y]-         | n == opFn OpEq = SInfix OpEq x y--> scapply ist f [] = f--> scapply ist (SVar n) args->         = let raw = idris_context ist in->           case ctxtLookup raw [] (fromIvorName ist n) of->             Left _ -> SApp (SVar n) args->             Right ifn -> let ia = implicitArgs ifn->                              lz = lazyArgs ifn ->                              args' = makeLazy (map (ia+) lz) args in->                              SApp (SVar n) args'-> scapply ist (SCon n i) args->         = let raw = idris_context ist in->           case ctxtLookup raw [] (fromIvorName ist n) of->             Left _ -> SApp (SCon n i) args->             Right ifn -> let ia = implicitArgs ifn->                              lz = lazyArgs ifn ->                              args' = makeLazy (map (ia+) lz) args in->                              SApp (SCon n i) args'--Everything else--> scapply ist f args = SApp f args--> makeLazy :: [Int] -> [SCBody] -> [SCBody]-> makeLazy lz args = zipWith ml' ->                       (map (\x -> elem x lz) [0..(length args-1)]) args->   where ml' True arg = SLazy arg->         ml' False arg = arg--> addRoot :: Name -> [Name] -> SimpleCase -> [(Name, [Name], SimpleCase)] ->            -> [(Name, [Name], SimpleCase)] -> addRoot root [] body@(Tm (Name _ n)) defs =->         case lookupT n defs of->           Just (as,b) -> (root, as, b):defs->           _ -> (root, [], body):defs->     where lookupT n ds = lookup n (map (\ (x,y,z) -> (x, (y,z))) ds)-> addRoot root args body defs = (root, args, body):defs
− Idris/Latex.lhs 
@@ -1,151 +0,0 @@-> {-# OPTIONS_GHC -fglasgow-exts #-}--> module Idris.Latex(latexDump,latexDefs) where--> import Idris.AbsSyntax-> import Debug.Trace--> latexDefs :: [String] -> [(Id,String)]-> latexDefs [] = []-> latexDefs (d:ds) = case span (/='=') d of->                      (i,a:def) -> (UN i, def):(latexDefs ds)->                      _ -> latexDefs ds--> latexDump :: Ctxt IvorFun -> [(Id,String)] -> Id -> IO ()-> latexDump ctxt defs nm = case ctxtLookup ctxt [] nm of->                            Right fn -> putStrLn $ latex ctxt defs fn->                            Left _ -> do putStrLn "No such name"->                                         return ()--> class LaTeX a where->     latex :: Ctxt IvorFun -> [(Id, String)] -> a -> String--> instance LaTeX Id where->     latex ctxt defs n ->         = case lookup n (defs++ldefs) of->             Just l -> l->             Nothing -> case ctxtLookup ctxt [] n of->                          Right (IvorFun _ _ _ _ d _ _ _) -> ty d (show n)->                          Left _ -> "\\VV{" ++ show n ++ "}"->         where ty (DataDecl _) n = "\\TC{" ++ n ++ "}"          ->               ty Constructor n = "\\DC{" ++ n ++ "}"->               ty _ n = "\\FN{" ++ n ++ "}"->               ldefs = case ctxtLookup ctxt [] (MN "latex" 0) of->                         Right (IvorFun _ _ _ _ (LatexDefs ds) _ _ _) -> ds->                         Left _ -> []--> instance LaTeX IvorFun where->     latex ctxt defs (IvorFun nm ty _ _ decl _ _ _) = latex ctxt defs decl--> instance LaTeX Decl where->     latex ctxt defs (DataDecl (Datatype id ty cons _ _ _ _))->           = "\\DM{\\AR{\n\\Data\\hg\\:" ++ ->             latex ctxt defs id ++ "\\:\\Hab\\:\\AR{" ++->             latex ctxt defs ty ++ "\\hg\\Where}\\\\ \n\\begin{array}{rl}\n" ++ ->                     conList (map (latex ctxt defs) cons) ++->                             "\\end{array}\n}}"->        where conList [] = ""->              conList [a] = " & " ++ a ++ "\n"->              conList (a:as) = " & " ++ a ++ "\\\\ \n \\mid" ++ conList as ->     latex ctxt defs (Fun f _) = latex ctxt defs f->     latex ctxt defs (TermDef n tm _) = "\\DM{" ++ latex ctxt defs n ++ "\\:=\\:" ++ latex ctxt defs tm ++ "}"->     latex ctxt defs (Fwd n ty _) = "\\DM{" ++ latex ctxt defs n ++ "\\:\\Hab\\:\\AR{" ++ latex ctxt defs ty ++ "}}"->     latex ctxt defs _ = "Can't LaTeXify this"->                                --> instance LaTeX Function where->     latex ctxt defs (Function n ty clauses _ _) =->         "\\DM{\\AR{\n" ++->         latex ctxt defs n ++ "\\:\\Hab\\:\\AR{" ++ latex ctxt defs ty ++ "}\\\\ \n" ++->         latexClauses clauses ++ "}}"->        where latexClauses [] = ""->              latexClauses cs@((n,(RawClause lhs rhs)):_) =->                  let arity = length (getRawArgs lhs) in->                         "\\PA{" ++ concat (take arity (repeat "\\A")) ++ ->                         "}{" ++->                         concat (map (latex ctxt defs) cs) ++ "}"--> instance LaTeX RawClause where->     latex ctxt defs (RawClause lhs rhs)->                 = let args = getRawArgs lhs->                       fn = getFn lhs in->                       showArgs (fn:args) ++ " & \\Ret{" ++ ->                                latex ctxt defs rhs ++ "}\\\\ \n"->         where->             showArgs [] = ""->             showArgs (a:as) = " & " ++ bracket (latex ctxt defs a) ++ showArgs as->             bracket x | ':' `elem` x = "(" ++ x ++ ")"->                       | otherwise = x--Type/term pairs--> instance (LaTeX a) => LaTeX (a,RawTerm) where->     latex ctxt defs (tm,ty) = latex ctxt defs tm ++ "\\:\\Hab\\:\\AR{" ++ latex ctxt defs ty ++ "}"--Clauses--> instance (LaTeX a) => LaTeX (a,RawClause) where->     latex ctxt defs (nm,clause) = latex ctxt defs clause--Constants--> instance LaTeX Constant where->     latex ctxt defs TYPE = "\\Type"->     latex ctxt defs StringType = "\\TC{String}"->     latex ctxt defs IntType = "\\TC{Int}"->     latex ctxt defs FloatType = "\\TC{Float}"->     latex ctxt defs (Builtin s) = "\\TC{" ++ s ++ "}"->     latex ctxt defs n = show n--Main bit for terms--> instance LaTeX RawTerm where->     latex ctxt defs tm = showP 10 tm where->        showP p (RVar _ _ (UN "__Unit") _) = "()"->        showP p (RVar _ _ (UN "__Empty") _) = "\\bottom"->        showP p (RVar _ _ i _) = latex ctxt defs i->        showP p RRefl = "\\DC{refl}"->        showP p RPlaceholder = "\\_"->        showP p (RApp _ _ f a) = bracket p 1 $ showP 1 f ++ "\\:" ++ showP 0 a->        showP p (RAppImp _ _ n f a) = showP 1 f->        showP p (RBind n (Lam ty) sc)->           = bracket p 2 $ ->             "\\lambda\\VV{" ++ show n ++ "}." ++ showP 10 sc->        showP p (RBind n (Pi Ex _ ty) sc)->           | internal n -- hack for spotting unused names quickly!->              = bracket p 2 $ showP 1 ty ++ "\\to" ++ showP 10 sc->           | otherwise->              = bracket p 2 $->                "(\\VV{" ++ show n ++ "} \\Hab " ++ showP 10 ty ++ ")\\to" ++->                       showP 10 sc->          where internal (UN ('_':'_':_)) = True->                internal (MN _ _) = True->                internal _ = False->        showP p (RBind n (Pi Im _ ty) sc)->              = bracket p 2 $ showP 10 sc->        showP p (RBind n (RLet val ty) sc)->           = bracket p 2 $->             "\\LET:\\VV{" ++ show n ++ "}\\: = " ++ showP 10 val->                    ++ "\\:\\IN\\:" ++ showP 10 sc->        showP p (RConst _ _ c) = latex ctxt defs c->        showP p (RInfix _ _ op l r) = bracket p 5 $->                                      showP 4 l ++ show op ++ showP 4 r--We want the closing bracket inside the \AR here, so it's on the right line,-hence the weird bracketing.-->        showP p (RDo ds) = (bracket p 2 $->                            "\\RW{do}\\:\\AR{" ++ ->                            concat (map (latex ctxt defs) ds)) ++ "}"->                            ->        showP _ x = show x ->        bracket outer inner str | inner>outer = "("++str++")"->                                | otherwise = str--> instance LaTeX Do where->     latex ctxt defs (DoBinding _ _ n ty tm) ->         = latex ctxt defs n ++ "\\leftarrow " ++ latex ctxt defs tm ++ ->           "\\\\ \n"->     latex ctxt defs (DoExp _ _ tm) = latex ctxt defs tm ++ "\\\\ \n"--
− Idris/Lexer.hs 
@@ -1,465 +0,0 @@-module Idris.Lexer where--import Data.Char-import Debug.Trace--import Idris.AbsSyntax--type LineNumber = Int--type P a = String -> String -> LineNumber -> Fixities -> Result a--getLineNo :: P LineNumber-getLineNo = \s fn l ops -> Success l--getFileName :: P String-getFileName = \s fn l ops -> Success fn--getContent :: P String-getContent = \s fn l ops -> Success s--getOps :: P Fixities-getOps = \s fn l ops -> Success ops--thenP :: P a -> (a -> P b) -> P b-m `thenP` k = \s fn l ops ->-   case m s fn l ops of-       Success a -> k a s fn l ops-       Failure e f ln -> Failure e f ln--returnP :: a -> P a-returnP a = \s fn l ops -> Success a--failP :: String -> P a-failP err = \s fn l ops -> Failure err fn l--catchP :: P a -> (String -> P a) -> P a-catchP m k = \s fn l ops ->-   case m s fn l ops of-      Success a -> Success a-      Failure e f ln -> k e s fn l ops--happyError :: P a-happyError = reportError "Parse error"--reportError :: String -> P a-reportError err = getFileName `thenP` \fn ->-                  getLineNo `thenP` \line ->-		  getContent `thenP` \str ->-                      failP (fn ++ ":" ++ show line ++ ":" ++ err ++ -                             " - before " ++ take 80 str ++ "...")--data Token-      = TokenName Id-      | TokenNSep-      | TokenInfixName String-      | TokenBrackName Id-      | TokenString String-      | TokenInt Int-      | TokenFloat Double-      | TokenChar Char-      | TokenBool Bool-      | TokenMetavar Id-      | TokenIntType-      | TokenCharType-      | TokenBoolType-      | TokenFloatType-      | TokenStringType-      | TokenHandleType-      | TokenLockType-      | TokenPtrType-      | TokenDataType-      | TokenCoDataType-      | TokenInfix-      | TokenInfixL-      | TokenInfixR-      | TokenParams-      | TokenUsing-      | TokenIdiom-      | TokenNoElim-      | TokenCollapsible-      | TokenPartial-      | TokenSyntax-      | TokenLazy-      | TokenStatic-      | TokenWhere-      | TokenWith-      | TokenType-      | TokenLType-      | TokenLazyBracket-      | TokenOB-      | TokenCB-      | TokenOCB-      | TokenCCB-      | TokenHashOB-      | TokenLPair-      | TokenRPair-      | TokenOSB-      | TokenCSB-      | TokenOId-      | TokenCId---      | TokenExists-      | TokenConcat-      | TokenTilde-      | TokenPlus-      | TokenMinus-      | TokenTimes-      | TokenDivide-      | TokenEquals-      | TokenOr-      | TokenAnd-      | TokenMightEqual-      | TokenEQ-      | TokenGE-      | TokenLE-      | TokenGT-      | TokenLT-      | TokenArrow-      | TokenFatArrow-      | TokenTransArrow-      | TokenLeftArrow-      | TokenColon-      | TokenSemi-      | TokenComma-      | TokenTuple-      | TokenBar-      | TokenStars-      | TokenDot-      | TokenEllipsis-      | TokenLambda-      | TokenInclude-      | TokenModule-      | TokenNamespace-      | TokenPublic-      | TokenPrivate-      | TokenAbstract-      | TokenImport-      | TokenExport-      | TokenInline-      | TokenDo-      | TokenReturn-      | TokenIf-      | TokenThen-      | TokenElse-      | TokenLet-      | TokenIn-      | TokenRefl-      | TokenEmptyType-      | TokenUnitType-      | TokenUnderscore-      | TokenBang--- Tactics-      | TokenProof-      | TokenTryProof-      | TokenIntro-      | TokenRefine-      | TokenExists-      | TokenGeneralise-      | TokenReflP-      | TokenRewrite-      | TokenRewriteAll-      | TokenCompute-      | TokenUnfold-      | TokenUndo-      | TokenInduction-      | TokenFill-      | TokenTrivial-      | TokenSimpleSearch-      | TokenMkTac-      | TokenBelieve-      | TokenUse-      | TokenDecide-      | TokenAbandon-      | TokenProofTerm-      | TokenQED--- Directives-      | TokenLaTeX-      | TokenNoCG-      | TokenEval-      | TokenSpec-      | TokenFreeze-      | TokenThaw-      | TokenTransform-      | TokenCInclude-      | TokenCLib-      | TokenHide-      | TokenEOF- deriving (Show, Eq)---lexer :: (Token -> P a) -> P a-lexer cont [] = cont TokenEOF []-lexer cont ('\n':cs) = \fn line -> lexer cont cs fn (line+1)--- empty type-lexer cont ('_':'|':'_':cs) = cont TokenEmptyType cs-lexer cont ('_':c:cs) | not (isAlpha c) && c/='_' = cont TokenUnderscore (c:cs)-lexer cont (c:cs)-      | isSpace c = \fn line -> lexer cont cs fn line-      | isAlpha c = lexVar cont (c:cs)-      | isDigit c = lexNum cont (c:cs)-      | c == '_' = lexVar cont (c:cs)--- unit type-lexer cont ('(':')':cs) = cont TokenUnitType cs-lexer cont ('"':cs) = lexString cont cs-lexer cont ('\'':cs) = lexChar cont cs-lexer cont ('{':'-':cs) = lexerEatComment 0 cont cs-lexer cont ('-':'-':cs) = lexerEatToNewline cont cs-lexer cont ('(':cs) = cont TokenOB cs-lexer cont (')':cs) = cont TokenCB cs-lexer cont ('{':c:cs) -    | isAlpha c || c=='_' = lexBrackVar cont (c:cs)-lexer cont ('{':cs) = cont TokenOCB cs-lexer cont ('}':cs) = cont TokenCCB cs-lexer cont ('[':'|':cs) = cont TokenOId cs-lexer cont ('|':']':cs) = cont TokenCId cs-lexer cont ('[':cs) = cont TokenOSB cs-lexer cont (']':cs) = cont TokenCSB cs-lexer cont ('?':'=':cs) = cont TokenMightEqual cs-lexer cont (';':cs) = cont TokenSemi cs-lexer cont ('\\':cs) = cont TokenLambda cs-lexer cont ('#':'(':cs) = cont TokenHashOB cs--- lexer cont ('#':cs) = cont TokenType cs-lexer cont (',':cs) = cont TokenComma cs-lexer cont ('|':'(':cs) = cont TokenLazyBracket cs-lexer cont ('%':cs) = lexSpecial cont cs-lexer cont ('?':cs) = lexMeta cont cs-lexer cont (c:cs) | isOpPrefix c = lexOp cont (c:cs)-lexer cont (c:cs) = lexError c cs--lexError c s l ops = failP (show l ++ ": Unrecognised token '" ++ [c] ++ "'\n") s l ops--lexerEatComment nls cont ('-':'}':cs)-    = \fn line -> lexer cont cs fn (line+nls)-lexerEatComment nls cont ('\n':cs) = lexerEatComment (nls+1) cont cs-lexerEatComment nls cont (c:cs) = lexerEatComment nls cont cs--lexerEatToNewline cont ('\n':cs)-   = \fn line -> lexer cont cs fn (line+1)-lexerEatToNewline cont []-   = \fn line -> lexer cont [] fn line-lexerEatToNewline cont (c:cs) = lexerEatToNewline cont cs--lexNum cont cs = case readNum cs of-                    (num,rest,isreal) ->-                        cont (tok num isreal) rest-  where tok num isreal | isreal = TokenFloat (read num)-                       | otherwise = TokenInt (read num)--readNum :: String -> (String,String,Bool)-readNum x = rn' False "" x-  where rn' dot acc [] = (acc,[],dot)-        rn' False acc ('.':xs) | head xs /= '.' = rn' True (acc++".") xs-        rn' dot acc (x:xs) | isDigit x = rn' dot (acc++[x]) xs-        rn' dot acc ('e':'+':xs) = rn' True (acc++"e+") xs-        rn' dot acc ('e':'-':xs) = rn' True (acc++"e-") xs-        rn' dot acc ('e':xs) = rn' True (acc++"e") xs-        rn' dot acc xs = (acc,xs,dot)--lexString cont cs =-   \fn line ops ->-   case getstr cs of-      Just (str,rest,nls) -> cont (TokenString str) rest fn (nls+line) ops-      Nothing -> failP (fn++":"++show line++":Unterminated string contant")-                    cs fn line ops--lexChar cont cs =-   \fn line ops ->-   case getchar cs of-      Just (str,rest) -> cont (TokenChar str) rest fn line ops-      Nothing ->-          failP (fn++":"++show line++":Unterminated character constant")-                       cs fn line ops--isAllowed c = isAlpha c || isDigit c || c `elem` "_\'?#."--lexVar cont cs =-   case span isAllowed cs of--- Keywords-      ("proof",rest) -> cont TokenProof rest-      ("tryproof",rest) -> cont TokenTryProof rest-      ("data",rest) -> cont TokenDataType rest-      ("codata",rest) -> cont TokenCoDataType rest-      ("using",rest) -> cont TokenUsing rest-      ("idiom",rest) -> cont TokenIdiom rest-      ("params",rest) -> cont TokenParams rest-      ("namespace",rest) -> cont TokenNamespace rest-      ("public",rest) -> cont TokenPublic rest-      ("private",rest) -> cont TokenPrivate rest-      ("abstract",rest) -> cont TokenAbstract rest-      ("module",rest) -> cont TokenModule rest-      ("import",rest) -> cont TokenImport rest-      ("export",rest) -> cont TokenExport rest-      ("inline",rest) -> cont TokenInline rest-      ("noElim",rest) -> cont TokenNoElim rest-      ("collapsible",rest) -> cont TokenCollapsible rest-      ("where",rest) -> cont TokenWhere rest-      ("with",rest) -> cont TokenWith rest-      ("partial",rest) -> cont TokenPartial rest-      ("syntax",rest) -> cont TokenSyntax rest-      ("lazy",rest) -> cont TokenLazy rest-      ("static",rest) -> cont TokenStatic rest-      ("infix",rest) -> cont TokenInfix rest-      ("infixl",rest) -> cont TokenInfixL rest-      ("infixr",rest) -> cont TokenInfixR rest-      ("exists",rest) -> cont TokenExists rest--- Types-      ("Set",rest) -> cont TokenType rest-      ("LSet",rest) -> cont TokenLType rest-      ("Int",rest) -> cont TokenIntType rest-      ("Char",rest) -> cont TokenCharType rest-      ("Float",rest) -> cont TokenFloatType rest-      ("String",rest) -> cont TokenStringType rest-      ("Lock",rest) -> cont TokenLockType rest-      ("Handle",rest) -> cont TokenHandleType rest-      ("Ptr",rest) -> cont TokenPtrType rest-      ("refl",rest) -> cont TokenRefl rest-      ("include",rest) -> cont TokenInclude rest-      ("do",rest) -> cont TokenDo rest-      ("return",rest) -> cont TokenReturn rest-      ("if",rest) -> cont TokenIf rest-      ("then",rest) -> cont TokenThen rest-      ("else",rest) -> cont TokenElse rest-      ("let",rest) -> cont TokenLet rest-      ("in",rest) -> cont TokenIn rest--- values--- expressions-      (var,rest) -> cont (mkname var) rest--lexOp cont cs = case span isOpChar cs of-                   (":",rest) -> cont TokenColon rest---                   ("+",rest) -> cont TokenPlus rest-                   ("-",rest) -> cont TokenMinus rest---                   ("*",rest) -> cont TokenTimes rest---                   ("/",rest) -> cont TokenDivide rest-                   ("=",rest) -> cont TokenEquals rest---                   ("==",rest) -> cont TokenEQ rest-                   (">",rest) -> cont TokenGT rest-                   ("<",rest) -> cont TokenLT rest---                   (">=",rest) -> cont TokenGE rest---                   ("<=",rest) -> cont TokenLE rest---                   ("++",rest) -> cont TokenConcat rest---                   ("&&",rest) -> cont TokenAnd rest-                   ("<|",rest) -> cont TokenLPair rest-                   ("|>",rest) -> cont TokenRPair rest-                   ("&",rest) -> cont TokenTuple rest---                   ("||",rest) -> cont TokenOr rest-                   ("...",rest) -> cont TokenEllipsis rest-                   ("**",rest) -> cont TokenStars rest-                   ("|",rest) -> cont TokenBar rest-                   ("!",rest) -> cont TokenBang rest-                   ("->", rest) -> cont TokenArrow rest-                   ("=>", rest) -> cont TokenFatArrow rest-                   -- ("==>", rest) -> cont TokenTransArrow rest-                   ("<-", rest) -> cont TokenLeftArrow rest-                   ("~", rest) -> cont TokenTilde rest-                   (op,rest) -> cont (TokenInfixName op) rest--isOpPrefix c = c `elem` ":+-*/=_.?|&><!@$%^~#"-isOpChar = isOpPrefix--lexBrackVar cont cs =-    case span isAllowed cs of-      (var,rest) -> cont (TokenBrackName (UN var)) rest--lexSpecial cont cs =-    case span isAllowed cs of-      ("latex",rest) -> cont TokenLaTeX rest-      ("nocg",rest) -> cont TokenNoCG rest-      ("eval",rest) -> cont TokenEval rest-      ("spec",rest) -> cont TokenSpec rest-      ("freeze",rest) -> cont TokenFreeze rest-      ("thaw",rest) -> cont TokenThaw rest-      ("transform",rest) -> cont TokenTransform rest-      ("include",rest) -> cont TokenCInclude rest-      ("lib",rest) -> cont TokenCLib rest-      ("hide",rest) -> cont TokenHide rest--- tactics--- FIXME: it'd be better to have a 'theorem proving' state so that these--- don't need the ugly syntax...-      ("intro",rest) -> cont TokenIntro rest-      ("refine",rest) -> cont TokenRefine rest-      ("exists",rest) -> cont TokenExists rest-      ("generalise",rest) -> cont TokenGeneralise rest-      ("refl",rest) -> cont TokenReflP rest-      ("rewrite",rest) -> cont TokenRewrite rest-      ("rewriteall",rest) -> cont TokenRewriteAll rest-      ("compute",rest) -> cont TokenCompute rest-      ("unfold",rest) -> cont TokenUnfold rest-      ("undo",rest) -> cont TokenUndo rest-      ("induction",rest) -> cont TokenInduction rest-      ("fill", rest) -> cont TokenFill rest-      ("trivial", rest) -> cont TokenTrivial rest-      ("searchcontext", rest) -> cont TokenSimpleSearch rest-      ("mktac", rest) -> cont TokenMkTac rest-      ("believe", rest) -> cont TokenBelieve rest-      ("use", rest) -> cont TokenUse rest-      ("decide", rest) -> cont TokenDecide rest-      ("abandon", rest) -> cont TokenAbandon rest-      ("prf", rest) -> cont TokenProofTerm rest-      ("qed", rest) -> cont TokenQED rest-      (thing,rest) -> lexError '%' rest---- Read everything up to '[whitespace]Qed'-{--lexProof cont cs = -   \fn line ->-      case getprf cs of-        Just (str,rest,nls) -> cont (TokenProof str) rest fn (nls+line)-        Nothing -> failP (fn++":"++show line++":No QED in Proof")-                          cs fn line--}--lexMeta cont cs =-    case span isAllowed cs of-      (thing,rest) -> cont (TokenMetavar (UN thing)) rest--mkname :: String -> Token-mkname c = TokenName (mkNS c)--mkNS c = let xs = mkNS' [] [] c in-            case xs of-              [x] -> UN x-              (x:xs) -> NS (map UN (reverse xs)) (UN x)- where-  mkNS' acc wds [] = reverse acc:wds-  mkNS' acc wds ('.':cs) = mkNS' [] (reverse acc:wds) cs-  mkNS' acc wds (c:cs) = mkNS' (c:acc) wds cs--getstr :: String -> Maybe (String,String,Int)-getstr cs = case getstr' "" cs 0 of-               Just (str,rest,nls) -> Just (reverse str,rest,nls)-               _ -> Nothing-getstr' acc ('\"':xs) = \nl -> Just (acc,xs,nl)-getstr' acc ('\\':'n':xs) = getstr' ('\n':acc) xs -- Newline-getstr' acc ('\\':'r':xs) = getstr' ('\r':acc) xs -- CR-getstr' acc ('\\':'t':xs) = getstr' ('\t':acc) xs -- Tab-getstr' acc ('\\':'b':xs) = getstr' ('\b':acc) xs -- Backspace-getstr' acc ('\\':'a':xs) = getstr' ('\a':acc) xs -- Alert-getstr' acc ('\\':'f':xs) = getstr' ('\f':acc) xs -- Formfeed-getstr' acc ('\\':'0':xs) = getstr' ('\0':acc) xs -- null-getstr' acc ('\\':x:xs) = getstr' (x:acc) xs -- Literal-getstr' acc ('\n':xs) = \nl ->getstr' ('\n':acc) xs (nl+1) -- Count the newline-getstr' acc (x:xs) = getstr' (x:acc) xs-getstr' _ _ = \nl -> Nothing--getchar :: String -> Maybe (Char,String)-getchar ('\\':'n':'\'':xs) = Just ('\n',xs) -- Newline-getchar ('\\':'r':'\'':xs) = Just ('\r',xs) -- CR-getchar ('\\':'t':'\'':xs) = Just ('\t',xs) -- Tab-getchar ('\\':'b':'\'':xs) = Just ('\b',xs) -- Backspace-getchar ('\\':'a':'\'':xs) = Just ('\a',xs) -- Alert-getchar ('\\':'f':'\'':xs) = Just ('\f',xs) -- Formfeed-getchar ('\\':'0':'\'':xs) = Just ('\0',xs) -- null-getchar ('\\':x:'\'':xs) = Just (x,xs) -- Literal-getchar (x:'\'':xs) = Just (x,xs)-getchar _ = Nothing--getprf :: String -> Maybe (String, String, Int)-getprf s = case getprf' "" s 0 of -               Just (str,rest,nls) -> Just (reverse str,rest,nls)-               _ -> Nothing-getprf' acc (c:'Q':'E':'D':rest)-    | isSpace c = \nl -> Just (acc,rest,nl)-getprf' acc ('\n':xs) = \nl ->getprf' ('\n':acc) xs (nl+1) -- Count the newline-getprf' acc (x:xs) = getprf' (x:acc) xs-getprf' acc _ = \nl -> Nothing
− Idris/Lib.lhs 
@@ -1,15 +0,0 @@-> {-# OPTIONS_GHC -fglasgow-exts #-}--> module Idris.Lib(defaultLibPath, readLibFile) where--> import Paths_idris--> defaultLibPath = [] -- prefix ++ "/lib/idris"]--> readLibFile :: [FilePath] -> FilePath -> IO String-> readLibFile xs x = ->    do dfname <- getDataFileName x->       tryReads ((map (\f -> f ++ "/" ++ x) (".":xs))++[dfname])->    where tryReads [] = fail $ "Can't find " ++ x->          tryReads (x:xs) = do catch (readFile x)->                                  (\e -> tryReads xs)
− Idris/MakeTerm.lhs 
@@ -1,418 +0,0 @@-> module Idris.MakeTerm where--> import Idris.AbsSyntax-> import Idris.Prover-> import Idris.SimpleCase-> import Idris.PartialEval--> import Ivor.TT as TT-> import Debug.Trace--> import Control.Monad-> import Control.Monad.State-> import List--Work out how many implicit arguments we need, then translate our definition-into an ivor definition, with all the necessary placeholders added.--The definition may generate new definitions (e.g. metavariables with proofs-attached).--> makeIvorFun ::  Implicit -> UndoInfo -> UserOps ->->                 Ctxt IvorFun -> Decl -> Function -> [CGFlag] -> ->                 (IvorFun, [Decl])--> makeIvorFun using ui uo ctxt decl (Function n ty clauses file line) flags->     = let (rty, imp) = addImplWith using ctxt (syntax ctxt using uo ty)->           ity = makeIvorTerm using ui uo n ctxt rty->           extCtxt = addEntry ctxt (thisNamespace using) n (IvorFun Nothing (Just ity) ->                                       imp Nothing decl flags (map (+p) (getLazy ty)) (map (+p) (getStatic ty)))->           clauses' = map (\ (n, c) -> (n, syntaxClause ctxt using uo c)) clauses ->           (clausesm, (_, newms)) ->                 = runState (insertMetasClauses n clauses') (0, [])->           pclauses = map (mkPat extCtxt imp) clausesm->           newdefs = reverse (map mkPrf newms) in->       (IvorFun (Just (toIvorName (fullName using n))) ->                   (Just (Annotation (FileLoc file line) ity)) imp ->                   (Just (PattDef (Patterns pclauses))) decl flags ->                   (map (+p) (getLazy ty)) (map (+p) (getStatic ty)),->                   newdefs)->   where p = length (params using)->         mkPat ectx imp (id,(RawClause lhs rhs)) ->               = let lhs' = addPlaceholders ectx using uo lhs in->                     case (getFn lhs', getRawArgs lhs') of->                          (fid, pats) ->->                            let vpats = map (toIvor uo ui n) pats->                                vrhs = makeIvorTerm using ui uo n ectx rhs in->                                PClause vpats [] vrhs->         mkPat ectx imp (id,(RawWithClause lhs prf scr def))->               = let lhs' = addPlaceholders ectx using uo lhs in->                     case (getFn lhs', getRawArgs lhs') of->                          (fid, pats) ->->                            let vpats = map (toIvor uo ui n) pats->                                vscr = makeIvorTerm using ui uo n ectx scr->                                vdef = Patterns $ map (mkPat ectx imp) (zip (repeat id) def) in->                                PWithClause prf vpats vscr vdef->         mkPrf (nm, tacs, failable) = Prf (Proof nm Nothing tacs) failable--> makeIvorFuns :: [Opt] -> Ctxt IvorFun -> ->                 [Decl] -> UserOps -> (Ctxt IvorFun, UserOps)-> makeIvorFuns opts is defs uo = mif opts is newCtxt noImplicit defDo uo defs--> mif :: [Opt] ->->        Ctxt IvorFun -> -- init->        Ctxt IvorFun -> -- new->        Implicit -> -- implicits->        UndoInfo -> -- do using bind, return->        UserOps -> -- Users operators->        [Decl] -> (Ctxt IvorFun, UserOps)-> mif opt ctxt acc using ui uo [] = (acc, uo)-> mif opt ctxt acc using' ui uo ((Using using decls):ds)->         = let (acc', uo') = mif opt ctxt acc (addUsing using' (Imp using [] [] (thisNamespace using'))) ui uo decls in->               mif opt ctxt acc' using' ui uo' ds-> mif opt ctxt acc using' ui uo ((Params newps decls):ds)->         = let (acc', uo') = (mif opt ctxt acc (addParams using' newps) ui uo decls) in->               mif opt ctxt acc' using' ui uo' ds-> mif opt ctxt acc using' ui uo ((Namespace n decls):ds)->         = let (acc', uo') = (mif opt ctxt acc (addNS using' n) ui uo decls) in->               mif opt ctxt acc' using' ui uo' ds-> mif opt ctxt acc using ui@(UI _ _ _ _ p pi r ri) uo ((DoUsing bind ret decls):ds)->         = let (acc', uo') = (mif opt ctxt acc using ui' uo decls) in->              mif opt ctxt acc' using ui uo' ds->    where ui' = let (bimpl, bfull) ->                       = case ctxtLookupName (appCtxt ctxt acc) (thisNamespace using) bind of->                              Right (i, bfull) -> (implicitArgs i, bfull)->                              Left err -> error (show err)->                    (rimpl, rfull)->                       = case ctxtLookupName (appCtxt ctxt acc) (thisNamespace using) ret of->                              Right (i, rfull) -> (implicitArgs i, rfull)->                              Left err -> error (show err)->                     in UI bfull bimpl rfull rimpl p pi r ri-> mif opt ctxt acc using ui@(UI b bi r ri _ _ _ _) uo ((Idiom pure ap decls):ds)->         = let (acc', uo') = (mif opt ctxt acc using ui' uo decls) in->             mif opt ctxt acc' using ui uo' ds->    where ui' = let (pureImpl, pfull) ->                      = case ctxtLookupName (appCtxt ctxt acc) (thisNamespace using) pure of->                              Right (i, pfull) -> (implicitArgs i, pfull)->                              Left err -> error (show err)->                    (apImpl, afull) ->                      = case ctxtLookupName (appCtxt ctxt acc) (thisNamespace using) ap of->                              Right (i, afull) -> (implicitArgs i, afull)->                              Left err -> error (show err)->                     in UI b bi r ri pfull pureImpl afull apImpl-> mif opt ctxt acc using' ui uo (decl@(Fun f flags):ds) ->         = let using = addParamName using' (funId f)->               (fn, newdefs) = makeIvorFun using ui uo (appCtxt ctxt acc) decl f flags in->               mif opt ctxt (addEntry acc (thisNamespace using) (funId f) fn) using ui uo (newdefs ++ ds)-> mif opt ctxt acc using' ui uo (decl@(Fwd n ty flags):ds) ->      = let (file, line) = getFileLine ty->            using = addParamName using' n->            (rty, imp) = addImplWith using (appCtxt ctxt acc) ty->            ity = makeIvorTerm using ui uo n (appCtxt ctxt acc) rty in->            mif opt ctxt (addEntry acc (thisNamespace using) n ->                         (IvorFun (Just (toIvorName (fullName using n))) ->                            (Just (Annotation (FileLoc file line) ity))->                              imp (Just Later) decl flags (getLazy ty) (getStatic ty))) using ui uo ds-> mif opt ctxt acc using' ui uo (decl@(DataDecl d):ds) ->      = let using = addParamName using' (tyId d) in->            addDataEntries opt ctxt acc decl d using ui uo ds -- will call mif on ds-> mif opt ctxt acc using ui uo@(UO _ trans _ _) (decl@(TermDef n tm flags):ds) ->     | null $ params using->         = let (itmraw, imp) = addImplWith using (appCtxt ctxt acc) tm->               itm = makeIvorTerm using ui uo n (appCtxt ctxt acc) itmraw in->               mif opt ctxt (addEntry acc (thisNamespace using) n ->                   (IvorFun (Just (toIvorName (fullName using n))) Nothing imp ->                            (Just (SimpleDef itm)) decl flags [] [])) using ui uo ds->     | otherwise = let (f,l) = getFileLine tm in->                       mif opt ctxt (addEntry acc (thisNamespace using) n ->                                (IvorProblem (f ++ ":" ++ show l ++ ":" ++->                                 show n ++ " needs a type declaration in a params block"))) ->                                 using ui uo ds-> mif opt ctxt acc using ui uo (decl@(LatexDefs ls):ds) ->         = mif opt ctxt (addEntry acc (thisNamespace using) (MN "latex" 0) ->              (IvorFun Nothing Nothing 0 Nothing decl [] [] [])) using ui uo ds-> mif opt ctxt acc using ui (UO fix trans fr syns) (decl@(Fixity op assoc prec):ds) ->         = mif opt ctxt (addEntry acc (thisNamespace using) (MN "fixity" (length ds)) ->              (IvorFun Nothing Nothing 0 Nothing decl [] [] [])) using ui ->                   (UO ((op,(assoc,prec)):fix) trans fr syns) ds-> mif opt ctxt acc using ui uo@(UO fix trans fr syns) (decl@(Transform lhs rhs):ds) ->         = let lhsraw = addPlaceholders (appCtxt ctxt acc) using uo lhs->               rhsraw = addPlaceholders (appCtxt ctxt acc) using uo rhs->               lhstm = makeIvorTerm using ui uo (MN "LHS" 0) ctxt lhsraw->               rhstm = makeIvorTerm using ui uo (MN "RHS" 0) ctxt rhsraw ->               trans' = if (NoSpec `elem` opt) then trans else->                            (lhstm,rhstm):trans in->           mif opt ctxt (addEntry acc (thisNamespace using) (MN "transform" (length ds)) ->              (IvorFun Nothing Nothing 0 Nothing decl [] [] [])) using ui ->                   (UO fix trans' fr syns) ds-> mif opt ctxt acc using ui uo@(UO fix trans fr syns) (decl@(SynDef f args rhs):ds) ->         = let sname = mkName (thisNamespace using) f ->               syns' = addEntry syns (thisNamespace using) sname (Syntax sname args rhs) in->               mif opt ctxt (addEntry acc (thisNamespace using) f->                 (IvorFun Nothing Nothing 0 Nothing decl [] [] []))->               using ui (UO fix trans fr syns') ds--Don't add yet! Or everything will be frozen in advance, rather than being -frozen after they are needed.--> mif opt ctxt acc using ui uo@(UO fix trans fr syns) (decl@(Freeze _ _ _ _):ds) ->     = mif opt ctxt (addEntry acc (thisNamespace using) (MN "freeze" (length ds))->                 (IvorFun Nothing Nothing 0 Nothing decl [] [] [])) using ui ->                 (UO fix trans fr syns) ds-> mif opt ctxt acc using ui uo (decl@(Prf (Proof n _ scr) failable):ds) ->     = case ctxtLookup acc (thisNamespace using) n of->          Left _ -> -- add the script and process the type later, should->                    -- be a metavariable->             mif opt ctxt (addEntry acc (thisNamespace using) n->               (IvorFun (Just (toIvorName (fullName using n))) Nothing 0 (Just (IProof scr failable)) decl [] [] [])) ->                  using ui uo ds->          Right (IvorFun _ ty imp _ _ _ _ _) -> ->             mif opt ctxt (addEntry acc (thisNamespace using) n->               (IvorFun (Just (toIvorName (fullName using n))) ty imp (Just (IProof scr failable)) decl [] [] []))->                   using ui uo ds--Just pass these on to epic to do the right thing--> mif opt ctxt acc using ui uo ((CInclude _):ds) = mif opt ctxt acc using ui uo ds-> mif opt ctxt acc using ui uo ((CLib _):ds) = mif opt ctxt acc using ui uo ds-> mif opt ctxt acc using ui uo (d:ds) = error $ "Miffed: " ++ show d--error "Not implemented"--Add an entry for the type id and for each of the constructors.--> addDataEntries :: [Opt] ->->                   Ctxt IvorFun -> Ctxt IvorFun -> Decl ->->                   Datatype -> Implicit ->->                   UndoInfo -> UserOps ->->                   [Decl] -> ->                   (Ctxt IvorFun, UserOps)-> addDataEntries opt ctxt acc decl (Latatype tid tty f l) using ui uo ds = ->     let (tyraw, imp) = addImplWith using (appCtxt ctxt acc) tty->         tytm = Annotation (FileLoc f l) $ makeIvorTerm using ui uo tid (appCtxt ctxt acc) tyraw ->         acc' = addEntry acc (thisNamespace using) tid ->                   (IvorFun (Just (toIvorName (fullName using tid))) (Just tytm) imp (Just LataDef) decl [] [] []) in->         mif opt ctxt acc' using ui uo ds-> addDataEntries opt ctxt acc decl (Datatype tid tty cons u e f l) using ui uo ds = ->     let (tyraw, imp) = addImplWith using (appCtxt ctxt acc) tty->         tytm = Annotation (FileLoc f l) $ makeIvorTerm using ui uo tid (appCtxt ctxt acc) tyraw->         acctmp = addEntry (appCtxt ctxt acc) (thisNamespace using) tid ->                     (IvorFun (Just (toIvorName (fullName using tid))) (Just tytm) imp Nothing decl [] [] [])->         ddef = makeInductive acctmp tid (getBinders tytm []) cons ->                    (addUsing using (Imp u [] [] (thisNamespace using))) ui uo []->         acc' = addEntry acc (thisNamespace using) tid ->                   (IvorFun (Just (toIvorName (fullName using tid))) (Just tytm) imp ->                              (Just (DataDef ddef (not (elem NoElim e)))) decl [] [] []) in->         addConEntries opt ctxt acc' cons u using ui uo ds f l--     Inductive (toIvorName tid) [] --> makeInductive :: Ctxt IvorFun -> Id -> ([(Name, ViewTerm)], ViewTerm) ->->                  [(Id,RawTerm)] -> Implicit ->->                  UndoInfo -> UserOps -> [(Name, ViewTerm)] -> Inductive-> makeInductive ctxt tid (indices, tty) [] using ui uo acc->        = Inductive (toIvorName (fullName using tid)) [] indices tty (reverse acc)-> makeInductive ctxt cdec indices ((cid, cty):cs) using ui uo acc->        = let (tyraw, imp) = addImplWith using ctxt cty->              tytm = makeIvorTerm using ui uo cdec ctxt tyraw in->              makeInductive ctxt cdec->                            indices cs using ui uo (((toIvorName (fullName using cid)),tytm):acc)--Examine an inductive definition; any index position which does not-change across the structure becomes a parameter.--The type has to be fully elaborated here. It's a bit of a hack, but we-add the type once, without the elim rule, so that the placeholders are filled-in, then we add it again after we work out what the parameters are, with-the elim rule.--Parameters go at the left, so as soon as find find an argment which isn't-a parameter, there can be no more (or we mess up the declared type). Hence -'span' rather than 'partition'.--> mkParams :: Inductive -> Inductive-> mkParams ind@(Inductive tname ps inds ty cons) ->   = let (newps', newinds') = span (isParam (map snd cons)) ->                                      (zip [0..] inds)->         newps = map snd newps'->         newinds = map snd newinds'->         newty = remAllPs newps ty->         newind = Inductive tname (ps++newps) newinds ty (remPs newps cons) in->           -- trace (show ind ++ "\n" ++ show newind ++ "\n" ++ show newps) $->             newind->   where isParam [] _ = True->         isParam (c:cs) (pos, (n,ty))->              | isParamCon pos c n = isParam cs (pos, (n,ty))->              | otherwise = False--If argument at given position wherever 'tname' is applied is always n, then-n is a parameter-->         isParamCon pos tm n ->             = checkp pos n (getApps tm)->         checkp pos n [] = True->         checkp pos n (t:ts) ->              | length t >= pos = nameMatch n (t!!!(pos,"checkp fail")) && checkp pos n ts->              | otherwise = False->         nameMatch n (Name _ nm) = n == nm->         nameMatch n (Annotation _ t) = nameMatch n t->         nameMatch _ _ = False-->         getApps app@(App f a)->             | appIsT (getApp f) = [getFnArgs app]->             | otherwise = getApps f ++ getApps a->         getApps (Forall n ty sc) = getApps ty ++ getApps sc->         getApps (Annotation _ n) = getApps n->         getApps x = []-->         appIsT (Name _ n) = n == tname->         appIsT (Annotation _ t) = appIsT t->         appIsT _ = False-->         remPs newps [] = []->         remPs newps ((n,ty):tys) = (n,remAllPs newps ty):(remPs newps tys)->         remAllPs newps (Forall n ty sc)->                  | n `elem` (map fst newps) = remAllPs newps sc->                  | otherwise = Forall n ty (remAllPs newps sc)->         remAllPs newps (Annotation _ n) = remAllPs newps n->         remAllPs newps x = x--> addConEntries :: [Opt] ->->                  Ctxt IvorFun -> Ctxt IvorFun -> ->                  [(Id,RawTerm)] -> -- constructors->                  [(Id,RawTerm)] -> -- datatype local 'using'->                  Implicit -> UndoInfo -> UserOps -> -- global 'using'->                  [Decl] -> String -> Int ->->                  (Ctxt IvorFun, UserOps)-> addConEntries opt ctxt acc [] u using ui uo ds f l = mif opt ctxt acc using ui uo ds-> addConEntries opt ctxt acc ((cid, ty):cs) u using' ui uo ds f l->     = let using = using' -- No! params are implicit here. addParamName using' cid->           (tyraw, imp) = addImplWith (addUsing (Imp u [] [] (thisNamespace using)) using) (appCtxt ctxt acc) ty->           tytm = Annotation (FileLoc f l) $ makeIvorTerm using ui uo cid (appCtxt ctxt acc) tyraw->           acc' = addEntry acc (thisNamespace using) cid ->                      (IvorFun (Just (toIvorName (fullName using cid))) (Just tytm) (imp+length (params using')) (Just IDataCon) Constructor [] (getLazy ty) (getStatic ty)) in->           addConEntries opt ctxt acc' cs u using ui uo ds f l--Add definitions to the Ivor Context. Return the new context and a list-of things we need to define to complete the program (i.e. metavariables)--> data TryAdd = OK (Context, [(Name, ViewTerm)]) UserOps StaticUsed->             | Err (Context, [(Name, ViewTerm)]) UserOps StaticUsed String -- record how far we got--> addIvor :: [Opt] -> IdrisState ->->            Ctxt IvorFun -> -- all definitions, including prelude->            Ctxt IvorFun -> -- just the ones we haven't added to Ivor yet->            Context -> UserOps -> Statics -> StaticUsed -> TryAdd-> addIvor opts ist all defs ctxt uo sts stu ->             = addivs (ctxt, []) uo stu (ctxtAlist defs)->    where addivs acc fixes stu [] = OK acc fixes stu->          addivs acc fixes stu ((n, IvorProblem err):ds) ->                                  = Err acc fixes stu err->          addivs acc fixes stu (def@(_,ifn):ds) = ->              case addIvorDef opts ist all fixes acc def sts stu of->                 Right (ok, fixes, stu') -> addivs ok fixes stu' ds->                 Left err -> Err acc fixes stu (idrisError all (guessContext ifn err))--Add a definition to Ivor. UserOps have been finalised already, by makeIvorFuns,-except frozen things, which need to be added as we go, in order.--> addIvorDef :: [Opt] -> IdrisState ->->               Ctxt IvorFun -> UserOps -> (Context, [(Name, ViewTerm)]) -> ->               (Id, IvorFun) -> Statics -> StaticUsed -> ->               TTM ((Context, [(Name, ViewTerm)]), UserOps, StaticUsed)-> addIvorDef opt ist raw uo (ctxt, metas) (n,IvorFun name tyin _ def (LatexDefs _) _ _ _) sts stu->                = return ((ctxt, metas), uo, stu)-> addIvorDef opt ist raw (UO fix trans fr syns) (ctxt, metas) (n,IvorFun name tyin _ def f@(Fixity op assoc prec) _ _ _) sts stu->                = return ((ctxt, metas), UO fix trans fr syns, stu)-> addIvorDef opt ist raw (UO fix trans fr syns) (ctxt, metas) (n,IvorFun name tyin _ def f@(SynDef _ _ _) _ _ _) sts stu->                = return ((ctxt, metas), UO fix trans fr syns, stu)-> addIvorDef opt ist raw (UO fix trans fr syns) (ctxt, metas) (n,IvorFun name tyin _ def f@(Transform lhs rhs) _ _ _) sts stu->                = return ((ctxt, metas), UO fix trans fr syns, stu)-> addIvorDef opt ist raw (UO fix trans fr syns) (ctxt, metas) (n,IvorFun name tyin _ def f@(Freeze file line ns frfn) _ _ _) sts stu->        = case ctxtLookupName raw ns frfn of->            Right (_,fn') -> return ((ctxt, metas), UO fix trans (fn':fr) syns, stu)->            Left err -> Left (ErrContext (file ++ ":" ++ show line ++ ":") (Message (show err)))-> addIvorDef opt ist raw uo@(UO fix trans fr syns) (ctxt, metas) (n,IvorFun (Just name) tyin _ (Just def') _ flags lazy static) sts stu->   = let def = if (Verbose `elem` opt) ->                  then trace ("Processing " ++ show n) def' else def' in->       case def of->         PattDef ps -> -- trace (show (ps, getSpec flags fr)) $->                 do checkArgLengths (show n) ps->                    (ctxt, newdefs) <- addPatternDefSC ctxt name (unjust tyin) ps (getSpec flags fr) sts->                    -- Get the type checked version->                    (_, pdef) <- getPatternDef ctxt name->                    -- Generate some PE data from it->                    -- let (_, nds, stu', newts, newfs) = getNewDefs n sts ist raw stu (PattDef pdef)->                    -- (ctxt, uo, freeze) <- addPEdefs raw ctxt sts uo nds->                    if (null newdefs) then return ((ctxt, metas), uo, stu)->                      else do r <- addMeta (Verbose `elem` opt) raw ctxt metas newdefs->                              return (r, uo, stu)->->         SimpleDef tm -> ->                         do tm' <- case (getSpec flags fr) of->                              Nothing -> return tm->                              Just [] -> do ctm <- check ctxt tm->                                            let ans = view (evalnew ctxt ctm)->                                            return ans->                              Just specfns -> do ctm <- check ctxt tm->                                                 let ans = view (evalnewLimit ctxt ctm specfns)->                                                 return ans->                            ctxt <- case tyin of->                                 Nothing -> addDef ctxt name tm'->                                 Just ty -> addTypedDef ctxt name tm' ty->                            -- Get the type checked version->                            (_, pdef) <- getPatternDef ctxt name->                            -- Generate some PE data from it->                            let (_, nds, stu', newts, newfs) = getNewDefs n sts ist raw stu (PattDef pdef)->                            (ctxt, uo, freeze) <- addPEdefs raw ctxt sts uo nds->                            return ((ctxt, metas), uo, stu)->         LataDef -> case tyin of->                       Just ty -> do ctxt <- declareData ctxt name ty->                                     return ((ctxt, metas), uo, stu)->         DataDef ind e -> -- trace (show (ind, e)) $->                          do c <- addDataNoElim ctxt ind->                           -- add once to fill in placeholders->                             ctxt <- if e then do->                                     d <- getInductive c name ->                           -- add again after we work out the parameters->                                     addData ctxt (mkParams d)->                                  else return c->                             return ((ctxt, metas), uo, stu)->                           -- addDataNoElim ctxt (mkParams d)->                           -- trace (show (mkParams d)) $ return c->         IProof scr failable -> ->                do case runScript raw ctxt uo n scr of->                     Right ctxt -> do->                        return ((ctxt, filter (\ (x,y) -> x /= toIvorName n)->                                metas), uo, stu)--If the proof doesn't work, but it was just a guess in a [tryproof ...] block,-just silently discard it and leave it for the user to fill in later:-->                     Left err -> let ctxt' = if (Verbose `elem` opt) then->                                             trace (show n ++ " proof failed") ctxt else ctxt in->                                 if failable ->                                     then return ((ctxt', metas), uo, stu)->                                     else Left err->         Later -> case tyin of->                    Just ty -> do ctxt <- declare ctxt name ty->                                  return ((ctxt, metas), uo, stu)->                    Nothing -> fail $ "No type given for forward declared " ++ show n->         _ -> return ((ctxt, metas), uo, stu)->    where unjust (Just x) = x->          getSpec [] fr->             = Nothing->          getSpec (CGEval:_) fr ->             = Just (map (\x -> (toIvorName x, 0)) fr)->          getSpec (CGSpec ns:_) fr->             | NoSpec `elem` opt = Nothing->             | otherwise = Just $ (map (\ (x, i) -> (toIvorName x, i)) ns) ++->                              (map (\x -> (toIvorName x, 0)) fr)->          getSpec (_:ns) fr = getSpec ns fr--> checkArgLengths :: String -> Patterns -> TTM ()-> checkArgLengths n (Patterns cs) ->    = if (length (nub (map (length.arguments) cs)) <= 1)->         then return ()->         else ttfail $ "Differing numbers of arguments in clauses for " ++ n-
− Idris/PMComp.lhs 
@@ -1,405 +0,0 @@-> {-# OPTIONS_GHC -fglasgow-exts #-}--> module Idris.PMComp(pmcomp,SimpleCase(..),CaseAlt(..)) where--Pattern matching compiler, convert to simple case expressions--> import Idris.AbsSyntax-> import Ivor.TT hiding (SimpleCase(..), CaseAlt(..))--> import Data.Typeable-> import Debug.Trace-> import Control.Monad.State-> import List hiding (partition)--Simple case statements are either a case analysis, just a term. ErrorCase -and Impossible are distinct in that 'Impossible' should be the default -fallthrough when a function is known to be total, and ErrorCAse otherwise.--> data SimpleCase = SCase ViewTerm [CaseAlt]->                 | Tm ViewTerm->                 | ErrorCase->                 | Impossible->    deriving (Show, Eq)--> data CaseAlt = Alt Name Int [Name] SimpleCase->              | ConstAlt Constant SimpleCase->              | Default SimpleCase->    deriving (Show, Eq)--> instance Ord CaseAlt where->   compare (Alt _ t _ _) (Alt _ u _ _) = compare t u->   compare (ConstAlt c _) (ConstAlt d _) = compare c d->   compare (Default _) (Default _) = EQ->   compare (Alt _ _ _ _) _ = LT->   compare (ConstAlt _ _) (Alt _ _ _ _) = GT->   compare (ConstAlt _ _) (Default _) = LT->   compare (Default _) _ = GT--> data CS = CS Int--> pmcomp :: Ctxt IvorFun -> Context -> ->           Bool -> -- erasure on->           Name -> ViewTerm -> Patterns -> ->           ([Name], SimpleCase)-> pmcomp raw ctxt erase n ty (Patterns ps) ->       = pm' n (map mkPat (deIOpats erase ps))->    where mkPat (PClause args _ rv) ->            = Clause (map (toPat ctxt) args) rv->          pm' n ps = evalState (doCaseComp raw ctxt ps) (CS 0)--It's easier if we can distinguish syntactically between constructor forms-and variables (and constants)--> data Pat = PCon Name Int [Pat]->          | PVar Name->          | PConst Constant->          | PNK Name Constant -- n+k pattern->          | PAny->   deriving Show--> data Clause = Clause [Pat] ViewTerm->   deriving Show--FIXME: If an argument is repeated in the patterns, turn the later ones-into underscores (since type checking will verify they are the same,-and if we don't matching can get confused).--> toPat :: Context -> ViewTerm -> Pat-> toPat ctxt tm = toPat' tm [] where->     toPat' (Name ty n) []->         | ty /= DataCon = PVar n->         | isVar n = PVar n->         | not (isCon n) = PAny->     toPat' (Name DataCon n) args ->         | isCon n = case getConstructorTag ctxt n of->                       Right i -> PCon n i args->                       Left _ -> error "Can't happen: no tag"->         | otherwise = error $ "Can't happen: variable applied to arguments " ++ show (n,args)->     toPat' (App (Name _ plus) (App (Name _ n) (Constant c))) []->         | plus == opFn Plus ->             = case (cast c)::Maybe Int of->                   Just i -> PNK n (Num i)->                   Nothing -> PAny->     toPat' (App f a) args = toPat' f ((toPat' a []):args)->     toPat' (Constant c) []->             = case (cast c)::Maybe Int of->                   Just i -> PConst (Num i)->                   Nothing -> ->                      case (cast c)::Maybe String of->                         Just s -> PConst (Str s)->                         Nothing ->->                             case (cast c)::Maybe Char of->                               Just c -> PConst (Num (fromEnum c))->     toPat' (Constant _) args ->                = error "Can't happen: constant applied to arguments"->     toPat' _ _ = PAny-->     isVar n = case nameType ctxt n of->                 Left _ -> True->                 Right Bound -> True->                 _ -> False->     isCon n = case nameType ctxt n of->                 Right DataCon -> True->                 _ -> False--> isVarPat (Clause ((PVar _):ps) _) = True-> isVarPat (Clause (PAny:ps) _) = True-> isVarPat _ = False--> isConPat (Clause ((PCon _ _ _):ps) _) = True-> isConPat (Clause ((PConst _):ps) _) = True-> isConPat _ = False--> data Partition = Cons [Clause]->                | Vars [Clause]--> partition :: Ctxt IvorFun -> Context -> [Clause] -> [Partition]-> partition raw ctxt [] = []-> partition raw ctxt ms@(m:_)->    | isVarPat m = let (vars, rest) = span isVarPat ms in->                            (Vars vars):partition raw ctxt rest ->    | isConPat m = let (cons, rest) = span isConPat ms in->                            (Cons cons):(partition raw ctxt rest)-> partition raw ctxt x = error (show x)--> doCaseComp :: Ctxt IvorFun -> Context ->->               [Clause] -> State CS ([Name], SimpleCase)-> doCaseComp raw ctxt cs = do vs <- newVars cs->                             let (cs', vs') = reOrder cs vs->                             sc <- match raw ctxt (map mkVT vs') cs' ErrorCase->                             -- return names in original order (this is the->                             -- argument list we're making)->                             return (map (name.show) vs, sc)->    where newVars [] = return []->          newVars ((Clause ps _):_)->               = do CS i <- get->                    put (CS (i+(length ps)))->                    return $ map (MN "cvar") [i..(i+(length ps)-1)]->          mkVT x = Name Unknown (name (show x))--Reorder variables so that one with most disjoint cases is first.-(Actually, quick hack, just reverse them, since then the dependent things-will at least be looked at last, and we'll be matching on the real arguments-rather than indices.)-->          reOrder cs vs = let djs = (reverse.sort.(mapI 0 dj).transpose.allArgs) cs in->                              (pickAll (map snd djs) cs, pick (map snd djs) vs)->          pickAll _ [] = []->          pickAll djs ((Clause args rest):cs) ->                       = (Clause (pick djs args) rest):(pickAll djs cs)->          allArgs [] = []->          allArgs ((Clause args rest):cs) = args:(allArgs cs)-->          pick [] _ = []->          pick (i:is) xs = if (i<length xs) then xs!!i : (pick is xs)->                              else error ("ARGH! pick " ++ show (i,xs,cs))--Count the number of different constructor forms in xs-->          dj xs = dj' [] xs->          dj' acc [] = length (nub acc)->          dj' acc (PCon n i p:xs) = dj' (n:acc) xs->          dj' acc (_:xs) = dj' acc xs-->          mapI i f [] = []->          mapI i f (x:xs) = (f x, i):(mapI (i+1) f xs)--> match :: Ctxt IvorFun -> Context -> ->          [ViewTerm] -> -- arguments->          [Clause] -> -- clauses->          SimpleCase -> -- fallthrough (error case)->          State CS SimpleCase-> match raw ctxt [] ((Clause [] ret):_) err ->           = return $ Tm ret -- run out of arguments-> match raw ctxt vs cs err ->       = mixture raw ctxt vs (partition raw ctxt cs) err--> mixture :: Ctxt IvorFun -> Context -> ->            [ViewTerm] ->->            [Partition] -> SimpleCase -> State CS SimpleCase-> mixture raw ctxt vs [] err = return err-> mixture raw ctxt vs ((Cons ms):ps) err ->     = do fallthrough <- (mixture raw ctxt vs ps err)->          conRule raw ctxt vs ms fallthrough-> mixture raw ctxt vs ((Vars ms):ps) err ->     = do fallthrough <- (mixture raw ctxt vs ps err)->          varRule raw ctxt vs ms fallthrough--In the constructor rule:--For each distinct constructor (or constant) create a group of possible-patterns in ConType and Group--> data ConType = CName Name Int -- ordinary named constructor->              | CConst Constant -- constant pattern->    deriving (Show, Eq)--> data Group = ConGroup ConType -- constructor->              -- arguments and rest of alternative for each instance->                    [([Pat], Clause)] ->    deriving Show---> conRule :: Ctxt IvorFun -> Context -> [ViewTerm] ->->            [Clause] -> SimpleCase -> State CS SimpleCase-> conRule raw ctxt (v:vs) cs err = ->    do groups <- groupCons cs->       caseGroups raw ctxt (v:vs) groups err--> caseGroups :: Ctxt IvorFun -> Context -> [ViewTerm] ->->               [Group] -> SimpleCase ->->               State CS SimpleCase-> caseGroups raw ctxt (v:vs) gs err->    = do g <- altGroups gs->         return $ SCase v g->   where altGroups [] = return [Default err]->         altGroups ((ConGroup (CName n i) args):cs)->           = do g <- altGroup n i args->                rest <- altGroups cs->                return (g:rest)->         altGroups ((ConGroup (CConst cval) args):cs)->           = do g <- altConstGroup cval args->                rest <- altGroups cs->                return (g:rest)-->         altGroup n i gs ->            = do (newArgs, nextCs) <- argsToAlt gs->                 matchCs <- match raw ctxt (map (Name Unknown) newArgs++vs)->                                           nextCs err->                 return $ Alt n i newArgs matchCs->         altConstGroup n gs->            = do (_, nextCs) <- argsToAlt gs->                 matchCs <- match raw ctxt vs nextCs err->                 return $ ConstAlt n matchCs--Find out how many new arguments we need to generate for the next step-of matching (since we're going to be matching further on the arguments-of each group for the constructor, and we'll need to give them names)--Return the new variables we've added to do case analysis on, and the-new set of clauses to match.--> argsToAlt :: [([Pat], Clause)] -> State CS ([Name], [Clause])-> argsToAlt [] = return ([],[])-> argsToAlt rs@((r,m):_) ->       = do newArgs <- getNewVars r->            -- generate new match alternatives, by combining the arguments->            -- matched on the constructor with the rest of the clause->            return (newArgs, addRs rs)->     where getNewVars [] = return []->           getNewVars ((PVar n):ns) = do nsv <- getNewVars ns->                                         return (n:nsv)->           getNewVars (_:ns) = do v <- getVar->                                  nsv <- getNewVars ns->                                  return (v:nsv)->           addRs [] = []->           addRs ((r,(Clause ps res) ):rs)->               = (Clause (r++ps) res):(addRs rs)--> getVar :: State CS Name-> getVar = do (CS var) <- get->             put (CS (var+1))->             return (name (show (MN "pvar" var)))--> groupCons :: Monad m => [Clause] -> m [Group]-> groupCons cs = gc [] cs->    where gc acc [] = return acc->          gc acc ((Clause (p:ps) res):cs) = do->            acc' <- addGroup p ps res acc->            gc acc' cs-->          addGroup p ps res acc = case p of->             PCon con i args -> return $ addg con i args (Clause ps res) acc->             PConst cval -> return $ addConG cval (Clause ps res) acc->             pat -> fail $ show pat ++ " is not a constructor or constant (can't happen)"-          ->          addg con i conargs res [] ->                   = [ConGroup (CName con i) [(conargs, res)]]->          addg con i conargs res (g@(ConGroup (CName n j) cs):gs)->               | i == j = (ConGroup (CName n i) (cs ++ [(conargs, res)])):gs->               | otherwise = g:(addg con i conargs res gs)-->          addConG con res [] = [ConGroup (CConst con) [([],res)]]->          addConG con res (g@(ConGroup (CConst n) cs):gs)->               | con == n = (ConGroup (CConst n) (cs ++ [([], res)])):gs->               | otherwise = g:(addConG con res gs)--In the variable rule:--case v args of-   p pats -> r1-   ...-   pn patsn -> rn--====>--case args of-   pats -> r1[p/v]-   ...-   patsn -> rn[p/v]--> varRule :: Ctxt IvorFun -> Context -> [ViewTerm] ->->            [Clause] -> SimpleCase -> State CS SimpleCase-> varRule raw ctxt (v:vs) alts err = do->     let alts' = map (repVar v) alts->     match raw ctxt vs alts' err->   where repVar v (Clause ((PVar p):ps) res) ->                    = let nres = subst p v res in->                      {- trace (show v ++ " for " ++ dbgshow p ++ " in " ++ show res ++ " gives " ++ show nres) $ -}->                          Clause ps nres->         repVar v (Clause (PAny:ps) res) = Clause ps res----Remove IO gubbins, make actions and ordering explicit--bind : IO A -> (A -> IO B) -> IO B-becomes -bind : A -> (A -> B) -> B--bind _ _ val fn ==> let newv = [[val]]-                        in [[fn newv]]--similarly for unsafeBind-unsafePerformIO becomes id--IOReturn _ a ==> [[a]]-IODo _ c k ==> [[k]] [[c]]--FIXME: Currently requires bind, iodo, etc to be fully applied. Need -intermediate functions for when this isn't the case--> bname i = name (show (MN "bname" i))--We don't care about the bound argument names any more, so don't bother deIOing-them, just put an empty list in.--> deIOpats :: Bool -> [PClause] -> [PClause]-> deIOpats erase cs = evalState (dp cs) 0->     where dp [] = return []->           dp ((PClause args _ rv):ps) = do args' <- mapM (deIO erase) args->                                            rv' <- deIO erase rv->                                            ps' <- dp ps->                                            return ((PClause args' [] rv'):ps')--> deIO :: Bool -> ViewTerm -> State Int ViewTerm-> deIO erase t = deIO' t where-->  deIO' (App (App (App (App (Name _ bind) _) _) v) k)->      | bind == bindNamei || ->        bind == ibindNamei->           = do i <- get->                put (i+1)->                v' <- deIO' v->                k' <- deIO' k->                return $ Let (bname i) Star -- type irrelevant->                          (App (App (Name Unknown (name "__effect")) Placeholder) v')->                              (quickSimpl (App k' (Name Unknown (bname i))))->      | bind == (name "unsafeBind") ->           = do i <- get->                put (i+1)->                return $ Let (bname i) Star -- type irrelevant->                             v (quickSimpl (App k (Name Unknown (bname i))))->  deIO' (App (App (Name _ ret) _) a) -- (without forcing)->      | (not erase) && ret == ioretNamei = deIO' a->  deIO' (App (Name _ ret) a) -- (with forcing)->      | erase && ret == ioretNamei = deIO' a->  deIO' (App (App (Name _ upio) _) a)->      | upio == (name "unsafePerformIO") = deIO' a->  deIO' (App (App (Name _ iolift) _) io)->      | iolift == ioliftNamei  -- Just skip this->         = deIO' io->  deIO' (App (App (App (Name _ iodo) _) c) k) -- (without forcing)->      | (not erase) && iodo == iodoNamei->         = do k' <- deIO' k->              c' <- deIO' c->              i <- get->              put (i+1)->              return $ Let (bname i) Star->                         (App (App (Name Unknown (name "__effect")) Placeholder) c')->                            (quickSimpl (App k' (Name Unknown (bname i))))->  deIO' (App (App (Name _ iodo) c) k) -- (with forcing)->      | erase && iodo == iodoNamei->         = do k' <- deIO' k->              c' <- deIO' c->              i <- get->              put (i+1)->              return $ Let (bname i) Star->                         (App (App (Name Unknown (name "__effect")) Placeholder) c')->                           (quickSimpl (App k' (Name Unknown (bname i))))->  deIO' (App f a) = do f' <- deIO' f->                       a' <- deIO' a->                       return (App f' a')->  deIO' (Lambda n ty sc) = do sc' <- deIO' sc->                              return (Lambda n ty sc')->  deIO' (Let n ty v sc) = do v' <- deIO' v->                             sc' <- deIO' sc->                             return (Let n ty v' sc')->  deIO' x = return x--Simplify the common case in bind/IODo--> quickSimpl (App (Lambda x ty sc) val)->    = subst x val sc-> quickSimpl x = x
− Idris/Parser.y 
@@ -1,833 +0,0 @@-{ -- -*-Haskell-*--{-# OPTIONS_GHC -fglasgow-exts #-}--module Idris.Parser where--import Data.Char-import Ivor.TT-import System.IO.Unsafe-import List-import Control.Monad--import Idris.AbsSyntax-import Idris.Lexer-import Idris.Lib--import Debug.Trace--}--%name mkparse Program-%name mkparseTerm Term-%name mkparseTactic Tactic--%tokentype { Token }-%monad { P } { thenP } { returnP }-%lexer { lexer } { TokenEOF }---- %expect 0--%token-      name            { TokenName $$ }-      userinfix       { TokenInfixName $$ }-      brackname       { TokenBrackName $$ }-      string          { TokenString $$ }-      int             { TokenInt $$ }-      float           { TokenFloat $$ }-      char            { TokenChar $$ }-      bool            { TokenBool $$ }-      metavar         { TokenMetavar $$ }-      ':'             { TokenColon }-      ';'             { TokenSemi }-      '|'             { TokenBar }-      stars           { TokenStars }-      '\\'            { TokenLambda }-      hashbrack       { TokenHashOB }-      '('             { TokenOB }-      ')'             { TokenCB }-      '{'             { TokenOCB }-      '}'             { TokenCCB }-      '['             { TokenOSB }-      ']'             { TokenCSB }-      oid             { TokenOId }-      cid             { TokenCId }-      lpair           { TokenLPair }-      rpair           { TokenRPair }-      exists          { TokenExists }-      '~'             { TokenTilde }-      '+'             { TokenPlus }-      '-'             { TokenMinus }-      '*'             { TokenTimes }-      '/'             { TokenDivide }-      '='             { TokenEquals }-      mightbe         { TokenMightEqual }-      '<'             { TokenLT }-      '>'             { TokenGT }-      ellipsis        { TokenEllipsis }-      '_'             { TokenUnderscore }-      ','             { TokenComma }-      '&'             { TokenTuple }-      '!'             { TokenBang }-      concat          { TokenConcat }---      eq              { TokenEQ }-      ge              { TokenGE }-      le              { TokenLE }-      or              { TokenOr }-      and             { TokenAnd }-      arrow           { TokenArrow }-      fatarrow        { TokenFatArrow }-      transarrow      { TokenTransArrow }-      leftarrow       { TokenLeftArrow }-      inttype         { TokenIntType }-      chartype        { TokenCharType }-      floattype       { TokenFloatType }-      stringtype      { TokenStringType }-      handletype      { TokenHandleType }-      ptrtype         { TokenPtrType }-      locktype        { TokenLockType }-      type            { TokenType }-      ltype           { TokenLType }-      lazybracket     { TokenLazyBracket }-      data            { TokenDataType }-      codata          { TokenCoDataType }-      infix           { TokenInfix }-      infixl          { TokenInfixL }-      infixr          { TokenInfixR }-      using           { TokenUsing }-      idiom           { TokenIdiom }-      params          { TokenParams }-      namespace       { TokenNamespace }-      public          { TokenPublic }-      private         { TokenPrivate }-      abstract        { TokenAbstract }-      noelim          { TokenNoElim }-      collapsible     { TokenCollapsible }-      where           { TokenWhere }-      with            { TokenWith }-      partial         { TokenPartial }-      syntax          { TokenSyntax }-      hide            { TokenHide }-      lazy            { TokenLazy }-      static          { TokenStatic }-      refl            { TokenRefl }-      empty           { TokenEmptyType }-      unit            { TokenUnitType }-      include         { TokenInclude }-      export          { TokenExport }-      inline          { TokenInline }-      do              { TokenDo }-      return          { TokenReturn }-      if              { TokenIf }-      then            { TokenThen }-      else            { TokenElse }-      let             { TokenLet }-      in              { TokenIn }-      proof           { TokenProof }-      try             { TokenTryProof }-      intro           { TokenIntro }-      refine          { TokenRefine }-      generalise      { TokenGeneralise }-      reflp           { TokenReflP }-      rewrite         { TokenRewrite }-      rewriteall      { TokenRewriteAll }-      compute         { TokenCompute }-      unfold          { TokenUnfold }-      undo            { TokenUndo }-      induction       { TokenInduction }-      fill            { TokenFill }-      trivial         { TokenTrivial }-      simplesearch    { TokenSimpleSearch }-      mktac           { TokenMkTac }-      believe         { TokenBelieve }-      use             { TokenUse }-      decide          { TokenDecide }-      abandon         { TokenAbandon }-      proofterm       { TokenProofTerm }-      qed             { TokenQED }-      latex           { TokenLaTeX }-      nocg            { TokenNoCG }-      eval            { TokenEval }-      spec            { TokenSpec }-      freeze          { TokenFreeze }-      thaw            { TokenThaw }-      transform       { TokenTransform }-      cinclude        { TokenCInclude }-      clib            { TokenCLib }--%nonassoc LAM-%nonassoc let in-%nonassoc '!' '@'-%nonassoc NEG-%left or-%left and '&'-%left '=' -- eq-%left userinfix-%left '<' le '>' ge-%left '+' '-'-%left '*' '/'-%left concat-%left '\\'-%right arrow-%left '(' '{' lazybracket '['-%nonassoc '.'-%right IMP-%nonassoc CONST--- All the things I don't want to cause a reduction inside a lam...-%nonassoc name inttype chartype floattype stringtype int char string float bool refl do type ltype-          empty unit '_' ptrtype handletype locktype metavar NONE brackname lazy-          oid '~' lpair PAIR return transarrow exists proof-%left APP-%nonassoc if then else--%%--Program :: { [ParseDecl] }-Program: { [] }-       | Declaration Program { $1:$2 }-       | Fixity Program { map RealDecl $1 ++ $2 }-       | include string ';' Program { RealDecl (PInclude $2) : $4 }--{--{%-	     let rest = $4 in-	     let pt = unsafePerformIO (readLib defaultLibPath $2) in-		case (mkparse pt $2 1 []) of-		   Success x -> returnP (x ++ rest)-		   Failure err file ln -> failP err-	  }--}--Declaration :: { ParseDecl }-Declaration: Function { $1 }-           | Datatype { RealDecl (DataDecl $1) }-           | Latex { RealDecl $1 }-           | freeze name File Line ';' { RealDecl (Freeze $3 $4 [] $2) }-           | Using '{' Program '}' { PUsing $1 $3 }-           | DoUsing '{' Program '}' { PDoUsing $1 $3 } -           | Idiom '{' Program '}' { PIdiom $1 $3 }-           | Params '{' Program '}' { PParams $1 $3 }-           | Namespace '{' Program '}' { PNamespace $1 $3 }-           | Transform { RealDecl $1 }-           | syntax Name NamesS '=' Term ';' { RealDecl (SynDef $2 $3 $5) }-           | hide Name File Line ';'-                 { RealDecl (SynDef $2 [] (RVar $3 $4 (mkhidden $2) Unknown)) }-           | cinclude string { RealDecl (CInclude $2) }-           | clib string { RealDecl (CLib $2) }--Transform :: { Decl }-Transform : transform Term fatarrow Term ';' { Transform $2 $4 }--Function :: { ParseDecl }-Function : Name ':' Type ';' Flags File Line { FunType $1 $3 (nub $5) $6 $7 }-         | Name ProofScript ';' { ProofScript $1 $2 }---         | DefTerm '=' Term Flags ';' { FunClause (mkDef $1) [] $3 $4 }-         | DefTerm WithTerms WithP Term '{' Functions '}' File Line-              { WithClause (mkDef $8 $9 $1) $2 $3 $4 $6 }-         | DefTerm WithTerms mightbe Term ';' '[' Name ']' File Line-              { FunClauseP (mkDef $9 $10 $1) $2 $4 $7 }-         | DefTerm WithTerms '=' Term ';' Flags File Line -              { FunClause (mkDef $7 $8 $1) $2 $4 (nub $6) }-         | '|' WithTerm '=' Term ';' { FunClause RPlaceholder [$2] $4 [] }-         | '|' WithTerm mightbe Term ';' '[' Name ']' -              { FunClauseP RPlaceholder [$2] $4 $7 }-         | '|' WithTerm WithP Term '{' Functions '}'-              { WithClause RPlaceholder [$2] $3 $4 $6 }--Visibility :: { CGFlag }-Visibility : public { Vis Public }-           | private { Vis Private }-           | abstract { Vis Abstract }-           | { Vis Public }--WithP :: { Bool }-WithP : with { False }-      | with proof { True }--WithTerms :: { [RawTerm] }-WithTerms : '|' WithTerm WithTerms { $2:$3 }-          | { [] }--WithTerm :: { RawTerm }-WithTerm : SimpleAppTerm { $1 }-         | SigmaTerm { $1 }-         | '(' Term ')' { $2 }-         | '(' TermList ')' File Line { pairDesugar $4 $5 (RVar $4 $5 (UN "mkPair") Unknown) $2 }--Functions :: { [ParseDecl] }-Functions : Function Functions { $1:$2 }-          | Function { [$1] }--Flags :: { [CGFlag] }-Flags : '[' FlagList ']' { $2 }-      | { [] }--FlagList :: { [CGFlag] }-FlagList : { [] }-      | Flag FlagList { $1 ++ $2 }--Flag :: { [CGFlag] }-Flag : nocg { [NoCG] }-     | eval { [CGEval, Inline] }-     | spec '(' NameInts ')' { [CGSpec $3] }-     | spec { [CGSpec []] }-     | inline { [Inline] }-     | export string { [CExport $2] }----         | Nameproof Script { ProofScript $2 }----         | proof '{' Tactics '}' { error "Foo" }---- Tactics :: { [(ITactic] }--- Tactics : ----         | Name '=' Term ';' { RealDecl (TermDef $1 $3) }--Fixity :: { [Decl] }-Fixity : FixDec int UserInfixes ';' { map (\x -> Fixity x $1 $2) $3 }--UserInfixes :: { [String] }-UserInfixes : UserInfix { [$1] }-            | UserInfix ',' UserInfixes { $1:$3 }---- some annoying special cases so we can have operators with other meanings.--UserInfix :: { String }-UserInfix : userinfix { $1 }-          | '-' { "-" }-          | '<' { "<" }-          | '>' { ">" }--FixDec :: { Fixity }-FixDec : infixl { LeftAssoc }-       | infixr { RightAssoc }-       | infix { NonAssoc }--Latex :: { Decl }-Latex : latex '{' LatexDefs '}' { LatexDefs $3 }--LatexDefs :: { [(Id,String)] }-LatexDefs : Name '=' string { [($1,$3)] }-          | Name '=' string ',' LatexDefs { ($1,$3):$5 }--DefTerm :: { (Id, [(RawTerm, Maybe Id)]) }-DefTerm : Name ArgTerms { ($1, $2) }--ArgTerms :: { [(RawTerm,Maybe Id)] }-ArgTerms : { [] }-      | NoAppTerm ArgTerms { ($1,Nothing):$2 }-      | brackname '}' ArgTerms File Line { (RVar $4 $5 $1 Unknown, Just $1):$3 }-      | brackname '=' Term '}' ArgTerms { ($3, Just $1):$5 }--Datatype :: { Datatype }-Datatype : Data DataOpts Name DefinedData File Line-             { mkDatatype $1 $5 $6 $3 $4 $2 }--Data :: { Bool }-Data : data { False }-     | codata { True }--DefinedData :: { Either RawTerm ((RawTerm, [(Id, RawTerm)]), [ConParse]) }-DefinedData : DType Constructors ';' { Right ($1,$2) }-            | ':' Type ';' { Left $2 }-            | ';' File Line { Left (RConst $2 $3 TYPE) }---- Currently just whether to generate an elim rule, this'll need to be--- a list of options if we ever expand this.--DataOpts :: { [TyOpt] }-DataOpts : { [] }-         | '[' DataOptList ']' { $2 }--DataOptList :: { [TyOpt] }-DataOptList : DataOpt { [$1] }-            | DataOpt ',' DataOptList { $1:$3 }--DataOpt :: { TyOpt }-DataOpt : noelim { NoElim }-        | collapsible { Collapsible }--Name :: { Id }-Name : name { $1 }-     | '(' UserInfix ')' { useropFn $2 }--SimpleAppTerm :: { RawTerm }-SimpleAppTerm : SimpleAppTerm File Line NoAppTerm  %prec APP { RApp $2 $3 $1 $4 }-              | SimpleAppTerm ImplicitTerm '}' File Line %prec APP -                   { RAppImp $4 $5 (fst $2) $1 (snd $2) }-              | Name File Line { RVar $2 $3 $1 Unknown }-              | Constant File Line { RConst $2 $3 $1 }-              | '_' { RPlaceholder }-              | empty File Line { RVar $2 $3 (UN "__Empty") TypeCon }-              | unit File Line { RVar $2 $3 (UN "__Unit") TypeCon }--Term :: { RawTerm }-Term : NoAppTerm { $1 }-     | hashbrack Type ')' { $2 }-     | Term File Line NoAppTerm  %prec APP { RApp $2 $3 $1 $4 }-     | Term ImplicitTerm '}' File Line %prec APP -                   { RAppImp $4 $5 (fst $2) $1 (snd $2) }-     | lazy Term File Line { RApp $3 $4 (RApp $3 $4 (RVar $3 $4 (UN "__lazy") Free) RPlaceholder) $2 }-     | '\\' Binds fatarrow Term %prec LAM-                { doBind Lam $2 $4 }-     | let LetBinds in Term-                { doLetBind $2 $4 }-     | InfixTerm { $1 }-     | if Term then Term else Term File Line-       { mkApp $7 $8 (RVar $7 $8 (UN "if_then_else") Free) [$2,$4,$6] }--Binds :: { [(Id, RawTerm)] }-Binds : Name MaybeType { [($1,$2)] }-      | Name MaybeType ',' Binds { ($1,$2):$4 }--TypedBinds :: { [(Id, RawTerm)] }-TypedBinds : TypedBind ',' TypedBinds { $1 ++ $3 }-           | TypedBind { $1 }--TypedBind :: { [(Id, RawTerm)] }-TypedBind : Name ':' Type { map ( \x -> (x,$3)) [$1] }--Names :: { [Id] }-Names : Name { [$1] }-      | Name ',' Names { $1:$3 }--NameInts :: { [(Id, Int)] }-NameInts : Name int { [($1,$2)] }-         | Name { [($1, 0)] }-         | Name ',' NameInts { ($1,0):$3 }-         | Name int ',' NameInts { ($1,$2):$4 }--BrackNames :: { [Id] }-BrackNames : brackname { [$1] }-      | brackname ',' Names { $1:$3 }--NamesS :: { [Id] }-NamesS : { [] }-       | Name NamesS { $1:$2 }--LetBinds :: { [(Id, RawTerm, RawTerm)] }-LetBinds : Name MaybeType '=' Term { [($1,$2,$4)] }-         | Name MaybeType '=' Term ',' LetBinds { ($1,$2,$4):$6 }--ImplicitTerm :: { (Id, RawTerm) }-ImplicitTerm : brackname File Line { ($1, RVar $2 $3 $1 Unknown) }-             | brackname '=' Term { ($1, $3) }--InfixTerm :: { RawTerm }-InfixTerm : '-' Term File Line %prec NEG { RInfix $3 $4 Minus (RConst $3 $4 (Num 0)) $2 }---          | Term '+' Term File Line { RInfix $4 $5  Plus $1 $3 }-          | Term '-' Term File Line %prec userinfix { RUserInfix $4 $5 False "-" $1 $3 }---          | Term '*' Term File Line { RInfix $4 $5  Times $1 $3 }---          | Term '/' Term File Line { RInfix $4 $5  Divide $1 $3 }---          | Term and Term File Line { RInfix $4 $5  OpAnd $1 $3 }-          | Term '&' Term File Line { mkApp $4 $5 (RVar $4 $5 (UN "Pair") TypeCon) [$1, $3] }---          | Term or Term File Line { RInfix $4 $5  OpOr $1 $3 }---          | Term concat Term File Line { RInfix $4 $5  Concat $1 $3 }---          | Term eq Term File Line { RInfix $4 $5  OpEq $1 $3 }-          | Term '<' Term File Line { RUserInfix $4 $5 False "<" $1 $3 }---          | Term le Term File Line { RInfix $4 $5  OpLEq $1 $3 }-          | Term '>' Term File Line { RUserInfix $4 $5 False ">" $1 $3 }---          | Term ge Term File Line { RInfix $4 $5  OpGEq $1 $3 }-          | Term arrow Term File Line { RBind (MN "X" 0) (Pi Ex [] $1) $3 }-          | UserInfixTerm { $1 }-          | NoAppTerm '=' NoAppTerm File Line { RInfix $4 $5 JMEq $1 $3 }--UserInfixTerm :: { RawTerm }-UserInfixTerm : Term userinfix Term File Line { RUserInfix $4 $5 False $2 $1 $3 }--Section :: { RawTerm }-Section : '(' userinfix Term File Line ')'-               { RBind (MN "X" 0) (Lam RPlaceholder) -                       (RUserInfix $4 $5 False $2 (RVar $4 $5 (MN "X" 0) Unknown) $3) }-        | '(' Term userinfix File Line ')'-               { RBind (MN "X" 0) (Lam RPlaceholder) -                       (RUserInfix $4 $5 False $3 $2 (RVar $4 $5 (MN "X" 0) Unknown)) }-        | '(' BuiltinOp Term File Line ')'-               { RBind (MN "X" 0) (Lam RPlaceholder) -                       (RUserInfix $4 $5 False $2 (RVar $4 $5 (MN "X" 0) Unknown) $3) }-        | '(' Term BuiltinOp File Line ')'-               { RBind (MN "X" 0) (Lam RPlaceholder) -                       (RUserInfix $4 $5 False $3 $2 (RVar $4 $5 (MN "X" 0) Unknown)) }-        | '(' Term '-' File Line ')'-               { RBind (MN "X" 0) (Lam RPlaceholder) -                       (RUserInfix $4 $5 False "-" $2 (RVar $4 $5 (MN "X" 0) Unknown)) }---- Special cases for ->--        | '(' Term arrow File Line ')'-               { RBind (MN "X" 0) (Lam RPlaceholder) -                       (RBind (MN "X" 1) (Pi Ex [] $2) (RVar $4 $5 (MN "X" 0) Unknown)) }-        | '(' arrow Term File Line ')'-               { RBind (MN "X" 0) (Lam RPlaceholder) -                       (RBind (MN "X" 1) (Pi Ex [] (RVar $4 $5 (MN "X" 0) Unknown)) $3) }       -        | '(' arrow File Line ')'-               { RBind (MN "X" 0) (Lam RPlaceholder)-                       (RBind (MN "X" 1) (Lam RPlaceholder)-                    (RBind (MN "X" 2) (Pi Ex [] (RVar $3 $4 (MN "X" 0) Unknown))-                       (RVar $3 $4 (MN "X" 1) Unknown))) }-- -- Special cases for pairing--        | '(' ',' File Line ')' -              {  RBind (MN "X" 0) (Lam RPlaceholder)-                   (RBind (MN "X" 1) (Lam RPlaceholder)-                       (pairDesugar $3 $4 (RVar $3 $4 (UN "mkPair") DataCon)-                                    [RVar $3 $4 (MN "X" 0) Unknown,-                                     RVar $3 $4 (MN "X" 1) Unknown])) }-        | '(' Term ',' File Line ')' -              {  RBind (MN "X" 0) (Lam RPlaceholder)-                       (pairDesugar $4 $5 (RVar $4 $5 (UN "mkPair") DataCon)-                                    [$2,-                                     RVar $4 $5 (MN "X" 0) Unknown]) }-        | '(' ',' Term File Line ')' -              {  RBind (MN "X" 0) (Lam RPlaceholder)-                       (pairDesugar $4 $5 (RVar $4 $5 (UN "mkPair") DataCon)-                                    [RVar $4 $5 (MN "X" 0) Unknown, $3]) }---BuiltinOp :: { String }-BuiltinOp : '<' { "<" }-          | '>' { ">" }--MaybeType :: { RawTerm }-MaybeType : { RPlaceholder}-          | ':' TypeTerm { $2 }--MaybeAType :: { RawTerm }-MaybeAType : { RPlaceholder}-          | ':' TypeTerm { $2 }---- Term representing a type may begin with implicit argument list--Type :: { RawTerm }-Type : BrackNames MaybeAType '}' arrow Type-               { doBind (Pi Im []) (map (\x -> (x, $2)) $1) $5 }-     | TypeTerm { $1 }--TypeTerm :: { RawTerm }-TypeTerm : TypeTerm arrow TypeTerm { RBind (MN "X" 0) (Pi Ex [] $1) $3 }-         | '(' TypedBinds ')' ArgOpts arrow TypeTerm-                { doBind (Pi Ex $4) $2 $6 }-         | lazybracket TypedBinds ')' arrow TypeTerm-                { doBind (Pi Ex [Lazy]) $2 $5 }-         | '(' TypeTerm ')' { bracket $2 }-         | '(' TypeTerm '=' TypeTerm File Line ')' { RInfix $5 $6 JMEq $2 $4 }-         | SimpleAppTerm { $1 }-         | hashbrack Term ')' { $2 }-         | TypeTerm userinfix TypeTerm File Line { RUserInfix $4 $5 False $2 $1 $3 }-         | TypeTerm '-' TypeTerm File Line { RUserInfix $4 $5 False "-" $1 $3 }-         | '(' TypeList ')' File Line { pairDesugar $4 $5 (RVar $4 $5 (UN "Pair") TypeCon) $2 }-         | SigmaType { $1 }--ArgOpt :: { ArgOpt }-ArgOpt : lazy { Lazy }-       | static { Static }--ArgOpts :: { [ArgOpt] }-ArgOpts : '[' ArgOptList ']' { $2 }-        | { [] }--ArgOptList :: { [ArgOpt] }-ArgOptList : ArgOpt ',' ArgOptList { $1:$3 }-           | ArgOpt { [$1] }--SigmaType :: { RawTerm }-SigmaType : '(' Name MaybeType stars TypeTerm ')' File Line -                  { sigDesugar $7 $8 ($2, $3) $5 }---          | exists Name MaybeType fatarrow SimpleAppTerm File Line---                  { sigDesugar $6 $7 ($2, $3) $5 }--TypeList :: { [RawTerm] }-         : TypeTerm '&' TypeTerm { $1:$3:[] }-         | TypeTerm '&' TypeList { $1:$3 }--NoAppTerm :: { RawTerm }-NoAppTerm : Name File Line { RVar $2 $3 $1 Unknown }-          | return File Line { RReturn $2 $3 }-          | '(' Term ')' { bracket $2 }-          | '~' NoAppTerm { RPure $2 }-          | metavar { RMetavar $1 }-          | '[' proof Tactics ']' { RMetavarPrf (UN "") $3 False }-          | '[' try Tactics ']' { RMetavarPrf (UN "") $3 True }-          | '!' Name File Line { RExpVar $3 $4 $2 }---          | '{' TypedBind '}' arrow NoAppTerm---                { doBind (Pi Im) $2 $5 }-          | Constant File Line { RConst $2 $3 $1 }-          | refl { RRefl }-          | empty File Line { RVar $2 $3 (UN "__Empty") TypeCon }-          | unit File Line { RVar $2 $3 (UN "__Unit") TypeCon }-          | '_' { RPlaceholder }-          | DoBlock { RDo $1 }-          | oid Term cid { RIdiom $2 }-          | '(' TermList ')' File Line { pairDesugar $4 $5 (RVar $4 $5 (UN "mkPair") DataCon) $2 }---          | '[' TermList ']' File Line { pairDesugar $4 $5 (RVar $4 $5 (UN "Exists")) $2 }---          | '(' TypeList ')' File Line { pairDesugar $4 $5 (RVar $4 $5 (UN "Pair")) $2 }-          | SigmaType { $1 } -          | Section { $1 }-          | SigmaTerm { $1 }-          | '[' File Line TermListZ ']' { mkConsList $2 $3 $4 }--SigmaTerm :: { RawTerm }-SigmaTerm : lpair Term ',' Term rpair File Line %prec PAIR-                { RApp $6 $7 (RApp $6 $7 (RVar $6 $7 (UN "Exists") DataCon) $2) $4 }-          | lpair Term rpair File Line %prec PAIR-                { RApp $4 $5 (RApp $4 $5 (RVar $4 $5 (UN "Exists") DataCon) RPlaceholder) $2 }--TermList :: { [RawTerm] }-         : Term ',' Term { $1:$3:[] }-         | Term ',' TermList { $1:$3 }--TermListZ :: { [RawTerm] }-         : { [] }-         | Term { [$1] }-         | Term ',' TermListZ { $1:$3 }---DoBlock :: { [Do] }-DoBlock : do '{' DoBindings '}' { $3 }--- Next rule is a TMP HACK! So that we can open brackets then have a name immediately.-        | do brackname MaybeType leftarrow Term File Line ';' DoBindings '}'-             { DoBinding $6 $7 $2 $3 $5 : $9 }--DoBindings :: { [Do] }-DoBindings : DoBind DoBindings { $1:$2}-           | DoBind { [$1] }--DoBind :: { Do }-DoBind : Name MaybeType leftarrow Term File Line ';' { DoBinding $5 $6 $1 $2 $4 }-       | let Name MaybeType '=' Term File Line ';' { DoLet $6 $7 $2 $3 $5 }-       | Term File Line ';' { DoExp $2 $3 $1 }--Constant :: { Constant }-Constant : type { TYPE }-         | ltype { LTYPE }-         | stringtype { StringType }-         | inttype { IntType }-         | chartype { CharType }-         | floattype { FloatType }-         | ptrtype { PtrType }-         | handletype { Builtin "Handle" }-         | locktype { Builtin "Lock" }-         | int { Num $1 }-         | char { Ch $1 }-         | string { Str $1 }-         | bool { Bo $1 }-         | float { Fl $1 }---- Whitespace separated term sequences; must be NoAppTerms since obviously--- application is space separated...--Terms :: { [RawTerm] }-Terms : { [] }-      | NoAppTerm Terms { $1:$2 }--DType :: { (RawTerm, [(Id, RawTerm)]) }-DType : ':' Type Using where { ($2, $3) }-      | '=' File Line { (RConst $2 $3 TYPE, []) }-      | VarList '=' File Line { (mkTyParams $3 $4 $1, []) }--Using :: { [(Id, RawTerm)] }-      : { [] }-      | using '(' UseList ')' { $3 }--DoUsing ::{ (Id,Id) }-        : do using '(' Name ',' Name ')' { ($4,$6) }--Idiom ::{ (Id,Id) }-        : idiom '(' Name ',' Name ')' { ($3,$5) }--        -Params :: { [(Id, RawTerm)] }-       : params '(' UseList ')' { $3 }--Namespace :: { Id }-          : namespace Name { $2 }--UseList :: { [(Id, RawTerm)] }-        : Name ':' Type { [($1, $3)] }-        | Name ':' Type ',' UseList { ($1,$3):$5 }--VarList :: { [Id] }-VarList : Name { [$1] }-        | Name VarList { $1:$2 }--Where : where { $1 }-      | '=' { $1 }--Constructors :: { [ConParse] }-Constructors : { [] } -- None-             | Constructor { [$1] }-             | Constructor '|' Constructors { $1:$3 }--Constructor :: { ConParse }-Constructor : Name CType { Full $1 $2 }-            | Name Terms { Simple $1 $2 }---            | Name { Simple $1 [] }--CType :: { RawTerm }-CType : ':' Type { $2 }--Tactic :: { ITactic }-Tactic : intro Names { Intro $2 }-       | intro { Intro [] }-       | refine Name { Refine $2 }-       | exists Term { Exists $2 }-       | generalise Term { Generalise $2 }-       | reflp { ReflP }-       | rewrite Term { Rewrite False False $2 }-       | rewrite leftarrow Term { Rewrite False True $3 }-       | rewriteall Term { Rewrite True False $2 }-       | rewriteall leftarrow Term { Rewrite True True $3 }-       | compute { Compute }-       | unfold Name { Unfold $2 }-       | undo { Undo }-       | induction Term { Induction $2 }-       | fill Term { Fill $2 }-       | trivial { Trivial }-       | simplesearch { SimpleSearch }-       | mktac Term { RunTactic $2 }-       | believe Term { Believe $2 }-       | use Term { Use $2 }-       | decide Term { Decide $2 }-       | abandon { Abandon }-       | proofterm { ProofTerm }-       | qed { Qed }--ProofScript :: { [ITactic] }-ProofScript : proof '{' Tactics '}' { $3 }--Tactics :: { [ITactic] }-Tactics : Tactic ';' { [$1] }-        | Tactic { [$1] }-        | Tactic ';' Tactics { $1:$3 }--TacticList :: { [ITactic] }-TacticList : Tactic { [$1] }-           | Tactic ',' Tactics { $1:$3 }--Line :: { LineNumber }-     : {- empty -}      {% getLineNo }--File :: { String } -     : {- empty -} %prec NONE  {% getFileName }--Ops :: { Fixities } -     : {- empty -} %prec NONE  {% getOps }--{--data ConParse = Full Id RawTerm-              | Simple Id [RawTerm]--parse :: String -> FilePath -> Result [Decl]-parse s fn = do ds <- mkparse s fn 1 []-                collectDecls ds--processImports :: [Opt] -> [FilePath] -> Result [Decl] -> -                  IO ([Decl], [FilePath])-processImports opts imped (Success ds) = pi imped [] ds-  where pi imps decls ((PInclude fp):xs)-           | fp `elem` imps = pi imps decls xs-           | otherwise = do-                 f <- readLibFile defaultLibPath fp-                 when (Verbose `elem` opts) $ putStrLn ("Reading " ++ fp)-                 case parse f fp of-                   Success t -> pi (fp:imps) decls (t++xs)-                   Failure e f l ->-                     fail $ f ++ ":" ++ show l ++ ":" ++ e-        pi imps decls ((Using t ds):xs)-            = do (ds',imps') <- pi imps [] ds-                 pi imps' (decls++[Using t ds']) xs-        pi imps decls ((Params t ds):xs)-            = do (ds',imps') <- pi imps [] ds-                 pi imps' (decls++[Params t ds']) xs-        pi imps decls ((DoUsing b r ds):xs)-            = do (ds',imps') <- pi imps [] ds-                 pi imps' (decls++[DoUsing b r ds']) xs-        pi imps decls ((Idiom b r ds):xs)-            = do (ds',imps') <- pi imps [] ds-                 pi imps' (decls++[Idiom b r ds']) xs-        pi imps decls ((Namespace n ds):xs)-            = do (ds',imps') <- pi imps [] ds-                 pi imps' (decls++[Namespace n ds']) xs-        pi imps decls (x:xs) = pi imps (decls++[x]) xs-        pi imps decls [] = return (decls, imps)--processImports _ imped (Failure e f l) -    = fail $ show f ++ ":" ++ show l ++ ":" ++ show e---parseTerm :: String -> Result RawTerm-parseTerm s = mkparseTerm s "(input)" 0 []--parseTactic :: String -> Result ITactic-parseTactic s = mkparseTactic s "(tactic)" 0 []---- Make a constructor type, and make arguments lazy if it's codata--mkCon :: Bool -> RawTerm -> ConParse -> (Id,RawTerm)-mkCon co _ (Full n t) = (n,if co then lazify t else t)-mkCon co ty (Simple n args) = (n, mkConTy args ty)-   where mkConTy [] ty = ty-         mkConTy (a:as) ty = let opts = if co then [Lazy] else [] in-                                 RBind (MN "X" 0) (Pi Ex opts a) (mkConTy as ty)---- Make sure all arguments are lazy--lazify :: RawTerm -> RawTerm-lazify (RBind n (Pi p opts a) sc) -    = RBind n (Pi p (nub (Lazy:opts)) a) (lazify sc)-lazify t = t--mkDef file line (n, tms) = mkImpApp (RVar file line n Unknown) tms-   where mkImpApp f [] = f-         mkImpApp f ((tm,Just n):ts) = mkImpApp (RAppImp file line n f tm) ts-         mkImpApp f ((tm, Nothing):ts) = mkImpApp (RApp file line f tm) ts--doBind :: (RawTerm -> RBinder) -> [(Id,RawTerm)] -> RawTerm -> RawTerm-doBind b [] t = t-doBind b ((x,ty):ts) tm = RBind x (b ty) (doBind b ts tm)--doLetBind :: [(Id,RawTerm,RawTerm)] -> RawTerm -> RawTerm-doLetBind [] t = t-doLetBind ((x,ty,val):ts) tm = RBind x (RLet val ty) (doLetBind ts tm)--mkTyApp :: String -> Int -> Id -> RawTerm -> RawTerm-mkTyApp file line n ty = mkApp file line (RVar file line n Unknown) (getTyArgs ty)-   where getTyArgs (RBind n _ t) = (RVar file line n Unknown):(getTyArgs t)-         getTyArgs x = []--mkTyParams :: String -> Int -> [Id] -> RawTerm-mkTyParams f l [] = RConst f l TYPE-mkTyParams f l (x:xs) = RBind x (Pi Ex [] (RConst f l TYPE)) (mkTyParams f l xs)--mkDatatype :: Bool -> String -> Int ->-              Id -> Either RawTerm ((RawTerm, [(Id, RawTerm)]), [ConParse]) -> -                    [TyOpt] -> Datatype-mkDatatype co file line n (Right ((t, using), cons)) opts-    = let opts' = if co then nub (Codata:opts) else opts in-          Datatype n t (map (mkCon co (mkTyApp file line n t)) cons) using opts' file line -mkDatatype co file line n (Left t) opts-    = Latatype n t file line--bracket (RUserInfix f l _ op x y) = RUserInfix f l True op x y-bracket x = x--pairDesugar :: String -> Int -> RawTerm -> [RawTerm] -> RawTerm-pairDesugar file line pair [x,y] = mkApp file line pair [x,y]-pairDesugar file line pair (x:y:xs) -    = pairDesugar file line pair ((mkApp file line pair [x,y]):xs)--sigDesugar :: String -> Int -> (Id, RawTerm) -> RawTerm -> RawTerm-sigDesugar file line (n, tm) sc-    = mkApp file line (RVar file line (UN "Sigma") TypeCon) [tm, lam]-   where lam = RBind n (Lam tm) sc--mkConsList :: String -> Int -> [RawTerm] -> RawTerm-mkConsList f l [] = RVar f l (UN "Nil") Unknown-mkConsList f l (x:xs) = RApp f l (RApp f l (RVar f l (UN "Cons") Unknown) x)-                                 (mkConsList f l xs)--mkhidden (UN n) = MN (n++" is hidden") 0--}-
− Idris/PartialEval.lhs 
@@ -1,310 +0,0 @@-Various bits and pieces to help do partial evaluation better.--This module doesn't do PE itself - rather, it sets up the %transform, %spec-and %freeze annotations.--> module Idris.PartialEval(partialeval, addPEdefs, staticDecls, ->                          getNewDefs) where--> import Idris.AbsSyntax-> import Ivor.TT as TT--> import Maybe-> import List-> import Control.Monad.State-> import Debug.Trace--> type NewTrans = [(ViewTerm, ViewTerm)]-> type NewFreeze = [Name]-> type NewDefs = [(Name, ViewTerm, Patterns, NewFreeze, (ViewTerm, ViewTerm))]--> type StaticState = (NewDefs, StaticUsed, NewTrans, NewFreeze, Int)--For everything in the context, look for applications of PEable functions,-with 'findStatic' below.-For each one, add a new definition, %spec it, %freeze it and add a-%transform rule that applies the new definition backwards.--For a definition d which uses PEable functions, add the new definitions -to the new context *before* adding d, followed by the %transform and %freeze -for each new definition, followed by d.-- addPEdefs :: Statics -> IdrisState -> Ctxt IvorFun -> Ctxt IvorFun- addPEdefs sts ist raw = addpes newCtxt [] (ctxtAlist raw)-   where addpes acc stu [] = acc-         addpes acc stu ((n,i):is) =-             let (i', defs, stu', _, _) = getPEdefs n sts ist raw stu i in-                 addpes (addEntry acc [] n i') stu' is--> getPEdefs :: Id -> Statics -> IdrisState ->->              Ctxt IvorFun -> StaticUsed -> IvorFun -> ->              (IvorFun, NewDefs, StaticUsed, NewTrans, NewFreeze)-> getPEdefs n sts ist raw stu i = ->     case ivorDef i of->       Just d -> let (def', (nds, stused, ts, fs, _)) = runState (getPEdef n sts ist raw stu d) ([], stu, [], [], 0) in->                     (i { ivorDef = Just def' }, nds, stused, ts, fs)->       Nothing -> (i, [], stu, [], [])--> getNewDefs :: Id -> Statics -> IdrisState ->->               Ctxt IvorFun -> StaticUsed -> IvorDef -> ->               (IvorDef, NewDefs, StaticUsed, NewTrans, NewFreeze)-> getNewDefs n sts ist raw stu d = ->     let (d', (sts', stu', ts, fs, _)) = runState (getPEdef n sts ist raw stu d) ([],stu,[],[],0) in->         (d', sts', stu', ts, fs)--> getPEdef :: Id -> Statics -> IdrisState -> Ctxt IvorFun -> ->             StaticUsed -> IvorDef ->->             State StaticState IvorDef-> getPEdef n sts ist raw stu (PattDef (Patterns ps)) =->     do ps' <- mapM pepat ps->        return (PattDef (Patterns ps'))->       where->           pepat (PClause args bs ret) ->                 = do ret' <- findStatic n sts ist raw ret->                      return (PClause args bs ret')->           pepat (PWithClause p args sc (Patterns ps)) ->                 = do sc' <- findStatic n sts ist raw sc->                      ps' <- mapM pepat ps->                      return (PWithClause p args sc' (Patterns ps'))-> getPEdef n sts ist raw stu (SimpleDef p) = ->     do p' <- findStatic n sts ist raw p->        return (SimpleDef p')-> getPEdef _ _ _ _ _ x = return x---Given a list of functions with static arguments, and a term...-Look for applications of that function in the term. --Replace them with a partially evaluated version (look in StaticsUsed first-to see if it's already been done.)--Return: the new term, the new definitions added, and an updated cached of PEed-functions.--> findStatic :: Id -> Statics -> IdrisState -> Ctxt IvorFun -> ViewTerm -> ->               State StaticState ViewTerm-> findStatic n sts ist raw vt = fs [] vt->    where->      fs stk (App f a) = do a' <- fs [] a->                            fs (a':stk) f->      fs stk (Lambda n ty sc) = do sc' <- fs [] sc->                                   freturn (Lambda n ty sc') stk->      fs stk (Let n ty v sc) = do v' <- fs [] v->                                  sc' <- fs [] sc->                                  freturn (Let n ty v' sc') stk->      fs stk (Annotation a vt) = do vt' <- fs stk vt->                                    return (Annotation a vt') --Don't bother with PE inside types-->      fs stk x = freturn x stk-->      freturn (Name _ f) args->         | Just (sts,arity,ty) <- lookup f sts->              = if length args == arity->                    then papply sts f ty args->                    else if length args > arity ->                            then do let (args', rest) = (take arity args,->                                                         drop arity args)->                                    app <- papply sts f ty args'->                                    return (apply app rest)->                            else return (apply (Name Unknown f) args)->      freturn f args = return (apply f args)--Check the arguments in static position are indeed statically known.-->      papply sts f ty args ->          | all (known args) sts = -- trace (show (f, args, ty)) $ ->              do let knownArgs = mkArgs sts 0 args->                 let ty' = newTy ty knownArgs->                 addDef f ty' knownArgs->                 return (apply (Name Unknown f) args)->      papply sts f ty args = return (apply (Name Unknown f) args)--Pull out the arguments that are statically known-->      mkArgs sts _ [] = []->      mkArgs sts i (a:args) | i `elem` sts = Right a : (mkArgs sts (i+1) args)->                            | otherwise = Left a : mkArgs sts (i+1) args-->      newTy (Forall n ty sc) (Left _ : rest) ->          = Forall n ty (newTy sc rest)->      newTy (Forall n ty sc) (Right val : rest)->          = newTy (subst n val sc) rest->      newTy (Annotation a x) rest = Annotation a (newTy x rest)->      newTy x _ = x-->      known args i = all nknown (namesTypesIn (args!!!(i,"known fail")))->      nknown x@(_,Free) = True->      nknown x@(_,DataCon) = True->      nknown x@(_,TypeCon) = True->      nknown x = False-->      addDef f ty args = ->         do (nds, used, ts, fs, name) <- get->            let defname = toIvorName $ MN ("PE"++show n) name->            let sargs = mapMaybe getRight args->            let idx = (f, sargs)->            if (idx `elem` used) then return () else->              do->                 let dargs = getDargs args nameSupply->                 let rhs = reImplicit ist raw $->                             apply (Name Unknown f) (mkAppArgs args sargs dargs)->                 let dargs' = map (dused (namesIn rhs)) dargs->                 let used' = idx:used->                 let transFrom = mktrans (getMVs args dargs') rhs->                 let transTo = mktrans (getMVs args dargs') (apply (Name Unknown defname) dargs')->                 let trans = (transFrom, transTo)->                 let freeze = getFrozen transFrom->                 let newdef = (defname, ty, Patterns [PClause dargs' [] rhs], freeze, trans)->                 let nds' = newdef:nds->                 put (nds', used', trans:ts, freeze ++ fs, name+1)-->      nameSupply = map (toIvorName.(MN "parg")) [0..]->      dused xs (Name _ n) | not (n `elem` xs) = Placeholder->      dused xs x = x-->      -- getDargs ((Left n@(Name _ _)):xs) ns = n : getDargs xs ns->      getDargs ((Left _):xs) (n:ns) = (Name Unknown n) : getDargs xs ns->      getDargs (_:xs) ns = getDargs xs ns->      getDargs [] _ = []-->      getRight (Right x) = Just x->      getRight _ = Nothing--Make a list of arguments for the specialisable application-->      mkAppArgs [] _ _ = []->      mkAppArgs (Left _:xs) ss (d:ds) = d:(mkAppArgs xs ss ds)->      mkAppArgs (Right v:xs) (s:ss) ds = s:(mkAppArgs xs ss ds)->      mkAppArgs _ _ _ = []--Make the LHS and RHS of a transformation rule for the new definition-->      getMVs (Left _:xs) (Name _ n:ds) = n:(getMVs xs ds)->      getMVs (Left _:xs) (_:ds) = getMVs xs ds->      getMVs (Right v:xs) ds = getMVs xs ds->      getMVs _ _ = []-->      mktrans (n:ns) tm = mktrans ns (subst n (Metavar n) tm)->      mktrans [] tm = tm-->      getFrozen tm = map fst (filter (\ (n, ty) -> ty == Free) (namesTypesIn tm))--Re-add _s for implicit arguments in PE definitions (because the type checker-will make a better job of working out what they should be than we will...)--The terms will just be simple applications--> reImplicit :: IdrisState -> Ctxt IvorFun -> ViewTerm -> ViewTerm-> reImplicit ist raw tm = reImp tm []->   where reImp fn@(Name _ n) stk->               = case getName n of->                   Right ifn -> let imps = implicitArgs ifn ->                                    stk' = take imps (repeat Placeholder)->                                             ++ drop imps stk in->                                    apply fn stk'->                   _ -> apply fn stk->         reImp (App f a) stk = reImp f ((reImp a []):stk)->         reImp (Annotation a t) stk = Annotation a (reImp t stk)->         reImp x stk = apply x stk-->         names = mkNameMap raw->         getName n = case lookup n names of->                       Just x -> ctxtLookup raw [] x->                       Nothing -> fail "No name"---Get a list of functions with static arguments, and their arities.--> staticDecls :: Ctxt IvorFun -> Statics-> staticDecls ctx = mapMaybe getStatic (ctxtAlist ctx)->    where getStatic (n,i) ->             = if null (staticArgs i) || fwdDef (rawDecl i)->                  then Nothing->                  else let statics = (map (+ (implicitArgs i)) (staticArgs i))->                           ar = arity (ivorDef i)->                           extras = getExtras statics ar (ivorFType i) ->                         in Just (toIvorName n, ->                                  (nub (extras ++ statics), ar, ->                                   getType (ivorFType i)))-->          fwdDef (Fwd _ _ _) = True->          fwdDef _ = False->          getType (Just t) = t-->          arity (Just (PattDef ps)) = parity ps->          arity _ = 0->          parity (Patterns []) = 0->          parity (Patterns ((PClause xs _ _):_)) = length xs->          parity (Patterns ((PWithClause _ xs _ _):_)) = length xs--Look for dependencies on the static arguments. Keep going until there are-no more. Add any dependencies on static arguments which are dependencies on-*no* dynamic arguments.-->          getExtras _ _ Nothing = []->          getExtras ss ar (Just t) ->             = let ds = [0..ar-1] \\ ss->                   args = TT.getArgTypes t->                   stypes = map (\x -> snd (args!!!(x,"extra 1"))) ss->                   dtypes = map (\x -> snd (args!!!(x,"extra 2"))) ds->                   stnames = concatMap namesIn stypes ->                   dnames = concatMap namesIn dtypes ->                   newss_in = nub (ss ++ (mapMaybe (\x -> lookupIdx 0 x args) stnames)) ->                   newds = mapMaybe (\x -> lookupIdx 0 x args) dnames->                   newss = sort $ newss_in \\ newds in->                   if (ss==newss) then ss else getExtras newss ar (Just t)->          lookupIdx i x ((n,v):xs) | n==x = Just i->                                   | otherwise = lookupIdx (i+1) x xs->          lookupIdx i x [] = Nothing--> addPEdefs :: Ctxt IvorFun -> Context -> Statics -> UserOps -> NewDefs -> ->              TTM (Context, UserOps, [Id])-> addPEdefs raw ctxt sts uo nds = tryAdd ctxt uo [] nds->    where tryAdd ctxt uo frz [] = return (ctxt, uo, frz)->          tryAdd ctxt uo frz (d:ds) ->               = case addPEdef ctxt uo d of->                   Right (ctxt', uo', frz') -> -- trace ("WIN: " ++ show d) $->                       tryAdd ctxt' uo' (frz++frz') ds->                   Left err -> trace ("FAIL: " ++ show d ++ "\n" ++ show err) $->                       tryAdd ctxt uo frz ds-->          addPEdef ctxt (UO fix trans frz syn) (n, ty, pdef, frz', trans') =->              do (ctxt, []) <- addPatternDef ctxt n ty pdef ->                               [Specialise (map (\x -> (x,1)) frz'),->                                SpecStatic (map getst sts)]->                 return (ctxt, UO fix (trans':trans) ->                                  (map getName frz'++frz) syn, ->                               map getName frz')-->          getst (n, (args, arity, ty)) = (n,(args,arity))->          names = mkNameMap raw->          getName n = case lookup n names of->                         Just x -> x->                         Nothing -> UN (show n)--Go through the context, evaluating enough to work out what the transform-rules need to be. Return a new set of transform rules, and specialised versions-of PEable functions.--Algorithm is:--In a definition f, PE(f):--For each static function I, with static positions s1...sn:-* If it appears in a pattern clause,  -    make a new function Ispec di = mkSpec (I di si)-       repeat PE(Ispec)-    add a transform I ?di si => Ispec ?di-          if any si is a name, freeze it--mkSpec(I di si):--* Evaluate I di si. Any si which is a name, expand only once.-  After the top level I, do not evaluate any static arguments of any I --    either they are all expanded, or we'll PE them separately.--> partialeval :: Ctxt IvorFun -> Context -> Statics -> UserOps -> ->                (Context, UserOps)-> partialeval raw ctxt sts uos = (ctxt, uos)
− Idris/Prover.lhs 
@@ -1,333 +0,0 @@-> module Idris.Prover(doProof, runScript, doIvor, ioTac) where--> import System.Console.Readline-> import Control.Monad hiding ((>=>))-> import Data.Typeable--> import Idris.AbsSyntax-> import Idris.Parser--> import Ivor.Shell-> import Ivor.TT-> import Ivor.Construction--> import Debug.Trace--> ioTac :: TTM a -> IO a-> ioTac (Left a) = fail (show a)-> ioTac (Right v) = return v--> doProof :: Ctxt IvorFun -> Context -> UserOps -> Id -> IO Context-> doProof raw ctxt uo nm = ->     do ctxt' <- ioTac $ resume ctxt (toIvorName nm)->        ctxt' <- ioTac $ attack defaultGoal ctxt'->        putStrLn $ showCtxtState raw ctxt'->        (ctxt', script, ok) <- proofShell (show nm) raw uo [] ctxt'->        if ok then do->            return ctxt'->          else do putStrLn "Proof abandoned"->                  return ctxt--> runScript :: Ctxt IvorFun -> Context -> UserOps -> Id -> [ITactic] -> ->              TTM Context-> runScript raw ctxt uo nm tacs =->     do ctxt <- resume ctxt (toIvorName nm)->        ctxt <- attack defaultGoal ctxt->        execScript raw ctxt uo tacs--This function assumes that it can plough on knowing the proof is fine.-If it isn't, it'll break, but with an error. We probably ought to check-properly, if only for useful diagnostics.--> execScript :: Ctxt IvorFun -> Context -> UserOps -> [ITactic] -> TTM Context-> execScript raw ctxt uo [] = return ctxt-> execScript raw ctxt uo (t:ts) ->      = do (ctxt,_,_) <- applyTac raw ctxt uo [] t->           ctxt <- keepSolving defaultGoal ctxt->           ctxt <- if ((numUnsolved ctxt) > 0)->                     then beta defaultGoal ctxt->                     else return ctxt->           execScript raw ctxt uo ts--> showScript :: String -> [String] -> IO ()-> showScript nm sc ->    = do putStrLn $ nm ++ " proof {"->         putStr $ concat (map (\line -> "\t" ++ line ++ ";\n") (sc++["%qed"]))->         putStrLn "};"--Remember the proof script (that's the [String]) and output it, without the-undone bits, after a Qed--> proofShell :: String -> Ctxt IvorFun -> UserOps -> [String] -> Context -> ->               IO (Context, [String], Bool)-> proofShell nm raw uo script ctxt = do->     inp <- readline (nm ++ "> ")->     res <- case inp of->              Nothing -> return ""->              Just ":q" -> return "abandon"->              Just tac -> do addHistory tac->                             return tac->     case parseTactic ("%"++res) of->            Failure err f l -> do putStrLn err->                                  proofShell nm raw uo script ctxt->            Success tac -> ->                do let script' = script ++ ["%"++res]->                   when (tac == Qed) $ ->                        showScript nm script->                   case applyTac raw ctxt uo script' tac of->                     Left err -> do print err->                                    proofShell nm raw uo script ctxt->                     Right (ctxt, script, True) -> do->                       ctxt <- ioTac $ keepSolving defaultGoal ctxt->                       ctxt <- ioTac $ if ((numUnsolved ctxt) > 0)->                                 then beta defaultGoal ctxt->                                 else return ctxt->                       if (proving ctxt)->                          then do putStrLn $ showCtxtState raw ctxt->                                  proofShell nm raw uo script ctxt->                          else return (ctxt, script, True)->                     _ -> return (ctxt, script, False)--> applyTac :: Ctxt IvorFun -> Context -> UserOps -> [String] -> ITactic -> ->             TTM (Context, [String], Bool)-> applyTac raw ctxt uo script Abandon = return (ctxt, script, False)-> applyTac raw ctxt uo script Undo = do ctxt <- restore ctxt->                                    -- remove the undo and the command->                                       let script' = init (init script)->                                       return (ctxt, script', True)-> applyTac raw ctxt uo script tac = do ctxt <- at (save ctxt) tac ->                                      return (ctxt, script, True)->   where->     at ctxt (Intro []) = intros defaultGoal ctxt->     at ctxt (Intro ns) = introsNames (map toIvorName ns) defaultGoal ctxt->     at ctxt (Refine n) = refine (Name Unknown (toIvorName n)) defaultGoal ctxt->     at ctxt (Generalise t) = generalise (ivor t) defaultGoal ctxt->     at ctxt (Exists t) = refine (App (App (App (Name Unknown (name "Exists"))->                                           Placeholder) Placeholder)->                                           (ivor t)) defaultGoal ctxt->     at ctxt ReflP = refine reflN defaultGoal ctxt->     at ctxt (Fill t) = fill (ivor t) defaultGoal ctxt->     at ctxt Trivial = (trivial >|> refine reflN) defaultGoal ctxt->     at ctxt SimpleSearch = (trivial >|> refine reflN >|> simplesearch raw uo) defaultGoal ctxt->     at ctxt (Believe t) = suspend_disbelief raw (ivor t) defaultGoal ctxt->     at ctxt (Use t) = prove_belief raw (ivor t) defaultGoal ctxt->     at ctxt (Decide t) = decide raw uo t defaultGoal ctxt->     at ctxt (Induction t) = induction (ivor t) defaultGoal ctxt->     at ctxt (Rewrite False f t) = rewrite (ivor t) f defaultGoal ctxt->     at ctxt (Rewrite True f t) = rewriteAll (ivor t) f defaultGoal ctxt->     at ctxt Compute = compute defaultGoal ctxt->     at ctxt (Unfold n) = unfold (toIvorName n) defaultGoal ctxt->     at ctxt (RunTactic tm) = runtac raw uo (ivor tm) defaultGoal ctxt->     at ctxt ProofTerm = do tm <- proofterm ctxt->                            fail (showVT raw (view tm))->     at ctxt Qed = qed ctxt-->     ivor t = makeIvorTerm noImplicit defDo uo (UN "__prf") raw t--> eqN = Name Unknown $ name "Eq"-> replN = Name Unknown $ toIvorName (UN "__eq_repl")-> symN = Name Unknown $ toIvorName (UN "__eq_sym")-> reflN = Name Unknown $ name "refl"-> eqP x y = apply eqN [Placeholder,Placeholder,x,y]-> believe x y = apply (Name Unknown (toIvorName (UN "__Suspend_Disbelief")))->                     [Placeholder,x,y]--> rewrite :: ViewTerm -> Bool -> Tactic-> rewrite = replace eqN replN symN--Given a rewrite rule, find all places where it can be applied (in the given -direction), and apply it. Search for points where the goal matches the LHS-of the rule's type, and apply rewrite.--> rewriteAll :: ViewTerm -> Bool -> Tactic-> rewriteAll (Name _ n) dir goal ctxt ->   = do tyin <- getType ctxt n->        let ty = view tyin->        rule <- getRule dir (getReturnType ty)->        let argNames = map fst (Ivor.TT.getArgTypes ty)->        fail $ "Not finished yet " ++ show rule->   where getRule dir (App (App (App (App ->                       (Name _ eq) Placeholder) Placeholder) l) r)->             | eq == opFn JMEq = if dir then return (l, r) else return (r,l)->         getRule _ _ = fail "Not a rewrite rule"--> rewriteAll tm dir _ _ = fail "Not a rewrite rule name"--> showCtxtState :: Ctxt IvorFun -> Context -> String-> showCtxtState raw ctxt->     | not (proving ctxt) = ""->     | null (getGoals ctxt) = "\nNo more goals\n"->     | otherwise = let (g:gs) = getGoals ctxt in->                      "\n" ++ showGoalState g ++->                      -- "\nOther goals: " ++ show gs ++ ->                      "\n\n"->  where->    showTm t = showImp False (unIvor raw (view t))->    showGoalState :: Goal -> String->    showGoalState g = let (Right gd) = goalData ctxt True g->                          env = bindings gd->                          ty = goalType gd->                          nm = goalName gd in->                        showEnv (reverse env) ++ "\n" ++->                        "--------------------------------\n" ++->                        show nm ++ " ? " ++ showTm ty ++ "\n"->    showEnv [] = ""->    showEnv ((n,ty):xs) = show n ++ " : " ++ showTm ty ++ "\n" ++->                          showEnv xs--Apply a tactic computed by an ivor function (see libs/tactics.idr for construction-of these tactics)--> doIvor :: Context -> IO Context-> doIvor ctxt = do s <- runShell "Ivor> " (newShell ctxt)->                  return (getContext s)----------- Specialised tactics for Idris ----------Given a term of type T args and a goal of type T args', look for the-first difference between args and args', and rewrite by-Suspend_Disbelief arg arg'. Keep doing this until the value solves the goal,-or there is nothing to rewrite.--At least make sure arg and arg' and not Types, so that we're only -suspending disbelief about value equalities, not polymorphic values.--> suspend_disbelief :: Ctxt IvorFun -> ViewTerm -> Tactic-> suspend_disbelief raw val goal ctxt->     = do ty <- checkCtxt ctxt goal val->          gd <- goalData ctxt True goal->          let gtype = view (goalType gd)->          let vtype = viewType ty->          let (gfn, gargs) = (getApp gtype, getFnArgs gtype)->          let (vfn, vargs) = (getApp vtype, getFnArgs vtype)->          when (gfn/=vfn) $ fail ((show gfn) ++ " and " ++ (show vfn) ++ ->                                  " are different types")->          let diffs = filter (\ (x,y) -> x/=y) (zip gargs vargs)->          ctxt <- rewriteDiffs diffs goal ctxt->          fill val goal ctxt->    where rewriteDiffs [] goal ctxt = idTac goal ctxt->          rewriteDiffs ((arg1, arg2):ds) goal ctxt->               = do let rt = believe arg1 arg2->                    rty <- checkCtxt ctxt goal arg1->                    when (viewType rty == Star) $->                         fail ((show arg1) ++ " is a type")->                    ctxt' <- rewrite rt False goal ctxt->                    rewriteDiffs ds goal ctxt'--As above, but instead of just believing the value, insert subgoals for-the required equality proofs--> prove_belief :: Ctxt IvorFun -> ViewTerm -> Tactic-> prove_belief raw val goal ctxt->     = do ty <- checkCtxt ctxt goal val->          gd <- goalData ctxt True goal->          let gtype = view (goalType gd)->          let vtype = viewType ty->          let (gfn, gargs) = (getApp gtype, getFnArgs gtype)->          let (vfn, vargs) = (getApp vtype, getFnArgs vtype)->          when (gfn/=vfn) $ fail ((show gfn) ++ " and " ++ (show vfn) ++ ->                                  " are different types")->          let diffs = filter (\ (x,y) -> x/=y) (zip gargs vargs)->          ctxt <- rewriteDiffs diffs goal ctxt->          fill val goal ctxt->    where rewriteDiffs [] goal ctxt = idTac goal ctxt->          rewriteDiffs ((arg1, arg2):ds) goal ctxt->               = do let claimTy = eqP arg2 arg1->                    claimName <- uniqueName ctxt (name "equality")->                    ctxt <- claim claimName claimTy goal ctxt->                    rty <- checkCtxt ctxt goal arg1->                    when (viewType rty == Star) $->                         fail ((show arg1) ++ " is a type")->                    ctxt' <- rewrite (Name Unknown claimName) False goal ctxt->                    rewriteDiffs ds goal ctxt'--decide; given a goal of the form X a b c, and a function x of type-x : a:A -> b:B -> c:C -> (Maybe (X a b c), apply the function to-a b c, and send the result to Ivor's isItJust tactic--_or_; given a goal of the form X a b c, and a function x of type-x: a:A -> b:B -> c:C -> Tactic, send x a b c to runtac below.--> decide :: Ctxt IvorFun -> UserOps -> RawTerm -> Tactic-> decide raw uo dproc goal ctxt = do->    gd <- goalData ctxt True goal->    let idgoal = unIvor raw ((view.goalType) gd)->    let args = getExplicitArgs idgoal->    let dapp = makeIvorTerm noImplicit defDo uo (UN "__prf") raw ->                            (mkApp "[proof]" 0 dproc args)->    (isItJust dapp >|> runtac raw uo dapp) goal ctxt--Try to solve a goal by looking through the global context. Obviously, this is-a bit dumb.--This is intended for type classes, so perhaps eventually what we'll want is-a way of just searching for dictionaries.--> simplesearch :: Ctxt IvorFun -> UserOps -> Tactic-> simplesearch raw uo goal ctxt = tryAll 5 allns goal ctxt->    where tryAll 0 _ _ _  = ttfail "Can't find a solution"->          tryAll d [] g c = ttfail "Can't find a solution"->          tryAll d ((i,fn):rest) g c | isFun (ivorDef fn) && take 8 (show i) == "instance"->                 = (tryRefine d (show i) >|> tryAll d rest) g c->          tryAll d (_:rest) g c = tryAll d rest g c-->          isFun (Just (SimpleDef _)) = True->          isFun (Just (PattDef _)) = True->          isFun _ = False->          allns = ctxtAlist raw-->          tryRefine d n g c = do goald <- goalData c False defaultGoal->                                 c <- refine n g c->                                 if (allSolved c) then return c else->                                     (beta >-> tryAll (d-1) allns) defaultGoal c----Run a tactic computed by mkTac--Check the term actually computes a tactic, then evaluate it, then run the actual tactics-the result term tells us to run.--> runtac :: Ctxt IvorFun -> UserOps -> ViewTerm -> Tactic-> runtac raw uo tmin goal ctxt = ->    do tm <- checkCtxt ctxt goal tmin->       checkTac (viewType tm)->       tm' <- evalCtxt ctxt goal tm->       exect (view tm') goal ctxt-->   where checkTac (Name _ n) | n == (name "Tactic") = return ()->         checkTac ty = fail $ (show ty) ++ " is not of type Tactic"-->         exect t g c = do c' <- exect' t g c->                          c' <- keepSolving defaultGoal c'->                          if ((numUnsolved c') > 0)->                             then beta defaultGoal c'->                             else return c'-->         exect' (App (App (Name _ tthen) x) y) | tthen == name "TThen" ->               = exect x >+> exect y->         exect' (App (App (Name _ tseq) x) y) | tseq == name "TSeq" ->               = exect x >-> exect y->         exect' (App (App (Name _ tthen) x) y) | tthen == name "TThenAll" ->               = exect x >=> exect y->         exect' (App (App (Name _ ttry) x) y) | ttry == name "TTry" ->               = exect x >|> exect y->         exect' (App (App (Name _ tfill) _) y) | tfill == name "TFill" ->               = fill y >+> keepSolving->         exect' (App (App (Name _ tdecide) _) y) | tdecide == name "TDecide" ->               = isItJust y >+> keepSolving->         exect' (App (Name _ trefine) (Constant s)) | trefine == name "TRefine" =->                  case cast s :: Maybe String of->                    Just str -> refine str->         exect' (App (Name _ tfail) (Constant s)) | tfail == name "TFail" =->                  \ g c -> case cast s :: Maybe String of->                              Just err -> ttfail err ->         exect' (Name _ ttrivial) | ttrivial == name "TTrivial" = trivial >|> refine reflN->         exect' (Name _ ttrivial) | ttrivial == name "TSearchContext" = trivial >|> simplesearch raw uo >|> refine reflN->         exect' tm = \ g c -> ttfail $ "Couldn't compute tactic " ++ show tm--XXX: Auto-rewrite: user can add rewrite rules, auto-rewrite repeatedly-rewrites by these rules until there's no more to rewrite, or until a-threshold is reached. Effectively looking for some kind of normal-form. Can we do this in any reasonable way?
− Idris/RunIO.hs 
@@ -1,185 +0,0 @@-{-# OPTIONS_GHC -fglasgow-exts -fallow-undecidable-instances -fallow-overlapping-instances #-}-{-# LANGUAGE MagicHash, UndecidableInstances, OverlappingInstances #-}--module Idris.RunIO where---- import SimplDSL--import Ivor.TT-import Ivor.Shell-import Ivor.Construction-import Idris.AbsSyntax--import Data.Typeable-import Data.IORef-import System.IO.Unsafe-import System.IO-import Control.Monad.Error-import Control.Concurrent-import Debug.Trace--newtype Lock = Lock QSem--instance Typeable Lock where-    typeOf a = mkTyConApp (mkTyCon "Lock") []--instance Show Lock where-    show x = "<<Lock>>"--instance Eq Lock where-    (==) x y = False -- Hmm--instance ViewConst Handle where-    typeof x = (name "Handle")--instance ViewConst Lock where-    typeof x = (name "Lock")--exec :: Context -> Term -> IO ()-exec ctxt wurzel = do res <- runIO ctxt (view (whnf ctxt wurzel))-                      putStrLn $ show res--runIO :: Context -> ViewTerm -> IO ViewTerm-runIO ctxt (App (App (App (Name _ d) _) act) k)-    | d == name "IO.IODo" = runAction ctxt (parseAction act) k-runIO ctxt (App (App (Name _ l) _) res)-    | l == name "IO.IOReturn" = return res-runIO _ x = fail $ "Not an IO action: " ++ show x--data Action = ReadStr-            | WriteStr String-            | Fork ViewTerm-            | NewLock Int-            | DoLock Lock-            | DoUnlock Lock-            | NewRef-            | ReadRef Int-            | WriteRef Int ViewTerm-            | CantReduce ViewTerm--parseAction x = parseAction' x [] where-  parseAction' (App f a) args = parseAction' f (a:args)-  parseAction' (Name _ n) args = (getAction n args)--getAction n []-    | n == name "IO.GetStr" = ReadStr-getAction n [Constant str]-    | n == name "IO.PutStr"-        = case cast str of-             Just str' -> WriteStr str'-getAction n [_,t]-    | n == name "IO.Fork"-        = Fork t-getAction n [Constant i]-    | n == name "IO.NewLock" -        = case cast i of-             Just i' -> NewLock i'-getAction n [lock]-    | n == name "IO.DoLock"-        = DoLock (getLock lock)-    | n == name "IO.DoUnlock"-        = DoUnlock (getLock lock)-getAction n []-    | n == name "IO.NewRef" = NewRef-getAction n [_,Constant i]-    | n == name "IO.ReadRef" -        = case cast i of-             Just i' -> ReadRef i'-getAction n [_,Constant i,val]-    | n == name "IO.WriteRef"-        = case cast i of-             Just i' -> WriteRef i' val--getAction n args = CantReduce (apply (Name Unknown n) args)--getHandle  (App _ (Constant h)) = case cast h of-                                   Just h' -> h'-getLock (Constant h) = case cast h of-                         Just h' -> h'-                         Nothing -> error ("Lock error in constant " ++ show h)-getLock x = error ("Lock error " ++ show x)--continue ctxt k arg = case fastCheck ctxt (App k arg) of-                        t -> let next = whnf ctxt t in-                             runIO ctxt (view next)-{-                          Right t -> let next = whnf ctxt t in-                                         runIO ctxt (view next)-                          Left err -> fail $ "Can't happen - continue " ++ err ++ "\n" ++ show k ++ "\n" ++ show arg--}--unit = Name Unknown (name "II")--runAction ctxt (WriteStr str) k-      -- Print the string, then run the continuation with the argument 'II'-        = do putStr str-             hFlush stdout-             continue ctxt k unit-runAction ctxt ReadStr k-      -- Read a string then run the continuation with the constant str-      = do str <- getLine-           continue ctxt k (Constant str)-runAction ctxt (Fork t) k-      = do forkIO (do x <- runIO ctxt t-                      return ())-           continue ctxt k unit-runAction ctxt (NewLock n) k-      = do mv <- newQSem n-           continue ctxt k (Constant (Lock mv))-runAction ctxt (DoLock l) k-      = do primLock l-           continue ctxt k unit-runAction ctxt (DoUnlock l) k-      = do primUnlock l-           continue ctxt k unit-runAction ctxt NewRef k-      = do i <- newRef-           continue ctxt k (Constant i)-runAction ctxt (ReadRef i) k-      = do v <- getMem i-           continue ctxt k v-runAction ctxt (WriteRef i val) k-      = do putMem i val-           continue ctxt k unit-runAction ctxt (CantReduce t) k-      = do fail $ "Stuck at: " ++ show t-           -- hFlush stdout--primLock :: Lock -> IO ()-primLock (Lock lock) = do waitQSem lock--primUnlock :: Lock -> IO ()-primUnlock (Lock lock) = signalQSem lock----- Some mutable memory, for implementing IORefs idris side.--type Value = ViewTerm-defaultVal = (Constant (0xDEADBEEF::Int))--data MemState = MemState (IORef (Int, [Value]))--memory :: MemState-memory = unsafePerformIO -               (do mem <- newIORef (0, (take 100 (repeat defaultVal)))-                   return (MemState mem))--newRef :: IO Int-newRef = do let (MemState mem) = memory-            (p,ref) <- readIORef mem-            writeIORef mem (p+1, ref)-            return p--putMem :: Int -> Value -> IO ()-putMem loc val = do let (MemState mem) = memory-                    (p,content) <- readIORef mem-                    writeIORef mem (p, update content loc val)--getMem :: Int -> IO Value-getMem loc = do let (MemState mem) = memory-                (p, content) <- readIORef mem-                return (content!!!(loc, "getMem fail"))--update :: [a] -> Int -> a -> [a]-update [] _ _ = []-update (x:xs) 0 v = (v:xs)-update (x:xs) n v = x:(update xs (n-1) v)
− Idris/SCTrans.lhs 
@@ -1,175 +0,0 @@-> {-# OPTIONS_GHC -fglasgow-exts #-}--Transformations at the supercombinator level.--Includes transforming data types into special case more efficient versions.-e.g. Nat -> Int, possibly List -> Block of memory, etc.--NOTE: Anything which has the shape of Nat, e.g. Fin could be converted to Nat -at an earlier stage, e.g. in ConTrans phase, then these transformations-would take effect.--> module Idris.SCTrans(transformSC, applyTransformsSC, SCTrans(..)) where--> import Idris.AbsSyntax-> import Idris.LambdaLift--> import Ivor.TT--> import Maybe-> import Debug.Trace--> data SCTrans = SCTrans String (SCBody -> SCBody)--> allSCTrans = [cfold, natCons, natCase, boolCons, boolCase, natArith, cfold]--Easier to take 'erasure' as an argument here - don't do constructor-transformations if we're not doing erasure (could do others).--> transformSC :: Bool -> SCFun -> SCFun-> transformSC erasure (SCFun c ns b) = SCFun c ns (tr b) where->     tr tm = if erasure then applyTransformsSC allSCTrans tm->                else tm--> applyTransformsSC :: [SCTrans] -> SCBody -> SCBody-> applyTransformsSC ts tm = foldl (flip doTrans) tm ts--Built-in transformations.--* Constant folding--> cfold = SCTrans "Constant Folding" con where->    con (SInfix op (SConst (Num x)) (SConst (Num y)))->        | Just r <- runOp op x y = SConst (Num r)->    con x = x->    runOp Plus x y = Just $ x+y->    runOp Minus x y = Just $ x-y->    runOp Times x y = Just $ x*y->    runOp Divide x y = Just $ x `div` y->    runOp _ x y = Nothing--* Nat constructors--> natCons = SCTrans "NatCons" ncon where->    ncon (SApp (SCon succ t) [arg]) ->           | succ == name "S" = SInfix Plus (SConst (Num 1)) arg->    ncon (SCon zero t) ->           | zero == name "O" = SConst (Num 0)->    ncon x = x--* Nat function special cases--> natArith = SCTrans "NatArith" narith where->    narith (SApp (SVar op) [x,y]) --Arithmetic can use machine operations-->           | op == name "plus" = SInfix Plus x y->           | op == name "mult" = SInfix Times x y--Conversions between nat and int are just no-ops-->    narith (SApp (SVar op) [x]) ->           | op == name "natToInt" = x->           | op == name "intToNat" = x-->    narith x = x--* Nat destructor (case)--> natCase = SCTrans "NatCase" ncase where->    ncase x@(SCCase t alts) ->     = case getNatAlts alts of->              (Just z, Just (arg, s), _) -> mkNatRHS t z (doSuc arg t s)->              (Just z, Nothing, Just d) -> mkNatRHS t z d->              (Nothing, Just (arg, s), Just d) -> mkNatRHS t d (doSuc arg t s)->              (Nothing, Nothing, Just d) -> x->              _ -> x->    ncase x = x--if t==0 then z else s-->    mkNatRHS t z s = SIfZero t z s--let arg = t - 1 in s-->    doSuc arg t s = SLet arg (SInfix Minus t (SConst (Num 1))) s-->    getNatAlts alts = let zs = mHead (mapMaybe getZeroAlt alts)->                          ss = mHead (mapMaybe getSuccAlt alts)->                          defs = mHead (mapMaybe getDefault alts) in->                                 (zs, ss, defs)->                 ->    mHead [x] = Just x->    mHead [] = Nothing->    getZeroAlt (SAlt zero t [] zrhs) ->                 | zero == name "O" = return zrhs->    getZeroAlt _ = fail "no O"->    getSuccAlt (SAlt succ t [arg] srhs) ->                 | succ == name "S" = return (arg, srhs)->    getSuccAlt _ = fail "no S"->    getDefault (SDefault drhs) = return drhs->    getDefault _ = fail "no default"---[SAlt zero t [] zrhs]]-[SAlt succ t [arg] shrs]-[SAlt zero t [] zrhs, SAlt succ t [arg] shrs, _]--* Bool constructors--> boolCons = SCTrans "BoolCons" ncon where->    ncon (SCon true t)->           | true == name "True" = SConst (Num 1)->    ncon (SCon false t) ->           | false == name "False" = SConst (Num 0)->    ncon x = x--* Bool destructor (case)--> boolCase = SCTrans "BoolCase" bcase where->    bcase x@(SCCase t alts) ->     = case getBoolAlts alts of->              (Just fc, Just tc, _) -> mkBoolRHS t fc tc->              (Just fc, Nothing, Just d) -> mkBoolRHS t fc d->              (Nothing, Just tc, Just d) -> mkBoolRHS t d tc->              (Nothing, Nothing, Just d) -> x->              _ -> x->    bcase x = x-->    mkBoolRHS t z s = SIfZero t z s-->    getBoolAlts alts = let fs = mHead (mapMaybe getFalseAlt alts)->                           ts = mHead (mapMaybe getTrueAlt alts)->                           defs = mHead (mapMaybe getDefault alts) in->                                  (fs, ts, defs)->                 ->    mHead [x] = Just x->    mHead [] = Nothing-->    getFalseAlt (SAlt false t [] frhs) ->                 | false == name "False" = return frhs->    getFalseAlt _ = fail "no O"->    getTrueAlt (SAlt true t [] trhs) ->                 | true == name "True" = return trhs->    getTrueAlt _ = fail "no True"->    getDefault (SDefault drhs) = return drhs->    getDefault _ = fail "no default"--> doTrans :: SCTrans -> SCBody -> SCBody-> doTrans (SCTrans _ trans) tm = tr tm where->     tr (SApp b bs) = trans (SApp (tr b) (map tr bs))->     tr (SLet n v sc) = trans (SLet n (tr v) (tr sc))->     tr (SCCase b alts) = trans (SCCase (tr b) (map tralt alts))->     tr (SInfix op l r) = trans (SInfix op (tr l) (tr r))->     tr (SLazy s) = trans (SLazy (tr s))->     tr (SIf i t e) = trans (SIf (tr i) (tr t) (tr e))->     tr (SIfZero i t e) = trans (SIfZero (tr i) (tr t) (tr e))->     tr s = trans s-->     tralt (SAlt n t args rhs) = SAlt n t args (tr rhs)->     tralt (SConstAlt c rhs) = SConstAlt c (tr rhs)->     tralt (SDefault rhs) = SDefault (tr rhs)---
− Idris/Serialise.lhs 
@@ -1,406 +0,0 @@-> {-# OPTIONS_GHC -fglasgow-exts #-}--Binary instances for idris data structures, and saving and loading -typechecked forms to disk.--> module Idris.Serialise where--> import Idris.AbsSyntax-> import Idris.ConTrans-> import Ivor.ViewTerm-> import Ivor.TT--> import Data.Binary-> import Data.Typeable-> import Control.Monad--> import Debug.Trace--> instance Binary ViewTerm where->     put (Name t x) = do put (0 :: Word8)->                         put t; put x->     put (App f a) = do put (1 :: Word8)->                        put f; put a->     put (Lambda v ty sc) = do put (2 :: Word8)->                               put v; put ty; put sc->     put (Forall v ty sc) = do put (3 :: Word8)->                               put v; put ty; put sc->     put (Let n v ty sc) = do put (4 :: Word8)->                              put n; put v; put ty; put sc->     put Star = put (5 :: Word8)->     put Placeholder = put (6 :: Word8)->     put (Annotation a t) = do put (7 :: Word8)->                               put a; put t->     put (Metavar m) = do put (8 :: Word8)->                          put m->     put (Constant c) = case cast c :: Maybe String of->                          Just v -> do put (9 :: Word8)->                                       put v->                          Nothing -> case cast c :: Maybe Int of->                            Just v -> do put (10 :: Word8)->                                         put v->                            Nothing -> case cast c :: Maybe Double of->                               Just v -> do put (11 :: Word8)->                                            put v->                               Nothing -> case cast c :: Maybe Char of->                                 Just v -> do put (12 :: Word8)->                                              put v->                                 Nothing -> fail "Unknown constant type"-->     get = do tag <- getWord8->              case tag of->                0 -> liftM2 Name get get->                1 -> liftM2 App get get->                2 -> liftM3 Lambda get get get->                3 -> liftM3 Forall get get get->                4 -> liftM4 Let get get get get->                5 -> return Star->                6 -> return Placeholder->                7 -> liftM2 Annotation get get->                8 -> liftM Metavar get->                9 -> do s <- get->                        return (Constant (s :: String))->                10 -> do i <- get->                         return (Constant (i :: Int))->                11 -> do d <- get->                         return (Constant (d :: Double))->                12 -> do d <- get->                         return (Constant (d :: Char))---> instance Binary RBinder where->     put (Pi p l r) = do put (0 :: Word8)->                         put p; put l; put r->     put (Lam t) = do put (1 :: Word8); put t->     put (RLet t ty) = do put (2 :: Word8); put t; put ty-->     get = do tag <- getWord8->              case tag of->                0 -> liftM3 Pi get get get->                1 -> liftM Lam get->                2 -> liftM2 RLet get get--> instance Binary Op where->     put x = put (fromEnum x)->     get = do t <- get->              return (toEnum t)--> instance Binary Plicit where->     put x = put (fromEnum x)->     get = do t <- get->              return (toEnum t)--> instance Binary Fixity where->     put x = put (fromEnum x)->     get = do t <- get->              return (toEnum t)--> instance Binary Opt where->     put x = put (fromEnum x)->     get = do t <- get->              return (toEnum t)--> instance Binary TyOpt where->     put x = put (fromEnum x)->     get = do t <- get->              return (toEnum t)--> instance Binary ArgOpt where->     put x = put (fromEnum x)->     get = do t <- get->              return (toEnum t)--> instance Binary Do where->     put (DoBinding f l i t y) = do put (0 :: Word8)->                                    put f; put l; put i; put t; put y->     put (DoLet a b c d e) = do put (1 :: Word8)->                                put a; put b; put c; put d; put e->     put (DoExp a b c) = do put (2 :: Word8); put a; put b; put c-->     get = do tag <- getWord8->              case tag of->                0 -> liftM5 DoBinding get get get get get->                1 -> liftM5 DoLet get get get get get->                2 -> liftM3 DoExp get get get--> instance Binary RawTerm where->     put (RVar a b c d) = do put (0 :: Word8); put a; put b; put c; put d->     put (RExpVar a b c) = do put (1 :: Word8); put a; put b; put c->     put (RApp a b c d) = do put (2 :: Word8); put a; put b; put c; put d->     put (RAppImp a b c d e) ->        = do put (3 :: Word8); put a; put b; put c; put d; put e->     put (RBind a b c) = do put (4 :: Word8); put a; put b; put c->     put (RConst a b c) = do put (5 :: Word8); put a; put b; put c->     put RPlaceholder = put (6 :: Word8)->     put (RMetavar i) = do put (7 :: Word8); put i->     put (RInfix a b c d e) ->        = do put (8 :: Word8); put a; put b; put c; put d; put e->     put (RUserInfix a b c d e f) ->        = do put (9 :: Word8); put a; put b; put c; put d; put e; put f->     put (RDo xs) = do put (10 :: Word8); put xs->     put (RReturn a b) = do put (11 :: Word8); put a; put b->     put (RIdiom i) = do put (12 :: Word8); put i->     put (RPure i) = do put (13 :: Word8); put i->     put RRefl = do put (14 :: Word8)->     put (RError f l i) = do put (15 :: Word8); put f; put l; put i-->     get = do tag <- getWord8->              case tag of->                0 -> liftM4 RVar get get get get->                1 -> liftM3 RExpVar get get get->                2 -> liftM4 RApp get get get get->                3 -> liftM5 RAppImp get get get get get->                4 -> liftM3 RBind get get get->                5 -> liftM3 RConst get get get->                6 -> return RPlaceholder->                7 -> liftM RMetavar get->                8 -> liftM5 RInfix get get get get get->                9 -> do a <- get; b <- get; c <- get; d <- get; e <- get;->                        f <- get;->                        return $ RUserInfix a b c d e f->                10 -> liftM RDo get->                11 -> liftM2 RReturn get get->                12 -> liftM RIdiom get->                13 -> liftM RPure get->                14 -> return RRefl->                15 -> liftM3 RError get get get--> instance Binary Constant where->     put (Num i) = do put (0 :: Word8); put i->     put (Str i) = do put (1 :: Word8); put i->     put (Bo b) = do put (2 :: Word8); put b->     put (Ch c) = do put (3 :: Word8); put c->     put (Fl f) = do put (4 :: Word8); put f->     put TYPE = put (5 :: Word8)->     put StringType = put (6 :: Word8)->     put IntType = put (7 :: Word8)->     put FloatType = put (8 :: Word8)->     put CharType = put (9 :: Word8)->     put PtrType = put (10 :: Word8)->     put (Builtin i) = do put (11 :: Word8); put i-->     get = do tag <- getWord8->              case tag of->                0 -> liftM Num get->                1 -> liftM Str get->                2 -> liftM Bo get->                3 -> liftM Ch get->                4 -> liftM Fl get->                5 -> return TYPE->                6 -> return StringType->                7 -> return IntType->                8 -> return FloatType->                9 -> return CharType->                10 -> return PtrType->                11 -> liftM Builtin get--> instance Binary TransData where->     put (Force a b c d e f) = do put (0 :: Word8)->                                  put a; put b; put c; put d; put e; put f->     put (Collapse a b c d) = do put (1 :: Word8)->                                 put a; put b; put c; put d->     put (Drop a b c d) = do put (2 :: Word8)->                             put a; put b; put c; put d->     get = do tag <- getWord8->              case tag of->                0 -> do a <- get; b <- get; c <- get; d <- get;->                        e <- get; f <- get;->                        return (Force a b c d e f)->                1 -> liftM4 Collapse get get get get->                2 -> liftM4 Drop get get get get--> instance Binary Transform where->     put (Trans n _ a) = do put n; put a->     get = do n <- get; a <- get->              let trans = case a of->                            Nothing -> Nothing->                            Just a' -> Just (rebuildTrans a')->              return (Trans n trans a)--> instance Binary Syntax where->     put (Syntax f n t) = do put f; put n; put t->     get = liftM3 Syntax get get get--> instance Binary UserOps where->     put (UO ds ts f s) = do put ds; put ts; put f; put s->     get = do ds <- get; ts <- get; f <- get; s <- get;->              return (UO ds ts f s)--> instance Binary IvorFun where->     put (IvorFun a b c d e f g h) = ->         do trace ("Put " ++ show (a, d)) $ put a; put b; put c; put d; put e; put f; put g; put h->     get = do a <- get; b <- trace (show a) $ get; c <- get; d <- get; e <- get; f <- get; g <- get; h <- get->              trace ("Got " ++ show (a, d)) $ return (IvorFun a b c d e f g h)--> instance Binary CGFlag where->     put NoCG = put (0 :: Word8)->     put CGEval = put (1 :: Word8)->     put (CExport s) = do put (2 :: Word8); put s->     put Inline = put (3 :: Word8)->     put (CGSpec x) = do put (4 :: Word8); put x-->     get = do tag <- getWord8->              case tag of->                0 -> return NoCG->                1 -> return CGEval->                2 -> liftM CExport get->                3 -> return Inline->                4 -> liftM CGSpec get--> instance Binary Decl where->     put (DataDecl d) = do put (0 :: Word8); put d->     put (Fwd a b c) = do put (1 :: Word8); put a; put b; put c->     put (Fun a b) = do put (2 :: Word8); put a; put b->     put (TermDef a b c) = do put (3 :: Word8); put a; put b; put c->     put Constructor = put (4 :: Word8)->     put (Prf d f) = do put (5 :: Word8); put d; put f->     put (LatexDefs d) = do put (6 :: Word8); put d->     put (Using a b) = do put (7 :: Word8); put a; put b->     put (Params a b) = do put (8 :: Word8); put a; put b->     put (DoUsing a b c) = do put (9 :: Word8); put a; put b; put c->     put (Idiom a b c) = do put (10 :: Word8); put a; put b; put c->     put (CLib d) = do put (11 :: Word8); put d->     put (CInclude d) = do put (12 :: Word8); put d->     put (Fixity a b c) = do put (13 :: Word8); put a; put b; put c->     put (Transform a b) = do put (14 :: Word8); put a; put b->     put (Freeze a b c d) = do put (15 :: Word8); put a; put b; put c; put d->     put (SynDef a b c) = do put (16 :: Word8); put a; put b; put c->     put (PInclude a) = do put (17 :: Word8); put a->     put (Namespace a b) = do put (18 :: Word8); put a; put b-->     get = do tag <- getWord8->              case tag of->                0 -> liftM DataDecl get->                1 -> liftM3 Fwd get get get->                2 -> liftM2 Fun get get->                3 -> liftM3 TermDef get get get->                4 -> return Constructor->                5 -> liftM2 Prf get get->                6 -> liftM LatexDefs get->                7 -> liftM2 Using get get->                8 -> liftM2 Params get get->                9 -> liftM3 DoUsing get get get->                10 -> liftM3 Idiom get get get->                11 -> liftM CLib get->                12 -> liftM CInclude get->                13 -> liftM3 Fixity get get get->                14 -> liftM2 Transform get get->                15 -> liftM4 Freeze get get get get->                16 -> liftM3 SynDef get get get->                17 -> liftM PInclude get->                18 -> liftM2 Namespace get get--> instance Binary Datatype where->     put (Datatype a b c d e f g) = do put (0 :: Word8)->                                       put a; put b; put c; put d; put e;->                                       put f; put g;->     put (Latatype a b c d) = do put (1 :: Word8)->                                 put a; put b; put c; put d->     get = do tag <- getWord8->              case tag of->                0 -> do a <- get; b <- get; c <- get; d <- get;->                        e <- get; f <- get; g <- get;->                        return (Datatype a b c d e f g)->                1 -> liftM4 Latatype get get get get--> instance Binary Function where->     put (Function a b c d e) = do put a; put b; put c; put d; put e->     get = liftM5 Function get get get get get--> instance Binary Proof where->     put (Proof a b c) = do put a; put b; put c->     get = liftM3 Proof get get get--> instance Binary RawClause where->     put (RawClause a b) = do put (0 :: Word8); put a; put b->     put (RawWithClause a b c d) = do put (1 :: Word8); put a; put b; put c; put d->     get = do tag <- getWord8->              case tag of->                0 -> liftM2 RawClause get get->                1 -> liftM4 RawWithClause get get get get--> instance Binary Patterns where->     put (Patterns p) = put p->     get = liftM Patterns get--> instance Binary PClause where->     put (PClause a b c) = do put (0 :: Word8); put a; put b; put c->     put (PWithClause a b c d) = do put (1 :: Word8); put a; put b; put c; put d->     get = do tag <- getWord8->              case tag of->                0 -> liftM3 PClause get get get->                1 -> liftM4 PWithClause get get get get--> instance Binary Inductive where->     put (Inductive a b c d e) = do put a; put b; put c; put d; put e->     get = liftM5 Inductive get get get get get--> instance Binary ITactic where->     put (Intro a) = do put (0 :: Word8); put a->     put (Refine a) = do put (1 :: Word8); put a->     put (Generalise a) = do put (2 :: Word8); put a->     put ReflP = put (3 :: Word8)->     put (Induction a) = do put (4 :: Word8); put a->     put (Fill a) = do put (5 :: Word8); put a->     put Trivial = put (6 :: Word8)->     put (Idris.AbsSyntax.Case a) = do put (7 :: Word8); put a->     put (Rewrite a b c) = do put (8 :: Word8); put a; put b; put c->     put (Unfold a) = do put (9 :: Word8); put a->     put Compute = put (10 :: Word8)->     put (Equiv a) = do put (11 :: Word8); put a->     put (Believe a) = do put (12 :: Word8); put a->     put (Use a) = do put (13 :: Word8); put a->     put (Decide a) = do put (14 :: Word8); put a->     put (RunTactic a) = do put (15 :: Word8); put a->     put Qed = put (16 :: Word8)-->     get = do tag <- getWord8->              case tag of->                0 -> liftM Intro get->                1 -> liftM Refine get->                2 -> liftM Generalise get->                3 -> return ReflP->                4 -> liftM Induction get->                5 -> liftM Fill get->                6 -> return Trivial->                7 -> liftM Idris.AbsSyntax.Case get->                8 -> liftM3 Rewrite get get get->                9 -> liftM Unfold get->                10 -> return Compute->                11 -> liftM Equiv get->                12 -> liftM Believe get->                13 -> liftM Use get->                14 -> liftM Decide get->                15 -> liftM RunTactic get->                16 -> return Qed--> instance Binary IvorDef where->     put (PattDef ps) = do put (0 :: Word8); put ps->     put ITyCon = put (1 :: Word8)->     put IDataCon = put (2 :: Word8)->     put (SimpleDef t) = do put (3 :: Word8); put t->     put (DataDef a b) = do put (4 :: Word8); put a; put b->     put (IProof ts f) = do put (5 :: Word8); put ts; put f->     put Later = put (6 :: Word8)->     put LataDef = put (7 :: Word8)-->     get = do tag <- getWord8->              case tag of->                0 -> liftM PattDef get->                1 -> return ITyCon->                2 -> return IDataCon->                3 -> liftM SimpleDef get->                4 -> liftM2 DataDef get get->                5 -> liftM2 IProof get get->                6 -> return Later->                7 -> return LataDef--> instance Binary IdrisState where->     put (IState a b c d e f g h i j k) ->        = do put a; put b; put c; put d; put e; put f; put g; put h; ->             put i; put j; put k->     get = do a <- get; b <- get; c <- get;->              d <- get; e <- get; f <- get; g <- get; h <- get; i <- get->              j <- get; k <- get->              return (IState a b c d e f g h i j k)-
− Idris/SimpleCase.lhs 
@@ -1,135 +0,0 @@-> {-# OPTIONS_GHC -fglasgow-exts #-}--> module Idris.SimpleCase(liftCases, addPatternDefSC, addMeta) where--> import Idris.AbsSyntax--> import Ivor.ViewTerm-> import Ivor.TT--> import Control.Monad.State-> import Debug.Trace--> type LCState = (Int, [(Name, ViewTerm, Patterns)])--> liftCases :: Name -> Patterns -> (Patterns, [(Name, ViewTerm, Patterns)])-> liftCases n ps ->      = let (ps', (i, ns)) = runState (liftCasePatts n ps) (10000, []) in->            {- trace (show (ps', ns)) $ -} (ps', ns)--> liftCasePatts :: Name -> Patterns -> ->                  State LCState Patterns-> liftCasePatts n (Patterns ps) ->               = do ps' <- liftPs ps []->                    (_, ns) <- get->                    return (Patterns ps')->    where liftPs [] acc = return acc->          liftPs ((PClause args bs rv):ps) acc->                    = do rv' <- lc n bs rv->                         liftPs ps (acc ++ [PClause args bs rv'])->          liftPs ((PWithClause p args sc pdefs):ps) acc->                    = do sc' <- lc n [] sc->                         pdefs' <- liftCasePatts n pdefs->                         liftPs ps (acc ++ [PWithClause p args sc' pdefs'])---> lc :: Name -> [(Name, ViewTerm)] -> ViewTerm -> State LCState ViewTerm -> lc root bs = lc' where->  lc' tm | Name nty fn <- getApp tm->       = let args = getFnArgs tm in->            if (fn == name "__CASE" && length args == 4)then ->                 do (i, fns) <- get->                    let params = bs->                    let paramArgs = map (Name Unknown) (map fst params)->                    let newdef = Patterns (getNewDef paramArgs (deAnnot (args!!!(3,"FAIL3"))))->                    let argtype = args!!!(0, "FAIL0")->                    let rettype = args!!!(1, "FAIL1")->                    let scrutinee = args!!!(2, "FAIL2")->                    let newty = getNewType params argtype rettype->                    let newname = name (show (MN (show root) i))->                    let newfn = (newname, newty, newdef)->                    put (i+1, newfn:fns)->                    -- trace (show (newname, params, newdef)) $->                    return (apply (Name Unknown newname) (paramArgs++[scrutinee]))->                 else return tm->  lc' (App f a) = do f' <- lc' f; a' <- lc' a; return (App f' a')->  lc' (Lambda n t sc) ->    = do t' <- lc' t; sc' <- lc' sc; return (Lambda n t' sc')->  lc' (Forall n t sc) ->    = do t' <- lc' t; sc' <- lc' sc; return (Forall n t' sc')->  lc' (Let n t v sc) ->    = do t' <- lc' t; v' <- lc' v; ->         sc' <- lc' sc; return (Let n t' v' sc')->  lc' (Annotation a t) = do t' <- lc' t; return (Annotation a t')->  lc' x = return x--> getNewDef :: [ViewTerm] -> ViewTerm -> [PClause]-> getNewDef ps (Let _ _ _ sc) = getNewDef ps sc-> getNewDef ps (App (App (App (App (App (Name _ branch) _) _) patt) ret) next)->           | branch == name "__BRANCH"->                = PClause (ps++[patt]) [] ret ->                    : getNewDef ps next-> getNewDef ps x = []--> getParams :: ViewTerm -> [(Name, ViewTerm)]-> getParams (App (App (App (Name _ is) ty) (Name _ n)) rest)->           | is == name "__IS" = (n, ty):getParams rest-> getParams _ = []--> getNewType :: [(Name, ViewTerm)] -> ViewTerm -> ViewTerm -> ViewTerm-> getNewType [] arg ret = Forall (name "__X") arg ret-> getNewType ((n,ty):ns) arg ret = Forall n ty (getNewType ns arg ret)--> deAnnot :: ViewTerm -> ViewTerm-> deAnnot (Annotation a t) = deAnnot t-> deAnnot (App f a) = App (deAnnot f) (deAnnot a)-> deAnnot x = x--> addPatternDefSC :: Context -> Name -> ViewTerm -> Patterns -> ->                    Maybe [(Name, Int)] -> Statics ->->                    TTM (Context, [(Name, ViewTerm)])-> addPatternDefSC ctxt nm ty ps specopts sts = do->     -- just allow general recursion for now->     let opts = [Holey, Partial, GenRec]--case specopts of-                  Nothing -> [Holey, Partial, GenRec]-                  Just fns -> trace ("Specialising " ++ show nm ++ " with " ++ show (map mkss sts)) $ -                              [Holey, Partial, GenRec], Specialise fns,-                               SpecStatic (map mkss sts)]-->     (ctxt', newdefs) <- addPatternDef ctxt nm ty ps opts->     ctxt' <- case specopts of->                Nothing -> return ctxt'->                Just fns -> trace ("Specialising " ++ show nm ++ " with " ++ show (map mkss sts)) $ ->                            spec ctxt' nm (map mkss sts) (map fst fns)->     (_, patts) <- getPatternDef ctxt' nm->     let (ps', ds) = liftCases nm patts->     if (null ds) then return (ctxt', newdefs)->        else do->          (ctxt', newdefs) <- addAll ctxt ds []->          (ctxt', newdefs') <- addPatternDef ctxt' nm ty ps' [Holey,Partial,GenRec]->          return (ctxt', newdefs++newdefs')->  where addAll ctxt [] nds = return (ctxt, nds)->        addAll ctxt ((n,ty,ps):rs) nds = do->          (ctxt', newdefs') <- addPatternDefSC ctxt n ty ps specopts sts->          addAll ctxt' rs (newdefs'++nds) ->        mkss (n, (statics, arity, ty)) = (n, (statics, arity))--> addMeta :: Bool ->->            Ctxt IvorFun -> Context -> ->           [(Name, ViewTerm)] -> [(Name, ViewTerm)] -> ->            TTM (Context, [(Name, ViewTerm)])-> addMeta verbose raw ctxt metas newdefs->       = let ans = (ctxt, metas ++ newdefs) in->                   if verbose then trace ("Metavariables are:\n" ++  concat (map showDef newdefs)) $ return ans->                              else return ans->    where->          showDef (n,ty) = "  " ++ show n ++ " : " ++ dumpMeta (unIvor raw ty)->                           ++ "\n"->          dumpMeta tm = showImp False (Idris.AbsSyntax.getRetType tm) ++ ->                        "\n  in environment\n" ++ ->                        dumpArgs (Idris.AbsSyntax.getArgTypes tm)->          dumpArgs [] = ""->          dumpArgs ((n,ty):xs) = "    " ++ show n ++ " : " ++showImp False ty->                                 ++ "\n" ++ dumpArgs xs
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2006-2010 Edwin Brady+Copyright (c) 2011 Edwin Brady     School of Computer Science, University of St Andrews All rights reserved.
− Main.lhs 
@@ -1,719 +0,0 @@-> module Main where--> import Ivor.TT hiding (transform)-> import Ivor.Shell--> import System-> import System.Environment-> import System.Time-> import System.Locale-> import System.IO-> import System.Console.Readline-> import Data.Typeable-> import Data.Binary-> import Char-> import Control.Monad-> import Control.Exception-> import List-> import Maybe-> import Debug.Trace-> import Distribution.Version-> import Prelude hiding (catch)--> import Idris.AbsSyntax-> import Idris.MakeTerm-> import Idris.Lib-> import Idris.Parser-> import Idris.Latex-> import Idris.Compiler-> import Idris.Prover-> import Idris.ConTrans-> import Idris.Fontlock-> import Idris.Serialise-> import Idris.RunIO-> import Idris.PartialEval--> import Paths_idris--Load things in this order:--* Introduce equality-* Load builtins (which don't rely on primitive types)-* Add primitives-* Load prelude-* Load users program--> idris_version = showV (versionBranch version)->   where->     showV [] = ""->     showV [a] = show a->     showV (x:xs) = show x ++ "." ++ showV xs--> data Args = Batch [String]->           | NoArgs--> main :: IO ()-> main = do args <- getArgs->           (infile, (batch, opts)) <- usage args->           ctxt <- ioTac $ addEquality emptyContext (name "Eq") (name "refl")->           (ctxt, defs) <- processInput ctxt (initState opts) "builtins.idr"->           ctxt <- ioTac $ prims ctxt->           (ctxt, defs) <- processInput ctxt defs "prelude.idr"->           (ctxt, defs) <- processInput ctxt defs infile->           let vars = idris_metavars defs->           when (not (null vars)) $->               do putStr "Proof obligations:\n\t"->                  print (map fst vars)->                  putStr "\n"->           repl defs ctxt batch--> usage opts@(('-':_):_) = do o <- mkArgs opts->                             putStrLn "No input file"->                             umessage-> usage [fname] = return (fname, (NoArgs, []))-> usage (fname:opts) = do o <- mkArgs opts->                         return (fname, o)-> usage _ = umessage--> umessage = ->   do putStrLn $ "Idris version " ++ idris_version->      putStrLn $ "--------------" ++ take (length idris_version) (repeat '-')->      putStrLn $ "Usage:"->      putStrLn $ "\tidris <source file> [options]"->      putStrLn $ "\n\tAvailable options:"->      putStrLn $ "\t\t -o <executable>   Compile to an executable"->      putStrLn $ "\t\t --run             Compile and run"->      putStrLn $ "\t\t --nospec          Turn off specialisation and transformation rules"->      putStrLn $ "\t\t --noerasure       Turn off erasure optimisations"->      putStrLn $ "\t\t --cmd <command>   Run a command in batch mode"->      putStrLn $ "\t\t --dir             Show support file location"->      putStrLn $ "\t\t --verbose         Debugging output"->      putStrLn $ "\n"->      exitWith (ExitFailure 1)--> mkArgs xs = mkA' [] [] xs where->     mkA' [] opts [] = return (NoArgs, opts)->     mkA' args opts [] = return (Batch (reverse args), opts)->     mkA' args opts ("-o":output:xs) ->           = mkA' ((":c " ++ output):args) opts xs->     mkA' args opts ("--run":xs) ->           = mkA' (":e":args) opts xs->     mkA' args opts ("-v":xs)->           = mkA' args (Verbose:opts) xs->     mkA' args opts ("--verbose":xs)->           = mkA' args (Verbose:opts) xs->     mkA' args opts ("--nospec":xs)->           = mkA' args (NoSpec:opts) xs->     mkA' args opts ("--noerasure":xs)->           = mkA' args (NoErasure:opts) xs->     mkA' args opts ("--cmd":b:xs)->           = mkA' (b:args) opts xs->     mkA' args opts ("--dir":xs)->           = do d <- getDataDir->                putStrLn d->                exitWith ExitSuccess->     mkA' args opts (x:xs) = do putStrLn $ "Unrecognised option " ++ x ++ "\n"->                                umessage--Time functions-FIXME: These use System.Time which is deprecated. Find out what to use-these days instead...--> picosec = 1000000000000-> mins = picosec*60-> hours = mins*60-> days = hours*24--> getTime :: IO Integer -> getTime = do (TOD sec pico) <- getClockTime->              return $ sec*picosec+pico-> diffTime t1 t2 = t1-t2-> showTime t = show (t `div` picosec) ++ "." ++ ->              (take 6 (zeros (show (t `mod` picosec)))) ++->              " seconds"->          -- add leading zeros->    where zeros t = (take (12 - length t) (repeat '0')) ++ t --> processInput :: Context -> IdrisState -> FilePath ->->                 IO (Context, IdrisState)-> processInput ctxt ist file = do->     let defs = idris_context ist->     let decls = idris_decls ist->     let opts = idris_options ist->     let fixes = idris_fixities ist->     let static = idris_static ist->     let sts = idris_static_used ist->     content <- readLibFile defaultLibPath file->     (ptree, imps) <- processImports opts (idris_imports ist) (parse content file)->     let (defsin, ops) = makeIvorFuns opts defs ptree fixes->     let static' = staticDecls defsin ++ static->     let defs' = defsin -- addPEdefs static' defsin->     let alldefs = appCtxt defs defs'->     ((ctxt, metas), fixes', sts') <- ->         case (addIvor opts ist alldefs defs' ctxt ops static' sts) of->             OK x fixes' sts' -> return (x, fixes', sts')->             Err x fixes' sts' err -> do putStrLn err ->                                         return (x, fixes', sts')->     let ist = addTransforms (IState alldefs (decls ++ ptree) metas opts ops [] newCtxt imps (mkNameMap alldefs) static' sts') ctxt ->     return (ctxt, ist { idris_fixities = fixes' })--> data REPLRes = Quit | Continue | NewCtxt IdrisState Context--Command; minimal abbreviation; function to run it; description; visibility--> commands->    = [("quit", "q", quit, "Exits the top level",True),->       ("type", "t", tmtype, "Print the type of a term",True),->       ("prove", "p", prove, "Begin a proof of an undefined name",True),->       ("metavars", "m", metavars, ->                    "Show remaining proof obligations",True),->       ("ivor", "i", ivor, "Drop into the Ivor shell",True),->       ("compile", "c", tcomp, "Compile a definition (of type IO ()", True),->       ("execute", "e", texec, "Compile and execute 'main'", True),->       ("LATEX", "L", latex, "Render a source file as LaTeX",False),->       ("HTML","H", html, "Render a source file as html", False),->       ("normalise", "n", norm, "Normalise a term (without executing)", True),->       ("definition", "d", showdef, "Show the erased version of a function or type", True),->       ("options","o", options, "Set options", True),->       ("help", "h", help, "Show help text",True),->       ("save", "s", ssave, "Save system state",True),->       ("load", "l", sload, "Load system state",True),->       ("xdebug", "xd", debug, "Show some internal stuff", False),->       ("?", "?", help, "Show help text",True)]--> type Command = IdrisState -> Context -> [String] -> IO REPLRes--> quit, tmtype, prove, metavars, tcomp, texec :: Command -> debug, norm, help, options, showdef, html, ssave :: Command--> quit _ _ _ = do return Quit-> tmtype (IState raw _ _ _ uo _ _ _ _ _ _) ctxt tms ->            = do icheckType raw uo ctxt (unwords tms)->                 return Continue-> prove ist ctxt (nm:[]) ->           = do let raw = idris_context ist->                ctxt' <- doProof raw ctxt (idris_fixities ist) (UN nm)->                let imv = filter (\ (x,y) -> x /= toIvorName (UN nm))->                              (idris_metavars ist)->                let ist' = ist { idris_metavars = imv }->                return (NewCtxt ist' ctxt')-> prove ist ctxt _ = do putStrLn "What do you want to prove?"->                       return Continue-> metavars ist ctxt _->           = do let vars = idris_metavars ist->                if (null vars)->                   then putStrLn "All proofs complete."->                   else ->                     do putStr "Proof obligations:\n\t"->                        print (map fst vars)->                        putStr "\n"->                return Continue-> ivor ist ctxt _ = do ctxt' <- doIvor ctxt->                      return (NewCtxt ist ctxt')-- latex ist ctxt (nm:defs) -           = do latexDump (idris_context ist) (latexDefs defs) (UN nm)-                return Continue--> html ist ctxt (nm:onm:style:_)->           = do htmlise (idris_context ist) nm onm (Just style)->                return Continue-> html ist ctxt (nm:onm:_)->           = do htmlise (idris_context ist) nm onm Nothing->                return Continue-> html ist ctxt _->           = do putStrLn "Please give input and output files"->                return Continue-> ssave ist ctxt (nm:_)->           = do encodeFile nm ist->                return Continue-> ssave ist ctxt _->           = do putStrLn "Please give an output file name"->                return Continue-> sload ist ctxt (nm:_)->           = do ist' <- decodeFile nm->                return (NewCtxt ist' ctxt)-> sload ist ctxt _->           = do putStrLn "Please give an input file name"->                return Continue-> latex ist ctxt (nm:onm:_)->           = do latexise (idris_context ist) nm onm->                return Continue-> latex ist ctxt _->           = do putStrLn "Please give input and output files"->                return Continue-> debug ist ctxt []->           = do putStrLn "Fixities/transforms\n"->                print (idris_fixities ist)->                putStrLn "\nStatic args:\n"->                print (idris_static ist)->                print (idris_static_used ist)->                return Continue-> tcomp ist ctxt [] ->           = do putStrLn "Please give an output filename"->                return Continue-> tcomp ist ctxt (top:[]) ->           = do let raw = idris_context ist->                comp ist ctxt (UN top) top->                -- putStrLn $ "Output " ++ top->                return Continue-> tcomp ist ctxt (top:exec:_) ->           = do comp ist ctxt (UN top) exec->                return Continue-> texec ist ctxt _ ->           = do time <- getTime->                res <- comp ist ctxt (UN "main") "main"->                ctime <- getTime->                let cdiff = diffTime ctime time->                when (ShowRunTime `elem` (idris_options ist))->                     (putStrLn $ "Compile time: " ++ showTime cdiff ++ "\n")->                when res (do system "./main"->                             return ())->                rtime <- getTime->                let rdiff = diffTime rtime ctime->                when (ShowRunTime `elem` (idris_options ist))->                     (putStrLn $ "\nRun time: " ++ showTime rdiff)->                return Continue-> norm ist ctxt tms ->          = do let raw = idris_context ist->               termInput False raw (idris_fixities ist) ctxt (unwords tms)->               return Continue-> options ist ctxt []->          = do putStrLn $ "Options: " ++ show (idris_options ist)->               return Continue-> options ist ctxt tms ->          = do let opts = idris_options ist->               let ist' = addTransforms (ist { idris_options = processOpts opts tms }) ctxt->               return $ NewCtxt ist' ctxt--> help _ _ _ ->    = do putStrLn $ "\nIdris version " ++ idris_version->         putStrLn $ "----------------" ++ take (length idris_version) (repeat '-')->         putStrLn "Commands available:\n"->         putStrLn "\t<expression>     Execute the given expression"->         mapM_ (\ (com, _, _, desc,vis) -> ->                    if vis ->                       then putStrLn $ "\t:" ++ com ++ (take (16-length com) (repeat ' ')) ++ desc->                       else return ()) commands->         putStrLn "\nCommands may be given the shortest unambiguous abbreviation (e.g. :q, :l)\n"->         return Continue--> repl :: IdrisState -> Context -> Args -> IO ()-> repl ist ctxt (Batch []) = return () -> repl ist@(IState raw decls metas opts fixes trans syns imps nms st stu) ctxt inp' ->          = do (inp, next) <- case inp' of ->                        Batch (b:bs) -> return (Just b, Batch bs)->                        _ -> do x <- readline ("Idris> ")->                                return (x, NoArgs)->               res <- case inp of->                        Nothing ->->                            do putChar '\n'->                               return Quit->                        Just (':':command) -> ->                            do addHistory (':':command)->                               runCommand' (words command) commands->                        Just exprinput -> ->                            do termInput' raw fixes ctxt exprinput->                               addHistory exprinput->                               return Continue->               case res of->                      Continue -> repl ist ctxt next->                      NewCtxt ist' ctxt' -> repl ist' ctxt' next->                      Quit -> return ()-->   where->      runCommand (c:args) ((_, abbr, fun, _, _):xs) ->         | matchesAbbrev abbr c = fun ist ctxt args->         | otherwise = runCommand (c:args) xs->      runCommand _ _ = do putStrLn "Unrecognised command"->                          help ist ctxt []->                          return Continue->      matchesAbbrev [] _ = True->      matchesAbbrev (a:xs) (c:cs) | a == c = matchesAbbrev xs cs->                                  | otherwise = False->      matchesAbbrev _ _ = False-->      termInput' r f c inp = handle handler $ termInput True r f c inp->         where handler StackOverflow = putStrLn "Stack overflow"->               handler UserInterrupt = putStrLn "Interrupted"->               handler e             = print e -- throwIO e->      runCommand' w c = handle handler $ runCommand w c->         where handler e = do print (e :: IOError)->                              return Continue--> termInput runio raw uo ctxt tm ->         = case getTerm tm of->                Right tm -> execEval runio raw ctxt (tm, viewType tm)->                Left err -> print err->   where getTerm tm = do let parsed' = parseTerm tm->                         case parsed' of->                           Success parsed -> do->                              let itm = makeIvorTerm noImplicit defDo uo (UN "__main") raw parsed->                              check ctxt itm->                           Failure err f l -> ttfail err--If it is an IO type, execute it, otherwise just eval it.--> execEval :: Bool -> Ctxt IvorFun -> Context -> (Term, ViewTerm) -> IO ()-> execEval True ivs ctxt (tm, (App (Name _ io) _))->          | io == name "IO.IO" = do catch (exec ctxt tm)->                                       (\e -> print (e :: IOError))->                                 -- putStrLn $ show (whnf ctxt tm)-> execEval runio ivs ctxt (tm, _) ->         = do let res = (evalnew ctxt tm)->              -- print res->              -- putStrLn (showImp True (unIvor ivs (view res)))->              putStr (showImp False (unIvor ivs (view res)))->              putStrLn $ " : " ++ showImp False (unIvor ivs (viewType res))--> icheckType :: Ctxt IvorFun -> UserOps -> Context -> String -> IO ()-> icheckType ivs uo ctxt tmin->         = case parseTerm tmin of ->               Success tm -> ->                    do let itm = makeIvorTerm noImplicit defDo uo (UN "__main") ivs tm->                       gtm <- ioTac $ check ctxt itm->                       putStrLn $ showImp False (unIvor ivs (viewType gtm))->               Failure err _ _ -> putStrLn err---> processOpts :: [Opt] -> [String] -> [Opt]-> processOpts opts [] = opts-> processOpts opts (x:xs) = processOpts (processOpt opts x) xs--> processOpt opts "f-" = nub (NoErasure:opts)-> processOpt opts "r+" = nub (ShowRunTime:opts)--> processOpt opts "f+" = (nub opts) \\ [NoErasure]-> processOpt opts "r-" = (nub opts) \\ [ShowRunTime]--> processOpt opts _ = opts -- silently ignore (FIXME)--Look up the name as a pattern definition, then as an inductive, and show-the appropriate thing, after applying the relevant transformations.--> showdef ist ctxt []->      = do putStrLn "Please give a name"->           return Continue-> showdef ist ctxt (n:_)->     = do case getPatternDef ctxt (name n) of->            Right (ty, pats) -> do showPDefs n (idris_context ist) (transform ctxt [] (transforms (idris_fixities ist)) (name n) pats)->                                   putStrLn "Compiles as:\n"->                                   showPats n (idris_context ist) (transform ctxt ->                                              (idris_transforms ist)->                                              (transforms (idris_fixities ist))->                                               (name n) pats)->                                   -- let Right (args, sc) = getCompiledPatternDef ctxt (name n)->                                   -- putStrLn "\nInternally compiled as:\n"->                                   -- print (args, sc)->            _ -> case getInductive ctxt (name n) of->                   Right ind -> showInductive n ctxt (idris_transforms ist) ->                                               (constructors ind)->                   _ -> putStrLn $ n ++ " not defined"->          return Continue--> showPats :: String -> Ctxt IvorFun -> Patterns -> IO ()-> showPats n ivs (Patterns ps) = putStrLn $ concat (map (\x -> showp' x ++ "\n") ps)->   where showp' (PClause args _ ty) ->                    = n ++ " " ++ concat (map (\x -> showarg (show x)) args) ++ "= " ++ showId ty->         showarg x = if (' ' `elem` x) then "(" ++ x ++ ") " else x ++ " "->         showId res = show res -- showImp True (unIvor ivs res)--> showPDefs :: String -> Ctxt IvorFun -> Patterns -> IO ()-> showPDefs n ivs (Patterns ps) = putStrLn $ concat (map (\x -> showp' x ++ "\n") ps)->   where showp' (PClause args _ ty) ->                    = n ++ " " ++ concat (map (\x -> showarg (show x)) args) ++ "= " ++ showId ty->         showarg x = if (' ' `elem` x) then "(" ++ x ++ ") " else x ++ " "->         showId res = showImp False (unIvor ivs res)--> showInductive :: String -> Context -> [Transform] -> ->                  [(Name, ViewTerm)] -> IO ()-> showInductive n ctxt trans cons ->    = do putStrLn $ n ++ " constructors:"->         putStrLn $ concat (map (\x -> "  " ++ showc x ++ "\n") cons)->  where showc (n, ty) = let atys = Ivor.TT.getArgTypes ty ->                            args = map mkName atys->                            app = apply (Name DataCon n) args in->                            show (applyTransforms ctxt trans app)->        mkName (n, ty) = Name Unknown (name (showarg (useName (show n) ty)))->        useName ('_':'_':_) ty = show ty->        useName n ty = n ++ " : " ++ show ty->        showarg x = if (' ' `elem` x) then "(" ++ x ++ ")" else x--> prims c = do c <- addPrimitive c (name "Int")->              c <- addPrimitive c (name "Char")->              c <- addPrimitive c (name "Float")->              c <- addPrimitive c (name "String")->              c <- addPrimitive c (name "Lock")->              c <- addPrimitive c (name "Handle")->              c <- addPrimitive c (name "Ptr")->              c <- addBinOp c (opFn Plus) ((+)::Int->Int->Int) "Int->Int->Int"->              c <- addBinOp c (opFn Minus) ((-)::Int->Int->Int)->                                "Int->Int->Int"->              c <- addBinOp c (opFn Times) ((*)::Int->Int->Int)->                                "Int->Int->Int"->              c <- addBinOp c (opFn Divide) (div::Int->Int->Int)->                                "Int->Int->Int"->              c <- addBinOp c (opFn Modulo) (mod::Int->Int->Int)->                                "Int->Int->Int"->              c <- addBinOp c (opFn FPlus) ((+)::Double->Double->Double) "Float->Float->Float"->              c <- addBinOp c (opFn FMinus) ((-)::Double->Double->Double)->                                "Float->Float->Float"->              c <- addBinOp c (opFn FTimes) ((*)::Double->Double->Double)->                                "Float->Float->Float"->              c <- addBinOp c (opFn FDivide) ((/)::Double->Double->Double)->                                "Float->Float->Float"->              c <- addBinOp c (opFn Concat) ((++)::String->String->String)->                                "String->String->String"->              c <- addBinOp c (opFn StringGetIndex) ->                       ((\str i -> str!!!(i,"stringGetIndex fail"))::String->Int->Char)->                                "String->Int->Char"->              c <- addBinOp c (opFn ShL) (shl::Int->Int->Int) "Int->Int->Int"->              c <- addBinOp c (opFn ShR) (shr::Int->Int->Int) "Int->Int->Int"->              c <- addExternalFn c (opFn OpEq) 2 constEq "Int->Int->Bool"->              c <- addExternalFn c (name "__charEq") 2 constEq "Char->Char->Bool"->              c <- addExternalFn c (name "__strEq") 2 constEq "String->String->Bool"->              c <- addExternalFn c (name "__strLT") 2 constLT "String->String->Bool"->              c <- addExternalFn c (opFn OpLT) 2 intlt "Int->Int->Bool"->              c <- addExternalFn c (opFn OpLEq) 2 intle "Int->Int->Bool"->              c <- addExternalFn c (opFn OpGT) 2 intgt "Int->Int->Bool"->              c <- addExternalFn c (opFn OpGEq) 2 intge "Int->Int->Bool"-->              c <- addExternalFn c (opFn OpFEq) 2 constEq "Float->Float->Bool"->              c <- addExternalFn c (opFn OpFLT) 2 floatlt "Float->Float->Bool"->              c <- addExternalFn c (opFn OpFLEq) 2 floatle "Float->Float->Bool"->              c <- addExternalFn c (opFn OpFGT) 2 floatgt "Float->Float->Bool"->              c <- addExternalFn c (opFn OpFGEq) 2 floatge "Float->Float->Bool"-->              c <- addExternalFn c (opFn FloatToString) 1 floatToString "Float->String"->              c <- addExternalFn c (opFn ToString) 1 intToString "Int->String"->              c <- addExternalFn c (opFn ToInt) 1 stringToInt "String->Int"->              c <- addExternalFn c (opFn StringToFloat) 1 stringToFloat "String->Float"->              c <- addExternalFn c (opFn IntToChar) 1 intToChar "Int->Char"->              c <- addExternalFn c (opFn CharToInt) 1 charToInt "Char->Int"->              c <- addExternalFn c (opFn StringLength) 1 stringLen "String->Int"->              c <- addExternalFn c (opFn StringHead) 1 stringHead "String->Char"->              c <- addExternalFn c (opFn StringTail) 1 stringTail "String->String"->              c <- addExternalFn c (opFn StringCons) 2 stringCons "Char->String->String"->              c <- addExternalFn c (opFn StringRev) 1 stringRev "String->String"->              c <- addExternalFn c (opFn StringSub) 3 stringSub "String->Int->Int->String"->              c <- addExternalFn c (opFn StringFind) 2 stringFind "String->Char->Int"->              c <- addExternalFn c (name "__Prove_Anything") 3 proveAnything->                                   "(A:*)->(B:*)->A->B"->              c <- addExternalFn c (name "__lazy") 1 runLazy "(A:*)A->A"->              c <- addExternalFn c (name "__effect") 1 runEffect "(A:*)A->A"->              return c--> shl :: Int -> Int -> Int-> shl x 0 = x-> shl x n = shl (x*2) (n-1)--> shr :: Int -> Int -> Int-> shr x 0 = x-> shr x n = shr (x `div` 2) (n-1)--> constEq :: [ViewTerm] -> Maybe ViewTerm-> constEq [Constant x, Constant y]->       = case cast x of->           Just x' -> if (x'==y)->                        then Just $ Name DataCon (name "True")->                        else Just $ Name DataCon (name "False")->           _ -> Nothing-> constEq _ = Nothing--> constLT :: [ViewTerm] -> Maybe ViewTerm-> constLT [Constant x, Constant y]->       = case (cast x, cast y) :: (Maybe String, Maybe String) of->           (Just x', Just y') -> if (x'<y')->                        then Just $ Name DataCon (name "True")->                        else Just $ Name DataCon (name "False")->           _ -> Nothing -- Just $ Name DataCon (name "False")-- constEq [_, x, y] = if (x == y) then Just $ Name DataCon (name "True")-                        else Just $ Name DataCon (name "False")--> constLT _ = Nothing--> intlt :: [ViewTerm] -> Maybe ViewTerm-> intlt [Constant x, Constant y]->       = case (cast x, cast y) of->           (Just x', Just y') -> if (x'<(y'::Int))->                            then Just $ Name DataCon (name "True")->                            else Just $ Name DataCon (name "False")->           _ -> Nothing-> intlt _ = Nothing--> intle :: [ViewTerm] -> Maybe ViewTerm-> intle [Constant x, Constant y]->       = case (cast x, cast y) of->           (Just x', Just y') -> if (x'<=(y'::Int))->                        then Just $ Name DataCon (name "True")->                        else Just $ Name DataCon (name "False")->           _ -> Nothing-> intle _ = Nothing--> intgt :: [ViewTerm] -> Maybe ViewTerm-> intgt [Constant x, Constant y]->       = case (cast x, cast y) of->           (Just x', Just y') -> if (x'>(y'::Int))->                        then Just $ Name DataCon (name "True")->                        else Just $ Name DataCon (name "False")->           _ -> Nothing-> intgt _ = Nothing--> intge :: [ViewTerm] -> Maybe ViewTerm-> intge [Constant x, Constant y]->       = case (cast x, cast y) of->           (Just x', Just y') -> if (x'>=(y'::Int))->                        then Just $ Name DataCon (name "True")->                        else Just $ Name DataCon (name "False")->           _ -> Nothing-> intge _ = Nothing--> floatlt :: [ViewTerm] -> Maybe ViewTerm-> floatlt [Constant x, Constant y]->       = case (cast x, cast y) of->           (Just x', Just y') -> if (x'<(y'::Double))->                            then Just $ Name DataCon (name "True")->                            else Just $ Name DataCon (name "False")->           _ -> Nothing-> floatlt _ = Nothing--> floatle :: [ViewTerm] -> Maybe ViewTerm-> floatle [Constant x, Constant y]->       = case (cast x, cast y) of->           (Just x', Just y') -> if (x'<=(y'::Double))->                        then Just $ Name DataCon (name "True")->                        else Just $ Name DataCon (name "False")->           _ -> Nothing-> floatle _ = Nothing--> floatgt :: [ViewTerm] -> Maybe ViewTerm-> floatgt [Constant x, Constant y]->       = case (cast x, cast y) of->           (Just x', Just y') -> if (x'>(y'::Double))->                        then Just $ Name DataCon (name "True")->                        else Just $ Name DataCon (name "False")->           _ -> Nothing-> floatgt _ = Nothing--> floatge :: [ViewTerm] -> Maybe ViewTerm-> floatge [Constant x, Constant y]->       = case (cast x, cast y) of->           (Just x', Just y') -> if (x'>=(y'::Double))->                        then Just $ Name DataCon (name "True")->                        else Just $ Name DataCon (name "False")->           _ -> Nothing-> floatge _ = Nothing--> intToString :: [ViewTerm] -> Maybe ViewTerm-> intToString [Constant x]->             = case cast x of->                 (Just s) -> Just (Constant (iToS s))->                 _ -> Nothing->    where iToS :: Int -> String->          iToS x = show x-> intToString _ = Nothing--> floatToString :: [ViewTerm] -> Maybe ViewTerm-> floatToString [Constant x]->             = case cast x of->                 (Just s) -> Just (Constant (fToS s))->                 _ -> Nothing->    where fToS :: Double -> String->          fToS x = show x-> floatToString _ = Nothing--> stringToInt :: [ViewTerm] -> Maybe ViewTerm-> stringToInt [Constant x]->             = case cast x of->                 (Just s) -> Just (Constant (sToI s))->                 _ -> Nothing->     where sToI :: String -> Int->           sToI ('-':s) | all isDigit s = -(read s)->           sToI s | all isDigit s = read s->                  | otherwise = 0-> stringToInt _ = Nothing--> stringToFloat :: [ViewTerm] -> Maybe ViewTerm-> stringToFloat [Constant x]->             = case cast x of->                 (Just s) -> Just (Constant (sToF s))->                 _ -> Nothing->     where sToF :: String -> Int->           sToF ('-':s) = -(read s)->           sToF s = read s-> stringToFloat _ = Nothing--> intToChar :: [ViewTerm] -> Maybe ViewTerm-> intToChar [Constant x] = case cast x :: Maybe Int of->                            Just i -> Just (Constant (toEnum i :: Char))->                            _ -> Nothing-> intToChar _ = Nothing--> charToInt :: [ViewTerm] -> Maybe ViewTerm-> charToInt [Constant x] = case cast x :: Maybe Char of->                            Just i -> Just (Constant (fromEnum i :: Int))->                            _ -> Nothing-> charToInt _ = Nothing--> stringLen :: [ViewTerm] -> Maybe ViewTerm-> stringLen [Constant x] = case cast x :: Maybe String of->                            (Just s) -> Just (Constant (length s))->                            _ -> Nothing-> stringLen _ = Nothing--> stringHead :: [ViewTerm] -> Maybe ViewTerm-> stringHead [Constant x] = case cast x :: Maybe String of->                            (Just (s:ss)) -> Just (Constant s)->                            _ -> Nothing-> stringHead _ = Nothing--> stringTail :: [ViewTerm] -> Maybe ViewTerm-> stringTail [Constant x] = case cast x :: Maybe String of->                            (Just (s:ss)) -> Just (Constant ss)->                            _ -> Nothing-> stringTail _ = Nothing--> stringCons :: [ViewTerm] -> Maybe ViewTerm-> stringCons [Constant x, Constant y] ->             = case (cast x, cast y) of->                   (Just s, Just ss) -> Just (Constant ((s:ss) :: String))->                   _ -> Nothing-> stringCons _ = Nothing--> stringRev :: [ViewTerm] -> Maybe ViewTerm-> stringRev [Constant x] = case cast x :: Maybe String of->                            Just s -> Just (Constant (reverse s))->                            _ -> Nothing-> stringRev _ = Nothing--> stringSub :: [ViewTerm] -> Maybe ViewTerm-> stringSub [Constant x, Constant start, Constant len] ->         = case (cast x, cast start, cast len) :: ->                    (Maybe String, Maybe Int, Maybe Int) of->               (Just str, Just st, Just l) -> ->                   Just (Constant (take l (drop st str) :: String))->               _ -> Nothing-> stringSub _ = Nothing--> stringFind :: [ViewTerm] -> Maybe ViewTerm-> stringFind [Constant x, Constant y] ->             = case (cast x, cast y) :: (Maybe String, Maybe Char) of->                   (Just s, Just c) -> ->                     case findIndex (==c) s of->                       Just v -> Just (Constant v)->                       Nothing -> Just (Constant ((-1) :: Int))->                   _ -> Nothing-> stringFind _ = Nothing--> proveAnything :: [ViewTerm] -> Maybe ViewTerm-> proveAnything [_,_,x] = Just x-> proveAnything _ = Nothing--> runLazy :: [ViewTerm] -> Maybe ViewTerm-> runLazy [_,x] = Just x-> runLazy _ = Nothing--> runEffect :: [ViewTerm] -> Maybe ViewTerm-> runEffect [_,x] = Just x-> runEffect _ = Nothing
+ Setup.hs view
@@ -0,0 +1,39 @@+import Distribution.Simple+import Distribution.Simple.InstallDirs as I+import Distribution.Simple.LocalBuildInfo as L+import Distribution.PackageDescription++import System.Exit+import System.Process++-- After Idris is built, we need to check and install the prelude and other libs++system' cmd = do +    exit <- system cmd+    case exit of+      ExitSuccess -> return ()+      ExitFailure _ -> exitWith exit++postCleanLib args flags desc _+    = system' "make -C lib clean"++addPrefix pfx var c = "export " ++ var ++ "=" ++ show pfx ++ "/" ++ c ++ ":$" ++ var++postInstLib args flags desc local+    = do let pkg = localPkgDescr local+         let penv = packageTemplateEnv (package pkg)+         let cenv = compilerTemplateEnv (compilerId (compiler local))+         let dirs_pkg = substituteInstallDirTemplates penv (installDirTemplates local)+         let dirs = substituteInstallDirTemplates cenv dirs_pkg+         let datad = datadir dirs+         let datasubd = datasubdir dirs+         let bind = fromPathTemplate (bindir dirs)+         let idir = fromPathTemplate (datadir dirs) ++ "/" ++ +                    fromPathTemplate (datasubdir dirs)+         putStrLn $ "Installing libraries in " ++ idir+         system' $ "make -C lib install TARGET=" ++ idir ++ " BINDIR=" ++ bind++main = defaultMainWithHooks (simpleUserHooks { postInst = postInstLib,+                                               postClean = postCleanLib })++
− Setup.lhs 
@@ -1,38 +0,0 @@-> import Distribution.Simple-> import Distribution.Simple.InstallDirs-> import Distribution.Simple.LocalBuildInfo-> import Distribution.PackageDescription--> import System--After Idris is built, we need to check and install the .idr library files,-and the C support they need.--FIXME: This is probably all done the wrong way, I don't really understand-Cabal properly... This is all stolen from the Epic build system.--> buildLib args flags desc local ->     = do exit <- system "make -C lib"->          return ()--This is a hack. I don't know how to tell cabal that a data file needs-installing but shouldn't be in the distribution. And it won't make the-distribution if it's not there, so instead I just delete-the file after configure.--> postConfLib args flags desc local->    = do exit <- system "make -C lib clean"->         return ()--> addPrefix pfx var c = "export " ++ var ++ "=" ++ show pfx ++ "/" ++ c ++ ":$" ++ var--> postInstLib args flags desc local->     = do let pfx = prefix (installDirTemplates local)->          exit <- system $ "make -C lib install PREFIX=" ++ show pfx->          return ()--> main = defaultMainWithHooks (simpleUserHooks { postBuild = buildLib,->                                                postConf = postConfLib,->                                                postInst = postInstLib })--
− dist/build/Idris/Parser.hs 
@@ -1,3973 +0,0 @@-{-# OPTIONS_GHC -fno-warn-overlapping-patterns #-}-{-# OPTIONS -fglasgow-exts -cpp #-}--- -*-Haskell-*--{-# OPTIONS_GHC -fglasgow-exts #-}--module Idris.Parser where--import Data.Char-import Ivor.TT-import System.IO.Unsafe-import List-import Control.Monad--import Idris.AbsSyntax-import Idris.Lexer-import Idris.Lib--import Debug.Trace-import qualified Data.Array as Happy_Data_Array-import qualified GHC.Exts as Happy_GHC_Exts---- parser produced by Happy Version 1.18.5--newtype HappyAbsSyn t74 = HappyAbsSyn HappyAny-#if __GLASGOW_HASKELL__ >= 607-type HappyAny = Happy_GHC_Exts.Any-#else-type HappyAny = forall a . a-#endif-happyIn6 :: ([ParseDecl]) -> (HappyAbsSyn t74)-happyIn6 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn6 #-}-happyOut6 :: (HappyAbsSyn t74) -> ([ParseDecl])-happyOut6 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut6 #-}-happyIn7 :: (ParseDecl) -> (HappyAbsSyn t74)-happyIn7 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn7 #-}-happyOut7 :: (HappyAbsSyn t74) -> (ParseDecl)-happyOut7 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut7 #-}-happyIn8 :: (Decl) -> (HappyAbsSyn t74)-happyIn8 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn8 #-}-happyOut8 :: (HappyAbsSyn t74) -> (Decl)-happyOut8 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut8 #-}-happyIn9 :: (ParseDecl) -> (HappyAbsSyn t74)-happyIn9 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn9 #-}-happyOut9 :: (HappyAbsSyn t74) -> (ParseDecl)-happyOut9 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut9 #-}-happyIn10 :: (CGFlag) -> (HappyAbsSyn t74)-happyIn10 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn10 #-}-happyOut10 :: (HappyAbsSyn t74) -> (CGFlag)-happyOut10 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut10 #-}-happyIn11 :: (Bool) -> (HappyAbsSyn t74)-happyIn11 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn11 #-}-happyOut11 :: (HappyAbsSyn t74) -> (Bool)-happyOut11 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut11 #-}-happyIn12 :: ([RawTerm]) -> (HappyAbsSyn t74)-happyIn12 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn12 #-}-happyOut12 :: (HappyAbsSyn t74) -> ([RawTerm])-happyOut12 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut12 #-}-happyIn13 :: (RawTerm) -> (HappyAbsSyn t74)-happyIn13 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn13 #-}-happyOut13 :: (HappyAbsSyn t74) -> (RawTerm)-happyOut13 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut13 #-}-happyIn14 :: ([ParseDecl]) -> (HappyAbsSyn t74)-happyIn14 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn14 #-}-happyOut14 :: (HappyAbsSyn t74) -> ([ParseDecl])-happyOut14 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut14 #-}-happyIn15 :: ([CGFlag]) -> (HappyAbsSyn t74)-happyIn15 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn15 #-}-happyOut15 :: (HappyAbsSyn t74) -> ([CGFlag])-happyOut15 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut15 #-}-happyIn16 :: ([CGFlag]) -> (HappyAbsSyn t74)-happyIn16 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn16 #-}-happyOut16 :: (HappyAbsSyn t74) -> ([CGFlag])-happyOut16 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut16 #-}-happyIn17 :: ([CGFlag]) -> (HappyAbsSyn t74)-happyIn17 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn17 #-}-happyOut17 :: (HappyAbsSyn t74) -> ([CGFlag])-happyOut17 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut17 #-}-happyIn18 :: ([Decl]) -> (HappyAbsSyn t74)-happyIn18 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn18 #-}-happyOut18 :: (HappyAbsSyn t74) -> ([Decl])-happyOut18 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut18 #-}-happyIn19 :: ([String]) -> (HappyAbsSyn t74)-happyIn19 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn19 #-}-happyOut19 :: (HappyAbsSyn t74) -> ([String])-happyOut19 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut19 #-}-happyIn20 :: (String) -> (HappyAbsSyn t74)-happyIn20 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn20 #-}-happyOut20 :: (HappyAbsSyn t74) -> (String)-happyOut20 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut20 #-}-happyIn21 :: (Fixity) -> (HappyAbsSyn t74)-happyIn21 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn21 #-}-happyOut21 :: (HappyAbsSyn t74) -> (Fixity)-happyOut21 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut21 #-}-happyIn22 :: (Decl) -> (HappyAbsSyn t74)-happyIn22 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn22 #-}-happyOut22 :: (HappyAbsSyn t74) -> (Decl)-happyOut22 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut22 #-}-happyIn23 :: ([(Id,String)]) -> (HappyAbsSyn t74)-happyIn23 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn23 #-}-happyOut23 :: (HappyAbsSyn t74) -> ([(Id,String)])-happyOut23 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut23 #-}-happyIn24 :: ((Id, [(RawTerm, Maybe Id)])) -> (HappyAbsSyn t74)-happyIn24 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn24 #-}-happyOut24 :: (HappyAbsSyn t74) -> ((Id, [(RawTerm, Maybe Id)]))-happyOut24 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut24 #-}-happyIn25 :: ([(RawTerm,Maybe Id)]) -> (HappyAbsSyn t74)-happyIn25 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn25 #-}-happyOut25 :: (HappyAbsSyn t74) -> ([(RawTerm,Maybe Id)])-happyOut25 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut25 #-}-happyIn26 :: (Datatype) -> (HappyAbsSyn t74)-happyIn26 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn26 #-}-happyOut26 :: (HappyAbsSyn t74) -> (Datatype)-happyOut26 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut26 #-}-happyIn27 :: (Bool) -> (HappyAbsSyn t74)-happyIn27 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn27 #-}-happyOut27 :: (HappyAbsSyn t74) -> (Bool)-happyOut27 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut27 #-}-happyIn28 :: (Either RawTerm ((RawTerm, [(Id, RawTerm)]), [ConParse])) -> (HappyAbsSyn t74)-happyIn28 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn28 #-}-happyOut28 :: (HappyAbsSyn t74) -> (Either RawTerm ((RawTerm, [(Id, RawTerm)]), [ConParse]))-happyOut28 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut28 #-}-happyIn29 :: ([TyOpt]) -> (HappyAbsSyn t74)-happyIn29 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn29 #-}-happyOut29 :: (HappyAbsSyn t74) -> ([TyOpt])-happyOut29 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut29 #-}-happyIn30 :: ([TyOpt]) -> (HappyAbsSyn t74)-happyIn30 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn30 #-}-happyOut30 :: (HappyAbsSyn t74) -> ([TyOpt])-happyOut30 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut30 #-}-happyIn31 :: (TyOpt) -> (HappyAbsSyn t74)-happyIn31 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn31 #-}-happyOut31 :: (HappyAbsSyn t74) -> (TyOpt)-happyOut31 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut31 #-}-happyIn32 :: (Id) -> (HappyAbsSyn t74)-happyIn32 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn32 #-}-happyOut32 :: (HappyAbsSyn t74) -> (Id)-happyOut32 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut32 #-}-happyIn33 :: (RawTerm) -> (HappyAbsSyn t74)-happyIn33 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn33 #-}-happyOut33 :: (HappyAbsSyn t74) -> (RawTerm)-happyOut33 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut33 #-}-happyIn34 :: (RawTerm) -> (HappyAbsSyn t74)-happyIn34 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn34 #-}-happyOut34 :: (HappyAbsSyn t74) -> (RawTerm)-happyOut34 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut34 #-}-happyIn35 :: ([(Id, RawTerm)]) -> (HappyAbsSyn t74)-happyIn35 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn35 #-}-happyOut35 :: (HappyAbsSyn t74) -> ([(Id, RawTerm)])-happyOut35 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut35 #-}-happyIn36 :: ([(Id, RawTerm)]) -> (HappyAbsSyn t74)-happyIn36 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn36 #-}-happyOut36 :: (HappyAbsSyn t74) -> ([(Id, RawTerm)])-happyOut36 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut36 #-}-happyIn37 :: ([(Id, RawTerm)]) -> (HappyAbsSyn t74)-happyIn37 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn37 #-}-happyOut37 :: (HappyAbsSyn t74) -> ([(Id, RawTerm)])-happyOut37 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut37 #-}-happyIn38 :: ([Id]) -> (HappyAbsSyn t74)-happyIn38 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn38 #-}-happyOut38 :: (HappyAbsSyn t74) -> ([Id])-happyOut38 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut38 #-}-happyIn39 :: ([(Id, Int)]) -> (HappyAbsSyn t74)-happyIn39 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn39 #-}-happyOut39 :: (HappyAbsSyn t74) -> ([(Id, Int)])-happyOut39 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut39 #-}-happyIn40 :: ([Id]) -> (HappyAbsSyn t74)-happyIn40 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn40 #-}-happyOut40 :: (HappyAbsSyn t74) -> ([Id])-happyOut40 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut40 #-}-happyIn41 :: ([Id]) -> (HappyAbsSyn t74)-happyIn41 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn41 #-}-happyOut41 :: (HappyAbsSyn t74) -> ([Id])-happyOut41 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut41 #-}-happyIn42 :: ([(Id, RawTerm, RawTerm)]) -> (HappyAbsSyn t74)-happyIn42 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn42 #-}-happyOut42 :: (HappyAbsSyn t74) -> ([(Id, RawTerm, RawTerm)])-happyOut42 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut42 #-}-happyIn43 :: ((Id, RawTerm)) -> (HappyAbsSyn t74)-happyIn43 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn43 #-}-happyOut43 :: (HappyAbsSyn t74) -> ((Id, RawTerm))-happyOut43 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut43 #-}-happyIn44 :: (RawTerm) -> (HappyAbsSyn t74)-happyIn44 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn44 #-}-happyOut44 :: (HappyAbsSyn t74) -> (RawTerm)-happyOut44 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut44 #-}-happyIn45 :: (RawTerm) -> (HappyAbsSyn t74)-happyIn45 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn45 #-}-happyOut45 :: (HappyAbsSyn t74) -> (RawTerm)-happyOut45 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut45 #-}-happyIn46 :: (RawTerm) -> (HappyAbsSyn t74)-happyIn46 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn46 #-}-happyOut46 :: (HappyAbsSyn t74) -> (RawTerm)-happyOut46 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut46 #-}-happyIn47 :: (String) -> (HappyAbsSyn t74)-happyIn47 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn47 #-}-happyOut47 :: (HappyAbsSyn t74) -> (String)-happyOut47 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut47 #-}-happyIn48 :: (RawTerm) -> (HappyAbsSyn t74)-happyIn48 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn48 #-}-happyOut48 :: (HappyAbsSyn t74) -> (RawTerm)-happyOut48 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut48 #-}-happyIn49 :: (RawTerm) -> (HappyAbsSyn t74)-happyIn49 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn49 #-}-happyOut49 :: (HappyAbsSyn t74) -> (RawTerm)-happyOut49 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut49 #-}-happyIn50 :: (RawTerm) -> (HappyAbsSyn t74)-happyIn50 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn50 #-}-happyOut50 :: (HappyAbsSyn t74) -> (RawTerm)-happyOut50 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut50 #-}-happyIn51 :: (RawTerm) -> (HappyAbsSyn t74)-happyIn51 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn51 #-}-happyOut51 :: (HappyAbsSyn t74) -> (RawTerm)-happyOut51 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut51 #-}-happyIn52 :: (ArgOpt) -> (HappyAbsSyn t74)-happyIn52 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn52 #-}-happyOut52 :: (HappyAbsSyn t74) -> (ArgOpt)-happyOut52 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut52 #-}-happyIn53 :: ([ArgOpt]) -> (HappyAbsSyn t74)-happyIn53 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn53 #-}-happyOut53 :: (HappyAbsSyn t74) -> ([ArgOpt])-happyOut53 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut53 #-}-happyIn54 :: ([ArgOpt]) -> (HappyAbsSyn t74)-happyIn54 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn54 #-}-happyOut54 :: (HappyAbsSyn t74) -> ([ArgOpt])-happyOut54 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut54 #-}-happyIn55 :: (RawTerm) -> (HappyAbsSyn t74)-happyIn55 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn55 #-}-happyOut55 :: (HappyAbsSyn t74) -> (RawTerm)-happyOut55 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut55 #-}-happyIn56 :: ([RawTerm]) -> (HappyAbsSyn t74)-happyIn56 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn56 #-}-happyOut56 :: (HappyAbsSyn t74) -> ([RawTerm])-happyOut56 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut56 #-}-happyIn57 :: (RawTerm) -> (HappyAbsSyn t74)-happyIn57 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn57 #-}-happyOut57 :: (HappyAbsSyn t74) -> (RawTerm)-happyOut57 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut57 #-}-happyIn58 :: (RawTerm) -> (HappyAbsSyn t74)-happyIn58 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn58 #-}-happyOut58 :: (HappyAbsSyn t74) -> (RawTerm)-happyOut58 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut58 #-}-happyIn59 :: ([RawTerm]) -> (HappyAbsSyn t74)-happyIn59 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn59 #-}-happyOut59 :: (HappyAbsSyn t74) -> ([RawTerm])-happyOut59 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut59 #-}-happyIn60 :: ([RawTerm]) -> (HappyAbsSyn t74)-happyIn60 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn60 #-}-happyOut60 :: (HappyAbsSyn t74) -> ([RawTerm])-happyOut60 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut60 #-}-happyIn61 :: ([Do]) -> (HappyAbsSyn t74)-happyIn61 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn61 #-}-happyOut61 :: (HappyAbsSyn t74) -> ([Do])-happyOut61 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut61 #-}-happyIn62 :: ([Do]) -> (HappyAbsSyn t74)-happyIn62 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn62 #-}-happyOut62 :: (HappyAbsSyn t74) -> ([Do])-happyOut62 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut62 #-}-happyIn63 :: (Do) -> (HappyAbsSyn t74)-happyIn63 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn63 #-}-happyOut63 :: (HappyAbsSyn t74) -> (Do)-happyOut63 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut63 #-}-happyIn64 :: (Constant) -> (HappyAbsSyn t74)-happyIn64 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn64 #-}-happyOut64 :: (HappyAbsSyn t74) -> (Constant)-happyOut64 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut64 #-}-happyIn65 :: ([RawTerm]) -> (HappyAbsSyn t74)-happyIn65 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn65 #-}-happyOut65 :: (HappyAbsSyn t74) -> ([RawTerm])-happyOut65 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut65 #-}-happyIn66 :: ((RawTerm, [(Id, RawTerm)])) -> (HappyAbsSyn t74)-happyIn66 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn66 #-}-happyOut66 :: (HappyAbsSyn t74) -> ((RawTerm, [(Id, RawTerm)]))-happyOut66 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut66 #-}-happyIn67 :: ([(Id, RawTerm)]) -> (HappyAbsSyn t74)-happyIn67 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn67 #-}-happyOut67 :: (HappyAbsSyn t74) -> ([(Id, RawTerm)])-happyOut67 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut67 #-}-happyIn68 :: ((Id,Id)) -> (HappyAbsSyn t74)-happyIn68 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn68 #-}-happyOut68 :: (HappyAbsSyn t74) -> ((Id,Id))-happyOut68 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut68 #-}-happyIn69 :: ((Id,Id)) -> (HappyAbsSyn t74)-happyIn69 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn69 #-}-happyOut69 :: (HappyAbsSyn t74) -> ((Id,Id))-happyOut69 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut69 #-}-happyIn70 :: ([(Id, RawTerm)]) -> (HappyAbsSyn t74)-happyIn70 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn70 #-}-happyOut70 :: (HappyAbsSyn t74) -> ([(Id, RawTerm)])-happyOut70 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut70 #-}-happyIn71 :: (Id) -> (HappyAbsSyn t74)-happyIn71 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn71 #-}-happyOut71 :: (HappyAbsSyn t74) -> (Id)-happyOut71 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut71 #-}-happyIn72 :: ([(Id, RawTerm)]) -> (HappyAbsSyn t74)-happyIn72 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn72 #-}-happyOut72 :: (HappyAbsSyn t74) -> ([(Id, RawTerm)])-happyOut72 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut72 #-}-happyIn73 :: ([Id]) -> (HappyAbsSyn t74)-happyIn73 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn73 #-}-happyOut73 :: (HappyAbsSyn t74) -> ([Id])-happyOut73 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut73 #-}-happyIn74 :: t74 -> (HappyAbsSyn t74)-happyIn74 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn74 #-}-happyOut74 :: (HappyAbsSyn t74) -> t74-happyOut74 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut74 #-}-happyIn75 :: ([ConParse]) -> (HappyAbsSyn t74)-happyIn75 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn75 #-}-happyOut75 :: (HappyAbsSyn t74) -> ([ConParse])-happyOut75 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut75 #-}-happyIn76 :: (ConParse) -> (HappyAbsSyn t74)-happyIn76 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn76 #-}-happyOut76 :: (HappyAbsSyn t74) -> (ConParse)-happyOut76 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut76 #-}-happyIn77 :: (RawTerm) -> (HappyAbsSyn t74)-happyIn77 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn77 #-}-happyOut77 :: (HappyAbsSyn t74) -> (RawTerm)-happyOut77 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut77 #-}-happyIn78 :: (ITactic) -> (HappyAbsSyn t74)-happyIn78 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn78 #-}-happyOut78 :: (HappyAbsSyn t74) -> (ITactic)-happyOut78 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut78 #-}-happyIn79 :: ([ITactic]) -> (HappyAbsSyn t74)-happyIn79 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn79 #-}-happyOut79 :: (HappyAbsSyn t74) -> ([ITactic])-happyOut79 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut79 #-}-happyIn80 :: ([ITactic]) -> (HappyAbsSyn t74)-happyIn80 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn80 #-}-happyOut80 :: (HappyAbsSyn t74) -> ([ITactic])-happyOut80 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut80 #-}-happyIn81 :: ([ITactic]) -> (HappyAbsSyn t74)-happyIn81 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn81 #-}-happyOut81 :: (HappyAbsSyn t74) -> ([ITactic])-happyOut81 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut81 #-}-happyIn82 :: (LineNumber) -> (HappyAbsSyn t74)-happyIn82 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn82 #-}-happyOut82 :: (HappyAbsSyn t74) -> (LineNumber)-happyOut82 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut82 #-}-happyIn83 :: (String) -> (HappyAbsSyn t74)-happyIn83 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn83 #-}-happyOut83 :: (HappyAbsSyn t74) -> (String)-happyOut83 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut83 #-}-happyIn84 :: (Fixities) -> (HappyAbsSyn t74)-happyIn84 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn84 #-}-happyOut84 :: (HappyAbsSyn t74) -> (Fixities)-happyOut84 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut84 #-}-happyInTok :: (Token) -> (HappyAbsSyn t74)-happyInTok x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyInTok #-}-happyOutTok :: (HappyAbsSyn t74) -> (Token)-happyOutTok x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOutTok #-}---happyActOffsets :: HappyAddr-happyActOffsets = HappyA# "\x1d\x00\x5e\x05\x18\x02\x00\x00\x49\x04\x5e\x05\x37\x01\x37\x01\x5e\x05\x00\x00\x48\x03\xef\x02\x00\x00\x37\x01\x00\x00\x5e\x05\x5e\x05\x00\x00\x00\x00\x5e\x05\x5e\x05\x5e\x05\x5e\x05\x00\x00\x00\x00\x00\x00\x00\x00\xa9\x01\x00\x00\x00\x00\x00\x00\x00\x00\xa8\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x37\x01\x91\x09\x3d\x02\xc3\x01\x5e\x05\x5e\x05\xae\x08\x5e\x05\x00\x00\x37\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5e\x05\x00\x00\x00\x00\x00\x00\xfc\x00\x00\x00\x5e\x05\x02\x01\x48\x04\x01\x00\x00\x00\x00\x00\x01\x00\xbc\x04\x00\x00\xa2\x04\x00\x00\x87\x04\xe2\x01\xab\x04\xa6\x04\xa5\x04\xa4\x04\x97\x04\x08\x0a\x75\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x89\x04\x88\x04\x84\x04\x02\x01\x02\x01\x02\x01\x8e\x04\x54\x04\x7f\x04\x8f\x04\x5e\x05\x8b\x04\x8a\x04\x00\x00\x00\x00\xbd\x02\x00\x00\x02\x01\x72\x04\x75\x04\x00\x00\x02\x01\x00\x00\x02\x01\x02\x01\x02\x01\x70\x04\x00\x00\x00\x00\x00\x00\x00\x00\x69\x00\x00\x00\x02\x00\x00\x00\x00\x00\x96\x02\x00\x00\x00\x00\x00\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x00\x00\x69\x08\x74\x04\x50\x01\x91\x09\x68\x04\x02\x01\xdc\x01\x5f\x00\x08\x0a\x75\x01\x00\x00\x00\x00\x6f\x04\x16\x04\x0e\x03\x00\x00\x6d\x04\x05\x05\x00\x00\x00\x00\x6c\x04\x00\x00\x6c\x04\x00\x00\x7a\x04\x6f\x03\x00\x00\x18\x02\x18\x02\xb8\x01\x1a\x04\xac\x04\x65\x04\xac\x04\xac\x04\x63\x04\x61\x04\xac\x04\xac\x04\x26\x0a\x62\x04\x59\x04\x1e\x00\x00\x00\x47\x04\xac\x04\x56\x09\x02\x01\x5e\x04\x37\x04\x00\x00\xae\x08\x51\x04\x00\x00\xac\x04\x45\x04\xac\x04\xac\x04\xac\x04\xac\x04\xac\x04\x00\x00\xa6\x01\x91\x01\x7c\x01\x67\x01\x52\x01\x3d\x01\x00\x00\x28\x01\xac\x04\x13\x01\xac\x04\xfe\x00\x00\x00\x3a\x04\x00\x00\xe9\x00\x02\x01\xc7\x00\x65\x00\x00\x00\x5a\x04\x5a\x04\x5a\x04\x5a\x04\x5a\x04\x00\x00\xac\x04\x5a\x04\xae\x08\x00\x00\x00\x00\x00\x00\xac\x04\x2f\x04\xcc\x09\x46\x04\x3e\x04\x28\x04\xa5\x01\x39\x04\x8b\x00\x36\x04\x53\x09\x02\x01\xcc\x09\xcc\x09\xcc\x09\x00\x00\x32\x04\xcc\x09\x31\x04\x00\x00\xd8\x05\x00\x00\xd8\x05\x00\x00\xd8\x05\x00\x00\xd8\x05\x00\x00\xac\x04\x00\x00\xac\x04\xac\x04\xac\x04\xac\x04\xac\x04\x2b\x04\x38\x04\x2d\x04\x24\x04\xac\x04\x00\x00\x00\x00\xac\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0b\x00\xd8\x05\x23\x04\x53\x04\x02\x01\xf6\x03\x00\x00\xfa\x03\xfa\x03\x08\x04\x1b\x04\x04\x04\x19\x04\xfa\x03\xfa\x03\xfa\x03\xc6\x03\x0c\x04\xfd\x03\x00\x00\x00\x00\xd3\x05\x18\x02\x15\x04\x69\x08\xfa\x03\x00\x00\x00\x00\x0b\x04\x06\x04\x05\x04\x03\x04\x01\x04\x00\x00\x00\x00\x18\x04\x02\x04\x00\x00\x00\x00\xfa\x03\xfa\x03\xfa\x03\x00\x00\x07\x04\xfe\x03\xe6\x03\xfc\x03\x02\x01\xeb\x03\x00\x00\x01\x00\x02\x01\xf4\x03\xe5\x03\x00\x00\xfa\x03\x7e\x05\xfb\x03\x00\x04\x00\x00\xd6\x03\x00\x00\xec\x03\xfa\x03\x00\x00\x00\x00\x02\x01\x00\x00\x91\x09\x25\x05\xcc\x04\x7c\x05\x00\x00\x00\x00\x00\x00\x00\x00\xfa\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x23\x05\x00\x00\xe1\x03\xd5\x03\x00\x00\x02\x01\x02\x01\xd1\x03\x91\x09\x00\x00\x00\x00\xdc\x01\x00\x00\x00\x00\xca\x04\x9c\x04\x91\x03\x00\x00\x75\x01\x00\x00\xfa\x03\xaa\x00\xb4\x02\xfa\x03\xda\x03\x00\x00\x00\x00\x00\x00\xb8\x03\x1a\x09\x00\x00\xf3\x08\x16\x03\x00\x00\xc8\x03\xd2\x03\x00\x00\x00\x00\x18\x02\xcc\x09\x00\x00\x67\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xcf\x03\x00\x00\xcd\x03\x00\x00\xae\x08\x00\x00\x1e\x00\xa3\x03\xa2\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xcc\x09\xcc\x09\xbb\x03\x91\x09\x02\x01\x95\x03\x91\x09\x1e\x00\x02\x01\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbf\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf3\x08\xf3\x08\xf3\x08\xf3\x08\xf3\x08\xf3\x08\x00\x00\x00\x00\x00\x00\x00\x00\xcc\x09\x00\x00\xd4\x00\x8c\x03\xd0\x01\x0a\x00\x00\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x91\x09\x00\x00\x00\x00\x24\x08\x00\x00\xdf\x07\x00\x00\x9a\x07\x00\x00\x55\x07\xbd\x03\xb7\x03\xb6\x03\xb4\x03\xb3\x03\x55\x00\x00\x00\x00\x00\xfa\x03\x00\x00\x00\x00\xfa\x03\x10\x07\xa0\x03\xd8\x05\xfa\x03\xde\x01\x00\x00\x46\x00\xa9\x03\xa7\x03\x00\x00\x00\x00\x00\x00\xf8\xff\x00\x00\xcb\x06\xab\x03\xa6\x03\x00\x00\x00\x00\x00\x00\x00\x00\xd9\x01\x00\x00\x86\x06\x00\x00\x46\x00\x00\x00\x99\x03\x86\x03\x9a\x03\x38\x03\x00\x00\x02\x01\x76\x03\x00\x00\x00\x00\x02\x01\x8d\x03\x00\x00\x00\x00\x02\x01\x02\x01\x46\x00\x7d\x03\x00\x00\x00\x00\x00\x00\x83\x03\xd9\x01\x8b\x03\x00\x00\x00\x00\x00\x00\x7b\x03\x00\x00\x00\x00\x02\x01\x00\x00\xae\x08\x00\x00\x00\x00\x91\x09\x00\x00\x3e\x03\x00\x00\x00\x00\x00\x00\x02\x01\x00\x00\x74\x03\x02\x01\x82\x03\x00\x00\xfa\x03\x00\x00\xd8\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5d\x03\x61\x03\x00\x00\x00\x00\xcc\x09\x49\x03\x49\x03\x00\x00\xd0\x01\x62\x03\x00\x00\x00\x00\x00\x00\xde\x01\x41\x06\x00\x00\x00\x00\x00\x00\x00\x00\x60\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5f\x03\x00\x00\x00\x00\x00\x00\x00\x00\xbd\x00\x5e\x03\x00\x00\x00\x00\x00\x00\x00\x00\xa1\x03\x00\x00\xfc\x05\x00\x00\x00\x00\x00\x00\x00\x00\xb7\x05\x5b\x03\x00\x00\x00\x00\x00\x00\x3c\x03\x02\x01\x00\x00\x02\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"#--happyGotoOffsets :: HappyAddr-happyGotoOffsets = HappyA# "\xf6\x0a\x55\x10\x24\x03\x00\x00\x00\x00\x3f\x10\x96\x01\x51\x03\x29\x10\x00\x00\x13\x10\xfd\x0f\x00\x00\x47\x03\x00\x00\xe7\x0f\xd1\x0f\x00\x00\x00\x00\xbb\x0f\xa5\x0f\x8f\x0f\x79\x0f\x00\x00\x00\x00\x00\x00\x1a\x03\x39\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x17\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\xb7\x0c\x77\x0b\x10\x03\x63\x0f\x4d\x0f\x9e\x10\x37\x0f\x00\x00\x3f\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x21\x0f\x00\x00\x07\x03\x06\x03\x00\x00\x05\x03\x0b\x0f\x59\x01\x00\x00\xdb\x0a\x00\x00\x00\x00\xd4\x0a\x00\x00\x00\x00\x44\x03\x00\x00\x2e\x03\x8d\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb9\x00\x31\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1d\x03\x1c\x03\x14\x03\x00\x00\x00\x00\x00\x00\x00\x00\xf5\x0e\x00\x00\x00\x00\x00\x00\x00\x00\x39\x01\xe7\x02\x08\x01\x00\x00\x00\x00\xe5\x02\x68\x01\x00\x00\x41\x01\x13\x03\x74\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x27\x03\xdd\x02\x29\x01\x00\x00\xd2\x02\x7f\x0b\x00\x00\xd1\x02\xd0\x02\xbe\x0a\x88\x0a\x72\x0a\x6b\x0a\x50\x0a\x00\x00\xf9\x06\x00\x00\x00\x00\x8b\x0c\x00\x00\x02\x03\xea\x01\x15\x03\x94\x00\xe0\x01\x00\x00\x00\x00\xec\x02\x00\x00\x24\x01\xc9\x02\xdf\x02\xc7\x0b\xc7\x02\xbf\x02\x21\x01\xc0\x02\x14\x01\x00\x00\x0f\x01\x0f\x01\xbc\x02\xc9\x01\xc5\x01\x2a\x00\xdf\xff\xdf\x0e\x00\x00\xc9\x0e\xb3\x0e\x00\x00\x00\x00\x4f\x0b\x4a\x0b\x0c\x01\xdb\x02\x00\x00\x00\x00\x00\x00\x00\x00\x9d\x0e\xa7\x02\xb4\x01\xda\x02\x00\x00\xb6\x02\x8d\x10\x00\x00\xb5\x02\x87\x0e\xb3\x02\x71\x0e\x5b\x0e\x45\x0e\x2f\x0e\x19\x0e\xae\x02\x0a\x01\x0a\x01\x0a\x01\x0a\x01\x0a\x01\x0a\x01\x00\x00\x0a\x01\x03\x0e\x0a\x01\xed\x0d\x0a\x01\x00\x00\x00\x00\x00\x00\x0a\x01\x81\x01\x0a\x01\x0a\x01\x00\x00\x04\x01\xff\x00\xef\x00\xe5\x00\xd6\x00\xad\x02\xd7\x0d\xd2\x00\x80\x10\xa4\x02\x9d\x02\x00\x00\xc1\x0d\x00\x00\x26\x07\x00\x00\x00\x00\x00\x00\x06\x00\x00\x00\x00\x00\x00\x00\xcd\x00\x33\x01\x9c\x06\x57\x06\x99\x05\x00\x00\x00\x00\x69\x04\x00\x00\x9a\x02\xcb\x00\x97\x02\xc2\x00\x92\x02\xbb\x00\x90\x02\xb0\x00\x8f\x02\x2b\x0b\x00\x00\x26\x0b\xab\x0d\x95\x0d\x88\x09\x07\x0b\x00\x00\x00\x00\x00\x00\x00\x00\x09\x0c\x00\x00\x88\x02\x7f\x0d\x87\x02\x86\x02\x7b\x02\x00\x00\x00\x00\xfc\xff\x99\x00\x00\x00\xb1\x0b\x3e\x01\x00\x00\x00\x00\x69\x0d\x53\x0d\x00\x00\x00\x00\x00\x00\xbe\x02\x3d\x0d\x27\x0d\x11\x0d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0e\x00\xc1\x01\x00\x00\xb4\x06\xfb\x0c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x77\x02\x71\x02\x79\x00\x00\x00\x70\x02\x68\x02\xe5\x0c\xcf\x0c\xb9\x0c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5e\x01\x00\x00\x64\x02\xd6\x09\x95\x02\x00\x00\x00\x00\x61\x02\xa3\x0c\x79\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x8d\x0c\x00\x00\x00\x00\x91\x02\x00\x00\x5f\x0c\x79\x00\x79\x00\x79\x00\x00\x00\x00\x00\x5c\x02\x00\x00\xf3\x0b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x79\x00\x5a\x02\x99\x02\x00\x00\x54\x02\x4f\x00\xef\xff\x00\x00\x33\x0c\x53\x02\x17\x02\xa4\x01\x00\x00\x00\x00\x79\x00\x79\x00\x79\x00\x00\x00\x35\x01\x00\x00\x77\x0c\x79\x00\x79\x00\x61\x0c\x02\x02\x00\x00\x00\x00\x47\x02\x00\x00\x78\x10\x00\x00\x78\x10\x79\x00\x46\x02\x79\x00\x00\x00\x00\x00\x00\x00\xbe\x01\x44\x04\x45\x02\x79\x00\x00\x00\x41\x02\x22\x02\x21\x02\x20\x02\x1e\x02\x1c\x02\x1b\x02\x00\x00\x1a\x02\x00\x00\x12\x02\x6b\x10\x10\x02\x00\x00\x00\x00\x00\x00\x0f\x02\x0e\x02\x00\x00\x00\x00\x0c\x02\x00\x00\xb2\x03\xc2\x01\x07\x02\x07\x0c\x4e\x01\x00\x00\xdb\x0b\x00\x00\x2e\x00\x79\x00\x0a\x02\x08\x02\x00\x00\xfe\x01\x79\x00\x00\x00\xfd\x01\xfc\x01\xfb\x01\xf0\x01\xec\x01\x00\x00\x5a\x10\x5a\x10\x5a\x10\x5a\x10\x5a\x10\x5a\x10\x00\x00\x00\x00\x00\x00\x00\x00\xe1\x02\x00\x00\x00\x00\x00\x00\xaa\x01\x00\x00\x00\x00\xdb\x01\xeb\x01\xdf\x01\xd1\x01\xf0\x09\xc6\x01\x00\x00\x50\x10\x00\x00\x50\x10\x00\x00\x50\x10\x00\x00\x50\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xdd\x0b\x00\x00\x95\x01\x4b\x0c\x50\x10\x00\x00\x78\x00\x35\x0c\x6b\x00\x00\x00\xa0\x02\xe7\x01\x00\x00\x00\x00\xb3\x01\xab\x01\x9e\x01\x8c\x01\xf6\x01\x00\x00\x00\x00\x00\x00\x89\x01\x00\x00\x6a\x01\x23\x01\x85\x01\x2a\x06\x7e\x01\x4f\x02\x00\x00\x00\x00\x00\x00\x00\x00\x6b\x00\x00\x00\x93\x01\x00\x00\x00\x00\x00\x00\x75\x00\x00\x00\x00\x00\x00\x00\x71\x00\x73\x01\xfe\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x12\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x56\x01\x00\x00\xed\xff\x00\x00\x97\x08\x00\x00\x00\x00\x02\x09\x4a\x01\x00\x00\x00\x00\x00\x00\x00\x00\x6e\x01\xc0\x00\x00\x00\xd5\x00\x5c\x00\x9c\x00\x1f\x0c\x00\x00\x47\x00\x95\x00\x00\x00\x77\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x83\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc4\x01\x00\x00\x00\x00\x00\x00\xc8\x00\x00\x00\x7f\x00\x00\x00\x4a\x00\x21\x00\xdc\x08\x38\x00\x00\x00\x20\x00\xee\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6b\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\x03\x00\x00\x00\xd0\xff\xdc\x08\x9b\x0b\xcb\xff\xdc\x08\x00\x00\x00\x00\x00\x00\x00\x00\xdc\x08\x00\x00\x00\x00\xc6\xff\x00\x00\x00\x00\x1d\x01\x00\x00\xf5\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"#--happyDefActions :: HappyAddr-happyDefActions = HappyA# "\x21\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0e\xff\x00\x00\x00\x00\x0a\xff\x00\x00\x00\x00\x05\xff\x00\x00\x03\xff\x00\x00\x00\x00\x00\xff\xff\xfe\x00\x00\x00\x00\x00\x00\x00\x00\xfa\xfe\xf9\xfe\xf8\xfe\xf0\xfe\xf0\xfe\x9b\xff\x80\xff\x45\xff\x46\xff\xa2\xff\x44\xff\x49\xff\xf0\xfe\xab\xff\x29\xff\x2b\xff\x27\xff\x2a\xff\x28\xff\x52\xff\x00\x00\x00\x00\x00\x00\xf0\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x4a\xff\x00\x00\x31\xff\x30\xff\x2f\xff\x32\xff\x2d\xff\x2e\xff\x2c\xff\x34\xff\x33\xff\x00\x00\x4d\xff\xf0\xfe\xf0\xfe\x00\x00\xf0\xfe\x00\x00\x00\x00\x00\x00\x21\xff\xef\xff\xf8\xff\x21\xff\x00\x00\xf6\xff\xda\xff\xf7\xff\xb1\xff\xbb\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb6\xff\xb5\xff\xc0\xff\xc2\xff\xc1\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\xeb\xff\xec\xff\xf0\xfe\xf0\xfe\x00\x00\x00\x00\x00\x00\xf0\xfe\x8c\xff\x1c\xff\x00\x00\x00\x00\x00\x00\x00\x00\xc6\xff\xc5\xff\xc4\xff\xc3\xff\x00\x00\xf0\xfe\xf0\xfe\xd8\xff\xf0\xfe\x00\x00\xa5\xff\xf0\xfe\xf0\xfe\x21\xff\x21\xff\x21\xff\x21\xff\x21\xff\xbc\xff\xbb\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xfa\xff\xfb\xff\x70\xff\x00\x00\xf0\xfe\xf1\xfe\x70\xff\x00\x00\xf1\xfe\xf1\xfe\xf0\xfe\xf0\xfe\xf0\xfe\x53\xff\xf0\xfe\xf0\xfe\xf1\xfe\x00\x00\x00\x00\xf0\xfe\xf0\xfe\x00\x00\x00\x00\xc6\xff\xc5\xff\x72\xff\x71\xff\xf0\xfe\xf0\xfe\xf0\xfe\x6e\xff\x00\x00\x6b\xff\x60\xff\x8e\xff\x00\x00\x00\x00\x00\x00\x70\xff\x00\x00\xf1\xfe\x00\x00\x00\x00\xf1\xfe\x00\x00\xf0\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf1\xfe\xf0\xfe\xf0\xfe\xf0\xfe\xf0\xfe\xf0\xfe\xf0\xfe\x04\xff\xf0\xfe\x00\x00\xf0\xfe\x00\x00\xf0\xfe\x0d\xff\x94\xff\x0f\xff\xf0\xfe\x00\x00\xf0\xfe\xf0\xfe\x56\xff\xf0\xfe\xf0\xfe\xf0\xfe\xf0\xfe\xf0\xfe\xf1\xfe\x00\x00\xf0\xfe\x00\x00\xf0\xfe\xf0\xfe\x4e\xff\x00\x00\x99\xff\x00\x00\x00\x00\x00\x00\x96\xff\xf0\xfe\x00\x00\x00\x00\x00\x00\xf0\xfe\x00\x00\x00\x00\x00\x00\x00\x00\xa1\xff\x00\x00\x00\x00\x00\x00\xf1\xfe\xf0\xfe\xf1\xfe\xf0\xfe\xf1\xfe\xf0\xfe\xf0\xfe\xf0\xfe\xf0\xfe\xf0\xfe\x54\xff\xf0\xfe\x72\xff\x71\xff\xf0\xfe\xf0\xfe\x00\x00\xf5\xfe\x00\x00\x00\x00\x3e\xff\x48\xff\xf0\xfe\x00\x00\xf1\xfe\xf1\xfe\xf1\xfe\x4c\xff\x4b\xff\xf0\xfe\xf0\xfe\x00\x00\x38\xff\x00\x00\x00\x00\x55\xff\x00\x00\x00\x00\x00\x00\x00\x00\xc8\xff\xda\xff\x00\x00\x00\x00\x00\x00\xdd\xff\x00\x00\xaf\xff\xad\xff\xac\xff\x00\x00\x00\x00\x00\x00\xbb\xff\x00\x00\xe8\xff\xba\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf1\xfe\xf1\xfe\xf0\xfe\x00\x00\xf1\xfe\xf1\xfe\x00\x00\x00\x00\x00\x00\xaa\xff\x00\x00\x00\x00\x00\x00\x00\x00\x8c\xff\x00\x00\xf1\xfe\x21\xff\x00\x00\x00\x00\x00\x00\xf1\xfe\x00\x00\xf0\xfe\x00\x00\x00\x00\xbf\xff\x00\x00\xf9\xff\x00\x00\x00\x00\x8b\xff\x1d\xff\x00\x00\x20\xff\x00\x00\xf0\xfe\xf0\xfe\xf0\xfe\xa7\xff\xa6\xff\xf0\xfe\xd7\xff\x00\x00\xa4\xff\xa3\xff\xf0\xff\xf1\xff\xf2\xff\xf3\xff\xf4\xff\xf0\xfe\xf0\xfe\xd2\xff\x00\x00\xf0\xfe\x19\xff\x15\xff\x00\x00\x00\x00\xf0\xfe\xf0\xfe\x00\x00\xb0\xff\xdc\xff\xf0\xfe\xf0\xfe\xf0\xfe\xdb\xff\x00\x00\xc9\xff\x00\x00\xf0\xfe\xf0\xfe\x00\x00\x70\xff\x39\xff\x3b\xff\xf1\xfe\x00\x00\x9e\xff\x4f\xff\x86\xff\xf0\xfe\xf1\xfe\xf0\xfe\x00\x00\x51\xff\x50\xff\xf6\xfe\x00\x00\xf1\xfe\xf0\xfe\x3f\xff\xf1\xfe\xf1\xfe\xf1\xfe\xf1\xfe\xf1\xfe\xf1\xfe\xf1\xfe\x00\x00\xf1\xfe\x00\x00\xf1\xfe\x00\x00\xf0\xfe\x6d\xff\x00\x00\x6a\xff\xf0\xfe\xf0\xfe\x8d\xff\x64\xff\xf0\xfe\x67\xff\x00\x00\x00\x00\x5c\xff\x00\x00\x00\x00\x00\x00\x00\x00\x6f\xff\x00\x00\xf0\xfe\xf1\xfe\xf1\xfe\xa0\xff\xf1\xfe\xf0\xfe\x88\xff\xf1\xfe\xf1\xfe\xf1\xfe\xf1\xfe\xf1\xfe\x93\xff\x81\xff\x84\xff\x82\xff\x83\xff\x85\xff\x7e\xff\x9f\xff\x7f\xff\x98\xff\x95\xff\x00\x00\x97\xff\x6f\xff\x00\x00\x00\x00\x58\xff\x57\xff\xf0\xfe\xf1\xfe\xf1\xfe\xf1\xfe\x00\x00\xf1\xfe\xa9\xff\x00\x00\x76\xff\x00\x00\x75\xff\x00\x00\x47\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf4\xfe\x43\xff\x3e\xff\x41\xff\xf0\xfe\x00\x00\x00\x00\x00\x00\xf0\xfe\x00\x00\xf0\xfe\xc7\xff\x00\x00\xd2\xff\x00\x00\xae\xff\xf1\xfe\xf1\xfe\x21\xff\xf0\xfe\x26\xff\x00\x00\x14\xff\x18\xff\xf1\xfe\xf7\xfe\xf0\xfe\xd1\xff\xf1\xfe\xbb\xff\xf1\xfe\x00\x00\xe4\xff\x00\x00\x1b\xff\x00\x00\xf0\xfe\xed\xff\x00\x00\xbe\xff\xf5\xff\xea\xff\x00\x00\x00\x00\xee\xff\x1e\xff\x00\x00\x00\x00\xd4\xff\x00\x00\xd6\xff\xb8\xff\xb9\xff\x00\x00\xd1\xff\x00\x00\xcb\xff\xcf\xff\xce\xff\xcc\xff\xf1\xfe\xb7\xff\x15\xff\xb4\xff\x26\xff\x11\xff\x12\xff\x00\x00\xf1\xfe\x00\x00\xb3\xff\xb2\xff\x23\xff\x00\x00\xf0\xfe\x00\x00\x00\x00\xf0\xfe\xf1\xfe\x00\x00\x35\xff\xf0\xfe\xf1\xfe\x3c\xff\xf0\xfe\x78\xff\x74\xff\x79\xff\x7c\xff\x7a\xff\x7b\xff\x7d\xff\x73\xff\x77\xff\xa8\xff\x6c\xff\x62\xff\x63\xff\x61\xff\xf1\xfe\x5a\xff\x00\x00\x5f\xff\x5e\xff\x00\x00\x68\xff\x69\xff\x5d\xff\x00\x00\x00\x00\xf1\xfe\x42\xff\xf1\xfe\xf0\xfe\x00\x00\xf1\xfe\x89\xff\xf0\xfe\xf1\xfe\x00\x00\x24\xff\x22\xff\x10\xff\x25\xff\x13\xff\xe9\xff\x00\x00\xca\xff\xd0\xff\xd3\xff\xe2\xff\xd5\xff\x00\x00\x1a\xff\x1f\xff\xbd\xff\xe3\xff\x91\xff\x00\x00\xf0\xfe\xe5\xff\xf1\xfe\x9a\xff\x00\x00\xf1\xfe\x00\x00\x59\xff\x66\xff\x5b\xff\x37\xff\x00\x00\x00\x00\xe7\xff\xf1\xfe\xcd\xff\x92\xff\x00\x00\x90\xff\x00\x00\xe6\xff\x3a\xff\x36\xff\x8f\xff"#--happyCheck :: HappyAddr-happyCheck = HappyA# "\xff\xff\x03\x00\x01\x00\x0b\x00\x25\x00\x03\x00\x08\x00\x1a\x00\x29\x00\x1a\x00\x02\x00\x03\x00\x02\x00\x0c\x00\x0c\x00\x1a\x00\x12\x00\x10\x00\x4c\x00\x0b\x00\x13\x00\x0a\x00\x21\x00\x4c\x00\x1a\x00\x11\x00\x12\x00\x13\x00\x4c\x00\x15\x00\x01\x00\x17\x00\x02\x00\x19\x00\x20\x00\x21\x00\x16\x00\x1d\x00\x2a\x00\x1d\x00\x1a\x00\x0c\x00\x22\x00\x23\x00\x4d\x00\x10\x00\x26\x00\x27\x00\x2a\x00\x27\x00\x45\x00\x46\x00\x45\x00\x46\x00\x2e\x00\x2f\x00\x2e\x00\x41\x00\x4c\x00\x1d\x00\x31\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x25\x00\x01\x00\x1a\x00\x4d\x00\x3c\x00\x1d\x00\x2e\x00\x4b\x00\x4d\x00\x4e\x00\x4d\x00\x43\x00\x0c\x00\x4d\x00\x2a\x00\x54\x00\x10\x00\x02\x00\x57\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x5a\x00\x5b\x00\x01\x00\x5d\x00\x11\x00\x02\x00\x03\x00\x1a\x00\x4d\x00\x4e\x00\x25\x00\x4d\x00\x4d\x00\x0c\x00\x0b\x00\x54\x00\x1d\x00\x10\x00\x57\x00\x74\x00\x13\x00\x4d\x00\x13\x00\x78\x00\x15\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x20\x00\x21\x00\x25\x00\x1d\x00\x2e\x00\x4c\x00\x7d\x00\x11\x00\x22\x00\x23\x00\x20\x00\x21\x00\x1a\x00\x27\x00\x02\x00\x1a\x00\x1a\x00\x25\x00\x74\x00\x43\x00\x2e\x00\x4d\x00\x78\x00\x4c\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x07\x00\x11\x00\x25\x00\x25\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x1d\x00\x4d\x00\x4b\x00\x20\x00\x02\x00\x03\x00\x1a\x00\x1b\x00\x4d\x00\x4e\x00\x27\x00\x42\x00\x4b\x00\x0b\x00\x42\x00\x54\x00\x4d\x00\x2e\x00\x57\x00\x11\x00\x12\x00\x13\x00\x25\x00\x15\x00\x07\x00\x17\x00\x05\x00\x19\x00\x4d\x00\x4d\x00\x4d\x00\x1d\x00\x34\x00\x02\x00\x03\x00\x4c\x00\x22\x00\x23\x00\x3a\x00\x4c\x00\x26\x00\x27\x00\x0b\x00\x1a\x00\x1b\x00\x25\x00\x02\x00\x74\x00\x2e\x00\x2f\x00\x13\x00\x78\x00\x15\x00\x7a\x00\x7b\x00\x7c\x00\x25\x00\x4c\x00\x7d\x00\x26\x00\x1d\x00\x11\x00\x4d\x00\x25\x00\x4c\x00\x22\x00\x23\x00\x02\x00\x03\x00\x34\x00\x27\x00\x1a\x00\x25\x00\x1d\x00\x25\x00\x3a\x00\x0b\x00\x2e\x00\x2e\x00\x25\x00\x30\x00\x24\x00\x26\x00\x25\x00\x13\x00\x4d\x00\x15\x00\x03\x00\x02\x00\x03\x00\x2e\x00\x01\x00\x5a\x00\x5b\x00\x1d\x00\x5d\x00\x4d\x00\x0b\x00\x25\x00\x22\x00\x23\x00\x4d\x00\x12\x00\x4d\x00\x27\x00\x13\x00\x10\x00\x15\x00\x25\x00\x02\x00\x03\x00\x2e\x00\x4d\x00\x11\x00\x4d\x00\x1d\x00\x0a\x00\x0b\x00\x0b\x00\x4d\x00\x22\x00\x23\x00\x1a\x00\x4d\x00\x25\x00\x27\x00\x13\x00\x7d\x00\x15\x00\x25\x00\x02\x00\x03\x00\x2e\x00\x0a\x00\x0b\x00\x25\x00\x1d\x00\x25\x00\x4d\x00\x0b\x00\x25\x00\x22\x00\x23\x00\x1a\x00\x01\x00\x25\x00\x27\x00\x13\x00\x4d\x00\x15\x00\x21\x00\x02\x00\x03\x00\x2e\x00\x0d\x00\x0e\x00\x7d\x00\x1d\x00\x25\x00\x10\x00\x0b\x00\x25\x00\x22\x00\x23\x00\x4d\x00\x1a\x00\x25\x00\x27\x00\x13\x00\x4d\x00\x15\x00\x20\x00\x02\x00\x03\x00\x2e\x00\x4d\x00\x1a\x00\x4d\x00\x1d\x00\x1a\x00\x4d\x00\x0b\x00\x25\x00\x22\x00\x23\x00\x4d\x00\x24\x00\x13\x00\x27\x00\x13\x00\x7d\x00\x15\x00\x1a\x00\x02\x00\x03\x00\x2e\x00\x1e\x00\x1f\x00\x4d\x00\x1d\x00\x20\x00\x4d\x00\x0b\x00\x1a\x00\x22\x00\x23\x00\x4d\x00\x02\x00\x1a\x00\x27\x00\x13\x00\x7d\x00\x15\x00\x24\x00\x02\x00\x03\x00\x2e\x00\x23\x00\x1a\x00\x42\x00\x1d\x00\x1a\x00\x4d\x00\x0b\x00\x1a\x00\x22\x00\x23\x00\x23\x00\x21\x00\x1a\x00\x27\x00\x13\x00\x7d\x00\x15\x00\x1d\x00\x02\x00\x03\x00\x2e\x00\x4c\x00\x22\x00\x23\x00\x1d\x00\x1a\x00\x1a\x00\x0b\x00\x1d\x00\x22\x00\x23\x00\x13\x00\x20\x00\x4c\x00\x27\x00\x13\x00\x7d\x00\x15\x00\x1a\x00\x02\x00\x03\x00\x2e\x00\x02\x00\x03\x00\x1a\x00\x1d\x00\x0a\x00\x1a\x00\x0b\x00\x0d\x00\x22\x00\x23\x00\x28\x00\x20\x00\x4d\x00\x27\x00\x13\x00\x7d\x00\x15\x00\x18\x00\x19\x00\x31\x00\x2e\x00\x33\x00\x34\x00\x0a\x00\x1d\x00\x37\x00\x0d\x00\x1d\x00\x3a\x00\x22\x00\x23\x00\x4c\x00\x22\x00\x23\x00\x27\x00\x1a\x00\x7d\x00\x27\x00\x4c\x00\x1e\x00\x1f\x00\x2e\x00\x4c\x00\x49\x00\x2e\x00\x2e\x00\x4d\x00\x30\x00\x3d\x00\x1a\x00\x1b\x00\x1a\x00\x1b\x00\x02\x00\x03\x00\x4d\x00\x01\x00\x7d\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0d\x00\x0e\x00\x2d\x00\x09\x00\x2d\x00\x10\x00\x31\x00\x32\x00\x31\x00\x14\x00\x4c\x00\x16\x00\x7d\x00\x18\x00\x1d\x00\x3a\x00\x1b\x00\x3a\x00\x4c\x00\x22\x00\x23\x00\x18\x00\x19\x00\x26\x00\x27\x00\x48\x00\x25\x00\x4a\x00\x48\x00\x28\x00\x4a\x00\x2e\x00\x48\x00\x7d\x00\x4a\x00\x1a\x00\x48\x00\x4c\x00\x4a\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x4c\x00\x28\x00\x4f\x00\x50\x00\x5e\x00\x5f\x00\x7d\x00\x48\x00\x49\x00\x7d\x00\x31\x00\x4d\x00\x33\x00\x34\x00\x4c\x00\x2a\x00\x37\x00\x55\x00\x56\x00\x3a\x00\x3b\x00\x1a\x00\x51\x00\x52\x00\x53\x00\x2f\x00\x4c\x00\x4c\x00\x57\x00\x58\x00\x5d\x00\x4c\x00\x47\x00\x01\x00\x02\x00\x5e\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x4c\x00\x4c\x00\x4c\x00\x4c\x00\x0e\x00\x0f\x00\x10\x00\x75\x00\x76\x00\x77\x00\x14\x00\x03\x00\x16\x00\x4c\x00\x18\x00\x4c\x00\x08\x00\x1b\x00\x4d\x00\x1d\x00\x4d\x00\x4d\x00\x4d\x00\x4c\x00\x22\x00\x23\x00\x12\x00\x25\x00\x26\x00\x4d\x00\x28\x00\x4c\x00\x4c\x00\x4c\x00\x1a\x00\x4c\x00\x2e\x00\x4c\x00\x4c\x00\x4c\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\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\x4f\x00\x4c\x00\x51\x00\x52\x00\x53\x00\x4c\x00\x4c\x00\x4c\x00\x57\x00\x58\x00\x59\x00\x01\x00\x02\x00\x5c\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x4d\x00\x4d\x00\x09\x00\x03\x00\x0e\x00\x0f\x00\x10\x00\x4d\x00\x08\x00\x4d\x00\x14\x00\x1a\x00\x16\x00\x4c\x00\x18\x00\x1a\x00\x4c\x00\x1b\x00\x12\x00\x1d\x00\x4c\x00\x0e\x00\x02\x00\x03\x00\x22\x00\x23\x00\x1a\x00\x25\x00\x4c\x00\x4c\x00\x28\x00\x02\x00\x03\x00\x1a\x00\x1b\x00\x4c\x00\x06\x00\x1e\x00\x1f\x00\x4c\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x1d\x00\x4c\x00\x4c\x00\x2d\x00\x4d\x00\x22\x00\x23\x00\x31\x00\x32\x00\x1d\x00\x27\x00\x4d\x00\x4d\x00\x4c\x00\x22\x00\x23\x00\x3a\x00\x2e\x00\x4c\x00\x27\x00\x4f\x00\x4c\x00\x51\x00\x52\x00\x53\x00\x4d\x00\x2e\x00\x2f\x00\x57\x00\x58\x00\x59\x00\x01\x00\x4d\x00\x5c\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x4c\x00\x4c\x00\x1a\x00\x1b\x00\x0e\x00\x0f\x00\x10\x00\x4d\x00\x4c\x00\x4c\x00\x14\x00\x2a\x00\x16\x00\x2b\x00\x18\x00\x4c\x00\x2a\x00\x1b\x00\x4c\x00\x1d\x00\x4d\x00\x2d\x00\x5b\x00\x02\x00\x03\x00\x31\x00\x4c\x00\x25\x00\x4c\x00\x2a\x00\x28\x00\x02\x00\x03\x00\x05\x00\x3a\x00\x1a\x00\x4d\x00\x4d\x00\x4d\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x4d\x00\x1d\x00\x05\x00\x1a\x00\x1a\x00\x19\x00\x22\x00\x23\x00\x4d\x00\x1d\x00\x4d\x00\x27\x00\x1a\x00\x1a\x00\x22\x00\x23\x00\x02\x00\x03\x00\x2e\x00\x27\x00\x4f\x00\x0e\x00\x51\x00\x52\x00\x53\x00\x0b\x00\x2e\x00\x17\x00\x57\x00\x58\x00\x59\x00\x01\x00\x06\x00\x5c\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x4d\x00\x4d\x00\x4d\x00\x1d\x00\x0e\x00\x0f\x00\x10\x00\x1a\x00\x22\x00\x23\x00\x14\x00\x4d\x00\x16\x00\x27\x00\x18\x00\x1a\x00\x26\x00\x1b\x00\x4d\x00\x1d\x00\x2e\x00\x4d\x00\x5a\x00\x02\x00\x03\x00\x1a\x00\x48\x00\x25\x00\x13\x00\x11\x00\x28\x00\x02\x00\x03\x00\x11\x00\x15\x00\x15\x00\x15\x00\x2e\x00\x11\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x26\x00\x1d\x00\x03\x00\x17\x00\x13\x00\x4a\x00\x22\x00\x23\x00\x10\x00\x1d\x00\x26\x00\x27\x00\x04\x00\x13\x00\x22\x00\x23\x00\x02\x00\x03\x00\x2e\x00\x27\x00\x4f\x00\x15\x00\x51\x00\x52\x00\x53\x00\x26\x00\x2e\x00\x11\x00\x57\x00\x58\x00\x59\x00\x01\x00\x12\x00\x5c\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x11\x00\x26\x00\x14\x00\x1d\x00\x0e\x00\x0f\x00\x10\x00\x0c\x00\x22\x00\x23\x00\x14\x00\x0b\x00\x16\x00\x27\x00\x18\x00\x2e\x00\x14\x00\x1b\x00\x14\x00\x1d\x00\x2e\x00\x20\x00\x02\x00\x03\x00\x2e\x00\x11\x00\x11\x00\x25\x00\x11\x00\x11\x00\x28\x00\x02\x00\x03\x00\x1a\x00\x1b\x00\x11\x00\x14\x00\x2e\x00\x2e\x00\x13\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x1d\x00\x15\x00\x11\x00\x2d\x00\x11\x00\x22\x00\x23\x00\x31\x00\x0a\x00\x1d\x00\x27\x00\x15\x00\x13\x00\x31\x00\x22\x00\x23\x00\x3a\x00\x2e\x00\x26\x00\x27\x00\x4f\x00\x20\x00\x51\x00\x52\x00\x53\x00\x14\x00\x2e\x00\x0b\x00\x57\x00\x58\x00\x59\x00\x01\x00\x26\x00\x5c\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x04\x00\x20\x00\x0b\x00\x13\x00\x0e\x00\x0f\x00\x10\x00\x20\x00\x26\x00\x11\x00\x14\x00\x11\x00\x16\x00\x0a\x00\x18\x00\x11\x00\x13\x00\x1b\x00\x13\x00\x1d\x00\x13\x00\x13\x00\x02\x00\x03\x00\x02\x00\x03\x00\x13\x00\x25\x00\x0b\x00\x15\x00\x28\x00\x26\x00\x5e\x00\x0c\x00\x0b\x00\x31\x00\x20\x00\x11\x00\x26\x00\x11\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x1d\x00\x13\x00\x1d\x00\x0d\x00\x15\x00\x22\x00\x23\x00\x22\x00\x23\x00\x26\x00\x27\x00\x26\x00\x27\x00\x15\x00\x0b\x00\x13\x00\x13\x00\x2e\x00\x11\x00\x2e\x00\x4f\x00\x11\x00\x51\x00\x52\x00\x53\x00\x26\x00\x11\x00\x0a\x00\x57\x00\x58\x00\x59\x00\x01\x00\x26\x00\x5c\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x03\x00\x1a\x00\x1b\x00\x26\x00\x0e\x00\x0f\x00\x10\x00\x13\x00\x20\x00\x2f\x00\x14\x00\x0a\x00\x16\x00\x11\x00\x18\x00\x0a\x00\x26\x00\x1b\x00\x03\x00\x1d\x00\x2d\x00\x11\x00\x5d\x00\x11\x00\x31\x00\x11\x00\x0a\x00\x25\x00\x0a\x00\x12\x00\x28\x00\x02\x00\x03\x00\x3a\x00\x0b\x00\x0b\x00\x11\x00\x10\x00\x1a\x00\x1b\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x04\x00\x04\x00\x01\x00\x12\x00\x04\x00\x19\x00\x10\x00\x41\x00\x2d\x00\x1d\x00\x10\x00\x10\x00\x31\x00\x14\x00\x22\x00\x23\x00\x02\x00\x03\x00\x26\x00\x27\x00\x4f\x00\x3a\x00\x51\x00\x52\x00\x53\x00\x0b\x00\x2e\x00\x12\x00\x57\x00\x58\x00\x59\x00\x01\x00\x0c\x00\x5c\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x12\x00\x12\x00\x12\x00\x1d\x00\x0e\x00\x0f\x00\x10\x00\x12\x00\x22\x00\x23\x00\x14\x00\x05\x00\x16\x00\x27\x00\x18\x00\x7d\x00\x7d\x00\x1b\x00\x20\x00\x1d\x00\x2e\x00\xff\xff\x02\x00\x03\x00\x02\x00\x03\x00\xff\xff\x25\x00\xff\xff\xff\xff\x28\x00\x0b\x00\xff\xff\x0b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x1d\x00\xff\xff\x1d\x00\xff\xff\xff\xff\x22\x00\x23\x00\x22\x00\x23\x00\xff\xff\x27\x00\xff\xff\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\xff\xff\x2e\x00\x4f\x00\xff\xff\x51\x00\x52\x00\x53\x00\xff\xff\xff\xff\xff\xff\x57\x00\x58\x00\x59\x00\x01\x00\xff\xff\x5c\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x00\x0f\x00\x10\x00\xff\xff\xff\xff\xff\xff\x14\x00\xff\xff\x16\x00\xff\xff\x18\x00\xff\xff\xff\xff\x1b\x00\xff\xff\x1d\x00\xff\xff\xff\xff\x02\x00\x03\x00\x02\x00\x03\x00\xff\xff\x25\x00\xff\xff\xff\xff\x28\x00\xff\xff\xff\xff\x0b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x13\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x1d\x00\xff\xff\x1d\x00\xff\xff\xff\xff\x22\x00\x23\x00\x22\x00\x23\x00\xff\xff\x27\x00\xff\xff\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\xff\xff\x2e\x00\x4f\x00\xff\xff\x51\x00\x52\x00\x53\x00\xff\xff\xff\xff\xff\xff\x57\x00\x58\x00\x59\x00\x01\x00\xff\xff\x5c\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x00\x0f\x00\x10\x00\xff\xff\xff\xff\xff\xff\x14\x00\xff\xff\x16\x00\xff\xff\x18\x00\xff\xff\xff\xff\x1b\x00\xff\xff\x1d\x00\xff\xff\xff\xff\x02\x00\x03\x00\x02\x00\x03\x00\xff\xff\x25\x00\xff\xff\xff\xff\x28\x00\xff\xff\xff\xff\x0b\x00\xff\xff\xff\xff\xff\xff\xff\xff\x12\x00\xff\xff\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x1d\x00\xff\xff\x1d\x00\xff\xff\xff\xff\x22\x00\x23\x00\x22\x00\x23\x00\xff\xff\x27\x00\xff\xff\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\xff\xff\x2e\x00\x4f\x00\xff\xff\x51\x00\x52\x00\x53\x00\xff\xff\x1a\x00\x1b\x00\x57\x00\x58\x00\x59\x00\x01\x00\xff\xff\x5c\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\xff\xff\x0b\x00\xff\xff\xff\xff\xff\xff\x2d\x00\x10\x00\xff\xff\xff\xff\x31\x00\x14\x00\xff\xff\x16\x00\xff\xff\x18\x00\xff\xff\xff\xff\x1b\x00\x3a\x00\x01\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x02\x00\x03\x00\x25\x00\x0a\x00\x0b\x00\x28\x00\xff\xff\xff\xff\xff\xff\x10\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\xff\xff\x20\x00\xff\xff\x1d\x00\xff\xff\xff\xff\xff\xff\xff\xff\x22\x00\x23\x00\xff\xff\x01\x00\xff\xff\x27\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x2e\x00\x0b\x00\x51\x00\x52\x00\x53\x00\xff\xff\x10\x00\xff\xff\x57\x00\x58\x00\x14\x00\xff\xff\x16\x00\xff\xff\x18\x00\xff\xff\xff\xff\x1b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x00\xff\xff\xff\xff\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x13\x00\xff\xff\xff\xff\xff\xff\xff\xff\x01\x00\xff\xff\x1a\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\xff\xff\x0b\x00\x51\x00\x52\x00\x53\x00\xff\xff\x10\x00\x28\x00\x57\x00\x58\x00\x14\x00\xff\xff\x16\x00\xff\xff\x18\x00\xff\xff\x31\x00\x1b\x00\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x25\x00\xff\xff\xff\xff\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x1b\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x00\xff\xff\xff\xff\x01\x00\x31\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\xff\xff\x3a\x00\x51\x00\x52\x00\x53\x00\xff\xff\x10\x00\xff\xff\x57\x00\x58\x00\x14\x00\xff\xff\x16\x00\xff\xff\x18\x00\xff\xff\xff\xff\x1b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x00\xff\xff\xff\xff\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x1b\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x13\x00\xff\xff\x2d\x00\xff\xff\xff\xff\x01\x00\x31\x00\x1a\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x3a\x00\x51\x00\x52\x00\x53\x00\xff\xff\x10\x00\x28\x00\x57\x00\x58\x00\x14\x00\xff\xff\x16\x00\xff\xff\x18\x00\xff\xff\x31\x00\x1b\x00\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x25\x00\xff\xff\xff\xff\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x13\x00\xff\xff\xff\xff\xff\xff\xff\xff\x01\x00\xff\xff\x1a\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\xff\xff\x0b\x00\x51\x00\x52\x00\x53\x00\xff\xff\x10\x00\x28\x00\x57\x00\x58\x00\x14\x00\xff\xff\x16\x00\xff\xff\x18\x00\xff\xff\x31\x00\x1b\x00\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x25\x00\xff\xff\xff\xff\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x1b\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x00\xff\xff\xff\xff\x01\x00\x31\x00\xff\xff\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\xff\xff\x3a\x00\x51\x00\x52\x00\x53\x00\xff\xff\x10\x00\x11\x00\x57\x00\x58\x00\x14\x00\xff\xff\x16\x00\xff\xff\x18\x00\xff\xff\xff\xff\x1b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x00\xff\xff\xff\xff\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\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\xff\xff\xff\xff\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\xff\xff\xff\xff\x51\x00\x52\x00\x53\x00\xff\xff\x10\x00\x11\x00\x57\x00\x58\x00\x14\x00\xff\xff\x16\x00\xff\xff\x18\x00\xff\xff\xff\xff\x1b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x00\xff\xff\xff\xff\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\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\xff\xff\xff\xff\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\xff\xff\xff\xff\x51\x00\x52\x00\x53\x00\xff\xff\x10\x00\x11\x00\x57\x00\x58\x00\x14\x00\xff\xff\x16\x00\xff\xff\x18\x00\xff\xff\xff\xff\x1b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x00\xff\xff\xff\xff\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\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\xff\xff\xff\xff\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\xff\xff\xff\xff\x51\x00\x52\x00\x53\x00\xff\xff\x10\x00\x11\x00\x57\x00\x58\x00\x14\x00\xff\xff\x16\x00\xff\xff\x18\x00\xff\xff\xff\xff\x1b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x00\xff\xff\xff\xff\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\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\xff\xff\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\xff\xff\xff\xff\x51\x00\x52\x00\x53\x00\xff\xff\x10\x00\xff\xff\x57\x00\x58\x00\x14\x00\xff\xff\x16\x00\xff\xff\x18\x00\xff\xff\xff\xff\x1b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x00\xff\xff\xff\xff\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\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\xff\xff\x1a\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\xff\xff\xff\xff\x51\x00\x52\x00\x53\x00\xff\xff\x10\x00\x28\x00\x57\x00\x58\x00\x14\x00\xff\xff\x16\x00\xff\xff\x18\x00\xff\xff\x31\x00\x1b\x00\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\xff\xff\xff\xff\x3a\x00\x3b\x00\x25\x00\xff\xff\xff\xff\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\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\xff\xff\x1a\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\xff\xff\xff\xff\x51\x00\x52\x00\x53\x00\xff\xff\x10\x00\x28\x00\x57\x00\x58\x00\x14\x00\xff\xff\x16\x00\xff\xff\x18\x00\xff\xff\x31\x00\x1b\x00\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x25\x00\xff\xff\xff\xff\x01\x00\x1a\x00\x1b\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x22\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x2c\x00\x2d\x00\x16\x00\xff\xff\x18\x00\x31\x00\xff\xff\x1b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3a\x00\xff\xff\xff\xff\x25\x00\xff\xff\xff\xff\xff\xff\xff\xff\x51\x00\x52\x00\x53\x00\xff\xff\xff\xff\xff\xff\x57\x00\x58\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x02\x00\x03\x00\x01\x00\x02\x00\xff\xff\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\x0f\x00\x10\x00\xff\xff\xff\xff\xff\xff\xff\xff\x51\x00\x52\x00\x53\x00\xff\xff\xff\xff\x1d\x00\x57\x00\x58\x00\x1d\x00\xff\xff\x22\x00\x23\x00\xff\xff\x22\x00\x23\x00\x27\x00\x25\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x01\x00\xff\xff\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0f\x00\x10\x00\x1a\x00\xff\xff\x1c\x00\xff\xff\xff\xff\xff\xff\x52\x00\x53\x00\xff\xff\xff\xff\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x00\xff\xff\xff\xff\x31\x00\xff\xff\x33\x00\x34\x00\x35\x00\xff\xff\x37\x00\xff\xff\xff\xff\x3a\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x01\x00\xff\xff\xff\xff\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x4d\x00\x00\x00\x01\x00\x02\x00\x03\x00\xff\xff\x0f\x00\x10\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0c\x00\x52\x00\x53\x00\x0f\x00\x10\x00\xff\xff\x12\x00\xff\xff\x14\x00\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x25\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\xff\xff\x01\x00\x1a\x00\x1b\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\xff\xff\x22\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x10\x00\xff\xff\xff\xff\xff\xff\x2c\x00\x2d\x00\x52\x00\x53\x00\x18\x00\x31\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x02\x00\x03\x00\x3a\x00\xff\xff\xff\xff\x25\x00\xff\xff\xff\xff\xff\xff\x0b\x00\x0c\x00\x0d\x00\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\x13\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x1d\x00\xff\xff\xff\xff\x20\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x26\x00\x27\x00\xff\xff\xff\xff\x00\x00\x01\x00\x02\x00\x03\x00\x2e\x00\x2f\x00\xff\xff\x31\x00\xff\xff\xff\xff\x52\x00\x53\x00\x0c\x00\xff\xff\xff\xff\x0f\x00\x10\x00\xff\xff\x12\x00\xff\xff\x14\x00\x15\x00\xff\xff\x41\x00\xff\xff\xff\xff\x1a\x00\x00\x00\x01\x00\x02\x00\x03\x00\xff\xff\x4a\x00\xff\xff\x00\x00\x01\x00\x02\x00\x03\x00\xff\xff\x0c\x00\xff\xff\xff\xff\x0f\x00\x10\x00\xff\xff\x12\x00\x0c\x00\x14\x00\x15\x00\x0f\x00\x10\x00\xff\xff\x12\x00\x1a\x00\x14\x00\x15\x00\x00\x00\x01\x00\x02\x00\x03\x00\x1a\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\xff\xff\xff\xff\x0c\x00\xff\xff\xff\xff\x0f\x00\x10\x00\xff\xff\x12\x00\xff\xff\x14\x00\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\xff\xff\xff\xff\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x0c\x00\xff\xff\xff\xff\x0f\x00\x10\x00\xff\xff\x12\x00\xff\xff\x14\x00\x15\x00\x00\x00\x01\x00\x02\x00\x03\x00\x1a\x00\xff\xff\xff\xff\x00\x00\x01\x00\x02\x00\x03\x00\xff\xff\x0c\x00\xff\xff\xff\xff\x0f\x00\x10\x00\xff\xff\x12\x00\x0c\x00\x14\x00\x15\x00\x0f\x00\x10\x00\xff\xff\x12\x00\x1a\x00\x14\x00\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x00\x00\x01\x00\x02\x00\x03\x00\xff\xff\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\xff\xff\xff\xff\x0c\x00\xff\xff\xff\xff\x0f\x00\x10\x00\xff\xff\x12\x00\xff\xff\x14\x00\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\xff\xff\xff\xff\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\xff\xff\x1c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x31\x00\xff\xff\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\xff\xff\x1a\x00\x3a\x00\x1c\x00\xff\xff\xff\xff\x1a\x00\xff\xff\x1c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\x4d\x00\xff\xff\xff\xff\x31\x00\xff\xff\x33\x00\x34\x00\xff\xff\x31\x00\x37\x00\x33\x00\x34\x00\x3a\x00\xff\xff\x37\x00\xff\xff\x1a\x00\x3a\x00\x1c\x00\xff\xff\xff\xff\x1a\x00\xff\xff\x1c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\x4d\x00\xff\xff\x26\x00\x27\x00\x28\x00\x4d\x00\xff\xff\xff\xff\x31\x00\xff\xff\x33\x00\x34\x00\xff\xff\x31\x00\x37\x00\x33\x00\x34\x00\x3a\x00\x0e\x00\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\xff\xff\xff\xff\x0e\x00\xff\xff\xff\xff\xff\xff\x1a\x00\xff\xff\x1c\x00\xff\xff\xff\xff\xff\xff\x4d\x00\xff\xff\x1a\x00\xff\xff\x1c\x00\x4d\x00\x26\x00\x27\x00\x28\x00\x29\x00\xff\xff\xff\xff\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\x31\x00\xff\xff\x33\x00\x34\x00\x35\x00\xff\xff\x37\x00\xff\xff\x31\x00\x3a\x00\x33\x00\x34\x00\x35\x00\x1a\x00\x37\x00\x1c\x00\xff\xff\x3a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\x38\x00\x39\x00\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\x38\x00\x39\x00\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x1b\x00\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\x22\x00\x37\x00\x38\x00\x39\x00\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\x2c\x00\x2d\x00\xff\xff\xff\xff\xff\xff\x31\x00\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\x36\x00\x37\x00\x3a\x00\xff\xff\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x1b\x00\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\x35\x00\x22\x00\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\x2c\x00\x2d\x00\xff\xff\xff\xff\xff\xff\x31\x00\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\x36\x00\x37\x00\x3a\x00\xff\xff\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x1b\x00\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\x22\x00\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\x2c\x00\x2d\x00\xff\xff\xff\xff\xff\xff\x31\x00\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\x3a\x00\xff\xff\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x1b\x00\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\x22\x00\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\x2c\x00\x2d\x00\xff\xff\xff\xff\xff\xff\x31\x00\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\x3a\x00\xff\xff\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x1b\x00\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\x22\x00\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\x2c\x00\x2d\x00\xff\xff\xff\xff\xff\xff\x31\x00\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\x3a\x00\xff\xff\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x1b\x00\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\x22\x00\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\x2c\x00\x2d\x00\xff\xff\xff\xff\xff\xff\x31\x00\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\x3a\x00\xff\xff\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\x1a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\x1a\x00\xff\xff\x37\x00\xff\xff\x28\x00\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\x31\x00\x28\x00\x33\x00\x34\x00\x1a\x00\x31\x00\x37\x00\x33\x00\x34\x00\x3a\x00\x31\x00\x37\x00\x33\x00\x34\x00\x3a\x00\xff\xff\x37\x00\x1a\x00\x28\x00\x3a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\xff\xff\x31\x00\xff\xff\x33\x00\x34\x00\x28\x00\xff\xff\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x1a\x00\x28\x00\x31\x00\xff\xff\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\xff\xff\x31\x00\x3a\x00\x33\x00\x34\x00\x28\x00\xff\xff\x37\x00\x1a\x00\xff\xff\x3a\x00\xff\xff\xff\xff\xff\xff\x31\x00\xff\xff\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\xff\xff\x28\x00\x3a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x31\x00\xff\xff\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"#--happyTable :: HappyAddr-happyTable = HappyA# "\x00\x00\x19\x02\x25\x00\x30\x02\xbf\x00\xc3\x00\x6c\x02\xfd\x01\x04\x01\xfd\x01\xc2\x00\xc3\x00\xf6\x00\x57\x00\xd9\xff\x72\x02\x4d\x00\x58\x00\x88\x02\x9d\xff\xfc\xff\xec\x00\x8b\x02\x7f\x02\x50\x00\x9d\xff\x9d\xff\x9d\xff\x81\x02\x9d\xff\x25\x00\x9d\xff\xf6\x00\x9d\xff\xd9\xff\xd9\xff\x71\x01\xc4\x00\x89\x01\xf7\x00\x72\x01\x57\x00\xc5\x00\xc6\x00\xc0\x00\x58\x00\x9d\xff\xc7\x00\x0c\x01\xb0\x01\x65\x02\xff\x01\xfe\x01\xff\x01\xc8\x00\x9d\xff\xf8\x00\x5e\x00\x75\x02\xf7\x00\x70\xff\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\xbf\x00\x25\x00\xbb\x00\xc8\x00\x73\x01\xcc\x01\xf8\x00\xd9\xff\x62\x00\x63\x00\x82\x02\x74\x01\x57\x00\x3f\x01\x0c\x01\x64\x00\x58\x00\xf6\x00\x65\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x9d\xff\x9d\xff\x25\x00\x9d\xff\x3e\x02\xc2\x00\xc3\x00\x72\x01\x62\x00\x63\x00\xbf\x00\x76\x02\x79\x02\x57\x00\x06\xff\x64\x00\xf7\x00\x58\x00\x65\x00\x66\x00\xfc\xff\xc8\x00\x06\xff\x67\x00\x06\xff\x68\x00\x69\x00\x6a\x00\xfc\xff\x28\x01\x29\x01\xbf\x00\xc4\x00\xf8\x00\x77\x02\x9d\xff\x70\x02\xc5\x00\xc6\x00\x42\x01\x43\x01\x44\x01\xc7\x00\xf6\x00\x44\x01\x4e\x01\xbf\x00\x66\x00\x00\x02\xc8\x00\x59\x02\x67\x00\x7a\x02\x68\x00\x69\x00\x6a\x00\xfc\xff\x25\x01\xae\x01\xbf\x00\xbf\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\xf7\x00\x5c\x02\x2a\x01\xaf\x01\xc2\x00\xc3\x00\x7d\x00\x7e\x00\x62\x00\x63\x00\xb0\x01\x6e\x02\x2a\x01\x9c\xff\x45\x01\x64\x00\xc0\x00\xf8\x00\x65\x00\x9c\xff\x9c\xff\x9c\xff\xbf\x00\x9c\xff\x7c\x00\x9c\xff\x85\x02\x9c\xff\x57\x02\x37\x02\xc0\x00\xc4\x00\x7f\x00\xc2\x00\xc3\x00\x7b\x02\xc5\x00\xc6\x00\x80\x00\x56\x02\x9c\xff\xc7\x00\x08\xff\x7d\x00\x7e\x00\xbf\x00\xf6\x00\x66\x00\xc8\x00\x9c\xff\x08\xff\x67\x00\x08\xff\x68\x00\x69\x00\x6a\x00\xbf\x00\x58\x02\x06\xff\x86\x02\xc4\x00\x6b\xff\x88\x01\xbf\x00\x5b\x02\xc5\x00\xc6\x00\xc2\x00\xc3\x00\x7f\x00\xc7\x00\x97\x00\xbf\x00\xf7\x00\xbf\x00\x80\x00\x0c\xff\xc8\x00\x4d\x02\xbf\x00\x7d\x02\x5d\x02\x6b\xff\xbf\x00\x0c\xff\x9c\x01\x0c\xff\x9c\x00\xc2\x00\xc3\x00\xf8\x00\x25\x00\x9c\xff\x9c\xff\xc4\x00\x9c\xff\x9e\x01\x0b\xff\xbf\x00\xc5\x00\xc6\x00\x5f\x02\x9d\x00\xa0\x01\xc7\x00\x0b\xff\x58\x00\x0b\xff\xbf\x00\xc2\x00\xc3\x00\xc8\x00\xa2\x01\x4d\x01\xc0\x00\xc4\x00\x69\x02\x1f\x02\x09\xff\xbb\x01\xc5\x00\xc6\x00\x4e\x01\xbe\x01\xbf\x00\xc7\x00\x09\xff\x9c\xff\x09\xff\xbf\x00\xc2\x00\xc3\x00\xc8\x00\x1e\x02\x1f\x02\xbf\x00\xc4\x00\xfb\x00\xbf\x01\x07\xff\xbf\x00\xc5\x00\xc6\x00\x72\x02\x25\x00\xbf\x00\xc7\x00\x07\xff\xc0\x01\x07\xff\x86\x02\xc2\x00\xc3\x00\xc8\x00\xf4\x01\x24\x01\x08\xff\xc4\x00\xbf\x00\x58\x00\x02\xff\xbf\x00\xc5\x00\xc6\x00\xc1\x01\xd6\x00\xfb\x00\xc7\x00\x02\xff\xc2\x01\x02\xff\xaa\x01\xc2\x00\xc3\x00\xc8\x00\xc0\x00\x85\x01\xfc\x00\xc4\x00\x44\x01\xc0\x00\x01\xff\xbf\x00\xc5\x00\xc6\x00\x14\x01\x98\x00\x32\x01\xc7\x00\x01\xff\x0c\xff\x01\xff\xec\x00\xc2\x00\xc3\x00\xc8\x00\xcf\x01\xee\x00\x16\x01\xc4\x00\x33\x01\xc0\x00\xfe\xfe\x97\x00\xc5\x00\xc6\x00\xfc\x00\x79\x00\x48\x01\xc7\x00\xfe\xfe\x0b\xff\xfe\xfe\x98\x00\xc2\x00\xc3\x00\xc8\x00\x59\x01\x48\x01\x47\x01\xc4\x00\x72\x02\xc0\x00\xfd\xfe\x60\x02\xc5\x00\xc6\x00\x49\x01\x73\x02\x6d\x02\xc7\x00\xfd\xfe\x09\xff\xfd\xfe\x7a\x00\xc2\x00\xc3\x00\xc8\x00\x62\x02\x7b\x00\x7c\x00\xc4\x00\xbb\x00\xd6\x00\xfc\xfe\xbc\x00\xc5\x00\xc6\x00\x8a\x00\xc3\x01\x66\x02\xc7\x00\xfc\xfe\x07\xff\xfc\xfe\x1a\x00\xc2\x00\xc3\x00\xc8\x00\xc2\x00\xc3\x00\x14\x02\xc4\x00\xb2\x01\xd6\x00\xfb\xfe\x70\xff\xc5\x00\xc6\x00\x1e\x00\xd7\x00\x25\x02\xc7\x00\xfb\xfe\x02\xff\xfb\xfe\xf8\x01\x2b\x01\x1f\x00\xc8\x00\x8b\x00\x21\x00\xec\x00\xc4\x00\x22\x00\x70\xff\xc4\x00\x23\x00\xc5\x00\xc6\x00\x1b\x02\xc5\x00\xc6\x00\xc7\x00\xec\x00\x01\xff\xc7\x00\x1d\x02\xed\x00\xee\x00\xc8\x00\x26\x02\x8c\x00\xc8\x00\x4d\x02\x2d\x02\x4e\x02\x2e\x02\x7d\x00\xb2\x00\x7d\x00\xb2\x00\xc2\x00\xc3\x00\x3b\x02\x25\x00\xfe\xfe\x8e\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x8f\x00\x23\x01\x24\x01\xd3\x01\x33\x02\x53\x02\x2e\x00\xb6\x00\xd4\x01\xb6\x00\x2f\x00\x30\x02\x30\x00\xfd\xfe\x31\x00\xc4\x00\x80\x00\x32\x00\x80\x00\x31\x02\xc5\x00\xc6\x00\x2a\x01\x2b\x01\x36\x02\xc7\x00\x0d\x01\x34\x00\xe9\x01\x0d\x01\x35\x00\x70\x01\xc8\x00\x0d\x01\xfc\xfe\x0e\x01\x1a\x00\x0d\x01\x47\x02\x0f\x01\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x49\x02\x1e\x00\x50\x02\x51\x02\xa7\x00\xa8\x00\xfb\xfe\x2d\x01\x2e\x01\xff\xff\x1f\x00\x4c\x02\x29\x02\x21\x00\x4a\x02\xf0\x01\x22\x00\x21\x02\x22\x02\x23\x00\x2a\x02\x06\x00\x40\x00\x41\x00\x42\x00\xd1\x01\x4b\x02\xc4\x01\x43\x00\x44\x00\x8a\xff\xc5\x01\x2b\x02\x25\x00\xad\x00\x90\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\xc6\x01\xc7\x01\xc8\x01\xc9\x01\x2c\x00\x2d\x00\x2e\x00\x23\x02\x24\x02\x25\x02\x2f\x00\x19\x02\x30\x00\xca\x01\x31\x00\xcb\x01\x1a\x02\x32\x00\xd6\x01\xae\x00\xd7\x01\xd8\x01\xda\x01\xdc\x01\xaf\x00\xb0\x00\x4d\x00\x34\x00\xb1\x00\xf9\x01\x35\x00\xde\x01\xe0\x01\xe1\x01\x50\x00\xe2\x01\xb2\x00\xe3\x01\xe4\x01\xe5\x01\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\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\x3f\x00\xe6\x01\x40\x00\x41\x00\x42\x00\xe7\x01\xec\x01\xef\x01\x43\x00\x44\x00\x45\x00\x25\x00\x79\x00\x46\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\xfa\x01\x01\x02\x03\x02\x19\x02\x2c\x00\x2d\x00\x2e\x00\x05\x02\x34\x02\x07\x02\x2f\x00\x0c\x02\x30\x00\x52\x01\x31\x00\x55\x01\x57\x01\x32\x00\x4d\x00\xae\x00\x61\x01\x77\x00\xc2\x00\xc3\x00\x7b\x00\x7c\x00\x50\x00\x34\x00\x62\x01\x66\x01\x35\x00\xc2\x00\xc3\x00\xef\x00\xb2\x00\x67\x01\x7e\x01\xf0\x00\xee\x00\x8a\x01\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\xc4\x00\x8b\x01\x8c\x01\xf1\x00\x8e\x01\xc5\x00\xc6\x00\xb6\x00\xf2\x00\xc4\x00\xc7\x00\x9b\x01\x9d\x01\x9f\x01\xc5\x00\xc6\x00\x80\x00\xc8\x00\xa1\x01\xc7\x00\x3f\x00\xa3\x01\x40\x00\x41\x00\x42\x00\xb8\x01\xc8\x00\x51\x01\x43\x00\x44\x00\x45\x00\x25\x00\xb9\x01\x46\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\xbd\x01\xdc\x00\x7d\x00\xb2\x00\x2c\x00\x2d\x00\x2e\x00\xe2\x00\xe5\x00\xe8\x00\x2f\x00\xea\x00\x30\x00\xf9\x00\x31\x00\x10\x01\x1e\x01\x32\x00\x17\x01\x33\x00\x15\x01\x52\x02\xf3\x01\xc2\x00\xc3\x00\xb6\x00\x18\x01\x34\x00\x1f\x01\x22\x01\x35\x00\xc2\x00\xc3\x00\x26\x01\x80\x00\x2e\x01\x3a\x01\x3b\x01\x3e\x01\xd2\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x01\xc4\x00\x40\x01\x46\x01\x71\x00\xee\x01\xc5\x00\xc6\x00\x4a\x01\xc4\x00\x4f\x01\xc7\x00\x72\x00\x73\x00\xc5\x00\xc6\x00\xc2\x00\xc3\x00\xc8\x00\xc7\x00\x3f\x00\x77\x00\x40\x00\x41\x00\x42\x00\x16\x02\xc8\x00\x90\x00\x43\x00\x44\x00\x45\x00\x25\x00\x92\x00\x46\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x9a\x00\x9d\x00\x9e\x00\xc4\x00\x2c\x00\x2d\x00\x2e\x00\xa0\x00\xc5\x00\xc6\x00\x2f\x00\xa5\x00\x30\x00\xc7\x00\x31\x00\xcf\x00\x88\x02\x32\x00\xbd\x00\x33\x00\xc8\x00\xc8\x00\x21\x01\xc2\x00\xc3\x00\xd5\x00\x04\x00\x34\x00\x8a\x02\x84\x02\x35\x00\xc2\x00\xc3\x00\x7d\x02\x72\x02\x75\x02\x55\x02\xf8\x00\x40\xff\xd4\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x56\x02\xc4\x00\x00\x00\x12\x01\x5f\x02\x62\x02\xc5\x00\xc6\x00\x68\x02\xc4\x00\x66\x01\xc7\x00\x69\x02\x6c\x02\xc5\x00\xc6\x00\xc2\x00\xc3\x00\xc8\x00\xc7\x00\x3f\x00\x6b\x02\x40\x00\x41\x00\x42\x00\x14\x02\xc8\x00\x70\x02\x43\x00\x44\x00\x45\x00\x25\x00\xf6\x01\x46\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x17\x02\x18\x02\x19\x02\xc4\x00\x2c\x00\x2d\x00\x2e\x00\x28\x02\xc5\x00\xc6\x00\x2f\x00\x29\x02\x30\x00\xc7\x00\x31\x00\x52\x02\x33\x02\x32\x00\x05\x02\x33\x00\xc8\x00\x39\x02\xc2\x00\xc3\x00\xcf\x01\x3f\x02\x40\x02\x34\x00\x41\x02\x42\x02\x35\x00\xc2\x00\xc3\x00\x7d\x00\xb2\x00\x43\x02\xd3\x01\xf8\x00\xda\x01\x87\xff\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\xc4\x00\x3d\xff\xde\x01\xd5\x01\xe0\x01\xc5\x00\xc6\x00\xb6\x00\xec\x00\xc4\x00\xc7\x00\xeb\x01\x03\x02\xef\x01\xc5\x00\xc6\x00\x80\x00\xc8\x00\xec\x01\xc7\x00\x3f\x00\xfd\x01\x40\x00\x41\x00\x42\x00\x05\x02\xc8\x00\x0f\x02\x43\x00\x44\x00\x45\x00\x25\x00\x10\x02\x1e\x01\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x11\x02\x54\x01\x12\x02\x55\x01\x2c\x00\x2d\x00\x2e\x00\x59\x01\x5c\x01\x5b\x01\x2f\x00\x5d\x01\x30\x00\x5e\x01\x31\x00\x64\x01\x69\x01\x32\x00\x6a\x01\x33\x00\x6b\x01\x6c\x01\xc2\x00\xc3\x00\x06\x01\xc3\x00\x6d\x01\x34\x00\x70\x01\x7a\x01\x35\x00\x79\x01\x7b\x01\x94\x00\x81\x01\x85\x01\x82\x01\x65\x01\x80\x01\x07\x01\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\xc4\x00\x88\x01\x08\x01\x95\x01\x92\x01\xc5\x00\xc6\x00\x09\x01\x0a\x01\x66\x01\xc7\x00\x0b\x01\xc7\x00\x93\x01\x94\x01\xa5\x01\xa7\x01\xc8\x00\xad\x01\x0c\x01\x3f\x00\xb1\x01\x40\x00\x41\x00\x42\x00\xb3\x01\xb4\x01\xb5\x01\x43\x00\x44\x00\x45\x00\x25\x00\xb7\x01\x46\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x7d\x00\xb2\x00\xda\x00\x2c\x00\x2d\x00\x2e\x00\xe7\x00\xe4\x00\xea\x00\x2f\x00\xec\x00\x30\x00\xf9\x00\x31\x00\xfb\x00\xf5\x00\x32\x00\x00\x00\x33\x00\xe8\x01\xc3\xff\x22\x01\xc4\xff\xb6\x00\x03\x01\xec\x00\x34\x00\xec\x00\x30\x01\x35\x00\xc2\x00\xc3\x00\x80\x00\x34\x01\x4c\x01\x44\x01\x4d\x01\x7d\x00\xb2\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x6b\x00\x6c\x00\x6e\x00\x6f\x00\x71\x00\x13\x01\x75\x00\x70\x00\xa5\x01\xc4\x00\x76\x00\x77\x00\xb6\x00\x92\x00\xc5\x00\xc6\x00\xc2\x00\xc3\x00\x14\x01\xc7\x00\x3f\x00\x80\x00\x40\x00\x41\x00\x42\x00\xf7\x01\xc8\x00\x86\x00\x43\x00\x44\x00\x45\x00\x25\x00\x94\x00\x1e\x01\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x87\x00\x88\x00\x89\x00\xc4\x00\x2c\x00\x2d\x00\x2e\x00\x8a\x00\xc5\x00\xc6\x00\x2f\x00\x95\x00\x30\x00\xc7\x00\x31\x00\xff\xff\xff\xff\x32\x00\xbf\x00\x33\x00\xc8\x00\x00\x00\xc2\x00\xc3\x00\xc2\x00\xc3\x00\x00\x00\x34\x00\x00\x00\x00\x00\x35\x00\xf8\x01\x00\x00\x0a\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\xc4\x00\x00\x00\xc4\x00\x00\x00\x00\x00\xc5\x00\xc6\x00\xc5\x00\xc6\x00\x00\x00\xc7\x00\x00\x00\xc7\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc8\x00\x00\x00\xc8\x00\x3f\x00\x00\x00\x40\x00\x41\x00\x42\x00\x00\x00\x00\x00\x00\x00\x43\x00\x44\x00\x45\x00\x25\x00\x00\x00\x46\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2c\x00\x2d\x00\x2e\x00\x00\x00\x00\x00\x00\x00\x2f\x00\x00\x00\x30\x00\x00\x00\x31\x00\x00\x00\x00\x00\x32\x00\x00\x00\x33\x00\x00\x00\x00\x00\xc2\x00\xc3\x00\xc2\x00\xc3\x00\x00\x00\x34\x00\x00\x00\x00\x00\x35\x00\x00\x00\x00\x00\x0b\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x02\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\xc4\x00\x00\x00\xc4\x00\x00\x00\x00\x00\xc5\x00\xc6\x00\xc5\x00\xc6\x00\x00\x00\xc7\x00\x00\x00\xc7\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc8\x00\x00\x00\xc8\x00\x3f\x00\x00\x00\x40\x00\x41\x00\x42\x00\x00\x00\x00\x00\x00\x00\x43\x00\x44\x00\x45\x00\x25\x00\x00\x00\x1e\x01\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2c\x00\x2d\x00\x2e\x00\x00\x00\x00\x00\x00\x00\x2f\x00\x00\x00\x30\x00\x00\x00\x31\x00\x00\x00\x00\x00\x32\x00\x00\x00\x33\x00\x00\x00\x00\x00\xc2\x00\xc3\x00\xc2\x00\xc3\x00\x00\x00\x34\x00\x00\x00\x00\x00\x35\x00\x00\x00\x00\x00\x13\x02\x00\x00\x00\x00\x00\x00\x00\x00\x09\x02\x00\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\xc4\x00\x00\x00\xc4\x00\x00\x00\x00\x00\xc5\x00\xc6\x00\xc5\x00\xc6\x00\x00\x00\xc7\x00\x00\x00\xc7\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc8\x00\x00\x00\xc8\x00\x3f\x00\x00\x00\x40\x00\x41\x00\x42\x00\x00\x00\x7d\x00\xb2\x00\x43\x00\x44\x00\x45\x00\x25\x00\x00\x00\x46\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x8b\x02\x00\x00\x00\x00\x00\x00\xa7\x01\x2e\x00\x00\x00\x00\x00\xb6\x00\x2f\x00\x00\x00\x30\x00\x00\x00\x31\x00\x00\x00\x00\x00\x32\x00\x80\x00\x25\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc3\x00\x34\x00\x76\x01\x77\x01\x35\x00\x00\x00\x00\x00\x00\x00\x58\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x00\x00\x78\x01\x00\x00\xc4\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc5\x00\xc6\x00\x00\x00\x25\x00\x00\x00\xc7\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\xc8\x00\x7f\x02\x40\x00\x41\x00\x42\x00\x00\x00\x2e\x00\x00\x00\x43\x00\x44\x00\x2f\x00\x00\x00\x30\x00\x00\x00\x31\x00\x00\x00\x00\x00\x32\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x34\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\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1c\x02\x00\x00\x00\x00\x00\x00\x00\x00\x25\x00\x00\x00\x1a\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x79\x02\x40\x00\x41\x00\x42\x00\x00\x00\x2e\x00\x1e\x00\x43\x00\x44\x00\x2f\x00\x00\x00\x30\x00\x00\x00\x31\x00\x00\x00\x1f\x00\x32\x00\x8b\x00\x21\x00\x00\x00\x00\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x34\x00\x00\x00\x00\x00\x35\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7d\x00\xb2\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa8\x01\x00\x00\x00\x00\x25\x00\xb6\x00\x8e\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x80\x00\x40\x00\x41\x00\x42\x00\x00\x00\x2e\x00\x00\x00\x43\x00\x44\x00\x2f\x00\x00\x00\x30\x00\x00\x00\x31\x00\x00\x00\x00\x00\x32\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x34\x00\x00\x00\x00\x00\x35\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7d\x00\xb2\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6e\x01\x00\x00\xa9\x01\x00\x00\x00\x00\x25\x00\xb6\x00\x1a\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2d\x02\x80\x00\x40\x00\x41\x00\x42\x00\x00\x00\x2e\x00\x1e\x00\x43\x00\x44\x00\x2f\x00\x00\x00\x30\x00\x00\x00\x31\x00\x00\x00\x1f\x00\x32\x00\x8b\x00\x21\x00\x00\x00\x00\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x34\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\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x34\x01\x00\x00\x00\x00\x00\x00\x00\x00\x25\x00\x00\x00\x1a\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x3a\x02\x40\x00\x41\x00\x42\x00\x00\x00\x2e\x00\x1e\x00\x43\x00\x44\x00\x2f\x00\x00\x00\x30\x00\x00\x00\x31\x00\x00\x00\x1f\x00\x32\x00\x8b\x00\x21\x00\x00\x00\x00\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x34\x00\x00\x00\x00\x00\x35\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7d\x00\xb2\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb5\x01\x00\x00\x00\x00\x25\x00\xb6\x00\x00\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x80\x00\x40\x00\x41\x00\x42\x00\x00\x00\x2e\x00\x44\x02\x43\x00\x44\x00\x2f\x00\x00\x00\x30\x00\x00\x00\x31\x00\x00\x00\x00\x00\x32\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x34\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\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x25\x00\x00\x00\x00\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x40\x00\x41\x00\x42\x00\x00\x00\x2e\x00\x45\x02\x43\x00\x44\x00\x2f\x00\x00\x00\x30\x00\x00\x00\x31\x00\x00\x00\x00\x00\x32\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x34\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\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x25\x00\x00\x00\x00\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x40\x00\x41\x00\x42\x00\x00\x00\x2e\x00\x46\x02\x43\x00\x44\x00\x2f\x00\x00\x00\x30\x00\x00\x00\x31\x00\x00\x00\x00\x00\x32\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x34\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\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x25\x00\x00\x00\x00\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x40\x00\x41\x00\x42\x00\x00\x00\x2e\x00\x47\x02\x43\x00\x44\x00\x2f\x00\x00\x00\x30\x00\x00\x00\x31\x00\x00\x00\x00\x00\x32\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x34\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\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x25\x00\x00\x00\x8e\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x40\x00\x41\x00\x42\x00\x00\x00\x2e\x00\x00\x00\x43\x00\x44\x00\x2f\x00\x00\x00\x30\x00\x00\x00\x31\x00\x00\x00\x00\x00\x32\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x34\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\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x25\x00\x00\x00\x1a\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x40\x00\x41\x00\x42\x00\x00\x00\x2e\x00\x1e\x00\x43\x00\x44\x00\x2f\x00\x00\x00\x30\x00\x00\x00\x31\x00\x00\x00\x1f\x00\x32\x00\x29\x02\x21\x00\x00\x00\x00\x00\x22\x00\x00\x00\x00\x00\x23\x00\x64\x02\x34\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\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x25\x00\x00\x00\x1a\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x40\x00\x41\x00\x42\x00\x00\x00\x2e\x00\x1e\x00\x43\x00\x44\x00\x2f\x00\x00\x00\x30\x00\x00\x00\x31\x00\x00\x00\x1f\x00\x32\x00\xba\x01\x21\x00\x00\x00\x00\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x34\x00\x00\x00\x00\x00\x00\x00\x7d\x00\xb2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb3\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x63\x02\xb5\x00\x00\x00\x00\x00\x00\x00\xb6\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x41\x00\x42\x00\x00\x00\x00\x00\x00\x00\x43\x00\x44\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc3\x00\x25\x00\x79\x00\x00\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xac\x01\xb9\x00\xba\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc4\x00\x00\x00\x00\x00\x7a\x00\x00\x00\xc5\x00\xc6\x00\x00\x00\x7b\x00\x7c\x00\xc7\x00\x83\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc8\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\xbb\x00\x25\x00\x00\x00\xb8\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb9\x00\xba\x00\x1a\x00\x00\x00\x96\x01\x00\x00\x00\x00\x00\x00\x84\x00\x85\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x83\x00\x00\x00\x00\x00\x1f\x00\x00\x00\x20\x00\x21\x00\x97\x01\x00\x00\x22\x00\x00\x00\x00\x00\x23\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\xbb\x00\x25\x00\x00\x00\x00\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x98\x01\x56\x01\x47\x00\x48\x00\x49\x00\x00\x00\xb9\x00\xba\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x84\x00\x85\x00\x4b\x00\x4c\x00\x00\x00\x4d\x00\x00\x00\x4e\x00\x4f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x50\x00\x83\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\xbb\x00\x00\x00\x25\x00\x7d\x00\xb2\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\xb3\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x82\x00\x00\x00\x00\x00\x00\x00\x48\x02\xb5\x00\x84\x00\x85\x00\x31\x00\xb6\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x65\xff\xc3\x00\x80\x00\x00\x00\x00\x00\x83\x00\x00\x00\x00\x00\x00\x00\x65\xff\x65\xff\x65\xff\x00\x00\x00\x00\x00\x00\x65\xff\x00\x00\x65\xff\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x65\xff\x00\x00\x00\x00\x65\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x65\xff\x65\xff\x00\x00\x00\x00\x35\x01\x47\x00\x48\x00\x49\x00\x65\xff\x65\xff\x00\x00\x65\xff\x00\x00\x00\x00\x84\x00\x85\x00\x4a\x00\x00\x00\x00\x00\x4b\x00\x4c\x00\x00\x00\x4d\x00\x00\x00\x4e\x00\x4f\x00\x00\x00\x65\xff\x00\x00\x00\x00\x50\x00\x36\x01\x47\x00\x48\x00\x49\x00\x00\x00\x65\xff\x00\x00\x37\x01\x47\x00\x48\x00\x49\x00\x00\x00\x4a\x00\x00\x00\x00\x00\x4b\x00\x4c\x00\x00\x00\x4d\x00\x4a\x00\x4e\x00\x4f\x00\x4b\x00\x4c\x00\x00\x00\x4d\x00\x50\x00\x4e\x00\x4f\x00\x38\x01\x47\x00\x48\x00\x49\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x00\x00\x00\x00\x4a\x00\x00\x00\x00\x00\x4b\x00\x4c\x00\x00\x00\x4d\x00\x00\x00\x4e\x00\x4f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x50\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x00\x00\x00\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x39\x01\x47\x00\x48\x00\x49\x00\x00\x00\x00\x00\x00\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x4a\x00\x00\x00\x00\x00\x4b\x00\x4c\x00\x00\x00\x4d\x00\x00\x00\x4e\x00\x4f\x00\x95\x00\x47\x00\x48\x00\x49\x00\x50\x00\x00\x00\x00\x00\x96\x00\x47\x00\x48\x00\x49\x00\x00\x00\x4a\x00\x00\x00\x00\x00\x4b\x00\x4c\x00\x00\x00\x4d\x00\x4a\x00\x4e\x00\x4f\x00\x4b\x00\x4c\x00\x00\x00\x4d\x00\x50\x00\x4e\x00\x4f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x50\x00\x46\x00\x47\x00\x48\x00\x49\x00\x00\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x00\x00\x00\x00\x4a\x00\x00\x00\x00\x00\x4b\x00\x4c\x00\x00\x00\x4d\x00\x00\x00\x4e\x00\x4f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x00\x00\x00\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x00\x00\xdd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x1f\x00\x00\x00\x20\x00\x21\x00\x00\x00\x00\x00\x22\x00\x00\x00\x1a\x00\x23\x00\xe1\x00\x00\x00\x00\x00\x1a\x00\x00\x00\xe4\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x95\x01\x00\x00\x00\x00\x1f\x00\x00\x00\x20\x00\x21\x00\x00\x00\x1f\x00\x22\x00\x20\x00\x21\x00\x23\x00\x00\x00\x22\x00\x00\x00\x1a\x00\x23\x00\xfd\x00\x00\x00\x00\x00\x1a\x00\x00\x00\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x99\x01\x00\x00\x1c\x00\x1d\x00\x1e\x00\x9a\x01\x00\x00\x00\x00\x1f\x00\x00\x00\x20\x00\x21\x00\x00\x00\x1f\x00\x22\x00\x20\x00\x21\x00\x23\x00\x77\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x77\x00\x00\x00\x00\x00\x00\x00\xa8\x00\x00\x00\xa9\x00\x00\x00\x00\x00\x00\x00\xfe\x00\x00\x00\x1a\x00\x00\x00\x3c\x01\x00\x01\x1c\x00\x1d\x00\x1e\x00\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x00\x00\x20\x00\x21\x00\xab\x00\x00\x00\x22\x00\x00\x00\x1f\x00\x23\x00\x20\x00\x21\x00\x3d\x01\x19\x01\x22\x00\x1a\x01\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x19\x01\x1f\x00\x1a\x01\x20\x00\x21\x00\x00\x00\x00\x00\x22\x00\x80\x02\x1c\x01\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x19\x01\x1f\x00\x1a\x01\x20\x00\x21\x00\x00\x00\x00\x00\x22\x00\x86\x01\x1c\x01\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7d\x00\xb2\x00\x1a\x00\x1f\x00\x8f\x01\x20\x00\x21\x00\x00\x00\xb3\x00\x22\x00\x1b\x01\x1c\x01\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\xcd\x01\xb5\x00\x00\x00\x00\x00\x00\x00\xb6\x00\x1a\x00\x1f\x00\x96\x01\x20\x00\x21\x00\x00\x00\x3c\x02\x22\x00\x80\x00\x00\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7d\x00\xb2\x00\x1a\x00\x1f\x00\x8f\x01\x20\x00\x21\x00\x97\x01\xb3\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\xcd\x01\xd0\x01\x00\x00\x00\x00\x00\x00\xb6\x00\x1a\x00\x1f\x00\x5a\x02\x20\x00\x21\x00\x00\x00\x90\x01\x22\x00\x80\x00\x00\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7d\x00\xb2\x00\x1a\x00\x1f\x00\x36\x02\x20\x00\x21\x00\x00\x00\xb3\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\xfb\x01\xb5\x00\x00\x00\x00\x00\x00\x00\xb6\x00\x1a\x00\x1f\x00\x3a\x02\x20\x00\x21\x00\x00\x00\x00\x00\x22\x00\x80\x00\x00\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7d\x00\xb2\x00\x1a\x00\x1f\x00\xf1\x01\x20\x00\x21\x00\x00\x00\xb3\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x0b\x02\xb5\x00\x00\x00\x00\x00\x00\x00\xb6\x00\x1a\x00\x1f\x00\xf3\x01\x20\x00\x21\x00\x00\x00\x00\x00\x22\x00\x80\x00\x00\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7d\x00\xb2\x00\x1a\x00\x1f\x00\x0d\x02\x20\x00\x21\x00\x00\x00\xb3\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x30\x01\xb5\x00\x00\x00\x00\x00\x00\x00\xb6\x00\x1a\x00\x1f\x00\x51\x01\x20\x00\x21\x00\x00\x00\x00\x00\x22\x00\x80\x00\x00\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7d\x00\xb2\x00\x1a\x00\x1f\x00\x5e\x01\x20\x00\x21\x00\x00\x00\xb3\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\xb4\x00\xb5\x00\x00\x00\x00\x00\x00\x00\xb6\x00\x1a\x00\x1f\x00\x5f\x01\x20\x00\x21\x00\x00\x00\x00\x00\x22\x00\x80\x00\x00\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x1f\x00\x60\x01\x20\x00\x21\x00\x00\x00\x00\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x1f\x00\x6d\x01\x20\x00\x21\x00\x00\x00\x00\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x1f\x00\x7b\x01\x20\x00\x21\x00\x00\x00\x00\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x1f\x00\x7c\x01\x20\x00\x21\x00\x00\x00\x00\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x1f\x00\x7d\x01\x20\x00\x21\x00\x00\x00\x00\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x1f\x00\x82\x01\x20\x00\x21\x00\x00\x00\x00\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x1f\x00\x83\x01\x20\x00\x21\x00\x00\x00\x00\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x1f\x00\x8d\x01\x20\x00\x21\x00\x00\x00\x00\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x1f\x00\xdf\x00\x20\x00\x21\x00\x00\x00\x00\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x1f\x00\xe0\x00\x20\x00\x21\x00\x00\x00\x00\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x1f\x00\xb7\x01\x20\x00\x21\x00\x00\x00\x00\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x1f\x00\xbc\x01\x20\x00\x21\x00\x00\x00\x00\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x1f\x00\xda\x00\x20\x00\x21\x00\x00\x00\x00\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x1f\x00\xdb\x00\x20\x00\x21\x00\x00\x00\x00\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x1f\x00\xdd\x00\x20\x00\x21\x00\x00\x00\x00\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x1f\x00\xde\x00\x20\x00\x21\x00\x00\x00\x00\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x1f\x00\xdf\x00\x20\x00\x21\x00\x00\x00\x00\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x1f\x00\xe0\x00\x20\x00\x21\x00\x00\x00\x00\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x1f\x00\xe1\x00\x20\x00\x21\x00\x00\x00\x00\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x1f\x00\xe4\x00\x20\x00\x21\x00\x00\x00\x00\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x1f\x00\xf3\x00\x20\x00\x21\x00\x00\x00\x00\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x1f\x00\xa1\x00\x20\x00\x21\x00\x00\x00\x00\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x1f\x00\x01\x01\x20\x00\x21\x00\x00\x00\x00\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x1f\x00\x03\x01\x20\x00\x21\x00\x00\x00\x00\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x1f\x00\x6c\x00\x20\x00\x21\x00\x00\x00\x00\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x1f\x00\x99\x00\x20\x00\x21\x00\x00\x00\x00\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x1f\x00\x9f\x00\x20\x00\x21\x00\x00\x00\x00\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x1f\x00\xa1\x00\x20\x00\x21\x00\x00\x00\x00\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x1f\x00\xa3\x00\x20\x00\x21\x00\x00\x00\x00\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x1f\x00\xa4\x00\x20\x00\x21\x00\x00\x00\x00\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x1f\x00\xc9\x00\x20\x00\x21\x00\x00\x00\x00\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x1f\x00\xca\x00\x20\x00\x21\x00\x00\x00\x00\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x1f\x00\xcb\x00\x20\x00\x21\x00\x00\x00\x00\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x1f\x00\xcc\x00\x20\x00\x21\x00\x00\x00\x00\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x1f\x00\xcd\x00\x20\x00\x21\x00\x00\x00\x00\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x1f\x00\xce\x00\x20\x00\x21\x00\x00\x00\x00\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x1f\x00\xd0\x00\x20\x00\x21\x00\x00\x00\x00\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x1f\x00\xd2\x00\x20\x00\x21\x00\x00\x00\x00\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x1f\x00\xd4\x00\x20\x00\x21\x00\x00\x00\x00\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x1f\x00\xd8\x00\x20\x00\x21\x00\x00\x00\x00\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x1a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x1f\x00\x1b\x00\x20\x00\x21\x00\x1a\x00\x00\x00\x22\x00\x00\x00\x1e\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x1f\x00\x1e\x00\xba\x01\x21\x00\x1a\x00\x1f\x00\x22\x00\x20\x00\x21\x00\x23\x00\x1f\x00\x22\x00\xba\x01\x21\x00\x23\x00\x00\x00\x22\x00\x1a\x00\x1e\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x00\x00\x1f\x00\x00\x00\xdb\x01\x21\x00\x1e\x00\x00\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x1a\x00\x1e\x00\x1f\x00\x00\x00\xba\x01\x21\x00\x00\x00\x00\x00\x22\x00\x00\x00\x1f\x00\x23\x00\xba\x01\x21\x00\x1e\x00\x00\x00\x22\x00\x1a\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x1f\x00\x00\x00\xe7\x00\x21\x00\x00\x00\x00\x00\x22\x00\x00\x00\x1e\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1f\x00\x00\x00\xa2\x00\x21\x00\x00\x00\x00\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\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 (3, 272) [-	(3 , happyReduce_3),-	(4 , happyReduce_4),-	(5 , happyReduce_5),-	(6 , happyReduce_6),-	(7 , happyReduce_7),-	(8 , happyReduce_8),-	(9 , happyReduce_9),-	(10 , happyReduce_10),-	(11 , happyReduce_11),-	(12 , happyReduce_12),-	(13 , happyReduce_13),-	(14 , happyReduce_14),-	(15 , happyReduce_15),-	(16 , happyReduce_16),-	(17 , happyReduce_17),-	(18 , happyReduce_18),-	(19 , happyReduce_19),-	(20 , happyReduce_20),-	(21 , happyReduce_21),-	(22 , happyReduce_22),-	(23 , happyReduce_23),-	(24 , happyReduce_24),-	(25 , happyReduce_25),-	(26 , happyReduce_26),-	(27 , happyReduce_27),-	(28 , happyReduce_28),-	(29 , happyReduce_29),-	(30 , happyReduce_30),-	(31 , happyReduce_31),-	(32 , happyReduce_32),-	(33 , happyReduce_33),-	(34 , happyReduce_34),-	(35 , happyReduce_35),-	(36 , happyReduce_36),-	(37 , happyReduce_37),-	(38 , happyReduce_38),-	(39 , happyReduce_39),-	(40 , happyReduce_40),-	(41 , happyReduce_41),-	(42 , happyReduce_42),-	(43 , happyReduce_43),-	(44 , happyReduce_44),-	(45 , happyReduce_45),-	(46 , happyReduce_46),-	(47 , happyReduce_47),-	(48 , happyReduce_48),-	(49 , happyReduce_49),-	(50 , happyReduce_50),-	(51 , happyReduce_51),-	(52 , happyReduce_52),-	(53 , happyReduce_53),-	(54 , happyReduce_54),-	(55 , happyReduce_55),-	(56 , happyReduce_56),-	(57 , happyReduce_57),-	(58 , happyReduce_58),-	(59 , happyReduce_59),-	(60 , happyReduce_60),-	(61 , happyReduce_61),-	(62 , happyReduce_62),-	(63 , happyReduce_63),-	(64 , happyReduce_64),-	(65 , happyReduce_65),-	(66 , happyReduce_66),-	(67 , happyReduce_67),-	(68 , happyReduce_68),-	(69 , happyReduce_69),-	(70 , happyReduce_70),-	(71 , happyReduce_71),-	(72 , happyReduce_72),-	(73 , happyReduce_73),-	(74 , happyReduce_74),-	(75 , happyReduce_75),-	(76 , happyReduce_76),-	(77 , happyReduce_77),-	(78 , happyReduce_78),-	(79 , happyReduce_79),-	(80 , happyReduce_80),-	(81 , happyReduce_81),-	(82 , happyReduce_82),-	(83 , happyReduce_83),-	(84 , happyReduce_84),-	(85 , happyReduce_85),-	(86 , happyReduce_86),-	(87 , happyReduce_87),-	(88 , happyReduce_88),-	(89 , happyReduce_89),-	(90 , happyReduce_90),-	(91 , happyReduce_91),-	(92 , happyReduce_92),-	(93 , happyReduce_93),-	(94 , happyReduce_94),-	(95 , happyReduce_95),-	(96 , happyReduce_96),-	(97 , happyReduce_97),-	(98 , happyReduce_98),-	(99 , happyReduce_99),-	(100 , happyReduce_100),-	(101 , happyReduce_101),-	(102 , happyReduce_102),-	(103 , happyReduce_103),-	(104 , happyReduce_104),-	(105 , happyReduce_105),-	(106 , happyReduce_106),-	(107 , happyReduce_107),-	(108 , happyReduce_108),-	(109 , happyReduce_109),-	(110 , happyReduce_110),-	(111 , happyReduce_111),-	(112 , happyReduce_112),-	(113 , happyReduce_113),-	(114 , happyReduce_114),-	(115 , happyReduce_115),-	(116 , happyReduce_116),-	(117 , happyReduce_117),-	(118 , happyReduce_118),-	(119 , happyReduce_119),-	(120 , happyReduce_120),-	(121 , happyReduce_121),-	(122 , happyReduce_122),-	(123 , happyReduce_123),-	(124 , happyReduce_124),-	(125 , happyReduce_125),-	(126 , happyReduce_126),-	(127 , happyReduce_127),-	(128 , happyReduce_128),-	(129 , happyReduce_129),-	(130 , happyReduce_130),-	(131 , happyReduce_131),-	(132 , happyReduce_132),-	(133 , happyReduce_133),-	(134 , happyReduce_134),-	(135 , happyReduce_135),-	(136 , happyReduce_136),-	(137 , happyReduce_137),-	(138 , happyReduce_138),-	(139 , happyReduce_139),-	(140 , happyReduce_140),-	(141 , happyReduce_141),-	(142 , happyReduce_142),-	(143 , happyReduce_143),-	(144 , happyReduce_144),-	(145 , happyReduce_145),-	(146 , happyReduce_146),-	(147 , happyReduce_147),-	(148 , happyReduce_148),-	(149 , happyReduce_149),-	(150 , happyReduce_150),-	(151 , happyReduce_151),-	(152 , happyReduce_152),-	(153 , happyReduce_153),-	(154 , happyReduce_154),-	(155 , happyReduce_155),-	(156 , happyReduce_156),-	(157 , happyReduce_157),-	(158 , happyReduce_158),-	(159 , happyReduce_159),-	(160 , happyReduce_160),-	(161 , happyReduce_161),-	(162 , happyReduce_162),-	(163 , happyReduce_163),-	(164 , happyReduce_164),-	(165 , happyReduce_165),-	(166 , happyReduce_166),-	(167 , happyReduce_167),-	(168 , happyReduce_168),-	(169 , happyReduce_169),-	(170 , happyReduce_170),-	(171 , happyReduce_171),-	(172 , happyReduce_172),-	(173 , happyReduce_173),-	(174 , happyReduce_174),-	(175 , happyReduce_175),-	(176 , happyReduce_176),-	(177 , happyReduce_177),-	(178 , happyReduce_178),-	(179 , happyReduce_179),-	(180 , happyReduce_180),-	(181 , happyReduce_181),-	(182 , happyReduce_182),-	(183 , happyReduce_183),-	(184 , happyReduce_184),-	(185 , happyReduce_185),-	(186 , happyReduce_186),-	(187 , happyReduce_187),-	(188 , happyReduce_188),-	(189 , happyReduce_189),-	(190 , happyReduce_190),-	(191 , happyReduce_191),-	(192 , happyReduce_192),-	(193 , happyReduce_193),-	(194 , happyReduce_194),-	(195 , happyReduce_195),-	(196 , happyReduce_196),-	(197 , happyReduce_197),-	(198 , happyReduce_198),-	(199 , happyReduce_199),-	(200 , happyReduce_200),-	(201 , happyReduce_201),-	(202 , happyReduce_202),-	(203 , happyReduce_203),-	(204 , happyReduce_204),-	(205 , happyReduce_205),-	(206 , happyReduce_206),-	(207 , happyReduce_207),-	(208 , happyReduce_208),-	(209 , happyReduce_209),-	(210 , happyReduce_210),-	(211 , happyReduce_211),-	(212 , happyReduce_212),-	(213 , happyReduce_213),-	(214 , happyReduce_214),-	(215 , happyReduce_215),-	(216 , happyReduce_216),-	(217 , happyReduce_217),-	(218 , happyReduce_218),-	(219 , happyReduce_219),-	(220 , happyReduce_220),-	(221 , happyReduce_221),-	(222 , happyReduce_222),-	(223 , happyReduce_223),-	(224 , happyReduce_224),-	(225 , happyReduce_225),-	(226 , happyReduce_226),-	(227 , happyReduce_227),-	(228 , happyReduce_228),-	(229 , happyReduce_229),-	(230 , happyReduce_230),-	(231 , happyReduce_231),-	(232 , happyReduce_232),-	(233 , happyReduce_233),-	(234 , happyReduce_234),-	(235 , happyReduce_235),-	(236 , happyReduce_236),-	(237 , happyReduce_237),-	(238 , happyReduce_238),-	(239 , happyReduce_239),-	(240 , happyReduce_240),-	(241 , happyReduce_241),-	(242 , happyReduce_242),-	(243 , happyReduce_243),-	(244 , happyReduce_244),-	(245 , happyReduce_245),-	(246 , happyReduce_246),-	(247 , happyReduce_247),-	(248 , happyReduce_248),-	(249 , happyReduce_249),-	(250 , happyReduce_250),-	(251 , happyReduce_251),-	(252 , happyReduce_252),-	(253 , happyReduce_253),-	(254 , happyReduce_254),-	(255 , happyReduce_255),-	(256 , happyReduce_256),-	(257 , happyReduce_257),-	(258 , happyReduce_258),-	(259 , happyReduce_259),-	(260 , happyReduce_260),-	(261 , happyReduce_261),-	(262 , happyReduce_262),-	(263 , happyReduce_263),-	(264 , happyReduce_264),-	(265 , happyReduce_265),-	(266 , happyReduce_266),-	(267 , happyReduce_267),-	(268 , happyReduce_268),-	(269 , happyReduce_269),-	(270 , happyReduce_270),-	(271 , happyReduce_271),-	(272 , happyReduce_272)-	]--happy_n_terms = 126 :: Int-happy_n_nonterms = 79 :: Int--happyReduce_3 = happySpecReduce_0  0# happyReduction_3-happyReduction_3  =  happyIn6-		 ([]-	)--happyReduce_4 = happySpecReduce_2  0# happyReduction_4-happyReduction_4 happy_x_2-	happy_x_1-	 =  case happyOut7 happy_x_1 of { happy_var_1 -> -	case happyOut6 happy_x_2 of { happy_var_2 -> -	happyIn6-		 (happy_var_1:happy_var_2-	)}}--happyReduce_5 = happySpecReduce_2  0# happyReduction_5-happyReduction_5 happy_x_2-	happy_x_1-	 =  case happyOut18 happy_x_1 of { happy_var_1 -> -	case happyOut6 happy_x_2 of { happy_var_2 -> -	happyIn6-		 (map RealDecl happy_var_1 ++ happy_var_2-	)}}--happyReduce_6 = happyReduce 4# 0# happyReduction_6-happyReduction_6 (happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOutTok happy_x_2 of { (TokenString happy_var_2) -> -	case happyOut6 happy_x_4 of { happy_var_4 -> -	happyIn6-		 (RealDecl (PInclude happy_var_2) : happy_var_4-	) `HappyStk` happyRest}}--happyReduce_7 = happySpecReduce_1  1# happyReduction_7-happyReduction_7 happy_x_1-	 =  case happyOut9 happy_x_1 of { happy_var_1 -> -	happyIn7-		 (happy_var_1-	)}--happyReduce_8 = happySpecReduce_1  1# happyReduction_8-happyReduction_8 happy_x_1-	 =  case happyOut26 happy_x_1 of { happy_var_1 -> -	happyIn7-		 (RealDecl (DataDecl happy_var_1)-	)}--happyReduce_9 = happySpecReduce_1  1# happyReduction_9-happyReduction_9 happy_x_1-	 =  case happyOut22 happy_x_1 of { happy_var_1 -> -	happyIn7-		 (RealDecl happy_var_1-	)}--happyReduce_10 = happyReduce 5# 1# happyReduction_10-happyReduction_10 (happy_x_5 `HappyStk`-	happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOutTok happy_x_2 of { (TokenName happy_var_2) -> -	case happyOut83 happy_x_3 of { happy_var_3 -> -	case happyOut82 happy_x_4 of { happy_var_4 -> -	happyIn7-		 (RealDecl (Freeze happy_var_3 happy_var_4 [] happy_var_2)-	) `HappyStk` happyRest}}}--happyReduce_11 = happyReduce 4# 1# happyReduction_11-happyReduction_11 (happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOut67 happy_x_1 of { happy_var_1 -> -	case happyOut6 happy_x_3 of { happy_var_3 -> -	happyIn7-		 (PUsing happy_var_1 happy_var_3-	) `HappyStk` happyRest}}--happyReduce_12 = happyReduce 4# 1# happyReduction_12-happyReduction_12 (happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOut68 happy_x_1 of { happy_var_1 -> -	case happyOut6 happy_x_3 of { happy_var_3 -> -	happyIn7-		 (PDoUsing happy_var_1 happy_var_3-	) `HappyStk` happyRest}}--happyReduce_13 = happyReduce 4# 1# happyReduction_13-happyReduction_13 (happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOut69 happy_x_1 of { happy_var_1 -> -	case happyOut6 happy_x_3 of { happy_var_3 -> -	happyIn7-		 (PIdiom happy_var_1 happy_var_3-	) `HappyStk` happyRest}}--happyReduce_14 = happyReduce 4# 1# happyReduction_14-happyReduction_14 (happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOut70 happy_x_1 of { happy_var_1 -> -	case happyOut6 happy_x_3 of { happy_var_3 -> -	happyIn7-		 (PParams happy_var_1 happy_var_3-	) `HappyStk` happyRest}}--happyReduce_15 = happyReduce 4# 1# happyReduction_15-happyReduction_15 (happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOut71 happy_x_1 of { happy_var_1 -> -	case happyOut6 happy_x_3 of { happy_var_3 -> -	happyIn7-		 (PNamespace happy_var_1 happy_var_3-	) `HappyStk` happyRest}}--happyReduce_16 = happySpecReduce_1  1# happyReduction_16-happyReduction_16 happy_x_1-	 =  case happyOut8 happy_x_1 of { happy_var_1 -> -	happyIn7-		 (RealDecl happy_var_1-	)}--happyReduce_17 = happyReduce 6# 1# happyReduction_17-happyReduction_17 (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 happyOut32 happy_x_2 of { happy_var_2 -> -	case happyOut41 happy_x_3 of { happy_var_3 -> -	case happyOut34 happy_x_5 of { happy_var_5 -> -	happyIn7-		 (RealDecl (SynDef happy_var_2 happy_var_3 happy_var_5)-	) `HappyStk` happyRest}}}--happyReduce_18 = happyReduce 5# 1# happyReduction_18-happyReduction_18 (happy_x_5 `HappyStk`-	happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOut32 happy_x_2 of { happy_var_2 -> -	case happyOut83 happy_x_3 of { happy_var_3 -> -	case happyOut82 happy_x_4 of { happy_var_4 -> -	happyIn7-		 (RealDecl (SynDef happy_var_2 [] (RVar happy_var_3 happy_var_4 (mkhidden happy_var_2) Unknown))-	) `HappyStk` happyRest}}}--happyReduce_19 = happySpecReduce_2  1# happyReduction_19-happyReduction_19 happy_x_2-	happy_x_1-	 =  case happyOutTok happy_x_2 of { (TokenString happy_var_2) -> -	happyIn7-		 (RealDecl (CInclude happy_var_2)-	)}--happyReduce_20 = happySpecReduce_2  1# happyReduction_20-happyReduction_20 happy_x_2-	happy_x_1-	 =  case happyOutTok happy_x_2 of { (TokenString happy_var_2) -> -	happyIn7-		 (RealDecl (CLib happy_var_2)-	)}--happyReduce_21 = happyReduce 5# 2# happyReduction_21-happyReduction_21 (happy_x_5 `HappyStk`-	happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOut34 happy_x_2 of { happy_var_2 -> -	case happyOut34 happy_x_4 of { happy_var_4 -> -	happyIn8-		 (Transform happy_var_2 happy_var_4-	) `HappyStk` happyRest}}--happyReduce_22 = happyReduce 7# 3# happyReduction_22-happyReduction_22 (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 happyOut32 happy_x_1 of { happy_var_1 -> -	case happyOut50 happy_x_3 of { happy_var_3 -> -	case happyOut15 happy_x_5 of { happy_var_5 -> -	case happyOut83 happy_x_6 of { happy_var_6 -> -	case happyOut82 happy_x_7 of { happy_var_7 -> -	happyIn9-		 (FunType happy_var_1 happy_var_3 (nub happy_var_5) happy_var_6 happy_var_7-	) `HappyStk` happyRest}}}}}--happyReduce_23 = happySpecReduce_3  3# happyReduction_23-happyReduction_23 happy_x_3-	happy_x_2-	happy_x_1-	 =  case happyOut32 happy_x_1 of { happy_var_1 -> -	case happyOut79 happy_x_2 of { happy_var_2 -> -	happyIn9-		 (ProofScript happy_var_1 happy_var_2-	)}}--happyReduce_24 = happyReduce 9# 3# happyReduction_24-happyReduction_24 (happy_x_9 `HappyStk`-	happy_x_8 `HappyStk`-	happy_x_7 `HappyStk`-	happy_x_6 `HappyStk`-	happy_x_5 `HappyStk`-	happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOut24 happy_x_1 of { happy_var_1 -> -	case happyOut12 happy_x_2 of { happy_var_2 -> -	case happyOut11 happy_x_3 of { happy_var_3 -> -	case happyOut34 happy_x_4 of { happy_var_4 -> -	case happyOut14 happy_x_6 of { happy_var_6 -> -	case happyOut83 happy_x_8 of { happy_var_8 -> -	case happyOut82 happy_x_9 of { happy_var_9 -> -	happyIn9-		 (WithClause (mkDef happy_var_8 happy_var_9 happy_var_1) happy_var_2 happy_var_3 happy_var_4 happy_var_6-	) `HappyStk` happyRest}}}}}}}--happyReduce_25 = happyReduce 10# 3# happyReduction_25-happyReduction_25 (happy_x_10 `HappyStk`-	happy_x_9 `HappyStk`-	happy_x_8 `HappyStk`-	happy_x_7 `HappyStk`-	happy_x_6 `HappyStk`-	happy_x_5 `HappyStk`-	happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOut24 happy_x_1 of { happy_var_1 -> -	case happyOut12 happy_x_2 of { happy_var_2 -> -	case happyOut34 happy_x_4 of { happy_var_4 -> -	case happyOut32 happy_x_7 of { happy_var_7 -> -	case happyOut83 happy_x_9 of { happy_var_9 -> -	case happyOut82 happy_x_10 of { happy_var_10 -> -	happyIn9-		 (FunClauseP (mkDef happy_var_9 happy_var_10 happy_var_1) happy_var_2 happy_var_4 happy_var_7-	) `HappyStk` happyRest}}}}}}--happyReduce_26 = happyReduce 8# 3# happyReduction_26-happyReduction_26 (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 happyOut24 happy_x_1 of { happy_var_1 -> -	case happyOut12 happy_x_2 of { happy_var_2 -> -	case happyOut34 happy_x_4 of { happy_var_4 -> -	case happyOut15 happy_x_6 of { happy_var_6 -> -	case happyOut83 happy_x_7 of { happy_var_7 -> -	case happyOut82 happy_x_8 of { happy_var_8 -> -	happyIn9-		 (FunClause (mkDef happy_var_7 happy_var_8 happy_var_1) happy_var_2 happy_var_4 (nub happy_var_6)-	) `HappyStk` happyRest}}}}}}--happyReduce_27 = happyReduce 5# 3# happyReduction_27-happyReduction_27 (happy_x_5 `HappyStk`-	happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOut13 happy_x_2 of { happy_var_2 -> -	case happyOut34 happy_x_4 of { happy_var_4 -> -	happyIn9-		 (FunClause RPlaceholder [happy_var_2] happy_var_4 []-	) `HappyStk` happyRest}}--happyReduce_28 = happyReduce 8# 3# happyReduction_28-happyReduction_28 (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 happyOut13 happy_x_2 of { happy_var_2 -> -	case happyOut34 happy_x_4 of { happy_var_4 -> -	case happyOut32 happy_x_7 of { happy_var_7 -> -	happyIn9-		 (FunClauseP RPlaceholder [happy_var_2] happy_var_4 happy_var_7-	) `HappyStk` happyRest}}}--happyReduce_29 = happyReduce 7# 3# happyReduction_29-happyReduction_29 (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 happyOut13 happy_x_2 of { happy_var_2 -> -	case happyOut11 happy_x_3 of { happy_var_3 -> -	case happyOut34 happy_x_4 of { happy_var_4 -> -	case happyOut14 happy_x_6 of { happy_var_6 -> -	happyIn9-		 (WithClause RPlaceholder [happy_var_2] happy_var_3 happy_var_4 happy_var_6-	) `HappyStk` happyRest}}}}--happyReduce_30 = happySpecReduce_1  4# happyReduction_30-happyReduction_30 happy_x_1-	 =  happyIn10-		 (Vis Public-	)--happyReduce_31 = happySpecReduce_1  4# happyReduction_31-happyReduction_31 happy_x_1-	 =  happyIn10-		 (Vis Private-	)--happyReduce_32 = happySpecReduce_1  4# happyReduction_32-happyReduction_32 happy_x_1-	 =  happyIn10-		 (Vis Abstract-	)--happyReduce_33 = happySpecReduce_0  4# happyReduction_33-happyReduction_33  =  happyIn10-		 (Vis Public-	)--happyReduce_34 = happySpecReduce_1  5# happyReduction_34-happyReduction_34 happy_x_1-	 =  happyIn11-		 (False-	)--happyReduce_35 = happySpecReduce_2  5# happyReduction_35-happyReduction_35 happy_x_2-	happy_x_1-	 =  happyIn11-		 (True-	)--happyReduce_36 = happySpecReduce_3  6# happyReduction_36-happyReduction_36 happy_x_3-	happy_x_2-	happy_x_1-	 =  case happyOut13 happy_x_2 of { happy_var_2 -> -	case happyOut12 happy_x_3 of { happy_var_3 -> -	happyIn12-		 (happy_var_2:happy_var_3-	)}}--happyReduce_37 = happySpecReduce_0  6# happyReduction_37-happyReduction_37  =  happyIn12-		 ([]-	)--happyReduce_38 = happySpecReduce_1  7# happyReduction_38-happyReduction_38 happy_x_1-	 =  case happyOut33 happy_x_1 of { happy_var_1 -> -	happyIn13-		 (happy_var_1-	)}--happyReduce_39 = happySpecReduce_1  7# happyReduction_39-happyReduction_39 happy_x_1-	 =  case happyOut58 happy_x_1 of { happy_var_1 -> -	happyIn13-		 (happy_var_1-	)}--happyReduce_40 = happySpecReduce_3  7# happyReduction_40-happyReduction_40 happy_x_3-	happy_x_2-	happy_x_1-	 =  case happyOut34 happy_x_2 of { happy_var_2 -> -	happyIn13-		 (happy_var_2-	)}--happyReduce_41 = happyReduce 5# 7# happyReduction_41-happyReduction_41 (happy_x_5 `HappyStk`-	happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOut59 happy_x_2 of { happy_var_2 -> -	case happyOut83 happy_x_4 of { happy_var_4 -> -	case happyOut82 happy_x_5 of { happy_var_5 -> -	happyIn13-		 (pairDesugar happy_var_4 happy_var_5 (RVar happy_var_4 happy_var_5 (UN "mkPair") Unknown) happy_var_2-	) `HappyStk` happyRest}}}--happyReduce_42 = happySpecReduce_2  8# happyReduction_42-happyReduction_42 happy_x_2-	happy_x_1-	 =  case happyOut9 happy_x_1 of { happy_var_1 -> -	case happyOut14 happy_x_2 of { happy_var_2 -> -	happyIn14-		 (happy_var_1:happy_var_2-	)}}--happyReduce_43 = happySpecReduce_1  8# happyReduction_43-happyReduction_43 happy_x_1-	 =  case happyOut9 happy_x_1 of { happy_var_1 -> -	happyIn14-		 ([happy_var_1]-	)}--happyReduce_44 = happySpecReduce_3  9# happyReduction_44-happyReduction_44 happy_x_3-	happy_x_2-	happy_x_1-	 =  case happyOut16 happy_x_2 of { happy_var_2 -> -	happyIn15-		 (happy_var_2-	)}--happyReduce_45 = happySpecReduce_0  9# happyReduction_45-happyReduction_45  =  happyIn15-		 ([]-	)--happyReduce_46 = happySpecReduce_0  10# happyReduction_46-happyReduction_46  =  happyIn16-		 ([]-	)--happyReduce_47 = happySpecReduce_2  10# happyReduction_47-happyReduction_47 happy_x_2-	happy_x_1-	 =  case happyOut17 happy_x_1 of { happy_var_1 -> -	case happyOut16 happy_x_2 of { happy_var_2 -> -	happyIn16-		 (happy_var_1 ++ happy_var_2-	)}}--happyReduce_48 = happySpecReduce_1  11# happyReduction_48-happyReduction_48 happy_x_1-	 =  happyIn17-		 ([NoCG]-	)--happyReduce_49 = happySpecReduce_1  11# happyReduction_49-happyReduction_49 happy_x_1-	 =  happyIn17-		 ([CGEval, Inline]-	)--happyReduce_50 = happyReduce 4# 11# happyReduction_50-happyReduction_50 (happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOut39 happy_x_3 of { happy_var_3 -> -	happyIn17-		 ([CGSpec happy_var_3]-	) `HappyStk` happyRest}--happyReduce_51 = happySpecReduce_1  11# happyReduction_51-happyReduction_51 happy_x_1-	 =  happyIn17-		 ([CGSpec []]-	)--happyReduce_52 = happySpecReduce_1  11# happyReduction_52-happyReduction_52 happy_x_1-	 =  happyIn17-		 ([Inline]-	)--happyReduce_53 = happySpecReduce_2  11# happyReduction_53-happyReduction_53 happy_x_2-	happy_x_1-	 =  case happyOutTok happy_x_2 of { (TokenString happy_var_2) -> -	happyIn17-		 ([CExport happy_var_2]-	)}--happyReduce_54 = happyReduce 4# 12# happyReduction_54-happyReduction_54 (happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOut21 happy_x_1 of { happy_var_1 -> -	case happyOutTok happy_x_2 of { (TokenInt happy_var_2) -> -	case happyOut19 happy_x_3 of { happy_var_3 -> -	happyIn18-		 (map (\x -> Fixity x happy_var_1 happy_var_2) happy_var_3-	) `HappyStk` happyRest}}}--happyReduce_55 = happySpecReduce_1  13# happyReduction_55-happyReduction_55 happy_x_1-	 =  case happyOut20 happy_x_1 of { happy_var_1 -> -	happyIn19-		 ([happy_var_1]-	)}--happyReduce_56 = happySpecReduce_3  13# happyReduction_56-happyReduction_56 happy_x_3-	happy_x_2-	happy_x_1-	 =  case happyOut20 happy_x_1 of { happy_var_1 -> -	case happyOut19 happy_x_3 of { happy_var_3 -> -	happyIn19-		 (happy_var_1:happy_var_3-	)}}--happyReduce_57 = happySpecReduce_1  14# happyReduction_57-happyReduction_57 happy_x_1-	 =  case happyOutTok happy_x_1 of { (TokenInfixName happy_var_1) -> -	happyIn20-		 (happy_var_1-	)}--happyReduce_58 = happySpecReduce_1  14# happyReduction_58-happyReduction_58 happy_x_1-	 =  happyIn20-		 ("-"-	)--happyReduce_59 = happySpecReduce_1  14# happyReduction_59-happyReduction_59 happy_x_1-	 =  happyIn20-		 ("<"-	)--happyReduce_60 = happySpecReduce_1  14# happyReduction_60-happyReduction_60 happy_x_1-	 =  happyIn20-		 (">"-	)--happyReduce_61 = happySpecReduce_1  15# happyReduction_61-happyReduction_61 happy_x_1-	 =  happyIn21-		 (LeftAssoc-	)--happyReduce_62 = happySpecReduce_1  15# happyReduction_62-happyReduction_62 happy_x_1-	 =  happyIn21-		 (RightAssoc-	)--happyReduce_63 = happySpecReduce_1  15# happyReduction_63-happyReduction_63 happy_x_1-	 =  happyIn21-		 (NonAssoc-	)--happyReduce_64 = happyReduce 4# 16# happyReduction_64-happyReduction_64 (happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOut23 happy_x_3 of { happy_var_3 -> -	happyIn22-		 (LatexDefs happy_var_3-	) `HappyStk` happyRest}--happyReduce_65 = happySpecReduce_3  17# happyReduction_65-happyReduction_65 happy_x_3-	happy_x_2-	happy_x_1-	 =  case happyOut32 happy_x_1 of { happy_var_1 -> -	case happyOutTok happy_x_3 of { (TokenString happy_var_3) -> -	happyIn23-		 ([(happy_var_1,happy_var_3)]-	)}}--happyReduce_66 = happyReduce 5# 17# happyReduction_66-happyReduction_66 (happy_x_5 `HappyStk`-	happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOut32 happy_x_1 of { happy_var_1 -> -	case happyOutTok happy_x_3 of { (TokenString happy_var_3) -> -	case happyOut23 happy_x_5 of { happy_var_5 -> -	happyIn23-		 ((happy_var_1,happy_var_3):happy_var_5-	) `HappyStk` happyRest}}}--happyReduce_67 = happySpecReduce_2  18# happyReduction_67-happyReduction_67 happy_x_2-	happy_x_1-	 =  case happyOut32 happy_x_1 of { happy_var_1 -> -	case happyOut25 happy_x_2 of { happy_var_2 -> -	happyIn24-		 ((happy_var_1, happy_var_2)-	)}}--happyReduce_68 = happySpecReduce_0  19# happyReduction_68-happyReduction_68  =  happyIn25-		 ([]-	)--happyReduce_69 = happySpecReduce_2  19# happyReduction_69-happyReduction_69 happy_x_2-	happy_x_1-	 =  case happyOut57 happy_x_1 of { happy_var_1 -> -	case happyOut25 happy_x_2 of { happy_var_2 -> -	happyIn25-		 ((happy_var_1,Nothing):happy_var_2-	)}}--happyReduce_70 = happyReduce 5# 19# happyReduction_70-happyReduction_70 (happy_x_5 `HappyStk`-	happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOutTok happy_x_1 of { (TokenBrackName happy_var_1) -> -	case happyOut25 happy_x_3 of { happy_var_3 -> -	case happyOut83 happy_x_4 of { happy_var_4 -> -	case happyOut82 happy_x_5 of { happy_var_5 -> -	happyIn25-		 ((RVar happy_var_4 happy_var_5 happy_var_1 Unknown, Just happy_var_1):happy_var_3-	) `HappyStk` happyRest}}}}--happyReduce_71 = happyReduce 5# 19# 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 happyOutTok happy_x_1 of { (TokenBrackName happy_var_1) -> -	case happyOut34 happy_x_3 of { happy_var_3 -> -	case happyOut25 happy_x_5 of { happy_var_5 -> -	happyIn25-		 ((happy_var_3, Just happy_var_1):happy_var_5-	) `HappyStk` happyRest}}}--happyReduce_72 = happyReduce 6# 20# happyReduction_72-happyReduction_72 (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 happyOut27 happy_x_1 of { happy_var_1 -> -	case happyOut29 happy_x_2 of { happy_var_2 -> -	case happyOut32 happy_x_3 of { happy_var_3 -> -	case happyOut28 happy_x_4 of { happy_var_4 -> -	case happyOut83 happy_x_5 of { happy_var_5 -> -	case happyOut82 happy_x_6 of { happy_var_6 -> -	happyIn26-		 (mkDatatype happy_var_1 happy_var_5 happy_var_6 happy_var_3 happy_var_4 happy_var_2-	) `HappyStk` happyRest}}}}}}--happyReduce_73 = happySpecReduce_1  21# happyReduction_73-happyReduction_73 happy_x_1-	 =  happyIn27-		 (False-	)--happyReduce_74 = happySpecReduce_1  21# happyReduction_74-happyReduction_74 happy_x_1-	 =  happyIn27-		 (True-	)--happyReduce_75 = happySpecReduce_3  22# happyReduction_75-happyReduction_75 happy_x_3-	happy_x_2-	happy_x_1-	 =  case happyOut66 happy_x_1 of { happy_var_1 -> -	case happyOut75 happy_x_2 of { happy_var_2 -> -	happyIn28-		 (Right (happy_var_1,happy_var_2)-	)}}--happyReduce_76 = happySpecReduce_3  22# happyReduction_76-happyReduction_76 happy_x_3-	happy_x_2-	happy_x_1-	 =  case happyOut50 happy_x_2 of { happy_var_2 -> -	happyIn28-		 (Left happy_var_2-	)}--happyReduce_77 = happySpecReduce_3  22# happyReduction_77-happyReduction_77 happy_x_3-	happy_x_2-	happy_x_1-	 =  case happyOut83 happy_x_2 of { happy_var_2 -> -	case happyOut82 happy_x_3 of { happy_var_3 -> -	happyIn28-		 (Left (RConst happy_var_2 happy_var_3 TYPE)-	)}}--happyReduce_78 = happySpecReduce_0  23# happyReduction_78-happyReduction_78  =  happyIn29-		 ([]-	)--happyReduce_79 = happySpecReduce_3  23# happyReduction_79-happyReduction_79 happy_x_3-	happy_x_2-	happy_x_1-	 =  case happyOut30 happy_x_2 of { happy_var_2 -> -	happyIn29-		 (happy_var_2-	)}--happyReduce_80 = happySpecReduce_1  24# happyReduction_80-happyReduction_80 happy_x_1-	 =  case happyOut31 happy_x_1 of { happy_var_1 -> -	happyIn30-		 ([happy_var_1]-	)}--happyReduce_81 = happySpecReduce_3  24# happyReduction_81-happyReduction_81 happy_x_3-	happy_x_2-	happy_x_1-	 =  case happyOut31 happy_x_1 of { happy_var_1 -> -	case happyOut30 happy_x_3 of { happy_var_3 -> -	happyIn30-		 (happy_var_1:happy_var_3-	)}}--happyReduce_82 = happySpecReduce_1  25# happyReduction_82-happyReduction_82 happy_x_1-	 =  happyIn31-		 (NoElim-	)--happyReduce_83 = happySpecReduce_1  25# happyReduction_83-happyReduction_83 happy_x_1-	 =  happyIn31-		 (Collapsible-	)--happyReduce_84 = happySpecReduce_1  26# happyReduction_84-happyReduction_84 happy_x_1-	 =  case happyOutTok happy_x_1 of { (TokenName happy_var_1) -> -	happyIn32-		 (happy_var_1-	)}--happyReduce_85 = happySpecReduce_3  26# happyReduction_85-happyReduction_85 happy_x_3-	happy_x_2-	happy_x_1-	 =  case happyOut20 happy_x_2 of { happy_var_2 -> -	happyIn32-		 (useropFn happy_var_2-	)}--happyReduce_86 = happyReduce 4# 27# happyReduction_86-happyReduction_86 (happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOut33 happy_x_1 of { happy_var_1 -> -	case happyOut83 happy_x_2 of { happy_var_2 -> -	case happyOut82 happy_x_3 of { happy_var_3 -> -	case happyOut57 happy_x_4 of { happy_var_4 -> -	happyIn33-		 (RApp happy_var_2 happy_var_3 happy_var_1 happy_var_4-	) `HappyStk` happyRest}}}}--happyReduce_87 = happyReduce 5# 27# happyReduction_87-happyReduction_87 (happy_x_5 `HappyStk`-	happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOut33 happy_x_1 of { happy_var_1 -> -	case happyOut43 happy_x_2 of { happy_var_2 -> -	case happyOut83 happy_x_4 of { happy_var_4 -> -	case happyOut82 happy_x_5 of { happy_var_5 -> -	happyIn33-		 (RAppImp happy_var_4 happy_var_5 (fst happy_var_2) happy_var_1 (snd happy_var_2)-	) `HappyStk` happyRest}}}}--happyReduce_88 = happySpecReduce_3  27# happyReduction_88-happyReduction_88 happy_x_3-	happy_x_2-	happy_x_1-	 =  case happyOut32 happy_x_1 of { happy_var_1 -> -	case happyOut83 happy_x_2 of { happy_var_2 -> -	case happyOut82 happy_x_3 of { happy_var_3 -> -	happyIn33-		 (RVar happy_var_2 happy_var_3 happy_var_1 Unknown-	)}}}--happyReduce_89 = happySpecReduce_3  27# happyReduction_89-happyReduction_89 happy_x_3-	happy_x_2-	happy_x_1-	 =  case happyOut64 happy_x_1 of { happy_var_1 -> -	case happyOut83 happy_x_2 of { happy_var_2 -> -	case happyOut82 happy_x_3 of { happy_var_3 -> -	happyIn33-		 (RConst happy_var_2 happy_var_3 happy_var_1-	)}}}--happyReduce_90 = happySpecReduce_1  27# happyReduction_90-happyReduction_90 happy_x_1-	 =  happyIn33-		 (RPlaceholder-	)--happyReduce_91 = happySpecReduce_3  27# happyReduction_91-happyReduction_91 happy_x_3-	happy_x_2-	happy_x_1-	 =  case happyOut83 happy_x_2 of { happy_var_2 -> -	case happyOut82 happy_x_3 of { happy_var_3 -> -	happyIn33-		 (RVar happy_var_2 happy_var_3 (UN "__Empty") TypeCon-	)}}--happyReduce_92 = happySpecReduce_3  27# happyReduction_92-happyReduction_92 happy_x_3-	happy_x_2-	happy_x_1-	 =  case happyOut83 happy_x_2 of { happy_var_2 -> -	case happyOut82 happy_x_3 of { happy_var_3 -> -	happyIn33-		 (RVar happy_var_2 happy_var_3 (UN "__Unit") TypeCon-	)}}--happyReduce_93 = happySpecReduce_1  28# happyReduction_93-happyReduction_93 happy_x_1-	 =  case happyOut57 happy_x_1 of { happy_var_1 -> -	happyIn34-		 (happy_var_1-	)}--happyReduce_94 = happySpecReduce_3  28# happyReduction_94-happyReduction_94 happy_x_3-	happy_x_2-	happy_x_1-	 =  case happyOut50 happy_x_2 of { happy_var_2 -> -	happyIn34-		 (happy_var_2-	)}--happyReduce_95 = happyReduce 4# 28# happyReduction_95-happyReduction_95 (happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOut34 happy_x_1 of { happy_var_1 -> -	case happyOut83 happy_x_2 of { happy_var_2 -> -	case happyOut82 happy_x_3 of { happy_var_3 -> -	case happyOut57 happy_x_4 of { happy_var_4 -> -	happyIn34-		 (RApp happy_var_2 happy_var_3 happy_var_1 happy_var_4-	) `HappyStk` happyRest}}}}--happyReduce_96 = happyReduce 5# 28# happyReduction_96-happyReduction_96 (happy_x_5 `HappyStk`-	happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOut34 happy_x_1 of { happy_var_1 -> -	case happyOut43 happy_x_2 of { happy_var_2 -> -	case happyOut83 happy_x_4 of { happy_var_4 -> -	case happyOut82 happy_x_5 of { happy_var_5 -> -	happyIn34-		 (RAppImp happy_var_4 happy_var_5 (fst happy_var_2) happy_var_1 (snd happy_var_2)-	) `HappyStk` happyRest}}}}--happyReduce_97 = happyReduce 4# 28# happyReduction_97-happyReduction_97 (happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOut34 happy_x_2 of { happy_var_2 -> -	case happyOut83 happy_x_3 of { happy_var_3 -> -	case happyOut82 happy_x_4 of { happy_var_4 -> -	happyIn34-		 (RApp happy_var_3 happy_var_4 (RApp happy_var_3 happy_var_4 (RVar happy_var_3 happy_var_4 (UN "__lazy") Free) RPlaceholder) happy_var_2-	) `HappyStk` happyRest}}}--happyReduce_98 = happyReduce 4# 28# happyReduction_98-happyReduction_98 (happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOut35 happy_x_2 of { happy_var_2 -> -	case happyOut34 happy_x_4 of { happy_var_4 -> -	happyIn34-		 (doBind Lam happy_var_2 happy_var_4-	) `HappyStk` happyRest}}--happyReduce_99 = happyReduce 4# 28# happyReduction_99-happyReduction_99 (happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOut42 happy_x_2 of { happy_var_2 -> -	case happyOut34 happy_x_4 of { happy_var_4 -> -	happyIn34-		 (doLetBind happy_var_2 happy_var_4-	) `HappyStk` happyRest}}--happyReduce_100 = happySpecReduce_1  28# happyReduction_100-happyReduction_100 happy_x_1-	 =  case happyOut44 happy_x_1 of { happy_var_1 -> -	happyIn34-		 (happy_var_1-	)}--happyReduce_101 = happyReduce 8# 28# happyReduction_101-happyReduction_101 (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 happyOut34 happy_x_2 of { happy_var_2 -> -	case happyOut34 happy_x_4 of { happy_var_4 -> -	case happyOut34 happy_x_6 of { happy_var_6 -> -	case happyOut83 happy_x_7 of { happy_var_7 -> -	case happyOut82 happy_x_8 of { happy_var_8 -> -	happyIn34-		 (mkApp happy_var_7 happy_var_8 (RVar happy_var_7 happy_var_8 (UN "if_then_else") Free) [happy_var_2,happy_var_4,happy_var_6]-	) `HappyStk` happyRest}}}}}--happyReduce_102 = happySpecReduce_2  29# happyReduction_102-happyReduction_102 happy_x_2-	happy_x_1-	 =  case happyOut32 happy_x_1 of { happy_var_1 -> -	case happyOut48 happy_x_2 of { happy_var_2 -> -	happyIn35-		 ([(happy_var_1,happy_var_2)]-	)}}--happyReduce_103 = happyReduce 4# 29# happyReduction_103-happyReduction_103 (happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOut32 happy_x_1 of { happy_var_1 -> -	case happyOut48 happy_x_2 of { happy_var_2 -> -	case happyOut35 happy_x_4 of { happy_var_4 -> -	happyIn35-		 ((happy_var_1,happy_var_2):happy_var_4-	) `HappyStk` happyRest}}}--happyReduce_104 = happySpecReduce_3  30# happyReduction_104-happyReduction_104 happy_x_3-	happy_x_2-	happy_x_1-	 =  case happyOut37 happy_x_1 of { happy_var_1 -> -	case happyOut36 happy_x_3 of { happy_var_3 -> -	happyIn36-		 (happy_var_1 ++ happy_var_3-	)}}--happyReduce_105 = happySpecReduce_1  30# happyReduction_105-happyReduction_105 happy_x_1-	 =  case happyOut37 happy_x_1 of { happy_var_1 -> -	happyIn36-		 (happy_var_1-	)}--happyReduce_106 = happySpecReduce_3  31# happyReduction_106-happyReduction_106 happy_x_3-	happy_x_2-	happy_x_1-	 =  case happyOut32 happy_x_1 of { happy_var_1 -> -	case happyOut50 happy_x_3 of { happy_var_3 -> -	happyIn37-		 (map ( \x -> (x,happy_var_3)) [happy_var_1]-	)}}--happyReduce_107 = happySpecReduce_1  32# happyReduction_107-happyReduction_107 happy_x_1-	 =  case happyOut32 happy_x_1 of { happy_var_1 -> -	happyIn38-		 ([happy_var_1]-	)}--happyReduce_108 = happySpecReduce_3  32# happyReduction_108-happyReduction_108 happy_x_3-	happy_x_2-	happy_x_1-	 =  case happyOut32 happy_x_1 of { happy_var_1 -> -	case happyOut38 happy_x_3 of { happy_var_3 -> -	happyIn38-		 (happy_var_1:happy_var_3-	)}}--happyReduce_109 = happySpecReduce_2  33# happyReduction_109-happyReduction_109 happy_x_2-	happy_x_1-	 =  case happyOut32 happy_x_1 of { happy_var_1 -> -	case happyOutTok happy_x_2 of { (TokenInt happy_var_2) -> -	happyIn39-		 ([(happy_var_1,happy_var_2)]-	)}}--happyReduce_110 = happySpecReduce_1  33# happyReduction_110-happyReduction_110 happy_x_1-	 =  case happyOut32 happy_x_1 of { happy_var_1 -> -	happyIn39-		 ([(happy_var_1, 0)]-	)}--happyReduce_111 = happySpecReduce_3  33# happyReduction_111-happyReduction_111 happy_x_3-	happy_x_2-	happy_x_1-	 =  case happyOut32 happy_x_1 of { happy_var_1 -> -	case happyOut39 happy_x_3 of { happy_var_3 -> -	happyIn39-		 ((happy_var_1,0):happy_var_3-	)}}--happyReduce_112 = happyReduce 4# 33# happyReduction_112-happyReduction_112 (happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOut32 happy_x_1 of { happy_var_1 -> -	case happyOutTok happy_x_2 of { (TokenInt happy_var_2) -> -	case happyOut39 happy_x_4 of { happy_var_4 -> -	happyIn39-		 ((happy_var_1,happy_var_2):happy_var_4-	) `HappyStk` happyRest}}}--happyReduce_113 = happySpecReduce_1  34# happyReduction_113-happyReduction_113 happy_x_1-	 =  case happyOutTok happy_x_1 of { (TokenBrackName happy_var_1) -> -	happyIn40-		 ([happy_var_1]-	)}--happyReduce_114 = happySpecReduce_3  34# happyReduction_114-happyReduction_114 happy_x_3-	happy_x_2-	happy_x_1-	 =  case happyOutTok happy_x_1 of { (TokenBrackName happy_var_1) -> -	case happyOut38 happy_x_3 of { happy_var_3 -> -	happyIn40-		 (happy_var_1:happy_var_3-	)}}--happyReduce_115 = happySpecReduce_0  35# happyReduction_115-happyReduction_115  =  happyIn41-		 ([]-	)--happyReduce_116 = happySpecReduce_2  35# happyReduction_116-happyReduction_116 happy_x_2-	happy_x_1-	 =  case happyOut32 happy_x_1 of { happy_var_1 -> -	case happyOut41 happy_x_2 of { happy_var_2 -> -	happyIn41-		 (happy_var_1:happy_var_2-	)}}--happyReduce_117 = happyReduce 4# 36# happyReduction_117-happyReduction_117 (happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOut32 happy_x_1 of { happy_var_1 -> -	case happyOut48 happy_x_2 of { happy_var_2 -> -	case happyOut34 happy_x_4 of { happy_var_4 -> -	happyIn42-		 ([(happy_var_1,happy_var_2,happy_var_4)]-	) `HappyStk` happyRest}}}--happyReduce_118 = happyReduce 6# 36# happyReduction_118-happyReduction_118 (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 happyOut32 happy_x_1 of { happy_var_1 -> -	case happyOut48 happy_x_2 of { happy_var_2 -> -	case happyOut34 happy_x_4 of { happy_var_4 -> -	case happyOut42 happy_x_6 of { happy_var_6 -> -	happyIn42-		 ((happy_var_1,happy_var_2,happy_var_4):happy_var_6-	) `HappyStk` happyRest}}}}--happyReduce_119 = happySpecReduce_3  37# happyReduction_119-happyReduction_119 happy_x_3-	happy_x_2-	happy_x_1-	 =  case happyOutTok happy_x_1 of { (TokenBrackName happy_var_1) -> -	case happyOut83 happy_x_2 of { happy_var_2 -> -	case happyOut82 happy_x_3 of { happy_var_3 -> -	happyIn43-		 ((happy_var_1, RVar happy_var_2 happy_var_3 happy_var_1 Unknown)-	)}}}--happyReduce_120 = happySpecReduce_3  37# happyReduction_120-happyReduction_120 happy_x_3-	happy_x_2-	happy_x_1-	 =  case happyOutTok happy_x_1 of { (TokenBrackName happy_var_1) -> -	case happyOut34 happy_x_3 of { happy_var_3 -> -	happyIn43-		 ((happy_var_1, happy_var_3)-	)}}--happyReduce_121 = happyReduce 4# 38# happyReduction_121-happyReduction_121 (happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOut34 happy_x_2 of { happy_var_2 -> -	case happyOut83 happy_x_3 of { happy_var_3 -> -	case happyOut82 happy_x_4 of { happy_var_4 -> -	happyIn44-		 (RInfix happy_var_3 happy_var_4 Minus (RConst happy_var_3 happy_var_4 (Num 0)) happy_var_2-	) `HappyStk` happyRest}}}--happyReduce_122 = happyReduce 5# 38# happyReduction_122-happyReduction_122 (happy_x_5 `HappyStk`-	happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOut34 happy_x_1 of { happy_var_1 -> -	case happyOut34 happy_x_3 of { happy_var_3 -> -	case happyOut83 happy_x_4 of { happy_var_4 -> -	case happyOut82 happy_x_5 of { happy_var_5 -> -	happyIn44-		 (RUserInfix happy_var_4 happy_var_5 False "-" happy_var_1 happy_var_3-	) `HappyStk` happyRest}}}}--happyReduce_123 = happyReduce 5# 38# happyReduction_123-happyReduction_123 (happy_x_5 `HappyStk`-	happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOut34 happy_x_1 of { happy_var_1 -> -	case happyOut34 happy_x_3 of { happy_var_3 -> -	case happyOut83 happy_x_4 of { happy_var_4 -> -	case happyOut82 happy_x_5 of { happy_var_5 -> -	happyIn44-		 (mkApp happy_var_4 happy_var_5 (RVar happy_var_4 happy_var_5 (UN "Pair") TypeCon) [happy_var_1, happy_var_3]-	) `HappyStk` happyRest}}}}--happyReduce_124 = happyReduce 5# 38# happyReduction_124-happyReduction_124 (happy_x_5 `HappyStk`-	happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOut34 happy_x_1 of { happy_var_1 -> -	case happyOut34 happy_x_3 of { happy_var_3 -> -	case happyOut83 happy_x_4 of { happy_var_4 -> -	case happyOut82 happy_x_5 of { happy_var_5 -> -	happyIn44-		 (RUserInfix happy_var_4 happy_var_5 False "<" happy_var_1 happy_var_3-	) `HappyStk` happyRest}}}}--happyReduce_125 = happyReduce 5# 38# happyReduction_125-happyReduction_125 (happy_x_5 `HappyStk`-	happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOut34 happy_x_1 of { happy_var_1 -> -	case happyOut34 happy_x_3 of { happy_var_3 -> -	case happyOut83 happy_x_4 of { happy_var_4 -> -	case happyOut82 happy_x_5 of { happy_var_5 -> -	happyIn44-		 (RUserInfix happy_var_4 happy_var_5 False ">" happy_var_1 happy_var_3-	) `HappyStk` happyRest}}}}--happyReduce_126 = happyReduce 5# 38# happyReduction_126-happyReduction_126 (happy_x_5 `HappyStk`-	happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOut34 happy_x_1 of { happy_var_1 -> -	case happyOut34 happy_x_3 of { happy_var_3 -> -	happyIn44-		 (RBind (MN "X" 0) (Pi Ex [] happy_var_1) happy_var_3-	) `HappyStk` happyRest}}--happyReduce_127 = happySpecReduce_1  38# happyReduction_127-happyReduction_127 happy_x_1-	 =  case happyOut45 happy_x_1 of { happy_var_1 -> -	happyIn44-		 (happy_var_1-	)}--happyReduce_128 = happyReduce 5# 38# happyReduction_128-happyReduction_128 (happy_x_5 `HappyStk`-	happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOut57 happy_x_1 of { happy_var_1 -> -	case happyOut57 happy_x_3 of { happy_var_3 -> -	case happyOut83 happy_x_4 of { happy_var_4 -> -	case happyOut82 happy_x_5 of { happy_var_5 -> -	happyIn44-		 (RInfix happy_var_4 happy_var_5 JMEq happy_var_1 happy_var_3-	) `HappyStk` happyRest}}}}--happyReduce_129 = happyReduce 5# 39# happyReduction_129-happyReduction_129 (happy_x_5 `HappyStk`-	happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOut34 happy_x_1 of { happy_var_1 -> -	case happyOutTok happy_x_2 of { (TokenInfixName happy_var_2) -> -	case happyOut34 happy_x_3 of { happy_var_3 -> -	case happyOut83 happy_x_4 of { happy_var_4 -> -	case happyOut82 happy_x_5 of { happy_var_5 -> -	happyIn45-		 (RUserInfix happy_var_4 happy_var_5 False happy_var_2 happy_var_1 happy_var_3-	) `HappyStk` happyRest}}}}}--happyReduce_130 = happyReduce 6# 40# happyReduction_130-happyReduction_130 (happy_x_6 `HappyStk`-	happy_x_5 `HappyStk`-	happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOutTok happy_x_2 of { (TokenInfixName happy_var_2) -> -	case happyOut34 happy_x_3 of { happy_var_3 -> -	case happyOut83 happy_x_4 of { happy_var_4 -> -	case happyOut82 happy_x_5 of { happy_var_5 -> -	happyIn46-		 (RBind (MN "X" 0) (Lam RPlaceholder) -                       (RUserInfix happy_var_4 happy_var_5 False happy_var_2 (RVar happy_var_4 happy_var_5 (MN "X" 0) Unknown) happy_var_3)-	) `HappyStk` happyRest}}}}--happyReduce_131 = happyReduce 6# 40# happyReduction_131-happyReduction_131 (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 happyOut34 happy_x_2 of { happy_var_2 -> -	case happyOutTok happy_x_3 of { (TokenInfixName happy_var_3) -> -	case happyOut83 happy_x_4 of { happy_var_4 -> -	case happyOut82 happy_x_5 of { happy_var_5 -> -	happyIn46-		 (RBind (MN "X" 0) (Lam RPlaceholder) -                       (RUserInfix happy_var_4 happy_var_5 False happy_var_3 happy_var_2 (RVar happy_var_4 happy_var_5 (MN "X" 0) Unknown))-	) `HappyStk` happyRest}}}}--happyReduce_132 = happyReduce 6# 40# happyReduction_132-happyReduction_132 (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 happyOut47 happy_x_2 of { happy_var_2 -> -	case happyOut34 happy_x_3 of { happy_var_3 -> -	case happyOut83 happy_x_4 of { happy_var_4 -> -	case happyOut82 happy_x_5 of { happy_var_5 -> -	happyIn46-		 (RBind (MN "X" 0) (Lam RPlaceholder) -                       (RUserInfix happy_var_4 happy_var_5 False happy_var_2 (RVar happy_var_4 happy_var_5 (MN "X" 0) Unknown) happy_var_3)-	) `HappyStk` happyRest}}}}--happyReduce_133 = happyReduce 6# 40# happyReduction_133-happyReduction_133 (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 happyOut34 happy_x_2 of { happy_var_2 -> -	case happyOut47 happy_x_3 of { happy_var_3 -> -	case happyOut83 happy_x_4 of { happy_var_4 -> -	case happyOut82 happy_x_5 of { happy_var_5 -> -	happyIn46-		 (RBind (MN "X" 0) (Lam RPlaceholder) -                       (RUserInfix happy_var_4 happy_var_5 False happy_var_3 happy_var_2 (RVar happy_var_4 happy_var_5 (MN "X" 0) Unknown))-	) `HappyStk` happyRest}}}}--happyReduce_134 = happyReduce 6# 40# happyReduction_134-happyReduction_134 (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 happyOut34 happy_x_2 of { happy_var_2 -> -	case happyOut83 happy_x_4 of { happy_var_4 -> -	case happyOut82 happy_x_5 of { happy_var_5 -> -	happyIn46-		 (RBind (MN "X" 0) (Lam RPlaceholder) -                       (RUserInfix happy_var_4 happy_var_5 False "-" happy_var_2 (RVar happy_var_4 happy_var_5 (MN "X" 0) Unknown))-	) `HappyStk` happyRest}}}--happyReduce_135 = happyReduce 6# 40# happyReduction_135-happyReduction_135 (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 happyOut34 happy_x_2 of { happy_var_2 -> -	case happyOut83 happy_x_4 of { happy_var_4 -> -	case happyOut82 happy_x_5 of { happy_var_5 -> -	happyIn46-		 (RBind (MN "X" 0) (Lam RPlaceholder) -                       (RBind (MN "X" 1) (Pi Ex [] happy_var_2) (RVar happy_var_4 happy_var_5 (MN "X" 0) Unknown))-	) `HappyStk` happyRest}}}--happyReduce_136 = happyReduce 6# 40# happyReduction_136-happyReduction_136 (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 happyOut34 happy_x_3 of { happy_var_3 -> -	case happyOut83 happy_x_4 of { happy_var_4 -> -	case happyOut82 happy_x_5 of { happy_var_5 -> -	happyIn46-		 (RBind (MN "X" 0) (Lam RPlaceholder) -                       (RBind (MN "X" 1) (Pi Ex [] (RVar happy_var_4 happy_var_5 (MN "X" 0) Unknown)) happy_var_3)-	) `HappyStk` happyRest}}}--happyReduce_137 = happyReduce 5# 40# happyReduction_137-happyReduction_137 (happy_x_5 `HappyStk`-	happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOut83 happy_x_3 of { happy_var_3 -> -	case happyOut82 happy_x_4 of { happy_var_4 -> -	happyIn46-		 (RBind (MN "X" 0) (Lam RPlaceholder)-                       (RBind (MN "X" 1) (Lam RPlaceholder)-                    (RBind (MN "X" 2) (Pi Ex [] (RVar happy_var_3 happy_var_4 (MN "X" 0) Unknown))-                       (RVar happy_var_3 happy_var_4 (MN "X" 1) Unknown)))-	) `HappyStk` happyRest}}--happyReduce_138 = happyReduce 5# 40# happyReduction_138-happyReduction_138 (happy_x_5 `HappyStk`-	happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOut83 happy_x_3 of { happy_var_3 -> -	case happyOut82 happy_x_4 of { happy_var_4 -> -	happyIn46-		 (RBind (MN "X" 0) (Lam RPlaceholder)-                   (RBind (MN "X" 1) (Lam RPlaceholder)-                       (pairDesugar happy_var_3 happy_var_4 (RVar happy_var_3 happy_var_4 (UN "mkPair") DataCon)-                                    [RVar happy_var_3 happy_var_4 (MN "X" 0) Unknown,-                                     RVar happy_var_3 happy_var_4 (MN "X" 1) Unknown]))-	) `HappyStk` happyRest}}--happyReduce_139 = happyReduce 6# 40# happyReduction_139-happyReduction_139 (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 happyOut34 happy_x_2 of { happy_var_2 -> -	case happyOut83 happy_x_4 of { happy_var_4 -> -	case happyOut82 happy_x_5 of { happy_var_5 -> -	happyIn46-		 (RBind (MN "X" 0) (Lam RPlaceholder)-                       (pairDesugar happy_var_4 happy_var_5 (RVar happy_var_4 happy_var_5 (UN "mkPair") DataCon)-                                    [happy_var_2,-                                     RVar happy_var_4 happy_var_5 (MN "X" 0) Unknown])-	) `HappyStk` happyRest}}}--happyReduce_140 = happyReduce 6# 40# happyReduction_140-happyReduction_140 (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 happyOut34 happy_x_3 of { happy_var_3 -> -	case happyOut83 happy_x_4 of { happy_var_4 -> -	case happyOut82 happy_x_5 of { happy_var_5 -> -	happyIn46-		 (RBind (MN "X" 0) (Lam RPlaceholder)-                       (pairDesugar happy_var_4 happy_var_5 (RVar happy_var_4 happy_var_5 (UN "mkPair") DataCon)-                                    [RVar happy_var_4 happy_var_5 (MN "X" 0) Unknown, happy_var_3])-	) `HappyStk` happyRest}}}--happyReduce_141 = happySpecReduce_1  41# happyReduction_141-happyReduction_141 happy_x_1-	 =  happyIn47-		 ("<"-	)--happyReduce_142 = happySpecReduce_1  41# happyReduction_142-happyReduction_142 happy_x_1-	 =  happyIn47-		 (">"-	)--happyReduce_143 = happySpecReduce_0  42# happyReduction_143-happyReduction_143  =  happyIn48-		 (RPlaceholder-	)--happyReduce_144 = happySpecReduce_2  42# happyReduction_144-happyReduction_144 happy_x_2-	happy_x_1-	 =  case happyOut51 happy_x_2 of { happy_var_2 -> -	happyIn48-		 (happy_var_2-	)}--happyReduce_145 = happySpecReduce_0  43# happyReduction_145-happyReduction_145  =  happyIn49-		 (RPlaceholder-	)--happyReduce_146 = happySpecReduce_2  43# happyReduction_146-happyReduction_146 happy_x_2-	happy_x_1-	 =  case happyOut51 happy_x_2 of { happy_var_2 -> -	happyIn49-		 (happy_var_2-	)}--happyReduce_147 = happyReduce 5# 44# happyReduction_147-happyReduction_147 (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_1 of { happy_var_1 -> -	case happyOut49 happy_x_2 of { happy_var_2 -> -	case happyOut50 happy_x_5 of { happy_var_5 -> -	happyIn50-		 (doBind (Pi Im []) (map (\x -> (x, happy_var_2)) happy_var_1) happy_var_5-	) `HappyStk` happyRest}}}--happyReduce_148 = happySpecReduce_1  44# happyReduction_148-happyReduction_148 happy_x_1-	 =  case happyOut51 happy_x_1 of { happy_var_1 -> -	happyIn50-		 (happy_var_1-	)}--happyReduce_149 = happySpecReduce_3  45# happyReduction_149-happyReduction_149 happy_x_3-	happy_x_2-	happy_x_1-	 =  case happyOut51 happy_x_1 of { happy_var_1 -> -	case happyOut51 happy_x_3 of { happy_var_3 -> -	happyIn51-		 (RBind (MN "X" 0) (Pi Ex [] happy_var_1) happy_var_3-	)}}--happyReduce_150 = happyReduce 6# 45# happyReduction_150-happyReduction_150 (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 happyOut36 happy_x_2 of { happy_var_2 -> -	case happyOut53 happy_x_4 of { happy_var_4 -> -	case happyOut51 happy_x_6 of { happy_var_6 -> -	happyIn51-		 (doBind (Pi Ex happy_var_4) happy_var_2 happy_var_6-	) `HappyStk` happyRest}}}--happyReduce_151 = happyReduce 5# 45# happyReduction_151-happyReduction_151 (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_2 of { happy_var_2 -> -	case happyOut51 happy_x_5 of { happy_var_5 -> -	happyIn51-		 (doBind (Pi Ex [Lazy]) happy_var_2 happy_var_5-	) `HappyStk` happyRest}}--happyReduce_152 = happySpecReduce_3  45# happyReduction_152-happyReduction_152 happy_x_3-	happy_x_2-	happy_x_1-	 =  case happyOut51 happy_x_2 of { happy_var_2 -> -	happyIn51-		 (bracket happy_var_2-	)}--happyReduce_153 = happyReduce 7# 45# happyReduction_153-happyReduction_153 (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 happyOut51 happy_x_2 of { happy_var_2 -> -	case happyOut51 happy_x_4 of { happy_var_4 -> -	case happyOut83 happy_x_5 of { happy_var_5 -> -	case happyOut82 happy_x_6 of { happy_var_6 -> -	happyIn51-		 (RInfix happy_var_5 happy_var_6 JMEq happy_var_2 happy_var_4-	) `HappyStk` happyRest}}}}--happyReduce_154 = happySpecReduce_1  45# happyReduction_154-happyReduction_154 happy_x_1-	 =  case happyOut33 happy_x_1 of { happy_var_1 -> -	happyIn51-		 (happy_var_1-	)}--happyReduce_155 = happySpecReduce_3  45# happyReduction_155-happyReduction_155 happy_x_3-	happy_x_2-	happy_x_1-	 =  case happyOut34 happy_x_2 of { happy_var_2 -> -	happyIn51-		 (happy_var_2-	)}--happyReduce_156 = happyReduce 5# 45# happyReduction_156-happyReduction_156 (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_1 of { happy_var_1 -> -	case happyOutTok happy_x_2 of { (TokenInfixName happy_var_2) -> -	case happyOut51 happy_x_3 of { happy_var_3 -> -	case happyOut83 happy_x_4 of { happy_var_4 -> -	case happyOut82 happy_x_5 of { happy_var_5 -> -	happyIn51-		 (RUserInfix happy_var_4 happy_var_5 False happy_var_2 happy_var_1 happy_var_3-	) `HappyStk` happyRest}}}}}--happyReduce_157 = happyReduce 5# 45# happyReduction_157-happyReduction_157 (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_1 of { happy_var_1 -> -	case happyOut51 happy_x_3 of { happy_var_3 -> -	case happyOut83 happy_x_4 of { happy_var_4 -> -	case happyOut82 happy_x_5 of { happy_var_5 -> -	happyIn51-		 (RUserInfix happy_var_4 happy_var_5 False "-" happy_var_1 happy_var_3-	) `HappyStk` happyRest}}}}--happyReduce_158 = happyReduce 5# 45# happyReduction_158-happyReduction_158 (happy_x_5 `HappyStk`-	happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOut56 happy_x_2 of { happy_var_2 -> -	case happyOut83 happy_x_4 of { happy_var_4 -> -	case happyOut82 happy_x_5 of { happy_var_5 -> -	happyIn51-		 (pairDesugar happy_var_4 happy_var_5 (RVar happy_var_4 happy_var_5 (UN "Pair") TypeCon) happy_var_2-	) `HappyStk` happyRest}}}--happyReduce_159 = happySpecReduce_1  45# happyReduction_159-happyReduction_159 happy_x_1-	 =  case happyOut55 happy_x_1 of { happy_var_1 -> -	happyIn51-		 (happy_var_1-	)}--happyReduce_160 = happySpecReduce_1  46# happyReduction_160-happyReduction_160 happy_x_1-	 =  happyIn52-		 (Lazy-	)--happyReduce_161 = happySpecReduce_1  46# happyReduction_161-happyReduction_161 happy_x_1-	 =  happyIn52-		 (Static-	)--happyReduce_162 = happySpecReduce_3  47# happyReduction_162-happyReduction_162 happy_x_3-	happy_x_2-	happy_x_1-	 =  case happyOut54 happy_x_2 of { happy_var_2 -> -	happyIn53-		 (happy_var_2-	)}--happyReduce_163 = happySpecReduce_0  47# happyReduction_163-happyReduction_163  =  happyIn53-		 ([]-	)--happyReduce_164 = happySpecReduce_3  48# happyReduction_164-happyReduction_164 happy_x_3-	happy_x_2-	happy_x_1-	 =  case happyOut52 happy_x_1 of { happy_var_1 -> -	case happyOut54 happy_x_3 of { happy_var_3 -> -	happyIn54-		 (happy_var_1:happy_var_3-	)}}--happyReduce_165 = happySpecReduce_1  48# happyReduction_165-happyReduction_165 happy_x_1-	 =  case happyOut52 happy_x_1 of { happy_var_1 -> -	happyIn54-		 ([happy_var_1]-	)}--happyReduce_166 = happyReduce 8# 49# happyReduction_166-happyReduction_166 (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 happyOut32 happy_x_2 of { happy_var_2 -> -	case happyOut48 happy_x_3 of { happy_var_3 -> -	case happyOut51 happy_x_5 of { happy_var_5 -> -	case happyOut83 happy_x_7 of { happy_var_7 -> -	case happyOut82 happy_x_8 of { happy_var_8 -> -	happyIn55-		 (sigDesugar happy_var_7 happy_var_8 (happy_var_2, happy_var_3) happy_var_5-	) `HappyStk` happyRest}}}}}--happyReduce_167 = happySpecReduce_3  50# happyReduction_167-happyReduction_167 happy_x_3-	happy_x_2-	happy_x_1-	 =  case happyOut51 happy_x_1 of { happy_var_1 -> -	case happyOut51 happy_x_3 of { happy_var_3 -> -	happyIn56-		 (happy_var_1:happy_var_3:[]-	)}}--happyReduce_168 = happySpecReduce_3  50# happyReduction_168-happyReduction_168 happy_x_3-	happy_x_2-	happy_x_1-	 =  case happyOut51 happy_x_1 of { happy_var_1 -> -	case happyOut56 happy_x_3 of { happy_var_3 -> -	happyIn56-		 (happy_var_1:happy_var_3-	)}}--happyReduce_169 = happySpecReduce_3  51# happyReduction_169-happyReduction_169 happy_x_3-	happy_x_2-	happy_x_1-	 =  case happyOut32 happy_x_1 of { happy_var_1 -> -	case happyOut83 happy_x_2 of { happy_var_2 -> -	case happyOut82 happy_x_3 of { happy_var_3 -> -	happyIn57-		 (RVar happy_var_2 happy_var_3 happy_var_1 Unknown-	)}}}--happyReduce_170 = happySpecReduce_3  51# happyReduction_170-happyReduction_170 happy_x_3-	happy_x_2-	happy_x_1-	 =  case happyOut83 happy_x_2 of { happy_var_2 -> -	case happyOut82 happy_x_3 of { happy_var_3 -> -	happyIn57-		 (RReturn happy_var_2 happy_var_3-	)}}--happyReduce_171 = happySpecReduce_3  51# happyReduction_171-happyReduction_171 happy_x_3-	happy_x_2-	happy_x_1-	 =  case happyOut34 happy_x_2 of { happy_var_2 -> -	happyIn57-		 (bracket happy_var_2-	)}--happyReduce_172 = happySpecReduce_2  51# happyReduction_172-happyReduction_172 happy_x_2-	happy_x_1-	 =  case happyOut57 happy_x_2 of { happy_var_2 -> -	happyIn57-		 (RPure happy_var_2-	)}--happyReduce_173 = happySpecReduce_1  51# happyReduction_173-happyReduction_173 happy_x_1-	 =  case happyOutTok happy_x_1 of { (TokenMetavar happy_var_1) -> -	happyIn57-		 (RMetavar happy_var_1-	)}--happyReduce_174 = happyReduce 4# 51# happyReduction_174-happyReduction_174 (happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOut80 happy_x_3 of { happy_var_3 -> -	happyIn57-		 (RMetavarPrf (UN "") happy_var_3 False-	) `HappyStk` happyRest}--happyReduce_175 = happyReduce 4# 51# happyReduction_175-happyReduction_175 (happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOut80 happy_x_3 of { happy_var_3 -> -	happyIn57-		 (RMetavarPrf (UN "") happy_var_3 True-	) `HappyStk` happyRest}--happyReduce_176 = happyReduce 4# 51# happyReduction_176-happyReduction_176 (happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOut32 happy_x_2 of { happy_var_2 -> -	case happyOut83 happy_x_3 of { happy_var_3 -> -	case happyOut82 happy_x_4 of { happy_var_4 -> -	happyIn57-		 (RExpVar happy_var_3 happy_var_4 happy_var_2-	) `HappyStk` happyRest}}}--happyReduce_177 = happySpecReduce_3  51# happyReduction_177-happyReduction_177 happy_x_3-	happy_x_2-	happy_x_1-	 =  case happyOut64 happy_x_1 of { happy_var_1 -> -	case happyOut83 happy_x_2 of { happy_var_2 -> -	case happyOut82 happy_x_3 of { happy_var_3 -> -	happyIn57-		 (RConst happy_var_2 happy_var_3 happy_var_1-	)}}}--happyReduce_178 = happySpecReduce_1  51# happyReduction_178-happyReduction_178 happy_x_1-	 =  happyIn57-		 (RRefl-	)--happyReduce_179 = happySpecReduce_3  51# happyReduction_179-happyReduction_179 happy_x_3-	happy_x_2-	happy_x_1-	 =  case happyOut83 happy_x_2 of { happy_var_2 -> -	case happyOut82 happy_x_3 of { happy_var_3 -> -	happyIn57-		 (RVar happy_var_2 happy_var_3 (UN "__Empty") TypeCon-	)}}--happyReduce_180 = happySpecReduce_3  51# happyReduction_180-happyReduction_180 happy_x_3-	happy_x_2-	happy_x_1-	 =  case happyOut83 happy_x_2 of { happy_var_2 -> -	case happyOut82 happy_x_3 of { happy_var_3 -> -	happyIn57-		 (RVar happy_var_2 happy_var_3 (UN "__Unit") TypeCon-	)}}--happyReduce_181 = happySpecReduce_1  51# happyReduction_181-happyReduction_181 happy_x_1-	 =  happyIn57-		 (RPlaceholder-	)--happyReduce_182 = happySpecReduce_1  51# happyReduction_182-happyReduction_182 happy_x_1-	 =  case happyOut61 happy_x_1 of { happy_var_1 -> -	happyIn57-		 (RDo happy_var_1-	)}--happyReduce_183 = happySpecReduce_3  51# happyReduction_183-happyReduction_183 happy_x_3-	happy_x_2-	happy_x_1-	 =  case happyOut34 happy_x_2 of { happy_var_2 -> -	happyIn57-		 (RIdiom happy_var_2-	)}--happyReduce_184 = happyReduce 5# 51# 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 happyOut59 happy_x_2 of { happy_var_2 -> -	case happyOut83 happy_x_4 of { happy_var_4 -> -	case happyOut82 happy_x_5 of { happy_var_5 -> -	happyIn57-		 (pairDesugar happy_var_4 happy_var_5 (RVar happy_var_4 happy_var_5 (UN "mkPair") DataCon) happy_var_2-	) `HappyStk` happyRest}}}--happyReduce_185 = happySpecReduce_1  51# happyReduction_185-happyReduction_185 happy_x_1-	 =  case happyOut55 happy_x_1 of { happy_var_1 -> -	happyIn57-		 (happy_var_1-	)}--happyReduce_186 = happySpecReduce_1  51# happyReduction_186-happyReduction_186 happy_x_1-	 =  case happyOut46 happy_x_1 of { happy_var_1 -> -	happyIn57-		 (happy_var_1-	)}--happyReduce_187 = happySpecReduce_1  51# happyReduction_187-happyReduction_187 happy_x_1-	 =  case happyOut58 happy_x_1 of { happy_var_1 -> -	happyIn57-		 (happy_var_1-	)}--happyReduce_188 = happyReduce 5# 51# happyReduction_188-happyReduction_188 (happy_x_5 `HappyStk`-	happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOut83 happy_x_2 of { happy_var_2 -> -	case happyOut82 happy_x_3 of { happy_var_3 -> -	case happyOut60 happy_x_4 of { happy_var_4 -> -	happyIn57-		 (mkConsList happy_var_2 happy_var_3 happy_var_4-	) `HappyStk` happyRest}}}--happyReduce_189 = happyReduce 7# 52# happyReduction_189-happyReduction_189 (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 happyOut34 happy_x_2 of { happy_var_2 -> -	case happyOut34 happy_x_4 of { happy_var_4 -> -	case happyOut83 happy_x_6 of { happy_var_6 -> -	case happyOut82 happy_x_7 of { happy_var_7 -> -	happyIn58-		 (RApp happy_var_6 happy_var_7 (RApp happy_var_6 happy_var_7 (RVar happy_var_6 happy_var_7 (UN "Exists") DataCon) happy_var_2) happy_var_4-	) `HappyStk` happyRest}}}}--happyReduce_190 = happyReduce 5# 52# happyReduction_190-happyReduction_190 (happy_x_5 `HappyStk`-	happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOut34 happy_x_2 of { happy_var_2 -> -	case happyOut83 happy_x_4 of { happy_var_4 -> -	case happyOut82 happy_x_5 of { happy_var_5 -> -	happyIn58-		 (RApp happy_var_4 happy_var_5 (RApp happy_var_4 happy_var_5 (RVar happy_var_4 happy_var_5 (UN "Exists") DataCon) RPlaceholder) happy_var_2-	) `HappyStk` happyRest}}}--happyReduce_191 = happySpecReduce_3  53# happyReduction_191-happyReduction_191 happy_x_3-	happy_x_2-	happy_x_1-	 =  case happyOut34 happy_x_1 of { happy_var_1 -> -	case happyOut34 happy_x_3 of { happy_var_3 -> -	happyIn59-		 (happy_var_1:happy_var_3:[]-	)}}--happyReduce_192 = happySpecReduce_3  53# happyReduction_192-happyReduction_192 happy_x_3-	happy_x_2-	happy_x_1-	 =  case happyOut34 happy_x_1 of { happy_var_1 -> -	case happyOut59 happy_x_3 of { happy_var_3 -> -	happyIn59-		 (happy_var_1:happy_var_3-	)}}--happyReduce_193 = happySpecReduce_0  54# happyReduction_193-happyReduction_193  =  happyIn60-		 ([]-	)--happyReduce_194 = happySpecReduce_1  54# happyReduction_194-happyReduction_194 happy_x_1-	 =  case happyOut34 happy_x_1 of { happy_var_1 -> -	happyIn60-		 ([happy_var_1]-	)}--happyReduce_195 = happySpecReduce_3  54# happyReduction_195-happyReduction_195 happy_x_3-	happy_x_2-	happy_x_1-	 =  case happyOut34 happy_x_1 of { happy_var_1 -> -	case happyOut60 happy_x_3 of { happy_var_3 -> -	happyIn60-		 (happy_var_1:happy_var_3-	)}}--happyReduce_196 = happyReduce 4# 55# happyReduction_196-happyReduction_196 (happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOut62 happy_x_3 of { happy_var_3 -> -	happyIn61-		 (happy_var_3-	) `HappyStk` happyRest}--happyReduce_197 = happyReduce 10# 55# happyReduction_197-happyReduction_197 (happy_x_10 `HappyStk`-	happy_x_9 `HappyStk`-	happy_x_8 `HappyStk`-	happy_x_7 `HappyStk`-	happy_x_6 `HappyStk`-	happy_x_5 `HappyStk`-	happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOutTok happy_x_2 of { (TokenBrackName happy_var_2) -> -	case happyOut48 happy_x_3 of { happy_var_3 -> -	case happyOut34 happy_x_5 of { happy_var_5 -> -	case happyOut83 happy_x_6 of { happy_var_6 -> -	case happyOut82 happy_x_7 of { happy_var_7 -> -	case happyOut62 happy_x_9 of { happy_var_9 -> -	happyIn61-		 (DoBinding happy_var_6 happy_var_7 happy_var_2 happy_var_3 happy_var_5 : happy_var_9-	) `HappyStk` happyRest}}}}}}--happyReduce_198 = happySpecReduce_2  56# happyReduction_198-happyReduction_198 happy_x_2-	happy_x_1-	 =  case happyOut63 happy_x_1 of { happy_var_1 -> -	case happyOut62 happy_x_2 of { happy_var_2 -> -	happyIn62-		 (happy_var_1:happy_var_2-	)}}--happyReduce_199 = happySpecReduce_1  56# happyReduction_199-happyReduction_199 happy_x_1-	 =  case happyOut63 happy_x_1 of { happy_var_1 -> -	happyIn62-		 ([happy_var_1]-	)}--happyReduce_200 = happyReduce 7# 57# happyReduction_200-happyReduction_200 (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 happyOut32 happy_x_1 of { happy_var_1 -> -	case happyOut48 happy_x_2 of { happy_var_2 -> -	case happyOut34 happy_x_4 of { happy_var_4 -> -	case happyOut83 happy_x_5 of { happy_var_5 -> -	case happyOut82 happy_x_6 of { happy_var_6 -> -	happyIn63-		 (DoBinding happy_var_5 happy_var_6 happy_var_1 happy_var_2 happy_var_4-	) `HappyStk` happyRest}}}}}--happyReduce_201 = happyReduce 8# 57# happyReduction_201-happyReduction_201 (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 happyOut32 happy_x_2 of { happy_var_2 -> -	case happyOut48 happy_x_3 of { happy_var_3 -> -	case happyOut34 happy_x_5 of { happy_var_5 -> -	case happyOut83 happy_x_6 of { happy_var_6 -> -	case happyOut82 happy_x_7 of { happy_var_7 -> -	happyIn63-		 (DoLet happy_var_6 happy_var_7 happy_var_2 happy_var_3 happy_var_5-	) `HappyStk` happyRest}}}}}--happyReduce_202 = happyReduce 4# 57# happyReduction_202-happyReduction_202 (happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOut34 happy_x_1 of { happy_var_1 -> -	case happyOut83 happy_x_2 of { happy_var_2 -> -	case happyOut82 happy_x_3 of { happy_var_3 -> -	happyIn63-		 (DoExp happy_var_2 happy_var_3 happy_var_1-	) `HappyStk` happyRest}}}--happyReduce_203 = happySpecReduce_1  58# happyReduction_203-happyReduction_203 happy_x_1-	 =  happyIn64-		 (TYPE-	)--happyReduce_204 = happySpecReduce_1  58# happyReduction_204-happyReduction_204 happy_x_1-	 =  happyIn64-		 (LTYPE-	)--happyReduce_205 = happySpecReduce_1  58# happyReduction_205-happyReduction_205 happy_x_1-	 =  happyIn64-		 (StringType-	)--happyReduce_206 = happySpecReduce_1  58# happyReduction_206-happyReduction_206 happy_x_1-	 =  happyIn64-		 (IntType-	)--happyReduce_207 = happySpecReduce_1  58# happyReduction_207-happyReduction_207 happy_x_1-	 =  happyIn64-		 (CharType-	)--happyReduce_208 = happySpecReduce_1  58# happyReduction_208-happyReduction_208 happy_x_1-	 =  happyIn64-		 (FloatType-	)--happyReduce_209 = happySpecReduce_1  58# happyReduction_209-happyReduction_209 happy_x_1-	 =  happyIn64-		 (PtrType-	)--happyReduce_210 = happySpecReduce_1  58# happyReduction_210-happyReduction_210 happy_x_1-	 =  happyIn64-		 (Builtin "Handle"-	)--happyReduce_211 = happySpecReduce_1  58# happyReduction_211-happyReduction_211 happy_x_1-	 =  happyIn64-		 (Builtin "Lock"-	)--happyReduce_212 = happySpecReduce_1  58# happyReduction_212-happyReduction_212 happy_x_1-	 =  case happyOutTok happy_x_1 of { (TokenInt happy_var_1) -> -	happyIn64-		 (Num happy_var_1-	)}--happyReduce_213 = happySpecReduce_1  58# happyReduction_213-happyReduction_213 happy_x_1-	 =  case happyOutTok happy_x_1 of { (TokenChar happy_var_1) -> -	happyIn64-		 (Ch happy_var_1-	)}--happyReduce_214 = happySpecReduce_1  58# happyReduction_214-happyReduction_214 happy_x_1-	 =  case happyOutTok happy_x_1 of { (TokenString happy_var_1) -> -	happyIn64-		 (Str happy_var_1-	)}--happyReduce_215 = happySpecReduce_1  58# happyReduction_215-happyReduction_215 happy_x_1-	 =  case happyOutTok happy_x_1 of { (TokenBool happy_var_1) -> -	happyIn64-		 (Bo happy_var_1-	)}--happyReduce_216 = happySpecReduce_1  58# happyReduction_216-happyReduction_216 happy_x_1-	 =  case happyOutTok happy_x_1 of { (TokenFloat happy_var_1) -> -	happyIn64-		 (Fl happy_var_1-	)}--happyReduce_217 = happySpecReduce_0  59# happyReduction_217-happyReduction_217  =  happyIn65-		 ([]-	)--happyReduce_218 = happySpecReduce_2  59# happyReduction_218-happyReduction_218 happy_x_2-	happy_x_1-	 =  case happyOut57 happy_x_1 of { happy_var_1 -> -	case happyOut65 happy_x_2 of { happy_var_2 -> -	happyIn65-		 (happy_var_1:happy_var_2-	)}}--happyReduce_219 = happyReduce 4# 60# happyReduction_219-happyReduction_219 (happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOut50 happy_x_2 of { happy_var_2 -> -	case happyOut67 happy_x_3 of { happy_var_3 -> -	happyIn66-		 ((happy_var_2, happy_var_3)-	) `HappyStk` happyRest}}--happyReduce_220 = happySpecReduce_3  60# happyReduction_220-happyReduction_220 happy_x_3-	happy_x_2-	happy_x_1-	 =  case happyOut83 happy_x_2 of { happy_var_2 -> -	case happyOut82 happy_x_3 of { happy_var_3 -> -	happyIn66-		 ((RConst happy_var_2 happy_var_3 TYPE, [])-	)}}--happyReduce_221 = happyReduce 4# 60# happyReduction_221-happyReduction_221 (happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOut73 happy_x_1 of { happy_var_1 -> -	case happyOut83 happy_x_3 of { happy_var_3 -> -	case happyOut82 happy_x_4 of { happy_var_4 -> -	happyIn66-		 ((mkTyParams happy_var_3 happy_var_4 happy_var_1, [])-	) `HappyStk` happyRest}}}--happyReduce_222 = happySpecReduce_0  61# happyReduction_222-happyReduction_222  =  happyIn67-		 ([]-	)--happyReduce_223 = happyReduce 4# 61# happyReduction_223-happyReduction_223 (happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOut72 happy_x_3 of { happy_var_3 -> -	happyIn67-		 (happy_var_3-	) `HappyStk` happyRest}--happyReduce_224 = happyReduce 7# 62# happyReduction_224-happyReduction_224 (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 happyOut32 happy_x_4 of { happy_var_4 -> -	case happyOut32 happy_x_6 of { happy_var_6 -> -	happyIn68-		 ((happy_var_4,happy_var_6)-	) `HappyStk` happyRest}}--happyReduce_225 = happyReduce 6# 63# happyReduction_225-happyReduction_225 (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 happyOut32 happy_x_3 of { happy_var_3 -> -	case happyOut32 happy_x_5 of { happy_var_5 -> -	happyIn69-		 ((happy_var_3,happy_var_5)-	) `HappyStk` happyRest}}--happyReduce_226 = happyReduce 4# 64# happyReduction_226-happyReduction_226 (happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOut72 happy_x_3 of { happy_var_3 -> -	happyIn70-		 (happy_var_3-	) `HappyStk` happyRest}--happyReduce_227 = happySpecReduce_2  65# happyReduction_227-happyReduction_227 happy_x_2-	happy_x_1-	 =  case happyOut32 happy_x_2 of { happy_var_2 -> -	happyIn71-		 (happy_var_2-	)}--happyReduce_228 = happySpecReduce_3  66# happyReduction_228-happyReduction_228 happy_x_3-	happy_x_2-	happy_x_1-	 =  case happyOut32 happy_x_1 of { happy_var_1 -> -	case happyOut50 happy_x_3 of { happy_var_3 -> -	happyIn72-		 ([(happy_var_1, happy_var_3)]-	)}}--happyReduce_229 = happyReduce 5# 66# happyReduction_229-happyReduction_229 (happy_x_5 `HappyStk`-	happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOut32 happy_x_1 of { happy_var_1 -> -	case happyOut50 happy_x_3 of { happy_var_3 -> -	case happyOut72 happy_x_5 of { happy_var_5 -> -	happyIn72-		 ((happy_var_1,happy_var_3):happy_var_5-	) `HappyStk` happyRest}}}--happyReduce_230 = happySpecReduce_1  67# happyReduction_230-happyReduction_230 happy_x_1-	 =  case happyOut32 happy_x_1 of { happy_var_1 -> -	happyIn73-		 ([happy_var_1]-	)}--happyReduce_231 = happySpecReduce_2  67# happyReduction_231-happyReduction_231 happy_x_2-	happy_x_1-	 =  case happyOut32 happy_x_1 of { happy_var_1 -> -	case happyOut73 happy_x_2 of { happy_var_2 -> -	happyIn73-		 (happy_var_1:happy_var_2-	)}}--happyReduce_232 = happySpecReduce_1  68# happyReduction_232-happyReduction_232 happy_x_1-	 =  case happyOutTok happy_x_1 of { happy_var_1 -> -	happyIn74-		 (happy_var_1-	)}--happyReduce_233 = happySpecReduce_1  68# happyReduction_233-happyReduction_233 happy_x_1-	 =  case happyOutTok happy_x_1 of { happy_var_1 -> -	happyIn74-		 (happy_var_1-	)}--happyReduce_234 = happySpecReduce_0  69# happyReduction_234-happyReduction_234  =  happyIn75-		 ([]-	)--happyReduce_235 = happySpecReduce_1  69# happyReduction_235-happyReduction_235 happy_x_1-	 =  case happyOut76 happy_x_1 of { happy_var_1 -> -	happyIn75-		 ([happy_var_1]-	)}--happyReduce_236 = happySpecReduce_3  69# happyReduction_236-happyReduction_236 happy_x_3-	happy_x_2-	happy_x_1-	 =  case happyOut76 happy_x_1 of { happy_var_1 -> -	case happyOut75 happy_x_3 of { happy_var_3 -> -	happyIn75-		 (happy_var_1:happy_var_3-	)}}--happyReduce_237 = happySpecReduce_2  70# happyReduction_237-happyReduction_237 happy_x_2-	happy_x_1-	 =  case happyOut32 happy_x_1 of { happy_var_1 -> -	case happyOut77 happy_x_2 of { happy_var_2 -> -	happyIn76-		 (Full happy_var_1 happy_var_2-	)}}--happyReduce_238 = happySpecReduce_2  70# happyReduction_238-happyReduction_238 happy_x_2-	happy_x_1-	 =  case happyOut32 happy_x_1 of { happy_var_1 -> -	case happyOut65 happy_x_2 of { happy_var_2 -> -	happyIn76-		 (Simple happy_var_1 happy_var_2-	)}}--happyReduce_239 = happySpecReduce_2  71# happyReduction_239-happyReduction_239 happy_x_2-	happy_x_1-	 =  case happyOut50 happy_x_2 of { happy_var_2 -> -	happyIn77-		 (happy_var_2-	)}--happyReduce_240 = happySpecReduce_2  72# happyReduction_240-happyReduction_240 happy_x_2-	happy_x_1-	 =  case happyOut38 happy_x_2 of { happy_var_2 -> -	happyIn78-		 (Intro happy_var_2-	)}--happyReduce_241 = happySpecReduce_1  72# happyReduction_241-happyReduction_241 happy_x_1-	 =  happyIn78-		 (Intro []-	)--happyReduce_242 = happySpecReduce_2  72# happyReduction_242-happyReduction_242 happy_x_2-	happy_x_1-	 =  case happyOut32 happy_x_2 of { happy_var_2 -> -	happyIn78-		 (Refine happy_var_2-	)}--happyReduce_243 = happySpecReduce_2  72# happyReduction_243-happyReduction_243 happy_x_2-	happy_x_1-	 =  case happyOut34 happy_x_2 of { happy_var_2 -> -	happyIn78-		 (Exists happy_var_2-	)}--happyReduce_244 = happySpecReduce_2  72# happyReduction_244-happyReduction_244 happy_x_2-	happy_x_1-	 =  case happyOut34 happy_x_2 of { happy_var_2 -> -	happyIn78-		 (Generalise happy_var_2-	)}--happyReduce_245 = happySpecReduce_1  72# happyReduction_245-happyReduction_245 happy_x_1-	 =  happyIn78-		 (ReflP-	)--happyReduce_246 = happySpecReduce_2  72# happyReduction_246-happyReduction_246 happy_x_2-	happy_x_1-	 =  case happyOut34 happy_x_2 of { happy_var_2 -> -	happyIn78-		 (Rewrite False False happy_var_2-	)}--happyReduce_247 = happySpecReduce_3  72# happyReduction_247-happyReduction_247 happy_x_3-	happy_x_2-	happy_x_1-	 =  case happyOut34 happy_x_3 of { happy_var_3 -> -	happyIn78-		 (Rewrite False True happy_var_3-	)}--happyReduce_248 = happySpecReduce_2  72# happyReduction_248-happyReduction_248 happy_x_2-	happy_x_1-	 =  case happyOut34 happy_x_2 of { happy_var_2 -> -	happyIn78-		 (Rewrite True False happy_var_2-	)}--happyReduce_249 = happySpecReduce_3  72# happyReduction_249-happyReduction_249 happy_x_3-	happy_x_2-	happy_x_1-	 =  case happyOut34 happy_x_3 of { happy_var_3 -> -	happyIn78-		 (Rewrite True True happy_var_3-	)}--happyReduce_250 = happySpecReduce_1  72# happyReduction_250-happyReduction_250 happy_x_1-	 =  happyIn78-		 (Compute-	)--happyReduce_251 = happySpecReduce_2  72# happyReduction_251-happyReduction_251 happy_x_2-	happy_x_1-	 =  case happyOut32 happy_x_2 of { happy_var_2 -> -	happyIn78-		 (Unfold happy_var_2-	)}--happyReduce_252 = happySpecReduce_1  72# happyReduction_252-happyReduction_252 happy_x_1-	 =  happyIn78-		 (Undo-	)--happyReduce_253 = happySpecReduce_2  72# happyReduction_253-happyReduction_253 happy_x_2-	happy_x_1-	 =  case happyOut34 happy_x_2 of { happy_var_2 -> -	happyIn78-		 (Induction happy_var_2-	)}--happyReduce_254 = happySpecReduce_2  72# happyReduction_254-happyReduction_254 happy_x_2-	happy_x_1-	 =  case happyOut34 happy_x_2 of { happy_var_2 -> -	happyIn78-		 (Fill happy_var_2-	)}--happyReduce_255 = happySpecReduce_1  72# happyReduction_255-happyReduction_255 happy_x_1-	 =  happyIn78-		 (Trivial-	)--happyReduce_256 = happySpecReduce_1  72# happyReduction_256-happyReduction_256 happy_x_1-	 =  happyIn78-		 (SimpleSearch-	)--happyReduce_257 = happySpecReduce_2  72# happyReduction_257-happyReduction_257 happy_x_2-	happy_x_1-	 =  case happyOut34 happy_x_2 of { happy_var_2 -> -	happyIn78-		 (RunTactic happy_var_2-	)}--happyReduce_258 = happySpecReduce_2  72# happyReduction_258-happyReduction_258 happy_x_2-	happy_x_1-	 =  case happyOut34 happy_x_2 of { happy_var_2 -> -	happyIn78-		 (Believe happy_var_2-	)}--happyReduce_259 = happySpecReduce_2  72# happyReduction_259-happyReduction_259 happy_x_2-	happy_x_1-	 =  case happyOut34 happy_x_2 of { happy_var_2 -> -	happyIn78-		 (Use happy_var_2-	)}--happyReduce_260 = happySpecReduce_2  72# happyReduction_260-happyReduction_260 happy_x_2-	happy_x_1-	 =  case happyOut34 happy_x_2 of { happy_var_2 -> -	happyIn78-		 (Decide happy_var_2-	)}--happyReduce_261 = happySpecReduce_1  72# happyReduction_261-happyReduction_261 happy_x_1-	 =  happyIn78-		 (Abandon-	)--happyReduce_262 = happySpecReduce_1  72# happyReduction_262-happyReduction_262 happy_x_1-	 =  happyIn78-		 (ProofTerm-	)--happyReduce_263 = happySpecReduce_1  72# happyReduction_263-happyReduction_263 happy_x_1-	 =  happyIn78-		 (Qed-	)--happyReduce_264 = happyReduce 4# 73# happyReduction_264-happyReduction_264 (happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOut80 happy_x_3 of { happy_var_3 -> -	happyIn79-		 (happy_var_3-	) `HappyStk` happyRest}--happyReduce_265 = happySpecReduce_2  74# happyReduction_265-happyReduction_265 happy_x_2-	happy_x_1-	 =  case happyOut78 happy_x_1 of { happy_var_1 -> -	happyIn80-		 ([happy_var_1]-	)}--happyReduce_266 = happySpecReduce_1  74# happyReduction_266-happyReduction_266 happy_x_1-	 =  case happyOut78 happy_x_1 of { happy_var_1 -> -	happyIn80-		 ([happy_var_1]-	)}--happyReduce_267 = happySpecReduce_3  74# happyReduction_267-happyReduction_267 happy_x_3-	happy_x_2-	happy_x_1-	 =  case happyOut78 happy_x_1 of { happy_var_1 -> -	case happyOut80 happy_x_3 of { happy_var_3 -> -	happyIn80-		 (happy_var_1:happy_var_3-	)}}--happyReduce_268 = happySpecReduce_1  75# happyReduction_268-happyReduction_268 happy_x_1-	 =  case happyOut78 happy_x_1 of { happy_var_1 -> -	happyIn81-		 ([happy_var_1]-	)}--happyReduce_269 = happySpecReduce_3  75# happyReduction_269-happyReduction_269 happy_x_3-	happy_x_2-	happy_x_1-	 =  case happyOut78 happy_x_1 of { happy_var_1 -> -	case happyOut80 happy_x_3 of { happy_var_3 -> -	happyIn81-		 (happy_var_1:happy_var_3-	)}}--happyReduce_270 = happyMonadReduce 0# 76# happyReduction_270-happyReduction_270 (happyRest) tk-	 = happyThen (( getLineNo)-	) (\r -> happyReturn (happyIn82 r))--happyReduce_271 = happyMonadReduce 0# 77# happyReduction_271-happyReduction_271 (happyRest) tk-	 = happyThen (( getFileName)-	) (\r -> happyReturn (happyIn83 r))--happyReduce_272 = happyMonadReduce 0# 78# happyReduction_272-happyReduction_272 (happyRest) tk-	 = happyThen (( getOps)-	) (\r -> happyReturn (happyIn84 r))--happyNewToken action sts stk-	= lexer(\tk -> -	let cont i = happyDoAction i tk action sts stk in-	case tk of {-	TokenEOF -> happyDoAction 125# tk action sts stk;-	TokenName happy_dollar_dollar -> cont 1#;-	TokenInfixName happy_dollar_dollar -> cont 2#;-	TokenBrackName happy_dollar_dollar -> cont 3#;-	TokenString happy_dollar_dollar -> cont 4#;-	TokenInt happy_dollar_dollar -> cont 5#;-	TokenFloat happy_dollar_dollar -> cont 6#;-	TokenChar happy_dollar_dollar -> cont 7#;-	TokenBool happy_dollar_dollar -> cont 8#;-	TokenMetavar happy_dollar_dollar -> cont 9#;-	TokenColon -> cont 10#;-	TokenSemi -> cont 11#;-	TokenBar -> cont 12#;-	TokenStars -> cont 13#;-	TokenLambda -> cont 14#;-	TokenHashOB -> cont 15#;-	TokenOB -> cont 16#;-	TokenCB -> cont 17#;-	TokenOCB -> cont 18#;-	TokenCCB -> cont 19#;-	TokenOSB -> cont 20#;-	TokenCSB -> cont 21#;-	TokenOId -> cont 22#;-	TokenCId -> cont 23#;-	TokenLPair -> cont 24#;-	TokenRPair -> cont 25#;-	TokenExists -> cont 26#;-	TokenTilde -> cont 27#;-	TokenPlus -> cont 28#;-	TokenMinus -> cont 29#;-	TokenTimes -> cont 30#;-	TokenDivide -> cont 31#;-	TokenEquals -> cont 32#;-	TokenMightEqual -> cont 33#;-	TokenLT -> cont 34#;-	TokenGT -> cont 35#;-	TokenEllipsis -> cont 36#;-	TokenUnderscore -> cont 37#;-	TokenComma -> cont 38#;-	TokenTuple -> cont 39#;-	TokenBang -> cont 40#;-	TokenConcat -> cont 41#;-	TokenGE -> cont 42#;-	TokenLE -> cont 43#;-	TokenOr -> cont 44#;-	TokenAnd -> cont 45#;-	TokenArrow -> cont 46#;-	TokenFatArrow -> cont 47#;-	TokenTransArrow -> cont 48#;-	TokenLeftArrow -> cont 49#;-	TokenIntType -> cont 50#;-	TokenCharType -> cont 51#;-	TokenFloatType -> cont 52#;-	TokenStringType -> cont 53#;-	TokenHandleType -> cont 54#;-	TokenPtrType -> cont 55#;-	TokenLockType -> cont 56#;-	TokenType -> cont 57#;-	TokenLType -> cont 58#;-	TokenLazyBracket -> cont 59#;-	TokenDataType -> cont 60#;-	TokenCoDataType -> cont 61#;-	TokenInfix -> cont 62#;-	TokenInfixL -> cont 63#;-	TokenInfixR -> cont 64#;-	TokenUsing -> cont 65#;-	TokenIdiom -> cont 66#;-	TokenParams -> cont 67#;-	TokenNamespace -> cont 68#;-	TokenPublic -> cont 69#;-	TokenPrivate -> cont 70#;-	TokenAbstract -> cont 71#;-	TokenNoElim -> cont 72#;-	TokenCollapsible -> cont 73#;-	TokenWhere -> cont 74#;-	TokenWith -> cont 75#;-	TokenPartial -> cont 76#;-	TokenSyntax -> cont 77#;-	TokenHide -> cont 78#;-	TokenLazy -> cont 79#;-	TokenStatic -> cont 80#;-	TokenRefl -> cont 81#;-	TokenEmptyType -> cont 82#;-	TokenUnitType -> cont 83#;-	TokenInclude -> cont 84#;-	TokenExport -> cont 85#;-	TokenInline -> cont 86#;-	TokenDo -> cont 87#;-	TokenReturn -> cont 88#;-	TokenIf -> cont 89#;-	TokenThen -> cont 90#;-	TokenElse -> cont 91#;-	TokenLet -> cont 92#;-	TokenIn -> cont 93#;-	TokenProof -> cont 94#;-	TokenTryProof -> cont 95#;-	TokenIntro -> cont 96#;-	TokenRefine -> cont 97#;-	TokenGeneralise -> cont 98#;-	TokenReflP -> cont 99#;-	TokenRewrite -> cont 100#;-	TokenRewriteAll -> cont 101#;-	TokenCompute -> cont 102#;-	TokenUnfold -> cont 103#;-	TokenUndo -> cont 104#;-	TokenInduction -> cont 105#;-	TokenFill -> cont 106#;-	TokenTrivial -> cont 107#;-	TokenSimpleSearch -> cont 108#;-	TokenMkTac -> cont 109#;-	TokenBelieve -> cont 110#;-	TokenUse -> cont 111#;-	TokenDecide -> cont 112#;-	TokenAbandon -> cont 113#;-	TokenProofTerm -> cont 114#;-	TokenQED -> cont 115#;-	TokenLaTeX -> cont 116#;-	TokenNoCG -> cont 117#;-	TokenEval -> cont 118#;-	TokenSpec -> cont 119#;-	TokenFreeze -> cont 120#;-	TokenThaw -> cont 121#;-	TokenTransform -> cont 122#;-	TokenCInclude -> cont 123#;-	TokenCLib -> cont 124#;-	_ -> happyError' tk-	})--happyError_ tk = happyError' tk--happyThen :: () => P a -> (a -> P b) -> P b-happyThen = (thenP)-happyReturn :: () => a -> P a-happyReturn = (returnP)-happyThen1 = happyThen-happyReturn1 :: () => a -> P a-happyReturn1 = happyReturn-happyError' :: () => (Token) -> P a-happyError' tk = (\token -> happyError) tk--mkparse = happySomeParser where-  happySomeParser = happyThen (happyParse 0#) (\x -> happyReturn (happyOut6 x))--mkparseTerm = happySomeParser where-  happySomeParser = happyThen (happyParse 1#) (\x -> happyReturn (happyOut34 x))--mkparseTactic = happySomeParser where-  happySomeParser = happyThen (happyParse 2#) (\x -> happyReturn (happyOut78 x))--happySeq = happyDontSeq---data ConParse = Full Id RawTerm-              | Simple Id [RawTerm]--parse :: String -> FilePath -> Result [Decl]-parse s fn = do ds <- mkparse s fn 1 []-                collectDecls ds--processImports :: [Opt] -> [FilePath] -> Result [Decl] -> -                  IO ([Decl], [FilePath])-processImports opts imped (Success ds) = pi imped [] ds-  where pi imps decls ((PInclude fp):xs)-           | fp `elem` imps = pi imps decls xs-           | otherwise = do-                 f <- readLibFile defaultLibPath fp-                 when (Verbose `elem` opts) $ putStrLn ("Reading " ++ fp)-                 case parse f fp of-                   Success t -> pi (fp:imps) decls (t++xs)-                   Failure e f l ->-                     fail $ f ++ ":" ++ show l ++ ":" ++ e-        pi imps decls ((Using t ds):xs)-            = do (ds',imps') <- pi imps [] ds-                 pi imps' (decls++[Using t ds']) xs-        pi imps decls ((Params t ds):xs)-            = do (ds',imps') <- pi imps [] ds-                 pi imps' (decls++[Params t ds']) xs-        pi imps decls ((DoUsing b r ds):xs)-            = do (ds',imps') <- pi imps [] ds-                 pi imps' (decls++[DoUsing b r ds']) xs-        pi imps decls ((Idiom b r ds):xs)-            = do (ds',imps') <- pi imps [] ds-                 pi imps' (decls++[Idiom b r ds']) xs-        pi imps decls ((Namespace n ds):xs)-            = do (ds',imps') <- pi imps [] ds-                 pi imps' (decls++[Namespace n ds']) xs-        pi imps decls (x:xs) = pi imps (decls++[x]) xs-        pi imps decls [] = return (decls, imps)--processImports _ imped (Failure e f l) -    = fail $ show f ++ ":" ++ show l ++ ":" ++ show e---parseTerm :: String -> Result RawTerm-parseTerm s = mkparseTerm s "(input)" 0 []--parseTactic :: String -> Result ITactic-parseTactic s = mkparseTactic s "(tactic)" 0 []---- Make a constructor type, and make arguments lazy if it's codata--mkCon :: Bool -> RawTerm -> ConParse -> (Id,RawTerm)-mkCon co _ (Full n t) = (n,if co then lazify t else t)-mkCon co ty (Simple n args) = (n, mkConTy args ty)-   where mkConTy [] ty = ty-         mkConTy (a:as) ty = let opts = if co then [Lazy] else [] in-                                 RBind (MN "X" 0) (Pi Ex opts a) (mkConTy as ty)---- Make sure all arguments are lazy--lazify :: RawTerm -> RawTerm-lazify (RBind n (Pi p opts a) sc) -    = RBind n (Pi p (nub (Lazy:opts)) a) (lazify sc)-lazify t = t--mkDef file line (n, tms) = mkImpApp (RVar file line n Unknown) tms-   where mkImpApp f [] = f-         mkImpApp f ((tm,Just n):ts) = mkImpApp (RAppImp file line n f tm) ts-         mkImpApp f ((tm, Nothing):ts) = mkImpApp (RApp file line f tm) ts--doBind :: (RawTerm -> RBinder) -> [(Id,RawTerm)] -> RawTerm -> RawTerm-doBind b [] t = t-doBind b ((x,ty):ts) tm = RBind x (b ty) (doBind b ts tm)--doLetBind :: [(Id,RawTerm,RawTerm)] -> RawTerm -> RawTerm-doLetBind [] t = t-doLetBind ((x,ty,val):ts) tm = RBind x (RLet val ty) (doLetBind ts tm)--mkTyApp :: String -> Int -> Id -> RawTerm -> RawTerm-mkTyApp file line n ty = mkApp file line (RVar file line n Unknown) (getTyArgs ty)-   where getTyArgs (RBind n _ t) = (RVar file line n Unknown):(getTyArgs t)-         getTyArgs x = []--mkTyParams :: String -> Int -> [Id] -> RawTerm-mkTyParams f l [] = RConst f l TYPE-mkTyParams f l (x:xs) = RBind x (Pi Ex [] (RConst f l TYPE)) (mkTyParams f l xs)--mkDatatype :: Bool -> String -> Int ->-              Id -> Either RawTerm ((RawTerm, [(Id, RawTerm)]), [ConParse]) -> -                    [TyOpt] -> Datatype-mkDatatype co file line n (Right ((t, using), cons)) opts-    = let opts' = if co then nub (Codata:opts) else opts in-          Datatype n t (map (mkCon co (mkTyApp file line n t)) cons) using opts' file line -mkDatatype co file line n (Left t) opts-    = Latatype n t file line--bracket (RUserInfix f l _ op x y) = RUserInfix f l True op x y-bracket x = x--pairDesugar :: String -> Int -> RawTerm -> [RawTerm] -> RawTerm-pairDesugar file line pair [x,y] = mkApp file line pair [x,y]-pairDesugar file line pair (x:y:xs) -    = pairDesugar file line pair ((mkApp file line pair [x,y]):xs)--sigDesugar :: String -> Int -> (Id, RawTerm) -> RawTerm -> RawTerm-sigDesugar file line (n, tm) sc-    = mkApp file line (RVar file line (UN "Sigma") TypeCon) [tm, lam]-   where lam = RBind n (Lam tm) sc--mkConsList :: String -> Int -> [RawTerm] -> RawTerm-mkConsList f l [] = RVar f l (UN "Nil") Unknown-mkConsList f l (x:xs) = RApp f l (RApp f l (RVar f l (UN "Cons") Unknown) x)-                                 (mkConsList f l xs)--mkhidden (UN n) = MN (n++" is hidden") 0-{-# 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 =---	trace "failing" $ -    	happyError_ tk--{-  We don't need state discarding for our restricted implementation of-    "error".  In fact, it can cause some bogus parses, so I've disabled it-    for now --SDM---- discard a state-happyFail  0# tk old_st (HappyCons ((action)) (sts)) -						(saved_tok `HappyStk` _ `HappyStk` stk) =---	trace ("discarding state, depth " ++ show (length stk))  $-	happyDoAction 0# tk action sts ((saved_tok`HappyStk`stk))--}---- Enter error recovery: generate an error token,---                       save the old token and carry on.-happyFail  i tk (action) sts stk =---      trace "entering error recovery" $-	happyDoAction 0# tk action sts ( (Happy_GHC_Exts.unsafeCoerce# (Happy_GHC_Exts.I# (i))) `HappyStk` stk)---- Internal happy errors:--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.
− dist/build/Idris/idris-tmp/Idris/Parser.hs 
@@ -1,3973 +0,0 @@-{-# OPTIONS_GHC -fno-warn-overlapping-patterns #-}-{-# OPTIONS -fglasgow-exts -cpp #-}--- -*-Haskell-*--{-# OPTIONS_GHC -fglasgow-exts #-}--module Idris.Parser where--import Data.Char-import Ivor.TT-import System.IO.Unsafe-import List-import Control.Monad--import Idris.AbsSyntax-import Idris.Lexer-import Idris.Lib--import Debug.Trace-import qualified Data.Array as Happy_Data_Array-import qualified GHC.Exts as Happy_GHC_Exts---- parser produced by Happy Version 1.18.5--newtype HappyAbsSyn t74 = HappyAbsSyn HappyAny-#if __GLASGOW_HASKELL__ >= 607-type HappyAny = Happy_GHC_Exts.Any-#else-type HappyAny = forall a . a-#endif-happyIn6 :: ([ParseDecl]) -> (HappyAbsSyn t74)-happyIn6 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn6 #-}-happyOut6 :: (HappyAbsSyn t74) -> ([ParseDecl])-happyOut6 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut6 #-}-happyIn7 :: (ParseDecl) -> (HappyAbsSyn t74)-happyIn7 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn7 #-}-happyOut7 :: (HappyAbsSyn t74) -> (ParseDecl)-happyOut7 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut7 #-}-happyIn8 :: (Decl) -> (HappyAbsSyn t74)-happyIn8 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn8 #-}-happyOut8 :: (HappyAbsSyn t74) -> (Decl)-happyOut8 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut8 #-}-happyIn9 :: (ParseDecl) -> (HappyAbsSyn t74)-happyIn9 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn9 #-}-happyOut9 :: (HappyAbsSyn t74) -> (ParseDecl)-happyOut9 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut9 #-}-happyIn10 :: (CGFlag) -> (HappyAbsSyn t74)-happyIn10 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn10 #-}-happyOut10 :: (HappyAbsSyn t74) -> (CGFlag)-happyOut10 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut10 #-}-happyIn11 :: (Bool) -> (HappyAbsSyn t74)-happyIn11 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn11 #-}-happyOut11 :: (HappyAbsSyn t74) -> (Bool)-happyOut11 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut11 #-}-happyIn12 :: ([RawTerm]) -> (HappyAbsSyn t74)-happyIn12 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn12 #-}-happyOut12 :: (HappyAbsSyn t74) -> ([RawTerm])-happyOut12 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut12 #-}-happyIn13 :: (RawTerm) -> (HappyAbsSyn t74)-happyIn13 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn13 #-}-happyOut13 :: (HappyAbsSyn t74) -> (RawTerm)-happyOut13 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut13 #-}-happyIn14 :: ([ParseDecl]) -> (HappyAbsSyn t74)-happyIn14 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn14 #-}-happyOut14 :: (HappyAbsSyn t74) -> ([ParseDecl])-happyOut14 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut14 #-}-happyIn15 :: ([CGFlag]) -> (HappyAbsSyn t74)-happyIn15 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn15 #-}-happyOut15 :: (HappyAbsSyn t74) -> ([CGFlag])-happyOut15 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut15 #-}-happyIn16 :: ([CGFlag]) -> (HappyAbsSyn t74)-happyIn16 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn16 #-}-happyOut16 :: (HappyAbsSyn t74) -> ([CGFlag])-happyOut16 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut16 #-}-happyIn17 :: ([CGFlag]) -> (HappyAbsSyn t74)-happyIn17 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn17 #-}-happyOut17 :: (HappyAbsSyn t74) -> ([CGFlag])-happyOut17 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut17 #-}-happyIn18 :: ([Decl]) -> (HappyAbsSyn t74)-happyIn18 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn18 #-}-happyOut18 :: (HappyAbsSyn t74) -> ([Decl])-happyOut18 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut18 #-}-happyIn19 :: ([String]) -> (HappyAbsSyn t74)-happyIn19 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn19 #-}-happyOut19 :: (HappyAbsSyn t74) -> ([String])-happyOut19 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut19 #-}-happyIn20 :: (String) -> (HappyAbsSyn t74)-happyIn20 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn20 #-}-happyOut20 :: (HappyAbsSyn t74) -> (String)-happyOut20 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut20 #-}-happyIn21 :: (Fixity) -> (HappyAbsSyn t74)-happyIn21 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn21 #-}-happyOut21 :: (HappyAbsSyn t74) -> (Fixity)-happyOut21 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut21 #-}-happyIn22 :: (Decl) -> (HappyAbsSyn t74)-happyIn22 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn22 #-}-happyOut22 :: (HappyAbsSyn t74) -> (Decl)-happyOut22 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut22 #-}-happyIn23 :: ([(Id,String)]) -> (HappyAbsSyn t74)-happyIn23 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn23 #-}-happyOut23 :: (HappyAbsSyn t74) -> ([(Id,String)])-happyOut23 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut23 #-}-happyIn24 :: ((Id, [(RawTerm, Maybe Id)])) -> (HappyAbsSyn t74)-happyIn24 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn24 #-}-happyOut24 :: (HappyAbsSyn t74) -> ((Id, [(RawTerm, Maybe Id)]))-happyOut24 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut24 #-}-happyIn25 :: ([(RawTerm,Maybe Id)]) -> (HappyAbsSyn t74)-happyIn25 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn25 #-}-happyOut25 :: (HappyAbsSyn t74) -> ([(RawTerm,Maybe Id)])-happyOut25 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut25 #-}-happyIn26 :: (Datatype) -> (HappyAbsSyn t74)-happyIn26 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn26 #-}-happyOut26 :: (HappyAbsSyn t74) -> (Datatype)-happyOut26 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut26 #-}-happyIn27 :: (Bool) -> (HappyAbsSyn t74)-happyIn27 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn27 #-}-happyOut27 :: (HappyAbsSyn t74) -> (Bool)-happyOut27 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut27 #-}-happyIn28 :: (Either RawTerm ((RawTerm, [(Id, RawTerm)]), [ConParse])) -> (HappyAbsSyn t74)-happyIn28 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn28 #-}-happyOut28 :: (HappyAbsSyn t74) -> (Either RawTerm ((RawTerm, [(Id, RawTerm)]), [ConParse]))-happyOut28 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut28 #-}-happyIn29 :: ([TyOpt]) -> (HappyAbsSyn t74)-happyIn29 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn29 #-}-happyOut29 :: (HappyAbsSyn t74) -> ([TyOpt])-happyOut29 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut29 #-}-happyIn30 :: ([TyOpt]) -> (HappyAbsSyn t74)-happyIn30 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn30 #-}-happyOut30 :: (HappyAbsSyn t74) -> ([TyOpt])-happyOut30 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut30 #-}-happyIn31 :: (TyOpt) -> (HappyAbsSyn t74)-happyIn31 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn31 #-}-happyOut31 :: (HappyAbsSyn t74) -> (TyOpt)-happyOut31 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut31 #-}-happyIn32 :: (Id) -> (HappyAbsSyn t74)-happyIn32 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn32 #-}-happyOut32 :: (HappyAbsSyn t74) -> (Id)-happyOut32 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut32 #-}-happyIn33 :: (RawTerm) -> (HappyAbsSyn t74)-happyIn33 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn33 #-}-happyOut33 :: (HappyAbsSyn t74) -> (RawTerm)-happyOut33 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut33 #-}-happyIn34 :: (RawTerm) -> (HappyAbsSyn t74)-happyIn34 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn34 #-}-happyOut34 :: (HappyAbsSyn t74) -> (RawTerm)-happyOut34 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut34 #-}-happyIn35 :: ([(Id, RawTerm)]) -> (HappyAbsSyn t74)-happyIn35 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn35 #-}-happyOut35 :: (HappyAbsSyn t74) -> ([(Id, RawTerm)])-happyOut35 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut35 #-}-happyIn36 :: ([(Id, RawTerm)]) -> (HappyAbsSyn t74)-happyIn36 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn36 #-}-happyOut36 :: (HappyAbsSyn t74) -> ([(Id, RawTerm)])-happyOut36 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut36 #-}-happyIn37 :: ([(Id, RawTerm)]) -> (HappyAbsSyn t74)-happyIn37 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn37 #-}-happyOut37 :: (HappyAbsSyn t74) -> ([(Id, RawTerm)])-happyOut37 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut37 #-}-happyIn38 :: ([Id]) -> (HappyAbsSyn t74)-happyIn38 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn38 #-}-happyOut38 :: (HappyAbsSyn t74) -> ([Id])-happyOut38 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut38 #-}-happyIn39 :: ([(Id, Int)]) -> (HappyAbsSyn t74)-happyIn39 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn39 #-}-happyOut39 :: (HappyAbsSyn t74) -> ([(Id, Int)])-happyOut39 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut39 #-}-happyIn40 :: ([Id]) -> (HappyAbsSyn t74)-happyIn40 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn40 #-}-happyOut40 :: (HappyAbsSyn t74) -> ([Id])-happyOut40 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut40 #-}-happyIn41 :: ([Id]) -> (HappyAbsSyn t74)-happyIn41 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn41 #-}-happyOut41 :: (HappyAbsSyn t74) -> ([Id])-happyOut41 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut41 #-}-happyIn42 :: ([(Id, RawTerm, RawTerm)]) -> (HappyAbsSyn t74)-happyIn42 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn42 #-}-happyOut42 :: (HappyAbsSyn t74) -> ([(Id, RawTerm, RawTerm)])-happyOut42 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut42 #-}-happyIn43 :: ((Id, RawTerm)) -> (HappyAbsSyn t74)-happyIn43 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn43 #-}-happyOut43 :: (HappyAbsSyn t74) -> ((Id, RawTerm))-happyOut43 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut43 #-}-happyIn44 :: (RawTerm) -> (HappyAbsSyn t74)-happyIn44 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn44 #-}-happyOut44 :: (HappyAbsSyn t74) -> (RawTerm)-happyOut44 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut44 #-}-happyIn45 :: (RawTerm) -> (HappyAbsSyn t74)-happyIn45 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn45 #-}-happyOut45 :: (HappyAbsSyn t74) -> (RawTerm)-happyOut45 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut45 #-}-happyIn46 :: (RawTerm) -> (HappyAbsSyn t74)-happyIn46 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn46 #-}-happyOut46 :: (HappyAbsSyn t74) -> (RawTerm)-happyOut46 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut46 #-}-happyIn47 :: (String) -> (HappyAbsSyn t74)-happyIn47 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn47 #-}-happyOut47 :: (HappyAbsSyn t74) -> (String)-happyOut47 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut47 #-}-happyIn48 :: (RawTerm) -> (HappyAbsSyn t74)-happyIn48 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn48 #-}-happyOut48 :: (HappyAbsSyn t74) -> (RawTerm)-happyOut48 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut48 #-}-happyIn49 :: (RawTerm) -> (HappyAbsSyn t74)-happyIn49 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn49 #-}-happyOut49 :: (HappyAbsSyn t74) -> (RawTerm)-happyOut49 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut49 #-}-happyIn50 :: (RawTerm) -> (HappyAbsSyn t74)-happyIn50 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn50 #-}-happyOut50 :: (HappyAbsSyn t74) -> (RawTerm)-happyOut50 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut50 #-}-happyIn51 :: (RawTerm) -> (HappyAbsSyn t74)-happyIn51 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn51 #-}-happyOut51 :: (HappyAbsSyn t74) -> (RawTerm)-happyOut51 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut51 #-}-happyIn52 :: (ArgOpt) -> (HappyAbsSyn t74)-happyIn52 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn52 #-}-happyOut52 :: (HappyAbsSyn t74) -> (ArgOpt)-happyOut52 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut52 #-}-happyIn53 :: ([ArgOpt]) -> (HappyAbsSyn t74)-happyIn53 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn53 #-}-happyOut53 :: (HappyAbsSyn t74) -> ([ArgOpt])-happyOut53 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut53 #-}-happyIn54 :: ([ArgOpt]) -> (HappyAbsSyn t74)-happyIn54 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn54 #-}-happyOut54 :: (HappyAbsSyn t74) -> ([ArgOpt])-happyOut54 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut54 #-}-happyIn55 :: (RawTerm) -> (HappyAbsSyn t74)-happyIn55 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn55 #-}-happyOut55 :: (HappyAbsSyn t74) -> (RawTerm)-happyOut55 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut55 #-}-happyIn56 :: ([RawTerm]) -> (HappyAbsSyn t74)-happyIn56 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn56 #-}-happyOut56 :: (HappyAbsSyn t74) -> ([RawTerm])-happyOut56 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut56 #-}-happyIn57 :: (RawTerm) -> (HappyAbsSyn t74)-happyIn57 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn57 #-}-happyOut57 :: (HappyAbsSyn t74) -> (RawTerm)-happyOut57 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut57 #-}-happyIn58 :: (RawTerm) -> (HappyAbsSyn t74)-happyIn58 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn58 #-}-happyOut58 :: (HappyAbsSyn t74) -> (RawTerm)-happyOut58 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut58 #-}-happyIn59 :: ([RawTerm]) -> (HappyAbsSyn t74)-happyIn59 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn59 #-}-happyOut59 :: (HappyAbsSyn t74) -> ([RawTerm])-happyOut59 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut59 #-}-happyIn60 :: ([RawTerm]) -> (HappyAbsSyn t74)-happyIn60 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn60 #-}-happyOut60 :: (HappyAbsSyn t74) -> ([RawTerm])-happyOut60 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut60 #-}-happyIn61 :: ([Do]) -> (HappyAbsSyn t74)-happyIn61 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn61 #-}-happyOut61 :: (HappyAbsSyn t74) -> ([Do])-happyOut61 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut61 #-}-happyIn62 :: ([Do]) -> (HappyAbsSyn t74)-happyIn62 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn62 #-}-happyOut62 :: (HappyAbsSyn t74) -> ([Do])-happyOut62 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut62 #-}-happyIn63 :: (Do) -> (HappyAbsSyn t74)-happyIn63 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn63 #-}-happyOut63 :: (HappyAbsSyn t74) -> (Do)-happyOut63 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut63 #-}-happyIn64 :: (Constant) -> (HappyAbsSyn t74)-happyIn64 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn64 #-}-happyOut64 :: (HappyAbsSyn t74) -> (Constant)-happyOut64 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut64 #-}-happyIn65 :: ([RawTerm]) -> (HappyAbsSyn t74)-happyIn65 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn65 #-}-happyOut65 :: (HappyAbsSyn t74) -> ([RawTerm])-happyOut65 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut65 #-}-happyIn66 :: ((RawTerm, [(Id, RawTerm)])) -> (HappyAbsSyn t74)-happyIn66 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn66 #-}-happyOut66 :: (HappyAbsSyn t74) -> ((RawTerm, [(Id, RawTerm)]))-happyOut66 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut66 #-}-happyIn67 :: ([(Id, RawTerm)]) -> (HappyAbsSyn t74)-happyIn67 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn67 #-}-happyOut67 :: (HappyAbsSyn t74) -> ([(Id, RawTerm)])-happyOut67 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut67 #-}-happyIn68 :: ((Id,Id)) -> (HappyAbsSyn t74)-happyIn68 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn68 #-}-happyOut68 :: (HappyAbsSyn t74) -> ((Id,Id))-happyOut68 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut68 #-}-happyIn69 :: ((Id,Id)) -> (HappyAbsSyn t74)-happyIn69 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn69 #-}-happyOut69 :: (HappyAbsSyn t74) -> ((Id,Id))-happyOut69 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut69 #-}-happyIn70 :: ([(Id, RawTerm)]) -> (HappyAbsSyn t74)-happyIn70 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn70 #-}-happyOut70 :: (HappyAbsSyn t74) -> ([(Id, RawTerm)])-happyOut70 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut70 #-}-happyIn71 :: (Id) -> (HappyAbsSyn t74)-happyIn71 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn71 #-}-happyOut71 :: (HappyAbsSyn t74) -> (Id)-happyOut71 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut71 #-}-happyIn72 :: ([(Id, RawTerm)]) -> (HappyAbsSyn t74)-happyIn72 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn72 #-}-happyOut72 :: (HappyAbsSyn t74) -> ([(Id, RawTerm)])-happyOut72 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut72 #-}-happyIn73 :: ([Id]) -> (HappyAbsSyn t74)-happyIn73 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn73 #-}-happyOut73 :: (HappyAbsSyn t74) -> ([Id])-happyOut73 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut73 #-}-happyIn74 :: t74 -> (HappyAbsSyn t74)-happyIn74 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn74 #-}-happyOut74 :: (HappyAbsSyn t74) -> t74-happyOut74 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut74 #-}-happyIn75 :: ([ConParse]) -> (HappyAbsSyn t74)-happyIn75 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn75 #-}-happyOut75 :: (HappyAbsSyn t74) -> ([ConParse])-happyOut75 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut75 #-}-happyIn76 :: (ConParse) -> (HappyAbsSyn t74)-happyIn76 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn76 #-}-happyOut76 :: (HappyAbsSyn t74) -> (ConParse)-happyOut76 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut76 #-}-happyIn77 :: (RawTerm) -> (HappyAbsSyn t74)-happyIn77 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn77 #-}-happyOut77 :: (HappyAbsSyn t74) -> (RawTerm)-happyOut77 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut77 #-}-happyIn78 :: (ITactic) -> (HappyAbsSyn t74)-happyIn78 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn78 #-}-happyOut78 :: (HappyAbsSyn t74) -> (ITactic)-happyOut78 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut78 #-}-happyIn79 :: ([ITactic]) -> (HappyAbsSyn t74)-happyIn79 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn79 #-}-happyOut79 :: (HappyAbsSyn t74) -> ([ITactic])-happyOut79 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut79 #-}-happyIn80 :: ([ITactic]) -> (HappyAbsSyn t74)-happyIn80 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn80 #-}-happyOut80 :: (HappyAbsSyn t74) -> ([ITactic])-happyOut80 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut80 #-}-happyIn81 :: ([ITactic]) -> (HappyAbsSyn t74)-happyIn81 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn81 #-}-happyOut81 :: (HappyAbsSyn t74) -> ([ITactic])-happyOut81 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut81 #-}-happyIn82 :: (LineNumber) -> (HappyAbsSyn t74)-happyIn82 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn82 #-}-happyOut82 :: (HappyAbsSyn t74) -> (LineNumber)-happyOut82 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut82 #-}-happyIn83 :: (String) -> (HappyAbsSyn t74)-happyIn83 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn83 #-}-happyOut83 :: (HappyAbsSyn t74) -> (String)-happyOut83 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut83 #-}-happyIn84 :: (Fixities) -> (HappyAbsSyn t74)-happyIn84 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn84 #-}-happyOut84 :: (HappyAbsSyn t74) -> (Fixities)-happyOut84 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut84 #-}-happyInTok :: (Token) -> (HappyAbsSyn t74)-happyInTok x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyInTok #-}-happyOutTok :: (HappyAbsSyn t74) -> (Token)-happyOutTok x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOutTok #-}---happyActOffsets :: HappyAddr-happyActOffsets = HappyA# "\x1d\x00\x5e\x05\x18\x02\x00\x00\x49\x04\x5e\x05\x37\x01\x37\x01\x5e\x05\x00\x00\x48\x03\xef\x02\x00\x00\x37\x01\x00\x00\x5e\x05\x5e\x05\x00\x00\x00\x00\x5e\x05\x5e\x05\x5e\x05\x5e\x05\x00\x00\x00\x00\x00\x00\x00\x00\xa9\x01\x00\x00\x00\x00\x00\x00\x00\x00\xa8\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x37\x01\x91\x09\x3d\x02\xc3\x01\x5e\x05\x5e\x05\xae\x08\x5e\x05\x00\x00\x37\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5e\x05\x00\x00\x00\x00\x00\x00\xfc\x00\x00\x00\x5e\x05\x02\x01\x48\x04\x01\x00\x00\x00\x00\x00\x01\x00\xbc\x04\x00\x00\xa2\x04\x00\x00\x87\x04\xe2\x01\xab\x04\xa6\x04\xa5\x04\xa4\x04\x97\x04\x08\x0a\x75\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x89\x04\x88\x04\x84\x04\x02\x01\x02\x01\x02\x01\x8e\x04\x54\x04\x7f\x04\x8f\x04\x5e\x05\x8b\x04\x8a\x04\x00\x00\x00\x00\xbd\x02\x00\x00\x02\x01\x72\x04\x75\x04\x00\x00\x02\x01\x00\x00\x02\x01\x02\x01\x02\x01\x70\x04\x00\x00\x00\x00\x00\x00\x00\x00\x69\x00\x00\x00\x02\x00\x00\x00\x00\x00\x96\x02\x00\x00\x00\x00\x00\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x00\x00\x69\x08\x74\x04\x50\x01\x91\x09\x68\x04\x02\x01\xdc\x01\x5f\x00\x08\x0a\x75\x01\x00\x00\x00\x00\x6f\x04\x16\x04\x0e\x03\x00\x00\x6d\x04\x05\x05\x00\x00\x00\x00\x6c\x04\x00\x00\x6c\x04\x00\x00\x7a\x04\x6f\x03\x00\x00\x18\x02\x18\x02\xb8\x01\x1a\x04\xac\x04\x65\x04\xac\x04\xac\x04\x63\x04\x61\x04\xac\x04\xac\x04\x26\x0a\x62\x04\x59\x04\x1e\x00\x00\x00\x47\x04\xac\x04\x56\x09\x02\x01\x5e\x04\x37\x04\x00\x00\xae\x08\x51\x04\x00\x00\xac\x04\x45\x04\xac\x04\xac\x04\xac\x04\xac\x04\xac\x04\x00\x00\xa6\x01\x91\x01\x7c\x01\x67\x01\x52\x01\x3d\x01\x00\x00\x28\x01\xac\x04\x13\x01\xac\x04\xfe\x00\x00\x00\x3a\x04\x00\x00\xe9\x00\x02\x01\xc7\x00\x65\x00\x00\x00\x5a\x04\x5a\x04\x5a\x04\x5a\x04\x5a\x04\x00\x00\xac\x04\x5a\x04\xae\x08\x00\x00\x00\x00\x00\x00\xac\x04\x2f\x04\xcc\x09\x46\x04\x3e\x04\x28\x04\xa5\x01\x39\x04\x8b\x00\x36\x04\x53\x09\x02\x01\xcc\x09\xcc\x09\xcc\x09\x00\x00\x32\x04\xcc\x09\x31\x04\x00\x00\xd8\x05\x00\x00\xd8\x05\x00\x00\xd8\x05\x00\x00\xd8\x05\x00\x00\xac\x04\x00\x00\xac\x04\xac\x04\xac\x04\xac\x04\xac\x04\x2b\x04\x38\x04\x2d\x04\x24\x04\xac\x04\x00\x00\x00\x00\xac\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0b\x00\xd8\x05\x23\x04\x53\x04\x02\x01\xf6\x03\x00\x00\xfa\x03\xfa\x03\x08\x04\x1b\x04\x04\x04\x19\x04\xfa\x03\xfa\x03\xfa\x03\xc6\x03\x0c\x04\xfd\x03\x00\x00\x00\x00\xd3\x05\x18\x02\x15\x04\x69\x08\xfa\x03\x00\x00\x00\x00\x0b\x04\x06\x04\x05\x04\x03\x04\x01\x04\x00\x00\x00\x00\x18\x04\x02\x04\x00\x00\x00\x00\xfa\x03\xfa\x03\xfa\x03\x00\x00\x07\x04\xfe\x03\xe6\x03\xfc\x03\x02\x01\xeb\x03\x00\x00\x01\x00\x02\x01\xf4\x03\xe5\x03\x00\x00\xfa\x03\x7e\x05\xfb\x03\x00\x04\x00\x00\xd6\x03\x00\x00\xec\x03\xfa\x03\x00\x00\x00\x00\x02\x01\x00\x00\x91\x09\x25\x05\xcc\x04\x7c\x05\x00\x00\x00\x00\x00\x00\x00\x00\xfa\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x23\x05\x00\x00\xe1\x03\xd5\x03\x00\x00\x02\x01\x02\x01\xd1\x03\x91\x09\x00\x00\x00\x00\xdc\x01\x00\x00\x00\x00\xca\x04\x9c\x04\x91\x03\x00\x00\x75\x01\x00\x00\xfa\x03\xaa\x00\xb4\x02\xfa\x03\xda\x03\x00\x00\x00\x00\x00\x00\xb8\x03\x1a\x09\x00\x00\xf3\x08\x16\x03\x00\x00\xc8\x03\xd2\x03\x00\x00\x00\x00\x18\x02\xcc\x09\x00\x00\x67\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xcf\x03\x00\x00\xcd\x03\x00\x00\xae\x08\x00\x00\x1e\x00\xa3\x03\xa2\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xcc\x09\xcc\x09\xbb\x03\x91\x09\x02\x01\x95\x03\x91\x09\x1e\x00\x02\x01\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbf\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf3\x08\xf3\x08\xf3\x08\xf3\x08\xf3\x08\xf3\x08\x00\x00\x00\x00\x00\x00\x00\x00\xcc\x09\x00\x00\xd4\x00\x8c\x03\xd0\x01\x0a\x00\x00\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x91\x09\x00\x00\x00\x00\x24\x08\x00\x00\xdf\x07\x00\x00\x9a\x07\x00\x00\x55\x07\xbd\x03\xb7\x03\xb6\x03\xb4\x03\xb3\x03\x55\x00\x00\x00\x00\x00\xfa\x03\x00\x00\x00\x00\xfa\x03\x10\x07\xa0\x03\xd8\x05\xfa\x03\xde\x01\x00\x00\x46\x00\xa9\x03\xa7\x03\x00\x00\x00\x00\x00\x00\xf8\xff\x00\x00\xcb\x06\xab\x03\xa6\x03\x00\x00\x00\x00\x00\x00\x00\x00\xd9\x01\x00\x00\x86\x06\x00\x00\x46\x00\x00\x00\x99\x03\x86\x03\x9a\x03\x38\x03\x00\x00\x02\x01\x76\x03\x00\x00\x00\x00\x02\x01\x8d\x03\x00\x00\x00\x00\x02\x01\x02\x01\x46\x00\x7d\x03\x00\x00\x00\x00\x00\x00\x83\x03\xd9\x01\x8b\x03\x00\x00\x00\x00\x00\x00\x7b\x03\x00\x00\x00\x00\x02\x01\x00\x00\xae\x08\x00\x00\x00\x00\x91\x09\x00\x00\x3e\x03\x00\x00\x00\x00\x00\x00\x02\x01\x00\x00\x74\x03\x02\x01\x82\x03\x00\x00\xfa\x03\x00\x00\xd8\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5d\x03\x61\x03\x00\x00\x00\x00\xcc\x09\x49\x03\x49\x03\x00\x00\xd0\x01\x62\x03\x00\x00\x00\x00\x00\x00\xde\x01\x41\x06\x00\x00\x00\x00\x00\x00\x00\x00\x60\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5f\x03\x00\x00\x00\x00\x00\x00\x00\x00\xbd\x00\x5e\x03\x00\x00\x00\x00\x00\x00\x00\x00\xa1\x03\x00\x00\xfc\x05\x00\x00\x00\x00\x00\x00\x00\x00\xb7\x05\x5b\x03\x00\x00\x00\x00\x00\x00\x3c\x03\x02\x01\x00\x00\x02\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"#--happyGotoOffsets :: HappyAddr-happyGotoOffsets = HappyA# "\xf6\x0a\x55\x10\x24\x03\x00\x00\x00\x00\x3f\x10\x96\x01\x51\x03\x29\x10\x00\x00\x13\x10\xfd\x0f\x00\x00\x47\x03\x00\x00\xe7\x0f\xd1\x0f\x00\x00\x00\x00\xbb\x0f\xa5\x0f\x8f\x0f\x79\x0f\x00\x00\x00\x00\x00\x00\x1a\x03\x39\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x17\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\xb7\x0c\x77\x0b\x10\x03\x63\x0f\x4d\x0f\x9e\x10\x37\x0f\x00\x00\x3f\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x21\x0f\x00\x00\x07\x03\x06\x03\x00\x00\x05\x03\x0b\x0f\x59\x01\x00\x00\xdb\x0a\x00\x00\x00\x00\xd4\x0a\x00\x00\x00\x00\x44\x03\x00\x00\x2e\x03\x8d\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb9\x00\x31\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1d\x03\x1c\x03\x14\x03\x00\x00\x00\x00\x00\x00\x00\x00\xf5\x0e\x00\x00\x00\x00\x00\x00\x00\x00\x39\x01\xe7\x02\x08\x01\x00\x00\x00\x00\xe5\x02\x68\x01\x00\x00\x41\x01\x13\x03\x74\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x27\x03\xdd\x02\x29\x01\x00\x00\xd2\x02\x7f\x0b\x00\x00\xd1\x02\xd0\x02\xbe\x0a\x88\x0a\x72\x0a\x6b\x0a\x50\x0a\x00\x00\xf9\x06\x00\x00\x00\x00\x8b\x0c\x00\x00\x02\x03\xea\x01\x15\x03\x94\x00\xe0\x01\x00\x00\x00\x00\xec\x02\x00\x00\x24\x01\xc9\x02\xdf\x02\xc7\x0b\xc7\x02\xbf\x02\x21\x01\xc0\x02\x14\x01\x00\x00\x0f\x01\x0f\x01\xbc\x02\xc9\x01\xc5\x01\x2a\x00\xdf\xff\xdf\x0e\x00\x00\xc9\x0e\xb3\x0e\x00\x00\x00\x00\x4f\x0b\x4a\x0b\x0c\x01\xdb\x02\x00\x00\x00\x00\x00\x00\x00\x00\x9d\x0e\xa7\x02\xb4\x01\xda\x02\x00\x00\xb6\x02\x8d\x10\x00\x00\xb5\x02\x87\x0e\xb3\x02\x71\x0e\x5b\x0e\x45\x0e\x2f\x0e\x19\x0e\xae\x02\x0a\x01\x0a\x01\x0a\x01\x0a\x01\x0a\x01\x0a\x01\x00\x00\x0a\x01\x03\x0e\x0a\x01\xed\x0d\x0a\x01\x00\x00\x00\x00\x00\x00\x0a\x01\x81\x01\x0a\x01\x0a\x01\x00\x00\x04\x01\xff\x00\xef\x00\xe5\x00\xd6\x00\xad\x02\xd7\x0d\xd2\x00\x80\x10\xa4\x02\x9d\x02\x00\x00\xc1\x0d\x00\x00\x26\x07\x00\x00\x00\x00\x00\x00\x06\x00\x00\x00\x00\x00\x00\x00\xcd\x00\x33\x01\x9c\x06\x57\x06\x99\x05\x00\x00\x00\x00\x69\x04\x00\x00\x9a\x02\xcb\x00\x97\x02\xc2\x00\x92\x02\xbb\x00\x90\x02\xb0\x00\x8f\x02\x2b\x0b\x00\x00\x26\x0b\xab\x0d\x95\x0d\x88\x09\x07\x0b\x00\x00\x00\x00\x00\x00\x00\x00\x09\x0c\x00\x00\x88\x02\x7f\x0d\x87\x02\x86\x02\x7b\x02\x00\x00\x00\x00\xfc\xff\x99\x00\x00\x00\xb1\x0b\x3e\x01\x00\x00\x00\x00\x69\x0d\x53\x0d\x00\x00\x00\x00\x00\x00\xbe\x02\x3d\x0d\x27\x0d\x11\x0d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0e\x00\xc1\x01\x00\x00\xb4\x06\xfb\x0c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x77\x02\x71\x02\x79\x00\x00\x00\x70\x02\x68\x02\xe5\x0c\xcf\x0c\xb9\x0c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5e\x01\x00\x00\x64\x02\xd6\x09\x95\x02\x00\x00\x00\x00\x61\x02\xa3\x0c\x79\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x8d\x0c\x00\x00\x00\x00\x91\x02\x00\x00\x5f\x0c\x79\x00\x79\x00\x79\x00\x00\x00\x00\x00\x5c\x02\x00\x00\xf3\x0b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x79\x00\x5a\x02\x99\x02\x00\x00\x54\x02\x4f\x00\xef\xff\x00\x00\x33\x0c\x53\x02\x17\x02\xa4\x01\x00\x00\x00\x00\x79\x00\x79\x00\x79\x00\x00\x00\x35\x01\x00\x00\x77\x0c\x79\x00\x79\x00\x61\x0c\x02\x02\x00\x00\x00\x00\x47\x02\x00\x00\x78\x10\x00\x00\x78\x10\x79\x00\x46\x02\x79\x00\x00\x00\x00\x00\x00\x00\xbe\x01\x44\x04\x45\x02\x79\x00\x00\x00\x41\x02\x22\x02\x21\x02\x20\x02\x1e\x02\x1c\x02\x1b\x02\x00\x00\x1a\x02\x00\x00\x12\x02\x6b\x10\x10\x02\x00\x00\x00\x00\x00\x00\x0f\x02\x0e\x02\x00\x00\x00\x00\x0c\x02\x00\x00\xb2\x03\xc2\x01\x07\x02\x07\x0c\x4e\x01\x00\x00\xdb\x0b\x00\x00\x2e\x00\x79\x00\x0a\x02\x08\x02\x00\x00\xfe\x01\x79\x00\x00\x00\xfd\x01\xfc\x01\xfb\x01\xf0\x01\xec\x01\x00\x00\x5a\x10\x5a\x10\x5a\x10\x5a\x10\x5a\x10\x5a\x10\x00\x00\x00\x00\x00\x00\x00\x00\xe1\x02\x00\x00\x00\x00\x00\x00\xaa\x01\x00\x00\x00\x00\xdb\x01\xeb\x01\xdf\x01\xd1\x01\xf0\x09\xc6\x01\x00\x00\x50\x10\x00\x00\x50\x10\x00\x00\x50\x10\x00\x00\x50\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xdd\x0b\x00\x00\x95\x01\x4b\x0c\x50\x10\x00\x00\x78\x00\x35\x0c\x6b\x00\x00\x00\xa0\x02\xe7\x01\x00\x00\x00\x00\xb3\x01\xab\x01\x9e\x01\x8c\x01\xf6\x01\x00\x00\x00\x00\x00\x00\x89\x01\x00\x00\x6a\x01\x23\x01\x85\x01\x2a\x06\x7e\x01\x4f\x02\x00\x00\x00\x00\x00\x00\x00\x00\x6b\x00\x00\x00\x93\x01\x00\x00\x00\x00\x00\x00\x75\x00\x00\x00\x00\x00\x00\x00\x71\x00\x73\x01\xfe\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x12\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x56\x01\x00\x00\xed\xff\x00\x00\x97\x08\x00\x00\x00\x00\x02\x09\x4a\x01\x00\x00\x00\x00\x00\x00\x00\x00\x6e\x01\xc0\x00\x00\x00\xd5\x00\x5c\x00\x9c\x00\x1f\x0c\x00\x00\x47\x00\x95\x00\x00\x00\x77\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x83\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc4\x01\x00\x00\x00\x00\x00\x00\xc8\x00\x00\x00\x7f\x00\x00\x00\x4a\x00\x21\x00\xdc\x08\x38\x00\x00\x00\x20\x00\xee\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6b\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\x03\x00\x00\x00\xd0\xff\xdc\x08\x9b\x0b\xcb\xff\xdc\x08\x00\x00\x00\x00\x00\x00\x00\x00\xdc\x08\x00\x00\x00\x00\xc6\xff\x00\x00\x00\x00\x1d\x01\x00\x00\xf5\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"#--happyDefActions :: HappyAddr-happyDefActions = HappyA# "\x21\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0e\xff\x00\x00\x00\x00\x0a\xff\x00\x00\x00\x00\x05\xff\x00\x00\x03\xff\x00\x00\x00\x00\x00\xff\xff\xfe\x00\x00\x00\x00\x00\x00\x00\x00\xfa\xfe\xf9\xfe\xf8\xfe\xf0\xfe\xf0\xfe\x9b\xff\x80\xff\x45\xff\x46\xff\xa2\xff\x44\xff\x49\xff\xf0\xfe\xab\xff\x29\xff\x2b\xff\x27\xff\x2a\xff\x28\xff\x52\xff\x00\x00\x00\x00\x00\x00\xf0\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x4a\xff\x00\x00\x31\xff\x30\xff\x2f\xff\x32\xff\x2d\xff\x2e\xff\x2c\xff\x34\xff\x33\xff\x00\x00\x4d\xff\xf0\xfe\xf0\xfe\x00\x00\xf0\xfe\x00\x00\x00\x00\x00\x00\x21\xff\xef\xff\xf8\xff\x21\xff\x00\x00\xf6\xff\xda\xff\xf7\xff\xb1\xff\xbb\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb6\xff\xb5\xff\xc0\xff\xc2\xff\xc1\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\xeb\xff\xec\xff\xf0\xfe\xf0\xfe\x00\x00\x00\x00\x00\x00\xf0\xfe\x8c\xff\x1c\xff\x00\x00\x00\x00\x00\x00\x00\x00\xc6\xff\xc5\xff\xc4\xff\xc3\xff\x00\x00\xf0\xfe\xf0\xfe\xd8\xff\xf0\xfe\x00\x00\xa5\xff\xf0\xfe\xf0\xfe\x21\xff\x21\xff\x21\xff\x21\xff\x21\xff\xbc\xff\xbb\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xfa\xff\xfb\xff\x70\xff\x00\x00\xf0\xfe\xf1\xfe\x70\xff\x00\x00\xf1\xfe\xf1\xfe\xf0\xfe\xf0\xfe\xf0\xfe\x53\xff\xf0\xfe\xf0\xfe\xf1\xfe\x00\x00\x00\x00\xf0\xfe\xf0\xfe\x00\x00\x00\x00\xc6\xff\xc5\xff\x72\xff\x71\xff\xf0\xfe\xf0\xfe\xf0\xfe\x6e\xff\x00\x00\x6b\xff\x60\xff\x8e\xff\x00\x00\x00\x00\x00\x00\x70\xff\x00\x00\xf1\xfe\x00\x00\x00\x00\xf1\xfe\x00\x00\xf0\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf1\xfe\xf0\xfe\xf0\xfe\xf0\xfe\xf0\xfe\xf0\xfe\xf0\xfe\x04\xff\xf0\xfe\x00\x00\xf0\xfe\x00\x00\xf0\xfe\x0d\xff\x94\xff\x0f\xff\xf0\xfe\x00\x00\xf0\xfe\xf0\xfe\x56\xff\xf0\xfe\xf0\xfe\xf0\xfe\xf0\xfe\xf0\xfe\xf1\xfe\x00\x00\xf0\xfe\x00\x00\xf0\xfe\xf0\xfe\x4e\xff\x00\x00\x99\xff\x00\x00\x00\x00\x00\x00\x96\xff\xf0\xfe\x00\x00\x00\x00\x00\x00\xf0\xfe\x00\x00\x00\x00\x00\x00\x00\x00\xa1\xff\x00\x00\x00\x00\x00\x00\xf1\xfe\xf0\xfe\xf1\xfe\xf0\xfe\xf1\xfe\xf0\xfe\xf0\xfe\xf0\xfe\xf0\xfe\xf0\xfe\x54\xff\xf0\xfe\x72\xff\x71\xff\xf0\xfe\xf0\xfe\x00\x00\xf5\xfe\x00\x00\x00\x00\x3e\xff\x48\xff\xf0\xfe\x00\x00\xf1\xfe\xf1\xfe\xf1\xfe\x4c\xff\x4b\xff\xf0\xfe\xf0\xfe\x00\x00\x38\xff\x00\x00\x00\x00\x55\xff\x00\x00\x00\x00\x00\x00\x00\x00\xc8\xff\xda\xff\x00\x00\x00\x00\x00\x00\xdd\xff\x00\x00\xaf\xff\xad\xff\xac\xff\x00\x00\x00\x00\x00\x00\xbb\xff\x00\x00\xe8\xff\xba\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf1\xfe\xf1\xfe\xf0\xfe\x00\x00\xf1\xfe\xf1\xfe\x00\x00\x00\x00\x00\x00\xaa\xff\x00\x00\x00\x00\x00\x00\x00\x00\x8c\xff\x00\x00\xf1\xfe\x21\xff\x00\x00\x00\x00\x00\x00\xf1\xfe\x00\x00\xf0\xfe\x00\x00\x00\x00\xbf\xff\x00\x00\xf9\xff\x00\x00\x00\x00\x8b\xff\x1d\xff\x00\x00\x20\xff\x00\x00\xf0\xfe\xf0\xfe\xf0\xfe\xa7\xff\xa6\xff\xf0\xfe\xd7\xff\x00\x00\xa4\xff\xa3\xff\xf0\xff\xf1\xff\xf2\xff\xf3\xff\xf4\xff\xf0\xfe\xf0\xfe\xd2\xff\x00\x00\xf0\xfe\x19\xff\x15\xff\x00\x00\x00\x00\xf0\xfe\xf0\xfe\x00\x00\xb0\xff\xdc\xff\xf0\xfe\xf0\xfe\xf0\xfe\xdb\xff\x00\x00\xc9\xff\x00\x00\xf0\xfe\xf0\xfe\x00\x00\x70\xff\x39\xff\x3b\xff\xf1\xfe\x00\x00\x9e\xff\x4f\xff\x86\xff\xf0\xfe\xf1\xfe\xf0\xfe\x00\x00\x51\xff\x50\xff\xf6\xfe\x00\x00\xf1\xfe\xf0\xfe\x3f\xff\xf1\xfe\xf1\xfe\xf1\xfe\xf1\xfe\xf1\xfe\xf1\xfe\xf1\xfe\x00\x00\xf1\xfe\x00\x00\xf1\xfe\x00\x00\xf0\xfe\x6d\xff\x00\x00\x6a\xff\xf0\xfe\xf0\xfe\x8d\xff\x64\xff\xf0\xfe\x67\xff\x00\x00\x00\x00\x5c\xff\x00\x00\x00\x00\x00\x00\x00\x00\x6f\xff\x00\x00\xf0\xfe\xf1\xfe\xf1\xfe\xa0\xff\xf1\xfe\xf0\xfe\x88\xff\xf1\xfe\xf1\xfe\xf1\xfe\xf1\xfe\xf1\xfe\x93\xff\x81\xff\x84\xff\x82\xff\x83\xff\x85\xff\x7e\xff\x9f\xff\x7f\xff\x98\xff\x95\xff\x00\x00\x97\xff\x6f\xff\x00\x00\x00\x00\x58\xff\x57\xff\xf0\xfe\xf1\xfe\xf1\xfe\xf1\xfe\x00\x00\xf1\xfe\xa9\xff\x00\x00\x76\xff\x00\x00\x75\xff\x00\x00\x47\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf4\xfe\x43\xff\x3e\xff\x41\xff\xf0\xfe\x00\x00\x00\x00\x00\x00\xf0\xfe\x00\x00\xf0\xfe\xc7\xff\x00\x00\xd2\xff\x00\x00\xae\xff\xf1\xfe\xf1\xfe\x21\xff\xf0\xfe\x26\xff\x00\x00\x14\xff\x18\xff\xf1\xfe\xf7\xfe\xf0\xfe\xd1\xff\xf1\xfe\xbb\xff\xf1\xfe\x00\x00\xe4\xff\x00\x00\x1b\xff\x00\x00\xf0\xfe\xed\xff\x00\x00\xbe\xff\xf5\xff\xea\xff\x00\x00\x00\x00\xee\xff\x1e\xff\x00\x00\x00\x00\xd4\xff\x00\x00\xd6\xff\xb8\xff\xb9\xff\x00\x00\xd1\xff\x00\x00\xcb\xff\xcf\xff\xce\xff\xcc\xff\xf1\xfe\xb7\xff\x15\xff\xb4\xff\x26\xff\x11\xff\x12\xff\x00\x00\xf1\xfe\x00\x00\xb3\xff\xb2\xff\x23\xff\x00\x00\xf0\xfe\x00\x00\x00\x00\xf0\xfe\xf1\xfe\x00\x00\x35\xff\xf0\xfe\xf1\xfe\x3c\xff\xf0\xfe\x78\xff\x74\xff\x79\xff\x7c\xff\x7a\xff\x7b\xff\x7d\xff\x73\xff\x77\xff\xa8\xff\x6c\xff\x62\xff\x63\xff\x61\xff\xf1\xfe\x5a\xff\x00\x00\x5f\xff\x5e\xff\x00\x00\x68\xff\x69\xff\x5d\xff\x00\x00\x00\x00\xf1\xfe\x42\xff\xf1\xfe\xf0\xfe\x00\x00\xf1\xfe\x89\xff\xf0\xfe\xf1\xfe\x00\x00\x24\xff\x22\xff\x10\xff\x25\xff\x13\xff\xe9\xff\x00\x00\xca\xff\xd0\xff\xd3\xff\xe2\xff\xd5\xff\x00\x00\x1a\xff\x1f\xff\xbd\xff\xe3\xff\x91\xff\x00\x00\xf0\xfe\xe5\xff\xf1\xfe\x9a\xff\x00\x00\xf1\xfe\x00\x00\x59\xff\x66\xff\x5b\xff\x37\xff\x00\x00\x00\x00\xe7\xff\xf1\xfe\xcd\xff\x92\xff\x00\x00\x90\xff\x00\x00\xe6\xff\x3a\xff\x36\xff\x8f\xff"#--happyCheck :: HappyAddr-happyCheck = HappyA# "\xff\xff\x03\x00\x01\x00\x0b\x00\x25\x00\x03\x00\x08\x00\x1a\x00\x29\x00\x1a\x00\x02\x00\x03\x00\x02\x00\x0c\x00\x0c\x00\x1a\x00\x12\x00\x10\x00\x4c\x00\x0b\x00\x13\x00\x0a\x00\x21\x00\x4c\x00\x1a\x00\x11\x00\x12\x00\x13\x00\x4c\x00\x15\x00\x01\x00\x17\x00\x02\x00\x19\x00\x20\x00\x21\x00\x16\x00\x1d\x00\x2a\x00\x1d\x00\x1a\x00\x0c\x00\x22\x00\x23\x00\x4d\x00\x10\x00\x26\x00\x27\x00\x2a\x00\x27\x00\x45\x00\x46\x00\x45\x00\x46\x00\x2e\x00\x2f\x00\x2e\x00\x41\x00\x4c\x00\x1d\x00\x31\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x25\x00\x01\x00\x1a\x00\x4d\x00\x3c\x00\x1d\x00\x2e\x00\x4b\x00\x4d\x00\x4e\x00\x4d\x00\x43\x00\x0c\x00\x4d\x00\x2a\x00\x54\x00\x10\x00\x02\x00\x57\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x5a\x00\x5b\x00\x01\x00\x5d\x00\x11\x00\x02\x00\x03\x00\x1a\x00\x4d\x00\x4e\x00\x25\x00\x4d\x00\x4d\x00\x0c\x00\x0b\x00\x54\x00\x1d\x00\x10\x00\x57\x00\x74\x00\x13\x00\x4d\x00\x13\x00\x78\x00\x15\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x20\x00\x21\x00\x25\x00\x1d\x00\x2e\x00\x4c\x00\x7d\x00\x11\x00\x22\x00\x23\x00\x20\x00\x21\x00\x1a\x00\x27\x00\x02\x00\x1a\x00\x1a\x00\x25\x00\x74\x00\x43\x00\x2e\x00\x4d\x00\x78\x00\x4c\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x07\x00\x11\x00\x25\x00\x25\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x1d\x00\x4d\x00\x4b\x00\x20\x00\x02\x00\x03\x00\x1a\x00\x1b\x00\x4d\x00\x4e\x00\x27\x00\x42\x00\x4b\x00\x0b\x00\x42\x00\x54\x00\x4d\x00\x2e\x00\x57\x00\x11\x00\x12\x00\x13\x00\x25\x00\x15\x00\x07\x00\x17\x00\x05\x00\x19\x00\x4d\x00\x4d\x00\x4d\x00\x1d\x00\x34\x00\x02\x00\x03\x00\x4c\x00\x22\x00\x23\x00\x3a\x00\x4c\x00\x26\x00\x27\x00\x0b\x00\x1a\x00\x1b\x00\x25\x00\x02\x00\x74\x00\x2e\x00\x2f\x00\x13\x00\x78\x00\x15\x00\x7a\x00\x7b\x00\x7c\x00\x25\x00\x4c\x00\x7d\x00\x26\x00\x1d\x00\x11\x00\x4d\x00\x25\x00\x4c\x00\x22\x00\x23\x00\x02\x00\x03\x00\x34\x00\x27\x00\x1a\x00\x25\x00\x1d\x00\x25\x00\x3a\x00\x0b\x00\x2e\x00\x2e\x00\x25\x00\x30\x00\x24\x00\x26\x00\x25\x00\x13\x00\x4d\x00\x15\x00\x03\x00\x02\x00\x03\x00\x2e\x00\x01\x00\x5a\x00\x5b\x00\x1d\x00\x5d\x00\x4d\x00\x0b\x00\x25\x00\x22\x00\x23\x00\x4d\x00\x12\x00\x4d\x00\x27\x00\x13\x00\x10\x00\x15\x00\x25\x00\x02\x00\x03\x00\x2e\x00\x4d\x00\x11\x00\x4d\x00\x1d\x00\x0a\x00\x0b\x00\x0b\x00\x4d\x00\x22\x00\x23\x00\x1a\x00\x4d\x00\x25\x00\x27\x00\x13\x00\x7d\x00\x15\x00\x25\x00\x02\x00\x03\x00\x2e\x00\x0a\x00\x0b\x00\x25\x00\x1d\x00\x25\x00\x4d\x00\x0b\x00\x25\x00\x22\x00\x23\x00\x1a\x00\x01\x00\x25\x00\x27\x00\x13\x00\x4d\x00\x15\x00\x21\x00\x02\x00\x03\x00\x2e\x00\x0d\x00\x0e\x00\x7d\x00\x1d\x00\x25\x00\x10\x00\x0b\x00\x25\x00\x22\x00\x23\x00\x4d\x00\x1a\x00\x25\x00\x27\x00\x13\x00\x4d\x00\x15\x00\x20\x00\x02\x00\x03\x00\x2e\x00\x4d\x00\x1a\x00\x4d\x00\x1d\x00\x1a\x00\x4d\x00\x0b\x00\x25\x00\x22\x00\x23\x00\x4d\x00\x24\x00\x13\x00\x27\x00\x13\x00\x7d\x00\x15\x00\x1a\x00\x02\x00\x03\x00\x2e\x00\x1e\x00\x1f\x00\x4d\x00\x1d\x00\x20\x00\x4d\x00\x0b\x00\x1a\x00\x22\x00\x23\x00\x4d\x00\x02\x00\x1a\x00\x27\x00\x13\x00\x7d\x00\x15\x00\x24\x00\x02\x00\x03\x00\x2e\x00\x23\x00\x1a\x00\x42\x00\x1d\x00\x1a\x00\x4d\x00\x0b\x00\x1a\x00\x22\x00\x23\x00\x23\x00\x21\x00\x1a\x00\x27\x00\x13\x00\x7d\x00\x15\x00\x1d\x00\x02\x00\x03\x00\x2e\x00\x4c\x00\x22\x00\x23\x00\x1d\x00\x1a\x00\x1a\x00\x0b\x00\x1d\x00\x22\x00\x23\x00\x13\x00\x20\x00\x4c\x00\x27\x00\x13\x00\x7d\x00\x15\x00\x1a\x00\x02\x00\x03\x00\x2e\x00\x02\x00\x03\x00\x1a\x00\x1d\x00\x0a\x00\x1a\x00\x0b\x00\x0d\x00\x22\x00\x23\x00\x28\x00\x20\x00\x4d\x00\x27\x00\x13\x00\x7d\x00\x15\x00\x18\x00\x19\x00\x31\x00\x2e\x00\x33\x00\x34\x00\x0a\x00\x1d\x00\x37\x00\x0d\x00\x1d\x00\x3a\x00\x22\x00\x23\x00\x4c\x00\x22\x00\x23\x00\x27\x00\x1a\x00\x7d\x00\x27\x00\x4c\x00\x1e\x00\x1f\x00\x2e\x00\x4c\x00\x49\x00\x2e\x00\x2e\x00\x4d\x00\x30\x00\x3d\x00\x1a\x00\x1b\x00\x1a\x00\x1b\x00\x02\x00\x03\x00\x4d\x00\x01\x00\x7d\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0d\x00\x0e\x00\x2d\x00\x09\x00\x2d\x00\x10\x00\x31\x00\x32\x00\x31\x00\x14\x00\x4c\x00\x16\x00\x7d\x00\x18\x00\x1d\x00\x3a\x00\x1b\x00\x3a\x00\x4c\x00\x22\x00\x23\x00\x18\x00\x19\x00\x26\x00\x27\x00\x48\x00\x25\x00\x4a\x00\x48\x00\x28\x00\x4a\x00\x2e\x00\x48\x00\x7d\x00\x4a\x00\x1a\x00\x48\x00\x4c\x00\x4a\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x4c\x00\x28\x00\x4f\x00\x50\x00\x5e\x00\x5f\x00\x7d\x00\x48\x00\x49\x00\x7d\x00\x31\x00\x4d\x00\x33\x00\x34\x00\x4c\x00\x2a\x00\x37\x00\x55\x00\x56\x00\x3a\x00\x3b\x00\x1a\x00\x51\x00\x52\x00\x53\x00\x2f\x00\x4c\x00\x4c\x00\x57\x00\x58\x00\x5d\x00\x4c\x00\x47\x00\x01\x00\x02\x00\x5e\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x4c\x00\x4c\x00\x4c\x00\x4c\x00\x0e\x00\x0f\x00\x10\x00\x75\x00\x76\x00\x77\x00\x14\x00\x03\x00\x16\x00\x4c\x00\x18\x00\x4c\x00\x08\x00\x1b\x00\x4d\x00\x1d\x00\x4d\x00\x4d\x00\x4d\x00\x4c\x00\x22\x00\x23\x00\x12\x00\x25\x00\x26\x00\x4d\x00\x28\x00\x4c\x00\x4c\x00\x4c\x00\x1a\x00\x4c\x00\x2e\x00\x4c\x00\x4c\x00\x4c\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\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\x4f\x00\x4c\x00\x51\x00\x52\x00\x53\x00\x4c\x00\x4c\x00\x4c\x00\x57\x00\x58\x00\x59\x00\x01\x00\x02\x00\x5c\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x4d\x00\x4d\x00\x09\x00\x03\x00\x0e\x00\x0f\x00\x10\x00\x4d\x00\x08\x00\x4d\x00\x14\x00\x1a\x00\x16\x00\x4c\x00\x18\x00\x1a\x00\x4c\x00\x1b\x00\x12\x00\x1d\x00\x4c\x00\x0e\x00\x02\x00\x03\x00\x22\x00\x23\x00\x1a\x00\x25\x00\x4c\x00\x4c\x00\x28\x00\x02\x00\x03\x00\x1a\x00\x1b\x00\x4c\x00\x06\x00\x1e\x00\x1f\x00\x4c\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x1d\x00\x4c\x00\x4c\x00\x2d\x00\x4d\x00\x22\x00\x23\x00\x31\x00\x32\x00\x1d\x00\x27\x00\x4d\x00\x4d\x00\x4c\x00\x22\x00\x23\x00\x3a\x00\x2e\x00\x4c\x00\x27\x00\x4f\x00\x4c\x00\x51\x00\x52\x00\x53\x00\x4d\x00\x2e\x00\x2f\x00\x57\x00\x58\x00\x59\x00\x01\x00\x4d\x00\x5c\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x4c\x00\x4c\x00\x1a\x00\x1b\x00\x0e\x00\x0f\x00\x10\x00\x4d\x00\x4c\x00\x4c\x00\x14\x00\x2a\x00\x16\x00\x2b\x00\x18\x00\x4c\x00\x2a\x00\x1b\x00\x4c\x00\x1d\x00\x4d\x00\x2d\x00\x5b\x00\x02\x00\x03\x00\x31\x00\x4c\x00\x25\x00\x4c\x00\x2a\x00\x28\x00\x02\x00\x03\x00\x05\x00\x3a\x00\x1a\x00\x4d\x00\x4d\x00\x4d\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x4d\x00\x1d\x00\x05\x00\x1a\x00\x1a\x00\x19\x00\x22\x00\x23\x00\x4d\x00\x1d\x00\x4d\x00\x27\x00\x1a\x00\x1a\x00\x22\x00\x23\x00\x02\x00\x03\x00\x2e\x00\x27\x00\x4f\x00\x0e\x00\x51\x00\x52\x00\x53\x00\x0b\x00\x2e\x00\x17\x00\x57\x00\x58\x00\x59\x00\x01\x00\x06\x00\x5c\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x4d\x00\x4d\x00\x4d\x00\x1d\x00\x0e\x00\x0f\x00\x10\x00\x1a\x00\x22\x00\x23\x00\x14\x00\x4d\x00\x16\x00\x27\x00\x18\x00\x1a\x00\x26\x00\x1b\x00\x4d\x00\x1d\x00\x2e\x00\x4d\x00\x5a\x00\x02\x00\x03\x00\x1a\x00\x48\x00\x25\x00\x13\x00\x11\x00\x28\x00\x02\x00\x03\x00\x11\x00\x15\x00\x15\x00\x15\x00\x2e\x00\x11\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x26\x00\x1d\x00\x03\x00\x17\x00\x13\x00\x4a\x00\x22\x00\x23\x00\x10\x00\x1d\x00\x26\x00\x27\x00\x04\x00\x13\x00\x22\x00\x23\x00\x02\x00\x03\x00\x2e\x00\x27\x00\x4f\x00\x15\x00\x51\x00\x52\x00\x53\x00\x26\x00\x2e\x00\x11\x00\x57\x00\x58\x00\x59\x00\x01\x00\x12\x00\x5c\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x11\x00\x26\x00\x14\x00\x1d\x00\x0e\x00\x0f\x00\x10\x00\x0c\x00\x22\x00\x23\x00\x14\x00\x0b\x00\x16\x00\x27\x00\x18\x00\x2e\x00\x14\x00\x1b\x00\x14\x00\x1d\x00\x2e\x00\x20\x00\x02\x00\x03\x00\x2e\x00\x11\x00\x11\x00\x25\x00\x11\x00\x11\x00\x28\x00\x02\x00\x03\x00\x1a\x00\x1b\x00\x11\x00\x14\x00\x2e\x00\x2e\x00\x13\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x1d\x00\x15\x00\x11\x00\x2d\x00\x11\x00\x22\x00\x23\x00\x31\x00\x0a\x00\x1d\x00\x27\x00\x15\x00\x13\x00\x31\x00\x22\x00\x23\x00\x3a\x00\x2e\x00\x26\x00\x27\x00\x4f\x00\x20\x00\x51\x00\x52\x00\x53\x00\x14\x00\x2e\x00\x0b\x00\x57\x00\x58\x00\x59\x00\x01\x00\x26\x00\x5c\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x04\x00\x20\x00\x0b\x00\x13\x00\x0e\x00\x0f\x00\x10\x00\x20\x00\x26\x00\x11\x00\x14\x00\x11\x00\x16\x00\x0a\x00\x18\x00\x11\x00\x13\x00\x1b\x00\x13\x00\x1d\x00\x13\x00\x13\x00\x02\x00\x03\x00\x02\x00\x03\x00\x13\x00\x25\x00\x0b\x00\x15\x00\x28\x00\x26\x00\x5e\x00\x0c\x00\x0b\x00\x31\x00\x20\x00\x11\x00\x26\x00\x11\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x1d\x00\x13\x00\x1d\x00\x0d\x00\x15\x00\x22\x00\x23\x00\x22\x00\x23\x00\x26\x00\x27\x00\x26\x00\x27\x00\x15\x00\x0b\x00\x13\x00\x13\x00\x2e\x00\x11\x00\x2e\x00\x4f\x00\x11\x00\x51\x00\x52\x00\x53\x00\x26\x00\x11\x00\x0a\x00\x57\x00\x58\x00\x59\x00\x01\x00\x26\x00\x5c\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x03\x00\x1a\x00\x1b\x00\x26\x00\x0e\x00\x0f\x00\x10\x00\x13\x00\x20\x00\x2f\x00\x14\x00\x0a\x00\x16\x00\x11\x00\x18\x00\x0a\x00\x26\x00\x1b\x00\x03\x00\x1d\x00\x2d\x00\x11\x00\x5d\x00\x11\x00\x31\x00\x11\x00\x0a\x00\x25\x00\x0a\x00\x12\x00\x28\x00\x02\x00\x03\x00\x3a\x00\x0b\x00\x0b\x00\x11\x00\x10\x00\x1a\x00\x1b\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x04\x00\x04\x00\x01\x00\x12\x00\x04\x00\x19\x00\x10\x00\x41\x00\x2d\x00\x1d\x00\x10\x00\x10\x00\x31\x00\x14\x00\x22\x00\x23\x00\x02\x00\x03\x00\x26\x00\x27\x00\x4f\x00\x3a\x00\x51\x00\x52\x00\x53\x00\x0b\x00\x2e\x00\x12\x00\x57\x00\x58\x00\x59\x00\x01\x00\x0c\x00\x5c\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x12\x00\x12\x00\x12\x00\x1d\x00\x0e\x00\x0f\x00\x10\x00\x12\x00\x22\x00\x23\x00\x14\x00\x05\x00\x16\x00\x27\x00\x18\x00\x7d\x00\x7d\x00\x1b\x00\x20\x00\x1d\x00\x2e\x00\xff\xff\x02\x00\x03\x00\x02\x00\x03\x00\xff\xff\x25\x00\xff\xff\xff\xff\x28\x00\x0b\x00\xff\xff\x0b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x1d\x00\xff\xff\x1d\x00\xff\xff\xff\xff\x22\x00\x23\x00\x22\x00\x23\x00\xff\xff\x27\x00\xff\xff\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\xff\xff\x2e\x00\x4f\x00\xff\xff\x51\x00\x52\x00\x53\x00\xff\xff\xff\xff\xff\xff\x57\x00\x58\x00\x59\x00\x01\x00\xff\xff\x5c\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x00\x0f\x00\x10\x00\xff\xff\xff\xff\xff\xff\x14\x00\xff\xff\x16\x00\xff\xff\x18\x00\xff\xff\xff\xff\x1b\x00\xff\xff\x1d\x00\xff\xff\xff\xff\x02\x00\x03\x00\x02\x00\x03\x00\xff\xff\x25\x00\xff\xff\xff\xff\x28\x00\xff\xff\xff\xff\x0b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x13\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x1d\x00\xff\xff\x1d\x00\xff\xff\xff\xff\x22\x00\x23\x00\x22\x00\x23\x00\xff\xff\x27\x00\xff\xff\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\xff\xff\x2e\x00\x4f\x00\xff\xff\x51\x00\x52\x00\x53\x00\xff\xff\xff\xff\xff\xff\x57\x00\x58\x00\x59\x00\x01\x00\xff\xff\x5c\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x00\x0f\x00\x10\x00\xff\xff\xff\xff\xff\xff\x14\x00\xff\xff\x16\x00\xff\xff\x18\x00\xff\xff\xff\xff\x1b\x00\xff\xff\x1d\x00\xff\xff\xff\xff\x02\x00\x03\x00\x02\x00\x03\x00\xff\xff\x25\x00\xff\xff\xff\xff\x28\x00\xff\xff\xff\xff\x0b\x00\xff\xff\xff\xff\xff\xff\xff\xff\x12\x00\xff\xff\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x1d\x00\xff\xff\x1d\x00\xff\xff\xff\xff\x22\x00\x23\x00\x22\x00\x23\x00\xff\xff\x27\x00\xff\xff\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\xff\xff\x2e\x00\x4f\x00\xff\xff\x51\x00\x52\x00\x53\x00\xff\xff\x1a\x00\x1b\x00\x57\x00\x58\x00\x59\x00\x01\x00\xff\xff\x5c\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\xff\xff\x0b\x00\xff\xff\xff\xff\xff\xff\x2d\x00\x10\x00\xff\xff\xff\xff\x31\x00\x14\x00\xff\xff\x16\x00\xff\xff\x18\x00\xff\xff\xff\xff\x1b\x00\x3a\x00\x01\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x02\x00\x03\x00\x25\x00\x0a\x00\x0b\x00\x28\x00\xff\xff\xff\xff\xff\xff\x10\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\xff\xff\x20\x00\xff\xff\x1d\x00\xff\xff\xff\xff\xff\xff\xff\xff\x22\x00\x23\x00\xff\xff\x01\x00\xff\xff\x27\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x2e\x00\x0b\x00\x51\x00\x52\x00\x53\x00\xff\xff\x10\x00\xff\xff\x57\x00\x58\x00\x14\x00\xff\xff\x16\x00\xff\xff\x18\x00\xff\xff\xff\xff\x1b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x00\xff\xff\xff\xff\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x13\x00\xff\xff\xff\xff\xff\xff\xff\xff\x01\x00\xff\xff\x1a\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\xff\xff\x0b\x00\x51\x00\x52\x00\x53\x00\xff\xff\x10\x00\x28\x00\x57\x00\x58\x00\x14\x00\xff\xff\x16\x00\xff\xff\x18\x00\xff\xff\x31\x00\x1b\x00\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x25\x00\xff\xff\xff\xff\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x1b\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x00\xff\xff\xff\xff\x01\x00\x31\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\xff\xff\x3a\x00\x51\x00\x52\x00\x53\x00\xff\xff\x10\x00\xff\xff\x57\x00\x58\x00\x14\x00\xff\xff\x16\x00\xff\xff\x18\x00\xff\xff\xff\xff\x1b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x00\xff\xff\xff\xff\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x1b\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x13\x00\xff\xff\x2d\x00\xff\xff\xff\xff\x01\x00\x31\x00\x1a\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x3a\x00\x51\x00\x52\x00\x53\x00\xff\xff\x10\x00\x28\x00\x57\x00\x58\x00\x14\x00\xff\xff\x16\x00\xff\xff\x18\x00\xff\xff\x31\x00\x1b\x00\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x25\x00\xff\xff\xff\xff\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x13\x00\xff\xff\xff\xff\xff\xff\xff\xff\x01\x00\xff\xff\x1a\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\xff\xff\x0b\x00\x51\x00\x52\x00\x53\x00\xff\xff\x10\x00\x28\x00\x57\x00\x58\x00\x14\x00\xff\xff\x16\x00\xff\xff\x18\x00\xff\xff\x31\x00\x1b\x00\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x25\x00\xff\xff\xff\xff\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x1b\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x00\xff\xff\xff\xff\x01\x00\x31\x00\xff\xff\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\xff\xff\x3a\x00\x51\x00\x52\x00\x53\x00\xff\xff\x10\x00\x11\x00\x57\x00\x58\x00\x14\x00\xff\xff\x16\x00\xff\xff\x18\x00\xff\xff\xff\xff\x1b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x00\xff\xff\xff\xff\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\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\xff\xff\xff\xff\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\xff\xff\xff\xff\x51\x00\x52\x00\x53\x00\xff\xff\x10\x00\x11\x00\x57\x00\x58\x00\x14\x00\xff\xff\x16\x00\xff\xff\x18\x00\xff\xff\xff\xff\x1b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x00\xff\xff\xff\xff\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\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\xff\xff\xff\xff\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\xff\xff\xff\xff\x51\x00\x52\x00\x53\x00\xff\xff\x10\x00\x11\x00\x57\x00\x58\x00\x14\x00\xff\xff\x16\x00\xff\xff\x18\x00\xff\xff\xff\xff\x1b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x00\xff\xff\xff\xff\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\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\xff\xff\xff\xff\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\xff\xff\xff\xff\x51\x00\x52\x00\x53\x00\xff\xff\x10\x00\x11\x00\x57\x00\x58\x00\x14\x00\xff\xff\x16\x00\xff\xff\x18\x00\xff\xff\xff\xff\x1b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x00\xff\xff\xff\xff\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\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\xff\xff\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\xff\xff\xff\xff\x51\x00\x52\x00\x53\x00\xff\xff\x10\x00\xff\xff\x57\x00\x58\x00\x14\x00\xff\xff\x16\x00\xff\xff\x18\x00\xff\xff\xff\xff\x1b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x00\xff\xff\xff\xff\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\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\xff\xff\x1a\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\xff\xff\xff\xff\x51\x00\x52\x00\x53\x00\xff\xff\x10\x00\x28\x00\x57\x00\x58\x00\x14\x00\xff\xff\x16\x00\xff\xff\x18\x00\xff\xff\x31\x00\x1b\x00\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\xff\xff\xff\xff\x3a\x00\x3b\x00\x25\x00\xff\xff\xff\xff\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\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\xff\xff\x1a\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\xff\xff\xff\xff\x51\x00\x52\x00\x53\x00\xff\xff\x10\x00\x28\x00\x57\x00\x58\x00\x14\x00\xff\xff\x16\x00\xff\xff\x18\x00\xff\xff\x31\x00\x1b\x00\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x25\x00\xff\xff\xff\xff\x01\x00\x1a\x00\x1b\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x22\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x2c\x00\x2d\x00\x16\x00\xff\xff\x18\x00\x31\x00\xff\xff\x1b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3a\x00\xff\xff\xff\xff\x25\x00\xff\xff\xff\xff\xff\xff\xff\xff\x51\x00\x52\x00\x53\x00\xff\xff\xff\xff\xff\xff\x57\x00\x58\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x02\x00\x03\x00\x01\x00\x02\x00\xff\xff\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\x0f\x00\x10\x00\xff\xff\xff\xff\xff\xff\xff\xff\x51\x00\x52\x00\x53\x00\xff\xff\xff\xff\x1d\x00\x57\x00\x58\x00\x1d\x00\xff\xff\x22\x00\x23\x00\xff\xff\x22\x00\x23\x00\x27\x00\x25\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x01\x00\xff\xff\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0f\x00\x10\x00\x1a\x00\xff\xff\x1c\x00\xff\xff\xff\xff\xff\xff\x52\x00\x53\x00\xff\xff\xff\xff\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x00\xff\xff\xff\xff\x31\x00\xff\xff\x33\x00\x34\x00\x35\x00\xff\xff\x37\x00\xff\xff\xff\xff\x3a\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x01\x00\xff\xff\xff\xff\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x4d\x00\x00\x00\x01\x00\x02\x00\x03\x00\xff\xff\x0f\x00\x10\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0c\x00\x52\x00\x53\x00\x0f\x00\x10\x00\xff\xff\x12\x00\xff\xff\x14\x00\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x25\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\xff\xff\x01\x00\x1a\x00\x1b\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\xff\xff\x22\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x10\x00\xff\xff\xff\xff\xff\xff\x2c\x00\x2d\x00\x52\x00\x53\x00\x18\x00\x31\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x02\x00\x03\x00\x3a\x00\xff\xff\xff\xff\x25\x00\xff\xff\xff\xff\xff\xff\x0b\x00\x0c\x00\x0d\x00\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\x13\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x1d\x00\xff\xff\xff\xff\x20\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x26\x00\x27\x00\xff\xff\xff\xff\x00\x00\x01\x00\x02\x00\x03\x00\x2e\x00\x2f\x00\xff\xff\x31\x00\xff\xff\xff\xff\x52\x00\x53\x00\x0c\x00\xff\xff\xff\xff\x0f\x00\x10\x00\xff\xff\x12\x00\xff\xff\x14\x00\x15\x00\xff\xff\x41\x00\xff\xff\xff\xff\x1a\x00\x00\x00\x01\x00\x02\x00\x03\x00\xff\xff\x4a\x00\xff\xff\x00\x00\x01\x00\x02\x00\x03\x00\xff\xff\x0c\x00\xff\xff\xff\xff\x0f\x00\x10\x00\xff\xff\x12\x00\x0c\x00\x14\x00\x15\x00\x0f\x00\x10\x00\xff\xff\x12\x00\x1a\x00\x14\x00\x15\x00\x00\x00\x01\x00\x02\x00\x03\x00\x1a\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\xff\xff\xff\xff\x0c\x00\xff\xff\xff\xff\x0f\x00\x10\x00\xff\xff\x12\x00\xff\xff\x14\x00\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\xff\xff\xff\xff\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x0c\x00\xff\xff\xff\xff\x0f\x00\x10\x00\xff\xff\x12\x00\xff\xff\x14\x00\x15\x00\x00\x00\x01\x00\x02\x00\x03\x00\x1a\x00\xff\xff\xff\xff\x00\x00\x01\x00\x02\x00\x03\x00\xff\xff\x0c\x00\xff\xff\xff\xff\x0f\x00\x10\x00\xff\xff\x12\x00\x0c\x00\x14\x00\x15\x00\x0f\x00\x10\x00\xff\xff\x12\x00\x1a\x00\x14\x00\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x00\x00\x01\x00\x02\x00\x03\x00\xff\xff\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\xff\xff\xff\xff\x0c\x00\xff\xff\xff\xff\x0f\x00\x10\x00\xff\xff\x12\x00\xff\xff\x14\x00\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\xff\xff\xff\xff\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\xff\xff\x1c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x31\x00\xff\xff\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\xff\xff\x1a\x00\x3a\x00\x1c\x00\xff\xff\xff\xff\x1a\x00\xff\xff\x1c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\x4d\x00\xff\xff\xff\xff\x31\x00\xff\xff\x33\x00\x34\x00\xff\xff\x31\x00\x37\x00\x33\x00\x34\x00\x3a\x00\xff\xff\x37\x00\xff\xff\x1a\x00\x3a\x00\x1c\x00\xff\xff\xff\xff\x1a\x00\xff\xff\x1c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\x4d\x00\xff\xff\x26\x00\x27\x00\x28\x00\x4d\x00\xff\xff\xff\xff\x31\x00\xff\xff\x33\x00\x34\x00\xff\xff\x31\x00\x37\x00\x33\x00\x34\x00\x3a\x00\x0e\x00\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\xff\xff\xff\xff\x0e\x00\xff\xff\xff\xff\xff\xff\x1a\x00\xff\xff\x1c\x00\xff\xff\xff\xff\xff\xff\x4d\x00\xff\xff\x1a\x00\xff\xff\x1c\x00\x4d\x00\x26\x00\x27\x00\x28\x00\x29\x00\xff\xff\xff\xff\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\x31\x00\xff\xff\x33\x00\x34\x00\x35\x00\xff\xff\x37\x00\xff\xff\x31\x00\x3a\x00\x33\x00\x34\x00\x35\x00\x1a\x00\x37\x00\x1c\x00\xff\xff\x3a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\x38\x00\x39\x00\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\x38\x00\x39\x00\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x1b\x00\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\x22\x00\x37\x00\x38\x00\x39\x00\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\x2c\x00\x2d\x00\xff\xff\xff\xff\xff\xff\x31\x00\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\x36\x00\x37\x00\x3a\x00\xff\xff\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x1b\x00\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\x35\x00\x22\x00\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\x2c\x00\x2d\x00\xff\xff\xff\xff\xff\xff\x31\x00\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\x36\x00\x37\x00\x3a\x00\xff\xff\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x1b\x00\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\x22\x00\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\x2c\x00\x2d\x00\xff\xff\xff\xff\xff\xff\x31\x00\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\x3a\x00\xff\xff\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x1b\x00\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\x22\x00\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\x2c\x00\x2d\x00\xff\xff\xff\xff\xff\xff\x31\x00\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\x3a\x00\xff\xff\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x1b\x00\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\x22\x00\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\x2c\x00\x2d\x00\xff\xff\xff\xff\xff\xff\x31\x00\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\x3a\x00\xff\xff\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x1b\x00\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\x22\x00\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\x2c\x00\x2d\x00\xff\xff\xff\xff\xff\xff\x31\x00\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\x3a\x00\xff\xff\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\x1a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x31\x00\x1c\x00\x33\x00\x34\x00\x1a\x00\xff\xff\x37\x00\xff\xff\x28\x00\x3a\x00\xff\xff\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\x31\x00\x28\x00\x33\x00\x34\x00\x1a\x00\x31\x00\x37\x00\x33\x00\x34\x00\x3a\x00\x31\x00\x37\x00\x33\x00\x34\x00\x3a\x00\xff\xff\x37\x00\x1a\x00\x28\x00\x3a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\xff\xff\x31\x00\xff\xff\x33\x00\x34\x00\x28\x00\xff\xff\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x1a\x00\x28\x00\x31\x00\xff\xff\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\xff\xff\x31\x00\x3a\x00\x33\x00\x34\x00\x28\x00\xff\xff\x37\x00\x1a\x00\xff\xff\x3a\x00\xff\xff\xff\xff\xff\xff\x31\x00\xff\xff\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\xff\xff\x28\x00\x3a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x31\x00\xff\xff\x33\x00\x34\x00\xff\xff\xff\xff\x37\x00\xff\xff\xff\xff\x3a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"#--happyTable :: HappyAddr-happyTable = HappyA# "\x00\x00\x19\x02\x25\x00\x30\x02\xbf\x00\xc3\x00\x6c\x02\xfd\x01\x04\x01\xfd\x01\xc2\x00\xc3\x00\xf6\x00\x57\x00\xd9\xff\x72\x02\x4d\x00\x58\x00\x88\x02\x9d\xff\xfc\xff\xec\x00\x8b\x02\x7f\x02\x50\x00\x9d\xff\x9d\xff\x9d\xff\x81\x02\x9d\xff\x25\x00\x9d\xff\xf6\x00\x9d\xff\xd9\xff\xd9\xff\x71\x01\xc4\x00\x89\x01\xf7\x00\x72\x01\x57\x00\xc5\x00\xc6\x00\xc0\x00\x58\x00\x9d\xff\xc7\x00\x0c\x01\xb0\x01\x65\x02\xff\x01\xfe\x01\xff\x01\xc8\x00\x9d\xff\xf8\x00\x5e\x00\x75\x02\xf7\x00\x70\xff\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\xbf\x00\x25\x00\xbb\x00\xc8\x00\x73\x01\xcc\x01\xf8\x00\xd9\xff\x62\x00\x63\x00\x82\x02\x74\x01\x57\x00\x3f\x01\x0c\x01\x64\x00\x58\x00\xf6\x00\x65\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x9d\xff\x9d\xff\x25\x00\x9d\xff\x3e\x02\xc2\x00\xc3\x00\x72\x01\x62\x00\x63\x00\xbf\x00\x76\x02\x79\x02\x57\x00\x06\xff\x64\x00\xf7\x00\x58\x00\x65\x00\x66\x00\xfc\xff\xc8\x00\x06\xff\x67\x00\x06\xff\x68\x00\x69\x00\x6a\x00\xfc\xff\x28\x01\x29\x01\xbf\x00\xc4\x00\xf8\x00\x77\x02\x9d\xff\x70\x02\xc5\x00\xc6\x00\x42\x01\x43\x01\x44\x01\xc7\x00\xf6\x00\x44\x01\x4e\x01\xbf\x00\x66\x00\x00\x02\xc8\x00\x59\x02\x67\x00\x7a\x02\x68\x00\x69\x00\x6a\x00\xfc\xff\x25\x01\xae\x01\xbf\x00\xbf\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\xf7\x00\x5c\x02\x2a\x01\xaf\x01\xc2\x00\xc3\x00\x7d\x00\x7e\x00\x62\x00\x63\x00\xb0\x01\x6e\x02\x2a\x01\x9c\xff\x45\x01\x64\x00\xc0\x00\xf8\x00\x65\x00\x9c\xff\x9c\xff\x9c\xff\xbf\x00\x9c\xff\x7c\x00\x9c\xff\x85\x02\x9c\xff\x57\x02\x37\x02\xc0\x00\xc4\x00\x7f\x00\xc2\x00\xc3\x00\x7b\x02\xc5\x00\xc6\x00\x80\x00\x56\x02\x9c\xff\xc7\x00\x08\xff\x7d\x00\x7e\x00\xbf\x00\xf6\x00\x66\x00\xc8\x00\x9c\xff\x08\xff\x67\x00\x08\xff\x68\x00\x69\x00\x6a\x00\xbf\x00\x58\x02\x06\xff\x86\x02\xc4\x00\x6b\xff\x88\x01\xbf\x00\x5b\x02\xc5\x00\xc6\x00\xc2\x00\xc3\x00\x7f\x00\xc7\x00\x97\x00\xbf\x00\xf7\x00\xbf\x00\x80\x00\x0c\xff\xc8\x00\x4d\x02\xbf\x00\x7d\x02\x5d\x02\x6b\xff\xbf\x00\x0c\xff\x9c\x01\x0c\xff\x9c\x00\xc2\x00\xc3\x00\xf8\x00\x25\x00\x9c\xff\x9c\xff\xc4\x00\x9c\xff\x9e\x01\x0b\xff\xbf\x00\xc5\x00\xc6\x00\x5f\x02\x9d\x00\xa0\x01\xc7\x00\x0b\xff\x58\x00\x0b\xff\xbf\x00\xc2\x00\xc3\x00\xc8\x00\xa2\x01\x4d\x01\xc0\x00\xc4\x00\x69\x02\x1f\x02\x09\xff\xbb\x01\xc5\x00\xc6\x00\x4e\x01\xbe\x01\xbf\x00\xc7\x00\x09\xff\x9c\xff\x09\xff\xbf\x00\xc2\x00\xc3\x00\xc8\x00\x1e\x02\x1f\x02\xbf\x00\xc4\x00\xfb\x00\xbf\x01\x07\xff\xbf\x00\xc5\x00\xc6\x00\x72\x02\x25\x00\xbf\x00\xc7\x00\x07\xff\xc0\x01\x07\xff\x86\x02\xc2\x00\xc3\x00\xc8\x00\xf4\x01\x24\x01\x08\xff\xc4\x00\xbf\x00\x58\x00\x02\xff\xbf\x00\xc5\x00\xc6\x00\xc1\x01\xd6\x00\xfb\x00\xc7\x00\x02\xff\xc2\x01\x02\xff\xaa\x01\xc2\x00\xc3\x00\xc8\x00\xc0\x00\x85\x01\xfc\x00\xc4\x00\x44\x01\xc0\x00\x01\xff\xbf\x00\xc5\x00\xc6\x00\x14\x01\x98\x00\x32\x01\xc7\x00\x01\xff\x0c\xff\x01\xff\xec\x00\xc2\x00\xc3\x00\xc8\x00\xcf\x01\xee\x00\x16\x01\xc4\x00\x33\x01\xc0\x00\xfe\xfe\x97\x00\xc5\x00\xc6\x00\xfc\x00\x79\x00\x48\x01\xc7\x00\xfe\xfe\x0b\xff\xfe\xfe\x98\x00\xc2\x00\xc3\x00\xc8\x00\x59\x01\x48\x01\x47\x01\xc4\x00\x72\x02\xc0\x00\xfd\xfe\x60\x02\xc5\x00\xc6\x00\x49\x01\x73\x02\x6d\x02\xc7\x00\xfd\xfe\x09\xff\xfd\xfe\x7a\x00\xc2\x00\xc3\x00\xc8\x00\x62\x02\x7b\x00\x7c\x00\xc4\x00\xbb\x00\xd6\x00\xfc\xfe\xbc\x00\xc5\x00\xc6\x00\x8a\x00\xc3\x01\x66\x02\xc7\x00\xfc\xfe\x07\xff\xfc\xfe\x1a\x00\xc2\x00\xc3\x00\xc8\x00\xc2\x00\xc3\x00\x14\x02\xc4\x00\xb2\x01\xd6\x00\xfb\xfe\x70\xff\xc5\x00\xc6\x00\x1e\x00\xd7\x00\x25\x02\xc7\x00\xfb\xfe\x02\xff\xfb\xfe\xf8\x01\x2b\x01\x1f\x00\xc8\x00\x8b\x00\x21\x00\xec\x00\xc4\x00\x22\x00\x70\xff\xc4\x00\x23\x00\xc5\x00\xc6\x00\x1b\x02\xc5\x00\xc6\x00\xc7\x00\xec\x00\x01\xff\xc7\x00\x1d\x02\xed\x00\xee\x00\xc8\x00\x26\x02\x8c\x00\xc8\x00\x4d\x02\x2d\x02\x4e\x02\x2e\x02\x7d\x00\xb2\x00\x7d\x00\xb2\x00\xc2\x00\xc3\x00\x3b\x02\x25\x00\xfe\xfe\x8e\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x8f\x00\x23\x01\x24\x01\xd3\x01\x33\x02\x53\x02\x2e\x00\xb6\x00\xd4\x01\xb6\x00\x2f\x00\x30\x02\x30\x00\xfd\xfe\x31\x00\xc4\x00\x80\x00\x32\x00\x80\x00\x31\x02\xc5\x00\xc6\x00\x2a\x01\x2b\x01\x36\x02\xc7\x00\x0d\x01\x34\x00\xe9\x01\x0d\x01\x35\x00\x70\x01\xc8\x00\x0d\x01\xfc\xfe\x0e\x01\x1a\x00\x0d\x01\x47\x02\x0f\x01\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x49\x02\x1e\x00\x50\x02\x51\x02\xa7\x00\xa8\x00\xfb\xfe\x2d\x01\x2e\x01\xff\xff\x1f\x00\x4c\x02\x29\x02\x21\x00\x4a\x02\xf0\x01\x22\x00\x21\x02\x22\x02\x23\x00\x2a\x02\x06\x00\x40\x00\x41\x00\x42\x00\xd1\x01\x4b\x02\xc4\x01\x43\x00\x44\x00\x8a\xff\xc5\x01\x2b\x02\x25\x00\xad\x00\x90\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\xc6\x01\xc7\x01\xc8\x01\xc9\x01\x2c\x00\x2d\x00\x2e\x00\x23\x02\x24\x02\x25\x02\x2f\x00\x19\x02\x30\x00\xca\x01\x31\x00\xcb\x01\x1a\x02\x32\x00\xd6\x01\xae\x00\xd7\x01\xd8\x01\xda\x01\xdc\x01\xaf\x00\xb0\x00\x4d\x00\x34\x00\xb1\x00\xf9\x01\x35\x00\xde\x01\xe0\x01\xe1\x01\x50\x00\xe2\x01\xb2\x00\xe3\x01\xe4\x01\xe5\x01\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\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\x3f\x00\xe6\x01\x40\x00\x41\x00\x42\x00\xe7\x01\xec\x01\xef\x01\x43\x00\x44\x00\x45\x00\x25\x00\x79\x00\x46\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\xfa\x01\x01\x02\x03\x02\x19\x02\x2c\x00\x2d\x00\x2e\x00\x05\x02\x34\x02\x07\x02\x2f\x00\x0c\x02\x30\x00\x52\x01\x31\x00\x55\x01\x57\x01\x32\x00\x4d\x00\xae\x00\x61\x01\x77\x00\xc2\x00\xc3\x00\x7b\x00\x7c\x00\x50\x00\x34\x00\x62\x01\x66\x01\x35\x00\xc2\x00\xc3\x00\xef\x00\xb2\x00\x67\x01\x7e\x01\xf0\x00\xee\x00\x8a\x01\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\xc4\x00\x8b\x01\x8c\x01\xf1\x00\x8e\x01\xc5\x00\xc6\x00\xb6\x00\xf2\x00\xc4\x00\xc7\x00\x9b\x01\x9d\x01\x9f\x01\xc5\x00\xc6\x00\x80\x00\xc8\x00\xa1\x01\xc7\x00\x3f\x00\xa3\x01\x40\x00\x41\x00\x42\x00\xb8\x01\xc8\x00\x51\x01\x43\x00\x44\x00\x45\x00\x25\x00\xb9\x01\x46\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\xbd\x01\xdc\x00\x7d\x00\xb2\x00\x2c\x00\x2d\x00\x2e\x00\xe2\x00\xe5\x00\xe8\x00\x2f\x00\xea\x00\x30\x00\xf9\x00\x31\x00\x10\x01\x1e\x01\x32\x00\x17\x01\x33\x00\x15\x01\x52\x02\xf3\x01\xc2\x00\xc3\x00\xb6\x00\x18\x01\x34\x00\x1f\x01\x22\x01\x35\x00\xc2\x00\xc3\x00\x26\x01\x80\x00\x2e\x01\x3a\x01\x3b\x01\x3e\x01\xd2\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x01\xc4\x00\x40\x01\x46\x01\x71\x00\xee\x01\xc5\x00\xc6\x00\x4a\x01\xc4\x00\x4f\x01\xc7\x00\x72\x00\x73\x00\xc5\x00\xc6\x00\xc2\x00\xc3\x00\xc8\x00\xc7\x00\x3f\x00\x77\x00\x40\x00\x41\x00\x42\x00\x16\x02\xc8\x00\x90\x00\x43\x00\x44\x00\x45\x00\x25\x00\x92\x00\x46\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x9a\x00\x9d\x00\x9e\x00\xc4\x00\x2c\x00\x2d\x00\x2e\x00\xa0\x00\xc5\x00\xc6\x00\x2f\x00\xa5\x00\x30\x00\xc7\x00\x31\x00\xcf\x00\x88\x02\x32\x00\xbd\x00\x33\x00\xc8\x00\xc8\x00\x21\x01\xc2\x00\xc3\x00\xd5\x00\x04\x00\x34\x00\x8a\x02\x84\x02\x35\x00\xc2\x00\xc3\x00\x7d\x02\x72\x02\x75\x02\x55\x02\xf8\x00\x40\xff\xd4\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x56\x02\xc4\x00\x00\x00\x12\x01\x5f\x02\x62\x02\xc5\x00\xc6\x00\x68\x02\xc4\x00\x66\x01\xc7\x00\x69\x02\x6c\x02\xc5\x00\xc6\x00\xc2\x00\xc3\x00\xc8\x00\xc7\x00\x3f\x00\x6b\x02\x40\x00\x41\x00\x42\x00\x14\x02\xc8\x00\x70\x02\x43\x00\x44\x00\x45\x00\x25\x00\xf6\x01\x46\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x17\x02\x18\x02\x19\x02\xc4\x00\x2c\x00\x2d\x00\x2e\x00\x28\x02\xc5\x00\xc6\x00\x2f\x00\x29\x02\x30\x00\xc7\x00\x31\x00\x52\x02\x33\x02\x32\x00\x05\x02\x33\x00\xc8\x00\x39\x02\xc2\x00\xc3\x00\xcf\x01\x3f\x02\x40\x02\x34\x00\x41\x02\x42\x02\x35\x00\xc2\x00\xc3\x00\x7d\x00\xb2\x00\x43\x02\xd3\x01\xf8\x00\xda\x01\x87\xff\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\xc4\x00\x3d\xff\xde\x01\xd5\x01\xe0\x01\xc5\x00\xc6\x00\xb6\x00\xec\x00\xc4\x00\xc7\x00\xeb\x01\x03\x02\xef\x01\xc5\x00\xc6\x00\x80\x00\xc8\x00\xec\x01\xc7\x00\x3f\x00\xfd\x01\x40\x00\x41\x00\x42\x00\x05\x02\xc8\x00\x0f\x02\x43\x00\x44\x00\x45\x00\x25\x00\x10\x02\x1e\x01\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x11\x02\x54\x01\x12\x02\x55\x01\x2c\x00\x2d\x00\x2e\x00\x59\x01\x5c\x01\x5b\x01\x2f\x00\x5d\x01\x30\x00\x5e\x01\x31\x00\x64\x01\x69\x01\x32\x00\x6a\x01\x33\x00\x6b\x01\x6c\x01\xc2\x00\xc3\x00\x06\x01\xc3\x00\x6d\x01\x34\x00\x70\x01\x7a\x01\x35\x00\x79\x01\x7b\x01\x94\x00\x81\x01\x85\x01\x82\x01\x65\x01\x80\x01\x07\x01\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\xc4\x00\x88\x01\x08\x01\x95\x01\x92\x01\xc5\x00\xc6\x00\x09\x01\x0a\x01\x66\x01\xc7\x00\x0b\x01\xc7\x00\x93\x01\x94\x01\xa5\x01\xa7\x01\xc8\x00\xad\x01\x0c\x01\x3f\x00\xb1\x01\x40\x00\x41\x00\x42\x00\xb3\x01\xb4\x01\xb5\x01\x43\x00\x44\x00\x45\x00\x25\x00\xb7\x01\x46\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x7d\x00\xb2\x00\xda\x00\x2c\x00\x2d\x00\x2e\x00\xe7\x00\xe4\x00\xea\x00\x2f\x00\xec\x00\x30\x00\xf9\x00\x31\x00\xfb\x00\xf5\x00\x32\x00\x00\x00\x33\x00\xe8\x01\xc3\xff\x22\x01\xc4\xff\xb6\x00\x03\x01\xec\x00\x34\x00\xec\x00\x30\x01\x35\x00\xc2\x00\xc3\x00\x80\x00\x34\x01\x4c\x01\x44\x01\x4d\x01\x7d\x00\xb2\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x6b\x00\x6c\x00\x6e\x00\x6f\x00\x71\x00\x13\x01\x75\x00\x70\x00\xa5\x01\xc4\x00\x76\x00\x77\x00\xb6\x00\x92\x00\xc5\x00\xc6\x00\xc2\x00\xc3\x00\x14\x01\xc7\x00\x3f\x00\x80\x00\x40\x00\x41\x00\x42\x00\xf7\x01\xc8\x00\x86\x00\x43\x00\x44\x00\x45\x00\x25\x00\x94\x00\x1e\x01\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x87\x00\x88\x00\x89\x00\xc4\x00\x2c\x00\x2d\x00\x2e\x00\x8a\x00\xc5\x00\xc6\x00\x2f\x00\x95\x00\x30\x00\xc7\x00\x31\x00\xff\xff\xff\xff\x32\x00\xbf\x00\x33\x00\xc8\x00\x00\x00\xc2\x00\xc3\x00\xc2\x00\xc3\x00\x00\x00\x34\x00\x00\x00\x00\x00\x35\x00\xf8\x01\x00\x00\x0a\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\xc4\x00\x00\x00\xc4\x00\x00\x00\x00\x00\xc5\x00\xc6\x00\xc5\x00\xc6\x00\x00\x00\xc7\x00\x00\x00\xc7\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc8\x00\x00\x00\xc8\x00\x3f\x00\x00\x00\x40\x00\x41\x00\x42\x00\x00\x00\x00\x00\x00\x00\x43\x00\x44\x00\x45\x00\x25\x00\x00\x00\x46\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2c\x00\x2d\x00\x2e\x00\x00\x00\x00\x00\x00\x00\x2f\x00\x00\x00\x30\x00\x00\x00\x31\x00\x00\x00\x00\x00\x32\x00\x00\x00\x33\x00\x00\x00\x00\x00\xc2\x00\xc3\x00\xc2\x00\xc3\x00\x00\x00\x34\x00\x00\x00\x00\x00\x35\x00\x00\x00\x00\x00\x0b\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x02\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\xc4\x00\x00\x00\xc4\x00\x00\x00\x00\x00\xc5\x00\xc6\x00\xc5\x00\xc6\x00\x00\x00\xc7\x00\x00\x00\xc7\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc8\x00\x00\x00\xc8\x00\x3f\x00\x00\x00\x40\x00\x41\x00\x42\x00\x00\x00\x00\x00\x00\x00\x43\x00\x44\x00\x45\x00\x25\x00\x00\x00\x1e\x01\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2c\x00\x2d\x00\x2e\x00\x00\x00\x00\x00\x00\x00\x2f\x00\x00\x00\x30\x00\x00\x00\x31\x00\x00\x00\x00\x00\x32\x00\x00\x00\x33\x00\x00\x00\x00\x00\xc2\x00\xc3\x00\xc2\x00\xc3\x00\x00\x00\x34\x00\x00\x00\x00\x00\x35\x00\x00\x00\x00\x00\x13\x02\x00\x00\x00\x00\x00\x00\x00\x00\x09\x02\x00\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\xc4\x00\x00\x00\xc4\x00\x00\x00\x00\x00\xc5\x00\xc6\x00\xc5\x00\xc6\x00\x00\x00\xc7\x00\x00\x00\xc7\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc8\x00\x00\x00\xc8\x00\x3f\x00\x00\x00\x40\x00\x41\x00\x42\x00\x00\x00\x7d\x00\xb2\x00\x43\x00\x44\x00\x45\x00\x25\x00\x00\x00\x46\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x8b\x02\x00\x00\x00\x00\x00\x00\xa7\x01\x2e\x00\x00\x00\x00\x00\xb6\x00\x2f\x00\x00\x00\x30\x00\x00\x00\x31\x00\x00\x00\x00\x00\x32\x00\x80\x00\x25\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc3\x00\x34\x00\x76\x01\x77\x01\x35\x00\x00\x00\x00\x00\x00\x00\x58\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x00\x00\x78\x01\x00\x00\xc4\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc5\x00\xc6\x00\x00\x00\x25\x00\x00\x00\xc7\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\xc8\x00\x7f\x02\x40\x00\x41\x00\x42\x00\x00\x00\x2e\x00\x00\x00\x43\x00\x44\x00\x2f\x00\x00\x00\x30\x00\x00\x00\x31\x00\x00\x00\x00\x00\x32\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x34\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\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1c\x02\x00\x00\x00\x00\x00\x00\x00\x00\x25\x00\x00\x00\x1a\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x79\x02\x40\x00\x41\x00\x42\x00\x00\x00\x2e\x00\x1e\x00\x43\x00\x44\x00\x2f\x00\x00\x00\x30\x00\x00\x00\x31\x00\x00\x00\x1f\x00\x32\x00\x8b\x00\x21\x00\x00\x00\x00\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x34\x00\x00\x00\x00\x00\x35\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7d\x00\xb2\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa8\x01\x00\x00\x00\x00\x25\x00\xb6\x00\x8e\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x80\x00\x40\x00\x41\x00\x42\x00\x00\x00\x2e\x00\x00\x00\x43\x00\x44\x00\x2f\x00\x00\x00\x30\x00\x00\x00\x31\x00\x00\x00\x00\x00\x32\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x34\x00\x00\x00\x00\x00\x35\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7d\x00\xb2\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6e\x01\x00\x00\xa9\x01\x00\x00\x00\x00\x25\x00\xb6\x00\x1a\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2d\x02\x80\x00\x40\x00\x41\x00\x42\x00\x00\x00\x2e\x00\x1e\x00\x43\x00\x44\x00\x2f\x00\x00\x00\x30\x00\x00\x00\x31\x00\x00\x00\x1f\x00\x32\x00\x8b\x00\x21\x00\x00\x00\x00\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x34\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\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x34\x01\x00\x00\x00\x00\x00\x00\x00\x00\x25\x00\x00\x00\x1a\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x3a\x02\x40\x00\x41\x00\x42\x00\x00\x00\x2e\x00\x1e\x00\x43\x00\x44\x00\x2f\x00\x00\x00\x30\x00\x00\x00\x31\x00\x00\x00\x1f\x00\x32\x00\x8b\x00\x21\x00\x00\x00\x00\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x34\x00\x00\x00\x00\x00\x35\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7d\x00\xb2\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb5\x01\x00\x00\x00\x00\x25\x00\xb6\x00\x00\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x80\x00\x40\x00\x41\x00\x42\x00\x00\x00\x2e\x00\x44\x02\x43\x00\x44\x00\x2f\x00\x00\x00\x30\x00\x00\x00\x31\x00\x00\x00\x00\x00\x32\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x34\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\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x25\x00\x00\x00\x00\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x40\x00\x41\x00\x42\x00\x00\x00\x2e\x00\x45\x02\x43\x00\x44\x00\x2f\x00\x00\x00\x30\x00\x00\x00\x31\x00\x00\x00\x00\x00\x32\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x34\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\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x25\x00\x00\x00\x00\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x40\x00\x41\x00\x42\x00\x00\x00\x2e\x00\x46\x02\x43\x00\x44\x00\x2f\x00\x00\x00\x30\x00\x00\x00\x31\x00\x00\x00\x00\x00\x32\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x34\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\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x25\x00\x00\x00\x00\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x40\x00\x41\x00\x42\x00\x00\x00\x2e\x00\x47\x02\x43\x00\x44\x00\x2f\x00\x00\x00\x30\x00\x00\x00\x31\x00\x00\x00\x00\x00\x32\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x34\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\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x25\x00\x00\x00\x8e\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x40\x00\x41\x00\x42\x00\x00\x00\x2e\x00\x00\x00\x43\x00\x44\x00\x2f\x00\x00\x00\x30\x00\x00\x00\x31\x00\x00\x00\x00\x00\x32\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x34\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\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x25\x00\x00\x00\x1a\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x40\x00\x41\x00\x42\x00\x00\x00\x2e\x00\x1e\x00\x43\x00\x44\x00\x2f\x00\x00\x00\x30\x00\x00\x00\x31\x00\x00\x00\x1f\x00\x32\x00\x29\x02\x21\x00\x00\x00\x00\x00\x22\x00\x00\x00\x00\x00\x23\x00\x64\x02\x34\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\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x25\x00\x00\x00\x1a\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x40\x00\x41\x00\x42\x00\x00\x00\x2e\x00\x1e\x00\x43\x00\x44\x00\x2f\x00\x00\x00\x30\x00\x00\x00\x31\x00\x00\x00\x1f\x00\x32\x00\xba\x01\x21\x00\x00\x00\x00\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x34\x00\x00\x00\x00\x00\x00\x00\x7d\x00\xb2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb3\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x63\x02\xb5\x00\x00\x00\x00\x00\x00\x00\xb6\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x41\x00\x42\x00\x00\x00\x00\x00\x00\x00\x43\x00\x44\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc3\x00\x25\x00\x79\x00\x00\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xac\x01\xb9\x00\xba\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc4\x00\x00\x00\x00\x00\x7a\x00\x00\x00\xc5\x00\xc6\x00\x00\x00\x7b\x00\x7c\x00\xc7\x00\x83\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc8\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\xbb\x00\x25\x00\x00\x00\xb8\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb9\x00\xba\x00\x1a\x00\x00\x00\x96\x01\x00\x00\x00\x00\x00\x00\x84\x00\x85\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x83\x00\x00\x00\x00\x00\x1f\x00\x00\x00\x20\x00\x21\x00\x97\x01\x00\x00\x22\x00\x00\x00\x00\x00\x23\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\xbb\x00\x25\x00\x00\x00\x00\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x98\x01\x56\x01\x47\x00\x48\x00\x49\x00\x00\x00\xb9\x00\xba\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x84\x00\x85\x00\x4b\x00\x4c\x00\x00\x00\x4d\x00\x00\x00\x4e\x00\x4f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x50\x00\x83\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\xbb\x00\x00\x00\x25\x00\x7d\x00\xb2\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\xb3\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x82\x00\x00\x00\x00\x00\x00\x00\x48\x02\xb5\x00\x84\x00\x85\x00\x31\x00\xb6\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x65\xff\xc3\x00\x80\x00\x00\x00\x00\x00\x83\x00\x00\x00\x00\x00\x00\x00\x65\xff\x65\xff\x65\xff\x00\x00\x00\x00\x00\x00\x65\xff\x00\x00\x65\xff\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x65\xff\x00\x00\x00\x00\x65\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x65\xff\x65\xff\x00\x00\x00\x00\x35\x01\x47\x00\x48\x00\x49\x00\x65\xff\x65\xff\x00\x00\x65\xff\x00\x00\x00\x00\x84\x00\x85\x00\x4a\x00\x00\x00\x00\x00\x4b\x00\x4c\x00\x00\x00\x4d\x00\x00\x00\x4e\x00\x4f\x00\x00\x00\x65\xff\x00\x00\x00\x00\x50\x00\x36\x01\x47\x00\x48\x00\x49\x00\x00\x00\x65\xff\x00\x00\x37\x01\x47\x00\x48\x00\x49\x00\x00\x00\x4a\x00\x00\x00\x00\x00\x4b\x00\x4c\x00\x00\x00\x4d\x00\x4a\x00\x4e\x00\x4f\x00\x4b\x00\x4c\x00\x00\x00\x4d\x00\x50\x00\x4e\x00\x4f\x00\x38\x01\x47\x00\x48\x00\x49\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x00\x00\x00\x00\x4a\x00\x00\x00\x00\x00\x4b\x00\x4c\x00\x00\x00\x4d\x00\x00\x00\x4e\x00\x4f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x50\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x00\x00\x00\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x39\x01\x47\x00\x48\x00\x49\x00\x00\x00\x00\x00\x00\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x4a\x00\x00\x00\x00\x00\x4b\x00\x4c\x00\x00\x00\x4d\x00\x00\x00\x4e\x00\x4f\x00\x95\x00\x47\x00\x48\x00\x49\x00\x50\x00\x00\x00\x00\x00\x96\x00\x47\x00\x48\x00\x49\x00\x00\x00\x4a\x00\x00\x00\x00\x00\x4b\x00\x4c\x00\x00\x00\x4d\x00\x4a\x00\x4e\x00\x4f\x00\x4b\x00\x4c\x00\x00\x00\x4d\x00\x50\x00\x4e\x00\x4f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x50\x00\x46\x00\x47\x00\x48\x00\x49\x00\x00\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x00\x00\x00\x00\x4a\x00\x00\x00\x00\x00\x4b\x00\x4c\x00\x00\x00\x4d\x00\x00\x00\x4e\x00\x4f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x00\x00\x00\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x00\x00\xdd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x1f\x00\x00\x00\x20\x00\x21\x00\x00\x00\x00\x00\x22\x00\x00\x00\x1a\x00\x23\x00\xe1\x00\x00\x00\x00\x00\x1a\x00\x00\x00\xe4\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x95\x01\x00\x00\x00\x00\x1f\x00\x00\x00\x20\x00\x21\x00\x00\x00\x1f\x00\x22\x00\x20\x00\x21\x00\x23\x00\x00\x00\x22\x00\x00\x00\x1a\x00\x23\x00\xfd\x00\x00\x00\x00\x00\x1a\x00\x00\x00\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x99\x01\x00\x00\x1c\x00\x1d\x00\x1e\x00\x9a\x01\x00\x00\x00\x00\x1f\x00\x00\x00\x20\x00\x21\x00\x00\x00\x1f\x00\x22\x00\x20\x00\x21\x00\x23\x00\x77\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x77\x00\x00\x00\x00\x00\x00\x00\xa8\x00\x00\x00\xa9\x00\x00\x00\x00\x00\x00\x00\xfe\x00\x00\x00\x1a\x00\x00\x00\x3c\x01\x00\x01\x1c\x00\x1d\x00\x1e\x00\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x00\x00\x20\x00\x21\x00\xab\x00\x00\x00\x22\x00\x00\x00\x1f\x00\x23\x00\x20\x00\x21\x00\x3d\x01\x19\x01\x22\x00\x1a\x01\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x19\x01\x1f\x00\x1a\x01\x20\x00\x21\x00\x00\x00\x00\x00\x22\x00\x80\x02\x1c\x01\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x19\x01\x1f\x00\x1a\x01\x20\x00\x21\x00\x00\x00\x00\x00\x22\x00\x86\x01\x1c\x01\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7d\x00\xb2\x00\x1a\x00\x1f\x00\x8f\x01\x20\x00\x21\x00\x00\x00\xb3\x00\x22\x00\x1b\x01\x1c\x01\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\xcd\x01\xb5\x00\x00\x00\x00\x00\x00\x00\xb6\x00\x1a\x00\x1f\x00\x96\x01\x20\x00\x21\x00\x00\x00\x3c\x02\x22\x00\x80\x00\x00\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7d\x00\xb2\x00\x1a\x00\x1f\x00\x8f\x01\x20\x00\x21\x00\x97\x01\xb3\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\xcd\x01\xd0\x01\x00\x00\x00\x00\x00\x00\xb6\x00\x1a\x00\x1f\x00\x5a\x02\x20\x00\x21\x00\x00\x00\x90\x01\x22\x00\x80\x00\x00\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7d\x00\xb2\x00\x1a\x00\x1f\x00\x36\x02\x20\x00\x21\x00\x00\x00\xb3\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\xfb\x01\xb5\x00\x00\x00\x00\x00\x00\x00\xb6\x00\x1a\x00\x1f\x00\x3a\x02\x20\x00\x21\x00\x00\x00\x00\x00\x22\x00\x80\x00\x00\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7d\x00\xb2\x00\x1a\x00\x1f\x00\xf1\x01\x20\x00\x21\x00\x00\x00\xb3\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x0b\x02\xb5\x00\x00\x00\x00\x00\x00\x00\xb6\x00\x1a\x00\x1f\x00\xf3\x01\x20\x00\x21\x00\x00\x00\x00\x00\x22\x00\x80\x00\x00\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7d\x00\xb2\x00\x1a\x00\x1f\x00\x0d\x02\x20\x00\x21\x00\x00\x00\xb3\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x30\x01\xb5\x00\x00\x00\x00\x00\x00\x00\xb6\x00\x1a\x00\x1f\x00\x51\x01\x20\x00\x21\x00\x00\x00\x00\x00\x22\x00\x80\x00\x00\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7d\x00\xb2\x00\x1a\x00\x1f\x00\x5e\x01\x20\x00\x21\x00\x00\x00\xb3\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\xb4\x00\xb5\x00\x00\x00\x00\x00\x00\x00\xb6\x00\x1a\x00\x1f\x00\x5f\x01\x20\x00\x21\x00\x00\x00\x00\x00\x22\x00\x80\x00\x00\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x1f\x00\x60\x01\x20\x00\x21\x00\x00\x00\x00\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x1f\x00\x6d\x01\x20\x00\x21\x00\x00\x00\x00\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x1f\x00\x7b\x01\x20\x00\x21\x00\x00\x00\x00\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x1f\x00\x7c\x01\x20\x00\x21\x00\x00\x00\x00\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x1f\x00\x7d\x01\x20\x00\x21\x00\x00\x00\x00\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x1f\x00\x82\x01\x20\x00\x21\x00\x00\x00\x00\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x1f\x00\x83\x01\x20\x00\x21\x00\x00\x00\x00\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x1f\x00\x8d\x01\x20\x00\x21\x00\x00\x00\x00\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x1f\x00\xdf\x00\x20\x00\x21\x00\x00\x00\x00\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x1f\x00\xe0\x00\x20\x00\x21\x00\x00\x00\x00\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x1f\x00\xb7\x01\x20\x00\x21\x00\x00\x00\x00\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x1f\x00\xbc\x01\x20\x00\x21\x00\x00\x00\x00\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x1f\x00\xda\x00\x20\x00\x21\x00\x00\x00\x00\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x1f\x00\xdb\x00\x20\x00\x21\x00\x00\x00\x00\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x1f\x00\xdd\x00\x20\x00\x21\x00\x00\x00\x00\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x1f\x00\xde\x00\x20\x00\x21\x00\x00\x00\x00\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x1f\x00\xdf\x00\x20\x00\x21\x00\x00\x00\x00\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x1f\x00\xe0\x00\x20\x00\x21\x00\x00\x00\x00\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x1f\x00\xe1\x00\x20\x00\x21\x00\x00\x00\x00\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x1f\x00\xe4\x00\x20\x00\x21\x00\x00\x00\x00\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x1f\x00\xf3\x00\x20\x00\x21\x00\x00\x00\x00\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x1f\x00\xa1\x00\x20\x00\x21\x00\x00\x00\x00\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x1f\x00\x01\x01\x20\x00\x21\x00\x00\x00\x00\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x1f\x00\x03\x01\x20\x00\x21\x00\x00\x00\x00\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x1f\x00\x6c\x00\x20\x00\x21\x00\x00\x00\x00\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x1f\x00\x99\x00\x20\x00\x21\x00\x00\x00\x00\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x1f\x00\x9f\x00\x20\x00\x21\x00\x00\x00\x00\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x1f\x00\xa1\x00\x20\x00\x21\x00\x00\x00\x00\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x1f\x00\xa3\x00\x20\x00\x21\x00\x00\x00\x00\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x1f\x00\xa4\x00\x20\x00\x21\x00\x00\x00\x00\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x1f\x00\xc9\x00\x20\x00\x21\x00\x00\x00\x00\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x1f\x00\xca\x00\x20\x00\x21\x00\x00\x00\x00\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x1f\x00\xcb\x00\x20\x00\x21\x00\x00\x00\x00\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x1f\x00\xcc\x00\x20\x00\x21\x00\x00\x00\x00\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x1f\x00\xcd\x00\x20\x00\x21\x00\x00\x00\x00\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x1f\x00\xce\x00\x20\x00\x21\x00\x00\x00\x00\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x1f\x00\xd0\x00\x20\x00\x21\x00\x00\x00\x00\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x1f\x00\xd2\x00\x20\x00\x21\x00\x00\x00\x00\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x1f\x00\xd4\x00\x20\x00\x21\x00\x00\x00\x00\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x1f\x00\xd8\x00\x20\x00\x21\x00\x00\x00\x00\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x1a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x1f\x00\x1b\x00\x20\x00\x21\x00\x1a\x00\x00\x00\x22\x00\x00\x00\x1e\x00\x23\x00\x00\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x1f\x00\x1e\x00\xba\x01\x21\x00\x1a\x00\x1f\x00\x22\x00\x20\x00\x21\x00\x23\x00\x1f\x00\x22\x00\xba\x01\x21\x00\x23\x00\x00\x00\x22\x00\x1a\x00\x1e\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x00\x00\x1f\x00\x00\x00\xdb\x01\x21\x00\x1e\x00\x00\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x1a\x00\x1e\x00\x1f\x00\x00\x00\xba\x01\x21\x00\x00\x00\x00\x00\x22\x00\x00\x00\x1f\x00\x23\x00\xba\x01\x21\x00\x1e\x00\x00\x00\x22\x00\x1a\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x1f\x00\x00\x00\xe7\x00\x21\x00\x00\x00\x00\x00\x22\x00\x00\x00\x1e\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1f\x00\x00\x00\xa2\x00\x21\x00\x00\x00\x00\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\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 (3, 272) [-	(3 , happyReduce_3),-	(4 , happyReduce_4),-	(5 , happyReduce_5),-	(6 , happyReduce_6),-	(7 , happyReduce_7),-	(8 , happyReduce_8),-	(9 , happyReduce_9),-	(10 , happyReduce_10),-	(11 , happyReduce_11),-	(12 , happyReduce_12),-	(13 , happyReduce_13),-	(14 , happyReduce_14),-	(15 , happyReduce_15),-	(16 , happyReduce_16),-	(17 , happyReduce_17),-	(18 , happyReduce_18),-	(19 , happyReduce_19),-	(20 , happyReduce_20),-	(21 , happyReduce_21),-	(22 , happyReduce_22),-	(23 , happyReduce_23),-	(24 , happyReduce_24),-	(25 , happyReduce_25),-	(26 , happyReduce_26),-	(27 , happyReduce_27),-	(28 , happyReduce_28),-	(29 , happyReduce_29),-	(30 , happyReduce_30),-	(31 , happyReduce_31),-	(32 , happyReduce_32),-	(33 , happyReduce_33),-	(34 , happyReduce_34),-	(35 , happyReduce_35),-	(36 , happyReduce_36),-	(37 , happyReduce_37),-	(38 , happyReduce_38),-	(39 , happyReduce_39),-	(40 , happyReduce_40),-	(41 , happyReduce_41),-	(42 , happyReduce_42),-	(43 , happyReduce_43),-	(44 , happyReduce_44),-	(45 , happyReduce_45),-	(46 , happyReduce_46),-	(47 , happyReduce_47),-	(48 , happyReduce_48),-	(49 , happyReduce_49),-	(50 , happyReduce_50),-	(51 , happyReduce_51),-	(52 , happyReduce_52),-	(53 , happyReduce_53),-	(54 , happyReduce_54),-	(55 , happyReduce_55),-	(56 , happyReduce_56),-	(57 , happyReduce_57),-	(58 , happyReduce_58),-	(59 , happyReduce_59),-	(60 , happyReduce_60),-	(61 , happyReduce_61),-	(62 , happyReduce_62),-	(63 , happyReduce_63),-	(64 , happyReduce_64),-	(65 , happyReduce_65),-	(66 , happyReduce_66),-	(67 , happyReduce_67),-	(68 , happyReduce_68),-	(69 , happyReduce_69),-	(70 , happyReduce_70),-	(71 , happyReduce_71),-	(72 , happyReduce_72),-	(73 , happyReduce_73),-	(74 , happyReduce_74),-	(75 , happyReduce_75),-	(76 , happyReduce_76),-	(77 , happyReduce_77),-	(78 , happyReduce_78),-	(79 , happyReduce_79),-	(80 , happyReduce_80),-	(81 , happyReduce_81),-	(82 , happyReduce_82),-	(83 , happyReduce_83),-	(84 , happyReduce_84),-	(85 , happyReduce_85),-	(86 , happyReduce_86),-	(87 , happyReduce_87),-	(88 , happyReduce_88),-	(89 , happyReduce_89),-	(90 , happyReduce_90),-	(91 , happyReduce_91),-	(92 , happyReduce_92),-	(93 , happyReduce_93),-	(94 , happyReduce_94),-	(95 , happyReduce_95),-	(96 , happyReduce_96),-	(97 , happyReduce_97),-	(98 , happyReduce_98),-	(99 , happyReduce_99),-	(100 , happyReduce_100),-	(101 , happyReduce_101),-	(102 , happyReduce_102),-	(103 , happyReduce_103),-	(104 , happyReduce_104),-	(105 , happyReduce_105),-	(106 , happyReduce_106),-	(107 , happyReduce_107),-	(108 , happyReduce_108),-	(109 , happyReduce_109),-	(110 , happyReduce_110),-	(111 , happyReduce_111),-	(112 , happyReduce_112),-	(113 , happyReduce_113),-	(114 , happyReduce_114),-	(115 , happyReduce_115),-	(116 , happyReduce_116),-	(117 , happyReduce_117),-	(118 , happyReduce_118),-	(119 , happyReduce_119),-	(120 , happyReduce_120),-	(121 , happyReduce_121),-	(122 , happyReduce_122),-	(123 , happyReduce_123),-	(124 , happyReduce_124),-	(125 , happyReduce_125),-	(126 , happyReduce_126),-	(127 , happyReduce_127),-	(128 , happyReduce_128),-	(129 , happyReduce_129),-	(130 , happyReduce_130),-	(131 , happyReduce_131),-	(132 , happyReduce_132),-	(133 , happyReduce_133),-	(134 , happyReduce_134),-	(135 , happyReduce_135),-	(136 , happyReduce_136),-	(137 , happyReduce_137),-	(138 , happyReduce_138),-	(139 , happyReduce_139),-	(140 , happyReduce_140),-	(141 , happyReduce_141),-	(142 , happyReduce_142),-	(143 , happyReduce_143),-	(144 , happyReduce_144),-	(145 , happyReduce_145),-	(146 , happyReduce_146),-	(147 , happyReduce_147),-	(148 , happyReduce_148),-	(149 , happyReduce_149),-	(150 , happyReduce_150),-	(151 , happyReduce_151),-	(152 , happyReduce_152),-	(153 , happyReduce_153),-	(154 , happyReduce_154),-	(155 , happyReduce_155),-	(156 , happyReduce_156),-	(157 , happyReduce_157),-	(158 , happyReduce_158),-	(159 , happyReduce_159),-	(160 , happyReduce_160),-	(161 , happyReduce_161),-	(162 , happyReduce_162),-	(163 , happyReduce_163),-	(164 , happyReduce_164),-	(165 , happyReduce_165),-	(166 , happyReduce_166),-	(167 , happyReduce_167),-	(168 , happyReduce_168),-	(169 , happyReduce_169),-	(170 , happyReduce_170),-	(171 , happyReduce_171),-	(172 , happyReduce_172),-	(173 , happyReduce_173),-	(174 , happyReduce_174),-	(175 , happyReduce_175),-	(176 , happyReduce_176),-	(177 , happyReduce_177),-	(178 , happyReduce_178),-	(179 , happyReduce_179),-	(180 , happyReduce_180),-	(181 , happyReduce_181),-	(182 , happyReduce_182),-	(183 , happyReduce_183),-	(184 , happyReduce_184),-	(185 , happyReduce_185),-	(186 , happyReduce_186),-	(187 , happyReduce_187),-	(188 , happyReduce_188),-	(189 , happyReduce_189),-	(190 , happyReduce_190),-	(191 , happyReduce_191),-	(192 , happyReduce_192),-	(193 , happyReduce_193),-	(194 , happyReduce_194),-	(195 , happyReduce_195),-	(196 , happyReduce_196),-	(197 , happyReduce_197),-	(198 , happyReduce_198),-	(199 , happyReduce_199),-	(200 , happyReduce_200),-	(201 , happyReduce_201),-	(202 , happyReduce_202),-	(203 , happyReduce_203),-	(204 , happyReduce_204),-	(205 , happyReduce_205),-	(206 , happyReduce_206),-	(207 , happyReduce_207),-	(208 , happyReduce_208),-	(209 , happyReduce_209),-	(210 , happyReduce_210),-	(211 , happyReduce_211),-	(212 , happyReduce_212),-	(213 , happyReduce_213),-	(214 , happyReduce_214),-	(215 , happyReduce_215),-	(216 , happyReduce_216),-	(217 , happyReduce_217),-	(218 , happyReduce_218),-	(219 , happyReduce_219),-	(220 , happyReduce_220),-	(221 , happyReduce_221),-	(222 , happyReduce_222),-	(223 , happyReduce_223),-	(224 , happyReduce_224),-	(225 , happyReduce_225),-	(226 , happyReduce_226),-	(227 , happyReduce_227),-	(228 , happyReduce_228),-	(229 , happyReduce_229),-	(230 , happyReduce_230),-	(231 , happyReduce_231),-	(232 , happyReduce_232),-	(233 , happyReduce_233),-	(234 , happyReduce_234),-	(235 , happyReduce_235),-	(236 , happyReduce_236),-	(237 , happyReduce_237),-	(238 , happyReduce_238),-	(239 , happyReduce_239),-	(240 , happyReduce_240),-	(241 , happyReduce_241),-	(242 , happyReduce_242),-	(243 , happyReduce_243),-	(244 , happyReduce_244),-	(245 , happyReduce_245),-	(246 , happyReduce_246),-	(247 , happyReduce_247),-	(248 , happyReduce_248),-	(249 , happyReduce_249),-	(250 , happyReduce_250),-	(251 , happyReduce_251),-	(252 , happyReduce_252),-	(253 , happyReduce_253),-	(254 , happyReduce_254),-	(255 , happyReduce_255),-	(256 , happyReduce_256),-	(257 , happyReduce_257),-	(258 , happyReduce_258),-	(259 , happyReduce_259),-	(260 , happyReduce_260),-	(261 , happyReduce_261),-	(262 , happyReduce_262),-	(263 , happyReduce_263),-	(264 , happyReduce_264),-	(265 , happyReduce_265),-	(266 , happyReduce_266),-	(267 , happyReduce_267),-	(268 , happyReduce_268),-	(269 , happyReduce_269),-	(270 , happyReduce_270),-	(271 , happyReduce_271),-	(272 , happyReduce_272)-	]--happy_n_terms = 126 :: Int-happy_n_nonterms = 79 :: Int--happyReduce_3 = happySpecReduce_0  0# happyReduction_3-happyReduction_3  =  happyIn6-		 ([]-	)--happyReduce_4 = happySpecReduce_2  0# happyReduction_4-happyReduction_4 happy_x_2-	happy_x_1-	 =  case happyOut7 happy_x_1 of { happy_var_1 -> -	case happyOut6 happy_x_2 of { happy_var_2 -> -	happyIn6-		 (happy_var_1:happy_var_2-	)}}--happyReduce_5 = happySpecReduce_2  0# happyReduction_5-happyReduction_5 happy_x_2-	happy_x_1-	 =  case happyOut18 happy_x_1 of { happy_var_1 -> -	case happyOut6 happy_x_2 of { happy_var_2 -> -	happyIn6-		 (map RealDecl happy_var_1 ++ happy_var_2-	)}}--happyReduce_6 = happyReduce 4# 0# happyReduction_6-happyReduction_6 (happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOutTok happy_x_2 of { (TokenString happy_var_2) -> -	case happyOut6 happy_x_4 of { happy_var_4 -> -	happyIn6-		 (RealDecl (PInclude happy_var_2) : happy_var_4-	) `HappyStk` happyRest}}--happyReduce_7 = happySpecReduce_1  1# happyReduction_7-happyReduction_7 happy_x_1-	 =  case happyOut9 happy_x_1 of { happy_var_1 -> -	happyIn7-		 (happy_var_1-	)}--happyReduce_8 = happySpecReduce_1  1# happyReduction_8-happyReduction_8 happy_x_1-	 =  case happyOut26 happy_x_1 of { happy_var_1 -> -	happyIn7-		 (RealDecl (DataDecl happy_var_1)-	)}--happyReduce_9 = happySpecReduce_1  1# happyReduction_9-happyReduction_9 happy_x_1-	 =  case happyOut22 happy_x_1 of { happy_var_1 -> -	happyIn7-		 (RealDecl happy_var_1-	)}--happyReduce_10 = happyReduce 5# 1# happyReduction_10-happyReduction_10 (happy_x_5 `HappyStk`-	happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOutTok happy_x_2 of { (TokenName happy_var_2) -> -	case happyOut83 happy_x_3 of { happy_var_3 -> -	case happyOut82 happy_x_4 of { happy_var_4 -> -	happyIn7-		 (RealDecl (Freeze happy_var_3 happy_var_4 [] happy_var_2)-	) `HappyStk` happyRest}}}--happyReduce_11 = happyReduce 4# 1# happyReduction_11-happyReduction_11 (happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOut67 happy_x_1 of { happy_var_1 -> -	case happyOut6 happy_x_3 of { happy_var_3 -> -	happyIn7-		 (PUsing happy_var_1 happy_var_3-	) `HappyStk` happyRest}}--happyReduce_12 = happyReduce 4# 1# happyReduction_12-happyReduction_12 (happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOut68 happy_x_1 of { happy_var_1 -> -	case happyOut6 happy_x_3 of { happy_var_3 -> -	happyIn7-		 (PDoUsing happy_var_1 happy_var_3-	) `HappyStk` happyRest}}--happyReduce_13 = happyReduce 4# 1# happyReduction_13-happyReduction_13 (happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOut69 happy_x_1 of { happy_var_1 -> -	case happyOut6 happy_x_3 of { happy_var_3 -> -	happyIn7-		 (PIdiom happy_var_1 happy_var_3-	) `HappyStk` happyRest}}--happyReduce_14 = happyReduce 4# 1# happyReduction_14-happyReduction_14 (happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOut70 happy_x_1 of { happy_var_1 -> -	case happyOut6 happy_x_3 of { happy_var_3 -> -	happyIn7-		 (PParams happy_var_1 happy_var_3-	) `HappyStk` happyRest}}--happyReduce_15 = happyReduce 4# 1# happyReduction_15-happyReduction_15 (happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOut71 happy_x_1 of { happy_var_1 -> -	case happyOut6 happy_x_3 of { happy_var_3 -> -	happyIn7-		 (PNamespace happy_var_1 happy_var_3-	) `HappyStk` happyRest}}--happyReduce_16 = happySpecReduce_1  1# happyReduction_16-happyReduction_16 happy_x_1-	 =  case happyOut8 happy_x_1 of { happy_var_1 -> -	happyIn7-		 (RealDecl happy_var_1-	)}--happyReduce_17 = happyReduce 6# 1# happyReduction_17-happyReduction_17 (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 happyOut32 happy_x_2 of { happy_var_2 -> -	case happyOut41 happy_x_3 of { happy_var_3 -> -	case happyOut34 happy_x_5 of { happy_var_5 -> -	happyIn7-		 (RealDecl (SynDef happy_var_2 happy_var_3 happy_var_5)-	) `HappyStk` happyRest}}}--happyReduce_18 = happyReduce 5# 1# happyReduction_18-happyReduction_18 (happy_x_5 `HappyStk`-	happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOut32 happy_x_2 of { happy_var_2 -> -	case happyOut83 happy_x_3 of { happy_var_3 -> -	case happyOut82 happy_x_4 of { happy_var_4 -> -	happyIn7-		 (RealDecl (SynDef happy_var_2 [] (RVar happy_var_3 happy_var_4 (mkhidden happy_var_2) Unknown))-	) `HappyStk` happyRest}}}--happyReduce_19 = happySpecReduce_2  1# happyReduction_19-happyReduction_19 happy_x_2-	happy_x_1-	 =  case happyOutTok happy_x_2 of { (TokenString happy_var_2) -> -	happyIn7-		 (RealDecl (CInclude happy_var_2)-	)}--happyReduce_20 = happySpecReduce_2  1# happyReduction_20-happyReduction_20 happy_x_2-	happy_x_1-	 =  case happyOutTok happy_x_2 of { (TokenString happy_var_2) -> -	happyIn7-		 (RealDecl (CLib happy_var_2)-	)}--happyReduce_21 = happyReduce 5# 2# happyReduction_21-happyReduction_21 (happy_x_5 `HappyStk`-	happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOut34 happy_x_2 of { happy_var_2 -> -	case happyOut34 happy_x_4 of { happy_var_4 -> -	happyIn8-		 (Transform happy_var_2 happy_var_4-	) `HappyStk` happyRest}}--happyReduce_22 = happyReduce 7# 3# happyReduction_22-happyReduction_22 (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 happyOut32 happy_x_1 of { happy_var_1 -> -	case happyOut50 happy_x_3 of { happy_var_3 -> -	case happyOut15 happy_x_5 of { happy_var_5 -> -	case happyOut83 happy_x_6 of { happy_var_6 -> -	case happyOut82 happy_x_7 of { happy_var_7 -> -	happyIn9-		 (FunType happy_var_1 happy_var_3 (nub happy_var_5) happy_var_6 happy_var_7-	) `HappyStk` happyRest}}}}}--happyReduce_23 = happySpecReduce_3  3# happyReduction_23-happyReduction_23 happy_x_3-	happy_x_2-	happy_x_1-	 =  case happyOut32 happy_x_1 of { happy_var_1 -> -	case happyOut79 happy_x_2 of { happy_var_2 -> -	happyIn9-		 (ProofScript happy_var_1 happy_var_2-	)}}--happyReduce_24 = happyReduce 9# 3# happyReduction_24-happyReduction_24 (happy_x_9 `HappyStk`-	happy_x_8 `HappyStk`-	happy_x_7 `HappyStk`-	happy_x_6 `HappyStk`-	happy_x_5 `HappyStk`-	happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOut24 happy_x_1 of { happy_var_1 -> -	case happyOut12 happy_x_2 of { happy_var_2 -> -	case happyOut11 happy_x_3 of { happy_var_3 -> -	case happyOut34 happy_x_4 of { happy_var_4 -> -	case happyOut14 happy_x_6 of { happy_var_6 -> -	case happyOut83 happy_x_8 of { happy_var_8 -> -	case happyOut82 happy_x_9 of { happy_var_9 -> -	happyIn9-		 (WithClause (mkDef happy_var_8 happy_var_9 happy_var_1) happy_var_2 happy_var_3 happy_var_4 happy_var_6-	) `HappyStk` happyRest}}}}}}}--happyReduce_25 = happyReduce 10# 3# happyReduction_25-happyReduction_25 (happy_x_10 `HappyStk`-	happy_x_9 `HappyStk`-	happy_x_8 `HappyStk`-	happy_x_7 `HappyStk`-	happy_x_6 `HappyStk`-	happy_x_5 `HappyStk`-	happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOut24 happy_x_1 of { happy_var_1 -> -	case happyOut12 happy_x_2 of { happy_var_2 -> -	case happyOut34 happy_x_4 of { happy_var_4 -> -	case happyOut32 happy_x_7 of { happy_var_7 -> -	case happyOut83 happy_x_9 of { happy_var_9 -> -	case happyOut82 happy_x_10 of { happy_var_10 -> -	happyIn9-		 (FunClauseP (mkDef happy_var_9 happy_var_10 happy_var_1) happy_var_2 happy_var_4 happy_var_7-	) `HappyStk` happyRest}}}}}}--happyReduce_26 = happyReduce 8# 3# happyReduction_26-happyReduction_26 (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 happyOut24 happy_x_1 of { happy_var_1 -> -	case happyOut12 happy_x_2 of { happy_var_2 -> -	case happyOut34 happy_x_4 of { happy_var_4 -> -	case happyOut15 happy_x_6 of { happy_var_6 -> -	case happyOut83 happy_x_7 of { happy_var_7 -> -	case happyOut82 happy_x_8 of { happy_var_8 -> -	happyIn9-		 (FunClause (mkDef happy_var_7 happy_var_8 happy_var_1) happy_var_2 happy_var_4 (nub happy_var_6)-	) `HappyStk` happyRest}}}}}}--happyReduce_27 = happyReduce 5# 3# happyReduction_27-happyReduction_27 (happy_x_5 `HappyStk`-	happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOut13 happy_x_2 of { happy_var_2 -> -	case happyOut34 happy_x_4 of { happy_var_4 -> -	happyIn9-		 (FunClause RPlaceholder [happy_var_2] happy_var_4 []-	) `HappyStk` happyRest}}--happyReduce_28 = happyReduce 8# 3# happyReduction_28-happyReduction_28 (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 happyOut13 happy_x_2 of { happy_var_2 -> -	case happyOut34 happy_x_4 of { happy_var_4 -> -	case happyOut32 happy_x_7 of { happy_var_7 -> -	happyIn9-		 (FunClauseP RPlaceholder [happy_var_2] happy_var_4 happy_var_7-	) `HappyStk` happyRest}}}--happyReduce_29 = happyReduce 7# 3# happyReduction_29-happyReduction_29 (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 happyOut13 happy_x_2 of { happy_var_2 -> -	case happyOut11 happy_x_3 of { happy_var_3 -> -	case happyOut34 happy_x_4 of { happy_var_4 -> -	case happyOut14 happy_x_6 of { happy_var_6 -> -	happyIn9-		 (WithClause RPlaceholder [happy_var_2] happy_var_3 happy_var_4 happy_var_6-	) `HappyStk` happyRest}}}}--happyReduce_30 = happySpecReduce_1  4# happyReduction_30-happyReduction_30 happy_x_1-	 =  happyIn10-		 (Vis Public-	)--happyReduce_31 = happySpecReduce_1  4# happyReduction_31-happyReduction_31 happy_x_1-	 =  happyIn10-		 (Vis Private-	)--happyReduce_32 = happySpecReduce_1  4# happyReduction_32-happyReduction_32 happy_x_1-	 =  happyIn10-		 (Vis Abstract-	)--happyReduce_33 = happySpecReduce_0  4# happyReduction_33-happyReduction_33  =  happyIn10-		 (Vis Public-	)--happyReduce_34 = happySpecReduce_1  5# happyReduction_34-happyReduction_34 happy_x_1-	 =  happyIn11-		 (False-	)--happyReduce_35 = happySpecReduce_2  5# happyReduction_35-happyReduction_35 happy_x_2-	happy_x_1-	 =  happyIn11-		 (True-	)--happyReduce_36 = happySpecReduce_3  6# happyReduction_36-happyReduction_36 happy_x_3-	happy_x_2-	happy_x_1-	 =  case happyOut13 happy_x_2 of { happy_var_2 -> -	case happyOut12 happy_x_3 of { happy_var_3 -> -	happyIn12-		 (happy_var_2:happy_var_3-	)}}--happyReduce_37 = happySpecReduce_0  6# happyReduction_37-happyReduction_37  =  happyIn12-		 ([]-	)--happyReduce_38 = happySpecReduce_1  7# happyReduction_38-happyReduction_38 happy_x_1-	 =  case happyOut33 happy_x_1 of { happy_var_1 -> -	happyIn13-		 (happy_var_1-	)}--happyReduce_39 = happySpecReduce_1  7# happyReduction_39-happyReduction_39 happy_x_1-	 =  case happyOut58 happy_x_1 of { happy_var_1 -> -	happyIn13-		 (happy_var_1-	)}--happyReduce_40 = happySpecReduce_3  7# happyReduction_40-happyReduction_40 happy_x_3-	happy_x_2-	happy_x_1-	 =  case happyOut34 happy_x_2 of { happy_var_2 -> -	happyIn13-		 (happy_var_2-	)}--happyReduce_41 = happyReduce 5# 7# happyReduction_41-happyReduction_41 (happy_x_5 `HappyStk`-	happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOut59 happy_x_2 of { happy_var_2 -> -	case happyOut83 happy_x_4 of { happy_var_4 -> -	case happyOut82 happy_x_5 of { happy_var_5 -> -	happyIn13-		 (pairDesugar happy_var_4 happy_var_5 (RVar happy_var_4 happy_var_5 (UN "mkPair") Unknown) happy_var_2-	) `HappyStk` happyRest}}}--happyReduce_42 = happySpecReduce_2  8# happyReduction_42-happyReduction_42 happy_x_2-	happy_x_1-	 =  case happyOut9 happy_x_1 of { happy_var_1 -> -	case happyOut14 happy_x_2 of { happy_var_2 -> -	happyIn14-		 (happy_var_1:happy_var_2-	)}}--happyReduce_43 = happySpecReduce_1  8# happyReduction_43-happyReduction_43 happy_x_1-	 =  case happyOut9 happy_x_1 of { happy_var_1 -> -	happyIn14-		 ([happy_var_1]-	)}--happyReduce_44 = happySpecReduce_3  9# happyReduction_44-happyReduction_44 happy_x_3-	happy_x_2-	happy_x_1-	 =  case happyOut16 happy_x_2 of { happy_var_2 -> -	happyIn15-		 (happy_var_2-	)}--happyReduce_45 = happySpecReduce_0  9# happyReduction_45-happyReduction_45  =  happyIn15-		 ([]-	)--happyReduce_46 = happySpecReduce_0  10# happyReduction_46-happyReduction_46  =  happyIn16-		 ([]-	)--happyReduce_47 = happySpecReduce_2  10# happyReduction_47-happyReduction_47 happy_x_2-	happy_x_1-	 =  case happyOut17 happy_x_1 of { happy_var_1 -> -	case happyOut16 happy_x_2 of { happy_var_2 -> -	happyIn16-		 (happy_var_1 ++ happy_var_2-	)}}--happyReduce_48 = happySpecReduce_1  11# happyReduction_48-happyReduction_48 happy_x_1-	 =  happyIn17-		 ([NoCG]-	)--happyReduce_49 = happySpecReduce_1  11# happyReduction_49-happyReduction_49 happy_x_1-	 =  happyIn17-		 ([CGEval, Inline]-	)--happyReduce_50 = happyReduce 4# 11# happyReduction_50-happyReduction_50 (happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOut39 happy_x_3 of { happy_var_3 -> -	happyIn17-		 ([CGSpec happy_var_3]-	) `HappyStk` happyRest}--happyReduce_51 = happySpecReduce_1  11# happyReduction_51-happyReduction_51 happy_x_1-	 =  happyIn17-		 ([CGSpec []]-	)--happyReduce_52 = happySpecReduce_1  11# happyReduction_52-happyReduction_52 happy_x_1-	 =  happyIn17-		 ([Inline]-	)--happyReduce_53 = happySpecReduce_2  11# happyReduction_53-happyReduction_53 happy_x_2-	happy_x_1-	 =  case happyOutTok happy_x_2 of { (TokenString happy_var_2) -> -	happyIn17-		 ([CExport happy_var_2]-	)}--happyReduce_54 = happyReduce 4# 12# happyReduction_54-happyReduction_54 (happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOut21 happy_x_1 of { happy_var_1 -> -	case happyOutTok happy_x_2 of { (TokenInt happy_var_2) -> -	case happyOut19 happy_x_3 of { happy_var_3 -> -	happyIn18-		 (map (\x -> Fixity x happy_var_1 happy_var_2) happy_var_3-	) `HappyStk` happyRest}}}--happyReduce_55 = happySpecReduce_1  13# happyReduction_55-happyReduction_55 happy_x_1-	 =  case happyOut20 happy_x_1 of { happy_var_1 -> -	happyIn19-		 ([happy_var_1]-	)}--happyReduce_56 = happySpecReduce_3  13# happyReduction_56-happyReduction_56 happy_x_3-	happy_x_2-	happy_x_1-	 =  case happyOut20 happy_x_1 of { happy_var_1 -> -	case happyOut19 happy_x_3 of { happy_var_3 -> -	happyIn19-		 (happy_var_1:happy_var_3-	)}}--happyReduce_57 = happySpecReduce_1  14# happyReduction_57-happyReduction_57 happy_x_1-	 =  case happyOutTok happy_x_1 of { (TokenInfixName happy_var_1) -> -	happyIn20-		 (happy_var_1-	)}--happyReduce_58 = happySpecReduce_1  14# happyReduction_58-happyReduction_58 happy_x_1-	 =  happyIn20-		 ("-"-	)--happyReduce_59 = happySpecReduce_1  14# happyReduction_59-happyReduction_59 happy_x_1-	 =  happyIn20-		 ("<"-	)--happyReduce_60 = happySpecReduce_1  14# happyReduction_60-happyReduction_60 happy_x_1-	 =  happyIn20-		 (">"-	)--happyReduce_61 = happySpecReduce_1  15# happyReduction_61-happyReduction_61 happy_x_1-	 =  happyIn21-		 (LeftAssoc-	)--happyReduce_62 = happySpecReduce_1  15# happyReduction_62-happyReduction_62 happy_x_1-	 =  happyIn21-		 (RightAssoc-	)--happyReduce_63 = happySpecReduce_1  15# happyReduction_63-happyReduction_63 happy_x_1-	 =  happyIn21-		 (NonAssoc-	)--happyReduce_64 = happyReduce 4# 16# happyReduction_64-happyReduction_64 (happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOut23 happy_x_3 of { happy_var_3 -> -	happyIn22-		 (LatexDefs happy_var_3-	) `HappyStk` happyRest}--happyReduce_65 = happySpecReduce_3  17# happyReduction_65-happyReduction_65 happy_x_3-	happy_x_2-	happy_x_1-	 =  case happyOut32 happy_x_1 of { happy_var_1 -> -	case happyOutTok happy_x_3 of { (TokenString happy_var_3) -> -	happyIn23-		 ([(happy_var_1,happy_var_3)]-	)}}--happyReduce_66 = happyReduce 5# 17# happyReduction_66-happyReduction_66 (happy_x_5 `HappyStk`-	happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOut32 happy_x_1 of { happy_var_1 -> -	case happyOutTok happy_x_3 of { (TokenString happy_var_3) -> -	case happyOut23 happy_x_5 of { happy_var_5 -> -	happyIn23-		 ((happy_var_1,happy_var_3):happy_var_5-	) `HappyStk` happyRest}}}--happyReduce_67 = happySpecReduce_2  18# happyReduction_67-happyReduction_67 happy_x_2-	happy_x_1-	 =  case happyOut32 happy_x_1 of { happy_var_1 -> -	case happyOut25 happy_x_2 of { happy_var_2 -> -	happyIn24-		 ((happy_var_1, happy_var_2)-	)}}--happyReduce_68 = happySpecReduce_0  19# happyReduction_68-happyReduction_68  =  happyIn25-		 ([]-	)--happyReduce_69 = happySpecReduce_2  19# happyReduction_69-happyReduction_69 happy_x_2-	happy_x_1-	 =  case happyOut57 happy_x_1 of { happy_var_1 -> -	case happyOut25 happy_x_2 of { happy_var_2 -> -	happyIn25-		 ((happy_var_1,Nothing):happy_var_2-	)}}--happyReduce_70 = happyReduce 5# 19# happyReduction_70-happyReduction_70 (happy_x_5 `HappyStk`-	happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOutTok happy_x_1 of { (TokenBrackName happy_var_1) -> -	case happyOut25 happy_x_3 of { happy_var_3 -> -	case happyOut83 happy_x_4 of { happy_var_4 -> -	case happyOut82 happy_x_5 of { happy_var_5 -> -	happyIn25-		 ((RVar happy_var_4 happy_var_5 happy_var_1 Unknown, Just happy_var_1):happy_var_3-	) `HappyStk` happyRest}}}}--happyReduce_71 = happyReduce 5# 19# 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 happyOutTok happy_x_1 of { (TokenBrackName happy_var_1) -> -	case happyOut34 happy_x_3 of { happy_var_3 -> -	case happyOut25 happy_x_5 of { happy_var_5 -> -	happyIn25-		 ((happy_var_3, Just happy_var_1):happy_var_5-	) `HappyStk` happyRest}}}--happyReduce_72 = happyReduce 6# 20# happyReduction_72-happyReduction_72 (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 happyOut27 happy_x_1 of { happy_var_1 -> -	case happyOut29 happy_x_2 of { happy_var_2 -> -	case happyOut32 happy_x_3 of { happy_var_3 -> -	case happyOut28 happy_x_4 of { happy_var_4 -> -	case happyOut83 happy_x_5 of { happy_var_5 -> -	case happyOut82 happy_x_6 of { happy_var_6 -> -	happyIn26-		 (mkDatatype happy_var_1 happy_var_5 happy_var_6 happy_var_3 happy_var_4 happy_var_2-	) `HappyStk` happyRest}}}}}}--happyReduce_73 = happySpecReduce_1  21# happyReduction_73-happyReduction_73 happy_x_1-	 =  happyIn27-		 (False-	)--happyReduce_74 = happySpecReduce_1  21# happyReduction_74-happyReduction_74 happy_x_1-	 =  happyIn27-		 (True-	)--happyReduce_75 = happySpecReduce_3  22# happyReduction_75-happyReduction_75 happy_x_3-	happy_x_2-	happy_x_1-	 =  case happyOut66 happy_x_1 of { happy_var_1 -> -	case happyOut75 happy_x_2 of { happy_var_2 -> -	happyIn28-		 (Right (happy_var_1,happy_var_2)-	)}}--happyReduce_76 = happySpecReduce_3  22# happyReduction_76-happyReduction_76 happy_x_3-	happy_x_2-	happy_x_1-	 =  case happyOut50 happy_x_2 of { happy_var_2 -> -	happyIn28-		 (Left happy_var_2-	)}--happyReduce_77 = happySpecReduce_3  22# happyReduction_77-happyReduction_77 happy_x_3-	happy_x_2-	happy_x_1-	 =  case happyOut83 happy_x_2 of { happy_var_2 -> -	case happyOut82 happy_x_3 of { happy_var_3 -> -	happyIn28-		 (Left (RConst happy_var_2 happy_var_3 TYPE)-	)}}--happyReduce_78 = happySpecReduce_0  23# happyReduction_78-happyReduction_78  =  happyIn29-		 ([]-	)--happyReduce_79 = happySpecReduce_3  23# happyReduction_79-happyReduction_79 happy_x_3-	happy_x_2-	happy_x_1-	 =  case happyOut30 happy_x_2 of { happy_var_2 -> -	happyIn29-		 (happy_var_2-	)}--happyReduce_80 = happySpecReduce_1  24# happyReduction_80-happyReduction_80 happy_x_1-	 =  case happyOut31 happy_x_1 of { happy_var_1 -> -	happyIn30-		 ([happy_var_1]-	)}--happyReduce_81 = happySpecReduce_3  24# happyReduction_81-happyReduction_81 happy_x_3-	happy_x_2-	happy_x_1-	 =  case happyOut31 happy_x_1 of { happy_var_1 -> -	case happyOut30 happy_x_3 of { happy_var_3 -> -	happyIn30-		 (happy_var_1:happy_var_3-	)}}--happyReduce_82 = happySpecReduce_1  25# happyReduction_82-happyReduction_82 happy_x_1-	 =  happyIn31-		 (NoElim-	)--happyReduce_83 = happySpecReduce_1  25# happyReduction_83-happyReduction_83 happy_x_1-	 =  happyIn31-		 (Collapsible-	)--happyReduce_84 = happySpecReduce_1  26# happyReduction_84-happyReduction_84 happy_x_1-	 =  case happyOutTok happy_x_1 of { (TokenName happy_var_1) -> -	happyIn32-		 (happy_var_1-	)}--happyReduce_85 = happySpecReduce_3  26# happyReduction_85-happyReduction_85 happy_x_3-	happy_x_2-	happy_x_1-	 =  case happyOut20 happy_x_2 of { happy_var_2 -> -	happyIn32-		 (useropFn happy_var_2-	)}--happyReduce_86 = happyReduce 4# 27# happyReduction_86-happyReduction_86 (happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOut33 happy_x_1 of { happy_var_1 -> -	case happyOut83 happy_x_2 of { happy_var_2 -> -	case happyOut82 happy_x_3 of { happy_var_3 -> -	case happyOut57 happy_x_4 of { happy_var_4 -> -	happyIn33-		 (RApp happy_var_2 happy_var_3 happy_var_1 happy_var_4-	) `HappyStk` happyRest}}}}--happyReduce_87 = happyReduce 5# 27# happyReduction_87-happyReduction_87 (happy_x_5 `HappyStk`-	happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOut33 happy_x_1 of { happy_var_1 -> -	case happyOut43 happy_x_2 of { happy_var_2 -> -	case happyOut83 happy_x_4 of { happy_var_4 -> -	case happyOut82 happy_x_5 of { happy_var_5 -> -	happyIn33-		 (RAppImp happy_var_4 happy_var_5 (fst happy_var_2) happy_var_1 (snd happy_var_2)-	) `HappyStk` happyRest}}}}--happyReduce_88 = happySpecReduce_3  27# happyReduction_88-happyReduction_88 happy_x_3-	happy_x_2-	happy_x_1-	 =  case happyOut32 happy_x_1 of { happy_var_1 -> -	case happyOut83 happy_x_2 of { happy_var_2 -> -	case happyOut82 happy_x_3 of { happy_var_3 -> -	happyIn33-		 (RVar happy_var_2 happy_var_3 happy_var_1 Unknown-	)}}}--happyReduce_89 = happySpecReduce_3  27# happyReduction_89-happyReduction_89 happy_x_3-	happy_x_2-	happy_x_1-	 =  case happyOut64 happy_x_1 of { happy_var_1 -> -	case happyOut83 happy_x_2 of { happy_var_2 -> -	case happyOut82 happy_x_3 of { happy_var_3 -> -	happyIn33-		 (RConst happy_var_2 happy_var_3 happy_var_1-	)}}}--happyReduce_90 = happySpecReduce_1  27# happyReduction_90-happyReduction_90 happy_x_1-	 =  happyIn33-		 (RPlaceholder-	)--happyReduce_91 = happySpecReduce_3  27# happyReduction_91-happyReduction_91 happy_x_3-	happy_x_2-	happy_x_1-	 =  case happyOut83 happy_x_2 of { happy_var_2 -> -	case happyOut82 happy_x_3 of { happy_var_3 -> -	happyIn33-		 (RVar happy_var_2 happy_var_3 (UN "__Empty") TypeCon-	)}}--happyReduce_92 = happySpecReduce_3  27# happyReduction_92-happyReduction_92 happy_x_3-	happy_x_2-	happy_x_1-	 =  case happyOut83 happy_x_2 of { happy_var_2 -> -	case happyOut82 happy_x_3 of { happy_var_3 -> -	happyIn33-		 (RVar happy_var_2 happy_var_3 (UN "__Unit") TypeCon-	)}}--happyReduce_93 = happySpecReduce_1  28# happyReduction_93-happyReduction_93 happy_x_1-	 =  case happyOut57 happy_x_1 of { happy_var_1 -> -	happyIn34-		 (happy_var_1-	)}--happyReduce_94 = happySpecReduce_3  28# happyReduction_94-happyReduction_94 happy_x_3-	happy_x_2-	happy_x_1-	 =  case happyOut50 happy_x_2 of { happy_var_2 -> -	happyIn34-		 (happy_var_2-	)}--happyReduce_95 = happyReduce 4# 28# happyReduction_95-happyReduction_95 (happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOut34 happy_x_1 of { happy_var_1 -> -	case happyOut83 happy_x_2 of { happy_var_2 -> -	case happyOut82 happy_x_3 of { happy_var_3 -> -	case happyOut57 happy_x_4 of { happy_var_4 -> -	happyIn34-		 (RApp happy_var_2 happy_var_3 happy_var_1 happy_var_4-	) `HappyStk` happyRest}}}}--happyReduce_96 = happyReduce 5# 28# happyReduction_96-happyReduction_96 (happy_x_5 `HappyStk`-	happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOut34 happy_x_1 of { happy_var_1 -> -	case happyOut43 happy_x_2 of { happy_var_2 -> -	case happyOut83 happy_x_4 of { happy_var_4 -> -	case happyOut82 happy_x_5 of { happy_var_5 -> -	happyIn34-		 (RAppImp happy_var_4 happy_var_5 (fst happy_var_2) happy_var_1 (snd happy_var_2)-	) `HappyStk` happyRest}}}}--happyReduce_97 = happyReduce 4# 28# happyReduction_97-happyReduction_97 (happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOut34 happy_x_2 of { happy_var_2 -> -	case happyOut83 happy_x_3 of { happy_var_3 -> -	case happyOut82 happy_x_4 of { happy_var_4 -> -	happyIn34-		 (RApp happy_var_3 happy_var_4 (RApp happy_var_3 happy_var_4 (RVar happy_var_3 happy_var_4 (UN "__lazy") Free) RPlaceholder) happy_var_2-	) `HappyStk` happyRest}}}--happyReduce_98 = happyReduce 4# 28# happyReduction_98-happyReduction_98 (happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOut35 happy_x_2 of { happy_var_2 -> -	case happyOut34 happy_x_4 of { happy_var_4 -> -	happyIn34-		 (doBind Lam happy_var_2 happy_var_4-	) `HappyStk` happyRest}}--happyReduce_99 = happyReduce 4# 28# happyReduction_99-happyReduction_99 (happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOut42 happy_x_2 of { happy_var_2 -> -	case happyOut34 happy_x_4 of { happy_var_4 -> -	happyIn34-		 (doLetBind happy_var_2 happy_var_4-	) `HappyStk` happyRest}}--happyReduce_100 = happySpecReduce_1  28# happyReduction_100-happyReduction_100 happy_x_1-	 =  case happyOut44 happy_x_1 of { happy_var_1 -> -	happyIn34-		 (happy_var_1-	)}--happyReduce_101 = happyReduce 8# 28# happyReduction_101-happyReduction_101 (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 happyOut34 happy_x_2 of { happy_var_2 -> -	case happyOut34 happy_x_4 of { happy_var_4 -> -	case happyOut34 happy_x_6 of { happy_var_6 -> -	case happyOut83 happy_x_7 of { happy_var_7 -> -	case happyOut82 happy_x_8 of { happy_var_8 -> -	happyIn34-		 (mkApp happy_var_7 happy_var_8 (RVar happy_var_7 happy_var_8 (UN "if_then_else") Free) [happy_var_2,happy_var_4,happy_var_6]-	) `HappyStk` happyRest}}}}}--happyReduce_102 = happySpecReduce_2  29# happyReduction_102-happyReduction_102 happy_x_2-	happy_x_1-	 =  case happyOut32 happy_x_1 of { happy_var_1 -> -	case happyOut48 happy_x_2 of { happy_var_2 -> -	happyIn35-		 ([(happy_var_1,happy_var_2)]-	)}}--happyReduce_103 = happyReduce 4# 29# happyReduction_103-happyReduction_103 (happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOut32 happy_x_1 of { happy_var_1 -> -	case happyOut48 happy_x_2 of { happy_var_2 -> -	case happyOut35 happy_x_4 of { happy_var_4 -> -	happyIn35-		 ((happy_var_1,happy_var_2):happy_var_4-	) `HappyStk` happyRest}}}--happyReduce_104 = happySpecReduce_3  30# happyReduction_104-happyReduction_104 happy_x_3-	happy_x_2-	happy_x_1-	 =  case happyOut37 happy_x_1 of { happy_var_1 -> -	case happyOut36 happy_x_3 of { happy_var_3 -> -	happyIn36-		 (happy_var_1 ++ happy_var_3-	)}}--happyReduce_105 = happySpecReduce_1  30# happyReduction_105-happyReduction_105 happy_x_1-	 =  case happyOut37 happy_x_1 of { happy_var_1 -> -	happyIn36-		 (happy_var_1-	)}--happyReduce_106 = happySpecReduce_3  31# happyReduction_106-happyReduction_106 happy_x_3-	happy_x_2-	happy_x_1-	 =  case happyOut32 happy_x_1 of { happy_var_1 -> -	case happyOut50 happy_x_3 of { happy_var_3 -> -	happyIn37-		 (map ( \x -> (x,happy_var_3)) [happy_var_1]-	)}}--happyReduce_107 = happySpecReduce_1  32# happyReduction_107-happyReduction_107 happy_x_1-	 =  case happyOut32 happy_x_1 of { happy_var_1 -> -	happyIn38-		 ([happy_var_1]-	)}--happyReduce_108 = happySpecReduce_3  32# happyReduction_108-happyReduction_108 happy_x_3-	happy_x_2-	happy_x_1-	 =  case happyOut32 happy_x_1 of { happy_var_1 -> -	case happyOut38 happy_x_3 of { happy_var_3 -> -	happyIn38-		 (happy_var_1:happy_var_3-	)}}--happyReduce_109 = happySpecReduce_2  33# happyReduction_109-happyReduction_109 happy_x_2-	happy_x_1-	 =  case happyOut32 happy_x_1 of { happy_var_1 -> -	case happyOutTok happy_x_2 of { (TokenInt happy_var_2) -> -	happyIn39-		 ([(happy_var_1,happy_var_2)]-	)}}--happyReduce_110 = happySpecReduce_1  33# happyReduction_110-happyReduction_110 happy_x_1-	 =  case happyOut32 happy_x_1 of { happy_var_1 -> -	happyIn39-		 ([(happy_var_1, 0)]-	)}--happyReduce_111 = happySpecReduce_3  33# happyReduction_111-happyReduction_111 happy_x_3-	happy_x_2-	happy_x_1-	 =  case happyOut32 happy_x_1 of { happy_var_1 -> -	case happyOut39 happy_x_3 of { happy_var_3 -> -	happyIn39-		 ((happy_var_1,0):happy_var_3-	)}}--happyReduce_112 = happyReduce 4# 33# happyReduction_112-happyReduction_112 (happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOut32 happy_x_1 of { happy_var_1 -> -	case happyOutTok happy_x_2 of { (TokenInt happy_var_2) -> -	case happyOut39 happy_x_4 of { happy_var_4 -> -	happyIn39-		 ((happy_var_1,happy_var_2):happy_var_4-	) `HappyStk` happyRest}}}--happyReduce_113 = happySpecReduce_1  34# happyReduction_113-happyReduction_113 happy_x_1-	 =  case happyOutTok happy_x_1 of { (TokenBrackName happy_var_1) -> -	happyIn40-		 ([happy_var_1]-	)}--happyReduce_114 = happySpecReduce_3  34# happyReduction_114-happyReduction_114 happy_x_3-	happy_x_2-	happy_x_1-	 =  case happyOutTok happy_x_1 of { (TokenBrackName happy_var_1) -> -	case happyOut38 happy_x_3 of { happy_var_3 -> -	happyIn40-		 (happy_var_1:happy_var_3-	)}}--happyReduce_115 = happySpecReduce_0  35# happyReduction_115-happyReduction_115  =  happyIn41-		 ([]-	)--happyReduce_116 = happySpecReduce_2  35# happyReduction_116-happyReduction_116 happy_x_2-	happy_x_1-	 =  case happyOut32 happy_x_1 of { happy_var_1 -> -	case happyOut41 happy_x_2 of { happy_var_2 -> -	happyIn41-		 (happy_var_1:happy_var_2-	)}}--happyReduce_117 = happyReduce 4# 36# happyReduction_117-happyReduction_117 (happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOut32 happy_x_1 of { happy_var_1 -> -	case happyOut48 happy_x_2 of { happy_var_2 -> -	case happyOut34 happy_x_4 of { happy_var_4 -> -	happyIn42-		 ([(happy_var_1,happy_var_2,happy_var_4)]-	) `HappyStk` happyRest}}}--happyReduce_118 = happyReduce 6# 36# happyReduction_118-happyReduction_118 (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 happyOut32 happy_x_1 of { happy_var_1 -> -	case happyOut48 happy_x_2 of { happy_var_2 -> -	case happyOut34 happy_x_4 of { happy_var_4 -> -	case happyOut42 happy_x_6 of { happy_var_6 -> -	happyIn42-		 ((happy_var_1,happy_var_2,happy_var_4):happy_var_6-	) `HappyStk` happyRest}}}}--happyReduce_119 = happySpecReduce_3  37# happyReduction_119-happyReduction_119 happy_x_3-	happy_x_2-	happy_x_1-	 =  case happyOutTok happy_x_1 of { (TokenBrackName happy_var_1) -> -	case happyOut83 happy_x_2 of { happy_var_2 -> -	case happyOut82 happy_x_3 of { happy_var_3 -> -	happyIn43-		 ((happy_var_1, RVar happy_var_2 happy_var_3 happy_var_1 Unknown)-	)}}}--happyReduce_120 = happySpecReduce_3  37# happyReduction_120-happyReduction_120 happy_x_3-	happy_x_2-	happy_x_1-	 =  case happyOutTok happy_x_1 of { (TokenBrackName happy_var_1) -> -	case happyOut34 happy_x_3 of { happy_var_3 -> -	happyIn43-		 ((happy_var_1, happy_var_3)-	)}}--happyReduce_121 = happyReduce 4# 38# happyReduction_121-happyReduction_121 (happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOut34 happy_x_2 of { happy_var_2 -> -	case happyOut83 happy_x_3 of { happy_var_3 -> -	case happyOut82 happy_x_4 of { happy_var_4 -> -	happyIn44-		 (RInfix happy_var_3 happy_var_4 Minus (RConst happy_var_3 happy_var_4 (Num 0)) happy_var_2-	) `HappyStk` happyRest}}}--happyReduce_122 = happyReduce 5# 38# happyReduction_122-happyReduction_122 (happy_x_5 `HappyStk`-	happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOut34 happy_x_1 of { happy_var_1 -> -	case happyOut34 happy_x_3 of { happy_var_3 -> -	case happyOut83 happy_x_4 of { happy_var_4 -> -	case happyOut82 happy_x_5 of { happy_var_5 -> -	happyIn44-		 (RUserInfix happy_var_4 happy_var_5 False "-" happy_var_1 happy_var_3-	) `HappyStk` happyRest}}}}--happyReduce_123 = happyReduce 5# 38# happyReduction_123-happyReduction_123 (happy_x_5 `HappyStk`-	happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOut34 happy_x_1 of { happy_var_1 -> -	case happyOut34 happy_x_3 of { happy_var_3 -> -	case happyOut83 happy_x_4 of { happy_var_4 -> -	case happyOut82 happy_x_5 of { happy_var_5 -> -	happyIn44-		 (mkApp happy_var_4 happy_var_5 (RVar happy_var_4 happy_var_5 (UN "Pair") TypeCon) [happy_var_1, happy_var_3]-	) `HappyStk` happyRest}}}}--happyReduce_124 = happyReduce 5# 38# happyReduction_124-happyReduction_124 (happy_x_5 `HappyStk`-	happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOut34 happy_x_1 of { happy_var_1 -> -	case happyOut34 happy_x_3 of { happy_var_3 -> -	case happyOut83 happy_x_4 of { happy_var_4 -> -	case happyOut82 happy_x_5 of { happy_var_5 -> -	happyIn44-		 (RUserInfix happy_var_4 happy_var_5 False "<" happy_var_1 happy_var_3-	) `HappyStk` happyRest}}}}--happyReduce_125 = happyReduce 5# 38# happyReduction_125-happyReduction_125 (happy_x_5 `HappyStk`-	happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOut34 happy_x_1 of { happy_var_1 -> -	case happyOut34 happy_x_3 of { happy_var_3 -> -	case happyOut83 happy_x_4 of { happy_var_4 -> -	case happyOut82 happy_x_5 of { happy_var_5 -> -	happyIn44-		 (RUserInfix happy_var_4 happy_var_5 False ">" happy_var_1 happy_var_3-	) `HappyStk` happyRest}}}}--happyReduce_126 = happyReduce 5# 38# happyReduction_126-happyReduction_126 (happy_x_5 `HappyStk`-	happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOut34 happy_x_1 of { happy_var_1 -> -	case happyOut34 happy_x_3 of { happy_var_3 -> -	happyIn44-		 (RBind (MN "X" 0) (Pi Ex [] happy_var_1) happy_var_3-	) `HappyStk` happyRest}}--happyReduce_127 = happySpecReduce_1  38# happyReduction_127-happyReduction_127 happy_x_1-	 =  case happyOut45 happy_x_1 of { happy_var_1 -> -	happyIn44-		 (happy_var_1-	)}--happyReduce_128 = happyReduce 5# 38# happyReduction_128-happyReduction_128 (happy_x_5 `HappyStk`-	happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOut57 happy_x_1 of { happy_var_1 -> -	case happyOut57 happy_x_3 of { happy_var_3 -> -	case happyOut83 happy_x_4 of { happy_var_4 -> -	case happyOut82 happy_x_5 of { happy_var_5 -> -	happyIn44-		 (RInfix happy_var_4 happy_var_5 JMEq happy_var_1 happy_var_3-	) `HappyStk` happyRest}}}}--happyReduce_129 = happyReduce 5# 39# happyReduction_129-happyReduction_129 (happy_x_5 `HappyStk`-	happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOut34 happy_x_1 of { happy_var_1 -> -	case happyOutTok happy_x_2 of { (TokenInfixName happy_var_2) -> -	case happyOut34 happy_x_3 of { happy_var_3 -> -	case happyOut83 happy_x_4 of { happy_var_4 -> -	case happyOut82 happy_x_5 of { happy_var_5 -> -	happyIn45-		 (RUserInfix happy_var_4 happy_var_5 False happy_var_2 happy_var_1 happy_var_3-	) `HappyStk` happyRest}}}}}--happyReduce_130 = happyReduce 6# 40# happyReduction_130-happyReduction_130 (happy_x_6 `HappyStk`-	happy_x_5 `HappyStk`-	happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOutTok happy_x_2 of { (TokenInfixName happy_var_2) -> -	case happyOut34 happy_x_3 of { happy_var_3 -> -	case happyOut83 happy_x_4 of { happy_var_4 -> -	case happyOut82 happy_x_5 of { happy_var_5 -> -	happyIn46-		 (RBind (MN "X" 0) (Lam RPlaceholder) -                       (RUserInfix happy_var_4 happy_var_5 False happy_var_2 (RVar happy_var_4 happy_var_5 (MN "X" 0) Unknown) happy_var_3)-	) `HappyStk` happyRest}}}}--happyReduce_131 = happyReduce 6# 40# happyReduction_131-happyReduction_131 (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 happyOut34 happy_x_2 of { happy_var_2 -> -	case happyOutTok happy_x_3 of { (TokenInfixName happy_var_3) -> -	case happyOut83 happy_x_4 of { happy_var_4 -> -	case happyOut82 happy_x_5 of { happy_var_5 -> -	happyIn46-		 (RBind (MN "X" 0) (Lam RPlaceholder) -                       (RUserInfix happy_var_4 happy_var_5 False happy_var_3 happy_var_2 (RVar happy_var_4 happy_var_5 (MN "X" 0) Unknown))-	) `HappyStk` happyRest}}}}--happyReduce_132 = happyReduce 6# 40# happyReduction_132-happyReduction_132 (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 happyOut47 happy_x_2 of { happy_var_2 -> -	case happyOut34 happy_x_3 of { happy_var_3 -> -	case happyOut83 happy_x_4 of { happy_var_4 -> -	case happyOut82 happy_x_5 of { happy_var_5 -> -	happyIn46-		 (RBind (MN "X" 0) (Lam RPlaceholder) -                       (RUserInfix happy_var_4 happy_var_5 False happy_var_2 (RVar happy_var_4 happy_var_5 (MN "X" 0) Unknown) happy_var_3)-	) `HappyStk` happyRest}}}}--happyReduce_133 = happyReduce 6# 40# happyReduction_133-happyReduction_133 (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 happyOut34 happy_x_2 of { happy_var_2 -> -	case happyOut47 happy_x_3 of { happy_var_3 -> -	case happyOut83 happy_x_4 of { happy_var_4 -> -	case happyOut82 happy_x_5 of { happy_var_5 -> -	happyIn46-		 (RBind (MN "X" 0) (Lam RPlaceholder) -                       (RUserInfix happy_var_4 happy_var_5 False happy_var_3 happy_var_2 (RVar happy_var_4 happy_var_5 (MN "X" 0) Unknown))-	) `HappyStk` happyRest}}}}--happyReduce_134 = happyReduce 6# 40# happyReduction_134-happyReduction_134 (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 happyOut34 happy_x_2 of { happy_var_2 -> -	case happyOut83 happy_x_4 of { happy_var_4 -> -	case happyOut82 happy_x_5 of { happy_var_5 -> -	happyIn46-		 (RBind (MN "X" 0) (Lam RPlaceholder) -                       (RUserInfix happy_var_4 happy_var_5 False "-" happy_var_2 (RVar happy_var_4 happy_var_5 (MN "X" 0) Unknown))-	) `HappyStk` happyRest}}}--happyReduce_135 = happyReduce 6# 40# happyReduction_135-happyReduction_135 (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 happyOut34 happy_x_2 of { happy_var_2 -> -	case happyOut83 happy_x_4 of { happy_var_4 -> -	case happyOut82 happy_x_5 of { happy_var_5 -> -	happyIn46-		 (RBind (MN "X" 0) (Lam RPlaceholder) -                       (RBind (MN "X" 1) (Pi Ex [] happy_var_2) (RVar happy_var_4 happy_var_5 (MN "X" 0) Unknown))-	) `HappyStk` happyRest}}}--happyReduce_136 = happyReduce 6# 40# happyReduction_136-happyReduction_136 (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 happyOut34 happy_x_3 of { happy_var_3 -> -	case happyOut83 happy_x_4 of { happy_var_4 -> -	case happyOut82 happy_x_5 of { happy_var_5 -> -	happyIn46-		 (RBind (MN "X" 0) (Lam RPlaceholder) -                       (RBind (MN "X" 1) (Pi Ex [] (RVar happy_var_4 happy_var_5 (MN "X" 0) Unknown)) happy_var_3)-	) `HappyStk` happyRest}}}--happyReduce_137 = happyReduce 5# 40# happyReduction_137-happyReduction_137 (happy_x_5 `HappyStk`-	happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOut83 happy_x_3 of { happy_var_3 -> -	case happyOut82 happy_x_4 of { happy_var_4 -> -	happyIn46-		 (RBind (MN "X" 0) (Lam RPlaceholder)-                       (RBind (MN "X" 1) (Lam RPlaceholder)-                    (RBind (MN "X" 2) (Pi Ex [] (RVar happy_var_3 happy_var_4 (MN "X" 0) Unknown))-                       (RVar happy_var_3 happy_var_4 (MN "X" 1) Unknown)))-	) `HappyStk` happyRest}}--happyReduce_138 = happyReduce 5# 40# happyReduction_138-happyReduction_138 (happy_x_5 `HappyStk`-	happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOut83 happy_x_3 of { happy_var_3 -> -	case happyOut82 happy_x_4 of { happy_var_4 -> -	happyIn46-		 (RBind (MN "X" 0) (Lam RPlaceholder)-                   (RBind (MN "X" 1) (Lam RPlaceholder)-                       (pairDesugar happy_var_3 happy_var_4 (RVar happy_var_3 happy_var_4 (UN "mkPair") DataCon)-                                    [RVar happy_var_3 happy_var_4 (MN "X" 0) Unknown,-                                     RVar happy_var_3 happy_var_4 (MN "X" 1) Unknown]))-	) `HappyStk` happyRest}}--happyReduce_139 = happyReduce 6# 40# happyReduction_139-happyReduction_139 (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 happyOut34 happy_x_2 of { happy_var_2 -> -	case happyOut83 happy_x_4 of { happy_var_4 -> -	case happyOut82 happy_x_5 of { happy_var_5 -> -	happyIn46-		 (RBind (MN "X" 0) (Lam RPlaceholder)-                       (pairDesugar happy_var_4 happy_var_5 (RVar happy_var_4 happy_var_5 (UN "mkPair") DataCon)-                                    [happy_var_2,-                                     RVar happy_var_4 happy_var_5 (MN "X" 0) Unknown])-	) `HappyStk` happyRest}}}--happyReduce_140 = happyReduce 6# 40# happyReduction_140-happyReduction_140 (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 happyOut34 happy_x_3 of { happy_var_3 -> -	case happyOut83 happy_x_4 of { happy_var_4 -> -	case happyOut82 happy_x_5 of { happy_var_5 -> -	happyIn46-		 (RBind (MN "X" 0) (Lam RPlaceholder)-                       (pairDesugar happy_var_4 happy_var_5 (RVar happy_var_4 happy_var_5 (UN "mkPair") DataCon)-                                    [RVar happy_var_4 happy_var_5 (MN "X" 0) Unknown, happy_var_3])-	) `HappyStk` happyRest}}}--happyReduce_141 = happySpecReduce_1  41# happyReduction_141-happyReduction_141 happy_x_1-	 =  happyIn47-		 ("<"-	)--happyReduce_142 = happySpecReduce_1  41# happyReduction_142-happyReduction_142 happy_x_1-	 =  happyIn47-		 (">"-	)--happyReduce_143 = happySpecReduce_0  42# happyReduction_143-happyReduction_143  =  happyIn48-		 (RPlaceholder-	)--happyReduce_144 = happySpecReduce_2  42# happyReduction_144-happyReduction_144 happy_x_2-	happy_x_1-	 =  case happyOut51 happy_x_2 of { happy_var_2 -> -	happyIn48-		 (happy_var_2-	)}--happyReduce_145 = happySpecReduce_0  43# happyReduction_145-happyReduction_145  =  happyIn49-		 (RPlaceholder-	)--happyReduce_146 = happySpecReduce_2  43# happyReduction_146-happyReduction_146 happy_x_2-	happy_x_1-	 =  case happyOut51 happy_x_2 of { happy_var_2 -> -	happyIn49-		 (happy_var_2-	)}--happyReduce_147 = happyReduce 5# 44# happyReduction_147-happyReduction_147 (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_1 of { happy_var_1 -> -	case happyOut49 happy_x_2 of { happy_var_2 -> -	case happyOut50 happy_x_5 of { happy_var_5 -> -	happyIn50-		 (doBind (Pi Im []) (map (\x -> (x, happy_var_2)) happy_var_1) happy_var_5-	) `HappyStk` happyRest}}}--happyReduce_148 = happySpecReduce_1  44# happyReduction_148-happyReduction_148 happy_x_1-	 =  case happyOut51 happy_x_1 of { happy_var_1 -> -	happyIn50-		 (happy_var_1-	)}--happyReduce_149 = happySpecReduce_3  45# happyReduction_149-happyReduction_149 happy_x_3-	happy_x_2-	happy_x_1-	 =  case happyOut51 happy_x_1 of { happy_var_1 -> -	case happyOut51 happy_x_3 of { happy_var_3 -> -	happyIn51-		 (RBind (MN "X" 0) (Pi Ex [] happy_var_1) happy_var_3-	)}}--happyReduce_150 = happyReduce 6# 45# happyReduction_150-happyReduction_150 (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 happyOut36 happy_x_2 of { happy_var_2 -> -	case happyOut53 happy_x_4 of { happy_var_4 -> -	case happyOut51 happy_x_6 of { happy_var_6 -> -	happyIn51-		 (doBind (Pi Ex happy_var_4) happy_var_2 happy_var_6-	) `HappyStk` happyRest}}}--happyReduce_151 = happyReduce 5# 45# happyReduction_151-happyReduction_151 (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_2 of { happy_var_2 -> -	case happyOut51 happy_x_5 of { happy_var_5 -> -	happyIn51-		 (doBind (Pi Ex [Lazy]) happy_var_2 happy_var_5-	) `HappyStk` happyRest}}--happyReduce_152 = happySpecReduce_3  45# happyReduction_152-happyReduction_152 happy_x_3-	happy_x_2-	happy_x_1-	 =  case happyOut51 happy_x_2 of { happy_var_2 -> -	happyIn51-		 (bracket happy_var_2-	)}--happyReduce_153 = happyReduce 7# 45# happyReduction_153-happyReduction_153 (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 happyOut51 happy_x_2 of { happy_var_2 -> -	case happyOut51 happy_x_4 of { happy_var_4 -> -	case happyOut83 happy_x_5 of { happy_var_5 -> -	case happyOut82 happy_x_6 of { happy_var_6 -> -	happyIn51-		 (RInfix happy_var_5 happy_var_6 JMEq happy_var_2 happy_var_4-	) `HappyStk` happyRest}}}}--happyReduce_154 = happySpecReduce_1  45# happyReduction_154-happyReduction_154 happy_x_1-	 =  case happyOut33 happy_x_1 of { happy_var_1 -> -	happyIn51-		 (happy_var_1-	)}--happyReduce_155 = happySpecReduce_3  45# happyReduction_155-happyReduction_155 happy_x_3-	happy_x_2-	happy_x_1-	 =  case happyOut34 happy_x_2 of { happy_var_2 -> -	happyIn51-		 (happy_var_2-	)}--happyReduce_156 = happyReduce 5# 45# happyReduction_156-happyReduction_156 (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_1 of { happy_var_1 -> -	case happyOutTok happy_x_2 of { (TokenInfixName happy_var_2) -> -	case happyOut51 happy_x_3 of { happy_var_3 -> -	case happyOut83 happy_x_4 of { happy_var_4 -> -	case happyOut82 happy_x_5 of { happy_var_5 -> -	happyIn51-		 (RUserInfix happy_var_4 happy_var_5 False happy_var_2 happy_var_1 happy_var_3-	) `HappyStk` happyRest}}}}}--happyReduce_157 = happyReduce 5# 45# happyReduction_157-happyReduction_157 (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_1 of { happy_var_1 -> -	case happyOut51 happy_x_3 of { happy_var_3 -> -	case happyOut83 happy_x_4 of { happy_var_4 -> -	case happyOut82 happy_x_5 of { happy_var_5 -> -	happyIn51-		 (RUserInfix happy_var_4 happy_var_5 False "-" happy_var_1 happy_var_3-	) `HappyStk` happyRest}}}}--happyReduce_158 = happyReduce 5# 45# happyReduction_158-happyReduction_158 (happy_x_5 `HappyStk`-	happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOut56 happy_x_2 of { happy_var_2 -> -	case happyOut83 happy_x_4 of { happy_var_4 -> -	case happyOut82 happy_x_5 of { happy_var_5 -> -	happyIn51-		 (pairDesugar happy_var_4 happy_var_5 (RVar happy_var_4 happy_var_5 (UN "Pair") TypeCon) happy_var_2-	) `HappyStk` happyRest}}}--happyReduce_159 = happySpecReduce_1  45# happyReduction_159-happyReduction_159 happy_x_1-	 =  case happyOut55 happy_x_1 of { happy_var_1 -> -	happyIn51-		 (happy_var_1-	)}--happyReduce_160 = happySpecReduce_1  46# happyReduction_160-happyReduction_160 happy_x_1-	 =  happyIn52-		 (Lazy-	)--happyReduce_161 = happySpecReduce_1  46# happyReduction_161-happyReduction_161 happy_x_1-	 =  happyIn52-		 (Static-	)--happyReduce_162 = happySpecReduce_3  47# happyReduction_162-happyReduction_162 happy_x_3-	happy_x_2-	happy_x_1-	 =  case happyOut54 happy_x_2 of { happy_var_2 -> -	happyIn53-		 (happy_var_2-	)}--happyReduce_163 = happySpecReduce_0  47# happyReduction_163-happyReduction_163  =  happyIn53-		 ([]-	)--happyReduce_164 = happySpecReduce_3  48# happyReduction_164-happyReduction_164 happy_x_3-	happy_x_2-	happy_x_1-	 =  case happyOut52 happy_x_1 of { happy_var_1 -> -	case happyOut54 happy_x_3 of { happy_var_3 -> -	happyIn54-		 (happy_var_1:happy_var_3-	)}}--happyReduce_165 = happySpecReduce_1  48# happyReduction_165-happyReduction_165 happy_x_1-	 =  case happyOut52 happy_x_1 of { happy_var_1 -> -	happyIn54-		 ([happy_var_1]-	)}--happyReduce_166 = happyReduce 8# 49# happyReduction_166-happyReduction_166 (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 happyOut32 happy_x_2 of { happy_var_2 -> -	case happyOut48 happy_x_3 of { happy_var_3 -> -	case happyOut51 happy_x_5 of { happy_var_5 -> -	case happyOut83 happy_x_7 of { happy_var_7 -> -	case happyOut82 happy_x_8 of { happy_var_8 -> -	happyIn55-		 (sigDesugar happy_var_7 happy_var_8 (happy_var_2, happy_var_3) happy_var_5-	) `HappyStk` happyRest}}}}}--happyReduce_167 = happySpecReduce_3  50# happyReduction_167-happyReduction_167 happy_x_3-	happy_x_2-	happy_x_1-	 =  case happyOut51 happy_x_1 of { happy_var_1 -> -	case happyOut51 happy_x_3 of { happy_var_3 -> -	happyIn56-		 (happy_var_1:happy_var_3:[]-	)}}--happyReduce_168 = happySpecReduce_3  50# happyReduction_168-happyReduction_168 happy_x_3-	happy_x_2-	happy_x_1-	 =  case happyOut51 happy_x_1 of { happy_var_1 -> -	case happyOut56 happy_x_3 of { happy_var_3 -> -	happyIn56-		 (happy_var_1:happy_var_3-	)}}--happyReduce_169 = happySpecReduce_3  51# happyReduction_169-happyReduction_169 happy_x_3-	happy_x_2-	happy_x_1-	 =  case happyOut32 happy_x_1 of { happy_var_1 -> -	case happyOut83 happy_x_2 of { happy_var_2 -> -	case happyOut82 happy_x_3 of { happy_var_3 -> -	happyIn57-		 (RVar happy_var_2 happy_var_3 happy_var_1 Unknown-	)}}}--happyReduce_170 = happySpecReduce_3  51# happyReduction_170-happyReduction_170 happy_x_3-	happy_x_2-	happy_x_1-	 =  case happyOut83 happy_x_2 of { happy_var_2 -> -	case happyOut82 happy_x_3 of { happy_var_3 -> -	happyIn57-		 (RReturn happy_var_2 happy_var_3-	)}}--happyReduce_171 = happySpecReduce_3  51# happyReduction_171-happyReduction_171 happy_x_3-	happy_x_2-	happy_x_1-	 =  case happyOut34 happy_x_2 of { happy_var_2 -> -	happyIn57-		 (bracket happy_var_2-	)}--happyReduce_172 = happySpecReduce_2  51# happyReduction_172-happyReduction_172 happy_x_2-	happy_x_1-	 =  case happyOut57 happy_x_2 of { happy_var_2 -> -	happyIn57-		 (RPure happy_var_2-	)}--happyReduce_173 = happySpecReduce_1  51# happyReduction_173-happyReduction_173 happy_x_1-	 =  case happyOutTok happy_x_1 of { (TokenMetavar happy_var_1) -> -	happyIn57-		 (RMetavar happy_var_1-	)}--happyReduce_174 = happyReduce 4# 51# happyReduction_174-happyReduction_174 (happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOut80 happy_x_3 of { happy_var_3 -> -	happyIn57-		 (RMetavarPrf (UN "") happy_var_3 False-	) `HappyStk` happyRest}--happyReduce_175 = happyReduce 4# 51# happyReduction_175-happyReduction_175 (happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOut80 happy_x_3 of { happy_var_3 -> -	happyIn57-		 (RMetavarPrf (UN "") happy_var_3 True-	) `HappyStk` happyRest}--happyReduce_176 = happyReduce 4# 51# happyReduction_176-happyReduction_176 (happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOut32 happy_x_2 of { happy_var_2 -> -	case happyOut83 happy_x_3 of { happy_var_3 -> -	case happyOut82 happy_x_4 of { happy_var_4 -> -	happyIn57-		 (RExpVar happy_var_3 happy_var_4 happy_var_2-	) `HappyStk` happyRest}}}--happyReduce_177 = happySpecReduce_3  51# happyReduction_177-happyReduction_177 happy_x_3-	happy_x_2-	happy_x_1-	 =  case happyOut64 happy_x_1 of { happy_var_1 -> -	case happyOut83 happy_x_2 of { happy_var_2 -> -	case happyOut82 happy_x_3 of { happy_var_3 -> -	happyIn57-		 (RConst happy_var_2 happy_var_3 happy_var_1-	)}}}--happyReduce_178 = happySpecReduce_1  51# happyReduction_178-happyReduction_178 happy_x_1-	 =  happyIn57-		 (RRefl-	)--happyReduce_179 = happySpecReduce_3  51# happyReduction_179-happyReduction_179 happy_x_3-	happy_x_2-	happy_x_1-	 =  case happyOut83 happy_x_2 of { happy_var_2 -> -	case happyOut82 happy_x_3 of { happy_var_3 -> -	happyIn57-		 (RVar happy_var_2 happy_var_3 (UN "__Empty") TypeCon-	)}}--happyReduce_180 = happySpecReduce_3  51# happyReduction_180-happyReduction_180 happy_x_3-	happy_x_2-	happy_x_1-	 =  case happyOut83 happy_x_2 of { happy_var_2 -> -	case happyOut82 happy_x_3 of { happy_var_3 -> -	happyIn57-		 (RVar happy_var_2 happy_var_3 (UN "__Unit") TypeCon-	)}}--happyReduce_181 = happySpecReduce_1  51# happyReduction_181-happyReduction_181 happy_x_1-	 =  happyIn57-		 (RPlaceholder-	)--happyReduce_182 = happySpecReduce_1  51# happyReduction_182-happyReduction_182 happy_x_1-	 =  case happyOut61 happy_x_1 of { happy_var_1 -> -	happyIn57-		 (RDo happy_var_1-	)}--happyReduce_183 = happySpecReduce_3  51# happyReduction_183-happyReduction_183 happy_x_3-	happy_x_2-	happy_x_1-	 =  case happyOut34 happy_x_2 of { happy_var_2 -> -	happyIn57-		 (RIdiom happy_var_2-	)}--happyReduce_184 = happyReduce 5# 51# 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 happyOut59 happy_x_2 of { happy_var_2 -> -	case happyOut83 happy_x_4 of { happy_var_4 -> -	case happyOut82 happy_x_5 of { happy_var_5 -> -	happyIn57-		 (pairDesugar happy_var_4 happy_var_5 (RVar happy_var_4 happy_var_5 (UN "mkPair") DataCon) happy_var_2-	) `HappyStk` happyRest}}}--happyReduce_185 = happySpecReduce_1  51# happyReduction_185-happyReduction_185 happy_x_1-	 =  case happyOut55 happy_x_1 of { happy_var_1 -> -	happyIn57-		 (happy_var_1-	)}--happyReduce_186 = happySpecReduce_1  51# happyReduction_186-happyReduction_186 happy_x_1-	 =  case happyOut46 happy_x_1 of { happy_var_1 -> -	happyIn57-		 (happy_var_1-	)}--happyReduce_187 = happySpecReduce_1  51# happyReduction_187-happyReduction_187 happy_x_1-	 =  case happyOut58 happy_x_1 of { happy_var_1 -> -	happyIn57-		 (happy_var_1-	)}--happyReduce_188 = happyReduce 5# 51# happyReduction_188-happyReduction_188 (happy_x_5 `HappyStk`-	happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOut83 happy_x_2 of { happy_var_2 -> -	case happyOut82 happy_x_3 of { happy_var_3 -> -	case happyOut60 happy_x_4 of { happy_var_4 -> -	happyIn57-		 (mkConsList happy_var_2 happy_var_3 happy_var_4-	) `HappyStk` happyRest}}}--happyReduce_189 = happyReduce 7# 52# happyReduction_189-happyReduction_189 (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 happyOut34 happy_x_2 of { happy_var_2 -> -	case happyOut34 happy_x_4 of { happy_var_4 -> -	case happyOut83 happy_x_6 of { happy_var_6 -> -	case happyOut82 happy_x_7 of { happy_var_7 -> -	happyIn58-		 (RApp happy_var_6 happy_var_7 (RApp happy_var_6 happy_var_7 (RVar happy_var_6 happy_var_7 (UN "Exists") DataCon) happy_var_2) happy_var_4-	) `HappyStk` happyRest}}}}--happyReduce_190 = happyReduce 5# 52# happyReduction_190-happyReduction_190 (happy_x_5 `HappyStk`-	happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOut34 happy_x_2 of { happy_var_2 -> -	case happyOut83 happy_x_4 of { happy_var_4 -> -	case happyOut82 happy_x_5 of { happy_var_5 -> -	happyIn58-		 (RApp happy_var_4 happy_var_5 (RApp happy_var_4 happy_var_5 (RVar happy_var_4 happy_var_5 (UN "Exists") DataCon) RPlaceholder) happy_var_2-	) `HappyStk` happyRest}}}--happyReduce_191 = happySpecReduce_3  53# happyReduction_191-happyReduction_191 happy_x_3-	happy_x_2-	happy_x_1-	 =  case happyOut34 happy_x_1 of { happy_var_1 -> -	case happyOut34 happy_x_3 of { happy_var_3 -> -	happyIn59-		 (happy_var_1:happy_var_3:[]-	)}}--happyReduce_192 = happySpecReduce_3  53# happyReduction_192-happyReduction_192 happy_x_3-	happy_x_2-	happy_x_1-	 =  case happyOut34 happy_x_1 of { happy_var_1 -> -	case happyOut59 happy_x_3 of { happy_var_3 -> -	happyIn59-		 (happy_var_1:happy_var_3-	)}}--happyReduce_193 = happySpecReduce_0  54# happyReduction_193-happyReduction_193  =  happyIn60-		 ([]-	)--happyReduce_194 = happySpecReduce_1  54# happyReduction_194-happyReduction_194 happy_x_1-	 =  case happyOut34 happy_x_1 of { happy_var_1 -> -	happyIn60-		 ([happy_var_1]-	)}--happyReduce_195 = happySpecReduce_3  54# happyReduction_195-happyReduction_195 happy_x_3-	happy_x_2-	happy_x_1-	 =  case happyOut34 happy_x_1 of { happy_var_1 -> -	case happyOut60 happy_x_3 of { happy_var_3 -> -	happyIn60-		 (happy_var_1:happy_var_3-	)}}--happyReduce_196 = happyReduce 4# 55# happyReduction_196-happyReduction_196 (happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOut62 happy_x_3 of { happy_var_3 -> -	happyIn61-		 (happy_var_3-	) `HappyStk` happyRest}--happyReduce_197 = happyReduce 10# 55# happyReduction_197-happyReduction_197 (happy_x_10 `HappyStk`-	happy_x_9 `HappyStk`-	happy_x_8 `HappyStk`-	happy_x_7 `HappyStk`-	happy_x_6 `HappyStk`-	happy_x_5 `HappyStk`-	happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOutTok happy_x_2 of { (TokenBrackName happy_var_2) -> -	case happyOut48 happy_x_3 of { happy_var_3 -> -	case happyOut34 happy_x_5 of { happy_var_5 -> -	case happyOut83 happy_x_6 of { happy_var_6 -> -	case happyOut82 happy_x_7 of { happy_var_7 -> -	case happyOut62 happy_x_9 of { happy_var_9 -> -	happyIn61-		 (DoBinding happy_var_6 happy_var_7 happy_var_2 happy_var_3 happy_var_5 : happy_var_9-	) `HappyStk` happyRest}}}}}}--happyReduce_198 = happySpecReduce_2  56# happyReduction_198-happyReduction_198 happy_x_2-	happy_x_1-	 =  case happyOut63 happy_x_1 of { happy_var_1 -> -	case happyOut62 happy_x_2 of { happy_var_2 -> -	happyIn62-		 (happy_var_1:happy_var_2-	)}}--happyReduce_199 = happySpecReduce_1  56# happyReduction_199-happyReduction_199 happy_x_1-	 =  case happyOut63 happy_x_1 of { happy_var_1 -> -	happyIn62-		 ([happy_var_1]-	)}--happyReduce_200 = happyReduce 7# 57# happyReduction_200-happyReduction_200 (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 happyOut32 happy_x_1 of { happy_var_1 -> -	case happyOut48 happy_x_2 of { happy_var_2 -> -	case happyOut34 happy_x_4 of { happy_var_4 -> -	case happyOut83 happy_x_5 of { happy_var_5 -> -	case happyOut82 happy_x_6 of { happy_var_6 -> -	happyIn63-		 (DoBinding happy_var_5 happy_var_6 happy_var_1 happy_var_2 happy_var_4-	) `HappyStk` happyRest}}}}}--happyReduce_201 = happyReduce 8# 57# happyReduction_201-happyReduction_201 (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 happyOut32 happy_x_2 of { happy_var_2 -> -	case happyOut48 happy_x_3 of { happy_var_3 -> -	case happyOut34 happy_x_5 of { happy_var_5 -> -	case happyOut83 happy_x_6 of { happy_var_6 -> -	case happyOut82 happy_x_7 of { happy_var_7 -> -	happyIn63-		 (DoLet happy_var_6 happy_var_7 happy_var_2 happy_var_3 happy_var_5-	) `HappyStk` happyRest}}}}}--happyReduce_202 = happyReduce 4# 57# happyReduction_202-happyReduction_202 (happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOut34 happy_x_1 of { happy_var_1 -> -	case happyOut83 happy_x_2 of { happy_var_2 -> -	case happyOut82 happy_x_3 of { happy_var_3 -> -	happyIn63-		 (DoExp happy_var_2 happy_var_3 happy_var_1-	) `HappyStk` happyRest}}}--happyReduce_203 = happySpecReduce_1  58# happyReduction_203-happyReduction_203 happy_x_1-	 =  happyIn64-		 (TYPE-	)--happyReduce_204 = happySpecReduce_1  58# happyReduction_204-happyReduction_204 happy_x_1-	 =  happyIn64-		 (LTYPE-	)--happyReduce_205 = happySpecReduce_1  58# happyReduction_205-happyReduction_205 happy_x_1-	 =  happyIn64-		 (StringType-	)--happyReduce_206 = happySpecReduce_1  58# happyReduction_206-happyReduction_206 happy_x_1-	 =  happyIn64-		 (IntType-	)--happyReduce_207 = happySpecReduce_1  58# happyReduction_207-happyReduction_207 happy_x_1-	 =  happyIn64-		 (CharType-	)--happyReduce_208 = happySpecReduce_1  58# happyReduction_208-happyReduction_208 happy_x_1-	 =  happyIn64-		 (FloatType-	)--happyReduce_209 = happySpecReduce_1  58# happyReduction_209-happyReduction_209 happy_x_1-	 =  happyIn64-		 (PtrType-	)--happyReduce_210 = happySpecReduce_1  58# happyReduction_210-happyReduction_210 happy_x_1-	 =  happyIn64-		 (Builtin "Handle"-	)--happyReduce_211 = happySpecReduce_1  58# happyReduction_211-happyReduction_211 happy_x_1-	 =  happyIn64-		 (Builtin "Lock"-	)--happyReduce_212 = happySpecReduce_1  58# happyReduction_212-happyReduction_212 happy_x_1-	 =  case happyOutTok happy_x_1 of { (TokenInt happy_var_1) -> -	happyIn64-		 (Num happy_var_1-	)}--happyReduce_213 = happySpecReduce_1  58# happyReduction_213-happyReduction_213 happy_x_1-	 =  case happyOutTok happy_x_1 of { (TokenChar happy_var_1) -> -	happyIn64-		 (Ch happy_var_1-	)}--happyReduce_214 = happySpecReduce_1  58# happyReduction_214-happyReduction_214 happy_x_1-	 =  case happyOutTok happy_x_1 of { (TokenString happy_var_1) -> -	happyIn64-		 (Str happy_var_1-	)}--happyReduce_215 = happySpecReduce_1  58# happyReduction_215-happyReduction_215 happy_x_1-	 =  case happyOutTok happy_x_1 of { (TokenBool happy_var_1) -> -	happyIn64-		 (Bo happy_var_1-	)}--happyReduce_216 = happySpecReduce_1  58# happyReduction_216-happyReduction_216 happy_x_1-	 =  case happyOutTok happy_x_1 of { (TokenFloat happy_var_1) -> -	happyIn64-		 (Fl happy_var_1-	)}--happyReduce_217 = happySpecReduce_0  59# happyReduction_217-happyReduction_217  =  happyIn65-		 ([]-	)--happyReduce_218 = happySpecReduce_2  59# happyReduction_218-happyReduction_218 happy_x_2-	happy_x_1-	 =  case happyOut57 happy_x_1 of { happy_var_1 -> -	case happyOut65 happy_x_2 of { happy_var_2 -> -	happyIn65-		 (happy_var_1:happy_var_2-	)}}--happyReduce_219 = happyReduce 4# 60# happyReduction_219-happyReduction_219 (happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOut50 happy_x_2 of { happy_var_2 -> -	case happyOut67 happy_x_3 of { happy_var_3 -> -	happyIn66-		 ((happy_var_2, happy_var_3)-	) `HappyStk` happyRest}}--happyReduce_220 = happySpecReduce_3  60# happyReduction_220-happyReduction_220 happy_x_3-	happy_x_2-	happy_x_1-	 =  case happyOut83 happy_x_2 of { happy_var_2 -> -	case happyOut82 happy_x_3 of { happy_var_3 -> -	happyIn66-		 ((RConst happy_var_2 happy_var_3 TYPE, [])-	)}}--happyReduce_221 = happyReduce 4# 60# happyReduction_221-happyReduction_221 (happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOut73 happy_x_1 of { happy_var_1 -> -	case happyOut83 happy_x_3 of { happy_var_3 -> -	case happyOut82 happy_x_4 of { happy_var_4 -> -	happyIn66-		 ((mkTyParams happy_var_3 happy_var_4 happy_var_1, [])-	) `HappyStk` happyRest}}}--happyReduce_222 = happySpecReduce_0  61# happyReduction_222-happyReduction_222  =  happyIn67-		 ([]-	)--happyReduce_223 = happyReduce 4# 61# happyReduction_223-happyReduction_223 (happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOut72 happy_x_3 of { happy_var_3 -> -	happyIn67-		 (happy_var_3-	) `HappyStk` happyRest}--happyReduce_224 = happyReduce 7# 62# happyReduction_224-happyReduction_224 (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 happyOut32 happy_x_4 of { happy_var_4 -> -	case happyOut32 happy_x_6 of { happy_var_6 -> -	happyIn68-		 ((happy_var_4,happy_var_6)-	) `HappyStk` happyRest}}--happyReduce_225 = happyReduce 6# 63# happyReduction_225-happyReduction_225 (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 happyOut32 happy_x_3 of { happy_var_3 -> -	case happyOut32 happy_x_5 of { happy_var_5 -> -	happyIn69-		 ((happy_var_3,happy_var_5)-	) `HappyStk` happyRest}}--happyReduce_226 = happyReduce 4# 64# happyReduction_226-happyReduction_226 (happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOut72 happy_x_3 of { happy_var_3 -> -	happyIn70-		 (happy_var_3-	) `HappyStk` happyRest}--happyReduce_227 = happySpecReduce_2  65# happyReduction_227-happyReduction_227 happy_x_2-	happy_x_1-	 =  case happyOut32 happy_x_2 of { happy_var_2 -> -	happyIn71-		 (happy_var_2-	)}--happyReduce_228 = happySpecReduce_3  66# happyReduction_228-happyReduction_228 happy_x_3-	happy_x_2-	happy_x_1-	 =  case happyOut32 happy_x_1 of { happy_var_1 -> -	case happyOut50 happy_x_3 of { happy_var_3 -> -	happyIn72-		 ([(happy_var_1, happy_var_3)]-	)}}--happyReduce_229 = happyReduce 5# 66# happyReduction_229-happyReduction_229 (happy_x_5 `HappyStk`-	happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOut32 happy_x_1 of { happy_var_1 -> -	case happyOut50 happy_x_3 of { happy_var_3 -> -	case happyOut72 happy_x_5 of { happy_var_5 -> -	happyIn72-		 ((happy_var_1,happy_var_3):happy_var_5-	) `HappyStk` happyRest}}}--happyReduce_230 = happySpecReduce_1  67# happyReduction_230-happyReduction_230 happy_x_1-	 =  case happyOut32 happy_x_1 of { happy_var_1 -> -	happyIn73-		 ([happy_var_1]-	)}--happyReduce_231 = happySpecReduce_2  67# happyReduction_231-happyReduction_231 happy_x_2-	happy_x_1-	 =  case happyOut32 happy_x_1 of { happy_var_1 -> -	case happyOut73 happy_x_2 of { happy_var_2 -> -	happyIn73-		 (happy_var_1:happy_var_2-	)}}--happyReduce_232 = happySpecReduce_1  68# happyReduction_232-happyReduction_232 happy_x_1-	 =  case happyOutTok happy_x_1 of { happy_var_1 -> -	happyIn74-		 (happy_var_1-	)}--happyReduce_233 = happySpecReduce_1  68# happyReduction_233-happyReduction_233 happy_x_1-	 =  case happyOutTok happy_x_1 of { happy_var_1 -> -	happyIn74-		 (happy_var_1-	)}--happyReduce_234 = happySpecReduce_0  69# happyReduction_234-happyReduction_234  =  happyIn75-		 ([]-	)--happyReduce_235 = happySpecReduce_1  69# happyReduction_235-happyReduction_235 happy_x_1-	 =  case happyOut76 happy_x_1 of { happy_var_1 -> -	happyIn75-		 ([happy_var_1]-	)}--happyReduce_236 = happySpecReduce_3  69# happyReduction_236-happyReduction_236 happy_x_3-	happy_x_2-	happy_x_1-	 =  case happyOut76 happy_x_1 of { happy_var_1 -> -	case happyOut75 happy_x_3 of { happy_var_3 -> -	happyIn75-		 (happy_var_1:happy_var_3-	)}}--happyReduce_237 = happySpecReduce_2  70# happyReduction_237-happyReduction_237 happy_x_2-	happy_x_1-	 =  case happyOut32 happy_x_1 of { happy_var_1 -> -	case happyOut77 happy_x_2 of { happy_var_2 -> -	happyIn76-		 (Full happy_var_1 happy_var_2-	)}}--happyReduce_238 = happySpecReduce_2  70# happyReduction_238-happyReduction_238 happy_x_2-	happy_x_1-	 =  case happyOut32 happy_x_1 of { happy_var_1 -> -	case happyOut65 happy_x_2 of { happy_var_2 -> -	happyIn76-		 (Simple happy_var_1 happy_var_2-	)}}--happyReduce_239 = happySpecReduce_2  71# happyReduction_239-happyReduction_239 happy_x_2-	happy_x_1-	 =  case happyOut50 happy_x_2 of { happy_var_2 -> -	happyIn77-		 (happy_var_2-	)}--happyReduce_240 = happySpecReduce_2  72# happyReduction_240-happyReduction_240 happy_x_2-	happy_x_1-	 =  case happyOut38 happy_x_2 of { happy_var_2 -> -	happyIn78-		 (Intro happy_var_2-	)}--happyReduce_241 = happySpecReduce_1  72# happyReduction_241-happyReduction_241 happy_x_1-	 =  happyIn78-		 (Intro []-	)--happyReduce_242 = happySpecReduce_2  72# happyReduction_242-happyReduction_242 happy_x_2-	happy_x_1-	 =  case happyOut32 happy_x_2 of { happy_var_2 -> -	happyIn78-		 (Refine happy_var_2-	)}--happyReduce_243 = happySpecReduce_2  72# happyReduction_243-happyReduction_243 happy_x_2-	happy_x_1-	 =  case happyOut34 happy_x_2 of { happy_var_2 -> -	happyIn78-		 (Exists happy_var_2-	)}--happyReduce_244 = happySpecReduce_2  72# happyReduction_244-happyReduction_244 happy_x_2-	happy_x_1-	 =  case happyOut34 happy_x_2 of { happy_var_2 -> -	happyIn78-		 (Generalise happy_var_2-	)}--happyReduce_245 = happySpecReduce_1  72# happyReduction_245-happyReduction_245 happy_x_1-	 =  happyIn78-		 (ReflP-	)--happyReduce_246 = happySpecReduce_2  72# happyReduction_246-happyReduction_246 happy_x_2-	happy_x_1-	 =  case happyOut34 happy_x_2 of { happy_var_2 -> -	happyIn78-		 (Rewrite False False happy_var_2-	)}--happyReduce_247 = happySpecReduce_3  72# happyReduction_247-happyReduction_247 happy_x_3-	happy_x_2-	happy_x_1-	 =  case happyOut34 happy_x_3 of { happy_var_3 -> -	happyIn78-		 (Rewrite False True happy_var_3-	)}--happyReduce_248 = happySpecReduce_2  72# happyReduction_248-happyReduction_248 happy_x_2-	happy_x_1-	 =  case happyOut34 happy_x_2 of { happy_var_2 -> -	happyIn78-		 (Rewrite True False happy_var_2-	)}--happyReduce_249 = happySpecReduce_3  72# happyReduction_249-happyReduction_249 happy_x_3-	happy_x_2-	happy_x_1-	 =  case happyOut34 happy_x_3 of { happy_var_3 -> -	happyIn78-		 (Rewrite True True happy_var_3-	)}--happyReduce_250 = happySpecReduce_1  72# happyReduction_250-happyReduction_250 happy_x_1-	 =  happyIn78-		 (Compute-	)--happyReduce_251 = happySpecReduce_2  72# happyReduction_251-happyReduction_251 happy_x_2-	happy_x_1-	 =  case happyOut32 happy_x_2 of { happy_var_2 -> -	happyIn78-		 (Unfold happy_var_2-	)}--happyReduce_252 = happySpecReduce_1  72# happyReduction_252-happyReduction_252 happy_x_1-	 =  happyIn78-		 (Undo-	)--happyReduce_253 = happySpecReduce_2  72# happyReduction_253-happyReduction_253 happy_x_2-	happy_x_1-	 =  case happyOut34 happy_x_2 of { happy_var_2 -> -	happyIn78-		 (Induction happy_var_2-	)}--happyReduce_254 = happySpecReduce_2  72# happyReduction_254-happyReduction_254 happy_x_2-	happy_x_1-	 =  case happyOut34 happy_x_2 of { happy_var_2 -> -	happyIn78-		 (Fill happy_var_2-	)}--happyReduce_255 = happySpecReduce_1  72# happyReduction_255-happyReduction_255 happy_x_1-	 =  happyIn78-		 (Trivial-	)--happyReduce_256 = happySpecReduce_1  72# happyReduction_256-happyReduction_256 happy_x_1-	 =  happyIn78-		 (SimpleSearch-	)--happyReduce_257 = happySpecReduce_2  72# happyReduction_257-happyReduction_257 happy_x_2-	happy_x_1-	 =  case happyOut34 happy_x_2 of { happy_var_2 -> -	happyIn78-		 (RunTactic happy_var_2-	)}--happyReduce_258 = happySpecReduce_2  72# happyReduction_258-happyReduction_258 happy_x_2-	happy_x_1-	 =  case happyOut34 happy_x_2 of { happy_var_2 -> -	happyIn78-		 (Believe happy_var_2-	)}--happyReduce_259 = happySpecReduce_2  72# happyReduction_259-happyReduction_259 happy_x_2-	happy_x_1-	 =  case happyOut34 happy_x_2 of { happy_var_2 -> -	happyIn78-		 (Use happy_var_2-	)}--happyReduce_260 = happySpecReduce_2  72# happyReduction_260-happyReduction_260 happy_x_2-	happy_x_1-	 =  case happyOut34 happy_x_2 of { happy_var_2 -> -	happyIn78-		 (Decide happy_var_2-	)}--happyReduce_261 = happySpecReduce_1  72# happyReduction_261-happyReduction_261 happy_x_1-	 =  happyIn78-		 (Abandon-	)--happyReduce_262 = happySpecReduce_1  72# happyReduction_262-happyReduction_262 happy_x_1-	 =  happyIn78-		 (ProofTerm-	)--happyReduce_263 = happySpecReduce_1  72# happyReduction_263-happyReduction_263 happy_x_1-	 =  happyIn78-		 (Qed-	)--happyReduce_264 = happyReduce 4# 73# happyReduction_264-happyReduction_264 (happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOut80 happy_x_3 of { happy_var_3 -> -	happyIn79-		 (happy_var_3-	) `HappyStk` happyRest}--happyReduce_265 = happySpecReduce_2  74# happyReduction_265-happyReduction_265 happy_x_2-	happy_x_1-	 =  case happyOut78 happy_x_1 of { happy_var_1 -> -	happyIn80-		 ([happy_var_1]-	)}--happyReduce_266 = happySpecReduce_1  74# happyReduction_266-happyReduction_266 happy_x_1-	 =  case happyOut78 happy_x_1 of { happy_var_1 -> -	happyIn80-		 ([happy_var_1]-	)}--happyReduce_267 = happySpecReduce_3  74# happyReduction_267-happyReduction_267 happy_x_3-	happy_x_2-	happy_x_1-	 =  case happyOut78 happy_x_1 of { happy_var_1 -> -	case happyOut80 happy_x_3 of { happy_var_3 -> -	happyIn80-		 (happy_var_1:happy_var_3-	)}}--happyReduce_268 = happySpecReduce_1  75# happyReduction_268-happyReduction_268 happy_x_1-	 =  case happyOut78 happy_x_1 of { happy_var_1 -> -	happyIn81-		 ([happy_var_1]-	)}--happyReduce_269 = happySpecReduce_3  75# happyReduction_269-happyReduction_269 happy_x_3-	happy_x_2-	happy_x_1-	 =  case happyOut78 happy_x_1 of { happy_var_1 -> -	case happyOut80 happy_x_3 of { happy_var_3 -> -	happyIn81-		 (happy_var_1:happy_var_3-	)}}--happyReduce_270 = happyMonadReduce 0# 76# happyReduction_270-happyReduction_270 (happyRest) tk-	 = happyThen (( getLineNo)-	) (\r -> happyReturn (happyIn82 r))--happyReduce_271 = happyMonadReduce 0# 77# happyReduction_271-happyReduction_271 (happyRest) tk-	 = happyThen (( getFileName)-	) (\r -> happyReturn (happyIn83 r))--happyReduce_272 = happyMonadReduce 0# 78# happyReduction_272-happyReduction_272 (happyRest) tk-	 = happyThen (( getOps)-	) (\r -> happyReturn (happyIn84 r))--happyNewToken action sts stk-	= lexer(\tk -> -	let cont i = happyDoAction i tk action sts stk in-	case tk of {-	TokenEOF -> happyDoAction 125# tk action sts stk;-	TokenName happy_dollar_dollar -> cont 1#;-	TokenInfixName happy_dollar_dollar -> cont 2#;-	TokenBrackName happy_dollar_dollar -> cont 3#;-	TokenString happy_dollar_dollar -> cont 4#;-	TokenInt happy_dollar_dollar -> cont 5#;-	TokenFloat happy_dollar_dollar -> cont 6#;-	TokenChar happy_dollar_dollar -> cont 7#;-	TokenBool happy_dollar_dollar -> cont 8#;-	TokenMetavar happy_dollar_dollar -> cont 9#;-	TokenColon -> cont 10#;-	TokenSemi -> cont 11#;-	TokenBar -> cont 12#;-	TokenStars -> cont 13#;-	TokenLambda -> cont 14#;-	TokenHashOB -> cont 15#;-	TokenOB -> cont 16#;-	TokenCB -> cont 17#;-	TokenOCB -> cont 18#;-	TokenCCB -> cont 19#;-	TokenOSB -> cont 20#;-	TokenCSB -> cont 21#;-	TokenOId -> cont 22#;-	TokenCId -> cont 23#;-	TokenLPair -> cont 24#;-	TokenRPair -> cont 25#;-	TokenExists -> cont 26#;-	TokenTilde -> cont 27#;-	TokenPlus -> cont 28#;-	TokenMinus -> cont 29#;-	TokenTimes -> cont 30#;-	TokenDivide -> cont 31#;-	TokenEquals -> cont 32#;-	TokenMightEqual -> cont 33#;-	TokenLT -> cont 34#;-	TokenGT -> cont 35#;-	TokenEllipsis -> cont 36#;-	TokenUnderscore -> cont 37#;-	TokenComma -> cont 38#;-	TokenTuple -> cont 39#;-	TokenBang -> cont 40#;-	TokenConcat -> cont 41#;-	TokenGE -> cont 42#;-	TokenLE -> cont 43#;-	TokenOr -> cont 44#;-	TokenAnd -> cont 45#;-	TokenArrow -> cont 46#;-	TokenFatArrow -> cont 47#;-	TokenTransArrow -> cont 48#;-	TokenLeftArrow -> cont 49#;-	TokenIntType -> cont 50#;-	TokenCharType -> cont 51#;-	TokenFloatType -> cont 52#;-	TokenStringType -> cont 53#;-	TokenHandleType -> cont 54#;-	TokenPtrType -> cont 55#;-	TokenLockType -> cont 56#;-	TokenType -> cont 57#;-	TokenLType -> cont 58#;-	TokenLazyBracket -> cont 59#;-	TokenDataType -> cont 60#;-	TokenCoDataType -> cont 61#;-	TokenInfix -> cont 62#;-	TokenInfixL -> cont 63#;-	TokenInfixR -> cont 64#;-	TokenUsing -> cont 65#;-	TokenIdiom -> cont 66#;-	TokenParams -> cont 67#;-	TokenNamespace -> cont 68#;-	TokenPublic -> cont 69#;-	TokenPrivate -> cont 70#;-	TokenAbstract -> cont 71#;-	TokenNoElim -> cont 72#;-	TokenCollapsible -> cont 73#;-	TokenWhere -> cont 74#;-	TokenWith -> cont 75#;-	TokenPartial -> cont 76#;-	TokenSyntax -> cont 77#;-	TokenHide -> cont 78#;-	TokenLazy -> cont 79#;-	TokenStatic -> cont 80#;-	TokenRefl -> cont 81#;-	TokenEmptyType -> cont 82#;-	TokenUnitType -> cont 83#;-	TokenInclude -> cont 84#;-	TokenExport -> cont 85#;-	TokenInline -> cont 86#;-	TokenDo -> cont 87#;-	TokenReturn -> cont 88#;-	TokenIf -> cont 89#;-	TokenThen -> cont 90#;-	TokenElse -> cont 91#;-	TokenLet -> cont 92#;-	TokenIn -> cont 93#;-	TokenProof -> cont 94#;-	TokenTryProof -> cont 95#;-	TokenIntro -> cont 96#;-	TokenRefine -> cont 97#;-	TokenGeneralise -> cont 98#;-	TokenReflP -> cont 99#;-	TokenRewrite -> cont 100#;-	TokenRewriteAll -> cont 101#;-	TokenCompute -> cont 102#;-	TokenUnfold -> cont 103#;-	TokenUndo -> cont 104#;-	TokenInduction -> cont 105#;-	TokenFill -> cont 106#;-	TokenTrivial -> cont 107#;-	TokenSimpleSearch -> cont 108#;-	TokenMkTac -> cont 109#;-	TokenBelieve -> cont 110#;-	TokenUse -> cont 111#;-	TokenDecide -> cont 112#;-	TokenAbandon -> cont 113#;-	TokenProofTerm -> cont 114#;-	TokenQED -> cont 115#;-	TokenLaTeX -> cont 116#;-	TokenNoCG -> cont 117#;-	TokenEval -> cont 118#;-	TokenSpec -> cont 119#;-	TokenFreeze -> cont 120#;-	TokenThaw -> cont 121#;-	TokenTransform -> cont 122#;-	TokenCInclude -> cont 123#;-	TokenCLib -> cont 124#;-	_ -> happyError' tk-	})--happyError_ tk = happyError' tk--happyThen :: () => P a -> (a -> P b) -> P b-happyThen = (thenP)-happyReturn :: () => a -> P a-happyReturn = (returnP)-happyThen1 = happyThen-happyReturn1 :: () => a -> P a-happyReturn1 = happyReturn-happyError' :: () => (Token) -> P a-happyError' tk = (\token -> happyError) tk--mkparse = happySomeParser where-  happySomeParser = happyThen (happyParse 0#) (\x -> happyReturn (happyOut6 x))--mkparseTerm = happySomeParser where-  happySomeParser = happyThen (happyParse 1#) (\x -> happyReturn (happyOut34 x))--mkparseTactic = happySomeParser where-  happySomeParser = happyThen (happyParse 2#) (\x -> happyReturn (happyOut78 x))--happySeq = happyDontSeq---data ConParse = Full Id RawTerm-              | Simple Id [RawTerm]--parse :: String -> FilePath -> Result [Decl]-parse s fn = do ds <- mkparse s fn 1 []-                collectDecls ds--processImports :: [Opt] -> [FilePath] -> Result [Decl] -> -                  IO ([Decl], [FilePath])-processImports opts imped (Success ds) = pi imped [] ds-  where pi imps decls ((PInclude fp):xs)-           | fp `elem` imps = pi imps decls xs-           | otherwise = do-                 f <- readLibFile defaultLibPath fp-                 when (Verbose `elem` opts) $ putStrLn ("Reading " ++ fp)-                 case parse f fp of-                   Success t -> pi (fp:imps) decls (t++xs)-                   Failure e f l ->-                     fail $ f ++ ":" ++ show l ++ ":" ++ e-        pi imps decls ((Using t ds):xs)-            = do (ds',imps') <- pi imps [] ds-                 pi imps' (decls++[Using t ds']) xs-        pi imps decls ((Params t ds):xs)-            = do (ds',imps') <- pi imps [] ds-                 pi imps' (decls++[Params t ds']) xs-        pi imps decls ((DoUsing b r ds):xs)-            = do (ds',imps') <- pi imps [] ds-                 pi imps' (decls++[DoUsing b r ds']) xs-        pi imps decls ((Idiom b r ds):xs)-            = do (ds',imps') <- pi imps [] ds-                 pi imps' (decls++[Idiom b r ds']) xs-        pi imps decls ((Namespace n ds):xs)-            = do (ds',imps') <- pi imps [] ds-                 pi imps' (decls++[Namespace n ds']) xs-        pi imps decls (x:xs) = pi imps (decls++[x]) xs-        pi imps decls [] = return (decls, imps)--processImports _ imped (Failure e f l) -    = fail $ show f ++ ":" ++ show l ++ ":" ++ show e---parseTerm :: String -> Result RawTerm-parseTerm s = mkparseTerm s "(input)" 0 []--parseTactic :: String -> Result ITactic-parseTactic s = mkparseTactic s "(tactic)" 0 []---- Make a constructor type, and make arguments lazy if it's codata--mkCon :: Bool -> RawTerm -> ConParse -> (Id,RawTerm)-mkCon co _ (Full n t) = (n,if co then lazify t else t)-mkCon co ty (Simple n args) = (n, mkConTy args ty)-   where mkConTy [] ty = ty-         mkConTy (a:as) ty = let opts = if co then [Lazy] else [] in-                                 RBind (MN "X" 0) (Pi Ex opts a) (mkConTy as ty)---- Make sure all arguments are lazy--lazify :: RawTerm -> RawTerm-lazify (RBind n (Pi p opts a) sc) -    = RBind n (Pi p (nub (Lazy:opts)) a) (lazify sc)-lazify t = t--mkDef file line (n, tms) = mkImpApp (RVar file line n Unknown) tms-   where mkImpApp f [] = f-         mkImpApp f ((tm,Just n):ts) = mkImpApp (RAppImp file line n f tm) ts-         mkImpApp f ((tm, Nothing):ts) = mkImpApp (RApp file line f tm) ts--doBind :: (RawTerm -> RBinder) -> [(Id,RawTerm)] -> RawTerm -> RawTerm-doBind b [] t = t-doBind b ((x,ty):ts) tm = RBind x (b ty) (doBind b ts tm)--doLetBind :: [(Id,RawTerm,RawTerm)] -> RawTerm -> RawTerm-doLetBind [] t = t-doLetBind ((x,ty,val):ts) tm = RBind x (RLet val ty) (doLetBind ts tm)--mkTyApp :: String -> Int -> Id -> RawTerm -> RawTerm-mkTyApp file line n ty = mkApp file line (RVar file line n Unknown) (getTyArgs ty)-   where getTyArgs (RBind n _ t) = (RVar file line n Unknown):(getTyArgs t)-         getTyArgs x = []--mkTyParams :: String -> Int -> [Id] -> RawTerm-mkTyParams f l [] = RConst f l TYPE-mkTyParams f l (x:xs) = RBind x (Pi Ex [] (RConst f l TYPE)) (mkTyParams f l xs)--mkDatatype :: Bool -> String -> Int ->-              Id -> Either RawTerm ((RawTerm, [(Id, RawTerm)]), [ConParse]) -> -                    [TyOpt] -> Datatype-mkDatatype co file line n (Right ((t, using), cons)) opts-    = let opts' = if co then nub (Codata:opts) else opts in-          Datatype n t (map (mkCon co (mkTyApp file line n t)) cons) using opts' file line -mkDatatype co file line n (Left t) opts-    = Latatype n t file line--bracket (RUserInfix f l _ op x y) = RUserInfix f l True op x y-bracket x = x--pairDesugar :: String -> Int -> RawTerm -> [RawTerm] -> RawTerm-pairDesugar file line pair [x,y] = mkApp file line pair [x,y]-pairDesugar file line pair (x:y:xs) -    = pairDesugar file line pair ((mkApp file line pair [x,y]):xs)--sigDesugar :: String -> Int -> (Id, RawTerm) -> RawTerm -> RawTerm-sigDesugar file line (n, tm) sc-    = mkApp file line (RVar file line (UN "Sigma") TypeCon) [tm, lam]-   where lam = RBind n (Lam tm) sc--mkConsList :: String -> Int -> [RawTerm] -> RawTerm-mkConsList f l [] = RVar f l (UN "Nil") Unknown-mkConsList f l (x:xs) = RApp f l (RApp f l (RVar f l (UN "Cons") Unknown) x)-                                 (mkConsList f l xs)--mkhidden (UN n) = MN (n++" is hidden") 0-{-# 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 =---	trace "failing" $ -    	happyError_ tk--{-  We don't need state discarding for our restricted implementation of-    "error".  In fact, it can cause some bogus parses, so I've disabled it-    for now --SDM---- discard a state-happyFail  0# tk old_st (HappyCons ((action)) (sts)) -						(saved_tok `HappyStk` _ `HappyStk` stk) =---	trace ("discarding state, depth " ++ show (length stk))  $-	happyDoAction 0# tk action sts ((saved_tok`HappyStk`stk))--}---- Enter error recovery: generate an error token,---                       save the old token and carry on.-happyFail  i tk (action) sts stk =---      trace "entering error recovery" $-	happyDoAction 0# tk action sts ( (Happy_GHC_Exts.unsafeCoerce# (Happy_GHC_Exts.I# (i))) `HappyStk` stk)---- Internal happy errors:--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.
idris.cabal view
@@ -1,72 +1,75 @@ Name:           idris-Version:        0.1.7.1+Version:        0.9.0 License:        BSD3 License-file:   LICENSE Author:         Edwin Brady Maintainer:     Edwin Brady <eb@cs.st-andrews.ac.uk> Homepage:       http://www.idris-lang.org/ -Stability:      Alpha+Stability:      Beta Category:       Compilers/Interpreters, Dependent Types Synopsis:       Dependently Typed Functional Programming Language-Description:    Idris is an experimental language with full dependent types.+Description:    Idris is a general purpose language with full dependent types.+                It is compiled, with eager evaluation.                  Dependent types allow types to be predicated on values,                 meaning that some aspects of a program's behaviour can be                 specified precisely in the type. The language is closely -		related to Epigram and Agda. There is a tutorial at <http://www.cs.st-andrews.ac.uk/~eb/Idris/tutorial.html>.+		related to Epigram and Agda. There is a tutorial at <http://www.idris-lang.org/documentation>.+                Features include:                 .-                The aims of the project are:+                * Full dependent types with dependent pattern matching+                .                +                * where clauses, with rule, simple case expressions, +                  pattern matching let and lambda bindings                 .-                * To provide a platform for realistic programming with dependent types.-                By realistic, we mean the ability to interact with the outside world-                and use primitive types and operations. This includes networking,-                file handling, concurrency, etc.+                * Type classes, monad comprehensions                 .-                * To show that full dependent types do not mean we have to abandon-                the functional style we have come to know and love with languages-                like Haskell and OCaml. We aim to show that lightweight dependently typed-                programming means allowing the programmer full access to values in types,-                and letting the type checker do the hard work so you don't have to!+                * do notation, idiom brackets, syntactic conveniences for lists, +                  tuples, dependent pairs                 .-                The Darcs repository can be found at <http://www-fp.cs.st-andrews.ac.uk/~eb/darcs/Idris>.-Homepage:       http://www.cs.st-andrews.ac.uk/~eb/Idris/+                * Indentation significant syntax, extensible syntax+                .+                * Tactic based theorem proving (influenced by Coq)+                .+                * Cumulative universes+                .+                * Simple foreign function interface (to C)+                .+                * Hugs style interactive environment  Cabal-Version:  >= 1.6-Build-type:     Simple+Build-type:     Custom -Data-files:     Prelude.e *.idr-Data-dir:       lib+Extra-source-files:    lib/Makefile  lib/*.idr lib/prelude/*.idr lib/network/*.idr+                       tutorial/examples/*.idr -Extra-source-files: CHANGELOG+source-repository head+  type:     git+  location: git://github.com/edwinb/Idris-dev.git  -Library-        Exposed-modules: Idris.Parser, Idris.Lexer, Idris.Lib, -                         Idris.AbsSyntax, Idris.Context, Idris.Latex-                         Idris.Compiler, Idris.LambdaLift, Idris.PMComp, -                         Idris.MakeTerm, Idris.Prover, Idris.Fontlock,-                         Idris.ConTrans, Idris.SCTrans, Idris.RunIO,-                         Idris.SimpleCase, Idris.Serialise, Idris.PartialEval-        Other-modules:   Paths_idris -        Build-depends:   base>=4 && <5, containers, array, parsec, mtl,-                         readline, ivor>=0.1.14, directory, haskell98,-                         old-time, old-locale, binary, epic>=0.1.7, Cabal-                                -        Extensions:      MagicHash, UndecidableInstances, OverlappingInstances, PatternGuards- Executable     idris-               Main-is: Main.lhs-               Other-modules: Idris.Parser, Idris.Lexer, Idris.Lib, -                              Idris.AbsSyntax, Idris.Context,-                              Idris.Compiler, Idris.LambdaLift, Idris.PMComp, -                              Idris.MakeTerm, Idris.Prover, Idris.Fontlock,-                              Idris.ConTrans, Idris.SCTrans, Idris.RunIO,-                              Idris.SimpleCase, Idris.Serialise, -                              Idris.PartialEval+               Main-is: Main.hs+               hs-source-dirs: src+               Other-modules: Core.TT, Core.Evaluate, Core.Typecheck, +                              Core.ProofShell, Core.ProofState, Core.CoreParser, +                              Core.ShellParser, Core.Unify, Core.Elaborate,+                              Core.CaseTree, Core.Constraints, -               Build-depends:   base>=4 && <5, containers, array, parsec, mtl,-                                readline, ivor>=0.1.14, directory, haskell98,-                                old-time, old-locale, binary, epic>=0.1.6, Cabal+                              Idris.AbsSyntax, Idris.Parser, Idris.REPL,+                              Idris.REPLParser, Idris.ElabDecls, Idris.Error,+                              Idris.Delaborate, Idris.Primitives, Idris.Imports,+                              Idris.Compiler, Idris.Prover, Idris.ElabTerm,+                              Idris.Coverage, Idris.IBC, Idris.Unlit,+                              Idris.DataOpts, Idris.Transforms,++                              Paths_idris++               Build-depends:   base>=4 && <5, parsec, mtl, Cabal, haskeline,+                                containers, process, transformers, filepath, directory,+                                binary, bytestring, epic>=0.9.2                                 -               Extensions:      MagicHash, UndecidableInstances, OverlappingInstances, PatternGuards+               Extensions:      MultiParamTypeClasses, FunctionalDependencies,+                                FlexibleInstances, TemplateHaskell                ghc-prof-options: -auto-all+               ghc-options: -rtsopts
+ lib/Makefile view
@@ -0,0 +1,22 @@++check: .PHONY+	$(BINDIR)/idris --noprelude --verbose --check checkall.idr++recheck: clean check++install: check+	mkdir -p $(TARGET)/prelude+	mkdir -p $(TARGET)/network+	install *.ibc $(TARGET)+	install prelude/*.ibc $(TARGET)/prelude+	install network/*.ibc $(TARGET)/network++clean: .PHONY+	rm -f *.ibc+	rm -f prelude/*.ibc+	rm -f network/*.ibc++linecount: .PHONY+	wc -l *.idr network/*.idr prelude/*.idr++.PHONY:
− lib/Prelude.e 
@@ -1,86 +0,0 @@-%include "string.h"---- IO--%inline __epic_id (x:Any) -> Any = x--%inline __epic_putStr (x:String) -> Unit =-    foreign Unit "putStr" (x:String)--__epic_readStr () -> String =-    foreign String "readStr" ()--__epic_append (x:String, y:String) -> String =-    foreign String "append" (x:String, y:String)--__epic_strlen (x:String) -> Int =-    foreign Int "strlen" (x:String)--__epic_strhead (x:String) -> Int =-    foreign Int "strHead" (x:String)--__epic_strtail (x:String) -> String =-    foreign String "strTail" (x:String)--__epic_strcons (h:Int, x:String) -> String =-    foreign String "strCons" (h:Int, x:String)--__epic_streq (x:String, y:String) -> Data =-    foreign Int "streq" (x:String, y:String)--__epic_strrev (x:String) -> String =-    foreign String "strrev" (x:String)--__epic_substr (x:String, start:Int, len:Int) -> String =-    foreign String "substr" (x:String, start: Int, len:Int)--__epic_strFind (x:String, c:Int) -> Int =-    foreign String "strFind" (x:String, c:Int)--%inline __epic_chareq (x:Int, y:Int) -> Data = x==y--%inline __epic_strlt (x:String, y:String) -> Data =-    foreign Int "strlt" (x:String, y:String)--__epic_newRef () -> Int =-    foreign Int "newRef" ()--__epic_readRef (A:Any, r:Int) -> Any =-    foreign Any "readRef" (r:Int)--__epic_writeRef (A:Any, r:Int, v:Any) -> Unit =-    foreign Unit "writeRef" (r:Int, v:Any)--__epic_newLock (l:Int) -> Int =-   foreign Int "newLock" (l:Int)--__epic_doLock (l:Int) -> Unit =-   foreign Unit "doLock" (l:Int)--__epic_doUnlock (l:Int) -> Unit =-   foreign Unit "doUnlock" (l:Int)--__epic_fork (a:Any, f:Fun) -> Unit =-   lazy foreign Unit "doFork" (f:Fun)--__epic_within (a:Any, i:Int, f:Fun, fail:Fun) -> Unit =-   lazy foreign Unit "doWithin" (i:Int, f:Fun, fail:Fun)--%inline __epic_bool (x:Int) -> Data =-   if (x==0) then (Con 1 ()) else (Con 0 ())--__epic_toInt (x:String) -> Int = -   foreign Int "strToInt" (x:String)--__epic_toString (x:Int) -> String = -   foreign String "intToStr" (x:Int)--__epic_floatToString (x:Float) -> String = -   foreign String "floatToStr" (x:Float)--__epic_stringToFloat (x:String) -> Float = -   foreign Float "strToFloat" (x:String)--__epic_native (x:Fun) -> Ptr =-   foreign Ptr "getNative" (x:Fun)-
− lib/bool.idr 
@@ -1,35 +0,0 @@-data Bool = True | False;--not : Bool -> Bool;-not True = False;-not False = True;--%transform not (not ?x) => ?x;--if_then_else : Bool -> |(t:A) -> |(e:A) -> A;-if_then_else True t f = t;-if_then_else False t f = f;--data so : Bool -> Set where oh : so True;--infixl 4 &&,||;--(||) : Bool -> Bool -> Bool;-(||) False x = x;-(||) True _ = True;--(&&) : Bool -> Bool -> Bool;-(&&) True x = x;-(&&) False _ = False;--or_commutes : (x:Bool) -> (y:Bool) -> ((x || y) = (y || x));-or_commutes True False  = refl _;-or_commutes True True   = refl _;-or_commutes False False = refl _;-or_commutes False True  = refl _;--and_commutes : (x:Bool) -> (y:Bool) -> ((x && y) = (y && x));-and_commutes True False  = refl _;-and_commutes True True   = refl _;-and_commutes False False = refl _;-and_commutes False True  = refl _;
lib/builtins.idr view
@@ -1,46 +1,239 @@-include "bool.idr"; +%access public -data __Unit = II;-data __Empty = ;+data Exists : (a : Set) -> (P : a -> Set) -> Set where+    Ex_intro : {P : a -> Set} -> (x : a) -> P x -> Exists a P -data Sigma : (A:Set)->(P:A->Set)->Set where-   Exists : {P:A->Set} -> (a:A) -> P a -> Sigma A P;+getWitness : {P : a -> Set} -> Exists a P -> a+getWitness (a ** v) = a -getSigIdx : {P:a->Set} ->  (s:Sigma a P) -> a;-getSigIdx (Exists a v) = a;+getProof : {P : a -> Set} -> (s : Exists a P) -> P (getWitness s)+getProof (a ** v) = v -getSigVal : {P:a->Set} -> (s:Sigma a P) -> P (getSigIdx s);-getSigVal (Exists a v) = v;+FalseElim : _|_ -> a -data Pair a b = mkPair a b;+-- For rewrite tactic+replace : {a:_} -> {x:_} -> {y:_} -> {P : a -> Set} -> x = y -> P x -> P y+replace refl prf = prf -id : a -> a;-id x = x;+sym : {l:a} -> {r:a} -> l = r -> r = l+sym refl = refl -rewrite : {A:B->Set} -> A m -> (m=n) -> A n;-rewrite t (refl m) = t;+lazy : a -> a+lazy x = x -- compiled specially --- This way is needed for Ivor's rewriting tactic+believe_me : a -> b -- compiled specially as id, use with care!+believe_me x = prim__believe_me _ _ x -__eq_repl : (A:Set)->(x:A) -> (y:A) -> (q:(x=y)) -> (P:(m:A)->Set) -> (p:P x) -> (P y);-__eq_repl A x x (refl _) P p = p;+namespace builtins { -__eq_sym : (A:Set) -> (a:A) -> (b:A) -> (p:(a=b)) -> (b=a);-__eq_sym A a a (refl _) = refl _;+id : a -> a+id x = x --- For proofs which should not be stored at run-time. Programs can--- construct objects of type Proof A, and manipulate them,--- but not inspect them. 'Proof' is treated as collapsible.+const : a -> b -> a+const x _ = x -data Proof : (A:Set) -> Set where-  __mkProof : (a:A) -> Proof A;+fst : (s, t) -> s+fst (x, y) = x -prove : (a:A) -> Proof A;-prove x = __mkProof x;+snd : (a, b) -> b+snd (x, y) = y --- This is the only function allowed to manipulate proofs.--- It'd be easier if we could hide '__mkProof'!+infixl 9 . -proof_bind : Proof A -> (A -> Proof B) -> Proof B;-proof_bind (__mkProof a) p = p a;+(.) : (b -> c) -> (a -> b) -> a -> c+(.) f g x = f (g x)++flip : (a -> b -> c) -> b -> a -> c+flip f x y = f y x++infixr 1 $++($) : (a -> b) -> a -> b+f $ a = f a++data Bool = False | True++boolElim : (x:Bool) -> |(t : a) -> |(f : a) -> a +boolElim True  t e = t+boolElim False t e = e++data so : Bool -> Set where oh : so True++syntax if [test] then [t] else [e] = boolElim test t e+syntax [test] "?" [t] ":" [e] = if test then t else e++infixl 4 &&, ||++(||) : Bool -> Bool -> Bool+(||) False x = x+(||) True _  = True++(&&) : Bool -> Bool -> Bool+(&&) True x  = x+(&&) False _ = False++not : Bool -> Bool+not True = False+not False = True++infixl 5 ==, /=, ==.+infixl 6 <, <=, >, >=, <., <=., >., >=.+infixl 7 <<, >>+infixl 8 +,-,++,+.,-.+infixl 9 *,/,*.,/.++--- Numeric operators++intToBool : Int -> Bool+intToBool 0 = False+intToBool x = True++boolOp : (a -> a -> Int) -> a -> a -> Bool+boolOp op x y = intToBool (op x y) ++class Eq a where+    (==) : a -> a -> Bool+    (/=) : a -> a -> Bool++    x /= y = not (x == y)+    x == y = not (x /= y)++instance Eq Int where +    (==) = boolOp prim__eqInt++instance Eq Integer where+    (==) = boolOp prim__eqBigInt++instance Eq Float where+    (==) = boolOp prim__eqFloat++instance Eq Char where+    (==) = boolOp prim__eqChar++instance Eq String where+    (==) = boolOp prim__eqString++data Ordering = LT | EQ | GT++class Eq a => Ord a where +    compare : a -> a -> Ordering++    (<) : a -> a -> Bool+    (<) x y with (compare x y) +        (<) x y | LT = True+        (<) x y | _  = False++    (>) : a -> a -> Bool+    (>) x y with (compare x y)+        (>) x y | GT = True+        (>) x y | _  = False++    (<=) : a -> a -> Bool+    (<=) x y = x < y || x == y++    (>=) : a -> a -> Bool+    (>=) x y = x > y || x == y++    max : a -> a -> a+    max x y = if (x > y) then x else y++    min : a -> a -> a+    min x y = if (x < y) then x else y++++instance Ord Int where +    compare x y = if (x == y) then EQ else+                  if (boolOp prim__ltInt x y) then LT else+                  GT+++instance Ord Integer where +    compare x y = if (x == y) then EQ else+                  if (boolOp prim__ltBigInt x y) then LT else+                  GT+++instance Ord Float where +    compare x y = if (x == y) then EQ else+                  if (boolOp prim__ltFloat x y) then LT else+                  GT+++instance Ord Char where +    compare x y = if (x == y) then EQ else+                  if (boolOp prim__ltChar x y) then LT else+                  GT+++instance Ord String where +    compare x y = if (x == y) then EQ else+                  if (boolOp prim__ltString x y) then LT else+                  GT+++class (Eq a, Ord a) => Num a where +    (+) : a -> a -> a+    (-) : a -> a -> a+    (*) : a -> a -> a++    abs : a -> a+    abs x = if (x < 0) then (-x) else x++    fromInteger : Int -> a++++instance Num Int where +    (+) = prim__addInt+    (-) = prim__subInt+    (*) = prim__mulInt++    fromInteger = id+++instance Num Integer where +    (+) = prim__addBigInt+    (-) = prim__subBigInt+    (*) = prim__mulBigInt++    fromInteger = prim__intToBigInt+++instance Num Float where +    (+) = prim__addFloat+    (-) = prim__subFloat+    (*) = prim__mulFloat++    fromInteger = prim__intToFloat +++div : Int -> Int -> Int+div = prim__divInt+++(/) : Float -> Float -> Float+(/) = prim__divFloat++--- string operators++(++) : String -> String -> String+(++) = prim__concat++strHead : String -> Char+strHead = prim__strHead++strTail : String -> String+strTail = prim__strTail++strCons : Char -> String -> String+strCons = prim__strCons++strIndex : String -> Int -> Char+strIndex = prim__strIndex++rev : String -> String+rev = prim__strRev++}
+ lib/checkall.idr view
@@ -0,0 +1,24 @@+module checkall++-- This file just exists to typecheck all the prelude modules+-- Add imports here ++import builtins+import prelude+import io+import system++import prelude.cast+import prelude.nat+import prelude.fin+import prelude.list+import prelude.maybe+import prelude.monad+import prelude.applicative+import prelude.either+import prelude.vect+import prelude.strings+import prelude.char++import network.cgi +
− lib/either.idr 
@@ -1,9 +0,0 @@-data Either A B = Left A | Right B;--choose : (x:Bool) -> Either (so (not x)) (so x);-choose False = Left oh;-choose True = Right oh;--either : Either a b -> (a -> c) -> (b -> c) -> c;-either (Left  a) fa fb = fa a;-either (Right b) fa fb = fb b;
− lib/equalities.idr 
@@ -1,39 +0,0 @@-include "maybe.idr";-include "vect.idr";--data EqNat : Nat -> Nat -> Set where-    eqO : EqNat O O-  | eqS : EqNat x y -> EqNat (S x) (S y);--eqNat' : (x:Nat) -> (y:Nat) -> Maybe (EqNat x y);-eqNat' O O = Just eqO;-eqNat' (S x) (S y) with eqNat' x y {-  eqNat' (S x) (S x) | Just p = Just (eqS p);-  eqNat' (S x) (S y) | Nothing = Nothing;-}-eqNat' _ _ = Nothing;--eqNat : Nat -> Nat -> Bool;-eqNat x y with eqNat' x y {-  eqNat x x | Just _ = True;-  eqNat x y | Nothing = False;-}--data EqFin : Fin n -> Fin n -> Set where-    eqfO : {k:Nat} -> EqFin {n=S k} fO fO-  | eqfS : {x:Fin n} -> {y:Fin n} -> EqFin x y -> EqFin (fS x) (fS y);--eqFin' : (x:Fin n) -> (y:Fin n) -> Maybe (EqFin x y);-eqFin' fO fO = Just eqfO;-eqFin' (fS x) (fS y) with eqFin' x y {-  eqFin' (fS x) (fS x) | Just p = Just (eqfS p);-  eqFin' (fS x) (fS y) | Nothing = Nothing;-}-eqFin' _ _ = Nothing;--eqFin : Fin n -> Fin n -> Bool;-eqFin x y with eqFin' x y {-  eqFin x x | Just _ = True;-  eqFin x y | Nothing = False;-}-
lib/io.idr view
@@ -1,272 +1,45 @@-include "list.idr";+import prelude.list --- FAny is to allow C functions to build up Idris data--- types. Obviously this needs care...+%access public -data FType = FUnit | FInt | FStr | FPtr | FFloat | FAny Set-           | FIntP (Int -> Bool);+abstract data IO a = prim__IO a -i_ftype : FType -> Set;-i_ftype FInt = Int;-i_ftype FStr = String;-i_ftype FPtr = Ptr;-i_ftype FFloat = Float;-i_ftype FUnit = ();-i_ftype (FAny ty) = ty;-i_ftype (FIntP p) = (x : Int ** so (p x)); +abstract+io_bind : IO a -> (a -> IO b) -> IO b+io_bind (prim__IO v) k = k v -data ForeignFun = FFun String (List FType) FType;+abstract+io_return : a -> IO a+io_return x = prim__IO x -f_retType : ForeignFun -> FType;-f_retType (FFun nm args ret) = ret;+-- This may seem pointless, but we can use it to force an+-- evaluation of main that Epic wouldn't otherwise do... -f_args : ForeignFun -> (List FType);-f_args (FFun nm args ret) = args;+run__IO : IO () -> IO ()+run__IO v = io_bind v (\v' => io_return v') -f_name : ForeignFun -> String;-f_name (FFun nm args ret) = nm;+data FTy = FInt | FFloat | FChar | FString | FPtr | FUnit -data FArgList : (List FType) -> Set where-    fNil : FArgList Nil-  | fCons : {x:FType} -> (fx:i_ftype x) -> (fxs:FArgList xs) ->-			 (FArgList (Cons x xs));+interpFTy : FTy -> Set+interpFTy FInt    = Int+interpFTy FFloat  = Float+interpFTy FChar   = Char+interpFTy FString = String+interpFTy FPtr    = Ptr+interpFTy FUnit   = () -fapp : {xs,ys:List FType} -> -       (FArgList xs) -> (FArgList ys) -> (FArgList (app xs ys));-fapp fNil fxs = fxs;-fapp (fCons fx fxs) fys = fCons fx (fapp fxs fys);+ForeignTy : (xs:List FTy) -> (t:FTy) -> Set+ForeignTy xs t = mkForeign' (rev xs) (IO (interpFTy t)) where +   mkForeign' : List FTy -> Set -> Set+   mkForeign' Nil ty       = ty+   mkForeign' (s :: ss) ty = mkForeign' ss (interpFTy s -> ty) -namespace IO { -  data IO : Set -> Set;--  data Command : Set where-      PutStr : String -> Command-    | GetStr : Command-    | Fork : {A:Set} -> A -> Command-    | NewLock : Int -> Command-    | DoLock : Lock -> Command-    | DoUnlock : Lock -> Command-    | NewRef : Command-    | ReadRef : Set -> Int -> Command-    | WriteRef : {A:Set} -> Int -> A -> Command-    | While : (IO Bool) -> (IO ()) -> Command-    | WhileAcc : {A:Set} -> (IO Bool) -> A -> (A -> IO A) -> Command-    | Within : Int -> (IO A) -> (IO A) -> Command-    | IOLift : {A:Set} -> (IO A) -> Command -    | Foreign : (f:ForeignFun) -> -  	        (args:FArgList (f_args f)) -> Command;+data Foreign : Set -> Set where+    FFun : String -> (xs:List FTy) -> (t:FTy) -> +           Foreign (ForeignTy xs t) -  Response : Command -> Set;-  Response (PutStr s) = ();-  Response GetStr = String;-  Response (Fork proc) = ();-  Response (NewLock i) = Lock;-  Response (DoLock l) = ();-  Response (DoUnlock l) = ();-  Response NewRef = Int;-  Response (ReadRef A i) = A;-  Response (WriteRef i val) = ();-  Response (While _ body) = ();-  Response (WhileAcc {A} _ acc body) = A;-  Response (Within {A} time body failure) = A;-  Response (IOLift {A} f) = A;-  Response (Foreign t args) = i_ftype (f_retType t);+mkForeign : Foreign x -> x+-- mkForeign compiled as primitive  -  data IO : Set -> Set where-     IOReturn : A -> (IO A)-   | IODo : (c:Command) -> ((Response c) -> (IO A)) -> (IO A);--  data IORef A = MkIORef Int;--  bind : (IO a) -> (a -> (IO b)) -> (IO b);-  bind (IOReturn a) k = k a;-  -- bind (IODo (IOLift {A} c) p) k = bind (bind c p) k;-  bind (IODo c p) k = IODo c (\y => (bind (p y) k));-  -- bind (IOError str) k = IOError str;--  ret : a -> IO a;-  ret x = IOReturn x;-}--kbind : (IO a) -> (a -> b) -> (IO b);-kbind (IOReturn a) k = IOReturn (k a);-kbind (IODo c p) k = IODo c (\x => (kbind (p x) k));--while : |(test:IO Bool) -> |(body: IO ()) -> IO ();-while t body = IODo (While t body) (\a => (IOReturn II));--while_accTR : Bool -> -            |(test:IO Bool) -> acc -> |(body: acc -> IO acc) -> IO acc;--while_acc : |(test:IO Bool) -> acc -> |(body: acc -> IO acc) -> IO acc;-{--while_acc test acc body = do { test' <- test;-	       	   	       while_accTR test' test acc body; };--while_accTR True test acc body = do { acc' <- body acc;-	    	      	       	      test' <- test;-	       	       	              while_accTR test' test acc' body; };-while_accTR False test acc body = return acc;--}-while_acc test acc body = IODo (WhileAcc test acc body) (\a => (IOReturn a));--{--ioReturn : a -> (IO a);-ioReturn x = IOReturn x;--}--apply : IO (a -> b) -> IO a -> IO b;-apply {a} {b} fn arg = do { f : (a->b) <- fn; -- grr-                            x <- arg;-              		    return (f x); };--data IOException = IOExcept String; --data IOe : Set -> Set where-   IOK : (IO A) -> (IOe A)- | IOError : String -> (IOe A);--{--catch : (IOe A) -> (IOException -> (IO A)) -> (IO A);-catch (IOK action) = action;-catch (IOError str) handler = handler (IOExcept str);--}---- No code for this - only works in compiled code, certainly shouldn't--- be evaluted in pure code!-unsafePerformIO : (IO A) -> A;---- get the rts representation of a value-unsafeNative : A -> Ptr;--putStr : String -> (IO ());-putStr str = IODo (PutStr str) (\a => (IOReturn a));--getStr : IO String;-getStr = IODo GetStr (\b => (IOReturn b));--getInt : IO Int;-getInt = do { inp <- getStr;-              let val = __toInt inp;-	      return val; };--putStrLn : String -> (IO ());-putStrLn str = do { putStr str;-		    putStr "\n"; };--fork : |(proc:IO ()) -> (IO ());-fork proc = IODo (Fork proc) (\a => (IOReturn a));--newLock : Int -> (IO Lock);-newLock i = IODo (NewLock i) (\l => (IOReturn l));--lock : Lock -> (IO ());-lock l = IODo (DoLock l) (\a => (IOReturn a));--unlock : Lock -> (IO ());-unlock l = IODo (DoUnlock l) (\a => (IOReturn a));---- Perform an action within "time" milliseconds, execute failure--- routine if it doesn't complete--within : Int -> |(action : IO a) -> |(failure : IO a) -> IO a;-within time act fail = IODo (Within time act fail) (\a => (IOReturn a));--newIORefPrim : IO Int;-newIORefPrim = IODo (NewRef) (\i => (IOReturn i));--readIORefPrim : Int -> (IO A);-readIORefPrim {A} i = IODo (ReadRef A i) (\a => (IOReturn a));--writeIORefPrim : Int -> A -> (IO ());-writeIORefPrim {A} i val = IODo (WriteRef {A} i val) (\a => (IOReturn a));--newIORef : A -> (IO (IORef A));-newIORef val = do { i <- newIORefPrim;-		    writeIORefPrim i val;-		    return (MkIORef i);-		  };--readIORef : (IORef A) -> (IO A);-readIORef (MkIORef i) = readIORefPrim i;--writeIORef : (IORef A) -> A -> (IO ());-writeIORef (MkIORef i) val = writeIORefPrim i val;--mkFType' : (List FType) -> FType -> Set  ; [%nocg]--mkFType' Nil rt = IO (i_ftype rt);-mkFType' (Cons t ts) rt = (i_ftype t) -> (mkFType' ts rt);--mkFType : ForeignFun -> Set   ; [%nocg]-mkFType (FFun fn args rt) = mkFType' args rt;--mkFDef : String -> (ts:List FType) -> (xs:List FType) -> (FArgList xs) ->-	 (rt:FType) -> (mkFType' ts rt)  ; [%nocg]-mkFDef nm Nil accA fs rt -   = IODo (Foreign (FFun nm accA rt) fs)-				 (\a => (IOReturn a));-mkFDef nm (Cons t ts) accA fs rt -   = \x:i_ftype t => mkFDef nm ts (app accA (Cons t Nil)) -				   (fapp fs (fCons x fNil)) rt;--mkForeign : (f:ForeignFun) -> (mkFType f)  ; [%nocg]-mkForeign (FFun fn args rt) = mkFDef fn args Nil fNil rt;--_isNull = mkForeign (FFun "isNull" (Cons FPtr Nil) FInt); [%eval]--isNull : Ptr -> Bool;-isNull ptr = if_then_else ((unsafePerformIO (_isNull ptr))==0) False True;--data File = FHandle Ptr;--_fopen-  = mkForeign (FFun "fileOpen" (Cons FStr (Cons FStr Nil)) FPtr); [%eval]-_fclose -  = mkForeign (FFun "fileClose" (Cons FPtr Nil) FUnit); [%eval]-_fread-  = mkForeign (FFun "freadStr" (Cons FPtr Nil) (FAny String)); [%eval]-_fwrite-  = mkForeign (FFun "fputStr" (Cons FPtr (Cons FStr Nil)) FUnit); [%eval]-_feof-  = mkForeign (FFun "feof" (Cons FPtr Nil) FInt); [%eval]--gc_details-  = mkForeign (FFun "epicMemInfo" Nil FUnit); [%eval]--gc_collect-  = mkForeign (FFun "epicGC" Nil FUnit); [%eval]--validFile : File -> Bool;-validFile (FHandle p) = not (isNull p);--fopen : String -> String -> IO File;-fopen str mode = do { ho <- _fopen str mode;-		      return (FHandle ho); };--fclose : File -> IO ();-fclose (FHandle h) = _fclose h;--fread : File -> IO String;-fread (FHandle hn) = _fread hn;--fwrite : File -> String -> IO ();-fwrite (FHandle h) str = _fwrite h str;--feof : File -> IO Bool;-feof (FHandle h) = do { eof <- _feof h;-     	      	      	return (not (eof==0)); };--sequence : (List (IO a)) -> (IO (List a));-sequence Nil = return Nil;-sequence (Cons x xs) = do { a <- x;-			    as <- sequence xs;-			    return (Cons a as); };--sleep = mkForeign (FFun "sleep" (Cons FInt Nil) FUnit); [%eval]---- Return time in microseconds since some unspecified starting point--utime = mkForeign (FFun "do_utime" Nil FInt); [%eval]
− lib/list.idr 
@@ -1,79 +0,0 @@-data List a = Nil | Cons a (List a);--map : (a->b) -> (List a) -> (List b);-map f Nil = Nil;-map f (Cons x xs) = Cons (f x) (map f xs);--consp : Bool -> a -> (List a) -> (List a);-consp True x xs = Cons x xs;-consp False x xs = xs;--filter : (a->Bool) -> (List a) -> (List a);-filter p Nil = Nil;-filter p (Cons x xs) = consp (p x) x (filter p xs);--maybeCons : (Maybe a) -> (List a) -> (List a);-maybeCons Nothing xs = xs;-maybeCons (Just a) xs = (Cons a xs);--mapMaybe : (a->(Maybe b)) -> (List a) -> (List b);-mapMaybe f Nil = Nil;-mapMaybe f (Cons x xs) = maybeCons (f x) (mapMaybe f xs);--app : (List a) -> (List a) -> (List a);-app Nil xs = xs;-app (Cons x xs) ys = Cons x (app xs ys);--foldl : (a -> b -> a) -> a -> (List b) -> a;-foldl f z Nil = z;-foldl f z (Cons x xs) = foldl f (f z x) xs;--foldr : (a -> b -> b) -> b -> (List a) -> b;-foldr f z Nil = z;-foldr f z (Cons x xs) = f x (foldr f z xs);--rev : (List a) -> (List a);-rev xs = foldl (flip Cons) Nil xs;--eq_resp_Cons : {xs,ys:List A} -> (xs=ys) -> ((Cons x xs) = (Cons x ys));-eq_resp_Cons {A} {x} (refl xs) = refl _;--elem : (a->a->Bool) -> a -> (List a) -> Bool;-elem q x Nil = False;-elem q x (Cons y ys) = if_then_else (q x y) True (elem q x ys);--app_assoc : (xs:List a) -> (ys:List a) -> (zs:List a) ->-	    (app xs (app ys zs) = app (app xs ys) zs);--app_assoc Nil ys zs = refl _;-app_assoc (Cons x xs) ys zs = let rec = app_assoc xs ys zs in-	  	      	      ?app_assocCons;-app_assocCons proof {-	%intro;-	%rewrite rec;-	%refl;-	%qed;-};--app_Nil : (xs:List a) -> (app xs Nil = xs);-app_Nil Nil = refl _;-app_Nil (Cons x xs) = ?appNil_Cons;-appNil_Cons proof {-	%intro a;-	%intro;-	%rewrite <- app_Nil xs;-	%refl;-	%qed;-};--span' : (a -> Bool) -> List a -> List a -> (List a & List a);-span' p Nil acc         = (rev acc, Nil);-span' p (Cons x xs) acc = if (p x) then (span' p xs (Cons x acc))-      	      	      	           else (rev acc, Cons x xs);--span : (a -> Bool) -> List a -> (List a & List a);-span p xs = span' p xs Nil;--length : List a -> Int;-length Nil = 0;-length (Cons x xs) = 1 + length xs;
− lib/maybe.idr 
@@ -1,13 +0,0 @@-data Maybe A = Just A | Nothing;--mMap : (f:A->B) -> (Maybe A) -> (Maybe B);-mMap f Nothing = Nothing;-mMap f (Just a) = Just (f a);--maybe : (x:Maybe a) -> |(default:b) -> (a->b) -> b;-maybe Nothing def f = def;-maybe (Just a) def f = f a;--maybeBind : Maybe a -> (a -> Maybe b) -> Maybe b;-maybeBind Nothing  mf = Nothing;-maybeBind (Just x) mf = mf x;
− lib/nat.idr 
@@ -1,147 +0,0 @@-data Nat = O | S Nat;--plus : Nat -> Nat -> Nat;-plus O y = y;-plus (S k) y = S (plus k y);--mult : Nat -> Nat -> Nat;-mult O y = O;-mult (S k) y = plus y (mult k y);--eq_resp_S : (m=n) -> ((S m) = (S n));-eq_resp_S (refl n) = refl (S n);--power : Nat -> Nat -> Nat;-power n O = S O;-power n (S k) = mult n (power n k);--------- Int/String conversions ---------intToNat : Int -> Nat;--in' : Bool -> Nat -> Int -> Nat;-in' True n i = n;-in' False n i = S (intToNat (i-1));--intToNat n = in' (n<=0) O n;--natToInt : Nat -> Int;-natToInt O = 0;-natToInt (S k) = 1+(natToInt k);------------- plus theorems -------------plus_nO : (n:Nat) -> ((plus n O) = n);-plus_nO O = (refl O);-plus_nO (S n) = eq_resp_S (plus_nO n);--plus_nSm : (m:Nat, n:Nat) -> ((plus n (S m)) = (S (plus n m)));-plus_nSm m O     = refl (S m);-plus_nSm m (S k) = eq_resp_S (plus_nSm m k);--plus_comm : (x:Nat, y:Nat) -> (plus x y = plus y x);-plus_comm proof {-        %intro; %induction x;-	%rewrite <- plus_nO y;-	%refl;-	%intro n,ih;-	%rewrite <- (plus_nSm n y);-	%rewrite ih;-	%refl;-	%qed;-};--plus_assoc  : (m:Nat, n:Nat, p:Nat) -> (plus m (plus n p) = plus (plus m n) p);-plus_assoc proof {-        %intro;-        %induction m;-        %compute;-        %refl;-        %intro k;-        %intro ih;-        %compute;-        %rewrite <- ih;-        %refl;-        %qed;-};------------- mult theorems -------------mult_nO : (n:Nat) -> ((mult n O) = O);-mult_nO O = refl _;-mult_nO (S k) = mult_nO k;--mult_nSm : (n:Nat, m:Nat) -> ((mult n (S m)) = (plus n (mult n m)));-mult_nSm proof {-        %intro;-        %induction n;-        %refl;-        %intro k,ih;-        %compute;-        %refine eq_resp_S;-        %rewrite <- ih;-        %generalise mult k m;-        %intro x;-        %rewrite <- plus_comm m x;-        %rewrite <- plus_assoc k x m;-        %rewrite <- plus_comm m (plus k x);-        %refl;-        %qed;-};--mult_comm : (x:Nat, y:Nat) -> ((mult x y) = (mult y x));-mult_comm proof {-        %intro;-        %induction x;-        %rewrite <- mult_nO y;-        %refl;-        %intro k,ih;-        %compute;-        %rewrite <- mult_nSm y k;-        %rewrite <- ih;-        %refl;-        %qed;-};--mult_distrib : (m:Nat, n:Nat, p:Nat) ->-	       (plus (mult m p) (mult n p) = mult (plus m n) p);-mult_distrib proof {-        %intro;-        %induction m;-        %refl;-        %intro k,ih;-        %compute;-        %rewrite ih;-        %rewrite plus_assoc p (mult k p) (mult n p);-        %refl;-        %qed;-};------ Comparing Nats--data Compare : Nat -> Nat -> Set where-   cmpLT : (y:Nat) -> (Compare x (plus x (S y)))- | cmpEQ : Compare x x- | cmpGT : (x:Nat) -> (Compare (plus y (S x)) y);--compareAux : (Compare n m) -> (Compare (S n) (S m));-compareAux (cmpLT y) = cmpLT _;-compareAux cmpEQ = cmpEQ;-compareAux (cmpGT x) = cmpGT _;--compare : (n:Nat) -> (m:Nat) -> (Compare n m);-compare O O = cmpEQ;-compare (S n) O = cmpGT _;-compare O (S m) = cmpLT _;-compare (S n) (S m) = compareAux (compare n m);--ltNat : Nat -> Nat -> Bool;-ltNat O (S x) = True;-ltNat (S x) O = False;-ltNat O O = False;-ltNat (S x) (S y) = ltNat x y;--max : Nat -> Nat -> Nat;-max O n = n;-max (S n) O = S n;-max (S n) (S m) = S (max n m);
+ lib/network/cgi.idr view
@@ -0,0 +1,144 @@+module network.cgi++import system++public+Vars : Set+Vars = List (String, String)++data CGIInfo = CGISt Vars -- GET+                     Vars -- POST+                     Vars -- Cookies+                     String -- User agent+                     String -- headers+                     String -- output++get_GET : CGIInfo -> Vars+get_GET (CGISt g _ _ _ _ _) = g++get_POST : CGIInfo -> Vars+get_POST (CGISt _ p _ _ _ _) = p++get_Cookies : CGIInfo -> Vars+get_Cookies (CGISt _ _ c _ _ _) = c++get_UAgent : CGIInfo -> String+get_UAgent (CGISt _ _ _ a _ _) = a++get_Headers : CGIInfo -> String+get_Headers (CGISt _ _ _ _ h _) = h++get_Output : CGIInfo -> String+get_Output (CGISt _ _ _ _ _ o) = o++add_Headers : String -> CGIInfo -> CGIInfo+add_Headers str (CGISt g p c a h o) = CGISt g p c a (h ++ str) o++add_Output : String -> CGIInfo -> CGIInfo+add_Output str (CGISt g p c a h o) = CGISt g p c a h (o ++ str)++abstract+data CGI : Set -> Set where+    MkCGI : (CGIInfo -> IO (a, CGIInfo)) -> CGI a++getAction : CGI a -> CGIInfo -> IO (a, CGIInfo)+getAction (MkCGI act) = act++instance Monad CGI where {+    (>>=) (MkCGI f) k = MkCGI (\s => do v <- f s+                                        getAction (k (fst v)) (snd v))++    return v = MkCGI (\s => return (v, s))+}++setInfo : CGIInfo -> CGI ()+setInfo i = MkCGI (\s => return ((), i))++getInfo : CGI CGIInfo+getInfo = MkCGI (\s => return (s, s))++abstract+lift : IO a -> CGI a +lift op = MkCGI (\st => do { x <- op+                             return (x, st) } ) ++abstract+output : String -> CGI ()+output s = do i <- getInfo+              setInfo (add_Output s i)++abstract+queryVars : CGI Vars+queryVars = do i <- getInfo+               return (get_GET i)++abstract+postVars : CGI Vars+postVars = do i <- getInfo+              return (get_POST i)++abstract+cookieVars : CGI Vars+cookieVars = do i <- getInfo+                return (get_Cookies i)++abstract+queryVar : String -> CGI (Maybe String)+queryVar x = do vs <- queryVars+                return (lookup x vs)++getOutput : CGI String+getOutput = do i <- getInfo+               return (get_Output i)++getHeaders : CGI String+getHeaders = do i <- getInfo+                return (get_Headers i)++abstract+flushHeaders : CGI ()+flushHeaders = do o <- getHeaders+                  lift (putStrLn o)++abstract+flush : CGI ()+flush = do o <- getOutput+           lift (putStr o) ++getVars : List Char -> String -> List (String, String)+getVars seps query = mapMaybe readVar (split (\x => elem x seps) query) +  where+    readVar : String -> Maybe (String, String)+    readVar xs with (split (\x => x == '=') xs)+        | [k, v] = Just (trim k, trim v)+        | _      = Nothing++getContent : Int -> IO String+getContent x = getC x "" where+    getC : Int -> String -> IO String+    getC 0 acc = return $ rev acc+    getC n acc = do x <- getChar+                    getC (n-1) (strCons x acc)++abstract+runCGI : CGI a -> IO a+runCGI prog = do +    clen_in <- getEnv "CONTENT_LENGTH"+    let clen = prim__strToInt clen_in+    content <- getContent clen+    query   <- getEnv "QUERY_STRING"+    cookie  <- getEnv "HTTP_COOKIE"+    agent   <- getEnv "HTTP_USER_AGENT"++    let get_vars  = getVars ['&',';'] query+    let post_vars = getVars ['&'] content+    let cookies   = getVars [';'] cookie++    p <- getAction prog (CGISt get_vars post_vars cookies agent +            "Content-type: text/html\n" +            "")+    putStrLn (get_Headers (snd p))+    putStr (get_Output (snd p))+    return (fst p)++
− lib/perm.idr 
@@ -1,139 +0,0 @@-include "vect.idr";---- Yes, it's a DSL! One which gives a sequence of operations for converting a--- list into its permutation.--using (x:A, xs:List A, xs':List A, xs'':List A, -       ys:List A, ys':List A,-       zs:List A)-{-  data Perm : (List A) -> (List A) -> Set where-     pnil : {A:Set} -> (Perm {A} Nil Nil)-   | pskip : (Perm xs xs') -> (Perm (Cons x xs) (Cons x xs'))-   | pswap : (Perm (Cons x (Cons y xs)) (Cons y (Cons x xs)))-   | ptrans : (Perm xs xs') -> (Perm xs' xs'') -> (Perm xs xs'');--  perm_id: Perm xs xs;-  perm_id {xs=Nil} = pnil;-  perm_id {xs=Cons x xs} = pskip perm_id;--  perm_sym : Perm xs xs' -> Perm xs' xs;-  perm_sym pnil = pnil;-  perm_sym (pskip p) = pskip (perm_sym p);-  perm_sym pswap = pswap;-  perm_sym (ptrans p q) = ptrans (perm_sym q) (perm_sym p);--  perm_refl : Perm xs xs;-  perm_refl {xs=Nil} = pnil;-  perm_refl {xs=Cons x xs} = pskip perm_refl;--  perm_app_head : (xs:List A) -> -                  Perm xs' ys' -> Perm (app xs xs') (app xs ys');-  perm_app_head Nil p = p;-  perm_app_head (Cons x xs) p = pskip (perm_app_head xs p);--  perm_add_cons : Perm (Cons x xs) (Cons x ys) -> Perm xs ys;-  perm_add_cons (pskip p) = p;-  perm_add_cons pswap = pskip perm_id;--  perm_app : Perm xs ys -> Perm xs' ys' ->-             Perm (app xs xs') (app ys ys');-  perm_app {xs=Nil} {ys=Nil} p p' = p';-  perm_app {xs=Cons x xs} {ys=Cons y ys} {xs'} {ys'} (ptrans p1 p2) p' = -     let r1 = perm_app p1 p' in-     let r2 = perm_app p2 p' in ?papp_cons;--  perm_rewrite : Perm xs xs' -> Perm xs ys -> Perm xs' ys;-  perm_rewrite p1 p2 = ptrans (perm_sym p1) p2;--  perm_rewrite_cons : Perm (Cons x xs) xs' -> Perm xs ys -> -                      Perm (Cons x ys) xs';-  perm_rewrite_cons (pskip p1) p2 = pskip (ptrans (perm_sym p2) p1);-  perm_rewrite_cons pswap p = ptrans (pskip (perm_sym p)) pswap;-  perm_rewrite_cons (ptrans p1 p2) p3 = ptrans (perm_rewrite_cons p1 p3) p2;--  perm_rewrite_app : Perm (app xs ys) xs' -> Perm ys zs ->-                     Perm (app xs zs) xs';-  perm_rewrite_app {xs=Nil} p1 p2 = perm_rewrite p2 p1;-  perm_rewrite_app {xs=Cons x xs} p1 p2 -       = perm_rewrite_cons p1 (perm_app perm_id p2);--  perm_swapr : Perm xs (Cons x (Cons y ys)) ->-               Perm xs (Cons y (Cons x ys));-  perm_swapr {xs=Cons a (Cons b xs)} p = ptrans p pswap;--  perm_swapl : Perm (Cons x (Cons y ys)) xs ->-               Perm (Cons y (Cons x ys)) xs;-  perm_swapl {xs=Cons a (Cons b xs)} p = ptrans pswap p;--  perm_move_cons : Perm xs (app ys (Cons x zs)) ->-                   Perm xs (Cons x (app ys zs));-  perm_move_cons {ys=Nil} p = p;-  perm_move_cons {ys=Cons y ys} p -        = perm_swapr (perm_sym -             (perm_rewrite_cons (perm_sym p) (perm_move_cons perm_id)));--  perm_cons_move : Perm xs (Cons x (app ys zs)) ->-                   Perm xs (app ys (Cons x zs));-                  -  perm_cons_move {ys=Nil} p = p;-  perm_cons_move {ys=Cons y ys} p -        = perm_sym (perm_rewrite_cons-             (perm_swapl (perm_sym p)) (perm_cons_move perm_id));--  -- This is by induction on the *list* xs, not the permutation, despite-  -- initial appearances.--  perm_app_cons : Perm xs (app xs' ys') ->-  		  Perm (Cons x xs) (app xs' (Cons x ys'));-  perm_app_cons {xs'=Nil} {ys'=Nil} p = pskip p;-  perm_app_cons {x} {xs=Cons x' xs} {xs'=Cons x' xs'}-                (pskip p) = let prec = perm_app_cons {x=x} p in-  		  perm_swapl (perm_rewrite_cons perm_id (perm_sym prec));-  perm_app_cons {xs=Cons x (Cons y _)} {xs'=Cons y (Cons x _)}-                pswap = perm_swapl (perm_swapr (pskip (perm_swapl-  		  (pskip (perm_app_cons perm_id))))); -- list is smaller!-  perm_app_cons {xs=Cons x' xs} {xs'=Cons x' xs'}-                (ptrans p1 p2) = perm_swapl (pskip (perm_app_cons-  		  (perm_add_cons (ptrans p1 p2)))); -- list is smaller!--  -- Again by induction on the list xs. Maybe there are shorter proofs,-  -- but it doesn't really matter, we're not going to run them...--  perm_app_swap : Perm (app xs ys) zs -> Perm (app ys xs) zs;-  perm_app_swap {xs=Nil} p ?= p;   [papp_swap_nil]-  perm_app_swap {xs=Cons x xs} {zs=Cons x zs} -                (pskip p) = perm_sym-                     (perm_app_cons (perm_sym (perm_app_swap p)));-  perm_app_swap {xs=Cons x (Cons y _)}-                pswap = perm_swapr (perm_sym -		        (perm_app_cons -			 (perm_rewrite_cons -			  (perm_app_cons perm_id) (perm_app_swap perm_id))));-  perm_app_swap {xs=Cons x xs} {zs=Cons z zs}-                (ptrans p1 p2) = perm_sym (perm_cons_move -                                  (perm_sym (perm_rewrite_cons -                                    (ptrans p1 p2) (perm_app_swap perm_id))));--}---papp_cons proof {-	%intro a;-	%intro;-	%refine ptrans;-	%fill (app X xs');-	%refine ptrans;-	%fill (app X ys');-	%fill r1;-	%fill perm_app_head X (perm_sym p');-	%fill r2;-	%qed;-};--papp_swap_nil proof {-	%intro;-	%use value;-	%fill app_Nil X1;-	%qed;-};
lib/prelude.idr view
@@ -1,121 +1,270 @@--- malloc evaluates an expression using a manual allocator, allocating 'bytes'--- Needs to be compiled specially, naturally.+module prelude -malloc : Int -> a -> a;-malloc bytes val = val;+import builtins+import io -%freeze malloc;+import prelude.cast+import prelude.nat+import prelude.fin+import prelude.list+import prelude.maybe+import prelude.monad+import prelude.applicative+import prelude.either+import prelude.vect+import prelude.strings+import prelude.char --- Used by the 'believe' tactic to make a temporary proof. Programs--- using this are not to be trusted! (Or maybe use externally trusted code)--- Generate a refl so that __eq_repl can reduce.+%access public -__Suspend_Disbelief : (m:A) -> (n:A) -> (n = m);-__Suspend_Disbelief m n = __Prove_Anything _ _ (refl n);+-- Show and instances -flip : (a -> b -> c) -> b -> a -> c;-flip f x y = f y x;+class Show a where +    show : a -> String -infixl 5 ==, /=, ==.;-infixl 6 <, <=, >, >=, <., <=., >., >=.;-infixl 7 <<, >>;-infixl 8 +,-,++,+.,-.;-infixl 9 *,/,*.,/.;+instance Show Nat where +    show O = "O"+    show (S k) = "s" ++ show k --- Integer primitives+instance Show Int where +    show = prim__intToStr -(+) : Int -> Int -> Int; [inline]-(+) x y = __addInt x y;+instance Show Integer where +    show = prim__bigIntToStr -(-) : Int -> Int -> Int; [inline]-(-) x y = __subInt x y;+instance Show Float where +    show = prim__floatToStr -(*) : Int -> Int -> Int; [inline]-(*) x y = __mulInt x y;+instance Show Char where +    show x = strCons x ""  -(/) : Int -> Int -> Int; [inline]-(/) x y = __divInt x y;+instance Show String where +    show = id -mod : Int -> Int -> Int; [inline]-mod x y = __modInt x y;+instance Show Bool where +    show True = "True"+    show False = "False" -(<) : Int -> Int -> Bool; [inline]-(<) x y = __intlt x y;+instance (Show a, Show b) => Show (a, b) where +    show (x, y) = "(" ++ show x ++ ", " ++ show y ++ ")" -(<=) : Int -> Int -> Bool; [inline]-(<=) x y = __intleq x y;+instance Show a => Show (List a) where +    show xs = "[" ++ show' xs ++ "]" where +        show' : Show a => List a -> String+        show' []        = ""+        show' [x]       = show x+        show' (x :: xs) = show x ++ ", " ++ show' xs -(>) : Int -> Int -> Bool; [inline]-(>) x y = __intgt x y;+instance Show a => Show (Vect a n) where +    show xs = "[" ++ show' xs ++ "]" where +        show' : Show a => Vect a n -> String+        show' []        = ""+        show' [x]       = show x+        show' (x :: xs) = show x ++ ", " ++ show' xs -(>=) : Int -> Int -> Bool; [inline]-(>=) x y = __intgeq x y;+instance Show a => Show (Maybe a) where +    show Nothing = "Nothing"+    show (Just x) = "Just " ++ show x -(==) : Int -> Int -> Bool; [inline]-(==) x y = __eq x y;+---- Monad instances -(/=) : Int -> Int -> Bool; [inline]-(/=) x y = not (__eq x y);+instance Monad IO where +    return t = io_return t+    b >>= k = io_bind b k -(<<) : Int -> Int -> Int; [inline]-(<<) x y = __shl x y;+instance Monad Maybe where +    return t = Just t -(>>) : Int -> Int -> Int; [inline]-(>>) x y = __shr x y;+    Nothing  >>= k = Nothing+    (Just x) >>= k = k x --- Floating point primitives+instance MonadPlus Maybe where +    mzero = Nothing -(+.) : Float -> Float -> Float; [inline]-(+.) x y = __addFloat x y;+    mplus (Just x) _       = Just x+    mplus Nothing (Just y) = Just y+    mplus Nothing Nothing  = Nothing -(-.) : Float -> Float -> Float; [inline]-(-.) x y = __subFloat x y;+instance Monad List where +    return x = [x]+    m >>= f = concatMap f m -(*.) : Float -> Float -> Float; [inline]-(*.) x y = __mulFloat x y;+instance MonadPlus List where +    mzero = []+    mplus = app -(/.) : Float -> Float -> Float; [inline]-(/.) x y = __divFloat x y;+---- Functor instances -(<.) : Float -> Float -> Bool; [inline]-(<.) x y = __floatlt x y;+instance Functor Maybe where +    fmap f (Just x) = Just (f x)+    fmap f Nothing  = Nothing -(<=.) : Float -> Float -> Bool; [inline]-(<=.) x y = __floatleq x y;+instance Functor List where +    fmap = map -(>.) : Float -> Float -> Bool; [inline]-(>.) x y = __floatgt x y;+---- Applicative instances -(>=.) : Float -> Float -> Bool; [inline]-(>=.) x y = __floatgeq x y;+instance Applicative Maybe where+    pure = Just -(==.) : Float -> Float -> Bool; [inline]-(==.) x y = __feq x y;+    (Just f) <$> (Just a) = Just (f a)+    Nothing  <$> Nothing  = Nothing --- String primitives -(++) : String -> String -> String; [inline]-(++) x y = __concat x y;+---- some mathematical operations +%include "math.h"+%lib "m" --- Function composition+exp : Float -> Float+exp x = prim__floatExp x -infixl 9 .;+log : Float -> Float+log x = prim__floatLog x -(.) : (b -> c) -> (a -> b) -> a -> c;-(.) f g x = f (g x);+pi : Float+pi = 3.141592653589793 -fst : (a & b) -> a; [inline]-fst (x, y) = x;+sin : Float -> Float+sin x = prim__floatSin x -snd : (a & b) -> b; [inline]-snd (x, y) = y;+cos : Float -> Float+cos x = prim__floatCos x -include "nat.idr";-include "maybe.idr";-include "io.idr";-include "either.idr";-include "tactics.idr";-include "vect.idr";-include "string.idr";+tan : Float -> Float+tan x = prim__floatTan x++asin : Float -> Float+asin x = prim__floatASin x++acos : Float -> Float+acos x = prim__floatACos x++atan : Float -> Float+atan x = prim__floatATan x++sqrt : Float -> Float+sqrt x = prim__floatSqrt x++floor : Float -> Float+floor x = prim__floatFloor x++ceiling : Float -> Float+ceiling x = prim__floatCeil x++---- Ranges++count : Num a => a -> a -> a -> List a+count a inc b = if a <= b then a :: count (a + inc) inc b+                          else []+  +syntax "[" [start] ".." [end] "]" +     = count start 1 end +syntax "[" [start] "," [next] ".." [end] "]" +     = count start (next - start) end ++---- More utilities++flip : (a -> b -> c) -> b -> a -> c+flip f x y = f y x++sum : Num a => List a -> a+sum = foldl (+) 0++prod : Num a => List a -> a+prod = foldl (*) 1++---- some basic io++putStr : String -> IO ()+putStr x = mkForeign (FFun "putStr" [FString] FUnit) x++putStrLn : String -> IO ()+putStrLn x = putStr (x ++ "\n")++print : Show a => a -> IO ()+print x = putStrLn (show x)++getLine : IO String+getLine = mkForeign (FFun "readStr" Nil FString)++putChar : Char -> IO ()+putChar c = mkForeign (FFun "putchar" [FChar] FUnit) c++getChar : IO Char+getChar = mkForeign (FFun "getchar" [] FChar)++---- some basic file handling++abstract +data File = FHandle Ptr++do_fopen : String -> String -> IO Ptr+do_fopen f m = mkForeign (FFun "fileOpen" [FString, FString] FPtr) f m++fopen : String -> String -> IO File+fopen f m = do h <- do_fopen f m+               return (FHandle h) ++data Mode = Read | Write | ReadWrite++openFile : String -> Mode -> IO File+openFile f m = fopen f (modeStr m) where +  modeStr : Mode -> String+  modeStr Read  = "r"+  modeStr Write = "w"+  modeStr ReadWrite = "r+"++do_fclose : Ptr -> IO ()+do_fclose h = mkForeign (FFun "fileClose" [FPtr] FUnit) h++closeFile : File -> IO ()+closeFile (FHandle h) = do_fclose h++do_fread : Ptr -> IO String+do_fread h = mkForeign (FFun "freadStr" [FPtr] FString) h++fread : File -> IO String+fread (FHandle h) = do_fread h++do_fwrite : Ptr -> String -> IO ()+do_fwrite h s = mkForeign (FFun "fputStr" [FPtr, FString] FUnit) h s++fwrite : File -> String -> IO ()+fwrite (FHandle h) s = do_fwrite h s++do_feof : Ptr -> IO Int+do_feof h = mkForeign (FFun "feof" [FPtr] FInt) h++feof : File -> IO Bool+feof (FHandle h) = do eof <- do_feof h+                      return (not (eof == 0)) ++nullPtr : Ptr -> IO Bool+nullPtr p = do ok <- mkForeign (FFun "isNull" [FPtr] FInt) p +               return (ok /= 0);++validFile : File -> IO Bool+validFile (FHandle h) = do x <- nullPtr h+                           return (not x)++while : |(test : IO Bool) -> |(body : IO ()) -> IO ()+while t b = do v <- t+               if v then do b+                            while t b+                    else return ()+               ++readFile : String -> IO String+readFile fn = do h <- openFile fn Read+                 c <- readFile' h ""+                 closeFile h+                 return c+  where +    readFile' : File -> String -> IO String+    readFile' h contents = +       do x <- feof h+          if not x then do l <- fread h+                           readFile' h (contents ++ l)+                   else return contents
+ lib/prelude/applicative.idr view
@@ -0,0 +1,13 @@+module prelude.applicative++import builtins++---- Applicative functors/Idioms++infixl 2 <$> ++class Applicative (f : Set -> Set) where +    pure  : a -> f a+    (<$>) : f (a -> b) -> f a -> f b ++
+ lib/prelude/cast.idr view
@@ -0,0 +1,49 @@+module prelude.cast++class Cast from to where+    cast : from -> to++-- String casts++instance Cast String Int where+    cast = prim__strToInt++instance Cast String Float where+    cast = prim__strToFloat++instance Cast String Integer where+    cast = prim__strToBigInt++-- Int casts++instance Cast Int String where+    cast = prim__intToStr++instance Cast Int Float where+    cast = prim__intToFloat++instance Cast Int Integer where+    cast = prim__intToBigInt ++instance Cast Int Char where+    cast = prim__intToChar++-- Float casts++instance Cast Float String where+    cast = prim__floatToStr++instance Cast Float Int where+    cast = prim__floatToInt++-- Integer casts++instance Cast Integer String where+    cast = prim__bigIntToStr++-- Char casts++instance Cast Char Int where+    cast = prim__charToInt++
+ lib/prelude/char.idr view
@@ -0,0 +1,34 @@+module prelude.char++import builtins++isUpper : Char -> Bool+isUpper x = x >= 'A' && x <= 'Z'++isLower : Char -> Bool+isLower x = x >= 'a' && x <= 'z'++isAlpha : Char -> Bool+isAlpha x = isUpper x || isLower x ++isDigit : Char -> Bool+isDigit x = (x >= '0' && x <= '9')++isAlphaNum : Char -> Bool+isAlphaNum x = isDigit x || isAlpha x++isSpace : Char -> Bool+isSpace x = x == ' '  || x == '\t' || x == '\r' ||+            x == '\n' || x == '\f' || x == '\v' ||+            x == '\xa0'++toUpper : Char -> Char+toUpper x = if (isLower x) +               then (prim__intToChar (prim__charToInt x - 32))+               else x++toLower : Char -> Char+toLower x = if (isUpper x)+               then (prim__intToChar (prim__charToInt x + 32))+               else x+
+ lib/prelude/either.idr view
@@ -0,0 +1,13 @@+module prelude.either++import builtins++data Either a b = Left a | Right b++choose : (b : Bool) -> Either (so b) (so (not b))+choose True = Left oh+choose False = Right oh++either : Either a b -> (a -> c) -> (b -> c) -> c+either (Left x)  l r = l x+either (Right x) l r = r x
+ lib/prelude/fin.idr view
@@ -0,0 +1,13 @@+module prelude.fin++import prelude.nat++data Fin : Nat -> Set where+    fO : Fin (S k)+    fS : Fin k -> Fin (S k)++instance Eq (Fin n) where+   fO == fO = True+   (fS k) == (fS k') = k == k'+   _ == _ = False+
+ lib/prelude/list.idr view
@@ -0,0 +1,104 @@+module prelude.list++import prelude.maybe+import builtins++%access public++infixr 7 :: ++data List a = Nil | (::) a (List a)++rev : List a -> List a+rev xs = revAcc [] xs where+  revAcc : List a -> List a -> List a+  revAcc acc []        = acc+  revAcc acc (x :: xs) = revAcc (x :: acc) xs++app : List a -> List a -> List a+app []        xs = xs+app (x :: xs) ys = x :: app xs ys++length : List a -> Int+length []        = 0+length (x :: xs) = 1 + length xs++take : Int -> List a -> List a+take 0 xs = []+take n [] = []+take n (x :: xs) = x :: take (n-1) xs++drop : Int -> List a -> List a+drop 0 xs = xs+drop n [] = []+drop n (x :: xs) = drop (n-1) xs++map : (a -> b) -> List a -> List b+map f []        = []+map f (x :: xs) = f x :: map f xs++concatMap : (a -> List b) -> List a -> List b+concatMap f [] = []+concatMap f (x :: xs) = app (f x) (concatMap f xs)++mapMaybe : (a -> Maybe b) -> List a -> List b+mapMaybe f [] = []+mapMaybe f (x :: xs) = case f x of+                           Nothing => mapMaybe f xs+                           Just v  => v :: mapMaybe f xs++foldl : (a -> b -> a) -> a -> List b -> a+foldl f a []        = a+foldl f a (x :: xs) = foldl f (f a x) xs++foldr : (a -> b -> b) -> b -> List a -> b+foldr f b []        = b+foldr f b (x :: xs) = f x (foldr f b xs)++filter : (y -> Bool) -> List y -> List y+filter pred [] = []+filter pred (x :: xs) = if (pred x) then (x :: filter pred xs)+                                    else (filter pred xs)++elem : Eq a => a -> List a -> Bool+elem x [] = False+elem x (y :: ys) = if (x == y) then True else (elem x ys)++lookup : Eq k => k -> List (k, v) -> Maybe v+lookup k [] = Nothing+lookup k ((x, v) :: xs) = if (x == k) then (Just v) else (lookup k xs)++sort : Ord a => List a -> List a+sort []  = []+sort [x] = [x]+sort xs = let (x, y) = split xs in+              merge (sort x) (sort y) where+    splitrec : List a -> List a -> (List a -> List a) -> (List a, List a)+    splitrec (_ :: _ :: xs) (y :: ys) zs = splitrec xs ys (zs . ((::) y))+    splitrec _              ys        zs = (zs [], ys)++    split : List a -> (List a, List a)+    split xs = splitrec xs xs id++    merge : Ord a => List a -> List a -> List a+    merge xs        []        = xs+    merge []        ys        = ys+    merge (x :: xs) (y :: ys) = if (x < y) then (x :: merge xs (y :: ys))+                                           else (y :: merge (x :: xs) ys)++span : (a -> Bool) -> List a -> (List a, List a)+span p [] = ([], [])+span p (x :: xs) with (p x) +   | True with (span p xs)+      | (ys, zs) = (x :: ys, zs)+   | False = ([], x :: xs)++break : (a -> Bool) -> List a -> (List a, List a)+break p = span (not . p)+  +split : (a -> Bool) -> List a -> List (List a)+split p [] = []+split p xs = case break p xs of+                  (chunk, []) => [chunk]+                  (chunk, (c :: rest)) => chunk :: split p rest+
+ lib/prelude/maybe.idr view
@@ -0,0 +1,12 @@+module prelude.maybe++data Maybe a = Nothing | Just a++maybe : |(def : b) -> (a -> b) -> Maybe a -> b+maybe n j Nothing  = n+maybe n j (Just x) = j x++maybe_bind : Maybe a -> (a -> Maybe b) -> Maybe b+maybe_bind Nothing k = Nothing+maybe_bind (Just x) k = k x+
+ lib/prelude/monad.idr view
@@ -0,0 +1,44 @@+module prelude.monad++-- Monads and Functors++import builtins++%access public++infixl 5 >>=++class Monad (m : Set -> Set) where +    return : a -> m a+    (>>=)  : m a -> (a -> m b) -> m b++class Functor (f : Set -> Set) where +    fmap : (a -> b) -> f a -> f b++class Monad m => MonadPlus (m : Set -> Set) where +    mplus : m a -> m a -> m a+    mzero : m a++guard : MonadPlus m => Bool -> m ()+guard True  = return ()+guard False = mzero++when : Monad m => Bool -> m () -> m ()+when True  f = f+when False _ = return ()++sequence : Monad m => List (m a) -> m (List a)+sequence []        = return []+sequence (x :: xs) = [ x' :: xs' | x' <- x, xs' <- sequence xs ]++sequence_ : Monad m => List (m a) -> m ()+sequence_ [] = return ()+sequence_ (x :: xs) = do x; sequence_ xs++mapM : Monad m => (a -> m b) -> List a -> m (List b)+mapM f xs = sequence (map f xs)++mapM_ : Monad m => (a -> m b) -> List a -> m ()+mapM_ f xs = sequence_ (map f xs)++
+ lib/prelude/nat.idr view
@@ -0,0 +1,124 @@+module prelude.nat++import builtins+import prelude.cast++%access public++data Nat = O | S Nat++instance Cast Nat Int where+    cast O = 0+    cast (S k) = 1 + cast k++plus : Nat -> Nat -> Nat+plus O     y = y+plus (S k) y = S (plus k y)++eqRespS : m = n -> S m = S n+eqRespS refl = refl++eqRespS' : S m = S n -> m = n+eqRespS' refl = refl++sub : Nat -> Nat -> Nat+sub O      y    = O+sub (S k) (S y) = sub k y+sub x      O    = x++mult : Nat -> Nat -> Nat+mult O     y = O+mult (S k) y = plus y (mult k y)++instance Eq Nat where +    O     == O     = True+    (S x) == (S y) = x == y+    O     == (S y) = False+    (S x) == O     = False++instance Ord Nat where+    compare O O     = EQ+    compare O (S k) = LT+    compare (S k) O = GT+    compare (S x) (S y) = compare x y++instance Num Nat where+    (+) = plus+    (-) = sub+    (*) = mult++    fromInteger 0 = O+    fromInteger n = if (n > 0) then (S (fromInteger (n-1))) else O++plusnO : (m : Nat) -> m + O = m+plusnO O     = refl+plusnO (S k) = eqRespS (plusnO k)++plusn_Sm : (n, m : Nat) -> (plus n (S m)) = S (plus n m)+plusn_Sm O     m = refl+plusn_Sm (S j) m = eqRespS (plusn_Sm _ _)++plus_commutes : (n : Nat) -> (m : Nat) -> n + m = m + n+plus_commutes O     m = sym (plusnO m)+plus_commutes (S k) m = let ih = plus_commutes k m in ?plus_commutes_Sk++plus_commutes_Sk = proof {+    intros;+    refine sym;+    rewrite sym ih;+    rewrite plusn_Sm m k;+    trivial;+}++plus_assoc : (n, m, p : Nat) -> n + (m + p) = (n + m) + p+plus_assoc O     m p = refl+plus_assoc (S k) m p = let ih = plus_assoc k m p in eqRespS ih++data Cmp : Nat -> Nat -> Set where+    cmpLT : (y : Nat) -> Cmp x (x + S y)+    cmpEQ : Cmp x x+    cmpGT : (x : Nat) -> Cmp (y + S x) y+  +cmp : (n, m : Nat) -> Cmp n m+cmp O     O     = cmpEQ+cmp (S n) O     = cmpGT _+cmp O     (S n) = cmpLT _+cmp (S x) (S y) with (cmp x y)+    cmp (S x) (S x)         | cmpEQ = cmpEQ+    cmp (S (y + S x)) (S y) | cmpGT _ = cmpGT _+    cmp (S x) (S (x + S y)) | cmpLT _ = cmpLT _+  +multnO : (n : Nat) -> (n * O) = O+multnO O     = refl+multnO (S k) = multnO k++multn_Sm : (n, m : Nat) -> n * S m = n + n * m+multn_Sm O     m = refl+multn_Sm (S k) m = let ih = multn_Sm k m in ?multnSmSk++mult_commutes : (n, m : Nat) -> n * m = m * n+mult_commutes O     m = ?mult_commO+mult_commutes (S k) m = let ih = mult_commutes k m in ?mult_commSk++mult_commSk = proof {+    intros;+    rewrite sym ih;+    rewrite multn_Sm m k;+    trivial;+}++mult_commO = proof {+    intro;+    rewrite multnO m;+    trivial;+}++multnSmSk = proof {+    intros;+    rewrite plus_commutes (mult k m) m;+    rewrite sym (plus_assoc k (mult k m) m);+    rewrite ih;+    rewrite plus_commutes m (mult k (S m));+    trivial;+}+
+ lib/prelude/strings.idr view
@@ -0,0 +1,64 @@+module prelude.strings++import builtins+import prelude.list+import prelude.char+import prelude.cast++-- Some more complex string operations++data StrM : String -> Set where+    StrNil : StrM ""+    StrCons : (x : Char) -> (xs : String) -> StrM (strCons x xs)++strHead' : (x : String) -> so (not (x == "")) -> Char+strHead' x p = prim__strHead x++strTail' : (x : String) -> so (not (x == "")) -> String+strTail' x p = prim__strTail x++-- we need the 'believe_me' because the operations are primitives++strM : (x : String) -> StrM x+strM x with (choose (not (x == "")))+  strM x | (Left p)  = believe_me (StrCons (strHead' x p) (strTail' x p))+  strM x | (Right p) = believe_me StrNil++unpack : String -> List Char+unpack s with (strM s)+  unpack ""             | StrNil = []+  unpack (strCons x xs) | (StrCons _ _) = x :: unpack xs++pack : List Char -> String+pack [] = ""+pack (x :: xs) = strCons x (pack xs)++instance Cast String (List Char) where+    cast = unpack++instance Cast (List Char) String where+    cast = pack++span : (Char -> Bool) -> String -> (String, String)+span p xs with (strM xs)+  span p ""             | StrNil        = ("", "")+  span p (strCons x xs) | (StrCons _ _) with (p x)+    | True with (span p xs)+      | (ys, zs) = (strCons x ys, zs)+    | False = ("", strCons x xs)++break : (Char -> Bool) -> String -> (String, String)+break p = span (not . p)++split : (Char -> Bool) -> String -> List String+split p xs = map pack (split p (unpack xs))++ltrim : String -> String+ltrim xs with (strM xs)+    ltrim "" | StrNil = ""+    ltrim (strCons x xs) | StrCons _ _+        = if (isSpace x) then (ltrim xs) else (strCons x xs)++trim : String -> String+trim xs = ltrim (rev (ltrim (rev xs)))+
+ lib/prelude/vect.idr view
@@ -0,0 +1,56 @@+module prelude.vect++import prelude.nat+import prelude.fin++%access public++infixr 7 :: ++data Vect : Set -> Nat -> Set where+    Nil   : Vect a O+    (::)  : a -> Vect a k -> Vect a (S k) ++tail : Vect a (S n) -> Vect a n+tail (x :: xs) = xs++lookup : Fin n -> Vect a n -> a+lookup fO     (x :: xs) = x+lookup (fS k) (x :: xs) = lookup k xs+lookup fO      [] impossible+lookup (fS _)  [] impossible+ +app : Vect a n -> Vect a m -> Vect a (n + m)+app []        ys = ys+app (x :: xs) ys = x :: app xs ys++filter : (a -> Bool) -> Vect a n -> (p ** Vect a p)+filter p [] = ( _ ** [] )+filter p (x :: xs) +    = let (_ ** xs') = filter p xs in+          if (p x) then ( _ ** x :: xs' ) else ( _ ** xs' )++map : (a -> b) -> Vect a n -> Vect b n+map f [] = []+map f (x :: xs) = f x :: map f xs++rev : Vect a n -> Vect a n+rev xs = revAcc [] xs where+  revAcc : Vect a n -> Vect a m -> Vect a (n + m)+  revAcc acc []        ?= acc+  revAcc acc (x :: xs) ?= revAcc (x :: acc) xs++---------- Proofs ----------++revAcc_lemma_2 = proof {+    intros;+    rewrite sym (plusn_Sm n k);+    exact value;+}++revAcc_lemma_1 = proof {+    intros;+    rewrite sym (plusnO n);+    exact value;+}+
− lib/state.idr 
@@ -1,29 +0,0 @@-namespace State {--  State : Set -> Set -> Set;-  State s a = s -> (a & s);--  bind : State s a -> (a -> State s b) -> State s b;-  bind fa k state with fa state {-     | (av, state') = k av state';-  }--  ret : a -> State s a;-  ret av state = (av, state);--  get : State s s;-  get state = (state, state);--  put : s -> State s ();-  put state _ = (II, state);--  runState : State s a -> s -> (a & s);-  runState s init = s init;--  execState : State s a -> s -> s;-  execState s init = snd (runState s init);--  evalState : State s a -> s -> a;-  evalState s init = fst (runState s init);--}
− lib/string.idr 
@@ -1,247 +0,0 @@-include "list.idr";--strLen: String -> Int; [inline]-strLen str = __strlen str;--strEq: String -> String -> Bool; [inline]-strEq s1 s2 = __strEq s1 s2;--charEq : Char -> Char -> Bool; [inline]-charEq c1 c2 = __charToInt c1 == __charToInt c2;--concat: String -> String -> String; [inline]-concat s1 s2 = __concat s1 s2;--strNull: String -> Bool; [inline]-strNull s = strEq s "";--strHead: String -> Maybe Char; [inline]-strHead s = if (strNull s) then Nothing else (Just (__strHead s));--strTail: String -> Maybe String; [inline]-strTail s = if (strNull s) then Nothing else (Just (__strTail s));--strRev : String -> String; [inline]-strRev s = __strRev s;--substr : String -> Int -> Int -> String; [inline]-substr s start len = __substr s start len;--strFind : String -> Char -> Int; [inline]-strFind s c = __strFind s c;--strSplit : Char -> String -> (String & String);-strSplit c str = let idx = strFind str c in-	 if (idx == (-1)) then (str, "") else-	 (substr str 0 idx, substr str (idx+1) (strLen str - (idx+1)));---- Some more, faster, string manipulations--strHead' : (x:String) -> (so (not (strNull x))) -> Char;-strHead' x p = __strHead x;--strTail' : (x:String) -> (so (not (strNull x))) -> String;-strTail' x p = __strTail x;--strCons: Char -> String -> String; [inline]-strCons c s = __strCons c s;--strUncons: String -> Maybe (Char & String); [inline]-strUncons s with (strHead s, strTail s) {-  | (Just h,  Just t)  = Just (h, t);-  | (Nothing, Nothing) = Nothing;-}--{-- A view of strings, for better, faster, pattern matching --}--data StrM : String -> Set where-   StrNil : StrM ""- | StrCons : (x:Char) -> (xs:String) -> StrM (strCons x xs);--strM : (x:String) -> StrM x;-strM x with choose (strNull x) {-   | Left p ?= StrCons (strHead' x p) (strTail' x p);     [strMleft]-   | Right p ?= StrNil;                                   [strMright]-}--strMright proof {-  %intro;-  %believe value; -- it's a primitive operation, we have to believe it!-  %qed;-};--strMleft proof {-  %intro;-  %believe value; -- it's a primitive operation, we have to believe it!-  %qed;-};---charAt: Int -> String -> Maybe Char; [inline]-charAt x str =-  if (strLen str > x && x >= 0) then (Just (__strgetIdx str x))-                                else Nothing;--showInt: Int -> String; [inline]-showInt x = __toString x;--readInt: String -> Maybe Int;-readInt str = let x = __toInt str-              in  if (strEq str (showInt x))-                     then (Just x)-                     else Nothing;--showNat: Nat -> String;-showNat n = __toString (natToInt n);--readNat: String -> Maybe Nat;-readNat str with readInt str {-  | Just x  = if (x >= 0) then (Just (intToNat x)) else Nothing;-  | Nothing = Nothing;-}--showFloat: Float -> String;-showFloat n = __floatToString n;--strToList: String -> List Char;-strToList s with strUncons s {-  | Just (h, t) = Cons h (strToList t);-  | Nothing     = Nil;-}--listToStr: List Char -> String;-listToStr = foldr strCons "";---- TODO if the change to the parser breaks things, the sigma pattern will---      need parens around-strToVect: String -> (n ** Vect Char n);-strToVect s with strUncons s {-    | Just (c, cs) with strToVect cs {-    | <| cs' |> = <| c :: cs' |>;-  }-  | Nothing      = <| VNil |>;-}--vectToStr: Vect Char n -> String;-vectToStr (h :: t) = strCons h (vectToStr t);-vectToStr VNil     = "";---data StrCmp = StrLT | StrEQ | StrGT;-strCmp: String -> String -> StrCmp;-strCmp s t =-  if      (__strLT s t) then StrLT-  else if (strEq s t)   then StrEQ-  else                       StrGT;--strSpan' : (Char -> Bool) -> String -> String -> (String & String);-strSpan' p str acc with strM str {-  strSpan' p "" acc | StrNil -         = (strRev acc, "");-  strSpan' p (strCons c cs) acc | StrCons _ _-         = if (p c) then (strSpan' p cs (strCons c acc))-    	      	    else (strRev acc, (strCons c cs));-}--strSpan : (Char -> Bool) -> String -> (String & String);-strSpan p str = strSpan' p str "";---- TODO: A collection of these in a Char library.--isSpace : Char -> Bool;-isSpace ' ' = True;-isSpace '\t' = True;-isSpace '\r' = True;-isSpace '\n' = True;-isSpace _ = False;--isNL : Char -> Bool;-isNL '\r' = True;-isNL '\n' = True;-isNL _ = False;--isAlpha : Char -> Bool;-isAlpha x = let a = __charToInt 'a' in-            let z = __charToInt 'z' in-            let A = __charToInt 'A' in-            let Z = __charToInt 'Z' in-	    let x' = __charToInt x in-	    (x' >= a && x' <= z) || (x' >= A && x' <= Z);--isDigit : Char -> Bool;-isDigit x = let a = __charToInt '0' in-            let z = __charToInt '9' in-	    let x' = __charToInt x in-	    (x' >= a && x' <= z);--words : String -> List String;-words str with (strSpan (not . isSpace) str) {-   | ("", "") = Nil;-   | (word, rest) with choose (strNull rest) {-       | Left rp with choose (strNull word) {-         | Left wp = Cons word (words (strTail' rest rp));-         | Right wp = words (strTail' rest rp);-         }-       | Right rp = Cons word Nil;-   }-}--lines : String -> List String;-lines str with (strSpan (not . isNL) str) {-   | ("", "") = Nil;-   | (line, rest) with choose (strNull rest) {-       | Left rp with choose (strNull line) {-         | Left wp = Cons line (lines (strTail' rest rp));-         | Right wp = lines (strTail' rest rp);-         }-       | Right rp = Cons line Nil;-   }-}---- Generic version of lines/words--splitBy : (Char -> Bool) -> String -> List String;-splitBy p str with (strSpan (not . p) str) {-   | ("", "") = Nil;-   | (word, rest) with choose (strNull rest) {-       | Left rp with choose (strNull word) {-         | Left wp = Cons word (splitBy p (strTail' rest rp));-         | Right wp = splitBy p (strTail' rest rp);-         }-       | Right rp = Cons word Nil;-   }-}--unlines : List String -> String;-unlines Nil = "";-unlines (Cons x xs) = x ++ "\n" ++ unlines xs;--unwords : List String -> String;-unwords Nil = "";-unwords (Cons x Nil) = x;-unwords (Cons x xs) = x ++ " " ++ unwords xs;--trimLeft : String -> String;-trimLeft str with (strSpan isSpace str) {-   | (spcs, rest) = rest;-}--trimRight : String -> String;-trimRight x = strRev (trimLeft (strRev x));--trim : String -> String;-trim x = trimLeft (strRev (trimLeft (strRev x)));--mapStr : (Char -> Char) -> String -> String;-mapStr f str with strM str {- mapStr f ""             | StrNil      = "";- mapStr f (strCons c cs) | StrCons _ _ = strCons (f c) (mapStr f cs);-}--toLower : Char -> Char;-toLower x = let xi = __charToInt x in-	    let Ai = __charToInt 'A' in-	    let ai = __charToInt 'a' in-	    let Zi = __charToInt 'Z' in-	    if (xi>=Ai && xi<=Zi) then (__intToChar (xi+ai-Ai)) else x;-
lib/system.idr view
@@ -1,18 +1,27 @@--- System/OS interaction functions+module system -namespace System {+import prelude -  numArgs = mkForeign (FFun "epic_numArgs" [] FInt); [%eval]-  getArgn = mkForeign (FFun "epic_getArg" [FInt] FStr); [%eval]+%access public -  getArgs' : List String -> Int -> IO (List String);-  getArgs' acc 0 = return acc;-  getArgs' acc n = do { arg <- getArgn (n-1);-                        getArgs' (Cons arg acc) (n-1); -                      };+getArgs : IO (List String)+getArgs = do n <- numArgs+             ga' [] 0 n +  where+    numArgs : IO Int+    numArgs = mkForeign (FFun "epic_numArgs" [] FInt) -  getArgs : IO (List String);-  getArgs = do { num <- numArgs;-                 getArgs' [] num; };+    getArg : Int -> IO String+    getArg x = mkForeign (FFun "epic_getArg" [FInt] FString) x -}+    ga' : List String -> Int -> Int -> IO (List String)+    ga' acc i n = if (i == n) then (return $ rev acc) else+                    do arg <- getArg i+                       ga' (arg :: acc) (i+1) n++getEnv : String -> IO String+getEnv x = mkForeign (FFun "getenv" [FString] FString) x++exit : Int -> IO ()+exit code = mkForeign (FFun "exit" [FInt] FUnit) code+
− lib/tactics.idr 
@@ -1,11 +0,0 @@-data Tactic : Set where-    TFill : {a:Set} -> a -> Tactic-  | TRefine : String -> Tactic-  | TTrivial : Tactic-  | TDecide : {a:Set} -> Maybe a -> Tactic-  | TSearchContext : Tactic-  | TTry : Tactic -> Tactic -> Tactic-  | TSeq : Tactic -> Tactic -> Tactic-  | TThen : Tactic -> Tactic -> Tactic-  | TThenAll : Tactic -> Tactic -> Tactic-  | TFail : String -> Tactic;
− lib/vect.idr 
@@ -1,71 +0,0 @@-include "nat.idr";--infixr 5 ::;--data Vect : Set -> Nat -> Set where-   VNil : Vect A O- | (::) : A -> (Vect A k) -> (Vect A (S k));--data Fin : Nat -> Set where-   fO : Fin (S k)- | fS : (Fin k) -> (Fin (S k));--finToNat : Fin k -> Nat;-finToNat fO = O;-finToNat (fS k) = S (finToNat k);--natToFin : (x:Nat) -> Fin (S x);-natToFin O = fO;-natToFin (S k) = fS (natToFin k);--ltFin : Fin n -> Fin n -> Bool;-ltFin fO (fS x) = True;-ltFin (fS x) fO = False;-ltFin fO fO = False;-ltFin (fS x) (fS y) = ltFin x y;--vlookup : (Fin k) -> (Vect A k) -> A;-vlookup fO (x :: xs) = x;-vlookup (fS k) (x :: xs) = vlookup k xs;--weakenFin : Fin n -> Fin (S n);-weakenFin fO = fO;-weakenFin (fS k) = fS (weakenFin k);--vmap : (A->B) -> (Vect A n) -> (Vect B n);-vmap f VNil = VNil;-vmap f (x :: xs) = f x :: vmap f xs;--vapp : (Vect A n) -> (Vect A m) -> (Vect A (plus n m));-vapp VNil ys = ys;-vapp (x :: xs) ys = x :: vapp xs ys;---- Membership predicate for vectors, and means to compute one.--using (A:Set, n:Nat, i:Fin n, x:A, y:A, xs:Vect A n) {--  data ElemIs : (Fin n) -> A -> (Vect A n) -> Set where-     first : (ElemIs fO x (x :: xs))-   | later : (ElemIs i x xs) -> (ElemIs (fS i) x (y :: xs));-}--elemIs : (i:Fin n) -> (xs:Vect A n) -> (ElemIs i (vlookup i xs) xs);-elemIs fO (x :: xs) = first;-elemIs (fS k) (x :: xs) = later (elemIs k xs);--isElemAuxO : {x:A} -> {xs: Vect A n} -> -	     (y:A) ->-	     (eq: (Maybe (x=y))) ->-	     (Maybe (ElemIs fO x (y :: xs)));-isElemAuxO {x=y} y (Just (refl _)) = Just first;-isElemAuxO y Nothing = Nothing;--isElem : (eq:(a:A)->(b:A)->(Maybe (a=b)))->-	 (i:Fin n) -> (x:A) -> (xs:Vect A n) -> (Maybe (ElemIs i x xs));-isElem eq i x VNil = Nothing;-isElem eq fO x (y :: xs) = isElemAuxO y (eq x y);-isElem eq (fS i) x (y :: xs) = mMap later (isElem eq i x xs);--vfoldl : (a -> b -> a) -> a -> (Vect b n) -> a;-vfoldl f z VNil = z;-vfoldl f z (x :: xs) = vfoldl f (f z x) xs;
+ src/Core/CaseTree.hs view
@@ -0,0 +1,216 @@+module Core.CaseTree(CaseDef(..), SC(..), CaseAlt(..), CaseTree,+                     simpleCase, small) where++import Core.TT++import Control.Monad.State+import Debug.Trace++data CaseDef = CaseDef [Name] SC+    deriving Show++data SC = Case Name [CaseAlt]+        | STerm Term+        | UnmatchedCase String -- error message+    deriving Show+{-! +deriving instance Binary SC +!-}++data CaseAlt = ConCase Name Int [Name] SC+             | ConstCase Const         SC+             | DefaultCase             SC+    deriving Show+{-! +deriving instance Binary CaseAlt +!-}++type CaseTree = SC+type Clause   = ([Pat], Term)+type CS = Int++-- simple terms can be inlined trivially - good for primitives in particular+small :: SC -> Bool+-- small (STerm t) = True+small _ = False++simpleCase :: Bool -> Bool -> [(Term, Term)] -> CaseDef+simpleCase tc cover [] +                 = CaseDef [] (UnmatchedCase "No pattern clauses")+simpleCase tc cover cs +                 = let pats    = map (\ (l, r) -> (toPats tc l, r)) cs+                       numargs = length (fst (head pats)) +                       ns      = take numargs args+                       tree    = evalState (match ns pats (defaultCase cover)) numargs in+                       CaseDef ns (prune tree)+    where args = map (\i -> MN i "e") [0..]+          defaultCase True = STerm Erased+          defaultCase False = UnmatchedCase "Error"++data Pat = PCon Name Int [Pat]+         | PConst Const+         | PV Name+         | PAny+    deriving Show++-- If there are repeated variables, take the *last* one (could be name shadowing+-- in a where clause, so take the most recent).++toPats :: Bool -> Term -> [Pat]+toPats tc f = reverse (toPat tc (getArgs f)) where+   getArgs (App f a) = a : getArgs f+   getArgs _ = []++toPat :: Bool -> [Term] -> [Pat]+toPat tc tms = evalState (mapM (\x -> toPat' x []) tms) []+  where+    toPat' (P (DCon t a) n _) args = do args' <- mapM (\x -> toPat' x []) args+                                        return $ PCon n t args'+    -- Typecase+    toPat' (P (TCon t a) n _) args | tc +                                   = do args' <- mapM (\x -> toPat' x []) args+                                        return $ PCon n t args'+    toPat' (Constant IType)   [] | tc = return $ PCon (UN "Int")    1 [] +    toPat' (Constant FlType)  [] | tc = return $ PCon (UN "Float")  2 [] +    toPat' (Constant ChType)  [] | tc = return $ PCon (UN "Char")   3 [] +    toPat' (Constant StrType) [] | tc = return $ PCon (UN "String") 4 [] +    toPat' (Constant PtrType) [] | tc = return $ PCon (UN "Ptr")    5 [] +    toPat' (Constant BIType)  [] | tc = return $ PCon (UN "Integer") 6 [] ++    toPat' (P Bound n _)      []   = do ns <- get+                                        if n `elem` ns +                                          then return PAny +                                          else do put (n : ns)+                                                  return (PV n)+    toPat' (App f a)          args = toPat' f (a : args)+    toPat' (Constant (I c)) [] = return $ PConst (I c) +    toPat' _                _  = return PAny+++data Partition = Cons [Clause]+               | Vars [Clause]++isVarPat (PV _ : ps , _) = True+isVarPat (PAny : ps , _) = True+isVarPat _               = False++isConPat (PCon _ _ _ : ps, _) = True+isConPat (PConst _   : ps, _) = True+isConPat _                    = False++partition :: [Clause] -> [Partition]+partition [] = []+partition ms@(m : _)+    | isVarPat m = let (vars, rest) = span isVarPat ms in+                       Vars vars : partition rest+    | isConPat m = let (cons, rest) = span isConPat ms in+                       Cons cons : partition rest+partition xs = error $ "Partition " ++ show xs++match :: [Name] -> [Clause] -> SC -- error case+                            -> State CS SC+match [] (([], ret) : _) err = return $ STerm ret -- run out of arguments+match vs cs err = mixture vs (partition cs) err++mixture :: [Name] -> [Partition] -> SC -> State CS SC+mixture vs [] err = return err+mixture vs (Cons ms : ps) err = do fallthrough <- mixture vs ps err+                                   conRule vs ms fallthrough+mixture vs (Vars ms : ps) err = do fallthrough <- mixture vs ps err+                                   varRule vs ms fallthrough++data ConType = CName Name Int -- named constructor+             | CConst Const -- constant, not implemented yet++data Group = ConGroup ConType -- Constructor+                      [([Pat], Clause)] -- arguments and rest of alternative++conRule :: [Name] -> [Clause] -> SC -> State CS SC+conRule (v:vs) cs err = do groups <- groupCons cs+                           caseGroups (v:vs) groups err++caseGroups :: [Name] -> [Group] -> SC -> State CS SC+caseGroups (v:vs) gs err = do g <- altGroups gs+                              return $ Case v g+  where+    altGroups [] = return [DefaultCase err]+    altGroups (ConGroup (CName n i) args : cs)+        = do g <- altGroup n i args+             rest <- altGroups cs+             return (g : rest)+    altGroups (ConGroup (CConst c) args : cs) +        = do g <- altConstGroup c args+             rest <- altGroups cs+             return (g : rest)++    altGroup n i gs = do (newArgs, nextCs) <- argsToAlt gs+                         matchCs <- match (newArgs ++ vs) nextCs err+                         return $ ConCase n i newArgs matchCs+    altConstGroup n gs = do (_, nextCs) <- argsToAlt gs+                            matchCs <- match vs nextCs err+                            return $ ConstCase n matchCs++argsToAlt :: [([Pat], Clause)] -> State CS ([Name], [Clause])+argsToAlt [] = return ([], [])+argsToAlt rs@((r, m) : _)+    = do newArgs <- getNewVars r+         return (newArgs, addRs rs)+  where +    getNewVars [] = return []+    getNewVars ((PV n) : ns) = do nsv <- getNewVars ns+                                  return (n : nsv)+    getNewVars (_ : ns) = do v <- getVar+                             nsv <- getNewVars ns+                             return (v : nsv)+    addRs [] = []+    addRs ((r, (ps, res)) : rs) = ((r++ps, res) : addRs rs)++getVar :: State CS Name+getVar = do v <- get; put (v+1); return (MN v "e")++groupCons :: [Clause] -> State CS [Group]+groupCons cs = gc [] cs+  where+    gc acc [] = return acc+    gc acc ((p : ps, res) : cs) = +        do acc' <- addGroup p ps res acc+           gc acc' cs+    addGroup p ps res acc = case p of+        PCon con i args -> return $ addg con i args (ps, res) acc+        PConst cval -> return $ addConG cval (ps, res) acc+        pat -> fail $ show pat ++ " is not a constructor or constant (can't happen)"++    addg con i conargs res [] = [ConGroup (CName con i) [(conargs, res)]]+    addg con i conargs res (g@(ConGroup (CName n j) cs):gs)+        | i == j = ConGroup (CName n i) (cs ++ [(conargs, res)]) : gs+        | otherwise = g : addg con i conargs res gs++    addConG con res [] = [ConGroup (CConst con) [([], res)]]+    addConG con res (g@(ConGroup (CConst n) cs) : gs)+        | con == n = ConGroup (CConst n) (cs ++ [([], res)]) : gs+        | otherwise = g : addConG con res gs++varRule :: [Name] -> [Clause] -> SC -> State CS SC+varRule (v : vs) alts err =+    do let alts' = map (repVar v) alts+       match vs alts' err+  where+    repVar v (PV p : ps , res) = (ps, subst p (P Bound v (V 0)) res)+    repVar v (PAny : ps , res) = (ps, res)++prune :: SC -> SC+prune (Case n alts) +    = let alts' = map pruneAlt $ +                      filter notErased alts in+          case alts' of+            [] -> STerm Erased+            as  -> Case n as+    where pruneAlt (ConCase n i ns sc) = ConCase n i ns (prune sc)+          pruneAlt (ConstCase c sc) = ConstCase c (prune sc)+          pruneAlt (DefaultCase sc) = DefaultCase (prune sc)++          notErased (DefaultCase (STerm Erased)) = False+          notErased _ = True+prune t = t++
+ src/Core/Constraints.hs view
@@ -0,0 +1,52 @@+module Core.Constraints(ucheck) where
+
+import Core.TT
+
+import Control.Applicative
+import Control.Arrow
+import Control.Monad.Error
+import Control.Monad.RWS
+import Control.Monad.State
+import Data.List
+import Data.Maybe
+import qualified Data.Map as M
+
+
+ucheck :: [(UConstraint, FC)] -> TC ()
+ucheck cs = acyclic rels (map fst (M.toList rels))
+  where lhs (ULT l _) = l
+        lhs (ULE l _) = l
+        rels = mkRels cs M.empty
+
+type Relations = M.Map UExp [(UConstraint, FC)]
+
+mkRels :: [(UConstraint, FC)] -> Relations -> Relations
+mkRels [] acc = acc
+mkRels ((c, f) : cs) acc 
+    = case M.lookup (lhs c) acc of
+            Nothing -> mkRels cs (M.insert (lhs c) [(c,f)] acc)
+            Just rs -> mkRels cs (M.insert (lhs c) ((c,f):rs) acc)
+  where lhs (ULT l _) = l
+        lhs (ULE l _) = l
+
+acyclic :: Relations -> [UExp] -> TC ()
+acyclic r cvs = checkCycle (FC "root" 0) r [] 0 cvs 
+  where
+    checkCycle :: FC -> Relations -> [UExp] -> Int -> [UExp] -> TC ()
+    checkCycle fc r path inc [] = return ()
+    checkCycle fc r path inc (c : cs)
+        = do check fc path inc c
+             -- Remove c from r since we know there's no cycles now
+             let r' = M.insert c [] r
+             checkCycle fc r' path inc cs
+
+    check fc path inc (UVar x) | x < 0 = return ()
+    check fc path inc cv
+        | inc > 0 && cv `elem` path = Error $ At fc UniverseError
+        | otherwise = case M.lookup cv r of
+                            Nothing       -> return ()
+                            Just cs -> mapM_ (next (cv:path) inc) cs
+    
+    next path inc (ULT l r, fc) = check fc path (inc + 1) r
+    next path inc (ULE l r, fc) = check fc path inc r
+
+ src/Core/CoreParser.hs view
@@ -0,0 +1,148 @@+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}++module Core.CoreParser(parseTerm, parseFile, parseDef, pTerm, iName, idrisDef) where++import Core.TT++import Text.ParserCombinators.Parsec+import Text.ParserCombinators.Parsec.Expr+import Text.ParserCombinators.Parsec.Language+import qualified Text.ParserCombinators.Parsec.Token as PTok++import Control.Monad.State+import Debug.Trace++type TokenParser a = PTok.TokenParser a++idrisDef = haskellDef { +              opStart = iOpStart,+              opLetter = iOpLetter,+              identLetter = identLetter haskellDef <|> lchar '.',+              reservedOpNames = [":", "..", "=", "\\", "|", "<-", "->", "=>", "**"],+              reservedNames = ["let", "in", "data", "Set", +                               "do", "dsl", "import", "impossible", +                               "case", "of",+                               "infix", "infixl", "infixr", "prefix",+                               "where", "with", "forall", "syntax", "proof",+                               "using", "params", "namespace", "class", "instance",+                               "public", "private", "abstract",+                               "Int", "Integer", "Float", "Char", "String", "Ptr"]+           } ++iOpStart = oneOf ":!#$%&*+./<=>?@\\^|-~"+iOpLetter = oneOf ":!#$%&*+./<=>?@\\^|-~"+--          <|> letter++lexer :: TokenParser a+lexer  = PTok.makeTokenParser idrisDef++whiteSpace= PTok.whiteSpace lexer+lexeme    = PTok.lexeme lexer+symbol    = PTok.symbol lexer+natural   = PTok.natural lexer+parens    = PTok.parens lexer+semi      = PTok.semi lexer+comma     = PTok.comma lexer+identifier= PTok.identifier lexer+reserved  = PTok.reserved lexer+operator  = PTok.operator lexer+reservedOp= PTok.reservedOp lexer+lchar = lexeme.char++type CParser a = GenParser Char a++parseFile = runParser pTestFile () "(input)"+parseDef = runParser pDef () "(input)"+parseTerm = runParser pTerm () "(input)"++pTestFile :: CParser a RProgram+pTestFile = do p <- many1 pDef ; eof+               return p++iName :: [String] -> CParser a Name+iName bad = do x <- identifier+               when (x `elem` bad) $ fail "Reserved identifier"+               return $ mkNS (reverse (parseName x))+  where+    mkNS [x] = UN x+    mkNS (x:xs) = NS (UN x) xs +    parseName x = case span (/= '.') x of+                       (x, "") -> [x]+                       (x, '.':y) -> x : parseName y++pDef :: CParser a (Name, RDef)+pDef = try (do x <- iName []; lchar ':'; ty <- pTerm+               lchar '='+               tm <- pTerm+               lchar ';'+               return (x, RFunction (RawFun ty tm)))+       <|> do x <- iName []; lchar ':'; ty <- pTerm; lchar ';'+              return (x, RConst ty)+       <|> do (x, d) <- pData; lchar ';'+              return (x, RData d)++app :: CParser a (Raw -> Raw -> Raw)+app = do whiteSpace ; return RApp++arrow :: CParser a (Raw -> Raw -> Raw)+arrow = do symbol "->" ; return $ \s t -> RBind (MN 0 "X") (Pi s) t++pTerm :: CParser a Raw+pTerm = try (do chainl1 pNoApp app)+           <|> pNoApp++pNoApp :: CParser a Raw+pNoApp = try (chainr1 pExp arrow)+           <|> pExp+pExp :: CParser a Raw+pExp = do lchar '\\'; x <- iName []; lchar ':'; ty <- pTerm+          symbol "=>";+          sc <- pTerm+          return (RBind x (Lam ty) sc)+       <|> try (do lchar '?'; x <- iName []; lchar ':'; ty <- pTerm+                   lchar '.';+                   sc <- pTerm+                   return (RBind x (Hole ty) sc))+       <|> try (do lchar '('; +                   x <- iName []; lchar ':'; ty <- pTerm+                   lchar ')';+                   symbol "->";+                   sc <- pTerm+                   return (RBind x (Pi ty) sc))+       <|> try (do lchar '('; +                   t <- pTerm+                   lchar ')'+                   return t)+       <|> try (do symbol "??";+                   x <- iName []; lchar ':'; ty <- pTerm+                   lchar '=';+                   val <- pTerm+                   sc <- pTerm+                   return (RBind x (Guess ty val) sc))+       <|> try (do reserved "let"; +                   x <- iName []; lchar ':'; ty <- pTerm+                   lchar '=';+                   val <- pTerm+                   reserved "in";+                   sc <- pTerm+                   return (RBind x (Let ty val) sc))+       <|> try (do lchar '_'; +                   x <- iName []; lchar ':'; ty <- pTerm+                   lchar '.';+                   sc <- pTerm+                   return (RBind x (PVar ty) sc))+       <|> try (do reserved "Set"+                   return RSet)+       <|> try (do x <- iName []+                   return (Var x))++pData :: CParser a (Name, RawDatatype)+pData = do reserved "data"; x <- iName []; lchar ':'; ty <- pTerm; reserved "where"+           cs <- many pConstructor+           return (x, RDatatype x ty cs)++pConstructor :: CParser a (Name, Raw)+pConstructor = do lchar '|'+                  c <- iName []; lchar ':'; ty <- pTerm+                  return (c, ty)+
+ src/Core/Elaborate.hs view
@@ -0,0 +1,435 @@+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, PatternGuards #-}++{- A high level language of tactic composition, for building+   elaborators from a high level language into the core theory.++   This is our interface to proof construction, rather than+   ProofState, because this gives us a language to build derived+   tactics out of the primitives.+-}++module Core.Elaborate(module Core.Elaborate, +                      module Core.ProofState) where++import Core.ProofState+import Core.TT+import Core.Evaluate+import Core.Typecheck++import Control.Monad.State+import Data.Char+import Data.List+import Debug.Trace++-- I don't really want this here, but it's useful for the test shell+data Command = Theorem Name Raw+             | Eval Raw+             | Quit+             | Print Name+             | Tac (Elab ())++data ElabState aux = ES (ProofState, aux) String (Maybe (ElabState aux))+  deriving Show+type Elab' aux a = StateT (ElabState aux) TC a+type Elab a = Elab' () a++proof :: ElabState aux -> ProofState+proof (ES (p, _) _ _) = p++saveState :: Elab' aux ()+saveState = do e@(ES p s _) <- get+               put (ES p s (Just e))++loadState :: Elab' aux ()+loadState = do (ES p s e) <- get+               case e of+                  Just st -> put st+                  _ -> fail "Nothing to undo"++erun :: FC -> Elab' aux a -> Elab' aux a+erun f elab = do s <- get+                 case runStateT elab s of+                    OK (a, s')     -> do put s'+                                         return a+                    Error (At f e) -> lift $ Error (At f e)+                    Error e        -> lift $ Error (At f e)++runElab :: aux -> Elab' aux a -> ProofState -> TC (a, ElabState aux)+runElab a e ps = runStateT e (ES (ps, a) "" Nothing)++execElab :: aux -> Elab' aux a -> ProofState -> TC (ElabState aux)+execElab a e ps = execStateT e (ES (ps, a) "" Nothing)++initElaborator :: Name -> Context -> Type -> ProofState+initElaborator = newProof++elaborate :: Context -> Name -> Type -> aux -> Elab' aux a -> TC (a, String)+elaborate ctxt n ty d elab = do let ps = initElaborator n ctxt ty+                                (a, ES ps' str _) <- runElab d elab ps+                                return (a, str)++updateAux :: (aux -> aux) -> Elab' aux ()+updateAux f = do ES (ps, a) l p <- get+                 put (ES (ps, f a) l p)++getAux :: Elab' aux aux+getAux = do ES (ps, a) _ _ <- get+            return a++processTactic' t = do ES (p, a) logs prev <- get+                      (p', log) <- lift $ processTactic t p+                      put (ES (p', a) (logs ++ log) prev)+                      return ()++-- Some handy gadgets for pulling out bits of state++-- get the global context+get_context :: Elab' aux Context+get_context = do ES p _ _ <- get+                 return (context (fst p))++-- get the proof term+get_term :: Elab' aux Term+get_term = do ES p _ _ <- get+              return (pterm (fst p))++-- get the local context at the currently in focus hole+get_env :: Elab' aux Env+get_env = do ES p _ _ <- get+             lift $ envAtFocus (fst p)++get_holes :: Elab' aux [Name]+get_holes = do ES p _ _ <- get+               return (holes (fst p))++-- get the current goal type+goal :: Elab' aux Type+goal = do ES p _ _ <- get+          b <- lift $ goalAtFocus (fst p)+          return (binderTy b)++-- typecheck locally+get_type :: Raw -> Elab' aux Type+get_type tm = do ctxt <- get_context+                 env <- get_env+                 (val, ty) <- lift $ check ctxt env tm+                 return (finalise ty)++-- get holes we've deferred for later definition+get_deferred :: Elab' aux [Name]+get_deferred = do ES p _ _ <- get+                  return (deferred (fst p))++get_inj :: Elab' aux [(Term, Term, Term)]+get_inj = do ES p _ _ <- get+             return (injective (fst p))++checkInjective :: (Term, Term, Term) -> Elab' aux ()+checkInjective (tm, l, r) = if isInjective tm then return ()+                                else lift $ tfail (NotInjective tm l r) ++-- get instance argument names+get_instances :: Elab' aux [Name]+get_instances = do ES p _ _ <- get+                   return (instances (fst p))++-- given a desired hole name, return a unique hole name+unique_hole :: Name -> Elab' aux Name+unique_hole n = do ES p _ _ <- get+                   let bs = bound_in (pterm (fst p)) ++ bound_in (ptype (fst p))+                   n' <- uniqueNameCtxt (context (fst p)) n (holes (fst p) ++ bs)+                   return n'+  where+    bound_in (Bind n b sc) = n : bi b ++ bound_in sc+      where+        bi (Let t v) = bound_in t ++ bound_in v+        bi (Guess t v) = bound_in t ++ bound_in v+        bi b = bound_in (binderTy b)+    bound_in (App f a) = bound_in f ++ bound_in a+    bound_in _ = []++uniqueNameCtxt :: Context -> Name -> [Name] -> Elab' aux Name+uniqueNameCtxt ctxt n hs +    | n `elem` hs = uniqueNameCtxt ctxt (nextName n) hs+    | [_] <- lookupTy Nothing n ctxt = uniqueNameCtxt ctxt (nextName n) hs+    | otherwise = return n++elog :: String -> Elab' aux ()+elog str = do ES p logs prev <- get+              put (ES p (logs ++ str ++ "\n") prev)++-- The primitives, from ProofState++attack :: Elab' aux ()+attack = processTactic' Attack++claim :: Name -> Raw -> Elab' aux ()+claim n t = processTactic' (Claim n t)++exact :: Raw -> Elab' aux ()+exact t = processTactic' (Exact t)++fill :: Raw -> Elab' aux ()+fill t = processTactic' (Fill t)++prep_fill :: Name -> [Name] -> Elab' aux ()+prep_fill n ns = processTactic' (PrepFill n ns)++complete_fill :: Elab' aux ()+complete_fill = processTactic' CompleteFill++solve :: Elab' aux ()+solve = processTactic' Solve++start_unify :: Name -> Elab' aux ()+start_unify n = processTactic' (StartUnify n)++end_unify :: Elab' aux ()+end_unify = processTactic' EndUnify++regret :: Elab' aux ()+regret = processTactic' Regret++compute :: Elab' aux ()+compute = processTactic' Compute++eval_in :: Raw -> Elab' aux ()+eval_in t = processTactic' (EvalIn t)++check_in :: Raw -> Elab' aux ()+check_in t = processTactic' (CheckIn t)++intro :: Maybe Name -> Elab' aux ()+intro n = processTactic' (Intro n)++introTy :: Raw -> Maybe Name -> Elab' aux ()+introTy ty n = processTactic' (IntroTy ty n)++forall :: Name -> Raw -> Elab' aux ()+forall n t = processTactic' (Forall n t)++letbind :: Name -> Raw -> Raw -> Elab' aux ()+letbind n t v = processTactic' (LetBind n t v)++rewrite :: Raw -> Elab' aux ()+rewrite tm = processTactic' (Rewrite tm)++patvar :: Name -> Elab' aux ()+patvar n = do env <- get_env+              if (n `elem` map fst env) then do apply (Var n) []; solve+                else do n' <- case n of+                                    UN _ -> return n+                                    MN _ _ -> unique_hole n+                                    NS _ _ -> return n+                        processTactic' (PatVar n')++patbind :: Name -> Elab' aux ()+patbind n = processTactic' (PatBind n)++focus :: Name -> Elab' aux ()+focus n = processTactic' (Focus n)++movelast :: Name -> Elab' aux ()+movelast n = processTactic' (MoveLast n)++defer :: Name -> Elab' aux ()+defer n = do n' <- unique_hole n+             processTactic' (Defer n')++instanceArg :: Name -> Elab' aux ()+instanceArg n = processTactic' (Instance n)++proofstate :: Elab' aux ()+proofstate = processTactic' ProofState++reorder_claims :: Name -> Elab' aux ()+reorder_claims n = processTactic' (Reorder n)++qed :: Elab' aux Term+qed = do processTactic' QED+         ES p _ _ <- get+         return (pterm (fst p))++undo :: Elab' aux ()+undo = processTactic' Undo++prepare_apply :: Raw -> [Bool] -> Elab' aux [Name]+prepare_apply fn imps =+    do ty <- get_type fn+       ctxt <- get_context+       env <- get_env+       -- let claims = getArgs ty imps+       claims <- mkClaims (normalise ctxt env ty) imps []+       ES (p, a) s prev <- get+       -- reverse the claims we made so that args go left to right+       let n = length (filter not imps)+       let (h : hs) = holes p+       put (ES (p { holes = h : (reverse (take n hs) ++ drop n hs) }, a) s prev)+--        case claims of+--             [] -> return ()+--             (h : _) -> reorder_claims h+       return claims+  where+    mkClaims (Bind n' (Pi t) sc) (i : is) claims =+        do n <- unique_hole (mkMN n')+--            when (null claims) (start_unify n)+           let sc' = instantiate (P Bound n t) sc+           claim n (forget t)+           when i (movelast n)+           mkClaims sc' is (n : claims)+    mkClaims t [] claims = return (reverse claims)+    mkClaims _ _ _ = fail $ "Wrong number of arguments for " ++ show fn++    doClaim ((i, _), n, t) = do claim n t+                                when i (movelast n)++    mkMN n@(MN _ _) = n+    mkMN n@(UN x) = MN 0 x+    mkMN (NS n xs) = NS (mkMN n) xs++apply :: Raw -> [(Bool, Int)] -> Elab' aux [Name]+apply fn imps = +    do args <- prepare_apply fn (map fst imps)+       fill (raw_apply fn (map Var args))+       -- *Don't* solve the arguments we're specifying by hand.+       -- (remove from unified list before calling end_unify)+       -- HMMM: Actually, if we get it wrong, the typechecker will complain!+       -- so do nothing+       ptm <- get_term+       let dontunify = [] -- map fst (filter (not.snd) (zip args (map fst imps)))+       ES (p, a) s prev <- get+       let (n, hs) = unified p+       let unify = (n, filter (\ (n, t) -> not (n `elem` dontunify)) hs)+       put (ES (p { unified = unify }, a) s prev)+       end_unify+       return (map (updateUnify hs) args)+  where updateUnify hs n = case lookup n hs of+                                Just (P _ t _) -> t+                                _ -> n++apply2 :: Raw -> [Maybe (Elab' aux ())] -> Elab' aux () +apply2 fn elabs = +    do args <- prepare_apply fn (map isJust elabs)+       fill (raw_apply fn (map Var args))+       elabArgs args elabs+       ES (p, a) s prev <- get+       let (n, hs) = unified p+       end_unify+       solve+  where elabArgs [] [] = return ()+        elabArgs (n:ns) (Just e:es) = do focus n; e+                                         elabArgs ns es+        elabArgs (n:ns) (_:es) = elabArgs ns es++        isJust (Just _) = False +        isJust _        = True++apply_elab :: Name -> [Maybe (Int, Elab' aux ())] -> Elab' aux ()+apply_elab n args = +    do ty <- get_type (Var n)+       ctxt <- get_context+       env <- get_env+       claims <- doClaims (normalise ctxt env ty) args []+       prep_fill n (map fst claims)+       let eclaims = sortBy (\ (_, x) (_,y) -> priOrder x y) claims+       elabClaims [] False claims+       complete_fill+       end_unify+  where+    priOrder Nothing Nothing = EQ+    priOrder Nothing _ = LT+    priOrder _ Nothing = GT+    priOrder (Just (x, _)) (Just (y, _)) = compare x y++    doClaims (Bind n' (Pi t) sc) (i : is) claims =+        do n <- unique_hole (mkMN n')+           when (null claims) (start_unify n)+           let sc' = instantiate (P Bound n t) sc+           claim n (forget t)+           doClaims sc' is ((n, i) : claims)+    doClaims t [] claims = return (reverse claims)+    doClaims _ _ _ = fail $ "Wrong number of arguments for " ++ show n++    elabClaims failed r [] +        | null failed = return ()+        | otherwise = if r then elabClaims [] False failed+                           else return ()+    elabClaims failed r ((n, Nothing) : xs) = elabClaims failed r xs+    elabClaims failed r (e@(n, Just (_, elaboration)) : xs)+        | r = try (do ES p _ _ <- get+                      focus n; elaboration; elabClaims failed r xs)+                  (elabClaims (e : failed) r xs)+        | otherwise = do ES p _ _ <- get+                         focus n; elaboration; elabClaims failed r xs++    mkMN n@(MN _ _) = n+    mkMN n@(UN x) = MN 0 x+    mkMN (NS n ns) = NS (mkMN n) ns++simple_app :: Elab' aux () -> Elab' aux () -> Elab' aux ()+simple_app fun arg =+    do a <- unique_hole (MN 0 "a")+       b <- unique_hole (MN 0 "b")+       f <- unique_hole (MN 0 "f")+       s <- unique_hole (MN 0 "s")+       claim a RSet+       claim b RSet+       claim f (RBind (MN 0 "aX") (Pi (Var a)) (Var b))+       start_unify s+       claim s (Var a)+       prep_fill f [s]+       -- try elaborating in both orders, since we might learn something useful+       -- either way+       try (do focus s; arg+               focus f; fun)+           (do focus f; fun+               focus s; arg)+       complete_fill+       end_unify++-- Abstract over an argument of unknown type, giving a name for the hole+-- which we'll fill with the argument type too.+arg :: Name -> Name -> Elab' aux ()+arg n tyhole = do ty <- unique_hole tyhole+                  claim ty RSet+                  forall n (Var ty)++-- Try a tactic, if it fails, try another+try :: Elab' aux a -> Elab' aux a -> Elab' aux a+try t1 t2 = do s <- get+               case runStateT t1 s of+                    OK (v, s') -> do put s'+                                     return v+                    Error e1 -> do put s+                                   case runStateT t2 s of+                                     OK (v, s') -> do put s'; return v+                                     Error e2 -> if score e1 > score e2 +                                                    then lift (tfail e1) +                                                    else lift (tfail e2)+                        +-- Try a selection of tactics. Exactly one must work, all others must fail+tryAll :: [(Elab' aux a, String)] -> Elab' aux a+tryAll xs = tryAll' [] (cantResolve, 0) (map fst xs)+  where+    cantResolve :: Elab' aux a+    cantResolve = fail $ "Couldn't resolve alternative: " +                                  ++ showSep ", " (map snd xs)++    tryAll' :: [Elab' aux a] -> -- successes+               (Elab' aux a, Int) -> -- smallest failure+               [Elab' aux a] -> -- still to try+               Elab' aux a+    tryAll' [res] _   [] = res+    tryAll' (_:_) _   [] = cantResolve+    tryAll' [] (f, _) [] = f+    tryAll' cs f (x:xs) = do s <- get+                             case runStateT x s of+                                    OK (v, s') -> tryAll' ((do put s'+                                                               return v):cs)  f xs+                                    Error err -> do put s+                                                    tryAll' cs (better err f) xs++    better err (f, i) = let s = score err in+                            if (s >= i) then (lift (tfail err), s)+                                        else (f, i)+
+ src/Core/Evaluate.hs view
@@ -0,0 +1,596 @@+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances,+             PatternGuards #-}++module Core.Evaluate(normalise, normaliseC, normaliseAll,+                simplify, specialise, hnf,+                Def(..), Accessibility(..), +                Context, initContext, ctxtAlist, uconstraints, next_tvar,+                addToCtxt, setAccess, addCtxtDef, addTyDecl, addDatatype, +                addCasedef, addOperator,+                lookupTy, lookupP, lookupDef, lookupVal, lookupTyEnv, isConName,+                Value(..)) where++import Debug.Trace+import Control.Monad.State+import qualified Data.Binary as B+import Data.Binary hiding (get, put)++import Core.TT+import Core.CaseTree++type EvalState = ()+type Eval a = State EvalState a++data EvalOpt = Spec | HNF | Simplify | AtREPL+  deriving (Show, Eq)++-- VALUES (as HOAS) ---------------------------------------------------------++data Value = VP NameType Name Value+           | VV Int+           | VBind Name (Binder Value) (Value -> Eval Value)+           | VApp Value Value+           | VSet UExp+           | VErased+           | VConstant Const+           | VTmp Int++data HNF = HP NameType Name (TT Name)+         | HV Int+         | HBind Name (Binder HNF) (HNF -> Eval HNF)+         | HApp HNF [HNF] [TT Name]+         | HSet UExp+         | HConstant Const+         | HTmp Int+    deriving Show++instance Show Value where+    show x = show $ evalState (quote 10 x) ()++instance Show (a -> b) where+    show x = "<<fn>>"++-- THE EVALUATOR ------------------------------------------------------------++-- The environment is assumed to be "locally named" - i.e., not de Bruijn +-- indexed.+-- i.e. it's an intermediate environment that we have while type checking or+-- while building a proof.++normaliseC :: Context -> Env -> TT Name -> TT Name+normaliseC ctxt env t +   = evalState (do val <- eval ctxt emptyContext env t []+                   quote 0 val) ()++normaliseAll :: Context -> Env -> TT Name -> TT Name+normaliseAll ctxt env t +   = evalState (do val <- eval ctxt emptyContext env t [AtREPL]+                   quote 0 val) ()++normalise :: Context -> Env -> TT Name -> TT Name+normalise ctxt env t +   = evalState (do val <- eval ctxt emptyContext (map finalEntry env) (finalise t) []+                   quote 0 val) ()++specialise :: Context -> Ctxt [Bool] -> TT Name -> TT Name+specialise ctxt statics t +   = evalState (do val <- eval ctxt statics [] (finalise t) [Spec]+                   quote 0 val) ()++-- Like normalise, but we only reduce functions that are marked as okay to +-- inline (and probably shouldn't reduce lets?)++simplify :: Context -> Env -> TT Name -> TT Name+simplify ctxt env t +   = evalState (do val <- eval ctxt emptyContext (map finalEntry env) (finalise t) [Simplify]+                   quote 0 val) ()++hnf :: Context -> Env -> TT Name -> TT Name+hnf ctxt env t +   = evalState (do val <- eval ctxt emptyContext (map finalEntry env) (finalise t) [HNF]+                   quote 0 val) ()+++-- unbindEnv env (quote 0 (eval ctxt (bindEnv env t)))++finalEntry :: (Name, Binder (TT Name)) -> (Name, Binder (TT Name))+finalEntry (n, b) = (n, fmap finalise b)++bindEnv :: EnvTT n -> TT n -> TT n+bindEnv [] tm = tm+bindEnv ((n, Let t v):bs) tm = Bind n (NLet t v) (bindEnv bs tm)+bindEnv ((n, b):bs)       tm = Bind n b (bindEnv bs tm)++unbindEnv :: EnvTT n -> TT n -> TT n+unbindEnv [] tm = tm+unbindEnv (_:bs) (Bind n b sc) = unbindEnv bs sc++-- Evaluate in a context of locally named things (i.e. not de Bruijn indexed,+-- such as we might have during construction of a proof)++eval :: Context -> Ctxt [Bool] -> Env -> TT Name -> [EvalOpt] -> Eval Value+eval ctxt statics genv tm opts = ev [] True [] tm where+    spec = Spec `elem` opts+    simpl = Simplify `elem` opts+    atRepl = AtREPL `elem` opts++    ev stk top env (P _ n ty)+        | Just (Let t v) <- lookup n genv = ev stk top env v +    ev stk top env (P Ref n ty) = case lookupDefAcc Nothing n atRepl ctxt of+        [(Function _ tm, Public)] -> +            ev (n:stk) True env tm+        [(TyDecl nt ty, _)]       -> do vty <- ev stk True env ty+                                        return $ VP nt n vty+        [(CaseOp inl _ _ [] tree _ _, Public)] -> -- unoptimised version+           if simpl && (not inl || elem n stk) +              then liftM (VP Ref n) (ev stk top env ty)+              else do c <- evCase (n:stk) top env [] [] tree +                      case c of+                        (Nothing, _) -> liftM (VP Ref n) (ev stk top env ty)+                        (Just v, _)  -> return v+        _ -> liftM (VP Ref n) (ev stk top env ty)+    ev stk top env (P nt n ty)   = liftM (VP nt n) (ev stk top env ty)+    ev stk top env (V i) | i < length env = return $ env !! i+                     | otherwise      = return $ VV i +    ev stk top env (Bind n (Let t v) sc)+           = do v' <- ev stk top env v --(finalise v)+                sc' <- ev stk top (v' : env) sc+                wknV (-1) sc'+    ev stk top env (Bind n (NLet t v) sc)+           = do t' <- ev stk top env (finalise t)+                v' <- ev stk top env (finalise v)+                sc' <- ev stk top (v' : env) sc+                return $ VBind n (Let t' v') (\x -> return sc')+    ev stk top env (Bind n b sc) +           = do b' <- vbind env b+                return $ VBind n b' (\x -> ev stk top (x:env) sc)+       where vbind env t = fmapMB (\tm -> ev stk top env (finalise tm)) t+    ev stk top env (App f a) = do f' <- ev stk top env f+                                  a' <- ev stk False env a+                                  evApply stk top env [a'] f'+    ev stk top env (Constant c) = return $ VConstant c+    ev stk top env Erased    = return VErased+    ev stk top env (Set i)   = return $ VSet i+    +    evApply stk top env args (VApp f a) = +            evApply stk top env (a:args) f+    evApply stk top env args f = apply stk top env f args++    apply stk top env (VBind n (Lam t) sc) (a:as) +        = do a' <- sc a+             app <- apply stk top env a' as +             wknV (-1) app+    apply stk False env f args+        | spec = return $ unload env f args+    apply stk top env (VP Ref n ty)        args+        | [(CaseOp inl _ _ ns tree _ _, Public)] <- lookupDefAcc Nothing n atRepl ctxt+            = -- traceWhen (n == UN ["interp"]) (show (n, args)) $+              if simpl && (not inl || elem n stk) +                 then return $ unload env (VP Ref n ty) args+                 else do c <- evCase (n:stk) top env ns args tree+                         case c of+                           (Nothing, _) -> return $ unload env (VP Ref n ty) args+                           (Just v, rest) -> evApply stk top env rest v+        | [Operator _ i op]  <- lookupDef Nothing n ctxt+            = if (i <= length args)+                 then case op (take i args) of+                    Nothing -> return $ unload env (VP Ref n ty) args+                    Just v  -> evApply stk top env (drop i args) v+                 else return $ unload env (VP Ref n ty) args+    apply stk top env f (a:as) = return $ unload env f (a:as)+    apply stk top env f []     = return f++    unload env f [] = f+    unload env f (a:as) = unload env (VApp f a) as++    evCase stk top env ns args tree+        | length ns <= length args +             = do let args' = take (length ns) args+                  let rest  = drop (length ns) args+                  t <- evTree stk top env (zipWith (\n t -> (n, t)) ns args') tree+                  return (t, rest)+        | otherwise = return (Nothing, args)++    evTree :: [Name] -> Bool -> [Value] -> [(Name, Value)] -> SC -> Eval (Maybe Value)+    evTree stk top env amap (UnmatchedCase str) = return Nothing+    evTree stk top env amap (STerm tm) +        = do let etm = pToVs (map fst amap) tm+             etm' <- ev stk top (map snd amap ++ env) etm+             return $ Just etm'+    evTree stk top env amap (Case n alts)+        = case lookup n amap of+            Just v -> do c <- chooseAlt env v (getValArgs v) alts amap+                         case c of+                            Just (altmap, sc) -> evTree stk top env altmap sc+                            _ -> do c' <- chooseAlt' stk env v (getValArgs v) alts amap+                                    case c' of+                                        Just (altmap, sc) -> evTree stk top env altmap sc+                                        _ -> return Nothing+            _ -> return Nothing++    chooseAlt' stk env _ (f, args) alts amap+        = do f' <- apply stk True env f args+             chooseAlt env f' (getValArgs f') alts amap++    chooseAlt :: [Value] -> Value -> (Value, [Value]) -> [CaseAlt] -> [(Name, Value)] ->+                 Eval (Maybe ([(Name, Value)], SC))+    chooseAlt env _ (VP (DCon i a) _ _, args) alts amap+        | Just (ns, sc) <- findTag i alts = return $ Just (updateAmap (zip ns args) amap, sc)+        | Just v <- findDefault alts      = return $ Just (amap, v)+    chooseAlt env _ (VP (TCon i a) _ _, args) alts amap+        | Just (ns, sc) <- findTag i alts = return $ Just (updateAmap (zip ns args) amap, sc)+        | Just v <- findDefault alts      = return $ Just (amap, v)+    chooseAlt env _ (VConstant c, []) alts amap+        | Just v <- findConst c alts      = return $ Just (amap, v)+        | Just v <- findDefault alts      = return $ Just (amap, v)+    chooseAlt _ _ _ _ _                     = return Nothing++    -- Replace old variable names in the map with new matches+    -- (This is possibly unnecessary since we make unique names and don't+    -- allow repeated variables...?)+    updateAmap newm amap +       = newm ++ filter (\ (x, _) -> not (elem x (map fst newm))) amap+    findTag i [] = Nothing+    findTag i (ConCase n j ns sc : xs) | i == j = Just (ns, sc)+    findTag i (_ : xs) = findTag i xs++    findDefault [] = Nothing+    findDefault (DefaultCase sc : xs) = Just sc+    findDefault (_ : xs) = findDefault xs ++    findConst c [] = Nothing+    findConst c (ConstCase c' v : xs) | c == c' = Just v+    findConst IType   (ConCase n 1 [] v : xs) = Just v +    findConst FlType  (ConCase n 2 [] v : xs) = Just v +    findConst ChType  (ConCase n 3 [] v : xs) = Just v +    findConst StrType (ConCase n 4 [] v : xs) = Just v +    findConst PtrType (ConCase n 5 [] v : xs) = Just v +    findConst c (_ : xs) = findConst c xs++    getValArgs tm = getValArgs' tm []+    getValArgs' (VApp f a) as = getValArgs' f (a:as)+    getValArgs' f as = (f, as)++class Quote a where+    quote :: Int -> a -> Eval (TT Name)++instance Quote Value where+    quote i (VP nt n v)    = liftM (P nt n) (quote i v)+    quote i (VV x)         = return $ V x+    quote i (VBind n b sc) = do sc' <- sc (VTmp i)+                                b' <- quoteB b+                                liftM (Bind n b') (quote (i+1) sc')+       where quoteB t = fmapMB (quote i) t+    quote i (VApp f a)     = liftM2 App (quote i f) (quote i a)+    quote i (VSet u)       = return $ Set u+    quote i VErased        = return $ Erased+    quote i (VConstant c)  = return $ Constant c+    quote i (VTmp x)       = return $ V (i - x - 1)++instance Quote HNF where+    quote i (HP nt n t)     = return (P nt n t)+    quote i (HV x)          = return $ V x+    quote i (HBind n b sc)  = do sc' <- sc (HTmp i)+                                 b' <- quoteB b+                                 liftM (Bind n b') (quote (i+1) sc')+        where quoteB t = fmapMB (quote i) t+    quote i (HApp f env as) = do f' <- quote i f+                                 as' <- mapM (iEnv env) as+                                 return $ mkApp f' as'+        where iEnv [] a = return a+              iEnv (x:xs) a = do x' <- quote i x+                                 iEnv xs (weakenTm (-1) (instantiate x' a))+    quote i (HSet u)        = return $ Set u+    quote i (HConstant c)   = return $ Constant c+    quote i (HTmp x)        = return $ V (i - x - 1)++wknV :: Int -> Value -> Eval Value+wknV i (VV x)         = return $ VV (x + i)+wknV i (VBind n b sc) = do b' <- fmapMB (wknV i) b+                           return $ VBind n b' (\x -> do x' <- sc x+                                                         wknV i x')+wknV i (VApp f a)     = liftM2 VApp (wknV i f) (wknV i a)+wknV i t              = return t++wknH :: Int -> HNF -> Eval HNF+wknH i (HV x)          = return $ HV (x + i)+wknH i (HBind n b sc)  = do b' <- fmapMB (wknH i) b+                            return $ HBind n b' (\x -> do x' <- sc x+                                                          wknH i x') +wknH i (HApp f env as) = liftM3 HApp (wknH i f) (return env) +                                                (return as)+wknH i t               = return t++-- HEAD NORMAL FORM ---------------------------------------------------------++eval_hnf :: Context -> Ctxt [Bool] -> Env -> TT Name -> Eval HNF+eval_hnf ctxt statics genv tm = ev [] tm where+    ev :: [HNF] -> TT Name -> Eval HNF+    ev env (P _ n ty) +        | Just (Let t v) <- lookup n genv = ev env v+    ev env (P Ref n ty) = case lookupDef Nothing n ctxt of+        [Function _ t]           -> ev env t+        [TyDecl nt ty]           -> return $ HP nt n ty+        [CaseOp inl _ _ [] tree _ _] ->+            do c <- evCase env [] [] tree+               case c of+                   (Nothing, _, _) -> return $ HP Ref n ty+                   (Just v, _, _)  -> return v+        _ -> return $ HP Ref n ty+    ev env (P nt n ty) = return $ HP nt n ty+    ev env (V i) | i < length env = return $ env !! i+                 | otherwise      = return $ HV i+    ev env (Bind n (Let t v) sc)+        = do v' <- ev env (finalise v)+             sc' <- ev (v' : env) sc+             wknH (-1) sc'+    ev env (Bind n b sc)+        = do b' <- hbind env b+             return $ HBind n b' (\x -> ev (x : env) sc)+      where hbind env t = fmapMB (\tm -> ev env (finalise tm)) t+    ev env (App f a) = evApply env [a] f+    ev env (Constant c) = return $ HConstant c+    ev env (Set i) = return $ HSet i++    evApply env args (App f a) = evApply env (a : args) f+    evApply env args f = do f' <- ev env f+                            apply env f' args++    apply env (HBind n (Lam t) sc) (a:as) = do a' <- ev env a+                                               sc' <- sc a'+                                               app <- apply env sc' as+                                               wknH (-1) app+    apply env (HP Ref n ty) args+        | [CaseOp _ _ _ ns tree _ _] <- lookupDef Nothing n ctxt+            = do c <- evCase env ns args tree+                 case c of+                    (Nothing, _, env') -> return $ unload env' (HP Ref n ty) args+                    (Just v, rest, env') -> do v' <- quote 0 v+                                               apply env' v rest+--         | Just (Operator _ i op) <- lookupDef n ctxt+--             = if (i <= length args)+--                  then case op (take i args) of+--                     Nothing -> return $ unload env (HP Ref n ty) args+--                     Just v -> evApply env (drop i args) v+--                  else return $ unload env (HP Ref n ty) args+    apply env f (a:as) = return $ unload env f (a:as)+    apply env f []     = return f+    +    unload env f [] = f+    unload env f as = HApp f env as++    evCase env ns args tree+        | length ns <= length args +             = do let args' = take (length ns) args+                  let rest  = drop (length ns) args+                  (t, env') <- evTree env (zipWith (\n t -> (n, t)) ns args') tree+                  return (t, rest, env')+        | otherwise = return (Nothing, args, env)++    evTree :: [HNF] -> [(Name, TT Name)] -> SC -> Eval (Maybe HNF, [HNF])+    evTree env amap (UnmatchedCase str) = return (Nothing, env)+    evTree env amap (STerm tm) +        = do let etm = pToVs (map fst amap) tm+             amap' <- mapM (ev env) (map snd amap)+             envw <- mapM (wknH (length amap)) env+             let env' = amap' ++ envw+             etm' <- trace (show etm) $ ev env' etm+             etmq <- quote 0 etm'+             trace ("Ev: " ++ show (etm, etmq)) $ return $ (Just etm', env')+    evTree env amap (Case n alts)+        = case lookup n amap of+             Just v -> do v' <- ev env v+                          case chooseAlt v' (getValArgs v') alts amap of+                            Just (altmap, sc) -> evTree env altmap sc+                            _ -> return (Nothing, env)++    chooseAlt :: HNF -> (HNF, [HNF], [TT Name]) -> +                 [CaseAlt] -> [(Name, TT Name)] ->+                 Maybe ([(Name, TT Name)], SC)+    chooseAlt _ (HP (DCon i a) _ _, env, args) alts amap+        | Just (ns, sc) <- findTag i alts = Just (updateAmap (zip ns args) amap, sc)+        | Just v <- findDefault alts      = Just (amap, v)+    chooseAlt _ (HP (TCon i a) _ _, env, args) alts amap+        | Just (ns, sc) <- findTag i alts = Just (updateAmap (zip ns args) amap, sc)+        | Just v <- findDefault alts      = Just (amap, v)+    chooseAlt _ (HConstant c, env, []) alts amap+        | Just v <- findConst c alts      = Just (amap, v)+        | Just v <- findDefault alts      = Just (amap, v)+    chooseAlt _ _ _ _                     = Nothing++    -- Replace old variable names in the map with new matches+    -- (This is possibly unnecessary since we make unique names and don't+    -- allow repeated variables...?)+    updateAmap newm amap +       = newm ++ filter (\ (x, _) -> not (elem x (map fst newm))) amap+    findTag i [] = Nothing+    findTag i (ConCase n j ns sc : xs) | i == j = Just (ns, sc)+    findTag i (_ : xs) = findTag i xs++    findDefault [] = Nothing+    findDefault (DefaultCase sc : xs) = Just sc+    findDefault (_ : xs) = findDefault xs ++    findConst c [] = Nothing+    findConst c (ConstCase c' v : xs) | c == c' = Just v+    findConst IType   (ConCase n 1 [] v : xs) = Just v +    findConst FlType  (ConCase n 2 [] v : xs) = Just v +    findConst ChType  (ConCase n 3 [] v : xs) = Just v +    findConst StrType (ConCase n 4 [] v : xs) = Just v +    findConst PtrType (ConCase n 5 [] v : xs) = Just v +    findConst c (_ : xs) = findConst c xs++    getValArgs (HApp t env args) = (t, env, args)+    getValArgs t = (t, [], [])++-- SPECIALISATION -----------------------------------------------------------+-- We need too much control to be able to do this by tweaking the main +-- evaluator++spec :: Context -> Ctxt [Bool] -> Env -> TT Name -> Eval (TT Name)+spec ctxt statics genv tm = error "spec undefined" ++-- CONTEXTS -----------------------------------------------------------------++{- A definition is either a simple function (just an expression with a type),+   a constant, which could be a data or type constructor, an axiom or as an+   yet undefined function, or an Operator.+   An Operator is a function which explains how to reduce. +   A CaseOp is a function defined by a simple case tree -}+   +data Def = Function Type Term+         | TyDecl NameType Type +         | Operator Type Int ([Value] -> Maybe Value)+         | CaseOp Bool Type [(Term, Term)] -- Bool for inlineable+                  [Name] SC -- Compile time case definition+                  [Name] SC -- Run time cae definitions+{-! +deriving instance Binary Def +!-}++instance Show Def where+    show (Function ty tm) = "Function: " ++ show (ty, tm)+    show (TyDecl nt ty) = "TyDecl: " ++ show nt ++ " " ++ show ty+    show (Operator ty _ _) = "Operator: " ++ show ty+    show (CaseOp _ ty ps ns sc ns' sc') +        = "Case: " ++ show ty ++ " " ++ show ps ++ "\n" ++ +                                        show ns ++ " " ++ show sc ++ "\n" +++                                        show ns' ++ " " ++ show sc'+-- We need this for serialising Def. Fortunately, it never gets used because+-- we'll never serialise a primitive operator++instance Binary (a -> b) where+    put x = return ()+    get = error "Getting a function"++------- ++-- Frozen => doesn't reduce+-- Hidden => doesn't reduce and invisible to type checker++data Accessibility = Public | Frozen | Hidden+    deriving (Show, Eq)+{-!+deriving instance Binary Accessibility+!-}++data Context = MkContext { uconstraints :: [UConstraint],+                           next_tvar    :: Int,+                           definitions  :: Ctxt (Def, Accessibility) }++initContext = MkContext [] 0 emptyContext++ctxtAlist :: Context -> [(Name, Def)]+ctxtAlist ctxt = map (\(n, (d, a)) -> (n, d)) $ toAlist (definitions ctxt)++veval ctxt env t = evalState (eval ctxt emptyContext env t []) ()++addToCtxt :: Name -> Term -> Type -> Context -> Context+addToCtxt n tm ty uctxt +    = let ctxt = definitions uctxt +          ctxt' = addDef n (Function ty tm, Public) ctxt in+          uctxt { definitions = ctxt' } ++setAccess :: Name -> Accessibility -> Context -> Context+setAccess n a uctxt+    = let ctxt = definitions uctxt+          ctxt' = updateDef n (\ (d, _) -> (d, a)) ctxt in+          uctxt { definitions = ctxt' }++addCtxtDef :: Name -> Def -> Context -> Context+addCtxtDef n d c = let ctxt = definitions c+                       ctxt' = addDef n (d, Public) ctxt in+                       c { definitions = ctxt' }++addTyDecl :: Name -> Type -> Context -> Context+addTyDecl n ty uctxt +    = let ctxt = definitions uctxt+          ctxt' = addDef n (TyDecl Ref ty, Public) ctxt in+          uctxt { definitions = ctxt' }++addDatatype :: Datatype Name -> Context -> Context+addDatatype (Data n tag ty cons) uctxt+    = let ctxt = definitions uctxt +          ty' = normalise uctxt [] ty+          ctxt' = addCons 0 cons (addDef n +                    (TyDecl (TCon tag (arity ty')) ty, Public) ctxt) in+          uctxt { definitions = ctxt' }+  where+    addCons tag [] ctxt = ctxt+    addCons tag ((n, ty) : cons) ctxt +        = let ty' = normalise uctxt [] ty in+              addCons (tag+1) cons (addDef n+                  (TyDecl (DCon tag (arity ty')) ty, Public) ctxt)++addCasedef :: Name -> Bool -> Bool -> Bool -> [(Term, Term)] -> [(Term, Term)] ->+              Type -> Context -> Context+addCasedef n alwaysInline tcase covering ps psrt ty uctxt +    = let ctxt = definitions uctxt+          ps' = ps -- simpl ps in+          ctxt' = case (simpleCase tcase covering ps', +                        simpleCase tcase covering psrt) of+                    (CaseDef args sc, CaseDef args' sc') -> +                                       let inl = alwaysInline in+                                           addDef n (CaseOp inl ty ps args sc args' sc',+                                                     Public) ctxt in+          uctxt { definitions = ctxt' }+  where simpl [] = []+        simpl ((l,r) : xs) = (l, simplify uctxt [] r) : simpl xs++addOperator :: Name -> Type -> Int -> ([Value] -> Maybe Value) -> Context -> Context+addOperator n ty a op uctxt+    = let ctxt = definitions uctxt +          ctxt' = addDef n (Operator ty a op, Public) ctxt in+          uctxt { definitions = ctxt' }++lookupTy :: Maybe [String] -> Name -> Context -> [Type]+lookupTy root n ctxt +                = do def <- lookupCtxt root n (definitions ctxt)+                     case fst def of+                       (Function ty _) -> return ty+                       (TyDecl _ ty) -> return ty+                       (Operator ty _ _) -> return ty+                       (CaseOp _ ty _ _ _ _ _) -> return ty++isConName :: Maybe [String] -> Name -> Context -> Bool+isConName root n ctxt +     = or $ do def <- lookupCtxt root n (definitions ctxt)+               case fst def of+                    (TyDecl (DCon _ _) _) -> return True+                    (TyDecl (TCon _ _) _) -> return True+                    _ -> return False++lookupP :: Maybe [String] -> Name -> Context -> [Term]+lookupP root n ctxt +   = do def <-  lookupCtxt root n (definitions ctxt)+        p <- case def of+          (Function ty tm, a) -> return (P Ref n ty, a)+          (TyDecl nt ty, a) -> return (P nt n ty, a)+          (CaseOp _ ty _ _ _ _ _, a) -> return (P Ref n ty, a)+          (Operator ty _ _, a) -> return (P Ref n ty, a)+        case snd p of+            Hidden -> []+            _ -> return (fst p)++lookupDef :: Maybe [String] -> Name -> Context -> [Def]+lookupDef root n ctxt = map fst $ lookupCtxt root n (definitions ctxt)++lookupDefAcc :: Maybe [String] -> Name -> Bool -> Context -> [(Def, Accessibility)]+lookupDefAcc root n mkpublic ctxt +    = map mkp $ lookupCtxt root n (definitions ctxt)+  where mkp (d, a) = if mkpublic then (d, Public) else (d, a)++lookupVal :: Maybe [String] -> Name -> Context -> [Value]+lookupVal root n ctxt +   = do def <- lookupCtxt root n (definitions ctxt)+        case fst def of+          (Function _ htm) -> return (veval ctxt [] htm)+          (TyDecl nt ty) -> return (VP nt n (veval ctxt [] ty))++lookupTyEnv :: Name -> Env -> Maybe (Int, Type)+lookupTyEnv n env = li n 0 env where+  li n i []           = Nothing+  li n i ((x, b): xs) +             | n == x = Just (i, binderTy b)+             | otherwise = li n (i+1) xs+
+ src/Core/ProofShell.hs view
@@ -0,0 +1,73 @@+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, PatternGuards #-}++module Core.ProofShell where++import Core.Typecheck+import Core.Evaluate+import Core.TT+import Core.ShellParser+import Core.Elaborate++import Control.Monad.State+import System.Console.Haskeline++data ShellState = ShellState +                        { ctxt     :: Context,+                          prf      :: Maybe ProofState,+                          deferred :: [(Name, ProofState)],+                          exitNow  :: Bool+                        }++initState c = ShellState c Nothing [] False++processCommand :: Command -> ShellState -> (ShellState, String)+processCommand (Theorem n ty) state +    = case check (ctxt state) [] ty of+              OK (gl, t) -> +                 case isSet (ctxt state) [] t of+                    OK _ -> (state { prf = Just (newProof n (ctxt state) gl) }, "")+                    _ ->    (state, "Goal is not a type")+              err ->            (state, show err)+processCommand Quit     state = (state { exitNow = True }, "Bye bye")+processCommand (Eval t) state = +    case check (ctxt state) [] t of+         OK (val, ty) ->+            let nf = normalise (ctxt state) [] val +                tnf = normalise (ctxt state) [] ty in+                (state, show nf ++ " : " ++ show ty)+         err -> (state, show err)+processCommand (Print n) state =+    case lookupDef Nothing n (ctxt state) of+         [tm] -> (state, show tm)+         _ -> (state, "No such name")+processCommand (Tac e)  state +    | Just ps <- prf state = case execElab () e ps of+                                OK (ES (ps', _) resp _) -> +                                   if (not (done ps')) +                                      then (state { prf = Just ps' }, resp)+                                      else (state { prf = Nothing,+                                                    ctxt = addToCtxt (thname ps')+                                                                     (pterm ps')+                                                                     (ptype ps')+                                                                     (context ps') }, resp)+                                err -> (state, show err)+    | otherwise = (state, "No proof in progress")++runShell :: ShellState -> InputT IO ShellState+runShell st = do (prompt, parser) <- +                           maybe (return ("TT# ", parseCommand)) +                                 (\st -> do outputStrLn (show st)+                                            return (show (thname st) ++ "# ", parseTactic)) +                                 (prf st)+                 x <- getInputLine prompt+                 cmd <- case x of+                    Nothing -> return $ Right Quit+                    Just input -> return (parser input)+                 case cmd of+                    Left err -> do outputStrLn (show err)+                                   runShell st+                    Right cmd -> do let (st', r) = processCommand cmd st+                                    outputStrLn r+                                    if (not (exitNow st')) then runShell st'+                                                           else return st'+
+ src/Core/ProofState.hs view
@@ -0,0 +1,520 @@+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, PatternGuards #-}++{- Implements a proof state, some primitive tactics for manipulating+   proofs, and some high level commands for introducing new theorems,+   evaluation/checking inside the proof system, etc. --}++module Core.ProofState(ProofState(..), newProof, envAtFocus, goalAtFocus,+                  Tactic(..), Goal(..), processTactic) where++import Core.Typecheck+import Core.Evaluate+import Core.TT+import Core.Unify++import Control.Monad.State+import Control.Applicative+import Data.List+import Debug.Trace++data ProofState = PS { thname   :: Name,+                       holes    :: [Name], -- holes still to be solved+                       nextname :: Int,    -- name supply+                       pterm    :: Term,   -- current proof term+                       ptype    :: Type,   -- original goal+                       unified  :: (Name, [(Name, Term)]),+                       solved   :: Maybe (Name, Term),+                       problems :: Fails,+                       injective :: [(Term, Term, Term)],+                       deferred :: [Name], -- names we'll need to define+                       instances :: [Name], -- instance arguments (for type classes)+                       previous :: Maybe ProofState, -- for undo+                       context  :: Context,+                       plog     :: String,+                       done     :: Bool+                     }+                   +data Goal = GD { premises :: Env,+                 goalType :: Binder Term+               }++data Tactic = Attack+            | Claim Name Raw+            | Reorder Name+            | Exact Raw+            | Fill Raw+            | PrepFill Name [Name]+            | CompleteFill+            | Regret+            | Solve+            | StartUnify Name+            | EndUnify+            | Compute+            | EvalIn Raw+            | CheckIn Raw+            | Intro (Maybe Name)+            | IntroTy Raw (Maybe Name)+            | Forall Name Raw+            | LetBind Name Raw Raw+            | Rewrite Raw+            | PatVar Name+            | PatBind Name+            | Focus Name+            | Defer Name+            | Instance Name+            | MoveLast Name+            | ProofState+            | Undo+            | QED+    deriving Show++-- Some utilites on proof and tactic states++instance Show ProofState where+    show (PS nm [] _ tm _ _ _ _ _ _ _ _ _ _ _) = show nm ++ ": no more goals"+    show (PS nm (h:hs) _ tm _ _ _ _ _ i _ _ ctxt _ _) +          = let OK g = goal (Just h) tm+                wkenv = premises g in+                "Other goals: " ++ show hs ++ "\n" +++                showPs wkenv (reverse wkenv) ++ "\n" +++                "-------------------------------- (" ++ show nm ++ +                ") -------\n  " +++                show h ++ " : " ++ showG wkenv (goalType g) ++ "\n"+         where showPs env [] = ""+               showPs env ((n, Let t v):bs) +                   = "  " ++ show n ++ " : " ++ +                     showEnv env ({- normalise ctxt env -} t) ++ "   =   " +++                     showEnv env ({- normalise ctxt env -} v) +++                     "\n" ++ showPs env bs+               showPs env ((n, b):bs) +                   = "  " ++ show n ++ " : " ++ +                     showEnv env ({- normalise ctxt env -} (binderTy b)) ++ +                     "\n" ++ showPs env bs+               showG ps (Guess t v) = showEnv ps ({- normalise ctxt ps -} t) ++ +                                         " =?= " ++ showEnv ps v+               showG ps b = showEnv ps (binderTy b)++same Nothing n  = True+same (Just x) n = x == n++hole (Hole _)    = True+hole (Guess _ _) = True+hole _           = False++holeName i = MN i "hole" ++unify' :: Context -> Env -> TT Name -> TT Name -> StateT TState TC [(Name, TT Name)]+unify' ctxt env topx topy = do (u, inj, fails) <- lift $ unify ctxt env topx topy+                               addInj inj+                               case fails of+                                    [] -> return u+                                    err -> +                                        do ps <- get+                                           put (ps { problems = err ++ problems ps })+                                           return []++getName :: Monad m => String -> StateT TState m Name+getName tag = do ps <- get+                 let n = nextname ps+                 put (ps { nextname = n+1 })+                 return $ MN n tag++action :: Monad m => (ProofState -> ProofState) -> StateT TState m ()+action a = do ps <- get+              put (a ps)++addLog :: Monad m => String -> StateT TState m ()+addLog str = action (\ps -> ps { plog = plog ps ++ str ++ "\n" })++newProof :: Name -> Context -> Type -> ProofState+newProof n ctxt ty = let h = holeName 0 +                         ty' = vToP ty in+                         PS n [h] 1 (Bind h (Hole ty') (P Bound h ty')) ty (h, []) +                            Nothing [] []+                            [] []+                            Nothing ctxt "" False++type TState = ProofState -- [TacticAction])+type RunTactic = Context -> Env -> Term -> StateT TState TC Term+type Hole = Maybe Name -- Nothing = default hole, first in list in proof state++envAtFocus :: ProofState -> TC Env+envAtFocus ps +    | not $ null (holes ps) = do g <- goal (Just (head (holes ps))) (pterm ps)+                                 return (premises g)+    | otherwise = fail "No holes"++goalAtFocus :: ProofState -> TC (Binder Type)+goalAtFocus ps+    | not $ null (holes ps) = do g <- goal (Just (head (holes ps))) (pterm ps)+                                 return (goalType g)++goal :: Hole -> Term -> TC Goal+goal h tm = g [] tm where+    g env (Bind n b sc) | hole b && same h n = return $ GD env b +                        | otherwise          +                           = gb env b `mplus` g ((n, b):env) sc+    g env (App f a)   = g env f `mplus` g env a+    g env t           = fail "Can't find hole"++    gb env (Let t v) = g env t `mplus` g env v+    gb env (Guess t v) = g env t `mplus` g env v+    gb env t = g env (binderTy t)++tactic :: Hole -> RunTactic -> StateT TState TC ()+tactic h f = do ps <- get+                tm' <- atH (context ps) [] (pterm ps)+                ps <- get -- might have changed while processing+                put (ps { pterm = tm' })+  where+    atH c env binder@(Bind n b sc) +        | hole b && same h n = f c env binder+        | otherwise          +            = liftM2 (Bind n) (atHb c env b) (atH c ((n, b) : env) sc) +    atH c env (App f a)    = liftM2 App (atH c env f) (atH c env a)+    atH c env t            = return t+    +    atHb c env (Let t v)   = liftM2 Let (atH c env t) (atH c env v)    +    atHb c env (Guess t v) = liftM2 Guess (atH c env t) (atH c env v)+    atHb c env t           = do ty' <- atH c env (binderTy t)+                                return $ t { binderTy = ty' }++attack :: RunTactic+attack ctxt env (Bind x (Hole t) sc) +    = do h <- getName "hole"+         action (\ps -> ps { holes = h : holes ps })+         return $ Bind x (Guess t (newtm h)) sc+  where+    newtm h = Bind h (Hole t) (P Bound h t) +attack ctxt env _ = fail "Not an attackable hole"++claim :: Name -> Raw -> RunTactic+claim n ty ctxt env t =+    do (tyv, tyt) <- lift $ check ctxt env ty+       lift $ isSet ctxt env tyt+       action (\ps -> let (g:gs) = holes ps in+                          ps { holes = g : n : gs } )+       return $ Bind n (Hole tyv) t -- (weakenTm 1 t)++reorder_claims :: RunTactic+reorder_claims ctxt env t+    = -- trace (showSep "\n" (map show (scvs t))) $ +      let (bs, sc) = scvs t []+          newbs = reverse (sortB (reverse bs)) in+          traceWhen (bs /= newbs) (show bs ++ "\n ==> \n" ++ show newbs) $+            return (bindAll newbs sc)+  where scvs (Bind n b@(Hole _) sc) acc = scvs sc ((n, b):acc)+        scvs sc acc = (reverse acc, sc)++        sortB :: [(Name, Binder (TT Name))] -> [(Name, Binder (TT Name))]+        sortB [] = []+        sortB (x:xs) | all (noOcc x) xs = x : sortB xs+                     | otherwise = sortB (insertB x xs)++        insertB x [] = [x]+        insertB x (y:ys) | all (noOcc x) (y:ys) = x : y : ys+                         | otherwise = y : insertB x ys++        noOcc (n, _) (_, Let t v) = noOccurrence n t && noOccurrence n v+        noOcc (n, _) (_, Guess t v) = noOccurrence n t && noOccurrence n v+        noOcc (n, _) (_, b) = noOccurrence n (binderTy b)++focus :: Name -> RunTactic+focus n ctxt env t = do action (\ps -> let hs = holes ps in+                                            if n `elem` hs+                                               then ps { holes = n : (hs \\ [n]) }+                                               else ps)+                        return t ++movelast :: Name -> RunTactic+movelast n ctxt env t = do action (\ps -> let hs = holes ps in+                                              if n `elem` hs+                                                  then ps { holes = (hs \\ [n]) ++ [n] }+                                                  else ps)+                           return t ++instanceArg :: Name -> RunTactic+instanceArg n ctxt env (Bind x (Hole t) sc)+    = do action (\ps -> let hs = holes ps+                            is = instances ps in+                            ps { holes = (hs \\ [x]) ++ [x],+                                 instances = x:is })+         return (Bind x (Hole t) sc)++defer :: Name -> RunTactic+defer n ctxt env (Bind x (Hole t) (P nt x' ty)) | x == x' = +    do action (\ps -> let hs = holes ps in+                          ps { holes = hs \\ [x] })+       return (Bind n (GHole (mkTy (reverse env) t)) +                      (mkApp (P Ref n ty) (map getP (reverse env))))+  where+    mkTy []           t = t+    mkTy ((n,b) : bs) t = Bind n (Pi (binderTy b)) (mkTy bs t)++    getP (n, b) = P Bound n (binderTy b)++-- Hmmm. YAGNI?+regret :: RunTactic+regret = undefined++addInj :: [(Term, Term, Term)] -> StateT TState TC ()+addInj inj = do ps <- get+                put (ps { injective = inj ++ injective ps })++exact :: Raw -> RunTactic+exact guess ctxt env (Bind x (Hole ty) sc) = +    do (val, valty) <- lift $ check ctxt env guess +       lift $ converts ctxt env valty ty+       return $ Bind x (Guess ty val) sc+exact _ _ _ _ = fail "Can't fill here."++-- As exact, but attempts to solve other goals by unification++fill :: Raw -> RunTactic+fill guess ctxt env (Bind x (Hole ty) sc) =+    do (val, valty) <- lift $ check ctxt env guess+       s <- get+       ns <- unify' ctxt env valty ty+       ps <- get+       let (uh, uns) = unified ps+       put (ps { unified = (uh, uns ++ ns) })+--        addLog (show (uh, uns ++ ns))+       return $ Bind x (Guess ty val) sc+fill _ _ _ _ = fail "Can't fill here."++prep_fill :: Name -> [Name] -> RunTactic+prep_fill f as ctxt env (Bind x (Hole ty) sc) =+    do let val = mkApp (P Ref f undefined) (map (\n -> P Ref n undefined) as)+       return $ Bind x (Guess ty val) sc+prep_fill f as ctxt env t = fail $ "Can't prepare fill at " ++ show t++complete_fill :: RunTactic+complete_fill ctxt env (Bind x (Guess ty val) sc) =+    do let guess = forget val+       (val', valty) <- lift $ check ctxt env guess    +       ns <- unify' ctxt env valty ty+       ps <- get+       let (uh, uns) = unified ps+       put (ps { unified = (uh, uns ++ ns) })+       return $ Bind x (Guess ty val) sc+complete_fill ctxt env t = fail $ "Can't complete fill at " ++ show t++solve :: RunTactic+solve ctxt env (Bind x (Guess ty val) sc)+   | pureTerm val = do ps <- get+                       let (uh, uns) = unified ps+                       action (\ps -> ps { holes = holes ps \\ [x],+                                           solved = Just (x, val),+                                           -- unified = (uh, uns ++ [(x, val)]),+                                           instances = instances ps \\ [x] })+                       return $ {- Bind x (Let ty val) sc -} instantiate val (pToV x sc)+   | otherwise    = fail $ "I see a hole in your solution. " ++ showEnv env val+solve _ _ h = fail $ "Not a guess " ++ show h++introTy :: Raw -> Maybe Name -> RunTactic+introTy ty mn ctxt env (Bind x (Hole t) (P _ x' _)) | x == x' =+    do let n = case mn of +                  Just name -> name+                  Nothing -> x+       let t' = normalise ctxt env t+       (tyv, tyt) <- lift $ check ctxt env ty+--        ns <- lift $ unify ctxt env tyv t'+       case t' of+           Bind y (Pi s) t -> let t' = instantiate (P Bound n s) (pToV y t) in+                                  do ns <- unify' ctxt env s tyv+                                     ps <- get+                                     let (uh, uns) = unified ps+                                     put (ps { unified = (uh, uns ++ ns) })+                                     return $ Bind n (Lam tyv) (Bind x (Hole t') (P Bound x t'))+           _ -> fail "Nothing to introduce"+introTy ty n ctxt env _ = fail "Can't introduce here."++intro :: Maybe Name -> RunTactic+intro mn ctxt env (Bind x (Hole t) (P _ x' _)) | x == x' =+    do let n = case mn of +                  Just name -> name+                  Nothing -> x+       let t' = normalise ctxt env t+       case t' of+           Bind y (Pi s) t -> let t' = instantiate (P Bound n s) (pToV y t) in +                                  return $ Bind n (Lam s) (Bind x (Hole t') (P Bound x t'))+           _ -> fail "Nothing to introduce"+intro n ctxt env _ = fail "Can't introduce here."++forall :: Name -> Raw -> RunTactic+forall n ty ctxt env (Bind x (Hole t) (P _ x' _)) | x == x' =+    do (tyv, tyt) <- lift $ check ctxt env ty+       lift $ isSet ctxt env tyt+       lift $ isSet ctxt env t+       return $ Bind n (Pi tyv) (Bind x (Hole t) (P Bound x t))+forall n ty ctxt env _ = fail "Can't pi bind here"++patvar :: Name -> RunTactic+patvar n ctxt env (Bind x (Hole t) sc) =+    do action (\ps -> ps { holes = holes ps \\ [x] })+       return $ Bind n (PVar t) (instantiate (P Bound n t) (pToV x sc))+patvar n ctxt env tm = fail $ "Can't add pattern var at " ++ show tm++letbind :: Name -> Raw -> Raw -> RunTactic+letbind n ty val ctxt env (Bind x (Hole t) (P _ x' _)) | x == x' =+    do (tyv,  tyt)  <- lift $ check ctxt env ty+       (valv, valt) <- lift $ check ctxt env val+       lift $ isSet ctxt env tyt+       return $ Bind n (Let tyv valv) (Bind x (Hole t) (P Bound x t))+letbind n ty val ctxt env _ = fail "Can't let bind here"++rewrite :: Raw -> RunTactic+rewrite tm ctxt env (Bind x (Hole t) xp@(P _ x' _)) | x == x' =+    do (tmv, tmt) <- lift $ check ctxt env tm+       case unApply tmt of+         (P _ (UN "=") _, [lt,rt,l,r]) ->+            do let p = Bind rname (Lam lt) (mkP (P Bound rname lt) r l t)+               let newt = mkP l r l t +               let sc = forget $ (Bind x (Hole newt) +                                       (mkApp (P Ref (UN "replace") (Set (UVal 0)))+                                              [lt, l, r, p, tmv, xp]))+               (scv, sct) <- lift $ check ctxt env sc+               return scv+         _ -> fail "Not an equality type"+  where+    -- to make the P for rewrite, replace syntactic occurrences of l in ty with+    -- and x, and put \x : lt in front+    mkP lt l r ty | l == ty = lt+    mkP lt l r (App f a) = let f' = if (r /= f) then mkP lt l r f else f+                               a' = if (r /= a) then mkP lt l r a else a in+                               App f' a'+    mkP lt l r x = x++    rname = MN 0 "replaced"+rewrite _ _ _ _ = fail "Can't rewrite here"++patbind :: Name -> RunTactic+patbind n ctxt env (Bind x (Hole t) (P _ x' _)) | x == x' =+    do let t' = normalise ctxt env t+       case t' of+           Bind y (PVTy s) t -> let t' = instantiate (P Bound n s) (pToV y t) in+                                    return $ Bind n (PVar s) (Bind x (Hole t') (P Bound x t'))+           _ -> fail "Nothing to pattern bind"+patbind n ctxt env _ = fail "Can't pattern bind here"++compute :: RunTactic+compute ctxt env (Bind x (Hole ty) sc) =+    do return $ Bind x (Hole (normalise ctxt env ty)) sc+        +check_in :: Raw -> RunTactic+check_in t ctxt env tm = +    do (val, valty) <- lift $ check ctxt env t+       addLog (showEnv env val ++ " : " ++ showEnv env valty)+       return tm++eval_in :: Raw -> RunTactic+eval_in t ctxt env tm = +    do (val, valty) <- lift $ check ctxt env t+       let val' = normalise ctxt env val+       let valty' = normalise ctxt env valty+       addLog (showEnv env val ++ " : " ++ +               showEnv env valty ++ +--                     " in " ++ show env ++ +               " ==>\n " +++               showEnv env val' ++ " : " ++ +               showEnv env valty')+       return tm++start_unify :: Name -> RunTactic+start_unify n ctxt env tm = do action (\ps -> ps { unified = (n, []) })+                               return tm++tmap f (a, b, c) = (f a, b, c)++solve_unified :: RunTactic+solve_unified ctxt env tm = +    do ps <- get+       let (_, ns) = unified ps+       action (\ps -> ps { holes = holes ps \\ map fst ns })+       action (\ps -> ps { pterm = updateSolved ns (pterm ps) })+       action (\ps -> ps { injective = map (tmap (updateSolved ns)) (injective ps) })+       return (updateSolved ns tm)++updateSolved xs (Bind n (Hole ty) t)+    | Just v <- lookup n xs = instantiate v (pToV n (updateSolved xs t))+updateSolved xs (Bind n b t) +    | otherwise = Bind n (fmap (updateSolved xs) b) (updateSolved xs t)+updateSolved xs (App f a) = App (updateSolved xs f) (updateSolved xs a)+updateSolved xs (P _ n _)+    | Just v <- lookup n xs = v+updateSolved xs t = t++updateProblems ns [] = []+updateProblems ns ((x, y, env, err) : ps) =+    let x' = updateSolved ns x+        y' = updateSolved ns y in+        (x',y',env,err) : updateProblems ns ps++processTactic :: Tactic -> ProofState -> TC (ProofState, String)+processTactic QED ps = case holes ps of+                           [] -> do let tm = {- normalise (context ps) [] -} (pterm ps)+                                    (tm', ty', _) <- recheck (context ps) [] (forget tm) tm+                                    return (ps { done = True, pterm = tm' }, +                                            "Proof complete: " ++ showEnv [] tm')+                           _  -> fail "Still holes to fill."+processTactic ProofState ps = return (ps, showEnv [] (pterm ps))+processTactic Undo ps = case previous ps of+                            Nothing -> fail "Nothing to undo."+                            Just pold -> return (pold, "")+processTactic EndUnify ps +    = let (h, ns) = unified ps+          ns' = map (\ (n, t) -> (n, updateSolved ns t)) ns +          tm' = -- trace ("Updating " ++ show ns' ++ " in " ++ show (pterm ps)) $+                updateSolved ns' (pterm ps) +          probs' = updateProblems ns' (problems ps) in+          case probs' of+            [] -> return (ps { pterm = tm', +                               unified = (h, []),+                               injective = map (tmap (updateSolved ns')) +                                                (injective ps),+                               holes = holes ps \\ map fst ns' }, "")+            errs@((_,_,_,err):_) -> tfail err+processTactic (Reorder n) ps +    = do ps' <- execStateT (tactic (Just n) reorder_claims) ps+         return (ps' { previous = Just ps, plog = "" }, plog ps')+processTactic t ps   +    = case holes ps of+        [] -> fail "Nothing to fill in."+        (h:_)  -> do ps' <- execStateT (process t h) ps+                     let pterm' = case solved ps' of+                                    Just s -> updateSolved [s] (pterm ps')+                                    _ -> pterm ps'+                     return (ps' { pterm = pterm',+                                   solved = Nothing,+                                   previous = Just ps, plog = "" }, plog ps')++process :: Tactic -> Name -> StateT TState TC ()+process EndUnify _ +   = do ps <- get+        let (h, _) = unified ps+        tactic (Just h) solve_unified+process t h = tactic (Just h) (mktac t)+   where mktac Attack          = attack+         mktac (Claim n r)     = claim n r+         mktac (Exact r)       = exact r+         mktac (Fill r)        = fill r+         mktac (PrepFill n ns) = prep_fill n ns+         mktac CompleteFill    = complete_fill+         mktac Regret          = regret+         mktac Solve           = solve+         mktac (StartUnify n)  = start_unify n+         mktac Compute         = compute+         mktac (Intro n)       = intro n+         mktac (IntroTy ty n)  = introTy ty n+         mktac (Forall n t)    = forall n t+         mktac (LetBind n t v) = letbind n t v+         mktac (Rewrite t)     = rewrite t+         mktac (PatVar n)      = patvar n+         mktac (PatBind n)     = patbind n+         mktac (CheckIn r)     = check_in r+         mktac (EvalIn r)      = eval_in r+         mktac (Focus n)       = focus n+         mktac (Defer n)       = defer n+         mktac (Instance n)    = instanceArg n+         mktac (MoveLast n)    = movelast n+
+ src/Core/ShellParser.hs view
@@ -0,0 +1,73 @@+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}++module Core.ShellParser(parseCommand, parseTactic) where++import Core.TT+import Core.Elaborate+import Core.CoreParser++import Text.ParserCombinators.Parsec+import Text.ParserCombinators.Parsec.Expr+import Text.ParserCombinators.Parsec.Language+import qualified Text.ParserCombinators.Parsec.Token as PTok++import Debug.Trace++type TokenParser a = PTok.TokenParser a++lexer :: TokenParser ()+lexer  = PTok.makeTokenParser haskellDef++whiteSpace= PTok.whiteSpace lexer+lexeme    = PTok.lexeme lexer+symbol    = PTok.symbol lexer+natural   = PTok.natural lexer+parens    = PTok.parens lexer+semi      = PTok.semi lexer+comma     = PTok.comma lexer+identifier= PTok.identifier lexer+reserved  = PTok.reserved lexer+operator  = PTok.operator lexer+reservedOp= PTok.reservedOp lexer+lchar = lexeme.char++parseCommand = parse pCommand "(input)"+parseTactic  = parse (pTactic >>= return . Tac) "(input)"++pCommand :: Parser Command+pCommand = do reserved "theorem"; n <- iName []; lchar ':'; ty <- pTerm+              return (Theorem n ty)+       <|> do reserved "eval"; tm <- pTerm+              return (Eval tm)+       <|> do reserved "print"; n <- iName []; return (Print n)+       <|> do reserved "quit";+              return Quit++pTactic :: Parser (Elab ())+pTactic = do reserved "attack";  return attack+      <|> do reserved "claim";   n <- iName []; lchar ':'; ty <- pTerm+             return (claim n ty)+      <|> do reserved "regret";  return regret+      <|> do reserved "exact";   tm <- pTerm; return (exact tm)+      <|> do reserved "fill";    tm <- pTerm; return (fill tm)+      <|> do reserved "apply";   tm <- pTerm; args <- many pArgType; +             return (discard (apply tm (map (\x -> (x,0)) args)))+      <|> do reserved "solve";   return solve+      <|> do reserved "compute"; return compute+      <|> do reserved "intro";   n <- iName []; return (intro (Just n))+      <|> do reserved "forall";  n <- iName []; lchar ':'; ty <- pTerm+             return (forall n ty)+      <|> do reserved "arg";     n <- iName []; t <- iName []; return (arg n t)+      <|> do reserved "patvar";  n <- iName []; return (patvar n)+--       <|> do reserved "patarg";  n <- iName []; t <- iName []; return (patarg n t)+      <|> do reserved "eval";    t <- pTerm; return (eval_in t)+      <|> do reserved "check";   t <- pTerm; return (check_in t)+      <|> do reserved "focus";   n <- iName []; return (focus n)+      <|> do reserved "state";   return proofstate+      <|> do reserved "undo";    return undo+      <|> do reserved "qed";     return (discard qed)++pArgType :: Parser Bool+pArgType = do lchar '_'; return True   -- implicit (machine fills in)+       <|> do lchar '?'; return False  -- user fills in+
+ src/Core/TT.hs view
@@ -0,0 +1,591 @@+{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, DeriveFunctor #-}++module Core.TT where++import Control.Monad.State+import Debug.Trace+import qualified Data.Map as Map+import Data.Char+import Data.List+import qualified Data.Binary as B+import Data.Binary hiding (get, put)++{- The language has:+   * Full dependent types+   * A hierarchy of universes, with cumulativity: Set : Set1, Set1 : Set2, ...+   * Pattern matching letrec binding+   * (primitive types defined externally)++   Some technical stuff:+   * Typechecker is kept as simple as possible +        - no unification, just a checker for incomplete terms.+   * We have a simple collection of tactics which we use to elaborate source+     programs with implicit syntax into fully explicit terms.+-}++data Option = SetInSet+            | CheckConv+  deriving Eq++data FC = FC { fc_fname :: String,+               fc_line :: Int }+    deriving Eq+{-! +deriving instance Binary FC +!-}++instance Show FC where+    show (FC f l) = f ++ ":" ++ show l++data Err = Msg String+         | CantUnify Term Term Err Int -- Int is 'score' - how much we did unify+         | NotInjective Term Term Term+         | IncompleteTerm Term+         | UniverseError+         | ProgramLineComment+         | At FC Err+  deriving Eq++score :: Err -> Int+score (CantUnify _ _ m s) = s + score m+score _ = 0++instance Show Err where+    show (Msg s) = s+    show (CantUnify l r e i) = "CantUnify " ++ show l ++ " " ++ show r ++ " "+                               ++ show e ++ " " ++ show i+    show _ = "Error"++data TC a = OK a+          | Error Err+  deriving (Eq, Functor)++instance Show a => Show (TC a) where+    show (OK x) = show x+    show (Error str) = "Error: " ++ show str++-- at some point, this instance should also carry type checking options+-- (e.g. Set:Set)++instance Monad TC where+    return = OK +    x >>= k = case x of +                OK v -> k v+                Error e -> Error e+    fail e = Error (Msg e)++tfail :: Err -> TC a+tfail e = Error e++trun :: FC -> TC a -> TC a+trun fc (OK a)    = OK a+trun fc (Error e) = Error (At fc e) ++instance MonadPlus TC where+    mzero = fail "Unknown error"+    (OK x) `mplus` _ = OK x+    _ `mplus` (OK y) = OK y+    err `mplus` _    = err++discard :: Monad m => m a -> m ()+discard f = f >> return ()++showSep :: String -> [String] -> String+showSep sep [] = ""+showSep sep [x] = x+showSep sep (x:xs) = x ++ sep ++ showSep sep xs++pmap f (x, y) = (f x, f y)++traceWhen True msg a = trace msg a+traceWhen False _  a = a++-- RAW TERMS ----------------------------------------------------------------++-- Names are hierarchies of strings, describing scope (so no danger of+-- duplicate names, but need to be careful on lookup).+-- Also MN for machine chosen names++data Name = UN String+          | NS Name [String] -- root, namespaces +          | MN Int String+  deriving (Eq, Ord)+{-! +deriving instance Binary Name +!-}++instance Show Name where+    show (UN n) = n+    show (NS n s) = showSep "." (reverse s) ++ "." ++ show n+    show (MN i s) = "{" ++ s ++ show i ++ "}"+++-- Contexts allow us to map names to things. A root name maps to a collection+-- of things in different namespaces with that name.++type Ctxt a = Map.Map Name (Map.Map Name a)+emptyContext = Map.empty++nsroot (NS n _) = n+nsroot n = n++addDef :: Name -> a -> Ctxt a -> Ctxt a+addDef n v ctxt = case Map.lookup (nsroot n) ctxt of+                        Nothing -> Map.insert (nsroot n) +                                        (Map.insert n v Map.empty) ctxt+                        Just xs -> Map.insert (nsroot n) +                                        (Map.insert n v xs) ctxt++{- lookup a name in the context, given an optional namespace.+   The name (n) may itself have a (partial) namespace given.++   Rules for resolution:+    - if an explicit namespace is given, return the names which match it. If none+      match, return all names.+    - if the name has has explicit namespace given, return the names which match it+      and ignore the given namespace.+    - otherwise, return all names.++-}++lookupCtxtName :: Maybe [String] -> Name -> Ctxt a -> [(Name, a)]+lookupCtxtName nspace n ctxt = case Map.lookup (nsroot n) ctxt of+                                  Just xs -> filterNS (Map.toList xs)+                                  Nothing -> []+  where+    filterNS [] = []+    filterNS ((found, v) : xs) +        | nsmatch n found = (found, v) : filterNS xs+        | otherwise       = filterNS xs++    nsmatch (NS n ns) (NS p ps) = ns `isPrefixOf` ps+    nsmatch (NS _ _)  _         = False+    nsmatch looking   found     = True++lookupCtxt :: Maybe [String] -> Name -> Ctxt a -> [a]+lookupCtxt ns n ctxt = map snd (lookupCtxtName ns n ctxt)++updateDef :: Name -> (a -> a) -> Ctxt a -> Ctxt a+updateDef n f ctxt +  = let ds = lookupCtxtName Nothing n ctxt in+        foldr (\ (n, t) c -> addDef n (f t) c) ctxt ds  ++toAlist :: Ctxt a -> [(Name, a)]+toAlist ctxt = let allns = map snd (Map.toList ctxt) in+                concat (map (Map.toList) allns)++addAlist :: Show a => [(Name, a)] -> Ctxt a -> Ctxt a+addAlist [] ctxt = ctxt+addAlist ((n, tm) : ds) ctxt = addDef n tm (addAlist ds ctxt)++data Const = I Int | BI Integer | Fl Double | Ch Char | Str String +           | IType | BIType     | FlType    | ChType  | StrType    +           | PtrType | Forgot+  deriving Eq+{-! +deriving instance Binary Const +!-}++data Raw = Var Name+         | RBind Name (Binder Raw) Raw+         | RApp Raw Raw+         | RSet+         | RForce Raw+         | RConstant Const+  deriving (Show, Eq)+{-! +deriving instance Binary Raw +!-}++data Binder b = Lam   { binderTy  :: b }+              | Pi    { binderTy  :: b }+              | Let   { binderTy  :: b,+                        binderVal :: b }+              | NLet  { binderTy  :: b,+                        binderVal :: b }+              | Hole  { binderTy  :: b}+              | GHole { binderTy  :: b}+              | Guess { binderTy  :: b,+                        binderVal :: b }+              | PVar  { binderTy  :: b }+              | PVTy  { binderTy  :: b }+  deriving (Show, Eq, Functor)+{-! +deriving instance Binary Binder +!-}++fmapMB :: Monad m => (a -> m b) -> Binder a -> m (Binder b)+fmapMB f (Let t v)   = liftM2 Let (f t) (f v)+fmapMB f (NLet t v)  = liftM2 NLet (f t) (f v)+fmapMB f (Guess t v) = liftM2 Guess (f t) (f v)+fmapMB f (Lam t)     = liftM Lam (f t)+fmapMB f (Pi t)      = liftM Pi (f t)+fmapMB f (Hole t)    = liftM Hole (f t)+fmapMB f (GHole t)   = liftM GHole (f t)+fmapMB f (PVar t)    = liftM PVar (f t)+fmapMB f (PVTy t)    = liftM PVTy (f t)++raw_apply :: Raw -> [Raw] -> Raw+raw_apply f [] = f+raw_apply f (a : as) = raw_apply (RApp f a) as++raw_unapply :: Raw -> (Raw, [Raw])+raw_unapply t = ua [] t where+    ua args (RApp f a) = ua (a:args) f+    ua args t          = (t, args)++data RawFun = RawFun { rtype :: Raw,+                       rval  :: Raw+                     }+  deriving Show++data RawDatatype = RDatatype Name Raw [(Name, Raw)]+  deriving Show++data RDef = RFunction RawFun+          | RConst Raw+          | RData RawDatatype+  deriving Show++type RProgram = [(Name, RDef)]++-- WELL TYPED TERMS ---------------------------------------------------------++data UExp = UVar Int -- universe variable+          | UVal Int -- explicit universe level+  deriving (Eq, Ord)++-- We assume that universe levels have been checked, so anything external+-- can just have the same universe variable and we won't get any new+-- cycles.++instance Binary UExp where+    put x = return ()+    get = return (UVar (-1))++instance Show UExp where+    show (UVar x) | x < 26 = [toEnum (x + fromEnum 'a')]+                  | otherwise = toEnum ((x `mod` 26) + fromEnum 'a') : show (x `div` 26)+    show (UVal x) = show x+--     show (UMax l r) = "max(" ++ show l ++ ", " ++ show r ++")"++data UConstraint = ULT UExp UExp+                 | ULE UExp UExp+  deriving Eq++instance Show UConstraint where+    show (ULT x y) = show x ++ " < " ++ show y+    show (ULE x y) = show x ++ " <= " ++ show y++type UCs = (Int, [UConstraint])++data NameType = Bound | Ref | DCon Int Int | TCon Int Int+  deriving (Show)+{-! +deriving instance Binary NameType +!-}++instance Eq NameType where+    Bound    == Bound    = True+    Ref      == Ref      = True+    DCon _ a == DCon _ b = (a == b) -- ignore tag+    TCon _ a == TCon _ b = (a == b) -- ignore tag+    _        == _        = False++data TT n = P NameType n (TT n) -- embed type+          | V Int +          | Bind n (Binder (TT n)) (TT n)+          | App (TT n) (TT n) -- function, function type, arg+          | Constant Const+          | Erased+          | Set UExp+  deriving Functor+{-! +deriving instance Binary TT +!-}++type EnvTT n = [(n, Binder (TT n))]++data Datatype n = Data { d_typename :: n,+                         d_typetag  :: Int,+                         d_type     :: (TT n),+                         d_cons     :: [(n, TT n)] }+  deriving (Show, Functor, Eq)++instance Eq n => Eq (TT n) where+    (==) (P xt x _)     (P yt y _)     = xt == yt && x == y+    (==) (V x)          (V y)          = x == y+    (==) (Bind _ xb xs) (Bind _ yb ys) = xb == yb && xs == ys+    (==) (App fx ax)    (App fy ay)    = fx == fy && ax == ay+    (==) (Set _)        (Set _)        = True -- deal with constraints later+    (==) (Constant x)   (Constant y)   = x == y+    (==) Erased         _              = True+    (==) _              Erased         = True+    (==) _              _              = False++convEq :: Eq n => TT n -> TT n -> StateT UCs TC Bool+convEq (P xt x _) (P yt y _) = return (xt == yt && x == y)+convEq (V x)      (V y)      = return (x == y)+convEq (Bind _ xb xs) (Bind _ yb ys) +                             = liftM2 (&&) (convEqB xb yb) (convEq xs ys)+  where convEqB (Let v t) (Let v' t') = liftM2 (&&) (convEq v v') (convEq t t')+        convEqB (Guess v t) (Guess v' t') = liftM2 (&&) (convEq v v') (convEq t t')+        convEqB b b' = convEq (binderTy b) (binderTy b')+convEq (App fx ax) (App fy ay)   = liftM2 (&&) (convEq fx fy) (convEq ax ay)+convEq (Constant x) (Constant y) = return (x == y)+convEq (Set x) (Set y)           = do (v, cs) <- get+                                      put (v, ULE x y : cs)+                                      return True+convEq Erased _ = return True+convEq _ Erased = return True+convEq _ _ = return False++-- A few handy operations on well typed terms:++isInjective :: TT n -> Bool+isInjective (P (DCon _ _) _ _) = True+isInjective (P (TCon _ _) _ _) = True+isInjective (Constant _)       = True+isInjective (Set x)            = True+isInjective (Bind _ (Pi _) sc) = True+isInjective (App f a)          = isInjective f+isInjective _                  = False++instantiate :: TT n -> TT n -> TT n+instantiate e = subst 0 where+    subst i (V x) | i == x = e+    subst i (Bind x b sc) = Bind x (fmap (subst i) b) (subst (i+1) sc)+    subst i (App f a) = App (subst i f) (subst i a)+    subst i t = t++pToV :: Eq n => n -> TT n -> TT n+pToV n = pToV' n 0+pToV' n i (P _ x _) | n == x = V i+pToV' n i (Bind x b sc)+                | n == x    = Bind x (fmap (pToV' n i) b) sc+                | otherwise = Bind x (fmap (pToV' n i) b) (pToV' n (i+1) sc)+pToV' n i (App f a) = App (pToV' n i f) (pToV' n i a)+pToV' n i t = t++-- Convert several names. First in the list comes out as V 0+pToVs :: Eq n => [n] -> TT n -> TT n+pToVs ns tm = pToVs' ns tm 0 where+    pToVs' []     tm i = tm+    pToVs' (n:ns) tm i = pToV' n i (pToVs' ns tm (i+1))++vToP :: TT n -> TT n+vToP = vToP' [] where+    vToP' env (V i) = let (n, b) = (env !! i) in+                          P Bound n (binderTy b)+    vToP' env (Bind n b sc) = let b' = fmap (vToP' env) b in+                                  Bind n b' (vToP' ((n, b'):env) sc)+    vToP' env (App f a) = App (vToP' env f) (vToP' env a)+    vToP' env t = t++finalise :: Eq n => TT n -> TT n+finalise (Bind x b sc) = Bind x (fmap finalise b) (pToV x (finalise sc))+finalise (App f a) = App (finalise f) (finalise a)+finalise t = t++subst :: Eq n => n -> TT n -> TT n -> TT n+subst n v tm = instantiate v (pToV n tm)++substNames :: Eq n => [(n, TT n)] -> TT n -> TT n+substNames []             t = t+substNames ((n, tm) : xs) t = subst n tm (substNames xs t)++-- Returns true if V 0 and bound name n do not occur in the term++noOccurrence :: Eq n => n -> TT n -> Bool+noOccurrence n t = no' 0 t+  where+    no' i (V x) = not (i == x)+    no' i (P Bound x _) = not (n == x)+    no' i (Bind n b sc) = noB' i b && no' (i+1) sc+       where noB' i (Let t v) = no' i t && no' i v+             noB' i (Guess t v) = no' i t && no' i v+             noB' i b = no' i (binderTy b)+    no' i (App f a) = no' i f && no' i a+    no' i _ = True++-- Return the arity of a (normalised) type++arity :: TT n -> Int+arity (Bind n (Pi t) sc) = 1 + arity sc+arity _ = 0++-- deconstruct an application; returns the function and a list of arguments++unApply :: TT n -> (TT n, [TT n])+unApply t = ua [] t where+    ua args (App f a) = ua (a:args) f+    ua args t         = (t, args)++mkApp :: TT n -> [TT n] -> TT n+mkApp f [] = f+mkApp f (a:as) = mkApp (App f a) as++forget :: TT Name -> Raw+forget tm = fe [] tm+  where+    fe env (P _ n _) = Var n+    fe env (V i)     = Var (env !! i)+    fe env (Bind n b sc) = RBind n (fmap (fe env) b) +                                   (fe (n:env) sc)+    fe env (App f a) = RApp (fe env f) (fe env a)+    fe env (Constant c) +                     = RConstant c+    fe env (Set i)   = RSet+    fe env Erased    = RConstant Forgot +    +bindAll :: [(n, Binder (TT n))] -> TT n -> TT n +bindAll [] t =t+bindAll ((n, b) : bs) t = Bind n b (bindAll bs t)++bindTyArgs :: (TT n -> Binder (TT n)) -> [(n, TT n)] -> TT n -> TT n+bindTyArgs b xs = bindAll (map (\ (n, ty) -> (n, b ty)) xs)++getArgTys :: TT n -> [(n, TT n)]+getArgTys (Bind n (Pi t) sc) = (n, t) : getArgTys sc+getArgTys _ = []++getRetTy :: TT n -> TT n+getRetTy (Bind n (PVar _) sc) = getRetTy sc+getRetTy (Bind n (PVTy _) sc) = getRetTy sc+getRetTy (Bind n (Pi _) sc)   = getRetTy sc+getRetTy sc = sc++uniqueName :: Name -> [Name] -> Name+uniqueName n hs | n `elem` hs = uniqueName (nextName n) hs+                | otherwise   = n++nextName (NS x s)    = NS (nextName x) s+nextName (MN i n)    = MN (i+1) n+nextName (UN x) = let (num', nm') = span isDigit (reverse x)+                      nm = reverse nm'+                      num = readN (reverse num') in+                          UN (nm ++ show (num+1))+  where+    readN "" = 0+    readN x  = read x++type Term = TT Name+type Type = Term++type Env  = EnvTT Name++-- an environment with de Bruijn indices 'normalised' so that they all refer to+-- this environment++newtype WkEnvTT n = Wk (EnvTT n)+type WkEnv = WkEnvTT Name++instance (Eq n, Show n) => Show (TT n) where+    show t = showEnv [] t++instance Show Const where+    show (I i) = show i+    show (BI i) = show i ++ "L"+    show (Fl f) = show f+    show (Ch c) = show c+    show (Str s) = show s+    show IType = "Int"+    show BIType = "Integer"+    show FlType = "Float"+    show ChType = "Char"+    show StrType = "String"+    show PtrType = "Ptr"++showEnv env t = showEnv' env t False+showEnvDbg env t = showEnv' env t True++showEnv' env t dbg = se 10 env t where+    se p env (P nt n t) = show n +                            ++ if dbg then "{" ++ show nt ++ " : " ++ se 10 env t ++ "}" else ""+    se p env (V i) | i < length env = (show $ fst $ env!!i) +++                                      if dbg then "{" ++ show i ++ "}" else ""+                   | otherwise = "!!V " ++ show i ++ "!!"+    se p env (Bind n b@(Pi t) sc)  +        | noOccurrence n sc && not dbg = bracket p 2 $ se 1 env t ++ " -> " ++ se 10 ((n,b):env) sc+    se p env (Bind n b sc) = bracket p 2 $ sb env n b ++ se 10 ((n,b):env) sc+    se p env (App f a) = bracket p 1 $ se 1 env f ++ " " ++ se 0 env a+    se p env (Constant c) = show c+    se p env Erased = "[__]"+    se p env (Set i) = "Set " ++ show i++    sb env n (Lam t)  = showb env "\\ " " => " n t+    sb env n (Hole t) = showb env "? " ". " n t+    sb env n (GHole t) = showb env "?defer " ". " n t+    sb env n (Pi t)   = showb env "(" ") -> " n t+    sb env n (PVar t) = showb env "pat " ". " n t+    sb env n (PVTy t) = showb env "pty " ". " n t+    sb env n (Let t v)   = showbv env "let " " in " n t v+    sb env n (Guess t v) = showbv env "?? " " in " n t v++    showb env op sc n t    = op ++ show n ++ " : " ++ se 10 env t ++ sc+    showbv env op sc n t v = op ++ show n ++ " : " ++ se 10 env t ++ " = " ++ +                             se 10 env v ++ sc ++    bracket outer inner str | inner > outer = "(" ++ str ++ ")"+                            | otherwise = str++-- Check whether a term has any holes in it - impure if so++pureTerm :: TT n -> Bool+pureTerm (App f a) = pureTerm f && pureTerm a+pureTerm (Bind n b sc) = pureBinder b && pureTerm sc where+    pureBinder (Hole _) = False+    pureBinder (Guess _ _) = False+    pureBinder (Let t v) = pureTerm t && pureTerm v+    pureBinder t = pureTerm (binderTy t)+pureTerm _ = True++-- weaken a term by adding i to each de Bruijn index (i.e. lift it over i bindings)++weakenTm :: Int -> TT n -> TT n+weakenTm i t = wk i 0 t+  where wk i min (V x) | x >= min = V (i + x)+        wk i m (App f a)     = App (wk i m f) (wk i m a)+        wk i m (Bind x b sc) = Bind x (wkb i m b) (wk i (m + 1) sc)+        wk i m t = t+        wkb i m t           = fmap (wk i m) t++-- weaken an environment so that all the de Bruijn indices are correct according+-- to the latest bound variable++weakenEnv :: EnvTT n -> EnvTT n+weakenEnv env = wk (length env - 1) env+  where wk i [] = []+        wk i ((n, b) : bs) = (n, weakenTmB i b) : wk (i - 1) bs+        weakenTmB i (Let   t v) = Let (weakenTm i t) (weakenTm i v)+        weakenTmB i (Guess t v) = Guess (weakenTm i t) (weakenTm i v)+        weakenTmB i t           = t { binderTy = weakenTm i (binderTy t) }++weakenTmEnv :: Int -> EnvTT n -> EnvTT n+weakenTmEnv i = map (\ (n, b) -> (n, fmap (weakenTm i) b))++orderPats :: Term -> Term+orderPats tm = op [] tm+  where+    op ps (Bind n (PVar t) sc) = op ((n, t) : ps) sc+    op ps sc = bindAll (map (\ (n, t) -> (n, PVar t)) (sortP ps)) sc ++    sortP ps = pick [] (reverse ps)++    namesIn (P _ n _) = [n]+    namesIn (Bind n b t) = nub $ nb b ++ (namesIn t \\ [n])+      where nb (Let   t v) = nub (namesIn t) ++ nub (namesIn v)+            nb (Guess t v) = nub (namesIn t) ++ nub (namesIn v)+            nb t = namesIn (binderTy t)+    namesIn (App f a) = nub (namesIn f ++ namesIn a)+    namesIn _ = []++    pick acc [] = reverse acc+    pick acc ((n, t) : ps) = pick (insert n t acc) ps++    insert n t [] = [(n, t)]+    insert n t ((n',t') : ps)+        | n `elem` (namesIn t' ++ concatMap namesIn (map snd ps))+            = (n', t') : insert n t ps+        | otherwise = (n,t):(n',t'):ps+
+ src/Core/Typecheck.hs view
@@ -0,0 +1,223 @@+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, DeriveFunctor,+             PatternGuards #-}++module Core.Typecheck where++import Control.Monad.State+import Debug.Trace++import Core.TT+import Core.Evaluate++-- To check conversion, normalise each term wrt the current environment.+-- Since we haven't converted everything to de Bruijn indices yet, we'll have to+-- deal with alpha conversion - we do this by making each inner term de Bruijn+-- indexed with 'finalise'++convertsC :: Context -> Env -> Term -> Term -> StateT UCs TC ()+convertsC ctxt env x y +   = do c <- convEq (finalise (normalise ctxt env x))+                    (finalise (normalise ctxt env y))+        if c then return ()+             else fail ("Can't convert between " ++ +                        showEnv env (finalise (normalise ctxt env x)) ++ " and " ++ +                        showEnv env (finalise (normalise ctxt env y)))++converts :: Context -> Env -> Term -> Term -> TC ()+converts ctxt env x y = if (finalise (normalise ctxt env x) == +                            finalise (normalise ctxt env y))+                          then return ()+                          else fail ("Can't convert between " ++ +                                     showEnvDbg env (finalise (normalise ctxt env x)) ++ " and " ++ +                                     showEnvDbg env (finalise (normalise ctxt env y)))++isSet :: Context -> Env -> Term -> TC ()+isSet ctxt env tm = isSet' (normalise ctxt env tm)+    where isSet' (Set _) = return ()+          isSet' tm = fail (showEnv env tm ++ " is not a Set")++recheck :: Context -> Env -> Raw -> Term -> TC (Term, Type, UCs)+recheck ctxt env tm orig+   = let v = next_tvar ctxt in+       case runStateT (check' False ctxt env tm) (v, []) of -- holes banned+          Error (IncompleteTerm _) -> Error $ IncompleteTerm orig+          Error e -> Error e+          OK ((tm, ty), constraints) -> +              return (tm, ty, constraints)++check :: Context -> Env -> Raw -> TC (Term, Type)+check ctxt env tm = evalStateT (check' True ctxt env tm) (0, []) -- Holes allowed++check' :: Bool -> Context -> Env -> Raw -> StateT UCs TC (Term, Type)+check' holes ctxt env top = chk env top where+  chk env (Var n)+      | Just (i, ty) <- lookupTyEnv n env = return (P Bound n ty, ty)+      | (P nt n' ty : _) <- lookupP Nothing n ctxt = return (P nt n' ty, ty)+      | otherwise = do fail $ "No such variable " ++ show n ++ " in " ++ show (map fst env)+  chk env (RApp f a)+      = do (fv, fty) <- chk env f+           (av, aty) <- chk env a+           let fty' = renameBinders 0 $ normalise ctxt env fty+           case fty' of+             Bind x (Pi s) t ->+                 do convertsC ctxt env aty s+                    let apty = normalise initContext env (Bind x (Let aty av) t)+                    return (App fv av, apty)+             t -> fail "Can't apply a non-function type"+    -- This rather unpleasant hack is needed because during incomplete +    -- proofs, variables are locally bound with an explicit name. If we just +    -- make sure bound names in function types are locally unique, machine+    -- generated names, we'll be fine.+    where renameBinders i (Bind x (Pi s) t) = Bind (MN i "binder") (Pi s) +                                                   (renameBinders (i+1) t)+          renameBinders i sc = sc+  chk env RSet +    | holes = return (Set (UVal 0), Set (UVal 0))+    | otherwise = do (v, cs) <- get+                     let c = ULT (UVar v) (UVar (v+1))+                     put (v+2, (c:cs))+                     return (Set (UVar v), Set (UVar (v+1)))+  chk env (RConstant Forgot) = return (Erased, Erased)+  chk env (RConstant c) = return (Constant c, constType c)+    where constType (I _)   = Constant IType+          constType (BI _)  = Constant BIType+          constType (Fl _)  = Constant FlType+          constType (Ch _)  = Constant ChType+          constType (Str _) = Constant StrType+          constType Forgot  = Erased+          constType _       = Set (UVal 0)+  chk env (RForce t) = do (_, ty) <- chk env t+                          return (Erased, ty)+  chk env (RBind n (Pi s) t)+      = do (sv, st) <- chk env s+           (tv, tt) <- chk ((n, Pi sv) : env) t+           (v, cs) <- get+           let Set su = normalise ctxt env st+           let Set tu = normalise ctxt env tt+           when (not holes) $ put (v+1, ULE su (UVar v):ULE tu (UVar v):cs)+           return (Bind n (Pi sv) (pToV n tv), Set (UVar v))  +  chk env (RBind n b sc)+      = do b' <- checkBinder b+           (scv, sct) <- chk ((n, b'):env) sc+           discharge n b' (pToV n scv) (pToV n sct)+    where checkBinder (Lam t)+            = do (tv, tt) <- chk env t+                 let tv' = normalise ctxt env tv+                 let tt' = normalise ctxt env tt+                 lift $ isSet ctxt env tt'+                 return (Lam tv)+          checkBinder (Pi t)+            = do (tv, tt) <- chk env t+                 let tv' = normalise ctxt env tv+                 let tt' = normalise ctxt env tt+                 lift $ isSet ctxt env tt'+                 return (Pi tv)+          checkBinder (Let t v)+            = do (tv, tt) <- chk env t+                 (vv, vt) <- chk env v+                 let tv' = normalise ctxt env tv+                 let tt' = normalise ctxt env tt+                 convertsC ctxt env vt tv+                 lift $ isSet ctxt env tt'+                 return (Let tv vv)+          checkBinder (NLet t v)+            = do (tv, tt) <- chk env t+                 (vv, vt) <- chk env v+                 let tv' = normalise ctxt env tv+                 let tt' = normalise ctxt env tt+                 convertsC ctxt env vt tv+                 lift $ isSet ctxt env tt'+                 return (NLet tv vv)+          checkBinder (Hole t)+            | not holes = lift $ tfail (IncompleteTerm undefined)+            | otherwise+                   = do (tv, tt) <- chk env t+                        let tv' = normalise ctxt env tv+                        let tt' = normalise ctxt env tt+                        lift $ isSet ctxt env tt'+                        return (Hole tv)+          checkBinder (GHole t)+            = do (tv, tt) <- chk env t+                 let tv' = normalise ctxt env tv+                 let tt' = normalise ctxt env tt+                 lift $ isSet ctxt env tt'+                 return (GHole tv)+          checkBinder (Guess t v)+            | not holes = lift $ tfail (IncompleteTerm undefined)+            | otherwise+                   = do (tv, tt) <- chk env t+                        (vv, vt) <- chk env v+                        let tv' = normalise ctxt env tv+                        let tt' = normalise ctxt env tt+                        convertsC ctxt env vt tv+                        lift $ isSet ctxt env tt'+                        return (Guess tv vv)+          checkBinder (PVar t)+            = do (tv, tt) <- chk env t+                 let tv' = normalise ctxt env tv+                 let tt' = normalise ctxt env tt+                 lift $ isSet ctxt env tt'+                 return (PVar tv)+          checkBinder (PVTy t)+            = do (tv, tt) <- chk env t+                 let tv' = normalise ctxt env tv+                 let tt' = normalise ctxt env tt+                 lift $ isSet ctxt env tt'+                 return (PVTy tv)+  +          discharge n (Lam t) scv sct+            = return (Bind n (Lam t) scv, Bind n (Pi t) sct)+          discharge n (Pi t) scv sct+            = return (Bind n (Pi t) scv, sct)+          discharge n (Let t v) scv sct+            = return (Bind n (Let t v) scv, Bind n (Let t v) sct)+          discharge n (NLet t v) scv sct+            = return (Bind n (NLet t v) scv, Bind n (Let t v) sct)+          discharge n (Hole t) scv sct+            = do -- A hole can't appear in the type of its scope+                 checkNotHoley 0 sct+                 return (Bind n (Hole t) scv, sct)+          discharge n (GHole t) scv sct+            = do -- A hole can't appear in the type of its scope+                 checkNotHoley 0 sct+                 return (Bind n (GHole t) scv, sct)+          discharge n (Guess t v) scv sct+            = do -- A hole can't appear in the type of its scope+                 checkNotHoley 0 sct+                 return (Bind n (Guess t v) scv, sct)+          discharge n (PVar t) scv sct+            = return (Bind n (PVar t) scv, Bind n (PVTy t) sct)+          discharge n (PVTy t) scv sct+            = return (Bind n (PVTy t) scv, sct)+  +          checkNotHoley i (V v) +              | v == i = fail "You can't put a hole where a hole don't belong"+          checkNotHoley i (App f a) = do checkNotHoley i f+                                         checkNotHoley i a+          checkNotHoley i (Bind n b sc) = checkNotHoley (i+1) sc+          checkNotHoley _ _ = return ()+++checkProgram :: Context -> RProgram -> TC Context+checkProgram ctxt [] = return ctxt+checkProgram ctxt ((n, RConst t) : xs) +   = do (t', tt') <- trace (show n) $ check ctxt [] t+        isSet ctxt [] tt'+        checkProgram (addTyDecl n t' ctxt) xs+checkProgram ctxt ((n, RFunction (RawFun ty val)) : xs)+   = do (ty', tyt') <- trace (show n) $ check ctxt [] ty+        (val', valt') <- check ctxt [] val+        isSet ctxt [] tyt'+        converts ctxt [] ty' valt'+        checkProgram (addToCtxt n val' ty' ctxt) xs+checkProgram ctxt ((n, RData (RDatatype _ ty cons)) : xs)+   = do (ty', tyt') <- trace (show n) $ check ctxt [] ty+        isSet ctxt [] tyt'+        -- add the tycon temporarily so we can check constructors+        let ctxt' = addDatatype (Data n 0 ty' []) ctxt+        cons' <- mapM (checkCon ctxt') cons+        checkProgram (addDatatype (Data n 0 ty' cons') ctxt) xs+  where checkCon ctxt (n, cty) = do (cty', ctyt') <- check ctxt [] cty+                                    return (n, cty')++
+ src/Core/Unify.hs view
@@ -0,0 +1,137 @@+module Core.Unify(unify, Fails) where++import Core.TT+import Core.Evaluate++import Control.Monad+import Control.Monad.State+import Debug.Trace++-- Unification is applied inside the theorem prover. We're looking for holes+-- which can be filled in, by matching one term's normal form against another.+-- Returns a list of hole names paired with the term which solves them, and+-- a list of things which need to be injective.++-- terms which need to be injective, with the things we're trying to unify+-- at the time++type Injs = [(TT Name, TT Name, TT Name)]+type Fails = [(TT Name, TT Name, Env, Err)]++data UInfo = UI Int Injs Fails++unify :: Context -> Env -> TT Name -> TT Name -> TC ([(Name, TT Name)], +                                                     Injs, Fails)+unify ctxt env topx topy +    = case runStateT +             (un' False [] (normalise ctxt env topx) (normalise ctxt env topy))+             (UI 0 [] []) of+              OK (v, UI _ inj fails) -> return (filter notTrivial v, inj, reverse fails)+--               OK (_, UI s _ ((_,_,f):fs)) -> tfail $ CantUnify topx topy f s+              Error e -> tfail e+  where+    notTrivial (x, P _ x' _) = x /= x'+    notTrivial _ = True++    injective (P (DCon _ _) _ _) = True+    injective (P (TCon _ _) _ _) = True+    injective (App f a)          = injective f+    injective _                  = False++    notP (P _ _ _) = False+    notP _ = True++    sc i = do UI s x f <- get+              put (UI (s+i) x f)++    uplus u1 u2 = do UI s i f <- get+                     r <- u1+                     UI s _ f' <- get+                     if (length f == length f') +                        then return r+                        else do put (UI s i f); u2++    un' :: Bool -> [(Name, Name)] -> TT Name -> TT Name ->+           StateT UInfo +           TC [(Name, TT Name)]+    un' fn bnames (P Bound x _)  (P Bound y _)  +        | (x,y) `elem` bnames = do sc 1; return []+    un' fn bnames (P Bound x _) tm+        | holeIn env x = do UI s i f <- get+                            when (notP tm && fn) $ put (UI s ((tm, topx, topy) : i) f)+                            sc 1+                            return [(x, tm)]+    un' fn bnames tm (P Bound y _)+        | holeIn env y = do UI s i f <- get+                            when (notP tm && fn) $ put (UI s ((tm, topx, topy) : i) f)+                            sc 1+                            return [(y, tm)]+    un' fn bnames (V i) (P Bound x _)+        | fst (bnames!!i) == x || snd (bnames!!i) == x = do sc 1; return []+    un' fn bnames (P Bound x _) (V i)+        | fst (bnames!!i) == x || snd (bnames!!i) == x = do sc 1; return []++    un' fn bnames (App fx ax) (App fy ay)    +        = do uplus -- do the second one if the first adds any errors +                (do hf <- un' True bnames fx fy +                    let ax' = normalise ctxt env (substNames hf ax)+                    let ay' = normalise ctxt env (substNames hf ay)+                    ha <- un' False bnames ax' ay'+                    sc 1+                    combine bnames hf ha)+                (do ha <- un' False bnames ax ay+                    let fx' = normalise ctxt env (substNames ha fx)+                    let fy' = normalise ctxt env (substNames ha fy)+                    hf <- un' False bnames fx' fy'+                    sc 1+                    combine bnames hf ha)++    un' fn bnames x (Bind n (Lam t) (App y (P Bound n' _)))+        | n == n' = un' False bnames x y+    un' fn bnames (Bind n (Lam t) (App x (P Bound n' _))) y+        | n == n' = un' False bnames x y+    un' fn bnames (Bind x bx sx) (Bind y by sy) +        = do h1 <- uB bnames bx by+             h2 <- un' False ((x,y):bnames) sx sy+             combine bnames h1 h2+    un' fn bnames x y +        | x == y = do sc 1; return []+        | otherwise = do UI s i f <- get+                         let err = CantUnify topx topy (CantUnify x y (Msg "") s) s+                         put (UI s i ((x, y, env, err) : f))+                         return [] -- lift $ tfail err++    uB bnames (Let tx vx) (Let ty vy)+        = do h1 <- un' False bnames tx ty+             h2 <- un' False bnames ty vy+             sc 1+             combine bnames h1 h2+    uB bnames (Guess tx vx) (Guess ty vy)+        = do h1 <- un' False bnames tx ty+             h2 <- un' False bnames ty vy+             sc 1+             combine bnames h1 h2+    uB bnames (Lam tx) (Lam ty) = do sc 1; un' False bnames tx ty+    uB bnames (Pi tx) (Pi ty) = do sc 1; un' False bnames tx ty+    uB bnames (Hole tx) (Hole ty) = un' False bnames tx ty+    uB bnames (PVar tx) (PVar ty) = un' False bnames tx ty+    uB bnames x y = do UI s i f <- get+                       let err = CantUnify topx topy+                                  (CantUnify (binderTy x) (binderTy y) (Msg "") s)+                                  s+                       put (UI s i ((binderTy x, binderTy y, env, err) : f))+                       return [] -- lift $ tfail err++    combine bnames as [] = return as+    combine bnames as ((n, t) : bs)+        = case lookup n as of +            Nothing -> combine bnames (as ++ [(n,t)]) bs+            Just t' -> do un' False bnames t t'+                          sc 1+                          combine bnames as bs++holeIn :: Env -> Name -> Bool+holeIn env n = case lookup n env of+                    Just (Hole _) -> True+                    _ -> False+
+ src/Idris/AbsSyntax.hs view
@@ -0,0 +1,1319 @@+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, DeriveFunctor,+             TypeSynonymInstances, PatternGuards #-}++module Idris.AbsSyntax where++import Core.TT+import Core.Evaluate+import Core.Elaborate+import Core.Typecheck++import System.Console.Haskeline+import Control.Monad.State+import Data.List+import Data.Char+import Data.Either+import Debug.Trace++import qualified Epic.Epic as E++data IOption = IOption { opt_logLevel :: Int,+                         opt_typecase :: Bool,+                         opt_typeintype :: Bool,+                         opt_coverage :: Bool,+                         opt_showimp  :: Bool,+                         opt_repl     :: Bool,+                         opt_verbose  :: Bool+                       }+    deriving (Show, Eq)++defaultOpts = IOption 0 False False True False True True++-- TODO: Add 'module data' to IState, which can be saved out and reloaded quickly (i.e+-- without typechecking).+-- This will include all the functions and data declarations, plus fixity declarations+-- and syntax macros.++data IState = IState { tt_ctxt :: Context,+                       idris_constraints :: [(UConstraint, FC)],+                       idris_infixes :: [FixDecl],+                       idris_implicits :: Ctxt [PArg],+                       idris_statics :: Ctxt [Bool],+                       idris_classes :: Ctxt ClassInfo,+                       idris_optimisation :: Ctxt OptInfo, +                       idris_datatypes :: Ctxt TypeInfo,+                       idris_patdefs :: Ctxt [(Term, Term)], -- not exported+                       idris_log :: String,+                       idris_options :: IOption,+                       idris_name :: Int,+                       idris_metavars :: [Name],+                       syntax_rules :: [Syntax],+                       syntax_keywords :: [String],+                       imported :: [FilePath],+                       idris_prims :: [(Name, ([E.Name], E.Term))],+                       idris_objs :: [FilePath],+                       idris_libs :: [String],+                       idris_hdrs :: [String],+                       last_proof :: Maybe (Name, [String]),+                       errLine :: Maybe Int,+                       lastParse :: Maybe Name, +                       indent_stack :: [Int],+                       brace_stack :: [Maybe Int],+                       hide_list :: [(Name, Maybe Accessibility)],+                       default_access :: Accessibility,+                       ibc_write :: [IBCWrite],+                       compiled_so :: Maybe String+                     }+             +-- information that needs writing for the current module's .ibc file+data IBCWrite = IBCFix FixDecl+              | IBCImp Name+              | IBCStatic Name+              | IBCClass Name+              | IBCData Name+              | IBCOpt Name+              | IBCSyntax Syntax+              | IBCKeyword String+              | IBCImport FilePath+              | IBCObj FilePath+              | IBCLib String+              | IBCHeader String+              | IBCAccess Name Accessibility+              | IBCDef Name -- i.e. main context+  deriving Show++idrisInit = IState initContext [] [] emptyContext emptyContext emptyContext+                   emptyContext emptyContext emptyContext+                   "" defaultOpts 6 [] [] [] [] [] [] [] [] +                   Nothing Nothing Nothing [] [] [] Hidden [] Nothing++-- The monad for the main REPL - reading and processing files and updating +-- global state (hence the IO inner monad).+type Idris = StateT IState (InputT IO)++getContext :: Idris Context+getContext = do i <- get; return (tt_ctxt i)++getObjectFiles :: Idris [FilePath]+getObjectFiles = do i <- get; return (idris_objs i)++addObjectFile :: FilePath -> Idris ()+addObjectFile f = do i <- get; put (i { idris_objs = f : idris_objs i })++getLibs :: Idris [String]+getLibs = do i <- get; return (idris_libs i)++addLib :: String -> Idris ()+addLib f = do i <- get; put (i { idris_libs = f : idris_libs i })++addHdr :: String -> Idris ()+addHdr f = do i <- get; put (i { idris_hdrs = f : idris_hdrs i })++setAccessibility :: Name -> Accessibility -> Idris ()+setAccessibility n a +         = do i <- get+              let ctxt = setAccess n a (tt_ctxt i)+              put (i { tt_ctxt = ctxt })++addIBC :: IBCWrite -> Idris ()+addIBC ibc@(IBCDef n) +           = do i <- get+                when (notDef (ibc_write i)) $+                  put (i { ibc_write = ibc : ibc_write i })+   where notDef [] = True+         notDef (IBCDef n': is) | n == n' = False+         notDef (_ : is) = notDef is+addIBC ibc = do i <- get; put (i { ibc_write = ibc : ibc_write i }) ++clearIBC :: Idris ()+clearIBC = do i <- get; put (i { ibc_write = [] })++getHdrs :: Idris [String]+getHdrs = do i <- get; return (idris_hdrs i)++setErrLine :: Int -> Idris ()+setErrLine x = do i <- get;+                  case (errLine i) of+                      Nothing -> put (i { errLine = Just x })+                      Just _ -> return ()++clearErr :: Idris ()+clearErr = do i <- get+              put (i { errLine = Nothing })++getSO :: Idris (Maybe String)+getSO = do i <- get+           return (compiled_so i)++setSO :: Maybe String -> Idris ()+setSO s = do i <- get+             put (i { compiled_so = s })++getIState :: Idris IState+getIState = get++putIState :: IState -> Idris ()+putIState = put++getName :: Idris Int+getName = do i <- get;+             let idx = idris_name i;+             put (i { idris_name = idx + 1 })+             return idx++checkUndefined :: FC -> Name -> Idris ()+checkUndefined fc n +    = do i <- getContext+         case lookupTy Nothing n i of+             (_:_)  -> fail $ show fc ++ ":" ++ +                       show n ++ " already defined"+             _ -> return ()++setContext :: Context -> Idris ()+setContext ctxt = do i <- get; put (i { tt_ctxt = ctxt } )++updateContext :: (Context -> Context) -> Idris ()+updateContext f = do i <- get; put (i { tt_ctxt = f (tt_ctxt i) } )++addConstraints :: FC -> (Int, [UConstraint]) -> Idris ()+addConstraints fc (v, cs)+    = do i <- get+         let ctxt = tt_ctxt i+         let ctxt' = ctxt { uconstraints = cs ++ uconstraints ctxt,+                            next_tvar = v }+         let ics = zip cs (repeat fc) ++ idris_constraints i+         put (i { tt_ctxt = ctxt', idris_constraints = ics })++addDeferred :: [(Name, Type)] -> Idris ()+addDeferred ns = do mapM_ (\(n, t) -> updateContext (addTyDecl n (tidyNames [] t))) ns+                    i <- get+                    put (i { idris_metavars = map fst ns ++ idris_metavars i })+  where tidyNames used (Bind (MN i x) b sc)+            = let n' = uniqueName (UN x) used in+                  Bind n' b $ tidyNames (n':used) sc+        tidyNames used (Bind n b sc)+            = let n' = uniqueName n used in+                  Bind n' b $ tidyNames (n':used) sc+        tidyNames used b = b++solveDeferred :: Name -> Idris ()+solveDeferred n = do i <- get+                     put (i { idris_metavars = idris_metavars i \\ [n] })++iputStrLn :: String -> Idris ()+iputStrLn = liftIO . putStrLn++iWarn :: FC -> String -> Idris ()+iWarn fc err = liftIO $ putStrLn (show fc ++ ":" ++ err)++setLogLevel :: Int -> Idris ()+setLogLevel l = do i <- get+                   let opts = idris_options i+                   let opt' = opts { opt_logLevel = l }+                   put (i { idris_options = opt' } )++logLevel :: Idris Int+logLevel = do i <- get+              return (opt_logLevel (idris_options i))++useREPL :: Idris Bool+useREPL = do i <- get+             return (opt_repl (idris_options i))++setREPL :: Bool -> Idris ()+setREPL t = do i <- get+               let opts = idris_options i+               let opt' = opts { opt_repl = t }+               put (i { idris_options = opt' })++verbose :: Idris Bool+verbose = do i <- get+             return (opt_verbose (idris_options i))++setVerbose :: Bool -> Idris ()+setVerbose t = do i <- get+                  let opts = idris_options i+                  let opt' = opts { opt_verbose = t }+                  put (i { idris_options = opt' })++typeInType :: Idris Bool+typeInType = do i <- get+                return (opt_typeintype (idris_options i))++setTypeInType :: Bool -> Idris ()+setTypeInType t = do i <- get+                     let opts = idris_options i+                     let opt' = opts { opt_typeintype = t }+                     put (i { idris_options = opt' })++coverage :: Idris Bool+coverage = do i <- get+              return (opt_coverage (idris_options i))++setCoverage :: Bool -> Idris ()+setCoverage t = do i <- get+                   let opts = idris_options i+                   let opt' = opts { opt_coverage = t }+                   put (i { idris_options = opt' })++impShow :: Idris Bool+impShow = do i <- get+             return (opt_showimp (idris_options i))++setImpShow :: Bool -> Idris ()+setImpShow t = do i <- get+                  let opts = idris_options i+                  let opt' = opts { opt_showimp = t }+                  put (i { idris_options = opt' })++logLvl :: Int -> String -> Idris ()+logLvl l str = do i <- get+                  let lvl = opt_logLevel (idris_options i)+                  when (lvl >= l)+                      $ do liftIO (putStrLn str)+                           put (i { idris_log = idris_log i ++ str ++ "\n" } )++iLOG :: String -> Idris ()+iLOG = logLvl 1++noErrors :: Idris Bool+noErrors = do i <- get+              case errLine i of+                Nothing -> return True+                _       -> return False++setTypeCase :: Bool -> Idris ()+setTypeCase t = do i <- get+                   let opts = idris_options i+                   let opt' = opts { opt_typecase = t }+                   put (i { idris_options = opt' })++-- Commands in the REPL++data Command = Quit | Help | Eval PTerm | Check PTerm | Reload | Edit+             | Compile String | Execute | ExecVal PTerm+             | Metavars | Prove Name | AddProof | Universes+             | TTShell +             | LogLvl Int | Spec PTerm | HNF PTerm | Defn Name | Info Name+             | NOP++-- Parsed declarations++data Fixity = Infixl { prec :: Int } +            | Infixr { prec :: Int }+            | InfixN { prec :: Int } +            | PrefixN { prec :: Int }+    deriving Eq+{-! +deriving instance Binary Fixity +!-}++instance Show Fixity where+    show (Infixl i) = "infixl " ++ show i+    show (Infixr i) = "infixr " ++ show i+    show (InfixN i) = "infix " ++ show i+    show (PrefixN i) = "prefix " ++ show i++data FixDecl = Fix Fixity String +    deriving (Show, Eq)+{-! +deriving instance Binary FixDecl +!-}++instance Ord FixDecl where+    compare (Fix x _) (Fix y _) = compare (prec x) (prec y)+++data Static = Static | Dynamic+  deriving (Show, Eq)+{-! +deriving instance Binary Static +!-}++-- Mark bindings with their explicitness, and laziness+data Plicity = Imp { plazy :: Bool,+                     pstatic :: Static }+             | Exp { plazy :: Bool,+                     pstatic :: Static }+             | Constraint { plazy :: Bool,+                            pstatic :: Static }+  deriving (Show, Eq)++{-!+deriving instance Binary Plicity +!-}++impl = Imp False Dynamic+expl = Exp False Dynamic+constraint = Constraint False Static++data FnOpt = Inlinable | Partial | Abstract | Private | TCGen+    deriving (Show, Eq)++type FnOpts = [FnOpt]++inlinable :: FnOpts -> Bool+inlinable = elem Inlinable++data PDecl' t = PFix     FC Fixity [String] -- fixity declaration+              | PTy      SyntaxInfo FC Name t   -- type declaration+              | PClauses FC FnOpts Name [PClause' t]   -- pattern clause+              | PData    SyntaxInfo FC (PData' t)      -- data declaration+              | PParams  FC [(Name, t)] [PDecl' t] -- params block+              | PNamespace String [PDecl' t] -- new namespace+              | PClass   SyntaxInfo FC +                         [t] -- constraints+                         Name+                         [(Name, t)] -- parameters+                         [PDecl' t] -- declarations+              | PInstance SyntaxInfo FC [t] -- constraints+                                        Name -- class+                                        [t] -- parameters+                                        t -- full instance type+                                        [PDecl' t]+              | PSyntax  FC Syntax+              | PDirective (Idris ())+    deriving Functor++data PClause' t = PClause Name t [t] t [PDecl' t]+                | PWith   Name t [t] t [PDecl' t]+                | PClauseR       [t] t [PDecl' t]+                | PWithR         [t] t [PDecl' t]+    deriving Functor++data PData' t  = PDatadecl { d_name :: Name,+                             d_tcon :: t,+                             d_cons :: [(Name, t, FC)] }+    deriving Functor++-- Handy to get a free function for applying PTerm -> PTerm functions+-- across a program, by deriving Functor++type PDecl   = PDecl' PTerm+type PData   = PData' PTerm+type PClause = PClause' PTerm ++-- get all the names declared in a decl++declared :: PDecl -> [Name]+declared (PFix _ _ _) = []+declared (PTy _ _ n t) = [n]+declared (PClauses _ _ n _) = [] -- not a declaration+declared (PData _ _ (PDatadecl n _ ts)) = n : map fstt ts+   where fstt (a, _, _) = a+declared (PParams _ _ ds) = concatMap declared ds+declared (PNamespace _ ds) = concatMap declared ds+-- declared (PImport _) = []++updateN :: [(Name, Name)] -> Name -> Name+updateN ns n | Just n' <- lookup n ns = n'+updateN _  n = n++updateNs :: [(Name, Name)] -> PTerm -> PTerm+updateNs [] t = t+updateNs ns t = mapPT updateRef t+  where updateRef (PRef fc f) = PRef fc (updateN ns f) +        updateRef t = t++-- updateDNs :: [(Name, Name)] -> PDecl -> PDecl+-- updateDNs [] t = t+-- updateDNs ns (PTy s f n t)    | Just n' <- lookup n ns = PTy s f n' t+-- updateDNs ns (PClauses f n c) | Just n' <- lookup n ns = PClauses f n' (map updateCNs c)+--   where updateCNs ns (PClause n l ts r ds) +--             = PClause (updateN ns n) (fmap (updateNs ns) l)+--                                      (map (fmap (updateNs ns)) ts)+--                                      (fmap (updateNs ns) r)+--                                      (map (updateDNs ns) ds)+-- updateDNs ns c = c++-- High level language terms++data PTerm = PQuote Raw+           | PRef FC Name+           | PLam Name PTerm PTerm+           | PPi  Plicity Name PTerm PTerm+           | PLet Name PTerm PTerm PTerm +           | PApp FC PTerm [PArg]+           | PCase FC PTerm [(PTerm, PTerm)]+           | PTrue FC+           | PFalse FC+           | PRefl FC+           | PResolveTC FC+           | PEq FC PTerm PTerm+           | PPair FC PTerm PTerm+           | PDPair FC PTerm PTerm PTerm+           | PAlternative [PTerm]+           | PHidden PTerm -- irrelevant or hidden pattern+           | PSet+           | PConstant Const+           | Placeholder+           | PDoBlock [PDo]+           | PIdiom FC PTerm+           | PReturn FC+           | PMetavar Name+           | PProof [PTactic]+           | PTactics [PTactic] -- as PProof, but no auto solving+           | PElabError String -- error to report on elaboration+           | PImpossible -- special case for declaring when an LHS can't typecheck+    deriving Eq+{-! +deriving instance Binary PTerm +!-}++mapPT :: (PTerm -> PTerm) -> PTerm -> PTerm+mapPT f t = f (mpt t) where+  mpt (PLam n t s) = PLam n (mapPT f t) (mapPT f s)+  mpt (PPi p n t s) = PPi p n (mapPT f t) (mapPT f s)+  mpt (PLet n ty v s) = PLet n (mapPT f ty) (mapPT f v) (mapPT f s)+  mpt (PApp fc t as) = PApp fc (mapPT f t) (map (fmap (mapPT f)) as)+  mpt (PCase fc c os) = PCase fc (mapPT f c) (map (pmap (mapPT f)) os)+  mpt (PEq fc l r) = PEq fc (mapPT f l) (mapPT f r)+  mpt (PPair fc l r) = PPair fc (mapPT f l) (mapPT f r)+  mpt (PDPair fc l t r) = PDPair fc (mapPT f l) (mapPT f t) (mapPT f r)+  mpt (PAlternative as) = PAlternative (map (mapPT f) as)+  mpt (PHidden t) = PHidden (mapPT f t)+  mpt (PDoBlock ds) = PDoBlock (map (fmap (mapPT f)) ds)+  mpt (PProof ts) = PProof (map (fmap (mapPT f)) ts)+  mpt (PTactics ts) = PTactics (map (fmap (mapPT f)) ts)+  mpt x = x+++data PTactic' t = Intro [Name] | Intros | Focus Name+                | Refine Name [Bool] | Rewrite t | LetTac Name t+                | Exact t | Compute | Trivial+                | Solve+                | Attack+                | ProofState | ProofTerm | Undo+                | Try (PTactic' t) (PTactic' t)+                | TSeq (PTactic' t) (PTactic' t)+                | Qed+    deriving (Show, Eq, Functor)+{-! +deriving instance Binary PTactic' +!-}++type PTactic = PTactic' PTerm++data PDo' t = DoExp  FC t+            | DoBind FC Name t+            | DoBindP FC t t+            | DoLet  FC Name t t+            | DoLetP FC t t+    deriving (Eq, Functor)+{-! +deriving instance Binary PDo' +!-}++type PDo = PDo' PTerm++-- The priority gives a hint as to elaboration order. Best to elaborate+-- things early which will help give a more concrete type to other+-- variables, e.g. a before (interpTy a).++data PArg' t = PImp { priority :: Int, +                      lazyarg :: Bool, pname :: Name, getTm :: t }+             | PExp { priority :: Int,+                      lazyarg :: Bool, getTm :: t }+             | PConstraint { priority :: Int,+                             lazyarg :: Bool, getTm :: t }+    deriving (Show, Eq, Functor)+{-! +deriving instance Binary PArg' +!-}++pimp = PImp 0 True+pexp = PExp 0 False+pconst = PConstraint 0 False++type PArg = PArg' PTerm++-- Type class data++data ClassInfo = CI { instanceName :: Name,+                      class_methods :: [(Name, PTerm)],+                      class_defaults :: [(Name, Name)], -- method name -> default impl+                      class_params :: [Name] }+    deriving Show+{-! +deriving instance Binary ClassInfo +!-}++data OptInfo = Optimise { collapsible :: Bool,+                          forceable :: [Int], -- argument positions+                          recursive :: [Int] }+    deriving Show+{-! +deriving instance Binary OptInfo +!-}+++data TypeInfo = TI { con_names :: [Name] }+    deriving Show+{-!+deriving instance Binary TypeInfo+!-}++-- Syntactic sugar info ++data DSL = DSL { dsl_bind    :: PTerm,+                 dsl_return  :: PTerm,+                 dsl_apply   :: PTerm,+                 dsl_pure    :: PTerm,+                 index_first :: Maybe PTerm,+                 index_next  :: Maybe PTerm,+                 dsl_lambda  :: Maybe PTerm,+                 dsl_let     :: Maybe PTerm+               }+    deriving Show++data SynContext = PatternSyntax | TermSyntax | AnySyntax+    deriving Show+{-! +deriving instance Binary SynContext +!-}++data Syntax = Rule [SSymbol] PTerm SynContext+    deriving Show+{-! +deriving instance Binary Syntax +!-}++data SSymbol = Keyword Name+             | Symbol String+             | Expr Name+    deriving Show+{-! +deriving instance Binary SSymbol +!-}++initDSL = DSL (PRef f (UN ">>=")) +              (PRef f (UN "return"))+              (PRef f (UN "<$>"))+              (PRef f (UN "pure"))+              Nothing+              Nothing+              Nothing+              Nothing+  where f = FC "(builtin)" 0++data SyntaxInfo = Syn { using :: [(Name, PTerm)],+                        syn_params :: [(Name, PTerm)],+                        syn_namespace :: [String],+                        no_imp :: [Name],+                        decoration :: Name -> Name,+                        inPattern :: Bool,+                        dsl_info :: DSL }+    deriving Show++defaultSyntax = Syn [] [] [] [] id False initDSL++--- Pretty printing declarations and terms++instance Show PTerm where+    show tm = showImp False tm++instance Show PDecl where+    show (PFix _ f ops) = show f ++ " " ++ showSep ", " ops+    show (PTy _ _ n ty) = show n ++ " : " ++ show ty+    show (PClauses _ _ n c) = showSep "\n" (map show c)+    show (PData _ _ d) = show d++instance Show PClause where+    show c = showCImp True c++instance Show PData where+    show d = showDImp False d++showCImp :: Bool -> PClause -> String+showCImp impl (PClause n l ws r w) +   = showImp impl l ++ showWs ws ++ " = " ++ showImp impl r+             ++ " where " ++ show w +  where+    showWs [] = ""+    showWs (x : xs) = " | " ++ showImp impl x ++ showWs xs+showCImp impl (PWith n l ws r w) +   = showImp impl l ++ showWs ws ++ " with " ++ showImp impl r+             ++ " { " ++ show w ++ " } " +  where+    showWs [] = ""+    showWs (x : xs) = " | " ++ showImp impl x ++ showWs xs+++showDImp :: Bool -> PData -> String+showDImp impl (PDatadecl n ty cons) +   = "data " ++ show n ++ " : " ++ showImp impl ty ++ " where\n\t"+     ++ showSep "\n\t| " +            (map (\ (n, t, _) -> show n ++ " : " ++ showImp impl t) cons)++getImps :: [PArg] -> [(Name, PTerm)]+getImps [] = []+getImps (PImp _ _ n tm : xs) = (n, tm) : getImps xs+getImps (_ : xs) = getImps xs++getExps :: [PArg] -> [PTerm]+getExps [] = []+getExps (PExp _ _ tm : xs) = tm : getExps xs+getExps (_ : xs) = getExps xs++getConsts :: [PArg] -> [PTerm]+getConsts [] = []+getConsts (PConstraint _ _ tm : xs) = tm : getConsts xs+getConsts (_ : xs) = getConsts xs++getAll :: [PArg] -> [PTerm]+getAll = map getTm ++showImp :: Bool -> PTerm -> String+showImp impl tm = se 10 tm where+    se p (PQuote r) = "![" ++ show r ++ "]"+    se p (PRef _ n) = if impl then show n+                              else showbasic n+      where showbasic n@(UN _) = show n+            showbasic (MN _ s) = s+            showbasic (NS n s) = showSep "." (reverse s) ++ "." ++ showbasic n+    se p (PLam n ty sc) = bracket p 2 $ "\\ " ++ show n ++ " => " ++ show sc+    se p (PLet n ty v sc) = bracket p 2 $ "let " ++ show n ++ " = " ++ se 10 v +++                            " in " ++ se 10 sc +    se p (PPi (Exp l s) n ty sc)+        | n `elem` allNamesIn sc = bracket p 2 $+                                    if l then "|(" else "(" ++ +                                    show n ++ " : " ++ se 10 ty ++ +                                    ") " ++ st +++                                    "-> " ++ se 10 sc+        | otherwise = bracket p 2 $ se 0 ty ++ " " ++ st ++ "-> " ++ se 10 sc+      where st = case s of+                    Static -> "[static] "+                    _ -> ""+    se p (PPi (Imp l s) n ty sc)+        | impl = bracket p 2 $ if l then "|{" else "{" ++ +                               show n ++ " : " ++ se 10 ty ++ +                               "} " ++ st ++ "-> " ++ se 10 sc+        | otherwise = se 10 sc+      where st = case s of+                    Static -> "[static] "+                    _ -> ""+    se p (PPi (Constraint _ _) n ty sc)+        = bracket p 2 $ se 10 ty ++ " => " ++ se 10 sc+    se p (PApp _ (PRef _ f) [])+        | not impl = show f+    se p (PApp _ (PRef _ op@(UN (f:_))) args)+        | length (getExps args) == 2 && not impl && not (isAlpha f) +            = let [l, r] = getExps args in+              bracket p 1 $ se 1 l ++ " " ++ show op ++ " " ++ se 0 r+    se p (PApp _ f as) +        = let args = getExps as in+              bracket p 1 $ se 1 f ++ if impl then concatMap sArg as+                                              else concatMap seArg args+    se p (PCase _ scr opts) = "case " ++ se 10 scr ++ " of " ++ showSep " | " (map sc opts)+       where sc (l, r) = se 10 l ++ " => " ++ se 10 r+    se p (PHidden tm) = "." ++ se 0 tm+    se p (PRefl _) = "refl"+    se p (PResolveTC _) = "resolvetc"+    se p (PTrue _) = "()"+    se p (PFalse _) = "_|_"+    se p (PEq _ l r) = bracket p 2 $ se 10 l ++ " = " ++ se 10 r+    se p (PPair _ l r) = "(" ++ se 10 l ++ ", " ++ se 10 r ++ ")"+    se p (PDPair _ l t r) = "(" ++ se 10 l ++ " ** " ++ se 10 r ++ ")"+    se p (PAlternative as) = "(|" ++ showSep " , " (map (se 10) as) ++ "|)"+    se p PSet = "Set"+    se p (PConstant c) = show c+    se p (PProof ts) = "proof { " ++ show ts ++ "}"+    se p (PTactics ts) = "tactics { " ++ show ts ++ "}"+    se p (PMetavar n) = "?" ++ show n+    se p (PReturn f) = "return"+    se p PImpossible = "impossible"+    se p Placeholder = "_"+    se p (PDoBlock _) = "do block show not implemented"+    se p (PElabError s) = s+--     se p x = "Not implemented"++    sArg (PImp _ _ n tm) = siArg (n, tm)+    sArg (PExp _ _ tm) = seArg tm+    sArg (PConstraint _ _ tm) = scArg tm++    seArg arg      = " " ++ se 0 arg+    siArg (n, val) = " {" ++ show n ++ " = " ++ se 10 val ++ "}"+    scArg val = " {{" ++ se 10 val ++ "}}"++    bracket outer inner str | inner > outer = "(" ++ str ++ ")"+                            | otherwise = str++allNamesIn :: PTerm -> [Name]+allNamesIn tm = nub $ ni [] tm +  where+    ni env (PRef _ n)        +        | not (n `elem` env) = [n]+    ni env (PApp _ f as)   = ni env f ++ concatMap (ni env) (map getTm as)+    ni env (PCase _ c os)  = ni env c ++ concatMap (ni env) (map snd os)+    ni env (PLam n ty sc)  = ni env ty ++ ni (n:env) sc+    ni env (PPi _ n ty sc) = ni env ty ++ ni (n:env) sc+    ni env (PHidden tm)    = ni env tm+    ni env (PEq _ l r)     = ni env l ++ ni env r+    ni env (PPair _ l r)   = ni env l ++ ni env r+    ni env (PDPair _ (PRef _ n) t r)  = ni env t ++ ni (n:env) r+    ni env (PDPair _ l t r)  = ni env l ++ ni env t ++ ni env r+    ni env (PAlternative ls) = concatMap (ni env) ls+    ni env _               = []++namesIn :: [(Name, PTerm)] -> IState -> PTerm -> [Name]+namesIn uvars ist tm = nub $ ni [] tm +  where+    ni env (PRef _ n)        +        | not (n `elem` env) +            = case lookupTy Nothing n (tt_ctxt ist) of+                [] -> [n]+                _ -> if n `elem` (map fst uvars) then [n] else []+    ni env (PApp _ f as)   = ni env f ++ concatMap (ni env) (map getTm as)+    ni env (PCase _ c os)  = ni env c ++ concatMap (ni env) (map snd os)+    ni env (PLam n ty sc)  = ni env ty ++ ni (n:env) sc+    ni env (PPi _ n ty sc) = ni env ty ++ ni (n:env) sc+    ni env (PEq _ l r)     = ni env l ++ ni env r+    ni env (PPair _ l r)   = ni env l ++ ni env r+    ni env (PDPair _ (PRef _ n) t r) = ni env t ++ ni (n:env) r+    ni env (PDPair _ l t r) = ni env l ++ ni env t ++ ni env r+    ni env (PAlternative as) = concatMap (ni env) as+    ni env (PHidden tm)    = ni env tm+    ni env _               = []++-- For inferring types of things++bi = FC "builtin" 0++inferTy   = MN 0 "__Infer"+inferCon  = MN 0 "__infer"+inferDecl = PDatadecl inferTy +                      PSet+                      [(inferCon, PPi impl (MN 0 "A") PSet (+                                  PPi expl (MN 0 "a") (PRef bi (MN 0 "A"))+                                  (PRef bi inferTy)), bi)]++infTerm t = PApp bi (PRef bi inferCon) [pimp (MN 0 "A") Placeholder, pexp t]+infP = P (TCon 6 0) inferTy (Set (UVal 0))++getInferTerm, getInferType :: Term -> Term+getInferTerm (Bind n b sc) = Bind n b $ getInferTerm sc+getInferTerm (App (App _ _) tm) = tm+getInferTerm tm = error ("getInferTerm " ++ show tm)++getInferType (Bind n b sc) = Bind n b $ getInferType sc+getInferType (App (App _ ty) _) = ty++-- Handy primitives: Unit, False, Pair, MkPair, =, mkForeign++primNames = [unitTy, unitCon,+             falseTy, pairTy, pairCon,+             eqTy, eqCon, inferTy, inferCon]++unitTy   = MN 0 "__Unit"+unitCon  = MN 0 "__II"+unitDecl = PDatadecl unitTy PSet+                     [(unitCon, PRef bi unitTy, bi)]++falseTy   = MN 0 "__False"+falseDecl = PDatadecl falseTy PSet []++pairTy    = MN 0 "__Pair"+pairCon   = MN 0 "__MkPair"+pairDecl  = PDatadecl pairTy (piBind [(n "A", PSet), (n "B", PSet)] PSet)+            [(pairCon, PPi impl (n "A") PSet (+                       PPi impl (n "B") PSet (+                       PPi expl (n "a") (PRef bi (n "A")) (+                       PPi expl (n "b") (PRef bi (n "B"))  +                           (PApp bi (PRef bi pairTy) [pexp (PRef bi (n "A")),+                                                pexp (PRef bi (n "B"))])))), bi)]+    where n a = MN 0 a++eqTy = UN "="+eqCon = UN "refl"+eqDecl = PDatadecl eqTy (piBind [(n "a", PSet), (n "b", PSet),+                                 (n "x", PRef bi (n "a")), (n "y", PRef bi (n "b"))]+                                 PSet)+                [(eqCon, PPi impl (n "a") PSet (+                         PPi impl (n "x") (PRef bi (n "a"))+                           (PApp bi (PRef bi eqTy) [pimp (n "a") Placeholder,+                                                    pimp (n "b") Placeholder,+                                                    pexp (PRef bi (n "x")),+                                                    pexp (PRef bi (n "x"))])), bi)]+    where n a = MN 0 a++-- Defined in builtins.idr+sigmaTy   = UN "Exists"+existsCon = UN "Ex_intro"++piBind :: [(Name, PTerm)] -> PTerm -> PTerm+piBind [] t = t+piBind ((n, ty):ns) t = PPi expl n ty (piBind ns t)+    +tcname (UN ('@':_)) = True+tcname (NS n _) = tcname n+tcname _ = False++-- Dealing with parameters++expandParams :: (Name -> Name) -> [(Name, PTerm)] -> [Name] -> PTerm -> PTerm+expandParams dec ps ns tm = en tm+  where+    -- if we shadow a name (say in a lambda binding) that is used in a call to+    -- a lifted function, we need access to both names - once in the scope of the+    -- binding and once to call the lifted functions. So we'll explicitly shadow+    -- it. (Yes, it's a hack. The alternative would be to resolve names earlier+    -- but we didn't...)+    +    mkShadow (UN n) = MN 0 n+    mkShadow (MN i n) = MN (i+1) n+    mkShadow (NS x s) = NS (mkShadow x) s++    en (PLam n t s)+       | n `elem` map fst ps+               = let n' = mkShadow n in+                     PLam n' (en t) (en (shadow n n' s))+       | otherwise = PLam n (en t) (en s)+    en (PPi p n t s) +       | n `elem` map fst ps+               = let n' = mkShadow n in+                     PPi p n' (en t) (en (shadow n n' s))+       | otherwise = PPi p n (en t) (en s)+    en (PLet n ty v s) +       | n `elem` map fst ps+               = let n' = mkShadow n in+                     PLet n' (en ty) (en v) (en (shadow n n' s))+       | otherwise = PLet n (en ty) (en v) (en s)+    en (PEq f l r) = PEq f (en l) (en r)+    en (PPair f l r) = PPair f (en l) (en r)+    en (PDPair f l t r) = PDPair f (en l) (en t) (en r)+    en (PAlternative as) = PAlternative (map en as)+    en (PHidden t) = PHidden (en t)+    en (PDoBlock ds) = PDoBlock (map (fmap en) ds)+    en (PProof ts)   = PProof (map (fmap en) ts)+    en (PTactics ts) = PTactics (map (fmap en) ts)++    en (PQuote (Var n)) +        | n `elem` ns = PQuote (Var (dec n))+    en (PApp fc (PRef fc' n) as)+        | n `elem` ns = PApp fc (PRef fc' (dec n)) +                           (map (pexp . (PRef fc)) (map fst ps) ++ (map (fmap en) as))+    en (PRef fc n)+        | n `elem` ns = PApp fc (PRef fc (dec n)) +                           (map (pexp . (PRef fc)) (map fst ps))+    en (PApp fc f as) = PApp fc (en f) (map (fmap en) as)+    en (PCase fc c os) = PCase fc (en c) (map (pmap en) os)+    en t = t++expandParamsD :: IState -> +                 (Name -> Name) -> [(Name, PTerm)] -> [Name] -> PDecl -> PDecl+expandParamsD ist dec ps ns (PTy syn fc n ty) +    = if n `elem` ns+         then PTy syn fc (dec n) (piBind ps (expandParams dec ps ns ty))+         else PTy syn fc n (expandParams dec ps ns ty)+expandParamsD ist dec ps ns (PClauses fc opts n cs)+    = let n' = if n `elem` ns then dec n else n in+          PClauses fc opts n' (map expandParamsC cs)+  where+    expandParamsC (PClause n lhs ws rhs ds)+        = let -- ps' = updateps True (namesIn ist rhs) (zip ps [0..])+              ps'' = updateps False (namesIn [] ist lhs) (zip ps [0..])+              n' = if n `elem` ns then dec n else n in+              PClause n' (expandParams dec ps'' ns lhs)+                         (map (expandParams dec ps'' ns) ws)+                         (expandParams dec ps'' ns rhs)+                         (map (expandParamsD ist dec ps'' ns) ds)+    expandParamsC (PWith n lhs ws wval ds)+        = let -- ps' = updateps True (namesIn ist wval) (zip ps [0..])+              ps'' = updateps False (namesIn [] ist lhs) (zip ps [0..])+              n' = if n `elem` ns then dec n else n in+              PWith n' (expandParams dec ps'' ns lhs)+                       (map (expandParams dec ps'' ns) ws)+                       (expandParams dec ps'' ns wval)+                       (map (expandParamsD ist dec ps'' ns) ds)+    updateps yn nm [] = []+    updateps yn nm (((a, t), i):as)+        | (a `elem` nm) == yn = (a, t) : updateps yn nm as+        | otherwise = (MN i (show n ++ "_u"), t) : updateps yn nm as++expandParamsD ist dec ps ns d = d++-- Calculate a priority for a type, for deciding elaboration order+-- * if it's just a type variable or concrete type, do it early (0)+-- * if there's only type variables and injective constructors, do it next (1)+-- * if there's a function type, next (2)+-- * finally, everything else (3)++getPriority :: IState -> PTerm -> Int+getPriority i tm = pri tm +  where+    pri (PRef _ n) =+        case lookupP Nothing n (tt_ctxt i) of+            ((P (DCon _ _) _ _):_) -> 1+            ((P (TCon _ _) _ _):_) -> 1+            ((P Ref _ _):_) -> 4+            [] -> 0 -- must be locally bound, if it's not an error...+    pri (PPi _ _ x y) = max 5 (max (pri x) (pri y))+    pri (PTrue _) = 0+    pri (PFalse _) = 0+    pri (PRefl _) = 1+    pri (PEq _ l r) = max 1 (max (pri l) (pri r))+    pri (PApp _ f as) = max 1 (max (pri f) (foldr max 0 (map (pri.getTm) as))) +    pri (PCase _ f as) = max 1 (max (pri f) (foldr max 0 (map (pri.snd) as))) +    pri (PPair _ l r) = max 1 (max (pri l) (pri r))+    pri (PDPair _ l t r) = max 1 (max (pri l) (max (pri t) (pri r)))+    pri (PAlternative as) = maximum (map pri as)+    pri (PConstant _) = 0+    pri Placeholder = 1+    pri _ = 3++-- Dealing with implicit arguments++-- Add implicit Pi bindings for any names in the term which appear in an+-- argument position.++-- This has become a right mess already. Better redo it some time...++implicit :: SyntaxInfo -> Name -> PTerm -> Idris PTerm+implicit syn n ptm +    = do i <- get+         let (tm', impdata) = implicitise syn i ptm+         let (tm'', spos) = findStatics i tm'+         put (i { idris_implicits = addDef n impdata (idris_implicits i) })+         addIBC (IBCImp n)+         logLvl 5 ("Implicit " ++ show n ++ " " ++ show impdata)+         i <- get+         put (i { idris_statics = addDef n spos (idris_statics i) })+         addIBC (IBCStatic n)+         return tm''++implicitise :: SyntaxInfo -> IState -> PTerm -> (PTerm, [PArg])+implicitise syn ist tm+    = let (declimps, ns') = execState (imps True [] tm) ([], []) +          ns = ns' \\ (map fst pvars ++ no_imp syn) in+          if null ns +            then (tm, reverse declimps) +            else implicitise syn ist (pibind uvars ns tm)+  where+    uvars = using syn+    pvars = syn_params syn++    dropAll (x:xs) ys | x `elem` ys = dropAll xs ys+                      | otherwise   = x : dropAll xs ys+    dropAll [] ys = []++    imps top env (PApp _ f as)+       = do (decls, ns) <- get+            let isn = concatMap (namesIn uvars ist) (map getTm as)+            put (decls, nub (ns ++ (isn `dropAll` (env ++ map fst (getImps decls)))))+    imps top env (PPi (Imp l _) n ty sc) +        = do let isn = nub (namesIn uvars ist ty) `dropAll` [n]+             (decls , ns) <- get+             put (PImp (getPriority ist ty) l n ty : decls, +                  nub (ns ++ (isn `dropAll` (env ++ map fst (getImps decls)))))+             imps True (n:env) sc+    imps top env (PPi (Exp l _) n ty sc) +        = do let isn = nub (namesIn uvars ist ty ++ case sc of+                            (PRef _ x) -> namesIn uvars ist sc `dropAll` [n]+                            _ -> [])+             (decls, ns) <- get -- ignore decls in HO types+             put (PExp (getPriority ist ty) l ty : decls, +                  nub (ns ++ (isn `dropAll` (env ++ map fst (getImps decls)))))+             imps True (n:env) sc+    imps top env (PPi (Constraint l _) n ty sc)+        = do let isn = nub (namesIn uvars ist ty ++ case sc of+                            (PRef _ x) -> namesIn uvars ist sc `dropAll` [n]+                            _ -> [])+             (decls, ns) <- get -- ignore decls in HO types+             put (PConstraint 10 l ty : decls, +                  nub (ns ++ (isn `dropAll` (env ++ map fst (getImps decls)))))+             imps True (n:env) sc+    imps top env (PEq _ l r)+        = do (decls, ns) <- get+             let isn = namesIn uvars ist l ++ namesIn uvars ist r+             put (decls, nub (ns ++ (isn `dropAll` (env ++ map fst (getImps decls)))))+    imps top env (PPair _ l r)+        = do (decls, ns) <- get+             let isn = namesIn uvars ist l ++ namesIn uvars ist r+             put (decls, nub (ns ++ (isn `dropAll` (env ++ map fst (getImps decls)))))+    imps top env (PDPair _ (PRef _ n) t r)+        = do (decls, ns) <- get+             let isn = nub (namesIn uvars ist t ++ namesIn uvars ist r) \\ [n]+             put (decls, nub (ns ++ (isn \\ (env ++ map fst (getImps decls)))))+    imps top env (PDPair _ l t r)+        = do (decls, ns) <- get+             let isn = namesIn uvars ist l ++ namesIn uvars ist t ++ +                       namesIn uvars ist r+             put (decls, nub (ns ++ (isn \\ (env ++ map fst (getImps decls)))))+    imps top env (PAlternative as)+        = do (decls, ns) <- get+             let isn = concatMap (namesIn uvars ist) as+             put (decls, nub (ns ++ (isn `dropAll` (env ++ map fst (getImps decls)))))+    imps top env (PLam n ty sc)  +        = do imps False env ty+             imps False (n:env) sc+    imps top env (PHidden tm)    = imps False env tm+    imps top env _               = return ()++    pibind using []     sc = sc+    pibind using (n:ns) sc +      = case lookup n using of+            Just ty -> PPi (Imp False Dynamic) n ty (pibind using ns sc)+            Nothing -> PPi (Imp False Dynamic) n Placeholder (pibind using ns sc)++-- Add implicit arguments in function calls++addImpl :: IState -> PTerm -> PTerm+addImpl ist ptm = ai [] ptm+  where+    ai env (PRef fc f)    +        | not (f `elem` env) = aiFn ist fc f []+    ai env (PEq fc l r)   = let l' = ai env l+                                r' = ai env r in+                                PEq fc l' r'+    ai env (PPair fc l r) = let l' = ai env l+                                r' = ai env r in+                                PPair fc l' r'+    ai env (PDPair fc l t r) = let l' = ai env l+                                   t' = ai env t+                                   r' = ai env r in+                                   PDPair fc l' t' r'+    ai env (PAlternative as) = let as' = map (ai env) as in+                                   PAlternative as'+    ai env (PApp fc (PRef _ f) as) +        | not (f `elem` env)+                          = let as' = map (fmap (ai env)) as in+                                aiFn ist fc f as'+    ai env (PApp fc f as) = let f' = ai env f+                                as' = map (fmap (ai env)) as in+                                mkPApp fc 1 f' as'+    ai env (PCase fc c os) = let c' = ai env c+                                 os' = map (pmap (ai env)) os in+                                 PCase fc c' os'+    ai env (PLam n ty sc) = let ty' = ai env ty+                                sc' = ai (n:env) sc in+                                PLam n ty' sc'+    ai env (PLet n ty val sc)+                          = let ty' = ai env ty+                                val' = ai env val+                                sc' = ai (n:env) sc in+                                PLet n ty' val' sc'+    ai env (PPi p n ty sc) = let ty' = ai env ty+                                 sc' = ai (n:env) sc in+                                 PPi p n ty' sc'+    ai env (PHidden tm) = PHidden (ai env tm)+    ai env (PProof ts) = PProof (map (fmap (ai env)) ts)+    ai env (PTactics ts) = PTactics (map (fmap (ai env)) ts)+    ai env tm = tm++aiFn :: IState -> FC -> Name -> [PArg] -> PTerm+aiFn ist fc f as+    | f `elem` primNames = PApp fc (PRef fc f) as+aiFn ist fc f as+          -- This is where namespaces get resolved by adding PAlternative+        = case lookupCtxtName Nothing f (idris_implicits ist) of+            [(f',ns)] -> mkPApp fc (length ns) (PRef fc f') (insertImpl ns as)+            [] -> if f `elem` idris_metavars ist+                    then PApp fc (PRef fc f) as+                    else mkPApp fc (length as) (PRef fc f) as+            alts -> PAlternative $+                     map (\(f', ns) -> mkPApp fc (length ns) (PRef fc f') +                                                 (insertImpl ns as)) alts+  where+    insertImpl :: [PArg] -> [PArg] -> [PArg]+    insertImpl (PExp p l ty : ps) (PExp _ _ tm : given) =+                                 PExp p l tm : insertImpl ps given+    insertImpl (PConstraint p l ty : ps) (PConstraint _ _ tm : given) =+                                 PConstraint p l tm : insertImpl ps given+    insertImpl (PConstraint p l ty : ps) given =+                                 PConstraint p l (PResolveTC fc) : insertImpl ps given+    insertImpl (PImp p l n ty : ps) given =+        case find n given [] of+            Just (tm, given') -> PImp p l n tm : insertImpl ps given'+            Nothing ->           PImp p l n Placeholder : insertImpl ps given+    insertImpl expected [] = []+    insertImpl _        given  = given++    find n []               acc = Nothing+    find n (PImp _ _ n' t : gs) acc +         | n == n' = Just (t, reverse acc ++ gs)+    find n (g : gs) acc = find n gs (g : acc)++mkPApp fc a f [] = f+mkPApp fc a f as = let rest = drop a as in+                       appRest fc (PApp fc f (take a as)) rest+  where+    appRest fc f [] = f+    appRest fc f (a : as) = appRest fc (PApp fc f [a]) as++-- Find 'static' argument positions+-- (the declared ones, plus any names in argument position in the declared +-- statics)+-- FIXME: It's possible that this really has to happen after elaboration++findStatics :: IState -> PTerm -> (PTerm, [Bool])+findStatics ist tm = let (ns, ss) = fs tm in+                         runState (pos ns ss tm) []+  where fs (PPi p n t sc)+            | Static <- pstatic p+                        = let (ns, ss) = fs sc in+                              (namesIn [] ist t : ns, namesIn [] ist t ++ n : ss)+            | otherwise = let (ns, ss) = fs sc in+                              (namesIn [] ist t : ns, ss)+        fs _ = ([], [])++        inOne n ns = length (filter id (map (elem n) ns)) == 1++        pos ns ss (PPi p n t sc) +            | n `inOne` ns && elem n ss+                        = do sc' <- pos ns ss sc+                             spos <- get+                             put (True : spos)+                             return (PPi (p { pstatic = Static }) n t sc')+            | otherwise = do sc' <- pos ns ss sc+                             spos <- get+                             put (False : spos)+                             return (PPi p n t sc')+        pos ns ss t = return t++-- Debugging/logging stuff++dumpDecls :: [PDecl] -> String+dumpDecls [] = ""+dumpDecls (d:ds) = dumpDecl d ++ "\n" ++ dumpDecls ds++dumpDecl (PFix _ f ops) = show f ++ " " ++ showSep ", " ops +dumpDecl (PTy _ _ n t) = "tydecl " ++ show n ++ " : " ++ showImp True t+dumpDecl (PClauses _ _ n cs) = "pat " ++ show n ++ "\t" ++ showSep "\n\t" (map (showCImp True) cs)+dumpDecl (PData _ _ d) = showDImp True d+dumpDecl (PParams _ ns ps) = "params {" ++ show ns ++ "\n" ++ dumpDecls ps ++ "}\n"+dumpDecl (PNamespace n ps) = "namespace {" ++ n ++ "\n" ++ dumpDecls ps ++ "}\n"+dumpDecl (PSyntax _ syn) = "syntax " ++ show syn+dumpDecl (PClass _ _ cs n ps ds) +    = "class " ++ show cs ++ " " ++ show n ++ " " ++ show ps ++ "\n" ++ dumpDecls ds+dumpDecl (PInstance _ _ cs n _ t ds) +    = "instance " ++ show cs ++ " " ++ show n ++ " " ++ show t ++ "\n" ++ dumpDecls ds+dumpDecl _ = "..."+-- dumpDecl (PImport i) = "import " ++ i++-- for 6.12/7 compatibility+data EitherErr a b = LeftErr a | RightOK b++instance Monad (EitherErr a) where+    return = RightOK++    (LeftErr e) >>= k = LeftErr e+    RightOK v   >>= k = k v++toEither (LeftErr e)  = Left e+toEither (RightOK ho) = Right ho++-- syntactic match of a against b, returning pair of variables in a +-- and what they match. Returns the pair that failed if not a match.++matchClause :: PTerm -> PTerm -> Either (PTerm, PTerm) [(Name, PTerm)]+matchClause = matchClause' False++matchClause' :: Bool -> PTerm -> PTerm -> Either (PTerm, PTerm) [(Name, PTerm)]+matchClause' names x y = checkRpts $ match (fullApp x) (fullApp y) where+    matchArg x y = match (fullApp (getTm x)) (fullApp (getTm y))++    fullApp (PApp _ (PApp fc f args) xs) = fullApp (PApp fc f (args ++ xs))+    fullApp x = x++    match' x y = match (fullApp x) (fullApp y)+    match (PApp _ (PRef _ (NS (UN "fromInteger") ["builtins"])) [_,_,x]) x' +        | PConstant (I _) <- getTm x = match (getTm x) x'+    match x' (PApp _ (PRef _ (NS (UN "fromInteger") ["builtins"])) [_,_,x])+        | PConstant (I _) <- getTm x = match (getTm x) x'+    match (PApp _ f args) (PApp _ f' args')+        | length args == length args'+            = do mf <- match' f f'+                 ms <- zipWithM matchArg args args'+                 return (mf ++ concat ms)+--     match (PRef _ n) (PRef _ n') | n == n' = return []+--                                  | otherwise = Nothing+    match (PRef f n) (PApp _ x []) = match (PRef f n) x+    match (PApp _ x []) (PRef f n) = match x (PRef f n)+    match (PRef _ n) (PRef _ n') | n == n' = return []+    match (PRef _ n) tm | not names = return [(n, tm)]+    match (PEq _ l r) (PEq _ l' r') = do ml <- match' l l'+                                         mr <- match' r r'+                                         return (ml ++ mr)+    match (PPair _ l r) (PPair _ l' r') = do ml <- match' l l'+                                             mr <- match' r r'+                                             return (ml ++ mr)+    match (PDPair _ l t r) (PDPair _ l' t' r') = do ml <- match' l l'+                                                    mt <- match' t t'+                                                    mr <- match' r r'+                                                    return (ml ++ mt ++ mr)+    match (PAlternative as) (PAlternative as') +        = do ms <- zipWithM match' as as' +             return (concat ms)+    match a@(PAlternative as) b+        = do let ms = zipWith match' as (repeat b)+             case (rights (map toEither ms)) of+                (x: _) -> return x+                _ -> LeftErr (a, b)+    match (PCase _ _ _) _ = return [] -- lifted out+    match (PMetavar _) _ = return [] -- modified+    match (PQuote _) _ = return []+    match (PProof _) _ = return []+    match (PTactics _) _ = return []+    match (PRefl _) (PRefl _) = return []+    match (PResolveTC _) (PResolveTC _) = return []+    match (PTrue _) (PTrue _) = return []+    match (PFalse _) (PFalse _) = return []+    match (PReturn _) (PReturn _) = return []+    match (PPi _ _ t s) (PPi _ _ t' s') = do mt <- match' t t'+                                             ms <- match' s s'+                                             return (mt ++ ms)+    match (PLam _ t s) (PLam _ t' s') = do mt <- match' t t'+                                           ms <- match' s s'+                                           return (mt ++ ms)+    match (PLet _ t ty s) (PLet _ t' ty' s') = do mt <- match' t t'+                                                  mty <- match' ty ty'+                                                  ms <- match' s s'+                                                  return (mt ++ mty ++ ms)+    match (PHidden x) (PHidden y) = match' x y+    match Placeholder _ = return []+    match _ Placeholder = return []+    match (PResolveTC _) _ = return []+    match a b | a == b = return []+              | otherwise = LeftErr (a, b)++    checkRpts (RightOK ms) = check ms where+        check ((n,t):xs) +            | Just t' <- lookup n xs = if t/=t' && t/=Placeholder && t'/=Placeholder+                                                then Left (t, t') +                                                else check xs+        check (_:xs) = check xs+        check [] = Right ms+    checkRpts (LeftErr x) = Left x++substMatches :: [(Name, PTerm)] -> PTerm -> PTerm+substMatches [] t = t+substMatches ((n,tm):ns) t = substMatch n tm (substMatches ns t)++substMatch :: Name -> PTerm -> PTerm -> PTerm+substMatch n tm t = sm t where+    sm (PRef _ n') | n == n' = tm+    sm (PLam x t sc) = PLam x (sm t) (sm sc)+    sm (PPi p x t sc) = PPi p x (sm t) (sm sc)+    sm (PApp f x as) = PApp f (sm x) (map (fmap sm) as)+    sm (PCase f x as) = PCase f (sm x) (map (pmap sm) as)+    sm (PEq f x y) = PEq f (sm x) (sm y)+    sm (PPair f x y) = PPair f (sm x) (sm y)+    sm (PDPair f x t y) = PDPair f (sm x) (sm t) (sm y)+    sm (PAlternative as) = PAlternative (map sm as)+    sm (PHidden x) = PHidden (sm x)+    sm x = x++shadow :: Name -> Name -> PTerm -> PTerm+shadow n n' t = sm t where+    sm (PRef fc x) | n == x = PRef fc n'+    sm (PLam x t sc) = PLam x (sm t) (sm sc)+    sm (PPi p x t sc) = PPi p x (sm t) (sm sc)+    sm (PApp f x as) = PApp f (sm x) (map (fmap sm) as)+    sm (PCase f x as) = PCase f (sm x) (map (pmap sm) as)+    sm (PEq f x y) = PEq f (sm x) (sm y)+    sm (PPair f x y) = PPair f (sm x) (sm y)+    sm (PDPair f x t y) = PDPair f (sm x) (sm t) (sm y)+    sm (PAlternative as) = PAlternative (map sm as)+    sm (PHidden x) = PHidden (sm x)+    sm x = x+
+ src/Idris/Compiler.hs view
@@ -0,0 +1,207 @@+{-# LANGUAGE PatternGuards #-}++module Idris.Compiler where++import Idris.AbsSyntax+import Idris.Transforms++import Core.TT+import Core.Evaluate+import Core.CaseTree++import Control.Monad.State+import Data.List+import System.Process+import System.IO+import System.Directory+import System.Environment++import Epic.Epic hiding (Term, Type, Name, fn, compile)+import qualified Epic.Epic as E++primDefs = [UN "mkForeign", UN "FalseElim"]++compile :: FilePath -> Term -> Idris ()+compile f tm+    = do checkMVs+         ds <- mkDecls tm+         objs <- getObjectFiles+         libs <- getLibs+         hdrs <- getHdrs+         let incs = map Include hdrs+         so <- getSO+         case so of+            Nothing ->+                do m <- epicMain tm+                   let mainval = EpicFn (name "main") m+                   liftIO $ compileObjWith [Debug] +                                (mkProgram (incs ++ mainval : ds)) (f ++ ".o")+                   liftIO $ link ((f ++ ".o") : objs ++ (map ("-l"++) libs)) f+  where checkMVs = do i <- get+                      case idris_metavars i \\ primDefs of+                            [] -> return ()+                            ms -> fail $ "There are undefined metavariables: " ++ show ms++mkDecls :: Term -> Idris [EpicDecl]+mkDecls t = do i <- getIState+               decls <- mapM build (ctxtAlist (tt_ctxt i))+               return $ basic_defs ++ decls+             +-- EpicFn (name "main") epicMain : decls++ename x = name ("idris_" ++ show x)+aname x = name ("a_" ++ show x)++epicMain tm = do e <- epic tm+                 return $ effect_ e++-- epicMain = effect_ $ -- ref (ename (UN "run__IO")) @@+--                      ref (ename (NS (UN "main") ["main"]))++class ToEpic a where+    epic :: a -> Idris E.Term++build :: (Name, Def) -> Idris EpicDecl+build (n, d) = do i <- getIState+                  case lookup n (idris_prims i) of+                    Just opDef -> return $ EpicFn (ename n) opDef+                    _ ->       do def <- epic d+                                  logLvl 3 $ "Compiled " ++ show n ++ " =\n\t" ++ show def+                                  return $ EpicFn (ename n) def++impossible = int 42424242++instance ToEpic Def where+    epic (Function tm _) = epic tm+    epic (CaseOp _ _ pats _ _ args sc) = epic (args, sc) -- optimised version+    epic _ = return impossible++instance ToEpic (TT Name) where+    epic tm = epic' [] tm where+      epic' env tm@(App f a)+          | (P _ (UN "mkForeign") _, args) <- unApply tm+              = doForeign args+          | (P _ (UN "lazy") _, [_,arg]) <- unApply tm+              = do arg' <- epic' env arg+                   return $ lazy_ arg'+          | (P _ (UN "prim__IO") _, [v]) <- unApply tm+              = epic' env v+          | (P _ (UN "io_bind") _, [_,_,v,k]) <- unApply tm+              = do v' <- epic' env v +                   k' <- epic' env k+                   return (k' @@ (effect_ v'))+          | (P (DCon t a) n _, args) <- unApply tm+              = epicCon env t a n args+      epic' env (P (DCon t a) n _) = return $ con_ t+      epic' env (P (TCon t a) n _) = return $ con_ t+      epic' env (P _ n _)          = return $ ref (ename n) +      epic' env (V i)              = return $ ref (env!!i)+      epic' env (Bind n (Lam _) sc)+            = do sc' <- epic' (aname n : env) sc+                 return $ term ([aname n], sc')+      epic' env (Bind n (Let _ v) sc)+            = do sc' <- epic' (aname n : env) sc+                 v' <- epic' env v+                 return $ let_ v' (aname n, sc') +      epic' env (Bind _ _ _) = return impossible+      epic' env (App f a) = do f' <- epic' env f+                               a' <- epic' env a+                               return (f' @@ a')+      epic' env (Constant c) = epic c+      epic' env Erased       = return impossible+      epic' env (Set _)      = return impossible++      epicCon env t arity n args+        | length args == arity = buildApp env (con_ t) args+        | otherwise = let extra = satArgs (arity - length args) in+                          do sc' <- epicCon env t arity n +                                        (args ++ map (\n -> P Bound n undefined) extra)+                             return $ term (map ename extra, sc')+        +      satArgs n = map (\i -> MN i "sat") [1..n]++      buildApp env e [] = return e+      buildApp env e (x:xs) = do x' <- epic' env x+                                 buildApp env (e @@ x') xs+                                    ++doForeign :: [TT Name] -> Idris E.Term+doForeign (_ : fgn : args)+   | (_, (Constant (Str fgnName) : fgnArgTys : P _ (UN ret) _ : [])) <- unApply fgn+        = let tys = getFTypes fgnArgTys+              rty = mkEty ret in+              do args' <- mapM epic args+                 -- wrap it in a prim__IO+                 -- return $ con_ 0 @@ impossible @@ +                 return $ lazy_ $ foreign_ rty fgnName (zip args' tys)+   | otherwise = fail "Badly formed foreign function call"++getFTypes :: TT Name -> [E.Type]+getFTypes tm = case unApply tm of+                 (nil, []) -> []+                 (cons, [(P _ (UN ty) _), xs]) -> +                    let rest = getFTypes xs in+                        mkEty ty : rest                        ++mkEty "FInt"    = tyInt+mkEty "FFloat"  = tyFloat+mkEty "FChar"   = tyChar+mkEty "FString" = tyString+mkEty "FPtr"    = tyPtr+mkEty "FUnit"   = tyUnit++instance ToEpic Const where+    epic (I i)   = return (int i)+    epic (BI i)  = return (bigint i)+    epic (Fl f)  = return (float f)+    epic (Str s) = return (str s)+    epic (Ch c)  = return (char c)+    epic IType   = return $ con_ 1+    epic FlType  = return $ con_ 2+    epic ChType  = return $ con_ 3+    epic StrType = return $ con_ 4+    epic PtrType = return $ con_ 5+    epic BIType  = return $ con_ 6++instance ToEpic ([Name], SC) where+    epic (args, tree) = do logLvl 3 $ "Compiling " ++ show args ++ "\n" ++ show tree+                           tree' <- epic tree+                           return $ term (map ename args, tree')++instance ToEpic SC where+    epic (Case n [ConCase _ i ns sc])+        = epicLet n ns 0 sc+      where+        epicLet x [] _ sc = epic sc+        epicLet x (n:ns) i sc +            = do sc' <- epicLet x ns (i+1) sc+                 return $ let_ (ref (ename x) !. i) (ename n, sc')++    epic (STerm t) = epic t+    epic (UnmatchedCase str) = return $ error_ str+    epic (Case n alts) = do alts' <- mapM mkEpicAlt alts+                            return $ case_ (ref (ename n)) alts'+      where+        mkEpicAlt (ConCase n t args rhs) = do rhs' <- epic rhs+                                              return $ con t (map ename args, rhs')+        mkEpicAlt (ConstCase (I i) rhs)  = do rhs' <- epic rhs+                                              return $ constcase i rhs'+        mkEpicAlt (ConstCase IType rhs) = do rhs' <- epic rhs +                                             return $ defaultcase rhs'+        mkEpicAlt (ConstCase c rhs)      +           = fail $ "Can only pattern match on integer constants (" ++ show c ++ ")"+        mkEpicAlt (DefaultCase rhs)      = do rhs' <- epic rhs+                                              return $ defaultcase rhs'++tempfile :: IO (FilePath, Handle)+tempfile = do env <- environment "TMPDIR"+              let dir = case env of+                              Nothing -> "/tmp"+                              (Just d) -> d+              openTempFile dir "esc"++environment :: String -> IO (Maybe String)+environment x = catch (do e <- getEnv x+                          return (Just e))+                      (\_ -> return Nothing)+
+ src/Idris/Coverage.hs view
@@ -0,0 +1,97 @@+{-# LANGUAGE PatternGuards #-}++module Idris.Coverage where++import Core.TT+import Core.Evaluate+import Idris.AbsSyntax+import Idris.Delaborate++import Data.List+import Debug.Trace++-- Given a list of LHSs, generate a extra clauses which cover the remaining+-- cases. The ones which haven't been provided are marked 'absurd' so that the+-- checker will make sure they can't happen.++-- This will only work after the given clauses have been typechecked and the+-- names are fully explicit!++genClauses :: FC -> Name -> [Term] -> [PClause] -> Idris [PClause]+genClauses fc n xs given+   = do i <- getIState+        let lhss = map (getLHS i) xs+        let argss = transpose lhss+        let all_args = map (genAll i) argss+        logLvl 7 $ "COVERAGE of " ++ show n+        logLvl 10 $ show argss ++ "\n" ++ show all_args+        logLvl 10 $ "Original: \n" ++ +                        showSep "\n" (map (\t -> showImp True (delab' i t True)) xs)+        let parg = case lookupCtxt Nothing n (idris_implicits i) of+                        (p : _) -> p+                        _ -> repeat (pexp Placeholder)+        let new = mnub i $ filter (noMatch i) $ mkClauses parg all_args+        logLvl 7 $ "New clauses: \n" ++ showSep "\n" (map (showImp True) new)+        return (map (\t -> PClause n t [] PImpossible []) new)+  where getLHS i term +            | (f, args) <- unApply term = map (\t -> delab' i t True) args+            | otherwise = []++        lhsApp (PClause _ l _ _ _) = l+        lhsApp (PWith _ l _ _ _) = l++        mnub i [] = []+        mnub i (x : xs) = +            if (any (\t -> case matchClause x t of+                                Right _ -> True+                                Left _ -> False) xs) then mnub i xs +                                                     else x : mnub i xs++        noMatch i tm = all (\x -> case matchClause (delab' i x True) tm of+                                          Right _ -> False+                                          Left miss -> True) xs +++        mkClauses :: [PArg] -> [[PTerm]] -> [PTerm]+        mkClauses parg args+            = do args' <- mkArg args+                 let tm = PApp fc (PRef fc n) (zipWith upd args' parg)+                 return tm+          where+            mkArg :: [[PTerm]] -> [[PTerm]]+            mkArg [] = return []+            mkArg (a : as) = do a' <- a+                                as' <- mkArg as+                                return (a':as')++genAll :: IState -> [PTerm] -> [PTerm]+genAll i args = concatMap otherPats (nub args)+  where +    otherPats :: PTerm -> [PTerm]+    otherPats o@(PRef fc n) = ops fc n [] o+    otherPats o@(PApp _ (PRef fc n) xs) = ops fc n xs o+    otherPats arg = return arg++    ops fc n xs o+        | (TyDecl c@(DCon _ arity) ty : _) <- lookupDef Nothing n (tt_ctxt i)+            = do xs' <- mapM otherPats (map getTm xs)+                 let p = PApp fc (PRef fc n) (zipWith upd xs' xs)+                 let tyn = getTy n (tt_ctxt i)+                 case lookupCtxt Nothing tyn (idris_datatypes i) of+                         (TI ns : _) -> p : map (mkPat fc) (ns \\ [n])+                         _ -> [p]+    ops fc n arg o = return o++    getTy n ctxt = case lookupTy Nothing n ctxt of+                          (t : _) -> case unApply (getRetTy t) of+                                        (P _ tyn _, _) -> tyn+                                        x -> error $ "Can't happen getTy 1 " ++ show (n, x)+                          _ -> error "Can't happen getTy 2"++    mkPat fc x = case lookupCtxt Nothing x (idris_implicits i) of+                      (pargs : _)+                         -> PApp fc (PRef fc x) (map (upd Placeholder) pargs)  +                      _ -> error "Can't happen - genAll"++upd p' p = p { getTm = p' }+
+ src/Idris/DataOpts.hs view
@@ -0,0 +1,145 @@+{-# LANGUAGE PatternGuards #-}++module Idris.DataOpts where++-- Forcing, detagging and collapsing++import Idris.AbsSyntax+import Core.TT++import Data.List+import Data.Maybe+import Debug.Trace++-- Calculate the forceable arguments to a constructor and update the set of+-- optimisations++forceArgs :: Name -> Type -> Idris ()+forceArgs n t = do let fargs = force 0 t+                   i <- getIState+                   copt <- case lookupCtxt Nothing n (idris_optimisation i) of+                                 []     -> return $ Optimise False [] []+                                 (op:_) -> return op+                   let opts = addDef n (copt { forceable = fargs }) (idris_optimisation i)+                   putIState (i { idris_optimisation = opts })+                   addIBC (IBCOpt n)+                   iLOG $ "Forced: " ++ show n ++ " " ++ show fargs ++ "\n   from " +++                          show t+  where+    force :: Int -> Term -> [Int]+    force i (Bind _ (Pi _) sc) +        = force (i + 1) $ instantiate (P Bound (MN i "?") Erased) sc+    force _ sc@(App f a) +        | (_, args) <- unApply sc +            = nub $ concatMap guarded args+    force _ _ = []++    isF (P _ (MN force "?") _) = Just force+    isF _ = Nothing++    guarded :: Term -> [Int]+    guarded t@(App f a)+        | (P (TCon _ _) _ _, args) <- unApply t+            = mapMaybe isF args ++ concatMap guarded args+        | (P (DCon _ _) _ _, args) <- unApply t+            = mapMaybe isF args ++ concatMap guarded args+    guarded t = mapMaybe isF [t]++-- Calculate whether a collection of constructors is collapsible++collapseCons :: Name -> [(Name, Type)] -> Idris ()+collapseCons ty cons = +                do i <- getIState+                   return ()++class Optimisable term where+    applyOpts :: term -> Idris term++instance (Optimisable a, Optimisable b) => Optimisable (a, b) where+    applyOpts (x, y) = do x' <- applyOpts x+                          y' <- applyOpts y+                          return (x', y')++instance Optimisable a => Optimisable [a] where+    applyOpts = mapM applyOpts++-- Raw is for compile time optimisation (before type checking)+-- Term is for run time optimisation (after type checking, collapsing allowed)++-- Compile time: no collapsing++instance Optimisable Raw where+    applyOpts t@(RApp f a)+        | (Var n, args) <- raw_unapply t -- MAGIC HERE+            = do args' <- mapM applyOpts args+                 i <- getIState+                 case lookupCtxt Nothing n (idris_optimisation i) of+                    (oi:_) -> return $ applyDataOpt oi n args'+                    _ -> return (raw_apply (Var n) args')+        | otherwise = do f' <- applyOpts f+                         a' <- applyOpts a+                         return (RApp f' a')+    applyOpts (RBind n b t) = do b' <- applyOpts b+                                 t' <- applyOpts t+                                 return (RBind n b' t')+    applyOpts (RForce t) = applyOpts t+    applyOpts t = return t++instance Optimisable t => Optimisable (Binder t) where+    applyOpts (Let t v) = do t' <- applyOpts t+                             v' <- applyOpts v+                             return (Let t' v')+    applyOpts b = do t' <- applyOpts (binderTy b)+                     return (b { binderTy = t' })+++applyDataOpt :: OptInfo -> Name -> [Raw] -> Raw+applyDataOpt oi n args+    = let args' = zipWith doForce (map (\x -> x `elem` (forceable oi)) [0..]) +                                  args in+          raw_apply (Var n) args'+  where+    doForce True  a = RForce a+    doForce False a = a++-- Run-time: do everything++instance Optimisable (TT Name) where+    applyOpts t@(App f a)+        | (c@(P (DCon t arity) n _), args) <- unApply t -- MAGIC HERE+            = do args' <- mapM applyOpts args+                 i <- getIState+                 case lookupCtxt Nothing n (idris_optimisation i) of+                      (oi:_) -> do return $ applyDataOptRT oi n t arity args'+                      _ -> return (mkApp c args')+        | otherwise = do f' <- applyOpts f+                         a' <- applyOpts a+                         return (App f' a')+    applyOpts (Bind n b t) = do b' <- applyOpts b+                                t' <- applyOpts t+                                return (Bind n b' t')+    applyOpts t = return t++-- Need to saturate arguments first to ensure that erasure happens uniformly++applyDataOptRT :: OptInfo -> Name -> Int -> Int -> [Term] -> Term+applyDataOptRT oi n tag arity args+    | length args == arity = doOpts n args (collapsible oi) (forceable oi)+    | otherwise = let extra = satArgs (arity - length args)+                      tm = doOpts n (args ++ map (\n -> P Bound n Erased) extra) +                                    (collapsible oi) (forceable oi) in+                      bind extra tm+  where+    satArgs n = map (\i -> MN i "sat") [1..n]++    bind [] tm = tm+    bind (n:ns) tm = Bind n (Lam Erased) (pToV n (bind ns tm))++    doOpts n args True f = Erased+    doOpts n args _ forced+        = let args' = filter keep (zip (map (\x -> x `elem` forced) [0..])+                                       args) in+              mkApp (P (DCon tag (arity - length forced)) n Erased) (map snd args')++    keep (forced, _) = not forced+
+ src/Idris/Delaborate.hs view
@@ -0,0 +1,77 @@+{-# LANGUAGE PatternGuards #-}++module Idris.Delaborate where++-- Convert core TT back into high level syntax, primarily for display+-- purposes.++import Idris.AbsSyntax+import Core.TT++import Debug.Trace++delab :: IState -> Term -> PTerm+delab i tm = delab' i tm False++delab' :: IState -> Term -> Bool -> PTerm+delab' ist tm fullname = de [] tm+  where+    un = FC "(val)" 0++    de env (App f a) = deFn env f [a]+    de env (V i)     | i < length env = PRef un (env!!i)+                     | otherwise = PRef un (UN ("v" ++ show i ++ ""))+    de env (P _ n _) | n == unitTy = PTrue un+                     | n == unitCon = PTrue un+                     | n == falseTy = PFalse un+                     | otherwise = PRef un (dens n)+    de env (Bind n (Lam ty) sc) = PLam n (de env ty) (de (n:env) sc)+    de env (Bind n (Pi ty) sc)  = PPi expl n (de env ty) (de (n:env) sc)+    de env (Bind n (Let ty val) sc) +        = PLet n (de env ty) (de env val) (de (n:env) sc)+    de env (Bind n _ sc) = de (n:env) sc+    de env (Constant i) = PConstant i+    de env Erased = Placeholder+    de env (Set i) = PSet ++    dens x | fullname = x+    dens ns@(NS n _) = case lookupCtxt Nothing n (idris_implicits ist) of+                              [_] -> n -- just one thing+                              _ -> ns+    dens n = n++    deFn env (App f a) args = deFn env f (a:args)+    deFn env (P _ n _) [l,r]     | n == pairTy  = PPair un (de env l) (de env r)+                                 | n == eqCon   = PRefl un+                                 | n == UN "lazy" = de env r+                                 | n == UN "Exists" = PDPair un (de env l) Placeholder+                                                                (de env r)+    deFn env (P _ n _) [_,_,l,r] | n == pairCon = PPair un (de env l) (de env r)+                                 | n == eqTy    = PEq un (de env l) (de env r)+                                 | n == UN "Ex_intro" = PDPair un (de env l) Placeholder+                                                                  (de env r)+    deFn env (P _ n _) args = mkPApp (dens n) (map (de env) args)+    deFn env f args = PApp un (de env f) (map pexp (map (de env) args))++    mkPApp n args +        | [imps] <- lookupCtxt Nothing n (idris_implicits ist)+            = PApp un (PRef un n) (zipWith imp (imps ++ repeat (pexp undefined)) args)+        | otherwise = PApp un (PRef un n) (map pexp args)++    imp (PImp p l n _) arg = PImp p l n arg+    imp (PExp p l _)   arg = PExp p l arg+    imp (PConstraint p l _) arg = PConstraint p l arg++pshow :: IState -> Err -> String+pshow i (Msg s) = s+pshow i (CantUnify x y e s) = "Can't unify " ++ show (delab i x)+                            ++ " with " ++ show (delab i y) +--                              ++ "\n\t(" ++ pshow i e ++ ")"+pshow i (NotInjective p x y) = "Can't verify injectivity of " ++ show (delab i p) +++                               " when unifying " ++ show (delab i x) ++ " and " ++ +                                                    show (delab i y)+pshow i (IncompleteTerm t) = "Incomplete term " ++ show t+pshow i UniverseError = "Universe inconsistency"+pshow i ProgramLineComment = "Program line next to comment"+pshow i (At f e) = show f ++ ":" ++ pshow i e+
+ src/Idris/ElabDecls.hs view
@@ -0,0 +1,634 @@+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, DeriveFunctor #-}++module Idris.ElabDecls where++import Idris.AbsSyntax+import Idris.Error+import Idris.Delaborate+import Idris.Imports+import Idris.ElabTerm+import Idris.Coverage+import Idris.DataOpts+import Paths_idris++import Core.TT+import Core.Elaborate hiding (Tactic(..))+import Core.Evaluate+import Core.Typecheck+import Core.CaseTree++import Control.Monad+import Control.Monad.State+import Data.List+import Data.Maybe+import Debug.Trace+++recheckC ctxt fc env t +    = do -- t' <- applyOpts (forget t) (doesn't work, or speed things up...)+         (tm, ty, cs) <- tclift $ recheck ctxt env (forget t) t+         addConstraints fc cs+         return (tm, ty)++checkDef fc ns = do ctxt <- getContext+                    mapM (\(n, t) -> do (t', _) <- recheckC ctxt fc [] t+                                        return (n, t')) ns++elabType :: ElabInfo -> SyntaxInfo -> FC -> Name -> PTerm -> Idris ()+elabType info syn fc n ty' = {- let ty' = piBind (params info) ty_in +                                      n  = liftname info n_in in    -}+      do checkUndefined fc n+         ctxt <- getContext+         i <- get+         ty' <- implicit syn n ty'+         let ty = addImpl i ty'+         logLvl 2 $ show n ++ " type " ++ showImp True ty+         ((ty', defer, is), log) <- tclift $ elaborate ctxt n (Set (UVal 0)) []+                                             (erun fc (build i info False n ty))+         (cty, _)   <- recheckC ctxt fc [] ty'+         logLvl 2 $ "---> " ++ show cty+         let nty = normalise ctxt [] cty+         ds <- checkDef fc ((n, nty):defer)+         addIBC (IBCDef n)+         addDeferred ds+         mapM_ (elabCaseBlock info) is ++elabData :: ElabInfo -> SyntaxInfo -> FC -> PData -> Idris ()+elabData info syn fc (PDatadecl n t_in dcons)+    = do iLOG (show fc)+         checkUndefined fc n+         ctxt <- getContext+         i <- get+         t_in <- implicit syn n t_in+         let t = addImpl i t_in+         ((t', defer, is), log) <- tclift $ elaborate ctxt n (Set (UVal 0)) []+                                            (erun fc (build i info False n t))+         def' <- checkDef fc defer+         addDeferred def'+         mapM_ (elabCaseBlock info) is+         (cty, _)  <- recheckC ctxt fc [] t'+         logLvl 2 $ "---> " ++ show cty+         updateContext (addTyDecl n cty) -- temporary, to check cons+         cons <- mapM (elabCon info syn) dcons+         ttag <- getName+         i <- get+         put (i { idris_datatypes = addDef n (TI (map fst cons)) +                                            (idris_datatypes i) })+         addIBC (IBCDef n)+         addIBC (IBCData n)+         collapseCons n cons+         updateContext (addDatatype (Data n ttag cty cons))++elabCon :: ElabInfo -> SyntaxInfo -> (Name, PTerm, FC) -> Idris (Name, Type)+elabCon info syn (n, t_in, fc)+    = do checkUndefined fc n+         ctxt <- getContext+         i <- get+         t_in <- implicit syn n t_in+         let t = addImpl i t_in+         logLvl 2 $ show fc ++ ":Constructor " ++ show n ++ " : " ++ showImp True t+         ((t', defer, is), log) <- tclift $ elaborate ctxt n (Set (UVal 0)) []+                                            (erun fc (build i info False n t))+         logLvl 2 $ "Rechecking " ++ show t'+         def' <- checkDef fc defer+         addDeferred def'+         mapM_ (elabCaseBlock info) is+         ctxt <- getContext+         (cty, _)  <- recheckC ctxt fc [] t'+         logLvl 2 $ "---> " ++ show n ++ " : " ++ show cty+         addIBC (IBCDef n)+         forceArgs n cty+         return (n, cty)++elabClauses :: ElabInfo -> FC -> FnOpts -> Name -> [PClause] -> Idris ()+elabClauses info fc opts n_in cs = let n = liftname info n_in in  +      do pats_in <- mapM (elabClause info fc (TCGen `elem` opts)) cs+         solveDeferred n+         let pats = mapMaybe id pats_in+         logLvl 3 (showSep "\n" (map (\ (l,r) -> +                                        show l ++ " = " ++ +                                        show r) pats))+         ist <- get+         let tcase = opt_typecase (idris_options ist)+         let pdef = map debind (map (simpl (tt_ctxt ist)) pats)+         cov <- coverage+         pcover <-+                 if cov  +                    then idrisCatch +                            (do missing <- genClauses fc n (map fst pdef) cs+                                mapM_ (elabClause info fc True) missing+                                return True)+                            (\c -> do -- iputStrLn $ "Warning: " ++ show c+                                      return False)+                    else return False+         pdef' <- applyOpts pdef +         let tree = simpleCase tcase pcover pdef+         let tree' = simpleCase tcase pcover pdef'+         tclift $ sameLength pdef+         logLvl 3 (show tree)+         logLvl 3 $ "Optimised: " ++ show tree'+         ctxt <- getContext+         ist <- get+         put (ist { idris_patdefs = addDef n pdef' (idris_patdefs ist) })+         case lookupTy (namespace info) n ctxt of+             [ty] -> do updateContext (addCasedef n (inlinable opts)+                                                     tcase pcover pdef pdef' ty)+                        addIBC (IBCDef n)+             [] -> return ()+  where+    debind (x, y) = (depat x, depat y)+    depat (Bind n (PVar t) sc) = depat (instantiate (P Bound n t) sc)+    depat x = x++    simpl ctxt (x, y) = (x, simplify ctxt [] y)++    sameLength ((x, _) : xs) +        = do l <- sameLength xs+             let (f, as) = unApply x+             if (null xs || l == length as) then return (length as)+                else tfail (At fc (Msg "Clauses have differing numbers of arguments "))+    sameLength [] = return 0++elabVal :: ElabInfo -> Bool -> PTerm -> Idris (Term, Type)+elabVal info aspat tm_in+   = do ctxt <- getContext+        i <- get+        let tm = addImpl i tm_in+        logLvl 10 (showImp True tm)+        ((tm', defer, is), _) <- tclift $ elaborate ctxt (MN 0 "val") infP []+                                          (build i info aspat (MN 0 "val") (infTerm tm))+        logLvl 3 ("Value: " ++ show tm')+        let vtm = getInferTerm tm'+        logLvl 2 (show vtm)+        recheckC ctxt (FC "prompt" 0) [] vtm++elabClause :: ElabInfo -> FC -> Bool -> PClause -> Idris (Maybe (Term, Term))+elabClause info fc tcgen (PClause fname lhs_in [] PImpossible [])+   = do ctxt <- getContext+        i <- get+        let lhs = addImpl i lhs_in+        -- if the LHS type checks, it is possible, so report an error+        case elaborate ctxt (MN 0 "patLHS") infP []+                            (erun fc (buildTC i info True tcgen fname (infTerm lhs))) of+            OK ((lhs', _, _), _) ->+               do let lhs_tm = orderPats (getInferTerm lhs')+                  checkInferred fc (delab' i lhs_tm True) lhs+                  fail $ show fc ++ ":" ++ showImp True (delab' i lhs_tm True) ++ " is a possible case"+                                ++ "\n" ++ showImp True lhs+            Error _ -> return ()+        return Nothing+elabClause info fc tcgen (PClause fname lhs_in withs rhs_in whereblock) +   = do ctxt <- getContext+        -- Build the LHS as an "Infer", and pull out its type and+        -- pattern bindings+        i <- get+        let lhs = addImpl i lhs_in+        logLvl 5 ("LHS: " ++ showImp True lhs)+        ((lhs', dlhs, []), _) <- +            tclift $ elaborate ctxt (MN 0 "patLHS") infP []+                     (erun fc (buildTC i info True tcgen fname (infTerm lhs)))+        let lhs_tm = orderPats (getInferTerm lhs')+        let lhs_ty = getInferType lhs'+        logLvl 3 (show lhs_tm)+        (clhs, clhsty) <- recheckC ctxt fc [] lhs_tm+        logLvl 5 ("Checked " ++ show clhs)+        -- Elaborate where block+        ist <- getIState+        windex <- getName+        let winfo = pinfo (pvars ist lhs_tm) whereblock windex+        let decls = concatMap declared whereblock+        let newargs = pvars ist lhs_tm+        let wb = map (expandParamsD ist decorate newargs decls) whereblock+        logLvl 5 $ show wb+        mapM_ (elabDecl' info) wb+        -- Now build the RHS, using the type of the LHS as the goal.+        i <- get -- new implicits from where block+        logLvl 5 (showImp True (expandParams decorate newargs decls rhs_in))+        let rhs = addImpl i (expandParams decorate newargs decls rhs_in)+                        -- TODO: but don't do names in scope+        logLvl 2 (showImp True rhs)+        ctxt <- getContext -- new context with where block added+        ((rhs', defer, is), _) <- +           tclift $ elaborate ctxt (MN 0 "patRHS") clhsty []+                    (do pbinds lhs_tm+                        (_, _, is) <- erun fc (build i info False fname rhs)+                        psolve lhs_tm+                        tt <- get_term+                        let (tm, ds) = runState (collectDeferred tt) []+                        return (tm, ds, is))+        logLvl 2 $ "---> " ++ show rhs'+        when (not (null defer)) $ iLOG $ "DEFERRED " ++ show defer+        def' <- checkDef fc defer+        addDeferred def'+        mapM_ (elabCaseBlock info) is+        ctxt <- getContext+        logLvl 5 $ "Rechecking"+        (crhs, crhsty) <- recheckC ctxt fc [] rhs'+        i <- get+        checkInferred fc (delab' i crhs True) rhs+        return $ Just (clhs, crhs)+  where+    decorate x = UN (show fname ++ "#" ++ show x)+    pinfo ns ps i +          = let ds = concatMap declared ps+                newps = params info ++ ns+                dsParams = map (\n -> (n, map fst newps)) ds+                newb = addAlist dsParams (inblock info) +                l = liftname info in+                info { params = newps,+                       inblock = newb,+                       liftname = id -- (\n -> case lookupCtxt n newb of+                                     --      Nothing -> n+                                     --      _ -> MN i (show n)) . l+                    }++elabClause info fc tcgen (PWith fname lhs_in withs wval_in withblock) +   = do ctxt <- getContext+        -- Build the LHS as an "Infer", and pull out its type and+        -- pattern bindings+        i <- get+        let lhs = addImpl i lhs_in+        logLvl 5 ("LHS: " ++ showImp True lhs)+        ((lhs', dlhs, []), _) <- tclift $ elaborate ctxt (MN 0 "patLHS") infP []+                                      (erun fc (buildTC i info True tcgen fname (infTerm lhs)))+        let lhs_tm = orderPats (getInferTerm lhs')+        let lhs_ty = getInferType lhs'+        let ret_ty = getRetTy lhs_ty+        logLvl 3 (show lhs_tm)+        (clhs, clhsty) <- recheckC ctxt fc [] lhs_tm+        logLvl 5 ("Checked " ++ show clhs)+        let bargs = getPBtys lhs_tm+        let wval = addImpl i wval_in+        logLvl 5 ("Checking " ++ showImp True wval)+        -- Elaborate wval in this context+        ((wval', defer, is), _) <- +            tclift $ elaborate ctxt (MN 0 "withRHS") +                        (bindTyArgs PVTy bargs infP) []+                        (do pbinds lhs_tm+                            -- TODO: may want where here - see winfo abpve+                            (_', d, is) <- erun fc (build i info False fname (infTerm wval))+                            psolve lhs_tm+                            tt <- get_term+                            return (tt, d, is))+        def' <- checkDef fc defer+        addDeferred def'+        mapM_ (elabCaseBlock info) is+        (cwval, cwvalty) <- recheckC ctxt fc [] (getInferTerm wval')+        logLvl 3 ("With type " ++ show cwvalty ++ "\nRet type " ++ show ret_ty)+        windex <- getName+        -- build a type declaration for the new function:+        -- (ps : Xs) -> (withval : cwvalty) -> ret_ty +        let wtype = bindTyArgs Pi (bargs ++ [(MN 0 "warg", getRetTy cwvalty)]) ret_ty+        logLvl 3 ("New function type " ++ show wtype)+        let wname = MN windex (show fname)+        let imps = getImps wtype -- add to implicits context+        put (i { idris_implicits = addDef wname imps (idris_implicits i) })+        addIBC (IBCDef wname)+        def' <- checkDef fc [(wname, wtype)]+        addDeferred def'++        -- in the subdecls, lhs becomes:+        --         fname  pats | wpat [rest]+        --    ==>  fname' ps   wpat [rest], match pats against toplevel for ps+        wb <- mapM (mkAuxC wname lhs (map fst bargs)) withblock+        logLvl 5 ("with block " ++ show wb)+        mapM_ (elabDecl info) wb++        -- rhs becomes: fname' ps wval+        let rhs = PApp fc (PRef fc wname) (map (pexp . (PRef fc) . fst) bargs ++ +                                                [pexp wval])+        logLvl 3 ("New RHS " ++ show rhs)+        ctxt <- getContext -- New context with block added+        i <- get+        ((rhs', defer, is), _) <-+           tclift $ elaborate ctxt (MN 0 "wpatRHS") clhsty []+                    (do pbinds lhs_tm+                        (_, d, is) <- erun fc (build i info False fname rhs)+                        psolve lhs_tm+                        tt <- get_term+                        return (tt, d, is))+        def' <- checkDef fc defer+        addDeferred def'+        mapM_ (elabCaseBlock info) is+        (crhs, crhsty) <- recheckC ctxt fc [] rhs'+        return $ Just (clhs, crhs)+  where+    getImps (Bind n (Pi _) t) = pexp Placeholder : getImps t+    getImps _ = []++    mkAuxC wname lhs ns (PClauses fc o n cs)+        | True  = do cs' <- mapM (mkAux wname lhs ns) cs+                     return $ PClauses fc o wname cs'+        | otherwise = fail $ show fc ++ "with clause uses wrong function name " ++ show n+    mkAuxC wname lhs ns d = return $ d++    mkAux wname toplhs ns (PClause n tm_in (w:ws) rhs wheres)+        = do i <- get+             let tm = addImpl i tm_in+             logLvl 2 ("Matching " ++ showImp True tm ++ " against " ++ +                                      showImp True toplhs)+             case matchClause toplhs tm of+                Left _ -> fail $ show fc ++ "with clause does not match top level"+                Right mvars -> do logLvl 3 ("Match vars : " ++ show mvars)+                                  lhs <- updateLHS n wname mvars ns (fullApp tm) w+                                  return $ PClause wname lhs ws rhs wheres+    mkAux wname toplhs ns (PWith n tm_in (w:ws) wval withs)+        = do i <- get+             let tm = addImpl i tm_in+             logLvl 2 ("Matching " ++ showImp True tm ++ " against " ++ +                                      showImp True toplhs)+             withs' <- mapM (mkAuxC wname toplhs ns) withs+             case matchClause toplhs tm of+                Left _ -> fail $ show fc ++ "with clause does not match top level"+                Right mvars -> do lhs <- updateLHS n wname mvars ns (fullApp tm) w+                                  return $ PWith wname lhs ws wval withs'+        +    updateLHS n wname mvars ns (PApp fc (PRef fc' n') args) w+        = return $ substMatches mvars $ +                PApp fc (PRef fc' wname) (map (pexp . (PRef fc')) ns ++ [pexp w])+    updateLHS n wname mvars ns tm w = fail $ "Not implemented match " ++ show tm ++    fullApp (PApp _ (PApp fc f args) xs) = fullApp (PApp fc f (args ++ xs))+    fullApp x = x++data MArgTy = IA | EA | CA deriving Show++elabClass :: ElabInfo -> SyntaxInfo -> +             FC -> [PTerm] -> +             Name -> [(Name, PTerm)] -> [PDecl] -> Idris ()+elabClass info syn fc constraints tn ps ds +    = do let cn = UN ("instance" ++ show tn) -- MN 0 ("instance" ++ show tn)+         let tty = pibind ps PSet+         let constraint = PApp fc (PRef fc tn)+                                  (map (pexp . PRef fc) (map fst ps))+         -- build data declaration+         ims <- mapM tdecl (filter tydecl ds)+         defs <- mapM (defdecl (map (\ (x,y,z) -> z) ims) constraint) +                      (filter clause ds)+         let (methods, imethods) = unzip (map (\ (x,y,z) -> (x, y)) ims)+         let cty = impbind ps $ conbind constraints $ pibind methods constraint+         let cons = [(cn, cty, fc)]+         let ddecl = PData syn fc (PDatadecl tn tty cons)+         elabDecl info ddecl+         -- for each constraint, build a top level function to chase it+         let usyn = syn { using = ps ++ using syn }+         fns <- mapM (cfun cn constraint usyn (map fst imethods)) constraints+         mapM_ (elabDecl info) (concat fns)+         -- for each method, build a top level function+         fns <- mapM (tfun cn constraint usyn (map fst imethods)) imethods+         mapM_ (elabDecl info) (concat fns)+         -- add the default definitions+         mapM_ (elabDecl info) (concat (map (snd.snd) defs))+         i <- get+         let defaults = map (\ (x, (y, z)) -> (x,y)) defs+         put (i { idris_classes = addDef tn (CI cn imethods defaults (map fst ps)) +                                            (idris_classes i) })+         addIBC (IBCClass tn)+  where+    pibind [] x = x+    pibind ((n, ty): ns) x = PPi expl n ty (pibind ns x) +    impbind [] x = x+    impbind ((n, ty): ns) x = PPi impl n ty (impbind ns x) +    conbind (ty : ns) x = PPi constraint (MN 0 "c") ty (conbind ns x)+    conbind [] x = x++    tdecl (PTy syn _ n t) = do t' <- implicit syn n t+                               return ( (n, (toExp (map fst ps) Exp t')),+                                        (n, (toExp (map fst ps) Imp t')),+                                        (n, (syn, t) ) )+    tdecl _ = fail "Not allowed in a class declaration"++    -- Create default definitions +    defdecl mtys c d@(PClauses fc opts n cs) =+        case lookup n mtys of+            Just (syn, ty) -> do let ty' = insertConstraint c ty+                                 let ds = map (decorateid defaultdec)+                                              [PTy syn fc n ty', +                                               PClauses fc (TCGen:opts) n cs]+                                 iLOG (show ds)+                                 return (n, (defaultdec n, ds))+            _ -> fail $ show n ++ " is not a method"+    defdecl _ _ _ = fail "Can't happen (defdecl)"++    defaultdec (UN n) = UN ("default#" ++ n)+    defaultdec (NS n ns) = NS (defaultdec n) ns++    tydecl (PTy _ _ _ _) = True+    tydecl _ = False+    clause (PClauses _ _ _ _) = True+    clause _ = False++    cfun cn c syn all con+        = do let cfn = UN ('@':show cn ++ "#" ++ show con)+             let mnames = take (length all) $ map (\x -> MN x "meth") [0..]+             let capp = PApp fc (PRef fc cn) (map (pexp . PRef fc) mnames)+             let lhs = PApp fc (PRef fc cfn) [pconst capp]+             let rhs = PResolveTC (FC "HACK" 0)+             let ty = PPi constraint (MN 0 "pc") c con+             iLOG (showImp True ty)+             iLOG (showImp True lhs ++ " = " ++ showImp True rhs)+             return [PTy syn fc cfn ty,+                     PClauses fc [Inlinable,TCGen] cfn [PClause cfn lhs [] rhs []]]++    tfun cn c syn all (m, ty) +        = do let ty' = insertConstraint c ty+             let mnames = take (length all) $ map (\x -> MN x "meth") [0..]+             let capp = PApp fc (PRef fc cn) (map (pexp . PRef fc) mnames)+             let margs = getMArgs ty+             let anames = map (\x -> MN x "arg") [0..]+             let lhs = PApp fc (PRef fc m) (pconst capp : lhsArgs margs anames)+             let rhs = PApp fc (getMeth mnames all m) (rhsArgs margs anames)+             iLOG (showImp True ty)+             iLOG (show (m, ty', capp, margs))+             iLOG (showImp True lhs ++ " = " ++ showImp True rhs)+             return [PTy syn fc m ty',+                     PClauses fc [Inlinable,TCGen] m [PClause m lhs [] rhs []]]++    getMArgs (PPi (Imp _ _) n ty sc) = IA : getMArgs sc+    getMArgs (PPi (Exp _ _) n ty sc) = EA  : getMArgs sc+    getMArgs (PPi (Constraint _ _) n ty sc) = CA : getMArgs sc+    getMArgs _ = []++    getMeth (m:ms) (a:as) x | x == a = PRef fc m+                            | otherwise = getMeth ms as x++    lhsArgs (EA : xs) (n : ns) = pexp (PRef fc n) : lhsArgs xs ns +    lhsArgs (IA : xs) ns = lhsArgs xs ns +    lhsArgs (CA : xs) ns = lhsArgs xs ns+    lhsArgs [] _ = []++    rhsArgs (EA : xs) (n : ns) = pexp (PRef fc n) : rhsArgs xs ns +    rhsArgs (IA : xs) ns = pexp Placeholder : rhsArgs xs ns +    rhsArgs (CA : xs) ns = pconst (PResolveTC fc) : rhsArgs xs ns+    rhsArgs [] _ = []++    insertConstraint c (PPi p@(Imp _ _) n ty sc)+                          = PPi p n ty (insertConstraint c sc)+    insertConstraint c sc = PPi constraint (MN 0 "c") c sc++    -- make arguments explicit and don't bind class parameters+    toExp ns e (PPi (Imp l s) n ty sc)+        | n `elem` ns = toExp ns e sc+        | otherwise = PPi (e l s) n ty (toExp ns e sc)+    toExp ns e (PPi p n ty sc) = PPi p n ty (toExp ns e sc)+    toExp ns e sc = sc++elabInstance :: ElabInfo -> SyntaxInfo -> +                FC -> [PTerm] -> Name -> +                [PTerm] -> PTerm -> [PDecl] -> Idris ()+elabInstance info syn fc cs n ps t ds+    = do i <- get +         (n, ci) <- case lookupCtxtName (namespace info) n (idris_classes i) of+                       [c] -> return c+                       _ -> fail $ show n ++ " is not a type class"+         let iname = UN ('@':show n ++ "$" ++ show ps)+         elabType info syn fc iname t+         let ips = zip (class_params ci) ps+         let ns = case n of+                    NS n ns' -> ns'+                    _ -> []+         let mtys = map (\ (n, t) -> let t' = substMatches ips t in+                                         (decorate ns n, coninsert cs t', t'))+                        (class_methods ci)+         logLvl 3 (show (mtys, ips))+         let ds' = insertDefaults (class_defaults ci) ns ds+         iLOG ("Defaults inserted: " ++ show ds' ++ "\n" ++ show ci)+         mapM_ (warnMissing ds' ns) (map fst (class_methods ci))+         let wb = map mkTyDecl mtys ++ map (decorateid (decorate ns)) ds'+         let lhs = PRef fc iname+         let rhs = PApp fc (PRef fc (instanceName ci))+                           (map (pexp . mkMethApp) mtys)+         let idecl = PClauses fc [Inlinable, TCGen] iname +                                 [PClause iname lhs [] rhs wb]+         iLOG (show idecl)+         elabDecl info idecl+  where+    mkMethApp (n, _, ty) = lamBind 0 ty (papp fc (PRef fc n) (methArgs 0 ty))+    lamBind i (PPi (Constraint _ _) _ _ sc) sc' +                                  = PLam (MN i "meth") Placeholder (lamBind (i+1) sc sc')+    lamBind i (PPi _ n ty sc) sc' = PLam (MN i "meth") Placeholder (lamBind (i+1) sc sc')+    lamBind i _ sc = sc+    methArgs i (PPi (Imp _ _) n ty sc) +        = PImp 0 False n (PRef fc (MN i "meth")) : methArgs (i+1) sc+    methArgs i (PPi (Exp _ _) n ty sc) +        = PExp 0 False (PRef fc (MN i "meth")) : methArgs (i+1) sc+    methArgs i (PPi (Constraint _ _) n ty sc) +        = PConstraint 0 False (PResolveTC fc) : methArgs (i+1) sc+    methArgs i _ = []++    papp fc f [] = f+    papp fc f as = PApp fc f as++    decorate ns (UN n) = NS (UN ('!':n)) ns+    decorate ns (NS (UN n) s) = NS (UN ('!':n)) ns++    mkTyDecl (n, t, _) = PTy syn fc n t++    conbind (ty : ns) x = PPi constraint (MN 0 "c") ty (conbind ns x)+    conbind [] x = x++    coninsert cs (PPi p@(Imp _ _) n t sc) = PPi p n t (coninsert cs sc)+    coninsert cs sc = conbind cs sc++    insertDefaults :: [(Name, Name)] -> [String] -> [PDecl] -> [PDecl]+    insertDefaults [] ns ds = ds+    insertDefaults ((n,dn) : defs) ns ds +       = insertDefaults defs ns (insertDef n dn ns ds)++    insertDef meth def ns decls+        | null $ filter (clauseFor meth ns) decls+            = decls ++ [PClauses fc [Inlinable,TCGen] meth +                        [PClause meth (PApp fc (PRef fc meth) []) [] +                                      (PApp fc (PRef fc def) []) []]]+        | otherwise = decls++    warnMissing decls ns meth+        | null $ filter (clauseFor meth ns) decls+            = iWarn fc $ "method " ++ show meth ++ " not defined"+        | otherwise = return ()++    clauseFor m ns (PClauses _ _ m' _) = decorate ns m == decorate ns m'+    clauseFor m ns _ = False++decorateid decorate (PTy s f n t) = PTy s f (decorate n) t+decorateid decorate (PClauses f o n cs) +   = PClauses f o (decorate n) (map dc cs)+    where dc (PClause n t as w ds) = PClause (decorate n) (dappname t) as w ds+          dc (PWith   n t as w ds) = PWith   (decorate n) (dappname t) as w +                                              (map (decorateid decorate) ds)+          dappname (PApp fc (PRef fc' n) as) = PApp fc (PRef fc' (decorate n)) as+          dappname t = t++pbinds (Bind n (PVar t) sc) = do attack; patbind n +                                 pbinds sc+pbinds tm = return ()++pbty (Bind n (PVar t) sc) tm = Bind n (PVTy t) (pbty sc tm)+pbty _ tm = tm++getPBtys (Bind n (PVar t) sc) = (n, t) : getPBtys sc+getPBtys _ = []++psolve (Bind n (PVar t) sc) = do solve; psolve sc+psolve tm = return ()++pvars ist (Bind n (PVar t) sc) = (n, delab ist t) : pvars ist sc+pvars ist _ = []++-- TODO: Also build a 'binary' version of each declaration for fast reloading++elabDecl :: ElabInfo -> PDecl -> Idris ()+elabDecl info d = idrisCatch (elabDecl' info d) +                             (\e -> do let msg = show e+                                       setErrLine (getErrLine msg)+                                       iputStrLn msg)++elabDecl' info (PFix _ _ _)      = return () -- nothing to elaborate+elabDecl' info (PSyntax _ p) = return () -- nothing to elaborate+elabDecl' info (PTy s f n ty)    = do iLOG $ "Elaborating type decl " ++ show n+                                      elabType info s f n ty+elabDecl' info (PData s f d)     = do iLOG $ "Elaborating " ++ show (d_name d)+                                      elabData info s f d+elabDecl' info d@(PClauses f o n ps) = do iLOG $ "Elaborating clause " ++ show n+                                          elabClauses info f o n ps+elabDecl' info (PParams f ns ps) = mapM_ (elabDecl' pinfo) ps+  where+    pinfo = let ds = concatMap declared ps+                newps = params info ++ ns+                dsParams = map (\n -> (n, map fst newps)) ds+                newb = addAlist dsParams (inblock info) in +                info { params = newps,+                       inblock = newb }+elabDecl' info (PNamespace n ps) = mapM_ (elabDecl' ninfo) ps+  where+    ninfo = case namespace info of+                Nothing -> info { namespace = Just [n] }+                Just ns -> info { namespace = Just (n:ns) } +elabDecl' info (PClass s f cs n ps ds) = do iLOG $ "Elaborating class " ++ show n+                                            elabClass info s f cs n ps ds+elabDecl' info (PInstance s f cs n ps t ds) +    = do iLOG $ "Elaborating instance " ++ show n+         elabInstance info s f cs n ps t ds+elabDecl' info (PDirective i) = i++elabCaseBlock info d@(PClauses f o n ps) +        = do addIBC (IBCDef n)+             elabDecl' info d ++-- elabDecl' info (PImport i) = loadModule i++-- Check that the result of type checking matches what the programmer wrote+-- (i.e. - if we inferred any arguments that the user provided, make sure+-- they are the same!)++checkInferred :: FC -> PTerm -> PTerm -> Idris ()+checkInferred fc inf user =+     do logLvl 6 $ "Checked to\n" ++ showImp True inf ++ "\n" +++                                     showImp True user+        tclift $ case matchClause' True user inf of +            Right vs -> return ()+            Left (x, y) -> tfail $ At fc +                                    (Msg $ "The type-checked term and given term do not match: "+                                           ++ show x ++ " and " ++ show y)+--                           ++ "\n" ++ showImp True inf ++ "\n" ++ showImp True user)+
+ src/Idris/ElabTerm.hs view
@@ -0,0 +1,451 @@+module Idris.ElabTerm where++import Idris.AbsSyntax++import Core.Elaborate hiding (Tactic(..))+import Core.TT+import Core.Evaluate++import Control.Monad+import Control.Monad.State+import Data.List+import Debug.Trace++-- Data to pass to recursively called elaborators; e.g. for where blocks,+-- paramaterised declarations, etc.++data ElabInfo = EInfo { params :: [(Name, PTerm)],+                        inblock :: Ctxt [Name], -- names in the block, and their params+                        liftname :: Name -> Name,+                        namespace :: Maybe [String] }++toplevel = EInfo [] emptyContext id Nothing++type ElabD a = Elab' [PDecl] a++-- Using the elaborator, convert a term in raw syntax to a fully+-- elaborated, typechecked term.+--+-- If building a pattern match, we convert undeclared variables from+-- holes to pattern bindings.++-- Also find deferred names in the term and their types++build :: IState -> ElabInfo -> Bool -> Name -> PTerm -> +         ElabD (Term, [(Name, Type)], [PDecl])+build ist info pattern fn tm +    = do elab ist info pattern False fn tm+         is <- getAux+         tt <- get_term+         let (tm, ds) = runState (collectDeferred tt) []+         return (tm, ds, is)++-- Build a term autogenerated as a typeclass method definition+-- (Separate, so we don't go overboard resolving things that we don't+-- know about yet on the LHS of a pattern def)++buildTC :: IState -> ElabInfo -> Bool -> Bool -> Name -> PTerm -> +         ElabD (Term, [(Name, Type)], [PDecl])+buildTC ist info pattern tcgen fn tm +    = do elab ist info pattern tcgen fn tm+         is <- getAux+         tt <- get_term+         let (tm, ds) = runState (collectDeferred tt) []+         return (tm, ds, is)++-- Returns the set of declarations we need to add to complete the definition+-- (most likely case blocks to elaborate)++elab :: IState -> ElabInfo -> Bool -> Bool -> Name -> PTerm -> +        ElabD ()+elab ist info pattern tcgen fn tm +    = do elabE False tm+         when pattern -- convert remaining holes to pattern vars+              mkPat+         inj <- get_inj+         mapM_ checkInjective inj+  where+    isph arg = case getTm arg of+        Placeholder -> (True, priority arg)+        _ -> (False, priority arg)++    toElab ina arg = case getTm arg of+        Placeholder -> Nothing+        v -> Just (priority arg, elabE ina v)++    toElab' ina arg = case getTm arg of+        Placeholder -> Nothing+        v -> Just (elabE ina v)++    mkPat = do hs <- get_holes+               case hs of+                  (h: hs) -> do patvar h; mkPat+                  [] -> return ()++    elabE ina t = {- do g <- goal+                 tm <- get_term+                 trace ("Elaborating " ++ show t ++ " : " ++ show g ++ "\n\tin " ++ show tm) +                    $ -} elab' ina t++    local f = do e <- get_env+                 return (f `elem` map fst e)++    elab' ina PSet           = do apply RSet []; solve+    elab' ina (PConstant c)  = do apply (RConstant c) []; solve+    elab' ina (PQuote r)     = do fill r; solve+    elab' ina (PTrue fc)     = try (elab' ina (PRef fc unitCon))+                                   (elab' ina (PRef fc unitTy))+    elab' ina (PFalse fc)    = elab' ina (PRef fc falseTy)+    elab' ina (PResolveTC (FC "HACK" _)) -- for chasing parent classes+       = resolveTC 2 fn ist+    elab' ina (PResolveTC fc) = do c <- unique_hole (MN 0 "c")+                                   instanceArg c+    elab' ina (PRefl fc)     = elab' ina (PApp fc (PRef fc eqCon) [pimp (MN 0 "a") Placeholder,+                                                           pimp (MN 0 "x") Placeholder])+    elab' ina (PEq fc l r)   = elab' ina (PApp fc (PRef fc eqTy) [pimp (MN 0 "a") Placeholder,+                                                          pimp (MN 0 "b") Placeholder,+                                                          pexp l, pexp r])+    elab' ina (PPair fc l r) = try (elabE True (PApp fc (PRef fc pairTy)+                                            [pexp l,pexp r]))+                                   (elabE True (PApp fc (PRef fc pairCon)+                                            [pimp (MN 0 "A") Placeholder,+                                             pimp (MN 0 "B") Placeholder,+                                             pexp l, pexp r]))+    elab' ina (PDPair fc l@(PRef _ n) t r)+            = case t of +                Placeholder -> try asType asValue+                _ -> asType+         where asType = elab' ina (PApp fc (PRef fc sigmaTy)+                                        [pexp t,+                                         pexp (PLam n Placeholder r)])+               asValue = elab' ina (PApp fc (PRef fc existsCon)+                                         [pimp (MN 0 "a") t,+                                          pimp (MN 0 "P") Placeholder,+                                          pexp l, pexp r])+    elab' ina (PDPair fc l t r) = elab' ina (PApp fc (PRef fc existsCon)+                                            [pimp (MN 0 "a") t,+                                             pimp (MN 0 "P") Placeholder,+                                             pexp l, pexp r])+    elab' ina (PAlternative as) +        = let as' = pruneAlt as in+              try (tryAll (zip (map (elab' ina) as') (map showHd as')))+                  (tryAll (zip (map (elab' ina) as) (map showHd as)))+        where showHd (PApp _ h _) = show h+              showHd x = show x+    elab' ina (PRef fc n) | pattern && not (inparamBlock n)+                         = do ctxt <- get_context+                              let iscon = isConName Nothing n ctxt+                              if (not iscon && ina) then erun fc $ patvar n+                                else try (do apply (Var n) []; solve)+                                         (patvar n)+      where inparamBlock n = case lookupCtxtName Nothing n (inblock info) of+                                [] -> False+                                _ -> True+    elab' ina (PRef fc n) = erun fc $ do apply (Var n) []; solve+    elab' ina (PLam n Placeholder sc)+          = do attack; intro (Just n); elabE True sc; solve+    elab' ina (PLam n ty sc)+          = do tyn <- unique_hole (MN 0 "lamty")+               claim tyn RSet+               attack+               introTy (Var tyn) (Just n)+               -- end_unify+               focus tyn+               elabE True ty+               elabE True sc+               solve+    elab' ina (PPi _ n Placeholder sc)+          = do attack; arg n (MN 0 "ty"); elabE True sc; solve+    elab' ina (PPi _ n ty sc) +          = do attack; tyn <- unique_hole (MN 0 "ty")+               claim tyn RSet+               n' <- case n of +                        MN _ _ -> unique_hole n+                        _ -> return n+               forall n' (Var tyn)+               focus tyn+               elabE True ty+               elabE True sc+               solve+    elab' ina (PLet n ty val sc)+          = do attack;+               tyn <- unique_hole (MN 0 "letty")+               claim tyn RSet+               valn <- unique_hole (MN 0 "letval")+               claim valn (Var tyn)+               letbind n (Var tyn) (Var valn)+               case ty of+                   Placeholder -> return ()+                   _ -> do focus tyn+                           elabE True ty+               focus valn+               elabE True val+               elabE True sc+               solve+    elab' ina (PApp fc (PRef _ f) args')+       = do let args = {- case lookupCtxt f (inblock info) of+                          Just ps -> (map (pexp . (PRef fc)) ps ++ args')+                          _ ->-} args'+            ivs <- get_instances+            -- HACK: we shouldn't resolve type classes if we're defining an instance+            -- function or default defition.+            let isinf = f == inferCon || tcname f+            try (do ns <- apply (Var f) (map isph args)+                    solve+                    let (ns', eargs) +                         = unzip $+                             sortBy (\(_,x) (_,y) -> compare (priority x) (priority y))+                                    (zip ns args)+                    try (elabArgs (ina || not isinf)+                             [] False ns' (map (\x -> (lazyarg x, getTm x)) eargs))+                        (elabArgs (ina || not isinf)+                             [] False (reverse ns') +                                      (map (\x -> (lazyarg x, getTm x)) (reverse eargs))))+--                 (try (do apply2 (Var f) (map (toElab' (ina || not isinf)) args)) +                     (do apply_elab f (map (toElab (ina || not isinf)) args)+                         solve)+            ivs' <- get_instances+            when (not pattern || (ina && not tcgen)) $+                mapM_ (\n -> do focus n+                                resolveTC 7 fn ist) (ivs' \\ ivs) +--             ivs <- get_instances+--             when (not (null ivs)) $+--               do t <- get_term+--                  trace (show ivs ++ "\n" ++ show t) $ +--                    mapM_ (\n -> do focus n+--                                    resolveTC ist) ivs+      where tcArg (n, PConstraint _ _ Placeholder) = True+            tcArg _ = False++    elab' a (PApp fc f [arg])+          = erun fc $ +             do simple_app (elabE a f) (elabE True (getTm arg))+                solve+    elab' ina Placeholder = do (h : hs) <- get_holes+                               movelast h+    elab' ina (PMetavar n) = let n' = mkN n in+                                 do attack; defer n'; solve+        where mkN n@(NS _ _) = n+              mkN n = case namespace info of+                        Just xs@(_:_) -> NS n xs+                        _ -> n+    elab' ina (PProof ts) = do mapM_ (runTac True ist) ts+    elab' ina (PTactics ts) = do mapM_ (runTac False ist) ts+    elab' ina (PElabError e) = fail e+    elab' ina c@(PCase fc scr opts)+        = do attack+             tyn <- unique_hole (MN 0 "scty")+             claim tyn RSet+             valn <- unique_hole (MN 0 "scval")+             scvn <- unique_hole (MN 0 "scvar")+             claim valn (Var tyn)+             letbind scvn (Var tyn) (Var valn)+             focus valn+             elabE True scr+             args <- get_env+             cname <- unique_hole (mkCaseName fn)+             elab' ina (PMetavar cname)+             let newdef = PClauses fc [] cname (caseBlock fc cname (reverse args) opts)+             -- fail $ "Not implemented " ++ show c ++ "\n" ++ show args+             -- elaborate case+             updateAux (newdef : )+             solve+        where mkCaseName (NS n ns) = NS (mkCaseName n) ns+              mkCaseName (UN x) = UN (x ++ "_case")+              mkCaseName (MN i x) = MN i (x ++ "_case")+    elab' ina x = fail $ "Something's gone wrong. Did you miss a semi-colon somewhere?"++    caseBlock :: FC -> Name -> [(Name, Binder Term)] -> [(PTerm, PTerm)] -> [PClause]+    caseBlock fc n env opts +        = let args = map mkarg (map fst (init env)) in+              map (mkClause args) opts+       where -- mkarg (MN _ _) = Placeholder+             mkarg n = PRef fc n+             mkClause args (l, r) +                = PClause n (PApp fc (PRef fc n)+                                     (map pexp args ++ [pexp l])) [] r []++    elabArgs ina failed retry [] _+        | retry = let (ns, ts) = unzip (reverse failed) in+                      elabArgs ina [] False ns ts+        | otherwise = return ()+    elabArgs ina failed r (n:ns) ((_, Placeholder) : args) +        = elabArgs ina failed r ns args+    elabArgs ina failed r (n:ns) ((lazy, t) : args)+        | lazy && not pattern +          = do elabArg n (PApp bi (PRef bi (UN "lazy"))+                               [pimp (UN "a") Placeholder,+                                pexp t]); +        | otherwise = elabArg n t+      where elabArg n t +                = do hs <- get_holes+                     tm <- get_term+                     failed' <- -- trace (show (n, t, hs, tm)) $ +                                case n `elem` hs of+                                   True ->+                                      if r+                                         then try (do focus n; elabE ina t; return failed)+                                                  (return ((n,(lazy, t)):failed))+                                         else do focus n; elabE ina t; return failed+                                   False -> return failed+                     elabArgs ina failed r ns args++pruneAlt :: [PTerm] -> [PTerm]+pruneAlt xs = map prune xs+  where+    prune (PApp fc1 (PRef fc2 f) as) +        = PApp fc1 (PRef fc2 f) (fmap (fmap (choose f)) as)+    prune t = t++    choose f (PAlternative as) = PAlternative (filter (headIs f) as)+    choose f t = t++    headIs f (PApp _ (PRef _ f') _) = f == f'+    headIs f _ = True -- keep if it's not an application++trivial :: IState -> ElabD ()+trivial ist = try (do elab ist toplevel False False (MN 0 "tac") (PRefl (FC "prf" 0))+                      return ())+                  (do env <- get_env+                      tryAll (map fst env)+                      return ())+      where+        tryAll []     = fail "No trivial solution"+        tryAll (x:xs) = try (elab ist toplevel False False+                                    (MN 0 "tac") (PRef (FC "prf" 0) x))+                            (tryAll xs)++resolveTC :: Int -> Name -> IState -> ElabD ()+resolveTC 0 fn ist = fail $ "Can't resolve type class"+resolveTC depth fn ist +         = try (trivial ist)+               (do t <- goal+                   let (tc, ttypes) = unApply t+                   needsDefault t tc ttypes+                   tm <- get_term+--                    traceWhen (depth > 6) ("GOAL: " ++ show t ++ "\nTERM: " ++ show tm) $+--                        (tryAll (map elabTC (map fst (ctxtAlist (tt_ctxt ist)))))+                   blunderbuss t (map fst (ctxtAlist (tt_ctxt ist))))+  where+    elabTC n | n /= fn && tcname n = (resolve n depth, show n)+             | otherwise = (fail "Can't resolve", show n)++    needsDefault t num@(P _ (NS (UN "Num") ["builtins"]) _) [P Bound a _]+        = do focus a+             fill (RConstant IType) -- default Int+             solve+--     needsDefault t f as+--         | all boundVar as = fail $ "Can't resolve " ++ show t+    needsDefault t f a = return ()++    boundVar (P Bound _ _) = True+    boundVar _ = False++    blunderbuss t [] = fail $ "Can't resolve type class " ++ show t+    blunderbuss t (n:ns) | n /= fn && tcname n = try (resolve n depth)+                                                     (blunderbuss t ns)+                         | otherwise = blunderbuss t ns++    resolve n depth+       | depth == 0 = fail $ "Can't resolve type class"+       | otherwise +              = do t <- goal+                   -- if there's a hole in the goal, don't even try+                   let imps = case lookupCtxtName Nothing n (idris_implicits ist) of+                                [] -> []+                                [args] -> map isImp (snd args) -- won't be overloaded!+                   args <- apply (Var n) imps+                   tm <- get_term+                   mapM_ (\ (_,n) -> do focus n+                                        resolveTC (depth - 1) fn ist) +                         (filter (\ (x, y) -> not x) (zip (map fst imps) args))+                   -- if there's any arguments left, we've failed to resolve+                   solve+       where isImp (PImp p _ _ _) = (True, p)+             isImp arg = (False, priority arg)++collectDeferred :: Term -> State [(Name, Type)] Term+collectDeferred (Bind n (GHole t) app) =+    do ds <- get+       put ((n, t) : ds)+       return app+collectDeferred (Bind n b t) = do b' <- cdb b+                                  t' <- collectDeferred t+                                  return (Bind n b' t')+  where+    cdb (Let t v)   = liftM2 Let (collectDeferred t) (collectDeferred v)+    cdb (Guess t v) = liftM2 Guess (collectDeferred t) (collectDeferred v)+    cdb b           = do ty' <- collectDeferred (binderTy b)+                         return (b { binderTy = ty' })+collectDeferred (App f a) = liftM2 App (collectDeferred f) (collectDeferred a)+collectDeferred t = return t++-- Running tactics directly++runTac :: Bool -> IState -> PTactic -> ElabD ()+runTac autoSolve ist tac = runT (fmap (addImpl ist) tac) where+    runT (Intro []) = do g <- goal+                         attack; intro (bname g)+      where+        bname (Bind n _ _) = Just n+        bname _ = Nothing+    runT (Intro xs) = mapM_ (\x -> do attack; intro (Just x)) xs+    runT Intros = do g <- goal+                     attack; intro (bname g)+                     try (runT Intros)+                         (return ())+      where+        bname (Bind n _ _) = Just n+        bname _ = Nothing+    runT (Exact tm) = do elab ist toplevel False False (MN 0 "tac") tm+                         when autoSolve solveAll+    runT (Refine fn [])   +        = do (fn', imps) <- case lookupCtxtName Nothing fn (idris_implicits ist) of+                                    [] -> do a <- envArgs fn+                                             return (fn, a)+                                    -- FIXME: resolve ambiguities+                                    [(n, args)] -> return $ (n, map isImp args)+             ns <- apply (Var fn') (map (\x -> (x,0)) imps)+             when autoSolve solveAll+       where isImp (PImp _ _ _ _) = True+             isImp _ = False+             envArgs n = do e <- get_env+                            case lookup n e of+                               Just t -> return $ map (const False)+                                                      (getArgTys (binderTy t))+                               _ -> return []+    runT (Refine fn imps) = do ns <- apply (Var fn) (map (\x -> (x,0)) imps)+                               when autoSolve solveAll+    runT (Rewrite tm) -- to elaborate tm, let bind it, then rewrite by that+              = do attack; -- (h:_) <- get_holes+                   tyn <- unique_hole (MN 0 "rty")+                   -- start_unify h+                   claim tyn RSet+                   valn <- unique_hole (MN 0 "rval")+                   claim valn (Var tyn)+                   letn <- unique_hole (MN 0 "rewrite_rule")+                   letbind letn (Var tyn) (Var valn)  +                   focus valn+                   elab ist toplevel False False (MN 0 "tac") tm+                   rewrite (Var letn)+                   when autoSolve solveAll+    runT (LetTac n tm)+              = do attack+                   tyn <- unique_hole (MN 0 "letty")+                   claim tyn RSet+                   valn <- unique_hole (MN 0 "letval")+                   claim valn (Var tyn)+                   letn <- unique_hole n+                   letbind letn (Var tyn) (Var valn)+                   focus valn+                   elab ist toplevel False False (MN 0 "tac") tm+                   when autoSolve solveAll+    runT Compute = compute+    runT Trivial = do trivial ist; when autoSolve solveAll+    runT (Focus n) = focus n+    runT Solve = solve+    runT (Try l r) = do try (runT l) (runT r)+    runT (TSeq l r) = do runT l; runT r+    runT x = fail $ "Not implemented " ++ show x++solveAll = try (do solve; solveAll) (return ())
+ src/Idris/Error.hs view
@@ -0,0 +1,61 @@+{-# LANGUAGE DeriveDataTypeable #-}++module Idris.Error where++import Prelude hiding (catch)+import Idris.AbsSyntax+import Idris.Delaborate++import Core.TT+import Core.Typecheck+import Core.Constraints++import System.Console.Haskeline+import Control.Monad.State+import System.IO.Error(isUserError, ioeGetErrorString)+import Data.Char+import Data.Typeable++iucheck :: Idris ()+iucheck = do tit <- typeInType+             when (not tit) $+                do ist <- get+                   idrisCatch (tclift $ ucheck (idris_constraints ist))+                              (\e -> do let msg = show e+                                        setErrLine (getErrLine msg)+                                        iputStrLn msg)++report :: IOError -> String+report e+    | isUserError e = ioeGetErrorString e +    | otherwise     = show e++idrisCatch :: Idris a -> (SomeException -> Idris a) -> Idris a+idrisCatch = catch++data IdrisErr = IErr String+    deriving Typeable++instance Show IdrisErr where+    show (IErr s) = s++instance Exception IdrisErr++ifail :: String -> Idris ()+ifail str = throwIO (IErr str)++tclift :: TC a -> Idris a+tclift tc = case tc of+               OK v -> return v+               Error err -> do i <- get+                               case err of+                                  At (FC f l) e -> setErrLine l+                                  _ -> return ()+                               throwIO (IErr $ pshow i err)++getErrLine str +  = case span (/=':') str of+      (_, ':':rest) -> case span isDigit rest of+        (num, _) -> read num+      _ -> 0+
+ src/Idris/IBC.hs view
@@ -0,0 +1,1046 @@+{-# LANGUAGE TypeSynonymInstances #-}++module Idris.IBC where++import Core.Evaluate+import Core.TT+import Core.CaseTree+import Idris.Compiler+import Idris.AbsSyntax+import Idris.Imports+import Idris.Error++import Data.Binary+import Data.List+import Data.ByteString.Lazy as B hiding (length, elem)+-- import Data.DeriveTH+import Control.Monad+import Control.Monad.State hiding (get, put)+import System.FilePath+import System.Directory++import Paths_idris++ibcVersion :: Word8+ibcVersion = 8++data IBCFile = IBCFile { ver :: Word8,+                         sourcefile :: FilePath,+                         ibc_imports :: [FilePath],+                         ibc_implicits :: [(Name, [PArg])],+                         ibc_fixes :: [FixDecl],+                         ibc_statics :: [(Name, [Bool])],+                         ibc_classes :: [(Name, ClassInfo)],+                         ibc_datatypes :: [(Name, TypeInfo)],+                         ibc_optimise :: [(Name, OptInfo)],+                         ibc_syntax :: [Syntax],+                         ibc_keywords :: [String],+                         ibc_objs :: [FilePath],+                         ibc_libs :: [String],+                         ibc_hdrs :: [String],+                         ibc_access :: [(Name, Accessibility)],+                         ibc_defs :: [(Name, Def)] }+{-! +deriving instance Binary IBCFile +!-}++initIBC :: IBCFile+initIBC = IBCFile ibcVersion "" [] [] [] [] [] [] [] [] [] [] [] [] [] []++loadIBC :: FilePath -> Idris ()+loadIBC fp = do iLOG $ "Loading ibc " ++ fp+                ibcf <- liftIO $ (decodeFile fp :: IO IBCFile)+                process ibcf fp++writeIBC :: FilePath -> FilePath -> Idris ()+writeIBC src f +    = do iLOG $ "Writing ibc " ++ show f+         i <- getIState+         case idris_metavars i \\ primDefs of+                (_:_) -> fail "Can't write ibc when there are unsolved metavariables"+                [] -> return ()+         ibcf <- mkIBC (ibc_write i) (initIBC { sourcefile = src }) +         idrisCatch (do liftIO $ encodeFile f ibcf+                        iLOG "Written")+            (\c -> do iLOG $ "Failed " ++ show c)+         return ()++mkIBC :: [IBCWrite] -> IBCFile -> Idris IBCFile+mkIBC [] f = return f+mkIBC (i:is) f = do ist <- getIState+                    logLvl 5 $ show i ++ " " ++ show (Data.List.length is)+                    f' <- ibc ist i f+                    mkIBC is f'++ibc i (IBCFix d) f = return f { ibc_fixes = d : ibc_fixes f } +ibc i (IBCImp n) f = case lookupCtxt Nothing n (idris_implicits i) of+                        [v] -> return f { ibc_implicits = (n,v): ibc_implicits f     }+                        _ -> fail "IBC write failed"+ibc i (IBCStatic n) f +                   = case lookupCtxt Nothing n (idris_statics i) of+                        [v] -> return f { ibc_statics = (n,v): ibc_statics f     }+                        _ -> fail "IBC write failed"+ibc i (IBCClass n) f +                   = case lookupCtxt Nothing n (idris_classes i) of+                        [v] -> return f { ibc_classes = (n,v): ibc_classes f     }+                        _ -> fail "IBC write failed"+ibc i (IBCData n) f +                   = case lookupCtxt Nothing n (idris_datatypes i) of+                        [v] -> return f { ibc_datatypes = (n,v): ibc_datatypes f     }+                        _ -> fail "IBC write failed"+ibc i (IBCOpt n) f = case lookupCtxt Nothing n (idris_optimisation i) of+                        [v] -> return f { ibc_optimise = (n,v): ibc_optimise f     }+                        _ -> fail "IBC write failed"+ibc i (IBCSyntax n) f = return f { ibc_syntax = n : ibc_syntax f }+ibc i (IBCKeyword n) f = return f { ibc_keywords = n : ibc_keywords f }+ibc i (IBCImport n) f = return f { ibc_imports = n : ibc_imports f }+ibc i (IBCObj n) f = return f { ibc_objs = n : ibc_objs f }+ibc i (IBCLib n) f = return f { ibc_libs = n : ibc_libs f }+ibc i (IBCHeader n) f = return f { ibc_hdrs = n : ibc_hdrs f }+ibc i (IBCDef n) f = case lookupDef Nothing n (tt_ctxt i) of+                        [v] -> return f { ibc_defs = (n,v) : ibc_defs f     }+                        _ -> fail "IBC write failed"+ibc i (IBCAccess n a) f = return f { ibc_access = (n,a) : ibc_access f }++process :: IBCFile -> FilePath -> Idris ()+process i fn+   | ver i /= ibcVersion = do iLOG "ibc out of date"+                              fail "Incorrect ibc version"+   | otherwise =  +            do srcok <- liftIO $ doesFileExist (sourcefile i)+               when srcok $ liftIO $ timestampOlder (sourcefile i) fn+               v <- verbose+               when (v && srcok) $ iputStrLn $ "Skipping " ++ sourcefile i+               pImports (ibc_imports i)+               pImps (ibc_implicits i)+               pFixes (ibc_fixes i)+               pStatics (ibc_statics i)+               pClasses (ibc_classes i)+               pDatatypes (ibc_datatypes i)+               pOptimise (ibc_optimise i)+               pSyntax (ibc_syntax i)+               pKeywords (ibc_keywords i)+               pObjs (ibc_objs i)+               pLibs (ibc_libs i)+               pHdrs (ibc_hdrs i)+               pDefs (ibc_defs i)+               pAccess (ibc_access i)++timestampOlder :: FilePath -> FilePath -> IO ()+timestampOlder src ibc = do srct <- getModificationTime src+                            ibct <- getModificationTime ibc+                            if (srct > ibct)+                               then fail "Needs reloading"+                               else return ()++pImports :: [FilePath] -> Idris ()+pImports fs +  = do datadir <- liftIO $ getDataDir+       mapM_ (\f -> do fp <- liftIO $ findImport [".", datadir] f+                       i <- getIState+                       if (f `elem` imported i)+                        then iLOG $ "Already read " ++ f+                        else do putIState (i { imported = f : imported i })+                                case fp of +                                    LIDR fn -> do iLOG $ "Failed at " ++ fn+                                                  fail "Must be an ibc"+                                    IDR fn -> do iLOG $ "Failed at " ++ fn+                                                 fail "Must be an ibc"+                                    IBC fn src -> loadIBC fn) +             fs++pImps :: [(Name, [PArg])] -> Idris ()+pImps imps = mapM_ (\ (n, imp) -> +                        do i <- getIState+                           putIState (i { idris_implicits +                                            = addDef n imp (idris_implicits i) }))+                   imps++pFixes :: [FixDecl] -> Idris ()+pFixes f = do i <- getIState+              putIState (i { idris_infixes = f ++ idris_infixes i })++pStatics :: [(Name, [Bool])] -> Idris ()+pStatics ss = mapM_ (\ (n, s) ->+                        do i <- getIState+                           putIState (i { idris_statics+                                           = addDef n s (idris_statics i) }))+                    ss++pClasses :: [(Name, ClassInfo)] -> Idris ()+pClasses cs = mapM_ (\ (n, c) ->+                        do i <- getIState+                           putIState (i { idris_classes+                                           = addDef n c (idris_classes i) }))+                    cs++pDatatypes :: [(Name, TypeInfo)] -> Idris ()+pDatatypes cs = mapM_ (\ (n, c) ->+                        do i <- getIState+                           putIState (i { idris_datatypes+                                           = addDef n c (idris_datatypes i) }))+                    cs++pOptimise :: [(Name, OptInfo)] -> Idris ()+pOptimise cs = mapM_ (\ (n, c) ->+                        do i <- getIState+                           putIState (i { idris_optimisation+                                           = addDef n c (idris_optimisation i) }))+                    cs++pSyntax :: [Syntax] -> Idris ()+pSyntax s = do i <- getIState+               putIState (i { syntax_rules = s ++ syntax_rules i })++pKeywords :: [String] -> Idris ()+pKeywords k = do i <- getIState+                 putIState (i { syntax_keywords = k ++ syntax_keywords i })++pObjs :: [FilePath] -> Idris ()+pObjs os = mapM_ addObjectFile os++pLibs :: [String] -> Idris ()+pLibs ls = mapM_ addLib ls++pHdrs :: [String] -> Idris ()+pHdrs hs = mapM_ addHdr hs++pDefs :: [(Name, Def)] -> Idris ()+pDefs ds = mapM_ (\ (n, d) -> +                     do i <- getIState+                        logLvl 5 $ "Added " ++ show (n, d)+                        putIState (i { tt_ctxt = addCtxtDef n d (tt_ctxt i) }))+                 ds       ++pAccess :: [(Name, Accessibility)] -> Idris ()+pAccess ds = mapM_ (\ (n, a) ->+                      do i <- getIState+                         putIState (i { tt_ctxt = setAccess n a (tt_ctxt i) }))+                   ds++----- Generated by 'derive'++ +instance Binary FC where+        put (FC x1 x2)+          = do put x1+               put x2+        get+          = do x1 <- get+               x2 <- get+               return (FC x1 x2)++ +instance Binary Name where+        put x+          = case x of+                UN x1 -> do putWord8 0+                            put x1+                NS x1 x2 -> do putWord8 1+                               put x1+                               put x2+                MN x1 x2 -> do putWord8 2+                               put x1+                               put x2+        get+          = do i <- getWord8+               case i of+                   0 -> do x1 <- get+                           return (UN x1)+                   1 -> do x1 <- get+                           x2 <- get+                           return (NS x1 x2)+                   2 -> do x1 <- get+                           x2 <- get+                           return (MN x1 x2)+                   _ -> error "Corrupted binary data for Name"++ +instance Binary Const where+        put x+          = case x of+                I x1 -> do putWord8 0+                           put x1+                BI x1 -> do putWord8 1+                            put x1+                Fl x1 -> do putWord8 2+                            put x1+                Ch x1 -> do putWord8 3+                            put x1+                Str x1 -> do putWord8 4+                             put x1+                IType -> putWord8 5+                BIType -> putWord8 6+                FlType -> putWord8 7+                ChType -> putWord8 8+                StrType -> putWord8 9+                PtrType -> putWord8 10+                Forgot -> putWord8 11+        get+          = do i <- getWord8+               case i of+                   0 -> do x1 <- get+                           return (I x1)+                   1 -> do x1 <- get+                           return (BI x1)+                   2 -> do x1 <- get+                           return (Fl x1)+                   3 -> do x1 <- get+                           return (Ch x1)+                   4 -> do x1 <- get+                           return (Str x1)+                   5 -> return IType+                   6 -> return BIType+                   7 -> return FlType+                   8 -> return ChType+                   9 -> return StrType+                   10 -> return PtrType+                   11 -> return Forgot+                   _ -> error "Corrupted binary data for Const"++ +instance Binary Raw where+        put x+          = case x of+                Var x1 -> do putWord8 0+                             put x1+                RBind x1 x2 x3 -> do putWord8 1+                                     put x1+                                     put x2+                                     put x3+                RApp x1 x2 -> do putWord8 2+                                 put x1+                                 put x2+                RSet -> putWord8 3+                RConstant x1 -> do putWord8 4+                                   put x1+                RForce x1 -> do putWord8 5+                                put x1+        get+          = do i <- getWord8+               case i of+                   0 -> do x1 <- get+                           return (Var x1)+                   1 -> do x1 <- get+                           x2 <- get+                           x3 <- get+                           return (RBind x1 x2 x3)+                   2 -> do x1 <- get+                           x2 <- get+                           return (RApp x1 x2)+                   3 -> return RSet+                   4 -> do x1 <- get+                           return (RConstant x1)+                   5 -> do x1 <- get+                           return (RForce x1)+                   _ -> error "Corrupted binary data for Raw"++ +instance (Binary b) => Binary (Binder b) where+        put x+          = case x of+                Lam x1 -> do putWord8 0+                             put x1+                Pi x1 -> do putWord8 1+                            put x1+                Let x1 x2 -> do putWord8 2+                                put x1+                                put x2+                NLet x1 x2 -> do putWord8 3+                                 put x1+                                 put x2+                Hole x1 -> do putWord8 4+                              put x1+                GHole x1 -> do putWord8 5+                               put x1+                Guess x1 x2 -> do putWord8 6+                                  put x1+                                  put x2+                PVar x1 -> do putWord8 7+                              put x1+                PVTy x1 -> do putWord8 8+                              put x1+        get+          = do i <- getWord8+               case i of+                   0 -> do x1 <- get+                           return (Lam x1)+                   1 -> do x1 <- get+                           return (Pi x1)+                   2 -> do x1 <- get+                           x2 <- get+                           return (Let x1 x2)+                   3 -> do x1 <- get+                           x2 <- get+                           return (NLet x1 x2)+                   4 -> do x1 <- get+                           return (Hole x1)+                   5 -> do x1 <- get+                           return (GHole x1)+                   6 -> do x1 <- get+                           x2 <- get+                           return (Guess x1 x2)+                   7 -> do x1 <- get+                           return (PVar x1)+                   8 -> do x1 <- get+                           return (PVTy x1)+                   _ -> error "Corrupted binary data for Binder"++ +instance Binary NameType where+        put x+          = case x of+                Bound -> putWord8 0+                Ref -> putWord8 1+                DCon x1 x2 -> do putWord8 2+                                 put x1+                                 put x2+                TCon x1 x2 -> do putWord8 3+                                 put x1+                                 put x2+        get+          = do i <- getWord8+               case i of+                   0 -> return Bound+                   1 -> return Ref+                   2 -> do x1 <- get+                           x2 <- get+                           return (DCon x1 x2)+                   3 -> do x1 <- get+                           x2 <- get+                           return (TCon x1 x2)+                   _ -> error "Corrupted binary data for NameType"++ +instance (Binary n) => Binary (TT n) where+        put x+          = case x of+                P x1 x2 x3 -> do putWord8 0+                                 put x1+                                 put x2+                                 put x3+                V x1 -> do putWord8 1+                           put x1+                Bind x1 x2 x3 -> do putWord8 2+                                    put x1+                                    put x2+                                    put x3+                App x1 x2 -> do putWord8 3+                                put x1+                                put x2+                Constant x1 -> do putWord8 4+                                  put x1+                Set x1 -> do putWord8 5+                             put x1+                Erased -> do putWord8 6+        get+          = do i <- getWord8+               case i of+                   0 -> do x1 <- get+                           x2 <- get+                           x3 <- get+                           return (P x1 x2 x3)+                   1 -> do x1 <- get+                           return (V x1)+                   2 -> do x1 <- get+                           x2 <- get+                           x3 <- get+                           return (Bind x1 x2 x3)+                   3 -> do x1 <- get+                           x2 <- get+                           return (App x1 x2)+                   4 -> do x1 <- get+                           return (Constant x1)+                   5 -> do x1 <- get+                           return (Set x1)+                   6 -> return Erased+                   _ -> error "Corrupted binary data for TT"++ +instance Binary SC where+        put x+          = case x of+                Case x1 x2 -> do putWord8 0+                                 put x1+                                 put x2+                STerm x1 -> do putWord8 1+                               put x1+                UnmatchedCase x1 -> do putWord8 2+                                       put x1+        get+          = do i <- getWord8+               case i of+                   0 -> do x1 <- get+                           x2 <- get+                           return (Case x1 x2)+                   1 -> do x1 <- get+                           return (STerm x1)+                   2 -> do x1 <- get+                           return (UnmatchedCase x1)+                   _ -> error "Corrupted binary data for SC"++ +instance Binary CaseAlt where+        put x+          = case x of+                ConCase x1 x2 x3 x4 -> do putWord8 0+                                          put x1+                                          put x2+                                          put x3+                                          put x4+                ConstCase x1 x2 -> do putWord8 1+                                      put x1+                                      put x2+                DefaultCase x1 -> do putWord8 2+                                     put x1+        get+          = do i <- getWord8+               case i of+                   0 -> do x1 <- get+                           x2 <- get+                           x3 <- get+                           x4 <- get+                           return (ConCase x1 x2 x3 x4)+                   1 -> do x1 <- get+                           x2 <- get+                           return (ConstCase x1 x2)+                   2 -> do x1 <- get+                           return (DefaultCase x1)+                   _ -> error "Corrupted binary data for CaseAlt"++ +instance Binary Def where+        put x+          = case x of+                Function x1 x2 -> do putWord8 0+                                     put x1+                                     put x2+                TyDecl x1 x2 -> do putWord8 1+                                   put x1+                                   put x2+                Operator x1 x2 x3 -> do putWord8 2+                                        put x1+                                        put x2+                                        put x3+                CaseOp x1 x2 x3 x4 x5 x6 x7 -> do putWord8 3+                                                  put x1+                                                  put x2+                                                  put x3+                                                  put x4+                                                  put x5+                                                  put x6+                                                  put x7+        get+          = do i <- getWord8+               case i of+                   0 -> do x1 <- get+                           x2 <- get+                           return (Function x1 x2)+                   1 -> do x1 <- get+                           x2 <- get+                           return (TyDecl x1 x2)+                   2 -> do x1 <- get+                           x2 <- get+                           x3 <- get+                           return (Operator x1 x2 x3)+                   3 -> do x1 <- get+                           x2 <- get+                           x3 <- get+                           x4 <- get+                           x5 <- get+                           x6 <- get+                           x7 <- get+                           return (CaseOp x1 x2 x3 x4 x5 x6 x7)+                   _ -> error "Corrupted binary data for Def"++instance Binary Accessibility where+        put x+          = case x of+                Public -> putWord8 0+                Frozen -> putWord8 1+                Hidden -> putWord8 2+        get+          = do i <- getWord8+               case i of+                   0 -> return Public+                   1 -> return Frozen+                   2 -> return Hidden+                   _ -> error "Corrupted binary data for Accessibility"++instance Binary IBCFile where+        put (IBCFile x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15 x16)+          = do put x1+               put x2+               put x3+               put x4+               put x5+               put x6+               put x7+               put x8+               put x9+               put x10+               put x11+               put x12+               put x13+               put x14+               put x15+               put x16+        get+          = do x1 <- get+               if x1 == ibcVersion then +                 do x2 <- get+                    x3 <- get+                    x4 <- get+                    x5 <- get+                    x6 <- get+                    x7 <- get+                    x8 <- get+                    x9 <- get+                    x10 <- get+                    x11 <- get+                    x12 <- get+                    x13 <- get+                    x14 <- get+                    x15 <- get+                    x16 <- get+                    return (IBCFile x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15 x16)+                  else return (initIBC { ver = x1 })+ +instance Binary Fixity where+        put x+          = case x of+                Infixl x1 -> do putWord8 0+                                put x1+                Infixr x1 -> do putWord8 1+                                put x1+                InfixN x1 -> do putWord8 2+                                put x1+                PrefixN x1 -> do putWord8 3+                                 put x1+        get+          = do i <- getWord8+               case i of+                   0 -> do x1 <- get+                           return (Infixl x1)+                   1 -> do x1 <- get+                           return (Infixr x1)+                   2 -> do x1 <- get+                           return (InfixN x1)+                   3 -> do x1 <- get+                           return (PrefixN x1)+                   _ -> error "Corrupted binary data for Fixity"++ +instance Binary FixDecl where+        put (Fix x1 x2)+          = do put x1+               put x2+        get+          = do x1 <- get+               x2 <- get+               return (Fix x1 x2)++ +instance Binary Static where+        put x+          = case x of+                Static -> putWord8 0+                Dynamic -> putWord8 1+        get+          = do i <- getWord8+               case i of+                   0 -> return Static+                   1 -> return Dynamic+                   _ -> error "Corrupted binary data for Static"++ +instance Binary Plicity where+        put x+          = case x of+                Imp x1 x2 -> do putWord8 0+                                put x1+                                put x2+                Exp x1 x2 -> do putWord8 1+                                put x1+                                put x2+                Constraint x1 x2 -> do putWord8 2+                                       put x1+                                       put x2+        get+          = do i <- getWord8+               case i of+                   0 -> do x1 <- get+                           x2 <- get+                           return (Imp x1 x2)+                   1 -> do x1 <- get+                           x2 <- get+                           return (Exp x1 x2)+                   2 -> do x1 <- get+                           x2 <- get+                           return (Constraint x1 x2)+                   _ -> error "Corrupted binary data for Plicity"++ +instance Binary PTerm where+        put x+          = case x of+                PQuote x1 -> do putWord8 0+                                put x1+                PRef x1 x2 -> do putWord8 1+                                 put x1+                                 put x2+                PLam x1 x2 x3 -> do putWord8 2+                                    put x1+                                    put x2+                                    put x3+                PPi x1 x2 x3 x4 -> do putWord8 3+                                      put x1+                                      put x2+                                      put x3+                                      put x4+                PLet x1 x2 x3 x4 -> do putWord8 4+                                       put x1+                                       put x2+                                       put x3+                                       put x4+                PApp x1 x2 x3 -> do putWord8 5+                                    put x1+                                    put x2+                                    put x3+                PTrue x1 -> do putWord8 6+                               put x1+                PFalse x1 -> do putWord8 7+                                put x1+                PRefl x1 -> do putWord8 8+                               put x1+                PResolveTC x1 -> do putWord8 9+                                    put x1+                PEq x1 x2 x3 -> do putWord8 10+                                   put x1+                                   put x2+                                   put x3+                PPair x1 x2 x3 -> do putWord8 11+                                     put x1+                                     put x2+                                     put x3+                PDPair x1 x2 x3 x4 -> do putWord8 12+                                         put x1+                                         put x2+                                         put x3+                                         put x4+                PAlternative x1 -> do putWord8 13+                                      put x1+                PHidden x1 -> do putWord8 14+                                 put x1+                PSet -> putWord8 15+                PConstant x1 -> do putWord8 16+                                   put x1+                Placeholder -> putWord8 17+                PDoBlock x1 -> do putWord8 18+                                  put x1+                PReturn x1 -> do putWord8 19+                                 put x1+                PMetavar x1 -> do putWord8 20+                                  put x1+                PProof x1 -> do putWord8 21+                                put x1+                PTactics x1 -> do putWord8 22+                                  put x1+                PElabError x1 -> do putWord8 23+                                    put x1+                PImpossible -> putWord8 24+        get+          = do i <- getWord8+               case i of+                   0 -> do x1 <- get+                           return (PQuote x1)+                   1 -> do x1 <- get+                           x2 <- get+                           return (PRef x1 x2)+                   2 -> do x1 <- get+                           x2 <- get+                           x3 <- get+                           return (PLam x1 x2 x3)+                   3 -> do x1 <- get+                           x2 <- get+                           x3 <- get+                           x4 <- get+                           return (PPi x1 x2 x3 x4)+                   4 -> do x1 <- get+                           x2 <- get+                           x3 <- get+                           x4 <- get+                           return (PLet x1 x2 x3 x4)+                   5 -> do x1 <- get+                           x2 <- get+                           x3 <- get+                           return (PApp x1 x2 x3)+                   6 -> do x1 <- get+                           return (PTrue x1)+                   7 -> do x1 <- get+                           return (PFalse x1)+                   8 -> do x1 <- get+                           return (PRefl x1)+                   9 -> do x1 <- get+                           return (PResolveTC x1)+                   10 -> do x1 <- get+                            x2 <- get+                            x3 <- get+                            return (PEq x1 x2 x3)+                   11 -> do x1 <- get+                            x2 <- get+                            x3 <- get+                            return (PPair x1 x2 x3)+                   12 -> do x1 <- get+                            x2 <- get+                            x3 <- get+                            x4 <- get+                            return (PDPair x1 x2 x3 x4)+                   13 -> do x1 <- get+                            return (PAlternative x1)+                   14 -> do x1 <- get+                            return (PHidden x1)+                   15 -> return PSet+                   16 -> do x1 <- get+                            return (PConstant x1)+                   17 -> return Placeholder+                   18 -> do x1 <- get+                            return (PDoBlock x1)+                   19 -> do x1 <- get+                            return (PReturn x1)+                   20 -> do x1 <- get+                            return (PMetavar x1)+                   21 -> do x1 <- get+                            return (PProof x1)+                   22 -> do x1 <- get+                            return (PTactics x1)+                   23 -> do x1 <- get+                            return (PElabError x1)+                   24 -> return PImpossible+                   _ -> error "Corrupted binary data for PTerm"++ +instance (Binary t) => Binary (PTactic' t) where+        put x+          = case x of+                Intro x1 -> do putWord8 0+                               put x1+                Focus x1 -> do putWord8 1+                               put x1+                Refine x1 x2 -> do putWord8 2+                                   put x1+                                   put x2+                Rewrite x1 -> do putWord8 3+                                 put x1+                LetTac x1 x2 -> do putWord8 4+                                   put x1+                                   put x2+                Exact x1 -> do putWord8 5+                               put x1+                Compute -> putWord8 6+                Trivial -> putWord8 7+                Solve -> putWord8 8+                Attack -> putWord8 9+                ProofState -> putWord8 10+                ProofTerm -> putWord8 11+                Undo -> putWord8 12+                Try x1 x2 -> do putWord8 13+                                put x1+                                put x2+                TSeq x1 x2 -> do putWord8 14+                                 put x1+                                 put x2+                Qed -> putWord8 15+        get+          = do i <- getWord8+               case i of+                   0 -> do x1 <- get+                           return (Intro x1)+                   1 -> do x1 <- get+                           return (Focus x1)+                   2 -> do x1 <- get+                           x2 <- get+                           return (Refine x1 x2)+                   3 -> do x1 <- get+                           return (Rewrite x1)+                   4 -> do x1 <- get+                           x2 <- get+                           return (LetTac x1 x2)+                   5 -> do x1 <- get+                           return (Exact x1)+                   6 -> return Compute+                   7 -> return Trivial+                   8 -> return Solve+                   9 -> return Attack+                   10 -> return ProofState+                   11 -> return ProofTerm+                   12 -> return Undo+                   13 -> do x1 <- get+                            x2 <- get+                            return (Try x1 x2)+                   14 -> do x1 <- get+                            x2 <- get+                            return (TSeq x1 x2)+                   15 -> return Qed+                   _ -> error "Corrupted binary data for PTactic'"+++instance (Binary t) => Binary (PDo' t) where+        put x+          = case x of+                DoExp x1 x2 -> do putWord8 0+                                  put x1+                                  put x2+                DoBind x1 x2 x3 -> do putWord8 1+                                      put x1+                                      put x2+                                      put x3+                DoBindP x1 x2 x3 -> do putWord8 2+                                       put x1+                                       put x2+                                       put x3+                DoLet x1 x2 x3 x4 -> do putWord8 3+                                        put x1+                                        put x2+                                        put x3+                                        put x4+                DoLetP x1 x2 x3 -> do putWord8 4+                                      put x1+                                      put x2+                                      put x3+        get+          = do i <- getWord8+               case i of+                   0 -> do x1 <- get+                           x2 <- get+                           return (DoExp x1 x2)+                   1 -> do x1 <- get+                           x2 <- get+                           x3 <- get+                           return (DoBind x1 x2 x3)+                   2 -> do x1 <- get+                           x2 <- get+                           x3 <- get+                           return (DoBindP x1 x2 x3)+                   3 -> do x1 <- get+                           x2 <- get+                           x3 <- get+                           x4 <- get+                           return (DoLet x1 x2 x3 x4)+                   4 -> do x1 <- get+                           x2 <- get+                           x3 <- get+                           return (DoLetP x1 x2 x3)+                   _ -> error "Corrupted binary data for PDo'"+++instance (Binary t) => Binary (PArg' t) where+        put x+          = case x of+                PImp x1 x2 x3 x4 -> do putWord8 0+                                       put x1+                                       put x2+                                       put x3+                                       put x4+                PExp x1 x2 x3 -> do putWord8 1+                                    put x1+                                    put x2+                                    put x3+                PConstraint x1 x2 x3 -> do putWord8 2+                                           put x1+                                           put x2+                                           put x3+        get+          = do i <- getWord8+               case i of+                   0 -> do x1 <- get+                           x2 <- get+                           x3 <- get+                           x4 <- get+                           return (PImp x1 x2 x3 x4)+                   1 -> do x1 <- get+                           x2 <- get+                           x3 <- get+                           return (PExp x1 x2 x3)+                   2 -> do x1 <- get+                           x2 <- get+                           x3 <- get+                           return (PConstraint x1 x2 x3)+                   _ -> error "Corrupted binary data for PArg'"++ +instance Binary ClassInfo where+        put (CI x1 x2 x3 x4)+          = do put x1+               put x2+               put x3+               put x4+        get+          = do x1 <- get+               x2 <- get+               x3 <- get+               x4 <- get+               return (CI x1 x2 x3 x4)++instance Binary OptInfo where+        put (Optimise x1 x2 x3)+          = do put x1+               put x2+               put x3+        get+          = do x1 <- get+               x2 <- get+               x3 <- get+               return (Optimise x1 x2 x3)++instance Binary TypeInfo where+        put (TI x1) = put x1+        get = do x1 <- get+                 return (TI x1)++instance Binary SynContext where+        put x+          = case x of+                PatternSyntax -> putWord8 0+                TermSyntax -> putWord8 1+                AnySyntax -> putWord8 2+        get+          = do i <- getWord8+               case i of+                   0 -> return PatternSyntax+                   1 -> return TermSyntax+                   2 -> return AnySyntax+                   _ -> error "Corrupted binary data for SynContext"++ +instance Binary Syntax where+        put (Rule x1 x2 x3)+          = do put x1+               put x2+               put x3+        get+          = do x1 <- get+               x2 <- get+               x3 <- get+               return (Rule x1 x2 x3)++ +instance Binary SSymbol where+        put x+          = case x of+                Keyword x1 -> do putWord8 0+                                 put x1+                Symbol x1 -> do putWord8 1+                                put x1+                Expr x1 -> do putWord8 2+                              put x1+        get+          = do i <- getWord8+               case i of+                   0 -> do x1 <- get+                           return (Keyword x1)+                   1 -> do x1 <- get+                           return (Symbol x1)+                   2 -> do x1 <- get+                           return (Expr x1)+                   _ -> error "Corrupted binary data for SSymbol"
+ src/Idris/Imports.hs view
@@ -0,0 +1,59 @@+module Idris.Imports where++import Idris.AbsSyntax++import Core.TT+import Paths_idris++import System.FilePath+import System.Directory+import Control.Monad.State++data IFileType = IDR FilePath | LIDR FilePath | IBC FilePath IFileType +    deriving Eq++srcPath :: FilePath -> FilePath+srcPath fp = let (n, ext) = splitExtension fp in+                 case ext of+                    ".idr" -> fp+                    _ -> fp ++ ".idr"++lsrcPath :: FilePath -> FilePath+lsrcPath fp = let (n, ext) = splitExtension fp in+                  case ext of+                     ".lidr" -> fp+                     _ -> fp ++ ".lidr"++-- Get name of byte compiled version of an import+ibcPath :: FilePath -> FilePath+ibcPath fp = let (n, ext) = splitExtension fp in+                 n ++ ".ibc"++findImport :: [FilePath] -> FilePath -> IO IFileType+findImport []     fp = fail $ "Can't find import " ++ fp+findImport (d:ds) fp = do let ibcp = ibcPath (d ++ "/" ++ fp)+                          let idrp = srcPath (d ++ "/" ++ fp)+                          let lidrp = lsrcPath (d ++ "/" ++ fp)+                          ibc  <- doesFileExist ibcp+                          idr  <- doesFileExist idrp+                          lidr <- doesFileExist lidrp+--                           when idr $ putStrLn $ idrp ++ " ok"+--                           when lidr $ putStrLn $ lidrp ++ " ok"+--                           when ibc $ putStrLn $ ibcp ++ " ok"+                          let isrc = if lidr then LIDR lidrp+                                             else IDR idrp+                          if ibc +                             then return (IBC ibcp isrc)+                             else if (idr || lidr) +                                     then return isrc+                                     else findImport ds fp++-- find a specific filename somewhere in a path++findInPath :: [FilePath] -> FilePath -> IO FilePath+findInPath [] fp = fail $ "Can't find file " ++ fp+findInPath (d:ds) fp = do let p = d ++ "/" ++ fp+                          e <- doesFileExist p+                          if e then return p else findInPath ds p++
+ src/Idris/Parser.hs view
@@ -0,0 +1,1219 @@+module Idris.Parser where++import Idris.AbsSyntax+import Idris.Imports+import Idris.Error+import Idris.ElabDecls+import Idris.ElabTerm+import Idris.IBC+import Idris.Unlit+import Paths_idris++import Core.CoreParser+import Core.TT+import Core.Evaluate++import Text.ParserCombinators.Parsec+import Text.ParserCombinators.Parsec.Error+import Text.ParserCombinators.Parsec.Expr+import Text.ParserCombinators.Parsec.Language+import qualified Text.ParserCombinators.Parsec.Token as PTok++import Data.List+import Control.Monad.State+import Debug.Trace+import Data.Maybe+import System.FilePath++type TokenParser a = PTok.TokenParser a++type IParser = GenParser Char IState++lexer :: TokenParser IState+lexer  = PTok.makeTokenParser idrisDef++whiteSpace= PTok.whiteSpace lexer+lexeme    = PTok.lexeme lexer+symbol    = PTok.symbol lexer+natural   = PTok.natural lexer+parens    = PTok.parens lexer+semi      = PTok.semi lexer+comma     = PTok.comma lexer+identifier= PTok.identifier lexer+reserved  = PTok.reserved lexer+operator  = PTok.operator lexer+reservedOp= PTok.reservedOp lexer+integer   = PTok.integer lexer+float     = PTok.float lexer+strlit    = PTok.stringLiteral lexer+chlit     = PTok.charLiteral lexer+lchar = lexeme.char++-- Loading modules++loadModule :: FilePath -> Idris String+loadModule f +   = idrisCatch (do datadir <- liftIO $ getDataDir+                    fp <- liftIO $ findImport [".", datadir] f+                    i <- getIState+                    if (f `elem` imported i)+                       then iLOG $ "Already read " ++ f+                       else do putIState (i { imported = f : imported i })+                               case fp of+                                   IDR fn  -> loadSource False fn+                                   LIDR fn -> loadSource True  fn+                                   IBC fn src -> +                                     idrisCatch (loadIBC fn)+                                                (\c -> do iLOG $ fn ++ " failed " ++ show c+                                                          case src of+                                                            IDR sfn -> loadSource False sfn+                                                            LIDR sfn -> loadSource True sfn)+                    let (dir, fh) = splitFileName f+                    return (dropExtension fh))+                (\e -> do let msg = show e+                          setErrLine (getErrLine msg)+                          iputStrLn msg+                          return "")++loadSource :: Bool -> FilePath -> Idris () +loadSource lidr f +             = do iLOG ("Reading " ++ f)+                  file_in <- liftIO $ readFile f+                  file <- if lidr then tclift $ unlit f file_in else return file_in+                  (mname, modules, rest, pos) <- parseImports f file+                  i <- getIState+                  putIState (i { default_access = Hidden })+                  mapM_ loadModule modules+                  clearIBC -- start a new .ibc file+                  mapM_ (\m -> addIBC (IBCImport m)) modules+                  ds' <- parseProg (defaultSyntax {syn_namespace = reverse mname }) +                                   f rest pos+                  let ds = namespaces mname ds'+                  logLvl 3 (dumpDecls ds)+                  i <- getIState+                  logLvl 10 (show (toAlist (idris_implicits i)))+                  logLvl 3 (show (idris_infixes i))+                  -- Now add all the declarations to the context+                  v <- verbose+                  when v $ iputStrLn $ "Type checking " ++ f+                  mapM_ (elabDecl toplevel) ds+                  iLOG ("Finished " ++ f)+                  let ibc = dropExtension f ++ ".ibc"+                  iucheck+                  i <- getIState+                  addHides (hide_list i)+                  ok <- noErrors+                  when ok $+                    idrisCatch (do writeIBC f ibc; clearIBC)+                               (\c -> return ()) -- failure is harmless+                  putIState (i { hide_list = [] })+                  return ()+  where+    namespaces []     ds = ds+    namespaces (x:xs) ds = [PNamespace x (namespaces xs ds)]++addHides :: [(Name, Maybe Accessibility)] -> Idris ()+addHides xs = do i <- getIState+                 let defh = default_access i+                 let (hs, as) = partition isNothing xs+                 if null as then return ()+                            else mapM_ doHide+                                    (map (\ (n, _) -> (n, defh)) hs +++                                     map (\ (n, Just a) -> (n, a)) as)+  where isNothing (_, Nothing) = True+        isNothing _            = False++        doHide (n, a) = do setAccessibility n a+                           addIBC (IBCAccess n a)++parseExpr i = runParser (pFullExpr defaultSyntax) i "(input)"+parseTac i = runParser (do t <- pTactic defaultSyntax+                           eof+                           return t) i "(proof)"++parseImports :: FilePath -> String -> Idris ([String], [String], String, SourcePos)+parseImports fname input +    = do i <- get+         case (runParser (do mname <- pHeader+                             ps <- many pImport+                             rest <- getInput+                             pos <- getPosition+                             return ((mname, ps, rest, pos), i)) i fname input) of+            Left err -> fail (ishow err)+            Right (x, i) -> do put i+                               return x+  where ishow err = let ln = sourceLine (errorPos err) in+                        fname ++ ":" ++ show ln ++ ":parse error"+--                           show (map messageString (errorMessages err))++pHeader :: IParser [String]+pHeader = try (do reserved "module"; i <- identifier; option ';' (lchar ';')+                  return (parseName i))+      <|> return []+  where parseName x = case span (/='.') x of+                            (x, "") -> [x]+                            (x, '.':y) -> x : parseName y++push_indent :: IParser ()+push_indent = do pos <- getPosition+                 ist <- getState+                 setState (ist { indent_stack = sourceColumn pos :+                                                indent_stack ist })++last_indent :: IParser Int+last_indent = do ist <- getState+                 case indent_stack ist of+                    (x : xs) -> return x+                    _ -> return 1++indent :: IParser Int+indent = do pos <- getPosition+            return (sourceColumn pos)++pop_indent :: IParser ()+pop_indent = do ist <- getState+                let (x : xs) = indent_stack ist+                setState (ist { indent_stack = xs })++open_block :: IParser ()+open_block = do lchar '{'+                ist <- getState+                setState (ist { brace_stack = Nothing : brace_stack ist })+         <|> do ist <- getState+                lvl <- indent+                setState (ist { brace_stack = Just lvl : brace_stack ist })++close_block :: IParser ()+close_block = do ist <- getState+                 bs <- case brace_stack ist of+                         Nothing : xs -> do lchar '}'+                                            return xs+                         Just lvl : xs -> do i <- indent+                                             inp <- getInput+--                                              trace (show (take 10 inp, i, lvl)) $+                                             if (i >= lvl && take 1 inp /= ")") +                                                then fail "Not end of block"+                                                else return xs+                 setState (ist { brace_stack = bs })++pTerminator = do lchar ';'; pop_indent+          <|> do c <- indent; l <- last_indent+                 if (c <= l) then pop_indent+                             else fail "Not a terminator"+          <|> do i <- getInput; if (take 1 i == "}" || take 1 i == ")") then pop_indent +                                                     else fail "Not a terminator"+          <|> lookAhead eof++pBarTerminator +            = do lchar '|'; return ()+          <|> do c <- indent; l <- last_indent+                 if (c <= l) then return ()+                             else fail "Not a terminator"+          <|> lookAhead eof++pKeepTerminator +            = do lchar ';'; return ()+          <|> do c <- indent; l <- last_indent+                 if (c <= l) then return ()+                             else fail "Not a terminator"+          <|> do i <- getInput; let h = take 1 i+                 if (h == "}" || h == ")" || h == "|") then return ()+                                           else fail "Not a terminator"+          <|> lookAhead eof++notEndApp = do c <- indent; l <- last_indent+               i <- getInput+               if (c <= l) then fail "Terminator"+                           else return ()++notEndBlock = do ist <- getState+                 case brace_stack ist of+                    Just lvl : xs -> do i <- indent+                                        inp <- getInput+                                        if (i < lvl || take 1 inp == ")")+                                                     then fail "End of block"+                                                     else return ()+                    _ -> return ()++pfc :: IParser FC+pfc = do s <- getPosition+         let (dir, file) = splitFileName (sourceName s)+         let f = case dir of+                    "./" -> file+                    _ -> sourceName s+         return $ FC f (sourceLine s)++pImport :: IParser String+pImport = do reserved "import"+             f <- identifier+             option ';' (lchar ';')+             return (map dot f)+  where dot '.' = '/'+        dot c = c++parseProg :: SyntaxInfo -> FilePath -> String -> SourcePos -> Idris [PDecl]+parseProg syn fname input pos+    = do i <- get+         case (runParser (do setPosition pos+                             whiteSpace+                             ps <- many (pDecl syn)+                             eof+                             i' <- getState+                             return (concat ps, i')) i fname input) of+            Left err -> fail (ishow err)+            Right (x, i) -> do put i+                               return (collect x)+  where ishow err = let ln = sourceLine (errorPos err) in+                        fname ++ ":" ++ show ln ++ ":parse error"+                              ++ " at column " ++ show (sourceColumn (errorPos err))+--                           show (map messageString (errorMessages err))++-- Collect PClauses with the same function name++collect :: [PDecl] -> [PDecl]+collect (c@(PClauses _ o _ _) : ds) +    = clauses (cname c) [] (c : ds)+  where clauses n acc (PClauses fc _ _ [PClause n' l ws r w] : ds)+           | n == n' = clauses n (PClause n' l ws r (collect w) : acc) ds+        clauses n acc (PClauses fc _ _ [PWith   n' l ws r w] : ds)+           | n == n' = clauses n (PWith n' l ws r (collect w) : acc) ds+        clauses n acc xs = PClauses (getfc c) o n (reverse acc) : collect xs++        cname (PClauses fc _ _ [PClause n _ _ _ _]) = n+        cname (PClauses fc _ _ [PWith   n _ _ _ _]) = n+        getfc (PClauses fc _ _ _) = fc++collect (PParams f ns ps : ds) = PParams f ns (collect ps) : collect ds+collect (PNamespace ns ps : ds) = PNamespace ns (collect ps) : collect ds+collect (PClass f s cs n ps ds : ds') = PClass f s cs n ps (collect ds) : collect ds'+collect (PInstance f s cs n ps t ds : ds') +    = PInstance f s cs n ps t (collect ds) : collect ds'+collect (d : ds) = d : collect ds+collect [] = []++pFullExpr :: SyntaxInfo -> IParser PTerm+pFullExpr syn +          = do x <- pExpr syn; eof;+               i <- getState+               return $ desugar syn i x++pDecl :: SyntaxInfo -> IParser [PDecl]+pDecl syn = do notEndBlock+               pDeclBody where+  pDeclBody+      = do d <- pDecl' syn+           i <- getState+           let d' = fmap (desugar syn i) d+           return [d']+    <|> pUsing syn+    <|> pParams syn+    <|> pNamespace syn+    <|> pClass syn+    <|> pInstance syn+    <|> pDirective+    <|> try (do reserved "import"+                fp <- identifier+                lchar ';'+                fail "imports must be at the top of file") ++pFunDecl :: SyntaxInfo -> IParser [PDecl]+pFunDecl syn+      = try (do notEndBlock+                d <- pFunDecl' syn+                i <- getState+                let d' = fmap (desugar syn i) d+                return [d'])++--------- Top Level Declarations ---------++pDecl' :: SyntaxInfo -> IParser PDecl+pDecl' syn+       = try pFixity+     <|> pFunDecl' syn+     <|> try (pData syn)+     <|> pSyntaxDecl syn++pSyntaxDecl :: SyntaxInfo -> IParser PDecl+pSyntaxDecl syn+    = do s <- pSyntaxRule syn+         i <- getState+         let rs = syntax_rules i+         let ns = syntax_keywords i+         let ibc = ibc_write i+         let ks = map show (names s)+         setState (i { syntax_rules = s : rs,+                       syntax_keywords = ks ++ ns,+                       ibc_write = IBCSyntax s : map IBCKeyword ks ++ ibc+                     })+         fc <- pfc+         return (PSyntax fc s)+  where+    names (Rule syms _ _) = mapMaybe ename syms+    ename (Keyword n) = Just n+    ename _ = Nothing++pSyntaxRule :: SyntaxInfo -> IParser Syntax+pSyntaxRule syn +    = do push_indent+         sty <- option AnySyntax (do reserved "term"; return TermSyntax+                                  <|> do reserved "pattern"; return PatternSyntax)+         reserved "syntax"+         syms <- many1 pSynSym+         when (all expr syms) $ fail "No keywords in syntax rule"+         let ns = mapMaybe name syms+         when (length ns /= length (nub ns)) +            $ fail "Repeated variable in syntax rule"+         lchar '='+         tm <- pExpr syn+         pTerminator+         return (Rule syms tm sty)+  where+    expr (Expr _) = True+    expr _ = False+    name (Expr n) = Just n+    name _ = Nothing++pSynSym :: IParser SSymbol+pSynSym = try (do lchar '['; n <- pName; lchar ']'+                  return (Expr n))+      <|> do n <- iName []+             return (Keyword n)+      <|> do sym <- strlit+             return (Symbol sym)++pFunDecl' :: SyntaxInfo -> IParser PDecl+pFunDecl' syn = try (do push_indent+                        acc <- pAccessibility+                        n_in <- pfName+                        let n = expandNS syn n_in+                        ty <- pTSig syn+                        fc <- pfc+                        pTerminator +--                         ty' <- implicit syn n ty+                        addAcc n acc+                        return (PTy syn fc n ty))+            <|> try (pPattern syn)++pUsing :: SyntaxInfo -> IParser [PDecl]+pUsing syn = +    do reserved "using"; +       lchar '('+       ns <- tyDeclList syn+       lchar ')'+       open_block+       let uvars = using syn+       ds <- many1 (pDecl (syn { using = uvars ++ ns }))+       close_block+       return (concat ds)++pParams :: SyntaxInfo -> IParser [PDecl]+pParams syn = +    do reserved "params"; +       lchar '('+       ns <- tyDeclList syn+       lchar ')'+       lchar '{'+       let pvars = syn_params syn+       ds <- many1 (pDecl syn { syn_params = pvars ++ ns })+       lchar '}'+       fc <- pfc+       return [PParams fc ns (concat ds)]++pNamespace :: SyntaxInfo -> IParser [PDecl]+pNamespace syn =+    do reserved "namespace";+       n <- identifier+       open_block +       ds <- many1 (pDecl syn { syn_namespace = n : syn_namespace syn })+       close_block+       return [PNamespace n (concat ds)] ++expandNS :: SyntaxInfo -> Name -> Name+expandNS syn n@(NS _ _) = n+expandNS syn n = case syn_namespace syn of+                        [] -> n+                        xs -> NS n xs++--------- Fixity ---------++pFixity :: IParser PDecl+pFixity = do push_indent+             f <- fixity; i <- natural; ops <- sepBy1 operator (lchar ',')+             pTerminator +             let prec = fromInteger i+             istate <- getState+             let fs = map (Fix (f prec)) ops+             setState (istate { +                idris_infixes = sort (fs ++ idris_infixes istate),+                ibc_write = map IBCFix fs ++ ibc_write istate })+             fc <- pfc+             return (PFix fc (f prec) ops)++fixity :: IParser (Int -> Fixity) +fixity = try (do reserved "infixl"; return Infixl)+     <|> try (do reserved "infixr"; return Infixr)+     <|> try (do reserved "infix";  return InfixN)+     <|> try (do reserved "prefix"; return PrefixN)++--------- Tyoe classes ---------++pClass :: SyntaxInfo -> IParser [PDecl]+pClass syn = do acc <- pAccessibility+                reserved "class"+                fc <- pfc+                cons <- pConstList syn+                n_in <- pName; let n = expandNS syn n_in+                cs <- many1 carg+                reserved "where"; open_block +                ds <- many1 $ pFunDecl syn+                close_block+                let allDs = concat ds+                accData acc n (concatMap declared allDs)+                return [PClass syn fc cons n cs allDs]+  where+    carg = do lchar '('; i <- pName; lchar ':'; ty <- pExpr syn; lchar ')'+              return (i, ty)+       <|> do i <- pName;+              return (i, PSet)++pInstance :: SyntaxInfo -> IParser [PDecl]+pInstance syn = do reserved "instance"+                   fc <- pfc+                   cs <- pConstList syn+                   cn <- pName+                   args <- many1 (pSimpleExpr syn)+                   let sc = PApp fc (PRef fc cn) (map pexp args)+                   let t = bindList (PPi constraint) (map (\x -> (MN 0 "c", x)) cs) sc+                   reserved "where"; open_block +                   ds <- many1 $ pFunDecl syn+                   close_block+                   return [PInstance syn fc cs cn args t (concat ds)]++--------- Expressions ---------++pExpr syn = do i <- getState+               buildExpressionParser (table (idris_infixes i)) (pExpr' syn)++pExpr' :: SyntaxInfo -> IParser PTerm+pExpr' syn +       = try (pExtExpr syn)+     <|> pNoExtExpr syn++pExtExpr :: SyntaxInfo -> IParser PTerm+pExtExpr syn = do i <- getState+                  pExtensions syn (syntax_rules i)++pSimpleExtExpr :: SyntaxInfo -> IParser PTerm+pSimpleExtExpr syn = do i <- getState+                        pExtensions syn (filter simple (syntax_rules i))+  where+    simple (Rule (Expr x:xs) _ _) = False+    simple (Rule [Keyword _] _ _) = True+    simple (Rule [Symbol _]  _ _) = True+    simple (Rule (_:xs) _ _) = case (last xs) of+        Keyword _ -> True+        Symbol _  -> True+        _ -> False+    simple _ = False++pNoExtExpr syn =+         try (pApp syn) +     <|> try (pSimpleExpr syn)+     <|> pLambda syn+     <|> pLet syn+     <|> pPi syn +     <|> pDoBlock syn+     <|> pComprehension syn+    +pExtensions :: SyntaxInfo -> [Syntax] -> IParser PTerm+pExtensions syn rules = choice (map (\x -> try (pExt syn x)) (filter valid rules))+  where+    valid (Rule _ _ AnySyntax) = True+    valid (Rule _ _ PatternSyntax) = inPattern syn+    valid (Rule _ _ TermSyntax) = not (inPattern syn)+++pExt :: SyntaxInfo -> Syntax -> IParser PTerm+pExt syn (Rule (s:ssym) ptm _)+    = do s1 <- pSymbol pSimpleExpr s +         smap <- mapM (pSymbol pExpr) ssym+         let ns = mapMaybe id (s1:smap)+         return (update ns ptm) -- updated with smap+  where+    pSymbol p (Keyword n) = do reserved (show n); return Nothing+    pSymbol p (Expr n)    = do tm <- p syn+                               return $ Just (n, tm)+    pSymbol p (Symbol s)  = do symbol s+                               return Nothing+    dropn n [] = []+    dropn n ((x,t) : xs) | n == x = xs+                         | otherwise = (x,t):dropn n xs++    update ns (PRef fc n) = case lookup n ns of+                              Just t -> t+                              _ -> PRef fc n+    update ns (PLam n ty sc) = PLam n (update ns ty) (update (dropn n ns) sc)+    update ns (PPi p n ty sc) = PPi p n (update ns ty) (update (dropn n ns) sc) +    update ns (PLet n ty val sc) = PLet n (update ns ty) (update ns val)+                                          (update (dropn n ns) sc)+    update ns (PApp fc t args) = PApp fc (update ns t) (map (fmap (update ns)) args)+    update ns (PCase fc c opts) = PCase fc (update ns c) (map (pmap (update ns)) opts) +    update ns (PPair fc l r) = PPair fc (update ns l) (update ns r)+    update ns (PDPair fc l t r) = PDPair fc (update ns l) (update ns t) (update ns r)+    update ns (PAlternative as) = PAlternative (map (update ns) as)+    update ns (PHidden t) = PHidden (update ns t)+    update ns (PDoBlock ds) = PDoBlock $ upd ns ds+      where upd ns (DoExp fc t : ds) = DoExp fc (update ns t) : upd ns ds+            upd ns (DoBind fc n t : ds) = DoBind fc n (update ns t) : upd (dropn n ns) ds+            upd ns (DoLet fc n ty t : ds) = DoLet fc n (update ns ty) (update ns t) +                                                : upd (dropn n ns) ds+            upd ns (DoBindP fc i t : ds) = DoBindP fc (update ns i) (update ns t) +                                                : upd ns ds+            upd ns (DoLetP fc i t : ds) = DoLetP fc (update ns i) (update ns t) +                                                : upd ns ds+    update ns t = t++pName = do i <- getState+           iName (syntax_keywords i)+    <|> do reserved "instance"+           i <- getState+           UN n <- iName (syntax_keywords i)+           return (UN ('@':n))+    ++pfName = try pName+     <|> do lchar '('; o <- operator; lchar ')'; return (UN o)++pAccessibility' :: IParser Accessibility+pAccessibility'+        = do reserved "public";   return Public+      <|> do reserved "abstract"; return Frozen+      <|> do reserved "private";  return Hidden++pAccessibility :: IParser (Maybe Accessibility)+pAccessibility+        = do acc <- pAccessibility'; return (Just acc)+      <|> return Nothing++addAcc :: Name -> Maybe Accessibility -> IParser ()+addAcc n a = do i <- getState+                setState (i { hide_list = (n, a) : hide_list i })++pSimpleExpr syn = +        try (do symbol "!["; t <- pTerm; lchar ']' +                return $ PQuote t)+        <|> do lchar '?'; x <- pName; return (PMetavar x)+        <|> do reserved "refl"; fc <- pfc; return (PRefl fc)+--         <|> do reserved "return"; fc <- pfc; return (PReturn fc)+        <|> do reserved "proof"; lchar '{';+               ts <- endBy (pTactic syn) (lchar ';')+               lchar '}'+               return (PProof ts)+        <|> do reserved "tactics"; lchar '{';+               ts <- endBy (pTactic syn) (lchar ';')+               lchar '}'+               return (PTactics ts)+        <|> do reserved "case"; fc <- pfc; scr <- pExpr syn; reserved "of";+               open_block +               push_indent+               opts <- many1 (do notEndBlock+                                 x <- pCaseOpt syn+                                 pKeepTerminator+                                 return x) -- sepBy1 (pCaseOpt syn) (lchar '|')+               pop_indent+               close_block+               return (PCase fc scr opts)+        <|> try (do x <- pfName; fc <- pfc; return (PRef fc x))+        <|> try (pList syn)+        <|> try (pAlt syn)+        <|> try (pIdiom syn)+        <|> try (do lchar '('; bracketed syn)+        <|> try (do c <- pConstant; fc <- pfc+                    return (modifyConst syn fc (PConstant c)))+        <|> do reserved "Set"; return PSet+        <|> try (do symbol "()"; fc <- pfc; return (PTrue fc))+        <|> try (do symbol "_|_"; fc <- pfc; return (PFalse fc))+        <|> do lchar '_'; return Placeholder+        <|> pSimpleExtExpr syn++bracketed syn =+            try (pPair syn)+        <|> try (do e <- pExpr syn; lchar ')'; return e)+        <|> try (do fc <- pfc; o <- operator; e <- pExpr syn; lchar ')'+                    return $ PLam (MN 0 "x") Placeholder+                                  (PApp fc (PRef fc (UN o)) [pexp (PRef fc (MN 0 "x")), +                                                             pexp e]))+        <|> try (do fc <- pfc; e <- pSimpleExpr syn; o <- operator; lchar ')'+                    return $ PLam (MN 0 "x") Placeholder+                                  (PApp fc (PRef fc (UN o)) [pexp e,+                                                             pexp (PRef fc (MN 0 "x"))]))++pCaseOpt :: SyntaxInfo -> IParser (PTerm, PTerm)+pCaseOpt syn = do lhs <- pExpr syn; symbol "=>";+                  rhs <- pExpr syn+                  return (lhs, rhs)++modifyConst :: SyntaxInfo -> FC -> PTerm -> PTerm+modifyConst syn fc (PConstant (I x)) +    | not (inPattern syn)+        = PApp fc (PRef fc (UN "fromInteger")) [pexp (PConstant (I x))]+modifyConst syn fc x = x++pList syn = do lchar '['; fc <- pfc+               xs <- sepBy (pExpr syn) (lchar ','); lchar ']'+               return (mkList fc xs)+  where+    mkList fc [] = PRef fc (UN "Nil")+    mkList fc (x : xs) = PApp fc (PRef fc (UN "::")) [pexp x, pexp (mkList fc xs)] ++pPair syn = try (do l <- pExpr syn +                    fc <- pfc+                    rest <- restTuple +                    case rest of+                        [] -> return l+                        [Left r] -> return (PPair fc l r)+                        [Right r] -> return (PDPair fc l Placeholder r))+        <|> try (do x <- ntuple+                    lchar ')'+                    return x) +        <|> do ln <- pName; lchar ':'; lty <- pExpr syn;+               reservedOp "**";+               fc <- pfc+               r <- pExpr syn; lchar ')';+               return (PDPair fc (PRef fc ln) lty r) +  where+    restTuple = do lchar ')'; return []+            <|> do lchar ','+                   r <- pExpr syn+                   lchar ')'+                   return [Left r]+            <|> do reservedOp "**"+                   r <- pExpr syn+                   lchar ')'+                   return [Right r]+    ntuple = try (do l <- pExpr syn; fc <- pfc; lchar ','+                     rest <- ntuple+                     return (PPair fc l rest))+             <|> (do l <- pExpr syn; fc <- pfc; lchar ','+                     r <- pExpr syn+                     return (PPair fc l r))+       +pAlt syn = do symbol "(|"; +              alts <- sepBy1 (pExpr' syn) (lchar ',')+              symbol "|)"+              return (PAlternative alts)++pHSimpleExpr syn+             = do lchar '.'+                  e <- pSimpleExpr syn+                  return $ PHidden e+           <|> pSimpleExpr syn++pApp syn = do f <- pSimpleExpr syn+              fc <- pfc+              args <- many1 (do notEndApp+                                pArg syn)+              return (PApp fc f args)++pArg :: SyntaxInfo -> IParser PArg+pArg syn = try (pImplicitArg syn)+       <|> try (pConstraintArg syn)+       <|> do e <- pSimpleExpr syn+              return (pexp e)++pImplicitArg syn = do lchar '{'; n <- pName+                      fc <- pfc+                      v <- option (PRef fc n) (do lchar '='; pExpr syn)+                      lchar '}'+                      return (pimp n v)++pConstraintArg syn = do symbol "@{"; e <- pExpr syn; symbol "}"+                        return (pconst e)++pTSig syn = do lchar ':'+               cs <- pConstList syn+               sc <- pExpr syn+               return (bindList (PPi constraint) (map (\x -> (MN 0 "c", x)) cs) sc)++pLambda syn = do lchar '\\'+                 (try (do xt <- tyOptDeclList syn+                          symbol "=>"+                          sc <- pExpr syn+                          return (bindList PLam xt sc))+                  <|> (do ps <- sepBy (do fc <- pfc+                                          e <- pSimpleExpr syn+                                          return (fc, e)) (lchar ',')+                          symbol "=>"+                          sc <- pExpr syn+                          return (pmList (zip [0..] ps) sc)))+    where pmList [] sc = sc+          pmList ((i, (fc, x)) : xs) sc +                = PLam (MN i "lamp") Placeholder+                        (PCase fc (PRef fc (MN i "lamp"))+                                [(x, (pmList xs sc))])++pLet syn = try (do reserved "let"; n <- pName; +                   ty <- option Placeholder (do lchar ':'; pExpr' syn)+                   lchar '='; v <- pExpr syn+                   reserved "in";  sc <- pExpr syn+                   return (PLet n ty v sc))+           <|> (do reserved "let"; fc <- pfc; pat <- pExpr' syn+                   symbol "="; v <- pExpr syn+                   reserved "in"; sc <- pExpr syn+                   return (PCase fc v [(pat, sc)]))++pPi syn = +     try (do lazy <- option False (do lchar '|'; return True)+             st <- pStatic+             lchar '('; xt <- tyDeclList syn; lchar ')'+             symbol "->"+             sc <- pExpr syn+             return (bindList (PPi (Exp lazy st)) xt sc))+ <|> try (do lazy <- option False (do lchar '|'; return True)+             st <- pStatic+             lchar '{'; xt <- tyDeclList syn; lchar '}'+             symbol "->"+             sc <- pExpr syn+             return (bindList (PPi (Imp lazy st)) xt sc))+      <|> do --lazy <- option False (do lchar '|'; return True)+             lchar '{'; reserved "static"; lchar '}'+             t <- pExpr' syn+             symbol "->"+             sc <- pExpr syn+             return (PPi (Exp False Static) (MN 42 "__pi_arg") t sc)++pConstList :: SyntaxInfo -> IParser [PTerm]+pConstList syn = try (do lchar '(' +                         tys <- sepBy1 (pExpr' syn) (lchar ',')+                         lchar ')'+                         reservedOp "=>"+                         return tys)+             <|> try (do t <- pExpr syn+                         reservedOp "=>"+                         return [t])+             <|> return []++tyDeclList syn = try (sepBy1 (do x <- pfName; t <- pTSig syn; return (x,t))+                         (lchar ','))+             <|> do ns <- sepBy1 pName (lchar ',')+                    t <- pTSig syn+                    return (map (\x -> (x, t)) ns)++tyOptDeclList syn = sepBy1 (do x <- pfName; +                               t <- option Placeholder (do lchar ':'+                                                           pExpr syn) +                               return (x,t))+                           (lchar ',')++bindList b []          sc = sc+bindList b ((n, t):bs) sc = b n t (bindList b bs sc)++pComprehension syn+    = do lchar '['; fc <- pfc; pat <- pExpr syn; lchar '|';+         qs <- sepBy1 (pDo syn) (lchar ','); lchar ']';+         return (PDoBlock (map addGuard qs ++ +                    [DoExp fc (PApp fc (PRef fc (UN "return"))+                                 [pexp pat])]))+    where addGuard (DoExp fc e) = DoExp fc (PApp fc (PRef fc (UN "guard"))+                                                    [pexp e])+          addGuard x = x++pDoBlock syn +    = do reserved "do"; open_block+         push_indent+         ds <- many1 (do notEndBlock+                         x <- pDo syn; pKeepTerminator; return x)+         pop_indent+         close_block+         return (PDoBlock ds)++pDo syn+     = try (do reserved "let"; i <- pName; +               ty <- option Placeholder (do lchar ':'; pExpr' syn)+               reservedOp "="; fc <- pfc+               e <- pExpr syn+               return (DoLet fc i ty e))+   <|> try (do reserved "let"; i <- pExpr' syn; reservedOp "="; fc <- pfc+               sc <- pExpr syn+               return (DoLetP fc i sc))+   <|> try (do i <- pName; symbol "<-"; fc <- pfc+               e <- pExpr syn;+               return (DoBind fc i e))+   <|> try (do i <- pExpr' syn; symbol "<-"; fc <- pfc+               e <- pExpr syn;+               return (DoBindP fc i e))+   <|> try (do e <- pExpr syn; fc <- pfc+               return (DoExp fc e))++pIdiom syn+    = do symbol "[|"; fc <- pfc; e <- pExpr syn; symbol "|]"+         return (PIdiom fc e)++pConstant :: IParser Const+pConstant = do reserved "Integer";return BIType+        <|> do reserved "Int";    return IType+        <|> do reserved "Char";   return ChType+        <|> do reserved "Float";  return FlType+        <|> do reserved "String"; return StrType+        <|> do reserved "Ptr";    return PtrType+        <|> try (do f <- float;   return $ Fl f)+        <|> try (do i <- natural; lchar 'L'; return $ BI i)+        <|> try (do i <- natural; return $ I (fromInteger i))+        <|> try (do s <- strlit;  return $ Str s)+        <|> try (do c <- chlit;   return $ Ch c)++pStatic :: IParser Static+pStatic = do lchar '['; reserved "static"; lchar ']';+             return Static+         <|> return Dynamic++table fixes +   = [[prefix "-" (\fc x -> PApp fc (PRef fc (UN "-")) +        [pexp (PApp fc (PRef fc (UN "fromInteger")) [pexp (PConstant (I 0))]), pexp x])]] +       ++ toTable (reverse fixes) +++      [[binary "="  (\fc x y -> PEq fc x y) AssocLeft],+       [binary "->" (\fc x y -> PPi expl (MN 42 "__pi_arg") x y) AssocRight]]++toTable fs = map (map toBin) +                 (groupBy (\ (Fix x _) (Fix y _) -> prec x == prec y) fs)+   where toBin (Fix (PrefixN _) op) = prefix op +                                       (\fc x -> PApp fc (PRef fc (UN op)) [pexp x])+         toBin (Fix f op) +            = binary op (\fc x y -> PApp fc (PRef fc (UN op)) [pexp x,pexp y]) (assoc f)+         assoc (Infixl _) = AssocLeft+         assoc (Infixr _) = AssocRight+         assoc (InfixN _) = AssocNone++binary name f assoc = Infix (do { reservedOp name; fc <- pfc; +                                  return (f fc) }) assoc+prefix name f = Prefix (do { reservedOp name; fc <- pfc;+                             return (f fc) })++--------- Data declarations ---------++-- (works for classes too - 'abstract' means the data/class is visible but members not)+accData :: Maybe Accessibility -> Name -> [Name] -> IParser ()+accData (Just Frozen) n ns = do addAcc n (Just Frozen)+                                mapM_ (\n -> addAcc n (Just Hidden)) ns+accData a n ns = do addAcc n a; mapM_ (\n -> addAcc n a) ns++pData :: SyntaxInfo -> IParser PDecl+pData syn = try (do acc <- pAccessibility+                    reserved "data"; fc <- pfc+                    tyn_in <- pfName; ty <- pTSig syn+                    let tyn = expandNS syn tyn_in+                    reserved "where"+                    open_block+                    push_indent+                    cons <- many (do notEndBlock+                                     c <- pConstructor syn+                                     pKeepTerminator+                                     return c) -- (lchar '|')+                    pop_indent+                    close_block +                    accData acc tyn (map (\ (n, _, _) -> n) cons)+                    return $ PData syn fc (PDatadecl tyn ty cons))+        <|> try (do push_indent+                    acc <- pAccessibility+                    reserved "data"; fc <- pfc+                    tyn_in <- pfName; args <- many pName+                    let tyn = expandNS syn tyn_in+                    lchar '='+                    cons <- sepBy1 (pSimpleCon syn) (lchar '|')+                    pTerminator+                    let conty = mkPApp fc (PRef fc tyn) (map (PRef fc) args)+                    let ty = bindArgs (map (\a -> PSet) args) PSet+                    cons' <- mapM (\ (x, cargs, cfc) -> +                                 do let cty = bindArgs cargs conty+                                    return (x, cty, cfc)) cons+                    accData acc tyn (map (\ (n, _, _) -> n) cons')+                    return $ PData syn fc (PDatadecl tyn ty cons'))+  where+    mkPApp fc t [] = t+    mkPApp fc t xs = PApp fc t (map pexp xs)++bindArgs :: [PTerm] -> PTerm -> PTerm+bindArgs [] t = t+bindArgs (x:xs) t = PPi expl (MN 0 "t") x (bindArgs xs t)++pConstructor :: SyntaxInfo -> IParser (Name, PTerm, FC)+pConstructor syn+    = do cn_in <- pfName; fc <- pfc+         let cn = expandNS syn cn_in+         ty <- pTSig syn+--          ty' <- implicit syn cn ty+         return (cn, ty, fc)++pSimpleCon :: SyntaxInfo -> IParser (Name, [PTerm], FC)+pSimpleCon syn +     = do cn_in <- pfName+          let cn = expandNS syn cn_in+          fc <- pfc+          args <- many (do notEndApp+                           pSimpleExpr syn)+          return (cn, args, fc)++--------- Pattern match clauses ---------++pPattern :: SyntaxInfo -> IParser PDecl+pPattern syn = do clause <- pClause syn+                  fc <- pfc+                  return (PClauses fc [] (MN 2 "_") [clause]) -- collect together later++pArgExpr syn = let syn' = syn { inPattern = True } in+                   try (pHSimpleExpr syn') <|> pSimpleExtExpr syn'++pRHS :: SyntaxInfo -> Name -> IParser PTerm+pRHS syn n = do lchar '='; pExpr syn+         <|> do symbol "?="; rhs <- pExpr syn;+                return (PLet (UN "value") Placeholder rhs (PMetavar n')) +         <|> do reserved "impossible"; return PImpossible+  where mkN (UN x)   = UN (x++"_lemma_1")+        mkN (NS x n) = NS (mkN x) n+        n' = mkN n++pClause :: SyntaxInfo -> IParser PClause+pClause syn+         = try (do push_indent+                   n_in <- pfName; let n = expandNS syn n_in+                   cargs <- many (pConstraintArg syn)+                   iargs <- many (pImplicitArg syn)+                   fc <- pfc+                   args <- many (pArgExpr syn)+                   wargs <- many (pWExpr syn)+                   rhs <- pRHS syn n+                   ist <- getState+                   let ctxt = tt_ctxt ist+                   let wsyn = syn { syn_namespace = [] }+                   (wheres, nmap) <- choice [do x <- pWhereblock n wsyn+                                                pop_indent+                                                return x, +                                             do pTerminator+                                                return ([], [])]+                   let capp = PApp fc (PRef fc n) +                                (iargs ++ cargs ++ map pexp args)+                   ist <- getState+                   setState (ist { lastParse = Just n })+                   return $ PClause n capp wargs rhs wheres)+       <|> try (do push_indent+                   wargs <- many1 (pWExpr syn)+                   ist <- getState+                   n <- case lastParse ist of+                             Just t -> return t+                             Nothing -> fail "Invalid clause"+                   rhs <- pRHS syn n+                   let ctxt = tt_ctxt ist+                   let wsyn = syn { syn_namespace = [] }+                   (wheres, nmap) <- choice [do x <- pWhereblock n wsyn+                                                pop_indent+                                                return x, +                                             do pTerminator+                                                return ([], [])]+                   return $ PClauseR wargs rhs wheres)++       <|> try (do push_indent+                   n_in <- pfName; let n = expandNS syn n_in+                   cargs <- many (pConstraintArg syn)+                   iargs <- many (pImplicitArg syn)+                   fc <- pfc+                   args <- many (pArgExpr syn)+                   wargs <- many (pWExpr syn)+                   let capp = PApp fc (PRef fc n) +                                (iargs ++ cargs ++ map pexp args)+                   reserved "with"+                   wval <- pSimpleExpr syn+                   open_block+                   ds <- many1 $ pFunDecl syn+                   let withs = map (fillLHSD n capp wargs) $ concat ds+                   close_block+                   ist <- getState+                   setState (ist { lastParse = Just n })+                   pop_indent+                   return $ PWith n capp wargs wval withs)++       <|> try (do wargs <- many1 (pWExpr syn)+                   reserved "with"+                   wval <- pSimpleExpr syn+                   open_block+                   ds <- many1 $ pFunDecl syn+                   let withs = concat ds+                   close_block+                   return $ PWithR wargs wval withs)++       <|> do push_indent+              l <- pArgExpr syn+              op <- operator+              let n = expandNS syn (UN op)+              r <- pArgExpr syn+              fc <- pfc+              wargs <- many (pWExpr syn)+              rhs <- pRHS syn n+              let wsyn = syn { syn_namespace = [] }+              (wheres, nmap) <- choice [do x <- pWhereblock n wsyn+                                           pop_indent+                                           return x, +                                        do pTerminator+                                           return ([], [])]+              ist <- getState+              let capp = PApp fc (PRef fc n) [pexp l, pexp r]+              setState (ist { lastParse = Just n })+              return $ PClause n capp wargs rhs wheres++       <|> do l <- pArgExpr syn+              op <- operator+              let n = expandNS syn (UN op)+              r <- pArgExpr syn+              fc <- pfc+              wargs <- many (pWExpr syn)+              reserved "with"+              wval <- pSimpleExpr syn+              open_block +              ds <- many1 $ pFunDecl syn+              close_block+              ist <- getState+              let capp = PApp fc (PRef fc n) [pexp l, pexp r]+              let withs = map (fillLHSD n capp wargs) $ concat ds+              setState (ist { lastParse = Just n })+              return $ PWith n capp wargs wval withs+  where+    fillLHS n capp owargs (PClauseR wargs v ws) +       = PClause n capp (owargs ++ wargs) v ws+    fillLHS n capp owargs (PWithR wargs v ws) +       = PWith n capp (owargs ++ wargs) v +            (map (fillLHSD n capp (owargs ++ wargs)) ws)+    fillLHS _ _ _ c = c++    fillLHSD n c a (PClauses fc o fn cs) = PClauses fc o fn (map (fillLHS n c a) cs)+    fillLHSD n c a x = x++pWExpr :: SyntaxInfo -> IParser PTerm+pWExpr syn = do lchar '|'; pExpr' syn++pWhereblock :: Name -> SyntaxInfo -> IParser ([PDecl], [(Name, Name)])+pWhereblock n syn +    = do reserved "where"; open_block+         ds <- many1 $ pFunDecl syn+         let dns = concatMap (concatMap declared) ds+         close_block+         return (concat ds, map (\x -> (x, decoration syn x)) dns)++pDirective :: IParser [PDecl]+pDirective = try (do lchar '%'; reserved "lib"; lib <- strlit;+                     return [PDirective (do addLib lib+                                            addIBC (IBCLib lib))])+         <|> try (do lchar '%'; reserved "link"; obj <- strlit;+                     return [PDirective (do datadir <- liftIO $ getDataDir+                                            o <- liftIO $ findInPath [".", datadir] obj+                                            addIBC (IBCObj o)+                                            addObjectFile o)])+         <|> try (do lchar '%'; reserved "include"; hdr <- strlit;+                     return [PDirective (do addHdr hdr+                                            addIBC (IBCHeader hdr))])+         <|> try (do lchar '%'; reserved "hide"; n <- iName []+                     return [PDirective (do setAccessibility n Hidden+                                            addIBC (IBCAccess n Hidden))])+         <|> try (do lchar '%'; reserved "freeze"; n <- iName []+                     return [PDirective (do setAccessibility n Frozen+                                            addIBC (IBCAccess n Frozen))])+         <|> try (do lchar '%'; reserved "access"; acc <- pAccessibility'+                     return [PDirective (do i <- getIState+                                            putIState (i { default_access = acc }))])+         <|> do lchar '%'; reserved "logging"; i <- natural;+                return [PDirective (setLogLevel (fromInteger i))] ++pTactic :: SyntaxInfo -> IParser PTactic+pTactic syn = do reserved "intro"; ns <- sepBy pName (lchar ',')+                 return $ Intro ns+          <|> do reserved "intros"; return Intros+          <|> try (do reserved "refine"; n <- pName+                      imps <- many1 imp+                      return $ Refine n imps)+          <|> do reserved "refine"; n <- pName+                 i <- getState+                 return $ Refine n []+          <|> do reserved "rewrite"; t <- pExpr syn;+                 i <- getState+                 return $ Rewrite (desugar syn i t)+          <|> do reserved "let"; n <- pName; lchar '=';+                 t <- pExpr syn;+                 i <- getState+                 return $ LetTac n (desugar syn i t)+          <|> do reserved "focus"; n <- pName+                 return $ Focus n+          <|> do reserved "exact"; t <- pExpr syn;+                 i <- getState+                 return $ Exact (desugar syn i t)+          <|> do reserved "try"; t <- pTactic syn;+                 lchar '|';+                 t1 <- pTactic syn+                 return $ Try t t1+          <|> do lchar '{'+                 t <- pTactic syn;+                 lchar ';';+                 t1 <- pTactic syn;+                 lchar '}'+                 return $ TSeq t t1+          <|> do reserved "compute"; return Compute+          <|> do reserved "trivial"; return Trivial+          <|> do reserved "solve"; return Solve+          <|> do reserved "attack"; return Attack+          <|> do reserved "state"; return ProofState+          <|> do reserved "term"; return ProofTerm+          <|> do reserved "undo"; return Undo+          <|> do reserved "qed"; return Qed+  where+    imp = do lchar '?'; return False+      <|> do lchar '_'; return True++desugar :: SyntaxInfo -> IState -> PTerm -> PTerm+desugar syn i t = let t' = expandDo (dsl_info syn) t in+                      t' -- addImpl i t'++expandDo :: DSL -> PTerm -> PTerm+expandDo dsl (PLam n ty tm) = PLam n (expandDo dsl ty) (expandDo dsl tm)+expandDo dsl (PLet n ty v tm) = PLet n (expandDo dsl ty) (expandDo dsl v) (expandDo dsl tm)+expandDo dsl (PPi p n ty tm) = PPi p n (expandDo dsl ty) (expandDo dsl tm)+expandDo dsl (PApp fc t args) = PApp fc (expandDo dsl t)+                                        (map (fmap (expandDo dsl)) args)+expandDo dsl (PCase fc s opts) = PCase fc (expandDo dsl s)+                                        (map (pmap (expandDo dsl)) opts)+expandDo dsl (PPair fc l r) = PPair fc (expandDo dsl l) (expandDo dsl r)+expandDo dsl (PDPair fc l t r) = PDPair fc (expandDo dsl l) (expandDo dsl t) +                                           (expandDo dsl r)+expandDo dsl (PAlternative as) = PAlternative (map (expandDo dsl) as)+expandDo dsl (PHidden t) = PHidden (expandDo dsl t)+expandDo dsl (PReturn fc) = dsl_return dsl+expandDo dsl (PDoBlock ds) = expandDo dsl $ block (dsl_bind dsl) ds +  where+    block b [DoExp fc tm] = tm +    block b [a] = PElabError "Last statement in do block must be an expression"+    block b (DoBind fc n tm : rest)+        = PApp fc b [pexp tm, pexp (PLam n Placeholder (block b rest))]+    block b (DoBindP fc p tm : rest)+        = PApp fc b [pexp tm, pexp (PLam (MN 0 "bpat") Placeholder +                                   (PCase fc (PRef fc (MN 0 "bpat"))+                                             [(p, block b rest)]))]+    block b (DoLet fc n ty tm : rest)+        = PLet n ty tm (block b rest)+    block b (DoLetP fc p tm : rest)+        = PCase fc tm [(p, block b rest)]+    block b (DoExp fc tm : rest)+        = PApp fc b +            [pexp tm, +             pexp (PLam (MN 0 "bindx") Placeholder (block b rest))]+    block b _ = PElabError "Invalid statement in do block"+expandDo dsl (PIdiom fc e) = expandDo dsl $ unIdiom (dsl_apply dsl) (dsl_pure dsl) fc e+expandDo dsl t = t++unIdiom :: PTerm -> PTerm -> FC -> PTerm -> PTerm+unIdiom ap pure fc e@(PApp _ _ _) = let f = getFn e in+                                        mkap (getFn e)+  where+    getFn (PApp fc f args) = (PApp fc pure [pexp f], args)+    getFn f = (f, [])++    mkap (f, [])   = f+    mkap (f, a:as) = mkap (PApp fc ap [pexp f, a], as)++unIdiom ap pure fc e = PApp fc pure [pexp e]+
+ src/Idris/Primitives.hs view
@@ -0,0 +1,309 @@+{-# LANGUAGE RankNTypes, ScopedTypeVariables #-}++module Idris.Primitives(elabPrims) where++import Idris.ElabDecls+import Idris.ElabTerm+import Idris.AbsSyntax++import Core.TT+import Core.Evaluate++import Epic.Epic hiding (Term, Type, Name, fn)+import qualified Epic.Epic as E++data Prim = Prim { p_name  :: Name,+                   p_type  :: Type,+                   p_arity :: Int,+                   p_def   :: [Value] -> Maybe Value,+                   p_epic  :: ([E.Name], E.Term)+                 }++ty []     x = Constant x+ty (t:ts) x = Bind (MN 0 "T") (Pi (Constant t)) (ty ts x)++believeTy = Bind (UN "a") (Pi (Set (UVar (-2))))+            (Bind (UN "b") (Pi (Set (UVar (-2))))+            (Bind (UN "x") (Pi (V 1)) (V 1)))++type ETm = E.Term+type EOp = E.Op++fun = E.fn+ref = E.ref++eOp :: EOp -> ([E.Name], ETm)+eOp op = ([E.name "x", E.name "y"], E.op_ op (E.fn "x") (E.fn "y")) ++eOpFn :: E.Type -> E.Type -> String -> ([E.Name], ETm)+eOpFn ty rty op = ([E.name "x", E.name "y"], +                    foreign_ rty op [(E.fn "x", ty), (E.fn "y", ty)])++strToInt x = foreign_ tyInt "strToInt" [(x, tyString)]+intToStr x = foreign_ tyString "intToStr" [(x, tyInt)]+charToInt x = x+intToChar x = x+intToBigInt x = foreign_ tyBigInt "intToBigInt" [(x, tyInt)]+strToBigInt x = foreign_ tyBigInt "strToBig" [(x, tyString)]+bigIntToStr x = foreign_ tyString "bigToStr" [(x, tyBigInt)]+strToFloat x = foreign_ tyFloat "strToFloat" [(x, tyString)]+floatToStr x = foreign_ tyString "floatToStr" [(x, tyFloat)]+intToFloat x = foreign_ tyFloat "intToFloat" [(x, tyInt)]+floatToInt x = foreign_ tyInt "floatToInt" [(x, tyFloat)]++floatExp x = foreign_ tyFloat "exp" [(x, tyFloat)]+floatLog x = foreign_ tyFloat "log" [(x, tyFloat)]+floatSin x = foreign_ tyFloat "sin" [(x, tyFloat)]+floatCos x = foreign_ tyFloat "cos" [(x, tyFloat)]+floatTan x = foreign_ tyFloat "tan" [(x, tyFloat)]+floatASin x = foreign_ tyFloat "asin" [(x, tyFloat)]+floatACos x = foreign_ tyFloat "acos" [(x, tyFloat)]+floatATan x = foreign_ tyFloat "atan" [(x, tyFloat)]+floatFloor x = foreign_ tyFloat "floor" [(x, tyFloat)]+floatCeil x = foreign_ tyFloat "ceil" [(x, tyFloat)]+floatSqrt x = foreign_ tyFloat "sqrt" [(x, tyFloat)]++strIndex x i = foreign_ tyChar "strIndex" [(x, tyString), (i, tyInt)]+strHead x = foreign_ tyChar "strHead" [(x, tyString)]+strTail x = foreign_ tyString "strTail" [(x, tyString)]+strCons x xs = foreign_ tyString "strCons" [(x, tyChar), (xs, tyString)]+strRev x = foreign_ tyString "strrev" [(x, tyString)]+strEq x y = foreign_ tyInt "streq" [(x, tyString), (y, tyString)]+strLt x y = foreign_ tyInt "strlt" [(x, tyString), (y, tyString)]++primitives =+   -- operators+  [Prim (UN "prim__addInt") (ty [IType, IType] IType) 2 (iBin (+))+    (eOp E.plus_),+   Prim (UN "prim__subInt") (ty [IType, IType] IType) 2 (iBin (-))+    (eOp E.minus_),+   Prim (UN "prim__mulInt") (ty [IType, IType] IType) 2 (iBin (*))+    (eOp E.times_),+   Prim (UN "prim__divInt") (ty [IType, IType] IType) 2 (iBin (div))+    (eOp E.divide_),+   Prim (UN "prim__eqInt")  (ty [IType, IType] IType) 2 (biBin (==))+    (eOp E.eq_),+   Prim (UN "prim__ltInt")  (ty [IType, IType] IType) 2 (biBin (<))+    (eOp E.lt_),+   Prim (UN "prim__lteInt") (ty [IType, IType] IType) 2 (biBin (<=))+    (eOp E.lte_),+   Prim (UN "prim__gtInt")  (ty [IType, IType] IType) 2 (biBin (>))+    (eOp E.gt_),+   Prim (UN "prim__gteInt") (ty [IType, IType] IType) 2 (biBin (>=))+    (eOp E.gte_),+   Prim (UN "prim__eqChar")  (ty [ChType, ChType] IType) 2 (bcBin (==))+    (eOp E.eq_),+   Prim (UN "prim__ltChar")  (ty [ChType, ChType] IType) 2 (bcBin (<))+    (eOp E.lt_),+   Prim (UN "prim__lteChar") (ty [ChType, ChType] IType) 2 (bcBin (<=))+    (eOp E.lte_),+   Prim (UN "prim__gtChar")  (ty [ChType, ChType] IType) 2 (bcBin (>))+    (eOp E.gt_),+   Prim (UN "prim__gteChar") (ty [ChType, ChType] IType) 2 (bcBin (>=))+    (eOp E.gte_),+   Prim (UN "prim__addBigInt") (ty [BIType, BIType] BIType) 2 (bBin (+))+    (eOpFn tyBigInt tyBigInt "addBig"),+   Prim (UN "prim__subBigInt") (ty [BIType, BIType] BIType) 2 (bBin (-))+    (eOpFn tyBigInt tyBigInt "subBig"),+   Prim (UN "prim__mulBigInt") (ty [BIType, BIType] BIType) 2 (bBin (*))+    (eOpFn tyBigInt tyBigInt "mulBig"),+   Prim (UN "prim__divBigInt") (ty [BIType, BIType] BIType) 2 (bBin (div))+    (eOpFn tyBigInt tyBigInt "divBig"),+   Prim (UN "prim__eqBigInt")  (ty [BIType, BIType] IType) 2 (bbBin (==))+    (eOpFn tyBigInt tyInt "eqBig"),+   Prim (UN "prim__ltBigInt")  (ty [BIType, BIType] IType) 2 (bbBin (<))+    (eOpFn tyBigInt tyInt "ltBig"),+   Prim (UN "prim__lteBigInt")  (ty [BIType, BIType] IType) 2 (bbBin (<=))+    (eOpFn tyBigInt tyInt "leBig"),+   Prim (UN "prim__gtBigInt")  (ty [BIType, BIType] IType) 2 (bbBin (>))+    (eOpFn tyBigInt tyInt "gtBig"),+   Prim (UN "prim__gtBigInt")  (ty [BIType, BIType] IType) 2 (bbBin (>=))+    (eOpFn tyBigInt tyInt "geBig"),+   Prim (UN "prim__addFloat") (ty [FlType, FlType] FlType) 2 (fBin (+))+    (eOp E.plusF_),+   Prim (UN "prim__subFloat") (ty [FlType, FlType] FlType) 2 (fBin (-))+    (eOp E.minusF_),+   Prim (UN "prim__mulFloat") (ty [FlType, FlType] FlType) 2 (fBin (*))+    (eOp E.timesF_),+   Prim (UN "prim__divFloat") (ty [FlType, FlType] FlType) 2 (fBin (/))+    (eOp E.divideF_),+   Prim (UN "prim__eqFloat")  (ty [FlType, FlType] IType) 2 (bfBin (==))+    (eOp E.eqF_),+   Prim (UN "prim__ltFloat")  (ty [FlType, FlType] IType) 2 (bfBin (<))+    (eOp E.ltF_),+   Prim (UN "prim__lteFloat") (ty [FlType, FlType] IType) 2 (bfBin (<=))+    (eOp E.lteF_),+   Prim (UN "prim__gtFloat")  (ty [FlType, FlType] IType) 2 (bfBin (>))+    (eOp E.gtF_),+   Prim (UN "prim__gteFloat") (ty [FlType, FlType] IType) 2 (bfBin (>=))+    (eOp E.gteF_),+   Prim (UN "prim__concat") (ty [StrType, StrType] StrType) 2 (sBin (++))+    ([E.name "x", E.name "y"], (fun "append") @@ fun "x" @@ fun "y"),+   Prim (UN "prim__eqString") (ty [StrType, StrType] IType) 2 (bsBin (==))+    ([E.name "x", E.name "y"], strEq (fun "x") (fun "y")),+   Prim (UN "prim__ltString") (ty [StrType, StrType] IType) 2 (bsBin (<))+    ([E.name "x", E.name "y"], strLt (fun "x") (fun "y")),+    -- Conversions+   Prim (UN "prim__strToInt") (ty [StrType] IType) 1 (c_strToInt)+    ([E.name "x"], strToInt (fun "x")),+   Prim (UN "prim__intToStr") (ty [IType] StrType) 1 (c_intToStr)+    ([E.name "x"], intToStr (fun "x")),+   Prim (UN "prim__charToInt") (ty [ChType] IType) 1 (c_charToInt)+    ([E.name "x"], charToInt (fun "x")),+   Prim (UN "prim__intToChar") (ty [IType] ChType) 1 (c_intToChar)+    ([E.name "x"], intToChar (fun "x")),+   Prim (UN "prim__intToBigInt") (ty [IType] BIType) 1 (c_intToBigInt)+    ([E.name "x"], intToBigInt (fun "x")),+   Prim (UN "prim__strToBigInt") (ty [StrType] BIType) 1 (c_strToBigInt)+    ([E.name "x"], strToBigInt (fun "x")),+   Prim (UN "prim__bigIntToStr") (ty [BIType] StrType) 1 (c_bigIntToStr)+    ([E.name "x"], bigIntToStr (fun "x")),+   Prim (UN "prim__strToFloat") (ty [StrType] FlType) 1 (c_strToFloat)+    ([E.name "x"], strToFloat (fun "x")),+   Prim (UN "prim__floatToStr") (ty [FlType] StrType) 1 (c_floatToStr)+    ([E.name "x"], floatToStr (fun "x")),+   Prim (UN "prim__intToFloat") (ty [IType] FlType) 1 (c_intToFloat)+    ([E.name "x"], intToFloat (fun "x")),+   Prim (UN "prim__floatToInt") (ty [FlType] IType) 1 (c_floatToInt)+    ([E.name "x"], floatToInt (fun "x")),++   Prim (UN "prim__floatExp") (ty [FlType] FlType) 1 (p_floatExp)+    ([E.name "x"], floatExp (fun "x")), +   Prim (UN "prim__floatLog") (ty [FlType] FlType) 1 (p_floatLog)+    ([E.name "x"], floatLog (fun "x")),+   Prim (UN "prim__floatSin") (ty [FlType] FlType) 1 (p_floatSin)+    ([E.name "x"], floatSin (fun "x")),+   Prim (UN "prim__floatCos") (ty [FlType] FlType) 1 (p_floatCos)+    ([E.name "x"], floatCos (fun "x")),+   Prim (UN "prim__floatTan") (ty [FlType] FlType) 1 (p_floatTan)+    ([E.name "x"], floatTan (fun "x")),+   Prim (UN "prim__floatASin") (ty [FlType] FlType) 1 (p_floatASin)+    ([E.name "x"], floatASin (fun "x")),+   Prim (UN "prim__floatACos") (ty [FlType] FlType) 1 (p_floatACos)+    ([E.name "x"], floatACos (fun "x")),+   Prim (UN "prim__floatATan") (ty [FlType] FlType) 1 (p_floatATan)+    ([E.name "x"], floatATan (fun "x")),+   Prim (UN "prim__floatSqrt") (ty [FlType] FlType) 1 (p_floatSqrt)+    ([E.name "x"], floatSqrt (fun "x")),+   Prim (UN "prim__floatFloor") (ty [FlType] FlType) 1 (p_floatFloor)+    ([E.name "x"], floatFloor (fun "x")),+   Prim (UN "prim__floatCeil") (ty [FlType] FlType) 1 (p_floatCeil)+    ([E.name "x"], floatCeil (fun "x")),++   Prim (UN "prim__strHead") (ty [StrType] ChType) 1 (p_strHead)+    ([E.name "x"], strHead (fun "x")),+   Prim (UN "prim__strTail") (ty [StrType] StrType) 1 (p_strTail)+    ([E.name "x"], strTail (fun "x")),+   Prim (UN "prim__strCons") (ty [ChType, StrType] StrType) 2 (p_strCons)+    ([E.name "x", E.name "xs"], strCons (fun "x") (fun "xs")),+   Prim (UN "prim__strIndex") (ty [StrType, IType] ChType) 2 (p_strIndex)+    ([E.name "x", E.name "i"], strIndex (fun "x") (fun "i")),+   Prim (UN "prim__strRev") (ty [StrType] StrType) 1 (p_strRev)+    ([E.name "x"], strRev (fun "x")),++   Prim (UN "prim__believe_me") believeTy 3 (p_believeMe)+    ([E.name "a", E.name "b", E.name "x"], fun "x") +  ]++p_believeMe [_,_,x] = Just x+p_believeMe _ = Nothing++iBin op [VConstant (I x), VConstant (I y)] = Just $ VConstant (I (op x y))+iBin _ _ = Nothing++bBin op [VConstant (BI x), VConstant (BI y)] = Just $ VConstant (BI (op x y))+bBin _ _ = Nothing++bBini op [VConstant (BI x), VConstant (BI y)] = Just $ VConstant (I (op x y))+bBini _ _ = Nothing++biBin op = iBin (\x y -> if (op x y) then 1 else 0)+bbBin op = bBini (\x y -> if (op x y) then 1 else 0)++fBin op [VConstant (Fl x), VConstant (Fl y)] = Just $ VConstant (Fl (op x y))+fBin _ _ = Nothing++bfBin op [VConstant (Fl x), VConstant (Fl y)] = let i = (if op x y then 1 else 0) in+                                                Just $ VConstant (I i)+bfBin _ _ = Nothing++bcBin op [VConstant (Ch x), VConstant (Ch y)] = let i = (if op x y then 1 else 0) in+                                                Just $ VConstant (I i)+bcBin _ _ = Nothing++bsBin op [VConstant (Str x), VConstant (Str y)] +    = let i = (if op x y then 1 else 0) in+          Just $ VConstant (I i)+bsBin _ _ = Nothing++sBin op [VConstant (Str x), VConstant (Str y)] = Just $ VConstant (Str (op x y))+sBin _ _ = Nothing++c_intToStr [VConstant (I x)] = Just $ VConstant (Str (show x))+c_intToStr _ = Nothing+c_strToInt [VConstant (Str x)] = Just $ VConstant (I (read x))+c_strToInt _ = Nothing++c_intToChar [VConstant (I x)] = Just $ VConstant (Ch (toEnum x))+c_intToChar _ = Nothing+c_charToInt [VConstant (Ch x)] = Just $ VConstant (I (fromEnum x))+c_charToInt _ = Nothing++c_intToBigInt [VConstant (I x)] = Just $ VConstant (BI (fromIntegral x))+c_intToBigInt _ = Nothing++c_bigIntToStr [VConstant (BI x)] = Just $ VConstant (Str (show x))+c_bigIntToStr _ = Nothing+c_strToBigInt [VConstant (Str x)] = Just $ VConstant (BI (read x))+c_strToBigInt _ = Nothing++c_floatToStr [VConstant (Fl x)] = Just $ VConstant (Str (show x))+c_floatToStr _ = Nothing+c_strToFloat [VConstant (Str x)] = Just $ VConstant (Fl (read x))+c_strToFloat _ = Nothing++c_floatToInt [VConstant (Fl x)] = Just $ VConstant (I (truncate x))+c_floatToInt _ = Nothing++c_intToFloat [VConstant (I x)] = Just $ VConstant (Fl (fromIntegral x))+c_intToFloat _ = Nothing++p_fPrim f [VConstant (Fl x)] = Just $ VConstant (Fl (f x))+p_fPrim f _ = Nothing++p_floatExp = p_fPrim exp+p_floatLog = p_fPrim log+p_floatSin = p_fPrim sin+p_floatCos = p_fPrim cos+p_floatTan = p_fPrim tan+p_floatASin = p_fPrim asin+p_floatACos = p_fPrim acos+p_floatATan = p_fPrim atan+p_floatSqrt = p_fPrim sqrt+p_floatFloor = p_fPrim (fromInteger . floor)+p_floatCeil = p_fPrim (fromInteger . ceiling)++p_strHead [VConstant (Str (x:xs))] = Just $ VConstant (Ch x)+p_strHead _ = Nothing+p_strTail [VConstant (Str (x:xs))] = Just $ VConstant (Str xs)+p_strTail _ = Nothing+p_strIndex [VConstant (Str xs), VConstant (I i)] +   | i < length xs = Just $ VConstant (Ch (xs!!i))+p_strIndex _ = Nothing+p_strCons [VConstant (Ch x), VConstant (Str xs)] = Just $ VConstant (Str (x:xs))+p_strCons _ = Nothing+p_strRev [VConstant (Str xs)] = Just $ VConstant (Str (reverse xs))+p_strRev _ = Nothing++elabPrim :: Prim -> Idris ()+elabPrim (Prim n ty i def epic) +    = do updateContext (addOperator n ty i def)+         i <- getIState+         putIState i { idris_prims = (n, epic) : idris_prims i }++elabPrims :: Idris ()+elabPrims = do mapM_ (elabDecl toplevel) +                     (map (PData defaultSyntax (FC "builtin" 0))+                         [inferDecl, unitDecl, falseDecl, pairDecl, eqDecl])+               mapM_ elabPrim primitives+
+ src/Idris/Prover.hs view
@@ -0,0 +1,120 @@+module Idris.Prover where++import Core.Elaborate hiding (Tactic(..))+import Core.TT+import Core.Evaluate+import Core.CaseTree+import Core.Typecheck++import Idris.AbsSyntax+import Idris.Delaborate+import Idris.ElabDecls+import Idris.ElabTerm+import Idris.Parser+import Idris.Error+import Idris.DataOpts++import System.Console.Haskeline+import Control.Monad.State++prover :: Bool -> Name -> Idris ()+prover lit x =+           do ctxt <- getContext+              i <- get+              case lookupTy Nothing x ctxt of+                  [t] -> if elem x (idris_metavars i)+                               then prove ctxt lit x t+                               else fail $ show x ++ " is not a metavariable"+                  _ -> fail "No such metavariable"++showProof :: Bool -> Name -> [String] -> String+showProof lit n ps +    = bird ++ show n ++ " = proof {" ++ break +++             showSep break (map (\x -> "    " ++ x ++ ";") ps) +++                     break ++ "}\n"+  where bird = if lit then "> " else ""+        break = "\n" ++ bird++prove :: Context -> Bool -> Name -> Type -> Idris ()+prove ctxt lit n ty +    = do let ps = initElaborator n ctxt ty +         (tm, prf) <- ploop True ("-" ++ show n) [] (ES (ps, []) "" Nothing)+         iLOG $ "Adding " ++ show tm+         iputStrLn $ showProof lit n prf+         i <- get+         put (i { last_proof = Just (n, prf) })+         let tree = simpleCase False True [(P Ref n ty, tm)]+         logLvl 3 (show tree)+         (ptm, pty) <- recheckC ctxt (FC "proof" 0) [] tm+         ptm' <- applyOpts ptm+         updateContext (addCasedef n True False True [(P Ref n ty, ptm)] +                                                [(P Ref n ty, ptm')] ty)+         solveDeferred n+elabStep :: ElabState [PDecl] -> ElabD a -> Idris (a, ElabState [PDecl])+elabStep st e = do case runStateT e st of+                     OK (a, st') -> return (a, st')+                     Error a -> do i <- get+                                   fail (pshow i a)+                  +dumpState :: IState -> ProofState -> IO ()+dumpState ist (PS nm [] _ tm _ _ _ _ _ _ _ _ _ _ _) = putStrLn $ (show nm) ++ ": no more goals"+dumpState ist ps@(PS nm (h:hs) _ tm _ _ _ _ problems i _ _ ctxy _ _)+   = do let OK ty = goalAtFocus ps+        let OK env = envAtFocus ps+--         putStrLn $ "Other goals: " ++ show hs ++ "\n"+        putStr $ "\n" ++ showPs (reverse env)+        putStrLn $ "---------------------------------- (" ++ show nm+                     ++ ") --------"+        putStrLn $ show h ++ " : " ++ showG ty ++ "\n"+  where+    tshow t = show (delab ist t)++    showPs [] = ""+    showPs ((MN _ "rewrite_rule", _) : bs) = showPs bs+    showPs ((n, Let t v) : bs)+        = "  " ++ show n ++ " = " ++ tshow v ++ " : " +++            tshow t ++ "\n" ++ showPs bs+    showPs ((n, b) : bs)+        = "  " ++ show n ++ " : " +++            tshow (binderTy b) ++ "\n" ++ showPs bs++    showG (Guess t v) = tshow t ++ " =?= " ++ tshow v+    showG b = tshow (binderTy b)++lifte :: ElabState [PDecl] -> ElabD a -> Idris a+lifte st e = do (v, _) <- elabStep st e+                return v++ploop :: Bool -> String -> [String] -> ElabState [PDecl] -> Idris (Term, [String])+ploop d prompt prf e +    = do i <- get+         when d $ liftIO $ dumpState i (proof e)+         x <- lift $ getInputLine (prompt ++ "> ")+         (cmd, step) <- case x of+            Nothing -> fail "Abandoned"+            Just input -> do return (parseTac i input, input)+         (d, st, done, prf') <- idrisCatch +           (case cmd of+              Left err -> do iputStrLn (show err)+                             return (False, e, False, prf)+              Right Undo -> +                           do (_, st) <- elabStep e loadState+                              return (True, st, False, init prf)+              Right ProofState ->+                              return (True, e, False, prf)+              Right ProofTerm -> +                           do tm <- lifte e get_term+                              iputStrLn $ "TT: " ++ show tm ++ "\n"+                              return (False, e, False, prf)+              Right Qed -> do hs <- lifte e get_holes+                              when (not (null hs)) $ fail "Incomplete proof"+                              return (False, e, True, prf)+              Right tac -> do (_, e) <- elabStep e saveState+                              (_, st) <- elabStep e (runTac True i tac)+                              return (True, st, False, prf ++ [step]))+           (\err -> do iputStrLn (show err)+                       return (False, e, False, prf))+         if done then do (tm, _) <- elabStep st get_term +                         return (tm, prf')+                 else ploop d prompt prf' st+
+ src/Idris/REPL.hs view
@@ -0,0 +1,250 @@+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, DeriveFunctor,+             PatternGuards #-}++module Idris.REPL where++import Idris.AbsSyntax+import Idris.REPLParser+import Idris.ElabDecls+import Idris.ElabTerm+import Idris.Error+import Idris.Delaborate+import Idris.Compiler+import Idris.Prover+import Idris.Parser+import Paths_idris++import Core.Evaluate+import Core.ProofShell+import Core.TT+import Core.Constraints++import System.Console.Haskeline as H+import System.FilePath+import System.Environment+import System.Process+import System.Directory+import System.IO+import Control.Monad+import Control.Monad.State+import Data.List+import Data.Char+import Data.Version++repl :: IState -> [FilePath] -> Idris ()+repl orig mods+   = H.catch+      (do let prompt = mkPrompt mods+          x <- lift $ getInputLine (prompt ++ "> ")+          case x of+              Nothing -> do iputStrLn "Bye bye"+                            return ()+              Just input -> H.catch +                              (do ms <- processInput input orig mods+                                  case ms of+                                      Just mods -> repl orig mods+                                      Nothing -> return ())+                              ctrlC)+      ctrlC+   where ctrlC :: SomeException -> Idris ()+         ctrlC e = do iputStrLn (show e)+                      repl orig mods++mkPrompt [] = "Idris"+mkPrompt [x] = "*" ++ dropExtension x+mkPrompt (x:xs) = "*" ++ dropExtension x ++ " " ++ mkPrompt xs++lit f = case splitExtension f of+            (_, ".lidr") -> True+            _ -> False++processInput :: String -> IState -> [FilePath] -> Idris (Maybe [FilePath])+processInput cmd orig inputs+    = do i <- get+         let fn = case inputs of+                        (f:_) -> f+                        _ -> ""+         case parseCmd i cmd of+                Left err ->   do liftIO $ print err+                                 return (Just inputs)+                Right Reload -> do put (orig { idris_options = idris_options i })+                                   clearErr+                                   mods <- mapM loadModule inputs  +                                   return (Just inputs)+                Right Edit -> do edit fn orig+                                 return (Just inputs)+                Right AddProof -> do idrisCatch (addProof fn orig)+                                                (\e -> iputStrLn (show e))+                                     return (Just inputs)+                Right Quit -> do iputStrLn "Bye bye"+                                 return Nothing+                Right cmd  -> do idrisCatch (process fn cmd)+                                            (\e -> iputStrLn (show e))+                                 return (Just inputs)++edit :: FilePath -> IState -> Idris ()+edit "" orig = iputStrLn "Nothing to edit"+edit f orig+    = do i <- get+         env <- liftIO $ getEnvironment+         let editor = getEditor env+         let line = case errLine i of+                        Just l -> " +" ++ show l ++ " "+                        Nothing -> " "+         let cmd = editor ++ line ++ f+         liftIO $ system cmd+         clearErr+         put (orig { idris_options = idris_options i })+         loadModule f+         iucheck+         return ()+   where getEditor env | Just ed <- lookup "EDITOR" env = ed+                       | Just ed <- lookup "VISUAL" env = ed+                       | otherwise = "vi"++addProof :: FilePath -> IState -> Idris ()+addProof "" orig = iputStrLn "Nothing to add to"+addProof f orig+    = do let fb = f ++ "~"+         liftIO $ copyFile f fb -- make a backup in case something goes wrong!+         prog <- liftIO $ readFile fb+         i <- get+         case last_proof i of+            Nothing -> iputStrLn "No proof to add"+            Just (n, p) -> do let prog' = insertScript (showProof (lit f) n p) (lines prog)+                              liftIO $ writeFile f (unlines prog')+                              iputStrLn $ "Added proof " ++ show n+                              put (i { last_proof = Nothing })+                              -- lift $ removeFile fb -- uncomment when less scared :)++insertScript :: String -> [String] -> [String]+insertScript prf [] = "\n---------- Proofs ----------" : "" : [prf]+insertScript prf (p@"---------- Proofs ----------" : "" : xs) +    = p : "" : prf : xs+insertScript prf (x : xs) = x : insertScript prf xs++process :: FilePath -> Command -> Idris ()+process fn Help = iputStrLn displayHelp+process fn (Eval t) +                 = do (tm, ty) <- elabVal toplevel False t+                      ctxt <- getContext+                      ist <- get +                      let tm' = normaliseAll ctxt [] tm+                      let ty' = normaliseAll ctxt [] ty+                      logLvl 3 $ "Raw: " ++ show (tm', ty')+                      imp <- impShow+                      iputStrLn (showImp imp (delab ist tm') ++ " : " ++ +                                 showImp imp (delab ist ty'))+process fn (ExecVal t) +                    = do (tm, ty) <- elabVal toplevel False t +--                                         (PApp fc (PRef fc (NS (UN "print") ["prelude"]))+--                                                           [pexp t])+                         (tmpn, tmph) <- liftIO tempfile+                         liftIO $ hClose tmph+                         compile tmpn tm+                         liftIO $ system tmpn+                         return ()+    where fc = FC "(input)" 0 +process fn (Check (PRef _ n))+                  = do ctxt <- getContext+                       ist <- get+                       imp <- impShow+                       case lookupTy Nothing n ctxt of+                        [t] -> iputStrLn $ show n ++ " : " +++                                  showImp imp (delab ist t)+                        _ -> iputStrLn $ "No such variable " ++ show n+process fn (Check t) = do (tm, ty) <- elabVal toplevel False t+                          ctxt <- getContext+                          ist <- get +                          imp <- impShow+                          let ty' = normaliseC ctxt [] ty+                          iputStrLn (showImp imp (delab ist tm) ++ " : " ++ +                                    showImp imp (delab ist ty))+process fn Universes = do i <- get+                          let cs = idris_constraints i+--                        iputStrLn $ showSep "\n" (map show cs)+                          liftIO $ print (map fst cs)+                          let n = length cs+                          iputStrLn $ "(" ++ show n ++ " constraints)"+                          case ucheck cs of+                            Error e -> iputStrLn $ pshow i e+                            OK _ -> iputStrLn "Universes OK"+process fn (Defn n) = do i <- get+                         iputStrLn "Compiled patterns:\n"+                         liftIO $ print (lookupDef Nothing n (tt_ctxt i))+                         case lookupCtxt Nothing n (idris_patdefs i) of+                            [] -> return ()+                            [d] -> do iputStrLn "Original definiton:\n"+                                      mapM_ (printCase i) d+    where printCase i (lhs, rhs) = do liftIO $ putStr $ showImp True (delab i lhs)+                                      liftIO $ putStr " = "+                                      liftIO $ putStrLn $ showImp True (delab i rhs)+process fn (Info n) = do i <- get+                         let oi = lookupCtxt Nothing n (idris_optimisation i)+                         liftIO $ print oi+process fn (Spec t) = do (tm, ty) <- elabVal toplevel False t+                         ctxt <- getContext+                         ist <- get+                         let tm' = specialise ctxt (idris_statics ist) tm+                         iputStrLn (show (delab ist tm'))+process fn (Prove n) = prover (lit fn) n+process fn (HNF t)  = do (tm, ty) <- elabVal toplevel False t+                         ctxt <- getContext+                         ist <- get+                         let tm' = simplify ctxt [] tm+                         iputStrLn (show (delab ist tm'))+process fn TTShell  = do ist <- get+                         let shst = initState (tt_ctxt ist)+                         shst' <- lift $ runShell shst+                         return ()+process fn Execute = do (m, _) <- elabVal toplevel False +                                        (PApp fc +                                           (PRef fc (UN "run__IO"))+                                           [pexp $ PRef fc (NS (UN "main") ["main"])])+--                                      (PRef (FC "main" 0) (NS (UN "main") ["main"]))+                        (tmpn, tmph) <- liftIO tempfile+                        liftIO $ hClose tmph+                        compile tmpn m+                        liftIO $ system tmpn+                        return ()+  where fc = FC "main" 0                     +process fn (Compile f) = do (m, _) <- elabVal toplevel False+                                        (PApp fc +                                           (PRef fc (UN "run__IO"))+                                           [pexp $ PRef fc (NS (UN "main") ["main"])])+                            compile f m+  where fc = FC "main" 0                     +process fn (LogLvl i) = setLogLevel i +process fn Metavars +                 = do ist <- get+                      let mvs = idris_metavars ist \\ primDefs+                      case mvs of+                        [] -> iputStrLn "No global metavariables to solve"+                        _ -> iputStrLn $ "Global metavariables:\n\t" ++ show mvs+process fn NOP      = return ()++displayHelp = let vstr = showVersion version in+              "\nIdris version " ++ vstr ++ "\n" +++              "--------------" ++ map (\x -> '-') vstr ++ "\n\n" +++              concatMap cmdInfo help+  where cmdInfo (cmds, args, text) = "   " ++ col 16 12 (showSep " " cmds) args text +        col c1 c2 l m r = +            l ++ take (c1 - length l) (repeat ' ') ++ +            m ++ take (c2 - length m) (repeat ' ') ++ r ++ "\n"++help =+  [ (["Command"], "Arguments", "Purpose"),+    ([""], "", ""),+    (["<expr>"], "", "Evaluate an expression"),+    ([":t"], "<expr>", "Check the type of an expression"),+    ([":r",":reload"], "", "Reload current file"),+    ([":e",":edit"], "", "Edit current file using $EDITOR or $VISUAL"),+    ([":m",":metavars"], "", "Show remaining proof obligations (metavariables)"),+    ([":p",":prove"], "<name>", "Prove a metavariable"),+    ([":a",":addproof"], "", "Add last proof to source file"),+    ([":c",":compile"], "<filename>", "Compile to an executable <filename>"),+    ([":exec",":execute"], "", "Compile to an executable and run"),+    ([":?",":h",":help"], "", "Display this help text"),+    ([":q",":quit"], "", "Exit the Idris system")+  ]+
+ src/Idris/REPLParser.hs view
@@ -0,0 +1,43 @@+module Idris.REPLParser(parseCmd) where++import Idris.Parser+import Idris.AbsSyntax+import Core.TT++import Text.ParserCombinators.Parsec+import Text.ParserCombinators.Parsec.Expr+import Text.ParserCombinators.Parsec.Language+import qualified Text.ParserCombinators.Parsec.Token as PTok++import Debug.Trace+import Data.List++parseCmd i = runParser pCmd i "(input)"++cmd :: [String] -> IParser ()+cmd xs = do lchar ':'; docmd (sortBy (\x y -> compare (length y) (length x)) xs)+    where docmd [] = fail "No such command"+          docmd (x:xs) = try (discard (symbol x)) <|> docmd xs++pCmd :: IParser Command+pCmd = try (do cmd ["q", "quit"]; eof; return Quit)+   <|> try (do cmd ["h", "?", "help"]; eof; return Help)+   <|> try (do cmd ["r", "reload"]; eof; return Reload)+   <|> try (do cmd ["e", "edit"]; eof; return Edit)+   <|> try (do cmd ["exec", "execute"]; eof; return Execute)+   <|> try (do cmd ["ttshell"]; eof; return TTShell)+   <|> try (do cmd ["c", "compile"]; f <- identifier; eof; return (Compile f))+   <|> try (do cmd ["m", "metavars"]; eof; return Metavars)+   <|> try (do cmd ["p", "prove"]; n <- pName; eof; return (Prove n)) +   <|> try (do cmd ["a", "addproof"]; eof; return AddProof)+   <|> try (do cmd ["log"]; i <- natural; eof; return (LogLvl (fromIntegral i)))+   <|> try (do cmd ["spec"]; t <- pFullExpr defaultSyntax; return (Spec t))+   <|> try (do cmd ["hnf"]; t <- pFullExpr defaultSyntax; return (HNF t))+   <|> try (do cmd ["d", "def"]; n <- pName; eof; return (Defn n))+   <|> try (do cmd ["t", "type"]; do t <- pFullExpr defaultSyntax; return (Check t))+   <|> try (do cmd ["u", "universes"]; eof; return Universes)+   <|> try (do cmd ["i", "info"]; n <- pfName; eof; return (Info n))+   <|> try (do cmd ["x"]; t <- pFullExpr defaultSyntax; return (ExecVal t))+   <|> do t <- pFullExpr defaultSyntax; return (Eval t)+   <|> do eof; return NOP+
+ src/Idris/Transforms.hs view
@@ -0,0 +1,44 @@+{-# LANGUAGE PatternGuards #-}++module Idris.Transforms where++import Idris.AbsSyntax+import Core.CaseTree+import Core.TT++class Transform a where+    transform :: (a -> a) -> a -> a++instance Transform (TT Name) where+    transform t x = t (trans' x) where+        trans' (Bind n b sc) = Bind n (fmap (transform t) b) (transform t sc)+        trans' (App f a) = App (transform t f) (transform t a)+        trans' x = x++type TTOpt = TT Name -> TT Name++optimisations :: [TTOpt]+optimisations = [zero, suc]++instance Transform SC where+    transform t x = t (trans' x) where+        trans' (Case n alts) = Case n (map transAlt alts)+        trans' t = t++        transAlt (ConCase n i as sc) = ConCase n i as (trans' sc)+        transAlt (ConstCase c sc) = ConstCase c (trans' sc)+        transAlt (DefaultCase sc) = DefaultCase (trans' sc)++type CaseOpt = SC -> SC++zero :: TTOpt+zero (P _ n _) | n == NS (UN "O") ["nat","prelude"] +    = Constant (BI 0)+zero x = x++suc :: TTOpt+suc (App (P _ s _) a) | s == NS (UN "S") ["nat","prelude"] +    = mkApp (P Ref (UN "prim__addBigInt") Erased) [Constant (BI 1), a]+suc x = x++
+ src/Idris/Unlit.hs view
@@ -0,0 +1,27 @@+module Idris.Unlit(unlit) where++import Core.TT+import Data.Char++unlit :: FilePath -> String -> TC String+unlit f s = do let s' = map ulLine (lines s)+               check f 1 s'+               return $ unlines (map snd s')++data LineType = Prog | Blank | Comm++ulLine ('>':' ':xs)        = (Prog, xs)+ulLine ('>':xs)            = (Prog, xs)+ulLine xs | all isSpace xs = (Blank, "")+          | otherwise      = (Comm, '-':'-':xs)++check f l (a:b:cs) = do chkAdj f l (fst a) (fst b)+                        check f (l+1) (b:cs)+check f l [x] = return ()+check f l [] = return ()++chkAdj f l Prog Comm = tfail $ At (FC f l) ProgramLineComment+chkAdj f l Comm Prog = tfail $ At (FC f l) ProgramLineComment+chkAdj f l _    _    = return ()++
+ src/Main.hs view
@@ -0,0 +1,128 @@+module Main where++import System.Console.Haskeline+import System.IO+import System.Environment+import System.Exit++import Data.Maybe+import Data.Version+import Control.Monad.State++import Core.CoreParser+import Core.ShellParser+import Core.TT+import Core.Typecheck+import Core.ProofShell+import Core.Evaluate+import Core.Constraints++import Idris.AbsSyntax+import Idris.Parser+import Idris.REPL+import Idris.ElabDecls+import Idris.Primitives+import Idris.Imports+import Idris.Error+import Paths_idris++-- Main program reads command line options, parses the main program, and gets+-- on with the REPL.++data Opt = Filename String+         | Ver+         | Usage+         | NoPrelude+         | NoREPL+         | OLogging Int+         | Output String+         | TypeCase+         | TypeInType+         | NoCoverage +         | Verbose+    deriving Eq++main = do xs <- getArgs+          opts <- parseArgs xs+          runInputT defaultSettings $ execStateT (runIdris opts) idrisInit++runIdris :: [Opt] -> Idris ()+runIdris opts = +    do let inputs = opt getFile opts+       let runrepl = not (NoREPL `elem` opts)+       let output = opt getOutput opts+       when (Ver `elem` opts) $ liftIO showver+       when (Usage `elem` opts) $ liftIO usage+       setREPL runrepl+       setVerbose runrepl+       when (Verbose `elem` opts) $ setVerbose True+       mapM_ makeOption opts+       elabPrims+       when (not (NoPrelude `elem` opts)) $ do x <- loadModule "prelude"+                                               return ()+       when runrepl $ iputStrLn banner +       ist <- get+       mods <- mapM loadModule inputs+       ok <- noErrors+       when ok $ case output of+                    [] -> return ()+                    (o:_) -> process "" (Compile o)  +       when runrepl $ repl ist inputs+       ok <- noErrors+       when (not ok) $ liftIO (exitWith (ExitFailure 1))+  where+    makeOption (OLogging i) = setLogLevel i+    makeOption TypeCase = setTypeCase True+    makeOption TypeInType = setTypeInType True+    makeOption NoCoverage = setCoverage False+    makeOption _ = return ()++getFile :: Opt -> Maybe String+getFile (Filename str) = Just str+getFile _ = Nothing++getOutput :: Opt -> Maybe String+getOutput (Output str) = Just str+getOutput _ = Nothing++opt :: (Opt -> Maybe a) -> [Opt] -> [a]+opt = mapMaybe ++usage = do putStrLn usagemsg+           exitWith ExitSuccess++showver = do putStrLn $ "Idris version " ++ ver+             exitWith ExitSuccess++parseArgs :: [String] -> IO [Opt]+parseArgs [] = return []+parseArgs ("--log":lvl:ns)   = liftM (OLogging (read lvl) : ) (parseArgs ns)+parseArgs ("--noprelude":ns) = liftM (NoPrelude : ) (parseArgs ns)+parseArgs ("--check":ns)     = liftM (NoREPL : ) (parseArgs ns)+parseArgs ("-o":n:ns)        = liftM (\x -> NoREPL : Output n : x) (parseArgs ns)+parseArgs ("--typecase":ns)  = liftM (TypeCase : ) (parseArgs ns)+parseArgs ("--typeintype":ns) = liftM (TypeInType : ) (parseArgs ns)+parseArgs ("--nocoverage":ns) = liftM (NoCoverage : ) (parseArgs ns)+parseArgs ("--help":ns)      = liftM (Usage : ) (parseArgs ns)+parseArgs ("--version":ns)   = liftM (Ver : ) (parseArgs ns)+parseArgs ("--verbose":ns)   = liftM (Verbose : ) (parseArgs ns)+parseArgs (n:ns)             = liftM (Filename n : ) (parseArgs ns)++ver = showVersion version++banner = "     ____    __     _                                          \n" ++     +         "    /  _/___/ /____(_)____                                     \n" +++         "    / // __  / ___/ / ___/     Version " ++ ver ++ "\n" +++         "  _/ // /_/ / /  / (__  )      http://www.idris-lang.org/      \n" +++         " /___/\\__,_/_/  /_/____/       Type :? for help                \n" ++usagemsg = "Idris version " ++ ver ++ "\n" +++           "--------------" ++ map (\x -> '-') ver ++ "\n" +++           "Usage: idris [input file] [options]\n" +++           "Options:\n" +++           "\t--check       Type check only\n" +++           "\t-o [file]     Generate executable\n" +++           "\t--noprelude   Don't import the prelude\n" +++           "\t--typeintype  Disable universe checking\n" +++           "\t--log [level] Set debugging log level\n"+
+ tutorial/examples/binary.idr view
@@ -0,0 +1,62 @@+module main++data Binary : Nat -> Set where+    bEnd : Binary O+    bO : Binary n -> Binary (n + n)+    bI : Binary n -> Binary (S (n + n))++instance Show (Binary n) where+    show (bO x) = show x ++ "0"+    show (bI x) = show x ++ "1"+    show bEnd = ""++data Parity : Nat -> Set where+   even : Parity (n + n)+   odd  : Parity (S (n + n))++parity : (n:Nat) -> Parity n+parity O     = even {n=O}+parity (S O) = odd {n=O}+parity (S (S k)) with (parity k)+    parity (S (S (j + j)))     | even ?= even {n=S j}+    parity (S (S (S (j + j)))) | odd  ?= odd {n=S j}++natToBin : (n:Nat) -> Binary n+natToBin O = bEnd+natToBin (S k) with (parity k)+   natToBin (S (j + j))     | even  = bI (natToBin j)+   natToBin (S (S (j + j))) | odd  ?= bO (natToBin (S j))++intToNat : Int -> Nat+intToNat 0 = O+intToNat x = if (x>0) then (S (intToNat (x-1))) else O++main : IO ()+main = do putStr "Enter a number: "+          x <- getLine+          print (natToBin (fromInteger (cast x)))++---------- Proofs ----------++natToBin_lemma_1 = proof {+    intro;+    intro;+    rewrite plusn_Sm j j;+    trivial;+}++parity_lemma_2 = proof {+    intro;+    intro;+    rewrite plusn_Sm j j;+    trivial;+}++parity_lemma_1 = proof {+    intro j;+    intro;+    rewrite plusn_Sm j j;+    trivial;+}++
+ tutorial/examples/bmain.idr view
@@ -0,0 +1,8 @@+module main++import btree++main : IO ()+main = do let t = toTree [1,8,2,7,9,3] +          print (toList t)+
+ tutorial/examples/btree.idr view
@@ -0,0 +1,18 @@+module btree++data BTree a = Leaf+             | Node (BTree a) a (BTree a)++insert : Ord a => a -> BTree a -> BTree a+insert x Leaf = Node Leaf x Leaf+insert x (Node l v r) = if (x < v) then (Node (insert x l) v r)+                                   else (Node l v (insert x r))++toList : BTree a -> List a+toList Leaf = []+toList (Node l v r) = app (toList l) (v :: toList r)++toTree : Ord a => List a -> BTree a+toTree [] = Leaf+toTree (x :: xs) = insert x (toTree xs)+
+ tutorial/examples/classes.idr view
@@ -0,0 +1,10 @@+m_add : Maybe Int -> Maybe Int -> Maybe Int+m_add x y = do x' <- x -- Extract value from x+               y' <- y -- Extract value from y+               return (x' + y') -- Add them ++m_add' : Maybe Int -> Maybe Int -> Maybe Int+m_add' x y = [ x' + y' | x' <- x, y' <- y ]++sortAndShow : (Ord a, Show a) => List a -> String+sortAndShow xs = show (sort xs)
+ tutorial/examples/foo.idr view
@@ -0,0 +1,10 @@+module foo++namespace x+  test : Int -> Int+  test x = x * 2++namespace y+  test : String -> String+  test x = x ++ x +
+ tutorial/examples/hello.idr view
@@ -0,0 +1,5 @@+module main++main : IO ()+main = putStrLn "Hello world"+
+ tutorial/examples/interp.idr view
@@ -0,0 +1,65 @@+module main++data Ty = TyInt | TyBool| TyFun Ty Ty++interpTy : Ty -> Set+interpTy TyInt       = Int+interpTy TyBool      = Bool+interpTy (TyFun s t) = interpTy s -> interpTy t++using (G : Vect Ty n) ++  data Env : Vect Ty n -> Set where+      Nil  : Env Nil+      (::) : interpTy a -> Env G -> Env (a :: G)++  data HasType : (i : Fin n) -> Vect Ty n -> Ty -> Set where+      stop : HasType fO (t :: G) t+      pop  : HasType k G t -> HasType (fS k) (u :: G) t++  lookup : HasType i G t -> Env G -> interpTy t+  lookup stop    (x :: xs) = x+  lookup (pop k) (x :: xs) = lookup k xs++  data Expr : Vect Ty n -> Ty -> Set where+      Var : HasType i G t -> Expr G t+      Val : (x : Int) -> Expr G TyInt+      Lam : Expr (a :: G) t -> Expr G (TyFun a t)+      App : Expr G (TyFun a t) -> Expr G a -> Expr G t+      Op  : (interpTy a -> interpTy b -> interpTy c) -> Expr G a -> Expr G b -> +            Expr G c+      If  : Expr G TyBool -> Expr G a -> Expr G a -> Expr G a+  +  interp : Env G -> {static} Expr G t -> interpTy t+  interp env (Var i)     = lookup i env+  interp env (Val x)     = x+  interp env (Lam sc)    = \x => interp (x :: env) sc+  interp env (App f s)   = interp env f (interp env s)+  interp env (Op op x y) = op (interp env x) (interp env y)+  interp env (If x t e)  = if interp env x then interp env t +                                           else interp env e++  eId : Expr G (TyFun TyInt TyInt)+  eId = Lam (Var stop)++  eAdd : Expr G (TyFun TyInt (TyFun TyInt TyInt))+  eAdd = Lam (Lam (Op (+) (Var stop) (Var (pop stop))))+  +  eDouble : Expr G (TyFun TyInt TyInt)+  eDouble = Lam (App (App eAdd (Var stop)) (Var stop))+ +  app : |(f : Expr G (TyFun a t)) -> Expr G a -> Expr G t+  app = \f, a => App f a++  fact : Expr G (TyFun TyInt TyInt)+  fact = Lam (If (Op (==) (Var stop) (Val 0))+                 (Val 1) (Op (*) (app fact (Op (-) (Var stop) (Val 1))) (Var stop)))++testFac : Int+testFac = interp [] fact 4++main : IO ()+main = do putStr "Enter a number: "+          x <- getLine+          print (interp [] fact (cast x)) +
+ tutorial/examples/letbind.idr view
@@ -0,0 +1,16 @@+module letbind++mirror : List a -> List a+mirror xs = let xs' = rev xs in+                app xs xs'++data Person = MkPerson String Int++showPerson : Person -> String+showPerson p = let MkPerson name age = p in+                   name ++ " is " ++ show age ++ " years old"++splitAt : Char -> String -> (String, String)+splitAt c x = case break (== c) x of+                  (x, y) => (x, strTail y)+
+ tutorial/examples/prims.idr view
@@ -0,0 +1,14 @@+module prims++x : Int+x = 42++foo : String+foo = "Sausage machine"++bar : Char+bar = 'Z'++quux : Bool+quux = False+
+ tutorial/examples/theorems.idr view
@@ -0,0 +1,38 @@++fiveIsFive : 5 = 5+fiveIsFive = refl++twoPlusTwo : 2 + 2 = 4+twoPlusTwo = refl++plusReduces : (n:Nat) -> plus O n = n+plusReduces n = refl++plusReducesO : (n:Nat) -> n = plus n O+plusReducesO O = refl+plusReducesO (S k) = eqRespS (plusReducesO k)++plusReducesS : (n:Nat) -> (m:Nat) -> S (plus n m) = plus n (S m)+plusReducesS O m = refl+plusReducesS (S k) m = eqRespS (plusReducesS k m)++plusReducesO' : (n:Nat) -> n = plus n O+plusReducesO' O     = ?plusredO_O+plusReducesO' (S k) = let ih = plusReducesO' k in+                      ?plusredO_S+++---------- Proofs ----------++plusredO_S = proof {+    intro;+    intro;+    rewrite ih;+    trivial;+}++plusredO_O = proof {+    compute;+    trivial;+}+
+ tutorial/examples/universe.idr view
@@ -0,0 +1,7 @@+myid : (a : Set) -> a -> a+myid _ x = x++idid :  (a : Set) -> a -> a+idid = myid _ myid++
+ tutorial/examples/usefultypes.idr view
@@ -0,0 +1,20 @@++intVec : Vect Int 5+intVec = [1, 2, 3, 4, 5]++double : Int -> Int+double x = x * 2++vec : (n ** Vect Int n)+vec = (_ ** [3, 4])++list_lookup : Nat -> List a -> Maybe a+list_lookup _     Nil         = Nothing+list_lookup O     (x :: xs) = Just x+list_lookup (S k) (x :: xs) = list_lookup k xs++lookup_default : Nat -> List a -> a -> a+lookup_default i xs def = case list_lookup i xs of+                              Nothing => def+                              Just x => x+
+ tutorial/examples/vbroken.idr view
@@ -0,0 +1,5 @@+vapp : Vect a n -> Vect a m -> Vect a (n + m)+vapp Nil       ys = ys+vapp (x :: xs) ys = x :: vapp xs xs -- BROKEN++
+ tutorial/examples/views.idr view
@@ -0,0 +1,37 @@+module views++data Parity : Nat -> Set where+   even : Parity (n + n)+   odd  : Parity (S (n + n))++parity : (n:Nat) -> Parity n+parity O     = even {n=O}+parity (S O) = odd {n=O}+parity (S (S k)) with (parity k)+  parity (S (S (j + j)))     | even ?= even {n=S j}+  parity (S (S (S (j + j)))) | odd  ?= odd {n=S j}++natToBin : Nat -> List Bool+natToBin O = Nil+natToBin k with (parity k)+   natToBin (j + j)     | even = False :: natToBin j+   natToBin (S (j + j)) | odd  = True  :: natToBin j+++---------- Proofs ----------++views.parity_lemma_2 = proof {+    intro;+    intro;+    rewrite plusn_Sm j j;+    trivial;+}++views.parity_lemma_1 = proof {+    intro;+    intro;+    rewrite plusn_Sm j j;+    trivial;+}++