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

common/AST.hs

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

common/FlowGraph.hs

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

common/ShowCode.hs

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

frontends/ParseOccam.hs

@@ -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 { 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' vp }
+             <|> 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"
 

frontends/RainPassesTest.hs

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

transformations/PassTest.hs

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

transformations/SimplifyExprs.hs

@@ -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 :: Either (A.Structured A.ExpressionList) A.Process -> [A.Variable] -> A.Structured A.Process
-    vpToSeq (A.Spec m spec s) vs = A.Spec m spec (vpToSeq s vs)
+    vpToSeq (Left (A.Spec m spec s)) vs = A.Spec m spec (vpToSeq (Left s) vs)
-    vpToSeq (A.ProcThen m p s) vs = A.ProcThen m p (vpToSeq s vs)
+    vpToSeq (Left (A.ProcThen m p s)) vs = A.ProcThen m p (vpToSeq (Left s) vs)
-    vpToSeq (A.Only m el) vs = A.Only m $ A.Assign m vs el
+    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).

transformations/SimplifyTypes.hs

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