module Let_Type ( Term (..) , Op (..) ) where import Op data Term = Constant Integer | Var String | Apply Op Term Term | Let [ (String, Term) ] Term deriving Show
module Let_Form ( Term (..) , zeige ) where import Let_Type import Rose import Bild import Form baum :: Term -> Rose String baum (Constant n) = Node { key = show n, children = [] } baum (Var n) = Node { key = n, children = [] } baum (Apply o l r) = Node { key = show o, children = map baum [ l, r ] } baum (Let nts b) = Node { key = "Let" , children = [ Node { key = n, children = [ baum t ] } | (n, t) <- nts ] ++ [ baum b ] } instance Form Term where form = form . baum
atom :: Parser Term atom = do n <- natural return $ Constant n `plus` paren term `plus` bindung `plus` do n <- name return $ Var n bindung :: Parser Term bindung = do keyword "let" nts <- brace $ sepBy (operator ";") $ do n <- name operator "=" t <- term return (n, t) keyword "in" body <- term return $ Let nts body(kompletter Quelltext hier)
module Env ( Env -- wird ohne Konstruktoren exportiert , Envs , nullEnvs , mkEnv, find, finds ) where import FiniteMap -- das sind gewichtsbalancierte Bäume data Env a = Env (FiniteMap String a) deriving Show type Envs a = [ Env a ] mkEnv :: [ (String, a) ] -> Env a mkEnv = Env . listToFM nullEnvs :: Envs a nullEnvs = [] find :: Env a -> String -> Maybe a find (Env e) n = lookupFM e n finds :: Envs a -> String -> Maybe a -- die erste Bindung aus einer Liste von Umgebungen finds es n = foldl (\ m e -> case m of Just x -> Just x Nothing -> find e n) Nothing esTatsächlich benutzen wir Listen von Umgebungen, und verwenden jeweils die erste sichtbare Bindung.
Das Auswerten eines Ausdrucks geht dann so:
module Let_Eval where import Let_Type import Let_Form import Env meaning :: Op -> (Integer -> Integer -> Integer) meaning Plus = (+) meaning Minus = (-) meaning Mal = (*) meaning Durch = div eval :: Envs Integer -> Term -> Integer eval envs t = case t of Constant n -> n Apply o l r -> let [ x, y ] = map (eval envs) $ [ l, r ] f = meaning o in f x y Var n -> case finds envs n of Nothing -> error $ "Variable " ++ n ++ " nicht gebunden" Just x -> x Let binds body -> let env = mkEnv [ (n, eval envs t) | (n, t) <- binds ] in eval (env : envs) body eval_top :: Term -> Integer eval_top = eval nullEnvsDas packen wir noch in ein Hauptprogramm
import Let_Type import Let_Parser import Let_Eval import Let_Form read_eval :: String -> String read_eval input = case parse (final term) input of Left msg -> msg Right t -> let x = eval_top t in show x main = do input <- getContents putStrLn $ read_eval input