diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,66 @@ # Changelog for the Clash project +## 1.10.2 *Sep 4th, 2026* + +Highlights: +* On a large representative circuit, this release reduces total runtime by 80% compared to 1.10.0; smaller circuits also recover from some previous performance regressions. See the [Clash benchmark results](https://clash-lang.github.io/clash-benchmarks/?machine=oele&branch=clash-lang/clash-compiler@1.10) for the comparison. + +Performance: +* The `clash-lib` compile-time evaluator no longer projects the entire global binding map into a fresh heap on (virtually) every invocation. In the representative benchmark, this reduced runtime by about 27%. See [#3323](https://github.com/clash-lang/clash-compiler/pull/3323). +* The `clash-ghc` compile-time evaluator peels elements from a literal `BitVector` via `unconcatBitVector#` directly as literals, rather than leaving residual `split#` calls for later rewrite passes. This speeds up normalization of designs that convert large `BitVector` constants to vectors. See [#3323](https://github.com/clash-lang/clash-compiler/pull/3323). +* In `clash-lib`, the Core-type-to-HWType translation used by representability queries during normalization is memoized across the rewrite session rather than recomputed for every query. This speeds up normalization of designs with large or deeply nested types. See [#3323](https://github.com/clash-lang/clash-compiler/pull/3323). +* The conversion from GHC Core to Clash Core in `clash-ghc` is faster on large designs: type-constructor annotations are pre-checked on the interned name, the accumulated TyCon map is no longer re-inserted at every occurrence, and global-variable types are converted once and cached. See [#3323](https://github.com/clash-lang/clash-compiler/pull/3323). +* Identifier-only free-variable folds in `clash-lib` now skip unnecessary type traversal, yielding about 2% faster normalization. See [#3327](https://github.com/clash-lang/clash-compiler/pull/3327). +* In the `clash-ghc`/`clash-lib` blackbox compilation path, blackbox functions and Haskell template functions now share a single Hint (GHC) session, and each distinct function is compiled exactly once. In larger designs, this reduced load time by about 20% and end-to-end runtime by about 2%. See [#3337](https://github.com/clash-lang/clash-compiler/pull/3337). +* In `clash-lib`, alpha-equivalence checks on `Term` and `Type` no longer compute free variables. Microbenchmarks show substantial speedups; end-to-end tests show a modest 2.5% improvement in normalization runtime. See [#3335](https://github.com/clash-lang/clash-compiler/pull/3335). +* In `clash-lib`, the cleanup phase that flattens the function hierarchy now runs the evaluator-backed transformations (`reduceConst`, `reduceNonRepPrim`) and the transformations that piggyback on their output as one bottom-up pass per flattening iteration, rather than during every settle round of the inner fixed-point loop. On larger designs, this produced about a 30% end-to-end improvement without changing generated HDL. See [#3338](https://github.com/clash-lang/clash-compiler/pull/3338). +* In `clash-ghc`, GHC-to-Clash type conversion is memoized by GHC type, with unchanged output. Types repeat extensively across binders, and converting one evaluates family-instance reductions and name conversions per node. On larger designs, this roughly halved loading time. See [#3340](https://github.com/clash-lang/clash-compiler/pull/3340). +* In `clash-lib`, `reduceNonRepPrim` dispatches on the primitive's name through a `HashMap` of handlers rather than walking a chain of string comparisons. On larger designs, this produced about a 6% end-to-end improvement. See [#3339](https://github.com/clash-lang/clash-compiler/pull/3339). +* In `clash-lib`, beta-reduction in the `appProp` transformation now uses a sharing-preserving substitution that leaves unchanged subterms untouched instead of rebuilding every visited node. Output is unchanged. See [#3341](https://github.com/clash-lang/clash-compiler/pull/3341). +* In `clash-lib`, the inlining transformations (`inlineWorkFree`, `inlineSmall`, `bindConstantVar`) now run cheap binder-only guards before computing type information, skip attempts at inner application-spine nodes, and stop measuring term size once it exceeds the inline limit. On larger designs, this reduced compiler runtime by about 8%. See [#3356](https://github.com/clash-lang/clash-compiler/pull/3356). + +Added: +* Blackboxes `~SYM`s can now be referenced by name + + Instead of doing: + ``` + signal ~GENSYM[foo][3] : ..; + signal ~GENSYM[bar][4] : ..; + + .. <= ~SYM[3] - ~SYM[4]; + ``` + + You can now refer to SYMbols by name: + ``` + signal ~SYM[foo] : ..; + signal ~SYM[bar] : ..; + + .. <= ~SYM[foo] - ~SYM[bar]; + ``` + + The old behaviour with `~GENSYM` and the numeric references is still fully supported. + + See [#3325](https://github.com/clash-lang/clash-compiler/issues/3325), implemented in [#3326](https://github.com/clash-lang/clash-compiler/pull/3326). +* `clash-lib` now provides `Hashable Term` and `Hashable Type` instances. These were removed in Clash 1.4.7 due to a faulty implementation, but are now back. They hash modulo alpha equivalence, and so agree with `Eq Term` and `Eq Type`: alpha-equivalent terms hash alike. See [#3336](https://github.com/clash-lang/clash-compiler/pull/3336). + +Changed: +* `clash-cosim` and `clash-ffi` packages have been removed from the `clash-compiler` repository and moved to standalone archived repositories. See [#3330](https://github.com/clash-lang/clash-compiler/pull/3330). +* The `clash` command-line flag `-fclash-debug-count-transformations` now also reports how often each transformation was attempted (counters suffixed `!try`), next to the existing applied-rewrite counts. See [#3356](https://github.com/clash-lang/clash-compiler/pull/3356). + +Fixed: +* In `clash-lib`, alpha-equivalence on terms now compares the `NameMod` and `Attributes` of a tick under the enclosing renaming environment, instead of in isolation. See [#3335](https://github.com/clash-lang/clash-compiler/pull/3335). +* In `clash-lib`, `freshenTm` now renames inside of an `Attributes` tick, added by `Clash.Annotations.SynthesisAttributes.annotateReg`. See [#3335](https://github.com/clash-lang/clash-compiler/pull/3335). +* In `clash-lib`, alpha-equivalence and alpha-comparison on terms now compare the types of `Rec` let binders, which they previously ignored. A `NonRec` binder's type is pinned down by its right-hand side, so it does not need comparing, but a `Rec` binder may occur in its own right-hand side, so its type is not determined by the right-hand side: `let x = x in x` is the same term whether `x` is an `Int` or a `Bool`. `eqTerm` already compared them, so `Eq Term` and `eqTerm` disagreed on such terms. See [#3335](https://github.com/clash-lang/clash-compiler/pull/3335). +* In `clash-lib`, `Ord Term` and `Ord Type` now behave lawfully. Comparison used to rename each pair of binders to a variable free in neither argument, preferring the left one, so which name an occurrence resolved to depended on which argument came first: `compare` on `forall a. forall b. b` and `forall c. forall d. c` returned `GT` whichever way round they were passed. See [#3335](https://github.com/clash-lang/clash-compiler/pull/3335). +* In `clash-lib`, `reduceNonRepPrim` now pierces through type families, `newtype`s and `Signal` constructors when determining a primitive's result type. See [#3339](https://github.com/clash-lang/clash-compiler/pull/3339). +* In `clash-lib`, the disjoint expression consolidation (DEC) transformation created non-exhaustive case-expressions when the consolidated function was not applied in every alternative. When constant propagation later reduced such a case-expression, compilation failed with `Clash error call: scrutinise: ...`. The argument-selecting case-expressions now carry a default alternative for the branches in which the consolidated function is not used [#2770](https://github.com/clash-lang/clash-compiler/issues/2770). See [#3344](https://github.com/clash-lang/clash-compiler/pull/3344). +* In `clash-ghc`, type family applications no longer get stuck when the top entity's module is loaded from an interface file and nothing else in the design causes the interfaces holding the needed family instances to be read. This made designs mentioning e.g. `BitVector (BitSize Bool)` behind another type family fail with `Cannot reduce to an integer`. See [#1534](https://github.com/clash-lang/clash-compiler/issues/1534), fixed in [#3343](https://github.com/clash-lang/clash-compiler/pull/3343). +* In `clash-lib`, `reduceNonRepPrim` now correctly accounts for non-work primitives returning a zero-length `Vec` and under-applied ones. See [#3348](https://github.com/clash-lang/clash-compiler/issues/3348), fixed in [#3349](https://github.com/clash-lang/clash-compiler/pull/3349). +* Name-shadowing warnings caused by blackboxes re-using identifiers has been fixed. See [#3273](https://github.com/clash-lang/clash-compiler/issues/3273), fixed in [#3353](https://github.com/clash-lang/clash-compiler/pull/3353). +* In `clash-ghc`, Clash no longer enables `-dynamic-too` when the build is already dynamic, which made GHC emit an `-Winconsistent-flags` warning. See [#3354](https://github.com/clash-lang/clash-compiler/issues/3354), fixed in [#3358](https://github.com/clash-lang/clash-compiler/pull/3358). +* In `clash-lib`, the SystemVerilog backend no longer emits out-of-bounds array indices when a nested modifier selects a half of an `RTree`. The size of a tree half was computed as `(d-1)^2` instead of `2^(d-1)`, so for an `RTree 3` the right half was emitted as `[4:8]` on an array whose valid indices are `0..7`. See [#3359](https://github.com/clash-lang/clash-compiler/issues/3359), fixed in [#3360](https://github.com/clash-lang/clash-compiler/pull/3360). +* In `clash-lib` and `clash-ghc`, structural equality and ordering now account for the names and types of variables, including in `eqTerm` and `eqType`, instead of relying only on variable uniques. See [#3361](https://github.com/clash-lang/clash-compiler/issues/3361), fixed in [#3362](https://github.com/clash-lang/clash-compiler/pull/3362). + ## 1.10.1 *Aug 27th, 2026* Highlights: diff --git a/clash-ghc.cabal b/clash-ghc.cabal --- a/clash-ghc.cabal +++ b/clash-ghc.cabal @@ -1,6 +1,6 @@ Cabal-version: 2.2 Name: clash-ghc -Version: 1.10.1 +Version: 1.10.2 Synopsis: Clash: a functional hardware description language - GHC frontend Description: Clash is a functional hardware description language that borrows both its @@ -173,8 +173,8 @@ text >= 1.2.2 && < 2.2, transformers >= 0.5.2.0 && < 0.7, unordered-containers >= 0.2.1.0 && < 0.3, - clash-lib == 1.10.1, - clash-prelude == 1.10.1, + clash-lib == 1.10.2, + clash-prelude == 1.10.2, ghc-typelits-extra, ghc-typelits-knownnat, ghc-typelits-natnormalise, diff --git a/src-ghc/Clash/GHC/Evaluator/Primitive.hs b/src-ghc/Clash/GHC/Evaluator/Primitive.hs --- a/src-ghc/Clash/GHC/Evaluator/Primitive.hs +++ b/src-ghc/Clash/GHC/Evaluator/Primitive.hs @@ -4578,38 +4578,51 @@ n' | Right m <- runExcept (tyNatSize tcm mTy) -> let Just vecTc = UniqMap.lookup vecTcNm tcm [_,consCon] = tyConDataCons vecTc - tupTcNm = ghcTyconToTyConName (tupleTyCon Boxed 2) - Just tupTc = UniqMap.lookup tupTcNm tcm - [tupDc] = tyConDataCons tupTc - splitCall = - mkApps (bvSplitPrim bvTcNm) - [ Right (mkTyConApp typeNatMul [LitTy (NumTy (n'-1)),mTy]) - , Right mTy - , Left (Literal (NaturalLiteral ((n'-1)*m))) - , Left (valToTerm bv) - ] mBVTy = mkTyConApp bvTcNm [mTy] - n1BVTy = mkTyConApp bvTcNm - [mkTyConApp typeNatMul - [LitTy (NumTy (n'-1)) - ,mTy]] - -- Guaranteed no capture, so okay to use unsafe name generation - xNm = mkUnsafeSystemName "x" 0 - bvNm = mkUnsafeSystemName "bv'" 1 - xId = mkLocalId mBVTy xNm - bvId = mkLocalId n1BVTy bvNm - tupPat = DataPat tupDc [] [xId,bvId] - xAlt = (tupPat, (Var xId)) - bvAlt = (tupPat, (Var bvId)) + n1MTy = mkTyConApp typeNatMul [LitTy (NumTy (n'-1)),mTy] + n1BVTy = mkTyConApp bvTcNm [n1MTy] - in reduce $ mkVecCons consCon (mkTyConApp bvTcNm [mTy]) n' - (Case splitCall mBVTy [xAlt]) + (hd, tl) = case bitVectorLiteral bv of + -- Fast path for literals + Just (mski, i) -> + let sh = fromInteger ((n'-1) * m) + loMask = bit sh - 1 + in ( mkBitVectorLit mBVTy mTy m + (mski `shiftR` sh) (i `shiftR` sh) + , mkBitVectorLit n1BVTy n1MTy ((n'-1)*m) + (mski .&. loMask) (i .&. loMask) + ) + Nothing -> + let tupTcNm = ghcTyconToTyConName (tupleTyCon Boxed 2) + Just tupTc = UniqMap.lookup tupTcNm tcm + [tupDc] = tyConDataCons tupTc + splitCall = + mkApps (bvSplitPrim bvTcNm) + [ Right n1MTy + , Right mTy + , Left (Literal (NaturalLiteral ((n'-1)*m))) + , Left (valToTerm bv) + ] + -- Guaranteed no capture, so okay to use unsafe name + -- generation + xNm = mkUnsafeSystemName "x" 0 + bvNm = mkUnsafeSystemName "bv'" 1 + xId = mkLocalId mBVTy xNm + bvId = mkLocalId n1BVTy bvNm + tupPat = DataPat tupDc [] [xId,bvId] + xAlt = (tupPat, (Var xId)) + bvAlt = (tupPat, (Var bvId)) + in ( Case splitCall mBVTy [xAlt] + , Case splitCall n1BVTy [bvAlt] + ) + + in reduce $ mkVecCons consCon mBVTy n' hd (mkApps (Prim pInfo) [ Right (LitTy (NumTy (n'-1))) , Right mTy , Left (Literal (NaturalLiteral (n'-1))) , Left (valToTerm km) - , Left (Case splitCall n1BVTy [bvAlt]) + , Left tl ]) _ -> Nothing "Data.Text.Show.$wunpackCStringAscii#" diff --git a/src-ghc/Clash/GHC/GHC2Core.hs b/src-ghc/Clash/GHC/GHC2Core.hs --- a/src-ghc/Clash/GHC/GHC2Core.hs +++ b/src-ghc/Clash/GHC/GHC2Core.hs @@ -1,8 +1,8 @@ {-| Copyright : (C) 2013-2016, University of Twente, 2016-2017, Myrtle Software Ltd, - 2017-2022, Google Inc. - 2021-2025, QBayLogic B.V., + 2017-2022, Google Inc., + 2021-2026, QBayLogic B.V. License : BSD2 (see the file LICENSE) Maintainer : QBayLogic B.V. -} @@ -35,7 +35,7 @@ where -- External Modules -import Control.Lens ((^.), (%~), (&), (%=), (.~), view, makeLenses) +import Control.Lens ((^.), (%~), (&), (%=), (.~), use, view, makeLenses) import Control.Applicative ((<|>)) import Control.Monad.Extra (ifM, andM) import Control.Monad.RWS.Strict (RWS) @@ -79,7 +79,7 @@ ( FamInst (..), FamInstEnvs , familyInstances, normaliseType, emptyFamInstEnvs, topReduceTyFamApp_maybe ) -import GHC.Data.FastString (unpackFS, bytesFS) +import GHC.Data.FastString (FastString, mkFastString, unpackFS, bytesFS) import GHC.Types.Id (isDataConId_maybe) import GHC.Types.Id.Info (IdDetails (..), unfoldingInfo) import GHC.Types.Literal (Literal (..), LitNumType (..), literalType) @@ -87,7 +87,7 @@ import GHC.Types.Name (Name, nameModule_maybe, nameOccName, nameUnique, getSrcSpan) import GHC.Builtin.Names (integerTyConKey, naturalTyConKey) -import GHC.Types.Name.Occurrence (occNameString) +import GHC.Types.Name.Occurrence (occNameFS, occNameString) import GHC.Data.Pair (Pair (..)) import GHC.Types.SrcLoc (SrcSpan (..), isGoodSrcSpan) import GHC.Core.TyCon @@ -127,10 +127,88 @@ instance Hashable Name where hashWithSalt s = hashWithSalt s . getKey . nameUnique +-- | A GHC 'Type' keyed for cache lookups: 'Eq' and 'Hashable' compare types +-- structurally instead of up to alpha-equivalence or type synonym expansion. +-- See 'eqType'. +newtype StructuralType = StructuralType Type + +instance Eq StructuralType where + StructuralType l == StructuralType r = eqType l r + +instance Hashable StructuralType where + hashWithSalt salt (StructuralType ty) = hashType salt ty + +-- | Structural equality on GHC types: type synonyms stay unexpanded, +-- alpha-equivalent types are distinct, and types containing casts or +-- coercions never compare equal. +eqType :: Type -> Type -> Bool +eqType = go + where + go (TyVarTy v1) (TyVarTy v2) = eqVar v1 v2 + go (AppTy l1 r1) (AppTy l2 r2) = go l1 l2 && go r1 r2 + go (TyConApp tc1 args1) (TyConApp tc2 args2) = + tc1 == tc2 && goList args1 args2 + go (ForAllTy (Bndr v1 f1) t1) (ForAllTy (Bndr v2 f2) t2) = + eqVar v1 v2 && f1 == f2 && go t1 t2 + go (FunTy f1 m1 a1 r1) (FunTy f2 m2 a2 r2) = + f1 == f2 && go m1 m2 && go a1 a2 && go r1 r2 + go (LitTy l1) (LitTy l2) = l1 == l2 + -- XXX: Not sure how to handle casts/coercions, so for now just claim they're + -- not equal. That's fair in the only context this is used: caching. + go _ _ = False + + -- GHC's 'Eq' on 'Var' and on 'Name' only compares uniques, and a unique only + -- identifies a variable within one scope. We want to use it for cache lookups, + -- so we should also take name and type differences into account! + eqVar v1 v2 = + v1 == v2 && eqVarName (varName v1) (varName v2) + && go (varType v1) (varType v2) + + -- 'coreToName' reads a name's occurrence name and module (as a qualified + -- string, which also decides its 'C.NameSort') and its source span + eqVarName n1 n2 = + nameOccName n1 == nameOccName n2 + && nameModule_maybe n1 == nameModule_maybe n2 + && getSrcSpan n1 == getSrcSpan n2 + + goList (t1:ts1) (t2:ts2) = go t1 t2 && goList ts1 ts2 + goList [] [] = True + goList _ _ = False + +-- | Hash a GHC type, matching 'eqType': types that compare equal hash equally. +hashType :: Int -> Type -> Int +hashType = go + where + go s ty = case ty of + TyVarTy v -> hashVar (tag s 0) v + AppTy l r -> go (go (tag s 1) l) r + TyConApp tc args -> foldl go (hashWithSalt (tag s 2) (getKey (tyConUnique tc))) args + ForAllTy (Bndr v _) t -> go (hashVar (tag s 3) v) t + FunTy _ m a r -> go (go (go (tag s 4) m) a) r + LitTy l -> case l of + NumTyLit i -> hashWithSalt (tag s 5) i + StrTyLit str -> hashWithSalt (tag s 6) (unpackFS str) + CharTyLit c -> hashWithSalt (tag s 7) c + CastTy t _ -> go (tag s 8) t + CoercionTy _ -> tag s 9 + + -- Matching 'eqType', see comment there. Deliberately coarser than 'eqVar': + -- it skips the name, which only costs the odd collision. The hash law needs + -- equal values to hash equally, not the other way around. + hashVar s v = go (hashWithSalt s (getKey (varUnique v))) (varType v) + + tag :: Int -> Int -> Int + tag = hashWithSalt + data GHC2CoreState = GHC2CoreState { _tyConMap :: C.UniqMap TyCon , _nameMap :: HashMap Name Text + , _varTypeMap :: HashMap Name C.Type + -- ^ Cache for converted types of global variables ('varType'). See + -- 'coreToVarType'. + , _convertedTypeCache :: HashMap StructuralType C.Type + -- ^ Cache for converted types, keyed on the GHC type. See 'coreToType'. } makeLenses ''GHC2CoreState @@ -144,7 +222,8 @@ makeLenses ''GHC2CoreEnv emptyGHC2CoreState :: GHC2CoreState -emptyGHC2CoreState = GHC2CoreState mempty HashMap.empty +emptyGHC2CoreState = + GHC2CoreState mempty HashMap.empty HashMap.empty HashMap.empty newtype SrcSpanRB = SrcSpanRB {unSrcSpanRB :: SrcSpan} @@ -491,12 +570,7 @@ termSP sp = fmap (second unSrcSpanRB) . RWS.listen . addUsefullR sp . term - coreToIdSP sp = RWS.local (\r@(GHC2CoreEnv _ e) -> - if isGoodSrcSpan sp then - GHC2CoreEnv sp e - else - r) - . coreToId + coreToIdSP sp = addUsefullR sp . coreToId lookupPrim :: Text -> Maybe (Maybe CompiledPrimitive) @@ -505,7 +579,7 @@ var x = do xPrim <- if isGlobalId x then coreToPrimVar x else coreToVar x let xNameS = C.nameOcc xPrim - xType <- coreToType (varType x) + xType <- coreToVarType x case isDataConId_maybe x of Just dc -> case lookupPrim xNameS of Just p -> @@ -633,6 +707,12 @@ then RWS.local (srcSpan .~ x) m else m +-- | Convert without an ambient source span: names GHC gives no location of +-- their own get 'noSrcSpan' instead of the location of the binder under +-- conversion. +withoutSrcSpan :: C2C a -> C2C a +withoutSrcSpan = RWS.local (srcSpan .~ noSrcSpan) + isSizedCast :: Type -> Type -> C2C Bool isSizedCast (TyConApp tc1 _) (TyConApp tc2 _) = do tc1Nm <- qualifiedNameString (tyConName tc1) @@ -867,14 +947,21 @@ coreToAttrs' illegal = error $ "Unexpected type args to Annotate: " ++ show (map (showPprUnsafe) illegal) +annotateOccFS :: FastString +annotateOccFS = mkFastString "Annotate" +{-# NOINLINE annotateOccFS #-} + -- | If this type has an annotate type synonym, return list of attributes. coreToAttrs :: Type -> C2C [Attr Text] -coreToAttrs (TyConApp tycon kindsOrTypes) = do - name' <- typeConstructorToString tycon +coreToAttrs (TyConApp tycon kindsOrTypes) + -- Cheap pre-check on the interned occurrence name; only build the qualified + -- name when it can possibly be Clash.Annotations.SynthesisAttributes.Annotate. + | occNameFS (nameOccName (tyConName tycon)) == annotateOccFS = do + name' <- typeConstructorToString tycon - if name' == show ''Annotate - then coreToAttrs' kindsOrTypes - else return [] + if name' == show ''Annotate + then coreToAttrs' kindsOrTypes + else return [] coreToAttrs _ = return [] @@ -893,11 +980,25 @@ -- | Converts GHC Type to a Clash Type. Strips newtypes and signals, with the -- exception of newtypes used as annotations (see: SynthesisAttributes). +-- +-- Conversions are memoized on the GHC type, which also shares the converted +-- types. The conversion runs 'withoutSrcSpan' so that it depends on the GHC +-- type alone; nothing ever reads back the source spans of names inside a +-- type, so no information is lost. coreToType :: Type -> C2C C.Type -coreToType ty = ty'' >>= annotateType ty +coreToType ty = do + cache <- use convertedTypeCache + case HashMap.lookup (StructuralType ty) cache of + Just ty1 -> pure ty1 + Nothing -> do + ty1 <- withoutSrcSpan convert + convertedTypeCache %= HashMap.insert (StructuralType ty) ty1 + pure ty1 where + convert = ty'' >>= annotateType ty + ty'' | Just ty' <- coreView ty = coreToType ty' | TyConApp tc xs <- ty = do envs <- view famInstEnvs @@ -919,7 +1020,7 @@ foldl C.AppTy <$> coreToType synTy' <*> mapM coreToType remArgs _ -> do tcName <- coreToName tyConName tyConUnique qualifiedNameString tc - tyConMap %= (C.insert tcName tc) + tyConMap %= C.insertIfAbsent tcName tc C.mkTyConApp <$> (pure tcName) <*> mapM coreToType args coreToType' (ForAllTy (Bndr tv _) ty) = C.ForAllTy <$> coreToTyVar tv <*> coreToType ty -- TODO: save the distinction between => and -> @@ -944,13 +1045,25 @@ coreToId :: Id -> C2C C.Id coreToId i = do - C.mkId <$> coreToType (varType i) <*> pure scope <*> coreToVar i + C.mkId <$> coreToVarType i <*> pure scope <*> coreToVar i where scope = if isGlobalId i then C.GlobalId else C.LocalId coreToVar :: Var -> C2C (C.Name a) coreToVar = coreToName varName varUnique qualifiedNameStringM + +-- | Convert the type of a variable, memoized on the variable's name. +-- +-- Only global variables are memoized: their names come from GHC's name cache +-- and are globally unique, so the same name always refers to the same +-- variable, whose type is intrinsic. Names of local variables (e.g. binders +-- instantiated when loading unfoldings from interface files) can collide +-- between declarations and must not share cache entries. +coreToVarType :: Var -> C2C C.Type +coreToVarType v + | isGlobalId v = makeCached (varName v) varTypeMap (coreToType (varType v)) + | otherwise = coreToType (varType v) coreToPrimVar :: Var -> C2C (C.Name C.Term) diff --git a/src-ghc/Clash/GHC/GenerateBindings.hs b/src-ghc/Clash/GHC/GenerateBindings.hs --- a/src-ghc/Clash/GHC/GenerateBindings.hs +++ b/src-ghc/Clash/GHC/GenerateBindings.hs @@ -71,7 +71,7 @@ ,mkVarEnv, unionVarEnv, elemVarSet, mkVarSet) import qualified Clash.Data.UniqMap as UniqMap import Clash.Debug (traceIf) -import Clash.Driver (compilePrimitive) +import Clash.Driver (compilePrimitives) import Clash.Driver.Bool (toGhcOverridingBool) import Clash.Driver.Types (BindingMap, Binding(..), IsPrim(..), ClashEnv(..), ClashDesign(..), ClashOpts(..)) import Clash.GHC.GHC2Core @@ -123,10 +123,7 @@ startTime <- Clock.getCurrentTime primMapR <- generatePrimMap unresolvedPrims primGuards (concat [pFP, primDirs, importDirs]) tdir <- maybe ghcLibDir (pure . GHC.topDir) dflagsM - primMapC <- - sequence $ HashMap.map - (sequence . fmap (compilePrimitive importDirs dbs tdir)) - primMapR + primMapC <- compilePrimitives importDirs dbs tdir primMapR let ((bindingsMap,clsVMap),tcMap,_) = RWS.runRWS (mkBindings primMapC bindings clsOps unlocatable) (GHC2CoreEnv GHC.noSrcSpan fiEnvs) diff --git a/src-ghc/Clash/GHC/LoadModules.hs b/src-ghc/Clash/GHC/LoadModules.hs --- a/src-ghc/Clash/GHC/LoadModules.hs +++ b/src-ghc/Clash/GHC/LoadModules.hs @@ -113,6 +113,7 @@ import qualified GHC.Data.FastString as FastString import qualified GHC import qualified GHC.Driver.Main as HscMain +import qualified GHC.Iface.Load as IfaceLoad import qualified GHC.Utils.Monad as MonadUtils import qualified GHC.Utils.Panic as Panic import qualified GHC.Serialized as Serialized (deserializeWithData) @@ -199,6 +200,7 @@ loadExternalModule hdl modName0 mainIsM = MC.try $ do let modName1 = GHC.mkModuleName modName0 foundMod <- GHC.findModule modName1 Nothing + loadFamilyInstanceModules foundMod let errMsg = "Internal error: found module, but could not load it" modInfo <- fromMaybe (error errMsg) <$> (GHC.getModuleInfo foundMod) tyThings <- catMaybes <$> mapM GHC.lookupGlobalName (GHC.modInfoExports modInfo) @@ -215,6 +217,26 @@ -- 'loadModules' is unaffected by the pruning above. return (rootIds, FamInstEnv.emptyFamInstEnv, modName1, loaded, allBinders) +-- | Read the interfaces of all modules that (transitively) contain type family +-- instances, so that those instances are visible in the external package state. +-- Also see https://github.com/clash-lang/clash-compiler/issues/1534. +loadFamilyInstanceModules :: GHC.GhcMonad m => GHC.Module -> m () +loadFamilyInstanceModules rootModule = runTcInteractive $ do + iface <- IfaceLoad.loadModuleInterface doc rootModule + IfaceLoad.loadModuleInterfaces doc (HscTypes.dep_finsts (GHC.mi_deps iface)) + where + doc = Outputable.text "Clash: reading type family instances" + +-- | Run a type checker action in the interactive context of the current session, +-- turning a failure into a source error. +runTcInteractive :: GHC.GhcMonad m => TcRnTypes.TcM a -> m a +runTcInteractive action = do + hscEnv <- GHC.getSession + (msgs, res) <- liftIO (TcRnMonad.initTcInteractive hscEnv action) + case res of + Nothing -> liftIO (throwIO (HscTypes.mkSrcErr (fmap GhcTcRnMessage msgs))) + Just a -> pure a + -- | Restrict the set of binders we load the transitive closure of. When a -- @-main-is@ name is given we do not need every export: any binder (and its -- closure) that is not selected as a top entity would be loaded, converted to @@ -303,8 +325,12 @@ ghcDynamic = case lookup "GHC Dynamic" (DynFlags.compilerInfo dflags) of Just "YES" -> True _ -> False - dflags3 = if ghcDynamic then DynFlags.gopt_set dflags2 DynFlags.Opt_BuildDynamicToo - else dflags2 + -- If the build is already dynamic, dynamic objects get built anyway and GHC + -- warns about '-dynamic-too' being ignored. See #3354. + targetIsDynamic = DynFlags.ways dflags2 `Ways.hasWay` Ways.WayDyn + dflags3 = if ghcDynamic && not targetIsDynamic + then DynFlags.gopt_set dflags2 DynFlags.Opt_BuildDynamicToo + else dflags2 when (DynFlags.gopt DynFlags.Opt_WorkerWrapper dflags3) $ trace @@ -550,15 +576,9 @@ MonadUtils.liftIO $ putStrLn $ "GHC: Compiling and loading modules took: " ++ modStartDiff -- Get type family instances: accumulated by GhcMonad during - -- 'loadExternalBinders' / 'loadExternalExprs' - hscEnv <- GHC.getSession - famInstEnvs <- do - (msgs, m) <- TcRnMonad.liftIO $ TcRnMonad.initTcInteractive hscEnv FamInst.tcGetFamInstEnvs - case m of - Nothing -> TcRnMonad.liftIO $ throwIO - $ HscTypes.mkSrcErr - $ fmap GhcTcRnMessage msgs - Just x -> return x + -- 'loadExternalBinders' / 'loadExternalExprs', and by + -- 'loadFamilyInstanceModules' for modules loaded from interface files. + famInstEnvs <- runTcInteractive FamInst.tcGetFamInstEnvs allSyn <- Map.fromList <$> findSynthesizeAnnotations allBinderIds topSyn <- map fst <$> findSynthesizeAnnotations rootIds