diff --git a/changelog.md b/changelog.md
--- a/changelog.md
+++ b/changelog.md
@@ -1,3 +1,7 @@
+# 0.4.1.0
+
+* Fix divergence of `fromInfinite` and `fromListWithDef` on infinite inputs.
+
 # 0.4.0.0
 
 * Remove instances `Foldable` and `Traversable`, they are too dangerous to diverge.
diff --git a/chimera.cabal b/chimera.cabal
--- a/chimera.cabal
+++ b/chimera.cabal
@@ -1,6 +1,6 @@
 cabal-version:      2.2
 name:               chimera
-version:            0.4.0.0
+version:            0.4.1.0
 license:            BSD-3-Clause
 license-file:       LICENSE
 copyright:          2017-2019 Bodigrim
@@ -95,6 +95,7 @@
     build-depends:
         base >=4.5 && <5,
         chimera,
+        infinite-list,
         QuickCheck >=2.10 && <2.15,
         tasty <1.6,
         tasty-hunit <0.11,
diff --git a/src/Data/Chimera/ContinuousMapping.hs b/src/Data/Chimera/ContinuousMapping.hs
--- a/src/Data/Chimera/ContinuousMapping.hs
+++ b/src/Data/Chimera/ContinuousMapping.hs
@@ -270,7 +270,7 @@
 fromZCurve3 :: Word -> (ThirdWord, ThirdWord, ThirdWord)
 fromZCurve3 z = (compact1by2 z, compact1by2 (z `shiftR` 1), compact1by2 (z `shiftR` 2))
 
--- | Convert a function of two 'HalfWord's to a function of one 'Word'.
+-- | Convert a function of two 'ThirdWord's to a function of one 'Word'.
 contramapFromZCurve3
   :: (ThirdWord -> ThirdWord -> ThirdWord -> a)
   -> (Word -> a)
@@ -278,7 +278,7 @@
   where
     uncurry3 func (a, b, c) = func a b c
 
--- | Convert a function of one 'Word' to a function of two 'HalfWord's.
+-- | Convert a function of one 'Word' to a function of two 'ThirdWord's.
 contramapToZCurve3
   :: (Word -> a)
   -> (ThirdWord -> ThirdWord -> ThirdWord -> a)
diff --git a/src/Data/Chimera/Internal.hs b/src/Data/Chimera/Internal.hs
--- a/src/Data/Chimera/Internal.hs
+++ b/src/Data/Chimera/Internal.hs
@@ -553,13 +553,21 @@
       [] -> G.singleton a : map (\k -> G.replicate (1 `shiftL` k) a) [0 .. bits - 1]
       x : xs -> G.singleton x : go 0 xs
 
-    go k xs = case measureOff kk xs of
-      Left l ->
-        G.fromListN kk (xs ++ replicate l a)
-          : map (\n -> G.replicate (1 `shiftL` n) a) [k + 1 .. bits - 1]
-      Right (ys, zs) -> G.fromListN kk ys : go (k + 1) zs
+    go k xs =
+      if k == bits
+        then []
+        else v : go (k + 1) zs
       where
         kk = 1 `shiftL` k
+        (v, zs) =
+          case measureOff kk xs of
+            Left l ->
+              ( if l == kk
+                  then G.replicate kk a
+                  else G.fromListN kk (xs ++ replicate l a)
+              , []
+              )
+            Right (ys, zs') -> (G.fromListN kk ys, zs')
 
 -- | Create a stream of values from a given infinite list.
 --
@@ -572,7 +580,10 @@
   where
     go0 (x :< xs) = G.singleton x : go 0 xs
 
-    go k xs = G.fromListN kk ys : go (k + 1) zs
+    go k xs =
+      if k == bits
+        then []
+        else G.fromListN kk ys : go (k + 1) zs
       where
         kk = 1 `shiftL` k
         (ys, zs) = Inf.splitAt kk xs
diff --git a/test/Test.hs b/test/Test.hs
--- a/test/Test.hs
+++ b/test/Test.hs
@@ -12,7 +12,9 @@
 import Data.Bits
 import Data.Foldable
 import Data.Function (fix)
+import qualified Data.List.Infinite as I
 import qualified Data.List as L
+import qualified Data.List.NonEmpty as NE
 import qualified Data.Vector.Generic as G
 
 import Data.Chimera.ContinuousMapping
@@ -152,11 +154,27 @@
   , QC.testProperty "toList" $
     \x xs -> xs === take (length xs) (Ch.toList (Ch.fromListWithDef x xs :: UChimera Bool))
 
-  , QC.testProperty "fromListWithDef" $
+  , testGroup "fromListWithDef"
+    [ QC.testProperty "finite list" $
+      \x xs ix ->
+        let jx = ix `mod` 65536 in
+          (if fromIntegral jx < length xs then xs !! fromIntegral jx else x) ===
+            Ch.index (Ch.fromListWithDef x xs :: UChimera Bool) jx
+
+    , QC.testProperty "infinite list" $
+      \x xs ix ->
+        let jx = ix `mod` 65536 in
+          let xs' = QC.getInfiniteList xs in
+            (xs' !! fromIntegral jx) ===
+              Ch.index (Ch.fromListWithDef x xs' :: UChimera Bool) jx
+    ]
+
+  , QC.testProperty "fromInfinite" $
     \x xs ix ->
       let jx = ix `mod` 65536 in
-        (if fromIntegral jx < length xs then xs !! fromIntegral jx else x) ===
-          Ch.index (Ch.fromListWithDef x xs :: UChimera Bool) jx
+        let ys = I.cycle (x NE.:| xs) in
+          (ys I.!! jx) ===
+            Ch.index (Ch.fromInfinite ys :: UChimera Bool) jx
 
   , QC.testProperty "fromVectorWithDef" $
     \x xs ix ->