diff --git a/copilot-c99.cabal b/copilot-c99.cabal --- a/copilot-c99.cabal +++ b/copilot-c99.cabal @@ -1,6 +1,6 @@ cabal-version : >= 1.10 name : copilot-c99 -version : 0.2.3 +version : 0.2.4 synopsis : A compiler for Copilot targeting C99. description : This is a back-end from Copilot to the Atom DSL. Please see README.mk for more details. license : BSD3 diff --git a/src/Copilot/Compile/C99/Phases.hs b/src/Copilot/Compile/C99/Phases.hs --- a/src/Copilot/Compile/C99/Phases.hs +++ b/src/Copilot/Compile/C99/Phases.hs @@ -30,11 +30,12 @@ data Phase = SampleExternVars | SampleExternArrays + | CallExternFuns | SampleExternFuns | UpdateStates | FireTriggers - | UpdateBuffers | UpdateObservers + | UpdateBuffers deriving (Bounded, Eq, Enum, Ord, Show) numberOfPhases :: Int @@ -46,11 +47,12 @@ schedulePhases params meta spec = A.period numberOfPhases $ sampleExternVars params meta spec >> + callExternFuns params meta spec >> sampleExternArrays params meta spec >> sampleExternFuns params meta spec >> - updateStates params meta spec >> fireTriggers params meta spec >> updateObservers params meta spec >> + updateStates params meta spec >> updateBuffers params meta spec -------------------------------------------------------------------------------- @@ -60,14 +62,12 @@ (mapM_ sampleExternVar . M.toList . externInfoMap) meta where - sampleExternVar :: (Core.Name, ExternInfo) -> Atom () sampleExternVar (name, ExternInfo v t) = exactPhase (fromEnum SampleExternVars) $ - atom ("sample_var_" ++ name) $ - do - W.AssignInst <- return $ W.assignInst t - v <== A.value (A.var' name (c2aType t)) + atom ("sample_var_" ++ name) $ do + W.AssignInst <- return $ W.assignInst t + v <== A.value (A.var' name (c2aType t)) -------------------------------------------------------------------------------- @@ -76,50 +76,57 @@ (mapM_ sampleExternArray . M.toList . externArrayInfoMap) meta where - sampleExternArray :: ((Core.Name, Core.Tag), ExternArrayInfo) -> Atom () sampleExternArray ((name, tag), ExternArrayInfo var idxExpr idxType elemType) = exactPhase (fromEnum SampleExternArrays) $ - atom ("sample_array_" ++ name ++ "_" ++ show tag) $ - do - W.IntegralEInst <- return $ W.integralEInst idxType - W.AssignInst <- return $ W.assignInst elemType - W.ExprInst <- return $ W.exprInst elemType - let e = c2aExpr meta idxExpr - arr = A.array' name (c2aType elemType) - var <== A.value (arr A.! e) + atom ("sample_array_" ++ name ++ "_" ++ show tag) $ do + W.IntegralEInst <- return $ W.integralEInst idxType + W.AssignInst <- return $ W.assignInst elemType + W.ExprInst <- return $ W.exprInst elemType + let e = c2aExpr meta idxExpr + arr = A.array' name (c2aType elemType) + var <== A.value (arr A.! e) -------------------------------------------------------------------------------- -sampleExternFuns :: Params -> MetaTable -> Core.Spec -> Atom () -sampleExternFuns _ meta _ = +callExternFuns :: Params -> MetaTable -> Core.Spec -> Atom () +callExternFuns _ meta _ = (mapM_ sampleExternFun . M.toList . externFunInfoMap) meta where - c2aUExpr :: Core.UExpr -> A.UE c2aUExpr (Core.UExpr t e) = case W.exprInst t of W.ExprInst -> A.ue (c2aExpr meta e) sampleExternFun :: ((Core.Name, Core.Tag), ExternFunInfo) -> Atom () - sampleExternFun ((name, tag), ExternFunInfo args var t) = - exactPhase (fromEnum SampleExternFuns) $ - atom ("sample_fun_" ++ name ++ "_" ++ show tag) $ - do - let args' = map c2aUExpr args - A.action fnCall args' - W.AssignInst <- return $ W.assignInst t - var <== A.value (A.var' (mkTmpExtFunVarName name tag) (c2aType t)) + sampleExternFun ((name, tag), ExternFunInfo args _ _) = + exactPhase (fromEnum CallExternFuns) $ + atom ("call_fun_" ++ name ++ "_" ++ show tag) $ do + let args' = map c2aUExpr args + A.action fnCall args' where - fnCall :: [String] -> String fnCall xs = mkTmpExtFunVarName name tag ++ " = " ++ name ++ "(" - ++ concat (intersperse "," xs) ++ ")" + ++ concat (intersperse "," (reverse xs)) ++ ")" -------------------------------------------------------------------------------- +sampleExternFuns :: Params -> MetaTable -> Core.Spec -> Atom () +sampleExternFuns _ meta _ = + (mapM_ sampleExternFun . M.toList . externFunInfoMap) meta + + where + sampleExternFun :: ((Core.Name, Core.Tag), ExternFunInfo) -> Atom () + sampleExternFun ((name, tag), ExternFunInfo _ var t) = + exactPhase (fromEnum CallExternFuns) $ + atom ("sample_fun_" ++ name ++ "_" ++ show tag) $ do + W.AssignInst <- return $ W.assignInst t + var <== A.value (A.var' (mkTmpExtFunVarName name tag) (c2aType t)) + +-------------------------------------------------------------------------------- + updateStates :: Params -> MetaTable -> Core.Spec -> Atom () updateStates _ meta Core.Spec @@ -127,7 +134,6 @@ } = mapM_ updateStreamState streams where - updateStreamState :: Core.Stream -> Atom () updateStreamState Core.Stream @@ -135,39 +141,37 @@ , Core.streamExpr = e , Core.streamExprType = t1 , Core.streamGuard = g - } = - do - let e' = c2aExpr meta e - Just strmInfo = M.lookup id (streamInfoMap meta) - g' = cond (c2aExpr meta g) - updateStreamState1 t1 id e' g' strmInfo + } + = do + let e' = c2aExpr meta e + Just strmInfo = M.lookup id (streamInfoMap meta) + g' = cond (c2aExpr meta g) + updateStreamState1 t1 id e' g' strmInfo updateStreamState1 :: Core.Type a -> Core.Id -> A.E a -> Atom () -> StreamInfo -> Atom () updateStreamState1 t1 id e1 g1 StreamInfo { streamInfoTempVar = tmp - , streamInfoType = t2 - } = + , streamInfoType = t2 } + = exactPhase (fromEnum UpdateStates) $ - atom ("update_state_s" ++ show id) $ - do - g1 - W.AssignInst <- return (W.assignInst t2) - Just Refl <- return (t1 =~= t2) - tmp <== e1 -- coerce (cong p) e1 + atom ("update_state_s" ++ show id) $ do + g1 + W.AssignInst <- return (W.assignInst t2) + Just Refl <- return (t1 =~= t2) + tmp <== e1 -- coerce (cong p) e1 -------------------------------------------------------------------------------- fireTriggers :: Params -> MetaTable -> Core.Spec -> Atom () fireTriggers params meta Core.Spec - { Core.specTriggers = triggers - } = + { Core.specTriggers = triggers } + = mapM_ fireTrigger triggers where - fireTrigger :: Core.Trigger -> Atom () fireTrigger Core.Trigger @@ -176,15 +180,13 @@ , Core.triggerArgs = args } = exactPhase (fromEnum FireTriggers) $ - atom ("fire_trigger_" ++ name) $ - do - let args' = map triggerArg2UE (reverse args) - e0' = c2aExpr meta e0 - cond e0' - A.action fnCall args' + atom ("fire_trigger_" ++ name) $ do + let args' = map triggerArg2UE (reverse args) + e0' = c2aExpr meta e0 + cond e0' + A.action fnCall args' where - triggerArg2UE :: Core.UExpr -> A.UE triggerArg2UE (Core.UExpr t e) = case W.exprInst t of @@ -199,12 +201,11 @@ updateObservers :: Params -> MetaTable -> Core.Spec -> Atom () updateObservers params meta Core.Spec - { Core.specObservers = observers - } = + { Core.specObservers = observers } + = mapM_ updateObserver observers where - updateObserver :: Core.Observer -> Atom () updateObserver Core.Observer @@ -213,42 +214,36 @@ , Core.observerExprType = t } = exactPhase (fromEnum UpdateObservers) $ - atom ("update_observer_" ++ name) $ - do - let e' = c2aExpr meta e - W.AssignInst <- return (W.assignInst t) - (A.var' (withPrefix (prefix params) name) . c2aType) t <== e' + atom ("update_observer_" ++ name) $ do + let e' = c2aExpr meta e + W.AssignInst <- return (W.assignInst t) + (A.var' (withPrefix (prefix params) name) . c2aType) t <== e' -------------------------------------------------------------------------------- updateBuffers :: Params -> MetaTable -> Core.Spec -> Atom () updateBuffers _ meta Core.Spec - { Core.specStreams = streams - } = + { Core.specStreams = streams } + = mapM_ updateBuffer streams where updateBuffer :: Core.Stream -> Atom () - updateBuffer - Core.Stream - { Core.streamId = id - } = - let - Just strmInfo = M.lookup id (streamInfoMap meta) - in - updateBuffer1 id strmInfo + updateBuffer Core.Stream { Core.streamId = id } + = + let Just strmInfo = M.lookup id (streamInfoMap meta) in + updateBuffer1 id strmInfo updateBuffer1 :: Core.Id -> StreamInfo -> Atom () updateBuffer1 id StreamInfo { streamInfoQueue = que , streamInfoTempVar = tmp - , streamInfoType = t - } = + , streamInfoType = t } + = exactPhase (fromEnum UpdateBuffers) $ - atom ("update_buffer_s" ++ show id) $ - do - W.AssignInst <- return (W.assignInst t) - Q.dropFirstElemAndSnoc (A.value tmp) que + atom ("update_buffer_s" ++ show id) $ do + W.AssignInst <- return (W.assignInst t) + Q.dropFirstElemAndSnoc (A.value tmp) que