Commit 76349636 authored by simonpj@microsoft.com's avatar simonpj@microsoft.com

Remove use of lambda with a refutable pattern

parent 528db2ad
......@@ -1308,7 +1308,7 @@ mkMultiBranch maybe_ncons raw_ways
= return (snd val)
| otherwise
= do label_neq <- getLabelBc
return (mkTestEQ (fst val) label_neq
return (testEQ (fst val) label_neq
`consOL` (snd val
`appOL` unitOL (LABEL label_neq)
`appOL` the_default))
......@@ -1322,7 +1322,7 @@ mkMultiBranch maybe_ncons raw_ways
label_geq <- getLabelBc
code_lo <- mkTree vals_lo range_lo (dec v_mid)
code_hi <- mkTree vals_hi v_mid range_hi
return (mkTestLT v_mid label_geq
return (testLT v_mid label_geq
`consOL` (code_lo
`appOL` unitOL (LABEL label_geq)
`appOL` code_hi))
......@@ -1332,34 +1332,32 @@ mkMultiBranch maybe_ncons raw_ways
[(_, def)] -> def
_ -> panic "mkMultiBranch/the_default"
testLT (DiscrI i) fail_label = TESTLT_I i fail_label
testLT (DiscrW i) fail_label = TESTLT_W i fail_label
testLT (DiscrF i) fail_label = TESTLT_F i fail_label
testLT (DiscrD i) fail_label = TESTLT_D i fail_label
testLT (DiscrP i) fail_label = TESTLT_P i fail_label
testLT NoDiscr _ = panic "mkMultiBranch NoDiscr"
testEQ (DiscrI i) fail_label = TESTEQ_I i fail_label
testEQ (DiscrW i) fail_label = TESTEQ_W i fail_label
testEQ (DiscrF i) fail_label = TESTEQ_F i fail_label
testEQ (DiscrD i) fail_label = TESTEQ_D i fail_label
testEQ (DiscrP i) fail_label = TESTEQ_P i fail_label
testEQ NoDiscr _ = panic "mkMultiBranch NoDiscr"
-- None of these will be needed if there are no non-default alts
(mkTestLT, mkTestEQ, init_lo, init_hi)
(init_lo, init_hi)
| null notd_ways
= panic "mkMultiBranch: awesome foursome"
| otherwise
= case fst (head notd_ways) of {
DiscrI _ -> ( \(DiscrI i) fail_label -> TESTLT_I i fail_label,
\(DiscrI i) fail_label -> TESTEQ_I i fail_label,
DiscrI minBound,
DiscrI maxBound );
DiscrW _ -> ( \(DiscrW i) fail_label -> TESTLT_W i fail_label,
\(DiscrW i) fail_label -> TESTEQ_W i fail_label,
DiscrW minBound,
DiscrW maxBound );
DiscrF _ -> ( \(DiscrF f) fail_label -> TESTLT_F f fail_label,
\(DiscrF f) fail_label -> TESTEQ_F f fail_label,
DiscrF minF,
DiscrF maxF );
DiscrD _ -> ( \(DiscrD d) fail_label -> TESTLT_D d fail_label,
\(DiscrD d) fail_label -> TESTEQ_D d fail_label,
DiscrD minD,
DiscrD maxD );
DiscrP _ -> ( \(DiscrP i) fail_label -> TESTLT_P i fail_label,
\(DiscrP i) fail_label -> TESTEQ_P i fail_label,
DiscrP algMinBound,
DiscrP algMaxBound );
NoDiscr -> panic "mkMultiBranch NoDiscr"
}
= case fst (head notd_ways) of
DiscrI _ -> ( DiscrI minBound, DiscrI maxBound )
DiscrW _ -> ( DiscrW minBound, DiscrW maxBound )
DiscrF _ -> ( DiscrF minF, DiscrF maxF )
DiscrD _ -> ( DiscrD minD, DiscrD maxD )
DiscrP _ -> ( DiscrP algMinBound, DiscrP algMaxBound )
NoDiscr -> panic "mkMultiBranch NoDiscr"
(algMinBound, algMaxBound)
= case maybe_ncons of
......
......@@ -426,7 +426,7 @@ cPprTermBase y =
. mapM (y (-1))
. subTerms)
, ifTerm (\t -> isTyCon listTyCon (ty t) && subTerms t `lengthIs` 2)
(\ p Term{subTerms=[h,t]} -> doList p h t)
(\ p t -> doList p t)
, ifTerm (isTyCon intTyCon . ty) (coerceShow$ \(a::Int)->a)
, ifTerm (isTyCon charTyCon . ty) (coerceShow$ \(a::Char)->a)
, ifTerm (isTyCon floatTyCon . ty) (coerceShow$ \(a::Float)->a)
......@@ -452,7 +452,7 @@ cPprTermBase y =
coerceShow f _p = return . text . show . f . unsafeCoerce# . val
--Note pprinting of list terms is not lazy
doList p h t = do
doList p (Term{subTerms=[h,t]}) = do
let elems = h : getListTerms t
isConsLast = not(termType(last elems) `coreEqType` termType h)
print_elems <- mapM (y cons_prec) elems
......@@ -468,6 +468,7 @@ cPprTermBase y =
getListTerms Term{subTerms=[]} = []
getListTerms t@Suspension{} = [t]
getListTerms t = pprPanic "getListTerms" (ppr t)
doList _ _ = panic "doList"
repPrim :: TyCon -> [Word] -> String
......
......@@ -79,11 +79,8 @@ slurpSpillCostInfo cmm
-- the info table from the CmmProc
countBlock info (BasicBlock blockId instrs)
| LiveInfo _ _ (Just blockLive) <- info
, Just rsLiveEntry <- lookupBlockEnv blockLive blockId
, rsLiveEntry_virt <- mapUniqSet (\(RegVirtual vr) -> vr)
$ filterUniqSet isVirtualReg rsLiveEntry
, Just rsLiveEntry <- lookupBlockEnv blockLive blockId
, rsLiveEntry_virt <- takeVirtuals rsLiveEntry
= countLIs rsLiveEntry_virt instrs
| otherwise
......@@ -112,10 +109,6 @@ slurpSpillCostInfo cmm
mapM_ incDefs $ catMaybes $ map takeVirtualReg $ nub written
-- compute liveness for entry to next instruction.
let takeVirtuals set
= mapUniqSet (\(RegVirtual vr) -> vr)
$ filterUniqSet isVirtualReg set
let liveDieRead_virt = takeVirtuals (liveDieRead live)
let liveDieWrite_virt = takeVirtuals (liveDieWrite live)
let liveBorn_virt = takeVirtuals (liveBorn live)
......@@ -134,6 +127,13 @@ slurpSpillCostInfo cmm
incLifetime reg = modify $ \s -> addToUFM_C plusSpillCostRecord s reg (reg, 0, 0, 1)
takeVirtuals :: UniqSet Reg -> UniqSet VirtualReg
takeVirtuals set = mapUniqSet get_virtual
$ filterUniqSet isVirtualReg set
where
get_virtual (RegVirtual vr) = vr
get_virtual _ = panic "getVirt"
-- | Choose a node to spill from this graph
chooseSpill
......
......@@ -320,7 +320,8 @@ rnExpr (HsArrApp arrow arg _ ho rtl)
-- infix form
rnExpr (HsArrForm op (Just _) [arg1, arg2])
= escapeArrowScope (rnLExpr op)
`thenM` \ (op'@(L _ (HsVar op_name)),fv_op) ->
`thenM` \ (op',fv_op) ->
let L _ (HsVar op_name) = op' in
rnCmdTop arg1 `thenM` \ (arg1',fv_arg1) ->
rnCmdTop arg2 `thenM` \ (arg2',fv_arg2) ->
......
......@@ -245,7 +245,7 @@ rnPat :: HsMatchContext Name -- for error messages
-> RnM (a, FreeVars) -- Variables bound by pattern do not
-- appear in the result FreeVars
rnPat ctxt pat thing_inside
= rnPats ctxt [pat] (\[pat'] -> thing_inside pat')
= rnPats ctxt [pat] (\pats' -> let [pat'] = pats' in thing_inside pat')
applyNameMaker :: NameMaker -> Located RdrName -> RnM Name
applyNameMaker mk rdr = do { (n, _fvs) <- runCps (newName mk rdr); return n }
......
......@@ -309,7 +309,8 @@ rnSrcWarnDecls _bound_names []
rnSrcWarnDecls bound_names decls
= do { -- check for duplicates
; mapM_ (\ (L loc rdr:lrdr':_) -> addErrAt loc (dupWarnDecl lrdr' rdr))
; mapM_ (\ dups -> let (L loc rdr:lrdr':_) = dups
in addErrAt loc (dupWarnDecl lrdr' rdr))
warn_rdr_dups
; pairs_s <- mapM (addLocM rn_deprec) decls
; return (WarnSome ((concat pairs_s))) }
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment