diff --git a/.travis.yml b/.travis.yml
--- a/.travis.yml
+++ b/.travis.yml
@@ -1,4 +1,98 @@
-language: haskell
+language: c
+sudo: false
+
+cache:
+  directories:
+    - $HOME/.cabsnap
+    - $HOME/.cabal/packages
+
+before_cache:
+  - rm -fv $HOME/.cabal/packages/hackage.haskell.org/build-reports.log
+  - rm -fv $HOME/.cabal/packages/hackage.haskell.org/00-index.tar
+
+matrix:
+  include:
+    - env: CABALVER=1.24 GHCVER=7.4.2
+      compiler: ": #GHC 7.4.2"
+      addons: {apt: {packages: [cabal-install-1.24,ghc-7.4.2,alex-3.1.4,happy-1.19.5], sources: [hvr-ghc]}}
+    - env: CABALVER=1.24 GHCVER=7.6.3
+      compiler: ": #GHC 7.6.3"
+      addons: {apt: {packages: [cabal-install-1.24,ghc-7.6.3,alex-3.1.4,happy-1.19.5], sources: [hvr-ghc]}}
+    - env: CABALVER=1.18 GHCVER=7.8.4
+      compiler: ": #GHC 7.8.4"
+      addons: {apt: {packages: [cabal-install-1.18,ghc-7.8.4,alex-3.1.4,happy-1.19.5], sources: [hvr-ghc]}}
+    - env: CABALVER=1.22 GHCVER=7.10.3
+      compiler: ": #GHC 7.10.3"
+      addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.3,alex-3.1.4,happy-1.19.5], sources: [hvr-ghc]}}
+    - env: CABALVER=1.24 GHCVER=8.0.1
+      compiler: ": #GHC 8.0.1"
+      addons: {apt: {packages: [cabal-install-1.24,ghc-8.0.1,alex-3.1.4,happy-1.19.5], sources: [hvr-ghc]}}
+    - env: CABALVER=1.24 GHCVER=head
+      compiler: ": #GHC head"
+      addons: {apt: {packages: [cabal-install-1.24,ghc-head,alex-3.1.4,happy-1.19.5], sources: [hvr-ghc]}}
+
+  allow_failures:
+    - env: CABALVER=1.24 GHCVER=head
+
+before_install:
+ - unset CC
+ - export HAPPYVER=1.19.5
+ - export ALEXVER=3.1.4
+ - export PATH=~/.cabal/bin:/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:/opt/happy/$HAPPYVER/bin:/opt/alex/$ALEXVER/bin:$PATH
+
+install:
+ - cabal --version
+ - echo "$(ghc --version) [$(ghc --print-project-git-commit-id 2> /dev/null || echo '?')]"
+ - if [ -f $HOME/.cabal/packages/hackage.haskell.org/00-index.tar.gz ];
+   then
+     zcat $HOME/.cabal/packages/hackage.haskell.org/00-index.tar.gz >
+          $HOME/.cabal/packages/hackage.haskell.org/00-index.tar;
+   fi
+ - travis_retry cabal update
+ - "sed -i  's/^jobs:.*$/jobs: 2/' $HOME/.cabal/config"
+ - cabal install --only-dependencies --enable-tests --enable-benchmarks --dry -v > installplan.txt
+ - sed -i -e '1,/^Resolving /d' installplan.txt; cat installplan.txt
+
+# check whether current requested install-plan matches cached package-db snapshot
+ - if diff -u installplan.txt $HOME/.cabsnap/installplan.txt;
+   then
+     echo "cabal build-cache HIT";
+     rm -rfv .ghc;
+     cp -a $HOME/.cabsnap/ghc $HOME/.ghc;
+     cp -a $HOME/.cabsnap/lib $HOME/.cabsnap/share $HOME/.cabsnap/bin $HOME/.cabal/;
+   else
+     echo "cabal build-cache MISS";
+     rm -rf $HOME/.cabsnap;
+     mkdir -p $HOME/.ghc $HOME/.cabal/lib $HOME/.cabal/share $HOME/.cabal/bin;
+     cabal install --only-dependencies --enable-tests --enable-benchmarks;
+     if [ "$GHCVER" = "7.10.3" ]; then cabal install Cabal-1.22.4.0; fi;
+   fi
+
+# snapshot package-db on cache miss
+ - if [ ! -d $HOME/.cabsnap ];
+   then
+      echo "snapshotting package-db to build-cache";
+      mkdir $HOME/.cabsnap;
+      cp -a $HOME/.ghc $HOME/.cabsnap/ghc;
+      cp -a $HOME/.cabal/lib $HOME/.cabal/share $HOME/.cabal/bin installplan.txt $HOME/.cabsnap/;
+   fi
+
+# Here starts the actual work to be performed for the package under test;
+# any command which exits with a non-zero exit code causes the build to fail.
+script:
+ - cabal configure --enable-tests -v2  # -v2 provides useful information for debugging
+ - cabal build   # this builds all libraries and executables (including tests)
+ - cabal test
+ - cabal bench || true  # expected result: these will crash
+ - cabal sdist || true  # tests that a source-distribution can be generated
+
+# Check that the resulting source distribution can be built & installed.
+# If there are no other `.tar.gz` files in `dist`, this can be even simpler:
+# `cabal install --force-reinstalls dist/*-*.tar.gz`
+ - SRC_TGZ=$(cabal info . | awk '{print $2;exit}').tar.gz &&
+   (cd dist && cabal install --force-reinstalls "$SRC_TGZ")
+
+
 notifications:
   irc:
     channels:
diff --git a/CHANGELOG.markdown b/CHANGELOG.markdown
--- a/CHANGELOG.markdown
+++ b/CHANGELOG.markdown
@@ -1,3 +1,10 @@
+4.3
+---
+* Compatibility with GHC 8.0.x
+* Dropped incomplete instance for `Algebra r (Map a b)` instance
+* Restructured Ring hierarchy (Thanks @dfoxfranke!)
+* Added DecidableNilpotence class (Thanks @dfoxfranke!)
+
 4.2
 ---
 * Support for `nats` version 1 and `base` 4.8's version of `Numeric.Natural`. This required monomorphizing some stuff to `Natural`, but that is more accurate than the previous hack anyways.
diff --git a/README.markdown b/README.markdown
--- a/README.markdown
+++ b/README.markdown
@@ -1,7 +1,7 @@
 algebra
 ==========
 
-[![Build Status](https://secure.travis-ci.org/ekmett/algebra.png?branch=master)](http://travis-ci.org/ekmett/algebra)
+[![Hackage](https://img.shields.io/hackage/v/algebra.svg)](https://hackage.haskell.org/package/algebra) [![Build Status](https://secure.travis-ci.org/ekmett/algebra.png?branch=master)](http://travis-ci.org/ekmett/algebra)
 
 This is a package for exploring constructive abstract algebra in Haskell.
 
diff --git a/algebra.cabal b/algebra.cabal
--- a/algebra.cabal
+++ b/algebra.cabal
@@ -1,6 +1,6 @@
 name:          algebra
 category:      Math, Algebra
-version:       4.2
+version:       4.3
 license:       BSD3
 cabal-version: >= 1.6
 license-file:  LICENSE
@@ -13,6 +13,8 @@
 synopsis:      Constructive abstract algebra
 description:   Constructive abstract algebra
 build-type:    Simple
+tested-with:   GHC == 7.4.2, GHC == 7.6.3, GHC == 7.8.4,
+               GHC == 7.10.3, GHC == 8.0.1
 extra-source-files:
   .ghci
   .gitignore
@@ -51,8 +53,8 @@
     mtl                     >= 2.0.1   && < 2.3,
     nats                    >= 0.1     && < 2,
     semigroups              >= 0.9     && < 1,
-    semigroupoids           >= 4       && < 5,
-    transformers            >= 0.2     && < 0.5,
+    semigroupoids           >= 4       && < 6,
+    transformers            >= 0.2     && < 0.6,
     tagged                  >= 0.4.2   && < 1,
     void                    >= 0.5.5.1 && < 1
 
@@ -77,6 +79,7 @@
     Numeric.Algebra.Quaternion
     Numeric.Algebra.Quaternion.Class
     Numeric.Algebra.Unital
+    Numeric.Algebra.Unital.UnitNormalForm
     Numeric.Band.Class
     Numeric.Band.Rectangular
     Numeric.Coalgebra.Categorical
@@ -90,11 +93,16 @@
     Numeric.Coalgebra.Trigonometric.Class
     Numeric.Covector
     Numeric.Decidable.Associates
+    Numeric.Decidable.Nilpotent
     Numeric.Decidable.Units
     Numeric.Decidable.Zero
     Numeric.Dioid.Class
     Numeric.Domain.Class
+    Numeric.Domain.GCD
     Numeric.Domain.Euclidean
+    Numeric.Domain.Integral
+    Numeric.Domain.PID
+    Numeric.Domain.UFD
     Numeric.Exp
     Numeric.Field.Class
     Numeric.Field.Fraction
@@ -120,7 +128,11 @@
     Numeric.Ring.Rng
     Numeric.Rng.Class
     Numeric.Rng.Zero
-    Numeric.Semiring.Integral
+    Numeric.Semiring.ZeroProduct
     Numeric.Semiring.Involutive
 
-  ghc-options: -Wall
+  other-modules: Numeric.Domain.Internal
+
+  ghc-options: -Wall -fno-warn-unused-imports
+  if impl(ghc >= 8.0.1)
+     ghc-options: -Wno-redundant-constraints
diff --git a/src/Numeric/Algebra/Class.hs b/src/Numeric/Algebra/Class.hs
--- a/src/Numeric/Algebra/Class.hs
+++ b/src/Numeric/Algebra/Class.hs
@@ -215,11 +215,11 @@
        Nothing -> f ls s
        Just (r, rs) -> f ls s + go (IntSet.insert r ls) rs
 
-instance (Semiring r, Monoidal r, Ord a, Partitionable b) => Algebra r (Map a b) -- where
+-- instance (Semiring r, Monoidal r, Ord a, Partitionable b) => Algebra r (Map a b) -- where
 --  mult f xs = case minViewWithKey xs of
 --    Nothing -> zero 
 --    Just ((k, r), rs) -> ...
-instance (Semiring r, Monoidal r, Partitionable a) => Algebra r (IntMap a)
+-- instance (Semiring r, Monoidal r, Partitionable a) => Algebra r (IntMap a)
 
 instance (Algebra r a, Algebra r b) => Algebra r (a,b) where
   mult f (a,b) = mult (\a1 a2 -> mult (\b1 b2 -> f (a1,b1) (a2,b2)) b) a
diff --git a/src/Numeric/Algebra/Commutative.hs b/src/Numeric/Algebra/Commutative.hs
--- a/src/Numeric/Algebra/Commutative.hs
+++ b/src/Numeric/Algebra/Commutative.hs
@@ -99,20 +99,20 @@
          , Semiring r
          ) => CommutativeAlgebra r IntSet
 
-instance (Commutative r
-         , Monoidal r
-         , Semiring r
-         , Ord a
-         , Abelian b
-         , Partitionable b
-         ) => CommutativeAlgebra r (Map a b)
+-- instance (Commutative r
+--          , Monoidal r
+--          , Semiring r
+--          , Ord a
+--          , Abelian b
+--          , Partitionable b
+--          ) => CommutativeAlgebra r (Map a b)
 
-instance ( Commutative r
-         , Monoidal r
-         , Semiring r
-         , Abelian b
-         , Partitionable b
-         ) => CommutativeAlgebra r (IntMap b)
+-- instance ( Commutative r
+--          , Monoidal r
+--          , Semiring r
+--          , Abelian b
+--          , Partitionable b
+--          ) => CommutativeAlgebra r (IntMap b)
 
 
 
diff --git a/src/Numeric/Algebra/Unital/UnitNormalForm.hs b/src/Numeric/Algebra/Unital/UnitNormalForm.hs
new file mode 100644
--- /dev/null
+++ b/src/Numeric/Algebra/Unital/UnitNormalForm.hs
@@ -0,0 +1,36 @@
+{-# LANGUAGE DefaultSignatures #-}
+module Numeric.Algebra.Unital.UnitNormalForm 
+    (UnitNormalForm(..), normalize, leadingUnit) where
+
+import Numeric.Algebra.Class
+import Numeric.Algebra.Division
+import Numeric.Algebra.Unital
+import Numeric.Decidable.Units
+import Numeric.Decidable.Associates
+import Numeric.Decidable.Zero
+import Numeric.Semiring.ZeroProduct
+import Prelude(Integer,signum,abs,fst,snd,(.), otherwise)
+
+class (DecidableUnits r, DecidableAssociates r) => UnitNormalForm r where
+    -- prop> let (u,n) = splitUnit r
+    --           (u',n') = splitUnit r' in
+    --           isUnit u && isUnit u' &&
+    --           u*n = r && u'*n' = r' &&
+    --           (isAssociate r r' ==> n = n') &&
+    --           splitUnit (r * r') = (u * u', n * n')
+    splitUnit :: r -> (r,r)
+    default splitUnit :: (Division r, ZeroProductSemiring r, DecidableZero r) => r -> (r,r)
+    splitUnit x | isZero x = (one,zero)
+                | otherwise = (x,one)
+
+instance UnitNormalForm Integer where
+  splitUnit 0 = (1, 0)
+  splitUnit n = (signum n, abs n)
+  {-# INLINE splitUnit #-}
+
+normalize :: UnitNormalForm r => r -> r
+normalize = snd . splitUnit
+
+leadingUnit :: UnitNormalForm r => r -> r
+leadingUnit = fst . splitUnit
+
diff --git a/src/Numeric/Decidable/Nilpotent.hs b/src/Numeric/Decidable/Nilpotent.hs
new file mode 100644
--- /dev/null
+++ b/src/Numeric/Decidable/Nilpotent.hs
@@ -0,0 +1,64 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+
+module Numeric.Decidable.Nilpotent (DecidableNilpotent(..)) where
+
+import Data.Bits(Bits(..))
+import Data.Int(Int8,Int16,Int32,Int64)
+import Data.Word(Word8,Word16,Word32,Word64)
+import Numeric.Algebra
+import Numeric.Decidable.Zero
+import Prelude hiding (Num(..), Ord(..))
+
+-- | An element @x@ is nilpotent if there exists @n@ s.t. @pow1p x n@ is zero.
+class (Monoidal r, Multiplicative r) => DecidableNilpotent r where
+    isNilpotent :: r -> Bool
+
+instance DecidableNilpotent () where
+    isNilpotent _ = True
+
+instance DecidableNilpotent Bool where
+    isNilpotent = isZero
+instance DecidableNilpotent Natural where
+    isNilpotent = isZero
+instance DecidableNilpotent Integer where
+    isNilpotent = isZero
+
+instance DecidableNilpotent Int where
+    isNilpotent = signedBitsNilpotent
+instance DecidableNilpotent Int8 where
+    isNilpotent = signedBitsNilpotent
+instance DecidableNilpotent Int16 where
+    isNilpotent = signedBitsNilpotent
+instance DecidableNilpotent Int32 where
+    isNilpotent = signedBitsNilpotent
+instance DecidableNilpotent Int64 where
+    isNilpotent = signedBitsNilpotent
+instance DecidableNilpotent Word8 where
+    isNilpotent = unsignedBitsNilpotent
+instance DecidableNilpotent Word16 where
+    isNilpotent = unsignedBitsNilpotent
+instance DecidableNilpotent Word32 where
+    isNilpotent = unsignedBitsNilpotent
+instance DecidableNilpotent Word64 where
+    isNilpotent = unsignedBitsNilpotent
+
+instance (DecidableNilpotent a, DecidableNilpotent b) => DecidableNilpotent (a,b) where
+    isNilpotent (a,b) = isNilpotent a && isNilpotent b
+
+instance (DecidableNilpotent a, DecidableNilpotent b, DecidableNilpotent c) => DecidableNilpotent (a,b,c) where
+    isNilpotent (a,b,c) = isNilpotent a && isNilpotent b && isNilpotent c
+
+instance (DecidableNilpotent a, DecidableNilpotent b, DecidableNilpotent c, DecidableNilpotent d) => DecidableNilpotent (a,b,c,d) where
+    isNilpotent (a,b,c,d) = isNilpotent a && isNilpotent b && isNilpotent c && isNilpotent d
+
+instance (DecidableNilpotent a, DecidableNilpotent b, DecidableNilpotent c, DecidableNilpotent d, DecidableNilpotent e) => DecidableNilpotent (a,b,c,d,e) where
+    isNilpotent (a,b,c,d,e) = isNilpotent a && isNilpotent b && isNilpotent c && isNilpotent d && isNilpotent e
+
+unsignedBitsNilpotent :: (Bits r, Group r, Unital r) => r -> Bool
+unsignedBitsNilpotent b = (b /= one) && b .&. (b - one) == zero
+
+signedBitsNilpotent :: (Bits r, Group r, Order r, Bounded r, Unital r) => r -> Bool
+signedBitsNilpotent b | zero <~ b = unsignedBitsNilpotent b
+                      | otherwise = b == minBound ||
+                                    unsignedBitsNilpotent (negate b)
+
diff --git a/src/Numeric/Decidable/Units.hs b/src/Numeric/Decidable/Units.hs
--- a/src/Numeric/Decidable/Units.hs
+++ b/src/Numeric/Decidable/Units.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE ConstrainedClassMethods #-}
 module Numeric.Decidable.Units 
   ( DecidableUnits(..)
   , recipUnitIntegral
@@ -16,7 +17,7 @@
 class Unital r => DecidableUnits r where
   recipUnit :: r -> Maybe r
 
-  isUnit :: DecidableUnits r => r -> Bool
+  isUnit :: r -> Bool
   isUnit = isJust . recipUnit
 
   (^?) :: Integral n => r -> n -> Maybe r
diff --git a/src/Numeric/Domain/Class.hs b/src/Numeric/Domain/Class.hs
--- a/src/Numeric/Domain/Class.hs
+++ b/src/Numeric/Domain/Class.hs
@@ -1,8 +1,4 @@
 {-# LANGUAGE FlexibleInstances, UndecidableInstances #-}
-module Numeric.Domain.Class where
-import Numeric.Ring.Class
-import Numeric.Semiring.Integral
+module Numeric.Domain.Class (Domain) where
 
--- | (Integral) domain is the integral semiring.
-class (IntegralSemiring d, Ring d) => Domain d
-instance (IntegralSemiring d, Ring d) => Domain d
+import Numeric.Domain.Internal(Domain)
diff --git a/src/Numeric/Domain/Euclidean.hs b/src/Numeric/Domain/Euclidean.hs
--- a/src/Numeric/Domain/Euclidean.hs
+++ b/src/Numeric/Domain/Euclidean.hs
@@ -1,77 +1,14 @@
-{-# LANGUAGE CPP, ConstraintKinds, FlexibleContexts, FlexibleInstances     #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving, MultiParamTypeClasses, RankNTypes #-}
-{-# LANGUAGE RebindableSyntax, UndecidableInstances                        #-}
-module Numeric.Domain.Euclidean (Euclidean(..), prs, normalize, gcd', leadingUnit, chineseRemainder) where
+module Numeric.Domain.Euclidean (Euclidean(..), euclid, prs, chineseRemainder) where
 import Numeric.Additive.Group
 import Numeric.Algebra.Class
 import Numeric.Algebra.Unital
-import Numeric.Decidable.Units
 import Numeric.Decidable.Zero
-import Numeric.Domain.Class
-import Numeric.Natural (Natural)
-import Numeric.Ring.Class
-import Prelude (Eq (..), Integer, Maybe (..), abs)
-import Prelude (fst, otherwise)
-import Prelude (signum, snd, ($), (.))
+import Numeric.Domain.Internal
+import Prelude (otherwise)
 import qualified Prelude                 as P
 
-infixl 7 `quot`, `rem`
-infix  7 `divide`
-class (Ring r, DecidableZero r, DecidableUnits r, Domain r) => Euclidean r where
-  -- | @splitUnit r@ calculates its leading unit and normal form.
-  --
-  -- prop> let (u, n) = splitUnit r in r == u * n && fst (splitUnit n) == one && isUnit u
-  splitUnit :: r -> (r, r)
-  -- | Euclidean (degree) function on @r@.
-  degree :: r -> Maybe Natural
-  -- | Division algorithm. @a `divide` b@ calculates
-  --   quotient and reminder of @a@ divided by @b@.
-  --
-  -- prop> let (q, r) = divide a p in p*q + r == a && degree r < degree q
-  divide :: r                   -- ^ elements divided by
-         -> r                   -- ^ divisor
-         -> (r,r)               -- ^ quotient and remin
-  quot :: r -> r -> r
-  quot a b = fst $ a `divide` b
-  {-# INLINE quot #-}
-
-  rem :: r -> r -> r
-  rem a b = snd $ a `divide` b
-  {-# INLINE rem #-}
-
-  -- | @'gcd' a b@ calculates greatest common divisor of @a@ and @b@.
-  gcd :: r -> r -> r
-  gcd a b = let (g,_,_):_ = euclid a b
-            in g
-  {-# INLINE gcd #-}
-
-  -- | Extended euclidean algorithm.
-  --
-  -- prop> euclid f g == xs ==> all (\(r, s, t) -> r == f * s + g * t) xs
-  euclid :: r -> r -> [(r,r,r)]
-  euclid f g =
-    let (ug, g') = splitUnit g
-        Just t'  = recipUnit ug
-        (uf, f') = splitUnit f
-        Just s   = recipUnit uf
-    in step [(g', 0, t'), (f', s, 0)]
-    where
-      step acc@((r',s',t'):(r,s,t):_)
-        | isZero r' = P.tail acc
-        | otherwise =
-          let q         = r `quot` r'
-              (ur, r'') = splitUnit $ r - q * r'
-              Just u    = recipUnit ur
-              s''       = (s - q * s') * u
-              t''       = (t - q * t') * u
-          in step ((r'', s'', t'') : acc)
-      step _ = P.error "cannot happen!"
-#if (__GLASGOW_HASKELL__ > 708)
-  {-# MINIMAL splitUnit, degree, divide #-}
-#endif
-
 prs :: Euclidean r => r -> r -> [(r, r, r)]
-prs f g = step [(g, 0, 1), (f, 1, 0)]
+prs f g = step [(g, zero, one), (f, one, zero)]
   where
     step acc@((r',s',t'):(r,s,t):_)
       | isZero r' = P.tail acc
@@ -81,29 +18,6 @@
             t''       = (t - q * t')
         in step ((r - q * r', s'', t'') : acc)
     step _ = P.error "cannot happen!"
-
-gcd' :: Euclidean r => [r] -> r
-gcd' []     = one
-gcd' [x]    = leadingUnit x
-gcd' [x,y]  = gcd x y
-gcd' (x:xs) = gcd x (gcd' xs)
-
-normalize :: Euclidean r => r -> r
-normalize = snd . splitUnit
-
-leadingUnit :: Euclidean r => r -> r
-leadingUnit = fst . splitUnit
-
-instance Euclidean Integer where
-  splitUnit 0 = (1, 0)
-  splitUnit n = (signum n, abs n)
-  {-# INLINE splitUnit #-}
-
-  degree = Just . P.fromInteger . abs
-  {-# INLINE degree #-}
-
-  divide = P.divMod
-  {-# INLINE divide #-}
 
 chineseRemainder :: Euclidean r
                  => [(r, r)] -- ^ List of @(m_i, v_i)@
diff --git a/src/Numeric/Domain/GCD.hs b/src/Numeric/Domain/GCD.hs
new file mode 100644
--- /dev/null
+++ b/src/Numeric/Domain/GCD.hs
@@ -0,0 +1,11 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+module Numeric.Domain.GCD (GCDDomain(..), gcd') where
+
+import Data.List.NonEmpty
+import Numeric.Domain.Internal(GCDDomain(..))
+import Numeric.Algebra.Unital.UnitNormalForm
+
+gcd' :: GCDDomain r => NonEmpty r -> r
+gcd' (x :| [])    = normalize x
+gcd' (x :| [y])  = gcd x y
+gcd' (x :| y:ys) = gcd x (gcd' (y:|ys))
diff --git a/src/Numeric/Domain/Integral.hs b/src/Numeric/Domain/Integral.hs
new file mode 100644
--- /dev/null
+++ b/src/Numeric/Domain/Integral.hs
@@ -0,0 +1,3 @@
+{-# LANGUAGE FlexibleInstances, UndecidableInstances #-}
+module Numeric.Domain.Integral (IntegralDomain(..)) where
+import Numeric.Domain.Internal(IntegralDomain(..))
diff --git a/src/Numeric/Domain/Internal.hs b/src/Numeric/Domain/Internal.hs
new file mode 100644
--- /dev/null
+++ b/src/Numeric/Domain/Internal.hs
@@ -0,0 +1,124 @@
+{-# LANGUAGE NoImplicitPrelude, FlexibleInstances, UndecidableInstances, DefaultSignatures #-}
+module Numeric.Domain.Internal where
+
+import Data.Maybe(fromJust)
+import Numeric.Additive.Group
+import Numeric.Algebra.Class
+import Numeric.Algebra.Commutative
+import Numeric.Algebra.Division
+import Numeric.Natural (Natural)
+import Numeric.Semiring.ZeroProduct
+import Numeric.Algebra.Unital.UnitNormalForm
+import Numeric.Ring.Class
+import Numeric.Decidable.Zero
+import Numeric.Decidable.Units
+
+import Prelude (Integer, Maybe (..), Bool(..),
+                otherwise, fst, snd, ($), (.))
+import qualified Prelude                 as P
+
+infixl 7 `quot`, `rem`
+infix  7 `divide`, `divides`, `maybeQuot`
+
+-- | (Integral) domain is the integral semiring.
+class (ZeroProductSemiring d, Ring d) => Domain d
+instance (ZeroProductSemiring d, Ring d) => Domain d
+
+-- | An integral domain is a commutative domain in which 1≠0.
+class (Domain d, Commutative d) => IntegralDomain d where
+    divides :: d -> d -> Bool
+    default divides :: (Euclidean d) => d -> d -> Bool
+    m `divides` n 
+        | isZero m = False
+        | otherwise = isZero (n `rem` m)
+    maybeQuot :: d -> d -> Maybe d
+    default maybeQuot :: (Euclidean d) => d -> d -> Maybe d
+    m `maybeQuot` n
+        | isZero n = Nothing
+        | otherwise = let (q,r) = m `divide` n in
+                      if isZero r then Just q else Nothing
+
+instance IntegralDomain Integer
+
+class (IntegralDomain d, UnitNormalForm d, DecidableZero d) => GCDDomain d where
+    gcd :: d -> d -> d
+    default gcd :: (PID d) => d -> d -> d
+    gcd a b = let (r,_,_) = egcd a b in r
+    {-# INLINE gcd #-}
+
+    reduceFraction :: d -> d -> (d,d)
+    reduceFraction a b =
+        let c = gcd a b in
+        (fromJust (a `maybeQuot` c), fromJust (b `maybeQuot` c))
+
+    lcm :: d -> d -> d
+    lcm p q = fromJust $ (p * q) `maybeQuot` (gcd p q)
+
+instance GCDDomain Integer
+
+class (GCDDomain d) => UFD d
+
+instance UFD Integer
+
+class (UFD d) => PID d where
+    egcd :: d -> d -> (d,d,d)
+    default egcd :: (Euclidean d) => d -> d -> (d,d,d)
+    egcd a b = P.head (euclid a b)
+    {-# INLINE egcd #-}
+
+instance PID Integer
+
+class (PID d) => Euclidean d where
+  -- | Euclidean (degree) function on @r@.
+  degree :: d -> Maybe Natural
+  default degree :: (Division d) => d -> Maybe Natural
+  degree a | isZero a = Nothing
+           | otherwise = Just zero
+  -- | Division algorithm. @a `divide` b@ calculates
+  --   quotient and remainder of @a@ divided by @b@.
+  --
+  -- prop> let (q, r) = divide a p in p*q + r == a && degree r < degree q
+  divide :: d                   -- ^ elements divided by
+         -> d                   -- ^ divisor
+         -> (d,d)               -- ^ quotient and remainder
+  default divide :: (Division d) => d -> d -> (d,d)
+  -- Be strict in order to make sure division by zero gets caught
+  divide a b = let q = a/b in (q,P.seq q zero)
+
+  quot :: d -> d -> d
+  quot a b = fst $ a `divide` b
+  {-# INLINE quot #-}
+
+  rem :: d -> d -> d
+  rem a b = snd $ a `divide` b
+  {-# INLINE rem #-}
+
+instance Euclidean Integer where
+  degree = Just . P.fromInteger . P.abs
+  {-# INLINE degree #-}
+
+  divide = P.divMod
+  {-# INLINE divide #-}
+
+
+-- | Extended euclidean algorithm.
+--
+-- prop> euclid f g == xs ==> all (\(r, s, t) -> r == f * s + g * t) xs
+euclid :: (Euclidean d) =>  d -> d -> [(d,d,d)]
+euclid f g =
+  let (ug, g') = splitUnit g
+      Just t'  = recipUnit ug
+      (uf, f') = splitUnit f
+      Just s   = recipUnit uf
+  in step [(g', zero, t'), (f', s, zero)]
+  where
+    step acc@((r',s',t'):(r,s,t):_)
+      | isZero r' = P.tail acc
+      | otherwise =
+        let q         = r `quot` r'
+            (ur, r'') = splitUnit $ r - q * r'
+            Just u    = recipUnit ur
+            s''       = (s - q * s') * u
+            t''       = (t - q * t') * u
+        in step ((r'', s'', t'') : acc)
+    step _ = P.error "cannot happen!"
diff --git a/src/Numeric/Domain/PID.hs b/src/Numeric/Domain/PID.hs
new file mode 100644
--- /dev/null
+++ b/src/Numeric/Domain/PID.hs
@@ -0,0 +1,3 @@
+module Numeric.Domain.PID (PID(..)) where
+
+import Numeric.Domain.Internal(PID(..))
diff --git a/src/Numeric/Domain/UFD.hs b/src/Numeric/Domain/UFD.hs
new file mode 100644
--- /dev/null
+++ b/src/Numeric/Domain/UFD.hs
@@ -0,0 +1,3 @@
+module Numeric.Domain.UFD (UFD) where
+
+import Numeric.Domain.Internal(UFD)
diff --git a/src/Numeric/Field/Class.hs b/src/Numeric/Field/Class.hs
--- a/src/Numeric/Field/Class.hs
+++ b/src/Numeric/Field/Class.hs
@@ -3,8 +3,8 @@
   ( Field
   ) where
 
-import Numeric.Ring.Division
-import Numeric.Algebra.Commutative
+import Numeric.Algebra.Division
+import Numeric.Domain.Euclidean
 
-class (Commutative r, DivisionRing r) => Field r
-instance (Commutative r, DivisionRing r) => Field r
+class (Euclidean d, Division d) => Field d
+instance (Euclidean d, Division d) => Field d
diff --git a/src/Numeric/Field/Fraction.hs b/src/Numeric/Field/Fraction.hs
--- a/src/Numeric/Field/Fraction.hs
+++ b/src/Numeric/Field/Fraction.hs
@@ -6,7 +6,6 @@
   , denominator
   , Ratio
   , (%)
-  , lcm
   ) where
 import Data.Proxy
 import Numeric.Additive.Class
@@ -15,17 +14,23 @@
 import Numeric.Algebra.Commutative
 import Numeric.Algebra.Division
 import Numeric.Algebra.Unital
+import Numeric.Algebra.Unital.UnitNormalForm
+import Numeric.Decidable.Associates
 import Numeric.Decidable.Units
 import Numeric.Decidable.Zero
 import Numeric.Domain.Euclidean
+import Numeric.Domain.GCD
+import Numeric.Domain.Integral
+import Numeric.Domain.PID
+import Numeric.Domain.UFD
 import Numeric.Natural
 import Numeric.Rig.Characteristic
 import Numeric.Rig.Class
 import Numeric.Ring.Class
-import Numeric.Semiring.Integral
+import Numeric.Semiring.ZeroProduct
 import Prelude                     hiding (Integral (..), Num (..), gcd, lcm)
 
--- | Fraction field @k(D)@ of 'Euclidean' domain @D@.
+-- | Fraction field @k(D)@ of 'GCDDomain' domain @D@.
 data Fraction d = Fraction !d !d
 
 -- Invariants: r == Fraction p q
@@ -35,21 +40,19 @@
 -- | Convenient synonym for 'Fraction'.
 type Ratio = Fraction
 
-lcm :: Euclidean r => r -> r -> r
-lcm p q = p * q `quot` gcd p q
-
 instance (Eq d, Show d, Unital d) => Show (Fraction d) where
   showsPrec d (Fraction p q)
    | q == one    = showsPrec d p
    | otherwise = showParen (d > 5) $ showsPrec 6 p . showString " / " . showsPrec 6 q
 
 infixl 7 %
-(%) :: Euclidean d => d -> d -> Fraction d
-a % b = let (ua, a') = splitUnit a
-            (ub, b') = splitUnit b
-            Just ub' = recipUnit ub
-            r = gcd a' b'
-        in Fraction (ua * ub' * a' `quot` r) (b' `quot` r)
+(%) :: (GCDDomain d) => d -> d -> Fraction d
+a % b | isZero b = error "Divide by zero"
+      | otherwise = let (ua, a') = splitUnit a
+                        (ub, b') = splitUnit b
+                        Just ub' = recipUnit ub
+                        (a'',b'') = reduceFraction a' b' in
+                    Fraction (ua * ub' * a'') (b'')
 
 numerator :: Fraction t -> t
 numerator (Fraction q _) = q
@@ -59,67 +62,82 @@
 denominator (Fraction _ p) = p
 {-# INLINE denominator #-}
 
-instance Euclidean d => IntegralSemiring (Fraction d)
-instance (Eq d, Multiplicative d) => Eq (Fraction d) where
+instance (GCDDomain d) => ZeroProductSemiring (Fraction d)
+instance (Eq d, GCDDomain d) => Eq (Fraction d) where
   Fraction p q == Fraction s t = p*t == q*s
   {-# INLINE (==) #-}
 
-instance (Ord d, Multiplicative d) => Ord (Fraction d)  where
+instance (Ord d, GCDDomain d) => Ord (Fraction d)  where
   compare (Fraction p q) (Fraction p' q') = compare (p*q') (p'*q)
   {-# INLINE compare #-}
 
-instance Euclidean d => Division (Fraction d) where
-  recip (Fraction p q) | isZero p  = error "Ratio has zero denominator!"
-                       | otherwise = let (recipUnit -> Just u, p') = splitUnit p
-                                     in Fraction (q * u) p'
+instance (GCDDomain d) => Division (Fraction d) where
+  recip (Fraction p q)
+      | isZero p = error "Divide by zero"
+      | otherwise = let (recipUnit -> Just u, p') = splitUnit p in
+                    Fraction (q * u) p'
   Fraction p q / Fraction s t = (p*t) % (q*s)
   {-# INLINE recip #-}
   {-# INLINE (/) #-}
 
-instance (Commutative d, Euclidean d) => Commutative (Fraction d)
+instance (GCDDomain d) => Commutative (Fraction d)
 
-instance Euclidean d => DecidableZero (Fraction d) where
+instance (GCDDomain d) => DecidableZero (Fraction d) where
   isZero (Fraction p _) = isZero p
   {-# INLINE isZero #-}
 
-instance Euclidean d => DecidableUnits (Fraction d) where
+instance (GCDDomain d) => DecidableUnits (Fraction d) where
   isUnit (Fraction p _) = not $ isZero p
   {-# INLINE isUnit #-}
   recipUnit (Fraction p q) | isZero p  = Nothing
                            | otherwise = Just (Fraction q p)
   {-# INLINE recipUnit #-}
-instance Euclidean d => Ring (Fraction d)
-instance Euclidean d => Abelian (Fraction d)
-instance Euclidean d => Semiring (Fraction d)
-instance Euclidean d => Group (Fraction d) where
+
+instance (GCDDomain d) => DecidableAssociates (Fraction d) where
+    isAssociate a b = not (isZero a || isZero b)
+
+instance (GCDDomain d) => Ring (Fraction d)
+instance (GCDDomain d) => Abelian (Fraction d)
+instance (GCDDomain d) => Semiring (Fraction d)
+instance (GCDDomain d) => Group (Fraction d) where
   negate (Fraction p q) = Fraction (negate p) q
   Fraction p q - Fraction p' q' = (p*q'-p'*q) % (q*q')
-instance Euclidean d => Monoidal (Fraction d) where
+instance (GCDDomain d) => Monoidal (Fraction d) where
   zero = Fraction zero one
   {-# INLINE zero #-}
-instance Euclidean d => LeftModule Integer (Fraction d) where
+instance (GCDDomain d) => LeftModule Integer (Fraction d) where
   n .* Fraction p r = (n .* p) % r
   {-# INLINE (.*) #-}
-instance Euclidean d => RightModule Integer (Fraction d) where
+instance (GCDDomain d) => RightModule Integer (Fraction d) where
   Fraction p r *. n = (p *. n) % r
   {-# INLINE (*.) #-}
-instance Euclidean d => LeftModule Natural (Fraction d) where
+instance (GCDDomain d) => LeftModule Natural (Fraction d) where
   n .* Fraction p r = (n .* p) % r
   {-# INLINE (.*) #-}
-instance Euclidean d => RightModule Natural (Fraction d) where
+instance (GCDDomain d) => RightModule Natural (Fraction d) where
   Fraction p r *. n = (p *. n) % r
   {-# INLINE (*.) #-}
-instance Euclidean d => Additive (Fraction d) where
+instance (GCDDomain d) => Additive (Fraction d) where
   Fraction p q + Fraction s t =
-    let u = gcd q t
-    in Fraction (p * t `quot` u + s*q`quot`u) (q*t`quot`u)
+    let n = p*t + s*q
+        d = q*t
+        (n',d') = reduceFraction n d
+    in Fraction n' d'
   {-# INLINE (+) #-}
-instance Euclidean d => Unital (Fraction d) where
+instance (GCDDomain d) => Unital (Fraction d) where
   one = Fraction one one
   {-# INLINE one #-}
-instance Euclidean d => Multiplicative (Fraction d) where
+instance (GCDDomain d) => Multiplicative (Fraction d) where
   Fraction p q * Fraction s t = (p*s) % (q*t)
-instance Euclidean d => Rig (Fraction d)
+instance (GCDDomain d) => Rig (Fraction d)
 
-instance (Characteristic d, Euclidean d) => Characteristic (Fraction d) where
+instance (Characteristic d, GCDDomain d) => Characteristic (Fraction d) where
   char _ = char (Proxy :: Proxy d)
+
+instance (GCDDomain d) => UnitNormalForm (Fraction d)
+instance (GCDDomain d) => IntegralDomain (Fraction d)
+instance (GCDDomain d) => GCDDomain (Fraction d)
+instance (GCDDomain d) => UFD (Fraction d)
+instance (GCDDomain d) => PID (Fraction d)
+instance (GCDDomain d) => Euclidean (Fraction d)
+
diff --git a/src/Numeric/Quadrance/Class.hs b/src/Numeric/Quadrance/Class.hs
--- a/src/Numeric/Quadrance/Class.hs
+++ b/src/Numeric/Quadrance/Class.hs
@@ -19,7 +19,7 @@
 instance Quadrance () a where 
   quadrance _ = ()
 
-instance Monoidal r => Quadrance r () where
+instance (Additive r, Monoidal r) => Quadrance r () where
   quadrance _ = zero
 
 instance (Quadrance r a, Quadrance r b) => Quadrance r (a,b) where
diff --git a/src/Numeric/Semiring/Integral.hs b/src/Numeric/Semiring/Integral.hs
deleted file mode 100644
--- a/src/Numeric/Semiring/Integral.hs
+++ /dev/null
@@ -1,15 +0,0 @@
-module Numeric.Semiring.Integral 
-  ( IntegralSemiring
-  ) where
-
-import Numeric.Algebra.Class
-import Numeric.Natural
-
--- | An integral semiring has no zero divisors
---
--- > a * b = 0 implies a == 0 || b == 0
-class (Monoidal r, Semiring r) => IntegralSemiring r
-
-instance IntegralSemiring Integer
-instance IntegralSemiring Natural
-instance IntegralSemiring Bool
diff --git a/src/Numeric/Semiring/ZeroProduct.hs b/src/Numeric/Semiring/ZeroProduct.hs
new file mode 100644
--- /dev/null
+++ b/src/Numeric/Semiring/ZeroProduct.hs
@@ -0,0 +1,15 @@
+module Numeric.Semiring.ZeroProduct
+  ( ZeroProductSemiring
+  ) where
+
+import Numeric.Algebra.Class
+import Numeric.Natural
+
+-- | A zero-product semiring has no zero divisors
+--
+-- > a * b = 0 implies a == 0 || b == 0
+class (Monoidal r, Semiring r) => ZeroProductSemiring r
+
+instance ZeroProductSemiring Integer
+instance ZeroProductSemiring Natural
+instance ZeroProductSemiring Bool
