diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -1,3 +1,7 @@ +2024-07-07 + * Version bump (3.20). (#522) + * Add support for struct field updates. (#520) + 2024-05-07 * Version bump (3.19.1). (#512) 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 : 3.19.1 +version : 3.20 synopsis : A compiler for Copilot targeting C99. description : This package is a back-end from Copilot to C. @@ -45,9 +45,9 @@ , mtl >= 2.2 && < 2.4 , pretty >= 1.1 && < 1.2 - , copilot-core >= 3.19.1 && < 3.20 - , language-c99 >= 0.2.0 && < 0.3 - , language-c99-simple >= 0.3 && < 0.4 + , copilot-core >= 3.20 && < 3.21 + , language-c99 >= 0.2.0 && < 0.3 + , language-c99-simple >= 0.3 && < 0.4 exposed-modules : Copilot.Compile.C99 diff --git a/src/Copilot/Compile/C99/CodeGen.hs b/src/Copilot/Compile/C99/CodeGen.hs --- a/src/Copilot/Compile/C99/CodeGen.hs +++ b/src/Copilot/Compile/C99/CodeGen.hs @@ -121,11 +121,13 @@ -- | Write a generator function for a stream. mkGenFun :: String -> Expr a -> Type a -> C.FunDef mkGenFun name expr ty = - C.FunDef static cTy name [] cVars [C.Return $ Just cExpr] + C.FunDef static cTy name [] cVars stmts where - static = Just C.Static - cTy = C.decay $ transType ty - (cExpr, cVars) = runState (transExpr expr) mempty + static = Just C.Static + cTy = C.decay $ transType ty + (cExpr, state') = runState (transExpr expr) (0, mempty, mempty) + (_, cVars, stmts') = state' + stmts = stmts' ++ [C.Return $ Just cExpr] -- | Write a generator function for a stream that returns an array. mkGenFunArray :: String -> String -> Expr a -> Type a -> C.FunDef @@ -139,13 +141,20 @@ outputParam = C.Param cArrayType nameArg cArrayType = transType ty - -- Output value, and any variable declarations needed - (cExpr, varDecls) = runState (transExpr expr) mempty + -- Statements to execute as part of the generator. They include statements + -- related to calculating the values of intermediate expressions, and + -- statements related to copying the final value to the destination array. + stmts = stmts' ++ [ copyStmt ] - -- Copy expression to output argument - stmts = [ C.Expr $ memcpy (C.Ident nameArg) cExpr size ] - size = C.LitInt (fromIntegral $ typeSize ty) - C..* C.SizeOfType (C.TypeName $ tyElemName ty) + -- Output value, variable declarations needed, and other statements that + -- must be executed to calculate intermediate values. + (cExpr, state') = runState (transExpr expr) (0, mempty, mempty) + (_, varDecls, stmts') = state' + + -- Copy expression to output argument. + copyStmt = C.Expr $ memcpy (C.Ident nameArg) cExpr size + size = C.LitInt (fromIntegral $ typeSize ty) + C..* C.SizeOfType (C.TypeName $ tyElemName ty) mkGenFunArray _name _nameArg _expr _ty = impossible "mkGenFunArray" "copilot-c99" diff --git a/src/Copilot/Compile/C99/Expr.hs b/src/Copilot/Compile/C99/Expr.hs --- a/src/Copilot/Compile/C99/Expr.hs +++ b/src/Copilot/Compile/C99/Expr.hs @@ -8,19 +8,20 @@ where -- External imports -import Control.Monad.State ( State, modify ) +import Control.Monad.State ( State, get, modify ) import qualified Data.List.NonEmpty as NonEmpty import qualified Language.C99.Simple as C -- Internal imports: Copilot import Copilot.Core ( Expr (..), Field (..), Op1 (..), Op2 (..), Op3 (..), Type (..), Value (..), accessorName, arrayElems, - toValues ) + toValues, typeSize ) -- Internal imports import Copilot.Compile.C99.Error ( impossible ) import Copilot.Compile.C99.Name ( exCpyName, streamAccessorName ) -import Copilot.Compile.C99.Type ( transLocalVarDeclType, transTypeName ) +import Copilot.Compile.C99.Type ( transLocalVarDeclType, transType, + transTypeName ) -- | Translates a Copilot Core expression into a C99 expression. transExpr :: Expr a -> State FunEnv C.Expr @@ -32,7 +33,9 @@ initExpr = Just $ C.InitExpr e1' -- Add new decl to the tail of the fun env - modify (++ [C.VarDecln Nothing cTy1 name initExpr]) + modify (\(i, x, y) + -> (i, x ++ [C.VarDecln Nothing cTy1 name initExpr], y) + ) transExpr e2 @@ -51,6 +54,48 @@ e' <- transExpr e return $ transOp1 op e' +transExpr (Op2 (UpdateField ty1@(Struct _) ty2 f) e1 e2) = do + -- Translating a struct update Op requires initializing a variable to the + -- "old" value, updating the field, and returning the new value. + e1' <- transExpr e1 + e2' <- transExpr e2 + + -- Variable to hold the updated struct + (i, _, _) <- get + let varName = "_v" ++ show i + modify (\(i, x, y) -> (i + 1, x, y)) + + -- Add new var decl + let initDecl = C.VarDecln Nothing cTy1 varName Nothing + cTy1 = transLocalVarDeclType ty1 + modify (\(i, x, y) -> (i, x ++ [initDecl], y)) + + -- Initialize the var to the same value as the original struct + let initStmt = C.Expr + $ C.AssignOp + C.Assign + (C.Ident varName) + e1' + + -- Update field f with given value e2. + let updateStmt = case ty2 of + Array _ -> C.Expr $ memcpy dest e2' size + where + dest = C.Dot (C.Ident varName) (accessorName f) + size = C.LitInt + (fromIntegral $ typeSize ty2) + C..* C.SizeOfType (C.TypeName (tyElemName ty2)) + + _ -> C.Expr + $ C.AssignOp + C.Assign + (C.Dot (C.Ident varName) (accessorName f)) + e2' + + modify (\(i, x, y) -> (i, x, y ++ [ initStmt, updateStmt ])) + + return $ C.Ident varName + transExpr (Op2 op e1 e2) = do e1' <- transExpr e1 e2' <- transExpr e2 @@ -100,32 +145,35 @@ -- | Translates a Copilot binary operator and its arguments into a C99 -- expression. +-- +-- PRE: op is not a struct update operation (i.e., 'UpdateField'). transOp2 :: Op2 a b c -> C.Expr -> C.Expr -> C.Expr transOp2 op e1 e2 = case op of - And -> e1 C..&& e2 - Or -> e1 C..|| e2 - Add _ -> e1 C..+ e2 - Sub _ -> e1 C..- e2 - Mul _ -> e1 C..* e2 - Mod _ -> e1 C..% e2 - Div _ -> e1 C../ e2 - Fdiv _ -> e1 C../ e2 - Pow ty -> funCall (specializeMathFunName ty "pow") [e1, e2] - Logb ty -> funCall (specializeMathFunName ty "log") [e2] C../ - funCall (specializeMathFunName ty "log") [e1] - Atan2 ty -> funCall (specializeMathFunName ty "atan2") [e1, e2] - Eq _ -> e1 C..== e2 - Ne _ -> e1 C..!= e2 - Le _ -> e1 C..<= e2 - Ge _ -> e1 C..>= e2 - Lt _ -> e1 C..< e2 - Gt _ -> e1 C..> e2 - BwAnd _ -> e1 C..& e2 - BwOr _ -> e1 C..| e2 - BwXor _ -> e1 C..^ e2 - BwShiftL _ _ -> e1 C..<< e2 - BwShiftR _ _ -> e1 C..>> e2 - Index _ -> C.Index e1 e2 + And -> e1 C..&& e2 + Or -> e1 C..|| e2 + Add _ -> e1 C..+ e2 + Sub _ -> e1 C..- e2 + Mul _ -> e1 C..* e2 + Mod _ -> e1 C..% e2 + Div _ -> e1 C../ e2 + Fdiv _ -> e1 C../ e2 + Pow ty -> funCall (specializeMathFunName ty "pow") [e1, e2] + Logb ty -> funCall (specializeMathFunName ty "log") [e2] C../ + funCall (specializeMathFunName ty "log") [e1] + Atan2 ty -> funCall (specializeMathFunName ty "atan2") [e1, e2] + Eq _ -> e1 C..== e2 + Ne _ -> e1 C..!= e2 + Le _ -> e1 C..<= e2 + Ge _ -> e1 C..>= e2 + Lt _ -> e1 C..< e2 + Gt _ -> e1 C..> e2 + BwAnd _ -> e1 C..& e2 + BwOr _ -> e1 C..| e2 + BwXor _ -> e1 C..^ e2 + BwShiftL _ _ -> e1 C..<< e2 + BwShiftR _ _ -> e1 C..>> e2 + Index _ -> C.Index e1 e2 + UpdateField _ _ _ -> impossible "transOp2" "copilot-c99" -- | Translates a Copilot ternary operator and its arguments into a C99 -- expression. @@ -368,10 +416,24 @@ -- | Auxiliary type used to collect all the declarations of all the variables -- used in a function to be generated, since variable declarations are always -- listed first at the top of the function body. -type FunEnv = [C.Decln] +type FunEnv = (Int, [C.Decln], [C.Stmt]) -- | Define a C expression that calls a function with arguments. funCall :: C.Ident -- ^ Function name -> [C.Expr] -- ^ Arguments -> C.Expr funCall name = C.Funcall (C.Ident name) + +-- Write a call to the memcpy function. +memcpy :: C.Expr -> C.Expr -> C.Expr -> C.Expr +memcpy dest src size = C.Funcall (C.Ident "memcpy") [dest, src, size] + +-- Translate a Copilot type to a C99 type, handling arrays especially. +-- +-- If the given type is an array (including multi-dimensional arrays), the +-- type is that of the elements in the array. Otherwise, it is just the +-- equivalent representation of the given type in C. +tyElemName :: Type a -> C.Type +tyElemName ty = case ty of + Array ty' -> tyElemName ty' + _ -> transType ty