From 0262a3d3c4fb7da99203db3285bad3b574632430 Mon Sep 17 00:00:00 2001 From: Zachary Snow Date: Tue, 24 Sep 2019 22:04:24 -0400 Subject: [PATCH] struct conversion visits non-asgn LHSs --- src/Convert/Struct.hs | 20 ++++++++++++++------ 1 file changed, 14 insertions(+), 6 deletions(-) diff --git a/src/Convert/Struct.hs b/src/Convert/Struct.hs index 2d40746..1756358 100644 --- a/src/Convert/Struct.hs +++ b/src/Convert/Struct.hs @@ -48,7 +48,8 @@ convertDescription (description @ Part{}) = -- helpers for the scoped traversal traverseModuleItemM :: ModuleItem -> State Types ModuleItem traverseModuleItemM item = - traverseExprsM traverseExprM item >>= + traverseLHSsM traverseLHSM item >>= + traverseExprsM traverseExprM >>= traverseAsgnsM traverseAsgnM traverseStmtM :: Stmt -> State Types Stmt traverseStmtM (Subroutine Nothing f args) = do @@ -56,7 +57,8 @@ convertDescription (description @ Part{}) = return $ uncurry (Subroutine Nothing) $ convertCall structs stateTypes f args traverseStmtM stmt = - traverseStmtExprsM traverseExprM stmt >>= + traverseStmtLHSsM traverseLHSM stmt >>= + traverseStmtExprsM traverseExprM >>= traverseStmtAsgnsM traverseAsgnM traverseExprM = traverseNestedExprsM $ stately converter @@ -64,24 +66,30 @@ convertDescription (description @ Part{}) = converter :: Types -> Expr -> Expr converter types expr = snd $ convertAsgn structs types (LHSIdent "", expr) + traverseLHSM = + traverseNestedLHSsM $ stately converter + where + converter :: Types -> LHS -> LHS + converter types lhs = + fst $ convertAsgn structs types (lhs, Ident "") traverseAsgnM = stately $ convertAsgn structs convertDescription other = other -- write down unstructured versions of packed struct types collectStructM :: Type -> Writer Structs () collectStructM (Struct (Packed sg) fields _) = - collectStructM' Struct True sg fields + collectStructM' (Struct $ Packed sg) True sg fields collectStructM (Union (Packed sg) fields _) = - collectStructM' Union False sg fields + collectStructM' (Union $ Packed sg) False sg fields collectStructM _ = return () collectStructM' - :: (Packing -> [Field] -> [Range] -> Type) + :: ([Field] -> [Range] -> Type) -> Bool -> Signing -> [Field] -> Writer Structs () collectStructM' constructor isStruct sg fields = do if canUnstructure then tell $ Map.singleton - (constructor (Packed sg) fields) + (constructor fields) (unstructType, unstructFields) else return () where