diff --git a/examples/NanoFeldspar.hs b/examples/NanoFeldspar.hs --- a/examples/NanoFeldspar.hs +++ b/examples/NanoFeldspar.hs @@ -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] diff --git a/examples/NanoFeldsparComp.hs b/examples/NanoFeldsparComp.hs --- a/examples/NanoFeldsparComp.hs +++ b/examples/NanoFeldsparComp.hs @@ -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 diff --git a/examples/WellScoped.hs b/examples/WellScoped.hs --- a/examples/WellScoped.hs +++ b/examples/WellScoped.hs @@ -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 diff --git a/src/Language/Syntactic/Functional.hs b/src/Language/Syntactic/Functional.hs --- a/src/Language/Syntactic/Functional.hs +++ b/src/Language/Syntactic/Functional.hs @@ -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 diff --git a/src/Language/Syntactic/Functional/Sharing.hs b/src/Language/Syntactic/Functional/Sharing.hs --- a/src/Language/Syntactic/Functional/Sharing.hs +++ b/src/Language/Syntactic/Functional/Sharing.hs @@ -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 diff --git a/syntactic.cabal b/syntactic.cabal --- a/syntactic.cabal +++ b/syntactic.cabal @@ -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 + diff --git a/tests/AlgorithmTests.hs b/tests/AlgorithmTests.hs new file mode 100644 --- /dev/null +++ b/tests/AlgorithmTests.hs @@ -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 + diff --git a/tests/Tests.hs b/tests/Tests.hs --- a/tests/Tests.hs +++ b/tests/Tests.hs @@ -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 ]