Hi, Paolo Losi wrote:
I'm following an interesting thread on the scala mailing list:
http://www.nabble.com/-scala--usefulness-of-OOP-td23268250.html
Martin Odersky advocates the OO features of the scala language proposing an interesting problem where the OO approach seams valuable.
I would be very much interested in seeing an Haskell solution to that problem.
Here is my take on it, using type families. Tillmann {-# LANGUAGE TypeFamilies #-} import Data.List (elemIndex) -- COMMON INTERFACE -- -- environments and variables class Env env where data V env empty :: env a bind :: (String, a) -> env a -> env a find :: env a -> V env -> a -- too bad we have to include these here :( showVar :: Int -> V env -> ShowS showEnv :: Show a => Int -> env a -> ShowS -- GENERIC INTERPRETER -- -- terms (for some type of variables v) data T env = Lam [String] (T env) | App (T env) [T env] | Var (V env) | Lit Integer instance Env env => Show (T env) where showsPrec p t = showParen (p > 10) $ case t of Lam vs t -> ("Lam " ++) . showsPrec 11 vs . (' ' :) . showsPrec 11 t App f xs -> ("App " ++) . showsPrec 11 f . (' ' :) . showsPrec 11 xs Var v -> ("Var " ++) . showVar 11 v Lit n -> ("Lit " ++) . showsPrec 11 n -- domain of values data D env = Fun [String] (T env) (env (D env)) | Num Integer instance Env env => Show (D env) where showsPrec p t = showParen (p > 10) $ case t of Fun vs t env -> ("Fun " ++) . showsPrec 11 vs . (' ' :) . showsPrec 11 t . (' ' :) . showEnv 11 env Num n -> ("Num " ++) . showsPrec 11 n -- interpreter eval :: Env env => env (D env) -> T env -> D env eval env (Lam vs t) = Fun vs t env eval env (App f xs) = apply (eval env f) (map (eval env) xs) eval env (Var v ) = find env v eval env (Lit n ) = Num n apply :: Env env => D env -> [D env] -> D env apply (Fun vs t env) xs | length vs == length xs = eval env' t | otherwise = error ("arity mismatch: " ++ show vs ++ ", " ++ show xs) where env' = foldr bind env (zip vs xs) apply (Num n) xs = error "not a function" -- VARIABLES AS STRINGS -- data AssocList a = AssocList [(String, a)] deriving Show instance Env AssocList where data V AssocList = Name String deriving Show empty = AssocList [] bind (v, x) (AssocList env) = AssocList ((v, x) : env) find (AssocList env) (Name v) = case lookup v env of Just x -> x Nothing -> error "free variable" showVar = showsPrec showEnv = showsPrec -- VARIABLES AS De-BRUIJN INDICES -- data Stack a = Stack [a] deriving Show instance Env Stack where data V Stack = Index Int deriving Show empty = Stack [] bind (v, x) (Stack env) = Stack (x : env) find (Stack env) (Index v) = if v < length env then env !! v else error "free variable" showVar = showsPrec showEnv = showsPrec -- CONVERT NAMES TO DE-BRUIJN INDICES -- index :: [String] -> T AssocList -> T Stack index vs (Lam ws t ) = Lam ws (index (ws ++ vs) t) index vs (App f xs ) = App (index vs f) (map (index vs) xs) index vs (Var (Name v)) = case elemIndex v vs of Just n -> Var (Index n) Nothing -> error "free variable" index vs (Lit n ) = Lit n -- TEST -- identity = Lam ["x"] (Var (Name "x")) two = Lam ["f", "x"] (App (Var (Name "f")) [(App (Var (Name "f")) [(Var (Name "x"))])]) five = App two [identity, Lit 5] test = case (eval empty five, eval empty (index [] five)) of (Num 5, Num 5) -> True _ -> False