Records with field names sharing the same underlying string are broken

Declaring records where the field Names are different, but the Names have the same underlying FastString causes a myriad of issues.

Test case:

{-# LANGUAGE DeriveTraversable  #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE RecordWildCards    #-}
{-# LANGUAGE TemplateHaskell    #-}

module T22122_aux where

import Language.Haskell.TH.Syntax
  ( Name, Type(ConT), Lit(CharL, StringL)
  , Dec(DataD, FunD), Con(RecC), Exp(LitE, VarE, RecUpdE), Pat(VarP)
  , Clause(Clause), Body(NormalB)
  , Bang(..), SourceUnpackedness(..), SourceStrictness(..)
  , newNameIO )
import System.IO.Unsafe
  ( unsafePerformIO )


data Names a
  = Names { d1_name, d2_name
          , mkd1_name, mkd2a_name, mkd2b_name
          , d1_fld1_name, d1_fld2_name, d2_fld1_name, d2_fld2_name
          , upd_name, upd_var_name :: a }
  deriving stock ( Functor, Foldable, Traversable )

string_names :: Names String
string_names =
  Names
    { d1_name      = "D1"
    , d2_name      = "D2"
    , mkd1_name    = "MkD1"
    , mkd2a_name   = "MkD2A"
    , mkd2b_name   = "MkD2B"
    , d1_fld1_name = "fld" -- these are deliberately the same,
    , d1_fld2_name = "fld" -- to check that we correctly use the exact Names
    , d2_fld1_name = "fld" -- in a record update, and not simply the
    , d2_fld2_name = "fld" -- field label strings
    , upd_name     = "upd"
    , upd_var_name = "r"
    }

names :: Names Name
names = unsafePerformIO $ traverse newNameIO string_names

noBang :: Bang
noBang = Bang NoSourceUnpackedness NoSourceStrictness

-- data D1 = MkD1 { fld1 :: Char, fld2 :: String }
-- data D2 = MkD2A { fld1 :: Char } | MkD2B { fld2 :: String }
data_decls :: [ Dec ]
data_decls = [ d1, d2 ]
  where
    Names { .. } = names
    d1 = DataD [] d1_name [] Nothing [mkd1] []
    d2 = DataD [] d2_name [] Nothing [mkd2_a, mkd2_b] []
    mkd1 = RecC mkd1_name [(d1_fld1_name, noBang, ConT ''Char), (d1_fld2_name, noBang, ConT ''String)]
    mkd2_a = RecC mkd2a_name [(d2_fld1_name, noBang, ConT ''Char)]
    mkd2_b = RecC mkd2b_name [(d2_fld2_name, noBang, ConT ''String)]

-- rec_upd r = r { fld1 = 'c', fld2 = "foo" }
record_upds :: [ Dec ]
record_upds = [ rec_upd ]
  where
    Names { .. } = names
    rec_upd = FunD upd_name [upd_clause]
    upd_clause = Clause [VarP upd_var_name] (NormalB rec_upd_body) []
    rec_upd_body = RecUpdE (VarE upd_var_name) [ (d1_fld1_name, LitE (CharL 'c')), (d1_fld2_name, LitE (StringL "foo")) ]

====================================

{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NoFieldSelectors      #-}
{-# LANGUAGE RecordWildCards       #-}
{-# LANGUAGE TemplateHaskell       #-}

module T22122 where

import T22122_aux ( data_decls, record_upds )

$(return data_decls)

$(return record_upds)

Issue 1

testsuite\tests\th\THRecordUpd.hs:10:2: error:
    * Constructors MkD2A and MkD2B give different types for field `fld'
    * In the data type declaration for `D2'
   |
10 | $(return data_decls)
   |  ^^^^^

Issue 2

Changing "fld", "fld", "fld", "fld" to "fld1", "fld2", "fld1", "fld2" causes the following error:

C:\Users\sheaf\AppData\Local\Temp\ghc6132_0\ghc_1.s:133:1: error:
     error: symbol 'THRecordUpd_fld2_info' is already defined
    |
133 | THRecordUpd_fld2_info:
    | ^
THRecordUpd_fld2_info:
^

C:\Users\sheaf\AppData\Local\Temp\ghc6132_0\ghc_1.s:174:1: error:
     error: symbol 'THRecordUpd_fld2_closure' is already defined
    |
174 | THRecordUpd_fld2_closure:
    | ^
THRecordUpd_fld2_closure:
^

C:\Users\sheaf\AppData\Local\Temp\ghc6132_0\ghc_1.s:190:1: error:
     error: symbol 'THRecordUpd_fld1_info' is already defined
    |
190 | THRecordUpd_fld1_info:
    | ^
THRecordUpd_fld1_info:
^

C:\Users\sheaf\AppData\Local\Temp\ghc6132_0\ghc_1.s:231:1: error:
     error: symbol 'THRecordUpd_fld1_closure' is already defined
    |
231 | THRecordUpd_fld1_closure:
    | ^
THRecordUpd_fld1_closure:
^
PLEASE submit a bug report to https://bugs.llvm.org/ and include the crash backtrace, preprocessed source, and associated run script.
Stack dump:
0.      Program arguments: C:\\Haskell\\ghc\\record-update\\_build\\stage1\\lib\\..\\../mingw/bin/clang.exe --rtlib=compiler-rt -iquotetestsuite\\tests\\th -Wa,-mbig-obj -Qunused-arguments -x assembler -c C:\\Users\\sheaf\\AppData\\Local\\Temp\\ghc6132_0\\ghc_1.s -o testsuite\\tests\\th\\THRecordUpd.o.tmp
 #0 0x00007ff9668fce2b llvm::MCWinCOFFObjectTargetWriter::recordRelocation(llvm::MCFixup const&) const (C:\Haskell\ghc\record-update\_build\mingw\bin\libLLVM-13.dll+0x174ce2b)
 #1 0x00007ff96689cda7 llvm::MCAssembler::Finish() (C:\Haskell\ghc\record-update\_build\mingw\bin\libLLVM-13.dll+0x16ecda7)
 #2 0x00007ff9668cb3f6 llvm::MCObjectStreamer::finishImpl() (C:\Haskell\ghc\record-update\_build\mingw\bin\libLLVM-13.dll+0x171b3f6)
 #3 0x00007ff9668e07cc llvm::MCWinCOFFStreamer::finishImpl() (C:\Haskell\ghc\record-update\_build\mingw\bin\libLLVM-13.dll+0x17307cc)
 #4 0x00007ff96690e193 llvm::createMCAsmParser(llvm::SourceMgr&, llvm::MCContext&, llvm::MCStreamer&, llvm::MCAsmInfo const&, unsigned int) (C:\Haskell\ghc\record-update\_build\mingw\bin\libLLVM-13.dll+0x175e193)
 #5 0x00007ff6a53ec2e2 cc1as_main(llvm::ArrayRef<char const*>, char const*, void*) (C:\Haskell\ghc\record-update\_build\mingw\bin\clang.exe+0xc2e2)
 #6 0x00007ff6a53e4a70 llvm::InitializeAllTargets() (C:\Haskell\ghc\record-update\_build\mingw\bin\clang.exe+0x4a70)
 #7 0x00007ff96b5662e6 llvm::SmallVectorTemplateBase<llvm::SmallString<128u>, false>::grow(unsigned long long) (C:\Haskell\ghc\record-update\_build\mingw\bin\libclang-cpp.dll+0x17b62e6)
 #8 0x00007ff965236e53 llvm::CrashRecoveryContext::RunSafely(llvm::function_ref<void ()>) (C:\Haskell\ghc\record-update\_build\mingw\bin\libLLVM-13.dll+0x86e53)
 #9 0x00007ff96b565eb5 clang::driver::CC1Command::Execute(llvm::ArrayRef<llvm::Optional<llvm::StringRef> >, std::__1::basic_string<char, std::__1::char_traits<char>, std::__1::allocator<char> >*, bool*) const (C:\Haskell\ghc\record-update\_build\mingw\bin\libclang-cpp.dll+0x17b5eb5)
#10 0x00007ff96b53795f clang::driver::Compilation::ExecuteCommand(clang::driver::Command const&, clang::driver::Command const*&) const (C:\Haskell\ghc\record-update\_build\mingw\bin\libclang-cpp.dll+0x178795f)
#11 0x00007ff96b537d39 clang::driver::Compilation::ExecuteJobs(clang::driver::JobList const&, llvm::SmallVectorImpl<std::__1::pair<int, clang::driver::Command const*> >&) const (C:\Haskell\ghc\record-update\_build\mingw\bin\libclang-cpp.dll+0x1787d39)
#12 0x00007ff96b54d4b6 clang::driver::Driver::ExecuteCompilation(clang::driver::Compilation&, llvm::SmallVectorImpl<std::__1::pair<int, clang::driver::Command const*> >&) (C:\Haskell\ghc\record-update\_build\mingw\bin\libclang-cpp.dll+0x179d4b6)
#13 0x00007ff6a53e3eac main (C:\Haskell\ghc\record-update\_build\mingw\bin\clang.exe+0x3eac)
#14 0x00007ff6a53e13da WinMainCRTStartup (C:\Haskell\ghc\record-update\_build\mingw\bin\clang.exe+0x13da)
#15 0x00007ff6a53e1436 mainCRTStartup (C:\Haskell\ghc\record-update\_build\mingw\bin\clang.exe+0x1436)
#16 0x00007ffa4cbe54e0 (C:\WINDOWS\System32\KERNEL32.DLL+0x154e0)
#17 0x00007ffa4db6485b (C:\WINDOWS\SYSTEM32\ntdll.dll+0x485b)
clang: error: clang integrated assembler command failed due to signal (use -v to see invocation)
clang version 13.0.0
Target: x86_64-w64-windows-gnu
Thread model: posix
InstalledDir: C:/Haskell/ghc/record-update/_build/stage1/lib/../../mingw/bin
clang: note: diagnostic msg: Error generating preprocessed source(s) - no preprocessable inputs.

<no location info>: error:
    `clang.exe' failed in phase `Assembler'. (Exit code: 1)                                         

Issue 3

Changing "fld", "fld", "fld", "fld" to "fld1", "fld1", "fld2", "fld3" causes the following:

    * GHC internal error: `THRecordUpd.fld1' is not in scope during type checking, but it passed the renamer
      tcl_env of environment: [a :-> Identifier[r_a::p1, NotLetBound]]
    * In the expression: r_a {fld1_5 = 'c', fld1_6 = "foo"}
      In an equation for `upd':
          upd r_a = r_a {fld1_5 = 'c', fld1_6 = "foo"}
   |
12 | $(return record_upds)
   |  ^^^^^^^^^^^^^^^^^^^^