{-# LANGUAGE FlexibleInstances #-}
-- This corresponds to src/comp/Util.hs in bsc.
module Language.Bluespec.Util
  ( dbgLevel
  , doubleQuote
  , ToString(..)
  ) where

import Data.Char (intToDigit)

import Language.Bluespec.Prelude

-- =====
-- Configurable traces
-- (currently only used in Id and XRef)

dbgLevel :: Int
dbgLevel :: Int
dbgLevel = -Int
1

-- =====
-- String utilities

doubleQuote :: String -> String
doubleQuote :: String -> String
doubleQuote String
s = String
"\"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\""

-- =====
-- ToString class

class ToString a where
    to_string :: a -> String
    itos :: a -> String

instance ToString Int where
    itos :: Int -> String
itos Int
a = Int -> String
forall a. Show a => a -> String
show Int
a
    to_string :: Int -> String
to_string Int
a = String -> String
forall a. HasCallStack => String -> a
error (String
"to_string applied to nonsymbol (Int) "
                            String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
a)

instance ToString Integer where
    itos :: Integer -> String
itos Integer
a = Integer -> String
forall a. Show a => a -> String
show Integer
a
    to_string :: Integer -> String
to_string Integer
a = String -> String
forall a. HasCallStack => String -> a
error (String
"to_string applied to nonsymbol (Integer) "
                            String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
a)

instance ToString Char where
    itos :: Char -> String
itos Char
a = Char -> String
forall a. Show a => a -> String
show Char
a
    to_string :: Char -> String
to_string Char
a = case Char
a of
        Char
'\n' -> String
"\\n"
        Char
'\r' -> String
"\\r"
        Char
'\t' -> String
"\\t"
        Char
'\a' -> String
"\\a"
        Char
'\\' -> String
"\\\\"
        Char
'"' -> String
"\\\""        -- backslash double-quote
        Char
_ | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
||
            Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0x100 -> String -> String
forall a. HasCallStack => String -> a
error (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
"quoting a character value " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n
        Char
_ | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0x20 Bool -> Bool -> Bool
|| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0x7F ->
            [ Char
'\\', Int -> Char
intToDigit Int
highest, Int -> Char
intToDigit Int
middle, Int -> Char
intToDigit Int
lowest ]
        Char
_ -> [Char
a]
      where
        n :: Int
n = Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
a
        (Int
top2, Int
lowest) = Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
quotRem Int
n Int
8
        (Int
highest, Int
middle) = Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
quotRem Int
top2 Int
8

instance ToString String where
    itos :: String -> String
itos String
a = String -> String
forall a. HasCallStack => String -> a
error (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
"itos applied to string " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
a
    to_string :: String -> String
to_string String
a = (Char -> String) -> String -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Char -> String
forall a. ToString a => a -> String
to_string String
a