Permalink
Browse files

Merge branch 'master' of git://github.com/facebook/lex-pass

  • Loading branch information...
2 parents c87f981 + e8e4e35 commit 9816cc258098448f74caf3e3e35599a623a27f97 @arvidj arvidj committed Sep 17, 2012
View
@@ -0,0 +1 @@
+/src/CodeGen/Transf.hs
View
@@ -19,17 +19,41 @@ executable lex-pass
buildable: False
hs-source-dirs: src
main-is: Main.hs
- build-depends: FUtil, HSH >= 2, MissingH, base >= 4, binary, bytestring,
- containers, derive, directory, filepath, mtl, parsec == 3.*,
- process, syb
+ build-depends: base >= 4 && < 5,
+ binary,
+ binary-generic,
+ bytestring,
+ containers,
+ directory,
+ filepath,
+ FUtil,
+ GenericPretty,
+ HSH >= 2 && < 3,
+ MissingH,
+ mtl,
+ parsec >= 3 && < 4,
+ process,
+ syb
ghc-options: -threaded
executable lex-pass-test
if !flag(test-only)
buildable: False
hs-source-dirs: src
main-is: Lang/Php/Ast/Test.hs
- build-depends: FUtil, HSH >= 2, base >= 4, binary, bytestring, containers,
- derive, directory, filepath, mtl, parsec == 3.*, process, syb
+ build-depends: base >= 4,
+ binary,
+ binary-generic,
+ bytestring,
+ containers,
+ directory,
+ filepath,
+ FUtil,
+ GenericPretty,
+ HSH >= 2 && < 3,
+ mtl,
+ parsec >= 3 && < 4,
+ process,
+ syb
ghc-options: -threaded
View
@@ -1,40 +1,12 @@
-{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}
-
-module Common (
- module Text.ParserCombinators.Parsec,
- Oper, Parse(..), Unparse(..)) where
-
-import Control.Applicative hiding (many, (<|>))
+module Common
+ (
+ module Control.Applicative
+ , module Control.Arrow
+ , module Control.Monad
+ , module Text.ParserCombinators.Parsec
+ ) where
+
+import Control.Applicative hiding ((<|>), many, optional, Const)
+import Control.Arrow
import Control.Monad
import Text.ParserCombinators.Parsec hiding (State, parse, choice)
-import Text.ParserCombinators.Parsec.Expr
-
--- parsec 2 vs 3 stuff
-
-type Oper a = Operator Char () a
-
-class Parse a where
- parse :: Parser a
-
-class Unparse a where
- unparse :: a -> String
-
-instance (Parse a) => Parse [a] where
- parse = many parse
-
-instance (Parse a, Parse b) => Parse (Either a b) where
- parse = Left <$> parse <|> Right <$> parse
-
-instance (Unparse a, Unparse b) => Unparse (Either a b) where
- unparse (Left a) = unparse a
- unparse (Right a) = unparse a
-
-instance (Unparse a, Unparse b) => Unparse (a, b) where
- unparse (a, b) = unparse a ++ unparse b
-
-instance (Unparse a) => Unparse [a] where
- unparse = concatMap unparse
-
-instance (Unparse a) => Unparse (Maybe a) where
- unparse = maybe "" unparse
-
View
@@ -1,8 +1,8 @@
{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DeriveGeneric #-}
module Data.Intercal where
-import Common
import Control.Arrow
import Control.Applicative
import Control.Monad
@@ -11,19 +11,13 @@ import Data.Data
import Prelude hiding (concatMap, map)
import qualified Prelude
+import Common
+import Parse
+import Unparse
+import Text.PrettyPrint.GenericPretty
+
data Intercal a b = Intercal a b (Intercal a b) | Interend a
- deriving (Eq, Show, Typeable, Data)
-
--- we're using method that should be faster-but-bigger instead of storing
--- length. this is probably the same as the derive one, just use that?
-instance (Binary a, Binary b) => Binary (Intercal a b) where
- put (Intercal x y r) = put (0 :: Word8) >> put x >> put y >> put r
- put (Interend x) = put (1 :: Word8) >> put x
- get = do
- tag <- getWord8
- case tag of
- 0 -> liftM3 Intercal get get get
- 1 -> liftM Interend get
+ deriving (Data, Eq, Generic, Show, Typeable)
intercalParser :: Parser a -> Parser b -> Parser (Intercal a b)
intercalParser a b = do
@@ -105,3 +99,4 @@ append :: a -> b -> Intercal b a -> Intercal b a
append a b (Interend b0) = Intercal b0 a $ Interend b
append a b (Intercal b0 a0 rest) = Intercal b0 a0 $ append a b rest
+instance (Out a, Out b) => Out (Intercal a b)
View
@@ -0,0 +1,27 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DeriveGeneric #-}
+
+module Data.List.NonEmpty where
+
+import Data.Binary
+import Data.Data
+import qualified Data.List as L
+import Text.PrettyPrint.GenericPretty
+
+-- | A non-empty list
+data NonEmpty a = NonEmpty
+ { head :: a
+ , tail :: [a]
+ } deriving (Data, Eq, Generic, Show, Typeable)
+
+toList :: NonEmpty a -> [a]
+toList (NonEmpty x xs) = x:xs
+
+fromList :: [a] -> Maybe (NonEmpty a)
+fromList [] = Nothing
+fromList (x:xs) = Just $ NonEmpty x xs
+
+length :: NonEmpty a -> Int
+length = L.length . toList
+
+instance (Out a) => Out (NonEmpty a)
View
@@ -1,24 +1,24 @@
-{-# LANGUAGE DeriveDataTypeable, TemplateHaskell #-}
+{-# LANGUAGE DeriveDataTypeable #-}
module Lang.Php.Ast (
module Lang.Php.Ast.Common,
- module Lang.Php.Ast.Expr,
module Lang.Php.Ast.Lex,
module Lang.Php.Ast.Stmt,
Ast
) where
-import Common
import Control.Applicative hiding ((<|>), many)
import Control.Arrow
import Control.Monad
+import Data.Binary.Generic
import Data.Char
+
+import Common
+import qualified Data.ByteString as BS
+import qualified Data.Intercal as IC
import Lang.Php.Ast.Common
-import Lang.Php.Ast.Expr
import Lang.Php.Ast.Lex
import Lang.Php.Ast.Stmt
-import qualified Data.ByteString as BS
-import qualified Data.Intercal as IC
data Ast = Ast TopLevel StmtList
deriving (Eq, Show, Typeable, Data)
@@ -27,7 +27,4 @@ instance Unparse Ast where
unparse (Ast t s) = unparse t ++ unparse s
instance Parse Ast where
- parse = liftM2 Ast parse stmtListParser
-
-$(derive makeBinary ''Ast)
-
+ parse = liftM2 Ast parse stmtListP
@@ -1,11 +1,23 @@
-{-# LANGUAGE DeriveDataTypeable, TemplateHaskell #-}
-
module Lang.Php.Ast.ArgList where
import Data.Either.Utils
+
+import qualified Data.List.NonEmpty as NE
import Lang.Php.Ast.Common
import Lang.Php.Ast.Lex
-import qualified Data.Intercal as IC
+
+type ArgList a = Either WS [WSCap a]
+
+type ReqArgList a = NE.NonEmpty (WSCap a)
+
+argListUnparser :: Unparse a => Unparser (ArgList a)
+argListUnparser x =
+ tokLParen ++
+ either unparse (intercalate tokComma . map unparse) x ++
+ tokRParen
+
+reqArgListUnparser :: Unparse a => Unparser (ReqArgList a)
+reqArgListUnparser = argListUnparser . Right . NE.toList
-- e.g. ($a, $b, $c) in f($a, $b, $c) or () in f()
argListParser :: Parser (a, WS) -> Parser (Either WS [WSCap a])
@@ -25,9 +37,9 @@ mbArgListParser :: Parser (a, WS) -> Parser (Either WS [Either WS (WSCap a)])
mbArgListParser = genArgListParser True False True True
-- e.g. ($a, $b, $c) in isset($a, $b, $c)
-issetListParser :: Parser (a, WS) -> Parser [WSCap a]
-issetListParser = fmap (map fromRight . fromRight) .
- genArgListParser False False False True
+reqArgListParser :: Parser (a, WS) -> Parser (ReqArgList a)
+reqArgListParser p = fromJust . NE.fromList . map fromRight . fromRight <$>
+ genArgListParser False False False True p
-- todo: this can just be separate right?
-- e.g. ($a) in exit($a) or () in exit()
@@ -38,8 +50,7 @@ exitListParser = fmap (fmap (fromRight . head)) .
genArgListParser :: Bool -> Bool -> Bool -> Bool -> Parser (a, WS) ->
Parser (Either WS [Either WS (WSCap a)])
genArgListParser emptyElemsAllowed finalCommaAllowed singleWSPoss
- overOneArgAllowed p = do
- tokLParenP
+ overOneArgAllowed p = tokLParenP >> do
args <- grabArgs emptyElemsAllowed finalCommaAllowed singleWSPoss
overOneArgAllowed p
return $ case args of
@@ -66,4 +77,3 @@ grabArgs emptyElemsAllowed finalCommaAllowed isFirstArgAndWSPoss
grabArgs emptyElemsAllowed finalCommaAllowed False overOneArgAllowed p
(arg:) <$> (if canContinue then ((tokCommaP >> cont) <|>) else id)
(tokRParenP >> return [])
-
Oops, something went wrong.

0 comments on commit 9816cc2

Please sign in to comment.