adding testcases for the logarithmic resolution of BulkCombinators

thma · Sep 17, 2023 · 4cef0e1 · 4cef0e1
1 parent b517546
commit 4cef0e1
Show file tree

Hide file tree

Showing 2 changed files with 34 additions and 11 deletions.
diff --git a/src/HhiReducer.hs b/src/HhiReducer.hs
@@ -41,6 +41,13 @@ link definitions (CComb comb)   = case lookup comb definitions of
   Just e  -> e
 link _definitions expr          = expr
 
+linkLog :: CombinatorDefinitions -> CExpr -> CExpr
+linkLog definitions (CApp fun arg) = link definitions fun ! link definitions arg
+linkLog definitions (CComb comb)   = case lookup comb definitions of
+  Nothing -> resolveBulk comb
+  Just e  -> e
+linkLog _definitions expr          = expr
+
 -- | translate and link in one go
 transLink :: CombinatorDefinitions -> CL -> CExpr
 transLink definitions (fun :@ arg)  = transLink definitions fun ! transLink definitions arg
@@ -92,7 +99,7 @@ resolveBulkLog (BulkCom c n) = breakBulkLog (fromString c) n
     breakBulkLog c n = foldr ((!) . (bs!!)) (prime c) (init $ bits n) ! comI where
       bs = [sbi, comB ! (comB ! prime c) ! sbi]
       prime c = comB ! (comB ! com c) ! comB
-      
+
     com :: Combinator -> CExpr
     com c = fromJust $ lookup c primitives
     sbi :: CExpr

diff --git a/test/ReducerKiselyovSpec.hs b/test/ReducerKiselyovSpec.hs
@@ -26,28 +26,44 @@ spec =
       verify ackermann compileEta
     it "computes tak Opt Eta" $
       verify tak compileEta
-    it "computes factorial BulkOpt" $
+
+    it "computes factorial BulkOpt Linear" $
       verify factorial compileBulk
-    it "computes fibonacci BulkOpt" $
+    it "computes fibonacci BulkOpt Linear" $
       verify fibonacci compileBulk
-    it "computes gaussian sum BulkOpt" $
+    it "computes gaussian sum BulkOpt Linear" $
       verify gaussian compileBulk
-    it "computes ackermann function BulkOpt"  $
+    it "computes ackermann function BulkOpt Linear"  $
       verify ackermann compileBulk
-    it "computes tak BulkOpt" $
+    it "computes tak BulkOpt Linear" $
       verify tak compileBulk
 
+    it "computes factorial BulkOpt Log" $
+      verifyLog factorial compileBulk
+    it "computes fibonacci BulkOpt Log" $
+      verifyLog fibonacci compileBulk
+    it "computes gaussian sum BulkOpt Log" $
+      verifyLog gaussian compileBulk
+    it "computes ackermann function BulkOpt Log"  $
+      verifyLog ackermann compileBulk
+    it "computes tak BulkOpt Log" $
+      verifyLog tak compileBulk      
+
 verify :: SourceCode -> (Environment -> CL) -> IO ()
 verify src compileFun = do
-  src `shouldSatisfy` runTest compileFun
+  src `shouldSatisfy` runTest compileFun (link, transLink)
+
+verifyLog :: SourceCode -> (Environment -> CL) -> IO ()
+verifyLog src compileFun = do
+  src `shouldSatisfy` runTest compileFun (linkLog, transLinkLog)
 
-runTest :: (Environment -> CL) -> SourceCode -> Bool
-runTest compileFun src =
+runTest :: (Environment -> CL) -> (CombinatorDefinitions -> CExpr -> CExpr,     CombinatorDefinitions -> CL -> CExpr) -> [Char] -> Bool
+runTest compileFun (linkFun, transLinkFun) src =
   let pEnv = parseEnvironment src
       aExp = compileFun pEnv
       tExp = translate aExp
       expected = translate $ toCL $ fromJust (lookup "expected" pEnv)
-      actual = link primitives tExp
-      actual' = transLink primitives aExp
+      actual = linkFun primitives tExp
+      actual' = transLinkFun primitives aExp
   in    show expected == show actual 
      && show expected == show actual'