Project fields in DSL.deconstructProduct

Fixes #2469

Co-authored-by: Felix Klein <felix@qbaylogic.com>
Co-authored-by: Hidde Moll <hidde@qbaylogic.com>

changelog/2023-05-17T13_25_42+02_00_fix_2469

@@ -0,0 +1 @@
+FIXED: `Clash.Primitives.DSL.deconstructProduct` now projects fields out of a product [#2469](https://github.com/clash-lang/clash-compiler/issues/2469)

clash-lib/src/Clash/Primitives/DSL.hs

@@ -1,8 +1,8 @@
 {-|
-  Copyright   :  (C) 2019, Myrtle Software Ltd.
+  Copyright   :  (C) 2019,      Myrtle Software Ltd.
                      2020-2023, QBayLogic B.V.
-                     2021, Myrtle.ai
-                     2022, Google Inc
+                     2021,      Myrtle.ai
+                     2022-2023, Google Inc
   License     :  BSD2 (see the file LICENSE)
   Maintainer  :  QBayLogic B.V. <devops@qbaylogic.com>
 
@@ -361,10 +361,15 @@ deconstructProduct
   -> [Text]
   -- ^ Name hints for element assignments
   -> State (BlockState backend) [TExpr]
-deconstructProduct (TExpr ty@(Product _ _ tys) (Identifier resName _)) vals = do
-  newNames <- zipWithM declare vals tys
-  addDeclaration $ Assignment resName Cont $ DataCon ty (DC (ty, 0)) (fmap eex newNames)
-  pure newNames
+deconstructProduct (TExpr ty@(Product _ _ fieldTys) (Identifier resName Nothing)) nameHints =
+  forM (zip3 [0..] nameHints fieldTys) $ \(fieldIndex, nameHint, fieldTy) ->
+    assign nameHint $
+      TExpr fieldTy (Identifier resName (Just (Indexed (ty, 0, fieldIndex))))
+
+deconstructProduct t0@(TExpr (Product {}) _) nameHints = do
+  t1 <- toIdentifier "product" t0
+  deconstructProduct t1 nameHints
+
 deconstructProduct e i =
   error $ "deconstructProduct: " <> show e <> " " <> show i