inlineCleanup introduces free variables
#1337
Assignees
Labels
Comments
|
Ah, this only triggers after this patch: diff --git a/clash-lib/src/Clash/Normalize/Transformations.hs b/clash-lib/src/Clash/Normalize/Transformations.hs
index 8706b3cc..bb2dde34 100644
--- a/clash-lib/src/Clash/Normalize/Transformations.hs
+++ b/clash-lib/src/Clash/Normalize/Transformations.hs
@@ -2148,8 +2148,9 @@ reduceNonRepPrim c@(TransformContext is0 ctx) e@(App _ _) | (Prim p, args, ticks
| n == 0 -> changed rArg
| m == 0 -> changed lArg
| otherwise -> do
- shouldReduce1 <- List.orM [ shouldReduce ctx
- , isUntranslatableType_not_poly aTy ]
+ shouldReduce1 <- List.orM [ pure ultra
+ , shouldReduce ctx
+ , isUntranslatableType_not_poly aTy ]
if shouldReduce1
then (`mkTicks` ticks) <$> reduceAppend is0 n m aTy lArg rArg
else return e
@@ -2159,8 +2160,9 @@ reduceNonRepPrim c@(TransformContext is0 ctx) e@(App _ _) | (Prim p, args, ticks
[vArg] = Either.lefts args
case runExcept (tyNatSize tcm nTy) of
Right n -> do
- shouldReduce1 <- List.orM [ shouldReduce ctx
- , isUntranslatableType_not_poly aTy ]
+ shouldReduce1 <- List.orM [ pure ultra
+ , shouldReduce ctx
+ , isUntranslatableType_not_poly aTy ]
if shouldReduce1
then (`mkTicks` ticks) <$> reduceHead is0 (n+1) aTy vArg
else return e
@@ -2170,8 +2172,9 @@ reduceNonRepPrim c@(TransformContext is0 ctx) e@(App _ _) | (Prim p, args, ticks
[vArg] = Either.lefts args
case runExcept (tyNatSize tcm nTy) of
Right n -> do
- shouldReduce1 <- List.orM [ shouldReduce ctx
- , isUntranslatableType_not_poly aTy ]
+ shouldReduce1 <- List.orM [ pure ultra
+ , shouldReduce ctx
+ , isUntranslatableType_not_poly aTy ]
if shouldReduce1
then (`mkTicks` ticks) <$> reduceTail is0 (n+1) aTy vArg
else return e
@@ -2181,9 +2184,10 @@ reduceNonRepPrim c@(TransformContext is0 ctx) e@(App _ _) | (Prim p, args, ticks
[vArg] = Either.lefts args
case runExcept (tyNatSize tcm nTy) of
Right n -> do
- shouldReduce1 <- List.orM [ shouldReduce ctx
- , isUntranslatableType_not_poly aTy
- ]
+ shouldReduce1 <- List.orM [ pure ultra
+ , shouldReduce ctx
+ , isUntranslatableType_not_poly aTy
+ ]
if shouldReduce1
then (`mkTicks` ticks) <$> reduceLast is0 (n+1) aTy vArg
else return e
@@ -2193,8 +2197,9 @@ reduceNonRepPrim c@(TransformContext is0 ctx) e@(App _ _) | (Prim p, args, ticks
[vArg] = Either.lefts args
case runExcept (tyNatSize tcm nTy) of
Right n -> do
- shouldReduce1 <- List.orM [ shouldReduce ctx
- , isUntranslatableType_not_poly aTy ]
+ shouldReduce1 <- List.orM [ pure ultra
+ , shouldReduce ctx
+ , isUntranslatableType_not_poly aTy ]
if shouldReduce1
then (`mkTicks` ticks) <$> reduceInit is0 (n+1) aTy vArg
else return e
@@ -2213,9 +2218,10 @@ reduceNonRepPrim c@(TransformContext is0 ctx) e@(App _ _) | (Prim p, args, ticks
let ([_sArg,vArg],[nTy,aTy]) = Either.partitionEithers args
case runExcept (tyNatSize tcm nTy) of
Right n -> do
- shouldReduce1 <- List.orM [ shouldReduce ctx
- , isUntranslatableType_not_poly aTy
- ]
+ shouldReduce1 <- List.orM [ pure ultra
+ , shouldReduce ctx
+ , isUntranslatableType_not_poly aTy
+ ]
if shouldReduce1
then (`mkTicks` ticks) <$> reduceReplicate n aTy eTy vArg
else return e
@@ -2279,8 +2285,9 @@ reduceNonRepPrim c@(TransformContext is0 ctx) e@(App _ _) | (Prim p, args, ticks
let ([_sArg,vArg],[nTy,aTy]) = Either.partitionEithers args
case runExcept (tyNatSize tcm nTy) of
Right n -> do
- shouldReduce1 <- List.orM [ shouldReduce ctx
- , isUntranslatableType False aTy ]
+ shouldReduce1 <- List.orM [ pure ultra
+ , shouldReduce ctx
+ , isUntranslatableType False aTy ]
if shouldReduce1
then (`mkTicks` ticks) <$> reduceTReplicate n aTy eTy vArg
else return eso it might just be edit: cleaned up patch |
|
Actually, I just need to make |
|
A lot of that patch just seems to be whitespace changes |
martijnbastiaan
added a commit
that referenced
this issue
May 20, 2020
martijnbastiaan
added a commit
that referenced
this issue
May 20, 2020
martijnbastiaan
added a commit
that referenced
this issue
May 20, 2020
martijnbastiaan
added a commit
that referenced
this issue
May 20, 2020
martijnbastiaan
added a commit
that referenced
this issue
May 20, 2020
martijnbastiaan
added a commit
that referenced
this issue
May 25, 2020
martijnbastiaan
added a commit
that referenced
this issue
May 25, 2020
martijnbastiaan
added a commit
that referenced
this issue
May 25, 2020
martijnbastiaan
added a commit
that referenced
this issue
May 25, 2020
christiaanb
pushed a commit
that referenced
this issue
May 25, 2020
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
Updated issue report 19 May 2020:
If
inlineCleanupis given an expression of the following form:Depending on the actual expressions that the various binders represent, it will determine
resultis a binding that should be "kept", while all others should be inlined.inlineBndrsCleanupwill try to do this, but it currently fails to handle this case correctly. It will yield:i.e., it will introduce a free variable!
Original issue report 18 May 2020:
Compiling the following:
{-# LANGUAGE GADTs #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE RecordWildCards #-} module Test where import Clash.Prelude type Lanes = 2 data SigFn a b = SigFn { runSigFn :: SigType a -> SigType b } class Sig a where type SigType a instance Sig Bit where type SigType Bit = Signal System Bit instance Sig a => Sig (Vec n a) where type SigType (Vec n a) = Vec n (SigType a) instance (Sig a, Sig b) => Sig (a, b) where type SigType (a, b) = (SigType a, SigType b) singletonSigFn :: SigFn a (Vec 1 a) singletonSigFn = SigFn singleton headSigFn :: SigFn (Vec 1 a) a headSigFn = SigFn head defSigFn :: Default (SigType t) => SigFn s t defSigFn = SigFn (const def) (>>>) :: SigFn a b -> SigFn b c -> SigFn a c SigFn f >>> SigFn g = SigFn (g . f) (<=>) :: SigFn a b -> SigFn c d -> SigFn (a, c) (b, d) SigFn f <=> SigFn g = SigFn (\(x, y) -> (f x, g y)) splitSigFn :: KnownNat n => SigFn (Vec (n + m) a) (Vec n a, Vec m a) splitSigFn = SigFn splitAtI catSigFn :: SigFn (Vec n a, Vec m a) (Vec (n + m) a) catSigFn = SigFn (\(x, y) -> x ++ y) data BitLayout t where BitLayout :: forall bitCount t . ( KnownNat bitCount ) => { bitCount :: SNat bitCount , inFn :: SigFn t (Vec bitCount Bit) , outFn :: SigFn (Vec bitCount Bit) t } -> BitLayout t unitLayout :: BitLayout Bit unitLayout = BitLayout SNat singletonSigFn headSigFn voidLayout :: forall t . Default (SigType t) => BitLayout t voidLayout = BitLayout d0 defSigFn defSigFn catLayout :: forall n m s . ( KnownNat n , KnownNat m , 1 <= n ) => BitLayout (Vec n s) -> BitLayout (Vec m s) -> BitLayout (Vec (n + m) s) catLayout (BitLayout aBitCount aInFn aOutFn) (BitLayout bBitCount bInFn bOutFn) = let inFn = splitSigFn >>> (aInFn <=> bInFn) >>> catSigFn outFn = splitSigFn >>> (aOutFn <=> bOutFn) >>> catSigFn in BitLayout SNat inFn outFn vecLayout :: forall n n' t . ( n' ~ (n - 1) , 1 <= n , KnownNat n , KnownNat n' ) => Vec n (BitLayout t) -> BitLayout (Vec n t) vecLayout (BitLayout{..} :> others) = let headLayout = BitLayout SNat (headSigFn >>> inFn) (outFn >>> singletonSigFn) in case others of Nil -> headLayout _ -> headLayout `catLayout` vecLayout @n' others layout :: BitLayout (Vec Lanes Bit) layout = mkPos (0 :: Index (Lanes + 1)) mkPos :: forall rp . ( KnownNat rp , 1 <= rp ) => Index (rp + 1) -> BitLayout (Vec rp Bit) mkPos n = let lanes = map (\i -> if i < n then unitLayout else voidLayout) $ iterateI succ 0 in vecLayout lanes runBitLayout :: Default (SigType t) => BitLayout t -> SigType t -> SigType t runBitLayout BitLayout{..} = runSigFn ( inFn >>> outFn ) topEntity :: Vec Lanes (Signal System Bit) -> Vec Lanes (Signal System Bit) topEntity = runBitLayout layoutwith
cabal new-run clash -- Test.hs --vhdl -fclash-debug DebugSilent -fclash-compile-ultrayields:
The text was updated successfully, but these errors were encountered: