Make genActual(s) use the correct abbreviation mode.
This commit is contained in:
parent
7d9110a9b0
commit
17da4db956
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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++
|
||||||
|
|
|
@ -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})
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue
Block a user