From 8d3f8153eb02f6c9bf9df3d665c6f4484c70f7c0 Mon Sep 17 00:00:00 2001
From: Adam Sampson <ats@offog.org>
Date: Tue, 10 Apr 2007 20:13:09 +0000
Subject: [PATCH] Nicer nonce naming; generate PAR

---
 fco2/GenerateC.hs  | 35 +++++++++++++++++++++++++----------
 fco2/Parse.hs      |  2 +-
 fco2/ParseState.hs |  6 +++---
 fco2/Unnest.hs     |  2 +-
 4 files changed, 30 insertions(+), 15 deletions(-)

diff --git a/fco2/GenerateC.hs b/fco2/GenerateC.hs
index 8d68bd5..4c3222a 100644
--- a/fco2/GenerateC.hs
+++ b/fco2/GenerateC.hs
@@ -271,7 +271,7 @@ genOutputItem c (A.OutCounted m ce ae)
     =  do genOutputItem c (A.OutExpression m ce)
           missing "genOutputItem counted"
 genOutputItem c (A.OutExpression m e)
-    =  do n <- makeNonce
+    =  do n <- makeNonce "output_item"
           ps <- get
           let t = fromJust $ typeOfExpression ps e
           case t of
@@ -308,7 +308,7 @@ genReplicator rep body
 -- of loop a C programmer would normally write.
 genReplicatorLoop :: A.Replicator -> CGen ()
 genReplicatorLoop (A.For m n base count)
-    =  do counter <- makeNonce
+    =  do counter <- makeNonce "replicator_count"
           tell ["int ", counter, " = "]
           genExpression count
           tell [", "]
@@ -338,7 +338,7 @@ introduceSpec (n, A.Declaration m A.Timer) = return ()
 introduceSpec (n, A.Declaration m t)
     =  do case t of
             A.Chan _ ->
-              do cn <- makeNonce
+              do cn <- makeNonce "channel"
                  tell ["Channel ", cn, ";\n"]
                  tell ["ChanInit (&", cn, ");\n"]
                  tell ["Channel *"]
@@ -457,7 +457,7 @@ genAssign vs el
                tell [";\n"]
           vs ->
             do tell ["{\n"]
-               ns <- mapM (\_ -> makeNonce) vs
+               ns <- mapM (\_ -> makeNonce "assign_tmp") vs
                mapM (\(v, n, e) -> do st <- get
                                       let t = typeOfVariable st v
                                       genType (fromJust t)
@@ -484,7 +484,7 @@ genInput c im
 
 genTimerRead :: A.Variable -> CGen ()
 genTimerRead v
-    =  do n <- makeNonce
+    =  do n <- makeNonce "time"
           tell ["{\n"]
           tell ["Time ", n, ";\n"]
           tell ["ProcTime (&", n, ");\n"]
@@ -508,7 +508,7 @@ genStop = tell ["SetErr ();\n"]
 -- that aren't replicated and don't have specs.
 genIf :: A.Structured -> CGen ()
 genIf s
-    =  do label <- makeNonce
+    =  do label <- makeNonce "if_end"
           genIfBody label s
           genStop
           tell [label, ":\n;\n"]
@@ -534,12 +534,27 @@ genWhile e p
           genProcess p
           tell ["}\n"]
 
--- FIXME Stubbed out for now so I can see what the branches look like...
 genPar :: A.ParMode -> [A.Process] -> CGen ()
 genPar pm ps
-    =  do tell ["#error PAR not implemented\n"]
-          sequence_ $ map genProcess ps
-          tell ["#error end PAR\n"]
+    =  do pids <- mapM (\_ -> makeNonce "pid") ps
+          sequence_ $ map genProcAlloc (zip pids ps)
+          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]
+
+genProcAlloc :: (String, A.Process) -> CGen ()
+genProcAlloc (pid, A.ProcCall m n as)
+    =  do tell ["Process *", pid, " = ProcAlloc ("]
+          genName n
+          -- FIXME stack size fixed here
+          tell [", 4096"]
+          sequence_ $ map (\a -> do tell [", "]
+                                    genActual a) as
+          tell [");\n"]
 
 genProcCall :: A.Name -> [A.Actual] -> CGen ()
 genProcCall n as
diff --git a/fco2/Parse.hs b/fco2/Parse.hs
index 700e36b..74e5fd8 100644
--- a/fco2/Parse.hs
+++ b/fco2/Parse.hs
@@ -322,7 +322,7 @@ findName thisN
 scopeIn :: A.Name -> A.SpecType -> A.AbbrevMode -> OccParser A.Name
 scopeIn n@(A.Name m nt s) t am
     =  do st <- getState
-          let s' = s ++ "_" ++ (show $ psNameCounter st)
+          let s' = s ++ "_u" ++ (show $ psNameCounter st)
           let n' = n { A.nameName = s' }
           let nd = A.NameDef {
             A.ndMeta = m,
diff --git a/fco2/ParseState.hs b/fco2/ParseState.hs
index cb3ea7b..45709ad 100644
--- a/fco2/ParseState.hs
+++ b/fco2/ParseState.hs
@@ -36,10 +36,10 @@ psLookupName :: ParseState -> A.Name -> Maybe A.NameDef
 psLookupName ps n = lookup (A.nameName n) (psNames ps)
 
 -- | Generate a throwaway unique name.
-makeNonce :: MonadState ParseState m => m String
-makeNonce
+makeNonce :: MonadState ParseState m => String -> m String
+makeNonce s
     =  do ps <- get
           let i = psNonceCounter ps
           put ps { psNonceCounter = i + 1 }
-          return $ "nonce" ++ show i
+          return $ s ++ "_n" ++ show i
 
diff --git a/fco2/Unnest.hs b/fco2/Unnest.hs
index 1ca07ad..9c8b665 100644
--- a/fco2/Unnest.hs
+++ b/fco2/Unnest.hs
@@ -16,7 +16,7 @@ type UnM a = StateT ParseState IO a
 -- | Generate and define a no-arg wrapper PROC around a process.
 makeNonceProc :: Meta -> A.Process -> UnM A.Specification
 makeNonceProc m p
-    =  do ns <- makeNonce
+    =  do ns <- makeNonce "wrapper_proc"
           let n = A.Name m A.ProcName ns
           let st = A.Proc m [] p
           let nd = A.NameDef {