{-# LANGUAGE DeriveDataTypeable #-}

module Impossible where

import Control.Exception
import Data.Typeable ( Typeable )


data Impossible
  = Impossible  String Integer
    -- ^ We reached a program point which should be unreachable.

  deriving Typeable

instance Show Impossible where
  show :: Impossible -> String
show (Impossible String
file Integer
line) = [String] -> String
unlines
    [ String
"An internal error has occurred. Please report this as a bug."
    , String
"Location of the error: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
file String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
line
    ]

instance Exception Impossible

-- | Abort by throwing an \"impossible\" error. You should not use
-- this function directly. Instead use the macro in @undefined.h@.

throwImpossible :: Impossible -> a
throwImpossible :: forall a. Impossible -> a
throwImpossible = Impossible -> a
forall a e. Exception e => e -> a
throw