[Git][ghc/ghc][wip/jeltsch/textual-bytecode-output] Switch to replacing several things with placeholders
by Wolfgang Jeltsch (＠jeltsch) 16 Jul '26
by Wolfgang Jeltsch (＠jeltsch) 16 Jul '26
16 Jul '26
Wolfgang Jeltsch pushed to branch wip/jeltsch/textual-bytecode-output at Glasgow Haskell Compiler / GHC
Commits:
aeddc354 by Wolfgang Jeltsch at 2026-07-15T19:57:47+03:00
Switch to replacing several things with placeholders
- - - - -
4 changed files:
- testsuite/tests/show-bytecode/Makefile
- testsuite/tests/show-bytecode/show-bytecode-breakpoints.stdout
- testsuite/tests/show-bytecode/show-bytecode-hpc.stdout
- testsuite/tests/show-bytecode/show-bytecode-vanilla.stdout
Changes:
=====================================
testsuite/tests/show-bytecode/Makefile
=====================================
@@ -4,7 +4,11 @@ include $(TOP)/mk/test.mk
compile = '$(TEST_HC)' $(TEST_HC_OPTS) -fbyte-code -fwrite-byte-code -no-link
show = '$(TEST_HC)' $(TEST_HC_OPTS) --show-byte-code
-normalize = sed -E -e 's/_r[[:alnum:]]+//g'
+normalize = sed -E -e ' \
+ s/_r[[:alnum:]]+/_@name_suffix@/g; \
+ s/[[:xdigit:]]{32}/@hash@/g; \
+ s/word [[:digit:]]{4}[[:digit:]]*/word @large_word@/ \
+ '
show-bytecode-vanilla:
$(compile) Example.hs
=====================================
testsuite/tests/show-bytecode/show-bytecode-breakpoints.stdout
=====================================
@@ -1,6 +1,6 @@
[1 of 1] Compiling Example ( Example.hs, Example.gbc )
name: Example
-hash: 35e1280518690981ffc1dfa3d7c3c18e
+hash: @hash@
objects:
ordinary object ‘primesPtr’:
arity: 0
@@ -11,54 +11,54 @@ objects:
utilized items:
break array of module ‘Example’
item named ‘static_ptr1’
- item named ‘$dTypeable2’
+ item named ‘$dTypeable2_@name_suffix@’
item named ‘$fIsStaticStaticPtr’
static-construction object ‘static_ptr1’:
data constructor name: StaticPtr
lifted: yes
literals:
- word 2391484856205448807
- word 14295153105712797526
+ word @large_word@
+ word @large_word@
utilized items:
- item named ‘static_ptr1_sat’
+ item named ‘static_ptr1_sat_@name_suffix@’
item named ‘primes’
- static-construction object ‘static_ptr1_sat’:
+ static-construction object ‘static_ptr1_sat_@name_suffix@’:
data constructor name: StaticPtrInfo
lifted: yes
literals: <none>
utilized items:
- item named ‘static_ptr1_sat’
- item named ‘static_ptr1_sat’
- item named ‘static_ptr1_sat’
- ordinary object ‘static_ptr1_sat’:
+ item named ‘static_ptr1_sat_@name_suffix@’
+ item named ‘static_ptr1_sat_@name_suffix@’
+ item named ‘static_ptr1_sat_@name_suffix@’
+ ordinary object ‘static_ptr1_sat_@name_suffix@’:
arity: 0
literals: top-level string "main"
utilized items:
- ordinary object ‘static_ptr1_sat’:
+ ordinary object ‘static_ptr1_sat_@name_suffix@’:
arity: 0
literals: <none>
utilized items: item named ‘unpackCString#’
- ordinary object ‘static_ptr1_sat’:
+ ordinary object ‘static_ptr1_sat_@name_suffix@’:
arity: 0
literals: top-level string "Example"
utilized items:
- ordinary object ‘static_ptr1_sat’:
+ ordinary object ‘static_ptr1_sat_@name_suffix@’:
arity: 0
literals: <none>
utilized items: item named ‘unpackCString#’
- static-construction object ‘static_ptr1_sat’:
+ static-construction object ‘static_ptr1_sat_@name_suffix@’:
data constructor name: (,)
lifted: yes
literals: <none>
utilized items:
- item named ‘static_ptr1_sat’
- item named ‘static_ptr1_sat’
- static-construction object ‘static_ptr1_sat’:
+ item named ‘static_ptr1_sat_@name_suffix@’
+ item named ‘static_ptr1_sat_@name_suffix@’
+ static-construction object ‘static_ptr1_sat_@name_suffix@’:
data constructor name: I#
lifted: yes
literals: word 27
utilized items: <none>
- static-construction object ‘static_ptr1_sat’:
+ static-construction object ‘static_ptr1_sat_@name_suffix@’:
data constructor name: I#
lifted: yes
literals: word 20
@@ -72,7 +72,7 @@ objects:
info table of ‘:’
utilized items:
break array of module ‘Example’
- ordinary object ‘primes_sat’:
+ ordinary object ‘primes_sat_@name_suffix@’:
arity: 0
literals:
top-level string "Example"
@@ -80,11 +80,11 @@ objects:
cost center of breakpoint 1
utilized items:
break array of module ‘Example’
- ordinary object ‘primes_sat’:
+ ordinary object ‘primes_sat_@name_suffix@’:
arity: 0
literals: <none>
utilized items:
- ordinary object ‘primes_sat’:
+ ordinary object ‘primes_sat_@name_suffix@’:
arity: 0
literals:
word 3
@@ -94,9 +94,9 @@ objects:
item named ‘fromInteger’
item named ‘$fEnumNatural’
item named ‘enumFrom’
- item named ‘isPrime’
+ item named ‘isPrime_@name_suffix@’
item named ‘filter’
- ordinary object ‘primes_sat’:
+ ordinary object ‘primes_sat_@name_suffix@’:
arity: 0
literals:
word 2
@@ -104,7 +104,7 @@ objects:
utilized items:
item named ‘$fNumNatural’
item named ‘fromInteger’
- ordinary object ‘isPrime’:
+ ordinary object ‘isPrime_@name_suffix@’:
arity: 1
literals:
top-level string "Example"
@@ -112,7 +112,7 @@ objects:
cost center of breakpoint 9
utilized items:
break array of module ‘Example’
- ordinary object ‘isPrime_sat’:
+ ordinary object ‘isPrime_sat_@name_suffix@’:
arity: 1
literals:
top-level string "Example"
@@ -120,7 +120,7 @@ objects:
cost center of breakpoint 8
utilized items:
break array of module ‘Example’
- ordinary object ‘isPrime_sat’:
+ ordinary object ‘isPrime_sat_@name_suffix@’:
arity: 1
literals:
top-level string "Example"
@@ -128,7 +128,7 @@ objects:
cost center of breakpoint 7
utilized items:
break array of module ‘Example’
- ordinary object ‘isPrime_sat’:
+ ordinary object ‘isPrime_sat_@name_suffix@’:
arity: 1
literals:
top-level string "Example"
@@ -136,7 +136,7 @@ objects:
cost center of breakpoint 6
utilized items:
break array of module ‘Example’
- ordinary object ‘isPrime_sat’:
+ ordinary object ‘isPrime_sat_@name_suffix@’:
arity: 0
literals:
top-level string "Example"
@@ -146,18 +146,18 @@ objects:
info table of ‘IS’
utilized items:
break array of module ‘Example’
- ordinary object ‘v’:
+ ordinary object ‘v_@name_suffix@’:
arity: 0
literals: <none>
utilized items:
item named ‘$fIntegralInteger’
item named ‘$fNumNatural’
item named ‘^’
- ordinary object ‘pap’:
+ ordinary object ‘pap_@name_suffix@’:
arity: 3
literals: <none>
utilized items: <none>
- ordinary object ‘isPrime_sat’:
+ ordinary object ‘isPrime_sat_@name_suffix@’:
arity: 1
literals:
top-level string "Example"
@@ -165,20 +165,20 @@ objects:
cost center of breakpoint 4
utilized items:
break array of module ‘Example’
- ordinary object ‘v’:
+ ordinary object ‘v_@name_suffix@’:
arity: 0
literals: <none>
utilized items:
item named ‘$fOrdNatural’
item named ‘<=’
- ordinary object ‘pap’:
+ ordinary object ‘pap_@name_suffix@’:
arity: 3
literals: <none>
utilized items: <none>
item named ‘.’
item named ‘primes’
item named ‘takeWhile’
- ordinary object ‘isPrime_sat’:
+ ordinary object ‘isPrime_sat_@name_suffix@’:
arity: 1
literals:
top-level string "Example"
@@ -186,7 +186,7 @@ objects:
cost center of breakpoint 3
utilized items:
break array of module ‘Example’
- ordinary object ‘pap’:
+ ordinary object ‘pap_@name_suffix@’:
arity: 2
literals: <none>
utilized items:
@@ -204,54 +204,54 @@ objects:
utilized items:
break array of module ‘Example’
item named ‘static_ptr’
- item named ‘$dTypeable2’
+ item named ‘$dTypeable2_@name_suffix@’
item named ‘$fIsStaticStaticPtr’
static-construction object ‘static_ptr’:
data constructor name: StaticPtr
lifted: yes
literals:
- word 17112019464237448244
- word 14704510317759369968
+ word @large_word@
+ word @large_word@
utilized items:
- item named ‘static_ptr_sat’
+ item named ‘static_ptr_sat_@name_suffix@’
item named ‘fibonaccis’
- static-construction object ‘static_ptr_sat’:
+ static-construction object ‘static_ptr_sat_@name_suffix@’:
data constructor name: StaticPtrInfo
lifted: yes
literals: <none>
utilized items:
- item named ‘static_ptr_sat’
- item named ‘static_ptr_sat’
- item named ‘static_ptr_sat’
- ordinary object ‘static_ptr_sat’:
+ item named ‘static_ptr_sat_@name_suffix@’
+ item named ‘static_ptr_sat_@name_suffix@’
+ item named ‘static_ptr_sat_@name_suffix@’
+ ordinary object ‘static_ptr_sat_@name_suffix@’:
arity: 0
literals: top-level string "main"
utilized items:
- ordinary object ‘static_ptr_sat’:
+ ordinary object ‘static_ptr_sat_@name_suffix@’:
arity: 0
literals: <none>
utilized items: item named ‘unpackCString#’
- ordinary object ‘static_ptr_sat’:
+ ordinary object ‘static_ptr_sat_@name_suffix@’:
arity: 0
literals: top-level string "Example"
utilized items:
- ordinary object ‘static_ptr_sat’:
+ ordinary object ‘static_ptr_sat_@name_suffix@’:
arity: 0
literals: <none>
utilized items: item named ‘unpackCString#’
- static-construction object ‘static_ptr_sat’:
+ static-construction object ‘static_ptr_sat_@name_suffix@’:
data constructor name: (,)
lifted: yes
literals: <none>
utilized items:
- item named ‘static_ptr_sat’
- item named ‘static_ptr_sat’
- static-construction object ‘static_ptr_sat’:
+ item named ‘static_ptr_sat_@name_suffix@’
+ item named ‘static_ptr_sat_@name_suffix@’
+ static-construction object ‘static_ptr_sat_@name_suffix@’:
data constructor name: I#
lifted: yes
literals: word 15
utilized items: <none>
- static-construction object ‘static_ptr_sat’:
+ static-construction object ‘static_ptr_sat_@name_suffix@’:
data constructor name: I#
lifted: yes
literals: word 24
@@ -265,7 +265,7 @@ objects:
info table of ‘:’
utilized items:
break array of module ‘Example’
- ordinary object ‘fibonaccis_sat’:
+ ordinary object ‘fibonaccis_sat_@name_suffix@’:
arity: 0
literals:
word 0
@@ -273,8 +273,8 @@ objects:
utilized items:
item named ‘$fNumNatural’
item named ‘fromInteger’
- item named ‘positiveFibonaccis’
- ordinary object ‘positiveFibonaccis’:
+ item named ‘positiveFibonaccis_@name_suffix@’
+ ordinary object ‘positiveFibonaccis_@name_suffix@’:
arity: 0
literals:
top-level string "Example"
@@ -283,7 +283,7 @@ objects:
info table of ‘:’
utilized items:
break array of module ‘Example’
- ordinary object ‘positiveFibonaccis_sat’:
+ ordinary object ‘positiveFibonaccis_sat_@name_suffix@’:
arity: 0
literals:
top-level string "Example"
@@ -291,16 +291,16 @@ objects:
cost center of breakpoint 12
utilized items:
break array of module ‘Example’
- ordinary object ‘positiveFibonaccis_sat’:
+ ordinary object ‘positiveFibonaccis_sat_@name_suffix@’:
arity: 0
literals: <none>
utilized items:
item named ‘$fNumNatural’
item named ‘+’
- item named ‘positiveFibonaccis’
+ item named ‘positiveFibonaccis_@name_suffix@’
item named ‘fibonaccis’
item named ‘zipWith’
- ordinary object ‘positiveFibonaccis_sat’:
+ ordinary object ‘positiveFibonaccis_sat_@name_suffix@’:
arity: 0
literals:
word 1
@@ -308,20 +308,20 @@ objects:
utilized items:
item named ‘$fNumNatural’
item named ‘fromInteger’
- ordinary object ‘$dTypeable2’:
+ ordinary object ‘$dTypeable2_@name_suffix@’:
arity: 0
literals: <none>
utilized items:
- item named ‘$dTypeable’
- item named ‘$dTypeable1’
+ item named ‘$dTypeable_@name_suffix@’
+ item named ‘$dTypeable1_@name_suffix@’
item named ‘mkTrAppChecked’
- ordinary object ‘$dTypeable1’:
+ ordinary object ‘$dTypeable1_@name_suffix@’:
arity: 0
literals: info table of ‘[]’
utilized items:
item named ‘$tcList’
item named ‘mkTrCon’
- ordinary object ‘$dTypeable’:
+ ordinary object ‘$dTypeable_@name_suffix@’:
arity: 0
literals: info table of ‘[]’
utilized items:
@@ -331,216 +331,216 @@ objects:
data constructor name: TyCon
lifted: yes
literals:
- word 4886352401159288042
- word 15486177717927261000
+ word @large_word@
+ word @large_word@
word 1
utilized items:
item named ‘$trModule’
- item named ‘$tc'Nested2’
- item named ‘$krep17’
- static-construction object ‘$tc'Nested2’:
+ item named ‘$tc'Nested2_@name_suffix@’
+ item named ‘$krep17_@name_suffix@’
+ static-construction object ‘$tc'Nested2_@name_suffix@’:
data constructor name: TrNameS
lifted: yes
- literals: address ‘$tc'Nested1’
+ literals: address ‘$tc'Nested1_@name_suffix@’
utilized items: <none>
- static-construction object ‘$krep17’:
+ static-construction object ‘$krep17_@name_suffix@’:
data constructor name: KindRepFun
lifted: yes
literals: <none>
utilized items:
- item named ‘$krep16’
- item named ‘$krep13’
- static-construction object ‘$krep16’:
+ item named ‘$krep16_@name_suffix@’
+ item named ‘$krep13_@name_suffix@’
+ static-construction object ‘$krep16_@name_suffix@’:
data constructor name: KindRepTyConApp
lifted: yes
literals: <none>
utilized items:
item named ‘$tcPerfectTree’
- item named ‘$krep15’
- static-construction object ‘$krep15’:
+ item named ‘$krep15_@name_suffix@’
+ static-construction object ‘$krep15_@name_suffix@’:
data constructor name: :
lifted: yes
literals: <none>
utilized items:
- item named ‘$krep4’
+ item named ‘$krep4_@name_suffix@’
item named ‘[]’
static-construction object ‘$tc'PerfectTree’:
data constructor name: TyCon
lifted: yes
literals:
- word 1216274636751977258
- word 143956009589726941
+ word @large_word@
+ word @large_word@
word 1
utilized items:
item named ‘$trModule’
- item named ‘$tc'PerfectTree2’
- item named ‘$krep14’
- static-construction object ‘$tc'PerfectTree2’:
+ item named ‘$tc'PerfectTree2_@name_suffix@’
+ item named ‘$krep14_@name_suffix@’
+ static-construction object ‘$tc'PerfectTree2_@name_suffix@’:
data constructor name: TrNameS
lifted: yes
- literals: address ‘$tc'PerfectTree1’
+ literals: address ‘$tc'PerfectTree1_@name_suffix@’
utilized items: <none>
- static-construction object ‘$krep14’:
+ static-construction object ‘$krep14_@name_suffix@’:
data constructor name: KindRepFun
lifted: yes
literals: <none>
utilized items:
- item named ‘$krep1’
- item named ‘$krep13’
- static-construction object ‘$krep13’:
+ item named ‘$krep1_@name_suffix@’
+ item named ‘$krep13_@name_suffix@’
+ static-construction object ‘$krep13_@name_suffix@’:
data constructor name: KindRepTyConApp
lifted: yes
literals: <none>
utilized items:
item named ‘$tcPerfectTree’
- item named ‘$krep12’
- static-construction object ‘$krep12’:
+ item named ‘$krep12_@name_suffix@’
+ static-construction object ‘$krep12_@name_suffix@’:
data constructor name: :
lifted: yes
literals: <none>
utilized items:
- item named ‘$krep1’
+ item named ‘$krep1_@name_suffix@’
item named ‘[]’
static-construction object ‘$tcPerfectTree’:
data constructor name: TyCon
lifted: yes
literals:
- word 11330648440307610868
- word 17396431681782259314
+ word @large_word@
+ word @large_word@
word 0
utilized items:
item named ‘$trModule’
- item named ‘$tcPerfectTree2’
+ item named ‘$tcPerfectTree2_@name_suffix@’
item named ‘krep$*Arr*’
- static-construction object ‘$tcPerfectTree2’:
+ static-construction object ‘$tcPerfectTree2_@name_suffix@’:
data constructor name: TrNameS
lifted: yes
- literals: address ‘$tcPerfectTree1’
+ literals: address ‘$tcPerfectTree1_@name_suffix@’
utilized items: <none>
static-construction object ‘$tc'Node’:
data constructor name: TyCon
lifted: yes
literals:
- word 2884468726215238492
- word 558166382591591938
+ word @large_word@
+ word @large_word@
word 2
utilized items:
item named ‘$trModule’
- item named ‘$tc'Node2’
- item named ‘$krep11’
- static-construction object ‘$tc'Node2’:
+ item named ‘$tc'Node2_@name_suffix@’
+ item named ‘$krep11_@name_suffix@’
+ static-construction object ‘$tc'Node2_@name_suffix@’:
data constructor name: TrNameS
lifted: yes
- literals: address ‘$tc'Node1’
+ literals: address ‘$tc'Node1_@name_suffix@’
utilized items: <none>
- static-construction object ‘$krep11’:
+ static-construction object ‘$krep11_@name_suffix@’:
data constructor name: KindRepFun
lifted: yes
literals: <none>
utilized items:
- item named ‘$krep7’
- item named ‘$krep10’
- static-construction object ‘$krep10’:
+ item named ‘$krep7_@name_suffix@’
+ item named ‘$krep10_@name_suffix@’
+ static-construction object ‘$krep10_@name_suffix@’:
data constructor name: KindRepFun
lifted: yes
literals: <none>
utilized items:
- item named ‘$krep’
- item named ‘$krep9’
- static-construction object ‘$krep9’:
+ item named ‘$krep_@name_suffix@’
+ item named ‘$krep9_@name_suffix@’
+ static-construction object ‘$krep9_@name_suffix@’:
data constructor name: KindRepFun
lifted: yes
literals: <none>
utilized items:
- item named ‘$krep7’
- item named ‘$krep7’
+ item named ‘$krep7_@name_suffix@’
+ item named ‘$krep7_@name_suffix@’
static-construction object ‘$tc'Leaf’:
data constructor name: TyCon
lifted: yes
literals:
- word 7677223365245394977
- word 14318463004604079067
+ word @large_word@
+ word @large_word@
word 2
utilized items:
item named ‘$trModule’
- item named ‘$tc'Leaf2’
- item named ‘$krep8’
- static-construction object ‘$tc'Leaf2’:
+ item named ‘$tc'Leaf2_@name_suffix@’
+ item named ‘$krep8_@name_suffix@’
+ static-construction object ‘$tc'Leaf2_@name_suffix@’:
data constructor name: TrNameS
lifted: yes
- literals: address ‘$tc'Leaf1’
+ literals: address ‘$tc'Leaf1_@name_suffix@’
utilized items: <none>
- static-construction object ‘$krep8’:
+ static-construction object ‘$krep8_@name_suffix@’:
data constructor name: KindRepFun
lifted: yes
literals: <none>
utilized items:
- item named ‘$krep1’
- item named ‘$krep7’
- static-construction object ‘$krep7’:
+ item named ‘$krep1_@name_suffix@’
+ item named ‘$krep7_@name_suffix@’
+ static-construction object ‘$krep7_@name_suffix@’:
data constructor name: KindRepTyConApp
lifted: yes
literals: <none>
utilized items:
item named ‘$tcBinTree’
- item named ‘$krep6’
- static-construction object ‘$krep6’:
+ item named ‘$krep6_@name_suffix@’
+ static-construction object ‘$krep6_@name_suffix@’:
data constructor name: :
lifted: yes
literals: <none>
utilized items:
- item named ‘$krep1’
- item named ‘$krep5’
- static-construction object ‘$krep5’:
+ item named ‘$krep1_@name_suffix@’
+ item named ‘$krep5_@name_suffix@’
+ static-construction object ‘$krep5_@name_suffix@’:
data constructor name: :
lifted: yes
literals: <none>
utilized items:
- item named ‘$krep’
+ item named ‘$krep_@name_suffix@’
item named ‘[]’
static-construction object ‘$tcBinTree’:
data constructor name: TyCon
lifted: yes
literals:
- word 9824011489556756898
- word 1356349741031249981
+ word @large_word@
+ word @large_word@
word 0
utilized items:
item named ‘$trModule’
- item named ‘$tcBinTree2’
+ item named ‘$tcBinTree2_@name_suffix@’
item named ‘krep$*->*->*’
- static-construction object ‘$tcBinTree2’:
+ static-construction object ‘$tcBinTree2_@name_suffix@’:
data constructor name: TrNameS
lifted: yes
- literals: address ‘$tcBinTree1’
+ literals: address ‘$tcBinTree1_@name_suffix@’
utilized items: <none>
- static-construction object ‘$krep4’:
+ static-construction object ‘$krep4_@name_suffix@’:
data constructor name: KindRepTyConApp
lifted: yes
literals: <none>
utilized items:
item named ‘$tcTuple2’
- item named ‘$krep3’
- static-construction object ‘$krep3’:
+ item named ‘$krep3_@name_suffix@’
+ static-construction object ‘$krep3_@name_suffix@’:
data constructor name: :
lifted: yes
literals: <none>
utilized items:
- item named ‘$krep1’
- item named ‘$krep2’
- static-construction object ‘$krep2’:
+ item named ‘$krep1_@name_suffix@’
+ item named ‘$krep2_@name_suffix@’
+ static-construction object ‘$krep2_@name_suffix@’:
data constructor name: :
lifted: yes
literals: <none>
utilized items:
- item named ‘$krep1’
+ item named ‘$krep1_@name_suffix@’
item named ‘[]’
- static-construction object ‘$krep1’:
+ static-construction object ‘$krep1_@name_suffix@’:
data constructor name: KindRepVar
lifted: yes
literals: word 0
utilized items: <none>
- static-construction object ‘$krep’:
+ static-construction object ‘$krep_@name_suffix@’:
data constructor name: KindRepVar
lifted: yes
literals: word 1
@@ -550,39 +550,39 @@ objects:
lifted: yes
literals: <none>
utilized items:
- item named ‘$trModule2’
- item named ‘$trModule4’
- static-construction object ‘$trModule4’:
+ item named ‘$trModule2_@name_suffix@’
+ item named ‘$trModule4_@name_suffix@’
+ static-construction object ‘$trModule4_@name_suffix@’:
data constructor name: TrNameS
lifted: yes
- literals: address ‘$trModule3’
+ literals: address ‘$trModule3_@name_suffix@’
utilized items: <none>
- static-construction object ‘$trModule2’:
+ static-construction object ‘$trModule2_@name_suffix@’:
data constructor name: TrNameS
lifted: yes
- literals: address ‘$trModule1’
+ literals: address ‘$trModule1_@name_suffix@’
utilized items: <none>
ordinary object ‘divides’:
arity: 3
literals: <none>
utilized items:
- ordinary object ‘$dReal’:
+ ordinary object ‘$dReal_@name_suffix@’:
arity: 0
literals: <none>
utilized items:
- ordinary object ‘$dNum’:
+ ordinary object ‘$dNum_@name_suffix@’:
arity: 0
literals: <none>
utilized items:
- ordinary object ‘$dEq’:
+ ordinary object ‘$dEq_@name_suffix@’:
arity: 0
literals: <none>
utilized items:
- ordinary object ‘$dEq1’:
+ ordinary object ‘$dEq1_@name_suffix@’:
arity: 0
literals: <none>
utilized items:
- ordinary object ‘bcprep’:
+ ordinary object ‘bcprep_@name_suffix@’:
arity: 5
literals:
top-level string "Example"
@@ -590,13 +590,13 @@ objects:
cost center of breakpoint 15
utilized items:
break array of module ‘Example’
- ordinary object ‘divides_sat’:
+ ordinary object ‘divides_sat_@name_suffix@’:
arity: 1
literals:
word 0
info table of ‘IS’
utilized items: item named ‘fromInteger’
- ordinary object ‘divides_sat’:
+ ordinary object ‘divides_sat_@name_suffix@’:
arity: 3
literals:
top-level string "Example"
@@ -640,14 +640,14 @@ data constructor info tables:
number of words for pointers: 3
number of words for non-pointers: 0
top-level strings:
- $tc'Nested1: "'Nested"
- $tc'PerfectTree1: "'PerfectTree"
- $tcPerfectTree1: "PerfectTree"
- $tc'Node1: "'Node"
- $tc'Leaf1: "'Leaf"
- $tcBinTree1: "BinTree"
- $trModule3: "Example"
- $trModule1: "main"
+ $tc'Nested1_@name_suffix@: "'Nested"
+ $tc'PerfectTree1_@name_suffix@: "'PerfectTree"
+ $tcPerfectTree1_@name_suffix@: "PerfectTree"
+ $tc'Node1_@name_suffix@: "'Node"
+ $tc'Leaf1_@name_suffix@: "'Leaf"
+ $tcBinTree1_@name_suffix@: "BinTree"
+ $trModule3_@name_suffix@: "Example"
+ $trModule1_@name_suffix@: "main"
breakpoints:
source breakpoints:
source breakpoint 0:
@@ -822,7 +822,7 @@ breakpoints:
%'Many eta1 :: a
corresponding source breakpoint: 1
static-pointer table entries:
- ed7a1b0a13717c34cc10ea39e61d12f0: static_ptr
- 213042ce5bda1667c6629602bbd55756: static_ptr1
+ @hash@: static_ptr
+ @hash@: static_ptr1
HPC information: <none>
=====================================
testsuite/tests/show-bytecode/show-bytecode-hpc.stdout
=====================================
@@ -1,6 +1,6 @@
[1 of 1] Compiling Example ( Example.hs, Example.gbc )
name: Example
-hash: f980f4ded430c2b38783bc705ca167a5
+hash: @hash@
objects:
ordinary object ‘primesPtr’:
arity: 0
@@ -9,71 +9,71 @@ objects:
label ‘_hpc_tickboxes_Example_hpc’
utilized items:
item named ‘static_ptr1’
- item named ‘$dTypeable2’
+ item named ‘$dTypeable2_@name_suffix@’
item named ‘$fIsStaticStaticPtr’
static-construction object ‘static_ptr1’:
data constructor name: StaticPtr
lifted: yes
literals:
- word 2391484856205448807
- word 14295153105712797526
+ word @large_word@
+ word @large_word@
utilized items:
- item named ‘static_ptr1_sat’
- item named ‘static_ptr1_sat’
- static-construction object ‘static_ptr1_sat’:
+ item named ‘static_ptr1_sat_@name_suffix@’
+ item named ‘static_ptr1_sat_@name_suffix@’
+ static-construction object ‘static_ptr1_sat_@name_suffix@’:
data constructor name: StaticPtrInfo
lifted: yes
literals: <none>
utilized items:
- item named ‘static_ptr1_sat’
- item named ‘static_ptr1_sat’
- item named ‘static_ptr1_sat’
- ordinary object ‘static_ptr1_sat’:
+ item named ‘static_ptr1_sat_@name_suffix@’
+ item named ‘static_ptr1_sat_@name_suffix@’
+ item named ‘static_ptr1_sat_@name_suffix@’
+ ordinary object ‘static_ptr1_sat_@name_suffix@’:
arity: 0
literals: top-level string "main"
utilized items:
- ordinary object ‘static_ptr1_sat’:
+ ordinary object ‘static_ptr1_sat_@name_suffix@’:
arity: 0
literals: <none>
utilized items: item named ‘unpackCString#’
- ordinary object ‘static_ptr1_sat’:
+ ordinary object ‘static_ptr1_sat_@name_suffix@’:
arity: 0
literals: top-level string "Example"
utilized items:
- ordinary object ‘static_ptr1_sat’:
+ ordinary object ‘static_ptr1_sat_@name_suffix@’:
arity: 0
literals: <none>
utilized items: item named ‘unpackCString#’
- static-construction object ‘static_ptr1_sat’:
+ static-construction object ‘static_ptr1_sat_@name_suffix@’:
data constructor name: (,)
lifted: yes
literals: <none>
utilized items:
- item named ‘static_ptr1_sat’
- item named ‘static_ptr1_sat’
- static-construction object ‘static_ptr1_sat’:
+ item named ‘static_ptr1_sat_@name_suffix@’
+ item named ‘static_ptr1_sat_@name_suffix@’
+ static-construction object ‘static_ptr1_sat_@name_suffix@’:
data constructor name: I#
lifted: yes
literals: word 27
utilized items: <none>
- static-construction object ‘static_ptr1_sat’:
+ static-construction object ‘static_ptr1_sat_@name_suffix@’:
data constructor name: I#
lifted: yes
literals: word 20
utilized items: <none>
- ordinary object ‘static_ptr1_sat’:
+ ordinary object ‘static_ptr1_sat_@name_suffix@’:
arity: 0
literals: label ‘_hpc_tickboxes_Example_hpc’
utilized items: item named ‘primes’
- ordinary object ‘primes2’:
+ ordinary object ‘primes2_@name_suffix@’:
arity: 0
literals: label ‘_hpc_tickboxes_Example_hpc’
utilized items:
- ordinary object ‘primes2_sat’:
+ ordinary object ‘primes2_sat_@name_suffix@’:
arity: 0
literals: label ‘_hpc_tickboxes_Example_hpc’
utilized items:
- ordinary object ‘primes2_sat’:
+ ordinary object ‘primes2_sat_@name_suffix@’:
arity: 0
literals:
label ‘_hpc_tickboxes_Example_hpc’
@@ -84,94 +84,94 @@ objects:
item named ‘fromInteger’
item named ‘$fEnumNatural’
item named ‘enumFrom’
- ordinary object ‘primes2_sat’:
+ ordinary object ‘primes2_sat_@name_suffix@’:
arity: 0
literals: label ‘_hpc_tickboxes_Example_hpc’
- utilized items: item named ‘isPrime’
+ utilized items: item named ‘isPrime_@name_suffix@’
item named ‘filter’
- ordinary object ‘isPrime’:
+ ordinary object ‘isPrime_@name_suffix@’:
arity: 1
literals:
label ‘_hpc_tickboxes_Example_hpc’
label ‘_hpc_tickboxes_Example_hpc’
utilized items:
- ordinary object ‘isPrime_sat’:
+ ordinary object ‘isPrime_sat_@name_suffix@’:
arity: 1
literals: label ‘_hpc_tickboxes_Example_hpc’
utilized items:
- ordinary object ‘isPrime_sat’:
+ ordinary object ‘isPrime_sat_@name_suffix@’:
arity: 1
literals: label ‘_hpc_tickboxes_Example_hpc’
utilized items:
- ordinary object ‘isPrime_sat’:
+ ordinary object ‘isPrime_sat_@name_suffix@’:
arity: 0
literals: label ‘_hpc_tickboxes_Example_hpc’
utilized items: item named ‘primes’
- ordinary object ‘isPrime_sat’:
+ ordinary object ‘isPrime_sat_@name_suffix@’:
arity: 1
literals: label ‘_hpc_tickboxes_Example_hpc’
utilized items:
- ordinary object ‘isPrime_sat’:
+ ordinary object ‘isPrime_sat_@name_suffix@’:
arity: 0
literals: label ‘_hpc_tickboxes_Example_hpc’
utilized items:
- ordinary object ‘v’:
+ ordinary object ‘v_@name_suffix@’:
arity: 0
literals: label ‘_hpc_tickboxes_Example_hpc’
utilized items:
item named ‘$fIntegralInteger’
item named ‘$fNumNatural’
item named ‘^’
- ordinary object ‘v1’:
+ ordinary object ‘v1_@name_suffix@’:
arity: 0
literals:
label ‘_hpc_tickboxes_Example_hpc’
word 2
info table of ‘IS’
utilized items: <none>
- ordinary object ‘pap’:
+ ordinary object ‘pap_@name_suffix@’:
arity: 3
literals: <none>
utilized items: <none>
- ordinary object ‘isPrime_sat’:
+ ordinary object ‘isPrime_sat_@name_suffix@’:
arity: 1
literals: label ‘_hpc_tickboxes_Example_hpc’
utilized items:
- ordinary object ‘v’:
+ ordinary object ‘v_@name_suffix@’:
arity: 0
literals: label ‘_hpc_tickboxes_Example_hpc’
utilized items:
item named ‘$fOrdNatural’
item named ‘<=’
- ordinary object ‘v1’:
+ ordinary object ‘v1_@name_suffix@’:
arity: 1
literals: label ‘_hpc_tickboxes_Example_hpc’
utilized items: <none>
- ordinary object ‘pap’:
+ ordinary object ‘pap_@name_suffix@’:
arity: 3
literals: <none>
utilized items: <none>
item named ‘.’
item named ‘takeWhile’
- ordinary object ‘isPrime_sat’:
+ ordinary object ‘isPrime_sat_@name_suffix@’:
arity: 1
literals: label ‘_hpc_tickboxes_Example_hpc’
utilized items:
- ordinary object ‘v’:
+ ordinary object ‘v_@name_suffix@’:
arity: 0
literals: label ‘_hpc_tickboxes_Example_hpc’
utilized items:
- ordinary object ‘pap’:
+ ordinary object ‘pap_@name_suffix@’:
arity: 2
literals: <none>
utilized items:
item named ‘$fIntegralNatural’
item named ‘divides’
- ordinary object ‘v1’:
+ ordinary object ‘v1_@name_suffix@’:
arity: 1
literals: label ‘_hpc_tickboxes_Example_hpc’
utilized items: <none>
- ordinary object ‘pap’:
+ ordinary object ‘pap_@name_suffix@’:
arity: 3
literals: <none>
utilized items: <none>
@@ -185,9 +185,9 @@ objects:
label ‘_hpc_tickboxes_Example_hpc’
info table of ‘:’
utilized items:
- item named ‘primes2’
- item named ‘primes1’
- ordinary object ‘primes1’:
+ item named ‘primes2_@name_suffix@’
+ item named ‘primes1_@name_suffix@’
+ ordinary object ‘primes1_@name_suffix@’:
arity: 0
literals:
label ‘_hpc_tickboxes_Example_hpc’
@@ -203,84 +203,84 @@ objects:
label ‘_hpc_tickboxes_Example_hpc’
utilized items:
item named ‘static_ptr’
- item named ‘$dTypeable2’
+ item named ‘$dTypeable2_@name_suffix@’
item named ‘$fIsStaticStaticPtr’
static-construction object ‘static_ptr’:
data constructor name: StaticPtr
lifted: yes
literals:
- word 17112019464237448244
- word 14704510317759369968
+ word @large_word@
+ word @large_word@
utilized items:
- item named ‘static_ptr_sat’
- item named ‘static_ptr_sat’
- static-construction object ‘static_ptr_sat’:
+ item named ‘static_ptr_sat_@name_suffix@’
+ item named ‘static_ptr_sat_@name_suffix@’
+ static-construction object ‘static_ptr_sat_@name_suffix@’:
data constructor name: StaticPtrInfo
lifted: yes
literals: <none>
utilized items:
- item named ‘static_ptr_sat’
- item named ‘static_ptr_sat’
- item named ‘static_ptr_sat’
- ordinary object ‘static_ptr_sat’:
+ item named ‘static_ptr_sat_@name_suffix@’
+ item named ‘static_ptr_sat_@name_suffix@’
+ item named ‘static_ptr_sat_@name_suffix@’
+ ordinary object ‘static_ptr_sat_@name_suffix@’:
arity: 0
literals: top-level string "main"
utilized items:
- ordinary object ‘static_ptr_sat’:
+ ordinary object ‘static_ptr_sat_@name_suffix@’:
arity: 0
literals: <none>
utilized items: item named ‘unpackCString#’
- ordinary object ‘static_ptr_sat’:
+ ordinary object ‘static_ptr_sat_@name_suffix@’:
arity: 0
literals: top-level string "Example"
utilized items:
- ordinary object ‘static_ptr_sat’:
+ ordinary object ‘static_ptr_sat_@name_suffix@’:
arity: 0
literals: <none>
utilized items: item named ‘unpackCString#’
- static-construction object ‘static_ptr_sat’:
+ static-construction object ‘static_ptr_sat_@name_suffix@’:
data constructor name: (,)
lifted: yes
literals: <none>
utilized items:
- item named ‘static_ptr_sat’
- item named ‘static_ptr_sat’
- static-construction object ‘static_ptr_sat’:
+ item named ‘static_ptr_sat_@name_suffix@’
+ item named ‘static_ptr_sat_@name_suffix@’
+ static-construction object ‘static_ptr_sat_@name_suffix@’:
data constructor name: I#
lifted: yes
literals: word 15
utilized items: <none>
- static-construction object ‘static_ptr_sat’:
+ static-construction object ‘static_ptr_sat_@name_suffix@’:
data constructor name: I#
lifted: yes
literals: word 24
utilized items: <none>
- ordinary object ‘static_ptr_sat’:
+ ordinary object ‘static_ptr_sat_@name_suffix@’:
arity: 0
literals: label ‘_hpc_tickboxes_Example_hpc’
utilized items: item named ‘fibonaccis’
- ordinary object ‘positiveFibonaccis1’:
+ ordinary object ‘positiveFibonaccis1_@name_suffix@’:
arity: 0
literals:
label ‘_hpc_tickboxes_Example_hpc’
label ‘_hpc_tickboxes_Example_hpc’
info table of ‘:’
utilized items:
- item named ‘positiveFibonaccis2’
- item named ‘positiveFibonaccis’
- ordinary object ‘positiveFibonaccis2’:
+ item named ‘positiveFibonaccis2_@name_suffix@’
+ item named ‘positiveFibonaccis_@name_suffix@’
+ ordinary object ‘positiveFibonaccis2_@name_suffix@’:
arity: 0
literals: label ‘_hpc_tickboxes_Example_hpc’
utilized items:
- ordinary object ‘positiveFibonaccis2_sat’:
+ ordinary object ‘positiveFibonaccis2_sat_@name_suffix@’:
arity: 0
literals: label ‘_hpc_tickboxes_Example_hpc’
- utilized items: item named ‘positiveFibonaccis1’
- ordinary object ‘positiveFibonaccis2_sat’:
+ utilized items: item named ‘positiveFibonaccis1_@name_suffix@’
+ ordinary object ‘positiveFibonaccis2_sat_@name_suffix@’:
arity: 0
literals: label ‘_hpc_tickboxes_Example_hpc’
utilized items: item named ‘fibonaccis’
- ordinary object ‘positiveFibonaccis2_sat’:
+ ordinary object ‘positiveFibonaccis2_sat_@name_suffix@’:
arity: 0
literals: label ‘_hpc_tickboxes_Example_hpc’
utilized items:
@@ -294,13 +294,13 @@ objects:
label ‘_hpc_tickboxes_Example_hpc’
info table of ‘:’
utilized items:
- item named ‘fibonaccis2’
- item named ‘fibonaccis1’
- ordinary object ‘fibonaccis2’:
+ item named ‘fibonaccis2_@name_suffix@’
+ item named ‘fibonaccis1_@name_suffix@’
+ ordinary object ‘fibonaccis2_@name_suffix@’:
arity: 0
literals: label ‘_hpc_tickboxes_Example_hpc’
- utilized items: item named ‘positiveFibonaccis1’
- ordinary object ‘positiveFibonaccis’:
+ utilized items: item named ‘positiveFibonaccis1_@name_suffix@’
+ ordinary object ‘positiveFibonaccis_@name_suffix@’:
arity: 0
literals:
label ‘_hpc_tickboxes_Example_hpc’
@@ -309,7 +309,7 @@ objects:
utilized items:
item named ‘$fNumNatural’
item named ‘fromInteger’
- ordinary object ‘fibonaccis1’:
+ ordinary object ‘fibonaccis1_@name_suffix@’:
arity: 0
literals:
label ‘_hpc_tickboxes_Example_hpc’
@@ -318,20 +318,20 @@ objects:
utilized items:
item named ‘$fNumNatural’
item named ‘fromInteger’
- ordinary object ‘$dTypeable2’:
+ ordinary object ‘$dTypeable2_@name_suffix@’:
arity: 0
literals: <none>
utilized items:
- item named ‘$dTypeable’
- item named ‘$dTypeable1’
+ item named ‘$dTypeable_@name_suffix@’
+ item named ‘$dTypeable1_@name_suffix@’
item named ‘mkTrAppChecked’
- ordinary object ‘$dTypeable1’:
+ ordinary object ‘$dTypeable1_@name_suffix@’:
arity: 0
literals: info table of ‘[]’
utilized items:
item named ‘$tcList’
item named ‘mkTrCon’
- ordinary object ‘$dTypeable’:
+ ordinary object ‘$dTypeable_@name_suffix@’:
arity: 0
literals: info table of ‘[]’
utilized items:
@@ -341,216 +341,216 @@ objects:
data constructor name: TyCon
lifted: yes
literals:
- word 4886352401159288042
- word 15486177717927261000
+ word @large_word@
+ word @large_word@
word 1
utilized items:
item named ‘$trModule’
- item named ‘$tc'Nested2’
- item named ‘$krep17’
- static-construction object ‘$tc'Nested2’:
+ item named ‘$tc'Nested2_@name_suffix@’
+ item named ‘$krep17_@name_suffix@’
+ static-construction object ‘$tc'Nested2_@name_suffix@’:
data constructor name: TrNameS
lifted: yes
- literals: address ‘$tc'Nested1’
+ literals: address ‘$tc'Nested1_@name_suffix@’
utilized items: <none>
- static-construction object ‘$krep17’:
+ static-construction object ‘$krep17_@name_suffix@’:
data constructor name: KindRepFun
lifted: yes
literals: <none>
utilized items:
- item named ‘$krep16’
- item named ‘$krep13’
- static-construction object ‘$krep16’:
+ item named ‘$krep16_@name_suffix@’
+ item named ‘$krep13_@name_suffix@’
+ static-construction object ‘$krep16_@name_suffix@’:
data constructor name: KindRepTyConApp
lifted: yes
literals: <none>
utilized items:
item named ‘$tcPerfectTree’
- item named ‘$krep15’
- static-construction object ‘$krep15’:
+ item named ‘$krep15_@name_suffix@’
+ static-construction object ‘$krep15_@name_suffix@’:
data constructor name: :
lifted: yes
literals: <none>
utilized items:
- item named ‘$krep4’
+ item named ‘$krep4_@name_suffix@’
item named ‘[]’
static-construction object ‘$tc'PerfectTree’:
data constructor name: TyCon
lifted: yes
literals:
- word 1216274636751977258
- word 143956009589726941
+ word @large_word@
+ word @large_word@
word 1
utilized items:
item named ‘$trModule’
- item named ‘$tc'PerfectTree2’
- item named ‘$krep14’
- static-construction object ‘$tc'PerfectTree2’:
+ item named ‘$tc'PerfectTree2_@name_suffix@’
+ item named ‘$krep14_@name_suffix@’
+ static-construction object ‘$tc'PerfectTree2_@name_suffix@’:
data constructor name: TrNameS
lifted: yes
- literals: address ‘$tc'PerfectTree1’
+ literals: address ‘$tc'PerfectTree1_@name_suffix@’
utilized items: <none>
- static-construction object ‘$krep14’:
+ static-construction object ‘$krep14_@name_suffix@’:
data constructor name: KindRepFun
lifted: yes
literals: <none>
utilized items:
- item named ‘$krep1’
- item named ‘$krep13’
- static-construction object ‘$krep13’:
+ item named ‘$krep1_@name_suffix@’
+ item named ‘$krep13_@name_suffix@’
+ static-construction object ‘$krep13_@name_suffix@’:
data constructor name: KindRepTyConApp
lifted: yes
literals: <none>
utilized items:
item named ‘$tcPerfectTree’
- item named ‘$krep12’
- static-construction object ‘$krep12’:
+ item named ‘$krep12_@name_suffix@’
+ static-construction object ‘$krep12_@name_suffix@’:
data constructor name: :
lifted: yes
literals: <none>
utilized items:
- item named ‘$krep1’
+ item named ‘$krep1_@name_suffix@’
item named ‘[]’
static-construction object ‘$tcPerfectTree’:
data constructor name: TyCon
lifted: yes
literals:
- word 11330648440307610868
- word 17396431681782259314
+ word @large_word@
+ word @large_word@
word 0
utilized items:
item named ‘$trModule’
- item named ‘$tcPerfectTree2’
+ item named ‘$tcPerfectTree2_@name_suffix@’
item named ‘krep$*Arr*’
- static-construction object ‘$tcPerfectTree2’:
+ static-construction object ‘$tcPerfectTree2_@name_suffix@’:
data constructor name: TrNameS
lifted: yes
- literals: address ‘$tcPerfectTree1’
+ literals: address ‘$tcPerfectTree1_@name_suffix@’
utilized items: <none>
static-construction object ‘$tc'Node’:
data constructor name: TyCon
lifted: yes
literals:
- word 2884468726215238492
- word 558166382591591938
+ word @large_word@
+ word @large_word@
word 2
utilized items:
item named ‘$trModule’
- item named ‘$tc'Node2’
- item named ‘$krep11’
- static-construction object ‘$tc'Node2’:
+ item named ‘$tc'Node2_@name_suffix@’
+ item named ‘$krep11_@name_suffix@’
+ static-construction object ‘$tc'Node2_@name_suffix@’:
data constructor name: TrNameS
lifted: yes
- literals: address ‘$tc'Node1’
+ literals: address ‘$tc'Node1_@name_suffix@’
utilized items: <none>
- static-construction object ‘$krep11’:
+ static-construction object ‘$krep11_@name_suffix@’:
data constructor name: KindRepFun
lifted: yes
literals: <none>
utilized items:
- item named ‘$krep7’
- item named ‘$krep10’
- static-construction object ‘$krep10’:
+ item named ‘$krep7_@name_suffix@’
+ item named ‘$krep10_@name_suffix@’
+ static-construction object ‘$krep10_@name_suffix@’:
data constructor name: KindRepFun
lifted: yes
literals: <none>
utilized items:
- item named ‘$krep’
- item named ‘$krep9’
- static-construction object ‘$krep9’:
+ item named ‘$krep_@name_suffix@’
+ item named ‘$krep9_@name_suffix@’
+ static-construction object ‘$krep9_@name_suffix@’:
data constructor name: KindRepFun
lifted: yes
literals: <none>
utilized items:
- item named ‘$krep7’
- item named ‘$krep7’
+ item named ‘$krep7_@name_suffix@’
+ item named ‘$krep7_@name_suffix@’
static-construction object ‘$tc'Leaf’:
data constructor name: TyCon
lifted: yes
literals:
- word 7677223365245394977
- word 14318463004604079067
+ word @large_word@
+ word @large_word@
word 2
utilized items:
item named ‘$trModule’
- item named ‘$tc'Leaf2’
- item named ‘$krep8’
- static-construction object ‘$tc'Leaf2’:
+ item named ‘$tc'Leaf2_@name_suffix@’
+ item named ‘$krep8_@name_suffix@’
+ static-construction object ‘$tc'Leaf2_@name_suffix@’:
data constructor name: TrNameS
lifted: yes
- literals: address ‘$tc'Leaf1’
+ literals: address ‘$tc'Leaf1_@name_suffix@’
utilized items: <none>
- static-construction object ‘$krep8’:
+ static-construction object ‘$krep8_@name_suffix@’:
data constructor name: KindRepFun
lifted: yes
literals: <none>
utilized items:
- item named ‘$krep1’
- item named ‘$krep7’
- static-construction object ‘$krep7’:
+ item named ‘$krep1_@name_suffix@’
+ item named ‘$krep7_@name_suffix@’
+ static-construction object ‘$krep7_@name_suffix@’:
data constructor name: KindRepTyConApp
lifted: yes
literals: <none>
utilized items:
item named ‘$tcBinTree’
- item named ‘$krep6’
- static-construction object ‘$krep6’:
+ item named ‘$krep6_@name_suffix@’
+ static-construction object ‘$krep6_@name_suffix@’:
data constructor name: :
lifted: yes
literals: <none>
utilized items:
- item named ‘$krep1’
- item named ‘$krep5’
- static-construction object ‘$krep5’:
+ item named ‘$krep1_@name_suffix@’
+ item named ‘$krep5_@name_suffix@’
+ static-construction object ‘$krep5_@name_suffix@’:
data constructor name: :
lifted: yes
literals: <none>
utilized items:
- item named ‘$krep’
+ item named ‘$krep_@name_suffix@’
item named ‘[]’
static-construction object ‘$tcBinTree’:
data constructor name: TyCon
lifted: yes
literals:
- word 9824011489556756898
- word 1356349741031249981
+ word @large_word@
+ word @large_word@
word 0
utilized items:
item named ‘$trModule’
- item named ‘$tcBinTree2’
+ item named ‘$tcBinTree2_@name_suffix@’
item named ‘krep$*->*->*’
- static-construction object ‘$tcBinTree2’:
+ static-construction object ‘$tcBinTree2_@name_suffix@’:
data constructor name: TrNameS
lifted: yes
- literals: address ‘$tcBinTree1’
+ literals: address ‘$tcBinTree1_@name_suffix@’
utilized items: <none>
- static-construction object ‘$krep4’:
+ static-construction object ‘$krep4_@name_suffix@’:
data constructor name: KindRepTyConApp
lifted: yes
literals: <none>
utilized items:
item named ‘$tcTuple2’
- item named ‘$krep3’
- static-construction object ‘$krep3’:
+ item named ‘$krep3_@name_suffix@’
+ static-construction object ‘$krep3_@name_suffix@’:
data constructor name: :
lifted: yes
literals: <none>
utilized items:
- item named ‘$krep1’
- item named ‘$krep2’
- static-construction object ‘$krep2’:
+ item named ‘$krep1_@name_suffix@’
+ item named ‘$krep2_@name_suffix@’
+ static-construction object ‘$krep2_@name_suffix@’:
data constructor name: :
lifted: yes
literals: <none>
utilized items:
- item named ‘$krep1’
+ item named ‘$krep1_@name_suffix@’
item named ‘[]’
- static-construction object ‘$krep1’:
+ static-construction object ‘$krep1_@name_suffix@’:
data constructor name: KindRepVar
lifted: yes
literals: word 0
utilized items: <none>
- static-construction object ‘$krep’:
+ static-construction object ‘$krep_@name_suffix@’:
data constructor name: KindRepVar
lifted: yes
literals: word 1
@@ -560,58 +560,58 @@ objects:
lifted: yes
literals: <none>
utilized items:
- item named ‘$trModule2’
- item named ‘$trModule4’
- static-construction object ‘$trModule4’:
+ item named ‘$trModule2_@name_suffix@’
+ item named ‘$trModule4_@name_suffix@’
+ static-construction object ‘$trModule4_@name_suffix@’:
data constructor name: TrNameS
lifted: yes
- literals: address ‘$trModule3’
+ literals: address ‘$trModule3_@name_suffix@’
utilized items: <none>
- static-construction object ‘$trModule2’:
+ static-construction object ‘$trModule2_@name_suffix@’:
data constructor name: TrNameS
lifted: yes
- literals: address ‘$trModule1’
+ literals: address ‘$trModule1_@name_suffix@’
utilized items: <none>
ordinary object ‘divides’:
arity: 3
literals: <none>
utilized items:
- ordinary object ‘$dReal’:
+ ordinary object ‘$dReal_@name_suffix@’:
arity: 0
literals:
label ‘_hpc_tickboxes_Example_hpc’
label ‘_hpc_tickboxes_Example_hpc’
utilized items:
- ordinary object ‘divides_sat’:
+ ordinary object ‘divides_sat_@name_suffix@’:
arity: 1
literals:
label ‘_hpc_tickboxes_Example_hpc’
word 0
info table of ‘IS’
utilized items:
- ordinary object ‘divides_sat’:
+ ordinary object ‘divides_sat_@name_suffix@’:
arity: 0
literals: <none>
utilized items: item named ‘fromInteger’
item named ‘$p1Real’
- ordinary object ‘divides_sat’:
+ ordinary object ‘divides_sat_@name_suffix@’:
arity: 3
literals: label ‘_hpc_tickboxes_Example_hpc’
utilized items:
- ordinary object ‘divides_sat’:
+ ordinary object ‘divides_sat_@name_suffix@’:
arity: 1
literals: label ‘_hpc_tickboxes_Example_hpc’
utilized items: <none>
- ordinary object ‘divides_sat’:
+ ordinary object ‘divides_sat_@name_suffix@’:
arity: 1
literals: label ‘_hpc_tickboxes_Example_hpc’
utilized items: <none>
item named ‘mod’
- ordinary object ‘divides_sat’:
+ ordinary object ‘divides_sat_@name_suffix@’:
arity: 0
literals: <none>
utilized items:
- ordinary object ‘divides_sat’:
+ ordinary object ‘divides_sat_@name_suffix@’:
arity: 0
literals: <none>
utilized items: item named ‘==’
@@ -648,18 +648,18 @@ data constructor info tables:
number of words for pointers: 3
number of words for non-pointers: 0
top-level strings:
- $tc'Nested1: "'Nested"
- $tc'PerfectTree1: "'PerfectTree"
- $tcPerfectTree1: "PerfectTree"
- $tc'Node1: "'Node"
- $tc'Leaf1: "'Leaf"
- $tcBinTree1: "BinTree"
- $trModule3: "Example"
- $trModule1: "main"
+ $tc'Nested1_@name_suffix@: "'Nested"
+ $tc'PerfectTree1_@name_suffix@: "'PerfectTree"
+ $tcPerfectTree1_@name_suffix@: "PerfectTree"
+ $tc'Node1_@name_suffix@: "'Node"
+ $tc'Leaf1_@name_suffix@: "'Leaf"
+ $tcBinTree1_@name_suffix@: "BinTree"
+ $trModule3_@name_suffix@: "Example"
+ $trModule1_@name_suffix@: "main"
breakpoints: <none>
static-pointer table entries:
- ed7a1b0a13717c34cc10ea39e61d12f0: static_ptr
- 213042ce5bda1667c6629602bbd55756: static_ptr1
+ @hash@: static_ptr
+ @hash@: static_ptr1
HPC information:
hash: 000000006110204f
module name: Example
=====================================
testsuite/tests/show-bytecode/show-bytecode-vanilla.stdout
=====================================
@@ -1,114 +1,114 @@
[1 of 1] Compiling Example ( Example.hs, Example.gbc )
name: Example
-hash: 69e57c48badc5756110a3f9e1ece8f0a
+hash: @hash@
objects:
ordinary object ‘primesPtr’:
arity: 0
literals: <none>
utilized items:
item named ‘static_ptr1’
- item named ‘$dTypeable2’
+ item named ‘$dTypeable2_@name_suffix@’
item named ‘$fIsStaticStaticPtr’
static-construction object ‘static_ptr1’:
data constructor name: StaticPtr
lifted: yes
literals:
- word 2391484856205448807
- word 14295153105712797526
+ word @large_word@
+ word @large_word@
utilized items:
- item named ‘static_ptr1_sat’
+ item named ‘static_ptr1_sat_@name_suffix@’
item named ‘primes’
- static-construction object ‘static_ptr1_sat’:
+ static-construction object ‘static_ptr1_sat_@name_suffix@’:
data constructor name: StaticPtrInfo
lifted: yes
literals: <none>
utilized items:
- item named ‘static_ptr1_sat’
- item named ‘static_ptr1_sat’
- item named ‘static_ptr1_sat’
- ordinary object ‘static_ptr1_sat’:
+ item named ‘static_ptr1_sat_@name_suffix@’
+ item named ‘static_ptr1_sat_@name_suffix@’
+ item named ‘static_ptr1_sat_@name_suffix@’
+ ordinary object ‘static_ptr1_sat_@name_suffix@’:
arity: 0
literals: top-level string "main"
utilized items:
- ordinary object ‘static_ptr1_sat’:
+ ordinary object ‘static_ptr1_sat_@name_suffix@’:
arity: 0
literals: <none>
utilized items: item named ‘unpackCString#’
- ordinary object ‘static_ptr1_sat’:
+ ordinary object ‘static_ptr1_sat_@name_suffix@’:
arity: 0
literals: top-level string "Example"
utilized items:
- ordinary object ‘static_ptr1_sat’:
+ ordinary object ‘static_ptr1_sat_@name_suffix@’:
arity: 0
literals: <none>
utilized items: item named ‘unpackCString#’
- static-construction object ‘static_ptr1_sat’:
+ static-construction object ‘static_ptr1_sat_@name_suffix@’:
data constructor name: (,)
lifted: yes
literals: <none>
utilized items:
- item named ‘static_ptr1_sat’
- item named ‘static_ptr1_sat’
- static-construction object ‘static_ptr1_sat’:
+ item named ‘static_ptr1_sat_@name_suffix@’
+ item named ‘static_ptr1_sat_@name_suffix@’
+ static-construction object ‘static_ptr1_sat_@name_suffix@’:
data constructor name: I#
lifted: yes
literals: word 27
utilized items: <none>
- static-construction object ‘static_ptr1_sat’:
+ static-construction object ‘static_ptr1_sat_@name_suffix@’:
data constructor name: I#
lifted: yes
literals: word 20
utilized items: <none>
- ordinary object ‘primes2’:
+ ordinary object ‘primes2_@name_suffix@’:
arity: 0
literals: <none>
utilized items:
- item named ‘primes2_sat’
- item named ‘isPrime’
+ item named ‘primes2_sat_@name_suffix@’
+ item named ‘isPrime_@name_suffix@’
item named ‘filter’
- ordinary object ‘isPrime’:
+ ordinary object ‘isPrime_@name_suffix@’:
arity: 1
literals: <none>
utilized items:
- ordinary object ‘isPrime_sat’:
+ ordinary object ‘isPrime_sat_@name_suffix@’:
arity: 1
literals: <none>
utilized items:
- ordinary object ‘isPrime_sat’:
+ ordinary object ‘isPrime_sat_@name_suffix@’:
arity: 1
literals: <none>
utilized items:
- ordinary object ‘isPrime_sat’:
+ ordinary object ‘isPrime_sat_@name_suffix@’:
arity: 1
literals:
word 2
info table of ‘IS’
utilized items:
- ordinary object ‘v’:
+ ordinary object ‘v_@name_suffix@’:
arity: 0
literals: <none>
utilized items:
item named ‘$fIntegralInteger’
item named ‘$fNumNatural’
item named ‘^’
- ordinary object ‘isPrime_sat’:
+ ordinary object ‘isPrime_sat_@name_suffix@’:
arity: 3
literals: <none>
utilized items: <none>
- ordinary object ‘v’:
+ ordinary object ‘v_@name_suffix@’:
arity: 0
literals: <none>
utilized items:
item named ‘$fOrdNatural’
item named ‘<=’
- ordinary object ‘isPrime_sat’:
+ ordinary object ‘isPrime_sat_@name_suffix@’:
arity: 3
literals: <none>
utilized items: <none>
item named ‘.’
item named ‘primes’
item named ‘takeWhile’
- ordinary object ‘isPrime_sat’:
+ ordinary object ‘isPrime_sat_@name_suffix@’:
arity: 2
literals: <none>
utilized items:
@@ -122,13 +122,13 @@ objects:
lifted: yes
literals: <none>
utilized items:
- item named ‘primes1’
- item named ‘primes2’
- ordinary object ‘primes2_sat’:
+ item named ‘primes1_@name_suffix@’
+ item named ‘primes2_@name_suffix@’
+ ordinary object ‘primes2_sat_@name_suffix@’:
arity: 0
literals: <none>
utilized items:
- ordinary object ‘primes2_sat’:
+ ordinary object ‘primes2_sat_@name_suffix@’:
arity: 0
literals:
word 3
@@ -138,14 +138,14 @@ objects:
item named ‘fromInteger’
item named ‘$fEnumNatural’
item named ‘enumFrom’
- ordinary object ‘primes1’:
+ ordinary object ‘primes1_@name_suffix@’:
arity: 0
literals: <none>
utilized items:
- item named ‘primes1_sat’
+ item named ‘primes1_sat_@name_suffix@’
item named ‘$fNumNatural’
item named ‘fromInteger’
- static-construction object ‘primes1_sat’:
+ static-construction object ‘primes1_sat_@name_suffix@’:
data constructor name: IS
lifted: yes
literals: word 2
@@ -155,124 +155,124 @@ objects:
literals: <none>
utilized items:
item named ‘static_ptr’
- item named ‘$dTypeable2’
+ item named ‘$dTypeable2_@name_suffix@’
item named ‘$fIsStaticStaticPtr’
static-construction object ‘static_ptr’:
data constructor name: StaticPtr
lifted: yes
literals:
- word 17112019464237448244
- word 14704510317759369968
+ word @large_word@
+ word @large_word@
utilized items:
- item named ‘static_ptr_sat’
+ item named ‘static_ptr_sat_@name_suffix@’
item named ‘fibonaccis’
- static-construction object ‘static_ptr_sat’:
+ static-construction object ‘static_ptr_sat_@name_suffix@’:
data constructor name: StaticPtrInfo
lifted: yes
literals: <none>
utilized items:
- item named ‘static_ptr_sat’
- item named ‘static_ptr_sat’
- item named ‘static_ptr_sat’
- ordinary object ‘static_ptr_sat’:
+ item named ‘static_ptr_sat_@name_suffix@’
+ item named ‘static_ptr_sat_@name_suffix@’
+ item named ‘static_ptr_sat_@name_suffix@’
+ ordinary object ‘static_ptr_sat_@name_suffix@’:
arity: 0
literals: top-level string "main"
utilized items:
- ordinary object ‘static_ptr_sat’:
+ ordinary object ‘static_ptr_sat_@name_suffix@’:
arity: 0
literals: <none>
utilized items: item named ‘unpackCString#’
- ordinary object ‘static_ptr_sat’:
+ ordinary object ‘static_ptr_sat_@name_suffix@’:
arity: 0
literals: top-level string "Example"
utilized items:
- ordinary object ‘static_ptr_sat’:
+ ordinary object ‘static_ptr_sat_@name_suffix@’:
arity: 0
literals: <none>
utilized items: item named ‘unpackCString#’
- static-construction object ‘static_ptr_sat’:
+ static-construction object ‘static_ptr_sat_@name_suffix@’:
data constructor name: (,)
lifted: yes
literals: <none>
utilized items:
- item named ‘static_ptr_sat’
- item named ‘static_ptr_sat’
- static-construction object ‘static_ptr_sat’:
+ item named ‘static_ptr_sat_@name_suffix@’
+ item named ‘static_ptr_sat_@name_suffix@’
+ static-construction object ‘static_ptr_sat_@name_suffix@’:
data constructor name: I#
lifted: yes
literals: word 15
utilized items: <none>
- static-construction object ‘static_ptr_sat’:
+ static-construction object ‘static_ptr_sat_@name_suffix@’:
data constructor name: I#
lifted: yes
literals: word 24
utilized items: <none>
- ordinary object ‘positiveFibonaccis2’:
+ ordinary object ‘positiveFibonaccis2_@name_suffix@’:
arity: 0
literals: <none>
utilized items:
- item named ‘positiveFibonaccis1’
+ item named ‘positiveFibonaccis1_@name_suffix@’
item named ‘fibonaccis’
- item named ‘positiveFibonaccis2_sat’
+ item named ‘positiveFibonaccis2_sat_@name_suffix@’
item named ‘zipWith’
- static-construction object ‘positiveFibonaccis1’:
+ static-construction object ‘positiveFibonaccis1_@name_suffix@’:
data constructor name: :
lifted: yes
literals: <none>
utilized items:
- item named ‘positiveFibonaccis’
- item named ‘positiveFibonaccis2’
+ item named ‘positiveFibonaccis_@name_suffix@’
+ item named ‘positiveFibonaccis2_@name_suffix@’
static-construction object ‘fibonaccis’:
data constructor name: :
lifted: yes
literals: <none>
utilized items:
- item named ‘fibonaccis1’
- item named ‘positiveFibonaccis1’
- ordinary object ‘positiveFibonaccis2_sat’:
+ item named ‘fibonaccis1_@name_suffix@’
+ item named ‘positiveFibonaccis1_@name_suffix@’
+ ordinary object ‘positiveFibonaccis2_sat_@name_suffix@’:
arity: 0
literals: <none>
utilized items:
item named ‘$fNumNatural’
item named ‘+’
- ordinary object ‘positiveFibonaccis’:
+ ordinary object ‘positiveFibonaccis_@name_suffix@’:
arity: 0
literals: <none>
utilized items:
- item named ‘positiveFibonaccis_sat’
+ item named ‘positiveFibonaccis_sat_@name_suffix@’
item named ‘$fNumNatural’
item named ‘fromInteger’
- static-construction object ‘positiveFibonaccis_sat’:
+ static-construction object ‘positiveFibonaccis_sat_@name_suffix@’:
data constructor name: IS
lifted: yes
literals: word 1
utilized items: <none>
- ordinary object ‘fibonaccis1’:
+ ordinary object ‘fibonaccis1_@name_suffix@’:
arity: 0
literals: <none>
utilized items:
- item named ‘fibonaccis1_sat’
+ item named ‘fibonaccis1_sat_@name_suffix@’
item named ‘$fNumNatural’
item named ‘fromInteger’
- static-construction object ‘fibonaccis1_sat’:
+ static-construction object ‘fibonaccis1_sat_@name_suffix@’:
data constructor name: IS
lifted: yes
literals: word 0
utilized items: <none>
- ordinary object ‘$dTypeable2’:
+ ordinary object ‘$dTypeable2_@name_suffix@’:
arity: 0
literals: <none>
utilized items:
- item named ‘$dTypeable’
- item named ‘$dTypeable1’
+ item named ‘$dTypeable_@name_suffix@’
+ item named ‘$dTypeable1_@name_suffix@’
item named ‘mkTrAppChecked’
- ordinary object ‘$dTypeable1’:
+ ordinary object ‘$dTypeable1_@name_suffix@’:
arity: 0
literals: info table of ‘[]’
utilized items:
item named ‘$tcList’
item named ‘mkTrCon’
- ordinary object ‘$dTypeable’:
+ ordinary object ‘$dTypeable_@name_suffix@’:
arity: 0
literals: info table of ‘[]’
utilized items:
@@ -282,216 +282,216 @@ objects:
data constructor name: TyCon
lifted: yes
literals:
- word 4886352401159288042
- word 15486177717927261000
+ word @large_word@
+ word @large_word@
word 1
utilized items:
item named ‘$trModule’
- item named ‘$tc'Nested2’
- item named ‘$krep17’
- static-construction object ‘$tc'Nested2’:
+ item named ‘$tc'Nested2_@name_suffix@’
+ item named ‘$krep17_@name_suffix@’
+ static-construction object ‘$tc'Nested2_@name_suffix@’:
data constructor name: TrNameS
lifted: yes
- literals: address ‘$tc'Nested1’
+ literals: address ‘$tc'Nested1_@name_suffix@’
utilized items: <none>
- static-construction object ‘$krep17’:
+ static-construction object ‘$krep17_@name_suffix@’:
data constructor name: KindRepFun
lifted: yes
literals: <none>
utilized items:
- item named ‘$krep16’
- item named ‘$krep13’
- static-construction object ‘$krep16’:
+ item named ‘$krep16_@name_suffix@’
+ item named ‘$krep13_@name_suffix@’
+ static-construction object ‘$krep16_@name_suffix@’:
data constructor name: KindRepTyConApp
lifted: yes
literals: <none>
utilized items:
item named ‘$tcPerfectTree’
- item named ‘$krep15’
- static-construction object ‘$krep15’:
+ item named ‘$krep15_@name_suffix@’
+ static-construction object ‘$krep15_@name_suffix@’:
data constructor name: :
lifted: yes
literals: <none>
utilized items:
- item named ‘$krep4’
+ item named ‘$krep4_@name_suffix@’
item named ‘[]’
static-construction object ‘$tc'PerfectTree’:
data constructor name: TyCon
lifted: yes
literals:
- word 1216274636751977258
- word 143956009589726941
+ word @large_word@
+ word @large_word@
word 1
utilized items:
item named ‘$trModule’
- item named ‘$tc'PerfectTree2’
- item named ‘$krep14’
- static-construction object ‘$tc'PerfectTree2’:
+ item named ‘$tc'PerfectTree2_@name_suffix@’
+ item named ‘$krep14_@name_suffix@’
+ static-construction object ‘$tc'PerfectTree2_@name_suffix@’:
data constructor name: TrNameS
lifted: yes
- literals: address ‘$tc'PerfectTree1’
+ literals: address ‘$tc'PerfectTree1_@name_suffix@’
utilized items: <none>
- static-construction object ‘$krep14’:
+ static-construction object ‘$krep14_@name_suffix@’:
data constructor name: KindRepFun
lifted: yes
literals: <none>
utilized items:
- item named ‘$krep1’
- item named ‘$krep13’
- static-construction object ‘$krep13’:
+ item named ‘$krep1_@name_suffix@’
+ item named ‘$krep13_@name_suffix@’
+ static-construction object ‘$krep13_@name_suffix@’:
data constructor name: KindRepTyConApp
lifted: yes
literals: <none>
utilized items:
item named ‘$tcPerfectTree’
- item named ‘$krep12’
- static-construction object ‘$krep12’:
+ item named ‘$krep12_@name_suffix@’
+ static-construction object ‘$krep12_@name_suffix@’:
data constructor name: :
lifted: yes
literals: <none>
utilized items:
- item named ‘$krep1’
+ item named ‘$krep1_@name_suffix@’
item named ‘[]’
static-construction object ‘$tcPerfectTree’:
data constructor name: TyCon
lifted: yes
literals:
- word 11330648440307610868
- word 17396431681782259314
+ word @large_word@
+ word @large_word@
word 0
utilized items:
item named ‘$trModule’
- item named ‘$tcPerfectTree2’
+ item named ‘$tcPerfectTree2_@name_suffix@’
item named ‘krep$*Arr*’
- static-construction object ‘$tcPerfectTree2’:
+ static-construction object ‘$tcPerfectTree2_@name_suffix@’:
data constructor name: TrNameS
lifted: yes
- literals: address ‘$tcPerfectTree1’
+ literals: address ‘$tcPerfectTree1_@name_suffix@’
utilized items: <none>
static-construction object ‘$tc'Node’:
data constructor name: TyCon
lifted: yes
literals:
- word 2884468726215238492
- word 558166382591591938
+ word @large_word@
+ word @large_word@
word 2
utilized items:
item named ‘$trModule’
- item named ‘$tc'Node2’
- item named ‘$krep11’
- static-construction object ‘$tc'Node2’:
+ item named ‘$tc'Node2_@name_suffix@’
+ item named ‘$krep11_@name_suffix@’
+ static-construction object ‘$tc'Node2_@name_suffix@’:
data constructor name: TrNameS
lifted: yes
- literals: address ‘$tc'Node1’
+ literals: address ‘$tc'Node1_@name_suffix@’
utilized items: <none>
- static-construction object ‘$krep11’:
+ static-construction object ‘$krep11_@name_suffix@’:
data constructor name: KindRepFun
lifted: yes
literals: <none>
utilized items:
- item named ‘$krep7’
- item named ‘$krep10’
- static-construction object ‘$krep10’:
+ item named ‘$krep7_@name_suffix@’
+ item named ‘$krep10_@name_suffix@’
+ static-construction object ‘$krep10_@name_suffix@’:
data constructor name: KindRepFun
lifted: yes
literals: <none>
utilized items:
- item named ‘$krep’
- item named ‘$krep9’
- static-construction object ‘$krep9’:
+ item named ‘$krep_@name_suffix@’
+ item named ‘$krep9_@name_suffix@’
+ static-construction object ‘$krep9_@name_suffix@’:
data constructor name: KindRepFun
lifted: yes
literals: <none>
utilized items:
- item named ‘$krep7’
- item named ‘$krep7’
+ item named ‘$krep7_@name_suffix@’
+ item named ‘$krep7_@name_suffix@’
static-construction object ‘$tc'Leaf’:
data constructor name: TyCon
lifted: yes
literals:
- word 7677223365245394977
- word 14318463004604079067
+ word @large_word@
+ word @large_word@
word 2
utilized items:
item named ‘$trModule’
- item named ‘$tc'Leaf2’
- item named ‘$krep8’
- static-construction object ‘$tc'Leaf2’:
+ item named ‘$tc'Leaf2_@name_suffix@’
+ item named ‘$krep8_@name_suffix@’
+ static-construction object ‘$tc'Leaf2_@name_suffix@’:
data constructor name: TrNameS
lifted: yes
- literals: address ‘$tc'Leaf1’
+ literals: address ‘$tc'Leaf1_@name_suffix@’
utilized items: <none>
- static-construction object ‘$krep8’:
+ static-construction object ‘$krep8_@name_suffix@’:
data constructor name: KindRepFun
lifted: yes
literals: <none>
utilized items:
- item named ‘$krep1’
- item named ‘$krep7’
- static-construction object ‘$krep7’:
+ item named ‘$krep1_@name_suffix@’
+ item named ‘$krep7_@name_suffix@’
+ static-construction object ‘$krep7_@name_suffix@’:
data constructor name: KindRepTyConApp
lifted: yes
literals: <none>
utilized items:
item named ‘$tcBinTree’
- item named ‘$krep6’
- static-construction object ‘$krep6’:
+ item named ‘$krep6_@name_suffix@’
+ static-construction object ‘$krep6_@name_suffix@’:
data constructor name: :
lifted: yes
literals: <none>
utilized items:
- item named ‘$krep1’
- item named ‘$krep5’
- static-construction object ‘$krep5’:
+ item named ‘$krep1_@name_suffix@’
+ item named ‘$krep5_@name_suffix@’
+ static-construction object ‘$krep5_@name_suffix@’:
data constructor name: :
lifted: yes
literals: <none>
utilized items:
- item named ‘$krep’
+ item named ‘$krep_@name_suffix@’
item named ‘[]’
static-construction object ‘$tcBinTree’:
data constructor name: TyCon
lifted: yes
literals:
- word 9824011489556756898
- word 1356349741031249981
+ word @large_word@
+ word @large_word@
word 0
utilized items:
item named ‘$trModule’
- item named ‘$tcBinTree2’
+ item named ‘$tcBinTree2_@name_suffix@’
item named ‘krep$*->*->*’
- static-construction object ‘$tcBinTree2’:
+ static-construction object ‘$tcBinTree2_@name_suffix@’:
data constructor name: TrNameS
lifted: yes
- literals: address ‘$tcBinTree1’
+ literals: address ‘$tcBinTree1_@name_suffix@’
utilized items: <none>
- static-construction object ‘$krep4’:
+ static-construction object ‘$krep4_@name_suffix@’:
data constructor name: KindRepTyConApp
lifted: yes
literals: <none>
utilized items:
item named ‘$tcTuple2’
- item named ‘$krep3’
- static-construction object ‘$krep3’:
+ item named ‘$krep3_@name_suffix@’
+ static-construction object ‘$krep3_@name_suffix@’:
data constructor name: :
lifted: yes
literals: <none>
utilized items:
- item named ‘$krep1’
- item named ‘$krep2’
- static-construction object ‘$krep2’:
+ item named ‘$krep1_@name_suffix@’
+ item named ‘$krep2_@name_suffix@’
+ static-construction object ‘$krep2_@name_suffix@’:
data constructor name: :
lifted: yes
literals: <none>
utilized items:
- item named ‘$krep1’
+ item named ‘$krep1_@name_suffix@’
item named ‘[]’
- static-construction object ‘$krep1’:
+ static-construction object ‘$krep1_@name_suffix@’:
data constructor name: KindRepVar
lifted: yes
literals: word 0
utilized items: <none>
- static-construction object ‘$krep’:
+ static-construction object ‘$krep_@name_suffix@’:
data constructor name: KindRepVar
lifted: yes
literals: word 1
@@ -501,46 +501,46 @@ objects:
lifted: yes
literals: <none>
utilized items:
- item named ‘$trModule2’
- item named ‘$trModule4’
- static-construction object ‘$trModule4’:
+ item named ‘$trModule2_@name_suffix@’
+ item named ‘$trModule4_@name_suffix@’
+ static-construction object ‘$trModule4_@name_suffix@’:
data constructor name: TrNameS
lifted: yes
- literals: address ‘$trModule3’
+ literals: address ‘$trModule3_@name_suffix@’
utilized items: <none>
- static-construction object ‘$trModule2’:
+ static-construction object ‘$trModule2_@name_suffix@’:
data constructor name: TrNameS
lifted: yes
- literals: address ‘$trModule1’
+ literals: address ‘$trModule1_@name_suffix@’
utilized items: <none>
ordinary object ‘divides’:
arity: 3
literals: <none>
utilized items:
- ordinary object ‘$dReal’:
+ ordinary object ‘$dReal_@name_suffix@’:
arity: 0
literals: <none>
utilized items:
- ordinary object ‘divides_sat’:
+ ordinary object ‘divides_sat_@name_suffix@’:
arity: 1
literals:
word 0
info table of ‘IS’
utilized items:
- ordinary object ‘divides_sat’:
+ ordinary object ‘divides_sat_@name_suffix@’:
arity: 0
literals: <none>
utilized items: item named ‘fromInteger’
item named ‘$p1Real’
- ordinary object ‘divides_sat’:
+ ordinary object ‘divides_sat_@name_suffix@’:
arity: 3
literals: <none>
utilized items: item named ‘mod’
- ordinary object ‘divides_sat’:
+ ordinary object ‘divides_sat_@name_suffix@’:
arity: 0
literals: <none>
utilized items:
- ordinary object ‘divides_sat’:
+ ordinary object ‘divides_sat_@name_suffix@’:
arity: 0
literals: <none>
utilized items: item named ‘==’
@@ -577,17 +577,17 @@ data constructor info tables:
number of words for pointers: 3
number of words for non-pointers: 0
top-level strings:
- $tc'Nested1: "'Nested"
- $tc'PerfectTree1: "'PerfectTree"
- $tcPerfectTree1: "PerfectTree"
- $tc'Node1: "'Node"
- $tc'Leaf1: "'Leaf"
- $tcBinTree1: "BinTree"
- $trModule3: "Example"
- $trModule1: "main"
+ $tc'Nested1_@name_suffix@: "'Nested"
+ $tc'PerfectTree1_@name_suffix@: "'PerfectTree"
+ $tcPerfectTree1_@name_suffix@: "PerfectTree"
+ $tc'Node1_@name_suffix@: "'Node"
+ $tc'Leaf1_@name_suffix@: "'Leaf"
+ $tcBinTree1_@name_suffix@: "BinTree"
+ $trModule3_@name_suffix@: "Example"
+ $trModule1_@name_suffix@: "main"
breakpoints: <none>
static-pointer table entries:
- ed7a1b0a13717c34cc10ea39e61d12f0: static_ptr
- 213042ce5bda1667c6629602bbd55756: static_ptr1
+ @hash@: static_ptr
+ @hash@: static_ptr1
HPC information: <none>
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/aeddc354c6672f1d89903200aac7932…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/aeddc354c6672f1d89903200aac7932…
You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help
1
0
[Git][ghc/ghc][wip/romes/27461] 3 commits: downsweep: make control flow simpler and cache correct
by Rodrigo Mesquita (＠alt-romes) 16 Jul '26
by Rodrigo Mesquita (＠alt-romes) 16 Jul '26
16 Jul '26
Rodrigo Mesquita pushed to branch wip/romes/27461 at Glasgow Haskell Compiler / GHC
Commits:
2b6f824d by Rodrigo Mesquita at 2026-07-15T15:53:21+01:00
downsweep: make control flow simpler and cache correct
This refactor extracts the control flow of downsweep into a single
function `dfsBuild`, which takes care of iteratively expanding and
traversing all nodes of the in-construction module graph necessary to
build a full `ModuleGraph`.
There are three levels of caching going on, all of which are necessary
to make sure we don't do repeated work (notably, NEVER summarise the
same module twice).
1. `dfsBuild` accumulates the final module graph and never revisits the
same node of the module graph. Cache is keyed by the final
`ModuleGraph`s `NodeKey`s.
2. For Module A in home-unit u1, each import in the list of imports
needs to be *found* (call to `findImportedModuleWithIsBoot`): at this
point, we only have the `ModuleName` of the import, not the `Module`.
This *finding* is somewhat expensive, so we cache it as well
(`ImportsCache`). The cache key is the home-unit to which the module
belongs~[1], the import package qualifier, and the ModuleName.
[1] Different home-units will have different package flags, which means
potentially different `Module` resolution for the same `ModuleName`.
3. The most expensive operation we want to avoid is summarising a
`Module` into a `ModSummary`, which notably involves parsing the
module header from scratch.
The third cache, in essence, maps a `Module` to its `ModSummary`
(named `ModSummaryCache`). This cache upholds the invariant: we NEVER
summarise the same module twice. In practice, the cache key is the
Module's UnitId and the Source path; the reason is we need to
distinguish between `.hs` and `.hs-boot` files, as their summaries
will differ.
Note that (2) can't guarantee this alone: Two ModuleName imports in
separate units can (and likely do) map to the same `Module`.
Note that the previous implementation failed to achieve the
no-duplicate-work summarisation invariant, and we ended up doing a
quadratic amount of processing in scenarios like test
`MultiComponentModules100`.
See also Note [Downsweep Control Flow and Caching]
Fixes #27461
Perf changes:
MultiComponentModules(normal) ghc/alloc 2,097,389,264 1,992,186,736 -5.0% GOOD
MultiComponentModules100(normal) ghc/alloc 24,310,173,770 21,293,867,360 -12.4% GOOD
MultiComponentModulesRecomp(normal) ghc/alloc 602,761,394 498,543,984 -17.3% GOOD
MultiComponentModulesRecomp100(normal) ghc/alloc 11,885,968,240 8,895,404,864 -25.2% GOOD
-------------------------
Metric Decrease:
MultiComponentModules
MultiComponentModules100
MultiComponentModulesRecomp
MultiComponentModulesRecomp100
-------------------------
- - - - -
c3478ed6 by Rodrigo Mesquita at 2026-07-15T15:53:34+01:00
implicitRequirementsShallow can never reach HoleUnit
findImportedModule will never return `HoleUnit` for a `ModuleName`
(a `HoleUnit` can only be found as a signature instantiation, never as a
directly *imported* thing)
Therefore, we can drop `[ModuleName]` returned by
`implicitRequirementsShallow`, which makes many things dead code.
Namely, the call to `implicitRequirementsShallow` from
GHC.Driver.Downsweep which was a performance bottleneck (for doing lots
of duplicate work in findImportedModule) is now entirely gone.
Fixes #27053
In an MR with this patch and the downsweep refactor (previous commit), CI says:
MultiComponentModules(normal) ghc/alloc 2,097,396,728 1,943,662,304 -7.3% GOOD
MultiComponentModules100(normal) ghc/alloc 24,310,182,136 17,227,574,440 -29.1% GOOD
MultiComponentModulesRecomp(normal) ghc/alloc 602,769,518 449,973,656 -25.3% GOOD
MultiComponentModulesRecomp100(normal) ghc/alloc 11,885,976,408 4,828,894,160 -59.4% GOOD
and the Cabal test (building Cabal with ghc --make) improves in the
total time reported by +RTS -s from 54s to 40s reliably on my machine
with default+profiled_ghc flavour. That's a 25% reduction in total run time!
-------------------------
Metric Decrease:
MultiComponentModules
MultiComponentModules100
MultiComponentModulesRecomp
MultiComponentModulesRecomp100
-------------------------
- - - - -
3c73f149 by Rodrigo Mesquita at 2026-07-15T17:31:08+01:00
downsweep: Cache negative results
When traversing a module graph structure, a uniquely identified node
should always expand to the same thing.
I don't see how visiting the same node which failed to be expanded a
first time would ever successfully expand the second time we try to
expand it (eg. when coming from a different edge to it -- it is still
the same node!). The node expansion is local, based just based on the
node itself, not on the path to get there.
Therefore, this patch removes the weird behavior and commentary of
`dfsBuild` wrt to `Nothing` not being cached and being potentially
expanded a second time around to something different, which was
misleading and, ultimately, incorrect.
Now, we have a `MGRes`, which is more explicit about a node being
Skipped just being a node that is ignored whenever it is found (and that
skip is cached) -- and we may want to do this due to failures or due to
just trying nodes which might not work on purpose, like hs-boots.
We uniformly cache positive and negative results and remove the
assumption that there might be an ordering in which the same node
visited at a later time might be expanded differently.
This makes it possible to traverse the module nodes in parallel without
a change in behavior, since there's no longer a hidden ordering
requirement.
- - - - -
8 changed files:
- compiler/GHC/Driver/Backpack.hs
- compiler/GHC/Driver/Downsweep.hs
- compiler/GHC/Tc/Utils/Backpack.hs
- testsuite/tests/ghc-api/fixed-nodes/FixedNodes.hs
- testsuite/tests/ghc-api/fixed-nodes/InterfaceModuleGraph.hs
- testsuite/tests/ghc-api/fixed-nodes/ModuleGraphInvariants.hs
- testsuite/tests/splice-imports/SI35.hs
- utils/check-ppr/Main.hs
Changes:
=====================================
compiler/GHC/Driver/Backpack.hs
=====================================
@@ -888,7 +888,7 @@ hsModuleToModSummary home_keys pn hsc_src modname
extra_sig_imports <- liftIO $ findExtraSigImports hsc_env hsc_src modname
let normal_imports = map convImport (generated_imports ++ ord_idecls)
- (implicit_sigs, inst_deps) <- liftIO $ implicitRequirementsShallow hsc_env normal_imports
+ inst_deps <- liftIO $ implicitRequirementsShallow hsc_env normal_imports
-- So that Finder can find it, even though it doesn't exist...
this_mod <- liftIO $ do
@@ -909,8 +909,7 @@ hsModuleToModSummary home_keys pn hsc_src modname
-- We have to do something special here:
-- due to merging, requirements may end up with
-- extra imports
- ++ ((,,) NormalLevel NoPkgQual . noLoc <$> extra_sig_imports)
- ++ ((,,) NormalLevel NoPkgQual . noLoc <$> implicit_sigs),
+ ++ ((,,) NormalLevel NoPkgQual . noLoc <$> extra_sig_imports),
-- This is our hack to get the parse tree to the right spot
ms_parsed_mod = Just (HsParsedModule {
hpm_module = hsmod,
=====================================
compiler/GHC/Driver/Downsweep.hs
=====================================
@@ -5,6 +5,8 @@
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE FunctionalDependencies #-}
module GHC.Driver.Downsweep
( downsweep
, downsweepThunk
@@ -91,7 +93,7 @@ import GHC.Unit.Module.Deps
import qualified GHC.Unit.Home.Graph as HUG
import GHC.Unit.Module.Stage
-import Data.Either ( rights, partitionEithers, lefts )
+import Data.Either ( partitionEithers, lefts )
import qualified Data.Map as Map
import qualified Data.Set as Set
@@ -111,6 +113,8 @@ import Control.Monad.Trans.Reader
import qualified Data.Map.Strict as M
import Control.Monad.Trans.Class
import System.IO.Unsafe (unsafeInterleaveIO)
+import Data.IORef
+import qualified Data.List.NonEmpty as NE
{-
Note [Downsweep and the ModuleGraph]
@@ -140,16 +144,9 @@ When is this graph constructed?
The result is having a uniform graph available for the whole compilation pipeline.
+See also Note [Downsweep Control Flow and Caching]
-}
--- This caches the answer to the question, if we are in this unit, what does
--- an import of this module mean.
-type DownsweepCache = M.Map (UnitId, PkgQual, ModuleNameWithIsBoot) [Either DriverMessages ModuleNodeInfo]
-
-moduleGraphNodeMap :: ModuleGraph -> M.Map NodeKey ModuleGraphNode
-moduleGraphNodeMap graph
- = M.fromList [(mkNodeKey node, node) | node <- mgModSummaries' graph]
-
-----------------------------------------------------------------------------
--
-- | Downsweep (dependency analysis) for --make mode
@@ -195,8 +192,11 @@ downsweep :: HscEnv
-- (Modules, IsBoot) identifiers, unless the Bool is true in
-- which case there can be repeats
downsweep hsc_env diag_wrapper msg old_summaries maybe_base_graph excl_mods allow_dup_roots = do
- n_jobs <- mkWorkerLimit (hsc_dflags hsc_env)
- (root_errs, root_summaries) <- rootSummariesParallel n_jobs hsc_env diag_wrapper msg summary
+ n_jobs <- mkWorkerLimit (hsc_dflags hsc_env)
+ summ_cache <- newIORef (mkModSummaryCache (zip old_summaries (repeat SummOld)))
+ imps_cache <- newIORef Map.empty
+ (root_errs, root_summaries) <- rootSummariesParallel n_jobs hsc_env diag_wrapper msg
+ (getRootSummary excl_mods summ_cache imps_cache)
let closure_errs = checkHomeUnitsClosed unit_env
unit_env = hsc_unit_env hsc_env
@@ -204,9 +204,13 @@ downsweep hsc_env diag_wrapper msg old_summaries maybe_base_graph excl_mods allo
case all_errs of
[] -> do
- (downsweep_errs, downsweep_nodes) <- downsweepFromRootNodes hsc_env old_summary_map maybe_base_graph excl_mods allow_dup_roots DownsweepUseCompile (map ModuleNodeCompile root_summaries) []
+ (downsweep_errs, downsweep_nodes) <-
+ downsweepFromRootNodes hsc_env summ_cache imps_cache maybe_base_graph
+ excl_mods allow_dup_roots DownsweepUseCompile (map ModuleNodeCompile root_summaries) []
- let (other_errs, unit_nodes) = partitionEithers $ HUG.unitEnv_foldWithKey (\nodes uid hue -> nodes ++ unitModuleNodes downsweep_nodes uid hue) [] (hsc_HUG hsc_env)
+ let (other_errs, unit_nodes) = partitionEithers $
+ HUG.unitEnv_foldWithKey (\nodes uid hue -> nodes ++ unitModuleNodes downsweep_nodes uid hue) []
+ (hsc_HUG hsc_env)
let all_nodes = downsweep_nodes ++ unit_nodes
let all_errs = downsweep_errs ++ other_errs
@@ -222,17 +226,6 @@ downsweep hsc_env diag_wrapper msg old_summaries maybe_base_graph excl_mods allo
return (all_errs, th_configured_nodes)
_ -> return (all_errs, emptyMG)
where
- summary = getRootSummary excl_mods old_summary_map
-
- -- A cache from file paths to the already summarised modules. The same file
- -- can be used in multiple units so the map is also keyed by which unit the
- -- file was used in.
- -- Reuse these if we can because the most expensive part of downsweep is
- -- reading the headers.
- old_summary_map :: M.Map (UnitId, OsPath) ModSummary
- old_summary_map =
- M.fromList [((ms_unitid ms, msHsFileOsPath ms), ms) | ms <- old_summaries]
-
-- Dependencies arising on a unit (backpack and module linking deps)
unitModuleNodes :: [ModuleGraphNode] -> UnitId -> HomeUnitEnv -> [Either (Messages DriverMessage) ModuleGraphNode]
unitModuleNodes summaries uid hue =
@@ -245,7 +238,9 @@ downsweep hsc_env diag_wrapper msg old_summaries maybe_base_graph excl_mods allo
downsweepThunk :: HscEnv -> ModSummary -> IO ModuleGraph
downsweepThunk hsc_env mod_summary = unsafeInterleaveIO $ do
debugTraceMsg (hsc_logger hsc_env) 3 $ text "Computing Module Graph thunk..."
- ~(errs, mg) <- downsweepFromRootNodes hsc_env mempty Nothing [] True DownsweepUseFixed [ModuleNodeCompile mod_summary] []
+ summs <- newIORef (mkModSummaryCache [(mod_summary,SummOld)])
+ imps <- newIORef mempty
+ ~(errs, mg) <- downsweepFromRootNodes hsc_env summs imps Nothing [] True DownsweepUseFixed [ModuleNodeCompile mod_summary] []
let dflags = hsc_dflags hsc_env
liftIO $ printOrThrowDiagnostics (hsc_logger hsc_env)
(initPrintConfig dflags)
@@ -269,83 +264,24 @@ downsweepInteractiveImports hsc_env ic = unsafeInterleaveIO $ do
debugTraceMsg (hsc_logger hsc_env) 3 $ (text "Computing Interactive Module Graph thunk...")
let imps = ic_imports (hsc_IC hsc_env)
- let interactive_mn = icInteractiveModule ic
- -- No sensible value for ModLocation.. if you hit this panic then you probably
- -- need to add proper support for modules without any source files to the driver.
- let ml = pprPanic "modLocation" (ppr interactive_mn <+> ppr imps)
- let key = moduleToMnk interactive_mn NotBoot
- let node_type = ModuleNodeFixed key ml
+ interactive_mn = icInteractiveModule ic
+ key = dsNodeInfoKey (DSInteractive interactive_mn imps)
-- The existing nodes in the module graph. This will be populated when GHCi runs
-- :load. Any home package modules need to already be in here.
- let cached_nodes = Map.fromList [ (mkNodeKey n, n) | n <- mg_mss (hsc_mod_graph hsc_env) ]
-
- (module_edges, graph) <- loopFromInteractive hsc_env (map mkEdge imps) cached_nodes
- let interactive_node = ModuleNode module_edges node_type
-
- let all_nodes = M.elems graph
+ let cached_nodes = Map.fromList [ (mkNodeKey n, NSuccess n) | n <- mg_mss (hsc_mod_graph hsc_env) ]
+
+ summ_cache <- newIORef mempty
+ imps_cache <- newIORef mempty
+ let env = DownsweepEnv hsc_env DownsweepUseFixed{-or UseCompiled?-} summ_cache imps_cache []
+ graph <- runDownsweepM env do
+ loopFromInteractive cached_nodes interactive_mn imps
+ let interactive_node = case expectJust $ M.lookup key graph of
+ NSuccess r -> r
+ NSkip -> pprPanic "downsweepInteractiveImports" (text "Skip")
+ all_nodes = [s | NSuccess s <- M.elems graph ]
return $ mkModuleGraph (interactive_node : all_nodes)
- where
- --
- mkEdge :: InteractiveImport -> Either ModuleNodeEdge (UnitId, ImportLevel, PkgQual, GenWithIsBoot (Located ModuleName))
- -- A simple edge to a module from the same home unit
- mkEdge (IIModule n) =
- let
- mod_node_key = ModNodeKeyWithUid
- { mnkModuleName = GWIB (moduleName n) NotBoot
- , mnkUnitId =
- -- 'toUnitId' is safe here, as we can't import modules that
- -- don't have a 'UnitId'.
- toUnitId (moduleUnit n)
- }
- mod_node_edge =
- ModuleNodeEdge NormalLevel (NodeKey_Module mod_node_key)
- in Left mod_node_edge
- -- A complete import statement
- mkEdge (IIDecl i) =
- let lvl = convImportLevel (ideclLevelSpec i)
- wanted_mod = unLoc (ideclName i)
- is_boot = ideclSource i
- mb_pkg = renameRawPkgQual (hsc_unit_env hsc_env) (unLoc $ ideclName i) (ideclPkgQual i)
- unitId = homeUnitId $ hsc_home_unit hsc_env
- in Right (unitId, lvl, mb_pkg, GWIB (noLoc wanted_mod) is_boot)
-
-loopFromInteractive :: HscEnv
- -> [Either ModuleNodeEdge (UnitId, ImportLevel, PkgQual, GenWithIsBoot (Located ModuleName))]
- -> M.Map NodeKey ModuleGraphNode
- -> IO ([ModuleNodeEdge],M.Map NodeKey ModuleGraphNode)
-loopFromInteractive _ [] cached_nodes = return ([], cached_nodes)
-loopFromInteractive hsc_env (edge:edges) cached_nodes =
- case edge of
- Left edge -> do
- (edges, cached_nodes') <- loopFromInteractive hsc_env edges cached_nodes
- return (edge : edges, cached_nodes')
- Right (unitId, lvl, mb_pkg, GWIB wanted_mod is_boot) -> do
- let home_unit = ue_unitHomeUnit unitId (hsc_unit_env hsc_env)
- let k _ loc mod =
- let key = moduleToMnk mod is_boot
- in return $ FoundHome (ModuleNodeFixed key loc)
- found <- liftIO $ summariseModuleDispatch k hsc_env home_unit is_boot wanted_mod mb_pkg []
- case found of
- -- Case 1: Home modules have to already be in the cache.
- FoundHome (ModuleNodeFixed mod _) -> do
- let edge = ModuleNodeEdge lvl (NodeKey_Module mod)
- -- Note: Does not perform any further downsweep as the module must already be in the cache.
- (edges, cached_nodes') <- loopFromInteractive hsc_env edges cached_nodes
- return (edge : edges, cached_nodes')
- -- Case 2: External units may not be in the cache, if we haven't already initialised the
- -- module graph. We can construct the module graph for those here by calling loopUnit.
- External uid -> do
- let hsc_env' = hscSetActiveHomeUnit home_unit hsc_env
- cached_nodes' = loopUnit hsc_env' cached_nodes [uid]
- edge = ModuleNodeEdge lvl (NodeKey_ExternalUnit uid)
- (edges, cached_nodes') <- loopFromInteractive hsc_env edges cached_nodes'
- return (edge : edges, cached_nodes')
- -- And if it's not found.. just carry on and hope.
- _ -> loopFromInteractive hsc_env edges cached_nodes
-
-
-- | Create a module graph from a list of installed modules.
-- This is used by the loader when we need to load modules but there
-- isn't already an existing module graph. For example, when loading plugins
@@ -373,7 +309,9 @@ downsweepInstalledModules hsc_env mods = do
_ -> throwGhcException $ ProgramError $ showSDoc (hsc_dflags hsc_env) $ text "downsweepInstalledModules: Could not find installed module" <+> ppr i
nodes <- mapM process installed_mods
- (errs, mg) <- downsweepFromRootNodes hsc_env mempty Nothing [] True DownsweepUseFixed nodes external_uids
+ summs <- newIORef mempty
+ imps <- newIORef mempty
+ (errs, mg) <- downsweepFromRootNodes hsc_env summs imps Nothing [] True DownsweepUseFixed nodes external_uids
-- Similarly here, we should really not get any errors, but print them out if we do.
let dflags = hsc_dflags hsc_env
@@ -397,7 +335,8 @@ data DownsweepMode = DownsweepUseCompile | DownsweepUseFixed
-- This function will start at the given roots, and traverse downwards to find
-- all the dependencies, all the way to the leaf units.
downsweepFromRootNodes :: HscEnv
- -> M.Map (UnitId, OsPath) ModSummary
+ -> ModSummaryCache
+ -> ImportsCache
-> Maybe ModuleGraph
-> [ModuleName]
-> Bool
@@ -405,44 +344,48 @@ downsweepFromRootNodes :: HscEnv
-> [ModuleNodeInfo] -- ^ The starting ModuleNodeInfo
-> [UnitId] -- ^ The starting units
-> IO ([DriverMessages], [ModuleGraphNode])
-downsweepFromRootNodes hsc_env old_summaries maybe_base_graph excl_mods allow_dup_roots mode root_nodes root_uids
- = do
- let root_map = mkRootMap root_nodes
- checkDuplicates root_map
- let env = DownsweepEnv hsc_env mode old_summaries excl_mods
- (deps', map0) <- runDownsweepM env $ do
- let base_nodes = maybe M.empty moduleGraphNodeMap maybe_base_graph
- (module_deps, map0) <- loopModuleNodeInfos root_nodes (base_nodes, root_map)
- let all_deps = loopUnit hsc_env module_deps root_uids
- let all_instantiations = getHomeUnitInstantiations hsc_env
- deps' <- loopInstantiations all_instantiations all_deps
- return (deps', map0)
-
-
- let downsweep_errs = lefts $ concat $ M.elems map0
- downsweep_nodes = M.elems deps'
-
- return (downsweep_errs, downsweep_nodes)
- where
- getHomeUnitInstantiations :: HscEnv -> [(UnitId, InstantiatedUnit)]
- getHomeUnitInstantiations hsc_env = HUG.unitEnv_foldWithKey (\nodes uid hue -> nodes ++ instantiationNodes uid (homeUnitEnv_units hue)) [] (hsc_HUG hsc_env)
-
- -- In a root module, the filename is allowed to diverge from the module
- -- name, so we have to check that there aren't multiple root files
- -- defining the same module (otherwise the duplicates will be silently
- -- ignored, leading to confusing behaviour).
- checkDuplicates
- :: DownsweepCache
- -> IO ()
- checkDuplicates root_map
- | not allow_dup_roots
- , dup_root:_ <- dup_roots = liftIO $ multiRootsErr sec dup_root
- | otherwise = pure ()
- where
- sec = initSourceErrorContext (hsc_dflags hsc_env)
- dup_roots :: [[ModuleNodeInfo]] -- Each at least of length 2
- dup_roots = filterOut isSingleton $ map rights (M.elems root_map)
-
+downsweepFromRootNodes hsc_env summ_cache imps_cache maybe_base_graph excl_mods allow_dup_roots mode root_nodes root_uids = do
+ when (not allow_dup_roots) $
+ case root_duplicates of
+ [] -> return ()
+ (dup_root:_) -> multiRootsErr sec dup_root
+ modifyImpsCache imps_cache (`M.union` mkRootMap root_nodes) -- add root nodes to imports cache
+ let env = DownsweepEnv hsc_env mode summ_cache imps_cache excl_mods
+ deps' <- runDownsweepM env $ do
+ let base_nodes = maybe M.empty moduleGraphNodeMap maybe_base_graph
+ module_deps <- loopModuleNodeInfos base_nodes root_nodes
+ all_deps <- loopUnits module_deps (hscActiveUnitId hsc_env) root_uids
+ deps' <- loopInstantiations all_deps (getHomeUnitInstantiations hsc_env)
+ return deps'
+ f_cache <- readIORef summ_cache
+ let downsweep_errs = lefts (M.elems f_cache)
+ downsweep_nodes = [ s | NSuccess s <- M.elems deps' ]
+
+ return (downsweep_errs, downsweep_nodes)
+ where
+ getHomeUnitInstantiations :: HscEnv -> [(UnitId, InstantiatedUnit)]
+ getHomeUnitInstantiations hsc_env = HUG.unitEnv_foldWithKey
+ (\nodes uid hue -> nodes ++ instantiationNodes uid (homeUnitEnv_units hue)) [] (hsc_HUG hsc_env)
+
+ -- In a root module, the filename is allowed to diverge from the module
+ -- name, so we have to check that there aren't multiple root files
+ -- defining the same module (otherwise the duplicates will be silently
+ -- ignored, leading to confusing behaviour).
+ root_duplicates :: [NE.NonEmpty ModuleNodeInfo]
+ root_duplicates = mapMaybe takes2 (M.elems root_map)
+ where
+ takes2 (a:as@(_:_)) = Just (a NE.:| as) -- Each at least of length 2
+ takes2 _ = Nothing
+
+ root_map = Map.fromListWith (flip (++))
+ [ ((moduleNodeInfoUnitId s, moduleNodeInfoMnwib s), [s])
+ | s <- root_nodes ]
+
+ moduleGraphNodeMap :: ModuleGraph -> M.Map NodeKey (MGRes ModuleGraphNode)
+ moduleGraphNodeMap graph
+ = M.fromList [(mkNodeKey node, NSuccess node) | node <- mgModSummaries' graph]
+
+ sec = initSourceErrorContext (hsc_dflags hsc_env)
calcDeps :: ModSummary -> [(ImportLevel, PkgQual, GenWithIsBoot (Located ModuleName))]
calcDeps ms =
@@ -457,104 +400,292 @@ type DownsweepM a = ReaderT DownsweepEnv IO a
data DownsweepEnv = DownsweepEnv {
downsweep_hsc_env :: HscEnv
, _downsweep_mode :: DownsweepMode
- , _downsweep_old_summaries :: M.Map (UnitId, OsPath) ModSummary
+ , _downsweep_summaries_cache :: ModSummaryCache
+ , downsweep_imports_cache :: ImportsCache
, _downsweep_excl_mods :: [ModuleName]
}
+type ModSummaryCache = IORef ModSummaryCacheMap
+type ImportsCache = IORef ImportsCacheMap
+
+-- | A cache from file paths to the already summarised modules. The same file
+-- can be used in multiple units so the map is actually also keyed by which
+-- unit the file was used in.
+--
+-- We want to reuse ModSummaries as far as possible because the most expensive
+-- part of downsweep is reading and parsing the headers.
+--
+-- See Note [Downsweep Control Flow and Caching]
+type ModSummaryCacheMap
+ -- The cache can't be keyed by 'Module' because that isn't sufficient to
+ -- distinguish .hs from .hs-boot files. Use path+unit instead.
+ = ( M.Map (UnitId, OsPath) (Either DriverMessages (ModSummary, SummProvenance)) )
+
+data SummProvenance
+ -- | Constructed during this downsweep: trivially up to date
+ = SummFresh
+ -- | Carried over from a previous run: may be stale, must be hash-checked
+ -- (and considered by -fforce-recomp)
+ | SummOld
+
+mkModSummaryCache :: [(ModSummary, SummProvenance)] -> ModSummaryCacheMap
+mkModSummaryCache summs = foldl' (flip (uncurry addModSummaryCache)) M.empty summs
+
+addModSummaryCache :: ModSummary -> SummProvenance -> ModSummaryCacheMap -> ModSummaryCacheMap
+addModSummaryCache ms pr fe = upd_fe fe
+ where
+ upd_fe fe
+ | Just src_fn_os <- ml_hs_file_ospath (ms_location ms)
+ = M.insert (ms_unitid ms, src_fn_os) (Right (ms, pr)) fe
+ | otherwise = fe
+
+modifySummCache :: ModSummaryCache -> (ModSummaryCacheMap -> ModSummaryCacheMap) -> IO ()
+modifyImpsCache :: ImportsCache -> (ImportsCacheMap -> ImportsCacheMap) -> IO ()
+modifySummCache r f = atomicModifyIORef' r (\c -> (f c, ()))
+modifyImpsCache r f = atomicModifyIORef' r (\c -> (f c, ()))
+
+-- | A cache from a module import (in given home unit context, with a package
+-- qualifier, and the imported module name (with or without SOURCE)) to the
+-- result of summarising that import (see 'summariseModuleDispatch').
+--
+-- See Note [Downsweep Control Flow and Caching]
+type ImportsCacheMap
+ = M.Map (UnitId, PkgQual, ModuleNameWithIsBoot) SummariseResult
+
+-- | Populate the 'ImportsCacheMap' with the root modules.
+mkRootMap :: [ModuleNodeInfo] -> ImportsCacheMap
+mkRootMap summaries = Map.fromList
+ [ ((moduleNodeInfoUnitId s, NoPkgQual, moduleNodeInfoMnwib s), FoundHome s) | s <- summaries ]
+
runDownsweepM :: DownsweepEnv -> DownsweepM a -> IO a
runDownsweepM env act = runReaderT act env
+loopDownsweepNodes :: M.Map NodeKey (MGRes ModuleGraphNode) -> [DownsweepNode] -> DownsweepM (M.Map NodeKey (MGRes ModuleGraphNode))
+loopModuleNodeInfos :: M.Map NodeKey (MGRes ModuleGraphNode) -> [ModuleNodeInfo] -> DownsweepM (M.Map NodeKey (MGRes ModuleGraphNode))
+loopUnits :: M.Map NodeKey (MGRes ModuleGraphNode) -> UnitId -> [UnitId] -> DownsweepM (M.Map NodeKey (MGRes ModuleGraphNode))
+loopInstantiations :: M.Map NodeKey (MGRes ModuleGraphNode) -> [(UnitId, InstantiatedUnit)] -> DownsweepM (M.Map NodeKey (MGRes ModuleGraphNode))
+loopFromInteractive :: M.Map NodeKey (MGRes ModuleGraphNode) -> Module -> [InteractiveImport] -> DownsweepM (M.Map NodeKey (MGRes ModuleGraphNode))
+loopDownsweepNodes base_map nodes = dfsBuild (Just base_map) nodes dsNodeInfoKey dsNodeExpand
+loopModuleNodeInfos base_map = loopDownsweepNodes base_map . map DSMod
+loopUnits base_map homud = loopDownsweepNodes base_map . map (DSUnit homud)
+loopInstantiations base_map = loopDownsweepNodes base_map . map (uncurry DSInst)
+loopFromInteractive base_map m = loopDownsweepNodes base_map . (:[]) . DSInteractive m
+
+--------------------------------------------------------------------------------
+
+-- | A 'DownsweepNode' is the basic block of the downsweep algorithm which
+-- encompasses the types of nodes we can iteratively expand to construct the
+-- full module graph. See 'loopDownsweepNodes'.
+--
+-- See Note [Downsweep Control Flow and Caching]
+data DownsweepNode
+ -- | A module node to expand
+ = DSMod ModuleNodeInfo
+ -- | A unit node to expand
+ | DSUnit
+ { home_context_uid :: UnitId
+ -- ^ The home unit which introduced the dependency on this 'node_uid'. This
+ -- 'node_uid' can only be expanded in the context ('HscEnv') where
+ -- 'home_context_uid' is the active home unit, to make sure the package flags
+ -- are the ones attributed to the home package that introduced this node.
+ , node_uid :: UnitId
+ -- ^ The unit node to expand
+ }
+ -- | FIXME: document the meaning of 'DSInst'
+ | DSInst
+ { home_context_uid :: UnitId
+ , instantiated_ud :: InstantiatedUnit
+ }
+ -- | A group of interactive imports from this interactive Module
+ | DSInteractive Module [InteractiveImport]
+
+instance Outputable DownsweepNode where
+ ppr = \case
+ DSMod (ModuleNodeCompile ms) -> text "DSModC" <+> ppr (ms_mod_name ms)
+ DSMod (ModuleNodeFixed key _) -> text "DSModF" <+> ppr key
+ DSUnit{node_uid} -> text "DSUnit" <+> ppr node_uid
+ DSInst{instantiated_ud} -> text "DSInst" <+> ppr instantiated_ud
+ DSInteractive mod ii -> text "DSInteractive" <+> ppr mod <+> ppr ii
+
+-- | They key by which to cache previously visited 'DownsweepNode's
+dsNodeInfoKey :: DownsweepNode -> NodeKey
+dsNodeInfoKey = \case
+ DSMod (ModuleNodeCompile ms) -> NodeKey_Module (msKey ms)
+ DSMod (ModuleNodeFixed mod _) -> NodeKey_Module mod
+ DSUnit{node_uid} -> NodeKey_ExternalUnit node_uid
+ DSInst{instantiated_ud} -> NodeKey_Unit instantiated_ud
+ DSInteractive mod _imps -> NodeKey_Module $ moduleToMnk mod NotBoot
+
+dsNodeExpand :: DownsweepNode -> DownsweepM (MGRes (ModuleGraphNode, [DownsweepNode]))
+dsNodeExpand = \case
+ DSMod (ModuleNodeCompile ms) -> expandModuleSummary ms
+ DSMod (ModuleNodeFixed key loc) -> expandFixedModuleNode key loc
+ DSUnit{ node_uid, home_context_uid } -> expandUnitNode node_uid home_context_uid
+ DSInst{ instantiated_ud
+ , home_context_uid } -> expandInstantiatedUnit instantiated_ud home_context_uid
+ DSInteractive imod iis -> expandInteractiveImports imod iis
+
+expandModuleSummary :: ModSummary -> DownsweepM (MGRes (ModuleGraphNode, [DownsweepNode]))
+expandModuleSummary ms = do -- Didn't work out what the imports mean yet, now do that.
+ hsc_env <- asks downsweep_hsc_env
+ let home_uid = ms_unitid ms
+ home_unit = ue_unitHomeUnit home_uid (hsc_unit_env hsc_env)
+ (final_deps, todo) <- fmap unzip $ forM (calcDeps ms) $ \(imp,mb_pkg,gwib) -> do
+ let GWIB { gwib_mod = L loc mod, gwib_isBoot = is_boot } = gwib
+ wanted_mod = L loc mod
+ mb_s <- downsweepSummarise home_unit is_boot wanted_mod mb_pkg Nothing
+ case mb_s of
+ NotThere -> return
+ ( Nothing, [] )
+ External uid -> return
+ ( Just $ mkModuleEdge imp (NodeKey_ExternalUnit uid)
+ -- Specify home unit, as each unit might have a different visible package database.
+ , [DSUnit{node_uid = uid, home_context_uid = home_uid}] )
+ FoundInstantiation iud -> return
+ ( Just (mkModuleEdge imp (NodeKey_Unit iud)), [] )
+ FoundHomeWithError (_uid, _e) -> return
+ ( Nothing, [] )
+ -- the error @e@ is already stored in the summarisation cache,
+ -- (the IORef in DownsweepM) and will get reported at the end.
+ FoundHome s -> return
+ -- MP: This assumes that we can only instantiate non home units, which is probably fair enough for now.
+ ( Just $ mkModuleEdge imp (NodeKey_Module (mnKey s))
+ , [DSMod s] )
+
+ -- This has the effect of finding a .hs file if we are looking at the .hs-boot file.
+ boot_todo <-
+ if | HsBootFile <- ms_hsc_src ms
+ -> do
+ r <- downsweepSummarise home_unit NotBoot (noLoc $ ms_mod_name ms) NoPkgQual Nothing
+ case r of
+ FoundHome s -> pure [DSMod s]
+ _ -> pure []
+ | otherwise -> pure []
+
+ return $ NSuccess
+ ( ModuleNode (catMaybes final_deps) (ModuleNodeCompile ms)
+ , boot_todo ++ concat todo
+ )
+
+-- | Expand a 'ModuleNodeFixed' node
+-- NB: If you ever reach a Fixed node, everything under that also must be fixed.
+expandFixedModuleNode :: ModNodeKeyWithUid -> ModLocation -> DownsweepM (MGRes (ModuleGraphNode, [DownsweepNode]))
+expandFixedModuleNode key loc = do
+ hsc_env <- asks downsweep_hsc_env
+ -- MP: TODO, we should just read the dependency info from the interface rather than either
+ -- a. Loading the whole thing into the EPS (this might never nececssary and causes lots of things to be permanently loaded into memory)
+ -- b. Loading the whole interface into a buffer before discarding it. (wasted allocation and deserialisation)
+ read_result <- liftIO $
+ -- 1. Check if the interface is already loaded into the EPS by some other
+ -- part of the compiler.
+ lookupIfaceByModuleHsc hsc_env (mnkToModule key) >>= \case
+ Just iface -> return (M.Succeeded iface)
+ Nothing -> readIface (hsc_hooks hsc_env) (hsc_logger hsc_env) (hsc_dflags hsc_env) (hsc_NC hsc_env) (mnkToModule key) (ml_hi_file loc)
+ case read_result of
+ M.Succeeded iface -> do
+ -- Computer information about this node
+ let node_deps = ifaceDeps (mi_deps iface)
+ edges = map mkFixedEdge node_deps
+ node = ModuleNode edges (ModuleNodeFixed key loc)
+ deps' <- catMaybes <$> mapM (mk_dep hsc_env) (bimap snd snd <$> node_deps)
+ pure $ NSuccess (node, deps')
+
+ -- Skip any failure, we might try to read a .hi-boot file for
+ -- example, even if there is not one.
+ M.Failed {} ->
+ pure NSkip
+ where
+ mk_dep hsc_env (Left key) = do
+ -- Like expandImports, but we already know exactly which module we are looking for.
+ read_result <- liftIO $ findExactModule hsc_env (mnkToInstalledModule key) (mnkIsBoot key)
+ case read_result of
+ InstalledFound loc -> do
+ pure $ Just $ DSMod (ModuleNodeFixed key loc)
+ _otherwise ->
+ -- If the finder fails, just keep going, there will be another
+ -- error later.
+ pure Nothing
+ mk_dep _ (Right uid_dep) = do
+ -- Set active unit so that looking loopUnit finds the correct
+ -- -package flags in the unit state.
+ let home_uid = mnkUnitId key
+ pure (Just DSUnit{node_uid=uid_dep, home_context_uid=home_uid})
+
+-- | Expand a unit id under the context of a certain home unit
+expandUnitNode :: UnitId {-^ @node_uid@ -} -> UnitId {-^ Home unit from where @node_uid@ was introduced -}
+ -> DownsweepM (MGRes (ModuleGraphNode, [DownsweepNode]))
+expandUnitNode node_uid home_context_uid = do
+ -- Set active unit so that looking loopUnit finds the correct
+ -- -package flags in the unit state.
+ hsc_env <- asks downsweep_hsc_env
+ let lcl_hsc_env = hscSetActiveUnitId home_context_uid hsc_env
+ case unitDepends <$> lookupUnitId (hsc_units lcl_hsc_env) node_uid of
+ Just us -> pure $ NSuccess ((UnitNode us node_uid), map (\u -> DSUnit{node_uid=u, home_context_uid{-inherit-}}) us)
+ Nothing -> pprPanic "loopUnit" (text "Malformed package database, missing " <+> ppr node_uid)
+
+expandInstantiatedUnit :: InstantiatedUnit -> UnitId {-^ Home unit -} -> DownsweepM (MGRes (ModuleGraphNode, [DownsweepNode]))
+expandInstantiatedUnit iud home_uid = pure $ NSuccess
+ ( InstantiationNode home_uid iud
+ , [DSUnit{node_uid=instUnitInstanceOf iud, home_context_uid=home_uid}] )
+
+expandInteractiveImports :: Module -> [InteractiveImport] -> DownsweepM (MGRes (ModuleGraphNode, [DownsweepNode]))
+expandInteractiveImports imod imps = do
+ hsc_env <- asks downsweep_hsc_env
+ imps_cache <- asks downsweep_imports_cache
+
+ let
+ -- A simple edge to a module from the same home unit
+ mkEdge (IIModule n) = return $
+ let
+ mod_node_key = ModNodeKeyWithUid
+ { mnkModuleName = GWIB (moduleName n) NotBoot
+ , mnkUnitId =
+ -- 'toUnitId' is safe here, as we can't import modules that
+ -- don't have a 'UnitId'.
+ toUnitId (moduleUnit n)
+ }
+ in (Just $ ModuleNodeEdge NormalLevel (NodeKey_Module mod_node_key), [])
-loopInstantiations :: [(UnitId, InstantiatedUnit)]
- -> M.Map NodeKey ModuleGraphNode
- -> DownsweepM (M.Map NodeKey ModuleGraphNode)
-loopInstantiations [] done = pure done
-loopInstantiations ((home_uid, iud) :xs) done = do
- hsc_env <- asks downsweep_hsc_env
- let home_unit = ue_unitHomeUnit home_uid (hsc_unit_env hsc_env)
- let hsc_env' = hscSetActiveHomeUnit home_unit hsc_env
- done' = loopUnit hsc_env' done [instUnitInstanceOf iud]
- payload = InstantiationNode home_uid iud
- loopInstantiations xs (M.insert (mkNodeKey payload) payload done')
-
-
--- This loops over all the mod summaries in the dependency graph, accumulates the actual dependencies for each module/unit
-loopSummaries :: [ModSummary]
- -> (M.Map NodeKey ModuleGraphNode,
- DownsweepCache)
- -> DownsweepM ((M.Map NodeKey ModuleGraphNode), DownsweepCache)
-loopSummaries [] done = pure done
-loopSummaries (ms:next) (done, summarised)
- | Just {} <- M.lookup k done
- = loopSummaries next (done, summarised)
- -- Didn't work out what the imports mean yet, now do that.
- | otherwise = do
- (final_deps, done', summarised') <- loopImports (ms_unitid ms) (calcDeps ms) done summarised
- -- This has the effect of finding a .hs file if we are looking at the .hs-boot file.
- (_, done'', summarised'') <- loopImports (ms_unitid ms) (maybeToList hs_file_for_boot) done' summarised'
- loopSummaries next (M.insert k (ModuleNode final_deps (ModuleNodeCompile ms)) done'', summarised'')
+ -- A complete import statement
+ mkEdge (IIDecl i) =
+ let lvl = convImportLevel (ideclLevelSpec i)
+ wanted_mod = unLoc (ideclName i)
+ is_boot = ideclSource i
+ mb_pkg = renameRawPkgQual (hsc_unit_env hsc_env) (unLoc $ ideclName i) (ideclPkgQual i)
+ unitId = homeUnitId $ hsc_home_unit hsc_env
+ in do
+ let home_unit = ue_unitHomeUnit unitId (hsc_unit_env hsc_env)
+ let k _ loc mod =
+ let key = moduleToMnk mod is_boot
+ in return $ FoundHome (ModuleNodeFixed key loc)
+
+ found <- liftIO $ summariseModuleDispatch k hsc_env imps_cache
+ home_unit is_boot (noLoc wanted_mod) mb_pkg []
+ case found of
+ -- Case 1: Home modules have to already be in the cache.
+ FoundHome (ModuleNodeFixed mod _) -> do
+ let edge = ModuleNodeEdge lvl (NodeKey_Module mod)
+ -- Note: Does not perform any further downsweep as the module must already be in the cache.
+ return (Just edge, [])
+ -- Case 2: External units may not be in the cache, if we haven't already initialised the
+ -- module graph. We can construct the module graph for those here by calling loopUnit.
+ External uid -> do
+ let edge = ModuleNodeEdge lvl (NodeKey_ExternalUnit uid)
+ return (Just edge, [DSUnit{node_uid=uid, home_context_uid=homeUnitId home_unit}])
+ -- And if it's not found.. just carry on and hope.
+ _ -> return (Nothing, [])
+
+ (module_edges, todo) <- unzip <$> mapM mkEdge imps
+ pure $ NSuccess
+ ( ModuleNode (catMaybes module_edges) node_type, concat todo )
where
- k = NodeKey_Module (msKey ms)
+ -- No sensible value for ModLocation.. if you hit this panic then you probably
+ -- need to add proper support for modules without any source files to the driver.
+ ml = pprPanic "modLocation" (ppr imod <+> ppr imps)
+ key = moduleToMnk imod NotBoot
+ node_type = ModuleNodeFixed key ml
- hs_file_for_boot
- | HsBootFile <- ms_hsc_src ms
- = Just (NormalLevel, NoPkgQual, (GWIB (noLoc $ ms_mod_name ms) NotBoot))
- | otherwise
- = Nothing
-
-loopModuleNodeInfos :: [ModuleNodeInfo] -> (M.Map NodeKey ModuleGraphNode, DownsweepCache) -> DownsweepM (M.Map NodeKey ModuleGraphNode, DownsweepCache)
-loopModuleNodeInfos is cache = foldM (flip loopModuleNodeInfo) cache is
-
-loopModuleNodeInfo :: ModuleNodeInfo -> (M.Map NodeKey ModuleGraphNode, DownsweepCache) -> DownsweepM (M.Map NodeKey ModuleGraphNode, DownsweepCache)
-loopModuleNodeInfo mod_node_info (done, summarised) = do
- case mod_node_info of
- ModuleNodeCompile ms -> do
- loopSummaries [ms] (done, summarised)
- ModuleNodeFixed mod ml -> do
- done' <- loopFixedModule mod ml done
- return (done', summarised)
-
--- NB: loopFixedModule does not take a downsweep cache, because if you
--- ever reach a Fixed node, everything under that also must be fixed.
-loopFixedModule :: ModNodeKeyWithUid -> ModLocation
- -> M.Map NodeKey ModuleGraphNode
- -> DownsweepM (M.Map NodeKey ModuleGraphNode)
-loopFixedModule key loc done = do
- let nk = NodeKey_Module key
- hsc_env <- asks downsweep_hsc_env
- case M.lookup nk done of
- Just {} -> return done
- Nothing -> do
- -- MP: TODO, we should just read the dependency info from the interface rather than either
- -- a. Loading the whole thing into the EPS (this might never nececssary and causes lots of things to be permanently loaded into memory)
- -- b. Loading the whole interface into a buffer before discarding it. (wasted allocation and deserialisation)
- read_result <- liftIO $
- -- 1. Check if the interface is already loaded into the EPS by some other
- -- part of the compiler.
- lookupIfaceByModuleHsc hsc_env (mnkToModule key) >>= \case
- Just iface -> return (M.Succeeded iface)
- Nothing -> readIface (hsc_hooks hsc_env) (hsc_logger hsc_env) (hsc_dflags hsc_env) (hsc_NC hsc_env) (mnkToModule key) (ml_hi_file loc)
- case read_result of
- M.Succeeded iface -> do
- -- Computer information about this node
- let node_deps = ifaceDeps (mi_deps iface)
- edges = map mkFixedEdge node_deps
- node = ModuleNode edges (ModuleNodeFixed key loc)
- foldM (loopFixedNodeKey (mnkUnitId key)) (M.insert nk node done) (bimap snd snd <$> node_deps)
- -- Ignore any failure, we might try to read a .hi-boot file for
- -- example, even if there is not one.
- M.Failed {} ->
- return done
-
-loopFixedNodeKey :: UnitId -> M.Map NodeKey ModuleGraphNode -> Either ModNodeKeyWithUid UnitId -> DownsweepM (M.Map NodeKey ModuleGraphNode)
-loopFixedNodeKey _ done (Left key) = do
- loopFixedImports [key] done
-loopFixedNodeKey home_uid done (Right uid) = do
- -- Set active unit so that looking loopUnit finds the correct
- -- -package flags in the unit state.
- hsc_env <- asks downsweep_hsc_env
- let hsc_env' = hscSetActiveUnitId home_uid hsc_env
- return $ loopUnit hsc_env' done [uid]
+--------------------------------------------------------------------------------
mkFixedEdge :: Either (ImportLevel, ModNodeKeyWithUid) (ImportLevel, UnitId) -> ModuleNodeEdge
mkFixedEdge (Left (lvl, key)) = mkModuleEdge lvl (NodeKey_Module key)
@@ -569,27 +700,6 @@ ifaceDeps deps =
| (lvl, uid) <- Set.toList (dep_direct_pkgs deps)
]
--- Like loopImports, but we already know exactly which module we are looking for.
-loopFixedImports :: [ModNodeKeyWithUid]
- -> M.Map NodeKey ModuleGraphNode
- -> DownsweepM (M.Map NodeKey ModuleGraphNode)
-loopFixedImports [] done = pure done
-loopFixedImports (key:keys) done = do
- let nk = NodeKey_Module key
- hsc_env <- asks downsweep_hsc_env
- case M.lookup nk done of
- Just {} -> loopFixedImports keys done
- Nothing -> do
- read_result <- liftIO $ findExactModule hsc_env (mnkToInstalledModule key) (mnkIsBoot key)
- case read_result of
- InstalledFound loc -> do
- done' <- loopFixedModule key loc done
- loopFixedImports keys done'
- _otherwise ->
- -- If the finder fails, just keep going, there will be another
- -- error later.
- loopFixedImports keys done
-
downsweepSummarise :: HomeUnit
-> IsBootInterface
-> Located ModuleName
@@ -597,90 +707,22 @@ downsweepSummarise :: HomeUnit
-> Maybe (StringBuffer, UTCTime)
-> DownsweepM SummariseResult
downsweepSummarise home_unit is_boot wanted_mod mb_pkg maybe_buf = do
- DownsweepEnv hsc_env mode old_summaries excl_mods <- ask
- case mode of
- DownsweepUseCompile -> liftIO $ summariseModule hsc_env home_unit old_summaries is_boot wanted_mod mb_pkg maybe_buf excl_mods
- DownsweepUseFixed -> liftIO $ summariseModuleInterface hsc_env home_unit is_boot wanted_mod mb_pkg excl_mods
-
-
--- This loops over each import in each summary. It is mutually recursive with
--- loopSummaries if we discover a new module by doing this.
-loopImports
- :: UnitId
- -- ^ UnitId of home unit of summary whose imports are being processed
- -> [(ImportLevel, PkgQual, GenWithIsBoot (Located ModuleName))]
- -- ^ Work list: process these modules
- -> M.Map NodeKey ModuleGraphNode
- -> DownsweepCache
- -- ^ Visited set; the range is a list because
- -- the roots can have the same module names
- -- if allow_dup_roots is True
- -> DownsweepM ([ModuleNodeEdge],
- M.Map NodeKey ModuleGraphNode, DownsweepCache)
- -- ^ The result is the completed NodeMap
-loopImports _ [] done summarised = return ([], done, summarised)
-loopImports home_uid ((imp, mb_pkg, gwib) : ss) done summarised
- | Just summs <- M.lookup cache_key summarised
- = case summs of
- [Right ms] -> do
- let nk = mkModuleEdge imp (NodeKey_Module (mnKey ms))
- (rest, summarised', done') <- loopImportsNext done summarised
- return (nk: rest, summarised', done')
- [Left _err] ->
- loopImportsNext done summarised
- _errs -> do
- loopImportsNext done summarised
- | otherwise
- = do
- hsc_env <- asks downsweep_hsc_env
- let home_unit = ue_unitHomeUnit home_uid (hsc_unit_env hsc_env)
- mb_s <- downsweepSummarise home_unit
- is_boot wanted_mod mb_pkg
- Nothing
- case mb_s of
- NotThere -> loopImportsNext done summarised
- External uid -> do
- -- Pass an updated hsc_env to loopUnit, as each unit might
- -- have a different visible package database.
- let hsc_env' = hscSetActiveHomeUnit home_unit hsc_env
- let done' = loopUnit hsc_env' done [uid]
- (other_deps, done'', summarised') <- loopImportsNext done' summarised
- return (mkModuleEdge imp (NodeKey_ExternalUnit uid) : other_deps, done'', summarised')
- FoundInstantiation iud -> do
- (other_deps, done', summarised') <- loopImportsNext done summarised
- return (mkModuleEdge imp (NodeKey_Unit iud) : other_deps, done', summarised')
- FoundHomeWithError (_uid, e) -> loopImportsNext done (Map.insert cache_key [(Left e)] summarised)
- FoundHome s -> do
- (done', summarised') <-
- loopModuleNodeInfo s (done, Map.insert cache_key [Right s] summarised)
- (other_deps, final_done, final_summarised) <- loopImportsNext done' summarised'
-
- -- MP: This assumes that we can only instantiate non home units, which is probably fair enough for now.
- return (mkModuleEdge imp (NodeKey_Module (mnKey s)) : other_deps, final_done, final_summarised)
- where
- loopImportsNext = loopImports home_uid ss
- cache_key = (home_uid, mb_pkg, unLoc <$> gwib)
- GWIB { gwib_mod = L loc mod, gwib_isBoot = is_boot } = gwib
- wanted_mod = L loc mod
-
-loopUnit :: HscEnv -> Map.Map NodeKey ModuleGraphNode -> [UnitId] -> Map.Map NodeKey ModuleGraphNode
-loopUnit _ cache [] = cache
-loopUnit lcl_hsc_env cache (u:uxs) = do
- let nk = (NodeKey_ExternalUnit u)
- case Map.lookup nk cache of
- Just {} -> loopUnit lcl_hsc_env cache uxs
- Nothing -> case unitDepends <$> lookupUnitId (hsc_units lcl_hsc_env) u of
- Just us -> loopUnit lcl_hsc_env (loopUnit lcl_hsc_env (Map.insert nk (UnitNode us u) cache) us) uxs
- Nothing -> pprPanic "loopUnit" (text "Malformed package database, missing " <+> ppr u)
-
-multiRootsErr :: SourceErrorContext -> [ModuleNodeInfo] -> IO ()
-multiRootsErr _ [] = panic "multiRootsErr"
-multiRootsErr sec summs@(summ1:_)
+ DownsweepEnv hsc_env mode summaries_cache_ref imports_cache_ref excl_mods <- ask
+ liftIO $ case mode of
+ DownsweepUseCompile ->
+ summariseModule hsc_env home_unit summaries_cache_ref imports_cache_ref
+ is_boot wanted_mod mb_pkg maybe_buf excl_mods
+ DownsweepUseFixed ->
+ summariseModuleInterface hsc_env home_unit imports_cache_ref is_boot
+ wanted_mod mb_pkg excl_mods
+
+multiRootsErr :: SourceErrorContext -> NE.NonEmpty ModuleNodeInfo -> IO ()
+multiRootsErr sec (summ1 NE.:| summs)
= throwOneError sec $ fmap GhcDriverMessage $
mkPlainErrorMsgEnvelope noSrcSpan $ DriverDuplicatedModuleDeclaration mod files
where
mod = moduleNodeInfoModule summ1
- files = mapMaybe (ml_hs_file . moduleNodeInfoLocation) summs
+ files = mapMaybe (ml_hs_file . moduleNodeInfoLocation) (summ1:summs)
moduleNotFoundErr :: UnitId -> ModuleName -> DriverMessages
moduleNotFoundErr uid mod = singleMessage $ mkPlainErrorMsgEnvelope noSrcSpan (DriverModuleNotFound uid mod)
@@ -734,24 +776,25 @@ linkNodes summaries uid hue =
getRootSummary ::
[ModuleName] ->
- M.Map (UnitId, OsPath) ModSummary ->
+ ModSummaryCache ->
+ ImportsCache ->
HscEnv ->
Target ->
IO (Either DriverMessages ModSummary)
-getRootSummary excl_mods old_summary_map hsc_env target
+getRootSummary excl_mods summ_cache imports_cache hsc_env target
| TargetFile file mb_phase <- targetId
= do
let offset_file = augmentByWorkingDirectory dflags file
exists <- liftIO $ doesFileExist offset_file
if exists || isJust maybe_buf
- then summariseFile hsc_env home_unit old_summary_map offset_file mb_phase
+ then summariseFile hsc_env home_unit summ_cache offset_file mb_phase
maybe_buf
else
return $ Left $ singleMessage $
mkPlainErrorMsgEnvelope noSrcSpan (DriverFileNotFound offset_file)
| TargetModule modl <- targetId
= do
- maybe_summary <- summariseModule hsc_env home_unit old_summary_map NotBoot
+ maybe_summary <- summariseModule hsc_env home_unit summ_cache imports_cache NotBoot
(L rootLoc modl) (ThisPkg (homeUnitId home_unit))
maybe_buf excl_mods
pure case maybe_summary of
@@ -1179,13 +1222,6 @@ Potential TODOS:
generating temporary ones.
-}
--- | Populate the Downsweep cache with the root modules.
-mkRootMap
- :: [ModuleNodeInfo]
- -> DownsweepCache
-mkRootMap summaries = Map.fromListWith (flip (++))
- [ ((moduleNodeInfoUnitId s, NoPkgQual, moduleNodeInfoMnwib s), [Right s]) | s <- summaries ]
-
-----------------------------------------------------------------------------
-- Summarising modules
@@ -1202,33 +1238,39 @@ mkRootMap summaries = Map.fromListWith (flip (++))
summariseFile
:: HscEnv
-> HomeUnit
- -> M.Map (UnitId, OsPath) ModSummary -- old summaries
+ -> ModSummaryCache
-> FilePath -- source file name
-> Maybe Phase -- start phase
-> Maybe (StringBuffer,UTCTime)
-> IO (Either DriverMessages ModSummary)
-summariseFile hsc_env' home_unit old_summaries src_fn mb_phase maybe_buf
- -- we can use a cached summary if one is available and the
- -- source file hasn't changed,
- | Just old_summary <- M.lookup (homeUnitId home_unit, src_fn_os) old_summaries
- = do
- let location = ms_location $ old_summary
-
- src_hash <- get_src_hash
- -- The file exists; we checked in getRootSummary above.
- -- If it gets removed subsequently, then this
- -- getFileHash may fail, but that's the right
- -- behaviour.
-
- -- return the cached summary if the source didn't change
- checkSummaryHash
- hsc_env (new_summary src_fn)
- old_summary location src_hash
-
- | otherwise
- = do src_hash <- get_src_hash
- new_summary src_fn src_hash
+summariseFile hsc_env' home_unit summ_cache_ref src_fn mb_phase maybe_buf
+ = do file_summ_cache <- readIORef summ_cache_ref
+ case M.lookup (homeUnitId home_unit, src_fn_os) file_summ_cache of
+ Just (Right (chd_summary, SummFresh)) ->
+ -- Fresh: use it straight away
+ pure (Right chd_summary)
+ Just (Right (old_summary, SummOld)) -> do
+ -- we can use a cached summary if one is available and the
+ -- source file hasn't changed,
+ let location = ms_location $ old_summary
+
+ src_hash <- get_src_hash
+ -- The file exists; we checked in getRootSummary above.
+ -- If it gets removed subsequently, then this
+ -- getFileHash may fail, but that's the right
+ -- behaviour.
+
+ -- return the cached summary if the source didn't change
+ res <- checkSummaryHash
+ hsc_env (new_summary src_fn)
+ old_summary location src_hash
+ case res of
+ Right ms -> modifySummCache summ_cache_ref (addModSummaryCache ms SummFresh)
+ Left _ -> pure ()
+ return res
+ _ -> do src_hash <- get_src_hash
+ new_summary src_fn src_hash
where
-- change the main active unit so all operations happen relative to the given unit
hsc_env = hscSetActiveHomeUnit home_unit hsc_env'
@@ -1239,7 +1281,8 @@ summariseFile hsc_env' home_unit old_summaries src_fn mb_phase maybe_buf
Just (buf,_) -> return $ fingerprintStringBuffer buf
Nothing -> liftIO $ getFileHash src_fn
- new_summary src_fn src_hash = runExceptT $ do
+ new_summary src_fn src_hash = do
+ res <- runExceptT $ do
preimps@PreprocessedImports {..}
<- getPreprocessedImports hsc_env src_fn mb_phase maybe_buf
@@ -1270,6 +1313,10 @@ summariseFile hsc_env' home_unit old_summaries src_fn mb_phase maybe_buf
, nms_mod = mod
, nms_preimps = preimps
}
+ modifySummCache summ_cache_ref $ case res of
+ Left e -> M.insert (homeUnitId home_unit, src_fn_os) (Left e)
+ Right ms -> addModSummaryCache ms SummFresh
+ return res
checkSummaryHash
:: HscEnv
@@ -1322,15 +1369,16 @@ data SummariseResult =
-- --make mode.
summariseModule :: HscEnv
-> HomeUnit
- -> M.Map (UnitId, OsPath) ModSummary
+ -> ModSummaryCache
+ -> ImportsCache
-> IsBootInterface
-> Located ModuleName
-> PkgQual
-> Maybe (StringBuffer, UTCTime)
-> [ModuleName]
-> IO SummariseResult
-summariseModule hsc_env home_unit old_summaries is_boot wanted_mod mb_pkg maybe_buf excl_mods =
- summariseModuleDispatch k hsc_env home_unit is_boot wanted_mod mb_pkg excl_mods
+summariseModule hsc_env home_unit old_summaries imps_cache is_boot wanted_mod mb_pkg maybe_buf excl_mods =
+ summariseModuleDispatch k hsc_env imps_cache home_unit is_boot wanted_mod mb_pkg excl_mods
where
k = summariseModuleWithSource home_unit old_summaries is_boot maybe_buf
@@ -1339,13 +1387,14 @@ summariseModule hsc_env home_unit old_summaries is_boot wanted_mod mb_pkg maybe_
-- This version always returns a ModuleNodeFixed node.
summariseModuleInterface :: HscEnv
-> HomeUnit
+ -> ImportsCache
-> IsBootInterface
-> Located ModuleName
-> PkgQual
-> [ModuleName]
-> IO SummariseResult
-summariseModuleInterface hsc_env home_unit is_boot wanted_mod mb_pkg excl_mods =
- summariseModuleDispatch k hsc_env home_unit is_boot wanted_mod mb_pkg excl_mods
+summariseModuleInterface hsc_env home_unit imps_cache is_boot wanted_mod mb_pkg excl_mods =
+ summariseModuleDispatch k hsc_env imps_cache home_unit is_boot wanted_mod mb_pkg excl_mods
where
k _hsc_env loc mod = do
-- The finder will return a path to the .hi-boot even if it doesn't actually
@@ -1362,6 +1411,7 @@ summariseModuleInterface hsc_env home_unit is_boot wanted_mod mb_pkg excl_mods =
summariseModuleDispatch
:: (HscEnv -> ModLocation -> Module -> IO SummariseResult) -- ^ Continuation about how to summarise a home module.
-> HscEnv
+ -> ImportsCache
-> HomeUnit
-> IsBootInterface -- True <=> a {-# SOURCE #-} import
-> Located ModuleName -- Imported module to be summarised
@@ -1370,7 +1420,7 @@ summariseModuleDispatch
-> IO SummariseResult
-summariseModuleDispatch k hsc_env' home_unit is_boot (L _ wanted_mod) mb_pkg excl_mods
+summariseModuleDispatch k hsc_env' imps_cache_ref home_unit is_boot (L _ wanted_mod) mb_pkg excl_mods
| wanted_mod `elem` excl_mods
= return NotThere
| otherwise = find_it
@@ -1380,112 +1430,133 @@ summariseModuleDispatch k hsc_env' home_unit is_boot (L _ wanted_mod) mb_pkg exc
hsc_env = hscSetActiveHomeUnit home_unit hsc_env'
find_it :: IO SummariseResult
-
find_it = do
- found <- findImportedModuleWithIsBoot hsc_env wanted_mod is_boot mb_pkg
- case found of
- Found location mod
- | moduleUnitId mod `Set.member` hsc_all_home_unit_ids hsc_env ->
- -- Home package
- k hsc_env location mod
- | VirtUnit iud <- moduleUnit mod
- , not (isHomeModule home_unit mod)
- -> return $ FoundInstantiation iud
- | otherwise -> return $ External (moduleUnitId mod)
- _ -> return NotThere
- -- Not found
- -- (If it is TRULY not found at all, we'll
- -- error when we actually try to compile)
-
+ imps_cache <- readIORef imps_cache_ref
+ case M.lookup cache_key imps_cache of
+ Just result -> return result
+ Nothing -> do
+ found <- findImportedModuleWithIsBoot hsc_env wanted_mod is_boot mb_pkg
+ r <- case found of
+ Found location mod
+ | moduleUnitId mod `Set.member` hsc_all_home_unit_ids hsc_env ->
+ -- Home package
+ k hsc_env location mod
+ | VirtUnit iud <- moduleUnit mod
+ , not (isHomeModule home_unit mod)
+ -> return $ FoundInstantiation iud
+ | otherwise -> return $ External (moduleUnitId mod)
+ _ -> return NotThere
+ -- Not found
+ -- (If it is TRULY not found at all, we'll
+ -- error when we actually try to compile)
+ modifyImpsCache imps_cache_ref (M.insert cache_key r)
+ return r
+
+ cache_key = ( homeUnitId home_unit, mb_pkg
+ , GWIB{ gwib_mod = wanted_mod, gwib_isBoot = is_boot })
-- | The continuation to summarise a home module if we want to find the source file
-- for it and potentially compile it.
summariseModuleWithSource
:: HomeUnit
- -> M.Map (UnitId, OsPath) ModSummary
- -- ^ Map of old summaries
+ -> ModSummaryCache
+ -- ^ Cache of constructed summaries
-> IsBootInterface -- True <=> a {-# SOURCE #-} import
-> Maybe (StringBuffer, UTCTime)
-> HscEnv
-> ModLocation
-> Module
-> IO SummariseResult
-summariseModuleWithSource home_unit old_summary_map is_boot maybe_buf hsc_env location mod = do
- -- Adjust location to point to the hs-boot source file,
- -- hi file, object file, when is_boot says so
- let src_fn = expectJust (ml_hs_file location)
-
- -- Check that it exists
- -- It might have been deleted since the Finder last found it
+summariseModuleWithSource home_unit summ_cache_ref is_boot maybe_buf hsc_env location mod = do
+ -- Adjust location to point to the hs-boot source file,
+ -- hi file, object file, when is_boot says so
+ let src_fn = expectJust (ml_hs_file location)
+ summ_cache <- readIORef summ_cache_ref
+ case ml_hs_file_ospath location >>= \p -> M.lookup (moduleUnitId mod, p) summ_cache of
+ Just (Right (chd_summary, SummFresh)) ->
+ -- Fresh! just return it
+ pure $ FoundHome (ModuleNodeCompile chd_summary)
+
+ Just (Left err) ->
+ -- Failure, don't try to summarise it again
+ pure $ FoundHomeWithError (moduleUnitId mod, err)
+
+ mb_old -> do
+ -- Either Nothing or a potentially old summary, must check.
+
+ -- Check that it exists
+ -- It might have been deleted since the Finder last found it
maybe_h <- fileHashIfExists src_fn
case maybe_h of
-- This situation can also happen if we have found the .hs file but the
-- .hs-boot file doesn't exist.
Nothing -> return NotThere
Just h -> do
- fresult <- new_summary_cache_check location mod src_fn h
+ fresult <- case mb_old of
+ Just (Right (old_summary, SummOld)) ->
+ -- check the hash on the source file, and return the cached
+ -- summary if it hasn't changed. If the file has changed then
+ -- need to resummarise.
+ case maybe_buf of
+ Just (buf,_) ->
+ checkSummaryHash hsc_env (new_summary location mod src_fn) old_summary location (fingerprintStringBuffer buf)
+ Nothing ->
+ checkSummaryHash hsc_env (new_summary location mod src_fn) old_summary location h
+ Nothing ->
+ new_summary location mod src_fn h
return $ case fresult of
Left err -> FoundHomeWithError (moduleUnitId mod, err)
Right ms -> FoundHome (ModuleNodeCompile ms)
-
where
dflags = hsc_dflags hsc_env
- new_summary_cache_check loc mod src_fn h
- | Just old_summary <- Map.lookup ((toUnitId (moduleUnit mod), src_fn_os)) old_summary_map =
-
- -- check the hash on the source file, and
- -- return the cached summary if it hasn't changed. If the
- -- file has changed then need to resummarise.
- case maybe_buf of
- Just (buf,_) ->
- checkSummaryHash hsc_env (new_summary loc mod src_fn) old_summary loc (fingerprintStringBuffer buf)
- Nothing ->
- checkSummaryHash hsc_env (new_summary loc mod src_fn) old_summary loc h
- | otherwise = new_summary loc mod src_fn h
- where
- src_fn_os = unsafeEncodeUtf src_fn
-
new_summary :: ModLocation
-> Module
-> FilePath
-> Fingerprint
-> IO (Either DriverMessages ModSummary)
new_summary location mod src_fn src_hash
- = runExceptT $ do
- preimps@PreprocessedImports {..}
- -- Remember to set the active unit here, otherwise the wrong include paths are passed to CPP
- -- See multiHomeUnits_cpp2 test
- <- getPreprocessedImports (hscSetActiveUnitId (moduleUnitId mod) hsc_env) src_fn Nothing maybe_buf
-
- -- NB: Despite the fact that is_boot is a top-level parameter, we
- -- don't actually know coming into this function what the HscSource
- -- of the module in question is. This is because we may be processing
- -- this module because another module in the graph imported it: in this
- -- case, we know if it's a boot or not because of the {-# SOURCE #-}
- -- annotation, but we don't know if it's a signature or a regular
- -- module until we actually look it up on the filesystem.
- let hsc_src
- | is_boot == IsBoot = HsBootFile
- | isHaskellSigFilename src_fn = HsigFile
- | otherwise = HsSrcFile
-
- when (pi_mod_name /= moduleName mod) $
- throwE $ singleMessage $ mkPlainErrorMsgEnvelope pi_mod_name_loc
- $ DriverFileModuleNameMismatch pi_mod_name (moduleName mod)
-
- let instantiations = homeUnitInstantiations home_unit
- when (hsc_src == HsigFile && isNothing (lookup pi_mod_name instantiations)) $
- throwE $ singleMessage $ mkPlainErrorMsgEnvelope pi_mod_name_loc
- $ DriverUnexpectedSignature pi_mod_name (checkBuildingCabalPackage dflags) instantiations
-
- liftIO $ makeNewModSummary hsc_env $ MakeNewModSummary
- { nms_src_fn = src_fn
- , nms_src_hash = src_hash
- , nms_hsc_src = hsc_src
- , nms_location = location
- , nms_mod = mod
- , nms_preimps = preimps
- }
+ = do
+ res <- runExceptT $ do
+ preimps@PreprocessedImports {..}
+ -- Remember to set the active unit here, otherwise the wrong include paths are passed to CPP
+ -- See multiHomeUnits_cpp2 test
+ <- getPreprocessedImports (hscSetActiveUnitId (moduleUnitId mod) hsc_env) src_fn Nothing maybe_buf
+
+ -- NB: Despite the fact that is_boot is a top-level parameter, we
+ -- don't actually know coming into this function what the HscSource
+ -- of the module in question is. This is because we may be processing
+ -- this module because another module in the graph imported it: in this
+ -- case, we know if it's a boot or not because of the {-# SOURCE #-}
+ -- annotation, but we don't know if it's a signature or a regular
+ -- module until we actually look it up on the filesystem.
+ let hsc_src
+ | is_boot == IsBoot = HsBootFile
+ | isHaskellSigFilename src_fn = HsigFile
+ | otherwise = HsSrcFile
+
+ when (pi_mod_name /= moduleName mod) $
+ throwE $ singleMessage $ mkPlainErrorMsgEnvelope pi_mod_name_loc
+ $ DriverFileModuleNameMismatch pi_mod_name (moduleName mod)
+
+ let instantiations = homeUnitInstantiations home_unit
+ when (hsc_src == HsigFile && isNothing (lookup pi_mod_name instantiations)) $
+ throwE $ singleMessage $ mkPlainErrorMsgEnvelope pi_mod_name_loc
+ $ DriverUnexpectedSignature pi_mod_name (checkBuildingCabalPackage dflags) instantiations
+
+ liftIO $ makeNewModSummary hsc_env $ MakeNewModSummary
+ { nms_src_fn = src_fn
+ , nms_src_hash = src_hash
+ , nms_hsc_src = hsc_src
+ , nms_location = location
+ , nms_mod = mod
+ , nms_preimps = preimps
+ }
+ modifySummCache summ_cache_ref $ case res of
+ Left e -> case ml_hs_file_ospath location of
+ Just p -> M.insert (moduleUnitId mod, p) (Left e)
+ Nothing -> id
+ Right ms -> addModSummaryCache ms SummFresh
+ return res
-- | Convenience named arguments for 'makeNewModSummary' only used to make
-- code more readable, not exported.
@@ -1508,7 +1579,6 @@ makeNewModSummary hsc_env MakeNewModSummary{..} = do
hie_timestamp <- modificationTimeIfExists (ml_hie_file_ospath nms_location)
bytecode_timestamp <- modificationTimeIfExists (ml_bytecode_file_ospath nms_location)
extra_sig_imports <- findExtraSigImports hsc_env nms_hsc_src pi_mod_name
- (implicit_sigs, _inst_deps) <- implicitRequirementsShallow (hscSetActiveUnitId (moduleUnitId nms_mod) hsc_env) pi_theimps
return $
ModSummary
@@ -1522,7 +1592,6 @@ makeNewModSummary hsc_env MakeNewModSummary{..} = do
, ms_srcimps = pi_srcimps
, ms_textual_imps =
((,,) NormalLevel NoPkgQual . noLoc <$> extra_sig_imports) ++
- ((,,) NormalLevel NoPkgQual . noLoc <$> implicit_sigs) ++
pi_theimps
, ms_hs_hash = nms_src_hash
, ms_iface_date = hi_timestamp
@@ -1568,3 +1637,116 @@ getPreprocessedImports hsc_env src_fn mb_phase maybe_buf = do
let pi_srcimps = pi_srcimps'
let pi_theimps = rn_imps pi_theimps'
return PreprocessedImports {..}
+
+--------------------------------------------------------------------------------
+
+-- | The result of expanding a node in 'dfsBuild'.
+data MGRes v
+ -- | Computed the node payload successfully
+ = NSuccess v
+ -- | Skip a node! This means this node doesn't produce a payload and we can
+ -- just ignore it if we ever come across it.
+ --
+ -- In practice, this might happen because of an error or maybe from an
+ -- attempt to expand e.g. an hs-boot node just to see if it sticks, but we
+ -- don't distinguish these uses. Skip just means ignore this node and don't
+ -- abort.
+ | NSkip
+
+-- | In a depth-first order, and starting from the given roots, traverse a
+-- graph by iteratively expanding a node into a payload and a list of children
+-- nodes to visit next.
+--
+-- A node is NEVER visited/expanded more than once, as long as the the
+-- node key @k@, computed from the node @n@, uniquely identifies that node.
+--
+-- The first argument @base_map@ is the starting set of already visited nodes
+-- (these nodes won't be expanded again!).
+--
+-- The result is a mapping from the key of every node transitively reachable
+-- from the root nodes (inclusively) to the payload returned by expanding that
+-- node. The result includes the previously visited nodes given in @base_map@,
+-- s.t. @dfsBuild base_map [] _ _ == base_map@.
+--
+-- The @expand@ function returns an 'NResult'. See the 'NResult' documentation
+-- for more information about each result type.
+--
+-- Error handling and exiting early can be achieved by selecting a @Monad m@
+-- accordingly, such as @Control.Monad.Except.Except@
+--
+-- Example usage: @n@ is instanced to @DownsweepNode@, @k@ is @NodeKey@, and @v@ is @ModuleNodeEdge@.
+--
+-- See also Note [Downsweep Control Flow and Caching]
+dfsBuild :: (Ord k, Monad m)
+ => Maybe (Map.Map k (MGRes v))
+ -- ^ Base map, existing results. We won't re-expand any of the nodes
+ -- already present in this map.
+ -> [n]
+ -- ^ The root nodes from where to start traversal
+ -> (n -> k)
+ -- ^ Compute the key which uniquely identifies this node
+ -> (n -> m (MGRes (v,[n])))
+ -- ^ Expand this node into its payload result and into the list of
+ -- children nodes to visit next.
+ -> m (Map.Map k (MGRes v))
+ -- ^ The result accumulates the payload of expanding the root nodes
+ -- and all nodes transitively reachable from those roots.
+dfsBuild base_map roots key expand = go roots (fromMaybe Map.empty base_map)
+ where
+ go [] visited = pure visited
+ go (s:ss) visited
+ | k `Map.member` visited
+ = go ss visited
+ | otherwise
+ = do r <- expand s
+ case r of
+ NSkip ->
+ go ss
+ (Map.insert k NSkip visited) -- Skip!
+ NSuccess (v,ns) ->
+ go (ns ++ ss {- todo: not use ++ here? -})
+ (Map.insert k (NSuccess v) visited)
+ where
+ k = key s
+
+{-
+Note [Downsweep Control Flow and Caching]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+The control flow of downsweep is extracted into a single function `dfsBuild`,
+which takes care of iteratively expanding and traversing all nodes of the
+in-construction module graph necessary to build a full `ModuleGraph` at the
+end.
+
+There are three levels of caching going on, all of which are necessary to make
+sure we don't do repeated work (notably, we NEVER summarise the same module
+twice).
+
+1. `dfsBuild` accumulates the final module graph and never revisits the
+ same node of the module graph. Cache is keyed by the final
+ `ModuleGraph`s `NodeKey`s.
+
+2. For Module A in home-unit u1, each import in the list of imports
+ needs to be *found* (call to `findImportedModuleWithIsBoot`): at this
+ point, we only have the `ModuleName` of the import, not the `Module`.
+ This *finding* is somewhat expensive, so we cache it as well
+ (`ImportsCache`). The cache key is the home-unit to which the module
+ belongs~[1], the import package qualifier, and the ModuleName.
+
+ [1] Different home-units will have different package flags, which means
+ potentially different `Module` resolution for the same `ModuleName`.
+
+3. The most expensive operation we want to avoid is summarising a
+ `Module` into a `ModSummary`, which notably involves parsing the
+ module header from scratch.
+ The third cache, in essence, maps a `Module` to its `ModSummary`
+ (named `ModSummaryCache`). This cache upholds the invariant: we NEVER
+ summarise the same module twice. In practice, the cache key is the
+ Module's UnitId and the Source path; the reason is we need to
+ distinguish between `.hs` and `.hs-boot` files, as their summaries
+ will differ.
+
+ Note that (2) can't guarantee this alone: Two ModuleName imports in
+ separate units can (and likely do) map to the same `Module`.
+
+See also Note [Downsweep and the ModuleGraph]
+-}
=====================================
compiler/GHC/Tc/Utils/Backpack.hs
=====================================
@@ -291,28 +291,28 @@ implicitRequirements hsc_env normal_imports
where
mhome_unit = hsc_home_unit_maybe hsc_env
--- | Like @implicitRequirements'@, but returns either the module name, if it is
--- a free hole, or the instantiated unit the imported module is from, so that
--- that instantiated unit can be processed and via the batch mod graph (rather
--- than a transitive closure done here) all the free holes are still reachable.
+-- | Like @implicitRequirements'@, but returns the instantiated unit the
+-- imported module is from, so that that instantiated unit can be processed and
+-- via the batch mod graph (rather than a transitive closure done here) all the
+-- free holes are still reachable.
implicitRequirementsShallow
:: HscEnv
-> [(ImportLevel, PkgQual, Located ModuleName)]
- -> IO ([ModuleName], [InstantiatedUnit])
-implicitRequirementsShallow hsc_env normal_imports = go ([], []) normal_imports
+ -> IO [InstantiatedUnit]
+implicitRequirementsShallow hsc_env normal_imports = go [] normal_imports
where
mhome_unit = hsc_home_unit_maybe hsc_env
go acc [] = pure acc
- go (accL, accR) ((_stage, mb_pkg, L _ imp):imports) = do
+ go accR ((_stage, mb_pkg, L _ imp):imports) = do
found <- findImportedModule hsc_env imp mb_pkg
let acc' = case found of
Found _ mod | notHomeModuleMaybe mhome_unit mod ->
case moduleUnit mod of
- HoleUnit -> (moduleName mod : accL, accR)
- RealUnit _ -> (accL, accR)
- VirtUnit u -> (accL, u:accR)
- _ -> (accL, accR)
+ HoleUnit -> panic "implicitRequirementsShallow: HoleUnit is unreachable through findImportedModule!"
+ RealUnit _ -> accR
+ VirtUnit u -> u:accR
+ _ -> accR
go acc' imports
-- | Given a 'Unit', make sure it is well typed. This is because
=====================================
testsuite/tests/ghc-api/fixed-nodes/FixedNodes.hs
=====================================
@@ -24,6 +24,7 @@ import Control.Monad.Catch (handle, throwM)
import Control.Exception.Context
import GHC.Driver.MakeFile
import GHC.Utils.Outputable
+import Data.IORef (newIORef)
-- | Convert a ModuleNodeCompile to a ModuleNodeFixed
convertToFixed :: ModuleNodeInfo -> ModuleNodeInfo
convertToFixed (ModuleNodeCompile ms) =
@@ -151,5 +152,6 @@ main = do
getModSummaryFromTarget :: FilePath -> Ghc ModSummary
getModSummaryFromTarget file = do
hsc_env <- getSession
- Right ms <- liftIO $ summariseFile hsc_env (DefiniteHomeUnit mainUnitId Nothing) mempty file Nothing Nothing
+ summ_cache <- liftIO $ newIORef mempty
+ Right ms <- liftIO $ summariseFile hsc_env (DefiniteHomeUnit mainUnitId Nothing) summ_cache file Nothing Nothing
return ms
=====================================
testsuite/tests/ghc-api/fixed-nodes/InterfaceModuleGraph.hs
=====================================
@@ -16,6 +16,7 @@ import GHC.Types.SourceFile
import System.Environment
import Control.Monad (void, when)
import Data.Maybe (fromJust)
+import Data.IORef (newIORef)
import Control.Exception (ExceptionWithContext(..), SomeException)
import Control.Monad.Catch (handle, throwM)
import Control.Exception.Context
@@ -67,7 +68,9 @@ main = do
keyC = msKey msC
let mkGraph s = do
- ([], nodes) <- downsweepFromRootNodes hsc_env mempty Nothing [] True DownsweepUseFixed s []
+ summ_cache <- newIORef mempty
+ imps_cache <- newIORef mempty
+ ([], nodes) <- downsweepFromRootNodes hsc_env summ_cache imps_cache Nothing [] True DownsweepUseFixed s []
return $ mkModuleGraph nodes
graph <- liftIO $ mkGraph [ModuleNodeCompile msC]
@@ -98,5 +101,6 @@ main = do
getModSummaryFromTarget :: FilePath -> Ghc ModSummary
getModSummaryFromTarget file = do
hsc_env <- getSession
- Right ms <- liftIO $ summariseFile hsc_env (DefiniteHomeUnit mainUnitId Nothing) mempty file Nothing Nothing
+ summ_cache <- liftIO $ newIORef mempty
+ Right ms <- liftIO $ summariseFile hsc_env (DefiniteHomeUnit mainUnitId Nothing) summ_cache file Nothing Nothing
return ms
=====================================
testsuite/tests/ghc-api/fixed-nodes/ModuleGraphInvariants.hs
=====================================
@@ -23,6 +23,7 @@ import Control.Monad.Catch (handle, throwM)
import Control.Exception.Context
import GHC.Utils.Outputable
import Data.List
+import Data.IORef (newIORef)
-- | Convert a ModuleNodeCompile to a ModuleNodeFixed
convertToFixed :: ModuleNodeInfo -> ModuleNodeInfo
@@ -132,5 +133,6 @@ main = do
getModSummaryFromTarget :: FilePath -> Ghc ModSummary
getModSummaryFromTarget file = do
hsc_env <- getSession
- Right ms <- liftIO $ summariseFile hsc_env (DefiniteHomeUnit mainUnitId Nothing) mempty file Nothing Nothing
+ summ_cache <- liftIO $ newIORef mempty
+ Right ms <- liftIO $ summariseFile hsc_env (DefiniteHomeUnit mainUnitId Nothing) summ_cache file Nothing Nothing
return ms
=====================================
testsuite/tests/splice-imports/SI35.hs
=====================================
@@ -28,6 +28,7 @@ import GHC.Unit.Module.Stage
import GHC.Data.Graph.Directed.Reachability
import GHC.Utils.Trace
import GHC.Unit.Module.Graph
+import Data.IORef (newIORef)
main :: IO ()
main = do
@@ -75,5 +76,6 @@ main = do
getModSummaryFromTarget :: FilePath -> Ghc ModSummary
getModSummaryFromTarget file = do
hsc_env <- getSession
- Right ms <- liftIO $ summariseFile hsc_env (DefiniteHomeUnit mainUnitId Nothing) mempty file Nothing Nothing
+ summ_cache <- liftIO $ newIORef mempty
+ Right ms <- liftIO $ summariseFile hsc_env (DefiniteHomeUnit mainUnitId Nothing) summ_cache file Nothing Nothing
return ms
\ No newline at end of file
=====================================
utils/check-ppr/Main.hs
=====================================
@@ -18,6 +18,7 @@ import System.Environment( getArgs )
import System.Exit
import System.FilePath
import System.IO
+import Data.IORef
usage :: String
usage = unlines
@@ -85,7 +86,8 @@ parseOneFile libdir fileName = do
let dflags2 = dflags `gopt_set` Opt_KeepRawTokenStream
_ <- setSessionDynFlags dflags2
hsc_env <- getSession
- mms <- liftIO $ summariseFile hsc_env (hsc_home_unit hsc_env) mempty fileName Nothing Nothing
+ cache <- liftIO $ newIORef mempty
+ mms <- liftIO $ summariseFile hsc_env (hsc_home_unit hsc_env) cache fileName Nothing Nothing
case mms of
Left _err -> error "parseOneFile"
Right ms -> parseModule ms
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/39c83aef286003aab5d12c13ef248b…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/39c83aef286003aab5d12c13ef248b…
You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help
1
0
[Git][ghc/ghc][wip/21101] 12 commits: hadrian: fix HLS support
by Sasha Bogicevic (＠Bogicevic) 16 Jul '26
by Sasha Bogicevic (＠Bogicevic) 16 Jul '26
16 Jul '26
Sasha Bogicevic pushed to branch wip/21101 at Glasgow Haskell Compiler / GHC
Commits:
ed261a7e by Cheng Shao at 2026-07-14T17:59:38-04:00
hadrian: fix HLS support
This patch fixes hadrian's HLS support so one can rely on HLS when
working on the hadrian codebase. Fixes #27480.
Not building/linking shared libraries for hadrian is a severely
premature optimization; this top-level setting in `cabal.project` only
affects home packages while the dependencies in the cabal store are
built with vanilla/dynamic anyway, and even adding dynamic builds to
home packages would not be costly due to cabal's usage of
`-dynamic-too`.
- - - - -
eee8ec5b by Cheng Shao at 2026-07-14T18:00:20-04:00
compiler: fix miscompiled %load_relaxed, add missing %store_relaxed
This patch fixes the %load_relaxed cmm primop compilation logic to
correctly use relaxed memory ordering, and adds the missing
%store_relaxed primop. Parsing logic of %load/%store with explicit
ordering is covered in the AtomicFetch test case. Fixes #27483.
Co-authored-by: Codex <codex(a)openai.com>
- - - - -
1718230f by Alan Zimmerman at 2026-07-14T18:01:06-04:00
EPA: Keep binds and sigs together in HsValBindsLR
We combine them into a single list for GhcPs, wrapped in the
ValBind data type, which is the bind equivalent of ValD, having
constructors for binds and sigs.
This simplifies exact print processing, especially when using it to
update the contents of local binds, as we no longer need AnnSortKey
BindTag
- - - - -
6bd1ad2a by Andreas Klebinger at 2026-07-14T18:01:49-04:00
Bump nofib submodule to account for MonoLocalBinds.
New versions of GHC enable MonoLocalBinds by default.
This breaks some of the benchmarks. I've fixed this and
this bump pulls in that fix.
- - - - -
7eb0f1c9 by Cheng Shao at 2026-07-14T18:02:31-04:00
testsuite: fix bytecodeIPE test under +ipe flavours
This patch fixes the bytecodeIPE test under +ipe flavours. It used to
fail under +ipe because the RTS is built with IPE info, then
stg_AP_info in RTS carries IPE info, so whereFrom wouldn't return
Nothing. Now the test checks IPE info of a datacon in the ghci-loaded
module which is not affected by whether the RTS is built with IPE info
or not. Fixes #27498.
Co-authored-by: Codex <codex(a)openai.com>
- - - - -
ef038aae by cydparser at 2026-07-15T04:35:41-04:00
Reduce bytes allocated for `capabilities` in RTS (fixes #27487)
In rts/Capability.c, `capabilities` is an array of pointers, but it was allocated as if it were an
array of Capability's.
- - - - -
d377e83e by Cheng Shao at 2026-07-15T04:36:27-04:00
rts: fix missing UNTAG in stg_readTVarIOzh
This patch fixes missing UNTAG on the current value closure read from
StgTVar. UNTAG is a no-op when it's stg_TREC_HEADER_info which is word
aligned; it may be a tagged closure, and reading info table from the
tagged address is an unaligned load which may cause issues on
platforms with strict alignment requirements.
Co-authored-by: Codex <codex(a)openai.com>
- - - - -
8ed03842 by Cheng Shao at 2026-07-15T04:36:27-04:00
rts: fix missing UNTAG in stg_control0zh_ll
This patch fixes missing UNTAG on the cont closure returned by
captureContinuationAndAbort. In case it's not NULL,
captureContinuationAndAbort returns a tagged StgContinuation closure,
in which case it must be untagged before accessing the
apply_mask_frame field.
In the past it worked out of luck: when apply_mask_frame was NULL then
mask_frame_offset is also 0 so the control flow didn't diverge to a
wrong path. Still, this is horribly wrong and will crash once
StgContinuation struct is refactored and fields are shuffled around.
Co-authored-by: Codex <codex(a)openai.com>
- - - - -
5aa7000a by Cheng Shao at 2026-07-15T04:37:08-04:00
compiler: fix redundant AP thunk codegen when not using -ticky-ap-thunk
This patch fixes a double negation confusion in !7525 that results in
some redundant AP thunk code generation when not using
-ticky-ap-thunk. Now, we use `stgToCmmUseStdApThunk` to indicate
whether precomputed AP thunks in the RTS should be used, which
defaults to `True`, unless `-ticky-ap-thunk` is passed.
`-finfo-table-map` now also implies `-ticky-ap-thunk`, since when
doing IPE profiling we want the generated AP thunks to be unique.
Fixes #27502.
-------------------------
Metric Decrease:
T3064
-------------------------
Co-authored-by: Codex <codex(a)openai.com>
- - - - -
b21b63e8 by Sasha Bogicevic at 2026-07-15T18:33:56+02:00
21101 Error message text for invalid record wildcard match
- - - - -
f57c7159 by Sasha Bogicevic at 2026-07-15T18:33:56+02:00
Improve error message for record wildcards with fieldless constructors
TcRnIllegalWildcardsInConstructor now stores a RecordFieldPart, so the message distinguishes record patterns from record constructions, and its suggested fixes are structured GhcHints (SuggestEmptyRecordBraces, SuggestExplicitConstructorArguments) that tools like HLS can turn into code actions. Storing HsRecFieldContext directly is not possible: GHC.Tc.Errors.Types is reachable from the parser via GHC.Types.Error.Codes, while GHC.Rename.Pat depends on the parser — so we reuse the existing RecordFieldPart mirror and toRecordFieldPart.
Fixes #21101
- - - - -
18267348 by Sasha Bogicevic at 2026-07-15T18:33:56+02:00
Record wildcard hints: show them in more contexts, and include arity (#21101)
Address review feedback on !8673:
* Emit SuggestExplicitConstructorArguments for record patterns as well
as record construction, so `f (C {..}) = ...` also suggests rewriting
to positional form. SuggestEmptyRecordBraces remains pattern-only,
since `C {}` as an expression would construct a value with all fields
unset.
* Store the constructor's visible arity in ConHasPositionalArgs so the
hint can say how many arguments to write, e.g.
Apply ‘D’ to its two arguments instead
The arity is threaded from the parsed declaration through
LConsWithFields: the per-constructor payload changes from
Maybe [Located Int] to Either VisArity [Located Int], where
Left n means the constructor has n unlabelled arguments.
Updates test baselines: T21101, T9815, T9815b, T9815ghci, T9815bghci.
- - - - -
54 changed files:
- + changelog.d/fix-cmm-atomic-load-store
- + changelog.d/fix-use-std-ap-thunk
- compiler/GHC/Cmm/Parser.y
- compiler/GHC/Driver/Config/StgToCmm.hs
- compiler/GHC/Driver/Flags.hs
- compiler/GHC/Hs/Binds.hs
- compiler/GHC/Hs/Instances.hs
- compiler/GHC/Hs/Utils.hs
- compiler/GHC/HsToCore/Quote.hs
- compiler/GHC/HsToCore/Ticks.hs
- compiler/GHC/Iface/Ext/Ast.hs
- compiler/GHC/Parser/Annotation.hs
- compiler/GHC/Parser/PostProcess.hs
- compiler/GHC/Rename/Bind.hs
- compiler/GHC/Rename/Env.hs
- compiler/GHC/Rename/Expr.hs
- compiler/GHC/Rename/Module.hs
- compiler/GHC/Rename/Names.hs
- compiler/GHC/Rename/Pat.hs
- compiler/GHC/Rename/Utils.hs
- compiler/GHC/Runtime/Eval.hs
- compiler/GHC/StgToCmm/Bind.hs
- compiler/GHC/StgToCmm/Config.hs
- compiler/GHC/Tc/Deriv.hs
- compiler/GHC/Tc/Errors/Ppr.hs
- compiler/GHC/Tc/Errors/Types.hs
- compiler/GHC/ThToHs.hs
- compiler/GHC/Types/GREInfo.hs
- compiler/GHC/Types/Hint.hs
- compiler/GHC/Types/Hint/Ppr.hs
- compiler/Language/Haskell/Syntax/Binds.hs
- compiler/Language/Haskell/Syntax/Extension.hs
- ghc/GHCi/UI.hs
- hadrian/cabal.project
- nofib
- rts/Capability.c
- rts/ContinuationOps.cmm
- rts/PrimOps.cmm
- testsuite/tests/cmm/should_run/AtomicFetch.hs
- testsuite/tests/cmm/should_run/AtomicFetch_cmm.cmm
- testsuite/tests/ghci/scripts/bytecodeIPE.hs
- testsuite/tests/parser/should_compile/DumpSemis.stderr
- testsuite/tests/printer/Test20297.stdout
- + testsuite/tests/rename/should_fail/T21101.hs
- + testsuite/tests/rename/should_fail/T21101.stderr
- testsuite/tests/rename/should_fail/T9815.stderr
- testsuite/tests/rename/should_fail/T9815b.stderr
- testsuite/tests/rename/should_fail/T9815bghci.stderr
- testsuite/tests/rename/should_fail/T9815ghci.stderr
- testsuite/tests/rename/should_fail/all.T
- utils/check-exact/ExactPrint.hs
- utils/check-exact/Main.hs
- utils/check-exact/Transform.hs
- utils/check-exact/Utils.hs
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6f1d6da89bde72a30c975f84383f90…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6f1d6da89bde72a30c975f84383f90…
You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help
1
0
[Git][ghc/ghc][wip/21101] Record wildcard hints: show them in more contexts, and include arity (#21101)
by Sasha Bogicevic (＠Bogicevic) 16 Jul '26
by Sasha Bogicevic (＠Bogicevic) 16 Jul '26
16 Jul '26
Sasha Bogicevic pushed to branch wip/21101 at Glasgow Haskell Compiler / GHC
Commits:
6f1d6da8 by Sasha Bogicevic at 2026-07-15T18:24:05+02:00
Record wildcard hints: show them in more contexts, and include arity (#21101)
Address review feedback on !8673:
* Emit SuggestExplicitConstructorArguments for record patterns as well
as record construction, so `f (C {..}) = ...` also suggests rewriting
to positional form. SuggestEmptyRecordBraces remains pattern-only,
since `C {}` as an expression would construct a value with all fields
unset.
* Store the constructor's visible arity in ConHasPositionalArgs so the
hint can say how many arguments to write, e.g.
Apply ‘D’ to its two arguments instead
The arity is threaded from the parsed declaration through
LConsWithFields: the per-constructor payload changes from
Maybe [Located Int] to Either VisArity [Located Int], where
Left n means the constructor has n unlabelled arguments.
Updates test baselines: T21101, T9815, T9815b, T9815ghci, T9815bghci.
- - - - -
14 changed files:
- compiler/GHC/Hs/Utils.hs
- compiler/GHC/Rename/Env.hs
- compiler/GHC/Rename/Names.hs
- compiler/GHC/Rename/Pat.hs
- compiler/GHC/Tc/Errors/Ppr.hs
- compiler/GHC/Tc/Errors/Types.hs
- compiler/GHC/Types/GREInfo.hs
- compiler/GHC/Types/Hint.hs
- compiler/GHC/Types/Hint/Ppr.hs
- testsuite/tests/rename/should_fail/T21101.stderr
- testsuite/tests/rename/should_fail/T9815.stderr
- testsuite/tests/rename/should_fail/T9815b.stderr
- testsuite/tests/rename/should_fail/T9815bghci.stderr
- testsuite/tests/rename/should_fail/T9815ghci.stderr
Changes:
=====================================
compiler/GHC/Hs/Utils.hs
=====================================
@@ -1589,8 +1589,8 @@ hsConDeclsBinders in the following format:
with its record fields, in the form of a list of Int indices into...
- IntMap FieldOcc, an IntMap of record fields.
-(In actual fact, we use [(ConRdrName, Maybe [Located Int])], with Nothing indicating
-that the constructor has unlabelled fields: see Note [Local constructor info in the renamer]
+(In actual fact, we use [(ConRdrName, Either VisArity [Located Int])], with Left n indicating
+that the constructor has n unlabelled arguments: see Note [Local constructor info in the renamer]
in GHC.Types.GREInfo.)
This allows us to do the following (see GHC.Rename.Names.getLocalNonValBinders.new_tc):
@@ -1611,7 +1611,7 @@ Other relevant test cases: rnfail015.
-- See Note [Collecting record fields in data declarations].
data LConsWithFields p =
LConsWithFields
- { consWithFieldIndices :: [(LocatedA (IdP (GhcPass p)), Maybe [Located Int])]
+ { consWithFieldIndices :: [(LocatedA (IdP (GhcPass p)), Either VisArity [Located Int])]
, consFields :: IntMap (LFieldOcc (GhcPass p))
}
@@ -1651,16 +1651,15 @@ hsConDeclsBinders cons = go emptyFieldIndices cons
LConsWithFields ns fs = go seen' rs
get_flds_h98 :: FieldIndices p -> HsConDeclH98Details (GhcPass p)
- -> (Maybe [Located Int], FieldIndices p)
- get_flds_h98 seen (RecCon _ flds) = first Just $ get_flds seen flds
- get_flds_h98 seen (PrefixCon _ []) = (Just [], seen)
- get_flds_h98 seen _ = (Nothing, seen)
+ -> (Either VisArity [Located Int], FieldIndices p)
+ get_flds_h98 seen (RecCon _ flds) = first Right $ get_flds seen flds
+ get_flds_h98 seen (PrefixCon _ args) = (Left (length args), seen)
+ get_flds_h98 seen (InfixCon {}) = (Left 2, seen)
get_flds_gadt :: FieldIndices p -> HsConDeclGADTDetails (GhcPass p)
- -> (Maybe [Located Int], FieldIndices p)
- get_flds_gadt seen (RecConGADT _ flds) = first Just $ get_flds seen flds
- get_flds_gadt seen (PrefixConGADT _ []) = (Just [], seen)
- get_flds_gadt seen _ = (Nothing, seen)
+ -> (Either VisArity [Located Int], FieldIndices p)
+ get_flds_gadt seen (RecConGADT _ flds) = first Right $ get_flds seen flds
+ get_flds_gadt seen (PrefixConGADT _ args) = (Left (length args), seen)
get_flds :: FieldIndices p -> LocatedA [LHsConDeclRecField (GhcPass p)]
-> ([Located Int], FieldIndices p)
=====================================
compiler/GHC/Rename/Env.hs
=====================================
@@ -423,7 +423,10 @@ lookupConstructorInfo qcon@(WithUserRdr _ con_name)
= do { info <- lookupGREInfo_GRE con_name
; case info of
IAmConLike con_info -> return con_info
- UnboundGRE -> return $ ConInfo (ConIsData []) ConHasPositionalArgs
+ UnboundGRE -> return $ ConInfo (ConIsData []) (ConHasPositionalArgs 0)
+ -- The arity is a dummy: an unbound constructor never reaches the
+ -- code that consults it (see the isUnboundName guard in
+ -- GHC.Rename.Pat.rn_dotdot).
IAmTyCon {} -> failIllegalTyCon WL_ConLike qcon
_ -> pprPanic "lookupConstructorInfo: not a ConLike" $
vcat [ text "name:" <+> ppr con_name ]
=====================================
compiler/GHC/Rename/Names.hs
=====================================
@@ -71,7 +71,7 @@ import GHC.Types.FieldLabel
import GHC.Types.Hint
import GHC.Types.SourceFile
import GHC.Types.SrcLoc as SrcLoc
-import GHC.Types.Basic ( TyConFlavour (..), convImportLevel )
+import GHC.Types.Basic (TyConFlavour (..), convImportLevel, VisArity)
import GHC.Types.Id
import GHC.Types.PkgQual
import GHC.Types.GREInfo (ConInfo(..), ConFieldInfo (..), ConLikeInfo (ConIsData))
@@ -875,15 +875,16 @@ getLocalNonValBinders fixity_env
--
-- The information we needed was all set up for us:
-- see Note [Collecting record fields in data declarations] in GHC.Hs.Utils.
- mk_fld_env :: [(Name, Maybe [Located Int])] -> IntMap FieldLabel
+ mk_fld_env :: [(Name, Either VisArity [Located Int])] -> IntMap FieldLabel
-> [(ConLikeName, ConInfo)]
mk_fld_env names flds =
[ (DataConName con, ConInfo (ConIsData (map fst names)) fld_info)
- | (con, mb_fl_indxs) <- names
- , let fld_info = case fmap (map ((flds IntMap.!) . unLoc)) mb_fl_indxs of
- Nothing -> ConHasPositionalArgs
- Just [] -> ConIsNullary
- Just (fld:flds) -> ConHasRecordFields $ fld NE.:| flds ]
+ | (con, con_fl_indxs) <- names
+ , let fld_info = case fmap (map ((flds IntMap.!) . unLoc)) con_fl_indxs of
+ Left 0 -> ConIsNullary
+ Left arity -> ConHasPositionalArgs arity
+ Right [] -> ConIsNullary
+ Right (fld:flds) -> ConHasRecordFields $ fld NE.:| flds ]
new_assoc :: DuplicateRecordFields -> FieldSelectors -> LInstDecl GhcPs
-> RnM [GlobalRdrElt]
@@ -939,10 +940,10 @@ getLocalNonValBinders fixity_env
-- Add errors if a constructor has a duplicate record field.
add_dup_fld_errs :: IntMap FieldLabel
- -> (Name, Maybe [Located Int])
+ -> (Name, Either VisArity [Located Int])
-> IOEnv (Env TcGblEnv TcLclEnv) ()
- add_dup_fld_errs all_flds (con, mb_con_flds)
- | Just con_flds <- mb_con_flds
+ add_dup_fld_errs all_flds (con, con_flds_or_arity)
+ | Right con_flds <- con_flds_or_arity
, let (_, dups) = removeDups (comparing unLoc) con_flds
= for_ dups $ \ dup_flds ->
-- Report the error at the location of the second occurrence
=====================================
compiler/GHC/Rename/Pat.hs
=====================================
@@ -874,7 +874,11 @@ rnHsRecFields ctxt mk_arg (HsRecFields { rec_flds = flds, rec_dotdot = dotdot })
; checkErr dd_flag (needFlagDotDot ctxt)
; (rdr_env, lcl_env) <- getRdrEnvs
; conInfo <- lookupConstructorInfo qcon
- ; when (conFieldInfo conInfo == ConHasPositionalArgs) (addErr (TcRnIllegalWildcardsInConstructor (toRecordFieldPart ctxt) con))
+
+ ; case conFieldInfo conInfo of
+ ConHasPositionalArgs nbArgs ->
+ addErr $ TcRnIllegalWildcardsInConstructor (toRecordFieldPart ctxt) con nbArgs
+ _ -> return ()
; let present_flds = mkOccSet $ map rdrNameOcc (getFieldRdrs flds)
-- For constructor uses (but not patterns)
=====================================
compiler/GHC/Tc/Errors/Ppr.hs
=====================================
@@ -357,7 +357,7 @@ instance Diagnostic TcRnMessage where
-> mkSimpleDecorated $ vcat [text "Illegal view pattern: " <+> ppr pat]
TcRnCharLiteralOutOfRange c
-> mkSimpleDecorated $ text "character literal out of range: '\\" <> char c <> char '\''
- TcRnIllegalWildcardsInConstructor ctx con
+ TcRnIllegalWildcardsInConstructor ctx con _
-> mkSimpleDecorated $
text "The data constructor" <+> quotes (ppr con)
<+> text "does not have named record fields, so the record"
@@ -2791,10 +2791,12 @@ instance Diagnostic TcRnMessage where
-> [suggestExtension LangExt.ViewPatterns]
TcRnCharLiteralOutOfRange{}
-> noHints
- TcRnIllegalWildcardsInConstructor ctx con
+ TcRnIllegalWildcardsInConstructor ctx con arity
-> case ctx of
- RecordFieldPattern{} -> [SuggestEmptyRecordBraces con]
- _ -> [SuggestExplicitConstructorArguments con]
+ RecordFieldPattern{} -> [ SuggestEmptyRecordBraces con
+ , SuggestExplicitConstructorArguments con arity
+ ]
+ _ -> [SuggestExplicitConstructorArguments con arity]
TcRnIgnoringAnnotations{}
-> noHints
TcRnAnnotationInSafeHaskell
=====================================
compiler/GHC/Tc/Errors/Types.hs
=====================================
@@ -824,6 +824,8 @@ data TcRnMessage where
worded accordingly. Constructors with no fields at all do not trigger
this error: since GHC proposal 496 ("Nullary record wildcards"),
@C {..}@ is legal for nullary constructors.
+ The 'VisArity' field records the constructor's number of positional arguments
+ which the suggested fix mentions.
Example(s):
@@ -842,7 +844,7 @@ data TcRnMessage where
rename/should_fail/T9815bghci.hs
rename/should_fail/T21101.hs
-}
- TcRnIllegalWildcardsInConstructor :: !RecordFieldPart -> !Name -> TcRnMessage
+ TcRnIllegalWildcardsInConstructor :: !RecordFieldPart -> !Name -> !VisArity -> TcRnMessage
{-| TcRnIgnoringAnnotations is a warning that occurs when the source code
contains annotation pragmas but the platform in use does not support an
=====================================
compiler/GHC/Types/GREInfo.hs
=====================================
@@ -244,14 +244,14 @@ instance NFData ConLikeInfo where
-- See Note [Local constructor info in the renamer]
data ConFieldInfo
= ConHasRecordFields (NonEmpty FieldLabel)
- | ConHasPositionalArgs
+ | ConHasPositionalArgs !VisArity
| ConIsNullary
deriving stock Eq
deriving Data
instance NFData ConFieldInfo where
rnf ConIsNullary = ()
- rnf ConHasPositionalArgs = ()
+ rnf (ConHasPositionalArgs arity) = rnf arity
rnf (ConHasRecordFields flds) = rnf flds
mkConInfo :: ConLikeInfo -> VisArity -> [FieldLabel] -> ConInfo
@@ -259,9 +259,9 @@ mkConInfo con_ty n flds =
ConInfo { conLikeInfo = con_ty
, conFieldInfo = mkConFieldInfo n flds }
-mkConFieldInfo :: Arity -> [FieldLabel] -> ConFieldInfo
+mkConFieldInfo :: VisArity -> [FieldLabel] -> ConFieldInfo
mkConFieldInfo 0 _ = ConIsNullary
-mkConFieldInfo _ fields = maybe ConHasPositionalArgs ConHasRecordFields
+mkConFieldInfo arity fields = maybe (ConHasPositionalArgs arity) ConHasRecordFields
$ NonEmpty.nonEmpty fields
conInfoFields :: ConInfo -> [FieldLabel]
@@ -269,7 +269,7 @@ conInfoFields = conFieldInfoFields . conFieldInfo
conFieldInfoFields :: ConFieldInfo -> [FieldLabel]
conFieldInfoFields (ConHasRecordFields fields) = NonEmpty.toList fields
-conFieldInfoFields ConHasPositionalArgs = []
+conFieldInfoFields (ConHasPositionalArgs _) = []
conFieldInfoFields ConIsNullary = []
instance Outputable ConInfo where
@@ -284,7 +284,7 @@ instance Outputable ConLikeInfo where
instance Outputable ConFieldInfo where
ppr ConIsNullary = text "ConIsNullary"
- ppr ConHasPositionalArgs = text "ConHasPositionalArgs"
+ ppr (ConHasPositionalArgs arity) = text "ConHasPositionalArgs" <+> braces (ppr arity)
ppr (ConHasRecordFields fieldLabels) =
text "ConHasRecordFields" <+> braces (ppr fieldLabels)
=====================================
compiler/GHC/Types/Hint.hs
=====================================
@@ -45,7 +45,7 @@ import GHC.Types.InlinePragma (ActivationGhc)
import GHC.Types.Name (Name, NameSpace, OccName (occNameFS), isSymOcc, nameOccName)
import GHC.Types.Name.Reader (RdrName (Unqual), ImpDeclSpec, GlobalRdrElt)
import GHC.Types.SrcLoc (SrcSpan)
-import GHC.Types.Basic (RuleName)
+import GHC.Types.Basic (RuleName, VisArity)
import GHC.Parser.Errors.Basic
import GHC.Utils.Outputable
import GHC.Data.FastString (fsLit)
@@ -560,9 +560,10 @@ data GhcHint
of record syntax, for constructors without labelled fields.
Triggered by 'GHC.Tc.Errors.Types.TcRnIllegalWildcardsInConstructor'
- in a record construction.
+ in a record construction and record patterns.
+ The 'VisArity' is the number of positional arguments of the constructor.
-}
- | SuggestExplicitConstructorArguments !Name
+ | SuggestExplicitConstructorArguments !Name !VisArity
-- | What the user should upgrade to resolve an @-jsem@ semaphore
-- protocol version mismatch.
=====================================
compiler/GHC/Types/Hint/Ppr.hs
=====================================
@@ -348,8 +348,9 @@ instance Outputable GhcHint where
SuggestEmptyRecordBraces con
-> text "Use" <+> quotes (ppr con <> text "{}") <+> text "instead,"
<+> text "which matches" <+> quotes (ppr con) <+> text "regardless of its fields"
- SuggestExplicitConstructorArguments con
- -> text "Apply" <+> quotes (ppr con) <+> text "to its arguments instead"
+ SuggestExplicitConstructorArguments con nbArgs
+ -> text "Apply" <+> quotes (ppr con) <+> text "to its"
+ <+> speakNOf nbArgs (text "argument") <+> text "instead"
perhapsAsPat :: SDoc
perhapsAsPat = text "Perhaps you meant an as-pattern, which must not be surrounded by whitespace"
=====================================
testsuite/tests/rename/should_fail/T21101.stderr
=====================================
@@ -1,5 +1,6 @@
T21101.hs:7:3: error: [GHC-47217]
The data constructor ‘D’ does not have named record fields, so the record pattern ‘D{..}’ is invalid.
- Suggested fix:
- Use ‘D{}’ instead, which matches ‘D’ regardless of its fields
+ Suggested fixes:
+ • Use ‘D{}’ instead, which matches ‘D’ regardless of its fields
+ • Apply ‘D’ to its two arguments instead
=====================================
testsuite/tests/rename/should_fail/T9815.stderr
=====================================
@@ -1,4 +1,4 @@
T9815.hs:6:13: error: [GHC-47217]
The data constructor ‘N’ does not have named record fields, so the record construction ‘N{..}’ is invalid.
- Suggested fix: Apply ‘N’ to its arguments instead
+ Suggested fix: Apply ‘N’ to its one argument instead
=====================================
testsuite/tests/rename/should_fail/T9815b.stderr
=====================================
@@ -1,4 +1,4 @@
T9815.hs:6:13: error: [GHC-47217]
The data constructor ‘N’ does not have named record fields, so the record construction ‘N{..}’ is invalid.
- Suggested fix: Apply ‘N’ to its arguments instead
+ Suggested fix: Apply ‘N’ to its one argument instead
=====================================
testsuite/tests/rename/should_fail/T9815bghci.stderr
=====================================
@@ -1,4 +1,4 @@
<interactive>:5:7: error: [GHC-47217]
The data constructor ‘Arg’ does not have named record fields, so the record construction ‘Arg{..}’ is invalid.
- Suggested fix: Apply ‘Arg’ to its arguments instead
+ Suggested fix: Apply ‘Arg’ to its two arguments instead
=====================================
testsuite/tests/rename/should_fail/T9815ghci.stderr
=====================================
@@ -1,4 +1,5 @@
<interactive>:3:7: error: [GHC-47217]
The data constructor ‘Data.Semigroup.Arg’ does not have named record fields, so the record construction ‘Data.Semigroup.Arg{..}’ is invalid.
- Suggested fix: Apply ‘Data.Semigroup.Arg’ to its arguments instead
+ Suggested fix:
+ Apply ‘Data.Semigroup.Arg’ to its two arguments instead
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6f1d6da89bde72a30c975f84383f908…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6f1d6da89bde72a30c975f84383f908…
You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help
1
0
16 Jul '26
Rodrigo Mesquita pushed new branch wip/romes/27461-zb at Glasgow Haskell Compiler / GHC
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/romes/27461-zb
You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help
1
0
Cheng Shao deleted branch wip/fix-hadrian-hls at Glasgow Haskell Compiler / GHC
--
You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help
1
0
15 Jul '26
Cheng Shao deleted branch wip/fix-ipe-bytecodeIPE-test at Glasgow Haskell Compiler / GHC
--
You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help
1
0
15 Jul '26
Cheng Shao deleted branch wip/fix-cmm-atomic-load-store at Glasgow Haskell Compiler / GHC
--
You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help
1
0
15 Jul '26
Cheng Shao deleted branch wip/rts-fix-missing-untag at Glasgow Haskell Compiler / GHC
--
You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help
1
0
15 Jul '26
Cheng Shao deleted branch wip/fix-use-std-ap-thunk at Glasgow Haskell Compiler / GHC
--
You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help
1
0