From e36815e32cafe55e461f90dca536c28d7735e7c3 Mon Sep 17 00:00:00 2001 From: Sergei Winitzki Date: Sat, 11 May 2024 16:56:58 +0200 Subject: [PATCH 1/7] optimize Natural/fold in the strict case --- dhall/src/Dhall/Normalize.hs | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/dhall/src/Dhall/Normalize.hs b/dhall/src/Dhall/Normalize.hs index e6a51a777..8be5007d7 100644 --- a/dhall/src/Dhall/Normalize.hs +++ b/dhall/src/Dhall/Normalize.hs @@ -211,8 +211,13 @@ 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 = strictLoopShortcut n (loop zero) + strictLoopShortcut 0 !res = res + strictLoopShortcut !n !res = do + x <- res + next_res = App succ' <$> res >>= loop + y <- next_res + if judgmentallyEqual x y then res else strictLoopShortcut (n - 1) next_res lazyLoop 0 = zero lazyLoop !n = App succ' (lazyLoop (n - 1)) From 89c54f741b7dea5f8e37e4d23b6ac19e44e9f0c0 Mon Sep 17 00:00:00 2001 From: Sergei Winitzki Date: Sat, 11 May 2024 18:02:19 +0200 Subject: [PATCH 2/7] remove tabs --- dhall/src/Dhall/Normalize.hs | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/dhall/src/Dhall/Normalize.hs b/dhall/src/Dhall/Normalize.hs index 8be5007d7..95e67f06c 100644 --- a/dhall/src/Dhall/Normalize.hs +++ b/dhall/src/Dhall/Normalize.hs @@ -212,12 +212,12 @@ normalizeWithM ctx e0 = loop (Syntax.denote e0) lazy = loop ( lazyLoop (fromIntegral n0 :: Integer)) strictLoop !n = strictLoopShortcut n (loop zero) - strictLoopShortcut 0 !res = res - strictLoopShortcut !n !res = do - x <- res - next_res = App succ' <$> res >>= loop - y <- next_res - if judgmentallyEqual x y then res else strictLoopShortcut (n - 1) next_res + strictLoopShortcut 0 !res = res + strictLoopShortcut !n !res = do + x <- res + next_res = App succ' <$> res >>= loop + y <- next_res + if judgmentallyEqual x y then res else strictLoopShortcut (n - 1) next_res lazyLoop 0 = zero lazyLoop !n = App succ' (lazyLoop (n - 1)) From 7bbee599ee6d141561d11f16efed0fffadc76f71 Mon Sep 17 00:00:00 2001 From: Sergei Winitzki Date: Sat, 11 May 2024 18:18:30 +0200 Subject: [PATCH 3/7] fix syntax in do block --- dhall/src/Dhall/Normalize.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/dhall/src/Dhall/Normalize.hs b/dhall/src/Dhall/Normalize.hs index 95e67f06c..5f33cbf7e 100644 --- a/dhall/src/Dhall/Normalize.hs +++ b/dhall/src/Dhall/Normalize.hs @@ -215,7 +215,7 @@ normalizeWithM ctx e0 = loop (Syntax.denote e0) strictLoopShortcut 0 !res = res strictLoopShortcut !n !res = do x <- res - next_res = App succ' <$> res >>= loop + let next_res = App succ' <$> res >>= loop y <- next_res if judgmentallyEqual x y then res else strictLoopShortcut (n - 1) next_res From 9dcac3347861d4efdd203db09968b7834cdfbe3b Mon Sep 17 00:00:00 2001 From: Sergei Winitzki Date: Sun, 12 May 2024 09:25:00 +0200 Subject: [PATCH 4/7] Update Normalize.hs Co-authored-by: Gabriella Gonzalez --- dhall/src/Dhall/Normalize.hs | 17 ++++++++++------- 1 file changed, 10 insertions(+), 7 deletions(-) diff --git a/dhall/src/Dhall/Normalize.hs b/dhall/src/Dhall/Normalize.hs index 5f33cbf7e..e7c580f46 100644 --- a/dhall/src/Dhall/Normalize.hs +++ b/dhall/src/Dhall/Normalize.hs @@ -211,13 +211,16 @@ normalizeWithM ctx e0 = loop (Syntax.denote e0) strict = strictLoop (fromIntegral n0 :: Integer) lazy = loop ( lazyLoop (fromIntegral n0 :: Integer)) - strictLoop !n = strictLoopShortcut n (loop zero) - strictLoopShortcut 0 !res = res - strictLoopShortcut !n !res = do - x <- res - let next_res = App succ' <$> res >>= loop - y <- next_res - if judgmentallyEqual x y then res else strictLoopShortcut (n - 1) next_res + 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)) From 827fc45834ba133698b4c93803a256d5f9255b79 Mon Sep 17 00:00:00 2001 From: Sergei Winitzki Date: Tue, 14 May 2024 12:19:56 +0200 Subject: [PATCH 5/7] adding wip code to Eval.hs --- dhall/src/Dhall/Eval.hs | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/dhall/src/Dhall/Eval.hs b/dhall/src/Dhall/Eval.hs index aac4b0c28..b217bb779 100644 --- a/dhall/src/Dhall/Eval.hs +++ b/dhall/src/Dhall/Eval.hs @@ -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 n) m = + case vApp succ (VNaturalLit n) of + VNaturalLit n' | n == n' -> VNaturalLit n + next -> go next (m - 1) + go acc m = go (vApp succ acc) (m - 1) _ -> inert NaturalBuild -> VPrim $ \case From ed07195c49d81207e69937b9d2af3ac005027188 Mon Sep 17 00:00:00 2001 From: Sergei Winitzki Date: Tue, 14 May 2024 15:31:02 +0200 Subject: [PATCH 6/7] fix code --- dhall/src/Dhall/Eval.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/dhall/src/Dhall/Eval.hs b/dhall/src/Dhall/Eval.hs index b217bb779..0f3b64388 100644 --- a/dhall/src/Dhall/Eval.hs +++ b/dhall/src/Dhall/Eval.hs @@ -529,10 +529,10 @@ eval !env t0 = -- https://github.com/ghcjs/ghcjs/issues/782 go zero (fromIntegral n' :: Integer) where go !acc 0 = acc - go (VNaturalLit n) m = - case vApp succ (VNaturalLit n) of - VNaturalLit n' | n == n' -> VNaturalLit n - next -> go next (m - 1) + 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 -> From 33efa78668951a3661e22378708fa2c43c87578d Mon Sep 17 00:00:00 2001 From: Sergei Winitzki Date: Fri, 31 May 2024 15:28:03 +0200 Subject: [PATCH 7/7] remove dummy change --- dhall/src/Dhall/Eval.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/dhall/src/Dhall/Eval.hs b/dhall/src/Dhall/Eval.hs index 38bb0b73c..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