Skip to content

Commit

Permalink
Reduce splitAt to undefined in illegal contexts (#2835)
Browse files Browse the repository at this point in the history
Previously, the Clash compiler would try to reduce

```
splitAt d1 Nil
```
to something of type
```
(Vec 1 a, Vec (0-1) a)
```
by trying to project the head and the tail out of the `Nil`
constructor. This of course does not work resulting in an
out-of-bounds indexing error reported in:

#2831

The compiler now reduces above expressions to:

```
undefined :: (Vec 1 a, Vec (0-1) a)
```

Which is morally equivalent to the run-time exception Haskell
evaluation would have thrown if the circuit description was
evaluated like a regular Haskell program.

Fixes #2831
  • Loading branch information
christiaanb authored Nov 2, 2024
1 parent 5706eaf commit 10f26ff
Show file tree
Hide file tree
Showing 4 changed files with 33 additions and 6 deletions.
1 change: 1 addition & 0 deletions changelog/2024-10-29T14_54_54+01_00_fix2831
Original file line number Diff line number Diff line change
@@ -0,0 +1 @@
FIXED: Clash errors out when `Clash.Sized.Vector.splitAt` is compile-time evaluated in an illegal context
23 changes: 17 additions & 6 deletions clash-ghc/src-ghc/Clash/GHC/Evaluator/Primitive.hs
Original file line number Diff line number Diff line change
Expand Up @@ -3827,12 +3827,23 @@ ghcPrimStep tcm isSubj pInfo tys args mach = case primName pInfo of
-- (x:xs) <- v
m' | DC _ vArgs <- last args
-- (x:fst (splitAt (m-1) xs),snd (splitAt (m-1) xs))
-> reduce $
mkApps (Data tupDc) $ (map Right tyArgs) ++
[ Left (mkVecCons consCon aTy m' (Either.lefts vArgs !! 1)
(splitAtSelR (Either.lefts vArgs !! 2) m1VecTy [lAlt]))
, Left (splitAtSelR (Either.lefts vArgs !! 2) nVecTy [rAlt])
]
-> case Either.lefts vArgs of
(_ : x : xs : _) ->
reduce $
mkApps (Data tupDc) $ (map Right tyArgs) ++
[ Left (mkVecCons consCon aTy m' x
(splitAtSelR xs m1VecTy [lAlt]))
, Left (splitAtSelR xs nVecTy [rAlt])
]
_ ->
-- v actually reduces to Nil and not Cons, this only happens
-- when 'n' would reduce to a negative number; the complement
-- of 'm'.
--
-- See Clash issue: https://github.com/clash-lang/clash-compiler/issues/2831
let resTy = getResultTy tcm ty tys
in reduce (TyApp (Prim NP.undefined) resTy)

-- v doesn't reduce to a data-constructor
_ -> Nothing

Expand Down
1 change: 1 addition & 0 deletions tests/Main.hs
Original file line number Diff line number Diff line change
Expand Up @@ -634,6 +634,7 @@ runClashTest = defaultMain $ clashTestRoot
, runTest "T2623CaseConFVs" def{hdlLoad=[],hdlSim=[],hdlTargets=[VHDL]}
, runTest "T2781" def{hdlLoad=[],hdlSim=[],hdlTargets=[VHDL]}
, runTest "T2628" def{hdlTargets=[VHDL], buildTargets=BuildSpecific ["TACacheServerStep"], hdlSim=[]}
, runTest "T2831" def{hdlLoad=[],hdlSim=[],hdlTargets=[VHDL]}
] <>
if compiledWith == Cabal then
-- This tests fails without environment files present, which are only
Expand Down
14 changes: 14 additions & 0 deletions tests/shouldwork/Issues/T2831.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,14 @@
module T2831 where

import Clash.Prelude

f :: forall n. SNat n -> Unsigned 4
f n@SNat = case compareSNat n (SNat @15) of
SNatLE -> at @n @(16 - n - 1) SNat vec
SNatGT -> 0
where
vec :: Vec 16 (Unsigned 4)
vec = repeat 1

topEntity :: Unsigned 4
topEntity = f d17

0 comments on commit 10f26ff

Please sign in to comment.