Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Merge pull request #7 from arvidj/issue/3-namespaces

Issue/3 namespaces
  • Loading branch information...
commit e437c29f6e08a6049e5364828ed8d9bbd72abb76 2 parents ce058a5 + b651f71
@dancor dancor authored
View
4 lex-pass.cabal
@@ -20,7 +20,7 @@ executable lex-pass
hs-source-dirs: src
main-is: Main.hs
build-depends: FUtil, HSH >= 2, MissingH, base >= 4, binary, bytestring,
- containers, derive, directory, filepath, mtl, parsec == 2.*,
+ containers, derive, directory, filepath, mtl, parsec == 3.*,
process, syb
ghc-options: -threaded
@@ -30,6 +30,6 @@ executable lex-pass-test
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 == 2.*, process, syb
+ derive, directory, filepath, mtl, parsec == 3.*, process, syb
ghc-options: -threaded
View
4 src/Common.hs
@@ -13,10 +13,6 @@ import Text.ParserCombinators.Parsec.Expr
type Oper a = Operator Char () a
-instance Applicative (GenParser Char ()) where
- pure = return
- (<*>) = ap
-
class Parse a where
parse :: Parser a
View
5 src/Lang/Php/Ast/Lex.hs
@@ -80,7 +80,7 @@ lineParser :: Parser String
lineParser = liftM2 (++) (many $ satisfy (/= '\n')) ((:[]) <$> newline)
identStartChars :: String
-identStartChars = ['a'..'z'] ++ ['A'..'Z'] ++ ['_']
+identStartChars = ['\\'] ++ ['a'..'z'] ++ ['A'..'Z'] ++ ['_']
identEndChars :: String
identEndChars = identStartChars ++ ['0'..'9']
@@ -293,6 +293,7 @@ tokSwitch = "switch"
tokThrow = "throw"
tokTry = "try"
tokUnset = "unset"
+tokUse = "use"
tokVar = "var"
tokWhile = "while"
tokXorWd = "xor"
@@ -356,6 +357,7 @@ reservedWords = Set.fromList [
tokThrow,
tokTry,
tokUnset,
+ tokUse,
tokVar,
tokWhile,
tokXorWd]
@@ -423,6 +425,7 @@ tokSwitchP = identCI tokSwitch
tokThrowP = identCI tokThrow
tokTryP = identCI tokTry
tokUnsetP = identCI tokUnset
+tokUseP = identCI tokUse
tokVarP = identCI tokVar
tokWhileP = identCI tokWhile
tokXorWdP = identCI tokXorWd
View
20 src/Lang/Php/Ast/StmtParse.hs
@@ -30,6 +30,7 @@ instance Unparse Stmt where
intercalate tokComma (map unparse a) ++ unparse end
StmtIf a -> unparse a
StmtInterface a -> unparse a
+ StmtNamespace n end -> tokNamespace ++ unparse n ++ unparse end
StmtNothing end -> unparse end
StmtReturn rMb w end -> tokReturn ++ unparse rMb ++ unparse w ++
unparse end
@@ -41,6 +42,7 @@ instance Unparse Stmt where
StmtUnset (WSCap w1 a w2) end -> tokUnset ++ unparse w1 ++ tokLParen ++
intercalate tokComma (map unparse a) ++ tokRParen ++ unparse w2 ++
unparse end
+ StmtUse n end -> tokUse ++ unparse n ++ unparse end
StmtWhile a -> unparse a
instance Unparse StmtEnd where
@@ -153,6 +155,12 @@ instance Unparse IfaceStmt where
unparse (IfaceConst vars) = cStmtConstUnparser vars
unparse (IfaceFunc a) = unparse a
+instance Unparse Namespace where
+ unparse (Namespace n) = n
+
+instance Unparse Use where
+ unparse (Use n) = n
+
instance Unparse VarMbVal where
unparse (VarMbVal var exprMb) = unparse var ++ maybe []
(\ (w, expr) -> w2With tokEquals w ++ unparse expr) exprMb
@@ -200,6 +208,8 @@ simpleStmtParser =
liftM2 (uncurry StmtExpr) parse parse <|>
StmtFuncDef <$> parse <|>
liftM2 StmtGlobal (tokGlobalP >> sepBy1 parse tokCommaP) parse <|>
+ liftM2 StmtNamespace (tokNamespaceP >> parse) parse <|>
+ liftM2 StmtUse (tokUseP >> parse) parse <|>
StmtInterface <$> parse <|>
StmtNothing <$> parse <|>
liftM3 StmtReturn (tokReturnP >> parse) (optionMaybe parse) parse <|>
@@ -405,6 +415,16 @@ instance Parse Interface where
((tokExtendsP >> sepBy1 parse tokCommaP) <|> return [])
parse
+instance Parse Namespace where
+ parse = do
+ n <- identifierParser
+ return $ Namespace n
+
+instance Parse Use where
+ parse = do
+ n <- identifierParser
+ return $ Use n
+
instance Parse IfaceStmt where
parse =
classConstParser IfaceConst <|>
View
10 src/Lang/Php/Ast/StmtTypes.hs
@@ -25,6 +25,7 @@ data Stmt =
StmtGlobal [WSCap Var] StmtEnd |
StmtIf If |
StmtInterface Interface |
+ StmtNamespace (WSCap Namespace) StmtEnd |
StmtNothing StmtEnd |
StmtReturn WS (Maybe (Expr, WS)) StmtEnd |
-- this list must have at least one element.. should i make a type for that?
@@ -33,6 +34,7 @@ data Stmt =
StmtThrow (WSCap Expr) StmtEnd |
StmtTry (WSCap (Block Stmt)) (IC.Intercal Catch WS) |
StmtUnset (WSCap [WSCap LRVal]) StmtEnd |
+ StmtUse (WSCap Use) StmtEnd |
StmtWhile While
deriving (Eq, Show, Typeable, Data)
@@ -41,6 +43,12 @@ data Stmt =
data Block a = Block (IC.Intercal WS a)
deriving (Eq, Show, Typeable, Data)
+data Namespace = Namespace String
+ deriving (Eq, Show, Typeable, Data)
+
+data Use = Use String
+ deriving (Eq, Show, Typeable, Data)
+
data Func = Func {
funcWS :: WS,
funcRef :: Maybe WS,
@@ -181,10 +189,12 @@ $(derive makeBinary ''If)
$(derive makeBinary ''IfaceStmt)
$(derive makeBinary ''IfBlock)
$(derive makeBinary ''Interface)
+$(derive makeBinary ''Namespace)
$(derive makeBinary ''Stmt)
$(derive makeBinary ''StmtEnd)
$(derive makeBinary ''Switch)
$(derive makeBinary ''TopLevel)
+$(derive makeBinary ''Use)
$(derive makeBinary ''VarMbVal)
$(derive makeBinary ''VarEqVal)
$(derive makeBinary ''While)
View
8 src/LexPassUtil.hs
@@ -7,6 +7,7 @@ import Control.Monad.State
import Data.Binary
import Data.Data
import Data.Generics
+import Data.String
import FUtil
import HSH
import Lang.Php.Ast
@@ -17,6 +18,8 @@ import System.IO
import System.Process
import qualified Data.Intercal as IC
+import Text.Parsec.Prim(Parsec)
+
--
-- transf framework
--
@@ -164,6 +167,7 @@ modAll f = stateToTransformer (everywhereM (mkM $ transformerToState f))
astPath :: FilePath -> FilePath -> FilePath
astPath codeDir subPath = codeDir </> ".ast" </> subPath ++ ".ast"
+transfModsFile :: Parsec s (Bool, b) ()
transfModsFile = updateState ((,) True . snd)
-- combine these into AnAst?
@@ -174,7 +178,7 @@ parseAndCache cacheAsts codeDir subPath = do
astFilename = astPath codeDir subPath
regen = do
hPutStrLn stderr "- Parsing"
- c <- readFileStrict $ codeDir </> subPath
+ c <- readFile $ codeDir </> subPath
case runParser parse () subPath c of
Left err -> error $ show err
Right ast -> do
@@ -193,7 +197,7 @@ parseAndCache cacheAsts codeDir subPath = do
else regen
else do
hPutStrLn stderr "- Parsing (always)"
- c <- readFileStrict $ codeDir </> subPath
+ c <- readFile $ codeDir </> subPath
return $ case runParser parse () subPath c of
Left err -> error $ show err
Right ast -> ast
Please sign in to comment.
Something went wrong with that request. Please try again.