import Bag ( Bag, emptyBag, isEmptyBag, snocBag, foldBag )
import Id ( Id, idType )
import VarSet
import Bag ( Bag, emptyBag, isEmptyBag, snocBag, foldBag )
import Id ( Id, idType )
import VarSet
-import DataCon ( DataCon, dataConArgTys, dataConType )
-import Const ( literalType, conType, Literal )
+import DataCon ( DataCon, dataConArgTys, dataConRepType )
+import PrimOp ( primOpType )
+import Literal ( literalType, Literal )
import Maybes ( catMaybes )
import Name ( isLocallyDefined, getSrcLoc )
import ErrUtils ( ErrMsg, Message, addErrLocHdrLine, pprBagOfErrors, dontAddErrLoc )
import Type ( mkFunTys, splitFunTys, splitAlgTyConApp_maybe,
isUnLiftedType, isTyVarTy, splitForAllTys, Type
)
import Maybes ( catMaybes )
import Name ( isLocallyDefined, getSrcLoc )
import ErrUtils ( ErrMsg, Message, addErrLocHdrLine, pprBagOfErrors, dontAddErrLoc )
import Type ( mkFunTys, splitFunTys, splitAlgTyConApp_maybe,
isUnLiftedType, isTyVarTy, splitForAllTys, Type
)
lintStgExpr e@(StgApp fun args)
= lintStgVar fun `thenMaybeL` \ fun_ty ->
mapMaybeL lintStgArg args `thenL` \ maybe_arg_tys ->
lintStgExpr e@(StgApp fun args)
= lintStgVar fun `thenMaybeL` \ fun_ty ->
mapMaybeL lintStgArg args `thenL` \ maybe_arg_tys ->
= mapMaybeL lintStgArg args `thenL` \ maybe_arg_tys ->
case maybe_arg_tys of
Nothing -> returnL Nothing
Just arg_tys -> checkFunApp con_ty arg_tys (mkFunAppMsg con_ty arg_tys e)
where
= mapMaybeL lintStgArg args `thenL` \ maybe_arg_tys ->
case maybe_arg_tys of
Nothing -> returnL Nothing
Just arg_tys -> checkFunApp con_ty arg_tys (mkFunAppMsg con_ty arg_tys e)
where
+ con_ty = dataConRepType con
+
+lintStgExpr e@(StgPrimApp op args _)
+ = mapMaybeL lintStgArg args `thenL` \ maybe_arg_tys ->
+ case maybe_arg_tys of
+ Nothing -> returnL Nothing
+ Just arg_tys -> checkFunApp op_ty arg_tys (mkFunAppMsg op_ty arg_tys e)
+ where
+ op_ty = primOpType op
Just (tycon, tys_applied, cons) ->
let
arg_tys = dataConArgTys con tys_applied
Just (tycon, tys_applied, cons) ->
let
arg_tys = dataConArgTys con tys_applied
in
checkL (con `elem` cons) (mkAlgAltMsg2 scrut_ty con) `thenL_`
checkL (length arg_tys == length args) (mkAlgAltMsg3 con args)
in
checkL (con `elem` cons) (mkAlgAltMsg2 scrut_ty con) `thenL_`
checkL (length arg_tys == length args) (mkAlgAltMsg3 con args)