diff --git a/compiler/GHC/Iface/Type.hs b/compiler/GHC/Iface/Type.hs index 1555f725a613e22f9bc9637b49f6219b387deb6b..ea024734fcc1abe9c10daba93831b628d66faced 100644 --- a/compiler/GHC/Iface/Type.hs +++ b/compiler/GHC/Iface/Type.hs @@ -728,6 +728,12 @@ ifaceVisAppArgsLength = go 0 | isVisibleForAllTyFlag argf = go (n+1) rest | otherwise = go n rest +ifaceAppArgsLength :: IfaceAppArgs -> Int +ifaceAppArgsLength = go 0 + where + go !n IA_Nil = n + go !n (IA_Arg _ _ ts) = go (n + 1) ts + {- Note [Suppressing invisible arguments] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -2090,21 +2096,27 @@ instance Binary IfaceTyLit where _ -> panic ("get IfaceTyLit " ++ show tag) instance Binary IfaceAppArgs where - put_ bh tk = - case tk of - IA_Arg t a ts -> putByte bh 0 >> put_ bh t >> put_ bh a >> put_ bh ts - IA_Nil -> putByte bh 1 + put_ bh tk = do + -- Int is variable length encoded so only + -- one byte for small lists. + put_ bh (ifaceAppArgsLength tk) + go tk + where + go IA_Nil = pure () + go (IA_Arg a b t) = do + put_ bh a + put_ bh b + go t - get bh = - do c <- getByte bh - case c of - 0 -> do - t <- get bh - a <- get bh - ts <- get bh - return $! IA_Arg t a ts - 1 -> return IA_Nil - _ -> panic ("get IfaceAppArgs " ++ show c) + get bh = do + n <- get bh :: IO Int + go n + where + go 0 = return IA_Nil + go c = do + a <- get bh + b <- get bh + IA_Arg a b <$> go (c - 1) -------------------