gll 0.4.0.2 → 0.4.0.3

raw patch · 5 files changed

+148/−44 lines, 5 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• changelog.txt +11/−0
• gll.cabal +1/−1
• src/GLL/Combinators/Interface.hs +54/−26
• src/GLL/Combinators/Lexer.hs +75/−14
• src/GLL/Types/Grammar.hs +7/−3

@@ -24,3 +24,14 @@   + generalised `within`   + different whitespace and comment handling in predefined lexer   + predefined lexer handles (nested) comment-blocks++0.4.0.2 -> 0.4.0.3+  M added hex, octal and binary representation to integer literals+  + added float literals+  + exporting `preferably` and `reluctantly`+  M renamed `rassoc` to shortest_match+  M renamed `lassoc` to longest_match+  - removed `assoc`+  + version of `chooses` that is left-biased (w.r.t. alternatives)+  + generalised arguments of longest_match and shortest_match to IsAltExpr +  + exporting `optionalWithDef`

@@ -3,7 +3,7 @@  -- The name of the package. name:                gll-version:             0.4.0.2+version:             0.4.0.3 synopsis:            GLL parser with simple combinator interface  license:             BSD3 license-file:        LICENSE

@@ -182,7 +182,7 @@     -- * Elementary parsers     term_parser, satisfy,     -- ** Elementary parsers using the 'Token' datatype -    keychar, keyword, int_lit, bool_lit, char_lit, string_lit, alt_id_lit, id_lit, token,+    keychar, keyword, int_lit, float_lit, bool_lit, char_lit, string_lit, alt_id_lit, id_lit, token,     -- ** Elementary character-level parsers     char,      -- * Elementary combinators@@ -193,7 +193,7 @@     -- *** Semantic actions     (<$$>),     -- *** Nonterminal introduction-    (<:=>),(<::=>),chooses,+    (<:=>),(<::=>),chooses,chooses_prec,     -- * Types     -- ** Grammar (combinator expression) types     BNF, SymbExpr, AltExpr, AltExprs,@@ -223,11 +223,12 @@     -- *** Ignoring semantic results     (<$$), (**>), (<**),     -- *** EBNF patterns-    optional, multiple, multiple1, multipleSepBy, multipleSepBy1,+    optional, preferably, reluctantly, optionalWithDef,+    multiple, multiple1, multipleSepBy, multipleSepBy1,       multipleSepBy2, within, parens, braces, brackets, angles,      -- *** Disambiguation               (<:=), (<::=),(<<<**>), (<**>>>), (<<**>), (<<<**), (**>>>), (<**>>),-            rassoc, lassoc, assoc,+            longest_match,shortest_match,             many, many1, some, some1,              manySepBy, manySepBy1, manySepBy2,                someSepBy, someSepBy1,someSepBy2,@@ -348,10 +349,15 @@ (<::=>) :: (Show t, Ord t, HasAlts b) => String -> b t a -> SymbExpr t a  x <::=> altPs = mkNtRule True False x altPs --- | Variant of <::=> that can be supplied with a list of alternates-chooses :: (Show t, Ord t) => String -> [AltExpr t a] -> SymbExpr t a-chooses p alts = (<::=>) p (OO alts)+-- | Variant of '<::=>' that can be supplied with a list of alternates+chooses :: (Show t, Ord t, IsAltExpr alt) => String -> [alt t a] -> SymbExpr t a+chooses p alts = (<::=>) p (OO (map toAlt alts)) +-- | Variant of '<::=' that can be supplied with a list of alternates+chooses_prec :: (Show t, Ord t, IsAltExpr alt) => String -> [alt t a] -> SymbExpr t a+chooses_prec p alts = (<::=) p (OO (map toAlt alts))++ infixl 4 <$$> -- | -- Form an 'AltExpr' by mapping some semantic action overy the result@@ -390,22 +396,17 @@              in OO (l : r)  -- |--- Apply this combinator to an alternative to indicate that the alternative--- is for a left-associative operator. Used for top-down disambiguation.-lassoc :: AltExpr t a -> AltExpr t a-lassoc (AltExpr (v1,v2,v3)) = AltExpr (v1,v2,\opts -> v3 (maximumPivot opts))---- |--- Apply this combinator to an alternative to indicate that the alternative--- is for a right-associative operator. Used for top-down disambiguation.-rassoc :: AltExpr t a -> AltExpr t a-rassoc (AltExpr (v1,v2,v3)) = AltExpr (v1,v2,\opts -> v3 (minimumPivot opts))+-- Apply this combinator to an alternative to turn all underlying occurrences+-- of '<**>' (or variants) apply 'longest match'.+longest_match :: (Show t, Ord t, IsAltExpr alt) => alt t a -> AltExpr t a+longest_match isalt = AltExpr (v1,v2,\opts -> v3 (maximumPivot opts))+  where AltExpr (v1,v2,v3) = toAlt isalt  --- |--- Apply this combinator to an alternative to indicate that the alternative--- is for an associative operator. Used for top-down disambiguation.-assoc :: AltExpr t a -> AltExpr t a-assoc = lassoc+-- Apply this combinator to an alternative to turn all underlying occurrences+-- of '<**>' (or variants) apply 'shortest match'.+shortest_match :: (Show t, Ord t, IsAltExpr alt) => alt t a -> AltExpr t a+shortest_match isalt = AltExpr (v1,v2,\opts -> v3 (minimumPivot opts))+  where AltExpr (v1,v2,v3) = toAlt isalt   -- | Create a symbol-parse for a terminal given: --@@ -458,6 +459,13 @@  where  unwrap (Just (IntLit (Just i)))  = i         unwrap _ = error "int_lit: downcast, or token without lexeme" +-- | Parse a single floating point literal, using a 'SubsumesToken' type.+-- Returns the lexeme interpreted as a 'Double'.+float_lit :: SubsumesToken t => SymbExpr t Double+float_lit  = term_parser (upcast (FloatLit Nothing)) (unwrap . downcast)+ where  unwrap (Just (FloatLit (Just i)))  = i+        unwrap _ = error "float_lit: downcast, or token without lexeme"+ -- | Parse a single Boolean, using a 'SubsumesToken' type. -- Returns the lexeme interpreter as a Boolean. bool_lit :: SubsumesToken t => SymbExpr t Bool@@ -687,11 +695,31 @@ manySepBy2 p s = mkRule $    (:) <$$> p <** s <**> manySepBy1 p s --- | Make a piece of BNF optional, but proceed if unsuccessful --- (yielding 'Nothing' as a result in that case).+-- | Derive either from the given symbol or the empty string. optional :: (Show t, Ord t, IsSymbExpr s) => s t a -> SymbExpr t (Maybe a)-optional p = let fresh = mkNt p "?"-                in fresh <::=> Just <$$> p <||> satisfy Nothing +optional p = fresh +  <:=>  Just <$$> p +  <||>  satisfy Nothing +  where fresh = mkNt p "?"++-- | Version of 'optional' that prefers to derive from the given symbol+-- affects only nullable nonterminal symbols+preferably :: (Show t, Ord t, IsSymbExpr s) => s t a -> SymbExpr t (Maybe a)+preferably p = fresh +  <:=   Just <$$> p +  <||>  satisfy Nothing +  where fresh = mkNt p "?"++-- | Version of 'optional' that prefers to derive the empty string from +-- the given symbol, effects only nullable nonterminal symbols+reluctantly :: (Show t, Ord t, IsSymbExpr s) => s t a -> SymbExpr t (Maybe a)+reluctantly p = fresh +  <:=   satisfy Nothing  +  <||>  Just <$$> p+  where fresh = mkNt p "?"++optionalWithDef :: (Show t, Ord t, IsSymbExpr s) => s t a -> a -> SymbExpr t a +optionalWithDef p def = mkNt p "?" <:=> id <$$> p <||> satisfy def  -- | Place a piece of BNF /within/ two other BNF fragments, ignoring their semantics. within :: IsSymbExpr s => BNF Token a -> s Token b -> BNF Token c -> BNF Token b

@@ -1,12 +1,14 @@  module GLL.Combinators.Lexer (     default_lexer, lexer, LexerSettings(..), emptyLanguage,+    oneOf, manyOf, someOf, baseToDec,     ) where  import GLL.Types.Grammar (Token(..), SubsumesToken(..)) import Data.List (isPrefixOf) import Data.Char (isSpace, isDigit, isAlpha, isUpper, isLower) import Text.Regex.Applicative+import Text.Regex.Applicative.Common (signed)  -- | Settings for changing the behaviour of the builtin lexer 'lexer'. -- Lexers are built using "Text.Regex.Applicative".@@ -73,30 +75,89 @@ lTokens lexsets =         lCharacters     <|> lKeywords-    <|> charsToInt  <$> optional (sym '-') <*> some (psym isDigit)+    <|> upcast . IntLit . Just <$> lIntegers +    <|> upcast . FloatLit . Just <$> lFloats     <|> upcast . IDLit . Just <$> identifiers lexsets      <|> upcast . AltIDLit . Just <$> altIdentifiers lexsets     <|> upcast . CharLit . Just <$> lCharLit     <|> upcast . StringLit . Just <$> lStringLit     <|> lMore-    where   -            charsToInt Nothing n = upcast (IntLit (Just (read n)))-            charsToInt (Just _) n = upcast (IntLit (Just (-(read n))))+  where     lMore = foldr ((<|>) . uncurry lToken) empty (tokens lexsets)              lChar c = upcast (Char c) <$ sym c-            lCharacters = foldr ((<|>) . lChar) empty (keychars lexsets) +            lCharacters = foldr ((<|>) . lChar) empty (keychars lexsets)              lKeyword k  = upcast (Keyword k) <$ string k             lKeywords = foldr ((<|>) . lKeyword) empty (keywords lexsets) -            lMore = foldr ((<|>) . uncurry lToken) empty (tokens lexsets)-            lToken t re = upcast . Token t . Just <$> re+lToken t re = upcast . Token t . Just <$> re -            lStringLit = toString <$ sym '\"' <*> many strChar <* sym '\"'-             where strChar =  sym '\\' *> sym '\"'-                              <|> psym ((/=) '\"')-                   toString inner = read ("\"" ++ inner ++ "\"")+lStringLit = toString <$ sym '\"' <*> many strChar <* sym '\"'+ where strChar =  sym '\\' *> sym '\"'+                  <|> psym ((/=) '\"')+       toString inner = read ("\"" ++ inner ++ "\"") -            lCharLit = id <$ sym '\'' <*> charChar <* sym '\''-              where charChar = sym '\\' *> sym '\''-                                <|> psym ((/=) '\'')+lCharLit = id <$ sym '\'' <*> charChar <* sym '\''+  where charChar = sym '\\' *> sym '\''+                    <|> psym ((/=) '\'')++lFloats :: RE Char Double+lFloats = signed ( read <$> (+        mkDP <$> decimal <*> sym '.' <*> decimal <*> optional exponent +    <|> mkEP <$> decimal <*> exponent+  ))+  where mkDP pre _ post mexp = pre ++ "." ++ post ++ maybe "" id mexp+        mkEP pre exp = pre ++ exp++        exponent = mk <$> (sym 'e' <|> sym 'E') +                      <*> optional (sym '+' <|> sym '-')+                      <*> decimal+         where mk pre sign dec = pre : maybe "" (:[]) sign ++ dec++lIntegers :: RE Char Int+lIntegers = signed (+      (read <$> decimal)+  <|> (baseToDec 16 <$ hexPrefix <*> someOf (['0'..'9']++['A'..'F']++['a'..'f']))+  <|> (baseToDec 8  <$ octPrefix <*> someOf ['0'..'7'])+  <|> (baseToDec 2  <$ binPrefix <*> someOf ['0','1'])+  )+  where hexPrefix = string "0x" <|> string "0X"+        octPrefix = string "0o" <|> string "0O"+        binPrefix = string "0b" <|> string "0B" +    +decimal :: RE Char String+decimal = someOf ['0'..'9'] + +-- | Convert numerical representation in a given base +--  (max base = 16, written as string)+--  into decimal representation (returned as Int)+baseToDec :: Int -> String -> Int+baseToDec base = baseToDec' 0 base . map toInt+  where baseToDec' acc base [] = acc+        baseToDec' acc base (d:ds) = baseToDec' (acc * base + d) base ds+        toInt c | c == 'A' || c == 'a' = 10+                | c == 'B' || c == 'b' = 11+                | c == 'C' || c == 'c' = 12+                | c == 'D' || c == 'd' = 13+                | c == 'E' || c == 'e' = 14+                | c == 'F' || c == 'f' = 15+                | otherwise = read [c]+ +oneOf :: Eq t => [t] -> RE t t       +oneOf ts = psym (\t -> t `elem` ts)++manyOf :: Eq t => [t] -> RE t [t]+manyOf ts = many (oneOf ts) ++someOf :: Eq t => [t] -> RE t [t]+someOf ts = some (oneOf ts) ++{-++manyOf :: Eq t => [t] -> RE t [t]+manyOf ts = empty <|> someOf ts++someOf :: Eq t => [t] -> RE t [t]+someOf ts = (:) <$> oneOf ts <*> manyOf ts++-}

@@ -52,6 +52,7 @@            | EOS            | Epsilon            | IntLit     (Maybe Int)+           | FloatLit   (Maybe Double)            | BoolLit    (Maybe Bool)            | StringLit  (Maybe String)            | CharLit    (Maybe Char)@@ -93,23 +94,25 @@  instance SubsumesToken Token where     upcast = id-    downcast = Just . id+    downcast = Just  deriving instance Ord Token deriving instance Eq Token  instance Show Token where-    show (Char c)             = "char('" ++ [c] ++ "')"+    show (Char c)             = "keychar('" ++ [c] ++ "')"     show (Keyword s)          = "keyword(\"" ++ s ++ "\")"     show (EOS)                = "<end-of-string>"     show (Epsilon)            = "<epsilon>"     show (IntLit (Just i))    = "int(" ++  show i ++ ")"     show (IntLit _)           = "<int>"+    show (FloatLit (Just i))  = "float(" ++  show i ++ ")"+    show (FloatLit _)         = "<float>"     show (BoolLit (Just b))   = "bool(" ++  show b ++ ")"     show (BoolLit _)          = "<bool>"     show (StringLit (Just s)) = "string(\"" ++ s ++ "\")"     show (StringLit _)        = "<string>"-    show (CharLit (Just c))   = "char-literal('" ++ [c] ++ "')"+    show (CharLit (Just c))   = "char('" ++ [c] ++ "')"     show (CharLit Nothing)    = "<char>"     show (AltIDLit (Just id)) = "altid(\"" ++ id ++ "\")"     show (AltIDLit Nothing)   = "<altid>"@@ -132,6 +135,7 @@     StringLit _ `matches` StringLit _  = True     CharLit _   `matches` CharLit _    = True     IntLit _    `matches` IntLit _     = True+    FloatLit _  `matches` FloatLit _   = True     BoolLit _   `matches` BoolLit _    = True     AltIDLit _  `matches` AltIDLit _   = True     IDLit _     `matches` IDLit _      = True