From e70972bfe03d3f349d9be4f238cdeedc6af90293 Mon Sep 17 00:00:00 2001 From: Nikolai Kudasov Date: Fri, 8 Nov 2024 16:21:04 +0300 Subject: [PATCH] Update free-foil dependency, factor out Data.SOAS --- free-foil-hou.cabal | 8 +- package.yaml | 1 - src/Data/SOAS.hs | 111 +++ src/Language/Lambda/Impl.hs | 148 +--- src/Language/Lambda/Syntax/Par.hs | 1363 +++++++++-------------------- stack.yaml | 19 +- stack.yaml.lock | 18 +- 7 files changed, 595 insertions(+), 1073 deletions(-) create mode 100644 src/Data/SOAS.hs diff --git a/free-foil-hou.cabal b/free-foil-hou.cabal index 82c4775..5760923 100644 --- a/free-foil-hou.cabal +++ b/free-foil-hou.cabal @@ -30,20 +30,20 @@ custom-setup library exposed-modules: + Data.SOAS Language.Lambda.Impl Language.Lambda.Syntax.Abs Language.Lambda.Syntax.Layout Language.Lambda.Syntax.Lex Language.Lambda.Syntax.Par Language.Lambda.Syntax.Print - Runner.Impl other-modules: Paths_free_foil_hou autogen-modules: Paths_free_foil_hou hs-source-dirs: src - ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints + ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints build-tools: alex >=3.2.4 , happy >=1.19.9 @@ -68,7 +68,7 @@ executable free-foil-hou-exe Paths_free_foil_hou hs-source-dirs: app - ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N + ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N build-tools: alex >=3.2.4 , happy >=1.19.9 @@ -95,7 +95,7 @@ test-suite free-foil-hou-test Paths_free_foil_hou hs-source-dirs: test - ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N + ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N build-tools: alex >=3.2.4 , happy >=1.19.9 diff --git a/package.yaml b/package.yaml index a2d85cb..a9580c9 100644 --- a/package.yaml +++ b/package.yaml @@ -45,7 +45,6 @@ ghc-options: - -Widentities - -Wincomplete-record-updates - -Wincomplete-uni-patterns - - -Wmissing-export-lists - -Wmissing-home-modules - -Wpartial-fields - -Wredundant-constraints diff --git a/src/Data/SOAS.hs b/src/Data/SOAS.hs new file mode 100644 index 0000000..ba05064 --- /dev/null +++ b/src/Data/SOAS.hs @@ -0,0 +1,111 @@ +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE TemplateHaskell #-} +module Data.SOAS where + +import qualified Control.Monad.Foil as Foil +import Data.Bifunctor +import Data.Bifunctor.Sum +import Data.Bifunctor.TH +import Generics.Kind.TH (deriveGenericK) +import qualified GHC.Generics as GHC + +import Control.Monad.Free.Foil +import Data.ZipMatchK + +data MetaAppSig metavar scope term = MetaAppSig metavar [term] + deriving (Functor, Foldable, Traversable, GHC.Generic) + +deriveBifunctor ''MetaAppSig +deriveBifoldable ''MetaAppSig +deriveBitraversable ''MetaAppSig + +deriveGenericK ''MetaAppSig + +instance ZipMatchK a => ZipMatchK (MetaAppSig a) + +-- >>> a = "λy.(λx.λy.X[x, y X[y, x]])y" :: MetaTerm Raw.MetaVarIdent Foil.VoidS +-- >>> b = "λz.(λx.λy.X[x, y X[y, x]])z" :: MetaTerm Raw.MetaVarIdent Foil.VoidS +-- >>> alphaEquiv Foil.emptyScope a b +-- True + +pattern MetaApp :: metavar -> [AST binder (Sum p (MetaAppSig metavar)) n] -> AST binder (Sum p (MetaAppSig metavar)) n +pattern MetaApp metavar args = Node (R2 (MetaAppSig metavar args)) + +type SOAS binder metavar sig n = AST binder (Sum sig (MetaAppSig metavar)) n + +data MetaAbs binder sig where + MetaAbs :: Foil.NameBinderList Foil.VoidS n -> AST binder sig n -> MetaAbs binder sig + +newtype MetaSubst binder sig metavar metavar' = MetaSubst {getMetaSubst :: (metavar, MetaAbs binder (Sum sig (MetaAppSig metavar')))} + +newtype MetaSubsts binder sig metavar metavar' = MetaSubsts + { getSubsts :: [MetaSubst binder sig metavar metavar'] + } + +-- M[g, \z. z a] +-- M[x, y] -> y x +-- y = \z. z a +-- x = g +-- (\z. z a) g + +-- >>> subst = "X [x0, x1] ↦ x1 x0" :: MetaSubst TermSig Raw.MetaVarIdent Raw.MetaVarIdent +-- >>> term = "λg. λa. λw. X[g, λz. z a]" +-- >>> nfMetaTermWithEmptyScope $ applyMetaSubsts id Foil.emptyScope (MetaSubsts [subst]) term +-- λ x0 . λ x1 . λ x2 . x0 x1 +-- >>> subst = "X [x, y] ↦ (λ z . y z) x" :: MetaSubst TermSig Raw.MetaVarIdent Raw.MetaVarIdent +-- >>> term = "λg. λa. λw. X[g, λz. z a]" +-- >>> nfMetaTermWithEmptyScope $ applyMetaSubsts id Foil.emptyScope (MetaSubsts [subst]) term +-- λ x0 . λ x1 . λ x2 . x0 x1 +-- >>> term = "λg. λa. X[g, λz. z a]" +-- >>> nfMetaTermWithEmptyScope $ applyMetaSubsts id Foil.emptyScope (MetaSubsts [subst]) term +-- λ x0 . λ x1 . x0 x1 +applyMetaSubsts :: + (Bifunctor sig, Eq metavar, Bifunctor (MetaAppSig metavar'), Foil.Distinct n, Foil.CoSinkable binder, Foil.SinkableK binder) => + (metavar -> metavar') -> + Foil.Scope n -> + MetaSubsts binder sig metavar metavar' -> + SOAS binder metavar sig n -> + SOAS binder metavar' sig n +applyMetaSubsts rename scope substs = \case + Var x -> Var x + Node (R2 (MetaAppSig metavar args)) -> + let args' = map apply args + in case lookup metavar (getMetaSubst <$> getSubsts substs) of + Just (MetaAbs names body) -> + let substs' = + Foil.nameMapToSubstitution $ + toNameMap Foil.emptyNameMap names args' + in substitute scope substs' body + Nothing -> Node $ R2 $ MetaAppSig (rename metavar) args' + Node (L2 term) -> Node $ L2 $ bimap (goScopedAST rename scope substs) apply term + where + apply = applyMetaSubsts rename scope substs + + toNameMap :: Foil.NameMap n a -> Foil.NameBinderList n l -> [a] -> Foil.NameMap l a + toNameMap nameMap Foil.NameBinderListEmpty [] = nameMap + toNameMap nameMap (Foil.NameBinderListCons binder rest) (x : xs) = toNameMap fresh rest xs + where + fresh = Foil.addNameBinder binder x nameMap + toNameMap _ _ _ = error "mismatched name list and argument list" + + goScopedAST :: + (Bifunctor sig, Eq metavar, Bifunctor (MetaAppSig metavar'), Foil.Distinct n, Foil.CoSinkable binder, Foil.SinkableK binder) => + (metavar -> metavar') -> + Foil.Scope n -> + MetaSubsts binder sig metavar metavar' -> + ScopedAST binder (Sum sig (MetaAppSig metavar)) n -> + ScopedAST binder (Sum sig (MetaAppSig metavar')) n + goScopedAST rename' scope' substs' (ScopedAST binder body) = + case Foil.assertDistinct binder of + Foil.Distinct -> + ScopedAST binder (applyMetaSubsts rename' newScope substs' body) + where + newScope = Foil.extendScopePattern binder scope' diff --git a/src/Language/Lambda/Impl.hs b/src/Language/Lambda/Impl.hs index ac2c0f6..3819ea8 100644 --- a/src/Language/Lambda/Impl.hs +++ b/src/Language/Lambda/Impl.hs @@ -48,7 +48,6 @@ import qualified Control.Monad.Foil as Foil import Control.Monad.Foil.Internal as FoilInternal import Control.Monad.Foil.TH import Control.Monad.Free.Foil -import Control.Monad.Free.Foil.Generic import Control.Monad.Free.Foil.TH import Data.Biapplicative (Bifunctor (bimap, first)) import Data.Bifunctor.Sum @@ -58,6 +57,9 @@ import Data.Map (Map) import qualified Data.Map as Map import Data.String (IsString (..)) import Data.Text (Text) +import Data.ZipMatchK +import Data.ZipMatchK.Bifunctor () +import Data.SOAS import qualified Data.Text as TIO import GHC.Generics (Generic) import qualified GHC.Generics as GHC @@ -101,20 +103,22 @@ deriveCoSinkable ''Raw.VarIdent ''Raw.Pattern mkToFoilPattern ''Raw.VarIdent ''Raw.Pattern mkFromFoilPattern ''Raw.VarIdent ''Raw.Pattern +deriveGenericK ''FoilPattern +instance Foil.SinkableK FoilPattern + deriveUnifiablePattern ''Raw.VarIdent ''Raw.Pattern deriving instance GHC.Generic (TermSig scope term) deriveGenericK ''TermSig +instance ZipMatchK TermSig --- | Match 'Raw.Ident' via 'Eq'. +-- | Match 'Raw.VarIdent' via 'Eq'. instance ZipMatchK Raw.VarIdent where zipMatchWithK = zipMatchViaEq +-- | Match 'Raw.MetaVarIdent' via 'Eq'. instance ZipMatchK Raw.MetaVarIdent where zipMatchWithK = zipMatchViaEq -instance ZipMatch TermSig where - zipMatch = genericZipMatch2 - -- ** Pattern synonyms pattern App' :: AST binder (Sum TermSig q) n -> AST binder (Sum TermSig q) n -> AST binder (Sum TermSig q) n @@ -143,103 +147,11 @@ pattern MetaVar' metavar args = Node (L2 (MetaVarSig metavar args)) -- * User-defined code -data MetaAppSig metavar scope term = MetaAppSig metavar [term] - deriving (Functor, Foldable, Traversable, GHC.Generic) - -deriveBifunctor ''MetaAppSig -deriveBifoldable ''MetaAppSig -deriveBitraversable ''MetaAppSig - -deriveGenericK ''MetaAppSig - -instance (ZipMatchK a) => ZipMatch (MetaAppSig a) where - zipMatch = genericZipMatch2 - --- >>> a = "λy.(λx.λy.X[x, y X[y, x]])y" :: MetaTerm Raw.MetaVarIdent Foil.VoidS --- >>> b = "λz.(λx.λy.X[x, y X[y, x]])z" :: MetaTerm Raw.MetaVarIdent Foil.VoidS --- >>> alphaEquiv Foil.emptyScope a b --- True - -pattern MetaApp :: metavar -> [AST binder (Sum p (MetaAppSig metavar)) n] -> AST binder (Sum p (MetaAppSig metavar)) n -pattern MetaApp metavar args = Node (R2 (MetaAppSig metavar args)) - type AST' = AST FoilPattern -- | Scope-safe λ-term representation in scope @n@. type Term = AST' TermSig - -type SOAS metavar sig n = AST' (Sum sig (MetaAppSig metavar)) n - -type MetaTerm metavar n = SOAS metavar TermSig n - -data MetaAbs sig where - MetaAbs :: NameBinderList Foil.VoidS n -> AST' sig n -> MetaAbs sig - -newtype MetaSubst sig metavar metavar' = MetaSubst {getMetaSubst :: (metavar, MetaAbs (Sum sig (MetaAppSig metavar')))} - -newtype MetaSubsts sig metavar metavar' = MetaSubsts - { getSubsts :: [MetaSubst sig metavar metavar'] - } - --- M[g, \z. z a] --- M[x, y] -> y x --- y = \z. z a --- x = g --- (\z. z a) g - --- >>> subst = "X [x0, x1] ↦ x1 x0" :: MetaSubst TermSig Raw.MetaVarIdent Raw.MetaVarIdent --- >>> term = "λg. λa. λw. X[g, λz. z a]" --- >>> nfMetaTermWithEmptyScope $ applyMetaSubsts id Foil.emptyScope (MetaSubsts [subst]) term --- λ x0 . λ x1 . λ x2 . x0 x1 --- >>> subst = "X [x, y] ↦ (λ z . y z) x" :: MetaSubst TermSig Raw.MetaVarIdent Raw.MetaVarIdent --- >>> term = "λg. λa. λw. X[g, λz. z a]" --- >>> nfMetaTermWithEmptyScope $ applyMetaSubsts id Foil.emptyScope (MetaSubsts [subst]) term --- λ x0 . λ x1 . λ x2 . x0 x1 --- >>> term = "λg. λa. X[g, λz. z a]" --- >>> nfMetaTermWithEmptyScope $ applyMetaSubsts id Foil.emptyScope (MetaSubsts [subst]) term --- λ x0 . λ x1 . x0 x1 -applyMetaSubsts :: - (Bifunctor sig, Eq metavar, Bifunctor (MetaAppSig metavar'), Distinct n) => - (metavar -> metavar') -> - Scope n -> - MetaSubsts sig metavar metavar' -> - SOAS metavar sig n -> - SOAS metavar' sig n -applyMetaSubsts rename scope substs = \case - Var x -> Var x - Node (R2 (MetaAppSig metavar args)) -> - let args' = map apply args - in case lookup metavar (getMetaSubst <$> getSubsts substs) of - Just (MetaAbs names body) -> - let substs' = - nameMapToSubsts $ - toNameMap Foil.emptyNameMap names args' - in substitute scope substs' body - Nothing -> Node $ R2 $ MetaAppSig (rename metavar) args' - Node (L2 term) -> Node $ L2 $ bimap (goScopedAST rename scope substs) apply term - where - apply = applyMetaSubsts rename scope substs - - toNameMap :: Foil.NameMap n a -> NameBinderList n l -> [a] -> Foil.NameMap l a - toNameMap nameMap NameBinderListEmpty [] = nameMap - toNameMap nameMap (NameBinderListCons binder rest) (x : xs) = toNameMap fresh rest xs - where - fresh = Foil.addNameBinder binder x nameMap - toNameMap _ _ _ = error "mismatched name list and argument list" - - goScopedAST :: - (Bifunctor sig, Eq metavar, Bifunctor (MetaAppSig metavar'), Distinct n) => - (metavar -> metavar') -> - Scope n -> - MetaSubsts sig metavar metavar' -> - ScopedAST FoilPattern (Sum sig (MetaAppSig metavar)) n -> - ScopedAST FoilPattern (Sum sig (MetaAppSig metavar')) n - goScopedAST rename' scope' substs' (ScopedAST binder body) = - case assertDistinct binder of - Foil.Distinct -> - ScopedAST binder (applyMetaSubsts rename' newScope substs' body) - where - newScope = Foil.extendScopePattern binder scope' +type MetaTerm metavar n = SOAS FoilPattern metavar TermSig n {-# COMPLETE Var, Lam', App', Let', MetaVar', MetaApp #-} @@ -268,16 +180,12 @@ nfMetaTerm scope = \case -- MetaSubst' metavar term -> MetaSubst' metavar (nfMetaTerm scope term) MetaApp metavar args -> MetaApp metavar (map (nfMetaTerm scope) args) -nfMetaTermWithEmptyScope :: SOAS metavar TermSig VoidS -> SOAS metavar TermSig VoidS +nfMetaTermWithEmptyScope :: SOAS FoilPattern metavar TermSig VoidS -> SOAS FoilPattern metavar TermSig VoidS nfMetaTermWithEmptyScope = nfMetaTerm Foil.emptyScope -nameMapToSubsts :: Foil.NameMap i (e o) -> Foil.Substitution e i o -nameMapToSubsts nameMap = - FoilInternal.UnsafeSubstitution $ FoilInternal.getNameMap nameMap - -- ** Conversion helpers for 'MetaSubst' -toMetaSubst :: Raw.MetaSubst -> MetaSubst TermSig Raw.MetaVarIdent Raw.MetaVarIdent +toMetaSubst :: Raw.MetaSubst -> MetaSubst FoilPattern TermSig Raw.MetaVarIdent Raw.MetaVarIdent toMetaSubst (Raw.AMetaSubst metavar vars term) = withMetaSubstVars vars Foil.emptyScope Map.empty NameBinderListEmpty $ \scope env binderList -> let term' = toTerm scope env (getTermFromScopedTerm term) @@ -310,7 +218,7 @@ withMetaSubstVars (ident : idents) scope env binderList cont = push x NameBinderListEmpty = NameBinderListCons x NameBinderListEmpty push x (NameBinderListCons y ys) = NameBinderListCons y (push x ys) -fromMetaSubst :: MetaSubst TermSig Raw.MetaVarIdent Raw.MetaVarIdent -> Raw.MetaSubst +fromMetaSubst :: MetaSubst FoilPattern TermSig Raw.MetaVarIdent Raw.MetaVarIdent -> Raw.MetaSubst fromMetaSubst (MetaSubst (metavar, MetaAbs binderList term)) = let term' = Raw.AScopedTerm $ fromTerm $ fromMetaTerm term idents = toVarIdentList binderList @@ -377,7 +285,7 @@ fromTerm = convertFromAST convertFromTermSig Raw.Var - fromFoilPattern + (fromFoilPattern (\i -> Raw.VarIdent ("x" ++ show i))) Raw.AScopedTerm (\i -> Raw.VarIdent ("x" ++ show i)) @@ -421,16 +329,16 @@ instance IsString (MetaTerm Raw.MetaVarIdent Foil.VoidS) where fromString :: String -> MetaTerm Raw.MetaVarIdent VoidS fromString = toMetaTerm . unsafeParseTerm --- >>> "X [ x, y, z ] ↦ λy.(λx.λy.X[x, y X[y, x]])y" :: MetaSubst TermSig Raw.MetaVarIdent Raw.MetaVarIdent +-- >>> "X [ x, y, z ] ↦ λy.(λx.λy.X[x, y X[y, x]])y" :: MetaSubst FoilPattern TermSig Raw.MetaVarIdent Raw.MetaVarIdent -- X [x0, x1, x2] ↦ λ x3 . (λ x4 . λ x5 . X [x4, x5 X [x5, x4]]) x3 -instance Show (MetaSubst TermSig Raw.MetaVarIdent Raw.MetaVarIdent) where - show :: MetaSubst TermSig Raw.MetaVarIdent Raw.MetaVarIdent -> String +instance Show (MetaSubst FoilPattern TermSig Raw.MetaVarIdent Raw.MetaVarIdent) where + show :: MetaSubst FoilPattern TermSig Raw.MetaVarIdent Raw.MetaVarIdent -> String show = Raw.printTree . fromMetaSubst --- >>> "X [ x, y ] ↦ λ x . y" :: MetaSubst TermSig Raw.MetaVarIdent Raw.MetaVarIdent +-- >>> "X [ x, y ] ↦ λ x . y" :: MetaSubst FoilPattern TermSig Raw.MetaVarIdent Raw.MetaVarIdent -- X [x0, x1] ↦ λ x2 . x1 -instance IsString (MetaSubst TermSig Raw.MetaVarIdent Raw.MetaVarIdent) where - fromString :: String -> MetaSubst TermSig Raw.MetaVarIdent Raw.MetaVarIdent +instance IsString (MetaSubst FoilPattern TermSig Raw.MetaVarIdent Raw.MetaVarIdent) where + fromString :: String -> MetaSubst FoilPattern TermSig Raw.MetaVarIdent Raw.MetaVarIdent fromString = unsafeParseMetaSubst unsafeParseTerm :: String -> Term Foil.VoidS @@ -441,12 +349,12 @@ unsafeParseTerm input = where tokens = Raw.resolveLayout False (Raw.myLexer input) -parseMetaSubst :: String -> Either String (MetaSubst TermSig Raw.MetaVarIdent Raw.MetaVarIdent) +parseMetaSubst :: String -> Either String (MetaSubst FoilPattern TermSig Raw.MetaVarIdent Raw.MetaVarIdent) parseMetaSubst input = let tokens = Raw.resolveLayout False (Raw.myLexer input) in toMetaSubst <$> Raw.pMetaSubst tokens -unsafeParseMetaSubst :: String -> MetaSubst TermSig Raw.MetaVarIdent Raw.MetaVarIdent +unsafeParseMetaSubst :: String -> MetaSubst FoilPattern TermSig Raw.MetaVarIdent Raw.MetaVarIdent unsafeParseMetaSubst = either error id . parseMetaSubst -- >>> "∀ m, n. Y[m, X[n, m]] = (λ x . m (x n)) m" :: UnificationConstraint @@ -562,19 +470,19 @@ interpretProgram (Raw.AProgram commands) = mapM_ interpretCommand commands -- ** Test framework implementation -- >>> constraint = "∀ g, a, w. X[g, λz. z a] = g a" :: UnificationConstraint --- >>> subst = "X[x, y] ↦ (λ z . y z) x" :: MetaSubst TermSig Raw.MetaVarIdent Raw.MetaVarIdent +-- >>> subst = "X[x, y] ↦ (λ z . y z) x" :: MetaSubst FoilPattern TermSig Raw.MetaVarIdent Raw.MetaVarIdent -- >>> isSolved (solveUnificationConstraint constraint (MetaSubsts [subst])) -- True -- >>> constraint1 = "∀ f, x . X[f, x] = f Y[x]" :: UnificationConstraint -- >>> constraint2 = "∀ x . Y[x] = x x" :: UnificationConstraint --- >>> subst1 = "Y[x] ↦ x x" :: MetaSubst TermSig Raw.MetaVarIdent Raw.MetaVarIdent --- >>> subst2 = "X[f, x] ↦ f (x x)" :: MetaSubst TermSig Raw.MetaVarIdent Raw.MetaVarIdent --- >>> subst3 = "M[x, y] ↦ y x" :: MetaSubst TermSig Raw.MetaVarIdent Raw.MetaVarIdent +-- >>> subst1 = "Y[x] ↦ x x" :: MetaSubst FoilPattern TermSig Raw.MetaVarIdent Raw.MetaVarIdent +-- >>> subst2 = "X[f, x] ↦ f (x x)" :: MetaSubst FoilPattern TermSig Raw.MetaVarIdent Raw.MetaVarIdent +-- >>> subst3 = "M[x, y] ↦ y x" :: MetaSubst FoilPattern TermSig Raw.MetaVarIdent Raw.MetaVarIdent -- >>> all id (map isSolved . solveUnificationConstraint (MetaSubsts [subst1, subst2, subst3])) [constraint1, constraint2]) -- True solveUnificationConstraint :: - MetaSubsts TermSig Raw.MetaVarIdent Raw.MetaVarIdent -> + MetaSubsts FoilPattern TermSig Raw.MetaVarIdent Raw.MetaVarIdent -> UnificationConstraint -> UnificationConstraint solveUnificationConstraint substs (UnificationConstraint scope binders lhs rhs) = @@ -601,7 +509,7 @@ data Problem = Problem data Solution = Solution { solutionName :: Text, solutionSubstitutions :: - [MetaSubst TermSig Raw.MetaVarIdent Raw.MetaVarIdent] + [MetaSubst FoilPattern TermSig Raw.MetaVarIdent Raw.MetaVarIdent] } deriving (Show, Generic) diff --git a/src/Language/Lambda/Syntax/Par.hs b/src/Language/Lambda/Syntax/Par.hs index eaae8ba..924464b 100644 --- a/src/Language/Lambda/Syntax/Par.hs +++ b/src/Language/Lambda/Syntax/Par.hs @@ -1,4 +1,14 @@ {-# OPTIONS_GHC -w #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE TypeSynonymInstances #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE PatternGuards #-} +{-# LANGUAGE NoStrictData #-} +#if __GLASGOW_HASKELL__ >= 710 +{-# LANGUAGE PartialTypeSignatures #-} +#endif {-# OPTIONS_GHC -fno-warn-incomplete-patterns -fno-warn-overlapping-patterns #-} {-# LANGUAGE PatternSynonyms #-} @@ -25,164 +35,37 @@ import qualified Language.Lambda.Syntax.Abs import Language.Lambda.Syntax.Lex import qualified Data.Array as Happy_Data_Array import qualified Data.Bits as Bits +import qualified GHC.Exts as Happy_GHC_Exts import Control.Applicative(Applicative(..)) import Control.Monad (ap) --- parser produced by Happy Version 1.20.1.1 +-- parser produced by Happy Version 2.0.2 data HappyAbsSyn - = HappyTerminal (Token) - | HappyErrorToken Prelude.Int - | HappyAbsSyn15 (Language.Lambda.Syntax.Abs.VarIdent) - | HappyAbsSyn16 (Language.Lambda.Syntax.Abs.MetaVarIdent) - | HappyAbsSyn17 (Language.Lambda.Syntax.Abs.Program) - | HappyAbsSyn18 (Language.Lambda.Syntax.Abs.Command) - | HappyAbsSyn19 ([Language.Lambda.Syntax.Abs.Command]) - | HappyAbsSyn20 (Language.Lambda.Syntax.Abs.Term) - | HappyAbsSyn23 ([Language.Lambda.Syntax.Abs.Term]) - | HappyAbsSyn24 (Language.Lambda.Syntax.Abs.ScopedTerm) - | HappyAbsSyn25 (Language.Lambda.Syntax.Abs.Pattern) - | HappyAbsSyn26 (Language.Lambda.Syntax.Abs.MetaSubst) - | HappyAbsSyn27 (Language.Lambda.Syntax.Abs.UnificationConstraint) - | HappyAbsSyn28 ([Language.Lambda.Syntax.Abs.VarIdent]) - -{- to allow type-synonyms as our monads (likely - - with explicitly-specified bind and return) - - in Haskell98, it seems that with - - /type M a = .../, then /(HappyReduction M)/ - - is not allowed. But Happy is a - - code-generator that can just substitute it. -type HappyReduction m = - Prelude.Int - -> (Token) - -> HappyState (Token) (HappyStk HappyAbsSyn -> [(Token)] -> m HappyAbsSyn) - -> [HappyState (Token) (HappyStk HappyAbsSyn -> [(Token)] -> m HappyAbsSyn)] - -> HappyStk HappyAbsSyn - -> [(Token)] -> m HappyAbsSyn --} - -action_0, - action_1, - action_2, - action_3, - action_4, - action_5, - action_6, - action_7, - action_8, - action_9, - action_10, - action_11, - action_12, - action_13, - action_14, - action_15, - action_16, - action_17, - action_18, - action_19, - action_20, - action_21, - action_22, - action_23, - action_24, - action_25, - action_26, - action_27, - action_28, - action_29, - action_30, - action_31, - action_32, - action_33, - action_34, - action_35, - action_36, - action_37, - action_38, - action_39, - action_40, - action_41, - action_42, - action_43, - action_44, - action_45, - action_46, - action_47, - action_48, - action_49, - action_50, - action_51, - action_52, - action_53, - action_54, - action_55, - action_56, - action_57, - action_58, - action_59, - action_60, - action_61, - action_62, - action_63, - action_64, - action_65, - action_66, - action_67, - action_68, - action_69, - action_70, - action_71, - action_72, - action_73 :: () => Prelude.Int -> ({-HappyReduction (Err) = -} - Prelude.Int - -> (Token) - -> HappyState (Token) (HappyStk HappyAbsSyn -> [(Token)] -> (Err) HappyAbsSyn) - -> [HappyState (Token) (HappyStk HappyAbsSyn -> [(Token)] -> (Err) HappyAbsSyn)] - -> HappyStk HappyAbsSyn - -> [(Token)] -> (Err) HappyAbsSyn) - -happyReduce_12, - happyReduce_13, - happyReduce_14, - happyReduce_15, - happyReduce_16, - happyReduce_17, - happyReduce_18, - happyReduce_19, - happyReduce_20, - happyReduce_21, - happyReduce_22, - happyReduce_23, - happyReduce_24, - happyReduce_25, - happyReduce_26, - happyReduce_27, - happyReduce_28, - happyReduce_29, - happyReduce_30, - happyReduce_31, - happyReduce_32, - happyReduce_33, - happyReduce_34, - happyReduce_35 :: () => ({-HappyReduction (Err) = -} - Prelude.Int - -> (Token) - -> HappyState (Token) (HappyStk HappyAbsSyn -> [(Token)] -> (Err) HappyAbsSyn) - -> [HappyState (Token) (HappyStk HappyAbsSyn -> [(Token)] -> (Err) HappyAbsSyn)] - -> HappyStk HappyAbsSyn - -> [(Token)] -> (Err) HappyAbsSyn) - -happyExpList :: Happy_Data_Array.Array Prelude.Int Prelude.Int -happyExpList = Happy_Data_Array.listArray (0,180) ([0,0,16,0,0,2,0,16384,0,0,24584,6,0,49153,0,8192,6144,0,1024,816,0,128,102,0,0,4,0,0,1,0,2048,0,0,512,0,0,64,0,0,0,0,16,0,0,0,0,0,0,0,0,128,0,4096,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1024,0,0,0,0,16384,12288,0,0,0,0,0,0,0,32800,25,0,0,1,0,8192,0,16384,0,0,0,0,0,0,0,0,8,6,0,0,0,0,2,0,0,0,0,128,102,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,12292,3,0,4,0,0,2,0,1024,0,0,64,51,0,0,2,0,8,0,0,2048,0,0,0,0,128,102,0,2048,0,0,256,0,0,0,0,2048,1632,0,256,204,0,0,0,0,0,0,0,0,0,0,32,0,0,0,0,0,4,0,256,0,0,52225,0,8192,6528,0,1024,816,0,0,0,0,0,0,0,0,0,0 - ]) + = HappyTerminal (Token) + | HappyErrorToken Prelude.Int + | HappyAbsSyn15 (Language.Lambda.Syntax.Abs.VarIdent) + | HappyAbsSyn16 (Language.Lambda.Syntax.Abs.MetaVarIdent) + | HappyAbsSyn17 (Language.Lambda.Syntax.Abs.Program) + | HappyAbsSyn18 (Language.Lambda.Syntax.Abs.Command) + | HappyAbsSyn19 ([Language.Lambda.Syntax.Abs.Command]) + | HappyAbsSyn20 (Language.Lambda.Syntax.Abs.Term) + | HappyAbsSyn23 ([Language.Lambda.Syntax.Abs.Term]) + | HappyAbsSyn24 (Language.Lambda.Syntax.Abs.ScopedTerm) + | HappyAbsSyn25 (Language.Lambda.Syntax.Abs.Pattern) + | HappyAbsSyn26 (Language.Lambda.Syntax.Abs.MetaSubst) + | HappyAbsSyn27 (Language.Lambda.Syntax.Abs.UnificationConstraint) + | HappyAbsSyn28 ([Language.Lambda.Syntax.Abs.VarIdent]) + +happyExpList :: HappyAddr +happyExpList = HappyA# "\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x40\x00\x00\x00\x00\x08\x60\x06\x00\x00\x00\x01\xc0\x00\x00\x00\x20\x00\x18\x00\x00\x00\x04\x30\x03\x00\x00\x80\x00\x66\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x30\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x80\x19\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x20\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x66\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x30\x03\x00\x00\x00\x04\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x04\x00\x00\x00\x00\x40\x00\x33\x00\x00\x00\x00\x00\x02\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x66\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x60\x06\x00\x00\x00\x01\xcc\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x01\x00\x00\x00\x00\x01\xcc\x00\x00\x00\x20\x80\x19\x00\x00\x00\x04\x30\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"# {-# NOINLINE happyExpListPerState #-} happyExpListPerState st = token_strs_expected where token_strs = ["error","%dummy","%start_pProgram","%start_pCommand","%start_pListCommand","%start_pTerm","%start_pTerm1","%start_pTerm2","%start_pListTerm","%start_pScopedTerm","%start_pPattern","%start_pMetaSubst","%start_pUnificationConstraint","%start_pListVarIdent","VarIdent","MetaVarIdent","Program","Command","ListCommand","Term","Term1","Term2","ListTerm","ScopedTerm","Pattern","MetaSubst","UnificationConstraint","ListVarIdent","'('","')'","','","'.'","';'","'='","'['","']'","'compute'","'in'","'let'","'\955'","'\8614'","'\8704'","L_VarIdent","L_MetaVarIdent","%eof"] - bit_start = st Prelude.* 45 - bit_end = (st Prelude.+ 1) Prelude.* 45 + bit_start = st Prelude.* 45 + bit_end = (st Prelude.+ 1) Prelude.* 45 read_bit = readArrayBit happyExpList bits = Prelude.map read_bit [bit_start..bit_end Prelude.- 1] bits_indexed = Prelude.zip bits [0..44] @@ -190,602 +73,273 @@ happyExpListPerState st = f (Prelude.False, _) = [] f (Prelude.True, nr) = [token_strs Prelude.!! nr] -action_0 (37) = happyShift action_39 -action_0 (17) = happyGoto action_41 -action_0 (18) = happyGoto action_37 -action_0 (19) = happyGoto action_42 -action_0 _ = happyReduce_16 - -action_1 (37) = happyShift action_39 -action_1 (18) = happyGoto action_40 -action_1 _ = happyFail (happyExpListPerState 1) - -action_2 (37) = happyShift action_39 -action_2 (18) = happyGoto action_37 -action_2 (19) = happyGoto action_38 -action_2 _ = happyReduce_16 - -action_3 (29) = happyShift action_29 -action_3 (39) = happyShift action_30 -action_3 (40) = happyShift action_31 -action_3 (43) = happyShift action_13 -action_3 (44) = happyShift action_20 -action_3 (15) = happyGoto action_23 -action_3 (16) = happyGoto action_24 -action_3 (20) = happyGoto action_36 -action_3 (21) = happyGoto action_26 -action_3 (22) = happyGoto action_27 -action_3 _ = happyFail (happyExpListPerState 3) - -action_4 (29) = happyShift action_29 -action_4 (43) = happyShift action_13 -action_4 (44) = happyShift action_20 -action_4 (15) = happyGoto action_23 -action_4 (16) = happyGoto action_24 -action_4 (21) = happyGoto action_35 -action_4 (22) = happyGoto action_27 -action_4 _ = happyFail (happyExpListPerState 4) - -action_5 (29) = happyShift action_29 -action_5 (43) = happyShift action_13 -action_5 (44) = happyShift action_20 -action_5 (15) = happyGoto action_23 -action_5 (16) = happyGoto action_24 -action_5 (22) = happyGoto action_34 -action_5 _ = happyFail (happyExpListPerState 5) - -action_6 (29) = happyShift action_29 -action_6 (39) = happyShift action_30 -action_6 (40) = happyShift action_31 -action_6 (43) = happyShift action_13 -action_6 (44) = happyShift action_20 -action_6 (15) = happyGoto action_23 -action_6 (16) = happyGoto action_24 -action_6 (20) = happyGoto action_32 -action_6 (21) = happyGoto action_26 -action_6 (22) = happyGoto action_27 -action_6 (23) = happyGoto action_33 -action_6 _ = happyReduce_26 - -action_7 (29) = happyShift action_29 -action_7 (39) = happyShift action_30 -action_7 (40) = happyShift action_31 -action_7 (43) = happyShift action_13 -action_7 (44) = happyShift action_20 -action_7 (15) = happyGoto action_23 -action_7 (16) = happyGoto action_24 -action_7 (20) = happyGoto action_25 -action_7 (21) = happyGoto action_26 -action_7 (22) = happyGoto action_27 -action_7 (24) = happyGoto action_28 -action_7 _ = happyFail (happyExpListPerState 7) - -action_8 (43) = happyShift action_13 -action_8 (15) = happyGoto action_21 -action_8 (25) = happyGoto action_22 -action_8 _ = happyFail (happyExpListPerState 8) - -action_9 (44) = happyShift action_20 -action_9 (16) = happyGoto action_18 -action_9 (26) = happyGoto action_19 -action_9 _ = happyFail (happyExpListPerState 9) - -action_10 (42) = happyShift action_17 -action_10 (27) = happyGoto action_16 -action_10 _ = happyFail (happyExpListPerState 10) - -action_11 (43) = happyShift action_13 -action_11 (15) = happyGoto action_14 -action_11 (28) = happyGoto action_15 -action_11 _ = happyReduce_33 - -action_12 (43) = happyShift action_13 -action_12 _ = happyFail (happyExpListPerState 12) - -action_13 _ = happyReduce_12 - -action_14 (31) = happyShift action_53 -action_14 _ = happyReduce_34 - -action_15 (45) = happyAccept -action_15 _ = happyFail (happyExpListPerState 15) - -action_16 (45) = happyAccept -action_16 _ = happyFail (happyExpListPerState 16) - -action_17 (43) = happyShift action_13 -action_17 (15) = happyGoto action_14 -action_17 (28) = happyGoto action_52 -action_17 _ = happyReduce_33 - -action_18 (35) = happyShift action_51 -action_18 _ = happyFail (happyExpListPerState 18) - -action_19 (45) = happyAccept -action_19 _ = happyFail (happyExpListPerState 19) - -action_20 _ = happyReduce_13 - -action_21 _ = happyReduce_30 - -action_22 (45) = happyAccept -action_22 _ = happyFail (happyExpListPerState 22) - -action_23 _ = happyReduce_23 - -action_24 (35) = happyShift action_50 -action_24 _ = happyFail (happyExpListPerState 24) - -action_25 _ = happyReduce_29 - -action_26 (29) = happyShift action_29 -action_26 (43) = happyShift action_13 -action_26 (44) = happyShift action_20 -action_26 (15) = happyGoto action_23 -action_26 (16) = happyGoto action_24 -action_26 (22) = happyGoto action_45 -action_26 _ = happyReduce_20 - -action_27 _ = happyReduce_22 - -action_28 (45) = happyAccept -action_28 _ = happyFail (happyExpListPerState 28) - -action_29 (29) = happyShift action_29 -action_29 (39) = happyShift action_30 -action_29 (40) = happyShift action_31 -action_29 (43) = happyShift action_13 -action_29 (44) = happyShift action_20 -action_29 (15) = happyGoto action_23 -action_29 (16) = happyGoto action_24 -action_29 (20) = happyGoto action_49 -action_29 (21) = happyGoto action_26 -action_29 (22) = happyGoto action_27 -action_29 _ = happyFail (happyExpListPerState 29) - -action_30 (43) = happyShift action_13 -action_30 (15) = happyGoto action_21 -action_30 (25) = happyGoto action_48 -action_30 _ = happyFail (happyExpListPerState 30) - -action_31 (43) = happyShift action_13 -action_31 (15) = happyGoto action_21 -action_31 (25) = happyGoto action_47 -action_31 _ = happyFail (happyExpListPerState 31) - -action_32 (31) = happyShift action_46 -action_32 _ = happyReduce_27 - -action_33 (45) = happyAccept -action_33 _ = happyFail (happyExpListPerState 33) - -action_34 (45) = happyAccept -action_34 _ = happyFail (happyExpListPerState 34) - -action_35 (29) = happyShift action_29 -action_35 (43) = happyShift action_13 -action_35 (44) = happyShift action_20 -action_35 (45) = happyAccept -action_35 (15) = happyGoto action_23 -action_35 (16) = happyGoto action_24 -action_35 (22) = happyGoto action_45 -action_35 _ = happyFail (happyExpListPerState 35) - -action_36 (45) = happyAccept -action_36 _ = happyFail (happyExpListPerState 36) - -action_37 (33) = happyShift action_44 -action_37 _ = happyFail (happyExpListPerState 37) - -action_38 (45) = happyAccept -action_38 _ = happyFail (happyExpListPerState 38) - -action_39 (29) = happyShift action_29 -action_39 (39) = happyShift action_30 -action_39 (40) = happyShift action_31 -action_39 (43) = happyShift action_13 -action_39 (44) = happyShift action_20 -action_39 (15) = happyGoto action_23 -action_39 (16) = happyGoto action_24 -action_39 (20) = happyGoto action_43 -action_39 (21) = happyGoto action_26 -action_39 (22) = happyGoto action_27 -action_39 _ = happyFail (happyExpListPerState 39) - -action_40 (45) = happyAccept -action_40 _ = happyFail (happyExpListPerState 40) - -action_41 (45) = happyAccept -action_41 _ = happyFail (happyExpListPerState 41) - -action_42 _ = happyReduce_14 - -action_43 _ = happyReduce_15 - -action_44 (37) = happyShift action_39 -action_44 (18) = happyGoto action_37 -action_44 (19) = happyGoto action_62 -action_44 _ = happyReduce_16 - -action_45 _ = happyReduce_21 - -action_46 (29) = happyShift action_29 -action_46 (39) = happyShift action_30 -action_46 (40) = happyShift action_31 -action_46 (43) = happyShift action_13 -action_46 (44) = happyShift action_20 -action_46 (15) = happyGoto action_23 -action_46 (16) = happyGoto action_24 -action_46 (20) = happyGoto action_32 -action_46 (21) = happyGoto action_26 -action_46 (22) = happyGoto action_27 -action_46 (23) = happyGoto action_61 -action_46 _ = happyReduce_26 - -action_47 (32) = happyShift action_60 -action_47 _ = happyFail (happyExpListPerState 47) - -action_48 (34) = happyShift action_59 -action_48 _ = happyFail (happyExpListPerState 48) - -action_49 (30) = happyShift action_58 -action_49 _ = happyFail (happyExpListPerState 49) - -action_50 (29) = happyShift action_29 -action_50 (39) = happyShift action_30 -action_50 (40) = happyShift action_31 -action_50 (43) = happyShift action_13 -action_50 (44) = happyShift action_20 -action_50 (15) = happyGoto action_23 -action_50 (16) = happyGoto action_24 -action_50 (20) = happyGoto action_32 -action_50 (21) = happyGoto action_26 -action_50 (22) = happyGoto action_27 -action_50 (23) = happyGoto action_57 -action_50 _ = happyReduce_26 - -action_51 (43) = happyShift action_13 -action_51 (15) = happyGoto action_14 -action_51 (28) = happyGoto action_56 -action_51 _ = happyReduce_33 - -action_52 (32) = happyShift action_55 -action_52 _ = happyFail (happyExpListPerState 52) - -action_53 (43) = happyShift action_13 -action_53 (15) = happyGoto action_14 -action_53 (28) = happyGoto action_54 -action_53 _ = happyReduce_33 - -action_54 _ = happyReduce_35 - -action_55 (29) = happyShift action_29 -action_55 (39) = happyShift action_30 -action_55 (40) = happyShift action_31 -action_55 (43) = happyShift action_13 -action_55 (44) = happyShift action_20 -action_55 (15) = happyGoto action_23 -action_55 (16) = happyGoto action_24 -action_55 (20) = happyGoto action_25 -action_55 (21) = happyGoto action_26 -action_55 (22) = happyGoto action_27 -action_55 (24) = happyGoto action_67 -action_55 _ = happyFail (happyExpListPerState 55) - -action_56 (36) = happyShift action_66 -action_56 _ = happyFail (happyExpListPerState 56) - -action_57 (36) = happyShift action_65 -action_57 _ = happyFail (happyExpListPerState 57) - -action_58 _ = happyReduce_25 - -action_59 (29) = happyShift action_29 -action_59 (39) = happyShift action_30 -action_59 (40) = happyShift action_31 -action_59 (43) = happyShift action_13 -action_59 (44) = happyShift action_20 -action_59 (15) = happyGoto action_23 -action_59 (16) = happyGoto action_24 -action_59 (20) = happyGoto action_64 -action_59 (21) = happyGoto action_26 -action_59 (22) = happyGoto action_27 -action_59 _ = happyFail (happyExpListPerState 59) - -action_60 (29) = happyShift action_29 -action_60 (39) = happyShift action_30 -action_60 (40) = happyShift action_31 -action_60 (43) = happyShift action_13 -action_60 (44) = happyShift action_20 -action_60 (15) = happyGoto action_23 -action_60 (16) = happyGoto action_24 -action_60 (20) = happyGoto action_25 -action_60 (21) = happyGoto action_26 -action_60 (22) = happyGoto action_27 -action_60 (24) = happyGoto action_63 -action_60 _ = happyFail (happyExpListPerState 60) - -action_61 _ = happyReduce_28 - -action_62 _ = happyReduce_17 - -action_63 _ = happyReduce_18 - -action_64 (38) = happyShift action_70 -action_64 _ = happyFail (happyExpListPerState 64) - -action_65 _ = happyReduce_24 - -action_66 (41) = happyShift action_69 -action_66 _ = happyFail (happyExpListPerState 66) - -action_67 (34) = happyShift action_68 -action_67 _ = happyFail (happyExpListPerState 67) - -action_68 (29) = happyShift action_29 -action_68 (39) = happyShift action_30 -action_68 (40) = happyShift action_31 -action_68 (43) = happyShift action_13 -action_68 (44) = happyShift action_20 -action_68 (15) = happyGoto action_23 -action_68 (16) = happyGoto action_24 -action_68 (20) = happyGoto action_25 -action_68 (21) = happyGoto action_26 -action_68 (22) = happyGoto action_27 -action_68 (24) = happyGoto action_73 -action_68 _ = happyFail (happyExpListPerState 68) - -action_69 (29) = happyShift action_29 -action_69 (39) = happyShift action_30 -action_69 (40) = happyShift action_31 -action_69 (43) = happyShift action_13 -action_69 (44) = happyShift action_20 -action_69 (15) = happyGoto action_23 -action_69 (16) = happyGoto action_24 -action_69 (20) = happyGoto action_25 -action_69 (21) = happyGoto action_26 -action_69 (22) = happyGoto action_27 -action_69 (24) = happyGoto action_72 -action_69 _ = happyFail (happyExpListPerState 69) - -action_70 (29) = happyShift action_29 -action_70 (39) = happyShift action_30 -action_70 (40) = happyShift action_31 -action_70 (43) = happyShift action_13 -action_70 (44) = happyShift action_20 -action_70 (15) = happyGoto action_23 -action_70 (16) = happyGoto action_24 -action_70 (20) = happyGoto action_25 -action_70 (21) = happyGoto action_26 -action_70 (22) = happyGoto action_27 -action_70 (24) = happyGoto action_71 -action_70 _ = happyFail (happyExpListPerState 70) - -action_71 _ = happyReduce_19 - -action_72 _ = happyReduce_31 - -action_73 _ = happyReduce_32 - -happyReduce_12 = happySpecReduce_1 15 happyReduction_12 +happyActOffsets :: HappyAddr +happyActOffsets = HappyA# "\xf8\xff\xff\xff\xf8\xff\xff\xff\xf8\xff\xff\xff\x08\x00\x00\x00\x06\x00\x00\x00\x06\x00\x00\x00\x08\x00\x00\x00\x08\x00\x00\x00\xf4\xff\xff\xff\xf6\xff\xff\xff\xfa\xff\xff\xff\x19\x00\x00\x00\x19\x00\x00\x00\x00\x00\x00\x00\x1b\x00\x00\x00\x23\x00\x00\x00\x23\x00\x00\x00\x29\x00\x00\x00\x32\x00\x00\x00\x2d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2d\x00\x00\x00\x00\x00\x00\x00\x33\x00\x00\x00\x00\x00\x00\x00\x06\x00\x00\x00\x00\x00\x00\x00\x31\x00\x00\x00\x08\x00\x00\x00\x34\x00\x00\x00\x34\x00\x00\x00\x41\x00\x00\x00\x37\x00\x00\x00\x37\x00\x00\x00\x01\x00\x00\x00\x37\x00\x00\x00\x47\x00\x00\x00\x3c\x00\x00\x00\x08\x00\x00\x00\x3c\x00\x00\x00\x3c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x27\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x4e\x00\x00\x00\x48\x00\x00\x00\x55\x00\x00\x00\x08\x00\x00\x00\x49\x00\x00\x00\x52\x00\x00\x00\x4d\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x58\x00\x00\x00\x59\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5c\x00\x00\x00\x00\x00\x00\x00\x5d\x00\x00\x00\x65\x00\x00\x00\x08\x00\x00\x00\x08\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"# + +happyGotoOffsets :: HappyAddr +happyGotoOffsets = HappyA# "\x22\x00\x00\x00\x5f\x00\x00\x00\x1f\x00\x00\x00\x83\x00\x00\x00\x04\x00\x00\x00\x99\x00\x00\x00\x68\x00\x00\x00\x2c\x00\x00\x00\x1d\x00\x00\x00\x1e\x00\x00\x00\x60\x00\x00\x00\x0c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x9b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x86\x00\x00\x00\x20\x00\x00\x00\x21\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x9b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x8e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x71\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7a\x00\x00\x00\x0e\x00\x00\x00\x00\x00\x00\x00\x0f\x00\x00\x00\x00\x00\x00\x00\x36\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x91\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x00\x00\x54\x00\x00\x00\x5e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"# + +happyAdjustOffset :: Happy_GHC_Exts.Int# -> Happy_GHC_Exts.Int# +happyAdjustOffset off = off + +happyDefActions :: HappyAddr +happyDefActions = HappyA# "\xef\xff\xff\xff\x00\x00\x00\x00\xef\xff\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe5\xff\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xde\xff\xff\xff\x00\x00\x00\x00\xf3\xff\xff\xff\xdd\xff\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\xde\xff\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\xf2\xff\xff\xff\xe1\xff\xff\xff\x00\x00\x00\x00\xe8\xff\xff\xff\x00\x00\x00\x00\xe2\xff\xff\xff\xeb\xff\xff\xff\xe9\xff\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe4\xff\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf1\xff\xff\xff\xf0\xff\xff\xff\xef\xff\xff\xff\xea\xff\xff\xff\xe5\xff\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe5\xff\xff\xff\xde\xff\xff\xff\x00\x00\x00\x00\xde\xff\xff\xff\xdc\xff\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe6\xff\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\xe3\xff\xff\xff\xee\xff\xff\xff\xed\xff\xff\xff\x00\x00\x00\x00\xe7\xff\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xec\xff\xff\xff\xe0\xff\xff\xff\xdf\xff\xff\xff"# + +happyCheck :: HappyAddr +happyCheck = HappyA# "\xff\xff\xff\xff\x09\x00\x00\x00\x01\x00\x00\x00\x0f\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x10\x00\x00\x00\x01\x00\x00\x00\x0e\x00\x00\x00\x01\x00\x00\x00\x06\x00\x00\x00\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0f\x00\x00\x00\x10\x00\x00\x00\x11\x00\x00\x00\x0b\x00\x00\x00\x0c\x00\x00\x00\x0f\x00\x00\x00\x10\x00\x00\x00\x0f\x00\x00\x00\x10\x00\x00\x00\x0d\x00\x00\x00\x0d\x00\x00\x00\x0d\x00\x00\x00\x0d\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x04\x00\x00\x00\x02\x00\x00\x00\x03\x00\x00\x00\x04\x00\x00\x00\x0a\x00\x00\x00\x0f\x00\x00\x00\x0b\x00\x00\x00\x0a\x00\x00\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x03\x00\x00\x00\x04\x00\x00\x00\x09\x00\x00\x00\x05\x00\x00\x00\x06\x00\x00\x00\x07\x00\x00\x00\x11\x00\x00\x00\x09\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x0f\x00\x00\x00\x07\x00\x00\x00\x07\x00\x00\x00\x05\x00\x00\x00\x06\x00\x00\x00\x07\x00\x00\x00\x11\x00\x00\x00\x09\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x11\x00\x00\x00\x0f\x00\x00\x00\x03\x00\x00\x00\x05\x00\x00\x00\x06\x00\x00\x00\x07\x00\x00\x00\x11\x00\x00\x00\x09\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x05\x00\x00\x00\x11\x00\x00\x00\x06\x00\x00\x00\x05\x00\x00\x00\x06\x00\x00\x00\x07\x00\x00\x00\x04\x00\x00\x00\x09\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x04\x00\x00\x00\x02\x00\x00\x00\x0f\x00\x00\x00\x05\x00\x00\x00\x06\x00\x00\x00\x07\x00\x00\x00\x0f\x00\x00\x00\x09\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x08\x00\x00\x00\x08\x00\x00\x00\x03\x00\x00\x00\x05\x00\x00\x00\x06\x00\x00\x00\x07\x00\x00\x00\x0a\x00\x00\x00\x09\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x0d\x00\x00\x00\x06\x00\x00\x00\x0c\x00\x00\x00\x05\x00\x00\x00\x06\x00\x00\x00\x07\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x05\x00\x00\x00\x06\x00\x00\x00\x07\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x05\x00\x00\x00\x06\x00\x00\x00\x07\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\xff\xff\xff\xff\x00\x00\x00\x00\x01\x00\x00\x00\x05\x00\x00\x00\x06\x00\x00\x00\x07\x00\x00\x00\x05\x00\x00\x00\x06\x00\x00\x00\x07\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\xff\xff\xff\xff\x00\x00\x00\x00\x01\x00\x00\x00\x05\x00\x00\x00\x06\x00\x00\x00\x07\x00\x00\x00\x05\x00\x00\x00\x06\x00\x00\x00\x07\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x07\x00\x00\x00\xff\xff\xff\xff\x07\x00\x00\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"# + +happyTable :: HappyAddr +happyTable = HappyA# "\x00\x00\x00\x00\x28\x00\x00\x00\x1e\x00\x00\x00\x0e\x00\x00\x00\x17\x00\x00\x00\x18\x00\x00\x00\x15\x00\x00\x00\x1e\x00\x00\x00\x12\x00\x00\x00\x1e\x00\x00\x00\x23\x00\x00\x00\x1b\x00\x00\x00\x0e\x00\x00\x00\x0e\x00\x00\x00\x0e\x00\x00\x00\x0e\x00\x00\x00\x0e\x00\x00\x00\x15\x00\x00\x00\xff\xff\xff\xff\x1f\x00\x00\x00\x20\x00\x00\x00\x0e\x00\x00\x00\x15\x00\x00\x00\x0e\x00\x00\x00\x15\x00\x00\x00\x0f\x00\x00\x00\x34\x00\x00\x00\x38\x00\x00\x00\x36\x00\x00\x00\x15\x00\x00\x00\x36\x00\x00\x00\x12\x00\x00\x00\x15\x00\x00\x00\x15\x00\x00\x00\x25\x00\x00\x00\x26\x00\x00\x00\x29\x00\x00\x00\x25\x00\x00\x00\x2a\x00\x00\x00\x16\x00\x00\x00\x0e\x00\x00\x00\x13\x00\x00\x00\x30\x00\x00\x00\x2f\x00\x00\x00\x17\x00\x00\x00\x18\x00\x00\x00\x25\x00\x00\x00\x3e\x00\x00\x00\x28\x00\x00\x00\x19\x00\x00\x00\x1a\x00\x00\x00\x1b\x00\x00\x00\xff\xff\xff\xff\x1c\x00\x00\x00\x17\x00\x00\x00\x18\x00\x00\x00\x0e\x00\x00\x00\x34\x00\x00\x00\x33\x00\x00\x00\x19\x00\x00\x00\x1a\x00\x00\x00\x1b\x00\x00\x00\xff\xff\xff\xff\x43\x00\x00\x00\x17\x00\x00\x00\x18\x00\x00\x00\xff\xff\xff\xff\x0e\x00\x00\x00\x2f\x00\x00\x00\x19\x00\x00\x00\x1a\x00\x00\x00\x1b\x00\x00\x00\xff\xff\xff\xff\x3f\x00\x00\x00\x17\x00\x00\x00\x18\x00\x00\x00\x2d\x00\x00\x00\xff\xff\xff\xff\x3c\x00\x00\x00\x19\x00\x00\x00\x1a\x00\x00\x00\x1b\x00\x00\x00\x3d\x00\x00\x00\x49\x00\x00\x00\x17\x00\x00\x00\x18\x00\x00\x00\x38\x00\x00\x00\x3b\x00\x00\x00\x0e\x00\x00\x00\x19\x00\x00\x00\x1a\x00\x00\x00\x1b\x00\x00\x00\x0e\x00\x00\x00\x48\x00\x00\x00\x17\x00\x00\x00\x18\x00\x00\x00\x43\x00\x00\x00\x42\x00\x00\x00\x28\x00\x00\x00\x19\x00\x00\x00\x1a\x00\x00\x00\x1b\x00\x00\x00\x47\x00\x00\x00\x47\x00\x00\x00\x17\x00\x00\x00\x18\x00\x00\x00\x46\x00\x00\x00\x45\x00\x00\x00\x10\x00\x00\x00\x20\x00\x00\x00\x1a\x00\x00\x00\x1b\x00\x00\x00\x21\x00\x00\x00\x17\x00\x00\x00\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x1a\x00\x00\x00\x1b\x00\x00\x00\x3d\x00\x00\x00\x17\x00\x00\x00\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x1a\x00\x00\x00\x1b\x00\x00\x00\x39\x00\x00\x00\x17\x00\x00\x00\x18\x00\x00\x00\x00\x00\x00\x00\x17\x00\x00\x00\x18\x00\x00\x00\x24\x00\x00\x00\x1a\x00\x00\x00\x1b\x00\x00\x00\x31\x00\x00\x00\x1a\x00\x00\x00\x1b\x00\x00\x00\x17\x00\x00\x00\x18\x00\x00\x00\x00\x00\x00\x00\x17\x00\x00\x00\x18\x00\x00\x00\x2b\x00\x00\x00\x1a\x00\x00\x00\x1b\x00\x00\x00\x40\x00\x00\x00\x1a\x00\x00\x00\x1b\x00\x00\x00\x17\x00\x00\x00\x18\x00\x00\x00\x17\x00\x00\x00\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x22\x00\x00\x00\x00\x00\x00\x00\x2d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\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 (12, 35) [ + (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) + ] + +happy_n_terms = 18 :: Prelude.Int +happy_n_nonterms = 14 :: Prelude.Int + +happyReduce_12 = happySpecReduce_1 0# happyReduction_12 happyReduction_12 (HappyTerminal (PT _ (T_VarIdent happy_var_1))) - = HappyAbsSyn15 - (Language.Lambda.Syntax.Abs.VarIdent happy_var_1 - ) + = HappyAbsSyn15 + (Language.Lambda.Syntax.Abs.VarIdent happy_var_1 + ) happyReduction_12 _ = notHappyAtAll -happyReduce_13 = happySpecReduce_1 16 happyReduction_13 +happyReduce_13 = happySpecReduce_1 1# happyReduction_13 happyReduction_13 (HappyTerminal (PT _ (T_MetaVarIdent happy_var_1))) - = HappyAbsSyn16 - (Language.Lambda.Syntax.Abs.MetaVarIdent happy_var_1 - ) + = HappyAbsSyn16 + (Language.Lambda.Syntax.Abs.MetaVarIdent happy_var_1 + ) happyReduction_13 _ = notHappyAtAll -happyReduce_14 = happySpecReduce_1 17 happyReduction_14 +happyReduce_14 = happySpecReduce_1 2# happyReduction_14 happyReduction_14 (HappyAbsSyn19 happy_var_1) - = HappyAbsSyn17 - (Language.Lambda.Syntax.Abs.AProgram happy_var_1 - ) + = HappyAbsSyn17 + (Language.Lambda.Syntax.Abs.AProgram happy_var_1 + ) happyReduction_14 _ = notHappyAtAll -happyReduce_15 = happySpecReduce_2 18 happyReduction_15 +happyReduce_15 = happySpecReduce_2 3# happyReduction_15 happyReduction_15 (HappyAbsSyn20 happy_var_2) - _ - = HappyAbsSyn18 - (Language.Lambda.Syntax.Abs.CommandCompute happy_var_2 - ) + _ + = HappyAbsSyn18 + (Language.Lambda.Syntax.Abs.CommandCompute happy_var_2 + ) happyReduction_15 _ _ = notHappyAtAll -happyReduce_16 = happySpecReduce_0 19 happyReduction_16 +happyReduce_16 = happySpecReduce_0 4# happyReduction_16 happyReduction_16 = HappyAbsSyn19 - ([] - ) + ([] + ) -happyReduce_17 = happySpecReduce_3 19 happyReduction_17 +happyReduce_17 = happySpecReduce_3 4# happyReduction_17 happyReduction_17 (HappyAbsSyn19 happy_var_3) - _ - (HappyAbsSyn18 happy_var_1) - = HappyAbsSyn19 - ((:) happy_var_1 happy_var_3 - ) + _ + (HappyAbsSyn18 happy_var_1) + = HappyAbsSyn19 + ((:) happy_var_1 happy_var_3 + ) happyReduction_17 _ _ _ = notHappyAtAll -happyReduce_18 = happyReduce 4 20 happyReduction_18 +happyReduce_18 = happyReduce 4# 5# happyReduction_18 happyReduction_18 ((HappyAbsSyn24 happy_var_4) `HappyStk` - _ `HappyStk` - (HappyAbsSyn25 happy_var_2) `HappyStk` - _ `HappyStk` - happyRest) - = HappyAbsSyn20 - (Language.Lambda.Syntax.Abs.Lam happy_var_2 happy_var_4 - ) `HappyStk` happyRest - -happyReduce_19 = happyReduce 6 20 happyReduction_19 + _ `HappyStk` + (HappyAbsSyn25 happy_var_2) `HappyStk` + _ `HappyStk` + happyRest) + = HappyAbsSyn20 + (Language.Lambda.Syntax.Abs.Lam happy_var_2 happy_var_4 + ) `HappyStk` happyRest + +happyReduce_19 = happyReduce 6# 5# happyReduction_19 happyReduction_19 ((HappyAbsSyn24 happy_var_6) `HappyStk` - _ `HappyStk` - (HappyAbsSyn20 happy_var_4) `HappyStk` - _ `HappyStk` - (HappyAbsSyn25 happy_var_2) `HappyStk` - _ `HappyStk` - happyRest) - = HappyAbsSyn20 - (Language.Lambda.Syntax.Abs.Let happy_var_2 happy_var_4 happy_var_6 - ) `HappyStk` happyRest - -happyReduce_20 = happySpecReduce_1 20 happyReduction_20 + _ `HappyStk` + (HappyAbsSyn20 happy_var_4) `HappyStk` + _ `HappyStk` + (HappyAbsSyn25 happy_var_2) `HappyStk` + _ `HappyStk` + happyRest) + = HappyAbsSyn20 + (Language.Lambda.Syntax.Abs.Let happy_var_2 happy_var_4 happy_var_6 + ) `HappyStk` happyRest + +happyReduce_20 = happySpecReduce_1 5# happyReduction_20 happyReduction_20 (HappyAbsSyn20 happy_var_1) - = HappyAbsSyn20 - (happy_var_1 - ) + = HappyAbsSyn20 + (happy_var_1 + ) happyReduction_20 _ = notHappyAtAll -happyReduce_21 = happySpecReduce_2 21 happyReduction_21 +happyReduce_21 = happySpecReduce_2 6# happyReduction_21 happyReduction_21 (HappyAbsSyn20 happy_var_2) - (HappyAbsSyn20 happy_var_1) - = HappyAbsSyn20 - (Language.Lambda.Syntax.Abs.App happy_var_1 happy_var_2 - ) + (HappyAbsSyn20 happy_var_1) + = HappyAbsSyn20 + (Language.Lambda.Syntax.Abs.App happy_var_1 happy_var_2 + ) happyReduction_21 _ _ = notHappyAtAll -happyReduce_22 = happySpecReduce_1 21 happyReduction_22 +happyReduce_22 = happySpecReduce_1 6# happyReduction_22 happyReduction_22 (HappyAbsSyn20 happy_var_1) - = HappyAbsSyn20 - (happy_var_1 - ) + = HappyAbsSyn20 + (happy_var_1 + ) happyReduction_22 _ = notHappyAtAll -happyReduce_23 = happySpecReduce_1 22 happyReduction_23 +happyReduce_23 = happySpecReduce_1 7# happyReduction_23 happyReduction_23 (HappyAbsSyn15 happy_var_1) - = HappyAbsSyn20 - (Language.Lambda.Syntax.Abs.Var happy_var_1 - ) + = HappyAbsSyn20 + (Language.Lambda.Syntax.Abs.Var happy_var_1 + ) happyReduction_23 _ = notHappyAtAll -happyReduce_24 = happyReduce 4 22 happyReduction_24 +happyReduce_24 = happyReduce 4# 7# happyReduction_24 happyReduction_24 (_ `HappyStk` - (HappyAbsSyn23 happy_var_3) `HappyStk` - _ `HappyStk` - (HappyAbsSyn16 happy_var_1) `HappyStk` - happyRest) - = HappyAbsSyn20 - (Language.Lambda.Syntax.Abs.MetaVar happy_var_1 happy_var_3 - ) `HappyStk` happyRest - -happyReduce_25 = happySpecReduce_3 22 happyReduction_25 + (HappyAbsSyn23 happy_var_3) `HappyStk` + _ `HappyStk` + (HappyAbsSyn16 happy_var_1) `HappyStk` + happyRest) + = HappyAbsSyn20 + (Language.Lambda.Syntax.Abs.MetaVar happy_var_1 happy_var_3 + ) `HappyStk` happyRest + +happyReduce_25 = happySpecReduce_3 7# happyReduction_25 happyReduction_25 _ - (HappyAbsSyn20 happy_var_2) - _ - = HappyAbsSyn20 - (happy_var_2 - ) + (HappyAbsSyn20 happy_var_2) + _ + = HappyAbsSyn20 + (happy_var_2 + ) happyReduction_25 _ _ _ = notHappyAtAll -happyReduce_26 = happySpecReduce_0 23 happyReduction_26 +happyReduce_26 = happySpecReduce_0 8# happyReduction_26 happyReduction_26 = HappyAbsSyn23 - ([] - ) + ([] + ) -happyReduce_27 = happySpecReduce_1 23 happyReduction_27 +happyReduce_27 = happySpecReduce_1 8# happyReduction_27 happyReduction_27 (HappyAbsSyn20 happy_var_1) - = HappyAbsSyn23 - ((:[]) happy_var_1 - ) + = HappyAbsSyn23 + ((:[]) happy_var_1 + ) happyReduction_27 _ = notHappyAtAll -happyReduce_28 = happySpecReduce_3 23 happyReduction_28 +happyReduce_28 = happySpecReduce_3 8# happyReduction_28 happyReduction_28 (HappyAbsSyn23 happy_var_3) - _ - (HappyAbsSyn20 happy_var_1) - = HappyAbsSyn23 - ((:) happy_var_1 happy_var_3 - ) + _ + (HappyAbsSyn20 happy_var_1) + = HappyAbsSyn23 + ((:) happy_var_1 happy_var_3 + ) happyReduction_28 _ _ _ = notHappyAtAll -happyReduce_29 = happySpecReduce_1 24 happyReduction_29 +happyReduce_29 = happySpecReduce_1 9# happyReduction_29 happyReduction_29 (HappyAbsSyn20 happy_var_1) - = HappyAbsSyn24 - (Language.Lambda.Syntax.Abs.AScopedTerm happy_var_1 - ) + = HappyAbsSyn24 + (Language.Lambda.Syntax.Abs.AScopedTerm happy_var_1 + ) happyReduction_29 _ = notHappyAtAll -happyReduce_30 = happySpecReduce_1 25 happyReduction_30 +happyReduce_30 = happySpecReduce_1 10# happyReduction_30 happyReduction_30 (HappyAbsSyn15 happy_var_1) - = HappyAbsSyn25 - (Language.Lambda.Syntax.Abs.APattern happy_var_1 - ) + = HappyAbsSyn25 + (Language.Lambda.Syntax.Abs.APattern happy_var_1 + ) happyReduction_30 _ = notHappyAtAll -happyReduce_31 = happyReduce 6 26 happyReduction_31 +happyReduce_31 = happyReduce 6# 11# happyReduction_31 happyReduction_31 ((HappyAbsSyn24 happy_var_6) `HappyStk` - _ `HappyStk` - _ `HappyStk` - (HappyAbsSyn28 happy_var_3) `HappyStk` - _ `HappyStk` - (HappyAbsSyn16 happy_var_1) `HappyStk` - happyRest) - = HappyAbsSyn26 - (Language.Lambda.Syntax.Abs.AMetaSubst happy_var_1 happy_var_3 happy_var_6 - ) `HappyStk` happyRest - -happyReduce_32 = happyReduce 6 27 happyReduction_32 + _ `HappyStk` + _ `HappyStk` + (HappyAbsSyn28 happy_var_3) `HappyStk` + _ `HappyStk` + (HappyAbsSyn16 happy_var_1) `HappyStk` + happyRest) + = HappyAbsSyn26 + (Language.Lambda.Syntax.Abs.AMetaSubst happy_var_1 happy_var_3 happy_var_6 + ) `HappyStk` happyRest + +happyReduce_32 = happyReduce 6# 12# happyReduction_32 happyReduction_32 ((HappyAbsSyn24 happy_var_6) `HappyStk` - _ `HappyStk` - (HappyAbsSyn24 happy_var_4) `HappyStk` - _ `HappyStk` - (HappyAbsSyn28 happy_var_2) `HappyStk` - _ `HappyStk` - happyRest) - = HappyAbsSyn27 - (Language.Lambda.Syntax.Abs.AUnificationConstraint happy_var_2 happy_var_4 happy_var_6 - ) `HappyStk` happyRest - -happyReduce_33 = happySpecReduce_0 28 happyReduction_33 + _ `HappyStk` + (HappyAbsSyn24 happy_var_4) `HappyStk` + _ `HappyStk` + (HappyAbsSyn28 happy_var_2) `HappyStk` + _ `HappyStk` + happyRest) + = HappyAbsSyn27 + (Language.Lambda.Syntax.Abs.AUnificationConstraint happy_var_2 happy_var_4 happy_var_6 + ) `HappyStk` happyRest + +happyReduce_33 = happySpecReduce_0 13# happyReduction_33 happyReduction_33 = HappyAbsSyn28 - ([] - ) + ([] + ) -happyReduce_34 = happySpecReduce_1 28 happyReduction_34 +happyReduce_34 = happySpecReduce_1 13# happyReduction_34 happyReduction_34 (HappyAbsSyn15 happy_var_1) - = HappyAbsSyn28 - ((:[]) happy_var_1 - ) + = HappyAbsSyn28 + ((:[]) happy_var_1 + ) happyReduction_34 _ = notHappyAtAll -happyReduce_35 = happySpecReduce_3 28 happyReduction_35 +happyReduce_35 = happySpecReduce_3 13# happyReduction_35 happyReduction_35 (HappyAbsSyn28 happy_var_3) - _ - (HappyAbsSyn15 happy_var_1) - = HappyAbsSyn28 - ((:) happy_var_1 happy_var_3 - ) + _ + (HappyAbsSyn15 happy_var_1) + = HappyAbsSyn28 + ((:) happy_var_1 happy_var_3 + ) happyReduction_35 _ _ _ = notHappyAtAll happyNewToken action sts stk [] = - action 45 45 notHappyAtAll (HappyState action) sts stk [] + happyDoAction 17# notHappyAtAll action sts stk [] happyNewToken action sts stk (tk:tks) = - let cont i = action i i tk (HappyState action) sts stk tks in - case tk of { - PT _ (TS _ 1) -> cont 29; - PT _ (TS _ 2) -> cont 30; - PT _ (TS _ 3) -> cont 31; - PT _ (TS _ 4) -> cont 32; - PT _ (TS _ 5) -> cont 33; - PT _ (TS _ 6) -> cont 34; - PT _ (TS _ 7) -> cont 35; - PT _ (TS _ 8) -> cont 36; - PT _ (TS _ 9) -> cont 37; - PT _ (TS _ 10) -> cont 38; - PT _ (TS _ 11) -> cont 39; - PT _ (TS _ 12) -> cont 40; - PT _ (TS _ 13) -> cont 41; - PT _ (TS _ 14) -> cont 42; - PT _ (T_VarIdent happy_dollar_dollar) -> cont 43; - PT _ (T_MetaVarIdent happy_dollar_dollar) -> cont 44; - _ -> happyError' ((tk:tks), []) - } - -happyError_ explist 45 tk tks = happyError' (tks, explist) + let cont i = happyDoAction i tk action sts stk tks in + case tk of { + PT _ (TS _ 1) -> cont 1#; + PT _ (TS _ 2) -> cont 2#; + PT _ (TS _ 3) -> cont 3#; + PT _ (TS _ 4) -> cont 4#; + PT _ (TS _ 5) -> cont 5#; + PT _ (TS _ 6) -> cont 6#; + PT _ (TS _ 7) -> cont 7#; + PT _ (TS _ 8) -> cont 8#; + PT _ (TS _ 9) -> cont 9#; + PT _ (TS _ 10) -> cont 10#; + PT _ (TS _ 11) -> cont 11#; + PT _ (TS _ 12) -> cont 12#; + PT _ (TS _ 13) -> cont 13#; + PT _ (TS _ 14) -> cont 14#; + PT _ (T_VarIdent happy_dollar_dollar) -> cont 15#; + PT _ (T_MetaVarIdent happy_dollar_dollar) -> cont 16#; + _ -> happyError' ((tk:tks), []) + } + +happyError_ explist 17# tk tks = happyError' (tks, explist) happyError_ explist _ tk tks = happyError' ((tk:tks), explist) happyThen :: () => Err a -> (a -> Err b) -> Err b @@ -798,40 +352,40 @@ happyReturn1 = \a tks -> (return) a happyError' :: () => ([(Token)], [Prelude.String]) -> Err a happyError' = (\(tokens, _) -> happyError tokens) pProgram tks = happySomeParser where - happySomeParser = happyThen (happyParse action_0 tks) (\x -> case x of {HappyAbsSyn17 z -> happyReturn z; _other -> notHappyAtAll }) + happySomeParser = happyThen (happyParse 0# tks) (\x -> case x of {HappyAbsSyn17 z -> happyReturn z; _other -> notHappyAtAll }) pCommand tks = happySomeParser where - happySomeParser = happyThen (happyParse action_1 tks) (\x -> case x of {HappyAbsSyn18 z -> happyReturn z; _other -> notHappyAtAll }) + happySomeParser = happyThen (happyParse 1# tks) (\x -> case x of {HappyAbsSyn18 z -> happyReturn z; _other -> notHappyAtAll }) pListCommand tks = happySomeParser where - happySomeParser = happyThen (happyParse action_2 tks) (\x -> case x of {HappyAbsSyn19 z -> happyReturn z; _other -> notHappyAtAll }) + happySomeParser = happyThen (happyParse 2# tks) (\x -> case x of {HappyAbsSyn19 z -> happyReturn z; _other -> notHappyAtAll }) pTerm tks = happySomeParser where - happySomeParser = happyThen (happyParse action_3 tks) (\x -> case x of {HappyAbsSyn20 z -> happyReturn z; _other -> notHappyAtAll }) + happySomeParser = happyThen (happyParse 3# tks) (\x -> case x of {HappyAbsSyn20 z -> happyReturn z; _other -> notHappyAtAll }) pTerm1 tks = happySomeParser where - happySomeParser = happyThen (happyParse action_4 tks) (\x -> case x of {HappyAbsSyn20 z -> happyReturn z; _other -> notHappyAtAll }) + happySomeParser = happyThen (happyParse 4# tks) (\x -> case x of {HappyAbsSyn20 z -> happyReturn z; _other -> notHappyAtAll }) pTerm2 tks = happySomeParser where - happySomeParser = happyThen (happyParse action_5 tks) (\x -> case x of {HappyAbsSyn20 z -> happyReturn z; _other -> notHappyAtAll }) + happySomeParser = happyThen (happyParse 5# tks) (\x -> case x of {HappyAbsSyn20 z -> happyReturn z; _other -> notHappyAtAll }) pListTerm tks = happySomeParser where - happySomeParser = happyThen (happyParse action_6 tks) (\x -> case x of {HappyAbsSyn23 z -> happyReturn z; _other -> notHappyAtAll }) + happySomeParser = happyThen (happyParse 6# tks) (\x -> case x of {HappyAbsSyn23 z -> happyReturn z; _other -> notHappyAtAll }) pScopedTerm tks = happySomeParser where - happySomeParser = happyThen (happyParse action_7 tks) (\x -> case x of {HappyAbsSyn24 z -> happyReturn z; _other -> notHappyAtAll }) + happySomeParser = happyThen (happyParse 7# tks) (\x -> case x of {HappyAbsSyn24 z -> happyReturn z; _other -> notHappyAtAll }) pPattern tks = happySomeParser where - happySomeParser = happyThen (happyParse action_8 tks) (\x -> case x of {HappyAbsSyn25 z -> happyReturn z; _other -> notHappyAtAll }) + happySomeParser = happyThen (happyParse 8# tks) (\x -> case x of {HappyAbsSyn25 z -> happyReturn z; _other -> notHappyAtAll }) pMetaSubst tks = happySomeParser where - happySomeParser = happyThen (happyParse action_9 tks) (\x -> case x of {HappyAbsSyn26 z -> happyReturn z; _other -> notHappyAtAll }) + happySomeParser = happyThen (happyParse 9# tks) (\x -> case x of {HappyAbsSyn26 z -> happyReturn z; _other -> notHappyAtAll }) pUnificationConstraint tks = happySomeParser where - happySomeParser = happyThen (happyParse action_10 tks) (\x -> case x of {HappyAbsSyn27 z -> happyReturn z; _other -> notHappyAtAll }) + happySomeParser = happyThen (happyParse 10# tks) (\x -> case x of {HappyAbsSyn27 z -> happyReturn z; _other -> notHappyAtAll }) pListVarIdent tks = happySomeParser where - happySomeParser = happyThen (happyParse action_11 tks) (\x -> case x of {HappyAbsSyn28 z -> happyReturn z; _other -> notHappyAtAll }) + happySomeParser = happyThen (happyParse 11# tks) (\x -> case x of {HappyAbsSyn28 z -> happyReturn z; _other -> notHappyAtAll }) happySeq = happyDontSeq @@ -848,90 +402,53 @@ happyError ts = Left $ myLexer :: String -> [Token] myLexer = tokens -{-# LINE 1 "templates/GenericTemplate.hs" #-} -- $Id: GenericTemplate.hs,v 1.26 2005/01/14 14:47:22 simonmar Exp $ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -data Happy_IntList = HappyCons Prelude.Int Happy_IntList - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +#if !defined(__GLASGOW_HASKELL__) +# error This code isn't being built with GHC. +#endif + +-- Get WORDS_BIGENDIAN (if defined) +#include "MachDeps.h" + +-- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex. +#if __GLASGOW_HASKELL__ > 706 +# define LT(n,m) ((Happy_GHC_Exts.tagToEnum# (n Happy_GHC_Exts.<# m)) :: Prelude.Bool) +# define GTE(n,m) ((Happy_GHC_Exts.tagToEnum# (n Happy_GHC_Exts.>=# m)) :: Prelude.Bool) +# define EQ(n,m) ((Happy_GHC_Exts.tagToEnum# (n Happy_GHC_Exts.==# m)) :: Prelude.Bool) +#else +# define LT(n,m) (n Happy_GHC_Exts.<# m) +# define GTE(n,m) (n Happy_GHC_Exts.>=# m) +# define EQ(n,m) (n Happy_GHC_Exts.==# m) +#endif +#define PLUS(n,m) (n Happy_GHC_Exts.+# m) +#define MINUS(n,m) (n Happy_GHC_Exts.-# m) +#define TIMES(n,m) (n Happy_GHC_Exts.*# m) +#define NEGATE(n) (Happy_GHC_Exts.negateInt# (n)) + +type Happy_Int = Happy_GHC_Exts.Int# +data Happy_IntList = HappyCons Happy_Int Happy_IntList + +#define ERROR_TOK 0# + +#if defined(HAPPY_COERCE) +# define GET_ERROR_TOKEN(x) (case Happy_GHC_Exts.unsafeCoerce# x of { (Happy_GHC_Exts.I# i) -> i }) +# define MK_ERROR_TOKEN(i) (Happy_GHC_Exts.unsafeCoerce# (Happy_GHC_Exts.I# i)) +# define MK_TOKEN(x) (happyInTok (x)) +#else +# define GET_ERROR_TOKEN(x) (case x of { HappyErrorToken (Happy_GHC_Exts.I# i) -> i }) +# define MK_ERROR_TOKEN(i) (HappyErrorToken (Happy_GHC_Exts.I# i)) +# define MK_TOKEN(x) (HappyTerminal (x)) +#endif + +#if defined(HAPPY_DEBUG) +# define DEBUG_TRACE(s) (happyTrace (s)) $ +happyTrace string expr = Happy_System_IO_Unsafe.unsafePerformIO $ do + Happy_System_IO.hPutStr Happy_System_IO.stderr string + return expr +#else +# define DEBUG_TRACE(s) {- nothing -} +#endif infixr 9 `HappyStk` data HappyStk a = HappyStk a (HappyStk a) @@ -947,184 +464,175 @@ happyParse start_state = happyNewToken start_state notHappyAtAll notHappyAtAll -- If the current token is ERROR_TOK, it means we've just accepted a partial -- parse (a %partial parser). We must ignore the saved token on the top of -- the stack in this case. -happyAccept (1) tk st sts (_ `HappyStk` ans `HappyStk` _) = +happyAccept ERROR_TOK tk st sts (_ `HappyStk` ans `HappyStk` _) = happyReturn1 ans -happyAccept j tk st sts (HappyStk ans _) = - (happyReturn1 ans) +happyAccept j tk st sts (HappyStk ans _) = + (happyTcHack j (happyTcHack st)) (happyReturn1 ans) ----------------------------------------------------------------------------- -- Arrays only: do the next action - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -indexShortOffAddr arr off = arr Happy_Data_Array.! off - +happyDoAction i tk st = + DEBUG_TRACE("state: " ++ show (Happy_GHC_Exts.I# st) ++ + ",\ttoken: " ++ show (Happy_GHC_Exts.I# i) ++ + ",\taction: ") + case happyDecodeAction (happyNextAction i st) of + HappyFail -> DEBUG_TRACE("failing.\n") + happyFail (happyExpListPerState (Happy_GHC_Exts.I# st)) i tk st + HappyAccept -> DEBUG_TRACE("accept.\n") + happyAccept i tk st + HappyReduce rule -> DEBUG_TRACE("reduce (rule " ++ show (Happy_GHC_Exts.I# rule) ++ ")") + (happyReduceArr Happy_Data_Array.! (Happy_GHC_Exts.I# rule)) i tk st + HappyShift new_state -> DEBUG_TRACE("shift, enter state " ++ show (Happy_GHC_Exts.I# new_state) ++ "\n") + happyShift new_state i tk st + +{-# INLINE happyNextAction #-} +happyNextAction i st = case happyIndexActionTable i st of + Just (Happy_GHC_Exts.I# act) -> act + Nothing -> happyIndexOffAddr happyDefActions st + +{-# INLINE happyIndexActionTable #-} +happyIndexActionTable i st + | GTE(off, 0#), EQ(happyIndexOffAddr happyCheck off, i) + = Prelude.Just (Happy_GHC_Exts.I# (happyIndexOffAddr happyTable off)) + | otherwise + = Prelude.Nothing + where + off = PLUS(happyIndexOffAddr happyActOffsets st, i) + +data HappyAction + = HappyFail + | HappyAccept + | HappyReduce Happy_Int -- rule number + | HappyShift Happy_Int -- new state + +{-# INLINE happyDecodeAction #-} +happyDecodeAction :: Happy_Int -> HappyAction +happyDecodeAction 0# = HappyFail +happyDecodeAction -1# = HappyAccept +happyDecodeAction action | LT(action, 0#) = HappyReduce NEGATE(PLUS(action, 1#)) + | otherwise = HappyShift MINUS(action, 1#) + +{-# INLINE happyIndexGotoTable #-} +happyIndexGotoTable nt st = happyIndexOffAddr happyTable off + where + off = PLUS(happyIndexOffAddr happyGotoOffsets st, nt) + +{-# INLINE happyIndexOffAddr #-} +happyIndexOffAddr :: HappyAddr -> Happy_Int -> Happy_Int +happyIndexOffAddr (HappyA# arr) off = +#if __GLASGOW_HASKELL__ >= 901 + Happy_GHC_Exts.int32ToInt# -- qualified import because it doesn't exist on older GHC's +#endif +#ifdef WORDS_BIGENDIAN + -- The CI of `alex` tests this code path + (Happy_GHC_Exts.word32ToInt32# (Happy_GHC_Exts.wordToWord32# (Happy_GHC_Exts.byteSwap32# (Happy_GHC_Exts.word32ToWord# (Happy_GHC_Exts.int32ToWord32# +#endif + (Happy_GHC_Exts.indexInt32OffAddr# arr off) +#ifdef WORDS_BIGENDIAN + ))))) +#endif {-# INLINE happyLt #-} -happyLt x y = (x Prelude.< y) - - - - - +happyLt x y = LT(x,y) readArrayBit arr bit = - Bits.testBit (indexShortOffAddr arr (bit `Prelude.div` 16)) (bit `Prelude.mod` 16) - - - - - - ------------------------------------------------------------------------------ --- HappyState data type (not arrays) - - - -newtype HappyState b c = HappyState - (Prelude.Int -> -- token number - Prelude.Int -> -- token number (yes, again) - b -> -- token semantic value - HappyState b c -> -- current state - [HappyState b c] -> -- state stack - c) - + Bits.testBit (Happy_GHC_Exts.I# (happyIndexOffAddr arr ((unbox_int bit) `Happy_GHC_Exts.iShiftRA#` 5#))) (bit `Prelude.mod` 32) + where unbox_int (Happy_GHC_Exts.I# x) = x +data HappyAddr = HappyA# Happy_GHC_Exts.Addr# ----------------------------------------------------------------------------- -- Shifting a token -happyShift new_state (1) tk st sts stk@(x `HappyStk` _) = - let i = (case x of { HappyErrorToken (i) -> i }) in --- trace "shifting the error token" $ - new_state i i tk (HappyState (new_state)) ((st):(sts)) (stk) +happyShift new_state ERROR_TOK tk st sts stk@(x `HappyStk` _) = + let i = GET_ERROR_TOKEN(x) in +-- trace "shifting the error token" $ + happyDoAction i tk new_state (HappyCons st sts) stk happyShift new_state i tk st sts stk = - happyNewToken new_state ((st):(sts)) ((HappyTerminal (tk))`HappyStk`stk) + happyNewToken new_state (HappyCons st sts) (MK_TOKEN(tk) `HappyStk` stk) -- happyReduce is specialised for the common cases. -happySpecReduce_0 i fn (1) tk st sts stk - = happyFail [] (1) tk st sts stk -happySpecReduce_0 nt fn j tk st@((HappyState (action))) sts stk - = action nt j tk st ((st):(sts)) (fn `HappyStk` stk) +happySpecReduce_0 i fn ERROR_TOK tk st sts stk + = happyFail [] ERROR_TOK tk st sts stk +happySpecReduce_0 nt fn j tk st sts stk + = happyGoto nt j tk st (HappyCons st sts) (fn `HappyStk` stk) -happySpecReduce_1 i fn (1) tk st sts stk - = happyFail [] (1) tk st sts stk -happySpecReduce_1 nt fn j tk _ sts@(((st@(HappyState (action))):(_))) (v1`HappyStk`stk') +happySpecReduce_1 i fn ERROR_TOK tk st sts stk + = happyFail [] ERROR_TOK tk st sts stk +happySpecReduce_1 nt fn j tk _ sts@(HappyCons st _) (v1 `HappyStk` stk') = let r = fn v1 in - happySeq r (action nt j tk st sts (r `HappyStk` stk')) + happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk')) -happySpecReduce_2 i fn (1) tk st sts stk - = happyFail [] (1) tk st sts stk -happySpecReduce_2 nt fn j tk _ ((_):(sts@(((st@(HappyState (action))):(_))))) (v1`HappyStk`v2`HappyStk`stk') +happySpecReduce_2 i fn ERROR_TOK tk st sts stk + = happyFail [] ERROR_TOK tk st sts stk +happySpecReduce_2 nt fn j tk _ + (HappyCons _ sts@(HappyCons st _)) + (v1 `HappyStk` v2 `HappyStk` stk') = let r = fn v1 v2 in - happySeq r (action nt j tk st sts (r `HappyStk` stk')) + happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk')) -happySpecReduce_3 i fn (1) tk st sts stk - = happyFail [] (1) tk st sts stk -happySpecReduce_3 nt fn j tk _ ((_):(((_):(sts@(((st@(HappyState (action))):(_))))))) (v1`HappyStk`v2`HappyStk`v3`HappyStk`stk') +happySpecReduce_3 i fn ERROR_TOK tk st sts stk + = happyFail [] ERROR_TOK tk st sts stk +happySpecReduce_3 nt fn j tk _ + (HappyCons _ (HappyCons _ sts@(HappyCons st _))) + (v1 `HappyStk` v2 `HappyStk` v3 `HappyStk` stk') = let r = fn v1 v2 v3 in - happySeq r (action nt j tk st sts (r `HappyStk` stk')) + happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk')) -happyReduce k i fn (1) tk st sts stk - = happyFail [] (1) tk st sts stk +happyReduce k i fn ERROR_TOK tk st sts stk + = happyFail [] ERROR_TOK tk st sts stk happyReduce k nt fn j tk st sts stk - = case happyDrop (k Prelude.- ((1) :: Prelude.Int)) sts of - sts1@(((st1@(HappyState (action))):(_))) -> - let r = fn stk in -- it doesn't hurt to always seq here... - happyDoSeq r (action nt j tk st1 sts1 r) + = case happyDrop MINUS(k,(1# :: Happy_Int)) sts of + sts1@(HappyCons st1 _) -> + let r = fn stk in -- it doesn't hurt to always seq here... + happyDoSeq r (happyGoto nt j tk st1 sts1 r) -happyMonadReduce k nt fn (1) tk st sts stk - = happyFail [] (1) tk st sts stk +happyMonadReduce k nt fn ERROR_TOK tk st sts stk + = happyFail [] ERROR_TOK tk st sts stk happyMonadReduce k nt fn j tk st sts stk = - case happyDrop k ((st):(sts)) of - sts1@(((st1@(HappyState (action))):(_))) -> + case happyDrop k (HappyCons st sts) of + sts1@(HappyCons st1 _) -> let drop_stk = happyDropStk k stk in - happyThen1 (fn stk tk) (\r -> action nt j tk st1 sts1 (r `HappyStk` drop_stk)) + happyThen1 (fn stk tk) + (\r -> happyGoto nt j tk st1 sts1 (r `HappyStk` drop_stk)) -happyMonad2Reduce k nt fn (1) tk st sts stk - = happyFail [] (1) tk st sts stk +happyMonad2Reduce k nt fn ERROR_TOK tk st sts stk + = happyFail [] ERROR_TOK tk st sts stk happyMonad2Reduce k nt fn j tk st sts stk = - case happyDrop k ((st):(sts)) of - sts1@(((st1@(HappyState (action))):(_))) -> - let drop_stk = happyDropStk k stk - - - - - - _ = nt :: Prelude.Int - new_state = action - + case happyDrop k (HappyCons st sts) of + sts1@(HappyCons st1 _) -> + let drop_stk = happyDropStk k stk + off = happyAdjustOffset (happyIndexOffAddr happyGotoOffsets st1) + off_i = PLUS(off, nt) + new_state = happyIndexOffAddr happyTable off_i in - happyThen1 (fn stk tk) (\r -> happyNewToken new_state sts1 (r `HappyStk` drop_stk)) + happyThen1 (fn stk tk) + (\r -> happyNewToken new_state sts1 (r `HappyStk` drop_stk)) -happyDrop (0) l = l -happyDrop n ((_):(t)) = happyDrop (n Prelude.- ((1) :: Prelude.Int)) t +happyDrop 0# l = l +happyDrop n (HappyCons _ t) = happyDrop MINUS(n,(1# :: Happy_Int)) t -happyDropStk (0) l = l -happyDropStk n (x `HappyStk` xs) = happyDropStk (n Prelude.- ((1)::Prelude.Int)) xs +happyDropStk 0# l = l +happyDropStk n (x `HappyStk` xs) = happyDropStk MINUS(n,(1#::Happy_Int)) xs ----------------------------------------------------------------------------- -- Moving to a new state after a reduction - - - - - - - - -happyGoto action j tk st = action j j tk (HappyState action) - +happyGoto nt j tk st = + DEBUG_TRACE(", goto state " ++ show (Happy_GHC_Exts.I# new_state) ++ "\n") + happyDoAction j tk new_state + where new_state = happyIndexGotoTable nt st ----------------------------------------------------------------------------- -- Error recovery (ERROR_TOK is the error token) -- parse error if we are in recovery and we fail again -happyFail explist (1) tk old_st _ stk@(x `HappyStk` _) = - let i = (case x of { HappyErrorToken (i) -> i }) in --- trace "failing" $ +happyFail explist ERROR_TOK tk old_st _ stk@(x `HappyStk` _) = + let i = GET_ERROR_TOKEN(x) in +-- trace "failing" $ happyError_ explist i tk {- We don't need state discarding for our restricted implementation of @@ -1132,17 +640,17 @@ happyFail explist (1) tk old_st _ stk@(x `HappyStk` _) = for now --SDM -- discard a state -happyFail ERROR_TOK tk old_st CONS(HAPPYSTATE(action),sts) - (saved_tok `HappyStk` _ `HappyStk` stk) = +happyFail ERROR_TOK tk old_st (HappyCons action sts) + (saved_tok `HappyStk` _ `HappyStk` stk) = -- trace ("discarding state, depth " ++ show (length stk)) $ - DO_ACTION(action,ERROR_TOK,tk,sts,(saved_tok`HappyStk`stk)) + happyDoAction ERROR_TOK tk action sts (saved_tok`HappyStk`stk) -} -- Enter error recovery: generate an error token, -- save the old token and carry on. -happyFail explist i tk (HappyState (action)) sts stk = --- trace "entering error recovery" $ - action (1) (1) tk (HappyState (action)) sts ((HappyErrorToken (i)) `HappyStk` stk) +happyFail explist i tk action sts stk = +-- trace "entering error recovery" $ + happyDoAction ERROR_TOK tk action sts (MK_ERROR_TOKEN(i) `HappyStk` stk) -- Internal happy errors: @@ -1152,14 +660,12 @@ notHappyAtAll = Prelude.error "Internal Happy error\n" ----------------------------------------------------------------------------- -- Hack to get the typechecker to accept our action functions - - - - - +happyTcHack :: Happy_Int -> a -> a +happyTcHack x y = y +{-# INLINE happyTcHack #-} ----------------------------------------------------------------------------- --- Seq-ing. If the --strict flag is given, then Happy emits +-- Seq-ing. If the --strict flag is given, then Happy emits -- happySeq = happyDoSeq -- otherwise it emits -- happySeq = happyDontSeq @@ -1173,13 +679,12 @@ happyDontSeq a b = b -- of deciding to inline happyGoto everywhere, which increases the size of -- the generated parser quite a bit. - - - - - - - +{-# NOINLINE happyDoAction #-} +{-# NOINLINE happyTable #-} +{-# NOINLINE happyCheck #-} +{-# NOINLINE happyActOffsets #-} +{-# NOINLINE happyGotoOffsets #-} +{-# NOINLINE happyDefActions #-} {-# NOINLINE happyShift #-} {-# NOINLINE happySpecReduce_0 #-} diff --git a/stack.yaml b/stack.yaml index db3f891..30cb144 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1,4 +1,4 @@ -resolver: nightly-2024-06-18 +resolver: nightly-2024-10-21 # User packages to be built. # Various formats can be used as shown in the example below. @@ -10,7 +10,7 @@ resolver: nightly-2024-06-18 # - auto-update # - wai packages: -- . + - . # Dependency packages to be pulled from upstream that are not in the resolver. # These entries can reference officially published versions as well as # forks / in-progress versions pinned to a git hash. For example: @@ -21,17 +21,16 @@ packages: # commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a # extra-deps: -- git: https://github.com/fizruk/free-foil.git - commit: 540b7a7f96915e78fa7014398c0eb97a08af23dc - subdirs: - - haskell/free-foil -- kind-generics-th-0.2.3.3@sha256:fc5f3aee46725e048a0159d73612a5d86c30017cd24ebab764347b65cffbd1d4,1519 + - git: https://github.com/fizruk/free-foil.git + commit: b57f37331ff4817b1a29337230711e2a4914fe64 + subdirs: + - haskell/free-foil + - kind-generics-th-0.2.3.3@sha256:fc5f3aee46725e048a0159d73612a5d86c30017cd24ebab764347b65cffbd1d4,1519 # kind-generics-th has an outdated upper bound on template-haskell :( allow-newer: true allow-newer-deps: - kind-generics-th - # Override default flag values for local packages and extra-deps # flags: {} @@ -57,5 +56,5 @@ allow-newer-deps: # compiler-check: newer-minor # If you are not using Nix, run `stack build --no-nix` -nix: - enable: true # false by default, except on NixOS +# nix: +# enable: true # false by default, except on NixOS diff --git a/stack.yaml.lock b/stack.yaml.lock index fcfcff8..fd3a3a4 100644 --- a/stack.yaml.lock +++ b/stack.yaml.lock @@ -5,16 +5,16 @@ packages: - completed: - commit: 540b7a7f96915e78fa7014398c0eb97a08af23dc + commit: b57f37331ff4817b1a29337230711e2a4914fe64 git: https://github.com/fizruk/free-foil.git name: free-foil pantry-tree: - sha256: 5e5883319fe5a47b25a67a08684e9d778be978e77315dd4a943ac743522a61e3 - size: 1820 + sha256: ba4f7b29193d305ad570316dbe90083536e83d1b02454245513b67129df5b78f + size: 2182 subdir: haskell/free-foil - version: 0.1.0 + version: 0.2.0 original: - commit: 540b7a7f96915e78fa7014398c0eb97a08af23dc + commit: b57f37331ff4817b1a29337230711e2a4914fe64 git: https://github.com/fizruk/free-foil.git subdir: haskell/free-foil - completed: @@ -26,7 +26,7 @@ packages: hackage: kind-generics-th-0.2.3.3@sha256:fc5f3aee46725e048a0159d73612a5d86c30017cd24ebab764347b65cffbd1d4,1519 snapshots: - completed: - sha256: 60372fd94e0c083c6484f17181fd5634e530550a14be00a4c032862c514bd802 - size: 650422 - url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/nightly/2024/6/18.yaml - original: nightly-2024-06-18 + sha256: 867086a789eaf6da9f48a56bb5e8bfd6df27b120023c144cc7bbec5c95717915 + size: 669588 + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/nightly/2024/10/21.yaml + original: nightly-2024-10-21