module UHC.Light.Compiler.Base.Parser
( module UHC.Light.Compiler.Base.ParseUtils
, pDollNm, pUID, pInt
, pCTag, pCTagExtensive
, pBool
, parseHsName
, pStr
, pUIDHI
, pPredOccId
, pIdOcc, pIdOccKind
, pAssocL
, pCurlySemiBlock, pCurlys, pSemiBlock, pCurlyCommaBlock )
where
import UU.Parsing
import UHC.Util.Utils
import UHC.Util.ParseUtils
import UHC.Util.ScanUtils
import UHC.Light.Compiler.Base.HsName.Builtin
import UHC.Light.Compiler.Base.Common
import UHC.Light.Compiler.Scanner.Common
import UHC.Light.Compiler.Scanner.Scanner
import UHC.Light.Compiler.Base.ParseUtils
import UHC.Light.Compiler.Base.ParseUtils
import UHC.Light.Compiler.Error
import UHC.Light.Compiler.Error.Pretty
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified UHC.Util.Rel as Rel
import Data.List

{-# LINE 30 "src/ehc/Base/Parser.chs" #-}
pDollNm :: P HsName
pDollNm
  = (parseHsName . tokenVals) -- tokMkQName
    <$> (   pVaridTk  <|> pConidTk
        <|> pQVaridTk <|> pQConidTk
        )

-- counterpart of ppUIDParseable/showUIDParseable
pUID :: P UID
-- pUID = mkUID <$ pOCURLY <*> pList1Sep pCOMMA pInt <* pCCURLY
pUID = mkUID <$ pBACKQUOTE <* pOCURLY <*> pList1Sep pCOMMA pInt <* pCCURLY
-- pUID = mkUID <$ pPERCENT <* pOBRACK <*> pList1Sep pSLASH pInt <* pCBRACK

pInt :: P Int
pInt = tokMkInt <$> pInteger10Tk


{-# LINE 51 "src/ehc/Base/Parser.chs" #-}
pUIDHI :: P UID
pUIDHI = pKeyTk "uid" *> pUID

{-# LINE 56 "src/ehc/Base/Parser.chs" #-}
-- | counterpart of ppCTag'
pCTag :: P CTag
pCTag
  = pCurly (   (\tyNm conNm tg -> CTag tyNm conNm tg (-1) (-1))
               <$> pDollNm <* pCOMMA <*> pDollNm <* pCOMMA <*> pInt
           <|> CTagRec <$ pKeyTk "Rec"
           )
-- | counterpart of pCTagExtensive'
pCTagExtensive :: P CTag
pCTagExtensive
  = pCurly (   CTag <$> pDollNm <* pCOMMA <*> pDollNm <* pCOMMA <*> pInt <* pCOMMA <*> pInt <* pCOMMA <*> pInt
           <|> CTagRec <$ pKeyTk "Rec"
           )

{-# LINE 72 "src/ehc/Base/Parser.chs" #-}
pBool :: P Bool
pBool = True <$ pKeyTk "True" <|> False <$ pKeyTk "False"

{-# LINE 78 "src/ehc/Base/Parser.chs" #-}
pPredOccId :: P PredOccId
pPredOccId
  = mkPrId <$> pUIDHI

{-# LINE 84 "src/ehc/Base/Parser.chs" #-}
-- counterpart of PP IdOccKind instance
pIdOccKind :: P IdOccKind
pIdOccKind
  =   IdOcc_Val     <$ pKeyTk "Value"
  <|> IdOcc_Pat     <$ pKeyTk "Pat"
  <|> IdOcc_Type    <$ pKeyTk "Type"
  <|> IdOcc_Kind    <$ pKeyTk "Kind"
  <|> IdOcc_Class   <$ pKeyTk "Class"
  <|> IdOcc_Inst    <$ pKeyTk "Instance"
  <|> IdOcc_Dflt    <$ pKeyTk "Default"
  <|> IdOcc_Data    <$ pKeyTk "Data"
  <|> IdOcc_Any     <$ pKeyTk "Any"

pIdOcc :: P IdOcc
pIdOcc = IdOcc <$ pOCURLY <*> pDollNm <* pCOMMA <*> pIdOccKind <* pCCURLY

{-# LINE 102 "src/ehc/Base/Parser.chs" #-}
pAssocL :: P a -> P b -> P (AssocL a b)
pAssocL pA pB = pOCURLY *> pListSep pCOMMA ((,) <$> pA <* pEQUAL <*> pB) <* pCCURLY

{-# LINE 111 "src/ehc/Base/Parser.chs" #-}
pHsNameUnique :: P HsNameUnique
pHsNameUnique
  =   HsNameUnique_Int    <$> pInt
  <|> HsNameUnique_UID    <$> pUID
  <|> HsNameUnique_String <$> pStr

pHsNameUniqifier :: P HsNameUniqifier
pHsNameUniqifier
  =   HsNameUniqifier_New                  <$ pKeyTk "NEW"
  <|> HsNameUniqifier_Error                <$ pKeyTk "ERR"
  <|> HsNameUniqifier_GloballyUnique       <$ pKeyTk "UNQ"
  <|> HsNameUniqifier_Evaluated            <$ pKeyTk "EVL"
  <|> HsNameUniqifier_Field                <$ pKeyTk "FLD"
  <|> HsNameUniqifier_Class                <$ pKeyTk "CLS"
  <|> HsNameUniqifier_ClassDict            <$ pKeyTk "DCT"
  <|> HsNameUniqifier_SelfDict             <$ pKeyTk "SDC"
  <|> HsNameUniqifier_ResultDict           <$ pKeyTk "RDC"
  <|> HsNameUniqifier_SuperClass           <$ pKeyTk "SUP"
  <|> HsNameUniqifier_DictField            <$ pKeyTk "DFL"
  <|> HsNameUniqifier_Inline               <$ pKeyTk "INL"
  <|> HsNameUniqifier_GloballyUniqueDict   <$ pKeyTk "UND"
  <|> HsNameUniqifier_FieldOffset          <$ pKeyTk "OFF"
  <|> HsNameUniqifier_CaseContinuation     <$ pKeyTk "CCN"
  <|> HsNameUniqifier_GrinUpdated          <$ pKeyTk "UPD"
  <|> HsNameUniqifier_FFIArg               <$ pKeyTk "FFI"
  <|> HsNameUniqifier_LacksLabel           <$ pKeyTk "LBL"
  <|> HsNameUniqifier_BindAspect           <$ pKeyTk "ASP"
  <|> HsNameUniqifier_Strict               <$ pKeyTk "STR"
  <|> HsNameUniqifier_GenericClass         <$ pKeyTk "GEN"
  <|> HsNameUniqifier_FFE                  <$ pKeyTk "FFE"
  <|> HsNameUniqifier_FFECoerced           <$ pKeyTk "FFC"

pHsNameUniqifierMp :: P HsNameUniqifierMp
pHsNameUniqifierMp
  = Map.fromList <$> pList ((pSep *> pHsNameUniqifier) <+> (pOCURLY *> pList (pSep *> pHsNameUnique)) <* pCCURLY)
  where pSep = tokConcat <$> pBACKQUOTE <*> pBACKQUOTE -- pAT

pHsName :: P HsName
pHsName
  = (\qs (b,u) -> hsnMkModf qs b u) <$> pList_ng (pHsName_Qual <* pDOT) <*> pHsName_Base

pHsName_Qual :: P String
pHsName_Qual
  = tokMkStr  <$> (pVaridTk <|> pConidTk <|> pVarsymTk <|> pConsymTk <|> pK)
  where pK =   pAnyKey pKeyTk $ Set.toList $ scoKeywordsTxt hsnScanOpts

pHsName_Base :: P (HsName, HsNameUniqifierMp)
pHsName_Base
  = pB <+> pHsNameUniqifierMp
  where pB =   mkHNmBase . concat <$> pList1 pHsName_Qual
           <|> mkHNm              <$> pUID
           <|> tokMkQName         <$> pDOT

{-# LINE 179 "src/ehc/Base/Parser.chs" #-}
parseHsName :: [String] -> HsName
parseHsName ss
  = p $ concat $ intersperse "." ss
  where p s = case parseToResMsgs pHsName $ scan hsnScanOpts (initPos s) s of
          (res,[]) -> res
          (res,ms) -> hsnUniqifyStr HsNameUniqifier_Error (show ms) res

{-# LINE 206 "src/ehc/Base/Parser.chs" #-}
pStr :: P String
pStr = tokMkStr <$> pStringTk

{-# LINE 211 "src/ehc/Base/Parser.chs" #-}
pSemiBlock :: P p -> P [p]
pSemiBlock p = pListSep pSEMI p

pCurlys :: P p -> P p
pCurlys p = pOCURLY *> p <* pCCURLY

pCurlySemiBlock :: P p -> P [p]
pCurlySemiBlock p = pCurlys (pListSep pSEMI p)

pCurlyCommaBlock :: P p -> P [p]
pCurlyCommaBlock p = pCurlys (pListSep pCOMMA p)