diff --git a/ma.cabal b/ma.cabal
index b4e00595180de06ec8141a7713ed1cc0b9818f2d..ea28e386e1665d8c98ad689b20b2bae757480ca4 100644
--- a/ma.cabal
+++ b/ma.cabal
@@ -45,6 +45,7 @@ library
                      , MA.Functors.Distribution
                      , MA.Functors.Polynomial
                      , MA.Functors.SomeFunctor
+                     , MA.Functors.HungryProduct
                      , MA.Parser
                      , MA.Parser.Lexer
                      , MA.Parser.Types
@@ -64,6 +65,7 @@ library
                      , MA.PartitionPrinter
                      , MA.Dot
                      , MA.PrettyShow
+                     , MA.WillHaveBetterName
   default-extensions:  GADTs
                      , StandaloneDeriving
                      , DeriveFunctor
diff --git a/src/MA/FunctorDescription.hs b/src/MA/FunctorDescription.hs
index 0a889c7c77a61feb812f29f2bd71d919cb4cf5a2..e63908bc4dc581e1cd84bab41ae0df46f5e01ae2 100644
--- a/src/MA/FunctorDescription.hs
+++ b/src/MA/FunctorDescription.hs
@@ -1,11 +1,14 @@
 {-# LANGUAGE FlexibleContexts #-}
 module MA.FunctorDescription
   ( FunctorParser(..)
+  -- , Mouth(..)
+  -- , HungryFunctorDescription(..)
   , FunctorDescription(..)
   ) where
 
 import           Data.Text (Text)
 
+import           MA.FunctorExpression.Type
 import           MA.FunctorExpression.Parser
 
 data FunctorDescription f = FunctorDescription
@@ -13,3 +16,13 @@ data FunctorDescription f = FunctorDescription
   , syntaxExample :: Text
   , functorExprParser :: FunctorParser f
   }
+
+
+-- data Mouth f g =
+--   Mouth (forall a. f (FunctorExpression g a) -> g (FunctorExpression g a))
+
+-- data Void3 (a :: * -> *) b
+
+
+
+
diff --git a/src/MA/Functors.hs b/src/MA/Functors.hs
index abb501ea66e0bd81ea2258e1ffaa004df6f55f1b..546ce9f86167820999aa5a5992d7cccd8d17287c 100644
--- a/src/MA/Functors.hs
+++ b/src/MA/Functors.hs
@@ -10,7 +10,7 @@ import MA.FunctorDescription
 import MA.Functors.Bag (bag)
 import MA.Functors.Distribution (distribution)
 import MA.Functors.GroupValued (intValued, realValued, complexValued)
-import MA.Functors.Polynomial (polynomial)
+import MA.Functors.Polynomial (polynomial, eat)
 import MA.Functors.Powerset (powerset)
 import MA.Functors.MonoidValued (maxIntValued, maxRealValued)
 import MA.Functors.SomeFunctor
@@ -20,5 +20,5 @@ registeredFunctors =
   [ [someFunctor maxIntValued, someFunctor maxRealValued ]
   , [someFunctor intValued, someFunctor realValued, someFunctor complexValued]
   , [someFunctor powerset, someFunctor bag, someFunctor distribution]
-  , [someFunctor polynomial]
+  , [someHungryFunctor polynomial (Eater eat)]
   ]
diff --git a/src/MA/Functors/Bag.hs b/src/MA/Functors/Bag.hs
index 008abdfc39fba82375478fb7d620124759f345f3..4233d6fba4e400d822548c5400905a24da2c6b29 100644
--- a/src/MA/Functors/Bag.hs
+++ b/src/MA/Functors/Bag.hs
@@ -38,6 +38,7 @@ bag = FunctorDescription
   { name = "Bag"
   , syntaxExample = "BX | ƁX"
   , functorExprParser = prefix ((L.symbol "B" <|> L.symbol "Ɓ") >> pure Bag)
+  -- , isHungry = Nothing
   }
 
 type instance Label Bag = Label (GroupValued Int)
diff --git a/src/MA/Functors/Distribution.hs b/src/MA/Functors/Distribution.hs
index 2f8800f2dc2700c47ef2243260394ecc5587d050..5b1908340ee9efda12b363bbae025a7f8eb0172e 100644
--- a/src/MA/Functors/Distribution.hs
+++ b/src/MA/Functors/Distribution.hs
@@ -32,6 +32,7 @@ distribution = FunctorDescription
   , syntaxExample = "DX | ƊX"
   , functorExprParser = prefix ((L.symbol "D" <|> L.symbol "Ɗ")
                                 >> pure Distribution)
+  -- , isHungry = Nothing
   }
 
 type instance Label Distribution = Label (GroupValued EqDouble)
diff --git a/src/MA/Functors/GroupValued.hs b/src/MA/Functors/GroupValued.hs
index a3890fd82dae78de011a36bc7eb0cca1fe130b94..b1c9d9c8ca9f6cad5e8dbd9db6e4dfff2f039304 100644
--- a/src/MA/Functors/GroupValued.hs
+++ b/src/MA/Functors/GroupValued.hs
@@ -49,6 +49,7 @@ intValued = FunctorDescription
   , syntaxExample = "Z^X | ℤ^X"
   , functorExprParser =
       prefix ((L.symbol "Z" <|> L.symbol "ℤ") >> L.symbol "^" >> pure GroupValued)
+  -- , isHungry = Nothing
   }
 
 realValued :: FunctorDescription (GroupValued EqDouble)
@@ -57,6 +58,7 @@ realValued = FunctorDescription
   , syntaxExample = "R^X | ℝ^X"
   , functorExprParser = prefix
     ((L.symbol "R" <|> L.symbol "ℝ") >> L.symbol "^" >> pure GroupValued)
+  -- , isHungry = Nothing
   }
 
 newtype OrderedComplex = OrderedComplex (Complex EqDouble)
@@ -72,6 +74,7 @@ complexValued = FunctorDescription
   , syntaxExample = "C^X | ℂ^X"
   , functorExprParser = prefix
     ((L.symbol "C" <|> L.symbol "ℂ") >> L.symbol "^" >> pure GroupValued)
+  -- , isHungry = Nothing
   }
 
 data GroupWeight m = GroupWeight !m !m
diff --git a/src/MA/Functors/HungryProduct.hs b/src/MA/Functors/HungryProduct.hs
new file mode 100644
index 0000000000000000000000000000000000000000..7b9c52d8f5a946f06dacaa5a784d2fda3b747646
--- /dev/null
+++ b/src/MA/Functors/HungryProduct.hs
@@ -0,0 +1,58 @@
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+module MA.Functors.HungryProduct (HungryProduct(..)) where
+
+import Prelude hiding (init)
+import Control.Arrow ((***))
+import Control.Monad
+import Data.Bifunctor
+
+import MA.Coalgebra.RefinementTypes
+import MA.RefinementInterface
+import MA.Coalgebra.Parser.Class
+import qualified MA.Parser.Lexer as L
+import MA.Functors.SomeFunctor
+
+-- data HungryProduct f a = HungryProduct (f a) (f a)
+
+data HungryProduct a = HungryProduct (SomeFunctor a) (SomeFunctor a)
+  deriving (Functor, Foldable, Traversable)
+
+-- type instance Label (HungryProduct f) = (Bool, Label f)
+-- type instance Weight (HungryProduct f) = (Weight f, Weight f)
+-- type instance H1 (HungryProduct f) = (H1 f, H1 f)
+-- type instance H3 (HungryProduct f) = (H3 f, H3 f)
+
+type instance Label HungryProduct = (Bool, Label SomeFunctor)
+type instance Weight HungryProduct = (Weight SomeFunctor, Weight SomeFunctor)
+type instance H1 HungryProduct = (H1 SomeFunctor, H1 SomeFunctor)
+type instance H3 HungryProduct = (H3 SomeFunctor, H3 SomeFunctor)
+
+instance RefinementInterface HungryProduct where
+  init :: H1 HungryProduct -> [Label HungryProduct] -> Weight HungryProduct
+  init (h1a, h1b) labels =
+    let labelsA = map snd $ filter fst labels
+        labelsB = map snd $ filter (not . fst) labels
+    in (init @SomeFunctor h1a labelsA, init @SomeFunctor h1b labelsB)
+
+  update :: [Label HungryProduct]
+         -> Weight HungryProduct
+         -> (Weight HungryProduct, H3 HungryProduct, Weight HungryProduct)
+  update labels (wa, wb) =
+    let labelsA = map snd $ filter fst labels
+        labelsB = map snd $ filter (not . fst) labels
+        (w1a, h3a, w2a) = update @SomeFunctor labelsA wa
+        (w1b, h3b, w2b) = update @SomeFunctor labelsB wb
+    in ((w1a, w1b), (h3a, h3b), (w2a, w2b))
+
+
+instance ParseMorphism HungryProduct where
+  parseMorphismPoint (HungryProduct f1 f2) = L.parens $ do
+    (h1a, succsA) <- parseMorphismPoint f1
+    void L.comma
+    (h1b, succsB) <- parseMorphismPoint f2
+
+    return ((h1a, h1b), (fmap (second (True,)) succsA)
+                     <> (fmap (second (False,)) succsB))
diff --git a/src/MA/Functors/MonoidValued.hs b/src/MA/Functors/MonoidValued.hs
index bca6ad7eb51a7e46877ca05cf41a4f65c907a6d9..b47c3b03e03c29cae72ab5c8d33627accc596144 100644
--- a/src/MA/Functors/MonoidValued.hs
+++ b/src/MA/Functors/MonoidValued.hs
@@ -55,6 +55,7 @@ maxIntValued :: FunctorDescription (SlowMonoidValued (Max Int))
 maxIntValued = FunctorDescription
   { name = "Max-valued"
   , syntaxExample = "(Z, max)^X"
+  -- , isHungry = Nothing
   , functorExprParser =
     prefix
       -- We need this try here, so that parenthesis can still be parsed as
@@ -74,6 +75,7 @@ maxRealValued :: FunctorDescription (SlowMonoidValued MaxDouble)
 maxRealValued = FunctorDescription
   { name = "Max-valued"
   , syntaxExample = "(R, max)^X"
+  -- , isHungry = Nothing
   , functorExprParser =
     prefix
       -- We need this try here, so that parenthesis can still be parsed as
diff --git a/src/MA/Functors/Polynomial.hs b/src/MA/Functors/Polynomial.hs
index 9f0c0b51774e09e884c1a6c6cc169a00ca87242c..6031561fc57e8def4f7f33cc90e61fe7e538b32e 100644
--- a/src/MA/Functors/Polynomial.hs
+++ b/src/MA/Functors/Polynomial.hs
@@ -19,6 +19,7 @@ module MA.Functors.Polynomial
   , ConstSet(..)
   , Exponent(..)
   , PolyH1(..)
+  , eat
   ) where
 
 import           Control.Monad
@@ -47,6 +48,10 @@ import           MA.Parser.Types
 import           MA.RefinementInterface
 import           MA.FunctorExpression.Parser
 import           MA.FunctorDescription
+import           MA.Functors.HungryProduct
+import           MA.FunctorExpression.Type
+import           MA.Functors.SomeFunctor
+
 
 newtype Polynomial a = Polynomial (Sum a)
   deriving (Functor, Foldable, Traversable)
@@ -92,6 +97,15 @@ polynomial = FunctorDescription
   , functorExprParser = polynomialp
   }
 
+eat :: Polynomial (FunctorExpression SomeFunctor a) -> HungryProduct (FunctorExpression SomeFunctor a)
+eat (Polynomial (Sum ((Product ((Identity a):|[Identity b])):|[]))) =
+  case (a, b) of
+    (Functor _ innerA, Functor _ innerB) ->
+      HungryProduct innerA innerB
+    _ -> error "coffee"
+eat _ = error "tea"
+
+
 polynomialp :: FunctorParser Polynomial
 polynomialp = FunctorParser $ \inner -> do
   parseSumExpr inner >>= \case
diff --git a/src/MA/Functors/Powerset.hs b/src/MA/Functors/Powerset.hs
index aa91140f48d6f402d72ab8d2d8c255a305cfdf12..ebabae0f9457867b4d232cd54db491c20c1213e0 100644
--- a/src/MA/Functors/Powerset.hs
+++ b/src/MA/Functors/Powerset.hs
@@ -23,6 +23,7 @@ powerset :: FunctorDescription Powerset
 powerset = FunctorDescription
   { name = "Powerset"
   , syntaxExample = "PX | ƤX"
+  -- , isHungry = Nothing
   , functorExprParser =
     prefix ((L.symbol "P" <|> L.symbol "Ƥ") >> pure Powerset)
   }
diff --git a/src/MA/Functors/SomeFunctor.hs b/src/MA/Functors/SomeFunctor.hs
index f05ae3a1989752290a00a5806932fc7e54efc7d3..0412581f4a787fcbbe706b5fca1c90bd6e3fcbc3 100644
--- a/src/MA/Functors/SomeFunctor.hs
+++ b/src/MA/Functors/SomeFunctor.hs
@@ -6,15 +6,22 @@
 module MA.Functors.SomeFunctor
   ( SomeFunctor(..)
   , someFunctor
+  , someHungryFunctor
+  , Eater(..)
+  , gregorSamsa
   ) where
 
 import           Prelude hiding (init)
+import           Data.Void
+import           Unsafe.Coerce
 
 import           Type.Reflection
 import           Data.Maybe (mapMaybe)
+import           Data.Functor.Const
 
 import           Control.DeepSeq (NFData(..))
 import qualified Data.Vector as V
+import qualified Data.Text as T
 
 import           MA.Coalgebra.Parser.Class
 import           MA.Coalgebra.RefinementTypes
@@ -22,6 +29,7 @@ import           MA.FunctorDescription
 import           MA.FunctorExpression.Parser
 import           MA.PrettyShow
 import           MA.RefinementInterface
+import           MA.FunctorExpression.Type
 
 type Suitable f
    = ( RefinementInterface f
@@ -35,10 +43,15 @@ type Suitable f
 
 data SomeFunctor a where
   SomeFunctor
-    :: (Suitable f, Typeable f, ParseMorphism f)
-    => f a
+    :: (Suitable f, Typeable f, ParseMorphism f, Suitable g, Typeable g, ParseMorphism g)
+    => Eater f g -> f a
     -> SomeFunctor a
 
+data Eater f g = Eater (forall a. f (FunctorExpression SomeFunctor a) -> g (FunctorExpression SomeFunctor a))
+data Void2 a
+
+-- type SomeFunctor = SomeFunctor2 Void2
+
 deriving instance Functor SomeFunctor
 deriving instance Foldable SomeFunctor
 deriving instance Traversable SomeFunctor
@@ -48,7 +61,29 @@ someFunctor ::
   => FunctorDescription f
   -> FunctorDescription SomeFunctor
 someFunctor fd =
-  fd { functorExprParser = transParser SomeFunctor (functorExprParser fd )}
+  fd { functorExprParser = transParser (SomeFunctor (Eater id)) (functorExprParser fd )
+     }
+
+someHungryFunctor ::
+     (Suitable f, Typeable f, ParseMorphism f , Suitable g, Typeable g, ParseMorphism g)
+  => FunctorDescription f
+  -> Eater f g
+  -> FunctorDescription SomeFunctor
+someHungryFunctor fd eater =
+  fd { functorExprParser = transParser (SomeFunctor eater) (functorExprParser fd )
+     }
+
+-- type Const2 (f :: * -> *) (ignore :: * -> *) = f
+-- data Const2 f (ignore :: * -> *) a = Const2 (f a)
+
+-- transHungry :: Mouth f g -> Mouth SomeFunctor SomeFunctor
+-- transHungry (Mouth trans) =
+  -- Mouth $ \(SomeFunctor inner) -> SomeFunctor inner
+
+gregorSamsa :: FunctorExpression SomeFunctor a -> FunctorExpression SomeFunctor a
+gregorSamsa Variable = Variable
+gregorSamsa (Functor a (SomeFunctor (Eater eat) inner)) =
+  Functor a (SomeFunctor (Eater id) (eat (fmap gregorSamsa inner)))
 
 data SomeLabel where
   SomeLabel :: (Suitable f) => TypeRep f -> Label f -> SomeLabel
@@ -56,6 +91,9 @@ data SomeLabel where
 instance PrettyShow SomeLabel where
   prettyShow (SomeLabel _ inner) = prettyShow inner
 
+instance Show SomeLabel where
+  show = T.unpack . prettyShow
+
 instance NFData SomeLabel where
   rnf (SomeLabel !_ !inner) = rnf inner
 
@@ -65,6 +103,9 @@ data SomeWeight where
 data SomeH1 where
   SomeH1 :: (Suitable f) => TypeRep f -> H1 f -> SomeH1
 
+instance Show SomeH1 where
+  show = T.unpack . prettyShow
+
 instance Eq SomeH1 where
   (SomeH1 f1 a) == (SomeH1 f2 b) = case eqTypeRep f1 f2 of
     Nothing -> False
@@ -122,7 +163,7 @@ instance RefinementInterface SomeFunctor where
         Just HRefl -> Just l
 
 instance ParseMorphism SomeFunctor where
-  parseMorphismPoint (SomeFunctor (f :: tf (MorphParser l h1 x))) = do
+  parseMorphismPoint (SomeFunctor _ (f :: tf (MorphParser l h1 x))) = do
     (h1, succs) <- parseMorphismPoint f
     let fRep = typeRep @tf
         newH1 = SomeH1 fRep h1
diff --git a/src/MA/Parser.hs b/src/MA/Parser.hs
index ce3e1db26812c225d87424869181706bbd4ce9a0..3fe0432310de72c88c196966006f6e3bee23b159 100644
--- a/src/MA/Parser.hs
+++ b/src/MA/Parser.hs
@@ -29,7 +29,7 @@ import           MA.FunctorExpression.Desorting
 import           MA.FunctorExpression.Type
 import           MA.FunctorDescription
 import           MA.Functors.Polynomial
-import           MA.Functors.SomeFunctor (SomeFunctor(SomeFunctor))
+import           MA.Functors.SomeFunctor (SomeFunctor(SomeFunctor), Eater(..))
 
 functorExpressionParser ::
      (Traversable f, ParseMorphism f)
@@ -64,7 +64,7 @@ parseFunctor name input =
   let identity =
         Functor
           (Precedence 0)
-          (SomeFunctor
+          (SomeFunctor (Eater id)
              (Polynomial
                 (Sum (E.fromList [Product (E.fromList [Identity Variable])]))))
    in bimap
@@ -84,7 +84,7 @@ parseCoalgebra functor name input =
   let identity =
         Functor
           (Precedence 0)
-          (SomeFunctor
+          (SomeFunctor (Eater id)
              (Polynomial
                 (Sum (E.fromList [Product (E.fromList [Identity Variable])]))))
       eitherFunctor = maybe (Left (identity, functorParsers)) Right functor
diff --git a/src/MA/WillHaveBetterName.hs b/src/MA/WillHaveBetterName.hs
new file mode 100644
index 0000000000000000000000000000000000000000..56377ce368d7c282aa5e80b4ca6ea2ca5f82a4d5
--- /dev/null
+++ b/src/MA/WillHaveBetterName.hs
@@ -0,0 +1,15 @@
+module MA.WillHaveBetterName () where
+
+import MA.FunctorExpression.Type
+import MA.Functors.SomeFunctor
+
+-- class Hungry f g | f -> g where
+--   eat :: f (FunctorExpression SomeFunctor a) -> g (FunctorExpression SomeFunctor a)
+--   eat = id
+
+
+-- morph :: FunctorExpression SomeFunctor a -> FunctorExpression SomeFunctor a
+-- morph Variable = Variable
+-- morph (Functor a (SomeFunctor f)) = Functor a (SomeFunctor (eat f))
+
+
diff --git a/src/main/Main.hs b/src/main/Main.hs
index 6058ab9825de3ecf64c29442bb2fa51f35ee7887..73512800acdd78140db9033aa33786b6d4d94188 100644
--- a/src/main/Main.hs
+++ b/src/main/Main.hs
@@ -43,7 +43,7 @@ import           MA.FunctorDescription
 import qualified Data.MorphismEncoding as Encoding
 import           MA.FunctorExpression.Sorts (Sort, sortedSort)
 import qualified Data.Partition as Partition
-import           MA.Functors.SomeFunctor (SomeFunctor)
+import           MA.Functors.SomeFunctor (SomeFunctor, gregorSamsa)
 import           MA.FunctorExpression.Type (FunctorExpression)
 import           MA.Dot