Monadic Arithmetics

/* Stop >>= \a -> >>= \b insane! */

instance + (m a) | + a & Monad m
where
 (+) ma mb = ma >>= \a -> mb >>= \b -> return $! a + b

instance - (m a) | - a & Monad m
where
 (-) ma mb = ma >>= \a -> mb >>= \b -> return $! a - b

instance * (m a) | * a & Monad m
where
 (*) ma mb = ma >>= \a -> mb >>= \b -> return $! a * b

instance / (m a) | / a & Monad m
where
 (/) ma mb = ma >>= \a -> mb >>= \b -> return $! a / b

instance mod (m a) | mod a & Monad m
where
 (mod) ma mb = ma >>= \a -> mb >>= \b -> return $! a mod b

instance rem (m a) | rem a & Monad m
where
 (rem) ma mb = ma >>= \a -> mb >>= \b -> return $! a rem b

/* http://hpaste.org/10673 */

Heterogeneous lists for poor Concurrent Clean programmer

module sh /* search hlist */

import Same, FuncPipe, UnitType, UndefValue, Float, ErrorValue, Char, Logical, String
import Map, FPToolbox

Start = test2

//////////////////////////////

:: O = O
:: I a = I a

pos0 = O
add1 a = I a
add2 a = I (I a)
add3 a = I (I (I a))
pos1 = add1 pos0
pos2 = add2 pos0
pos3 = add3 pos0
pos4 = add1 pos3
pos5 = add2 pos4
pos6 = add3 pos3
pos7 = add3 pos4
pos8 = add3 pos5

///////////////////////////////////////////////////////

test2 :: String
test2 = selectHList pos0 ("hello",(-15.84,(100,(True,<>))))

class SelectHList i a t
where
 selectHList :: i a -> t

instance SelectHList (I i) (a,b) t | SelectHList i b t
where
 selectHList (I i) (a,b) = selectHList i b

instance SelectHList O (a,b) a` | Same a a`
where
 selectHList O (a,b) = same a

////////////////////////////////////////////////////

test :: String
test = searchHList ("hello",(-15.84,(100,(True,<>))))

class SearchHList t a
where
 searchHList :: !a -> t

instance SearchHList t <>
where
 searchHList <> = error "SearchHList: type not found!"

instance SearchHList t (a,b) | IfTypeEqual t a & SearchHList t b // allways inline this instance
where
 searchHList (a,b) = ifTypeEqual a $ searchHList b

class IfTypeEqual t a
where
 ifTypeEqual :: a t -> t

instance IfTypeEqual Int Int  where ifTypeEqual a b = a
instance IfTypeEqual Bool Bool  where ifTypeEqual a b = a
instance IfTypeEqual Float Float where ifTypeEqual a b = a
instance IfTypeEqual Char Char  where ifTypeEqual a b = a
instance IfTypeEqual String String where ifTypeEqual a b = a
instance IfTypeEqual [t] [a] | IfTypeEqual t a
where
 ifTypeEqual a b = map (\(ae,be) -> ifTypeEqual ae be) $ zip2 a b

instance IfTypeEqual t a where ifTypeEqual a f = f