Commit 369e9f2f by Zachary Snow

updated Stack snapshot; handled pattern matching failure issues introduced in GHC 8.6

parent 75e2fba5
......@@ -130,11 +130,14 @@ traverseModuleItemsM mapper (Part extern kw lifetime name ports items) = do
isGenModuleItem (GenModuleItem _) = True
isGenModuleItem _ = False
breakGenerate other = [other]
traverseModuleItemsM mapper (PackageItem packageItem) = do
let item = MIPackageItem packageItem
Part False Module Nothing "DNE" [] [item'] <-
converted <-
traverseModuleItemsM mapper (Part False Module Nothing "DNE" [] [item])
let item' = case converted of
Part False Module Nothing "DNE" [] [newItem] -> newItem
_ -> error $ "redirected PackageItem traverse failed: "
++ show converted
return $ case item' of
MIPackageItem packageItem' -> PackageItem packageItem'
other -> error $ "encountered bad package module item: " ++ show other
......@@ -605,8 +608,12 @@ traverseLHSsM' strat mapper item =
lhs' <- mapper lhs
return $ NInputGate kw x lhs' exprs
traverseModuleItemLHSsM (AssertionItem (mx, a)) = do
Assertion a' <- traverseNestedStmtsM (traverseStmtLHSsM mapper) (Assertion a)
return $ AssertionItem (mx, a')
converted <-
traverseNestedStmtsM (traverseStmtLHSsM mapper) (Assertion a)
return $ case converted of
Assertion a' -> AssertionItem (mx, a')
_ -> error $ "redirected AssertionItem traverse failed: "
++ show converted
traverseModuleItemLHSsM other = return other
traverseLHSs' :: TFStrategy -> Mapper LHS -> Mapper ModuleItem
......@@ -795,8 +802,12 @@ collectAsgnsM = collectAsgnsM' IncludeTFs
traverseNestedModuleItemsM :: Monad m => MapperM m ModuleItem -> MapperM m ModuleItem
traverseNestedModuleItemsM mapper item = do
Part False Module Nothing "DNE" [] items' <-
converted <-
traverseModuleItemsM mapper (Part False Module Nothing "DNE" [] [item])
let items' = case converted of
Part False Module Nothing "DNE" [] newItems -> newItems
_ -> error $ "redirected NestedModuleItems traverse failed: "
++ show converted
return $ case items' of
[item'] -> item'
_ -> Generate $ map GenModuleItem items'
......
......@@ -463,9 +463,13 @@ takeThrough goal = do
-- pop one character from the input stream
takeChar :: Alex Char
takeChar = do
(pos, _, _, ch : str) <- alexGetInput
(pos, _, _, str) <- alexGetInput
(ch, chs) <-
if null str
then lexicalError "unexpected end of input"
else return (head str, tail str)
let newPos = alexMove pos ch
alexSetInput (newPos, ch, [], str)
alexSetInput (newPos, ch, [], chs)
return ch
-- drop spaces in the input until a non-space is reached or EOF
......@@ -497,7 +501,8 @@ dropWhitespace = do
where
dropChar :: Alex ()
dropChar = do
(pos, _, _, ch : rest) <- alexGetInput
(pos, _, _, chs) <- alexGetInput
let ch : rest = chs
alexSetInput (alexMove pos ch, ch, [], rest)
-- removes and returns a quoted string such as <foo.bar> or "foo.bar"
......@@ -558,8 +563,11 @@ takeMacroDefinition = do
takeMacroArguments :: Alex [String]
takeMacroArguments = do
dropSpaces
'(' <- takeChar
argLoop
leadCh <- takeChar
if leadCh == '('
then argLoop
else lexicalError $ "expected begining of macro arguments, but found "
++ show leadCh
where
argLoop :: Alex [String]
argLoop = do
......
resolver: lts-12.5
resolver: lts-13.17
packages:
- .
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