Refactor fp_prologue

As suggested by Alex Richardson
CTSRD-CHERI · Aug 15, 2023 · 0873b58 · 0873b58
1 parent ff9ef87
commit 0873b58
Show file tree

Hide file tree

Showing 5 changed files with 15 additions and 25 deletions.
diff --git a/src/QuickCheckVEngine/Templates/GenAll.hs b/src/QuickCheckVEngine/Templates/GenAll.hs
@@ -93,6 +93,4 @@ genAll = readParams $ \params -> random $ do
                ] | has_icsr desc]
            ++ [[ (8, instUniform (rv32_xcheri desc src1 src2 srcScr imm mop dest))
                ] | has_cheri desc]
-  return $ shrinkScope $ (if has_f desc || has_d desc then noShrink fp_prologue
-                                                      else mempty)
-                         <> repeatTillEnd (dist $ concat insts)
+  return $ fp_prologue $ repeatTillEnd (dist $ concat insts)
diff --git a/src/QuickCheckVEngine/Templates/GenCHERI.hs b/src/QuickCheckVEngine/Templates/GenCHERI.hs
@@ -162,8 +162,4 @@ gen_simple_fpclear = random $ do
                 ]
 
 randomCHERITest :: Template
-randomCHERITest = readParams $ \param ->
-                    let temp = repeatTillEnd $ genRandomCHERITest
-                        arch = archDesc param
-                    in if has_f arch || has_d arch then noShrink fp_prologue <> temp
-                                                   else temp
+randomCHERITest = fp_prologue $ repeatTillEnd genRandomCHERITest
diff --git a/src/QuickCheckVEngine/Templates/GenFP.hs b/src/QuickCheckVEngine/Templates/GenFP.hs
@@ -78,6 +78,4 @@ genFP has_f has_d has_xlen_64 = random $ do
               ++ [ rv64_f src1 dest rm | has_f && has_xlen_64 ]
               ++ [ rv64_d src1 dest rm | has_d && has_xlen_64 ]
   let epilogue = csrr dest (unsafe_csrs_indexFromName "fcsr")
-  return $ shrinkScope $    noShrink fp_prologue
-                         <> repeatTillEnd (instUniform $ concat insts)
-                         <> noShrink epilogue
+  return $ fp_prologue (repeatTillEnd (instUniform $ concat insts) <> noShrink epilogue)
diff --git a/src/QuickCheckVEngine/Templates/RandomTest.hs b/src/QuickCheckVEngine/Templates/RandomTest.hs
@@ -43,11 +43,8 @@ import QuickCheckVEngine.Templates.Utils
 
 -- | 'randomTest' provides a 'Template' for a random test
 randomTest :: Template
-randomTest = wrap go
-  where wrap t = readParams $ \param -> if has_f (archDesc param) || has_d (archDesc param)
-                                        then shrinkScope $ noShrink fp_prologue <> t
-                                        else t
-        go = random $ do
+randomTest = fp_prologue go
+  where go = random $ do
           remaining <- getSize
           srcAddr   <- src
           srcData   <- src

diff --git a/src/QuickCheckVEngine/Templates/Utils/FP.hs b/src/QuickCheckVEngine/Templates/Utils/FP.hs
@@ -41,12 +41,13 @@ import RISCV
 import QuickCheckVEngine.Template
 import QuickCheckVEngine.Templates.Utils.General
 
-fp_prologue :: Template
-fp_prologue = mconcat [ inst $ lui 1 2
-                      , csrs (unsafe_csrs_indexFromName "mstatus") 1
-                      , csrs (unsafe_csrs_indexFromName "fcsr") 0
-                      , readParams $ \p -> if has_f (archDesc p) || has_d (archDesc p)
-                                           then mconcat $ [inst $ fmv_w_x i 0 | i <- [0..4]]
-                                                       ++ [inst $ (if has_d (archDesc p) then fmv_d_x else fmv_w_x) i 0 | i <- [16..20]]
-                                           else mempty
-                      ]
+fp_prologue :: Template -> Template
+fp_prologue t = readParams $ \p ->
+    if has_f (archDesc p) || has_d (archDesc p)
+    then shrinkScope ((noShrink . mconcat) [ inst $ lui 1 2
+                                           , csrs (unsafe_csrs_indexFromName "mstatus") 1
+                                           , csrs (unsafe_csrs_indexFromName "fcsr") 0
+                                           , mconcat $ [inst $ fmv_w_x i 0 | i <- [0..4]]
+                                                    ++ [inst $ (if has_d (archDesc p) then fmv_d_x else fmv_w_x) i 0 | i <- [16..20]]
+                                           ] <> t)
+    else t