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)
| ^^^^^^^^^^^^^^^^^^^^Edited by sheaf