diff --git a/backends/GenerateC.hs b/backends/GenerateC.hs index 2778a7c..422fcfc 100644 --- a/backends/GenerateC.hs +++ b/backends/GenerateC.hs @@ -1420,7 +1420,7 @@ realFormals (A.Formal am t n) -- This will use ProcGetParam if the Proc is in csParProcs, or the normal C -- calling convention otherwise. genProcSpec :: A.Name -> A.SpecType -> Bool -> CGen () -genProcSpec n (A.Proc _ sm fs p) forwardDecl +genProcSpec n (A.Proc _ (sm, _) fs p) forwardDecl = do cs <- getCompState let (header, params) = if n `Set.member` csParProcs cs then (genParHeader, genParParams) diff --git a/backends/GenerateCPPCSP.hs b/backends/GenerateCPPCSP.hs index ca86c29..d31d36c 100644 --- a/backends/GenerateCPPCSP.hs +++ b/backends/GenerateCPPCSP.hs @@ -537,7 +537,7 @@ cppgenFormal :: (A.Name -> A.Name) -> A.Formal -> CGen () cppgenFormal nameFunc (A.Formal am t n) = call genDecl am t (nameFunc n) cppgenForwardDeclaration :: A.Specification -> CGen() -cppgenForwardDeclaration (A.Specification _ n (A.Proc _ sm fs _)) +cppgenForwardDeclaration (A.Specification _ n (A.Proc _ (sm, _) fs _)) = do --Generate the "process" as a C++ function: call genSpecMode sm tell ["void "] @@ -592,7 +592,7 @@ cppgenForwardDeclaration _ = return () cppintroduceSpec :: A.Specification -> CGen () --I generate process wrappers for all functions by default: -cppintroduceSpec (A.Specification _ n (A.Proc _ sm fs p)) +cppintroduceSpec (A.Specification _ n (A.Proc _ (sm, _) fs p)) = do --Generate the "process" as a C++ function: call genSpecMode sm tell ["void "] diff --git a/data/AST.hs b/data/AST.hs index 9631187..fbf2033 100644 --- a/data/AST.hs +++ b/data/AST.hs @@ -499,7 +499,7 @@ data SpecType = -- The list pairs tag names with item types. | ProtocolCase Meta [(Name, [Type])] -- | Declare a @PROC@. - | Proc Meta SpecMode [Formal] Process + | Proc Meta (SpecMode, RecMode) [Formal] Process -- | Declare a @FUNCTION@. | Function Meta (SpecMode, RecMode) [Type] [Formal] (Either (Structured ExpressionList) Process) diff --git a/data/CompState.hs b/data/CompState.hs index 546083b..78bbf37 100644 --- a/data/CompState.hs +++ b/data/CompState.hs @@ -349,7 +349,7 @@ defineNonce m s st am -- | Generate and define a no-arg wrapper PROC around a process. makeNonceProc :: CSM m => Meta -> A.Process -> m A.Specification makeNonceProc m p - = defineNonce m "wrapper_proc" (A.Proc m A.PlainSpec [] p) A.Abbrev + = defineNonce m "wrapper_proc" (A.Proc m (A.PlainSpec, A.PlainRec) [] p) A.Abbrev -- | Generate and define a counter for a replicator. makeNonceCounter :: CSM m => String -> Meta -> m A.Name diff --git a/frontends/ParseOccam.hs b/frontends/ParseOccam.hs index d7b0ee1..ddf9aa5 100644 --- a/frontends/ParseOccam.hs +++ b/frontends/ParseOccam.hs @@ -409,6 +409,7 @@ scopeInSpec (spec@(A.Specification m n st), nt) return $ A.Specification m n' st where isRecursive (A.Function _ (_, A.Recursive) _ _ _) = True + isRecursive (A.Proc _ (_, A.Recursive) _ _) = True isRecursive _ = False scopeOutSpec :: A.Specification -> OccParser () @@ -1087,18 +1088,22 @@ definition do { sIS; p <- sequentialProtocol; sColon; eol; return (A.Specification m n $ A.Protocol m p, ProtocolName) } <|> do { eol; indent; sCASE; eol; ps <- maybeIndentedList m "empty CASE protocol" taggedProtocol; outdent; sColon; eol; return (A.Specification m n $ A.ProtocolCase m ps, ProtocolName) } <|> do m <- md - (sm, _) <- specMode sPROC + (sm, (rm, _)) <- specMode $ recMode sPROC n <- newProcName fs <- formalList eol indent + n' <- if rm == A.Recursive + then scopeIn n ProcName + (A.Proc m (sm, rm) (map fst fs) (A.Skip m)) A.Original + else return n fs' <- scopeInFormals fs p <- process scopeOutFormals fs' outdent sColon eol - return (A.Specification m n $ A.Proc m sm fs' p, ProcName) + return (A.Specification m n' $ A.Proc m (sm, rm) fs' p, ProcName) <|> do m <- md (rs, (sm, (rm, _))) <- tryVV (sepBy1 dataType sComma) (specMode $ recMode sFUNCTION) n <- newFunctionName diff --git a/frontends/ParseRain.hs b/frontends/ParseRain.hs index 7cd6c5c..bb287d1 100644 --- a/frontends/ParseRain.hs +++ b/frontends/ParseRain.hs @@ -494,7 +494,7 @@ terminator = A.Several emptyMeta [] processDecl :: RainParser A.AST processDecl = do {m <- sProcess ; procName <- name ; params <- tupleDef ; body <- block ; return $ A.Spec m - (A.Specification m procName (A.Proc m A.PlainSpec (formaliseTuple params) body)) + (A.Specification m procName (A.Proc m (A.PlainSpec, A.Recursive) (formaliseTuple params) body)) terminator} functionDecl :: RainParser A.AST diff --git a/transformations/SimplifyExprs.hs b/transformations/SimplifyExprs.hs index afa085e..495f6e9 100644 --- a/transformations/SimplifyExprs.hs +++ b/transformations/SimplifyExprs.hs @@ -53,7 +53,7 @@ functionsToProcs = pass "Convert FUNCTIONs to PROCs" (applyDepthM doSpecification) where doSpecification :: A.Specification -> PassM A.Specification - doSpecification (A.Specification m n (A.Function mf (sm, _) rts fs evp)) + doSpecification (A.Specification m n (A.Function mf smrm rts fs evp)) = do -- Create new names for the return values. specs <- sequence [makeNonceVariable "return_formal" mf t A.Abbrev | t <- rts] let names = [n | A.Specification mf n _ <- specs] @@ -61,7 +61,7 @@ functionsToProcs = pass "Convert FUNCTIONs to PROCs" modify $ (\ps -> ps { csFunctionReturns = Map.insert (A.nameName n) rts (csFunctionReturns ps) }) -- Turn the value process into an assignment process. let p = vpToSeq m n 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 + let st = A.Proc mf smrm (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 let nd = A.NameDef { diff --git a/transformations/SimplifyProcs.hs b/transformations/SimplifyProcs.hs index 9cd0a24..cbc7533 100644 --- a/transformations/SimplifyProcs.hs +++ b/transformations/SimplifyProcs.hs @@ -158,4 +158,4 @@ flattenAssign = pass "Flatten assignment" let code = A.Seq m $ A.Several m $ map (A.Only m) assigns return (A.Spec m (A.Specification m (n {A.nameName = "copy_" ++ A.nameName n}) - (A.Proc m A.InlineSpec [A.Formal A.Abbrev t nonceLHS, A.Formal A.ValAbbrev t nonceRHS] code))) + (A.Proc m (A.InlineSpec, A.PlainRec) [A.Formal A.Abbrev t nonceLHS, A.Formal A.ValAbbrev t nonceRHS] code)))