BNFC-meta (empty) → 0.1
raw patch · 23 files changed
+6228/−0 lines, 23 filesdep +alex-metadep +arraydep +basesetup-changed
Dependencies added: alex-meta, array, base, happy-meta, haskell-src-meta, template-haskell, th-lift
Files
- BNFC-meta.cabal +52/−0
- LICENSE +0/−0
- Language/LBNF.hs +206/−0
- Language/LBNF/AbsBNF.hs +122/−0
- Language/LBNF/CF.hs +636/−0
- Language/LBNF/CFtoAbstract.hs +77/−0
- Language/LBNF/CFtoAlex2.hs +315/−0
- Language/LBNF/CFtoHappy.hs +229/−0
- Language/LBNF/CFtoPrinter.hs +154/−0
- Language/LBNF/ErrM.hs +26/−0
- Language/LBNF/GetCF.hs +322/−0
- Language/LBNF/LexBNF.hs +293/−0
- Language/LBNF/LiftBNF.hs +34/−0
- Language/LBNF/ParBNF.hs +3158/−0
- Language/LBNF/PrintPrelude.hs +76/−0
- Language/LBNF/RegToAlex.hs +88/−0
- Language/LBNF/TypeChecker.hs +146/−0
- Language/LBNF/Utils.hs +112/−0
- Setup.lhs +3/−0
- examples/jll/JavaletteLight.hs +59/−0
- examples/jll/UseJll.hs +37/−0
- examples/sql/Sql.hs +70/−0
- examples/sql/UseSql.hs +13/−0
+ BNFC-meta.cabal view
@@ -0,0 +1,52 @@+Name: BNFC-meta+version: 0.1+cabal-Version: >= 1.6+build-type: Simple+license: GPL-2+license-file: LICENSE+author: Jonas Duregård+maintainer: Jonas Duregård (jonas.duregard@chalmers.se)+category: Language+synopsis: Deriving Quasi-Quoters from BNF Grammars+description: This package provides a comfortable way of defining quasi-quoters. + Specifically, given a quasi-quoted LBNF grammar (as used by the BNF Converter) + it generates (using Template Haskell) an LALR parser and pretty pretty printer + for the language. The parser is then used to define a quasi-quoter. With a simple+ pragma, the user can define a universal syntax for anti-quoting. This means that + any grammar non-terminal can be replaced by a quoted Haskell expression of the + appropriate type. A few examples are included in the source tarball.++extra-source-files:+ examples/jll/JavaletteLight.hs+ examples/jll/UseJll.hs+ examples/sql/Sql.hs+ examples/sql/UseSql.hs++Library+ Build-Depends: + base>=4.2&&<5+ , array==0.3.0.*+ , template-haskell >=2.4&&<2.5+ , haskell-src-meta >= 0.1.1 && < 0.2+ , th-lift >=0.5&&<0.6+ , happy-meta+ , alex-meta+ Exposed-modules:+ Language.LBNF+ Other-modules:+ Language.LBNF.AbsBNF+ , Language.LBNF.CF+ , Language.LBNF.CFtoAbstract+ , Language.LBNF.CFtoAlex2+ , Language.LBNF.CFtoHappy + , Language.LBNF.CFtoPrinter+ , Language.LBNF.ErrM+ , Language.LBNF.GetCF+ , Language.LBNF.LiftBNF+ , Language.LBNF.PrintPrelude+ + , Language.LBNF.LexBNF+ , Language.LBNF.ParBNF+ , Language.LBNF.RegToAlex+ , Language.LBNF.TypeChecker+ , Language.LBNF.Utils
+ LICENSE view
+ Language/LBNF.hs view
@@ -0,0 +1,206 @@+{-# LANGUAGE TemplateHaskell #-}++module Language.LBNF (+ compile+ , pp+ , cf, q, qm, Q, errormsg+ , ord, listArray, (!), Err(..), Array, HappyStk(..)+ , Lift (..), Entrypoint(..), Aq(..)+ , module Language.Haskell.Meta.Parse+ , module Language.Haskell.TH.Quote+ + , dumpAlex, dumpHappy+ ) where++import Language.LBNF.CF+import Language.LBNF.CFtoAbstract+import Language.LBNF.CFtoAlex2+import Language.LBNF.CFtoHappy +import Language.LBNF.CFtoPrinter+import Language.LBNF.ErrM+import Language.LBNF.GetCF+import Language.LBNF.LiftBNF()+import Language.LBNF.PrintPrelude++import Language.Haskell.TH+import Language.Haskell.TH.Quote+import Language.Haskell.TH.Syntax+import Language.Haskell.TH.Lift++import Language.Haskell.Meta.Parse++import Text.Happy.Quote+import Text.Alex.Quote++import Data.Array+import Data.Char (ord, toLower)+++cf :: QuasiQuoter +cf = QuasiQuoter cfe cfp where+ cfe s = case getCF s of+ (g,[]) -> lift g+ (_,msgs) -> error $ unlines msgs+ cfp = error "Pattern quoting of grammars is not supported"++qm :: (Entrypoint a, Lift b) => (a -> Q b) -> QuasiQuoter+qm f = QuasiQuoter qExpM (error "Pattern quotes are not supported yet...")+ where+ qExpM s = case parse s of+ Bad e -> error e+ Ok a -> f a >>= lift++q :: (Entrypoint a, Lift b) => (a -> b) -> QuasiQuoter+q f = QuasiQuoter qExp (error "Pattern quotes are not supported yet...")+ where+ qExp s = case parse s of+ Bad e -> error e+ Ok a -> lift $ f a++errormsg :: String -> Q a+errormsg s = error s ++pp :: Print a => a -> String+pp = printTree+class Entrypoint a where+ parse :: String -> Err a++class Aq a where+ aq :: a -> ExpQ+ +compose f g = [|$f . $g|]++compile :: CF -> Q [Dec]+compile g = do + (d1,tokens) <- cf2Abstract g+ d2 <- cf2Printer g+ d3 <- deriveLiftMany' $ map TyConI tokens + dEp <- deriveEps g d1+ dalx <- alexcode g+ dhpy <- happycode g+ return $ d1 + ++ d2+ ++ tokens+ ++ dEp+ ++ dalx + ++ dhpy+ ++ d3++dumpHappy :: CF -> String+dumpHappy = cf2HappyS++dumpAlex :: CF -> String+dumpAlex = cf2alex2++happycode = compileHappy . parseHappy . cf2HappyS++alexcode = compileAlex . parseAlex . cf2alex2++subst _ _ [ ] = []+subst from to xs@(a:as) =+ if isPrefixOf from xs+ then to ++ drop (length from) xs+ else a : subst from to as+ where isPrefixOf as bs = and $ zipWith (==) as bs+++++deriveEps :: CF -> [Dec] -> Q [Dec]+deriveEps cf ds = do+ d1 <- mapM deriveEp eps+ d2 <- maybe (deriveLiftMany' $ map TyConI ds) (deriveAq cf) (aqSyntax cf)+ d3 <- sequence $ concatMap (spliceQQ $ hasAq cf) eps+ return $ d1 ++ d2 ++ d3+ where+ eps = filter isNormal $ allEntryPoints cf+ spliceQQ :: Bool -> String -> [Q Dec]+ spliceQQ aq bs = if aq then maybe ([]) go (unAq bs) else go bs where+ go nam = + [funD (mkName (initLower nam)) [clause [] (normalB + [|q (id :: $(conT typeName) -> $(conT typeName)) |]) []]]+ typeName = mkName bs+++deriveEp s = instanceD (cxt []) (appT (conT ''Entrypoint) (conT $ mkName s)) + [funD 'parse + [clause [] + (normalB $ compose (varE $ mkName $ "p"++s) (varE $ mkName $ "tokens")) []+ ]]++deriveAq cf (_,i,a) = (fmap concat $ sequence $ map deriveAqLift $ cf2data cf) >>= addAq where+ addAq ds = do+ v <- newName "a"+ let nAqToken = mkName "AqToken"+ d <- instanceD + (cxt []) + (appT (conT ''Aq) $ conT nAqToken)+ [funD 'aq [clause [conP nAqToken [varP v]] (normalB $ aqDec (varE v)) []]]+ return $ d:ds+ aqDec v = + [|either error return . parseExp . drop $(lie) . reverse . drop $(lae) . reverse $ $(v)|]+ (lie, lae) = (lift $ length i,lift $ length a)+++deriveAqLift (c,f_cs) = maybe reg aq (unAq c) where + reg = sequence [instanceD (cxt []) (conT ''Lift `appT` typ) [cases >>= funD 'lift ]]+ aq rc = sequence [instanceD (cxt []) (conT ''Lift `appT` typ) [cases >>= funD 'lift ]]+ typ = conT n+ n = mkName c+ cases = do+ s <- newName "s"+ let cons = map doCon f_cs+ return $ cons+++deriveAqSpecialLift s = + instanceD (cxt []) (conT ''Lift `appT` typ) [cases >>= funD 'lift ] where+ typ = conT n+ n = mkName (rename s)+ aqn = mkName (renameAq s)+ cases = do+ v <- newName "l"+ let aqe = [| return (either error id (parseExp $(varE v))) |]+ aq = clause [conP aqn [varP v]] (normalB aqe) []+ con = doConSpec s+ return $ aq : [con]+++doCon :: (String,[String]) -> Q Clause+doCon (fun,cats) = case unAqs fun of+ Just x -> do + v <- newName "l"+ let aqn = mkName fun+ aqe = [|aq $(varE v)|]+ clause [conP aqn [varP v]] (normalB aqe) []+ Nothing -> case unAq fun of+ Nothing -> hlp fun+ Just x -> if x `elem` specialCatsP then doConSpec x else hlp x+ where + hlp real = do+ vs <- mapM newName (map (const "a") cats)+ let c = mkName real+ aqc = mkName fun+ args = [ [| lift $(varE n) |] | n <- vs ]+ e = foldl (\e1 e2 -> [| appE $e1 $e2 |]) [| conE c |] args+ clause [conP aqc (map varP vs)] (normalB e) []++doConSpec :: String -> Q Clause+doConSpec s = do+ v <- newName "a"+ let+ n = mkName (rename s)+ e = case s of + "Integer" -> [| litE (IntegerL $(varE v)) |]+ "Double" -> [| litE (RationalL (toRational $(varE v))) |]+ "String" -> [| litE (StringL $(varE v)) |]+ "Ident" -> [| $(varE $ mkName "lift") $(varE v) |]+ "Char" -> [| litE (charL $(varE v)) |]+ -- _ -> error ( "s )+ clause [conP n [varP v]] (normalB e) []++initLower :: String -> String+initLower [] = error "initLower : Empty list"+initLower (c:cs) = toLower c : cs++
+ Language/LBNF/AbsBNF.hs view
@@ -0,0 +1,122 @@+module Language.LBNF.AbsBNF where + +-- Haskell module generated by the BNF converter + +newtype Ident = Ident String deriving (Eq,Ord,Show) +data LGrammar = + LGr [LDef] + deriving (Eq,Ord,Show) + +data LDef = + DefAll Def + | DefSome [Ident] Def + | LDefView [Ident] + deriving (Eq,Ord,Show) + +data Grammar = + Grammar [Def] + deriving (Eq,Ord,Show) + +data Def = + Rule Label Cat [Item] + | Comment String + | Comments String String + | Internal Label Cat [Item] + | Token Ident Reg + | PosToken Ident Reg + | Entryp [Ident] + | Separator MinimumSize Cat String + | Terminator MinimumSize Cat String + | Coercions Ident Integer + | Rules Ident [RHS] + | Function Ident [Arg] Exp + | External Ident HsTyp + | AntiQuote String String String + | Layout [String] + | LayoutStop [String] + | LayoutTop + deriving (Eq,Ord,Show) + +data Item = + Terminal String + | NTerminal Cat + deriving (Eq,Ord,Show) + +data Cat = + ListCat Cat + | IdCat Ident + deriving (Eq,Ord,Show) + +data Label = + LabNoP LabelId + | LabP LabelId [ProfItem] + | LabPF LabelId LabelId [ProfItem] + | LabF LabelId LabelId + deriving (Eq,Ord,Show) + +data LabelId = + Id Ident + | Wild + | ListE + | ListCons + | ListOne + | Aq + deriving (Eq,Ord,Show) + +data ProfItem = + ProfIt [IntList] [Integer] + deriving (Eq,Ord,Show) + +data IntList = + Ints [Integer] + deriving (Eq,Ord,Show) + +data HsTyp = + HsApp HsTyp HsTyp + | HsCon Ident + | HsTup [HsTyp] + | HsList HsTyp + deriving (Eq,Ord,Show) + +data Arg = + Arg Ident + deriving (Eq,Ord,Show) + +data Exp = + Cons Exp Exp + | App Ident [Exp] + | Var Ident + | LitInt Integer + | LitChar Char + | LitString String + | LitDouble Double + | List [Exp] + deriving (Eq,Ord,Show) + +data RHS = + RHS [Item] + deriving (Eq,Ord,Show) + +data MinimumSize = + MNonempty + | MEmpty + deriving (Eq,Ord,Show) + +data Reg = + RSeq Reg Reg + | RAlt Reg Reg + | RMinus Reg Reg + | RStar Reg + | RPlus Reg + | ROpt Reg + | REps + | RChar Char + | RAlts String + | RSeqs String + | RDigit + | RLetter + | RUpper + | RLower + | RAny + deriving (Eq,Ord,Show) +
+ Language/LBNF/CF.hs view
@@ -0,0 +1,636 @@+{-# OPTIONS -fglasgow-exts #-}+{-+ BNF Converter: Abstract syntax+ Copyright (C) 2004 Author: Markus Forberg, Michael Pellauer, Aarne Ranta++ This program is free software; you can redistribute it and/or modify+ it under the terms of the GNU General Public License as published by+ the Free Software Foundation; either version 2 of the License, or+ (at your option) any later version.++ This program is distributed in the hope that it will be useful,+ but WITHOUT ANY WARRANTY; without even the implied warranty of+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+ GNU General Public License for more details.++ You should have received a copy of the GNU General Public License+ along with this program; if not, write to the Free Software+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA+-}++module Language.LBNF.CF (+ -- Types.+ CF,+ Rule,+ Pragma(..),+ Exp(..),+ Literal,+ Symbol,+ KeyWord,+ Cat,+ Fun,+ Tree(..),+ prTree, -- print an abstract syntax tree+ Data, -- describes the abstract syntax of a grammar+ cf2data, -- translates a grammar to a Data object.+ cf2dataLists, -- translates to a Data with List categories included.+ -- Literal categories, constants,+ firstCat, -- the first value category in the grammar.+ firstEntry, -- the first entry or the first value category+ specialCats, -- ident+ specialCatsP, -- all literals+ specialData, -- special data+ isCoercion, -- wildcards in grammar (avoid syntactic clutter)+ isDefinedRule, -- defined rules (allows syntactic sugar)+ isProperLabel, -- not coercion or defined rule+ allCats, -- all categories of a grammar+ allCatsIdNorm,+ allEntryPoints, -- those categories that are entry points to the parser+ reservedWords, -- get the keywords of a grammar.+ symbols, -- get all symbols+ literals, -- get all literals of a grammar. (e.g. String, Double)+ reversibleCats, -- categories that is left-recursive transformable.+ findAllReversibleCats, -- find all reversible categories+ identCat, -- transforms '[C]' to ListC (others, unchanged).+ valCat, -- The value category of a rule.+ isParsable, -- Checks if the rule is parsable.+ rulesOfCF, -- All rules of a grammar.+ rulesForCat, -- rules for a given category+ ruleGroups, -- Categories are grouped with their rules.+ ruleGroupsInternals, --As above, but includes internal cats.+ funRule, -- The function name of a rule.+ notUniqueFuns, -- Returns a list of function labels that are not unique.+ badInheritence, -- Returns a list of all function labels that can cause problems in languages with inheritence.+ isList, -- Checks if a category is a list category.+ -- Information functions for list functions.+ isNilFun, -- empty list function? ([])+ isOneFun, -- one element list function? (:[])+ isConsFun, -- constructor function? (:)+ isNilCons, -- either three of above?+ isEmptyListCat, -- checks if the list permits []+ revSepListRule, -- reverse a rule, if it is of form C t [C].+ rhsRule, -- The list of Terminals/NonTerminals of a rule.+ normCat, -- Removes precendence information. C1 => C, [C2] => [C]+ normCatOfList, -- Removes precendence information and enclosed List. C1 => C, C2 => C+ catOfList, -- Removes enclosed list: [C1] => C1+ comments, -- translates the pragmas into two list containing the s./m. comments+ tokenPragmas, -- user-defined regular expression tokens+ tokenNames, -- The names of all user-defined tokens+ precCat, -- get the precendence level of a Cat C1 => 1, C => 0+ precLevels, -- get all precendence levels in the grammar, sorted in increasing order.+ precRule, -- get the precendence level of the value category of a rule.+ precCF, -- Check if the CF consists of precendence levels.+ isUsedCat,+ internalCat, -- the symbol #+ isPositionCat, -- category that has a position in AST+ isNormal,+ hasIdent,+ hasLayout,+ hasAq,+ rename,+ renameAq,+ renameAqt,+ unAq,+ unAqs,+ aqSyntax,+ -- resolveAq,+ layoutPragmas,+ checkRule,++ CFP, -- CF with profiles+ RuleP,+ FunP, + Prof,+ cf2cfpRule,+ cf2cfp,+ cfp2cf,+ trivialProf,+ rulesOfCFP,+ funRuleP, ruleGroupsP, allCatsP, allEntryPointsP+ ) where++import Language.LBNF.Utils (prParenth,(+++))+import Data.List (nub, intersperse, partition, sort,sort,group)+import Data.Char+import Language.LBNF.AbsBNF (Reg())++-- A context free grammar consists of a set of rules and some extended +-- information (e.g. pragmas, literals, symbols, keywords)+type CF = (Exts,[Rule])++-- A rule consists of a function name, a main category and a sequence of+-- terminals and non-terminals.+-- function_name . Main_Cat ::= sequence+type Rule = (Fun, (Cat, [Either Cat String]))++-- polymorphic types for common type signatures for CF and CFP+type Rul f = (f, (Cat, [Either Cat String]))+type CFG f = (Exts,[Rul f])++type Exts = ([Pragma],Info)+-- Info is information extracted from the CF, for easy access.+-- Literals - Char, String, Ident, Integer, Double+-- Strings are quoted strings, and Ident are unquoted.+-- Symbols - symbols in the grammar, e.g. ´*´, '->'.+-- KeyWord - reserved words, e.g. 'if' 'while'+type Info = ([Literal],[Symbol],[KeyWord],[Cat])++-- Expressions for function definitions+data Exp = App String [Exp]+ | LitInt Integer+ | LitDouble Double+ | LitChar Char+ | LitString String+ deriving (Eq)++instance Show Exp where+ showsPrec p e =+ case listView e of+ Right es ->+ showString "["+ . foldr (.) id (intersperse (showString ", ") $ map shows es)+ . showString "]"+ Left (App x []) -> showString x+ Left (App "(:)" [e1,e2]) ->+ showParen (p>0)+ $ showsPrec 1 e1+ . showString " : "+ . shows e2+ Left (App x es) ->+ showParen (p>1)+ $ foldr (.) id+ $ intersperse (showString " ")+ $ showString x : map (showsPrec 2) es+ Left (LitInt n) -> shows n+ Left (LitDouble x) -> shows x+ Left (LitChar c) -> shows c+ Left (LitString s) -> shows s+ where+ listView (App "[]" []) = Right []+ listView (App "(:)" [e1,e2])+ | Right es <- listView e2 = Right $ e1:es+ listView e = Left e++-- pragmas for single line comments and for multiple-line comments.+data Pragma = CommentS String + | CommentM (String,String)+ | TokenReg String Bool Reg+ | EntryPoints [Cat]+ | Layout [String]+ | LayoutStop [String]+ | LayoutTop+ | FunDef String [String] Exp+ | AntiQuote String String String+ -- ...+ deriving (Show, Eq)++tokenPragmas :: CFG f -> [(String,Reg)]+tokenPragmas cf = [(name,exp) | TokenReg name _ exp <- pragmasOfCF cf]++tokenNames :: CF -> [String]+tokenNames cf = fst (unzip (tokenPragmas cf))++layoutPragmas :: CF -> (Bool,[String],[String])+layoutPragmas cf = let ps = pragmasOfCF cf in (+ not (null [() | LayoutTop <- ps]), -- if there's layout betw top-level+ concat [ss | Layout ss <- ps], -- layout-block starting words+ concat [ss | LayoutStop ss <- ps] -- layout-block ending words+ )++hasLayout :: CF -> Bool+hasLayout cf = case layoutPragmas cf of+ (t,ws,_) -> t || not (null ws) -- (True,[],_) means: top-level layout only++hasAq :: CF -> Bool+hasAq cf = case [(b,a) | AntiQuote b i a <- pragmasOfCF cf] of+ [] -> False+ _ -> True++aqSyntax :: CF -> Maybe (String,String,String)+aqSyntax cf = case [(b,i,a) | AntiQuote b i a <- pragmasOfCF cf] of+ [] -> Nothing+ [t] -> Just t+ many -> error "aqSyntax: Multiple antiquote pragmas"+{-+resolveAq cf@((ps,(i,t,y,z)),rs0) = maybe cf addAqRules $ aqSyntax cf where+ addAqRules (b,a) = ((map renamePragma ps,(newi,nub $ "[":"]":t,y,(map rename z))),rs) where+ rs = map renameRule (rulesOfCF cf) ++ newRules ++ concat (map newType + newi = nub $ "String":i+ newRules = map mkNewRule $ filter isNormal $ allCats cf+ mkNewRule s = (renameAq s,(rename s,map Right b ++ [Left $ "String"] ++ map Right a))+ renameRule (fun,(cat,itms)) = (rename fun,(rename cat, map renameItem itms))+ renameItem = either (Left . rename) (Right . id)++ renamePragma p = case p of+ EntryPoints cs -> EntryPoints $ map rename cs+ _ -> p+ newType s = [+ (rename s,(rename s,[Left $ s])),+ (s++"__AQ",(rename s,map Right b ++ [Left $ "String"] ++ map Right a))+ ]+-}++rename s = case s of+ "_" -> s+ "#" -> s+ "(:)" -> s+ "(:[])" -> s+ "[]" -> s+ ('[':l) -> '[' : rename (init l) ++ "]" + _ -> "AQ_" ++ normCat s ++ number s++renameAqt s = case s of+ ('[':l) -> '[' : renameAqt (init l) ++ "]"+ _ -> "AQ___" ++ normCat s ++ number s++renameAq s = case s of+ ('[':l) -> '[' : renameAq (init l) ++ "]"+ _ -> "AQ__" ++ normCat s ++ number s++number = reverse . takeWhile isDigit . reverse++unAq s = case s of + 'A':'Q':'_':r -> Just r+ _ -> Nothing ++unAqs s = case s of + 'A':'Q':'_':'_':'_':r -> Just r+ 'A':'Q':'_':'_':r -> Just r+ _ -> Nothing ++-- Literal: Char, String, Ident, Integer, Double+type Literal = Cat+type Symbol = String+type KeyWord = String++-- Cat is the Non-terminals of the grammar.+type Cat = String+-- Fun is the function name of a rule. +type Fun = String++internalCat :: Cat+internalCat = "#"++-- Abstract syntax tree.+newtype Tree = Tree (Fun,[Tree])++-- The abstract syntax of a grammar.+type Data = (Cat, [(Fun,[Cat])])++-- firstCat returns the first Category appearing in the grammar.+firstCat :: CF -> Cat+firstCat = valCat . head . rulesOfCF++firstEntry :: CF -> Cat+firstEntry cf = case allEntryPoints cf of + (x:_) -> x+ _ -> firstCat cf++rulesOfCF :: CF -> [Rule]+rulesOfCF = snd++notUniqueFuns :: CF -> [Fun]+notUniqueFuns cf = let xss = group $ sort [ f | (f,_) <- rulesOfCF cf,+ not (isNilCons f || isCoercion f)]+ in [ head xs | xs <- xss, length xs > 1]++badInheritence :: CF -> [Cat]+badInheritence cf = concatMap checkGroup (ruleGroups cf)+ where+ checkGroup (cat, rs) = if (length rs <= 1)+ then []+ else case lookup cat rs of+ Nothing -> []+ Just x -> [cat]++infoOfCF :: CFG f -> Info+infoOfCF = snd . fst++pragmasOfCF :: CFG f -> [Pragma]+pragmasOfCF = fst . fst++-- extract the comment pragmas.+commentPragmas :: [Pragma] -> [Pragma]+commentPragmas = filter isComment+ where isComment (CommentS _) = True+ isComment (CommentM _) = True+ isComment _ = False++-- returns all normal rules that constructs the given Cat.+rulesForCat :: CF -> Cat -> [Rule]+rulesForCat cf cat = [normRuleFun r | r <- rulesOfCF cf, isParsable r, valCat r == cat] ++--This version doesn't exclude internal rules.+rulesForCat' :: CF -> Cat -> [Rule]+rulesForCat' cf cat = [normRuleFun r | r <- rulesOfCF cf, valCat r == cat] ++valCat :: Rul f -> Cat+valCat = fst . snd++-- Get all categories of a grammar.+allCats :: CF -> [Cat]+allCats = nub . map valCat . rulesOfCF -- no cats w/o production++-- Gets all normalized identified Categories+allCatsIdNorm :: CF -> [Cat]+allCatsIdNorm = nub . map identCat . map normCat . allCats++-- category is used on an rhs+isUsedCat :: CF -> Cat -> Bool+isUsedCat cf cat = elem cat [c | r <- (rulesOfCF cf), Left c <- rhsRule r]++-- entry points to parser ----+allEntryPoints :: CF -> [Cat]+allEntryPoints cf = case concat [cats | EntryPoints cats <- pragmasOfCF cf] of+ [] -> allCats cf+ cs -> cs++-- group all categories with their rules.+ruleGroups :: CF -> [(Cat,[Rule])]+ruleGroups cf = [(c, rulesForCat cf c) | c <- allCats cf]++-- group all categories with their rules including internal rules.+ruleGroupsInternals :: CF -> [(Cat,[Rule])]+ruleGroupsInternals cf = [(c, rulesForCat' cf c) | c <- allCats cf]++literals :: CFG f -> [Cat]+literals cf = lits ++ owns+ where + (lits,_,_,_) = infoOfCF cf+ owns = map fst $ tokenPragmas cf++symbols :: CFG f -> [String]+symbols cf = syms+ where (_,syms,_,_) = infoOfCF cf++reservedWords :: CFG f -> [String]+reservedWords cf = sort keywords+ where (_,_,keywords,_) = infoOfCF cf++reversibleCats :: CFG f -> [Cat]+reversibleCats cf = cats + where (_,_,_,cats) = infoOfCF cf++-- Comments can be defined by the 'comment' pragma+comments :: CF -> ([(String,String)],[String])+comments cf = case commentPragmas (pragmasOfCF cf) of+ xs -> ([p | CommentM p <- xs],+ [s | CommentS s <- xs])++funRule :: Rule -> Fun+funRule = fst++rhsRule :: Rul f -> [Either Cat String]+rhsRule = snd . snd++-- built-in categories (corresponds to lexer)++-- if the gramamr uses the predefined Ident type+hasIdent :: CF -> Bool+hasIdent cf = isUsedCat cf "Ident"++-- these need new datatypes+specialCats :: CF -> [Cat]+specialCats cf = (if hasIdent cf then ("Ident":) else id) (map fst (tokenPragmas cf))++-- the parser needs these+specialCatsP :: [Cat]+specialCatsP = words "Ident Integer String Char Double"++-- to print parse trees+prTree :: Tree -> String+prTree (Tree (fun,[])) = fun +prTree (Tree (fun,trees)) = fun +++ unwords (map pr2 trees) where+ pr2 t@(Tree (_,ts)) = (if (null ts) then id else prParenth) (prTree t)++-- abstract syntax trees: data type definitions++cf2data :: CF -> [Data]+cf2data cf = + [(cat, nub (map mkData [r | r@(f,_) <- rulesOfCF cf, + not (isDefinedRule f),+ not (isCoercion f), eqCat cat (valCat r)])) + | cat <- allNormalCats cf] + where+ mkData (f,(_,its)) = (normFun f,[normCat c | Left c <- its, c /= internalCat])++--This version includes lists in the returned data.+--Michael 4/03+cf2dataLists :: CF -> [Data]+cf2dataLists cf = + [(cat, nub (map mkData [r | r@(f,_) <- rulesOfCF cf, + not (isDefinedRule f),+ not (isCoercion f), eqCat cat (valCat r)])) + | cat <- (filter (\x -> not $ isDigit $ last x) (allCats cf))] + where+ mkData (f,(_,its)) = (normFun f,[normCat c | Left c <- its, c /= internalCat])++specialData :: CF -> [Data]+specialData cf = [(c,[(c,[arg c])]) | c <- specialCats cf] where+ arg c = case c of + _ -> "String"++allNormalCats :: CF -> [Cat]+allNormalCats = filter isNormal . allCats++-- to deal with coercions++-- the Haskell convention: the wildcard _ is not a constructor++isCoercion :: Fun -> Bool+isCoercion = (== "_")++isDefinedRule :: Fun -> Bool+isDefinedRule (x:_) = isLower x++isProperLabel :: Fun -> Bool+isProperLabel f = not (isCoercion f || isDefinedRule f)++-- categories C1, C2,... (one digit in end) are variants of C++eqCat :: Cat -> Cat -> Bool+eqCat c c1 = catCat c == catCat c1++normCat :: Cat -> Cat+normCat c = case c of+ '[':cs -> "[" ++ norm (init cs) ++ "]"+ _ -> unList $ norm c -- to be deprecated+ where+ norm = reverse . dropWhile isDigit . reverse++normCatOfList :: Cat -> Cat+normCatOfList = normCat . catOfList++-- for Happy and Latex+-- When given a list Cat, i.e. '[C]', it removes the square brackets,+-- and adds the prefix List, i.e. 'ListC'.+identCat :: Cat -> Cat+identCat c = case c of+ '[':cs -> "List" ++ identCat (init cs)+ _ -> c++normFun :: Fun -> Fun+normFun = id -- takeWhile (not . isDigit)++normRuleFun :: Rule -> Rule+normRuleFun (f,p) = (normFun f, p)++isNormal :: Cat -> Bool+isNormal c = not (isList c || isDigit (last c))++isParsable :: Rul f -> Bool+isParsable (_,(_, Left "#":_)) = False+isParsable _ = True++isList :: Cat -> Bool+isList c = head c == '[' ++unList :: Cat -> Cat+unList c = c++catOfList :: Cat -> Cat+catOfList c = case c of+ '[':_:_ -> init (tail c)+ _ -> c++isNilFun, isOneFun, isConsFun, isNilCons, isAqFun :: Fun -> Bool+isNilCons f = isNilFun f || isOneFun f || isConsFun f+isNilFun f = f == "[]" +isOneFun f = f == "(:[])" +isConsFun f = f == "(:)" ++isEmptyListCat :: CF -> Cat -> Bool+isEmptyListCat cf c = elem "[]" $ map fst $ rulesForCat' cf c++isNonterm = either (const True) (const False)++isAqFun f = f == "$"++-- used in Happy to parse lists of form 'C t [C]' in reverse order+-- applies only if the [] rule has no terminals+revSepListRule :: Rul f -> Rul f+revSepListRule r@(f,(c, ts)) = (f, (c, xs : x : sep)) where+ (x,sep,xs) = (head ts, init (tail ts), last ts) +-- invariant: test in findAllReversibleCats have been performed++findAllReversibleCats :: CF -> [Cat]+findAllReversibleCats cf = [c | (c,r) <- ruleGroups cf, isRev c r] where+ isRev c rs = case rs of+ [r1,r2] | isList c -> if isConsFun (funRule r2) + then tryRev r2 r1+ else if isConsFun (funRule r1) + then tryRev r1 r2+ else False+ _ -> False+ tryRev (f,(_,ts@(x:_:xs))) r = isEmptyNilRule r && + isConsFun f && isNonterm x && isNonterm (last ts)+ tryRev _ _ = False++isEmptyNilRule (f,(_,ts)) = isNilFun f && null ts++precCat :: Cat -> Int+precCat = snd . analyseCat++precRule :: Rule -> Int+precRule = precCat . valCat++precLevels :: CF -> [Int]+precLevels cf = sort $ nub $ [ precCat c | c <- allCats cf]++precCF :: CF -> Bool+precCF cf = length (precLevels cf) > 1++catCat :: Cat -> Cat+catCat = fst . analyseCat++analyseCat :: Cat -> (Cat,Int)+analyseCat c = if (isList c) then list c else noList c+ where+ list cat = let (rc,n) = noList (init (tail cat)) in ("[" ++ rc ++ "]",n)+ noList cat = case span isDigit (reverse cat) of+ ([],c') -> (reverse c', 0)+ (d,c') -> (reverse c', read (reverse d))++-- we should actually check that +-- (1) coercions are always between variants+-- (2) no other digits are used++checkRule :: CF -> RuleP -> Either RuleP String+checkRule cf r@((f,_),(cat,rhs))+ | badCoercion = Right $ "Bad coercion in rule" +++ s+ | badNil = Right $ "Bad empty list rule" +++ s+ | badOne = Right $ "Bad one-element list rule" +++ s+ | badCons = Right $ "Bad list construction rule" +++ s+ | badList = Right $ "Bad list formation rule" +++ s+ | badSpecial = Right $ "Bad special category rule" +++ s+ | badTypeName = Right $ "Bad type name" +++ unwords badtypes +++ "in" +++ s+ | badFunName = Right $ "Bad constructor name" +++ f +++ "in" +++ s+ | badMissing = Right $ "No production for" +++ unwords missing +++ ", appearing in rule" +++ s+ | otherwise = Left r+ where+ s = f ++ "." +++ cat +++ "::=" +++ unwords (map (either id show) rhs) ---+ c = normCat cat+ cs = [normCat c | Left c <- rhs]+ badCoercion = isCoercion f && not ([c] == cs)+ badNil = isNilFun f && not (isList c && null cs)+ badOne = isOneFun f && not (isList c && cs == [catOfList c])+ badCons = isConsFun f && not (isList c && cs == [catOfList c, c])+ badList = isList c && + not (isCoercion f || isNilFun f || isOneFun f || isConsFun f)+ badSpecial = elem c specialCatsP && not (isCoercion f)++ badMissing = not (null missing)+ missing = filter nodef [c | Left c <- rhs] + nodef t = notElem t defineds+ defineds = + "#" : map fst (tokenPragmas cf) ++ specialCatsP ++ map valCat (rulesOfCF cf) + badTypeName = not (null badtypes)+ badtypes = filter isBadType $ cat : [c | Left c <- rhs]+ isBadType c = not (isUpper (head c) || isList c || c == "#")+ badFunName = not (all (\c -> isAlphaNum c || c == '_') f {-isUpper (head f)-}+ || isCoercion f || isNilFun f || isOneFun f || isConsFun f || isAqFun f)++isPositionCat :: CFG f -> Cat -> Bool+isPositionCat cf cat = or [b | TokenReg name b _ <- pragmasOfCF cf, name == cat]+++-- grammar with permutation profile à la GF. AR 22/9/2004++type CFP = (Exts,[RuleP])+type FunP = (Fun,Prof)+type RuleP = (FunP, (Cat, [Either Cat String]))++type Prof = (Fun, [([[Int]],[Int])]) -- the original function name, profile++cf2cfp :: CF -> CFP+cf2cfp (es,rs) = (es, map cf2cfpRule rs)++cf2cfpRule :: Rule -> RuleP+cf2cfpRule (f,(c,its)) = ((f, (f, trivialProf its)),(c,its))++cfp2cf :: CFP -> CF+cfp2cf (es,rs) = (es,[(f,(c,its)) | ((f,_),(c,its)) <- rs])++trivialProf :: [Either Cat String] -> [([[Int]],[Int])]+trivialProf its = [([],[i]) | (i,_) <- zip [0..] [c | Left c <- its]]++rulesOfCFP :: CFP -> [RuleP]+rulesOfCFP = snd++funRuleP :: RuleP -> Fun+funRuleP = fst . snd . fst++ruleGroupsP :: CFP -> [(Cat,[RuleP])]+ruleGroupsP cf = [(c, rulesForCatP cf c) | c <- allCatsP cf]++rulesForCatP :: CFP -> Cat -> [RuleP]+rulesForCatP cf cat = [r | r <- rulesOfCFP cf, isParsable r, valCat r == cat] ++allCatsP :: CFP -> [Cat]+allCatsP = nub . map valCat . rulesOfCFP -- no cats w/o production++allEntryPointsP :: CFP -> [Cat]+allEntryPointsP cf = case concat [cats | EntryPoints cats <- pragmasOfCF cf] of+ [] -> allCatsP cf+ cs -> cs
+ Language/LBNF/CFtoAbstract.hs view
@@ -0,0 +1,77 @@+{-# LANGUAGE TemplateHaskell #-}+{-+ BNF Converter: Abstract syntax Generator+ Copyright (C) 2004 Author: Markus Forberg++ This program is free software; you can redistribute it and/or modify+ it under the terms of the GNU General Public License as published by+ the Free Software Foundation; either version 2 of the License, or+ (at your option) any later version.++ This program is distributed in the hope that it will be useful,+ but WITHOUT ANY WARRANTY; without even the implied warranty of+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+ GNU General Public License for more details.++ You should have received a copy of the GNU General Public License+ along with this program; if not, write to the Free Software+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA+-}++module Language.LBNF.CFtoAbstract (cf2Abstract) where++import Language.Haskell.TH++import Language.LBNF.CF+++-- to produce a Haskell module+cf2Abstract :: CF -> Q ([Dec],[Dec])+cf2Abstract cf0 = do+ d1 <- sequence $ map prData $ cf2data cf0+ d2 <- sequence $ map (prSpecialData cf0) (specialCats cf0) +-- d3 <- if hasAq cf0+-- then do+-- let cf = resolveAq cf0+ -- d3a <- sequence $ map (prSpecialData cf) (specialCats cf) +-- d3b <- sequence $ map prData $ cf2data cf+ -- d3c <- transl cf0+ -- d3d <- lifts cf+-- return $ d3b+-- else return []+ + return (d1, d2)++++fixname :: String -> TypeQ+fixname ('[':xs) = appT listT $ conT $ mkName $ init xs+fixname xs = conT $ mkName xs+ +prData :: Data -> Q Dec+prData (cat,rules) = + dataD (return []) (mkName cat) [] (map cons rules) deriv where+ cons (fun,cats) = normalC (mkName fun) $ map typ cats+ typ cat = strictType notStrict $ fixname cat+ deriv = [mkName "Eq",mkName "Ord",mkName "Show"]++prSpecialData :: CF -> Cat -> Q Dec+prSpecialData cf cat =+ newtypeD (return []) (mkName cat) [] con deriv where+ con = normalC (mkName cat) $ [typ]+ typ = strictType notStrict $ contentSpec cf cat+ deriv = [mkName "Eq",mkName "Ord",mkName "Show"]++contentSpec :: CF -> Cat -> Q Type+contentSpec cf cat = if isPositionCat cf cat + then [t|((Int,Int),String)|] + else [t|String|]+++-- aqName :: Bool -> String -> Name+-- aqName False s = +++-- transl cf = return []++-- lifts cf = return []
+ Language/LBNF/CFtoAlex2.hs view
@@ -0,0 +1,315 @@+{-+ BNF Converter: Alex 2.0 Generator+ Copyright (C) 2004 Author: Peter Gammie++ This program is free software; you can redistribute it and/or modify+ it under the terms of the GNU General Public License as published by+ the Free Software Foundation; either version 2 of the License, or+ (at your option) any later version.++ This program is distributed in the hope that it will be useful,+ but WITHOUT ANY WARRANTY; without even the implied warranty of+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+ GNU General Public License for more details.++ You should have received a copy of the GNU General Public License+ along with this program; if not, write to the Free Software+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA+-}++-------------------------------------------------------------------+-- |+-- Module : CFtoAlex2+-- Copyright : (C)opyright 2003, {aarne,markus,peteg} at cs dot chalmers dot se+-- License : GPL (see COPYING for details)+-- +-- Maintainer : {markus,aarne} at cs dot chalmers dot se+-- Stability : alpha+-- Portability : Haskell98+--+-- Hacked version of @CFtoAlex@ to cope with Alex2.+--+-------------------------------------------------------------------+module Language.LBNF.CFtoAlex2 (cf2alex2) where++import Language.LBNF.CF+import Data.List++-- For RegToAlex, see below.+import Language.LBNF.AbsBNF+import Data.Char++cf2alex2 ::CF -> String+cf2alex2 cf = + unlines $ concat $ intersperse [""] [+ cMacros,+ rMacros cf,+ restOfAlex False cf+ ]+ +cMacros :: [String]+cMacros = [+ "$l = [a-zA-Z\\192 - \\255] # [\\215 \\247] -- isolatin1 letter FIXME",+ "$c = [A-Z\\192-\\221] # [\\215] -- capital isolatin1 letter FIXME",+ "$s = [a-z\\222-\\255] # [\\247] -- small isolatin1 letter FIXME",+ "$d = [0-9] -- digit",+ "$i = [$l $d _ '] -- identifier character",+ "$u = [\\0-\\255] -- universal: any character"+ ]++rMacros :: CF -> [String]+rMacros cf = + let symbs = symbols cf+ in+ (if null symbs then [] else [+ "@rsyms = -- symbols and non-identifier-like reserved words",+ " " ++ unwords (intersperse "|" (map mkEsc symbs))+ ])+ where+ mkEsc = unwords . esc+ esc s = if null a then rest else show a : rest+ where (a,r) = span isAlphaNum s+ rest = case r of+ [] -> []+ (c:xs) -> s : esc xs+ where s = if isPrint c then ['\\',c]+ else '\\':show (ord c)++restOfAlex :: Bool -> CF -> [String]+restOfAlex shareStrings cf = [+ ":-", + lexComments (comments cf),+ "$white+ ;",+ pTSpec (symbols cf),++ userDefTokenTypes,+ ident,++ ifC "String" ("\\\" ([$u # [\\\" \\\\ \\n]] | (\\\\ (\\\" | \\\\ | \\' | n | t)))* \\\"" +++ "{ tok (\\p s -> PT p (TL $ share $ unescapeInitTail s)) }"),+ ifC "Char" "\\\' ($u # [\\\' \\\\] | \\\\ [\\\\ \\\' n t]) \\' { tok (\\p s -> PT p (TC $ share s)) }",+ ifC "Integer" "$d+ { tok (\\p s -> PT p (TI $ share s)) }",+ ifC "Double" "$d+ \\. $d+ (e (\\-)? $d+)? { tok (\\p s -> PT p (TD $ share s)) }",+ "",+ "{",+ "",+ "tok f p s = f p s",+ "",+ "share :: String -> String",+ "share = " ++ if shareStrings then "shareString" else "id",+ "",+ "data Tok =", + " TS !String -- reserved words and symbols",+ " | TL !String -- string literals", + " | TI !String -- integer literals",+ " | TV !String -- identifiers",+ " | TD !String -- double precision float literals",+ " | TC !String -- character literals",+ userDefTokenConstrs,+ " deriving (Eq,Show,Ord)",+ "",+ "data Token = ",+ " PT Posn Tok",+ " | Err Posn",+ " deriving (Eq,Show,Ord)",+ "",+ "tokenPos (PT (Pn _ l _) _ :_) = \"line \" ++ show l", + "tokenPos (Err (Pn _ l _) :_) = \"line \" ++ show l", + "tokenPos _ = \"end of file\"",+ "",+ "posLineCol (Pn _ l c) = (l,c)",+ "mkPosToken t@(PT p _) = (posLineCol p, prToken t)",+ "",+ "prToken t = case t of", + " PT _ (TS s) -> s",+ " PT _ (TI s) -> s",+ " PT _ (TV s) -> s",+ " PT _ (TD s) -> s",+ " PT _ (TC s) -> s",+ userDefTokenPrint, + " _ -> show t",+ "",+ "data BTree = N | B String Tok BTree BTree deriving (Show)",+ "",+ "eitherResIdent :: (String -> Tok) -> String -> Tok",+ "eitherResIdent tv s = treeFind resWords",+ " where",+ " treeFind N = tv s",+ " treeFind (B a t left right) | s < a = treeFind left",+ " | s > a = treeFind right",+ " | s == a = t",+ "",+ "resWords = " ++ (show $ sorted2tree $ sort resws),+ " where b s = B s (TS s)",+ "",+ "unescapeInitTail :: String -> String",+ "unescapeInitTail = unesc . tail where",+ " unesc s = case s of",+ " '\\\\':c:cs | elem c ['\\\"', '\\\\', '\\\''] -> c : unesc cs",+ " '\\\\':'n':cs -> '\\n' : unesc cs",+ " '\\\\':'t':cs -> '\\t' : unesc cs",+ " '\"':[] -> []",+ " c:cs -> c : unesc cs",+ " _ -> []",+ "",+ "-------------------------------------------------------------------",+ "-- Alex wrapper code.",+ "-- A modified \"posn\" wrapper.",+ "-------------------------------------------------------------------",+ "",+ "data Posn = Pn !Int !Int !Int",+ " deriving (Eq, Show,Ord)",+ "",+ "alexStartPos :: Posn",+ "alexStartPos = Pn 0 1 1",+ "",+ "alexMove :: Posn -> Char -> Posn",+ "alexMove (Pn a l c) '\\t' = Pn (a+1) l (((c+7) `div` 8)*8+1)",+ "alexMove (Pn a l c) '\\n' = Pn (a+1) (l+1) 1",+ "alexMove (Pn a l c) _ = Pn (a+1) l (c+1)",+ "",+ "type AlexInput = (Posn, -- current position,",+ " Char, -- previous char",+ " String) -- current input string",+ "",+ "tokens :: String -> [Token]",+ "tokens str = go (alexStartPos, '\\n', str)",+ " where",+ " go :: (Posn, Char, String) -> [Token]",+ " go inp@(pos, _, str) =",+ " case alexScan inp 0 of",+ " AlexEOF -> []",+ " AlexError (pos, _, _) -> [Err pos]",+ " AlexSkip inp' len -> go inp'",+ " AlexToken inp' len act -> act pos (take len str) : (go inp')",+ "",+ "alexGetChar :: AlexInput -> Maybe (Char,AlexInput)",+ "alexGetChar (p, c, []) = Nothing",+ "alexGetChar (p, _, (c:s)) =",+ " let p' = alexMove p c",+ " in p' `seq` Just (c, (p', c, s))",+ "",+ "alexInputPrevChar :: AlexInput -> Char",+ "alexInputPrevChar (p, c, s) = c",+ "}"+ ]+ where+ ifC cat s = if isUsedCat cf cat then s else ""+ lexComments ([],[]) = [] + lexComments (xs,s1:ys) = '\"' : s1 ++ "\"" ++ " [.]* ; -- Toss single line comments\n" ++ lexComments (xs, ys)+ lexComments (([l1,l2],[r1,r2]):xs,[]) = concat $+ [+ ('\"':l1:l2:"\" ([$u # \\"), -- FIXME quotes or escape?+ (l2:"] | \\"),+ (r1:" [$u # \\"),+ (r2:"])* (\""),+ (r1:"\")+ \""),+ (r2:"\" ; \n"),+ lexComments (xs, [])+ ]+ lexComments ((_:xs),[]) = lexComments (xs,[]) +--- lexComments (xs,(_:ys)) = lexComments (xs,ys) ++ -- tokens consisting of special symbols+ pTSpec [] = ""+ pTSpec _ = "@rsyms { tok (\\p s -> PT p (TS $ share s)) }"++ userDefTokenTypes = unlines $+ [printRegAlex exp +++ " { tok (\\p s -> PT p (eitherResIdent (T_" ++ name ++ " . share) s)) }"+ | (name,exp) <- tokenPragmas cf]+ userDefTokenConstrs = unlines $+ [" | T_" ++ name ++ " !String" | (name,_) <- tokenPragmas cf]+ userDefTokenPrint = unlines $+ [" PT _ (T_" ++ name ++ " s) -> s" | (name,_) <- tokenPragmas cf]++ ident =+ "$l $i* { tok (\\p s -> PT p (eitherResIdent (TV . share) s)) }" + --ifC "Ident" "<ident> ::= ^l ^i* { ident p = PT p . eitherResIdent TV }" ++ resws = reservedWords cf+++data BTree = N | B String BTree BTree ++instance Show BTree where+ showsPrec _ N = showString "N"+ showsPrec n (B s l r) = wrap (showString "b " . shows s . showChar ' '+ . showsPrec 1 l . showChar ' '+ . showsPrec 1 r)+ where wrap f = if n > 0 then showChar '(' . f . showChar ')' else f++sorted2tree :: [String] -> BTree+sorted2tree [] = N+sorted2tree xs = B x (sorted2tree t1) (sorted2tree t2) where+ (t1,(x:t2)) = splitAt (length xs `div` 2) xs+++-------------------------------------------------------------------+-- Inlined version of @RegToAlex@.+-- Syntax has changed...+-------------------------------------------------------------------++-- modified from pretty-printer generated by the BNF converter++-- the top-level printing method+printRegAlex :: Reg -> String+printRegAlex = render . prt 0++-- you may want to change render and parenth++render :: [String] -> String+render = rend 0+ where rend :: Int -> [String] -> String+ rend i ss = case ss of+ "[" :ts -> cons "[" $ rend i ts+ "(" :ts -> cons "(" $ rend i ts+ t : "," :ts -> cons t $ space "," $ rend i ts+ t : ")" :ts -> cons t $ cons ")" $ rend i ts+ t : "]" :ts -> cons t $ cons "]" $ rend i ts+ t :ts -> space t $ rend i ts+ _ -> ""++ cons s t = s ++ t+ new i s = s+ space t s = if null s then t else t ++ " " ++ s++parenth :: [String] -> [String]+parenth ss = ["("] ++ ss ++ [")"]++-- the printer class does the job+class Print a where+ prt :: Int -> a -> [String]+ prtList :: [a] -> [String]+ prtList = concat . map (prt 0)++instance Print a => Print [a] where+ prt _ = prtList++instance Print Char where+ prt _ c = if isAlphaNum c then [[c]] else ['\\':[c]]+ prtList s = map (concat . prt 0) s++prPrec :: Int -> Int -> [String] -> [String]+prPrec i j = if j<i then parenth else id++instance Print Ident where+ prt _ (Ident i) = [i]++instance Print Reg where+ prt i e = case e of+ RSeq reg0 reg -> prPrec i 2 (concat [prt 2 reg0 , prt 3 reg])+ RAlt reg0 reg -> prPrec i 1 (concat [prt 1 reg0 , ["|"] , prt 2 reg])+ RMinus reg0 reg -> prPrec i 1 (concat [prt 2 reg0 , ["#"] , prt 2 reg])+ RStar reg -> prPrec i 3 (concat [prt 3 reg , ["*"]])+ RPlus reg -> prPrec i 3 (concat [prt 3 reg , ["+"]])+ ROpt reg -> prPrec i 3 (concat [prt 3 reg , ["?"]])+ REps -> prPrec i 3 (["/\\n"])+ RChar c -> prPrec i 3 (concat [prt 0 c])+ RAlts str -> prPrec i 3 (concat [["["],prt 0 str,["]"]])+ RSeqs str -> prPrec i 2 (concat (map (prt 0) str))+ RDigit -> prPrec i 3 (concat [["$d"]])+ RLetter -> prPrec i 3 (concat [["$l"]])+ RUpper -> prPrec i 3 (concat [["$c"]])+ RLower -> prPrec i 3 (concat [["$s"]])+ RAny -> prPrec i 3 (concat [["$u"]])
+ Language/LBNF/CFtoHappy.hs view
@@ -0,0 +1,229 @@+{-+ BNF Converter: Happy Generator+ Copyright (C) 2004 Author: Markus Forberg, Aarne Ranta++ This program is free software; you can redistribute it and/or modify+ it under the terms of the GNU General Public License as published by+ the Free Software Foundation; either version 2 of the License, or+ (at your option) any later version.++ This program is distributed in the hope that it will be useful,+ but WITHOUT ANY WARRANTY; without even the implied warranty of+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+ GNU General Public License for more details.++ You should have received a copy of the GNU General Public License+ along with this program; if not, write to the Free Software+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA+-}++module Language.LBNF.CFtoHappy + (+ cf2HappyS -- cf2HappyS :: CF -> CFCat -> String+ ,HappyMode(..)+ )+ where++import Language.LBNF.CF+--import Lexer+import Data.List (intersperse)+import Data.Char++-- Type declarations++type Rules = [(NonTerminal,[(Pattern,Action)])]+type NonTerminal = String+type Pattern = String+type Action = String+type MetaVar = String++-- default naming++moduleName = "HappyParser"+tokenName = "Token"++-- Happy mode++data HappyMode = Standard | GLR deriving Eq+++cf2HappyS :: CF -> String+---- cf2HappyS :: String -> CF -> String+cf2HappyS = cf2Happy++-- The main function, that given a CF and a CFCat to parse according to, +-- generates a happy module. +cf2Happy cf+ = unlines + [declarations Standard (allEntryPoints cf),+ tokens (symbols cf ++ reservedWords cf),+ specialToks cf,+ delimiter,+ specialRules cf,+ prRules (rulesForHappy cf),+ finalize cf]+++-- The declarations of a happy file.+declarations :: HappyMode -> [NonTerminal] -> String+declarations mode ns = unlines + [generateP ns,+ case mode of + Standard -> "-- no lexer declaration"+ GLR -> "%lexer { myLexer } { Err _ }",+ "%monad { Err } { thenM } { returnM }",+ "%tokentype { " ++ tokenName ++ " }"]+ where generateP [] = []+ generateP (n:ns) = concat ["%name p",n'," ",n',"\n",generateP ns]+ where n' = identCat n++-- The useless delimiter symbol.+delimiter :: String+delimiter = "\n%%\n"++-- Generate the list of tokens and their identifiers.+tokens :: [String] -> String+tokens toks = "%token \n" ++ prTokens toks+ where prTokens [] = []+ prTokens (t:tk) = " " ++ (convert t) ++ + " { " ++ oneTok t ++ " }\n" +++ prTokens tk+ oneTok t = "PT _ (TS " ++ show t ++ ")"++-- Happy doesn't allow characters such as åäö to occur in the happy file. This+-- is however not a restriction, just a naming paradigm in the happy source file.+convert :: String -> String+convert "\\" = concat ['\'':"\\\\","\'"]+convert xs = concat ['\'':(escape xs),"\'"]+ where escape [] = []+ escape ('\'':xs) = '\\':'\'':escape xs+ escape (x:xs) = x:escape xs++rulesForHappy :: CF -> Rules+rulesForHappy cf = map mkOne $ ruleGroups cf where+ mkOne (cat,rules) = constructRule cf rules cat++-- For every non-terminal, we construct a set of rules. A rule is a sequence of+-- terminals and non-terminals, and an action to be performed+-- As an optimization, a pair of list rules [C] ::= "" | C k [C]+-- is left-recursivized into [C] ::= "" | [C] C k.+-- This could be generalized to cover other forms of list rules.+constructRule :: CF -> [Rule] -> NonTerminal -> (NonTerminal,[(Pattern,Action)])+constructRule cf rules nt = (nt,[(p,generateAction nt (revF b r) m) | + r0 <- rules,+ let (b,r) = if isConsFun (funRule r0) && elem (valCat r0) revs + then (True,revSepListRule r0) + else (False,r0),+ let (p,m) = generatePatterns cf r])+ where+ revF b r = if b then ("flip " ++ funRule r) else (underscore $ funRule r)+ revs = reversibleCats cf+ underscore f | isDefinedRule f = f ++ "_"+ | otherwise = f++-- Generates a string containing the semantic action.+-- An action can for example be: Sum $1 $2, that is, construct an AST+-- with the constructor Sum applied to the two metavariables $1 and $2.+generateAction :: NonTerminal -> Fun -> [MetaVar] -> Action+generateAction nt f ms = unwords $ (if isCoercion f then [] else [f]) ++ ms++-- Generate patterns and a set of metavariables indicating +-- where in the pattern the non-terminal++generatePatterns :: CF -> Rule -> (Pattern,[MetaVar])+generatePatterns cf r = case rhsRule r of+ [] -> ("{- empty -}",[])+ its -> (unwords (map mkIt its), metas its) + where+ mkIt i = case i of+ Left c -> identCat c+ Right s -> convert s+ metas its = [revIf c ('$': show i) | (i,Left c) <- zip [1 ::Int ..] its]+ revIf c m = if (not (isConsFun (funRule r)) && elem c revs) + then ("(reverse " ++ m ++ ")") + else m -- no reversal in the left-recursive Cons rule itself+ revs = reversibleCats cf++-- We have now constructed the patterns and actions, +-- so the only thing left is to merge them into one string.++prRules :: Rules -> String+prRules = unlines . map prOne+ where+ prOne (nt,[]) = [] -- nt has only internal use+ prOne (nt,((p,a):ls)) =+ unwords [nt', "::", "{", normCat nt, "}\n" ++ + nt', ":" , p, "{", a, "}", "\n" ++ pr ls] ++ "\n"+ where + nt' = identCat nt+ pr [] = []+ pr ((p,a):ls) = + unlines [(concat $ intersperse " " [" |", p, "{", a , "}"])] ++ pr ls+ +-- Finally, some haskell code.++finalize :: CF -> String+finalize cf = unlines $+ [+ "{",+ "\nreturnM :: a -> Err a",+ "returnM = return",+ "\nthenM :: Err a -> (a -> Err b) -> Err b",+ "thenM = (>>=)",+ "\nhappyError :: [" ++ tokenName ++ "] -> Err a",+ "happyError ts =", + " Bad $ \"syntax error at \" ++ tokenPos ts ++ ",+ " case ts of",+ " [] -> []",+ " [Err _] -> \" due to lexer error\"", + " _ -> \" before \" ++ unwords (map prToken (take 4 ts))",+ "",+ "myLexer = tokens"+ ] ++ definedRules cf ++ [ "}" ]++definedRules ((ps,_),_) = [ mkDef f xs e | FunDef f xs e <- ps ]+ where+ mkDef f xs e = unwords $ (f ++ "_") : xs' ++ ["=", show e']+ where+ xs' = map (++"_") xs+ e' = underscore e+ underscore (App x es)+ | isLower $ head x = App (x ++ "_") $ map underscore es+ | otherwise = App x $ map underscore es+ underscore e = e++-- aarne's modifs 8/1/2002:+-- Markus's modifs 11/02/2002++-- GF literals+specialToks :: CF -> String+specialToks cf = unlines $+ (map aux (literals cf))+ ++ ["L_err { _ }"]+ where aux cat = + case cat of+ "Ident" -> "L_ident { PT _ (TV $$) }"+ "String" -> "L_quoted { PT _ (TL $$) }"+ "Integer" -> "L_integ { PT _ (TI $$) }"+ "Double" -> "L_doubl { PT _ (TD $$) }"+ "Char" -> "L_charac { PT _ (TC $$) }"+ own -> "L_" ++ own ++ " { PT _ (T_" ++ own ++ " " ++ posn ++ ") }"+ where+ posn = if isPositionCat cf cat then "_" else "$$"++specialRules :: CF -> String+specialRules cf = unlines $+ map aux (literals cf)+ where + aux cat = + case cat of+ "Ident" -> "Ident :: { Ident } : L_ident { Ident $1 }" + "String" -> "String :: { String } : L_quoted { $1 }" + -- "String" -> "String :: { String } : L_quoted { $1 }" + "Integer" -> "Integer :: { Integer } : L_integ { (read $1) :: Integer }"+ "Double" -> "Double :: { Double } : L_doubl { (read $1) :: Double }"+ "Char" -> "Char :: { Char } : L_charac { (read $1) :: Char }"+ own -> own ++ " :: { " ++ own ++ "} : L_" ++ own ++ " { " ++ own ++ " ("++ posn ++ "$1)}"+ -- PCC: take "own" as type name? (manual says newtype)+ where+ posn = if isPositionCat cf cat then "mkPosToken " else ""
+ Language/LBNF/CFtoPrinter.hs view
@@ -0,0 +1,154 @@+{-# LANGUAGE TemplateHaskell #-}+{-+ BNF Converter: Pretty-printer generator+ Copyright (C) 2004 Author: Aarne Ranta++ This program is free software; you can redistribute it and/or modify+ it under the terms of the GNU General Public License as published by+ the Free Software Foundation; either version 2 of the License, or+ (at your option) any later version.++ This program is distributed in the hope that it will be useful,+ but WITHOUT ANY WARRANTY; without even the implied warranty of+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+ GNU General Public License for more details.++ You should have received a copy of the GNU General Public License+ along with this program; if not, write to the Free Software+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA+-}++module Language.LBNF.CFtoPrinter (cf2Printer) where++import Language.LBNF.CF+import Language.LBNF.Utils+import Language.LBNF.PrintPrelude+import Data.List (intersperse)+import Data.Char(toLower)++import Language.Haskell.TH+import Language.Haskell.TH.Syntax++-- derive pretty-printer from a BNF grammar. AR 15/2/2002+cf2Printer :: CF -> Q [Dec]+cf2Printer cf = sequence $ concat [+ if hasIdent cf then [identRule cf] else [],+ [ownPrintRule cf own | (own,_) <- tokenPragmas cf],+ rules cf+ ]++{-+showsPrintRule cf t = unlines $ [+ "instance Print " ++ t ++ " where",+ " prt _ x = doc (shows x)",+ ifList cf t+ ]+-}++identRule cf = ownPrintRule cf "Ident"++ownPrintRule :: CF -> String -> DecQ+ownPrintRule cf own = do+ i <- newName "i"+ let + posn = if isPositionCat cf own + then tupP [wildP,conP (mkName own) [varP i]]+ else conP (mkName own) [varP i]+ body = normalB [|doc (showString $(varE i))|]+ prtc = funD ('prt) [clause [wildP, posn] body []]+ instanceD (cxt []) (appT (conT $ ''Print) $ conT $ mkName own) [prtc]+ +{-unlines $ [+ "instance Print " ++ own ++ " where",+ " prt _ (" ++ own ++ posn ++ ") = doc (showString i)",+ ifList cf own+ ]+ where+ posn = if isPositionCat cf own then " (_,i)" else " i"+-}+-- copy and paste from CFtoTemplate++rules :: CF -> [Q Dec]+rules cf = + map (\(s,xs) -> case_fun s (map toArgs xs) (ifList cf s)) $ cf2data cf+ where + toArgs (cons,args) = ((cons, names (map (checkRes . var) args) (0 :: Int)), ruleOf cons)+ names [] _ = []+ names (x:xs) n+ | elem x xs = (x ++ show n) : names xs (n+1)+ | otherwise = x : names xs n+ var ('[':xs) = var (init xs) ++ "s"+ var "Ident" = "id"+ var "Integer" = "n"+ var "String" = "str"+ var "Char" = "c"+ var "Double" = "d"+ var xs = map toLower xs+ checkRes s+ | elem s reservedHaskell = s ++ "'"+ | otherwise = s+ reservedHaskell = ["case","class","data","default","deriving","do","else","if",+ "import","in","infix","infixl","infixr","instance","let","module",+ "newtype","of","then","type","where","as","qualified","hiding"]+ ruleOf s = maybe undefined id $ lookup s (rulesOfCF cf)++-- case_fun :: Cat -> [(Con,Rule)] -> Q Dec+case_fun cat xs lst = instanceD (cxt []) (appT (conT ''Print) $ conT $ mkName cat) + [newName "i" >>= \i -> newName "x" >>= prtc i] where+ prtc i n = funD ('prt) [clause [varP i,varP n] (body) []] where+ body = normalB $ caseE (varE n) $+ map mtch xs+ mtch ((c,xx),r) = match + (conP (mkName c) [varP (mkName x)|x <- xx])+ (normalB + [| prPrec + $(varE i) + $(litE $ IntegerL $ toInteger $ precCat $ fst r) + $(mkRhs xx (snd r))+ |])+ []+ +{-+unlines [+ "instance Print" +++ cat +++ "where",+ " prt i" +++ "e = case e of",+ unlines $ map (\ ((c,xx),r) -> + " " ++ c +++ unwords xx +++ "->" +++ + "prPrec i" +++ show (precCat (fst r)) +++ mkRhs xx (snd r)) xs+ ]+-}++ifList :: CF -> String -> [DecQ]+ifList cf cat = mkListRule $ nil cat ++ one cat ++ cons cat where+ nil cat = [(listP [],mkRhs [] its) | + (f,(c,its)) <- rulesOfCF cf, isNilFun f , normCatOfList c == cat]+ one cat = [(listP [varP $ mkName "x"], mkRhs ["x"] its) | + (f,(c,its)) <- rulesOfCF cf, isOneFun f , normCatOfList c == cat]+ cons cat = [(conP '(:) [varP $ mkName "x",varP $ mkName "xs"], mkRhs ["x","xs"] its) | + (f,(c,its)) <- rulesOfCF cf, isConsFun f , normCatOfList c == cat]+ mkListRule [] = []+ mkListRule rs = [do+ es <- newName "es"+ funD 'prtList [clause [varP es] (normalB $ caseE (varE es) $ map mtch rs) []]]+ mtch (p,e) = match p (normalB e) []+++mkRhs :: [String] -> [Either String String] -> ExpQ+mkRhs args its = [| concatD $(listE $ mk args its) |]+ where+ mk args (Left "#" : items) = mk args items+ mk (arg:args) (Left c : items) = prt' c (arg) : mk args items+ mk args (Right s : items) = [| doc (showString $(lift (s :: String))) |] : mk args items+ mk _ _ = []+ prt' :: String -> String -> ExpQ+ prt' c arg = [| prt $(lift $ precCat c) $(varE $ mkName arg) |]++ {-+ "(concatD [" ++ unwords (intersperse "," (mk args its)) ++ "])"+ where+ mk args (Left "#" : items) = mk args items+ mk (arg:args) (Left c : items) = (prt c +++ arg) : mk args items+ mk args (Right s : items) = ("doc (showString" +++ show s ++ ")") : mk args items+ mk _ _ = []+ prt c = "prt" +++ show (precCat c)+-}
+ Language/LBNF/ErrM.hs view
@@ -0,0 +1,26 @@+-- BNF Converter: Error Monad+-- Copyright (C) 2004 Author: Aarne Ranta++-- This file comes with NO WARRANTY and may be used FOR ANY PURPOSE.+module Language.LBNF.ErrM where++-- the Error monad: like Maybe type with error msgs++import Control.Monad (MonadPlus(..), liftM)++data Err a = Ok a | Bad String+ deriving (Read, Show, Eq, Ord)++instance Monad Err where+ return = Ok+ fail = Bad+ Ok a >>= f = f a+ Bad s >>= f = Bad s++instance Functor Err where+ fmap = liftM++instance MonadPlus Err where+ mzero = Bad "Err.mzero"+ mplus (Bad _) y = y+ mplus x _ = x
+ Language/LBNF/GetCF.hs view
@@ -0,0 +1,322 @@+{-+ BNF Converter: Abstract syntax+ Copyright (C) 2004 Author: Markus Forsberg, Aarne Ranta++ This program is free software; you can redistribute it and/or modify+ it under the terms of the GNU General Public License as published by+ the Free Software Foundation; either version 2 of the License, or+ (at your option) any later version.++ This program is distributed in the hope that it will be useful,+ but WITHOUT ANY WARRANTY; without even the implied warranty of+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+ GNU General Public License for more details.++ You should have received a copy of the GNU General Public License+ along with this program; if not, write to the Free Software+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA+-}+++module Language.LBNF.GetCF where++import Control.Monad ( when )++import Language.LBNF.CF+import Language.LBNF.Utils+import Language.LBNF.ParBNF+import Data.List(nub,partition)+import qualified Language.LBNF.AbsBNF as Abs+-- import LexBNF+import Language.LBNF.ErrM+import Data.Char+import Language.LBNF.TypeChecker++readCF :: FilePath -> IO CF+readCF f = tryReadCF f >>= return . fst++tryReadCF :: FilePath -> IO (CF,Bool)+tryReadCF file = do+ (cfp,m) <- tryReadCFP file+ return (cfp2cf cfp, m)++tryReadCFP :: FilePath -> IO (CFP,Bool)+tryReadCFP file = do+ putStrLn $ "\nReading grammar from " ++ file+ s <- readFile file+ let (cfp,msg') = getCFP s+ cf = cfp2cf cfp+ msg = case checkDefinitions cf of+ Bad err -> msg' ++ [err]+ Ok () -> msg'+ ret = cfp+ if not (null msg) then do+ putStrLn $ unlines msg+ return (ret,False)+ else do+ putStrLn $ show (length (rulesOfCF cf)) +++ "rules accepted\n"++ let c3s = [(b,e) | (b,e) <- fst (comments cf), length b > 2 || length e > 2]+ if null c3s then return () else do+ putStrLn + "Warning: comment delimiters longer than 2 characters ignored in Haskell:"+ mapM_ putStrLn [b +++ "-" +++ e | (b,e) <- c3s]+ case filter (not . isDefinedRule) $ notUniqueFuns cf of+ [] -> case (badInheritence cf) of+ [] -> return (ret,True)+ xs -> do+ putStrLn "Warning :"+ putStrLn $ " Bad Label name in Category(s) :" ++ unwords xs+ putStrLn $ " These categories have more than one Label, yet one of these"+ putStrLn $ " Labels has the same name as the Category. This will almost"+ putStrLn $ " certainly cause problems in languages other than Haskell.\n"+ return (ret,True)+ xs -> do + putStrLn $ "Warning :" + putStrLn $ " Non-unique label name(s) : " ++ unwords xs+ putStrLn $ " There may be problems with the pretty-printer.\n"+ case (badInheritence cf) of+ [] -> return (ret,True)+ xs -> do+ putStrLn $ "Warning :"+ putStrLn $ " Bad Label name in Category(s) :" ++ unwords xs+ putStrLn $ " These categories have more than one Label, yet one of these"+ putStrLn $ " Labels has the same name as the Category. This will almost"+ putStrLn $ " certainly cause problems in languages other than Haskell.\n"+ return (ret,True)+++-- peteg: FIXME this is racey.+-- want to be a bit smarter about whether we actually generate the file+-- or save it... e.g. ErrM.hs need not be regenerated if it exists.+++getCF :: String -> (CF, [String])+getCF s = let (cfp,msg) = getCFP s in (cfp2cf cfp, msg)++getCFP :: String -> (CFP, [String])+getCFP s = (cf,msgs ++ msgs1) where+ (cf,msgs1) = ((exts,ruls2),msgs2)+ (ruls2,msgs2) = untag $ partition (isRule) $ map (checkRule cf00) $ rulesOfCFP cf0+ untag (ls,rs) = ([c | Left c <- ls], [c | Right c <- rs])+ isRule = either (const True) (const False)+ cf00 = cfp2cf cf0+ (cf0@(exts,_),msgs) = (revs . srt . conv . pGrammar . myLexer) s+ srt rs = let rules = [r | Left (Right r) <- rs]+ literals = nub [lit | xs <- map (snd . snd) rules,+ (Left lit) <- xs,+ elem lit specialCatsP]+ pragma = [r | Left (Left r) <- rs]+ errors = [s | Right s <- rs, not (null s)]+ (symbols,keywords) = partition notIdent reservedWords+ notIdent s = null s || not (isAlpha (head s)) || any (not . isIdentRest) s+ isIdentRest c = isAlphaNum c || c == '_' || c == '\''+ reservedWords = nub [t | (_,(_,its)) <- rules, Right t <- its]+ cats = []+ in (((pragma,(literals,symbols,keywords,cats)),rules),errors)+ revs (cf@((pragma,(literals,symbols,keywords,_)),rules),errors) =+ (((pragma,+ (literals,symbols,keywords,findAllReversibleCats (cfp2cf cf))),rules),errors)++conv :: Err Abs.Grammar -> [Either (Either Pragma RuleP) String]+conv (Bad s) = [Right s]+conv (Ok (Abs.Grammar defs)) = map Left $ concatMap (transDef defs) defs++transDef :: [Abs.Def] -> Abs.Def -> [Either Pragma RuleP]+transDef defs x = case x of+ Abs.Rule label cat items -> + [Right (transLabel label,(transCat cat,map transItem items))]+ Abs.Comment str -> [Left $ CommentS str]+ Abs.Comments str0 str -> [Left $ CommentM (str0,str)]+ Abs.Token ident reg -> [Left $ TokenReg (transIdent ident) False reg]+ Abs.PosToken ident reg -> [Left $ TokenReg (transIdent ident) True reg]+ Abs.Entryp idents -> [Left $ EntryPoints (map transIdent idents)]+ Abs.Internal label cat items -> + [Right (transLabel label,(transCat cat,(Left "#":(map transItem items))))]+ Abs.Separator size ident str -> map (Right . cf2cfpRule) $ separatorRules size ident str+ Abs.Terminator size ident str -> map (Right . cf2cfpRule) $ terminatorRules size ident str+ Abs.Coercions ident int -> map (Right . cf2cfpRule) $ coercionRules ident int+ Abs.Rules ident strs -> map (Right . cf2cfpRule) $ ebnfRules ident strs+ Abs.Layout ss -> [Left $ Layout ss]+ Abs.LayoutStop ss -> [Left $ LayoutStop ss]+ Abs.LayoutTop -> [Left $ LayoutTop]+-- Abs.Function f xs e -> [Left $ FunDef (transIdent f) (map transArg xs) (transExp e)]+ Abs.AntiQuote b i a ->+ [Left $ AntiQuote b i a] + ++ [Left $ TokenReg "AqToken" False $ aqToken i a]+ ++ nub (concatMap (aqDefs (b,i,a) (concatMap toks defs)) defs) where+ reg = aqToken a++aqToken :: String -> String -> Abs.Reg+aqToken i s@(c:cs) = Abs.RSeq (Abs.RSeqs i) $ Abs.RSeq (Abs.RStar $ foldr1 Abs.RAlt $ map clause prefixes) $ Abs.RSeqs s where+ prefixes = scanr (:) [c] . reverse $ cs+-- clause [d] = RMinus $ RAny $ RChar d+ clause (d:ds) = subclause (reverse ds) (Abs.RMinus Abs.RAny $ Abs.RChar d)+ subclause [] x = x+ subclause (e:es) x = Abs.RSeq (Abs.RChar e) (subclause es x)++-- {":"} (((char - ']')':' | (char - ':')) * {":]"}+++-- Abs.RSeq (Abs.RSeqs i) (go $ reverse cs) where+-- go [] = (Abs.RMinus Abs.RAny (Abs.RChar c))+-- go (d:ds) = Abs.RSeq (Abs.RStar $ go ds) (Abs.RChar d) ++-- TokenReg "AqToken" False +-- (Abs.RSeq+-- (Abs.RSeq+-- (Abs.RSeqs i)+-- (Abs.RStar Abs.RAny))+-- (Abs.RSeqs a))++++-- \begin{hack}+aqDefs :: (String,String,String) -> [String] -> Abs.Def -> [Either Pragma RuleP]+aqDefs ss tokens x = addSpecials ss $ concatMap (renamers ss tokens) $ case x of+ Abs.Rule label cat items -> [Right (transLabel label,(transCat cat,map transItem items))]+-- case cat of+-- Abs.ListCat _ -> []+-- _ -> [Right (transLabel label,(transCat cat,map transItem items))]+ Abs.Comment str -> []+ Abs.Comments str0 str -> []+ Abs.Token ident reg -> []+ Abs.PosToken ident reg -> []+ Abs.Entryp idents -> [Left $ EntryPoints (map transIdent idents)]+ Abs.Internal label cat items -> + [Right (transLabel label,(transCat cat,(Left "#":(map transItem items))))]+ Abs.Separator size ident str -> map (Right . cf2cfpRule) $ separatorRules size ident str+ Abs.Terminator size ident str -> map (Right . cf2cfpRule) $ terminatorRules size ident str+ Abs.Coercions ident int -> map (Right . cf2cfpRule) $ coercionRules ident int+ Abs.Rules ident strs -> map (Right . cf2cfpRule) $ ebnfRules ident strs+ Abs.Layout ss -> []+ Abs.LayoutStop ss -> []+ Abs.LayoutTop -> []+-- Abs.Function f xs e -> []+ Abs.AntiQuote b i a -> []++++++toks x = case x of+ Abs.Token (Abs.Ident ident) reg -> [ident]+ Abs.PosToken (Abs.Ident ident) reg -> [ident]+ _ -> []++renamers :: (String,String,String) -> [String] -> Either Pragma RuleP -> [Either Pragma RuleP]+renamers (b,i,a) tokens = either (return . Left . renamep) (map Right . renamer) where+ renamep (EntryPoints eps) = EntryPoints $ map rename eps+ renamer ((lab,(lab' ,p)),(cat,its)) = [+ ((rename lab,(rename lab' , p)),(rename cat, map renameItem its))+ ] ++ if isList cat then [] else [+ cf2cfpRule (renameAq cat,(rename cat, [Right b,Left "AqToken"])),+ cf2cfpRule (renameAqt cat,(rename cat, [Right (b++normCat cat), Left "AqToken"]))+ ]++ renameItem = either (\s -> Left $ (if s `elem` tokens then id else rename) s) (Right . id)++addSpecials :: (String,String,String) -> [Either Pragma RuleP] -> [Either Pragma RuleP]+addSpecials (b,i,a) rs = rs ++ concatMap special literals where+ + special aqs@('A':'Q':'_':s) = map Right [cf2cfpRule $ (aqs,(aqs,[Left s])),+ cf2cfpRule (renameAq s,(rename s, [Right b,Left "AqToken"])),+ cf2cfpRule (renameAqt s,(rename s, [Right (b++s), Left "AqToken"]))+ ]+ rules = [r | (Right r) <- rs]+ literals = nub [lit | xs <- map (snd . snd) rules,+ (Left lit) <- xs,+ elem lit (map rename specialCatsP)]+-- \end{hack}++++separatorRules :: Abs.MinimumSize -> Abs.Cat -> String -> [Rule]+separatorRules size c s = if null s then terminatorRules size c s else ifEmpty [+ ("(:[])", (cs,[Left c'])),+ ("(:)", (cs,[Left c', Right s, Left cs]))+ ]+ where + c' = transCat c+ cs = "[" ++ c' ++ "]"+ ifEmpty rs = if (size == Abs.MNonempty) then rs else (("[]", (cs,[])) : rs)++terminatorRules :: Abs.MinimumSize -> Abs.Cat -> String -> [Rule]+terminatorRules size c s = [+ ifEmpty,+ ("(:)", (cs,Left c' : s' [Left cs]))+ ]+ where + c' = transCat c+ cs = "[" ++ c' ++ "]"+ s' its = if null s then its else (Right s : its)+ ifEmpty = if (size == Abs.MNonempty) + then ("(:[])",(cs,[Left c'] ++ if null s then [] else [Right s]))+ else ("[]", (cs,[]))++coercionRules :: Abs.Ident -> Integer -> [Rule]+coercionRules (Abs.Ident c) n = + ("_", (c, [Left (c ++ "1")])) :+ [("_", (c ++ show (i-1), [Left (c ++ show i)])) | i <- [2..n]] +++ [("_", (c ++ show n, [Right "(", Left c, Right ")"]))]++ebnfRules :: Abs.Ident -> [Abs.RHS] -> [Rule]+ebnfRules (Abs.Ident c) rhss = + [(mkFun k c its, (c, map transItem its)) | (k, Abs.RHS its) <- zip [1 :: Int ..] rhss]+ where+ mkFun k c i = case i of+ [Abs.Terminal s] -> c' ++ "_" ++ mkName k s+ [Abs.NTerminal n] -> c' ++ identCat (transCat n)+ _ -> c' ++ "_" ++ show k+ c' = c --- normCat c+ mkName k s = if all (\c -> isAlphaNum c || elem c "_'") s + then s else show k++transItem :: Abs.Item -> Either Cat String+transItem x = case x of+ Abs.Terminal str -> Right str+ Abs.NTerminal cat -> Left (transCat cat)++transCat :: Abs.Cat -> Cat+transCat x = case x of+ Abs.ListCat cat -> "[" ++ (transCat cat) ++ "]"+ Abs.IdCat id -> transIdent id++transLabel :: Abs.Label -> (Fun,Prof)+transLabel y = case y of+ Abs.LabNoP f -> let g = transLabelId f in (g,(g,[])) ---- should be Nothing+ Abs.LabP f p -> let g = transLabelId f in (g,(g, map transProf p))+ Abs.LabPF f g p -> (transLabelId f,(transLabelId g, map transProf p))+ Abs.LabF f g -> (transLabelId f,(transLabelId g, []))+ where+ transLabelId x = case x of+ Abs.Id id -> transIdent id+ Abs.Wild -> "_"+ Abs.ListE -> "[]"+ Abs.ListCons -> "(:)"+ Abs.ListOne -> "(:[])"+ Abs.Aq -> "$"+ transProf (Abs.ProfIt bss as) = + ([map fromInteger bs | Abs.Ints bs <- bss], map fromInteger as)++transIdent :: Abs.Ident -> String+transIdent x = case x of+ Abs.Ident str -> str++transArg :: Abs.Arg -> String+transArg (Abs.Arg x) = transIdent x++transExp :: Abs.Exp -> Exp+transExp e = case e of+ Abs.App x es -> App (transIdent x) (map transExp es)+ Abs.Var x -> App (transIdent x) []+ Abs.Cons e1 e2 -> cons e1 (transExp e2)+ Abs.List es -> foldr cons nil es+ Abs.LitInt x -> LitInt x+ Abs.LitDouble x -> LitDouble x+ Abs.LitChar x -> LitChar x+ Abs.LitString x -> LitString x+ where+ cons e1 e2 = App "(:)" [transExp e1, e2]+ nil = App "[]" []+
+ Language/LBNF/LexBNF.hs view
@@ -0,0 +1,293 @@+{-# OPTIONS -cpp #-} +{-# LINE 3 "LexBNF.x" #-} + +{-# OPTIONS -fno-warn-incomplete-patterns #-} +module Language.LBNF.LexBNF where + + + +#if __GLASGOW_HASKELL__ >= 603 +#include "ghcconfig.h" +#elif defined(__GLASGOW_HASKELL__) +#include "config.h" +#endif +#if __GLASGOW_HASKELL__ >= 503 +import Data.Array +import Data.Char (ord) +import Data.Array.Base (unsafeAt) +#else +import Array +import Char (ord) +#endif +alex_base :: Array Int Int +alex_base = listArray (0,30) [1,56,57,23,24,0,68,69,25,26,27,66,0,15,13,156,364,0,279,487,213,0,41,157,211,53,231,33,242,285,439] + +alex_table :: Array Int Int +alex_table = listArray (0,742) [0,-1,-1,-1,-1,-1,-1,-1,-1,-1,11,11,11,11,11,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,11,-1,18,-1,12,-1,-1,23,12,12,12,12,12,3,12,-1,25,25,25,25,25,25,25,25,25,25,13,12,-1,12,-1,12,-1,-1,-1,1,7,7,7,8,14,12,11,11,11,11,11,21,27,27,27,27,27,27,27,27,27,27,0,12,-1,12,-1,12,-1,11,28,0,25,25,25,25,25,25,25,25,25,25,0,0,7,6,0,0,0,0,0,0,0,0,0,10,12,12,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,4,5,16,-1,0,0,0,0,0,0,0,16,16,16,16,16,16,16,16,16,16,0,0,-1,0,0,0,0,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,19,-1,24,22,16,19,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,26,26,26,26,26,26,26,26,26,26,-1,26,26,26,26,26,26,26,26,26,26,0,0,0,22,0,19,0,0,0,0,0,0,0,17,0,0,0,0,0,0,0,22,0,19,0,0,0,22,0,19,30,0,29,27,27,27,27,27,27,27,27,27,27,0,0,0,0,0,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,20,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,0,0,0,0,0,0,0,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,0,0,0,0,16,0,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,27,27,27,27,27,27,27,27,27,27,-1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,17,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,20,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,0,16,16,16,16,16,16,16,16,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0] + +alex_check :: Array Int Int +alex_check = listArray (0,742) [-1,0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63,64,10,10,45,45,45,45,45,58,61,9,10,11,12,13,39,48,49,50,51,52,53,54,55,56,57,-1,91,92,93,94,95,96,32,46,-1,48,49,50,51,52,53,54,55,56,57,-1,-1,45,45,-1,-1,-1,-1,-1,-1,-1,-1,-1,123,124,125,126,127,128,129,130,131,132,133,134,135,136,137,138,139,140,141,142,143,144,145,146,147,148,149,150,151,152,153,154,155,156,157,158,159,160,161,162,163,164,165,166,167,168,169,170,171,172,173,174,175,176,177,178,179,180,181,182,183,184,185,186,187,188,189,190,191,125,125,39,39,-1,-1,-1,-1,-1,-1,-1,48,49,50,51,52,53,54,55,56,57,-1,-1,215,-1,-1,-1,-1,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,34,247,92,39,95,39,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115,116,117,118,119,120,121,122,48,49,50,51,52,53,54,55,56,57,10,48,49,50,51,52,53,54,55,56,57,-1,-1,-1,92,-1,92,-1,-1,-1,-1,-1,-1,-1,34,-1,-1,-1,-1,-1,-1,-1,110,-1,110,-1,-1,-1,116,-1,116,45,-1,101,48,49,50,51,52,53,54,55,56,57,-1,-1,-1,-1,-1,192,193,194,195,196,197,198,199,200,201,202,203,204,205,206,207,208,209,210,211,212,213,214,92,216,217,218,219,220,221,222,223,224,225,226,227,228,229,230,231,232,233,234,235,236,237,238,239,240,241,242,243,244,245,246,39,248,249,250,251,252,253,254,255,48,49,50,51,52,53,54,55,56,57,-1,-1,-1,-1,-1,-1,-1,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,-1,-1,-1,-1,95,-1,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115,116,117,118,119,120,121,122,48,49,50,51,52,53,54,55,56,57,10,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,34,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,192,193,194,195,196,197,198,199,200,201,202,203,204,205,206,207,208,209,210,211,212,213,214,92,216,217,218,219,220,221,222,223,224,225,226,227,228,229,230,231,232,233,234,235,236,237,238,239,240,241,242,243,244,245,246,-1,248,249,250,251,252,253,254,255,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1] + +alex_deflt :: Array Int Int +alex_deflt = listArray (0,30) [15,2,2,-1,9,-1,9,9,9,9,-1,-1,-1,-1,-1,-1,-1,-1,19,19,-1,-1,-1,22,-1,-1,-1,-1,-1,-1,-1] + +alex_accept = listArray (0::Int,30) [[],[(AlexAccSkip)],[(AlexAccSkip)],[(AlexAcc (alex_action_3))],[(AlexAccSkip)],[(AlexAccSkip)],[],[],[],[],[(AlexAcc (alex_action_3))],[(AlexAccSkip)],[(AlexAcc (alex_action_3))],[(AlexAcc (alex_action_3))],[],[(AlexAcc (alex_action_4))],[(AlexAcc (alex_action_4))],[(AlexAcc (alex_action_5))],[],[],[],[(AlexAcc (alex_action_6))],[],[],[],[(AlexAcc (alex_action_7))],[(AlexAcc (alex_action_8))],[(AlexAcc (alex_action_8))],[],[],[]] +{-# LINE 34 "LexBNF.x" #-} + + +tok f p s = f p s + +share :: String -> String +share = id + +data Tok = + TS !String -- reserved words and symbols + | TL !String -- string literals + | TI !String -- integer literals + | TV !String -- identifiers + | TD !String -- double precision float literals + | TC !String -- character literals + + deriving (Eq,Show,Ord) + +data Token = + PT Posn Tok + | Err Posn + deriving (Eq,Show,Ord) + +tokenPos (PT (Pn _ l _) _ :_) = "line " ++ show l +tokenPos (Err (Pn _ l _) :_) = "line " ++ show l +tokenPos _ = "end of file" + +posLineCol (Pn _ l c) = (l,c) +mkPosToken t@(PT p _) = (posLineCol p, prToken t) + +prToken t = case t of + PT _ (TS s) -> s + PT _ (TI s) -> s + PT _ (TV s) -> s + PT _ (TD s) -> s + PT _ (TC s) -> s + + _ -> show t + +data BTree = N | B String Tok BTree BTree deriving (Show) + +eitherResIdent :: (String -> Tok) -> String -> Tok +eitherResIdent tv s = treeFind resWords + where + treeFind N = tv s + treeFind (B a t left right) | s < a = treeFind left + | s > a = treeFind right + | s == a = t + +resWords = b "letter" (b "digit" (b "coercions" (b "char" (b "antiquote" N N) N) (b "define" (b "comment" N N) N)) (b "external" (b "eps" (b "entrypoints" N N) N) (b "layout" (b "internal" N N) N))) (b "stop" (b "position" (b "nonempty" (b "lower" N N) N) (b "separator" (b "rules" N N) N)) (b "toplevel" (b "token" (b "terminator" N N) N) (b "views" (b "upper" N N) N))) + where b s = B s (TS s) + +unescapeInitTail :: String -> String +unescapeInitTail = unesc . tail where + unesc s = case s of + '\\':c:cs | elem c ['\"', '\\', '\''] -> c : unesc cs + '\\':'n':cs -> '\n' : unesc cs + '\\':'t':cs -> '\t' : unesc cs + '"':[] -> [] + c:cs -> c : unesc cs + _ -> [] + +------------------------------------------------------------------- +-- Alex wrapper code. +-- A modified "posn" wrapper. +------------------------------------------------------------------- + +data Posn = Pn !Int !Int !Int + deriving (Eq, Show,Ord) + +alexStartPos :: Posn +alexStartPos = Pn 0 1 1 + +alexMove :: Posn -> Char -> Posn +alexMove (Pn a l c) '\t' = Pn (a+1) l (((c+7) `div` 8)*8+1) +alexMove (Pn a l c) '\n' = Pn (a+1) (l+1) 1 +alexMove (Pn a l c) _ = Pn (a+1) l (c+1) + +type AlexInput = (Posn, -- current position, + Char, -- previous char + String) -- current input string + +tokens :: String -> [Token] +tokens str = go (alexStartPos, '\n', str) + where + go :: (Posn, Char, String) -> [Token] + go inp@(pos, _, str) = + case alexScan inp 0 of + AlexEOF -> [] + AlexError (pos, _, _) -> [Err pos] + AlexSkip inp' len -> go inp' + AlexToken inp' len act -> act pos (take len str) : (go inp') + +alexGetChar :: AlexInput -> Maybe (Char,AlexInput) +alexGetChar (p, c, []) = Nothing +alexGetChar (p, _, (c:s)) = + let p' = alexMove p c + in p' `seq` Just (c, (p', c, s)) + +alexInputPrevChar :: AlexInput -> Char +alexInputPrevChar (p, c, s) = c + +alex_action_3 = tok (\p s -> PT p (TS $ share s)) +alex_action_4 = tok (\p s -> PT p (eitherResIdent (TV . share) s)) +alex_action_5 = tok (\p s -> PT p (TL $ share $ unescapeInitTail s)) +alex_action_6 = tok (\p s -> PT p (TC $ share s)) +alex_action_7 = tok (\p s -> PT p (TI $ share s)) +alex_action_8 = tok (\p s -> PT p (TD $ share s)) +{-# LINE 1 "templates\GenericTemplate.hs" #-} +{-# LINE 1 "templates\\GenericTemplate.hs" #-} +{-# LINE 1 "<built-in>" #-} +{-# LINE 1 "<command line>" #-} +{-# LINE 1 "templates\\GenericTemplate.hs" #-} +-- ----------------------------------------------------------------------------- +-- ALEX TEMPLATE +-- +-- This code is in the PUBLIC DOMAIN; you may copy it freely and use +-- it for any purpose whatsoever. + +-- ----------------------------------------------------------------------------- +-- INTERNALS and main scanner engine + +{-# LINE 37 "templates\\GenericTemplate.hs" #-} + +{-# LINE 47 "templates\\GenericTemplate.hs" #-} + +{-# LINE 68 "templates\\GenericTemplate.hs" #-} +alexIndexInt16OffAddr arr off = arr ! off + + +{-# LINE 89 "templates\\GenericTemplate.hs" #-} +alexIndexInt32OffAddr arr off = arr ! off + + +{-# LINE 100 "templates\\GenericTemplate.hs" #-} +quickIndex arr i = arr ! i + + +-- ----------------------------------------------------------------------------- +-- Main lexing routines + +data AlexReturn a + = AlexEOF + | AlexError !AlexInput + | AlexSkip !AlexInput !Int + | AlexToken !AlexInput !Int a + +-- alexScan :: AlexInput -> StartCode -> AlexReturn a +alexScan input (sc) + = alexScanUser undefined input (sc) + +alexScanUser user input (sc) + = case alex_scan_tkn user input (0) input sc AlexNone of + (AlexNone, input') -> + case alexGetChar input of + Nothing -> + + + + AlexEOF + Just _ -> + + + + AlexError input' + + (AlexLastSkip input'' len, _) -> + + + + AlexSkip input'' len + + (AlexLastAcc k input''' len, _) -> + + + + AlexToken input''' len k + + +-- Push the input through the DFA, remembering the most recent accepting +-- state it encountered. + +alex_scan_tkn user orig_input len input s last_acc = + input `seq` -- strict in the input + let + new_acc = check_accs (alex_accept `quickIndex` (s)) + in + new_acc `seq` + case alexGetChar input of + Nothing -> (new_acc, input) + Just (c, new_input) -> + + + + let + (base) = alexIndexInt32OffAddr alex_base s + ((ord_c)) = ord c + (offset) = (base + ord_c) + (check) = alexIndexInt16OffAddr alex_check offset + + (new_s) = if (offset >= (0)) && (check == ord_c) + then alexIndexInt16OffAddr alex_table offset + else alexIndexInt16OffAddr alex_deflt s + in + case new_s of + (-1) -> (new_acc, input) + -- on an error, we want to keep the input *before* the + -- character that failed, not after. + _ -> alex_scan_tkn user orig_input (len + (1)) + new_input new_s new_acc + + where + check_accs [] = last_acc + check_accs (AlexAcc a : _) = AlexLastAcc a input (len) + check_accs (AlexAccSkip : _) = AlexLastSkip input (len) + check_accs (AlexAccPred a predx : rest) + | predx user orig_input (len) input + = AlexLastAcc a input (len) + check_accs (AlexAccSkipPred predx : rest) + | predx user orig_input (len) input + = AlexLastSkip input (len) + check_accs (_ : rest) = check_accs rest + +data AlexLastAcc a + = AlexNone + | AlexLastAcc a !AlexInput !Int + | AlexLastSkip !AlexInput !Int + +data AlexAcc a user + = AlexAcc a + | AlexAccSkip + | AlexAccPred a (AlexAccPred user) + | AlexAccSkipPred (AlexAccPred user) + +type AlexAccPred user = user -> AlexInput -> Int -> AlexInput -> Bool + +-- ----------------------------------------------------------------------------- +-- Predicates on a rule + +alexAndPred p1 p2 user in1 len in2 + = p1 user in1 len in2 && p2 user in1 len in2 + +--alexPrevCharIsPred :: Char -> AlexAccPred _ +alexPrevCharIs c _ input _ _ = c == alexInputPrevChar input + +--alexPrevCharIsOneOfPred :: Array Char Bool -> AlexAccPred _ +alexPrevCharIsOneOf arr _ input _ _ = arr ! alexInputPrevChar input + +--alexRightContext :: Int -> AlexAccPred _ +alexRightContext (sc) user _ _ input = + case alex_scan_tkn user input (0) input sc AlexNone of + (AlexNone, _) -> False + _ -> True + -- TODO: there's no need to find the longest + -- match when checking the right context, just + -- the first match will do. + +-- used by wrappers +iUnbox (i) = i
+ Language/LBNF/LiftBNF.hs view
@@ -0,0 +1,34 @@+{-#Language TemplateHaskell #-}+module Language.LBNF.LiftBNF where+import Language.LBNF.AbsBNF+import Language.Haskell.TH.Lift+import Language.Haskell.TH.Syntax hiding (Exp)+import Language.Haskell.TH hiding (Exp)++import qualified Language.LBNF.CF as CF++deriveLift ''Grammar+deriveLift ''Def+deriveLift ''Exp+deriveLift ''Arg+deriveLift ''RHS+deriveLift ''MinimumSize+deriveLift ''ProfItem+deriveLift ''LabelId+deriveLift ''IntList+deriveLift ''Reg+deriveLift ''Item+deriveLift ''Cat+deriveLift ''Label++deriveLift ''HsTyp++instance Lift Ident where+ lift (Ident s) = [| Ident s|]+ +instance Lift Double where+ lift d = litE (DoublePrimL $ toRational d)+ + +deriveLift ''CF.Exp+deriveLift ''CF.Pragma
+ Language/LBNF/ParBNF.hs view
@@ -0,0 +1,3158 @@+{-# OPTIONS_GHC -fno-warn-overlapping-patterns #-} +{-# OPTIONS -fno-warn-incomplete-patterns -fno-warn-overlapping-patterns #-} +module Language.LBNF.ParBNF where +import Language.LBNF.AbsBNF +import Language.LBNF.LexBNF +import Language.LBNF.ErrM + +-- parser produced by Happy Version 1.18.5 + +data HappyAbsSyn + = HappyTerminal (Token) + | HappyErrorToken Int + | HappyAbsSyn38 (String) + | HappyAbsSyn39 (Ident) + | HappyAbsSyn40 (Integer) + | HappyAbsSyn41 (Char) + | HappyAbsSyn42 (Double) + | HappyAbsSyn43 (LGrammar) + | HappyAbsSyn44 (LDef) + | HappyAbsSyn45 ([LDef]) + | HappyAbsSyn46 (Grammar) + | HappyAbsSyn47 ([Def]) + | HappyAbsSyn48 ([Item]) + | HappyAbsSyn49 (Def) + | HappyAbsSyn50 (Item) + | HappyAbsSyn51 (Cat) + | HappyAbsSyn52 (Label) + | HappyAbsSyn53 (LabelId) + | HappyAbsSyn54 (ProfItem) + | HappyAbsSyn55 (IntList) + | HappyAbsSyn56 ([Integer]) + | HappyAbsSyn57 ([IntList]) + | HappyAbsSyn58 ([ProfItem]) + | HappyAbsSyn59 (HsTyp) + | HappyAbsSyn61 ([HsTyp]) + | HappyAbsSyn62 (Arg) + | HappyAbsSyn63 ([Arg]) + | HappyAbsSyn64 (Exp) + | HappyAbsSyn67 ([Exp]) + | HappyAbsSyn69 ([String]) + | HappyAbsSyn70 ([RHS]) + | HappyAbsSyn71 (RHS) + | HappyAbsSyn72 (MinimumSize) + | HappyAbsSyn73 (Reg) + | HappyAbsSyn77 ([Ident]) + +{- 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 = + 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, + action_74, + action_75, + action_76, + action_77, + action_78, + action_79, + action_80, + action_81, + action_82, + action_83, + action_84, + action_85, + action_86, + action_87, + action_88, + action_89, + action_90, + action_91, + action_92, + action_93, + action_94, + action_95, + action_96, + action_97, + action_98, + action_99, + action_100, + action_101, + action_102, + action_103, + action_104, + action_105, + action_106, + action_107, + action_108, + action_109, + action_110, + action_111, + action_112, + action_113, + action_114, + action_115, + action_116, + action_117, + action_118, + action_119, + action_120, + action_121, + action_122, + action_123, + action_124, + action_125, + action_126, + action_127, + action_128, + action_129, + action_130, + action_131, + action_132, + action_133, + action_134, + action_135, + action_136, + action_137, + action_138, + action_139, + action_140, + action_141, + action_142, + action_143, + action_144, + action_145, + action_146, + action_147, + action_148, + action_149, + action_150, + action_151, + action_152, + action_153, + action_154, + action_155, + action_156, + action_157, + action_158, + action_159, + action_160, + action_161, + action_162, + action_163, + action_164, + action_165, + action_166, + action_167, + action_168, + action_169, + action_170, + action_171, + action_172, + action_173, + action_174, + action_175, + action_176, + action_177, + action_178, + action_179, + action_180, + action_181, + action_182, + action_183, + action_184, + action_185, + action_186, + action_187, + action_188, + action_189, + action_190, + action_191, + action_192, + action_193, + action_194, + action_195, + action_196, + action_197, + action_198, + action_199, + action_200, + action_201, + action_202, + action_203, + action_204, + action_205, + action_206, + action_207, + action_208, + action_209, + action_210, + action_211, + action_212, + action_213, + action_214, + action_215, + action_216, + action_217, + action_218, + action_219, + action_220, + action_221, + action_222, + action_223, + action_224, + action_225, + action_226, + action_227, + action_228, + action_229, + action_230, + action_231, + action_232, + action_233, + action_234, + action_235, + action_236, + action_237, + action_238, + action_239, + action_240, + action_241, + action_242, + action_243, + action_244, + action_245, + action_246, + action_247, + action_248, + action_249, + action_250, + action_251, + action_252, + action_253, + action_254, + action_255, + action_256, + action_257, + action_258, + action_259, + action_260, + action_261, + action_262 :: () => Int -> ({-HappyReduction (Err) = -} + Int + -> (Token) + -> HappyState (Token) (HappyStk HappyAbsSyn -> [(Token)] -> (Err) HappyAbsSyn) + -> [HappyState (Token) (HappyStk HappyAbsSyn -> [(Token)] -> (Err) HappyAbsSyn)] + -> HappyStk HappyAbsSyn + -> [(Token)] -> (Err) HappyAbsSyn) + +happyReduce_35, + happyReduce_36, + happyReduce_37, + happyReduce_38, + happyReduce_39, + happyReduce_40, + happyReduce_41, + happyReduce_42, + happyReduce_43, + happyReduce_44, + happyReduce_45, + happyReduce_46, + happyReduce_47, + happyReduce_48, + happyReduce_49, + happyReduce_50, + happyReduce_51, + happyReduce_52, + happyReduce_53, + happyReduce_54, + happyReduce_55, + happyReduce_56, + happyReduce_57, + happyReduce_58, + happyReduce_59, + happyReduce_60, + happyReduce_61, + happyReduce_62, + happyReduce_63, + happyReduce_64, + happyReduce_65, + happyReduce_66, + happyReduce_67, + happyReduce_68, + happyReduce_69, + happyReduce_70, + happyReduce_71, + happyReduce_72, + happyReduce_73, + happyReduce_74, + happyReduce_75, + happyReduce_76, + happyReduce_77, + happyReduce_78, + happyReduce_79, + happyReduce_80, + happyReduce_81, + happyReduce_82, + happyReduce_83, + happyReduce_84, + happyReduce_85, + happyReduce_86, + happyReduce_87, + happyReduce_88, + happyReduce_89, + happyReduce_90, + happyReduce_91, + happyReduce_92, + happyReduce_93, + happyReduce_94, + happyReduce_95, + happyReduce_96, + happyReduce_97, + happyReduce_98, + happyReduce_99, + happyReduce_100, + happyReduce_101, + happyReduce_102, + happyReduce_103, + happyReduce_104, + happyReduce_105, + happyReduce_106, + happyReduce_107, + happyReduce_108, + happyReduce_109, + happyReduce_110, + happyReduce_111, + happyReduce_112, + happyReduce_113, + happyReduce_114, + happyReduce_115, + happyReduce_116, + happyReduce_117, + happyReduce_118, + happyReduce_119, + happyReduce_120, + happyReduce_121, + happyReduce_122, + happyReduce_123, + happyReduce_124, + happyReduce_125, + happyReduce_126, + happyReduce_127, + happyReduce_128, + happyReduce_129, + happyReduce_130, + happyReduce_131, + happyReduce_132, + happyReduce_133, + happyReduce_134, + happyReduce_135, + happyReduce_136, + happyReduce_137, + happyReduce_138, + happyReduce_139, + happyReduce_140, + happyReduce_141, + happyReduce_142, + happyReduce_143, + happyReduce_144, + happyReduce_145, + happyReduce_146 :: () => ({-HappyReduction (Err) = -} + Int + -> (Token) + -> HappyState (Token) (HappyStk HappyAbsSyn -> [(Token)] -> (Err) HappyAbsSyn) + -> [HappyState (Token) (HappyStk HappyAbsSyn -> [(Token)] -> (Err) HappyAbsSyn)] + -> HappyStk HappyAbsSyn + -> [(Token)] -> (Err) HappyAbsSyn) + +action_0 (82) = happyShift action_107 +action_0 (84) = happyShift action_108 +action_0 (85) = happyShift action_109 +action_0 (87) = happyShift action_110 +action_0 (97) = happyShift action_121 +action_0 (99) = happyShift action_122 +action_0 (100) = happyShift action_123 +action_0 (101) = happyShift action_124 +action_0 (103) = happyShift action_125 +action_0 (105) = happyShift action_126 +action_0 (106) = happyShift action_127 +action_0 (107) = happyShift action_128 +action_0 (111) = happyShift action_129 +action_0 (112) = happyShift action_130 +action_0 (113) = happyShift action_131 +action_0 (115) = happyShift action_132 +action_0 (116) = happyShift action_133 +action_0 (119) = happyShift action_144 +action_0 (121) = happyShift action_39 +action_0 (39) = happyGoto action_139 +action_0 (43) = happyGoto action_146 +action_0 (44) = happyGoto action_140 +action_0 (45) = happyGoto action_147 +action_0 (49) = happyGoto action_142 +action_0 (52) = happyGoto action_120 +action_0 (53) = happyGoto action_112 +action_0 (77) = happyGoto action_143 +action_0 _ = happyReduce_44 + +action_1 (82) = happyShift action_107 +action_1 (84) = happyShift action_108 +action_1 (85) = happyShift action_109 +action_1 (87) = happyShift action_110 +action_1 (97) = happyShift action_121 +action_1 (99) = happyShift action_122 +action_1 (100) = happyShift action_123 +action_1 (101) = happyShift action_124 +action_1 (103) = happyShift action_125 +action_1 (105) = happyShift action_126 +action_1 (106) = happyShift action_127 +action_1 (107) = happyShift action_128 +action_1 (111) = happyShift action_129 +action_1 (112) = happyShift action_130 +action_1 (113) = happyShift action_131 +action_1 (115) = happyShift action_132 +action_1 (116) = happyShift action_133 +action_1 (119) = happyShift action_144 +action_1 (121) = happyShift action_39 +action_1 (39) = happyGoto action_139 +action_1 (44) = happyGoto action_145 +action_1 (49) = happyGoto action_142 +action_1 (52) = happyGoto action_120 +action_1 (53) = happyGoto action_112 +action_1 (77) = happyGoto action_143 +action_1 _ = happyFail + +action_2 (82) = happyShift action_107 +action_2 (84) = happyShift action_108 +action_2 (85) = happyShift action_109 +action_2 (87) = happyShift action_110 +action_2 (97) = happyShift action_121 +action_2 (99) = happyShift action_122 +action_2 (100) = happyShift action_123 +action_2 (101) = happyShift action_124 +action_2 (103) = happyShift action_125 +action_2 (105) = happyShift action_126 +action_2 (106) = happyShift action_127 +action_2 (107) = happyShift action_128 +action_2 (111) = happyShift action_129 +action_2 (112) = happyShift action_130 +action_2 (113) = happyShift action_131 +action_2 (115) = happyShift action_132 +action_2 (116) = happyShift action_133 +action_2 (119) = happyShift action_144 +action_2 (121) = happyShift action_39 +action_2 (39) = happyGoto action_139 +action_2 (44) = happyGoto action_140 +action_2 (45) = happyGoto action_141 +action_2 (49) = happyGoto action_142 +action_2 (52) = happyGoto action_120 +action_2 (53) = happyGoto action_112 +action_2 (77) = happyGoto action_143 +action_2 _ = happyReduce_44 + +action_3 (82) = happyShift action_107 +action_3 (84) = happyShift action_108 +action_3 (85) = happyShift action_109 +action_3 (87) = happyShift action_110 +action_3 (97) = happyShift action_121 +action_3 (99) = happyShift action_122 +action_3 (100) = happyShift action_123 +action_3 (101) = happyShift action_124 +action_3 (103) = happyShift action_125 +action_3 (105) = happyShift action_126 +action_3 (106) = happyShift action_127 +action_3 (107) = happyShift action_128 +action_3 (111) = happyShift action_129 +action_3 (112) = happyShift action_130 +action_3 (113) = happyShift action_131 +action_3 (115) = happyShift action_132 +action_3 (116) = happyShift action_133 +action_3 (121) = happyShift action_39 +action_3 (39) = happyGoto action_105 +action_3 (46) = happyGoto action_137 +action_3 (47) = happyGoto action_138 +action_3 (49) = happyGoto action_136 +action_3 (52) = happyGoto action_120 +action_3 (53) = happyGoto action_112 +action_3 _ = happyReduce_48 + +action_4 (82) = happyShift action_107 +action_4 (84) = happyShift action_108 +action_4 (85) = happyShift action_109 +action_4 (87) = happyShift action_110 +action_4 (97) = happyShift action_121 +action_4 (99) = happyShift action_122 +action_4 (100) = happyShift action_123 +action_4 (101) = happyShift action_124 +action_4 (103) = happyShift action_125 +action_4 (105) = happyShift action_126 +action_4 (106) = happyShift action_127 +action_4 (107) = happyShift action_128 +action_4 (111) = happyShift action_129 +action_4 (112) = happyShift action_130 +action_4 (113) = happyShift action_131 +action_4 (115) = happyShift action_132 +action_4 (116) = happyShift action_133 +action_4 (121) = happyShift action_39 +action_4 (39) = happyGoto action_105 +action_4 (47) = happyGoto action_135 +action_4 (49) = happyGoto action_136 +action_4 (52) = happyGoto action_120 +action_4 (53) = happyGoto action_112 +action_4 _ = happyReduce_48 + +action_5 (48) = happyGoto action_134 +action_5 _ = happyReduce_51 + +action_6 (82) = happyShift action_107 +action_6 (84) = happyShift action_108 +action_6 (85) = happyShift action_109 +action_6 (87) = happyShift action_110 +action_6 (97) = happyShift action_121 +action_6 (99) = happyShift action_122 +action_6 (100) = happyShift action_123 +action_6 (101) = happyShift action_124 +action_6 (103) = happyShift action_125 +action_6 (105) = happyShift action_126 +action_6 (106) = happyShift action_127 +action_6 (107) = happyShift action_128 +action_6 (111) = happyShift action_129 +action_6 (112) = happyShift action_130 +action_6 (113) = happyShift action_131 +action_6 (115) = happyShift action_132 +action_6 (116) = happyShift action_133 +action_6 (121) = happyShift action_39 +action_6 (39) = happyGoto action_105 +action_6 (49) = happyGoto action_119 +action_6 (52) = happyGoto action_120 +action_6 (53) = happyGoto action_112 +action_6 _ = happyFail + +action_7 (82) = happyShift action_115 +action_7 (120) = happyShift action_36 +action_7 (121) = happyShift action_39 +action_7 (38) = happyGoto action_116 +action_7 (39) = happyGoto action_113 +action_7 (50) = happyGoto action_117 +action_7 (51) = happyGoto action_118 +action_7 _ = happyFail + +action_8 (82) = happyShift action_115 +action_8 (121) = happyShift action_39 +action_8 (39) = happyGoto action_113 +action_8 (51) = happyGoto action_114 +action_8 _ = happyFail + +action_9 (82) = happyShift action_107 +action_9 (84) = happyShift action_108 +action_9 (85) = happyShift action_109 +action_9 (87) = happyShift action_110 +action_9 (121) = happyShift action_39 +action_9 (39) = happyGoto action_105 +action_9 (52) = happyGoto action_111 +action_9 (53) = happyGoto action_112 +action_9 _ = happyFail + +action_10 (82) = happyShift action_107 +action_10 (84) = happyShift action_108 +action_10 (85) = happyShift action_109 +action_10 (87) = happyShift action_110 +action_10 (121) = happyShift action_39 +action_10 (39) = happyGoto action_105 +action_10 (53) = happyGoto action_106 +action_10 _ = happyFail + +action_11 (85) = happyShift action_97 +action_11 (54) = happyGoto action_104 +action_11 _ = happyFail + +action_12 (82) = happyShift action_100 +action_12 (55) = happyGoto action_103 +action_12 _ = happyFail + +action_13 (122) = happyShift action_77 +action_13 (40) = happyGoto action_101 +action_13 (56) = happyGoto action_102 +action_13 _ = happyReduce_86 + +action_14 (82) = happyShift action_100 +action_14 (55) = happyGoto action_98 +action_14 (57) = happyGoto action_99 +action_14 _ = happyReduce_89 + +action_15 (85) = happyShift action_97 +action_15 (54) = happyGoto action_95 +action_15 (58) = happyGoto action_96 +action_15 _ = happyFail + +action_16 (59) = happyGoto action_94 +action_16 _ = happyFail + +action_17 (82) = happyShift action_92 +action_17 (85) = happyShift action_93 +action_17 (121) = happyShift action_39 +action_17 (39) = happyGoto action_90 +action_17 (60) = happyGoto action_91 +action_17 _ = happyFail + +action_18 (59) = happyGoto action_88 +action_18 (61) = happyGoto action_89 +action_18 _ = happyFail + +action_19 (121) = happyShift action_39 +action_19 (39) = happyGoto action_86 +action_19 (62) = happyGoto action_87 +action_19 _ = happyFail + +action_20 (63) = happyGoto action_85 +action_20 _ = happyReduce_101 + +action_21 (82) = happyShift action_75 +action_21 (85) = happyShift action_76 +action_21 (120) = happyShift action_36 +action_21 (121) = happyShift action_39 +action_21 (122) = happyShift action_77 +action_21 (123) = happyShift action_54 +action_21 (124) = happyShift action_78 +action_21 (38) = happyGoto action_66 +action_21 (39) = happyGoto action_67 +action_21 (40) = happyGoto action_68 +action_21 (41) = happyGoto action_69 +action_21 (42) = happyGoto action_70 +action_21 (64) = happyGoto action_84 +action_21 (65) = happyGoto action_72 +action_21 (66) = happyGoto action_73 +action_21 _ = happyFail + +action_22 (82) = happyShift action_75 +action_22 (85) = happyShift action_76 +action_22 (120) = happyShift action_36 +action_22 (121) = happyShift action_39 +action_22 (122) = happyShift action_77 +action_22 (123) = happyShift action_54 +action_22 (124) = happyShift action_78 +action_22 (38) = happyGoto action_66 +action_22 (39) = happyGoto action_67 +action_22 (40) = happyGoto action_68 +action_22 (41) = happyGoto action_69 +action_22 (42) = happyGoto action_70 +action_22 (65) = happyGoto action_83 +action_22 (66) = happyGoto action_73 +action_22 _ = happyFail + +action_23 (82) = happyShift action_75 +action_23 (85) = happyShift action_76 +action_23 (120) = happyShift action_36 +action_23 (121) = happyShift action_39 +action_23 (122) = happyShift action_77 +action_23 (123) = happyShift action_54 +action_23 (124) = happyShift action_78 +action_23 (38) = happyGoto action_66 +action_23 (39) = happyGoto action_79 +action_23 (40) = happyGoto action_68 +action_23 (41) = happyGoto action_69 +action_23 (42) = happyGoto action_70 +action_23 (66) = happyGoto action_82 +action_23 _ = happyFail + +action_24 (82) = happyShift action_75 +action_24 (85) = happyShift action_76 +action_24 (120) = happyShift action_36 +action_24 (121) = happyShift action_39 +action_24 (122) = happyShift action_77 +action_24 (123) = happyShift action_54 +action_24 (124) = happyShift action_78 +action_24 (38) = happyGoto action_66 +action_24 (39) = happyGoto action_79 +action_24 (40) = happyGoto action_68 +action_24 (41) = happyGoto action_69 +action_24 (42) = happyGoto action_70 +action_24 (66) = happyGoto action_80 +action_24 (67) = happyGoto action_81 +action_24 _ = happyFail + +action_25 (82) = happyShift action_75 +action_25 (85) = happyShift action_76 +action_25 (120) = happyShift action_36 +action_25 (121) = happyShift action_39 +action_25 (122) = happyShift action_77 +action_25 (123) = happyShift action_54 +action_25 (124) = happyShift action_78 +action_25 (38) = happyGoto action_66 +action_25 (39) = happyGoto action_67 +action_25 (40) = happyGoto action_68 +action_25 (41) = happyGoto action_69 +action_25 (42) = happyGoto action_70 +action_25 (64) = happyGoto action_71 +action_25 (65) = happyGoto action_72 +action_25 (66) = happyGoto action_73 +action_25 (68) = happyGoto action_74 +action_25 _ = happyReduce_116 + +action_26 (120) = happyShift action_36 +action_26 (38) = happyGoto action_64 +action_26 (69) = happyGoto action_65 +action_26 _ = happyFail + +action_27 (48) = happyGoto action_60 +action_27 (70) = happyGoto action_62 +action_27 (71) = happyGoto action_63 +action_27 _ = happyReduce_51 + +action_28 (48) = happyGoto action_60 +action_28 (71) = happyGoto action_61 +action_28 _ = happyReduce_51 + +action_29 (110) = happyShift action_59 +action_29 (72) = happyGoto action_58 +action_29 _ = happyReduce_125 + +action_30 (82) = happyShift action_45 +action_30 (85) = happyShift action_46 +action_30 (95) = happyShift action_47 +action_30 (98) = happyShift action_48 +action_30 (102) = happyShift action_49 +action_30 (104) = happyShift action_50 +action_30 (108) = happyShift action_51 +action_30 (109) = happyShift action_52 +action_30 (118) = happyShift action_53 +action_30 (123) = happyShift action_54 +action_30 (41) = happyGoto action_40 +action_30 (73) = happyGoto action_57 +action_30 (75) = happyGoto action_43 +action_30 _ = happyFail + +action_31 (82) = happyShift action_45 +action_31 (85) = happyShift action_46 +action_31 (95) = happyShift action_47 +action_31 (98) = happyShift action_48 +action_31 (102) = happyShift action_49 +action_31 (104) = happyShift action_50 +action_31 (108) = happyShift action_51 +action_31 (109) = happyShift action_52 +action_31 (118) = happyShift action_53 +action_31 (123) = happyShift action_54 +action_31 (41) = happyGoto action_40 +action_31 (73) = happyGoto action_41 +action_31 (74) = happyGoto action_56 +action_31 (75) = happyGoto action_43 +action_31 _ = happyFail + +action_32 (82) = happyShift action_45 +action_32 (85) = happyShift action_46 +action_32 (95) = happyShift action_47 +action_32 (98) = happyShift action_48 +action_32 (102) = happyShift action_49 +action_32 (104) = happyShift action_50 +action_32 (108) = happyShift action_51 +action_32 (109) = happyShift action_52 +action_32 (118) = happyShift action_53 +action_32 (123) = happyShift action_54 +action_32 (41) = happyGoto action_40 +action_32 (75) = happyGoto action_55 +action_32 _ = happyFail + +action_33 (82) = happyShift action_45 +action_33 (85) = happyShift action_46 +action_33 (95) = happyShift action_47 +action_33 (98) = happyShift action_48 +action_33 (102) = happyShift action_49 +action_33 (104) = happyShift action_50 +action_33 (108) = happyShift action_51 +action_33 (109) = happyShift action_52 +action_33 (118) = happyShift action_53 +action_33 (123) = happyShift action_54 +action_33 (41) = happyGoto action_40 +action_33 (73) = happyGoto action_41 +action_33 (74) = happyGoto action_42 +action_33 (75) = happyGoto action_43 +action_33 (76) = happyGoto action_44 +action_33 _ = happyFail + +action_34 (121) = happyShift action_39 +action_34 (39) = happyGoto action_37 +action_34 (77) = happyGoto action_38 +action_34 _ = happyFail + +action_35 (120) = happyShift action_36 +action_35 _ = happyFail + +action_36 _ = happyReduce_35 + +action_37 (88) = happyShift action_151 +action_37 _ = happyReduce_145 + +action_38 (126) = happyAccept +action_38 _ = happyFail + +action_39 _ = happyReduce_36 + +action_40 _ = happyReduce_135 + +action_41 (82) = happyShift action_45 +action_41 (85) = happyShift action_46 +action_41 (91) = happyShift action_202 +action_41 (95) = happyShift action_47 +action_41 (98) = happyShift action_48 +action_41 (102) = happyShift action_49 +action_41 (104) = happyShift action_50 +action_41 (108) = happyShift action_51 +action_41 (109) = happyShift action_52 +action_41 (118) = happyShift action_53 +action_41 (123) = happyShift action_54 +action_41 (41) = happyGoto action_40 +action_41 (75) = happyGoto action_194 +action_41 _ = happyReduce_130 + +action_42 (90) = happyShift action_195 +action_42 _ = happyReduce_144 + +action_43 (92) = happyShift action_196 +action_43 (93) = happyShift action_197 +action_43 (94) = happyShift action_198 +action_43 _ = happyReduce_127 + +action_44 (126) = happyAccept +action_44 _ = happyFail + +action_45 (120) = happyShift action_36 +action_45 (38) = happyGoto action_201 +action_45 _ = happyFail + +action_46 (82) = happyShift action_45 +action_46 (85) = happyShift action_46 +action_46 (95) = happyShift action_47 +action_46 (98) = happyShift action_48 +action_46 (102) = happyShift action_49 +action_46 (104) = happyShift action_50 +action_46 (108) = happyShift action_51 +action_46 (109) = happyShift action_52 +action_46 (118) = happyShift action_53 +action_46 (123) = happyShift action_54 +action_46 (41) = happyGoto action_40 +action_46 (73) = happyGoto action_41 +action_46 (74) = happyGoto action_42 +action_46 (75) = happyGoto action_43 +action_46 (76) = happyGoto action_200 +action_46 _ = happyFail + +action_47 (120) = happyShift action_36 +action_47 (38) = happyGoto action_199 +action_47 _ = happyFail + +action_48 _ = happyReduce_142 + +action_49 _ = happyReduce_138 + +action_50 _ = happyReduce_134 + +action_51 _ = happyReduce_139 + +action_52 _ = happyReduce_141 + +action_53 _ = happyReduce_140 + +action_54 _ = happyReduce_38 + +action_55 (92) = happyShift action_196 +action_55 (93) = happyShift action_197 +action_55 (94) = happyShift action_198 +action_55 (126) = happyAccept +action_55 _ = happyFail + +action_56 (90) = happyShift action_195 +action_56 (126) = happyAccept +action_56 _ = happyFail + +action_57 (82) = happyShift action_45 +action_57 (85) = happyShift action_46 +action_57 (95) = happyShift action_47 +action_57 (98) = happyShift action_48 +action_57 (102) = happyShift action_49 +action_57 (104) = happyShift action_50 +action_57 (108) = happyShift action_51 +action_57 (109) = happyShift action_52 +action_57 (118) = happyShift action_53 +action_57 (123) = happyShift action_54 +action_57 (126) = happyAccept +action_57 (41) = happyGoto action_40 +action_57 (75) = happyGoto action_194 +action_57 _ = happyFail + +action_58 (126) = happyAccept +action_58 _ = happyFail + +action_59 _ = happyReduce_124 + +action_60 (82) = happyShift action_115 +action_60 (120) = happyShift action_36 +action_60 (121) = happyShift action_39 +action_60 (38) = happyGoto action_116 +action_60 (39) = happyGoto action_113 +action_60 (50) = happyGoto action_153 +action_60 (51) = happyGoto action_118 +action_60 _ = happyReduce_123 + +action_61 (126) = happyAccept +action_61 _ = happyFail + +action_62 (126) = happyAccept +action_62 _ = happyFail + +action_63 (90) = happyShift action_193 +action_63 _ = happyReduce_121 + +action_64 (88) = happyShift action_192 +action_64 _ = happyReduce_119 + +action_65 (126) = happyAccept +action_65 _ = happyFail + +action_66 _ = happyReduce_110 + +action_67 (82) = happyShift action_75 +action_67 (85) = happyShift action_76 +action_67 (120) = happyShift action_36 +action_67 (121) = happyShift action_39 +action_67 (122) = happyShift action_77 +action_67 (123) = happyShift action_54 +action_67 (124) = happyShift action_78 +action_67 (38) = happyGoto action_66 +action_67 (39) = happyGoto action_79 +action_67 (40) = happyGoto action_68 +action_67 (41) = happyGoto action_69 +action_67 (42) = happyGoto action_70 +action_67 (66) = happyGoto action_80 +action_67 (67) = happyGoto action_191 +action_67 _ = happyReduce_107 + +action_68 _ = happyReduce_108 + +action_69 _ = happyReduce_109 + +action_70 _ = happyReduce_111 + +action_71 (88) = happyShift action_190 +action_71 _ = happyReduce_117 + +action_72 (78) = happyShift action_189 +action_72 _ = happyReduce_104 + +action_73 _ = happyReduce_106 + +action_74 (126) = happyAccept +action_74 _ = happyFail + +action_75 (82) = happyShift action_75 +action_75 (85) = happyShift action_76 +action_75 (120) = happyShift action_36 +action_75 (121) = happyShift action_39 +action_75 (122) = happyShift action_77 +action_75 (123) = happyShift action_54 +action_75 (124) = happyShift action_78 +action_75 (38) = happyGoto action_66 +action_75 (39) = happyGoto action_67 +action_75 (40) = happyGoto action_68 +action_75 (41) = happyGoto action_69 +action_75 (42) = happyGoto action_70 +action_75 (64) = happyGoto action_71 +action_75 (65) = happyGoto action_72 +action_75 (66) = happyGoto action_73 +action_75 (68) = happyGoto action_188 +action_75 _ = happyReduce_116 + +action_76 (82) = happyShift action_75 +action_76 (85) = happyShift action_76 +action_76 (120) = happyShift action_36 +action_76 (121) = happyShift action_39 +action_76 (122) = happyShift action_77 +action_76 (123) = happyShift action_54 +action_76 (124) = happyShift action_78 +action_76 (38) = happyGoto action_66 +action_76 (39) = happyGoto action_67 +action_76 (40) = happyGoto action_68 +action_76 (41) = happyGoto action_69 +action_76 (42) = happyGoto action_70 +action_76 (64) = happyGoto action_187 +action_76 (65) = happyGoto action_72 +action_76 (66) = happyGoto action_73 +action_76 _ = happyFail + +action_77 _ = happyReduce_37 + +action_78 _ = happyReduce_39 + +action_79 _ = happyReduce_107 + +action_80 (82) = happyShift action_75 +action_80 (85) = happyShift action_76 +action_80 (120) = happyShift action_36 +action_80 (121) = happyShift action_39 +action_80 (122) = happyShift action_77 +action_80 (123) = happyShift action_54 +action_80 (124) = happyShift action_78 +action_80 (38) = happyGoto action_66 +action_80 (39) = happyGoto action_79 +action_80 (40) = happyGoto action_68 +action_80 (41) = happyGoto action_69 +action_80 (42) = happyGoto action_70 +action_80 (66) = happyGoto action_80 +action_80 (67) = happyGoto action_186 +action_80 _ = happyReduce_114 + +action_81 (126) = happyAccept +action_81 _ = happyFail + +action_82 (126) = happyAccept +action_82 _ = happyFail + +action_83 (126) = happyAccept +action_83 _ = happyFail + +action_84 (126) = happyAccept +action_84 _ = happyFail + +action_85 (121) = happyShift action_39 +action_85 (126) = happyAccept +action_85 (39) = happyGoto action_86 +action_85 (62) = happyGoto action_185 +action_85 _ = happyFail + +action_86 _ = happyReduce_100 + +action_87 (126) = happyAccept +action_87 _ = happyFail + +action_88 (82) = happyShift action_92 +action_88 (85) = happyShift action_93 +action_88 (88) = happyShift action_184 +action_88 (121) = happyShift action_39 +action_88 (39) = happyGoto action_90 +action_88 (60) = happyGoto action_181 +action_88 _ = happyReduce_98 + +action_89 (126) = happyAccept +action_89 _ = happyFail + +action_90 _ = happyReduce_95 + +action_91 (126) = happyAccept +action_91 _ = happyFail + +action_92 (59) = happyGoto action_183 +action_92 _ = happyFail + +action_93 (59) = happyGoto action_88 +action_93 (61) = happyGoto action_182 +action_93 _ = happyFail + +action_94 (82) = happyShift action_92 +action_94 (85) = happyShift action_93 +action_94 (121) = happyShift action_39 +action_94 (126) = happyAccept +action_94 (39) = happyGoto action_90 +action_94 (60) = happyGoto action_181 +action_94 _ = happyFail + +action_95 (85) = happyShift action_97 +action_95 (54) = happyGoto action_95 +action_95 (58) = happyGoto action_180 +action_95 _ = happyReduce_92 + +action_96 (126) = happyAccept +action_96 _ = happyFail + +action_97 (82) = happyShift action_179 +action_97 _ = happyFail + +action_98 (88) = happyShift action_178 +action_98 _ = happyReduce_90 + +action_99 (126) = happyAccept +action_99 _ = happyFail + +action_100 (122) = happyShift action_77 +action_100 (40) = happyGoto action_101 +action_100 (56) = happyGoto action_177 +action_100 _ = happyReduce_86 + +action_101 (88) = happyShift action_176 +action_101 _ = happyReduce_87 + +action_102 (126) = happyAccept +action_102 _ = happyFail + +action_103 (126) = happyAccept +action_103 _ = happyFail + +action_104 (126) = happyAccept +action_104 _ = happyFail + +action_105 _ = happyReduce_78 + +action_106 (126) = happyAccept +action_106 _ = happyFail + +action_107 (83) = happyShift action_175 +action_107 _ = happyFail + +action_108 _ = happyReduce_79 + +action_109 (78) = happyShift action_174 +action_109 _ = happyFail + +action_110 _ = happyReduce_83 + +action_111 (126) = happyAccept +action_111 _ = happyFail + +action_112 (82) = happyShift action_107 +action_112 (84) = happyShift action_108 +action_112 (85) = happyShift action_173 +action_112 (87) = happyShift action_110 +action_112 (121) = happyShift action_39 +action_112 (39) = happyGoto action_105 +action_112 (53) = happyGoto action_171 +action_112 (54) = happyGoto action_95 +action_112 (58) = happyGoto action_172 +action_112 _ = happyReduce_74 + +action_113 _ = happyReduce_73 + +action_114 (126) = happyAccept +action_114 _ = happyFail + +action_115 (82) = happyShift action_115 +action_115 (121) = happyShift action_39 +action_115 (39) = happyGoto action_113 +action_115 (51) = happyGoto action_170 +action_115 _ = happyFail + +action_116 _ = happyReduce_70 + +action_117 (126) = happyAccept +action_117 _ = happyFail + +action_118 _ = happyReduce_71 + +action_119 (126) = happyAccept +action_119 _ = happyFail + +action_120 (80) = happyShift action_169 +action_120 _ = happyFail + +action_121 (120) = happyShift action_36 +action_121 (38) = happyGoto action_168 +action_121 _ = happyFail + +action_122 (121) = happyShift action_39 +action_122 (39) = happyGoto action_167 +action_122 _ = happyFail + +action_123 (120) = happyShift action_36 +action_123 (38) = happyGoto action_166 +action_123 _ = happyFail + +action_124 (121) = happyShift action_39 +action_124 (39) = happyGoto action_165 +action_124 _ = happyFail + +action_125 (121) = happyShift action_39 +action_125 (39) = happyGoto action_37 +action_125 (77) = happyGoto action_164 +action_125 _ = happyFail + +action_126 (121) = happyShift action_39 +action_126 (39) = happyGoto action_163 +action_126 _ = happyFail + +action_127 (82) = happyShift action_107 +action_127 (84) = happyShift action_108 +action_127 (85) = happyShift action_109 +action_127 (87) = happyShift action_110 +action_127 (121) = happyShift action_39 +action_127 (39) = happyGoto action_105 +action_127 (52) = happyGoto action_162 +action_127 (53) = happyGoto action_112 +action_127 _ = happyFail + +action_128 (114) = happyShift action_160 +action_128 (117) = happyShift action_161 +action_128 (120) = happyShift action_36 +action_128 (38) = happyGoto action_64 +action_128 (69) = happyGoto action_159 +action_128 _ = happyFail + +action_129 (116) = happyShift action_158 +action_129 _ = happyFail + +action_130 (121) = happyShift action_39 +action_130 (39) = happyGoto action_157 +action_130 _ = happyFail + +action_131 (110) = happyShift action_59 +action_131 (72) = happyGoto action_156 +action_131 _ = happyReduce_125 + +action_132 (110) = happyShift action_59 +action_132 (72) = happyGoto action_155 +action_132 _ = happyReduce_125 + +action_133 (121) = happyShift action_39 +action_133 (39) = happyGoto action_154 +action_133 _ = happyFail + +action_134 (82) = happyShift action_115 +action_134 (120) = happyShift action_36 +action_134 (121) = happyShift action_39 +action_134 (126) = happyAccept +action_134 (38) = happyGoto action_116 +action_134 (39) = happyGoto action_113 +action_134 (50) = happyGoto action_153 +action_134 (51) = happyGoto action_118 +action_134 _ = happyFail + +action_135 (126) = happyAccept +action_135 _ = happyFail + +action_136 (79) = happyShift action_152 +action_136 _ = happyReduce_49 + +action_137 (126) = happyAccept +action_137 _ = happyFail + +action_138 _ = happyReduce_47 + +action_139 (80) = happyReduce_78 +action_139 (82) = happyReduce_78 +action_139 (84) = happyReduce_78 +action_139 (85) = happyReduce_78 +action_139 (87) = happyReduce_78 +action_139 (88) = happyShift action_151 +action_139 (121) = happyReduce_78 +action_139 _ = happyReduce_145 + +action_140 (79) = happyShift action_150 +action_140 _ = happyReduce_45 + +action_141 (126) = happyAccept +action_141 _ = happyFail + +action_142 _ = happyReduce_41 + +action_143 (78) = happyShift action_149 +action_143 _ = happyFail + +action_144 (121) = happyShift action_39 +action_144 (39) = happyGoto action_37 +action_144 (77) = happyGoto action_148 +action_144 _ = happyFail + +action_145 (126) = happyAccept +action_145 _ = happyFail + +action_146 (126) = happyAccept +action_146 _ = happyFail + +action_147 _ = happyReduce_40 + +action_148 _ = happyReduce_43 + +action_149 (82) = happyShift action_107 +action_149 (84) = happyShift action_108 +action_149 (85) = happyShift action_109 +action_149 (87) = happyShift action_110 +action_149 (97) = happyShift action_121 +action_149 (99) = happyShift action_122 +action_149 (100) = happyShift action_123 +action_149 (101) = happyShift action_124 +action_149 (103) = happyShift action_125 +action_149 (105) = happyShift action_126 +action_149 (106) = happyShift action_127 +action_149 (107) = happyShift action_128 +action_149 (111) = happyShift action_129 +action_149 (112) = happyShift action_130 +action_149 (113) = happyShift action_131 +action_149 (115) = happyShift action_132 +action_149 (116) = happyShift action_133 +action_149 (121) = happyShift action_39 +action_149 (39) = happyGoto action_105 +action_149 (49) = happyGoto action_241 +action_149 (52) = happyGoto action_120 +action_149 (53) = happyGoto action_112 +action_149 _ = happyFail + +action_150 (82) = happyShift action_107 +action_150 (84) = happyShift action_108 +action_150 (85) = happyShift action_109 +action_150 (87) = happyShift action_110 +action_150 (97) = happyShift action_121 +action_150 (99) = happyShift action_122 +action_150 (100) = happyShift action_123 +action_150 (101) = happyShift action_124 +action_150 (103) = happyShift action_125 +action_150 (105) = happyShift action_126 +action_150 (106) = happyShift action_127 +action_150 (107) = happyShift action_128 +action_150 (111) = happyShift action_129 +action_150 (112) = happyShift action_130 +action_150 (113) = happyShift action_131 +action_150 (115) = happyShift action_132 +action_150 (116) = happyShift action_133 +action_150 (119) = happyShift action_144 +action_150 (121) = happyShift action_39 +action_150 (39) = happyGoto action_139 +action_150 (44) = happyGoto action_140 +action_150 (45) = happyGoto action_240 +action_150 (49) = happyGoto action_142 +action_150 (52) = happyGoto action_120 +action_150 (53) = happyGoto action_112 +action_150 (77) = happyGoto action_143 +action_150 _ = happyReduce_44 + +action_151 (121) = happyShift action_39 +action_151 (39) = happyGoto action_37 +action_151 (77) = happyGoto action_239 +action_151 _ = happyFail + +action_152 (82) = happyShift action_107 +action_152 (84) = happyShift action_108 +action_152 (85) = happyShift action_109 +action_152 (87) = happyShift action_110 +action_152 (97) = happyShift action_121 +action_152 (99) = happyShift action_122 +action_152 (100) = happyShift action_123 +action_152 (101) = happyShift action_124 +action_152 (103) = happyShift action_125 +action_152 (105) = happyShift action_126 +action_152 (106) = happyShift action_127 +action_152 (107) = happyShift action_128 +action_152 (111) = happyShift action_129 +action_152 (112) = happyShift action_130 +action_152 (113) = happyShift action_131 +action_152 (115) = happyShift action_132 +action_152 (116) = happyShift action_133 +action_152 (121) = happyShift action_39 +action_152 (39) = happyGoto action_105 +action_152 (47) = happyGoto action_238 +action_152 (49) = happyGoto action_136 +action_152 (52) = happyGoto action_120 +action_152 (53) = happyGoto action_112 +action_152 _ = happyReduce_48 + +action_153 _ = happyReduce_52 + +action_154 (82) = happyShift action_45 +action_154 (85) = happyShift action_46 +action_154 (95) = happyShift action_47 +action_154 (98) = happyShift action_48 +action_154 (102) = happyShift action_49 +action_154 (104) = happyShift action_50 +action_154 (108) = happyShift action_51 +action_154 (109) = happyShift action_52 +action_154 (118) = happyShift action_53 +action_154 (123) = happyShift action_54 +action_154 (41) = happyGoto action_40 +action_154 (73) = happyGoto action_41 +action_154 (74) = happyGoto action_42 +action_154 (75) = happyGoto action_43 +action_154 (76) = happyGoto action_237 +action_154 _ = happyFail + +action_155 (82) = happyShift action_115 +action_155 (121) = happyShift action_39 +action_155 (39) = happyGoto action_113 +action_155 (51) = happyGoto action_236 +action_155 _ = happyFail + +action_156 (82) = happyShift action_115 +action_156 (121) = happyShift action_39 +action_156 (39) = happyGoto action_113 +action_156 (51) = happyGoto action_235 +action_156 _ = happyFail + +action_157 (81) = happyShift action_234 +action_157 _ = happyFail + +action_158 (121) = happyShift action_39 +action_158 (39) = happyGoto action_233 +action_158 _ = happyFail + +action_159 _ = happyReduce_67 + +action_160 (120) = happyShift action_36 +action_160 (38) = happyGoto action_64 +action_160 (69) = happyGoto action_232 +action_160 _ = happyFail + +action_161 _ = happyReduce_69 + +action_162 (80) = happyShift action_231 +action_162 _ = happyFail + +action_163 (89) = happyShift action_230 +action_163 _ = happyFail + +action_164 _ = happyReduce_59 + +action_165 (63) = happyGoto action_229 +action_165 _ = happyReduce_101 + +action_166 (120) = happyShift action_36 +action_166 (38) = happyGoto action_228 +action_166 _ = happyReduce_54 + +action_167 (122) = happyShift action_77 +action_167 (40) = happyGoto action_227 +action_167 _ = happyFail + +action_168 (120) = happyShift action_36 +action_168 (38) = happyGoto action_226 +action_168 _ = happyFail + +action_169 (82) = happyShift action_115 +action_169 (121) = happyShift action_39 +action_169 (39) = happyGoto action_113 +action_169 (51) = happyGoto action_225 +action_169 _ = happyFail + +action_170 (83) = happyShift action_224 +action_170 _ = happyFail + +action_171 (85) = happyShift action_97 +action_171 (54) = happyGoto action_95 +action_171 (58) = happyGoto action_223 +action_171 _ = happyReduce_77 + +action_172 _ = happyReduce_75 + +action_173 (78) = happyShift action_174 +action_173 (82) = happyShift action_179 +action_173 _ = happyFail + +action_174 (82) = happyShift action_221 +action_174 (86) = happyShift action_222 +action_174 _ = happyFail + +action_175 _ = happyReduce_80 + +action_176 (122) = happyShift action_77 +action_176 (40) = happyGoto action_101 +action_176 (56) = happyGoto action_220 +action_176 _ = happyReduce_86 + +action_177 (83) = happyShift action_219 +action_177 _ = happyFail + +action_178 (82) = happyShift action_100 +action_178 (55) = happyGoto action_98 +action_178 (57) = happyGoto action_218 +action_178 _ = happyReduce_89 + +action_179 (82) = happyShift action_100 +action_179 (55) = happyGoto action_98 +action_179 (57) = happyGoto action_217 +action_179 _ = happyReduce_89 + +action_180 _ = happyReduce_93 + +action_181 _ = happyReduce_94 + +action_182 (86) = happyShift action_216 +action_182 _ = happyFail + +action_183 (82) = happyShift action_92 +action_183 (83) = happyShift action_215 +action_183 (85) = happyShift action_93 +action_183 (121) = happyShift action_39 +action_183 (39) = happyGoto action_90 +action_183 (60) = happyGoto action_181 +action_183 _ = happyFail + +action_184 (59) = happyGoto action_88 +action_184 (61) = happyGoto action_214 +action_184 _ = happyFail + +action_185 _ = happyReduce_102 + +action_186 _ = happyReduce_115 + +action_187 (86) = happyShift action_213 +action_187 _ = happyFail + +action_188 (83) = happyShift action_212 +action_188 _ = happyFail + +action_189 (82) = happyShift action_75 +action_189 (85) = happyShift action_76 +action_189 (120) = happyShift action_36 +action_189 (121) = happyShift action_39 +action_189 (122) = happyShift action_77 +action_189 (123) = happyShift action_54 +action_189 (124) = happyShift action_78 +action_189 (38) = happyGoto action_66 +action_189 (39) = happyGoto action_67 +action_189 (40) = happyGoto action_68 +action_189 (41) = happyGoto action_69 +action_189 (42) = happyGoto action_70 +action_189 (64) = happyGoto action_211 +action_189 (65) = happyGoto action_72 +action_189 (66) = happyGoto action_73 +action_189 _ = happyFail + +action_190 (82) = happyShift action_75 +action_190 (85) = happyShift action_76 +action_190 (120) = happyShift action_36 +action_190 (121) = happyShift action_39 +action_190 (122) = happyShift action_77 +action_190 (123) = happyShift action_54 +action_190 (124) = happyShift action_78 +action_190 (38) = happyGoto action_66 +action_190 (39) = happyGoto action_67 +action_190 (40) = happyGoto action_68 +action_190 (41) = happyGoto action_69 +action_190 (42) = happyGoto action_70 +action_190 (64) = happyGoto action_71 +action_190 (65) = happyGoto action_72 +action_190 (66) = happyGoto action_73 +action_190 (68) = happyGoto action_210 +action_190 _ = happyReduce_116 + +action_191 _ = happyReduce_105 + +action_192 (120) = happyShift action_36 +action_192 (38) = happyGoto action_64 +action_192 (69) = happyGoto action_209 +action_192 _ = happyFail + +action_193 (48) = happyGoto action_60 +action_193 (70) = happyGoto action_208 +action_193 (71) = happyGoto action_63 +action_193 _ = happyReduce_51 + +action_194 (92) = happyShift action_196 +action_194 (93) = happyShift action_197 +action_194 (94) = happyShift action_198 +action_194 _ = happyReduce_126 + +action_195 (82) = happyShift action_45 +action_195 (85) = happyShift action_46 +action_195 (95) = happyShift action_47 +action_195 (98) = happyShift action_48 +action_195 (102) = happyShift action_49 +action_195 (104) = happyShift action_50 +action_195 (108) = happyShift action_51 +action_195 (109) = happyShift action_52 +action_195 (118) = happyShift action_53 +action_195 (123) = happyShift action_54 +action_195 (41) = happyGoto action_40 +action_195 (73) = happyGoto action_207 +action_195 (75) = happyGoto action_43 +action_195 _ = happyFail + +action_196 _ = happyReduce_131 + +action_197 _ = happyReduce_132 + +action_198 _ = happyReduce_133 + +action_199 (96) = happyShift action_206 +action_199 _ = happyFail + +action_200 (86) = happyShift action_205 +action_200 _ = happyFail + +action_201 (83) = happyShift action_204 +action_201 _ = happyFail + +action_202 (82) = happyShift action_45 +action_202 (85) = happyShift action_46 +action_202 (95) = happyShift action_47 +action_202 (98) = happyShift action_48 +action_202 (102) = happyShift action_49 +action_202 (104) = happyShift action_50 +action_202 (108) = happyShift action_51 +action_202 (109) = happyShift action_52 +action_202 (118) = happyShift action_53 +action_202 (123) = happyShift action_54 +action_202 (41) = happyGoto action_40 +action_202 (73) = happyGoto action_203 +action_202 (75) = happyGoto action_43 +action_202 _ = happyFail + +action_203 (82) = happyShift action_45 +action_203 (85) = happyShift action_46 +action_203 (95) = happyShift action_47 +action_203 (98) = happyShift action_48 +action_203 (102) = happyShift action_49 +action_203 (104) = happyShift action_50 +action_203 (108) = happyShift action_51 +action_203 (109) = happyShift action_52 +action_203 (118) = happyShift action_53 +action_203 (123) = happyShift action_54 +action_203 (41) = happyGoto action_40 +action_203 (75) = happyGoto action_194 +action_203 _ = happyReduce_129 + +action_204 _ = happyReduce_136 + +action_205 _ = happyReduce_143 + +action_206 _ = happyReduce_137 + +action_207 (82) = happyShift action_45 +action_207 (85) = happyShift action_46 +action_207 (95) = happyShift action_47 +action_207 (98) = happyShift action_48 +action_207 (102) = happyShift action_49 +action_207 (104) = happyShift action_50 +action_207 (108) = happyShift action_51 +action_207 (109) = happyShift action_52 +action_207 (118) = happyShift action_53 +action_207 (123) = happyShift action_54 +action_207 (41) = happyGoto action_40 +action_207 (75) = happyGoto action_194 +action_207 _ = happyReduce_128 + +action_208 _ = happyReduce_122 + +action_209 _ = happyReduce_120 + +action_210 _ = happyReduce_118 + +action_211 _ = happyReduce_103 + +action_212 _ = happyReduce_112 + +action_213 _ = happyReduce_113 + +action_214 _ = happyReduce_99 + +action_215 _ = happyReduce_97 + +action_216 _ = happyReduce_96 + +action_217 (83) = happyShift action_252 +action_217 _ = happyFail + +action_218 _ = happyReduce_91 + +action_219 _ = happyReduce_85 + +action_220 _ = happyReduce_88 + +action_221 (83) = happyShift action_251 +action_221 _ = happyFail + +action_222 _ = happyReduce_81 + +action_223 _ = happyReduce_76 + +action_224 _ = happyReduce_72 + +action_225 (81) = happyShift action_250 +action_225 _ = happyFail + +action_226 (120) = happyShift action_36 +action_226 (38) = happyGoto action_249 +action_226 _ = happyFail + +action_227 _ = happyReduce_62 + +action_228 _ = happyReduce_55 + +action_229 (89) = happyShift action_248 +action_229 (121) = happyShift action_39 +action_229 (39) = happyGoto action_86 +action_229 (62) = happyGoto action_185 +action_229 _ = happyFail + +action_230 (59) = happyGoto action_247 +action_230 _ = happyFail + +action_231 (82) = happyShift action_115 +action_231 (121) = happyShift action_39 +action_231 (39) = happyGoto action_113 +action_231 (51) = happyGoto action_246 +action_231 _ = happyFail + +action_232 _ = happyReduce_68 + +action_233 (82) = happyShift action_45 +action_233 (85) = happyShift action_46 +action_233 (95) = happyShift action_47 +action_233 (98) = happyShift action_48 +action_233 (102) = happyShift action_49 +action_233 (104) = happyShift action_50 +action_233 (108) = happyShift action_51 +action_233 (109) = happyShift action_52 +action_233 (118) = happyShift action_53 +action_233 (123) = happyShift action_54 +action_233 (41) = happyGoto action_40 +action_233 (73) = happyGoto action_41 +action_233 (74) = happyGoto action_42 +action_233 (75) = happyGoto action_43 +action_233 (76) = happyGoto action_245 +action_233 _ = happyFail + +action_234 (48) = happyGoto action_60 +action_234 (70) = happyGoto action_244 +action_234 (71) = happyGoto action_63 +action_234 _ = happyReduce_51 + +action_235 (120) = happyShift action_36 +action_235 (38) = happyGoto action_243 +action_235 _ = happyFail + +action_236 (120) = happyShift action_36 +action_236 (38) = happyGoto action_242 +action_236 _ = happyFail + +action_237 _ = happyReduce_57 + +action_238 _ = happyReduce_50 + +action_239 _ = happyReduce_146 + +action_240 _ = happyReduce_46 + +action_241 _ = happyReduce_42 + +action_242 _ = happyReduce_61 + +action_243 _ = happyReduce_60 + +action_244 _ = happyReduce_63 + +action_245 _ = happyReduce_58 + +action_246 (81) = happyShift action_257 +action_246 _ = happyFail + +action_247 (82) = happyShift action_92 +action_247 (85) = happyShift action_93 +action_247 (121) = happyShift action_39 +action_247 (39) = happyGoto action_90 +action_247 (60) = happyGoto action_181 +action_247 _ = happyReduce_65 + +action_248 (82) = happyShift action_75 +action_248 (85) = happyShift action_76 +action_248 (120) = happyShift action_36 +action_248 (121) = happyShift action_39 +action_248 (122) = happyShift action_77 +action_248 (123) = happyShift action_54 +action_248 (124) = happyShift action_78 +action_248 (38) = happyGoto action_66 +action_248 (39) = happyGoto action_67 +action_248 (40) = happyGoto action_68 +action_248 (41) = happyGoto action_69 +action_248 (42) = happyGoto action_70 +action_248 (64) = happyGoto action_256 +action_248 (65) = happyGoto action_72 +action_248 (66) = happyGoto action_73 +action_248 _ = happyFail + +action_249 _ = happyReduce_66 + +action_250 (48) = happyGoto action_255 +action_250 _ = happyReduce_51 + +action_251 (86) = happyShift action_254 +action_251 _ = happyFail + +action_252 (88) = happyShift action_253 +action_252 _ = happyFail + +action_253 (82) = happyShift action_259 +action_253 _ = happyFail + +action_254 _ = happyReduce_82 + +action_255 (82) = happyShift action_115 +action_255 (120) = happyShift action_36 +action_255 (121) = happyShift action_39 +action_255 (38) = happyGoto action_116 +action_255 (39) = happyGoto action_113 +action_255 (50) = happyGoto action_153 +action_255 (51) = happyGoto action_118 +action_255 _ = happyReduce_53 + +action_256 _ = happyReduce_64 + +action_257 (48) = happyGoto action_258 +action_257 _ = happyReduce_51 + +action_258 (82) = happyShift action_115 +action_258 (120) = happyShift action_36 +action_258 (121) = happyShift action_39 +action_258 (38) = happyGoto action_116 +action_258 (39) = happyGoto action_113 +action_258 (50) = happyGoto action_153 +action_258 (51) = happyGoto action_118 +action_258 _ = happyReduce_56 + +action_259 (122) = happyShift action_77 +action_259 (40) = happyGoto action_101 +action_259 (56) = happyGoto action_260 +action_259 _ = happyReduce_86 + +action_260 (83) = happyShift action_261 +action_260 _ = happyFail + +action_261 (86) = happyShift action_262 +action_261 _ = happyFail + +action_262 _ = happyReduce_84 + +happyReduce_35 = happySpecReduce_1 38 happyReduction_35 +happyReduction_35 (HappyTerminal (PT _ (TL happy_var_1))) + = HappyAbsSyn38 + (happy_var_1 + ) +happyReduction_35 _ = notHappyAtAll + +happyReduce_36 = happySpecReduce_1 39 happyReduction_36 +happyReduction_36 (HappyTerminal (PT _ (TV happy_var_1))) + = HappyAbsSyn39 + (Ident happy_var_1 + ) +happyReduction_36 _ = notHappyAtAll + +happyReduce_37 = happySpecReduce_1 40 happyReduction_37 +happyReduction_37 (HappyTerminal (PT _ (TI happy_var_1))) + = HappyAbsSyn40 + ((read happy_var_1) :: Integer + ) +happyReduction_37 _ = notHappyAtAll + +happyReduce_38 = happySpecReduce_1 41 happyReduction_38 +happyReduction_38 (HappyTerminal (PT _ (TC happy_var_1))) + = HappyAbsSyn41 + ((read happy_var_1) :: Char + ) +happyReduction_38 _ = notHappyAtAll + +happyReduce_39 = happySpecReduce_1 42 happyReduction_39 +happyReduction_39 (HappyTerminal (PT _ (TD happy_var_1))) + = HappyAbsSyn42 + ((read happy_var_1) :: Double + ) +happyReduction_39 _ = notHappyAtAll + +happyReduce_40 = happySpecReduce_1 43 happyReduction_40 +happyReduction_40 (HappyAbsSyn45 happy_var_1) + = HappyAbsSyn43 + (LGr happy_var_1 + ) +happyReduction_40 _ = notHappyAtAll + +happyReduce_41 = happySpecReduce_1 44 happyReduction_41 +happyReduction_41 (HappyAbsSyn49 happy_var_1) + = HappyAbsSyn44 + (DefAll happy_var_1 + ) +happyReduction_41 _ = notHappyAtAll + +happyReduce_42 = happySpecReduce_3 44 happyReduction_42 +happyReduction_42 (HappyAbsSyn49 happy_var_3) + _ + (HappyAbsSyn77 happy_var_1) + = HappyAbsSyn44 + (DefSome happy_var_1 happy_var_3 + ) +happyReduction_42 _ _ _ = notHappyAtAll + +happyReduce_43 = happySpecReduce_2 44 happyReduction_43 +happyReduction_43 (HappyAbsSyn77 happy_var_2) + _ + = HappyAbsSyn44 + (LDefView happy_var_2 + ) +happyReduction_43 _ _ = notHappyAtAll + +happyReduce_44 = happySpecReduce_0 45 happyReduction_44 +happyReduction_44 = HappyAbsSyn45 + ([] + ) + +happyReduce_45 = happySpecReduce_1 45 happyReduction_45 +happyReduction_45 (HappyAbsSyn44 happy_var_1) + = HappyAbsSyn45 + ((:[]) happy_var_1 + ) +happyReduction_45 _ = notHappyAtAll + +happyReduce_46 = happySpecReduce_3 45 happyReduction_46 +happyReduction_46 (HappyAbsSyn45 happy_var_3) + _ + (HappyAbsSyn44 happy_var_1) + = HappyAbsSyn45 + ((:) happy_var_1 happy_var_3 + ) +happyReduction_46 _ _ _ = notHappyAtAll + +happyReduce_47 = happySpecReduce_1 46 happyReduction_47 +happyReduction_47 (HappyAbsSyn47 happy_var_1) + = HappyAbsSyn46 + (Grammar happy_var_1 + ) +happyReduction_47 _ = notHappyAtAll + +happyReduce_48 = happySpecReduce_0 47 happyReduction_48 +happyReduction_48 = HappyAbsSyn47 + ([] + ) + +happyReduce_49 = happySpecReduce_1 47 happyReduction_49 +happyReduction_49 (HappyAbsSyn49 happy_var_1) + = HappyAbsSyn47 + ((:[]) happy_var_1 + ) +happyReduction_49 _ = notHappyAtAll + +happyReduce_50 = happySpecReduce_3 47 happyReduction_50 +happyReduction_50 (HappyAbsSyn47 happy_var_3) + _ + (HappyAbsSyn49 happy_var_1) + = HappyAbsSyn47 + ((:) happy_var_1 happy_var_3 + ) +happyReduction_50 _ _ _ = notHappyAtAll + +happyReduce_51 = happySpecReduce_0 48 happyReduction_51 +happyReduction_51 = HappyAbsSyn48 + ([] + ) + +happyReduce_52 = happySpecReduce_2 48 happyReduction_52 +happyReduction_52 (HappyAbsSyn50 happy_var_2) + (HappyAbsSyn48 happy_var_1) + = HappyAbsSyn48 + (flip (:) happy_var_1 happy_var_2 + ) +happyReduction_52 _ _ = notHappyAtAll + +happyReduce_53 = happyReduce 5 49 happyReduction_53 +happyReduction_53 ((HappyAbsSyn48 happy_var_5) `HappyStk` + _ `HappyStk` + (HappyAbsSyn51 happy_var_3) `HappyStk` + _ `HappyStk` + (HappyAbsSyn52 happy_var_1) `HappyStk` + happyRest) + = HappyAbsSyn49 + (Rule happy_var_1 happy_var_3 (reverse happy_var_5) + ) `HappyStk` happyRest + +happyReduce_54 = happySpecReduce_2 49 happyReduction_54 +happyReduction_54 (HappyAbsSyn38 happy_var_2) + _ + = HappyAbsSyn49 + (Comment happy_var_2 + ) +happyReduction_54 _ _ = notHappyAtAll + +happyReduce_55 = happySpecReduce_3 49 happyReduction_55 +happyReduction_55 (HappyAbsSyn38 happy_var_3) + (HappyAbsSyn38 happy_var_2) + _ + = HappyAbsSyn49 + (Comments happy_var_2 happy_var_3 + ) +happyReduction_55 _ _ _ = notHappyAtAll + +happyReduce_56 = happyReduce 6 49 happyReduction_56 +happyReduction_56 ((HappyAbsSyn48 happy_var_6) `HappyStk` + _ `HappyStk` + (HappyAbsSyn51 happy_var_4) `HappyStk` + _ `HappyStk` + (HappyAbsSyn52 happy_var_2) `HappyStk` + _ `HappyStk` + happyRest) + = HappyAbsSyn49 + (Internal happy_var_2 happy_var_4 (reverse happy_var_6) + ) `HappyStk` happyRest + +happyReduce_57 = happySpecReduce_3 49 happyReduction_57 +happyReduction_57 (HappyAbsSyn73 happy_var_3) + (HappyAbsSyn39 happy_var_2) + _ + = HappyAbsSyn49 + (Token happy_var_2 happy_var_3 + ) +happyReduction_57 _ _ _ = notHappyAtAll + +happyReduce_58 = happyReduce 4 49 happyReduction_58 +happyReduction_58 ((HappyAbsSyn73 happy_var_4) `HappyStk` + (HappyAbsSyn39 happy_var_3) `HappyStk` + _ `HappyStk` + _ `HappyStk` + happyRest) + = HappyAbsSyn49 + (PosToken happy_var_3 happy_var_4 + ) `HappyStk` happyRest + +happyReduce_59 = happySpecReduce_2 49 happyReduction_59 +happyReduction_59 (HappyAbsSyn77 happy_var_2) + _ + = HappyAbsSyn49 + (Entryp happy_var_2 + ) +happyReduction_59 _ _ = notHappyAtAll + +happyReduce_60 = happyReduce 4 49 happyReduction_60 +happyReduction_60 ((HappyAbsSyn38 happy_var_4) `HappyStk` + (HappyAbsSyn51 happy_var_3) `HappyStk` + (HappyAbsSyn72 happy_var_2) `HappyStk` + _ `HappyStk` + happyRest) + = HappyAbsSyn49 + (Separator happy_var_2 happy_var_3 happy_var_4 + ) `HappyStk` happyRest + +happyReduce_61 = happyReduce 4 49 happyReduction_61 +happyReduction_61 ((HappyAbsSyn38 happy_var_4) `HappyStk` + (HappyAbsSyn51 happy_var_3) `HappyStk` + (HappyAbsSyn72 happy_var_2) `HappyStk` + _ `HappyStk` + happyRest) + = HappyAbsSyn49 + (Terminator happy_var_2 happy_var_3 happy_var_4 + ) `HappyStk` happyRest + +happyReduce_62 = happySpecReduce_3 49 happyReduction_62 +happyReduction_62 (HappyAbsSyn40 happy_var_3) + (HappyAbsSyn39 happy_var_2) + _ + = HappyAbsSyn49 + (Coercions happy_var_2 happy_var_3 + ) +happyReduction_62 _ _ _ = notHappyAtAll + +happyReduce_63 = happyReduce 4 49 happyReduction_63 +happyReduction_63 ((HappyAbsSyn70 happy_var_4) `HappyStk` + _ `HappyStk` + (HappyAbsSyn39 happy_var_2) `HappyStk` + _ `HappyStk` + happyRest) + = HappyAbsSyn49 + (Rules happy_var_2 happy_var_4 + ) `HappyStk` happyRest + +happyReduce_64 = happyReduce 5 49 happyReduction_64 +happyReduction_64 ((HappyAbsSyn64 happy_var_5) `HappyStk` + _ `HappyStk` + (HappyAbsSyn63 happy_var_3) `HappyStk` + (HappyAbsSyn39 happy_var_2) `HappyStk` + _ `HappyStk` + happyRest) + = HappyAbsSyn49 + (Function happy_var_2 (reverse happy_var_3) happy_var_5 + ) `HappyStk` happyRest + +happyReduce_65 = happyReduce 4 49 happyReduction_65 +happyReduction_65 ((HappyAbsSyn59 happy_var_4) `HappyStk` + _ `HappyStk` + (HappyAbsSyn39 happy_var_2) `HappyStk` + _ `HappyStk` + happyRest) + = HappyAbsSyn49 + (External happy_var_2 happy_var_4 + ) `HappyStk` happyRest + +happyReduce_66 = happyReduce 4 49 happyReduction_66 +happyReduction_66 ((HappyAbsSyn38 happy_var_4) `HappyStk` + (HappyAbsSyn38 happy_var_3) `HappyStk` + (HappyAbsSyn38 happy_var_2) `HappyStk` + _ `HappyStk` + happyRest) + = HappyAbsSyn49 + (AntiQuote happy_var_2 happy_var_3 happy_var_4 + ) `HappyStk` happyRest + +happyReduce_67 = happySpecReduce_2 49 happyReduction_67 +happyReduction_67 (HappyAbsSyn69 happy_var_2) + _ + = HappyAbsSyn49 + (Layout happy_var_2 + ) +happyReduction_67 _ _ = notHappyAtAll + +happyReduce_68 = happySpecReduce_3 49 happyReduction_68 +happyReduction_68 (HappyAbsSyn69 happy_var_3) + _ + _ + = HappyAbsSyn49 + (LayoutStop happy_var_3 + ) +happyReduction_68 _ _ _ = notHappyAtAll + +happyReduce_69 = happySpecReduce_2 49 happyReduction_69 +happyReduction_69 _ + _ + = HappyAbsSyn49 + (LayoutTop + ) + +happyReduce_70 = happySpecReduce_1 50 happyReduction_70 +happyReduction_70 (HappyAbsSyn38 happy_var_1) + = HappyAbsSyn50 + (Terminal happy_var_1 + ) +happyReduction_70 _ = notHappyAtAll + +happyReduce_71 = happySpecReduce_1 50 happyReduction_71 +happyReduction_71 (HappyAbsSyn51 happy_var_1) + = HappyAbsSyn50 + (NTerminal happy_var_1 + ) +happyReduction_71 _ = notHappyAtAll + +happyReduce_72 = happySpecReduce_3 51 happyReduction_72 +happyReduction_72 _ + (HappyAbsSyn51 happy_var_2) + _ + = HappyAbsSyn51 + (ListCat happy_var_2 + ) +happyReduction_72 _ _ _ = notHappyAtAll + +happyReduce_73 = happySpecReduce_1 51 happyReduction_73 +happyReduction_73 (HappyAbsSyn39 happy_var_1) + = HappyAbsSyn51 + (IdCat happy_var_1 + ) +happyReduction_73 _ = notHappyAtAll + +happyReduce_74 = happySpecReduce_1 52 happyReduction_74 +happyReduction_74 (HappyAbsSyn53 happy_var_1) + = HappyAbsSyn52 + (LabNoP happy_var_1 + ) +happyReduction_74 _ = notHappyAtAll + +happyReduce_75 = happySpecReduce_2 52 happyReduction_75 +happyReduction_75 (HappyAbsSyn58 happy_var_2) + (HappyAbsSyn53 happy_var_1) + = HappyAbsSyn52 + (LabP happy_var_1 happy_var_2 + ) +happyReduction_75 _ _ = notHappyAtAll + +happyReduce_76 = happySpecReduce_3 52 happyReduction_76 +happyReduction_76 (HappyAbsSyn58 happy_var_3) + (HappyAbsSyn53 happy_var_2) + (HappyAbsSyn53 happy_var_1) + = HappyAbsSyn52 + (LabPF happy_var_1 happy_var_2 happy_var_3 + ) +happyReduction_76 _ _ _ = notHappyAtAll + +happyReduce_77 = happySpecReduce_2 52 happyReduction_77 +happyReduction_77 (HappyAbsSyn53 happy_var_2) + (HappyAbsSyn53 happy_var_1) + = HappyAbsSyn52 + (LabF happy_var_1 happy_var_2 + ) +happyReduction_77 _ _ = notHappyAtAll + +happyReduce_78 = happySpecReduce_1 53 happyReduction_78 +happyReduction_78 (HappyAbsSyn39 happy_var_1) + = HappyAbsSyn53 + (Id happy_var_1 + ) +happyReduction_78 _ = notHappyAtAll + +happyReduce_79 = happySpecReduce_1 53 happyReduction_79 +happyReduction_79 _ + = HappyAbsSyn53 + (Wild + ) + +happyReduce_80 = happySpecReduce_2 53 happyReduction_80 +happyReduction_80 _ + _ + = HappyAbsSyn53 + (ListE + ) + +happyReduce_81 = happySpecReduce_3 53 happyReduction_81 +happyReduction_81 _ + _ + _ + = HappyAbsSyn53 + (ListCons + ) + +happyReduce_82 = happyReduce 5 53 happyReduction_82 +happyReduction_82 (_ `HappyStk` + _ `HappyStk` + _ `HappyStk` + _ `HappyStk` + _ `HappyStk` + happyRest) + = HappyAbsSyn53 + (ListOne + ) `HappyStk` happyRest + +happyReduce_83 = happySpecReduce_1 53 happyReduction_83 +happyReduction_83 _ + = HappyAbsSyn53 + (Aq + ) + +happyReduce_84 = happyReduce 9 54 happyReduction_84 +happyReduction_84 (_ `HappyStk` + _ `HappyStk` + (HappyAbsSyn56 happy_var_7) `HappyStk` + _ `HappyStk` + _ `HappyStk` + _ `HappyStk` + (HappyAbsSyn57 happy_var_3) `HappyStk` + _ `HappyStk` + _ `HappyStk` + happyRest) + = HappyAbsSyn54 + (ProfIt happy_var_3 happy_var_7 + ) `HappyStk` happyRest + +happyReduce_85 = happySpecReduce_3 55 happyReduction_85 +happyReduction_85 _ + (HappyAbsSyn56 happy_var_2) + _ + = HappyAbsSyn55 + (Ints happy_var_2 + ) +happyReduction_85 _ _ _ = notHappyAtAll + +happyReduce_86 = happySpecReduce_0 56 happyReduction_86 +happyReduction_86 = HappyAbsSyn56 + ([] + ) + +happyReduce_87 = happySpecReduce_1 56 happyReduction_87 +happyReduction_87 (HappyAbsSyn40 happy_var_1) + = HappyAbsSyn56 + ((:[]) happy_var_1 + ) +happyReduction_87 _ = notHappyAtAll + +happyReduce_88 = happySpecReduce_3 56 happyReduction_88 +happyReduction_88 (HappyAbsSyn56 happy_var_3) + _ + (HappyAbsSyn40 happy_var_1) + = HappyAbsSyn56 + ((:) happy_var_1 happy_var_3 + ) +happyReduction_88 _ _ _ = notHappyAtAll + +happyReduce_89 = happySpecReduce_0 57 happyReduction_89 +happyReduction_89 = HappyAbsSyn57 + ([] + ) + +happyReduce_90 = happySpecReduce_1 57 happyReduction_90 +happyReduction_90 (HappyAbsSyn55 happy_var_1) + = HappyAbsSyn57 + ((:[]) happy_var_1 + ) +happyReduction_90 _ = notHappyAtAll + +happyReduce_91 = happySpecReduce_3 57 happyReduction_91 +happyReduction_91 (HappyAbsSyn57 happy_var_3) + _ + (HappyAbsSyn55 happy_var_1) + = HappyAbsSyn57 + ((:) happy_var_1 happy_var_3 + ) +happyReduction_91 _ _ _ = notHappyAtAll + +happyReduce_92 = happySpecReduce_1 58 happyReduction_92 +happyReduction_92 (HappyAbsSyn54 happy_var_1) + = HappyAbsSyn58 + ((:[]) happy_var_1 + ) +happyReduction_92 _ = notHappyAtAll + +happyReduce_93 = happySpecReduce_2 58 happyReduction_93 +happyReduction_93 (HappyAbsSyn58 happy_var_2) + (HappyAbsSyn54 happy_var_1) + = HappyAbsSyn58 + ((:) happy_var_1 happy_var_2 + ) +happyReduction_93 _ _ = notHappyAtAll + +happyReduce_94 = happySpecReduce_2 59 happyReduction_94 +happyReduction_94 (HappyAbsSyn59 happy_var_2) + (HappyAbsSyn59 happy_var_1) + = HappyAbsSyn59 + (HsApp happy_var_1 happy_var_2 + ) +happyReduction_94 _ _ = notHappyAtAll + +happyReduce_95 = happySpecReduce_1 60 happyReduction_95 +happyReduction_95 (HappyAbsSyn39 happy_var_1) + = HappyAbsSyn59 + (HsCon happy_var_1 + ) +happyReduction_95 _ = notHappyAtAll + +happyReduce_96 = happySpecReduce_3 60 happyReduction_96 +happyReduction_96 _ + (HappyAbsSyn61 happy_var_2) + _ + = HappyAbsSyn59 + (HsTup happy_var_2 + ) +happyReduction_96 _ _ _ = notHappyAtAll + +happyReduce_97 = happySpecReduce_3 60 happyReduction_97 +happyReduction_97 _ + (HappyAbsSyn59 happy_var_2) + _ + = HappyAbsSyn59 + (HsList happy_var_2 + ) +happyReduction_97 _ _ _ = notHappyAtAll + +happyReduce_98 = happySpecReduce_1 61 happyReduction_98 +happyReduction_98 (HappyAbsSyn59 happy_var_1) + = HappyAbsSyn61 + ((:[]) happy_var_1 + ) +happyReduction_98 _ = notHappyAtAll + +happyReduce_99 = happySpecReduce_3 61 happyReduction_99 +happyReduction_99 (HappyAbsSyn61 happy_var_3) + _ + (HappyAbsSyn59 happy_var_1) + = HappyAbsSyn61 + ((:) happy_var_1 happy_var_3 + ) +happyReduction_99 _ _ _ = notHappyAtAll + +happyReduce_100 = happySpecReduce_1 62 happyReduction_100 +happyReduction_100 (HappyAbsSyn39 happy_var_1) + = HappyAbsSyn62 + (Arg happy_var_1 + ) +happyReduction_100 _ = notHappyAtAll + +happyReduce_101 = happySpecReduce_0 63 happyReduction_101 +happyReduction_101 = HappyAbsSyn63 + ([] + ) + +happyReduce_102 = happySpecReduce_2 63 happyReduction_102 +happyReduction_102 (HappyAbsSyn62 happy_var_2) + (HappyAbsSyn63 happy_var_1) + = HappyAbsSyn63 + (flip (:) happy_var_1 happy_var_2 + ) +happyReduction_102 _ _ = notHappyAtAll + +happyReduce_103 = happySpecReduce_3 64 happyReduction_103 +happyReduction_103 (HappyAbsSyn64 happy_var_3) + _ + (HappyAbsSyn64 happy_var_1) + = HappyAbsSyn64 + (Cons happy_var_1 happy_var_3 + ) +happyReduction_103 _ _ _ = notHappyAtAll + +happyReduce_104 = happySpecReduce_1 64 happyReduction_104 +happyReduction_104 (HappyAbsSyn64 happy_var_1) + = HappyAbsSyn64 + (happy_var_1 + ) +happyReduction_104 _ = notHappyAtAll + +happyReduce_105 = happySpecReduce_2 65 happyReduction_105 +happyReduction_105 (HappyAbsSyn67 happy_var_2) + (HappyAbsSyn39 happy_var_1) + = HappyAbsSyn64 + (App happy_var_1 happy_var_2 + ) +happyReduction_105 _ _ = notHappyAtAll + +happyReduce_106 = happySpecReduce_1 65 happyReduction_106 +happyReduction_106 (HappyAbsSyn64 happy_var_1) + = HappyAbsSyn64 + (happy_var_1 + ) +happyReduction_106 _ = notHappyAtAll + +happyReduce_107 = happySpecReduce_1 66 happyReduction_107 +happyReduction_107 (HappyAbsSyn39 happy_var_1) + = HappyAbsSyn64 + (Var happy_var_1 + ) +happyReduction_107 _ = notHappyAtAll + +happyReduce_108 = happySpecReduce_1 66 happyReduction_108 +happyReduction_108 (HappyAbsSyn40 happy_var_1) + = HappyAbsSyn64 + (LitInt happy_var_1 + ) +happyReduction_108 _ = notHappyAtAll + +happyReduce_109 = happySpecReduce_1 66 happyReduction_109 +happyReduction_109 (HappyAbsSyn41 happy_var_1) + = HappyAbsSyn64 + (LitChar happy_var_1 + ) +happyReduction_109 _ = notHappyAtAll + +happyReduce_110 = happySpecReduce_1 66 happyReduction_110 +happyReduction_110 (HappyAbsSyn38 happy_var_1) + = HappyAbsSyn64 + (LitString happy_var_1 + ) +happyReduction_110 _ = notHappyAtAll + +happyReduce_111 = happySpecReduce_1 66 happyReduction_111 +happyReduction_111 (HappyAbsSyn42 happy_var_1) + = HappyAbsSyn64 + (LitDouble happy_var_1 + ) +happyReduction_111 _ = notHappyAtAll + +happyReduce_112 = happySpecReduce_3 66 happyReduction_112 +happyReduction_112 _ + (HappyAbsSyn67 happy_var_2) + _ + = HappyAbsSyn64 + (List happy_var_2 + ) +happyReduction_112 _ _ _ = notHappyAtAll + +happyReduce_113 = happySpecReduce_3 66 happyReduction_113 +happyReduction_113 _ + (HappyAbsSyn64 happy_var_2) + _ + = HappyAbsSyn64 + (happy_var_2 + ) +happyReduction_113 _ _ _ = notHappyAtAll + +happyReduce_114 = happySpecReduce_1 67 happyReduction_114 +happyReduction_114 (HappyAbsSyn64 happy_var_1) + = HappyAbsSyn67 + ((:[]) happy_var_1 + ) +happyReduction_114 _ = notHappyAtAll + +happyReduce_115 = happySpecReduce_2 67 happyReduction_115 +happyReduction_115 (HappyAbsSyn67 happy_var_2) + (HappyAbsSyn64 happy_var_1) + = HappyAbsSyn67 + ((:) happy_var_1 happy_var_2 + ) +happyReduction_115 _ _ = notHappyAtAll + +happyReduce_116 = happySpecReduce_0 68 happyReduction_116 +happyReduction_116 = HappyAbsSyn67 + ([] + ) + +happyReduce_117 = happySpecReduce_1 68 happyReduction_117 +happyReduction_117 (HappyAbsSyn64 happy_var_1) + = HappyAbsSyn67 + ((:[]) happy_var_1 + ) +happyReduction_117 _ = notHappyAtAll + +happyReduce_118 = happySpecReduce_3 68 happyReduction_118 +happyReduction_118 (HappyAbsSyn67 happy_var_3) + _ + (HappyAbsSyn64 happy_var_1) + = HappyAbsSyn67 + ((:) happy_var_1 happy_var_3 + ) +happyReduction_118 _ _ _ = notHappyAtAll + +happyReduce_119 = happySpecReduce_1 69 happyReduction_119 +happyReduction_119 (HappyAbsSyn38 happy_var_1) + = HappyAbsSyn69 + ((:[]) happy_var_1 + ) +happyReduction_119 _ = notHappyAtAll + +happyReduce_120 = happySpecReduce_3 69 happyReduction_120 +happyReduction_120 (HappyAbsSyn69 happy_var_3) + _ + (HappyAbsSyn38 happy_var_1) + = HappyAbsSyn69 + ((:) happy_var_1 happy_var_3 + ) +happyReduction_120 _ _ _ = notHappyAtAll + +happyReduce_121 = happySpecReduce_1 70 happyReduction_121 +happyReduction_121 (HappyAbsSyn71 happy_var_1) + = HappyAbsSyn70 + ((:[]) happy_var_1 + ) +happyReduction_121 _ = notHappyAtAll + +happyReduce_122 = happySpecReduce_3 70 happyReduction_122 +happyReduction_122 (HappyAbsSyn70 happy_var_3) + _ + (HappyAbsSyn71 happy_var_1) + = HappyAbsSyn70 + ((:) happy_var_1 happy_var_3 + ) +happyReduction_122 _ _ _ = notHappyAtAll + +happyReduce_123 = happySpecReduce_1 71 happyReduction_123 +happyReduction_123 (HappyAbsSyn48 happy_var_1) + = HappyAbsSyn71 + (RHS (reverse happy_var_1) + ) +happyReduction_123 _ = notHappyAtAll + +happyReduce_124 = happySpecReduce_1 72 happyReduction_124 +happyReduction_124 _ + = HappyAbsSyn72 + (MNonempty + ) + +happyReduce_125 = happySpecReduce_0 72 happyReduction_125 +happyReduction_125 = HappyAbsSyn72 + (MEmpty + ) + +happyReduce_126 = happySpecReduce_2 73 happyReduction_126 +happyReduction_126 (HappyAbsSyn73 happy_var_2) + (HappyAbsSyn73 happy_var_1) + = HappyAbsSyn73 + (RSeq happy_var_1 happy_var_2 + ) +happyReduction_126 _ _ = notHappyAtAll + +happyReduce_127 = happySpecReduce_1 73 happyReduction_127 +happyReduction_127 (HappyAbsSyn73 happy_var_1) + = HappyAbsSyn73 + (happy_var_1 + ) +happyReduction_127 _ = notHappyAtAll + +happyReduce_128 = happySpecReduce_3 74 happyReduction_128 +happyReduction_128 (HappyAbsSyn73 happy_var_3) + _ + (HappyAbsSyn73 happy_var_1) + = HappyAbsSyn73 + (RAlt happy_var_1 happy_var_3 + ) +happyReduction_128 _ _ _ = notHappyAtAll + +happyReduce_129 = happySpecReduce_3 74 happyReduction_129 +happyReduction_129 (HappyAbsSyn73 happy_var_3) + _ + (HappyAbsSyn73 happy_var_1) + = HappyAbsSyn73 + (RMinus happy_var_1 happy_var_3 + ) +happyReduction_129 _ _ _ = notHappyAtAll + +happyReduce_130 = happySpecReduce_1 74 happyReduction_130 +happyReduction_130 (HappyAbsSyn73 happy_var_1) + = HappyAbsSyn73 + (happy_var_1 + ) +happyReduction_130 _ = notHappyAtAll + +happyReduce_131 = happySpecReduce_2 75 happyReduction_131 +happyReduction_131 _ + (HappyAbsSyn73 happy_var_1) + = HappyAbsSyn73 + (RStar happy_var_1 + ) +happyReduction_131 _ _ = notHappyAtAll + +happyReduce_132 = happySpecReduce_2 75 happyReduction_132 +happyReduction_132 _ + (HappyAbsSyn73 happy_var_1) + = HappyAbsSyn73 + (RPlus happy_var_1 + ) +happyReduction_132 _ _ = notHappyAtAll + +happyReduce_133 = happySpecReduce_2 75 happyReduction_133 +happyReduction_133 _ + (HappyAbsSyn73 happy_var_1) + = HappyAbsSyn73 + (ROpt happy_var_1 + ) +happyReduction_133 _ _ = notHappyAtAll + +happyReduce_134 = happySpecReduce_1 75 happyReduction_134 +happyReduction_134 _ + = HappyAbsSyn73 + (REps + ) + +happyReduce_135 = happySpecReduce_1 75 happyReduction_135 +happyReduction_135 (HappyAbsSyn41 happy_var_1) + = HappyAbsSyn73 + (RChar happy_var_1 + ) +happyReduction_135 _ = notHappyAtAll + +happyReduce_136 = happySpecReduce_3 75 happyReduction_136 +happyReduction_136 _ + (HappyAbsSyn38 happy_var_2) + _ + = HappyAbsSyn73 + (RAlts happy_var_2 + ) +happyReduction_136 _ _ _ = notHappyAtAll + +happyReduce_137 = happySpecReduce_3 75 happyReduction_137 +happyReduction_137 _ + (HappyAbsSyn38 happy_var_2) + _ + = HappyAbsSyn73 + (RSeqs happy_var_2 + ) +happyReduction_137 _ _ _ = notHappyAtAll + +happyReduce_138 = happySpecReduce_1 75 happyReduction_138 +happyReduction_138 _ + = HappyAbsSyn73 + (RDigit + ) + +happyReduce_139 = happySpecReduce_1 75 happyReduction_139 +happyReduction_139 _ + = HappyAbsSyn73 + (RLetter + ) + +happyReduce_140 = happySpecReduce_1 75 happyReduction_140 +happyReduction_140 _ + = HappyAbsSyn73 + (RUpper + ) + +happyReduce_141 = happySpecReduce_1 75 happyReduction_141 +happyReduction_141 _ + = HappyAbsSyn73 + (RLower + ) + +happyReduce_142 = happySpecReduce_1 75 happyReduction_142 +happyReduction_142 _ + = HappyAbsSyn73 + (RAny + ) + +happyReduce_143 = happySpecReduce_3 75 happyReduction_143 +happyReduction_143 _ + (HappyAbsSyn73 happy_var_2) + _ + = HappyAbsSyn73 + (happy_var_2 + ) +happyReduction_143 _ _ _ = notHappyAtAll + +happyReduce_144 = happySpecReduce_1 76 happyReduction_144 +happyReduction_144 (HappyAbsSyn73 happy_var_1) + = HappyAbsSyn73 + (happy_var_1 + ) +happyReduction_144 _ = notHappyAtAll + +happyReduce_145 = happySpecReduce_1 77 happyReduction_145 +happyReduction_145 (HappyAbsSyn39 happy_var_1) + = HappyAbsSyn77 + ((:[]) happy_var_1 + ) +happyReduction_145 _ = notHappyAtAll + +happyReduce_146 = happySpecReduce_3 77 happyReduction_146 +happyReduction_146 (HappyAbsSyn77 happy_var_3) + _ + (HappyAbsSyn39 happy_var_1) + = HappyAbsSyn77 + ((:) happy_var_1 happy_var_3 + ) +happyReduction_146 _ _ _ = notHappyAtAll + +happyNewToken action sts stk [] = + action 126 126 notHappyAtAll (HappyState 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 ":") -> cont 78; + PT _ (TS ";") -> cont 79; + PT _ (TS ".") -> cont 80; + PT _ (TS "::=") -> cont 81; + PT _ (TS "[") -> cont 82; + PT _ (TS "]") -> cont 83; + PT _ (TS "_") -> cont 84; + PT _ (TS "(") -> cont 85; + PT _ (TS ")") -> cont 86; + PT _ (TS "$") -> cont 87; + PT _ (TS ",") -> cont 88; + PT _ (TS "=") -> cont 89; + PT _ (TS "|") -> cont 90; + PT _ (TS "-") -> cont 91; + PT _ (TS "*") -> cont 92; + PT _ (TS "+") -> cont 93; + PT _ (TS "?") -> cont 94; + PT _ (TS "{") -> cont 95; + PT _ (TS "}") -> cont 96; + PT _ (TS "antiquote") -> cont 97; + PT _ (TS "char") -> cont 98; + PT _ (TS "coercions") -> cont 99; + PT _ (TS "comment") -> cont 100; + PT _ (TS "define") -> cont 101; + PT _ (TS "digit") -> cont 102; + PT _ (TS "entrypoints") -> cont 103; + PT _ (TS "eps") -> cont 104; + PT _ (TS "external") -> cont 105; + PT _ (TS "internal") -> cont 106; + PT _ (TS "layout") -> cont 107; + PT _ (TS "letter") -> cont 108; + PT _ (TS "lower") -> cont 109; + PT _ (TS "nonempty") -> cont 110; + PT _ (TS "position") -> cont 111; + PT _ (TS "rules") -> cont 112; + PT _ (TS "separator") -> cont 113; + PT _ (TS "stop") -> cont 114; + PT _ (TS "terminator") -> cont 115; + PT _ (TS "token") -> cont 116; + PT _ (TS "toplevel") -> cont 117; + PT _ (TS "upper") -> cont 118; + PT _ (TS "views") -> cont 119; + PT _ (TL happy_dollar_dollar) -> cont 120; + PT _ (TV happy_dollar_dollar) -> cont 121; + PT _ (TI happy_dollar_dollar) -> cont 122; + PT _ (TC happy_dollar_dollar) -> cont 123; + PT _ (TD happy_dollar_dollar) -> cont 124; + _ -> cont 125; + _ -> happyError' (tk:tks) + } + +happyError_ tk tks = happyError' (tk:tks) + +happyThen :: () => Err a -> (a -> Err b) -> Err b +happyThen = (thenM) +happyReturn :: () => a -> Err a +happyReturn = (returnM) +happyThen1 m k tks = (thenM) m (\a -> k a tks) +happyReturn1 :: () => a -> b -> Err a +happyReturn1 = \a tks -> (returnM) a +happyError' :: () => [(Token)] -> Err a +happyError' = happyError + +pLGrammar tks = happySomeParser where + happySomeParser = happyThen (happyParse action_0 tks) (\x -> case x of {HappyAbsSyn43 z -> happyReturn z; _other -> notHappyAtAll }) + +pLDef tks = happySomeParser where + happySomeParser = happyThen (happyParse action_1 tks) (\x -> case x of {HappyAbsSyn44 z -> happyReturn z; _other -> notHappyAtAll }) + +pListLDef tks = happySomeParser where + happySomeParser = happyThen (happyParse action_2 tks) (\x -> case x of {HappyAbsSyn45 z -> happyReturn z; _other -> notHappyAtAll }) + +pGrammar tks = happySomeParser where + happySomeParser = happyThen (happyParse action_3 tks) (\x -> case x of {HappyAbsSyn46 z -> happyReturn z; _other -> notHappyAtAll }) + +pListDef tks = happySomeParser where + happySomeParser = happyThen (happyParse action_4 tks) (\x -> case x of {HappyAbsSyn47 z -> happyReturn z; _other -> notHappyAtAll }) + +pListItem tks = happySomeParser where + happySomeParser = happyThen (happyParse action_5 tks) (\x -> case x of {HappyAbsSyn48 z -> happyReturn z; _other -> notHappyAtAll }) + +pDef tks = happySomeParser where + happySomeParser = happyThen (happyParse action_6 tks) (\x -> case x of {HappyAbsSyn49 z -> happyReturn z; _other -> notHappyAtAll }) + +pItem tks = happySomeParser where + happySomeParser = happyThen (happyParse action_7 tks) (\x -> case x of {HappyAbsSyn50 z -> happyReturn z; _other -> notHappyAtAll }) + +pCat tks = happySomeParser where + happySomeParser = happyThen (happyParse action_8 tks) (\x -> case x of {HappyAbsSyn51 z -> happyReturn z; _other -> notHappyAtAll }) + +pLabel tks = happySomeParser where + happySomeParser = happyThen (happyParse action_9 tks) (\x -> case x of {HappyAbsSyn52 z -> happyReturn z; _other -> notHappyAtAll }) + +pLabelId tks = happySomeParser where + happySomeParser = happyThen (happyParse action_10 tks) (\x -> case x of {HappyAbsSyn53 z -> happyReturn z; _other -> notHappyAtAll }) + +pProfItem tks = happySomeParser where + happySomeParser = happyThen (happyParse action_11 tks) (\x -> case x of {HappyAbsSyn54 z -> happyReturn z; _other -> notHappyAtAll }) + +pIntList tks = happySomeParser where + happySomeParser = happyThen (happyParse action_12 tks) (\x -> case x of {HappyAbsSyn55 z -> happyReturn z; _other -> notHappyAtAll }) + +pListInteger tks = happySomeParser where + happySomeParser = happyThen (happyParse action_13 tks) (\x -> case x of {HappyAbsSyn56 z -> happyReturn z; _other -> notHappyAtAll }) + +pListIntList tks = happySomeParser where + happySomeParser = happyThen (happyParse action_14 tks) (\x -> case x of {HappyAbsSyn57 z -> happyReturn z; _other -> notHappyAtAll }) + +pListProfItem tks = happySomeParser where + happySomeParser = happyThen (happyParse action_15 tks) (\x -> case x of {HappyAbsSyn58 z -> happyReturn z; _other -> notHappyAtAll }) + +pHsTyp tks = happySomeParser where + happySomeParser = happyThen (happyParse action_16 tks) (\x -> case x of {HappyAbsSyn59 z -> happyReturn z; _other -> notHappyAtAll }) + +pHsTyp1 tks = happySomeParser where + happySomeParser = happyThen (happyParse action_17 tks) (\x -> case x of {HappyAbsSyn59 z -> happyReturn z; _other -> notHappyAtAll }) + +pListHsTyp tks = happySomeParser where + happySomeParser = happyThen (happyParse action_18 tks) (\x -> case x of {HappyAbsSyn61 z -> happyReturn z; _other -> notHappyAtAll }) + +pArg tks = happySomeParser where + happySomeParser = happyThen (happyParse action_19 tks) (\x -> case x of {HappyAbsSyn62 z -> happyReturn z; _other -> notHappyAtAll }) + +pListArg tks = happySomeParser where + happySomeParser = happyThen (happyParse action_20 tks) (\x -> case x of {HappyAbsSyn63 z -> happyReturn z; _other -> notHappyAtAll }) + +pExp tks = happySomeParser where + happySomeParser = happyThen (happyParse action_21 tks) (\x -> case x of {HappyAbsSyn64 z -> happyReturn z; _other -> notHappyAtAll }) + +pExp1 tks = happySomeParser where + happySomeParser = happyThen (happyParse action_22 tks) (\x -> case x of {HappyAbsSyn64 z -> happyReturn z; _other -> notHappyAtAll }) + +pExp2 tks = happySomeParser where + happySomeParser = happyThen (happyParse action_23 tks) (\x -> case x of {HappyAbsSyn64 z -> happyReturn z; _other -> notHappyAtAll }) + +pListExp2 tks = happySomeParser where + happySomeParser = happyThen (happyParse action_24 tks) (\x -> case x of {HappyAbsSyn67 z -> happyReturn z; _other -> notHappyAtAll }) + +pListExp tks = happySomeParser where + happySomeParser = happyThen (happyParse action_25 tks) (\x -> case x of {HappyAbsSyn67 z -> happyReturn z; _other -> notHappyAtAll }) + +pListString tks = happySomeParser where + happySomeParser = happyThen (happyParse action_26 tks) (\x -> case x of {HappyAbsSyn69 z -> happyReturn z; _other -> notHappyAtAll }) + +pListRHS tks = happySomeParser where + happySomeParser = happyThen (happyParse action_27 tks) (\x -> case x of {HappyAbsSyn70 z -> happyReturn z; _other -> notHappyAtAll }) + +pRHS tks = happySomeParser where + happySomeParser = happyThen (happyParse action_28 tks) (\x -> case x of {HappyAbsSyn71 z -> happyReturn z; _other -> notHappyAtAll }) + +pMinimumSize tks = happySomeParser where + happySomeParser = happyThen (happyParse action_29 tks) (\x -> case x of {HappyAbsSyn72 z -> happyReturn z; _other -> notHappyAtAll }) + +pReg2 tks = happySomeParser where + happySomeParser = happyThen (happyParse action_30 tks) (\x -> case x of {HappyAbsSyn73 z -> happyReturn z; _other -> notHappyAtAll }) + +pReg1 tks = happySomeParser where + happySomeParser = happyThen (happyParse action_31 tks) (\x -> case x of {HappyAbsSyn73 z -> happyReturn z; _other -> notHappyAtAll }) + +pReg3 tks = happySomeParser where + happySomeParser = happyThen (happyParse action_32 tks) (\x -> case x of {HappyAbsSyn73 z -> happyReturn z; _other -> notHappyAtAll }) + +pReg tks = happySomeParser where + happySomeParser = happyThen (happyParse action_33 tks) (\x -> case x of {HappyAbsSyn73 z -> happyReturn z; _other -> notHappyAtAll }) + +pListIdent tks = happySomeParser where + happySomeParser = happyThen (happyParse action_34 tks) (\x -> case x of {HappyAbsSyn77 z -> happyReturn z; _other -> notHappyAtAll }) + +happySeq = happyDontSeq + + +returnM :: a -> Err a +returnM = return + +thenM :: Err a -> (a -> Err b) -> Err b +thenM = (>>=) + +happyError :: [Token] -> Err a +happyError ts = + Bad $ "syntax error at " ++ tokenPos ts ++ + case ts of + [] -> [] + [Err _] -> " due to lexer error" + _ -> " before " ++ unwords (map prToken (take 4 ts)) + +myLexer = tokens +{-# LINE 1 "templates\GenericTemplate.hs" #-} +{-# LINE 1 "templates\\GenericTemplate.hs" #-} +{-# LINE 1 "<built-in>" #-} +{-# LINE 1 "<command line>" #-} +{-# LINE 1 "templates\\GenericTemplate.hs" #-} +-- Id: GenericTemplate.hs,v 1.26 2005/01/14 14:47:22 simonmar Exp + +{-# LINE 30 "templates\\GenericTemplate.hs" #-} + + + + + + + + +{-# LINE 51 "templates\\GenericTemplate.hs" #-} + +{-# LINE 61 "templates\\GenericTemplate.hs" #-} + +{-# LINE 70 "templates\\GenericTemplate.hs" #-} + +infixr 9 `HappyStk` +data HappyStk a = HappyStk a (HappyStk a) + +----------------------------------------------------------------------------- +-- starting the parse + +happyParse start_state = happyNewToken start_state notHappyAtAll notHappyAtAll + +----------------------------------------------------------------------------- +-- Accepting the parse + +-- If the current token is (1), 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` _) = + happyReturn1 ans +happyAccept j tk st sts (HappyStk ans _) = + (happyReturn1 ans) + +----------------------------------------------------------------------------- +-- Arrays only: do the next action + +{-# LINE 148 "templates\\GenericTemplate.hs" #-} + +----------------------------------------------------------------------------- +-- HappyState data type (not arrays) + + + +newtype HappyState b c = HappyState + (Int -> -- token number + Int -> -- token number (yes, again) + b -> -- token semantic value + HappyState b c -> -- current state + [HappyState b c] -> -- state stack + c) + + + +----------------------------------------------------------------------------- +-- 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 i tk st sts stk = + happyNewToken new_state ((st):(sts)) ((HappyTerminal (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_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') + = let r = fn v1 in + happySeq r (action 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') + = let r = fn v1 v2 in + happySeq r (action 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') + = let r = fn v1 v2 v3 in + happySeq r (action 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 nt fn j tk st sts stk + = case happyDrop (k - ((1) :: 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) + +happyMonadReduce k nt fn (1) tk st sts stk + = happyFail (1) tk st sts stk +happyMonadReduce k nt fn j tk st sts stk = + happyThen1 (fn stk tk) (\r -> action nt j tk st1 sts1 (r `HappyStk` drop_stk)) + where (sts1@(((st1@(HappyState (action))):(_)))) = happyDrop k ((st):(sts)) + drop_stk = happyDropStk k stk + +happyMonad2Reduce k nt fn (1) tk st sts stk + = happyFail (1) tk st sts stk +happyMonad2Reduce k nt fn j tk st sts stk = + happyThen1 (fn stk tk) (\r -> happyNewToken new_state sts1 (r `HappyStk` drop_stk)) + where (sts1@(((st1@(HappyState (action))):(_)))) = happyDrop k ((st):(sts)) + drop_stk = happyDropStk k stk + + + + + + new_state = action + + +happyDrop (0) l = l +happyDrop n ((_):(t)) = happyDrop (n - ((1) :: Int)) t + +happyDropStk (0) l = l +happyDropStk n (x `HappyStk` xs) = happyDropStk (n - ((1)::Int)) xs + +----------------------------------------------------------------------------- +-- Moving to a new state after a reduction + +{-# LINE 246 "templates\\GenericTemplate.hs" #-} +happyGoto action j tk st = action j j tk (HappyState action) + + +----------------------------------------------------------------------------- +-- Error recovery ((1) is the error token) + +-- parse error if we are in recovery and we fail again +happyFail (1) tk old_st _ stk = +-- trace "failing" $ + happyError_ tk + +{- We don't need state discarding for our restricted implementation of + "error". In fact, it can cause some bogus parses, so I've disabled it + for now --SDM + +-- discard a state +happyFail (1) tk old_st (((HappyState (action))):(sts)) + (saved_tok `HappyStk` _ `HappyStk` stk) = +-- trace ("discarding state, depth " ++ show (length stk)) $ + action (1) (1) tk (HappyState (action)) sts ((saved_tok`HappyStk`stk)) +-} + +-- Enter error recovery: generate an error token, +-- save the old token and carry on. +happyFail i tk (HappyState (action)) sts stk = +-- trace "entering error recovery" $ + action (1) (1) tk (HappyState (action)) sts ( (HappyErrorToken (i)) `HappyStk` stk) + +-- Internal happy errors: + +notHappyAtAll = error "Internal Happy error\n" + +----------------------------------------------------------------------------- +-- Hack to get the typechecker to accept our action functions + + + + + + + +----------------------------------------------------------------------------- +-- Seq-ing. If the --strict flag is given, then Happy emits +-- happySeq = happyDoSeq +-- otherwise it emits +-- happySeq = happyDontSeq + +happyDoSeq, happyDontSeq :: a -> b -> b +happyDoSeq a b = a `seq` b +happyDontSeq a b = b + +----------------------------------------------------------------------------- +-- Don't inline any functions from the template. GHC has a nasty habit +-- of deciding to inline happyGoto everywhere, which increases the size of +-- the generated parser quite a bit. + +{-# LINE 310 "templates\\GenericTemplate.hs" #-} +{-# NOINLINE happyShift #-} +{-# NOINLINE happySpecReduce_0 #-} +{-# NOINLINE happySpecReduce_1 #-} +{-# NOINLINE happySpecReduce_2 #-} +{-# NOINLINE happySpecReduce_3 #-} +{-# NOINLINE happyReduce #-} +{-# NOINLINE happyMonadReduce #-} +{-# NOINLINE happyGoto #-} +{-# NOINLINE happyFail #-} + +-- end of Happy Template.
+ Language/LBNF/PrintPrelude.hs view
@@ -0,0 +1,76 @@+module Language.LBNF.PrintPrelude where++import Data.Char++printTree :: Print a => a -> String+printTree = render . prt 0++type Doc = [ShowS] -> [ShowS]++doc :: ShowS -> Doc+doc = (:)++render :: Doc -> String+render d = rend 0 (map ($ "") $ d []) "" where+ rend i ss = case ss of+ "[" :ts -> showChar '[' . rend i ts+ "(" :ts -> showChar '(' . rend i ts+ "{" :ts -> showChar '{' . new (i+1) . rend (i+1) ts+ "}" : ";":ts -> new (i-1) . space "}" . showChar ';' . new (i-1) . rend (i-1) ts+ "}" :ts -> new (i-1) . showChar '}' . new (i-1) . rend (i-1) ts+ ";" :ts -> showChar ';' . new i . rend i ts+ t : "," :ts -> showString t . space "," . rend i ts+ t : ")" :ts -> showString t . showChar ')' . rend i ts+ t : "]" :ts -> showString t . showChar ']' . rend i ts+ t :ts -> space t . rend i ts+ _ -> id+ new i = showChar '\n' . replicateS (2*i) (showChar ' ') . dropWhile isSpace+ space t = showString t . (\s -> if null s then "" else (' ':s))++parenth :: Doc -> Doc+parenth ss = doc (showChar '(') . ss . doc (showChar ')')++concatS :: [ShowS] -> ShowS+concatS = foldr (.) id++concatD :: [Doc] -> Doc+concatD = foldr (.) id++replicateS :: Int -> ShowS -> ShowS+replicateS n f = concatS (replicate n f)++-- the printer class does the job+class Print a where+ prt :: Int -> a -> Doc+ prtList :: [a] -> Doc+ prtList = concatD . map (prt 0)++instance Print a => Print [a] where+ prt _ = prtList++instance Print Char where+ prt _ s = doc (showChar '\'' . mkEsc '\'' s . showChar '\'')+ prtList s = doc (showChar '"' . concatS (map (mkEsc '"') s) . showChar '"')++mkEsc :: Char -> Char -> ShowS+mkEsc q s = case s of+ _ | s == q -> showChar '\\' . showChar s+ '\\'-> showString "\\\\"+ '\n' -> showString "\\n"+ '\t' -> showString "\\t"+ _ -> showChar s++prPrec :: Int -> Int -> Doc -> Doc+prPrec i j = if j<i then parenth else id+++instance Print Integer where+ prt _ x = doc (shows x)+ prtList es = case es of+ [] -> (concatD [])+ [x] -> (concatD [prt 0 x])+ x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs])+++instance Print Double where+ prt _ x = doc (shows x)
+ Language/LBNF/RegToAlex.hs view
@@ -0,0 +1,88 @@+{-+ BNF Converter: Regular expression pretty printer+ Copyright (C) 2004 Author: BNF Converter, Aarne Ranta++ This program is free software; you can redistribute it and/or modify+ it under the terms of the GNU General Public License as published by+ the Free Software Foundation; either version 2 of the License, or+ (at your option) any later version.++ This program is distributed in the hope that it will be useful,+ but WITHOUT ANY WARRANTY; without even the implied warranty of+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+ GNU General Public License for more details.++ You should have received a copy of the GNU General Public License+ along with this program; if not, write to the Free Software+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA+-}++module Language.LBNF.RegToAlex (printRegAlex) where++-- modified from pretty-printer generated by the BNF converter++import Language.LBNF.AbsBNF+import Data.Char++-- the top-level printing method+printRegAlex :: Reg -> String+printRegAlex = render . prt 0++-- you may want to change render and parenth++render :: [String] -> String+render = rend (0::Int) where+ rend i ss = case ss of+ "[" :ts -> cons "[" $ rend i ts+ "(" :ts -> cons "(" $ rend i ts+ t : "," :ts -> cons t $ space "," $ rend i ts+ t : ")" :ts -> cons t $ cons ")" $ rend i ts+ t : "]" :ts -> cons t $ cons "]" $ rend i ts+ t :ts -> space t $ rend i ts+ _ -> ""+ cons s t = s ++ t+ new i s = s+ space t s = if null s then t else t ++ " " ++ s++parenth :: [String] -> [String]+parenth ss = ["("] ++ ss ++ [")"]++-- the printer class does the job+class Print a where+ prt :: Int -> a -> [String]+ prtList :: [a] -> [String]+ prtList = concat . map (prt 0)++instance Print a => Print [a] where+ prt _ = prtList++instance Print Char where+ prt _ c = if isAlphaNum c then [[c]] else ['^':[c]]+ prtList s = map (concat . prt 0) s++prPrec :: Int -> Int -> [String] -> [String]+prPrec i j = if j<i then parenth else id++instance Print Ident where+ prt _ (Ident i) = [i]++instance Print Reg where+ prt i e = case e of+ RSeq reg0 reg -> prPrec i 2 (concat [prt 2 reg0 , prt 3 reg])+ RAlt reg0 reg -> prPrec i 1 (concat [prt 1 reg0 , ["|"] , prt 2 reg])+ RMinus reg0 reg -> prPrec i 1 (concat [prt 2 reg0 , ["#"] , prt 2 reg])+ RStar reg -> prPrec i 3 (concat [prt 3 reg , ["*"]])+ RPlus reg -> prPrec i 3 (concat [prt 3 reg , ["+"]])+ ROpt reg -> prPrec i 3 (concat [prt 3 reg , ["?"]])+ REps -> prPrec i 3 (["$"])+ RChar c -> prPrec i 3 (concat [prt 0 c])+ RAlts str -> prPrec i 3 (concat [["["],prt 0 str,["]"]])+ RSeqs str -> prPrec i 2 (concat (map (prt 0) str))+ RDigit -> prPrec i 3 (concat [["^d"]])+ RLetter -> prPrec i 3 (concat [["^l"]])+ RUpper -> prPrec i 3 (concat [["^c"]])+ RLower -> prPrec i 3 (concat [["^s"]])+ RAny -> prPrec i 3 (concat [["^u"]])+++
+ Language/LBNF/TypeChecker.hs view
@@ -0,0 +1,146 @@++module Language.LBNF.TypeChecker where++import Control.Monad+import Data.List+import Data.Char++import Language.LBNF.CF+import Language.LBNF.ErrM++data Base = BaseT String+ | ListT Base+ deriving (Eq)++data Type = FunT [Base] Base+ deriving (Eq)++instance Show Base where+ show (BaseT x) = x+ show (ListT t) = "[" ++ show t ++ "]"++instance Show Type where+ show (FunT ts t) = unwords $ map show ts ++ ["->", show t]++data Context = Ctx { ctxLabels :: [(String, Type)]+ , ctxTokens :: [String]+ }++catchErr :: Err a -> (String -> Err a) -> Err a+catchErr (Bad s) f = f s+catchErr (Ok x) _ = Ok x++buildContext :: CF -> Context+buildContext cf@(_,rules) =+ Ctx+ [ (f, mkType cat args) | (f,(cat,args)) <- rules+ , not (isCoercion f)+ , not (isNilCons f)+ ]+ ("Ident" : tokenNames cf)+ where++ mkType cat args = FunT [ mkBase t | Left t <- args, t /= internalCat ]+ (mkBase cat)+ mkBase t+ | isList t = ListT $ mkBase $ normCatOfList t+ | otherwise = BaseT $ normCat t++isToken :: String -> Context -> Bool+isToken x ctx = elem x $ ctxTokens ctx++extendContext :: Context -> [(String,Type)] -> Context+extendContext ctx xs = ctx { ctxLabels = xs ++ ctxLabels ctx }++lookupCtx :: String -> Context -> Err Type+lookupCtx x ctx+ | isToken x ctx = return $ FunT [BaseT "String"] (BaseT x)+ | otherwise =+ case lookup x $ ctxLabels ctx of+ Nothing -> fail $ "Undefined symbol '" ++ x ++ "'."+ Just t -> return t++checkDefinitions :: CF -> Err ()+checkDefinitions cf@((ps,_),_) =+ do checkContext ctx+ sequence_ [ checkDefinition ctx f xs e | FunDef f xs e <- ps ]+ where+ ctx = buildContext cf++checkContext :: Context -> Err ()+checkContext ctx =+ mapM_ checkEntry $ groupSnd $ ctxLabels ctx+ where+ -- This is a very handy function which transforms a lookup table+ -- with duplicate keys to a list valued lookup table with no duplicate+ -- keys.+ groupSnd :: Ord a => [(a,b)] -> [(a,[b])]+ groupSnd =+ map ((fst . head) /\ map snd)+ . groupBy ((==) **.* fst)+ . sortBy (compare **.* fst)+ + (f /\ g) x = (f x, g x)+ (f **.* g) x y = f (g x) (g y)++ checkEntry (f,ts) =+ case nub ts of+ [_] -> return ()+ ts' -> + fail $ "The symbol '" ++ f ++ "' is used at conflicting types:\n" +++ unlines (map ((" " ++) . show) ts')++checkDefinition :: Context -> String -> [String] -> Exp -> Err ()+checkDefinition ctx f xs e =+ do checkDefinition' dummyConstructors ctx f xs e+ return ()++data ListConstructors = LC+ { nil :: Base -> String+ , cons :: Base -> String+ }++dummyConstructors :: ListConstructors+dummyConstructors = LC (const "[]") (const "(:)")++checkDefinition' :: ListConstructors -> Context -> String -> [String] -> Exp -> Err ([(String,Base)],(Exp,Base))+checkDefinition' list ctx f xs e =+ do unless (isLower $ head f) $ fail "Defined functions must start with a lowercase letter."+ t@(FunT ts t') <- lookupCtx f ctx `catchErr` \_ ->+ fail $ "'" ++ f ++ "' must be used in a rule."+ let expect = length ts+ given = length xs+ unless (expect == given) $ fail $ "'" ++ f ++ "' is used with type " ++ show t ++ " but defined with " ++ show given ++ " argument" ++ plural given ++ "."+ e' <- checkExp list (extendContext ctx $ zip xs (map (FunT []) ts)) e t'+ return (zip xs ts, (e', t'))+ `catchErr` \err -> fail $ "In the definition " ++ unwords (f : xs ++ ["=",show e,";"]) ++ "\n " ++ err+ where+ plural 1 = ""+ plural _ = "s"++checkExp :: ListConstructors -> Context -> Exp -> Base -> Err Exp+checkExp list ctx (App "[]" []) (ListT t) = return (App (nil list t) [])+checkExp _ _ (App "[]" _) _ = fail $ "[] is applied to too many arguments."+checkExp list ctx (App "(:)" [e,es]) (ListT t) =+ do e' <- checkExp list ctx e t+ es' <- checkExp list ctx es (ListT t)+ return $ App (cons list t) [e',es']+checkExp _ _ (App "(:)" es) _ = fail $ "(:) takes 2 arguments, but has been given " ++ show (length es) ++ "."+checkExp list ctx e@(App x es) t =+ do FunT ts t' <- lookupCtx x ctx+ es' <- matchArgs ctx es ts+ unless (t == t') $ fail $ show e ++ " has type " ++ show t' ++ ", but something of type " ++ show t ++ " was expected."+ return $ App x es'+ where+ matchArgs ctx es ts+ | expect /= given = fail $ "'" ++ x ++ "' takes " ++ show expect ++ " arguments, but has been given " ++ show given ++ "."+ | otherwise = zipWithM (checkExp list ctx) es ts+ where+ expect = length ts+ given = length es+checkExp _ _ e@(LitInt _) (BaseT "Integer") = return e+checkExp _ _ e@(LitDouble _) (BaseT "Double") = return e+checkExp _ _ e@(LitChar _) (BaseT "Char") = return e+checkExp _ _ e@(LitString _) (BaseT "String") = return e+checkExp _ _ e t = fail $ show e ++ " does not have type " ++ show t ++ "."+
+ Language/LBNF/Utils.hs view
@@ -0,0 +1,112 @@+{-+ BNF Converter: Abstract syntax+ Copyright (C) 2004 Author: Aarne Ranta++ This program is free software; you can redistribute it and/or modify+ it under the terms of the GNU General Public License as published by+ the Free Software Foundation; either version 2 of the License, or+ (at your option) any later version.++ This program is distributed in the hope that it will be useful,+ but WITHOUT ANY WARRANTY; without even the implied warranty of+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+ GNU General Public License for more details.++ You should have received a copy of the GNU General Public License+ along with this program; if not, write to the Free Software+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA+-}++module Language.LBNF.Utils where++import Control.Monad (unless)++infixr 5 ++++infixr 5 +++++infixr 5 ++++++infixr 2 |||+infixr 5 ...+infixr 3 ***+++-- printing operations++a +++ b = a ++ " " ++ b+a ++++ b = a ++ "\n" ++ b+a +++++ b = a ++ "\n\n" ++ b++prParenth s = if s == "" then "" else "(" ++ s ++ ")"+++-- parser combinators a` la Wadler and Hutton++type Parser a b = [a] -> [(b,[a])]++(...) :: Parser a b -> Parser a c -> Parser a (b,c)+(p ... q) s = [((x,y),r) | (x,t) <- p s, (y,r) <- q t]++(|||) :: Parser a b -> Parser a b -> Parser a b+(p ||| q) s = p s ++ q s++lit :: (Eq a) => a -> Parser a a+lit x (c:cs) = [(x,cs) | x == c]+lit _ _ = []++(***) :: Parser a b -> (b -> c) -> Parser a c+(p *** f) s = [(f x,r) | (x,r) <- p s] ++succeed :: b -> Parser a b+succeed v s = [(v,s)]++fails :: Parser a b+fails s = []++-- to get parse results++parseResults :: Parser a b -> [a] -> [b]+parseResults p s = [x | (x,r) <- p s, null r]+++-- * List utilities++-- | Replace all occurences of a value by another value+replace :: Eq a => + a -- ^ Value to replace + -> a -- ^ Value to replace it with+ -> [a] -> [a]+replace x y xs = [ if z == x then y else z | z <- xs]++-- | Split a list on the first occurence of a value.+-- Does not include the value that was split on in either+-- of the returned lists.+split :: Eq a => a -> [a] -> ([a],[a])+split x xs = let (ys, zs) = break (==x) xs+ in (ys, drop 1 zs)++-- | Split a list on every occurence of a value.+-- If the value does not occur in the list,+-- the result is the singleton list containing the input list.+-- Thus the returned list is never the empty list.+splitAll :: Eq a => a -> [a] -> [[a]]+splitAll _ [] = [[]]+splitAll x xs = let (ys, zs) = break (==x) xs+ in ys : case zs of+ [] -> []+ _:zs' -> splitAll x zs'+++pathSep :: Char+pathSep = '/'++-- | Like the prelude function 'inits' but for path names.+-- For example:+-- > pathInits "foo/bar" = ["foo","foo/bar"]+-- > pathInits "foo/bar/baz.hs" = ["foo","foo/bar","foo/bar/baz.hs"]+pathInits :: String -> [String]+pathInits "" = []+pathInits xs = let (ys,zs) = split pathSep xs+ in ys : map ((ys ++ [pathSep]) ++) (pathInits zs)++-- | Like basename(1), remove all leading directories from a path name.+basename :: String -> String+basename = last . splitAll pathSep
+ Setup.lhs view
@@ -0,0 +1,3 @@+> import Distribution.Simple+> main :: IO ()+> main = defaultMain
+ examples/jll/JavaletteLight.hs view
@@ -0,0 +1,59 @@+{-# LANGUAGE QuasiQuotes #-}++module JavaletteLight where++import Language.LBNF++{- compile is a TH function and cf is a QuasiQuoter for LBNF. +compile will generate most of the code that BNFC, Happy and Alex +would (and some new stuff) and splice it directly into this module. +-}+compile [$cf|++-- This is a new pragma. The rest of the grammar is original JL.+antiquote "[" ":" ":]" ;++-- Javalette Light: a simple subset of C, covering+-- programs with a single zero-argument function.+-- example: koe.jll+-- ordinary rules++Fun. Prog ::= Typ Ident "(" ")" "{" [Stm] "}" ;++SDecl. Stm ::= Typ Ident ";" ;+SAss. Stm ::= Ident "=" Exp ";" ;+SIncr. Stm ::= Ident "++" ";" ;+SWhile. Stm ::= "while" "(" Exp ")" "{" [Stm] "}" ;++ELt. Exp0 ::= Exp1 "<" Exp1 ;+EPlus. Exp1 ::= Exp1 "+" Exp2 ;+ETimes. Exp2 ::= Exp2 "*" Exp3 ;+EVar. Exp3 ::= Ident ;+EInt. Exp3 ::= Integer ;+EDouble. Exp3 ::= Double ;++[]. [Stm] ::= ;+(:). [Stm] ::= Stm [Stm] ;++-- coercions++_. Stm ::= Stm ";" ;++_. Exp ::= Exp0 ;+_. Exp0 ::= Exp1 ;+_. Exp1 ::= Exp2 ;+_. Exp2 ::= Exp3 ;+_. Exp3 ::= "(" Exp ")" ;++TInt. Typ ::= "int" ;+TDouble. Typ ::= "double" ;++-- pragmas++comment "/*" "*/" ;+comment "//" ;++entrypoints Prog, Stm, Exp ;+ |]++
+ examples/jll/UseJll.hs view
@@ -0,0 +1,37 @@+{-# LANGUAGE QuasiQuotes #-}+import JavaletteLight+import Language.LBNF(pp) -- overloaded pretty-printing function+import Prelude hiding (exp)++{- This Javalette Light program is parsed at compile time, +and replaced by it's abstract syntax representation.+The 'holes' in square brackets are anti-quoted Haskell +expression. ++The QuasiQuoter prog is generated from the grammar in JavaletteLight.hs+(it corresponds to the category Prog).+-}+++prg x v e = [$prog|+int f() {+ int a; + [:SWhile (EInt 10 :: Exp) []:]+ int a;+ int [:v:];+ int tmp;+ while (n < [Exp:e:]) {+ n = n + 1;+ tmp = a + b;+ a = b;+ b = tmp;+ }+}+|] ++st v = [$stm| [:v:] = 1; |]+pr = prg (st (Ident "n")) (Ident "n") [$exp|n|]+main = putStr $ pp pr+++
+ examples/sql/Sql.hs view
@@ -0,0 +1,70 @@+{-# Language QuasiQuotes #-} +module SQL where +import Language.LBNF + +compile [$cf| + +antiquote "[" ":" ":]" ; + +entrypoints SqlStatement,BoolExpression,Value,TableName ; + +-- Statements +DeleteStatement. SqlStatement ::= "DELETE" "FROM" TableName WhereClause ; + +WhereClause. WhereClause ::= "WHERE" BoolExpression; +NoWhereClause. WhereClause ::= ; + +-- Names +TableName. TableName ::= LocalOrSchemaQualifiedName ; +ColumnName. ColumnName ::= LocalOrSchemaQualifiedName ; + +-- Expressions +BoolOr. BoolExpression ::= BoolExpression "OR" BoolExpression1 ; +BoolAnd. BoolExpression1 ::= BoolExpression1 "AND" BoolExpression2 ; +BoolNeg. BoolExpression2 ::= "NOT" BoolExpression3 ; +BoolIsNot. BoolExpression3 ::= BoolExpression4 "IS" "NOT" TruthValue ; +BoolIs. BoolExpression3 ::= BoolExpression4 "IS" TruthValue ; +BoolVal. BoolExpression4 ::= RowValuePredicand CompOp RowValuePredicand ; +_. BoolExpression4 ::= "(" BoolExpression ")" ; +-- | <nonparenthesized value expression primary> +-- Lots of other predicates go here... + +_. BoolExpression ::= BoolExpression1 ; +_. BoolExpression1 ::= BoolExpression2 ; +_. BoolExpression2 ::= BoolExpression3 ; +_. BoolExpression3 ::= BoolExpression4 ; + + +ValuePredicand . RowValuePredicand ::= Value ; +ColumnReferencePredicand . RowValuePredicand ::= ColumnName ; +-- <boolean value expression> +-- <explicit row value constructor> +-- <row value special case> + +TRUE. TruthValue ::= "TRUE" ; +FALSE. TruthValue ::= "FALSE" ; +UNKNOWN. TruthValue ::= "UNKNOWN" ; + +-- Comparison operators +EqualsOp. CompOp ::= "=" ; +NotEqualsOp. CompOp ::= "><" ; +LessThanOperator. CompOp ::= "<" ; +GreaterThanOp. CompOp ::= ">" ; +LessThanOrEqualsOp. CompOp ::= "<=" ; +GreaterThanOrEqualsOp. CompOp ::= ">=" ; + +-- Data +StringValue. Value ::= String ; +IntValue. Value ::= Integer ; +DoubleValue. Value ::= Double ; +-- <datetime value expression> +-- <interval value expression> +-- <user-defined type value expression> +-- <reference value expression> +-- <collection value expression> + +-- Tokens +token LocalOrSchemaQualifiedName + (letter (letter | digit)* '.')* letter (letter | digit)* ; + +|]
+ examples/sql/UseSql.hs view
@@ -0,0 +1,13 @@+{-# Language QuasiQuotes #-} +module UseSQL where +-- import Language.LBNF + +import SQL; + +del x uid= [$sqlStatement| + DELETE FROM Tables.Table WHERE + [:x:] + AND Owner = [Integer:uid:] + |] + +stm = del [$boolExpression|text = "Value"|] 0