Make <* and *> default instances

The previous solution was to exploit a compiler bug

src/libraries/OS-Independent/Control/Applicative.dcl

@@ -17,6 +17,12 @@ where
 	pure           :: a -> f a
 	(<*>) infixl 4 :: !(f (a -> b)) (f a) -> f b
 
+	(<*) infixl 4  :: !(f a) (f b) -> f a
+	(<*) fa fb = pure (\x _->x) <*> fa <*> fb
+
+	(*>) infixl 4  :: !(f a) (f b) -> f b
+	(*>) fa fb = pure (\_ x->x) <*> fa <*> fb
+
 class Alternative f | Applicative f
 where
 	empty          :: f a
@@ -37,29 +43,6 @@ some :: (f a) -> f [a] | Alternative f
 
 many :: (f a) -> f [a] | Alternative f
 
-/**
- * Sequence actions and take the value of the right argument.
- * Previously, this was a normal function with the type context Applicative f
- * and an implementation similar to the instance for f now. However, for some
- * types there are more efficient possibilities. Making this a class with a
- * default implementation allows overriding the instance in such cases, like
- * for Maybe here.
- * Be aware that the execution order has to be correct: the left hand side must
- * be evaluated before the right hand side.
- */
-class (*>) infixl 4 f :: !(f a) (f b) -> f b | Applicative f
-instance *> f
-
-/**
- * Sequence actions and take the value of the left argument.
- * For the reason behind making this a class rather than a normal function, see
- * the documentation on *>.
- * Be aware that the execution order has to be correct: the left hand side must
- * be evaluated before the right hand side.
- */
-class (<*) infixl 4 f :: !(f a) (f b) -> f a | Applicative f
-instance <* f
-
 (<**>) infixl 4 :: (f a) (f (a -> b)) -> f b | Applicative f
 
 lift :: a -> f a | Applicative f

src/libraries/OS-Independent/Control/Applicative.icl

@@ -6,6 +6,17 @@ from Data.Monoid import class Monoid, class Semigroup
 import qualified Data.Monoid as DM
 from StdFunc import id, o, flip, const
 
+class Applicative f | Functor f
+where
+	pure           :: a -> f a
+	(<*>) infixl 4 :: !(f (a -> b)) (f a) -> f b
+
+	(<*) infixl 4  :: !(f a) (f b) -> f a
+	(<*) fa fb = pure (\x _->x) <*> fa <*> fb
+
+	(*>) infixl 4  :: !(f a) (f b) -> f b
+	(*>) fa fb = pure (\_ x->x) <*> fa <*> fb
+
 getConst :: !(Const a b) -> a
 getConst (Const x) = x
 
@@ -49,10 +60,6 @@ many v = many_v
   where  many_v  = some_v <|> lift []
          some_v  = (\x xs -> [x:xs]) <$> v <*> many_v
 
-instance *> f where *> fa fb = id <$ fa <*> fb
-
-instance <* f where <* fa fb = liftA2 const fa fb
-
 (<**>) infixl 4 :: (f a) (f (a -> b)) -> f b | Applicative f
 (<**>) fa fab = liftA2 (flip ($)) fa fab
 

src/libraries/OS-Independent/Data/Either.dcl

@@ -5,7 +5,7 @@ definition module Data.Either
 * used inside generic functions, since most generic functions treat this
 * type in a special way which may lead to strange behavior.
 */
-from Control.Applicative import class Applicative, class *>, class <*, class Alternative
+from Control.Applicative import class Applicative, class Alternative
 from Control.Monad import class Monad
 from Data.Functor import class Functor
 from Data.Monoid import class Monoid, class Semigroup
@@ -17,14 +17,7 @@ from Data.GenEq import generic gEq
 :: Either a b = Left a | Right b
 
 instance Functor (Either a)
-
 instance Applicative (Either e)
-
-// Making use of the type information allows for faster sequencing operators.
-// See the documentation on *> in Control.Applicative.
-instance *> (Either e)
-instance <* (Either e)
-
 instance Monad (Either e)
 
 instance Foldable (Either a)

src/libraries/OS-Independent/Data/Either.icl

@@ -15,24 +15,21 @@ import Data.Bifunctor
 import Data.GenEq
 
 instance Functor (Either a) where
-  fmap f (Left l)  = Left l
-  fmap f (Right r) = Right (f r)
+	fmap f (Left l)  = Left l
+	fmap f (Right r) = Right (f r)
 
 instance Applicative (Either e) where
-  pure x        = Right x
-  (<*>) (Left  e) _ = Left e
-  (<*>) (Right f) r = fmap f r
+	pure x        = Right x
 
-instance *> (Either e)
-where
-	*> (Right _) e = e
-	*> (Left l)  _ = Left l
+	(<*>) (Left  e) _ = Left e
+	(<*>) (Right f) r = fmap f r
 
-instance <* (Either e)
-where
-	<* (Left l)  _         = Left l
-	<* _         (Left l)  = Left l
-	<* x         _         = x
+	(*>) (Right _) e = e
+	(*>) (Left l)  _ = Left l
+
+	(<*) (Left l)  _         = Left l
+	(<*) _         (Left l)  = Left l
+	(<*) x         _         = x
 
 instance Monad (Either e)
 where

src/libraries/OS-Independent/Data/Foldable.dcl

 definition module Data.Foldable
 
-from Control.Applicative import class Applicative (..), :: Const, class Alternative (..), class *>
+from Control.Applicative import class Applicative (..), :: Const, class Alternative (..)
 from Control.Monad import class Monad (..), >>=, class MonadPlus (..)
 from Data.Functor import class Functor (..)
 from Data.Monoid import class Monoid (..), class Semigroup (..)
@@ -105,7 +105,7 @@ foldlM :: (b a -> m b) b (t a) -> m b | Foldable t & Monad m
  * Map each element of a structure to an action, evaluate these actions from
  * left to right, and ignore the results.
  */
-traverse_ :: (a -> f b) (t a) -> f () | Foldable t & Applicative, *> f
+traverse_ :: (a -> f b) (t a) -> f () | Foldable t & Applicative f
 
 /**
  * `for_` is {{`traverse_`}} with its arguments flipped.
@@ -129,7 +129,7 @@ forM_ :== flip mapM_
  * Evaluate each action in the structure from left to right, and ignore the
  * results.
  */
-sequenceA_ :: (t (f a)) -> f () | Foldable t & Applicative, *> f
+sequenceA_ :: (t (f a)) -> f () | Foldable t & Applicative f
 
 /**
  * Evaluate each monadic action in the structure from left to right, and ignore

src/libraries/OS-Independent/Data/Foldable.icl

@@ -47,13 +47,13 @@ foldlM :: (b a -> m b) b (t a) -> m b | Foldable t & Monad m
 foldlM f z0 xs = foldr f` pure xs z0
   where f` x k z = f z x >>= k
 
-traverse_ :: (a -> f b) (t a) -> f () | Foldable t & Applicative, *> f
+traverse_ :: (a -> f b) (t a) -> f () | Foldable t & Applicative f
 traverse_ f x = foldr ((*>) o f) (pure ()) x
 
 mapM_ :: (a -> m b) (t a) -> m () | Foldable t & Monad m
 mapM_ f x = foldr ((\ma mb -> ma >>= \_ -> mb) o f) (pure ()) x
 
-sequenceA_ :: (t (f a)) -> f () | Foldable t & Applicative, *> f
+sequenceA_ :: (t (f a)) -> f () | Foldable t & Applicative f
 sequenceA_ x = foldr (*>) (pure ()) x
 
 concat :: (t [a]) -> [a] | Foldable t

src/libraries/OS-Independent/Data/Functor/Identity.icl

 implementation module Data.Functor.Identity
 
-from Data.Functor import class Functor
-from Control.Applicative import class Applicative
-from Control.Monad import class Monad
+import Data.Functor
+import Control.Applicative
+import Control.Monad
 
 :: Identity a = Identity a
 

src/libraries/OS-Independent/Data/GenFDomain.icl

@@ -2,16 +2,17 @@ implementation module Data.GenFDomain
 
 import StdChar, StdEnum, StdInt, StdList
 import StdGeneric
+import Data.List
+import Control.GenBimap
 
 generic gFDomain a :: [a]
 gFDomain{|Bool|}         = [False,True]
 gFDomain{|Char|}         = map toChar [0..255]
 gFDomain{|UNIT|}         = [UNIT]
-gFDomain{|PAIR|}   dx dy = [PAIR x y \\ x <- dx, y <- dy]
+gFDomain{|PAIR|}   dx dy = zipWith PAIR dx dy
 gFDomain{|EITHER|} dx dy = map LEFT dx ++ map RIGHT dy
 gFDomain{|CONS|}   dx    = map CONS   dx
 gFDomain{|FIELD|}  dx    = map FIELD  dx
 gFDomain{|OBJECT|} dx    = map OBJECT dx
 
-derive bimap []
 derive gFDomain (,), (,,), (,,,), (,,,,), (,,,,,), (,,,,,,), (,,,,,,,)

src/libraries/OS-Independent/Data/Maybe.dcl

@@ -7,7 +7,7 @@ import StdMaybe
 
 from StdOverloaded import class ==(..)
 from Data.Functor import class Functor
-from Control.Applicative import class Applicative, class *>, class <*, class Alternative
+from Control.Applicative import class Applicative, class Alternative
 from Control.Monad import class Monad, class MonadPlus
 from Control.Monad.Trans import class MonadTrans
 from Data.Monoid import class Semigroup, class Monoid
@@ -17,8 +17,6 @@ from Data.GenEq import generic gEq
 
 instance Functor Maybe
 instance Applicative Maybe
-instance *> Maybe
-instance <* Maybe
 instance Alternative Maybe
 instance Monad Maybe
 instance MonadPlus Maybe

src/libraries/OS-Independent/Data/Maybe.icl

@@ -21,17 +21,11 @@ where
 	pure x            = Just x
 	(<*>) Nothing  _  = Nothing
 	(<*>) (Just f) ma = fmap f ma
-
-instance *> Maybe
-where
-	*> (Just _) m = m
-	*> _        _ = Nothing
-
-instance <* Maybe
-where
-	<* Nothing _  = Nothing
-	<* m (Just _) = m
-	<* _ _        = Nothing
+	(*>) (Just _) m = m
+	(*>) _        _ = Nothing
+	(<*) Nothing _  = Nothing
+	(<*) m (Just _) = m
+	(<*) _ _        = Nothing
 
 instance Alternative Maybe
 where
@@ -118,7 +112,7 @@ instance Functor (MaybeT m) | Functor m where
 instance Applicative (MaybeT m) | Monad m where
 	pure x = MaybeT $ pure $ Just x
 
-	<*> mf mx = MaybeT $
+	(<*>) mf mx = MaybeT $
 		runMaybeT mf >>= \mb_f ->
 		case mb_f of
 			Nothing = pure Nothing

src/libraries/OS-Independent/Text/Parsers/Simple/Core.icl

 implementation module Text.Parsers.Simple.Core
 
+import StdEnv
+
 import Control.Applicative
 import Control.Monad
 import Data.Either
 import Data.Func
 import Data.Functor
 import Data.List
-from StdFunc import o, const
 
 :: PCont t a :== [t] -> ([(a, [t])], [Error])
 :: Parser t a = Parser (PCont t a)

src/libraries/OS-Independent/Text/Parsers/ZParsers/ParsersKernel.dcl

@@ -2,7 +2,7 @@ definition module Text.Parsers.ZParsers.ParsersKernel
 from StdEnv import class Eq, class toString, class ==
 from Data.Maybe import :: Maybe(..)
 
-from Control.Applicative import class Applicative, class Alternative, class *>
+from Control.Applicative import class Applicative, class Alternative
 from Control.Monad import class Monad
 from Data.Functor import class Functor
 
@@ -58,9 +58,9 @@ instance Monad (Gram f) | Functor f
 
 mkP :: !(Gram f a) -> f a | Monad f & Applicative f & Alternative f
 
-sepBy :: !(Gram f a) (f b) -> f a | Monad, Applicative, Alternative, *> f
+sepBy :: !(Gram f a) (f b) -> f a | Monad, Applicative, Alternative f
 
-insertSep :: (f b) !(Gram f a) -> Gram f a | Monad, Applicative, Alternative, *> f
+insertSep :: (f b) !(Gram f a) -> Gram f a | Monad, Applicative, Alternative f
 
 gmList :: !(Gram f a) -> Gram f [a] | Functor f
 

src/libraries/OS-Independent/Text/Parsers/ZParsers/ParsersKernel.icl

@@ -188,18 +188,18 @@ mkP (Gram l_a m_a) = foldr (<|>) (maybe empty pure m_a)
   where  mkP_Alt (Seq f_b2a g_b)   = f_b2a <*> mkP g_b
          mkP_Alt (Bind f_b b2g_a)  = f_b >>= (mkP o b2g_a)
 
-sepBy :: !(Gram f a) (f b) -> f a | Monad, Applicative, Alternative, *> f
+sepBy :: !(Gram f a) (f b) -> f a | Monad, Applicative, Alternative f
 sepBy g sep = mkP (insertSep sep g)
 
-insertSep :: (f b) !(Gram f a) -> Gram f a | Monad, Applicative, Alternative, *> f
+insertSep :: (f b) !(Gram f a) -> Gram f a | Monad, Applicative, Alternative f
 insertSep sep (Gram na ea) = Gram (map insertSepInAlt na) ea
    where insertSepInAlt (Seq fb2a gb)   = Seq fb2a (prefixSepInGram sep gb)
          insertSepInAlt (Bind fc c2ga)  = Bind fc (insertSep sep o c2ga)
 
-prefixSepInGram :: (f b) (Gram f a) -> Gram f a | Monad, Applicative, Alternative, *> f
+prefixSepInGram :: (f b) (Gram f a) -> Gram f a | Monad, Applicative, Alternative f
 prefixSepInGram sep (Gram na ne)   = Gram (map (prefixSepInAlt sep) na) ne
 
-prefixSepInAlt :: (f a) (PAlt f b) -> PAlt f b | Monad, Applicative, Alternative, *> f
+prefixSepInAlt :: (f a) (PAlt f b) -> PAlt f b | Monad, Applicative, Alternative f
 prefixSepInAlt sep (Seq fb2a gb)   = Seq (sep *> fb2a) (prefixSepInGram sep gb)
 
 gmList :: !(Gram f a) -> Gram f [a] | Functor f