type level function is quite slow

slowTypeLevel.hs

{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE TypeFamilyDependencies #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}

import qualified GHC.TypeLits as TypeLits

data Z
data S n

class KnownNat n where
  natSing :: n -> Integer

instance KnownNat Z where
  natSing _ = 0
instance KnownNat n => KnownNat (S n) where
  natSing _ = 1 + natSing (undefined :: n)

natVal :: KnownNat n => n -> Integer
natVal = natSing

type family FromInteger a where
  FromInteger 0 = Z
  FromInteger n = S (FromInteger (n TypeLits.- 1))

type T10k = FromInteger 10000
-- natVal (undefined :: T10k) => reduction stack overflow

main = natVal (undefined :: T10k)