Fexpr interpreter in haskell

vau.hs

data S = Sym String | Nil | Tr | Fl | Cons S S deriving (Eq, Show)

data T = Var String |
  Combine T T T |
  Lam String T |
  Eps String T |
  Eval T T     |
  Wrap T       |
  Env [(String, T)] |
  Sexp S  deriving (Eq, Show)

data Result t = Ok t | Done | Fail deriving (Show)

find :: String -> T -> Maybe T
find s (Env e) = lookup s e

step :: T -> Result T
step t =
  case t of
    Combine (Lam s b) a e -> Ok $ subst b s a
    Combine (Eps s b) a e -> Ok $ Combine (subst b s e) a e
    Combine (Wrap t) a e -> Ok $ Combine t (Eval a e) e
    Combine c@(Combine _ _ _) a e ->
      case step c of
        Done -> Fail
        Fail -> Fail
        Ok c' -> Ok $ Combine c' a e
    Lam s b -> Done
    Eps s b -> Done
    Sexp _ -> Done
    Eval d e -> case d of
      Sexp Nil     -> Ok d
      Sexp (Sym s) -> Ok d
      Sexp _       -> Ok d
      Var s -> case find s e of
        Nothing -> Fail
        Just x  -> Ok x
      Lam _ _     -> Ok d
      Eps _ _     -> Ok d
      Env _       -> Ok d
    _ -> Fail

manyStep :: T -> Either T T
manyStep t =
  case step t of
    Ok st -> manyStep st
    Done -> Right t
    -- Done -> case t of
    --           Eval t' _ -> Right t'
    --           _ -> Right t
    Fail -> Left t

accSteps :: T -> [Either T T]
accSteps t =
  case (step t) of
    Ok st -> (Right t) : accSteps st
    Done -> [Right t]
    Fail -> [Left t]


subst :: T -> String -> T -> T
subst t var val =
  case t of
    Var s    -> if s == var then val else t
    Lam s b  -> if s == var then t else Lam s (subst b var val)
    Eps s b  -> if s == var then t else Eps s (subst b var val)
    Eval b (Env e) ->
      Eval (subst b var val)
        (Env (fmap (\(n,x) -> (n, subst x var val)) e))
    Eval b e -> t
    Wrap b   -> Wrap (subst b var val)
    Env e    -> t
    Sexp as  -> t


idT :: T
idT = Lam "x" (Var "x")

res = manyStep $
  Combine (Combine idT
                   (Wrap idT)
                   (Env []))
          (Sexp (Sym "q"))
          (Env [])