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:
parent
949c88bb75
commit
24f646f5b8
|
@ -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 ()
|
||||||
|
|
|
@ -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)
|
||||||
|
|
|
@ -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))
|
||||||
|
|
Loading…
Reference in New Issue
Block a user