SKI.hs

module SKI ( SKI( S, K, I, App ), reduceSKI ) where

data SKI = S | K | I | App SKI SKI deriving Eq

instance Show SKI where
  show = go False
    where go _ S = "S"
          go _ K = "K"
          go _ I = "I"
          go p (App t u) = parens p $ go False t ++ go True u
          
          parens p s = if p then "(" ++ s ++ ")" else s

reduceSKI :: SKI -> SKI
reduceSKI = reduceNormal

data Frame = AppL SKI | AppR SKI
type Kont = [Frame]

reduceNormal :: SKI -> SKI
reduceNormal t = seek t []

seek :: SKI -> Kont -> SKI
seek S (AppL f : AppL g : AppL x : k) = seek f (AppL x : AppL (App g x) : k)
seek K (AppL x : AppL y : k) = seek x k
seek I (AppL x : k) = seek x k
seek (App t u) k = seek t (AppL u : k)
seek t k = destroy t k

destroy :: SKI -> Kont -> SKI
destroy t [] = t
destroy t (AppL u : k) = seek u (AppR t : k)
destroy t (AppR u : k) = destroy (App u t) k

reduceCBN :: SKI -> SKI
reduceCBN S = S
reduceCBN K = K
reduceCBN I = I
reduceCBN (App t u) = reduceApp (reduceCBN t) u
  where reduceApp I x = reduceCBN x
        reduceApp (App K x) y = reduceCBN x
        reduceApp (App (App S f) g) x = reduceCBN (App (App f x) (App g x))
        reduceApp t u = App t u