ADPfusion 0.2.0.2 → 0.2.0.3

raw patch · 2 files changed

+48/−1 lines, 2 files

Files

• ADP/Fusion/TH.hs +46/−0
• ADPfusion.cabal +2/−1

@@ -0,0 +1,46 @@+{-# LANGUAGE TemplateHaskell #-}++module ADP.Fusion.TH where++import Language.Haskell.TH+import Language.Haskell.TH.Syntax+import Data.List+import qualified Data.Vector.Fusion.Stream.Monadic as SM++++-- | Create the algebra product function from a signature type constructor.++makeAlgebraProduct :: Name -> Q [Dec]+makeAlgebraProduct nm = do+  rnm <- reify nm+  case rnm of+    TyConI (DataD ctx tyConName args cs d) -> case cs of+      -- we analyze the accessor functions and look for the objective function+      -- accessor. It's stream parameter is the type of the non-terminal.+      -- Everything else in accessors are terminal parameters.+      [RecC dataConName fs] -> do+        -- find the objective function type (we crash if the user has more than+        -- one)+        let [oF] = filter (isObjectiveF . sel3) fs+        error $ unlines $ intersperse "\n" $ map show fs+      _   -> fail "more than one data ctor"+    _          -> fail "unsupported data type"++sel3 (a,b,c) = c++zzz :: VarStrictType -> String+zzz (nm,s,t) = show (nm,s,t)++isObjectiveF :: Type -> Bool+isObjectiveF (AppT (AppT ArrowT (AppT (AppT (ConT s) _) _)) (AppT _ _)) | s == ''SM.Stream = True+isObjectiveF _ = False++-- AppT (AppT ArrowT+--            (AppT (AppT (ConT Data.Vector.Fusion.Stream.Monadic.Stream)+--                        (VarT m_1627401654)+--                  )+--            (VarT x_1627401655)+--            )+--      )+--      (AppT (VarT m_1627401654) (VarT r_1627401656))

@@ -1,5 +1,5 @@ name:           ADPfusion-version:        0.2.0.2+version:        0.2.0.3 author:         Christian Hoener zu Siederdissen, 2011-2013 copyright:      Christian Hoener zu Siederdissen, 2011-2013 homepage:       http://www.tbi.univie.ac.at/~choener/adpfusion@@ -104,6 +104,7 @@     ADP.Fusion.QuickCheck     ADP.Fusion.Region     ADP.Fusion.Table+    ADP.Fusion.TH    ghc-options:     -O2 -funbox-strict-fields