Commit 5de1bf18 authored by Laszlo Domoszlai's avatar Laszlo Domoszlai

do not generate code for unused constructor arguments in "case"

parent 2d912c78
......@@ -318,6 +318,17 @@ containsUnsafeSelect s (SCase _ ps) = isUnsafeSelect s ps || any (containsUnsafe
containsUnsafeSelect s (SLet b _) = containsUnsafeSelect s b
containsUnsafeSelect s _ = False
isUsed :: SaplTerm SaplVar -> Bool
isUsed body var = w (unpackVar var) body
where
w vn (SVar bvar) = unpackVar bvar == vn
w vn (SApplication bvar bargs) = w vn bvar || any (w vn) bargs
w vn (SCase bexpr branches) = w vn bexpr || any (w vn) (map snd branches)
w vn (SLet bexpr bdefs) = w vn bexpr || any (w vn) (map unpackBindExpr bdefs)
w vn (SSelect bexpr _ _) = w vn bexpr
w vn (SUpdate bexpr _ updates) = w vn bexpr || any (w vn) (map snd updates)
w _ _ = False
isUnsafeSelect :: !CoderState ![(SaplPattern, SaplTerm)] -> Bool
isUnsafeSelect s patterns
= case ps of
......@@ -352,11 +363,16 @@ where
True = a
_ = a <++ "case " <++ toString get_cons.index <++ ": "
= a <++ "var " <++ instargs args 0 s <++ callWrapper body s
# (fargs, _) = foldl (\(fs, i) a -> if (isUsed body a) ([(a,i):fs],i+1) (fs,i+1)) ([], 0) args
= case fargs of
[] = a <++ callWrapper body s
fargs = a <++ "var " <++ instargs (reverse fargs) s <++ callWrapper body s
where
instargs [t] i s a = a <++ termCoder t s <++ "=ys[" <++ i+2 <++ "];"
instargs [t:ts] i s a = a <++ termCoder t s <++ "=ys[" <++ i+2 <++ "]," <++ instargs ts (i+1) s
instargs [] i s a = a
instargs [(t,i)] s a = a <++ termCoder t s <++ "=ys[" <++ i+2 <++ "];"
instargs [(t,i):ts] s a = a <++ termCoder t s <++ "=ys[" <++ i+2 <++ "]," <++ instargs ts s
instargs [] s a = a
get_cons = get_cons_or_die s cons
......
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