{------------------------------------------------------------------------------- Copyright: Bernie Pope 2007 Module: Reduce Description: Evaluation of Baskell expressions. Achieved by a term re-writing system. Takes an arbitrary Baskell expression and continually applies reduction rules on it until no more rules apply. In some cases this may be an infinite process. Allows non-strict and strict evaluation. A top-level evaluator is provided which demands the entire final result (ie, unlike a lazy evaluator it does not stop when the term reaches weak head normal form, but continues evaluating inside the term). This is needed by the interpreter because we usually want this kind of deep evaluation at the top level of the read-eval-print loop. However it does not evaluate under lambda abstractions (in case the top level expression is a function). If the term is not well typed then the evaluator might get stuck. This means evaluation will end but the term is not a value (though technically it is a normal form). Of course, what it means to be well typed depends on your type system. Baskell's type checker does not reject any program, so it will try to reduce absolutely anything, even if it does not make sense semantically (such as: plus True 3, which will get stuck). Primary Authors: Bernie Pope -------------------------------------------------------------------------------} {- This file is part of baskell. baskell is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. baskell is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with baskell; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} module Reduce ( runExp , Env , buildEnv , emptyEnv , joinEnv ) where import AST ( Exp (..) , Decl (..) , Program (..) , Ident , Lit (..) ) import qualified Data.Map as Map ( Map , empty , fromList , empty , union , insert , lookup ) import Control.Monad.Reader ( Reader , runReader , ask ) import Control.Monad ( liftM , liftM2 ) -------------------------------------------------------------------------------- -- an environment is a mapping from variables to their values type Env = Map.Map Ident Exp type Eval a = Reader Env a emptyEnv :: Env emptyEnv = Map.empty joinEnv :: Env -> Env -> Env joinEnv = Map.union buildEnv :: Program -> Env buildEnv (Program decls) = Map.fromList [ (name, body) | Decl name body <- decls ] -- top level evaluator - evaluates inside lists and tuples runExp :: Env -> Exp -> Exp runExp env exp = runReader (evaluate exp) env evaluate :: Exp -> Eval Exp evaluate exp = do reduct <- reduce exp case reduct of App (App (Literal LitCons) hd) tl -> liftM2 (App . App (Literal LitCons)) (evaluate hd) (evaluate tl) Tuple exps -> liftM Tuple $ mapM evaluate exps other -> return other -- reduce an expression to Weak Head Normal Form (WHNF) under a given -- environment. It is assumed that top-level functions will be -- in the initial environment. -- -- * variables that are not in the environment are unbound and -- they reduce to themselves -- * an expression is in WHNF if it is a lambda abstraction -- or if it is an application of a constructor -- * the arguments of primitive functions are reduced -- before the application is reduced because primitives -- are strict in their arguments. reduce :: Exp -> Eval Exp reduce exp | isWHNF exp = return exp reduce exp@(Var i) = do env <- ask case Map.lookup i env of Nothing -> return exp Just val -> reduce val reduce (App (Prim _name prim) arg) = do reduct <- reduce arg case prim reduct of Nothing -> return (App (Prim _name prim) arg) Just result -> reduce result reduce (App (Lam var body) arg) = reduce $ substitute var arg body reduce (App (LamStrict var body) arg) = do argReduct <- reduce arg seq argReduct $ reduce $ substitute var argReduct body reduce (App nonLam arg) = do funReduct <- reduce nonLam if isLambda funReduct -- to avoid infinite loops on ill-typed terms then reduce $ App funReduct arg else return $ App funReduct arg reduce other = return other isLambda :: Exp -> Bool isLambda (Lam {}) = True isLambda (LamStrict {}) = True isLambda other = False -- XXX fixme isWHNF :: Exp -> Bool isWHNF (Lam {}) = True isWHNF (LamStrict {}) = True isWHNF (Literal {}) = True isWHNF (App (Literal LitCons) _hd) = True isWHNF (App (App (Literal LitCons) _hd) _tl) = True isWHNF (Tuple {}) = True isWHNF other = False -- replace all free occurrences of an identifier -- with an expression (part of Beta reduction) substitute :: Ident -> Exp -> Exp -> Exp substitute ident1 val exp@(Var ident2) | ident1 == ident2 = val | otherwise = exp substitute ident1 val exp@(Lam ident2 body) | ident1 == ident2 = exp | otherwise = Lam ident2 (substitute ident1 val body) substitute ident1 val exp@(LamStrict ident2 body) | ident1 == ident2 = exp | otherwise = LamStrict ident2 (substitute ident1 val body) substitute ident val (App e1 e2) = App (substitute ident val e1) (substitute ident val e2) substitute ident val exp@(Literal lit) = exp substitute ident val (Tuple exps) = Tuple $ map (substitute ident val) exps substitute ident val exp@(Prim _name _implementation) = exp