diff --git a/folds.cabal b/folds.cabal
--- a/folds.cabal
+++ b/folds.cabal
@@ -1,6 +1,6 @@
 name:          folds
 category:      Data, Comonads, Enumerator
-version:       0.2
+version:       0.3
 license:       BSD3
 cabal-version: >= 1.8
 license-file:  LICENSE
@@ -54,6 +54,7 @@
     comonad           >= 3.1   && < 4,
     contravariant     >= 0.4.2 && < 1,
     lens              >= 3.9   && < 4,
+    pointed           >= 3     && < 4,
     profunctors       >= 3.3   && < 4,
     reflection        >= 1.3   && < 2,
     semigroupoids     >= 3.1   && < 4,
@@ -68,8 +69,12 @@
     Data.Fold.Internal
     Data.Fold.L
     Data.Fold.L'
+    Data.Fold.L1
+    Data.Fold.L1'
     Data.Fold.M
+    Data.Fold.M1
     Data.Fold.R
+    Data.Fold.R1
 
   ghc-options: -Wall
 
diff --git a/src/Data/Fold.hs b/src/Data/Fold.hs
--- a/src/Data/Fold.hs
+++ b/src/Data/Fold.hs
@@ -10,18 +10,31 @@
 ----------------------------------------------------------------------------
 module Data.Fold
   (
+  -- * Scaners and Foldings
+    Scan(..)
+  , Folding(..)
+  -- * Combinators
+  , beneath
+  -- * Scans
+  -- ** Left Scans
+  , L1(..), L1'(..)
+  -- ** Semigroup Scans
+  , M1(..)
+  -- ** Right Scans
+  , R1(..)
   -- * Foldings
   -- ** Left Foldings
-    L(..), L'(..)
+  , L(..), L'(..)
   -- ** Monoidal Foldings
   , M(..)
   -- ** Right Foldings
   , R(..)
-  -- * Folding Combinators
-  , Folding(..)
-  , beneath
-  -- * Folding Homomorphisms
-  -- $hom
+  -- * Homomorphisms
+  -- ** Scan Homomorphisms
+  -- $scanhom
+
+  -- ** Folding Homomorphisms
+  -- $foldinghom
   , AsRM(..)
   , AsL'(..)
   ) where
@@ -29,40 +42,62 @@
 import Data.Fold.Class
 import Data.Fold.L
 import Data.Fold.L'
+import Data.Fold.L1
+import Data.Fold.L1'
 import Data.Fold.M
+import Data.Fold.M1
 import Data.Fold.R
+import Data.Fold.R1
 import Control.Category ((>>>))
 
--- * Folding Homomorphisms
+-- * Scan Homomorphisms
 
--- $hom
+-- $scanhom
 --
--- We define @f@ to be a folding homomorphism betwen @p@ and @q@ when:
+-- We define @f@ to be a scan homomorphism between @p@ and @q@ when:
 --
 -- @
 -- f :: forall a b. p a b -> q a b
 -- @
 --
 -- @
+-- 'run1' xs (f φ)        ≡ 'run1' xs φ
+-- 'prefix1' xs (f φ)     ≡ f ('prefix1' xs φ)
+-- 'postfix1' (f φ) xs    ≡ f ('postfix1' φ xs)
+-- 'dimap' l r (f φ)      ≡ f ('dimap' l r φ)
+-- 'pure' a               ≡ f ('pure' a)
+-- f φ '<*>' f ψ          ≡ f (φ '<*>' ψ)
+-- 'return' a             ≡ f ('return' a)
+-- f φ '>>=' f . k        ≡ f (φ '>>=' k)
+-- 'interspersing' a (f φ) ≡ f ('interspersing' a φ)
+-- @
+--
+-- Furthermore,
+--
+-- @'left'' (f φ)@ and @f ('left'' φ)@ should agree whenever either answer is 'Right'
+-- @'right'' (f φ)@ and @f ('right'' φ)@ should agree whenver either answer is 'Left'
+--
+
+-- * Folding Homomorphisms
+
+-- $foldinghom
+--
+-- We define @f@ to be a folding homomorphism between @p@ and @q@ when
+-- @f@ is a scan homomorphism and additionally we can satisfy:
+--
+-- @
 -- 'run' xs (f φ)         ≡ 'run' xs φ
 -- 'runOf' l xs (f φ)     ≡ 'runOf' l xs φ
 -- 'prefix' xs (f φ)      ≡ f ('prefix' xs φ)
 -- 'prefixOf' l xs (f φ)  ≡ f ('prefixOf' l xs φ)
 -- 'postfix' (f φ) xs     ≡ f ('postfix' φ xs)
 -- 'postfixOf' l (f φ) xs ≡ f ('postfixOf' l φ xs)
--- 'left'' (f φ)          ≡ f ('left'' φ)
--- 'right'' (f φ)         ≡ f ('right'' φ)
--- 'dimap' l r (f φ)      ≡ f ('dimap' l r φ)
 -- 'extract' (f φ)        ≡ 'extract' φ
--- 'pure' a               ≡ f ('pure' a)
--- f φ '<*>' f ψ          ≡ f (φ '<*>' ψ)
--- 'return' a             ≡ f ('return' a)
--- f φ '>>=' f . k        ≡ f (φ '>>=' k)
 -- 'filtering' p (f φ)     ≡ f ('filtering' p φ)
--- 'interspersing' a (f φ) ≡ f ('interspersing' a φ)
 -- @
 --
--- Note: A law including 'extend' is explicitly excluded.
+-- Note: A law including 'extend' is explicitly excluded. To work consistenly
+-- across foldings, use 'prefix' and 'postfix' instead.
 
 class AsRM p where
   -- | 'asM' is a folding homomorphism to a monoidal folding
diff --git a/src/Data/Fold/Class.hs b/src/Data/Fold/Class.hs
--- a/src/Data/Fold/Class.hs
+++ b/src/Data/Fold/Class.hs
@@ -1,7 +1,9 @@
 {-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE DefaultSignatures #-}
 {-# LANGUAGE Trustworthy #-}
 module Data.Fold.Class
-  ( Folding(..)
+  ( Scan(..)
+  , Folding(..)
   , beneath
   ) where
 
@@ -19,27 +21,38 @@
 instance Foldable One where
   foldMap f (One a) = f a
 
-class Choice p => Folding p where
+class Choice p => Scan p where
+  prefix1 :: a -> p a b -> p a b
+  default prefix1 :: Folding p => a -> p a b -> p a b
+  prefix1 = prefix . One
+  {-# INLINE prefix1 #-}
+
+  postfix1 :: p a b -> a -> p a b
+  default postfix1 :: Folding p => p a b -> a -> p a b
+  postfix1 p = postfix p . One
+  {-# INLINE postfix1 #-}
+
+  -- | Apply a 'Folding' to a single element of input
+  run1 :: a -> p a b -> b
+  default run1 :: Folding p => a -> p a b -> b
+  run1 = run . One
+  {-# INLINE run1 #-}
+
+  interspersing :: a -> p a b -> p a b
+
+class Scan p => Folding p where
   -- | Partially apply a 'Folding' to some initial input on the left.
   --
   prefix :: Foldable t => t a -> p a b -> p a b
   prefix = prefixOf folded
   {-# INLINE prefix #-}
 
-  prefix1 :: a -> p a b -> p a b
-  prefix1 = prefix . One
-  {-# INLINE prefix1 #-}
-
   prefixOf :: Fold s a -> s -> p a b -> p a b
 
   postfix :: Foldable t => p a b -> t a -> p a b
   postfix = postfixOf folded
   {-# INLINE postfix #-}
 
-  postfix1 :: p a b -> a -> p a b
-  postfix1 p = postfix p . One
-  {-# INLINE postfix1 #-}
-
   postfixOf :: Fold s a -> p a b -> s -> p a b
 
   -- | Apply a 'Folding' to a container full of input:
@@ -53,18 +66,9 @@
   run = runOf folded
   {-# INLINE run #-}
 
-  -- | Apply a 'Folding' to a single element of input
-  run1 :: a -> p a b -> b
-  run1 = run . One
-  {-# INLINE run1 #-}
-
   runOf :: Fold s a -> s -> p a b -> b
 
   filtering :: (a -> Bool) -> p a b -> p a b
-
-  interspersing :: a -> p a b -> p a b
-
--- enscanOf :: Traversal s t a b -> s -> p a b -> t
 
 -- | Lift a 'Folding' into a 'Prism'.
 --
diff --git a/src/Data/Fold/L'.hs b/src/Data/Fold/L'.hs
--- a/src/Data/Fold/L'.hs
+++ b/src/Data/Fold/L'.hs
@@ -21,7 +21,7 @@
 import Unsafe.Coerce
 import Prelude hiding (foldl)
 
--- | strict left folds
+-- | A strict left fold / strict Moore machine
 data L' a b = forall r. L' (r -> b) (r -> a -> r) r
 
 -- | Construct a strict Moore machine from a state valuation and transition function
@@ -29,32 +29,35 @@
 unfoldL' f = L' (fst . f) (snd . f)
 {-# INLINE unfoldL' #-}
 
+instance Scan L' where
+  run1 t (L' k h z)    = k $! h z t
+  prefix1 a            = run1 a . duplicate
+  postfix1 t a         = extend (run1 a) t
+  interspersing a (L' k h z) = L' (maybe' (k z) k) h' Nothing' where
+    h' Nothing' b  = Just' (h z b)
+    h' (Just' x) b = Just' (h (h x a) b)
+
+  {-# INLINE run1 #-}
+  {-# INLINE prefix1 #-}
+  {-# INLINE postfix1 #-}
+  {-# INLINE interspersing #-}
+
 -- | efficient 'prefix', leaky 'postfix'
 instance Folding L' where
   run t (L' k h z)     = k $! foldl' h z t
-  run1 t (L' k h z)    = k $! h z t
   runOf l s (L' k h z) = k $! foldlOf' l h z s
   prefix s             = run s . duplicate
-  prefix1 a            = run1 a . duplicate
   prefixOf l s         = runOf l s . duplicate
   postfix t s          = extend (run s) t
-  postfix1 t a         = extend (run1 a) t
   postfixOf l t s      = extend (runOf l s) t
   filtering p (L' k h z) = L' k (\r a -> if p a then h r a else r) z
-  interspersing a (L' k h z) = L' (maybe' (k z) k) h' Nothing' where
-    h' Nothing' b  = Just' (h z b)
-    h' (Just' x) b = Just' (h (h x a) b)
   {-# INLINE run #-}
-  {-# INLINE run1 #-}
   {-# INLINE runOf #-}
   {-# INLINE prefix #-}
-  {-# INLINE prefix1 #-}
   {-# INLINE prefixOf #-}
   {-# INLINE postfix #-}
-  {-# INLINE postfix1 #-}
   {-# INLINE postfixOf #-}
   {-# INLINE filtering #-}
-  {-# INLINE interspersing #-}
 
 instance Profunctor L' where
   dimap f g (L' k h z) = L' (g.k) (\r -> h r . f) z
@@ -123,8 +126,12 @@
 instance Monad (L' a) where
   return = pure
   {-# INLINE return #-}
+
   m >>= f = L' (\xs a -> run xs (f a)) Snoc Nil <*> m
   {-# INLINE (>>=) #-}
+
+  _ >> n = n
+  {-# INLINE (>>) #-}
 
 instance Extend (L' a) where
   extended = extend
diff --git a/src/Data/Fold/L.hs b/src/Data/Fold/L.hs
--- a/src/Data/Fold/L.hs
+++ b/src/Data/Fold/L.hs
@@ -21,7 +21,7 @@
 import Unsafe.Coerce
 import Prelude hiding (foldl)
 
--- left folds
+-- | A Moore Machine
 data L a b = forall r. L (r -> b) (r -> a -> r) r
 
 -- | Construct a Moore machine from a state valuation and transition function
@@ -29,32 +29,34 @@
 unfoldL f = L (fst . f) (snd . f)
 {-# INLINE unfoldL #-}
 
+instance Scan L where
+  run1 t (L k h z)    = k (h z t)
+  prefix1 a           = run1 a . duplicate
+  postfix1 t a        = extend (run1 a) t
+  interspersing a (L k h z) = L (maybe' (k z) k) h' Nothing' where
+    h' Nothing' b  = Just' (h z b)
+    h' (Just' x) b = Just' (h (h x a) b)
+  {-# INLINE run1 #-}
+  {-# INLINE prefix1 #-}
+  {-# INLINE postfix1 #-}
+  {-# INLINE interspersing #-}
+
 -- | efficient 'prefix', leaky 'postfix'
 instance Folding L where
   run t (L k h z)     = k (foldl h z t)
-  run1 t (L k h z)    = k (h z t)
   runOf l s (L k h z) = k (foldlOf l h z s)
   prefix s            = run s . duplicate
-  prefix1 a           = run1 a . duplicate
   prefixOf l s        = runOf l s . duplicate
   postfix t s         = extend (run s) t
-  postfix1 t a        = extend (run1 a) t
   postfixOf l t s     = extend (runOf l s) t
   filtering p (L k h z) = L k (\r a -> if p a then h r a else r) z
-  interspersing a (L k h z) = L (maybe' (k z) k) h' Nothing' where
-    h' Nothing' b  = Just' (h z b)
-    h' (Just' x) b = Just' (h (h x a) b)
   {-# INLINE run #-}
-  {-# INLINE run1 #-}
   {-# INLINE runOf #-}
   {-# INLINE prefix #-}
-  {-# INLINE prefix1 #-}
   {-# INLINE prefixOf #-}
   {-# INLINE postfix #-}
-  {-# INLINE postfix1 #-}
   {-# INLINE postfixOf #-}
   {-# INLINE filtering #-}
-  {-# INLINE interspersing #-}
 
 {-
 enscanl s (L k h z) = snd (mapAccumL h' z s) where
@@ -129,8 +131,12 @@
 instance Monad (L a) where
   return = pure
   {-# INLINE return #-}
+
   m >>= f = L (\xs a -> run xs (f a)) Snoc Nil <*> m
   {-# INLINE (>>=) #-}
+
+  _ >> n = n
+  {-# INLINE (>>) #-}
 
 instance Extend (L a) where
   extended = extend
diff --git a/src/Data/Fold/L1'.hs b/src/Data/Fold/L1'.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Fold/L1'.hs
@@ -0,0 +1,150 @@
+{-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE Trustworthy #-}
+module Data.Fold.L1'
+  ( L1'(..)
+  ) where
+
+import Control.Applicative
+import Control.Arrow
+import Control.Category
+import Control.Lens
+import Data.Fold.Class
+import Data.Fold.Internal
+import Data.Functor.Apply
+import Data.Pointed
+import Data.Profunctor
+import Data.Profunctor.Unsafe
+import Data.Semigroupoid
+import Prelude hiding (id,(.))
+import Unsafe.Coerce
+
+-- | A strict Mealy Machine
+data L1' a b = forall c. L1' (c -> b) (c -> a -> c) (a -> c)
+
+instance Scan L1' where
+  run1 a (L1' k _ z) = k (z a)
+  prefix1 a (L1' k h z) = L1' k h (h $! z a)
+  postfix1 (L1' k h z) a = L1' (\c -> k $! h c a) h z
+  interspersing a (L1' k h z) = L1' k (\x b -> (h $! h x a) b) z
+  {-# INLINE run1 #-}
+  {-# INLINE prefix1 #-}
+  {-# INLINE postfix1 #-}
+  {-# INLINE interspersing #-}
+
+instance Functor (L1' a) where
+  fmap f (L1' k h z) = L1' (f.k) h z
+  {-# INLINE fmap #-}
+  b <$ _ = pure b
+  {-# INLINE (<$) #-}
+
+instance Pointed (L1' a) where
+  point x = L1' (\() -> x) (\() _ -> ()) (\_ -> ())
+  {-# INLINE point #-}
+
+instance Apply (L1' a) where
+  (<.>) = (<*>)
+  {-# INLINE (<.>) #-}
+  (<.) m = \_ -> m
+  {-# INLINE (<.) #-}
+  _ .> m = m
+  {-# INLINE (.>) #-}
+
+instance Applicative (L1' a) where
+  pure x = L1' (\() -> x) (\() _ -> ()) (\_ -> ())
+  {-# INLINE pure #-}
+  L1' kf hf zf <*> L1' ka ha za = L1'
+    (\(Pair' x y) -> kf x (ka y))
+    (\(Pair' x y) a -> Pair' (hf x a) (ha y a))
+    (\a -> Pair' (zf a) (za a))
+  (<*) m = \ _ -> m
+  {-# INLINE (<*) #-}
+  _ *> m = m
+  {-# INLINE (*>) #-}
+
+instance Monad (L1' a) where
+  return x = L1' (\() -> x) (\() _ -> ()) (\_ -> ())
+  {-# INLINE return #-}
+  m >>= f = L1' (\xs a -> walk xs (f a)) Snoc1 First <*> m where
+  {-# INLINE (>>=) #-}
+  _ >> n = n
+  {-# INLINE (>>) #-}
+
+instance Semigroupoid L1' where
+  o = (.)
+  {-# INLINE o #-}
+
+instance Category L1' where
+  id = arr id
+  {-# INLINE id #-}
+  L1' k h z . L1' k' h' z' = L1' (\(Pair' b _) -> k b) h'' z'' where
+    z'' a = Pair' (z (k' b)) b where b = z' a
+    h'' (Pair' c d) a = Pair' (h c (k' d')) d' where d' = h' d a
+  {-# INLINE (.) #-}
+
+instance Arrow L1' where
+  arr h = L1' h (\_ a -> a) id
+  {-# INLINE arr #-}
+  first (L1' k h z) = L1' (first k) h' (first z) where
+    h' (a,b) (c,_) = (h a c, b)
+  {-# INLINE first #-}
+  second (L1' k h z) = L1' (second k) h' (second z) where
+    h' (a,b) (_,c) = (a, h b c)
+  {-# INLINE second #-}
+  L1' k h z *** L1' k' h' z' = L1' (k *** k') h'' (z *** z') where
+    h'' (a,b) (c,d) = (h a c, h' b d)
+  {-# INLINE (***) #-}
+  L1' k h z &&& L1' k' h' z' = L1' (k *** k') h'' (z &&& z') where
+    h'' (c,d) a = (h c a, h' d a)
+  {-# INLINE (&&&) #-}
+
+instance Profunctor L1' where
+  dimap f g (L1' k h z) = L1' (g.k) (\a -> h a . f) (z.f)
+  {-# INLINE dimap #-}
+  lmap f (L1' k h z) = L1' (k) (\a -> h a . f) (z.f)
+  {-# INLINE lmap #-}
+  rmap g (L1' k h z) = L1' (g.k) h z
+  {-# INLINE rmap #-}
+  ( #. ) _ = unsafeCoerce
+  {-# INLINE (#.) #-}
+  x .# _ = unsafeCoerce x
+  {-# INLINE (.#) #-}
+
+instance Strong L1' where
+  first' = first
+  {-# INLINE first' #-}
+  second' = second
+  {-# INLINE second' #-}
+
+instance Choice L1' where
+  left' (L1' k h z) = L1' (_Left %~ k) step (_Left %~ z) where
+    step (Left x) (Left y) = Left (h x y)
+    step (Right c) _ = Right c
+    step _ (Right c) = Right c
+  {-# INLINE left' #-}
+
+  right' (L1' k h z) = L1' (_Right %~ k) step (_Right %~ z) where
+    step (Right x) (Right y) = Right (h x y)
+    step (Left c) _ = Left c
+    step _ (Left c) = Left c
+  {-# INLINE right' #-}
+
+instance ArrowChoice L1' where
+  left (L1' k h z) = L1' (_Left %~ k) step (_Left %~ z) where
+    step (Left x) (Left y) = Left (h x y)
+    step (Right c) _ = Right c
+    step _ (Right c) = Right c
+  {-# INLINE left #-}
+
+  right (L1' k h z) = L1' (_Right %~ k) step (_Right %~ z) where
+    step (Right x) (Right y) = Right (h x y)
+    step (Left c) _ = Left c
+    step _ (Left c) = Left c
+  {-# INLINE right #-}
+
+data SnocList1 a = Snoc1 (SnocList1 a) a | First a
+
+walk :: SnocList1 a -> L1' a b -> b
+walk xs0 (L1' k h z) = k (go xs0) where
+  go (First a) = z a
+  go (Snoc1 as a) = h (go as) a
+{-# INLINE walk #-}
diff --git a/src/Data/Fold/L1.hs b/src/Data/Fold/L1.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Fold/L1.hs
@@ -0,0 +1,150 @@
+{-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE Trustworthy #-}
+module Data.Fold.L1
+  ( L1(..)
+  ) where
+
+import Control.Applicative
+import Control.Arrow
+import Control.Category
+import Control.Lens
+import Data.Fold.Class
+import Data.Fold.Internal
+import Data.Functor.Apply
+import Data.Pointed
+import Data.Profunctor
+import Data.Profunctor.Unsafe
+import Data.Semigroupoid
+import Prelude hiding (id,(.))
+import Unsafe.Coerce
+
+-- | A Mealy Machine
+data L1 a b = forall c. L1 (c -> b) (c -> a -> c) (a -> c)
+
+instance Scan L1 where
+  run1 a (L1 k _ z) = k (z a)
+  prefix1 a (L1 k h z) = L1 k h (h (z a))
+  postfix1 (L1 k h z) a = L1 (\c -> k (h c a)) h z
+  interspersing a (L1 k h z) = L1 k (\x b -> h (h x a) b) z
+  {-# INLINE run1 #-}
+  {-# INLINE prefix1 #-}
+  {-# INLINE postfix1 #-}
+  {-# INLINE interspersing #-}
+
+instance Functor (L1 a) where
+  fmap f (L1 k h z) = L1 (f.k) h z
+  {-# INLINE fmap #-}
+  b <$ _ = pure b
+  {-# INLINE (<$) #-}
+
+instance Pointed (L1 a) where
+  point x = L1 (\() -> x) (\() _ -> ()) (\_ -> ())
+  {-# INLINE point #-}
+
+instance Apply (L1 a) where
+  (<.>) = (<*>)
+  {-# INLINE (<.>) #-}
+  (<.) m = \_ -> m
+  {-# INLINE (<.) #-}
+  _ .> m = m
+  {-# INLINE (.>) #-}
+
+instance Applicative (L1 a) where
+  pure x = L1 (\() -> x) (\() _ -> ()) (\_ -> ())
+  {-# INLINE pure #-}
+  L1 kf hf zf <*> L1 ka ha za = L1
+    (\(Pair' x y) -> kf x (ka y))
+    (\(Pair' x y) a -> Pair' (hf x a) (ha y a))
+    (\a -> Pair' (zf a) (za a))
+  (<*) m = \ _ -> m
+  {-# INLINE (<*) #-}
+  _ *> m = m
+  {-# INLINE (*>) #-}
+
+instance Monad (L1 a) where
+  return x = L1 (\() -> x) (\() _ -> ()) (\_ -> ())
+  {-# INLINE return #-}
+  m >>= f = L1 (\xs a -> walk xs (f a)) Snoc1 First <*> m where
+  {-# INLINE (>>=) #-}
+  _ >> n = n
+  {-# INLINE (>>) #-}
+
+instance Semigroupoid L1 where
+  o = (.)
+  {-# INLINE o #-}
+
+instance Category L1 where
+  id = arr id
+  {-# INLINE id #-}
+  L1 k h z . L1 k' h' z' = L1 (\(Pair' b _) -> k b) h'' z'' where
+    z'' a = Pair' (z (k' b)) b where b = z' a
+    h'' (Pair' c d) a = Pair' (h c (k' d')) d' where d' = h' d a
+  {-# INLINE (.) #-}
+
+instance Arrow L1 where
+  arr h = L1 h (\_ a -> a) id
+  {-# INLINE arr #-}
+  first (L1 k h z) = L1 (first k) h' (first z) where
+    h' (a,b) (c,_) = (h a c, b)
+  {-# INLINE first #-}
+  second (L1 k h z) = L1 (second k) h' (second z) where
+    h' (a,b) (_,c) = (a, h b c)
+  {-# INLINE second #-}
+  L1 k h z *** L1 k' h' z' = L1 (k *** k') h'' (z *** z') where
+    h'' (a,b) (c,d) = (h a c, h' b d)
+  {-# INLINE (***) #-}
+  L1 k h z &&& L1 k' h' z' = L1 (k *** k') h'' (z &&& z') where
+    h'' (c,d) a = (h c a, h' d a)
+  {-# INLINE (&&&) #-}
+
+instance Profunctor L1 where
+  dimap f g (L1 k h z) = L1 (g.k) (\a -> h a . f) (z.f)
+  {-# INLINE dimap #-}
+  lmap f (L1 k h z) = L1 (k) (\a -> h a . f) (z.f)
+  {-# INLINE lmap #-}
+  rmap g (L1 k h z) = L1 (g.k) h z
+  {-# INLINE rmap #-}
+  ( #. ) _ = unsafeCoerce
+  {-# INLINE (#.) #-}
+  x .# _ = unsafeCoerce x
+  {-# INLINE (.#) #-}
+
+instance Strong L1 where
+  first' = first
+  {-# INLINE first' #-}
+  second' = second
+  {-# INLINE second' #-}
+
+instance Choice L1 where
+  left' (L1 k h z) = L1 (_Left %~ k) step (_Left %~ z) where
+    step (Left x) (Left y) = Left (h x y)
+    step (Right c) _ = Right c
+    step _ (Right c) = Right c
+  {-# INLINE left' #-}
+
+  right' (L1 k h z) = L1 (_Right %~ k) step (_Right %~ z) where
+    step (Right x) (Right y) = Right (h x y)
+    step (Left c) _ = Left c
+    step _ (Left c) = Left c
+  {-# INLINE right' #-}
+
+instance ArrowChoice L1 where
+  left (L1 k h z) = L1 (_Left %~ k) step (_Left %~ z) where
+    step (Left x) (Left y) = Left (h x y)
+    step (Right c) _ = Right c
+    step _ (Right c) = Right c
+  {-# INLINE left #-}
+
+  right (L1 k h z) = L1 (_Right %~ k) step (_Right %~ z) where
+    step (Right x) (Right y) = Right (h x y)
+    step (Left c) _ = Left c
+    step _ (Left c) = Left c
+  {-# INLINE right #-}
+
+data SnocList1 a = Snoc1 (SnocList1 a) a | First a
+
+walk :: SnocList1 a -> L1 a b -> b
+walk xs0 (L1 k h z) = k (go xs0) where
+  go (First a) = z a
+  go (Snoc1 as a) = h (go as) a
+{-# INLINE walk #-}
diff --git a/src/Data/Fold/M.hs b/src/Data/Fold/M.hs
--- a/src/Data/Fold/M.hs
+++ b/src/Data/Fold/M.hs
@@ -26,49 +26,51 @@
 import Unsafe.Coerce
 import Prelude hiding (sum, product, length)
 
--- | A 'foldMap' caught in amber.
+-- | A 'foldMap' caught in amber. a.k.a. a monoidal reducer
 data M a b = forall m. M (m -> b) (a -> m) (m -> m -> m) m
 
+instance Scan M where
+  run1 a (M k h _ _) = k (h a)
+  prefix1 a (M k h m z) = case h a of
+     x -> M (\y -> k (m x y)) h m z
+  postfix1 (M k h m z) a = case h a of
+     y -> M (\x -> k (m x y)) h m z
+  interspersing a (M k h m z) = M (maybe' (k z) k) h' m' Nothing' where
+    h' r  = Just' (h r)
+    m' (Just' x) (Just' y) = Just' (x `m` h a `m` y)
+    m' Nothing' my = my
+    m' mx Nothing' = mx
+  {-# INLINE run1 #-}
+  {-# INLINE prefix1 #-}
+  {-# INLINE postfix1 #-}
+  {-# INLINE interspersing #-}
+
 -- | efficient 'prefix', efficient 'postfix'
 instance Folding M where
   run s (M k h m (z :: m)) = reify (m, z) $
     \ (_ :: Proxy s) -> k $ runN (foldMap (N #. h) s :: N m s)
-  run1 a (M k h _ _) = k (h a)
   runOf l s (M k h m (z :: m)) = reify (m, z) $
     \ (_ :: Proxy s) -> k $ runN (foldMapOf l (N #. h) s :: N m s)
   prefix s (M k h m (z :: m)) = reify (m, z) $
     \ (_ :: Proxy s) -> case runN (foldMap (N #. h) s :: N m s) of
       x -> M (\y -> k (m x y)) h m z
-  prefix1 a (M k h m z) = case h a of
-     x -> M (\y -> k (m x y)) h m z
   prefixOf l s (M k h m (z :: m)) = reify (m, z) $
     \ (_ :: Proxy s) -> case runN (foldMapOf l (N #. h) s :: N m s) of
       x -> M (\y -> k (m x y)) h m z
   postfix (M k h m (z :: m)) s = reify (m, z) $
     \ (_ :: Proxy s) -> case runN (foldMap (N #. h) s :: N m s) of
       y -> M (\x -> k (m x y)) h m z
-  postfix1 (M k h m z) a = case h a of
-     y -> M (\x -> k (m x y)) h m z
   postfixOf l (M k h m (z :: m)) s = reify (m, z) $
     \ (_ :: Proxy s) -> case runN (foldMapOf l (N #. h) s :: N m s) of
       y -> M (\x -> k (m x y)) h m z
   filtering p (M k h m z) = M k (\a -> if p a then h a else z) m z
-  interspersing a (M k h m z) = M (maybe' (k z) k) h' m' Nothing' where
-    h' r  = Just' (h r)
-    m' (Just' x) (Just' y) = Just' (x `m` h a `m` y)
-    m' Nothing' my = my
-    m' mx Nothing' = mx
   {-# INLINE run #-}
-  {-# INLINE run1 #-}
   {-# INLINE runOf #-}
   {-# INLINE prefix #-}
-  {-# INLINE prefix1 #-}
   {-# INLINE prefixOf #-}
   {-# INLINE postfix #-}
-  {-# INLINE postfix1 #-}
   {-# INLINE postfixOf #-}
   {-# INLINE filtering #-}
-  {-# INLINE interspersing #-}
 
 instance Profunctor M where
   dimap f g (M k h m e) = M (g.k) (h.f) m e
@@ -133,8 +135,12 @@
 instance Monad (M a) where
   return = pure
   {-# INLINE return #-}
+
   m >>= f = M (\xs a -> run xs (f a)) One Two Zero <*> m
   {-# INLINE (>>=) #-}
+
+  _ >> n = n
+  {-# INLINE (>>) #-}
 
 instance Extend (M a) where
   extended = extend
diff --git a/src/Data/Fold/M1.hs b/src/Data/Fold/M1.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Fold/M1.hs
@@ -0,0 +1,153 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE ExistentialQuantification #-}
+module Data.Fold.M1
+  ( M1(..)
+  ) where
+
+import Control.Applicative
+import Control.Arrow
+import Control.Category
+import Control.Lens
+import Data.Fold.Class
+import Data.Fold.Internal
+import Data.Functor.Apply
+import Data.Pointed
+import Data.Profunctor
+import Data.Profunctor.Unsafe
+import Data.Semigroupoid
+import Prelude hiding (id,(.))
+import Unsafe.Coerce
+
+-- | A semigroup reducer
+data M1 a b = forall m. M1 (m -> b) (a -> m) (m -> m -> m)
+
+instance Scan M1 where
+  run1 a (M1 k h _) = k (h a)
+  prefix1 a (M1 k h m) = case h a of
+     x -> M1 (\y -> k (m x y)) h m
+  postfix1 (M1 k h m) a = case h a of
+     y -> M1 (\x -> k (m x y)) h m
+  interspersing a (M1 k h m) = M1 k h m' where
+    m' x y = x `m` h a `m` y
+  {-# INLINE run1 #-}
+  {-# INLINE prefix1 #-}
+  {-# INLINE postfix1 #-}
+  {-# INLINE interspersing #-}
+
+instance Functor (M1 a) where
+  fmap f (M1 k h m) = M1 (f.k) h m
+  {-# INLINE fmap #-}
+  b <$ _ = pure b
+  {-# INLINE (<$) #-}
+
+instance Pointed (M1 a) where
+  point x = M1 (\() -> x) (\_ -> ()) (\() () -> ())
+  {-# INLINE point #-}
+
+instance Apply (M1 a) where
+  (<.>) = (<*>)
+  {-# INLINE (<.>) #-}
+  (<.) m = \_ -> m
+  {-# INLINE (<.) #-}
+  _ .> m = m
+  {-# INLINE (.>) #-}
+
+instance Applicative (M1 a) where
+  pure x = M1 (\() -> x) (\_ -> ()) (\() () -> ())
+  {-# INLINE pure #-}
+  M1 kf hf mf <*> M1 ka ha ma = M1
+    (\(Pair' x y) -> kf x (ka y))
+    (\a -> Pair' (hf a) (ha a))
+    (\(Pair' x1 y1) (Pair' x2 y2) -> Pair' (mf x1 x2) (ma y1 y2))
+  (<*) m = \ _ -> m
+  {-# INLINE (<*) #-}
+  _ *> m = m
+  {-# INLINE (*>) #-}
+
+instance Monad (M1 a) where
+  return x = M1 (\() -> x) (\_ -> ()) (\() () -> ())
+  {-# INLINE return #-}
+  m >>= f = M1 (\xs a -> walk xs (f a)) Tip1 Bin1 <*> m where
+  {-# INLINE (>>=) #-}
+  _ >> n = n
+  {-# INLINE (>>) #-}
+
+instance Semigroupoid M1 where
+  o = (.)
+  {-# INLINE o #-}
+
+instance Category M1 where
+  id = M1 id id const
+  {-# INLINE id #-}
+  M1 k h m . M1 k' h' m' = M1 (\(Pair' b _) -> k b) h'' m'' where
+    m'' (Pair' a b) (Pair' c d) = Pair' (m a c) (m' b d)
+    h'' a = Pair' (h (k' d)) d where d = h' a
+  {-# INLINE (.) #-}
+
+instance Arrow M1 where
+  arr h = M1 h id const
+  {-# INLINE arr #-}
+  first (M1 k h m) = M1 (first k) (first h) m' where
+    m' (a,b) (c,_) = (m a c, b)
+  {-# INLINE first #-}
+  second (M1 k h m) = M1 (second k) (second h) m' where
+    m' (a,b) (_,c) = (a, m b c)
+  {-# INLINE second #-}
+  M1 k h m *** M1 k' h' m' = M1 (k *** k') (h *** h') m'' where
+    m'' (a,b) (c,d) = (m a c, m' b d)
+  {-# INLINE (***) #-}
+  M1 k h m &&& M1 k' h' m' = M1 (k *** k') (h &&& h') m'' where
+    m'' (a,b) (c,d) = (m a c, m' b d)
+  {-# INLINE (&&&) #-}
+
+instance Profunctor M1 where
+  dimap f g (M1 k h m) = M1 (g.k) (h.f) m
+  {-# INLINE dimap #-}
+  lmap f (M1 k h m) = M1 (k) (h.f) m
+  {-# INLINE lmap #-}
+  rmap g (M1 k h m) = M1 (g.k) h m
+  {-# INLINE rmap #-}
+  ( #. ) _ = unsafeCoerce
+  {-# INLINE (#.) #-}
+  x .# _ = unsafeCoerce x
+  {-# INLINE (.#) #-}
+
+instance Strong M1 where
+  first' = first
+  {-# INLINE first' #-}
+  second' = second
+  {-# INLINE second' #-}
+
+instance Choice M1 where
+  left' (M1 k h m) = M1 (_Left %~ k) (_Left %~ h) step where
+    step (Left x) (Left y) = Left (m x y)
+    step (Right c) _ = Right c
+    step _ (Right c) = Right c
+  {-# INLINE left' #-}
+
+  right' (M1 k h m) = M1 (_Right %~ k) (_Right %~ h) step where
+    step (Right x) (Right y) = Right (m x y)
+    step (Left c) _ = Left c
+    step _ (Left c) = Left c
+  {-# INLINE right' #-}
+
+instance ArrowChoice M1 where
+  left (M1 k h m) = M1 (_Left %~ k) (_Left %~ h) step where
+    step (Left x) (Left y) = Left (m x y)
+    step (Right c) _ = Right c
+    step _ (Right c) = Right c
+  {-# INLINE left #-}
+
+  right (M1 k h m) = M1 (_Right %~ k) (_Right %~ h) step where
+    step (Right x) (Right y) = Right (m x y)
+    step (Left c) _ = Left c
+    step _ (Left c) = Left c
+  {-# INLINE right #-}
+
+data Tree1 a = Bin1 (Tree1 a) (Tree1 a) | Tip1 a
+
+walk :: Tree1 a -> M1 a b -> b
+walk xs0 (M1 k h m) = k (go xs0) where
+  go (Tip1 a) = h a
+  go (Bin1 xs ys) = m (go xs) (go ys)
+{-# INLINE walk #-}
diff --git a/src/Data/Fold/R.hs b/src/Data/Fold/R.hs
--- a/src/Data/Fold/R.hs
+++ b/src/Data/Fold/R.hs
@@ -20,35 +20,37 @@
 import Unsafe.Coerce
 import Prelude hiding (foldr, sum, product, length)
 
--- right folds
+-- | right folds / a reversed Moore machine
 data R a b = forall r. R (r -> b) (a -> r -> r) r
 
+instance Scan R where
+  run1 t (R k h z)    = k (h t z)
+  prefix1 a           = extend (run1 a)
+  postfix1 t a        = run1 a (duplicate t)
+  interspersing a (R k h z) = R (maybe' (k z) k) h' Nothing' where
+    h' b Nothing'  = Just' (h b z)
+    h' b (Just' x) = Just' (h b (h a x))
+  {-# INLINE run1 #-}
+  {-# INLINE prefix1 #-}
+  {-# INLINE postfix1 #-}
+  {-# INLINE interspersing #-}
+
 -- | leaky 'prefix', efficient 'postfix'
 instance Folding R where
   run t (R k h z)     = k (foldr h z t)
-  run1 t (R k h z)    = k (h t z)
   runOf l s (R k h z) = k (foldrOf l h z s)
   prefix s            = extend (run s)
-  prefix1 a           = extend (run1 a)
   prefixOf l s        = extend (runOf l s)
   postfix t s         = run s (duplicate t)
-  postfix1 t a        = run1 a (duplicate t)
   postfixOf l t s     = runOf l s (duplicate t)
   filtering p (R k h z) = R k (\a r -> if p a then h a r else r) z
-  interspersing a (R k h z) = R (maybe' (k z) k) h' Nothing' where
-    h' b Nothing'  = Just' (h b z)
-    h' b (Just' x) = Just' (h b (h a x))
   {-# INLINE run #-}
-  {-# INLINE run1 #-}
   {-# INLINE runOf #-}
   {-# INLINE prefix #-}
-  {-# INLINE prefix1 #-}
   {-# INLINE prefixOf #-}
   {-# INLINE postfix #-}
-  {-# INLINE postfix1 #-}
   {-# INLINE postfixOf #-}
   {-# INLINE filtering #-}
-  {-# INLINE interspersing #-}
 
 instance Profunctor R where
   dimap f g (R k h z) = R (g.k) (h.f) z
@@ -102,6 +104,9 @@
 
   m >>= f = R (\xs a -> run xs (f a)) (:) [] <*> m
   {-# INLINE (>>=) #-}
+
+  _ >> n = n
+  {-# INLINE (>>) #-}
 
 instance Applicative (R a) where
   pure b = R (\() -> b) (\_ () -> ()) ()
diff --git a/src/Data/Fold/R1.hs b/src/Data/Fold/R1.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Fold/R1.hs
@@ -0,0 +1,150 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE ExistentialQuantification #-}
+module Data.Fold.R1
+  ( R1(..)
+  ) where
+
+import Control.Applicative
+import Control.Arrow
+import Control.Category
+import Control.Lens
+import Data.Fold.Class
+import Data.Fold.Internal
+import Data.Functor.Apply
+import Data.Pointed
+import Data.Profunctor
+import Data.Profunctor.Unsafe
+import Data.Semigroupoid
+import Prelude hiding (id,(.))
+import Unsafe.Coerce
+
+-- | A reversed Mealy machine
+data R1 a b = forall c. R1 (c -> b) (a -> c -> c) (a -> c)
+
+instance Scan R1 where
+  run1 a (R1 k _ z) = k (z a)
+  prefix1 a (R1 k h z) = R1 (\c -> k (h a c)) h z
+  postfix1 (R1 k h z) a = R1 k h (\c -> h c (z a))
+  interspersing a (R1 k h z) = R1 k (\b x -> h b (h a x)) z
+  {-# INLINE run1 #-}
+  {-# INLINE prefix1 #-}
+  {-# INLINE postfix1 #-}
+  {-# INLINE interspersing #-}
+
+instance Functor (R1 a) where
+  fmap f (R1 k h z) = R1 (f.k) h z
+  {-# INLINE fmap #-}
+  b <$ _ = pure b
+  {-# INLINE (<$) #-}
+
+instance Pointed (R1 a) where
+  point x = R1 (\() -> x) (\_ () -> ()) (\_ -> ())
+  {-# INLINE point #-}
+
+instance Apply (R1 a) where
+  (<.>) = (<*>)
+  {-# INLINE (<.>) #-}
+  (<.) m = \_ -> m
+  {-# INLINE (<.) #-}
+  _ .> m = m
+  {-# INLINE (.>) #-}
+
+instance Applicative (R1 a) where
+  pure x = R1 (\() -> x) (\_ () -> ()) (\_ -> ())
+  {-# INLINE pure #-}
+  R1 kf hf zf <*> R1 ka ha za = R1
+    (\(Pair' x y) -> kf x (ka y))
+    (\a (Pair' x y) -> Pair' (hf a x) (ha a y))
+    (\a -> Pair' (zf a) (za a))
+  (<*) m = \ _ -> m
+  {-# INLINE (<*) #-}
+  _ *> m = m
+  {-# INLINE (*>) #-}
+
+instance Monad (R1 a) where
+  return x = R1 (\() -> x) (\_ () -> ()) (\_ -> ())
+  {-# INLINE return #-}
+  m >>= f = R1 (\xs a -> walk xs (f a)) Cons1 Last <*> m where
+  {-# INLINE (>>=) #-}
+  _ >> n = n
+  {-# INLINE (>>) #-}
+
+instance Semigroupoid R1 where
+  o = (.)
+  {-# INLINE o #-}
+
+instance Category R1 where
+  id = arr id
+  {-# INLINE id #-}
+  R1 k h z . R1 k' h' z' = R1 (\(Pair' b _) -> k b) h'' z'' where
+    z'' a = Pair' (z (k' b)) b where b = z' a
+    h'' a (Pair' c d) = Pair' (h (k' d') c) d' where d' = h' a d
+  {-# INLINE (.) #-}
+
+instance Arrow R1 where
+  arr h = R1 h const id
+  {-# INLINE arr #-}
+  first (R1 k h z) = R1 (first k) h' (first z) where
+    h' (a,b) (c,_) = (h a c, b)
+  {-# INLINE first #-}
+  second (R1 k h z) = R1 (second k) h' (second z) where
+    h' (a,b) (_,c) = (a, h b c)
+  {-# INLINE second #-}
+  R1 k h z *** R1 k' h' z' = R1 (k *** k') h'' (z *** z') where 
+    h'' (a,b) (c,d) = (h a c, h' b d)
+  {-# INLINE (***) #-}
+  R1 k h z &&& R1 k' h' z' = R1 (k *** k') h'' (z &&& z') where
+    h'' a (c,d) = (h a c, h' a d)
+  {-# INLINE (&&&) #-}
+
+instance Profunctor R1 where
+  dimap f g (R1 k h z) = R1 (g.k) (h.f) (z.f)
+  {-# INLINE dimap #-}
+  lmap f (R1 k h z) = R1 (k) (h.f) (z.f)
+  {-# INLINE lmap #-}
+  rmap g (R1 k h z) = R1 (g.k) h z
+  {-# INLINE rmap #-}
+  ( #. ) _ = unsafeCoerce
+  {-# INLINE (#.) #-}
+  x .# _ = unsafeCoerce x
+  {-# INLINE (.#) #-}
+
+instance Strong R1 where
+  first' = first
+  {-# INLINE first' #-}
+  second' = second
+  {-# INLINE second' #-}
+
+instance Choice R1 where
+  left' (R1 k h z) = R1 (_Left %~ k) step (_Left %~ z) where
+    step (Left x) (Left y) = Left (h x y)
+    step (Right c) _ = Right c
+    step _ (Right c) = Right c
+  {-# INLINE left' #-}
+
+  right' (R1 k h z) = R1 (_Right %~ k) step (_Right %~ z) where
+    step (Right x) (Right y) = Right (h x y)
+    step (Left c) _ = Left c
+    step _ (Left c) = Left c
+  {-# INLINE right' #-}
+
+instance ArrowChoice R1 where
+  left (R1 k h z) = R1 (_Left %~ k) step (_Left %~ z) where
+    step (Left x) (Left y) = Left (h x y)
+    step (Right c) _ = Right c
+    step _ (Right c) = Right c
+  {-# INLINE left #-}
+
+  right (R1 k h z) = R1 (_Right %~ k) step (_Right %~ z) where
+    step (Right x) (Right y) = Right (h x y)
+    step (Left c) _ = Left c
+    step _ (Left c) = Left c
+  {-# INLINE right #-}
+
+data List1 a = Cons1 a (List1 a) | Last a
+
+walk :: List1 a -> R1 a b -> b
+walk xs0 (R1 k h z) = k (go xs0) where
+  go (Last a) = z a
+  go (Cons1 a as) = h a (go as)
+{-# INLINE walk #-}