packages feed

baskell-0.1: src/Reduce.hs

{-------------------------------------------------------------------------------

        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