Clash gets stuck on this design

[pieter-bos]

The below self-contained example makes clash not terminate:

Unfold for original example

{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Top where

import Clash.Prelude
import Clash.Annotations.TH

class KnownNat (UsbSize a) => UsbSerialize a where
  type UsbSize a :: Nat
  usbDeserialize :: BitVector (UsbSize a) -> a

newtype Packed a = Packed { unPacked :: a }

instance BitPack a => UsbSerialize (Packed a) where
  type UsbSize (Packed a) = BitSize a
  usbDeserialize = Packed . unpack

data PID
  = Out
  | In
  deriving (Generic, NFDataX, BitPack)

instance UsbSerialize PID where
  type UsbSize PID = UsbSize (Packed PID)
  usbDeserialize = unPacked . usbDeserialize

baseCrc ::
  HiddenClockResetEnable dom =>
  Signal dom (Maybe Bit) ->
  Signal dom (Maybe Bit)
baseCrc = mealy (\() _ -> deepErrorX "Q") ()

bufferFirst ::
  HiddenClockResetEnable dom =>
  Signal dom (Maybe Bit) ->
  Signal dom (Maybe PID)
bufferFirst =
  mealy step 0
 where
  step buf (Just 0) = (0, Just $ usbDeserialize buf)
  step buf _ = (buf, Just (usbDeserialize (buf .<<+ 0)))

holdPID ::
  (KnownDomain dom, HiddenClockResetEnable dom) =>
  Signal dom (Maybe Bit) ->
  Signal dom (Maybe PID)
holdPID inp =
  bufferFirst $ baseCrc $ mealy (\() _ -> deepErrorX "QQ") () inp

usb ::
  forall dom .
  (KnownDomain dom, HiddenClockResetEnable dom) =>
  Signal dom Bool
usb = goodPid <$> holdPID (deepErrorX "QQ")
 where
  goodPid (Just In) = True
  goodPid _ = False

{-# OPAQUE usb #-}

topEntity ::
  "CLK" ::: Clock System ->
  "BTN" ::: Reset System ->
  "o" ::: Signal System Bool
topEntity clk rst =
  withClockResetEnable clk rst enableGen $ usb

$(makeTopEntity 'topEntity)

[kleinreact]

A bit smaller reproducer:

{-# LANGUAGE UndecidableInstances #-}
module Top where

import Clash.Prelude

class KnownNat (UsbSize a) => UsbSerialize a where
  type UsbSize a :: Nat
  usbDeserialize :: BitVector (UsbSize a) -> a

newtype Packed a = Packed { unPacked :: a }

instance BitPack a => UsbSerialize (Packed a) where
  type UsbSize (Packed a) = BitSize a
  usbDeserialize = Packed . unpack

instance UsbSerialize Bit where
  type UsbSize Bit = UsbSize (Packed Bit)
  usbDeserialize = unPacked . usbDeserialize

topEntity :: HiddenClockResetEnable System => Signal System Bit
topEntity = mealy step 0 $ pure ()
 where
  step x _ = (x, usbDeserialize (x .<<+ 0))
--  {-# INLINE step #-}

Note that the commented INLINE at the end already suffices to fix the issue, which may be useful to figure out its origin.

[christiaanb]

Change

newtype Packed a = Packed { unPacked :: a }

to

data Packed a = Packed { unPacked :: a }

This is a known bug in the Clash compiler: type families over newtypes break Clash. There's an attempt at a fix here #1064 but it needs to be rewritten and gotten into a working state.

[pieter-bos]

For posterity: the motivation for this approach is to be able to use DerivingVia, so I can do something like:

data PID = In | Out | Setup
  deriving (Generic, BitPack)
  deriving UsbSerialize via (Packed PID)

Since DerivingVia instists that here PID must be Coercible to Packed PID, it must be a newtype for this approach to work.