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 , genMeta
, genName , genName
, genRightB , genRightB
, justOnly
, seqComma , seqComma
, withIf , withIf
) where ) where
@ -1584,7 +1585,11 @@ cgenSeq s = call genStructured s doP
--}}} --}}}
--{{{ if --{{{ if
cgenIf :: Meta -> A.Structured A.Choice -> CGen () 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" = do label <- csmLift $ makeNonce "if_end"
tell ["/*",label,"*/"] tell ["/*",label,"*/"]
genIfBody label s genIfBody label s
@ -1601,6 +1606,17 @@ cgenIf m s
call genProcess p call genProcess p
tell ["goto ", label, ";"] tell ["goto ", label, ";"]
tell ["}"] 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 --{{{ case
cgenCase :: Meta -> A.Expression -> A.Structured A.Option -> CGen () cgenCase :: Meta -> A.Expression -> A.Structured A.Option -> CGen ()

View File

@ -40,7 +40,7 @@ import System.IO
import qualified AST as A import qualified AST as A
import CompState import CompState
import GenerateC (cgenOps, cgenReplicatorLoop, cgenType, cintroduceSpec, cremoveSpec, 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 GenerateCBased
import Metadata import Metadata
import Pass 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) -- | 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 :: 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" = do ifExc <- csmLift $ makeNonce "if_exc"
tell ["class ",ifExc, "{};try{"] tell ["class ",ifExc, "{};try{"]
genIfBody ifExc s genIfBody ifExc s
@ -772,6 +776,13 @@ cppgenIf m s
tell ["){"] tell ["){"]
call genProcess p call genProcess p
tell ["throw ",ifExc, "();}"] 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) -- | Changed because C++CSP has channel-ends as concepts (whereas CCSP does not)

View File

@ -66,6 +66,9 @@ caret = tell ["^"]
hash :: CGen () hash :: CGen ()
hash = tell ["#"] hash = tell ["#"]
backq :: CGen ()
backq = tell ["`"]
-- | A few easy helpers for name variables for testing. -- | A few easy helpers for name variables for testing.
foo :: A.Name foo :: A.Name
foo = simpleName "foo" foo = simpleName "foo"
@ -912,11 +915,13 @@ testCase = TestList
testIf :: Test testIf :: Test
testIf = TestList testIf = TestList
[ [
testBothR "testIf 0" "/\\*([[:alnum:]_]+)\\*/\\^\\1:;" "class ([[:alnum:]_]+)\\{\\};try\\{\\^\\}catch\\(\\1\\)\\{\\}" testBothR "testIf 0" "\\{\\^\\}" "\\{\\^\\}"
(over (tcall2 genIf emptyMeta (A.Several emptyMeta []))) (over (tcall2 genIf emptyMeta (A.Several emptyMeta [])))
,testBothR "testIf 1" "/\\*([[:alnum:]_]+)\\*/if\\(\\$\\)\\{@goto \\1;\\}\\^\\1:;" ,testBothR "testIf 1" "if\\(\\$\\)\\{@\\}else \\{\\^\\}" "if\\(\\$\\)\\{@\\}else \\{\\^\\}"
"class ([[:alnum:]_]+)\\{\\};try\\{if\\(\\$\\)\\{@throw \\1\\(\\);\\}\\^\\}catch\\(\\1\\)\\{\\}"
(over (tcall2 genIf emptyMeta (A.Only emptyMeta $ A.Choice emptyMeta e p))) (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 where
e :: A.Expression e :: A.Expression
@ -924,7 +929,11 @@ testIf = TestList
p :: A.Process p :: A.Process
p = undefined p = undefined
over :: Override 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 :: Test
testWhile = testBothSame "testWhile 0" "while($){@}" (over (tcall2 genWhile undefined undefined)) testWhile = testBothSame "testWhile 0" "while($){@}" (over (tcall2 genWhile undefined undefined))