parsley 1.0.0.0 → 1.0.0.1
raw patch · 46 files changed
+6683/−6 lines, 46 filesdep +arraydep +attoparsecdep +bytestringdep ~basedep ~template-haskelldep ~textPVP ok
version bump matches the API change (PVP)
Dependencies added: array, attoparsec, bytestring, containers, criterion, deepseq, dump-core, megaparsec, mtl, parsec, parsley, parsley-garnish, tasty, tasty-hunit, tasty-quickcheck, th-test-utils
Dependency ranges changed: base, template-haskell, text
API changes (from Hackage documentation)
Files
- ChangeLog.md +4/−0
- benchmarks/BrainfuckBench/Attoparsec/Parser.hs +17/−0
- benchmarks/BrainfuckBench/Handrolled/Parser.hs +26/−0
- benchmarks/BrainfuckBench/Happy/Parser.y +33/−0
- benchmarks/BrainfuckBench/Main.hs +65/−0
- benchmarks/BrainfuckBench/Megaparsec/Parser.hs +19/−0
- benchmarks/BrainfuckBench/Parsec/Parser.hs +18/−0
- benchmarks/BrainfuckBench/Parsley/Parser.hs +36/−0
- benchmarks/BrainfuckBench/Shared.hs +35/−0
- benchmarks/JavascriptBench/Attoparsec/Parser.hs +242/−0
- benchmarks/JavascriptBench/Happy/Parser.y +466/−0
- benchmarks/JavascriptBench/Main.hs +63/−0
- benchmarks/JavascriptBench/Megaparsec/Parser.hs +244/−0
- benchmarks/JavascriptBench/Parsec/Parser.hs +244/−0
- benchmarks/JavascriptBench/Parsley/Parser.hs +263/−0
- benchmarks/JavascriptBench/Shared.hs +95/−0
- benchmarks/NandlangBench/Bison/Nandlang.tab.c +1601/−0
- benchmarks/NandlangBench/Bison/Parser.hs +15/−0
- benchmarks/NandlangBench/Bison/lex.yy.c +1949/−0
- benchmarks/NandlangBench/Main.hs +28/−0
- benchmarks/NandlangBench/Parsley/Functions.hs +19/−0
- benchmarks/NandlangBench/Parsley/Parser.hs +103/−0
- benchmarks/Shared/Attoparsec/Extended.hs +77/−0
- benchmarks/Shared/BenchmarkUtils.hs +40/−0
- benchmarks/Shared/Megaparsec/Extended.hs +73/−0
- benchmarks/Shared/Parsec/Extended.hs +70/−0
- parsley.cabal +70/−1
- src/ghc/Parsley/Combinator.hs +25/−5
- test/Parsley/Alternative/Parsers.hs +1/−0
- test/Parsley/Alternative/Test.hs +28/−0
- test/Parsley/Applicative/Parsers.hs +1/−0
- test/Parsley/Applicative/Test.hs +55/−0
- test/Parsley/Combinator/Parsers.hs +10/−0
- test/Parsley/Combinator/Test.hs +86/−0
- test/Parsley/Fold/Parsers.hs +31/−0
- test/Parsley/Fold/Test.hs +107/−0
- test/Parsley/Precedence/Parsers.hs +1/−0
- test/Parsley/Precedence/Test.hs +14/−0
- test/Parsley/Primitive/Parsers.hs +28/−0
- test/Parsley/Primitive/Test.hs +108/−0
- test/Parsley/Register/Parsers.hs +32/−0
- test/Parsley/Register/Test.hs +94/−0
- test/Parsley/Selective/Parsers.hs +1/−0
- test/Parsley/Selective/Test.hs +37/−0
- test/ParsleyTest.hs +24/−0
- test/TestUtils.hs +85/−0
ChangeLog.md view
@@ -19,3 +19,7 @@ ## 1.0.0.0 -- 2021-06-12 * Factored all of the `Parsley.Internal` modules out into `parsley-core` package++## 1.0.0.1 -- 2021-06-29++* Improved implementation of `oneOf` and `noneOf` to use ranges and not exhaustive character search
+ benchmarks/BrainfuckBench/Attoparsec/Parser.hs view
@@ -0,0 +1,17 @@+module BrainfuckBench.Attoparsec.Parser where++import Shared.Attoparsec.Extended+import BrainfuckBench.Shared++brainfuck :: Parser [BrainFuckOp]+brainfuck = whitespace *> bf <* endOfInput+ where+ bf = many ( lexeme (char '>' $> RightPointer)+ <|> lexeme (char '<' $> LeftPointer)+ <|> lexeme (char '+' $> Increment)+ <|> lexeme (char '-' $> Decrement)+ <|> lexeme (char '.' $> Output)+ <|> lexeme (char ',' $> Input)+ <|> between (lexeme (char '[')) (lexeme (char ']')) (Loop <$> bf))+ whitespace = skipMany (noneOf "<>+-.,[]")+ lexeme p = p <* whitespace
+ benchmarks/BrainfuckBench/Handrolled/Parser.hs view
@@ -0,0 +1,26 @@+module BrainfuckBench.Handrolled.Parser where+import BrainfuckBench.Shared++brainfuck :: String -> Maybe [BrainFuckOp]+brainfuck input =+ let walk :: String -> [BrainFuckOp] -> Maybe ([BrainFuckOp], String)+ walk [] acc = return (reverse acc, [])+ walk input@(']':_) acc = return (reverse acc, input)+ walk (c:rest) acc = case c of+ '>' -> walk rest (RightPointer:acc)+ '<' -> walk rest (LeftPointer:acc)+ '+' -> walk rest (Increment:acc)+ '-' -> walk rest (Decrement:acc)+ '.' -> walk rest (Output:acc)+ ',' -> walk rest (Input:acc)+ '[' -> do (body, rest') <- loop rest; walk rest' (Loop body:acc)+ _ -> walk rest acc+ loop :: String -> Maybe ([BrainFuckOp], String)+ loop input = do+ (body, rest) <- walk input []+ case rest of+ ']':rest' -> return (body, rest')+ _ -> fail "unclosed loop"+ in do+ (res, []) <- walk input []+ return res
+ benchmarks/BrainfuckBench/Happy/Parser.y view
@@ -0,0 +1,33 @@+{+module BrainfuckBench.Happy.Parser where+import BrainfuckBench.Shared (BrainFuckOp(..))+}++%name brainfuck Bf+%tokentype { Char }+%error { const Nothing }+%monad { Maybe }++%token+ inc { '+' }+ dec { '-' }+ out { '.' }+ in { ',' }+ lft { '<' }+ rht { '>' }+ lb { '[' }+ rb { ']' }+ ws { $$ }++%%++Bf :: { [BrainFuckOp] }+Bf : inc Bf { Increment : $2 }+ | dec Bf { Decrement : $2 }+ | out Bf { Output : $2 }+ | in Bf { Input : $2 }+ | lft Bf { LeftPointer : $2 }+ | rht Bf { RightPointer : $2 }+ | lb Bf rb Bf { Loop $2 : $4 }+ | ws Bf { $2 }+ | { [] }
+ benchmarks/BrainfuckBench/Main.hs view
@@ -0,0 +1,65 @@+{-# LANGUAGE TemplateHaskell,+ ScopedTypeVariables,+ StandaloneDeriving,+ DeriveAnyClass,+ DeriveGeneric,+ TypeFamilies,+ UnboxedTuples,+ TypeApplications #-}+module Main where+import Criterion.Main (Benchmark, bgroup, defaultMain)+import Control.DeepSeq (NFData)+import GHC.Generics (Generic)+import Data.ByteString (ByteString)+import Parsley.InputExtras (Text16(..), CharList(..))+--import Parsley.Internal.Verbose ()+import qualified BrainfuckBench.Parsley.Parser+import qualified BrainfuckBench.Parsec.Parser+import qualified BrainfuckBench.Megaparsec.Parser+import qualified BrainfuckBench.Attoparsec.Parser+import qualified BrainfuckBench.Handrolled.Parser+import qualified BrainfuckBench.Happy.Parser+import qualified Parsley+import qualified Data.ByteString.Lazy+import BrainfuckBench.Shared+import Shared.BenchmarkUtils++main :: IO ()+main = defaultMain [brainfuck]++deriving instance Generic BrainFuckOp+deriving instance NFData BrainFuckOp++brainfuckParsleyS :: String -> Maybe [BrainFuckOp]+brainfuckParsleyS = $$(Parsley.runParser BrainfuckBench.Parsley.Parser.brainfuck)++brainfuckParsleyT :: Text16 -> Maybe [BrainFuckOp]+brainfuckParsleyT = $$(Parsley.runParser BrainfuckBench.Parsley.Parser.brainfuck)++brainfuckParsleyB :: ByteString -> Maybe [BrainFuckOp]+brainfuckParsleyB = $$(Parsley.runParser BrainfuckBench.Parsley.Parser.brainfuck)++brainfuckParsleySS :: CharList -> Maybe [BrainFuckOp]+brainfuckParsleySS = $$(Parsley.runParser BrainfuckBench.Parsley.Parser.brainfuck)++brainfuckParsleyLB :: Data.ByteString.Lazy.ByteString -> Maybe [BrainFuckOp]+brainfuckParsleyLB = $$(Parsley.runParser BrainfuckBench.Parsley.Parser.brainfuck)++brainfuck :: Benchmark+brainfuck =+ let bfTest :: NFData rep => (FilePath -> IO rep) -> String -> (rep -> Maybe [BrainFuckOp]) -> Benchmark+ bfTest = benchmark ["benchmarks/inputs/helloworld.bf", "benchmarks/inputs/helloworld_golfed.bf", "benchmarks/inputs/compiler.bf"]+ in bgroup "Brainfuck"+ [ {-bfTest string "Parsley (Stream)" (brainfuckParsleySS . CharList)+ ,-} bfTest string "Happy" BrainfuckBench.Happy.Parser.brainfuck+ , bfTest string "Parsley (String)" brainfuckParsleyS+ , bfTest text "Parsley (Text)" (brainfuckParsleyT . Text16)+ --, bfTest bytestring "Parsley (ByteString)" brainfuckParsleyB+ --, bfTest lazy_bytestring "Parsley (Lazy ByteString)" brainfuckParsleyLB+ , bfTest string "Parsec (String)" (parsecParse BrainfuckBench.Parsec.Parser.brainfuck)+ , bfTest text "Parsec (Text)" (parsecParse BrainfuckBench.Parsec.Parser.brainfuck)+ , bfTest string "Mega (String)" (megaParse BrainfuckBench.Megaparsec.Parser.brainfuck)+ , bfTest text "Mega (Text)" (megaParse BrainfuckBench.Megaparsec.Parser.brainfuck)+ , bfTest text "Atto (Text)" (attoParse BrainfuckBench.Attoparsec.Parser.brainfuck)+ , bfTest string "Handrolled" BrainfuckBench.Handrolled.Parser.brainfuck+ ]
+ benchmarks/BrainfuckBench/Megaparsec/Parser.hs view
@@ -0,0 +1,19 @@+{-# LANGUAGE ScopedTypeVariables, TypeFamilies #-}+module BrainfuckBench.Megaparsec.Parser where++import Shared.Megaparsec.Extended+import BrainfuckBench.Shared++brainfuck :: forall s. (Stream s, Token s ~ Char) => Parser s [BrainFuckOp]+brainfuck = whitespace *> bf <* eof+ where+ bf = many ( lexeme (char '>' $> RightPointer)+ <|> lexeme (char '<' $> LeftPointer)+ <|> lexeme (char '+' $> Increment)+ <|> lexeme (char '-' $> Decrement)+ <|> lexeme (char '.' $> Output)+ <|> lexeme (char ',' $> Input)+ <|> between (lexeme (char '[')) (lexeme (char ']')) (Loop <$> bf))+ whitespace = skipMany (noneOf "<>+-.,[]")+ lexeme :: Parser s a -> Parser s a+ lexeme p = p <* whitespace
+ benchmarks/BrainfuckBench/Parsec/Parser.hs view
@@ -0,0 +1,18 @@+{-# LANGUAGE FlexibleContexts #-}+module BrainfuckBench.Parsec.Parser where++import Shared.Parsec.Extended+import BrainfuckBench.Shared++brainfuck :: Stream s Identity Char => Parser s [BrainFuckOp]+brainfuck = whitespace *> bf <* eof+ where+ bf = many ( lexeme (char '>' $> RightPointer)+ <|> lexeme (char '<' $> LeftPointer)+ <|> lexeme (char '+' $> Increment)+ <|> lexeme (char '-' $> Decrement)+ <|> lexeme (char '.' $> Output)+ <|> lexeme (char ',' $> Input)+ <|> between (lexeme (char '[')) (lexeme (char ']')) (Loop <$> bf))+ whitespace = skipMany (noneOf "<>+-.,[]")+ lexeme p = p <* whitespace
+ benchmarks/BrainfuckBench/Parsley/Parser.hs view
@@ -0,0 +1,36 @@+{-# OPTIONS_GHC -fplugin=Parsley.OverloadedQuotesPlugin #-}+{-# LANGUAGE TemplateHaskellQuotes #-}+{-# LANGUAGE DeriveLift #-}+{-# LANGUAGE StandaloneDeriving #-}+module BrainfuckBench.Parsley.Parser where++import Prelude hiding (fmap, pure, (<*), (*>), (<*>), (<$>), (<$), pred)+import BrainfuckBench.Shared+import Parsley+import Parsley.Combinator (noneOf, eof)+import Parsley.Fold (skipMany)+--import Parsley.Garnish+import Language.Haskell.TH.Syntax (Lift(..))++deriving instance Lift BrainFuckOp++brainfuck :: Parser [BrainFuckOp]+brainfuck = whitespace *> bf <* eof+ where+ whitespace = skipMany (noneOf "<>+-[],.")+ lexeme p = p <* whitespace+ {-bf = many ( lexeme ((token ">" $> code RightPointer)+ <|> (token "<" $> code LeftPointer)+ <|> (token "+" $> code Increment)+ <|> (token "-" $> code Decrement)+ <|> (token "." $> code Output)+ <|> (token "," $> code Input)+ <|> (between (lexeme (token "[")) (token "]") (code Loop <$> bf))))-}+ bf = many (lexeme (match "><+-.,[" (lookAhead item) op empty))+ op '>' = item $> [|RightPointer|]+ op '<' = item $> [|LeftPointer|]+ op '+' = item $> [|Increment|]+ op '-' = item $> [|Decrement|]+ op '.' = item $> [|Output|]+ op ',' = item $> [|Input|]+ op '[' = between (lexeme item) (try (char ']')) ([|Loop|] <$> bf)
@@ -0,0 +1,35 @@+module BrainfuckBench.Shared where+import Data.Int+import Data.Char (ord, chr)++data BrainFuckOp = RightPointer | LeftPointer | Increment | Decrement | Output | Input | Loop [BrainFuckOp] deriving Show++data Tape a = Tape [a] a [a]++evalBf :: [BrainFuckOp] -> IO ()+evalBf prog = go (Tape (repeat 0) 0 (repeat 0)) prog >> return ()+ where+ evalOp :: BrainFuckOp -> Tape Int32 -> IO (Tape Int32)+ evalOp RightPointer tape = return (right tape)+ evalOp LeftPointer tape = return (left tape)+ evalOp Increment tape = let x = read tape in return (write (succ x) tape)+ evalOp Decrement tape = let x = read tape in return (write (pred x) tape)+ evalOp Output tape = let x = read tape in do print (chr (fromEnum x)); return tape+ evalOp Input tape = do x <- getChar; return (write (toEnum (ord x)) tape)+ evalOp (Loop p) tape = let x = read tape in if x == 0 then return tape+ else do tape' <- go tape p+ if read tape' /= 0 then evalOp (Loop p) tape'+ else return tape'++ go :: Tape Int32 -> [BrainFuckOp] -> IO (Tape Int32)+ go tape [] = return tape+ go tape (op:ops) = do tape' <- evalOp op tape; go tape' ops++ right :: Tape a -> Tape a+ right (Tape ls x (r:rs)) = Tape (x:ls) r rs+ left :: Tape a -> Tape a+ left (Tape (l:ls) x rs) = Tape ls l (x:rs)+ read :: Tape a -> a+ read (Tape _ x _) = x+ write :: a -> Tape a -> Tape a+ write x (Tape ls _ rs) = Tape ls x rs
+ benchmarks/JavascriptBench/Attoparsec/Parser.hs view
@@ -0,0 +1,242 @@+module JavascriptBench.Attoparsec.Parser where++import Shared.Attoparsec.Extended+import JavascriptBench.Shared++import Data.Char (isSpace, isUpper, digitToInt)+import Data.Maybe (catMaybes)+import Text.Read (readMaybe)++javascript :: Parser JSProgram+javascript = whitespace *> many element <* endOfInput+ where+ element :: Parser JSElement+ element = keyword "function" *> liftA3 JSFunction identifier (parens (commaSep identifier)) compound+ <|> JSStm <$> stmt+ compound :: Parser JSCompoundStm+ compound = braces (many stmt)+ stmt :: Parser JSStm+ stmt = semi $> JSSemi+ <|> keyword "if" *> liftA3 JSIf parensExpr stmt (maybeP (keyword "else" *> stmt))+ <|> keyword "while" *> liftA2 JSWhile parensExpr stmt+ <|> (keyword "for" *> parens+ (try (liftA2 JSForIn varsOrExprs (keyword "in" *> expr))+ <|> liftA3 JSFor (maybeP varsOrExprs <* semi) (optExpr <* semi) optExpr)+ <*> stmt)+ <|> keyword "break" $> JSBreak+ <|> keyword "continue" $> JSContinue+ <|> keyword "with" *> liftA2 JSWith parensExpr stmt+ <|> keyword "return" *> (JSReturn <$> optExpr)+ <|> JSBlock <$> compound+ <|> JSNaked <$> varsOrExprs+ varsOrExprs :: Parser (Either [JSVar] JSExpr)+ varsOrExprs = (keyword "var" *> commaSep1 variable) <+> expr+ variable :: Parser JSVar+ variable = liftA2 JSVar identifier (maybeP (symbol '=' *> asgn))+ parensExpr :: Parser JSExpr+ parensExpr = parens expr+ optExpr :: Parser (Maybe JSExpr)+ optExpr = maybeP expr+ expr :: Parser JSExpr+ expr = commaSep1 asgn+ asgn :: Parser JSExpr'+ asgn = chainl1 condExpr (symbol '=' $> JSAsgn)+ condExpr :: Parser JSExpr'+ condExpr = liftA2 jsCondExprBuild expr' (maybeP ((symbol '?' *> asgn) <~> (symbol ':' *> asgn)))+ expr' :: Parser JSExpr'+ expr' = precedence+ [ Prefix [ operator "--" $> jsDec, operator "++" $> jsInc+ , operator "-" $> jsNeg, operator "+" $> jsPlus+ , operator "~" $> jsBitNeg, operator "!" $> jsNot ]+ , Postfix [ operator "--" $> jsDec, operator "++" $> jsInc ]+ , InfixL [ operator "*" $> JSMul, operator "/" $> JSDiv+ , operator "%" $> JSMod ]+ , InfixL [ operator "+" $> JSAdd, operator "-" $> JSSub ]+ , InfixL [ operator "<<" $> JSShl, operator ">>" $> JSShr ]+ , InfixL [ operator "<=" $> JSLe, operator "<" $> JSLt+ , operator ">=" $> JSGe, operator ">" $> JSGt ]+ , InfixL [ operator "==" $> JSEq, operator "!=" $> JSNe ]+ , InfixL [ try (operator "&") $> JSBitAnd ]+ , InfixL [ operator "^" $> JSBitXor ]+ , InfixL [ try (operator "|") $> JSBitOr ]+ , InfixL [ operator "&&" $> JSAnd ]+ , InfixL [ operator "||" $> JSOr ]+ ]+ (JSUnary <$> memOrCon)+ memOrCon :: Parser JSUnary+ memOrCon = keyword "delete" *> (JSDel <$> member)+ <|> keyword "new" *> (JSCons <$> con)+ <|> JSMember <$> member+ con :: Parser JSCons+ con = liftA2 JSQual (keyword "this" $> "this") (dot *> conCall) <|> conCall+ conCall :: Parser JSCons+ conCall = identifier <**>+ (dot *> (flip JSQual <$> conCall)+ <|> flip JSConCall <$> parens (commaSep asgn)+ <|> pure (\name -> JSConCall name []))+ member :: Parser JSMember+ member = primaryExpr <**>+ (flip JSCall <$> parens (commaSep asgn)+ <|> flip JSIndex <$> brackets expr+ <|> dot *> ((flip JSAccess) <$> member)+ <|> pure JSPrimExp)+ primaryExpr :: Parser JSAtom+ primaryExpr = JSParens <$> parens expr+ <|> JSArray <$> brackets (commaSep asgn)+ <|> JSId <$> identifier+ <|> either JSInt JSFloat <$> naturalOrFloat+ <|> JSString <$> stringLiteral+ <|> JSTrue <$ keyword "true"+ <|> JSFalse <$ keyword "false"+ <|> JSNull <$ keyword "null"+ <|> JSThis <$ keyword "this"++ -- Token Parsers+ space :: Parser ()+ space = void (satisfy isSpace)+ whitespace :: Parser ()+ whitespace = skipMany (spaces <|> oneLineComment <|> multiLineComment)+ keyword :: String -> Parser ()+ keyword s = try (string s *> notIdentLetter) *> whitespace+ operator :: String -> Parser ()+ operator op = try (string op *> notOpLetter) *> whitespace+ identifier :: Parser String+ identifier = try ((identStart <:> many identLetter) >?> jsUnreservedName) <* whitespace+ naturalOrFloat :: Parser (Either Int Double)+ naturalOrFloat = natFloat <* whitespace++ -- Nonsense to deal with floats and ints+ natFloat :: Parser (Either Int Double)+ natFloat = char '0' *> zeroNumFloat <|> decimalFloat++ zeroNumFloat :: Parser (Either Int Double)+ zeroNumFloat = Left <$> (hexadecimal <|> octal)+ <|> decimalFloat+ <|> (fromMaybeP (fractFloat <*> pure 0) empty)+ <|> pure (Left 0)++ decimalFloat :: Parser (Either Int Double)+ decimalFloat = fromMaybeP (decimal <**> (option (Just . Left) fractFloat)) empty++ fractFloat :: Parser (Int -> Maybe (Either Int Double))+ fractFloat = f <$> fractExponent+ where+ f g x = fmap Right (g x)++ fractExponent :: Parser (Int -> Maybe Double)+ fractExponent = f <$> fraction <*> option "" exponent'+ <|> f <$> pure "" <*> exponent'+ where+ f fract exp n = readMaybe (show n ++ fract ++ exp)++ fraction :: Parser [Char]+ fraction = char '.' <:> some (oneOf ['0'..'9'])++ exponent' :: Parser [Char]+ exponent' = ('e' :) <$> (oneOf "eE"+ *> ((((:) <$> oneOf "+-") <|> pure id)+ <*> (show <$> decimal)))++ decimal :: Parser Int+ decimal = number 10 (oneOf ['0'..'9'])+ hexadecimal = oneOf "xX" *> number 16 (oneOf (['a'..'f'] ++ ['A'..'F'] ++ ['0'..'9']))+ octal = oneOf "oO" *> number 8 (oneOf ['0'..'7'])++ number :: Int -> Parser Char -> Parser Int+ number base = pfoldl1 (\x d -> base * x + digitToInt d) 0++ stringLiteral :: Parser String+ stringLiteral = catMaybes <$> between (token "\"") (token "\"") (many stringChar) <* whitespace+ symbol :: Char -> Parser Char+ symbol c = try (char c) <* whitespace+ parens :: Parser a -> Parser a+ parens = between (symbol '(') (symbol ')')+ brackets :: Parser a -> Parser a+ brackets = between (symbol '[') (symbol ']')+ braces :: Parser a -> Parser a+ braces = between (symbol '{') (symbol '}')+ dot :: Parser Char+ dot = symbol '.'+ semi :: Parser Char+ semi = symbol ';'+ comma :: Parser Char+ comma = symbol ','+ commaSep :: Parser a -> Parser [a]+ commaSep p = sepBy p comma+ commaSep1 :: Parser a -> Parser [a]+ commaSep1 p = sepBy1 p comma++ -- Let bindings+ spaces :: Parser ()+ spaces = skipSome space++ oneLineComment :: Parser ()+ oneLineComment = void (token "//" *> skipMany (satisfy (/= '\n')))++ multiLineComment :: Parser ()+ multiLineComment =+ let inComment = void (token "*/")+ <|> skipSome (satisfy (/= '*')) *> inComment+ <|> char '*' *> inComment+ in token "/*" *> inComment++ identStart = satisfy jsIdentStart+ identLetter = satisfy jsIdentLetter+ notIdentLetter = peekChar >?> (maybe True (not . jsIdentLetter))+ notOpLetter = peekChar >?> (maybe True (notInClass "+-*/=<>!~&|.%^"))++ escChrs :: [Char]+ escChrs = "abfntv\\\"'0123456789xo^ABCDEFGHLNRSUV"++ stringChar :: Parser (Maybe Char)+ stringChar = Just <$> satisfy jsStringLetter <|> stringEscape++ stringEscape :: Parser (Maybe Char)+ stringEscape = token "\\" *> (token "&" $> Nothing+ <|> spaces *> token "\\" $> Nothing+ <|> Just <$> escapeCode)++ escapeCode :: Parser Char+ escapeCode = match escChrs (oneOf escChrs) escCode empty+ where+ escCode 'a' = pure ('\a')+ escCode 'b' = pure ('\b')+ escCode 'f' = pure ('\f')+ escCode 'n' = pure ('\n')+ escCode 't' = pure ('\t')+ escCode 'v' = pure ('\v')+ escCode '\\' = pure ('\\')+ escCode '"' = pure ('"')+ escCode '\'' = pure ('\'')+ escCode '^' = (\c -> toEnum (fromEnum c - fromEnum 'A' + 1)) <$> satisfy isUpper+ escCode 'A' = token "CK" $> ('\ACK')+ escCode 'B' = token "S" $> ('\BS') <|> token "EL" $> ('\BEL')+ escCode 'C' = token "R" $> ('\CR') <|> token "AN" $> ('\CAN')+ escCode 'D' = token "C" *> (token "1" $> ('\DC1')+ <|> token "2" $> ('\DC2')+ <|> token "3" $> ('\DC3')+ <|> token "4" $> ('\DC4'))+ <|> token "EL" $> ('\DEL')+ <|> token "LE" $> ('\DLE')+ escCode 'E' = token "M" $> ('\EM')+ <|> token "T" *> (token "X" $> ('\ETX')+ <|> token "B" $> ('\ETB'))+ <|> token "SC" $> ('\ESC')+ <|> token "OT" $> ('\EOT')+ <|> token "NQ" $> ('\ENQ')+ escCode 'F' = token "F" $> ('\FF') <|> token "S" $> ('\FS')+ escCode 'G' = token "S" $> ('\GS')+ escCode 'H' = token "T" $> ('\HT')+ escCode 'L' = token "F" $> ('\LF')+ escCode 'N' = token "UL" $> ('\NUL') <|> token "AK" $> ('\NAK')+ escCode 'R' = token "S" $> ('\RS')+ escCode 'S' = token "O" *> option (('\SO')) (token "H" $> ('\SOH'))+ <|> token "I" $> ('\SI')+ <|> token "P" $> ('\SP')+ <|> token "TX" $> ('\STX')+ <|> token "YN" $> ('\SYN')+ <|> token "UB" $> ('\SUB')+ escCode 'U' = token "S" $> ('\US')+ escCode 'V' = token "T" $> ('\VT')+ -- TODO numeric+ escCode _ = empty--error "numeric escape codes not supported"
+ benchmarks/JavascriptBench/Happy/Parser.y view
@@ -0,0 +1,466 @@+{+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+module JavascriptBench.Happy.Parser where+import JavascriptBench.Shared+import Control.Monad.Reader+import Control.Applicative+import Data.Char (isSpace, isAlpha, isDigit, isAlphaNum, isUpper, isHexDigit, isOctDigit)+import Data.Maybe (fromMaybe)+import Data.List (span)+import Text.Read (readMaybe)+}++%name javascript Program+%lexer { lexer } { Eof }+%tokentype { Token }+%error { failParse }+%monad { Parser }++%token+ number { TokenNumber $$ }+ id { TokenId $$ }+ true { TokenTrue }+ false { TokenFalse }+ if { TokenIf }+ else { TokenElse }+ for { TokenFor }+ while { TokenWhile }+ with { TokenWith }+ break { TokenBreak }+ continue { TokenContinue }+ function { TokenFunction }+ var { TokenVar }+ new { TokenNew }+ delete { TokenDelete }+ this { TokenThis }+ null { TokenNull }+ return { TokenReturn }+ in { TokenIn }+ '=' { TokenAss }+ ':' { TokenColon }+ '?' { TokenQuest }+ '--' { TokenDec }+ '++' { TokenInc }+ '+' { TokenAdd }+ '-' { TokenSub }+ '!' { TokenNot }+ '~' { TokenNeg }+ '*' { TokenMul }+ '/' { TokenDiv }+ '%' { TokenMod }+ '<<' { TokenShl }+ '>>' { TokenShr }+ '<=' { TokenLeq }+ '<' { TokenLt }+ '>=' { TokenGeq }+ '>' { TokenGt }+ '==' { TokenEq }+ '!=' { TokenNeq }+ '&' { TokenBAnd }+ '|' { TokenBOr }+ '^' { TokenXor }+ '&&' { TokenAnd }+ '||' { TokenOr }+ string { TokenString $$ }+ '(' { TokenLParen }+ ')' { TokenRParen }+ '[' { TokenLBracket }+ ']' { TokenRBracket }+ '{' { TokenLBrace }+ '}' { TokenRBrace }+ '.' { TokenDot }+ ';' { TokenSemi }+ ',' { TokenComma }+%%++Program :: { JSProgram }+Program : Element Program { $1 : $2 }+ | { [] }++Element :: { JSElement }+Element : function id '(' Params ')' Compound { JSFunction $2 $4 $6 }+ | Stmt { JSStm $1 }++Params :: { [String] }+Params : id ',' Params { $1 : $3 }+ | id { [$1] }+ | { [] }++Compound :: { JSCompoundStm }+Compound : '{' Compound_ '}' { $2 }++Compound_ :: { [JSStm] }+Compound_ : Stmt Compound_ { $1 : $2 }+ | { [] }++Stmt :: { JSStm }+Stmt : ';' { JSSemi }+ | if '(' Expr ')' Stmt Else { JSIf $3 $5 $6 }+ | while '(' Expr ')' Stmt { JSWhile $3 $5 }+ | for '(' VarsOrExprs in Expr ')' Stmt { JSForIn $3 $5 $7 }+ | for '(' OptVarsOrExprs ';' OptExpr ';' OptExpr ')' Stmt { JSFor $3 $5 $7 $9}+ | break { JSBreak }+ | continue { JSContinue }+ | with '(' Expr ')' Stmt { JSWith $3 $5 }+ | return OptExpr { JSReturn $2 }+ | Compound { JSBlock $1 }+ | VarsOrExprs { JSNaked $1 }++Else :: { Maybe JSStm }+Else : else Stmt { Just $2 }+ | { Nothing }++OptExpr :: { Maybe JSExpr }+OptExpr : Expr { Just $1 }+ | { Nothing }++OptVarsOrExprs :: { Maybe (Either [JSVar] JSExpr) }+OptVarsOrExprs : VarsOrExprs { Just $1 }+ | { Nothing }++VarsOrExprs :: { Either [JSVar] JSExpr }+VarsOrExprs : var Vars { Left $2 }+ | Expr { Right $1 }++Vars :: { [JSVar] }+Vars : Variable ',' Vars { $1 : $3 }+ | Variable { [$1] }++Variable :: { JSVar }+Variable : id '=' Asgn { JSVar $1 (Just $3) }+ | id { JSVar $1 Nothing }++Expr :: { JSExpr }+Expr : Asgn ',' Expr { $1 : $3 }+ | Asgn { [$1] }++Asgn :: { JSExpr' }+Asgn : Asgn '=' CondExpr { JSAsgn $1 $3 }+ | CondExpr { $1 }++CondExpr :: { JSExpr' }+CondExpr : OrExpr Ternary { jsCondExprBuild $1 $2 }++Ternary :: { Maybe (JSExpr', JSExpr') }+Ternary : '?' Asgn ':' Asgn { Just ($2, $4) }+ | { Nothing }++-- Expressions+OrExpr :: { JSExpr' }+OrExpr : OrExpr '||' AndExpr { JSOr $1 $3 } | AndExpr { $1 }+AndExpr : AndExpr '&&' BitOrExpr { JSAnd $1 $3 } | BitOrExpr { $1 }+BitOrExpr : BitOrExpr '|' BitXorExpr { JSBitOr $1 $3 } | BitXorExpr { $1 }+BitXorExpr : BitXorExpr '^' BitAndExpr { JSBitXor $1 $3 } | BitAndExpr { $1 }+BitAndExpr : BitAndExpr '&' EqExpr { JSBitAnd $1 $3 } | EqExpr { $1 }+EqExpr : EqExpr '==' CompExpr { JSEq $1 $3 }+ | EqExpr '!=' CompExpr { JSNe $1 $3 }+ | CompExpr { $1 }+CompExpr : CompExpr '<=' ShiftExpr { JSLe $1 $3 }+ | CompExpr '<' ShiftExpr { JSLt $1 $3 }+ | CompExpr '>=' ShiftExpr { JSGe $1 $3 }+ | CompExpr '>' ShiftExpr { JSGt $1 $3 }+ | ShiftExpr { $1 }+ShiftExpr : ShiftExpr '<<' WeakArithExpr { JSShl $1 $3 }+ | ShiftExpr '>>' WeakArithExpr { JSShr $1 $3 }+ | WeakArithExpr { $1 }+WeakArithExpr : WeakArithExpr '+' StrongArithExpr { JSAdd $1 $3 }+ | WeakArithExpr '-' StrongArithExpr { JSSub $1 $3 }+ | StrongArithExpr { $1 }+StrongArithExpr : StrongArithExpr '*' Postfixes { JSMul $1 $3 }+ | StrongArithExpr '/' Postfixes { JSDiv $1 $3 }+ | StrongArithExpr '%' Postfixes { JSMod $1 $3 }+ | Postfixes { $1 }+Postfixes : Postfixes '--' { jsDec $1 }+ | Postfixes '++' { jsInc $1 }+ | Prefixes { $1 }+Prefixes : '--' Prefixes { jsDec $2 }+ | '++' Prefixes { jsInc $2 }+ | '-' Prefixes { jsNeg $2 }+ | '+' Prefixes { jsPlus $2 }+ | '~' Prefixes { jsBitNeg $2 }+ | '!' Prefixes { jsNot $2 }+ | MemOrCon { JSUnary $1 }++MemOrCon :: { JSUnary }+MemOrCon : delete Member { JSDel $2 }+ | new Con { JSCons $2 }+ | Member { JSMember $1 }++Con :: { JSCons }+Con : this '.' ConCall { JSQual "this" $3 }+ | ConCall { $1 }++ConCall :: { JSCons }+ConCall : id ConCall_ { $2 $1 }++ConCall_ :: { String -> JSCons }+ConCall_ : '.' ConCall { flip JSQual $2 }+ | '(' CommaAsgn ')' { flip JSConCall $2 }+ | { flip JSConCall [] }++CommaAsgn :: { [JSExpr'] }+CommaAsgn : Expr { $1 }+ | { [] }++Member :: { JSMember }+Member : PrimaryExpr Member_ { $2 $1 }++Member_ :: { JSAtom -> JSMember }+Member_ : '(' CommaAsgn ')' { flip JSCall $2 }+ | '[' Expr ']' { flip JSIndex $2 }+ | '.' Member { flip JSAccess $2 }+ | { JSPrimExp }++PrimaryExpr :: { JSAtom }+PrimaryExpr : '(' Expr ')' { JSParens $2 }+ | '[' CommaAsgn ']' { JSArray $2 }+ | id { JSId $1 }+ | number { either JSInt JSFloat $1 }+ | string { JSString $1 }+ | true { JSTrue }+ | false { JSFalse }+ | null { JSNull }+ | this { JSThis }++{+data Token = TokenNumber (Either Int Double)+ | TokenId String+ | TokenTrue+ | TokenFalse+ | TokenIf+ | TokenElse+ | TokenFor+ | TokenWhile+ | TokenWith+ | TokenBreak+ | TokenContinue+ | TokenFunction+ | TokenVar+ | TokenNew+ | TokenDelete+ | TokenThis+ | TokenNull+ | TokenReturn+ | TokenIn+ | TokenAss+ | TokenColon+ | TokenQuest+ | TokenDec+ | TokenInc+ | TokenAdd+ | TokenSub+ | TokenNot+ | TokenNeg+ | TokenMul+ | TokenDiv+ | TokenMod+ | TokenShl+ | TokenShr+ | TokenLeq+ | TokenLt+ | TokenGeq+ | TokenGt+ | TokenEq+ | TokenNeq+ | TokenBAnd+ | TokenBOr+ | TokenXor+ | TokenAnd+ | TokenOr+ | TokenString String+ | TokenLParen+ | TokenRParen+ | TokenLBracket+ | TokenRBracket+ | TokenLBrace+ | TokenRBrace+ | TokenDot+ | TokenSemi+ | TokenComma+ | Eof++newtype Parser a = Parser (ReaderT String Maybe a)+ deriving (Functor, Applicative, Alternative, Monad, MonadReader String)++failParse :: Token -> Parser a+failParse _ = Parser empty++runParser :: Parser a -> String -> Maybe a+runParser (Parser p) = runReaderT p++lexer :: (Token -> Parser a) -> Parser a+lexer k = do+ input <- ask+ case whiteSpace input of+ [] -> k Eof+ c:cs -> nextToken c cs (\t input -> local (const input) (k t))+ where+ nextToken :: Char -> String -> (Token -> String -> Parser a) -> Parser a+ nextToken ';' cs k = k TokenSemi cs+ nextToken ':' cs k = k TokenColon cs+ nextToken '.' cs k = k TokenDot cs+ nextToken ',' cs k = k TokenComma cs+ nextToken '?' cs k = k TokenQuest cs+ nextToken '(' cs k = k TokenLParen cs+ nextToken ')' cs k = k TokenRParen cs+ nextToken '[' cs k = k TokenLBracket cs+ nextToken ']' cs k = k TokenRBracket cs+ nextToken '{' cs k = k TokenLBrace cs+ nextToken '}' cs k = k TokenRBrace cs+ nextToken '*' cs k = k TokenMul cs+ nextToken '/' cs k = k TokenDiv cs+ nextToken '%' cs k = k TokenMod cs+ nextToken '~' cs k = k TokenNeg cs+ nextToken '!' ('=':cs) k = k TokenNeq cs+ nextToken '!' cs k = k TokenNot cs+ nextToken '=' ('=':cs) k = k TokenEq cs+ nextToken '=' cs k = k TokenAss cs+ nextToken '&' ('&':cs) k = k TokenAnd cs+ nextToken '&' cs k = k TokenBAnd cs+ nextToken '|' ('|':cs) k = k TokenOr cs+ nextToken '|' cs k = k TokenBOr cs+ nextToken '^' cs k = k TokenXor cs+ nextToken '<' ('<':cs) k = k TokenShl cs+ nextToken '<' ('=':cs) k = k TokenLeq cs+ nextToken '<' cs k = k TokenLt cs+ nextToken '>' ('>':cs) k = k TokenShr cs+ nextToken '>' ('=':cs) k = k TokenGeq cs+ nextToken '>' cs k = k TokenGt cs+ nextToken '-' ('-':cs) k = k TokenDec cs+ nextToken '-' cs k = k TokenSub cs+ nextToken '+' ('+':cs) k = k TokenInc cs+ nextToken '+' cs k = k TokenAdd cs+ nextToken '"' cs k = stringLit cs (k . TokenString)+ nextToken c cs k | isDigit c = numLit c cs (k . TokenNumber)+ nextToken 'b' ('r':'e':'a':'k':cs) k | noIdLetter cs = k TokenBreak cs+ nextToken 'c' ('o':'n':'t':'i':'n':'u':'e':cs) k | noIdLetter cs = k TokenContinue cs+ nextToken 'd' ('e':'l':'e':'t':'e':cs) k | noIdLetter cs = k TokenDelete cs+ nextToken 'e' ('l':'s':'e':cs) k | noIdLetter cs = k TokenElse cs+ nextToken 'f' ('a':'l':'s':'e':cs) k | noIdLetter cs = k TokenFalse cs+ nextToken 'f' ('o':'r':cs) k | noIdLetter cs = k TokenFor cs+ nextToken 'f' ('u':'n':'c':'t':'i':'o':'n':cs) k | noIdLetter cs = k TokenFunction cs+ nextToken 'i' ('f':cs) k | noIdLetter cs = k TokenIf cs+ nextToken 'i' ('n':cs) k | noIdLetter cs = k TokenIn cs+ nextToken 'n' ('e':'w':cs) k | noIdLetter cs = k TokenNew cs+ nextToken 'n' ('u':'l':'l':cs) k | noIdLetter cs = k TokenNull cs+ nextToken 'r' ('e':'t':'u':'r':'n':cs) k | noIdLetter cs = k TokenReturn cs+ nextToken 't' ('h':'i':'s':cs) k | noIdLetter cs = k TokenThis cs+ nextToken 't' ('r':'u':'e':cs) k | noIdLetter cs = k TokenTrue cs+ nextToken 'v' ('a':'r':cs) k | noIdLetter cs = k TokenVar cs+ nextToken 'w' ('h':'i':'l':'e':cs) k | noIdLetter cs = k TokenWhile cs+ nextToken 'w' ('i':'t':'h':cs) k | noIdLetter cs = k TokenWith cs+ nextToken c cs k | idLetter c = let (ident, rest) = span idLetter cs in k (TokenId (c:ident)) rest+ nextToken c cs k = empty++ idLetter :: Char -> Bool+ idLetter '_' = True+ idLetter c = isAlphaNum c++ noIdLetter :: String -> Bool+ noIdLetter (c:_) | idLetter c = False+ noIdLetter _ = True++ numLit :: Char -> String -> (Either Int Double -> String -> Parser a) -> Parser a+ numLit '0' = zeroNumFloat+ numLit d = (fromMaybe empty .) . decimalFloat . (d :)++ zeroNumFloat :: String -> (Either Int Double -> String -> Parser a) -> Parser a+ zeroNumFloat ('x':cs) k = hexadecimal cs (k . Left)+ zeroNumFloat ('X':cs) k = hexadecimal cs (k . Left)+ zeroNumFloat ('o':cs) k = octal cs (k . Left)+ zeroNumFloat ('O':cs) k = octal cs (k . Left)+ zeroNumFloat cs k = fromMaybe (k (Left 0) cs) (fractFloat 0 cs k <|> decimalFloat cs k)++ decimalFloat :: String -> (Either Int Double -> String -> Parser a) -> Maybe (Parser a)+ decimalFloat (d:cs) k | isDigit d = return (decimal (d:cs) (\x cs -> fromMaybe (k (Left x) cs) (fractFloat x cs k)))+ decimalFloat _ _ = empty++ fractFloat :: Int -> String -> (Either Int Double -> String -> Parser a) -> Maybe (Parser a)+ fractFloat x ('.':cs) = fractExpMaker ('.':) x cs+ fractFloat x ('e':cs) = exponent x cs+ fractFloat x ('E':cs) = exponent x cs+ fractFloat x cs = return Nothing++ exponent :: Int -> String -> (Either Int Double -> String -> Parser a) -> Maybe (Parser a)+ exponent x ('+':cs) = fractExpMaker ('e':) x cs+ exponent x ('-':cs) = fractExpMaker (('e':) . ('-':)) x cs+ exponent x cs = fractExpMaker ('e':) x cs++ fractExpMaker :: (String -> String) -> Int -> String -> (Either Int Double -> String -> Parser a) -> Maybe (Parser a)+ fractExpMaker conv x cs k = let (y, rest) = span isDigit cs in fmap (flip k rest . Right) (readMaybe (show x ++ conv y))++ number :: (Char -> Bool) -> (String -> String) -> String -> (Int -> String -> Parser a) -> Parser a+ number digit conv cs k = let (x, rest) = span digit cs in maybe empty (flip k rest) (readMaybe (conv x))+ decimal = number isDigit id+ hexadecimal = number isHexDigit ("0x" ++)+ octal = number isOctDigit ("0o" ++)++ stringLit :: String -> (String -> String -> Parser a) -> Parser a+ stringLit = go id+ where+ go :: (String -> String) -> String -> (String -> String -> Parser a) -> Parser a+ go acc ('\\':cs) k = escape cs (\c cs -> go (acc . (c:)) cs k)+ go acc ('"':cs) k = k (acc []) cs+ go acc (c:cs) k = go (acc . (c:)) cs k+ go acc _ k = empty++ escape :: String -> (Char -> String -> Parser a) -> Parser a+ escape ('a':cs) k = k '\a' cs+ escape ('b':cs) k = k '\b' cs+ escape ('f':cs) k = k '\f' cs+ escape ('n':cs) k = k '\n' cs+ escape ('t':cs) k = k '\t' cs+ escape ('v':cs) k = k '\v' cs+ escape ('\\':cs) k = k '\\' cs+ escape ('"':cs) k = k '"' cs+ escape ('\'':cs) k = k '\'' cs+ escape ('^':c:cs) k | isUpper c = k (toEnum (fromEnum c - fromEnum 'A' + 1)) cs+ escape ('A':'C':'K':cs) k = k '\ACK' cs+ escape ('B':'S':cs) k = k '\BS' cs+ escape ('B':'E':'L':cs) k = k '\BEL' cs+ escape ('C':'R':cs) k = k '\CR' cs+ escape ('C':'A':'N':cs) k = k '\CAN' cs+ escape ('D':'C':'1':cs) k = k '\DC1' cs+ escape ('D':'C':'2':cs) k = k '\DC2' cs+ escape ('D':'C':'3':cs) k = k '\DC3' cs+ escape ('D':'C':'4':cs) k = k '\DC4' cs+ escape ('D':'E':'L':cs) k = k '\DEL' cs+ escape ('D':'L':'E':cs) k = k '\DLE' cs+ escape ('E':'M':cs) k = k '\EM' cs+ escape ('E':'T':'X':cs) k = k '\ETX' cs+ escape ('E':'T':'B':cs) k = k '\ETB' cs+ escape ('E':'S':'C':cs) k = k '\ESC' cs+ escape ('E':'O':'T':cs) k = k '\EOT' cs+ escape ('E':'N':'Q':cs) k = k '\ENQ' cs+ escape ('F':'F':cs) k = k '\FF' cs+ escape ('F':'S':cs) k = k '\FS' cs+ escape ('G':'S':cs) k = k '\GS' cs+ escape ('H':'T':cs) k = k '\HT' cs+ escape ('L':'F':cs) k = k '\LF' cs+ escape ('N':'U':'L':cs) k = k '\NUL' cs+ escape ('N':'A':'K':cs) k = k '\NAK' cs+ escape ('R':'S':cs) k = k '\RS' cs+ escape ('S':'O':'H':cs) k = k '\SOH' cs+ escape ('S':'O':cs) k = k '\SO' cs+ escape ('S':'I':cs) k = k '\SI' cs+ escape ('S':'P':cs) k = k '\SP' cs+ escape ('S':'T':'X':cs) k = k '\STX' cs+ escape ('S':'Y':'N':cs) k = k '\SYN' cs+ escape ('S':'U':'B':cs) k = k '\SUB' cs+ escape ('U':'S':cs) k = k '\US' cs+ escape ('V':'T':cs) k = k '\VT' cs+ escape _ _ = empty++ whiteSpace :: String -> String+ whiteSpace (c:cs) | isSpace c = whiteSpace cs+ whiteSpace ('/':'*':cs) = multiLineComment cs+ whiteSpace ('/':'/':cs) = singleLineComment cs+ whiteSpace cs = cs+ singleLineComment :: String -> String+ singleLineComment = whiteSpace . dropWhile (/= '\n')+ multiLineComment :: String -> String+ multiLineComment ('*':'/':cs) = whiteSpace cs+ multiLineComment (_:cs) = multiLineComment cs+ multiLineComment [] = empty++}
+ benchmarks/JavascriptBench/Main.hs view
@@ -0,0 +1,63 @@+{-# LANGUAGE TemplateHaskell,+ ScopedTypeVariables,+ StandaloneDeriving,+ DeriveAnyClass,+ DeriveGeneric,+ TypeFamilies,+ UnboxedTuples,+ TypeApplications #-}+module Main where+import Criterion.Main (Benchmark, bgroup, defaultMain)+import Control.DeepSeq (NFData)+import GHC.Generics (Generic)+import Data.Text (Text)+--import Parsley.Internal.Verbose ()+import qualified JavascriptBench.Parsley.Parser+import qualified JavascriptBench.Parsec.Parser+import qualified JavascriptBench.Megaparsec.Parser+import qualified JavascriptBench.Attoparsec.Parser+import qualified JavascriptBench.Happy.Parser+import qualified Parsley+import JavascriptBench.Shared+import Shared.BenchmarkUtils++main :: IO ()+main = defaultMain [javascript]++deriving instance Generic JSElement+deriving instance Generic JSStm+deriving instance Generic JSVar+deriving instance Generic JSExpr'+deriving instance Generic JSUnary+deriving instance Generic JSMember+deriving instance Generic JSCons+deriving instance Generic JSAtom+deriving instance NFData JSElement+deriving instance NFData JSStm+deriving instance NFData JSVar+deriving instance NFData JSExpr'+deriving instance NFData JSUnary+deriving instance NFData JSMember+deriving instance NFData JSCons+deriving instance NFData JSAtom++javascriptParsleyS :: String -> Maybe JSProgram+javascriptParsleyS = $$(Parsley.runParser JavascriptBench.Parsley.Parser.javascript)++javascriptParsleyT :: Text -> Maybe JSProgram+javascriptParsleyT = $$(Parsley.runParser JavascriptBench.Parsley.Parser.javascript)++javascript :: Benchmark+javascript =+ let jsTest :: NFData rep => (FilePath -> IO rep) -> String -> (rep -> Maybe JSProgram) -> Benchmark+ jsTest = benchmark ["benchmarks/inputs/fibonacci.js", "benchmarks/inputs/heapsort.js", "benchmarks/inputs/game.js", "benchmarks/inputs/big.js"]+ in bgroup "Javascript"+ [ jsTest text "Parsley (Text)" javascriptParsleyT+ , jsTest string "Parsley (String)" javascriptParsleyS+ , jsTest text "Atto" (attoParse JavascriptBench.Attoparsec.Parser.javascript)+ , jsTest string "Happy" (JavascriptBench.Happy.Parser.runParser JavascriptBench.Happy.Parser.javascript)+ , jsTest string "Parsec (String)" (parsecParse JavascriptBench.Parsec.Parser.javascript)+ , jsTest text "Parsec (Text)" (parsecParse JavascriptBench.Parsec.Parser.javascript)+ , jsTest string "Mega (String)" (megaParse JavascriptBench.Megaparsec.Parser.javascript)+ , jsTest text "Mega (Text)" (megaParse JavascriptBench.Megaparsec.Parser.javascript)+ ]
+ benchmarks/JavascriptBench/Megaparsec/Parser.hs view
@@ -0,0 +1,244 @@+{-# LANGUAGE TypeFamilies+ , ScopedTypeVariables #-}++module JavascriptBench.Megaparsec.Parser where+import JavascriptBench.Shared+import Shared.Megaparsec.Extended+import Data.Char (isSpace, isUpper, digitToInt)+import Data.Maybe (catMaybes)+import Text.Read (readMaybe)++javascript :: forall s. (Stream s, Token s ~ Char) => Parser s JSProgram+javascript = whitespace *> many element <* eof+ where+ element :: Parser s JSElement+ element = keyword "function" *> liftA3 JSFunction identifier (parens (commaSep identifier)) compound+ <|> JSStm <$> stmt+ compound :: Parser s JSCompoundStm+ compound = braces (many stmt)+ stmt :: Parser s JSStm+ stmt = semi $> JSSemi+ <|> keyword "if" *> liftA3 JSIf parensExpr stmt (maybeP (keyword "else" *> stmt))+ <|> keyword "while" *> liftA2 JSWhile parensExpr stmt+ <|> (keyword "for" *> parens+ (try (liftA2 JSForIn varsOrExprs (keyword "in" *> expr))+ <|> liftA3 JSFor (maybeP varsOrExprs <* semi) (optExpr <* semi) optExpr)+ <*> stmt)+ <|> keyword "break" $> JSBreak+ <|> keyword "continue" $> JSContinue+ <|> keyword "with" *> liftA2 JSWith parensExpr stmt+ <|> keyword "return" *> (JSReturn <$> optExpr)+ <|> JSBlock <$> compound+ <|> JSNaked <$> varsOrExprs+ varsOrExprs :: Parser s (Either [JSVar] JSExpr)+ varsOrExprs = (keyword "var" *> commaSep1 variable) <+> expr+ variable :: Parser s JSVar+ variable = liftA2 JSVar identifier (maybeP (symbol '=' *> asgn))+ parensExpr :: Parser s JSExpr+ parensExpr = parens expr+ optExpr :: Parser s (Maybe JSExpr)+ optExpr = maybeP expr+ expr :: Parser s JSExpr+ expr = commaSep1 asgn+ asgn :: Parser s JSExpr'+ asgn = chainl1 condExpr (symbol '=' $> JSAsgn)+ condExpr :: Parser s JSExpr'+ condExpr = liftA2 jsCondExprBuild expr' (maybeP ((symbol '?' *> asgn) <~> (symbol ':' *> asgn)))+ expr' :: Parser s JSExpr'+ expr' = precedence+ [ Prefix [ operator "--" $> jsDec, operator "++" $> jsInc+ , operator "-" $> jsNeg, operator "+" $> jsPlus+ , operator "~" $> jsBitNeg, operator "!" $> jsNot ]+ , Postfix [ operator "--" $> jsDec, operator "++" $> jsInc ]+ , InfixL [ operator "*" $> JSMul, operator "/" $> JSDiv+ , operator "%" $> JSMod ]+ , InfixL [ operator "+" $> JSAdd, operator "-" $> JSSub ]+ , InfixL [ operator "<<" $> JSShl, operator ">>" $> JSShr ]+ , InfixL [ operator "<=" $> JSLe, operator "<" $> JSLt+ , operator ">=" $> JSGe, operator ">" $> JSGt ]+ , InfixL [ operator "==" $> JSEq, operator "!=" $> JSNe ]+ , InfixL [ try (operator "&") $> JSBitAnd ]+ , InfixL [ operator "^" $> JSBitXor ]+ , InfixL [ try (operator "|") $> JSBitOr ]+ , InfixL [ operator "&&" $> JSAnd ]+ , InfixL [ operator "||" $> JSOr ]+ ]+ (JSUnary <$> memOrCon)+ memOrCon :: Parser s JSUnary+ memOrCon = keyword "delete" *> (JSDel <$> member)+ <|> keyword "new" *> (JSCons <$> con)+ <|> JSMember <$> member+ con :: Parser s JSCons+ con = liftA2 JSQual (keyword "this" $> "this") (dot *> conCall) <|> conCall+ conCall :: Parser s JSCons+ conCall = identifier <**>+ (dot *> (flip JSQual <$> conCall)+ <|> flip JSConCall <$> parens (commaSep asgn)+ <|> pure (\name -> JSConCall name []))+ member :: Parser s JSMember+ member = primaryExpr <**>+ (flip JSCall <$> parens (commaSep asgn)+ <|> flip JSIndex <$> brackets expr+ <|> dot *> ((flip JSAccess) <$> member)+ <|> pure JSPrimExp)+ primaryExpr :: Parser s JSAtom+ primaryExpr = JSParens <$> parens expr+ <|> JSArray <$> brackets (commaSep asgn)+ <|> JSId <$> identifier+ <|> either JSInt JSFloat <$> naturalOrFloat+ <|> JSString <$> stringLiteral+ <|> JSTrue <$ keyword "true"+ <|> JSFalse <$ keyword "false"+ <|> JSNull <$ keyword "null"+ <|> JSThis <$ keyword "this"++ -- Token Parsers+ space :: Parser s ()+ space = void (satisfy isSpace)+ whitespace :: Parser s ()+ whitespace = skipMany (spaces <|> oneLineComment <|> multiLineComment)+ keyword :: String -> Parser s ()+ keyword s = try (string s *> notIdentLetter) *> whitespace+ operator :: String -> Parser s ()+ operator op = try (string op *> notOpLetter) *> whitespace+ identifier :: Parser s String+ identifier = try ((identStart <:> many identLetter) >?> jsUnreservedName) <* whitespace+ naturalOrFloat :: Parser s (Either Int Double)+ naturalOrFloat = natFloat <* whitespace++ -- Nonsense to deal with floats and ints+ natFloat :: Parser s (Either Int Double)+ natFloat = char '0' *> zeroNumFloat <|> decimalFloat++ zeroNumFloat :: Parser s (Either Int Double)+ zeroNumFloat = Left <$> (hexadecimal <|> octal)+ <|> decimalFloat+ <|> (fromMaybeP (fractFloat <*> pure 0) empty)+ <|> pure (Left 0)++ decimalFloat :: Parser s (Either Int Double)+ decimalFloat = fromMaybeP (decimal <**> (option (Just . Left) fractFloat)) empty++ fractFloat :: Parser s (Int -> Maybe (Either Int Double))+ fractFloat = f <$> fractExponent+ where+ f g x = fmap Right (g x)++ fractExponent :: Parser s (Int -> Maybe Double)+ fractExponent = f <$> fraction <*> option "" exponent'+ <|> f <$> pure "" <*> exponent'+ where+ f fract exp n = readMaybe (show n ++ fract ++ exp)++ fraction :: Parser s [Char]+ fraction = ('.' :) <$> (char '.'+ *> some (oneOf ['0'..'9']))++ exponent' :: Parser s [Char]+ exponent' = ('e' :) <$> (oneOf "eE"+ *> ((((:) <$> oneOf "+-") <|> pure id)+ <*> (show <$> decimal)))++ decimal :: Parser s Int+ decimal = number 10 (oneOf ['0'..'9'])+ hexadecimal = oneOf "xX" *> number 16 (oneOf (['a'..'f'] ++ ['A'..'F'] ++ ['0'..'9']))+ octal = oneOf "oO" *> number 8 (oneOf ['0'..'7'])++ number :: Int -> Parser s Char -> Parser s Int+ number base = pfoldl1 (\x d -> base * x + digitToInt d) 0++ stringLiteral :: Parser s String+ stringLiteral = catMaybes <$> between (token "\"") (token "\"") (many stringChar) <* whitespace+ symbol :: Char -> Parser s Char+ symbol c = try (char c) <* whitespace+ parens :: Parser s a -> Parser s a+ parens = between (symbol '(') (symbol ')')+ brackets :: Parser s a -> Parser s a+ brackets = between (symbol '[') (symbol ']')+ braces :: Parser s a -> Parser s a+ braces = between (symbol '{') (symbol '}')+ dot :: Parser s Char+ dot = symbol '.'+ semi :: Parser s Char+ semi = symbol ';'+ comma :: Parser s Char+ comma = symbol ','+ commaSep :: Parser s a -> Parser s [a]+ commaSep p = sepBy p comma+ commaSep1 :: Parser s a -> Parser s [a]+ commaSep1 p = sepBy1 p comma++ -- Let bindings+ spaces :: Parser s ()+ spaces = skipSome space++ oneLineComment :: Parser s ()+ oneLineComment = void (token "//" *> skipMany (satisfy (/= '\n')))++ multiLineComment :: Parser s ()+ multiLineComment =+ let inComment = void (token "*/")+ <|> skipSome (noneOf "/*") *> inComment+ <|> oneOf "/*" *> inComment+ in token "/*" *> inComment++ identStart = satisfy jsIdentStart+ identLetter = satisfy jsIdentLetter+ notIdentLetter = notFollowedBy identLetter+ notOpLetter = notFollowedBy (oneOf "+-*/=<>!~&|.%^")++ escChrs :: [Char]+ escChrs = "abfntv\\\"'0123456789xo^ABCDEFGHLNRSUV"++ stringChar :: Parser s (Maybe Char)+ stringChar = Just <$> satisfy jsStringLetter <|> stringEscape++ stringEscape :: Parser s (Maybe Char)+ stringEscape = token "\\" *> (token "&" $> Nothing+ <|> spaces *> token "\\" $> Nothing+ <|> Just <$> escapeCode)++ escapeCode :: Parser s Char+ escapeCode = match escChrs (oneOf escChrs) escCode empty+ where+ escCode 'a' = pure ('\a')+ escCode 'b' = pure ('\b')+ escCode 'f' = pure ('\f')+ escCode 'n' = pure ('\n')+ escCode 't' = pure ('\t')+ escCode 'v' = pure ('\v')+ escCode '\\' = pure ('\\')+ escCode '"' = pure ('"')+ escCode '\'' = pure ('\'')+ escCode '^' = (\c -> toEnum (fromEnum c - fromEnum 'A' + 1)) <$> satisfy isUpper+ escCode 'A' = token "CK" $> ('\ACK')+ escCode 'B' = token "S" $> ('\BS') <|> token "EL" $> ('\BEL')+ escCode 'C' = token "R" $> ('\CR') <|> token "AN" $> ('\CAN')+ escCode 'D' = token "C" *> (token "1" $> ('\DC1')+ <|> token "2" $> ('\DC2')+ <|> token "3" $> ('\DC3')+ <|> token "4" $> ('\DC4'))+ <|> token "EL" $> ('\DEL')+ <|> token "LE" $> ('\DLE')+ escCode 'E' = token "M" $> ('\EM')+ <|> token "T" *> (token "X" $> ('\ETX')+ <|> token "B" $> ('\ETB'))+ <|> token "SC" $> ('\ESC')+ <|> token "OT" $> ('\EOT')+ <|> token "NQ" $> ('\ENQ')+ escCode 'F' = token "F" $> ('\FF') <|> token "S" $> ('\FS')+ escCode 'G' = token "S" $> ('\GS')+ escCode 'H' = token "T" $> ('\HT')+ escCode 'L' = token "F" $> ('\LF')+ escCode 'N' = token "UL" $> ('\NUL') <|> token "AK" $> ('\NAK')+ escCode 'R' = token "S" $> ('\RS')+ escCode 'S' = token "O" *> option (('\SO')) (token "H" $> ('\SOH'))+ <|> token "I" $> ('\SI')+ <|> token "P" $> ('\SP')+ <|> token "TX" $> ('\STX')+ <|> token "YN" $> ('\SYN')+ <|> token "UB" $> ('\SUB')+ escCode 'U' = token "S" $> ('\US')+ escCode 'V' = token "T" $> ('\VT')+ -- TODO numeric+ escCode _ = empty--error "numeric escape codes not supported"
+ benchmarks/JavascriptBench/Parsec/Parser.hs view
@@ -0,0 +1,244 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables #-}+module JavascriptBench.Parsec.Parser where++import Shared.Parsec.Extended+import JavascriptBench.Shared++import Data.Char (isSpace, isUpper, digitToInt)+import Data.Maybe (catMaybes)+import Text.Read (readMaybe)++javascript :: forall s. Stream s Identity Char => Parser s JSProgram+javascript = whitespace *> many element <* eof+ where+ element :: Parser s JSElement+ element = keyword "function" *> liftA3 JSFunction identifier (parens (commaSep identifier)) compound+ <|> JSStm <$> stmt+ compound :: Parser s JSCompoundStm+ compound = braces (many stmt)+ stmt :: Parser s JSStm+ stmt = semi $> JSSemi+ <|> keyword "if" *> liftA3 JSIf parensExpr stmt (maybeP (keyword "else" *> stmt))+ <|> keyword "while" *> liftA2 JSWhile parensExpr stmt+ <|> (keyword "for" *> parens+ (try (liftA2 JSForIn varsOrExprs (keyword "in" *> expr))+ <|> liftA3 JSFor (maybeP varsOrExprs <* semi) (optExpr <* semi) optExpr)+ <*> stmt)+ <|> keyword "break" $> JSBreak+ <|> keyword "continue" $> JSContinue+ <|> keyword "with" *> liftA2 JSWith parensExpr stmt+ <|> keyword "return" *> (JSReturn <$> optExpr)+ <|> JSBlock <$> compound+ <|> JSNaked <$> varsOrExprs+ varsOrExprs :: Parser s (Either [JSVar] JSExpr)+ varsOrExprs = (keyword "var" *> commaSep1 variable) <+> expr+ variable :: Parser s JSVar+ variable = liftA2 JSVar identifier (maybeP (symbol '=' *> asgn))+ parensExpr :: Parser s JSExpr+ parensExpr = parens expr+ optExpr :: Parser s (Maybe JSExpr)+ optExpr = maybeP expr+ expr :: Parser s JSExpr+ expr = commaSep1 asgn+ asgn :: Parser s JSExpr'+ asgn = chainl1 condExpr (symbol '=' $> JSAsgn)+ condExpr :: Parser s JSExpr'+ condExpr = liftA2 jsCondExprBuild expr' (maybeP ((symbol '?' *> asgn) <~> (symbol ':' *> asgn)))+ expr' :: Parser s JSExpr'+ expr' = precedence+ [ Prefix [ operator "--" $> jsDec, operator "++" $> jsInc+ , operator "-" $> jsNeg, operator "+" $> jsPlus+ , operator "~" $> jsBitNeg, operator "!" $> jsNot ]+ , Postfix [ operator "--" $> jsDec, operator "++" $> jsInc ]+ , InfixL [ operator "*" $> JSMul, operator "/" $> JSDiv+ , operator "%" $> JSMod ]+ , InfixL [ operator "+" $> JSAdd, operator "-" $> JSSub ]+ , InfixL [ operator "<<" $> JSShl, operator ">>" $> JSShr ]+ , InfixL [ operator "<=" $> JSLe, operator "<" $> JSLt+ , operator ">=" $> JSGe, operator ">" $> JSGt ]+ , InfixL [ operator "==" $> JSEq, operator "!=" $> JSNe ]+ , InfixL [ try (operator "&") $> JSBitAnd ]+ , InfixL [ operator "^" $> JSBitXor ]+ , InfixL [ try (operator "|") $> JSBitOr ]+ , InfixL [ operator "&&" $> JSAnd ]+ , InfixL [ operator "||" $> JSOr ]+ ]+ (JSUnary <$> memOrCon)+ memOrCon :: Parser s JSUnary+ memOrCon = keyword "delete" *> (JSDel <$> member)+ <|> keyword "new" *> (JSCons <$> con)+ <|> JSMember <$> member+ con :: Parser s JSCons+ con = liftA2 JSQual (keyword "this" $> "this") (dot *> conCall) <|> conCall+ conCall :: Parser s JSCons+ conCall = identifier <**>+ (dot *> (flip JSQual <$> conCall)+ <|> flip JSConCall <$> parens (commaSep asgn)+ <|> pure (\name -> JSConCall name []))+ member :: Parser s JSMember+ member = primaryExpr <**>+ (flip JSCall <$> parens (commaSep asgn)+ <|> flip JSIndex <$> brackets expr+ <|> dot *> ((flip JSAccess) <$> member)+ <|> pure JSPrimExp)+ primaryExpr :: Parser s JSAtom+ primaryExpr = JSParens <$> parens expr+ <|> JSArray <$> brackets (commaSep asgn)+ <|> JSId <$> identifier+ <|> either JSInt JSFloat <$> naturalOrFloat+ <|> JSString <$> stringLiteral+ <|> JSTrue <$ keyword "true"+ <|> JSFalse <$ keyword "false"+ <|> JSNull <$ keyword "null"+ <|> JSThis <$ keyword "this"++ -- Token Parsers+ space :: Parser s ()+ space = void (satisfy isSpace)+ whitespace :: Parser s ()+ whitespace = skipMany (spaces <|> oneLineComment <|> multiLineComment)+ keyword :: String -> Parser s ()+ keyword s = try (string s *> notIdentLetter) *> whitespace+ operator :: String -> Parser s ()+ operator op = try (string op *> notOpLetter) *> whitespace+ identifier :: Parser s String+ identifier = try ((identStart <:> many identLetter) >?> jsUnreservedName) <* whitespace+ naturalOrFloat :: Parser s (Either Int Double)+ naturalOrFloat = natFloat <* whitespace++ -- Nonsense to deal with floats and ints+ natFloat :: Parser s (Either Int Double)+ natFloat = char '0' *> zeroNumFloat <|> decimalFloat++ zeroNumFloat :: Parser s (Either Int Double)+ zeroNumFloat = Left <$> (hexadecimal <|> octal)+ <|> decimalFloat+ <|> (fromMaybeP (fractFloat <*> pure 0) empty)+ <|> pure (Left 0)++ decimalFloat :: Parser s (Either Int Double)+ decimalFloat = fromMaybeP (decimal <**> (option (Just . Left) fractFloat)) empty++ fractFloat :: Parser s (Int -> Maybe (Either Int Double))+ fractFloat = f <$> fractExponent+ where+ f g x = fmap Right (g x)++ fractExponent :: Parser s (Int -> Maybe Double)+ fractExponent = f <$> fraction <*> option "" exponent'+ <|> f <$> pure "" <*> exponent'+ where+ f fract exp n = readMaybe (show n ++ fract ++ exp)++ fraction :: Parser s [Char]+ fraction = char '.' <:> some (oneOf ['0'..'9'])++ exponent' :: Parser s [Char]+ exponent' = ('e' :) <$> (oneOf "eE"+ *> ((((:) <$> oneOf "+-") <|> pure id)+ <*> (show <$> decimal)))++ decimal :: Parser s Int+ decimal = number 10 (oneOf ['0'..'9'])+ hexadecimal = oneOf "xX" *> number 16 (oneOf (['a'..'f'] ++ ['A'..'F'] ++ ['0'..'9']))+ octal = oneOf "oO" *> number 8 (oneOf ['0'..'7'])++ number :: Int -> Parser s Char -> Parser s Int+ number base = pfoldl1 (\x d -> base * x + digitToInt d) 0++ stringLiteral :: Parser s String+ stringLiteral = catMaybes <$> between (token "\"") (token "\"") (many stringChar) <* whitespace+ symbol :: Char -> Parser s Char+ symbol c = try (char c) <* whitespace+ parens :: Parser s a -> Parser s a+ parens = between (symbol '(') (symbol ')')+ brackets :: Parser s a -> Parser s a+ brackets = between (symbol '[') (symbol ']')+ braces :: Parser s a -> Parser s a+ braces = between (symbol '{') (symbol '}')+ dot :: Parser s Char+ dot = symbol '.'+ semi :: Parser s Char+ semi = symbol ';'+ comma :: Parser s Char+ comma = symbol ','+ commaSep :: Parser s a -> Parser s [a]+ commaSep p = sepBy p comma+ commaSep1 :: Parser s a -> Parser s [a]+ commaSep1 p = sepBy1 p comma++ -- Let bindings+ spaces :: Parser s ()+ spaces = skipSome space++ oneLineComment :: Parser s ()+ oneLineComment = void (token "//" *> skipMany (satisfy (/= '\n')))++ multiLineComment :: Parser s ()+ multiLineComment =+ let inComment = void (token "*/")+ <|> skipSome (satisfy (/= '*')) *> inComment+ <|> char '*' *> inComment+ in token "/*" *> inComment++ identStart = satisfy jsIdentStart+ identLetter = satisfy jsIdentLetter+ notIdentLetter = notFollowedBy identLetter+ notOpLetter = notFollowedBy (oneOf "+-*/=<>!~&|.%^")++ escChrs :: [Char]+ escChrs = "abfntv\\\"'0123456789xo^ABCDEFGHLNRSUV"++ stringChar :: Parser s (Maybe Char)+ stringChar = Just <$> satisfy jsStringLetter <|> stringEscape++ stringEscape :: Parser s (Maybe Char)+ stringEscape = token "\\" *> (token "&" $> Nothing+ <|> spaces *> token "\\" $> Nothing+ <|> Just <$> escapeCode)++ escapeCode :: Parser s Char+ escapeCode = match escChrs (oneOf escChrs) escCode empty+ where+ escCode 'a' = pure ('\a')+ escCode 'b' = pure ('\b')+ escCode 'f' = pure ('\f')+ escCode 'n' = pure ('\n')+ escCode 't' = pure ('\t')+ escCode 'v' = pure ('\v')+ escCode '\\' = pure ('\\')+ escCode '"' = pure ('"')+ escCode '\'' = pure ('\'')+ escCode '^' = (\c -> toEnum (fromEnum c - fromEnum 'A' + 1)) <$> satisfy isUpper+ escCode 'A' = token "CK" $> ('\ACK')+ escCode 'B' = token "S" $> ('\BS') <|> token "EL" $> ('\BEL')+ escCode 'C' = token "R" $> ('\CR') <|> token "AN" $> ('\CAN')+ escCode 'D' = token "C" *> (token "1" $> ('\DC1')+ <|> token "2" $> ('\DC2')+ <|> token "3" $> ('\DC3')+ <|> token "4" $> ('\DC4'))+ <|> token "EL" $> ('\DEL')+ <|> token "LE" $> ('\DLE')+ escCode 'E' = token "M" $> ('\EM')+ <|> token "T" *> (token "X" $> ('\ETX')+ <|> token "B" $> ('\ETB'))+ <|> token "SC" $> ('\ESC')+ <|> token "OT" $> ('\EOT')+ <|> token "NQ" $> ('\ENQ')+ escCode 'F' = token "F" $> ('\FF') <|> token "S" $> ('\FS')+ escCode 'G' = token "S" $> ('\GS')+ escCode 'H' = token "T" $> ('\HT')+ escCode 'L' = token "F" $> ('\LF')+ escCode 'N' = token "UL" $> ('\NUL') <|> token "AK" $> ('\NAK')+ escCode 'R' = token "S" $> ('\RS')+ escCode 'S' = token "O" *> option (('\SO')) (token "H" $> ('\SOH'))+ <|> token "I" $> ('\SI')+ <|> token "P" $> ('\SP')+ <|> token "TX" $> ('\STX')+ <|> token "YN" $> ('\SYN')+ <|> token "UB" $> ('\SUB')+ escCode 'U' = token "S" $> ('\US')+ escCode 'V' = token "T" $> ('\VT')+ -- TODO numeric+ escCode _ = empty--error "numeric escape codes not supported"
+ benchmarks/JavascriptBench/Parsley/Parser.hs view
@@ -0,0 +1,263 @@+{-# OPTIONS_GHC -fplugin=Parsley.OverloadedQuotesPlugin #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE DeriveLift #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE PatternSynonyms #-}+module JavascriptBench.Parsley.Parser where++import Prelude hiding (fmap, pure, (<*), (*>), (<*>), (<$>), (<$), pred)+import Parsley+import Parsley.Combinator (token, oneOf, noneOf, eof)+import Parsley.Fold (skipMany, skipSome, sepBy, sepBy1, pfoldl1, chainl1)+import Parsley.Precedence (precedence, monolith, prefix, postfix, infixR, infixL)+import Parsley.Defunctionalized (Defunc(CONS, ID, LIFTED), pattern FLIP_H, pattern COMPOSE_H)+import JavascriptBench.Shared+import Data.Char (isSpace, isUpper, digitToInt, isDigit)+import Data.Maybe (catMaybes)+import Text.Read (readMaybe)+import Control.Monad (liftM)+import Language.Haskell.TH.Syntax (Lift(..))++deriving instance Lift JSElement+deriving instance Lift JSStm+deriving instance Lift JSVar+deriving instance Lift JSExpr'+deriving instance Lift JSUnary+deriving instance Lift JSMember+deriving instance Lift JSCons+deriving instance Lift JSAtom++javascript :: Parser JSProgram+javascript = whitespace *> many element <* eof+ where+ element :: Parser JSElement+ element = keyword "function" *> liftA3 [|JSFunction|] identifier (parens (commaSep identifier)) compound+ <|> [|JSStm|] <$> stmt+ compound :: Parser JSCompoundStm+ compound = braces (many stmt)+ stmt :: Parser JSStm+ stmt = semi $> [|JSSemi|]+ <|> keyword "if" *> liftA3 [|JSIf|] parensExpr stmt (maybeP (keyword "else" *> stmt))+ <|> keyword "while" *> liftA2 [|JSWhile|] parensExpr stmt+ <|> (keyword "for" *> parens+ (try (liftA2 [|JSForIn|] varsOrExprs (keyword "in" *> expr))+ <|> liftA3 [|JSFor|] (maybeP varsOrExprs <* semi) (optExpr <* semi) optExpr)+ <*> stmt)+ <|> keyword "break" $> [|JSBreak|]+ <|> keyword "continue" $> [|JSContinue|]+ <|> keyword "with" *> liftA2 [|JSWith|] parensExpr stmt+ <|> keyword "return" *> ([|JSReturn|] <$> optExpr)+ <|> [|JSBlock|] <$> compound+ <|> [|JSNaked|] <$> varsOrExprs+ varsOrExprs :: Parser (Either [JSVar] JSExpr)+ varsOrExprs = keyword "var" *> commaSep1 variable <+> expr+ variable :: Parser JSVar+ variable = liftA2 [|JSVar|] identifier (maybeP (symbol '=' *> asgn))+ parensExpr :: Parser JSExpr+ parensExpr = parens expr+ optExpr :: Parser (Maybe JSExpr)+ optExpr = maybeP expr+ expr :: Parser JSExpr+ expr = commaSep1 asgn+ asgn :: Parser JSExpr'+ asgn = chainl1 condExpr (symbol '=' $> [|JSAsgn|])+ condExpr :: Parser JSExpr'+ condExpr = liftA2 [|jsCondExprBuild|] expr' (maybeP ((symbol '?' *> asgn) <~> (symbol ':' *> asgn)))+ expr' :: Parser JSExpr'+ expr' = precedence (monolith+ [ prefix [ operator "--" $> [|jsDec|], operator "++" $> [|jsInc|]+ , operator "-" $> [|jsNeg|], operator "+" $> [|jsPlus|]+ , operator "~" $> [|jsBitNeg|], operator "!" $> [|jsNot|] ]+ , postfix [ operator "--" $> [|jsDec|], operator "++" $> [|jsInc|] ]+ , infixL [ operator "*" $> [|JSMul|], operator "/" $> [|JSDiv|]+ , operator "%" $> [|JSMod|] ]+ , infixL [ operator "+" $> [|JSAdd|], operator "-" $> [|JSSub|] ]+ , infixL [ operator "<<" $> [|JSShl|], operator ">>" $> [|JSShr|] ]+ , infixL [ operator "<=" $> [|JSLe|], operator "<" $> [|JSLt|]+ , operator ">=" $> [|JSGe|], operator ">" $> [|JSGt|] ]+ , infixL [ operator "==" $> [|JSEq|], operator "!=" $> [|JSNe|] ]+ , infixL [ try (operator "&") $> [|JSBitAnd|] ]+ , infixL [ operator "^" $> [|JSBitXor|] ]+ , infixL [ try (operator "|") $> [|JSBitOr|] ]+ , infixL [ operator "&&" $> [|JSAnd|] ]+ , infixL [ operator "||" $> [|JSOr|] ]+ ])+ ([|JSUnary|] <$> memOrCon)+ memOrCon :: Parser JSUnary+ memOrCon = keyword "delete" *> ([|JSDel|] <$> member)+ <|> keyword "new" *> ([|JSCons|] <$> con)+ <|> [|JSMember|] <$> member+ con :: Parser JSCons+ con = liftA2 [|JSQual|] (keyword "this" $> [|"this"|]) (dot *> conCall) <|> conCall+ conCall :: Parser JSCons+ conCall = identifier <**>+ (dot *> (FLIP_H [|JSQual|] <$> conCall)+ <|> FLIP_H [|JSConCall|] <$> parens (commaSep asgn)+ <|> pure (makeQ (\name -> JSConCall name []) [||\name -> JSConCall name []||]))+ member :: Parser JSMember+ member = primaryExpr <**>+ (FLIP_H [|JSCall|] <$> parens (commaSep asgn)+ <|> FLIP_H [|JSIndex|] <$> brackets expr+ <|> dot *> (FLIP_H [|JSAccess|] <$> member)+ <|> pure [|JSPrimExp|])+ primaryExpr :: Parser JSAtom+ primaryExpr = [|JSParens|] <$> parens expr+ <|> [|JSArray|] <$> brackets (commaSep asgn)+ <|> [|JSId|] <$> identifier+ <|> [|either JSInt JSFloat|] <$> naturalOrFloat+ <|> [|JSString|] <$> stringLiteral+ <|> [|JSTrue|] <$ keyword "true"+ <|> [|JSFalse|] <$ keyword "false"+ <|> [|JSNull|] <$ keyword "null"+ <|> [|JSThis|] <$ keyword "this"++ -- Token Parsers+ space :: Parser ()+ space = void (satisfy [|isSpace|])+ whitespace :: Parser ()+ whitespace = skipMany (spaces <|> oneLineComment <|> multiLineComment)+ keyword :: String -> Parser ()+ keyword s = try (string s *> notIdentLetter) *> whitespace+ operator :: String -> Parser ()+ operator op = try (string op *> notOpLetter) *> whitespace+ identifier :: Parser String+ identifier = try ((identStart <:> many identLetter) >?> [|jsUnreservedName|]) <* whitespace+ naturalOrFloat :: Parser (Either Int Double)+ naturalOrFloat = natFloat <* whitespace++ -- Nonsense to deal with floats and ints+ natFloat :: Parser (Either Int Double)+ natFloat = char '0' *> zeroNumFloat <|> decimalFloat++ zeroNumFloat :: Parser (Either Int Double)+ zeroNumFloat = [|Left|] <$> (hexadecimal <|> octal)+ <|> decimalFloat+ <|> (fromMaybeP (fractFloat <*> pure (LIFTED 0)) empty)+ <|> pure [|Left 0|]++ decimalFloat :: Parser (Either Int Double)+ decimalFloat = fromMaybeP (decimal <**> (option (COMPOSE_H [|Just|] [|Left|]) fractFloat)) empty++ fractFloat :: Parser (Int -> Maybe (Either Int Double))+ fractFloat = [|\g x -> liftM Right (g x)|] <$> fractExponent++ fractExponent :: Parser (Int -> Maybe Double)+ fractExponent = f <$> fraction <*> option [|""|] exponent'+ <|> g <$> exponent'+ where+ f = [|\fract exp n -> readMaybe (show n ++ fract ++ exp)|]+ g = [|\exp n -> readMaybe (show n ++ exp)|]++ fraction :: Parser [Char]+ fraction = char '.' <:> some (oneOf ['0'..'9'])++ exponent' :: Parser [Char]+ exponent' = [|$(CONS) 'e'|] <$> (oneOf "eE"+ *> (((CONS <$> oneOf "+-") <|> pure ID)+ <*> ([|show|] <$> decimal)))++ decimal :: Parser Int+ decimal = number (LIFTED 10) (oneOf ['0'..'9'])+ hexadecimal = oneOf "xX" *> number (LIFTED 16) (oneOf (['a'..'f'] ++ ['A'..'F'] ++ ['0'..'9']))+ octal = oneOf "oO" *> number (LIFTED 8) (oneOf ['0'..'7'])++ number :: Defunc Int -> Parser Char -> Parser Int+ number qbase digit = pfoldl1 addDigit (LIFTED 0) digit+ where+ addDigit = [|\x d -> $(qbase) * x + (digitToInt d)|]++ stringLiteral :: Parser String+ stringLiteral = [|catMaybes|] <$> between (token "\"") (token "\"") (many stringChar) <* whitespace+ symbol :: Char -> Parser Char+ symbol c = try (char c) <* whitespace+ parens :: Parser a -> Parser a+ parens = between (symbol '(') (symbol ')')+ brackets :: Parser a -> Parser a+ brackets = between (symbol '[') (symbol ']')+ braces :: Parser a -> Parser a+ braces = between (symbol '{') (symbol '}')+ dot :: Parser Char+ dot = symbol '.'+ semi :: Parser Char+ semi = symbol ';'+ comma :: Parser Char+ comma = symbol ','+ commaSep :: Parser a -> Parser [a]+ commaSep p = sepBy p comma+ commaSep1 :: Parser a -> Parser [a]+ commaSep1 p = sepBy1 p comma++ -- Let bindings+ spaces :: Parser ()+ spaces = skipSome space++ oneLineComment :: Parser ()+ oneLineComment = void (token "//" *> skipMany (satisfy [|(/= '\n')|]))++ multiLineComment :: Parser ()+ multiLineComment =+ let inComment = void (token "*/")+ <|> skipSome (noneOf "*") *> inComment+ <|> char '*' *> inComment+ in token "/*" *> inComment++ identStart = satisfy [|jsIdentStart|]+ identLetter = satisfy [|jsIdentLetter|]+ notIdentLetter = notFollowedBy identLetter+ notOpLetter = notFollowedBy (oneOf "+-*/=<>!~&|.%^")++ escChrs :: [Char]+ escChrs = "abfntv\\\"'0123456789xo^ABCDEFGHLNRSUV"++ stringChar :: Parser (Maybe Char)+ stringChar = [|Just|] <$> satisfy [|jsStringLetter|] <|> stringEscape++ stringEscape :: Parser (Maybe Char)+ stringEscape = token "\\" *> (token "&" $> [|Nothing|]+ <|> spaces *> token "\\" $> [|Nothing|]+ <|> [|Just|] <$> escapeCode)++ escapeCode :: Parser Char+ escapeCode = match escChrs (oneOf escChrs) escCode empty+ where+ escCode 'a' = pure [|'\a'|]+ escCode 'b' = pure [|'\b'|]+ escCode 'f' = pure [|'\f'|]+ escCode 'n' = pure [|'\n'|]+ escCode 't' = pure [|'\t'|]+ escCode 'v' = pure [|'\v'|]+ escCode '\\' = pure [|'\\'|]+ escCode '"' = pure [|'"'|]+ escCode '\'' = pure [|'\''|]+ escCode '^' = [|\c -> toEnum (fromEnum c - fromEnum 'A' + 1)|] <$> satisfy [|isUpper|]+ escCode 'A' = token "CK" $> [|'\ACK'|]+ escCode 'B' = token "S" $> [|'\BS'|] <|> token "EL" $> [|'\BEL'|]+ escCode 'C' = token "R" $> [|'\CR'|] <|> token "AN" $> [|'\CAN'|]+ escCode 'D' = token "C" *> (token "1" $> [|'\DC1'|]+ <|> token "2" $> [|'\DC2'|]+ <|> token "3" $> [|'\DC3'|]+ <|> token "4" $> [|'\DC4'|])+ <|> token "EL" $> [|'\DEL'|]+ <|> token "LE" $> [|'\DLE'|]+ escCode 'E' = token "M" $> [|'\EM'|]+ <|> token "T" *> (token "X" $> [|'\ETX'|]+ <|> token "B" $> [|'\ETB'|])+ <|> token "SC" $> [|'\ESC'|]+ <|> token "OT" $> [|'\EOT'|]+ <|> token "NQ" $> [|'\ENQ'|]+ escCode 'F' = token "F" $> [|'\FF'|] <|> token "S" $> [|'\FS'|]+ escCode 'G' = token "S" $> [|'\GS'|]+ escCode 'H' = token "T" $> [|'\HT'|]+ escCode 'L' = token "F" $> [|'\LF'|]+ escCode 'N' = token "UL" $> [|'\NUL'|] <|> token "AK" $> [|'\NAK'|]+ escCode 'R' = token "S" $> [|'\RS'|]+ escCode 'S' = token "O" *> option [|'\SO'|] (token "H" $> [|'\SOH'|])+ <|> token "I" $> [|'\SI'|]+ <|> token "P" $> [|'\SP'|]+ <|> token "TX" $> [|'\STX'|]+ <|> token "YN" $> [|'\SYN'|]+ <|> token "UB" $> [|'\SUB'|]+ escCode 'U' = token "S" $> [|'\US'|]+ escCode 'V' = token "T" $> [|'\VT'|]+ -- TODO numeric+ escCode _ = empty--error "numeric escape codes not supported"
@@ -0,0 +1,95 @@+module JavascriptBench.Shared where++import Data.Char (isAlpha, isAlphaNum, isSpace, isUpper, isDigit, digitToInt)+import Data.Set (fromList, member)++type JSProgram = [JSElement]+type JSCompoundStm = [JSStm]+type JSExpr = [JSExpr']+data JSElement = JSFunction String [String] JSCompoundStm | JSStm JSStm deriving Show+data JSStm = JSSemi+ | JSIf JSExpr JSStm (Maybe JSStm)+ | JSWhile JSExpr JSStm+ | JSFor (Maybe (Either [JSVar] JSExpr)) (Maybe JSExpr) (Maybe JSExpr) JSStm+ | JSForIn (Either [JSVar] JSExpr) JSExpr JSStm+ | JSBreak+ | JSContinue+ | JSWith JSExpr JSStm+ | JSReturn (Maybe JSExpr)+ | JSBlock JSCompoundStm+ | JSNaked (Either [JSVar] JSExpr) deriving Show+data JSVar = JSVar String (Maybe JSExpr') deriving Show+data JSExpr' = JSAsgn JSExpr' JSExpr'+ | JSCond JSExpr' JSExpr' JSExpr'+ | JSOr JSExpr' JSExpr'+ | JSAnd JSExpr' JSExpr'+ | JSBitOr JSExpr' JSExpr'+ | JSBitXor JSExpr' JSExpr'+ | JSBitAnd JSExpr' JSExpr'+ | JSEq JSExpr' JSExpr'+ | JSNe JSExpr' JSExpr'+ | JSLt JSExpr' JSExpr'+ | JSGt JSExpr' JSExpr'+ | JSLe JSExpr' JSExpr'+ | JSGe JSExpr' JSExpr'+ | JSShl JSExpr' JSExpr'+ | JSShr JSExpr' JSExpr'+ | JSAdd JSExpr' JSExpr'+ | JSSub JSExpr' JSExpr'+ | JSMul JSExpr' JSExpr'+ | JSDiv JSExpr' JSExpr'+ | JSMod JSExpr' JSExpr'+ | JSUnary JSUnary deriving Show+data JSUnary = JSPlus JSUnary+ | JSNeg JSUnary+ | JSBitNeg JSUnary+ | JSNot JSUnary+ | JSInc JSUnary+ | JSDec JSUnary+ | JSNew JSCons+ | JSDel JSMember+ | JSMember JSMember+ | JSCons JSCons deriving Show+jsPlus (JSUnary u) = JSUnary (JSPlus u)+jsNeg (JSUnary u) = JSUnary (JSNeg u)+jsBitNeg (JSUnary u) = JSUnary (JSBitNeg u)+jsNot (JSUnary u) = JSUnary (JSNot u)+jsInc (JSUnary u) = JSUnary (JSInc u)+jsDec (JSUnary u) = JSUnary (JSDec u)+data JSMember = JSPrimExp JSAtom+ | JSAccess JSAtom JSMember+ | JSIndex JSAtom JSExpr+ | JSCall JSAtom JSExpr deriving Show+data JSCons = JSQual String JSCons+ | JSConCall String JSExpr deriving Show+data JSAtom = JSParens JSExpr+ | JSArray JSExpr+ | JSId String+ | JSInt Int+ | JSFloat Double+ | JSString String+ | JSTrue+ | JSFalse+ | JSNull+ | JSThis deriving Show++jsCondExprBuild :: JSExpr' -> Maybe (JSExpr', JSExpr') -> JSExpr'+jsCondExprBuild c (Just (t, e)) = JSCond c t e+jsCondExprBuild c Nothing = c++jsIdentStart :: Char -> Bool+jsIdentStart c = isAlpha c || c == '_'++jsIdentLetter :: Char -> Bool+jsIdentLetter c = isAlphaNum c || c == '_'++jsUnreservedName :: String -> Bool+jsUnreservedName = \s -> not (member s keys)+ where+ keys = fromList ["true", "false", "if", "else",+ "for", "while", "break", "continue",+ "function", "var", "new", "delete",+ "this", "null", "return", "with"]++jsStringLetter :: Char -> Bool+jsStringLetter c = (c /= '"') && (c /= '\\') && (c > '\026')
+ benchmarks/NandlangBench/Bison/Nandlang.tab.c view
@@ -0,0 +1,1601 @@+/* A Bison parser, made by GNU Bison 3.5.1. */++/* Bison implementation for Yacc-like parsers in C++ Copyright (C) 1984, 1989-1990, 2000-2015, 2018-2020 Free Software Foundation,+ Inc.++ 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 3 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, see <http://www.gnu.org/licenses/>. */++/* As a special exception, you may create a larger work that contains+ part or all of the Bison parser skeleton and distribute that work+ under terms of your choice, so long as that work isn't itself a+ parser generator using the skeleton or a modified version thereof+ as a parser skeleton. Alternatively, if you modify or redistribute+ the parser skeleton itself, you may (at your option) remove this+ special exception, which will cause the skeleton and the resulting+ Bison output files to be licensed under the GNU General Public+ License without this special exception.++ This special exception was added by the Free Software Foundation in+ version 2.2 of Bison. */++/* C LALR(1) parser skeleton written by Richard Stallman, by+ simplifying the original so-called "semantic" parser. */++/* All symbols defined below should begin with yy or YY, to avoid+ infringing on user name space. This should be done even for local+ variables, as they might otherwise be expanded by user macros.+ There are some unavoidable exceptions within include files to+ define necessary library symbols; they are noted "INFRINGES ON+ USER NAME SPACE" below. */++/* Undocumented macros, especially those whose name start with YY_,+ are private implementation details. Do not rely on them. */++/* Identify Bison output. */+#define YYBISON 1++/* Bison version. */+#define YYBISON_VERSION "3.5.1"++/* Skeleton name. */+#define YYSKELETON_NAME "yacc.c"++/* Pure parsers. */+#define YYPURE 0++/* Push parsers. */+#define YYPUSH 0++/* Pull parsers. */+#define YYPULL 1+++++/* First part of user prologue. */+#line 1 "Nandlang.y"++#include <stdbool.h>+bool parse(const char*);+extern int yylex(void);+void yyerror(const char* err);++#line 77 "Nandlang.tab.c"++# ifndef YY_CAST+# ifdef __cplusplus+# define YY_CAST(Type, Val) static_cast<Type> (Val)+# define YY_REINTERPRET_CAST(Type, Val) reinterpret_cast<Type> (Val)+# else+# define YY_CAST(Type, Val) ((Type) (Val))+# define YY_REINTERPRET_CAST(Type, Val) ((Type) (Val))+# endif+# endif+# ifndef YY_NULLPTR+# if defined __cplusplus+# if 201103L <= __cplusplus+# define YY_NULLPTR nullptr+# else+# define YY_NULLPTR 0+# endif+# else+# define YY_NULLPTR ((void*)0)+# endif+# endif++/* Enabling verbose error messages. */+#ifdef YYERROR_VERBOSE+# undef YYERROR_VERBOSE+# define YYERROR_VERBOSE 1+#else+# define YYERROR_VERBOSE 0+#endif++/* Use api.header.include to #include this header+ instead of duplicating it here. */+#ifndef YY_YY_NANDLANG_TAB_H_INCLUDED+# define YY_YY_NANDLANG_TAB_H_INCLUDED+/* Debug traces. */+#ifndef YYDEBUG+# define YYDEBUG 0+#endif+#if YYDEBUG+extern int yydebug;+#endif++/* Token type. */+#ifndef YYTOKENTYPE+# define YYTOKENTYPE+ enum yytokentype+ {+ IDENTIFIER = 258,+ BIT = 259,+ NAT = 260,+ CHAR = 261,+ FUNCTION = 262,+ IF = 263,+ WHILE = 264,+ VAR = 265,+ ELSE = 266+ };+#endif++/* Value type. */+#if ! defined YYSTYPE && ! defined YYSTYPE_IS_DECLARED+typedef int YYSTYPE;+# define YYSTYPE_IS_TRIVIAL 1+# define YYSTYPE_IS_DECLARED 1+#endif+++extern YYSTYPE yylval;++int yyparse (void);++#endif /* !YY_YY_NANDLANG_TAB_H_INCLUDED */++++#ifdef short+# undef short+#endif++/* On compilers that do not define __PTRDIFF_MAX__ etc., make sure+ <limits.h> and (if available) <stdint.h> are included+ so that the code can choose integer types of a good width. */++#ifndef __PTRDIFF_MAX__+# include <limits.h> /* INFRINGES ON USER NAME SPACE */+# if defined __STDC_VERSION__ && 199901 <= __STDC_VERSION__+# include <stdint.h> /* INFRINGES ON USER NAME SPACE */+# define YY_STDINT_H+# endif+#endif++/* Narrow types that promote to a signed type and that can represent a+ signed or unsigned integer of at least N bits. In tables they can+ save space and decrease cache pressure. Promoting to a signed type+ helps avoid bugs in integer arithmetic. */++#ifdef __INT_LEAST8_MAX__+typedef __INT_LEAST8_TYPE__ yytype_int8;+#elif defined YY_STDINT_H+typedef int_least8_t yytype_int8;+#else+typedef signed char yytype_int8;+#endif++#ifdef __INT_LEAST16_MAX__+typedef __INT_LEAST16_TYPE__ yytype_int16;+#elif defined YY_STDINT_H+typedef int_least16_t yytype_int16;+#else+typedef short yytype_int16;+#endif++#if defined __UINT_LEAST8_MAX__ && __UINT_LEAST8_MAX__ <= __INT_MAX__+typedef __UINT_LEAST8_TYPE__ yytype_uint8;+#elif (!defined __UINT_LEAST8_MAX__ && defined YY_STDINT_H \+ && UINT_LEAST8_MAX <= INT_MAX)+typedef uint_least8_t yytype_uint8;+#elif !defined __UINT_LEAST8_MAX__ && UCHAR_MAX <= INT_MAX+typedef unsigned char yytype_uint8;+#else+typedef short yytype_uint8;+#endif++#if defined __UINT_LEAST16_MAX__ && __UINT_LEAST16_MAX__ <= __INT_MAX__+typedef __UINT_LEAST16_TYPE__ yytype_uint16;+#elif (!defined __UINT_LEAST16_MAX__ && defined YY_STDINT_H \+ && UINT_LEAST16_MAX <= INT_MAX)+typedef uint_least16_t yytype_uint16;+#elif !defined __UINT_LEAST16_MAX__ && USHRT_MAX <= INT_MAX+typedef unsigned short yytype_uint16;+#else+typedef int yytype_uint16;+#endif++#ifndef YYPTRDIFF_T+# if defined __PTRDIFF_TYPE__ && defined __PTRDIFF_MAX__+# define YYPTRDIFF_T __PTRDIFF_TYPE__+# define YYPTRDIFF_MAXIMUM __PTRDIFF_MAX__+# elif defined PTRDIFF_MAX+# ifndef ptrdiff_t+# include <stddef.h> /* INFRINGES ON USER NAME SPACE */+# endif+# define YYPTRDIFF_T ptrdiff_t+# define YYPTRDIFF_MAXIMUM PTRDIFF_MAX+# else+# define YYPTRDIFF_T long+# define YYPTRDIFF_MAXIMUM LONG_MAX+# endif+#endif++#ifndef YYSIZE_T+# ifdef __SIZE_TYPE__+# define YYSIZE_T __SIZE_TYPE__+# elif defined size_t+# define YYSIZE_T size_t+# elif defined __STDC_VERSION__ && 199901 <= __STDC_VERSION__+# include <stddef.h> /* INFRINGES ON USER NAME SPACE */+# define YYSIZE_T size_t+# else+# define YYSIZE_T unsigned+# endif+#endif++#define YYSIZE_MAXIMUM \+ YY_CAST (YYPTRDIFF_T, \+ (YYPTRDIFF_MAXIMUM < YY_CAST (YYSIZE_T, -1) \+ ? YYPTRDIFF_MAXIMUM \+ : YY_CAST (YYSIZE_T, -1)))++#define YYSIZEOF(X) YY_CAST (YYPTRDIFF_T, sizeof (X))++/* Stored state numbers (used for stacks). */+typedef yytype_int8 yy_state_t;++/* State numbers in computations. */+typedef int yy_state_fast_t;++#ifndef YY_+# if defined YYENABLE_NLS && YYENABLE_NLS+# if ENABLE_NLS+# include <libintl.h> /* INFRINGES ON USER NAME SPACE */+# define YY_(Msgid) dgettext ("bison-runtime", Msgid)+# endif+# endif+# ifndef YY_+# define YY_(Msgid) Msgid+# endif+#endif++#ifndef YY_ATTRIBUTE_PURE+# if defined __GNUC__ && 2 < __GNUC__ + (96 <= __GNUC_MINOR__)+# define YY_ATTRIBUTE_PURE __attribute__ ((__pure__))+# else+# define YY_ATTRIBUTE_PURE+# endif+#endif++#ifndef YY_ATTRIBUTE_UNUSED+# if defined __GNUC__ && 2 < __GNUC__ + (7 <= __GNUC_MINOR__)+# define YY_ATTRIBUTE_UNUSED __attribute__ ((__unused__))+# else+# define YY_ATTRIBUTE_UNUSED+# endif+#endif++/* Suppress unused-variable warnings by "using" E. */+#if ! defined lint || defined __GNUC__+# define YYUSE(E) ((void) (E))+#else+# define YYUSE(E) /* empty */+#endif++#if defined __GNUC__ && ! defined __ICC && 407 <= __GNUC__ * 100 + __GNUC_MINOR__+/* Suppress an incorrect diagnostic about yylval being uninitialized. */+# define YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN \+ _Pragma ("GCC diagnostic push") \+ _Pragma ("GCC diagnostic ignored \"-Wuninitialized\"") \+ _Pragma ("GCC diagnostic ignored \"-Wmaybe-uninitialized\"")+# define YY_IGNORE_MAYBE_UNINITIALIZED_END \+ _Pragma ("GCC diagnostic pop")+#else+# define YY_INITIAL_VALUE(Value) Value+#endif+#ifndef YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN+# define YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN+# define YY_IGNORE_MAYBE_UNINITIALIZED_END+#endif+#ifndef YY_INITIAL_VALUE+# define YY_INITIAL_VALUE(Value) /* Nothing. */+#endif++#if defined __cplusplus && defined __GNUC__ && ! defined __ICC && 6 <= __GNUC__+# define YY_IGNORE_USELESS_CAST_BEGIN \+ _Pragma ("GCC diagnostic push") \+ _Pragma ("GCC diagnostic ignored \"-Wuseless-cast\"")+# define YY_IGNORE_USELESS_CAST_END \+ _Pragma ("GCC diagnostic pop")+#endif+#ifndef YY_IGNORE_USELESS_CAST_BEGIN+# define YY_IGNORE_USELESS_CAST_BEGIN+# define YY_IGNORE_USELESS_CAST_END+#endif+++#define YY_ASSERT(E) ((void) (0 && (E)))++#if ! defined yyoverflow || YYERROR_VERBOSE++/* The parser invokes alloca or malloc; define the necessary symbols. */++# ifdef YYSTACK_USE_ALLOCA+# if YYSTACK_USE_ALLOCA+# ifdef __GNUC__+# define YYSTACK_ALLOC __builtin_alloca+# elif defined __BUILTIN_VA_ARG_INCR+# include <alloca.h> /* INFRINGES ON USER NAME SPACE */+# elif defined _AIX+# define YYSTACK_ALLOC __alloca+# elif defined _MSC_VER+# include <malloc.h> /* INFRINGES ON USER NAME SPACE */+# define alloca _alloca+# else+# define YYSTACK_ALLOC alloca+# if ! defined _ALLOCA_H && ! defined EXIT_SUCCESS+# include <stdlib.h> /* INFRINGES ON USER NAME SPACE */+ /* Use EXIT_SUCCESS as a witness for stdlib.h. */+# ifndef EXIT_SUCCESS+# define EXIT_SUCCESS 0+# endif+# endif+# endif+# endif+# endif++# ifdef YYSTACK_ALLOC+ /* Pacify GCC's 'empty if-body' warning. */+# define YYSTACK_FREE(Ptr) do { /* empty */; } while (0)+# ifndef YYSTACK_ALLOC_MAXIMUM+ /* The OS might guarantee only one guard page at the bottom of the stack,+ and a page size can be as small as 4096 bytes. So we cannot safely+ invoke alloca (N) if N exceeds 4096. Use a slightly smaller number+ to allow for a few compiler-allocated temporary stack slots. */+# define YYSTACK_ALLOC_MAXIMUM 4032 /* reasonable circa 2006 */+# endif+# else+# define YYSTACK_ALLOC YYMALLOC+# define YYSTACK_FREE YYFREE+# ifndef YYSTACK_ALLOC_MAXIMUM+# define YYSTACK_ALLOC_MAXIMUM YYSIZE_MAXIMUM+# endif+# if (defined __cplusplus && ! defined EXIT_SUCCESS \+ && ! ((defined YYMALLOC || defined malloc) \+ && (defined YYFREE || defined free)))+# include <stdlib.h> /* INFRINGES ON USER NAME SPACE */+# ifndef EXIT_SUCCESS+# define EXIT_SUCCESS 0+# endif+# endif+# ifndef YYMALLOC+# define YYMALLOC malloc+# if ! defined malloc && ! defined EXIT_SUCCESS+void *malloc (YYSIZE_T); /* INFRINGES ON USER NAME SPACE */+# endif+# endif+# ifndef YYFREE+# define YYFREE free+# if ! defined free && ! defined EXIT_SUCCESS+void free (void *); /* INFRINGES ON USER NAME SPACE */+# endif+# endif+# endif+#endif /* ! defined yyoverflow || YYERROR_VERBOSE */+++#if (! defined yyoverflow \+ && (! defined __cplusplus \+ || (defined YYSTYPE_IS_TRIVIAL && YYSTYPE_IS_TRIVIAL)))++/* A type that is properly aligned for any stack member. */+union yyalloc+{+ yy_state_t yyss_alloc;+ YYSTYPE yyvs_alloc;+};++/* The size of the maximum gap between one aligned stack and the next. */+# define YYSTACK_GAP_MAXIMUM (YYSIZEOF (union yyalloc) - 1)++/* The size of an array large to enough to hold all stacks, each with+ N elements. */+# define YYSTACK_BYTES(N) \+ ((N) * (YYSIZEOF (yy_state_t) + YYSIZEOF (YYSTYPE)) \+ + YYSTACK_GAP_MAXIMUM)++# define YYCOPY_NEEDED 1++/* Relocate STACK from its old location to the new one. The+ local variables YYSIZE and YYSTACKSIZE give the old and new number of+ elements in the stack, and YYPTR gives the new location of the+ stack. Advance YYPTR to a properly aligned location for the next+ stack. */+# define YYSTACK_RELOCATE(Stack_alloc, Stack) \+ do \+ { \+ YYPTRDIFF_T yynewbytes; \+ YYCOPY (&yyptr->Stack_alloc, Stack, yysize); \+ Stack = &yyptr->Stack_alloc; \+ yynewbytes = yystacksize * YYSIZEOF (*Stack) + YYSTACK_GAP_MAXIMUM; \+ yyptr += yynewbytes / YYSIZEOF (*yyptr); \+ } \+ while (0)++#endif++#if defined YYCOPY_NEEDED && YYCOPY_NEEDED+/* Copy COUNT objects from SRC to DST. The source and destination do+ not overlap. */+# ifndef YYCOPY+# if defined __GNUC__ && 1 < __GNUC__+# define YYCOPY(Dst, Src, Count) \+ __builtin_memcpy (Dst, Src, YY_CAST (YYSIZE_T, (Count)) * sizeof (*(Src)))+# else+# define YYCOPY(Dst, Src, Count) \+ do \+ { \+ YYPTRDIFF_T yyi; \+ for (yyi = 0; yyi < (Count); yyi++) \+ (Dst)[yyi] = (Src)[yyi]; \+ } \+ while (0)+# endif+# endif+#endif /* !YYCOPY_NEEDED */++/* YYFINAL -- State number of the termination state. */+#define YYFINAL 5+/* YYLAST -- Last index in YYTABLE. */+#define YYLAST 64++/* YYNTOKENS -- Number of terminals. */+#define YYNTOKENS 23+/* YYNNTS -- Number of nonterminals. */+#define YYNNTS 22+/* YYNRULES -- Number of rules. */+#define YYNRULES 41+/* YYNSTATES -- Number of states. */+#define YYNSTATES 71++#define YYUNDEFTOK 2+#define YYMAXUTOK 266+++/* YYTRANSLATE(TOKEN-NUM) -- Symbol number corresponding to TOKEN-NUM+ as returned by yylex, with out-of-bounds checking. */+#define YYTRANSLATE(YYX) \+ (0 <= (YYX) && (YYX) <= YYMAXUTOK ? yytranslate[YYX] : YYUNDEFTOK)++/* YYTRANSLATE[TOKEN-NUM] -- Symbol number corresponding to TOKEN-NUM+ as returned by yylex. */+static const yytype_int8 yytranslate[] =+{+ 0, 2, 2, 2, 2, 2, 2, 2, 2, 2,+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,+ 2, 2, 2, 14, 2, 2, 2, 2, 2, 2,+ 15, 16, 2, 2, 17, 2, 2, 2, 2, 2,+ 2, 2, 2, 2, 2, 2, 2, 2, 18, 20,+ 2, 19, 2, 2, 2, 2, 2, 2, 2, 2,+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,+ 2, 12, 2, 13, 2, 2, 2, 2, 2, 2,+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,+ 2, 2, 2, 21, 2, 22, 2, 2, 2, 2,+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,+ 2, 2, 2, 2, 2, 2, 1, 2, 3, 4,+ 5, 6, 7, 8, 9, 10, 11+};++#if YYDEBUG+ /* YYRLINE[YYN] -- Source line where rule number YYN was defined. */+static const yytype_int8 yyrline[] =+{+ 0, 22, 22, 22, 23, 24, 24, 25, 25, 26,+ 26, 27, 27, 28, 28, 29, 30, 31, 32, 32,+ 33, 34, 35, 35, 36, 37, 38, 39, 40, 41,+ 42, 43, 43, 44, 45, 45, 45, 45, 46, 47,+ 47, 48+};+#endif++#if YYDEBUG || YYERROR_VERBOSE || 0+/* YYTNAME[SYMBOL-NUM] -- String name of the symbol SYMBOL-NUM.+ First, the terminals, then, starting at YYNTOKENS, nonterminals. */+static const char *const yytname[] =+{+ "$end", "error", "$undefined", "IDENTIFIER", "BIT", "NAT", "CHAR",+ "FUNCTION", "IF", "WHILE", "VAR", "ELSE", "'['", "']'", "'!'", "'('",+ "')'", "','", "':'", "'='", "';'", "'{'", "'}'", "$accept", "nandlang",+ "index", "natorbit", "variable", "literal", "expr", "nandexpr",+ "funccallOrVar", "exprlist", "exprlist1", "varlist", "varlist1",+ "funcparam", "varstmt", "ifstmt", "elsestmt", "whilestmt", "statement",+ "block", "statements", "funcdef", YY_NULLPTR+};+#endif++# ifdef YYPRINT+/* YYTOKNUM[NUM] -- (External) token number corresponding to the+ (internal) symbol number NUM (which must be that of a token). */+static const yytype_int16 yytoknum[] =+{+ 0, 256, 257, 258, 259, 260, 261, 262, 263, 264,+ 265, 266, 91, 93, 33, 40, 41, 44, 58, 61,+ 59, 123, 125+};+# endif++#define YYPACT_NINF (-45)++#define yypact_value_is_default(Yyn) \+ ((Yyn) == YYPACT_NINF)++#define YYTABLE_NINF (-18)++#define yytable_value_is_error(Yyn) \+ 0++ /* YYPACT[STATE-NUM] -- Index in YYTABLE of the portion describing+ STATE-NUM. */+static const yytype_int8 yypact[] =+{+ -3, 14, 19, -3, 16, -45, -45, 37, 34, 30,+ 31, -45, 32, 39, -45, 37, 37, 29, -45, -45,+ 38, -45, -45, 24, -45, -45, -5, -45, -45, 33,+ 33, 37, -45, 4, -45, -45, 35, -45, -45, -45,+ 24, 36, 33, 15, 26, -8, -8, 40, 33, -45,+ 33, -45, -45, 28, 41, -45, -45, 42, -45, 33,+ -45, 43, 33, -45, 29, -45, 44, -45, -45, -45,+ -45+};++ /* YYDEFACT[STATE-NUM] -- Default reduction number in state STATE-NUM.+ Performed when YYTABLE does not specify something else to do. Zero+ means the default is an error. */+static const yytype_int8 yydefact[] =+{+ 3, 0, 0, 3, 0, 1, 2, 23, 7, 25,+ 27, 22, 0, 0, 8, 0, 23, 0, 6, 5,+ 0, 24, 26, 40, 41, 4, 7, 9, 10, 0,+ 0, 0, 13, 0, 12, 14, 0, 36, 34, 35,+ 40, 0, 19, 8, 17, 0, 0, 0, 0, 37,+ 0, 39, 38, 21, 0, 18, 16, 32, 33, 0,+ 11, 0, 0, 15, 0, 30, 0, 29, 20, 31,+ 28+};++ /* YYPGOTO[NTERM-NUM]. */+static const yytype_int8 yypgoto[] =+{+ -45, 49, -23, -45, -45, -45, -18, 7, -45, -45,+ -36, 45, -15, -45, -45, -45, -45, -45, -45, -44,+ 20, -45+};++ /* YYDEFGOTO[NTERM-NUM]. */+static const yytype_int8 yydefgoto[] =+{+ -1, 2, 14, 20, 9, 32, 53, 34, 35, 54,+ 55, 10, 11, 12, 37, 38, 65, 39, 40, 24,+ 41, 3+};++ /* YYTABLE[YYPACT[STATE-NUM]] -- What to do in state STATE-NUM. If+ positive, shift that token. If negative, reduce the rule whose+ number is the opposite. If YYTABLE_NINF, syntax error. */+static const yytype_int8 yytable[] =+{+ 21, 57, 58, 43, 1, 33, 48, 13, 36, -17,+ 42, 45, 46, 23, 61, -17, 47, 4, 48, 5,+ 69, 56, 33, 66, 49, 36, 68, 26, 27, -16,+ 28, 7, 29, 30, 31, -16, 44, 27, 13, 28,+ 8, 42, 48, 18, 19, 62, 13, 15, 17, 16,+ 23, 25, 6, 64, 50, 60, 0, 63, 52, 59,+ 51, 22, 0, 67, 70+};++static const yytype_int8 yycheck[] =+{+ 15, 45, 46, 26, 7, 23, 14, 12, 23, 14,+ 15, 29, 30, 21, 50, 20, 31, 3, 14, 0,+ 64, 44, 40, 59, 20, 40, 62, 3, 4, 14,+ 6, 15, 8, 9, 10, 20, 3, 4, 12, 6,+ 3, 15, 14, 4, 5, 17, 12, 17, 16, 18,+ 21, 13, 3, 11, 19, 48, -1, 16, 22, 19,+ 40, 16, -1, 20, 20+};++ /* YYSTOS[STATE-NUM] -- The (internal number of the) accessing+ symbol of state STATE-NUM. */+static const yytype_int8 yystos[] =+{+ 0, 7, 24, 44, 3, 0, 24, 15, 3, 27,+ 34, 35, 36, 12, 25, 17, 18, 16, 4, 5,+ 26, 35, 34, 21, 42, 13, 3, 4, 6, 8,+ 9, 10, 28, 29, 30, 31, 35, 37, 38, 40,+ 41, 43, 15, 25, 3, 29, 29, 35, 14, 20,+ 19, 43, 22, 29, 32, 33, 25, 42, 42, 19,+ 30, 33, 17, 16, 11, 39, 33, 20, 33, 42,+ 20+};++ /* YYR1[YYN] -- Symbol number of symbol that rule YYN derives. */+static const yytype_int8 yyr1[] =+{+ 0, 23, 24, 24, 25, 26, 26, 27, 27, 28,+ 28, 29, 29, 30, 30, 31, 31, 31, 32, 32,+ 33, 33, 34, 34, 35, 35, 36, 36, 37, 37,+ 38, 39, 39, 40, 41, 41, 41, 41, 42, 43,+ 43, 44+};++ /* YYR2[YYN] -- Number of symbols on the right hand side of rule YYN. */+static const yytype_int8 yyr2[] =+{+ 0, 2, 2, 0, 3, 1, 1, 1, 2, 1,+ 1, 3, 1, 1, 1, 4, 2, 1, 1, 0,+ 3, 1, 1, 0, 3, 1, 3, 1, 5, 4,+ 4, 2, 0, 3, 1, 1, 1, 2, 3, 2,+ 0, 6+};+++#define yyerrok (yyerrstatus = 0)+#define yyclearin (yychar = YYEMPTY)+#define YYEMPTY (-2)+#define YYEOF 0++#define YYACCEPT goto yyacceptlab+#define YYABORT goto yyabortlab+#define YYERROR goto yyerrorlab+++#define YYRECOVERING() (!!yyerrstatus)++#define YYBACKUP(Token, Value) \+ do \+ if (yychar == YYEMPTY) \+ { \+ yychar = (Token); \+ yylval = (Value); \+ YYPOPSTACK (yylen); \+ yystate = *yyssp; \+ goto yybackup; \+ } \+ else \+ { \+ yyerror (YY_("syntax error: cannot back up")); \+ YYERROR; \+ } \+ while (0)++/* Error token number */+#define YYTERROR 1+#define YYERRCODE 256++++/* Enable debugging if requested. */+#if YYDEBUG++# ifndef YYFPRINTF+# include <stdio.h> /* INFRINGES ON USER NAME SPACE */+# define YYFPRINTF fprintf+# endif++# define YYDPRINTF(Args) \+do { \+ if (yydebug) \+ YYFPRINTF Args; \+} while (0)++/* This macro is provided for backward compatibility. */+#ifndef YY_LOCATION_PRINT+# define YY_LOCATION_PRINT(File, Loc) ((void) 0)+#endif+++# define YY_SYMBOL_PRINT(Title, Type, Value, Location) \+do { \+ if (yydebug) \+ { \+ YYFPRINTF (stderr, "%s ", Title); \+ yy_symbol_print (stderr, \+ Type, Value); \+ YYFPRINTF (stderr, "\n"); \+ } \+} while (0)+++/*-----------------------------------.+| Print this symbol's value on YYO. |+`-----------------------------------*/++static void+yy_symbol_value_print (FILE *yyo, int yytype, YYSTYPE const * const yyvaluep)+{+ FILE *yyoutput = yyo;+ YYUSE (yyoutput);+ if (!yyvaluep)+ return;+# ifdef YYPRINT+ if (yytype < YYNTOKENS)+ YYPRINT (yyo, yytoknum[yytype], *yyvaluep);+# endif+ YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN+ YYUSE (yytype);+ YY_IGNORE_MAYBE_UNINITIALIZED_END+}+++/*---------------------------.+| Print this symbol on YYO. |+`---------------------------*/++static void+yy_symbol_print (FILE *yyo, int yytype, YYSTYPE const * const yyvaluep)+{+ YYFPRINTF (yyo, "%s %s (",+ yytype < YYNTOKENS ? "token" : "nterm", yytname[yytype]);++ yy_symbol_value_print (yyo, yytype, yyvaluep);+ YYFPRINTF (yyo, ")");+}++/*------------------------------------------------------------------.+| yy_stack_print -- Print the state stack from its BOTTOM up to its |+| TOP (included). |+`------------------------------------------------------------------*/++static void+yy_stack_print (yy_state_t *yybottom, yy_state_t *yytop)+{+ YYFPRINTF (stderr, "Stack now");+ for (; yybottom <= yytop; yybottom++)+ {+ int yybot = *yybottom;+ YYFPRINTF (stderr, " %d", yybot);+ }+ YYFPRINTF (stderr, "\n");+}++# define YY_STACK_PRINT(Bottom, Top) \+do { \+ if (yydebug) \+ yy_stack_print ((Bottom), (Top)); \+} while (0)+++/*------------------------------------------------.+| Report that the YYRULE is going to be reduced. |+`------------------------------------------------*/++static void+yy_reduce_print (yy_state_t *yyssp, YYSTYPE *yyvsp, int yyrule)+{+ int yylno = yyrline[yyrule];+ int yynrhs = yyr2[yyrule];+ int yyi;+ YYFPRINTF (stderr, "Reducing stack by rule %d (line %d):\n",+ yyrule - 1, yylno);+ /* The symbols being reduced. */+ for (yyi = 0; yyi < yynrhs; yyi++)+ {+ YYFPRINTF (stderr, " $%d = ", yyi + 1);+ yy_symbol_print (stderr,+ yystos[+yyssp[yyi + 1 - yynrhs]],+ &yyvsp[(yyi + 1) - (yynrhs)]+ );+ YYFPRINTF (stderr, "\n");+ }+}++# define YY_REDUCE_PRINT(Rule) \+do { \+ if (yydebug) \+ yy_reduce_print (yyssp, yyvsp, Rule); \+} while (0)++/* Nonzero means print parse trace. It is left uninitialized so that+ multiple parsers can coexist. */+int yydebug;+#else /* !YYDEBUG */+# define YYDPRINTF(Args)+# define YY_SYMBOL_PRINT(Title, Type, Value, Location)+# define YY_STACK_PRINT(Bottom, Top)+# define YY_REDUCE_PRINT(Rule)+#endif /* !YYDEBUG */+++/* YYINITDEPTH -- initial size of the parser's stacks. */+#ifndef YYINITDEPTH+# define YYINITDEPTH 200+#endif++/* YYMAXDEPTH -- maximum size the stacks can grow to (effective only+ if the built-in stack extension method is used).++ Do not make this value too large; the results are undefined if+ YYSTACK_ALLOC_MAXIMUM < YYSTACK_BYTES (YYMAXDEPTH)+ evaluated with infinite-precision integer arithmetic. */++#ifndef YYMAXDEPTH+# define YYMAXDEPTH 10000+#endif+++#if YYERROR_VERBOSE++# ifndef yystrlen+# if defined __GLIBC__ && defined _STRING_H+# define yystrlen(S) (YY_CAST (YYPTRDIFF_T, strlen (S)))+# else+/* Return the length of YYSTR. */+static YYPTRDIFF_T+yystrlen (const char *yystr)+{+ YYPTRDIFF_T yylen;+ for (yylen = 0; yystr[yylen]; yylen++)+ continue;+ return yylen;+}+# endif+# endif++# ifndef yystpcpy+# if defined __GLIBC__ && defined _STRING_H && defined _GNU_SOURCE+# define yystpcpy stpcpy+# else+/* Copy YYSRC to YYDEST, returning the address of the terminating '\0' in+ YYDEST. */+static char *+yystpcpy (char *yydest, const char *yysrc)+{+ char *yyd = yydest;+ const char *yys = yysrc;++ while ((*yyd++ = *yys++) != '\0')+ continue;++ return yyd - 1;+}+# endif+# endif++# ifndef yytnamerr+/* Copy to YYRES the contents of YYSTR after stripping away unnecessary+ quotes and backslashes, so that it's suitable for yyerror. The+ heuristic is that double-quoting is unnecessary unless the string+ contains an apostrophe, a comma, or backslash (other than+ backslash-backslash). YYSTR is taken from yytname. If YYRES is+ null, do not copy; instead, return the length of what the result+ would have been. */+static YYPTRDIFF_T+yytnamerr (char *yyres, const char *yystr)+{+ if (*yystr == '"')+ {+ YYPTRDIFF_T yyn = 0;+ char const *yyp = yystr;++ for (;;)+ switch (*++yyp)+ {+ case '\'':+ case ',':+ goto do_not_strip_quotes;++ case '\\':+ if (*++yyp != '\\')+ goto do_not_strip_quotes;+ else+ goto append;++ append:+ default:+ if (yyres)+ yyres[yyn] = *yyp;+ yyn++;+ break;++ case '"':+ if (yyres)+ yyres[yyn] = '\0';+ return yyn;+ }+ do_not_strip_quotes: ;+ }++ if (yyres)+ return yystpcpy (yyres, yystr) - yyres;+ else+ return yystrlen (yystr);+}+# endif++/* Copy into *YYMSG, which is of size *YYMSG_ALLOC, an error message+ about the unexpected token YYTOKEN for the state stack whose top is+ YYSSP.++ Return 0 if *YYMSG was successfully written. Return 1 if *YYMSG is+ not large enough to hold the message. In that case, also set+ *YYMSG_ALLOC to the required number of bytes. Return 2 if the+ required number of bytes is too large to store. */+static int+yysyntax_error (YYPTRDIFF_T *yymsg_alloc, char **yymsg,+ yy_state_t *yyssp, int yytoken)+{+ enum { YYERROR_VERBOSE_ARGS_MAXIMUM = 5 };+ /* Internationalized format string. */+ const char *yyformat = YY_NULLPTR;+ /* Arguments of yyformat: reported tokens (one for the "unexpected",+ one per "expected"). */+ char const *yyarg[YYERROR_VERBOSE_ARGS_MAXIMUM];+ /* Actual size of YYARG. */+ int yycount = 0;+ /* Cumulated lengths of YYARG. */+ YYPTRDIFF_T yysize = 0;++ /* There are many possibilities here to consider:+ - If this state is a consistent state with a default action, then+ the only way this function was invoked is if the default action+ is an error action. In that case, don't check for expected+ tokens because there are none.+ - The only way there can be no lookahead present (in yychar) is if+ this state is a consistent state with a default action. Thus,+ detecting the absence of a lookahead is sufficient to determine+ that there is no unexpected or expected token to report. In that+ case, just report a simple "syntax error".+ - Don't assume there isn't a lookahead just because this state is a+ consistent state with a default action. There might have been a+ previous inconsistent state, consistent state with a non-default+ action, or user semantic action that manipulated yychar.+ - Of course, the expected token list depends on states to have+ correct lookahead information, and it depends on the parser not+ to perform extra reductions after fetching a lookahead from the+ scanner and before detecting a syntax error. Thus, state merging+ (from LALR or IELR) and default reductions corrupt the expected+ token list. However, the list is correct for canonical LR with+ one exception: it will still contain any token that will not be+ accepted due to an error action in a later state.+ */+ if (yytoken != YYEMPTY)+ {+ int yyn = yypact[+*yyssp];+ YYPTRDIFF_T yysize0 = yytnamerr (YY_NULLPTR, yytname[yytoken]);+ yysize = yysize0;+ yyarg[yycount++] = yytname[yytoken];+ if (!yypact_value_is_default (yyn))+ {+ /* Start YYX at -YYN if negative to avoid negative indexes in+ YYCHECK. In other words, skip the first -YYN actions for+ this state because they are default actions. */+ int yyxbegin = yyn < 0 ? -yyn : 0;+ /* Stay within bounds of both yycheck and yytname. */+ int yychecklim = YYLAST - yyn + 1;+ int yyxend = yychecklim < YYNTOKENS ? yychecklim : YYNTOKENS;+ int yyx;++ for (yyx = yyxbegin; yyx < yyxend; ++yyx)+ if (yycheck[yyx + yyn] == yyx && yyx != YYTERROR+ && !yytable_value_is_error (yytable[yyx + yyn]))+ {+ if (yycount == YYERROR_VERBOSE_ARGS_MAXIMUM)+ {+ yycount = 1;+ yysize = yysize0;+ break;+ }+ yyarg[yycount++] = yytname[yyx];+ {+ YYPTRDIFF_T yysize1+ = yysize + yytnamerr (YY_NULLPTR, yytname[yyx]);+ if (yysize <= yysize1 && yysize1 <= YYSTACK_ALLOC_MAXIMUM)+ yysize = yysize1;+ else+ return 2;+ }+ }+ }+ }++ switch (yycount)+ {+# define YYCASE_(N, S) \+ case N: \+ yyformat = S; \+ break+ default: /* Avoid compiler warnings. */+ YYCASE_(0, YY_("syntax error"));+ YYCASE_(1, YY_("syntax error, unexpected %s"));+ YYCASE_(2, YY_("syntax error, unexpected %s, expecting %s"));+ YYCASE_(3, YY_("syntax error, unexpected %s, expecting %s or %s"));+ YYCASE_(4, YY_("syntax error, unexpected %s, expecting %s or %s or %s"));+ YYCASE_(5, YY_("syntax error, unexpected %s, expecting %s or %s or %s or %s"));+# undef YYCASE_+ }++ {+ /* Don't count the "%s"s in the final size, but reserve room for+ the terminator. */+ YYPTRDIFF_T yysize1 = yysize + (yystrlen (yyformat) - 2 * yycount) + 1;+ if (yysize <= yysize1 && yysize1 <= YYSTACK_ALLOC_MAXIMUM)+ yysize = yysize1;+ else+ return 2;+ }++ if (*yymsg_alloc < yysize)+ {+ *yymsg_alloc = 2 * yysize;+ if (! (yysize <= *yymsg_alloc+ && *yymsg_alloc <= YYSTACK_ALLOC_MAXIMUM))+ *yymsg_alloc = YYSTACK_ALLOC_MAXIMUM;+ return 1;+ }++ /* Avoid sprintf, as that infringes on the user's name space.+ Don't have undefined behavior even if the translation+ produced a string with the wrong number of "%s"s. */+ {+ char *yyp = *yymsg;+ int yyi = 0;+ while ((*yyp = *yyformat) != '\0')+ if (*yyp == '%' && yyformat[1] == 's' && yyi < yycount)+ {+ yyp += yytnamerr (yyp, yyarg[yyi++]);+ yyformat += 2;+ }+ else+ {+ ++yyp;+ ++yyformat;+ }+ }+ return 0;+}+#endif /* YYERROR_VERBOSE */++/*-----------------------------------------------.+| Release the memory associated to this symbol. |+`-----------------------------------------------*/++static void+yydestruct (const char *yymsg, int yytype, YYSTYPE *yyvaluep)+{+ YYUSE (yyvaluep);+ if (!yymsg)+ yymsg = "Deleting";+ YY_SYMBOL_PRINT (yymsg, yytype, yyvaluep, yylocationp);++ YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN+ YYUSE (yytype);+ YY_IGNORE_MAYBE_UNINITIALIZED_END+}+++++/* The lookahead symbol. */+int yychar;++/* The semantic value of the lookahead symbol. */+YYSTYPE yylval;+/* Number of syntax errors so far. */+int yynerrs;+++/*----------.+| yyparse. |+`----------*/++int+yyparse (void)+{+ yy_state_fast_t yystate;+ /* Number of tokens to shift before error messages enabled. */+ int yyerrstatus;++ /* The stacks and their tools:+ 'yyss': related to states.+ 'yyvs': related to semantic values.++ Refer to the stacks through separate pointers, to allow yyoverflow+ to reallocate them elsewhere. */++ /* The state stack. */+ yy_state_t yyssa[YYINITDEPTH];+ yy_state_t *yyss;+ yy_state_t *yyssp;++ /* The semantic value stack. */+ YYSTYPE yyvsa[YYINITDEPTH];+ YYSTYPE *yyvs;+ YYSTYPE *yyvsp;++ YYPTRDIFF_T yystacksize;++ int yyn;+ int yyresult;+ /* Lookahead token as an internal (translated) token number. */+ int yytoken = 0;+ /* The variables used to return semantic value and location from the+ action routines. */+ YYSTYPE yyval;++#if YYERROR_VERBOSE+ /* Buffer for error messages, and its allocated size. */+ char yymsgbuf[128];+ char *yymsg = yymsgbuf;+ YYPTRDIFF_T yymsg_alloc = sizeof yymsgbuf;+#endif++#define YYPOPSTACK(N) (yyvsp -= (N), yyssp -= (N))++ /* The number of symbols on the RHS of the reduced rule.+ Keep to zero when no symbol should be popped. */+ int yylen = 0;++ yyssp = yyss = yyssa;+ yyvsp = yyvs = yyvsa;+ yystacksize = YYINITDEPTH;++ YYDPRINTF ((stderr, "Starting parse\n"));++ yystate = 0;+ yyerrstatus = 0;+ yynerrs = 0;+ yychar = YYEMPTY; /* Cause a token to be read. */+ goto yysetstate;+++/*------------------------------------------------------------.+| yynewstate -- push a new state, which is found in yystate. |+`------------------------------------------------------------*/+yynewstate:+ /* In all cases, when you get here, the value and location stacks+ have just been pushed. So pushing a state here evens the stacks. */+ yyssp++;+++/*--------------------------------------------------------------------.+| yysetstate -- set current state (the top of the stack) to yystate. |+`--------------------------------------------------------------------*/+yysetstate:+ YYDPRINTF ((stderr, "Entering state %d\n", yystate));+ YY_ASSERT (0 <= yystate && yystate < YYNSTATES);+ YY_IGNORE_USELESS_CAST_BEGIN+ *yyssp = YY_CAST (yy_state_t, yystate);+ YY_IGNORE_USELESS_CAST_END++ if (yyss + yystacksize - 1 <= yyssp)+#if !defined yyoverflow && !defined YYSTACK_RELOCATE+ goto yyexhaustedlab;+#else+ {+ /* Get the current used size of the three stacks, in elements. */+ YYPTRDIFF_T yysize = yyssp - yyss + 1;++# if defined yyoverflow+ {+ /* Give user a chance to reallocate the stack. Use copies of+ these so that the &'s don't force the real ones into+ memory. */+ yy_state_t *yyss1 = yyss;+ YYSTYPE *yyvs1 = yyvs;++ /* Each stack pointer address is followed by the size of the+ data in use in that stack, in bytes. This used to be a+ conditional around just the two extra args, but that might+ be undefined if yyoverflow is a macro. */+ yyoverflow (YY_("memory exhausted"),+ &yyss1, yysize * YYSIZEOF (*yyssp),+ &yyvs1, yysize * YYSIZEOF (*yyvsp),+ &yystacksize);+ yyss = yyss1;+ yyvs = yyvs1;+ }+# else /* defined YYSTACK_RELOCATE */+ /* Extend the stack our own way. */+ if (YYMAXDEPTH <= yystacksize)+ goto yyexhaustedlab;+ yystacksize *= 2;+ if (YYMAXDEPTH < yystacksize)+ yystacksize = YYMAXDEPTH;++ {+ yy_state_t *yyss1 = yyss;+ union yyalloc *yyptr =+ YY_CAST (union yyalloc *,+ YYSTACK_ALLOC (YY_CAST (YYSIZE_T, YYSTACK_BYTES (yystacksize))));+ if (! yyptr)+ goto yyexhaustedlab;+ YYSTACK_RELOCATE (yyss_alloc, yyss);+ YYSTACK_RELOCATE (yyvs_alloc, yyvs);+# undef YYSTACK_RELOCATE+ if (yyss1 != yyssa)+ YYSTACK_FREE (yyss1);+ }+# endif++ yyssp = yyss + yysize - 1;+ yyvsp = yyvs + yysize - 1;++ YY_IGNORE_USELESS_CAST_BEGIN+ YYDPRINTF ((stderr, "Stack size increased to %ld\n",+ YY_CAST (long, yystacksize)));+ YY_IGNORE_USELESS_CAST_END++ if (yyss + yystacksize - 1 <= yyssp)+ YYABORT;+ }+#endif /* !defined yyoverflow && !defined YYSTACK_RELOCATE */++ if (yystate == YYFINAL)+ YYACCEPT;++ goto yybackup;+++/*-----------.+| yybackup. |+`-----------*/+yybackup:+ /* Do appropriate processing given the current state. Read a+ lookahead token if we need one and don't already have one. */++ /* First try to decide what to do without reference to lookahead token. */+ yyn = yypact[yystate];+ if (yypact_value_is_default (yyn))+ goto yydefault;++ /* Not known => get a lookahead token if don't already have one. */++ /* YYCHAR is either YYEMPTY or YYEOF or a valid lookahead symbol. */+ if (yychar == YYEMPTY)+ {+ YYDPRINTF ((stderr, "Reading a token: "));+ yychar = yylex ();+ }++ if (yychar <= YYEOF)+ {+ yychar = yytoken = YYEOF;+ YYDPRINTF ((stderr, "Now at end of input.\n"));+ }+ else+ {+ yytoken = YYTRANSLATE (yychar);+ YY_SYMBOL_PRINT ("Next token is", yytoken, &yylval, &yylloc);+ }++ /* If the proper action on seeing token YYTOKEN is to reduce or to+ detect an error, take that action. */+ yyn += yytoken;+ if (yyn < 0 || YYLAST < yyn || yycheck[yyn] != yytoken)+ goto yydefault;+ yyn = yytable[yyn];+ if (yyn <= 0)+ {+ if (yytable_value_is_error (yyn))+ goto yyerrlab;+ yyn = -yyn;+ goto yyreduce;+ }++ /* Count tokens shifted since error; after three, turn off error+ status. */+ if (yyerrstatus)+ yyerrstatus--;++ /* Shift the lookahead token. */+ YY_SYMBOL_PRINT ("Shifting", yytoken, &yylval, &yylloc);+ yystate = yyn;+ YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN+ *++yyvsp = yylval;+ YY_IGNORE_MAYBE_UNINITIALIZED_END++ /* Discard the shifted token. */+ yychar = YYEMPTY;+ goto yynewstate;+++/*-----------------------------------------------------------.+| yydefault -- do the default action for the current state. |+`-----------------------------------------------------------*/+yydefault:+ yyn = yydefact[yystate];+ if (yyn == 0)+ goto yyerrlab;+ goto yyreduce;+++/*-----------------------------.+| yyreduce -- do a reduction. |+`-----------------------------*/+yyreduce:+ /* yyn is the number of a rule to reduce with. */+ yylen = yyr2[yyn];++ /* If YYLEN is nonzero, implement the default value of the action:+ '$$ = $1'.++ Otherwise, the following line sets YYVAL to garbage.+ This behavior is undocumented and Bison+ users should not rely upon it. Assigning to YYVAL+ unconditionally makes the parser a bit smaller, and it avoids a+ GCC warning that YYVAL may be used uninitialized. */+ yyval = yyvsp[1-yylen];+++ YY_REDUCE_PRINT (yyn);+ switch (yyn)+ {++#line 1353 "Nandlang.tab.c"++ default: break;+ }+ /* User semantic actions sometimes alter yychar, and that requires+ that yytoken be updated with the new translation. We take the+ approach of translating immediately before every use of yytoken.+ One alternative is translating here after every semantic action,+ but that translation would be missed if the semantic action invokes+ YYABORT, YYACCEPT, or YYERROR immediately after altering yychar or+ if it invokes YYBACKUP. In the case of YYABORT or YYACCEPT, an+ incorrect destructor might then be invoked immediately. In the+ case of YYERROR or YYBACKUP, subsequent parser actions might lead+ to an incorrect destructor call or verbose syntax error message+ before the lookahead is translated. */+ YY_SYMBOL_PRINT ("-> $$ =", yyr1[yyn], &yyval, &yyloc);++ YYPOPSTACK (yylen);+ yylen = 0;+ YY_STACK_PRINT (yyss, yyssp);++ *++yyvsp = yyval;++ /* Now 'shift' the result of the reduction. Determine what state+ that goes to, based on the state we popped back to and the rule+ number reduced by. */+ {+ const int yylhs = yyr1[yyn] - YYNTOKENS;+ const int yyi = yypgoto[yylhs] + *yyssp;+ yystate = (0 <= yyi && yyi <= YYLAST && yycheck[yyi] == *yyssp+ ? yytable[yyi]+ : yydefgoto[yylhs]);+ }++ goto yynewstate;+++/*--------------------------------------.+| yyerrlab -- here on detecting error. |+`--------------------------------------*/+yyerrlab:+ /* Make sure we have latest lookahead translation. See comments at+ user semantic actions for why this is necessary. */+ yytoken = yychar == YYEMPTY ? YYEMPTY : YYTRANSLATE (yychar);++ /* If not already recovering from an error, report this error. */+ if (!yyerrstatus)+ {+ ++yynerrs;+#if ! YYERROR_VERBOSE+ yyerror (YY_("syntax error"));+#else+# define YYSYNTAX_ERROR yysyntax_error (&yymsg_alloc, &yymsg, \+ yyssp, yytoken)+ {+ char const *yymsgp = YY_("syntax error");+ int yysyntax_error_status;+ yysyntax_error_status = YYSYNTAX_ERROR;+ if (yysyntax_error_status == 0)+ yymsgp = yymsg;+ else if (yysyntax_error_status == 1)+ {+ if (yymsg != yymsgbuf)+ YYSTACK_FREE (yymsg);+ yymsg = YY_CAST (char *, YYSTACK_ALLOC (YY_CAST (YYSIZE_T, yymsg_alloc)));+ if (!yymsg)+ {+ yymsg = yymsgbuf;+ yymsg_alloc = sizeof yymsgbuf;+ yysyntax_error_status = 2;+ }+ else+ {+ yysyntax_error_status = YYSYNTAX_ERROR;+ yymsgp = yymsg;+ }+ }+ yyerror (yymsgp);+ if (yysyntax_error_status == 2)+ goto yyexhaustedlab;+ }+# undef YYSYNTAX_ERROR+#endif+ }++++ if (yyerrstatus == 3)+ {+ /* If just tried and failed to reuse lookahead token after an+ error, discard it. */++ if (yychar <= YYEOF)+ {+ /* Return failure if at end of input. */+ if (yychar == YYEOF)+ YYABORT;+ }+ else+ {+ yydestruct ("Error: discarding",+ yytoken, &yylval);+ yychar = YYEMPTY;+ }+ }++ /* Else will try to reuse lookahead token after shifting the error+ token. */+ goto yyerrlab1;+++/*---------------------------------------------------.+| yyerrorlab -- error raised explicitly by YYERROR. |+`---------------------------------------------------*/+yyerrorlab:+ /* Pacify compilers when the user code never invokes YYERROR and the+ label yyerrorlab therefore never appears in user code. */+ if (0)+ YYERROR;++ /* Do not reclaim the symbols of the rule whose action triggered+ this YYERROR. */+ YYPOPSTACK (yylen);+ yylen = 0;+ YY_STACK_PRINT (yyss, yyssp);+ yystate = *yyssp;+ goto yyerrlab1;+++/*-------------------------------------------------------------.+| yyerrlab1 -- common code for both syntax error and YYERROR. |+`-------------------------------------------------------------*/+yyerrlab1:+ yyerrstatus = 3; /* Each real token shifted decrements this. */++ for (;;)+ {+ yyn = yypact[yystate];+ if (!yypact_value_is_default (yyn))+ {+ yyn += YYTERROR;+ if (0 <= yyn && yyn <= YYLAST && yycheck[yyn] == YYTERROR)+ {+ yyn = yytable[yyn];+ if (0 < yyn)+ break;+ }+ }++ /* Pop the current state because it cannot handle the error token. */+ if (yyssp == yyss)+ YYABORT;+++ yydestruct ("Error: popping",+ yystos[yystate], yyvsp);+ YYPOPSTACK (1);+ yystate = *yyssp;+ YY_STACK_PRINT (yyss, yyssp);+ }++ YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN+ *++yyvsp = yylval;+ YY_IGNORE_MAYBE_UNINITIALIZED_END+++ /* Shift the error token. */+ YY_SYMBOL_PRINT ("Shifting", yystos[yyn], yyvsp, yylsp);++ yystate = yyn;+ goto yynewstate;+++/*-------------------------------------.+| yyacceptlab -- YYACCEPT comes here. |+`-------------------------------------*/+yyacceptlab:+ yyresult = 0;+ goto yyreturn;+++/*-----------------------------------.+| yyabortlab -- YYABORT comes here. |+`-----------------------------------*/+yyabortlab:+ yyresult = 1;+ goto yyreturn;+++#if !defined yyoverflow || YYERROR_VERBOSE+/*-------------------------------------------------.+| yyexhaustedlab -- memory exhaustion comes here. |+`-------------------------------------------------*/+yyexhaustedlab:+ yyerror (YY_("memory exhausted"));+ yyresult = 2;+ /* Fall through. */+#endif+++/*-----------------------------------------------------.+| yyreturn -- parsing is finished, return the result. |+`-----------------------------------------------------*/+yyreturn:+ if (yychar != YYEMPTY)+ {+ /* Make sure we have latest lookahead translation. See comments at+ user semantic actions for why this is necessary. */+ yytoken = YYTRANSLATE (yychar);+ yydestruct ("Cleanup: discarding lookahead",+ yytoken, &yylval);+ }+ /* Do not reclaim the symbols of the rule whose action triggered+ this YYABORT or YYACCEPT. */+ YYPOPSTACK (yylen);+ YY_STACK_PRINT (yyss, yyssp);+ while (yyssp != yyss)+ {+ yydestruct ("Cleanup: popping",+ yystos[+*yyssp], yyvsp);+ YYPOPSTACK (1);+ }+#ifndef yyoverflow+ if (yyss != yyssa)+ YYSTACK_FREE (yyss);+#endif+#if YYERROR_VERBOSE+ if (yymsg != yymsgbuf)+ YYSTACK_FREE (yymsg);+#endif+ return yyresult;+}+#line 50 "Nandlang.y"+++void set_input_string(const char* in);+void end_lexical_scan(void);++bool parse(const char* in) +{+ set_input_string(in);+ int rv = yyparse();+ end_lexical_scan();+ return !rv;+}++void yyerror(const char* msg) +{+ return;+}
+ benchmarks/NandlangBench/Bison/Parser.hs view
@@ -0,0 +1,15 @@+{-# LANGUAGE ForeignFunctionInterface #-}+module NandlangBench.Bison.Parser where++import Foreign.C+import Foreign.Ptr+import Data.ByteString+import System.IO.Unsafe++foreign import ccall "parse" c_parse :: Ptr CChar -> CBool++marshall :: ByteString -> CBool+marshall = unsafePerformIO . flip useAsCString (return . c_parse)++nand :: ByteString -> Maybe ()+nand str = if marshall str == 1 then Just () else Nothing
+ benchmarks/NandlangBench/Bison/lex.yy.c view
@@ -0,0 +1,1949 @@++#line 3 "lex.yy.c"++#define YY_INT_ALIGNED short int++/* A lexical scanner generated by flex */++#define FLEX_SCANNER+#define YY_FLEX_MAJOR_VERSION 2+#define YY_FLEX_MINOR_VERSION 6+#define YY_FLEX_SUBMINOR_VERSION 4+#if YY_FLEX_SUBMINOR_VERSION > 0+#define FLEX_BETA+#endif++/* First, we deal with platform-specific or compiler-specific issues. */++/* begin standard C headers. */+#include <stdio.h>+#include <string.h>+#include <errno.h>+#include <stdlib.h>++/* end standard C headers. */++/* flex integer type definitions */++#ifndef FLEXINT_H+#define FLEXINT_H++/* C99 systems have <inttypes.h>. Non-C99 systems may or may not. */++#if defined (__STDC_VERSION__) && __STDC_VERSION__ >= 199901L++/* C99 says to define __STDC_LIMIT_MACROS before including stdint.h,+ * if you want the limit (max/min) macros for int types. + */+#ifndef __STDC_LIMIT_MACROS+#define __STDC_LIMIT_MACROS 1+#endif++#include <inttypes.h>+typedef int8_t flex_int8_t;+typedef uint8_t flex_uint8_t;+typedef int16_t flex_int16_t;+typedef uint16_t flex_uint16_t;+typedef int32_t flex_int32_t;+typedef uint32_t flex_uint32_t;+#else+typedef signed char flex_int8_t;+typedef short int flex_int16_t;+typedef int flex_int32_t;+typedef unsigned char flex_uint8_t; +typedef unsigned short int flex_uint16_t;+typedef unsigned int flex_uint32_t;++/* Limits of integral types. */+#ifndef INT8_MIN+#define INT8_MIN (-128)+#endif+#ifndef INT16_MIN+#define INT16_MIN (-32767-1)+#endif+#ifndef INT32_MIN+#define INT32_MIN (-2147483647-1)+#endif+#ifndef INT8_MAX+#define INT8_MAX (127)+#endif+#ifndef INT16_MAX+#define INT16_MAX (32767)+#endif+#ifndef INT32_MAX+#define INT32_MAX (2147483647)+#endif+#ifndef UINT8_MAX+#define UINT8_MAX (255U)+#endif+#ifndef UINT16_MAX+#define UINT16_MAX (65535U)+#endif+#ifndef UINT32_MAX+#define UINT32_MAX (4294967295U)+#endif++#ifndef SIZE_MAX+#define SIZE_MAX (~(size_t)0)+#endif++#endif /* ! C99 */++#endif /* ! FLEXINT_H */++/* begin standard C++ headers. */++/* TODO: this is always defined, so inline it */+#define yyconst const++#if defined(__GNUC__) && __GNUC__ >= 3+#define yynoreturn __attribute__((__noreturn__))+#else+#define yynoreturn+#endif++/* Returned upon end-of-file. */+#define YY_NULL 0++/* Promotes a possibly negative, possibly signed char to an+ * integer in range [0..255] for use as an array index.+ */+#define YY_SC_TO_UI(c) ((YY_CHAR) (c))++/* Enter a start condition. This macro really ought to take a parameter,+ * but we do it the disgusting crufty way forced on us by the ()-less+ * definition of BEGIN.+ */+#define BEGIN (yy_start) = 1 + 2 *+/* Translate the current start state into a value that can be later handed+ * to BEGIN to return to the state. The YYSTATE alias is for lex+ * compatibility.+ */+#define YY_START (((yy_start) - 1) / 2)+#define YYSTATE YY_START+/* Action number for EOF rule of a given start state. */+#define YY_STATE_EOF(state) (YY_END_OF_BUFFER + state + 1)+/* Special action meaning "start processing a new file". */+#define YY_NEW_FILE yyrestart( yyin )+#define YY_END_OF_BUFFER_CHAR 0++/* Size of default input buffer. */+#ifndef YY_BUF_SIZE+#ifdef __ia64__+/* On IA-64, the buffer size is 16k, not 8k.+ * Moreover, YY_BUF_SIZE is 2*YY_READ_BUF_SIZE in the general case.+ * Ditto for the __ia64__ case accordingly.+ */+#define YY_BUF_SIZE 32768+#else+#define YY_BUF_SIZE 16384+#endif /* __ia64__ */+#endif++/* The state buf must be large enough to hold one state per character in the main buffer.+ */+#define YY_STATE_BUF_SIZE ((YY_BUF_SIZE + 2) * sizeof(yy_state_type))++#ifndef YY_TYPEDEF_YY_BUFFER_STATE+#define YY_TYPEDEF_YY_BUFFER_STATE+typedef struct yy_buffer_state *YY_BUFFER_STATE;+#endif++#ifndef YY_TYPEDEF_YY_SIZE_T+#define YY_TYPEDEF_YY_SIZE_T+typedef size_t yy_size_t;+#endif++extern int yyleng;++extern FILE *yyin, *yyout;++#define EOB_ACT_CONTINUE_SCAN 0+#define EOB_ACT_END_OF_FILE 1+#define EOB_ACT_LAST_MATCH 2+ + #define YY_LESS_LINENO(n)+ #define YY_LINENO_REWIND_TO(ptr)+ +/* Return all but the first "n" matched characters back to the input stream. */+#define yyless(n) \+ do \+ { \+ /* Undo effects of setting up yytext. */ \+ int yyless_macro_arg = (n); \+ YY_LESS_LINENO(yyless_macro_arg);\+ *yy_cp = (yy_hold_char); \+ YY_RESTORE_YY_MORE_OFFSET \+ (yy_c_buf_p) = yy_cp = yy_bp + yyless_macro_arg - YY_MORE_ADJ; \+ YY_DO_BEFORE_ACTION; /* set up yytext again */ \+ } \+ while ( 0 )+#define unput(c) yyunput( c, (yytext_ptr) )++#ifndef YY_STRUCT_YY_BUFFER_STATE+#define YY_STRUCT_YY_BUFFER_STATE+struct yy_buffer_state+ {+ FILE *yy_input_file;++ char *yy_ch_buf; /* input buffer */+ char *yy_buf_pos; /* current position in input buffer */++ /* Size of input buffer in bytes, not including room for EOB+ * characters.+ */+ int yy_buf_size;++ /* Number of characters read into yy_ch_buf, not including EOB+ * characters.+ */+ int yy_n_chars;++ /* Whether we "own" the buffer - i.e., we know we created it,+ * and can realloc() it to grow it, and should free() it to+ * delete it.+ */+ int yy_is_our_buffer;++ /* Whether this is an "interactive" input source; if so, and+ * if we're using stdio for input, then we want to use getc()+ * instead of fread(), to make sure we stop fetching input after+ * each newline.+ */+ int yy_is_interactive;++ /* Whether we're considered to be at the beginning of a line.+ * If so, '^' rules will be active on the next match, otherwise+ * not.+ */+ int yy_at_bol;++ int yy_bs_lineno; /**< The line count. */+ int yy_bs_column; /**< The column count. */++ /* Whether to try to fill the input buffer when we reach the+ * end of it.+ */+ int yy_fill_buffer;++ int yy_buffer_status;++#define YY_BUFFER_NEW 0+#define YY_BUFFER_NORMAL 1+ /* When an EOF's been seen but there's still some text to process+ * then we mark the buffer as YY_EOF_PENDING, to indicate that we+ * shouldn't try reading from the input source any more. We might+ * still have a bunch of tokens to match, though, because of+ * possible backing-up.+ *+ * When we actually see the EOF, we change the status to "new"+ * (via yyrestart()), so that the user can continue scanning by+ * just pointing yyin at a new input file.+ */+#define YY_BUFFER_EOF_PENDING 2++ };+#endif /* !YY_STRUCT_YY_BUFFER_STATE */++/* Stack of input buffers. */+static size_t yy_buffer_stack_top = 0; /**< index of top of stack. */+static size_t yy_buffer_stack_max = 0; /**< capacity of stack. */+static YY_BUFFER_STATE * yy_buffer_stack = NULL; /**< Stack as an array. */++/* We provide macros for accessing buffer states in case in the+ * future we want to put the buffer states in a more general+ * "scanner state".+ *+ * Returns the top of the stack, or NULL.+ */+#define YY_CURRENT_BUFFER ( (yy_buffer_stack) \+ ? (yy_buffer_stack)[(yy_buffer_stack_top)] \+ : NULL)+/* Same as previous macro, but useful when we know that the buffer stack is not+ * NULL or when we need an lvalue. For internal use only.+ */+#define YY_CURRENT_BUFFER_LVALUE (yy_buffer_stack)[(yy_buffer_stack_top)]++/* yy_hold_char holds the character lost when yytext is formed. */+static char yy_hold_char;+static int yy_n_chars; /* number of characters read into yy_ch_buf */+int yyleng;++/* Points to current character in buffer. */+static char *yy_c_buf_p = NULL;+static int yy_init = 0; /* whether we need to initialize */+static int yy_start = 0; /* start state number */++/* Flag which is used to allow yywrap()'s to do buffer switches+ * instead of setting up a fresh yyin. A bit of a hack ...+ */+static int yy_did_buffer_switch_on_eof;++void yyrestart ( FILE *input_file );+void yy_switch_to_buffer ( YY_BUFFER_STATE new_buffer );+YY_BUFFER_STATE yy_create_buffer ( FILE *file, int size );+void yy_delete_buffer ( YY_BUFFER_STATE b );+void yy_flush_buffer ( YY_BUFFER_STATE b );+void yypush_buffer_state ( YY_BUFFER_STATE new_buffer );+void yypop_buffer_state ( void );++static void yyensure_buffer_stack ( void );+static void yy_load_buffer_state ( void );+static void yy_init_buffer ( YY_BUFFER_STATE b, FILE *file );+#define YY_FLUSH_BUFFER yy_flush_buffer( YY_CURRENT_BUFFER )++YY_BUFFER_STATE yy_scan_buffer ( char *base, yy_size_t size );+YY_BUFFER_STATE yy_scan_string ( const char *yy_str );+YY_BUFFER_STATE yy_scan_bytes ( const char *bytes, int len );++void *yyalloc ( yy_size_t );+void *yyrealloc ( void *, yy_size_t );+void yyfree ( void * );++#define yy_new_buffer yy_create_buffer+#define yy_set_interactive(is_interactive) \+ { \+ if ( ! YY_CURRENT_BUFFER ){ \+ yyensure_buffer_stack (); \+ YY_CURRENT_BUFFER_LVALUE = \+ yy_create_buffer( yyin, YY_BUF_SIZE ); \+ } \+ YY_CURRENT_BUFFER_LVALUE->yy_is_interactive = is_interactive; \+ }+#define yy_set_bol(at_bol) \+ { \+ if ( ! YY_CURRENT_BUFFER ){\+ yyensure_buffer_stack (); \+ YY_CURRENT_BUFFER_LVALUE = \+ yy_create_buffer( yyin, YY_BUF_SIZE ); \+ } \+ YY_CURRENT_BUFFER_LVALUE->yy_at_bol = at_bol; \+ }+#define YY_AT_BOL() (YY_CURRENT_BUFFER_LVALUE->yy_at_bol)++/* Begin user sect3 */++#define yywrap() (/*CONSTCOND*/1)+#define YY_SKIP_YYWRAP+typedef flex_uint8_t YY_CHAR;++FILE *yyin = NULL, *yyout = NULL;++typedef int yy_state_type;++extern int yylineno;+int yylineno = 1;++extern char *yytext;+#ifdef yytext_ptr+#undef yytext_ptr+#endif+#define yytext_ptr yytext++static yy_state_type yy_get_previous_state ( void );+static yy_state_type yy_try_NUL_trans ( yy_state_type current_state );+static int yy_get_next_buffer ( void );+static void yynoreturn yy_fatal_error ( const char* msg );++/* Done after the current pattern has been matched and before the+ * corresponding action - sets up yytext.+ */+#define YY_DO_BEFORE_ACTION \+ (yytext_ptr) = yy_bp; \+ yyleng = (int) (yy_cp - yy_bp); \+ (yy_hold_char) = *yy_cp; \+ *yy_cp = '\0'; \+ (yy_c_buf_p) = yy_cp;+#define YY_NUM_RULES 23+#define YY_END_OF_BUFFER 24+/* This struct is not used in this scanner,+ but its presence is necessary. */+struct yy_trans_info+ {+ flex_int32_t yy_verify;+ flex_int32_t yy_nxt;+ };+static const flex_int16_t yy_accept[64] =+ { 0,+ 0, 0, 24, 23, 1, 20, 23, 11, 12, 19,+ 23, 3, 4, 18, 17, 21, 15, 16, 10, 10,+ 10, 10, 10, 10, 13, 14, 1, 0, 0, 0,+ 4, 10, 10, 10, 10, 10, 10, 22, 0, 2,+ 10, 10, 6, 6, 10, 10, 10, 10, 8, 8,+ 10, 9, 9, 10, 10, 10, 7, 7, 10, 10,+ 5, 5, 0+ } ;++static const YY_CHAR yy_ec[256] =+ { 0,+ 1, 1, 1, 1, 1, 1, 1, 1, 2, 3,+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,+ 1, 2, 4, 1, 1, 1, 1, 1, 5, 6,+ 7, 1, 1, 8, 1, 1, 9, 10, 11, 12,+ 12, 12, 12, 12, 12, 12, 12, 13, 14, 1,+ 15, 1, 1, 1, 16, 16, 16, 17, 17, 16,+ 16, 16, 17, 16, 16, 17, 16, 16, 16, 16,+ 16, 17, 16, 17, 16, 16, 16, 16, 16, 16,+ 18, 19, 20, 1, 21, 1, 22, 21, 23, 21,++ 24, 25, 21, 26, 27, 21, 21, 28, 21, 29,+ 30, 21, 21, 31, 32, 33, 34, 35, 36, 21,+ 21, 21, 37, 1, 38, 1, 1, 1, 1, 1,+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,++ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,+ 1, 1, 1, 1, 1+ } ;++static const YY_CHAR yy_meta[39] =+ { 0,+ 1, 1, 2, 1, 3, 1, 1, 1, 1, 4,+ 5, 5, 1, 1, 1, 5, 5, 1, 1, 1,+ 5, 5, 5, 5, 4, 5, 5, 5, 4, 5,+ 4, 5, 4, 5, 4, 5, 1, 1+ } ;++static const flex_int16_t yy_base[68] =+ { 0,+ 0, 0, 268, 269, 37, 269, 248, 269, 269, 269,+ 257, 31, 34, 269, 269, 269, 269, 269, 0, 237,+ 230, 238, 240, 235, 269, 269, 45, 255, 254, 255,+ 39, 0, 225, 227, 51, 224, 227, 269, 250, 269,+ 228, 228, 269, 0, 87, 222, 123, 216, 269, 0,+ 224, 269, 0, 220, 159, 216, 269, 0, 204, 195,+ 269, 0, 269, 231, 233, 236, 240+ } ;++static const flex_int16_t yy_def[68] =+ { 0,+ 63, 1, 63, 63, 63, 63, 64, 63, 63, 63,+ 63, 63, 63, 63, 63, 63, 63, 63, 65, 65,+ 65, 65, 65, 65, 63, 63, 63, 63, 66, 67,+ 63, 65, 65, 65, 63, 65, 65, 63, 67, 63,+ 65, 65, 63, 65, 63, 65, 63, 65, 63, 65,+ 65, 63, 65, 65, 63, 65, 63, 65, 65, 63,+ 63, 65, 0, 63, 63, 63, 63+ } ;++static const flex_int16_t yy_nxt[308] =+ { 0,+ 4, 5, 5, 6, 7, 8, 9, 10, 11, 12,+ 12, 13, 14, 15, 16, 4, 4, 17, 4, 18,+ 19, 19, 19, 20, 21, 19, 22, 19, 19, 19,+ 19, 19, 19, 19, 23, 24, 25, 26, 27, 27,+ 31, 31, 31, 31, 31, 31, 27, 27, 31, 31,+ 31, 43, 43, 43, 43, 43, 43, 43, 43, 43,+ 44, 44, 44, 43, 43, 43, 44, 32, 43, 43,+ 43, 44, 44, 44, 44, 44, 44, 44, 44, 44,+ 44, 44, 44, 44, 44, 44, 44, 49, 49, 49,+ 49, 49, 49, 49, 49, 49, 50, 50, 50, 49,++ 49, 49, 50, 32, 49, 49, 49, 50, 50, 50,+ 50, 50, 50, 50, 50, 50, 50, 50, 50, 50,+ 50, 50, 50, 52, 52, 52, 52, 52, 52, 52,+ 52, 52, 53, 53, 53, 52, 52, 52, 53, 32,+ 52, 52, 52, 53, 53, 53, 53, 53, 53, 53,+ 53, 53, 53, 53, 53, 53, 53, 53, 53, 57,+ 57, 57, 57, 57, 57, 57, 57, 57, 58, 58,+ 58, 57, 57, 57, 58, 32, 57, 57, 57, 58,+ 58, 58, 58, 58, 58, 58, 58, 58, 58, 58,+ 58, 58, 58, 58, 58, 61, 61, 61, 61, 61,++ 61, 61, 61, 61, 62, 62, 62, 61, 61, 61,+ 62, 32, 61, 61, 61, 62, 62, 62, 62, 62,+ 62, 62, 62, 62, 62, 62, 62, 62, 62, 62,+ 62, 28, 60, 28, 28, 28, 32, 32, 28, 28,+ 39, 39, 39, 39, 39, 59, 56, 55, 54, 51,+ 48, 47, 40, 46, 45, 42, 41, 40, 38, 38,+ 37, 36, 35, 34, 33, 30, 29, 63, 3, 63,+ 63, 63, 63, 63, 63, 63, 63, 63, 63, 63,+ 63, 63, 63, 63, 63, 63, 63, 63, 63, 63,+ 63, 63, 63, 63, 63, 63, 63, 63, 63, 63,++ 63, 63, 63, 63, 63, 63, 63+ } ;++static const flex_int16_t yy_chk[308] =+ { 0,+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,+ 1, 1, 1, 1, 1, 1, 1, 1, 5, 5,+ 12, 12, 12, 13, 13, 13, 27, 27, 31, 31,+ 31, 35, 35, 35, 35, 35, 35, 35, 35, 35,+ 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,+ 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,+ 35, 35, 35, 35, 35, 35, 35, 45, 45, 45,+ 45, 45, 45, 45, 45, 45, 45, 45, 45, 45,++ 45, 45, 45, 45, 45, 45, 45, 45, 45, 45,+ 45, 45, 45, 45, 45, 45, 45, 45, 45, 45,+ 45, 45, 45, 47, 47, 47, 47, 47, 47, 47,+ 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,+ 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,+ 47, 47, 47, 47, 47, 47, 47, 47, 47, 55,+ 55, 55, 55, 55, 55, 55, 55, 55, 55, 55,+ 55, 55, 55, 55, 55, 55, 55, 55, 55, 55,+ 55, 55, 55, 55, 55, 55, 55, 55, 55, 55,+ 55, 55, 55, 55, 55, 60, 60, 60, 60, 60,++ 60, 60, 60, 60, 60, 60, 60, 60, 60, 60,+ 60, 60, 60, 60, 60, 60, 60, 60, 60, 60,+ 60, 60, 60, 60, 60, 60, 60, 60, 60, 60,+ 60, 64, 59, 64, 64, 64, 65, 65, 66, 66,+ 67, 67, 67, 67, 67, 56, 54, 51, 48, 46,+ 42, 41, 39, 37, 36, 34, 33, 30, 29, 28,+ 24, 23, 22, 21, 20, 11, 7, 3, 63, 63,+ 63, 63, 63, 63, 63, 63, 63, 63, 63, 63,+ 63, 63, 63, 63, 63, 63, 63, 63, 63, 63,+ 63, 63, 63, 63, 63, 63, 63, 63, 63, 63,++ 63, 63, 63, 63, 63, 63, 63+ } ;++static yy_state_type yy_last_accepting_state;+static char *yy_last_accepting_cpos;++extern int yy_flex_debug;+int yy_flex_debug = 0;++/* The intent behind this definition is that it'll catch+ * any uses of REJECT which flex missed.+ */+#define REJECT reject_used_but_not_detected+#define yymore() yymore_used_but_not_detected+#define YY_MORE_ADJ 0+#define YY_RESTORE_YY_MORE_OFFSET+char *yytext;+#line 1 "Nandlang.l"+#line 3 "Nandlang.l"+#include "Nandlang.tab.h"+#include "stdio.h"+void set_input_string(const char* in);+void end_lexical_scan(void);+#line 536 "lex.yy.c"+#line 537 "lex.yy.c"++#define INITIAL 0++#ifndef YY_NO_UNISTD_H+/* Special case for "unistd.h", since it is non-ANSI. We include it way+ * down here because we want the user's section 1 to have been scanned first.+ * The user has a chance to override it with an option.+ */+#include <unistd.h>+#endif++#ifndef YY_EXTRA_TYPE+#define YY_EXTRA_TYPE void *+#endif++static int yy_init_globals ( void );++/* Accessor methods to globals.+ These are made visible to non-reentrant scanners for convenience. */++int yylex_destroy ( void );++int yyget_debug ( void );++void yyset_debug ( int debug_flag );++YY_EXTRA_TYPE yyget_extra ( void );++void yyset_extra ( YY_EXTRA_TYPE user_defined );++FILE *yyget_in ( void );++void yyset_in ( FILE * _in_str );++FILE *yyget_out ( void );++void yyset_out ( FILE * _out_str );++ int yyget_leng ( void );++char *yyget_text ( void );++int yyget_lineno ( void );++void yyset_lineno ( int _line_number );++/* Macros after this point can all be overridden by user definitions in+ * section 1.+ */++#ifndef YY_SKIP_YYWRAP+#ifdef __cplusplus+extern "C" int yywrap ( void );+#else+extern int yywrap ( void );+#endif+#endif++#ifndef YY_NO_UNPUT+ + static void yyunput ( int c, char *buf_ptr );+ +#endif++#ifndef yytext_ptr+static void yy_flex_strncpy ( char *, const char *, int );+#endif++#ifdef YY_NEED_STRLEN+static int yy_flex_strlen ( const char * );+#endif++#ifndef YY_NO_INPUT+#ifdef __cplusplus+static int yyinput ( void );+#else+static int input ( void );+#endif++#endif++/* Amount of stuff to slurp up with each read. */+#ifndef YY_READ_BUF_SIZE+#ifdef __ia64__+/* On IA-64, the buffer size is 16k, not 8k */+#define YY_READ_BUF_SIZE 16384+#else+#define YY_READ_BUF_SIZE 8192+#endif /* __ia64__ */+#endif++/* Copy whatever the last rule matched to the standard output. */+#ifndef ECHO+/* This used to be an fputs(), but since the string might contain NUL's,+ * we now use fwrite().+ */+#define ECHO do { if (fwrite( yytext, (size_t) yyleng, 1, yyout )) {} } while (0)+#endif++/* Gets input and stuffs it into "buf". number of characters read, or YY_NULL,+ * is returned in "result".+ */+#ifndef YY_INPUT+#define YY_INPUT(buf,result,max_size) \+ if ( YY_CURRENT_BUFFER_LVALUE->yy_is_interactive ) \+ { \+ int c = '*'; \+ int n; \+ for ( n = 0; n < max_size && \+ (c = getc( yyin )) != EOF && c != '\n'; ++n ) \+ buf[n] = (char) c; \+ if ( c == '\n' ) \+ buf[n++] = (char) c; \+ if ( c == EOF && ferror( yyin ) ) \+ YY_FATAL_ERROR( "input in flex scanner failed" ); \+ result = n; \+ } \+ else \+ { \+ errno=0; \+ while ( (result = (int) fread(buf, 1, (yy_size_t) max_size, yyin)) == 0 && ferror(yyin)) \+ { \+ if( errno != EINTR) \+ { \+ YY_FATAL_ERROR( "input in flex scanner failed" ); \+ break; \+ } \+ errno=0; \+ clearerr(yyin); \+ } \+ }\+\++#endif++/* No semi-colon after return; correct usage is to write "yyterminate();" -+ * we don't want an extra ';' after the "return" because that will cause+ * some compilers to complain about unreachable statements.+ */+#ifndef yyterminate+#define yyterminate() return YY_NULL+#endif++/* Number of entries by which start-condition stack grows. */+#ifndef YY_START_STACK_INCR+#define YY_START_STACK_INCR 25+#endif++/* Report a fatal error. */+#ifndef YY_FATAL_ERROR+#define YY_FATAL_ERROR(msg) yy_fatal_error( msg )+#endif++/* end tables serialization structures and prototypes */++/* Default declaration of generated scanner - a define so the user can+ * easily add parameters.+ */+#ifndef YY_DECL+#define YY_DECL_IS_OURS 1++extern int yylex (void);++#define YY_DECL int yylex (void)+#endif /* !YY_DECL */++/* Code executed at the beginning of each rule, after yytext and yyleng+ * have been set up.+ */+#ifndef YY_USER_ACTION+#define YY_USER_ACTION+#endif++/* Code executed at the end of each rule. */+#ifndef YY_BREAK+#define YY_BREAK /*LINTED*/break;+#endif++#define YY_RULE_SETUP \+ YY_USER_ACTION++/** The main scanner function which does all the work.+ */+YY_DECL+{+ yy_state_type yy_current_state;+ char *yy_cp, *yy_bp;+ int yy_act;+ + if ( !(yy_init) )+ {+ (yy_init) = 1;++#ifdef YY_USER_INIT+ YY_USER_INIT;+#endif++ if ( ! (yy_start) )+ (yy_start) = 1; /* first start state */++ if ( ! yyin )+ yyin = stdin;++ if ( ! yyout )+ yyout = stdout;++ if ( ! YY_CURRENT_BUFFER ) {+ yyensure_buffer_stack ();+ YY_CURRENT_BUFFER_LVALUE =+ yy_create_buffer( yyin, YY_BUF_SIZE );+ }++ yy_load_buffer_state( );+ }++ {+#line 14 "Nandlang.l"++#line 756 "lex.yy.c"++ while ( /*CONSTCOND*/1 ) /* loops until end-of-file is reached */+ {+ yy_cp = (yy_c_buf_p);++ /* Support of yytext. */+ *yy_cp = (yy_hold_char);++ /* yy_bp points to the position in yy_ch_buf of the start of+ * the current run.+ */+ yy_bp = yy_cp;++ yy_current_state = (yy_start);+yy_match:+ do+ {+ YY_CHAR yy_c = yy_ec[YY_SC_TO_UI(*yy_cp)] ;+ if ( yy_accept[yy_current_state] )+ {+ (yy_last_accepting_state) = yy_current_state;+ (yy_last_accepting_cpos) = yy_cp;+ }+ while ( yy_chk[yy_base[yy_current_state] + yy_c] != yy_current_state )+ {+ yy_current_state = (int) yy_def[yy_current_state];+ if ( yy_current_state >= 64 )+ yy_c = yy_meta[yy_c];+ }+ yy_current_state = yy_nxt[yy_base[yy_current_state] + yy_c];+ ++yy_cp;+ }+ while ( yy_base[yy_current_state] != 269 );++yy_find_action:+ yy_act = yy_accept[yy_current_state];+ if ( yy_act == 0 )+ { /* have to back up */+ yy_cp = (yy_last_accepting_cpos);+ yy_current_state = (yy_last_accepting_state);+ yy_act = yy_accept[yy_current_state];+ }++ YY_DO_BEFORE_ACTION;++do_action: /* This label is used only to access EOF actions. */++ switch ( yy_act )+ { /* beginning of action switch */+ case 0: /* must back up */+ /* undo the effects of YY_DO_BEFORE_ACTION */+ *yy_cp = (yy_hold_char);+ yy_cp = (yy_last_accepting_cpos);+ yy_current_state = (yy_last_accepting_state);+ goto yy_find_action;++case 1:+/* rule 1 can match eol */+YY_RULE_SETUP+#line 15 "Nandlang.l"+;+ YY_BREAK+case 2:+/* rule 2 can match eol */+YY_RULE_SETUP+#line 16 "Nandlang.l"+;+ YY_BREAK+case 3:+YY_RULE_SETUP+#line 17 "Nandlang.l"+return BIT;+ YY_BREAK+case 4:+YY_RULE_SETUP+#line 18 "Nandlang.l"+return NAT;+ YY_BREAK+case 5:+/* rule 5 can match eol */+YY_RULE_SETUP+#line 19 "Nandlang.l"+return FUNCTION;+ YY_BREAK+case 6:+/* rule 6 can match eol */+YY_RULE_SETUP+#line 20 "Nandlang.l"+return IF;+ YY_BREAK+case 7:+/* rule 7 can match eol */+YY_RULE_SETUP+#line 21 "Nandlang.l"+return WHILE;+ YY_BREAK+case 8:+/* rule 8 can match eol */+YY_RULE_SETUP+#line 22 "Nandlang.l"+return VAR;+ YY_BREAK+case 9:+/* rule 9 can match eol */+YY_RULE_SETUP+#line 23 "Nandlang.l"+return ELSE;+ YY_BREAK+case 10:+YY_RULE_SETUP+#line 24 "Nandlang.l"+return IDENTIFIER;+ YY_BREAK+case 11:+YY_RULE_SETUP+#line 25 "Nandlang.l"+return '(';+ YY_BREAK+case 12:+YY_RULE_SETUP+#line 26 "Nandlang.l"+return ')';+ YY_BREAK+case 13:+YY_RULE_SETUP+#line 27 "Nandlang.l"+return '{';+ YY_BREAK+case 14:+YY_RULE_SETUP+#line 28 "Nandlang.l"+return '}';+ YY_BREAK+case 15:+YY_RULE_SETUP+#line 29 "Nandlang.l"+return '[';+ YY_BREAK+case 16:+YY_RULE_SETUP+#line 30 "Nandlang.l"+return ']';+ YY_BREAK+case 17:+YY_RULE_SETUP+#line 31 "Nandlang.l"+return ';';+ YY_BREAK+case 18:+YY_RULE_SETUP+#line 32 "Nandlang.l"+return ':';+ YY_BREAK+case 19:+YY_RULE_SETUP+#line 33 "Nandlang.l"+return ',';+ YY_BREAK+case 20:+YY_RULE_SETUP+#line 34 "Nandlang.l"+return '!';+ YY_BREAK+case 21:+YY_RULE_SETUP+#line 35 "Nandlang.l"+return '=';+ YY_BREAK+case 22:+YY_RULE_SETUP+#line 36 "Nandlang.l"+return CHAR;+ YY_BREAK+case 23:+YY_RULE_SETUP+#line 37 "Nandlang.l"+ECHO;+ YY_BREAK+#line 935 "lex.yy.c"+case YY_STATE_EOF(INITIAL):+ yyterminate();++ case YY_END_OF_BUFFER:+ {+ /* Amount of text matched not including the EOB char. */+ int yy_amount_of_matched_text = (int) (yy_cp - (yytext_ptr)) - 1;++ /* Undo the effects of YY_DO_BEFORE_ACTION. */+ *yy_cp = (yy_hold_char);+ YY_RESTORE_YY_MORE_OFFSET++ if ( YY_CURRENT_BUFFER_LVALUE->yy_buffer_status == YY_BUFFER_NEW )+ {+ /* We're scanning a new file or input source. It's+ * possible that this happened because the user+ * just pointed yyin at a new source and called+ * yylex(). If so, then we have to assure+ * consistency between YY_CURRENT_BUFFER and our+ * globals. Here is the right place to do so, because+ * this is the first action (other than possibly a+ * back-up) that will match for the new input source.+ */+ (yy_n_chars) = YY_CURRENT_BUFFER_LVALUE->yy_n_chars;+ YY_CURRENT_BUFFER_LVALUE->yy_input_file = yyin;+ YY_CURRENT_BUFFER_LVALUE->yy_buffer_status = YY_BUFFER_NORMAL;+ }++ /* Note that here we test for yy_c_buf_p "<=" to the position+ * of the first EOB in the buffer, since yy_c_buf_p will+ * already have been incremented past the NUL character+ * (since all states make transitions on EOB to the+ * end-of-buffer state). Contrast this with the test+ * in input().+ */+ if ( (yy_c_buf_p) <= &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars)] )+ { /* This was really a NUL. */+ yy_state_type yy_next_state;++ (yy_c_buf_p) = (yytext_ptr) + yy_amount_of_matched_text;++ yy_current_state = yy_get_previous_state( );++ /* Okay, we're now positioned to make the NUL+ * transition. We couldn't have+ * yy_get_previous_state() go ahead and do it+ * for us because it doesn't know how to deal+ * with the possibility of jamming (and we don't+ * want to build jamming into it because then it+ * will run more slowly).+ */++ yy_next_state = yy_try_NUL_trans( yy_current_state );++ yy_bp = (yytext_ptr) + YY_MORE_ADJ;++ if ( yy_next_state )+ {+ /* Consume the NUL. */+ yy_cp = ++(yy_c_buf_p);+ yy_current_state = yy_next_state;+ goto yy_match;+ }++ else+ {+ yy_cp = (yy_c_buf_p);+ goto yy_find_action;+ }+ }++ else switch ( yy_get_next_buffer( ) )+ {+ case EOB_ACT_END_OF_FILE:+ {+ (yy_did_buffer_switch_on_eof) = 0;++ if ( yywrap( ) )+ {+ /* Note: because we've taken care in+ * yy_get_next_buffer() to have set up+ * yytext, we can now set up+ * yy_c_buf_p so that if some total+ * hoser (like flex itself) wants to+ * call the scanner after we return the+ * YY_NULL, it'll still work - another+ * YY_NULL will get returned.+ */+ (yy_c_buf_p) = (yytext_ptr) + YY_MORE_ADJ;++ yy_act = YY_STATE_EOF(YY_START);+ goto do_action;+ }++ else+ {+ if ( ! (yy_did_buffer_switch_on_eof) )+ YY_NEW_FILE;+ }+ break;+ }++ case EOB_ACT_CONTINUE_SCAN:+ (yy_c_buf_p) =+ (yytext_ptr) + yy_amount_of_matched_text;++ yy_current_state = yy_get_previous_state( );++ yy_cp = (yy_c_buf_p);+ yy_bp = (yytext_ptr) + YY_MORE_ADJ;+ goto yy_match;++ case EOB_ACT_LAST_MATCH:+ (yy_c_buf_p) =+ &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars)];++ yy_current_state = yy_get_previous_state( );++ yy_cp = (yy_c_buf_p);+ yy_bp = (yytext_ptr) + YY_MORE_ADJ;+ goto yy_find_action;+ }+ break;+ }++ default:+ YY_FATAL_ERROR(+ "fatal flex scanner internal error--no action found" );+ } /* end of action switch */+ } /* end of scanning one token */+ } /* end of user's declarations */+} /* end of yylex */++/* yy_get_next_buffer - try to read in a new buffer+ *+ * Returns a code representing an action:+ * EOB_ACT_LAST_MATCH -+ * EOB_ACT_CONTINUE_SCAN - continue scanning from current position+ * EOB_ACT_END_OF_FILE - end of file+ */+static int yy_get_next_buffer (void)+{+ char *dest = YY_CURRENT_BUFFER_LVALUE->yy_ch_buf;+ char *source = (yytext_ptr);+ int number_to_move, i;+ int ret_val;++ if ( (yy_c_buf_p) > &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars) + 1] )+ YY_FATAL_ERROR(+ "fatal flex scanner internal error--end of buffer missed" );++ if ( YY_CURRENT_BUFFER_LVALUE->yy_fill_buffer == 0 )+ { /* Don't try to fill the buffer, so this is an EOF. */+ if ( (yy_c_buf_p) - (yytext_ptr) - YY_MORE_ADJ == 1 )+ {+ /* We matched a single character, the EOB, so+ * treat this as a final EOF.+ */+ return EOB_ACT_END_OF_FILE;+ }++ else+ {+ /* We matched some text prior to the EOB, first+ * process it.+ */+ return EOB_ACT_LAST_MATCH;+ }+ }++ /* Try to read more data. */++ /* First move last chars to start of buffer. */+ number_to_move = (int) ((yy_c_buf_p) - (yytext_ptr) - 1);++ for ( i = 0; i < number_to_move; ++i )+ *(dest++) = *(source++);++ if ( YY_CURRENT_BUFFER_LVALUE->yy_buffer_status == YY_BUFFER_EOF_PENDING )+ /* don't do the read, it's not guaranteed to return an EOF,+ * just force an EOF+ */+ YY_CURRENT_BUFFER_LVALUE->yy_n_chars = (yy_n_chars) = 0;++ else+ {+ int num_to_read =+ YY_CURRENT_BUFFER_LVALUE->yy_buf_size - number_to_move - 1;++ while ( num_to_read <= 0 )+ { /* Not enough room in the buffer - grow it. */++ /* just a shorter name for the current buffer */+ YY_BUFFER_STATE b = YY_CURRENT_BUFFER_LVALUE;++ int yy_c_buf_p_offset =+ (int) ((yy_c_buf_p) - b->yy_ch_buf);++ if ( b->yy_is_our_buffer )+ {+ int new_size = b->yy_buf_size * 2;++ if ( new_size <= 0 )+ b->yy_buf_size += b->yy_buf_size / 8;+ else+ b->yy_buf_size *= 2;++ b->yy_ch_buf = (char *)+ /* Include room in for 2 EOB chars. */+ yyrealloc( (void *) b->yy_ch_buf,+ (yy_size_t) (b->yy_buf_size + 2) );+ }+ else+ /* Can't grow it, we don't own it. */+ b->yy_ch_buf = NULL;++ if ( ! b->yy_ch_buf )+ YY_FATAL_ERROR(+ "fatal error - scanner input buffer overflow" );++ (yy_c_buf_p) = &b->yy_ch_buf[yy_c_buf_p_offset];++ num_to_read = YY_CURRENT_BUFFER_LVALUE->yy_buf_size -+ number_to_move - 1;++ }++ if ( num_to_read > YY_READ_BUF_SIZE )+ num_to_read = YY_READ_BUF_SIZE;++ /* Read in more data. */+ YY_INPUT( (&YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[number_to_move]),+ (yy_n_chars), num_to_read );++ YY_CURRENT_BUFFER_LVALUE->yy_n_chars = (yy_n_chars);+ }++ if ( (yy_n_chars) == 0 )+ {+ if ( number_to_move == YY_MORE_ADJ )+ {+ ret_val = EOB_ACT_END_OF_FILE;+ yyrestart( yyin );+ }++ else+ {+ ret_val = EOB_ACT_LAST_MATCH;+ YY_CURRENT_BUFFER_LVALUE->yy_buffer_status =+ YY_BUFFER_EOF_PENDING;+ }+ }++ else+ ret_val = EOB_ACT_CONTINUE_SCAN;++ if (((yy_n_chars) + number_to_move) > YY_CURRENT_BUFFER_LVALUE->yy_buf_size) {+ /* Extend the array by 50%, plus the number we really need. */+ int new_size = (yy_n_chars) + number_to_move + ((yy_n_chars) >> 1);+ YY_CURRENT_BUFFER_LVALUE->yy_ch_buf = (char *) yyrealloc(+ (void *) YY_CURRENT_BUFFER_LVALUE->yy_ch_buf, (yy_size_t) new_size );+ if ( ! YY_CURRENT_BUFFER_LVALUE->yy_ch_buf )+ YY_FATAL_ERROR( "out of dynamic memory in yy_get_next_buffer()" );+ /* "- 2" to take care of EOB's */+ YY_CURRENT_BUFFER_LVALUE->yy_buf_size = (int) (new_size - 2);+ }++ (yy_n_chars) += number_to_move;+ YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars)] = YY_END_OF_BUFFER_CHAR;+ YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars) + 1] = YY_END_OF_BUFFER_CHAR;++ (yytext_ptr) = &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[0];++ return ret_val;+}++/* yy_get_previous_state - get the state just before the EOB char was reached */++ static yy_state_type yy_get_previous_state (void)+{+ yy_state_type yy_current_state;+ char *yy_cp;+ + yy_current_state = (yy_start);++ for ( yy_cp = (yytext_ptr) + YY_MORE_ADJ; yy_cp < (yy_c_buf_p); ++yy_cp )+ {+ YY_CHAR yy_c = (*yy_cp ? yy_ec[YY_SC_TO_UI(*yy_cp)] : 1);+ if ( yy_accept[yy_current_state] )+ {+ (yy_last_accepting_state) = yy_current_state;+ (yy_last_accepting_cpos) = yy_cp;+ }+ while ( yy_chk[yy_base[yy_current_state] + yy_c] != yy_current_state )+ {+ yy_current_state = (int) yy_def[yy_current_state];+ if ( yy_current_state >= 64 )+ yy_c = yy_meta[yy_c];+ }+ yy_current_state = yy_nxt[yy_base[yy_current_state] + yy_c];+ }++ return yy_current_state;+}++/* yy_try_NUL_trans - try to make a transition on the NUL character+ *+ * synopsis+ * next_state = yy_try_NUL_trans( current_state );+ */+ static yy_state_type yy_try_NUL_trans (yy_state_type yy_current_state )+{+ int yy_is_jam;+ char *yy_cp = (yy_c_buf_p);++ YY_CHAR yy_c = 1;+ if ( yy_accept[yy_current_state] )+ {+ (yy_last_accepting_state) = yy_current_state;+ (yy_last_accepting_cpos) = yy_cp;+ }+ while ( yy_chk[yy_base[yy_current_state] + yy_c] != yy_current_state )+ {+ yy_current_state = (int) yy_def[yy_current_state];+ if ( yy_current_state >= 64 )+ yy_c = yy_meta[yy_c];+ }+ yy_current_state = yy_nxt[yy_base[yy_current_state] + yy_c];+ yy_is_jam = (yy_current_state == 63);++ return yy_is_jam ? 0 : yy_current_state;+}++#ifndef YY_NO_UNPUT++ static void yyunput (int c, char * yy_bp )+{+ char *yy_cp;+ + yy_cp = (yy_c_buf_p);++ /* undo effects of setting up yytext */+ *yy_cp = (yy_hold_char);++ if ( yy_cp < YY_CURRENT_BUFFER_LVALUE->yy_ch_buf + 2 )+ { /* need to shift things up to make room */+ /* +2 for EOB chars. */+ int number_to_move = (yy_n_chars) + 2;+ char *dest = &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[+ YY_CURRENT_BUFFER_LVALUE->yy_buf_size + 2];+ char *source =+ &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[number_to_move];++ while ( source > YY_CURRENT_BUFFER_LVALUE->yy_ch_buf )+ *--dest = *--source;++ yy_cp += (int) (dest - source);+ yy_bp += (int) (dest - source);+ YY_CURRENT_BUFFER_LVALUE->yy_n_chars =+ (yy_n_chars) = (int) YY_CURRENT_BUFFER_LVALUE->yy_buf_size;++ if ( yy_cp < YY_CURRENT_BUFFER_LVALUE->yy_ch_buf + 2 )+ YY_FATAL_ERROR( "flex scanner push-back overflow" );+ }++ *--yy_cp = (char) c;++ (yytext_ptr) = yy_bp;+ (yy_hold_char) = *yy_cp;+ (yy_c_buf_p) = yy_cp;+}++#endif++#ifndef YY_NO_INPUT+#ifdef __cplusplus+ static int yyinput (void)+#else+ static int input (void)+#endif++{+ int c;+ + *(yy_c_buf_p) = (yy_hold_char);++ if ( *(yy_c_buf_p) == YY_END_OF_BUFFER_CHAR )+ {+ /* yy_c_buf_p now points to the character we want to return.+ * If this occurs *before* the EOB characters, then it's a+ * valid NUL; if not, then we've hit the end of the buffer.+ */+ if ( (yy_c_buf_p) < &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars)] )+ /* This was really a NUL. */+ *(yy_c_buf_p) = '\0';++ else+ { /* need more input */+ int offset = (int) ((yy_c_buf_p) - (yytext_ptr));+ ++(yy_c_buf_p);++ switch ( yy_get_next_buffer( ) )+ {+ case EOB_ACT_LAST_MATCH:+ /* This happens because yy_g_n_b()+ * sees that we've accumulated a+ * token and flags that we need to+ * try matching the token before+ * proceeding. But for input(),+ * there's no matching to consider.+ * So convert the EOB_ACT_LAST_MATCH+ * to EOB_ACT_END_OF_FILE.+ */++ /* Reset buffer status. */+ yyrestart( yyin );++ /*FALLTHROUGH*/++ case EOB_ACT_END_OF_FILE:+ {+ if ( yywrap( ) )+ return 0;++ if ( ! (yy_did_buffer_switch_on_eof) )+ YY_NEW_FILE;+#ifdef __cplusplus+ return yyinput();+#else+ return input();+#endif+ }++ case EOB_ACT_CONTINUE_SCAN:+ (yy_c_buf_p) = (yytext_ptr) + offset;+ break;+ }+ }+ }++ c = *(unsigned char *) (yy_c_buf_p); /* cast for 8-bit char's */+ *(yy_c_buf_p) = '\0'; /* preserve yytext */+ (yy_hold_char) = *++(yy_c_buf_p);++ return c;+}+#endif /* ifndef YY_NO_INPUT */++/** Immediately switch to a different input stream.+ * @param input_file A readable stream.+ * + * @note This function does not reset the start condition to @c INITIAL .+ */+ void yyrestart (FILE * input_file )+{+ + if ( ! YY_CURRENT_BUFFER ){+ yyensure_buffer_stack ();+ YY_CURRENT_BUFFER_LVALUE =+ yy_create_buffer( yyin, YY_BUF_SIZE );+ }++ yy_init_buffer( YY_CURRENT_BUFFER, input_file );+ yy_load_buffer_state( );+}++/** Switch to a different input buffer.+ * @param new_buffer The new input buffer.+ * + */+ void yy_switch_to_buffer (YY_BUFFER_STATE new_buffer )+{+ + /* TODO. We should be able to replace this entire function body+ * with+ * yypop_buffer_state();+ * yypush_buffer_state(new_buffer);+ */+ yyensure_buffer_stack ();+ if ( YY_CURRENT_BUFFER == new_buffer )+ return;++ if ( YY_CURRENT_BUFFER )+ {+ /* Flush out information for old buffer. */+ *(yy_c_buf_p) = (yy_hold_char);+ YY_CURRENT_BUFFER_LVALUE->yy_buf_pos = (yy_c_buf_p);+ YY_CURRENT_BUFFER_LVALUE->yy_n_chars = (yy_n_chars);+ }++ YY_CURRENT_BUFFER_LVALUE = new_buffer;+ yy_load_buffer_state( );++ /* We don't actually know whether we did this switch during+ * EOF (yywrap()) processing, but the only time this flag+ * is looked at is after yywrap() is called, so it's safe+ * to go ahead and always set it.+ */+ (yy_did_buffer_switch_on_eof) = 1;+}++static void yy_load_buffer_state (void)+{+ (yy_n_chars) = YY_CURRENT_BUFFER_LVALUE->yy_n_chars;+ (yytext_ptr) = (yy_c_buf_p) = YY_CURRENT_BUFFER_LVALUE->yy_buf_pos;+ yyin = YY_CURRENT_BUFFER_LVALUE->yy_input_file;+ (yy_hold_char) = *(yy_c_buf_p);+}++/** Allocate and initialize an input buffer state.+ * @param file A readable stream.+ * @param size The character buffer size in bytes. When in doubt, use @c YY_BUF_SIZE.+ * + * @return the allocated buffer state.+ */+ YY_BUFFER_STATE yy_create_buffer (FILE * file, int size )+{+ YY_BUFFER_STATE b;+ + b = (YY_BUFFER_STATE) yyalloc( sizeof( struct yy_buffer_state ) );+ if ( ! b )+ YY_FATAL_ERROR( "out of dynamic memory in yy_create_buffer()" );++ b->yy_buf_size = size;++ /* yy_ch_buf has to be 2 characters longer than the size given because+ * we need to put in 2 end-of-buffer characters.+ */+ b->yy_ch_buf = (char *) yyalloc( (yy_size_t) (b->yy_buf_size + 2) );+ if ( ! b->yy_ch_buf )+ YY_FATAL_ERROR( "out of dynamic memory in yy_create_buffer()" );++ b->yy_is_our_buffer = 1;++ yy_init_buffer( b, file );++ return b;+}++/** Destroy the buffer.+ * @param b a buffer created with yy_create_buffer()+ * + */+ void yy_delete_buffer (YY_BUFFER_STATE b )+{+ + if ( ! b )+ return;++ if ( b == YY_CURRENT_BUFFER ) /* Not sure if we should pop here. */+ YY_CURRENT_BUFFER_LVALUE = (YY_BUFFER_STATE) 0;++ if ( b->yy_is_our_buffer )+ yyfree( (void *) b->yy_ch_buf );++ yyfree( (void *) b );+}++/* Initializes or reinitializes a buffer.+ * This function is sometimes called more than once on the same buffer,+ * such as during a yyrestart() or at EOF.+ */+ static void yy_init_buffer (YY_BUFFER_STATE b, FILE * file )++{+ int oerrno = errno;+ + yy_flush_buffer( b );++ b->yy_input_file = file;+ b->yy_fill_buffer = 1;++ /* If b is the current buffer, then yy_init_buffer was _probably_+ * called from yyrestart() or through yy_get_next_buffer.+ * In that case, we don't want to reset the lineno or column.+ */+ if (b != YY_CURRENT_BUFFER){+ b->yy_bs_lineno = 1;+ b->yy_bs_column = 0;+ }++ b->yy_is_interactive = file ? (isatty( fileno(file) ) > 0) : 0;+ + errno = oerrno;+}++/** Discard all buffered characters. On the next scan, YY_INPUT will be called.+ * @param b the buffer state to be flushed, usually @c YY_CURRENT_BUFFER.+ * + */+ void yy_flush_buffer (YY_BUFFER_STATE b )+{+ if ( ! b )+ return;++ b->yy_n_chars = 0;++ /* We always need two end-of-buffer characters. The first causes+ * a transition to the end-of-buffer state. The second causes+ * a jam in that state.+ */+ b->yy_ch_buf[0] = YY_END_OF_BUFFER_CHAR;+ b->yy_ch_buf[1] = YY_END_OF_BUFFER_CHAR;++ b->yy_buf_pos = &b->yy_ch_buf[0];++ b->yy_at_bol = 1;+ b->yy_buffer_status = YY_BUFFER_NEW;++ if ( b == YY_CURRENT_BUFFER )+ yy_load_buffer_state( );+}++/** Pushes the new state onto the stack. The new state becomes+ * the current state. This function will allocate the stack+ * if necessary.+ * @param new_buffer The new state.+ * + */+void yypush_buffer_state (YY_BUFFER_STATE new_buffer )+{+ if (new_buffer == NULL)+ return;++ yyensure_buffer_stack();++ /* This block is copied from yy_switch_to_buffer. */+ if ( YY_CURRENT_BUFFER )+ {+ /* Flush out information for old buffer. */+ *(yy_c_buf_p) = (yy_hold_char);+ YY_CURRENT_BUFFER_LVALUE->yy_buf_pos = (yy_c_buf_p);+ YY_CURRENT_BUFFER_LVALUE->yy_n_chars = (yy_n_chars);+ }++ /* Only push if top exists. Otherwise, replace top. */+ if (YY_CURRENT_BUFFER)+ (yy_buffer_stack_top)++;+ YY_CURRENT_BUFFER_LVALUE = new_buffer;++ /* copied from yy_switch_to_buffer. */+ yy_load_buffer_state( );+ (yy_did_buffer_switch_on_eof) = 1;+}++/** Removes and deletes the top of the stack, if present.+ * The next element becomes the new top.+ * + */+void yypop_buffer_state (void)+{+ if (!YY_CURRENT_BUFFER)+ return;++ yy_delete_buffer(YY_CURRENT_BUFFER );+ YY_CURRENT_BUFFER_LVALUE = NULL;+ if ((yy_buffer_stack_top) > 0)+ --(yy_buffer_stack_top);++ if (YY_CURRENT_BUFFER) {+ yy_load_buffer_state( );+ (yy_did_buffer_switch_on_eof) = 1;+ }+}++/* Allocates the stack if it does not exist.+ * Guarantees space for at least one push.+ */+static void yyensure_buffer_stack (void)+{+ yy_size_t num_to_alloc;+ + if (!(yy_buffer_stack)) {++ /* First allocation is just for 2 elements, since we don't know if this+ * scanner will even need a stack. We use 2 instead of 1 to avoid an+ * immediate realloc on the next call.+ */+ num_to_alloc = 1; /* After all that talk, this was set to 1 anyways... */+ (yy_buffer_stack) = (struct yy_buffer_state**)yyalloc+ (num_to_alloc * sizeof(struct yy_buffer_state*)+ );+ if ( ! (yy_buffer_stack) )+ YY_FATAL_ERROR( "out of dynamic memory in yyensure_buffer_stack()" );++ memset((yy_buffer_stack), 0, num_to_alloc * sizeof(struct yy_buffer_state*));++ (yy_buffer_stack_max) = num_to_alloc;+ (yy_buffer_stack_top) = 0;+ return;+ }++ if ((yy_buffer_stack_top) >= ((yy_buffer_stack_max)) - 1){++ /* Increase the buffer to prepare for a possible push. */+ yy_size_t grow_size = 8 /* arbitrary grow size */;++ num_to_alloc = (yy_buffer_stack_max) + grow_size;+ (yy_buffer_stack) = (struct yy_buffer_state**)yyrealloc+ ((yy_buffer_stack),+ num_to_alloc * sizeof(struct yy_buffer_state*)+ );+ if ( ! (yy_buffer_stack) )+ YY_FATAL_ERROR( "out of dynamic memory in yyensure_buffer_stack()" );++ /* zero only the new slots.*/+ memset((yy_buffer_stack) + (yy_buffer_stack_max), 0, grow_size * sizeof(struct yy_buffer_state*));+ (yy_buffer_stack_max) = num_to_alloc;+ }+}++/** Setup the input buffer state to scan directly from a user-specified character buffer.+ * @param base the character buffer+ * @param size the size in bytes of the character buffer+ * + * @return the newly allocated buffer state object.+ */+YY_BUFFER_STATE yy_scan_buffer (char * base, yy_size_t size )+{+ YY_BUFFER_STATE b;+ + if ( size < 2 ||+ base[size-2] != YY_END_OF_BUFFER_CHAR ||+ base[size-1] != YY_END_OF_BUFFER_CHAR )+ /* They forgot to leave room for the EOB's. */+ return NULL;++ b = (YY_BUFFER_STATE) yyalloc( sizeof( struct yy_buffer_state ) );+ if ( ! b )+ YY_FATAL_ERROR( "out of dynamic memory in yy_scan_buffer()" );++ b->yy_buf_size = (int) (size - 2); /* "- 2" to take care of EOB's */+ b->yy_buf_pos = b->yy_ch_buf = base;+ b->yy_is_our_buffer = 0;+ b->yy_input_file = NULL;+ b->yy_n_chars = b->yy_buf_size;+ b->yy_is_interactive = 0;+ b->yy_at_bol = 1;+ b->yy_fill_buffer = 0;+ b->yy_buffer_status = YY_BUFFER_NEW;++ yy_switch_to_buffer( b );++ return b;+}++/** Setup the input buffer state to scan a string. The next call to yylex() will+ * scan from a @e copy of @a str.+ * @param yystr a NUL-terminated string to scan+ * + * @return the newly allocated buffer state object.+ * @note If you want to scan bytes that may contain NUL values, then use+ * yy_scan_bytes() instead.+ */+YY_BUFFER_STATE yy_scan_string (const char * yystr )+{+ + return yy_scan_bytes( yystr, (int) strlen(yystr) );+}++/** Setup the input buffer state to scan the given bytes. The next call to yylex() will+ * scan from a @e copy of @a bytes.+ * @param yybytes the byte buffer to scan+ * @param _yybytes_len the number of bytes in the buffer pointed to by @a bytes.+ * + * @return the newly allocated buffer state object.+ */+YY_BUFFER_STATE yy_scan_bytes (const char * yybytes, int _yybytes_len )+{+ YY_BUFFER_STATE b;+ char *buf;+ yy_size_t n;+ int i;+ + /* Get memory for full buffer, including space for trailing EOB's. */+ n = (yy_size_t) (_yybytes_len + 2);+ buf = (char *) yyalloc( n );+ if ( ! buf )+ YY_FATAL_ERROR( "out of dynamic memory in yy_scan_bytes()" );++ for ( i = 0; i < _yybytes_len; ++i )+ buf[i] = yybytes[i];++ buf[_yybytes_len] = buf[_yybytes_len+1] = YY_END_OF_BUFFER_CHAR;++ b = yy_scan_buffer( buf, n );+ if ( ! b )+ YY_FATAL_ERROR( "bad buffer in yy_scan_bytes()" );++ /* It's okay to grow etc. this buffer, and we should throw it+ * away when we're done.+ */+ b->yy_is_our_buffer = 1;++ return b;+}++#ifndef YY_EXIT_FAILURE+#define YY_EXIT_FAILURE 2+#endif++static void yynoreturn yy_fatal_error (const char* msg )+{+ fprintf( stderr, "%s\n", msg );+ exit( YY_EXIT_FAILURE );+}++/* Redefine yyless() so it works in section 3 code. */++#undef yyless+#define yyless(n) \+ do \+ { \+ /* Undo effects of setting up yytext. */ \+ int yyless_macro_arg = (n); \+ YY_LESS_LINENO(yyless_macro_arg);\+ yytext[yyleng] = (yy_hold_char); \+ (yy_c_buf_p) = yytext + yyless_macro_arg; \+ (yy_hold_char) = *(yy_c_buf_p); \+ *(yy_c_buf_p) = '\0'; \+ yyleng = yyless_macro_arg; \+ } \+ while ( 0 )++/* Accessor methods (get/set functions) to struct members. */++/** Get the current line number.+ * + */+int yyget_lineno (void)+{+ + return yylineno;+}++/** Get the input stream.+ * + */+FILE *yyget_in (void)+{+ return yyin;+}++/** Get the output stream.+ * + */+FILE *yyget_out (void)+{+ return yyout;+}++/** Get the length of the current token.+ * + */+int yyget_leng (void)+{+ return yyleng;+}++/** Get the current token.+ * + */++char *yyget_text (void)+{+ return yytext;+}++/** Set the current line number.+ * @param _line_number line number+ * + */+void yyset_lineno (int _line_number )+{+ + yylineno = _line_number;+}++/** Set the input stream. This does not discard the current+ * input buffer.+ * @param _in_str A readable stream.+ * + * @see yy_switch_to_buffer+ */+void yyset_in (FILE * _in_str )+{+ yyin = _in_str ;+}++void yyset_out (FILE * _out_str )+{+ yyout = _out_str ;+}++int yyget_debug (void)+{+ return yy_flex_debug;+}++void yyset_debug (int _bdebug )+{+ yy_flex_debug = _bdebug ;+}++static int yy_init_globals (void)+{+ /* Initialization is the same as for the non-reentrant scanner.+ * This function is called from yylex_destroy(), so don't allocate here.+ */++ (yy_buffer_stack) = NULL;+ (yy_buffer_stack_top) = 0;+ (yy_buffer_stack_max) = 0;+ (yy_c_buf_p) = NULL;+ (yy_init) = 0;+ (yy_start) = 0;++/* Defined in main.c */+#ifdef YY_STDINIT+ yyin = stdin;+ yyout = stdout;+#else+ yyin = NULL;+ yyout = NULL;+#endif++ /* For future reference: Set errno on error, since we are called by+ * yylex_init()+ */+ return 0;+}++/* yylex_destroy is for both reentrant and non-reentrant scanners. */+int yylex_destroy (void)+{+ + /* Pop the buffer stack, destroying each element. */+ while(YY_CURRENT_BUFFER){+ yy_delete_buffer( YY_CURRENT_BUFFER );+ YY_CURRENT_BUFFER_LVALUE = NULL;+ yypop_buffer_state();+ }++ /* Destroy the stack itself. */+ yyfree((yy_buffer_stack) );+ (yy_buffer_stack) = NULL;++ /* Reset the globals. This is important in a non-reentrant scanner so the next time+ * yylex() is called, initialization will occur. */+ yy_init_globals( );++ return 0;+}++/*+ * Internal utility routines.+ */++#ifndef yytext_ptr+static void yy_flex_strncpy (char* s1, const char * s2, int n )+{+ + int i;+ for ( i = 0; i < n; ++i )+ s1[i] = s2[i];+}+#endif++#ifdef YY_NEED_STRLEN+static int yy_flex_strlen (const char * s )+{+ int n;+ for ( n = 0; s[n]; ++n )+ ;++ return n;+}+#endif++void *yyalloc (yy_size_t size )+{+ return malloc(size);+}++void *yyrealloc (void * ptr, yy_size_t size )+{+ + /* The cast to (char *) in the following accommodates both+ * implementations that use char* generic pointers, and those+ * that use void* generic pointers. It works with the latter+ * because both ANSI C and C++ allow castless assignment from+ * any pointer type to void*, and deal with argument conversions+ * as though doing an assignment.+ */+ return realloc(ptr, size);+}++void yyfree (void * ptr )+{+ free( (char *) ptr ); /* see yyrealloc() for (char *) cast */+}++#define YYTABLES_NAME "yytables"++#line 37 "Nandlang.l"+++void set_input_string(const char* in) {+ yy_scan_string(in);+}++void end_lexical_scan(void) {+ yy_delete_buffer(YY_CURRENT_BUFFER);+}+
+ benchmarks/NandlangBench/Main.hs view
@@ -0,0 +1,28 @@+{-# LANGUAGE TemplateHaskell,+ ScopedTypeVariables,+ TypeFamilies,+ UnboxedTuples,+ TypeApplications #-}+module Main where+import Criterion.Main (Benchmark, bgroup, defaultMain)+import Control.DeepSeq (NFData)+import Data.ByteString (ByteString)+--import Parsley.Internal.Verbose ()+import qualified NandlangBench.Parsley.Parser+import qualified NandlangBench.Bison.Parser+import qualified Parsley+import Shared.BenchmarkUtils++main :: IO ()+main = defaultMain [nandlang]++nandParsleyB :: ByteString -> Maybe ()+nandParsleyB = $$(Parsley.runParser NandlangBench.Parsley.Parser.nandlang)++nandlang :: Benchmark+nandlang =+ let nandTest :: NFData rep => (FilePath -> IO rep) -> String -> (rep -> Maybe ()) -> Benchmark+ nandTest = benchmark ["benchmarks/inputs/fibonacci.nand", "benchmarks/inputs/fizzbuzz.nand", "benchmarks/inputs/arrays.nand"]+ in bgroup "Nandlang"+ [ nandTest bytestring "Parsley" nandParsleyB+ , nandTest bytestring "Bison" NandlangBench.Bison.Parser.nand ]
+ benchmarks/NandlangBench/Parsley/Functions.hs view
@@ -0,0 +1,19 @@+module NandlangBench.Parsley.Functions where++import Data.Char (isAlpha, isAlphaNum)+import Data.Set (fromList, member)++nandIdentStart :: Char -> Bool+nandIdentStart c = isAlpha c || c == '_'++nandIdentLetter :: Char -> Bool+nandIdentLetter c = isAlphaNum c || c == '_'++nandUnreservedName :: String -> Bool+nandUnreservedName = \s -> not (member s keys)+ where+ keys = fromList ["if", "else", "while",+ "function", "var"]++nandStringLetter :: Char -> Bool+nandStringLetter c = (c /= '"') && (c /= '\\') && (c > '\026')
+ benchmarks/NandlangBench/Parsley/Parser.hs view
@@ -0,0 +1,103 @@+{-# OPTIONS_GHC -fplugin=Parsley.OverloadedQuotesPlugin #-}+{-# LANGUAGE TemplateHaskellQuotes #-}+{-# LANGUAGE DeriveLift #-}+{-# LANGUAGE StandaloneDeriving #-}+module NandlangBench.Parsley.Parser where++import Prelude hiding (fmap, pure, (<*), (*>), (<*>), (<$>), (<$), pred)+import Parsley+import Parsley.Combinator (token, oneOf, eof)+import Parsley.Fold (skipMany, skipSome)+--import Parsley.Garnish+import NandlangBench.Parsley.Functions+import Data.Char (isSpace)++nandlang :: Parser ()+nandlang = whitespace *> skipMany funcdef <* eof+ where+ index :: Parser ()+ index = brackets nat+ identifier :: Parser ()+ identifier = try (identStart *> skipMany identLetter) *> whitespace+ variable :: Parser ()+ variable = identifier *> optional index++ literal :: Parser ()+ literal = bit <|> charLit++ keyword :: String -> Parser ()+ keyword s = try (string s *> notIdentLetter) *> whitespace++ identStart = satisfy [|nandIdentStart|]+ identLetter = satisfy [|nandIdentLetter|]+ notIdentLetter = notFollowedBy identLetter++ bit :: Parser ()+ bit = (char '0' <|> char '1') *> whitespace++ nat :: Parser ()+ nat = decimal++ charLit :: Parser ()+ charLit = between (char '\'') (symbol '\'') charChar++ charChar :: Parser ()+ charChar = void (satisfy [|nandStringLetter|]) <|> esc++ esc :: Parser ()+ esc = char '\\' *> void (oneOf "0tnvfr")++ expr :: Parser ()+ expr = nandexpr *> skipMany (symbol '!' *> nandexpr)++ nandexpr :: Parser ()+ nandexpr = literal <|> funccallOrVar++ funccallOrVar :: Parser ()+ funccallOrVar = identifier *> optional (parens exprlist <|> index)++ exprlist = commaSep expr+ exprlist1 = commaSep1 expr+ varlist = commaSep variable+ varlist1 = commaSep1 variable++ funcparam = varlist *> optional (symbol ':' *> varlist)+ varstmt = optional (keyword "var") *> varlist1 *> symbol '=' *> exprlist1 <* semi+ ifstmt = keyword "if" *> expr *> block *> optional (keyword "else" *> block)+ whilestmt = keyword "while" *> expr *> block+ statement = ifstmt <|> whilestmt <|> try varstmt <|> expr <* semi+ block = braces (skipMany statement)+ funcdef = keyword "function" *> identifier *> parens funcparam *> block++ decimal :: Parser ()+ decimal = number (oneOf ['0'..'9'])+ hexadecimal = oneOf "xX" *> number (oneOf (['a'..'f'] ++ ['A'..'F'] ++ ['0'..'9']))+ octal = oneOf "oO" *> number (oneOf ['0'..'7'])+ number :: Parser a -> Parser ()+ number digit = skipSome digit++ symbol :: Char -> Parser Char+ symbol c = char c <* whitespace+ parens :: Parser a -> Parser a+ parens = between (symbol '(') (symbol ')')+ brackets :: Parser a -> Parser a+ brackets = between (symbol '[') (symbol ']')+ braces :: Parser a -> Parser a+ braces = between (symbol '{') (symbol '}')+ semi :: Parser Char+ semi = symbol ';'+ comma :: Parser Char+ comma = symbol ','+ commaSep :: Parser a -> Parser ()+ commaSep p = optional (commaSep1 p)+ commaSep1 :: Parser a -> Parser ()+ commaSep1 p = p *> skipMany (comma *> p)++ space :: Parser ()+ space = void (satisfy [|isSpace|])+ whitespace :: Parser ()+ whitespace = skipMany (spaces <|> oneLineComment)+ spaces :: Parser ()+ spaces = skipSome space+ oneLineComment :: Parser ()+ oneLineComment = void (token "//" *> skipMany (satisfy [|(/= '\n')|]))
@@ -0,0 +1,77 @@+module Shared.Attoparsec.Extended (+ module Data.Functor,+ module Control.Applicative,+ module Data.Attoparsec.Text,+ module Control.Monad,+ module Shared.Attoparsec.Extended+ ) where++import Data.Attoparsec.Text hiding (match, string)+import Data.Functor (void, ($>))+import Control.Monad (MonadPlus)+import Control.Applicative (liftA2, liftA3, empty, Alternative, (<**>), (<|>), many)+import Data.List (foldl')++string = traverse char++token :: String -> Parser String+token = try . string++between o c p = o *> p <* c++oneOf = satisfy . inClass+noneOf = satisfy . notInClass++match :: (Monad m, Eq a) => [a] -> m a -> (a -> m b) -> m b -> m b+match xs p f def = p >>= (\x -> if elem x xs then f x else def)++skipSome :: Parser a -> Parser ()+skipSome p = void (some p)++some = many1++maybeP :: Parser a -> Parser (Maybe a)+maybeP p = option Nothing (Just <$> p)++fromMaybeP :: Monad m => m (Maybe a) -> m a -> m a+fromMaybeP mmx d = mmx >>= maybe d return++(<+>) :: Parser a -> Parser b -> Parser (Either a b)+p <+> q = Left <$> p <|> Right <$> q++(<:>) :: Parser a -> Parser [a] -> Parser [a]+(<:>) = liftA2 (:)++(<~>) :: Parser a -> Parser b -> Parser (a, b)+(<~>) = liftA2 (,)++pfoldl1 :: (b -> a -> b) -> b -> Parser a -> Parser b+pfoldl1 f k p = foldl' f k <$> some p++(>?>) :: MonadPlus m => m a -> (a -> Bool) -> m a+m >?> f = m >>= \x -> if f x then return x else empty++chainPre :: Parser (a -> a) -> Parser a -> Parser a+chainPre op p = flip (foldr ($)) <$> many op <*> p++chainPost :: Parser a -> Parser (a -> a) -> Parser a+chainPost p op = foldl' (flip ($)) <$> p <*> many op++chainl1 :: Parser a -> Parser (a -> a -> a) -> Parser a+chainl1 p op = chainPost p (flip <$> op <*> p)++chainr1 :: Parser a -> Parser (a -> a -> a) -> Parser a+chainr1 p op = let go = p <**> ((flip <$> op <*> go) <|> pure id) in go++data Level s a = InfixL [Parser (a -> a -> a)]+ | InfixR [Parser (a -> a -> a)]+ | Prefix [Parser (a -> a)]+ | Postfix [Parser (a -> a)]++precedence :: [Level s a] -> Parser a -> Parser a+precedence levels atom = foldl' convert atom levels+ where+ convert x (InfixL ops) = chainl1 x (choice ops)+ convert x (InfixR ops) = chainr1 x (choice ops)+ convert x (Prefix ops) = chainPre (choice ops) x+ convert x (Postfix ops) = chainPost x (choice ops)
@@ -0,0 +1,40 @@+{-# LANGUAGE TypeFamilies+ , FlexibleContexts #-}+module Shared.BenchmarkUtils where++import Criterion.Main (Benchmark, bgroup, bench, nf, defaultMain, env)+import Control.DeepSeq (NFData)+import Control.Monad.Identity (Identity)+import Data.Text (Text)+import Data.ByteString (ByteString)+import qualified Text.Parsec as Parsec+import qualified Text.Megaparsec as Megaparsec+import qualified Data.Attoparsec.Text as Attoparsec+import qualified Data.Text.IO+import qualified Data.ByteString+import qualified Data.ByteString.Lazy+import qualified Shared.Parsec.Extended+import qualified Shared.Megaparsec.Extended++parsecParse :: Parsec.Stream s Identity Char => Shared.Parsec.Extended.Parser s a -> s -> Maybe a+parsecParse p = either (const Nothing) Just . Parsec.parse p ""++megaParse :: (Megaparsec.Stream s, Megaparsec.Token s ~ Char) => Shared.Megaparsec.Extended.Parser s a -> s -> Maybe a+megaParse = Megaparsec.parseMaybe++attoParse :: Attoparsec.Parser a -> Text -> Maybe a+attoParse p = Attoparsec.maybeResult . Attoparsec.parse p++string :: FilePath -> IO String+string = readFile+text :: FilePath -> IO Text+text = Data.Text.IO.readFile+bytestring :: FilePath -> IO ByteString+bytestring = Data.ByteString.readFile+lazy_bytestring :: FilePath -> IO Data.ByteString.Lazy.ByteString+lazy_bytestring = Data.ByteString.Lazy.readFile++benchmark :: (NFData a, NFData rep) => [FilePath] -> (FilePath -> IO rep) -> String -> (rep -> Maybe a) -> Benchmark+benchmark filenames load lib parser = env (traverse load filenames) (bgroup lib . (tasks filenames))+ where+ tasks filenames inputs = foldr (\f ts n -> bench f (nf parser (inputs !! n)) : ts (n+1)) (const []) filenames 0
@@ -0,0 +1,73 @@+{-# LANGUAGE TypeFamilies #-}+module Shared.Megaparsec.Extended (+ module Text.Megaparsec,+ module Text.Megaparsec.Char,+ module Control.Monad,+ module Control.Applicative,+ module Shared.Megaparsec.Extended+ ) where+import Text.Megaparsec hiding (token, match)+import Text.Megaparsec.Char hiding (string)+import Data.List (foldl')+import Control.Monad (MonadPlus, void)+import Control.Applicative (liftA2, liftA3, empty, Alternative, (<**>))++type Parser s a = Parsec () s a++string :: (Stream s, Token s ~ Char) => String -> Parser s String+string = traverse char++token :: (Stream s, Token s ~ Char) => String -> Parser s String+token = try . string++($>) :: Functor f => f a -> b -> f b+($>) = flip (<$)++match :: (Monad m, Eq a) => [a] -> m a -> (a -> m b) -> m b -> m b+match xs p f def = p >>= (\x -> if elem x xs then f x else def)++maybeP :: (Stream s, Token s ~ Char) => Parser s a -> Parser s (Maybe a)+maybeP p = option Nothing (Just <$> p)++fromMaybeP :: Monad m => m (Maybe a) -> m a -> m a+fromMaybeP mmx d = mmx >>= maybe d return++(<+>) :: (Stream s, Token s ~ Char) => Parser s a -> Parser s b -> Parser s (Either a b)+p <+> q = Left <$> p <|> Right <$> q++(<:>) :: (Stream s, Token s ~ Char) => Parser s a -> Parser s [a] -> Parser s [a]+(<:>) = liftA2 (:)++(<~>) :: (Stream s, Token s ~ Char) => Parser s a -> Parser s b -> Parser s (a, b)+(<~>) = liftA2 (,)++pfoldl1 :: (Stream s, Token s ~ Char) => (b -> a -> b) -> b -> Parser s a -> Parser s b+pfoldl1 f k p = foldl' f k <$> some p++(>?>) :: MonadPlus m => m a -> (a -> Bool) -> m a+m >?> f = m >>= \x -> if f x then return x else empty++chainPre :: (Stream s, Token s ~ Char) => Parser s (a -> a) -> Parser s a -> Parser s a+chainPre op p = flip (foldr ($)) <$> many op <*> p++chainPost :: (Stream s, Token s ~ Char) => Parser s a -> Parser s (a -> a) -> Parser s a+chainPost p op = foldl' (flip ($)) <$> p <*> many op++chainl1 :: (Stream s, Token s ~ Char) => Parser s a -> Parser s (a -> a -> a) -> Parser s a+chainl1 p op = chainPost p (flip <$> op <*> p)++chainr1 :: (Stream s, Token s ~ Char) => Parser s a -> Parser s (a -> a -> a) -> Parser s a+chainr1 p op = let go = p <**> ((flip <$> op <*> go) <|> pure id) in go++data Level s a = InfixL [Parser s (a -> a -> a)]+ | InfixR [Parser s (a -> a -> a)]+ | Prefix [Parser s (a -> a)]+ | Postfix [Parser s (a -> a)]++precedence :: (Stream s, Token s ~ Char) => [Level s a] -> Parser s a -> Parser s a+precedence levels atom = foldl' convert atom levels+ where+ convert x (InfixL ops) = chainl1 x (choice ops)+ convert x (InfixR ops) = chainr1 x (choice ops)+ convert x (Prefix ops) = chainPre (choice ops) x+ convert x (Postfix ops) = chainPost x (choice ops)
@@ -0,0 +1,70 @@+{-# LANGUAGE FlexibleContexts #-}+module Shared.Parsec.Extended (+ module Text.Parsec,+ module Data.Functor,+ module Control.Monad,+ module Control.Monad.Identity,+ module Control.Applicative,+ module Shared.Parsec.Extended+ ) where++import Text.Parsec hiding (token)+import Data.Functor (void, ($>))+import Control.Monad.Identity (Identity)+import Control.Monad (MonadPlus)+import Control.Applicative (liftA2, liftA3, empty, Alternative, (<**>))+import Data.List (foldl')++type Parser s a = Parsec s () a++token :: Stream s Identity Char => String -> Parser s String+token = try . string++match :: (Monad m, Eq a) => [a] -> m a -> (a -> m b) -> m b -> m b+match xs p f def = p >>= (\x -> if elem x xs then f x else def)++skipSome :: Stream s Identity Char => Parser s a -> Parser s ()+skipSome p = void (some p)++maybeP :: Stream s Identity Char => Parser s a -> Parser s (Maybe a)+maybeP p = option Nothing (Just <$> p)++fromMaybeP :: Monad m => m (Maybe a) -> m a -> m a+fromMaybeP mmx d = mmx >>= maybe d return++(<+>) :: Stream s Identity Char => Parser s a -> Parser s b -> Parser s (Either a b)+p <+> q = Left <$> p <|> Right <$> q++(<:>) :: Stream s Identity Char => Parser s a -> Parser s [a] -> Parser s [a]+(<:>) = liftA2 (:)++(<~>) :: Stream s Identity Char => Parser s a -> Parser s b -> Parser s (a, b)+(<~>) = liftA2 (,)++some :: Stream s Identity Char => Parser s a -> Parser s [a]+some = many1++pfoldl1 :: Stream s Identity Char => (b -> a -> b) -> b -> Parser s a -> Parser s b+pfoldl1 f k p = foldl' f k <$> some p++(>?>) :: MonadPlus m => m a -> (a -> Bool) -> m a+m >?> f = m >>= \x -> if f x then return x else empty++chainPre :: Stream s Identity Char => Parser s (a -> a) -> Parser s a -> Parser s a+chainPre op p = flip (foldr ($)) <$> many op <*> p++chainPost :: Stream s Identity Char => Parser s a -> Parser s (a -> a) -> Parser s a+chainPost p op = foldl' (flip ($)) <$> p <*> many op++data Level s a = InfixL [Parser s (a -> a -> a)]+ | InfixR [Parser s (a -> a -> a)]+ | Prefix [Parser s (a -> a)]+ | Postfix [Parser s (a -> a)]++precedence :: Stream s Identity Char => [Level s a] -> Parser s a -> Parser s a+precedence levels atom = foldl' convert atom levels+ where+ convert x (InfixL ops) = chainl1 x (choice ops)+ convert x (InfixR ops) = chainr1 x (choice ops)+ convert x (Prefix ops) = chainPre (choice ops) x+ convert x (Postfix ops) = chainPost x (choice ops)
parsley.cabal view
@@ -5,7 +5,7 @@ -- | +------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change-version: 1.0.0.0+version: 1.0.0.1 synopsis: A fast parser combinator library backed by Typed Template Haskell description: Parsley is a staged selective parser combinator library, which means it does not support monadic operations, and relies on Typed Template@@ -85,3 +85,72 @@ source-repository head type: git location: https://github.com/j-mie6/HaskellParsley++common test-common+ build-depends: base >=4.10 && <5,+ parsley,+ parsley-garnish,+ tasty,+ template-haskell+ other-extensions: TemplateHaskellQuotes, TemplateHaskell+ hs-source-dirs: test+ default-language: Haskell2010+ ghc-options: -fplugin=Parsley.OverloadedQuotesPlugin++test-suite parsley-test+ import: test-common+ type: exitcode-stdio-1.0+ build-depends: tasty-hunit, tasty-quickcheck, th-test-utils, deepseq+ main-is: ParsleyTest.hs+ other-modules: Parsley.Alternative.Test, Parsley.Applicative.Test, Parsley.Combinator.Test, Parsley.Fold.Test,+ Parsley.Precedence.Test, Parsley.Register.Test, Parsley.Selective.Test, Parsley.Primitive.Test,+ Parsley.Alternative.Parsers, Parsley.Applicative.Parsers, Parsley.Combinator.Parsers, Parsley.Fold.Parsers,+ Parsley.Precedence.Parsers, Parsley.Register.Parsers, Parsley.Selective.Parsers, Parsley.Primitive.Parsers,+ TestUtils++common benchmark-common+ build-tool-depends: happy:happy+ build-depends: base >=4.10 && <5,+ parsley,+ parsley-garnish,+ criterion >=1.5 && <1.6,+ deepseq,+ template-haskell,+ parsec,+ attoparsec,+ megaparsec,+ text,+ bytestring,+ mtl,+ array,+ containers+ hs-source-dirs: benchmarks+ other-extensions: TemplateHaskellQuotes, TemplateHaskell+ other-modules: Shared.BenchmarkUtils, Shared.Attoparsec.Extended, Shared.Megaparsec.Extended, Shared.Parsec.Extended+ default-language: Haskell2010+ ghc-options: -rtsopts -fno-spec-constr+ if false && impl(ghc < 8.8)+ build-depends: dump-core+ ghc-options: -fplugin=DumpCore++benchmark brainfuck-bench+ import: benchmark-common+ type: exitcode-stdio-1.0+ other-modules: BrainfuckBench.Shared, BrainfuckBench.Parsley.Parser, BrainfuckBench.Parsec.Parser, BrainfuckBench.Megaparsec.Parser,+ BrainfuckBench.Attoparsec.Parser, BrainfuckBench.Handrolled.Parser, BrainfuckBench.Happy.Parser+ main-is: BrainfuckBench/Main.hs++benchmark javascript-bench+ import: benchmark-common+ type: exitcode-stdio-1.0+ other-modules: JavascriptBench.Shared, JavascriptBench.Parsley.Parser, JavascriptBench.Parsec.Parser, JavascriptBench.Megaparsec.Parser,+ JavascriptBench.Attoparsec.Parser, JavascriptBench.Happy.Parser+ main-is: JavascriptBench/Main.hs++benchmark nandlang-bench+ import: benchmark-common+ type: exitcode-stdio-1.0+ --cc-options: -O3+ other-modules: NandlangBench.Parsley.Parser, NandlangBench.Parsley.Functions, NandlangBench.Bison.Parser+ c-sources: benchmarks/NandlangBench/Bison/lex.yy.c, benchmarks/NandlangBench/Bison/Nandlang.tab.c+ main-is: NandlangBench/Main.hs
src/ghc/Parsley/Combinator.hs view
@@ -1,4 +1,5 @@-{-# LANGUAGE PatternSynonyms #-}+{-# OPTIONS_GHC -Wno-incomplete-patterns #-}+{-# LANGUAGE PatternSynonyms, ViewPatterns #-} {-| Module : Parsley.Combinator Description : The parsing combinators@@ -22,9 +23,10 @@ ) where import Prelude hiding (traverse, (*>))+import Data.List (sort) import Parsley.Alternative (manyTill) import Parsley.Applicative (($>), void, traverse, (<:>), (*>))-import Parsley.Internal (Code, makeQ, Parser, Defunc(LIFTED, EQ_H, CONST), pattern APP_H, satisfy, lookAhead, try, notFollowedBy)+import Parsley.Internal (Code, Quapplicative(..), Parser, Defunc(LIFTED, EQ_H, CONST, LAM_S), pattern APP_H, pattern COMPOSE_H, satisfy, lookAhead, try, notFollowedBy) {-| This combinator will attempt match a given string. If the parser fails midway through, this@@ -44,7 +46,7 @@ @since 0.1.0.0 -} oneOf :: [Char] -> Parser Char-oneOf cs = satisfy (makeQ (flip elem cs) [||\c -> $$(ofChars cs [||c||])||])+oneOf = satisfy . elem' {-| This combinator will attempt to not match any one of the provided list of characters. If one of those@@ -54,10 +56,28 @@ @since 0.1.0.0 -} noneOf :: [Char] -> Parser Char-noneOf cs = satisfy (makeQ (not . flip elem cs) [||\c -> not $$(ofChars cs [||c||])||])+noneOf = satisfy . COMPOSE_H (makeQ not [||not||]) . elem' +elem' :: [Char] -> Defunc (Char -> Bool)+elem' cs = LAM_S (\c -> makeQ (elem (_val c) cs) (ofChars cs (_code c)))+ ofChars :: [Char] -> Code Char -> Code Bool-ofChars = foldr (\c rest qc -> [|| c == $$qc || $$(rest qc) ||]) (const [||False||])+ofChars [] _ = [||False||]+ofChars cs qc = foldr1 (\p q -> [|| $$p || $$q ||]) (map (makePred qc) (ranges cs))++makePred :: Code Char -> (Char, Char) -> Code Bool+makePred qc (c, c')+ | c == c' = [|| c == $$qc ||]+ | otherwise = [|| c <= $$qc && $$qc <= c' ||]++ranges :: [Char] -> [(Char, Char)]+ranges (sort -> c:cs) = go c (fromEnum c) cs+ where+ go :: Char -> Int -> [Char] -> [(Char, Char)]+ go lower prev [] = [(lower, toEnum prev)]+ go lower prev (c:cs)+ | i <- fromEnum c, i == prev + 1 = go lower i cs+ | otherwise = (lower, toEnum prev) : go c (fromEnum c) cs {-| Like `string`, excepts parses the given string atomically using `try`. Never consumes input on
+ test/Parsley/Alternative/Parsers.hs view
@@ -0,0 +1,1 @@+module Parsley.Alternative.Parsers where
+ test/Parsley/Alternative/Test.hs view
@@ -0,0 +1,28 @@+{-# LANGUAGE TemplateHaskell, UnboxedTuples, ScopedTypeVariables #-}+module Parsley.Alternative.Test where+import Test.Tasty+import Test.Tasty.HUnit+import TestUtils+import qualified Parsley.Alternative.Parsers as Parsers++import Prelude hiding ()+import Parsley (runParser)++tests :: TestTree+tests = testGroup "Alternative" [ coproductTests+ , optionTests+ , choiceTests+ , manyTillTests+ ]++coproductTests :: TestTree+coproductTests = testGroup "<+> should" [] -- <+>++optionTests :: TestTree+optionTests = testGroup "option should" [] -- optional, optionally, option, maybeP++choiceTests :: TestTree+choiceTests = testGroup "choice should" [] -- choice++manyTillTests :: TestTree+manyTillTests = testGroup "manyTill should" [] --manyTill
+ test/Parsley/Applicative/Parsers.hs view
@@ -0,0 +1,1 @@+module Parsley.Applicative.Parsers where
+ test/Parsley/Applicative/Test.hs view
@@ -0,0 +1,55 @@+{-# LANGUAGE TemplateHaskell, UnboxedTuples, ScopedTypeVariables #-}+module Parsley.Applicative.Test where+import Test.Tasty+import Test.Tasty.HUnit+import TestUtils+import qualified Parsley.Applicative.Parsers as Parsers++import Prelude hiding ()+import Parsley (runParser)+import Parsley.Applicative (unit)++tests :: TestTree+tests = testGroup "Applicative" [ unitTests+ , fmapTests+ , voidTests+ , thenTests+ , prevTests+ , liftA2Tests+ , liftA3Tests+ , sequenceTests+ , betweenTests+ ]++unit' :: String -> Maybe ()+unit' = $$(runParserMocked unit [||unit||])++unitTests :: TestTree+unitTests = testGroup "unit should"+ [ testCase "not need to consume input" $ unit' "" @?= Just ()+ , testCase "not fail if there is input" $ unit' "a" @?= Just ()+ ]++fmapTests :: TestTree+fmapTests = testGroup "fmap should" [] -- <$>/<&>++voidTests :: TestTree+voidTests = testGroup "void should" [] -- void++thenTests :: TestTree+thenTests = testGroup ">>/~> should" [] -- >>/~>++prevTests :: TestTree+prevTests = testGroup "<~ should" [] -- <~++liftA2Tests :: TestTree+liftA2Tests = testGroup "liftA2 should" [] -- <~>/<**>++liftA3Tests :: TestTree+liftA3Tests = testGroup "liftA3 should" [] -- liftA3++sequenceTests :: TestTree+sequenceTests = testGroup "sequence should" [] --traverse/repeat++betweenTests :: TestTree+betweenTests = testGroup "between should" [] --between
+ test/Parsley/Combinator/Parsers.hs view
@@ -0,0 +1,10 @@+module Parsley.Combinator.Parsers where++import Parsley (Parser)+import Parsley.Combinator (oneOf)++abc :: Parser Char+abc = oneOf ['a', 'b', 'c']++nothing :: Parser Char+nothing = oneOf []
+ test/Parsley/Combinator/Test.hs view
@@ -0,0 +1,86 @@+{-# LANGUAGE TemplateHaskell, UnboxedTuples, ScopedTypeVariables #-}+module Parsley.Combinator.Test where+import Test.Tasty+import Test.Tasty.HUnit+import TestUtils+import qualified Parsley.Combinator.Parsers as Parsers++import Prelude hiding ((*>))+import Parsley (runParser, (*>))+import Parsley.Combinator (eof, more, char, item)++tests :: TestTree+tests = testGroup "Combinator" [ stringTests+ , oneOfTests+ , noneOfTests+ , tokenTests+ , eofTests+ , moreTests+ , charTests+ , itemTests+ , someTillTests+ ]++stringTests :: TestTree+stringTests = testGroup "string should" []++nothing :: String -> Maybe Char+nothing = $$(runParserMocked Parsers.nothing [||Parsers.nothing||])++abc :: String -> Maybe Char+abc = $$(runParserMocked Parsers.abc [||Parsers.abc||])++oneOfTests :: TestTree+oneOfTests = testGroup "oneOf should"+ [ testCase "handle no options no input" $ nothing "" @?= Nothing+ , testCase "handle no options with input" $ nothing "a" @?= Nothing+ , testCase "parse any of characters" $ do+ abc "a" @?= Just 'a'+ abc "b" @?= Just 'b'+ abc "c" @?= Just 'c'+ , testCase "fail otherwise" $ abc "d" @?= Nothing+ ]++noneOfTests :: TestTree+noneOfTests = testGroup "noneOf should" []++tokenTests :: TestTree+tokenTests = testGroup "token should" []++isNull :: String -> Maybe ()+isNull = $$(runParserMocked eof [||eof||])++eofTests :: TestTree+eofTests = testGroup "eof should"+ [ testCase "succeed on empty input" $ isNull "" @?= Just ()+ , testCase "fail on non-empty input" $ isNull "a" @?= Nothing+ ]++notNull :: String -> Maybe ()+notNull = $$(runParserMocked more [||more||])++notNullThenA :: String -> Maybe Char+notNullThenA = $$(runParserMocked (more *> char 'a') [||more *> char 'a'||])++moreTests :: TestTree+moreTests = testGroup "more should"+ [ testCase "fail on empty input" $ notNull "" @?= Nothing+ , testCase "succeed on non-empty input" $ notNull "a" @?= Just ()+ , testCase "not consume input" $ notNullThenA "a" @?= Just 'a'+ ]++charA :: String -> Maybe Char+charA = $$(runParserMocked (char 'a') [||char 'a'||])++charTests :: TestTree+charTests = testGroup "char should"+ [ testCase "fail on empty input" $ charA "" @?= Nothing+ , testCase "succeed on correct char" $ charA "a" @?= Just 'a'+ , testCase "fail on wrong char" $ charA "b" @?= Nothing+ ]++itemTests :: TestTree+itemTests = testGroup "item should" []++someTillTests :: TestTree+someTillTests = testGroup "someTill should" []
+ test/Parsley/Fold/Parsers.hs view
@@ -0,0 +1,31 @@+{-# LANGUAGE TemplateHaskell #-}+module Parsley.Fold.Parsers where++import Prelude hiding (pure, (<*>), (*>), (<*))+import Parsley+import Parsley.Fold+--import Parsley.Garnish++plusOne :: Parser Int+plusOne = chainPre (string "++" $> [|succ|]) (char '1' $> [|1|])++plusOne' :: Parser Int+plusOne' = chainPre (try (string "++") $> [|succ|]) (char '1' $> [|1|])++plusOnePure :: Parser Int+plusOnePure = try (chainPre (string "++" $> [|succ|]) (pure ([|1|]))) <|> pure ([|0|])++onePlus :: Parser Int+onePlus = chainPost (char '1' $> [|1|]) (string "++" $> [|succ|])++onePlus' :: Parser Int+onePlus' = chainPost (char '1' $> [|1|]) (try (string "++") $> [|succ|])++manyAA :: Parser [String]+manyAA = many (string "aa")++someA :: Parser String+someA = some (char 'a')++many2A :: Parser String+many2A = manyN 2 (char 'a')
+ test/Parsley/Fold/Test.hs view
@@ -0,0 +1,107 @@+{-# LANGUAGE TemplateHaskell, UnboxedTuples, ScopedTypeVariables, TypeApplications #-}+module Parsley.Fold.Test where+import Test.Tasty+import Test.Tasty.HUnit+import TestUtils+import qualified Parsley.Fold.Parsers as Parsers++import Prelude hiding ()+import Parsley (runParser)++tests :: TestTree+tests = testGroup "Fold" [ chainPreTests+ , chainPostTests+ , pfoldrTests+ , pfoldlTests+ , chainlTests+ , chainrTests+ , manyTests+ , skipManyTests+ , sepByTests+ , endByTests+ , sepEndByTests]++plusOne :: String -> Maybe Int+plusOne = $$(runParserMocked Parsers.plusOne [||Parsers.plusOne||])++plusOne' :: String -> Maybe Int+plusOne' = $$(runParserMocked Parsers.plusOne' [||Parsers.plusOne'||])++plusOnePure :: String -> Maybe Int+plusOnePure = $$(runParserMocked Parsers.plusOnePure [||Parsers.plusOnePure||])++chainPreTests :: TestTree+chainPreTests = testGroup "chainPre should"+ [ testCase "parse an operatorless value" $ do+ plusOne "1" @?= Just 1+ plusOne "" @?= Nothing+ plusOnePure "" @?= Just 1+ , testCase "parser all operators that precede" $ do+ plusOne "++++1" @?= Just 3+ plusOne' "++++1" @?= Just 3+ plusOnePure "+" @?= Just 0+ , testCase "fail if an operator fails after consuming input" $ plusOne "+++1" @?= Nothing+ ]++onePlus :: String -> Maybe Int+onePlus = $$(runParserMocked Parsers.onePlus [||Parsers.onePlus||])++onePlus' :: String -> Maybe Int+onePlus' = $$(runParserMocked Parsers.onePlus' [||Parsers.onePlus'||])++chainPostTests :: TestTree+chainPostTests = testGroup "chainPost should"+ [ testCase "require an initial value" $ do+ onePlus "1" @?= Just 1+ onePlus "" @?= Nothing+ , testCase "parser all operators that follow" $ onePlus "1++++" @?= Just 3+ , testCase "fail if an operator fails after consuming input" $ onePlus "1+++" @?= Nothing+ , testCase "not fail if the operator fails with try" $ onePlus' "1+++" @?= Just 2+ ]++pfoldrTests :: TestTree+pfoldrTests = testGroup "pfoldr should" [] -- pfoldr pfoldr1++pfoldlTests :: TestTree+pfoldlTests = testGroup "pfoldl should" [] -- pfoldl pfoldl1++chainlTests :: TestTree+chainlTests = testGroup "chainl should" [] -- chainl1' chainl1 chainl++chainrTests :: TestTree+chainrTests = testGroup "chainr should" [] -- chainr1' chainr1 chainr++manyAA :: String -> Maybe [String]+manyAA = $$(runParserMocked Parsers.manyAA [||Parsers.manyAA||])++someA :: String -> Maybe String+someA = $$(runParserMocked Parsers.someA [||Parsers.someA||])++many2A :: String -> Maybe String+many2A = $$(runParserMocked Parsers.many2A [||Parsers.many2A||])++manyTests :: TestTree+manyTests = testGroup "many should"+ [ testCase "succeed on empty input" $ do+ manyAA "" @?= Just []+ someA "" @?= Nothing+ many2A "" @?= Nothing+ many2A "a" @?= Nothing+ , testCase "succeed when given an input" $ do+ manyAA "aa" @?= Just ["aa"]+ someA "aa" @?= Just "aa"+ many2A "aaa" @?= Just "aaa"+ , testCase "fail when partial" $ manyAA "a" @?= Nothing+ ]++skipManyTests :: TestTree+skipManyTests = testGroup "skipMany should" [] -- skipMany skipManyN skipSome++sepByTests :: TestTree+sepByTests = testGroup "sepBy should" [] -- sepBy sepBy1++endByTests :: TestTree+endByTests = testGroup "endBy should" [] -- endBy endBy1++sepEndByTests :: TestTree+sepEndByTests = testGroup "sepEndBy should" [] -- sepEndBy sepEndBy1
+ test/Parsley/Precedence/Parsers.hs view
@@ -0,0 +1,1 @@+module Parsley.Precedence.Parsers where
+ test/Parsley/Precedence/Test.hs view
@@ -0,0 +1,14 @@+{-# LANGUAGE TemplateHaskell, UnboxedTuples, ScopedTypeVariables #-}+module Parsley.Precedence.Test where+import Test.Tasty+import Test.Tasty.HUnit+import TestUtils+import qualified Parsley.Precedence.Parsers as Parsers++import Prelude hiding ()+import Parsley (runParser)++tests :: TestTree+tests = testGroup "Precedence should" [++ ]
+ test/Parsley/Primitive/Parsers.hs view
@@ -0,0 +1,28 @@+{-# LANGUAGE TemplateHaskell #-}+module Parsley.Primitive.Parsers where++import Prelude hiding (pure, (<*>), (*>), (<*))+import Data.Char (isDigit)+import Parsley+import Parsley.Defunctionalized (Defunc(EMPTY))+--import Parsley.Garnish++pure7 :: Parser Int+pure7 = pure [|7|]++digit :: Parser Char+digit = satisfy [|isDigit|]++twoDigits :: Parser Char+twoDigits = digit *> digit++abOrC :: Parser String+abOrC = string "ab" <|> string "c"++abOrCThenD :: Parser String+abOrCThenD = abOrC <* char 'd'++recursive :: Parser [Char]+recursive =+ let r = item <:> r <|> pure EMPTY+ in r
+ test/Parsley/Primitive/Test.hs view
@@ -0,0 +1,108 @@+{-# LANGUAGE TemplateHaskell, UnboxedTuples, ScopedTypeVariables, TypeApplications #-}+module Parsley.Primitive.Test where+import Test.Tasty+import Test.Tasty.HUnit+import TestUtils+import qualified Parsley.Primitive.Parsers as Parsers++import Parsley (runParser, empty)++tests :: TestTree+tests = testGroup "Primitive" [ pureTests+ , apTests+ , thenTests+ , prevTests+ , altTests+ , emptyTests+ , satisfyTests+ , lookAheadTests+ , notFollowedByTests+ , tryTests+ , branchTests+ , conditionalTests+ , recursionTests+ ]++pure7 :: String -> Maybe Int+pure7 = $$(runParserMocked Parsers.pure7 [||Parsers.pure7||])++pureTests :: TestTree+pureTests = testGroup "pure should"+ [ testCase "not need to consume input" $ pure7 "" @?= Just 7+ , testCase "not fail if there is input" $ pure7 "a" @?= Just 7+ ]++apTests :: TestTree+apTests = testGroup "<*> should" []++thenTests :: TestTree+thenTests = testGroup "*> should" []++prevTests :: TestTree+prevTests = testGroup "<* should" []++abOrC :: String -> Maybe String+abOrC = $$(runParserMocked Parsers.abOrC [||Parsers.abOrC||])++abOrCThenD :: String -> Maybe String+abOrCThenD = $$(runParserMocked Parsers.abOrCThenD [||Parsers.abOrCThenD||])++altTests :: TestTree+altTests = testGroup "<|> should"+ [ testCase "take the left branch if it succeeds" $ do+ abOrC "ab" @?= Just "ab"+ abOrCThenD "abd" @?= Just "ab"+ , testCase "take the right branch if left failed without consumption" $ do+ abOrC "c" @?= Just "c"+ abOrC "d" @?= Nothing+ abOrCThenD "cd" @?= Just "c"+ abOrCThenD "d" @?= Nothing+ , testCase "fail if the left branch fails and consumes input" $ abOrC "a" @?= Nothing+ ]++constNothing :: String -> Maybe ()+constNothing = $$(runParserMocked empty [||empty||])++emptyTests :: TestTree+emptyTests = testGroup "empty should"+ [ testCase "fail the parser with no input" $ constNothing "" @?= Nothing+ , testCase "fail the parser with input" $ constNothing "a" @?= Nothing+ ]++digit :: String -> Maybe Char+digit = $$(runParserMocked Parsers.digit [||Parsers.digit||])++twoDigits :: String -> Maybe Char+twoDigits = $$(runParserMocked Parsers.twoDigits [||Parsers.twoDigits||])++satisfyTests :: TestTree+satisfyTests = testGroup "satisfy should"+ [ testCase "fail when given no input" $ digit "" @?= Nothing+ , testCase "fail when given incorrect input" $ digit "a" @?= Nothing+ , testCase "succeed when given correct input" $ digit "1" @?= Just '1'+ , testCase "actually consume input" $ twoDigits "1" @?= Nothing+ , testCase "consume more than 1 piece of input with two" $ twoDigits "12" @?= Just '2'+ ]++lookAheadTests :: TestTree+lookAheadTests = testGroup "lookAhead should" []++notFollowedByTests :: TestTree+notFollowedByTests = testGroup "notFollowedBy should" []++tryTests :: TestTree+tryTests = testGroup "try should" []++branchTests :: TestTree+branchTests = testGroup "branch should" []++conditionalTests :: TestTree+conditionalTests = testGroup "conditional should" []++manyAny :: String -> Maybe String+manyAny = $$(runParserMocked Parsers.recursive [||Parsers.recursive||])++recursionTests :: TestTree+recursionTests = testGroup "recursion should"+ [ testCase "work properly" $ manyAny "abc" @?= Just "abc"+ ]
+ test/Parsley/Register/Parsers.hs view
@@ -0,0 +1,32 @@+{-# LANGUAGE TemplateHaskellQuotes #-}+module Parsley.Register.Parsers where++import Prelude hiding ((*>), (<*))+import Data.Char (isDigit)+import Parsley (Parser, item, char, (*>), (<*), (<|>))+import Parsley.Register+--import Parsley.Garnish++getPure :: Parser Int+getPure = newRegister_ [|8|] get++getPersists :: Parser Int+getPersists = newRegister_ [|8|] (\r -> item *> get r)++getPersistsBranch :: Parser Int+getPersistsBranch = newRegister_ [|8|] (\r -> (char 'a' *> get r) <|> get r)++getNoInput :: Parser Int+getNoInput = newRegister_ [|8|] (\r -> get r <* item)++putPure :: Parser Int+putPure = newRegister_ [|8|] (\r -> put_ r [|7|] *> get r)++putSeq :: Parser Char+putSeq = newRegister_ [|'a'|] (\r -> put r item *> get r)++putPut :: Parser Int+putPut = newRegister_ [|7|] (\r -> put_ r [|5|] *> put_ r [|6|] *> get r)++putCarries :: Parser Bool+putCarries = newRegister_ [|False|] (\r -> (put_ r [|True|] *> item *> put_ r [|False|] *> get r) <|> get r)
+ test/Parsley/Register/Test.hs view
@@ -0,0 +1,94 @@+{-# LANGUAGE TemplateHaskell, UnboxedTuples, ScopedTypeVariables, TypeApplications #-}+module Parsley.Register.Test where+import Test.Tasty+import Test.Tasty.HUnit+import TestUtils+import qualified Parsley.Register.Parsers as Parsers++import Prelude hiding ()+import Parsley (runParser)++-- NewRegister is required for any test and can only be tested with another component+-- so it is omitted+tests :: TestTree+tests = testGroup "Register" [ getTests+ , putTests+ , getsTests+ , modifyTests+ , moveTests+ , swapTests+ , localTests+ , bindTests+ , rollbackTests+ , forTests+ ]++getPure :: String -> Maybe Int+getPure = $$(runParserMocked Parsers.getPure [||Parsers.getPure||])++getPersists :: String -> Maybe Int+getPersists = $$(runParserMocked Parsers.getPersists [||Parsers.getPersists||])++getPersistsBranch :: String -> Maybe Int+getPersistsBranch = $$(runParserMocked Parsers.getPersistsBranch [||Parsers.getPersistsBranch||])++getNoInput :: String -> Maybe Int+getNoInput = $$(runParserMocked Parsers.getNoInput [||Parsers.getNoInput||])++getTests :: TestTree+getTests = testGroup "get should"+ [ testCase "work when given no input" $ getPure "" @?= Just 8+ , testCase "work when given input" $ getPure "a" @?= Just 8+ , testCase "persist across other parsers" $ getPersists "a" @?= Just 8+ , testCase "persist across branches" $ do+ getPersistsBranch "" @?= Just 8+ getPersistsBranch "a" @?= Just 8+ , testCase "not consume input" $ getNoInput "a" @?= Just 8+ ]++putPure :: String -> Maybe Int+putPure = $$(runParserMocked Parsers.putPure [||Parsers.putPure||])++putSeq :: String -> Maybe Char+putSeq = $$(runParserMocked Parsers.putSeq [||Parsers.putSeq||])++putPut :: String -> Maybe Int+putPut = $$(runParserMocked Parsers.putPut [||Parsers.putPut||])++putCarries :: String -> Maybe Bool+putCarries = $$(runParserMocked Parsers.putCarries [||Parsers.putCarries||])++putTests :: TestTree+putTests = testGroup "put should"+ [ testCase "work when given no input" $ putPure "" @?= Just 7+ , testCase "work when given input" $ putPure "a" @?= Just 7+ , testCase "ensure the sub-parser is ran first" $ putSeq "b" @?= Just 'b'+ , testCase "puts should override puts" $ putPut "" @?= Just 6+ , testCase "put should carry over in branches" $ do+ putCarries "" @?= Just True+ putCarries "a" @?= Just False+ ]++getsTests :: TestTree+getsTests = testGroup "gets should" [] -- gets_++modifyTests :: TestTree+modifyTests = testGroup "modify should" [] -- modify_++moveTests :: TestTree+moveTests = testGroup "move should" []++swapTests :: TestTree+swapTests = testGroup "swap should" []++localTests :: TestTree+localTests = testGroup "local should" []++bindTests :: TestTree+bindTests = testGroup "bind should" []++rollbackTests :: TestTree+rollbackTests = testGroup "rollback should" []++forTests :: TestTree+forTests = testGroup "for should" []
+ test/Parsley/Selective/Parsers.hs view
@@ -0,0 +1,1 @@+module Parsley.Selective.Parsers where
+ test/Parsley/Selective/Test.hs view
@@ -0,0 +1,37 @@+{-# LANGUAGE TemplateHaskell, UnboxedTuples, ScopedTypeVariables #-}+module Parsley.Selective.Test where+import Test.Tasty+import Test.Tasty.HUnit+import TestUtils+import qualified Parsley.Selective.Parsers as Parsers++tests :: TestTree+tests = testGroup "Selective" [ selectTests+ , filterTests+ , predicateTests+ , sbindTests+ , whenTests+ , whileTests+ , fromMaybePTests+ ]++selectTests :: TestTree+selectTests = testGroup "select should" []++filterTests :: TestTree+filterTests = testGroup "filter should" [] -- >??>, >?>, filteredBy++predicateTests :: TestTree+predicateTests = testGroup "predicate should" [] -- <?:>++sbindTests :: TestTree+sbindTests = testGroup "sbind should" [] -- match++whenTests :: TestTree+whenTests = testGroup "when should" []++whileTests :: TestTree+whileTests = testGroup "while should" []++fromMaybePTests :: TestTree+fromMaybePTests = testGroup "fromMaybeP should" []
+ test/ParsleyTest.hs view
@@ -0,0 +1,24 @@+module Main where+import Test.Tasty+import qualified Parsley.Alternative.Test as Alternative+import qualified Parsley.Applicative.Test as Applicative+import qualified Parsley.Combinator.Test as Combinator+import qualified Parsley.Fold.Test as Fold+import qualified Parsley.Precedence.Test as Precedence+import qualified Parsley.Primitive.Test as Primitive+import qualified Parsley.Register.Test as Register+import qualified Parsley.Selective.Test as Selective++main :: IO ()+main = defaultMain tests++tests :: TestTree+tests = testGroup "Parsley Tests" [ Primitive.tests+ , Alternative.tests+ , Applicative.tests+ , Combinator.tests+ , Fold.tests+ , Precedence.tests+ , Register.tests+ , Selective.tests+ ]
+ test/TestUtils.hs view
@@ -0,0 +1,85 @@+{-# LANGUAGE TemplateHaskell, TypeApplications, DeriveAnyClass, StandaloneDeriving, CPP, FlexibleInstances #-}+module TestUtils where++import Parsley (runParser, Parser, Code)+--import Parsley.Internal.Verbose ()+import Language.Haskell.TH.Syntax +#if MIN_VERSION_template_haskell(2,17,0)+ hiding (Code)+#endif+import Language.Haskell.TH.TestUtils+import Language.Haskell.TH.TestUtils.QMode+import Control.DeepSeq++#if MIN_VERSION_template_haskell(2,16,0)+import GHC.ForeignPtr+#endif++#if MIN_VERSION_template_haskell(2,17,0)+#else+unTypeCode = unTypeQ+#endif++-- TODO Use WQ: requires lift plugin to not require any Lift instance for variables (if missing)+runParserMocked :: Parser a -> Code (Parser a) -> Code (String -> Maybe a)+runParserMocked p qp = [|| \s ->+ runParserMocked' $$qp `deepseq` $$(runParser p) s+ ||]++runParserMocked' :: Parser a -> Exp+runParserMocked' = runTestQ (QState MockQ [] []) . unTypeCode . runParser @String++deriving instance NFData Exp+deriving instance NFData Name+deriving instance NFData OccName+deriving instance NFData NameFlavour+deriving instance NFData ModName+deriving instance NFData NameSpace+deriving instance NFData PkgName+deriving instance NFData Lit+#if MIN_VERSION_template_haskell(2,16,0)+deriving instance NFData Bytes+instance NFData (ForeignPtr a) where rnf = rwhnf+#endif+deriving instance NFData Type+#if MIN_VERSION_template_haskell(2,17,0)+deriving instance NFData a => NFData (TyVarBndr a)+deriving instance NFData Specificity+#else+deriving instance NFData TyVarBndr+#endif+deriving instance NFData Pat+deriving instance NFData TyLit+deriving instance NFData Match+deriving instance NFData Body+deriving instance NFData Guard+deriving instance NFData Stmt+deriving instance NFData Dec+deriving instance NFData Clause+deriving instance NFData Con+deriving instance NFData Bang+deriving instance NFData SourceUnpackedness+deriving instance NFData SourceStrictness+deriving instance NFData DerivClause+deriving instance NFData Range+deriving instance NFData DerivStrategy+deriving instance NFData FunDep+deriving instance NFData Overlap+deriving instance NFData Foreign+deriving instance NFData Callconv+deriving instance NFData Fixity+deriving instance NFData FixityDirection+deriving instance NFData Safety+deriving instance NFData Pragma+deriving instance NFData Inline+deriving instance NFData TySynEqn+deriving instance NFData RuleMatch+deriving instance NFData TypeFamilyHead+deriving instance NFData FamilyResultSig+deriving instance NFData Phases+deriving instance NFData Role+deriving instance NFData InjectivityAnn+deriving instance NFData RuleBndr+deriving instance NFData PatSynArgs+deriving instance NFData AnnTarget+deriving instance NFData PatSynDir