identify bug in babs

Author: thma

app/Main.hs

@@ -60,7 +60,7 @@ loadTestCase name = do
   putStrLn "The source: "
   putStrLn src
   let pEnv = parseEnvironment src
-      expr = compile pEnv abstractSimple
+      expr = compile pEnv abstractToSKI
   return expr
 
 graphReductionDemo :: IO Expr -> IO ()

benchmark/ReductionBenchmarks.hs

@@ -2,7 +2,7 @@ module ReductionBenchmarks where
 
 import Criterion.Main ( defaultMain, bench, nf )
 import Parser ( parseEnvironment, Expr(Int) )
-import LambdaToSKI ( abstractSimple, compile )
+import LambdaToSKI ( abstractToSKI, compile )
 import GraphReduction ( allocate, normalForm, toString, Graph )
 import Data.Maybe (fromJust)
 import Data.STRef ( STRef )
@@ -16,7 +16,7 @@ loadTestCase :: String -> IO Expr
 loadTestCase name = do
   src <- readFile $ "test/" ++ name ++ ".ths"
   let pEnv = parseEnvironment src
-      expr = compile pEnv abstractSimple
+      expr = compile pEnv abstractToSKI
   return expr
 
 getInt :: Expr -> Integer

src/LambdaToSKI.hs

@@ -17,7 +17,6 @@ import           Parser    (Environment, Expr (..))
 
 type Error = String
 
--- @TODO There must be a subtle bug in here. (tak 12 6 3) won't work with this abstraction
 babs :: Environment -> Expr -> Expr
 babs env (Lam x e)
   | Var "i" :@ _x <- t = t
@@ -27,7 +26,7 @@ babs env (Lam x e)
   | m :@ Var y <- t, x == y, x `notElem` fv [] m = m
   | Var y :@ m :@ Var z <- t, x == y, x == z = babs env $ Lam x $ Var "s" :@ Var "s" :@ Var "k" :@ Var x :@ m
   | m :@ (n :@ l) <- t, isComb m, isComb n = babs env $ Lam x $ Var "s" :@ Lam x m :@ n :@ l
-  | (m :@ n) :@ l <- t, isComb m, isComb l = babs env $ Lam x $ Var "s" :@ m :@ Lam x l :@ n
+--  | (m :@ n) :@ l <- t, isComb m, isComb l = babs env $ Lam x $ Var "s" :@ m :@ Lam x l :@ n -- this line is buggy (endless loop for tak)
   | (m :@ l) :@ (n :@ l') <- t,
     l `noLamEq` l',
     isComb m,

test/GraphReductionSpec.hs

@@ -46,7 +46,7 @@ getInt _ = error "not an int"
 runTest :: SourceCode -> (String, String)
 runTest src =
   let pEnv = parseEnvironment src
-      expr = compile pEnv abstractSimple
+      expr = compile pEnv abstractToSKI
       graph = allocate expr
       expected = show $ getInt $ fromJust (lookup "expected" pEnv)
       result = reduceGraph graph

test/ReducerSpec.hs

@@ -40,7 +40,7 @@ loadTestCase name = readFile $ "test/" ++ name ++ ".ths"
 runTest :: SourceCode -> Bool
 runTest src =
   let pEnv = parseEnvironment src
-      aExp = compile pEnv abstractSimple
+      aExp = compile pEnv abstractToSKI
       tExp = translate aExp
       expected = translate $ fromJust (lookup "expected" pEnv)
       actual = link primitives tExp