Parser.hs

module UHC.Light.Compiler.Ty.Parser
( pTy', pTy )
where
import UU.Parsing
import UHC.Util.ParseUtils
import UHC.Light.Compiler.Base.Parser
import UHC.Util.ScanUtils
import UHC.Light.Compiler.Base.Common
import UHC.Light.Compiler.Base.TermLike
import UHC.Light.Compiler.Base.HsName.Builtin
import UHC.Light.Compiler.Scanner.Common
import UHC.Light.Compiler.Scanner.Scanner
import UHC.Light.Compiler.Ty

{-# LINE 21 "src/ehc/Ty/Parser.chs" #-}
-- type P p = PlainParser Token p

{-# LINE 25 "src/ehc/Ty/Parser.chs" #-}
pTy :: P Ty
pTy = pTy' pDollNm

pTy' :: P HsName -> P Ty
pTy' pNm = pT
  where
{-
    pPred :: P Pred
    pPred
      = pOIMPL
         *> (pT
             <**> (   (flip Pred_Lacks) <$ pLAM <*> (Label_Lab <$> pNm <|> Label_Var <$> pUIDHI)
                  <|> pSucceed Pred_Class
            )     )
        <*  pCIMPL
-}

    pTyBase :: P Ty
    pTyBase
      =   appCon  <$> pNm
      <|> pParens pT
      <|> pBracks pT
      <|> pRow
      <|> mkTyVar <$> pUID
{-
      <|> Ty_Any  <$  pQUESTQUEST
      <|> mkTyPr  <$> pPred
-}
      where pRow :: P Ty
            pRow
              = pOROWROW
                 *> (   foldl (\r (l,e) -> Ty_Ext r l e)
                        <$> pRow <* pVBAR
                        <*> pList1Sep pCOMMA ((,) <$> (pNm <|> mkHNmPos <$> pInt) <* pDCOLON <*> pT)
                    <|> pSucceed (appCon hsnRowEmpty)
                    )
                <*  pCROWROW

    pTyApp :: P Ty
    pTyApp
      =   appTopApp <$> pList1 pTyBase

    pT :: P Ty
    pT
      =   pTyApp <**>
            (   flip app1Arr <$ pRARROW <*> pT
            <|> pSucceed id
            )
{-
      <|> Ty_TBind
          <$> ((TyQu_Forall <$ pFORALL <|> TyQu_Exists <$ pEXISTS) <*> pMaybe 0 id (pSTAR *> pMaybe 1 id pInt))
          <*> pUIDHI
          <*> pMaybe kiStar id (pParens pT)
          <*  pDOT
          <*> pT
      <|> Ty_Lam <$ pLAM <*> pUIDHI <* pRARROW <*> pT
-}