diff --git a/backends/GenerateC.hs b/backends/GenerateC.hs index 6d7a181..dbcb496 100644 --- a/backends/GenerateC.hs +++ b/backends/GenerateC.hs @@ -1358,20 +1358,19 @@ cgenSpecMode A.InlineSpec = tell ["inline "] prefixComma :: [CGen ()] -> CGen () prefixComma cs = sequence_ [genComma >> c | c <- cs] -cgenActuals :: [A.Actual] -> CGen () -cgenActuals as = prefixComma (map (call genActual) as) +cgenActuals :: [A.Formal] -> [A.Actual] -> CGen () +cgenActuals fs as = prefixComma [call genActual f a | (f, a) <- zip fs as] -cgenActual :: A.Actual -> CGen () -cgenActual actual = seqComma $ realActuals actual +cgenActual :: A.Formal -> A.Actual -> CGen () +cgenActual f a = seqComma $ realActuals f a -- | Return generators for all the real actuals corresponding to a single -- actual. -realActuals :: A.Actual -> [CGen ()] -realActuals (A.ActualExpression e) +realActuals :: A.Formal -> A.Actual -> [CGen ()] +realActuals _ (A.ActualExpression e) = [call genExpression e] -realActuals (A.ActualVariable v) - = [do am <- abbrevModeOfVariable v - call genVariableAM v am] +realActuals (A.Formal am _ _) (A.ActualVariable v) + = [call genVariableAM v am] -- | Return (type, name) generator pairs for all the real formals corresponding -- to a single formal. @@ -1431,9 +1430,9 @@ genProcSpec n (A.Proc _ sm fs p) forwardDecl -- | Generate a ProcAlloc for a PAR subprocess, returning a nonce for the -- workspace pointer and the name of the function to call. -cgenProcAlloc :: A.Name -> [A.Actual] -> CGen (String, CGen ()) -cgenProcAlloc n as - = do let ras = concatMap realActuals as +cgenProcAlloc :: A.Name -> [A.Formal] -> [A.Actual] -> CGen (String, CGen ()) +cgenProcAlloc n fs as + = do let ras = concat [realActuals f a | (f, a) <- zip fs as] ws <- csmLift $ makeNonce "workspace" tell ["Workspace ", ws, " = ProcAlloc (wptr, ", show $ length ras, ", "] @@ -1627,7 +1626,8 @@ cgenPar pm s where startP :: String -> Meta -> A.Process -> CGen () startP bar _ (A.ProcCall _ n as) - = do (ws, func) <- cgenProcAlloc n as + = do (A.Proc _ _ fs _) <- specTypeOfName n + (ws, func) <- cgenProcAlloc n fs as tell ["LightProcStart (wptr, &", bar, ", ", ws, ", "] func tell [");\n"] @@ -1747,7 +1747,8 @@ cgenProcCall :: A.Name -> [A.Actual] -> CGen () cgenProcCall n as = do genName n tell [" (wptr"] - call genActuals as + (A.Proc _ _ fs _) <- specTypeOfName n + call genActuals fs as tell [");\n"] --}}} --{{{ intrinsic procs diff --git a/backends/GenerateCBased.hs b/backends/GenerateCBased.hs index 74260eb..219ee0f 100644 --- a/backends/GenerateCBased.hs +++ b/backends/GenerateCBased.hs @@ -88,9 +88,9 @@ data GenOps = GenOps { -- | Generates code when a variable comes into scope (e.g. allocating memory, initialising variables). declareInit :: Meta -> A.Type -> A.Variable -> Maybe (CGen ()), -- | Generates an individual parameter to a function\/proc. - genActual :: A.Actual -> CGen (), + genActual :: A.Formal -> A.Actual -> CGen (), -- | Generates the list of actual parameters to a function\/proc. - genActuals :: [A.Actual] -> CGen (), + genActuals :: [A.Formal] -> [A.Actual] -> CGen (), genAllocMobile :: Meta -> A.Type -> Maybe A.Expression -> CGen(), genAlt :: Bool -> A.Structured A.Alternative -> CGen (), -- | Generates the given array element expressions as a flattened (one-dimensional) list of literals diff --git a/backends/GenerateCPPCSP.hs b/backends/GenerateCPPCSP.hs index 5d5b8b7..2653201 100644 --- a/backends/GenerateCPPCSP.hs +++ b/backends/GenerateCPPCSP.hs @@ -401,7 +401,8 @@ cppgenPar _ s do tell [forking," .forkInThisThread(new proc_"] genName n tell ["("] - call genActuals as + (A.Proc _ _ fs _) <- specTypeOfName n + call genActuals fs as tell [" ) ); "] _ -> error ("trying to run something other than a process in parallel") @@ -472,15 +473,16 @@ cppgenAlt _ s -- | In GenerateC this uses prefixComma (because "Process * me" is always the first argument), but here we use infixComma. -cppgenActuals :: [A.Actual] -> CGen () -cppgenActuals as = infixComma (map (call genActual) as) +cppgenActuals :: [A.Formal] -> [A.Actual] -> CGen () +cppgenActuals fs as = infixComma [call genActual f a | (f, a) <- zip fs as] -- | The only change from GenerateC is that passing "me" is not necessary in C++CSP cppgenProcCall :: A.Name -> [A.Actual] -> CGen () cppgenProcCall n as = do genName n tell ["("] - call genActuals as + (A.Proc _ _ fs _) <- specTypeOfName n + call genActuals fs as tell [");"] -- | Changed because we initialise channels and arrays differently in C++ diff --git a/backends/GenerateCTest.hs b/backends/GenerateCTest.hs index add73bd..e5c2876 100644 --- a/backends/GenerateCTest.hs +++ b/backends/GenerateCTest.hs @@ -301,25 +301,33 @@ testActuals :: Test testActuals = TestList [ -- C adds a prefix comma (to follow Process* me) but C++ does not: - testBoth "genActuals 0" ",@,@" "@,@" $ overActual (tcall genActuals [undefined, undefined]) - ,testBothSame "genActuals 1" "" $ (tcall genActuals []) + testBoth "genActuals 0" ",@,@" "@,@" $ overActual (tcall genActuals [undefined, undefined] [undefined, undefined]) + ,testBothSame "genActuals 1" "" $ (tcall genActuals [] []) --For expressions, genExpression should be called: - ,testBothSame "genActual 0" "$" $ over (tcall genActual $ A.ActualExpression (A.True undefined)) - - --For abbreviating arrays, nothing special should happen any more: - ,testBothSame "genActual 1" "$" $ over (tcall genActual $ A.ActualExpression (A.Literal undefined undefined undefined)) - ,testBothSameS "genActual 2" "@" (over (tcall genActual $ A.ActualVariable (A.Variable undefined foo))) - (defineName foo $ simpleDefDecl "foo" A.Int) - ,testBothSameS "genActual 3" "&@" (over (tcall genActual $ A.ActualVariable (A.Variable undefined foo))) - (do defineName foo $ simpleDefDecl "bar" A.Int + ,testBothSame "genActual 0" "$" $ over (tcall genActual valFormal $ A.ActualExpression (A.True undefined)) + ,testBothSame "genActual 1" "$" $ over (tcall genActual valFormal $ A.ActualExpression (A.Literal undefined undefined undefined)) + + --The abbreviation mode used when generating an actual should come from the + --corresponding formal, not from the variable: + ,testBothSameS "genActual 10" "@" (over (tcall genActual valFormal $ A.ActualVariable (A.Variable undefined foo))) + (defineVariable "foo" A.Int) + ,testBothSameS "genActual 11" "&@" (over (tcall genActual refFormal $ A.ActualVariable (A.Variable undefined foo))) + (defineVariable "foo" A.Int) + ,testBothSameS "genActual 12" "@" (over (tcall genActual valFormal $ A.ActualVariable (A.Variable undefined foo))) + (do defineVariable "bar" A.Int + defineIs "foo" A.Int (variable "bar")) + ,testBothSameS "genActual 13" "&@" (over (tcall genActual refFormal $ A.ActualVariable (A.Variable undefined foo))) + (do defineVariable "bar" A.Int defineIs "foo" A.Int (variable "bar")) - ,testBothSameS "genActual 4" "@" (over (tcall genActual $ A.ActualVariable (A.Variable undefined foo))) - (defineName foo $ simpleDefDecl "foo" A.Int) ] where + valFormal :: A.Formal + valFormal = A.Formal A.ValAbbrev undefined undefined + refFormal :: A.Formal + refFormal = A.Formal A.Abbrev undefined undefined overActual :: Override - overActual = local (\ops -> ops {genActual = override1 at}) + overActual = local (\ops -> ops {genActual = override2 at}) over :: Override over = local (\ops -> ops {genVariable = override1 at, genExpression = override1 dollar})