[GHC] #9417: Pattern synonyms across modules broken in Haddock
GHC
ghc-devs at haskell.org
Wed Aug 6 14:59:26 UTC 2014
#9417: Pattern synonyms across modules broken in Haddock
-------------------------------------+-------------------------------------
Reporter: Fuuzetsu | Owner:
Type: bug | Status: new
Priority: normal | Milestone:
Component: Compiler | Version: 7.9
Keywords: | Operating System:
Architecture: Unknown/Multiple | Unknown/Multiple
Difficulty: Unknown | Type of failure:
Blocked By: | None/Unknown
Related Tickets: | Test Case:
| Blocking:
| Differential Revisions:
-------------------------------------+-------------------------------------
Create modules as follows
{{{#!hs
-- PatSymDef.hs
{-# Language PatternSynonyms #-}
module PatSymDef where
pattern Some a = Just a
}}}
{{{#!hs
-- PatSymUse.hs
{-# Language PatternSynonyms #-}
module PatSymUse where
import PatSymDef
f :: Maybe Int -> Int
f (Some a) = a
f Nothing = 0
}}}
Then run Haddock against them:
{{{
[nix-shell:~/programming/haddock]$ ./dist/build/haddock/haddock -h
/tmp/PatSymUse.hs /tmp/PatSymDef.hs -o /tmp
Haddock coverage:
Warning: Not found in environment: Some
50% ( 1 / 2) in 'PatSymDef'
/tmp/PatSymUse.hs:9:4:
Can't find interface-file declaration for data constructor Some
Probable cause: bug in .hi-boot file, or inconsistent .hi file
Use -ddump-if-trace to get an idea of which file caused the error
In the pattern: Some a
In an equation for ‘f’: f (Some a) = a
}}}
Here with -ddump-if-trace:
{{{
[nix-shell:~/programming/haddock]$ ./dist/build/haddock/haddock -h
/tmp/PatSymUse.hs /tmp/PatSymDef.hs -o /tmp --optghc='-ddump-if-trace'
Haddock coverage:
Considering whether to load base:Prelude
Reading interface for base:Prelude;
reason: Prelude is directly imported
readIFace /nix/store/m347lhn3g6sh2s9pv7kz68qs2jyhzphg-
ghc-7.9.20140805/lib/ghc-7.9.20140805/base_DiPQ1siqG3SBjHauL3L03p/Prelude.hi
readIFace /nix/store/m347lhn3g6sh2s9pv7kz68qs2jyhzphg-
ghc-7.9.20140805/lib/ghc-7.9.20140805/base_DiPQ1siqG3SBjHauL3L03p/Prelude.dyn_hi
updating EPS_
updating EPS_
Considering whether to load base:GHC.Base {- SYSTEM -}
Reading interface for base:GHC.Base;
reason: Loading orphan modules (base:GHC.Base)
readIFace /nix/store/m347lhn3g6sh2s9pv7kz68qs2jyhzphg-
ghc-7.9.20140805/lib/ghc-7.9.20140805/base_DiPQ1siqG3SBjHauL3L03p/GHC/Base.hi
readIFace /nix/store/m347lhn3g6sh2s9pv7kz68qs2jyhzphg-
ghc-7.9.20140805/lib/ghc-7.9.20140805/base_DiPQ1siqG3SBjHauL3L03p/GHC/Base.dyn_hi
updating EPS_
Considering whether to load base:GHC.Float {- SYSTEM -}
Reading interface for base:GHC.Float;
reason: Loading orphan modules (base:GHC.Float)
readIFace /nix/store/m347lhn3g6sh2s9pv7kz68qs2jyhzphg-
ghc-7.9.20140805/lib/ghc-7.9.20140805/base_DiPQ1siqG3SBjHauL3L03p/GHC/Float.hi
readIFace /nix/store/m347lhn3g6sh2s9pv7kz68qs2jyhzphg-
ghc-7.9.20140805/lib/ghc-7.9.20140805/base_DiPQ1siqG3SBjHauL3L03p/GHC/Float.dyn_hi
updating EPS_
Considering whether to load base:GHC.Real {- SYSTEM -}
Reading interface for base:GHC.Real;
reason: Loading orphan modules (base:GHC.Real)
readIFace /nix/store/m347lhn3g6sh2s9pv7kz68qs2jyhzphg-
ghc-7.9.20140805/lib/ghc-7.9.20140805/base_DiPQ1siqG3SBjHauL3L03p/GHC/Real.hi
readIFace /nix/store/m347lhn3g6sh2s9pv7kz68qs2jyhzphg-
ghc-7.9.20140805/lib/ghc-7.9.20140805/base_DiPQ1siqG3SBjHauL3L03p/GHC/Real.dyn_hi
updating EPS_
loadHiBootInterface main at main:PatSymDef
Considering whether to load base:Data.Maybe {- SYSTEM -}
Reading interface for base:Data.Maybe;
reason: The name ‘Data.Maybe.Just’ is mentioned explicitly
readIFace /nix/store/m347lhn3g6sh2s9pv7kz68qs2jyhzphg-
ghc-7.9.20140805/lib/ghc-7.9.20140805/base_DiPQ1siqG3SBjHauL3L03p/Data/Maybe.hi
readIFace /nix/store/m347lhn3g6sh2s9pv7kz68qs2jyhzphg-
ghc-7.9.20140805/lib/ghc-7.9.20140805/base_DiPQ1siqG3SBjHauL3L03p/Data/Maybe.dyn_hi
updating EPS_
Starting fork { Declaration for Maybe
Loading decl for Data.Maybe.Maybe
updating EPS_
Considering whether to load ghc-prim:GHC.Prim {- SYSTEM -}
Reading interface for ghc-prim:GHC.Prim;
reason: Need home interface for wired-in thing *
updating EPS_
Start interface-file tc_con_decl Nothing
Done interface-file tc_con_decl Data.Maybe.Nothing
Start interface-file tc_con_decl Just
Done interface-file tc_con_decl Data.Maybe.Just
tcIfaceDecl4 Data.Maybe.Maybe
} ending fork Declaration for Maybe
Starting fork { Constructor Data.Maybe.Nothing
} ending fork Constructor Data.Maybe.Nothing
Starting fork { Constructor Data.Maybe.Just
} ending fork Constructor Data.Maybe.Just
==================== Interface statistics ====================
Renamer stats: 6 interfaces read
1 type/class/variable imported, out of 776 read
0 instance decls imported, out of 42 read
0 rule decls imported, out of 53 read
Need decl for PatSymDef.Some
Considering whether to load main at main:PatSymDef {- SYSTEM -}
Warning: Not found in environment: Some
50% ( 1 / 2) in 'PatSymDef'
Considering whether to load base:Prelude
Considering whether to load main at main:PatSymDef
updating EPS_
Considering whether to load base:GHC.Base {- SYSTEM -}
Considering whether to load base:GHC.Float {- SYSTEM -}
Considering whether to load base:GHC.Real {- SYSTEM -}
loadHiBootInterface main at main:PatSymUse
Considering whether to load base:Data.Maybe {- SYSTEM -}
Considering whether to load ghc-prim:GHC.Types {- SYSTEM -}
Reading interface for ghc-prim:GHC.Types;
reason: The name ‘GHC.Types.Int’ is mentioned explicitly
readIFace /nix/store/m347lhn3g6sh2s9pv7kz68qs2jyhzphg-
ghc-7.9.20140805/lib/ghc-7.9.20140805/ghcpr_BE58KUgBe9ELCsPXiJ1Q2r/GHC/Types.hi
readIFace /nix/store/m347lhn3g6sh2s9pv7kz68qs2jyhzphg-
ghc-7.9.20140805/lib/ghc-7.9.20140805/ghcpr_BE58KUgBe9ELCsPXiJ1Q2r/GHC/Types.dyn_hi
updating EPS_
Considering whether to load ghc-prim:GHC.Types {- SYSTEM -}
Considering whether to load main at main:PatSymDef {- SYSTEM -}
Considering whether to load base:Data.Maybe {- SYSTEM -}
Considering whether to load ghc-prim:GHC.Types {- SYSTEM -}
Considering whether to load ghc-prim:GHC.Types {- SYSTEM -}
Need decl for PatSymDef.Some
Considering whether to load main at main:PatSymDef {- SYSTEM -}
/tmp/PatSymUse.hs:9:4:
Can't find interface-file declaration for data constructor Some
Probable cause: bug in .hi-boot file, or inconsistent .hi file
Use -ddump-if-trace to get an idea of which file caused the error
In the pattern: Some a
In an equation for ‘f’: f (Some a) = a
}}}
Originally reported to me against Haddock 2.14.3, GHC 7.8.3 and I can
confirm both there and on yesterday's GHC HEAD.
It'd be great if whoever is involved with pattern synonyms could take a
look.
--
Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/9417>
GHC <http://www.haskell.org/ghc/>
The Glasgow Haskell Compiler
More information about the ghc-tickets
mailing list