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.
This commit is contained in:
Neil Brown 2009-01-18 19:33:01 +00:00
parent 949c88bb75
commit 24f646f5b8
3 changed files with 43 additions and 7 deletions

View File

@ -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 ()

View File

@ -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)

View File

@ -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))