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