syntactic 3.4 → 3.5
raw patch · 8 files changed
+449/−35 lines, 8 files
Files
- examples/NanoFeldspar.hs +1/−1
- examples/NanoFeldsparComp.hs +1/−1
- examples/WellScoped.hs +1/−1
- src/Language/Syntactic/Functional.hs +173/−14
- src/Language/Syntactic/Functional/Sharing.hs +30/−14
- syntactic.cabal +3/−3
- tests/AlgorithmTests.hs +237/−0
- tests/Tests.hs +3/−1
examples/NanoFeldspar.hs view
@@ -227,7 +227,7 @@ -- | Explicit sharing share :: (Syntax a, Syntax b) => a -> (a -> b) -> b-share = sugarSymTyped Let+share = sugarSymTyped (Let "") -- | Parallel array parallel :: Type a => Data Length -> (Data Index -> Data a) -> Data [a]
examples/NanoFeldsparComp.hs view
@@ -101,7 +101,7 @@ compileExp var | Just (Var v) <- prj var = return (varNameE v) compileExp (lett :$ a :$ (lam :$ body))- | Just Let <- prj lett+ | Just (Let _) <- prj lett , Just (LamT v) <- prj lam = do a' <- compileExp a
examples/WellScoped.hs view
@@ -32,7 +32,7 @@ share :: forall e a b . Exp e a -> ((forall e' . Ext e' (a,e) => Exp e' a) -> Exp (a,e) b) -> Exp e b-share a f = smartWS Let a $ lamWS f+share a f = smartWS (Let "") a $ lamWS f ex1 :: Exp e (Int -> Int) ex1 = lamWS $ \a -> share (a + 4) $ \b -> share (a+b) $ \c -> a+b+c
src/Language/Syntactic/Functional.hs view
@@ -43,6 +43,10 @@ -- * Free and bound variables , freeVars , allVars+ , renameUnique'+ , renameUnique+ -- * Substitution+ , parSubst -- * Alpha-equivalence , AlphaEnv , alphaEq'@@ -69,16 +73,21 @@ import Control.DeepSeq import Control.Monad.Cont import Control.Monad.Reader+import Control.Monad.State import Data.Dynamic+import qualified Data.Foldable as Foldable import Data.List (genericIndex) #if MIN_VERSION_GLASGOW_HASKELL(7,10,0,0) #else import Data.Proxy -- Needed by GHC < 7.8 #endif+import Data.Map (Map)+import qualified Data.Map as Map import Data.Set (Set) import qualified Data.Set as Set import Data.Tree +import Data.Constraint import Data.Hash (hashInt) import Language.Syntactic@@ -338,9 +347,10 @@ where prVar :: sym sig -> Maybe Name prLam :: sym sig -> Maybe Name- -- It is in principle possible to replace a constraint `BindingDomain s` by- -- `(Project Binding s, Project BindingT s)` + -- | Rename a variable or a lambda (no effect for other symbols)+ renameBind :: (Name -> Name) -> sym sig -> sym sig+ instance {-# OVERLAPPING #-} (BindingDomain sym1, BindingDomain sym2) => BindingDomain (sym1 :+: sym2) where@@ -348,16 +358,20 @@ prVar (InjR s) = prVar s prLam (InjL s) = prLam s prLam (InjR s) = prLam s+ renameBind re (InjL s) = InjL $ renameBind re s+ renameBind re (InjR s) = InjR $ renameBind re s instance {-# OVERLAPPING #-} BindingDomain sym => BindingDomain (Typed sym) where prVar (Typed s) = prVar s prLam (Typed s) = prLam s+ renameBind re (Typed s) = Typed $ renameBind re s instance {-# OVERLAPPING #-} BindingDomain sym => BindingDomain (sym :&: i) where prVar = prVar . decorExpr prLam = prLam . decorExpr+ renameBind re (s :&: d) = renameBind re s :&: d instance {-# OVERLAPPING #-} BindingDomain sym => BindingDomain (AST sym) where@@ -365,37 +379,50 @@ prVar _ = Nothing prLam (Sym s) = prLam s prLam _ = Nothing+ renameBind re (Sym s) = Sym $ renameBind re s instance {-# OVERLAPPING #-} BindingDomain Binding where prVar (Var v) = Just v- prVar _ = Nothing prLam (Lam v) = Just v- prLam _ = Nothing+ renameBind re (Var v) = Var $ re v+ renameBind re (Lam v) = Lam $ re v instance {-# OVERLAPPING #-} BindingDomain BindingT where prVar (VarT v) = Just v- prVar _ = Nothing prLam (LamT v) = Just v- prLam _ = Nothing+ renameBind re (VarT v) = VarT $ re v+ renameBind re (LamT v) = LamT $ re v instance {-# OVERLAPPING #-} BindingDomain sym where prVar _ = Nothing prLam _ = Nothing+ renameBind _ a = a -- | A symbol for let bindings -- -- This symbol is just an application operator. The actual binding has to be -- done by a lambda that constructs the second argument.+--+-- The provided string is just a tag and has nothing to do with the name of the+-- variable of the second argument (if that argument happens to be a lambda).+-- However, a back end may use the tag to give a sensible name to the generated+-- variable.+--+-- The string tag may be empty. data Let sig where- Let :: Let (a :-> (a -> b) :-> Full b)+ Let :: String -> Let (a :-> (a -> b) :-> Full b) -instance Symbol Let where symSig Let = signature-instance Render Let where renderSym Let = "letBind"+instance Symbol Let where symSig (Let _) = signature +instance Render Let+ where+ renderSym (Let "") = "Let"+ renderSym (Let nm) = "Let " ++ nm+ instance Equality Let where equal = equalDefault@@ -403,9 +430,9 @@ instance StringTree Let where- stringTreeSym [a, Node lam [body]] Let- | ("Lam",v) <- splitAt 3 lam = Node ("Let" ++ v) [a,body]- stringTreeSym [a,f] Let = Node "Let" [a,f]+ stringTreeSym [a, Node lam [body]] letSym+ | ("Lam",v) <- splitAt 3 lam = Node (renderSym letSym ++ v) [a,body]+ stringTreeSym [a,f] letSym = Node (renderSym letSym) [a,f] -- | Monadic constructs --@@ -485,7 +512,7 @@ ------------------------------------------------------------------------------------------------------- * Free variables+-- * Free and bound variables ---------------------------------------------------------------------------------------------------- -- | Get the set of free variables in an expression@@ -507,9 +534,141 @@ allVars (s :$ a) = Set.union (allVars s) (allVars a) allVars _ = Set.empty +-- | Generate an infinite list of fresh names given a list of allocated names+--+-- The argument is assumed to be sorted and not contain an infinite number of adjacent names.+freshVars :: [Name] -> [Name]+freshVars as = go 0 as+ where+ go c [] = [c..]+ go c (v:as)+ | c < v = c : go (c+1) (v:as)+ | c == v = go (c+1) as+ | otherwise = go c as +freshVar :: MonadState [Name] m => m Name+freshVar = do+ v:vs <- get+ put vs+ return v +-- | Rename the bound variables in a term+--+-- The free variables are left untouched. The bound variables are given unique+-- names using as small names as possible. The first argument is a list of+-- reserved names. Reserved names and names of free variables are not used when+-- renaming bound variables.+renameUnique' :: forall sym a . BindingDomain sym =>+ [Name] -> ASTF sym a -> ASTF sym a+renameUnique' vs a = flip evalState fs $ go Map.empty a+ where+ fs = freshVars $ Set.toAscList (freeVars a `Set.union` Set.fromList vs)++ go :: Map Name Name -> AST sym sig -> State [Name] (AST sym sig)+ go env var+ | Just v <- prVar var = case Map.lookup v env of+ Just w -> return $ renameBind (\_ -> w) var+ _ -> return var -- Free variable+ go env (lam :$ body)+ | Just v <- prLam lam = do+ w <- freshVar+ body' <- go (Map.insert v w env) body+ return $ renameBind (\_ -> w) lam :$ body'+ go env (s :$ a) = liftM2 (:$) (go env s) (go env a)+ go env s = return s++-- | Rename the bound variables in a term+--+-- The free variables are left untouched. The bound variables are given unique+-- names using as small names as possible. Names of free variables are not used+-- when renaming bound variables.+renameUnique :: BindingDomain sym => ASTF sym a -> ASTF sym a+renameUnique = renameUnique' []+++ ----------------------------------------------------------------------------------------------------+-- * Substitution+----------------------------------------------------------------------------------------------------++-- | Name environment+type Aliases =+ ( Set Name -- Reserved names+ , Map Name Name -- Aliases; co-domain must not contain reserved names+ , Name -- Fresh name; must be greater than all reserved names and all names+ -- in the co-domain of the alias map+ )+ -- Invariant: The second component of the pair is a name that is greater than+ -- all names in the co-domain of the map.++-- | Set up an initial alias environment from a set of reserved names+initAliases :: Set Name -> Aliases+initAliases res = (res, Map.empty, next)+ where+ next = Set.findMax (Set.insert (-1) res) + 1++-- | Locally rename a binding+rename :: Name -> Aliases -> (Name,Aliases)+rename n al@(res,mp,next)+ | Just n' <- Map.lookup n mp = (n',al)+ -- This is a shadowing binding, so it's safe to reuse the name of the+ -- shadowed binding (i.e. it will shadow the same binding after renaming+ -- as before). This case is not strictly needed, but it allows more name+ -- reuse.+ | not (Set.member n res) =+ (n, (Set.insert n res, Map.insert n n mp, max next (n+1)))+ -- Here we reuse the name because it's not reserved. It may seem+ -- pointless to map the name to itself, but this allows `parSubst` to+ -- use the map to see whether a name is in scope.+ | otherwise = (next, (Set.insert next res, Map.insert n next mp, next + 1))+ -- Here we need a fresh name. By reserving the name we ensure that no+ -- binding will be renamed to shadow the new name (unless it was already+ -- a shadowing binding; see above).++-- | Lookup a name in an alias environment+lookAlias :: Name -> Aliases -> Maybe Name+lookAlias n (_,mp,_) = Map.lookup n mp++-- | Capture-avoiding parallel substitution+--+-- Uses the "rapier" method described in "Secrets of the Glasgow Haskell+-- Compiler inliner" (Peyton Jones and Marlow, JFP 2006) to rename variables+-- where there's risk for capturing.+parSubst :: forall sym a . BindingDomain sym+ => (forall a b . ASTF sym a -> ASTF sym b -> Maybe (Dict (a ~ b)))+ -- ^ Type equality+ -> [(Name, EF (AST sym))] -- ^ Substitution+ -> ASTF sym a+ -> ASTF sym a+parSubst teq subst a = go (initAliases reserved) a+ where+ reserved = Set.union+ (freeVars a) -- TODO Not needed?+ (Foldable.fold [freeVars b | (_, EF b) <- subst])++ go :: Aliases -> ASTF sym b -> ASTF sym b+ go aliases var+ | Just v <- prVar var+ = case lookAlias v aliases of+ Just v' -> renameBind (\_ -> v') var+ _ -> case lookup v subst of+ Just (EF b) | Just Dict <- teq var b -> b+ _ -> var -- Free variable without a substitution+ go aliases (lam :$ body)+ | Just v <- prLam lam+ , let (v',aliases') = rename v aliases+ = renameBind (\_ -> v') lam :$ go aliases' body+ go aliases a =+ simpleMatch (\s as -> appArgs (Sym s) $ mapArgs (go aliases) as) a++ -- It is safe to use the same `subst` throughout the traversal in `go`. This+ -- is because `lookup v subst` is only done when `v` is known not to be in+ -- scope (variables in scope must be in the alias map). So there's no risk of+ -- replacing a bound variable.++++---------------------------------------------------------------------------------------------------- -- * Alpha-equivalence ---------------------------------------------------------------------------------------------------- @@ -592,7 +751,7 @@ instance Eval Let where- evalSym Let = flip ($)+ evalSym (Let _) = flip ($) instance Monad m => Eval (MONAD m) where
src/Language/Syntactic/Functional/Sharing.hs view
@@ -1,5 +1,3 @@-{-# LANGUAGE RecordWildCards #-}- -- | Simple code motion transformation performing common sub-expression -- elimination and variable hoisting. Note that the implementation is very -- inefficient.@@ -89,7 +87,7 @@ (\(Typed _) _ -> let injVariable = Typed . inj . var injLambda = Typed . inj . lam- injLet = Typed $ inj Let+ injLet = Typed $ inj (Let "") in Just InjDict {..} ) b ) a@@ -118,7 +116,7 @@ -> (forall a . ASTF symI a -> Bool) -- ^ Can we hoist over this expression? -> CodeMotionInterface symI-defaultInterfaceDecor kaka mkFunInfo var lam sharable hoistOver = Interface {..}+defaultInterfaceDecor teq mkFunInfo var lam sharable hoistOver = Interface {..} where mkInjDict :: ASTF symI a -> ASTF symI b -> Maybe (InjDict symI a b) mkInjDict a b | not (sharable a b) = Nothing@@ -128,7 +126,7 @@ (\(_ :&: bInfo) _ -> let injVariable v = inj (var aInfo v) :&: aInfo injLambda v = inj (lam aInfo bInfo v) :&: mkFunInfo aInfo bInfo- injLet = inj Let :&: bInfo+ injLet = inj (Let "") :&: bInfo in Just InjDict {..} ) b ) a@@ -137,7 +135,7 @@ castExprCM a b = simpleMatch (\(_ :&: aInfo) _ -> simpleMatch- (\(_ :&: bInfo) _ -> case kaka aInfo bInfo of+ (\(_ :&: bInfo) _ -> case teq aInfo bInfo of Just Dict -> Just a _ -> Nothing ) b@@ -163,7 +161,7 @@ | otherwise = subst a where subst :: AST sym c -> AST sym c- subst (f :$ a) = subst f :$ substitute iface x y a+ subst (s :$ a) = subst s :$ substitute iface x y a subst a = a -- Note: Since `codeMotion` only uses `substitute` to replace sub-expressions -- with fresh variables, there's no risk of capturing.@@ -174,14 +172,32 @@ => ASTF sym a -- ^ Expression to count -> ASTF sym b -- ^ Expression to count in -> Int-count a b- | alphaEq a b = 1- | otherwise = cnt b+count a b = cnt b where- cnt :: AST sym c -> Int- cnt (f :$ b) = cnt f + count a b- cnt _ = 0+ fv = freeVars a + cnt :: ASTF sym c -> Int+ cnt c+ | alphaEq a c = 1+ | otherwise = cnt' c++ cnt' :: AST sym sig -> Int+ cnt' (lam :$ body)+ | Just v <- prLam lam+ , Set.member v fv = 0+ -- There can be no match under a lambda that binds a variable that is+ -- free in `a`. This case needs to be handled in order to avoid false+ -- matches.+ --+ -- Consider the following expression:+ --+ -- (\x -> f x) 0 + f x+ --+ -- The sub-expression `f x` appear twice, but `x` means different+ -- things in the two cases.+ cnt' (s :$ c) = cnt' s + cnt c+ cnt' _ = 0+ -- | Environment for the expression in the 'choose' function data Env sym = Env { inLambda :: Bool -- ^ Whether the current expression is inside a lambda@@ -268,7 +284,7 @@ :$ (Sym (injLambda id v) :$ body) descend :: AST sym b -> m (AST sym b)- descend (f :$ a) = liftM2 (:$) (descend f) (codeMotionM iface a)+ descend (s :$ a) = liftM2 (:$) (descend s) (codeMotionM iface a) descend a = return a -- | Perform common sub-expression elimination and variable hoisting
syntactic.cabal view
@@ -1,5 +1,5 @@ Name: syntactic-Version: 3.4+Version: 3.5 Synopsis: Generic representation and manipulation of abstract syntax Description: The library provides a generic representation of type-indexed abstract syntax trees (or indexed data types in general). It also permits the definition of open syntax@@ -111,6 +111,7 @@ GADTs GeneralizedNewtypeDeriving RankNTypes+ RecordWildCards ScopedTypeVariables TypeFamilies TypeOperators@@ -128,8 +129,6 @@ default-language: Haskell2010 - default-extensions:- build-depends: syntactic, base,@@ -166,3 +165,4 @@ other-extensions: TemplateHaskell+
+ tests/AlgorithmTests.hs view
@@ -0,0 +1,237 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeOperators #-}++module AlgorithmTests where++++import Data.List+import qualified Data.Set as Set+import Data.Dynamic++import Language.Syntactic+import Language.Syntactic.TH+import Language.Syntactic.Functional+import Language.Syntactic.Functional.Sharing++import Test.QuickCheck++import Test.Tasty.QuickCheck+import Test.Tasty.TH++++data Sym sig+ where+ Int :: Int -> Sym (Full Int)+ Neg :: Sym (Full (Int -> Int))+ Add :: Sym (Full (Int -> Int -> Int))+ App1 :: Sym ((Int -> Int) :-> Int :-> Full Int)+ App2 :: Sym ((Int -> Int -> Int) :-> Int :-> Int :-> Full Int)+ App3 :: Sym ((Int -> Int -> Int -> Int) :-> Int :-> Int :-> Int :-> Full Int)++deriveSymbol ''Sym+deriveRender id ''Sym+deriveEquality ''Sym++instance StringTree Sym+instance EvalEnv Sym env++instance Eval Sym+ where+ evalSym (Int i) = i+ evalSym Neg = negate+ evalSym Add = (+)+ evalSym App1 = ($)+ evalSym App2 = \f a b -> f a b+ evalSym App3 = \f a b c -> f a b c++type Dom = Typed (BindingT :+: Let :+: Sym)++type Exp a = ASTF Dom a++int :: Int -> Exp Int+int = sugarSymTyped . Int++neg :: Exp Int -> Exp Int+neg = app1 (sugarSymTyped Neg)++add :: Exp Int -> Exp Int -> Exp Int+add = app2 (sugarSymTyped Add)++app1 :: Exp (Int -> Int) -> Exp Int -> Exp Int+app1 = sugarSymTyped App1++app2 :: Exp (Int -> Int -> Int) -> Exp Int -> Exp Int -> Exp Int+app2 = sugarSymTyped App2++app3 :: Exp (Int -> Int -> Int -> Int) -> Exp Int -> Exp Int -> Exp Int -> Exp Int+app3 = sugarSymTyped App3++varr :: Name -> Exp Int+varr = sugarSymTyped . VarT++lamm :: Typeable a => Name -> Exp a -> Exp (Int -> a)+lamm v = sugarSymTyped (LamT v)++++-- | Return a 'Name' not in the given list+notIn :: [Name] -> Name+notIn = go 0 . sort+ where+ go prev [] = prev+1+ go prev (n:ns)+ | n > prev+1 = prev+1+ | otherwise = go n ns++-- | Generate a variable name+genVar+ :: Int -- ^ Frequency for bound+ -> Int -- ^ Frequency for free+ -> [Name] -- ^ Names in scope+ -> Gen Name+genVar fb ff inScope = fmap fromIntegral $ frequency+ [ (fb, elements (0:inScope))+ , (ff, return $ notIn inScope)+ ]++genExp :: Int -> [Name] -> Gen (ASTF Dom Int)+genExp s inScope = frequency+ [ (1, fmap int arbitrary)+ , (1, fmap varr $ genVar 1 1 inScope)+ , (s, do a <- genExp (s-1) inScope+ return $ neg a+ )+ , (s, do a <- genExp (s `div` 2) inScope+ b <- genExp (s `div` 2) inScope+ return $ add a b+ )+ , (s, do f <- genExp1 (s `div` 2) inScope+ a <- genExp (s `div` 2) inScope+ return $ app1 f a+ )+ , (s, do f <- genExp2 (s `div` 3) inScope+ a <- genExp (s `div` 3) inScope+ b <- genExp (s `div` 3) inScope+ return $ app2 f a b+ )+ , (s, do f <- genExp3 (s `div` 4) inScope+ a <- genExp (s `div` 4) inScope+ b <- genExp (s `div` 4) inScope+ c <- genExp (s `div` 4) inScope+ return $ app3 f a b c+ )+ ]++genExp1 :: Int -> [Name] -> Gen (ASTF Dom (Int -> Int))+genExp1 s inScope = do+ v <- genVar 1 2 inScope+ body <- genExp (s-1) (v:inScope)+ return $ lamm v body++genExp2 :: Int -> [Name] -> Gen (ASTF Dom (Int -> Int -> Int))+genExp2 s inScope = do+ v1 <- genVar 1 2 inScope+ v2 <- genVar 1 2 (v1:inScope)+ body <- genExp (s-2) (v2:v1:inScope)+ return $ lamm v1 $ lamm v2 body++genExp3 :: Int -> [Name] -> Gen (ASTF Dom (Int -> Int -> Int -> Int))+genExp3 s inScope = do+ v1 <- genVar 1 2 inScope+ v2 <- genVar 1 2 (v1:inScope)+ v3 <- genVar 1 2 (v2:v1:inScope)+ body <- genExp (s-3) (v3:v2:v1:inScope)+ return $ lamm v1 $ lamm v2 $ lamm v3 body++shrinkExp :: AST Dom sig -> [AST Dom sig]+shrinkExp s+ | Just (Int i) <- prj s = map int $ shrink i+shrinkExp (Sym (Typed lam) :$ body)+ | Just (LamT v) <- prj lam = [sugarSymTyped (LamT v) b | b <- shrinkExp body]+shrinkExp (app1 :$ f :$ a)+ | Just App1 <- prj app1 = concat+ [ case f of+ lam :$ body | Just (LamT _) <- prj lam -> [body]+ _ -> []+ , [a]+ , [ sugarSymTyped App1 f' a' | (f',a') <- shrink (f,a) ]+ ]+shrinkExp (app2 :$ f :$ a :$ b)+ | Just App2 <- prj app2 = concat+ [ case f of+ lam1 :$ (lam2 :$ body)+ | Just (LamT _) <- prj lam1+ , Just (LamT _) <- prj lam2+ -> [body]+ _ -> []+ , [a,b]+ , [ sugarSymTyped App2 f' a' b' | (f',a',b') <- shrink (f,a,b) ]+ ]+shrinkExp (app3 :$ f :$ a :$ b :$ c)+ | Just App3 <- prj app3 = concat+ [ case f of+ lam1 :$ (lam2 :$ (lam3 :$ body))+ | Just (LamT _) <- prj lam1+ , Just (LamT _) <- prj lam2+ , Just (LamT _) <- prj lam3+ -> [body]+ _ -> []+ , [a,b,c]+ , [ sugarSymTyped App3 f' a' b' c' | (f',a',b',c') <- shrink (f,a,b,c) ]+ ]+shrinkExp _ = []++instance Arbitrary (Exp Int)+ where+ arbitrary = sized $ \s -> genExp s []+ shrink = shrinkExp++instance Arbitrary (Exp (Int -> Int))+ where+ arbitrary = sized $ \s -> genExp1 s []+ shrink = shrinkExp++instance Arbitrary (Exp (Int -> Int -> Int))+ where+ arbitrary = sized $ \s -> genExp2 s []+ shrink = shrinkExp++instance Arbitrary (Exp (Int -> Int -> Int -> Int))+ where+ arbitrary = sized $ \s -> genExp3 s []+ shrink = shrinkExp++prop_freeVars (a :: Exp Int) = freeVars a `Set.isSubsetOf` allVars a++prop_alphaEq_refl (a :: Exp Int) = alphaEq a a++prop_alphaEq_rename (a :: Exp Int) = alphaEq a (renameUnique a)++evalAny :: Exp Int -> Int+evalAny a = evalOpen env a+ where+ fv = freeVars a+ env = zip (Set.toList fv) (map toDyn [(100 :: Int), 110 ..])++prop_renameUnique_vars (a :: Exp Int) = freeVars a == freeVars (renameUnique a)+prop_renameUnique_eval (a :: Exp Int) = evalAny a == evalAny (renameUnique a)++cm :: Exp a -> Exp a+cm = codeMotion $ defaultInterface VarT LamT (\_ _ -> True) (\_ -> True)++prop_codeMotion_vars (a :: Exp Int) = freeVars a == freeVars (cm a)+prop_codeMotion_eval (a :: Exp Int) = evalAny a == evalAny (cm a)++counter = app2 (lamm 1 (lamm 2 (varr 1))) (app1 (lamm 1 (int 0)) (app2 (lamm 0 (lamm 0 (varr 1))) (int 0) (int 0))) (varr 2)+++tests = $testGroupGenerator++main = $defaultMainGenerator+
tests/Tests.hs view
@@ -1,12 +1,14 @@ import Test.Tasty +import qualified AlgorithmTests import qualified NanoFeldsparTests import qualified WellScopedTests import qualified MonadTests import qualified TH tests = testGroup "AllTests"- [ NanoFeldsparTests.tests+ [ AlgorithmTests.tests+ , NanoFeldsparTests.tests , WellScopedTests.tests , MonadTests.tests ]