data FuncName = Lambda
              | Named String
              deriving (Show, Eq)

data OP = OPGT
        | OPLT
        | OPEQ
        deriving (Show,Eq)

type VarName = String

type EnvEntry = (VarName, MULang)
type MUEnv = [EnvEntry]

data MULang = MUVar VarName
            | MUInt Int
            | MUAdd MULang MULang
            | MUFun FuncName String MULang
            | MUIf OP MULang MULang MULang MULang
            | MUCall MULang MULang
            | MUPair MULang MULang
            | MUFst  MULang
            | MUSnd  MULang
            | MULet  VarName MULang MULang
            | MUUnit
            | MUIsUnit MULang
            | MUClosure MUEnv MULang
            deriving (Show,Eq)
            
-- extra "syntax" that can be compiled to a proper MULang in a single pass
data MULangE = MUMLet MUEnv MULang
             | MUIfUnit MULang MULang MULang
             deriving (Show, Eq) 

eval :: MUEnv -> MULang -> MULang
eval env x@(MUUnit)         = x
eval env x@(MUInt _)        = x
eval env x@(MUClosure _ _)  = x
eval env   (MUAdd x y)      = MUInt (x' + y')
            where
                (MUInt x') = (eval env x)
                (MUInt y') = (eval env y)
             
eval env   (MUVar var)      = x
            where p (Just y) = y 
                  p        _ = MUUnit
                  x = p $ lookup var env
            
eval env   (MUPair e1 e2)   = MUPair (eval env e1) (eval env e2)
eval env   (MUFst expr)     = x
            where (MUPair x _) = eval env expr
eval env   (MUSnd expr)     = x
            where (MUPair _ x) = eval env expr
            
eval env   (MUIsUnit x)     = condt $ eval env x
            where condt (MUUnit) = MUInt 1
                  condt       _  = MUInt 0
eval env   (MULet var el e1) = eval newenv e1
            where newenv = (var, eval env el):env

eval env x@(MUFun fname str expr) = (MUClosure env x)

eval env   (MUCall e1 e2) = eval newenv fun 
            where
                   closure = eval env e1
                   (MUClosure cenv (MUFun fname param fun)) = closure
                   fparam = eval env e2
                   newenv = function fname ++ [(param, fparam)] ++ cenv
                   function Lambda    = []
                   function (Named x) = [(x, closure)]
                   
eval env   (MUIf op x y e1 e2)
                | x' `opy` y'   = eval env e1
                | otherwise = eval env e2 
            where
                (MUInt x') = (eval env x)
                (MUInt y') = (eval env y)
                opy = iny op
                iny (OPGT) = (>)
                iny (OPLT) = (<)
                iny (OPEQ) = (==)
                        

preproc (MUMLet ((v, e):xs) f) = MULet v e (preproc $ MUMLet xs f)
preproc (MUMLet []          f) = f 
preproc (MUIfUnit e e1 e2)     = MUIf (OPEQ) (MUIsUnit e) (MUInt 1) e1 e2 

v = preproc $ MUMLet [
            ("double", (MUFun (Lambda) "n"
                            (MUAdd (MUVar "n")
                                   (MUVar "n")
                            )))
           ,("sumlist", (MUFun (Named "sm") "ls"
                            (preproc $ MUIfUnit (MUVar "ls")
                                            (MUInt 0)
                                            (MUAdd
                                                (MUFst (MUVar "ls"))
                                                (MUCall (MUVar "sm")
                                                        (MUSnd (MUVar "ls")))))))
           ]
           (MUCall (MUVar "sumlist")
            (toMUPLList [1..4]))
            
toMUPLList :: [Int] -> MULang
toMUPLList = (foldr MUPair MUUnit).(map MUInt)
toHSList :: MULang -> [Int]
toHSList (MUPair (MUInt x) y) = x:(toHSList y)
toHSList (MUUnit)             = []

main = putStrLn $ show (eval [] v)