mirror of
https://github.com/GaloisInc/macaw.git
synced 2024-11-26 09:22:20 +03:00
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:
parent
02c2bc468e
commit
e55add0b51
@ -23,6 +23,7 @@ single CFG.
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
{-# LANGUAGE UndecidableInstances #-}
|
||||
{-# LANGUAGE UndecidableSuperClasses #-}
|
||||
module Data.Macaw.CFG.Core
|
||||
( -- * Stmt level declarations
|
||||
Stmt(..)
|
||||
|
@ -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.
|
||||
|
@ -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
2
deps/asl-translator
vendored
@ -1 +1 @@
|
||||
Subproject commit 83e498bb687b518784504da6db3e6c1b09f64db3
|
||||
Subproject commit b1d3c6b816ff90a12f31429f65f99866215ad1b1
|
2
deps/bv-sized
vendored
2
deps/bv-sized
vendored
@ -1 +1 @@
|
||||
Subproject commit 57c5a0399e3e2ebeaddc754e9b721056606c9b6e
|
||||
Subproject commit d8b0e400101d4491859d5060cf491153ae09ab86
|
2
deps/bv-sized-float
vendored
2
deps/bv-sized-float
vendored
@ -1 +1 @@
|
||||
Subproject commit f18e76f244a0f49f043873de650ebb92d1546d07
|
||||
Subproject commit f6ba3b21379e7c09bc379a32610989b20666b0ef
|
2
deps/crucible
vendored
2
deps/crucible
vendored
@ -1 +1 @@
|
||||
Subproject commit f4145fbed96245f385a91ef3a32e6737df1075ff
|
||||
Subproject commit ad4a553487eeb5c6bbb5abf4bde26af905bf0254
|
2
deps/dismantle
vendored
2
deps/dismantle
vendored
@ -1 +1 @@
|
||||
Subproject commit 48433e7ccb02924b2f4695c8c9f09fb9cfccdfc4
|
||||
Subproject commit 82849d4aa097e7e802953286339ef9ea5e0e4bf4
|
2
deps/grift
vendored
2
deps/grift
vendored
@ -1 +1 @@
|
||||
Subproject commit 819a1fedf33501a79ad5fbd6e7ae03dfc7219234
|
||||
Subproject commit 3fe3056a1d79f27bc8e828bc667653c6595517ca
|
2
deps/llvm-pretty
vendored
2
deps/llvm-pretty
vendored
@ -1 +1 @@
|
||||
Subproject commit 64d43d9375a819dc2a2df99fb98df24f049dcfaa
|
||||
Subproject commit b13493fda7276835a4e19bf13a9fb1b3e08083a9
|
2
deps/llvm-pretty-bc-parser
vendored
2
deps/llvm-pretty-bc-parser
vendored
@ -1 +1 @@
|
||||
Subproject commit cbcf0954c23da0018df3cc6aae77290ae2efe53b
|
||||
Subproject commit d541adf5c12e86058cbc1f211456b4ad4a7011a1
|
2
deps/macaw-loader
vendored
2
deps/macaw-loader
vendored
@ -1 +1 @@
|
||||
Subproject commit f69f3a835aeaa532206a0e5595b9f89fa1449fb8
|
||||
Subproject commit 47d19084a5924f7ebe23f7bc3a89f0f8b314142f
|
2
deps/semmc
vendored
2
deps/semmc
vendored
@ -1 +1 @@
|
||||
Subproject commit 5e77424525e4a6907c83b3ded93a8063679e14a7
|
||||
Subproject commit 1c6ad57c36c5dd153335d419b7123af48a95b2b4
|
2
deps/what4
vendored
2
deps/what4
vendored
@ -1 +1 @@
|
||||
Subproject commit 6c462cd46e0ea9ebbfbd6b6ea237984eeb3dc72a
|
||||
Subproject commit ffbad75b1ce65577422a19a30a39a5059be8b95f
|
@ -6,6 +6,7 @@
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
{-# LANGUAGE TypeSynonymInstances #-}
|
||||
{-# LANGUAGE UndecidableInstances #-}
|
||||
|
||||
module Data.Macaw.SemMC.Operands (
|
||||
ExtractValue(..),
|
||||
|
Loading…
Reference in New Issue
Block a user