[Haskell-cafe] Re: Re: implementing recursive let
Ben Franksen
ben.franksen at online.de
Fri Nov 27 14:22:06 EST 2009
Ben Franksen wrote:
> Ok, it seems I have a version that does what I want. It is not very
> elegant, I have to manually wrap/unwrap the ErrorT stuff just for the Val
> case, but at least it seems to work. Here it goes:
>
>> eval (Var x) = Eval $ ErrorT $ do
>> env <- get
>> v <- case M.lookup x env of
>> Just v -> return v
>> Nothing -> do
>> warning ("reference to undefined variable " ++ show x)
>> let v = Data ""
>> modify (M.insert x v)
>> return v
>> return (Right v)
>>
>> warning s = tell $ ["Warning: " ++ s]
While this works for simple var=constant declarations, it breaks down again
as soon as I add lambdas and application. Same symptoms as before: eval
loops; and it works again if I remove the ErrorT (but then I get a pattern
match failure if I apply a non-function which is of course what I wanted to
avoid with the ErrorT).
This is maddening! There must be some way to get mutual recursion to work
while still allowing for clean handling of failure. What galls me the most
is that it is so unpredictable whether the program will terminate with a
given input or not.
(The code is attached.)
Cheers
Ben
-------------- next part --------------
{-# LANGUAGE RecursiveDo, GeneralizedNewtypeDeriving,
TypeSynonymInstances, MultiParamTypeClasses #-}
import Control.Monad
import Control.Monad.State
import Control.Monad.Error
import Control.Monad.Writer
import Control.Monad.Reader
import Control.Monad.Fix
import qualified Data.Map as M
data Expr = Let [(String, Expr)] Expr | Const Int | Var String
| Lam String Expr | App Expr Expr
data Value = Data String | Function (Value -> Eval Value)
instance Show Value where
show (Data s) = s
type Env = M.Map String Value
eval :: Expr -> Eval Value
eval (Const n) = return (Data (show n))
eval (Var x) = Eval $ noError $ do
env <- get
case M.lookup x env of
Just v -> return v
Nothing -> do
warning ("reference to undefined variable " ++ show x)
let v = Data ""
modify (M.insert x v)
return v
eval (Let decls body) = mdo
let (names,exprs) = unzip decls
updateEnv env = foldr (uncurry M.insert) env $ zip names values
(values,result) <- local updateEnv $ liftM2 (,) (mapM eval exprs) (eval body)
return result
eval (Lam parm body) = do
env <- ask
return $ Function (\val -> local (\_ -> M.insert parm val env) (eval body))
eval (App fun arg) = do
f <- eval fun
x <- eval arg -- call-by-value, so evaluate the arg first
case f of
Function f -> f x
warning s = tell $ ["Warning: " ++ s]
newtype Eval a = Eval {
unEval :: ErrorT String (StateT Env (Writer [String])) a
} deriving (
Monad, MonadFix, MonadWriter [String],
MonadState Env, MonadError String
)
runEval :: Eval Value -> Either String Value
runEval = fst . runWriter . flip evalStateT M.empty . runErrorT . unEval
evaluate = runEval . eval
instance MonadReader Env Eval where
ask = get
local tr act = do
s <- get
modify tr
r <- act
put s
return r
noError :: (Monad m, Error e) => ErrorT e m a -> ErrorT e m a
noError m = ErrorT $ do
~(Right r) <- runErrorT m
return (Right r)
-- examples
good1 = Let [("x", Const 1)] (Var "x")
good2 = Let [("y", Var "x"),("x", Const 1)] (Var "y")
bad1 = Let [("x", Const 1)] (Var "y")
letf = Let [("f",Lam "x" (Var "x"))] (App (Var "f") (Const 1))
badapp = Let [("f",Lam "x" (Var "x"))] (App (Const 1) (Var "f"))
More information about the Haskell-Cafe
mailing list