Skip to content

HieAst: add module name #24493

Patrick requested to merge soulomoon/ghc:hieAst-add-module-name-#24493 into master

The main purpose of this PR is to tuck the module name xxx in module xxx where into the hieAst. It should fix #24493 (closed).

The following have been done:

  1. Renamed and update the tcg_doc_hdr :: Maybe (LHsDoc GhcRn) to tcg_hdr_info :: (Maybe (LHsDoc GhcRn), Maybe (XRec GhcRn ModuleName)) To store the located module name information.
  2. update the RenamedSource and RenamedStuff with extra Maybe (XRec GhcRn ModuleName) located module name information.
  3. add test testsuite/tests/hiefile/should_compile/T24493.hs to ensure the module name is added and update several relevent tests.
  4. accompanied haddoc test change PR in haddock!52 (closed)

For File: hello.hs

module Hello where

go = "1"

The result of ghc hello.hs -fno-code -fwrite-ide-info -fvalidate-ide-info -ddump-hie -fforce-recomp Change from

==================== HIE AST ====================
File: hello.hs
Node@hello.hs:3:1-8: Source: From source
                     {(annotations: {(FunBind, HsBindLR), (Match, Match),
                                     (Module, Module), (XHsBindsLR, HsBindLR)}), 
                      (types: [0]),  (identifier info: {})}
                     
  Node@hello.hs:3:1-2: Source: From source
                       {(annotations: {}),  (types: []), 
                        (identifier info: {(name Hello.go,  Details:  Just 0 {LHS of a match group,
                                                                              regular value bound with scope: ModuleScope bound at: hello.hs:3:1-8})})}
                       
  Node@hello.hs:3:4-8: Source: From source
                       {(annotations: {(GRHS, GRHS)}),  (types: []), 
                        (identifier info: {})}
                       
    Node@hello.hs:3:6-8: Source: From source
                         {(annotations: {(HsLit, HsExpr)}),  (types: [0]), 
                          (identifier info: {})}

to

==================== HIE AST ====================
File: hello.hs
Node@hello.hs:(1,8)-(3,8): Source: From source
                           {(annotations: {(Module, Module)}),  (types: []), 
                            (identifier info: {})}
                           
  Node@hello.hs:1:8-12: Source: From source
                        {(annotations: {}),  (types: []), 
                         (identifier info: {(module Hello,  Details:  Nothing {})})}
                        
  Node@hello.hs:3:1-8: Source: From source
                       {(annotations: {(FunBind, HsBindLR), (Match, Match),
                                       (XHsBindsLR, HsBindLR)}), 
                        (types: [0]),  (identifier info: {})}
                       
    Node@hello.hs:3:1-2: Source: From source
                         {(annotations: {}),  (types: []), 
                          (identifier info: {(name Hello.go,  Details:  Just 0 {LHS of a match group,
                                                                                regular value bound with scope: ModuleScope bound at: hello.hs:3:1-8})})}
                         
    Node@hello.hs:3:4-8: Source: From source
                         {(annotations: {(GRHS, GRHS)}),  (types: []), 
                          (identifier info: {})}
                         
      Node@hello.hs:3:6-8: Source: From source
                           {(annotations: {(HsLit, HsExpr)}),  (types: [0]), 
                            (identifier info: {})}
Edited by Patrick

Merge request reports