Skip to content

M
mu-client-ghc
Commit 70a4766e authored by nathyong's avatar nathyong
Browse files
Options

Add GHC wired-in libraries

parent e2561239
Hide whitespace changes
Inline Side-by-side
Showing with 50210 additions and 12 deletions

Too many changes to show.
Plain diff Email patch

To preserve performance only 208 of 208+ files are displayed.

app/Main.hs
View file @ 70a4766e
......@@ -22,7 +22,6 @@ import System.Environment (getArgs)
import System.Exit (exitFailure)
import qualified Data.Sequence as Seq
import qualified Data.Map.Strict as M
import System.Directory (listDirectory)
import qualified Language.Haskell.GHC.Simple as GHC.Simple
import Language.Haskell.GHC.Simple.Extra ()
......@@ -35,6 +34,8 @@ import Mu.AST
import Mu.Impl.RefImpl2
import Mu.Interface
import Debug.Trace
compilerConfig :: CompConfig
compilerConfig =
GHC.Simple.disableCodeGen $
......@@ -49,26 +50,27 @@ main :: IO ()
main = do
inputFiles <- getArgs
b <- GHC.Simple.compileWith compilerConfig compileMu inputFiles
libresults <- compileLibraryFiles
libresults <- mapM compileLibraryFiles libraryFiles
case b of
Success results _ _ -> do
doResults lives $ mergeResults $ (loadPrim : libresults ++ results')
doResults lives $ mergeResults $ (loadPrim : concat libresults ++ results')
where
results' = fmap modCompiledModule (results)
lives = toList $ foldMap getDefns results'
getDefns (defns, _, _) = fmap toName defns
Failure _ _ -> exitFailure
compileLibraryFiles :: IO [MuResult]
compileLibraryFiles = do
b <- getLibraryFiles >>= GHC.Simple.compileWith libconfig compileMu
compileLibraryFiles :: (String, [FilePath]) -> IO [MuResult]
compileLibraryFiles (packageKey, files) = do
traceM ("Compiling the library file " ++ packageKey)
b <- GHC.Simple.compileWith libconfig compileMu files
case b of
Success results _ _ -> return $ fmap modCompiledModule results
Failure _ _ -> error "Could not compile internal bundle"
where
libconfig = compilerConfig
{ cfgGhcFlags =
["-this-unit-id", "ghc-prim", "-ddump-stg", "-ddump-to-file"]
["-this-unit-id", packageKey, "-ddump-stg", "-ddump-to-file"]
}
doResults :: [Name] -> MuMergedResult -> IO ()
......@@ -93,12 +95,222 @@ doResults liveObjectNames (defns, topClosures, mainFunction) = do
where
defns' = M.elems defns
getLibraryFiles :: IO [FilePath]
getLibraryFiles = process =<< mapM listDirectory'
["/Users/nathan/projects/microvm/anuhc/anuhc-prim/GHC/"]
-- | A list of all library files, indexed by their package-key.
-- TODO: fix this.
libraryFiles :: [(String, [FilePath])]
libraryFiles = [ ("ghc-prim", prefix ghcPrimFiles)
, ("base", prefix baseFiles)
]
where
process = return . (filter (".hs" `isSuffixOf`) . concat)
listDirectory' dir = listDirectory dir >>= return . (fmap (dir ++))
prefix = fmap ("/Users/nathan/projects/microvm/anuhc/libraries/" ++)
ghcPrimFiles =
[ "ghc-prim/GHC/CString.hs"
, "ghc-prim/GHC/Classes.hs"
, "ghc-prim/GHC/Debug.hs"
, "ghc-prim/GHC/IntWord64.hs"
, "ghc-prim/GHC/Magic.hs"
-- , "ghc-prim/GHC/PrimopWrappers.hs"
, "ghc-prim/GHC/Tuple.hs"
, "ghc-prim/GHC/Types.hs"
]
baseFiles =
[ "base/Control/Applicative.hs"
, "base/Control/Arrow.hs"
, "base/Control/Category.hs"
, "base/Control/Concurrent.hs"
, "base/Control/Concurrent/Chan.hs"
, "base/Control/Concurrent/MVar.hs"
, "base/Control/Concurrent/QSem.hs"
, "base/Control/Concurrent/QSemN.hs"
, "base/Control/Exception.hs"
, "base/Control/Exception/Base.hs"
, "base/Control/Monad.hs"
, "base/Control/Monad/Fail.hs"
, "base/Control/Monad/Fix.hs"
, "base/Control/Monad/Instances.hs"
, "base/Control/Monad/IO/Class.hs"
, "base/Control/Monad/ST.hs"
, "base/Control/Monad/ST/Lazy.hs"
, "base/Control/Monad/ST/Lazy/Safe.hs"
, "base/Control/Monad/ST/Lazy/Unsafe.hs"
, "base/Control/Monad/ST/Safe.hs"
, "base/Control/Monad/ST/Strict.hs"
, "base/Control/Monad/ST/Unsafe.hs"
, "base/Control/Monad/Zip.hs"
, "base/Data/Bifunctor.hs"
, "base/Data/Bits.hs"
, "base/Data/Bool.hs"
, "base/Data/Char.hs"
, "base/Data/Coerce.hs"
, "base/Data/Complex.hs"
, "base/Data/Data.hs"
, "base/Data/Dynamic.hs"
, "base/Data/Either.hs"
, "base/Data/Eq.hs"
, "base/Data/Fixed.hs"
, "base/Data/Foldable.hs"
, "base/Data/Function.hs"
, "base/Data/Functor.hs"
, "base/Data/Functor/Classes.hs"
, "base/Data/Functor/Compose.hs"
, "base/Data/Functor/Const.hs"
, "base/Data/Functor/Identity.hs"
, "base/Data/Functor/Product.hs"
, "base/Data/Functor/Sum.hs"
, "base/Data/IORef.hs"
, "base/Data/Int.hs"
, "base/Data/Ix.hs"
, "base/Data/Kind.hs"
, "base/Data/List.hs"
, "base/Data/List/NonEmpty.hs"
, "base/Data/Maybe.hs"
, "base/Data/Monoid.hs"
, "base/Data/Ord.hs"
, "base/Data/Proxy.hs"
, "base/Data/Ratio.hs"
, "base/Data/Semigroup.hs"
, "base/Data/STRef.hs"
, "base/Data/STRef/Lazy.hs"
, "base/Data/STRef/Strict.hs"
, "base/Data/String.hs"
, "base/Data/Traversable.hs"
, "base/Data/Tuple.hs"
, "base/Data/Type/Bool.hs"
, "base/Data/Type/Coercion.hs"
, "base/Data/Type/Equality.hs"
, "base/Data/Typeable.hs"
, "base/Data/Typeable/Internal.hs"
, "base/Data/Unique.hs"
, "base/Data/Version.hs"
, "base/Data/Void.hs"
, "base/Data/Word.hs"
, "base/Debug/Trace.hs"
, "base/Foreign.hs"
, "base/Foreign/C.hs"
, "base/Foreign/C/Error.hs"
, "base/Foreign/C/String.hs"
, "base/Foreign/C/Types.hs"
, "base/Foreign/Concurrent.hs"
, "base/Foreign/ForeignPtr.hs"
, "base/Foreign/ForeignPtr/Safe.hs"
, "base/Foreign/ForeignPtr/Unsafe.hs"
, "base/Foreign/Marshal.hs"
, "base/Foreign/Marshal/Alloc.hs"
, "base/Foreign/Marshal/Array.hs"
, "base/Foreign/Marshal/Error.hs"
, "base/Foreign/Marshal/Pool.hs"
, "base/Foreign/Marshal/Safe.hs"
, "base/Foreign/Marshal/Unsafe.hs"
, "base/Foreign/Marshal/Utils.hs"
, "base/Foreign/Ptr.hs"
, "base/Foreign/Safe.hs"
, "base/Foreign/StablePtr.hs"
, "base/Foreign/Storable.hs"
, "base/GHC/Arr.hs"
, "base/GHC/Base.hs"
, "base/GHC/Char.hs"
, "base/GHC/Conc.hs"
, "base/GHC/Conc/IO.hs"
, "base/GHC/Conc/Signal.hs"
, "base/GHC/Conc/Sync.hs"
, "base/GHC/ConsoleHandler.hs"
, "base/GHC/Constants.hs"
, "base/GHC/Desugar.hs"
, "base/GHC/Enum.hs"
, "base/GHC/Environment.hs"
, "base/GHC/Err.hs"
, "base/GHC/Exception.hs"
, "base/GHC/ExecutionStack.hs"
, "base/GHC/ExecutionStack/Internal.hs"
, "base/GHC/Exts.hs"
, "base/GHC/Fingerprint.hs"
, "base/GHC/Fingerprint/Type.hs"
, "base/GHC/Float.hs"
, "base/GHC/Float/ConversionUtils.hs"
, "base/GHC/Float/RealFracMethods.hs"
, "base/GHC/Foreign.hs"
, "base/GHC/ForeignPtr.hs"
, "base/GHC/GHCi.hs"
, "base/GHC/Generics.hs"
, "base/GHC/IO.hs"
, "base/GHC/IO/Buffer.hs"
, "base/GHC/IO/BufferedIO.hs"
, "base/GHC/IO/Device.hs"
, "base/GHC/IO/Encoding.hs"
, "base/GHC/IO/Encoding/CodePage.hs"
, "base/GHC/IO/Encoding/Failure.hs"
, "base/GHC/IO/Encoding/Iconv.hs"
, "base/GHC/IO/Encoding/Latin1.hs"
, "base/GHC/IO/Encoding/Types.hs"
, "base/GHC/IO/Encoding/UTF16.hs"
, "base/GHC/IO/Encoding/UTF32.hs"
, "base/GHC/IO/Encoding/UTF8.hs"
, "base/GHC/IO/Exception.hs"
, "base/GHC/IO/FD.hs"
, "base/GHC/IO/Handle.hs"
, "base/GHC/IO/Handle/FD.hs"
, "base/GHC/IO/Handle/Internals.hs"
, "base/GHC/IO/Handle/Text.hs"
, "base/GHC/IO/Handle/Types.hs"
, "base/GHC/IO/IOMode.hs"
, "base/GHC/IO/Unsafe.hs"
, "base/GHC/IOArray.hs"
, "base/GHC/IORef.hs"
, "base/GHC/Int.hs"
, "base/GHC/List.hs"
, "base/GHC/MVar.hs"
, "base/GHC/Natural.hs"
, "base/GHC/Num.hs"
, "base/GHC/OldList.hs"
, "base/GHC/OverloadedLabels.hs"
, "base/GHC/PArr.hs"
, "base/GHC/Pack.hs"
, "base/GHC/Profiling.hs"
, "base/GHC/Ptr.hs"
, "base/GHC/Read.hs"
, "base/GHC/Real.hs"
, "base/GHC/RTS/Flags.hs"
, "base/GHC/ST.hs"
, "base/GHC/StaticPtr.hs"
, "base/GHC/STRef.hs"
, "base/GHC/Show.hs"
, "base/GHC/Stable.hs"
, "base/GHC/Stack.hs"
, "base/GHC/Stack/CCS.hs"
, "base/GHC/Stack/Types.hs"
, "base/GHC/Stats.hs"
, "base/GHC/Storable.hs"
, "base/GHC/TopHandler.hs"
, "base/GHC/TypeLits.hs"
, "base/GHC/Unicode.hs"
, "base/GHC/Weak.hs"
, "base/GHC/Word.hs"
, "base/Numeric.hs"
, "base/Numeric/Natural.hs"
, "base/Prelude.hs"
, "base/System/CPUTime.hs"
, "base/System/Console/GetOpt.hs"
, "base/System/Environment.hs"
, "base/System/Exit.hs"
, "base/System/IO.hs"
, "base/System/IO/Error.hs"
, "base/System/IO/Unsafe.hs"
, "base/System/Info.hs"
, "base/System/Mem.hs"
, "base/System/Mem/StableName.hs"
, "base/System/Mem/Weak.hs"
, "base/System/Posix/Internals.hs"
, "base/System/Posix/Types.hs"
, "base/System/Timeout.hs"
, "base/Text/ParserCombinators/ReadP.hs"
, "base/Text/ParserCombinators/ReadPrec.hs"
, "base/Text/Printf.hs"
, "base/Text/Read.hs"
, "base/Text/Read/Lex.hs"
, "base/Text/Show.hs"
, "base/Text/Show/Functions.hs"
, "base/Unsafe/Coerce.hs"
]
-- printResult :: CompResult String -> IO ()
-- printResult result = do putStrLn errors
......
libraries/base/.authorspellings 0 → 100644
View file @ 70a4766e
Simon Marlow <marlowsd@gmail.com>, simonmar, simonmar@microsoft.com
Ross Paterson <ross@soi.city.ac.uk>, ross
Sven Panne <sven.panne@aedion.de>, panne
Malcolm Wallace <Malcolm.Wallace@cs.york.ac.uk>, malcolm
Simon Peyton Jones <simonpj@microsoft.com>, simonpj
Don Stewart <dons@galois.com>, dons
Tim Harris <tharris@microsoft.com>, tharris
Lennart Augustsson <lennart@augustsson.net>, lennart.augustsson@credit-suisse.com
Duncan Coutts <duncan@haskell.org>, duncan.coutts@worc.ox.ac.uk, duncan@well-typed.com
Ben Lippmeier <benl@ouroborus.net>, benl@cse.unsw.edu.au, Ben.Lippmeier@anu.edu.au
Manuel M T Chakravarty <chak@cse.unsw.edu.au>, chak
Jose Pedro Magalhaes <jpm@cs.uu.nl>, jpm@cs.uu.nl
libraries/base/.gitignore 0 → 100644
View file @ 70a4766e
*.o
*.aux
*.hi
*.tix
*.exe
# Backup files
*~
# Specific generated files
/GNUmakefile
/autom4te.cache/
/base.buildinfo
/config.log
/config.status
/configure
/dist-install/
/ghc.mk
/include/EventConfig.h
/include/HsBaseConfig.h
/include/HsBaseConfig.h.in
libraries/base/Control/Applicative.hs 0 → 100644
View file @ 70a4766e
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE NoImplicitPrelude #-}
-----------------------------------------------------------------------------
-- |
-- Module : Control.Applicative
-- Copyright : Conor McBride and Ross Paterson 2005
-- License : BSD-style (see the LICENSE file in the distribution)
--
-- Maintainer : libraries@haskell.org
-- Stability : experimental
-- Portability : portable
--
-- This module describes a structure intermediate between a functor and
-- a monad (technically, a strong lax monoidal functor). Compared with
-- monads, this interface lacks the full power of the binding operation
-- '>>=', but
--
-- * it has more instances.
--
-- * it is sufficient for many uses, e.g. context-free parsing, or the
-- 'Data.Traversable.Traversable' class.
--
-- * instances can perform analysis of computations before they are
-- executed, and thus produce shared optimizations.
--
-- This interface was introduced for parsers by Niklas R&#xF6;jemo, because
-- it admits more sharing than the monadic interface. The names here are
-- mostly based on parsing work by Doaitse Swierstra.
--
-- For more details, see
-- <http://www.soi.city.ac.uk/~ross/papers/Applicative.html Applicative Programming with Effects>,
-- by Conor McBride and Ross Paterson.
module Control.Applicative (
-- * Applicative functors
Applicative(..),
-- * Alternatives
Alternative(..),
-- * Instances
Const(..), WrappedMonad(..), WrappedArrow(..), ZipList(..),
-- * Utility functions
(<$>), (<$), (<**>),
liftA, liftA2, liftA3,
optional,
) where
import Control.Category hiding ((.), id)
import Control.Arrow
import Data.Maybe
import Data.Tuple
import Data.Eq
import Data.Ord
import Data.Foldable (Foldable(..))
import Data.Functor ((<$>))
import Data.Functor.Const (Const(..))
import GHC.Base
import GHC.Generics
import GHC.List (repeat, zipWith)
import GHC.Read (Read)
import GHC.Show (Show)
newtype WrappedMonad m a = WrapMonad { unwrapMonad :: m a }
deriving (Generic, Generic1, Monad)
instance Monad m => Functor (WrappedMonad m) where
fmap f (WrapMonad v) = WrapMonad (liftM f v)
instance Monad m => Applicative (WrappedMonad m) where
pure = WrapMonad . pure
WrapMonad f <*> WrapMonad v = WrapMonad (f `ap` v)
instance MonadPlus m => Alternative (WrappedMonad m) where
empty = WrapMonad mzero
WrapMonad u <|> WrapMonad v = WrapMonad (u `mplus` v)
newtype WrappedArrow a b c = WrapArrow { unwrapArrow :: a b c }
deriving (Generic, Generic1)
instance Arrow a => Functor (WrappedArrow a b) where
fmap f (WrapArrow a) = WrapArrow (a >>> arr f)
instance Arrow a => Applicative (WrappedArrow a b) where
pure x = WrapArrow (arr (const x))
WrapArrow f <*> WrapArrow v = WrapArrow (f &&& v >>> arr (uncurry id))
instance (ArrowZero a, ArrowPlus a) => Alternative (WrappedArrow a b) where
empty = WrapArrow zeroArrow
WrapArrow u <|> WrapArrow v = WrapArrow (u <+> v)
-- | Lists, but with an 'Applicative' functor based on zipping, so that
--
-- @f '<$>' 'ZipList' xs1 '<*>' ... '<*>' 'ZipList' xsn = 'ZipList' (zipWithn f xs1 ... xsn)@
--
newtype ZipList a = ZipList { getZipList :: [a] }
deriving ( Show, Eq, Ord, Read, Functor
, Foldable, Generic, Generic1)
-- See Data.Traversable for Traversabel instance due to import loops
instance Applicative ZipList where
pure x = ZipList (repeat x)
ZipList fs <*> ZipList xs = ZipList (zipWith id fs xs)
-- extra functions
-- | One or none.
optional :: Alternative f => f a -> f (Maybe a)
optional v = Just <$> v <|> pure Nothing
libraries/base/Control/Arrow.hs 0 → 100644
View file @ 70a4766e
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -Wno-inline-rule-shadowing #-}
-- The RULES for the methods of class Arrow may never fire
-- e.g. compose/arr; see Trac #10528
-----------------------------------------------------------------------------
-- |
-- Module : Control.Arrow
-- Copyright : (c) Ross Paterson 2002
-- License : BSD-style (see the LICENSE file in the distribution)
--
-- Maintainer : libraries@haskell.org
-- Stability : provisional
-- Portability : portable
--
-- Basic arrow definitions, based on
--
-- * /Generalising Monads to Arrows/, by John Hughes,
-- /Science of Computer Programming/ 37, pp67-111, May 2000.
--
-- plus a couple of definitions ('returnA' and 'loop') from
--
-- * /A New Notation for Arrows/, by Ross Paterson, in /ICFP 2001/,
-- Firenze, Italy, pp229-240.
--
-- These papers and more information on arrows can be found at
-- <http://www.haskell.org/arrows/>.
module Control.Arrow (
-- * Arrows
Arrow(..), Kleisli(..),
-- ** Derived combinators
returnA,
(^>>), (>>^),
(>>>), (<<<), -- reexported
-- ** Right-to-left variants
(<<^), (^<<),
-- * Monoid operations
ArrowZero(..), ArrowPlus(..),
-- * Conditionals
ArrowChoice(..),
-- * Arrow application
ArrowApply(..), ArrowMonad(..), leftApp,
-- * Feedback
ArrowLoop(..)
) where
import Data.Tuple ( fst, snd, uncurry )
import Data.Either
import Control.Monad.Fix
import Control.Category
import GHC.Base hiding ( (.), id )
infixr 5 <+>
infixr 3 ***
infixr 3 &&&
infixr 2 +++
infixr 2 |||
infixr 1 ^>>, >>^
infixr 1 ^<<, <<^
-- | The basic arrow class.
--
-- Instances should satisfy the following laws:
--
-- * @'arr' id = 'id'@
--
-- * @'arr' (f >>> g) = 'arr' f >>> 'arr' g@
--
-- * @'first' ('arr' f) = 'arr' ('first' f)@
--
-- * @'first' (f >>> g) = 'first' f >>> 'first' g@
--
-- * @'first' f >>> 'arr' 'fst' = 'arr' 'fst' >>> f@
--
-- * @'first' f >>> 'arr' ('id' *** g) = 'arr' ('id' *** g) >>> 'first' f@
--
-- * @'first' ('first' f) >>> 'arr' 'assoc' = 'arr' 'assoc' >>> 'first' f@
--
-- where
--
-- > assoc ((a,b),c) = (a,(b,c))
--
-- The other combinators have sensible default definitions,
-- which may be overridden for efficiency.
class Category a => Arrow a where
{-# MINIMAL arr, (first | (***)) #-}
-- | Lift a function to an arrow.
arr :: (b -> c) -> a b c
-- | Send the first component of the input through the argument
-- arrow, and copy the rest unchanged to the output.
first :: a b c -> a (b,d) (c,d)
first = (*** id)
-- | A mirror image of 'first'.
--
-- The default definition may be overridden with a more efficient
-- version if desired.
second :: a b c -> a (d,b) (d,c)
second = (id ***)
-- | Split the input between the two argument arrows and combine
-- their output. Note that this is in general not a functor.
--
-- The default definition may be overridden with a more efficient
-- version if desired.
(***) :: a b c -> a b' c' -> a (b,b') (c,c')
f *** g = first f >>> arr swap >>> first g >>> arr swap
where swap ~(x,y) = (y,x)
-- | Fanout: send the input to both argument arrows and combine
-- their output.
--
-- The default definition may be overridden with a more efficient
-- version if desired.
(&&&) :: a b c -> a b c' -> a b (c,c')
f &&& g = arr (\b -> (b,b)) >>> f *** g
{-# RULES
"compose/arr" forall f g .
(arr f) . (arr g) = arr (f . g)
"first/arr" forall f .
first (arr f) = arr (first f)
"second/arr" forall f .
second (arr f) = arr (second f)
"product/arr" forall f g .
arr f *** arr g = arr (f *** g)
"fanout/arr" forall f g .
arr f &&& arr g = arr (f &&& g)
"compose/first" forall f g .
(first f) . (first g) = first (f . g)
"compose/second" forall f g .
(second f) . (second g) = second (f . g)
#-}
-- Ordinary functions are arrows.
instance Arrow (->) where
arr f = f
-- (f *** g) ~(x,y) = (f x, g y)
-- sorry, although the above defn is fully H'98, nhc98 can't parse it.
(***) f g ~(x,y) = (f x, g y)
-- | Kleisli arrows of a monad.
newtype Kleisli m a b = Kleisli { runKleisli :: a -> m b }
instance Monad m => Category (Kleisli m) where
id = Kleisli return
(Kleisli f) . (Kleisli g) = Kleisli (\b -> g b >>= f)
instance Monad m => Arrow (Kleisli m) where
arr f = Kleisli (return . f)
first (Kleisli f) = Kleisli (\ ~(b,d) -> f b >>= \c -> return (c,d))
second (Kleisli f) = Kleisli (\ ~(d,b) -> f b >>= \c -> return (d,c))
-- | The identity arrow, which plays the role of 'return' in arrow notation.
returnA :: Arrow a => a b b
returnA = arr id
-- | Precomposition with a pure function.
(^>>) :: Arrow a => (b -> c) -> a c d -> a b d
f ^>> a = arr f >>> a
-- | Postcomposition with a pure function.
(>>^) :: Arrow a => a b c -> (c -> d) -> a b d
a >>^ f = a >>> arr f
-- | Precomposition with a pure function (right-to-left variant).
(<<^) :: Arrow a => a c d -> (b -> c) -> a b d
a <<^ f = a <<< arr f
-- | Postcomposition with a pure function (right-to-left variant).
(^<<) :: Arrow a => (c -> d) -> a b c -> a b d
f ^<< a = arr f <<< a
class Arrow a => ArrowZero a where
zeroArrow :: a b c
instance MonadPlus m => ArrowZero (Kleisli m) where
zeroArrow = Kleisli (\_ -> mzero)
-- | A monoid on arrows.
class ArrowZero a => ArrowPlus a where
-- | An associative operation with identity 'zeroArrow'.
(<+>) :: a b c -> a b c -> a b c
instance MonadPlus m => ArrowPlus (Kleisli m) where
Kleisli f <+> Kleisli g = Kleisli (\x -> f x `mplus` g x)
-- | Choice, for arrows that support it. This class underlies the
-- @if@ and @case@ constructs in arrow notation.
--
-- Instances should satisfy the following laws:
--
-- * @'left' ('arr' f) = 'arr' ('left' f)@
--
-- * @'left' (f >>> g) = 'left' f >>> 'left' g@
--
-- * @f >>> 'arr' 'Left' = 'arr' 'Left' >>> 'left' f@
--
-- * @'left' f >>> 'arr' ('id' +++ g) = 'arr' ('id' +++ g) >>> 'left' f@
--
-- * @'left' ('left' f) >>> 'arr' 'assocsum' = 'arr' 'assocsum' >>> 'left' f@
--
-- where
--
-- > assocsum (Left (Left x)) = Left x
-- > assocsum (Left (Right y)) = Right (Left y)
-- > assocsum (Right z) = Right (Right z)
--
-- The other combinators have sensible default definitions, which may
-- be overridden for efficiency.
class Arrow a => ArrowChoice a where
{-# MINIMAL (left | (+++)) #-}
-- | Feed marked inputs through the argument arrow, passing the
-- rest through unchanged to the output.