From e3e9e912f2c910b96d00fde69f9d6fa9ba2d312f Mon Sep 17 00:00:00 2001
From: Neil Brown <neil@twistedsquare.com>
Date: Fri, 8 Feb 2008 11:17:50 +0000
Subject: [PATCH] Added a read-only version of CSM, named CSMR

---
 backends/GenerateCBased.hs |  4 ++++
 common/CompState.hs        | 35 +++++++++++++++++++++++++++++++++--
 frontends/ParseOccam.hs    |  3 +++
 3 files changed, 40 insertions(+), 2 deletions(-)

diff --git a/backends/GenerateCBased.hs b/backends/GenerateCBased.hs
index 680025c..9992cc1 100644
--- a/backends/GenerateCBased.hs
+++ b/backends/GenerateCBased.hs
@@ -25,6 +25,7 @@ import Control.Monad.Writer
 import Data.Generics
 
 import qualified AST as A
+import CompState
 import Errors
 import Metadata
 import Pass
@@ -37,6 +38,9 @@ type CGen = ReaderT GenOps CGen'
 
 instance Die CGen where
   dieReport = throwError
+  
+instance CSMR m => CSMR (ReaderT GenOps m) where
+  getCompState = lift getCompState
 --}}}
 
 -- | A function that applies a subscript to a variable.
diff --git a/common/CompState.hs b/common/CompState.hs
index 30a0859..10e8ab2 100644
--- a/common/CompState.hs
+++ b/common/CompState.hs
@@ -20,7 +20,9 @@ with this program.  If not, see <http://www.gnu.org/licenses/>.
 module CompState where
 
 import Control.Monad.Error
+import Control.Monad.Reader
 import Control.Monad.State
+import Control.Monad.Writer
 import Data.Generics
 import Data.Map (Map)
 import qualified Data.Map as Map
@@ -112,8 +114,37 @@ emptyState = CompState {
 
 -- | Class of monads which keep a CompState.
 -- (This is just shorthand for the equivalent MonadState constraint.)
-class MonadState CompState m => CSM m
-instance MonadState CompState m => CSM m
+class (CSMR m, MonadState CompState m) => CSM m
+instance (CSMR m, MonadState CompState m) => CSM m
+
+-- | This class is like a specific instance of MonadReader.  I tried playing
+-- with introducing all sorts of MonadReader classes, trying to infer it from
+-- MonadState.  But due to various problems (you can't directly infer MonadReader
+-- from MonadState, you can't easily stack different MonadReader instances, etc)
+-- this was the easiest method to get a read-only CompState monad.
+--
+-- If you introduce new monads or monad transformers elsewhere in the code you
+-- may have to define your own instance (see for example, ParseOccam or GenerateCBased)
+class Monad m => CSMR m where
+  getCompState :: m CompState
+
+instance Monad m => CSMR (ReaderT CompState m) where
+  getCompState = ask
+
+instance Monad m => CSMR (StateT CompState m) where
+  getCompState = get
+
+instance CSMR (Reader CompState) where
+  getCompState = ask
+
+instance CSMR (State CompState) where
+  getCompState = get
+
+instance (CSMR m, Error e) => CSMR (ErrorT e m) where
+  getCompState = lift getCompState
+
+instance (CSMR m, Monoid w) => CSMR (WriterT w m) where
+  getCompState = lift getCompState
 
 --{{{  name definitions
 -- | Add the definition of a name.
diff --git a/frontends/ParseOccam.hs b/frontends/ParseOccam.hs
index 12d4e4a..602ec0f 100644
--- a/frontends/ParseOccam.hs
+++ b/frontends/ParseOccam.hs
@@ -50,6 +50,9 @@ instance MonadState st (GenParser tok st) where
   get = getState
   put = setState
 
+instance CSMR (GenParser tok CompState) where
+  getCompState = getState
+
 instance Die (GenParser tok st) where
   dieReport (Just m, err) = fail $ packMeta m err
   dieReport (Nothing, err) = fail err