--
-- CBV interpreter with non-determinism and multiple results.
--
module InterpND where

data Term = Var String 
          | Con Int
          | Add Term Term
          | Lam String Term
          | App Term Term
          | Amb Term Term
  deriving Show

data Value = Wrong
             | Num Int
             | Fun (Value -> M Value)

instance Show Value where
    show Wrong = "<wrong>"
    show (Num  n) = show n
    show (Fun _) = "<function>"


unit v = [v]
bad s = [Wrong]
bind x f = concat $ map f x

both x y = x ++ y


type M a = [a]

type Env = [(String, Value)]

getVar :: Env -> String -> M Value
getVar ((x,v):xs) y = if x == y then unit v else getVar xs y
getVar [] y = bad $ "unbound variable "++y

add :: Value -> Value -> M Value
add (Num m) (Num n) = unit $ Num $ m + n
add m n = bad $ "expected numbers, found "++(show m)++" and "++(show n)

apply :: Value -> Value -> M Value
apply (Fun v1) v2 = v1 v2
apply f _ = bad $ "expected function, found "++(show f)

interp :: Term -> Env -> M Value
interp (Var x) env = getVar env x
interp (Con n) _ = unit $ Num n
interp (Add e1 e2) env = 
    bind (interp e1 env) $ \v1 ->
    bind (interp e2 env) $ \v2 ->
    add v1 v2
interp (Lam x e) env = unit $ Fun $ \v -> interp e ((x,v):env)
interp (App e1 e2) env = 
    bind (interp e1 env) $ \v1 ->
    bind (interp e2 env) $ \v2 ->
    apply v1 v2
interp (Amb e1 e2) env = both (interp e1 env) (interp e2 env)

test e = interp e []

i = Lam "x" $ Var "x"
k = Lam "x" $ Lam "y" $ Var "x"
s = Lam "f" $ Lam "g" $ Lam "x" $ App (App (Var "f") (Var "x")) (App (Var "g") (Var "x"))
omega = App (Lam "x" $ App (Var "x") (Var "x")) (Lam "x" $ App (Var "x") (Var "x"))