B', C' and S' work for graphreduction and HHI

Author: thma

app/Main.hs

@@ -78,9 +78,8 @@ graphReductionDemo ioexpr = do
 hhiReductionDemo :: IO Expr -> IO ()
 hhiReductionDemo ioexpr = do
   expr <- ioexpr
-  --let cexpr = translate expr 
-  --putStrLn "compiled to CExpr"
-  --print cexpr
+  putStrLn "compiled to CExpr"
+  print expr
   let actual = transLink primitives expr
   putStrLn "after graph reduction:"
   print actual

src/GraphReduction.hs

@@ -141,6 +141,38 @@ reduce C (p1 : p2 : p3 : _) = do
   (_ :@: zP) <- readSTRef p3
   node1 <- newSTRef $ xP :@: zP
   writeSTRef p3 (node1 :@: yP)
+
+-- B' P Q R S = P Q (R S)
+reduce B' (p : q : r : s : _) = do
+  (_ :@: pP) <- readSTRef p
+  (_ :@: qP) <- readSTRef q
+  (_ :@: rP) <- readSTRef r
+  (_ :@: sP) <- readSTRef s
+  node1 <- newSTRef $ pP :@: qP
+  node2 <- newSTRef $ rP :@: sP
+  writeSTRef s (node1 :@: node2)
+
+-- C' P Q R S = P (Q S) R
+reduce C' (p : q : r : s : _) = do
+  (_ :@: pP) <- readSTRef p
+  (_ :@: qP) <- readSTRef q
+  (_ :@: rP) <- readSTRef r
+  (_ :@: sP) <- readSTRef s
+  node1 <- newSTRef $ qP :@: sP
+  node2 <- newSTRef $ pP :@: node1
+  writeSTRef s (node2 :@: rP) 
+
+-- S' P Q R S = P (Q S) (R S)
+reduce S' (p : q : r : s : _) = do
+  (_ :@: pP) <- readSTRef p
+  (_ :@: qP) <- readSTRef q
+  (_ :@: rP) <- readSTRef r
+  (_ :@: sP) <- readSTRef s
+  node1 <- newSTRef $ qP :@: sP
+  node2 <- newSTRef $ pP :@: node1
+  node3 <- newSTRef $ rP :@: sP
+  writeSTRef s (node2 :@: node3)  
+
 reduce Y (p1 : _) = do
   (_yP :@: fP) <- readSTRef p1
   writeSTRef p1 (fP :@: p1)

src/LambdaToSKI.hs

@@ -78,7 +78,10 @@ opt (Var "i" :@ n@(Int _n))                           = n
 opt ((Var "s" :@ (Var "k" :@ e1)) :@ (Var "k" :@ e2)) = Var "k" :@ (e1 :@ e2)
 opt ((Var "s" :@ e1) :@ (Var "k" :@ e2))              = (Var "c" :@ e1) :@ e2
 opt ((Var "s" :@ (Var "k" :@ e1)) :@ e2)              = (Var "b" :@ e1) :@ e2
-opt ((Var "s" :@ ((Var "b" :@ Var "p") :@ Var "q")) :@ Var "r") = ((Var "s1" :@ Var "p") :@ Var "q") :@ Var "r"
+opt ((Var "s" :@ ((Var "b" :@ p) :@ q)) :@ r)         = ((Var "s'" :@ p) :@ q) :@ r  -- Diller, p.98
+opt ((Var "b" :@ (p :@ q) :@ r))                      = ((Var "b'" :@ p) :@ q) :@ r
+opt ((Var "c" :@ ((Var "b" :@ p) :@ q)) :@ r)         = ((Var "c'" :@ p) :@ q) :@ r
+
 opt (x :@ y)                                          = opt x :@ opt y
 opt x                                                 = x