From dd88a26052bdef0dd4c00e1a4781ec3ef532c5db Mon Sep 17 00:00:00 2001
From: Luite Stegeman <stegeman@gmail.com>
Date: Mon, 6 Nov 2023 15:58:16 +0100
Subject: [PATCH] JS: remove broken newIdents from JStg Monad
GHC.JS.JStg.Monad.newIdents was broken, resulting in duplicate
identifiers being generated in h$c1, h$c2, ... .
This change removes the broken newIdents.
---
compiler/GHC/JS/JStg/Monad.hs | 14 --------------
compiler/GHC/JS/Make.hs | 3 ++-
2 files changed, 2 insertions(+), 15 deletions(-)
diff --git a/compiler/GHC/JS/JStg/Monad.hs b/compiler/GHC/JS/JStg/Monad.hs
index 3c328150bf09..980bc2cba7bb 100644
--- a/compiler/GHC/JS/JStg/Monad.hs
+++ b/compiler/GHC/JS/JStg/Monad.hs
@@ -40,7 +40,6 @@ module GHC.JS.JStg.Monad
, JSM
, withTag
, newIdent
- , newIdents
, initJSM
) where
@@ -95,19 +94,6 @@ newIdent = do env <- get
mk_ident :: FastString -> Unique -> Ident
mk_ident t i = global (mconcat [t, "_", mkFastString (show i)])
-
-
--- | A special case optimization over @newIdent@. Given a number of @Ident@ to
--- generate, generate all of them at one time and update the state once rather
--- than n times.
-newIdents :: Int -> JSM [Ident]
-newIdents 0 = return []
-newIdents n = do env <- get
- let is = take n (uniqsFromSupply $ ids env)
- tag = prefix env
- return $ fmap (mk_ident tag) is
-
-
-- | Set the tag for @Ident@s for all remaining computations.
tag_names :: FastString -> JSM ()
tag_names tag = modify' (\env -> env {prefix = tag})
diff --git a/compiler/GHC/JS/Make.hs b/compiler/GHC/JS/Make.hs
index 0fd023baa937..3a98ca21e570 100644
--- a/compiler/GHC/JS/Make.hs
+++ b/compiler/GHC/JS/Make.hs
@@ -149,6 +149,7 @@ import GHC.JS.JStg.Monad
import GHC.JS.Transform
import Control.Arrow ((***))
+import Control.Monad (replicateM)
import Data.Tuple
import qualified Data.Map as M
@@ -325,7 +326,7 @@ jFunctionSized
-> ([JStgExpr] -> JSM JStgStat) -- ^ function body, input is locally unique generated variables
-> JSM JStgStat
jFunctionSized name arity body = do
- func_args <- newIdents arity
+ func_args <- replicateM arity newIdent
FuncStat name func_args <$> (body $ toJExpr <$> func_args)
-- | Construct a top-level function subject to JS hoisting. Special case where
--
GitLab