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

.gitignore

@@ -0,0 +1 @@
+/src/CodeGen/Transf.hs

lex-pass.cabal

@@ -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
 

src/Common.hs

@@ -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
-

src/Data/Intercal.hs

@@ -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)

src/Data/List/NonEmpty.hs

@@ -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)

src/Lang/Php/Ast.hs

@@ -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

src/Lang/Php/Ast/ArgList.hs

@@ -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 [])
-