PTQ-0.0.4: src/MP.hs

-----------------------------------------------------------------------------
-- |
-- Module      :  MP
-- Copyright   :  (c) Masahiro Sakai 2007-2009
-- License     :  BSD3-style (see LICENSE)
-- 
-- Maintainer:    masahiro.sakai@gmail.com
-- Stability   :  experimental
-- Portability :  portable

module MP
    ( applyMP
    )
    where
import Expr

applyMP :: Expr -> Expr
-- MP1
-- MP4
applyMP (Const tv) | tv `elem` ["find","lose","eat","love"] =
    lambda "p" $ lambda "x" $
    FVar "p" <@> (int $ lambda "y" $ Const tv :@ int (lambda "P" $ FVar "P" <@> FVar "y") :@ FVar "x")
-- MP8
applyMP (Const "in") =
    lambda "p" $ lambda "P" $ lambda "x" $
    FVar "p" <@> (int $ lambda "y" $ Const "in" :@ int (lambda "z" $ FVar "z" <@> FVar "y") :@ FVar "P" :@ FVar "x")
-- MP9
applyMP (Const "seek") = lambda "P" $ Const "try" :@ int (find' :@ FVar "P")
    where find' = applyMP (Const "find")
applyMP (Bind q (Sc body)) = Bind q (Sc (applyMP body))
applyMP (fun :@ arg) = applyMP fun :@ applyMP arg
applyMP (Op1 op a)   = Op1 op (applyMP a)
applyMP (Op2 op a b) = Op2 op (applyMP a) (applyMP b)
applyMP x = x