From 24f646f5b8b7d96d2c42a968d37e27d8a8ff2a7b Mon Sep 17 00:00:00 2001
From: Neil Brown <neil@twistedsquare.com>
Date: Sun, 18 Jan 2009 19:33:01 +0000
Subject: [PATCH] Changed if statements so that they generate a simpler if when
 no specs are involved

Fixes #16.  If there are no Spec or ProcThen items in an if, a much simpler if (without gotos or similar) is generated.
---
 backends/GenerateC.hs      | 18 +++++++++++++++++-
 backends/GenerateCPPCSP.hs | 15 +++++++++++++--
 backends/GenerateCTest.hs  | 17 +++++++++++++----
 3 files changed, 43 insertions(+), 7 deletions(-)

diff --git a/backends/GenerateC.hs b/backends/GenerateC.hs
index 424abc7..9658b33 100644
--- a/backends/GenerateC.hs
+++ b/backends/GenerateC.hs
@@ -33,6 +33,7 @@ module GenerateC
   , genMeta
   , genName
   , genRightB
+  , justOnly
   , seqComma
   , withIf
   ) where
@@ -1584,7 +1585,11 @@ cgenSeq s = call genStructured s doP
 --}}}
 --{{{  if
 cgenIf :: Meta -> A.Structured A.Choice -> CGen ()
-cgenIf m s
+cgenIf m s | justOnly s = do call genStructured s doCplain
+                             tell ["{"]
+                             call genStop m "no choice matched in IF process"
+                             tell ["}"]
+           | otherwise
     =  do label <- csmLift $ makeNonce "if_end"
           tell ["/*",label,"*/"]
           genIfBody label s
@@ -1601,6 +1606,17 @@ cgenIf m s
                  call genProcess p
                  tell ["goto ", label, ";"]
                  tell ["}"]
+    doCplain _ (A.Choice _ e p)
+      = do tell ["if("]
+           call genExpression e
+           tell ["){"]
+           call genProcess p
+           tell ["}else "]
+
+justOnly :: Data a => A.Structured a -> Bool
+justOnly (A.Only {}) = True
+justOnly (A.Several _ ss) = all justOnly ss
+justOnly _ = False
 --}}}
 --{{{  case
 cgenCase :: Meta -> A.Expression -> A.Structured A.Option -> CGen ()
diff --git a/backends/GenerateCPPCSP.hs b/backends/GenerateCPPCSP.hs
index bd0a99c..8e5a275 100644
--- a/backends/GenerateCPPCSP.hs
+++ b/backends/GenerateCPPCSP.hs
@@ -40,7 +40,7 @@ import System.IO
 import qualified AST as A
 import CompState
 import GenerateC (cgenOps, cgenReplicatorLoop, cgenType, cintroduceSpec, cremoveSpec,
-  generate, genComma, genLeftB, genMeta, genName, genRightB, seqComma, withIf)
+  generate, genComma, genLeftB, genMeta, genName, genRightB, justOnly, seqComma, withIf)
 import GenerateCBased
 import Metadata
 import Pass
@@ -756,7 +756,11 @@ cppgenUnfoldedVariable m var
 -- | Changed to throw a nonce-exception class instead of the goto, because C++ doesn't allow gotos to cross class initialisations (such as arrays)
 
 cppgenIf :: Meta -> A.Structured A.Choice -> CGen ()
-cppgenIf m s
+cppgenIf m s | justOnly s = do call genStructured s doCplain
+                               tell ["{"]
+                               call genStop m "no choice matched in IF process"
+                               tell ["}"]
+             | otherwise
     =  do ifExc <- csmLift $ makeNonce "if_exc"
           tell ["class ",ifExc, "{};try{"]
           genIfBody ifExc s
@@ -772,6 +776,13 @@ cppgenIf m s
                  tell ["){"]
                  call genProcess p
                  tell ["throw ",ifExc, "();}"]
+    doCplain _ (A.Choice _ e p)
+      = do tell ["if("]
+           call genExpression e
+           tell ["){"]
+           call genProcess p
+           tell ["}else "]
+
 --}}}
 
 -- | Changed because C++CSP has channel-ends as concepts (whereas CCSP does not)
diff --git a/backends/GenerateCTest.hs b/backends/GenerateCTest.hs
index 74a7b33..9003a09 100644
--- a/backends/GenerateCTest.hs
+++ b/backends/GenerateCTest.hs
@@ -66,6 +66,9 @@ caret = tell ["^"]
 hash :: CGen ()
 hash = tell ["#"]
 
+backq :: CGen ()
+backq = tell ["`"]
+
 -- | A few easy helpers for name variables for testing.
 foo :: A.Name
 foo = simpleName "foo"
@@ -912,11 +915,13 @@ testCase = TestList
 testIf :: Test
 testIf = TestList
  [
-  testBothR "testIf 0" "/\\*([[:alnum:]_]+)\\*/\\^\\1:;" "class ([[:alnum:]_]+)\\{\\};try\\{\\^\\}catch\\(\\1\\)\\{\\}"
+  testBothR "testIf 0" "\\{\\^\\}" "\\{\\^\\}"
     (over (tcall2 genIf emptyMeta (A.Several emptyMeta [])))
-  ,testBothR "testIf 1" "/\\*([[:alnum:]_]+)\\*/if\\(\\$\\)\\{@goto \\1;\\}\\^\\1:;" 
-    "class ([[:alnum:]_]+)\\{\\};try\\{if\\(\\$\\)\\{@throw \\1\\(\\);\\}\\^\\}catch\\(\\1\\)\\{\\}"
+  ,testBothR "testIf 1" "if\\(\\$\\)\\{@\\}else \\{\\^\\}" "if\\(\\$\\)\\{@\\}else \\{\\^\\}"
     (over (tcall2 genIf emptyMeta (A.Only emptyMeta $ A.Choice emptyMeta e p)))
+  ,testBothR "testIf 2" "/\\*([[:alnum:]_]+)\\*/`if\\(\\$\\)\\{@goto \\1;\\}#\\^\\1:;" 
+    "class ([[:alnum:]_]+)\\{\\};try\\{`if\\(\\$\\)\\{@throw \\1\\(\\);\\}#\\^\\}catch\\(\\1\\)\\{\\}"
+    (over (tcall2 genIf emptyMeta (A.Spec emptyMeta undefined $ A.Only emptyMeta $ A.Choice emptyMeta e p)))
  ]
  where
    e :: A.Expression
@@ -924,7 +929,11 @@ testIf = TestList
    p :: A.Process
    p = undefined
    over :: Override
-   over = local $ \ops -> ops {genExpression = override1 dollar, genProcess = override1 at, genStop = override2 caret, genSpec = override2 hash}
+   over = local $ \ops -> ops { genExpression = override1 dollar
+                              , genProcess = override1 at
+                              , genStop = override2 caret
+                              , introduceSpec = override1 backq
+                              , removeSpec = override1 hash}
 
 testWhile :: Test
 testWhile = testBothSame "testWhile 0" "while($){@}" (over (tcall2 genWhile undefined undefined))