Skip to content

Commit 6fa2d7a

Browse files
rowanG077rowanG077
authored
Do not emit source locations if -g is not passed to clash (#3133)
[#3132](#3132).
1 parent 2cfac47 commit 6fa2d7a

File tree

10 files changed

+124
-19
lines changed

10 files changed

+124
-19
lines changed

‎changelog/2026-02-02T21_55_56+01_00_no_dbg_emit_srcloc‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1 @@
1+
Fixed: Do not emit source locations if `-g` is not passed to clash [#3132](https://github.com/clash-lang/clash-compiler/issues/3132).

‎clash-ghc/src-bin-9.10.1/Clash/Main.hs‎

Lines changed: 5 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -268,9 +268,12 @@ main' postLoadMode units dflags0 args flagWarnings startAction clashOpts = do
268268
(dflags3, fileish_args, dynamicFlagWarnings) <-
269269
GHC.parseDynamicFlags logger2 dflags2 args'
270270

271-
-- Propagate -Werror to Clash
271+
-- Propagate some GHC flags to Clash
272272
liftIO . modifyIORef' clashOpts $ \opts ->
273-
opts { opt_werror = EnumSet.member Opt_WarnIsError (generalFlags dflags3) }
273+
opts
274+
{ opt_werror = EnumSet.member Opt_WarnIsError (generalFlags dflags3)
275+
, opt_ghcDebugLevel = debugLevel dflags3
276+
}
274277

275278
let dflags4 = if backendNeedsFullWays bcknd &&
276279
not (gopt Opt_ExternalInterpreter dflags3)

‎clash-ghc/src-bin-9.10.2/Clash/Main.hs‎

Lines changed: 5 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -268,9 +268,12 @@ main' postLoadMode units dflags0 args flagWarnings startAction clashOpts = do
268268
(dflags3, fileish_args, dynamicFlagWarnings) <-
269269
GHC.parseDynamicFlags logger2 dflags2 args'
270270

271-
-- Propagate -Werror to Clash
271+
-- Propagate some GHC flags to Clash
272272
liftIO . modifyIORef' clashOpts $ \opts ->
273-
opts { opt_werror = EnumSet.member Opt_WarnIsError (generalFlags dflags3) }
273+
opts
274+
{ opt_werror = EnumSet.member Opt_WarnIsError (generalFlags dflags3)
275+
, opt_ghcDebugLevel = debugLevel dflags3
276+
}
274277

275278
let dflags4 = if backendNeedsFullWays bcknd &&
276279
not (gopt Opt_ExternalInterpreter dflags3)

‎clash-ghc/src-bin-9.6/Clash/Main.hs‎

Lines changed: 5 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -268,9 +268,12 @@ main' postLoadMode units dflags0 args flagWarnings startAction clashOpts = do
268268
(dflags3, fileish_args, dynamicFlagWarnings) <-
269269
GHC.parseDynamicFlags logger2 dflags2 args'
270270

271-
-- Propagate -Werror to Clash
271+
-- Propagate some GHC flags to Clash
272272
liftIO . modifyIORef' clashOpts $ \opts ->
273-
opts { opt_werror = EnumSet.member Opt_WarnIsError (generalFlags dflags3) }
273+
opts
274+
{ opt_werror = EnumSet.member Opt_WarnIsError (generalFlags dflags3)
275+
, opt_ghcDebugLevel = debugLevel dflags3
276+
}
274277

275278
let dflags4 = if backendNeedsFullWays bcknd &&
276279
not (gopt Opt_ExternalInterpreter dflags3)

‎clash-ghc/src-bin-9.8/Clash/Main.hs‎

Lines changed: 5 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -266,9 +266,12 @@ main' postLoadMode units dflags0 args flagWarnings startAction clashOpts = do
266266
(dflags3, fileish_args, dynamicFlagWarnings) <-
267267
GHC.parseDynamicFlags logger2 dflags2 args'
268268

269-
-- Propagate -Werror to Clash
269+
-- Propagate some GHC flags to Clash
270270
liftIO . modifyIORef' clashOpts $ \opts ->
271-
opts { opt_werror = EnumSet.member Opt_WarnIsError (generalFlags dflags3) }
271+
opts
272+
{ opt_werror = EnumSet.member Opt_WarnIsError (generalFlags dflags3)
273+
, opt_ghcDebugLevel = debugLevel dflags3
274+
}
272275

273276
let dflags4 = if backendNeedsFullWays bcknd &&
274277
not (gopt Opt_ExternalInterpreter dflags3)

‎clash-lib/src/Clash/Driver/Types.hs‎

Lines changed: 7 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -2,8 +2,8 @@
22
Copyright : (C) 2013-2016, University of Twente,
33
2016-2017, Myrtle Software Ltd,
44
2017 , QBayLogic, Google Inc.,
5-
2020-2022, QBayLogic,
65
2022 , Google Inc.,
6+
2020-2026, QBayLogic,
77
License : BSD2 (see the file LICENSE)
88
Maintainer : QBayLogic B.V. <devops@qbaylogic.com>
99
@@ -315,6 +315,11 @@ data ClashOpts = ClashOpts
315315
-- Command line flag: -fclash-evaluator-fuel-limit
316316
, opt_debug :: DebugOpts
317317
-- ^ Options which control debugging. See 'DebugOpts'.
318+
, opt_ghcDebugLevel :: Int
319+
-- ^ What the GHC debug level is (i.e. @-g<N>@).
320+
--
321+
-- Clash uses this to decide whether to emit source-location information in
322+
-- generated HDL.
318323
, opt_cachehdl :: Bool
319324
-- ^ Reuse previously generated output from Clash. Only caches topentities.
320325
--
@@ -407,6 +412,7 @@ defClashOpts
407412
, opt_inlineConstantLimit = 0
408413
, opt_evaluatorFuelLimit = 20
409414
, opt_debug = debugNone
415+
, opt_ghcDebugLevel = 0
410416
, opt_cachehdl = True
411417
, opt_clear = False
412418
, opt_primWarn = True

‎clash-lib/src/Clash/Netlist.hs‎

Lines changed: 18 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -2,8 +2,8 @@
22
Copyright : (C) 2012-2016, University of Twente,
33
2016-2017, Myrtle Software Ltd,
44
2017-2018, Google Inc.,
5-
2021-2024, QBayLogic B.V.
6-
2022 , Google Inc.
5+
2022 , Google Inc.,
6+
2021-2026, QBayLogic B.V.
77
License : BSD2 (see the file LICENSE)
88
Maintainer : QBayLogic B.V. <devops@qbaylogic.com>
99
@@ -314,13 +314,25 @@ mkNetDecl (id_,tm) | (_,_,ticks) <- collectArgsTicks tm = preserveVarEnv $ withT
314314
Annotated attrs hty0 -> Annotated (attrs ++ lAttrs) hty0
315315
hty0 -> annotated lAttrs hty0
316316

317+
-- GHC starts including sources notes on any debug level greater than 0
318+
-- we copy this behaviour here.
319+
emitLocs <- (>0) . opt_ghcDebugLevel <$> Lens.view clashOpts
320+
let
321+
srcNote =
322+
if emitLocs then
323+
addSrcNote $ case tm of
324+
Tick (SrcSpan s) _ -> s
325+
_ -> nameLoc (varName id_)
326+
else
327+
Nothing
328+
317329
if | not (shouldRenderDecl hwTy tm) -> return []
318330
| (Prim pInfo@PrimInfo{primMultiResult=MultiResult}, args) <- collectArgs tm ->
319-
multiDecls pInfo args
320-
| otherwise -> pure <$> singleDecl hwTy
331+
multiDecls srcNote pInfo args
332+
| otherwise -> pure <$> singleDecl srcNote hwTy
321333

322334
where
323-
multiDecls pInfo args0 = do
335+
multiDecls srcNote pInfo args0 = do
324336
tcm <- Lens.view tcCache
325337
resInits0 <- getResInits (id_, tm)
326338
let
@@ -334,18 +346,14 @@ mkNetDecl (id_,tm) | (_,_,ticks) <- collectArgsTicks tm = preserveVarEnv $ withT
334346
hwTys <- mapM (unsafeCoreTypeToHWTypeM' $(curLoc)) (mpi_resultTypes mpInfo)
335347
pure (zipWith3 netdecl res hwTys resInits1)
336348

337-
singleDecl hwTy = do
349+
singleDecl srcNote hwTy = do
338350
rIM <- listToMaybe <$> getResInits (id_, tm)
339351
return (NetDecl' srcNote (Id.unsafeFromCoreId id_) hwTy rIM)
340352

341353
addSrcNote loc
342354
| isGoodSrcSpan loc = Just (StrictText.pack (showSDocUnsafe (ppr loc)))
343355
| otherwise = Nothing
344356

345-
srcNote = addSrcNote $ case tm of
346-
Tick (SrcSpan s) _ -> s
347-
_ -> nameLoc (varName id_)
348-
349357
isMultiPrimSelect :: Term -> Bool
350358
isMultiPrimSelect t = case collectArgs t of
351359
(Prim (primName -> "c$multiPrimSelect"), _) -> True

‎tests/Main.hs‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -692,6 +692,8 @@ runClashTest = defaultMain
692692
, clashLibTest "NoDeDup" def{hdlTargets=[VHDL]}
693693
, clashLibTest "T1766" def
694694
, clashLibTest "T1935" def
695+
, outputTest "HDLContainsLoc" def{hdlSim=[], clashFlags=["-g"]}
696+
, outputTest "HDLNotContainsLoc" def{hdlSim=[]}
695697
]
696698
, clashTestGroup "Numbers"
697699
[ runTest "BitInteger" def

‎tests/shouldwork/Netlist/HDLContainsLoc.hs‎

Lines changed: 37 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,37 @@
1+
{-# LANGUAGE DataKinds #-}
2+
3+
module HDLContainsLoc where
4+
5+
import Clash.Prelude
6+
7+
import qualified Prelude as P
8+
import Data.List (isInfixOf)
9+
import System.Environment (getArgs)
10+
import System.FilePath ((</>), takeDirectory)
11+
12+
topEntity :: Maybe Int -> Int
13+
topEntity x = case x of Nothing -> 0; Just x -> x
14+
15+
assertIn :: String -> String -> IO ()
16+
assertIn needle haystack
17+
| needle `isInfixOf` haystack = return ()
18+
| otherwise = P.error $ P.concat [ "Expected:\n\n ", needle
19+
, "\n\nIn:\n\n", haystack ]
20+
21+
mainVHDL :: IO ()
22+
mainVHDL = do
23+
[topDir] <- getArgs
24+
content <- readFile (topDir </> show 'topEntity </> "topEntity.vhdl")
25+
assertIn "HDLContainsLoc.hs:" content
26+
27+
mainVerilog :: IO ()
28+
mainVerilog = do
29+
[topDir] <- getArgs
30+
content <- readFile (topDir </> show 'topEntity </> "topEntity.v")
31+
assertIn "HDLContainsLoc.hs:" content
32+
33+
mainSystemVerilog :: IO ()
34+
mainSystemVerilog = do
35+
[topDir] <- getArgs
36+
content <- readFile (topDir </> show 'topEntity </> "topEntity.sv")
37+
assertIn "HDLContainsLoc.hs:" content

‎tests/shouldwork/Netlist/HDLNotContainsLoc.hs‎

Lines changed: 39 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,39 @@
1+
{-# LANGUAGE DataKinds #-}
2+
3+
module HDLNotContainsLoc where
4+
5+
import Clash.Prelude
6+
7+
import qualified Prelude as P
8+
import Data.List (isInfixOf)
9+
import System.Environment (getArgs)
10+
import System.FilePath ((</>), takeDirectory)
11+
12+
topEntity :: Maybe Int -> Int
13+
topEntity x = case x of Nothing -> 0; Just x -> x
14+
15+
assertNotIn :: String -> String -> IO ()
16+
assertNotIn needle haystack
17+
| not (needle `isInfixOf` haystack)
18+
= return ()
19+
| otherwise
20+
= P.error $ P.concat [ "Did not expect:\n\n ", needle
21+
, "\n\nIn:\n\n", haystack ]
22+
23+
mainVHDL :: IO ()
24+
mainVHDL = do
25+
[topDir] <- getArgs
26+
content <- readFile (topDir </> show 'topEntity </> "topEntity.vhdl")
27+
assertNotIn "HDLNotContainsLoc.hs:" content
28+
29+
mainVerilog :: IO ()
30+
mainVerilog = do
31+
[topDir] <- getArgs
32+
content <- readFile (topDir </> show 'topEntity </> "topEntity.v")
33+
assertNotIn "HDLNotContainsLoc.hs:" content
34+
35+
mainSystemVerilog :: IO ()
36+
mainSystemVerilog = do
37+
[topDir] <- getArgs
38+
content <- readFile (topDir </> show 'topEntity </> "topEntity.sv")
39+
assertNotIn "HDLNotContainsLoc.hs:" content

0 commit comments

Comments
 (0)