From a3ebd96a8696bf33a4dd63103dee1f70b848952e Mon Sep 17 00:00:00 2001
From: Neil Brown <neil@twistedsquare.com>
Date: Fri, 8 Feb 2008 11:24:37 +0000
Subject: [PATCH] Changed all the functions in the EvalLiterals, Types and
 ShowCode modules to use CSMR (instead of CSM)

---
 common/EvalLiterals.hs | 10 ++++----
 common/ShowCode.hs     | 17 ++++++-------
 common/Types.hs        | 56 +++++++++++++++++++++---------------------
 3 files changed, 41 insertions(+), 42 deletions(-)

diff --git a/common/EvalLiterals.hs b/common/EvalLiterals.hs
index 98bfe11..5aa21f8 100644
--- a/common/EvalLiterals.hs
+++ b/common/EvalLiterals.hs
@@ -30,7 +30,7 @@ import Data.Word
 import Numeric
 
 import qualified AST as A
-import CompState
+import CompState hiding (CSM) -- everything here is read-only
 import Errors
 import Metadata
 
@@ -76,18 +76,18 @@ isConstantArray (A.ArrayElemArray aes) = and $ map isConstantArray aes
 isConstantArray (A.ArrayElemExpr e) = isConstant e
 
 -- | Evaluate a constant integer expression.
-evalIntExpression :: (CSM m, Die m) => A.Expression -> m Int
+evalIntExpression :: (CSMR m, Die m) => A.Expression -> m Int
 evalIntExpression e
-    =  do ps <- get
+    =  do ps <- getCompState
           case runEvaluator ps (evalSimpleExpression e) of
             Left (m,err) -> dieReport (m,"cannot evaluate expression: " ++ err)
             Right (OccInt val) -> return $ fromIntegral val
             Right _ -> dieP (findMeta e) "expression is not of INT type"
 
 -- | Evaluate a byte literal.
-evalByte :: (CSM m, Die m) => String -> m Char
+evalByte :: (CSMR m, Die m) => String -> m Char
 evalByte s
-    =  do ps <- get
+    =  do ps <- getCompState
           case runEvaluator ps (evalByteLiteral s) of
             Left (m,err) -> dieReport (m,"cannot evaluate byte literal: " ++ err)
             Right (OccByte ch) -> return (chr $ fromIntegral ch)
diff --git a/common/ShowCode.hs b/common/ShowCode.hs
index e30765f..dcd6090 100644
--- a/common/ShowCode.hs
+++ b/common/ShowCode.hs
@@ -41,7 +41,7 @@ import Text.PrettyPrint.HughesPJ hiding (space, colon)
 import Text.Regex
 
 import qualified AST as A
-import CompState
+import CompState hiding (CSM) -- everything here is read-only
 
 data ShowOccamState = ShowOccamState {
   indentLevel :: Int,  -- The indent level in spaces (add two for each indent)
@@ -144,22 +144,21 @@ class ShowRain a where
   showRain :: a -> String
 
 -- | Shows the given code (AST item) as either occam or Rain code, depending on which frontend was selected
-showCode :: (CSM m, ShowOccam a, ShowRain a) => a -> m String
+showCode :: (CSMR m, ShowOccam a, ShowRain a) => a -> m String
 showCode o
-   = do st <- get
+   = do st <- getCompState
         case csFrontend st of
-          FrontendOccam -> do st <- get
-                              return $ evalState (showOccamM o) (initialShowOccamState $ transformNames $ csNames st)
+          FrontendOccam -> return $ evalState (showOccamM o) (initialShowOccamState $ transformNames $ csNames st)
           FrontendRain -> return $ showRain o
  where
    transformNames :: Map.Map String A.NameDef -> Map.Map String String
    transformNames = Map.map A.ndOrigName
 
 -- | Some type hackery to allow formatCode to take a variable number of functions.
-class CSM m => ShowCodeFormat a m | a -> m where
+class CSMR m => ShowCodeFormat a m | a -> m where
   chain :: [String] -> [m String] -> a
 
-instance CSM m => ShowCodeFormat (m String) m where
+instance CSMR m => ShowCodeFormat (m String) m where
   chain xs ys = (liftM concat) (sequence $ interleave (map return xs) (ys))
     where
       --Given [a,b,c] [1,2], produces [a,1,b,2,c] etc
@@ -169,14 +168,14 @@ instance CSM m => ShowCodeFormat (m String) m where
       interleave (x:xs) (y:ys) = (x:y: (interleave xs ys))
 
 
-instance (ShowOccam a, ShowRain a, ShowCodeFormat r m, CSM m) => ShowCodeFormat (a -> r) m where
+instance (ShowOccam a, ShowRain a, ShowCodeFormat r m, CSMR m) => ShowCodeFormat (a -> r) m where
   chain a x = (\y -> chain a (x ++ [showCode y]))
               
 
 -- | Formats the given code as either occam or Rain code, depending on the frontend (using showCode).
 -- Use like this:
 -- dieC $ formatCode "Types do not match: % and %" ta tb
-formatCode :: (CSM m,ShowCodeFormat r m) => String -> r
+formatCode :: (CSMR m,ShowCodeFormat r m) => String -> r
 formatCode fmt = chain (splitRegex (mkRegex "%") fmt) []
 
 
diff --git a/common/Types.hs b/common/Types.hs
index c3cdd8c..0dce4fe 100644
--- a/common/Types.hs
+++ b/common/Types.hs
@@ -40,7 +40,7 @@ import Data.List
 import Data.Ord
 
 import qualified AST as A
-import CompState
+import CompState hiding (CSM) -- all these functions are read-only!
 import Errors
 import EvalLiterals
 import Intrinsics
@@ -49,17 +49,17 @@ import ShowCode
 import Utils
 
 -- | Gets the 'A.SpecType' for a given 'A.Name' from the recorded types in the 'CompState'.  Dies with an error if the name is unknown.
-specTypeOfName :: (CSM m, Die m) => A.Name -> m A.SpecType
+specTypeOfName :: (CSMR m, Die m) => A.Name -> m A.SpecType
 specTypeOfName n
     = liftM A.ndType (lookupNameOrError n $ dieP (A.nameMeta n) $ "Could not find find type in specTypeOfName for: " ++ (show $ A.nameName n))
 
 -- | Gets the 'A.AbbrevMode' for a given 'A.Name' from the recorded types in the 'CompState'.  Dies with an error if the name is unknown.
-abbrevModeOfName :: (CSM m, Die m) => A.Name -> m A.AbbrevMode
+abbrevModeOfName :: (CSMR m, Die m) => A.Name -> m A.AbbrevMode
 abbrevModeOfName n
     = liftM A.ndAbbrevMode (lookupNameOrError n $ dieP (A.nameMeta n) $ "Could not find find abbreviation mode in abbrevModeOfName for: " ++ (show $ A.nameName n))
 
 -- | Gets the 'A.Type' for a given 'A.Name' by looking at its definition in the 'CompState'.  Dies with an error if the name is unknown.
-typeOfName :: (CSM m, Die m) => A.Name -> m A.Type
+typeOfName :: (CSMR m, Die m) => A.Name -> m A.Type
 typeOfName n
     =  do st <- specTypeOfName n
           t <- typeOfSpec st
@@ -67,7 +67,7 @@ typeOfName n
             Just t' -> return t'
             Nothing -> dieP (findMeta n) $ "cannot type name " ++ show st
 
-typeOfSpec :: (CSM m, Die m) => A.SpecType -> m (Maybe A.Type)
+typeOfSpec :: (CSMR m, Die m) => A.SpecType -> m (Maybe A.Type)
 typeOfSpec st
         = case st of
             A.Declaration _ t _ -> return $ Just t
@@ -80,7 +80,7 @@ typeOfSpec st
 
 --{{{  identifying types
 -- | Apply a slice to a type.
-sliceType :: (CSM m, Die m) => Meta -> A.Expression -> A.Expression -> A.Type -> m A.Type
+sliceType :: (CSMR m, Die m) => Meta -> A.Expression -> A.Expression -> A.Type -> m A.Type
 sliceType m base count (A.Array (d:ds) t)
     = case (isConstant base, isConstant count) of
         (True, True) ->
@@ -101,7 +101,7 @@ sliceType m base count (A.Array (d:ds) t)
 sliceType m _ _ _ = dieP m "slice of non-array type"
 
 -- | Get the fields of a record type.
-recordFields :: (CSM m, Die m) => Meta -> A.Type -> m [(A.Name, A.Type)]
+recordFields :: (CSMR m, Die m) => Meta -> A.Type -> m [(A.Name, A.Type)]
 recordFields m (A.Record rec)
     =  do st <- specTypeOfName rec
           case st of
@@ -110,13 +110,13 @@ recordFields m (A.Record rec)
 recordFields m _ = dieP m "not record type"
 
 -- | Get the type of a record field.
-typeOfRecordField :: (CSM m, Die m) => Meta -> A.Type -> A.Name -> m A.Type
+typeOfRecordField :: (CSMR m, Die m) => Meta -> A.Type -> A.Name -> m A.Type
 typeOfRecordField m t field
     =  do fs <- recordFields m t
           checkJust (Just m, "unknown record field") $ lookup field fs
 
 -- | Apply a plain subscript to a type.
-plainSubscriptType :: (CSM m, Die m) => Meta -> A.Expression -> A.Type -> m A.Type
+plainSubscriptType :: (CSMR m, Die m) => Meta -> A.Expression -> A.Type -> m A.Type
 plainSubscriptType m sub (A.Array (d:ds) t)
     = case (isConstant sub, d) of
         (True, A.Dimension size) ->
@@ -133,7 +133,7 @@ plainSubscriptType m _ t = diePC m $ formatCode "subscript of non-array type: %"
 
 -- | Apply a subscript to a type, and return what the type is after it's been
 -- subscripted.
-subscriptType :: (CSM m, Die m) => A.Subscript -> A.Type -> m A.Type
+subscriptType :: (CSMR m, Die m) => A.Subscript -> A.Type -> m A.Type
 subscriptType sub t@(A.UserDataType _)
     = resolveUserType (findMeta sub) t >>= subscriptType sub
 subscriptType (A.SubscriptFromFor m base count) t
@@ -154,7 +154,7 @@ subscriptType sub t = diePC (findMeta sub) $ formatCode "Unsubscriptable type: %
 
 -- | The inverse of 'subscriptType': given a type that we know is the result of
 -- a subscript, return what the type being subscripted is.
-unsubscriptType :: (CSM m, Die m) => A.Subscript -> A.Type -> m A.Type
+unsubscriptType :: (CSMR m, Die m) => A.Subscript -> A.Type -> m A.Type
 unsubscriptType (A.SubscriptFromFor _ _ _) t
     = return $ removeFixedDimension t
 unsubscriptType (A.SubscriptFrom _ _) t
@@ -170,13 +170,13 @@ unsubscriptType (A.Subscript _ sub) t
 -- subscriptType with constant 0 as a subscript, but without the checking.
 -- This is used for the couple of cases where we know it's safe and don't want
 -- the usage check.
-trivialSubscriptType :: (CSM m, Die m) => Meta -> A.Type -> m A.Type
+trivialSubscriptType :: (CSMR m, Die m) => Meta -> A.Type -> m A.Type
 trivialSubscriptType _ (A.Array [d] t) = return t
 trivialSubscriptType _ (A.Array (d:ds) t) = return $ A.Array ds t
 trivialSubscriptType m t = diePC m $ formatCode "not plain array type: %" t
 
 -- | Gets the 'A.Type' of a 'A.Variable' by looking at the types recorded in the 'CompState'.
-typeOfVariable :: (CSM m, Die m) => A.Variable -> m A.Type
+typeOfVariable :: (CSMR m, Die m) => A.Variable -> m A.Type
 typeOfVariable (A.Variable m n) = typeOfName n
 typeOfVariable (A.SubscriptedVariable m s v)
     = typeOfVariable v >>= subscriptType s
@@ -192,7 +192,7 @@ typeOfVariable (A.DirectedVariable m dir v)
            _ -> dieP m $ "Used specifier on something that was not a directionless channel: " ++ show v
 
 -- | Get the abbreviation mode of a variable.
-abbrevModeOfVariable :: (CSM m, Die m) => A.Variable -> m A.AbbrevMode
+abbrevModeOfVariable :: (CSMR m, Die m) => A.Variable -> m A.AbbrevMode
 abbrevModeOfVariable (A.Variable _ n) = abbrevModeOfName n
 abbrevModeOfVariable (A.SubscriptedVariable _ sub v) = abbrevModeOfVariable v
 abbrevModeOfVariable (A.DirectedVariable _ _ v) = abbrevModeOfVariable v
@@ -210,16 +210,16 @@ dyadicIsBoolean _ = False
 
 -- | In occam, things that are arrays\/lists (literals, constructors, etc) are arrays.  However, in Rain they are lists.
 -- This function chooses between the two types accordingly.  The dimensions are only relevant in occam.
-typeOfArrayList :: CSM m => [A.Dimension] -> A.Type -> m A.Type
+typeOfArrayList :: CSMR m => [A.Dimension] -> A.Type -> m A.Type
 typeOfArrayList dims innerType
-  = do st <- get 
+  = do st <- getCompState
        case csFrontend st of
          FrontendOccam -> return $ A.Array dims innerType
          FrontendRain -> return $ A.List innerType
 
 
 -- | Gets the 'A.Type' of an 'A.Expression'.  This function assumes that the expression has already been type-checked.
-typeOfExpression :: (CSM m, Die m) => A.Expression -> m A.Type
+typeOfExpression :: (CSMR m, Die m) => A.Expression -> m A.Type
 typeOfExpression e
     = case e of
         A.Monadic m op e -> typeOfExpression e
@@ -254,7 +254,7 @@ typeOfExpression e
         A.ExprConstr m (A.RangeConstr _ b e) -> 
           do bt <- typeOfExpression b
              et <- typeOfExpression e
-             st <- get
+             st <- getCompState
              if bt /= et
                then dieP m "Types did not match for beginning and end of range"
                else typeOfArrayList [A.UnknownDimension] bt
@@ -266,18 +266,18 @@ typeOfExpression e
 --}}}
 
 -- | Gets the return type(s) of a function call from the 'CompState'.
-returnTypesOfFunction :: (CSM m, Die m) => A.Name -> m [A.Type]
+returnTypesOfFunction :: (CSMR m, Die m) => A.Name -> m [A.Type]
 returnTypesOfFunction n
     =  do st <- specTypeOfName n
           case st of
             A.Function _ _ rs _ _ -> return rs
             -- If it's not defined as a function, it might have been converted to a proc.
             _ ->
-              do ps <- get
+              do ps <- getCompState
                  checkJust (Just $ findMeta n, "not defined as a function") $
                    Map.lookup (A.nameName n) (csFunctionReturns ps)
 
-returnTypesOfIntrinsic :: (CSM m, Die m) => Meta -> String -> m [A.Type]
+returnTypesOfIntrinsic :: (CSMR m, Die m) => Meta -> String -> m [A.Type]
 returnTypesOfIntrinsic m s
     = case lookup s intrinsicFunctions of
         Just (rts, _) -> return rts
@@ -285,7 +285,7 @@ returnTypesOfIntrinsic m s
 
 -- | Get the items in a channel's protocol (for typechecking).
 -- Returns Left if it's a simple protocol, Right if it's tagged.
-protocolItems :: (CSM m, Die m) => A.Variable -> m (Either [A.Type] [(A.Name, [A.Type])])
+protocolItems :: (CSMR m, Die m) => A.Variable -> m (Either [A.Type] [(A.Name, [A.Type])])
 protocolItems v
     =  do A.Chan _ _ t <- typeOfVariable v
           case t of
@@ -309,10 +309,10 @@ abbrevModeOfSpec s
 
 -- | Resolve a datatype into its underlying type -- i.e. if it's a named data
 -- type, then return the underlying real type. This will recurse.
-underlyingType :: (CSM m, Die m) => Meta -> A.Type -> m A.Type
+underlyingType :: (CSMR m, Die m) => Meta -> A.Type -> m A.Type
 underlyingType m = everywhereM (mkM underlyingType')
   where
-    underlyingType' :: (CSM m, Die m) => A.Type -> m A.Type
+    underlyingType' :: (CSMR m, Die m) => A.Type -> m A.Type
     underlyingType' t@(A.UserDataType _)
       = resolveUserType m t >>= underlyingType m
     underlyingType' (A.Array ds t) = return $ addDimensions ds t
@@ -321,7 +321,7 @@ underlyingType m = everywhereM (mkM underlyingType')
 -- | Like underlyingType, but only do the "outer layer": if you give this a
 -- user type that's an array of user types, then you'll get back an array of
 -- user types.
-resolveUserType :: (CSM m, Die m) => Meta -> A.Type -> m A.Type
+resolveUserType :: (CSMR m, Die m) => Meta -> A.Type -> m A.Type
 resolveUserType m (A.UserDataType n)
     =  do st <- specTypeOfName n
           case st of
@@ -523,7 +523,7 @@ data BytesInResult =
   deriving (Show, Eq)
 
 -- | Return the size in bytes of a data type.
-bytesInType :: (CSM m, Die m) => A.Type -> m BytesInResult
+bytesInType :: (CSMR m, Die m) => A.Type -> m BytesInResult
 bytesInType A.Byte = return $ BIJust 1
 bytesInType A.UInt16 = return $ BIJust 2
 bytesInType A.UInt32 = return $ BIJust 4
@@ -538,7 +538,7 @@ bytesInType A.Real32 = return $ BIJust 4
 bytesInType A.Real64 = return $ BIJust 8
 bytesInType a@(A.Array _ _) = bytesInArray 0 a
   where
-    bytesInArray :: (CSM m, Die m) => Int -> A.Type -> m BytesInResult
+    bytesInArray :: (CSMR m, Die m) => Int -> A.Type -> m BytesInResult
     bytesInArray num (A.Array [] t) = bytesInType t
     bytesInArray num (A.Array (d:ds) t)
         =  do ts <- bytesInArray (num + 1) (A.Array ds t)
@@ -556,7 +556,7 @@ bytesInType (A.Record n)
             (A.RecordType _ True nts) -> bytesInList nts
             _ -> return $ BIUnknown
   where
-    bytesInList :: (CSM m, Die m) => [(A.Name, A.Type)] -> m BytesInResult
+    bytesInList :: (CSMR m, Die m) => [(A.Name, A.Type)] -> m BytesInResult
     bytesInList [] = return $ BIJust 0
     bytesInList ((_, t):rest)
         =  do bi <- bytesInType t