-- | Description: Applicative order evaluation Krivine machine.
module Rossum.Krivine.Eager where

import           Data.Maybe

import           Rossum.Krivine.Term

data Sided a = L | V a | R
  deriving (Show)

type Configuration = (Env, Maybe Term, Stack (Sided Closure))

-- | Step an applicative order Krivine machine.
--
-- Implements rules from Hankin (2004), pp 125-127.
step :: Configuration -> Maybe Configuration
step c = case c of
  (p, Just (App m n), s)         -> Just (p, Just m, L : (V (Closure n p)) : s)
  (p, Just (Abs m), s)           -> Just ([], Nothing, (V (Closure (Abs m) p)) : s)
  (u:p, Just (Var n), s) | n > 1 -> Just (p, Just (Var (n - 1)), s)
  (u:p, Just (Var 1), s)         -> Just ([], Nothing, (V u) : s)
  ([], Nothing, (V u):L:(V (Closure n p)):s) -> Just (p, Just n, R : V u : s)
  ([], Nothing, (V u):R:(V (Closure (Abs m) p)):s) -> Just (u:p, Just m, s)
  _ -> Nothing

run :: Configuration -> [Configuration]
run c = map fromJust . takeWhile isJust $ iterate (>>= step) (Just c)

-- | Execute a compiled 'Term' in applicative order.
execute :: Term -> Either [String] [String]
execute kt =
  let cfg = ([], Just kt, [])
      cfg' = last (run cfg)
  in Right [ "K Term: " ++ format kt
           , "Result: " ++ show cfg'
           ]
