on the way to B', C' and S'

Author: thma

app/Main.hs

@@ -27,7 +27,7 @@ main = do
   hSetEncoding stdout utf8 -- this is required to handle UTF-8 characters like λ
 
   -- testSource <-readFile "test/tak.ths"
-  let testSource = "main = (\\x y -> x) 3 4"
+  let testSource = "main = (\\x y -> + x x) 3 4"
   putStrLn "The sourcecode: "
   putStrLn testSource
 
@@ -36,7 +36,7 @@ main = do
   mapM_ print env
   putStrLn ""
 
-  let expr = compile env babs0 --abstractSimple --abstractToSKI
+  let expr = compile env abstractToSKI
   putStrLn "The main expression compiled to SICKYB combinator expressions:"
   print expr
   putStrLn ""

src/HhiReducer.hs

@@ -48,14 +48,17 @@ transLink _globals (Int k)      = CInt k
 transLink globals (Var c)       = fromJust $ lookup (fromString c) globals
 transLink _globals l@(Lam _ _)  = error $ "lambdas should be abstracted already " ++ show l
 
-
+-- | the set of primary operations: combinators + basic arithmetic functions
 primitives :: GlobalEnv
 primitives = let (-->) = (,) in
   [ I      --> CFun id
   , K      --> CFun (CFun . const)
   , S      --> CFun (\f -> CFun $ \g -> CFun $ \x -> f!x!(g!x))
   , B      --> CFun (\f -> CFun $ \g -> CFun $ \x -> f!(g!x))
   , C      --> CFun (\f -> CFun $ \g -> CFun $ \x -> f!x!g)
+  , B'     --> CFun (\p -> CFun $ \q -> CFun $ \r -> CFun $ \s -> p!q!(r!s))      -- B' P Q R S = P Q (R S)
+  , C'     --> CFun (\p -> CFun $ \q -> CFun $ \r -> CFun $ \s -> p!(q!s)!r)      -- C' P Q R S = P (Q S) R
+  , S'     --> CFun (\p -> CFun $ \q -> CFun $ \r -> CFun $ \s -> p!(q!s)!(r!s))  -- S' P Q R S = P (Q S) (R S)
   , IF     --> CFun (\(CInt cond) -> CFun $ \thenExp -> CFun $ \elseExp -> if cond == 1 then thenExp else elseExp)
   , Y      --> CFun (\(CFun f) -> fix f)
   , ADD    --> arith (+)

src/LambdaToSKI.hs

@@ -17,6 +17,7 @@ import           Parser    (Environment, Expr (..))
 
 type Error = String
 
+-- improved bracket abstraction according to https://tromp.github.io/cl/LC.pdf (section 3.2)
 babs :: Environment -> Expr -> Expr
 babs env (Lam x e)
   | Var "i" :@ _x <- t = t
@@ -77,6 +78,7 @@ 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 (x :@ y)                                          = opt x :@ opt y
 opt x                                                 = x
 
@@ -124,7 +126,7 @@ cccAbs env (Var s)
 cccAbs env (m :@ n) = cccAbs env m :@ cccAbs env n
 cccAbs _env x = x
 
-data Combinator = I | K | S | B | C | Y | P | ADD | SUB | MUL | DIV | REM | SUB1 | EQL | GEQ | ZEROP | IF
+data Combinator = I | K | S | B | C | Y | P | ADD | SUB | MUL | DIV | REM | SUB1 | EQL | GEQ | ZEROP | IF | B' | C' | S'
   deriving (Eq, Show)
 
 fromString :: String -> Combinator
@@ -133,6 +135,9 @@ fromString "k"    = K
 fromString "s"    = S
 fromString "b"    = B
 fromString "c"    = C
+fromString "s'"   = S'
+fromString "b'"   = B'
+fromString "c'"   = C'
 fromString "y"    = Y
 fromString "p"    = P
 fromString "+"    = ADD