Commit e7fc1e61 by Zachary Snow

remove legacy tagging logic in array flattening conversion

parent 336812ff
...@@ -156,9 +156,9 @@ convertExpr scopes = ...@@ -156,9 +156,9 @@ convertExpr scopes =
where where
-- removes the innermost dimensions of the given type information, and -- removes the innermost dimensions of the given type information, and
-- applies the given transformation to the expression -- applies the given transformation to the expression
dropLevel :: (Expr -> Expr) -> (TypeInfo, Expr) -> (TypeInfo, Expr) dropLevel :: TypeInfo -> TypeInfo
dropLevel nest ((t, a), expr) = dropLevel (t, a) =
((tf rs', a'), nest expr) (tf rs', a')
where where
(tf, rs) = typeRanges t (tf, rs) = typeRanges t
(rs', a') = case (rs, a) of (rs', a') = case (rs, a) of
...@@ -166,48 +166,46 @@ convertExpr scopes = ...@@ -166,48 +166,46 @@ convertExpr scopes =
(packed, []) -> (tail packed, []) (packed, []) -> (tail packed, [])
(packed, unpacked) -> (packed, tail unpacked) (packed, unpacked) -> (packed, tail unpacked)
-- given an expression, returns its type information and a tagged -- given an expression, returns its type information, if possible
-- version of the expression, if possible levels :: Expr -> Maybe TypeInfo
levels :: Expr -> Maybe (TypeInfo, Expr)
levels (Bit expr a) = levels (Bit expr a) =
case levels expr of case levels expr of
Just info -> Just $ dropLevel (\expr' -> Bit expr' a) info Just info -> Just $ dropLevel info
Nothing -> fallbackLevels $ Bit expr a Nothing -> fallbackLevels $ Bit expr a
levels (Range expr a b) = levels (Range expr _ _) =
fmap (dropLevel $ \expr' -> Range expr' a b) (levels expr) fmap dropLevel $ levels expr
levels (Dot expr x) = levels (Dot expr x) =
case levels expr of case levels expr of
Just ((Struct _ fields [], []), expr') -> dropDot fields expr' Just (Struct _ fields [], []) -> dropDot fields
Just ((Union _ fields [], []), expr') -> dropDot fields expr' Just (Union _ fields [], []) -> dropDot fields
_ -> fallbackLevels $ Dot expr x _ -> fallbackLevels $ Dot expr x
where where
dropDot :: [Field] -> Expr -> Maybe (TypeInfo, Expr) dropDot :: [Field] -> Maybe TypeInfo
dropDot fields expr' = dropDot fields =
if Map.member x fieldMap if Map.member x fieldMap
then Just ((fieldType, []), Dot expr' x) then Just (fieldType, [])
else Nothing else Nothing
where where
fieldMap = Map.fromList $ map swap fields fieldMap = Map.fromList $ map swap fields
fieldType = fieldMap Map.! x fieldType = fieldMap Map.! x
levels expr = fallbackLevels expr levels expr = fallbackLevels expr
fallbackLevels :: Expr -> Maybe (TypeInfo, Expr) fallbackLevels :: Expr -> Maybe TypeInfo
fallbackLevels expr = fallbackLevels expr =
fmap ((, expr) . thd3) res fmap thd3 res
where where
res = lookupElem scopes expr res = lookupElem scopes expr
thd3 (_, _, c) = c thd3 (_, _, c) = c
-- given an expression, returns the two most significant (innermost, -- given an expression, returns the two most significant (innermost,
-- leftmost) packed dimensions and a tagged version of the expression, -- leftmost) packed dimensions
-- if possible dims :: Expr -> Maybe (Range, Range)
dims :: Expr -> Maybe (Range, Range, Expr)
dims expr = dims expr =
case levels expr of case levels expr of
Just ((t, []), expr') -> Just (t, []) ->
case snd $ typeRanges t of case snd $ typeRanges t of
dimInner : dimOuter : _ -> dimInner : dimOuter : _ ->
Just (dimInner, dimOuter, expr') Just (dimInner, dimOuter)
_ -> Nothing _ -> Nothing
_ -> Nothing _ -> Nothing
...@@ -224,20 +222,15 @@ convertExpr scopes = ...@@ -224,20 +222,15 @@ convertExpr scopes =
-- the prefixed identifier is encountered at the lowest level, it is -- the prefixed identifier is encountered at the lowest level, it is
-- removed. -- removed.
tag = ':'
rewriteExpr :: Expr -> Expr rewriteExpr :: Expr -> Expr
rewriteExpr (Ident x) = rewriteExpr expr@Ident{} = expr
if head x == tag
then Ident $ tail x
else Ident x
rewriteExpr orig@(Bit (Bit expr idxInner) idxOuter) = rewriteExpr orig@(Bit (Bit expr idxInner) idxOuter) =
if isJust maybeDims && expr == rewriteExpr expr if isJust maybeDims && expr == rewriteExpr expr
then Bit expr' idx' then Bit expr idx'
else rewriteExprLowPrec orig else rewriteExprLowPrec orig
where where
maybeDims = dims expr maybeDims = dims expr
Just (dimInner, dimOuter, expr') = maybeDims Just (dimInner, dimOuter) = maybeDims
idxInner' = orientIdx dimInner idxInner idxInner' = orientIdx dimInner idxInner
idxOuter' = orientIdx dimOuter idxOuter idxOuter' = orientIdx dimOuter idxOuter
base = binOp Mul idxInner' (rangeSize dimOuter) base = binOp Mul idxInner' (rangeSize dimOuter)
...@@ -256,11 +249,11 @@ convertExpr scopes = ...@@ -256,11 +249,11 @@ convertExpr scopes =
range = (base, len) range = (base, len)
rewriteExpr orig@(Range (Bit expr idxInner) modeOuter rangeOuter) = rewriteExpr orig@(Range (Bit expr idxInner) modeOuter rangeOuter) =
if isJust maybeDims && expr == rewriteExpr expr if isJust maybeDims && expr == rewriteExpr expr
then Range expr' modeOuter range' then Range expr modeOuter range'
else rewriteExprLowPrec orig else rewriteExprLowPrec orig
where where
maybeDims = dims expr maybeDims = dims expr
Just (dimInner, dimOuter, expr') = maybeDims Just (dimInner, dimOuter) = maybeDims
idxInner' = orientIdx dimInner idxInner idxInner' = orientIdx dimInner idxInner
(baseOuter, lenOuter) = rangeOuter (baseOuter, lenOuter) = rangeOuter
baseOuter' = orientIdx dimOuter baseOuter baseOuter' = orientIdx dimOuter baseOuter
...@@ -279,11 +272,11 @@ convertExpr scopes = ...@@ -279,11 +272,11 @@ convertExpr scopes =
rewriteExprLowPrec :: Expr -> Expr rewriteExprLowPrec :: Expr -> Expr
rewriteExprLowPrec orig@(Bit expr idx) = rewriteExprLowPrec orig@(Bit expr idx) =
if isJust maybeDims && expr == rewriteExpr expr if isJust maybeDims && expr == rewriteExpr expr
then Range expr' mode' range' then Range expr mode' range'
else orig else orig
where where
maybeDims = dims expr maybeDims = dims expr
Just (dimInner, dimOuter, expr') = maybeDims Just (dimInner, dimOuter) = maybeDims
mode' = IndexedPlus mode' = IndexedPlus
idx' = orientIdx dimInner idx idx' = orientIdx dimInner idx
len = rangeSize dimOuter len = rangeSize dimOuter
...@@ -302,11 +295,11 @@ convertExpr scopes = ...@@ -302,11 +295,11 @@ convertExpr scopes =
range' = (base, len) range' = (base, len)
rewriteExprLowPrec orig@(Range expr mode range) = rewriteExprLowPrec orig@(Range expr mode range) =
if isJust maybeDims && expr == rewriteExpr expr if isJust maybeDims && expr == rewriteExpr expr
then Range expr' mode' range' then Range expr mode' range'
else orig else orig
where where
maybeDims = dims expr maybeDims = dims expr
Just (dimInner, dimOuter, expr') = maybeDims Just (dimInner, dimOuter) = maybeDims
sizeOuter = rangeSize dimOuter sizeOuter = rangeSize dimOuter
offsetOuter = uncurry (endianCondExpr dimOuter) $ swap dimOuter offsetOuter = uncurry (endianCondExpr dimOuter) $ swap dimOuter
(baseOrig, lenOrig) = range (baseOrig, lenOrig) = range
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment