From 65875f523febb6b0007d7a9a668d14fc0e6e91fb Mon Sep 17 00:00:00 2001
From: Neil Brown <neil@twistedsquare.com>
Date: Thu, 19 Mar 2009 16:47:31 +0000
Subject: [PATCH] Added mobile cloning rather than using dereferencing to copy
 mobiles

---
 backends/GenerateC.hs               | 18 ++++++++----------
 backends/GenerateCBased.hs          |  1 +
 common/Types.hs                     |  1 +
 data/AST.hs                         |  3 +++
 transformations/ImplicitMobility.hs | 10 +++-------
 5 files changed, 16 insertions(+), 17 deletions(-)

diff --git a/backends/GenerateC.hs b/backends/GenerateC.hs
index 6d73844..49b9bd7 100644
--- a/backends/GenerateC.hs
+++ b/backends/GenerateC.hs
@@ -91,6 +91,7 @@ cgenOps = GenOps {
     genCase = cgenCase,
     genCheckedConversion = cgenCheckedConversion,
     genClearMobile = cgenClearMobile,
+    genCloneMobile = cgenCloneMobile,
     genConversion = cgenConversion,
     genConversionSymbol = cgenConversionSymbol,
     genDecl = cgenDecl,
@@ -948,6 +949,7 @@ cgenExpression (A.BytesInType m t) = call genBytesIn m t (Left False)
 --cgenExpression (A.OffsetOf m t n)
 --cgenExpression (A.ExprConstr {})
 cgenExpression (A.AllocMobile m t me) = call genAllocMobile m t me
+cgenExpression (A.CloneMobile m e) = call genCloneMobile m e
 cgenExpression t = call genMissing $ "genExpression " ++ show t
 
 cgenSizeSuffix :: String -> CGen ()
@@ -1356,16 +1358,6 @@ cintroduceSpec (A.Specification _ n (A.IsExpr _ am t e))
                  tell [" = "]
                  rhs
                  tell [";\n"]
-          case t of
-            A.Mobile (A.Array ds _) -> do
-              sequence_ [case d of
-                A.Dimension e -> do genName n
-                                    tell ["->dimensions[", show i, "]="]
-                                    call genExpression e
-                                    tell [";"]
-                A.UnknownDimension -> return ()
-                | (d, i) <- zip ds [0..]]
-            _ -> return ()
 cintroduceSpec (A.Specification _ n (A.IsChannelArray _ (A.Array _ c) cs))
     =  do call genType c
           case c of
@@ -1938,4 +1930,10 @@ cgenClearMobile _ v
   where
     genVar = call genVariable v
 
+cgenCloneMobile :: Meta -> A.Expression -> CGen ()
+cgenCloneMobile _ e
+  = do tell ["MTClone(wptr,(void*)"]
+       call genExpression e
+       tell [")"]
+
 --}}}
diff --git a/backends/GenerateCBased.hs b/backends/GenerateCBased.hs
index 30447df..a04a325 100644
--- a/backends/GenerateCBased.hs
+++ b/backends/GenerateCBased.hs
@@ -112,6 +112,7 @@ data GenOps = GenOps {
     genCase :: Meta -> A.Expression -> A.Structured A.Option -> CGen (),
     genCheckedConversion :: Meta -> A.Type -> A.Type -> CGen () -> CGen (),
     genClearMobile :: Meta -> A.Variable -> CGen (),
+    genCloneMobile :: Meta -> A.Expression -> CGen (),
     genConversion :: Meta -> A.ConversionMode -> A.Type -> A.Expression -> CGen (),
     genConversionSymbol :: A.Type -> A.Type -> A.ConversionMode -> CGen (),
     genDecl :: A.AbbrevMode -> A.Type -> A.Name -> CGen (),
diff --git a/common/Types.hs b/common/Types.hs
index 54a5336..27fb40d 100644
--- a/common/Types.hs
+++ b/common/Types.hs
@@ -283,6 +283,7 @@ typeOfExpression e
         A.BytesInType m t -> return A.Int
         A.OffsetOf m t n -> return A.Int
         A.AllocMobile _ t _ -> return t
+        A.CloneMobile _ e -> typeOfExpression e
 --}}}
 
 -- | Gets the return type(s) of a function call from the 'CompState'.
diff --git a/data/AST.hs b/data/AST.hs
index 3443407..0049512 100644
--- a/data/AST.hs
+++ b/data/AST.hs
@@ -277,6 +277,9 @@ data Expression =
   -- | A mobile allocation. The type should always be Mobile t, and the
   -- Expression should be of type t.
   | AllocMobile Meta Type (Maybe Expression)
+  -- | A CLONE operation.  The inner expression should have a Mobile type, and
+  -- this will have the same type as the inner component:
+  | CloneMobile Meta Expression
   deriving (Show, Eq, Typeable, Data)
 
 -- | A list of expressions.
diff --git a/transformations/ImplicitMobility.hs b/transformations/ImplicitMobility.hs
index e80d2d3..88ad029 100644
--- a/transformations/ImplicitMobility.hs
+++ b/transformations/ImplicitMobility.hs
@@ -59,7 +59,7 @@ effectDecision targetVar (Copy _) (AlterProcess wrapper) = routeModify wrapper a
            case e of
              A.ExprVariable m' v ->
                if (Var v == targetVar)
-                 then return $ A.ExprVariable m' $ A.DerefVariable m' v
+                 then return $ A.CloneMobile m' $ A.ExprVariable m' v
                  else return e
              -- TODO handle concat expressions with repeated vars
              A.Dyadic m A.Concat lhs rhs ->
@@ -69,11 +69,9 @@ effectDecision targetVar (Copy _) (AlterProcess wrapper) = routeModify wrapper a
              _ -> return e
     alterProc :: A.Process -> PassM A.Process
     alterProc (A.Assign m lhs (A.ExpressionList m' [e]))
-      = do e' <- derefExp e
-           return $ A.Assign m lhs $ A.ExpressionList m' [e']
+      = return $ A.Assign m lhs $ A.ExpressionList m' [A.CloneMobile m' e]
     alterProc (A.Output m cv [A.OutExpression m' e])
-      = do e' <- derefExp e
-           return $ A.Output m cv [A.OutExpression m' e']
+      = return $ A.Output m cv [A.OutExpression m' $ A.CloneMobile m' e]
     alterProc x = dieP (findMeta x) "Cannot alter process to copy"
 effectDecision _ (Copy _) _ = return
 
@@ -281,8 +279,6 @@ mobiliseArrays = pass "Make all arrays mobile" [] [] recurse
       = Just $ f $ A.Array ds $ A.ChanEnd attr dir $ A.Mobile t
     mobiliseArrayInside _ = Nothing
 
--- TODO I think I want to clone, not dereference
-
 class Dereferenceable a where
   deref :: Meta -> a -> Maybe a