diff --git a/src/EMGMTestData.hs b/src/EMGMTestData.hs deleted file mode 100644 index 43f15eb..0000000 --- a/src/EMGMTestData.hs +++ /dev/null @@ -1,108 +0,0 @@ -{-# LANGUAGE TypeOperators #-} - -module EMGMTestData where - -import DGG.Adapter.EMGM ---import Language.Haskell.Exts.Syntax -import Generics.EMGM as E -import Prelude as P -import DGG.Data as M ---import Language.Haskell.Exts.Pretty - --- Test code: --- -data Tree a = Leaf a | Branch (Tree a) (Tree a) | LBranch (Tree a) (Tree a) (Tree a) -data Foo = Bar | Baz | Bat - -data List a = Nil | Cons a (List a) -type ListRep a = Unit :+: a :*: List a - -listEP :: EP (List a) (ListRep a) -listEP = EP from to - where - from Nil = L Unit - from (Cons a la) = R (a :*: la) - to (L Unit) = Nil - to (R (a :*: la)) = Cons a la - -data Foo' = Bar' - -ggEPA = EP from to - where - from Ba = L Unit - from Ca = R (L Unit) - from Da = R (R (L Unit)) - from Ea = R (R (R Unit)) - to (L Unit) = Ba - to (R (L Unit)) = Ca - to (R (R (L Unit))) = Da - to (R (R (R Unit))) = Ea - - -ggFoo' :: EP Foo' Unit -ggFoo' = EP from' to' - where - from' Bar' = Unit - to' Unit = Bar' - -ggEPTree :: EP (Tree t) (t :+: Tree t :*: Tree t - :+: Tree t :*: Tree t :*: Tree t) -ggEPTree = EP from' to' where - from' (Leaf a) = L a - from' (Branch a b) = R (L (a :*: b)) - from' (LBranch a b c) = R (R (a :*: b :*: c)) - to' (L a) = Leaf a - to' (R (L (a :*: b))) = Branch a b - to' (R (R (a :*: b :*: c))) = LBranch a b c - -ggFoo :: EP Foo (Unit :+: (Unit :+: Unit)) -ggFoo = EP from' to' - where - from' Bar = L Unit - from' Baz = R (L Unit) - from' Bat = R (R Unit) - to' (L Unit) = Bar - to' (R (L Unit)) = Baz - to' (R (R Unit)) = Bat - -data A = Ba | Ca | Da | Ea -{- - -aTC = TCInfo "A" TyDataType [ - VCInfo "Ba" 0 0 Nonfix M.LeftAssoc [], - VCInfo "Ca" 0 1 Nonfix M.LeftAssoc [], - VCInfo "Da" 0 2 Nonfix M.LeftAssoc [], - VCInfo "Ea" 0 3 Nonfix M.LeftAssoc []] -aList = TCInfo "List" TyDataType [ - VCInfo "Nil" 0 0 Nonfix M.LeftAssoc [], - VCInfo "List" 2 1 Nonfix M.LeftAssoc [ Record Nothing "a" undefined - , Record Nothing "b" undefined]] - - -data Comp f g a = C (f (g a)) - - -ggComp = EP from' to' where - from' (C fga) = fga - to' fga = C fga - -data HFix f a = Hln (f (HFix f) a) --} --- To describe any value constructor in an EP, all that is required are the --- value constructor name and the number of records to the value constructor. --- These do need to be given unique names, but their type is not explicitly --- refered to in the EP. --- --- The types are required in order to generate a type signature though. --- The question is if we want to generate a type signature for the EP. In --- general, the compiler can infer that by itself. TODO: Ask Sean about cases --- where the compiler would fail to infer the types. -{-ggHFix = EP from' to' where - from' (Hln ffa) = ffa - to' ffa = Hln ffa --} -{- -[UnBangedTy (TyParen (TyApp (TyApp (TyVar (Ident "f")) - (TyParen (TyApp (TyCon (UnQual (Ident "HFix"))) - (TyVar (Ident "f"))))) (TyVar (Ident "a"))))] --} diff --git a/src/HSEParser.hs b/src/HSEParser.hs deleted file mode 100644 index 80c98c6..0000000 --- a/src/HSEParser.hs +++ /dev/null @@ -1,126 +0,0 @@ -module Main where - -import Language.Haskell.Exts -import DGG.Data - ---testFile = "testmodule.hs" ---testFile = "EMGMTestData.hs" ---testFile = "Reps.hs" ---testFile = "SYBTest.hs" -testFile = "foo.hs" - -main = - do pr <- parseFile testFile - do case pr of - (ParseOk a) -> processModule a - (ParseFailed _ m) -> putStrLn m - -processModule :: Module -> IO () -processModule (Module sl mn mps mwt mess ids ds) = - do printSrcLoc sl - printModuleInfo mn - printPragmas mps - printWarning mwt - printExports mess - printImports ids - printDecls ds - -printSrcLoc :: SrcLoc -> IO () -printSrcLoc (SrcLoc fn l c) = putStrLn $ fn ++ " l: " ++ show l ++ " c: " ++ show c - -printModuleInfo :: ModuleName -> IO () -printModuleInfo (ModuleName mn) = putStrLn mn - -printWarning :: Maybe WarningText -> IO () -printWarning Nothing = putStrLn "(No warnings)" -printWarning (Just (DeprText dt)) = putStrLn $ "Depr: " ++ dt -printWarning (Just (WarnText wt)) = putStrLn $ "Warn: " ++ wt - -printPragmas mps = putStrLn "(Pragmas aren't that interesting for me)" -printExports mess = putStrLn "(A module's exports are not that interesting for me either)" -printImports ids = putStrLn "(A module's imports are not that interesting for me either)" -printDecls ds = sequence_ $ map (\x -> putStrLn (show x ++ "\n")) ds --putStrLn "The Decls is what it's all about!" - --- Looking at data Decl in Language.Haskell.Exts.Syntax: --- We're probably interested in the following information, of which a couple of --- are probably not that interesting after all: -{- --- A type declaration -TypeDecl SrcLoc Name [TyVarBind] Type - --- A type family declaration -TypeFamDecl SrcLoc Name [TyVarBind] (Maybe Kind) - --- A data OR newtype declaration -DataDecl SrcLoc DataOrNew Context Name [TyVarBind] [QualConDecl] [Deriving] - ---A data OR newtype declaration, GADT style -GDataDecl SrcLoc DataOrNew Context Name [TyVarBind] (Maybe Kind) [GadtDecl] [Deriving] - --- A data family declaration -DataFamDecl SrcLoc Context Name [TyVarBind] (Maybe Kind) - --- A type family instance declaration -TypeInsDecl SrcLoc Type Type - --- A data family instance declaration -DataInsDecl SrcLoc DataOrNew Type [QualConDecl] [Deriving] - --- A data family instance declaration, GADT style -GDataInsDecl SrcLoc DataOrNew Type (Maybe Kind) [GadtDecl] [Deriving] - --- A declaration of a type class -ClassDecl SrcLoc Context Name [TyVarBind] [FunDep] [ClassDecl] - --- An declaration of a type class instance -InstDecl SrcLoc Context QName [Type] [InstDecl] - --- A standalone deriving declaration -DerivDecl SrcLoc Context QName [Type] - --- A declaration of operator fixity -InfixDecl SrcLoc Assoc Int [Op] - --- A declaration of default types -DefaultDecl SrcLoc [Type] - --- A Template Haskell splicing declaration -SpliceDecl SrcLoc Exp - --- A type signature declaration -TypeSig SrcLoc [Name] Type - --- A set of function binding clauses -FunBind [Match] - --- A pattern binding -PatBind SrcLoc Pat (Maybe Type) Rhs Binds --} - --- Where to go from here? --- Two things are required by this library: --- 1. It needs to be able to parse datatypes and convert them into a simpler --- format so the second point can be achieved. --- 2. It needs to be able to generate representations for various generic views --- and libraries. --- 3. Think of a cool name for this library --- --- In order to achieve 1: --- - Determine what information is required from the datatypes. --- - Define a simpler format to contain this information --- - Write conversion functions from haskell-src-exts to the library representation --- --- In order to achieve 2: --- - Map the library representation back to haskell-src-exts --- - Hook it up to mechanisms as found in Derive, making sure there is an option --- for both outputting to file (compiler independent) and using TH (GHC only) --- --- In order to achieve 3: --- - Be creative - --- Required data (TODO: Make a separate document for this): --- --- - Constructor: at the very least its name, arity, labels (for record syntax) --- and its fixity. These are required by EMGM, which is probably the most --- demanding for constructor data. Also observe the type of constructor: --- normal prefix, record style (prefix or infix) and infix without records. diff --git a/src/TestTH.hs b/src/TestTH.hs deleted file mode 100644 index 42e617a..0000000 --- a/src/TestTH.hs +++ /dev/null @@ -1,43 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE ExistentialQuantification #-} -{-# LANGUAGE GADTs #-} -module TestTH where - -import Generics.EMGM -import Data.DeriveTH -import DGG.Adapter.EMGM -import DGG.Adapter.SYB ---import Data.Data ---import Data.Typeable - -data Foo = Bar -data List a = Nil | Cons a (List a) -data MyTree a = MyLeaf - | MyBinNode { lTree :: (MyTree a) - , bVal :: a - , rTree :: (MyTree a) } - | MyRTree a [MyTree a] - ---data Dynamic = forall s. (Data s) => Dyn s TypeRep - -data Perfect a = Leaf { unLeaf :: a } - | Node (Perfect (a, a)) - --- $(derive deriveSYB ''Dynamic) --- $(derive deriveSYB ''Perfect) - -$(derive deriveEMGM ''Foo) - -$(derive deriveEMGM ''List) - -$(derive deriveEMGM ''MyTree) - - --- $(derive deriveSYB ''Foo) - --- $(derive deriveSYB ''List) - --- $(derive deriveSYB ''MyTree) - diff --git a/src/testmodule.hs b/src/testmodule.hs deleted file mode 100644 index 7dbb73e..0000000 --- a/src/testmodule.hs +++ /dev/null @@ -1,50 +0,0 @@ -{-# LANGUAGE GADTs #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE ExistentialQuantification #-} - -module TestModule where - --- Product -data MyProd = MyProd Bool Int - -type MyProdAlias = MyProd - --- Strict product -data MyStrict = MyStrict !Bool !Int - --- Polymorphic -data MyPoly a = MyPoly a - -type MyPolyAlias = MyPoly Int - --- Regular datatype -data List a = Nil | Cons a (List a) - --- Mutual recursive datatypes -data MutRecA a = MRANill a | MutRecA (MutRecB a) -data MutRecB b = MRBNill b | MutRecB (MutRecA b) - --- Nested datatype -data Perfect a = Perfect (Perfect (a,a)) - --- Existential -data Exist = forall a. Exist a - --- GADTs -data Expr a where - I :: Int -> Expr Int - B :: Bool -> Expr Bool - Add :: Expr Int -> Expr Int -> Expr Int - Mul :: Expr Int -> Expr Int -> Expr Int - Eq :: Expr Int -> Expr Int -> Expr Bool - --- Newtype -newtype Foo = Foo Int - - -data Tree = Empty | Leaf Int | Node Tree Tree Tree -data TTree a = Tip Int | Branch (TTree a) a (TTree a) -data Toeplitz a = Toeplitz a [(a,a)] -data Comp f g a = C (f (g a)) -data HFix f a = Hln (f (HFix f) a) -