Commit e5cda42f authored by Simon Peyton Jones's avatar Simon Peyton Jones

Merge branch 'master' of http://darcs.haskell.org/testsuite

parents 8b9fffbf da1938c1
......@@ -16,29 +16,31 @@ import qualified Language.Haskell.TH as TH
import Data.List
import Data.Function
main :: IO ()
main = defaultErrorHandler defaultLogAction
$ runGhc (Just cTop) $ do
liftIO $ putStrLn "Initializing Package Database"
dflags <- getSessionDynFlags
let dflags' = dflags
setSessionDynFlags dflags'
let mod_nm = mkModuleName "Annrun01_Help"
liftIO $ putStrLn "Setting Target"
setTargets [Target (TargetModule mod_nm) True Nothing]
liftIO $ putStrLn "Loading Targets"
load LoadAllTargets
liftIO $ putStrLn "Finding Module"
mod <- findModule mod_nm Nothing
liftIO $ putStrLn "Getting Module Info"
Just mod_info <- getModuleInfo mod
liftIO $ putStrLn "Showing Details For Module"
showTargetAnns (ModuleTarget mod)
liftIO $ putStrLn "Showing Details For Exports"
mapM (showTargetAnns . NamedTarget) $ sortBy (compare `on` getOccName) $ modInfoExports mod_info
let exports = sortBy (compare `on` getOccName) $ modInfoExports mod_info
mapM_ (showTargetAnns . NamedTarget) exports
showTargetAnns :: CoreAnnTarget -> Ghc ()
showTargetAnns target = do
......
......@@ -4,6 +4,7 @@ test ('dph-diophantine-opt'
, skip_if_fast
, reqlib('dph-par')
, reqlib('dph-prim-par')
, expect_broken(5065)
, only_ways(['normal', 'threaded1', 'threaded2']) ]
, multimod_compile_and_run
, [ 'Main'
......
{-# LANGUAGE KindSignatures, GADTs, TypeFamilies, MultiParamTypeClasses, FlexibleContexts, ScopedTypeVariables, TypeSynonymInstances, FlexibleInstances #-}
module T5303( showContextSeries ) where
import Control.Monad.State.Strict( StateT )
import Control.Monad.Trans ( lift )
data Tree m = Tree {}
data FL (a :: * -> * -> *) x z where
(:>:) :: a x y -> FL a y z -> FL a x z
NilFL :: FL a x x
class (Functor m, Monad m) => ApplyMonad m (state :: (* -> *) -> *)
class Apply (p :: * -> * -> *) where
type ApplyState p :: (* -> *) -> *
apply :: ApplyMonad m (ApplyState p) => p x y -> m ()
class (Functor m, Monad m, ApplyMonad (ApplyMonadOver m state) state)
=> ApplyMonadTrans m (state :: (* -> *) -> *) where
type ApplyMonadOver m state :: * -> *
runApplyMonad :: (ApplyMonadOver m state) x -> state m -> m (x, state m)
instance (Functor m, Monad m) => ApplyMonadTrans m Tree where
type ApplyMonadOver m Tree = TreeMonad m
runApplyMonad = virtualTreeMonad
instance (Functor m, Monad m) => ApplyMonad (TreeMonad m) Tree
-- | Internal state of the 'TreeIO' monad. Keeps track of the current Tree
-- content, unsync'd changes and a current working directory (of the monad).
data TreeState m = TreeState { tree :: !(Tree m) }
type TreeMonad m = StateT (TreeState m) m
type TreeIO = TreeMonad IO
virtualTreeMonad :: (Functor m, Monad m) => TreeMonad m a -> Tree m -> m (a, Tree m)
virtualTreeMonad action t = undefined
applyToState :: forall p m x y. (Apply p, ApplyMonadTrans m (ApplyState p))
=> p x y -> (ApplyState p) m -> m ((ApplyState p) m)
applyToState _ _ = snd `fmap` runApplyMonad undefined undefined
showContextSeries :: (Apply p, ApplyState p ~ Tree) => FL p x y -> TreeIO ()
showContextSeries (p:>:_) = (undefined >>= lift . applyToState p) >> return ()
......@@ -123,3 +123,4 @@ test('T5168',
['$MAKE -s --no-print-directory T5168'])
test('T5329', normal, compile, [''])
test('T5303', reqlib('mtl'), compile, ['']) # Coercion-optimiation test
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment