-- Copyright 2019 Google LLC
--
-- Use of this source code is governed by a BSD-style
-- license that can be found in the LICENSE file or at
-- https://developers.google.com/open-source/licenses/bsd

{-# LANGUAGE CPP #-}
module GHC.SourceGen.Lit.Internal where

#if MIN_VERSION_ghc(9,2,0)
import GHC.Types.SourceText (SourceText(NoSourceText), FractionalLit(..), IntegralLit(..))
#elif MIN_VERSION_ghc(9,0,0)
import GHC.Types.Basic (SourceText(NoSourceText), FractionalLit(..), IntegralLit(..))
#else
import BasicTypes (SourceText(NoSourceText), FractionalLit(..), IntegralLit(..))
#endif
import GHC.Hs.Lit
import GHC.SourceGen.Syntax.Internal

noSourceText :: (SourceText -> a) -> a
noSourceText :: forall a. (SourceText -> a) -> a
noSourceText = (forall a b. (a -> b) -> a -> b
$ SourceText
NoSourceText)

litNeedsParen :: HsLit' -> Bool
-- For now, ignoring cases that only arrive from internal compiler passes.
-- Furthermore, GHC parses primitive numbers like -3.0# without needing parentheses.
-- So we can uniformly ignore this step.
litNeedsParen :: HsLit' -> Bool
litNeedsParen HsLit'
_ = Bool
False

overLitNeedsParen :: HsOverLit' -> Bool
overLitNeedsParen :: HsOverLit' -> Bool
overLitNeedsParen = OverLitVal -> Bool
needs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall p. HsOverLit p -> OverLitVal
ol_val
  where
    needs :: OverLitVal -> Bool
needs (HsIntegral IntegralLit
x) = IntegralLit -> Bool
il_neg IntegralLit
x
    needs (HsFractional FractionalLit
x) = FractionalLit -> Bool
fl_neg FractionalLit
x
    needs OverLitVal
_ = Bool
False