Make genActual(s) use the correct abbreviation mode.

This commit is contained in:
Adam Sampson 2008-04-01 13:16:23 +00:00
parent 7d9110a9b0
commit 17da4db956
4 changed files with 44 additions and 33 deletions

View File

@ -1358,20 +1358,19 @@ cgenSpecMode A.InlineSpec = tell ["inline "]
prefixComma :: [CGen ()] -> CGen () prefixComma :: [CGen ()] -> CGen ()
prefixComma cs = sequence_ [genComma >> c | c <- cs] prefixComma cs = sequence_ [genComma >> c | c <- cs]
cgenActuals :: [A.Actual] -> CGen () cgenActuals :: [A.Formal] -> [A.Actual] -> CGen ()
cgenActuals as = prefixComma (map (call genActual) as) cgenActuals fs as = prefixComma [call genActual f a | (f, a) <- zip fs as]
cgenActual :: A.Actual -> CGen () cgenActual :: A.Formal -> A.Actual -> CGen ()
cgenActual actual = seqComma $ realActuals actual cgenActual f a = seqComma $ realActuals f a
-- | Return generators for all the real actuals corresponding to a single -- | Return generators for all the real actuals corresponding to a single
-- actual. -- actual.
realActuals :: A.Actual -> [CGen ()] realActuals :: A.Formal -> A.Actual -> [CGen ()]
realActuals (A.ActualExpression e) realActuals _ (A.ActualExpression e)
= [call genExpression e] = [call genExpression e]
realActuals (A.ActualVariable v) realActuals (A.Formal am _ _) (A.ActualVariable v)
= [do am <- abbrevModeOfVariable v = [call genVariableAM v am]
call genVariableAM v am]
-- | Return (type, name) generator pairs for all the real formals corresponding -- | Return (type, name) generator pairs for all the real formals corresponding
-- to a single formal. -- 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 -- | Generate a ProcAlloc for a PAR subprocess, returning a nonce for the
-- workspace pointer and the name of the function to call. -- workspace pointer and the name of the function to call.
cgenProcAlloc :: A.Name -> [A.Actual] -> CGen (String, CGen ()) cgenProcAlloc :: A.Name -> [A.Formal] -> [A.Actual] -> CGen (String, CGen ())
cgenProcAlloc n as cgenProcAlloc n fs as
= do let ras = concatMap realActuals as = do let ras = concat [realActuals f a | (f, a) <- zip fs as]
ws <- csmLift $ makeNonce "workspace" ws <- csmLift $ makeNonce "workspace"
tell ["Workspace ", ws, " = ProcAlloc (wptr, ", show $ length ras, ", "] tell ["Workspace ", ws, " = ProcAlloc (wptr, ", show $ length ras, ", "]
@ -1627,7 +1626,8 @@ cgenPar pm s
where where
startP :: String -> Meta -> A.Process -> CGen () startP :: String -> Meta -> A.Process -> CGen ()
startP bar _ (A.ProcCall _ n as) 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, ", "] tell ["LightProcStart (wptr, &", bar, ", ", ws, ", "]
func func
tell [");\n"] tell [");\n"]
@ -1747,7 +1747,8 @@ cgenProcCall :: A.Name -> [A.Actual] -> CGen ()
cgenProcCall n as cgenProcCall n as
= do genName n = do genName n
tell [" (wptr"] tell [" (wptr"]
call genActuals as (A.Proc _ _ fs _) <- specTypeOfName n
call genActuals fs as
tell [");\n"] tell [");\n"]
--}}} --}}}
--{{{ intrinsic procs --{{{ intrinsic procs

View File

@ -88,9 +88,9 @@ data GenOps = GenOps {
-- | Generates code when a variable comes into scope (e.g. allocating memory, initialising variables). -- | Generates code when a variable comes into scope (e.g. allocating memory, initialising variables).
declareInit :: Meta -> A.Type -> A.Variable -> Maybe (CGen ()), declareInit :: Meta -> A.Type -> A.Variable -> Maybe (CGen ()),
-- | Generates an individual parameter to a function\/proc. -- | 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. -- | 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(), genAllocMobile :: Meta -> A.Type -> Maybe A.Expression -> CGen(),
genAlt :: Bool -> A.Structured A.Alternative -> CGen (), genAlt :: Bool -> A.Structured A.Alternative -> CGen (),
-- | Generates the given array element expressions as a flattened (one-dimensional) list of literals -- | Generates the given array element expressions as a flattened (one-dimensional) list of literals

View File

@ -401,7 +401,8 @@ cppgenPar _ s
do tell [forking," .forkInThisThread(new proc_"] do tell [forking," .forkInThisThread(new proc_"]
genName n genName n
tell ["("] tell ["("]
call genActuals as (A.Proc _ _ fs _) <- specTypeOfName n
call genActuals fs as
tell [" ) ); "] tell [" ) ); "]
_ -> error ("trying to run something other than a process in parallel") _ -> 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. -- | In GenerateC this uses prefixComma (because "Process * me" is always the first argument), but here we use infixComma.
cppgenActuals :: [A.Actual] -> CGen () cppgenActuals :: [A.Formal] -> [A.Actual] -> CGen ()
cppgenActuals as = infixComma (map (call genActual) as) 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 -- | The only change from GenerateC is that passing "me" is not necessary in C++CSP
cppgenProcCall :: A.Name -> [A.Actual] -> CGen () cppgenProcCall :: A.Name -> [A.Actual] -> CGen ()
cppgenProcCall n as cppgenProcCall n as
= do genName n = do genName n
tell ["("] tell ["("]
call genActuals as (A.Proc _ _ fs _) <- specTypeOfName n
call genActuals fs as
tell [");"] tell [");"]
-- | Changed because we initialise channels and arrays differently in C++ -- | Changed because we initialise channels and arrays differently in C++

View File

@ -301,25 +301,33 @@ testActuals :: Test
testActuals = TestList testActuals = TestList
[ [
-- C adds a prefix comma (to follow Process* me) but C++ does not: -- C adds a prefix comma (to follow Process* me) but C++ does not:
testBoth "genActuals 0" ",@,@" "@,@" $ overActual (tcall genActuals [undefined, undefined]) testBoth "genActuals 0" ",@,@" "@,@" $ overActual (tcall genActuals [undefined, undefined] [undefined, undefined])
,testBothSame "genActuals 1" "" $ (tcall genActuals []) ,testBothSame "genActuals 1" "" $ (tcall genActuals [] [])
--For expressions, genExpression should be called: --For expressions, genExpression should be called:
,testBothSame "genActual 0" "$" $ over (tcall genActual $ A.ActualExpression (A.True undefined)) ,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))
--For abbreviating arrays, nothing special should happen any more: --The abbreviation mode used when generating an actual should come from the
,testBothSame "genActual 1" "$" $ over (tcall genActual $ A.ActualExpression (A.Literal undefined undefined undefined)) --corresponding formal, not from the variable:
,testBothSameS "genActual 2" "@" (over (tcall genActual $ A.ActualVariable (A.Variable undefined foo))) ,testBothSameS "genActual 10" "@" (over (tcall genActual valFormal $ A.ActualVariable (A.Variable undefined foo)))
(defineName foo $ simpleDefDecl "foo" A.Int) (defineVariable "foo" A.Int)
,testBothSameS "genActual 3" "&@" (over (tcall genActual $ A.ActualVariable (A.Variable undefined foo))) ,testBothSameS "genActual 11" "&@" (over (tcall genActual refFormal $ A.ActualVariable (A.Variable undefined foo)))
(do defineName foo $ simpleDefDecl "bar" A.Int (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")) 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 where
valFormal :: A.Formal
valFormal = A.Formal A.ValAbbrev undefined undefined
refFormal :: A.Formal
refFormal = A.Formal A.Abbrev undefined undefined
overActual :: Override overActual :: Override
overActual = local (\ops -> ops {genActual = override1 at}) overActual = local (\ops -> ops {genActual = override2 at})
over :: Override over :: Override
over = local (\ops -> ops {genVariable = override1 at, genExpression = override1 dollar}) over = local (\ops -> ops {genVariable = override1 at, genExpression = override1 dollar})