diff --git a/dhall/src/Dhall/Eval.hs b/dhall/src/Dhall/Eval.hs index baeeca77a..0f3b64388 100644 --- a/dhall/src/Dhall/Eval.hs +++ b/dhall/src/Dhall/Eval.hs @@ -122,7 +122,7 @@ instance Semigroup (VChunks a) where VChunks xys z <> VChunks [] z' = VChunks xys (z <> z') VChunks xys z <> VChunks ((x', y'):xys') z' = VChunks (xys ++ (z <> x', y'):xys') z' -instance Monoid (VChunks b) where +instance Monoid (VChunks a) where mempty = VChunks [] mempty {-| Some information is lost when `eval` converts a `Lam` or a built-in function @@ -527,9 +527,13 @@ eval !env t0 = -- following issue: -- -- https://github.com/ghcjs/ghcjs/issues/782 - let go !acc 0 = acc - go acc m = go (vApp succ acc) (m - 1) - in go zero (fromIntegral n' :: Integer) + go zero (fromIntegral n' :: Integer) where + go !acc 0 = acc + go (VNaturalLit x) m = + case vApp succ (VNaturalLit x) of + VNaturalLit y | x == y -> VNaturalLit x + notNaturalLit -> go notNaturalLit (m - 1) + go acc m = go (vApp succ acc) (m - 1) _ -> inert NaturalBuild -> VPrim $ \case diff --git a/dhall/src/Dhall/Map.hs b/dhall/src/Dhall/Map.hs index c85d37085..9d1afa961 100644 --- a/dhall/src/Dhall/Map.hs +++ b/dhall/src/Dhall/Map.hs @@ -623,8 +623,8 @@ traverseWithKey :: Ord k => Applicative f => (k -> a -> f b) -> Map k a -> f (Map k b) traverseWithKey f (Map m Sorted) = fmap (\m' -> Map m' Sorted) (Data.Map.traverseWithKey f m) -traverseWithKey f m = - fmap fromList (traverse f' (toList m)) +traverseWithKey f m@(Map _ ks) = + flip Map ks . Data.Map.fromList <$> traverse f' (toList m) where f' (k, a) = fmap ((,) k) (f k a) {-# INLINABLE traverseWithKey #-} diff --git a/dhall/src/Dhall/Normalize.hs b/dhall/src/Dhall/Normalize.hs index e6a51a777..e7c580f46 100644 --- a/dhall/src/Dhall/Normalize.hs +++ b/dhall/src/Dhall/Normalize.hs @@ -211,8 +211,16 @@ normalizeWithM ctx e0 = loop (Syntax.denote e0) strict = strictLoop (fromIntegral n0 :: Integer) lazy = loop ( lazyLoop (fromIntegral n0 :: Integer)) - strictLoop 0 = loop zero - strictLoop !n = App succ' <$> strictLoop (n - 1) >>= loop + strictLoop !n = do + z <- loop zero + strictLoopShortcut n z + + strictLoopShortcut 0 !previous = pure previous + strictLoopShortcut !n !previous = do + current <- loop (App succ' previous) + if judgmentallyEqual previous current + then pure previous + else strictLoopShortcut (n - 1) current lazyLoop 0 = zero lazyLoop !n = App succ' (lazyLoop (n - 1))