diff --git a/BNFC-meta.cabal b/BNFC-meta.cabal new file mode 100644 --- /dev/null +++ b/BNFC-meta.cabal @@ -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 diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE diff --git a/Language/LBNF.hs b/Language/LBNF.hs new file mode 100644 --- /dev/null +++ b/Language/LBNF.hs @@ -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 + + diff --git a/Language/LBNF/AbsBNF.hs b/Language/LBNF/AbsBNF.hs new file mode 100644 --- /dev/null +++ b/Language/LBNF/AbsBNF.hs @@ -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) + diff --git a/Language/LBNF/CF.hs b/Language/LBNF/CF.hs new file mode 100644 --- /dev/null +++ b/Language/LBNF/CF.hs @@ -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 diff --git a/Language/LBNF/CFtoAbstract.hs b/Language/LBNF/CFtoAbstract.hs new file mode 100644 --- /dev/null +++ b/Language/LBNF/CFtoAbstract.hs @@ -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 [] diff --git a/Language/LBNF/CFtoAlex2.hs b/Language/LBNF/CFtoAlex2.hs new file mode 100644 --- /dev/null +++ b/Language/LBNF/CFtoAlex2.hs @@ -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" " ::= ^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 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"]]) diff --git a/Language/LBNF/CFtoHappy.hs b/Language/LBNF/CFtoHappy.hs new file mode 100644 --- /dev/null +++ b/Language/LBNF/CFtoHappy.hs @@ -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 "" diff --git a/Language/LBNF/CFtoPrinter.hs b/Language/LBNF/CFtoPrinter.hs new file mode 100644 --- /dev/null +++ b/Language/LBNF/CFtoPrinter.hs @@ -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) +-} diff --git a/Language/LBNF/ErrM.hs b/Language/LBNF/ErrM.hs new file mode 100644 --- /dev/null +++ b/Language/LBNF/ErrM.hs @@ -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 diff --git a/Language/LBNF/GetCF.hs b/Language/LBNF/GetCF.hs new file mode 100644 --- /dev/null +++ b/Language/LBNF/GetCF.hs @@ -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 "[]" [] + diff --git a/Language/LBNF/LexBNF.hs b/Language/LBNF/LexBNF.hs new file mode 100644 --- /dev/null +++ b/Language/LBNF/LexBNF.hs @@ -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 "" #-} +{-# LINE 1 "" #-} +{-# 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 diff --git a/Language/LBNF/LiftBNF.hs b/Language/LBNF/LiftBNF.hs new file mode 100644 --- /dev/null +++ b/Language/LBNF/LiftBNF.hs @@ -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 diff --git a/Language/LBNF/ParBNF.hs b/Language/LBNF/ParBNF.hs new file mode 100644 --- /dev/null +++ b/Language/LBNF/ParBNF.hs @@ -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 "" #-} +{-# LINE 1 "" #-} +{-# 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. diff --git a/Language/LBNF/PrintPrelude.hs b/Language/LBNF/PrintPrelude.hs new file mode 100644 --- /dev/null +++ b/Language/LBNF/PrintPrelude.hs @@ -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 (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) diff --git a/Language/LBNF/RegToAlex.hs b/Language/LBNF/RegToAlex.hs new file mode 100644 --- /dev/null +++ b/Language/LBNF/RegToAlex.hs @@ -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 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"]]) + + + diff --git a/Language/LBNF/TypeChecker.hs b/Language/LBNF/TypeChecker.hs new file mode 100644 --- /dev/null +++ b/Language/LBNF/TypeChecker.hs @@ -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 ++ "." + diff --git a/Language/LBNF/Utils.hs b/Language/LBNF/Utils.hs new file mode 100644 --- /dev/null +++ b/Language/LBNF/Utils.hs @@ -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 diff --git a/Setup.lhs b/Setup.lhs new file mode 100644 --- /dev/null +++ b/Setup.lhs @@ -0,0 +1,3 @@ +> import Distribution.Simple +> main :: IO () +> main = defaultMain diff --git a/examples/jll/JavaletteLight.hs b/examples/jll/JavaletteLight.hs new file mode 100644 --- /dev/null +++ b/examples/jll/JavaletteLight.hs @@ -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 ; + |] + + diff --git a/examples/jll/UseJll.hs b/examples/jll/UseJll.hs new file mode 100644 --- /dev/null +++ b/examples/jll/UseJll.hs @@ -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 + + + diff --git a/examples/sql/Sql.hs b/examples/sql/Sql.hs new file mode 100644 --- /dev/null +++ b/examples/sql/Sql.hs @@ -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 ")" ; +-- | +-- Lots of other predicates go here... + +_. BoolExpression ::= BoolExpression1 ; +_. BoolExpression1 ::= BoolExpression2 ; +_. BoolExpression2 ::= BoolExpression3 ; +_. BoolExpression3 ::= BoolExpression4 ; + + +ValuePredicand . RowValuePredicand ::= Value ; +ColumnReferencePredicand . RowValuePredicand ::= ColumnName ; +-- +-- +-- + +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 ; +-- +-- +-- +-- +-- + +-- Tokens +token LocalOrSchemaQualifiedName + (letter (letter | digit)* '.')* letter (letter | digit)* ; + +|] diff --git a/examples/sql/UseSql.hs b/examples/sql/UseSql.hs new file mode 100644 --- /dev/null +++ b/examples/sql/UseSql.hs @@ -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