Support building with GHC 9.4

This contains a variety of tweaks needed to make the libraries in the
`macaw` repo build with GHC 9.4:

* `ST` no longer has a `MonadFail` instance. See
  [this section](https://gitlab.haskell.org/ghc/ghc/-/wikis/migration/9.4?version_id=b60e52482a666d25638d59cd7e86851ddf971dc1#st-is-no-longer-an-instance-of-monadfail)
  of the GHC 9.4 Migration Guide. To adapt to this change, I had to change some
  uses of `fail` to `panic`, and I also had to avoid some partial pattern
  matches in `do`-notation to avoid incurring `MonadFail (ST s)` constraints.
* GHC 9.4 is pickier about undecidable superclass checking. As such, I needed to
  explicitly enable `UndecidableSuperClasses` in a handful of places.
* The following submodule changes were brought in to support building with
  GHC 9.4:
  * `asl-translator`: GaloisInc/asl-translator#51
  * `bv-sized`: GaloisInc/bv-sized#27
  * `bv-sized-float`: GaloisInc/bv-sized-float#4
  * `crucible`: GaloisInc/crucible#1073

    (This also requires bumping the `llvm-pretty`, `llvm-pretty-bc-parser`,
    and `what4` submodules as a side effect)
  * `dismantle`: GaloisInc/dismantle#40
  * `grift`: GaloisInc/grift#8
  * `macaw-loader`: GaloisInc/macaw-loader#17
  * `semmc`: GaloisInc/semmc#79
This commit is contained in:
Ryan Scott 2023-04-01 11:57:46 -04:00
parent 02c2bc468e
commit e55add0b51
15 changed files with 19 additions and 13 deletions

View File

@ -23,6 +23,7 @@ single CFG.
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE UndecidableSuperClasses #-}
module Data.Macaw.CFG.Core
( -- * Stmt level declarations
Stmt(..)

View File

@ -52,6 +52,7 @@ import Data.STRef
import Data.Macaw.CFG.App
import Data.Macaw.CFG.Core
import Data.Macaw.Memory
import qualified Data.Macaw.Panic as P
import Data.Macaw.Types
import Data.Macaw.CFG.Block (TermStmt)
@ -185,7 +186,8 @@ addBinding srcId val = Rewriter $ do
lift $ do
m <- readSTRef ref
when (MapF.member srcId m) $ do
fail $ "Assignment " ++ show srcId ++ " is already bound."
P.panic P.Base "addBinding"
["Assignment " ++ show srcId ++ " is already bound."]
writeSTRef ref $! MapF.insert srcId val m
-- | Return true if values are identical
@ -716,7 +718,8 @@ rewriteValue v =
srcMap <- lift $ readSTRef ref
case MapF.lookup aid srcMap of
Just tgtVal -> pure tgtVal
Nothing -> fail $ "Could not resolve source assignment " ++ show aid ++ "."
Nothing -> P.panic P.Base "rewriteValue"
["Could not resolve source assignment " ++ show aid ++ "."]
Initial r -> pure (Initial r)
-- | Apply optimizations to a statement.

View File

@ -15,6 +15,7 @@ Declares 'Memory', a type for representing segmented memory with permissions.
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableSuperClasses #-}
module Data.Macaw.Memory
( Memory
-- * Inspecting memory

2
deps/asl-translator vendored

@ -1 +1 @@
Subproject commit 83e498bb687b518784504da6db3e6c1b09f64db3
Subproject commit b1d3c6b816ff90a12f31429f65f99866215ad1b1

2
deps/bv-sized vendored

@ -1 +1 @@
Subproject commit 57c5a0399e3e2ebeaddc754e9b721056606c9b6e
Subproject commit d8b0e400101d4491859d5060cf491153ae09ab86

2
deps/bv-sized-float vendored

@ -1 +1 @@
Subproject commit f18e76f244a0f49f043873de650ebb92d1546d07
Subproject commit f6ba3b21379e7c09bc379a32610989b20666b0ef

2
deps/crucible vendored

@ -1 +1 @@
Subproject commit f4145fbed96245f385a91ef3a32e6737df1075ff
Subproject commit ad4a553487eeb5c6bbb5abf4bde26af905bf0254

2
deps/dismantle vendored

@ -1 +1 @@
Subproject commit 48433e7ccb02924b2f4695c8c9f09fb9cfccdfc4
Subproject commit 82849d4aa097e7e802953286339ef9ea5e0e4bf4

2
deps/grift vendored

@ -1 +1 @@
Subproject commit 819a1fedf33501a79ad5fbd6e7ae03dfc7219234
Subproject commit 3fe3056a1d79f27bc8e828bc667653c6595517ca

2
deps/llvm-pretty vendored

@ -1 +1 @@
Subproject commit 64d43d9375a819dc2a2df99fb98df24f049dcfaa
Subproject commit b13493fda7276835a4e19bf13a9fb1b3e08083a9

@ -1 +1 @@
Subproject commit cbcf0954c23da0018df3cc6aae77290ae2efe53b
Subproject commit d541adf5c12e86058cbc1f211456b4ad4a7011a1

2
deps/macaw-loader vendored

@ -1 +1 @@
Subproject commit f69f3a835aeaa532206a0e5595b9f89fa1449fb8
Subproject commit 47d19084a5924f7ebe23f7bc3a89f0f8b314142f

2
deps/semmc vendored

@ -1 +1 @@
Subproject commit 5e77424525e4a6907c83b3ded93a8063679e14a7
Subproject commit 1c6ad57c36c5dd153335d419b7123af48a95b2b4

2
deps/what4 vendored

@ -1 +1 @@
Subproject commit 6c462cd46e0ea9ebbfbd6b6ea237984eeb3dc72a
Subproject commit ffbad75b1ce65577422a19a30a39a5059be8b95f

View File

@ -6,6 +6,7 @@
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE UndecidableInstances #-}
module Data.Macaw.SemMC.Operands (
ExtractValue(..),