From 7205272fa53e1f723780a6486e239cd60971d025 Mon Sep 17 00:00:00 2001
From: Adam Sampson <ats@offog.org>
Date: Mon, 30 Apr 2007 01:28:17 +0000
Subject: [PATCH] Use genStructured to do PAR -- which is much shorter

---
 fco2/EvalConstants.hs |  2 +-
 fco2/GenerateC.hs     | 63 ++++++++++++++-----------------------------
 fco2/SimplifyExprs.hs |  2 +-
 fco2/Types.hs         | 27 ++++++++++++++++---
 4 files changed, 46 insertions(+), 48 deletions(-)

diff --git a/fco2/EvalConstants.hs b/fco2/EvalConstants.hs
index bffde03..f1e7080 100644
--- a/fco2/EvalConstants.hs
+++ b/fco2/EvalConstants.hs
@@ -54,7 +54,7 @@ simplifyExpression :: ParseState -> A.Expression -> Either String A.Expression
 simplifyExpression ps e
     = case runEvaluator ps (evalExpression e) of
         Left err -> Left err
-        Right val -> Right $ snd $ renderValue (metaOfExpression e) val
+        Right val -> Right $ snd $ renderValue (findMeta e) val
 
 --{{{  expression evaluator
 evalLiteral :: A.Literal -> EvalM OccValue
diff --git a/fco2/GenerateC.hs b/fco2/GenerateC.hs
index 54fe948..8ccfafe 100644
--- a/fco2/GenerateC.hs
+++ b/fco2/GenerateC.hs
@@ -11,6 +11,7 @@ import Numeric
 import Text.Printf
 
 import qualified AST as A
+import EvalConstants
 import EvalLiterals
 import Metadata
 import ParseState
@@ -433,7 +434,7 @@ genArraySubscript v es
                  tell [", "]
                  genVariable v
                  tell ["_sizes[", show sub, "], "]
-                 genMeta (metaOfExpression e)
+                 genMeta (findMeta e)
                  tell [")"]
         genChunks = [genVariable v >> tell ["_sizes[", show i, "]"] | i <- subs]
 --}}}
@@ -660,7 +661,7 @@ genGeneralReplicatorLoop index base count
           tell ["++"]
 
 genReplicatorSize :: A.Replicator -> CGen ()
-genReplicatorSize (A.For m n base count) = genExpression count
+genReplicatorSize rep = genExpression (sizeOfReplicator rep)
 --}}}
 
 --{{{  abbreviations
@@ -677,7 +678,7 @@ genSlice v (A.Variable _ on) start count ds
                         tell [", "]
                         genName on
                         tell ["_sizes[0], "]
-                        genMeta (metaOfExpression count)
+                        genMeta (findMeta count)
                         tell [")"]
                         sequence_ [do tell [", "]
                                       genName on
@@ -1044,7 +1045,7 @@ genProcess p = case p of
   A.If m s -> genIf m s
   A.Case m e s -> genCase m e s
   A.While m e p -> genWhile e p
-  A.Par m pm s -> genParBody pm s
+  A.Par m pm s -> genPar pm s
   -- PROCESSOR does nothing special.
   A.Processor m e p -> genProcess p
   A.Alt m b s -> genAlt b s
@@ -1230,51 +1231,27 @@ genWhile e p
           tell ["}\n"]
 --}}}
 --{{{  par
--- FIXME: This is a bit odd because it'll only generate the two forms of the
--- AST resulting from regular and replicated PARs. It'd probably be better to
--- make it deal with a general Structured PAR.
-
-genParBody :: A.ParMode -> A.Structured -> CGen ()
-genParBody pm (A.Spec _ spec s) = genSpec spec (genParBody pm s)
-genParBody pm (A.ProcThen _ p s) = genProcess p >> genParBody pm s
-genParBody pm (A.Several _ ss) = genPar pm ss
-genParBody pm (A.Rep _ rep s) = genParRep pm rep s
-
-genParProc :: (A.Process -> CGen()) -> A.Structured -> CGen ()
-genParProc gen (A.Spec _ spec s) = genSpec spec (genParProc gen s)
-genParProc gen (A.ProcThen _ p s) = genProcess p >> genParProc gen s
-genParProc gen (A.OnlyP _ p) = gen p
-
-genPar :: A.ParMode -> [A.Structured] -> CGen ()
-genPar pm ss
-    =  do pids <- sequence [makeNonce "pid" | _ <- ss]
-          sequence_ $ [genParProc (\p -> do tell ["Process *", pid, " = "]
-                                            genProcAlloc p
-                                            tell [";\n"]) s
-                       | (pid, s) <- (zip pids ss)]
-          case pm of
-            A.PlainPar ->
-              do tell ["ProcPar ("]
-                 sequence_ $ [tell [pid, ", "] | pid <- pids]
-                 tell ["NULL);\n"]
-            _ -> missing $ "genPar " ++ show pm
-          sequence_ $ [tell ["ProcAllocClean (", pid, ");\n"] | pid <- pids]
-
-genParRep :: A.ParMode -> A.Replicator -> A.Structured -> CGen ()
-genParRep pm rep s
-    =  do pids <- makeNonce "pids"
+genPar :: A.ParMode -> A.Structured -> CGen ()
+genPar pm s
+    =  do (size, _, _) <- constantFold $ addOne (sizeOfStructured s)
+          pids <- makeNonce "pids"
           index <- makeNonce "i"
           tell ["Process *", pids, "["]
-          genReplicatorSize rep
-          tell [" + 1];\n"]
+          genExpression size
+          tell ["];\n"]
           tell ["int ", index, " = 0;\n"]
-          genReplicator rep $ genParProc (\p -> do tell [pids, "[", index, "++] = "]
-                                                   genProcAlloc p
-                                                   tell [";\n"]) s
+          genStructured s (createP pids index)
           tell [pids, "[", index, "] = NULL;\n"]
           tell ["ProcParList (", pids, ");\n"]
           tell [index, " = 0;\n"]
-          genReplicator rep $ tell ["ProcAllocClean (", pids, "[", index, "++]);\n"]
+          genStructured s (freeP pids index)
+  where
+    createP pids index (A.OnlyP _ p)
+        = do tell [pids, "[", index, "++] = "]
+             genProcAlloc p
+             tell [";\n"]
+    freeP pids index (A.OnlyP _ _)
+        = do tell ["ProcAllocClean (", pids, "[", index, "++]);\n"]
 
 genProcAlloc :: A.Process -> CGen ()
 genProcAlloc (A.ProcCall m n as)
diff --git a/fco2/SimplifyExprs.hs b/fco2/SimplifyExprs.hs
index 89814ae..022ef91 100644
--- a/fco2/SimplifyExprs.hs
+++ b/fco2/SimplifyExprs.hs
@@ -136,7 +136,7 @@ pullUp = doGeneric `extM` doStructured `extM` doProcess `extM` doSpecification `
       where
         pull :: A.Type -> A.Expression -> PassM A.Expression
         pull t e
-            = do let m = metaOfExpression e
+            = do let m = findMeta e
                  spec@(A.Specification _ n _) <- makeNonceIsExpr "array_expr" m t e
                  addPulled $ A.Spec m spec
                  return $ A.ExprVariable m (A.Variable m n)
diff --git a/fco2/Types.hs b/fco2/Types.hs
index 822c121..4665861 100644
--- a/fco2/Types.hs
+++ b/fco2/Types.hs
@@ -231,9 +231,9 @@ makeAbbrevAM am = am
 makeConstant :: Meta -> Int -> A.Expression
 makeConstant m n = A.ExprLiteral m $ A.Literal m A.Int $ A.IntLiteral m (show n)
 
--- | Find the Meta value in an expression.
-metaOfExpression :: A.Expression -> Meta
-metaOfExpression e = head $ gmapQ (mkQ emptyMeta findMeta) e
+-- | Find the first Meta value in some part of the AST.
+findMeta :: (Data t, Typeable t) => t -> Meta
+findMeta e = head $ gmapQ (mkQ emptyMeta findMeta) e
   where
     findMeta :: Meta -> Meta
     findMeta m = m
@@ -362,3 +362,24 @@ bytesInType (A.UserDataType n)
 bytesInType _ = return $ BIUnknown
 --}}}
 
+-- | Get the number of items a replicator produces.
+sizeOfReplicator :: A.Replicator -> A.Expression
+sizeOfReplicator (A.For _ _ _ count) = count
+
+-- | Get the number of items in a Structured as an expression.
+sizeOfStructured :: A.Structured -> A.Expression
+sizeOfStructured (A.Rep m rep s)
+    = A.Dyadic m A.Times (sizeOfReplicator rep) (sizeOfStructured s)
+sizeOfStructured (A.Spec _ _ s) = sizeOfStructured s
+sizeOfStructured (A.ProcThen _ _ s) = sizeOfStructured s
+sizeOfStructured (A.Several m ss)
+    = case ss of
+        [] -> makeConstant m 0
+        _ -> foldl1 (A.Dyadic m A.Plus) (map sizeOfStructured ss)
+sizeOfStructured s = makeConstant (findMeta s) 1
+
+-- | Add one to an expression.
+addOne :: A.Expression -> A.Expression
+addOne e = A.Dyadic m A.Plus (makeConstant m 1) e
+  where m = findMeta e
+