diff --git a/CHANGELOG.txt b/CHANGELOG.txt --- a/CHANGELOG.txt +++ b/CHANGELOG.txt @@ -1,3 +1,24 @@ +0.2.0 Thomas Gibson-Robinson 2012-01-04 + * Enhanced the evaluator: + * Dot is not handled correctly; + * More versions of infinite sets are allowed; + * Add experimental and partial support of $ in prefixes. + This should mean that the evaluator has feature parity with FDR2, + although it does lack testing. + * Added a renamer that renames all variables in a file or expression to + ensure that they do not clash. + * Enhanced the parser to be more compatible with FDR2 with regard to the + ambiguity with > and end of sequence. See the comment in + src/CSPM/Parser.hs. + * Fixed a bug in the typechecker where it would incorrectly allow yield + types to be chosen in prefixes. For example, given c?x?y:{0,1} where + c is a channel that has only one field, of type A, the typechecker would + assign a type of Int=>A for x, which does not match the evaluator which + would assign x to the whole A. To fix this a new type constraint was + added, Inputable, that any type other than yield satisfies. + * Added a lot more documentation, particularly on the abstract syntax tree + and how to use the library. + 0.1.2 Thomas Gibson-Robinson 2011-11-04 * Fix building with GHC 7.2 and Alex 3. * Remove the last few remaining mentions to sfdr (the old name for diff --git a/dist/build/CSPM/Parser/Lexer.hs b/dist/build/CSPM/Parser/Lexer.hs --- a/dist/build/CSPM/Parser/Lexer.hs +++ b/dist/build/CSPM/Parser/Lexer.hs @@ -67,19 +67,28 @@ openseq token inp len = do - --cs <- getSequenceStack - --setSequenceStack (0:cs) + cs <- getSequenceStack + setSequenceStack (0:cs) tok token inp len closeseq token inp len = do - --(c:cs) <- getSequenceStack - --setSequenceStack cs + (c:cs) <- getSequenceStack + case cs of + c1:cs -> setSequenceStack (c+c1:cs) + [] -> + -- Must be because of a syntax error (too many closing brakcets) + -- We let the parser catch this and we try and do something + -- sensible. + setSequenceStack [0] tok token inp len gt :: AlexInput -> Int -> ParseMonad LToken gt inp len = do (c:cs) <- getSequenceStack - tok (if c > 0 then TCloseSeq else TGt) inp len + if c > 0 then do + setSequenceStack (c-1:cs) + tok TCloseSeq inp len + else tok TGt inp len soakTok :: Token -> AlexInput -> Int -> ParseMonad LToken soakTok t inp len = setCurrentStartCode soak >> tok t inp len diff --git a/libcspm.cabal b/libcspm.cabal --- a/libcspm.cabal +++ b/libcspm.cabal @@ -10,7 +10,29 @@ Build-type: Simple Cabal-version: >=1.9.2 Synopsis: A library providing a parser, type checker and evaluator for CSPM. -Version: 0.1.2 +Description: + This library provides a parser, type checker and evaluator for machine CSP. + The parser is designed to be compatible with FDR2 and, in particular, deals + with the ambiguity between greater than and end of sequence in the same way + (as far as possible, see "CSPM.Parser" for more information). The + typechecker is as liberal as it is possible to make a typechecker without + making typechecking undecidable. Documentation on the type system is + forthcoming. The evaluator is relatively experimental, but should be able + to evaluate any CSPM expression that FDR2 can. The output of this phase + (if a process is evaluated) is a tree of CSP (note not CSPM) operator + applications which should be suitable for input into a refinement checker, + or other process algebraic tool. + . + The main module of interest will be the "CSPM" module. This packages up + most of the functionality of the library in an easy to use, relatively + high level format. See "CSPM" for an example of how to use this module. + . + Version Numbering Policy: point releases (i.e. from @x.y.z@ to @x.y.z'@) + are guaranteed to be backwards compatible. Minor releases (i.e. + from @x.y.z@ to @x.y'.z'@) will not be backwards compatible, but should be + relatively easy to port to. Major changes (i.e. from @x.y.z@ to @x'.y'.z'@) + will not be backwards compatible and may include large API redesigns. +Version: 0.2.0 Extra-source-files: README.md, CHANGELOG.txt @@ -22,7 +44,7 @@ Source-repository this type: git location: https://github.com/tomgr/libcspm - tag: release-0.1.2 + tag: release-0.2.0 Library Build-Depends: @@ -34,7 +56,8 @@ mtl >= 2.0, pretty >= 1.0, directory >= 1.0, - graph-wrapper >= 0.2 + graph-wrapper >= 0.2, + value-supply >= 0.6 Exposed-Modules: CSPM, @@ -42,6 +65,7 @@ CSPM.Compiler.Map, CSPM.Compiler.Processes, CSPM.Compiler.Set, + CSPM.DataStructures.Literals, CSPM.DataStructures.Names, CSPM.DataStructures.Syntax, CSPM.DataStructures.Tokens, @@ -64,6 +88,8 @@ CSPM.Parser.Monad, CSPM.Parser.Parser, CSPM.PrettyPrinter, + CSPM.Prelude, + CSPM.Renamer, CSPM.TypeChecker, CSPM.TypeChecker.BuiltInFunctions, CSPM.TypeChecker.Common, diff --git a/src/CSPM.hs b/src/CSPM.hs --- a/src/CSPM.hs +++ b/src/CSPM.hs @@ -1,25 +1,113 @@ {-# LANGUAGE FlexibleInstances #-} +-- | This module provides the main high-level interface to the library +-- functionality. It does this through a monadic interface, mainly due to the +-- fact that several of the components require the use of the IO monad. It is +-- highly recommended that users of this library use a monad and then implement +-- the 'CSPMMonad' class on their own custom monad. An example of this is shown +-- by the basic implementation of the 'CSPM' monad. +-- +-- The main library datatype is exported by 'CSPM.DataStructures.Syntax', which +-- provides an AST representation of machine CSP. Most of the pieces of syntax, +-- like expressions ('Exp'), are parametrised by the type of the variables that +-- it contains. For more information see the comment at the top of the above +-- module. +-- +-- The library exports several APIs which, in likely order of usage, are: +-- +-- [@Parser@] Parses strings or files and produces an AST, parametrised +-- by 'UnRenamedName', which are simply pieces of text. +-- +-- [@Renamer@] Renames the AST and produces an equivalent AST, but +-- parametrised by 'Name', which uniquely identify the binding instance +-- of each variable (see documentation of 'Name'). +-- +-- [@Type Checker@] Type checks an AST, in the process annotating it with +-- types. +-- +-- [@Desugarer@] Desugars an AST, remove syntactic sugar and prepares it for +-- evaluation. The AST produced by this phase should not be pretty +-- printed as it parenthesis have been removed, potentially making it not +-- equivalent. +-- +-- [@Evaluator@] Evaluates an AST, returning a 'Value'. Note that the +-- evaluator is lazy, meaning that the resulting Value will be generated +-- as it is consumed, making it suitable for streaming to subsequent +-- compilation phases. +-- +-- For example, suppose we wish to evaluate the expression @test(1,2,3)@ within +-- the context of the file @test.csp@ we could use the following segment of +-- code: +-- +-- > main :: IO () +-- > main = do +-- > session <- newCSPMSession +-- > (value, resultingSession) <- unCSPM session $ do +-- > -- Parse the file, returning something of type PModule. +-- > parsedFile <- parseFile "test.csp" +-- > -- Rename the file, returning something of type TCModule. +-- > renamedFile <- renameFile parsedFile +-- > -- Typecheck the file, annotating it with types. +-- > typeCheckedFile <- typeCheckFile renamedFile +-- > -- Desugar the file, returning the version ready for evaluation. +-- > desugaredFile <- desugarFile typeCheckedFile +-- > -- Bind the file, making all functions and patterns available. +-- > bindFile desugaredFile +-- > +-- > -- The file is now ready for use, so now we build the expression +-- > -- to be evaluated. +-- > parsedExpression <- parseExpression "test(1,2,3)" +-- > renamedExpression <- renameExpression parsedExpression +-- > typeCheckedExpression <- typeCheckExpression renamedExpression +-- > desugaredExpression <- desugarExpression typeCheckedExpression +-- > +-- > -- Evaluate the expression in the current context. +-- > value <- evaluateExpression desugaredExpression +-- > return value +-- > putStrLn (show (prettyPrint value)) +-- > return () +-- +-- This would pretty print the value of the expression to stdout. module CSPM ( - module CSPM.DataStructures.Names, - module CSPM.DataStructures.Syntax, - module CSPM.DataStructures.Types, -- * CSPM Monad CSPMSession, newCSPMSession, - CSPMMonad, - getSession, setSession, handleWarnings, + CSPMMonad(..), withSession, -- ** A basic implementation of the monad CSPM, unCSPM, + -- * Common Data Types + -- | Defines the names that are used by machine CSP. + module CSPM.DataStructures.Names, + -- | Defines the abstract syntax for machine CSP. + module CSPM.DataStructures.Syntax, + -- | Defines the types used by the typechecker. + module CSPM.DataStructures.Types, + -- | Defines the values produced by the evaluator. + module CSPM.Evaluator.Values, -- * Parser API parseStringAsFile, parseFile, parseInteractiveStmt, parseExpression, + -- * Renamer API + renameFile, renameInteractiveStmt, renameExpression, -- * Type Checker API - typeCheckFile, typeCheckInteractiveStmt, typeCheckExpression, ensureExpressionIsOfType, - dependenciesOfExp, typeOfExpression, + typeCheckFile, typeCheckInteractiveStmt, typeCheckExpression, + ensureExpressionIsOfType, dependenciesOfExp, typeOfExpression, + -- * Desugarer API + desugarFile, desugarInteractiveStmt, desugarExpression, -- * Evaluator API - evaluateExp, bindFile, bindDeclaration, getBoundNames, + evaluateExpression, + -- * Low-Level API + -- | Whilst this module provides many of the commonly used functionality + -- within the CSPM monad, sometimes there are additional functions exported + -- by other modules that are of use. The following functions allow the + -- renamer, typechecker and evaluator to be run in the current state. They + -- also save the resulting state in the current session. + runParserInCurrentState, + runRenamerInCurrentState, + runTypeCheckerInCurrentState, + runEvaluatorInCurrentState, + reportWarnings, -- * Misc functions - getLibCSPMVersion + getLibCSPMVersion, ) where @@ -35,6 +123,7 @@ import qualified CSPM.Evaluator as EV import CSPM.Evaluator.Values import qualified CSPM.Parser as P +import qualified CSPM.Renamer as RN import qualified CSPM.TypeChecker as TC import qualified CSPM.Desugar as DS import Paths_libcspm (version) @@ -42,120 +131,180 @@ import Util.Exception import Util.PrettyPrint --- | A `CSPMSession` represents the internal states of all the various +-- | A 'CSPMSession' represents the internal states of all the various -- components. data CSPMSession = CSPMSession { + -- | The state of the renamer. + rnState :: RN.RenamerState, + -- | The state of the type checker. tcState :: TC.TypeInferenceState, + -- | The state of the evaluator. evState :: EV.EvaluationState } --- | Create a new `CSPMSession`. +-- | Create a new 'CSPMSession'. newCSPMSession :: MonadIO m => m CSPMSession newCSPMSession = do -- Get the type checker environment with the built in functions already -- injected + rnState <- liftIO $ RN.initRenamer tcState <- liftIO $ TC.initTypeChecker let evState = EV.initEvaluator - return $ CSPMSession tcState evState + return $ CSPMSession rnState tcState evState -- | The CSPMMonad is the main monad in which all functions must be called. --- Whilst there is a build in representation (see `CSPM`) it is recommended --- that you define an instance of CSPMMonad over whatever monad you use. +-- Whilst there is a build in representation (see 'CSPM') it is recommended +-- that you define an instance of 'CSPMMonad' over whatever monad you use. class (MonadIO m) => CSPMMonad m where + -- | Get the current session. getSession :: m CSPMSession + -- | Update the current session. setSession :: CSPMSession -> m () + -- | This is called whenever warnings are emitted. handleWarnings :: [ErrorMessage] -> m () - + +-- | Executes an operation giving it access to the current 'CSPMSession'. withSession :: CSPMMonad m => (CSPMSession -> m a) -> m a withSession f = getSession >>= f +-- | Modifies the session using the given function. modifySession :: CSPMMonad m => (CSPMSession -> CSPMSession) -> m () modifySession f = do s <- getSession setSession (f s) -reportWarnings :: CSPMMonad m => m(a, [ErrorMessage]) -> m a +-- | Given a program that can return warnings, runs the program and raises +-- any warnings found using 'handleWarnings'. +reportWarnings :: CSPMMonad m => m (a, [ErrorMessage]) -> m a reportWarnings prog = withSession $ \ sess -> do (v, ws) <- prog - if ws == [] then return () - else handleWarnings ws + when (ws /= []) $ handleWarnings ws return v --- A basic implementation +-- | A basic implementation of 'CSPMMonad', using the 'StateT' monad. This +-- prints out any warnings to stdout. type CSPM = StateT CSPMSession IO +-- | Runs a 'CSPM' function, returning the result and the resulting session. unCSPM :: CSPMSession -> CSPM a -> IO (a, CSPMSession) unCSPM = flip runStateT - + instance CSPMMonad CSPM where getSession = get setSession = put handleWarnings ms = liftIO $ putStrLn $ show $ prettyPrint ms --- Parser API -parse :: CSPMMonad m => FilePath -> P.ParseMonad a -> m a -parse dir p = liftIO $ P.runParser p dir +-- | Runs the parser. +runParserInCurrentState :: CSPMMonad m => FilePath -> P.ParseMonad a -> m a +runParserInCurrentState dir p = liftIO $ P.runParser p dir -- | Parse a file `fp`. Throws a `SourceError` on any parse error. parseFile :: CSPMMonad m => FilePath -> m [PModule] parseFile fp = let (dir, fname) = splitFileName fp - in parse dir (P.parseFile fname) + in runParserInCurrentState dir (P.parseFile fname) -- | Parses a string, treating it as though it were a file. Throws a --- `SourceError` on any parse error. +-- 'SourceError' on any parse error. parseStringAsFile :: CSPMMonad m => String -> m [PModule] -parseStringAsFile str = parse "" (P.parseStringAsFile str) +parseStringAsFile str = runParserInCurrentState "" (P.parseStringAsFile str) --- | Parses an `InteractiveStmt`. Throws a `SourceError` on any parse error. +-- | Parses a 'PInteractiveStmt'. Throws a 'SourceError' on any parse error. parseInteractiveStmt :: CSPMMonad m => String -> m PInteractiveStmt -parseInteractiveStmt str = parse "" (P.parseInteractiveStmt str) +parseInteractiveStmt str = + runParserInCurrentState "" (P.parseInteractiveStmt str) --- | Parses an `Exp`. Throws a `SourceError` on any parse error. +-- | Parses an 'Exp'. Throws a 'SourceError' on any parse error. parseExpression :: CSPMMonad m => String -> m PExp -parseExpression str = parse "" (P.parseExpression str) +parseExpression str = runParserInCurrentState "" (P.parseExpression str) +-- Renamer API + +-- | Runs renamer in the current state. +runRenamerInCurrentState :: CSPMMonad m => RN.RenamerMonad a -> m a +runRenamerInCurrentState p = withSession $ \s -> do + (a, st) <- liftIO $ RN.runFromStateToState (rnState s) p + modifySession (\s -> s { rnState = st }) + return a + +-- | Renames a file. +renameFile :: CSPMMonad m => [PModule] -> m [TCModule] +renameFile m = runRenamerInCurrentState $ do + RN.newScope + RN.rename m + +-- | Renames an expression. +renameExpression :: CSPMMonad m => PExp -> m TCExp +renameExpression e = runRenamerInCurrentState $ RN.rename e + +-- | Rename ian interactive statement. +renameInteractiveStmt :: CSPMMonad m => PInteractiveStmt -> m TCInteractiveStmt +renameInteractiveStmt e = runRenamerInCurrentState $ do + RN.newScope + RN.rename e + -- TypeChecker API --- All the type checkers also perform desugaring + +-- | Runs the typechecker in the current state, saving the resulting state and +-- returning any warnings encountered. runTypeCheckerInCurrentState :: CSPMMonad m => TC.TypeCheckMonad a -> m (a, [ErrorMessage]) runTypeCheckerInCurrentState p = withSession $ \s -> do (a, ws, st) <- liftIO $ TC.runFromStateToState (tcState s) p modifySession (\s -> s { tcState = st }) return (a, ws) --- | Type checks a file, also desugaring it. Throws a `SourceError` --- if an error is encountered and will call handleWarnings -typeCheckFile :: CSPMMonad m => [PModule] -> m [TCModule] +-- | Type checks a file, also desugaring and annotating it. Throws a +-- 'SourceError' if an error is encountered and will call 'handleWarnings' on +-- any warnings. This also performs desugaraing. +typeCheckFile :: CSPMMonad m => [TCModule] -> m [TCModule] typeCheckFile ms = reportWarnings $ runTypeCheckerInCurrentState $ do TC.typeCheck ms - return $ DS.desugar ms + return ms --- | Type checks a `InteractiveStmt`. -typeCheckInteractiveStmt :: CSPMMonad m => PInteractiveStmt -> m TCInteractiveStmt +-- | Type checks a 'PInteractiveStmt'. +typeCheckInteractiveStmt :: CSPMMonad m => TCInteractiveStmt -> m TCInteractiveStmt typeCheckInteractiveStmt pstmt = reportWarnings $ runTypeCheckerInCurrentState $ do TC.typeCheck pstmt - return $ DS.desugar pstmt + return pstmt -typeCheckExpression :: CSPMMonad m => PExp -> m TCExp +-- | Type checkes a 'PExp', returning the desugared and annotated version. +typeCheckExpression :: CSPMMonad m => TCExp -> m TCExp typeCheckExpression exp = reportWarnings $ runTypeCheckerInCurrentState $ do TC.typeCheck exp - return $ DS.desugar exp + return exp -ensureExpressionIsOfType :: CSPMMonad m => Type -> PExp -> m TCExp +-- | Given a 'Type', ensures that the 'PExp' is of that type. It returns the +-- annoated and desugared expression. +ensureExpressionIsOfType :: CSPMMonad m => Type -> TCExp -> m TCExp ensureExpressionIsOfType t exp = reportWarnings $ runTypeCheckerInCurrentState $ do TC.typeCheckExpect t exp - return $ DS.desugar exp + return exp -- | Gets the type of the expression in the current context. -typeOfExpression :: CSPMMonad m => PExp -> m Type +typeOfExpression :: CSPMMonad m => TCExp -> m Type typeOfExpression exp = reportWarnings $ runTypeCheckerInCurrentState (TC.typeOfExp exp) +-- | Returns the 'Name's that the given type checked expression depends on. dependenciesOfExp :: CSPMMonad m => TCExp -> m [Name] dependenciesOfExp e = reportWarnings $ runTypeCheckerInCurrentState (TC.dependenciesOfExp e) +-- | Desugar a file, preparing it for evaulation. +desugarFile :: CSPMMonad m => [TCModule] -> m [TCModule] +desugarFile [m] = return [DS.desugar m] + +-- | Desugars an expression. +desugarExpression :: CSPMMonad m => TCExp -> m TCExp +desugarExpression e = return $ DS.desugar e + +-- | Desugars an interactive statement. +desugarInteractiveStmt :: CSPMMonad m => TCInteractiveStmt -> m TCInteractiveStmt +desugarInteractiveStmt s = return $ DS.desugar s + -- Evaluator API + +-- | Runs the evaluator in the current state, saving the resulting state. runEvaluatorInCurrentState :: CSPMMonad m => EV.EvaluationMonad a -> m a runEvaluatorInCurrentState p = withSession $ \s -> do let (a, st) = EV.runFromStateToState (evState s) p @@ -167,28 +316,31 @@ -- | Get a list of currently bound names in the environment. getBoundNames :: CSPMMonad m => m [Name] getBoundNames = runEvaluatorInCurrentState EV.getBoundNames - --- | Takes a declaration and adds it to the current environment. +  +-- | Takes a declaration and adds it to the current environment. Requires the +-- declaration to be desugared. bindDeclaration :: CSPMMonad m => TCDecl -> m () bindDeclaration d = withSession $ \s -> do - evSt <- runEvaluatorInCurrentState (EV.addToEnvironment (EV.evaluateDecl d)) - modifySession (\s -> s { evState = evSt }) - --- | Binds all the declarations that are in a particular file. +    evSt <- runEvaluatorInCurrentState (do + ds <- EV.evaluateDecl d + EV.addToEnvironment ds) +    modifySession (\s -> s { evState = evSt }) +  +-- | Binds all the declarations that are in a particular file. Requires the +-- file to be desugared. bindFile :: CSPMMonad m => [TCModule] -> m () bindFile ms = do - -- Bind - evSt <- runEvaluatorInCurrentState (EV.addToEnvironment (EV.evaluateFile ms)) - modifySession (\s -> s { evState = evSt }) - return () - --- | Returns a list of all declarations in the specified file. -evaluateFile :: CSPMMonad m => [TCModule] -> m [(Name, Value)] -evaluateFile ms = runEvaluatorInCurrentState (EV.evaluateFile ms) - --- | Evaluates the expression in the current context. -evaluateExp :: CSPMMonad m => TCExp -> m Value -evaluateExp e = runEvaluatorInCurrentState (EV.evaluateExp e) +    -- Bind +    evSt <- runEvaluatorInCurrentState (do + ds <- EV.evaluateFile ms + EV.addToEnvironment ds) +    modifySession (\s -> s { evState = evSt }) +    return () +  +-- | Evaluates the expression in the current context. Requires the expression +-- to be desugared. +evaluateExpression :: CSPMMonad m => TCExp -> m Value +evaluateExpression e = runEvaluatorInCurrentState (EV.evaluateExp e) -- | Return the version of libcspm that is being used. getLibCSPMVersion :: Version diff --git a/src/CSPM/Compiler/Processes.hs b/src/CSPM/Compiler/Processes.hs --- a/src/CSPM/Compiler/Processes.hs +++ b/src/CSPM/Compiler/Processes.hs @@ -1,31 +1,85 @@ +-- | This module provides the input data structure to the compiler. module CSPM.Compiler.Processes ( - Proc(..), ProcName + Proc(..), + ProcOperator(..), + ProcName(..), + prettyPrintAllRequiredProcesses, ) where +import qualified CSPM.Compiler.Map as M +import qualified CSPM.Compiler.Set as S import CSPM.Compiler.Events +import CSPM.DataStructures.Names +import {-# SOURCE #-} CSPM.Evaluator.Values import Util.PrettyPrint -type ProcName = String +-- | ProcNames uniquely identify processes. +data ProcName = ProcName { + -- | The name of this process (recal Name s are unique). + name :: Name, + -- | The arguments applied to this process, in case it was a function + -- call. + arguments :: [[Value]] + } +instance Eq ProcName where + pn1 == pn2 = name pn1 == name pn2 && arguments pn1 == arguments pn2 +instance PrettyPrintable ProcName where + prettyPrint (ProcName n args) = + prettyPrint n + <> hcat (map (\as -> parens (list (map prettyPrint as))) args) +instance Show ProcName where + show pn = show (prettyPrint pn) + +-- | An operator that can be applied to processes. +data ProcOperator = + Chase + | Diamond + | Explicate + | Normalize + | ModelCompress + | StrongBisim + | TauLoopFactor + | WeakBisim + deriving (Eq) + +instance PrettyPrintable ProcOperator where + prettyPrint Chase = text "chase" + prettyPrint Diamond = text "diamond" + prettyPrint Explicate = text "explicate" + prettyPrint Normalize = text "normal" + prettyPrint ModelCompress = text "model_compress" + prettyPrint StrongBisim = text "sbisim" + prettyPrint TauLoopFactor = text "tau_loop_factor" + prettyPrint WeakBisim = text "wbisim" + +instance Show ProcOperator where + show p = show (prettyPrint p) + +-- | A compiled process. Note this is an infinite data structure (due to +-- PProcCall) as this makes compilation easy (we can easily chase +-- dependencies). data Proc = - PAlphaParallel [(EventSet, Proc)] - | PException Proc EventSet Proc + PAlphaParallel [(S.Set Event, Proc)] + | PException Proc (S.Set Event) Proc | PExternalChoice [Proc] - | PGenParallel EventSet [Proc] - | PHide Proc EventSet + | PGenParallel (S.Set Event) [Proc] + | PHide Proc (S.Set Event) | PInternalChoice [Proc] | PInterrupt Proc Proc | PInterleave [Proc] + -- Map from event of left process, to event of right that it synchronises + -- with. (Left being p1, Right being p2 ps ps). + | PLinkParallel Proc (M.Map Event Event) Proc + | POperator ProcOperator Proc | PPrefix Event Proc + -- Map from Old -> New event + | PRename (M.Relation Event Event) Proc | PSequentialComp Proc Proc | PSlidingChoice Proc Proc - -- TODO: - -- | PLinkParallel EventMap [Proc] - -- | PRename EventMap Proc - -- | POperator ProcOperator Proc - -- where: - -- data ProcOperator = Normalise | Explicate | StrongBisim | TauLoopFactor | Diamond | ModelCompress - | PProcCall ProcName (Maybe Proc) + -- | Labels the process this contains. This allows infinite loops to be + -- spotted. + | PProcCall ProcName Proc instance PrettyPrintable Proc where prettyPrint (PAlphaParallel aps) = @@ -35,23 +89,78 @@ prettyPrint p1 <+> text "[|" <> prettyPrint a <> text "|>" <+> prettyPrint p2 prettyPrint (PExternalChoice ps) = - sep (punctuate (text " []") (map prettyPrint ps)) + sep (punctuateFront (text "[] ") (map prettyPrint ps)) prettyPrint (PGenParallel a ps) = text "||" <+> brackets (prettyPrint a) <+> braces (list (map prettyPrint ps)) prettyPrint (PHide p a) = prettyPrint p <+> char '\\' <+> prettyPrint a prettyPrint (PInternalChoice ps) = - sep (punctuate (text " |~|") (map prettyPrint ps)) + sep (punctuateFront (text "|~| ") (map prettyPrint ps)) prettyPrint (PInterleave ps) = - sep (punctuate (text " |||") (map prettyPrint ps)) + sep (punctuateFront (text "||| ") (map prettyPrint ps)) + prettyPrint (PLinkParallel p1 evm p2) = + prettyPrint p1 <+> text "[" <> + list (map (\(evLeft, evRight) -> prettyPrint evLeft <+> text "<-" + <+> prettyPrint evRight) evm) + <> text "]" <+> prettyPrint p2 + prettyPrint (POperator op p) = + prettyPrint op <> parens (prettyPrint p) prettyPrint (PPrefix e p) = prettyPrint e <+> text "->" <+> prettyPrint p + prettyPrint (PRename evm p) = + prettyPrint p <> text "[[" + <> list (map (\ (evOld, evNew) -> + prettyPrint evOld <+> text "<-" + <+> prettyPrint evNew) evm) + <> text "]]" prettyPrint (PSequentialComp p1 p2) = prettyPrint p1 <+> text "->" <+> prettyPrint p2 prettyPrint (PSlidingChoice p1 p2) = prettyPrint p1 <+> text "|>" <+> prettyPrint p2 - - prettyPrint (PProcCall s _) = text s + prettyPrint (PProcCall n _) = prettyPrint n + instance Show Proc where show p = show (prettyPrint p) + +-- | Given a process, returns the initial process and all processes that it +-- calls. +splitProcIntoComponents :: Proc -> (Proc, [(ProcName, Proc)]) +splitProcIntoComponents p = + let + explored pns n = n `elem` (map fst pns) + + exploreAll :: [(ProcName, Proc)] -> [Proc] -> [(ProcName, Proc)] + exploreAll pns [] = pns + exploreAll pns (p:ps) = exploreAll (explore pns p) ps + + explore :: [(ProcName, Proc)] -> Proc -> [(ProcName, Proc)] + explore pns (PAlphaParallel aps) = exploreAll pns ps + where ps = map snd aps + explore pns (PException p1 _ p2) = exploreAll pns [p1, p2] + explore pns (PExternalChoice ps) = exploreAll pns ps + explore pns (PGenParallel _ ps) = exploreAll pns ps + explore pns (PHide p _) = explore pns p + explore pns (PInternalChoice ps) = exploreAll pns ps + explore pns (PInterrupt p1 p2) = exploreAll pns [p1, p2] + explore pns (PInterleave ps) = exploreAll pns ps + explore pns (PLinkParallel p1 _ p2) = exploreAll pns [p1, p2] + explore pns (POperator _ p) = explore pns p + explore pns (PPrefix _ p) = explore pns p + explore pns (PRename _ p) = explore pns p + explore pns (PSequentialComp p1 p2) = exploreAll pns [p1, p2] + explore pns (PSlidingChoice p1 p2) = exploreAll pns [p1, p2] + explore pns (PProcCall n p) = + if explored pns n then pns + else explore ((n, p):pns) p + in (p, explore [] p) + +-- | Pretty prints the given process and all processes that it depends upon. +prettyPrintAllRequiredProcesses :: Proc -> Doc +prettyPrintAllRequiredProcesses p = + let + (pInit, namedPs) = splitProcIntoComponents p + ppNamedProc (n,p) = + hang (prettyPrint n <+> char '=') tabWidth (prettyPrint p) + in + vcat (punctuate (char '\n') ((map ppNamedProc namedPs)++[prettyPrint pInit])) diff --git a/src/CSPM/DataStructures/Literals.hs b/src/CSPM/DataStructures/Literals.hs new file mode 100644 --- /dev/null +++ b/src/CSPM/DataStructures/Literals.hs @@ -0,0 +1,17 @@ +module CSPM.DataStructures.Literals ( + Literal(..) +) where + +import Util.PrettyPrint + +data Literal = + -- | An integer. This is finite size, as per the FDR spec. + Int Int + -- | A boolean (TODO: remove). + | Bool Bool + deriving (Eq, Show) + +instance PrettyPrintable Literal where + prettyPrint (Int n) = int n + prettyPrint (Bool True) = text "true" + prettyPrint (Bool False) = text "false" diff --git a/src/CSPM/DataStructures/Names.hs b/src/CSPM/DataStructures/Names.hs --- a/src/CSPM/DataStructures/Names.hs +++ b/src/CSPM/DataStructures/Names.hs @@ -1,19 +1,131 @@ {-# LANGUAGE DeriveDataTypeable #-} -module CSPM.DataStructures.Names where +-- | Names used by the evaluator. This is heavily inspired by GHC. +module CSPM.DataStructures.Names ( + -- * Data Types + OccName(..), + UnRenamedName(..), + Name(..), + NameType(..), + -- * Construction Helpers + mkExternalName, mkInternalName, mkWiredInName, mkFreshInternalName, + -- * Utility Functions + isNameDataConstructor, +) where + +import Control.Monad.Trans +import Data.IORef +import Data.Supply import Data.Typeable +import System.IO.Unsafe -data Name = - Name String - | InternalName String - deriving (Eq, Ord, Typeable, Show) +import Util.Annotated +import Util.PrettyPrint -isInternal :: Name -> Bool -isInternal (Name _) = False -isInternal (InternalName _) = True +-- | A name that occurs in the source code somewhere. +data OccName = + OccName String + deriving (Eq, Ord, Show, Typeable) -mkInternalName :: String -> Name -mkInternalName = InternalName +instance PrettyPrintable OccName where + prettyPrint (OccName s) = text s -data QualifiedName = - UnQual Name - deriving (Eq, Show) +-- | A name that has not yet been renamed. Created by the parser. +data UnRenamedName = + UnQual OccName + deriving (Eq, Ord, Show, Typeable) + +instance PrettyPrintable UnRenamedName where + prettyPrint (UnQual n) = prettyPrint n + +-- | A renamed name and is the exclusive type used after the renamer. Names +-- are guaranteed to be unique, meaning that two names are equal iff they +-- refer to the same binding instance. For example, consider the following CSPM +-- code: +-- +-- @ +-- f = 1 +-- g = let f = 2 within (f, f) +-- @ +-- +-- This will be renamed to: +-- +-- @ +-- f0 = 1 +-- g = let f1 = 2 within (f1, f1) +-- @ +-- +data Name = + Name { + -- | The type of this name. + nameType :: NameType, + -- | The original occurence of this name (used for error messages). + nameOccurrence :: !OccName, + -- | Where this name was defined. If this occurs in a pattern, then it + -- will be equal to the location of the pattern, otherwise it will be + -- equal to the location of the definition that this name binds to. + nameDefinition :: !SrcSpan, + -- | The unique identifier for this name. Inserted by the renamer. + nameUnique :: !Int, + -- | Is this name a type constructor, i.e. a datatype or a channel? + nameIsConstructor :: Bool + } + deriving Typeable + +data NameType = + -- | An externally visible name (like a top level definition). + ExternalName + -- | A name created by the renamer, but from the users' source (e.g. from + -- a lambda). + | InternalName + -- | A built in name. + | WiredInName + deriving Eq + +instance Eq Name where + n1 == n2 = nameUnique n1 == nameUnique n2 + +instance Ord Name where + compare n1 n2 = compare (nameUnique n1) (nameUnique n2) + +instance PrettyPrintable Name where + prettyPrint n = prettyPrint (nameOccurrence n) + +instance Show Name where + show n = show (prettyPrint n) + +nameUniqueSupply :: IORef (Supply Int) +nameUniqueSupply = unsafePerformIO (do + s <- newNumSupply + newIORef s) + +takeNameUnique :: MonadIO m => m Int +takeNameUnique = do + s <- liftIO $ readIORef nameUniqueSupply + let (s1, s2) = split2 s + liftIO $ writeIORef nameUniqueSupply s2 + return $ supplyValue s1 + +mkExternalName :: MonadIO m => OccName -> SrcSpan -> Bool -> m Name +mkExternalName o s b = do + u <- takeNameUnique + return $ Name ExternalName o s u b + +mkInternalName :: MonadIO m => OccName -> SrcSpan -> m Name +mkInternalName o s = do + u <- takeNameUnique + return $ Name InternalName o s u False + +mkFreshInternalName :: MonadIO m => m Name +mkFreshInternalName = do + u <- takeNameUnique + let s = 'i':show u + return $ Name InternalName (OccName s) Unknown u False + +mkWiredInName :: MonadIO m => OccName -> Bool -> m Name +mkWiredInName o b = do + u <- takeNameUnique + return $ Name WiredInName o Unknown u b + +-- | Does the given Name correspond to a data type or a channel definition. +isNameDataConstructor :: Name -> Bool +isNameDataConstructor n = nameIsConstructor n diff --git a/src/CSPM/DataStructures/Syntax.hs b/src/CSPM/DataStructures/Syntax.hs --- a/src/CSPM/DataStructures/Syntax.hs +++ b/src/CSPM/DataStructures/Syntax.hs @@ -1,22 +1,75 @@ -module CSPM.DataStructures.Syntax where +-- | This module represents the abstract syntax tree of machine CSP. +-- Most of the datatypes are parameterised over the type of variables that they +-- contain. Before renaming (by 'CSPM.Renamer') the variables are of type +-- 'UnRenamedName', wheras after renaming they are of type 'Name' (and are +-- hence associated with their bindings instances). Furthermore, nearly all +-- pieces of syntax are annoated with their location in the source code, and +-- (sometimes) with their type (but only after type checking). This is done +-- using the 'Annotated' datatype. +module CSPM.DataStructures.Syntax ( + -- * Modules + Module(..), + -- * Declarations + Decl(..), Match(..), + -- ** Assertions + Assertion(..), Model(..), ModelOption(..), SemanticProperty(..), + -- ** Data Type Clauses + DataTypeClause(..), + -- * Expressions + Exp(..), BinaryMathsOp(..), BinaryBooleanOp(..), UnaryMathsOp(..), + UnaryBooleanOp(..), + -- ** Fields + -- | Fields occur within prefix statements. For example, if the prefix + -- was @c$x?y!z@ then there would be three fields, of type 'NonDetInput', + -- 'Input' and 'Output' respectively. + Field(..), + -- ** Statements + -- | Statements occur on the right hand side of a list comprehension, or + -- in the context of replicated operators. For example, in + -- @<... | x <- y, func(b)>@, @x <- y@ and @func(b)@ are both statements, + -- of type 'Generator' and 'Qualifier' respectively. + Stmt(..), + -- * Patterns + -- | Patterns match against values and may bind some components of the + -- values to variables. + Pat(..), + -- * Interactive Statements + -- | Interactive statements are intended to be input by an interactive + -- editor. + InteractiveStmt(..), + -- * Type Synonyms + -- | As the types are parameterised over the type of names it can be + -- laborious to type the names. Therefore, some shortcuts are provided. + AnModule(..), AnDecl(..), AnMatch(..), AnPat(..), AnExp(..), AnField(..), + AnStmt(..), AnDataTypeClause(..), AnAssertion(..), AnInteractiveStmt(..), + -- ** Pre-Renaming Types + PModule(..), PDecl(..), PMatch(..), PPat(..), PExp(..), PField(..), + PStmt(..), PDataTypeClause(..), PAssertion(..), PInteractiveStmt(..), + -- ** Post-Renaming Types + TCModule(..), TCDecl(..), TCMatch(..), TCPat(..), TCExp(..), TCField(..), + TCStmt(..), TCDataTypeClause(..), TCAssertion(..), TCInteractiveStmt(..), + -- * Helpers + getType, getSymbolTable, +) where -import CSPM.DataStructures.Types +import CSPM.DataStructures.Literals import CSPM.DataStructures.Names +import CSPM.DataStructures.Types import Util.Annotated import Util.Exception -- P = post parsing, TC = post typechecking, An = annotated -type AnModule = Annotated () Module +type AnModule id = Annotated () (Module id) -- Declarations may bind multiple names -type AnDecl = Annotated (Maybe SymbolTable, PSymbolTable) Decl -type AnMatch = Annotated () Match -type AnPat = Annotated () Pat -type AnExp = Annotated (Maybe Type, PType) Exp -type AnField = Annotated () Field -type AnStmt = Annotated () Stmt -type AnDataTypeClause = Annotated () DataTypeClause -type AnAssertion = Annotated () Assertion -type AnInteractiveStmt = Annotated () InteractiveStmt +type AnDecl id = Annotated (Maybe SymbolTable, PSymbolTable) (Decl id) +type AnMatch id = Annotated () (Match id) +type AnPat id = Annotated () (Pat id) +type AnExp id = Annotated (Maybe Type, PType) (Exp id) +type AnField id = Annotated () (Field id) +type AnStmt id = Annotated () (Stmt id) +type AnDataTypeClause id = Annotated () (DataTypeClause id) +type AnAssertion id = Annotated () (Assertion id) +type AnInteractiveStmt id = Annotated () (InteractiveStmt id) getType :: Annotated (Maybe Type, PType) a -> Type getType an = case fst (annotation an) of @@ -28,42 +81,33 @@ Just t -> t Nothing -> panic "Cannot get the symbol table of something that is not typechecked" - -type PModule = AnModule -type PDecl = AnDecl -type PMatch = AnMatch -type PPat = AnPat -type PExp = AnExp -type PStmt = AnStmt -type PField = AnField -type PDataTypeClause = AnDataTypeClause -type PAssertion = AnAssertion -type PInteractiveStmt = AnInteractiveStmt - -type TCModule = AnModule -type TCDecl = AnDecl -type TCMatch = AnMatch -type TCPat = AnPat -type TCExp = AnExp -type TCField = AnField -type TCStmt = AnStmt -type TCDataTypeClause = AnDataTypeClause -type TCAssertion = AnAssertion -type TCInteractiveStmt = AnInteractiveStmt +type PModule = AnModule UnRenamedName +type PDecl = AnDecl UnRenamedName +type PMatch = AnMatch UnRenamedName +type PPat = AnPat UnRenamedName +type PExp = AnExp UnRenamedName +type PStmt = AnStmt UnRenamedName +type PField = AnField UnRenamedName +type PDataTypeClause = AnDataTypeClause UnRenamedName +type PAssertion = AnAssertion UnRenamedName +type PInteractiveStmt = AnInteractiveStmt UnRenamedName --- ************************************************************************* --- Basic Components --- ************************************************************************* -data Literal = - Int Integer - | Bool Bool - deriving (Eq, Show) +type TCModule = AnModule Name +type TCDecl = AnDecl Name +type TCMatch = AnMatch Name +type TCPat = AnPat Name +type TCExp = AnExp Name +type TCField = AnField Name +type TCStmt = AnStmt Name +type TCDataTypeClause = AnDataTypeClause Name +type TCAssertion = AnAssertion Name +type TCInteractiveStmt = AnInteractiveStmt Name -- ************************************************************************* -- Modules -- ************************************************************************* -data Module = - GlobalModule [AnDecl] +data Module id = + GlobalModule [AnDecl id] deriving (Eq, Show) -- ************************************************************************* @@ -92,110 +136,344 @@ Divide | Minus | Mod | Plus | Times deriving (Eq, Show) -data Exp = - App AnExp [AnExp] - | BooleanBinaryOp BinaryBooleanOp AnExp AnExp - | BooleanUnaryOp UnaryBooleanOp AnExp - | Concat AnExp AnExp - | DotApp AnExp AnExp - | If AnExp AnExp AnExp - | Lambda AnPat AnExp - | Let [AnDecl] AnExp - | Lit Literal - | List [AnExp] - | ListComp [AnExp] [AnStmt] - | ListEnumFrom AnExp - | ListEnumFromTo AnExp AnExp - -- TODO: ListEnumFrom and ListEnumTO - test in FDR - -- TODO: compare with official CSPM syntax - | ListLength AnExp - | MathsBinaryOp BinaryMathsOp AnExp AnExp - | MathsUnaryOp UnaryMathsOp AnExp - | Paren AnExp - | Set [AnExp] - | SetComp [AnExp] [AnStmt] - | SetEnum [AnExp] -- {| |} - | SetEnumComp [AnExp] [AnStmt] -- {|c.x | x <- xs|} - | SetEnumFrom AnExp - | SetEnumFromTo AnExp AnExp - | Tuple [AnExp] - | Var QualifiedName +-- | An expression. +data Exp id = + -- | Function application. + App { + -- | The function. + appFunction :: AnExp id, + -- | The arguments applied to the function + appArguments :: [AnExp id] + } + -- | Application of a binary boolean operator. + | BooleanBinaryOp { + booleanBinaryOpOperator :: BinaryBooleanOp, + booleanBinaryOpLeftExpression :: AnExp id, + booleanBinaryOpRightExpression :: AnExp id + } + -- | Application of a unary boolean operator. + | BooleanUnaryOp { + unaryBooleanOpOperator :: UnaryBooleanOp, + unaryBooleanExpression :: AnExp id + } + -- | List concatenation, e.g. @x^y@. + | Concat { + concatLeftList :: AnExp id, + concatRightList :: AnExp id + } + -- | Dot operator application, e.g. @c.x@. + | DotApp { + dotAppLeftArgument :: AnExp id, + dotAppRighArgument :: AnExp id + } + -- | If statements, e.g. @if cond then e1 else e2@. + | If { + -- | The condition of the if. + ifCondition :: AnExp id, + -- | The then branch. + ifThenBranch :: AnExp id, + -- The else branch. + ifElseBranch :: AnExp id + } + -- | Lambda functions, e.g. @\(x,y) \@ e(x,y)@. + | Lambda { + lambdaBindingPattern :: AnPat id, + lambdaRightHandSide :: AnExp id + } + -- | Let declarations, e.g. @let func = e1 within e2@. + | Let { + letDeclarations :: [AnDecl id], + letExpression :: AnExp id + } + -- | Literals, e.g. @true@ or @1@. + | Lit { + litLiteral :: Literal + } + -- | List literals, e.g. @<1,2,3>@. + | List { + listItems :: [AnExp id] + } + -- | List comprehensions, e.g. @@. + | ListComp { + listCompItems :: [AnExp id], + listCompStatements :: [AnStmt id] + } + -- | Infinite list of integers from the given value, e.g. @<1..>@. + | ListEnumFrom { + listEnumFromLowerBound :: AnExp id + } + -- | Bounded list of integers between the given values, e.g. @<1..3>@. + | ListEnumFromTo { + listEnumFromToLowerBound :: AnExp id, + listEnumFromToUpperBound :: AnExp id + } + -- | The length of the list, e.g. @#list@. + | ListLength { + listLengthExpression :: AnExp id + } + -- | Application of binary maths operator, e.g. @x+y@. + | MathsBinaryOp { + mathsBinaryOpOperator :: BinaryMathsOp, + mathsBinaryOpLeftExpression :: AnExp id, + mathsBinaryOpRightExpression :: AnExp id + } + -- | Application of unary maths operator, e.g. @-x@. + | MathsUnaryOp { + mathsUnaryOpOperator :: UnaryMathsOp, + mathsUnaryOpExpression :: AnExp id + } + -- | A user provided bracket, e.g. @(e)@. + | Paren { + parenExpression :: AnExp id + } + -- | Set literals, e.g. @{1,2,3}@. + | Set { + setItems :: [AnExp id] + } + -- | Set comprehensions, e.g. @{x,y | (x,y) <- e}@. + | SetComp { + setCompItems :: [AnExp id], + setCompStatements :: [AnStmt id] + } + -- | Enumerated Sets, i.e. sets that complete the events, e.g. @{| c.x |}@. + | SetEnum { + setEnumItems :: [AnExp id] + } + -- | Set comprehension version of 'SetEnum', e.g. @{| c.x | x <- xs |}@. + | SetEnumComp { + setEnumCompItems :: [AnExp id], + setEnumCompStatements :: [AnStmt id] + } + -- | The infinite set of integers from the given value, e.g. @{5..}@. + | SetEnumFrom { + setEnumFromLowerBound :: AnExp id + } + -- | The bounded set of integers between the two given values, e.g. + -- @{5..6}@. + | SetEnumFromTo { + -- | The lower bound. + setEnumFromToLowerBound :: AnExp id, + -- | The upper bound. + setEnumFromToUpperBound :: AnExp id + } + -- | Tuples, e.g. @(1,2)@. + | Tuple { + tupleItems :: [AnExp id] + } + -- | Variables, e.g. @x@. + | Var { + varIdentity :: id + } -- Processes - | AlphaParallel AnExp AnExp AnExp AnExp -- Proc Alpha Alpha Proc - | Exception AnExp AnExp AnExp -- Proc Alpha Proc - | ExternalChoice AnExp AnExp - | GenParallel AnExp AnExp AnExp -- Proc Alpha Proc - | GuardedExp AnExp AnExp -- b & P - | Hiding AnExp AnExp - | InternalChoice AnExp AnExp - | Interrupt AnExp AnExp - | Interleave AnExp AnExp - | LinkParallel AnExp [(AnExp, AnExp)] [AnStmt] AnExp -- Exp, tied chans, generators, second - | Prefix AnExp [AnField] AnExp - | Rename AnExp [(AnExp, AnExp)] [AnStmt] - | SequentialComp AnExp AnExp -- P; Q - | SlidingChoice AnExp AnExp + -- | Alphabetised parallel, e.g. @P [A || B] Q@. + | AlphaParallel { + -- | Process 1. + alphaParLeftProcess :: AnExp id, + -- | Alphabet of process 1. + alphaParAlphabetLeftProcess :: AnExp id, + -- | Alphabet of process 2. + alphaParAlphabetRightProcess :: AnExp id, + -- | Process 2. + alphaParRightProcess :: AnExp id + } + -- | Exception operator, e.g. @P [| A |> Q@. + | Exception { + exceptionLeftProcess :: AnExp id, + exceptionAlphabet :: AnExp id, + exceptionRightProcess :: AnExp id + } + -- | External choice, e.g. @P [] Q@. + | ExternalChoice { + extChoiceLeftProcess :: AnExp id, + extChoiceRightOperator :: AnExp id + } + -- | Generalised parallel, e.g. @P [| A |] Q@. + | GenParallel { + genParallelLeftProcess :: AnExp id, + genParallelAlphabet :: AnExp id, + genParallelRightProcess :: AnExp id + } + -- | Guarded expressions, e.g. @b & P@ where @b@ is a boolean expression. + -- This is equivalent to @if b then P else STOP@. + | GuardedExp { + guardedExpCondition :: AnExp id, + guardedExpProcess :: AnExp id + } + -- | Hiding of events, e.g. @P \ A@. + | Hiding { + -- | The process the hiding is applied to. + hidingProcess :: AnExp id, + -- | The set of events to be hidden. + hidingAlphabet :: AnExp id + } + -- | Internal choice, e.g. @P |~| Q@. + | InternalChoice { + intChoiceLeftProcess :: AnExp id, + intChoiceRightProcess :: AnExp id + } + -- | Interrupt (where the left process is turned off once the right process + -- performs an event), e.g. @P /\ Q@. + | Interrupt { + interruptLeftProcess :: AnExp id, + interruptRightProcess :: AnExp id + } + -- | Interleaving of processes, e.g. @P ||| Q@. + | Interleave { + interleaveLeftProcess :: AnExp id, + interleaveRightProcess :: AnExp id + } + -- Linked parallel, e.g. @P [a.x <- b.x | x <- X] Q@. + | LinkParallel { + linkParLeftProcess :: AnExp id, + linkParTiedEvents :: [(AnExp id, AnExp id)], + linkParTieStatements :: [AnStmt id], + linkParRightProcess :: AnExp id + } + -- | Event prefixing, e.g. @c$x?y!z -> P@. + | Prefix { + prefixChannel :: AnExp id, + prefixFields :: [AnField id], + prefixProcess :: AnExp id + } + -- | Event renaming, e.g. @P [[ a.x <- b.x | x <- X ]]@. + | Rename { + -- | The process that is renamed. + renameProcess :: AnExp id, + -- | The events that are renamed, in the format of @(old, new)@. + renameTiedEvents :: [(AnExp id, AnExp id)], + -- | The statements for the ties. + renameTieStatements :: [AnStmt id] + } + -- | Sequential composition, e.g. @P; Q@. + | SequentialComp { + seqCompLeftProcess :: AnExp id, + seqCompRightProcess :: AnExp id + } + -- | Sliding choice, e.g. @P |> Q@. + | SlidingChoice { + slidingChoiceLeftProcess :: AnExp id, + slidingChoiceRightProcess :: AnExp id + } + -- Replicated Operators - | ReplicatedAlphaParallel [AnStmt] AnExp AnExp -- alpha exp is second - | ReplicatedExternalChoice [AnStmt] AnExp - | ReplicatedInterleave [AnStmt] AnExp - | ReplicatedInternalChoice [AnStmt] AnExp - | ReplicatedLinkParallel [(AnExp, AnExp)] [AnStmt] AnExp - | ReplicatedParallel AnExp [AnStmt] AnExp -- alpha exp is first + -- | Replicated alphabetised parallel, e.g. @|| x : X \@ [| A(x) |] P(x)@. + | ReplicatedAlphaParallel { + repAlphaParReplicatedStatements :: [AnStmt id], + repAlphaParAlphabet :: AnExp id, + repAlphaParProcess :: AnExp id + } + -- | Replicated external choice, e.g. @[] x : X \@ P(x)@. + | ReplicatedExternalChoice { + repExtChoiceReplicatedStatements :: [AnStmt id], + repExtChoiceProcess :: AnExp id + } + -- | Replicated interleave, e.g. @||| x : X \@ P(x)@. + | ReplicatedInterleave { + repInterleaveReplicatedStatements :: [AnStmt id], + repInterleaveProcess :: AnExp id + } + -- | Replicated internal choice, e.g. @|~| x : X \@ P(x)@. + | ReplicatedInternalChoice { + repIntChoiceReplicatedStatements :: [AnStmt id], + repIntChoiceProcess :: AnExp id + } + -- | Replicated link parallel, e.g. + -- @[a.x <- b.x | x <- X(y)] y : Y \@ P(y)@. + | ReplicatedLinkParallel { + -- | The tied events. + repLinkParTiedChannels :: [(AnExp id, AnExp id)], + -- | The statements for the ties. + repLinkParTieStatements :: [AnStmt id], + -- | The 'Stmt's - the process (and ties) are evaluated once for each + -- value generated by these. + repLinkParReplicatedStatements :: [AnStmt id], + -- | The process + repLinkParProcess :: AnExp id + } + -- | Replicated parallel, e.g. @[| A |] x : X \@ P(x)@. + | ReplicatedParallel { + repParAlphabet :: AnExp id, + repParReplicatedStatements :: [AnStmt id], + repParProcess :: AnExp id + } - -- Used only for parsing + -- | Used only for parsing - never appears in an AST. | ExpPatWildCard - | ExpPatDoublePattern AnExp AnExp + -- | Used only for parsing - never appears in an AST. + | ExpPatDoublePattern (AnExp id) (AnExp id) deriving (Eq, Show) -data Field = - -- | !x - Output AnExp - -- | ?x:A - | Input AnPat (Maybe AnExp) - -- | $x:A (see P395 UCS) - | NonDetInput AnPat (Maybe AnExp) +data Field id = + -- | @!x@ + Output (AnExp id) + -- | @?x:A@ + | Input (AnPat id) (Maybe (AnExp id)) + -- | @$x:A@ (see P395 UCS) + | NonDetInput (AnPat id) (Maybe (AnExp id)) deriving (Eq, Show) -data Stmt = - Generator AnPat AnExp - | Qualifier AnExp +data Stmt id = + Generator (AnPat id) (AnExp id) + | Qualifier (AnExp id) deriving (Eq, Show) --- A statement in an interactive session -data InteractiveStmt = - Evaluate AnExp - | Bind AnDecl - | RunAssertion Assertion +-- | A statement in an interactive session. +data InteractiveStmt id = + Evaluate (AnExp id) + | Bind (AnDecl id) + | RunAssertion (Assertion id) deriving Show -- ************************************************************************* -- Declarations -- ************************************************************************* -data Decl = - -- Third argument is the annotated type - FunBind Name [AnMatch] - | PatBind AnPat AnExp - | Assert Assertion - | External [Name] - | Transparent [Name] - -- The expression in the following three definitions means a type expression - -- and therefore dots and commas have special meanings. See TPC P529 for - -- details (or the typechecker or evaluator). - | Channel [Name] (Maybe AnExp) - | DataType Name [AnDataTypeClause] - | NameType Name AnExp + +data Decl id = + -- | A function binding, e.g. @func(x,y)(z) = 0@. + FunBind id [AnMatch id] + -- | The binding of a pattern to an expression, e.g. @(p,q) = e@. + | PatBind (AnPat id) (AnExp id) + -- | An assertion in a file, e.g. @assert P [T= Q@. + | Assert (Assertion id) + -- | An import of an external function, e.g. @external test@, + | External { + externalImportedNames :: [id] + } + -- | An import of a transparent function, e.g. @transparent normal@. + | Transparent { + transparentImportedNames :: [id] + } + -- | A channel declaration, e.g. @channel c, d : {0..1}.{0..1}@. + | Channel [id] (Maybe (AnExp id)) + -- | A datatype declaration, e.g. @datatype T = Clause1 | Clause2@. + | DataType id [AnDataTypeClause id] + -- | A nametype declaration, e.g. @nametype T2 = T.T@. + | NameType id (AnExp id) deriving (Eq, Show) -- TODO: annotate -data Assertion = - Refinement AnExp Model AnExp [ModelOption] - | PropertyCheck AnExp SemanticProperty (Maybe Model) - | BoolAssertion AnExp - | ASNot Assertion +data Assertion id = + -- | A refinement assertion, e.g. @assert P [F= Q@. + Refinement { + refinementSpecification :: AnExp id, + refinementModel :: Model, + refinementImplementation :: AnExp id, + refinementModelOptions :: [ModelOption id] + } + -- | A check of property, like deadlock freedom, e.g. + -- @assert P :[deadlock free [F]]@. + | PropertyCheck { + propertyCheckProcess :: AnExp id, + propertyCheckProperty :: SemanticProperty, + propertyCheckModel :: Maybe Model + } + -- | A boolean assertion, not currently supported. + | BoolAssertion (AnExp id) + -- | The negation of an assertion, not currently supported. + | ASNot (Assertion id) deriving (Eq, Show) data Model = @@ -208,8 +486,8 @@ | RevivalsDivergences deriving (Eq, Show) -data ModelOption = - TauPriority AnExp +data ModelOption id = + TauPriority (AnExp id) deriving (Eq, Show) data SemanticProperty = @@ -219,43 +497,114 @@ deriving (Eq, Show) -- TODO: annotate -data DataTypeClause = - DataTypeClause Name (Maybe AnExp) +-- | The clause of a datatype, e.g. if a datatype declaration was: +-- +-- > datatype T = A.Int.Bool | B.Bool | C +-- +-- Then T would have three datatype clauses, one for each of its tags (i.e. +-- @A@, @B@ and @C@). +data DataTypeClause id = + DataTypeClause { + -- | The name of the datatype clause. + dataTypeClauseName :: id, + -- | The expression that gives the set of values that can be dotted + -- with this clause. For example, in the above example the datatype + -- clause for A would have "Int.Bool" as its type expression. + dataTypeClauseTypeExpression :: Maybe (AnExp id) + } deriving (Eq, Show) -data Match = - Match [[AnPat]] AnExp +-- | Matches occur on the left hand side of a function declaration and there +-- is one 'Match' for each clause of the declaration. For example, given the +-- declaration: +-- +-- @ +-- f(<>) = 0 +-- f(^xs) = 1+f(xs) +-- @ +-- +-- there would be two matches. +data Match id = + Match { + -- | The patterns that need to be matched. This is a list of lists as + -- functions may be curried, like @f(x,y)(z) = ...@. + matchPatterns :: [[AnPat id]], + -- | The expression to be evaluated if the match succeeds. + matchRightHandSide :: AnExp id + } deriving (Eq, Show) -data Pat = - PConcat AnPat AnPat - | PDotApp AnPat AnPat - | PDoublePattern AnPat AnPat - | PList [AnPat] - | PLit Literal - | PParen AnPat - | PSet [AnPat] - | PTuple [AnPat] - | PVar Name +data Pat id = + -- | The concatenation of two patterns, e.g. @p1^p2@. + PConcat { + pConcatLeftPat :: AnPat id, + pConcatRightPat :: AnPat id + } + -- | The dot of two patterns, e.g. @p1.p2@. + | PDotApp { + pDotLeftPat :: AnPat id, + pDotRightPat :: AnPat id + } + -- | A double pattern match, e.g. @p1\@\@p2@. + | PDoublePattern { + pDoublePatLeftPat :: AnPat id, + pDoublePatRightPat :: AnPat id + } + -- | A literal pattern list, e.g. @@. + | PList { + pListItems :: [AnPat id] + } + -- | A literal pattern, e.g. @true@, or @0@. + | PLit { + pLitLiteral :: Literal + } + -- | A user supplied parenthesis in a pattern. + | PParen { + pParenPattern :: AnPat id + } + -- | A set pattern. Only singleton patterns, or zero patterns are supported. + -- This is checked by the desugarer. For example, @{p1,p2}@ is not allowed, + -- but @{p1}@ and @{}@ are allowed. + | PSet { + pSetItems :: [AnPat id] + } + -- | A tuple pattern, e.g. @(p1,p2,p3)@. + | PTuple { + pTupleItems :: [AnPat id] + } + -- | A variable pattern, e.g. @x@, or @A@ where @A@ is a datatype clause. + -- If the variable is a datatype clause then it only matches that datatype + -- tag, whereas for anything else it matches anything. + | PVar { + pVarIdentity :: id + } + -- | Matches anything but does not bind it. | PWildCard - -- In all compiled patterns we store the original pattern - -- Because of the fact that you can write patterns such as: - -- f(^xs^) - -- f() - -- f(xs^) + -- | Since you can write list patterns such as: + -- + -- > f(^xs^^<9,0>) + -- > f() + -- > f(xs^) + -- -- we need an easy may of matching them. Thus, we compile - -- the patterns to a PCompList instead. - -- PCompList ps (Just (p, ps')) corresponds to a list + -- the patterns to a @PCompList@ instead. + -- + -- @PCompList ps (Just (p, ps'))@ corresponds to a list -- where it starts with ps (where each p in ps matches exactly one - -- component, has a middle of p and and end matching exactly ps' - | PCompList [AnPat] (Maybe (AnPat, [AnPat])) Pat - -- Recall the longest match rule when evaluating this - -- How about: - -- channel c : A.Int.A - -- datatype A = B.Bool - -- func(c.B.true.x) = - -- func(c.B.false.0.B.x) = - | PCompDot [AnPat] Pat + -- list element, has a middle of p (which must be a variable pattern, + -- or a wildcard) and and end matching exactly ps' (again, where each p + -- in ps matches exactly one list component). + | PCompList { + pListStartItems :: [AnPat id], + pListMiddleEndItems :: Maybe (AnPat id, [AnPat id]), + pListOriginalPattern :: Pat id + } + -- | Like with a 'PCompList' we flatten nested dot patterns to make it + -- easier to evaluate. + | PCompDot { + pDotItems :: [AnPat id], + pDotOriginalpattern :: Pat id + } deriving (Eq, Show) diff --git a/src/CSPM/DataStructures/Tokens.hs b/src/CSPM/DataStructures/Tokens.hs --- a/src/CSPM/DataStructures/Tokens.hs +++ b/src/CSPM/DataStructures/Tokens.hs @@ -9,7 +9,7 @@ import Util.PrettyPrint data Token = - TInteger Integer + TInteger Int | TFalse | TTrue | TIdent String @@ -107,7 +107,7 @@ show t = show (prettyPrint t) instance PrettyPrintable Token where - prettyPrint (TInteger i) = integer i + prettyPrint (TInteger i) = int i prettyPrint TFalse = text "false" prettyPrint TTrue = text "true" prettyPrint (TIdent s) = text s diff --git a/src/CSPM/DataStructures/Types.hs b/src/CSPM/DataStructures/Types.hs --- a/src/CSPM/DataStructures/Types.hs +++ b/src/CSPM/DataStructures/Types.hs @@ -1,8 +1,23 @@ -module CSPM.DataStructures.Types where +module CSPM.DataStructures.Types ( + -- * Data Structures + TypeVar, TypeScheme(..), Constraint(..), Type(..), TypeVarRef(..), + prettyPrintTypes, + -- * Creation of Types + freshTypeVar, freshTypeVarWithConstraints, + -- * Symbol Tables + SymbolTable, PSymbolTable, freshPSymbolTable, readPSymbolTable, + setPSymbolTable, + + -- * Type Pointers + PType, freshPType, readPType, setPType, +) where + import Control.Monad.Trans import Data.IORef import Data.List +import Data.Supply +import System.IO.Unsafe import CSPM.DataStructures.Names import Util.PartialFunctions @@ -18,7 +33,7 @@ deriving (Eq, Show) data Constraint = - Eq | Ord + Eq | Ord | Inputable deriving (Eq, Ord, Show) -- During Type Checking we use TDotable a b only when a is something @@ -53,6 +68,29 @@ instance Show TypeVarRef where show (TypeVarRef tv cs _) = "TypeVarRef "++show tv ++ show cs +typeVarSupply :: IORef (Supply Int) +typeVarSupply = unsafePerformIO (do + s <- newNumSupply + newIORef s) + +takeTypeVarFromSupply :: MonadIO m => m TypeVar +takeTypeVarFromSupply = do + s <- liftIO $ readIORef typeVarSupply + let (s1, s2) = split2 s + liftIO $ writeIORef typeVarSupply s2 + return $ TypeVar $ supplyValue s1 + +freshTypeVar :: MonadIO m => m Type +freshTypeVar = freshTypeVarWithConstraints [] + +freshTypeVarWithConstraints :: MonadIO m => [Constraint] -> m Type +freshTypeVarWithConstraints cs = do + tv <- takeTypeVarFromSupply + ioRef <- freshPType + return $ TVar (TypeVarRef tv cs ioRef) + + + newtype IORefMaybe a = IORefMaybe (Maybe a) type SymbolTable = PartialFunction Name TypeScheme type PType = IORef (Maybe Type) @@ -79,6 +117,7 @@ instance PrettyPrintable Constraint where prettyPrint Eq = text "Eq" prettyPrint Ord = text "Ord" + prettyPrint Inputable = text "Inputable" -- | Pretty prints several types using the same variable substitutions prettyPrintTypes :: [Type] -> [Doc] @@ -133,7 +172,7 @@ ) <> text "." <> prettyPrintType vmap t2 prettyPrintType vmap (TDotable t1 t2) = prettyPrintType vmap t1 <> text "=>" <> prettyPrintType vmap t2 -prettyPrintType vmap (TDatatype (Name n)) = text n +prettyPrintType vmap (TDatatype n) = prettyPrint n prettyPrintType vmap (TBool) = text "Bool" prettyPrintType vmap (TInt) = text "Int" diff --git a/src/CSPM/Desugar.hs b/src/CSPM/Desugar.hs --- a/src/CSPM/Desugar.hs +++ b/src/CSPM/Desugar.hs @@ -1,6 +1,8 @@ {-# LANGUAGE FlexibleInstances #-} module CSPM.Desugar where +import CSPM.DataStructures.Literals +import CSPM.DataStructures.Names import CSPM.DataStructures.Syntax import CSPM.DataStructures.Types import CSPM.PrettyPrinter @@ -26,10 +28,10 @@ instance (Desugarable a, Desugarable b) => Desugarable (a,b) where desugar (a,b) = (desugar a, desugar b) -instance Desugarable Module where +instance Desugarable (Module Name) where desugar (GlobalModule ds) = GlobalModule (desugar ds) -instance Desugarable Decl where +instance Desugarable (Decl Name) where desugar (FunBind n ms) = FunBind n (desugar ms) desugar (PatBind p e) = PatBind (desugar p) (desugar e) desugar (Assert a) = Assert (desugar a) @@ -39,22 +41,22 @@ desugar (DataType n cs) = DataType n (desugar cs) desugar (NameType n e) = NameType n (desugar e) -instance Desugarable Assertion where +instance Desugarable (Assertion Name) where desugar (Refinement e1 m e2 opts) = Refinement (desugar e1) m (desugar e2) (desugar opts) desugar (PropertyCheck e p m) = PropertyCheck (desugar e) p m -instance Desugarable ModelOption where +instance Desugarable (ModelOption Name) where desugar (TauPriority e) = TauPriority (desugar e) -instance Desugarable DataTypeClause where +instance Desugarable (DataTypeClause Name) where desugar (DataTypeClause n me) = DataTypeClause n (desugar me) -instance Desugarable Match where +instance Desugarable (Match Name) where desugar (Match pss e) = Match (desugar pss) (desugar e) -instance Desugarable Exp where +instance Desugarable (Exp Name) where desugar (App e es) = App (desugar e) (desugar es) desugar (BooleanBinaryOp op e1 e2) = BooleanBinaryOp op (desugar e1) (desugar e2) @@ -77,7 +79,7 @@ -- We don't remove the Paren as people may pretty print a desugared -- expression, which would then not have parenthesis needed to -- remove ambiguity - desugar (Paren e) = Paren (desugar e) + desugar (Paren e) = unAnnotate (desugar e) desugar (Set es) = Set (desugar es) desugar (SetComp es stmts) = SetComp (desugar es) (desugar stmts) desugar (SetEnum es) = SetEnum (desugar es) @@ -117,30 +119,31 @@ ReplicatedInternalChoice (desugar stmts) (desugar e) desugar (ReplicatedParallel stmts e1 e2) = ReplicatedParallel (desugar stmts) (desugar e1) (desugar e2) - desugar (ReplicatedLinkParallel ties stmts e) = - ReplicatedLinkParallel (desugar ties) (desugar stmts) (desugar e) + desugar (ReplicatedLinkParallel ties tiesStmts stmts e) = + ReplicatedLinkParallel (desugar ties) (desugar tiesStmts) + (desugar stmts) (desugar e) -instance Desugarable Field where +instance Desugarable (Field Name) where desugar (Output e) = Output (desugar e) desugar (Input p e) = Input (desugar p) (desugar e) desugar (NonDetInput p e) = NonDetInput (desugar p) (desugar e) -instance Desugarable Stmt where +instance Desugarable (Stmt Name) where desugar (Generator p e) = Generator (desugar p) (desugar e) desugar (Qualifier e) = Qualifier (desugar e) -instance Desugarable InteractiveStmt where +instance Desugarable (InteractiveStmt Name) where desugar (Bind d) = Bind (desugar d) desugar (Evaluate e) = Evaluate (desugar e) desugar (RunAssertion a) = RunAssertion (desugar a) -instance Desugarable Pat where +instance Desugarable (Pat Name) where desugar (PConcat p1 p2) = let combine (as1, Just (p, bs1)) (as2, Nothing) = (as1, Just (p, bs1++as2)) combine (as1, Nothing) (as2, p) = (as1++as2, p) - extractCompList :: AnPat -> ([AnPat], Maybe (AnPat, [AnPat])) + extractCompList :: TCPat -> ([TCPat], Maybe (TCPat, [TCPat])) extractCompList (An _ _ (PCompList ps mp _)) = (ps, mp) extractCompList p = ([], Just (p, [])) @@ -162,7 +165,7 @@ -- We don't remove the Paren as people may pretty print a desugared -- expression, which would then not have parenthesis needed to -- remove ambiguity - desugar (PParen p) = PParen (desugar p) + desugar (PParen p) = unAnnotate (desugar p) desugar (PSet []) = PSet [] desugar (PSet [p]) = PSet [desugar p] desugar (PSet ps) = throwSourceError [mkErrorMessage l err] @@ -170,7 +173,7 @@ -- TODO: get a proper location for the whole -- pattern l = loc (head ps) - err = prettyPrint (PSet ps) <+> text "is not a valid set pattern as set patterns may only match at most one element" + err = prettyPrint (PSet ps) <+> text "is not a valid set pattern as set patterns may only match at most one element." desugar (PTuple ps) = PTuple (map desugar ps) desugar (PVar n) = PVar n desugar (PWildCard) = PWildCard diff --git a/src/CSPM/Evaluator.hs b/src/CSPM/Evaluator.hs --- a/src/CSPM/Evaluator.hs +++ b/src/CSPM/Evaluator.hs @@ -34,17 +34,16 @@ evaluateExp e = eval e -- | Evaluates the declaration but doesn't add it to the current environment. -evaluateDecl :: TCDecl -> EvaluationMonad [(Name, Value)] -evaluateDecl d = bindDecls [d] +evaluateDecl :: TCDecl -> EvaluationMonad [(Name, EvaluationMonad Value)] +evaluateDecl d = return $ bindDecls [d] -- | Evaluates the declaration but doesn't add it to the current environment. -evaluateFile :: [TCModule] -> EvaluationMonad [(Name, Value)] -evaluateFile ms = bindModules ms +evaluateFile :: [TCModule] -> EvaluationMonad [(Name, EvaluationMonad Value)] +evaluateFile ms = return $ bindModules ms getBoundNames :: EvaluationMonad [Name] getBoundNames = - getEnvironment >>= return . filter (not . isInternal) . map fst . flatten + getEnvironment >>= return . filter (\n -> nameType n == ExternalName) . map fst . toList -addToEnvironment - :: EvaluationMonad [(Name, Value)] -> EvaluationMonad EvaluationState +addToEnvironment :: [(Name, EvaluationMonad Value)] -> EvaluationMonad EvaluationState addToEnvironment bs = addScopeAndBindM bs getState diff --git a/src/CSPM/Evaluator/BuiltInFunctions.hs b/src/CSPM/Evaluator/BuiltInFunctions.hs --- a/src/CSPM/Evaluator/BuiltInFunctions.hs +++ b/src/CSPM/Evaluator/BuiltInFunctions.hs @@ -1,24 +1,35 @@ -module CSPM.Evaluator.BuiltInFunctions where +module CSPM.Evaluator.BuiltInFunctions ( + injectBuiltInFunctions, + builtInName +) where import Control.Monad +import qualified Data.Map as M import qualified CSPM.Compiler.Set as CS import CSPM.DataStructures.Names +import CSPM.Evaluator.Exceptions import CSPM.Evaluator.Monad import CSPM.Evaluator.Values import qualified CSPM.Evaluator.ValueSet as S +import CSPM.Prelude import Util.Exception +bMap = M.fromList [(stringName b, name b) | b <- builtins True] +builtInName s = M.findWithDefault (panic "builtin not found") s bMap + builtInFunctions :: [(Name, Value)] builtInFunctions = let + nameForString s = builtInName s cspm_union [VSet s1, VSet s2] = S.union s1 s2 cspm_inter [VSet s1, VSet s2] = S.intersection s1 s2 cspm_diff [VSet s1, VSet s2] = S.difference s1 s2 - cspm_Union ss = S.unions (map (\ (VSet s) -> s) ss) - cspm_Inter ss = S.intersections (map (\ (VSet s) -> s) ss) + cspm_Union [VSet s] = S.unions (map (\ (VSet s) -> s) (S.toList s)) + cspm_Inter [VSet s] = + S.intersections (map (\ (VSet s) -> s) (S.toList s)) cspm_member [v, VSet s] = VBool $ S.member v s - cspm_card [VSet s] = VInt $ S.card s + cspm_card [VSet s] = VInt $ fromIntegral $ S.card s cspm_empty [VSet s] = VBool $ S.empty s cspm_set [VList xs] = S.fromList xs cspm_Set [VSet s] = S.powerset s @@ -27,20 +38,30 @@ cspm_seq [VSet s] = S.toList s - cspm_length [VList xs] = VInt $ (toInteger (length xs)) + cspm_length [VList xs] = VInt $ length xs cspm_null [VList xs] = VBool $ null xs - cspm_head [VList xs] = head xs - cspm_tail [VList xs] = tail xs + cspm_head [VList []] = throwError headEmptyListMessage + cspm_head [VList (x:xs)] = x + cspm_tail [VList []] = throwError tailEmptyListMessage + cspm_tail [VList (x:xs)] = xs cspm_concat [VList xs] = concat (map (\(VList ys) -> ys) xs) cspm_elem [v, VList vs] = VBool $ v `elem` vs - csp_chaos [VSet a] = VProc $ PProcCall n (Just p) + csp_chaos [VSet a] = VProc chaosCall where - n = procId (Name "CHAOS") [[VSet a]] + chaosCall = PProcCall n p + n = procId (nameForString "CHAOS") [[VSet a]] evSet = S.valueSetToEventSet a - branches = [PPrefix ev (PProcCall n Nothing) | ev <- CS.toList evSet] - stopProc = PProcCall (procId (Name "STOP") []) (Just csp_stop) + branches = [PPrefix ev chaosCall | ev <- CS.toList evSet] + stopProc = PProcCall (procId (nameForString "STOP") []) csp_stop p = PInternalChoice (stopProc:branches) + cspm_extensions [v] = do + exs <- extensions v + return $ VSet $ S.fromList exs + cspm_productions [v] = do + exs <- productions v + return $ VSet $ S.fromList exs + -- | Functions that return sets set_funcs = [ ("union", cspm_union), ("inter", cspm_inter), @@ -54,6 +75,18 @@ ("seq", cspm_seq), ("tail", cspm_tail), ("concat", cspm_concat) ] + -- | Functions that mutate processes (like compression functions). + proc_operators = [ + ("chase", Chase), + ("diamond", Diamond), + ("explicate", Explicate), + ("normal", Normalize), + ("model_compress", ModelCompress), + ("sbisim", StrongBisim), + ("tau_loop_factor", TauLoopFactor), + ("wbisim", WeakBisim) + ] + -- | Functions that return something else other_funcs = [ ("length", cspm_length), ("null", cspm_null), @@ -61,33 +94,50 @@ ("member", cspm_member), ("card", cspm_card), ("empty", cspm_empty), ("CHAOS", csp_chaos) ] - - mkFunc (s, f) = (Name s, VFunction (\ vs -> return (f vs))) + + -- | Functions that require a monadic context. + monadic_funcs = [ + ("productions", cspm_productions), ("extensions", cspm_extensions) + ] + mkFunc (s, f) = (nameForString s, VFunction (\ vs -> return (f vs))) + mkMonadicFunc (s, f) = (nameForString s, VFunction f) + procs = [ - (csp_stop_id, csp_stop), - (csp_skip_id, PPrefix Tick (PProcCall csp_stop_id (Just csp_stop))) + ("STOP", csp_stop), + ("SKIP", PPrefix Tick (PProcCall csp_stop_id csp_stop)) ] - csp_skip_id = procId (Name "SKIP") [] - csp_stop_id = procId (Name "STOP") [] + csp_skip_id = procId (nameForString "SKIP") [] + csp_stop_id = procId (nameForString "STOP") [] csp_stop = PExternalChoice [] - mkProc (s, p) = (Name s, VProc p) + mkProc (s, p) = (nameForString s, VProc p) cspm_true = ("true", VBool True) cspm_false = ("false", VBool False) cspm_True = ("True", VBool True) cspm_False = ("False", VBool False) - constants = [cspm_true, cspm_false, cspm_True, cspm_False] + cspm_Bool = ("Bool", VSet (S.fromList [snd cspm_true, snd cspm_false])) + cspm_Int = ("Int", VSet S.Integers) + cspm_Proc = ("Proc", VSet S.Processes) + cspm_Events = ("Events", panic "Events not implemented") + + constants = [ + cspm_true, cspm_false, cspm_True, cspm_False, + cspm_Bool, cspm_Int, cspm_Proc, cspm_Events + ] - mkConstant (s, v) = (Name s, v) + mkConstant (s, v) = (nameForString s, v) in map mkFunc ( map (\ (n, f) -> (n, VSet . f)) set_funcs ++ map (\ (n, f) -> (n, VList . f)) seq_funcs + ++ map (\ (n, po) -> + (n,\[VProc p]-> VProc $ POperator po p)) proc_operators ++ other_funcs) + ++ map mkMonadicFunc monadic_funcs ++ map mkProc procs ++ map mkConstant constants diff --git a/src/CSPM/Evaluator/DeclBind.hs b/src/CSPM/Evaluator/DeclBind.hs --- a/src/CSPM/Evaluator/DeclBind.hs +++ b/src/CSPM/Evaluator/DeclBind.hs @@ -1,10 +1,12 @@ -{-# LANGUAGE TypeSynonymInstances #-} +{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-} module CSPM.Evaluator.DeclBind ( - bindDecls, valuesForChannel, valuesForDataTypeClause, + bindDecls, + --valuesForChannel, valuesForDataTypeClause, ) where import Control.Monad import Data.Maybe +import System.IO.Unsafe import CSPM.DataStructures.Names import CSPM.DataStructures.Syntax @@ -15,25 +17,28 @@ import CSPM.Evaluator.Values import CSPM.Evaluator.ValueSet import Util.Annotated +import Util.Exception +import qualified Util.List as UL +import Util.Monad -bindDecls :: [TCDecl] -> EvaluationMonad [(Name, Value)] -bindDecls ds = do - bss <- mapM bindDecl ds - return (concat bss) +-- | Given a list of declarations, returns a sequence of names bounds to +-- values that can be passed to 'addScopeAndBind' in order to bind them in +-- the current scope. +bindDecls :: [TCDecl] -> [(Name, EvaluationMonad Value)] +bindDecls ds = concatMap bindDecl ds -bindDecl :: AnDecl -> EvaluationMonad [(Name, Value)] -bindDecl (an@(An _ _ (FunBind n ms))) = do - func <- collectArgs argGroupCount [] - return [(n, func)] +bindDecl :: TCDecl -> [(Name, EvaluationMonad Value)] +bindDecl (an@(An _ _ (FunBind n ms))) = [(n, collectArgs argGroupCount [])] where mss = map unAnnotate ms argGroupCount = head (map (\ (Match pss e) -> length pss) mss) collectArgs :: Int -> [[Value]] -> EvaluationMonad Value collectArgs 0 ass_ = do bss <- mapM (\ (Match pss e) -> do - r <- zipWithM bindAll pss ass - let b = and (map fst r) - let binds = concatMap snd r + let + r = zipWith bindAll pss ass + b = and (map fst r) + binds = concatMap snd r return ((b, binds), e) ) mss let @@ -45,7 +50,7 @@ v <- eval exp case v of VProc p -> - return $ VProc $ PProcCall (procId n ass) (Just p) + return $ VProc $ PProcCall (procId n ass) p _ -> return v) _ -> throwError $ funBindPatternMatchFailureMessage (loc an) n ass @@ -53,68 +58,86 @@ ass = reverse ass_ collectArgs n ass = return $ VFunction $ \ vs -> collectArgs (n-1) (vs:ass) -bindDecl (an@(An _ _ (PatBind p e))) = do - v <- eval e - r <- bind p v - case r of - (True, bs) -> return bs - (False, _) -> throwError $ patternMatchFailureMessage (loc an) p v -bindDecl (an@(An _ _ (Channel ns me))) = do - -- TODO: check channel values are in es - vs <- case me of - Nothing -> return [] - Just e -> do - v <- eval e - return $ evalTypeExprToList v - return $ [(n, VEvent n []) | n <- ns]++ - [(internalNameForChannel n, VTuple (map VSet vs)) | n <- ns] +bindDecl (an@(An _ _ (PatBind p e))) = + let + -- We put p inside the unsafePerformIO simply to prevent it being + -- lifed out of the lambda (and thus only being performed once). + nV = unsafePerformIO (p `seq` mkFreshInternalName) + {-# NOINLINE nV #-} + extractor :: Name -> EvaluationMonad Value + extractor n = do + v <- lookupVar nV + let + nvs = case bind p v of + (True, nvs) -> nvs + (False, _) -> throwError $ + patternMatchFailureMessage (loc an) p v + return $ head [v | (n', v) <- nvs, n' == n] + in (nV, eval e):[(fv, extractor fv) | fv <- freeVars p] +bindDecl (an@(An _ _ (Channel ns me))) = + let + mkChan :: Name -> EvaluationMonad Value + mkChan n = do + vss <- case me of + Just e -> eval e >>= return . evalTypeExprToList + Nothing -> return [] + + let arity = fromIntegral (length vss) + return $ VTuple [VDot [VChannel n], VInt arity, VList (map VList vss)] + in [(n, mkChan n) | n <- ns] bindDecl (an@(An _ _ (DataType n cs))) = - -- TODO: check data values are in e let - bindClause (DataTypeClause nc Nothing) = do - return (emptySet, [(nc, VDataType nc []), - (internalNameForDataTypeClause nc, VTuple [])]) - bindClause (DataTypeClause nc (Just e)) = do - v <- eval e + mkDataTypeClause :: DataTypeClause Name -> (Name, EvaluationMonad Value) + mkDataTypeClause (DataTypeClause nc me) = (nc, do + vss <- case me of + Just e -> eval e >>= return . evalTypeExprToList + Nothing -> return [] + let arity = fromIntegral (length vss) + return $ VTuple [VDot [VDataType nc], VInt arity, VList (map VList vss)]) + computeSetOfValues :: EvaluationMonad Value + computeSetOfValues = let - sets = evalTypeExprToList v - setOfValues = cartesianProduct (VDataType nc) sets - binds = [(nc, VDataType nc []), - (internalNameForDataTypeClause nc, VTuple (map VSet sets))] - return (setOfValues, binds) - in do - (sets, binds) <- mapAndUnzipM (bindClause . unAnnotate) cs - let dt = (n, VSet (unions sets)) - return $ dt:concat binds -bindDecl (an@(An _ _ (NameType n e))) = do - v <- eval e - return [(n, VSet $ evalTypeExpr v)] - -bindDecl (an@(An _ _ (Assert _))) = return [] -bindDecl (an@(An _ _ (External ns))) = return [] -bindDecl (an@(An _ _ (Transparent ns))) = return [] - -internalNameForChannel, internalNameForDataTypeClause :: Name -> Name -internalNameForChannel (Name n) = - mkInternalName ("VALUE_TUPLE_CHANNEL_"++n) -internalNameForDataTypeClause (Name n) = - mkInternalName ("VALUE_TUPLE_DT_CLAUSE_"++n) - -valuesForChannel :: Name -> EvaluationMonad [ValueSet] -valuesForChannel n = do - VTuple vs <- lookupVar (internalNameForChannel n) - return $ map (\(VSet s) -> s) vs + mkSet nc = do + VTuple [_, _, VList fields] <- lookupVar nc + let cp = UL.cartesianProduct (map (\(VList vs) -> vs) fields) + return $ map (\vs -> VDot ((VDataType nc):vs)) cp + in do + vs <- concatMapM mkSet [nc | DataTypeClause nc _ <- map unAnnotate cs] + return $ VSet (fromList vs) + in (n, computeSetOfValues):(map mkDataTypeClause (map unAnnotate cs)) +bindDecl (an@(An _ _ (NameType n e))) = + [(n, do + v <- eval e + return $ VSet $ evalTypeExpr v)] -valuesForDataTypeClause :: Name -> EvaluationMonad [ValueSet] -valuesForDataTypeClause n = do - VTuple vs <- lookupVar (internalNameForDataTypeClause n) - return $ map (\(VSet s) -> s) vs +bindDecl (an@(An _ _ (Assert _))) = [] +bindDecl (an@(An _ _ (External ns))) = [] +bindDecl (an@(An _ _ (Transparent ns))) = [] evalTypeExpr :: Value -> ValueSet evalTypeExpr (VSet s) = s evalTypeExpr (VDot vs) = cartesianProduct VDot (map evalTypeExpr vs) evalTypeExpr (VTuple vs) = cartesianProduct VTuple (map evalTypeExpr vs) -evalTypeExprToList :: Value -> [ValueSet] -evalTypeExprToList (VDot vs) = map evalTypeExpr vs -evalTypeExprToList v = [evalTypeExpr v] +evalTypeExprToList :: Value -> [[Value]] +evalTypeExprToList (VDot vs) = concatMap evalTypeExprToList vs +evalTypeExprToList v = [toList (evalTypeExpr v)] + +class FreeVars a where + freeVars :: a -> [Name] + +instance FreeVars a => FreeVars (Annotated b a) where + freeVars (An _ _ inner) = freeVars inner + +instance FreeVars (Pat Name) where + freeVars (PConcat p1 p2) = freeVars p1++freeVars p2 + freeVars (PDotApp p1 p2) = freeVars p1++freeVars p2 + freeVars (PDoublePattern p1 p2) = freeVars p1++freeVars p2 + freeVars (PList ps) = concatMap freeVars ps + freeVars (PLit l) = [] + freeVars (PParen p) = freeVars p + freeVars (PSet ps) = concatMap freeVars ps + freeVars (PTuple ps) = concatMap freeVars ps + freeVars (PVar n) | isNameDataConstructor n = [] + freeVars (PVar n) = [n] + freeVars (PWildCard) = [] diff --git a/src/CSPM/Evaluator/Environment.hs b/src/CSPM/Evaluator/Environment.hs --- a/src/CSPM/Evaluator/Environment.hs +++ b/src/CSPM/Evaluator/Environment.hs @@ -1,13 +1,26 @@ module CSPM.Evaluator.Environment ( - module Util.HierarchicalMap, Environment, + new, lookup, newLayerAndBind, toList, ) where import qualified Data.Map as M -import Prelude +import Prelude hiding (lookup) import CSPM.DataStructures.Names import {-# SOURCE #-} CSPM.Evaluator.Values -import Util.HierarchicalMap +import Util.Exception -type Environment = HierarchicalMap Name Value +type Environment = M.Map Name Value + +new :: Environment +new = M.empty + +toList :: Environment -> [(Name, Value)] +toList = M.toList + +lookup :: Environment -> Name -> Value +lookup env n = M.findWithDefault (panic ("lookup not found: "++show n)) n env + +newLayerAndBind :: Environment -> [(Name, Value)] -> Environment +newLayerAndBind env nvs = + foldr (\ (n,v) env -> M.insert n v env) env nvs diff --git a/src/CSPM/Evaluator/Exceptions.hs b/src/CSPM/Evaluator/Exceptions.hs --- a/src/CSPM/Evaluator/Exceptions.hs +++ b/src/CSPM/Evaluator/Exceptions.hs @@ -7,26 +7,78 @@ import CSPM.DataStructures.Names import CSPM.DataStructures.Syntax import CSPM.PrettyPrinter -import {-# SOURCE #-} CSPM.Evaluator.Values +import CSPM.Evaluator.Values +import {-# SOURCE #-} CSPM.Evaluator.ValueSet import Util.Annotated import Util.Exception import Util.PrettyPrint -patternMatchFailureMessage :: SrcSpan -> AnPat -> Value -> ErrorMessage +patternMatchFailureMessage :: SrcSpan -> TCPat -> Value -> ErrorMessage patternMatchFailureMessage l pat v = mkErrorMessage l $ hang (hang (text "Pattern match failure: Value") tabWidth (prettyPrint v)) tabWidth (text "does not match the pattern" <+> prettyPrint pat) +headEmptyListMessage :: ErrorMessage +headEmptyListMessage = mkErrorMessage Unknown $ + text "Attempt to take head of empty list." + +tailEmptyListMessage :: ErrorMessage +tailEmptyListMessage = mkErrorMessage Unknown $ + text "Attempt to take tail of empty list." + funBindPatternMatchFailureMessage :: SrcSpan -> Name -> [[Value]] -> ErrorMessage funBindPatternMatchFailureMessage l n vss = mkErrorMessage l $ hang (text "Pattern match failure whilst attempting to evaluate:") tabWidth (prettyPrint n <> hcat (map (\ vs -> parens (list (map prettyPrint vs))) vss)) - + +replicatedInternalChoiceOverEmptySetMessage :: SrcSpan -> Exp Name -> ErrorMessage +replicatedInternalChoiceOverEmptySetMessage l p = mkErrorMessage l $ + hang ( + hang (text "The set expression in"<>colon) tabWidth + (prettyPrint p) + ) tabWidth + (text "evaluated to the empty set. However, replicated internal choice is not defined for the empty set.") + typeCheckerFailureMessage :: String -> ErrorMessage -typeCheckerFailureMessage s = - mkErrorMessage Unknown $ - hang (text "The program caused a runtime error that should have been caught by the typechecker:") - tabWidth (text s) +typeCheckerFailureMessage s = mkErrorMessage Unknown $ + hang (text "The program caused a runtime error that should have been caught by the typechecker:") + tabWidth (text s) + +cannotConvertIntegersToListMessage :: ErrorMessage +cannotConvertIntegersToListMessage = mkErrorMessage Unknown $ + text "Cannot convert the set of all integers into a list." + +cannotConvertProcessesToListMessage :: ErrorMessage +cannotConvertProcessesToListMessage = mkErrorMessage Unknown $ + text "Cannot convert the set of all processes (i.e. Proc) into a list." + +cannotCheckSetMembershipError :: Value -> ValueSet -> ErrorMessage +cannotCheckSetMembershipError v vs = mkErrorMessage Unknown $ + text "Cannot check for set membership as the supplied set is infinite." + +cardOfInfiniteSetMessage :: ValueSet -> ErrorMessage +cardOfInfiniteSetMessage vs = mkErrorMessage Unknown $ + text "Attempt to take the cardinatlity of an infinite set." + +cannotUnionSetsMessage :: ValueSet -> ValueSet -> ErrorMessage +cannotUnionSetsMessage vs1 vs2 = mkErrorMessage Unknown $ + text "Cannot union the supplied sets." + +cannotIntersectSetsMessage :: ValueSet -> ValueSet -> ErrorMessage +cannotIntersectSetsMessage vs1 vs2 = mkErrorMessage Unknown $ + text "Cannot intersect the supplied sets." + +cannotDifferenceSetsMessage :: ValueSet -> ValueSet -> ErrorMessage +cannotDifferenceSetsMessage vs1 vs2 = mkErrorMessage Unknown $ + text "Cannot difference the supplied sets." + +eventIsNotValidMessage :: Value -> ErrorMessage +eventIsNotValidMessage (v@(VDot (VChannel n:_))) = mkErrorMessage Unknown $ + text "The event" + <+> prettyPrint v + <+> text "is not a member of its channel" + <+> prettyPrint n + <+> text "and therefore the event is not valid." diff --git a/src/CSPM/Evaluator/Expr.hs b/src/CSPM/Evaluator/Expr.hs --- a/src/CSPM/Evaluator/Expr.hs +++ b/src/CSPM/Evaluator/Expr.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TypeSynonymInstances #-} +{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-} module CSPM.Evaluator.Expr ( Evaluatable, eval, ) where @@ -6,8 +6,10 @@ import Control.Monad.Trans import Data.Maybe +import CSPM.DataStructures.Literals import CSPM.DataStructures.Names import CSPM.DataStructures.Syntax +import CSPM.Evaluator.BuiltInFunctions import CSPM.Evaluator.DeclBind import CSPM.Evaluator.Environment import CSPM.Evaluator.Exceptions @@ -17,6 +19,8 @@ import qualified CSPM.Evaluator.ValueSet as S import Util.Annotated import Util.Exception +import Util.Monad +import Util.Prelude import Util.PrettyPrint -- In order to keep lazy evaluation working properly only use pattern @@ -29,7 +33,7 @@ instance Evaluatable a => Evaluatable (Annotated b a) where eval (An _ _ a) = eval a -instance Evaluatable Exp where +instance Evaluatable (Exp Name) where eval (App func args) = do vs <- mapM eval args VFunction f <- eval func @@ -41,19 +45,21 @@ And -> let VBool b1 = v1 + -- This is lazy, only pattern matches if b2 is required. VBool b2 = v2 in return $ VBool (b1 && b2) Or -> let VBool b1 = v1 + -- This is lazy, only pattern matches if b2 is required. VBool b2 = v2 in return $ VBool (b1 || b2) - Equals -> return $ VBool (v1 == v2) - NotEquals -> return $ VBool (v1 /= v2) - LessThan -> return $ VBool (v1 < v2) - GreaterThan -> return $ VBool (v1 > v2) - LessThanEq -> return $ VBool (v1 <= v2) - GreaterThanEq -> return $ VBool (v1 >= v2) + Equals -> return $ VBool (compareValues v1 v2 == Just EQ) + NotEquals -> return $ VBool (compareValues v1 v2 /= Just EQ) + LessThan -> return $ VBool (compareValues v1 v2 == Just LT) + GreaterThan -> return $ VBool (compareValues v1 v2 == Just GT) + LessThanEq -> return $ VBool (compareValues v1 v2 `elem` [Just LT, Just EQ]) + GreaterThanEq -> return $ VBool (compareValues v1 v2 `elem` [Just GT, Just EQ]) eval (BooleanUnaryOp op e) = do VBool b <- eval e case op of @@ -75,28 +81,18 @@ eval (DotApp e1 e2) = do v1 <- eval e1 v2 <- eval e2 - return $ combineDots v1 v2 - where - combineDots (VDot vs1) (VDot vs2) = VDot (vs1++vs2) - combineDots (VDot vs) y = VDot (vs++[y]) - combineDots (VEvent n vs1) (VDot vs2) = VEvent n (vs1++vs2) - combineDots (VEvent n vs1) x = VEvent n (vs1++[x]) - combineDots (VDataType n vs1) (VDot vs2) = VDataType n (vs1++vs2) - combineDots (VDataType n vs1) x = VDataType n (vs1++[x]) - combineDots v1 v2 = VDot [v1, v2] + combineDots v1 v2 eval (If e1 e2 e3) = do VBool b <- eval e1 if b then eval e2 else eval e3 eval (Lambda p e) = return $ VFunction $ \ [v] -> do - (matches, binds) <- bind p v + let (matches, binds) = bind p v if matches then addScopeAndBind binds (eval e) else throwError $ patternMatchFailureMessage (loc p) p v - eval (Let decls e) = do - bs <- bindDecls decls - addScopeAndBind bs (eval e) + eval (Let decls e) = addScopeAndBindM (bindDecls decls) (eval e) eval (Lit lit) = return $ case lit of Int i -> VInt i @@ -105,7 +101,6 @@ eval (ListComp es stmts) = do xs <- evalStmts (\(VList xs) -> xs) stmts (mapM eval es) return $ VList xs - where eval (ListEnumFrom e) = do VInt lb <- eval e return $ VList (map VInt [lb..]) @@ -115,7 +110,7 @@ return $ VList (map VInt [lb..ub]) eval (ListLength e) = do VList xs <- eval e - return $ VInt (toInteger (length xs)) + return $ VInt (length xs) eval (MathsBinaryOp op e1 e2) = do VInt i1 <- eval e1 VInt i2 <- eval e2 @@ -148,87 +143,124 @@ eval (SetEnumFromTo e1 e2) = do VInt lb <- eval e1 VInt ub <- eval e2 - return $ VSet (S.RangedSet lb ub) + return $ VSet (S.fromList (map VInt [lb..ub])) eval (Tuple es) = mapM eval es >>= return . VTuple - eval (Var (UnQual n)) = do + eval (Var n) | isNameDataConstructor n = do + VTuple [dc, _, _] <- lookupVar n + return dc + eval (Var n) = do v <- lookupVar n case v of - VProc p -> return $ VProc $ PProcCall (procId n []) (Just p) + VProc p -> return $ VProc $ PProcCall (procId n []) p _ -> return v -- This is the most complicated process because it is actually a shorthand -- for external choice and internal choice. - eval (Prefix e1 fs e2) = do - VEvent n vs1 <- eval e1 + eval (Prefix e1 fs e2) = let - normalizeEvent [] = [] - normalizeEvent ((VDot vs1):vs2) = normalizeEvent (vs1++vs2) - normalizeEvent (v:vs) = v:normalizeEvent vs - - evalInputField :: [Value] -> [Field] -> AnPat -> S.ValueSet -> - EvaluationMonad [Proc] - evalInputField vs fs p s = do + evalInputField :: Value -> [Field Name] -> TCPat -> S.ValueSet -> + (Value -> [Field Name] -> EvaluationMonad Proc) -> + EvaluationMonad [Proc] + evalInputField evBase fs p s evalRest = do mps <- mapM (\v -> do - (matches, binds) <- bind p v + let (matches, binds) = bind p v if matches then do - p <- addScopeAndBind binds - (evalFields (vs++normalizeEvent [v]) fs) + ev' <- combineDots evBase v + p <- addScopeAndBind binds (evalRest ev' fs) return $ Just p else return Nothing) (S.toList s) return $ catMaybes mps - evalFields :: [Value] -> [Field] -> EvaluationMonad Proc - evalFields vs [] = do + -- | Evalutates an input field, deducing the correct set of values + -- to input over. + evalInputField2 :: Value -> [Field Name] -> Pat Name -> + (Value -> [Field Name] -> EvaluationMonad Proc) -> + ([Proc] -> Proc) -> EvaluationMonad Proc + evalInputField2 evBase fs p evalRest procConstructor = + let + -- | The function to use to generate the options. If this + -- is the last field it uses 'extensions' to extend to a + -- fully formed event, otherwise we use 'oneFieldExtensions' + -- to extend by precisely one field. + extensionsOperator = + if fs == [] then extensions else oneFieldExtensions + + -- | Converts a pattern to its constituent fields. + patToFields :: Pat Name -> [Pat Name] + patToFields (PCompDot ps _) = map unAnnotate ps + patToFields (PDoublePattern p1 p2) = patToFields (unAnnotate p1) + patToFields p = [p] + + -- | Given a value and a list of patterns (from + -- 'patToFields') computes the appropriate set of events and + -- then evaluates it. + evExtensions :: Value -> [Pat Name] -> EvaluationMonad [Proc] + evExtensions evBase [] = do + p <- evalRest evBase fs + return [p] + evExtensions evBase (PVar n:ps) | isNameDataConstructor n = do + VTuple [dc, _, _] <- lookupVar n + evBase' <- combineDots evBase dc + evExtensions evBase' ps + evExtensions evBase (p:ps) = do + vs <- extensionsOperator evBase + mps <- mapM (\v -> do + let (matches, bs) = bind p v + if matches then do + evBase' <- combineDots evBase v + proc <- addScopeAndBind bs (evExtensions evBase' ps) + return $ Just proc + else return Nothing) vs + return $ concat $ catMaybes mps + in do + ps <- evExtensions evBase (patToFields p) + return $ procConstructor ps + + evalNonDetFields :: Value -> [Field Name] -> EvaluationMonad Proc + evalNonDetFields evBase (NonDetInput p (Just e):fs) = do + VSet s <- eval e + ps <- evalInputField evBase fs p s evalNonDetFields + return $ PInternalChoice ps + evalNonDetFields evBase (NonDetInput p Nothing:fs) = + evalInputField2 evBase fs (unAnnotate p) evalNonDetFields PInternalChoice + evalNonDetFields evBase fs = evalFields evBase fs + + evalFields :: Value -> [Field Name] -> EvaluationMonad Proc + evalFields ev [] = do + -- TODO: check valid event p <- evalProc e2 - return $ PPrefix (valueEventToEvent (VEvent n vs)) p - evalFields vs (Output e:fs) = do + return $ PPrefix (valueEventToEvent ev) p + evalFields evBase (Output e:fs) = do v <- eval e - evalFields (vs++normalizeEvent [v]) fs - - evalFields vs (Input p (Just e):fs) = do + ev' <- combineDots evBase v + evalFields ev' fs + evalFields evBase (Input p (Just e):fs) = do VSet s <- eval e - ps <- evalInputField vs fs p s - return $ PExternalChoice ps - evalFields vs (Input p Nothing:fs) = do - -- Calculate which component this is - let component = length vs - chanVs <- valuesForChannel n - let s = chanVs!!component - ps <- evalInputField vs fs p s + ps <- evalInputField evBase fs p s evalFields return $ PExternalChoice ps - - evalFields vs (NonDetInput p (Just e):fs) = do - VSet s <- eval e - ps <- evalInputField vs fs p s - return $ PInternalChoice ps - evalFields vs (NonDetInput p Nothing:fs) = do - -- Calculate which component this is - let component = length vs - chanVs <- valuesForChannel n - let s = chanVs!!component - ps <- evalInputField vs fs p s - return $ PInternalChoice ps - + evalFields evBase (Input p Nothing:fs) = + evalInputField2 evBase fs (unAnnotate p) evalFields PExternalChoice + evalFields evBase (NonDetInput _ _:fs) = + panic "Evaluation of $ after ! or ? is not supported." + -- Takes a proc and combines nested [] and |~| simplify :: Proc -> Proc --- TODO: error over PInternalChoice [] simplify (PExternalChoice [p]) = simplify p simplify (PInternalChoice [p]) = simplify p - - simplify (PExternalChoice ((PExternalChoice ps1):ps2)) = - simplify (PExternalChoice (ps1++ps2)) - simplify (PExternalChoice ps) = - PExternalChoice (map simplify ps) - - simplify (PInternalChoice ((PInternalChoice ps1):ps2)) = - simplify (PInternalChoice (ps1++ps2)) - simplify (PInternalChoice ps) = - PInternalChoice (map simplify ps) - + simplify (PExternalChoice (ps@((PExternalChoice _):_))) = + let extract (PExternalChoice ps) = ps in + simplify (PExternalChoice (concatMap extract ps)) + simplify (PExternalChoice ps) = PExternalChoice (map simplify ps) + simplify (PInternalChoice (ps@((PInternalChoice _):_))) = + let extract (PInternalChoice ps) = ps in + simplify (PInternalChoice (concatMap extract ps)) + simplify (PInternalChoice ps) = PInternalChoice (map simplify ps) simplify p = p - - p <- evalFields vs1 (map unAnnotate fs) - return $ VProc $ simplify p + in do + ev@(VDot (VChannel n:vfs)) <- eval e1 + VTuple [_, VInt arity, VList fieldSets] <- lookupVar n + p <- evalNonDetFields ev (map unAnnotate fs) + return $ VProc (simplify p) eval (AlphaParallel e1 e2 e3 e4) = do p1 <- evalProc e1 @@ -252,7 +284,7 @@ return $ VProc $ PGenParallel (S.valueSetToEventSet a) ps eval (GuardedExp guard proc) = do VBool b <- eval guard - if b then eval proc else lookupVar (Name "STOP") + if b then eval proc else lookupVar (builtInName "STOP") eval (Hiding e1 e2) = do p <- evalProc e1 VSet s <- eval e2 @@ -267,9 +299,15 @@ eval (Interleave e1 e2) = do ps <- evalProcs [e1, e2] return $ VProc $ PInterleave ps --- TODO --- eval (LinkParallel e1 ties stmts e2) --- eval (Rename e1 ties stmts) = + eval (LinkParallel e1 ties stmts e2) = do + p1 <- evalProc e1 + p2 <- evalProc e2 + ts <- evalTies stmts ties + return $ VProc $ PLinkParallel p1 ts p2 + eval (Rename e1 ties stmts) = do + p1 <- evalProc e1 + ts <- evalTies stmts ties + return $ VProc $ PRename ts p1 eval (SequentialComp e1 e2) = do p1 <- evalProc e1 p2 <- evalProc e2 @@ -293,9 +331,19 @@ return $ VProc $ PInterleave ps eval (ReplicatedInternalChoice stmts e) = do ps <- evalStmts (\(VSet s) -> S.toList s) stmts (evalProcs [e]) - return $ VProc $ PInternalChoice ps --- TODO --- eval (ReplicatedLinkParallel e1 ties stmts e2) = + let e' = ReplicatedInternalChoice stmts e + case ps of + [] -> throwError $ replicatedInternalChoiceOverEmptySetMessage (loc e) e' + _ -> return $ VProc $ PInternalChoice ps + eval (ReplicatedLinkParallel ties tiesStmts stmts e) = do + tsps <- evalStmts (\(VList vs) -> vs) stmts $ do + ts <- evalTies tiesStmts ties + p <- evalProc e + return [(ts, p)] + let + mkLinkPar [(ts, p1)] = p1 + mkLinkPar ((ts, p1):tps) = PLinkParallel p1 ts (mkLinkPar tps) + return $ VProc $ mkLinkPar tsps eval (ReplicatedParallel e1 stmts e2) = do VSet s <- eval e1 ps <- evalStmts (\(VSet s) -> S.toList s) stmts (evalProcs [e2]) @@ -303,16 +351,36 @@ eval e = panic ("No clause to eval "++show e) -evalProcs = mapM evalProc +evalProcs :: Evaluatable a => [a] -> EvaluationMonad [Proc] +evalProcs as = mapM evalProc as evalProc :: Evaluatable a => a -> EvaluationMonad Proc evalProc a = eval a >>= \v -> case v of VProc x -> return x _ -> panic "Type checker error" +evalTies :: [TCStmt] -> [(TCExp, TCExp)] -> EvaluationMonad [(Event, Event)] +evalTies stmts ties = do + tss <- evalStmts (\(VSet s) -> S.toList s) stmts (mapM evalTie ties) + return $ concat tss + where + extendTie :: (Value, Value) -> Value -> EvaluationMonad (Event, Event) + extendTie (evOld, evNew) ex = do + ev1 <- extendEvent evOld ex + ev2 <- extendEvent evNew ex + return (valueEventToEvent ev1, valueEventToEvent ev2) + evalTie (eOld, eNew) = do + evOld <- eval eOld + evNew <- eval eNew + -- Obviously evOld and evNew could be channels, or prefixes + -- of events so we compute the extensions. + -- TODO: this assumes extensions evOld <= extensions evNew + exsOld <- extensions evOld + mapM (\ex -> extendTie (evOld, evNew) ex) exsOld + -- | Evaluates the statements, evaluating `prog` for each possible -- assingment to the generators that satisfies the qualifiers. -evalStmts :: (Value -> [Value]) -> [AnStmt] -> EvaluationMonad [a] -> +evalStmts :: (Value -> [Value]) -> [TCStmt] -> EvaluationMonad [a] -> EvaluationMonad [a] evalStmts extract anStmts prog = let @@ -323,20 +391,21 @@ if b then evStmts stmts else return [] evStmts (Generator p e:stmts) = do v <- eval e - let vs = extract v vss <- mapM (\v -> do - (matches, binds) <- bind p v + let (matches, binds) = bind p v if matches then addScopeAndBind binds (evStmts stmts) - else return []) vs + else return []) (extract v) return $ concat vss in evStmts (map unAnnotate anStmts) -- | Takes a VEvent and then computes all events that this is a prefix of. completeEvent :: Value -> EvaluationMonad S.ValueSet -completeEvent (VEvent n vs) = do - chanVs <- valuesForChannel n - let remainingComponents = drop (length vs) chanVs - if length remainingComponents == 0 then return $ S.fromList [VEvent n vs] - else return $ S.cartesianProduct (\vs' -> VEvent n (vs++vs')) remainingComponents +completeEvent ev = do + exs <- extensions ev + l <- mapM (extendEvent ev) exs + return $ S.fromList l + +extendEvent :: Value -> Value -> EvaluationMonad Value +extendEvent ev exs = combineDots ev exs diff --git a/src/CSPM/Evaluator/Expr.hs-boot b/src/CSPM/Evaluator/Expr.hs-boot --- a/src/CSPM/Evaluator/Expr.hs-boot +++ b/src/CSPM/Evaluator/Expr.hs-boot @@ -1,5 +1,7 @@ +{-# LANGUAGE FlexibleInstances #-} module CSPM.Evaluator.Expr where +import CSPM.DataStructures.Names import CSPM.DataStructures.Syntax import CSPM.Evaluator.Monad import CSPM.Evaluator.Values @@ -10,5 +12,5 @@ eval :: a -> EvaluationMonad Value instance Evaluatable a => Evaluatable (Annotated b a) -instance Evaluatable Exp +instance Evaluatable (Exp Name) diff --git a/src/CSPM/Evaluator/Module.hs b/src/CSPM/Evaluator/Module.hs --- a/src/CSPM/Evaluator/Module.hs +++ b/src/CSPM/Evaluator/Module.hs @@ -13,9 +13,9 @@ import CSPM.Evaluator.Values import Util.Annotated -bindModules :: [TCModule] -> EvaluationMonad [(Name, Value)] -bindModules ms = liftM concat (mapM bindModule ms) +bindModules :: [TCModule] -> [(Name, EvaluationMonad Value)] +bindModules ms = concatMap bindModule ms -bindModule :: TCModule -> EvaluationMonad [(Name, Value)] +bindModule :: TCModule -> [(Name, EvaluationMonad Value)] bindModule an = case unAnnotate an of GlobalModule ds -> bindDecls ds diff --git a/src/CSPM/Evaluator/Monad.hs b/src/CSPM/Evaluator/Monad.hs --- a/src/CSPM/Evaluator/Monad.hs +++ b/src/CSPM/Evaluator/Monad.hs @@ -4,7 +4,6 @@ import Prelude hiding (lookup) import CSPM.DataStructures.Names -import CSPM.Evaluator.Exceptions import CSPM.Evaluator.Environment import {-# SOURCE #-} CSPM.Evaluator.Values import Util.Exception @@ -58,18 +57,26 @@ -- catch it env <- getEnvironment return $ lookup env n - + +-- | Implements non-recursive lets. addScopeAndBind :: [(Name, Value)] -> EvaluationMonad a -> EvaluationMonad a -addScopeAndBind bs = addScopeAndBindM $ return bs +addScopeAndBind bs = addScopeAndBindM [(n, return v) | (n, v) <- bs] -addScopeAndBindM :: EvaluationMonad [(Name, Value)] -> EvaluationMonad a -> EvaluationMonad a -addScopeAndBindM binds = - modify (\st -> let - bs = runEvaluator st' binds - env' = newLayerAndBind (environment st) bs - st' = st { environment = env' } - in - st') +-- | Implements recursive lets. +addScopeAndBindM :: [(Name, EvaluationMonad Value)] -> EvaluationMonad a -> EvaluationMonad a +addScopeAndBindM binds prog = do + st <- getState + let + env' = newLayerAndBind (environment st) bs + st' = st { environment = env' } + bs = [(n, runEvaluator st' v) | (n, v) <- binds] + modify (\_ -> st') prog throwError :: ErrorMessage -> a throwError err = throwSourceError [err] + +-- the problem here is that in order to get st', we need env', which requires +-- bs. However, bs requires st', which is not a problem intself if something +-- is lazy, but if binds does a lookup in the environment (which it does) +-- then this will break it? + diff --git a/src/CSPM/Evaluator/PatBind.hs b/src/CSPM/Evaluator/PatBind.hs --- a/src/CSPM/Evaluator/PatBind.hs +++ b/src/CSPM/Evaluator/PatBind.hs @@ -1,8 +1,9 @@ -{-# LANGUAGE TypeSynonymInstances #-} +{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-} module CSPM.Evaluator.PatBind where import Control.Monad +import CSPM.DataStructures.Literals import CSPM.DataStructures.Names import CSPM.DataStructures.Syntax import CSPM.Evaluator.Monad @@ -10,15 +11,16 @@ import CSPM.Evaluator.ValueSet import Util.Annotated import Util.Exception +import Util.PrettyPrint -- Bind :: Pattern, value -> (Matches Pattern, Values to Bind class Bindable a where - bind :: a -> Value -> EvaluationMonad (Bool, [(Name, Value)]) + bind :: a -> Value -> (Bool, [(Name, Value)]) instance Bindable a => Bindable (Annotated b a) where bind (An _ _ a) v = bind a v -instance Bindable Pat where +instance Bindable (Pat Name) where -- We can decompose any PConcat pattern into three patterns representing: -- Begining (of the form PList), middle (either PWildcard or PVar) -- and end (of the form PList), With both begining and end possible empty @@ -28,12 +30,13 @@ bind (PCompList starts (Just (middle, ends)) _) (VList xs) = -- Only match if the list contains sufficient items if not (atLeastLength (length starts + length ends) xs) then - return (False, []) - else do - (b1, nvs1) <- bindAll starts xsStart - (b2, nvs2) <- bindAll ends xsEnd - (b3, nvs3) <- bind middle (VList xsMiddle) - return (b1 && b2 && b3, nvs1++nvs2++nvs3) + (False, []) + else + let + (b1, nvs1) = bindAll starts xsStart + (b2, nvs2) = bindAll ends xsEnd + (b3, nvs3) = bind middle (VList xsMiddle) + in (b1 && b2 && b3, nvs1++nvs2++nvs3) where atLeastLength 0 _ = True atLeastLength _ [] = False @@ -42,37 +45,61 @@ (xsMiddle, xsEnd) = if length ends == 0 then (rest, []) else splitAt (length rest - length ends) rest - bind (PCompDot ps _) (VDot vs) = do - (b1, nvs1) <- bindAll psInit vsInit - (b2, nvs2) <- bind pLast (VDot vsLast) - return (b1 && b2, nvs1++nvs2) - where - (psInit, pLast) = initLast ps - (vsInit, vsLast) = splitAt (length psInit) vs - initLast :: [a] -> ([a], a) - initLast [a] = ([],a) - initLast (a:as) = let (bs,b) = initLast as in (a:bs,b) - bind (PDoublePattern p1 p2) v = do - (m1, b1) <- bind p1 v - (m2, b2) <- bind p2 v - return $ (m1 && m2, b1++b2) - bind (PLit (Int i1)) (VInt i2) | i1 == i2 = return (True, []) - bind (PLit (Bool b1)) (VBool b2) | b1 == b2 = return (True, []) + bind (PCompDot ps _) (VDot vs) = + let + -- Matches a compiled dot pattern, given a list of patterns for + -- the fields and the values that each field takes. + matchCompDot :: [Pat Name] -> [Value] -> (Bool, [(Name, Value)]) + matchCompDot [] [] = (True, []) + matchCompDot (PVar n:ps) (VDot (VDataType n':vfs):vs2) | isNameDataConstructor n = + -- In this case, we are matching within a subfield of the + -- current field. Therefore, add all the values that this + -- subfield has. + if n /= n' then (False, []) + else matchCompDot ps (vfs++vs2) + matchCompDot (PVar n:ps) (VDot (VChannel n':vfs):vs2) | isNameDataConstructor n = + if n /= n' then (False, []) + else matchCompDot ps (vfs++vs2) + matchCompDot [p] [v] = bind p v + matchCompDot [p] vs = bind p (VDot vs) + matchCompDot (p:ps) (v:vs) = + let + (b1, nvs1) = bind p v + (b2, nvs2) = matchCompDot ps vs + in (b1 && b2, nvs1++nvs2) + + r = matchCompDot (map unAnnotate ps) vs + in r + bind (PDoublePattern p1 p2) v = + let + (m1, b1) = bind p1 v + (m2, b2) = bind p2 v + in (m1 && m2, b1++b2) + bind (PLit (Int i1)) (VInt i2) | i1 == i2 = (True, []) + bind (PLit (Bool b1)) (VBool b2) | b1 == b2 = (True, []) bind (PSet [p]) (VSet s) = case singletonValue s of Just v -> bind p v - Nothing -> return (False, []) + Nothing -> (False, []) bind (PTuple ps) (VTuple vs) = do -- NB: len ps == len vs by typechecker bindAll ps vs - -- Although n may refer to a datatype or a channel this doesn't - -- matter, we rebind for ease - bind (PVar n) v = return (True, [(n, v)]) - bind PWildCard v = return (True, []) - bind _ _ = return (False, []) +-- TODO, the following two cases are wrong, consider calling f(x) = x +-- with f(done). ARGH. +-- bind (PVar n) (VChannel n') = return (n == n', []) +-- bind (PVar n) (VDataType n') = return (n == n', []) +-- Must just be a normal variable + bind (PVar n) v | isNameDataConstructor n = + case v of + VChannel n' -> (n == n', []) + VDataType n' -> (n == n', []) + _ -> panic $ show $ prettyPrint v <+> text "is not a data constructor." + bind (PVar n) v = (True, [(n, v)]) + bind PWildCard v = (True, []) + bind _ _ = (False, []) -bindAll :: Bindable a => [a] -> [Value] - -> EvaluationMonad (Bool, [(Name, Value)]) -bindAll ps xs = do - rs <- zipWithM bind ps xs - return (and (map fst rs), concat (map snd rs)) +bindAll :: Bindable a => [a] -> [Value] -> (Bool, [(Name, Value)]) +bindAll ps xs = + let + rs = zipWith bind ps xs + in (and (map fst rs), concat (map snd rs)) diff --git a/src/CSPM/Evaluator/ValueSet.hs b/src/CSPM/Evaluator/ValueSet.hs --- a/src/CSPM/Evaluator/ValueSet.hs +++ b/src/CSPM/Evaluator/ValueSet.hs @@ -1,8 +1,31 @@ -module CSPM.Evaluator.ValueSet where +-- | Provides a set implementation for machine CSP sets. This relies heavily +-- on the type checking and assumes in many places that the sets being operated +-- on are suitable for the opertion in question. +-- +-- We cannot just use the built in set implementation as FDR assumes in several +-- places that infinite sets are allowed. +module CSPM.Evaluator.ValueSet ( + -- * Construction + ValueSet(Integers, Processes, IntSetFrom), + emptySet, fromList, toList, + -- * Basic Functions + compareValueSets, + member, card, empty, + union, unions, + intersection, intersections, + difference, + -- * Derived functions + cartesianProduct, powerset, allSequences, + -- * Specialised Functions + singletonValue, + valueSetToEventSet +) +where import Control.Monad import qualified Data.Set as S +import CSPM.Evaluator.Exceptions import CSPM.Evaluator.Values import qualified CSPM.Compiler.Events as CE import qualified CSPM.Compiler.Set as CS @@ -10,45 +33,82 @@ import Util.PrettyPrint hiding (empty) data ValueSet = - Integers -- Set of all integers - | Processes -- Set of all processes + -- | Set of all integers + Integers + -- | Set of all processes + | Processes + -- | An explicit set of values | ExplicitSet (S.Set Value) - | IntSetFrom Integer -- {lb..} - | RangedSet Integer Integer -- {lb..ub} - | LazySet [Value] + -- | The infinite set of integers starting at lb. + | IntSetFrom Int -- {lb..} + -- | A set of two value sets. Note that the tree of sets may be infinite. + -- NB. Composite sets are always infinite. + | CompositeSet ValueSet ValueSet + -- Only used for the internal set representation + deriving Ord instance Eq ValueSet where - Integers == Integers = True - Processes == Processes = True - IntSetFrom lb1 == IntSetFrom lb2 = lb1 == lb2 - RangedSet lb1 ub1 == RangedSet lb2 ub2 = lb1 == lb2 && ub1 == ub2 - ExplicitSet s1 == ExplicitSet s2 = s1 == s2 - - ExplicitSet s == RangedSet lb ub = s == S.fromList (map VInt [lb..ub]) - RangedSet lb ub == ExplicitSet s = s == S.fromList (map VInt [lb..ub]) - -- TODO: complete - - _ == _ = panic "Cannot compare sets" - -instance Ord ValueSet where - compare (ExplicitSet s1) (ExplicitSet s2) = compare s1 s2 - -- TODO: complete + s1 == s2 = compareValueSets s1 s2 == Just EQ instance PrettyPrintable ValueSet where prettyPrint Integers = text "Integers" prettyPrint Processes = text "Proc" - prettyPrint (IntSetFrom lb) = braces (integer lb <> text "...") - prettyPrint (RangedSet lb ub) = - braces (integer lb <> text "..." <> integer ub) + prettyPrint (IntSetFrom lb) = braces (int lb <> text "...") prettyPrint (ExplicitSet s) = braces (list (map prettyPrint $ S.toList s)) - prettyPrint (LazySet vs) = - braces (list (map prettyPrint vs)) - -- TODO: complete + prettyPrint (CompositeSet s1 s2) = + text "union" <> parens (prettyPrint s1 <> comma <+> prettyPrint s2) instance Show ValueSet where show = show . prettyPrint +flipOrder :: Maybe Ordering -> Maybe Ordering +flipOrder Nothing = Nothing +flipOrder (Just EQ) = Just EQ +flipOrder (Just LT) = Just GT +flipOrder (Just GT) = Just LT + +-- | Compares two value sets using subseteq (as per the specification). +compareValueSets :: ValueSet -> ValueSet -> Maybe Ordering +-- Processes +compareValueSets Processes Processes = Just EQ +compareValueSets _ Processes = Just LT +compareValueSets Processes _ = Just GT +-- Integers +compareValueSets Integers Integers = Just EQ +compareValueSets _ Integers = Just LT +compareValueSets Integers _ = Just GT +-- IntSetFrom +compareValueSets (IntSetFrom lb1) (IntSetFrom lb2) = Just (compare lb1 lb2) +-- ExplicitSet +compareValueSets (ExplicitSet s1) (ExplicitSet s2) = + if s1 == s2 then Just EQ + else if S.isProperSubsetOf s1 s2 then Just LT + else if S.isProperSubsetOf s2 s1 then Just GT + else Nothing +-- IntSetFrom+ExplicitSet +compareValueSets (IntSetFrom lb1) (ExplicitSet s2) = + let + VInt lb2 = S.findMin s2 + VInt ub2 = S.findMax s2 + in if lb1 <= lb2 then Just GT else Nothing +compareValueSets (ExplicitSet s1) (IntSetFrom lb1) = + flipOrder (compareValueSets (IntSetFrom lb1) (ExplicitSet s1)) + +-- Composite Sets +compareValueSets (CompositeSet s1 s2) s = + case (compareValueSets s1 s, compareValueSets s2 s) of + (Nothing, _) -> Nothing + (_, Nothing) -> Nothing + (Just LT, Just x) -> if x /= GT then Just LT else Nothing + (Just EQ, Just x) -> Just x + (Just GT, Just x) -> if x /= LT then Just GT else Nothing +compareValueSets s (CompositeSet s1 s2) = + flipOrder (compareValueSets (CompositeSet s1 s2) s) + +-- Anything else is incomparable +--compareValueSets _ _ = Nothing + -- | Produces a ValueSet of the carteisan product of several ValueSets, -- using 'vc' to convert each sequence of values into a single value. cartesianProduct :: ([Value] -> Value) -> [ValueSet] -> ValueSet @@ -59,20 +119,28 @@ powerset = fromList . map (VSet . fromList) . filterM (\x -> [True, False]) . toList --- | Returns the set of all sequences over the input set +-- | Returns the set of all sequences over the input set. This is infinite +-- so we use a CompositeSet. allSequences :: ValueSet -> ValueSet allSequences s = if empty s then emptySet else let itemsAsList :: [Value] itemsAsList = toList s + list :: Integer -> [Value] list 0 = [VList []] list n = concatMap (\x -> map (app x) (list (n-1))) itemsAsList where app :: Value -> Value -> Value app x (VList xs) = VList $ x:xs - in LazySet (list 0) + + yielder :: [Value] -> ValueSet + yielder (x:xs) = CompositeSet (ExplicitSet (S.singleton x)) (yielder xs) + allSequences :: [Value] + allSequences = concatMap list [0..] + in yielder allSequences + -- | The empty set emptySet :: ValueSet emptySet = ExplicitSet S.empty @@ -84,88 +152,125 @@ -- | Converts a set to list. toList :: ValueSet -> [Value] toList (ExplicitSet s) = S.toList s -toList (RangedSet lb ub) = map VInt [lb..ub] toList (IntSetFrom lb) = map VInt [lb..] -toList (LazySet xs) = xs --- TODO: rest +toList (CompositeSet s1 s2) = toList s1 ++ toList s2 +toList Integers = throwSourceError [cannotConvertIntegersToListMessage] +toList Processes = throwSourceError [cannotConvertProcessesToListMessage] --- | Returns the value iff the set contains one item only +-- | Returns the value iff the set contains one item only. singletonValue :: ValueSet -> Maybe Value -singletonValue s = if card s == 1 then Just (head (toList s)) else Nothing +singletonValue s = + let + isSingleton :: ValueSet -> Bool + isSingleton (ExplicitSet s) = S.size s == 1 + isSingleton _ = False + in if isSingleton s then Just (head (toList s)) else Nothing +-- | Is the specified value a member of the set. member :: Value -> ValueSet -> Bool member v (ExplicitSet s) = S.member v s member (VInt i) Integers = True member (VInt i) (IntSetFrom lb) = i >= lb -member (VInt i) (RangedSet lb ub) = i >= lb && i <= ub -member v (LazySet xs) = v `elem` xs +member v (CompositeSet s1 s2) = member v s1 || member v s2 +-- FDR does actually try and given the correct value here. +member (VProc p) Processes = True +member v s1 = throwSourceError [cannotCheckSetMembershipError v s1] +-- | The cardinality of the set. Throws an error if the set is infinite. card :: ValueSet -> Integer card (ExplicitSet s) = toInteger (S.size s) -card (RangedSet lb ub) = ub-lb+1 +card s = throwSourceError [cardOfInfiniteSetMessage s] +-- | Is the specified set empty? empty :: ValueSet -> Bool -empty Processes = panic "empty(Processes) Not implemented" empty (ExplicitSet s) = S.null s +empty (CompositeSet s1 s2) = False empty (IntSetFrom lb) = False -empty (Integers) = False -empty (RangedSet lb ub) = False -empty (LazySet xs) = - case xs of - x:_ -> False - _ -> True - -mapMonotonic :: (Value -> Value) -> ValueSet -> ValueSet -mapMonotonic f (ExplicitSet s) = ExplicitSet $ S.mapMonotonic f s +empty Processes = False +empty Integers = False +-- | Replicated union. unions :: [ValueSet] -> ValueSet unions vs = foldr union (ExplicitSet S.empty) vs +-- | Replicated intersection. intersections :: [ValueSet] -> ValueSet -intersections vs = panic "Unions not implemented" +intersections [] = emptySet +intersections (v:vs) = foldr1 intersection vs +-- | Union two sets throwing an error if it cannot be done in a way that will +-- terminate. union :: ValueSet -> ValueSet -> ValueSet -union (ExplicitSet s1) (ExplicitSet s2) = - ExplicitSet (S.union s1 s2) -union (IntSetFrom lb1) (IntSetFrom lb2) = - IntSetFrom (min lb1 lb2) -union (IntSetFrom lb) Integers =Integers -union Integers (IntSetFrom lb) =Integers -union (IntSetFrom lb1) (RangedSet lb2 ub2) | lb1 <= ub2 = - IntSetFrom (min lb1 lb2) -union (RangedSet lb2 ub2) (IntSetFrom lb1) | lb1 <= ub2 = - IntSetFrom (min lb1 lb2) -union x y | x == y = x +-- Process unions +union _ Processes = Processes +union Processes _ = Processes +-- Integer unions +union (IntSetFrom lb1) (IntSetFrom lb2) = IntSetFrom (min lb1 lb2) +union _ Integers = Integers +union Integers _ = Integers +-- Composite unions +union s1 (s2 @ (CompositeSet _ _)) = CompositeSet s1 s2 +union (s1 @ (CompositeSet _ _)) s2 = CompositeSet s1 s2 +-- Explicit unions +union (ExplicitSet s1) (ExplicitSet s2) = ExplicitSet (S.union s1 s2) +union (ExplicitSet s1) (IntSetFrom lb) = + CompositeSet (ExplicitSet s1) (IntSetFrom lb) +union (IntSetFrom lb) (ExplicitSet s1) = + CompositeSet (ExplicitSet s1) (IntSetFrom lb) +-- The above are all the well typed possibilities +--union s1 s2 = throwSourceError [cannotUnionSetsMessage s1 s2] + +-- | Intersects two sets throwing an error if it cannot be done in a way that +-- will terminate. intersection :: ValueSet -> ValueSet -> ValueSet +-- Explicit intersections intersection (ExplicitSet s1) (ExplicitSet s2) = - ExplicitSet (S.intersection s1 s2) -intersection (IntSetFrom lb1) (IntSetFrom lb2) = - IntSetFrom (min lb1 lb2) -intersection (IntSetFrom lb) Integers =IntSetFrom lb -intersection Integers (IntSetFrom lb) =IntSetFrom lb -intersection (IntSetFrom lb1) (RangedSet lb2 ub2) = - if lb1 <= ub2 then RangedSet (max lb2 lb1) ub2 - else ExplicitSet S.empty -intersection (RangedSet lb2 ub2) (IntSetFrom lb1) | lb1 <= ub2 = - intersection (IntSetFrom lb1) (RangedSet lb2 ub2) -inter x y | x == y = x + ExplicitSet (S.intersection s1 s2) +-- Integer intersections +intersection (IntSetFrom lb1) (IntSetFrom lb2) = IntSetFrom (max lb1 lb2) +intersection Integers Integers = Integers +intersection x Integers = x +intersection Integers x = x +-- Integer+ExplicitSet +intersection (ExplicitSet s1) (IntSetFrom lb1) = + let + VInt ubs = S.findMax s1 + VInt lbs = S.findMin s1 + in if lbs >= lb1 then ExplicitSet s1 + else ExplicitSet (S.intersection (S.fromList (map VInt [lbs..ubs])) s1) +intersection (IntSetFrom lb1) (ExplicitSet s2) = + intersection (ExplicitSet s2) (IntSetFrom lb1) +-- Process intersection +intersection Processes Processes = Processes +intersection Processes x = x +intersection x Processes = x +-- Composite sets are always infinite and therefore cannot be intersected in any +-- finite way. +intersection s1 s2 = throwSourceError [cannotIntersectSetsMessage s1 s2] difference :: ValueSet -> ValueSet -> ValueSet -difference (ExplicitSet s1) (ExplicitSet s2) = - ExplicitSet (S.difference s1 s2) -difference (IntSetFrom lb1) (IntSetFrom lb2) = - if lb1 < lb2 then RangedSet lb1 (lb2-1) - else ExplicitSet S.empty -difference (IntSetFrom lb) Integers = ExplicitSet S.empty ---difference Integers (IntSetFrom lb) = --- InfSetTo (lb-1) ---difference (IntSetFrom lb1) (RangedSet lb2 ub2) = --- if lb1 <= ub2 thenRangedSet (max lb2 lb1) ub2 --- elseExplicitSet empty ---difference (RangedSet lb2 ub2) (IntSetFrom lb1) | lb1 <= ub2 = -difference x y | x == y = ExplicitSet S.empty - +difference (ExplicitSet s1) (ExplicitSet s2) = ExplicitSet (S.difference s1 s2) +difference (IntSetFrom lb1) (IntSetFrom lb2) = fromList (map VInt [lb1..(lb2-1)]) +difference _ Integers = ExplicitSet S.empty +difference (IntSetFrom lb1) (ExplicitSet s1) = + let + VInt ubs = S.findMax s1 + VInt lbs = S.findMin s1 + card = S.size s1 + rangeSize = 1+(ubs-lbs) + s1' = IntSetFrom lb1 + s2' = ExplicitSet s1 + in if fromIntegral rangeSize == card then + -- is contiguous + if lb1 == lbs then IntSetFrom (ubs+1) + else throwSourceError [cannotDifferenceSetsMessage s1' s2'] + else + -- is not contiguous + throwSourceError [cannotDifferenceSetsMessage s1' s2'] +difference (ExplicitSet s1) (IntSetFrom lb1) = + ExplicitSet (S.fromList [VInt i | VInt i <- S.toList s1, i < lb1]) +difference s1 s2 = throwSourceError [cannotDifferenceSetsMessage s1 s2] -valueSetToEventSet :: ValueSet -> CE.EventSet +valueSetToEventSet :: ValueSet -> CS.Set CE.Event valueSetToEventSet = CS.fromList . map valueEventToEvent . toList diff --git a/src/CSPM/Evaluator/ValueSet.hs-boot b/src/CSPM/Evaluator/ValueSet.hs-boot --- a/src/CSPM/Evaluator/ValueSet.hs-boot +++ b/src/CSPM/Evaluator/ValueSet.hs-boot @@ -1,5 +1,6 @@ module CSPM.Evaluator.ValueSet where +import {-# SOURCE #-} CSPM.Evaluator.Values import Util.PrettyPrint data ValueSet @@ -7,3 +8,8 @@ instance Eq ValueSet instance Ord ValueSet instance PrettyPrintable ValueSet + +toList :: ValueSet -> [Value] +fromList :: [Value] -> ValueSet +cartesianProduct :: ([Value] -> Value) -> [ValueSet] -> ValueSet +compareValueSets :: ValueSet -> ValueSet -> Maybe Ordering diff --git a/src/CSPM/Evaluator/Values.hs b/src/CSPM/Evaluator/Values.hs --- a/src/CSPM/Evaluator/Values.hs +++ b/src/CSPM/Evaluator/Values.hs @@ -1,29 +1,40 @@ module CSPM.Evaluator.Values ( - Value(..), Proc(..), Event(..), + Value(..), Proc(..), ProcOperator(..), Event(..), + compareValues, procId, valueEventToEvent, + combineDots, + extensions, oneFieldExtensions, + productions, ) where +import Control.Monad +import Data.Foldable (foldrM) + import CSPM.Compiler.Events import CSPM.Compiler.Processes import CSPM.DataStructures.Names import CSPM.DataStructures.Syntax -import CSPM.Evaluator.Exceptions import CSPM.Evaluator.Monad -import {-# SOURCE #-} CSPM.Evaluator.ValueSet +import {-# SOURCE #-} CSPM.Evaluator.ValueSet hiding (cartesianProduct) import CSPM.PrettyPrinter +import Util.Exception +import Util.List import Util.Prelude import Util.PrettyPrint data Value = - VInt Integer + VInt Int | VBool Bool | VTuple [Value] - -- TODO: the following one may be completely incorrect, needs - -- testing + -- | If A is a datatype clause that has 3 fields a b c then a runtime + -- instantiation of this would be VDot [VDataType "A", a, b, c] where a,b + -- and c can contain other VDots. | VDot [Value] - | VEvent Name [Value] - | VDataType Name [Value] + -- The following two never appear on their own, they are always part of a + -- VDot (even if the VDot has no values). + | VChannel Name + | VDataType Name | VList [Value] | VSet ValueSet | VFunction ([Value] -> EvaluationMonad Value) @@ -34,36 +45,77 @@ VBool b1 == VBool b2 = b1 == b2 VTuple vs1 == VTuple vs2 = vs1 == vs2 VDot vs1 == VDot vs2 = vs1 == vs2 - VEvent n1 vs1 == VEvent n2 vs2 = n1 == n2 && vs1 == vs2 - VDataType n1 vs1 == VDataType n2 vs2 = n1 == n2 && vs1 == vs2 + VChannel n1 == VChannel n2 = n1 == n2 + VDataType n1 == VDataType n2 = n1 == n2 VList vs1 == VList vs2 = vs1 == vs2 VSet s1 == VSet s2 = s1 == s2 - v1 == v2 = throwError $ typeCheckerFailureMessage "Cannot compare for eq" + v1 == v2 = False +-- | Implements CSPM comparisons (note that Ord Value does not). +compareValues :: Value -> Value -> Maybe Ordering +-- The following are all orderable and comparable +compareValues (VInt i1) (VInt i2) = Just (compare i1 i2) +compareValues (VBool b1) (VBool b2) = Just (compare b1 b2) +compareValues (VTuple vs1) (VTuple vs2) = + -- Tuples must be same length by type checking + -- Tuples are ordered lexiographically + let + cmp [] [] = EQ + cmp (x:xs) (y:ys) = compare x y `thenCmp` cmp xs ys + in Just (cmp vs1 vs2) +compareValues (VList vs1) (VList vs2) = + let + -- for lists comparing means comparing prefixes + cmp [] [] = Just EQ + cmp [] (y:ys) = Just LT + cmp (x:xs) [] = Just GT + cmp (x:xs) (y:ys) | x == y = cmp xs ys + cmp (x:xs) (y:ys) = + -- x != y, hence neither can be a prefix of the other + Nothing + in cmp vs1 vs2 +compareValues (VSet s1) (VSet s2) = compareValueSets s1 s2 + +-- The following can only be compared for equality, hence if they are not +-- equal we return Nothing. +compareValues (VChannel n1) (VChannel n2) = + if n1 == n2 then Just EQ else Nothing +compareValues (VDataType n1) (VDataType n2) = + if n1 == n2 then Just EQ else Nothing +compareValues (VDot vs1) (VDot vs2) = + if vs1 == vs2 then Just EQ else Nothing + +-- Every other possibility is invalid +compareValues v1 v2 = panic $ + "Cannot compare "++show v1++" "++show v2 + instance Ord Value where + -- This implementation is used for various internal measures, but not + -- for implementing actual comparisons in CSPM. compare (VInt i1) (VInt i2) = compare i1 i2 + compare (VBool b1) (VBool b2) = compare b1 b2 compare (VTuple vs1) (VTuple vs2) = compare vs1 vs2 compare (VList vs1) (VList vs2) = compare vs1 vs2 - compare (VSet s1) (VSet s2) = compare s1 s2 - + compare (VSet s1) (VSet s2) = compare s1 s2 -- These are only ever used for the internal set implementation compare (VDot vs1) (VDot vs2) = compare vs1 vs2 - compare (VEvent n vs1) (VEvent n' vs2) = - compare n n' `thenCmp` compare vs1 vs2 - compare (VDataType n vs1) (VDataType n' vs2) = - compare n n' `thenCmp` compare vs1 vs2 - - compare v1 v2 = throwError $ typeCheckerFailureMessage "Cannot order" + compare (VChannel n) (VChannel n') = compare n n' + compare (VDataType n) (VDataType n') = compare n n' + compare v1 v2 = panic $ + -- Must be as a result of a mixed set of values, which cannot happen + -- as a result of type checking. + "Internal sets - cannot order "++show v1++" "++show v2 + instance PrettyPrintable Value where - prettyPrint (VInt i) = integer i + prettyPrint (VInt i) = int i prettyPrint (VBool True) = text "true" prettyPrint (VBool False) = text "false" prettyPrint (VTuple vs) = parens (list $ map prettyPrint vs) prettyPrint (VDot vs) = dotSep (map prettyPrint vs) - prettyPrint (VEvent n vs) = dotSep (prettyPrint n:map prettyPrint vs) - prettyPrint (VDataType n vs) = dotSep (prettyPrint n:map prettyPrint vs) + prettyPrint (VChannel n) = prettyPrint n + prettyPrint (VDataType n) = prettyPrint n prettyPrint (VList vs) = angles (list $ map prettyPrint vs) prettyPrint (VSet s) = prettyPrint s prettyPrint (VFunction _) = text "" @@ -72,10 +124,161 @@ instance Show Value where show v = show (prettyPrint v) --- TODO take acount of let within statements -procId :: Name -> [[Value]] -> String -procId n vss = show $ - prettyPrint n <> hcat (map (parens . list) (map (map prettyPrint) vss)) +-- | The number of fields this datatype or channel has. +arityOfDataTypeClause :: Name -> EvaluationMonad Int +arityOfDataTypeClause n = do + VTuple [_, VInt a,_] <- lookupVar n + return a +-- | Takes two values and dots then together appropriately. +combineDots :: Value -> Value -> EvaluationMonad Value +combineDots v1 v2 = + let + -- | Dots the given value onto the right of the given base, providing + -- the left hand value is a field. + maybeDotFieldOn :: Value -> Value -> EvaluationMonad (Maybe Value) + maybeDotFieldOn (VDot (nd:vs)) v = do + let + mn = case nd of + VDataType n -> Just n + VChannel n -> Just n + _ -> Nothing + case mn of + Nothing -> return Nothing + Just n -> do + a <- arityOfDataTypeClause n + let fieldCount = length vs + if a == 0 then return Nothing + else if length vs == 0 then + return $ Just (VDot [nd, v]) + else do + -- Try and dot it onto our last field + mv <- maybeDotFieldOn (last vs) v + case mv of + Just vLast -> + return $ Just (VDot (nd:replaceLast vs vLast)) + -- Start a new field, or return nothing if we + -- are full + Nothing | fieldCount < a -> + return $ Just (VDot (nd:vs++[v])) + Nothing | fieldCount == a -> return Nothing + Nothing | fieldCount > a -> panic "Malformed dot encountered." + maybeDotFieldOn vbase v = return Nothing + + -- | Dots the two values together, ensuring that if either the left or + -- the right value is a dot list combines them into one dot list. + dotAndReduce :: Value -> Value -> Value + dotAndReduce (VDot (VDataType n1:vs1)) (VDot (VDataType n2:vs2)) = + VDot [VDot (VDataType n1:vs1), VDot (VDataType n2:vs2)] + dotAndReduce (VDot (VDataType n1:vs1)) (VDot vs2) = + VDot (VDot (VDataType n1:vs1) : vs2) + dotAndReduce (VDot vs1) (VDot (VDataType n2:vs2)) = + VDot (vs1 ++ [VDot (VDataType n2:vs2)]) + dotAndReduce v1 v2 = VDot [v1, v2] + + -- | Given a base value and the value of a field dots the field onto + -- the right of the base. Assumes that the value provided is a field. + dotFieldOn :: Value -> Value -> EvaluationMonad Value + dotFieldOn vBase vField = do + mv <- maybeDotFieldOn vBase vField + case mv of + Just v -> return v + Nothing -> return $ dotAndReduce vBase vField + + -- | Split a value up into the values that could be used as fields. + splitIntoFields :: Value -> [Value] + splitIntoFields (v@(VDot (VDataType n:_))) = [v] + splitIntoFields (VDot vs) = vs + splitIntoFields v = [v] + + -- | Given a base value and a list of many fields dots the fields onto + -- the base. Assumes that the values provided are fields. + dotManyFieldsOn :: Value -> [Value] -> EvaluationMonad Value + dotManyFieldsOn v [] = return v + dotManyFieldsOn vBase (v:vs) = do + vBase' <- dotFieldOn vBase v + dotManyFieldsOn vBase' vs + in + -- Split v2 up into its composite fields and then dot them onto v1. + dotManyFieldsOn v1 (splitIntoFields v2) + +procId :: Name -> [[Value]] -> ProcName +procId n vss = ProcName n vss + +-- | This assumes that the value is a VDot with the left is a VChannel valueEventToEvent :: Value -> Event -valueEventToEvent (ev@(VEvent _ _)) = UserEvent (show (prettyPrint ev)) +valueEventToEvent v = UserEvent (show (prettyPrint v)) + +-- | Returns an x such that ev.x has been extended by exactly one atomic field. +-- This could be inside a subfield or elsewhere. +oneFieldExtensions :: Value -> EvaluationMonad [Value] +oneFieldExtensions (VDot (dn:vs)) = do + let + mn = case dn of + VChannel n -> Just n + VDataType n -> Just n + _ -> Nothing + case mn of + Nothing -> return [VDot []] + Just n -> do + let fieldCount = length vs + -- Get the information about the channel + VTuple [_, VInt arity, VList fieldSets] <- lookupVar n + + -- Firstly, try completing the last field in the current value + -- (in case it is only half formed). + mexs <- + if fieldCount > 0 then do + exs <- oneFieldExtensions (last vs) + if exs /= [VDot []] then return $ Just exs + else return Nothing + else return Nothing + + return $ case mexs of + Just exs -> exs + Nothing -> + if arity == fieldCount then [VDot []] + else -- We still have fields to complete + map (\ v -> VDot [v]) + (head [s | VList s <- drop (length vs) fieldSets]) +oneFieldExtensions _ = return [VDot []] + +-- | Takes a datatype or a channel value and then computes all x such that +-- ev.x is a full datatype/event. Each of the returned values is guaranteed +-- to be a VDot. +extensions :: Value -> EvaluationMonad [Value] +extensions (VDot (dn:vs)) = do + let + mn = case dn of + VChannel n -> Just n + VDataType n -> Just n + _ -> Nothing + case mn of + Nothing -> return [VDot []] + Just n -> do + let fieldCount = length vs + -- Get the information about the datatype/channel + VTuple [_, VInt arity, VList fieldSets] <- lookupVar n + + -- Firstly, complete the last field in the current value (in case it is only + -- half formed). + exsLast <- + if fieldCount == 0 then return [VDot []] + else extensions (last vs) + + if arity == fieldCount then return exsLast + else + -- We still have fields to complete + let + remainingFields = [s | VList s <- drop (length vs) fieldSets] + combineDots ((VDot vs1):vs2) = VDot (vs1++vs2) + fields = exsLast:remainingFields + in return $ map combineDots (cartesianProduct fields) +extensions v = return [VDot []] + +-- | Takes a datatype or a channel value and computes v.x for all x that +-- complete the value. +productions :: Value -> EvaluationMonad [Value] +productions v = do + pss <- extensions v + mapM (combineDots v) pss diff --git a/src/CSPM/Parser.hs b/src/CSPM/Parser.hs --- a/src/CSPM/Parser.hs +++ b/src/CSPM/Parser.hs @@ -1,3 +1,50 @@ +-- | A module that parses CSPM modules. +-- +-- The biggest problem with parsing CSPM is that > means both greater than +-- and end sequence. For example, consider @\ 2@ and @\ 2 >@. +-- Both of these are syntactically valid, but the parser has no way of deducing +-- whether or not the first @>@ it sees is an end sequence or a greater than. +-- +-- Clearly, without an arbitrary lookahead it is not possible, in general, to +-- solve this. Hence, we go for the 'shortest sequence' approach, in which +-- whenever a @>@ is seen whilst a list is currently open, we assume that it +-- closes the list. +-- +-- FDR has a slightly more sophisticated scheme, but this depends on the fact +-- that Bison happens to generate a lazy lookahead in this case, whereas Happy +-- is never lazy in its lookahead token. In particular, FDR has a sequence +-- stack of integers. The top value means the number of open sequence brackets +-- it has seen so far. It lexes @\<@ as normal, but whenever it decides that a +-- @\<@ token is a open sequence token, adds one to the current top of the +-- sequence stack. Then, whenever a @>@ token is discovered it checks to see +-- if the top value is non-zero, and if so lexes endseq, otherwise lexes gt. +-- It then decrements the value of the top of the sequence stack in the +-- parser. It uses a stack to allow it to open new contexts within parenthesis. +-- +-- Laziness is required when scanning something like @\<1> > \<1>@ as, if it is +-- not lazy then the second @>@ will be lexed just before the first @>@ is dealt +-- with. +-- +-- Instead, we decrement the top of the sequence stack within the lexer instead. +-- I don't think this will cause a change in behaviour, as if the lexer lexes +-- a _endseq token then it will definitely decrement the counter later (and +-- it has already checked to make sure it is non-zero). However, we do keep +-- the decision about @LT@ being @openseq@ or @\<@ in the parser as this can +-- decide when this is the case (e.g. @x \<@ means it must be a @LT@). +-- +-- The above is a problem in conjunction with nested brackets. For example, +-- consider @\<(0,1) | x>@; when we parse this we would take the @(@ into the +-- lookahead before we actually parse @\<@, meaning that when we push the @1@ +-- onto the sequence stack it actually goes onto the new top entry that is +-- popped off after @)@ is processed. Therefore, the @>@ will be parsed as a +-- @GT@. To solve this we make sure that whenever we pop off the sequence +-- stack we add any remaining open sequences onto the new top element. Clearly +-- this would be unsafe if we were relying on this for parsing, but as we are +-- not this should be fine and should cause no further ambiguities. +-- +-- It should be noted the above is a big hacky workaround, but I see no +-- alternative without resorting to an arbitrary lookahead parser (like parsec) +-- and its obvious inefficiency. module CSPM.Parser ( parseFile, parseInteractiveStmt, parseExpression, parseStringAsFile, @@ -10,20 +57,24 @@ import CSPM.Parser.Parser import Util.Annotated --- External Interface +-- | Parse as string as an 'PInteractiveStmt'. parseInteractiveStmt :: String -> ParseMonad PInteractiveStmt parseInteractiveStmt str = pushFileContents "" str >> parseInteractiveStmt_ +-- | Parses a string as an 'PExp'. parseExpression :: String -> ParseMonad PExp parseExpression str = pushFileContents "" str >> parseExpression_ +-- | Parse the given file, returning the parsed 'PModule's. parseFile :: String -> ParseMonad [PModule] parseFile fname = do decls <- pushFile fname parseFile_ return [An Unknown dummyAnnotation (GlobalModule decls)] +-- | Parse a string, as though it were an entire file, returning the parsed +-- 'PModule's. parseStringAsFile :: String -> ParseMonad [PModule] parseStringAsFile str = do decls <- pushFileContents "" str >> parseFile_ diff --git a/src/CSPM/Parser/Lexer.x b/src/CSPM/Parser/Lexer.x --- a/src/CSPM/Parser/Lexer.x +++ b/src/CSPM/Parser/Lexer.x @@ -192,19 +192,28 @@ openseq token inp len = do - --cs <- getSequenceStack - --setSequenceStack (0:cs) + cs <- getSequenceStack + setSequenceStack (0:cs) tok token inp len closeseq token inp len = do - --(c:cs) <- getSequenceStack - --setSequenceStack cs + (c:cs) <- getSequenceStack + case cs of + c1:cs -> setSequenceStack (c+c1:cs) + [] -> + -- Must be because of a syntax error (too many closing brakcets) + -- We let the parser catch this and we try and do something + -- sensible. + setSequenceStack [0] tok token inp len gt :: AlexInput -> Int -> ParseMonad LToken gt inp len = do (c:cs) <- getSequenceStack - tok (if c > 0 then TCloseSeq else TGt) inp len + if c > 0 then do + setSequenceStack (c-1:cs) + tok TCloseSeq inp len + else tok TGt inp len soakTok :: Token -> AlexInput -> Int -> ParseMonad LToken soakTok t inp len = setCurrentStartCode soak >> tok t inp len diff --git a/src/CSPM/Parser/Parser.hs b/src/CSPM/Parser/Parser.hs --- a/src/CSPM/Parser/Parser.hs +++ b/src/CSPM/Parser/Parser.hs @@ -1,2124 +1,2116 @@ {-# OPTIONS_GHC -w #-} {-# OPTIONS -fglasgow-exts -cpp #-} module CSPM.Parser.Parser ( - parseFile_, parseInteractiveStmt_, parseExpression_ -) -where - -import Data.Char - -import CSPM.DataStructures.Names -import CSPM.DataStructures.Syntax -import CSPM.DataStructures.Tokens -import CSPM.DataStructures.Types hiding (TDot) -import CSPM.Parser.Exceptions -import CSPM.Parser.Lexer -import CSPM.Parser.Monad -import Util.Annotated -import qualified Data.Array as Happy_Data_Array -import qualified GHC.Exts as Happy_GHC_Exts - --- parser produced by Happy Version 1.18.6 - -newtype HappyAbsSyn t8 t9 t28 t29 = HappyAbsSyn HappyAny -#if __GLASGOW_HASKELL__ >= 607 -type HappyAny = Happy_GHC_Exts.Any -#else -type HappyAny = forall a . a -#endif -happyIn6 :: ([PDecl]) -> (HappyAbsSyn t8 t9 t28 t29) -happyIn6 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyIn6 #-} -happyOut6 :: (HappyAbsSyn t8 t9 t28 t29) -> ([PDecl]) -happyOut6 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut6 #-} -happyIn7 :: (PInteractiveStmt) -> (HappyAbsSyn t8 t9 t28 t29) -happyIn7 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyIn7 #-} -happyOut7 :: (HappyAbsSyn t8 t9 t28 t29) -> (PInteractiveStmt) -happyOut7 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut7 #-} -happyIn8 :: t8 -> (HappyAbsSyn t8 t9 t28 t29) -happyIn8 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyIn8 #-} -happyOut8 :: (HappyAbsSyn t8 t9 t28 t29) -> t8 -happyOut8 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut8 #-} -happyIn9 :: t9 -> (HappyAbsSyn t8 t9 t28 t29) -happyIn9 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyIn9 #-} -happyOut9 :: (HappyAbsSyn t8 t9 t28 t29) -> t9 -happyOut9 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut9 #-} -happyIn10 :: ([PDecl]) -> (HappyAbsSyn t8 t9 t28 t29) -happyIn10 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyIn10 #-} -happyOut10 :: (HappyAbsSyn t8 t9 t28 t29) -> ([PDecl]) -happyOut10 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut10 #-} -happyIn11 :: ([PDecl]) -> (HappyAbsSyn t8 t9 t28 t29) -happyIn11 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyIn11 #-} -happyOut11 :: (HappyAbsSyn t8 t9 t28 t29) -> ([PDecl]) -happyOut11 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut11 #-} -happyIn12 :: ([PDecl]) -> (HappyAbsSyn t8 t9 t28 t29) -happyIn12 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyIn12 #-} -happyOut12 :: (HappyAbsSyn t8 t9 t28 t29) -> ([PDecl]) -happyOut12 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut12 #-} -happyIn13 :: (Maybe PDecl) -> (HappyAbsSyn t8 t9 t28 t29) -happyIn13 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyIn13 #-} -happyOut13 :: (HappyAbsSyn t8 t9 t28 t29) -> (Maybe PDecl) -happyOut13 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut13 #-} -happyIn14 :: (PDecl) -> (HappyAbsSyn t8 t9 t28 t29) -happyIn14 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyIn14 #-} -happyOut14 :: (HappyAbsSyn t8 t9 t28 t29) -> (PDecl) -happyOut14 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut14 #-} -happyIn15 :: (PDecl) -> (HappyAbsSyn t8 t9 t28 t29) -happyIn15 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyIn15 #-} -happyOut15 :: (HappyAbsSyn t8 t9 t28 t29) -> (PDecl) -happyOut15 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut15 #-} -happyIn16 :: (Assertion) -> (HappyAbsSyn t8 t9 t28 t29) -happyIn16 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyIn16 #-} -happyOut16 :: (HappyAbsSyn t8 t9 t28 t29) -> (Assertion) -happyOut16 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut16 #-} -happyIn17 :: (SemanticProperty) -> (HappyAbsSyn t8 t9 t28 t29) -happyIn17 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyIn17 #-} -happyOut17 :: (HappyAbsSyn t8 t9 t28 t29) -> (SemanticProperty) -happyOut17 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut17 #-} -happyIn18 :: (ModelOption) -> (HappyAbsSyn t8 t9 t28 t29) -happyIn18 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyIn18 #-} -happyOut18 :: (HappyAbsSyn t8 t9 t28 t29) -> (ModelOption) -happyOut18 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut18 #-} -happyIn19 :: (PDataTypeClause) -> (HappyAbsSyn t8 t9 t28 t29) -happyIn19 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyIn19 #-} -happyOut19 :: (HappyAbsSyn t8 t9 t28 t29) -> (PDataTypeClause) -happyOut19 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut19 #-} -happyIn20 :: ([PDataTypeClause]) -> (HappyAbsSyn t8 t9 t28 t29) -happyIn20 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyIn20 #-} -happyOut20 :: (HappyAbsSyn t8 t9 t28 t29) -> ([PDataTypeClause]) -happyOut20 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut20 #-} -happyIn21 :: ([PDataTypeClause]) -> (HappyAbsSyn t8 t9 t28 t29) -happyIn21 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyIn21 #-} -happyOut21 :: (HappyAbsSyn t8 t9 t28 t29) -> ([PDataTypeClause]) -happyOut21 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut21 #-} -happyIn22 :: (Located Name) -> (HappyAbsSyn t8 t9 t28 t29) -happyIn22 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyIn22 #-} -happyOut22 :: (HappyAbsSyn t8 t9 t28 t29) -> (Located Name) -happyOut22 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut22 #-} -happyIn23 :: ([Located Name]) -> (HappyAbsSyn t8 t9 t28 t29) -happyIn23 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyIn23 #-} -happyOut23 :: (HappyAbsSyn t8 t9 t28 t29) -> ([Located Name]) -happyOut23 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut23 #-} -happyIn24 :: ([Located Name]) -> (HappyAbsSyn t8 t9 t28 t29) -happyIn24 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyIn24 #-} -happyOut24 :: (HappyAbsSyn t8 t9 t28 t29) -> ([Located Name]) -happyOut24 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut24 #-} -happyIn25 :: (Located QualifiedName) -> (HappyAbsSyn t8 t9 t28 t29) -happyIn25 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyIn25 #-} -happyOut25 :: (HappyAbsSyn t8 t9 t28 t29) -> (Located QualifiedName) -happyOut25 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut25 #-} -happyIn26 :: (Located Literal) -> (HappyAbsSyn t8 t9 t28 t29) -happyIn26 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyIn26 #-} -happyOut26 :: (HappyAbsSyn t8 t9 t28 t29) -> (Located Literal) -happyOut26 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut26 #-} -happyIn27 :: (PPat) -> (HappyAbsSyn t8 t9 t28 t29) -happyIn27 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyIn27 #-} -happyOut27 :: (HappyAbsSyn t8 t9 t28 t29) -> (PPat) -happyOut27 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut27 #-} -happyIn28 :: t28 -> (HappyAbsSyn t8 t9 t28 t29) -happyIn28 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyIn28 #-} -happyOut28 :: (HappyAbsSyn t8 t9 t28 t29) -> t28 -happyOut28 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut28 #-} -happyIn29 :: t29 -> (HappyAbsSyn t8 t9 t28 t29) -happyIn29 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyIn29 #-} -happyOut29 :: (HappyAbsSyn t8 t9 t28 t29) -> t29 -happyOut29 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut29 #-} -happyIn30 :: (PExp) -> (HappyAbsSyn t8 t9 t28 t29) -happyIn30 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyIn30 #-} -happyOut30 :: (HappyAbsSyn t8 t9 t28 t29) -> (PExp) -happyOut30 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut30 #-} -happyIn31 :: (PExp) -> (HappyAbsSyn t8 t9 t28 t29) -happyIn31 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyIn31 #-} -happyOut31 :: (HappyAbsSyn t8 t9 t28 t29) -> (PExp) -happyOut31 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut31 #-} -happyIn32 :: (PExp) -> (HappyAbsSyn t8 t9 t28 t29) -happyIn32 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyIn32 #-} -happyOut32 :: (HappyAbsSyn t8 t9 t28 t29) -> (PExp) -happyOut32 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut32 #-} -happyIn33 :: (PField) -> (HappyAbsSyn t8 t9 t28 t29) -happyIn33 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyIn33 #-} -happyOut33 :: (HappyAbsSyn t8 t9 t28 t29) -> (PField) -happyOut33 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut33 #-} -happyIn34 :: ((PExp, PExp)) -> (HappyAbsSyn t8 t9 t28 t29) -happyIn34 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyIn34 #-} -happyOut34 :: (HappyAbsSyn t8 t9 t28 t29) -> ((PExp, PExp)) -happyOut34 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut34 #-} -happyIn35 :: ([(PExp, PExp)]) -> (HappyAbsSyn t8 t9 t28 t29) -happyIn35 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyIn35 #-} -happyOut35 :: (HappyAbsSyn t8 t9 t28 t29) -> ([(PExp, PExp)]) -happyOut35 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut35 #-} -happyIn36 :: ([(PExp, PExp)]) -> (HappyAbsSyn t8 t9 t28 t29) -happyIn36 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyIn36 #-} -happyOut36 :: (HappyAbsSyn t8 t9 t28 t29) -> ([(PExp, PExp)]) -happyOut36 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut36 #-} -happyIn37 :: ((PExp, PExp)) -> (HappyAbsSyn t8 t9 t28 t29) -happyIn37 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyIn37 #-} -happyOut37 :: (HappyAbsSyn t8 t9 t28 t29) -> ((PExp, PExp)) -happyOut37 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut37 #-} -happyIn38 :: ([(PExp, PExp)]) -> (HappyAbsSyn t8 t9 t28 t29) -happyIn38 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyIn38 #-} -happyOut38 :: (HappyAbsSyn t8 t9 t28 t29) -> ([(PExp, PExp)]) -happyOut38 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut38 #-} -happyIn39 :: ([(PExp, PExp)]) -> (HappyAbsSyn t8 t9 t28 t29) -happyIn39 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyIn39 #-} -happyOut39 :: (HappyAbsSyn t8 t9 t28 t29) -> ([(PExp, PExp)]) -happyOut39 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut39 #-} -happyIn40 :: ([PField]) -> (HappyAbsSyn t8 t9 t28 t29) -happyIn40 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyIn40 #-} -happyOut40 :: (HappyAbsSyn t8 t9 t28 t29) -> ([PField]) -happyOut40 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut40 #-} -happyIn41 :: ([PField]) -> (HappyAbsSyn t8 t9 t28 t29) -happyIn41 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyIn41 #-} -happyOut41 :: (HappyAbsSyn t8 t9 t28 t29) -> ([PField]) -happyOut41 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut41 #-} -happyIn42 :: ([PExp]) -> (HappyAbsSyn t8 t9 t28 t29) -happyIn42 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyIn42 #-} -happyOut42 :: (HappyAbsSyn t8 t9 t28 t29) -> ([PExp]) -happyOut42 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut42 #-} -happyIn43 :: ([PExp]) -> (HappyAbsSyn t8 t9 t28 t29) -happyIn43 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyIn43 #-} -happyOut43 :: (HappyAbsSyn t8 t9 t28 t29) -> ([PExp]) -happyOut43 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut43 #-} -happyIn44 :: ([PExp]) -> (HappyAbsSyn t8 t9 t28 t29) -happyIn44 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyIn44 #-} -happyOut44 :: (HappyAbsSyn t8 t9 t28 t29) -> ([PExp]) -happyOut44 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut44 #-} -happyIn45 :: ([PExp]) -> (HappyAbsSyn t8 t9 t28 t29) -happyIn45 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyIn45 #-} -happyOut45 :: (HappyAbsSyn t8 t9 t28 t29) -> ([PExp]) -happyOut45 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut45 #-} -happyIn46 :: ([PStmt]) -> (HappyAbsSyn t8 t9 t28 t29) -happyIn46 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyIn46 #-} -happyOut46 :: (HappyAbsSyn t8 t9 t28 t29) -> ([PStmt]) -happyOut46 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut46 #-} -happyIn47 :: (PStmt) -> (HappyAbsSyn t8 t9 t28 t29) -happyIn47 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyIn47 #-} -happyOut47 :: (HappyAbsSyn t8 t9 t28 t29) -> (PStmt) -happyOut47 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut47 #-} -happyIn48 :: ([PStmt]) -> (HappyAbsSyn t8 t9 t28 t29) -happyIn48 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyIn48 #-} -happyOut48 :: (HappyAbsSyn t8 t9 t28 t29) -> ([PStmt]) -happyOut48 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut48 #-} -happyIn49 :: ([PStmt]) -> (HappyAbsSyn t8 t9 t28 t29) -happyIn49 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyIn49 #-} -happyOut49 :: (HappyAbsSyn t8 t9 t28 t29) -> ([PStmt]) -happyOut49 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut49 #-} -happyInTok :: (LToken) -> (HappyAbsSyn t8 t9 t28 t29) -happyInTok x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyInTok #-} -happyOutTok :: (HappyAbsSyn t8 t9 t28 t29) -> (LToken) -happyOutTok x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOutTok #-} - - -happyActOffsets :: HappyAddr -happyActOffsets = HappyA# "\x00\x00\x4c\x01\x70\x01\x00\x00\x4d\x00\x00\x00\x00\x00\x70\x01\x64\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x70\x01\x96\x00\x70\x01\x70\x01\x00\x00\x00\x00\x70\x01\x70\x01\x70\x01\x70\x01\x70\x01\x70\x01\x70\x01\x70\x01\x70\x01\x70\x01\x70\x01\xcf\x00\x00\x00\x01\x06\x96\x00\x70\x01\xcf\x00\x00\x00\xe9\xff\x05\x01\x17\x01\x00\x00\x00\x00\xfe\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x70\x01\x00\x00\xc6\x00\xe5\x00\x70\x01\x70\x01\x70\x01\x70\x01\x70\x01\x70\x01\x70\x01\x70\x01\x70\x01\x70\x01\x70\x01\x70\x01\x70\x01\x70\x01\x70\x01\x70\x01\x70\x01\x70\x01\x70\x01\x70\x01\x70\x01\x70\x01\x70\x01\x70\x01\x70\x01\x70\x01\x70\x01\x70\x01\x70\x01\x70\x01\x70\x01\x70\x01\x2a\x00\xde\x02\x00\x00\xf4\x00\xf7\x00\xe9\x00\xe3\x00\xe1\x00\xea\x00\x00\x00\xa8\x00\xf1\x00\x68\x05\x01\x06\xf7\xff\xed\x00\x35\x05\xf1\xff\x31\x02\xb7\x00\x04\x00\x9d\x01\x9c\x08\xcd\x00\x01\x06\xb5\x01\xee\x04\xa7\x04\xf8\xff\x00\x00\x00\x00\x00\x00\x00\x00\x70\x01\x00\x00\x03\x01\x70\x01\x70\x01\x70\x01\x00\x00\x70\x01\x00\x00\x70\x01\x00\x00\xba\x00\x70\x01\x70\x01\x00\x00\x70\x01\x70\x01\x70\x01\x70\x01\x70\x01\x70\x01\x70\x01\x70\x01\x97\x00\x70\x01\x70\x01\x2a\x08\x2a\x08\xf8\x07\xc6\x07\x2a\x08\xfd\x06\x62\x07\x94\x07\x60\x04\xd3\x00\x97\x02\xca\x00\x00\x00\xbb\x00\xc3\x00\x8e\x00\xeb\xff\x04\x00\x04\x00\x04\x00\x9d\x01\x9d\x01\x8b\x08\x8b\x08\x8b\x08\x8b\x08\x8b\x08\x8b\x08\x69\x08\x7a\x08\x33\x06\xce\x05\x30\x07\xcb\x06\x98\x06\x53\x08\x00\x00\x70\x01\x00\x00\xb4\x00\x00\x00\x00\x00\x00\x00\xb2\x00\x00\x00\xa9\x00\x9e\x00\x70\x01\x01\x00\x00\x00\x70\x01\x87\x00\x00\x00\x00\x00\x00\x00\x00\x00\x70\x01\x81\x00\x00\x00\x9b\x05\x00\x00\x00\x00\x00\x00\x5b\x00\x70\x01\xa2\x00\xa2\x00\x70\x01\x2a\x08\x70\x01\x70\x01\x00\x00\x70\x01\x5f\x00\x70\x01\x70\x01\x70\x01\x70\x01\x52\x00\x70\x01\x9b\x05\x9b\x05\x70\x01\x00\x00\x9b\x05\x9b\x05\x9b\x05\x00\x00\x85\x00\x00\x00\x76\x00\x4e\x00\x9b\x05\x19\x04\x00\x00\x4f\x00\x80\x00\x9b\x05\x00\x00\xe6\x03\x00\x00\x9f\x03\x58\x00\x00\x00\x00\x00\x70\x01\x00\x00\x00\x00\x00\x00\x70\x01\x70\x01\x58\x03\x11\x03\x70\x01\x65\x06\x65\x06\x00\x00\x00\x00\x00\x00\x00\x00\x30\x07\x30\x07\x00\x00\x00\x00\x00\x00\x00\x00\x74\x00\x67\x00\x00\x00\x00\x00\x70\x01\x00\x00\x70\x01\x7d\x00\x65\x06\x70\x01\x70\x01\x9b\x05\x9b\x05\x9b\x05\x65\x06\x65\x06\x00\x00\x00\x00\x00\x00"# - -happyGotoOffsets :: HappyAddr -happyGotoOffsets = HappyA# "\x6d\x00\x40\x00\xfb\x09\x73\x00\xf0\x03\x00\x00\x00\x00\x2f\x05\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf3\x09\x67\x04\xad\x00\xeb\x09\x00\x00\x00\x00\xe3\x09\xdb\x09\xb6\x01\xe7\x04\xa1\x04\xd3\x09\xaa\x04\x98\x03\x51\x03\xf7\x01\xae\x01\x00\x00\x00\x00\xff\xff\xe8\x02\x5e\x03\x00\x00\x00\x00\x6a\x00\x00\x00\x6c\x00\x00\x00\x00\x00\xff\xff\xce\x00\x56\x00\xc4\x00\x71\x00\x47\x00\x04\x02\x00\x00\x00\x00\x49\x00\xcb\x09\xc3\x09\xbb\x09\xb3\x09\xab\x09\xa3\x09\x9b\x09\x93\x09\x8b\x09\x83\x09\x7b\x09\x73\x09\x6b\x09\x63\x09\x5b\x09\x53\x09\x4b\x09\x43\x09\x3b\x09\x33\x09\x47\x01\x3a\x02\x2b\x09\xa5\x03\x23\x09\x1b\x09\x13\x09\x0b\x09\x03\x09\xfb\x08\xf3\x08\xeb\x08\x00\x00\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\xff\xff\x00\x00\x00\x00\xff\xff\x00\x00\xff\xff\x00\x00\xff\xff\xff\xff\xff\xff\x00\x00\xff\xff\xff\xff\xff\xff\xff\xff\x29\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3f\x01\x00\x00\x3d\x06\xe3\x08\x0a\x06\xdb\x08\x00\x00\x18\x00\x00\x00\xfe\x00\x00\x00\xd3\x08\xcb\x08\xf6\x00\x00\x00\x8d\x00\xf1\x04\x48\x00\xd7\x05\xc3\x08\x5a\x08\x51\x08\x64\x00\x00\x00\x36\x08\x2e\x08\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x00\xff\xff\x00\x00\x00\x00\x1d\x00\x00\x00\x00\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x00\x25\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x05\xd0\x07\x00\x00\x02\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x71\x05\x17\x00\x00\x00\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x38\x05\x3c\x00\x08\x00\x22\x04\xff\xff\xf3\x07\x9e\x07\x00\x00\x6d\x02\x00\x00\xfc\xff\x1a\x03\x8f\x07\x6c\x07\x00\x00\x39\x07\xff\xff\xff\xff\x07\x07\x00\x00\xff\xff\xff\xff\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\xff\xff\x00\x00\x00\x00\x00\x00\xff\xff\x00\x00\xff\xff\x00\x00\x7a\x00\xf6\xff\x00\x00\x00\x00\xd4\x06\x00\x00\x00\x00\x00\x00\xa1\x06\x6f\x06\xff\xff\xff\xff\x87\x01\xff\xff\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xdf\x02\x00\x00\xa1\x02\x26\x00\xff\xff\x63\x01\xd1\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x00\x00\x00\x00\x00"# - -happyDefActions :: HappyAddr -happyDefActions = HappyA# "\xf6\xff\x00\x00\x00\x00\x00\x00\xf4\xff\xc8\xff\xc9\xff\x7b\xff\x00\x00\xca\xff\xd1\xff\xd2\xff\xcf\xff\xd0\xff\xa4\xff\x00\x00\x00\x00\x00\x00\x00\x00\xb1\xff\xcd\xff\x00\x00\x00\x00\x00\x00\x7b\xff\x7b\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf9\xff\xcb\xff\x00\x00\x00\x00\x00\x00\xfa\xff\x00\x00\x00\x00\xf2\xff\xf1\xff\xed\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7f\xff\x00\x00\x80\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7b\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\x73\xff\x70\xff\x00\x00\x72\xff\x00\x00\x00\x00\x00\x00\x00\x00\x82\xff\x00\x00\x83\xff\x00\x00\x78\xff\x00\x00\x7a\xff\x78\xff\x00\x00\x00\x00\x00\x00\xab\xff\xb7\xff\xba\xff\x00\x00\xce\xff\x00\x00\x00\x00\x78\xff\x00\x00\xfc\xff\xf3\xff\xf5\xff\xb0\xff\x00\x00\xcc\xff\x00\x00\x00\x00\x00\x00\x00\x00\xc7\xff\x00\x00\xc3\xff\x00\x00\xaa\xff\x00\x00\x00\x00\x00\x00\xa6\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x96\xff\x97\xff\x98\xff\x9a\xff\xa1\xff\x9d\xff\x9e\xff\xa0\xff\xcb\xff\x77\xff\x00\x00\x00\x00\x86\xff\x77\xff\x87\xff\x00\x00\xac\xff\xb4\xff\xb3\xff\xb2\xff\xb5\xff\xb6\xff\xbd\xff\xbe\xff\xbb\xff\xbc\xff\xbf\xff\xc0\xff\xb9\xff\xb8\xff\x9f\xff\xa3\xff\x89\xff\x8b\xff\x8d\xff\xc6\xff\x7e\xff\x00\x00\xe6\xff\x00\x00\xd6\xff\xd4\xff\xe7\xff\xd5\xff\xe8\xff\x00\x00\xeb\xff\x00\x00\xef\xff\xf8\xff\x00\x00\xe2\xff\xe0\xff\xdf\xff\xde\xff\xdd\xff\x00\x00\xe4\xff\xe1\xff\xc5\xff\xf0\xff\xee\xff\xf7\xff\xec\xff\x00\x00\x00\x00\x00\x00\x00\x00\xa2\xff\x00\x00\x00\x00\xc2\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x75\xff\x74\xff\x00\x00\x71\xff\x93\xff\x91\xff\x92\xff\x84\xff\x00\x00\x81\xff\x00\x00\x00\x00\x79\xff\x00\x00\xa8\xff\x00\x00\x7d\xff\xc1\xff\xec\xff\x00\x00\xae\xff\x00\x00\x00\x00\xaf\xff\xad\xff\x00\x00\xa9\xff\xa7\xff\xa5\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x99\xff\x9c\xff\x88\xff\x76\xff\x95\xff\x85\xff\x8a\xff\x8c\xff\xe5\xff\xd3\xff\xd8\xff\xe9\xff\xd9\xff\xda\xff\xea\xff\xe3\xff\x00\x00\xdc\xff\x00\x00\x00\x00\x94\xff\x00\x00\x00\x00\x8e\xff\x8f\xff\xc4\xff\x90\xff\x9b\xff\xd7\xff\xdb\xff"# - -happyCheck :: HappyAddr -happyCheck = HappyA# "\xff\xff\x10\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x10\x00\x10\x00\x20\x00\x21\x00\x22\x00\x23\x00\x17\x00\x25\x00\x13\x00\x14\x00\x15\x00\x16\x00\x12\x00\x13\x00\x19\x00\x1a\x00\x16\x00\x10\x00\x18\x00\x1b\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x22\x00\x23\x00\x0c\x00\x39\x00\x29\x00\x2a\x00\x2b\x00\x27\x00\x31\x00\x3f\x00\x13\x00\x14\x00\x3c\x00\x16\x00\x2e\x00\x2f\x00\x19\x00\x1a\x00\x0d\x00\x33\x00\x3e\x00\x10\x00\x0d\x00\x0e\x00\x38\x00\x39\x00\x37\x00\x3b\x00\x39\x00\x3d\x00\x27\x00\x17\x00\x01\x00\x41\x00\x3f\x00\x43\x00\x28\x00\x45\x00\x46\x00\x47\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x4c\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x13\x00\x14\x00\x28\x00\x16\x00\x10\x00\x18\x00\x19\x00\x1a\x00\x13\x00\x14\x00\x15\x00\x16\x00\x12\x00\x13\x00\x19\x00\x1a\x00\x16\x00\x1b\x00\x18\x00\x10\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x00\x00\x02\x00\x08\x00\x03\x00\x29\x00\x2a\x00\x2b\x00\x27\x00\x0b\x00\x03\x00\x13\x00\x14\x00\x15\x00\x16\x00\x2e\x00\x2f\x00\x19\x00\x1a\x00\x02\x00\x33\x00\x10\x00\x11\x00\x12\x00\x10\x00\x38\x00\x39\x00\x07\x00\x3b\x00\x31\x00\x3d\x00\x3c\x00\x3e\x00\x29\x00\x41\x00\x19\x00\x43\x00\x17\x00\x45\x00\x46\x00\x47\x00\x1b\x00\x44\x00\x01\x00\x02\x00\x4c\x00\x04\x00\x05\x00\x22\x00\x23\x00\x19\x00\x40\x00\x13\x00\x14\x00\x15\x00\x16\x00\x02\x00\x24\x00\x19\x00\x1a\x00\x12\x00\x13\x00\x4f\x00\x0d\x00\x16\x00\x26\x00\x18\x00\x06\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x29\x00\x2a\x00\x2b\x00\x07\x00\x06\x00\x01\x00\x02\x00\x27\x00\x04\x00\x05\x00\x13\x00\x14\x00\x15\x00\x16\x00\x2e\x00\x2f\x00\x19\x00\x1a\x00\x3a\x00\x33\x00\x07\x00\x10\x00\x12\x00\x13\x00\x38\x00\x39\x00\x16\x00\x3b\x00\x18\x00\x3d\x00\x10\x00\x11\x00\x12\x00\x41\x00\x0e\x00\x43\x00\x43\x00\x45\x00\x46\x00\x47\x00\x10\x00\x11\x00\x12\x00\x27\x00\x4c\x00\x10\x00\x13\x00\x14\x00\x19\x00\x16\x00\x2e\x00\x2f\x00\x19\x00\x1a\x00\x44\x00\x33\x00\x09\x00\x0a\x00\x0b\x00\x3a\x00\x38\x00\x39\x00\x07\x00\x3b\x00\x3c\x00\x3d\x00\x07\x00\x0f\x00\x19\x00\x41\x00\x19\x00\x43\x00\x07\x00\x45\x00\x46\x00\x47\x00\x19\x00\x02\x00\x01\x00\x02\x00\x4c\x00\x04\x00\x05\x00\x13\x00\x14\x00\x15\x00\x16\x00\x19\x00\x48\x00\x19\x00\x1a\x00\x13\x00\x14\x00\x15\x00\x16\x00\x12\x00\x13\x00\x19\x00\x1a\x00\x16\x00\x03\x00\x18\x00\x17\x00\xff\xff\x4f\x00\x29\x00\x2a\x00\x2b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x29\x00\x2a\x00\x2b\x00\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\x2f\x00\xff\xff\x31\x00\xff\xff\x33\x00\xff\xff\xff\xff\xff\xff\xff\xff\x38\x00\x39\x00\xff\xff\x3b\x00\xff\xff\x3d\x00\xff\xff\xff\xff\xff\xff\x41\x00\xff\xff\x43\x00\xff\xff\x45\x00\x46\x00\x47\x00\xff\xff\xff\xff\x01\x00\x02\x00\x4c\x00\x04\x00\x05\x00\x13\x00\x14\x00\x15\x00\x16\x00\xff\xff\xff\xff\x19\x00\x1a\x00\x13\x00\x14\x00\xff\xff\x16\x00\x12\x00\x13\x00\x19\x00\x1a\x00\x16\x00\xff\xff\x18\x00\xff\xff\xff\xff\xff\xff\x29\x00\x2a\x00\x2b\x00\x1f\x00\xff\xff\x26\x00\x27\x00\xff\xff\xff\xff\x01\x00\x02\x00\x27\x00\x04\x00\x05\x00\x13\x00\x14\x00\xff\xff\x16\x00\x2e\x00\x2f\x00\x19\x00\x1a\x00\xff\xff\x33\x00\xff\xff\xff\xff\x12\x00\x13\x00\x38\x00\x39\x00\x16\x00\x3b\x00\x18\x00\x3d\x00\xff\xff\xff\xff\xff\xff\x41\x00\xff\xff\x43\x00\xff\xff\x45\x00\x46\x00\x47\x00\xff\xff\xff\xff\xff\xff\x27\x00\x4c\x00\xff\xff\x13\x00\x14\x00\xff\xff\x16\x00\x2e\x00\x2f\x00\x19\x00\x1a\x00\xff\xff\x33\x00\xff\xff\xff\xff\xff\xff\xff\xff\x38\x00\x39\x00\xff\xff\x3b\x00\xff\xff\x3d\x00\xff\xff\xff\xff\xff\xff\x41\x00\xff\xff\x43\x00\xff\xff\x45\x00\x46\x00\x47\x00\xff\xff\xff\xff\xff\xff\x06\x00\x4c\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x13\x00\x14\x00\x15\x00\x16\x00\xff\xff\x11\x00\x19\x00\x1a\x00\x13\x00\x14\x00\xff\xff\x16\x00\x18\x00\xff\xff\x19\x00\x1a\x00\x34\x00\x35\x00\x36\x00\x37\x00\xff\xff\x39\x00\x29\x00\x2a\x00\x2b\x00\x24\x00\xff\xff\x3f\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\xff\xff\x2f\x00\x30\x00\xff\xff\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\xff\xff\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3f\x00\xff\xff\x41\x00\xff\xff\x43\x00\xff\xff\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\xff\xff\xff\xff\x4d\x00\x4e\x00\x06\x00\xff\xff\x08\x00\x09\x00\x0a\x00\x0b\x00\x13\x00\x14\x00\x15\x00\x16\x00\x0a\x00\x11\x00\x19\x00\x1a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x18\x00\x13\x00\x14\x00\xff\xff\x16\x00\xff\xff\x18\x00\x19\x00\x1a\x00\xff\xff\x29\x00\x2a\x00\x2b\x00\xff\xff\xff\xff\xff\xff\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\xff\xff\x2f\x00\x30\x00\xff\xff\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\xff\xff\x39\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x3f\x00\xff\xff\x41\x00\xff\xff\x43\x00\x11\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x18\x00\xff\xff\x4d\x00\x4e\x00\x13\x00\x14\x00\xff\xff\x16\x00\xff\xff\x18\x00\x19\x00\x1a\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\xff\xff\x2f\x00\x30\x00\xff\xff\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\xff\xff\x39\x00\x3a\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x3f\x00\xff\xff\x41\x00\xff\xff\x43\x00\x11\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x18\x00\xff\xff\x4d\x00\x4e\x00\x13\x00\x14\x00\xff\xff\x16\x00\xff\xff\x18\x00\x19\x00\x1a\x00\xff\xff\x1c\x00\xff\xff\xff\xff\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\xff\xff\x2f\x00\x30\x00\xff\xff\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\xff\xff\x39\x00\xff\xff\x08\x00\x09\x00\x0a\x00\x0b\x00\x3f\x00\xff\xff\x41\x00\xff\xff\x43\x00\x11\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x18\x00\xff\xff\x4d\x00\x4e\x00\x4f\x00\x13\x00\x14\x00\xff\xff\x16\x00\xff\xff\x18\x00\x19\x00\x1a\x00\xff\xff\xff\xff\xff\xff\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\xff\xff\x2f\x00\x30\x00\xff\xff\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\xff\xff\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\xff\xff\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\xff\xff\x4d\x00\x4e\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\xff\xff\x0d\x00\x0e\x00\x05\x00\x06\x00\x11\x00\x08\x00\x09\x00\x13\x00\x14\x00\xff\xff\x16\x00\x18\x00\x18\x00\x19\x00\x1a\x00\xff\xff\x13\x00\x14\x00\xff\xff\x16\x00\xff\xff\xff\xff\x19\x00\x1a\x00\xff\xff\xff\xff\xff\xff\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\xff\xff\x2f\x00\x30\x00\xff\xff\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\xff\xff\x39\x00\xff\xff\x08\x00\x09\x00\x0a\x00\x0b\x00\x3f\x00\xff\xff\x41\x00\xff\xff\x43\x00\x11\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x18\x00\xff\xff\x4d\x00\x4e\x00\x13\x00\x14\x00\xff\xff\x16\x00\xff\xff\x18\x00\x19\x00\x1a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\xff\xff\x2f\x00\x30\x00\xff\xff\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\xff\xff\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3f\x00\xff\xff\x41\x00\xff\xff\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\xff\xff\xff\xff\x4d\x00\x4e\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x13\x00\x14\x00\x15\x00\x16\x00\x0a\x00\x11\x00\x19\x00\x1a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x18\x00\x13\x00\x14\x00\xff\xff\x16\x00\xff\xff\x18\x00\x19\x00\x1a\x00\xff\xff\x29\x00\x2a\x00\x2b\x00\xff\xff\xff\xff\xff\xff\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\xff\xff\x2f\x00\x30\x00\xff\xff\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\xff\xff\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3f\x00\xff\xff\x41\x00\xff\xff\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\xff\xff\xff\xff\x4d\x00\x4e\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x13\x00\x14\x00\x15\x00\x16\x00\xff\xff\x11\x00\x19\x00\x1a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x18\x00\x13\x00\x14\x00\xff\xff\x16\x00\xff\xff\x18\x00\x19\x00\x1a\x00\xff\xff\x29\x00\x2a\x00\x2b\x00\x1f\x00\x20\x00\x21\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\xff\xff\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3f\x00\xff\xff\x41\x00\xff\xff\x43\x00\xff\xff\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\xff\xff\xff\xff\x4d\x00\x4e\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\xff\xff\xff\xff\x04\x00\x05\x00\x06\x00\x11\x00\x08\x00\x09\x00\xff\xff\x15\x00\xff\xff\xff\xff\x18\x00\xff\xff\xff\xff\xff\xff\xff\xff\x13\x00\x14\x00\xff\xff\x16\x00\xff\xff\xff\xff\x19\x00\x1a\x00\xff\xff\xff\xff\xff\xff\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\xff\xff\x2f\x00\x30\x00\xff\xff\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\xff\xff\x39\x00\xff\xff\x08\x00\x09\x00\x0a\x00\x0b\x00\x3f\x00\xff\xff\x41\x00\xff\xff\x43\x00\x11\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x18\x00\xff\xff\x4d\x00\x4e\x00\x13\x00\x14\x00\xff\xff\x16\x00\xff\xff\x18\x00\x19\x00\x1a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\xff\xff\x2f\x00\x30\x00\xff\xff\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\xff\xff\x39\x00\xff\xff\xff\xff\x3c\x00\xff\xff\xff\xff\x3f\x00\xff\xff\x41\x00\xff\xff\x43\x00\xff\xff\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\xff\xff\xff\xff\x4d\x00\x4e\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x05\x00\x06\x00\xff\xff\x08\x00\x09\x00\x11\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x18\x00\xff\xff\x13\x00\x14\x00\xff\xff\x16\x00\xff\xff\xff\xff\x19\x00\x1a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\xff\xff\x2f\x00\x30\x00\xff\xff\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\xff\xff\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3f\x00\xff\xff\x41\x00\xff\xff\x43\x00\xff\xff\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\xff\xff\x4c\x00\x4d\x00\x4e\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x13\x00\x14\x00\xff\xff\x16\x00\x11\x00\xff\xff\x19\x00\x1a\x00\xff\xff\x13\x00\x14\x00\x18\x00\x16\x00\xff\xff\x18\x00\x19\x00\x1a\x00\xff\xff\xff\xff\x26\x00\x27\x00\x1f\x00\x20\x00\x21\x00\xff\xff\xff\xff\xff\xff\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\xff\xff\x2f\x00\x30\x00\xff\xff\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\xff\xff\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3f\x00\xff\xff\x41\x00\xff\xff\x43\x00\xff\xff\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\xff\xff\xff\xff\x4d\x00\x4e\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x13\x00\x14\x00\xff\xff\x16\x00\xff\xff\x11\x00\x19\x00\x1a\x00\x14\x00\xff\xff\x13\x00\x14\x00\x18\x00\x16\x00\xff\xff\x18\x00\x19\x00\x1a\x00\xff\xff\x26\x00\x27\x00\xff\xff\x1f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\xff\xff\x2f\x00\x30\x00\xff\xff\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\xff\xff\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3f\x00\xff\xff\x41\x00\xff\xff\x43\x00\xff\xff\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\xff\xff\xff\xff\x4d\x00\x4e\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x13\x00\x14\x00\xff\xff\x16\x00\x11\x00\xff\xff\x19\x00\x1a\x00\xff\xff\x13\x00\x14\x00\x18\x00\x16\x00\xff\xff\x18\x00\x19\x00\x1a\x00\xff\xff\xff\xff\x26\x00\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\xff\xff\x2f\x00\x30\x00\xff\xff\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\xff\xff\x39\x00\xff\xff\x08\x00\x09\x00\x0a\x00\x0b\x00\x3f\x00\xff\xff\x41\x00\xff\xff\x43\x00\x11\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x18\x00\xff\xff\x4d\x00\x4e\x00\x13\x00\x14\x00\xff\xff\x16\x00\xff\xff\x18\x00\x19\x00\x1a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\xff\xff\x2f\x00\x30\x00\xff\xff\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\xff\xff\x39\x00\xff\xff\x08\x00\x09\x00\x0a\x00\x0b\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x11\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x18\x00\xff\xff\x4d\x00\x4e\x00\x13\x00\x14\x00\xff\xff\x16\x00\xff\xff\x18\x00\x19\x00\x1a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\xff\xff\x2f\x00\x30\x00\xff\xff\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\xff\xff\x39\x00\xff\xff\x08\x00\x09\x00\x0a\x00\x0b\x00\x3f\x00\xff\xff\x41\x00\xff\xff\x43\x00\x11\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x18\x00\xff\xff\x4d\x00\x4e\x00\x13\x00\x14\x00\xff\xff\x16\x00\xff\xff\x18\x00\x19\x00\x1a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\xff\xff\x2f\x00\x30\x00\xff\xff\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\xff\xff\x39\x00\xff\xff\x08\x00\x09\x00\x0a\x00\x0b\x00\x3f\x00\xff\xff\x41\x00\xff\xff\x43\x00\x11\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x18\x00\xff\xff\x4d\x00\x4e\x00\x13\x00\x14\x00\xff\xff\x16\x00\xff\xff\x18\x00\x19\x00\x1a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\xff\xff\x2f\x00\x30\x00\xff\xff\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\xff\xff\x39\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\xff\xff\x3f\x00\xff\xff\x41\x00\xff\xff\x43\x00\xff\xff\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\xff\xff\xff\xff\x4d\x00\x4e\x00\x13\x00\x14\x00\xff\xff\x16\x00\x17\x00\xff\xff\x19\x00\x1a\x00\xff\xff\xff\xff\xff\xff\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\xff\xff\x2f\x00\x30\x00\xff\xff\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\xff\xff\x39\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\xff\xff\x3f\x00\xff\xff\x41\x00\xff\xff\x43\x00\xff\xff\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\xff\xff\xff\xff\x4d\x00\x4e\x00\x13\x00\x14\x00\xff\xff\x16\x00\xff\xff\xff\xff\x19\x00\x1a\x00\xff\xff\xff\xff\xff\xff\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\xff\xff\x2f\x00\x30\x00\xff\xff\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\xff\xff\x39\x00\xff\xff\x08\x00\xff\xff\xff\xff\xff\xff\x3f\x00\x0d\x00\x41\x00\xff\xff\x43\x00\x11\x00\x45\x00\x46\x00\xff\xff\x48\x00\x49\x00\x4a\x00\x18\x00\xff\xff\x4d\x00\x4e\x00\x13\x00\x14\x00\xff\xff\x16\x00\xff\xff\xff\xff\x19\x00\x1a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\xff\xff\x2f\x00\x30\x00\xff\xff\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\xff\xff\x39\x00\xff\xff\x08\x00\xff\xff\xff\xff\xff\xff\x3f\x00\x0d\x00\x41\x00\xff\xff\x43\x00\x11\x00\x45\x00\x46\x00\x47\x00\xff\xff\x49\x00\x4a\x00\x18\x00\xff\xff\x4d\x00\x4e\x00\x13\x00\x14\x00\xff\xff\x16\x00\xff\xff\xff\xff\x19\x00\x1a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\xff\xff\x2f\x00\x30\x00\xff\xff\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\xff\xff\x39\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\xff\xff\x3f\x00\xff\xff\x41\x00\xff\xff\x43\x00\xff\xff\x45\x00\x46\x00\x47\x00\xff\xff\x49\x00\x4a\x00\xff\xff\xff\xff\x4d\x00\x4e\x00\x13\x00\x14\x00\xff\xff\x16\x00\xff\xff\xff\xff\x19\x00\x1a\x00\xff\xff\xff\xff\xff\xff\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\xff\xff\x2f\x00\x30\x00\xff\xff\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\xff\xff\x39\x00\xff\xff\x08\x00\xff\xff\xff\xff\xff\xff\x3f\x00\xff\xff\x41\x00\xff\xff\x43\x00\x11\x00\x45\x00\x46\x00\xff\xff\x48\x00\x49\x00\x4a\x00\x18\x00\xff\xff\x4d\x00\x4e\x00\x13\x00\x14\x00\xff\xff\x16\x00\xff\xff\xff\xff\x19\x00\x1a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\xff\xff\x2f\x00\x30\x00\xff\xff\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\xff\xff\x39\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\xff\xff\x3f\x00\xff\xff\x41\x00\xff\xff\x43\x00\xff\xff\x45\x00\x46\x00\x47\x00\xff\xff\x49\x00\x4a\x00\xff\xff\xff\xff\x4d\x00\x4e\x00\x13\x00\x14\x00\xff\xff\x16\x00\xff\xff\xff\xff\x19\x00\x1a\x00\xff\xff\xff\xff\xff\xff\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\xff\xff\x2f\x00\x30\x00\xff\xff\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\xff\xff\x39\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\xff\xff\x3f\x00\x13\x00\x14\x00\xff\xff\x16\x00\xff\xff\x45\x00\x19\x00\x1a\x00\x48\x00\x49\x00\x4a\x00\xff\xff\xff\xff\x4d\x00\x4e\x00\x13\x00\x14\x00\xff\xff\x16\x00\xff\xff\xff\xff\x19\x00\x1a\x00\xff\xff\xff\xff\xff\xff\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\xff\xff\x2f\x00\x30\x00\xff\xff\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\xff\xff\x39\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\xff\xff\x3f\x00\xff\xff\xff\xff\xff\xff\x07\x00\x08\x00\x09\x00\xff\xff\xff\xff\x48\x00\x49\x00\x4a\x00\xff\xff\xff\xff\x4d\x00\x4e\x00\x13\x00\x14\x00\xff\xff\x16\x00\xff\xff\xff\xff\x19\x00\x1a\x00\xff\xff\xff\xff\xff\xff\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\xff\xff\x2f\x00\x30\x00\xff\xff\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\xff\xff\x39\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\xff\xff\x3f\x00\x13\x00\x14\x00\xff\xff\x16\x00\xff\xff\xff\xff\x19\x00\x1a\x00\x48\x00\xff\xff\x4a\x00\xff\xff\xff\xff\x4d\x00\x4e\x00\x13\x00\x14\x00\xff\xff\x16\x00\xff\xff\xff\xff\x19\x00\x1a\x00\xff\xff\xff\xff\xff\xff\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\xff\xff\x2f\x00\x30\x00\xff\xff\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\xff\xff\x39\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\xff\xff\x3f\x00\x13\x00\x14\x00\xff\xff\x16\x00\xff\xff\xff\xff\x19\x00\x1a\x00\x48\x00\x13\x00\x14\x00\xff\xff\x16\x00\x4d\x00\x4e\x00\x19\x00\x1a\x00\x13\x00\x14\x00\xff\xff\x16\x00\xff\xff\xff\xff\x19\x00\x1a\x00\xff\xff\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\xff\xff\x2f\x00\x30\x00\x08\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\xff\xff\x39\x00\x13\x00\x14\x00\xff\xff\x16\x00\xff\xff\x3f\x00\x19\x00\x1a\x00\xff\xff\x13\x00\x14\x00\xff\xff\x16\x00\xff\xff\x48\x00\x19\x00\x1a\x00\xff\xff\xff\xff\xff\xff\x4e\x00\xff\xff\xff\xff\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\xff\xff\x2f\x00\x30\x00\xff\xff\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\xff\xff\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\x28\x00\x3f\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\xff\xff\x2f\x00\x30\x00\xff\xff\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\xff\xff\x39\x00\xff\xff\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x3f\x00\x2f\x00\x30\x00\xff\xff\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\xff\xff\x39\x00\xff\xff\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x3f\x00\x2f\x00\x30\x00\xff\xff\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\xff\xff\x39\x00\xff\xff\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x3f\x00\x2f\x00\x30\x00\xff\xff\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\xff\xff\x39\x00\x13\x00\x14\x00\xff\xff\x16\x00\xff\xff\x3f\x00\x19\x00\x1a\x00\x13\x00\x14\x00\xff\xff\x16\x00\xff\xff\xff\xff\x19\x00\x1a\x00\x13\x00\x14\x00\xff\xff\x16\x00\xff\xff\xff\xff\x19\x00\x1a\x00\x13\x00\x14\x00\xff\xff\x16\x00\xff\xff\xff\xff\x19\x00\x1a\x00\x13\x00\x14\x00\xff\xff\x16\x00\xff\xff\xff\xff\x19\x00\x1a\x00\x13\x00\x14\x00\xff\xff\x16\x00\xff\xff\xff\xff\x19\x00\x1a\x00\x13\x00\x14\x00\xff\xff\x16\x00\xff\xff\xff\xff\x19\x00\x1a\x00\x13\x00\x14\x00\xff\xff\x16\x00\xff\xff\xff\xff\x19\x00\x1a\x00\x13\x00\x14\x00\xff\xff\x16\x00\xff\xff\xff\xff\x19\x00\x1a\x00\x13\x00\x14\x00\xff\xff\x16\x00\xff\xff\xff\xff\x19\x00\x1a\x00\x13\x00\x14\x00\xff\xff\x16\x00\xff\xff\xff\xff\x19\x00\x1a\x00\x13\x00\x14\x00\xff\xff\x16\x00\xff\xff\xff\xff\x19\x00\x1a\x00\x13\x00\x14\x00\xff\xff\x16\x00\xff\xff\xff\xff\x19\x00\x1a\x00\x13\x00\x14\x00\xff\xff\x16\x00\xff\xff\xff\xff\x19\x00\x1a\x00\x13\x00\x14\x00\xff\xff\x16\x00\xff\xff\xff\xff\x19\x00\x1a\x00\x13\x00\x14\x00\xff\xff\x16\x00\xff\xff\xff\xff\x19\x00\x1a\x00\x13\x00\x14\x00\xff\xff\x16\x00\xff\xff\xff\xff\x19\x00\x1a\x00\x13\x00\x14\x00\xff\xff\x16\x00\xff\xff\xff\xff\x19\x00\x1a\x00\x13\x00\x14\x00\xff\xff\x16\x00\xff\xff\xff\xff\x19\x00\x1a\x00\x13\x00\x14\x00\xff\xff\x16\x00\xff\xff\xff\xff\x19\x00\x1a\x00\x13\x00\x14\x00\xff\xff\x16\x00\xff\xff\xff\xff\x19\x00\x1a\x00\x13\x00\x14\x00\xff\xff\x16\x00\xff\xff\xff\xff\x19\x00\x1a\x00\x13\x00\x14\x00\xff\xff\x16\x00\xff\xff\xff\xff\x19\x00\x1a\x00\x13\x00\x14\x00\xff\xff\x16\x00\xff\xff\xff\xff\x19\x00\x1a\x00\x13\x00\x14\x00\xff\xff\x16\x00\xff\xff\xff\xff\x19\x00\x1a\x00\x13\x00\x14\x00\xff\xff\x16\x00\xff\xff\xff\xff\x19\x00\x1a\x00\x13\x00\x14\x00\xff\xff\x16\x00\xff\xff\xff\xff\x19\x00\x1a\x00\x13\x00\x14\x00\xff\xff\x16\x00\xff\xff\xff\xff\x19\x00\x1a\x00\x13\x00\x14\x00\xff\xff\x16\x00\xff\xff\xff\xff\x19\x00\x1a\x00\x13\x00\x14\x00\xff\xff\x16\x00\xff\xff\xff\xff\x19\x00\x1a\x00\x13\x00\x14\x00\xff\xff\x16\x00\xff\xff\xff\xff\x19\x00\x1a\x00\x13\x00\x14\x00\xff\xff\x16\x00\xff\xff\xff\xff\x19\x00\x1a\x00\x13\x00\x14\x00\xff\xff\x16\x00\xff\xff\xff\xff\x19\x00\x1a\x00\x13\x00\x14\x00\xff\xff\x16\x00\xff\xff\xff\xff\x19\x00\x1a\x00\x13\x00\x14\x00\xff\xff\x16\x00\xff\xff\xff\xff\x19\x00\x1a\x00\x13\x00\x14\x00\xff\xff\x16\x00\xff\xff\xff\xff\x19\x00\x1a\x00\x13\x00\x14\x00\xff\xff\x16\x00\xff\xff\xff\xff\x19\x00\x1a\x00\x13\x00\x14\x00\xff\xff\x16\x00\xff\xff\xff\xff\x19\x00\x1a\x00\x13\x00\x14\x00\xff\xff\x16\x00\xff\xff\xff\xff\x19\x00\x1a\x00\x13\x00\x14\x00\xff\xff\x16\x00\xff\xff\xff\xff\x19\x00\x1a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\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\x81\x00\x0b\x00\x0c\x00\xd0\x00\x0d\x00\x0e\x00\x85\x00\x78\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xf8\x00\xca\x00\x05\x00\x06\x00\x56\x00\x07\x00\x0f\x00\x10\x00\x57\x00\x09\x00\x11\x00\x0c\x01\x12\x00\x33\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x12\x01\x4b\x00\x58\x00\x06\x01\x5a\x00\x13\x00\x79\x00\x4c\x00\x05\x00\x06\x00\x82\x00\x07\x00\x14\x00\x15\x00\x63\x00\x09\x00\x1f\x01\x16\x00\x86\x00\x10\x01\x90\x00\x91\x00\x17\x00\x18\x00\x4a\x00\x19\x00\x4b\x00\x1a\x00\xf1\x00\x76\x00\x20\x00\x1b\x00\x4c\x00\x1c\x00\xda\x00\x1d\x00\x1e\x00\x1f\x00\x0d\x01\x0e\x01\x0f\x01\x10\x01\x20\x00\x0b\x00\x0c\x00\x76\x00\x0d\x00\x0e\x00\x05\x00\x06\x00\xdf\x00\x07\x00\xb8\x00\x21\x00\x22\x00\x09\x00\x05\x00\x06\x00\x56\x00\x07\x00\x0f\x00\x10\x00\x57\x00\x09\x00\x11\x00\xb5\x00\x12\x00\xbe\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x25\x00\xc1\x00\x16\x01\x04\x00\x58\x00\xe9\x00\x5a\x00\x13\x00\xc4\x00\x04\x00\x05\x00\x06\x00\x56\x00\x07\x00\x14\x00\x15\x00\x57\x00\x09\x00\xba\x00\x16\x00\xba\x00\xbb\x00\xbc\x00\x17\x01\x17\x00\x18\x00\x84\x00\x19\x00\x79\x00\x1a\x00\xfc\x00\xfe\x00\xe4\x00\x1b\x00\xff\x00\x1c\x00\xf9\x00\x1d\x00\x1e\x00\x1f\x00\x33\x00\x03\x01\x0b\x00\x0c\x00\x20\x00\x0d\x00\x0e\x00\x34\x00\x35\x00\x00\x01\x08\x01\x05\x00\x06\x00\x56\x00\x07\x00\xba\x00\x14\x01\x57\x00\x09\x00\x0f\x00\x10\x00\xfb\xff\xd2\x00\x11\x00\xcc\x00\x12\x00\xd3\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x58\x00\xeb\x00\x5a\x00\xd4\x00\xd5\x00\x0b\x00\x0c\x00\x13\x00\x0d\x00\x0e\x00\x05\x00\x06\x00\x6d\x00\x07\x00\x14\x00\x15\x00\x6e\x00\x09\x00\xd9\x00\x16\x00\xda\x00\xdc\x00\x0f\x00\x10\x00\x17\x00\x18\x00\x11\x00\x19\x00\x12\x00\x1a\x00\xba\x00\xbd\x00\xbc\x00\x1b\x00\xdd\x00\x1c\x00\xe4\x00\x1d\x00\x1e\x00\x1f\x00\xba\x00\xbf\x00\xbc\x00\x13\x00\x20\x00\xdc\x00\x05\x00\x06\x00\x7d\x00\x07\x00\x14\x00\x15\x00\x1d\x01\x09\x00\x89\x00\x16\x00\x38\x00\x39\x00\x3a\x00\x7e\x00\x17\x00\x18\x00\x84\x00\x19\x00\xf0\x00\x1a\x00\x88\x00\x8a\x00\x8b\x00\x1b\x00\x8c\x00\x1c\x00\x8e\x00\x1d\x00\x1e\x00\x1f\x00\x8d\x00\xba\x00\x0b\x00\x0c\x00\x20\x00\x0d\x00\x0e\x00\x05\x00\x06\x00\x56\x00\x07\x00\x8f\x00\xb7\x00\x57\x00\x09\x00\x05\x00\x06\x00\x56\x00\x07\x00\x0f\x00\x10\x00\x57\x00\x09\x00\x11\x00\xc3\x00\x12\x00\xc4\x00\x00\x00\xff\xff\x58\x00\xec\x00\x5a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x58\x00\xf0\x00\x5a\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x15\x00\x00\x00\x79\x00\x00\x00\x16\x00\x00\x00\x00\x00\x00\x00\x00\x00\x17\x00\x18\x00\x00\x00\x19\x00\x00\x00\x1a\x00\x00\x00\x00\x00\x00\x00\x1b\x00\x00\x00\x1c\x00\x00\x00\x1d\x00\x1e\x00\x1f\x00\x00\x00\x00\x00\x0b\x00\x0c\x00\x20\x00\x0d\x00\x0e\x00\x05\x00\x06\x00\x56\x00\x07\x00\x00\x00\x00\x00\x57\x00\x09\x00\x05\x00\x06\x00\x00\x00\x07\x00\x0f\x00\x10\x00\x63\x00\x09\x00\x24\x00\x00\x00\x12\x00\x00\x00\x00\x00\x00\x00\x58\x00\xf7\x00\x5a\x00\x25\x00\x00\x00\xa0\x00\x65\x00\x00\x00\x00\x00\x0b\x00\x0c\x00\x13\x00\x0d\x00\x0e\x00\x05\x00\x06\x00\x00\x00\x07\x00\x14\x00\x15\x00\x1e\x01\x09\x00\x00\x00\x16\x00\x00\x00\x00\x00\x0f\x00\x10\x00\x17\x00\x18\x00\x11\x00\x19\x00\x12\x00\x1a\x00\x00\x00\x00\x00\x00\x00\x1b\x00\x00\x00\x1c\x00\x00\x00\x1d\x00\x1e\x00\x1f\x00\x00\x00\x00\x00\x00\x00\x13\x00\x20\x00\x00\x00\x05\x00\x06\x00\x00\x00\x07\x00\x14\x00\x15\x00\x17\x01\x09\x00\x00\x00\x16\x00\x00\x00\x00\x00\x00\x00\x00\x00\x17\x00\x18\x00\x00\x00\x19\x00\x00\x00\x1a\x00\x00\x00\x00\x00\x00\x00\x1b\x00\x00\x00\x1c\x00\x00\x00\x1d\x00\x1e\x00\x1f\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x20\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x05\x00\x06\x00\x56\x00\x07\x00\x00\x00\x3b\x00\x57\x00\x09\x00\x05\x00\x06\x00\x00\x00\x07\x00\x3c\x00\x00\x00\x68\x00\x09\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x00\x00\x4b\x00\x58\x00\x59\x00\x5a\x00\x69\x00\x00\x00\x4c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x00\x00\x4b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4c\x00\x00\x00\x4d\x00\x00\x00\x4e\x00\x00\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x00\x00\x00\x00\x55\x00\x56\x00\xc1\x00\x00\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x05\x00\x06\x00\x56\x00\x07\x00\xb7\x00\x3b\x00\x57\x00\x09\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3c\x00\x05\x00\x06\x00\x00\x00\x07\x00\x00\x00\x27\x00\x22\x00\x09\x00\x00\x00\x58\x00\x5b\x00\x5a\x00\x00\x00\x00\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x00\x00\x4b\x00\x7f\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x4c\x00\x00\x00\x4d\x00\x00\x00\x4e\x00\x3b\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x3c\x00\x00\x00\x55\x00\x56\x00\x05\x00\x06\x00\x00\x00\x07\x00\x00\x00\x9c\x00\x22\x00\x09\x00\x00\x00\x9d\x00\x9e\x00\x9f\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x00\x00\x4b\x00\x80\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x4c\x00\x00\x00\x4d\x00\x00\x00\x4e\x00\x3b\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x3c\x00\x00\x00\x55\x00\x56\x00\x05\x00\x06\x00\x00\x00\x07\x00\x00\x00\x9c\x00\x22\x00\x09\x00\x00\x00\x08\x01\x00\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x00\x00\x4b\x00\x00\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x4c\x00\x00\x00\x4d\x00\x00\x00\x4e\x00\x3b\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x3c\x00\x00\x00\x55\x00\x56\x00\xff\xff\x05\x00\x06\x00\x00\x00\x07\x00\x00\x00\x20\x01\x22\x00\x09\x00\x00\x00\x00\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x00\x00\x4b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4c\x00\x00\x00\x4d\x00\xde\x00\x4e\x00\x00\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\xdf\x00\x00\x00\x55\x00\x56\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x00\x00\xce\xff\xce\xff\x28\x00\x29\x00\x3b\x00\x2a\x00\x2b\x00\x05\x00\x06\x00\x00\x00\x07\x00\x3c\x00\x14\x01\x22\x00\x09\x00\x00\x00\x05\x00\x06\x00\x00\x00\x07\x00\x00\x00\x00\x00\x2c\x00\x09\x00\x00\x00\x00\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x00\x00\x4b\x00\x00\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x4c\x00\x00\x00\x4d\x00\x00\x00\x4e\x00\x3b\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x3c\x00\x00\x00\x55\x00\x56\x00\x05\x00\x06\x00\x00\x00\x07\x00\x00\x00\x05\x01\x22\x00\x09\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x00\x00\x4b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4c\x00\x00\x00\x4d\x00\x00\x00\x4e\x00\x19\x01\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x00\x00\x00\x00\x55\x00\x56\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x05\x00\x06\x00\x56\x00\x07\x00\x26\x00\x3b\x00\x57\x00\x09\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3c\x00\x05\x00\x06\x00\x00\x00\x07\x00\x00\x00\x27\x00\x22\x00\x09\x00\x00\x00\x58\x00\x5c\x00\x5a\x00\x00\x00\x00\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x00\x00\x4b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4c\x00\x00\x00\x4d\x00\x00\x00\x4e\x00\x1a\x01\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x00\x00\x00\x00\x55\x00\x56\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x05\x00\x06\x00\x56\x00\x07\x00\x00\x00\x3b\x00\x57\x00\x09\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3c\x00\x05\x00\x06\x00\x00\x00\x07\x00\x00\x00\x5e\x00\x99\x00\x09\x00\x00\x00\x58\x00\x5d\x00\x5a\x00\x5f\x00\x9a\x00\x61\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x00\x00\x43\x00\x44\x00\x79\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x00\x00\x4b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4c\x00\x00\x00\x4d\x00\x00\x00\x4e\x00\x00\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x00\x00\x00\x00\x55\x00\x56\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x00\x00\x00\x00\x73\x00\x74\x00\x29\x00\x3b\x00\x2a\x00\x2b\x00\x00\x00\xfb\x00\x00\x00\x00\x00\x3c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x05\x00\x06\x00\x00\x00\x07\x00\x00\x00\x00\x00\x6f\x00\x09\x00\x00\x00\x00\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x00\x00\x4b\x00\x00\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x4c\x00\x00\x00\x4d\x00\x00\x00\x4e\x00\x3b\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x3c\x00\x00\x00\x55\x00\x56\x00\x05\x00\x06\x00\x00\x00\x07\x00\x00\x00\x0b\x01\x22\x00\x09\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x00\x00\x4b\x00\x00\x00\x00\x00\xfd\x00\x00\x00\x00\x00\x4c\x00\x00\x00\x4d\x00\x00\x00\x4e\x00\x00\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x00\x00\x00\x00\x55\x00\x56\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x28\x00\x29\x00\x00\x00\x2a\x00\x2b\x00\x3b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3c\x00\x00\x00\x05\x00\x06\x00\x00\x00\x07\x00\x00\x00\x00\x00\x6f\x00\x09\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x00\x00\x4b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4c\x00\x00\x00\x4d\x00\x00\x00\x4e\x00\x00\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x00\x00\xe1\x00\x55\x00\x56\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x7a\x00\x05\x00\x06\x00\x00\x00\x07\x00\x3b\x00\x00\x00\x63\x00\x09\x00\x00\x00\x05\x00\x06\x00\x3c\x00\x07\x00\x00\x00\x5e\x00\x22\x00\x09\x00\x00\x00\x00\x00\x64\x00\x65\x00\x5f\x00\x60\x00\x61\x00\x00\x00\x00\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x00\x00\x4b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4c\x00\x00\x00\x4d\x00\x00\x00\x4e\x00\x00\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x00\x00\x00\x00\x55\x00\x56\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x05\x00\x06\x00\x00\x00\x07\x00\x00\x00\x3b\x00\x66\x00\x09\x00\x7b\x00\x00\x00\x05\x00\x06\x00\x3c\x00\x07\x00\x00\x00\x5e\x00\x22\x00\x09\x00\x00\x00\x67\x00\x65\x00\x00\x00\xea\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x00\x00\x4b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4c\x00\x00\x00\x4d\x00\x00\x00\x4e\x00\x00\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x00\x00\x00\x00\x55\x00\x56\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x83\x00\x05\x00\x06\x00\x00\x00\x07\x00\x3b\x00\x00\x00\x71\x00\x09\x00\x00\x00\x05\x00\x06\x00\x3c\x00\x07\x00\x00\x00\x11\x01\x22\x00\x09\x00\x00\x00\x00\x00\x72\x00\x65\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x00\x00\x4b\x00\x00\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x4c\x00\x00\x00\x4d\x00\x00\x00\x4e\x00\x3b\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x3c\x00\x00\x00\x55\x00\x56\x00\x05\x00\x06\x00\x00\x00\x07\x00\x00\x00\xca\x00\x22\x00\x09\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x00\x00\x4b\x00\x00\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x4c\x00\x00\x00\x4d\x00\x87\x00\x4e\x00\x3b\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x3c\x00\x00\x00\x55\x00\x56\x00\x05\x00\x06\x00\x00\x00\x07\x00\x00\x00\xd0\x00\x22\x00\x09\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x00\x00\x4b\x00\x00\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x4c\x00\x00\x00\x4d\x00\x00\x00\x4e\x00\x00\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x3c\x00\x00\x00\x55\x00\x56\x00\x05\x00\x06\x00\x00\x00\x07\x00\x00\x00\xe8\x00\x22\x00\x09\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x00\x00\x4b\x00\x00\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x4c\x00\x00\x00\x4d\x00\x00\x00\x4e\x00\x3b\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x3c\x00\x00\x00\x55\x00\x56\x00\x05\x00\x06\x00\x00\x00\x07\x00\x00\x00\xf3\x00\x22\x00\x09\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x00\x00\x4b\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x00\x00\x4c\x00\x00\x00\x4d\x00\x00\x00\x4e\x00\x00\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x00\x00\x00\x00\x55\x00\x56\x00\x05\x00\x06\x00\x00\x00\x07\x00\xf5\x00\x00\x00\xf6\x00\x09\x00\x00\x00\x00\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x00\x00\x4b\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x00\x00\x4c\x00\x00\x00\x4d\x00\x00\x00\x4e\x00\x00\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x00\x00\x00\x00\x55\x00\x56\x00\x05\x00\x06\x00\x00\x00\x07\x00\x00\x00\x00\x00\x1a\x01\x09\x00\x00\x00\x00\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x00\x00\x4b\x00\x00\x00\x37\x00\x00\x00\x00\x00\x00\x00\x4c\x00\xd7\x00\x00\x00\x00\x00\x00\x00\x3b\x00\x4f\x00\x50\x00\x00\x00\x52\x00\x53\x00\x54\x00\x3c\x00\x00\x00\x55\x00\x56\x00\x05\x00\x06\x00\x00\x00\x07\x00\x00\x00\x00\x00\x1b\x01\x09\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x00\x00\x4b\x00\x00\x00\x37\x00\x00\x00\x00\x00\x00\x00\x4c\x00\xd8\x00\x4d\x00\x00\x00\x4e\x00\x3b\x00\x4f\x00\x50\x00\x51\x00\x00\x00\x53\x00\x54\x00\x3c\x00\x00\x00\x55\x00\x56\x00\x05\x00\x06\x00\x00\x00\x07\x00\x00\x00\x00\x00\x1c\x01\x09\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x00\x00\x4b\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x00\x00\x4c\x00\x00\x00\x4d\x00\x00\x00\x4e\x00\x00\x00\x4f\x00\x50\x00\x51\x00\x00\x00\x53\x00\x54\x00\x00\x00\x00\x00\x55\x00\x56\x00\x05\x00\x06\x00\x00\x00\x07\x00\x00\x00\x00\x00\x00\x01\x09\x00\x00\x00\x00\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x00\x00\x4b\x00\x00\x00\x37\x00\x00\x00\x00\x00\x00\x00\x4c\x00\x00\x00\x4d\x00\x00\x00\x4e\x00\x3b\x00\x4f\x00\x50\x00\x00\x00\x52\x00\x53\x00\x54\x00\x3c\x00\x00\x00\x55\x00\x56\x00\x05\x00\x06\x00\x00\x00\x07\x00\x00\x00\x00\x00\x01\x01\x09\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x00\x00\x4b\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x00\x00\x4c\x00\x00\x00\x4d\x00\x00\x00\x4e\x00\x00\x00\x4f\x00\x50\x00\x51\x00\x00\x00\x53\x00\x54\x00\x00\x00\x00\x00\x55\x00\x56\x00\x05\x00\x06\x00\x00\x00\x07\x00\x00\x00\x00\x00\x03\x01\x09\x00\x00\x00\x00\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x00\x00\x4b\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x00\x00\x4c\x00\x05\x00\x06\x00\x00\x00\x07\x00\x00\x00\x4f\x00\x04\x01\x09\x00\x52\x00\x53\x00\x54\x00\x00\x00\x00\x00\x55\x00\x56\x00\x05\x00\x06\x00\x00\x00\x07\x00\x00\x00\x00\x00\x09\x01\x09\x00\x00\x00\x00\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x00\x00\x4b\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x00\x00\x4c\x00\x00\x00\x00\x00\x00\x00\xcd\x00\xce\x00\x2b\x00\x00\x00\x00\x00\x52\x00\x53\x00\x54\x00\x00\x00\x00\x00\x55\x00\x56\x00\x05\x00\x06\x00\x00\x00\x07\x00\x00\x00\x00\x00\x6f\x00\x09\x00\x00\x00\x00\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x00\x00\x4b\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x00\x00\x4c\x00\x05\x00\x06\x00\x00\x00\x07\x00\x00\x00\x00\x00\x0a\x01\x09\x00\x52\x00\x00\x00\x54\x00\x00\x00\x00\x00\x55\x00\x56\x00\x05\x00\x06\x00\x00\x00\x07\x00\x00\x00\x00\x00\xcc\x00\x09\x00\x00\x00\x00\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x00\x00\x4b\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x00\x00\x4c\x00\x05\x00\x06\x00\x00\x00\x07\x00\x00\x00\x00\x00\xd5\x00\x09\x00\x52\x00\x05\x00\x06\x00\x00\x00\x07\x00\x55\x00\x56\x00\xe1\x00\x09\x00\x05\x00\x06\x00\x00\x00\x07\x00\x00\x00\x00\x00\xe2\x00\x09\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x00\x00\x43\x00\x44\x00\x37\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x00\x00\x4b\x00\x05\x00\x06\x00\x00\x00\x07\x00\x00\x00\x4c\x00\xe5\x00\x09\x00\x00\x00\x05\x00\x06\x00\x00\x00\x07\x00\x00\x00\x52\x00\xe6\x00\x09\x00\x00\x00\x00\x00\x00\x00\x56\x00\x00\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x00\x00\x4b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3d\x00\x4c\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x00\x00\x4b\x00\x00\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x4c\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x00\x00\x4b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x00\x00\x4b\x00\x00\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x4c\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x00\x00\x4b\x00\x05\x00\x06\x00\x00\x00\x07\x00\x00\x00\x4c\x00\xe7\x00\x09\x00\x05\x00\x06\x00\x00\x00\x07\x00\x00\x00\x00\x00\xed\x00\x09\x00\x05\x00\x06\x00\x00\x00\x07\x00\x00\x00\x00\x00\xee\x00\x09\x00\x05\x00\x06\x00\x00\x00\x07\x00\x00\x00\x00\x00\xf2\x00\x09\x00\x05\x00\x06\x00\x00\x00\x07\x00\x00\x00\x00\x00\xf4\x00\x09\x00\x05\x00\x06\x00\x00\x00\x07\x00\x00\x00\x00\x00\x91\x00\x09\x00\x05\x00\x06\x00\x00\x00\x07\x00\x00\x00\x00\x00\x92\x00\x09\x00\x05\x00\x06\x00\x00\x00\x07\x00\x00\x00\x00\x00\x93\x00\x09\x00\x05\x00\x06\x00\x00\x00\x07\x00\x00\x00\x00\x00\x94\x00\x09\x00\x05\x00\x06\x00\x00\x00\x07\x00\x00\x00\x00\x00\x95\x00\x09\x00\x05\x00\x06\x00\x00\x00\x07\x00\x00\x00\x00\x00\x96\x00\x09\x00\x05\x00\x06\x00\x00\x00\x07\x00\x00\x00\x00\x00\x97\x00\x09\x00\x05\x00\x06\x00\x00\x00\x07\x00\x00\x00\x00\x00\x98\x00\x09\x00\x05\x00\x06\x00\x00\x00\x07\x00\x00\x00\x00\x00\x9b\x00\x09\x00\x05\x00\x06\x00\x00\x00\x07\x00\x00\x00\x00\x00\xa1\x00\x09\x00\x05\x00\x06\x00\x00\x00\x07\x00\x00\x00\x00\x00\xa2\x00\x09\x00\x05\x00\x06\x00\x00\x00\x07\x00\x00\x00\x00\x00\xa3\x00\x09\x00\x05\x00\x06\x00\x00\x00\x07\x00\x00\x00\x00\x00\xa4\x00\x09\x00\x05\x00\x06\x00\x00\x00\x07\x00\x00\x00\x00\x00\xa5\x00\x09\x00\x05\x00\x06\x00\x00\x00\x07\x00\x00\x00\x00\x00\xa6\x00\x09\x00\x05\x00\x06\x00\x00\x00\x07\x00\x00\x00\x00\x00\xa7\x00\x09\x00\x05\x00\x06\x00\x00\x00\x07\x00\x00\x00\x00\x00\xa8\x00\x09\x00\x05\x00\x06\x00\x00\x00\x07\x00\x00\x00\x00\x00\xa9\x00\x09\x00\x05\x00\x06\x00\x00\x00\x07\x00\x00\x00\x00\x00\xaa\x00\x09\x00\x05\x00\x06\x00\x00\x00\x07\x00\x00\x00\x00\x00\xab\x00\x09\x00\x05\x00\x06\x00\x00\x00\x07\x00\x00\x00\x00\x00\xac\x00\x09\x00\x05\x00\x06\x00\x00\x00\x07\x00\x00\x00\x00\x00\xad\x00\x09\x00\x05\x00\x06\x00\x00\x00\x07\x00\x00\x00\x00\x00\xae\x00\x09\x00\x05\x00\x06\x00\x00\x00\x07\x00\x00\x00\x00\x00\xaf\x00\x09\x00\x05\x00\x06\x00\x00\x00\x07\x00\x00\x00\x00\x00\xb0\x00\x09\x00\x05\x00\x06\x00\x00\x00\x07\x00\x00\x00\x00\x00\xb1\x00\x09\x00\x05\x00\x06\x00\x00\x00\x07\x00\x00\x00\x00\x00\xb2\x00\x09\x00\x05\x00\x06\x00\x00\x00\x07\x00\x00\x00\x00\x00\xb3\x00\x09\x00\x05\x00\x06\x00\x00\x00\x07\x00\x00\x00\x00\x00\xb4\x00\x09\x00\x05\x00\x06\x00\x00\x00\x07\x00\x00\x00\x00\x00\x62\x00\x09\x00\x05\x00\x06\x00\x00\x00\x07\x00\x00\x00\x00\x00\x6a\x00\x09\x00\x05\x00\x06\x00\x00\x00\x07\x00\x00\x00\x00\x00\x6b\x00\x09\x00\x05\x00\x06\x00\x00\x00\x07\x00\x00\x00\x00\x00\x6c\x00\x09\x00\x05\x00\x06\x00\x00\x00\x07\x00\x00\x00\x00\x00\x70\x00\x09\x00\x05\x00\x06\x00\x00\x00\x07\x00\x00\x00\x00\x00\x08\x00\x09\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\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, 143) [ - (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) - ] - -happy_n_terms = 80 :: Int -happy_n_nonterms = 44 :: Int - -happyReduce_3 = happySpecReduce_2 0# happyReduction_3 -happyReduction_3 happy_x_2 - happy_x_1 - = case happyOut10 happy_x_2 of { happy_var_2 -> - happyIn6 - (happy_var_2 - )} - -happyReduce_4 = happyMonadReduce 4# 1# happyReduction_4 -happyReduction_4 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut31 happy_x_2 of { happy_var_2 -> - case happyOut30 happy_x_4 of { happy_var_4 -> - ( do - d <- convDecl happy_var_2 happy_var_4 - return $ annotate2 happy_var_1 happy_var_4 (Bind d))}}} - ) (\r -> happyReturn (happyIn7 r)) - -happyReduce_5 = happySpecReduce_2 1# happyReduction_5 -happyReduction_5 happy_x_2 - happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut16 happy_x_2 of { happy_var_2 -> - happyIn7 - (annotate happy_var_1 (RunAssertion happy_var_2) - )}} - -happyReduce_6 = happySpecReduce_1 1# happyReduction_6 -happyReduction_6 happy_x_1 - = case happyOut30 happy_x_1 of { happy_var_1 -> - happyIn7 - (annotate happy_var_1 (Evaluate happy_var_1) - )} - -happyReduce_7 = happySpecReduce_1 2# happyReduction_7 -happyReduction_7 happy_x_1 - = happyIn8 - ( - ) - -happyReduce_8 = happySpecReduce_2 2# happyReduction_8 -happyReduction_8 happy_x_2 - happy_x_1 - = happyIn8 - ( - ) - -happyReduce_9 = happySpecReduce_0 3# happyReduction_9 -happyReduction_9 = happyIn9 - ( - ) - -happyReduce_10 = happySpecReduce_2 3# happyReduction_10 -happyReduction_10 happy_x_2 - happy_x_1 - = happyIn9 - ( - ) - -happyReduce_11 = happySpecReduce_0 4# happyReduction_11 -happyReduction_11 = happyIn10 - ([] - ) - -happyReduce_12 = happySpecReduce_1 4# happyReduction_12 -happyReduction_12 happy_x_1 - = case happyOut11 happy_x_1 of { happy_var_1 -> - happyIn10 - (happy_var_1 - )} - -happyReduce_13 = happySpecReduce_1 5# happyReduction_13 -happyReduction_13 happy_x_1 - = case happyOut12 happy_x_1 of { happy_var_1 -> - happyIn11 - (combineDecls (reverse happy_var_1) - )} - -happyReduce_14 = happySpecReduce_1 6# happyReduction_14 -happyReduction_14 happy_x_1 - = case happyOut14 happy_x_1 of { happy_var_1 -> - happyIn12 - ([happy_var_1] - )} - -happyReduce_15 = happySpecReduce_3 6# happyReduction_15 -happyReduction_15 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut12 happy_x_1 of { happy_var_1 -> - case happyOut13 happy_x_3 of { happy_var_3 -> - happyIn12 - (case happy_var_3 of - Just d -> d:happy_var_1 - Nothing -> happy_var_1 - )}} - -happyReduce_16 = happySpecReduce_0 7# happyReduction_16 -happyReduction_16 = happyIn13 - (Nothing - ) - -happyReduce_17 = happySpecReduce_1 7# happyReduction_17 -happyReduction_17 happy_x_1 - = case happyOut14 happy_x_1 of { happy_var_1 -> - happyIn13 - (Just happy_var_1 - )} - -happyReduce_18 = happyMonadReduce 1# 8# happyReduction_18 -happyReduction_18 (happy_x_1 `HappyStk` - happyRest) tk - = happyThen (case happyOut15 happy_x_1 of { happy_var_1 -> - ( annotateWithSymbolTable happy_var_1)} - ) (\r -> happyReturn (happyIn14 r)) - -happyReduce_19 = happyMonadReduce 3# 9# happyReduction_19 -happyReduction_19 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen (case happyOut31 happy_x_1 of { happy_var_1 -> - case happyOut30 happy_x_3 of { happy_var_3 -> - ( convDecl happy_var_1 happy_var_3)}} - ) (\r -> happyReturn (happyIn15 r)) - -happyReduce_20 = happySpecReduce_2 9# happyReduction_20 -happyReduction_20 happy_x_2 - happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut23 happy_x_2 of { happy_var_2 -> - happyIn15 - (annotate2List happy_var_1 happy_var_2 (Channel (map unLoc happy_var_2) Nothing) - )}} - -happyReduce_21 = happyReduce 4# 9# happyReduction_21 -happyReduction_21 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut23 happy_x_2 of { happy_var_2 -> - case happyOut30 happy_x_4 of { happy_var_4 -> - happyIn15 - (annotate2 happy_var_1 happy_var_4 (Channel (map unLoc happy_var_2) (Just happy_var_4)) - ) `HappyStk` happyRest}}} - -happyReduce_22 = happyReduce 4# 9# happyReduction_22 -happyReduction_22 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut22 happy_x_2 of { happy_var_2 -> - case happyOut20 happy_x_4 of { happy_var_4 -> - happyIn15 - (annotate2List happy_var_1 happy_var_4 (DataType (unLoc happy_var_2) happy_var_4) - ) `HappyStk` happyRest}}} - -happyReduce_23 = happySpecReduce_2 9# happyReduction_23 -happyReduction_23 happy_x_2 - happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut23 happy_x_2 of { happy_var_2 -> - happyIn15 - (annotate2List happy_var_1 happy_var_2 (External (map unLoc happy_var_2)) - )}} - -happyReduce_24 = happySpecReduce_2 9# happyReduction_24 -happyReduction_24 happy_x_2 - happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut23 happy_x_2 of { happy_var_2 -> - happyIn15 - (annotate2List happy_var_1 happy_var_2 (Transparent (map unLoc happy_var_2)) - )}} - -happyReduce_25 = happySpecReduce_2 9# happyReduction_25 -happyReduction_25 happy_x_2 - happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut16 happy_x_2 of { happy_var_2 -> - happyIn15 - (annotate happy_var_1 (Assert happy_var_2) - )}} - -happyReduce_26 = happyReduce 4# 9# happyReduction_26 -happyReduction_26 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut22 happy_x_2 of { happy_var_2 -> - case happyOut30 happy_x_4 of { happy_var_4 -> - happyIn15 - (annotate2 happy_var_1 happy_var_4 (NameType (unLoc happy_var_2) happy_var_4) - ) `HappyStk` happyRest}}} - -happyReduce_27 = happySpecReduce_3 10# happyReduction_27 -happyReduction_27 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut30 happy_x_1 of { happy_var_1 -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut30 happy_x_3 of { happy_var_3 -> - happyIn16 - ((Refinement happy_var_1 (getRefinesModel happy_var_2) happy_var_3 []) - )}}} - -happyReduce_28 = happyReduce 4# 10# happyReduction_28 -happyReduction_28 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) - = case happyOut30 happy_x_1 of { happy_var_1 -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut30 happy_x_3 of { happy_var_3 -> - case happyOut18 happy_x_4 of { happy_var_4 -> - happyIn16 - ((Refinement happy_var_1 (getRefinesModel happy_var_2) happy_var_3 [happy_var_4]) - ) `HappyStk` happyRest}}}} - -happyReduce_29 = happySpecReduce_2 10# happyReduction_29 -happyReduction_29 happy_x_2 - happy_x_1 - = case happyOut30 happy_x_1 of { happy_var_1 -> - case happyOut17 happy_x_2 of { happy_var_2 -> - happyIn16 - ((PropertyCheck happy_var_1 happy_var_2 Nothing) - )}} - -happyReduce_30 = happySpecReduce_3 10# happyReduction_30 -happyReduction_30 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut30 happy_x_1 of { happy_var_1 -> - case happyOut17 happy_x_2 of { happy_var_2 -> - case happyOutTok happy_x_3 of { happy_var_3 -> - happyIn16 - ((PropertyCheck happy_var_1 happy_var_2 (Just (getPropModel happy_var_3))) - )}}} - -happyReduce_31 = happySpecReduce_1 11# happyReduction_31 -happyReduction_31 happy_x_1 - = happyIn17 - (DeadlockFreedom - ) - -happyReduce_32 = happySpecReduce_1 11# happyReduction_32 -happyReduction_32 happy_x_1 - = happyIn17 - (LivelockFreedom - ) - -happyReduce_33 = happySpecReduce_1 11# happyReduction_33 -happyReduction_33 happy_x_1 - = happyIn17 - (LivelockFreedom - ) - -happyReduce_34 = happySpecReduce_1 11# happyReduction_34 -happyReduction_34 happy_x_1 - = happyIn17 - (Deterministic - ) - -happyReduce_35 = happySpecReduce_2 12# happyReduction_35 -happyReduction_35 happy_x_2 - happy_x_1 - = case happyOut30 happy_x_2 of { happy_var_2 -> - happyIn18 - (TauPriority happy_var_2 - )} - -happyReduce_36 = happySpecReduce_3 13# happyReduction_36 -happyReduction_36 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut22 happy_x_1 of { happy_var_1 -> - case happyOut30 happy_x_3 of { happy_var_3 -> - happyIn19 - (annotate2 happy_var_1 happy_var_3 (DataTypeClause (unLoc happy_var_1) (Just happy_var_3)) - )}} - -happyReduce_37 = happySpecReduce_1 13# happyReduction_37 -happyReduction_37 happy_x_1 - = case happyOut22 happy_x_1 of { happy_var_1 -> - happyIn19 - (annotate happy_var_1 (DataTypeClause (unLoc happy_var_1) Nothing) - )} - -happyReduce_38 = happySpecReduce_1 14# happyReduction_38 -happyReduction_38 happy_x_1 - = case happyOut21 happy_x_1 of { happy_var_1 -> - happyIn20 - (reverse happy_var_1 - )} - -happyReduce_39 = happySpecReduce_1 15# happyReduction_39 -happyReduction_39 happy_x_1 - = case happyOut19 happy_x_1 of { happy_var_1 -> - happyIn21 - ([happy_var_1] - )} - -happyReduce_40 = happySpecReduce_3 15# happyReduction_40 -happyReduction_40 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut21 happy_x_1 of { happy_var_1 -> - case happyOut19 happy_x_3 of { happy_var_3 -> - happyIn21 - (happy_var_3:happy_var_1 - )}} - -happyReduce_41 = happySpecReduce_1 16# happyReduction_41 -happyReduction_41 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn22 - (liftLoc happy_var_1 (Name (getName happy_var_1)) - )} - -happyReduce_42 = happySpecReduce_1 17# happyReduction_42 -happyReduction_42 happy_x_1 - = case happyOut24 happy_x_1 of { happy_var_1 -> - happyIn23 - (reverse happy_var_1 - )} - -happyReduce_43 = happySpecReduce_1 18# happyReduction_43 -happyReduction_43 happy_x_1 - = case happyOut22 happy_x_1 of { happy_var_1 -> - happyIn24 - ([happy_var_1] - )} - -happyReduce_44 = happySpecReduce_3 18# happyReduction_44 -happyReduction_44 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut24 happy_x_1 of { happy_var_1 -> - case happyOut22 happy_x_3 of { happy_var_3 -> - happyIn24 - (happy_var_3:happy_var_1 - )}} - -happyReduce_45 = happySpecReduce_1 19# happyReduction_45 -happyReduction_45 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn25 - (liftLoc happy_var_1 (UnQual (Name (getName happy_var_1))) - )} - -happyReduce_46 = happySpecReduce_1 20# happyReduction_46 -happyReduction_46 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn26 - (liftLoc happy_var_1 (Int (getInt happy_var_1)) - )} - -happyReduce_47 = happySpecReduce_1 20# happyReduction_47 -happyReduction_47 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn26 - (liftLoc happy_var_1 (Bool True) - )} - -happyReduce_48 = happySpecReduce_1 20# happyReduction_48 -happyReduction_48 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn26 - (liftLoc happy_var_1 (Bool False) - )} - -happyReduce_49 = happySpecReduce_1 21# happyReduction_49 -happyReduction_49 happy_x_1 - = case happyOut31 happy_x_1 of { happy_var_1 -> - happyIn27 - (convPat happy_var_1 - )} - -happyReduce_50 = happyMonadReduce 1# 22# happyReduction_50 -happyReduction_50 (happy_x_1 `HappyStk` - happyRest) tk - = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> - ( do - modifyTopFileParserState ( - \ st @ (FileParserState { sequenceStack = (c:cs) }) -> - st { sequenceStack = (c+1):cs }) - return happy_var_1)} - ) (\r -> happyReturn (happyIn28 r)) - -happyReduce_51 = happyMonadReduce 1# 23# happyReduction_51 -happyReduction_51 (happy_x_1 `HappyStk` - happyRest) tk - = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> - ( do - modifyTopFileParserState ( - \ st @ (FileParserState { sequenceStack = (c:cs) }) -> - st { sequenceStack = (c-1):cs }) - return happy_var_1)} - ) (\r -> happyReturn (happyIn29 r)) - -happyReduce_52 = happySpecReduce_1 24# happyReduction_52 -happyReduction_52 happy_x_1 - = case happyOut31 happy_x_1 of { happy_var_1 -> - happyIn30 - (checkExp happy_var_1 - )} - -happyReduce_53 = happyMonadReduce 1# 25# happyReduction_53 -happyReduction_53 (happy_x_1 `HappyStk` - happyRest) tk - = happyThen (case happyOut32 happy_x_1 of { happy_var_1 -> - ( do - t <- freshPType - let An l _ e = happy_var_1 - return $ An l (Nothing, t) e)} - ) (\r -> happyReturn (happyIn31 r)) - -happyReduce_54 = happySpecReduce_1 26# happyReduction_54 -happyReduction_54 happy_x_1 - = case happyOut26 happy_x_1 of { happy_var_1 -> - happyIn32 - (liftLoc happy_var_1 (Lit (unLoc happy_var_1)) - )} - -happyReduce_55 = happySpecReduce_1 26# happyReduction_55 -happyReduction_55 happy_x_1 - = case happyOut25 happy_x_1 of { happy_var_1 -> - happyIn32 - (liftLoc happy_var_1 (Var (unLoc happy_var_1)) - )} - -happyReduce_56 = happySpecReduce_3 26# happyReduction_56 -happyReduction_56 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut42 happy_x_2 of { happy_var_2 -> - case happyOutTok happy_x_3 of { happy_var_3 -> - happyIn32 - (annotate2 happy_var_1 happy_var_3 (Tuple happy_var_2) - )}}} - -happyReduce_57 = happySpecReduce_3 26# happyReduction_57 -happyReduction_57 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut31 happy_x_1 of { happy_var_1 -> - case happyOut31 happy_x_3 of { happy_var_3 -> - happyIn32 - (annotate2 happy_var_1 happy_var_3 (DotApp happy_var_1 happy_var_3) - )}} - -happyReduce_58 = happyReduce 4# 26# happyReduction_58 -happyReduction_58 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut11 happy_x_2 of { happy_var_2 -> - case happyOut31 happy_x_4 of { happy_var_4 -> - happyIn32 - (annotate2 happy_var_1 happy_var_4 (Let (checkLetDecls happy_var_2) happy_var_4) - ) `HappyStk` happyRest}}} - -happyReduce_59 = happyReduce 6# 26# happyReduction_59 -happyReduction_59 (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_1 of { happy_var_1 -> - case happyOut31 happy_x_2 of { happy_var_2 -> - case happyOut31 happy_x_4 of { happy_var_4 -> - case happyOut31 happy_x_6 of { happy_var_6 -> - happyIn32 - (annotate2 happy_var_1 happy_var_6 (If happy_var_2 happy_var_4 happy_var_6) - ) `HappyStk` happyRest}}}} - -happyReduce_60 = happySpecReduce_3 26# happyReduction_60 -happyReduction_60 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut31 happy_x_2 of { happy_var_2 -> - case happyOutTok happy_x_3 of { happy_var_3 -> - happyIn32 - (annotate2 happy_var_1 happy_var_3 (Paren happy_var_2) - )}}} - -happyReduce_61 = happyReduce 4# 26# happyReduction_61 -happyReduction_61 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) - = case happyOut31 happy_x_1 of { happy_var_1 -> - case happyOut44 happy_x_3 of { happy_var_3 -> - case happyOutTok happy_x_4 of { happy_var_4 -> - happyIn32 - (annotate2 happy_var_1 happy_var_4 (App happy_var_1 happy_var_3) - ) `HappyStk` happyRest}}} - -happyReduce_62 = happyReduce 4# 26# happyReduction_62 -happyReduction_62 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut27 happy_x_2 of { happy_var_2 -> - case happyOut31 happy_x_4 of { happy_var_4 -> - happyIn32 - (annotate2 happy_var_1 happy_var_4 (Lambda happy_var_2 happy_var_4) - ) `HappyStk` happyRest}}} - -happyReduce_63 = happySpecReduce_3 26# happyReduction_63 -happyReduction_63 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut31 happy_x_1 of { happy_var_1 -> - case happyOut31 happy_x_3 of { happy_var_3 -> - happyIn32 - (annotate2 happy_var_1 happy_var_3 (BooleanBinaryOp Equals happy_var_1 happy_var_3) - )}} - -happyReduce_64 = happySpecReduce_3 26# happyReduction_64 -happyReduction_64 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut31 happy_x_1 of { happy_var_1 -> - case happyOut31 happy_x_3 of { happy_var_3 -> - happyIn32 - (annotate2 happy_var_1 happy_var_3 (BooleanBinaryOp NotEquals happy_var_1 happy_var_3) - )}} - -happyReduce_65 = happySpecReduce_3 26# happyReduction_65 -happyReduction_65 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut31 happy_x_1 of { happy_var_1 -> - case happyOut31 happy_x_3 of { happy_var_3 -> - happyIn32 - (annotate2 happy_var_1 happy_var_3 (BooleanBinaryOp LessThan happy_var_1 happy_var_3) - )}} - -happyReduce_66 = happySpecReduce_3 26# happyReduction_66 -happyReduction_66 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut31 happy_x_1 of { happy_var_1 -> - case happyOut31 happy_x_3 of { happy_var_3 -> - happyIn32 - (annotate2 happy_var_1 happy_var_3 (BooleanBinaryOp GreaterThan happy_var_1 happy_var_3) - )}} - -happyReduce_67 = happySpecReduce_3 26# happyReduction_67 -happyReduction_67 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut31 happy_x_1 of { happy_var_1 -> - case happyOut31 happy_x_3 of { happy_var_3 -> - happyIn32 - (annotate2 happy_var_1 happy_var_3 (BooleanBinaryOp LessThanEq happy_var_1 happy_var_3) - )}} - -happyReduce_68 = happySpecReduce_3 26# happyReduction_68 -happyReduction_68 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut31 happy_x_1 of { happy_var_1 -> - case happyOut31 happy_x_3 of { happy_var_3 -> - happyIn32 - (annotate2 happy_var_1 happy_var_3 (BooleanBinaryOp GreaterThanEq happy_var_1 happy_var_3) - )}} - -happyReduce_69 = happySpecReduce_2 26# happyReduction_69 -happyReduction_69 happy_x_2 - happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut31 happy_x_2 of { happy_var_2 -> - happyIn32 - (annotate2 happy_var_1 happy_var_2 (BooleanUnaryOp Not happy_var_2) - )}} - -happyReduce_70 = happySpecReduce_3 26# happyReduction_70 -happyReduction_70 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut31 happy_x_1 of { happy_var_1 -> - case happyOut31 happy_x_3 of { happy_var_3 -> - happyIn32 - (annotate2 happy_var_1 happy_var_3 (BooleanBinaryOp Or happy_var_1 happy_var_3) - )}} - -happyReduce_71 = happySpecReduce_3 26# happyReduction_71 -happyReduction_71 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut31 happy_x_1 of { happy_var_1 -> - case happyOut31 happy_x_3 of { happy_var_3 -> - happyIn32 - (annotate2 happy_var_1 happy_var_3 (BooleanBinaryOp And happy_var_1 happy_var_3) - )}} - -happyReduce_72 = happySpecReduce_2 26# happyReduction_72 -happyReduction_72 happy_x_2 - happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut31 happy_x_2 of { happy_var_2 -> - happyIn32 - (annotate2 happy_var_1 happy_var_2 (MathsUnaryOp Negate happy_var_2) - )}} - -happyReduce_73 = happySpecReduce_3 26# happyReduction_73 -happyReduction_73 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut31 happy_x_1 of { happy_var_1 -> - case happyOut31 happy_x_3 of { happy_var_3 -> - happyIn32 - (annotate2 happy_var_1 happy_var_3 (MathsBinaryOp Plus happy_var_1 happy_var_3) - )}} - -happyReduce_74 = happySpecReduce_3 26# happyReduction_74 -happyReduction_74 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut31 happy_x_1 of { happy_var_1 -> - case happyOut31 happy_x_3 of { happy_var_3 -> - happyIn32 - (annotate2 happy_var_1 happy_var_3 (MathsBinaryOp Minus happy_var_1 happy_var_3) - )}} - -happyReduce_75 = happySpecReduce_3 26# happyReduction_75 -happyReduction_75 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut31 happy_x_1 of { happy_var_1 -> - case happyOut31 happy_x_3 of { happy_var_3 -> - happyIn32 - (annotate2 happy_var_1 happy_var_3 (MathsBinaryOp Mod happy_var_1 happy_var_3) - )}} - -happyReduce_76 = happySpecReduce_3 26# happyReduction_76 -happyReduction_76 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut31 happy_x_1 of { happy_var_1 -> - case happyOut31 happy_x_3 of { happy_var_3 -> - happyIn32 - (annotate2 happy_var_1 happy_var_3 (MathsBinaryOp Divide happy_var_1 happy_var_3) - )}} - -happyReduce_77 = happySpecReduce_3 26# happyReduction_77 -happyReduction_77 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut31 happy_x_1 of { happy_var_1 -> - case happyOut31 happy_x_3 of { happy_var_3 -> - happyIn32 - (annotate2 happy_var_1 happy_var_3 (MathsBinaryOp Times happy_var_1 happy_var_3) - )}} - -happyReduce_78 = happySpecReduce_1 26# happyReduction_78 -happyReduction_78 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn32 - (annotate happy_var_1 (List []) - )} - -happyReduce_79 = happySpecReduce_3 26# happyReduction_79 -happyReduction_79 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut28 happy_x_1 of { happy_var_1 -> - case happyOut44 happy_x_2 of { happy_var_2 -> - case happyOut29 happy_x_3 of { happy_var_3 -> - happyIn32 - (annotate2 happy_var_1 happy_var_3 (List happy_var_2) - )}}} - -happyReduce_80 = happyReduce 5# 26# happyReduction_80 -happyReduction_80 (happy_x_5 `HappyStk` - happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) - = case happyOut28 happy_x_1 of { happy_var_1 -> - case happyOut44 happy_x_2 of { happy_var_2 -> - case happyOut48 happy_x_4 of { happy_var_4 -> - case happyOut29 happy_x_5 of { happy_var_5 -> - happyIn32 - (annotate2 happy_var_1 happy_var_5 (ListComp happy_var_2 happy_var_4) - ) `HappyStk` happyRest}}}} - -happyReduce_81 = happyReduce 4# 26# happyReduction_81 -happyReduction_81 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) - = case happyOut28 happy_x_1 of { happy_var_1 -> - case happyOut31 happy_x_2 of { happy_var_2 -> - case happyOut29 happy_x_4 of { happy_var_4 -> - happyIn32 - (annotate2 happy_var_1 happy_var_4 (ListEnumFrom happy_var_2) - ) `HappyStk` happyRest}}} - -happyReduce_82 = happyReduce 5# 26# happyReduction_82 -happyReduction_82 (happy_x_5 `HappyStk` - happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) - = case happyOut28 happy_x_1 of { happy_var_1 -> - case happyOut31 happy_x_2 of { happy_var_2 -> - case happyOut31 happy_x_4 of { happy_var_4 -> - case happyOut29 happy_x_5 of { happy_var_5 -> - happyIn32 - (annotate2 happy_var_1 happy_var_5 (ListEnumFromTo happy_var_2 happy_var_4) - ) `HappyStk` happyRest}}}} - -happyReduce_83 = happySpecReduce_3 26# happyReduction_83 -happyReduction_83 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut31 happy_x_1 of { happy_var_1 -> - case happyOut31 happy_x_3 of { happy_var_3 -> - happyIn32 - (annotate2 happy_var_1 happy_var_3 (Concat happy_var_1 happy_var_3) - )}} - -happyReduce_84 = happySpecReduce_2 26# happyReduction_84 -happyReduction_84 happy_x_2 - happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut31 happy_x_2 of { happy_var_2 -> - happyIn32 - (annotate2 happy_var_1 happy_var_2 (ListLength happy_var_2) - )}} - -happyReduce_85 = happySpecReduce_3 26# happyReduction_85 -happyReduction_85 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut44 happy_x_2 of { happy_var_2 -> - case happyOutTok happy_x_3 of { happy_var_3 -> - happyIn32 - (annotate2 happy_var_1 happy_var_3 (Set happy_var_2) - )}}} - -happyReduce_86 = happyReduce 5# 26# happyReduction_86 -happyReduction_86 (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 { happy_var_1 -> - case happyOut44 happy_x_2 of { happy_var_2 -> - case happyOut48 happy_x_4 of { happy_var_4 -> - case happyOutTok happy_x_5 of { happy_var_5 -> - happyIn32 - (annotate2 happy_var_1 happy_var_5 (SetComp happy_var_2 happy_var_4) - ) `HappyStk` happyRest}}}} - -happyReduce_87 = happyReduce 4# 26# happyReduction_87 -happyReduction_87 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut31 happy_x_2 of { happy_var_2 -> - case happyOutTok happy_x_4 of { happy_var_4 -> - happyIn32 - (annotate2 happy_var_1 happy_var_4 (SetEnumFrom happy_var_2) - ) `HappyStk` happyRest}}} - -happyReduce_88 = happyReduce 5# 26# happyReduction_88 -happyReduction_88 (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 { happy_var_1 -> - case happyOut31 happy_x_2 of { happy_var_2 -> - case happyOut31 happy_x_4 of { happy_var_4 -> - case happyOutTok happy_x_5 of { happy_var_5 -> - happyIn32 - (annotate2 happy_var_1 happy_var_5 (SetEnumFromTo happy_var_2 happy_var_4) - ) `HappyStk` happyRest}}}} - -happyReduce_89 = happySpecReduce_3 26# happyReduction_89 -happyReduction_89 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut44 happy_x_2 of { happy_var_2 -> - case happyOutTok happy_x_3 of { happy_var_3 -> - happyIn32 - (annotate2 happy_var_1 happy_var_3 (SetEnum happy_var_2) - )}}} - -happyReduce_90 = happyReduce 5# 26# happyReduction_90 -happyReduction_90 (happy_x_5 `HappyStk` - happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut44 happy_x_2 of { happy_var_2 -> - case happyOut48 happy_x_4 of { happy_var_4 -> - case happyOutTok happy_x_5 of { happy_var_5 -> - happyIn32 - (annotate2 happy_var_1 happy_var_5 (SetEnumComp happy_var_2 happy_var_4) - ) `HappyStk` happyRest}}}} - -happyReduce_91 = happySpecReduce_1 26# happyReduction_91 -happyReduction_91 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn32 - (liftLoc happy_var_1 (ExpPatWildCard) - )} - -happyReduce_92 = happySpecReduce_3 26# happyReduction_92 -happyReduction_92 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut31 happy_x_1 of { happy_var_1 -> - case happyOut31 happy_x_3 of { happy_var_3 -> - happyIn32 - (liftLoc happy_var_1 (ExpPatDoublePattern happy_var_1 happy_var_3) - )}} - -happyReduce_93 = happyReduce 4# 26# happyReduction_93 -happyReduction_93 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) - = case happyOut31 happy_x_1 of { happy_var_1 -> - case happyOut40 happy_x_2 of { happy_var_2 -> - case happyOut31 happy_x_4 of { happy_var_4 -> - happyIn32 - (annotate2 happy_var_1 happy_var_4 (Prefix happy_var_1 happy_var_2 happy_var_4) - ) `HappyStk` happyRest}}} - -happyReduce_94 = happySpecReduce_3 26# happyReduction_94 -happyReduction_94 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut31 happy_x_1 of { happy_var_1 -> - case happyOut31 happy_x_3 of { happy_var_3 -> - happyIn32 - (annotate2 happy_var_1 happy_var_3 (Prefix happy_var_1 [] happy_var_3) - )}} - -happyReduce_95 = happySpecReduce_3 26# happyReduction_95 -happyReduction_95 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut31 happy_x_1 of { happy_var_1 -> - case happyOut31 happy_x_3 of { happy_var_3 -> - happyIn32 - (annotate2 happy_var_1 happy_var_3 (ExternalChoice happy_var_1 happy_var_3) - )}} - -happyReduce_96 = happySpecReduce_3 26# happyReduction_96 -happyReduction_96 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut31 happy_x_1 of { happy_var_1 -> - case happyOut31 happy_x_3 of { happy_var_3 -> - happyIn32 - (annotate2 happy_var_1 happy_var_3 (Hiding happy_var_1 happy_var_3) - )}} - -happyReduce_97 = happySpecReduce_3 26# happyReduction_97 -happyReduction_97 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut31 happy_x_1 of { happy_var_1 -> - case happyOut31 happy_x_3 of { happy_var_3 -> - happyIn32 - (annotate2 happy_var_1 happy_var_3 (InternalChoice happy_var_1 happy_var_3) - )}} - -happyReduce_98 = happySpecReduce_3 26# happyReduction_98 -happyReduction_98 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut31 happy_x_1 of { happy_var_1 -> - case happyOut31 happy_x_3 of { happy_var_3 -> - happyIn32 - (annotate2 happy_var_1 happy_var_3 (Interleave happy_var_1 happy_var_3) - )}} - -happyReduce_99 = happyReduce 5# 26# happyReduction_99 -happyReduction_99 (happy_x_5 `HappyStk` - happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) - = case happyOut31 happy_x_1 of { happy_var_1 -> - case happyOut31 happy_x_3 of { happy_var_3 -> - case happyOut31 happy_x_5 of { happy_var_5 -> - happyIn32 - (annotate2 happy_var_1 happy_var_5 (GenParallel happy_var_1 happy_var_3 happy_var_5) - ) `HappyStk` happyRest}}} - -happyReduce_100 = happyReduce 7# 26# happyReduction_100 -happyReduction_100 (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 happyOut31 happy_x_1 of { happy_var_1 -> - case happyOut31 happy_x_3 of { happy_var_3 -> - case happyOut31 happy_x_5 of { happy_var_5 -> - case happyOut31 happy_x_7 of { happy_var_7 -> - happyIn32 - (annotate2 happy_var_1 happy_var_7 (AlphaParallel happy_var_1 happy_var_3 happy_var_5 happy_var_7) - ) `HappyStk` happyRest}}}} - -happyReduce_101 = happySpecReduce_3 26# happyReduction_101 -happyReduction_101 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut31 happy_x_1 of { happy_var_1 -> - case happyOut31 happy_x_3 of { happy_var_3 -> - happyIn32 - (annotate2 happy_var_1 happy_var_3 (Interrupt happy_var_1 happy_var_3) - )}} - -happyReduce_102 = happyReduce 5# 26# happyReduction_102 -happyReduction_102 (happy_x_5 `HappyStk` - happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) - = case happyOut31 happy_x_1 of { happy_var_1 -> - case happyOut31 happy_x_3 of { happy_var_3 -> - case happyOut31 happy_x_5 of { happy_var_5 -> - happyIn32 - (annotate2 happy_var_1 happy_var_5 (Exception happy_var_1 happy_var_3 happy_var_5) - ) `HappyStk` happyRest}}} - -happyReduce_103 = happySpecReduce_3 26# happyReduction_103 -happyReduction_103 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut31 happy_x_1 of { happy_var_1 -> - case happyOut31 happy_x_3 of { happy_var_3 -> - happyIn32 - (annotate2 happy_var_1 happy_var_3 (SlidingChoice happy_var_1 happy_var_3) - )}} - -happyReduce_104 = happySpecReduce_3 26# happyReduction_104 -happyReduction_104 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut31 happy_x_1 of { happy_var_1 -> - case happyOut31 happy_x_3 of { happy_var_3 -> - happyIn32 - (annotate2 happy_var_1 happy_var_3 (SequentialComp happy_var_1 happy_var_3) - )}} - -happyReduce_105 = happySpecReduce_3 26# happyReduction_105 -happyReduction_105 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut31 happy_x_1 of { happy_var_1 -> - case happyOut31 happy_x_3 of { happy_var_3 -> - happyIn32 - (annotate2 happy_var_1 happy_var_3 (GuardedExp happy_var_1 happy_var_3) - )}} - -happyReduce_106 = happyReduce 5# 26# happyReduction_106 -happyReduction_106 (happy_x_5 `HappyStk` - happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) - = case happyOut31 happy_x_1 of { happy_var_1 -> - case happyOut35 happy_x_3 of { happy_var_3 -> - case happyOut46 happy_x_4 of { happy_var_4 -> - case happyOutTok happy_x_5 of { happy_var_5 -> - happyIn32 - (annotate2 happy_var_1 happy_var_5 (Rename happy_var_1 happy_var_3 happy_var_4) - ) `HappyStk` happyRest}}}} - -happyReduce_107 = happyReduce 6# 26# happyReduction_107 -happyReduction_107 (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 happyOut31 happy_x_1 of { happy_var_1 -> - case happyOut38 happy_x_3 of { happy_var_3 -> - case happyOut46 happy_x_4 of { happy_var_4 -> - case happyOut31 happy_x_6 of { happy_var_6 -> - happyIn32 - (annotate2 happy_var_1 happy_var_6 (LinkParallel happy_var_1 happy_var_3 happy_var_4 happy_var_6) - ) `HappyStk` happyRest}}}} - -happyReduce_108 = happyReduce 4# 26# happyReduction_108 -happyReduction_108 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut48 happy_x_2 of { happy_var_2 -> - case happyOut31 happy_x_4 of { happy_var_4 -> - happyIn32 - (annotate2 happy_var_1 happy_var_4 (ReplicatedInterleave happy_var_2 happy_var_4) - ) `HappyStk` happyRest}}} - -happyReduce_109 = happyReduce 4# 26# happyReduction_109 -happyReduction_109 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut48 happy_x_2 of { happy_var_2 -> - case happyOut31 happy_x_4 of { happy_var_4 -> - happyIn32 - (annotate2 happy_var_1 happy_var_4 (ReplicatedExternalChoice happy_var_2 happy_var_4) - ) `HappyStk` happyRest}}} - -happyReduce_110 = happyReduce 4# 26# happyReduction_110 -happyReduction_110 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut48 happy_x_2 of { happy_var_2 -> - case happyOut31 happy_x_4 of { happy_var_4 -> - happyIn32 - (annotate2 happy_var_1 happy_var_4 (ReplicatedInternalChoice happy_var_2 happy_var_4) - ) `HappyStk` happyRest}}} - -happyReduce_111 = happyReduce 7# 26# happyReduction_111 -happyReduction_111 (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_1 of { happy_var_1 -> - case happyOut48 happy_x_2 of { happy_var_2 -> - case happyOut31 happy_x_5 of { happy_var_5 -> - case happyOut31 happy_x_7 of { happy_var_7 -> - happyIn32 - (annotate2 happy_var_1 happy_var_7 (ReplicatedAlphaParallel happy_var_2 happy_var_5 happy_var_7) - ) `HappyStk` happyRest}}}} - -happyReduce_112 = happyReduce 6# 26# happyReduction_112 -happyReduction_112 (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_1 of { happy_var_1 -> - case happyOut31 happy_x_2 of { happy_var_2 -> - case happyOut48 happy_x_4 of { happy_var_4 -> - case happyOut31 happy_x_6 of { happy_var_6 -> - happyIn32 - (annotate2 happy_var_1 happy_var_6 (ReplicatedParallel happy_var_2 happy_var_4 happy_var_6) - ) `HappyStk` happyRest}}}} - -happyReduce_113 = happyReduce 6# 26# happyReduction_113 -happyReduction_113 (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_1 of { happy_var_1 -> - case happyOut38 happy_x_2 of { happy_var_2 -> - case happyOut48 happy_x_4 of { happy_var_4 -> - case happyOut31 happy_x_6 of { happy_var_6 -> - happyIn32 - (annotate2 happy_var_1 happy_var_6 (ReplicatedLinkParallel happy_var_2 happy_var_4 happy_var_6) - ) `HappyStk` happyRest}}}} - -happyReduce_114 = happySpecReduce_2 27# happyReduction_114 -happyReduction_114 happy_x_2 - happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut31 happy_x_2 of { happy_var_2 -> - happyIn33 - (annotate2 happy_var_1 happy_var_2 (Input (convPat happy_var_2) Nothing) - )}} - -happyReduce_115 = happyReduce 4# 27# happyReduction_115 -happyReduction_115 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut31 happy_x_2 of { happy_var_2 -> - case happyOut31 happy_x_4 of { happy_var_4 -> - happyIn33 - (annotate2 happy_var_1 happy_var_4 (Input (convPat happy_var_2) (Just (checkExp happy_var_4))) - ) `HappyStk` happyRest}}} - -happyReduce_116 = happySpecReduce_2 27# happyReduction_116 -happyReduction_116 happy_x_2 - happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut31 happy_x_2 of { happy_var_2 -> - happyIn33 - (annotate2 happy_var_1 happy_var_2 (NonDetInput (convPat happy_var_2) Nothing) - )}} - -happyReduce_117 = happyReduce 4# 27# happyReduction_117 -happyReduction_117 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut31 happy_x_2 of { happy_var_2 -> - case happyOut31 happy_x_4 of { happy_var_4 -> - happyIn33 - (annotate2 happy_var_1 happy_var_4 (NonDetInput (convPat happy_var_2) (Just (checkExp happy_var_4))) - ) `HappyStk` happyRest}}} - -happyReduce_118 = happySpecReduce_2 27# happyReduction_118 -happyReduction_118 happy_x_2 - happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut31 happy_x_2 of { happy_var_2 -> - happyIn33 - (annotate2 happy_var_1 happy_var_2 (Output (checkExp happy_var_2)) - )}} - -happyReduce_119 = happySpecReduce_3 28# happyReduction_119 -happyReduction_119 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut30 happy_x_1 of { happy_var_1 -> - case happyOut30 happy_x_3 of { happy_var_3 -> - happyIn34 - ((happy_var_1, happy_var_3) - )}} - -happyReduce_120 = happySpecReduce_1 29# happyReduction_120 -happyReduction_120 happy_x_1 - = case happyOut36 happy_x_1 of { happy_var_1 -> - happyIn35 - (reverse happy_var_1 - )} - -happyReduce_121 = happySpecReduce_1 30# happyReduction_121 -happyReduction_121 happy_x_1 - = case happyOut34 happy_x_1 of { happy_var_1 -> - happyIn36 - ([happy_var_1] - )} - -happyReduce_122 = happySpecReduce_3 30# happyReduction_122 -happyReduction_122 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut36 happy_x_1 of { happy_var_1 -> - case happyOut34 happy_x_3 of { happy_var_3 -> - happyIn36 - (happy_var_3:happy_var_1 - )}} - -happyReduce_123 = happySpecReduce_3 31# happyReduction_123 -happyReduction_123 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut30 happy_x_1 of { happy_var_1 -> - case happyOut30 happy_x_3 of { happy_var_3 -> - happyIn37 - ((happy_var_1, happy_var_3) - )}} - -happyReduce_124 = happySpecReduce_1 32# happyReduction_124 -happyReduction_124 happy_x_1 - = case happyOut39 happy_x_1 of { happy_var_1 -> - happyIn38 - (reverse happy_var_1 - )} - -happyReduce_125 = happySpecReduce_1 33# happyReduction_125 -happyReduction_125 happy_x_1 - = case happyOut37 happy_x_1 of { happy_var_1 -> - happyIn39 - ([happy_var_1] - )} - -happyReduce_126 = happySpecReduce_3 33# happyReduction_126 -happyReduction_126 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut39 happy_x_1 of { happy_var_1 -> - case happyOut37 happy_x_3 of { happy_var_3 -> - happyIn39 - (happy_var_3:happy_var_1 - )}} - -happyReduce_127 = happySpecReduce_1 34# happyReduction_127 -happyReduction_127 happy_x_1 - = case happyOut41 happy_x_1 of { happy_var_1 -> - happyIn40 - (reverse happy_var_1 - )} - -happyReduce_128 = happySpecReduce_1 35# happyReduction_128 -happyReduction_128 happy_x_1 - = case happyOut33 happy_x_1 of { happy_var_1 -> - happyIn41 - ([happy_var_1] - )} - -happyReduce_129 = happySpecReduce_2 35# happyReduction_129 -happyReduction_129 happy_x_2 - happy_x_1 - = case happyOut41 happy_x_1 of { happy_var_1 -> - case happyOut33 happy_x_2 of { happy_var_2 -> - happyIn41 - (happy_var_2:happy_var_1 - )}} - -happyReduce_130 = happySpecReduce_3 36# happyReduction_130 -happyReduction_130 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut31 happy_x_1 of { happy_var_1 -> - case happyOut45 happy_x_3 of { happy_var_3 -> - happyIn42 - (happy_var_1:(reverse happy_var_3) - )}} - -happyReduce_131 = happySpecReduce_1 37# happyReduction_131 -happyReduction_131 happy_x_1 - = case happyOut45 happy_x_1 of { happy_var_1 -> - happyIn43 - (reverse happy_var_1 - )} - -happyReduce_132 = happySpecReduce_0 38# happyReduction_132 -happyReduction_132 = happyIn44 - ([] - ) - -happyReduce_133 = happySpecReduce_1 38# happyReduction_133 -happyReduction_133 happy_x_1 - = case happyOut45 happy_x_1 of { happy_var_1 -> - happyIn44 - (reverse happy_var_1 - )} - -happyReduce_134 = happySpecReduce_3 39# happyReduction_134 -happyReduction_134 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut45 happy_x_1 of { happy_var_1 -> - case happyOut31 happy_x_3 of { happy_var_3 -> - happyIn45 - (happy_var_3:happy_var_1 - )}} - -happyReduce_135 = happySpecReduce_1 39# happyReduction_135 -happyReduction_135 happy_x_1 - = case happyOut31 happy_x_1 of { happy_var_1 -> - happyIn45 - ([happy_var_1] - )} - -happyReduce_136 = happySpecReduce_0 40# happyReduction_136 -happyReduction_136 = happyIn46 - ([] - ) - -happyReduce_137 = happySpecReduce_2 40# happyReduction_137 -happyReduction_137 happy_x_2 - happy_x_1 - = case happyOut48 happy_x_2 of { happy_var_2 -> - happyIn46 - (happy_var_2 - )} - -happyReduce_138 = happySpecReduce_3 41# happyReduction_138 -happyReduction_138 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut27 happy_x_1 of { happy_var_1 -> - case happyOut31 happy_x_3 of { happy_var_3 -> - happyIn47 - (annotate2 happy_var_1 happy_var_3 (Generator happy_var_1 happy_var_3) - )}} - -happyReduce_139 = happySpecReduce_3 41# happyReduction_139 -happyReduction_139 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut27 happy_x_1 of { happy_var_1 -> - case happyOut31 happy_x_3 of { happy_var_3 -> - happyIn47 - (annotate2 happy_var_1 happy_var_3 (Generator happy_var_1 happy_var_3) - )}} - -happyReduce_140 = happySpecReduce_1 41# happyReduction_140 -happyReduction_140 happy_x_1 - = case happyOut31 happy_x_1 of { happy_var_1 -> - happyIn47 - (annotate happy_var_1 (Qualifier happy_var_1) - )} - -happyReduce_141 = happySpecReduce_1 42# happyReduction_141 -happyReduction_141 happy_x_1 - = case happyOut49 happy_x_1 of { happy_var_1 -> - happyIn48 - (reverse happy_var_1 - )} - -happyReduce_142 = happySpecReduce_3 43# happyReduction_142 -happyReduction_142 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut49 happy_x_1 of { happy_var_1 -> - case happyOut47 happy_x_3 of { happy_var_3 -> - happyIn49 - (happy_var_3:happy_var_1 - )}} - -happyReduce_143 = happySpecReduce_1 43# happyReduction_143 -happyReduction_143 happy_x_1 - = case happyOut47 happy_x_1 of { happy_var_1 -> - happyIn49 - ([happy_var_1] - )} - -happyNewToken action sts stk - = getNextTokenWrapper(\tk -> - let cont i = happyDoAction i tk action sts stk in - case tk of { - L _ TEOF -> happyDoAction 79# tk action sts stk; - L _ (TInteger _) -> cont 1#; - L _ (TIdent _) -> cont 2#; - L _ TNewLine -> cont 3#; - L _ TFalse -> cont 4#; - L _ TTrue -> cont 5#; - L _ TDefineEqual -> cont 6#; - L _ TComma -> cont 7#; - L _ TDot -> cont 8#; - L _ TQuestionMark -> cont 9#; - L _ TDollar -> cont 10#; - L _ TExclamationMark -> cont 11#; - L _ TDoubleDot -> cont 12#; - L _ TColon -> cont 13#; - L _ TDrawnFrom -> cont 14#; - L _ TTie -> cont 15#; - L _ TPipe -> cont 16#; - L _ TDoubleAt -> cont 17#; - L _ TWildCard -> cont 18#; - L _ TIf -> cont 19#; - L _ TThen -> cont 20#; - L _ TElse -> cont 21#; - L _ TLet -> cont 22#; - L _ TWithin -> cont 23#; - L _ TBackSlash -> cont 24#; - L _ TLambdaDot -> cont 25#; - L _ TChannel -> cont 26#; - L _ TDataType -> cont 27#; - L _ TExternal -> cont 28#; - L _ TTransparent -> cont 29#; - L _ TNameType -> cont 30#; - L _ TAssert -> cont 31#; - L _ TDeadlockFree -> cont 32#; - L _ TLivelockFree -> cont 33#; - L _ TDivergenceFree -> cont 34#; - L _ TDeterministic -> cont 35#; - L _ TTauPriority -> cont 36#; - L _ (TRefines _) -> cont 37#; - L _ (TModel _) -> cont 38#; - L _ TNot -> cont 39#; - L _ TAnd -> cont 40#; - L _ TOr -> cont 41#; - L _ TEq -> cont 42#; - L _ TNotEq -> cont 43#; - L _ TLtEq -> cont 44#; - L _ TGtEq -> cont 45#; - L _ TEmptySeq -> cont 46#; - L _ TLt -> cont 47#; - L _ TGt -> cont 48#; - L _ TCloseSeq -> cont 49#; - L _ TPlus -> cont 50#; - L _ TMinus -> cont 51#; - L _ TTimes -> cont 52#; - L _ TDivide -> cont 53#; - L _ TMod -> cont 54#; - L _ TConcat -> cont 55#; - L _ THash -> cont 56#; - L _ TLParen -> cont 57#; - L _ TRParen -> cont 58#; - L _ TLBrace -> cont 59#; - L _ TRBrace -> cont 60#; - L _ TLPipeBrace -> cont 61#; - L _ TRPipeBrace -> cont 62#; - L _ TLDoubleSqBracket -> cont 63#; - L _ TRDoubleSqBracket -> cont 64#; - L _ TLPipeSqBracket -> cont 65#; - L _ TRPipeSqBracket -> cont 66#; - L _ TLSqBracket -> cont 67#; - L _ TRSqBracket -> cont 68#; - L _ TExtChoice -> cont 69#; - L _ TIntChoice -> cont 70#; - L _ TInterleave -> cont 71#; - L _ TPrefix -> cont 72#; - L _ TInterrupt -> cont 73#; - L _ TSlidingChoice -> cont 74#; - L _ TRException -> cont 75#; - L _ TParallel -> cont 76#; - L _ TSemiColon -> cont 77#; - L _ TGuard -> cont 78#; - _ -> happyError' tk - }) - -happyError_ tk = happyError' tk - -happyThen :: () => ParseMonad a -> (a -> ParseMonad b) -> ParseMonad b -happyThen = (>>=) -happyReturn :: () => a -> ParseMonad a -happyReturn = (return) -happyThen1 = happyThen -happyReturn1 :: () => a -> ParseMonad a -happyReturn1 = happyReturn -happyError' :: () => (LToken) -> ParseMonad a -happyError' tk = parseError tk - -parseFile_ = happySomeParser where - happySomeParser = happyThen (happyParse 0#) (\x -> happyReturn (happyOut6 x)) - -parseInteractiveStmt_ = happySomeParser where - happySomeParser = happyThen (happyParse 1#) (\x -> happyReturn (happyOut7 x)) - -parseExpression_ = happySomeParser where - happySomeParser = happyThen (happyParse 2#) (\x -> happyReturn (happyOut31 x)) - -happySeq = happyDontSeq - - -combineDecls :: [PDecl] -> [PDecl] -combineDecls [] = [] -combineDecls ((An loc1 b (FunBind n ms)):(An loc2 c (FunBind n' ms')):ds) | n == n' = - combineDecls $ (An (combineSpans loc1 loc2) b (FunBind n (ms++ms'))):ds -combineDecls (d:ds) = d:combineDecls ds - -convDecl :: PExp -> PExp -> ParseMonad PDecl -convDecl (lhs @ (An loc1 b lhsexp)) (rhs @ (An loc2 d _)) = - let - span = combineSpans loc1 loc2 - - -- REMEMBER: needs to reverse pts - getPats :: Exp -> ([[PPat]], Name) - getPats (App f args) = - ((map convPat args):ps, n) - where - (ps, n) = getPats (unAnnotate f) - getPats (Var (UnQual n)) = ([], n) - - convFunBind exp = - FunBind n [An span (dummyAnnotation) (Match (reverse ps) rhs)] - where - (ps, n) = getPats exp - - convPatBind exp = PatBind (convPat exp) rhs - in do - symbTable <- freshPSymbolTable - case lhsexp of - App f args -> return $ An span (Nothing, symbTable) (convFunBind lhsexp) - _ -> return $ An span (Nothing, symbTable) (convPatBind lhs) - --- | Throws an error if a declaration that is not allowed inside a let --- expression is found. -checkLetDecls :: [PDecl] -> [PDecl] -checkLetDecls decls = map checkDecl decls - where - checkDecl :: PDecl -> PDecl - checkDecl (anDecl@(An _ _ decl)) = - let - check (FunBind a b) = anDecl - check (PatBind a b) = anDecl - check _ = throwSourceError [invalidDeclarationErrorMessage anDecl] - in check decl - -checkExp :: PExp -> PExp -checkExp (anExp@(An a b exp)) = - let - check :: Exp -> Exp - check (App e es) = App (checkExp e) (map checkExp es) - check (BooleanBinaryOp op e1 e2) = BooleanBinaryOp op (checkExp e1) (checkExp e2) - check (BooleanUnaryOp op e) = BooleanUnaryOp op (checkExp e) - check (Concat e1 e2) = Concat (checkExp e1) (checkExp e2) - check (DotApp e1 e2) = DotApp (checkExp e1) (checkExp e2) - check (If e1 e2 e3) = If (checkExp e1) (checkExp e2) (checkExp e3) - check (Lambda p e) = Lambda p (checkExp e) - check (Let decls e) = Let decls (checkExp e) - check (Lit lit) = Lit lit - check (List es) = List (map checkExp es) - check (ListComp es stmts) = ListComp (map checkExp es) stmts - check (ListEnumFrom e) = ListEnumFrom (checkExp e) - check (ListEnumFromTo e1 e2) = ListEnumFromTo (checkExp e1) (checkExp e2) - check (ListLength e) = ListLength (checkExp e) - check (MathsBinaryOp op e1 e2) = MathsBinaryOp op (checkExp e1) (checkExp e2) - check (MathsUnaryOp op e) = MathsUnaryOp op (checkExp e) - check (Paren e) = Paren (checkExp e) - check (Set es) = Set (map checkExp es) - check (SetComp es stmts) = SetComp (map checkExp es) stmts - check (SetEnumFrom e) = SetEnumFrom (checkExp e) - check (SetEnumFromTo e1 e2) = SetEnumFromTo (checkExp e1) (checkExp e2) - check (SetEnum es) = SetEnum (map checkExp es) - -- We don't need to check inside stmts as they will have been checked - -- upon creation - check (SetEnumComp es stmts) = SetEnumComp (map checkExp es) stmts - check (Tuple es) = Tuple (map checkExp es) - check (Var qname) = Var qname - - check (AlphaParallel e1 e2 e3 e4) = - AlphaParallel (checkExp e1) (checkExp e2) (checkExp e3) (checkExp e4) - check (Exception e1 e2 e3) = Exception (checkExp e1) (checkExp e2) (checkExp e3) - check (ExternalChoice e1 e2) = ExternalChoice (checkExp e1) (checkExp e2) - check (GenParallel e1 e2 e3) = GenParallel (checkExp e1) (checkExp e2) (checkExp e3) - check (GuardedExp e1 e2) = GuardedExp (checkExp e1) (checkExp e2) - check (Hiding e1 e2) = Hiding (checkExp e1) (checkExp e2) - check (InternalChoice e1 e2) = InternalChoice (checkExp e1) (checkExp e2) - check (Interrupt e1 e2) = Interrupt (checkExp e1) (checkExp e2) - check (Interleave e1 e2) = Interleave (checkExp e1) (checkExp e2) - check (LinkParallel e1 ties stmts e2) = - LinkParallel (checkExp e1) ties stmts (checkExp e2) - check (Prefix e1 fields e2) = Prefix (checkExp e1) fields (checkExp e2) - check (Rename e ties stmts) = Rename (checkExp e) ties stmts - check (SequentialComp e1 e2) = SequentialComp (checkExp e1) (checkExp e2) - check (SlidingChoice e1 e2) = SlidingChoice (checkExp e1) (checkExp e2) - - check (ReplicatedAlphaParallel stmts e1 e2) = - ReplicatedAlphaParallel stmts (checkExp e1) (checkExp e2) - check (ReplicatedInterleave stmts e1) = ReplicatedInterleave stmts (checkExp e1) - check (ReplicatedExternalChoice stmts e1) = ReplicatedExternalChoice stmts (checkExp e1) - check (ReplicatedInternalChoice stmts e1) = ReplicatedInternalChoice stmts (checkExp e1) - check (ReplicatedParallel e1 stmts e2) = - ReplicatedParallel (checkExp e1) stmts (checkExp e2) - check (ReplicatedLinkParallel ties stmts e) = - ReplicatedLinkParallel ties stmts (checkExp e) - - check x = throwSourceError [invalidExpressionErrorMessage anExp] - in - An a b (check exp) - -dotAppToList :: PExp -> [PExp] -dotAppToList (An a b exp) = - let - list :: Exp -> [PExp] - list (DotApp e1 e2) = (dotAppToList e1) ++ (dotAppToList e2) - list x = [An a b x] - in - list exp - -convPat :: PExp -> PPat -convPat (anExp@ (An a b exp)) = - let - trans :: Exp -> Pat - trans (Concat e1 e2) = PConcat (convPat e1) (convPat e2) - trans (DotApp e1 e2) = PDotApp (convPat e1) (convPat e2) - trans (List xs) = PList (map convPat xs) - trans (Lit x) = PLit x - trans (Set xs) = PSet (map convPat xs) - trans (Paren x) = PParen (convPat x) - trans (Tuple xs) = PTuple (map convPat xs) - trans (Var (UnQual x)) = PVar x - trans (ExpPatWildCard) = PWildCard - trans (ExpPatDoublePattern e1 e2) = - PDoublePattern (convPat e1) (convPat e2) - trans x = throwSourceError [invalidPatternErrorMessage anExp] - in - An a () (trans exp) - --- Helper function to get the contents of tokens -getInt (L _ (TInteger x)) = x -getName (L _ (TIdent x)) = x -getRefinesModel (L _ (TRefines x)) = x -getPropModel (L _ (TModel x)) = x - -class Locatable a where - getLoc :: a b -> SrcSpan - unLoc :: a b -> b - mkLoc :: SrcSpan -> b -> a b - -instance Locatable Located where - getLoc (L loc _) = loc - unLoc (L _ b) = b - mkLoc loc b = L loc b - -instance Locatable (Annotated a) where - getLoc (An loc _ _) = loc - unLoc (An _ _ b) = b - mkLoc loc b = An loc dummyAnnotation b - -annotate :: (Locatable t1, Locatable t2) => t1 a -> b -> t2 b -annotate t1 b = mkLoc (getLoc t1) b - -annotate2 :: - (Locatable t1, Locatable t2, Locatable t3) => t1 a -> t2 b -> c -> t3 c -annotate2 t1 t2 b = mkLoc (combineSpans (getLoc t1) (getLoc t2)) b -annotate2List :: - (Locatable t1, Locatable t2, Locatable t3) => t1 a -> [t2 b] -> c -> t3 c -annotate2List t1 t2 b = annotate2 t1 (last t2) b -annotate2List' :: - (Locatable t1, Locatable t2, Locatable t3) => [t1 a] -> t2 b -> c -> t3 c -annotate2List' t1 t2 b = annotate2 (last t1) t2 b - -annotateWithSymbolTable - :: Annotated (Maybe SymbolTable, PSymbolTable) a -> ParseMonad (Annotated (Maybe SymbolTable, PSymbolTable) a) -annotateWithSymbolTable (An l _ a) = do - symbTable <- freshPSymbolTable - return $ An l (Nothing, symbTable) a + parseFile_, parseInteractiveStmt_, parseExpression_ +) +where + +-- To generate the corresponding .hs file run the following commands +-- cpp -P src/CSPM/Parser/Parser.ppy > src/CSPM/Parser/Parser.y +-- happy --ghc --coerce --array src/CSPM/Parser/Parser.y +-- rm src/CSPM/Parser/Parser.y + +-- i.e.: cpp -P src/CSPM/Parser/Parser.ppy > src/CSPM/Parser/Parser.y && happy --ghc --coerce --array src/CSPM/Parser/Parser.y && rm src/CSPM/Parser/Parser.y + +import Data.Char + +import CSPM.DataStructures.Literals +import CSPM.DataStructures.Names +import CSPM.DataStructures.Syntax +import CSPM.DataStructures.Tokens +import CSPM.DataStructures.Types hiding (TDot) +import CSPM.Parser.Exceptions +import CSPM.Parser.Lexer +import CSPM.Parser.Monad +import Util.Annotated +import qualified Data.Array as Happy_Data_Array +import qualified GHC.Exts as Happy_GHC_Exts + +-- parser produced by Happy Version 1.18.6 + +newtype HappyAbsSyn t8 t9 t27 t28 = HappyAbsSyn HappyAny +#if __GLASGOW_HASKELL__ >= 607 +type HappyAny = Happy_GHC_Exts.Any +#else +type HappyAny = forall a . a +#endif +happyIn6 :: ([PDecl]) -> (HappyAbsSyn t8 t9 t27 t28) +happyIn6 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn6 #-} +happyOut6 :: (HappyAbsSyn t8 t9 t27 t28) -> ([PDecl]) +happyOut6 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut6 #-} +happyIn7 :: (PInteractiveStmt) -> (HappyAbsSyn t8 t9 t27 t28) +happyIn7 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn7 #-} +happyOut7 :: (HappyAbsSyn t8 t9 t27 t28) -> (PInteractiveStmt) +happyOut7 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut7 #-} +happyIn8 :: t8 -> (HappyAbsSyn t8 t9 t27 t28) +happyIn8 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn8 #-} +happyOut8 :: (HappyAbsSyn t8 t9 t27 t28) -> t8 +happyOut8 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut8 #-} +happyIn9 :: t9 -> (HappyAbsSyn t8 t9 t27 t28) +happyIn9 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn9 #-} +happyOut9 :: (HappyAbsSyn t8 t9 t27 t28) -> t9 +happyOut9 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut9 #-} +happyIn10 :: ([PDecl]) -> (HappyAbsSyn t8 t9 t27 t28) +happyIn10 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn10 #-} +happyOut10 :: (HappyAbsSyn t8 t9 t27 t28) -> ([PDecl]) +happyOut10 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut10 #-} +happyIn11 :: ([PDecl]) -> (HappyAbsSyn t8 t9 t27 t28) +happyIn11 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn11 #-} +happyOut11 :: (HappyAbsSyn t8 t9 t27 t28) -> ([PDecl]) +happyOut11 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut11 #-} +happyIn12 :: ([PDecl]) -> (HappyAbsSyn t8 t9 t27 t28) +happyIn12 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn12 #-} +happyOut12 :: (HappyAbsSyn t8 t9 t27 t28) -> ([PDecl]) +happyOut12 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut12 #-} +happyIn13 :: (Maybe PDecl) -> (HappyAbsSyn t8 t9 t27 t28) +happyIn13 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn13 #-} +happyOut13 :: (HappyAbsSyn t8 t9 t27 t28) -> (Maybe PDecl) +happyOut13 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut13 #-} +happyIn14 :: (PDecl) -> (HappyAbsSyn t8 t9 t27 t28) +happyIn14 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn14 #-} +happyOut14 :: (HappyAbsSyn t8 t9 t27 t28) -> (PDecl) +happyOut14 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut14 #-} +happyIn15 :: (PDecl) -> (HappyAbsSyn t8 t9 t27 t28) +happyIn15 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn15 #-} +happyOut15 :: (HappyAbsSyn t8 t9 t27 t28) -> (PDecl) +happyOut15 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut15 #-} +happyIn16 :: (Assertion UnRenamedName) -> (HappyAbsSyn t8 t9 t27 t28) +happyIn16 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn16 #-} +happyOut16 :: (HappyAbsSyn t8 t9 t27 t28) -> (Assertion UnRenamedName) +happyOut16 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut16 #-} +happyIn17 :: (SemanticProperty) -> (HappyAbsSyn t8 t9 t27 t28) +happyIn17 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn17 #-} +happyOut17 :: (HappyAbsSyn t8 t9 t27 t28) -> (SemanticProperty) +happyOut17 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut17 #-} +happyIn18 :: (ModelOption UnRenamedName) -> (HappyAbsSyn t8 t9 t27 t28) +happyIn18 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn18 #-} +happyOut18 :: (HappyAbsSyn t8 t9 t27 t28) -> (ModelOption UnRenamedName) +happyOut18 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut18 #-} +happyIn19 :: (PDataTypeClause) -> (HappyAbsSyn t8 t9 t27 t28) +happyIn19 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn19 #-} +happyOut19 :: (HappyAbsSyn t8 t9 t27 t28) -> (PDataTypeClause) +happyOut19 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut19 #-} +happyIn20 :: ([PDataTypeClause]) -> (HappyAbsSyn t8 t9 t27 t28) +happyIn20 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn20 #-} +happyOut20 :: (HappyAbsSyn t8 t9 t27 t28) -> ([PDataTypeClause]) +happyOut20 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut20 #-} +happyIn21 :: ([PDataTypeClause]) -> (HappyAbsSyn t8 t9 t27 t28) +happyIn21 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn21 #-} +happyOut21 :: (HappyAbsSyn t8 t9 t27 t28) -> ([PDataTypeClause]) +happyOut21 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut21 #-} +happyIn22 :: (Located UnRenamedName) -> (HappyAbsSyn t8 t9 t27 t28) +happyIn22 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn22 #-} +happyOut22 :: (HappyAbsSyn t8 t9 t27 t28) -> (Located UnRenamedName) +happyOut22 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut22 #-} +happyIn23 :: ([Located UnRenamedName]) -> (HappyAbsSyn t8 t9 t27 t28) +happyIn23 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn23 #-} +happyOut23 :: (HappyAbsSyn t8 t9 t27 t28) -> ([Located UnRenamedName]) +happyOut23 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut23 #-} +happyIn24 :: ([Located UnRenamedName]) -> (HappyAbsSyn t8 t9 t27 t28) +happyIn24 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn24 #-} +happyOut24 :: (HappyAbsSyn t8 t9 t27 t28) -> ([Located UnRenamedName]) +happyOut24 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut24 #-} +happyIn25 :: (Located Literal) -> (HappyAbsSyn t8 t9 t27 t28) +happyIn25 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn25 #-} +happyOut25 :: (HappyAbsSyn t8 t9 t27 t28) -> (Located Literal) +happyOut25 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut25 #-} +happyIn26 :: (PPat) -> (HappyAbsSyn t8 t9 t27 t28) +happyIn26 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn26 #-} +happyOut26 :: (HappyAbsSyn t8 t9 t27 t28) -> (PPat) +happyOut26 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut26 #-} +happyIn27 :: t27 -> (HappyAbsSyn t8 t9 t27 t28) +happyIn27 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn27 #-} +happyOut27 :: (HappyAbsSyn t8 t9 t27 t28) -> t27 +happyOut27 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut27 #-} +happyIn28 :: t28 -> (HappyAbsSyn t8 t9 t27 t28) +happyIn28 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn28 #-} +happyOut28 :: (HappyAbsSyn t8 t9 t27 t28) -> t28 +happyOut28 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut28 #-} +happyIn29 :: (PExp) -> (HappyAbsSyn t8 t9 t27 t28) +happyIn29 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn29 #-} +happyOut29 :: (HappyAbsSyn t8 t9 t27 t28) -> (PExp) +happyOut29 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut29 #-} +happyIn30 :: (PExp) -> (HappyAbsSyn t8 t9 t27 t28) +happyIn30 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn30 #-} +happyOut30 :: (HappyAbsSyn t8 t9 t27 t28) -> (PExp) +happyOut30 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut30 #-} +happyIn31 :: (PExp) -> (HappyAbsSyn t8 t9 t27 t28) +happyIn31 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn31 #-} +happyOut31 :: (HappyAbsSyn t8 t9 t27 t28) -> (PExp) +happyOut31 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut31 #-} +happyIn32 :: (PField) -> (HappyAbsSyn t8 t9 t27 t28) +happyIn32 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn32 #-} +happyOut32 :: (HappyAbsSyn t8 t9 t27 t28) -> (PField) +happyOut32 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut32 #-} +happyIn33 :: ((PExp, PExp)) -> (HappyAbsSyn t8 t9 t27 t28) +happyIn33 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn33 #-} +happyOut33 :: (HappyAbsSyn t8 t9 t27 t28) -> ((PExp, PExp)) +happyOut33 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut33 #-} +happyIn34 :: ([(PExp, PExp)]) -> (HappyAbsSyn t8 t9 t27 t28) +happyIn34 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn34 #-} +happyOut34 :: (HappyAbsSyn t8 t9 t27 t28) -> ([(PExp, PExp)]) +happyOut34 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut34 #-} +happyIn35 :: ([(PExp, PExp)]) -> (HappyAbsSyn t8 t9 t27 t28) +happyIn35 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn35 #-} +happyOut35 :: (HappyAbsSyn t8 t9 t27 t28) -> ([(PExp, PExp)]) +happyOut35 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut35 #-} +happyIn36 :: ((PExp, PExp)) -> (HappyAbsSyn t8 t9 t27 t28) +happyIn36 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn36 #-} +happyOut36 :: (HappyAbsSyn t8 t9 t27 t28) -> ((PExp, PExp)) +happyOut36 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut36 #-} +happyIn37 :: ([(PExp, PExp)]) -> (HappyAbsSyn t8 t9 t27 t28) +happyIn37 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn37 #-} +happyOut37 :: (HappyAbsSyn t8 t9 t27 t28) -> ([(PExp, PExp)]) +happyOut37 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut37 #-} +happyIn38 :: ([(PExp, PExp)]) -> (HappyAbsSyn t8 t9 t27 t28) +happyIn38 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn38 #-} +happyOut38 :: (HappyAbsSyn t8 t9 t27 t28) -> ([(PExp, PExp)]) +happyOut38 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut38 #-} +happyIn39 :: ([PField]) -> (HappyAbsSyn t8 t9 t27 t28) +happyIn39 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn39 #-} +happyOut39 :: (HappyAbsSyn t8 t9 t27 t28) -> ([PField]) +happyOut39 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut39 #-} +happyIn40 :: ([PField]) -> (HappyAbsSyn t8 t9 t27 t28) +happyIn40 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn40 #-} +happyOut40 :: (HappyAbsSyn t8 t9 t27 t28) -> ([PField]) +happyOut40 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut40 #-} +happyIn41 :: ([PExp]) -> (HappyAbsSyn t8 t9 t27 t28) +happyIn41 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn41 #-} +happyOut41 :: (HappyAbsSyn t8 t9 t27 t28) -> ([PExp]) +happyOut41 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut41 #-} +happyIn42 :: ([PExp]) -> (HappyAbsSyn t8 t9 t27 t28) +happyIn42 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn42 #-} +happyOut42 :: (HappyAbsSyn t8 t9 t27 t28) -> ([PExp]) +happyOut42 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut42 #-} +happyIn43 :: ([PExp]) -> (HappyAbsSyn t8 t9 t27 t28) +happyIn43 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn43 #-} +happyOut43 :: (HappyAbsSyn t8 t9 t27 t28) -> ([PExp]) +happyOut43 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut43 #-} +happyIn44 :: ([PExp]) -> (HappyAbsSyn t8 t9 t27 t28) +happyIn44 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn44 #-} +happyOut44 :: (HappyAbsSyn t8 t9 t27 t28) -> ([PExp]) +happyOut44 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut44 #-} +happyIn45 :: ([PStmt]) -> (HappyAbsSyn t8 t9 t27 t28) +happyIn45 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn45 #-} +happyOut45 :: (HappyAbsSyn t8 t9 t27 t28) -> ([PStmt]) +happyOut45 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut45 #-} +happyIn46 :: (PStmt) -> (HappyAbsSyn t8 t9 t27 t28) +happyIn46 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn46 #-} +happyOut46 :: (HappyAbsSyn t8 t9 t27 t28) -> (PStmt) +happyOut46 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut46 #-} +happyIn47 :: ([PStmt]) -> (HappyAbsSyn t8 t9 t27 t28) +happyIn47 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn47 #-} +happyOut47 :: (HappyAbsSyn t8 t9 t27 t28) -> ([PStmt]) +happyOut47 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut47 #-} +happyIn48 :: ([PStmt]) -> (HappyAbsSyn t8 t9 t27 t28) +happyIn48 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn48 #-} +happyOut48 :: (HappyAbsSyn t8 t9 t27 t28) -> ([PStmt]) +happyOut48 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut48 #-} +happyInTok :: (LToken) -> (HappyAbsSyn t8 t9 t27 t28) +happyInTok x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyInTok #-} +happyOutTok :: (HappyAbsSyn t8 t9 t27 t28) -> (LToken) +happyOutTok x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOutTok #-} + + +happyActOffsets :: HappyAddr +happyActOffsets = HappyA# "\x00\x00\x4c\x01\x70\x01\x00\x00\x4d\x00\x00\x00\x00\x00\x70\x01\x64\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x70\x01\x96\x00\x70\x01\x70\x01\x00\x00\x00\x00\x70\x01\x70\x01\x70\x01\x70\x01\x70\x01\x70\x01\x70\x01\x70\x01\x70\x01\x70\x01\x70\x01\xa2\x00\x00\x00\x01\x06\x96\x00\x70\x01\xa2\x00\x00\x00\xd0\x01\xce\x00\xe3\x00\x00\x00\x00\x00\xfe\x01\xe2\x00\xe2\x00\xe2\x00\xe2\x00\xe2\x00\x70\x01\x00\x00\x9b\x00\xcb\x00\x70\x01\x70\x01\x70\x01\x70\x01\x70\x01\x70\x01\x70\x01\x70\x01\x70\x01\x70\x01\x70\x01\x70\x01\x70\x01\x70\x01\x70\x01\x70\x01\x70\x01\x70\x01\x70\x01\x70\x01\x70\x01\x70\x01\x70\x01\x70\x01\x70\x01\x70\x01\x70\x01\x70\x01\x70\x01\x70\x01\x70\x01\x70\x01\x18\x00\xde\x02\x00\x00\xc7\x00\xd8\x00\xc5\x00\xc1\x00\xb1\x00\xb4\x00\x00\x00\xbb\x00\xb3\x00\x68\x05\x01\x06\xf7\xff\xa8\x00\x35\x05\xf1\xff\x31\x02\x73\x00\x1d\x00\xf9\x02\xb1\x08\xa0\x00\x01\x06\xb5\x01\xee\x04\xa7\x04\xf8\xff\x00\x00\x00\x00\x00\x00\x00\x00\x70\x01\x00\x00\x03\x01\x70\x01\x70\x01\x70\x01\x00\x00\x70\x01\x00\x00\x70\x01\x00\x00\xba\x00\x70\x01\x70\x01\x00\x00\x70\x01\x70\x01\x61\x00\x70\x01\x70\x01\x70\x01\x70\x01\x70\x01\x70\x01\x68\x00\x70\x01\x70\x01\x2a\x08\x2a\x08\xf8\x07\xc6\x07\x2a\x08\xfd\x06\x62\x07\x94\x07\x60\x04\x94\x00\x97\x02\x9c\x00\x00\x00\x90\x00\x98\x00\x62\x00\xd1\xff\x1d\x00\x1d\x00\x1d\x00\xf9\x02\xf9\x02\xa0\x08\xa0\x08\xa0\x08\xa0\x08\xa0\x08\xa0\x08\x7e\x08\x8f\x08\x33\x06\xce\x05\x30\x07\xcb\x06\x98\x06\x53\x08\x00\x00\x70\x01\x00\x00\x97\x00\x00\x00\x00\x00\x8f\x00\x00\x00\x8b\x00\x7c\x00\x70\x01\x01\x00\x00\x00\x70\x01\x6f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x70\x01\x6b\x00\x00\x00\x9b\x05\x00\x00\x00\x00\x00\x00\x3d\x00\x70\x01\x85\x00\x85\x00\x70\x01\x2a\x08\x70\x01\x70\x01\x00\x00\x70\x01\x4b\x00\x70\x01\x70\x01\x70\x01\x40\x00\x70\x01\x9b\x05\x9b\x05\x70\x01\x00\x00\x9b\x05\x9b\x05\x9b\x05\x00\x00\x00\x00\x70\x01\x00\x00\x66\x00\x39\x00\x9b\x05\x19\x04\x00\x00\x3a\x00\x5f\x00\x9b\x05\x00\x00\xe6\x03\x00\x00\x9f\x03\x33\x00\x00\x00\x00\x00\x70\x01\x00\x00\x00\x00\x00\x00\x70\x01\x49\x00\x58\x03\x11\x03\x70\x01\x65\x06\x65\x06\x00\x00\x00\x00\x00\x00\x30\x07\x30\x07\x00\x00\x00\x00\x00\x00\x00\x00\x51\x00\x53\x00\x00\x00\x00\x00\x70\x01\x00\x00\x70\x01\x55\x00\x65\x06\x70\x01\x70\x01\x70\x01\x9b\x05\x9b\x05\x9b\x05\x65\x06\x65\x06\x00\x00\x00\x00\x00\x00"# + +happyGotoOffsets :: HappyAddr +happyGotoOffsets = HappyA# "\x27\x00\xd7\x00\xd1\x09\x50\x00\x20\x01\x00\x00\x00\x00\x55\x03\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xca\x09\xa6\x03\xf5\x04\xc3\x09\x00\x00\x00\x00\xbc\x09\xb5\x09\x1e\x00\xfb\x01\xb2\x01\xae\x09\x05\x02\x7b\x08\x26\x08\xf4\x07\xc2\x07\x00\x00\x00\x00\x0a\x00\xe8\x02\x5c\x03\x00\x00\x00\x00\x41\x00\x00\x00\x47\x00\x00\x00\x00\x00\x0a\x00\xb6\x00\x35\x00\xb0\x00\x71\x00\x30\x00\x97\x01\x00\x00\x00\x00\x23\x00\xa7\x09\xa0\x09\x99\x09\x92\x09\x8b\x09\x84\x09\x7d\x09\x76\x09\x6f\x09\x68\x09\x61\x09\x5a\x09\x53\x09\x4c\x09\x45\x09\x3e\x09\x37\x09\x30\x09\x29\x09\x22\x09\x07\x01\x6d\x02\x1b\x09\xbc\x01\x14\x09\x0d\x09\x06\x09\xff\x08\xf8\x08\xf1\x08\xea\x08\xe3\x08\x00\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x0a\x00\x0a\x00\x00\x00\x00\x00\x0a\x00\x00\x00\x0a\x00\x00\x00\x0a\x00\x0a\x00\x0a\x00\x00\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x22\x00\x00\x00\x00\x00\x00\x00\x00\x00\x90\x07\x00\x00\xeb\x04\xd9\x08\xae\x04\x85\x08\x00\x00\x50\x01\x00\x00\x44\x01\x00\x00\x5c\x08\x52\x08\xf9\x00\x00\x00\x8e\x00\x3a\x02\x00\x00\x45\x00\xa4\x04\x34\x08\x02\x08\xd0\x07\x65\x00\x00\x00\x9e\x07\x6c\x07\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0b\x00\x0a\x00\x00\x00\x00\x00\xef\xff\x00\x00\x00\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x00\x00\x39\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x67\x04\x8d\x01\x00\x00\x07\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5d\x04\x0e\x00\x00\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x22\x04\x63\x00\xff\xff\xf4\x03\x0a\x00\xd4\x06\xa1\x06\x00\x00\x2a\x01\x00\x00\xea\x03\x6f\x06\x3d\x06\x00\x00\x0a\x06\x0a\x00\x0a\x00\xd7\x05\x00\x00\x0a\x00\x0a\x00\x0a\x00\x00\x00\x00\x00\xf9\xff\x00\x00\x00\x00\x00\x00\x0a\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x0a\x00\x00\x00\x0a\x00\x00\x00\x29\x00\xf5\xff\x00\x00\x00\x00\xa4\x05\x00\x00\x00\x00\x00\x00\x71\x05\x00\x00\x0a\x00\x0a\x00\x40\x05\x0a\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x0a\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xad\x03\x00\x00\xa4\x02\x08\x00\x0a\x00\x39\x05\x32\x05\xfc\x04\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x00\x00\x00\x00\x00\x00"# + +happyDefActions :: HappyAddr +happyDefActions = HappyA# "\xf6\xff\x00\x00\x00\x00\x00\x00\xf4\xff\xc9\xff\xca\xff\x7c\xff\x00\x00\xcb\xff\xd2\xff\xd6\xff\xd0\xff\xd1\xff\xa5\xff\x00\x00\x00\x00\x00\x00\x00\x00\xb2\xff\xce\xff\x00\x00\x00\x00\x00\x00\x7c\xff\x7c\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf9\xff\xcc\xff\x00\x00\x00\x00\x00\x00\xfa\xff\x00\x00\x00\x00\xf2\xff\xf1\xff\xed\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\xff\x00\x00\x81\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\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\x74\xff\x71\xff\x00\x00\x73\xff\x00\x00\x00\x00\x00\x00\x00\x00\x83\xff\x78\xff\x84\xff\x00\x00\x79\xff\x00\x00\x7b\xff\x79\xff\x00\x00\x00\x00\x00\x00\xac\xff\xb8\xff\xbb\xff\x00\x00\xcf\xff\x00\x00\x00\x00\x79\xff\x00\x00\xfc\xff\xf3\xff\xf5\xff\xb1\xff\x00\x00\xcd\xff\x00\x00\x00\x00\x00\x00\x00\x00\xc8\xff\x00\x00\xc4\xff\x00\x00\xab\xff\x00\x00\x00\x00\x00\x00\xa7\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\x97\xff\x98\xff\x99\xff\x9b\xff\xa2\xff\x9e\xff\x9f\xff\xa1\xff\xcc\xff\x78\xff\x00\x00\x00\x00\x87\xff\x78\xff\x88\xff\x00\x00\xad\xff\xb5\xff\xb4\xff\xb3\xff\xb6\xff\xb7\xff\xbe\xff\xbf\xff\xbc\xff\xbd\xff\xc0\xff\xc1\xff\xba\xff\xb9\xff\xa0\xff\xa4\xff\x8a\xff\x8c\xff\x8e\xff\xc7\xff\x7f\xff\x00\x00\xe6\xff\x00\x00\xd4\xff\xe7\xff\xd5\xff\xe8\xff\x00\x00\xeb\xff\x00\x00\xef\xff\xf8\xff\x00\x00\xe2\xff\xe0\xff\xdf\xff\xde\xff\xdd\xff\x00\x00\xe4\xff\xe1\xff\xc6\xff\xf0\xff\xee\xff\xf7\xff\xec\xff\x00\x00\x00\x00\x00\x00\x00\x00\xa3\xff\x00\x00\x00\x00\xc3\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x76\xff\x75\xff\x00\x00\x72\xff\x94\xff\x92\xff\x93\xff\x85\xff\x77\xff\x00\x00\x82\xff\x00\x00\x00\x00\x7a\xff\x00\x00\xa9\xff\x00\x00\x7e\xff\xc2\xff\xec\xff\x00\x00\xaf\xff\x00\x00\x00\x00\xb0\xff\xae\xff\x00\x00\xaa\xff\xa8\xff\xa6\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x9a\xff\x9d\xff\x89\xff\x96\xff\x86\xff\x8b\xff\x8d\xff\xe5\xff\xd3\xff\xd8\xff\xe9\xff\xd9\xff\xda\xff\xea\xff\xe3\xff\x00\x00\xdc\xff\x00\x00\x00\x00\x95\xff\x00\x00\x00\x00\x00\x00\x90\xff\xc5\xff\x8f\xff\x91\xff\x9c\xff\xd7\xff\xdb\xff"# + +happyCheck :: HappyAddr +happyCheck = HappyA# "\xff\xff\x10\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x10\x00\x10\x00\x10\x00\x39\x00\x16\x00\x13\x00\x14\x00\x15\x00\x10\x00\x3f\x00\x18\x00\x19\x00\x12\x00\x13\x00\x0d\x00\x27\x00\x16\x00\x10\x00\x18\x00\x0c\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x28\x00\x29\x00\x2a\x00\x1a\x00\x0d\x00\x0e\x00\x00\x00\x27\x00\x31\x00\x03\x00\x21\x00\x22\x00\x3c\x00\x10\x00\x2e\x00\x2f\x00\x13\x00\x27\x00\x15\x00\x33\x00\x3e\x00\x18\x00\x19\x00\x16\x00\x38\x00\x39\x00\x27\x00\x3b\x00\x1a\x00\x3d\x00\x16\x00\x10\x00\x23\x00\x41\x00\x1a\x00\x43\x00\x10\x00\x45\x00\x46\x00\x47\x00\x02\x00\x21\x00\x22\x00\x0b\x00\x4c\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x03\x00\x37\x00\x10\x00\x39\x00\x02\x00\x13\x00\x14\x00\x15\x00\x08\x00\x3f\x00\x18\x00\x19\x00\x12\x00\x13\x00\x10\x00\x19\x00\x16\x00\x31\x00\x18\x00\x07\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x28\x00\x29\x00\x2a\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x27\x00\x10\x00\x3c\x00\x3e\x00\x13\x00\x14\x00\x15\x00\x2e\x00\x2f\x00\x18\x00\x19\x00\x19\x00\x33\x00\x10\x00\x11\x00\x12\x00\x44\x00\x38\x00\x39\x00\x02\x00\x3b\x00\x0d\x00\x3d\x00\x40\x00\x4f\x00\x28\x00\x41\x00\x24\x00\x43\x00\x06\x00\x45\x00\x46\x00\x47\x00\x26\x00\x07\x00\x01\x00\x02\x00\x4c\x00\x04\x00\x05\x00\x3a\x00\x06\x00\x10\x00\x07\x00\x10\x00\x13\x00\x14\x00\x15\x00\x10\x00\x44\x00\x18\x00\x19\x00\x12\x00\x13\x00\x0e\x00\x43\x00\x16\x00\x3a\x00\x18\x00\x07\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x28\x00\x29\x00\x2a\x00\x19\x00\x07\x00\x01\x00\x02\x00\x27\x00\x04\x00\x05\x00\x10\x00\x11\x00\x12\x00\x0f\x00\x2e\x00\x2f\x00\x10\x00\x11\x00\x12\x00\x33\x00\x19\x00\x10\x00\x12\x00\x13\x00\x38\x00\x39\x00\x16\x00\x3b\x00\x18\x00\x3d\x00\x09\x00\x0a\x00\x0b\x00\x41\x00\x01\x00\x43\x00\x19\x00\x45\x00\x46\x00\x47\x00\x19\x00\x07\x00\x19\x00\x27\x00\x4c\x00\x48\x00\x02\x00\x17\x00\x03\x00\x10\x00\x2e\x00\x2f\x00\x13\x00\xff\xff\x15\x00\x33\x00\x17\x00\x18\x00\x19\x00\x4f\x00\x38\x00\x39\x00\xff\xff\x3b\x00\x3c\x00\x3d\x00\xff\xff\xff\xff\xff\xff\x41\x00\xff\xff\x43\x00\xff\xff\x45\x00\x46\x00\x47\x00\xff\xff\xff\xff\x01\x00\x02\x00\x4c\x00\x04\x00\x05\x00\x10\x00\xff\xff\xff\xff\x13\x00\x14\x00\x15\x00\xff\xff\xff\xff\x18\x00\x19\x00\xff\xff\xff\xff\x12\x00\x13\x00\x10\x00\xff\xff\x16\x00\x13\x00\x18\x00\x15\x00\xff\xff\xff\xff\x18\x00\x19\x00\x28\x00\x29\x00\x2a\x00\x04\x00\x05\x00\x06\x00\xff\xff\x08\x00\x09\x00\x27\x00\xff\xff\x25\x00\x26\x00\xff\xff\xff\xff\x10\x00\x2e\x00\x2f\x00\x13\x00\x31\x00\x15\x00\x33\x00\xff\xff\x18\x00\x19\x00\x10\x00\x38\x00\x39\x00\x13\x00\x3b\x00\x15\x00\x3d\x00\x17\x00\x18\x00\x19\x00\x41\x00\x1b\x00\x43\x00\xff\xff\x45\x00\x46\x00\x47\x00\xff\xff\xff\xff\x01\x00\x02\x00\x4c\x00\x04\x00\x05\x00\xff\xff\xff\xff\x10\x00\xff\xff\xff\xff\x13\x00\x14\x00\x15\x00\xff\xff\xff\xff\x18\x00\x19\x00\x12\x00\x13\x00\x10\x00\xff\xff\x16\x00\x13\x00\x18\x00\x15\x00\xff\xff\xff\xff\x18\x00\x19\x00\xff\xff\x1f\x00\x28\x00\x29\x00\x2a\x00\xff\xff\xff\xff\x01\x00\x02\x00\x27\x00\x04\x00\x05\x00\x26\x00\xff\xff\xff\xff\xff\xff\x2e\x00\x2f\x00\xff\xff\xff\xff\xff\xff\x33\x00\xff\xff\xff\xff\x12\x00\x13\x00\x38\x00\x39\x00\x16\x00\x3b\x00\x18\x00\x3d\x00\xff\xff\xff\xff\xff\xff\x41\x00\xff\xff\x43\x00\xff\xff\x45\x00\x46\x00\x47\x00\x07\x00\x08\x00\x09\x00\x27\x00\x4c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x10\x00\x2e\x00\x2f\x00\x13\x00\x0a\x00\x15\x00\x33\x00\xff\xff\x18\x00\x19\x00\x10\x00\x38\x00\x39\x00\x13\x00\x3b\x00\x15\x00\x3d\x00\x17\x00\x18\x00\x19\x00\x41\x00\xff\xff\x43\x00\xff\xff\x45\x00\x46\x00\x47\x00\xff\xff\xff\xff\xff\xff\x06\x00\x4c\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\xff\xff\x10\x00\xff\xff\xff\xff\x13\x00\x11\x00\x15\x00\xff\xff\xff\xff\x18\x00\x19\x00\x10\x00\x18\x00\xff\xff\x13\x00\xff\xff\x15\x00\xff\xff\x17\x00\x18\x00\x19\x00\xff\xff\x25\x00\x26\x00\xff\xff\x1e\x00\x1f\x00\x20\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\xff\xff\x2f\x00\x30\x00\xff\xff\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\xff\xff\x39\x00\xff\xff\x20\x00\x21\x00\x22\x00\x23\x00\x3f\x00\x25\x00\x41\x00\xff\xff\x43\x00\xff\xff\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\xff\xff\xff\xff\x4d\x00\x4e\x00\x06\x00\xff\xff\x08\x00\x09\x00\x0a\x00\x0b\x00\xff\xff\x10\x00\xff\xff\xff\xff\x13\x00\x11\x00\x15\x00\xff\xff\xff\xff\x18\x00\x19\x00\x10\x00\x18\x00\xff\xff\x13\x00\xff\xff\x15\x00\xff\xff\x17\x00\x18\x00\x19\x00\xff\xff\x25\x00\x26\x00\xff\xff\x1e\x00\x1f\x00\x20\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\xff\xff\x2f\x00\x30\x00\xff\xff\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\xff\xff\x39\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x3f\x00\xff\xff\x41\x00\xff\xff\x43\x00\x11\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x18\x00\x10\x00\x4d\x00\x4e\x00\x13\x00\xff\xff\x15\x00\xff\xff\x17\x00\x18\x00\x19\x00\xff\xff\xff\xff\xff\xff\xff\xff\x1e\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\xff\xff\x2f\x00\x30\x00\xff\xff\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\xff\xff\x39\x00\x3a\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x3f\x00\xff\xff\x41\x00\xff\xff\x43\x00\x11\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x18\x00\x10\x00\x4d\x00\x4e\x00\x13\x00\xff\xff\x15\x00\xff\xff\x17\x00\x18\x00\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\xff\xff\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\xff\xff\x2f\x00\x30\x00\xff\xff\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\xff\xff\x39\x00\xff\xff\x08\x00\x09\x00\x0a\x00\x0b\x00\x3f\x00\xff\xff\x41\x00\xff\xff\x43\x00\x11\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x18\x00\xff\xff\x4d\x00\x4e\x00\x4f\x00\x10\x00\xff\xff\xff\xff\x13\x00\xff\xff\x15\x00\xff\xff\x17\x00\x18\x00\x19\x00\xff\xff\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\xff\xff\x2f\x00\x30\x00\xff\xff\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\xff\xff\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\xff\xff\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\xff\xff\x4d\x00\x4e\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\xff\xff\x0d\x00\x0e\x00\x05\x00\x06\x00\x11\x00\x08\x00\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\x18\x00\xff\xff\x10\x00\xff\xff\xff\xff\x13\x00\xff\xff\x15\x00\xff\xff\xff\xff\x18\x00\x19\x00\xff\xff\xff\xff\xff\xff\xff\xff\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\xff\xff\x2f\x00\x30\x00\xff\xff\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\xff\xff\x39\x00\xff\xff\x08\x00\x09\x00\x0a\x00\x0b\x00\x3f\x00\xff\xff\x41\x00\xff\xff\x43\x00\x11\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x18\x00\xff\xff\x4d\x00\x4e\x00\x34\x00\x35\x00\x36\x00\x37\x00\xff\xff\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3f\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\xff\xff\x2f\x00\x30\x00\xff\xff\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\xff\xff\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3f\x00\xff\xff\x41\x00\xff\xff\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\xff\xff\xff\xff\x4d\x00\x4e\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\xff\xff\x10\x00\x0a\x00\xff\xff\x13\x00\x11\x00\x15\x00\xff\xff\x10\x00\x18\x00\x19\x00\x13\x00\x18\x00\x15\x00\xff\xff\x17\x00\x18\x00\x19\x00\xff\xff\xff\xff\xff\xff\xff\xff\x25\x00\x26\x00\xff\xff\xff\xff\xff\xff\xff\xff\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\xff\xff\x2f\x00\x30\x00\xff\xff\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\xff\xff\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3f\x00\xff\xff\x41\x00\xff\xff\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\xff\xff\xff\xff\x4d\x00\x4e\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x05\x00\x06\x00\xff\xff\x08\x00\x09\x00\x11\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x10\x00\x18\x00\xff\xff\x13\x00\xff\xff\x15\x00\xff\xff\x10\x00\x18\x00\x19\x00\x13\x00\xff\xff\x15\x00\xff\xff\x17\x00\x18\x00\x19\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\xff\xff\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3f\x00\xff\xff\x41\x00\xff\xff\x43\x00\xff\xff\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\xff\xff\xff\xff\x4d\x00\x4e\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\x10\x00\x15\x00\xff\xff\x13\x00\x18\x00\x15\x00\xff\xff\x17\x00\x18\x00\x19\x00\x10\x00\xff\xff\xff\xff\x13\x00\xff\xff\x15\x00\xff\xff\x17\x00\x18\x00\x19\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\xff\xff\x2f\x00\x30\x00\xff\xff\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\xff\xff\x39\x00\xff\xff\x08\x00\x09\x00\x0a\x00\x0b\x00\x3f\x00\xff\xff\x41\x00\xff\xff\x43\x00\x11\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x18\x00\x10\x00\x4d\x00\x4e\x00\x13\x00\xff\xff\x15\x00\xff\xff\x17\x00\x18\x00\x19\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\xff\xff\x2f\x00\x30\x00\xff\xff\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\xff\xff\x39\x00\xff\xff\xff\xff\x3c\x00\xff\xff\xff\xff\x3f\x00\xff\xff\x41\x00\xff\xff\x43\x00\xff\xff\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\xff\xff\xff\xff\x4d\x00\x4e\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\xff\xff\x10\x00\xff\xff\xff\xff\x13\x00\x11\x00\x15\x00\xff\xff\x17\x00\x18\x00\x19\x00\x10\x00\x18\x00\xff\xff\x13\x00\xff\xff\x15\x00\xff\xff\x17\x00\x18\x00\x19\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\xff\xff\x2f\x00\x30\x00\xff\xff\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\xff\xff\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3f\x00\xff\xff\x41\x00\xff\xff\x43\x00\xff\xff\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\xff\xff\x4c\x00\x4d\x00\x4e\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x10\x00\xff\xff\xff\xff\x13\x00\x11\x00\x15\x00\xff\xff\x17\x00\x18\x00\x19\x00\x10\x00\x18\x00\xff\xff\x13\x00\xff\xff\x15\x00\xff\xff\x17\x00\x18\x00\x19\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\xff\xff\x2f\x00\x30\x00\xff\xff\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\xff\xff\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3f\x00\xff\xff\x41\x00\xff\xff\x43\x00\xff\xff\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\xff\xff\xff\xff\x4d\x00\x4e\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\xff\xff\x10\x00\xff\xff\xff\xff\x13\x00\x11\x00\x15\x00\x16\x00\x14\x00\x18\x00\x19\x00\x10\x00\x18\x00\xff\xff\x13\x00\x14\x00\x15\x00\xff\xff\x10\x00\x18\x00\x19\x00\x13\x00\xff\xff\x15\x00\xff\xff\xff\xff\x18\x00\x19\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\xff\xff\x2f\x00\x30\x00\xff\xff\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\xff\xff\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3f\x00\xff\xff\x41\x00\xff\xff\x43\x00\xff\xff\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\xff\xff\xff\xff\x4d\x00\x4e\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x10\x00\xff\xff\xff\xff\x13\x00\x11\x00\x15\x00\xff\xff\x10\x00\x18\x00\x19\x00\x13\x00\x18\x00\x15\x00\xff\xff\x10\x00\x18\x00\x19\x00\x13\x00\xff\xff\x15\x00\xff\xff\xff\xff\x18\x00\x19\x00\xff\xff\xff\xff\xff\xff\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\xff\xff\x2f\x00\x30\x00\xff\xff\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\xff\xff\x39\x00\xff\xff\x08\x00\x09\x00\x0a\x00\x0b\x00\x3f\x00\xff\xff\x41\x00\xff\xff\x43\x00\x11\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x18\x00\x10\x00\x4d\x00\x4e\x00\x13\x00\xff\xff\x15\x00\xff\xff\xff\xff\x18\x00\x19\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\xff\xff\x2f\x00\x30\x00\xff\xff\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\xff\xff\x39\x00\xff\xff\x08\x00\x09\x00\x0a\x00\x0b\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x11\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x18\x00\x10\x00\x4d\x00\x4e\x00\x13\x00\xff\xff\x15\x00\xff\xff\xff\xff\x18\x00\x19\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\xff\xff\x2f\x00\x30\x00\xff\xff\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\xff\xff\x39\x00\xff\xff\x08\x00\x09\x00\x0a\x00\x0b\x00\x3f\x00\xff\xff\x41\x00\xff\xff\x43\x00\x11\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x18\x00\x10\x00\x4d\x00\x4e\x00\x13\x00\xff\xff\x15\x00\xff\xff\xff\xff\x18\x00\x19\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\xff\xff\x2f\x00\x30\x00\xff\xff\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\xff\xff\x39\x00\xff\xff\x08\x00\x09\x00\x0a\x00\x0b\x00\x3f\x00\xff\xff\x41\x00\xff\xff\x43\x00\x11\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x18\x00\x10\x00\x4d\x00\x4e\x00\x13\x00\xff\xff\x15\x00\xff\xff\xff\xff\x18\x00\x19\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\xff\xff\x2f\x00\x30\x00\xff\xff\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\xff\xff\x39\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\xff\xff\x3f\x00\xff\xff\x41\x00\xff\xff\x43\x00\xff\xff\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\xff\xff\x10\x00\x4d\x00\x4e\x00\x13\x00\xff\xff\x15\x00\xff\xff\xff\xff\x18\x00\x19\x00\xff\xff\xff\xff\xff\xff\xff\xff\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\xff\xff\x2f\x00\x30\x00\xff\xff\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\xff\xff\x39\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\xff\xff\x3f\x00\xff\xff\x41\x00\xff\xff\x43\x00\xff\xff\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\xff\xff\x10\x00\x4d\x00\x4e\x00\x13\x00\xff\xff\x15\x00\xff\xff\xff\xff\x18\x00\x19\x00\xff\xff\xff\xff\xff\xff\xff\xff\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\xff\xff\x2f\x00\x30\x00\xff\xff\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\xff\xff\x39\x00\xff\xff\x08\x00\xff\xff\xff\xff\xff\xff\x3f\x00\x0d\x00\x41\x00\xff\xff\x43\x00\x11\x00\x45\x00\x46\x00\xff\xff\x48\x00\x49\x00\x4a\x00\x18\x00\x10\x00\x4d\x00\x4e\x00\x13\x00\xff\xff\x15\x00\xff\xff\xff\xff\x18\x00\x19\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\xff\xff\x2f\x00\x30\x00\xff\xff\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\xff\xff\x39\x00\xff\xff\x08\x00\xff\xff\xff\xff\xff\xff\x3f\x00\x0d\x00\x41\x00\xff\xff\x43\x00\x11\x00\x45\x00\x46\x00\x47\x00\xff\xff\x49\x00\x4a\x00\x18\x00\x10\x00\x4d\x00\x4e\x00\x13\x00\xff\xff\x15\x00\xff\xff\xff\xff\x18\x00\x19\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\xff\xff\x2f\x00\x30\x00\xff\xff\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\xff\xff\x39\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\xff\xff\x3f\x00\xff\xff\x41\x00\xff\xff\x43\x00\xff\xff\x45\x00\x46\x00\x47\x00\xff\xff\x49\x00\x4a\x00\xff\xff\x10\x00\x4d\x00\x4e\x00\x13\x00\xff\xff\x15\x00\xff\xff\xff\xff\x18\x00\x19\x00\xff\xff\xff\xff\xff\xff\xff\xff\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\xff\xff\x2f\x00\x30\x00\xff\xff\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\xff\xff\x39\x00\xff\xff\x08\x00\xff\xff\xff\xff\xff\xff\x3f\x00\xff\xff\x41\x00\xff\xff\x43\x00\x11\x00\x45\x00\x46\x00\xff\xff\x48\x00\x49\x00\x4a\x00\x18\x00\x10\x00\x4d\x00\x4e\x00\x13\x00\xff\xff\x15\x00\xff\xff\xff\xff\x18\x00\x19\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\xff\xff\x2f\x00\x30\x00\xff\xff\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\xff\xff\x39\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\xff\xff\x3f\x00\xff\xff\x41\x00\xff\xff\x43\x00\xff\xff\x45\x00\x46\x00\x47\x00\xff\xff\x49\x00\x4a\x00\xff\xff\x10\x00\x4d\x00\x4e\x00\x13\x00\xff\xff\x15\x00\xff\xff\xff\xff\x18\x00\x19\x00\xff\xff\xff\xff\xff\xff\xff\xff\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\xff\xff\x2f\x00\x30\x00\xff\xff\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\xff\xff\x39\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x10\x00\x3f\x00\xff\xff\x13\x00\x14\x00\x15\x00\xff\xff\x45\x00\x18\x00\x19\x00\x48\x00\x49\x00\x4a\x00\xff\xff\x10\x00\x4d\x00\x4e\x00\x13\x00\xff\xff\x15\x00\xff\xff\xff\xff\x18\x00\x19\x00\x28\x00\x29\x00\x2a\x00\xff\xff\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\xff\xff\x2f\x00\x30\x00\xff\xff\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\xff\xff\x39\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x10\x00\x3f\x00\xff\xff\x13\x00\x14\x00\x15\x00\xff\xff\xff\xff\x18\x00\x19\x00\x48\x00\x49\x00\x4a\x00\xff\xff\x10\x00\x4d\x00\x4e\x00\x13\x00\xff\xff\x15\x00\xff\xff\xff\xff\x18\x00\x19\x00\x28\x00\x29\x00\x2a\x00\xff\xff\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\xff\xff\x2f\x00\x30\x00\xff\xff\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\xff\xff\x39\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x10\x00\x3f\x00\xff\xff\x13\x00\x14\x00\x15\x00\xff\xff\xff\xff\x18\x00\x19\x00\x48\x00\xff\xff\x4a\x00\xff\xff\x10\x00\x4d\x00\x4e\x00\x13\x00\xff\xff\x15\x00\xff\xff\xff\xff\x18\x00\x19\x00\x28\x00\x29\x00\x2a\x00\xff\xff\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\xff\xff\x2f\x00\x30\x00\xff\xff\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\xff\xff\x39\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x10\x00\x3f\x00\xff\xff\x13\x00\x14\x00\x15\x00\xff\xff\xff\xff\x18\x00\x19\x00\x48\x00\xff\xff\xff\xff\xff\xff\x10\x00\x4d\x00\x4e\x00\x13\x00\xff\xff\x15\x00\xff\xff\xff\xff\x18\x00\x19\x00\x28\x00\x29\x00\x2a\x00\xff\xff\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\xff\xff\x2f\x00\x30\x00\x08\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x10\x00\x39\x00\xff\xff\x13\x00\xff\xff\x15\x00\xff\xff\x3f\x00\x18\x00\x19\x00\x10\x00\xff\xff\xff\xff\x13\x00\xff\xff\x15\x00\x48\x00\xff\xff\x18\x00\x19\x00\xff\xff\xff\xff\x4e\x00\xff\xff\xff\xff\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\xff\xff\x2f\x00\x30\x00\xff\xff\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x10\x00\x39\x00\xff\xff\x13\x00\x14\x00\x15\x00\xff\xff\x3f\x00\x18\x00\x19\x00\x10\x00\xff\xff\xff\xff\x13\x00\xff\xff\x15\x00\xff\xff\xff\xff\x18\x00\x19\x00\xff\xff\xff\xff\xff\xff\xff\xff\x28\x00\x29\x00\x2a\x00\x28\x00\xff\xff\x2a\x00\x2b\x00\x2c\x00\x2d\x00\xff\xff\x2f\x00\x30\x00\xff\xff\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\xff\xff\x39\x00\xff\xff\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x3f\x00\x2f\x00\x30\x00\xff\xff\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\xff\xff\x39\x00\xff\xff\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x3f\x00\x2f\x00\x30\x00\xff\xff\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\xff\xff\x39\x00\xff\xff\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x3f\x00\x2f\x00\x30\x00\xff\xff\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x10\x00\x39\x00\xff\xff\x13\x00\xff\xff\x15\x00\xff\xff\x3f\x00\x18\x00\x19\x00\x10\x00\xff\xff\xff\xff\x13\x00\xff\xff\x15\x00\xff\xff\x10\x00\x18\x00\x19\x00\x13\x00\xff\xff\x15\x00\xff\xff\x10\x00\x18\x00\x19\x00\x13\x00\xff\xff\x15\x00\xff\xff\x10\x00\x18\x00\x19\x00\x13\x00\xff\xff\x15\x00\xff\xff\x10\x00\x18\x00\x19\x00\x13\x00\xff\xff\x15\x00\xff\xff\x10\x00\x18\x00\x19\x00\x13\x00\xff\xff\x15\x00\xff\xff\x10\x00\x18\x00\x19\x00\x13\x00\xff\xff\x15\x00\xff\xff\x10\x00\x18\x00\x19\x00\x13\x00\xff\xff\x15\x00\xff\xff\x10\x00\x18\x00\x19\x00\x13\x00\xff\xff\x15\x00\xff\xff\x10\x00\x18\x00\x19\x00\x13\x00\xff\xff\x15\x00\xff\xff\x10\x00\x18\x00\x19\x00\x13\x00\xff\xff\x15\x00\xff\xff\x10\x00\x18\x00\x19\x00\x13\x00\xff\xff\x15\x00\xff\xff\x10\x00\x18\x00\x19\x00\x13\x00\xff\xff\x15\x00\xff\xff\x10\x00\x18\x00\x19\x00\x13\x00\xff\xff\x15\x00\xff\xff\x10\x00\x18\x00\x19\x00\x13\x00\xff\xff\x15\x00\xff\xff\x10\x00\x18\x00\x19\x00\x13\x00\xff\xff\x15\x00\xff\xff\x10\x00\x18\x00\x19\x00\x13\x00\xff\xff\x15\x00\xff\xff\x10\x00\x18\x00\x19\x00\x13\x00\xff\xff\x15\x00\xff\xff\x10\x00\x18\x00\x19\x00\x13\x00\xff\xff\x15\x00\xff\xff\x10\x00\x18\x00\x19\x00\x13\x00\xff\xff\x15\x00\xff\xff\x10\x00\x18\x00\x19\x00\x13\x00\xff\xff\x15\x00\xff\xff\x10\x00\x18\x00\x19\x00\x13\x00\xff\xff\x15\x00\xff\xff\x10\x00\x18\x00\x19\x00\x13\x00\xff\xff\x15\x00\xff\xff\x10\x00\x18\x00\x19\x00\x13\x00\xff\xff\x15\x00\xff\xff\x10\x00\x18\x00\x19\x00\x13\x00\xff\xff\x15\x00\xff\xff\x10\x00\x18\x00\x19\x00\x13\x00\xff\xff\x15\x00\xff\xff\x10\x00\x18\x00\x19\x00\x13\x00\xff\xff\x15\x00\xff\xff\x10\x00\x18\x00\x19\x00\x13\x00\xff\xff\x15\x00\xff\xff\x10\x00\x18\x00\x19\x00\x13\x00\xff\xff\x15\x00\xff\xff\x10\x00\x18\x00\x19\x00\x13\x00\xff\xff\x15\x00\xff\xff\x10\x00\x18\x00\x19\x00\x13\x00\xff\xff\x15\x00\xff\xff\x10\x00\x18\x00\x19\x00\x13\x00\xff\xff\x15\x00\xff\xff\x10\x00\x18\x00\x19\x00\x13\x00\xff\xff\x15\x00\xff\xff\x10\x00\x18\x00\x19\x00\x13\x00\xff\xff\x15\x00\xff\xff\x10\x00\x18\x00\x19\x00\x13\x00\xff\xff\x15\x00\xff\xff\xff\xff\x18\x00\x19\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\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\x81\x00\x0b\x00\x0c\x00\xd0\x00\x0d\x00\x0e\x00\x85\x00\x78\x00\x05\x00\x4b\x00\xf8\x00\x06\x00\x56\x00\x07\x00\x0b\x01\x4c\x00\x57\x00\x09\x00\x0f\x00\x10\x00\x1f\x01\xda\x00\x11\x00\x0f\x01\x12\x00\x11\x01\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x58\x00\xff\x00\x5a\x00\x33\x00\x91\x00\x92\x00\x25\x00\x13\x00\x79\x00\x04\x00\x34\x00\x35\x00\x82\x00\x05\x00\x14\x00\x15\x00\x06\x00\xde\x00\x07\x00\x16\x00\x86\x00\x68\x00\x09\x00\x76\x00\x17\x00\x18\x00\x88\x00\x19\x00\xb6\x00\x1a\x00\xf9\x00\xb9\x00\x69\x00\x1b\x00\x33\x00\x1c\x00\xbe\x00\x1d\x00\x1e\x00\x1f\x00\xc1\x00\x34\x00\x35\x00\xc4\x00\x20\x00\x0b\x00\x0c\x00\x76\x00\x0d\x00\x0e\x00\x04\x00\x4a\x00\x05\x00\x4b\x00\x0c\x00\x06\x00\x56\x00\x07\x00\x15\x01\x4c\x00\x57\x00\x09\x00\x0f\x00\x10\x00\x16\x01\x1a\x01\x11\x00\x79\x00\x12\x00\x84\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x58\x00\xe8\x00\x5a\x00\x0c\x01\x0d\x01\x0e\x01\x0f\x01\x13\x00\x05\x00\xfc\x00\xfe\x00\x06\x00\x56\x00\x07\x00\x14\x00\x15\x00\x57\x00\x09\x00\xff\x00\x16\x00\xba\x00\xbb\x00\xbc\x00\x03\x01\x17\x00\x18\x00\x0c\x00\x19\x00\xd2\x00\x1a\x00\x07\x01\xfb\xff\xe3\x00\x1b\x00\x13\x01\x1c\x00\xd3\x00\x1d\x00\x1e\x00\x1f\x00\xcc\x00\xd4\x00\x0b\x00\x0c\x00\x20\x00\x0d\x00\x0e\x00\xd9\x00\xd5\x00\x05\x00\xda\x00\x8a\x00\x06\x00\x56\x00\x07\x00\x8a\x00\xea\x00\x57\x00\x09\x00\x0f\x00\x10\x00\xdc\x00\xe3\x00\x11\x00\x7e\x00\x12\x00\x84\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x58\x00\xeb\x00\x5a\x00\x7d\x00\x88\x00\x0b\x00\x0c\x00\x13\x00\x0d\x00\x0e\x00\xba\x00\xbd\x00\xbc\x00\x8b\x00\x14\x00\x15\x00\xba\x00\xbf\x00\xbc\x00\x16\x00\x8c\x00\x8a\x00\x0f\x00\x10\x00\x17\x00\x18\x00\x11\x00\x19\x00\x12\x00\x1a\x00\x38\x00\x39\x00\x3a\x00\x1b\x00\x20\x00\x1c\x00\x8d\x00\x1d\x00\x1e\x00\x1f\x00\x8e\x00\x8f\x00\x90\x00\x13\x00\x20\x00\xb8\x00\x0c\x00\xc4\x00\xc3\x00\x05\x00\x14\x00\x15\x00\x06\x00\x00\x00\x07\x00\x16\x00\x21\x00\x22\x00\x09\x00\xff\xff\x17\x00\x18\x00\x00\x00\x19\x00\xf0\x00\x1a\x00\x00\x00\x00\x00\x00\x00\x1b\x00\x00\x00\x1c\x00\x00\x00\x1d\x00\x1e\x00\x1f\x00\x00\x00\x00\x00\x0b\x00\x0c\x00\x20\x00\x0d\x00\x0e\x00\x05\x00\x00\x00\x00\x00\x06\x00\x56\x00\x07\x00\x00\x00\x00\x00\x57\x00\x09\x00\x00\x00\x00\x00\x0f\x00\x10\x00\x05\x00\x00\x00\x11\x00\x06\x00\x12\x00\x07\x00\x00\x00\x00\x00\x63\x00\x09\x00\x58\x00\xec\x00\x5a\x00\x73\x00\x74\x00\x29\x00\x00\x00\x2a\x00\x2b\x00\x13\x00\x00\x00\xa1\x00\x65\x00\x00\x00\x00\x00\x05\x00\x14\x00\x15\x00\x06\x00\x79\x00\x07\x00\x16\x00\x00\x00\x6f\x00\x09\x00\x05\x00\x17\x00\x18\x00\x06\x00\x19\x00\x07\x00\x1a\x00\x9d\x00\x22\x00\x09\x00\x1b\x00\x07\x01\x1c\x00\x00\x00\x1d\x00\x1e\x00\x1f\x00\x00\x00\x00\x00\x0b\x00\x0c\x00\x20\x00\x0d\x00\x0e\x00\x00\x00\x00\x00\x05\x00\x00\x00\x00\x00\x06\x00\x56\x00\x07\x00\x00\x00\x00\x00\x57\x00\x09\x00\x0f\x00\x10\x00\x05\x00\x00\x00\x24\x00\x06\x00\x12\x00\x07\x00\x00\x00\x00\x00\x63\x00\x09\x00\x00\x00\x25\x00\x58\x00\xf0\x00\x5a\x00\x00\x00\x00\x00\x0b\x00\x0c\x00\x13\x00\x0d\x00\x0e\x00\xf1\x00\x00\x00\x00\x00\x00\x00\x14\x00\x15\x00\x00\x00\x00\x00\x00\x00\x16\x00\x00\x00\x00\x00\x0f\x00\x10\x00\x17\x00\x18\x00\x11\x00\x19\x00\x12\x00\x1a\x00\x00\x00\x00\x00\x00\x00\x1b\x00\x00\x00\x1c\x00\x00\x00\x1d\x00\x1e\x00\x1f\x00\xcd\x00\xce\x00\x2b\x00\x13\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x05\x00\x14\x00\x15\x00\x06\x00\xb8\x00\x07\x00\x16\x00\x00\x00\x6f\x00\x09\x00\x05\x00\x17\x00\x18\x00\x06\x00\x19\x00\x07\x00\x1a\x00\x27\x00\x22\x00\x09\x00\x1b\x00\x00\x00\x1c\x00\x00\x00\x1d\x00\x1e\x00\x1f\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x20\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x00\x00\x05\x00\x00\x00\x00\x00\x06\x00\x3b\x00\x07\x00\x00\x00\x00\x00\x63\x00\x09\x00\x05\x00\x3c\x00\x00\x00\x06\x00\x00\x00\x07\x00\x00\x00\x5e\x00\x9a\x00\x09\x00\x00\x00\x64\x00\x65\x00\x00\x00\x5f\x00\x9b\x00\x61\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x00\x00\x4b\x00\x00\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\x4c\x00\xca\x00\x4d\x00\x00\x00\x4e\x00\x00\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x00\x00\x00\x00\x55\x00\x56\x00\xc1\x00\x00\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x00\x00\x05\x00\x00\x00\x00\x00\x06\x00\x3b\x00\x07\x00\x00\x00\x00\x00\x66\x00\x09\x00\x05\x00\x3c\x00\x00\x00\x06\x00\x00\x00\x07\x00\x00\x00\x5e\x00\x22\x00\x09\x00\x00\x00\x67\x00\x65\x00\x00\x00\x5f\x00\x60\x00\x61\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x00\x00\x4b\x00\x7f\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x4c\x00\x00\x00\x4d\x00\x00\x00\x4e\x00\x3b\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x3c\x00\x05\x00\x55\x00\x56\x00\x06\x00\x00\x00\x07\x00\x00\x00\x5e\x00\x22\x00\x09\x00\x00\x00\x00\x00\x00\x00\x00\x00\xea\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x00\x00\x4b\x00\x80\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x4c\x00\x00\x00\x4d\x00\x00\x00\x4e\x00\x3b\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x3c\x00\x05\x00\x55\x00\x56\x00\x06\x00\x00\x00\x07\x00\x00\x00\x9d\x00\x22\x00\x09\x00\x00\x00\x9e\x00\x9f\x00\xa0\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x00\x00\x4b\x00\x00\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x4c\x00\x00\x00\x4d\x00\x00\x00\x4e\x00\x3b\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x3c\x00\x00\x00\x55\x00\x56\x00\xff\xff\x05\x00\x00\x00\x00\x00\x06\x00\x00\x00\x07\x00\x00\x00\x20\x01\x22\x00\x09\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x00\x00\x4b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4c\x00\x00\x00\x4d\x00\xdd\x00\x4e\x00\x00\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\xde\x00\x00\x00\x55\x00\x56\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x00\x00\xcf\xff\xcf\xff\x28\x00\x29\x00\x3b\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3c\x00\x00\x00\x05\x00\x00\x00\x00\x00\x06\x00\x00\x00\x07\x00\x00\x00\x00\x00\x2c\x00\x09\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x00\x00\x4b\x00\x00\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x4c\x00\x00\x00\x4d\x00\x00\x00\x4e\x00\x3b\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x3c\x00\x00\x00\x55\x00\x56\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x00\x00\x4b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x00\x00\x4b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4c\x00\x00\x00\x4d\x00\x00\x00\x4e\x00\x18\x01\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x00\x00\x00\x00\x55\x00\x56\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x00\x00\x05\x00\x26\x00\x00\x00\x06\x00\x3b\x00\x07\x00\x00\x00\x05\x00\x71\x00\x09\x00\x06\x00\x3c\x00\x07\x00\x00\x00\x27\x00\x22\x00\x09\x00\x00\x00\x00\x00\x00\x00\x00\x00\x72\x00\x65\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x00\x00\x4b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4c\x00\x00\x00\x4d\x00\x00\x00\x4e\x00\x19\x01\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x00\x00\x00\x00\x55\x00\x56\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x28\x00\x29\x00\x00\x00\x2a\x00\x2b\x00\x3b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x05\x00\x3c\x00\x00\x00\x06\x00\x00\x00\x07\x00\x00\x00\x05\x00\x6f\x00\x09\x00\x06\x00\x00\x00\x07\x00\x00\x00\x13\x01\x22\x00\x09\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x00\x00\x43\x00\x44\x00\x79\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x00\x00\x4b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4c\x00\x00\x00\x4d\x00\x00\x00\x4e\x00\x00\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x00\x00\x00\x00\x55\x00\x56\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3b\x00\x00\x00\x00\x00\x05\x00\xfb\x00\x00\x00\x06\x00\x3c\x00\x07\x00\x00\x00\x05\x01\x22\x00\x09\x00\x05\x00\x00\x00\x00\x00\x06\x00\x00\x00\x07\x00\x00\x00\x0a\x01\x22\x00\x09\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x00\x00\x4b\x00\x00\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x4c\x00\x00\x00\x4d\x00\x00\x00\x4e\x00\x3b\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x3c\x00\x05\x00\x55\x00\x56\x00\x06\x00\x00\x00\x07\x00\x00\x00\x10\x01\x22\x00\x09\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x00\x00\x4b\x00\x00\x00\x00\x00\xfd\x00\x00\x00\x00\x00\x4c\x00\x00\x00\x4d\x00\x00\x00\x4e\x00\x00\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x00\x00\x00\x00\x55\x00\x56\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x00\x00\x05\x00\x00\x00\x00\x00\x06\x00\x3b\x00\x07\x00\x00\x00\xca\x00\x22\x00\x09\x00\x05\x00\x3c\x00\x00\x00\x06\x00\x00\x00\x07\x00\x00\x00\xd0\x00\x22\x00\x09\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x00\x00\x4b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4c\x00\x00\x00\x4d\x00\x00\x00\x4e\x00\x00\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x00\x00\xe0\x00\x55\x00\x56\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x7a\x00\x05\x00\x00\x00\x00\x00\x06\x00\x3b\x00\x07\x00\x00\x00\xe7\x00\x22\x00\x09\x00\x05\x00\x3c\x00\x00\x00\x06\x00\x00\x00\x07\x00\x00\x00\xf3\x00\x22\x00\x09\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x00\x00\x4b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4c\x00\x00\x00\x4d\x00\x00\x00\x4e\x00\x00\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x00\x00\x00\x00\x55\x00\x56\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x00\x00\x05\x00\x00\x00\x00\x00\x06\x00\x3b\x00\x07\x00\xf5\x00\x7b\x00\xf6\x00\x09\x00\x05\x00\x3c\x00\x00\x00\x06\x00\x6d\x00\x07\x00\x00\x00\x05\x00\x6e\x00\x09\x00\x06\x00\x00\x00\x07\x00\x00\x00\x00\x00\x1c\x01\x09\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x00\x00\x4b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4c\x00\x00\x00\x4d\x00\x00\x00\x4e\x00\x00\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x00\x00\x00\x00\x55\x00\x56\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x83\x00\x05\x00\x00\x00\x00\x00\x06\x00\x3b\x00\x07\x00\x00\x00\x05\x00\x1d\x01\x09\x00\x06\x00\x3c\x00\x07\x00\x00\x00\x05\x00\x1e\x01\x09\x00\x06\x00\x00\x00\x07\x00\x00\x00\x00\x00\x16\x01\x09\x00\x00\x00\x00\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x00\x00\x4b\x00\x00\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x4c\x00\x00\x00\x4d\x00\x00\x00\x4e\x00\x3b\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x3c\x00\x05\x00\x55\x00\x56\x00\x06\x00\x00\x00\x07\x00\x00\x00\x00\x00\x1a\x01\x09\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x00\x00\x4b\x00\x00\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x4c\x00\x00\x00\x4d\x00\x87\x00\x4e\x00\x3b\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x3c\x00\x05\x00\x55\x00\x56\x00\x06\x00\x00\x00\x07\x00\x00\x00\x00\x00\x1b\x01\x09\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x00\x00\x4b\x00\x00\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x4c\x00\x00\x00\x4d\x00\x00\x00\x4e\x00\x00\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x3c\x00\x05\x00\x55\x00\x56\x00\x06\x00\x00\x00\x07\x00\x00\x00\x00\x00\x00\x01\x09\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x00\x00\x4b\x00\x00\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x4c\x00\x00\x00\x4d\x00\x00\x00\x4e\x00\x3b\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x3c\x00\x05\x00\x55\x00\x56\x00\x06\x00\x00\x00\x07\x00\x00\x00\x00\x00\x01\x01\x09\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x00\x00\x4b\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x00\x00\x4c\x00\x00\x00\x4d\x00\x00\x00\x4e\x00\x00\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x00\x00\x05\x00\x55\x00\x56\x00\x06\x00\x00\x00\x07\x00\x00\x00\x00\x00\x03\x01\x09\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x00\x00\x4b\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x00\x00\x4c\x00\x00\x00\x4d\x00\x00\x00\x4e\x00\x00\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x00\x00\x05\x00\x55\x00\x56\x00\x06\x00\x00\x00\x07\x00\x00\x00\x00\x00\x04\x01\x09\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x00\x00\x4b\x00\x00\x00\x37\x00\x00\x00\x00\x00\x00\x00\x4c\x00\xd7\x00\x00\x00\x00\x00\x00\x00\x3b\x00\x4f\x00\x50\x00\x00\x00\x52\x00\x53\x00\x54\x00\x3c\x00\x05\x00\x55\x00\x56\x00\x06\x00\x00\x00\x07\x00\x00\x00\x00\x00\x08\x01\x09\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x00\x00\x4b\x00\x00\x00\x37\x00\x00\x00\x00\x00\x00\x00\x4c\x00\xd8\x00\x4d\x00\x00\x00\x4e\x00\x3b\x00\x4f\x00\x50\x00\x51\x00\x00\x00\x53\x00\x54\x00\x3c\x00\x05\x00\x55\x00\x56\x00\x06\x00\x00\x00\x07\x00\x00\x00\x00\x00\x09\x01\x09\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x00\x00\x4b\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x00\x00\x4c\x00\x00\x00\x4d\x00\x00\x00\x4e\x00\x00\x00\x4f\x00\x50\x00\x51\x00\x00\x00\x53\x00\x54\x00\x00\x00\x05\x00\x55\x00\x56\x00\x06\x00\x00\x00\x07\x00\x00\x00\x00\x00\xcc\x00\x09\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x00\x00\x4b\x00\x00\x00\x37\x00\x00\x00\x00\x00\x00\x00\x4c\x00\x00\x00\x4d\x00\x00\x00\x4e\x00\x3b\x00\x4f\x00\x50\x00\x00\x00\x52\x00\x53\x00\x54\x00\x3c\x00\x05\x00\x55\x00\x56\x00\x06\x00\x00\x00\x07\x00\x00\x00\x00\x00\xd5\x00\x09\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x00\x00\x4b\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x00\x00\x4c\x00\x00\x00\x4d\x00\x00\x00\x4e\x00\x00\x00\x4f\x00\x50\x00\x51\x00\x00\x00\x53\x00\x54\x00\x00\x00\x05\x00\x55\x00\x56\x00\x06\x00\x00\x00\x07\x00\x00\x00\x00\x00\xe0\x00\x09\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x00\x00\x4b\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x05\x00\x4c\x00\x00\x00\x06\x00\x56\x00\x07\x00\x00\x00\x4f\x00\x57\x00\x09\x00\x52\x00\x53\x00\x54\x00\x00\x00\x05\x00\x55\x00\x56\x00\x06\x00\x00\x00\x07\x00\x00\x00\x00\x00\xe1\x00\x09\x00\x58\x00\xf7\x00\x5a\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x00\x00\x4b\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x05\x00\x4c\x00\x00\x00\x06\x00\x56\x00\x07\x00\x00\x00\x00\x00\x57\x00\x09\x00\x52\x00\x53\x00\x54\x00\x00\x00\x05\x00\x55\x00\x56\x00\x06\x00\x00\x00\x07\x00\x00\x00\x00\x00\xe4\x00\x09\x00\x58\x00\x59\x00\x5a\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x00\x00\x4b\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x05\x00\x4c\x00\x00\x00\x06\x00\x56\x00\x07\x00\x00\x00\x00\x00\x57\x00\x09\x00\x52\x00\x00\x00\x54\x00\x00\x00\x05\x00\x55\x00\x56\x00\x06\x00\x00\x00\x07\x00\x00\x00\x00\x00\xe5\x00\x09\x00\x58\x00\x5b\x00\x5a\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x00\x00\x4b\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x05\x00\x4c\x00\x00\x00\x06\x00\x56\x00\x07\x00\x00\x00\x00\x00\x57\x00\x09\x00\x52\x00\x00\x00\x00\x00\x00\x00\x05\x00\x55\x00\x56\x00\x06\x00\x00\x00\x07\x00\x00\x00\x00\x00\xe6\x00\x09\x00\x58\x00\x5c\x00\x5a\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x00\x00\x43\x00\x44\x00\x37\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x05\x00\x4b\x00\x00\x00\x06\x00\x00\x00\x07\x00\x00\x00\x4c\x00\xed\x00\x09\x00\x05\x00\x00\x00\x00\x00\x06\x00\x00\x00\x07\x00\x52\x00\x00\x00\xee\x00\x09\x00\x00\x00\x00\x00\x56\x00\x00\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x05\x00\x4b\x00\x00\x00\x06\x00\x56\x00\x07\x00\x00\x00\x4c\x00\x57\x00\x09\x00\x05\x00\x00\x00\x00\x00\x06\x00\x00\x00\x07\x00\x00\x00\x00\x00\xf2\x00\x09\x00\x00\x00\x00\x00\x00\x00\x00\x00\x58\x00\x5d\x00\x5a\x00\x3d\x00\x00\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x00\x00\x4b\x00\x00\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x4c\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x00\x00\x4b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x00\x00\x4b\x00\x00\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x4c\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x05\x00\x4b\x00\x00\x00\x06\x00\x00\x00\x07\x00\x00\x00\x4c\x00\xf4\x00\x09\x00\x05\x00\x00\x00\x00\x00\x06\x00\x00\x00\x07\x00\x00\x00\x05\x00\x92\x00\x09\x00\x06\x00\x00\x00\x07\x00\x00\x00\x05\x00\x93\x00\x09\x00\x06\x00\x00\x00\x07\x00\x00\x00\x05\x00\x94\x00\x09\x00\x06\x00\x00\x00\x07\x00\x00\x00\x05\x00\x95\x00\x09\x00\x06\x00\x00\x00\x07\x00\x00\x00\x05\x00\x96\x00\x09\x00\x06\x00\x00\x00\x07\x00\x00\x00\x05\x00\x97\x00\x09\x00\x06\x00\x00\x00\x07\x00\x00\x00\x05\x00\x98\x00\x09\x00\x06\x00\x00\x00\x07\x00\x00\x00\x05\x00\x99\x00\x09\x00\x06\x00\x00\x00\x07\x00\x00\x00\x05\x00\x9c\x00\x09\x00\x06\x00\x00\x00\x07\x00\x00\x00\x05\x00\xa2\x00\x09\x00\x06\x00\x00\x00\x07\x00\x00\x00\x05\x00\xa3\x00\x09\x00\x06\x00\x00\x00\x07\x00\x00\x00\x05\x00\xa4\x00\x09\x00\x06\x00\x00\x00\x07\x00\x00\x00\x05\x00\xa5\x00\x09\x00\x06\x00\x00\x00\x07\x00\x00\x00\x05\x00\xa6\x00\x09\x00\x06\x00\x00\x00\x07\x00\x00\x00\x05\x00\xa7\x00\x09\x00\x06\x00\x00\x00\x07\x00\x00\x00\x05\x00\xa8\x00\x09\x00\x06\x00\x00\x00\x07\x00\x00\x00\x05\x00\xa9\x00\x09\x00\x06\x00\x00\x00\x07\x00\x00\x00\x05\x00\xaa\x00\x09\x00\x06\x00\x00\x00\x07\x00\x00\x00\x05\x00\xab\x00\x09\x00\x06\x00\x00\x00\x07\x00\x00\x00\x05\x00\xac\x00\x09\x00\x06\x00\x00\x00\x07\x00\x00\x00\x05\x00\xad\x00\x09\x00\x06\x00\x00\x00\x07\x00\x00\x00\x05\x00\xae\x00\x09\x00\x06\x00\x00\x00\x07\x00\x00\x00\x05\x00\xaf\x00\x09\x00\x06\x00\x00\x00\x07\x00\x00\x00\x05\x00\xb0\x00\x09\x00\x06\x00\x00\x00\x07\x00\x00\x00\x05\x00\xb1\x00\x09\x00\x06\x00\x00\x00\x07\x00\x00\x00\x05\x00\xb2\x00\x09\x00\x06\x00\x00\x00\x07\x00\x00\x00\x05\x00\xb3\x00\x09\x00\x06\x00\x00\x00\x07\x00\x00\x00\x05\x00\xb4\x00\x09\x00\x06\x00\x00\x00\x07\x00\x00\x00\x05\x00\xb5\x00\x09\x00\x06\x00\x00\x00\x07\x00\x00\x00\x05\x00\x62\x00\x09\x00\x06\x00\x00\x00\x07\x00\x00\x00\x05\x00\x6a\x00\x09\x00\x06\x00\x00\x00\x07\x00\x00\x00\x05\x00\x6b\x00\x09\x00\x06\x00\x00\x00\x07\x00\x00\x00\x05\x00\x6c\x00\x09\x00\x06\x00\x00\x00\x07\x00\x00\x00\x05\x00\x70\x00\x09\x00\x06\x00\x00\x00\x07\x00\x00\x00\x00\x00\x08\x00\x09\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\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, 142) [ + (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) + ] + +happy_n_terms = 80 :: Int +happy_n_nonterms = 43 :: Int + +happyReduce_3 = happySpecReduce_2 0# happyReduction_3 +happyReduction_3 happy_x_2 + happy_x_1 + = case happyOut10 happy_x_2 of { happy_var_2 -> + happyIn6 + (happy_var_2 + )} + +happyReduce_4 = happyMonadReduce 4# 1# happyReduction_4 +happyReduction_4 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut30 happy_x_2 of { happy_var_2 -> + case happyOut29 happy_x_4 of { happy_var_4 -> + ( do + d <- convDecl happy_var_2 happy_var_4 + return $ annotate2 happy_var_1 happy_var_4 (Bind d))}}} + ) (\r -> happyReturn (happyIn7 r)) + +happyReduce_5 = happySpecReduce_2 1# happyReduction_5 +happyReduction_5 happy_x_2 + happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut16 happy_x_2 of { happy_var_2 -> + happyIn7 + (annotate happy_var_1 (RunAssertion happy_var_2) + )}} + +happyReduce_6 = happySpecReduce_1 1# happyReduction_6 +happyReduction_6 happy_x_1 + = case happyOut29 happy_x_1 of { happy_var_1 -> + happyIn7 + (annotate happy_var_1 (Evaluate happy_var_1) + )} + +happyReduce_7 = happySpecReduce_1 2# happyReduction_7 +happyReduction_7 happy_x_1 + = happyIn8 + ( + ) + +happyReduce_8 = happySpecReduce_2 2# happyReduction_8 +happyReduction_8 happy_x_2 + happy_x_1 + = happyIn8 + ( + ) + +happyReduce_9 = happySpecReduce_0 3# happyReduction_9 +happyReduction_9 = happyIn9 + ( + ) + +happyReduce_10 = happySpecReduce_2 3# happyReduction_10 +happyReduction_10 happy_x_2 + happy_x_1 + = happyIn9 + ( + ) + +happyReduce_11 = happySpecReduce_0 4# happyReduction_11 +happyReduction_11 = happyIn10 + ([] + ) + +happyReduce_12 = happySpecReduce_1 4# happyReduction_12 +happyReduction_12 happy_x_1 + = case happyOut11 happy_x_1 of { happy_var_1 -> + happyIn10 + (happy_var_1 + )} + +happyReduce_13 = happySpecReduce_1 5# happyReduction_13 +happyReduction_13 happy_x_1 + = case happyOut12 happy_x_1 of { happy_var_1 -> + happyIn11 + (combineDecls (reverse happy_var_1) + )} + +happyReduce_14 = happySpecReduce_1 6# happyReduction_14 +happyReduction_14 happy_x_1 + = case happyOut14 happy_x_1 of { happy_var_1 -> + happyIn12 + ([happy_var_1] + )} + +happyReduce_15 = happySpecReduce_3 6# happyReduction_15 +happyReduction_15 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut12 happy_x_1 of { happy_var_1 -> + case happyOut13 happy_x_3 of { happy_var_3 -> + happyIn12 + (case happy_var_3 of + Just d -> d:happy_var_1 + Nothing -> happy_var_1 + )}} + +happyReduce_16 = happySpecReduce_0 7# happyReduction_16 +happyReduction_16 = happyIn13 + (Nothing + ) + +happyReduce_17 = happySpecReduce_1 7# happyReduction_17 +happyReduction_17 happy_x_1 + = case happyOut14 happy_x_1 of { happy_var_1 -> + happyIn13 + (Just happy_var_1 + )} + +happyReduce_18 = happyMonadReduce 1# 8# happyReduction_18 +happyReduction_18 (happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOut15 happy_x_1 of { happy_var_1 -> + ( annotateWithSymbolTable happy_var_1)} + ) (\r -> happyReturn (happyIn14 r)) + +happyReduce_19 = happyMonadReduce 3# 9# happyReduction_19 +happyReduction_19 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOut30 happy_x_1 of { happy_var_1 -> + case happyOut29 happy_x_3 of { happy_var_3 -> + ( convDecl happy_var_1 happy_var_3)}} + ) (\r -> happyReturn (happyIn15 r)) + +happyReduce_20 = happySpecReduce_2 9# happyReduction_20 +happyReduction_20 happy_x_2 + happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut23 happy_x_2 of { happy_var_2 -> + happyIn15 + (annotate2List happy_var_1 happy_var_2 (Channel (map unLoc happy_var_2) Nothing) + )}} + +happyReduce_21 = happyReduce 4# 9# happyReduction_21 +happyReduction_21 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut23 happy_x_2 of { happy_var_2 -> + case happyOut29 happy_x_4 of { happy_var_4 -> + happyIn15 + (annotate2 happy_var_1 happy_var_4 (Channel (map unLoc happy_var_2) (Just happy_var_4)) + ) `HappyStk` happyRest}}} + +happyReduce_22 = happyReduce 4# 9# happyReduction_22 +happyReduction_22 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut22 happy_x_2 of { happy_var_2 -> + case happyOut20 happy_x_4 of { happy_var_4 -> + happyIn15 + (annotate2List happy_var_1 happy_var_4 (DataType (unLoc happy_var_2) happy_var_4) + ) `HappyStk` happyRest}}} + +happyReduce_23 = happySpecReduce_2 9# happyReduction_23 +happyReduction_23 happy_x_2 + happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut23 happy_x_2 of { happy_var_2 -> + happyIn15 + (annotate2List happy_var_1 happy_var_2 (External (map unLoc happy_var_2)) + )}} + +happyReduce_24 = happySpecReduce_2 9# happyReduction_24 +happyReduction_24 happy_x_2 + happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut23 happy_x_2 of { happy_var_2 -> + happyIn15 + (annotate2List happy_var_1 happy_var_2 (Transparent (map unLoc happy_var_2)) + )}} + +happyReduce_25 = happySpecReduce_2 9# happyReduction_25 +happyReduction_25 happy_x_2 + happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut16 happy_x_2 of { happy_var_2 -> + happyIn15 + (annotate happy_var_1 (Assert happy_var_2) + )}} + +happyReduce_26 = happyReduce 4# 9# happyReduction_26 +happyReduction_26 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut22 happy_x_2 of { happy_var_2 -> + case happyOut29 happy_x_4 of { happy_var_4 -> + happyIn15 + (annotate2 happy_var_1 happy_var_4 (NameType (unLoc happy_var_2) happy_var_4) + ) `HappyStk` happyRest}}} + +happyReduce_27 = happySpecReduce_3 10# happyReduction_27 +happyReduction_27 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut29 happy_x_1 of { happy_var_1 -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut29 happy_x_3 of { happy_var_3 -> + happyIn16 + ((Refinement happy_var_1 (getRefinesModel happy_var_2) happy_var_3 []) + )}}} + +happyReduce_28 = happyReduce 4# 10# happyReduction_28 +happyReduction_28 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut29 happy_x_1 of { happy_var_1 -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut29 happy_x_3 of { happy_var_3 -> + case happyOut18 happy_x_4 of { happy_var_4 -> + happyIn16 + ((Refinement happy_var_1 (getRefinesModel happy_var_2) happy_var_3 [happy_var_4]) + ) `HappyStk` happyRest}}}} + +happyReduce_29 = happySpecReduce_2 10# happyReduction_29 +happyReduction_29 happy_x_2 + happy_x_1 + = case happyOut29 happy_x_1 of { happy_var_1 -> + case happyOut17 happy_x_2 of { happy_var_2 -> + happyIn16 + ((PropertyCheck happy_var_1 happy_var_2 Nothing) + )}} + +happyReduce_30 = happySpecReduce_3 10# happyReduction_30 +happyReduction_30 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut29 happy_x_1 of { happy_var_1 -> + case happyOut17 happy_x_2 of { happy_var_2 -> + case happyOutTok happy_x_3 of { happy_var_3 -> + happyIn16 + ((PropertyCheck happy_var_1 happy_var_2 (Just (getPropModel happy_var_3))) + )}}} + +happyReduce_31 = happySpecReduce_1 11# happyReduction_31 +happyReduction_31 happy_x_1 + = happyIn17 + (DeadlockFreedom + ) + +happyReduce_32 = happySpecReduce_1 11# happyReduction_32 +happyReduction_32 happy_x_1 + = happyIn17 + (LivelockFreedom + ) + +happyReduce_33 = happySpecReduce_1 11# happyReduction_33 +happyReduction_33 happy_x_1 + = happyIn17 + (LivelockFreedom + ) + +happyReduce_34 = happySpecReduce_1 11# happyReduction_34 +happyReduction_34 happy_x_1 + = happyIn17 + (Deterministic + ) + +happyReduce_35 = happySpecReduce_2 12# happyReduction_35 +happyReduction_35 happy_x_2 + happy_x_1 + = case happyOut29 happy_x_2 of { happy_var_2 -> + happyIn18 + (TauPriority happy_var_2 + )} + +happyReduce_36 = happySpecReduce_3 13# happyReduction_36 +happyReduction_36 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut22 happy_x_1 of { happy_var_1 -> + case happyOut29 happy_x_3 of { happy_var_3 -> + happyIn19 + (annotate2 happy_var_1 happy_var_3 (DataTypeClause (unLoc happy_var_1) (Just happy_var_3)) + )}} + +happyReduce_37 = happySpecReduce_1 13# happyReduction_37 +happyReduction_37 happy_x_1 + = case happyOut22 happy_x_1 of { happy_var_1 -> + happyIn19 + (annotate happy_var_1 (DataTypeClause (unLoc happy_var_1) Nothing) + )} + +happyReduce_38 = happySpecReduce_1 14# happyReduction_38 +happyReduction_38 happy_x_1 + = case happyOut21 happy_x_1 of { happy_var_1 -> + happyIn20 + (reverse happy_var_1 + )} + +happyReduce_39 = happySpecReduce_1 15# happyReduction_39 +happyReduction_39 happy_x_1 + = case happyOut19 happy_x_1 of { happy_var_1 -> + happyIn21 + ([happy_var_1] + )} + +happyReduce_40 = happySpecReduce_3 15# happyReduction_40 +happyReduction_40 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut21 happy_x_1 of { happy_var_1 -> + case happyOut19 happy_x_3 of { happy_var_3 -> + happyIn21 + (happy_var_3:happy_var_1 + )}} + +happyReduce_41 = happySpecReduce_1 16# happyReduction_41 +happyReduction_41 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn22 + (liftLoc happy_var_1 (UnQual (OccName (getName happy_var_1))) + )} + +happyReduce_42 = happySpecReduce_1 17# happyReduction_42 +happyReduction_42 happy_x_1 + = case happyOut24 happy_x_1 of { happy_var_1 -> + happyIn23 + (reverse happy_var_1 + )} + +happyReduce_43 = happySpecReduce_1 18# happyReduction_43 +happyReduction_43 happy_x_1 + = case happyOut22 happy_x_1 of { happy_var_1 -> + happyIn24 + ([happy_var_1] + )} + +happyReduce_44 = happySpecReduce_3 18# happyReduction_44 +happyReduction_44 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut24 happy_x_1 of { happy_var_1 -> + case happyOut22 happy_x_3 of { happy_var_3 -> + happyIn24 + (happy_var_3:happy_var_1 + )}} + +happyReduce_45 = happySpecReduce_1 19# happyReduction_45 +happyReduction_45 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn25 + (liftLoc happy_var_1 (Int (getInt happy_var_1)) + )} + +happyReduce_46 = happySpecReduce_1 19# happyReduction_46 +happyReduction_46 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn25 + (liftLoc happy_var_1 (Bool True) + )} + +happyReduce_47 = happySpecReduce_1 19# happyReduction_47 +happyReduction_47 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn25 + (liftLoc happy_var_1 (Bool False) + )} + +happyReduce_48 = happySpecReduce_1 20# happyReduction_48 +happyReduction_48 happy_x_1 + = case happyOut30 happy_x_1 of { happy_var_1 -> + happyIn26 + (convPat happy_var_1 + )} + +happyReduce_49 = happyMonadReduce 1# 21# happyReduction_49 +happyReduction_49 (happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + ( do + modifyTopFileParserState ( + \ st @ (FileParserState { sequenceStack = (c:cs) }) -> + st { sequenceStack = (c+1):cs }) + return happy_var_1)} + ) (\r -> happyReturn (happyIn27 r)) + +happyReduce_50 = happySpecReduce_1 22# happyReduction_50 +happyReduction_50 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn28 + (happy_var_1 + )} + +happyReduce_51 = happySpecReduce_1 23# happyReduction_51 +happyReduction_51 happy_x_1 + = case happyOut30 happy_x_1 of { happy_var_1 -> + happyIn29 + (checkExp happy_var_1 + )} + +happyReduce_52 = happyMonadReduce 1# 24# happyReduction_52 +happyReduction_52 (happy_x_1 `HappyStk` + happyRest) tk + = happyThen (case happyOut31 happy_x_1 of { happy_var_1 -> + ( do + t <- freshPType + let An l _ e = happy_var_1 + return $ An l (Nothing, t) e)} + ) (\r -> happyReturn (happyIn30 r)) + +happyReduce_53 = happySpecReduce_1 25# happyReduction_53 +happyReduction_53 happy_x_1 + = case happyOut25 happy_x_1 of { happy_var_1 -> + happyIn31 + (liftLoc happy_var_1 (Lit (unLoc happy_var_1)) + )} + +happyReduce_54 = happySpecReduce_1 25# happyReduction_54 +happyReduction_54 happy_x_1 + = case happyOut22 happy_x_1 of { happy_var_1 -> + happyIn31 + (liftLoc happy_var_1 (Var (unLoc happy_var_1)) + )} + +happyReduce_55 = happySpecReduce_3 25# happyReduction_55 +happyReduction_55 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut41 happy_x_2 of { happy_var_2 -> + case happyOutTok happy_x_3 of { happy_var_3 -> + happyIn31 + (annotate2 happy_var_1 happy_var_3 (Tuple happy_var_2) + )}}} + +happyReduce_56 = happySpecReduce_3 25# happyReduction_56 +happyReduction_56 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut30 happy_x_1 of { happy_var_1 -> + case happyOut30 happy_x_3 of { happy_var_3 -> + happyIn31 + (annotate2 happy_var_1 happy_var_3 (DotApp happy_var_1 happy_var_3) + )}} + +happyReduce_57 = happyReduce 4# 25# happyReduction_57 +happyReduction_57 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut11 happy_x_2 of { happy_var_2 -> + case happyOut30 happy_x_4 of { happy_var_4 -> + happyIn31 + (annotate2 happy_var_1 happy_var_4 (Let (checkLetDecls happy_var_2) happy_var_4) + ) `HappyStk` happyRest}}} + +happyReduce_58 = happyReduce 6# 25# happyReduction_58 +happyReduction_58 (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_1 of { happy_var_1 -> + case happyOut30 happy_x_2 of { happy_var_2 -> + case happyOut30 happy_x_4 of { happy_var_4 -> + case happyOut30 happy_x_6 of { happy_var_6 -> + happyIn31 + (annotate2 happy_var_1 happy_var_6 (If happy_var_2 happy_var_4 happy_var_6) + ) `HappyStk` happyRest}}}} + +happyReduce_59 = happySpecReduce_3 25# happyReduction_59 +happyReduction_59 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut30 happy_x_2 of { happy_var_2 -> + case happyOutTok happy_x_3 of { happy_var_3 -> + happyIn31 + (annotate2 happy_var_1 happy_var_3 (Paren happy_var_2) + )}}} + +happyReduce_60 = happyReduce 4# 25# happyReduction_60 +happyReduction_60 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut30 happy_x_1 of { happy_var_1 -> + case happyOut43 happy_x_3 of { happy_var_3 -> + case happyOutTok happy_x_4 of { happy_var_4 -> + happyIn31 + (annotate2 happy_var_1 happy_var_4 (App happy_var_1 happy_var_3) + ) `HappyStk` happyRest}}} + +happyReduce_61 = happyReduce 4# 25# happyReduction_61 +happyReduction_61 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut26 happy_x_2 of { happy_var_2 -> + case happyOut30 happy_x_4 of { happy_var_4 -> + happyIn31 + (annotate2 happy_var_1 happy_var_4 (Lambda happy_var_2 happy_var_4) + ) `HappyStk` happyRest}}} + +happyReduce_62 = happySpecReduce_3 25# happyReduction_62 +happyReduction_62 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut30 happy_x_1 of { happy_var_1 -> + case happyOut30 happy_x_3 of { happy_var_3 -> + happyIn31 + (annotate2 happy_var_1 happy_var_3 (BooleanBinaryOp Equals happy_var_1 happy_var_3) + )}} + +happyReduce_63 = happySpecReduce_3 25# happyReduction_63 +happyReduction_63 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut30 happy_x_1 of { happy_var_1 -> + case happyOut30 happy_x_3 of { happy_var_3 -> + happyIn31 + (annotate2 happy_var_1 happy_var_3 (BooleanBinaryOp NotEquals happy_var_1 happy_var_3) + )}} + +happyReduce_64 = happySpecReduce_3 25# happyReduction_64 +happyReduction_64 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut30 happy_x_1 of { happy_var_1 -> + case happyOut30 happy_x_3 of { happy_var_3 -> + happyIn31 + (annotate2 happy_var_1 happy_var_3 (BooleanBinaryOp LessThan happy_var_1 happy_var_3) + )}} + +happyReduce_65 = happySpecReduce_3 25# happyReduction_65 +happyReduction_65 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut30 happy_x_1 of { happy_var_1 -> + case happyOut30 happy_x_3 of { happy_var_3 -> + happyIn31 + (annotate2 happy_var_1 happy_var_3 (BooleanBinaryOp GreaterThan happy_var_1 happy_var_3) + )}} + +happyReduce_66 = happySpecReduce_3 25# happyReduction_66 +happyReduction_66 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut30 happy_x_1 of { happy_var_1 -> + case happyOut30 happy_x_3 of { happy_var_3 -> + happyIn31 + (annotate2 happy_var_1 happy_var_3 (BooleanBinaryOp LessThanEq happy_var_1 happy_var_3) + )}} + +happyReduce_67 = happySpecReduce_3 25# happyReduction_67 +happyReduction_67 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut30 happy_x_1 of { happy_var_1 -> + case happyOut30 happy_x_3 of { happy_var_3 -> + happyIn31 + (annotate2 happy_var_1 happy_var_3 (BooleanBinaryOp GreaterThanEq happy_var_1 happy_var_3) + )}} + +happyReduce_68 = happySpecReduce_2 25# happyReduction_68 +happyReduction_68 happy_x_2 + happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut30 happy_x_2 of { happy_var_2 -> + happyIn31 + (annotate2 happy_var_1 happy_var_2 (BooleanUnaryOp Not happy_var_2) + )}} + +happyReduce_69 = happySpecReduce_3 25# happyReduction_69 +happyReduction_69 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut30 happy_x_1 of { happy_var_1 -> + case happyOut30 happy_x_3 of { happy_var_3 -> + happyIn31 + (annotate2 happy_var_1 happy_var_3 (BooleanBinaryOp Or happy_var_1 happy_var_3) + )}} + +happyReduce_70 = happySpecReduce_3 25# happyReduction_70 +happyReduction_70 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut30 happy_x_1 of { happy_var_1 -> + case happyOut30 happy_x_3 of { happy_var_3 -> + happyIn31 + (annotate2 happy_var_1 happy_var_3 (BooleanBinaryOp And happy_var_1 happy_var_3) + )}} + +happyReduce_71 = happySpecReduce_2 25# happyReduction_71 +happyReduction_71 happy_x_2 + happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut30 happy_x_2 of { happy_var_2 -> + happyIn31 + (annotate2 happy_var_1 happy_var_2 (MathsUnaryOp Negate happy_var_2) + )}} + +happyReduce_72 = happySpecReduce_3 25# happyReduction_72 +happyReduction_72 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut30 happy_x_1 of { happy_var_1 -> + case happyOut30 happy_x_3 of { happy_var_3 -> + happyIn31 + (annotate2 happy_var_1 happy_var_3 (MathsBinaryOp Plus happy_var_1 happy_var_3) + )}} + +happyReduce_73 = happySpecReduce_3 25# happyReduction_73 +happyReduction_73 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut30 happy_x_1 of { happy_var_1 -> + case happyOut30 happy_x_3 of { happy_var_3 -> + happyIn31 + (annotate2 happy_var_1 happy_var_3 (MathsBinaryOp Minus happy_var_1 happy_var_3) + )}} + +happyReduce_74 = happySpecReduce_3 25# happyReduction_74 +happyReduction_74 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut30 happy_x_1 of { happy_var_1 -> + case happyOut30 happy_x_3 of { happy_var_3 -> + happyIn31 + (annotate2 happy_var_1 happy_var_3 (MathsBinaryOp Mod happy_var_1 happy_var_3) + )}} + +happyReduce_75 = happySpecReduce_3 25# happyReduction_75 +happyReduction_75 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut30 happy_x_1 of { happy_var_1 -> + case happyOut30 happy_x_3 of { happy_var_3 -> + happyIn31 + (annotate2 happy_var_1 happy_var_3 (MathsBinaryOp Divide happy_var_1 happy_var_3) + )}} + +happyReduce_76 = happySpecReduce_3 25# happyReduction_76 +happyReduction_76 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut30 happy_x_1 of { happy_var_1 -> + case happyOut30 happy_x_3 of { happy_var_3 -> + happyIn31 + (annotate2 happy_var_1 happy_var_3 (MathsBinaryOp Times happy_var_1 happy_var_3) + )}} + +happyReduce_77 = happySpecReduce_1 25# happyReduction_77 +happyReduction_77 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn31 + (annotate happy_var_1 (List []) + )} + +happyReduce_78 = happySpecReduce_3 25# happyReduction_78 +happyReduction_78 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut27 happy_x_1 of { happy_var_1 -> + case happyOut43 happy_x_2 of { happy_var_2 -> + case happyOut28 happy_x_3 of { happy_var_3 -> + happyIn31 + (annotate2 happy_var_1 happy_var_3 (List happy_var_2) + )}}} + +happyReduce_79 = happyReduce 5# 25# happyReduction_79 +happyReduction_79 (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 happyOut43 happy_x_2 of { happy_var_2 -> + case happyOut47 happy_x_4 of { happy_var_4 -> + case happyOut28 happy_x_5 of { happy_var_5 -> + happyIn31 + (annotate2 happy_var_1 happy_var_5 (ListComp happy_var_2 happy_var_4) + ) `HappyStk` happyRest}}}} + +happyReduce_80 = happyReduce 4# 25# happyReduction_80 +happyReduction_80 (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 happyOut30 happy_x_2 of { happy_var_2 -> + case happyOut28 happy_x_4 of { happy_var_4 -> + happyIn31 + (annotate2 happy_var_1 happy_var_4 (ListEnumFrom happy_var_2) + ) `HappyStk` happyRest}}} + +happyReduce_81 = happyReduce 5# 25# happyReduction_81 +happyReduction_81 (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 happyOut30 happy_x_2 of { happy_var_2 -> + case happyOut30 happy_x_4 of { happy_var_4 -> + case happyOut28 happy_x_5 of { happy_var_5 -> + happyIn31 + (annotate2 happy_var_1 happy_var_5 (ListEnumFromTo happy_var_2 happy_var_4) + ) `HappyStk` happyRest}}}} + +happyReduce_82 = happySpecReduce_3 25# happyReduction_82 +happyReduction_82 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut30 happy_x_1 of { happy_var_1 -> + case happyOut30 happy_x_3 of { happy_var_3 -> + happyIn31 + (annotate2 happy_var_1 happy_var_3 (Concat happy_var_1 happy_var_3) + )}} + +happyReduce_83 = happySpecReduce_2 25# happyReduction_83 +happyReduction_83 happy_x_2 + happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut30 happy_x_2 of { happy_var_2 -> + happyIn31 + (annotate2 happy_var_1 happy_var_2 (ListLength happy_var_2) + )}} + +happyReduce_84 = happySpecReduce_3 25# happyReduction_84 +happyReduction_84 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut43 happy_x_2 of { happy_var_2 -> + case happyOutTok happy_x_3 of { happy_var_3 -> + happyIn31 + (annotate2 happy_var_1 happy_var_3 (Set happy_var_2) + )}}} + +happyReduce_85 = happyReduce 5# 25# happyReduction_85 +happyReduction_85 (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 { happy_var_1 -> + case happyOut43 happy_x_2 of { happy_var_2 -> + case happyOut47 happy_x_4 of { happy_var_4 -> + case happyOutTok happy_x_5 of { happy_var_5 -> + happyIn31 + (annotate2 happy_var_1 happy_var_5 (SetComp happy_var_2 happy_var_4) + ) `HappyStk` happyRest}}}} + +happyReduce_86 = happyReduce 4# 25# happyReduction_86 +happyReduction_86 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut30 happy_x_2 of { happy_var_2 -> + case happyOutTok happy_x_4 of { happy_var_4 -> + happyIn31 + (annotate2 happy_var_1 happy_var_4 (SetEnumFrom happy_var_2) + ) `HappyStk` happyRest}}} + +happyReduce_87 = happyReduce 5# 25# 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 happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut30 happy_x_2 of { happy_var_2 -> + case happyOut30 happy_x_4 of { happy_var_4 -> + case happyOutTok happy_x_5 of { happy_var_5 -> + happyIn31 + (annotate2 happy_var_1 happy_var_5 (SetEnumFromTo happy_var_2 happy_var_4) + ) `HappyStk` happyRest}}}} + +happyReduce_88 = happySpecReduce_3 25# happyReduction_88 +happyReduction_88 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut43 happy_x_2 of { happy_var_2 -> + case happyOutTok happy_x_3 of { happy_var_3 -> + happyIn31 + (annotate2 happy_var_1 happy_var_3 (SetEnum happy_var_2) + )}}} + +happyReduce_89 = happyReduce 5# 25# happyReduction_89 +happyReduction_89 (happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut43 happy_x_2 of { happy_var_2 -> + case happyOut47 happy_x_4 of { happy_var_4 -> + case happyOutTok happy_x_5 of { happy_var_5 -> + happyIn31 + (annotate2 happy_var_1 happy_var_5 (SetEnumComp happy_var_2 happy_var_4) + ) `HappyStk` happyRest}}}} + +happyReduce_90 = happySpecReduce_1 25# happyReduction_90 +happyReduction_90 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn31 + (liftLoc happy_var_1 (ExpPatWildCard) + )} + +happyReduce_91 = happySpecReduce_3 25# happyReduction_91 +happyReduction_91 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut30 happy_x_1 of { happy_var_1 -> + case happyOut30 happy_x_3 of { happy_var_3 -> + happyIn31 + (liftLoc happy_var_1 (ExpPatDoublePattern happy_var_1 happy_var_3) + )}} + +happyReduce_92 = happyReduce 4# 25# happyReduction_92 +happyReduction_92 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut30 happy_x_1 of { happy_var_1 -> + case happyOut39 happy_x_2 of { happy_var_2 -> + case happyOut30 happy_x_4 of { happy_var_4 -> + happyIn31 + (annotate2 happy_var_1 happy_var_4 (Prefix happy_var_1 happy_var_2 happy_var_4) + ) `HappyStk` happyRest}}} + +happyReduce_93 = happySpecReduce_3 25# happyReduction_93 +happyReduction_93 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut30 happy_x_1 of { happy_var_1 -> + case happyOut30 happy_x_3 of { happy_var_3 -> + happyIn31 + (annotate2 happy_var_1 happy_var_3 (Prefix happy_var_1 [] happy_var_3) + )}} + +happyReduce_94 = happySpecReduce_3 25# happyReduction_94 +happyReduction_94 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut30 happy_x_1 of { happy_var_1 -> + case happyOut30 happy_x_3 of { happy_var_3 -> + happyIn31 + (annotate2 happy_var_1 happy_var_3 (ExternalChoice happy_var_1 happy_var_3) + )}} + +happyReduce_95 = happySpecReduce_3 25# happyReduction_95 +happyReduction_95 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut30 happy_x_1 of { happy_var_1 -> + case happyOut30 happy_x_3 of { happy_var_3 -> + happyIn31 + (annotate2 happy_var_1 happy_var_3 (Hiding happy_var_1 happy_var_3) + )}} + +happyReduce_96 = happySpecReduce_3 25# happyReduction_96 +happyReduction_96 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut30 happy_x_1 of { happy_var_1 -> + case happyOut30 happy_x_3 of { happy_var_3 -> + happyIn31 + (annotate2 happy_var_1 happy_var_3 (InternalChoice happy_var_1 happy_var_3) + )}} + +happyReduce_97 = happySpecReduce_3 25# happyReduction_97 +happyReduction_97 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut30 happy_x_1 of { happy_var_1 -> + case happyOut30 happy_x_3 of { happy_var_3 -> + happyIn31 + (annotate2 happy_var_1 happy_var_3 (Interleave happy_var_1 happy_var_3) + )}} + +happyReduce_98 = happyReduce 5# 25# happyReduction_98 +happyReduction_98 (happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut30 happy_x_1 of { happy_var_1 -> + case happyOut30 happy_x_3 of { happy_var_3 -> + case happyOut30 happy_x_5 of { happy_var_5 -> + happyIn31 + (annotate2 happy_var_1 happy_var_5 (GenParallel happy_var_1 happy_var_3 happy_var_5) + ) `HappyStk` happyRest}}} + +happyReduce_99 = happyReduce 7# 25# happyReduction_99 +happyReduction_99 (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 happyOut30 happy_x_1 of { happy_var_1 -> + case happyOut30 happy_x_3 of { happy_var_3 -> + case happyOut30 happy_x_5 of { happy_var_5 -> + case happyOut30 happy_x_7 of { happy_var_7 -> + happyIn31 + (annotate2 happy_var_1 happy_var_7 (AlphaParallel happy_var_1 happy_var_3 happy_var_5 happy_var_7) + ) `HappyStk` happyRest}}}} + +happyReduce_100 = happySpecReduce_3 25# happyReduction_100 +happyReduction_100 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut30 happy_x_1 of { happy_var_1 -> + case happyOut30 happy_x_3 of { happy_var_3 -> + happyIn31 + (annotate2 happy_var_1 happy_var_3 (Interrupt happy_var_1 happy_var_3) + )}} + +happyReduce_101 = happyReduce 5# 25# happyReduction_101 +happyReduction_101 (happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut30 happy_x_1 of { happy_var_1 -> + case happyOut30 happy_x_3 of { happy_var_3 -> + case happyOut30 happy_x_5 of { happy_var_5 -> + happyIn31 + (annotate2 happy_var_1 happy_var_5 (Exception happy_var_1 happy_var_3 happy_var_5) + ) `HappyStk` happyRest}}} + +happyReduce_102 = happySpecReduce_3 25# happyReduction_102 +happyReduction_102 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut30 happy_x_1 of { happy_var_1 -> + case happyOut30 happy_x_3 of { happy_var_3 -> + happyIn31 + (annotate2 happy_var_1 happy_var_3 (SlidingChoice happy_var_1 happy_var_3) + )}} + +happyReduce_103 = happySpecReduce_3 25# happyReduction_103 +happyReduction_103 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut30 happy_x_1 of { happy_var_1 -> + case happyOut30 happy_x_3 of { happy_var_3 -> + happyIn31 + (annotate2 happy_var_1 happy_var_3 (SequentialComp happy_var_1 happy_var_3) + )}} + +happyReduce_104 = happySpecReduce_3 25# happyReduction_104 +happyReduction_104 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut30 happy_x_1 of { happy_var_1 -> + case happyOut30 happy_x_3 of { happy_var_3 -> + happyIn31 + (annotate2 happy_var_1 happy_var_3 (GuardedExp happy_var_1 happy_var_3) + )}} + +happyReduce_105 = happyReduce 5# 25# happyReduction_105 +happyReduction_105 (happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut30 happy_x_1 of { happy_var_1 -> + case happyOut34 happy_x_3 of { happy_var_3 -> + case happyOut45 happy_x_4 of { happy_var_4 -> + case happyOutTok happy_x_5 of { happy_var_5 -> + happyIn31 + (annotate2 happy_var_1 happy_var_5 (Rename happy_var_1 happy_var_3 happy_var_4) + ) `HappyStk` happyRest}}}} + +happyReduce_106 = happyReduce 6# 25# happyReduction_106 +happyReduction_106 (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 happyOut30 happy_x_1 of { happy_var_1 -> + case happyOut37 happy_x_3 of { happy_var_3 -> + case happyOut45 happy_x_4 of { happy_var_4 -> + case happyOut30 happy_x_6 of { happy_var_6 -> + happyIn31 + (annotate2 happy_var_1 happy_var_6 (LinkParallel happy_var_1 happy_var_3 happy_var_4 happy_var_6) + ) `HappyStk` happyRest}}}} + +happyReduce_107 = happyReduce 4# 25# happyReduction_107 +happyReduction_107 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut47 happy_x_2 of { happy_var_2 -> + case happyOut30 happy_x_4 of { happy_var_4 -> + happyIn31 + (annotate2 happy_var_1 happy_var_4 (ReplicatedInterleave happy_var_2 happy_var_4) + ) `HappyStk` happyRest}}} + +happyReduce_108 = happyReduce 4# 25# happyReduction_108 +happyReduction_108 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut47 happy_x_2 of { happy_var_2 -> + case happyOut30 happy_x_4 of { happy_var_4 -> + happyIn31 + (annotate2 happy_var_1 happy_var_4 (ReplicatedExternalChoice happy_var_2 happy_var_4) + ) `HappyStk` happyRest}}} + +happyReduce_109 = happyReduce 4# 25# happyReduction_109 +happyReduction_109 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut47 happy_x_2 of { happy_var_2 -> + case happyOut30 happy_x_4 of { happy_var_4 -> + happyIn31 + (annotate2 happy_var_1 happy_var_4 (ReplicatedInternalChoice happy_var_2 happy_var_4) + ) `HappyStk` happyRest}}} + +happyReduce_110 = happyReduce 7# 25# happyReduction_110 +happyReduction_110 (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_1 of { happy_var_1 -> + case happyOut47 happy_x_2 of { happy_var_2 -> + case happyOut30 happy_x_5 of { happy_var_5 -> + case happyOut30 happy_x_7 of { happy_var_7 -> + happyIn31 + (annotate2 happy_var_1 happy_var_7 (ReplicatedAlphaParallel happy_var_2 happy_var_5 happy_var_7) + ) `HappyStk` happyRest}}}} + +happyReduce_111 = happyReduce 6# 25# happyReduction_111 +happyReduction_111 (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_1 of { happy_var_1 -> + case happyOut30 happy_x_2 of { happy_var_2 -> + case happyOut47 happy_x_4 of { happy_var_4 -> + case happyOut30 happy_x_6 of { happy_var_6 -> + happyIn31 + (annotate2 happy_var_1 happy_var_6 (ReplicatedParallel happy_var_2 happy_var_4 happy_var_6) + ) `HappyStk` happyRest}}}} + +happyReduce_112 = happyReduce 7# 25# happyReduction_112 +happyReduction_112 (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_1 of { happy_var_1 -> + case happyOut37 happy_x_2 of { happy_var_2 -> + case happyOut45 happy_x_3 of { happy_var_3 -> + case happyOut47 happy_x_5 of { happy_var_5 -> + case happyOut30 happy_x_7 of { happy_var_7 -> + happyIn31 + (annotate2 happy_var_1 happy_var_7 (ReplicatedLinkParallel happy_var_2 happy_var_3 happy_var_5 happy_var_7) + ) `HappyStk` happyRest}}}}} + +happyReduce_113 = happySpecReduce_2 26# happyReduction_113 +happyReduction_113 happy_x_2 + happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut30 happy_x_2 of { happy_var_2 -> + happyIn32 + (annotate2 happy_var_1 happy_var_2 (Input (convPat happy_var_2) Nothing) + )}} + +happyReduce_114 = happyReduce 4# 26# happyReduction_114 +happyReduction_114 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut30 happy_x_2 of { happy_var_2 -> + case happyOut30 happy_x_4 of { happy_var_4 -> + happyIn32 + (annotate2 happy_var_1 happy_var_4 (Input (convPat happy_var_2) (Just (checkExp happy_var_4))) + ) `HappyStk` happyRest}}} + +happyReduce_115 = happySpecReduce_2 26# happyReduction_115 +happyReduction_115 happy_x_2 + happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut30 happy_x_2 of { happy_var_2 -> + happyIn32 + (annotate2 happy_var_1 happy_var_2 (NonDetInput (convPat happy_var_2) Nothing) + )}} + +happyReduce_116 = happyReduce 4# 26# happyReduction_116 +happyReduction_116 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut30 happy_x_2 of { happy_var_2 -> + case happyOut30 happy_x_4 of { happy_var_4 -> + happyIn32 + (annotate2 happy_var_1 happy_var_4 (NonDetInput (convPat happy_var_2) (Just (checkExp happy_var_4))) + ) `HappyStk` happyRest}}} + +happyReduce_117 = happySpecReduce_2 26# happyReduction_117 +happyReduction_117 happy_x_2 + happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut30 happy_x_2 of { happy_var_2 -> + happyIn32 + (annotate2 happy_var_1 happy_var_2 (Output (checkExp happy_var_2)) + )}} + +happyReduce_118 = happySpecReduce_3 27# happyReduction_118 +happyReduction_118 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut29 happy_x_1 of { happy_var_1 -> + case happyOut29 happy_x_3 of { happy_var_3 -> + happyIn33 + ((happy_var_1, happy_var_3) + )}} + +happyReduce_119 = happySpecReduce_1 28# happyReduction_119 +happyReduction_119 happy_x_1 + = case happyOut35 happy_x_1 of { happy_var_1 -> + happyIn34 + (reverse happy_var_1 + )} + +happyReduce_120 = happySpecReduce_1 29# happyReduction_120 +happyReduction_120 happy_x_1 + = case happyOut33 happy_x_1 of { happy_var_1 -> + happyIn35 + ([happy_var_1] + )} + +happyReduce_121 = happySpecReduce_3 29# happyReduction_121 +happyReduction_121 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut35 happy_x_1 of { happy_var_1 -> + case happyOut33 happy_x_3 of { happy_var_3 -> + happyIn35 + (happy_var_3:happy_var_1 + )}} + +happyReduce_122 = happySpecReduce_3 30# happyReduction_122 +happyReduction_122 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut29 happy_x_1 of { happy_var_1 -> + case happyOut29 happy_x_3 of { happy_var_3 -> + happyIn36 + ((happy_var_1, happy_var_3) + )}} + +happyReduce_123 = happySpecReduce_1 31# happyReduction_123 +happyReduction_123 happy_x_1 + = case happyOut38 happy_x_1 of { happy_var_1 -> + happyIn37 + (reverse happy_var_1 + )} + +happyReduce_124 = happySpecReduce_1 32# happyReduction_124 +happyReduction_124 happy_x_1 + = case happyOut36 happy_x_1 of { happy_var_1 -> + happyIn38 + ([happy_var_1] + )} + +happyReduce_125 = happySpecReduce_3 32# happyReduction_125 +happyReduction_125 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut38 happy_x_1 of { happy_var_1 -> + case happyOut36 happy_x_3 of { happy_var_3 -> + happyIn38 + (happy_var_3:happy_var_1 + )}} + +happyReduce_126 = happySpecReduce_1 33# happyReduction_126 +happyReduction_126 happy_x_1 + = case happyOut40 happy_x_1 of { happy_var_1 -> + happyIn39 + (reverse happy_var_1 + )} + +happyReduce_127 = happySpecReduce_1 34# happyReduction_127 +happyReduction_127 happy_x_1 + = case happyOut32 happy_x_1 of { happy_var_1 -> + happyIn40 + ([happy_var_1] + )} + +happyReduce_128 = happySpecReduce_2 34# happyReduction_128 +happyReduction_128 happy_x_2 + happy_x_1 + = case happyOut40 happy_x_1 of { happy_var_1 -> + case happyOut32 happy_x_2 of { happy_var_2 -> + happyIn40 + (happy_var_2:happy_var_1 + )}} + +happyReduce_129 = happySpecReduce_3 35# happyReduction_129 +happyReduction_129 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut30 happy_x_1 of { happy_var_1 -> + case happyOut44 happy_x_3 of { happy_var_3 -> + happyIn41 + (happy_var_1:(reverse happy_var_3) + )}} + +happyReduce_130 = happySpecReduce_1 36# happyReduction_130 +happyReduction_130 happy_x_1 + = case happyOut44 happy_x_1 of { happy_var_1 -> + happyIn42 + (reverse happy_var_1 + )} + +happyReduce_131 = happySpecReduce_0 37# happyReduction_131 +happyReduction_131 = happyIn43 + ([] + ) + +happyReduce_132 = happySpecReduce_1 37# happyReduction_132 +happyReduction_132 happy_x_1 + = case happyOut44 happy_x_1 of { happy_var_1 -> + happyIn43 + (reverse happy_var_1 + )} + +happyReduce_133 = happySpecReduce_3 38# happyReduction_133 +happyReduction_133 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut44 happy_x_1 of { happy_var_1 -> + case happyOut30 happy_x_3 of { happy_var_3 -> + happyIn44 + (happy_var_3:happy_var_1 + )}} + +happyReduce_134 = happySpecReduce_1 38# happyReduction_134 +happyReduction_134 happy_x_1 + = case happyOut30 happy_x_1 of { happy_var_1 -> + happyIn44 + ([happy_var_1] + )} + +happyReduce_135 = happySpecReduce_0 39# happyReduction_135 +happyReduction_135 = happyIn45 + ([] + ) + +happyReduce_136 = happySpecReduce_2 39# happyReduction_136 +happyReduction_136 happy_x_2 + happy_x_1 + = case happyOut47 happy_x_2 of { happy_var_2 -> + happyIn45 + (happy_var_2 + )} + +happyReduce_137 = happySpecReduce_3 40# happyReduction_137 +happyReduction_137 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut26 happy_x_1 of { happy_var_1 -> + case happyOut30 happy_x_3 of { happy_var_3 -> + happyIn46 + (annotate2 happy_var_1 happy_var_3 (Generator happy_var_1 happy_var_3) + )}} + +happyReduce_138 = happySpecReduce_3 40# happyReduction_138 +happyReduction_138 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut26 happy_x_1 of { happy_var_1 -> + case happyOut30 happy_x_3 of { happy_var_3 -> + happyIn46 + (annotate2 happy_var_1 happy_var_3 (Generator happy_var_1 happy_var_3) + )}} + +happyReduce_139 = happySpecReduce_1 40# happyReduction_139 +happyReduction_139 happy_x_1 + = case happyOut30 happy_x_1 of { happy_var_1 -> + happyIn46 + (annotate happy_var_1 (Qualifier happy_var_1) + )} + +happyReduce_140 = happySpecReduce_1 41# happyReduction_140 +happyReduction_140 happy_x_1 + = case happyOut48 happy_x_1 of { happy_var_1 -> + happyIn47 + (reverse happy_var_1 + )} + +happyReduce_141 = happySpecReduce_3 42# happyReduction_141 +happyReduction_141 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut48 happy_x_1 of { happy_var_1 -> + case happyOut46 happy_x_3 of { happy_var_3 -> + happyIn48 + (happy_var_3:happy_var_1 + )}} + +happyReduce_142 = happySpecReduce_1 42# happyReduction_142 +happyReduction_142 happy_x_1 + = case happyOut46 happy_x_1 of { happy_var_1 -> + happyIn48 + ([happy_var_1] + )} + +happyNewToken action sts stk + = getNextTokenWrapper(\tk -> + let cont i = happyDoAction i tk action sts stk in + case tk of { + L _ TEOF -> happyDoAction 79# tk action sts stk; + L _ (TInteger _) -> cont 1#; + L _ (TIdent _) -> cont 2#; + L _ TNewLine -> cont 3#; + L _ TFalse -> cont 4#; + L _ TTrue -> cont 5#; + L _ TDefineEqual -> cont 6#; + L _ TComma -> cont 7#; + L _ TDot -> cont 8#; + L _ TQuestionMark -> cont 9#; + L _ TDollar -> cont 10#; + L _ TExclamationMark -> cont 11#; + L _ TDoubleDot -> cont 12#; + L _ TColon -> cont 13#; + L _ TDrawnFrom -> cont 14#; + L _ TTie -> cont 15#; + L _ TPipe -> cont 16#; + L _ TDoubleAt -> cont 17#; + L _ TWildCard -> cont 18#; + L _ TIf -> cont 19#; + L _ TThen -> cont 20#; + L _ TElse -> cont 21#; + L _ TLet -> cont 22#; + L _ TWithin -> cont 23#; + L _ TBackSlash -> cont 24#; + L _ TLambdaDot -> cont 25#; + L _ TChannel -> cont 26#; + L _ TDataType -> cont 27#; + L _ TExternal -> cont 28#; + L _ TTransparent -> cont 29#; + L _ TNameType -> cont 30#; + L _ TAssert -> cont 31#; + L _ TDeadlockFree -> cont 32#; + L _ TLivelockFree -> cont 33#; + L _ TDivergenceFree -> cont 34#; + L _ TDeterministic -> cont 35#; + L _ TTauPriority -> cont 36#; + L _ (TRefines _) -> cont 37#; + L _ (TModel _) -> cont 38#; + L _ TNot -> cont 39#; + L _ TAnd -> cont 40#; + L _ TOr -> cont 41#; + L _ TEq -> cont 42#; + L _ TNotEq -> cont 43#; + L _ TLtEq -> cont 44#; + L _ TGtEq -> cont 45#; + L _ TEmptySeq -> cont 46#; + L _ TLt -> cont 47#; + L _ TGt -> cont 48#; + L _ TCloseSeq -> cont 49#; + L _ TPlus -> cont 50#; + L _ TMinus -> cont 51#; + L _ TTimes -> cont 52#; + L _ TDivide -> cont 53#; + L _ TMod -> cont 54#; + L _ TConcat -> cont 55#; + L _ THash -> cont 56#; + L _ TLParen -> cont 57#; + L _ TRParen -> cont 58#; + L _ TLBrace -> cont 59#; + L _ TRBrace -> cont 60#; + L _ TLPipeBrace -> cont 61#; + L _ TRPipeBrace -> cont 62#; + L _ TLDoubleSqBracket -> cont 63#; + L _ TRDoubleSqBracket -> cont 64#; + L _ TLPipeSqBracket -> cont 65#; + L _ TRPipeSqBracket -> cont 66#; + L _ TLSqBracket -> cont 67#; + L _ TRSqBracket -> cont 68#; + L _ TExtChoice -> cont 69#; + L _ TIntChoice -> cont 70#; + L _ TInterleave -> cont 71#; + L _ TPrefix -> cont 72#; + L _ TInterrupt -> cont 73#; + L _ TSlidingChoice -> cont 74#; + L _ TRException -> cont 75#; + L _ TParallel -> cont 76#; + L _ TSemiColon -> cont 77#; + L _ TGuard -> cont 78#; + _ -> happyError' tk + }) + +happyError_ tk = happyError' tk + +happyThen :: () => ParseMonad a -> (a -> ParseMonad b) -> ParseMonad b +happyThen = (>>=) +happyReturn :: () => a -> ParseMonad a +happyReturn = (return) +happyThen1 = happyThen +happyReturn1 :: () => a -> ParseMonad a +happyReturn1 = happyReturn +happyError' :: () => (LToken) -> ParseMonad a +happyError' tk = parseError tk + +parseFile_ = happySomeParser where + happySomeParser = happyThen (happyParse 0#) (\x -> happyReturn (happyOut6 x)) + +parseInteractiveStmt_ = happySomeParser where + happySomeParser = happyThen (happyParse 1#) (\x -> happyReturn (happyOut7 x)) + +parseExpression_ = happySomeParser where + happySomeParser = happyThen (happyParse 2#) (\x -> happyReturn (happyOut30 x)) + +happySeq = happyDontSeq + + +combineDecls :: [PDecl] -> [PDecl] +combineDecls [] = [] +combineDecls ((An loc1 b (FunBind n ms)):(An loc2 c (FunBind n' ms')):ds) | n == n' = + combineDecls $ (An (combineSpans loc1 loc2) b (FunBind n (ms++ms'))):ds +combineDecls (d:ds) = d:combineDecls ds + +convDecl :: PExp -> PExp -> ParseMonad PDecl +convDecl (lhs @ (An loc1 b lhsexp)) (rhs @ (An loc2 d _)) = + let + span = combineSpans loc1 loc2 + + -- REMEMBER: needs to reverse pts + getPats :: Exp UnRenamedName -> ([[PPat]], UnRenamedName) + getPats (App f args) = + ((map convPat args):ps, n) + where + (ps, n) = getPats (unAnnotate f) + getPats (Var n) = ([], n) + + convFunBind exp = + FunBind n [An span (dummyAnnotation) (Match (reverse ps) rhs)] + where + (ps, n) = getPats exp + + convPatBind exp = PatBind (convPat exp) rhs + in do + symbTable <- freshPSymbolTable + case lhsexp of + App f args -> return $ An span (Nothing, symbTable) (convFunBind lhsexp) + _ -> return $ An span (Nothing, symbTable) (convPatBind lhs) + +-- | Throws an error if a declaration that is not allowed inside a let +-- expression is found. +checkLetDecls :: [PDecl] -> [PDecl] +checkLetDecls decls = map checkDecl decls + where + checkDecl :: PDecl -> PDecl + checkDecl (anDecl@(An _ _ decl)) = + let + check (FunBind a b) = anDecl + check (PatBind a b) = anDecl + check _ = throwSourceError [invalidDeclarationErrorMessage anDecl] + in check decl + +checkExp :: PExp -> PExp +checkExp (anExp@(An a b exp)) = + let + check :: Exp UnRenamedName -> Exp UnRenamedName + check (App e es) = App (checkExp e) (map checkExp es) + check (BooleanBinaryOp op e1 e2) = BooleanBinaryOp op (checkExp e1) (checkExp e2) + check (BooleanUnaryOp op e) = BooleanUnaryOp op (checkExp e) + check (Concat e1 e2) = Concat (checkExp e1) (checkExp e2) + check (DotApp e1 e2) = DotApp (checkExp e1) (checkExp e2) + check (If e1 e2 e3) = If (checkExp e1) (checkExp e2) (checkExp e3) + check (Lambda p e) = Lambda p (checkExp e) + check (Let decls e) = Let decls (checkExp e) + check (Lit lit) = Lit lit + check (List es) = List (map checkExp es) + check (ListComp es stmts) = ListComp (map checkExp es) stmts + check (ListEnumFrom e) = ListEnumFrom (checkExp e) + check (ListEnumFromTo e1 e2) = ListEnumFromTo (checkExp e1) (checkExp e2) + check (ListLength e) = ListLength (checkExp e) + check (MathsBinaryOp op e1 e2) = MathsBinaryOp op (checkExp e1) (checkExp e2) + check (MathsUnaryOp op e) = MathsUnaryOp op (checkExp e) + check (Paren e) = Paren (checkExp e) + check (Set es) = Set (map checkExp es) + check (SetComp es stmts) = SetComp (map checkExp es) stmts + check (SetEnumFrom e) = SetEnumFrom (checkExp e) + check (SetEnumFromTo e1 e2) = SetEnumFromTo (checkExp e1) (checkExp e2) + check (SetEnum es) = SetEnum (map checkExp es) + -- We don't need to check inside stmts as they will have been checked + -- upon creation + check (SetEnumComp es stmts) = SetEnumComp (map checkExp es) stmts + check (Tuple es) = Tuple (map checkExp es) + check (Var qname) = Var qname + + check (AlphaParallel e1 e2 e3 e4) = + AlphaParallel (checkExp e1) (checkExp e2) (checkExp e3) (checkExp e4) + check (Exception e1 e2 e3) = Exception (checkExp e1) (checkExp e2) (checkExp e3) + check (ExternalChoice e1 e2) = ExternalChoice (checkExp e1) (checkExp e2) + check (GenParallel e1 e2 e3) = GenParallel (checkExp e1) (checkExp e2) (checkExp e3) + check (GuardedExp e1 e2) = GuardedExp (checkExp e1) (checkExp e2) + check (Hiding e1 e2) = Hiding (checkExp e1) (checkExp e2) + check (InternalChoice e1 e2) = InternalChoice (checkExp e1) (checkExp e2) + check (Interrupt e1 e2) = Interrupt (checkExp e1) (checkExp e2) + check (Interleave e1 e2) = Interleave (checkExp e1) (checkExp e2) + check (LinkParallel e1 ties stmts e2) = + LinkParallel (checkExp e1) ties stmts (checkExp e2) + check (Prefix e1 fields e2) = Prefix (checkExp e1) fields (checkExp e2) + check (Rename e ties stmts) = Rename (checkExp e) ties stmts + check (SequentialComp e1 e2) = SequentialComp (checkExp e1) (checkExp e2) + check (SlidingChoice e1 e2) = SlidingChoice (checkExp e1) (checkExp e2) + + check (ReplicatedAlphaParallel stmts e1 e2) = + ReplicatedAlphaParallel stmts (checkExp e1) (checkExp e2) + check (ReplicatedInterleave stmts e1) = ReplicatedInterleave stmts (checkExp e1) + check (ReplicatedExternalChoice stmts e1) = ReplicatedExternalChoice stmts (checkExp e1) + check (ReplicatedInternalChoice stmts e1) = ReplicatedInternalChoice stmts (checkExp e1) + check (ReplicatedParallel e1 stmts e2) = + ReplicatedParallel (checkExp e1) stmts (checkExp e2) + check (ReplicatedLinkParallel ties tiesStmts stmts e) = + ReplicatedLinkParallel ties tiesStmts stmts (checkExp e) + + check x = throwSourceError [invalidExpressionErrorMessage anExp] + in + An a b (check exp) + +dotAppToList :: PExp -> [PExp] +dotAppToList (An a b exp) = + let + list :: Exp UnRenamedName -> [PExp] + list (DotApp e1 e2) = (dotAppToList e1) ++ (dotAppToList e2) + list x = [An a b x] + in + list exp + +convPat :: PExp -> PPat +convPat (anExp@ (An a b exp)) = + let + trans :: Exp UnRenamedName -> Pat UnRenamedName + trans (Concat e1 e2) = PConcat (convPat e1) (convPat e2) + trans (DotApp e1 e2) = PDotApp (convPat e1) (convPat e2) + trans (List xs) = PList (map convPat xs) + trans (Lit x) = PLit x + trans (Set xs) = PSet (map convPat xs) + trans (Paren x) = PParen (convPat x) + trans (Tuple xs) = PTuple (map convPat xs) + trans (Var x) = PVar x + trans (ExpPatWildCard) = PWildCard + trans (ExpPatDoublePattern e1 e2) = + PDoublePattern (convPat e1) (convPat e2) + trans x = throwSourceError [invalidPatternErrorMessage anExp] + in + An a () (trans exp) + +-- Helper function to get the contents of tokens +getInt (L _ (TInteger x)) = x +getName (L _ (TIdent x)) = x +getRefinesModel (L _ (TRefines x)) = x +getPropModel (L _ (TModel x)) = x + +class Locatable a where + getLoc :: a b -> SrcSpan + unLoc :: a b -> b + mkLoc :: SrcSpan -> b -> a b + +instance Locatable Located where + getLoc (L loc _) = loc + unLoc (L _ b) = b + mkLoc loc b = L loc b + +instance Locatable (Annotated a) where + getLoc (An loc _ _) = loc + unLoc (An _ _ b) = b + mkLoc loc b = An loc dummyAnnotation b + +annotate :: (Locatable t1, Locatable t2) => t1 a -> b -> t2 b +annotate t1 b = mkLoc (getLoc t1) b + +annotate2 :: + (Locatable t1, Locatable t2, Locatable t3) => t1 a -> t2 b -> c -> t3 c +annotate2 t1 t2 b = mkLoc (combineSpans (getLoc t1) (getLoc t2)) b +annotate2List :: + (Locatable t1, Locatable t2, Locatable t3) => t1 a -> [t2 b] -> c -> t3 c +annotate2List t1 t2 b = annotate2 t1 (last t2) b +annotate2List' :: + (Locatable t1, Locatable t2, Locatable t3) => [t1 a] -> t2 b -> c -> t3 c +annotate2List' t1 t2 b = annotate2 (last t1) t2 b + +annotateWithSymbolTable + :: Annotated (Maybe SymbolTable, PSymbolTable) a -> ParseMonad (Annotated (Maybe SymbolTable, PSymbolTable) a) +annotateWithSymbolTable (An l _ a) = do + symbTable <- freshPSymbolTable + return $ An l (Nothing, symbTable) a liftLoc :: (Locatable t1, Locatable t2) => t1 a -> b -> t2 b liftLoc t1 b = mkLoc (getLoc t1) b diff --git a/src/CSPM/Prelude.hs b/src/CSPM/Prelude.hs new file mode 100644 --- /dev/null +++ b/src/CSPM/Prelude.hs @@ -0,0 +1,181 @@ +-- | This module contains all the builtin definitions for the input CSPM +-- language. +module CSPM.Prelude ( + BuiltIn(..), + builtins, + transparentFunctionForOccName, + externalFunctionForOccName +) +where + +import System.IO.Unsafe + +import CSPM.DataStructures.Names +import CSPM.DataStructures.Types + +data BuiltIn = + BuiltIn { + name :: Name, + stringName :: String, + isDeprecated :: Bool, + deprecatedReplacement :: Maybe Name, + typeScheme :: TypeScheme, + isTypeUnsafe :: Bool, + isExternal :: Bool, + isTransparent :: Bool + } + +instance Eq BuiltIn where + b1 == b2 = name b1 == name b2 + +builtins :: Bool -> [BuiltIn] +builtins includeHidden = + if includeHidden then allBuiltins + else [b | b <- allBuiltins, not (isExternal b), not (isTransparent b)] + +transparentFunctionForOccName :: OccName -> Maybe BuiltIn +transparentFunctionForOccName (OccName s) = + let bs = [b | b <- allBuiltins, isTransparent b, stringName b == s] in + if bs == [] then Nothing else Just (head bs) + +externalFunctionForOccName :: OccName -> Maybe BuiltIn +externalFunctionForOccName (OccName s) = + let bs = [b | b <- allBuiltins, isExternal b, stringName b == s] in + if bs == [] then Nothing else Just (head bs) + + +allBuiltins :: [BuiltIn] +allBuiltins = unsafePerformIO makeBuiltins + +makeBuiltins :: IO [BuiltIn] --Type -> (String, [Type], Type)] +makeBuiltins = + let + cspm_union fv = ("union", [TSet fv, TSet fv], TSet fv) + cspm_inter fv = ("inter", [TSet fv, TSet fv], TSet fv) + cspm_diff fv = ("diff", [TSet fv, TSet fv], TSet fv) + cspm_Union fv = ("Union", [TSet (TSet fv)], TSet fv) + cspm_Inter fv = ("Inter", [TSet (TSet fv)], TSet fv) + cspm_member fv = ("member", [fv, TSet fv], TBool) + cspm_card fv = ("card", [TSet fv], TInt) + cspm_empty fv = ("empty", [TSet fv], TBool) + cspm_set fv = ("set", [TSeq fv], TSet fv) + cspm_Set fv = ("Set", [TSet fv], TSet (TSet fv)) + cspm_Seq fv = ("Seq", [TSet fv], TSet (TSeq fv)) + cspm_seq fv = ("seq", [TSet fv], TSeq fv) + + sets = [cspm_union, cspm_inter, cspm_diff, cspm_Union, cspm_Inter, + cspm_member, cspm_card, cspm_empty, cspm_set, cspm_Set, + cspm_Seq, cspm_seq] + + cspm_length fv = ("length", [TSeq fv], TInt) + cspm_null fv = ("null", [TSeq fv], TBool) + cspm_head fv = ("head", [TSeq fv], fv) + cspm_tail fv = ("tail", [TSeq fv], TSeq fv) + cspm_concat fv = ("concat", [TSeq (TSeq fv)], TSeq fv) + cspm_elem fv = ("elem", [fv, TSeq fv], TBool) + + seqs = [cspm_length, cspm_null, cspm_head, cspm_tail, cspm_concat, + cspm_elem] + + cspm_STOP = ("STOP", TProc) + cspm_SKIP = ("SKIP", TProc) + cspm_CHAOS = ("CHAOS", TFunction [TSet TEvent] TProc) + cspm_prioritise = ("prioritise", TFunction [TProc, TSeq (TSet TEvent)] TProc) + + builtInProcs :: [(String, Type)] + builtInProcs = [cspm_STOP, cspm_SKIP, cspm_CHAOS, cspm_prioritise] + + cspm_Int = ("Int", TSet TInt) + cspm_Bool = ("Bool", TSet TBool) + cspm_Proc = ("Proc", TSet TProc) + cspm_Events = ("Events", TSet TEvent) + cspm_true = ("true", TBool) + cspm_false = ("false", TBool) + cspm_True = ("True", TBool) + cspm_False = ("False", TBool) + + typeConstructors :: [(String, Type)] + typeConstructors = [cspm_Int, cspm_Bool, cspm_Proc, cspm_Events, + cspm_true, cspm_false, cspm_True, cspm_False] + + externalFunctions :: [(String, Type)] + externalFunctions = [] + + transparentFunctions :: [(String, Type)] + transparentFunctions = [ + ("diamond", TFunction [TProc] TProc), + ("normal", TFunction [TProc] TProc), + ("sbisim", TFunction [TProc] TProc), + ("tau_loop_factor", TFunction [TProc] TProc), + ("model_compress", TFunction [TProc] TProc), + ("explicate", TFunction [TProc] TProc), + ("wbisim", TFunction [TProc] TProc), + ("chase", TFunction [TProc] TProc) + ] + + externalNames = map fst externalFunctions + transparentNames = map fst transparentFunctions + + mkFuncType cs func = do + fv @ (TVar (TypeVarRef tv _ _)) <- freshTypeVarWithConstraints cs + let (n, args, ret) = func fv + let t = ForAll [(tv, cs)] (TFunction args ret) + return (n, t) + mkUnsafeFuncType n = do + fv1 @ (TVar (TypeVarRef tv1 _ _)) <- freshTypeVarWithConstraints [] + fv2 @ (TVar (TypeVarRef tv2 _ _)) <- freshTypeVarWithConstraints [] + let t = ForAll [(tv1, []), (tv2, [])] (TFunction [fv1] fv2) + return (n, t) + mkPatternType func = do + let (n, t) = func + return (n, ForAll [] t) + + unsafeFunctionNames :: [String] + unsafeFunctionNames = ["productions", "extensions"] + + deprecatedNames :: [String] + deprecatedNames = ["True", "False"] + + replacementForDeprecatedName :: String -> Maybe String + replacementForDeprecatedName "True" = Just "true" + replacementForDeprecatedName "False" = Just "false" + replacementForDeprecatedName _ = Nothing + + makeBuiltIn :: (String, TypeScheme) -> IO BuiltIn + makeBuiltIn (s, ts) = do + n <- mkWiredInName (OccName s) False + return $ BuiltIn { + name = n, + stringName = s, + isDeprecated = s `elem` deprecatedNames, + deprecatedReplacement = Nothing, + typeScheme = ts, + isTypeUnsafe = s `elem` unsafeFunctionNames, + isExternal = s `elem` externalNames, + isTransparent = s `elem` transparentNames + } + + makeReplacements :: [BuiltIn] -> BuiltIn -> IO BuiltIn + makeReplacements bs b | isDeprecated b = + case replacementForDeprecatedName (stringName b) of + Just s' -> + case filter (\b' -> stringName b' == s') bs of + [b'] -> return $ b { deprecatedReplacement = Just (name b') } + [] -> return b + Nothing -> return b + makeReplacements _ b = return b + in do + bs1 <- mapM (mkFuncType []) seqs + bs2 <- mapM (mkFuncType [Eq]) sets + bs3 <- mapM mkPatternType typeConstructors + bs4 <- mapM mkPatternType builtInProcs + bs5 <- mapM mkUnsafeFuncType unsafeFunctionNames + bs6 <- mapM mkPatternType externalFunctions + bs7 <- mapM mkPatternType transparentFunctions + + let bs = bs1++bs2++bs3++bs4++bs5++bs6++bs7 + + bs' <- mapM makeBuiltIn bs + bs'' <- mapM (makeReplacements bs') bs' + + return bs'' diff --git a/src/CSPM/PrettyPrinter.hs b/src/CSPM/PrettyPrinter.hs --- a/src/CSPM/PrettyPrinter.hs +++ b/src/CSPM/PrettyPrinter.hs @@ -4,30 +4,26 @@ ) where +import CSPM.DataStructures.Literals import CSPM.DataStructures.Names import CSPM.DataStructures.Syntax import Util.Annotated import Util.Exception import Util.PrettyPrint - -instance PrettyPrintable Name where - prettyPrint (Name s) = text s -instance PrettyPrintable QualifiedName where - prettyPrint (UnQual name) = prettyPrint name -instance PrettyPrintable [Module] where +instance PrettyPrintable id => PrettyPrintable [Module id] where prettyPrint = vcat . map prettyPrint -instance PrettyPrintable Module where +instance PrettyPrintable id => PrettyPrintable (Module id) where prettyPrint (GlobalModule decls) = vcat (punctuate (char '\n') (map prettyPrint decls)) -instance PrettyPrintable InteractiveStmt where +instance PrettyPrintable id => PrettyPrintable (InteractiveStmt id) where prettyPrint (Evaluate e) = prettyPrint e prettyPrint (Bind decl) = text "let" <+> prettyPrint decl -prettyPrintMatch :: Name -> AnMatch -> Doc +prettyPrintMatch :: PrettyPrintable id => id -> AnMatch id -> Doc prettyPrintMatch n (An _ _ (Match groups exp)) = hang ((prettyPrint n <> hcat (map ppGroup groups)) <+> equals) @@ -35,9 +31,8 @@ where ppGroup ps = parens (list (map prettyPrint ps)) -instance PrettyPrintable Decl where - prettyPrint (FunBind n ms) = - vcat (map (prettyPrintMatch n) ms) +instance PrettyPrintable id => PrettyPrintable (Decl id) where + prettyPrint (FunBind n ms) = vcat (map (prettyPrintMatch n) ms) prettyPrint (PatBind pat exp) = hang (prettyPrint pat <+> equals) tabWidth (prettyPrint exp) @@ -56,7 +51,7 @@ prettyPrint (Assert a) = text "assert" <+> prettyPrint a -instance PrettyPrintable Assertion where +instance PrettyPrintable id => PrettyPrintable (Assertion id) where prettyPrint (Refinement e1 m e2 opts) = hang (hang (prettyPrint e1) tabWidth (char '[' <> prettyPrint m <> char '=' <+> prettyPrint e2)) @@ -67,6 +62,7 @@ prettyPrint (PropertyCheck e1 prop (Just m)) = hang (prettyPrint e1) tabWidth (colon <> brackets (prettyPrint prop <+> brackets (prettyPrint m))) + instance PrettyPrintable Model where prettyPrint Traces = text "T" prettyPrint Failures = text "F" @@ -76,7 +72,7 @@ prettyPrint Revivals = text "V" prettyPrint RevivalsDivergences = text "VD" -instance PrettyPrintable ModelOption where +instance PrettyPrintable id => PrettyPrintable (ModelOption id) where prettyPrint (TauPriority e) = text ":[tau priority over]:" <+> prettyPrint e @@ -85,12 +81,12 @@ prettyPrint Deterministic = text "deterministic" prettyPrint LivelockFreedom = text "divergence free" -instance PrettyPrintable DataTypeClause where +instance PrettyPrintable id => PrettyPrintable (DataTypeClause id) where prettyPrint (DataTypeClause n Nothing) = prettyPrint n prettyPrint (DataTypeClause n (Just e)) = prettyPrint n <> text "." <> prettyPrint e -instance PrettyPrintable Pat where +instance PrettyPrintable id => PrettyPrintable (Pat id) where prettyPrint (PConcat e1 e2) = prettyPrint e1 <+> text "^" <+> prettyPrint e2 prettyPrint (PDotApp e1 e2) = @@ -136,7 +132,7 @@ -- {-1} which would start a block comment prettyPrint Negate = text " -" -instance PrettyPrintable Exp where +instance PrettyPrintable id => PrettyPrintable (Exp id) where prettyPrint (App e1 args) = prettyPrint e1 <> parens (list (map prettyPrint args)) prettyPrint (BooleanBinaryOp op e1 e2) = @@ -225,8 +221,9 @@ ppRepOp (text "|||") stmts (prettyPrint e) prettyPrint (ReplicatedInternalChoice stmts e) = ppRepOp (text "|~|") stmts (prettyPrint e) - prettyPrint (ReplicatedLinkParallel ties stmts e) = - ppRepOp (brackets (list (map ppTie ties))) stmts (prettyPrint e) + prettyPrint (ReplicatedLinkParallel ties tiesStmts stmts e) = + ppRepOp (brackets (ppComp' (map ppTie ties) tiesStmts)) + stmts (prettyPrint e) prettyPrint (ReplicatedParallel alpha stmts e) = ppRepOp (brackets (bars (prettyPrint alpha))) stmts (prettyPrint e) @@ -236,7 +233,7 @@ prettyPrint (ExpPatDoublePattern e1 e2) = prettyPrint e1 <+> text "@@" <+> prettyPrint e2 -instance PrettyPrintable Field where +instance PrettyPrintable id => PrettyPrintable (Field id) where prettyPrint (Output exp) = char '!' <> prettyPrint exp prettyPrint (Input pat Nothing) = @@ -248,36 +245,31 @@ prettyPrint (NonDetInput pat (Just exp)) = char '$' <> prettyPrint pat <+> colon <+> prettyPrint exp -instance PrettyPrintable Stmt where +instance PrettyPrintable id => PrettyPrintable (Stmt id) where prettyPrint (Generator pat exp) = sep [prettyPrint pat, text "<-" <+> prettyPrint exp] prettyPrint (Qualifier exp) = prettyPrint exp -instance PrettyPrintable Literal where - prettyPrint (Int n) = integer n - prettyPrint (Bool True) = text "true" - prettyPrint (Bool False) = text "false" - -ppTie :: (AnExp, AnExp) -> Doc +ppTie :: PrettyPrintable id => (AnExp id, AnExp id) -> Doc ppTie (l, r) = prettyPrint l <+> text "<->" <+> prettyPrint r -ppRename :: (AnExp, AnExp) -> Doc +ppRename :: PrettyPrintable id => (AnExp id, AnExp id) -> Doc ppRename (l, r) = prettyPrint l <+> text "<-" <+> prettyPrint r -ppRepOp :: Doc -> [AnStmt] -> Doc -> Doc +ppRepOp :: PrettyPrintable id => Doc -> [AnStmt id] -> Doc -> Doc ppRepOp op stmts exp = hang op tabWidth ( hang (list (map prettyPrint stmts) <+> char '@') tabWidth exp) -ppComp :: [AnExp] -> [AnStmt] -> Doc +ppComp :: PrettyPrintable id => [AnExp id] -> [AnStmt id] -> Doc ppComp es stmts = ppComp' (map prettyPrint es) stmts -ppComp' :: [Doc] -> [AnStmt] -> Doc +ppComp' :: PrettyPrintable id => [Doc] -> [AnStmt id] -> Doc ppComp' es stmts = hang (list es) tabWidth - (if stmts /= [] then char '|' <+> list (map prettyPrint stmts) + (if length stmts > 0 then char '|' <+> list (map prettyPrint stmts) else empty) ppBinOp :: Doc -> Doc -> Doc -> Doc diff --git a/src/CSPM/Renamer.hs b/src/CSPM/Renamer.hs new file mode 100644 --- /dev/null +++ b/src/CSPM/Renamer.hs @@ -0,0 +1,568 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE TypeSynonymInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE FunctionalDependencies #-} +{-# LANGUAGE UndecidableInstances #-} +-- | Renames all variables to unique Names, in the process converting all +-- UnRenamedName into Name. This simplifies many subsequent phases as every +-- name is guaranteed to be unique so flat maps may be used, rather than +-- Hierarchical maps. Further, this also flags patterns that match channels +-- and datatype clauses. +module CSPM.Renamer ( + RenamerState, + RenamerMonad, + runFromStateToState, + initRenamer, + rename, + newScope, +) where + +import Control.Monad.State +import Data.List + +import CSPM.DataStructures.Names +import CSPM.DataStructures.Syntax +import CSPM.Prelude +import Util.Annotated +import Util.Exception +import qualified Util.HierarchicalMap as HM +import Util.Monad +import Util.PartialFunctions +import Util.PrettyPrint hiding (($$)) + +type RenameEnvironment = HM.HierarchicalMap UnRenamedName Name + +data RenamerState = RenamerState { + environment :: RenameEnvironment + } + +type RenamerMonad = StateT RenamerState IO + +-- | Initialises the renamer. +initRenamer :: IO (RenamerState) +initRenamer = do + let bs = map (\b -> (UnQual (OccName (stringName b)), name b)) (builtins False) + return $ RenamerState { + -- We insert a new layer to allow builtins to be overridden + environment = HM.newLayer (HM.updateMulti HM.new bs) + } + +-- | Runs the renamer starting at the given state and returning the given state. +runFromStateToState :: RenamerState -> RenamerMonad a -> IO (a, RenamerState) +runFromStateToState s p = runStateT p s + +-- ********************** +-- Monad Operations + +addScope :: RenamerMonad a -> RenamerMonad a +addScope m = do + env <- gets environment + let env' = HM.newLayer env + modify (\ st -> st { environment = env' }) + a <- m + modify (\ st -> st { environment = env }) + return a + +newScope :: RenamerMonad () +newScope = do + env <- gets environment + let env' = HM.newLayer env + modify (\ st -> st { environment = env' }) + +lookupName :: UnRenamedName -> RenamerMonad (Maybe Name) +lookupName n = do + env <- gets environment + return $ HM.maybeLookup env n + +setName :: UnRenamedName -> Name -> RenamerMonad () +setName rn n = + modify (\ st -> st { + environment = HM.update (environment st) rn n + }) + +-- ********************** +-- Renaming Class and basic instances + +class Renamable e1 e2 | e1 -> e2 where + rename :: e1 -> RenamerMonad e2 + +instance Renamable e1 e2 => Renamable [e1] [e2] where + rename es = mapM rename es + +instance Renamable e1 e2 => Renamable (Maybe e1) (Maybe e2) where + rename (Just x) = return Just $$ rename x + rename Nothing = return Nothing + +instance Renamable e1 e2 => Renamable (Annotated a e1) (Annotated a e2) where + rename (An a b e) = rename e >>= return . An a b + +instance (Renamable e1 e2, Renamable e1' e2') => Renamable (e1, e1') (e2, e2') where + rename (a, b) = do + a' <- rename a + b' <- rename b + return (a', b') + +type NameMaker = SrcSpan -> UnRenamedName -> RenamerMonad Name + +externalNameMaker :: Bool -> NameMaker +externalNameMaker b l (UnQual ocn) = mkExternalName ocn l b + +internalNameMaker :: NameMaker +internalNameMaker l (UnQual ocn) = mkInternalName ocn l + +reAnnotatePure :: Annotated a e -> e' -> Annotated a e' +reAnnotatePure (An a b _) v = An a b v + +-- | Given something annotated and a function that mutates the inner object, +-- returns the inner object annotated with the same outer annotation. +reAnnotate :: Monad m => Annotated a e -> m e' -> m (Annotated a e') +reAnnotate (An a b _) m = do + v <- m + return $ An a b v + +-- | Renames the declarations in the current scope. +renameDeclarations :: Bool -> [PDecl] -> RenamerMonad a -> RenamerMonad ([TCDecl], a) +renameDeclarations topLevel ds prog = do + -- Firstly, check for duplicates amongst the definitions + checkDuplicates ds + + -- Now, find all the datatype labels and channels and create names for + -- them in the maps (otherwise renameVarLHS will fail). + mapM_ insertChannelsAndDataTypes ds + + -- Secondly, insert all other names into the environment. + mapM_ insertBoundNames ds + + -- Finally, as all the declarations have been inserted into the map we + -- can rename the right hand sides (as every variable *should* be in + -- scope). + ds' <- mapM renameRightHandSide ds + + -- check the inner thing + a <- prog + + return (ds', a) + + where + nameMaker :: NameMaker + nameMaker = if topLevel then externalNameMaker False else internalNameMaker + + ignoringNameMaker :: NameMaker + ignoringNameMaker _ rn = do + Just v <- lookupName rn + return v + + insertChannelsAndDataTypes :: PDecl -> RenamerMonad () + insertChannelsAndDataTypes ad = case unAnnotate ad of + Channel ns _ -> mapM_ (\ rn -> do + n' <- externalNameMaker True (loc ad) rn + setName rn n') ns + DataType rn cs -> mapM_ (\ cl -> case unAnnotate cl of + DataTypeClause rn _ -> do + n' <- externalNameMaker True (loc cl) rn + setName rn n' + ) cs + _ -> return () + + insertBoundNames :: PDecl -> RenamerMonad () + insertBoundNames pd = case unAnnotate pd of + Assert _ -> return () + Channel _ _ -> return () + DataType rn _ -> do + n <- nameMaker (loc pd) rn + setName rn n + External ns -> + mapM_ (\ rn@(UnQual ocn) -> do + case externalFunctionForOccName ocn of + Just b -> setName rn (name b) + Nothing -> + let err = mkErrorMessage (loc pd) (externalFunctionNotRecognised rn) + in throwSourceError [err]) ns + FunBind rn ms -> do + n <- nameMaker (loc pd) rn + setName rn n + NameType rn _ -> do + n <- nameMaker (loc pd) rn + setName rn n + PatBind p e -> renamePattern nameMaker p >> return () + Transparent ns -> + mapM_ (\ rn@(UnQual ocn) -> do + case transparentFunctionForOccName ocn of + Just b -> setName rn (name b) + Nothing -> + let err = mkErrorMessage (loc pd) (transparentFunctionNotRecognised rn) + in throwSourceError [err]) ns + + renameRightHandSide :: PDecl -> RenamerMonad TCDecl + renameRightHandSide pd = reAnnotate pd $ case unAnnotate pd of + Assert e -> do + e' <- addScope $ rename e + return $ Assert e' + Channel rns e -> do + ns <- mapM renameVarRHS rns + e' <- addScope $ rename e + return $ Channel ns e' + DataType rn cs -> do + n <- renameVarRHS rn + cs' <- mapM (\ pc -> addScope $ reAnnotate pc $ case unAnnotate pc of + DataTypeClause rn e -> do + n' <- renameVarRHS rn + e' <- rename e + return $ DataTypeClause n' e') cs + return $ DataType n cs' + External rns -> do + ns <- mapM renameVarRHS rns + return $ External ns + FunBind rn ms -> do + n <- renameVarRHS rn + ms' <- mapM rename ms + return $ FunBind n ms' + NameType rn e -> do + n <- renameVarRHS rn + e' <- addScope $ rename e + return $ NameType n e' + PatBind p e -> do + p' <- renamePattern ignoringNameMaker p + e' <- addScope $ rename e + return $ PatBind p' e' + Transparent rns -> do + ns <- mapM renameVarRHS rns + return $ Transparent ns + +renamePattern :: NameMaker -> PPat -> RenamerMonad TCPat +renamePattern nm ap = + let + renamePat :: PPat -> RenamerMonad TCPat + renamePat ap = reAnnotate ap $ case unAnnotate ap of + PConcat p1 p2 -> return PConcat $$ renamePat p1 $$ renamePat p2 + PDotApp p1 p2 -> return PDotApp $$ renamePat p1 $$ renamePat p2 + PDoublePattern p1 p2 -> + return PDoublePattern $$ renamePat p1 $$ renamePat p2 + PList ps -> return PList $$ mapM renamePat ps + PLit l -> return $ PLit l + PParen p -> return PParen $$ renamePat p + PSet ps -> return PSet $$ mapM renamePat ps + PTuple ps -> return PTuple $$ mapM renamePat ps + PVar v -> do + -- In this case, we should lookup the variable in the map and see if it is + -- bound. If it is and is a datatype constructor, then we should return + -- return that, otherwise we create a new internal var. + mn <- lookupName v + case mn of + Just n | isNameDataConstructor n -> + -- Just return the name + return (PVar n) + _ -> do + -- Create the name + n <- nm (loc ap) v + setName v n + return $ PVar n + PWildCard -> return PWildCard + in do + checkDuplicates [ap] + renamePat ap + +checkDuplicates :: FreeVars a => [Annotated b a] -> RenamerMonad () +checkDuplicates aps = do + fvss <- mapM freeVars aps + + let + fvs = sort (concat fvss) + gfvs = group fvs + duped = filter (\l -> length l > 1) gfvs + nameLocMap = + concatMap (\(ns, d) -> [(n, loc d) | n <- ns]) (zip fvss aps) + + if duped /= [] then + throwSourceError (map (mkErrorMessage Unknown) (duplicatedDefinitionsMessage nameLocMap)) + else return () + +-- | Rename a variable on the left hand side of a definition. +--renameVarLHS :: NameMaker -> UnRenamedName -> RenamerMonad Name +--renameVarLHS nm v = do + +-- | Rename a variable on the right hand side of a definition. +renameVarRHS :: UnRenamedName -> RenamerMonad Name +renameVarRHS n = do + mn <- lookupName n + case mn of + Just x -> return x + Nothing -> throwSourceError [mkErrorMessage Unknown (varNotInScopeMessage n)] + +renameFields :: [PField] -> RenamerMonad a -> RenamerMonad ([TCField], a) +renameFields fs inner = do + checkDuplicates fs + -- No duplicates, so we can just add one scope + addScope (do + -- We do the fields left to right, to ensure that the scoping is correct + + -- Recall that c?x$y is equiv to |~| y:... @ [] x:... @ ... and hence + -- the nondet fields bind first. + + -- Firstly, we do the nondet fields. + fsNonDet <- mapM (\afd -> + case unAnnotate afd of + Output e -> return Nothing + Input p me -> return Nothing + NonDetInput p me -> do + me' <- rename me + p' <- renamePattern internalNameMaker p + return $ Just $ reAnnotatePure afd $ NonDetInput p' me') fs + + fsDet <- mapM (\ afd -> + case unAnnotate afd of + Output e -> do + e' <- rename e + return $ Just $ reAnnotatePure afd $ Output e' + Input p me -> do + -- Rename me first, as it can't depend on p + me' <- rename me + p' <- renamePattern internalNameMaker p + return $ Just $ reAnnotatePure afd $ Input p' me' + NonDetInput p me -> return Nothing) fs + + let + combineJusts :: [Maybe a] -> [Maybe a] -> [a] + combineJusts [] [] = [] + combineJusts (Just x:xs) (Nothing:ys) = x:combineJusts xs ys + combineJusts (Nothing:xs) (Just y:ys) = y:combineJusts xs ys + + fs' :: [TCField] + fs' = combineJusts fsNonDet fsDet + + -- all fields renamed, now rename the inner thing + a <- inner + return (fs', a)) + +renameStatements :: [PStmt] -> RenamerMonad a -> RenamerMonad ([TCStmt], a) +renameStatements stmts inner = do + checkDuplicates stmts + -- No duplicates, so we can just add one scope + addScope (do + -- We do the stmts left to right, to ensure that the scoping is correct + stmts' <- mapM (\ astmt -> reAnnotate astmt $ + case unAnnotate astmt of + Generator p e -> do + -- Rename e first, as it can't depend on p + e' <- rename e + p' <- renamePattern internalNameMaker p + return $ Generator p' e' + Qualifier e -> do + e' <- rename e + return $ Qualifier e' + ) stmts + -- all stmts renamed, now rename the inner thing + a <- inner + return (stmts', a)) + +instance Renamable (Match UnRenamedName) (Match Name) where + rename (Match pss e) = addScope $ do + checkDuplicates (concat pss) + pss' <- mapM (mapM (renamePattern internalNameMaker)) pss + e' <- rename e + return $ Match pss' e' + +instance Renamable (InteractiveStmt UnRenamedName) (InteractiveStmt Name) where + rename (Bind d) = do + ([d'],_) <- renameDeclarations True [d] (return ()) + return $ Bind d' + rename (Evaluate e) = return Evaluate $$ rename e + rename (RunAssertion a) = return RunAssertion $$ rename a + +instance Renamable (Module UnRenamedName) (Module Name) where + rename (GlobalModule ds) = do + (ds', _) <- renameDeclarations True ds (return ()) + return $ GlobalModule ds' + +instance Renamable (Assertion UnRenamedName) (Assertion Name) where + rename (ASNot e) = + return ASNot $$ rename e + rename (BoolAssertion e) = + return BoolAssertion $$ rename e + rename (Refinement e1 m e2 mopts) = + return Refinement $$ rename e1 $$ return m $$ rename e2 $$ rename mopts + rename (PropertyCheck e1 p m) = + return PropertyCheck $$ rename e1 $$ return p $$ return m + +instance Renamable (ModelOption UnRenamedName) (ModelOption Name) where + rename (TauPriority e) = return TauPriority $$ rename e + +instance Renamable (Exp UnRenamedName) (Exp Name) where + rename (App e es) = return App $$ rename e $$ rename es + rename (BooleanBinaryOp op e1 e2) = return + (BooleanBinaryOp op) $$ rename e1 $$ rename e2 + rename (BooleanUnaryOp op e) = return + (BooleanUnaryOp op) $$ rename e + rename (Concat e1 e2) = return Concat $$ rename e1 $$ rename e2 + rename (DotApp e1 e2) = return DotApp $$ rename e1 $$ rename e2 + rename (If e1 e2 e3) = return If $$ rename e1 $$ rename e2 $$ rename e3 + rename (Lambda p e) = do + (p', e') <- addScope (do + p' <- renamePattern internalNameMaker p + e' <- rename e + return (p', e')) + return $ Lambda p' e' + rename (Let ds e) = do + (ds', e') <- addScope $ renameDeclarations False ds (rename e) + return $ Let ds' e' + rename (Lit l) = return $ Lit l + rename (List es) = return List $$ rename es + rename (ListComp es stmts) = do + (stmts', es') <- renameStatements stmts (rename es) + return $ ListComp es' stmts' + rename (ListEnumFrom e) = return ListEnumFrom $$ rename e + rename (ListEnumFromTo e1 e2) = return ListEnumFromTo $$ rename e1 $$ rename e2 + rename (ListLength e) = return ListLength $$ rename e + rename (MathsBinaryOp op e1 e2) = return + (MathsBinaryOp op) $$ rename e1 $$ rename e2 + rename (MathsUnaryOp op e) = return (MathsUnaryOp op) $$ rename e + rename (Paren e) = return Paren $$ rename e + rename (Set es) = return Set $$ rename es + rename (SetComp es stmts) = do + (stmts', es') <- renameStatements stmts (rename es) + return $ SetComp es' stmts' + rename (SetEnum es) = return SetEnum $$ rename es + rename (SetEnumComp es stmts) = do + (stmts', es') <- renameStatements stmts (rename es) + return $ SetEnumComp es' stmts' + rename (SetEnumFrom e) = return SetEnumFrom $$ rename e + rename (SetEnumFromTo e1 e2) = return SetEnumFromTo $$ rename e1 $$ rename e2 + rename (Tuple es) = return Tuple $$ rename es + rename (Var n) = return Var $$ renameVarRHS n + + rename (AlphaParallel e1 e2 e3 e4) = return + AlphaParallel $$ rename e1 $$ rename e2 $$ rename e3 $$ rename e4 + rename (Exception e1 e2 e3) = return + Exception $$ rename e1 $$ rename e2 $$ rename e3 + rename (ExternalChoice e1 e2) = return ExternalChoice $$ rename e1 $$ rename e2 + rename (GenParallel e1 e2 e3) = return + GenParallel $$ rename e1 $$ rename e2 $$ rename e3 + rename (GuardedExp e1 e2) = return GuardedExp $$ rename e1 $$ rename e2 + rename (Hiding e1 e2) = return Hiding $$ rename e1 $$ rename e2 + rename (InternalChoice e1 e2) = return InternalChoice $$ rename e1 $$ rename e2 + rename (Interrupt e1 e2) = return Interrupt $$ rename e1 $$ rename e2 + rename (Interleave e1 e2) = return Interleave $$ rename e1 $$ rename e2 + rename (LinkParallel e1 ties stmts e2) = do + e1' <- rename e1 + e2' <- rename e2 + (stmts', ties') <- renameStatements stmts (rename ties) + return $ LinkParallel e1' ties' stmts' e2' + rename (Prefix e1 fs e2) = do + e1' <- rename e1 + (fs', e2') <- renameFields fs (rename e2) + return $ Prefix e1' fs' e2' + rename (Rename e1 ties stmts) = do + e1' <- rename e1 + (stmts', ties') <- renameStatements stmts (rename ties) + return $ Rename e1' ties' stmts' + rename (SequentialComp e1 e2) = return SequentialComp $$ rename e1 $$ rename e2 + rename (SlidingChoice e1 e2) = return SlidingChoice $$ rename e1 $$ rename e2 + + rename (ReplicatedAlphaParallel stmts e1 e2) = do + (stmts', (e1', e2')) <- renameStatements stmts (do + e1' <- rename e1 + e2' <- rename e2 + return (e1', e2')) + return $ ReplicatedAlphaParallel stmts' e1' e2' + rename (ReplicatedInterleave stmts e) = do + (stmts', e') <- renameStatements stmts (rename e) + return $ ReplicatedInterleave stmts' e' + rename (ReplicatedExternalChoice stmts e) = do + (stmts', e') <- renameStatements stmts (rename e) + return $ ReplicatedExternalChoice stmts' e' + rename (ReplicatedInternalChoice stmts e) = do + (stmts', e') <- renameStatements stmts (rename e) + return $ ReplicatedInternalChoice stmts' e' + rename (ReplicatedParallel e1 stmts e2) = do + e1' <- rename e1 + (stmts', e2') <- renameStatements stmts (rename e2) + return $ ReplicatedParallel e1' stmts' e2' + rename (ReplicatedLinkParallel ties tiesStmts stmts e) = do + (stmts', (e', ties', tiesStmts')) <- renameStatements stmts (do + e' <- rename e + (tiesStmts', ties') <- renameStatements tiesStmts (rename ties) + return (e', ties', tiesStmts')) + return $ ReplicatedLinkParallel ties' tiesStmts' stmts' e' + +class FreeVars a where + freeVars :: a -> RenamerMonad [UnRenamedName] + +instance FreeVars a => FreeVars [a] where + freeVars xs = concatMapM freeVars xs + +instance FreeVars a => FreeVars (Annotated b a) where + freeVars (An _ _ inner) = freeVars inner + +instance FreeVars (Pat UnRenamedName) where + freeVars (PConcat p1 p2) = do + fvs1 <- freeVars p1 + fvs2 <- freeVars p2 + return $ fvs1++fvs2 + freeVars (PDotApp p1 p2) = freeVars [p1,p2] + freeVars (PDoublePattern p1 p2) = do + fvs1 <- freeVars p1 + fvs2 <- freeVars p2 + return $ fvs1++fvs2 + freeVars (PList ps) = freeVars ps + freeVars (PLit l) = return [] + freeVars (PParen p) = freeVars p + freeVars (PSet ps) = freeVars ps + freeVars (PTuple ps) = freeVars ps + freeVars (PVar n) = do + mn <- lookupName n + case mn of + Just n | isNameDataConstructor n -> return [] + _ -> return [n] + freeVars (PWildCard) = return [] + +instance FreeVars (Stmt UnRenamedName) where + freeVars (Qualifier e) = return [] + freeVars (Generator p e) = freeVars p + +instance FreeVars (Field UnRenamedName) where + freeVars (Input p e) = freeVars p + freeVars (NonDetInput p e) = freeVars p + freeVars (Output e) = return [] + +instance FreeVars (Decl UnRenamedName) where + freeVars (Assert _) = return [] + freeVars (External ns) = return ns + freeVars (Channel ns _) = return ns + freeVars (DataType n cs) = + return $ n:[n' | DataTypeClause n' _ <- map unAnnotate cs] + freeVars (FunBind n _) = return [n] + freeVars (NameType n _) = return [n] + freeVars (PatBind p _) = freeVars p + freeVars (Transparent ns) = return ns + +-- ******************** +-- Error Messages + +type Error = Doc + +duplicatedDefinitionsMessage :: [(UnRenamedName, SrcSpan)] -> [Error] +duplicatedDefinitionsMessage ns = duplicatedDefinitionsMessage' $ + let + names = map fst ns + dupNames = (map head . filter (\ g -> length g > 1) . group . sort) names + in [(n, applyRelation ns n) | n <- dupNames] + +duplicatedDefinitionsMessage' :: [(UnRenamedName, [SrcSpan])] -> [Error] +duplicatedDefinitionsMessage' nlocs = + map (\ (n, spans) -> + hang (text "The variable" <+> prettyPrint n + <+> text "has multiple definitions at" <> colon) tabWidth + (vcat (map prettyPrint spans))) nlocs + +transparentFunctionNotRecognised :: UnRenamedName -> Error +transparentFunctionNotRecognised n = + text "The transparent function" <+> prettyPrint n <+> + text "is not recognised." + +externalFunctionNotRecognised :: UnRenamedName -> Error +externalFunctionNotRecognised n = + text "The external function" <+> prettyPrint n <+> + text "is not recognised." + +varNotInScopeMessage :: UnRenamedName -> Error +varNotInScopeMessage n = prettyPrint n <+> text "is not in scope" diff --git a/src/CSPM/TypeChecker.hs b/src/CSPM/TypeChecker.hs --- a/src/CSPM/TypeChecker.hs +++ b/src/CSPM/TypeChecker.hs @@ -48,7 +48,7 @@ typeCheck :: (Compressable a, TC.TypeCheckable a b) => a -> TypeCheckMonad a typeCheck exp = TC.typeCheck exp >> mcompress exp -typeOfExp :: PExp -> TypeCheckMonad Type +typeOfExp :: TCExp -> TypeCheckMonad Type typeOfExp exp = do -- See if has been type checked, if so, return type, -- else type check diff --git a/src/CSPM/TypeChecker/BuiltInFunctions.hs b/src/CSPM/TypeChecker/BuiltInFunctions.hs --- a/src/CSPM/TypeChecker/BuiltInFunctions.hs +++ b/src/CSPM/TypeChecker/BuiltInFunctions.hs @@ -1,132 +1,23 @@ {-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-} module CSPM.TypeChecker.BuiltInFunctions( - injectBuiltInFunctions, externalFunctions, transparentFunctions, - builtInNames, replacementForDeprecatedName, + injectBuiltInFunctions ) where -import CSPM.DataStructures.Types -import CSPM.TypeChecker.Monad +import Control.Monad import CSPM.DataStructures.Names -import Util.Exception -import Util.PartialFunctions - -sets :: [Type -> (String, [Type], Type)] -sets = - let - cspm_union fv = ("union", [TSet fv, TSet fv], TSet fv) - cspm_inter fv = ("inter", [TSet fv, TSet fv], TSet fv) - cspm_diff fv = ("diff", [TSet fv, TSet fv], TSet fv) - cspm_Union fv = ("Union", [TSet (TSet fv)], TSet fv) - cspm_Inter fv = ("Inter", [TSet (TSet fv)], TSet fv) - cspm_member fv = ("member", [fv, TSet fv], TBool) - cspm_card fv = ("card", [TSet fv], TInt) - cspm_empty fv = ("empty", [TSet fv], TBool) - cspm_set fv = ("set", [TSeq fv], TSet fv) - cspm_Set fv = ("Set", [TSet fv], TSet (TSet fv)) - cspm_Seq fv = ("Seq", [TSet fv], TSet (TSeq fv)) - cspm_seq fv = ("seq", [TSet fv], TSeq fv) - in - [cspm_union, cspm_inter, cspm_diff, cspm_Union, cspm_Inter, - cspm_member, cspm_card, cspm_empty, cspm_set, cspm_Set, - cspm_Seq, cspm_seq] -seqs :: [Type -> (String, [Type], Type)] -seqs = - let - cspm_length fv = ("length", [TSeq fv], TInt) - cspm_null fv = ("null", [TSeq fv], TBool) - cspm_head fv = ("head", [TSeq fv], fv) - cspm_tail fv = ("tail", [TSeq fv], TSeq fv) - cspm_concat fv = ("concat", [TSeq (TSeq fv)], TSeq fv) - cspm_elem fv = ("elem", [fv, TSeq fv], TBool) - in - [cspm_length, cspm_null, cspm_head, cspm_tail, cspm_concat, - cspm_elem] - -builtInProcs :: [(String, Type)] -builtInProcs = - let - cspm_STOP = ("STOP", TProc) - cspm_SKIP = ("SKIP", TProc) - cspm_CHAOS = ("CHAOS", TFunction [TSet TEvent] TProc) - cspm_prioritise = ("prioritise", TFunction [TProc, TSeq (TSet TEvent)] TProc) - in - [cspm_STOP, cspm_SKIP, cspm_CHAOS, cspm_prioritise] - -typeConstructors :: [(String, Type)] -typeConstructors = - let - cspm_Int = ("Int", TSet TInt) - cspm_Bool = ("Bool", TSet TBool) - cspm_Proc = ("Proc", TSet TProc) - cspm_Events = ("Events", TSet TEvent) - cspm_true = ("true", TBool) - cspm_false = ("false", TBool) - cspm_True = ("True", TBool) - cspm_False = ("False", TBool) - in - [cspm_Int, cspm_Bool, cspm_Proc, cspm_Events, cspm_true, - cspm_false, cspm_True, cspm_False] +import CSPM.DataStructures.Types +import CSPM.Prelude +import CSPM.TypeChecker.Monad hiding (isDeprecated, isTypeUnsafe) injectBuiltInFunctions :: TypeCheckMonad () injectBuiltInFunctions = - let - mkFuncType cs func = - do - fv @ (TVar (TypeVarRef tv _ _)) <- freshTypeVarWithConstraints cs - let (n, args, ret) = func fv - let t = ForAll [(tv, cs)] (TFunction args ret) - setType (Name n) t - mkUnsafeFuncType s = do - fv1 @ (TVar (TypeVarRef tv1 _ _)) <- freshTypeVarWithConstraints [] - fv2 @ (TVar (TypeVarRef tv2 _ _)) <- freshTypeVarWithConstraints [] - setType (Name s) (ForAll [(tv1, []), (tv2, [])] (TFunction [fv1] fv2)) - mkPatternType func = - do - let (n, t) = func - setType (Name n) (ForAll [] t) - in do - mapM_ (mkFuncType []) seqs - mapM_ (mkFuncType [Eq]) sets - mapM_ mkPatternType typeConstructors - mapM_ mkPatternType builtInProcs - mapM_ mkUnsafeFuncType unsafeFunctionNames - mapM_ (markAsDeprecated . Name) deprecatedNames - mapM_ (markTypeAsUnsafe . Name) unsafeFunctionNames - -externalFunctions :: PartialFunction String Type -externalFunctions = [] - -transparentFunctions :: PartialFunction String Type -transparentFunctions = [ - ("diamond", TFunction [TProc] TProc), - ("normal", TFunction [TProc] TProc), - ("sbisim", TFunction [TProc] TProc), - ("tau_loop_factor", TFunction [TProc] TProc), - ("model_compress", TFunction [TProc] TProc), - ("explicate", TFunction [TProc] TProc), - ("wbisim", TFunction [TProc] TProc), - ("chase", TFunction [TProc] TProc) - ] - -builtInNames :: [String] -builtInNames = - map fst externalFunctions - ++ map fst transparentFunctions - ++ map fst typeConstructors - ++ map extract seqs - ++ map extract sets - ++ unsafeFunctionNames - where - extract f = let (a,_,_) = f (panic "Dummy type var evaluated") in a - -unsafeFunctionNames :: [String] -unsafeFunctionNames = ["productions", "extensions"] - -deprecatedNames :: [String] -deprecatedNames = ["True", "False"] - -replacementForDeprecatedName :: Name -> Maybe Name -replacementForDeprecatedName (Name "True") = Just $ Name $ "true" -replacementForDeprecatedName (Name "False") = Just $ Name $ "false" -replacementForDeprecatedName _ = Nothing + -- We inject all builtins, including transparent and external functions + -- as everything has been renamed, meaning this won't overwrite any + -- user defined functions + mapM_ (\ b -> do + setType (name b) (typeScheme b) + when (isDeprecated b) $ + markAsDeprecated (name b) (deprecatedReplacement b) + when (isTypeUnsafe b) $ + markTypeAsUnsafe (name b)) (builtins True) diff --git a/src/CSPM/TypeChecker/Common.hs b/src/CSPM/TypeChecker/Common.hs --- a/src/CSPM/TypeChecker/Common.hs +++ b/src/CSPM/TypeChecker/Common.hs @@ -1,6 +1,7 @@ {-# LANGUAGE FlexibleContexts, MultiParamTypeClasses, FunctionalDependencies #-} module CSPM.TypeChecker.Common where +import CSPM.DataStructures.Literals import CSPM.DataStructures.Syntax import CSPM.DataStructures.Types import CSPM.TypeChecker.BuiltInFunctions diff --git a/src/CSPM/TypeChecker/Compressor.hs b/src/CSPM/TypeChecker/Compressor.hs --- a/src/CSPM/TypeChecker/Compressor.hs +++ b/src/CSPM/TypeChecker/Compressor.hs @@ -1,23 +1,21 @@ +-- | Traverses the AST filling in all the type information, ensuring that each +-- type is fully compressed. {-# LANGUAGE FlexibleInstances #-} module CSPM.TypeChecker.Compressor( Compressable, mcompress ) where +import CSPM.DataStructures.Literals import CSPM.DataStructures.Types import CSPM.DataStructures.Syntax import CSPM.TypeChecker.Monad import Util.Annotated +import Util.Monad class Compressable a where - -- | Map compress + -- | Map compress. mcompress :: a -> TypeCheckMonad a -($$) :: TypeCheckMonad (a -> b) -> TypeCheckMonad a -> TypeCheckMonad b -($$) fm argm = do - f <- fm - arg <- argm - return $ f arg - instance (Compressable a) => Compressable (Annotated (Maybe SymbolTable, PSymbolTable) a) where mcompress (An l (_, pt) v) = do symbtable <- readPSymbolTable pt @@ -47,7 +45,7 @@ v1' <- mcompress v1 v2' <- mcompress v2 return (v1', v2') -instance Compressable Exp where +instance Compressable (Exp a) where mcompress (App e es) = return App $$ mcompress e $$ mcompress es mcompress (BooleanBinaryOp op e1 e2) = return (BooleanBinaryOp op) $$ mcompress e1 $$ mcompress e2 @@ -108,14 +106,14 @@ return ReplicatedInternalChoice $$ mcompress stmts $$ mcompress e mcompress (ReplicatedParallel stmts e1 e2) = return ReplicatedParallel $$ mcompress stmts $$ mcompress e1 $$ mcompress e2 - mcompress (ReplicatedLinkParallel ties stmts e) = - return ReplicatedLinkParallel $$ mcompress ties $$ mcompress stmts $$ mcompress e - - mcompress a = panic (show a) -instance Compressable Module where + mcompress (ReplicatedLinkParallel ties tiesStmts stmts e) = + return ReplicatedLinkParallel $$ mcompress ties $$ mcompress tiesStmts + $$ mcompress stmts $$ mcompress e + +instance Compressable (Module a) where mcompress (GlobalModule ds) = return GlobalModule $$ mcompress ds -instance Compressable Decl where +instance Compressable (Decl a) where mcompress (FunBind n ms) = return (FunBind n) $$ mcompress ms mcompress (PatBind p e) = return PatBind $$ mcompress p $$ mcompress e mcompress (Assert a) = return Assert $$ mcompress a @@ -125,36 +123,36 @@ mcompress (DataType n cs) = return (DataType n) $$ mcompress cs mcompress (NameType n e) = return (NameType n) $$ mcompress e -instance Compressable Assertion where +instance Compressable (Assertion a) where mcompress (Refinement e1 m e2 opts) = return Refinement $$ mcompress e1 $$ mcompress m $$ mcompress e2 $$ mcompress opts mcompress (PropertyCheck e p m) = return PropertyCheck $$ mcompress e $$ mcompress p $$ mcompress m -instance Compressable ModelOption where +instance Compressable (ModelOption a) where mcompress (TauPriority e) = return TauPriority $$ mcompress e -instance Compressable DataTypeClause where +instance Compressable (DataTypeClause a) where mcompress (DataTypeClause n me) = return (DataTypeClause n) $$ mcompress me -instance Compressable Match where +instance Compressable (Match a) where mcompress (Match pss e) = return Match $$ mcompress pss $$ mcompress e -instance Compressable Field where +instance Compressable (Field a) where mcompress (Output e) = return Output $$ mcompress e mcompress (Input p e) = return Input $$ mcompress p $$ mcompress e mcompress (NonDetInput p e) = return NonDetInput $$ mcompress p $$ mcompress e -instance Compressable Stmt where +instance Compressable (Stmt a) where mcompress (Generator p e) = return Generator $$ mcompress p $$ mcompress e mcompress (Qualifier e) = return Qualifier $$ mcompress e -instance Compressable InteractiveStmt where +instance Compressable (InteractiveStmt a) where mcompress (Bind d) = return Bind $$ mcompress d mcompress (Evaluate e) = return Evaluate $$ mcompress e mcompress (RunAssertion a) = return RunAssertion $$ mcompress a -instance Compressable Pat where +instance Compressable (Pat a) where mcompress (PConcat p1 p2) = return PConcat $$ mcompress p1 $$ mcompress p2 mcompress (PList ps) = return PList $$ mcompress ps mcompress (PDotApp p1 p2) = return PDotApp $$ mcompress p1 $$ mcompress p2 diff --git a/src/CSPM/TypeChecker/Decl.hs b/src/CSPM/TypeChecker/Decl.hs --- a/src/CSPM/TypeChecker/Decl.hs +++ b/src/CSPM/TypeChecker/Decl.hs @@ -27,7 +27,7 @@ import Util.PrettyPrint -- | Type check a list of possibly mutually recursive functions -typeCheckDecls :: [PDecl] -> TypeCheckMonad () +typeCheckDecls :: [TCDecl] -> TypeCheckMonad () typeCheckDecls decls = do namesBoundByDecls <- mapM (\ decl -> do namesBound <- namesBoundByDecl decl @@ -45,8 +45,7 @@ namesToLocations = [(n, loc d) | (d, ns) <- namesBoundByDecls, n <- ns] -- Throw an error if a name is defined multiple times - manyErrorsIfFalse (noDups boundVars) - (duplicatedDefinitionsMessage namesToLocations) + when (not (noDups boundVars)) $ panic "Duplicates found after renaming." -- We prebind the datatypes and channels as they can be matched on in -- patterns (and thus, given a var in a pattern we can't decide if it @@ -104,7 +103,7 @@ -- that we can identify when a particular pattern uses these clauses and -- channels. We do this by injecting them into the symbol table earlier -- than normal. -registerChannelsAndDataTypes :: Decl -> TypeCheckMonad () +registerChannelsAndDataTypes :: Decl Name -> TypeCheckMonad () registerChannelsAndDataTypes (DataType n cs) = do mapM_ (\ c -> case unAnnotate c of DataTypeClause n' _ -> addDataTypeOrChannel n' @@ -116,7 +115,7 @@ -- | Type checks a group of certainly mutually recursive functions. Only -- functions that are mutually recursive should be included otherwise the -- types could end up being less general. -typeCheckMutualyRecursiveGroup :: [PDecl] -> TypeCheckMonad () +typeCheckMutualyRecursiveGroup :: [TCDecl] -> TypeCheckMonad () typeCheckMutualyRecursiveGroup ds' = do -- TODO: fix temporary hack let @@ -168,11 +167,11 @@ unify t (TSet fv) return fv -instance TypeCheckable PDecl [(Name, Type)] where +instance TypeCheckable TCDecl [(Name, Type)] where errorContext an = Nothing typeCheck' an = setSrcSpan (loc an) $ typeCheck (inner an) -instance TypeCheckable Decl [(Name, Type)] where +instance TypeCheckable (Decl Name) [(Name, Type)] where errorContext (FunBind n ms) = Just $ -- This will only be helpful if the equations don't match in -- type @@ -254,23 +253,11 @@ t <- typeCheck e valueType <- evalTypeExpression t return [(n, TSet valueType)] - typeCheck' (Transparent ns) = do - mapM_ (\ (n@(Name s)) -> do - texp <- applyPFOrError (transparentFunctionNotRecognised n) - transparentFunctions s - ForAll [] t <- getType n - unify texp t) ns - return [] - typeCheck' (External ns) = do - mapM_ (\ (n@(Name s)) -> do - texp <- applyPFOrError (externalFunctionNotRecognised n) - externalFunctions s - ForAll [] t <- getType n - unify texp t) ns - return [] + typeCheck' (Transparent ns) = return [] + typeCheck' (External ns) = return [] typeCheck' (Assert a) = typeCheck a >> return [] -instance TypeCheckable Assertion () where +instance TypeCheckable (Assertion Name) () where errorContext a = Just $ hang (text "In the assertion" <> colon) tabWidth (prettyPrint a) typeCheck' (PropertyCheck e1 p m) = do @@ -281,17 +268,17 @@ ensureIsProc e2 mapM_ typeCheck opts -instance TypeCheckable ModelOption () where +instance TypeCheckable (ModelOption Name) () where errorContext a = Nothing typeCheck' (TauPriority e) = do typeCheckExpect e (TSet TEvent) return () -instance TypeCheckable PDataTypeClause (Name, [Type]) where +instance TypeCheckable TCDataTypeClause (Name, [Type]) where errorContext an = Nothing typeCheck' an = setSrcSpan (loc an) $ typeCheck (inner an) -instance TypeCheckable DataTypeClause (Name, [Type]) where +instance TypeCheckable (DataTypeClause Name) (Name, [Type]) where errorContext c = Just $ hang (text "In the data type clause" <> colon) tabWidth (prettyPrint c) @@ -303,10 +290,10 @@ dotList <- typeToDotList valueType return (n', dotList) -instance TypeCheckable PMatch Type where +instance TypeCheckable TCMatch Type where errorContext an = Nothing typeCheck' an = setSrcSpan (loc an) $ typeCheck (inner an) -instance TypeCheckable Match Type where +instance TypeCheckable (Match Name) Type where -- We create the error context in FunBind as that has access -- to the name errorContext (Match groups exp) = Nothing @@ -331,10 +318,3 @@ ) pats) groups return $ foldr (\ targs tr -> TFunction targs tr) tr tgroups - -applyPFOrError - :: Eq a => Error -> PartialFunction a b -> a -> TypeCheckMonad b -applyPFOrError err pf a = - case safeApply pf a of - Just a -> return a - Nothing -> raiseMessageAsError err diff --git a/src/CSPM/TypeChecker/Decl.hs-boot b/src/CSPM/TypeChecker/Decl.hs-boot --- a/src/CSPM/TypeChecker/Decl.hs-boot +++ b/src/CSPM/TypeChecker/Decl.hs-boot @@ -4,4 +4,4 @@ import CSPM.DataStructures.Types import CSPM.TypeChecker.Monad -typeCheckDecls :: [PDecl] -> TypeCheckMonad () +typeCheckDecls :: [TCDecl] -> TypeCheckMonad () diff --git a/src/CSPM/TypeChecker/Dependencies.hs b/src/CSPM/TypeChecker/Dependencies.hs --- a/src/CSPM/TypeChecker/Dependencies.hs +++ b/src/CSPM/TypeChecker/Dependencies.hs @@ -22,7 +22,7 @@ -- Clearly these depend on each other heavily as a name is free iff -- it is not a dependency. -namesBoundByDecl :: AnDecl -> TypeCheckMonad [Name] +namesBoundByDecl :: AnDecl Name -> TypeCheckMonad [Name] namesBoundByDecl = namesBoundByDecl' . unAnnotate namesBoundByDecl' (FunBind n ms) = return [n] namesBoundByDecl' (PatBind p ms) = freeVars p @@ -50,7 +50,7 @@ instance Dependencies a => Dependencies (Annotated b a) where dependencies' (An _ _ inner) = dependencies inner -instance Dependencies Pat where +instance Dependencies (Pat Name) where dependencies' (PVar n) = do res <- isDataTypeOrChannel n return $ if res then [n] else [] @@ -70,7 +70,7 @@ fvs2 <- dependencies' p2 return $ fvs1++fvs2 -instance Dependencies Exp where +instance Dependencies (Exp Name) where dependencies' (App e es) = dependencies' (e:es) dependencies' (BooleanBinaryOp _ e1 e2) = dependencies' [e1,e2] dependencies' (BooleanUnaryOp _ e) = dependencies' e @@ -118,7 +118,7 @@ dependencies' (SetEnumFromTo e1 e2) = dependencies' [e1,e2] dependencies' (SetEnum es) = dependencies' es dependencies' (Tuple es) = dependencies' es - dependencies' (Var (UnQual n)) = return [n] + dependencies' (Var n) = return [n] -- Processes dependencies' (AlphaParallel e1 e2 e3 e4) = dependencies' [e1,e2,e3,e4] @@ -156,8 +156,12 @@ dependenciesStmts stmts [e1] dependencies' (ReplicatedInternalChoice stmts e1) = dependenciesStmts stmts [e1] - dependencies' (ReplicatedLinkParallel ties stmts e) = - dependenciesStmts stmts (e:es++es') + dependencies' (ReplicatedLinkParallel ties tiesStmts stmts e) = do + d1 <- dependenciesStmts tiesStmts (es++es') + d2 <- dependenciesStmts stmts e + -- The ties may depend on variables bound by stmts too + fvsstmts <- freeVars stmts + return $ (d1 \\ fvsstmts)++d2 where (es, es') = unzip ties dependencies' (ReplicatedParallel e1 stmts e2) = dependenciesStmts stmts [e1,e2] @@ -166,7 +170,7 @@ -- Recall that a later stmt can depend on values that appear in an ealier stmt -- For example, consider . Therefore we do a foldr to correctly -- consider cases like -dependenciesStmts :: Dependencies a => [PStmt] -> a -> TypeCheckMonad [Name] +dependenciesStmts :: Dependencies a => [TCStmt] -> a -> TypeCheckMonad [Name] dependenciesStmts [] e = dependencies e dependenciesStmts (stmt:stmts) e = do depse <- dependenciesStmts stmts e @@ -175,19 +179,19 @@ let depse' = nub (depsstmt++depse) return $ depse' \\ fvstmt -instance Dependencies Stmt where +instance Dependencies (Stmt Name) where dependencies' (Generator p e) = do ds1 <- dependencies p ds2 <- dependencies e return $ ds1++ds2 dependencies' (Qualifier e) = dependencies e -instance Dependencies Field where +instance Dependencies (Field Name) where dependencies' (Input p e) = dependencies e dependencies' (NonDetInput p e) = dependencies e dependencies' (Output e) = dependencies e -instance Dependencies Decl where +instance Dependencies (Decl Name) where dependencies' (FunBind n ms) = do fvsms <- dependencies ms return $ fvsms @@ -203,7 +207,7 @@ dependencies' (Transparent ns) = return [] dependencies' (Assert a) = dependencies a -instance Dependencies Assertion where +instance Dependencies (Assertion Name) where dependencies' (Refinement e1 m e2 opts) = do d1 <- dependencies [e1, e2] d2 <- dependencies opts @@ -212,10 +216,10 @@ dependencies' (BoolAssertion e1) = dependencies [e1] dependencies' (ASNot a) = dependencies a -instance Dependencies ModelOption where +instance Dependencies (ModelOption Name) where dependencies' (TauPriority e) = dependencies' e -instance Dependencies Match where +instance Dependencies (Match Name) where dependencies' (Match ps e) = do fvs1 <- freeVars ps @@ -223,48 +227,45 @@ fvs2 <- dependencies e return $ (fvs2 \\ fvs1) ++ depsPs -instance Dependencies DataTypeClause where +instance Dependencies (DataTypeClause Name) where dependencies' (DataTypeClause n Nothing) = return [] dependencies' (DataTypeClause n (Just e)) = dependencies' e class FreeVars a where freeVars :: a -> TypeCheckMonad [Name] - freeVars = liftM nub . freeVars' - - freeVars' :: a -> TypeCheckMonad [Name] instance FreeVars a => FreeVars [a] where - freeVars' xs = concatMapM freeVars' xs + freeVars xs = concatMapM freeVars xs instance FreeVars a => FreeVars (Annotated b a) where - freeVars' (An _ _ inner) = freeVars inner + freeVars (An _ _ inner) = freeVars inner -instance FreeVars Pat where - freeVars' (PVar n) = do +instance FreeVars (Pat Name) where + freeVars (PVar n) = do res <- isDataTypeOrChannel n return $ if res then [] else [n] - freeVars' (PConcat p1 p2) = do - fvs1 <- freeVars' p1 - fvs2 <- freeVars' p2 + freeVars (PConcat p1 p2) = do + fvs1 <- freeVars p1 + fvs2 <- freeVars p2 return $ fvs1++fvs2 - freeVars' (PDotApp p1 p2) = freeVars' [p1,p2] - freeVars' (PList ps) = freeVars' ps - freeVars' (PWildCard) = return [] - freeVars' (PTuple ps) = freeVars' ps - freeVars' (PSet ps) = freeVars' ps - freeVars' (PParen p) = freeVars' p - freeVars' (PLit l) = return [] - freeVars' (PDoublePattern p1 p2) = do - fvs1 <- freeVars' p1 - fvs2 <- freeVars' p2 + freeVars (PDotApp p1 p2) = freeVars [p1,p2] + freeVars (PList ps) = freeVars ps + freeVars (PWildCard) = return [] + freeVars (PTuple ps) = freeVars ps + freeVars (PSet ps) = freeVars ps + freeVars (PParen p) = freeVars p + freeVars (PLit l) = return [] + freeVars (PDoublePattern p1 p2) = do + fvs1 <- freeVars p1 + fvs2 <- freeVars p2 return $ fvs1++fvs2 -instance FreeVars Stmt where - freeVars' (Qualifier e) = return [] - freeVars' (Generator p e) = freeVars p +instance FreeVars (Stmt Name) where + freeVars (Qualifier e) = return [] + freeVars (Generator p e) = freeVars p -instance FreeVars Field where - freeVars' (Input p e) = freeVars p - freeVars' (NonDetInput p e) = freeVars p - freeVars' (Output e) = return [] +instance FreeVars (Field Name) where + freeVars (Input p e) = freeVars p + freeVars (NonDetInput p e) = freeVars p + freeVars (Output e) = return [] diff --git a/src/CSPM/TypeChecker/Environment.hs b/src/CSPM/TypeChecker/Environment.hs --- a/src/CSPM/TypeChecker/Environment.hs +++ b/src/CSPM/TypeChecker/Environment.hs @@ -1,20 +1,22 @@ module CSPM.TypeChecker.Environment ( - module Util.HierarchicalMap, - Environment, + Environment, + new, bind, maybeLookup, update, delete, toList, mkSymbolInformation, SymbolInformation(..) ) where +import qualified Data.Map as M + import CSPM.DataStructures.Names import CSPM.DataStructures.Types -import Util.HierarchicalMap -- | Make symbol information for the type assuming that the symbol -- is not deprecated and its type is not unsafe. mkSymbolInformation :: TypeScheme -> SymbolInformation mkSymbolInformation t = SymbolInformation { typeScheme = t, - isDeprecated = False, + isDeprecated = False, + deprecationReplacement = Nothing, isTypeUnsafe = False } @@ -24,10 +26,29 @@ typeScheme :: TypeScheme, -- | Is this symbol deprecated isDeprecated :: Bool, + deprecationReplacement :: Maybe Name, -- | Is this symbols' type too general (if so -- use of it will emit a soundness warning) isTypeUnsafe :: Bool } deriving (Eq, Show) -type Environment = HierarchicalMap Name SymbolInformation +type Environment = M.Map Name SymbolInformation + +new :: Environment +new = M.empty + +bind :: Environment -> [(Name, SymbolInformation)] -> Environment +bind env bs = foldr (\ (n,t) env -> M.insert n t env) env bs + +maybeLookup :: Environment -> Name -> Maybe SymbolInformation +maybeLookup env n = M.lookup n env + +update :: Environment -> Name -> SymbolInformation -> Environment +update env n s = M.insert n s env + +delete :: Environment -> Name -> Environment +delete env n = M.delete n env + +toList :: Environment -> [(Name, SymbolInformation)] +toList = M.toList diff --git a/src/CSPM/TypeChecker/Exceptions.hs b/src/CSPM/TypeChecker/Exceptions.hs --- a/src/CSPM/TypeChecker/Exceptions.hs +++ b/src/CSPM/TypeChecker/Exceptions.hs @@ -1,14 +1,10 @@ {-# LANGUAGE DeriveDataTypeable #-} module CSPM.TypeChecker.Exceptions ( Error, Warning, - varNotInScopeMessage, infiniteUnificationMessage, unificationErrorMessage, - duplicatedDefinitionsMessage, incorrectArgumentCountMessage, constraintUnificationErrorMessage, - transparentFunctionNotRecognised, - externalFunctionNotRecognised, deprecatedNameUsed, unsafeNameUsed, ) @@ -30,9 +26,6 @@ type Error = Doc type Warning = Doc -varNotInScopeMessage :: Name -> Error -varNotInScopeMessage n = prettyPrint n <+> text "is not in scope" - incorrectArgumentCountMessage :: Doc -> Int -> Int -> Error incorrectArgumentCountMessage func expected actual = hang (hang (text "The function") tabWidth func) tabWidth @@ -64,29 +57,6 @@ constraintUnificationErrorMessage c t = hang (hang (text "The type") tabWidth (prettyPrint t)) tabWidth (text "does not have the constraint" <+> prettyPrint c) - -duplicatedDefinitionsMessage :: [(Name, SrcSpan)] -> [Error] -duplicatedDefinitionsMessage ns = duplicatedDefinitionsMessage' $ - let - names = map fst ns - dupNames = (map head . filter (\ g -> length g > 1) . group . sort) names - in [(n, applyRelation ns n) | n <- dupNames] - -duplicatedDefinitionsMessage' :: [(Name, [SrcSpan])] -> [Error] -duplicatedDefinitionsMessage' nlocs = - map (\ (n, spans) -> - hang (text "The variable" <+> prettyPrint n - <+> text "has multiple definitions at" <> colon) tabWidth - (vcat (map prettyPrint spans))) nlocs - -transparentFunctionNotRecognised :: Name -> Error -transparentFunctionNotRecognised n = - text "The transparent function" <+> prettyPrint n <+> - text "is not recognised." -externalFunctionNotRecognised :: Name -> Error -externalFunctionNotRecognised n = - text "The external function" <+> prettyPrint n <+> - text "is not recognised." deprecatedNameUsed :: Name -> Maybe Name -> Error deprecatedNameUsed n Nothing = diff --git a/src/CSPM/TypeChecker/Expr.hs b/src/CSPM/TypeChecker/Expr.hs --- a/src/CSPM/TypeChecker/Expr.hs +++ b/src/CSPM/TypeChecker/Expr.hs @@ -22,7 +22,7 @@ import Util.Monad import Util.PrettyPrint -checkFunctionCall :: Doc -> [PExp] -> [Type] -> TypeCheckMonad () +checkFunctionCall :: Doc -> [TCExp] -> [Type] -> TypeCheckMonad () checkFunctionCall func args expectedTypes = do actTypes <- mapM typeCheck args let @@ -50,7 +50,7 @@ mapM unifyArg as return () -instance TypeCheckable PExp Type where +instance TypeCheckable TCExp Type where errorContext an = Nothing typeCheck' an = do t <- setSrcSpan (loc an) $ typeCheck (inner an) @@ -61,7 +61,7 @@ t <- setSrcSpan (loc an) $ typeCheckExpect (inner an) texp setPType (snd (annotation an)) t return t -instance TypeCheckable Exp Type where +instance TypeCheckable (Exp Name) Type where typeCheckExpect obj texp = case errorContext obj of Just c -> addErrorContext c m @@ -171,14 +171,14 @@ typeCheck' (Tuple es) = do ts <- mapM typeCheck es return $ TTuple ts - typeCheck' (Var (UnQual n)) = do + typeCheck' (Var n) = do b <- isDeprecated n - if b then - addWarning (deprecatedNameUsed n (replacementForDeprecatedName n)) - else return () + when b $ do + r <- replacementForDeprecatedName n + addWarning (deprecatedNameUsed n r) + b <- isTypeUnsafe n - if b then addWarning (unsafeNameUsed n) - else return () + when b $ addWarning (unsafeNameUsed n) t <- getType n instantiate t @@ -245,8 +245,8 @@ namesToLocations = [(n, loc f) | (f, fvs) <- fvsByField, n <- fvs] -- Throw an error if a name is defined multiple times - manyErrorsIfFalse (noDups fvs) - (duplicatedDefinitionsMessage namesToLocations) + when (not (noDups fvs)) (panic "Dupes found in prefix after renaming.") + t1 <- typeCheck e1 let tcfs [] tsfields = do @@ -254,7 +254,7 @@ ensureIsProc e2 tcfs (f:fs) tsfields = typeCheckField f (\ t -> tcfs fs (t:tsfields)) - tcfs fields [] + local fvs (tcfs fields []) typeCheck' (LinkParallel e1 ties stmts e2) = do ensureIsProc e1 @@ -284,12 +284,14 @@ typeCheckReplicatedOp stmts $ do typeCheckExpect alpha (TSet TEvent) ensureIsProc proc - typeCheck' (ReplicatedLinkParallel ties stmts proc) = + typeCheck' (ReplicatedLinkParallel ties tiesStmts stmts proc) = do typeCheckStmts TSeq stmts $ do - let (as, bs) = unzip ties - ast <- mapM ensureIsChannel as - zipWithM typeCheckExpect bs ast - ensureIsProc proc + typeCheckStmts TSet tiesStmts $ do + let (as, bs) = unzip ties + ast <- mapM ensureIsChannel as + zipWithM typeCheckExpect bs ast + ensureIsProc proc + return $ TProc typeCheck' (ReplicatedInterleave stmts e1) = typeCheckReplicatedOp stmts (ensureIsProc e1) typeCheck' (ReplicatedExternalChoice stmts e1) = @@ -299,22 +301,25 @@ typeCheck' x = panic ("No case for type checking a "++show x) -typeCheckField :: PField -> (Type -> TypeCheckMonad a) -> TypeCheckMonad a +typeCheckField :: TCField -> (Type -> TypeCheckMonad a) -> TypeCheckMonad a typeCheckField field tc = let errCtxt = hang (text "In the field:") tabWidth (prettyPrint field) checkInput p e = do t <- typeCheck e - fvs <- freeVars p - local fvs $ do - tp <- addErrorContext errCtxt (do - tp <- typeCheck p - unify (TSet tp) t - return tp) - tc tp + tp <- addErrorContext errCtxt (do + -- We don't enforce that tp is Inputable as users are free + -- to do what they wish when they specify the set where + -- the items come from. + tp <- typeCheck p + unify (TSet tp) t + return tp) + tc tp chkInputNoSet p = do - fvs <- freeVars p - local fvs (addErrorContext errCtxt (typeCheck p) >>= tc) + t <- addErrorContext errCtxt $ do + t <- typeCheck p + ensureHasConstraint Inputable t + tc t check (NonDetInput p (Just e)) = checkInput p e check (Input p (Just e)) = checkInput p e check (NonDetInput p Nothing) = chkInputNoSet p @@ -324,7 +329,7 @@ -- | The first argument is a type constructor, which given a type, returns -- that type encapsulate in some other type. -typeCheckStmt :: (Type -> Type) -> PStmt -> TypeCheckMonad a -> TypeCheckMonad a +typeCheckStmt :: (Type -> Type) -> TCStmt -> TypeCheckMonad a -> TypeCheckMonad a typeCheckStmt typc stmt tc = let errCtxt = hang (text "In the statement of a comprehension:") tabWidth @@ -334,18 +339,16 @@ addErrorContext errCtxt (ensureIsBool e) tc check (Generator p exp) = do - fvs <- freeVars p texp <- addErrorContext errCtxt (typeCheck exp) - local fvs $ do - addErrorContext errCtxt (do - tpat <- typeCheck p - unify (typc tpat) texp) - tc + addErrorContext errCtxt (do + tpat <- typeCheck p + unify (typc tpat) texp) + tc in setSrcSpan (loc stmt) (check (unAnnotate stmt)) -- | Type check a series of statements. For each statement a new scope is added -- to ensure that clauses only depend on variables already bound. -typeCheckStmts :: (Type -> Type) -> [AnStmt] -> TypeCheckMonad a -> TypeCheckMonad a +typeCheckStmts :: (Type -> Type) -> [TCStmt] -> TypeCheckMonad a -> TypeCheckMonad a typeCheckStmts typc stmts tc = do fvsByStmt <- mapM (\stmt -> do fvs <- freeVars stmt @@ -355,13 +358,13 @@ namesToLocations = [(n, loc f) | (f, fvs) <- fvsByStmt, n <- fvs] -- Throw an error if a name is defined multiple times - manyErrorsIfFalse (noDups fvs) - (duplicatedDefinitionsMessage namesToLocations) - check stmts + when (not (noDups fvs)) (panic "Dupes found in stmts after renaming.") + -- Renaming ensures uniqueness, so introduce the free vars now. + local fvs (check stmts) where check [] = tc check (stmt:stmts) = typeCheckStmt typc stmt (check stmts) -- | Shortcut for replicated operators -typeCheckReplicatedOp :: [AnStmt] -> TypeCheckMonad a -> TypeCheckMonad a +typeCheckReplicatedOp :: [TCStmt] -> TypeCheckMonad a -> TypeCheckMonad a typeCheckReplicatedOp = typeCheckStmts TSet diff --git a/src/CSPM/TypeChecker/InteractiveStmt.hs b/src/CSPM/TypeChecker/InteractiveStmt.hs --- a/src/CSPM/TypeChecker/InteractiveStmt.hs +++ b/src/CSPM/TypeChecker/InteractiveStmt.hs @@ -12,11 +12,11 @@ import Util.Annotated import Util.PrettyPrint -instance TypeCheckable PInteractiveStmt () where +instance TypeCheckable TCInteractiveStmt () where errorContext a = Nothing typeCheck' = typeCheck . unAnnotate -instance TypeCheckable InteractiveStmt () where +instance TypeCheckable (InteractiveStmt Name) () where errorContext a = Nothing typeCheck' (Bind decl) = typeCheckDecls [decl] typeCheck' (Evaluate exp) = diff --git a/src/CSPM/TypeChecker/Module.hs b/src/CSPM/TypeChecker/Module.hs --- a/src/CSPM/TypeChecker/Module.hs +++ b/src/CSPM/TypeChecker/Module.hs @@ -1,6 +1,7 @@ {-# LANGUAGE MultiParamTypeClasses, TypeSynonymInstances, FlexibleInstances #-} module CSPM.TypeChecker.Module where +import CSPM.DataStructures.Names import CSPM.DataStructures.Syntax import CSPM.DataStructures.Types import CSPM.TypeChecker.Common @@ -8,14 +9,14 @@ import CSPM.TypeChecker.Monad import Util.Annotated -instance TypeCheckable [PModule] () where +instance TypeCheckable [TCModule] () where errorContext _ = Nothing typeCheck' ([m]) = typeCheck m -instance TypeCheckable PModule () where +instance TypeCheckable TCModule () where errorContext _ = Nothing typeCheck' an = setSrcSpan (loc an) $ typeCheck' (inner an) -instance TypeCheckable Module () where +instance TypeCheckable (Module Name) () where errorContext _ = Nothing typeCheck' (GlobalModule ds) = typeCheckDecls ds diff --git a/src/CSPM/TypeChecker/Monad.hs b/src/CSPM/TypeChecker/Monad.hs --- a/src/CSPM/TypeChecker/Monad.hs +++ b/src/CSPM/TypeChecker/Monad.hs @@ -1,7 +1,8 @@ module CSPM.TypeChecker.Monad ( readTypeRef, writeTypeRef, freshTypeVar, freshTypeVarWithConstraints, - getType, safeGetType, setType, - isDeprecated, isTypeUnsafe, markAsDeprecated, markTypeAsUnsafe, + getType, setType, + isTypeUnsafe, markTypeAsUnsafe, + replacementForDeprecatedName, isDeprecated, markAsDeprecated, compress, compressTypeScheme, TypeCheckMonad, runTypeChecker, @@ -44,8 +45,6 @@ -- | List of names that correspond to channels and -- datatypes - used when detecting dependencies. dataTypesAndChannels :: [Name], - -- | Next TypeVar to be allocated - nextTypeId :: Int, -- | Location of the current AST element - used for error -- pretty printing srcSpan :: SrcSpan, @@ -68,7 +67,6 @@ newTypeInferenceState = TypeInferenceState { environment = Env.new, dataTypesAndChannels = [], - nextTypeId = 0, srcSpan = Unknown, errorContexts = [], errors = [], @@ -106,12 +104,12 @@ env <- getEnvironment newArgs <- replicateM (length ns) freshTypeVar let symbs = map (Env.mkSymbolInformation . ForAll []) newArgs - setEnvironment (Env.newLayerAndBind env (zip ns symbs)) + setEnvironment (Env.bind env (zip ns symbs)) res <- m - + env <- getEnvironment - setEnvironment (Env.popLayer env) + setEnvironment (foldr (flip Env.delete) env ns) return res @@ -270,17 +268,6 @@ writeTypeRef :: TypeVarRef -> Type -> TypeCheckMonad () writeTypeRef (TypeVarRef tv cs ioref) t = setPType ioref t -freshTypeVar :: TypeCheckMonad Type -freshTypeVar = freshTypeVarWithConstraints [] - -freshTypeVarWithConstraints :: [Constraint] -> TypeCheckMonad Type -freshTypeVarWithConstraints cs = - do - nextId <- gets nextTypeId - modify (\s -> s { nextTypeId = nextId+1 }) - ioRef <- freshPType - return $ TVar (TypeVarRef (TypeVar nextId) cs ioRef) - getSymbolInformation :: Name -> TypeCheckMonad Env.SymbolInformation getSymbolInformation n = do env <- gets environment @@ -288,32 +275,22 @@ -- If we don't do this the error is deferred until later case Env.maybeLookup env n of Just symb -> return symb - Nothing -> raiseMessagesAsError [varNotInScopeMessage n] + Nothing -> panic "Name not found after renaming." -- | Get the type of 'n' and throw an exception if it doesn't exist. getType :: Name -> TypeCheckMonad TypeScheme getType n = do symb <- getSymbolInformation n return $ Env.typeScheme symb - --- | Get the type of 'n' if it exists, othewise return Nothing. -safeGetType :: Name -> TypeCheckMonad (Maybe TypeScheme) -safeGetType n = do - env <- gets environment - case Env.maybeLookup env n of - Just symb -> return $ Just $ Env.typeScheme symb - Nothing -> return Nothing -- | Sets the type of n to be t in the current scope only. No unification is -- performed. setType :: Name -> TypeScheme -> TypeCheckMonad () setType n t = do env <- getEnvironment - let - symb = case Env.maybeLookupInTopLayer env n of - Just symb -> symb { Env.typeScheme = t } - Nothing -> Env.mkSymbolInformation t - setSymbolInformation n symb + case Env.maybeLookup env n of + Just symb -> setSymbolInformation n (symb { Env.typeScheme = t }) + Nothing -> setSymbolInformation n (Env.mkSymbolInformation t) setSymbolInformation :: Name -> Env.SymbolInformation -> TypeCheckMonad () setSymbolInformation n symb = do @@ -330,14 +307,22 @@ symb <- getSymbolInformation n return $ Env.isTypeUnsafe symb -markAsDeprecated :: Name -> TypeCheckMonad () -markAsDeprecated n = do +markAsDeprecated :: Name -> Maybe Name -> TypeCheckMonad () +markAsDeprecated n repl = do symb <- getSymbolInformation n - setSymbolInformation n (symb { Env.isDeprecated = True }) + setSymbolInformation n (symb { + Env.isDeprecated = True, + Env.deprecationReplacement = repl + }) markTypeAsUnsafe :: Name -> TypeCheckMonad () markTypeAsUnsafe n = do symb <- getSymbolInformation n setSymbolInformation n (symb { Env.isTypeUnsafe = True }) + +replacementForDeprecatedName :: Name -> TypeCheckMonad (Maybe Name) +replacementForDeprecatedName n = do + symb <- getSymbolInformation n + return $ Env.deprecationReplacement symb -- | Apply compress to the type of a type scheme. compressTypeScheme :: TypeScheme -> TypeCheckMonad TypeScheme diff --git a/src/CSPM/TypeChecker/Pat.hs b/src/CSPM/TypeChecker/Pat.hs --- a/src/CSPM/TypeChecker/Pat.hs +++ b/src/CSPM/TypeChecker/Pat.hs @@ -1,6 +1,7 @@ {-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-} module CSPM.TypeChecker.Pat () where +import CSPM.DataStructures.Names import CSPM.DataStructures.Syntax hiding (getType) import CSPM.DataStructures.Types import CSPM.TypeChecker.Common @@ -9,12 +10,12 @@ import Util.Annotated import Util.PrettyPrint -instance TypeCheckable PPat Type where +instance TypeCheckable TCPat Type where errorContext an = Nothing typeCheck' an = setSrcSpan (loc an) $ typeCheck (inner an) typeCheckExpect an typ = setSrcSpan (loc an) (typeCheckExpect (inner an) typ) -instance TypeCheckable Pat Type where +instance TypeCheckable (Pat Name) Type where typeCheckExpect obj texp = case errorContext obj of Just c -> addErrorContext c m @@ -43,8 +44,6 @@ typeCheck' (PLit lit) = typeCheck lit typeCheck' (PParen p1) = typeCheck p1 typeCheck' (PSet ps) = do --- TODO: add to desugarer --- errorIfFalse (length ps <= 1) (InvalidSetPattern ps) t <- ensureAreEqual ps ensureHasConstraint Eq t return $ TSet t diff --git a/src/CSPM/TypeChecker/Unification.hs b/src/CSPM/TypeChecker/Unification.hs --- a/src/CSPM/TypeChecker/Unification.hs +++ b/src/CSPM/TypeChecker/Unification.hs @@ -59,7 +59,7 @@ envfvs <- (liftM nub . concatMapM freeTypeVars) [t | (n, SymbolInformation { typeScheme = ForAll _ t - }) <- flatten env, not (n `elem` names)] + }) <- toList env, not (n `elem` names)] mapM (\ nts -> mapM (\ (n,t) -> do -- The free vars in this type deffvs <- freeTypeVars t @@ -110,28 +110,36 @@ -- | Takes a constraint and a type and returns True iff the type satisfies the -- constraint, or can be made to satsify the constraint by appropriate type -- substitutions, in which case the type substitutions are performed. -unifyConstraint :: Constraint -> Type -> TypeCheckMonad Bool +unifyConstraint :: Constraint -> Type -> TypeCheckMonad () unifyConstraint c (TVar v) = do res <- readTypeRef v case res of Left (tva, cs) -> - if c `elem` cs then return True else do + if c `elem` cs then return () else do fv <- freshTypeVarWithConstraints (nub (c:cs)) applySubstitution v fv - return True + return () Right t -> unifyConstraint c t -unifyConstraint c TInt = return True -unifyConstraint Eq TBool = return True -- Bools are not orderable P524 +unifyConstraint c TInt = return () +unifyConstraint Eq TBool = return () -- Bools are not orderable P524 +unifyConstraint Inputable TBool = return () unifyConstraint c (TSeq t) = unifyConstraint c t -unifyConstraint c (TDot t1 t2) = liftM and (mapM (unifyConstraint c) [t1,t2]) -unifyConstraint c (TSet t) = return True -- All set elements must support comparison -unifyConstraint c (TTuple ts) = liftM and (mapM (unifyConstraint c) ts) -unifyConstraint Eq TEvent = return True -- Events comparable only -unifyConstraint Eq TEventable = return True -- ditto +unifyConstraint Inputable (TDot t1 t2) = do + t <- evaluateDots (TDot t1 t2) + case t of + TDot t1 t2 -> mapM_ (unifyConstraint Inputable) [t1,t2] + _ -> unifyConstraint Inputable t +unifyConstraint c (TDot t1 t2) = mapM_ (unifyConstraint c) [t1,t2] +unifyConstraint c (TSet t) = return () -- All set elements must support comparison +unifyConstraint c (TTuple ts) = mapM_ (unifyConstraint c) ts +unifyConstraint Eq TEvent = return () -- Events comparable only +unifyConstraint Inputable TEvent = return () +unifyConstraint Eq TEventable = return () -- ditto unifyConstraint Eq (TDotable a b) = -- channels and datatypes are only dotable things - liftM and (mapM (unifyConstraint Eq) [a,b]) -unifyConstraint Eq (TDatatype n) = return True + mapM_ (unifyConstraint Eq) [a,b] +unifyConstraint Eq (TDatatype n) = return () -- User data types are not orderable P524 +unifyConstraint Inputable (TDatatype n) = return () unifyConstraint c t = raiseMessageAsError $ constraintUnificationErrorMessage c t @@ -271,18 +279,18 @@ -- Symmetric case of above combineTypeLists (a:as) ((TDotable argt rt):b:bs) | (isSimple b || (isVar b && bs /= [])) = do - unify argt b - combineTypeLists (rt:bs) (a:as) + unify b argt + combineTypeLists (a:as) (rt:bs) | isVar b = do let (args, urt) = reduceDotable (TDotable argt rt) t:ts <- evalTypeList (a:as) - t1 <- unify urt t - combineTypeLists (args++ts) [b] + t1 <- unify t urt + combineTypeLists [b] (args++ts) return (t1:ts) | isDotable b = do let (argsB, rtB) = reduceDotable b - unify argt rtB - combineTypeLists (foldr TDotable rt argsB : bs) (a:as) + unify rtB argt + combineTypeLists (a:as) (foldr TDotable rt argsB : bs) -- TODO: explain why we can't do the unification (it may be because of -- a type error, but may well be because of an unsupported type list). @@ -295,6 +303,8 @@ -- stack in order to ensure error messages are helpful. unify :: Type -> Type -> TypeCheckMonad Type unify texp tact = do + text <- compress texp + tact <- compress tact addUnificationPair (texp, tact) (unifyNoStk texp tact) -- | Unifies the types but doesn't add a pair to the stack. @@ -317,17 +327,15 @@ res <- readTypeRef a case res of Left (tva, cs) -> do - res <- liftM and (mapM (\ c -> unifyConstraint c b) cs) - if res then applySubstitution a b - else raiseUnificationError False + mapM_ (\ c -> unifyConstraint c b) cs + applySubstitution a b Right t -> unify t b unifyNoStk a (TVar b) = do res <- readTypeRef b case res of Left (tvb, cs) -> do - res <- liftM and (mapM (\ c -> unifyConstraint c a) cs) - if res then applySubstitution b a - else raiseUnificationError False + mapM_ (\ c -> unifyConstraint c a) cs + applySubstitution b a Right t -> unify a t diff --git a/src/Util/Exception.hs b/src/Util/Exception.hs --- a/src/Util/Exception.hs +++ b/src/Util/Exception.hs @@ -3,7 +3,7 @@ Exception, LibCSPMException(..), throwException, - tryM, + MonadIOException(..), panic, throwSourceError, mkErrorMessage, mkWarningMessage, ErrorMessage, ErrorMessages, @@ -24,21 +24,24 @@ -- | An error message that resulted from something in the user's input. data ErrorMessage = ErrorMessage { - -- | Used for sorting into order + -- | Used for sorting into order. location :: SrcSpan, - -- | The message + -- | The message. message :: Doc } | WarningMessage { - -- | Used for sorting into order + -- | Used for sorting into order. location :: SrcSpan, - -- | The message + -- | The message. message :: Doc } +-- | Given a 'SrcSpan' and a pretty printed 'Doc' creates an 'ErrorMessage'. mkErrorMessage :: SrcSpan -> Doc -> ErrorMessage mkErrorMessage l d = ErrorMessage l d +-- | Constructs a warning from a 'SrcSpan' and a pretty printed 'Doc', +-- prepending @Warning: @ to the 'Doc'. mkWarningMessage :: SrcSpan -> Doc -> ErrorMessage mkWarningMessage l d = WarningMessage l (text "Warning" <> colon <+> d) @@ -68,18 +71,21 @@ deriving Typeable instance Show LibCSPMException where - show (Panic str) = "Internal inconsitancy error: "++show str + show (Panic str) = "Internal inconsitancy error: "++str show (SourceError ms) = show (prettyPrint ms) show (UserError) = "An unknown error occured." instance Exception LibCSPMException +-- | Throw an error message as a 'SourceError'. throwSourceError :: ErrorMessages -> a throwSourceError = throwException . SourceError +-- | Given a string causes a 'Panic' to be thrown. panic :: String -> a panic = throwException . Panic +-- | Throws an arbitrary 'Exception'. throwException :: Exception e => e -> a throwException = throw diff --git a/src/Util/HierarchicalMap.hs b/src/Util/HierarchicalMap.hs --- a/src/Util/HierarchicalMap.hs +++ b/src/Util/HierarchicalMap.hs @@ -6,11 +6,11 @@ import Prelude hiding (lookup) import Util.Exception -data Ord a => HierarchicalMap a b = +data HierarchicalMap a b = HierarchicalMap [M.Map a b] deriving Show -data (Ord a, Show a, Typeable a) => HierarchicalMapException a = +data HierarchicalMapException a = ValueNotFoundException a deriving (Show, Typeable) diff --git a/src/Util/List.hs b/src/Util/List.hs --- a/src/Util/List.hs +++ b/src/Util/List.hs @@ -5,3 +5,11 @@ -- | Returns true iff the list has no duplicates. noDups :: Eq a => [a] -> Bool noDups xs = nub xs == xs + +-- | Replaces the last item in a list. Assumes the list is non empty. +replaceLast :: [a] -> a -> [a] +replaceLast [_] v = [v] +replaceLast (x:xs) v = replaceLast xs v + +cartesianProduct :: [[a]] -> [[a]] +cartesianProduct vss = sequence vss diff --git a/src/Util/Monad.hs b/src/Util/Monad.hs --- a/src/Util/Monad.hs +++ b/src/Util/Monad.hs @@ -1,6 +1,30 @@ -module Util.Monad where +-- | Misc utility functions that are defined on monads. +module Util.Monad ( + concatMapM, + andM, + orM, + ($$) +) where import Control.Monad concatMapM :: (Monad m) => (a -> m [b]) -> [a] -> m [b] concatMapM f xs = liftM concat (mapM f xs) + +andM :: (Monad m) => [m Bool] -> m Bool +andM [m] = m +andM (m:ms) = do + b <- m + if b then andM ms else return False + +orM :: (Monad m) => [m Bool] -> m Bool +orM [m] = m +orM (m:ms) = do + b <- m + if not b then orM ms else return True + +($$) :: Monad m => m (a -> b) -> m a -> m b +($$) fm argm = do + f <- fm + arg <- argm + return $ f arg diff --git a/src/Util/Prelude.hs b/src/Util/Prelude.hs --- a/src/Util/Prelude.hs +++ b/src/Util/Prelude.hs @@ -1,4 +1,11 @@ -module Util.Prelude where +-- | Various miscellaneous functions utility functions. +module Util.Prelude ( + thenCmp, + expandPathIO, + trim, + cartProduct, +) +where import Data.Char import Prelude @@ -10,6 +17,7 @@ thenCmp :: Ordering -> Ordering -> Ordering thenCmp EQ x = x thenCmp x _ = x +{-# INLINE thenCmp #-} -- | Given a file path, if the first character is a ~ then -- expands the ~ to the users' home directory. @@ -23,6 +31,6 @@ trim :: String -> String trim = f . f where f = reverse . dropWhile isSpace --- | Compute the cartesian product of a list of lists. +-- | Compute the Cartesian product of a list of lists. cartProduct :: [[a]] -> [[a]] cartProduct = sequence diff --git a/src/Util/PrettyPrint.hs b/src/Util/PrettyPrint.hs --- a/src/Util/PrettyPrint.hs +++ b/src/Util/PrettyPrint.hs @@ -3,20 +3,41 @@ PrettyPrintable (prettyPrint), tabWidth, tabIndent, + shortDouble, + commaSeparatedInt, angles, bars, list, dotSep, - speakNth + speakNth, + punctuateFront, ) where +import Numeric +import Text.Printf import Text.PrettyPrint.HughesPJ class PrettyPrintable a where prettyPrint :: a -> Doc -- | The width, in spaces, of a tab character. -tabWidth :: Int +tabWidth :: Int tabWidth = 4 +-- | Pretty prints an integer and separates it into groups of 3, separated by +-- commas. +commaSeparatedInt :: Int -> Doc +commaSeparatedInt = + let + breakIntoGroupsOf3 (c1:c2:c3:c4:cs) = + [c3,c2,c1] : breakIntoGroupsOf3 (c4:cs) + breakIntoGroupsOf3 cs = [reverse cs] + in + fcat . punctuate comma . reverse . map text + . breakIntoGroupsOf3 . reverse . show + +-- | Show a double `d` printing only `places` places after the decimal place. +shortDouble :: Int -> Double -> Doc +shortDouble places d = text (showGFloat (Just places) d "") + -- | Indent a document by `tabWidth` characters, on each line -- (uses `nest`). tabIndent :: Doc -> Doc @@ -55,3 +76,8 @@ | last_dig == 3 = "rd" | otherwise = "th" last_dig = n `rem` 10 + +-- | Equivalent to [d1, sep <> d2, sep <> d3, ...]. +punctuateFront :: Doc -> [Doc] -> [Doc] +punctuateFront sep [] = [] +punctuateFront sep (x:xs) = x:[sep <> x | x <- xs] diff --git a/tests/Main.hs b/tests/Main.hs --- a/tests/Main.hs +++ b/tests/Main.hs @@ -1,12 +1,18 @@ -module Main where +module Main (main) where +import Control.Monad +import Control.Monad.Trans +import Data.List import System.Directory import System.Exit (exitFailure, exitSuccess) import System.FilePath import CSPM +import CSPM.Compiler.Processes import Monad +import Util.Annotated import Util.Exception +import Util.Monad hiding (($$)) import Util.PrettyPrint data RunResult = @@ -32,12 +38,22 @@ b <- doesDirectoryExist fp if not b then return [] else do names <- getDirectoryContents fp - return $ filter (`notElem` [".", "..", ".DS_Store"]) names + let ns = filter (`notElem` [".", "..", ".DS_Store"]) names + concatMapM (\n -> do + let fp' = joinPath [fp, n] + b <- doesDirectoryExist fp' + if b then do + ns <- getAndFilterDirectoryContents fp' + return [joinPath [n, n'] | n' <- ns] + else if takeExtension n == ".csp" then return [n] + else return []) ns runSections ::IO [IO Bool] runSections = do - let testDir = "tests" - sections <- getAndFilterDirectoryContents testDir + let + testDir = "tests" + sections = ["parser", "prettyprinter", "typechecker", "evaluator"] + fs <- mapM (\section -> do shouldPassFiles <- getAndFilterDirectoryContents $ joinPath [testDir, section, "should_pass"] @@ -45,15 +61,18 @@ joinPath [testDir, section, "should_fail"] shouldWarnFiles <- getAndFilterDirectoryContents $ joinPath [testDir, section, "should_warn"] - let - Just test = lookup section testFunctions - pf = [runTest (joinPath [testDir, section, "should_pass", f]) - test PassedNoWarnings | f <- shouldPassFiles] - ff = [runTest (joinPath [testDir, section, "should_fail", f]) - test ErrorOccured | f <- shouldFailFiles] - wf = [runTest (joinPath [testDir, section, "should_warn", f]) - test WarningsEmitted | f <- shouldWarnFiles] - return $ pf++ff++wf + + case lookup section testFunctions of + Just test -> + let + pf = [runTest (joinPath [testDir, section, "should_pass", f]) + test PassedNoWarnings | f <- shouldPassFiles] + ff = [runTest (joinPath [testDir, section, "should_fail", f]) + test ErrorOccured | f <- shouldFailFiles] + wf = [runTest (joinPath [testDir, section, "should_warn", f]) + test WarningsEmitted | f <- shouldWarnFiles] + in return $ pf++ff++wf + Nothing -> return [] ) sections return $ concat fs @@ -89,12 +108,14 @@ testFunctions = [ ("parser", parserTest), ("typechecker", typeCheckerTest), - ("prettyprinter", prettyPrinterTest) + ("prettyprinter", prettyPrinterTest), + ("evaluator", evaluatorTest) ] typeCheckerTest :: FilePath -> Test () typeCheckerTest fp = do - ms <- parseFile fp + ms <- disallowErrors (parseFile fp) + ms <- CSPM.renameFile ms typeCheckFile ms return () @@ -108,7 +129,68 @@ prettyPrinterTest :: FilePath -> Test () prettyPrinterTest fp = do - ms <- parseFile fp + ms <- disallowErrors (parseFile fp) let str = show (prettyPrint ms) ms' <- parseStringAsFile str if ms /= ms' then throwException UserError else return () + +disallowErrors :: Test a -> Test a +disallowErrors a = do + res <- tryM a + case res of + Left e -> panic $ show $ text "Test failed at an unexpected point:" + $$ tabIndent (text (show e)) + Right v -> return v + +evaluatorTest :: FilePath -> Test () +evaluatorTest fp = do + let + evalExpr :: String -> Type -> Test Value + evalExpr s t = do + tce <- disallowErrors $ do + e <- parseExpression s + rne <- renameExpression e + tce <- ensureExpressionIsOfType t rne + desugarExpression tce + evaluateExpression tce + + dsms <- disallowErrors $ do + ms <- parseFile fp + rms <- CSPM.renameFile ms + tms <- typeCheckFile rms + dsms <- desugarFile tms + bindFile dsms + return dsms + + -- Extract all declarations of the form "test...", which should be of + -- patterns of type :: Bool + mapM_ (\ (GlobalModule ds) -> mapM_ (\ d -> + case d of + PatBind p _ -> + case unAnnotate p of + PVar n -> do + let OccName s = nameOccurrence n + when ("test" `isPrefixOf` s) $ do + VBool b <- evalExpr s TBool + when (not b) $ + throwSourceError [mkErrorMessage (loc p) + (prettyPrint n <+> text "was false") + ] + when ("procTest" `isPrefixOf` s) $ do + VProc proc <- evalExpr s TProc + let expectedOutputFile = + (dropExtension fp)++"-"++s++"-expected.txt" + expectedOutput <- liftIO $ readFile expectedOutputFile + let output = prettyPrintAllRequiredProcesses proc + when (show output /= expectedOutput) $ + throwSourceError [mkErrorMessage (loc p) $ + text "The output of" + <+> prettyPrint n + <+> text "did not match the expected output." + <+> text "The actual output was:" + $$ tabIndent output + ] + _ -> return () + _ -> return () + ) (map unAnnotate ds) + ) (map unAnnotate dsms)