Commit 690185e0 authored by sof's avatar sof
Browse files

[project @ 1999-02-06 15:54:21 by sof]

simplify_pat: When simplifying a RecPat to a ConPat, expand out the missing
fields with WildPats.
parent 88ca0162
......@@ -21,7 +21,7 @@ import DsUtils ( EquationInfo(..),
)
import Id ( idType )
import DataCon ( DataCon, isTupleCon, isUnboxedTupleCon,
dataConSourceArity )
dataConSourceArity, dataConFieldLabels )
import Name ( Name, mkLocalName, getOccName, isDataSymOcc, getName, mkSrcVarOcc )
import Type ( Type,
isUnboxedType,
......@@ -164,7 +164,6 @@ untidy _ (NPlusKPatIn name lit) = panic "Check.untidy: NPlusKPatIn"
untidy _ (NegPatIn ipat) = panic "Check.untidy: NegPatIn"
untidy _ (ParPatIn pat) = panic "Check.untidy: ParPatIn"
untidy _ (RecPatIn name fields) = panic "Check.untidy: RecPatIn"
-- [(name, InPat name, Bool)] -- True <=> source used punning
pars :: NeedPars -> WarningPat -> WarningPat
pars True p = ParPatIn p
......@@ -210,10 +209,10 @@ check' [] = ([([],[])],emptyUniqSet
check' [EqnInfo n ctx ps (MatchResult CanFail _)]
| all_vars ps = ([(take (length ps) (repeat new_wild_pat),[])], unitUniqSet n)
check' qs@((EqnInfo n ctx ps (MatchResult CanFail _)):_)
check' qs@((EqnInfo n ctx ps (MatchResult CanFail _)):rs)
| all_vars ps = (pats, addOneToUniqSet indexs n)
where
(pats,indexs) = check' (tail qs)
(pats,indexs) = check' rs
check' qs@((EqnInfo n ctx ps result):_)
| all_vars ps = ([], unitUniqSet n)
......@@ -222,13 +221,15 @@ check' qs@((EqnInfo n ctx ps result):_)
| literals = split_by_literals qs
| constructors = split_by_constructor qs
| only_vars = first_column_only_vars qs
| otherwise = panic "Check.check': Not implemented :-("
| otherwise = panic ("Check.check': Not implemented :-(")
where
-- Note: RecPats will have been simplified to ConPats
-- at this stage.
constructors = or (map is_con qs)
literals = or (map is_lit qs)
only_vars = and (map is_var qs)
-- npat = or (map is_npat qs)
-- nplusk = or (map is_nplusk qs)
only_vars = and (map is_var qs)
\end{code}
Here begins the code to deal with literals, we need to split the matrix
......@@ -406,7 +407,7 @@ remove_dups (x:xs) | or (map (\y -> compare_cons x y) xs) = remove_dups xs
| otherwise = x : remove_dups xs
get_used_cons :: [EquationInfo] -> [TypecheckedPat]
get_used_cons qs = remove_dups [con | (EqnInfo _ _ (con@(ConPat _ _ _ _ _):_) _) <- qs]
get_used_cons qs = remove_dups [con | (EqnInfo _ _ (con@(ConPat _ _ _ _ _):_) _) <- qs ]
remove_dups' :: [HsLit] -> [HsLit]
remove_dups' [] = []
......@@ -434,9 +435,10 @@ get_unused_cons used_cons = unused_cons
(ConPat _ ty _ _ _) = head used_cons
Just (ty_con,_) = splitTyConApp_maybe ty
all_cons = tyConDataCons ty_con
used_cons_as_id = map (\ (ConPat id _ _ _ _) -> id) used_cons
used_cons_as_id = map (\ (ConPat d _ _ _ _) -> d) used_cons
unused_cons = uniqSetToList (mkUniqSet all_cons `minusUniqSet` mkUniqSet used_cons_as_id)
all_vars :: [TypecheckedPat] -> Bool
all_vars [] = True
all_vars (WildPat _:ps) = all_vars ps
......@@ -448,7 +450,7 @@ remove_var _ = panic "Check:remove_var: equa
is_con :: EquationInfo -> Bool
is_con (EqnInfo _ _ ((ConPat _ _ _ _ _):_) _) = True
is_con _ = False
is_con _ = False
is_lit :: EquationInfo -> Bool
is_lit (EqnInfo _ _ ((LitPat _ _):_) _) = True
......@@ -601,16 +603,30 @@ simplify_pat (TuplePat ps False)
where
arity = length ps
simplify_pat (RecPat id ty tvs dicts [])
= ConPat id ty tvs dicts [wild_pat]
simplify_pat (RecPat dc ty tvs dicts [])
= ConPat dc ty tvs dicts all_wild_pats
where
wild_pat = WildPat gt
gt = panic "Check.symplify_pat: gessing gt"
all_wild_pats = map (\ _ -> WildPat gt) (dataConFieldLabels dc)
gt = panic "Check.symplify_pat{RecPat-1}"
simplify_pat (RecPat id ty tvs dicts idps)
= ConPat id ty tvs dicts pats
simplify_pat (RecPat dc ty tvs dicts idps)
= ConPat dc ty tvs dicts pats
where
pats = map (\ (id,p,_)-> simplify_pat p) idps
pats = map (simplify_pat.snd) all_pats
-- pad out all the missing fields with WildPats.
field_pats = map (\ f -> (getName f, WildPat (panic "simplify_pat(RecPat-2)")))
(dataConFieldLabels dc)
all_pats =
foldr
( \ (id,p,_) acc -> insertNm (getName id) p acc)
field_pats
idps
insertNm nm p [] = [(nm,p)]
insertNm nm p (x@(n,_):xs)
| nm == n = (nm,p):xs
| otherwise = x : insertNm nm p xs
simplify_pat pat@(LitPat lit lit_ty)
| isUnboxedType lit_ty = pat
......
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