Permalink
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...
1 parent 188ffd1 commit ed0e33a50482b34a65b884beef10dd7bd1c743a9 @dancor dancor committed Sep 14, 2012
View
@@ -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
@@ -1,6 +1,3 @@
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE TypeSynonymInstances #-}
-
module Common
(
module Control.Applicative
View
@@ -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
@@ -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
@@ -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)
-
@@ -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
@@ -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)
@@ -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
@@ -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

0 comments on commit ed0e33a

Please sign in to comment.