Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

switch from template haskell to binary-generic

I thought this would help but full recompilation is still 57s for me.
Maybe we need to split modules up more or kill the "deriving Generic" by
going to the "deriving Data"-based pretty printer?

In any case, we have removed a lot of lines of boilerplate code.
And you don't have TH spewing things at you in compilation.
  • Loading branch information...
commit ed0e33a50482b34a65b884beef10dd7bd1c743a9 1 parent 188ffd1
@dancor dancor authored
View
4 lex-pass.cabal
@@ -21,6 +21,7 @@ executable lex-pass
main-is: Main.hs
build-depends: base >= 4 && < 5,
binary,
+ binary-generic,
bytestring,
containers,
derive,
@@ -41,8 +42,9 @@ executable lex-pass-test
buildable: False
hs-source-dirs: src
main-is: Lang/Php/Ast/Test.hs
- build-depends: base >= 4,
+ build-depends: base >= 4,
binary,
+ binary-generic,
bytestring,
containers,
derive,
View
3  src/Common.hs
@@ -1,6 +1,3 @@
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE TypeSynonymInstances #-}
-
module Common
(
module Control.Applicative
View
12 src/Data/Intercal.hs
@@ -19,18 +19,6 @@ import Text.PrettyPrint.GenericPretty
data Intercal a b = Intercal a b (Intercal a b) | Interend a
deriving (Data, Eq, Generic, Show, Typeable)
--- 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
- _ -> fail "corrupt"
-
intercalParser :: Parser a -> Parser b -> Parser (Intercal a b)
intercalParser a b = do
aRes <- a
View
3  src/Data/List/NonEmpty.hs
@@ -1,6 +1,5 @@
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE TemplateHaskell #-}
module Data.List.NonEmpty where
@@ -27,5 +26,3 @@ length :: NonEmpty a -> Int
length = L.length . toList
instance (Out a) => Out (NonEmpty a)
-
-$(derive makeBinary ''NonEmpty)
View
13 src/Lang/Php/Ast.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE DeriveDataTypeable, TemplateHaskell #-}
+{-# LANGUAGE DeriveDataTypeable #-}
module Lang.Php.Ast (
module Lang.Php.Ast.Common,
@@ -7,16 +7,18 @@ module Lang.Php.Ast (
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.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)
@@ -26,6 +28,3 @@ instance Unparse Ast where
instance Parse Ast where
parse = liftM2 Ast parse stmtListP
-
-$(derive makeBinary ''Ast)
-
View
8 src/Lang/Php/Ast/Common.hs
@@ -1,3 +1,6 @@
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE UndecidableInstances #-}
+
module Lang.Php.Ast.Common
(
module Data.Binary
@@ -14,6 +17,7 @@ module Lang.Php.Ast.Common
) where
import Data.Binary
+import Data.Binary.Generic
import Data.Char
import Data.Data hiding (Infix, Prefix)
import Data.DeriveTH
@@ -24,3 +28,7 @@ import Common
import Parse
import Unparse
import Lang.Php.Ast.WS
+
+instance (Data a) => Binary a where
+ get = getGeneric
+ put = putGeneric
View
5 src/Lang/Php/Ast/Lex.hs
@@ -1,6 +1,5 @@
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE TemplateHaskell #-}
module Lang.Php.Ast.Lex where
@@ -447,7 +446,3 @@ tokAttributeP = identCI tokAttribute
instance Out HereDoc
instance Out NumLit
instance Out StrLit
-
-$(derive makeBinary ''HereDoc)
-$(derive makeBinary ''NumLit)
-$(derive makeBinary ''StrLit)
View
51 src/Lang/Php/Ast/StmtTypes.hs
@@ -1,6 +1,5 @@
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE TemplateHaskell #-}
module Lang.Php.Ast.StmtTypes where
@@ -389,53 +388,3 @@ instance Out VarMbVal
instance Out While
instance Out Xml
instance Out XmlLitOrExpr
-
-$(derive makeBinary ''AbstrFunc)
-$(derive makeBinary ''AnonFunc)
-$(derive makeBinary ''AnonFuncUse)
-$(derive makeBinary ''BinOp)
-$(derive makeBinary ''BinOpBy)
-$(derive makeBinary ''Block)
-$(derive makeBinary ''Case)
-$(derive makeBinary ''Catch)
-$(derive makeBinary ''Class)
-$(derive makeBinary ''ClassStmt)
-$(derive makeBinary ''Const)
-$(derive makeBinary ''Declare)
-$(derive makeBinary ''DoWhile)
-$(derive makeBinary ''DubArrowMb)
-$(derive makeBinary ''DynConst)
-$(derive makeBinary ''Expr)
-$(derive makeBinary ''For)
-$(derive makeBinary ''Foreach)
-$(derive makeBinary ''ForPart)
-$(derive makeBinary ''Func)
-$(derive makeBinary ''FuncArg)
-$(derive makeBinary ''If)
-$(derive makeBinary ''IfaceStmt)
-$(derive makeBinary ''IfBlock)
-$(derive makeBinary ''IncOrReq)
-$(derive makeBinary ''Interface)
-$(derive makeBinary ''LOnlyVal)
-$(derive makeBinary ''LRVal)
-$(derive makeBinary ''LVal)
-$(derive makeBinary ''Memb)
-$(derive makeBinary ''Namespace)
-$(derive makeBinary ''OnceOrNot)
-$(derive makeBinary ''PostOp)
-$(derive makeBinary ''PreOp)
-$(derive makeBinary ''ROnlyVal)
-$(derive makeBinary ''RVal)
-$(derive makeBinary ''Stmt)
-$(derive makeBinary ''StmtEnd)
-$(derive makeBinary ''Switch)
-$(derive makeBinary ''TernaryIf)
-$(derive makeBinary ''TopLevel)
-$(derive makeBinary ''Use)
-$(derive makeBinary ''Val)
-$(derive makeBinary ''Var)
-$(derive makeBinary ''VarEqVal)
-$(derive makeBinary ''VarMbVal)
-$(derive makeBinary ''While)
-$(derive makeBinary ''Xml)
-$(derive makeBinary ''XmlLitOrExpr)
View
5 src/Lang/Php/Ast/WS.hs
@@ -4,7 +4,6 @@
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverlappingInstances #-}
{-# LANGUAGE StandaloneDeriving #-}
-{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE UndecidableInstances #-}
@@ -47,8 +46,6 @@ instance Unparse WSElem where
instance Out WSElem
-$(derive makeBinary ''WSElem)
-
-- WS
type WS = [WSElem]
@@ -93,8 +90,6 @@ instance (Parse (a, WS)) => Parse (WSCap a) where
instance (Out a) => Out (WSCap a)
-$(derive makeBinary ''WSCap)
-
wsCapParser :: Parser a -> Parser (WSCap a)
wsCapParser = wsToWsCapParser . toWsParser
Please sign in to comment.
Something went wrong with that request. Please try again.