From addc5500283bde54796ccd4ce9ba28742ca2cc85 Mon Sep 17 00:00:00 2001 From: Zachary Snow Date: Mon, 22 Apr 2019 02:48:22 -0400 Subject: [PATCH] minor code cleanup for struct conversion --- src/Convert/Struct.hs | 74 +++++++++++++++++++++++-------------------- 1 file changed, 39 insertions(+), 35 deletions(-) diff --git a/src/Convert/Struct.hs b/src/Convert/Struct.hs index 53aeef3..ef30e32 100644 --- a/src/Convert/Struct.hs +++ b/src/Convert/Struct.hs @@ -6,12 +6,12 @@ module Convert.Struct (convert) where -import Data.Hashable (hash) -import Data.Maybe (fromJust, isJust) -import Data.List (elemIndex, sortOn) -import Data.Tuple (swap) import Control.Monad.State import Control.Monad.Writer +import Data.Hashable (hash) +import Data.List (elemIndex, sortOn) +import Data.Maybe (fromJust, isJust) +import Data.Tuple (swap) import qualified Data.Map.Strict as Map import qualified Data.Set as Set @@ -37,14 +37,13 @@ convertDescription (description @ (Part _ _ _ _ _ _)) = Map.empty description -- collect information about this description structs = execWriter $ collectModuleItemsM - (collectTypesM collectType) description + (collectTypesM collectStructM) description -- determine which of the packer functions we actually need calledFuncs = execWriter $ collectModuleItemsM - (collectExprsM $ collectNestedExprsM collectCalls) description' + (collectExprsM $ collectNestedExprsM collectCallsM) description' packerFuncs = Set.map packerFnName $ Map.keysSet structs calledPackedFuncs = Set.intersection calledFuncs packerFuncs - funcs = map packerFn usedStructs - usedStructs = filter (isNeeded . fst) $ Map.toList structs + funcs = map packerFn $ filter isNeeded $ Map.keys structs isNeeded tf = Set.member (packerFnName tf) calledPackedFuncs -- helpers for the scoped traversal traverseModuleItemM :: ModuleItem -> State Types ModuleItem @@ -55,30 +54,18 @@ convertDescription (description @ (Part _ _ _ _ _ _)) = traverseStmtM stmt = traverseStmtExprsM traverseExprM stmt >>= traverseStmtAsgnsM traverseAsgnM - traverseExprM = traverseNestedExprsM $ stately $ convertOnlyExpr structs + traverseExprM = + traverseNestedExprsM $ stately converter + where + converter :: Types -> Expr -> Expr + converter types expr = + snd $ convertAsgn structs types (LHSIdent "", expr) traverseAsgnM = stately $ convertAsgn structs convertDescription other = other --- writes down the names of called functions -collectCalls :: Expr -> Writer Idents () -collectCalls (Call f _) = tell $ Set.singleton f -collectCalls _ = return () - --- produces a function which packs the components of a struct literal -packerFn :: (TypeFunc, StructInfo) -> ModuleItem -packerFn (structTf, (flatType, _)) = - MIPackageItem $ - Function Nothing flatType fnName decls [retStmt] - where - Struct (Packed _) fields [] = structTf [] - toInput (t, x) = Variable Input t x [] Nothing - decls = map toInput fields - retStmt = Return $ Concat $ map (Ident . snd) fields - fnName = packerFnName structTf - --- write down unstructured versions of a packed struct type -collectType :: Type -> Writer Structs () -collectType (Struct (Packed sg) fields _) = do +-- write down unstructured versions of packed struct types +collectStructM :: Type -> Writer Structs () +collectStructM (Struct (Packed sg) fields _) = do -- TODO: How should we combine the structs Signing with that of the types it -- contains? if canUnstructure @@ -130,8 +117,7 @@ collectType (Struct (Packed sg) fields _) = do all (head fieldClasses ==) fieldClasses && not (any isComplex fieldTypes) -collectType _ = return () - +collectStructM _ = return () -- convert a struct type to its unstructured equivalent convertType :: Structs -> Type -> Type @@ -142,6 +128,10 @@ convertType structs t1 = where (tf2, rs2) = typeRanges t2 where (tf1, rs1) = typeRanges t1 +-- writes down the names of called functions +collectCallsM :: Expr -> Writer Idents () +collectCallsM (Call f _) = tell $ Set.singleton f +collectCallsM _ = return () -- write down the types of declarations traverseDeclM :: Decl -> State Types Decl @@ -152,6 +142,18 @@ traverseDeclM origDecl = do Localparam t x _ -> modify $ Map.insert x t return origDecl +-- produces a function which packs the components of a struct literal +packerFn :: TypeFunc -> ModuleItem +packerFn structTf = + MIPackageItem $ + Function Nothing (structTf []) fnName decls [retStmt] + where + Struct (Packed _) fields [] = structTf [] + toInput (t, x) = Variable Input t x [] Nothing + decls = map toInput fields + retStmt = Return $ Concat $ map (Ident . snd) fields + fnName = packerFnName structTf + -- returns a "unique" name for the packer for a given struct type packerFnName :: TypeFunc -> Identifier packerFnName structTf = @@ -160,10 +162,12 @@ packerFnName structTf = val = hash $ show structTf str = tail $ show val -convertOnlyExpr :: Structs -> Types -> Expr -> Expr -convertOnlyExpr structs types expr = - snd $ convertAsgn structs types (LHSIdent "", expr) - +-- This is where the magic happens. This is responsible for convertign struct +-- accesses, assignments, and literals, given appropriate information about the +-- structs and the current declaration context. The general strategy involves +-- looking at the innermost type of a node to convert outer uses of fields, and +-- then using the outermost type to figure out the corresping struct definition +-- for struct literals that are encountered. convertAsgn :: Structs -> Types -> (LHS, Expr) -> (LHS, Expr) convertAsgn structs types (lhs, expr) = (lhs', expr')