From 9edea5d958851121e9645a0b9d4687b837404f2d Mon Sep 17 00:00:00 2001
From: Neil Brown <neil@twistedsquare.com>
Date: Thu, 30 Aug 2007 16:51:22 +0000
Subject: [PATCH] Added a new variable type, DirectedVariable, for using
 channel-end specifiers

---
 AST.hs            | 2 ++
 EvalConstants.hs  | 1 +
 GenerateC.hs      | 4 ++++
 GenerateCPPCSP.hs | 3 +++
 SimplifyExprs.hs  | 1 +
 Types.hs          | 6 ++++++
 6 files changed, 17 insertions(+)

diff --git a/AST.hs b/AST.hs
index 3689fcb..f961441 100644
--- a/AST.hs
+++ b/AST.hs
@@ -231,6 +231,8 @@ data Variable =
   Variable Meta Name
   -- | A subscripted variable (e.g. @c[0]@ or @person[name]@).
   | SubscriptedVariable Meta Subscript Variable
+  -- | A channel-end variable (e.g. @c?@)
+  | DirectedVariable Meta Direction Variable
   deriving (Show, Eq, Typeable, Data)
 
 -- | An expression.
diff --git a/EvalConstants.hs b/EvalConstants.hs
index 0b6e753..1095180 100644
--- a/EvalConstants.hs
+++ b/EvalConstants.hs
@@ -96,6 +96,7 @@ evalVariable (A.Variable _ n)
             Just e -> evalExpression e
             Nothing -> throwError $ "non-constant variable " ++ show n ++ " used"
 evalVariable (A.SubscriptedVariable _ sub v) = evalVariable v >>= evalSubscript sub
+evalVariable (A.DirectedVariable _ _ v) = evalVariable v
 
 evalIndex :: A.Expression -> EvalM Int
 evalIndex e
diff --git a/GenerateC.hs b/GenerateC.hs
index 6fccf75..05f0ac6 100644
--- a/GenerateC.hs
+++ b/GenerateC.hs
@@ -695,6 +695,7 @@ cgenVariable' ops checkValid v
           let isSub = case v of
                         A.Variable _ _ -> False
                         A.SubscriptedVariable _ _ _ -> True
+                        A.DirectedVariable _ _ _ -> False
 
           let prefix = case (am, t) of
                          (_, A.Array _ _) -> ""
@@ -724,6 +725,7 @@ cgenVariable' ops checkValid v
 
     inner :: A.Variable -> CGen ()
     inner (A.Variable _ n) = genName n
+    inner (A.DirectedVariable _ _ v) = inner v
     inner sv@(A.SubscriptedVariable _ (A.Subscript _ _) _)
         =  do let (es, v) = collectSubs sv
               call genVariable ops v
@@ -1049,6 +1051,8 @@ cgenArrayAbbrev ops v
     genAASize (A.Variable _ on) arg
         = call genArraySize ops True
                        (tell ["&"] >> genName on >> tell ["_sizes[", show arg, "]"])
+    genAASize (A.DirectedVariable _ _ v)  arg
+        = genAASize v arg
 
 cgenArraySize :: GenOps -> Bool -> CGen () -> A.Name -> CGen ()
 cgenArraySize ops isPtr size n
diff --git a/GenerateCPPCSP.hs b/GenerateCPPCSP.hs
index 2d28cfd..1b3af9f 100644
--- a/GenerateCPPCSP.hs
+++ b/GenerateCPPCSP.hs
@@ -1238,6 +1238,7 @@ cppgenVariable' ops checkValid v
            let isSub = case v of
                          A.Variable _ _ -> False
                          A.SubscriptedVariable _ _ _ -> True
+                         A.DirectedVariable _ _ _ -> False                        
 
            let prefix = case (am, t) of
                           (_, A.Array _ _) -> ""
@@ -1267,6 +1268,8 @@ cppgenVariable' ops checkValid v
 
      inner :: A.Variable -> CGen ()
      inner (A.Variable _ n) = genName n
+     inner (A.DirectedVariable _ A.DirInput v) = tell ["(("] >> inner v >> tell [")->reader())"]
+     inner (A.DirectedVariable _ A.DirOutput v) = tell ["(("] >> inner v >> tell [")->writer())"]
      inner sv@(A.SubscriptedVariable _ (A.Subscript _ _) _)
          =  do let (es, v) = collectSubs sv
                call genVariable ops v
diff --git a/SimplifyExprs.hs b/SimplifyExprs.hs
index 4b29112..896c1c4 100644
--- a/SimplifyExprs.hs
+++ b/SimplifyExprs.hs
@@ -196,6 +196,7 @@ pullUp = doGeneric
                 A.Array _ _ ->
                   case e' of
                     A.ExprVariable _ (A.Variable _ _) -> return e'
+                    A.ExprVariable _ (A.DirectedVariable _ _ _) -> return e'
                     _ -> pull t e'
                 _ -> return e'
       where
diff --git a/Types.hs b/Types.hs
index a1d5782..302d06e 100644
--- a/Types.hs
+++ b/Types.hs
@@ -156,11 +156,17 @@ typeOfVariable :: (CSM 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
+typeOfVariable (A.DirectedVariable m dir v)
+    = do t <- typeOfVariable v
+         case t of 
+           (A.Chan A.DirUnknown attr innerT) -> return (A.Chan dir attr innerT)
+           _ -> die $ "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 (A.Variable _ n) = abbrevModeOfName n
 abbrevModeOfVariable (A.SubscriptedVariable _ sub v) = abbrevModeOfVariable v
+abbrevModeOfVariable (A.DirectedVariable _ _ v) = abbrevModeOfVariable v
 
 dyadicIsBoolean :: A.DyadicOp -> Bool
 dyadicIsBoolean A.Eq = True