Permalink
Browse files

Initial import.

  • Loading branch information...
sebastiaanvisser committed Mar 14, 2012
0 parents commit dd5f70ad2bdeccc3f14b3e3c8ba20ab434dfbc13
Showing with 219 additions and 0 deletions.
  1. +1 −0 .gitignore
  2. +28 −0 LICENSE
  3. +26 −0 attoparsec-expr.cabal
  4. +164 −0 src/Data/Attoparsec/Expr.hs
@@ -0,0 +1 @@
+dist/
28 LICENSE
@@ -0,0 +1,28 @@
+Copyright (c) Sebastiaan Visser 2008
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions
+are met:
+1. Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+2. Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in the
+ documentation and/or other materials provided with the distribution.
+3. Neither the name of the author nor the names of his contributors
+ may be used to endorse or promote products derived from this software
+ without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE
+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+SUCH DAMAGE.
+
@@ -0,0 +1,26 @@
+Name: attoparsec-expr
+Version: 0.1
+Description: Port of parsec's expression parser to attoparsec.
+Synopsis: Port of parsec's expression parser to attoparsec.
+Category: Text, Parsing
+License: BSD3
+License-file: LICENSE
+Author: Daan Leijen, Paolo Martini
+Maintainer: Sebastiaan Visser <haskell@fvisser.nl>
+Build-Type: Simple
+Cabal-Version: >= 1.6
+
+Library
+ GHC-Options: -Wall
+ HS-Source-Dirs: src
+
+ Build-Depends:
+ base == 4.*
+ , attoparsec >= 0.9 && < 0.11
+
+ Exposed-modules: Data.Attoparsec.Expr
+
+Source-repository head
+ type: git
+ location: https://github.com/sfvisser/attoparsec-expr
+
@@ -0,0 +1,164 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module : Text.Parsec.Expr
+-- Copyright : (c) Daan Leijen 1999-2001, (c) Paolo Martini 2007
+-- License : BSD-style (see the LICENSE file)
+--
+-- Author : derek.a.elkins@gmail.com
+-- Ported by : Sebastiaan Visser <haskell@fvisser.nl>
+-- Stability : provisional
+-- Portability : non-portable
+--
+-- A helper module to parse \"expressions\".
+-- Builds a parser given a table of operators and associativities.
+--
+-----------------------------------------------------------------------------
+
+module Data.Attoparsec.Expr
+ ( Assoc(..), Operator(..), OperatorTable
+ , buildExpressionParser
+ ) where
+
+import Control.Applicative
+import Data.Monoid
+import Data.Attoparsec.Combinator
+import Data.Attoparsec.Types
+
+-----------------------------------------------------------
+-- Assoc and OperatorTable
+-----------------------------------------------------------
+
+-- | This data type specifies the associativity of operators: left, right
+-- or none.
+
+data Assoc = AssocNone
+ | AssocLeft
+ | AssocRight
+
+-- | This data type specifies operators that work on values of type @a@.
+-- An operator is either binary infix or unary prefix or postfix. A
+-- binary operator has also an associated associativity.
+
+data Operator t a = Infix (Parser t (a -> a -> a)) Assoc
+ | Prefix (Parser t (a -> a))
+ | Postfix (Parser t (a -> a))
+
+-- | An @OperatorTable@ is a list of @Operator@
+-- lists. The list is ordered in descending
+-- precedence. All operators in one list have the same precedence (but
+-- may have a different associativity).
+
+type OperatorTable t a = [[Operator t a]]
+
+-----------------------------------------------------------
+-- Convert an OperatorTable and basic term parser into
+-- a full fledged expression parser
+-----------------------------------------------------------
+
+-- | @buildExpressionParser table term@ builds an expression parser for
+-- terms @term@ with operators from @table@, taking the associativity
+-- and precedence specified in @table@ into account. Prefix and postfix
+-- operators of the same precedence can only occur once (i.e. @--2@ is
+-- not allowed if @-@ is prefix negate). Prefix and postfix operators
+-- of the same precedence associate to the left (i.e. if @++@ is
+-- postfix increment, than @-2++@ equals @-1@, not @-3@).
+--
+-- The @buildExpressionParser@ takes care of all the complexity
+-- involved in building expression parser. Here is an example of an
+-- expression parser that handles prefix signs, postfix increment and
+-- basic arithmetic.
+--
+-- > expr = buildExpressionParser table term
+-- > <?> "expression"
+-- >
+-- > term = parens expr
+-- > <|> natural
+-- > <?> "simple expression"
+-- >
+-- > table = [ [prefix "-" negate, prefix "+" id ]
+-- > , [postfix "++" (+1)]
+-- > , [binary "*" (*) AssocLeft, binary "/" (div) AssocLeft ]
+-- > , [binary "+" (+) AssocLeft, binary "-" (-) AssocLeft ]
+-- > ]
+-- >
+-- > binary name fun assoc = Infix (do{ reservedOp name; return fun }) assoc
+-- > prefix name fun = Prefix (do{ reservedOp name; return fun })
+-- > postfix name fun = Postfix (do{ reservedOp name; return fun })
+
+buildExpressionParser :: Monoid t => [[Operator t b]] -> Parser t b -> Parser t b
+buildExpressionParser operators simpleExpr
+ = foldl makeParser simpleExpr operators
+ where
+ makeParser term ops
+ = let (rassoc,lassoc,nassoc
+ ,prefix,postfix) = foldr splitOp ([],[],[],[],[]) ops
+
+ rassocOp = choice rassoc
+ lassocOp = choice lassoc
+ nassocOp = choice nassoc
+ prefixOp = choice prefix
+ postfixOp = choice postfix
+
+ ambigious assoc op= do{ _ <- op; fail ("ambiguous use of a " ++ assoc
+ ++ " associative operator")
+ }
+
+ ambigiousRight = ambigious "right" rassocOp
+ ambigiousLeft = ambigious "left" lassocOp
+ ambigiousNon = ambigious "non" nassocOp
+
+ termP = do{ pre <- prefixP
+ ; x <- term
+ ; post <- postfixP
+ ; return (post (pre x))
+ }
+
+ postfixP = postfixOp <|> return id
+
+ prefixP = prefixOp <|> return id
+
+ rassocP x = do{ f <- rassocOp
+ ; y <- do{ z <- termP; rassocP1 z }
+ ; return (f x y)
+ }
+ <|> ambigiousLeft
+ <|> ambigiousNon
+ -- <|> return x
+
+ rassocP1 x = rassocP x <|> return x
+
+ lassocP x = do{ f <- lassocOp
+ ; y <- termP
+ ; lassocP1 (f x y)
+ }
+ <|> ambigiousRight
+ <|> ambigiousNon
+ -- <|> return x
+
+ lassocP1 x = lassocP x <|> return x
+
+ nassocP x = do{ f <- nassocOp
+ ; y <- termP
+ ; ambigiousRight
+ <|> ambigiousLeft
+ <|> ambigiousNon
+ <|> return (f x y)
+ }
+ -- <|> return x
+
+ in do{ x <- termP
+ ; rassocP x <|> lassocP x <|> nassocP x <|> return x
+ }
+
+
+ splitOp (Infix op assoc) (rassoc,lassoc,nassoc,prefix,postfix)
+ = case assoc of
+ AssocNone -> (rassoc,lassoc,op:nassoc,prefix,postfix)
+ AssocLeft -> (rassoc,op:lassoc,nassoc,prefix,postfix)
+ AssocRight -> (op:rassoc,lassoc,nassoc,prefix,postfix)
+
+ splitOp (Prefix op) (rassoc,lassoc,nassoc,prefix,postfix)
+ = (rassoc,lassoc,nassoc,op:prefix,postfix)
+
+ splitOp (Postfix op) (rassoc,lassoc,nassoc,prefix,postfix)
+ = (rassoc,lassoc,nassoc,prefix,op:postfix)

0 comments on commit dd5f70a

Please sign in to comment.