\begin{code}
module ParseUtil (
parseError -- String -> Pa
- , cbot -- a
, mkVanillaCon, mkRecCon,
, mkRecConstrOrUpdate -- HsExp -> [HsFieldUpdate] -> P HsExp
, groupBindings
- , mkExtName -- Maybe ExtName -> RdrName -> ExtName
+ , mkExtName -- RdrName -> ExtName
, checkPrec -- String -> P String
, checkContext -- HsType -> P HsContext
, checkSimple -- HsType -> [HsName] -> P ((HsName,[HsName]))
, checkPattern -- HsExp -> P HsPat
, checkPatterns -- SrcLoc -> [HsExp] -> P [HsPat]
- , checkDo -- [HsStmt] -> P [HsStmt]
+ , checkDo -- [Stmt] -> P [Stmt]
, checkValDef -- (SrcLoc, HsExp, HsRhs, [HsDecl]) -> P HsDecl
, checkValSig -- (SrcLoc, HsExp, HsRhs, [HsDecl]) -> P HsDecl
) where
import RdrHsSyn ( RdrBinding(..),
RdrNameHsType, RdrNameBangType, RdrNameContext,
RdrNameHsTyVar, RdrNamePat, RdrNameHsExpr, RdrNameGRHSs,
- RdrNameHsRecordBinds, RdrNameMonoBinds, RdrNameConDetails
+ RdrNameHsRecordBinds, RdrNameMonoBinds, RdrNameConDetails,
+ mkNPlusKPat
)
import RdrName
import PrelNames ( unitTyCon_RDR )
-import ForeignCall ( CCallConv(..) )
import OccName ( dataName, varName, tcClsName,
occNameSpace, setOccNameSpace, occNameUserString )
+import CStrings ( CLabelString )
import FastString ( unpackFS )
-import UniqFM ( UniqFM, listToUFM )
import Outputable
-----------------------------------------------------------------------------
getSrcLocP `thenP` \ loc ->
failMsgP (hcat [ppr loc, text ": ", text s])
-cbot = panic "CCall:result_ty"
-----------------------------------------------------------------------------
-- mkVanillaCon
-- checkDo (a) checks that the last thing is an ExprStmt
-- (b) transforms it to a ResultStmt
-checkDo [] = parseError "Empty 'do' construct"
-checkDo [ExprStmt e l] = returnP [ResultStmt e l]
-checkDo [s] = parseError "The last statment in a 'do' construct must be an expression"
-checkDo (s:ss) = checkDo ss `thenP` \ ss' ->
- returnP (s:ss')
+checkDo [] = parseError "Empty 'do' construct"
+checkDo [ExprStmt e _ l] = returnP [ResultStmt e l]
+checkDo [s] = parseError "The last statement in a 'do' construct must be an expression"
+checkDo (s:ss) = checkDo ss `thenP` \ ss' ->
+ returnP (s:ss')
---------------------------------------------------------------------------
-- Checking Patterns.
in
returnP (SigPatIn e t')
- OpApp (HsVar n) (HsVar plus) _ (HsOverLit lit@(HsIntegral k))
+ OpApp (HsVar n) (HsVar plus) _ (HsOverLit lit@(HsIntegral _ _))
| plus == plus_RDR
- -> returnP (NPlusKPatIn n lit)
+ -> returnP (mkNPlusKPat n lit)
where
plus_RDR = mkUnqual varName SLIT("+") -- Hack
_ -> patFail
HsPar e -> checkPat e [] `thenP` (returnP . ParPatIn)
- ExplicitList es -> mapP (\e -> checkPat e []) es `thenP` \ps ->
+ ExplicitList _ es -> mapP (\e -> checkPat e []) es `thenP` \ps ->
returnP (ListPatIn ps)
ExplicitTuple es b -> mapP (\e -> checkPat e []) es `thenP` \ps ->
-- want z-encoding (e.g. names with z's in them shouldn't be doubled)
-- (This is why we use occNameUserString.)
-mkExtName :: Maybe ExtName -> RdrName -> ExtName
-mkExtName Nothing rdrNm = ExtName (_PK_ (occNameUserString (rdrNameOcc rdrNm)))
- Nothing
-mkExtName (Just x) _ = x
+mkExtName :: RdrName -> CLabelString
+mkExtName rdrNm = _PK_ (occNameUserString (rdrNameOcc rdrNm))
-----------------------------------------------------------------------------
-- group function bindings into equation groups