mapM_ lintCmmExpr args
if map cmmExprRep args == machOpArgReps op
then cmmCheckMachOp op args
- else cmmLintMachOpErr expr
+ else cmmLintMachOpErr expr (map cmmExprRep args) (machOpArgReps op)
lintCmmExpr (CmmRegOff reg offset)
= lintCmmExpr (CmmMachOp (MO_Add rep)
[CmmReg reg, CmmLit (CmmInt (fromIntegral offset) rep)])
return ()
lintCmmStmt (CmmCall _target _res args _vols) = mapM_ (lintCmmExpr.fst) args
lintCmmStmt (CmmCondBranch e _id) = lintCmmExpr e >> checkCond e >> return ()
-lintCmmStmt (CmmSwitch e _branches) = lintCmmExpr e >> return ()
+lintCmmStmt (CmmSwitch e _branches) = do
+ erep <- lintCmmExpr e
+ if (erep == wordRep)
+ then return ()
+ else cmmLintErr (text "switch scrutinee is not a word: " <> ppr e)
lintCmmStmt (CmmJump e _args) = lintCmmExpr e >> return ()
lintCmmStmt _other = return ()
Left err -> Left (hang info 2 err)
Right a -> Right a
-cmmLintMachOpErr :: CmmExpr -> CmmLint a
-cmmLintMachOpErr expr = cmmLintErr (text "in MachOp application: " $$
- nest 2 (pprExpr expr))
+cmmLintMachOpErr :: CmmExpr -> [MachRep] -> [MachRep] -> CmmLint a
+cmmLintMachOpErr expr argsRep opExpectsRep
+ = cmmLintErr (text "in MachOp application: " $$
+ nest 2 (pprExpr expr) $$
+ (text "op is expecting: " <+> ppr opExpectsRep) $$
+ (text "arguments provide: " <+> ppr argsRep))
cmmLintAssignErr :: CmmStmt -> CmmLint a
cmmLintAssignErr stmt = cmmLintErr (text "in assignment: " $$