suzanne.soy/tock-mirror
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Altered the AST to allow a function to be either an ExpressionList (classical occam) or a Process (Rain/proposed new occam)

Browse Source
This commit is contained in:
Neil Brown 2008-02-24 19:29:31 +00:00
parent 74f3cb7fc2
commit 1edaacae89
8 changed files with 23 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
common/AST.hs
View File

@ -475,7 +475,7 @@ data SpecType =
-- | Declare a @PROC@.
| Proc Meta SpecMode [Formal] Process
-- | Declare a @FUNCTION@.
| Function Meta SpecMode [Type] [Formal] (Structured ExpressionList)
| Function Meta SpecMode [Type] [Formal] (Either (Structured ExpressionList) Process)
-- | Declare a retyping abbreviation of a variable.
| Retypes Meta AbbrevMode Type Variable
-- | Declare a retyping abbreviation of an expression.

6
common/FlowGraph.hs
View File

@ -282,9 +282,11 @@ buildProcessOrFunctionSpec :: (Monad mAlter, Monad mLabel) => A.Specification ->
buildProcessOrFunctionSpec (A.Specification _ _ (A.Proc m _ args p)) route
= let procRoute = (route33 route A.Specification) in
addNewSubProcFunc m args (Left (p, route44 procRoute A.Proc)) (route34 procRoute A.Proc)
buildProcessOrFunctionSpec (A.Specification _ _ (A.Function m _ _ args s)) route
buildProcessOrFunctionSpec (A.Specification _ _ (A.Function m _ _ args es)) route
= let funcRoute = (route33 route A.Specification) in
addNewSubProcFunc m args (Right (s, route55 funcRoute A.Function)) (route45 funcRoute A.Function)
case es of
Left sel -> addNewSubProcFunc m args (Right (sel, route55 funcRoute A.Function @-> (\f (Left e) -> f e >>* Left))) (route45 funcRoute A.Function)
Right p -> addNewSubProcFunc m args (Left (p, route55 funcRoute A.Function @-> (\f (Right p) -> f p >>* Right))) (route45 funcRoute A.Function)
buildProcessOrFunctionSpec _ _ = return ()
-- All the various types of Structured (SEQ, PAR, ALT, IF, CASE, input-CASE, VALOF) deal with their nodes so differently

4
common/ShowCode.hs
View File

@ -389,11 +389,11 @@ instance ShowOccam A.Specification where
+>> occamOutdent
+>> (showOccamLine colon)
--TODO use the specmode
showOccamM (A.Specification _ n (A.Function _ sm retTypes params el@(A.Only {})))
showOccamM (A.Specification _ n (A.Function _ sm retTypes params (Left el@(A.Only {}))))
= showOccamLine $
showWithCommas retTypes +>> (return " FUNCTION ") +>> showName n +>> return "(" +>> showWithCommas params +>> return ")"
+>> return " IS " +>> showOccamM el +>> colon
showOccamM (A.Specification _ n (A.Function _ sm retTypes params body))
showOccamM (A.Specification _ n (A.Function _ sm retTypes params (Left body)))
= (showOccamLine $ showWithCommas retTypes +>> (return " FUNCTION ") +>> showName n +>> return "(" +>> showWithCommas params +>> return ")")
+>> occamIndent
+>> showOccamM body

4
frontends/ParseOccam.hs
View File

@ -1373,8 +1373,8 @@ definition
(rs, sm) <- tryVV (sepBy1 dataType sComma) (specMode sFUNCTION)
n <- newFunctionName
fs <- formalList
do { sIS; fs' <- scopeInFormals fs; el <- expressionList rs; scopeOutFormals fs'; sColon; eol; return $ A.Specification m n $ A.Function m sm rs fs' (A.Only m el) }
<|> do { eol; indent; fs' <- scopeInFormals fs; vp <- valueProcess rs; scopeOutFormals fs'; outdent; sColon; eol; return $ A.Specification m n $ A.Function m sm rs fs' vp }
do { sIS; fs' <- scopeInFormals fs; el <- expressionList rs; scopeOutFormals fs'; sColon; eol; return $ A.Specification m n $ A.Function m sm rs fs' (Left $ A.Only m el) }
<|> do { eol; indent; fs' <- scopeInFormals fs; vp <- valueProcess rs; scopeOutFormals fs'; outdent; sColon; eol; return $ A.Specification m n $ A.Function m sm rs fs' (Left vp) }
<|> retypesAbbrev
<?> "definition"

2
frontends/RainPassesTest.hs
View File

@ -384,7 +384,7 @@ testParamPass testName formals params transParams
startStateFunc = do defineName (simpleName "x") $ simpleDefDecl "x" (A.UInt16)
case formals of
Nothing -> return ()
Just formals' -> defineName (funcName "foo") $ simpleDef "foo" $ A.Function m A.PlainSpec [A.Byte] formals' (A.Only m $ A.ExpressionList m [])
Just formals' -> defineName (funcName "foo") $ simpleDef "foo" $ A.Function m A.PlainSpec [A.Byte] formals' (Left $ A.Only m $ A.ExpressionList m [])
origProc = A.ProcCall m (procName "foo") params
expProc ps = A.ProcCall m (procName "foo") ps
origFunc = A.FunctionCall m (funcName "foo") (deActualise params)

6
transformations/PassTest.hs
View File

@ -61,7 +61,7 @@ assertGetItemCast k kv
-- | Given a body, returns a function spec:
singleParamFunc :: A.Structured A.ExpressionList -> A.Specification
singleParamFunc body = A.Specification m (simpleName "foo") (A.Function m A.PlainSpec [A.Int] [A.Formal A.ValAbbrev A.Byte (simpleName "param0")] body)
singleParamFunc body = A.Specification m (simpleName "foo") (A.Function m A.PlainSpec [A.Int] [A.Formal A.ValAbbrev A.Byte (simpleName "param0")] (Left body))
-- | Returns the expected body of the single parameter process (when the function had valof0 as a body)
singleParamBodyExp :: Pattern -- ^ to match: A.Process
@ -94,7 +94,7 @@ testFunctionsToProcs1 :: Test
testFunctionsToProcs1 = TestCase $ testPassWithItemsStateCheck "testFunctionsToProcs1 A" exp (functionsToProcs orig) (return ()) check
where
orig = A.Specification m (simpleName "foo") (A.Function m A.PlainSpec [A.Int,A.Real32]
[A.Formal A.ValAbbrev A.Byte (simpleName "param0"),A.Formal A.Abbrev A.Real32 (simpleName "param1")] (valofTwo "param0" "param1"))
[A.Formal A.ValAbbrev A.Byte (simpleName "param0"),A.Formal A.Abbrev A.Real32 (simpleName "param1")] (Left $ valofTwo "param0" "param1"))
exp = tag3 A.Specification DontCare (simpleName "foo") procBody
procBody = tag4 A.Proc DontCare A.PlainSpec [tag3 A.Formal A.ValAbbrev A.Byte (simpleName "param0"),
tag3 A.Formal A.Abbrev A.Real32 (simpleName "param1"),
@ -123,7 +123,7 @@ testFunctionsToProcs1 = TestCase $ testPassWithItemsStateCheck "testFunctionsToP
testFunctionsToProcs2 :: Test
testFunctionsToProcs2 = TestCase $ testPassWithItemsStateCheck "testFunctionsToProcs2 A" exp (functionsToProcs orig) (return ()) check
where
orig = A.Specification m (simpleName "fooOuter") (A.Function m A.PlainSpec [A.Int] [A.Formal A.ValAbbrev A.Byte (simpleName "paramOuter0")] $
orig = A.Specification m (simpleName "fooOuter") (A.Function m A.PlainSpec [A.Int] [A.Formal A.ValAbbrev A.Byte (simpleName "paramOuter0")] $ Left $
A.Spec m (singleParamFunc valof0) valof0)
exp = tag3 A.Specification DontCare (simpleName "fooOuter") procBodyOuter
procHeader body = tag4 A.Proc DontCare A.PlainSpec [tag3 A.Formal A.ValAbbrev A.Byte (simpleName "paramOuter0"), tag3 A.Formal A.Abbrev A.Int (Named "retOuter0" DontCare)] body

14
transformations/SimplifyExprs.hs
View File

@ -48,14 +48,14 @@ functionsToProcs = doGeneric `extM` doSpecification
doGeneric = makeGeneric functionsToProcs
doSpecification :: A.Specification -> PassM A.Specification
doSpecification (A.Specification m n (A.Function mf sm rts fs vp))
doSpecification (A.Specification m n (A.Function mf sm rts fs evp))
= do -- Create new names for the return values.
specs <- sequence [makeNonceVariable "return_formal" mf t A.VariableName A.Abbrev | t <- rts]
let names = [n | A.Specification mf n _ <- specs]
-- Note the return types so we can fix calls later.
modify $ (\ps -> ps { csFunctionReturns = Map.insert (A.nameName n) rts (csFunctionReturns ps) })
-- Turn the value process into an assignment process.
let p = A.Seq mf $ vpToSeq vp [A.Variable mf n | n <- names]
let p = A.Seq mf $ vpToSeq evp [A.Variable mf n | n <- names]
let st = A.Proc mf sm (fs ++ [A.Formal A.Abbrev t n | (t, n) <- zip rts names]) p
-- Build a new specification and redefine the function.
let spec = A.Specification m n st
@ -72,10 +72,12 @@ functionsToProcs = doGeneric `extM` doSpecification
doGeneric spec
doSpecification s = doGeneric s
vpToSeq :: A.Structured A.ExpressionList -> [A.Variable] -> A.Structured A.Process
vpToSeq (A.Spec m spec s) vs = A.Spec m spec (vpToSeq s vs)
vpToSeq (A.ProcThen m p s) vs = A.ProcThen m p (vpToSeq s vs)
vpToSeq (A.Only m el) vs = A.Only m $ A.Assign m vs el
vpToSeq :: Either (A.Structured A.ExpressionList) A.Process -> [A.Variable] -> A.Structured A.Process
vpToSeq (Left (A.Spec m spec s)) vs = A.Spec m spec (vpToSeq (Left s) vs)
vpToSeq (Left (A.ProcThen m p s)) vs = A.ProcThen m p (vpToSeq (Left s) vs)
vpToSeq (Left (A.Only m el)) vs = A.Only m $ A.Assign m vs el
-- TODO test and implement:
-- vpToSeq (Right p) vs =
-- | Convert AFTER expressions to the equivalent using MINUS (which is how the
-- occam 3 manual defines AFTER).

3
transformations/SimplifyTypes.hs
View File

@ -56,6 +56,7 @@ rntState p = (get >>= nullBodies >>= resolveNamedTypes >>= put) >> return p
nullProcFuncDefs :: A.NameDef -> A.NameDef
nullProcFuncDefs (A.NameDef m n on nt (A.Proc m' sm fs _) am pl) = (A.NameDef m n on nt (A.Proc m' sm fs (A.Skip m')) am pl)
nullProcFuncDefs (A.NameDef m n on nt (A.Function m' sm ts fs _) am pl) = (A.NameDef m n on nt (A.Function m' sm ts fs (A.Several m' [])) am pl)
nullProcFuncDefs (A.NameDef m n on nt (A.Function m' sm ts fs (Left _)) am pl) = (A.NameDef m n on nt (A.Function m' sm ts fs (Left $ A.Several m' [])) am pl)
nullProcFuncDefs (A.NameDef m n on nt (A.Function m' sm ts fs (Right _)) am pl) = (A.NameDef m n on nt (A.Function m' sm ts fs (Right $ A.Skip m')) am pl)
nullProcFuncDefs x = x