Commit c168ec47 by Zachary Snow

added some error checking for struct pattern conversion

parent 37760007
...@@ -215,38 +215,50 @@ convertAsgn structs types (lhs, expr) = ...@@ -215,38 +215,50 @@ convertAsgn structs types (lhs, expr) =
convertExpr (Struct (Packed sg) fields rs) e convertExpr (Struct (Packed sg) fields rs) e
convertExpr (Struct (Packed _) fields _) (Pattern [(Just "default", e)]) = convertExpr (Struct (Packed _) fields _) (Pattern [(Just "default", e)]) =
Concat $ take (length fields) (repeat e) Concat $ take (length fields) (repeat e)
convertExpr (Struct (Packed sg) fields []) (Pattern items) = convertExpr (Struct (Packed sg) fields []) (Pattern itemsOrig) =
if Map.notMember structTf structs if length items /= length fields then
then Pattern items'' error $ "struct pattern " ++ show items ++
else Concat exprs " doesn't have the same # of items as " ++ show structTf
else if itemsFieldNames /= fieldNames then
error $ "struct pattern " ++ show items ++ " has fields " ++
show itemsFieldNames ++ ", but struct type has fields " ++
show fieldNames
else if Map.notMember structTf structs then
Pattern items
else
Concat $ map packItem items
where where
subMap = \(Just ident, subExpr) -> subMap = \(Just ident, subExpr) ->
(Just ident, convertExpr (lookupFieldType fields ident) subExpr) (Just ident, convertExpr (lookupFieldType fields ident) subExpr)
structTf = Struct (Packed sg) fields structTf = Struct (Packed sg) fields
items' = itemsNamed =
-- if the pattern does not use identifiers, use the -- if the pattern does not use identifiers, use the
-- identifiers from the struct type definition in order -- identifiers from the struct type definition in order
if not (all (isJust . fst) items) if not (all (isJust . fst) itemsOrig)
then zip (map (Just. snd) fields) (map snd items) then zip (map (Just. snd) fields) (map snd itemsOrig)
else items else itemsOrig
items'' = map subMap items' items = sortOn itemPosition $ map subMap itemsNamed
fieldNames = map snd fields fieldNames = map snd fields
itemsFieldNames = map (fromJust . fst) items
itemPosition = \(Just x, _) -> fromJust $ elemIndex x fieldNames itemPosition = \(Just x, _) -> fromJust $ elemIndex x fieldNames
packItem (Just x, Number n) = packItem (Just x, Number n) =
Number $ if size /= show resSize
case readMaybe unticked :: Maybe Int of then error $ "literal " ++ show n ++ " for " ++ show x
Nothing -> ++ " doesn't have struct field size " ++ show size
if unticked == n else Number res
then n
else size ++ n
Just num -> size ++ "'d" ++ show num
where where
Number size = rangeSize $ lookupUnstructRange structTf x Number size = rangeSize $ lookupUnstructRange structTf x
unticked = case n of unticked = case n of
'\'' : rest -> rest '\'' : rest -> rest
rest -> rest rest -> rest
resSize = (read $ takeWhile (/= '\'') res) :: Int
res = case readMaybe unticked :: Maybe Int of
Nothing ->
if unticked == n
then n
else size ++ n
Just num -> size ++ "'d" ++ show num
packItem (_, itemExpr) = itemExpr packItem (_, itemExpr) = itemExpr
exprs = map packItem $ sortOn itemPosition items''
convertExpr _ other = other convertExpr _ other = other
-- try expression conversion by looking at the *innermost* type first -- try expression conversion by looking at the *innermost* type first
......
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