Skip to content

Commit ec016d4

Browse files
rowanG077rowanG077
committed
Unpack no longer warns
FIXED: Clash no longer gives `Dubious primitive instantiation warning` when using `unpack` [#2386](#2386).
1 parent 8d6a861 commit ec016d4

File tree

9 files changed

+773
-40
lines changed

9 files changed

+773
-40
lines changed

‎changelog/2023-01-04T14_23_01+01_00_fix_2386

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,2 @@
1+
FIXED: Clash no longer gives `Dubious primitive instantiation warning`
2+
when using `unpack` [#2386](https://github.com/clash-lang/clash-compiler/issues/2386).

‎clash-ghc/src-ghc/Clash/GHC/Evaluator/Primitive.hs

Lines changed: 249 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -2,7 +2,8 @@
22
Copyright : (C) 2013-2016, University of Twente,
33
2016-2017, Myrtle Software Ltd,
44
2017-2022, Google Inc.,
5-
2017-2022, QBayLogic B.V.
5+
2017-2023, QBayLogic B.V.
6+
2023, LumiGuide Fietsdetectie B.V.
67
License : BSD2 (see the file LICENSE)
78
Maintainer : QBayLogic B.V. <[email protected]>
89
-}
@@ -2202,6 +2203,127 @@ ghcPrimStep tcm isSubj pInfo tys args mach = case primName pInfo of
22022203
-> reduce (boolToBoolLiteral tcm ty (s1 == s2))
22032204
| otherwise -> error (show args)
22042205

2206+
"Clash.Class.BitPack.Internal.packInt8#" -- :: Int8 -> BitVector 8
2207+
| [DC _ [Left arg]] <- args
2208+
, eval <- Evaluator ghcStep ghcUnwind ghcPrimStep ghcPrimUnwind
2209+
#if MIN_VERSION_base(4,16,0)
2210+
, mach2@Machine{mStack=[],mTerm=Literal (Int8Literal i)} <- whnf eval tcm True (setTerm arg $ stackClear mach)
2211+
#else
2212+
, mach2@Machine{mStack=[],mTerm=Literal (IntLiteral i)} <- whnf eval tcm True (setTerm arg $ stackClear mach)
2213+
#endif
2214+
-> let resTyInfo = extractTySizeInfo tcm ty tys
2215+
in Just $ mach2
2216+
{ mStack = mStack mach
2217+
, mTerm = mkBitVectorLit' resTyInfo 0 i
2218+
}
2219+
2220+
"Clash.Class.BitPack.Internal.packInt16#" -- :: Int16 -> BitVector 16
2221+
| [DC _ [Left arg]] <- args
2222+
, eval <- Evaluator ghcStep ghcUnwind ghcPrimStep ghcPrimUnwind
2223+
#if MIN_VERSION_base(4,16,0)
2224+
, mach2@Machine{mStack=[],mTerm=Literal (Int16Literal i)} <- whnf eval tcm True (setTerm arg $ stackClear mach)
2225+
#else
2226+
, mach2@Machine{mStack=[],mTerm=Literal (IntLiteral i)} <- whnf eval tcm True (setTerm arg $ stackClear mach)
2227+
#endif
2228+
-> let resTyInfo = extractTySizeInfo tcm ty tys
2229+
in Just $ mach2
2230+
{ mStack = mStack mach
2231+
, mTerm = mkBitVectorLit' resTyInfo 0 i
2232+
}
2233+
2234+
"Clash.Class.BitPack.Internal.packInt32#" -- :: Int32 -> BitVector 32
2235+
| [DC _ [Left arg]] <- args
2236+
, eval <- Evaluator ghcStep ghcUnwind ghcPrimStep ghcPrimUnwind
2237+
#if MIN_VERSION_base(4,16,0)
2238+
, mach2@Machine{mStack=[],mTerm=Literal (Int32Literal i)} <- whnf eval tcm True (setTerm arg $ stackClear mach)
2239+
#else
2240+
, mach2@Machine{mStack=[],mTerm=Literal (IntLiteral i)} <- whnf eval tcm True (setTerm arg $ stackClear mach)
2241+
#endif
2242+
-> let resTyInfo = extractTySizeInfo tcm ty tys
2243+
in Just $ mach2
2244+
{ mStack = mStack mach
2245+
, mTerm = mkBitVectorLit' resTyInfo 0 i
2246+
}
2247+
2248+
"Clash.Class.BitPack.Internal.packInt64#" -- :: Int64 -> BitVector 64
2249+
| [DC _ [Left arg]] <- args
2250+
, eval <- Evaluator ghcStep ghcUnwind ghcPrimStep ghcPrimUnwind
2251+
#if MIN_VERSION_base(4,16,0)
2252+
, mach2@Machine{mStack=[],mTerm=Literal (Int64Literal i)} <- whnf eval tcm True (setTerm arg $ stackClear mach)
2253+
#else
2254+
, mach2@Machine{mStack=[],mTerm=Literal (IntLiteral i)} <- whnf eval tcm True (setTerm arg $ stackClear mach)
2255+
#endif
2256+
-> let resTyInfo = extractTySizeInfo tcm ty tys
2257+
in Just $ mach2
2258+
{ mStack = mStack mach
2259+
, mTerm = mkBitVectorLit' resTyInfo 0 i
2260+
}
2261+
2262+
"Clash.Class.BitPack.Internal.packWord#" -- :: Word -> BitVector WORD_SIZE_IN_BITS
2263+
| [DC _ [Left arg]] <- args
2264+
, eval <- Evaluator ghcStep ghcUnwind ghcPrimStep ghcPrimUnwind
2265+
, mach2@Machine{mStack=[],mTerm=Literal (WordLiteral i)} <- whnf eval tcm True (setTerm arg $ stackClear mach)
2266+
-> let resTyInfo = extractTySizeInfo tcm ty tys
2267+
in Just $ mach2
2268+
{ mStack = mStack mach
2269+
, mTerm = mkBitVectorLit' resTyInfo 0 i
2270+
}
2271+
2272+
"Clash.Class.BitPack.Internal.packWord8#" -- :: Word8 -> BitVector 8
2273+
| [DC _ [Left arg]] <- args
2274+
, eval <- Evaluator ghcStep ghcUnwind ghcPrimStep ghcPrimUnwind
2275+
#if MIN_VERSION_base(4,16,0)
2276+
, mach2@Machine{mStack=[],mTerm=Literal (Word8Literal i)} <- whnf eval tcm True (setTerm arg $ stackClear mach)
2277+
#else
2278+
, mach2@Machine{mStack=[],mTerm=Literal (WordLiteral i)} <- whnf eval tcm True (setTerm arg $ stackClear mach)
2279+
#endif
2280+
-> let resTyInfo = extractTySizeInfo tcm ty tys
2281+
in Just $ mach2
2282+
{ mStack = mStack mach
2283+
, mTerm = mkBitVectorLit' resTyInfo 0 i
2284+
}
2285+
2286+
"Clash.Class.BitPack.Internal.packWord16#" -- :: Word16 -> BitVector 16
2287+
| [DC _ [Left arg]] <- args
2288+
, eval <- Evaluator ghcStep ghcUnwind ghcPrimStep ghcPrimUnwind
2289+
#if MIN_VERSION_base(4,16,0)
2290+
, mach2@Machine{mStack=[],mTerm=Literal (Word16Literal i)} <- whnf eval tcm True (setTerm arg $ stackClear mach)
2291+
#else
2292+
, mach2@Machine{mStack=[],mTerm=Literal (WordLiteral i)} <- whnf eval tcm True (setTerm arg $ stackClear mach)
2293+
#endif
2294+
-> let resTyInfo = extractTySizeInfo tcm ty tys
2295+
in Just $ mach2
2296+
{ mStack = mStack mach
2297+
, mTerm = mkBitVectorLit' resTyInfo 0 i
2298+
}
2299+
2300+
"Clash.Class.BitPack.Internal.packWord32#" -- :: Word32 -> BitVector 32
2301+
| [DC _ [Left arg]] <- args
2302+
, eval <- Evaluator ghcStep ghcUnwind ghcPrimStep ghcPrimUnwind
2303+
#if MIN_VERSION_base(4,16,0)
2304+
, mach2@Machine{mStack=[],mTerm=Literal (Word32Literal i)} <- whnf eval tcm True (setTerm arg $ stackClear mach)
2305+
#else
2306+
, mach2@Machine{mStack=[],mTerm=Literal (WordLiteral i)} <- whnf eval tcm True (setTerm arg $ stackClear mach)
2307+
#endif
2308+
-> let resTyInfo = extractTySizeInfo tcm ty tys
2309+
in Just $ mach2
2310+
{ mStack = mStack mach
2311+
, mTerm = mkBitVectorLit' resTyInfo 0 i
2312+
}
2313+
2314+
"Clash.Class.BitPack.Internal.packWord64#" -- :: Word64 -> BitVector 64
2315+
| [DC _ [Left arg]] <- args
2316+
, eval <- Evaluator ghcStep ghcUnwind ghcPrimStep ghcPrimUnwind
2317+
#if MIN_VERSION_base(4,16,0)
2318+
, mach2@Machine{mStack=[],mTerm=Literal (Word64Literal i)} <- whnf eval tcm True (setTerm arg $ stackClear mach)
2319+
#else
2320+
, mach2@Machine{mStack=[],mTerm=Literal (WordLiteral i)} <- whnf eval tcm True (setTerm arg $ stackClear mach)
2321+
#endif
2322+
-> let resTyInfo = extractTySizeInfo tcm ty tys
2323+
in Just $ mach2
2324+
{ mStack = mStack mach
2325+
, mTerm = mkBitVectorLit' resTyInfo 0 i
2326+
}
22052327

22062328
"Clash.Class.BitPack.Internal.packDouble#" -- :: Double -> BitVector 64
22072329
| [DC _ [Left arg]] <- args
@@ -2223,6 +2345,114 @@ ghcPrimStep tcm isSubj pInfo tys args mach = case primName pInfo of
22232345
, mTerm = mkBitVectorLit' resTyInfo 0 (toInteger $ (pack :: Word32 -> BitVector 32) i)
22242346
}
22252347

2348+
"Clash.Class.BitPack.Internal.packCUShort#" -- :: CUShort -> BitVector 16
2349+
| [DC _ [Left arg]] <- args
2350+
, eval <- Evaluator ghcStep ghcUnwind ghcPrimStep ghcPrimUnwind
2351+
#if MIN_VERSION_base(4,16,0)
2352+
, mach2@Machine{mStack=[],mTerm=Literal (Word16Literal i)} <- whnf eval tcm True (setTerm arg $ stackClear mach)
2353+
#else
2354+
, mach2@Machine{mStack=[],mTerm=Literal (WordLiteral i)} <- whnf eval tcm True (setTerm arg $ stackClear mach)
2355+
#endif
2356+
-> let resTyInfo = extractTySizeInfo tcm ty tys
2357+
in Just $ mach2
2358+
{ mStack = mStack mach
2359+
, mTerm = mkBitVectorLit' resTyInfo 0 i
2360+
}
2361+
2362+
"Clash.Class.BitPack.Internal.unpackInt8#" -- BitVector 8 -> Int8
2363+
| [i] <- bitVectorLiterals' args
2364+
-> let resTy = getResultTy tcm ty tys
2365+
val = toInteger (unpack (toBV i) :: Signed 8)
2366+
#if MIN_VERSION_base(4,16,0)
2367+
proj = Int8Literal
2368+
#else
2369+
proj = IntLiteral
2370+
#endif
2371+
in reduce (mkIntCLit tcm proj val resTy)
2372+
2373+
"Clash.Class.BitPack.Internal.unpackInt16#" -- BitVector 16 -> Int16
2374+
| [i] <- bitVectorLiterals' args
2375+
-> let resTy = getResultTy tcm ty tys
2376+
val = toInteger (unpack (toBV i) :: Signed 16)
2377+
#if MIN_VERSION_base(4,16,0)
2378+
proj = Int16Literal
2379+
#else
2380+
proj = IntLiteral
2381+
#endif
2382+
in reduce (mkIntCLit tcm proj val resTy)
2383+
2384+
"Clash.Class.BitPack.Internal.unpackInt32#" -- BitVector 32 -> Int32
2385+
| [i] <- bitVectorLiterals' args
2386+
-> let resTy = getResultTy tcm ty tys
2387+
val = toInteger (unpack (toBV i) :: Signed 32)
2388+
#if MIN_VERSION_base(4,16,0)
2389+
proj = Int32Literal
2390+
#else
2391+
proj = IntLiteral
2392+
#endif
2393+
in reduce (mkIntCLit tcm proj val resTy)
2394+
2395+
"Clash.Class.BitPack.Internal.unpackInt64#" -- BitVector 64 -> Int64
2396+
| [i] <- bitVectorLiterals' args
2397+
-> let resTy = getResultTy tcm ty tys
2398+
val = toInteger (unpack (toBV i) :: Signed 64)
2399+
#if MIN_VERSION_base(4,16,0)
2400+
proj = Int64Literal
2401+
#else
2402+
proj = IntLiteral
2403+
#endif
2404+
in reduce (mkIntCLit tcm proj val resTy)
2405+
2406+
"Clash.Class.BitPack.Internal.unpackWord#" -- BitVector WORD_SIZE_IN_BITS -> Word
2407+
| [i] <- bitVectorLiterals' args
2408+
-> let resTy = getResultTy tcm ty tys
2409+
val = toInteger (unpack (toBV i) :: Unsigned 64)
2410+
in reduce (mkIntCLit tcm WordLiteral val resTy)
2411+
2412+
"Clash.Class.BitPack.Internal.unpackWord8#" -- BitVector 8 -> Word8
2413+
| [i] <- bitVectorLiterals' args
2414+
-> let resTy = getResultTy tcm ty tys
2415+
val = toInteger (unpack (toBV i) :: Unsigned 8)
2416+
#if MIN_VERSION_base(4,16,0)
2417+
proj = Word8Literal
2418+
#else
2419+
proj = WordLiteral
2420+
#endif
2421+
in reduce (mkIntCLit tcm proj val resTy)
2422+
2423+
"Clash.Class.BitPack.Internal.unpackWord16#" -- BitVector 16 -> Word16
2424+
| [i] <- bitVectorLiterals' args
2425+
-> let resTy = getResultTy tcm ty tys
2426+
val = toInteger (unpack (toBV i) :: Unsigned 16)
2427+
#if MIN_VERSION_base(4,16,0)
2428+
proj = Word16Literal
2429+
#else
2430+
proj = WordLiteral
2431+
#endif
2432+
in reduce (mkIntCLit tcm proj val resTy)
2433+
2434+
"Clash.Class.BitPack.Internal.unpackWord32#" -- BitVector 32 -> Word32
2435+
| [i] <- bitVectorLiterals' args
2436+
-> let resTy = getResultTy tcm ty tys
2437+
val = toInteger (unpack (toBV i) :: Unsigned 32)
2438+
#if MIN_VERSION_base(4,16,0)
2439+
proj = Word32Literal
2440+
#else
2441+
proj = WordLiteral
2442+
#endif
2443+
in reduce (mkIntCLit tcm proj val resTy)
2444+
2445+
"Clash.Class.BitPack.Internal.unpackWord64#" -- BitVector 64 -> Word64
2446+
| [i] <- bitVectorLiterals' args
2447+
-> let resTy = getResultTy tcm ty tys
2448+
val = toInteger (unpack (toBV i) :: Unsigned 64)
2449+
#if MIN_VERSION_base(4,16,0)
2450+
proj = Word64Literal
2451+
#else
2452+
proj = WordLiteral
2453+
#endif
2454+
in reduce (mkIntCLit tcm proj val resTy)
2455+
22262456
"Clash.Class.BitPack.Internal.unpackFloat#"
22272457
| [i] <- bitVectorLiterals' args
22282458
-> let resTy = getResultTy tcm ty tys
@@ -2235,6 +2465,17 @@ ghcPrimStep tcm isSubj pInfo tys args mach = case primName pInfo of
22352465
val = unpack (toBV i :: BitVector 64)
22362466
in reduce (mkDoubleCLit tcm val resTy)
22372467

2468+
"Clash.Class.BitPack.Internal.unpackCUShort#"
2469+
| [i] <- bitVectorLiterals' args
2470+
-> let resTy = getResultTy tcm ty tys
2471+
val = toInteger (unpack (toBV i) :: Unsigned 16)
2472+
#if MIN_VERSION_base(4,16,0)
2473+
proj = Word16Literal
2474+
#else
2475+
proj = WordLiteral
2476+
#endif
2477+
in reduce (mkIntCLit tcm proj val resTy)
2478+
22382479
"Clash.Class.BitPack.Internal.xToBV"
22392480
| isSubj
22402481
, Just (nTy, kn) <- extractKnownNat tcm tys
@@ -2793,7 +3034,7 @@ ghcPrimStep tcm isSubj pInfo tys args mach = case primName pInfo of
27933034
"Clash.Sized.Internal.Index.fromEnum#"
27943035
| [i] <- indexLiterals' args
27953036
-> let resTy = getResultTy tcm ty tys
2796-
in reduce (mkIntCLit tcm i resTy)
3037+
in reduce (mkIntCLit tcm IntLiteral i resTy)
27973038

27983039
-- Bounded
27993040
"Clash.Sized.Internal.Index.maxBound#"
@@ -2910,7 +3151,7 @@ ghcPrimStep tcm isSubj pInfo tys args mach = case primName pInfo of
29103151
"Clash.Sized.Internal.Signed.fromEnum#"
29113152
| [i] <- signedLiterals' args
29123153
-> let resTy = getResultTy tcm ty tys
2913-
in reduce (mkIntCLit tcm i resTy)
3154+
in reduce (mkIntCLit tcm IntLiteral i resTy)
29143155

29153156
-- Bounded
29163157
"Clash.Sized.Internal.Signed.minBound#"
@@ -3128,7 +3369,7 @@ ghcPrimStep tcm isSubj pInfo tys args mach = case primName pInfo of
31283369
"Clash.Sized.Internal.Unsigned.fromEnum#"
31293370
| [i] <- unsignedLiterals' args
31303371
-> let resTy = getResultTy tcm ty tys
3131-
in reduce (mkIntCLit tcm i resTy)
3372+
in reduce (mkIntCLit tcm IntLiteral i resTy)
31323373

31333374
-- Bounded
31343375
"Clash.Sized.Internal.Unsigned.minBound#"
@@ -4709,9 +4950,9 @@ bitVectorLitIntLit tcm tys args
47094950
| otherwise
47104951
= Nothing
47114952

4712-
mkIntCLit :: TyConMap -> Integer -> Type -> Term
4713-
mkIntCLit tcm lit resTy =
4714-
App (Data intDc) (Literal (IntLiteral lit))
4953+
mkIntCLit :: TyConMap -> (Integer -> Literal) -> Integer -> Type -> Term
4954+
mkIntCLit tcm proj lit resTy =
4955+
App (Data intDc) (Literal (proj lit))
47154956
where
47164957
(_, tyView -> TyConApp intTcNm []) = splitFunForallTy resTy
47174958
Just intTc = UniqMap.lookup intTcNm tcm
@@ -5045,7 +5286,7 @@ liftBitVector2CInt
50455286
liftBitVector2CInt tcm resTy f args _p
50465287
| [i] <- bitVectorLiterals' args
50475288
= let val = f (toBV i)
5048-
in Just $ mkIntCLit tcm val resTy
5289+
in Just $ mkIntCLit tcm IntLiteral val resTy
50495290
| otherwise
50505291
= Nothing
50515292

0 commit comments

Comments
 (0)