diff --git a/CONTRIBUTORS.md b/CONTRIBUTORS.md
index 71f41bc4b1..0bcdac1947 100644
--- a/CONTRIBUTORS.md
+++ b/CONTRIBUTORS.md
@@ -97,6 +97,7 @@ If you would prefer to use different terms, please use the section below instead
 | [@philopon](https://github.com/philopon) | Hirotomo Moriwaki | [MIT license](http://opensource.org/licenses/MIT) |
 | [@pseudonom](https://github.com/pseudonom) | Eric Easley | [MIT license](http://opensource.org/licenses/MIT) |
 | [@quesebifurcan](https://github.com/quesebifurcan) | Fredrik Wallberg | [MIT license](http://opensource.org/licenses/MIT) |
+| [@radrow](https://github.com/radrow) | Radosław Rowicki | [MIT license](http://opensource.org/licenses/MIT) |
 | [@rhendric](https://github.com/rhendric) | Ryan Hendrickson | [MIT license](http://opensource.org/licenses/MIT) |
 | [@rightfold](https://github.com/rightfold) | rightfold | [MIT license](https://opensource.org/licenses/MIT) |
 | [@rndnoise](https://www.github.com/rndnoise) | rndnoise | [MIT license](http://opensource.org/licenses/MIT) |
diff --git a/src/Language/PureScript/CoreImp/Optimizer/TCO.hs b/src/Language/PureScript/CoreImp/Optimizer/TCO.hs
index 6aa53905b6..f86faea72d 100644
--- a/src/Language/PureScript/CoreImp/Optimizer/TCO.hs
+++ b/src/Language/PureScript/CoreImp/Optimizer/TCO.hs
@@ -49,37 +49,16 @@ tco = everywhere convert where
   collectAllFunctionArgs allArgs f body = (allArgs, body, f)
 
   isTailRecursive :: Text -> AST -> Bool
-  isTailRecursive ident js = countSelfReferences js > 0 && allInTailPosition js where
-    countSelfReferences = everything (+) match where
-      match :: AST -> Int
-      match (Var _ ident') | ident == ident' = 1
-      match _ = 0
-
-    allInTailPosition (Return _ expr)
-      | isSelfCall ident expr = countSelfReferences expr == 1
-      | otherwise = countSelfReferences expr == 0
-    allInTailPosition (While _ js1 body)
-      = countSelfReferences js1 == 0 && allInTailPosition body
-    allInTailPosition (For _ _ js1 js2 body)
-      = countSelfReferences js1 == 0 && countSelfReferences js2 == 0 && allInTailPosition body
-    allInTailPosition (ForIn _ _ js1 body)
-      = countSelfReferences js1 == 0 && allInTailPosition body
-    allInTailPosition (IfElse _ js1 body el)
-      = countSelfReferences js1 == 0 && allInTailPosition body && all allInTailPosition el
-    allInTailPosition (Block _ body)
-      = all allInTailPosition body
-    allInTailPosition (Throw _ js1)
-      = countSelfReferences js1 == 0
-    allInTailPosition (ReturnNoResult _)
-      = True
-    allInTailPosition (VariableIntroduction _ _ js1)
-      = all ((== 0) . countSelfReferences) js1
-    allInTailPosition (Assignment _ _ js1)
-      = countSelfReferences js1 == 0
-    allInTailPosition (Comment _ _ js1)
-      = allInTailPosition js1
-    allInTailPosition _
-      = False
+  isTailRecursive ident js = anyInTailPosition js where
+
+    anyInTailPosition :: AST -> Bool
+    anyInTailPosition (Return _ expr) = isSelfCall ident expr
+    anyInTailPosition (While _ _ body) = anyInTailPosition body
+    anyInTailPosition (For _ _ _ _ body) = anyInTailPosition body
+    anyInTailPosition (ForIn _ _ _ body) = anyInTailPosition body
+    anyInTailPosition (IfElse _ _ body el) = anyInTailPosition body || any anyInTailPosition el
+    anyInTailPosition (Block _ body) = any anyInTailPosition body
+    anyInTailPosition _ = False
 
   toLoop :: Text -> [Text] -> [Text] -> AST -> AST
   toLoop ident outerArgs innerArgs js =
diff --git a/tests/purs/passing/OccasionalTCO.purs b/tests/purs/passing/OccasionalTCO.purs
new file mode 100644
index 0000000000..915eb53a51
--- /dev/null
+++ b/tests/purs/passing/OccasionalTCO.purs
@@ -0,0 +1,49 @@
+module Main where
+
+import Prelude
+import Effect.Console (log)
+
+main = do
+  let _ = occasionalTCO1 10000000
+  let _ = occasionalTCO2 10000000
+  let _ = occasionalTCO3 10000000
+  let _ = occasionalTCO4 10000000
+  let _ = occasionalTCO5 10000000
+  log "Done"
+
+occasionalTCO1 :: Int -> Int
+occasionalTCO1 0 = 1
+occasionalTCO1 n =
+  occasionalTCO1 (n - occasionalTCO1 0)
+
+occasionalTCO2 :: Int -> Int
+occasionalTCO2 0 = 1
+occasionalTCO2 n =
+  let x = occasionalTCO2 0
+  in occasionalTCO2 (n - x)
+
+occasionalTCO3 :: Int -> Int
+occasionalTCO3 0 = 1
+occasionalTCO3 n =
+  if occasionalTCO3 0 == n
+  then 1
+  else occasionalTCO3 (n - occasionalTCO3 0)
+
+occasionalTCO4 :: Int -> Int
+occasionalTCO4 0 = 1
+occasionalTCO4 n | 1 <- occasionalTCO4 0 =
+  case occasionalTCO4 0 + n of
+    2 -> 1
+    x -> occasionalTCO4 (x - 2)
+occasionalTCO4 _ = 1
+
+occasionalTCO5 :: Int -> Int
+occasionalTCO5 0 = 1
+occasionalTCO5 n | n > 10 =
+  occasionalTCO5 (n - 1)
+occasionalTCO5 n =
+  if n > 5
+  then occasionalTCO5 $ n - 1
+  else call occasionalTCO5 (n - 1)
+
+call f x = f x