From 43c85cb183433d455c8039a43c323de5759dfc4d Mon Sep 17 00:00:00 2001 From: Samuel Breese Date: Sun, 21 Nov 2021 01:32:26 -0500 Subject: [PATCH 01/47] Initial support for converting Yosys IR to SAWCore --- saw-script.cabal | 3 + src/SAWScript/Interpreter.hs | 12 +++ src/SAWScript/Value.hs | 10 +++ src/SAWScript/Yosys.hs | 157 +++++++++++++++++++++++++++++++++++ src/SAWScript/Yosys/IR.hs | 129 ++++++++++++++++++++++++++++ 5 files changed, 311 insertions(+) create mode 100644 src/SAWScript/Yosys.hs create mode 100644 src/SAWScript/Yosys/IR.hs diff --git a/saw-script.cabal b/saw-script.cabal index 36a3f9bd1b..744f92fdbd 100644 --- a/saw-script.cabal +++ b/saw-script.cabal @@ -174,6 +174,9 @@ library SAWScript.X86 SAWScript.X86Spec + SAWScript.Yosys + SAWScript.Yosys.IR + GHC-options: -O2 -Wall -fno-ignore-asserts -fno-spec-constr-count if impl(ghc == 8.0.1) ghc-options: -Wno-redundant-constraints diff --git a/src/SAWScript/Interpreter.hs b/src/SAWScript/Interpreter.hs index ed8c1fb123..434f4d0f5f 100644 --- a/src/SAWScript/Interpreter.hs +++ b/src/SAWScript/Interpreter.hs @@ -68,6 +68,7 @@ import SAWScript.Proof (newTheoremDB) import SAWScript.Prover.Rewrite(basic_ss) import SAWScript.Prover.Exporter import SAWScript.Prover.MRSolver (emptyMREnv) +import SAWScript.Yosys import Verifier.SAW.Conversion --import Verifier.SAW.PrettySExp import Verifier.SAW.Prim (rethrowEvalError) @@ -3333,6 +3334,17 @@ primitives = Map.fromList --------------------------------------------------------------------- + , prim "yosys_load_module" "String -> TopLevel YosysIR" + (pureVal yosys_load_module) + Experimental + [] + , prim "yosys_extract" "YosysIR -> String -> String -> TopLevel Term" + (pureVal yosys_extract) + Experimental + [] + + --------------------------------------------------------------------- + , prim "mr_solver_prove" "Term -> Term -> TopLevel ()" (scVal (mrSolverProve True)) Experimental diff --git a/src/SAWScript/Value.hs b/src/SAWScript/Value.hs index eed42f404f..93c2fba07d 100644 --- a/src/SAWScript/Value.hs +++ b/src/SAWScript/Value.hs @@ -80,6 +80,7 @@ import SAWScript.Prover.SolverStats import SAWScript.Prover.MRSolver.Term as MRSolver import SAWScript.Crucible.LLVM.Skeleton import SAWScript.X86 (X86Unsupported(..), X86Error(..)) +import SAWScript.Yosys.IR import Verifier.SAW.Name (toShortName) import Verifier.SAW.CryptolEnv as CEnv @@ -162,6 +163,7 @@ data Value | VAIG AIGNetwork | VCFG SAW_CFG | VGhostVar CMS.GhostGlobal + | VYosysModule YosysIR type SAWSimpset = Simpset TheoremNonce @@ -339,6 +341,7 @@ showsPrecValue opts p v = VCFG (JVM_CFG g) -> showString (show g) VGhostVar x -> showParen (p > 10) $ showString "Ghost " . showsPrec 11 x + VYosysModule _ -> showString "<>" VJVMSetup _ -> showString "<>" VJVMMethodSpec _ -> showString "<>" VJVMSetupValue x -> shows x @@ -1035,6 +1038,13 @@ instance FromValue CMS.GhostGlobal where fromValue (VGhostVar r) = r fromValue v = error ("fromValue GlobalVar: " ++ show v) +instance IsValue YosysIR where + toValue = VYosysModule + +instance FromValue YosysIR where + fromValue (VYosysModule ir) = ir + fromValue v = error ("fromValue YosysIR: " ++ show v) + -- Error handling -------------------------------------------------------------- underStateT :: (forall b. m b -> m b) -> StateT s m a -> StateT s m a diff --git a/src/SAWScript/Yosys.hs b/src/SAWScript/Yosys.hs new file mode 100644 index 0000000000..c477d85156 --- /dev/null +++ b/src/SAWScript/Yosys.hs @@ -0,0 +1,157 @@ +{-# Language TemplateHaskell #-} +{-# Language OverloadedStrings #-} +{-# Language RecordWildCards #-} +{-# Language LambdaCase #-} +{-# Language TupleSections #-} + +module SAWScript.Yosys + ( YosysIR + , yosys_load_module + , yosys_extract + ) where + +import Control.Lens.TH (makeLenses) +import Control.Lens (at, (^.)) + +import Control.Monad (forM, foldM) +import Control.Monad.IO.Class (MonadIO(..)) +import Control.Exception (throw) + +import qualified Data.Maybe as Maybe +import qualified Data.List as List +import Data.Map (Map) +import qualified Data.Map as Map +import Data.Text (Text) +import qualified Data.Text as Text +import qualified Data.Graph as Graph + +import qualified Cryptol.TypeCheck.Type as Cryptol + +import qualified Verifier.SAW.SharedTerm as SC +import qualified Verifier.SAW.TypedTerm as SC + +import SAWScript.Panic (panic) +import SAWScript.Value +import SAWScript.Yosys.IR + +-------------------------------------------------------------------------------- +-- ** Building a network graph from Yosys IR + +data Netgraph = Netgraph + { _netgraphGraph :: Graph.Graph + , _netgraphNodeFromVertex :: Graph.Vertex -> (Cell, [Bitrep], [[Bitrep]]) + , _netgraphVertexFromKey :: [Bitrep] -> Maybe Graph.Vertex + } +makeLenses ''Netgraph + +moduleNetgraph :: Module -> Netgraph +moduleNetgraph m = + let + cellToNodes :: Cell -> [(Cell, [Bitrep], [[Bitrep]])] + cellToNodes c = (c, , inputBits) <$> outputBits + where + inputBits = List.nub + . Maybe.mapMaybe + ( \(p, bits) -> + case c ^. cellPortDirections . at p of + Just DirectionInput -> Just bits + Just DirectionInout -> Just bits + _ -> Nothing + ) + . Map.assocs + $ c ^. cellConnections + outputBits = List.nub + . Maybe.mapMaybe + ( \(p, bits) -> + case c ^. cellPortDirections . at p of + Just DirectionOutput -> Just bits + Just DirectionInout -> Just bits + _ -> Nothing + ) + . Map.assocs + $ c ^. cellConnections + nodes = concatMap cellToNodes . Map.elems $ m ^. moduleCells + (_netgraphGraph, _netgraphNodeFromVertex, _netgraphVertexFromKey) + = Graph.graphFromEdges nodes + in Netgraph{..} + +cellToTerm :: MonadIO m => SC.SharedContext -> Cell -> [SC.Term] -> m SC.Term +cellToTerm sc c args = case c ^. cellType of + CellTypeOr -> do + w <- liftIO $ SC.scNat sc $ case Map.lookup "Y" $ c ^. cellConnections of + Nothing -> panic "cellToTerm" ["Missing expected output name for $or cell"] + Just bits -> fromIntegral $ length bits + identity <- liftIO $ SC.scBvBool sc w =<< SC.scBool sc False + liftIO $ foldM (SC.scBvOr sc w) identity args + CellTypeAnd -> do + w <- liftIO $ SC.scNat sc $ case Map.lookup "Y" $ c ^. cellConnections of + Nothing -> panic "cellToTerm" ["Missing expected output name for $and cell"] + Just bits -> fromIntegral $ length bits + identity <- liftIO $ SC.scBvBool sc w =<< SC.scBool sc True + liftIO $ foldM (SC.scBvAnd sc w) identity args + +netgraphToTerms :: MonadIO m => SC.SharedContext -> Netgraph -> Map [Bitrep] SC.Term -> m (Map [Bitrep] SC.Term) +netgraphToTerms sc ng inputs = do + let sorted = Graph.reverseTopSort $ ng ^. netgraphGraph + foldM + ( \acc v -> do + let (c, out, inp) = ng ^. netgraphNodeFromVertex $ v + args <- forM inp $ \i -> + -- TODO: be smarter on this lookup! may want to insert terms for individual bits. + case Map.lookup i acc of + Just t -> pure t + Nothing -> throw . YosysError $ "Failed to find output bitvec: " <> Text.pack (show i) + t <- cellToTerm sc c args + pure $ Map.insert out t acc + ) + inputs + sorted + +-------------------------------------------------------------------------------- +-- ** Building a SAWCore term from a network graph + +yosysIRToTerm :: MonadIO m => SC.SharedContext -> YosysIR -> Text -> Text -> m SC.TypedTerm +yosysIRToTerm sc ir modnm portnm = do + m <- case Map.lookup modnm $ ir ^. yosysModules of + Just m -> pure m + Nothing -> throw . YosysError $ "Failed to find module: " <> modnm -- + p <- case Map.lookup portnm $ m ^. modulePorts of + Just p + | p ^. portDirection == DirectionOutput + || p ^. portDirection == DirectionInout + -> pure p + | otherwise -> throw . YosysError $ mconcat ["Port ", portnm, " is not an output port"] + Nothing -> throw . YosysError $ "Failed to find port: " <> portnm + let ng = moduleNetgraph m + let inputports = Maybe.mapMaybe + ( \(nm, ip) -> + if ip ^. portDirection == DirectionInput || ip ^. portDirection == DirectionInout + then Just (nm, ip ^. portBits) + else Nothing + ) + . Map.assocs + $ m ^. modulePorts + inputs <- fmap Map.fromList . forM inputports $ \(nm, inp) -> do + tp <- liftIO . SC.scBitvector sc . fromIntegral $ length inp + ec <- liftIO $ SC.scFreshEC sc nm tp + t <- liftIO $ SC.scExtCns sc ec + pure (inp, t) + env <- netgraphToTerms sc ng inputs + case Map.lookup (p ^. portBits) env of + Just t -> do + let cty = Cryptol.tWord (Cryptol.tNum . length $ p ^. portBits) + pure $ SC.TypedTerm (SC.TypedTermSchema (Cryptol.tMono cty)) t + Nothing -> throw . YosysError $ "Failed to find output for bits: " <> (Text.pack . show $ p ^. portBits) + +-------------------------------------------------------------------------------- +-- ** Functions visible from SAWScript REPL + +{-# ANN module ("HLint: ignore Use camelCase" :: String) #-} + +yosys_load_module :: FilePath -> TopLevel YosysIR +yosys_load_module = loadYosysIR + +yosys_extract :: YosysIR -> String -> String -> TopLevel SC.TypedTerm +yosys_extract ir modnm portnm = do + sc <- getSharedContext + yosysIRToTerm sc ir (Text.pack modnm) (Text.pack portnm) diff --git a/src/SAWScript/Yosys/IR.hs b/src/SAWScript/Yosys/IR.hs new file mode 100644 index 0000000000..9cd8674d69 --- /dev/null +++ b/src/SAWScript/Yosys/IR.hs @@ -0,0 +1,129 @@ +{-# Language TemplateHaskell #-} +{-# Language OverloadedStrings #-} +{-# Language RecordWildCards #-} +{-# Language LambdaCase #-} +{-# Language TupleSections #-} + +module SAWScript.Yosys.IR where + +import Control.Lens.TH (makeLenses) + +import Control.Monad.IO.Class (MonadIO(..)) +import Control.Exception (Exception, throw) + +import Data.Map (Map) +import Data.Text (Text) +import qualified Data.Text as Text + +import qualified Data.Aeson as Aeson + +-------------------------------------------------------------------------------- +-- ** Representing and loading the Yosys JSON IR + +newtype YosysError = YosysError Text + deriving Show +instance Exception YosysError + +data Direction + = DirectionInput + | DirectionOutput + | DirectionInout + deriving (Show, Eq, Ord) +instance Aeson.FromJSON Direction where + parseJSON (Aeson.String "input") = pure DirectionInput + parseJSON (Aeson.String "output") = pure DirectionOutput + parseJSON (Aeson.String "inout") = pure DirectionInout + parseJSON v = fail $ "Failed to parse direction: " <> show v + +data Bitrep + = BitrepZero + | BitrepOne + | BitrepX + | BitrepZ + | Bitrep Integer + deriving (Show, Eq, Ord) +instance Aeson.FromJSON Bitrep where + parseJSON (Aeson.String "0") = pure BitrepZero + parseJSON (Aeson.String "1") = pure BitrepOne + parseJSON (Aeson.String "x") = pure BitrepX + parseJSON (Aeson.String "z") = pure BitrepZ + parseJSON vn@Aeson.Number{} = Bitrep <$> Aeson.parseJSON vn + parseJSON v = fail $ "Failed to parse bits: " <> show v + +data Port = Port + { _portDirection :: Direction + , _portBits :: [Bitrep] + , _portOffset :: Integer + , _portUpto :: Bool + } deriving (Show, Eq, Ord) +makeLenses ''Port +instance Aeson.FromJSON Port where + parseJSON = Aeson.withObject "port" $ \o -> do + _portDirection <- o Aeson..: "direction" + _portBits <- o Aeson..: "bits" + _portOffset <- o Aeson..:? "offset" >>= \case + Just off -> pure off + Nothing -> pure 0 + _portUpto <- o Aeson..:? "upto" >>= \case + Just (Aeson.Number 1) -> pure True + _ -> pure False + pure Port{..} + +data CellType + = CellTypeOr + | CellTypeAnd + deriving (Show, Eq, Ord) +instance Aeson.FromJSON CellType where + parseJSON (Aeson.String "$or") = pure CellTypeOr + parseJSON (Aeson.String "$and") = pure CellTypeAnd + parseJSON v = fail $ "Failed to parse cell type: " <> show v + +data Cell = Cell + { _cellHideName :: Bool + , _cellType :: CellType + , _cellParameters :: Map Text Text + , _cellAttributes :: Aeson.Value + , _cellPortDirections :: Map Text Direction + , _cellConnections :: Map Text [Bitrep] + } deriving (Show, Eq, Ord) +makeLenses ''Cell +instance Aeson.FromJSON Cell where + parseJSON = Aeson.withObject "cell" $ \o -> do + _cellHideName <- o Aeson..:? "hide_name" >>= \case + Just (Aeson.Number 1) -> pure True + _ -> pure False + _cellType <- o Aeson..: "type" + _cellParameters <- o Aeson..: "parameters" + _cellAttributes <- o Aeson..: "attributes" + _cellPortDirections <- o Aeson..: "port_directions" + _cellConnections <- o Aeson..: "connections" + pure Cell{..} + +data Module = Module + { _moduleAttributes :: Aeson.Value + , _modulePorts :: Map Text Port + , _moduleCells :: Map Text Cell + } deriving (Show, Eq, Ord) +makeLenses ''Module +instance Aeson.FromJSON Module where + parseJSON = Aeson.withObject "module" $ \o -> do + _moduleAttributes <- o Aeson..: "attributes" + _modulePorts <- o Aeson..: "ports" + _moduleCells <- o Aeson..: "cells" + pure Module{..} + +data YosysIR = YosysIR + { _yosysCreator :: Text + , _yosysModules :: Map Text Module + } deriving (Show, Eq, Ord) +makeLenses ''YosysIR +instance Aeson.FromJSON YosysIR where + parseJSON = Aeson.withObject "yosys" $ \o -> do + _yosysCreator <- o Aeson..: "creator" + _yosysModules <- o Aeson..: "modules" + pure YosysIR{..} + +loadYosysIR :: MonadIO m => FilePath -> m YosysIR +loadYosysIR p = liftIO $ Aeson.eitherDecodeFileStrict p >>= \case + Left err -> throw . YosysError $ Text.pack err + Right ir -> pure ir From f694ecec85efcf92ed78374219386bcdc0fd8cbb Mon Sep 17 00:00:00 2001 From: Samuel Breese Date: Mon, 3 Jan 2022 12:52:48 -0500 Subject: [PATCH 02/47] Split and join terms that don't line up exactly --- src/SAWScript/Yosys.hs | 74 ++++++++++++++++++++++++++++++------------ 1 file changed, 54 insertions(+), 20 deletions(-) diff --git a/src/SAWScript/Yosys.hs b/src/SAWScript/Yosys.hs index c477d85156..9abb7ad397 100644 --- a/src/SAWScript/Yosys.hs +++ b/src/SAWScript/Yosys.hs @@ -75,8 +75,13 @@ moduleNetgraph m = = Graph.graphFromEdges nodes in Netgraph{..} +-------------------------------------------------------------------------------- +-- ** Building a SAWCore term from a network graph + +-- | Given a Yosys cell and terms for its arguments, construct a term representing the output. cellToTerm :: MonadIO m => SC.SharedContext -> Cell -> [SC.Term] -> m SC.Term cellToTerm sc c args = case c ^. cellType of + -- TODO better handling here. consider multiple-output cells? CellTypeOr -> do w <- liftIO $ SC.scNat sc $ case Map.lookup "Y" $ c ^. cellConnections of Nothing -> panic "cellToTerm" ["Missing expected output name for $or cell"] @@ -90,26 +95,54 @@ cellToTerm sc c args = case c ^. cellType of identity <- liftIO $ SC.scBvBool sc w =<< SC.scBool sc True liftIO $ foldM (SC.scBvAnd sc w) identity args +-- | Given a bit pattern ([Bitrep]) and a term, construct a map associating that output pattern with +-- the term, and each bit of that pattern with the corresponding bit of the term. +deriveTermsByIndices :: MonadIO m => SC.SharedContext -> [Bitrep] -> SC.Term -> m (Map [Bitrep] SC.Term) +deriveTermsByIndices sc rep t = do + boolty <- liftIO $ SC.scBoolType sc + telems <- forM [0..length rep] $ \index -> do + tlen <- liftIO . SC.scNat sc . fromIntegral $ length rep + idx <- liftIO . SC.scNat sc $ fromIntegral index + bit <- liftIO $ SC.scAt sc tlen boolty t idx + liftIO $ SC.scSingle sc boolty bit + pure . Map.fromList $ mconcat + [ [(rep, t)] + , zip ((:[]) <$> rep) telems + ] + +-- | Given a netgraph and an initial map from bit patterns to terms, populate that map with terms +-- generated from the rest of the netgraph. netgraphToTerms :: MonadIO m => SC.SharedContext -> Netgraph -> Map [Bitrep] SC.Term -> m (Map [Bitrep] SC.Term) -netgraphToTerms sc ng inputs = do - let sorted = Graph.reverseTopSort $ ng ^. netgraphGraph - foldM - ( \acc v -> do - let (c, out, inp) = ng ^. netgraphNodeFromVertex $ v - args <- forM inp $ \i -> - -- TODO: be smarter on this lookup! may want to insert terms for individual bits. - case Map.lookup i acc of - Just t -> pure t - Nothing -> throw . YosysError $ "Failed to find output bitvec: " <> Text.pack (show i) - t <- cellToTerm sc c args - pure $ Map.insert out t acc - ) - inputs - sorted - --------------------------------------------------------------------------------- --- ** Building a SAWCore term from a network graph +netgraphToTerms sc ng inputs + | length (Graph.scc $ ng ^. netgraphGraph ) > 1 + = throw $ YosysError "Network graph contains a cycle; SAW does not currently support analysis of sequential circuits." + | otherwise = do + let sorted = Graph.reverseTopSort $ ng ^. netgraphGraph + foldM + ( \acc v -> do + let (c, out, inp) = ng ^. netgraphNodeFromVertex $ v + args <- forM inp $ \i -> -- for each input bit pattern + case Map.lookup i acc of + Just t -> pure t -- if we can find that pattern exactly, great! use that term + Nothing -> do -- otherwise, find each individual bit and append the terms + one <- liftIO $ SC.scNat sc 1 + boolty <- liftIO $ SC.scBoolType sc + many <- liftIO . SC.scNat sc . fromIntegral $ length i + vecty <- liftIO $ SC.scVecType sc many boolty + bits <- case sequence $ flip Map.lookup acc . (:[]) <$> i of + Just bits -> pure bits + Nothing -> throw . YosysError $ "Failed to find output bitvec: " <> Text.pack (show i) + vecBits <- liftIO $ SC.scVector sc vecty bits + liftIO $ SC.scJoin sc many one boolty vecBits + t <- cellToTerm sc c args -- once we've built a term, insert it along with each of its bits + derived <- deriveTermsByIndices sc out t + pure $ Map.union derived acc + ) + inputs + sorted +-- | Given a Yosys IR, the name of a VHDL module, and the name of an output port, construct a +-- SAWCore term for the value of that output port. yosysIRToTerm :: MonadIO m => SC.SharedContext -> YosysIR -> Text -> Text -> m SC.TypedTerm yosysIRToTerm sc ir modnm portnm = do m <- case Map.lookup modnm $ ir ^. yosysModules of @@ -131,11 +164,12 @@ yosysIRToTerm sc ir modnm portnm = do ) . Map.assocs $ m ^. modulePorts - inputs <- fmap Map.fromList . forM inputports $ \(nm, inp) -> do + derivedInputs <- forM inputports $ \(nm, inp) -> do tp <- liftIO . SC.scBitvector sc . fromIntegral $ length inp ec <- liftIO $ SC.scFreshEC sc nm tp t <- liftIO $ SC.scExtCns sc ec - pure (inp, t) + deriveTermsByIndices sc inp t + let inputs = foldr Map.union Map.empty derivedInputs env <- netgraphToTerms sc ng inputs case Map.lookup (p ^. portBits) env of Just t -> do From 31954a5a8364edfcee4701c3011336091cf734de Mon Sep 17 00:00:00 2001 From: Samuel Breese Date: Mon, 3 Jan 2022 13:08:55 -0500 Subject: [PATCH 03/47] Build TypedTerms correctly, put extracted terms inside functions --- src/SAWScript/Yosys.hs | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/src/SAWScript/Yosys.hs b/src/SAWScript/Yosys.hs index 9abb7ad397..7e8b2c14b3 100644 --- a/src/SAWScript/Yosys.hs +++ b/src/SAWScript/Yosys.hs @@ -164,17 +164,18 @@ yosysIRToTerm sc ir modnm portnm = do ) . Map.assocs $ m ^. modulePorts - derivedInputs <- forM inputports $ \(nm, inp) -> do + (derivedInputs, extCns) <- fmap unzip . forM inputports $ \(nm, inp) -> do tp <- liftIO . SC.scBitvector sc . fromIntegral $ length inp ec <- liftIO $ SC.scFreshEC sc nm tp t <- liftIO $ SC.scExtCns sc ec - deriveTermsByIndices sc inp t + derived <- deriveTermsByIndices sc inp t + pure (derived, ec) let inputs = foldr Map.union Map.empty derivedInputs env <- netgraphToTerms sc ng inputs case Map.lookup (p ^. portBits) env of - Just t -> do - let cty = Cryptol.tWord (Cryptol.tNum . length $ p ^. portBits) - pure $ SC.TypedTerm (SC.TypedTermSchema (Cryptol.tMono cty)) t + Just unwrapped -> do + t <- liftIO $ SC.scAbstractExts sc extCns unwrapped + liftIO $ SC.mkTypedTerm sc t Nothing -> throw . YosysError $ "Failed to find output for bits: " <> (Text.pack . show $ p ^. portBits) -------------------------------------------------------------------------------- From 702a4f6cec6bd5acb46377215b89d078deeae752 Mon Sep 17 00:00:00 2001 From: Samuel Breese Date: Mon, 3 Jan 2022 13:15:57 -0500 Subject: [PATCH 04/47] Remove unnecessary import --- src/SAWScript/Yosys.hs | 2 -- 1 file changed, 2 deletions(-) diff --git a/src/SAWScript/Yosys.hs b/src/SAWScript/Yosys.hs index 7e8b2c14b3..74e45a5512 100644 --- a/src/SAWScript/Yosys.hs +++ b/src/SAWScript/Yosys.hs @@ -25,8 +25,6 @@ import Data.Text (Text) import qualified Data.Text as Text import qualified Data.Graph as Graph -import qualified Cryptol.TypeCheck.Type as Cryptol - import qualified Verifier.SAW.SharedTerm as SC import qualified Verifier.SAW.TypedTerm as SC From 28d10fa77fbcb6149ebaebf9d8916efa5328d86a Mon Sep 17 00:00:00 2001 From: Samuel Breese Date: Sat, 22 Jan 2022 21:02:06 -0500 Subject: [PATCH 05/47] Support for user-defined cells --- src/SAWScript/Interpreter.hs | 8 +- src/SAWScript/Yosys.hs | 199 ++++++++++++++++++++++++++--------- src/SAWScript/Yosys/IR.hs | 14 +-- 3 files changed, 154 insertions(+), 67 deletions(-) diff --git a/src/SAWScript/Interpreter.hs b/src/SAWScript/Interpreter.hs index 434f4d0f5f..47066fa0c7 100644 --- a/src/SAWScript/Interpreter.hs +++ b/src/SAWScript/Interpreter.hs @@ -3334,12 +3334,12 @@ primitives = Map.fromList --------------------------------------------------------------------- - , prim "yosys_load_module" "String -> TopLevel YosysIR" - (pureVal yosys_load_module) + , prim "yosys_load_file" "String -> TopLevel YosysIR" + (pureVal yosys_load_file) Experimental [] - , prim "yosys_extract" "YosysIR -> String -> String -> TopLevel Term" - (pureVal yosys_extract) + , prim "yosys_compositional_extract" "YosysIR -> String -> [()] -> ProofScript () -> TopLevel Term" + (pureVal yosys_compositional_extract) Experimental [] diff --git a/src/SAWScript/Yosys.hs b/src/SAWScript/Yosys.hs index 74e45a5512..a5686206b7 100644 --- a/src/SAWScript/Yosys.hs +++ b/src/SAWScript/Yosys.hs @@ -1,22 +1,24 @@ {-# Language TemplateHaskell #-} {-# Language OverloadedStrings #-} {-# Language RecordWildCards #-} +{-# Language ViewPatterns #-} {-# Language LambdaCase #-} {-# Language TupleSections #-} module SAWScript.Yosys ( YosysIR - , yosys_load_module - , yosys_extract + , yosys_load_file + , yosys_compositional_extract ) where import Control.Lens.TH (makeLenses) -import Control.Lens (at, (^.)) +import Control.Lens (at, view, (^.)) import Control.Monad (forM, foldM) import Control.Monad.IO.Class (MonadIO(..)) import Control.Exception (throw) +import qualified Data.Tuple as Tuple import qualified Data.Maybe as Maybe import qualified Data.List as List import Data.Map (Map) @@ -33,7 +35,29 @@ import SAWScript.Value import SAWScript.Yosys.IR -------------------------------------------------------------------------------- --- ** Building a network graph from Yosys IR +-- ** Building the module graph from Yosys IR + +data Modgraph = Modgraph + { _modgraphGraph :: Graph.Graph + , _modgraphNodeFromVertex :: Graph.Vertex -> (Module, Text, [Text]) + , _modgraphVertexFromKey :: Text -> Maybe Graph.Vertex + } +makeLenses ''Modgraph + +yosysIRModgraph :: YosysIR -> Modgraph +yosysIRModgraph ir = + let + moduleToNode :: (Text, Module) -> (Module, Text, [Text]) + moduleToNode (nm, m) = (m, nm, deps) + where + deps = view cellType <$> Map.elems (m ^. moduleCells) + nodes = moduleToNode <$> Map.assocs (ir ^. yosysModules) + (_modgraphGraph, _modgraphNodeFromVertex, _modgraphVertexFromKey) + = Graph.graphFromEdges nodes + in Modgraph{..} + +-------------------------------------------------------------------------------- +-- ** Building a network graph from a Yosys module data Netgraph = Netgraph { _netgraphGraph :: Graph.Graph @@ -42,6 +66,16 @@ data Netgraph = Netgraph } makeLenses ''Netgraph +cellInputConnections :: Cell -> Map Text [Bitrep] +cellInputConnections c = Map.intersection (c ^. cellConnections) inp + where + inp = Map.filter (\d -> d == DirectionInput || d == DirectionInout) $ c ^. cellPortDirections + +cellOutputConnections :: Cell -> Map [Bitrep] Text +cellOutputConnections c = Map.fromList . fmap Tuple.swap . Map.toList $ Map.intersection (c ^. cellConnections) out + where + out = Map.filter (\d -> d == DirectionOutput || d == DirectionInout) $ c ^. cellPortDirections + moduleNetgraph :: Module -> Netgraph moduleNetgraph m = let @@ -76,22 +110,37 @@ moduleNetgraph m = -------------------------------------------------------------------------------- -- ** Building a SAWCore term from a network graph --- | Given a Yosys cell and terms for its arguments, construct a term representing the output. -cellToTerm :: MonadIO m => SC.SharedContext -> Cell -> [SC.Term] -> m SC.Term -cellToTerm sc c args = case c ^. cellType of - -- TODO better handling here. consider multiple-output cells? - CellTypeOr -> do +-- | Given a Yosys cell and a map of terms for its arguments, construct a term representing the output. +cellToTerm :: + MonadIO m => + SC.SharedContext -> + Map Text SC.Term {- ^ Environment of user-defined cells -} -> + Cell {- ^ Cell type -} -> + Map Text SC.Term {- ^ Mapping of input names to input terms -} -> + m SC.Term +cellToTerm sc env c args = case c ^. cellType of + "$or" -> do w <- liftIO $ SC.scNat sc $ case Map.lookup "Y" $ c ^. cellConnections of Nothing -> panic "cellToTerm" ["Missing expected output name for $or cell"] Just bits -> fromIntegral $ length bits identity <- liftIO $ SC.scBvBool sc w =<< SC.scBool sc False - liftIO $ foldM (SC.scBvOr sc w) identity args - CellTypeAnd -> do + res <- liftIO $ foldM (SC.scBvOr sc w) identity args + liftIO . SC.scRecord sc $ Map.fromList + [ ("Y", res) + ] + "$and" -> do w <- liftIO $ SC.scNat sc $ case Map.lookup "Y" $ c ^. cellConnections of Nothing -> panic "cellToTerm" ["Missing expected output name for $and cell"] Just bits -> fromIntegral $ length bits identity <- liftIO $ SC.scBvBool sc w =<< SC.scBool sc True - liftIO $ foldM (SC.scBvAnd sc w) identity args + res <- liftIO $ foldM (SC.scBvAnd sc w) identity args + liftIO . SC.scRecord sc $ Map.fromList + [ ("Y", res) + ] + (flip Map.lookup env -> Just term) -> do + r <- liftIO $ SC.scRecord sc args + liftIO $ SC.scApply sc term r + ct -> throw . YosysError $ "Unknown cell type: " <> ct -- | Given a bit pattern ([Bitrep]) and a term, construct a map associating that output pattern with -- the term, and each bit of that pattern with the corresponding bit of the term. @@ -110,16 +159,25 @@ deriveTermsByIndices sc rep t = do -- | Given a netgraph and an initial map from bit patterns to terms, populate that map with terms -- generated from the rest of the netgraph. -netgraphToTerms :: MonadIO m => SC.SharedContext -> Netgraph -> Map [Bitrep] SC.Term -> m (Map [Bitrep] SC.Term) -netgraphToTerms sc ng inputs - | length (Graph.scc $ ng ^. netgraphGraph ) > 1 - = throw $ YosysError "Network graph contains a cycle; SAW does not currently support analysis of sequential circuits." +netgraphToTerms :: + MonadIO m => + SC.SharedContext -> + Map Text SC.Term -> + Netgraph -> + Map [Bitrep] SC.Term -> + m (Map [Bitrep] SC.Term) +netgraphToTerms sc env ng inputs + | length (Graph.components $ ng ^. netgraphGraph ) > 1 + = do + liftIO . print . Graph.transposeG $ ng ^. netgraphGraph + liftIO $ print (Graph.components $ ng ^. netgraphGraph ) + throw $ YosysError "Network graph contains a cycle; SAW does not currently support analysis of sequential circuits." | otherwise = do let sorted = Graph.reverseTopSort $ ng ^. netgraphGraph foldM ( \acc v -> do let (c, out, inp) = ng ^. netgraphNodeFromVertex $ v - args <- forM inp $ \i -> -- for each input bit pattern + args <- forM (cellInputConnections c) $ \i -> -- for each input bit pattern case Map.lookup i acc of Just t -> pure t -- if we can find that pattern exactly, great! use that term Nothing -> do -- otherwise, find each individual bit and append the terms @@ -132,27 +190,22 @@ netgraphToTerms sc ng inputs Nothing -> throw . YosysError $ "Failed to find output bitvec: " <> Text.pack (show i) vecBits <- liftIO $ SC.scVector sc vecty bits liftIO $ SC.scJoin sc many one boolty vecBits - t <- cellToTerm sc c args -- once we've built a term, insert it along with each of its bits - derived <- deriveTermsByIndices sc out t - pure $ Map.union derived acc + r <- cellToTerm sc env c args -- once we've built a term, insert it along with each of its bits + ts <- forM (cellOutputConnections c) $ \o -> do + t <- liftIO $ SC.scRecordSelect sc r o + deriveTermsByIndices sc out t + pure $ Map.union (Map.unions ts) acc ) inputs sorted --- | Given a Yosys IR, the name of a VHDL module, and the name of an output port, construct a --- SAWCore term for the value of that output port. -yosysIRToTerm :: MonadIO m => SC.SharedContext -> YosysIR -> Text -> Text -> m SC.TypedTerm -yosysIRToTerm sc ir modnm portnm = do - m <- case Map.lookup modnm $ ir ^. yosysModules of - Just m -> pure m - Nothing -> throw . YosysError $ "Failed to find module: " <> modnm -- - p <- case Map.lookup portnm $ m ^. modulePorts of - Just p - | p ^. portDirection == DirectionOutput - || p ^. portDirection == DirectionInout - -> pure p - | otherwise -> throw . YosysError $ mconcat ["Port ", portnm, " is not an output port"] - Nothing -> throw . YosysError $ "Failed to find port: " <> portnm +moduleToTerm :: + MonadIO m => + SC.SharedContext -> + Map Text SC.Term -> + Module -> + m SC.Term +moduleToTerm sc env m = do let ng = moduleNetgraph m let inputports = Maybe.mapMaybe ( \(nm, ip) -> @@ -162,29 +215,71 @@ yosysIRToTerm sc ir modnm portnm = do ) . Map.assocs $ m ^. modulePorts - (derivedInputs, extCns) <- fmap unzip . forM inputports $ \(nm, inp) -> do - tp <- liftIO . SC.scBitvector sc . fromIntegral $ length inp - ec <- liftIO $ SC.scFreshEC sc nm tp - t <- liftIO $ SC.scExtCns sc ec - derived <- deriveTermsByIndices sc inp t - pure (derived, ec) - let inputs = foldr Map.union Map.empty derivedInputs - env <- netgraphToTerms sc ng inputs - case Map.lookup (p ^. portBits) env of - Just unwrapped -> do - t <- liftIO $ SC.scAbstractExts sc extCns unwrapped - liftIO $ SC.mkTypedTerm sc t - Nothing -> throw . YosysError $ "Failed to find output for bits: " <> (Text.pack . show $ p ^. portBits) + let outputports = Maybe.mapMaybe + ( \(nm, ip) -> + if ip ^. portDirection == DirectionOutput || ip ^. portDirection == DirectionInout + then Just (nm, ip ^. portBits) + else Nothing + ) + . Map.assocs + $ m ^. modulePorts + inputRecordType <- liftIO . SC.scRecordType sc =<< forM inputports + (\(nm, inp) -> do + tp <- liftIO . SC.scBitvector sc . fromIntegral $ length inp + pure (nm, tp) + ) + outputRecordType <- liftIO . SC.scRecordType sc =<< forM outputports + (\(nm, out) -> do + tp <- liftIO . SC.scBitvector sc . fromIntegral $ length out + pure (nm, tp) + ) + inputRecordEC <- liftIO $ SC.scFreshEC sc "input" inputRecordType + inputRecord <- liftIO $ SC.scExtCns sc inputRecordEC + derivedInputs <- forM inputports $ \(nm, inp) -> do + t <- liftIO $ SC.scRecordSelect sc inputRecord nm + deriveTermsByIndices sc inp t + let inputs = Map.unions derivedInputs + env <- netgraphToTerms sc env ng inputs + outputRecord <- liftIO . SC.scRecord sc . Map.fromList =<< forM outputports + (\(nm, out) -> do + case Map.lookup out env of + Nothing -> throw . YosysError $ "Failed to find module output bits: " <> Text.pack (show out) + Just t -> pure (nm, t) + ) + liftIO $ SC.scAbstractExts sc [inputRecordEC] outputRecord + +-- | Given a Yosys IR and the name of a VHDL module, construct a SAWCore term for that module. +yosysIRToTerm :: + MonadIO m => + SC.SharedContext -> + YosysIR -> + Text -> + m SC.TypedTerm +yosysIRToTerm sc ir modnm = do + let mg = yosysIRModgraph ir + let sorted = Graph.reverseTopSort $ mg ^. modgraphGraph + env <- foldM + (\acc v -> do + let (m, nm, _) = mg ^. modgraphNodeFromVertex $ v + t <- moduleToTerm sc acc m + pure $ Map.insert nm t acc + ) + Map.empty + sorted + m <- case Map.lookup modnm env of + Just m -> pure m + Nothing -> throw . YosysError $ "Failed to find module: " <> modnm + liftIO $ SC.mkTypedTerm sc m -------------------------------------------------------------------------------- -- ** Functions visible from SAWScript REPL {-# ANN module ("HLint: ignore Use camelCase" :: String) #-} -yosys_load_module :: FilePath -> TopLevel YosysIR -yosys_load_module = loadYosysIR +yosys_load_file :: FilePath -> TopLevel YosysIR +yosys_load_file = loadYosysIR -yosys_extract :: YosysIR -> String -> String -> TopLevel SC.TypedTerm -yosys_extract ir modnm portnm = do +yosys_compositional_extract :: YosysIR -> String -> [()] -> ProofScript () -> TopLevel SC.TypedTerm +yosys_compositional_extract ir modnm _lemmas _tactic = do sc <- getSharedContext - yosysIRToTerm sc ir (Text.pack modnm) (Text.pack portnm) + yosysIRToTerm sc ir (Text.pack modnm) diff --git a/src/SAWScript/Yosys/IR.hs b/src/SAWScript/Yosys/IR.hs index 9cd8674d69..872f7f3ea0 100644 --- a/src/SAWScript/Yosys/IR.hs +++ b/src/SAWScript/Yosys/IR.hs @@ -21,8 +21,9 @@ import qualified Data.Aeson as Aeson -- ** Representing and loading the Yosys JSON IR newtype YosysError = YosysError Text - deriving Show instance Exception YosysError +instance Show YosysError where + show (YosysError msg) = Text.unpack $ "Error: " <> msg data Direction = DirectionInput @@ -69,18 +70,9 @@ instance Aeson.FromJSON Port where _ -> pure False pure Port{..} -data CellType - = CellTypeOr - | CellTypeAnd - deriving (Show, Eq, Ord) -instance Aeson.FromJSON CellType where - parseJSON (Aeson.String "$or") = pure CellTypeOr - parseJSON (Aeson.String "$and") = pure CellTypeAnd - parseJSON v = fail $ "Failed to parse cell type: " <> show v - data Cell = Cell { _cellHideName :: Bool - , _cellType :: CellType + , _cellType :: Text , _cellParameters :: Map Text Text , _cellAttributes :: Aeson.Value , _cellPortDirections :: Map Text Direction From 4f9aacfca5cef5cab1ec9733bb7b342506f1f8e7 Mon Sep 17 00:00:00 2001 From: Samuel Breese Date: Tue, 1 Feb 2022 15:38:08 -0500 Subject: [PATCH 06/47] Use Cryptol record encoding --- src/SAWScript/Yosys.hs | 93 ++++++++++++++++++++++++++++++------------ 1 file changed, 67 insertions(+), 26 deletions(-) diff --git a/src/SAWScript/Yosys.hs b/src/SAWScript/Yosys.hs index a5686206b7..a5990dab39 100644 --- a/src/SAWScript/Yosys.hs +++ b/src/SAWScript/Yosys.hs @@ -30,6 +30,10 @@ import qualified Data.Graph as Graph import qualified Verifier.SAW.SharedTerm as SC import qualified Verifier.SAW.TypedTerm as SC +import qualified Cryptol.TypeCheck.Type as C +import qualified Cryptol.Utils.Ident as C +import qualified Cryptol.Utils.RecordMap as C + import SAWScript.Panic (panic) import SAWScript.Value import SAWScript.Yosys.IR @@ -110,6 +114,42 @@ moduleNetgraph m = -------------------------------------------------------------------------------- -- ** Building a SAWCore term from a network graph +cryptolRecordType :: + MonadIO m => + SC.SharedContext -> + Map Text SC.Term -> + m SC.Term +cryptolRecordType sc fields = + liftIO $ SC.scTupleType sc (fmap snd . C.canonicalFields . C.recordFromFields $ Map.assocs fields) + +cryptolRecord :: + MonadIO m => + SC.SharedContext -> + Map Text SC.Term -> + m SC.Term +cryptolRecord sc fields = + liftIO $ SC.scTuple sc (fmap snd . C.canonicalFields . C.recordFromFields $ Map.assocs fields) + +cryptolRecordSelect :: + MonadIO m => + SC.SharedContext -> + Map Text a -> + SC.Term -> + Text -> + m SC.Term +cryptolRecordSelect sc fields r nm = + case List.elemIndex nm ord of + Just i -> liftIO $ SC.scTupleSelector sc r (i + 1) (length ord) + Nothing -> throw . YosysError $ mconcat + [ "Could not build record selector term for field name \"" + , nm + , "\" on record term: " + , Text.pack $ show r + , "\nFields are: " + , Text.pack $ show $ Map.keys fields + ] + where ord = fmap fst . C.canonicalFields . C.recordFromFields $ Map.assocs fields + -- | Given a Yosys cell and a map of terms for its arguments, construct a term representing the output. cellToTerm :: MonadIO m => @@ -125,7 +165,7 @@ cellToTerm sc env c args = case c ^. cellType of Just bits -> fromIntegral $ length bits identity <- liftIO $ SC.scBvBool sc w =<< SC.scBool sc False res <- liftIO $ foldM (SC.scBvOr sc w) identity args - liftIO . SC.scRecord sc $ Map.fromList + cryptolRecord sc $ Map.fromList [ ("Y", res) ] "$and" -> do @@ -134,11 +174,11 @@ cellToTerm sc env c args = case c ^. cellType of Just bits -> fromIntegral $ length bits identity <- liftIO $ SC.scBvBool sc w =<< SC.scBool sc True res <- liftIO $ foldM (SC.scBvAnd sc w) identity args - liftIO . SC.scRecord sc $ Map.fromList + cryptolRecord sc $ Map.fromList [ ("Y", res) ] (flip Map.lookup env -> Just term) -> do - r <- liftIO $ SC.scRecord sc args + r <- cryptolRecord sc args liftIO $ SC.scApply sc term r ct -> throw . YosysError $ "Unknown cell type: " <> ct @@ -176,7 +216,7 @@ netgraphToTerms sc env ng inputs let sorted = Graph.reverseTopSort $ ng ^. netgraphGraph foldM ( \acc v -> do - let (c, out, inp) = ng ^. netgraphNodeFromVertex $ v + let (c, out, _) = ng ^. netgraphNodeFromVertex $ v args <- forM (cellInputConnections c) $ \i -> -- for each input bit pattern case Map.lookup i acc of Just t -> pure t -- if we can find that pattern exactly, great! use that term @@ -191,8 +231,9 @@ netgraphToTerms sc env ng inputs vecBits <- liftIO $ SC.scVector sc vecty bits liftIO $ SC.scJoin sc many one boolty vecBits r <- cellToTerm sc env c args -- once we've built a term, insert it along with each of its bits + let fields = Map.filter (\d -> d == DirectionOutput || d == DirectionInout) $ c ^. cellPortDirections ts <- forM (cellOutputConnections c) $ \o -> do - t <- liftIO $ SC.scRecordSelect sc r o + t <- cryptolRecordSelect sc fields r o deriveTermsByIndices sc out t pure $ Map.union (Map.unions ts) acc ) @@ -204,7 +245,7 @@ moduleToTerm :: SC.SharedContext -> Map Text SC.Term -> Module -> - m SC.Term + m (SC.Term, SC.TypedTermType) moduleToTerm sc env m = do let ng = moduleNetgraph m let inputports = Maybe.mapMaybe @@ -223,30 +264,30 @@ moduleToTerm sc env m = do ) . Map.assocs $ m ^. modulePorts - inputRecordType <- liftIO . SC.scRecordType sc =<< forM inputports + inputRecordType <- cryptolRecordType sc . Map.fromList =<< forM inputports (\(nm, inp) -> do tp <- liftIO . SC.scBitvector sc . fromIntegral $ length inp pure (nm, tp) ) - outputRecordType <- liftIO . SC.scRecordType sc =<< forM outputports - (\(nm, out) -> do - tp <- liftIO . SC.scBitvector sc . fromIntegral $ length out - pure (nm, tp) - ) inputRecordEC <- liftIO $ SC.scFreshEC sc "input" inputRecordType inputRecord <- liftIO $ SC.scExtCns sc inputRecordEC derivedInputs <- forM inputports $ \(nm, inp) -> do - t <- liftIO $ SC.scRecordSelect sc inputRecord nm + t <- liftIO $ cryptolRecordSelect sc (Map.fromList inputports) inputRecord nm deriveTermsByIndices sc inp t let inputs = Map.unions derivedInputs - env <- netgraphToTerms sc env ng inputs - outputRecord <- liftIO . SC.scRecord sc . Map.fromList =<< forM outputports + terms <- netgraphToTerms sc env ng inputs + outputRecord <- cryptolRecord sc . Map.fromList =<< forM outputports (\(nm, out) -> do - case Map.lookup out env of + case Map.lookup out terms of Nothing -> throw . YosysError $ "Failed to find module output bits: " <> Text.pack (show out) Just t -> pure (nm, t) ) - liftIO $ SC.scAbstractExts sc [inputRecordEC] outputRecord + t <- liftIO $ SC.scAbstractExts sc [inputRecordEC] outputRecord + let toCryptol (nm, rep) = (C.mkIdent nm, C.tWord . C.tNum $ length rep) + let cty = C.tFun + (C.tRec . C.recordFromFields $ toCryptol <$> inputports) + (C.tRec . C.recordFromFields $ toCryptol <$> outputports) + pure (t, SC.TypedTermSchema $ C.tMono cty) -- | Given a Yosys IR and the name of a VHDL module, construct a SAWCore term for that module. yosysIRToTerm :: @@ -258,18 +299,18 @@ yosysIRToTerm :: yosysIRToTerm sc ir modnm = do let mg = yosysIRModgraph ir let sorted = Graph.reverseTopSort $ mg ^. modgraphGraph - env <- foldM - (\acc v -> do + (termEnv, typeEnv) <- foldM + (\(termEnv, typeEnv) v -> do let (m, nm, _) = mg ^. modgraphNodeFromVertex $ v - t <- moduleToTerm sc acc m - pure $ Map.insert nm t acc + (t, schema) <- moduleToTerm sc termEnv m + pure (Map.insert nm t termEnv, Map.insert nm schema typeEnv) ) - Map.empty + (Map.empty, Map.empty) sorted - m <- case Map.lookup modnm env of - Just m -> pure m - Nothing -> throw . YosysError $ "Failed to find module: " <> modnm - liftIO $ SC.mkTypedTerm sc m + (m, schema) <- case (Map.lookup modnm termEnv, Map.lookup modnm typeEnv) of + (Just m, Just schema) -> pure (m, schema) + _ -> throw . YosysError $ "Failed to find module: " <> modnm + pure $ SC.TypedTerm schema m -------------------------------------------------------------------------------- -- ** Functions visible from SAWScript REPL From 9f2df2896691663899754df6638d36758567056e Mon Sep 17 00:00:00 2001 From: Samuel Breese Date: Wed, 9 Feb 2022 21:32:25 -0500 Subject: [PATCH 07/47] Implement some more cell types --- src/SAWScript/Yosys.hs | 137 +++++++++++++++++++++++++++++++++++------ 1 file changed, 117 insertions(+), 20 deletions(-) diff --git a/src/SAWScript/Yosys.hs b/src/SAWScript/Yosys.hs index a5990dab39..800165209d 100644 --- a/src/SAWScript/Yosys.hs +++ b/src/SAWScript/Yosys.hs @@ -4,6 +4,7 @@ {-# Language ViewPatterns #-} {-# Language LambdaCase #-} {-# Language TupleSections #-} +{-# Language ScopedTypeVariables #-} module SAWScript.Yosys ( YosysIR @@ -20,6 +21,7 @@ import Control.Exception (throw) import qualified Data.Tuple as Tuple import qualified Data.Maybe as Maybe +import qualified Data.Foldable as Foldable import qualified Data.List as List import Data.Map (Map) import qualified Data.Map as Map @@ -29,6 +31,7 @@ import qualified Data.Graph as Graph import qualified Verifier.SAW.SharedTerm as SC import qualified Verifier.SAW.TypedTerm as SC +import qualified Verifier.SAW.Name as SC import qualified Cryptol.TypeCheck.Type as C import qualified Cryptol.Utils.Ident as C @@ -44,7 +47,7 @@ import SAWScript.Yosys.IR data Modgraph = Modgraph { _modgraphGraph :: Graph.Graph , _modgraphNodeFromVertex :: Graph.Vertex -> (Module, Text, [Text]) - , _modgraphVertexFromKey :: Text -> Maybe Graph.Vertex + -- , _modgraphVertexFromKey :: Text -> Maybe Graph.Vertex } makeLenses ''Modgraph @@ -66,7 +69,7 @@ yosysIRModgraph ir = data Netgraph = Netgraph { _netgraphGraph :: Graph.Graph , _netgraphNodeFromVertex :: Graph.Vertex -> (Cell, [Bitrep], [[Bitrep]]) - , _netgraphVertexFromKey :: [Bitrep] -> Maybe Graph.Vertex + -- , _netgraphVertexFromKey :: [Bitrep] -> Maybe Graph.Vertex } makeLenses ''Netgraph @@ -152,6 +155,7 @@ cryptolRecordSelect sc fields r nm = -- | Given a Yosys cell and a map of terms for its arguments, construct a term representing the output. cellToTerm :: + forall m. MonadIO m => SC.SharedContext -> Map Text SC.Term {- ^ Environment of user-defined cells -} -> @@ -159,28 +163,121 @@ cellToTerm :: Map Text SC.Term {- ^ Mapping of input names to input terms -} -> m SC.Term cellToTerm sc env c args = case c ^. cellType of - "$or" -> do - w <- liftIO $ SC.scNat sc $ case Map.lookup "Y" $ c ^. cellConnections of - Nothing -> panic "cellToTerm" ["Missing expected output name for $or cell"] - Just bits -> fromIntegral $ length bits - identity <- liftIO $ SC.scBvBool sc w =<< SC.scBool sc False - res <- liftIO $ foldM (SC.scBvOr sc w) identity args - cryptolRecord sc $ Map.fromList - [ ("Y", res) - ] - "$and" -> do - w <- liftIO $ SC.scNat sc $ case Map.lookup "Y" $ c ^. cellConnections of - Nothing -> panic "cellToTerm" ["Missing expected output name for $and cell"] - Just bits -> fromIntegral $ length bits - identity <- liftIO $ SC.scBvBool sc w =<< SC.scBool sc True - res <- liftIO $ foldM (SC.scBvAnd sc w) identity args - cryptolRecord sc $ Map.fromList - [ ("Y", res) - ] + "$not" -> bvUnaryOp $ SC.scBvNot sc + "$pos" -> input "A" + "$neg" -> bvUnaryOp $ SC.scBvNeg sc + "$and" -> bvNAryOp $ SC.scBvAnd sc + "$or" -> bvNAryOp $ SC.scBvOr sc + "$xor" -> bvNAryOp $ SC.scBvXor sc + "$xnor" -> bvNAryOp $ \w x y -> do + r <- SC.scBvXor sc w x y + SC.scBvNot sc w r + "$reduce_and" -> bvReduce True =<< do + liftIO . SC.scLookupDef sc $ SC.mkIdent SC.preludeName "and" + "$reduce_or" -> bvReduce False =<< do + liftIO . SC.scLookupDef sc $ SC.mkIdent SC.preludeName "or" + "$reduce_xor" -> bvReduce False =<< do + liftIO . SC.scLookupDef sc $ SC.mkIdent SC.preludeName "xor" + "$reduce_xnor" -> bvReduce True =<< do + boolTy <- liftIO $ SC.scBoolType sc + xEC <- liftIO $ SC.scFreshEC sc "x" boolTy + x <- liftIO $ SC.scExtCns sc xEC + yEC <- liftIO $ SC.scFreshEC sc "y" boolTy + y <- liftIO $ SC.scExtCns sc yEC + r <- liftIO $ SC.scXor sc x y + res <- liftIO $ SC.scNot sc r + liftIO $ SC.scAbstractExts sc [xEC, yEC] res + "$reduce_bool" -> bvReduce False =<< do + liftIO . SC.scLookupDef sc $ SC.mkIdent SC.preludeName "or" + "$shl" -> bvBinaryOp $ SC.scBvShl sc + "$shr" -> bvBinaryOp $ SC.scBvShr sc + "$sshl" -> bvBinaryOp $ SC.scBvShl sc -- same as shl + "$sshr" -> bvBinaryOp $ SC.scBvSShr sc + -- "$shift" -> _ + -- "$shiftx" -> _ + "$lt" -> bvBinaryOp $ SC.scBvULt sc + "$le" -> bvBinaryOp $ SC.scBvULe sc + "$gt" -> bvBinaryOp $ SC.scBvUGt sc + "$ge" -> bvBinaryOp $ SC.scBvUGe sc + "$eq" -> bvBinaryOp $ SC.scBvEq sc + "$ne" -> bvBinaryOp $ \w x y -> do + r <- SC.scBvEq sc w x y + SC.scNot sc r + "$eqx" -> bvBinaryOp $ SC.scBvEq sc + "$nex" -> bvBinaryOp $ \w x y -> do + r <- SC.scBvEq sc w x y + SC.scNot sc r + "$add" -> bvNAryOp $ SC.scBvAdd sc + "$sub" -> bvBinaryOp $ SC.scBvSub sc + "$mul" -> bvNAryOp $ SC.scBvMul sc + "$div" -> bvBinaryOp $ SC.scBvUDiv sc + "$mod" -> bvBinaryOp $ SC.scBvURem sc + -- "$modfloor" -> _ + -- "$logic_not" -> _ + -- "$logic_and" -> _ + "$logic_or" -> bvReduce False =<< do + liftIO . SC.scLookupDef sc $ SC.mkIdent SC.preludeName "or" + -- "$mux" -> _ + -- "$pmux" -> _ + -- "$bmux" -> _ + -- "$demux" -> _ + -- "$lut" -> _ + -- "$slice" -> _ + -- "$concat" -> _ (flip Map.lookup env -> Just term) -> do r <- cryptolRecord sc args liftIO $ SC.scApply sc term r ct -> throw . YosysError $ "Unknown cell type: " <> ct + where + nm = c ^. cellType + outputWidth :: m SC.Term + outputWidth = + liftIO $ SC.scNat sc $ case Map.lookup "Y" $ c ^. cellConnections of + Nothing -> panic "cellToTerm" [Text.unpack $ mconcat ["Missing expected output name for ", nm, " cell"]] + Just bits -> fromIntegral $ length bits + input :: Text -> m SC.Term + input inpNm = + case Map.lookup inpNm args of + Nothing -> panic "cellToTerm" [Text.unpack $ mconcat [nm, " missing input ", inpNm]] + Just a -> pure a + bvUnaryOp :: (SC.Term -> SC.Term -> IO SC.Term) -> m SC.Term + bvUnaryOp f = do + t <- input "A" + w <- outputWidth + res <- liftIO $ f w t + cryptolRecord sc $ Map.fromList + [ ("Y", res) + ] + bvBinaryOp :: (SC.Term -> SC.Term -> SC.Term -> IO SC.Term) -> m SC.Term + bvBinaryOp f = do + ta <- input "A" + tb <- input "B" + w <- outputWidth + res <- liftIO $ f w ta tb + cryptolRecord sc $ Map.fromList + [ ("Y", res) + ] + bvNAryOp :: (SC.Term -> SC.Term -> SC.Term -> IO SC.Term) -> m SC.Term + bvNAryOp f = + case Foldable.toList args of + [] -> panic "cellToTerm" [Text.unpack $ mconcat [nm, " cell given no inputs"]] + (t:rest) -> do + w <- outputWidth + res <- liftIO $ foldM (f w) t rest + cryptolRecord sc $ Map.fromList + [ ("Y", res) + ] + bvReduce :: Bool -> SC.Term -> m SC.Term + bvReduce boolIdentity boolFun = do + t <- input "A" + w <- outputWidth + boolTy <- liftIO $ SC.scBoolType sc + identity <- liftIO $ SC.scBool sc boolIdentity + scFoldr <- liftIO . SC.scLookupDef sc $ SC.mkIdent SC.preludeName "foldr" + res <- liftIO $ SC.scApplyAll sc scFoldr [boolTy, boolTy, w, boolFun, identity, t] + cryptolRecord sc $ Map.fromList + [ ("Y", res) + ] -- | Given a bit pattern ([Bitrep]) and a term, construct a map associating that output pattern with -- the term, and each bit of that pattern with the corresponding bit of the term. From da97203a63f676b3c4668ee3c404b3a85bb84c2c Mon Sep 17 00:00:00 2001 From: Samuel Breese Date: Fri, 11 Feb 2022 12:17:48 -0500 Subject: [PATCH 08/47] Improved interface; now Yosys files are imported as records --- src/SAWScript/Interpreter.hs | 8 ++--- src/SAWScript/Yosys.hs | 57 +++++++++++++++++++++--------------- 2 files changed, 36 insertions(+), 29 deletions(-) diff --git a/src/SAWScript/Interpreter.hs b/src/SAWScript/Interpreter.hs index 47066fa0c7..a96fc69501 100644 --- a/src/SAWScript/Interpreter.hs +++ b/src/SAWScript/Interpreter.hs @@ -3334,12 +3334,8 @@ primitives = Map.fromList --------------------------------------------------------------------- - , prim "yosys_load_file" "String -> TopLevel YosysIR" - (pureVal yosys_load_file) - Experimental - [] - , prim "yosys_compositional_extract" "YosysIR -> String -> [()] -> ProofScript () -> TopLevel Term" - (pureVal yosys_compositional_extract) + , prim "yosys_import" "String -> TopLevel Term" + (pureVal yosys_import) Experimental [] diff --git a/src/SAWScript/Yosys.hs b/src/SAWScript/Yosys.hs index 800165209d..6b4c6130d2 100644 --- a/src/SAWScript/Yosys.hs +++ b/src/SAWScript/Yosys.hs @@ -8,8 +8,7 @@ module SAWScript.Yosys ( YosysIR - , yosys_load_file - , yosys_compositional_extract + , yosys_import ) where import Control.Lens.TH (makeLenses) @@ -19,6 +18,7 @@ import Control.Monad (forM, foldM) import Control.Monad.IO.Class (MonadIO(..)) import Control.Exception (throw) +import Data.Bifunctor (first) import qualified Data.Tuple as Tuple import qualified Data.Maybe as Maybe import qualified Data.Foldable as Foldable @@ -213,10 +213,25 @@ cellToTerm sc env c args = case c ^. cellType of "$div" -> bvBinaryOp $ SC.scBvUDiv sc "$mod" -> bvBinaryOp $ SC.scBvURem sc -- "$modfloor" -> _ - -- "$logic_not" -> _ - -- "$logic_and" -> _ - "$logic_or" -> bvReduce False =<< do - liftIO . SC.scLookupDef sc $ SC.mkIdent SC.preludeName "or" + "$logic_not" -> do + w <- outputWidth + ta <- input "A" + anz <- liftIO $ SC.scBvNonzero sc w ta + liftIO $ SC.scNot sc anz + "$logic_and" -> do + w <- outputWidth + ta <- input "A" + tb <- input "B" + anz <- liftIO $ SC.scBvNonzero sc w ta + bnz <- liftIO $ SC.scBvNonzero sc w tb + liftIO $ SC.scAnd sc anz bnz + "$logic_or" -> do + w <- outputWidth + ta <- input "A" + tb <- input "B" + anz <- liftIO $ SC.scBvNonzero sc w ta + bnz <- liftIO $ SC.scBvNonzero sc w tb + liftIO $ SC.scOr sc anz bnz -- "$mux" -> _ -- "$pmux" -> _ -- "$bmux" -> _ @@ -342,7 +357,7 @@ moduleToTerm :: SC.SharedContext -> Map Text SC.Term -> Module -> - m (SC.Term, SC.TypedTermType) + m (SC.Term, C.Type) moduleToTerm sc env m = do let ng = moduleNetgraph m let inputports = Maybe.mapMaybe @@ -384,40 +399,36 @@ moduleToTerm sc env m = do let cty = C.tFun (C.tRec . C.recordFromFields $ toCryptol <$> inputports) (C.tRec . C.recordFromFields $ toCryptol <$> outputports) - pure (t, SC.TypedTermSchema $ C.tMono cty) + pure (t, cty) -- | Given a Yosys IR and the name of a VHDL module, construct a SAWCore term for that module. -yosysIRToTerm :: +yosysIRToRecordTerm :: MonadIO m => SC.SharedContext -> YosysIR -> - Text -> m SC.TypedTerm -yosysIRToTerm sc ir modnm = do +yosysIRToRecordTerm sc ir = do let mg = yosysIRModgraph ir let sorted = Graph.reverseTopSort $ mg ^. modgraphGraph (termEnv, typeEnv) <- foldM (\(termEnv, typeEnv) v -> do let (m, nm, _) = mg ^. modgraphNodeFromVertex $ v - (t, schema) <- moduleToTerm sc termEnv m - pure (Map.insert nm t termEnv, Map.insert nm schema typeEnv) + (t, ty) <- moduleToTerm sc termEnv m + pure (Map.insert nm t termEnv, Map.insert nm ty typeEnv) ) (Map.empty, Map.empty) sorted - (m, schema) <- case (Map.lookup modnm termEnv, Map.lookup modnm typeEnv) of - (Just m, Just schema) -> pure (m, schema) - _ -> throw . YosysError $ "Failed to find module: " <> modnm - pure $ SC.TypedTerm schema m + let cty = C.tRec . C.recordFromFields $ first C.mkIdent <$> Map.assocs typeEnv + record <- cryptolRecord sc termEnv + pure $ SC.TypedTerm (SC.TypedTermSchema $ C.tMono cty) record -------------------------------------------------------------------------------- -- ** Functions visible from SAWScript REPL {-# ANN module ("HLint: ignore Use camelCase" :: String) #-} -yosys_load_file :: FilePath -> TopLevel YosysIR -yosys_load_file = loadYosysIR - -yosys_compositional_extract :: YosysIR -> String -> [()] -> ProofScript () -> TopLevel SC.TypedTerm -yosys_compositional_extract ir modnm _lemmas _tactic = do +yosys_import :: FilePath -> TopLevel SC.TypedTerm +yosys_import path = do sc <- getSharedContext - yosysIRToTerm sc ir (Text.pack modnm) + ir <- loadYosysIR path + yosysIRToRecordTerm sc ir From 98c6027470c48a6b9c8ed785059a0761f28d9c94 Mon Sep 17 00:00:00 2001 From: Samuel Breese Date: Sun, 13 Feb 2022 20:25:13 -0500 Subject: [PATCH 09/47] Tentative steps toward compositional reasoning --- saw-script.cabal | 1 + src/SAWScript/Yosys.hs | 36 ++++++++++++--- src/SAWScript/Yosys/Theorem.hs | 83 ++++++++++++++++++++++++++++++++++ 3 files changed, 113 insertions(+), 7 deletions(-) create mode 100644 src/SAWScript/Yosys/Theorem.hs diff --git a/saw-script.cabal b/saw-script.cabal index 744f92fdbd..101dd6ddd1 100644 --- a/saw-script.cabal +++ b/saw-script.cabal @@ -176,6 +176,7 @@ library SAWScript.Yosys SAWScript.Yosys.IR + SAWScript.Yosys.Theorem GHC-options: -O2 -Wall -fno-ignore-asserts -fno-spec-constr-count if impl(ghc == 8.0.1) diff --git a/src/SAWScript/Yosys.hs b/src/SAWScript/Yosys.hs index 6b4c6130d2..88c035433d 100644 --- a/src/SAWScript/Yosys.hs +++ b/src/SAWScript/Yosys.hs @@ -12,8 +12,8 @@ module SAWScript.Yosys ) where import Control.Lens.TH (makeLenses) -import Control.Lens (at, view, (^.)) +import Control.Lens (at, view, (^.)) import Control.Monad (forM, foldM) import Control.Monad.IO.Class (MonadIO(..)) import Control.Exception (throw) @@ -23,12 +23,15 @@ import qualified Data.Tuple as Tuple import qualified Data.Maybe as Maybe import qualified Data.Foldable as Foldable import qualified Data.List as List +import qualified Data.List.NonEmpty as NE import Data.Map (Map) import qualified Data.Map as Map import Data.Text (Text) import qualified Data.Text as Text import qualified Data.Graph as Graph +import qualified Text.URI as URI + import qualified Verifier.SAW.SharedTerm as SC import qualified Verifier.SAW.TypedTerm as SC import qualified Verifier.SAW.Name as SC @@ -357,7 +360,7 @@ moduleToTerm :: SC.SharedContext -> Map Text SC.Term -> Module -> - m (SC.Term, C.Type) + m (SC.Term, SC.Term, C.Type) moduleToTerm sc env m = do let ng = moduleNetgraph m let inputports = Maybe.mapMaybe @@ -381,6 +384,11 @@ moduleToTerm sc env m = do tp <- liftIO . SC.scBitvector sc . fromIntegral $ length inp pure (nm, tp) ) + outputRecordType <- cryptolRecordType sc . Map.fromList =<< forM outputports + (\(nm, out) -> do + tp <- liftIO . SC.scBitvector sc . fromIntegral $ length out + pure (nm, tp) + ) inputRecordEC <- liftIO $ SC.scFreshEC sc "input" inputRecordType inputRecord <- liftIO $ SC.scExtCns sc inputRecordEC derivedInputs <- forM inputports $ \(nm, inp) -> do @@ -395,11 +403,12 @@ moduleToTerm sc env m = do Just t -> pure (nm, t) ) t <- liftIO $ SC.scAbstractExts sc [inputRecordEC] outputRecord + ty <- liftIO $ SC.scFun sc inputRecordType outputRecordType let toCryptol (nm, rep) = (C.mkIdent nm, C.tWord . C.tNum $ length rep) let cty = C.tFun (C.tRec . C.recordFromFields $ toCryptol <$> inputports) (C.tRec . C.recordFromFields $ toCryptol <$> outputports) - pure (t, cty) + pure (t, ty, cty) -- | Given a Yosys IR and the name of a VHDL module, construct a SAWCore term for that module. yosysIRToRecordTerm :: @@ -413,14 +422,27 @@ yosysIRToRecordTerm sc ir = do (termEnv, typeEnv) <- foldM (\(termEnv, typeEnv) v -> do let (m, nm, _) = mg ^. modgraphNodeFromVertex $ v - (t, ty) <- moduleToTerm sc termEnv m - pure (Map.insert nm t termEnv, Map.insert nm ty typeEnv) + (t, ty, cty) <- moduleToTerm sc termEnv m + let uri = URI.URI + { URI.uriScheme = URI.mkScheme "yosys" + , URI.uriAuthority = Left True + , URI.uriPath = (False,) <$> mapM URI.mkPathPiece (nm NE.:| []) + , URI.uriQuery = [] + , URI.uriFragment = Nothing + } + let ni = SC.ImportedName uri [nm] + tc <- liftIO $ SC.scConstant' sc ni t ty + pure + ( Map.insert nm tc termEnv + , Map.insert nm cty typeEnv + ) ) (Map.empty, Map.empty) sorted - let cty = C.tRec . C.recordFromFields $ first C.mkIdent <$> Map.assocs typeEnv record <- cryptolRecord sc termEnv - pure $ SC.TypedTerm (SC.TypedTermSchema $ C.tMono cty) record + let cty = C.tRec . C.recordFromFields $ first C.mkIdent <$> Map.assocs typeEnv + let tt = SC.TypedTerm (SC.TypedTermSchema $ C.tMono cty) record + pure tt -------------------------------------------------------------------------------- -- ** Functions visible from SAWScript REPL diff --git a/src/SAWScript/Yosys/Theorem.hs b/src/SAWScript/Yosys/Theorem.hs new file mode 100644 index 0000000000..f265b9b1a8 --- /dev/null +++ b/src/SAWScript/Yosys/Theorem.hs @@ -0,0 +1,83 @@ +{-# Language TemplateHaskell #-} +{-# Language OverloadedStrings #-} +{-# Language LambdaCase #-} +{-# Language ScopedTypeVariables #-} + +module SAWScript.Yosys.Theorem where + +import Control.Lens.TH (makeLenses) + +import Control.Lens ((^.)) +import Control.Monad.IO.Class (MonadIO(..)) +import Control.Exception (throw) + +import qualified Data.Text as Text +import qualified Data.Set as Set + +import qualified Text.URI as URI + +import qualified Verifier.SAW.Cache as SC +import qualified Verifier.SAW.SharedTerm as SC +import qualified Verifier.SAW.TypedTerm as SC + +import SAWScript.Yosys.IR + +-- | A YosysTheorem is extracted from a term with the form: +-- {{ \r -> precond r ==> module r == other r }} +-- where "module" is a term derived from some Yosys module, "other" is a term of +-- appropriate type, and "precond" is an optional precondition for the equality. +data YosysTheorem = YosysTheorem + { _theoremTerm :: SC.TypedTerm -- original term + , _theoremURI :: URI.URI -- URI identifying overridden module + , _theoremInputType :: SC.Term -- type of r + , _theoremOutputType :: SC.Term -- type of (module r) + , _theoremPrecond :: Maybe SC.Term -- {{ \r -> precond r }} + , _theoremBody :: SC.Term -- {{ \r -> other r }} + } +makeLenses ''YosysTheorem + +-- | Applying a theorem thm as an "override" in a Yosys-derived term t proceeds as follows: +-- 1) unfold all names except thm.theoremURI in t +-- 2) traverse t, looking for constants named thm.theoremURI +-- 4) replace the constant term with either thm.theoremBody, or +-- {{ \x -> if thm.theoremPrecond r then thm.theoremBody else thm.theoremURI }} +-- in the presence of a precondition +rewriteWithTheorem :: + forall m. + MonadIO m => + SC.SharedContext -> + YosysTheorem -> + SC.Term -> + m SC.Term +rewriteWithTheorem sc thm t = do + tidx <- liftIO (SC.scResolveNameByURI sc $ thm ^. theoremURI) >>= \case + Nothing -> throw . YosysError $ "Could not resolve name " <> Text.pack (show $ thm ^. theoremURI) + Just i -> pure i + unfolded <- liftIO $ SC.scUnfoldConstantSet sc False (Set.singleton tidx) t + cache <- liftIO SC.newCache + let + thmMux :: SC.Term -> IO SC.Term + thmMux elseCase = + case thm ^. theoremPrecond of + Just pc -> do + -- build function term accepting a record of appropriate type + -- body is: if thm.precond then thm.cellterm else def + ec <- SC.scFreshEC sc "r" $ thm ^. theoremInputType + r <- SC.scExtCns sc ec + precond <- SC.scApply sc pc r + thenCase <- SC.scApply sc (thm ^. theoremBody) r + body <- SC.scIte sc (thm ^. theoremOutputType) precond thenCase elseCase + SC.scAbstractExts sc [ec] body + Nothing -> pure $ thm ^. theoremBody + go :: SC.Term -> IO SC.Term + go s@(SC.Unshared tf) = case tf of + SC.Constant (SC.EC idx _ _) _ + | idx == tidx -> thmMux s + | otherwise -> pure s + _ -> SC.Unshared <$> traverse go tf + go s@SC.STApp { SC.stAppIndex = aidx, SC.stAppTermF = tf } = SC.useCache cache aidx $ case tf of + SC.Constant (SC.EC idx _ _) _ + | idx == tidx -> thmMux s + | otherwise -> pure s + _ -> SC.scTermF sc =<< traverse go tf + liftIO $ go unfolded From fb9b75361e010415647fcf7cee8f6353548d5d88 Mon Sep 17 00:00:00 2001 From: Samuel Breese Date: Tue, 22 Feb 2022 19:38:03 -0500 Subject: [PATCH 10/47] Update manual.md --- doc/manual/manual.md | 46 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 46 insertions(+) diff --git a/doc/manual/manual.md b/doc/manual/manual.md index 967b438949..42f2a0249f 100644 --- a/doc/manual/manual.md +++ b/doc/manual/manual.md @@ -3114,3 +3114,49 @@ problem with this aspect of the translation. [^5]: https://coq.inria.fr [^6]: https://github.com/mit-plv/fiat-crypto + +# Analysis of HDL Code + +SAW has experimental support for analysis of hardware descriptions written in Verilog or VHDL ([via GHDL](https://github.com/ghdl/ghdl-yosys-plugin)) through an intermediate representation produced by [Yosys](https://yosyshq.net/yosys/). +This generally follows the same conventions and idioms used in the rest of SAWSCript. +(N.B. the following commands must first be enabled using `enable_experimental`.) + +* `yosys_import : String -> TopLevel Term` produces a `Term` given the path to a JSON file produced by the Yosys `write_json` command. + The resulting term is a Cryptol record, where each field corresponds to one HDL module exported by Yosys. + Each HDL module is in turn represented by a function from a record of input port values to a records of output port values. + For example, consider a Yosys JSON file derived from the following VHDL entities: +~~~~ {.vhd} +entity half is + port ( + a : in std_logic; + b : in std_logic; + c : out std_logic; + s : out std_logic + ); +end half; + +entity full is + port ( + a : in std_logic; + b : in std_logic; + cin : in std_logic; + cout : out std_logic; + s : out std_logic + ); +end full; +~~~~ + The resulting `Term` will have the type +~~~~ +{ half : {a : [1], b : [1]} -> {c : [1], s : [1]} +, full : {a : [1], b : [1], cin : [1]} -> {cout : [1], s : [1]} +} +~~~~ +* `yosys_verify : Term -> [Term] -> Term -> [YosysTheorem] -> ProofScript () -> TopLevel YosysTheorem` proves equality between an HDL module and a specification. + The first parameter is the HDL module - given a record `m` from `yosys_import`, this will typically look something like `{{ m.foo }}`. + The second parameter is a list of preconditions for the equality. + The third parameter is the specification, a term of the same type as the HDL module, which will typically be some Cryptol function or another HDL module. + The fourth parameter is a list of "overrides", which witness the results of previous `yosys_verify` proofs. + These overrides can be used to simplify terms by replacing use sites of submodules with their specifications. + + Note that `Term`s derived from HDL modules are "first class", and are not restricted to `yosys_verify`: they may also be used with SAW's typical `Term` infrastructure like `sat`, `prove_print`, term rewriting, etc. + `yosys_verify` simply provides a convenient and familiar interface, similar to `llvm_verify` or `jvm_verify`. From cd4571bb2852bcf2d4545f70bb2b7e33c327fbbd Mon Sep 17 00:00:00 2001 From: Samuel Breese Date: Tue, 22 Feb 2022 19:38:33 -0500 Subject: [PATCH 11/47] Interface changes for yosys_verify --- saw-core/src/Verifier/SAW/SharedTerm.hs | 6 + src/SAWScript/Interpreter.hs | 5 + src/SAWScript/Value.hs | 10 ++ src/SAWScript/Yosys.hs | 201 ++++++++++++++--------- src/SAWScript/Yosys/Theorem.hs | 205 +++++++++++++++++++++--- 5 files changed, 325 insertions(+), 102 deletions(-) diff --git a/saw-core/src/Verifier/SAW/SharedTerm.hs b/saw-core/src/Verifier/SAW/SharedTerm.hs index d0cfae71e7..84ea8063e3 100644 --- a/saw-core/src/Verifier/SAW/SharedTerm.hs +++ b/saw-core/src/Verifier/SAW/SharedTerm.hs @@ -41,6 +41,7 @@ module Verifier.SAW.SharedTerm , alphaEquiv , alistAllFields , scRegisterName + , scLookupNameInfo , scResolveName , scResolveNameByURI , scResolveUnambiguous @@ -382,6 +383,11 @@ scRegisterName sc i nmi = atomicModifyIORef' (scNamingEnv sc) (\env -> (f env, ( Left uri -> throw (DuplicateNameException uri) Right env' -> env' +scLookupNameInfo :: SharedContext -> VarIndex -> IO (Maybe NameInfo) +scLookupNameInfo sc i = do + env <- readIORef $ scNamingEnv sc + pure . Map.lookup i $ resolvedNames env + scResolveUnambiguous :: SharedContext -> Text -> IO (VarIndex, NameInfo) scResolveUnambiguous sc nm = scResolveName sc nm >>= \case diff --git a/src/SAWScript/Interpreter.hs b/src/SAWScript/Interpreter.hs index a96fc69501..bf8d0b445a 100644 --- a/src/SAWScript/Interpreter.hs +++ b/src/SAWScript/Interpreter.hs @@ -3339,6 +3339,11 @@ primitives = Map.fromList Experimental [] + , prim "yosys_verify" "Term -> [Term] -> Term -> [YosysTheorem] -> ProofScript () -> TopLevel YosysTheorem" + (pureVal yosys_verify) + Experimental + [] + --------------------------------------------------------------------- , prim "mr_solver_prove" "Term -> Term -> TopLevel ()" diff --git a/src/SAWScript/Value.hs b/src/SAWScript/Value.hs index 93c2fba07d..7daba3893c 100644 --- a/src/SAWScript/Value.hs +++ b/src/SAWScript/Value.hs @@ -81,6 +81,7 @@ import SAWScript.Prover.MRSolver.Term as MRSolver import SAWScript.Crucible.LLVM.Skeleton import SAWScript.X86 (X86Unsupported(..), X86Error(..)) import SAWScript.Yosys.IR +import SAWScript.Yosys.Theorem (YosysTheorem) import Verifier.SAW.Name (toShortName) import Verifier.SAW.CryptolEnv as CEnv @@ -164,6 +165,7 @@ data Value | VCFG SAW_CFG | VGhostVar CMS.GhostGlobal | VYosysModule YosysIR + | VYosysTheorem YosysTheorem type SAWSimpset = Simpset TheoremNonce @@ -342,6 +344,7 @@ showsPrecValue opts p v = VGhostVar x -> showParen (p > 10) $ showString "Ghost " . showsPrec 11 x VYosysModule _ -> showString "<>" + VYosysTheorem _ -> showString "<>" VJVMSetup _ -> showString "<>" VJVMMethodSpec _ -> showString "<>" VJVMSetupValue x -> shows x @@ -1045,6 +1048,13 @@ instance FromValue YosysIR where fromValue (VYosysModule ir) = ir fromValue v = error ("fromValue YosysIR: " ++ show v) +instance IsValue YosysTheorem where + toValue = VYosysTheorem + +instance FromValue YosysTheorem where + fromValue (VYosysTheorem thm) = thm + fromValue v = error ("fromValue YosysTheorem: " ++ show v) + -- Error handling -------------------------------------------------------------- underStateT :: (forall b. m b -> m b) -> StateT s m a -> StateT s m a diff --git a/src/SAWScript/Yosys.hs b/src/SAWScript/Yosys.hs index 88c035433d..8b03cc633f 100644 --- a/src/SAWScript/Yosys.hs +++ b/src/SAWScript/Yosys.hs @@ -9,6 +9,7 @@ module SAWScript.Yosys ( YosysIR , yosys_import + , yosys_verify ) where import Control.Lens.TH (makeLenses) @@ -30,6 +31,8 @@ import Data.Text (Text) import qualified Data.Text as Text import qualified Data.Graph as Graph +import Numeric.Natural (Natural) + import qualified Text.URI as URI import qualified Verifier.SAW.SharedTerm as SC @@ -42,7 +45,10 @@ import qualified Cryptol.Utils.RecordMap as C import SAWScript.Panic (panic) import SAWScript.Value +import qualified SAWScript.Builtins as Builtins + import SAWScript.Yosys.IR +import SAWScript.Yosys.Theorem -------------------------------------------------------------------------------- -- ** Building the module graph from Yosys IR @@ -71,8 +77,8 @@ yosysIRModgraph ir = data Netgraph = Netgraph { _netgraphGraph :: Graph.Graph - , _netgraphNodeFromVertex :: Graph.Vertex -> (Cell, [Bitrep], [[Bitrep]]) - -- , _netgraphVertexFromKey :: [Bitrep] -> Maybe Graph.Vertex + , _netgraphNodeFromVertex :: Graph.Vertex -> (Cell, Bitrep, [Bitrep]) + -- , _netgraphVertexFromKey :: Bitrep -> Maybe Graph.Vertex } makeLenses ''Netgraph @@ -89,20 +95,39 @@ cellOutputConnections c = Map.fromList . fmap Tuple.swap . Map.toList $ Map.inte moduleNetgraph :: Module -> Netgraph moduleNetgraph m = let - cellToNodes :: Cell -> [(Cell, [Bitrep], [[Bitrep]])] + bitsFromInputPorts :: [Bitrep] + bitsFromInputPorts = (<> [BitrepZero, BitrepOne]) + . List.nub + . mconcat + . Maybe.mapMaybe + ( \(_, p) -> + case p ^. portDirection of + DirectionInput -> Just $ p ^. portBits + DirectionInout -> Just $ p ^. portBits + _ -> Nothing + ) + . Map.assocs + $ m ^. modulePorts + cellToNodes :: Cell -> [(Cell, Bitrep, [Bitrep])] cellToNodes c = (c, , inputBits) <$> outputBits where - inputBits = List.nub + inputBits :: [Bitrep] + inputBits = + filter (not . flip elem bitsFromInputPorts) + . List.nub + . mconcat . Maybe.mapMaybe ( \(p, bits) -> - case c ^. cellPortDirections . at p of + case (c ^. cellPortDirections . at p) of Just DirectionInput -> Just bits Just DirectionInout -> Just bits _ -> Nothing ) . Map.assocs $ c ^. cellConnections + outputBits :: [Bitrep] outputBits = List.nub + . mconcat . Maybe.mapMaybe ( \(p, bits) -> case c ^. cellPortDirections . at p of @@ -120,42 +145,6 @@ moduleNetgraph m = -------------------------------------------------------------------------------- -- ** Building a SAWCore term from a network graph -cryptolRecordType :: - MonadIO m => - SC.SharedContext -> - Map Text SC.Term -> - m SC.Term -cryptolRecordType sc fields = - liftIO $ SC.scTupleType sc (fmap snd . C.canonicalFields . C.recordFromFields $ Map.assocs fields) - -cryptolRecord :: - MonadIO m => - SC.SharedContext -> - Map Text SC.Term -> - m SC.Term -cryptolRecord sc fields = - liftIO $ SC.scTuple sc (fmap snd . C.canonicalFields . C.recordFromFields $ Map.assocs fields) - -cryptolRecordSelect :: - MonadIO m => - SC.SharedContext -> - Map Text a -> - SC.Term -> - Text -> - m SC.Term -cryptolRecordSelect sc fields r nm = - case List.elemIndex nm ord of - Just i -> liftIO $ SC.scTupleSelector sc r (i + 1) (length ord) - Nothing -> throw . YosysError $ mconcat - [ "Could not build record selector term for field name \"" - , nm - , "\" on record term: " - , Text.pack $ show r - , "\nFields are: " - , Text.pack $ show $ Map.keys fields - ] - where ord = fmap fst . C.canonicalFields . C.recordFromFields $ Map.assocs fields - -- | Given a Yosys cell and a map of terms for its arguments, construct a term representing the output. cellToTerm :: forall m. @@ -198,16 +187,16 @@ cellToTerm sc env c args = case c ^. cellType of "$sshr" -> bvBinaryOp $ SC.scBvSShr sc -- "$shift" -> _ -- "$shiftx" -> _ - "$lt" -> bvBinaryOp $ SC.scBvULt sc - "$le" -> bvBinaryOp $ SC.scBvULe sc - "$gt" -> bvBinaryOp $ SC.scBvUGt sc - "$ge" -> bvBinaryOp $ SC.scBvUGe sc - "$eq" -> bvBinaryOp $ SC.scBvEq sc - "$ne" -> bvBinaryOp $ \w x y -> do + "$lt" -> bvBinaryCmp $ SC.scBvULt sc + "$le" -> bvBinaryCmp $ SC.scBvULe sc + "$gt" -> bvBinaryCmp $ SC.scBvUGt sc + "$ge" -> bvBinaryCmp $ SC.scBvUGe sc + "$eq" -> bvBinaryCmp $ SC.scBvEq sc + "$ne" -> bvBinaryCmp $ \w x y -> do r <- SC.scBvEq sc w x y SC.scNot sc r - "$eqx" -> bvBinaryOp $ SC.scBvEq sc - "$nex" -> bvBinaryOp $ \w x y -> do + "$eqx" -> bvBinaryCmp $ SC.scBvEq sc + "$nex" -> bvBinaryCmp $ \w x y -> do r <- SC.scBvEq sc w x y SC.scNot sc r "$add" -> bvNAryOp $ SC.scBvAdd sc @@ -235,7 +224,14 @@ cellToTerm sc env c args = case c ^. cellType of anz <- liftIO $ SC.scBvNonzero sc w ta bnz <- liftIO $ SC.scBvNonzero sc w tb liftIO $ SC.scOr sc anz bnz - -- "$mux" -> _ + "$mux" -> do + w <- outputWidth + ta <- input "A" + tb <- input "B" + ts <- input "S" + snz <- liftIO $ SC.scBvNonzero sc w ts + ty <- liftIO $ SC.scBitvector sc outputWidthNat + liftIO $ SC.scIte sc ty snz tb ta -- "$pmux" -> _ -- "$bmux" -> _ -- "$demux" -> _ @@ -248,11 +244,13 @@ cellToTerm sc env c args = case c ^. cellType of ct -> throw . YosysError $ "Unknown cell type: " <> ct where nm = c ^. cellType - outputWidth :: m SC.Term - outputWidth = - liftIO $ SC.scNat sc $ case Map.lookup "Y" $ c ^. cellConnections of + outputWidthNat :: Natural + outputWidthNat = + case Map.lookup "Y" $ c ^. cellConnections of Nothing -> panic "cellToTerm" [Text.unpack $ mconcat ["Missing expected output name for ", nm, " cell"]] Just bits -> fromIntegral $ length bits + outputWidth :: m SC.Term + outputWidth = liftIO $ SC.scNat sc outputWidthNat input :: Text -> m SC.Term input inpNm = case Map.lookup inpNm args of @@ -275,6 +273,17 @@ cellToTerm sc env c args = case c ^. cellType of cryptolRecord sc $ Map.fromList [ ("Y", res) ] + bvBinaryCmp :: (SC.Term -> SC.Term -> SC.Term -> IO SC.Term) -> m SC.Term + bvBinaryCmp f = do + ta <- input "A" + tb <- input "B" + w <- outputWidth + bit <- liftIO $ f w ta tb + boolty <- liftIO $ SC.scBoolType sc + res <- liftIO $ SC.scSingle sc boolty bit + cryptolRecord sc $ Map.fromList + [ ("Y", res) + ] bvNAryOp :: (SC.Term -> SC.Term -> SC.Term -> IO SC.Term) -> m SC.Term bvNAryOp f = case Foldable.toList args of @@ -292,7 +301,9 @@ cellToTerm sc env c args = case c ^. cellType of boolTy <- liftIO $ SC.scBoolType sc identity <- liftIO $ SC.scBool sc boolIdentity scFoldr <- liftIO . SC.scLookupDef sc $ SC.mkIdent SC.preludeName "foldr" - res <- liftIO $ SC.scApplyAll sc scFoldr [boolTy, boolTy, w, boolFun, identity, t] + bit <- liftIO $ SC.scApplyAll sc scFoldr [boolTy, boolTy, w, boolFun, identity, t] + boolty <- liftIO $ SC.scBoolType sc + res <- liftIO $ SC.scSingle sc boolty bit cryptolRecord sc $ Map.fromList [ ("Y", res) ] @@ -312,6 +323,28 @@ deriveTermsByIndices sc rep t = do , zip ((:[]) <$> rep) telems ] +lookupPatternTerm :: + MonadIO m => + SC.SharedContext -> + [Bitrep] -> + Map [Bitrep] SC.Term -> + m SC.Term +lookupPatternTerm sc pat ts = + case Map.lookup pat ts of + Just t -> pure t -- if we can find that pattern exactly, great! use that term + Nothing -> do -- otherwise, find each individual bit and append the terms + one <- liftIO $ SC.scNat sc 1 + boolty <- liftIO $ SC.scBoolType sc + many <- liftIO . SC.scNat sc . fromIntegral $ length pat + vecty <- liftIO $ SC.scVecType sc many boolty + bits <- forM pat $ \b -> do + case Map.lookup [b] ts of + Just t -> pure t + Nothing -> do + throw . YosysError $ "Failed to find output bitvec: " <> Text.pack (show b) + vecBits <- liftIO $ SC.scVector sc vecty bits + liftIO $ SC.scJoin sc many one boolty vecBits + -- | Given a netgraph and an initial map from bit patterns to terms, populate that map with terms -- generated from the rest of the netgraph. netgraphToTerms :: @@ -322,32 +355,20 @@ netgraphToTerms :: Map [Bitrep] SC.Term -> m (Map [Bitrep] SC.Term) netgraphToTerms sc env ng inputs - | length (Graph.components $ ng ^. netgraphGraph ) > 1 + | length (Graph.scc $ ng ^. netgraphGraph ) /= length (ng ^. netgraphGraph) = do - liftIO . print . Graph.transposeG $ ng ^. netgraphGraph - liftIO $ print (Graph.components $ ng ^. netgraphGraph ) throw $ YosysError "Network graph contains a cycle; SAW does not currently support analysis of sequential circuits." | otherwise = do let sorted = Graph.reverseTopSort $ ng ^. netgraphGraph foldM ( \acc v -> do - let (c, out, _) = ng ^. netgraphNodeFromVertex $ v - args <- forM (cellInputConnections c) $ \i -> -- for each input bit pattern - case Map.lookup i acc of - Just t -> pure t -- if we can find that pattern exactly, great! use that term - Nothing -> do -- otherwise, find each individual bit and append the terms - one <- liftIO $ SC.scNat sc 1 - boolty <- liftIO $ SC.scBoolType sc - many <- liftIO . SC.scNat sc . fromIntegral $ length i - vecty <- liftIO $ SC.scVecType sc many boolty - bits <- case sequence $ flip Map.lookup acc . (:[]) <$> i of - Just bits -> pure bits - Nothing -> throw . YosysError $ "Failed to find output bitvec: " <> Text.pack (show i) - vecBits <- liftIO $ SC.scVector sc vecty bits - liftIO $ SC.scJoin sc many one boolty vecBits + let (c, _output, _deps) = ng ^. netgraphNodeFromVertex $ v + -- liftIO $ putStrLn $ mconcat ["Building term for output: ", show output, " and inputs: ", show deps] + args <- forM (cellInputConnections c) $ \i -> do -- for each input bit pattern + lookupPatternTerm sc i acc r <- cellToTerm sc env c args -- once we've built a term, insert it along with each of its bits let fields = Map.filter (\d -> d == DirectionOutput || d == DirectionInout) $ c ^. cellPortDirections - ts <- forM (cellOutputConnections c) $ \o -> do + ts <- forM (Map.assocs $ cellOutputConnections c) $ \(out, o) -> do t <- cryptolRecordSelect sc fields r o deriveTermsByIndices sc out t pure $ Map.union (Map.unions ts) acc @@ -394,14 +415,21 @@ moduleToTerm sc env m = do derivedInputs <- forM inputports $ \(nm, inp) -> do t <- liftIO $ cryptolRecordSelect sc (Map.fromList inputports) inputRecord nm deriveTermsByIndices sc inp t - let inputs = Map.unions derivedInputs + + zeroTerm <- liftIO $ SC.scBvConst sc 1 0 + oneTerm <- liftIO $ SC.scBvConst sc 1 1 + let inputs = Map.unions $ mconcat + [ [ Map.fromList + [ ( [BitrepZero], zeroTerm) + , ( [BitrepOne], oneTerm ) + ] + ] + , derivedInputs + ] + terms <- netgraphToTerms sc env ng inputs outputRecord <- cryptolRecord sc . Map.fromList =<< forM outputports - (\(nm, out) -> do - case Map.lookup out terms of - Nothing -> throw . YosysError $ "Failed to find module output bits: " <> Text.pack (show out) - Just t -> pure (nm, t) - ) + (\(nm, out) -> (nm,) <$> lookupPatternTerm sc out terms) t <- liftIO $ SC.scAbstractExts sc [inputRecordEC] outputRecord ty <- liftIO $ SC.scFun sc inputRecordType outputRecordType let toCryptol (nm, rep) = (C.mkIdent nm, C.tWord . C.tNum $ length rep) @@ -422,6 +450,7 @@ yosysIRToRecordTerm sc ir = do (termEnv, typeEnv) <- foldM (\(termEnv, typeEnv) v -> do let (m, nm, _) = mg ^. modgraphNodeFromVertex $ v + -- liftIO . putStrLn . Text.unpack $ mconcat ["Converting module: ", nm] (t, ty, cty) <- moduleToTerm sc termEnv m let uri = URI.URI { URI.uriScheme = URI.mkScheme "yosys" @@ -454,3 +483,19 @@ yosys_import path = do sc <- getSharedContext ir <- loadYosysIR path yosysIRToRecordTerm sc ir + +yosys_verify :: SC.TypedTerm -> [SC.TypedTerm] -> SC.TypedTerm -> [YosysTheorem] -> ProofScript () -> TopLevel YosysTheorem +yosys_verify ymod preconds other specs tactic = do + sc <- getSharedContext + newmod <- foldM (\term thm -> applyOverride sc thm term) + (SC.ttTerm ymod) + specs + mpc <- case preconds of + [] -> pure Nothing + (pc:pcs) -> do + t <- foldM (\a b -> liftIO $ SC.scAnd sc a b) (SC.ttTerm pc) (SC.ttTerm <$> pcs) + pure . Just $ SC.TypedTerm (SC.ttType pc) t + thm <- buildTheorem sc ymod newmod mpc other + prop <- theoremProp sc thm + _ <- Builtins.provePrintPrim tactic prop + pure thm diff --git a/src/SAWScript/Yosys/Theorem.hs b/src/SAWScript/Yosys/Theorem.hs index f265b9b1a8..06f3e68ed7 100644 --- a/src/SAWScript/Yosys/Theorem.hs +++ b/src/SAWScript/Yosys/Theorem.hs @@ -1,83 +1,240 @@ {-# Language TemplateHaskell #-} {-# Language OverloadedStrings #-} {-# Language LambdaCase #-} +{-# Language ViewPatterns #-} {-# Language ScopedTypeVariables #-} +{-# OPTIONS_GHC -Wno-incomplete-patterns #-} module SAWScript.Yosys.Theorem where import Control.Lens.TH (makeLenses) import Control.Lens ((^.)) +import Control.Monad (forM, foldM) import Control.Monad.IO.Class (MonadIO(..)) import Control.Exception (throw) +import Control.Monad.Catch (MonadThrow) +import qualified Data.List as List +import Data.Text (Text) import qualified Data.Text as Text import qualified Data.Set as Set +import Data.Map (Map) +import qualified Data.Map as Map import qualified Text.URI as URI import qualified Verifier.SAW.Cache as SC import qualified Verifier.SAW.SharedTerm as SC import qualified Verifier.SAW.TypedTerm as SC +import qualified Verifier.SAW.Recognizer as R + +import qualified Verifier.SAW.Cryptol as CSC + +import qualified Cryptol.TypeCheck.Type as C +import qualified Cryptol.Utils.Ident as C +import qualified Cryptol.Utils.RecordMap as C import SAWScript.Yosys.IR --- | A YosysTheorem is extracted from a term with the form: --- {{ \r -> precond r ==> module r == other r }} --- where "module" is a term derived from some Yosys module, "other" is a term of --- appropriate type, and "precond" is an optional precondition for the equality. data YosysTheorem = YosysTheorem - { _theoremTerm :: SC.TypedTerm -- original term - , _theoremURI :: URI.URI -- URI identifying overridden module + { _theoremURI :: URI.URI -- URI identifying overridden module + , _theoremInputCryptolType :: C.Type -- cryptol type of r + , _theoremOutputCryptolType :: C.Type -- cryptol type of (module r) , _theoremInputType :: SC.Term -- type of r , _theoremOutputType :: SC.Term -- type of (module r) + , _theoremModule :: SC.Term -- {{ \r -> module r }} , _theoremPrecond :: Maybe SC.Term -- {{ \r -> precond r }} , _theoremBody :: SC.Term -- {{ \r -> other r }} } makeLenses ''YosysTheorem +cryptolRecordType :: + MonadIO m => + SC.SharedContext -> + Map Text SC.Term -> + m SC.Term +cryptolRecordType sc fields = + liftIO $ SC.scTupleType sc (fmap snd . C.canonicalFields . C.recordFromFields $ Map.assocs fields) + +cryptolRecord :: + MonadIO m => + SC.SharedContext -> + Map Text SC.Term -> + m SC.Term +cryptolRecord sc fields = + liftIO $ SC.scTuple sc (fmap snd . C.canonicalFields . C.recordFromFields $ Map.assocs fields) + +cryptolRecordSelect :: + MonadIO m => + SC.SharedContext -> + Map Text a -> + SC.Term -> + Text -> + m SC.Term +cryptolRecordSelect sc fields r nm = + case List.elemIndex nm ord of + Just i -> liftIO $ SC.scTupleSelector sc r (i + 1) (length ord) + Nothing -> throw . YosysError $ mconcat + [ "Could not build record selector term for field name \"" + , nm + , "\" on record term: " + , Text.pack $ show r + , "\nFields are: " + , Text.pack . show $ Map.keys fields + ] + where ord = fmap fst . C.canonicalFields . C.recordFromFields $ Map.assocs fields + +eqBvRecords :: + (MonadIO m, MonadThrow m) => + SC.SharedContext -> + C.Type -> + SC.Term -> + SC.Term -> + m SC.Term +eqBvRecords sc cty a b = do + fields <- Map.mapKeys C.identText . Map.fromList . C.canonicalFields <$> case cty of + C.TRec fs -> pure fs + _ -> throw . YosysError $ mconcat + [ "Type\n" + , Text.pack $ show cty + , "\nis not a record type" + ] + eqs <- forM (Map.assocs fields) $ \(nm, fcty) -> do + w <- case fcty of + C.TCon (C.TC C.TCSeq) [C.TCon (C.TC (C.TCNum wint)) [], C.TCon (C.TC C.TCBit) []] -> + liftIO . SC.scNat sc $ fromIntegral wint + _ -> throw . YosysError $ mconcat + [ "Type\n" + , Text.pack $ show fcty + , "\nis not a bitvector type" + ] + fa <- cryptolRecordSelect sc fields a nm + fb <- cryptolRecordSelect sc fields b nm + liftIO $ SC.scBvEq sc w fa fb + case eqs of + [] -> throw . YosysError $ mconcat + [ "Record type\n" + , Text.pack $ show cty + , "\nhas no fields" + ] + (e:es) -> foldM (\x y -> liftIO $ SC.scAnd sc x y) e es + +theoremProp :: + (MonadIO m, MonadThrow m) => + SC.SharedContext -> + YosysTheorem -> + m SC.TypedTerm +theoremProp sc thm = do + ec <- liftIO $ SC.scFreshEC sc "r" $ thm ^. theoremInputType + r <- liftIO $ SC.scExtCns sc ec + modr <- liftIO $ SC.scApply sc (thm ^. theoremModule) r + bodyr <- liftIO $ SC.scApply sc (thm ^. theoremBody) r + equality <- liftIO $ eqBvRecords sc (thm ^. theoremOutputCryptolType) modr bodyr + res <- case thm ^. theoremPrecond of + Nothing -> pure equality + Just pc -> do + pcr <- liftIO $ SC.scApply sc pc r + liftIO $ SC.scImplies sc pcr equality + func <- liftIO $ SC.scAbstractExts sc [ec] res + let cty = C.tFun (thm ^. theoremInputCryptolType) C.tBit + pure $ SC.TypedTerm (SC.TypedTermSchema $ C.tMono cty) func + +theoremReplacement :: + (MonadIO m, MonadThrow m) => + SC.SharedContext -> + YosysTheorem -> + m SC.Term +theoremReplacement sc thm = do + ec <- liftIO $ SC.scFreshEC sc "r" $ thm ^. theoremInputType + r <- liftIO $ SC.scExtCns sc ec + body <- case thm ^. theoremPrecond of + Nothing -> liftIO $ SC.scApply sc (thm ^. theoremBody) r + Just pc -> do + precond <- liftIO $ SC.scApply sc pc r + thenCase <- liftIO $ SC.scApply sc (thm ^. theoremBody) r + liftIO $ SC.scIte sc (thm ^. theoremOutputType) precond thenCase (thm ^. theoremModule) + liftIO $ SC.scAbstractExts sc [ec] body + +buildTheorem :: + (MonadIO m, MonadThrow m) => + SC.SharedContext -> + SC.TypedTerm -> + SC.Term -> + Maybe SC.TypedTerm -> + SC.TypedTerm -> + m YosysTheorem +buildTheorem sc ymod newmod precond body = do + cty <- case SC.ttType ymod of + SC.TypedTermSchema (C.Forall [] [] cty) -> pure cty + _ -> throw . YosysError $ mconcat + [ "Term\n" + , Text.pack . SC.showTerm $ SC.ttTerm ymod + , "\ncannot be used as an override, as it does not have a monomorphic Cryptol type." + ] + (cinpTy, coutTy) <- case cty of + C.TCon (C.TC C.TCFun) [ci, co] -> pure (ci, co) + _ -> throw . YosysError $ mconcat + [ "Term\n" + , Text.pack . SC.showTerm $ SC.ttTerm ymod + , "\ndoes not have a Cryptol function type." + ] + inpTy <- liftIO $ CSC.importType sc CSC.emptyEnv cinpTy + outTy <- liftIO $ CSC.importType sc CSC.emptyEnv coutTy + idx <- case SC.ttTerm ymod of + (R.asConstant -> Just (SC.EC idx _ _, _)) -> pure idx + _ -> throw . YosysError $ mconcat + [ "Term\n" + , Text.pack . SC.showTerm $ SC.ttTerm ymod + , "\nis not a Yosys module." + ] + uri <- liftIO (SC.scLookupNameInfo sc idx) >>= \case + Just (SC.ImportedName uri _) -> pure uri + _ -> throw . YosysError $ mconcat + [ "Term\n" + , Text.pack . SC.showTerm $ SC.ttTerm ymod + , "\ndoes not call a Yosys module on either side of an equality." + ] + pure YosysTheorem + { _theoremURI = uri + , _theoremInputCryptolType = cinpTy + , _theoremOutputCryptolType = coutTy + , _theoremInputType = inpTy + , _theoremOutputType = outTy + , _theoremModule = newmod + , _theoremPrecond = SC.ttTerm <$> precond + , _theoremBody = SC.ttTerm body + } + -- | Applying a theorem thm as an "override" in a Yosys-derived term t proceeds as follows: -- 1) unfold all names except thm.theoremURI in t -- 2) traverse t, looking for constants named thm.theoremURI -- 4) replace the constant term with either thm.theoremBody, or -- {{ \x -> if thm.theoremPrecond r then thm.theoremBody else thm.theoremURI }} -- in the presence of a precondition -rewriteWithTheorem :: +applyOverride :: forall m. - MonadIO m => + (MonadIO m, MonadThrow m) => SC.SharedContext -> YosysTheorem -> SC.Term -> m SC.Term -rewriteWithTheorem sc thm t = do +applyOverride sc thm t = do tidx <- liftIO (SC.scResolveNameByURI sc $ thm ^. theoremURI) >>= \case Nothing -> throw . YosysError $ "Could not resolve name " <> Text.pack (show $ thm ^. theoremURI) Just i -> pure i unfolded <- liftIO $ SC.scUnfoldConstantSet sc False (Set.singleton tidx) t cache <- liftIO SC.newCache let - thmMux :: SC.Term -> IO SC.Term - thmMux elseCase = - case thm ^. theoremPrecond of - Just pc -> do - -- build function term accepting a record of appropriate type - -- body is: if thm.precond then thm.cellterm else def - ec <- SC.scFreshEC sc "r" $ thm ^. theoremInputType - r <- SC.scExtCns sc ec - precond <- SC.scApply sc pc r - thenCase <- SC.scApply sc (thm ^. theoremBody) r - body <- SC.scIte sc (thm ^. theoremOutputType) precond thenCase elseCase - SC.scAbstractExts sc [ec] body - Nothing -> pure $ thm ^. theoremBody go :: SC.Term -> IO SC.Term go s@(SC.Unshared tf) = case tf of SC.Constant (SC.EC idx _ _) _ - | idx == tidx -> thmMux s + | idx == tidx -> theoremReplacement sc thm | otherwise -> pure s _ -> SC.Unshared <$> traverse go tf go s@SC.STApp { SC.stAppIndex = aidx, SC.stAppTermF = tf } = SC.useCache cache aidx $ case tf of SC.Constant (SC.EC idx _ _) _ - | idx == tidx -> thmMux s + | idx == tidx -> theoremReplacement sc thm | otherwise -> pure s _ -> SC.scTermF sc =<< traverse go tf liftIO $ go unfolded From 08bd920e58860f8729d22d9d401ccd2bdeb0b24f Mon Sep 17 00:00:00 2001 From: Samuel Breese Date: Tue, 22 Feb 2022 19:42:55 -0500 Subject: [PATCH 12/47] Update manual.md --- doc/manual/manual.md | 50 ++++++++++++++++++++++---------------------- 1 file changed, 25 insertions(+), 25 deletions(-) diff --git a/doc/manual/manual.md b/doc/manual/manual.md index 42f2a0249f..f9d692f636 100644 --- a/doc/manual/manual.md +++ b/doc/manual/manual.md @@ -3125,32 +3125,32 @@ This generally follows the same conventions and idioms used in the rest of SAWSC The resulting term is a Cryptol record, where each field corresponds to one HDL module exported by Yosys. Each HDL module is in turn represented by a function from a record of input port values to a records of output port values. For example, consider a Yosys JSON file derived from the following VHDL entities: -~~~~ {.vhd} -entity half is - port ( - a : in std_logic; - b : in std_logic; - c : out std_logic; - s : out std_logic - ); -end half; - -entity full is - port ( - a : in std_logic; - b : in std_logic; - cin : in std_logic; - cout : out std_logic; - s : out std_logic - ); -end full; -~~~~ + ~~~~ {.vhdl} + entity half is + port ( + a : in std_logic; + b : in std_logic; + c : out std_logic; + s : out std_logic + ); + end half; + + entity full is + port ( + a : in std_logic; + b : in std_logic; + cin : in std_logic; + cout : out std_logic; + s : out std_logic + ); + end full; + ~~~~ The resulting `Term` will have the type -~~~~ -{ half : {a : [1], b : [1]} -> {c : [1], s : [1]} -, full : {a : [1], b : [1], cin : [1]} -> {cout : [1], s : [1]} -} -~~~~ + ~~~~ + { half : {a : [1], b : [1]} -> {c : [1], s : [1]} + , full : {a : [1], b : [1], cin : [1]} -> {cout : [1], s : [1]} + } + ~~~~ * `yosys_verify : Term -> [Term] -> Term -> [YosysTheorem] -> ProofScript () -> TopLevel YosysTheorem` proves equality between an HDL module and a specification. The first parameter is the HDL module - given a record `m` from `yosys_import`, this will typically look something like `{{ m.foo }}`. The second parameter is a list of preconditions for the equality. From 0bc2453fec690df0ca5992c4859efafa4cc4aaf8 Mon Sep 17 00:00:00 2001 From: Samuel Breese Date: Tue, 22 Feb 2022 19:43:50 -0500 Subject: [PATCH 13/47] Update manual.md --- doc/manual/manual.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/manual/manual.md b/doc/manual/manual.md index f9d692f636..4f692aaf41 100644 --- a/doc/manual/manual.md +++ b/doc/manual/manual.md @@ -3125,7 +3125,7 @@ This generally follows the same conventions and idioms used in the rest of SAWSC The resulting term is a Cryptol record, where each field corresponds to one HDL module exported by Yosys. Each HDL module is in turn represented by a function from a record of input port values to a records of output port values. For example, consider a Yosys JSON file derived from the following VHDL entities: - ~~~~ {.vhdl} + ~~~~vhdl entity half is port ( a : in std_logic; From bc031f277f4917a8bc6f43e272879a1daf28ca3c Mon Sep 17 00:00:00 2001 From: Samuel Breese Date: Tue, 1 Mar 2022 13:54:34 -0500 Subject: [PATCH 14/47] Tentative saw-remote-api updates --- saw-remote-api/python/saw_client/commands.py | 49 +++++++- .../python/saw_client/connection.py | 17 +++ .../python/saw_client/exceptions.py | 2 + saw-remote-api/saw-remote-api.cabal | 3 +- saw-remote-api/saw-remote-api/Main.hs | 10 ++ saw-remote-api/src/SAWServer.hs | 18 ++- saw-remote-api/src/SAWServer/Exceptions.hs | 12 ++ saw-remote-api/src/SAWServer/Yosys.hs | 111 ++++++++++++++++++ src/SAWScript/Yosys.hs | 21 +++- src/SAWScript/Yosys/Theorem.hs | 25 ++++ 10 files changed, 259 insertions(+), 9 deletions(-) create mode 100644 saw-remote-api/src/SAWServer/Yosys.hs diff --git a/saw-remote-api/python/saw_client/commands.py b/saw-remote-api/python/saw_client/commands.py index a763c4fa82..014e4485d4 100644 --- a/saw-remote-api/python/saw_client/commands.py +++ b/saw-remote-api/python/saw_client/commands.py @@ -12,6 +12,53 @@ class SAWCommand(argo.Command): def process_error(self, ae : argo.ArgoException) -> Exception: return exceptions.make_saw_exception(ae) +class YosysImport(SAWCommand): + def __init__(self, + connection : argo.HasProtocolState, + name : str, + path : str, + timeout : Optional[float]) -> None: + super(YosysImport, self).__init__( + 'SAW/Yosys/import', + {'name': name, 'path': path}, + connection, + #timeout=timeout + ) + + def process_result(self, res : Any) -> Any: + return res + +class YosysVerify(SAWCommand): + def __init__( + self, + connection : argo.HasProtocolState, + imp: str, + module : str, + preconds: List[str], + spec : str, + lemmas : List[str], + script : ProofScript, + lemma_name : str, + timeout : Optional[float]) -> None: + params = { + 'import': imp, + 'module': module, + 'preconds': preconds, + 'spec': spec, + 'lemmas': lemmas, + 'script': script, + 'lemma name': lemma_name + } + super(YosysVerify, self).__init__( + 'SAW/Yosys/verify', + params, + connection, + #timeout=timeout + ) + + def process_result(self, res : Any) -> Any: + return res + class CryptolLoadFile(SAWCommand): def __init__(self, connection : argo.HasProtocolState, filename : str, @@ -20,7 +67,7 @@ def __init__(self, connection : argo.HasProtocolState, 'SAW/Cryptol/load file', {'file': filename}, connection, - timeout=timeout + #timeout=timeout ) def process_result(self, _res : Any) -> Any: diff --git a/saw-remote-api/python/saw_client/connection.py b/saw-remote-api/python/saw_client/connection.py index 0a45321815..924ec6b5d0 100644 --- a/saw-remote-api/python/saw_client/connection.py +++ b/saw-remote-api/python/saw_client/connection.py @@ -229,6 +229,23 @@ def llvm_assume(self, LLVMAssume(self, module, function, contract, lemma_name, timeout) return self.most_recent_result + def yosys_import(self, name: str, path: str, timeout : Optional[float] = None) -> Command: + self.most_recent_result = YosysImport(self, name, path, timeout) + return self.most_recent_result + + def yosys_verify(self, + imp: str, + module: str, + preconds: List[str], + spec: str, + lemmas: List[str], + script: ProofScript, + lemma_name: str, + timeout : Optional[float] = None) -> Command: + self.most_recent_result = \ + YosysVerify(self, imp, module, preconds, spec, lemmas, script, lemma_name, timeout) + return self.most_recent_result + def prove(self, goal: cryptoltypes.CryptolJSON, proof_script: ProofScript, diff --git a/saw-remote-api/python/saw_client/exceptions.py b/saw-remote-api/python/saw_client/exceptions.py index 9ce7b39c6a..b45d97be97 100644 --- a/saw-remote-api/python/saw_client/exceptions.py +++ b/saw-remote-api/python/saw_client/exceptions.py @@ -54,6 +54,7 @@ class NotAJVMClass(ServerValueError): pass class NotAJVMMethodSpecIR(ServerValueError): pass class NotASimpset(ServerValueError): pass class NotATerm(ServerValueError): pass +class NotAYosysTheorem(ServerValueError): pass # Setup errors: class SetupError(SAWException): pass @@ -85,6 +86,7 @@ class CryptolError(SAWException): pass 10070: NotATerm, 10080: NotAJVMClass, 10090: NotAJVMMethodSpecIR, + 10130: NotAYosysTheorem, # Setup errors: 10100: NotSettingUpCryptol, 10110: NotSettingUpCrucibleLLVM, diff --git a/saw-remote-api/saw-remote-api.cabal b/saw-remote-api/saw-remote-api.cabal index efdefc63a6..cb69162274 100644 --- a/saw-remote-api/saw-remote-api.cabal +++ b/saw-remote-api/saw-remote-api.cabal @@ -89,7 +89,8 @@ library SAWServer.Term, SAWServer.TopLevel, SAWServer.TrackFile, - SAWServer.VerifyCommon + SAWServer.VerifyCommon, + SAWServer.Yosys executable saw-remote-api import: general, deps, warnings, errors diff --git a/saw-remote-api/saw-remote-api/Main.hs b/saw-remote-api/saw-remote-api/Main.hs index 4fedadf5da..371cdc1158 100644 --- a/saw-remote-api/saw-remote-api/Main.hs +++ b/saw-remote-api/saw-remote-api/Main.hs @@ -40,6 +40,7 @@ import SAWServer.ProofScript ( makeSimpsetDescr, makeSimpset, proveDescr, prove ) import SAWServer.SaveTerm ( saveTermDescr, saveTerm ) import SAWServer.SetOption ( setOptionDescr, setOption ) +import SAWServer.Yosys (yosysImportDescr, yosysImport, yosysVerifyDescr, yosysVerify) main :: IO () @@ -109,6 +110,15 @@ sawMethods = "SAW/LLVM/assume" llvmAssumeDescr llvmAssume + -- Yosys + , Argo.command + "SAW/Yosys/import" + yosysImportDescr + yosysImport + , Argo.command + "SAW/Yosys/verify" + yosysVerifyDescr + yosysVerify -- General , Argo.command "SAW/create ghost variable" diff --git a/saw-remote-api/src/SAWServer.hs b/saw-remote-api/src/SAWServer.hs index b3abfd01c8..caf1e04aec 100644 --- a/saw-remote-api/src/SAWServer.hs +++ b/saw-remote-api/src/SAWServer.hs @@ -55,6 +55,7 @@ import SAWScript.Position (Pos(..)) import SAWScript.Prover.Rewrite (basic_ss) import SAWScript.Proof (newTheoremDB) import SAWScript.Value (AIGProxy(..), BuiltinContext(..), JVMSetupM, LLVMCrucibleSetupM, TopLevelRO(..), TopLevelRW(..), defaultPPOpts, SAWSimpset) +import SAWScript.Yosys.Theorem (YosysTheorem) import qualified Verifier.SAW.Cryptol.Prelude as CryptolSAW import Verifier.SAW.CryptolEnv (initCryptolEnv, bindTypedTerm) import qualified Cryptol.Utils.Ident as Cryptol @@ -63,6 +64,7 @@ import SAWScript.Prover.MRSolver (emptyMREnv) import qualified Argo --import qualified CryptolServer (validateServerState, ServerState(..)) +--import qualified CryptolServer (validateServerState, ServerState(..)) import SAWServer.Exceptions ( serverValNotFound, notAnLLVMModule, @@ -71,7 +73,9 @@ import SAWServer.Exceptions notASimpset, notATerm, notAJVMClass, - notAJVMMethodSpecIR ) + notAJVMMethodSpecIR, + notAYosysTheorem, + ) type SAWCont = (SAWEnv, SAWTask) @@ -307,6 +311,7 @@ data ServerVal | VJVMMethodSpecIR (CMS.ProvedSpec CJ.JVM) | VLLVMMethodSpecIR (CMS.SomeLLVM CMS.ProvedSpec) | VGhostVar CMS.GhostGlobal + | VYosysTheorem YosysTheorem instance Show ServerVal where show (VTerm t) = "(VTerm " ++ show t ++ ")" @@ -320,6 +325,7 @@ instance Show ServerVal where show (VLLVMMethodSpecIR _) = "VLLVMMethodSpecIR" show (VJVMMethodSpecIR _) = "VJVMMethodSpecIR" show (VGhostVar x) = "(VGhostVar " ++ show x ++ ")" + show (VYosysTheorem _) = "VYosysTheorem" class IsServerVal a where toServerVal :: a -> ServerVal @@ -348,6 +354,9 @@ instance IsServerVal JSS.Class where instance IsServerVal CMS.GhostGlobal where toServerVal = VGhostVar +instance IsServerVal YosysTheorem where + toServerVal = VYosysTheorem + class KnownCrucibleSetupType a where knownCrucibleSetupRepr :: CrucibleSetupTypeRepr a @@ -449,3 +458,10 @@ getGhosts :: Argo.Command SAWState [(ServerName, CMS.GhostGlobal)] getGhosts = do SAWEnv serverEnv <- view sawEnv <$> Argo.getState return [ (n, g) | (n, VGhostVar g) <- M.toList serverEnv ] + +getYosysTheorem :: ServerName -> Argo.Command SAWState YosysTheorem +getYosysTheorem n = + do v <- getServerVal n + case v of + VYosysTheorem t -> return t + _other -> Argo.raise (notAYosysTheorem n) diff --git a/saw-remote-api/src/SAWServer/Exceptions.hs b/saw-remote-api/src/SAWServer/Exceptions.hs index d02a1016aa..298117a422 100644 --- a/saw-remote-api/src/SAWServer/Exceptions.hs +++ b/saw-remote-api/src/SAWServer/Exceptions.hs @@ -11,6 +11,7 @@ module SAWServer.Exceptions ( , notASimpset , notATerm , notAJVMClass + , notAYosysTheorem -- * Wrong monad errors , notSettingUpCryptol , notSettingUpLLVMCrucible @@ -156,6 +157,17 @@ notAtTopLevel tasks = 10120 "Not at top level" (Just (JSON.object ["tasks" .= tasks])) +notAYosysTheorem :: + (ToJSON name, Show name) => + name {- ^ the name that should have been mapped to a Yosys theorem -}-> + JSONRPCException +notAYosysTheorem name = + makeJSONRPCException 10130 + ("The server value with name " <> + T.pack (show name) <> + " is not a Yosys theorem") + (Just $ object ["name" .= name]) + cantLoadLLVMModule :: String -> JSONRPCException cantLoadLLVMModule err = makeJSONRPCException diff --git a/saw-remote-api/src/SAWServer/Yosys.hs b/saw-remote-api/src/SAWServer/Yosys.hs new file mode 100644 index 0000000000..eea2cfe4fc --- /dev/null +++ b/saw-remote-api/src/SAWServer/Yosys.hs @@ -0,0 +1,111 @@ +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} + +module SAWServer.Yosys where + +import Control.Lens (view) + +import Data.Aeson (FromJSON(..), withObject, (.:)) +import Data.Text (Text) + +import qualified Argo +import qualified Argo.Doc as Doc + +import SAWServer (SAWState, ServerName, sawTask, setServerVal, getTerm, getYosysTheorem) +import SAWServer.Exceptions (notAtTopLevel) +import SAWServer.OK (OK, ok) +import SAWServer.ProofScript (ProofScript, interpretProofScript) +import SAWServer.TopLevel (tl) + +import SAWScript.Value (getSharedContext) +import SAWScript.Yosys (yosys_import, yosys_verify) +import SAWScript.Yosys.Theorem (cryptolRecordSelectTyped) + +-- newtype YosysModule = YosysModule (Map String ServerName) + +data YosysImportParams = YosysImportParams + { yosysImportPath :: FilePath + , yosysImportServerName :: ServerName + } + +instance FromJSON YosysImportParams where + parseJSON = withObject "SAW/Yosys/import params" $ \o -> do + yosysImportServerName <- o .: "name" + yosysImportPath <- o .: "path" + pure YosysImportParams{..} + +instance Doc.DescribedMethod YosysImportParams OK where + parameterFieldDescription = + [ ("name", Doc.Paragraph [Doc.Text "The name to refer to the record of Yosys modules by later."]) + , ("path", Doc.Paragraph [Doc.Text "The path to the Yosys JSON file to import."]) + ] + resultFieldDescription = [] + +yosysImport :: YosysImportParams -> Argo.Command SAWState OK +yosysImport params = do + tasks <- view sawTask <$> Argo.getState + case tasks of + (_:_) -> Argo.raise $ notAtTopLevel $ fst <$> tasks + [] -> do + t <- tl . yosys_import $ yosysImportPath params + setServerVal (yosysImportServerName params) t + ok + +yosysImportDescr :: Doc.Block +yosysImportDescr = + Doc.Paragraph [Doc.Text "Import a file produced by the Yosys \"write_json\" command"] + +data YosysVerifyParams = YosysVerifyParams + { yosysVerifyImport :: ServerName + , yosysVerifyModule :: Text + , yosysVerifyPreconds :: [ServerName] + , yosysVerifySpec :: ServerName + , yosysVerifyLemmas :: [ServerName] + , yosysVerifyScript :: ProofScript + , yosysVerifyLemmaName :: ServerName + } + +instance FromJSON YosysVerifyParams where + parseJSON = withObject "SAW/Yosys/verify params" $ \o -> do + yosysVerifyImport <- o .: "import" + yosysVerifyModule <- o .: "module" + yosysVerifyPreconds <- o .: "preconds" + yosysVerifySpec <- o .: "spec" + yosysVerifyLemmas <- o .: "lemmas" + yosysVerifyScript <- o .: "script" + yosysVerifyLemmaName <- o .: "lemma name" + pure YosysVerifyParams{..} + +instance Doc.DescribedMethod YosysVerifyParams OK where + parameterFieldDescription = + [ ("import", Doc.Paragraph [Doc.Text "The imported Yosys file."]) + , ("module", Doc.Paragraph [Doc.Text "The HDL module to verify."]) + , ("preconds", Doc.Paragraph [Doc.Text "Any preconditions for the verificatiion."]) + , ("spec", Doc.Paragraph [Doc.Text "The specification to verify for the module."]) + , ("lemmas", Doc.Paragraph [Doc.Text "The specifications to use for other modules during this verification."]) + , ("script", Doc.Paragraph [Doc.Text "The script to use to prove the validity of the resulting verification conditions."]) + , ("lemma name", Doc.Paragraph [Doc.Text "The name to refer to the result by later."]) + ] + resultFieldDescription = [] + +yosysVerify :: YosysVerifyParams -> Argo.Command SAWState OK +yosysVerify params = do + tasks <- view sawTask <$> Argo.getState + case tasks of + (_:_) -> Argo.raise $ notAtTopLevel $ fst <$> tasks + [] -> do + impTerm <- getTerm $ yosysVerifyImport params + specTerm <- getTerm $ yosysVerifySpec params + lemmas <- mapM getYosysTheorem $ yosysVerifyLemmas params + proofScript <- interpretProofScript $ yosysVerifyScript params + l <- tl $ do + sc <- getSharedContext + modTerm <- cryptolRecordSelectTyped sc impTerm $ yosysVerifyModule params + yosys_verify modTerm [] specTerm lemmas proofScript + setServerVal (yosysVerifyLemmaName params) l + ok + +yosysVerifyDescr :: Doc.Block +yosysVerifyDescr = + Doc.Paragraph [Doc.Text "Verify that the named HDL module meets its specification"] diff --git a/src/SAWScript/Yosys.hs b/src/SAWScript/Yosys.hs index 8b03cc633f..9e200f83ee 100644 --- a/src/SAWScript/Yosys.hs +++ b/src/SAWScript/Yosys.hs @@ -438,16 +438,16 @@ moduleToTerm sc env m = do (C.tRec . C.recordFromFields $ toCryptol <$> outputports) pure (t, ty, cty) --- | Given a Yosys IR and the name of a VHDL module, construct a SAWCore term for that module. -yosysIRToRecordTerm :: +-- | Given a Yosys IR and the name of a VHDL module, construct records associating module names with SAWCore terms and Cryptol types. +yosysIRToTerms :: MonadIO m => SC.SharedContext -> YosysIR -> - m SC.TypedTerm -yosysIRToRecordTerm sc ir = do + m (Map Text SC.Term, Map Text C.Type) +yosysIRToTerms sc ir = do let mg = yosysIRModgraph ir let sorted = Graph.reverseTopSort $ mg ^. modgraphGraph - (termEnv, typeEnv) <- foldM + foldM (\(termEnv, typeEnv) v -> do let (m, nm, _) = mg ^. modgraphNodeFromVertex $ v -- liftIO . putStrLn . Text.unpack $ mconcat ["Converting module: ", nm] @@ -468,6 +468,15 @@ yosysIRToRecordTerm sc ir = do ) (Map.empty, Map.empty) sorted + +-- | Given a Yosys IR and the name of a VHDL module, construct a SAWCore term for that module. +yosysIRToRecordTerm :: + MonadIO m => + SC.SharedContext -> + YosysIR -> + m SC.TypedTerm +yosysIRToRecordTerm sc ir = do + (termEnv, typeEnv) <- yosysIRToTerms sc ir record <- cryptolRecord sc termEnv let cty = C.tRec . C.recordFromFields $ first C.mkIdent <$> Map.assocs typeEnv let tt = SC.TypedTerm (SC.TypedTermSchema $ C.tMono cty) record @@ -487,7 +496,7 @@ yosys_import path = do yosys_verify :: SC.TypedTerm -> [SC.TypedTerm] -> SC.TypedTerm -> [YosysTheorem] -> ProofScript () -> TopLevel YosysTheorem yosys_verify ymod preconds other specs tactic = do sc <- getSharedContext - newmod <- foldM (\term thm -> applyOverride sc thm term) + newmod <- foldM (flip $ applyOverride sc) (SC.ttTerm ymod) specs mpc <- case preconds of diff --git a/src/SAWScript/Yosys/Theorem.hs b/src/SAWScript/Yosys/Theorem.hs index 06f3e68ed7..c0f7a8ed7d 100644 --- a/src/SAWScript/Yosys/Theorem.hs +++ b/src/SAWScript/Yosys/Theorem.hs @@ -85,6 +85,31 @@ cryptolRecordSelect sc fields r nm = ] where ord = fmap fst . C.canonicalFields . C.recordFromFields $ Map.assocs fields +cryptolRecordSelectTyped :: + MonadIO m => + SC.SharedContext -> + SC.TypedTerm -> + Text -> + m SC.TypedTerm +cryptolRecordSelectTyped sc r nm = do + fields <- Map.mapKeys C.identText . Map.fromList . C.canonicalFields <$> case SC.ttType r of + SC.TypedTermSchema (C.Forall [] [] (C.TRec fs)) -> pure fs + _ -> throw . YosysError $ mconcat + [ "Type\n" + , Text.pack . show $ SC.ttType r + , "\nis not a record type" + ] + cty <- case Map.lookup nm fields of + Just cty -> pure cty + _ -> throw . YosysError $ mconcat + [ "Record type\n" + , Text.pack . show $ SC.ttType r + , "\ndoes not have field " + , nm + ] + t <- cryptolRecordSelect sc fields (SC.ttTerm r) nm + pure $ SC.TypedTerm (SC.TypedTermSchema $ C.tMono cty) t + eqBvRecords :: (MonadIO m, MonadThrow m) => SC.SharedContext -> From 2ee44446329e6db4ea5e5eebcb9b58fd5c1b9198 Mon Sep 17 00:00:00 2001 From: Samuel Breese Date: Thu, 10 Mar 2022 12:08:05 -0500 Subject: [PATCH 15/47] Update saw-remote-api --- doc/manual/manual.md | 46 ------------------ s2nTests/docker/saw.dockerfile | 10 ++-- saw-remote-api/python/saw_client/commands.py | 6 +-- saw-remote-api/src/SAWServer.hs | 15 ++++++ saw-remote-api/src/SAWServer/Exceptions.hs | 12 +++++ saw-remote-api/src/SAWServer/Yosys.hs | 49 ++++++++++++++------ src/SAWScript/Yosys.hs | 20 +++++++- src/SAWScript/Yosys/Theorem.hs | 3 +- 8 files changed, 91 insertions(+), 70 deletions(-) diff --git a/doc/manual/manual.md b/doc/manual/manual.md index 4f692aaf41..967b438949 100644 --- a/doc/manual/manual.md +++ b/doc/manual/manual.md @@ -3114,49 +3114,3 @@ problem with this aspect of the translation. [^5]: https://coq.inria.fr [^6]: https://github.com/mit-plv/fiat-crypto - -# Analysis of HDL Code - -SAW has experimental support for analysis of hardware descriptions written in Verilog or VHDL ([via GHDL](https://github.com/ghdl/ghdl-yosys-plugin)) through an intermediate representation produced by [Yosys](https://yosyshq.net/yosys/). -This generally follows the same conventions and idioms used in the rest of SAWSCript. -(N.B. the following commands must first be enabled using `enable_experimental`.) - -* `yosys_import : String -> TopLevel Term` produces a `Term` given the path to a JSON file produced by the Yosys `write_json` command. - The resulting term is a Cryptol record, where each field corresponds to one HDL module exported by Yosys. - Each HDL module is in turn represented by a function from a record of input port values to a records of output port values. - For example, consider a Yosys JSON file derived from the following VHDL entities: - ~~~~vhdl - entity half is - port ( - a : in std_logic; - b : in std_logic; - c : out std_logic; - s : out std_logic - ); - end half; - - entity full is - port ( - a : in std_logic; - b : in std_logic; - cin : in std_logic; - cout : out std_logic; - s : out std_logic - ); - end full; - ~~~~ - The resulting `Term` will have the type - ~~~~ - { half : {a : [1], b : [1]} -> {c : [1], s : [1]} - , full : {a : [1], b : [1], cin : [1]} -> {cout : [1], s : [1]} - } - ~~~~ -* `yosys_verify : Term -> [Term] -> Term -> [YosysTheorem] -> ProofScript () -> TopLevel YosysTheorem` proves equality between an HDL module and a specification. - The first parameter is the HDL module - given a record `m` from `yosys_import`, this will typically look something like `{{ m.foo }}`. - The second parameter is a list of preconditions for the equality. - The third parameter is the specification, a term of the same type as the HDL module, which will typically be some Cryptol function or another HDL module. - The fourth parameter is a list of "overrides", which witness the results of previous `yosys_verify` proofs. - These overrides can be used to simplify terms by replacing use sites of submodules with their specifications. - - Note that `Term`s derived from HDL modules are "first class", and are not restricted to `yosys_verify`: they may also be used with SAW's typical `Term` infrastructure like `sat`, `prove_print`, term rewriting, etc. - `yosys_verify` simply provides a convenient and familiar interface, similar to `llvm_verify` or `jvm_verify`. diff --git a/s2nTests/docker/saw.dockerfile b/s2nTests/docker/saw.dockerfile index 4eb83bf9d4..29f8e11910 100644 --- a/s2nTests/docker/saw.dockerfile +++ b/s2nTests/docker/saw.dockerfile @@ -39,7 +39,7 @@ RUN curl -L https://github.com/CVC4/CVC4/releases/download/1.8/cvc4-1.8-x86_64-l # Set executable and run tests RUN chmod +x rootfs/usr/local/bin/* -FROM haskell:8.8.4-stretch AS build +FROM haskell:8.10.7-buster AS build USER root RUN apt-get update && apt-get install -y wget libncurses-dev unzip COPY --from=solvers /solvers/rootfs / @@ -49,11 +49,11 @@ USER saw WORKDIR /home/saw ENV LANG=C.UTF-8 \ LC_ALL=C.UTF-8 -COPY cabal.GHC-8.8.4.config cabal.project.freeze -RUN cabal v2-update -RUN cabal v2-build +COPY cabal.GHC-8.10.7.config cabal.project.freeze +RUN cabal update +RUN cabal build RUN mkdir -p /home/saw/rootfs/usr/local/bin -RUN cp $(cabal v2-exec which saw) /home/saw/rootfs/usr/local/bin/saw +RUN cp $(cabal exec which saw) /home/saw/rootfs/usr/local/bin/saw WORKDIR /home/saw USER root RUN chown -R root:root /home/saw/rootfs diff --git a/saw-remote-api/python/saw_client/commands.py b/saw-remote-api/python/saw_client/commands.py index 014e4485d4..ba0e9d285f 100644 --- a/saw-remote-api/python/saw_client/commands.py +++ b/saw-remote-api/python/saw_client/commands.py @@ -22,7 +22,7 @@ def __init__(self, 'SAW/Yosys/import', {'name': name, 'path': path}, connection, - #timeout=timeout + timeout=timeout ) def process_result(self, res : Any) -> Any: @@ -53,7 +53,7 @@ def __init__( 'SAW/Yosys/verify', params, connection, - #timeout=timeout + timeout=timeout ) def process_result(self, res : Any) -> Any: @@ -67,7 +67,7 @@ def __init__(self, connection : argo.HasProtocolState, 'SAW/Cryptol/load file', {'file': filename}, connection, - #timeout=timeout + timeout=timeout ) def process_result(self, _res : Any) -> Any: diff --git a/saw-remote-api/src/SAWServer.hs b/saw-remote-api/src/SAWServer.hs index caf1e04aec..c58713fb23 100644 --- a/saw-remote-api/src/SAWServer.hs +++ b/saw-remote-api/src/SAWServer.hs @@ -74,6 +74,7 @@ import SAWServer.Exceptions notATerm, notAJVMClass, notAJVMMethodSpecIR, + notAYosysImport, notAYosysTheorem, ) @@ -299,6 +300,8 @@ data CrucibleSetupTypeRepr :: Type -> Type where UnitRepr :: CrucibleSetupTypeRepr () TypedTermRepr :: CrucibleSetupTypeRepr TypedTerm +newtype YosysImport = YosysImport { yosysImport :: Map Text TypedTerm } + data ServerVal = VTerm TypedTerm | VSimpset SAWSimpset @@ -311,6 +314,7 @@ data ServerVal | VJVMMethodSpecIR (CMS.ProvedSpec CJ.JVM) | VLLVMMethodSpecIR (CMS.SomeLLVM CMS.ProvedSpec) | VGhostVar CMS.GhostGlobal + | VYosysImport YosysImport | VYosysTheorem YosysTheorem instance Show ServerVal where @@ -325,6 +329,7 @@ instance Show ServerVal where show (VLLVMMethodSpecIR _) = "VLLVMMethodSpecIR" show (VJVMMethodSpecIR _) = "VJVMMethodSpecIR" show (VGhostVar x) = "(VGhostVar " ++ show x ++ ")" + show (VYosysImport _) = "VYosysImport" show (VYosysTheorem _) = "VYosysTheorem" class IsServerVal a where @@ -354,6 +359,9 @@ instance IsServerVal JSS.Class where instance IsServerVal CMS.GhostGlobal where toServerVal = VGhostVar +instance IsServerVal YosysImport where + toServerVal = VYosysImport + instance IsServerVal YosysTheorem where toServerVal = VYosysTheorem @@ -459,6 +467,13 @@ getGhosts = do SAWEnv serverEnv <- view sawEnv <$> Argo.getState return [ (n, g) | (n, VGhostVar g) <- M.toList serverEnv ] +getYosysImport :: ServerName -> Argo.Command SAWState YosysImport +getYosysImport n = + do v <- getServerVal n + case v of + VYosysImport t -> return t + _other -> Argo.raise (notAYosysImport n) + getYosysTheorem :: ServerName -> Argo.Command SAWState YosysTheorem getYosysTheorem n = do v <- getServerVal n diff --git a/saw-remote-api/src/SAWServer/Exceptions.hs b/saw-remote-api/src/SAWServer/Exceptions.hs index 298117a422..bc361e4048 100644 --- a/saw-remote-api/src/SAWServer/Exceptions.hs +++ b/saw-remote-api/src/SAWServer/Exceptions.hs @@ -12,6 +12,7 @@ module SAWServer.Exceptions ( , notATerm , notAJVMClass , notAYosysTheorem + , notAYosysImport -- * Wrong monad errors , notSettingUpCryptol , notSettingUpLLVMCrucible @@ -168,6 +169,17 @@ notAYosysTheorem name = " is not a Yosys theorem") (Just $ object ["name" .= name]) +notAYosysImport :: + (ToJSON name, Show name) => + name {- ^ the name that should have been mapped to a Yosys import -}-> + JSONRPCException +notAYosysImport name = + makeJSONRPCException 10131 + ("The server value with name " <> + T.pack (show name) <> + " is not a Yosys import") + (Just $ object ["name" .= name]) + cantLoadLLVMModule :: String -> JSONRPCException cantLoadLLVMModule err = makeJSONRPCException diff --git a/saw-remote-api/src/SAWServer/Yosys.hs b/saw-remote-api/src/SAWServer/Yosys.hs index eea2cfe4fc..384ea8f63a 100644 --- a/saw-remote-api/src/SAWServer/Yosys.hs +++ b/saw-remote-api/src/SAWServer/Yosys.hs @@ -6,21 +6,28 @@ module SAWServer.Yosys where import Control.Lens (view) +import Control.Monad (forM) +import Control.Monad.IO.Class (liftIO) +import Control.Exception (throw) + import Data.Aeson (FromJSON(..), withObject, (.:)) import Data.Text (Text) +import qualified Data.Map as Map import qualified Argo import qualified Argo.Doc as Doc -import SAWServer (SAWState, ServerName, sawTask, setServerVal, getTerm, getYosysTheorem) +import CryptolServer.Data.Expression (Expression(..), getCryptolExpr) + +import SAWServer (SAWState, ServerName, YosysImport(..), sawTask, setServerVal, getYosysImport, getYosysTheorem) +import SAWServer.CryptolExpression (CryptolModuleException(..), getTypedTermOfCExp) import SAWServer.Exceptions (notAtTopLevel) import SAWServer.OK (OK, ok) import SAWServer.ProofScript (ProofScript, interpretProofScript) import SAWServer.TopLevel (tl) -import SAWScript.Value (getSharedContext) -import SAWScript.Yosys (yosys_import, yosys_verify) -import SAWScript.Yosys.Theorem (cryptolRecordSelectTyped) +import SAWScript.Value (getSharedContext, getTopLevelRW, rwCryptol) +import SAWScript.Yosys (loadYosysIR, yosysIRToTypedTerms, yosys_verify) -- newtype YosysModule = YosysModule (Map String ServerName) @@ -48,8 +55,11 @@ yosysImport params = do case tasks of (_:_) -> Argo.raise $ notAtTopLevel $ fst <$> tasks [] -> do - t <- tl . yosys_import $ yosysImportPath params - setServerVal (yosysImportServerName params) t + imp <- tl $ do + sc <- getSharedContext + ir <- loadYosysIR $ yosysImportPath params + YosysImport <$> yosysIRToTypedTerms sc ir + setServerVal (yosysImportServerName params) imp ok yosysImportDescr :: Doc.Block @@ -59,8 +69,8 @@ yosysImportDescr = data YosysVerifyParams = YosysVerifyParams { yosysVerifyImport :: ServerName , yosysVerifyModule :: Text - , yosysVerifyPreconds :: [ServerName] - , yosysVerifySpec :: ServerName + , yosysVerifyPreconds :: [Expression] + , yosysVerifySpec :: Expression , yosysVerifyLemmas :: [ServerName] , yosysVerifyScript :: ProofScript , yosysVerifyLemmaName :: ServerName @@ -83,7 +93,7 @@ instance Doc.DescribedMethod YosysVerifyParams OK where , ("module", Doc.Paragraph [Doc.Text "The HDL module to verify."]) , ("preconds", Doc.Paragraph [Doc.Text "Any preconditions for the verificatiion."]) , ("spec", Doc.Paragraph [Doc.Text "The specification to verify for the module."]) - , ("lemmas", Doc.Paragraph [Doc.Text "The specifications to use for other modules during this verification."]) + , ("lemmas", Doc.Paragraph [Doc.Text "The lemmas to use for other modules during this verification."]) , ("script", Doc.Paragraph [Doc.Text "The script to use to prove the validity of the resulting verification conditions."]) , ("lemma name", Doc.Paragraph [Doc.Text "The name to refer to the result by later."]) ] @@ -95,14 +105,27 @@ yosysVerify params = do case tasks of (_:_) -> Argo.raise $ notAtTopLevel $ fst <$> tasks [] -> do - impTerm <- getTerm $ yosysVerifyImport params - specTerm <- getTerm $ yosysVerifySpec params + fileReader <- Argo.getFileReader + YosysImport imp <- getYosysImport $ yosysVerifyImport params + let Just modTerm = Map.lookup (yosysVerifyModule params) imp lemmas <- mapM getYosysTheorem $ yosysVerifyLemmas params proofScript <- interpretProofScript $ yosysVerifyScript params + cexp <- getCryptolExpr $ yosysVerifySpec params + precondExprs <- mapM getCryptolExpr $ yosysVerifyPreconds params l <- tl $ do + rw <- getTopLevelRW sc <- getSharedContext - modTerm <- cryptolRecordSelectTyped sc impTerm $ yosysVerifyModule params - yosys_verify modTerm [] specTerm lemmas proofScript + let cenv = rwCryptol rw + preconds <- forM precondExprs $ \pc -> do + (eterm, warnings) <- liftIO $ getTypedTermOfCExp fileReader sc cenv pc + case eterm of + Right (t, _) -> pure t + Left err -> throw $ CryptolModuleException err warnings + (eterm, warnings) <- liftIO $ getTypedTermOfCExp fileReader sc cenv cexp + specTerm <- case eterm of + Right (t, _) -> pure t + Left err -> throw $ CryptolModuleException err warnings + yosys_verify modTerm preconds specTerm lemmas proofScript setServerVal (yosysVerifyLemmaName params) l ok diff --git a/src/SAWScript/Yosys.hs b/src/SAWScript/Yosys.hs index 9e200f83ee..2d9ddfef83 100644 --- a/src/SAWScript/Yosys.hs +++ b/src/SAWScript/Yosys.hs @@ -10,6 +10,8 @@ module SAWScript.Yosys ( YosysIR , yosys_import , yosys_verify + , loadYosysIR + , yosysIRToTypedTerms ) where import Control.Lens.TH (makeLenses) @@ -438,7 +440,7 @@ moduleToTerm sc env m = do (C.tRec . C.recordFromFields $ toCryptol <$> outputports) pure (t, ty, cty) --- | Given a Yosys IR and the name of a VHDL module, construct records associating module names with SAWCore terms and Cryptol types. +-- | Given a Yosys IR, construct records associating module names with SAWCore terms and Cryptol types. yosysIRToTerms :: MonadIO m => SC.SharedContext -> @@ -469,7 +471,21 @@ yosysIRToTerms sc ir = do (Map.empty, Map.empty) sorted --- | Given a Yosys IR and the name of a VHDL module, construct a SAWCore term for that module. +-- | Given a Yosys IR, construct a record of TypedTerms +yosysIRToTypedTerms :: + MonadIO m => + SC.SharedContext -> + YosysIR -> + m (Map Text SC.TypedTerm) +yosysIRToTypedTerms sc ir = do + (termEnv, typeEnv) <- yosysIRToTerms sc ir + res <- forM (Map.assocs termEnv) $ \(nm, t) -> + case Map.lookup nm typeEnv of + Nothing -> throw . YosysError $ "No type for Yosys module: " <> nm + Just ty -> pure (nm, SC.TypedTerm (SC.TypedTermSchema $ C.tMono ty) t) + pure $ Map.fromList res + +-- | Given a Yosys IR, construct a SAWCore record for all modules. yosysIRToRecordTerm :: MonadIO m => SC.SharedContext -> diff --git a/src/SAWScript/Yosys/Theorem.hs b/src/SAWScript/Yosys/Theorem.hs index c0f7a8ed7d..3659d1bed9 100644 --- a/src/SAWScript/Yosys/Theorem.hs +++ b/src/SAWScript/Yosys/Theorem.hs @@ -178,7 +178,8 @@ theoremReplacement sc thm = do Just pc -> do precond <- liftIO $ SC.scApply sc pc r thenCase <- liftIO $ SC.scApply sc (thm ^. theoremBody) r - liftIO $ SC.scIte sc (thm ^. theoremOutputType) precond thenCase (thm ^. theoremModule) + elseCase <- liftIO $ SC.scApply sc (thm ^. theoremModule) r + liftIO $ SC.scIte sc (thm ^. theoremOutputType) precond thenCase elseCase liftIO $ SC.scAbstractExts sc [ec] body buildTheorem :: From e51d21f6e5cc06c2aa783d03513820d4a04e08fe Mon Sep 17 00:00:00 2001 From: Samuel Breese Date: Sun, 3 Apr 2022 14:39:43 -0400 Subject: [PATCH 16/47] Preliminary translation of sequential circuits Right now this is probably subtly broken in a bunch of ways. But, I can translate a simple FSM and the resulting term appears to behave correctly! --- src/SAWScript/Yosys.hs | 284 ++++++++++++++++++++++++--------- src/SAWScript/Yosys/Theorem.hs | 2 +- 2 files changed, 212 insertions(+), 74 deletions(-) diff --git a/src/SAWScript/Yosys.hs b/src/SAWScript/Yosys.hs index 2d9ddfef83..60465206b1 100644 --- a/src/SAWScript/Yosys.hs +++ b/src/SAWScript/Yosys.hs @@ -3,6 +3,7 @@ {-# Language RecordWildCards #-} {-# Language ViewPatterns #-} {-# Language LambdaCase #-} +{-# Language MultiWayIf #-} {-# Language TupleSections #-} {-# Language ScopedTypeVariables #-} @@ -21,7 +22,6 @@ import Control.Monad (forM, foldM) import Control.Monad.IO.Class (MonadIO(..)) import Control.Exception (throw) -import Data.Bifunctor (first) import qualified Data.Tuple as Tuple import qualified Data.Maybe as Maybe import qualified Data.Foldable as Foldable @@ -79,13 +79,15 @@ yosysIRModgraph ir = data Netgraph = Netgraph { _netgraphGraph :: Graph.Graph - , _netgraphNodeFromVertex :: Graph.Vertex -> (Cell, Bitrep, [Bitrep]) + , _netgraphNodeFromVertex :: Graph.Vertex -> ((Text, Cell), Bitrep, [Bitrep]) -- , _netgraphVertexFromKey :: Bitrep -> Maybe Graph.Vertex } makeLenses ''Netgraph cellInputConnections :: Cell -> Map Text [Bitrep] -cellInputConnections c = Map.intersection (c ^. cellConnections) inp +cellInputConnections c + | c ^. cellType == "$dff" = Map.empty + | otherwise = Map.intersection (c ^. cellConnections) inp where inp = Map.filter (\d -> d == DirectionInput || d == DirectionInout) $ c ^. cellPortDirections @@ -110,8 +112,10 @@ moduleNetgraph m = ) . Map.assocs $ m ^. modulePorts - cellToNodes :: Cell -> [(Cell, Bitrep, [Bitrep])] - cellToNodes c = (c, , inputBits) <$> outputBits + cellToNodes :: (Text, Cell) -> [((Text, Cell), Bitrep, [Bitrep])] + cellToNodes (nm, c) + | c ^. cellType == "$dff" = ((nm, c), , []) <$> outputBits + | otherwise = ((nm, c), , inputBits) <$> outputBits where inputBits :: [Bitrep] inputBits = @@ -120,7 +124,7 @@ moduleNetgraph m = . mconcat . Maybe.mapMaybe ( \(p, bits) -> - case (c ^. cellPortDirections . at p) of + case c ^. cellPortDirections . at p of Just DirectionInput -> Just bits Just DirectionInout -> Just bits _ -> Nothing @@ -139,7 +143,7 @@ moduleNetgraph m = ) . Map.assocs $ c ^. cellConnections - nodes = concatMap cellToNodes . Map.elems $ m ^. moduleCells + nodes = concatMap cellToNodes . Map.assocs $ m ^. moduleCells (_netgraphGraph, _netgraphNodeFromVertex, _netgraphVertexFromKey) = Graph.graphFromEdges nodes in Netgraph{..} @@ -147,18 +151,38 @@ moduleNetgraph m = -------------------------------------------------------------------------------- -- ** Building a SAWCore term from a network graph +data ConvertedModule = ConvertedModule + { _convertedModuleTerm :: SC.Term + , _convertedModuleType :: SC.Term + , _convertedModuleCryptolType :: C.Type + , _convertedModuleStateFields :: Maybe (Map Text (SC.Term, C.Type)) + } +makeLenses ''ConvertedModule + -- | Given a Yosys cell and a map of terms for its arguments, construct a term representing the output. cellToTerm :: - forall m. + forall m a. MonadIO m => SC.SharedContext -> - Map Text SC.Term {- ^ Environment of user-defined cells -} -> + Map Text ConvertedModule {- ^ Environment of user-defined cells -} -> + Map Text a {- ^ Mapping from output names used to construct record lookups -} -> + Maybe SC.Term {- ^ State term for this cell, if it exists -} -> Cell {- ^ Cell type -} -> Map Text SC.Term {- ^ Mapping of input names to input terms -} -> - m SC.Term -cellToTerm sc env c args = case c ^. cellType of + m (SC.Term, Maybe SC.Term) +cellToTerm sc env outputFields mst c args = case c ^. cellType of + "$dff" + | Just st <- mst -> do + fmap (,Nothing) . cryptolRecord sc $ Map.fromList + [ ("Q", st) + ] + | otherwise -> panic "cellToTerm" [Text.unpack $ mconcat ["Flip-flop cell has no associated state term"]] "$not" -> bvUnaryOp $ SC.scBvNot sc - "$pos" -> input "A" + "$pos" -> do + res <- input "A" + fmap (,Nothing) . cryptolRecord sc $ Map.fromList + [ ("Y", res) + ] "$neg" -> bvUnaryOp $ SC.scBvNeg sc "$and" -> bvNAryOp $ SC.scBvAnd sc "$or" -> bvNAryOp $ SC.scBvOr sc @@ -211,21 +235,30 @@ cellToTerm sc env c args = case c ^. cellType of w <- outputWidth ta <- input "A" anz <- liftIO $ SC.scBvNonzero sc w ta - liftIO $ SC.scNot sc anz + res <- liftIO $ SC.scNot sc anz + fmap (,Nothing) . cryptolRecord sc $ Map.fromList + [ ("Y", res) + ] "$logic_and" -> do w <- outputWidth ta <- input "A" tb <- input "B" anz <- liftIO $ SC.scBvNonzero sc w ta bnz <- liftIO $ SC.scBvNonzero sc w tb - liftIO $ SC.scAnd sc anz bnz + res <- liftIO $ SC.scAnd sc anz bnz + fmap (,Nothing) . cryptolRecord sc $ Map.fromList + [ ("Y", res) + ] "$logic_or" -> do w <- outputWidth ta <- input "A" tb <- input "B" anz <- liftIO $ SC.scBvNonzero sc w ta bnz <- liftIO $ SC.scBvNonzero sc w tb - liftIO $ SC.scOr sc anz bnz + res <- liftIO $ SC.scOr sc anz bnz + fmap (,Nothing) . cryptolRecord sc $ Map.fromList + [ ("Y", res) + ] "$mux" -> do w <- outputWidth ta <- input "A" @@ -233,16 +266,25 @@ cellToTerm sc env c args = case c ^. cellType of ts <- input "S" snz <- liftIO $ SC.scBvNonzero sc w ts ty <- liftIO $ SC.scBitvector sc outputWidthNat - liftIO $ SC.scIte sc ty snz tb ta + res <- liftIO $ SC.scIte sc ty snz tb ta + fmap (,Nothing) . cryptolRecord sc $ Map.fromList + [ ("Y", res) + ] -- "$pmux" -> _ -- "$bmux" -> _ -- "$demux" -> _ -- "$lut" -> _ -- "$slice" -> _ -- "$concat" -> _ - (flip Map.lookup env -> Just term) -> do - r <- cryptolRecord sc args - liftIO $ SC.scApply sc term r + (flip Map.lookup env -> Just cm) -> do + r <- cryptolRecord sc $ case mst of + Nothing -> args + Just st -> Map.insert "__state__" st args + res <- liftIO $ SC.scApply sc (cm ^. convertedModuleTerm) r + post <- case mst of + Nothing -> pure Nothing + Just _ -> Just <$> cryptolRecordSelect sc outputFields res "__state__" + pure (res, post) ct -> throw . YosysError $ "Unknown cell type: " <> ct where nm = c ^. cellType @@ -258,24 +300,24 @@ cellToTerm sc env c args = case c ^. cellType of case Map.lookup inpNm args of Nothing -> panic "cellToTerm" [Text.unpack $ mconcat [nm, " missing input ", inpNm]] Just a -> pure a - bvUnaryOp :: (SC.Term -> SC.Term -> IO SC.Term) -> m SC.Term + bvUnaryOp :: (SC.Term -> SC.Term -> IO SC.Term) -> m (SC.Term, Maybe SC.Term) bvUnaryOp f = do t <- input "A" w <- outputWidth res <- liftIO $ f w t - cryptolRecord sc $ Map.fromList + fmap (,Nothing) . cryptolRecord sc $ Map.fromList [ ("Y", res) ] - bvBinaryOp :: (SC.Term -> SC.Term -> SC.Term -> IO SC.Term) -> m SC.Term + bvBinaryOp :: (SC.Term -> SC.Term -> SC.Term -> IO SC.Term) -> m (SC.Term, Maybe SC.Term) bvBinaryOp f = do ta <- input "A" tb <- input "B" w <- outputWidth res <- liftIO $ f w ta tb - cryptolRecord sc $ Map.fromList + fmap (,Nothing) . cryptolRecord sc $ Map.fromList [ ("Y", res) ] - bvBinaryCmp :: (SC.Term -> SC.Term -> SC.Term -> IO SC.Term) -> m SC.Term + bvBinaryCmp :: (SC.Term -> SC.Term -> SC.Term -> IO SC.Term) -> m (SC.Term, Maybe SC.Term) bvBinaryCmp f = do ta <- input "A" tb <- input "B" @@ -283,20 +325,20 @@ cellToTerm sc env c args = case c ^. cellType of bit <- liftIO $ f w ta tb boolty <- liftIO $ SC.scBoolType sc res <- liftIO $ SC.scSingle sc boolty bit - cryptolRecord sc $ Map.fromList + fmap (,Nothing) . cryptolRecord sc $ Map.fromList [ ("Y", res) ] - bvNAryOp :: (SC.Term -> SC.Term -> SC.Term -> IO SC.Term) -> m SC.Term + bvNAryOp :: (SC.Term -> SC.Term -> SC.Term -> IO SC.Term) -> m (SC.Term, Maybe SC.Term) bvNAryOp f = case Foldable.toList args of [] -> panic "cellToTerm" [Text.unpack $ mconcat [nm, " cell given no inputs"]] (t:rest) -> do w <- outputWidth res <- liftIO $ foldM (f w) t rest - cryptolRecord sc $ Map.fromList + fmap (,Nothing) . cryptolRecord sc $ Map.fromList [ ("Y", res) ] - bvReduce :: Bool -> SC.Term -> m SC.Term + bvReduce :: Bool -> SC.Term -> m (SC.Term, Maybe SC.Term) bvReduce boolIdentity boolFun = do t <- input "A" w <- outputWidth @@ -306,7 +348,7 @@ cellToTerm sc env c args = case c ^. cellType of bit <- liftIO $ SC.scApplyAll sc scFoldr [boolTy, boolTy, w, boolFun, identity, t] boolty <- liftIO $ SC.scBoolType sc res <- liftIO $ SC.scSingle sc boolty bit - cryptolRecord sc $ Map.fromList + fmap (,Nothing) . cryptolRecord sc $ Map.fromList [ ("Y", res) ] @@ -333,8 +375,8 @@ lookupPatternTerm :: m SC.Term lookupPatternTerm sc pat ts = case Map.lookup pat ts of - Just t -> pure t -- if we can find that pattern exactly, great! use that term - Nothing -> do -- otherwise, find each individual bit and append the terms + Just t -> pure t + Nothing -> do one <- liftIO $ SC.scNat sc 1 boolty <- liftIO $ SC.scBoolType sc many <- liftIO . SC.scNat sc . fromIntegral $ length pat @@ -352,43 +394,82 @@ lookupPatternTerm sc pat ts = netgraphToTerms :: MonadIO m => SC.SharedContext -> - Map Text SC.Term -> + Map Text ConvertedModule -> + Map Text (SC.Term, C.Type) -> + Maybe SC.Term -> Netgraph -> Map [Bitrep] SC.Term -> - m (Map [Bitrep] SC.Term) -netgraphToTerms sc env ng inputs - | length (Graph.scc $ ng ^. netgraphGraph ) /= length (ng ^. netgraphGraph) + m (Map [Bitrep] SC.Term, Map Text SC.Term) +netgraphToTerms sc env stateFields mst ng inputs + | length (Graph.scc $ ng ^. netgraphGraph) /= length (ng ^. netgraphGraph) = do - throw $ YosysError "Network graph contains a cycle; SAW does not currently support analysis of sequential circuits." + throw $ YosysError "Network graph contains a cycle after splitting on DFFs; SAW does not currently support analysis of this circuit" | otherwise = do let sorted = Graph.reverseTopSort $ ng ^. netgraphGraph foldM - ( \acc v -> do - let (c, _output, _deps) = ng ^. netgraphNodeFromVertex $ v + ( \(acc, stateAcc) v -> do + let ((nm, c), _output, _deps) = ng ^. netgraphNodeFromVertex $ v -- liftIO $ putStrLn $ mconcat ["Building term for output: ", show output, " and inputs: ", show deps] + args <- forM (cellInputConnections c) $ \i -> do -- for each input bit pattern + -- if we can find that pattern exactly, great! use that term + -- otherwise, find each individual bit and append the terms lookupPatternTerm sc i acc - r <- cellToTerm sc env c args -- once we've built a term, insert it along with each of its bits - let fields = Map.filter (\d -> d == DirectionOutput || d == DirectionInout) $ c ^. cellPortDirections + + let portFields = Map.filter (\d -> d == DirectionOutput || d == DirectionInout) $ c ^. cellPortDirections + (cellmst, outputFields) <- case mst of + Just st + | Just _ <- Map.lookup nm stateFields -> do + cellmst <- Just <$> cryptolRecordSelect sc stateFields st nm + pure (cellmst, if c ^. cellType == "$dff" then portFields else Map.insert "__state__" DirectionOutput portFields) + _ -> pure (Nothing, portFields) + + (r, mpost) <- cellToTerm sc env outputFields cellmst c args + + -- once we've built a term, insert it along with each of its bits ts <- forM (Map.assocs $ cellOutputConnections c) $ \(out, o) -> do - t <- cryptolRecordSelect sc fields r o + t <- cryptolRecordSelect sc outputFields r o deriveTermsByIndices sc out t - pure $ Map.union (Map.unions ts) acc + pure + ( Map.union (Map.unions ts) acc + , case mpost of + Nothing -> stateAcc + Just post -> Map.insert nm post stateAcc + ) ) - inputs + (inputs, Map.empty) sorted -moduleToTerm :: +convertModule :: MonadIO m => SC.SharedContext -> - Map Text SC.Term -> + Map Text ConvertedModule -> Module -> - m (SC.Term, SC.Term, C.Type) -moduleToTerm sc env m = do + m ConvertedModule +convertModule sc env m = do let ng = moduleNetgraph m + let clockCandidates = List.nub + . Maybe.mapMaybe + ( \(_nm, c) -> if c ^. cellType == "$dff" + then Map.lookup "CLK" (c ^. cellConnections) + else Nothing + ) + . Map.assocs + $ m ^. moduleCells + let clockBits = case clockCandidates of + [] -> [] + [b] -> b + _ -> throw . YosysError $ mconcat + [ "Multiple clocks detected (bits: " + , Text.pack $ show clockCandidates + , ")\nSAW only supports sequential circuits with a single clock" + ] + let inputports = Maybe.mapMaybe ( \(nm, ip) -> - if ip ^. portDirection == DirectionInput || ip ^. portDirection == DirectionInout + if + (ip ^. portDirection == DirectionInput || ip ^. portDirection == DirectionInout) + && (ip ^. portBits /= clockBits) then Just (nm, ip ^. portBits) else Nothing ) @@ -402,22 +483,54 @@ moduleToTerm sc env m = do ) . Map.assocs $ m ^. modulePorts - inputRecordType <- cryptolRecordType sc . Map.fromList =<< forM inputports + + stateFields <- Map.fromList + . Maybe.catMaybes + <$> mapM + ( \v -> + let ((nm, c), _output, _deps) = ng ^. netgraphNodeFromVertex $ v + in if + | c ^. cellType == "$dff" + , Just b <- Map.lookup "Q" $ c ^. cellConnections -> do + let w = length b + ty <- liftIO $ SC.scBitvector sc $ fromIntegral w + let cty = C.tWord $ C.tNum w + pure $ Just (nm, (ty, cty)) + | Just cm <- Map.lookup (c ^. cellType) env + , Just fields <- cm ^. convertedModuleStateFields -> do + ty <- cryptolRecordType sc (fst <$> fields) + let cty = C.tRec . C.recordFromFields $ (\(cnm, (_, t)) -> (C.mkIdent cnm, t)) <$> Map.assocs fields + pure $ Just (nm, (ty, cty)) + | otherwise -> pure Nothing + ) + (Graph.vertices $ ng ^. netgraphGraph) + stateRecordType <- cryptolRecordType sc $ fst <$> stateFields + let stateRecordCryptolType = C.tRec . C.recordFromFields $ (\(cnm, (_, t)) -> (C.mkIdent cnm, t)) <$> Map.assocs stateFields + + let addStateType fs = if Map.null stateFields then fs else Map.insert "__state__" stateRecordType fs + inputFields <- addStateType . Map.fromList <$> forM inputports (\(nm, inp) -> do tp <- liftIO . SC.scBitvector sc . fromIntegral $ length inp pure (nm, tp) ) - outputRecordType <- cryptolRecordType sc . Map.fromList =<< forM outputports + outputFields <- addStateType . Map.fromList <$> forM outputports (\(nm, out) -> do tp <- liftIO . SC.scBitvector sc . fromIntegral $ length out pure (nm, tp) ) + inputRecordType <- cryptolRecordType sc inputFields + outputRecordType <- cryptolRecordType sc outputFields inputRecordEC <- liftIO $ SC.scFreshEC sc "input" inputRecordType inputRecord <- liftIO $ SC.scExtCns sc inputRecordEC + derivedInputs <- forM inputports $ \(nm, inp) -> do - t <- liftIO $ cryptolRecordSelect sc (Map.fromList inputports) inputRecord nm + t <- liftIO $ cryptolRecordSelect sc inputFields inputRecord nm deriveTermsByIndices sc inp t + stateRecordTerm <- if Map.null stateFields + then pure Nothing + else liftIO $ Just <$> cryptolRecordSelect sc inputFields inputRecord "__state__" + zeroTerm <- liftIO $ SC.scBvConst sc 1 0 oneTerm <- liftIO $ SC.scBvConst sc 1 1 let inputs = Map.unions $ mconcat @@ -429,31 +542,55 @@ moduleToTerm sc env m = do , derivedInputs ] - terms <- netgraphToTerms sc env ng inputs - outputRecord <- cryptolRecord sc . Map.fromList =<< forM outputports + (terms, modulePostStates) <- netgraphToTerms sc env stateFields stateRecordTerm ng inputs + dffBackedges <- fmap (Map.fromList . Maybe.catMaybes) + . mapM + ( \(nm, c) -> if + | c ^. cellType == "$dff" + , Just b <- Map.lookup "D" (c ^. cellConnections) + -> do + t <- lookupPatternTerm sc b terms + pure $ Just (nm, t) + | otherwise -> pure Nothing + ) + . Map.assocs + $ m ^. moduleCells + let postStateFields = Map.union dffBackedges modulePostStates + postStateRecord <- cryptolRecord sc postStateFields + + let addState fs = if Map.null stateFields then fs else Map.insert "__state__" postStateRecord fs + outputRecord <- cryptolRecord sc . addState . Map.fromList =<< forM outputports (\(nm, out) -> (nm,) <$> lookupPatternTerm sc out terms) + t <- liftIO $ SC.scAbstractExts sc [inputRecordEC] outputRecord ty <- liftIO $ SC.scFun sc inputRecordType outputRecordType + + let addStateCryptolType fs = if Map.null stateFields then fs else ("__state__", stateRecordCryptolType):fs let toCryptol (nm, rep) = (C.mkIdent nm, C.tWord . C.tNum $ length rep) let cty = C.tFun - (C.tRec . C.recordFromFields $ toCryptol <$> inputports) - (C.tRec . C.recordFromFields $ toCryptol <$> outputports) - pure (t, ty, cty) + (C.tRec . C.recordFromFields . addStateCryptolType $ toCryptol <$> inputports) + (C.tRec . C.recordFromFields . addStateCryptolType $ toCryptol <$> outputports) + pure ConvertedModule + { _convertedModuleTerm = t + , _convertedModuleType = ty + , _convertedModuleCryptolType = cty + , _convertedModuleStateFields = if Map.null stateFields then Nothing else Just stateFields + } -- | Given a Yosys IR, construct records associating module names with SAWCore terms and Cryptol types. yosysIRToTerms :: MonadIO m => SC.SharedContext -> YosysIR -> - m (Map Text SC.Term, Map Text C.Type) + m (Map Text ConvertedModule) yosysIRToTerms sc ir = do let mg = yosysIRModgraph ir let sorted = Graph.reverseTopSort $ mg ^. modgraphGraph foldM - (\(termEnv, typeEnv) v -> do + (\env v -> do let (m, nm, _) = mg ^. modgraphNodeFromVertex $ v -- liftIO . putStrLn . Text.unpack $ mconcat ["Converting module: ", nm] - (t, ty, cty) <- moduleToTerm sc termEnv m + cm <- convertModule sc env m let uri = URI.URI { URI.uriScheme = URI.mkScheme "yosys" , URI.uriAuthority = Left True @@ -462,13 +599,11 @@ yosysIRToTerms sc ir = do , URI.uriFragment = Nothing } let ni = SC.ImportedName uri [nm] - tc <- liftIO $ SC.scConstant' sc ni t ty - pure - ( Map.insert nm tc termEnv - , Map.insert nm cty typeEnv - ) + tc <- liftIO $ SC.scConstant' sc ni (cm ^. convertedModuleTerm) (cm ^. convertedModuleType) + let cm' = cm { _convertedModuleTerm = tc } + pure $ Map.insert nm cm' env ) - (Map.empty, Map.empty) + Map.empty sorted -- | Given a Yosys IR, construct a record of TypedTerms @@ -478,11 +613,14 @@ yosysIRToTypedTerms :: YosysIR -> m (Map Text SC.TypedTerm) yosysIRToTypedTerms sc ir = do - (termEnv, typeEnv) <- yosysIRToTerms sc ir - res <- forM (Map.assocs termEnv) $ \(nm, t) -> - case Map.lookup nm typeEnv of - Nothing -> throw . YosysError $ "No type for Yosys module: " <> nm - Just ty -> pure (nm, SC.TypedTerm (SC.TypedTermSchema $ C.tMono ty) t) + env <- yosysIRToTerms sc ir + res <- forM (Map.assocs env) $ \(nm, cm) -> + pure + ( nm + , SC.TypedTerm + (SC.TypedTermSchema $ C.tMono $ cm ^. convertedModuleCryptolType) + $ cm ^. convertedModuleTerm + ) pure $ Map.fromList res -- | Given a Yosys IR, construct a SAWCore record for all modules. @@ -492,9 +630,9 @@ yosysIRToRecordTerm :: YosysIR -> m SC.TypedTerm yosysIRToRecordTerm sc ir = do - (termEnv, typeEnv) <- yosysIRToTerms sc ir - record <- cryptolRecord sc termEnv - let cty = C.tRec . C.recordFromFields $ first C.mkIdent <$> Map.assocs typeEnv + env <- yosysIRToTerms sc ir + record <- cryptolRecord sc $ view convertedModuleTerm <$> env + let cty = C.tRec . C.recordFromFields $ (\(nm, cm) -> (C.mkIdent nm, cm ^. convertedModuleCryptolType)) <$> Map.assocs env let tt = SC.TypedTerm (SC.TypedTermSchema $ C.tMono cty) record pure tt diff --git a/src/SAWScript/Yosys/Theorem.hs b/src/SAWScript/Yosys/Theorem.hs index 3659d1bed9..97d1b2e1a7 100644 --- a/src/SAWScript/Yosys/Theorem.hs +++ b/src/SAWScript/Yosys/Theorem.hs @@ -79,7 +79,7 @@ cryptolRecordSelect sc fields r nm = [ "Could not build record selector term for field name \"" , nm , "\" on record term: " - , Text.pack $ show r + , Text.pack $ SC.showTerm r , "\nFields are: " , Text.pack . show $ Map.keys fields ] From 82061e0f10ef119d686592e0057471fd8d570961 Mon Sep 17 00:00:00 2001 From: Samuel Breese Date: Sun, 1 May 2022 19:27:37 -0400 Subject: [PATCH 17/47] Refactoring to support better sequential circuit translation --- saw-script.cabal | 4 + src/SAWScript/Yosys.hs | 581 +++----------------------------- src/SAWScript/Yosys/Cell.hs | 206 +++++++++++ src/SAWScript/Yosys/IR.hs | 21 +- src/SAWScript/Yosys/Netgraph.hs | 291 ++++++++++++++++ src/SAWScript/Yosys/State.hs | 186 ++++++++++ src/SAWScript/Yosys/Theorem.hs | 105 +----- src/SAWScript/Yosys/Utils.hs | 126 +++++++ 8 files changed, 876 insertions(+), 644 deletions(-) create mode 100644 src/SAWScript/Yosys/Cell.hs create mode 100644 src/SAWScript/Yosys/Netgraph.hs create mode 100644 src/SAWScript/Yosys/State.hs create mode 100644 src/SAWScript/Yosys/Utils.hs diff --git a/saw-script.cabal b/saw-script.cabal index 101dd6ddd1..30aeb6e830 100644 --- a/saw-script.cabal +++ b/saw-script.cabal @@ -175,8 +175,12 @@ library SAWScript.X86Spec SAWScript.Yosys + SAWScript.Yosys.Cell SAWScript.Yosys.IR + SAWScript.Yosys.Netgraph + SAWScript.Yosys.State SAWScript.Yosys.Theorem + SAWScript.Yosys.Utils GHC-options: -O2 -Wall -fno-ignore-asserts -fno-spec-constr-count if impl(ghc == 8.0.1) diff --git a/src/SAWScript/Yosys.hs b/src/SAWScript/Yosys.hs index 60465206b1..5dbd029168 100644 --- a/src/SAWScript/Yosys.hs +++ b/src/SAWScript/Yosys.hs @@ -17,15 +17,10 @@ module SAWScript.Yosys import Control.Lens.TH (makeLenses) -import Control.Lens (at, view, (^.)) +import Control.Lens (view, (^.)) import Control.Monad (forM, foldM) import Control.Monad.IO.Class (MonadIO(..)) -import Control.Exception (throw) -import qualified Data.Tuple as Tuple -import qualified Data.Maybe as Maybe -import qualified Data.Foldable as Foldable -import qualified Data.List as List import qualified Data.List.NonEmpty as NE import Data.Map (Map) import qualified Data.Map as Map @@ -33,23 +28,22 @@ import Data.Text (Text) import qualified Data.Text as Text import qualified Data.Graph as Graph -import Numeric.Natural (Natural) - import qualified Text.URI as URI import qualified Verifier.SAW.SharedTerm as SC import qualified Verifier.SAW.TypedTerm as SC -import qualified Verifier.SAW.Name as SC import qualified Cryptol.TypeCheck.Type as C import qualified Cryptol.Utils.Ident as C import qualified Cryptol.Utils.RecordMap as C -import SAWScript.Panic (panic) import SAWScript.Value import qualified SAWScript.Builtins as Builtins +import SAWScript.Yosys.Utils import SAWScript.Yosys.IR +import SAWScript.Yosys.Netgraph +import SAWScript.Yosys.State import SAWScript.Yosys.Theorem -------------------------------------------------------------------------------- @@ -74,516 +68,13 @@ yosysIRModgraph ir = = Graph.graphFromEdges nodes in Modgraph{..} --------------------------------------------------------------------------------- --- ** Building a network graph from a Yosys module - -data Netgraph = Netgraph - { _netgraphGraph :: Graph.Graph - , _netgraphNodeFromVertex :: Graph.Vertex -> ((Text, Cell), Bitrep, [Bitrep]) - -- , _netgraphVertexFromKey :: Bitrep -> Maybe Graph.Vertex - } -makeLenses ''Netgraph - -cellInputConnections :: Cell -> Map Text [Bitrep] -cellInputConnections c - | c ^. cellType == "$dff" = Map.empty - | otherwise = Map.intersection (c ^. cellConnections) inp - where - inp = Map.filter (\d -> d == DirectionInput || d == DirectionInout) $ c ^. cellPortDirections - -cellOutputConnections :: Cell -> Map [Bitrep] Text -cellOutputConnections c = Map.fromList . fmap Tuple.swap . Map.toList $ Map.intersection (c ^. cellConnections) out - where - out = Map.filter (\d -> d == DirectionOutput || d == DirectionInout) $ c ^. cellPortDirections - -moduleNetgraph :: Module -> Netgraph -moduleNetgraph m = - let - bitsFromInputPorts :: [Bitrep] - bitsFromInputPorts = (<> [BitrepZero, BitrepOne]) - . List.nub - . mconcat - . Maybe.mapMaybe - ( \(_, p) -> - case p ^. portDirection of - DirectionInput -> Just $ p ^. portBits - DirectionInout -> Just $ p ^. portBits - _ -> Nothing - ) - . Map.assocs - $ m ^. modulePorts - cellToNodes :: (Text, Cell) -> [((Text, Cell), Bitrep, [Bitrep])] - cellToNodes (nm, c) - | c ^. cellType == "$dff" = ((nm, c), , []) <$> outputBits - | otherwise = ((nm, c), , inputBits) <$> outputBits - where - inputBits :: [Bitrep] - inputBits = - filter (not . flip elem bitsFromInputPorts) - . List.nub - . mconcat - . Maybe.mapMaybe - ( \(p, bits) -> - case c ^. cellPortDirections . at p of - Just DirectionInput -> Just bits - Just DirectionInout -> Just bits - _ -> Nothing - ) - . Map.assocs - $ c ^. cellConnections - outputBits :: [Bitrep] - outputBits = List.nub - . mconcat - . Maybe.mapMaybe - ( \(p, bits) -> - case c ^. cellPortDirections . at p of - Just DirectionOutput -> Just bits - Just DirectionInout -> Just bits - _ -> Nothing - ) - . Map.assocs - $ c ^. cellConnections - nodes = concatMap cellToNodes . Map.assocs $ m ^. moduleCells - (_netgraphGraph, _netgraphNodeFromVertex, _netgraphVertexFromKey) - = Graph.graphFromEdges nodes - in Netgraph{..} - --------------------------------------------------------------------------------- --- ** Building a SAWCore term from a network graph - -data ConvertedModule = ConvertedModule - { _convertedModuleTerm :: SC.Term - , _convertedModuleType :: SC.Term - , _convertedModuleCryptolType :: C.Type - , _convertedModuleStateFields :: Maybe (Map Text (SC.Term, C.Type)) - } -makeLenses ''ConvertedModule - --- | Given a Yosys cell and a map of terms for its arguments, construct a term representing the output. -cellToTerm :: - forall m a. - MonadIO m => - SC.SharedContext -> - Map Text ConvertedModule {- ^ Environment of user-defined cells -} -> - Map Text a {- ^ Mapping from output names used to construct record lookups -} -> - Maybe SC.Term {- ^ State term for this cell, if it exists -} -> - Cell {- ^ Cell type -} -> - Map Text SC.Term {- ^ Mapping of input names to input terms -} -> - m (SC.Term, Maybe SC.Term) -cellToTerm sc env outputFields mst c args = case c ^. cellType of - "$dff" - | Just st <- mst -> do - fmap (,Nothing) . cryptolRecord sc $ Map.fromList - [ ("Q", st) - ] - | otherwise -> panic "cellToTerm" [Text.unpack $ mconcat ["Flip-flop cell has no associated state term"]] - "$not" -> bvUnaryOp $ SC.scBvNot sc - "$pos" -> do - res <- input "A" - fmap (,Nothing) . cryptolRecord sc $ Map.fromList - [ ("Y", res) - ] - "$neg" -> bvUnaryOp $ SC.scBvNeg sc - "$and" -> bvNAryOp $ SC.scBvAnd sc - "$or" -> bvNAryOp $ SC.scBvOr sc - "$xor" -> bvNAryOp $ SC.scBvXor sc - "$xnor" -> bvNAryOp $ \w x y -> do - r <- SC.scBvXor sc w x y - SC.scBvNot sc w r - "$reduce_and" -> bvReduce True =<< do - liftIO . SC.scLookupDef sc $ SC.mkIdent SC.preludeName "and" - "$reduce_or" -> bvReduce False =<< do - liftIO . SC.scLookupDef sc $ SC.mkIdent SC.preludeName "or" - "$reduce_xor" -> bvReduce False =<< do - liftIO . SC.scLookupDef sc $ SC.mkIdent SC.preludeName "xor" - "$reduce_xnor" -> bvReduce True =<< do - boolTy <- liftIO $ SC.scBoolType sc - xEC <- liftIO $ SC.scFreshEC sc "x" boolTy - x <- liftIO $ SC.scExtCns sc xEC - yEC <- liftIO $ SC.scFreshEC sc "y" boolTy - y <- liftIO $ SC.scExtCns sc yEC - r <- liftIO $ SC.scXor sc x y - res <- liftIO $ SC.scNot sc r - liftIO $ SC.scAbstractExts sc [xEC, yEC] res - "$reduce_bool" -> bvReduce False =<< do - liftIO . SC.scLookupDef sc $ SC.mkIdent SC.preludeName "or" - "$shl" -> bvBinaryOp $ SC.scBvShl sc - "$shr" -> bvBinaryOp $ SC.scBvShr sc - "$sshl" -> bvBinaryOp $ SC.scBvShl sc -- same as shl - "$sshr" -> bvBinaryOp $ SC.scBvSShr sc - -- "$shift" -> _ - -- "$shiftx" -> _ - "$lt" -> bvBinaryCmp $ SC.scBvULt sc - "$le" -> bvBinaryCmp $ SC.scBvULe sc - "$gt" -> bvBinaryCmp $ SC.scBvUGt sc - "$ge" -> bvBinaryCmp $ SC.scBvUGe sc - "$eq" -> bvBinaryCmp $ SC.scBvEq sc - "$ne" -> bvBinaryCmp $ \w x y -> do - r <- SC.scBvEq sc w x y - SC.scNot sc r - "$eqx" -> bvBinaryCmp $ SC.scBvEq sc - "$nex" -> bvBinaryCmp $ \w x y -> do - r <- SC.scBvEq sc w x y - SC.scNot sc r - "$add" -> bvNAryOp $ SC.scBvAdd sc - "$sub" -> bvBinaryOp $ SC.scBvSub sc - "$mul" -> bvNAryOp $ SC.scBvMul sc - "$div" -> bvBinaryOp $ SC.scBvUDiv sc - "$mod" -> bvBinaryOp $ SC.scBvURem sc - -- "$modfloor" -> _ - "$logic_not" -> do - w <- outputWidth - ta <- input "A" - anz <- liftIO $ SC.scBvNonzero sc w ta - res <- liftIO $ SC.scNot sc anz - fmap (,Nothing) . cryptolRecord sc $ Map.fromList - [ ("Y", res) - ] - "$logic_and" -> do - w <- outputWidth - ta <- input "A" - tb <- input "B" - anz <- liftIO $ SC.scBvNonzero sc w ta - bnz <- liftIO $ SC.scBvNonzero sc w tb - res <- liftIO $ SC.scAnd sc anz bnz - fmap (,Nothing) . cryptolRecord sc $ Map.fromList - [ ("Y", res) - ] - "$logic_or" -> do - w <- outputWidth - ta <- input "A" - tb <- input "B" - anz <- liftIO $ SC.scBvNonzero sc w ta - bnz <- liftIO $ SC.scBvNonzero sc w tb - res <- liftIO $ SC.scOr sc anz bnz - fmap (,Nothing) . cryptolRecord sc $ Map.fromList - [ ("Y", res) - ] - "$mux" -> do - w <- outputWidth - ta <- input "A" - tb <- input "B" - ts <- input "S" - snz <- liftIO $ SC.scBvNonzero sc w ts - ty <- liftIO $ SC.scBitvector sc outputWidthNat - res <- liftIO $ SC.scIte sc ty snz tb ta - fmap (,Nothing) . cryptolRecord sc $ Map.fromList - [ ("Y", res) - ] - -- "$pmux" -> _ - -- "$bmux" -> _ - -- "$demux" -> _ - -- "$lut" -> _ - -- "$slice" -> _ - -- "$concat" -> _ - (flip Map.lookup env -> Just cm) -> do - r <- cryptolRecord sc $ case mst of - Nothing -> args - Just st -> Map.insert "__state__" st args - res <- liftIO $ SC.scApply sc (cm ^. convertedModuleTerm) r - post <- case mst of - Nothing -> pure Nothing - Just _ -> Just <$> cryptolRecordSelect sc outputFields res "__state__" - pure (res, post) - ct -> throw . YosysError $ "Unknown cell type: " <> ct - where - nm = c ^. cellType - outputWidthNat :: Natural - outputWidthNat = - case Map.lookup "Y" $ c ^. cellConnections of - Nothing -> panic "cellToTerm" [Text.unpack $ mconcat ["Missing expected output name for ", nm, " cell"]] - Just bits -> fromIntegral $ length bits - outputWidth :: m SC.Term - outputWidth = liftIO $ SC.scNat sc outputWidthNat - input :: Text -> m SC.Term - input inpNm = - case Map.lookup inpNm args of - Nothing -> panic "cellToTerm" [Text.unpack $ mconcat [nm, " missing input ", inpNm]] - Just a -> pure a - bvUnaryOp :: (SC.Term -> SC.Term -> IO SC.Term) -> m (SC.Term, Maybe SC.Term) - bvUnaryOp f = do - t <- input "A" - w <- outputWidth - res <- liftIO $ f w t - fmap (,Nothing) . cryptolRecord sc $ Map.fromList - [ ("Y", res) - ] - bvBinaryOp :: (SC.Term -> SC.Term -> SC.Term -> IO SC.Term) -> m (SC.Term, Maybe SC.Term) - bvBinaryOp f = do - ta <- input "A" - tb <- input "B" - w <- outputWidth - res <- liftIO $ f w ta tb - fmap (,Nothing) . cryptolRecord sc $ Map.fromList - [ ("Y", res) - ] - bvBinaryCmp :: (SC.Term -> SC.Term -> SC.Term -> IO SC.Term) -> m (SC.Term, Maybe SC.Term) - bvBinaryCmp f = do - ta <- input "A" - tb <- input "B" - w <- outputWidth - bit <- liftIO $ f w ta tb - boolty <- liftIO $ SC.scBoolType sc - res <- liftIO $ SC.scSingle sc boolty bit - fmap (,Nothing) . cryptolRecord sc $ Map.fromList - [ ("Y", res) - ] - bvNAryOp :: (SC.Term -> SC.Term -> SC.Term -> IO SC.Term) -> m (SC.Term, Maybe SC.Term) - bvNAryOp f = - case Foldable.toList args of - [] -> panic "cellToTerm" [Text.unpack $ mconcat [nm, " cell given no inputs"]] - (t:rest) -> do - w <- outputWidth - res <- liftIO $ foldM (f w) t rest - fmap (,Nothing) . cryptolRecord sc $ Map.fromList - [ ("Y", res) - ] - bvReduce :: Bool -> SC.Term -> m (SC.Term, Maybe SC.Term) - bvReduce boolIdentity boolFun = do - t <- input "A" - w <- outputWidth - boolTy <- liftIO $ SC.scBoolType sc - identity <- liftIO $ SC.scBool sc boolIdentity - scFoldr <- liftIO . SC.scLookupDef sc $ SC.mkIdent SC.preludeName "foldr" - bit <- liftIO $ SC.scApplyAll sc scFoldr [boolTy, boolTy, w, boolFun, identity, t] - boolty <- liftIO $ SC.scBoolType sc - res <- liftIO $ SC.scSingle sc boolty bit - fmap (,Nothing) . cryptolRecord sc $ Map.fromList - [ ("Y", res) - ] - --- | Given a bit pattern ([Bitrep]) and a term, construct a map associating that output pattern with --- the term, and each bit of that pattern with the corresponding bit of the term. -deriveTermsByIndices :: MonadIO m => SC.SharedContext -> [Bitrep] -> SC.Term -> m (Map [Bitrep] SC.Term) -deriveTermsByIndices sc rep t = do - boolty <- liftIO $ SC.scBoolType sc - telems <- forM [0..length rep] $ \index -> do - tlen <- liftIO . SC.scNat sc . fromIntegral $ length rep - idx <- liftIO . SC.scNat sc $ fromIntegral index - bit <- liftIO $ SC.scAt sc tlen boolty t idx - liftIO $ SC.scSingle sc boolty bit - pure . Map.fromList $ mconcat - [ [(rep, t)] - , zip ((:[]) <$> rep) telems - ] - -lookupPatternTerm :: - MonadIO m => - SC.SharedContext -> - [Bitrep] -> - Map [Bitrep] SC.Term -> - m SC.Term -lookupPatternTerm sc pat ts = - case Map.lookup pat ts of - Just t -> pure t - Nothing -> do - one <- liftIO $ SC.scNat sc 1 - boolty <- liftIO $ SC.scBoolType sc - many <- liftIO . SC.scNat sc . fromIntegral $ length pat - vecty <- liftIO $ SC.scVecType sc many boolty - bits <- forM pat $ \b -> do - case Map.lookup [b] ts of - Just t -> pure t - Nothing -> do - throw . YosysError $ "Failed to find output bitvec: " <> Text.pack (show b) - vecBits <- liftIO $ SC.scVector sc vecty bits - liftIO $ SC.scJoin sc many one boolty vecBits - --- | Given a netgraph and an initial map from bit patterns to terms, populate that map with terms --- generated from the rest of the netgraph. -netgraphToTerms :: - MonadIO m => - SC.SharedContext -> - Map Text ConvertedModule -> - Map Text (SC.Term, C.Type) -> - Maybe SC.Term -> - Netgraph -> - Map [Bitrep] SC.Term -> - m (Map [Bitrep] SC.Term, Map Text SC.Term) -netgraphToTerms sc env stateFields mst ng inputs - | length (Graph.scc $ ng ^. netgraphGraph) /= length (ng ^. netgraphGraph) - = do - throw $ YosysError "Network graph contains a cycle after splitting on DFFs; SAW does not currently support analysis of this circuit" - | otherwise = do - let sorted = Graph.reverseTopSort $ ng ^. netgraphGraph - foldM - ( \(acc, stateAcc) v -> do - let ((nm, c), _output, _deps) = ng ^. netgraphNodeFromVertex $ v - -- liftIO $ putStrLn $ mconcat ["Building term for output: ", show output, " and inputs: ", show deps] - - args <- forM (cellInputConnections c) $ \i -> do -- for each input bit pattern - -- if we can find that pattern exactly, great! use that term - -- otherwise, find each individual bit and append the terms - lookupPatternTerm sc i acc - - let portFields = Map.filter (\d -> d == DirectionOutput || d == DirectionInout) $ c ^. cellPortDirections - (cellmst, outputFields) <- case mst of - Just st - | Just _ <- Map.lookup nm stateFields -> do - cellmst <- Just <$> cryptolRecordSelect sc stateFields st nm - pure (cellmst, if c ^. cellType == "$dff" then portFields else Map.insert "__state__" DirectionOutput portFields) - _ -> pure (Nothing, portFields) - - (r, mpost) <- cellToTerm sc env outputFields cellmst c args - - -- once we've built a term, insert it along with each of its bits - ts <- forM (Map.assocs $ cellOutputConnections c) $ \(out, o) -> do - t <- cryptolRecordSelect sc outputFields r o - deriveTermsByIndices sc out t - pure - ( Map.union (Map.unions ts) acc - , case mpost of - Nothing -> stateAcc - Just post -> Map.insert nm post stateAcc - ) - ) - (inputs, Map.empty) - sorted - -convertModule :: - MonadIO m => - SC.SharedContext -> - Map Text ConvertedModule -> - Module -> - m ConvertedModule -convertModule sc env m = do - let ng = moduleNetgraph m - let clockCandidates = List.nub - . Maybe.mapMaybe - ( \(_nm, c) -> if c ^. cellType == "$dff" - then Map.lookup "CLK" (c ^. cellConnections) - else Nothing - ) - . Map.assocs - $ m ^. moduleCells - let clockBits = case clockCandidates of - [] -> [] - [b] -> b - _ -> throw . YosysError $ mconcat - [ "Multiple clocks detected (bits: " - , Text.pack $ show clockCandidates - , ")\nSAW only supports sequential circuits with a single clock" - ] - - let inputports = Maybe.mapMaybe - ( \(nm, ip) -> - if - (ip ^. portDirection == DirectionInput || ip ^. portDirection == DirectionInout) - && (ip ^. portBits /= clockBits) - then Just (nm, ip ^. portBits) - else Nothing - ) - . Map.assocs - $ m ^. modulePorts - let outputports = Maybe.mapMaybe - ( \(nm, ip) -> - if ip ^. portDirection == DirectionOutput || ip ^. portDirection == DirectionInout - then Just (nm, ip ^. portBits) - else Nothing - ) - . Map.assocs - $ m ^. modulePorts - - stateFields <- Map.fromList - . Maybe.catMaybes - <$> mapM - ( \v -> - let ((nm, c), _output, _deps) = ng ^. netgraphNodeFromVertex $ v - in if - | c ^. cellType == "$dff" - , Just b <- Map.lookup "Q" $ c ^. cellConnections -> do - let w = length b - ty <- liftIO $ SC.scBitvector sc $ fromIntegral w - let cty = C.tWord $ C.tNum w - pure $ Just (nm, (ty, cty)) - | Just cm <- Map.lookup (c ^. cellType) env - , Just fields <- cm ^. convertedModuleStateFields -> do - ty <- cryptolRecordType sc (fst <$> fields) - let cty = C.tRec . C.recordFromFields $ (\(cnm, (_, t)) -> (C.mkIdent cnm, t)) <$> Map.assocs fields - pure $ Just (nm, (ty, cty)) - | otherwise -> pure Nothing - ) - (Graph.vertices $ ng ^. netgraphGraph) - stateRecordType <- cryptolRecordType sc $ fst <$> stateFields - let stateRecordCryptolType = C.tRec . C.recordFromFields $ (\(cnm, (_, t)) -> (C.mkIdent cnm, t)) <$> Map.assocs stateFields - - let addStateType fs = if Map.null stateFields then fs else Map.insert "__state__" stateRecordType fs - inputFields <- addStateType . Map.fromList <$> forM inputports - (\(nm, inp) -> do - tp <- liftIO . SC.scBitvector sc . fromIntegral $ length inp - pure (nm, tp) - ) - outputFields <- addStateType . Map.fromList <$> forM outputports - (\(nm, out) -> do - tp <- liftIO . SC.scBitvector sc . fromIntegral $ length out - pure (nm, tp) - ) - inputRecordType <- cryptolRecordType sc inputFields - outputRecordType <- cryptolRecordType sc outputFields - inputRecordEC <- liftIO $ SC.scFreshEC sc "input" inputRecordType - inputRecord <- liftIO $ SC.scExtCns sc inputRecordEC - - derivedInputs <- forM inputports $ \(nm, inp) -> do - t <- liftIO $ cryptolRecordSelect sc inputFields inputRecord nm - deriveTermsByIndices sc inp t - - stateRecordTerm <- if Map.null stateFields - then pure Nothing - else liftIO $ Just <$> cryptolRecordSelect sc inputFields inputRecord "__state__" - - zeroTerm <- liftIO $ SC.scBvConst sc 1 0 - oneTerm <- liftIO $ SC.scBvConst sc 1 1 - let inputs = Map.unions $ mconcat - [ [ Map.fromList - [ ( [BitrepZero], zeroTerm) - , ( [BitrepOne], oneTerm ) - ] - ] - , derivedInputs - ] - - (terms, modulePostStates) <- netgraphToTerms sc env stateFields stateRecordTerm ng inputs - dffBackedges <- fmap (Map.fromList . Maybe.catMaybes) - . mapM - ( \(nm, c) -> if - | c ^. cellType == "$dff" - , Just b <- Map.lookup "D" (c ^. cellConnections) - -> do - t <- lookupPatternTerm sc b terms - pure $ Just (nm, t) - | otherwise -> pure Nothing - ) - . Map.assocs - $ m ^. moduleCells - let postStateFields = Map.union dffBackedges modulePostStates - postStateRecord <- cryptolRecord sc postStateFields - - let addState fs = if Map.null stateFields then fs else Map.insert "__state__" postStateRecord fs - outputRecord <- cryptolRecord sc . addState . Map.fromList =<< forM outputports - (\(nm, out) -> (nm,) <$> lookupPatternTerm sc out terms) - - t <- liftIO $ SC.scAbstractExts sc [inputRecordEC] outputRecord - ty <- liftIO $ SC.scFun sc inputRecordType outputRecordType - - let addStateCryptolType fs = if Map.null stateFields then fs else ("__state__", stateRecordCryptolType):fs - let toCryptol (nm, rep) = (C.mkIdent nm, C.tWord . C.tNum $ length rep) - let cty = C.tFun - (C.tRec . C.recordFromFields . addStateCryptolType $ toCryptol <$> inputports) - (C.tRec . C.recordFromFields . addStateCryptolType $ toCryptol <$> outputports) - pure ConvertedModule - { _convertedModuleTerm = t - , _convertedModuleType = ty - , _convertedModuleCryptolType = cty - , _convertedModuleStateFields = if Map.null stateFields then Nothing else Just stateFields - } - --- | Given a Yosys IR, construct records associating module names with SAWCore terms and Cryptol types. -yosysIRToTerms :: +-- | Given a Yosys IR, construct a map from module names to SAWCore terms alongside SAWCore and Cryptol types +convertYosysIR :: MonadIO m => SC.SharedContext -> YosysIR -> m (Map Text ConvertedModule) -yosysIRToTerms sc ir = do +convertYosysIR sc ir = do let mg = yosysIRModgraph ir let sorted = Graph.reverseTopSort $ mg ^. modgraphGraph foldM @@ -606,31 +97,63 @@ yosysIRToTerms sc ir = do Map.empty sorted --- | Given a Yosys IR, construct a record of TypedTerms +-- | Given a Yosys IR, construct a map from module names to TypedTerms yosysIRToTypedTerms :: MonadIO m => SC.SharedContext -> YosysIR -> m (Map Text SC.TypedTerm) yosysIRToTypedTerms sc ir = do - env <- yosysIRToTerms sc ir - res <- forM (Map.assocs env) $ \(nm, cm) -> - pure - ( nm - , SC.TypedTerm - (SC.TypedTermSchema $ C.tMono $ cm ^. convertedModuleCryptolType) - $ cm ^. convertedModuleTerm - ) - pure $ Map.fromList res + env <- convertYosysIR sc ir + pure . flip fmap env $ \cm -> + SC.TypedTerm + (SC.TypedTermSchema $ C.tMono $ cm ^. convertedModuleCryptolType) + $ cm ^. convertedModuleTerm --- | Given a Yosys IR, construct a SAWCore record for all modules. +-- | Given a Yosys IR, construct a SAWCore record containing terms for each module yosysIRToRecordTerm :: MonadIO m => SC.SharedContext -> YosysIR -> m SC.TypedTerm yosysIRToRecordTerm sc ir = do - env <- yosysIRToTerms sc ir + env <- convertYosysIR sc ir + record <- cryptolRecord sc $ view convertedModuleTerm <$> env + let cty = C.tRec . C.recordFromFields $ (\(nm, cm) -> (C.mkIdent nm, cm ^. convertedModuleCryptolType)) <$> Map.assocs env + let tt = SC.TypedTerm (SC.TypedTermSchema $ C.tMono cty) record + pure tt + +-- | Given a Yosys IR, construct a map from module names to SAWCore terms alongside SAWCore and Cryptol types +convertYosysIRInline :: + MonadIO m => + SC.SharedContext -> + YosysIR -> + m (Map Text ConvertedModule) +convertYosysIRInline sc ir = do + res <- forM (Map.assocs $ ir ^. yosysModules) $ \(nm, m) -> do + -- liftIO $ putStrLn $ "Converting: " <> Text.unpack nm + cm <- convertModuleInline sc (ir ^. yosysModules) m + let uri = URI.URI + { URI.uriScheme = URI.mkScheme "yosys" + , URI.uriAuthority = Left True + , URI.uriPath = (False,) <$> mapM URI.mkPathPiece (nm NE.:| []) + , URI.uriQuery = [] + , URI.uriFragment = Nothing + } + let ni = SC.ImportedName uri [nm] + tc <- liftIO $ SC.scConstant' sc ni (cm ^. convertedModuleTerm) (cm ^. convertedModuleType) + let cm' = cm { _convertedModuleTerm = tc } + pure (nm, cm') + pure $ Map.fromList res + +-- | Given a Yosys IR, construct a SAWCore record containing terms for each module +yosysIRToRecordTermInline :: + MonadIO m => + SC.SharedContext -> + YosysIR -> + m SC.TypedTerm +yosysIRToRecordTermInline sc ir = do + env <- convertYosysIRInline sc ir record <- cryptolRecord sc $ view convertedModuleTerm <$> env let cty = C.tRec . C.recordFromFields $ (\(nm, cm) -> (C.mkIdent nm, cm ^. convertedModuleCryptolType)) <$> Map.assocs env let tt = SC.TypedTerm (SC.TypedTermSchema $ C.tMono cty) record @@ -645,7 +168,7 @@ yosys_import :: FilePath -> TopLevel SC.TypedTerm yosys_import path = do sc <- getSharedContext ir <- loadYosysIR path - yosysIRToRecordTerm sc ir + yosysIRToRecordTermInline sc ir yosys_verify :: SC.TypedTerm -> [SC.TypedTerm] -> SC.TypedTerm -> [YosysTheorem] -> ProofScript () -> TopLevel YosysTheorem yosys_verify ymod preconds other specs tactic = do diff --git a/src/SAWScript/Yosys/Cell.hs b/src/SAWScript/Yosys/Cell.hs new file mode 100644 index 0000000000..26fa31aa3c --- /dev/null +++ b/src/SAWScript/Yosys/Cell.hs @@ -0,0 +1,206 @@ +{-# Language TemplateHaskell #-} +{-# Language OverloadedStrings #-} +{-# Language RecordWildCards #-} +{-# Language ViewPatterns #-} +{-# Language LambdaCase #-} +{-# Language MultiWayIf #-} +{-# Language TupleSections #-} +{-# Language ScopedTypeVariables #-} + +module SAWScript.Yosys.Cell where + +import Control.Lens ((^.)) +import Control.Monad (foldM) +import Control.Monad.IO.Class (MonadIO(..)) + +import qualified Data.Foldable as Foldable +import Data.Map (Map) +import qualified Data.Map as Map +import Data.Text (Text) +import qualified Data.Text as Text + +import Numeric.Natural (Natural) + +import qualified Verifier.SAW.SharedTerm as SC +import qualified Verifier.SAW.Name as SC + +import SAWScript.Panic (panic) + +import SAWScript.Yosys.Utils +import SAWScript.Yosys.IR + +-- | Given a primitive Yosys cell and a map of terms for its arguments, construct a record term representing the output. +-- If the provided cell is not a primitive, return Nothing. +primCellToTerm :: + forall m b. + MonadIO m => + SC.SharedContext -> + Cell [b] {- ^ Cell type -} -> + Map Text SC.Term {- ^ Mapping of input names to input terms -} -> + m (Maybe SC.Term) +primCellToTerm sc c args = case c ^. cellType of + "$not" -> bvUnaryOp $ SC.scBvNot sc + "$pos" -> do + res <- input "A" + fmap Just . cryptolRecord sc $ Map.fromList + [ ("Y", res) + ] + "$neg" -> bvUnaryOp $ SC.scBvNeg sc + "$and" -> bvNAryOp $ SC.scBvAnd sc + "$or" -> bvNAryOp $ SC.scBvOr sc + "$xor" -> bvNAryOp $ SC.scBvXor sc + "$xnor" -> bvNAryOp $ \w x y -> do + r <- SC.scBvXor sc w x y + SC.scBvNot sc w r + "$reduce_and" -> bvReduce True =<< do + liftIO . SC.scLookupDef sc $ SC.mkIdent SC.preludeName "and" + "$reduce_or" -> bvReduce False =<< do + liftIO . SC.scLookupDef sc $ SC.mkIdent SC.preludeName "or" + "$reduce_xor" -> bvReduce False =<< do + liftIO . SC.scLookupDef sc $ SC.mkIdent SC.preludeName "xor" + "$reduce_xnor" -> bvReduce True =<< do + boolTy <- liftIO $ SC.scBoolType sc + xEC <- liftIO $ SC.scFreshEC sc "x" boolTy + x <- liftIO $ SC.scExtCns sc xEC + yEC <- liftIO $ SC.scFreshEC sc "y" boolTy + y <- liftIO $ SC.scExtCns sc yEC + r <- liftIO $ SC.scXor sc x y + res <- liftIO $ SC.scNot sc r + liftIO $ SC.scAbstractExts sc [xEC, yEC] res + "$reduce_bool" -> bvReduce False =<< do + liftIO . SC.scLookupDef sc $ SC.mkIdent SC.preludeName "or" + "$shl" -> bvBinaryOp $ SC.scBvShl sc + "$shr" -> bvBinaryOp $ SC.scBvShr sc + "$sshl" -> bvBinaryOp $ SC.scBvShl sc -- same as shl + "$sshr" -> bvBinaryOp $ SC.scBvSShr sc + -- "$shift" -> _ + -- "$shiftx" -> _ + "$lt" -> bvBinaryCmp $ SC.scBvULt sc + "$le" -> bvBinaryCmp $ SC.scBvULe sc + "$gt" -> bvBinaryCmp $ SC.scBvUGt sc + "$ge" -> bvBinaryCmp $ SC.scBvUGe sc + "$eq" -> bvBinaryCmp $ SC.scBvEq sc + "$ne" -> bvBinaryCmp $ \w x y -> do + r <- SC.scBvEq sc w x y + SC.scNot sc r + "$eqx" -> bvBinaryCmp $ SC.scBvEq sc + "$nex" -> bvBinaryCmp $ \w x y -> do + r <- SC.scBvEq sc w x y + SC.scNot sc r + "$add" -> bvNAryOp $ SC.scBvAdd sc + "$sub" -> bvBinaryOp $ SC.scBvSub sc + "$mul" -> bvNAryOp $ SC.scBvMul sc + "$div" -> bvBinaryOp $ SC.scBvUDiv sc + "$mod" -> bvBinaryOp $ SC.scBvURem sc + -- "$modfloor" -> _ + "$logic_not" -> do + w <- outputWidth + ta <- input "A" + anz <- liftIO $ SC.scBvNonzero sc w ta + res <- liftIO $ SC.scNot sc anz + fmap Just . cryptolRecord sc $ Map.fromList + [ ("Y", res) + ] + "$logic_and" -> do + w <- outputWidth + ta <- input "A" + tb <- input "B" + anz <- liftIO $ SC.scBvNonzero sc w ta + bnz <- liftIO $ SC.scBvNonzero sc w tb + res <- liftIO $ SC.scAnd sc anz bnz + fmap Just . cryptolRecord sc $ Map.fromList + [ ("Y", res) + ] + "$logic_or" -> do + w <- outputWidth + ta <- input "A" + tb <- input "B" + anz <- liftIO $ SC.scBvNonzero sc w ta + bnz <- liftIO $ SC.scBvNonzero sc w tb + res <- liftIO $ SC.scOr sc anz bnz + fmap Just . cryptolRecord sc $ Map.fromList + [ ("Y", res) + ] + "$mux" -> do + w <- outputWidth + ta <- input "A" + tb <- input "B" + ts <- input "S" + snz <- liftIO $ SC.scBvNonzero sc w ts + ty <- liftIO $ SC.scBitvector sc outputWidthNat + res <- liftIO $ SC.scIte sc ty snz tb ta + fmap Just . cryptolRecord sc $ Map.fromList + [ ("Y", res) + ] + -- "$pmux" -> _ + -- "$bmux" -> _ + -- "$demux" -> _ + -- "$lut" -> _ + -- "$slice" -> _ + -- "$concat" -> _ + _ -> pure Nothing + where + nm = c ^. cellType + outputWidthNat :: Natural + outputWidthNat = + case Map.lookup "Y" $ c ^. cellConnections of + Nothing -> panic "cellToTerm" [Text.unpack $ mconcat ["Missing expected output name for ", nm, " cell"]] + Just bits -> fromIntegral $ length bits + outputWidth :: m SC.Term + outputWidth = liftIO $ SC.scNat sc outputWidthNat + input :: Text -> m SC.Term + input inpNm = + case Map.lookup inpNm args of + Nothing -> panic "cellToTerm" [Text.unpack $ mconcat [nm, " missing input ", inpNm]] + Just a -> pure a + bvUnaryOp :: (SC.Term -> SC.Term -> IO SC.Term) -> m (Maybe SC.Term) + bvUnaryOp f = do + t <- input "A" + w <- outputWidth + res <- liftIO $ f w t + fmap Just . cryptolRecord sc $ Map.fromList + [ ("Y", res) + ] + bvBinaryOp :: (SC.Term -> SC.Term -> SC.Term -> IO SC.Term) -> m (Maybe SC.Term) + bvBinaryOp f = do + ta <- input "A" + tb <- input "B" + w <- outputWidth + res <- liftIO $ f w ta tb + fmap Just . cryptolRecord sc $ Map.fromList + [ ("Y", res) + ] + bvBinaryCmp :: (SC.Term -> SC.Term -> SC.Term -> IO SC.Term) -> m (Maybe SC.Term) + bvBinaryCmp f = do + ta <- input "A" + tb <- input "B" + w <- outputWidth + bit <- liftIO $ f w ta tb + boolty <- liftIO $ SC.scBoolType sc + res <- liftIO $ SC.scSingle sc boolty bit + fmap Just . cryptolRecord sc $ Map.fromList + [ ("Y", res) + ] + bvNAryOp :: (SC.Term -> SC.Term -> SC.Term -> IO SC.Term) -> m (Maybe SC.Term) + bvNAryOp f = + case Foldable.toList args of + [] -> panic "cellToTerm" [Text.unpack $ mconcat [nm, " cell given no inputs"]] + (t:rest) -> do + w <- outputWidth + res <- liftIO $ foldM (f w) t rest + fmap Just . cryptolRecord sc $ Map.fromList + [ ("Y", res) + ] + bvReduce :: Bool -> SC.Term -> m (Maybe SC.Term) + bvReduce boolIdentity boolFun = do + t <- input "A" + w <- outputWidth + boolTy <- liftIO $ SC.scBoolType sc + identity <- liftIO $ SC.scBool sc boolIdentity + scFoldr <- liftIO . SC.scLookupDef sc $ SC.mkIdent SC.preludeName "foldr" + bit <- liftIO $ SC.scApplyAll sc scFoldr [boolTy, boolTy, w, boolFun, identity, t] + boolty <- liftIO $ SC.scBoolType sc + res <- liftIO $ SC.scSingle sc boolty bit + fmap Just . cryptolRecord sc $ Map.fromList + [ ("Y", res) + ] diff --git a/src/SAWScript/Yosys/IR.hs b/src/SAWScript/Yosys/IR.hs index 872f7f3ea0..f650fbaf45 100644 --- a/src/SAWScript/Yosys/IR.hs +++ b/src/SAWScript/Yosys/IR.hs @@ -3,13 +3,15 @@ {-# Language RecordWildCards #-} {-# Language LambdaCase #-} {-# Language TupleSections #-} +{-# Language FlexibleInstances #-} +{-# Language DeriveFunctor #-} module SAWScript.Yosys.IR where import Control.Lens.TH (makeLenses) import Control.Monad.IO.Class (MonadIO(..)) -import Control.Exception (Exception, throw) +import Control.Exception (throw) import Data.Map (Map) import Data.Text (Text) @@ -17,14 +19,11 @@ import qualified Data.Text as Text import qualified Data.Aeson as Aeson +import SAWScript.Yosys.Utils + -------------------------------------------------------------------------------- -- ** Representing and loading the Yosys JSON IR -newtype YosysError = YosysError Text -instance Exception YosysError -instance Show YosysError where - show (YosysError msg) = Text.unpack $ "Error: " <> msg - data Direction = DirectionInput | DirectionOutput @@ -70,16 +69,16 @@ instance Aeson.FromJSON Port where _ -> pure False pure Port{..} -data Cell = Cell +data Cell bs = Cell { _cellHideName :: Bool , _cellType :: Text , _cellParameters :: Map Text Text , _cellAttributes :: Aeson.Value , _cellPortDirections :: Map Text Direction - , _cellConnections :: Map Text [Bitrep] - } deriving (Show, Eq, Ord) + , _cellConnections :: Map Text bs + } deriving (Show, Eq, Ord, Functor) makeLenses ''Cell -instance Aeson.FromJSON Cell where +instance Aeson.FromJSON (Cell [Bitrep]) where parseJSON = Aeson.withObject "cell" $ \o -> do _cellHideName <- o Aeson..:? "hide_name" >>= \case Just (Aeson.Number 1) -> pure True @@ -94,7 +93,7 @@ instance Aeson.FromJSON Cell where data Module = Module { _moduleAttributes :: Aeson.Value , _modulePorts :: Map Text Port - , _moduleCells :: Map Text Cell + , _moduleCells :: Map Text (Cell [Bitrep]) } deriving (Show, Eq, Ord) makeLenses ''Module instance Aeson.FromJSON Module where diff --git a/src/SAWScript/Yosys/Netgraph.hs b/src/SAWScript/Yosys/Netgraph.hs new file mode 100644 index 0000000000..bc114f75a2 --- /dev/null +++ b/src/SAWScript/Yosys/Netgraph.hs @@ -0,0 +1,291 @@ +{-# Language TemplateHaskell #-} +{-# Language OverloadedStrings #-} +{-# Language RecordWildCards #-} +{-# Language ViewPatterns #-} +{-# Language LambdaCase #-} +{-# Language MultiWayIf #-} +{-# Language TupleSections #-} +{-# Language ScopedTypeVariables #-} + +module SAWScript.Yosys.Netgraph where + +import Control.Lens.TH (makeLenses) + +import Control.Lens (at, (^.)) +import Control.Monad (forM, foldM) +import Control.Monad.IO.Class (MonadIO(..)) +import Control.Exception (throw) + +import qualified Data.Tuple as Tuple +import qualified Data.Maybe as Maybe +import qualified Data.List as List +import Data.Map (Map) +import qualified Data.Map as Map +import Data.Text (Text) +import qualified Data.Text as Text +import qualified Data.Graph as Graph + +import qualified Verifier.SAW.SharedTerm as SC + +import qualified Cryptol.TypeCheck.Type as C +import qualified Cryptol.Utils.Ident as C +import qualified Cryptol.Utils.RecordMap as C + +import SAWScript.Yosys.Utils +import SAWScript.Yosys.IR +import SAWScript.Yosys.Cell + +moduleInputPorts :: Module -> Map Text [Bitrep] +moduleInputPorts m = + Map.fromList + . Maybe.mapMaybe + ( \(nm, ip) -> + if ip ^. portDirection == DirectionInput || ip ^. portDirection == DirectionInout + then Just (nm, ip ^. portBits) + else Nothing + ) + . Map.assocs + $ m ^. modulePorts + +moduleOutputPorts :: Module -> Map Text [Bitrep] +moduleOutputPorts m = + Map.fromList + . Maybe.mapMaybe + ( \(nm, ip) -> + if ip ^. portDirection == DirectionOutput || ip ^. portDirection == DirectionInout + then Just (nm, ip ^. portBits) + else Nothing + ) + . Map.assocs + $ m ^. modulePorts + +cellInputConnections :: Cell [b] -> Map Text [b] +cellInputConnections c = Map.intersection (c ^. cellConnections) inp + where + inp = Map.filter (\d -> d == DirectionInput || d == DirectionInout) $ c ^. cellPortDirections + +cellOutputConnections :: Ord b => Cell [b] -> Map [b] Text +cellOutputConnections c = Map.fromList . fmap Tuple.swap . Map.toList $ Map.intersection (c ^. cellConnections) out + where + out = Map.filter (\d -> d == DirectionOutput || d == DirectionInout) $ c ^. cellPortDirections + +cellToEdges :: (Ord b, Eq b) => Cell [b] -> [(b, [b])] +cellToEdges c = (, inputBits) <$> outputBits + where + inputBits = List.nub . mconcat . Map.elems $ cellInputConnections c + outputBits = List.nub . mconcat . Map.keys $ cellOutputConnections c + +-------------------------------------------------------------------------------- +-- ** Building a network graph from a Yosys module + +data Netgraph b = Netgraph + { _netgraphGraph :: Graph.Graph + , _netgraphNodeFromVertex :: Graph.Vertex -> (Cell [b], b, [b]) + -- , _netgraphVertexFromKey :: Bitrep -> Maybe Graph.Vertex + } +makeLenses ''Netgraph + +moduleNetgraph :: Module -> Netgraph Bitrep +moduleNetgraph m = + let + bitsFromInputPorts :: [Bitrep] + bitsFromInputPorts = (<> [BitrepZero, BitrepOne]) + . List.nub + . mconcat + . Maybe.mapMaybe + ( \(_, p) -> + case p ^. portDirection of + DirectionInput -> Just $ p ^. portBits + DirectionInout -> Just $ p ^. portBits + _ -> Nothing + ) + . Map.assocs + $ m ^. modulePorts -- + cellToNodes :: Cell [Bitrep] -> [(Cell [Bitrep], Bitrep, [Bitrep])] + cellToNodes c + | c ^. cellType == "$dff" = (c, , []) <$> outputBits + | otherwise = (c, , inputBits) <$> outputBits + where + inputBits :: [Bitrep] + inputBits = + filter (not . flip elem bitsFromInputPorts) + . List.nub + . mconcat + . Maybe.mapMaybe + ( \(p, bits) -> + case c ^. cellPortDirections . at p of + Just DirectionInput -> Just bits + Just DirectionInout -> Just bits + _ -> Nothing + ) + . Map.assocs + $ c ^. cellConnections + outputBits :: [Bitrep] + outputBits = List.nub + . mconcat + . Maybe.mapMaybe + ( \(p, bits) -> + case c ^. cellPortDirections . at p of + Just DirectionOutput -> Just bits + Just DirectionInout -> Just bits + _ -> Nothing + ) + . Map.assocs + $ c ^. cellConnections + nodes = concatMap cellToNodes . Map.elems $ m ^. moduleCells + (_netgraphGraph, _netgraphNodeFromVertex, _netgraphVertexFromKey) + = Graph.graphFromEdges nodes + in Netgraph{..} + +-------------------------------------------------------------------------------- +-- ** Building a SAWCore term from a network graph + +data ConvertedModule = ConvertedModule + { _convertedModuleTerm :: SC.Term + , _convertedModuleType :: SC.Term + , _convertedModuleCryptolType :: C.Type + } +makeLenses ''ConvertedModule + +-- | Given a bit pattern ([Bitrep]) and a term, construct a map associating that output pattern with +-- the term, and each bit of that pattern with the corresponding bit of the term. +deriveTermsByIndices :: (MonadIO m, Ord b) => SC.SharedContext -> [b] -> SC.Term -> m (Map [b] SC.Term) +deriveTermsByIndices sc rep t = do + boolty <- liftIO $ SC.scBoolType sc + telems <- forM [0..length rep] $ \index -> do + tlen <- liftIO . SC.scNat sc . fromIntegral $ length rep + idx <- liftIO . SC.scNat sc $ fromIntegral index + bit <- liftIO $ SC.scAt sc tlen boolty t idx + liftIO $ SC.scSingle sc boolty bit + pure . Map.fromList $ mconcat + [ [(rep, t)] + , zip ((:[]) <$> rep) telems + ] + +lookupPatternTerm :: + (MonadIO m, Ord b, Show b) => + SC.SharedContext -> + [b] -> + Map [b] SC.Term -> + m SC.Term +lookupPatternTerm sc pat ts = + case Map.lookup pat ts of + Just t -> pure t + Nothing -> do + one <- liftIO $ SC.scNat sc 1 + boolty <- liftIO $ SC.scBoolType sc + many <- liftIO . SC.scNat sc . fromIntegral $ length pat + vecty <- liftIO $ SC.scVecType sc many boolty + bits <- forM pat $ \b -> do + case Map.lookup [b] ts of + Just t -> pure t + Nothing -> do + throw . YosysError $ "Failed to find output bitvec: " <> Text.pack (show b) + vecBits <- liftIO $ SC.scVector sc vecty bits + liftIO $ SC.scJoin sc many one boolty vecBits + +-- | Given a netgraph and an initial map from bit patterns to terms, populate that map with terms +-- generated from the rest of the netgraph. +netgraphToTerms :: + (MonadIO m, Ord b, Show b) => + SC.SharedContext -> + Map Text ConvertedModule -> + Netgraph b -> + Map [b] SC.Term -> + m (Map [b] SC.Term) +netgraphToTerms sc env ng inputs + | length (Graph.scc $ ng ^. netgraphGraph) /= length (ng ^. netgraphGraph) + = do + throw $ YosysError "Network graph contains a cycle after splitting on DFFs; SAW does not currently support analysis of this circuit" + | otherwise = do + let sorted = Graph.reverseTopSort $ ng ^. netgraphGraph + foldM + ( \acc v -> do + let (c, _output, _deps) = ng ^. netgraphNodeFromVertex $ v + let outputFields = Map.filter (\d -> d == DirectionOutput || d == DirectionInout) $ c ^. cellPortDirections + if + -- special handling for $dff nodes - we read their /output/ from the inputs map, and later detect and write their /input/ to the state + | c ^. cellType == "$dff" + , Just dffout <- Map.lookup "Q" $ c ^. cellConnections -> do + r <- lookupPatternTerm sc dffout acc + ts <- deriveTermsByIndices sc dffout r + pure $ Map.union ts acc + | otherwise -> do + args <- forM (cellInputConnections c) $ \i -> do -- for each input bit pattern + -- if we can find that pattern exactly, great! use that term + -- otherwise, find each individual bit and append the terms + lookupPatternTerm sc i acc + + r <- primCellToTerm sc c args >>= \case + Just r -> pure r + Nothing -> case Map.lookup (c ^. cellType) env of + Just cm -> do + r <- cryptolRecord sc args + liftIO $ SC.scApply sc (cm ^. convertedModuleTerm) r + Nothing -> throw . YosysError $ "No definition for module: " <> (c ^. cellType) + + -- once we've built a term, insert it along with each of its bits + ts <- forM (Map.assocs $ cellOutputConnections c) $ \(out, o) -> do + t <- cryptolRecordSelect sc outputFields r o + deriveTermsByIndices sc out t + pure $ Map.union (Map.unions ts) acc + ) + inputs + sorted + +convertModule :: + MonadIO m => + SC.SharedContext -> + Map Text ConvertedModule -> + Module -> + m ConvertedModule +convertModule sc env m = do + let ng = moduleNetgraph m + + let inputPorts = moduleInputPorts m + let outputPorts = moduleOutputPorts m + + inputFields <- forM inputPorts + (\inp -> do + liftIO . SC.scBitvector sc . fromIntegral $ length inp + ) + outputFields <- forM outputPorts + (\out -> do + liftIO . SC.scBitvector sc . fromIntegral $ length out + ) + inputRecordType <- cryptolRecordType sc inputFields + outputRecordType <- cryptolRecordType sc outputFields + inputRecordEC <- liftIO $ SC.scFreshEC sc "input" inputRecordType + inputRecord <- liftIO $ SC.scExtCns sc inputRecordEC + + derivedInputs <- forM (Map.assocs inputPorts) $ \(nm, inp) -> do + t <- liftIO $ cryptolRecordSelect sc inputFields inputRecord nm + deriveTermsByIndices sc inp t + + zeroTerm <- liftIO $ SC.scBvConst sc 1 0 + oneTerm <- liftIO $ SC.scBvConst sc 1 1 + let inputs = Map.unions $ mconcat + [ [ Map.fromList + [ ( [BitrepZero], zeroTerm) + , ( [BitrepOne], oneTerm ) + ] + ] + , derivedInputs + ] + + terms <- netgraphToTerms sc env ng inputs + outputRecord <- cryptolRecord sc =<< forM outputPorts + (\out -> lookupPatternTerm sc out terms) + + t <- liftIO $ SC.scAbstractExts sc [inputRecordEC] outputRecord + ty <- liftIO $ SC.scFun sc inputRecordType outputRecordType + + let toCryptol (nm, rep) = (C.mkIdent nm, C.tWord . C.tNum $ length rep) + let cty = C.tFun + (C.tRec . C.recordFromFields $ toCryptol <$> Map.assocs inputPorts) + (C.tRec . C.recordFromFields $ toCryptol <$> Map.assocs outputPorts) + pure ConvertedModule + { _convertedModuleTerm = t + , _convertedModuleType = ty + , _convertedModuleCryptolType = cty + } diff --git a/src/SAWScript/Yosys/State.hs b/src/SAWScript/Yosys/State.hs new file mode 100644 index 0000000000..c0d5e9d0bf --- /dev/null +++ b/src/SAWScript/Yosys/State.hs @@ -0,0 +1,186 @@ +{-# Language TemplateHaskell #-} +{-# Language OverloadedStrings #-} +{-# Language RecordWildCards #-} +{-# Language MultiWayIf #-} +{-# Language ViewPatterns #-} +{-# Language TupleSections #-} +{-# Language ScopedTypeVariables #-} + +module SAWScript.Yosys.State where + +import Control.Lens ((^.)) +import Control.Monad (forM) +import Control.Monad.IO.Class (MonadIO(..)) +import Control.Exception (throw) + +import Data.Map (Map) +import qualified Data.Map as Map +import Data.Text (Text) +import qualified Data.Text as Text +import qualified Data.Graph as Graph + +import qualified Verifier.SAW.SharedTerm as SC + +import qualified Cryptol.TypeCheck.Type as C +import qualified Cryptol.Utils.Ident as C +import qualified Cryptol.Utils.RecordMap as C + +import SAWScript.Panic (panic) + +import SAWScript.Yosys.Utils +import SAWScript.Yosys.IR +import SAWScript.Yosys.Netgraph + +-------------------------------------------------------------------------------- +-- ** Bit identifiers qualified with the name of a module instance. +-- To ensure global uniqueness, since for sequential circuits we use one global +-- graph of cells to properly detect cycles where the breaking DFF is within a +-- submodule. + +data QualBitrep + = QualBitrepZero + | QualBitrepOne + | QualBitrepX + | QualBitrepZ + | QualBitrep Text Integer + deriving (Show, Eq, Ord) + +qualifyBitrep :: Text -> Bitrep -> QualBitrep +qualifyBitrep _ BitrepZero = QualBitrepZero +qualifyBitrep _ BitrepOne = QualBitrepOne +qualifyBitrep _ BitrepX = QualBitrepX +qualifyBitrep _ BitrepZ = QualBitrepZ +qualifyBitrep nm (Bitrep i) = QualBitrep nm i + +-------------------------------------------------------------------------------- +-- ** Constructing a graph of the entire circuit. + +type CircgraphNode = (Cell [QualBitrep], QualBitrep, [QualBitrep]) + +rebindQualify :: Text -> Map [Bitrep] [QualBitrep] -> [Bitrep] -> [QualBitrep] +rebindQualify inm binds bits = case Map.lookup bits binds of + Nothing -> qualifyBitrep inm <$> bits + Just qbits -> qbits + +moduleToInlineNetgraph :: forall m. MonadIO m => Map Text Module -> Module -> m (Netgraph QualBitrep) +moduleToInlineNetgraph mmap topm = do + nodes <- go "top" Map.empty topm + -- liftIO $ putStrLn $ unlines $ (\(c, out, inp) -> show (c ^. cellType, out, inp)) <$> nodes + let (_netgraphGraph, _netgraphNodeFromVertex, _) = Graph.graphFromEdges nodes + pure Netgraph{..} + where + go :: Text -> Map [Bitrep] [QualBitrep] -> Module -> m [CircgraphNode] + go inm binds m = do + fmap mconcat . forM (Map.assocs $ m ^. moduleCells) $ \(cnm, fmap (rebindQualify inm binds) -> c) -> do + if + | c ^. cellType == "$dff" + -> pure $ (\(out, _inp) -> (c, out, [])) <$> cellToEdges c + | Text.isPrefixOf "$" (c ^. cellType) + -> pure $ (\(out, inp) -> (c, out, inp)) <$> cellToEdges c + | Just subm <- Map.lookup (c ^. cellType) mmap + -> do + sbinds <- forM (Map.assocs $ subm ^. modulePorts) $ \(pnm, p) -> do + case Map.lookup pnm (c ^. cellConnections) of + Nothing -> throw . YosysError $ mconcat + [ "Cell \"", cnm, "\" does not provide a connection for port \"", pnm, "\"" + ] + Just cbits -> pure (p ^. portBits, cbits) + liftIO $ putStrLn $ "Descending into: " <> Text.unpack (c ^. cellType) <> ", binds are " <> show sbinds + subcells <- go (inm <> " " <> cnm) (Map.fromList sbinds) subm + pure subcells + | otherwise + -> throw . YosysError $ "No definition for module: " <> (c ^. cellType) + +findDffs :: + Netgraph QualBitrep -> + [Cell [QualBitrep]] +findDffs ng = + filter (\c -> c ^. cellType == "$dff") + . fmap (\v -> let (c, _, _) = ng ^. netgraphNodeFromVertex $ v in c) + . Graph.vertices + $ ng ^. netgraphGraph + +convertModuleInline :: + MonadIO m => + SC.SharedContext -> + Map Text Module -> + Module -> + m ConvertedModule +convertModuleInline sc mmap m = do + ng <- moduleToInlineNetgraph mmap m + + let dffs = findDffs ng + stateFields <- fmap Map.fromList . forM dffs $ \c -> + case Map.lookup "Q" $ c ^. cellConnections of + Nothing -> panic "convertModuleInline" ["Missing expected output name for $dff cell"] + Just b -> do + t <- liftIO . SC.scBitvector sc . fromIntegral $ length b + let cty = C.tWord . C.tNum $ length b + pure ("nm", (t, cty)) + stateRecordType <- cryptolRecordType sc $ fst <$> stateFields + let stateRecordCryptolType = C.tRec . C.recordFromFields $ (\(cnm, (_, t)) -> (C.mkIdent cnm, t)) <$> Map.assocs stateFields + + let inputPorts = moduleInputPorts m + let outputPorts = moduleOutputPorts m + inputFields <- forM inputPorts $ \inp -> do + liftIO . SC.scBitvector sc . fromIntegral $ length inp + outputFields <- forM outputPorts $ \out -> do + liftIO . SC.scBitvector sc . fromIntegral $ length out + + let domainFields = Map.insert "__state__" stateRecordType inputFields + let codomainFields = Map.insert "__state__" stateRecordType outputFields + + domainRecordType <- cryptolRecordType sc domainFields + codomainRecordType <- cryptolRecordType sc codomainFields + domainRecordEC <- liftIO $ SC.scFreshEC sc "input" domainRecordType + domainRecord <- liftIO $ SC.scExtCns sc domainRecordEC + + derivedInputs <- forM (Map.assocs inputPorts) $ \(nm, inp) -> do + t <- liftIO $ cryptolRecordSelect sc domainFields domainRecord nm + deriveTermsByIndices sc (qualifyBitrep "top" <$> inp) t + + preStateRecord <- liftIO $ cryptolRecordSelect sc domainFields domainRecord "__state__" + derivedPreState <- forM dffs $ \c -> + case Map.lookup "Q" $ c ^. cellConnections of + Nothing -> panic "convertModuleInline" ["Missing expected output name for $dff cell"] + Just b -> do + t <- liftIO $ cryptolRecordSelect sc stateFields preStateRecord "nm" + deriveTermsByIndices sc b t + + zeroTerm <- liftIO $ SC.scBvConst sc 1 0 + oneTerm <- liftIO $ SC.scBvConst sc 1 1 + let inputs = Map.unions $ mconcat + [ [ Map.fromList + [ ( [QualBitrepZero], zeroTerm) + , ( [QualBitrepOne], oneTerm ) + ] + ] + , derivedInputs + , derivedPreState + ] + + terms <- netgraphToTerms sc Map.empty ng inputs + + postStateFields <- forM dffs $ \c -> + case Map.lookup "D" $ c ^. cellConnections of + Nothing -> panic "convertModuleInline" ["Missing expected input name for $dff cell"] + Just b -> do + t <- lookupPatternTerm sc b terms + pure ("nm", t) + postStateRecord <- cryptolRecord sc $ Map.fromList postStateFields + + outputRecord <- cryptolRecord sc . Map.insert "__state__" postStateRecord =<< forM outputPorts + (\out -> lookupPatternTerm sc (qualifyBitrep "top" <$> out) terms) + + t <- liftIO $ SC.scAbstractExts sc [domainRecordEC] outputRecord + ty <- liftIO $ SC.scFun sc domainRecordType codomainRecordType + + let toCryptol (nm, rep) = (C.mkIdent nm, C.tWord . C.tNum $ length rep) + let cty = C.tFun + (C.tRec . C.recordFromFields . (("__state__", stateRecordCryptolType):) $ toCryptol <$> Map.assocs inputPorts) + (C.tRec . C.recordFromFields . (("__state__", stateRecordCryptolType):) $ toCryptol <$> Map.assocs outputPorts) + pure ConvertedModule + { _convertedModuleTerm = t + , _convertedModuleType = ty + , _convertedModuleCryptolType = cty + } diff --git a/src/SAWScript/Yosys/Theorem.hs b/src/SAWScript/Yosys/Theorem.hs index 97d1b2e1a7..03b8fe2c8e 100644 --- a/src/SAWScript/Yosys/Theorem.hs +++ b/src/SAWScript/Yosys/Theorem.hs @@ -10,17 +10,12 @@ module SAWScript.Yosys.Theorem where import Control.Lens.TH (makeLenses) import Control.Lens ((^.)) -import Control.Monad (forM, foldM) import Control.Monad.IO.Class (MonadIO(..)) import Control.Exception (throw) import Control.Monad.Catch (MonadThrow) -import qualified Data.List as List -import Data.Text (Text) import qualified Data.Text as Text import qualified Data.Set as Set -import Data.Map (Map) -import qualified Data.Map as Map import qualified Text.URI as URI @@ -32,10 +27,8 @@ import qualified Verifier.SAW.Recognizer as R import qualified Verifier.SAW.Cryptol as CSC import qualified Cryptol.TypeCheck.Type as C -import qualified Cryptol.Utils.Ident as C -import qualified Cryptol.Utils.RecordMap as C -import SAWScript.Yosys.IR +import SAWScript.Yosys.Utils data YosysTheorem = YosysTheorem { _theoremURI :: URI.URI -- URI identifying overridden module @@ -49,102 +42,6 @@ data YosysTheorem = YosysTheorem } makeLenses ''YosysTheorem -cryptolRecordType :: - MonadIO m => - SC.SharedContext -> - Map Text SC.Term -> - m SC.Term -cryptolRecordType sc fields = - liftIO $ SC.scTupleType sc (fmap snd . C.canonicalFields . C.recordFromFields $ Map.assocs fields) - -cryptolRecord :: - MonadIO m => - SC.SharedContext -> - Map Text SC.Term -> - m SC.Term -cryptolRecord sc fields = - liftIO $ SC.scTuple sc (fmap snd . C.canonicalFields . C.recordFromFields $ Map.assocs fields) - -cryptolRecordSelect :: - MonadIO m => - SC.SharedContext -> - Map Text a -> - SC.Term -> - Text -> - m SC.Term -cryptolRecordSelect sc fields r nm = - case List.elemIndex nm ord of - Just i -> liftIO $ SC.scTupleSelector sc r (i + 1) (length ord) - Nothing -> throw . YosysError $ mconcat - [ "Could not build record selector term for field name \"" - , nm - , "\" on record term: " - , Text.pack $ SC.showTerm r - , "\nFields are: " - , Text.pack . show $ Map.keys fields - ] - where ord = fmap fst . C.canonicalFields . C.recordFromFields $ Map.assocs fields - -cryptolRecordSelectTyped :: - MonadIO m => - SC.SharedContext -> - SC.TypedTerm -> - Text -> - m SC.TypedTerm -cryptolRecordSelectTyped sc r nm = do - fields <- Map.mapKeys C.identText . Map.fromList . C.canonicalFields <$> case SC.ttType r of - SC.TypedTermSchema (C.Forall [] [] (C.TRec fs)) -> pure fs - _ -> throw . YosysError $ mconcat - [ "Type\n" - , Text.pack . show $ SC.ttType r - , "\nis not a record type" - ] - cty <- case Map.lookup nm fields of - Just cty -> pure cty - _ -> throw . YosysError $ mconcat - [ "Record type\n" - , Text.pack . show $ SC.ttType r - , "\ndoes not have field " - , nm - ] - t <- cryptolRecordSelect sc fields (SC.ttTerm r) nm - pure $ SC.TypedTerm (SC.TypedTermSchema $ C.tMono cty) t - -eqBvRecords :: - (MonadIO m, MonadThrow m) => - SC.SharedContext -> - C.Type -> - SC.Term -> - SC.Term -> - m SC.Term -eqBvRecords sc cty a b = do - fields <- Map.mapKeys C.identText . Map.fromList . C.canonicalFields <$> case cty of - C.TRec fs -> pure fs - _ -> throw . YosysError $ mconcat - [ "Type\n" - , Text.pack $ show cty - , "\nis not a record type" - ] - eqs <- forM (Map.assocs fields) $ \(nm, fcty) -> do - w <- case fcty of - C.TCon (C.TC C.TCSeq) [C.TCon (C.TC (C.TCNum wint)) [], C.TCon (C.TC C.TCBit) []] -> - liftIO . SC.scNat sc $ fromIntegral wint - _ -> throw . YosysError $ mconcat - [ "Type\n" - , Text.pack $ show fcty - , "\nis not a bitvector type" - ] - fa <- cryptolRecordSelect sc fields a nm - fb <- cryptolRecordSelect sc fields b nm - liftIO $ SC.scBvEq sc w fa fb - case eqs of - [] -> throw . YosysError $ mconcat - [ "Record type\n" - , Text.pack $ show cty - , "\nhas no fields" - ] - (e:es) -> foldM (\x y -> liftIO $ SC.scAnd sc x y) e es - theoremProp :: (MonadIO m, MonadThrow m) => SC.SharedContext -> diff --git a/src/SAWScript/Yosys/Utils.hs b/src/SAWScript/Yosys/Utils.hs new file mode 100644 index 0000000000..4bea594ed7 --- /dev/null +++ b/src/SAWScript/Yosys/Utils.hs @@ -0,0 +1,126 @@ +{-# Language TemplateHaskell #-} +{-# Language OverloadedStrings #-} +{-# Language LambdaCase #-} +{-# Language ViewPatterns #-} +{-# Language ScopedTypeVariables #-} + +module SAWScript.Yosys.Utils where + +import Control.Monad (forM, foldM) +import Control.Monad.IO.Class (MonadIO(..)) +import Control.Exception (Exception, throw) +import Control.Monad.Catch (MonadThrow) + +import qualified Data.List as List +import Data.Text (Text) +import qualified Data.Text as Text +import Data.Map (Map) +import qualified Data.Map as Map + +import qualified Verifier.SAW.SharedTerm as SC +import qualified Verifier.SAW.TypedTerm as SC + +import qualified Cryptol.TypeCheck.Type as C +import qualified Cryptol.Utils.Ident as C +import qualified Cryptol.Utils.RecordMap as C + +newtype YosysError = YosysError Text +instance Exception YosysError +instance Show YosysError where + show (YosysError msg) = Text.unpack $ "Error: " <> msg + +cryptolRecordType :: + MonadIO m => + SC.SharedContext -> + Map Text SC.Term -> + m SC.Term +cryptolRecordType sc fields = + liftIO $ SC.scTupleType sc (fmap snd . C.canonicalFields . C.recordFromFields $ Map.assocs fields) + +cryptolRecord :: + MonadIO m => + SC.SharedContext -> + Map Text SC.Term -> + m SC.Term +cryptolRecord sc fields = + liftIO $ SC.scTuple sc (fmap snd . C.canonicalFields . C.recordFromFields $ Map.assocs fields) + +cryptolRecordSelect :: + MonadIO m => + SC.SharedContext -> + Map Text a -> + SC.Term -> + Text -> + m SC.Term +cryptolRecordSelect sc fields r nm = + case List.elemIndex nm ord of + Just i -> liftIO $ SC.scTupleSelector sc r (i + 1) (length ord) + Nothing -> throw . YosysError $ mconcat + [ "Could not build record selector term for field name \"" + , nm + , "\" on record term: " + , Text.pack $ SC.showTerm r + , "\nFields are: " + , Text.pack . show $ Map.keys fields + ] + where ord = fmap fst . C.canonicalFields . C.recordFromFields $ Map.assocs fields + +cryptolRecordSelectTyped :: + MonadIO m => + SC.SharedContext -> + SC.TypedTerm -> + Text -> + m SC.TypedTerm +cryptolRecordSelectTyped sc r nm = do + fields <- Map.mapKeys C.identText . Map.fromList . C.canonicalFields <$> case SC.ttType r of + SC.TypedTermSchema (C.Forall [] [] (C.TRec fs)) -> pure fs + _ -> throw . YosysError $ mconcat + [ "Type\n" + , Text.pack . show $ SC.ttType r + , "\nis not a record type" + ] + cty <- case Map.lookup nm fields of + Just cty -> pure cty + _ -> throw . YosysError $ mconcat + [ "Record type\n" + , Text.pack . show $ SC.ttType r + , "\ndoes not have field " + , nm + ] + t <- cryptolRecordSelect sc fields (SC.ttTerm r) nm + pure $ SC.TypedTerm (SC.TypedTermSchema $ C.tMono cty) t + +eqBvRecords :: + (MonadIO m, MonadThrow m) => + SC.SharedContext -> + C.Type -> + SC.Term -> + SC.Term -> + m SC.Term +eqBvRecords sc cty a b = do + fields <- Map.mapKeys C.identText . Map.fromList . C.canonicalFields <$> case cty of + C.TRec fs -> pure fs + _ -> throw . YosysError $ mconcat + [ "Type\n" + , Text.pack $ show cty + , "\nis not a record type" + ] + eqs <- forM (Map.assocs fields) $ \(nm, fcty) -> do + w <- case fcty of + C.TCon (C.TC C.TCSeq) [C.TCon (C.TC (C.TCNum wint)) [], C.TCon (C.TC C.TCBit) []] -> + liftIO . SC.scNat sc $ fromIntegral wint + _ -> throw . YosysError $ mconcat + [ "Type\n" + , Text.pack $ show fcty + , "\nis not a bitvector type" + ] + fa <- cryptolRecordSelect sc fields a nm + fb <- cryptolRecordSelect sc fields b nm + liftIO $ SC.scBvEq sc w fa fb + case eqs of + [] -> throw . YosysError $ mconcat + [ "Record type\n" + , Text.pack $ show cty + , "\nhas no fields" + ] + (e:es) -> foldM (\x y -> liftIO $ SC.scAnd sc x y) e es From ea9fd9330bf393073681be01b11ef140d4728036 Mon Sep 17 00:00:00 2001 From: Samuel Breese Date: Mon, 16 May 2022 16:43:21 -0400 Subject: [PATCH 18/47] Fix $mux cell --- src/SAWScript/Yosys/Cell.hs | 16 +++++++++------- 1 file changed, 9 insertions(+), 7 deletions(-) diff --git a/src/SAWScript/Yosys/Cell.hs b/src/SAWScript/Yosys/Cell.hs index 26fa31aa3c..f42d09abe2 100644 --- a/src/SAWScript/Yosys/Cell.hs +++ b/src/SAWScript/Yosys/Cell.hs @@ -122,11 +122,11 @@ primCellToTerm sc c args = case c ^. cellType of [ ("Y", res) ] "$mux" -> do - w <- outputWidth ta <- input "A" tb <- input "B" ts <- input "S" - snz <- liftIO $ SC.scBvNonzero sc w ts + swidth <- connWidth "S" + snz <- liftIO $ SC.scBvNonzero sc swidth ts ty <- liftIO $ SC.scBitvector sc outputWidthNat res <- liftIO $ SC.scIte sc ty snz tb ta fmap Just . cryptolRecord sc $ Map.fromList @@ -141,13 +141,15 @@ primCellToTerm sc c args = case c ^. cellType of _ -> pure Nothing where nm = c ^. cellType - outputWidthNat :: Natural - outputWidthNat = - case Map.lookup "Y" $ c ^. cellConnections of + connWidthNat :: Text -> Natural + connWidthNat onm = + case Map.lookup onm $ c ^. cellConnections of Nothing -> panic "cellToTerm" [Text.unpack $ mconcat ["Missing expected output name for ", nm, " cell"]] Just bits -> fromIntegral $ length bits - outputWidth :: m SC.Term - outputWidth = liftIO $ SC.scNat sc outputWidthNat + connWidth :: Text -> m SC.Term + connWidth onm = liftIO . SC.scNat sc $ connWidthNat onm + outputWidthNat = connWidthNat "Y" + outputWidth = connWidth "Y" input :: Text -> m SC.Term input inpNm = case Map.lookup inpNm args of From 7adde6204c2b602c9c74347ff7fd43a2e0ef727d Mon Sep 17 00:00:00 2001 From: Samuel Breese Date: Wed, 18 May 2022 20:17:20 -0400 Subject: [PATCH 19/47] Extraction of non-stateful terms given a finite number of iterations --- src/SAWScript/Interpreter.hs | 15 ++++ src/SAWScript/Value.hs | 10 +++ src/SAWScript/Yosys.hs | 63 +++++++------- src/SAWScript/Yosys/State.hs | 159 ++++++++++++++++++++++++++++++----- 4 files changed, 194 insertions(+), 53 deletions(-) diff --git a/src/SAWScript/Interpreter.hs b/src/SAWScript/Interpreter.hs index bf8d0b445a..89e89bb4d8 100644 --- a/src/SAWScript/Interpreter.hs +++ b/src/SAWScript/Interpreter.hs @@ -3344,6 +3344,21 @@ primitives = Map.fromList Experimental [] + , prim "yosys_import_sequential" "String -> String -> TopLevel YosysSequential" + (pureVal yosys_import_sequential) + Experimental + [] + + , prim "yosys_extract_sequential" "YosysSequential -> Int -> TopLevel Term" + (pureVal yosys_extract_sequential) + Experimental + [] + + , prim "yosys_extract_sequential_raw" "YosysSequential -> TopLevel Term" + (pureVal yosys_extract_sequential_raw) + Experimental + [] + --------------------------------------------------------------------- , prim "mr_solver_prove" "Term -> Term -> TopLevel ()" diff --git a/src/SAWScript/Value.hs b/src/SAWScript/Value.hs index 7daba3893c..6c1fbc0a12 100644 --- a/src/SAWScript/Value.hs +++ b/src/SAWScript/Value.hs @@ -82,6 +82,7 @@ import SAWScript.Crucible.LLVM.Skeleton import SAWScript.X86 (X86Unsupported(..), X86Error(..)) import SAWScript.Yosys.IR import SAWScript.Yosys.Theorem (YosysTheorem) +import SAWScript.Yosys.State (YosysSequential) import Verifier.SAW.Name (toShortName) import Verifier.SAW.CryptolEnv as CEnv @@ -165,6 +166,7 @@ data Value | VCFG SAW_CFG | VGhostVar CMS.GhostGlobal | VYosysModule YosysIR + | VYosysSequential YosysSequential | VYosysTheorem YosysTheorem type SAWSimpset = Simpset TheoremNonce @@ -344,6 +346,7 @@ showsPrecValue opts p v = VGhostVar x -> showParen (p > 10) $ showString "Ghost " . showsPrec 11 x VYosysModule _ -> showString "<>" + VYosysSequential _ -> showString "<>" VYosysTheorem _ -> showString "<>" VJVMSetup _ -> showString "<>" VJVMMethodSpec _ -> showString "<>" @@ -1048,6 +1051,13 @@ instance FromValue YosysIR where fromValue (VYosysModule ir) = ir fromValue v = error ("fromValue YosysIR: " ++ show v) +instance IsValue YosysSequential where + toValue = VYosysSequential + +instance FromValue YosysSequential where + fromValue (VYosysSequential s) = s + fromValue v = error ("fromValue YosysSequential: " ++ show v) + instance IsValue YosysTheorem where toValue = VYosysTheorem diff --git a/src/SAWScript/Yosys.hs b/src/SAWScript/Yosys.hs index 5dbd029168..1443461137 100644 --- a/src/SAWScript/Yosys.hs +++ b/src/SAWScript/Yosys.hs @@ -11,6 +11,9 @@ module SAWScript.Yosys ( YosysIR , yosys_import , yosys_verify + , yosys_import_sequential + , yosys_extract_sequential + , yosys_extract_sequential_raw , loadYosysIR , yosysIRToTypedTerms ) where @@ -18,6 +21,7 @@ module SAWScript.Yosys import Control.Lens.TH (makeLenses) import Control.Lens (view, (^.)) +import Control.Exception (throw) import Control.Monad (forM, foldM) import Control.Monad.IO.Class (MonadIO(..)) @@ -123,41 +127,20 @@ yosysIRToRecordTerm sc ir = do let tt = SC.TypedTerm (SC.TypedTermSchema $ C.tMono cty) record pure tt --- | Given a Yosys IR, construct a map from module names to SAWCore terms alongside SAWCore and Cryptol types -convertYosysIRInline :: +-- | Given a Yosys IR, construct a value representing a specific module with all submodules inlined +yosysIRToSequential :: MonadIO m => SC.SharedContext -> YosysIR -> - m (Map Text ConvertedModule) -convertYosysIRInline sc ir = do - res <- forM (Map.assocs $ ir ^. yosysModules) $ \(nm, m) -> do - -- liftIO $ putStrLn $ "Converting: " <> Text.unpack nm - cm <- convertModuleInline sc (ir ^. yosysModules) m - let uri = URI.URI - { URI.uriScheme = URI.mkScheme "yosys" - , URI.uriAuthority = Left True - , URI.uriPath = (False,) <$> mapM URI.mkPathPiece (nm NE.:| []) - , URI.uriQuery = [] - , URI.uriFragment = Nothing - } - let ni = SC.ImportedName uri [nm] - tc <- liftIO $ SC.scConstant' sc ni (cm ^. convertedModuleTerm) (cm ^. convertedModuleType) - let cm' = cm { _convertedModuleTerm = tc } - pure (nm, cm') - pure $ Map.fromList res - --- | Given a Yosys IR, construct a SAWCore record containing terms for each module -yosysIRToRecordTermInline :: - MonadIO m => - SC.SharedContext -> - YosysIR -> - m SC.TypedTerm -yosysIRToRecordTermInline sc ir = do - env <- convertYosysIRInline sc ir - record <- cryptolRecord sc $ view convertedModuleTerm <$> env - let cty = C.tRec . C.recordFromFields $ (\(nm, cm) -> (C.mkIdent nm, cm ^. convertedModuleCryptolType)) <$> Map.assocs env - let tt = SC.TypedTerm (SC.TypedTermSchema $ C.tMono cty) record - pure tt + Text -> + m YosysSequential +yosysIRToSequential sc ir nm = do + case Map.lookup nm $ ir ^. yosysModules of + Nothing -> throw . YosysError $ mconcat + [ "Could not find module: " + , nm + ] + Just m -> convertModuleInline sc (ir ^. yosysModules) m -------------------------------------------------------------------------------- -- ** Functions visible from SAWScript REPL @@ -168,7 +151,7 @@ yosys_import :: FilePath -> TopLevel SC.TypedTerm yosys_import path = do sc <- getSharedContext ir <- loadYosysIR path - yosysIRToRecordTermInline sc ir + yosysIRToRecordTerm sc ir yosys_verify :: SC.TypedTerm -> [SC.TypedTerm] -> SC.TypedTerm -> [YosysTheorem] -> ProofScript () -> TopLevel YosysTheorem yosys_verify ymod preconds other specs tactic = do @@ -185,3 +168,17 @@ yosys_verify ymod preconds other specs tactic = do prop <- theoremProp sc thm _ <- Builtins.provePrintPrim tactic prop pure thm + +yosys_import_sequential :: Text -> FilePath -> TopLevel YosysSequential +yosys_import_sequential nm path = do + sc <- getSharedContext + ir <- loadYosysIR path + yosysIRToSequential sc ir nm + +yosys_extract_sequential :: YosysSequential -> Integer -> TopLevel SC.TypedTerm +yosys_extract_sequential s n = do + sc <- getSharedContext + composeYosysSequential sc s n + +yosys_extract_sequential_raw :: YosysSequential -> TopLevel SC.TypedTerm +yosys_extract_sequential_raw s = pure $ s ^. yosysSequentialTerm diff --git a/src/SAWScript/Yosys/State.hs b/src/SAWScript/Yosys/State.hs index c0d5e9d0bf..58d7f528a5 100644 --- a/src/SAWScript/Yosys/State.hs +++ b/src/SAWScript/Yosys/State.hs @@ -8,11 +8,14 @@ module SAWScript.Yosys.State where +import Control.Lens.TH (makeLenses) + import Control.Lens ((^.)) -import Control.Monad (forM) +import Control.Monad (forM, foldM) import Control.Monad.IO.Class (MonadIO(..)) import Control.Exception (throw) +import Data.Bifunctor (bimap) import Data.Map (Map) import qualified Data.Map as Map import Data.Text (Text) @@ -20,6 +23,8 @@ import qualified Data.Text as Text import qualified Data.Graph as Graph import qualified Verifier.SAW.SharedTerm as SC +import qualified Verifier.SAW.TypedTerm as SC +import qualified Verifier.SAW.Name as SC import qualified Cryptol.TypeCheck.Type as C import qualified Cryptol.Utils.Ident as C @@ -100,15 +105,48 @@ findDffs ng = . Graph.vertices $ ng ^. netgraphGraph +data YosysSequential = YosysSequential + { _yosysSequentialTerm :: SC.TypedTerm + , _yosysSequentialStateFields :: Map Text (SC.Term, C.Type) + , _yosysSequentialInputFields :: Map Text (SC.Term, C.Type) + , _yosysSequentialOutputFields :: Map Text (SC.Term, C.Type) + } +makeLenses ''YosysSequential + +fieldsToType :: + MonadIO m => + SC.SharedContext -> + Map Text (SC.Term, C.Type) -> + m SC.Term +fieldsToType sc = cryptolRecordType sc . fmap fst + +fieldsToCryptolType :: + MonadIO m => + Map Text (SC.Term, C.Type) -> + m C.Type +fieldsToCryptolType fields = pure . C.tRec . C.recordFromFields $ bimap C.mkIdent snd <$> Map.assocs fields + +insertStateField :: + MonadIO m => + SC.SharedContext -> + Map Text (SC.Term, C.Type) -> + Map Text (SC.Term, C.Type) -> + m (Map Text (SC.Term, C.Type)) +insertStateField sc stateFields fields = do + stateRecordType <- fieldsToType sc stateFields + stateRecordCryptolType <- fieldsToCryptolType stateFields + pure $ Map.insert "__state__" (stateRecordType, stateRecordCryptolType) fields + convertModuleInline :: MonadIO m => SC.SharedContext -> Map Text Module -> Module -> - m ConvertedModule + m YosysSequential convertModuleInline sc mmap m = do ng <- moduleToInlineNetgraph mmap m + -- construct SAWCore and Cryptol types let dffs = findDffs ng stateFields <- fmap Map.fromList . forM dffs $ \c -> case Map.lookup "Q" $ c ^. cellConnections of @@ -117,21 +155,27 @@ convertModuleInline sc mmap m = do t <- liftIO . SC.scBitvector sc . fromIntegral $ length b let cty = C.tWord . C.tNum $ length b pure ("nm", (t, cty)) - stateRecordType <- cryptolRecordType sc $ fst <$> stateFields - let stateRecordCryptolType = C.tRec . C.recordFromFields $ (\(cnm, (_, t)) -> (C.mkIdent cnm, t)) <$> Map.assocs stateFields let inputPorts = moduleInputPorts m let outputPorts = moduleOutputPorts m inputFields <- forM inputPorts $ \inp -> do - liftIO . SC.scBitvector sc . fromIntegral $ length inp + ty <- liftIO . SC.scBitvector sc . fromIntegral $ length inp + let cty = C.tWord . C.tNum $ length inp + pure (ty, cty) outputFields <- forM outputPorts $ \out -> do - liftIO . SC.scBitvector sc . fromIntegral $ length out + ty <- liftIO . SC.scBitvector sc . fromIntegral $ length out + let cty = C.tWord . C.tNum $ length out + pure (ty, cty) + + domainFields <- insertStateField sc stateFields inputFields + codomainFields <- insertStateField sc stateFields outputFields - let domainFields = Map.insert "__state__" stateRecordType inputFields - let codomainFields = Map.insert "__state__" stateRecordType outputFields + domainRecordType <- fieldsToType sc domainFields + domainCryptolRecordType <- fieldsToCryptolType domainFields + -- codomainRecordType <- fieldsToType sc codomainFields + codomainCryptolRecordType <- fieldsToCryptolType codomainFields - domainRecordType <- cryptolRecordType sc domainFields - codomainRecordType <- cryptolRecordType sc codomainFields + -- convert module into term domainRecordEC <- liftIO $ SC.scFreshEC sc "input" domainRecordType domainRecord <- liftIO $ SC.scExtCns sc domainRecordEC @@ -172,15 +216,90 @@ convertModuleInline sc mmap m = do outputRecord <- cryptolRecord sc . Map.insert "__state__" postStateRecord =<< forM outputPorts (\out -> lookupPatternTerm sc (qualifyBitrep "top" <$> out) terms) + -- construct result t <- liftIO $ SC.scAbstractExts sc [domainRecordEC] outputRecord - ty <- liftIO $ SC.scFun sc domainRecordType codomainRecordType - - let toCryptol (nm, rep) = (C.mkIdent nm, C.tWord . C.tNum $ length rep) - let cty = C.tFun - (C.tRec . C.recordFromFields . (("__state__", stateRecordCryptolType):) $ toCryptol <$> Map.assocs inputPorts) - (C.tRec . C.recordFromFields . (("__state__", stateRecordCryptolType):) $ toCryptol <$> Map.assocs outputPorts) - pure ConvertedModule - { _convertedModuleTerm = t - , _convertedModuleType = ty - , _convertedModuleCryptolType = cty + -- ty <- liftIO $ SC.scFun sc domainRecordType codomainRecordType + let cty = C.tFun domainCryptolRecordType codomainCryptolRecordType + pure YosysSequential + { _yosysSequentialTerm = SC.TypedTerm (SC.TypedTermSchema $ C.tMono cty) t + , _yosysSequentialStateFields = stateFields + , _yosysSequentialInputFields = inputFields + , _yosysSequentialOutputFields = outputFields } + +composeYosysSequential :: + forall m. + MonadIO m => + SC.SharedContext -> + YosysSequential -> + Integer -> + m SC.TypedTerm +composeYosysSequential sc s n = do + let t = SC.ttTerm $ s ^. yosysSequentialTerm + + width <- liftIO . SC.scNat sc $ fromIntegral n + extendedInputFields <- forM (s ^. yosysSequentialInputFields) $ \(ty, cty) -> do + exty <- liftIO $ SC.scVecType sc width ty + let excty = C.tSeq (C.tNum n) cty + pure (exty, excty) + extendedOutputFields <- forM (s ^. yosysSequentialOutputFields) $ \(ty, cty) -> do + exty <- liftIO $ SC.scVecType sc width ty + let excty = C.tSeq (C.tNum n) cty + pure (exty, excty) + extendedInputType <- fieldsToType sc extendedInputFields + extendedInputCryptolType <- fieldsToCryptolType extendedInputFields + extendedInputRecordEC <- liftIO $ SC.scFreshEC sc "input" extendedInputType + extendedInputRecord <- liftIO $ SC.scExtCns sc extendedInputRecordEC + extendedOutputCryptolType <- fieldsToCryptolType extendedOutputFields + + allInputs <- fmap Map.fromList . forM (Map.keys extendedInputFields) $ \nm -> do + inp <- liftIO $ cryptolRecordSelect sc extendedInputFields extendedInputRecord nm + pure (nm, inp) + + codomainFields <- insertStateField sc (s ^. yosysSequentialStateFields) $ s ^. yosysSequentialOutputFields + + let + buildIntermediateInput :: Integer -> SC.Term -> m SC.Term + buildIntermediateInput i st = do + inps <- fmap Map.fromList . forM (Map.assocs allInputs) $ \(nm, inp) -> do + case Map.lookup nm $ s ^. yosysSequentialInputFields of + Nothing -> throw . YosysError $ "Invalid input: " <> nm + Just (elemty, _) -> do + idx <- liftIO . SC.scNat sc $ fromIntegral i + idxed <- liftIO $ SC.scAt sc width elemty inp idx + pure (nm, idxed) + let inpsWithSt = Map.insert "__state__" st inps + cryptolRecord sc inpsWithSt + + summarizeOutput :: SC.Term -> m (SC.Term, Map Text SC.Term) + summarizeOutput outrec = do + outstate <- liftIO $ cryptolRecordSelect sc codomainFields outrec "__state__" + outputs <- fmap Map.fromList . forM (Map.assocs $ s ^. yosysSequentialOutputFields) $ \(nm, (ty, _)) -> do + out <- liftIO $ cryptolRecordSelect sc codomainFields outrec nm + wrapped <- liftIO $ SC.scSingle sc ty out + pure (nm, wrapped) + pure (outstate, outputs) + + compose1 :: Integer -> (SC.Term, Map Text SC.Term) -> m (SC.Term, Map Text SC.Term) + compose1 i (st, outs) = do + inprec <- buildIntermediateInput i st + outrec <- liftIO $ SC.scApply sc t inprec + (st', outs') <- summarizeOutput outrec + mergedOuts <- fmap Map.fromList . forM (Map.assocs outs') $ \(nm, arr) -> do + case (Map.lookup nm $ s ^. yosysSequentialOutputFields, Map.lookup nm outs) of + (Just (ty, _), Just rest) -> do + restlen <- liftIO . SC.scNat sc $ fromIntegral i + arrlen <- liftIO $ SC.scNat sc 1 + appended <- liftIO $ SC.scAppend sc restlen arrlen ty rest arr + pure (nm, appended) + _ -> pure (nm, arr) + pure (st', mergedOuts) + + stateType <- fieldsToType sc $ s ^. yosysSequentialStateFields + initialStateMsg <- liftIO $ SC.scString sc "Attempted to read initial state of sequential circuit" + initialState <- liftIO $ SC.scGlobalApply sc (SC.mkIdent SC.preludeName "error") [stateType, initialStateMsg] + (_, outputs) <- foldM (\acc i -> compose1 i acc) (initialState, Map.empty) [0..n] + outputRecord <- cryptolRecord sc outputs + res <- liftIO $ SC.scAbstractExts sc [extendedInputRecordEC] outputRecord + let cty = C.tFun extendedInputCryptolType extendedOutputCryptolType + pure $ SC.TypedTerm (SC.TypedTermSchema $ C.tMono cty) res From 9632565ce4e5d6999795e55af624907eff5ca81c Mon Sep 17 00:00:00 2001 From: Samuel Breese Date: Sat, 21 May 2022 15:42:37 -0400 Subject: [PATCH 20/47] Use cell names for DFF state lookups instead of a placeholder --- src/SAWScript/Yosys/Netgraph.hs | 14 +++++++------- src/SAWScript/Yosys/State.hs | 26 +++++++++++++------------- 2 files changed, 20 insertions(+), 20 deletions(-) diff --git a/src/SAWScript/Yosys/Netgraph.hs b/src/SAWScript/Yosys/Netgraph.hs index bc114f75a2..4c1d3d491d 100644 --- a/src/SAWScript/Yosys/Netgraph.hs +++ b/src/SAWScript/Yosys/Netgraph.hs @@ -80,7 +80,7 @@ cellToEdges c = (, inputBits) <$> outputBits data Netgraph b = Netgraph { _netgraphGraph :: Graph.Graph - , _netgraphNodeFromVertex :: Graph.Vertex -> (Cell [b], b, [b]) + , _netgraphNodeFromVertex :: Graph.Vertex -> ((Text, Cell [b]), b, [b]) -- , _netgraphVertexFromKey :: Bitrep -> Maybe Graph.Vertex } makeLenses ''Netgraph @@ -101,10 +101,10 @@ moduleNetgraph m = ) . Map.assocs $ m ^. modulePorts -- - cellToNodes :: Cell [Bitrep] -> [(Cell [Bitrep], Bitrep, [Bitrep])] - cellToNodes c - | c ^. cellType == "$dff" = (c, , []) <$> outputBits - | otherwise = (c, , inputBits) <$> outputBits + cellToNodes :: (Text, Cell [Bitrep]) -> [((Text, Cell [Bitrep]), Bitrep, [Bitrep])] + cellToNodes (nm, c) + | c ^. cellType == "$dff" = ((nm, c), , []) <$> outputBits + | otherwise = ((nm, c), , inputBits) <$> outputBits where inputBits :: [Bitrep] inputBits = @@ -132,7 +132,7 @@ moduleNetgraph m = ) . Map.assocs $ c ^. cellConnections - nodes = concatMap cellToNodes . Map.elems $ m ^. moduleCells + nodes = concatMap cellToNodes . Map.assocs $ m ^. moduleCells (_netgraphGraph, _netgraphNodeFromVertex, _netgraphVertexFromKey) = Graph.graphFromEdges nodes in Netgraph{..} @@ -201,7 +201,7 @@ netgraphToTerms sc env ng inputs let sorted = Graph.reverseTopSort $ ng ^. netgraphGraph foldM ( \acc v -> do - let (c, _output, _deps) = ng ^. netgraphNodeFromVertex $ v + let ((_, c), _output, _deps) = ng ^. netgraphNodeFromVertex $ v let outputFields = Map.filter (\d -> d == DirectionOutput || d == DirectionInout) $ c ^. cellPortDirections if -- special handling for $dff nodes - we read their /output/ from the inputs map, and later detect and write their /input/ to the state diff --git a/src/SAWScript/Yosys/State.hs b/src/SAWScript/Yosys/State.hs index 58d7f528a5..e4b35afa9f 100644 --- a/src/SAWScript/Yosys/State.hs +++ b/src/SAWScript/Yosys/State.hs @@ -60,7 +60,7 @@ qualifyBitrep nm (Bitrep i) = QualBitrep nm i -------------------------------------------------------------------------------- -- ** Constructing a graph of the entire circuit. -type CircgraphNode = (Cell [QualBitrep], QualBitrep, [QualBitrep]) +type CircgraphNode = ((Text, Cell [QualBitrep]), QualBitrep, [QualBitrep]) rebindQualify :: Text -> Map [Bitrep] [QualBitrep] -> [Bitrep] -> [QualBitrep] rebindQualify inm binds bits = case Map.lookup bits binds of @@ -70,7 +70,6 @@ rebindQualify inm binds bits = case Map.lookup bits binds of moduleToInlineNetgraph :: forall m. MonadIO m => Map Text Module -> Module -> m (Netgraph QualBitrep) moduleToInlineNetgraph mmap topm = do nodes <- go "top" Map.empty topm - -- liftIO $ putStrLn $ unlines $ (\(c, out, inp) -> show (c ^. cellType, out, inp)) <$> nodes let (_netgraphGraph, _netgraphNodeFromVertex, _) = Graph.graphFromEdges nodes pure Netgraph{..} where @@ -79,9 +78,9 @@ moduleToInlineNetgraph mmap topm = do fmap mconcat . forM (Map.assocs $ m ^. moduleCells) $ \(cnm, fmap (rebindQualify inm binds) -> c) -> do if | c ^. cellType == "$dff" - -> pure $ (\(out, _inp) -> (c, out, [])) <$> cellToEdges c + -> pure $ (\(out, _inp) -> ((cnm, c), out, [])) <$> cellToEdges c | Text.isPrefixOf "$" (c ^. cellType) - -> pure $ (\(out, inp) -> (c, out, inp)) <$> cellToEdges c + -> pure $ (\(out, inp) -> ((cnm, c), out, inp)) <$> cellToEdges c | Just subm <- Map.lookup (c ^. cellType) mmap -> do sbinds <- forM (Map.assocs $ subm ^. modulePorts) $ \(pnm, p) -> do @@ -98,10 +97,11 @@ moduleToInlineNetgraph mmap topm = do findDffs :: Netgraph QualBitrep -> - [Cell [QualBitrep]] + Map Text (Cell [QualBitrep]) findDffs ng = - filter (\c -> c ^. cellType == "$dff") - . fmap (\v -> let (c, _, _) = ng ^. netgraphNodeFromVertex $ v in c) + Map.fromList + . filter (\(_, c) -> c ^. cellType == "$dff") + . fmap (\v -> let (n, _, _) = ng ^. netgraphNodeFromVertex $ v in n) . Graph.vertices $ ng ^. netgraphGraph @@ -148,13 +148,13 @@ convertModuleInline sc mmap m = do -- construct SAWCore and Cryptol types let dffs = findDffs ng - stateFields <- fmap Map.fromList . forM dffs $ \c -> + stateFields <- forM dffs $ \c -> case Map.lookup "Q" $ c ^. cellConnections of Nothing -> panic "convertModuleInline" ["Missing expected output name for $dff cell"] Just b -> do t <- liftIO . SC.scBitvector sc . fromIntegral $ length b let cty = C.tWord . C.tNum $ length b - pure ("nm", (t, cty)) + pure (t, cty) let inputPorts = moduleInputPorts m let outputPorts = moduleOutputPorts m @@ -184,11 +184,11 @@ convertModuleInline sc mmap m = do deriveTermsByIndices sc (qualifyBitrep "top" <$> inp) t preStateRecord <- liftIO $ cryptolRecordSelect sc domainFields domainRecord "__state__" - derivedPreState <- forM dffs $ \c -> + derivedPreState <- forM (Map.assocs dffs) $ \(cnm, c) -> case Map.lookup "Q" $ c ^. cellConnections of Nothing -> panic "convertModuleInline" ["Missing expected output name for $dff cell"] Just b -> do - t <- liftIO $ cryptolRecordSelect sc stateFields preStateRecord "nm" + t <- liftIO $ cryptolRecordSelect sc stateFields preStateRecord cnm deriveTermsByIndices sc b t zeroTerm <- liftIO $ SC.scBvConst sc 1 0 @@ -210,8 +210,8 @@ convertModuleInline sc mmap m = do Nothing -> panic "convertModuleInline" ["Missing expected input name for $dff cell"] Just b -> do t <- lookupPatternTerm sc b terms - pure ("nm", t) - postStateRecord <- cryptolRecord sc $ Map.fromList postStateFields + pure t + postStateRecord <- cryptolRecord sc postStateFields outputRecord <- cryptolRecord sc . Map.insert "__state__" postStateRecord =<< forM outputPorts (\out -> lookupPatternTerm sc (qualifyBitrep "top" <$> out) terms) From c44bb9c11be132b15c306c5360773dc8163e187a Mon Sep 17 00:00:00 2001 From: Samuel Breese Date: Sun, 22 May 2022 21:03:24 -0400 Subject: [PATCH 21/47] Fixes for shifts and arithmetic cells, improved sequential circuits --- src/SAWScript/Yosys.hs | 2 +- src/SAWScript/Yosys/Cell.hs | 68 ++++++++++++++++++----- src/SAWScript/Yosys/Netgraph.hs | 3 +- src/SAWScript/Yosys/State.hs | 96 ++++++++------------------------- 4 files changed, 80 insertions(+), 89 deletions(-) diff --git a/src/SAWScript/Yosys.hs b/src/SAWScript/Yosys.hs index 1443461137..37e3af24e4 100644 --- a/src/SAWScript/Yosys.hs +++ b/src/SAWScript/Yosys.hs @@ -140,7 +140,7 @@ yosysIRToSequential sc ir nm = do [ "Could not find module: " , nm ] - Just m -> convertModuleInline sc (ir ^. yosysModules) m + Just m -> convertModuleInline sc m -------------------------------------------------------------------------------- -- ** Functions visible from SAWScript REPL diff --git a/src/SAWScript/Yosys/Cell.hs b/src/SAWScript/Yosys/Cell.hs index f42d09abe2..56a9b59117 100644 --- a/src/SAWScript/Yosys/Cell.hs +++ b/src/SAWScript/Yosys/Cell.hs @@ -69,10 +69,38 @@ primCellToTerm sc c args = case c ^. cellType of liftIO $ SC.scAbstractExts sc [xEC, yEC] res "$reduce_bool" -> bvReduce False =<< do liftIO . SC.scLookupDef sc $ SC.mkIdent SC.preludeName "or" - "$shl" -> bvBinaryOp $ SC.scBvShl sc - "$shr" -> bvBinaryOp $ SC.scBvShr sc - "$sshl" -> bvBinaryOp $ SC.scBvShl sc -- same as shl - "$sshr" -> bvBinaryOp $ SC.scBvSShr sc + "$shl" -> do + ta <- input "A" + nb <- inputNat "B" + w <- outputWidth + res <- liftIO $ SC.scBvShl sc w ta nb + fmap Just . cryptolRecord sc $ Map.fromList + [ ("Y", res) + ] + "$shr" -> do + ta <- input "A" + nb <- inputNat "B" + w <- outputWidth + res <- liftIO $ SC.scBvShr sc w ta nb + fmap Just . cryptolRecord sc $ Map.fromList + [ ("Y", res) + ] + "$sshl" -> do + ta <- input "A" + nb <- inputNat "B" + w <- outputWidth + res <- liftIO $ SC.scBvShl sc w ta nb + fmap Just . cryptolRecord sc $ Map.fromList + [ ("Y", res) + ] + "$sshr" -> do + ta <- input "A" + nb <- inputNat "B" + w <- outputWidth + res <- liftIO $ SC.scBvSShr sc w ta nb + fmap Just . cryptolRecord sc $ Map.fromList + [ ("Y", res) + ] -- "$shift" -> _ -- "$shiftx" -> _ "$lt" -> bvBinaryCmp $ SC.scBvULt sc @@ -87,11 +115,11 @@ primCellToTerm sc c args = case c ^. cellType of "$nex" -> bvBinaryCmp $ \w x y -> do r <- SC.scBvEq sc w x y SC.scNot sc r - "$add" -> bvNAryOp $ SC.scBvAdd sc - "$sub" -> bvBinaryOp $ SC.scBvSub sc - "$mul" -> bvNAryOp $ SC.scBvMul sc - "$div" -> bvBinaryOp $ SC.scBvUDiv sc - "$mod" -> bvBinaryOp $ SC.scBvURem sc + "$add" -> bvBinaryArithOp $ SC.scBvAdd sc + "$sub" -> bvBinaryArithOp $ SC.scBvSub sc + "$mul" -> bvBinaryArithOp $ SC.scBvMul sc + "$div" -> bvBinaryArithOp $ SC.scBvUDiv sc + "$mod" -> bvBinaryArithOp $ SC.scBvURem sc -- "$modfloor" -> _ "$logic_not" -> do w <- outputWidth @@ -155,6 +183,14 @@ primCellToTerm sc c args = case c ^. cellType of case Map.lookup inpNm args of Nothing -> panic "cellToTerm" [Text.unpack $ mconcat [nm, " missing input ", inpNm]] Just a -> pure a + inputNat :: Text -> m SC.Term + inputNat inpNm = do + v <- input inpNm + w <- connWidth inpNm + bool <- liftIO $ SC.scBoolType sc + rev <- liftIO $ SC.scGlobalApply sc "Prelude.reverse" [w, bool, v] + -- note bvToNat is big-endian while yosys shifts expect little-endian + liftIO $ SC.scGlobalApply sc "Prelude.bvToNat" [w, rev] bvUnaryOp :: (SC.Term -> SC.Term -> IO SC.Term) -> m (Maybe SC.Term) bvUnaryOp f = do t <- input "A" @@ -163,14 +199,18 @@ primCellToTerm sc c args = case c ^. cellType of fmap Just . cryptolRecord sc $ Map.fromList [ ("Y", res) ] - bvBinaryOp :: (SC.Term -> SC.Term -> SC.Term -> IO SC.Term) -> m (Maybe SC.Term) - bvBinaryOp f = do + bvBinaryArithOp :: (SC.Term -> SC.Term -> SC.Term -> IO SC.Term) -> m (Maybe SC.Term) + bvBinaryArithOp f = do + w <- outputWidth + bool <- liftIO $ SC.scBoolType sc ta <- input "A" + reva <- liftIO $ SC.scGlobalApply sc "Prelude.reverse" [w, bool, ta] tb <- input "B" - w <- outputWidth - res <- liftIO $ f w ta tb + revb <- liftIO $ SC.scGlobalApply sc "Prelude.reverse" [w, bool, tb] + res <- liftIO $ f w reva revb + revres <- liftIO $ SC.scGlobalApply sc "Prelude.reverse" [w, bool, res] fmap Just . cryptolRecord sc $ Map.fromList - [ ("Y", res) + [ ("Y", revres) ] bvBinaryCmp :: (SC.Term -> SC.Term -> SC.Term -> IO SC.Term) -> m (Maybe SC.Term) bvBinaryCmp f = do diff --git a/src/SAWScript/Yosys/Netgraph.hs b/src/SAWScript/Yosys/Netgraph.hs index 4c1d3d491d..65731ef1b2 100644 --- a/src/SAWScript/Yosys/Netgraph.hs +++ b/src/SAWScript/Yosys/Netgraph.hs @@ -201,7 +201,8 @@ netgraphToTerms sc env ng inputs let sorted = Graph.reverseTopSort $ ng ^. netgraphGraph foldM ( \acc v -> do - let ((_, c), _output, _deps) = ng ^. netgraphNodeFromVertex $ v + let ((cnm, c), _output, deps) = ng ^. netgraphNodeFromVertex $ v + liftIO . putStrLn $ "Processing cell " <> show cnm <> " with deps: " <> show deps let outputFields = Map.filter (\d -> d == DirectionOutput || d == DirectionInout) $ c ^. cellPortDirections if -- special handling for $dff nodes - we read their /output/ from the inputs map, and later detect and write their /input/ to the state diff --git a/src/SAWScript/Yosys/State.hs b/src/SAWScript/Yosys/State.hs index e4b35afa9f..af83e00215 100644 --- a/src/SAWScript/Yosys/State.hs +++ b/src/SAWScript/Yosys/State.hs @@ -22,6 +22,8 @@ import Data.Text (Text) import qualified Data.Text as Text import qualified Data.Graph as Graph +import Numeric.Natural (Natural) + import qualified Verifier.SAW.SharedTerm as SC import qualified Verifier.SAW.TypedTerm as SC import qualified Verifier.SAW.Name as SC @@ -36,68 +38,9 @@ import SAWScript.Yosys.Utils import SAWScript.Yosys.IR import SAWScript.Yosys.Netgraph --------------------------------------------------------------------------------- --- ** Bit identifiers qualified with the name of a module instance. --- To ensure global uniqueness, since for sequential circuits we use one global --- graph of cells to properly detect cycles where the breaking DFF is within a --- submodule. - -data QualBitrep - = QualBitrepZero - | QualBitrepOne - | QualBitrepX - | QualBitrepZ - | QualBitrep Text Integer - deriving (Show, Eq, Ord) - -qualifyBitrep :: Text -> Bitrep -> QualBitrep -qualifyBitrep _ BitrepZero = QualBitrepZero -qualifyBitrep _ BitrepOne = QualBitrepOne -qualifyBitrep _ BitrepX = QualBitrepX -qualifyBitrep _ BitrepZ = QualBitrepZ -qualifyBitrep nm (Bitrep i) = QualBitrep nm i - --------------------------------------------------------------------------------- --- ** Constructing a graph of the entire circuit. - -type CircgraphNode = ((Text, Cell [QualBitrep]), QualBitrep, [QualBitrep]) - -rebindQualify :: Text -> Map [Bitrep] [QualBitrep] -> [Bitrep] -> [QualBitrep] -rebindQualify inm binds bits = case Map.lookup bits binds of - Nothing -> qualifyBitrep inm <$> bits - Just qbits -> qbits - -moduleToInlineNetgraph :: forall m. MonadIO m => Map Text Module -> Module -> m (Netgraph QualBitrep) -moduleToInlineNetgraph mmap topm = do - nodes <- go "top" Map.empty topm - let (_netgraphGraph, _netgraphNodeFromVertex, _) = Graph.graphFromEdges nodes - pure Netgraph{..} - where - go :: Text -> Map [Bitrep] [QualBitrep] -> Module -> m [CircgraphNode] - go inm binds m = do - fmap mconcat . forM (Map.assocs $ m ^. moduleCells) $ \(cnm, fmap (rebindQualify inm binds) -> c) -> do - if - | c ^. cellType == "$dff" - -> pure $ (\(out, _inp) -> ((cnm, c), out, [])) <$> cellToEdges c - | Text.isPrefixOf "$" (c ^. cellType) - -> pure $ (\(out, inp) -> ((cnm, c), out, inp)) <$> cellToEdges c - | Just subm <- Map.lookup (c ^. cellType) mmap - -> do - sbinds <- forM (Map.assocs $ subm ^. modulePorts) $ \(pnm, p) -> do - case Map.lookup pnm (c ^. cellConnections) of - Nothing -> throw . YosysError $ mconcat - [ "Cell \"", cnm, "\" does not provide a connection for port \"", pnm, "\"" - ] - Just cbits -> pure (p ^. portBits, cbits) - liftIO $ putStrLn $ "Descending into: " <> Text.unpack (c ^. cellType) <> ", binds are " <> show sbinds - subcells <- go (inm <> " " <> cnm) (Map.fromList sbinds) subm - pure subcells - | otherwise - -> throw . YosysError $ "No definition for module: " <> (c ^. cellType) - findDffs :: - Netgraph QualBitrep -> - Map Text (Cell [QualBitrep]) + Netgraph Bitrep -> + Map Text (Cell [Bitrep]) findDffs ng = Map.fromList . filter (\(_, c) -> c ^. cellType == "$dff") @@ -110,6 +53,7 @@ data YosysSequential = YosysSequential , _yosysSequentialStateFields :: Map Text (SC.Term, C.Type) , _yosysSequentialInputFields :: Map Text (SC.Term, C.Type) , _yosysSequentialOutputFields :: Map Text (SC.Term, C.Type) + , _yosysSequentialStateWidths :: Map Text Natural } makeLenses ''YosysSequential @@ -140,21 +84,23 @@ insertStateField sc stateFields fields = do convertModuleInline :: MonadIO m => SC.SharedContext -> - Map Text Module -> Module -> m YosysSequential -convertModuleInline sc mmap m = do - ng <- moduleToInlineNetgraph mmap m +convertModuleInline sc m = do + let ng = moduleNetgraph m -- construct SAWCore and Cryptol types let dffs = findDffs ng - stateFields <- forM dffs $ \c -> + + stateWidths <- forM dffs $ \c -> case Map.lookup "Q" $ c ^. cellConnections of Nothing -> panic "convertModuleInline" ["Missing expected output name for $dff cell"] - Just b -> do - t <- liftIO . SC.scBitvector sc . fromIntegral $ length b - let cty = C.tWord . C.tNum $ length b - pure (t, cty) + Just b -> pure . fromIntegral $ length b + + stateFields <- forM stateWidths $ \w -> do + t <- liftIO $ SC.scBitvector sc w + let cty = C.tWord $ C.tNum w + pure (t, cty) let inputPorts = moduleInputPorts m let outputPorts = moduleOutputPorts m @@ -181,7 +127,7 @@ convertModuleInline sc mmap m = do derivedInputs <- forM (Map.assocs inputPorts) $ \(nm, inp) -> do t <- liftIO $ cryptolRecordSelect sc domainFields domainRecord nm - deriveTermsByIndices sc (qualifyBitrep "top" <$> inp) t + deriveTermsByIndices sc inp t preStateRecord <- liftIO $ cryptolRecordSelect sc domainFields domainRecord "__state__" derivedPreState <- forM (Map.assocs dffs) $ \(cnm, c) -> @@ -195,8 +141,8 @@ convertModuleInline sc mmap m = do oneTerm <- liftIO $ SC.scBvConst sc 1 1 let inputs = Map.unions $ mconcat [ [ Map.fromList - [ ( [QualBitrepZero], zeroTerm) - , ( [QualBitrepOne], oneTerm ) + [ ( [BitrepZero], zeroTerm) + , ( [BitrepOne], oneTerm ) ] ] , derivedInputs @@ -214,7 +160,7 @@ convertModuleInline sc mmap m = do postStateRecord <- cryptolRecord sc postStateFields outputRecord <- cryptolRecord sc . Map.insert "__state__" postStateRecord =<< forM outputPorts - (\out -> lookupPatternTerm sc (qualifyBitrep "top" <$> out) terms) + (\out -> lookupPatternTerm sc out terms) -- construct result t <- liftIO $ SC.scAbstractExts sc [domainRecordEC] outputRecord @@ -225,6 +171,7 @@ convertModuleInline sc mmap m = do , _yosysSequentialStateFields = stateFields , _yosysSequentialInputFields = inputFields , _yosysSequentialOutputFields = outputFields + , _yosysSequentialStateWidths = stateWidths } composeYosysSequential :: @@ -298,6 +245,9 @@ composeYosysSequential sc s n = do stateType <- fieldsToType sc $ s ^. yosysSequentialStateFields initialStateMsg <- liftIO $ SC.scString sc "Attempted to read initial state of sequential circuit" initialState <- liftIO $ SC.scGlobalApply sc (SC.mkIdent SC.preludeName "error") [stateType, initialStateMsg] + -- initialStateFields <- forM (s ^. yosysSequentialStateWidths) $ \w -> do + -- liftIO $ SC.scBvConst sc w 0 + -- initialState <- cryptolRecord sc initialStateFields (_, outputs) <- foldM (\acc i -> compose1 i acc) (initialState, Map.empty) [0..n] outputRecord <- cryptolRecord sc outputs res <- liftIO $ SC.scAbstractExts sc [extendedInputRecordEC] outputRecord From e696ba62d64591d887a12b6777da39a968d84f9c Mon Sep 17 00:00:00 2001 From: Samuel Breese Date: Tue, 31 May 2022 11:50:55 -0400 Subject: [PATCH 22/47] Remove debug print statement --- src/SAWScript/Yosys/Netgraph.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/src/SAWScript/Yosys/Netgraph.hs b/src/SAWScript/Yosys/Netgraph.hs index 65731ef1b2..1676ff38d9 100644 --- a/src/SAWScript/Yosys/Netgraph.hs +++ b/src/SAWScript/Yosys/Netgraph.hs @@ -202,7 +202,6 @@ netgraphToTerms sc env ng inputs foldM ( \acc v -> do let ((cnm, c), _output, deps) = ng ^. netgraphNodeFromVertex $ v - liftIO . putStrLn $ "Processing cell " <> show cnm <> " with deps: " <> show deps let outputFields = Map.filter (\d -> d == DirectionOutput || d == DirectionInout) $ c ^. cellPortDirections if -- special handling for $dff nodes - we read their /output/ from the inputs map, and later detect and write their /input/ to the state From 0f41b6fef90ca7064305d28358a091b488de7cbc Mon Sep 17 00:00:00 2001 From: Samuel Breese Date: Mon, 6 Jun 2022 01:35:59 -0400 Subject: [PATCH 23/47] Add preliminary support for model checker query --- .gitmodules | 3 +++ cabal.project | 2 ++ deps/language-sally | 1 + deps/what4 | 2 +- saw-script.cabal | 3 +++ src/SAWScript/Interpreter.hs | 5 +++++ src/SAWScript/Yosys.hs | 13 +++++++++++-- src/SAWScript/Yosys/State.hs | 4 ++++ 8 files changed, 30 insertions(+), 3 deletions(-) create mode 160000 deps/language-sally diff --git a/.gitmodules b/.gitmodules index 26c5446492..926212c99c 100644 --- a/.gitmodules +++ b/.gitmodules @@ -43,3 +43,6 @@ [submodule "deps/language-rust"] path = deps/language-rust url = https://github.com/harpocrates/language-rust.git +[submodule "deps/language-sally"] + path = deps/language-sally + url = https://github.com/GaloisInc/language-sally diff --git a/cabal.project b/cabal.project index 7f67a14279..4ac34a0ad2 100644 --- a/cabal.project +++ b/cabal.project @@ -17,6 +17,8 @@ packages: deps/aig deps/cryptol deps/what4/what4 + deps/what4/what4-transition-system + deps/language-sally deps/crucible/crucible deps/crucible/crucible-concurrency deps/crucible/crucible-jvm diff --git a/deps/language-sally b/deps/language-sally new file mode 160000 index 0000000000..de4f979032 --- /dev/null +++ b/deps/language-sally @@ -0,0 +1 @@ +Subproject commit de4f979032396b2c8fa1b5d05603c47dd96874e2 diff --git a/deps/what4 b/deps/what4 index e569514d10..4722827c8d 160000 --- a/deps/what4 +++ b/deps/what4 @@ -1 +1 @@ -Subproject commit e569514d10f940db20027705388565f3d9f729e3 +Subproject commit 4722827c8def6a59623c87c8fadf6658930088a9 diff --git a/saw-script.cabal b/saw-script.cabal index 30aeb6e830..b981f033e2 100644 --- a/saw-script.cabal +++ b/saw-script.cabal @@ -83,6 +83,8 @@ library , unordered-containers , utf8-string , what4 >= 0.4 + , what4-transition-system + , language-sally , vector , GraphSCC , macaw-base @@ -180,6 +182,7 @@ library SAWScript.Yosys.Netgraph SAWScript.Yosys.State SAWScript.Yosys.Theorem + SAWScript.Yosys.TransitionSystem SAWScript.Yosys.Utils GHC-options: -O2 -Wall -fno-ignore-asserts -fno-spec-constr-count diff --git a/src/SAWScript/Interpreter.hs b/src/SAWScript/Interpreter.hs index 89e89bb4d8..a557afb3f5 100644 --- a/src/SAWScript/Interpreter.hs +++ b/src/SAWScript/Interpreter.hs @@ -3359,6 +3359,11 @@ primitives = Map.fromList Experimental [] + , prim "yosys_verify_sequential_offline_sally" "YosysSequential -> String -> Term -> TopLevel ()" + (pureVal yosys_verify_sequential_sally) + Experimental + [] + --------------------------------------------------------------------- , prim "mr_solver_prove" "Term -> Term -> TopLevel ()" diff --git a/src/SAWScript/Yosys.hs b/src/SAWScript/Yosys.hs index 37e3af24e4..31f06268e0 100644 --- a/src/SAWScript/Yosys.hs +++ b/src/SAWScript/Yosys.hs @@ -14,6 +14,7 @@ module SAWScript.Yosys , yosys_import_sequential , yosys_extract_sequential , yosys_extract_sequential_raw + , yosys_verify_sequential_sally , loadYosysIR , yosysIRToTypedTerms ) where @@ -22,14 +23,13 @@ import Control.Lens.TH (makeLenses) import Control.Lens (view, (^.)) import Control.Exception (throw) -import Control.Monad (forM, foldM) +import Control.Monad (foldM) import Control.Monad.IO.Class (MonadIO(..)) import qualified Data.List.NonEmpty as NE import Data.Map (Map) import qualified Data.Map as Map import Data.Text (Text) -import qualified Data.Text as Text import qualified Data.Graph as Graph import qualified Text.URI as URI @@ -43,12 +43,14 @@ import qualified Cryptol.Utils.RecordMap as C import SAWScript.Value import qualified SAWScript.Builtins as Builtins +import qualified SAWScript.Crucible.Common as Common import SAWScript.Yosys.Utils import SAWScript.Yosys.IR import SAWScript.Yosys.Netgraph import SAWScript.Yosys.State import SAWScript.Yosys.Theorem +import SAWScript.Yosys.TransitionSystem -------------------------------------------------------------------------------- -- ** Building the module graph from Yosys IR @@ -182,3 +184,10 @@ yosys_extract_sequential s n = do yosys_extract_sequential_raw :: YosysSequential -> TopLevel SC.TypedTerm yosys_extract_sequential_raw s = pure $ s ^. yosysSequentialTerm + +yosys_verify_sequential_sally :: YosysSequential -> FilePath -> SC.TypedTerm -> TopLevel () +yosys_verify_sequential_sally s path q = do + sc <- getSharedContext + sym <- liftIO $ Common.newSAWCoreExprBuilder sc + scs <- liftIO $ Common.sawCoreState sym + queryModelChecker sym scs sc s path q diff --git a/src/SAWScript/Yosys/State.hs b/src/SAWScript/Yosys/State.hs index af83e00215..176bb869c7 100644 --- a/src/SAWScript/Yosys/State.hs +++ b/src/SAWScript/Yosys/State.hs @@ -53,6 +53,8 @@ data YosysSequential = YosysSequential , _yosysSequentialStateFields :: Map Text (SC.Term, C.Type) , _yosysSequentialInputFields :: Map Text (SC.Term, C.Type) , _yosysSequentialOutputFields :: Map Text (SC.Term, C.Type) + , _yosysSequentialInputWidths :: Map Text Natural + , _yosysSequentialOutputWidths :: Map Text Natural , _yosysSequentialStateWidths :: Map Text Natural } makeLenses ''YosysSequential @@ -171,6 +173,8 @@ convertModuleInline sc m = do , _yosysSequentialStateFields = stateFields , _yosysSequentialInputFields = inputFields , _yosysSequentialOutputFields = outputFields + , _yosysSequentialInputWidths = fromIntegral . length <$> inputPorts + , _yosysSequentialOutputWidths = fromIntegral . length <$> outputPorts , _yosysSequentialStateWidths = stateWidths } From 21013de14dc0ac086b90fea911b408e8881f7551 Mon Sep 17 00:00:00 2001 From: Samuel Breese Date: Mon, 13 Jun 2022 13:57:09 -0400 Subject: [PATCH 24/47] Better model checker export, Python stuff --- saw-remote-api/python/saw_client/commands.py | 34 +++ .../python/saw_client/connection.py | 10 +- saw-remote-api/saw-remote-api.cabal | 1 - saw-remote-api/saw-remote-api/Main.hs | 14 +- saw-remote-api/src/SAWServer.hs | 17 +- saw-remote-api/src/SAWServer/Exceptions.hs | 12 + saw-remote-api/src/SAWServer/Term.hs | 26 -- saw-remote-api/src/SAWServer/Yosys.hs | 86 +++++- src/SAWScript/Builtins.hs | 10 +- src/SAWScript/Interpreter.hs | 2 +- src/SAWScript/Yosys.hs | 8 +- src/SAWScript/Yosys/TransitionSystem.hs | 275 ++++++++++++++++++ 12 files changed, 451 insertions(+), 44 deletions(-) delete mode 100644 saw-remote-api/src/SAWServer/Term.hs create mode 100644 src/SAWScript/Yosys/TransitionSystem.hs diff --git a/saw-remote-api/python/saw_client/commands.py b/saw-remote-api/python/saw_client/commands.py index ba0e9d285f..2d901631e3 100644 --- a/saw-remote-api/python/saw_client/commands.py +++ b/saw-remote-api/python/saw_client/commands.py @@ -59,6 +59,40 @@ def __init__( def process_result(self, res : Any) -> Any: return res +class YosysImportSequential(SAWCommand): + def __init__(self, + connection : argo.HasProtocolState, + name : str, + path : str, + module : str, + timeout : Optional[float]) -> None: + super(YosysImportSequential, self).__init__( + 'SAW/Yosys/import sequential', + {'name': name, 'path': path, 'module': module}, + connection, + timeout=timeout + ) + + def process_result(self, res : Any) -> Any: + return res + +class YosysExtractSequential(SAWCommand): + def __init__(self, + connection : argo.HasProtocolState, + name : str, + module : str, + cycles : int, + timeout : Optional[float]) -> None: + super(YosysExtractSequential, self).__init__( + 'SAW/Yosys/extract sequential', + {'name': name, 'cycles': cycles, 'module': module}, + connection, + timeout=timeout + ) + + def process_result(self, res : Any) -> Any: + return res + class CryptolLoadFile(SAWCommand): def __init__(self, connection : argo.HasProtocolState, filename : str, diff --git a/saw-remote-api/python/saw_client/connection.py b/saw-remote-api/python/saw_client/connection.py index 924ec6b5d0..7d8d33dae1 100644 --- a/saw-remote-api/python/saw_client/connection.py +++ b/saw-remote-api/python/saw_client/connection.py @@ -229,7 +229,7 @@ def llvm_assume(self, LLVMAssume(self, module, function, contract, lemma_name, timeout) return self.most_recent_result - def yosys_import(self, name: str, path: str, timeout : Optional[float] = None) -> Command: + def yosys_import(self, name: str, path: str, timeout : Optional[float] = None) -> Command: self.most_recent_result = YosysImport(self, name, path, timeout) return self.most_recent_result @@ -246,6 +246,14 @@ def yosys_verify(self, YosysVerify(self, imp, module, preconds, spec, lemmas, script, lemma_name, timeout) return self.most_recent_result + def yosys_import_sequential(self, name: str, path: str, module: str, timeout : Optional[float] = None) -> Command: + self.most_recent_result = YosysImportSequential(self, name, path, module, timeout) + return self.most_recent_result + + def yosys_extract_sequential(self, name: str, module: str, cycles: int, timeout : Optional[float] = None) -> Command: + self.most_recent_result = YosysExtractSequential(self, name, module, cycles, timeout) + return self.most_recent_result + def prove(self, goal: cryptoltypes.CryptolJSON, proof_script: ProofScript, diff --git a/saw-remote-api/saw-remote-api.cabal b/saw-remote-api/saw-remote-api.cabal index cb69162274..a903c5b63f 100644 --- a/saw-remote-api/saw-remote-api.cabal +++ b/saw-remote-api/saw-remote-api.cabal @@ -86,7 +86,6 @@ library SAWServer.ProofScript, SAWServer.SaveTerm, SAWServer.SetOption, - SAWServer.Term, SAWServer.TopLevel, SAWServer.TrackFile, SAWServer.VerifyCommon, diff --git a/saw-remote-api/saw-remote-api/Main.hs b/saw-remote-api/saw-remote-api/Main.hs index 371cdc1158..1017c747fd 100644 --- a/saw-remote-api/saw-remote-api/Main.hs +++ b/saw-remote-api/saw-remote-api/Main.hs @@ -40,7 +40,11 @@ import SAWServer.ProofScript ( makeSimpsetDescr, makeSimpset, proveDescr, prove ) import SAWServer.SaveTerm ( saveTermDescr, saveTerm ) import SAWServer.SetOption ( setOptionDescr, setOption ) -import SAWServer.Yosys (yosysImportDescr, yosysImport, yosysVerifyDescr, yosysVerify) +import SAWServer.Yosys + ( yosysImportDescr, yosysImport, + yosysVerifyDescr, yosysVerify, + yosysImportSequentialDescr, yosysImportSequential, + yosysExtractSequentialDescr, yosysExtractSequential ) main :: IO () @@ -119,6 +123,14 @@ sawMethods = "SAW/Yosys/verify" yosysVerifyDescr yosysVerify + , Argo.command + "SAW/Yosys/import sequential" + yosysImportSequentialDescr + yosysImportSequential + , Argo.command + "SAW/Yosys/extract sequential" + yosysExtractSequentialDescr + yosysExtractSequential -- General , Argo.command "SAW/create ghost variable" diff --git a/saw-remote-api/src/SAWServer.hs b/saw-remote-api/src/SAWServer.hs index c58713fb23..62e5929b40 100644 --- a/saw-remote-api/src/SAWServer.hs +++ b/saw-remote-api/src/SAWServer.hs @@ -55,6 +55,7 @@ import SAWScript.Position (Pos(..)) import SAWScript.Prover.Rewrite (basic_ss) import SAWScript.Proof (newTheoremDB) import SAWScript.Value (AIGProxy(..), BuiltinContext(..), JVMSetupM, LLVMCrucibleSetupM, TopLevelRO(..), TopLevelRW(..), defaultPPOpts, SAWSimpset) +import SAWScript.Yosys.State (YosysSequential) import SAWScript.Yosys.Theorem (YosysTheorem) import qualified Verifier.SAW.Cryptol.Prelude as CryptolSAW import Verifier.SAW.CryptolEnv (initCryptolEnv, bindTypedTerm) @@ -65,6 +66,8 @@ import SAWScript.Prover.MRSolver (emptyMREnv) import qualified Argo --import qualified CryptolServer (validateServerState, ServerState(..)) --import qualified CryptolServer (validateServerState, ServerState(..)) +--import qualified CryptolServer (validateServerState, ServerState(..)) +--import qualified CryptolServer (validateServerState, ServerState(..)) import SAWServer.Exceptions ( serverValNotFound, notAnLLVMModule, @@ -75,7 +78,7 @@ import SAWServer.Exceptions notAJVMClass, notAJVMMethodSpecIR, notAYosysImport, - notAYosysTheorem, + notAYosysTheorem, notAYosysSequential ) type SAWCont = (SAWEnv, SAWTask) @@ -316,6 +319,7 @@ data ServerVal | VGhostVar CMS.GhostGlobal | VYosysImport YosysImport | VYosysTheorem YosysTheorem + | VYosysSequential YosysSequential instance Show ServerVal where show (VTerm t) = "(VTerm " ++ show t ++ ")" @@ -331,6 +335,7 @@ instance Show ServerVal where show (VGhostVar x) = "(VGhostVar " ++ show x ++ ")" show (VYosysImport _) = "VYosysImport" show (VYosysTheorem _) = "VYosysTheorem" + show (VYosysSequential _) = "VYosysSequential" class IsServerVal a where toServerVal :: a -> ServerVal @@ -365,6 +370,9 @@ instance IsServerVal YosysImport where instance IsServerVal YosysTheorem where toServerVal = VYosysTheorem +instance IsServerVal YosysSequential where + toServerVal = VYosysSequential + class KnownCrucibleSetupType a where knownCrucibleSetupRepr :: CrucibleSetupTypeRepr a @@ -480,3 +488,10 @@ getYosysTheorem n = case v of VYosysTheorem t -> return t _other -> Argo.raise (notAYosysTheorem n) + +getYosysSequential :: ServerName -> Argo.Command SAWState YosysSequential +getYosysSequential n = + do v <- getServerVal n + case v of + VYosysSequential t -> return t + _other -> Argo.raise (notAYosysSequential n) diff --git a/saw-remote-api/src/SAWServer/Exceptions.hs b/saw-remote-api/src/SAWServer/Exceptions.hs index bc361e4048..a580e000f0 100644 --- a/saw-remote-api/src/SAWServer/Exceptions.hs +++ b/saw-remote-api/src/SAWServer/Exceptions.hs @@ -13,6 +13,7 @@ module SAWServer.Exceptions ( , notAJVMClass , notAYosysTheorem , notAYosysImport + , notAYosysSequential -- * Wrong monad errors , notSettingUpCryptol , notSettingUpLLVMCrucible @@ -180,6 +181,17 @@ notAYosysImport name = " is not a Yosys import") (Just $ object ["name" .= name]) +notAYosysSequential :: + (ToJSON name, Show name) => + name {- ^ the name that should have been mapped to a Yosys sequential module -}-> + JSONRPCException +notAYosysSequential name = + makeJSONRPCException 10132 + ("The server value with name " <> + T.pack (show name) <> + " is not a Yosys sequential module") + (Just $ object ["name" .= name]) + cantLoadLLVMModule :: String -> JSONRPCException cantLoadLLVMModule err = makeJSONRPCException diff --git a/saw-remote-api/src/SAWServer/Term.hs b/saw-remote-api/src/SAWServer/Term.hs deleted file mode 100644 index 084056a8c5..0000000000 --- a/saw-remote-api/src/SAWServer/Term.hs +++ /dev/null @@ -1,26 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -module SAWServer.Term (JSONModuleName(..)) where - -import Control.Applicative ( Alternative((<|>)) ) -import Data.Aeson as JSON - ( withArray, withText, FromJSON(parseJSON), ToJSON(toJSON) ) -import qualified Data.Text as T -import qualified Data.Vector as V - -import Verifier.SAW.Term.Functor ( mkModuleName, ModuleName ) - -newtype JSONModuleName = JSONModuleName ModuleName - -instance FromJSON JSONModuleName where - parseJSON val = literal val <|> structured val - where - literal = - withText "module name as string" $ - pure . JSONModuleName . mkModuleName . T.splitOn "." - structured = - withArray "module name as list of parts" $ \v -> - do parts <- traverse parseJSON (V.toList v) - pure $ JSONModuleName $ mkModuleName parts - -instance ToJSON JSONModuleName where - toJSON (JSONModuleName n) = toJSON (show n) diff --git a/saw-remote-api/src/SAWServer/Yosys.hs b/saw-remote-api/src/SAWServer/Yosys.hs index 384ea8f63a..6b505c52a6 100644 --- a/saw-remote-api/src/SAWServer/Yosys.hs +++ b/saw-remote-api/src/SAWServer/Yosys.hs @@ -4,7 +4,7 @@ module SAWServer.Yosys where -import Control.Lens (view) +import Control.Lens (view, (%=)) import Control.Monad (forM) import Control.Monad.IO.Class (liftIO) @@ -14,12 +14,16 @@ import Data.Aeson (FromJSON(..), withObject, (.:)) import Data.Text (Text) import qualified Data.Map as Map +import Cryptol.Utils.Ident (mkIdent) + +import qualified Verifier.SAW.CryptolEnv as CEnv + import qualified Argo import qualified Argo.Doc as Doc import CryptolServer.Data.Expression (Expression(..), getCryptolExpr) -import SAWServer (SAWState, ServerName, YosysImport(..), sawTask, setServerVal, getYosysImport, getYosysTheorem) +import SAWServer (SAWState, ServerName (ServerName), YosysImport(..), sawTask, setServerVal, getYosysImport, getYosysTheorem, getYosysSequential, sawTopLevelRW) import SAWServer.CryptolExpression (CryptolModuleException(..), getTypedTermOfCExp) import SAWServer.Exceptions (notAtTopLevel) import SAWServer.OK (OK, ok) @@ -27,9 +31,7 @@ import SAWServer.ProofScript (ProofScript, interpretProofScript) import SAWServer.TopLevel (tl) import SAWScript.Value (getSharedContext, getTopLevelRW, rwCryptol) -import SAWScript.Yosys (loadYosysIR, yosysIRToTypedTerms, yosys_verify) - --- newtype YosysModule = YosysModule (Map String ServerName) +import SAWScript.Yosys (loadYosysIR, yosysIRToTypedTerms, yosys_verify, yosys_import_sequential, yosys_extract_sequential) data YosysImportParams = YosysImportParams { yosysImportPath :: FilePath @@ -132,3 +134,77 @@ yosysVerify params = do yosysVerifyDescr :: Doc.Block yosysVerifyDescr = Doc.Paragraph [Doc.Text "Verify that the named HDL module meets its specification"] + +data YosysImportSequentialParams = YosysImportSequentialParams + { yosysImportSequentialModuleName :: Text + , yosysImportSequentialPath :: FilePath + , yosysImportSequentialServerName :: ServerName + } + +instance FromJSON YosysImportSequentialParams where + parseJSON = withObject "SAW/Yosys/import sequential params" $ \o -> do + yosysImportSequentialServerName <- o .: "name" + yosysImportSequentialPath <- o .: "path" + yosysImportSequentialModuleName <- o .: "module" + pure YosysImportSequentialParams{..} + +instance Doc.DescribedMethod YosysImportSequentialParams OK where + parameterFieldDescription = + [ ("name", Doc.Paragraph [Doc.Text "The name to refer to the record of Yosys modules by later."]) + , ("path", Doc.Paragraph [Doc.Text "The path to the Yosys JSON file to import."]) + , ("module", Doc.Paragraph [Doc.Text "The sequential module within the Yosys JSON file to analyze."]) + ] + resultFieldDescription = [] + +yosysImportSequential :: YosysImportSequentialParams -> Argo.Command SAWState OK +yosysImportSequential params = do + tasks <- view sawTask <$> Argo.getState + case tasks of + (_:_) -> Argo.raise $ notAtTopLevel $ fst <$> tasks + [] -> do + s <- tl $ do + yosys_import_sequential (yosysImportSequentialModuleName params) (yosysImportSequentialPath params) + setServerVal (yosysImportSequentialServerName params) s + ok + +yosysImportSequentialDescr :: Doc.Block +yosysImportSequentialDescr = + Doc.Paragraph [Doc.Text "Import a sequential circuit from a file produced by the Yosys \"write_json\" command"] + +data YosysExtractSequentialParams = YosysExtractSequentialParams + { yosysExtractSequentialModule :: ServerName + , yosysExtractSequentialCycles :: Integer + , yosysExtractSequentialServerName :: ServerName + } + +instance FromJSON YosysExtractSequentialParams where + parseJSON = withObject "SAW/Yosys/extract sequential params" $ \o -> do + yosysExtractSequentialServerName <- o .: "name" + yosysExtractSequentialModule <- o .: "module" + yosysExtractSequentialCycles <- o .: "cycles" + pure YosysExtractSequentialParams{..} + +instance Doc.DescribedMethod YosysExtractSequentialParams OK where + parameterFieldDescription = + [ ("name", Doc.Paragraph [Doc.Text "The name to refer extracted term by later."]) + , ("cycles", Doc.Paragraph [Doc.Text "The number of cycles over which to iterate the term."]) + , ("module", Doc.Paragraph [Doc.Text "The name of the sequential module to analyze."]) + ] + resultFieldDescription = [] + +yosysExtractSequential :: YosysExtractSequentialParams -> Argo.Command SAWState OK +yosysExtractSequential params = do + tasks <- view sawTask <$> Argo.getState + case tasks of + (_:_) -> Argo.raise $ notAtTopLevel $ fst <$> tasks + [] -> do + m <- getYosysSequential $ yosysExtractSequentialModule params + s <- tl $ yosys_extract_sequential m (yosysExtractSequentialCycles params) + let sn@(ServerName n) = yosysExtractSequentialServerName params + sawTopLevelRW %= \rw -> rw { rwCryptol = CEnv.bindTypedTerm (mkIdent n, s) $ rwCryptol rw } + setServerVal sn s + ok + +yosysExtractSequentialDescr :: Doc.Block +yosysExtractSequentialDescr = + Doc.Paragraph [Doc.Text "Extract a term from a sequential circuit"] diff --git a/src/SAWScript/Builtins.hs b/src/SAWScript/Builtins.hs index 36044e1bb7..b52c9a6d2e 100644 --- a/src/SAWScript/Builtins.hs +++ b/src/SAWScript/Builtins.hs @@ -986,11 +986,11 @@ provePrim script t = do proveHelper :: String -> ProofScript () -> - TypedTerm -> + Term -> (Term -> TopLevel Prop) -> TopLevel Theorem proveHelper nm script t f = do - prop <- f $ ttTerm t + prop <- f t pos <- SV.getPosition let goal = ProofGoal { goalNum = 0 @@ -1008,7 +1008,7 @@ proveHelper nm script t f = do ++ SV.showsProofResult opts res "" case res of ValidProof _stats thm -> - do printOutLnTop Debug $ "Valid: " ++ show (ppTerm (SV.sawPPOpts opts) $ ttTerm t) + do printOutLnTop Debug $ "Valid: " ++ show (ppTerm (SV.sawPPOpts opts) t) SV.returnProof thm InvalidProof _stats _cex pst -> failProof pst UnfinishedProof pst -> failProof pst @@ -1019,7 +1019,7 @@ provePrintPrim :: TopLevel Theorem provePrintPrim script t = do sc <- getSharedContext - proveHelper "prove_print" script t $ io . predicateToProp sc Universal + proveHelper "prove_print" script (ttTerm t) $ io . predicateToProp sc Universal provePropPrim :: ProofScript () -> @@ -1027,7 +1027,7 @@ provePropPrim :: TopLevel Theorem provePropPrim script t = do sc <- getSharedContext - proveHelper "prove_extcore" script t $ io . termToProp sc + proveHelper "prove_extcore" script (ttTerm t) $ io . termToProp sc satPrim :: ProofScript () -> diff --git a/src/SAWScript/Interpreter.hs b/src/SAWScript/Interpreter.hs index a557afb3f5..2cde788639 100644 --- a/src/SAWScript/Interpreter.hs +++ b/src/SAWScript/Interpreter.hs @@ -3359,7 +3359,7 @@ primitives = Map.fromList Experimental [] - , prim "yosys_verify_sequential_offline_sally" "YosysSequential -> String -> Term -> TopLevel ()" + , prim "yosys_verify_sequential_offline_sally" "YosysSequential -> String -> Term -> [String] -> TopLevel ()" (pureVal yosys_verify_sequential_sally) Experimental [] diff --git a/src/SAWScript/Yosys.hs b/src/SAWScript/Yosys.hs index 31f06268e0..0645f38635 100644 --- a/src/SAWScript/Yosys.hs +++ b/src/SAWScript/Yosys.hs @@ -29,7 +29,9 @@ import Control.Monad.IO.Class (MonadIO(..)) import qualified Data.List.NonEmpty as NE import Data.Map (Map) import qualified Data.Map as Map +import qualified Data.Set as Set import Data.Text (Text) +import qualified Data.Text as Text import qualified Data.Graph as Graph import qualified Text.URI as URI @@ -185,9 +187,9 @@ yosys_extract_sequential s n = do yosys_extract_sequential_raw :: YosysSequential -> TopLevel SC.TypedTerm yosys_extract_sequential_raw s = pure $ s ^. yosysSequentialTerm -yosys_verify_sequential_sally :: YosysSequential -> FilePath -> SC.TypedTerm -> TopLevel () -yosys_verify_sequential_sally s path q = do +yosys_verify_sequential_sally :: YosysSequential -> FilePath -> SC.TypedTerm -> [String] -> TopLevel () +yosys_verify_sequential_sally s path q fixed = do sc <- getSharedContext sym <- liftIO $ Common.newSAWCoreExprBuilder sc scs <- liftIO $ Common.sawCoreState sym - queryModelChecker sym scs sc s path q + queryModelChecker sym scs sc s path q . Set.fromList $ Text.pack <$> fixed diff --git a/src/SAWScript/Yosys/TransitionSystem.hs b/src/SAWScript/Yosys/TransitionSystem.hs new file mode 100644 index 0000000000..5544abea9f --- /dev/null +++ b/src/SAWScript/Yosys/TransitionSystem.hs @@ -0,0 +1,275 @@ +{-# Language TemplateHaskell #-} +{-# Language OverloadedStrings #-} +{-# Language TupleSections #-} +{-# Language ViewPatterns #-} +{-# Language ScopedTypeVariables #-} +{-# Language TypeApplications #-} +{-# Language DataKinds #-} +{-# Language KindSignatures #-} +{-# Language GADTs #-} + +module SAWScript.Yosys.TransitionSystem where + +import Control.Lens.TH (makeLenses) + +import Control.Lens ((^.), view, at) +import Control.Monad (forM, foldM) +import Control.Monad.IO.Class (MonadIO(..)) +import Control.Exception (throw) + +import Data.Functor.Const (Const(..)) +import qualified Data.Set as Set +import qualified Data.Map as Map +import Data.Map (Map) +import Data.Text (Text) +import Data.Text.Encoding (encodeUtf8) +import qualified Data.Text as Text +import qualified Data.ByteString as BS +import qualified Data.IORef as IORef + +import Numeric.Natural (Natural) + +import Data.Parameterized.Some +import Data.Parameterized.NatRepr +import Data.Parameterized.Classes +import qualified Data.Parameterized.Context as Ctx +import qualified Data.Parameterized.TraversableFC as TraversableFC + +import qualified Verifier.SAW.SharedTerm as SC +import qualified Verifier.SAW.TypedTerm as SC + +import qualified Verifier.SAW.Simulator.Value as Sim +import qualified Verifier.SAW.Simulator.What4 as SimW4 +import qualified Verifier.SAW.Simulator.What4.ReturnTrip as SimW4 + +import qualified What4.Interface as W4 +import qualified What4.Symbol as W4 +import qualified What4.SWord as W4 +import qualified What4.Expr.Builder as W4.B +import qualified What4.TransitionSystem as W4 + +import qualified Language.Sally as Sally +import qualified Language.Sally.TransitionSystem as Sally + +import SAWScript.Yosys.Utils +import SAWScript.Yosys.State + +data SequentialField tp = SequentialField + { _sequentialFieldName :: Text + , _sequentialFieldTypeRepr :: W4.BaseTypeRepr tp + } +makeLenses ''SequentialField + +data SequentialFields ctx = SequentialFields + { _sequentialFields :: Ctx.Assignment SequentialField ctx + , _sequentialFieldsIndex :: Map Text (Some (Ctx.Index ctx)) + } +makeLenses ''SequentialFields + +sequentialReprs :: + forall m. + MonadIO m => + Map Text Natural -> + m (Some SequentialFields) +sequentialReprs fs = do + let assocs = Map.assocs fs + Some fields <- go assocs + idxs <- Ctx.traverseAndCollect (\idx _ -> pure [Some idx]) fields + let index = zipWith (\(nm, _) idx -> (nm, idx)) assocs $ reverse idxs + pure $ Some SequentialFields + { _sequentialFields = fields + , _sequentialFieldsIndex = Map.fromList index + } + where + go :: [(Text, Natural)] -> m (Some (Ctx.Assignment SequentialField)) + go [] = pure $ Some Ctx.empty + go ((nm, n):ns) = case someNat n of + Just (Some nr) | Just LeqProof <- testLeq (knownNat @1) nr -> do + let field = SequentialField + { _sequentialFieldName = nm + , _sequentialFieldTypeRepr = W4.BaseBVRepr nr + } + Some rest <- go ns + pure $ Some $ Ctx.extend rest field + _ -> throw . YosysError $ "Invalid width for state field: " <> nm + +ecBindingsOfFields :: + MonadIO m => + W4.B.ExprBuilder n st fs -> + SC.SharedContext -> + Text -> + Map Text SC.Term -> + SequentialFields ctx -> + W4.SymStruct (W4.B.ExprBuilder n st fs) ctx -> + m (Map Text (SC.ExtCns SC.Term, SimW4.SValue (W4.B.ExprBuilder n st fs))) +ecBindingsOfFields sym sc pfx fs s inp = fmap Map.fromList . forM (Map.assocs fs) $ \(baseName, ty) -> do + let nm = pfx <> baseName + ec <- liftIO $ SC.scFreshEC sc nm ty + val <- case s ^. sequentialFieldsIndex . at nm of + Just (Some idx) + | sf <- s ^. sequentialFields . ixF' idx + , W4.BaseBVRepr _nr <- sf ^. sequentialFieldTypeRepr + -> do + inpExpr <- liftIO $ W4.structField sym inp idx + pure . Sim.VWord $ W4.DBV inpExpr + _ -> throw . YosysError $ "Invalid field binding: " <> nm + pure (baseName, (ec, val)) + +queryModelChecker :: + MonadIO m => + W4.B.ExprBuilder n st fs -> + SimW4.SAWCoreState n -> + SC.SharedContext -> + YosysSequential -> + FilePath -> + SC.TypedTerm -> + Set.Set Text -> + m () +queryModelChecker sym _scs sc sequential path query fixedInputs = do + let (fixedInputWidths, variableInputWidths) = Map.partitionWithKey (\nm _ -> Set.member nm fixedInputs) $ sequential ^. yosysSequentialInputWidths + let (fixedInputFields, variableInputFields) = Map.partitionWithKey (\nm _ -> Set.member nm fixedInputs) $ sequential ^. yosysSequentialInputFields + let internalWidths = Map.singleton "cycle" 8 + internalFields <- forM internalWidths $ \w -> liftIO $ SC.scBitvector sc w + + Some inputFields <- sequentialReprs variableInputWidths + let inputReprs = TraversableFC.fmapFC (view sequentialFieldTypeRepr) $ inputFields ^. sequentialFields + let inputNames = TraversableFC.fmapFC (Const . W4.safeSymbol . Text.unpack . view sequentialFieldName) $ inputFields ^. sequentialFields + + let combinedWidths = Map.unions + [ sequential ^. yosysSequentialStateWidths + , Map.mapKeys ("stateinput_"<>) fixedInputWidths + , Map.mapKeys ("stateoutput_"<>) $ sequential ^. yosysSequentialOutputWidths + , Map.mapKeys ("internal_"<>) internalWidths + ] + Some stateFields <- sequentialReprs combinedWidths + let stateReprs = TraversableFC.fmapFC (view sequentialFieldTypeRepr) $ stateFields ^. sequentialFields + let stateNames = TraversableFC.fmapFC (Const . W4.safeSymbol . Text.unpack . view sequentialFieldName) $ stateFields ^. sequentialFields + let ts = W4.TransitionSystem + { W4.inputReprs = inputReprs + , W4.inputNames = inputNames + , W4.stateReprs = stateReprs + , W4.stateNames = stateNames + , W4.initialStatePredicate = \cur -> do + curInternalBindings <- ecBindingsOfFields sym sc "internal_" internalFields stateFields cur + cycleVal <- case Map.lookup "cycle" curInternalBindings of + Just (ec, _) -> SC.scExtCns sc ec + Nothing -> throw $ YosysError "Invalid current cycle field" + zero <- SC.scBvConst sc 8 0 + wnat <- SC.scNat sc 8 + cyclePred <- SC.scBvEq sc wnat cycleVal zero + ref <- IORef.newIORef Map.empty + let args = Map.unions $ fmap (Map.fromList . fmap (\(ec, x) -> (SC.ecVarIndex ec, x)) . Map.elems) + [ curInternalBindings + ] + sval <- SimW4.w4SolveBasic sym sc Map.empty args ref Set.empty cyclePred + case sval of + Sim.VBool b -> pure b + _ -> throw . YosysError $ "Invalid type when converting predicate to What4: " <> Text.pack (show sval) + , W4.stateTransitions = \input cur next -> do + inputBindings <- ecBindingsOfFields sym sc "" (fst <$> variableInputFields) inputFields input + curBindings <- ecBindingsOfFields sym sc "" (fst <$> (sequential ^. yosysSequentialStateFields)) stateFields cur + curFixedInputBindings <- ecBindingsOfFields sym sc "stateinput_" (fst <$> fixedInputFields) stateFields cur + curInternalBindings <- ecBindingsOfFields sym sc "internal_" internalFields stateFields cur + nextBindings <- ecBindingsOfFields sym sc "" (fst <$> (sequential ^. yosysSequentialStateFields)) stateFields next + nextFixedInputBindings <- ecBindingsOfFields sym sc "stateinput_" (fst <$> fixedInputFields) stateFields next + nextOutputBindings <- ecBindingsOfFields sym sc "stateoutput_" (fst <$> (sequential ^. yosysSequentialOutputFields)) stateFields next + nextInternalBindings <- ecBindingsOfFields sym sc "internal_" internalFields stateFields next + inps <- fmap Map.fromList . forM (Map.assocs $ sequential ^. yosysSequentialInputWidths) $ \(nm, _) -> + let bindings = if Set.member nm fixedInputs then curFixedInputBindings else inputBindings + in case Map.lookup nm bindings of + Just (ec, _) -> (nm,) <$> SC.scExtCns sc ec + Nothing -> throw . YosysError $ "Invalid input field: " <> nm + states <- forM curBindings $ \(ec, _) -> SC.scExtCns sc ec + inpst <- cryptolRecord sc states + domainRec <- cryptolRecord sc $ Map.insert "__state__" inpst inps + codomainRec <- liftIO $ SC.scApply sc (sequential ^. yosysSequentialTerm . SC.ttTermLens) domainRec + codomainFields <- insertStateField sc (sequential ^. yosysSequentialStateFields) $ sequential ^. yosysSequentialOutputFields + outst <- cryptolRecordSelect sc codomainFields codomainRec "__state__" + stPreds <- forM (Map.assocs $ sequential ^. yosysSequentialStateWidths) $ \(nm, w) -> do + val <- cryptolRecordSelect sc (sequential ^. yosysSequentialStateFields) outst nm + wnat <- SC.scNat sc w + new <- case Map.lookup nm nextBindings of + Just (ec, _) -> SC.scExtCns sc ec + Nothing -> throw . YosysError $ "Invalid state update field: " <> nm + liftIO $ SC.scBvEq sc wnat new val + outputPreds <- forM (Map.assocs $ sequential ^. yosysSequentialOutputWidths) $ \(nm, w) -> do + val <- cryptolRecordSelect sc codomainFields codomainRec nm + wnat <- SC.scNat sc w + new <- case Map.lookup nm nextOutputBindings of + Just (ec, _) -> SC.scExtCns sc ec + Nothing -> throw . YosysError $ "Invalid output update field: " <> nm + liftIO $ SC.scBvEq sc wnat new val + fixedInputPreds <- forM (Map.assocs fixedInputWidths) $ \(nm, w) -> do + wnat <- SC.scNat sc w + val <- case Map.lookup nm curFixedInputBindings of + Just (ec, _) -> SC.scExtCns sc ec + Nothing -> throw . YosysError $ "Invalid current fixed input field: " <> nm + new <- case Map.lookup nm nextFixedInputBindings of + Just (ec, _) -> SC.scExtCns sc ec + Nothing -> throw . YosysError $ "Invalid next fixed input field: " <> nm + liftIO $ SC.scBvEq sc wnat new val + cycleIncrement <- do + wnat <- SC.scNat sc 8 + val <- case Map.lookup "cycle" curInternalBindings of + Just (ec, _) -> SC.scExtCns sc ec + Nothing -> throw $ YosysError "Invalid current cycle field" + one <- SC.scBvConst sc 8 1 + incremented <- SC.scBvAdd sc wnat val one + new <- case Map.lookup "cycle" nextInternalBindings of + Just (ec, _) -> SC.scExtCns sc ec + Nothing -> throw $ YosysError "Invalid next cycle field" + liftIO $ SC.scBvEq sc wnat new incremented + identity <- SC.scBool sc True + conj <- foldM (SC.scAnd sc) identity $ stPreds <> outputPreds <> fixedInputPreds <> [cycleIncrement] + ref <- IORef.newIORef Map.empty + let args = Map.unions $ fmap (Map.fromList . fmap (\(ec, x) -> (SC.ecVarIndex ec, x)) . Map.elems) + [ inputBindings + , curBindings + , curFixedInputBindings + , curInternalBindings + , nextBindings + , nextOutputBindings + , nextFixedInputBindings + , nextInternalBindings + ] + sval <- SimW4.w4SolveBasic sym sc Map.empty args ref Set.empty conj + w4Conj <- case sval of + Sim.VBool b -> pure b + _ -> throw . YosysError $ "Invalid type when converting predicate to What4: " <> Text.pack (show sval) + pure + [ (W4.systemSymbol "default!", w4Conj) + ] + , W4.queries = \cur -> do + curFixedInputBindings <- ecBindingsOfFields sym sc "stateinput_" (fst <$> fixedInputFields) stateFields cur + curOutputBindings <- ecBindingsOfFields sym sc "stateoutput_" (fst <$> (sequential ^. yosysSequentialOutputFields)) stateFields cur + curInternalBindings <- ecBindingsOfFields sym sc "internal_" internalFields stateFields cur + fixedInps <- fmap Map.fromList . forM (Map.assocs fixedInputWidths) $ \(nm, _) -> + case Map.lookup nm curFixedInputBindings of + Nothing -> throw . YosysError $ "Invalid fixed input field: " <> nm + Just (ec, _) -> (nm,) <$> SC.scExtCns sc ec + outputs <- fmap Map.fromList . forM (Map.assocs $ sequential ^. yosysSequentialOutputWidths) $ \(nm, _) -> + case Map.lookup nm curOutputBindings of + Nothing -> throw . YosysError $ "Invalid output field: " <> nm + Just (ec, _) -> (nm,) <$> SC.scExtCns sc ec + cycleVal <- case Map.lookup "cycle" curInternalBindings of + Just (ec, _) -> SC.scExtCns sc ec + Nothing -> throw $ YosysError "Invalid current cycle field" + fixedInputRec <- cryptolRecord sc fixedInps + outputRec <- cryptolRecord sc outputs + result <- liftIO $ SC.scApplyAll sc (query ^. SC.ttTermLens) [cycleVal, fixedInputRec, outputRec] + ref <- IORef.newIORef Map.empty + let args = Map.unions $ fmap (Map.fromList . fmap (\(ec, x) -> (SC.ecVarIndex ec, x)) . Map.elems) + [ curOutputBindings + , curFixedInputBindings + , curInternalBindings + ] + sval <- SimW4.w4SolveBasic sym sc Map.empty args ref Set.empty result + w4Pred <- case sval of + Sim.VBool b -> pure b + _ -> throw . YosysError $ "Invalid type when converting predicate to What4: " <> Text.pack (show sval) + pure [w4Pred] + } + sts <- liftIO $ Sally.exportTransitionSystem sym Sally.mySallyNames ts + sexp <- liftIO $ Sally.sexpOfSally sym sts + liftIO . BS.writeFile path . encodeUtf8 . Text.pack . show $ Sally.sexpToDoc sexp + pure () From 42aa4de6dec5a77f6a9d622338e4865926d1734f Mon Sep 17 00:00:00 2001 From: Samuel Breese Date: Fri, 1 Jul 2022 10:46:11 -0400 Subject: [PATCH 25/47] Add some documentation --- src/SAWScript/Interpreter.hs | 39 ++++++++++++++++++++++++++++++------ 1 file changed, 33 insertions(+), 6 deletions(-) diff --git a/src/SAWScript/Interpreter.hs b/src/SAWScript/Interpreter.hs index 2cde788639..5dfcc2acaa 100644 --- a/src/SAWScript/Interpreter.hs +++ b/src/SAWScript/Interpreter.hs @@ -3337,32 +3337,59 @@ primitives = Map.fromList , prim "yosys_import" "String -> TopLevel Term" (pureVal yosys_import) Experimental - [] + [ "Produces a `Term` given the path to a JSON file produced by the Yosys `write_json` command." + , "The resulting term is a Cryptol record, where each field corresponds to one HDL module exported by Yosys." + , "Each HDL module is in turn represented by a function from a record of input port values to a record of output port values." + ] , prim "yosys_verify" "Term -> [Term] -> Term -> [YosysTheorem] -> ProofScript () -> TopLevel YosysTheorem" (pureVal yosys_verify) Experimental - [] + [ "Proves equality between a combinational HDL module and a specification." + , "The first parameter is the HDL module - given a record m from yosys_import, this will typically look something like `{{ m.foo }}`." + , "The second parameter is a list of preconditions for the equality." + , "The third parameter is the specification, a term of the same type as the HDL module, which will typically be some Cryptol function or another HDL module." + , "The fourth parameter is a list of overrides, which witness the results of previous yosys_verify proofs." + , "These overrides can be used to simplify terms by replacing use sites of submodules with their specifications." + , "Note that terms derived from HDL modules are first class, and are not restricted to yosys_verify: they may also be used with SAW's typical Term infrastructure like sat, prove_print, term rewriting, etc." + , "yosys_verify simply provides a convenient and familiar interface, similar to llvm_verify or jvm_verify." + ] , prim "yosys_import_sequential" "String -> String -> TopLevel YosysSequential" (pureVal yosys_import_sequential) Experimental - [] + [ "Imports a particular sequential HDL module." + , "The first parameter is the module name, the second is the path to the Yosys JSON file." + , "The resulting value is an opaque representation of the sequential circuit that can be extracted to a Term or sent to solvers in various ways." + , "SAW expects the sequential module to exist entirely within a single Yosys module - the Yosys \"flatten\" command will collapse the module hierarchy into a single module." + , "The only supported sequential element is the basic $dff cell." + , "Memory cells and more complex flip-flops can be translated into $dff using the \"memory\" and \"dffunmap\" Yosys commands." + ] , prim "yosys_extract_sequential" "YosysSequential -> Int -> TopLevel Term" (pureVal yosys_extract_sequential) Experimental - [] + [ "Extracts a term from the given sequential module with the state eliminated by iterating the term over the given concrete number of cycles." + , "The resulting term has no state field in the inputs or outputs, and each input and output field is replaced with an array of that field's type (array length being the number of cycles)." + , "This term can be used like a normal SAW term - it may be embedded in Cryptol expressions, used in prove and sat, etc." + ] , prim "yosys_extract_sequential_raw" "YosysSequential -> TopLevel Term" (pureVal yosys_extract_sequential_raw) Experimental - [] + [ "Extracts a term from the given sequential module." + , "This term has explicit fields for the state of the circuit in the input and output record types." + ] , prim "yosys_verify_sequential_offline_sally" "YosysSequential -> String -> Term -> [String] -> TopLevel ()" (pureVal yosys_verify_sequential_sally) Experimental - [] + [ "Export a query over the given sequential module to an input file for the Sally model checker." + , "The first parameter is the sequential module." + , "The second parameter is the path to write the resulting Sally input." + , "The third parameter is the query, which should be a boolean function of three parameters: an 8-bit cycle counter, a record of \"fixed\" inputs, and a record of circuit outputs." + , "The fourth parameter is a list of strings specifying certain circuit inputs as fixed - these inputs are assumed to remain unchanged across cycles, and are therefore accesible from the query function." + ] --------------------------------------------------------------------- From f96f9b8971f70561a37216fccad0825c85daed2a Mon Sep 17 00:00:00 2001 From: Sam Breese Date: Thu, 7 Jul 2022 17:52:43 -0400 Subject: [PATCH 26/47] Update what4 commit --- deps/what4 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/deps/what4 b/deps/what4 index 4722827c8d..4af08d1762 160000 --- a/deps/what4 +++ b/deps/what4 @@ -1 +1 @@ -Subproject commit 4722827c8def6a59623c87c8fadf6658930088a9 +Subproject commit 4af08d1762a60ff4d36adf6a98481fe5910a72d6 From b103d830eb63f1ad73c655bddf2eebc569486114 Mon Sep 17 00:00:00 2001 From: Samuel Breese Date: Sun, 24 Jul 2022 22:27:48 -0400 Subject: [PATCH 27/47] Fix warnings --- src/SAWScript/Yosys/Netgraph.hs | 2 +- src/SAWScript/Yosys/State.hs | 1 - 2 files changed, 1 insertion(+), 2 deletions(-) diff --git a/src/SAWScript/Yosys/Netgraph.hs b/src/SAWScript/Yosys/Netgraph.hs index 1676ff38d9..365e4c89b8 100644 --- a/src/SAWScript/Yosys/Netgraph.hs +++ b/src/SAWScript/Yosys/Netgraph.hs @@ -201,7 +201,7 @@ netgraphToTerms sc env ng inputs let sorted = Graph.reverseTopSort $ ng ^. netgraphGraph foldM ( \acc v -> do - let ((cnm, c), _output, deps) = ng ^. netgraphNodeFromVertex $ v + let ((_cnm, c), _output, _deps) = ng ^. netgraphNodeFromVertex $ v let outputFields = Map.filter (\d -> d == DirectionOutput || d == DirectionInout) $ c ^. cellPortDirections if -- special handling for $dff nodes - we read their /output/ from the inputs map, and later detect and write their /input/ to the state diff --git a/src/SAWScript/Yosys/State.hs b/src/SAWScript/Yosys/State.hs index 176bb869c7..e36748c360 100644 --- a/src/SAWScript/Yosys/State.hs +++ b/src/SAWScript/Yosys/State.hs @@ -19,7 +19,6 @@ import Data.Bifunctor (bimap) import Data.Map (Map) import qualified Data.Map as Map import Data.Text (Text) -import qualified Data.Text as Text import qualified Data.Graph as Graph import Numeric.Natural (Natural) From 883950d93136938f36d45765ab3c75a480da61ac Mon Sep 17 00:00:00 2001 From: Samuel Breese Date: Sun, 18 Sep 2022 16:36:47 -0400 Subject: [PATCH 28/47] Better exception handling, add nonces to Yosys-derived names --- src/SAWScript/Yosys.hs | 6 ++- src/SAWScript/Yosys/Cell.hs | 13 ++++++- src/SAWScript/Yosys/Netgraph.hs | 28 +++++++++----- src/SAWScript/Yosys/State.hs | 15 ++++++-- src/SAWScript/Yosys/Utils.hs | 65 ++++++++++++++++++++++++++++++++- 5 files changed, 109 insertions(+), 18 deletions(-) diff --git a/src/SAWScript/Yosys.hs b/src/SAWScript/Yosys.hs index 0645f38635..981c0a7238 100644 --- a/src/SAWScript/Yosys.hs +++ b/src/SAWScript/Yosys.hs @@ -36,6 +36,8 @@ import qualified Data.Graph as Graph import qualified Text.URI as URI +import qualified Data.Parameterized.Nonce as Nonce + import qualified Verifier.SAW.SharedTerm as SC import qualified Verifier.SAW.TypedTerm as SC @@ -90,12 +92,14 @@ convertYosysIR sc ir = do let (m, nm, _) = mg ^. modgraphNodeFromVertex $ v -- liftIO . putStrLn . Text.unpack $ mconcat ["Converting module: ", nm] cm <- convertModule sc env m + n <- liftIO $ Nonce.freshNonce Nonce.globalNonceGenerator + let frag = Text.pack . show $ Nonce.indexValue n let uri = URI.URI { URI.uriScheme = URI.mkScheme "yosys" , URI.uriAuthority = Left True , URI.uriPath = (False,) <$> mapM URI.mkPathPiece (nm NE.:| []) , URI.uriQuery = [] - , URI.uriFragment = Nothing + , URI.uriFragment = URI.mkFragment frag } let ni = SC.ImportedName uri [nm] tc <- liftIO $ SC.scConstant' sc ni (cm ^. convertedModuleTerm) (cm ^. convertedModuleType) diff --git a/src/SAWScript/Yosys/Cell.hs b/src/SAWScript/Yosys/Cell.hs index 56a9b59117..32a320c025 100644 --- a/src/SAWScript/Yosys/Cell.hs +++ b/src/SAWScript/Yosys/Cell.hs @@ -12,6 +12,7 @@ module SAWScript.Yosys.Cell where import Control.Lens ((^.)) import Control.Monad (foldM) import Control.Monad.IO.Class (MonadIO(..)) +import Control.Exception (throw) import qualified Data.Foldable as Foldable import Data.Map (Map) @@ -160,7 +161,17 @@ primCellToTerm sc c args = case c ^. cellType of fmap Just . cryptolRecord sc $ Map.fromList [ ("Y", res) ] - -- "$pmux" -> _ + "$pmux" -> throw YosysErrorUnsupportedPmux + "$adff" -> throw $ YosysErrorUnsupportedFF "$adff" + "$sdff" -> throw $ YosysErrorUnsupportedFF "$sdff" + "$aldff" -> throw $ YosysErrorUnsupportedFF "$aldff" + "$dffsr" -> throw $ YosysErrorUnsupportedFF "$dffsr" + "$dffe" -> throw $ YosysErrorUnsupportedFF "$dffe" + "$adffe" -> throw $ YosysErrorUnsupportedFF "$adffe" + "$sdffe" -> throw $ YosysErrorUnsupportedFF "$sdffe" + "$sdffce" -> throw $ YosysErrorUnsupportedFF "$sdffce" + "$aldffe" -> throw $ YosysErrorUnsupportedFF "$aldffe" + "$dffsre" -> throw $ YosysErrorUnsupportedFF "$dffsre" -- "$bmux" -> _ -- "$demux" -> _ -- "$lut" -> _ diff --git a/src/SAWScript/Yosys/Netgraph.hs b/src/SAWScript/Yosys/Netgraph.hs index 365e4c89b8..23093bfd64 100644 --- a/src/SAWScript/Yosys/Netgraph.hs +++ b/src/SAWScript/Yosys/Netgraph.hs @@ -26,6 +26,7 @@ import qualified Data.Text as Text import qualified Data.Graph as Graph import qualified Verifier.SAW.SharedTerm as SC +import qualified Verifier.SAW.Name as SC import qualified Cryptol.TypeCheck.Type as C import qualified Cryptol.Utils.Ident as C @@ -165,10 +166,11 @@ deriveTermsByIndices sc rep t = do lookupPatternTerm :: (MonadIO m, Ord b, Show b) => SC.SharedContext -> + YosysBitvecConsumer -> [b] -> Map [b] SC.Term -> m SC.Term -lookupPatternTerm sc pat ts = +lookupPatternTerm sc loc pat ts = case Map.lookup pat ts of Just t -> pure t Nothing -> do @@ -179,8 +181,7 @@ lookupPatternTerm sc pat ts = bits <- forM pat $ \b -> do case Map.lookup [b] ts of Just t -> pure t - Nothing -> do - throw . YosysError $ "Failed to find output bitvec: " <> Text.pack (show b) + Nothing -> throw $ YosysErrorNoSuchOutputBitvec (Text.pack $ show b) loc vecBits <- liftIO $ SC.scVector sc vecty bits liftIO $ SC.scJoin sc many one boolty vecBits @@ -201,20 +202,20 @@ netgraphToTerms sc env ng inputs let sorted = Graph.reverseTopSort $ ng ^. netgraphGraph foldM ( \acc v -> do - let ((_cnm, c), _output, _deps) = ng ^. netgraphNodeFromVertex $ v + let ((cnm, c), _output, _deps) = ng ^. netgraphNodeFromVertex $ v let outputFields = Map.filter (\d -> d == DirectionOutput || d == DirectionInout) $ c ^. cellPortDirections if -- special handling for $dff nodes - we read their /output/ from the inputs map, and later detect and write their /input/ to the state | c ^. cellType == "$dff" , Just dffout <- Map.lookup "Q" $ c ^. cellConnections -> do - r <- lookupPatternTerm sc dffout acc + r <- lookupPatternTerm sc (YosysBitvecConsumerCell cnm "Q") dffout acc ts <- deriveTermsByIndices sc dffout r pure $ Map.union ts acc | otherwise -> do - args <- forM (cellInputConnections c) $ \i -> do -- for each input bit pattern + args <- fmap Map.fromList . forM (Map.assocs $ cellInputConnections c) $ \(inm, i) -> do -- for each input bit pattern -- if we can find that pattern exactly, great! use that term -- otherwise, find each individual bit and append the terms - lookupPatternTerm sc i acc + (inm,) <$> lookupPatternTerm sc (YosysBitvecConsumerCell cnm inm) i acc r <- primCellToTerm sc c args >>= \case Just r -> pure r @@ -222,7 +223,7 @@ netgraphToTerms sc env ng inputs Just cm -> do r <- cryptolRecord sc args liftIO $ SC.scApply sc (cm ^. convertedModuleTerm) r - Nothing -> throw . YosysError $ "No definition for module: " <> (c ^. cellType) + Nothing -> throw $ YosysErrorNoSuchCellType (c ^. cellType) cnm -- once we've built a term, insert it along with each of its bits ts <- forM (Map.assocs $ cellOutputConnections c) $ \(out, o) -> do @@ -264,18 +265,25 @@ convertModule sc env m = do zeroTerm <- liftIO $ SC.scBvConst sc 1 0 oneTerm <- liftIO $ SC.scBvConst sc 1 1 + oneBitType <- liftIO $ SC.scBitvector sc 1 + xMsg <- liftIO $ SC.scString sc "Attempted to read X bit" + xTerm <- liftIO $ SC.scGlobalApply sc (SC.mkIdent SC.preludeName "error") [oneBitType, xMsg] + zMsg <- liftIO $ SC.scString sc "Attempted to read Z bit" + zTerm <- liftIO $ SC.scGlobalApply sc (SC.mkIdent SC.preludeName "error") [oneBitType, zMsg] let inputs = Map.unions $ mconcat [ [ Map.fromList [ ( [BitrepZero], zeroTerm) , ( [BitrepOne], oneTerm ) + , ( [BitrepX], xTerm ) + , ( [BitrepZ], zTerm ) ] ] , derivedInputs ] terms <- netgraphToTerms sc env ng inputs - outputRecord <- cryptolRecord sc =<< forM outputPorts - (\out -> lookupPatternTerm sc out terms) + outputRecord <- cryptolRecord sc =<< mapForWithKeyM outputPorts + (\onm out -> lookupPatternTerm sc (YosysBitvecConsumerOutputPort onm) out terms) t <- liftIO $ SC.scAbstractExts sc [inputRecordEC] outputRecord ty <- liftIO $ SC.scFun sc inputRecordType outputRecordType diff --git a/src/SAWScript/Yosys/State.hs b/src/SAWScript/Yosys/State.hs index e36748c360..5c11f419ae 100644 --- a/src/SAWScript/Yosys/State.hs +++ b/src/SAWScript/Yosys/State.hs @@ -140,10 +140,17 @@ convertModuleInline sc m = do zeroTerm <- liftIO $ SC.scBvConst sc 1 0 oneTerm <- liftIO $ SC.scBvConst sc 1 1 + oneBitType <- liftIO $ SC.scBitvector sc 1 + xMsg <- liftIO $ SC.scString sc "Attempted to read X bit" + xTerm <- liftIO $ SC.scGlobalApply sc (SC.mkIdent SC.preludeName "error") [oneBitType, xMsg] + zMsg <- liftIO $ SC.scString sc "Attempted to read Z bit" + zTerm <- liftIO $ SC.scGlobalApply sc (SC.mkIdent SC.preludeName "error") [oneBitType, zMsg] let inputs = Map.unions $ mconcat [ [ Map.fromList [ ( [BitrepZero], zeroTerm) , ( [BitrepOne], oneTerm ) + , ( [BitrepX], xTerm ) + , ( [BitrepZ], zTerm ) ] ] , derivedInputs @@ -152,16 +159,16 @@ convertModuleInline sc m = do terms <- netgraphToTerms sc Map.empty ng inputs - postStateFields <- forM dffs $ \c -> + postStateFields <- mapForWithKeyM dffs $ \cnm c -> case Map.lookup "D" $ c ^. cellConnections of Nothing -> panic "convertModuleInline" ["Missing expected input name for $dff cell"] Just b -> do - t <- lookupPatternTerm sc b terms + t <- lookupPatternTerm sc (YosysBitvecConsumerCell cnm "D") b terms pure t postStateRecord <- cryptolRecord sc postStateFields - outputRecord <- cryptolRecord sc . Map.insert "__state__" postStateRecord =<< forM outputPorts - (\out -> lookupPatternTerm sc out terms) + outputRecord <- cryptolRecord sc . Map.insert "__state__" postStateRecord =<< mapForWithKeyM outputPorts + (\onm out -> lookupPatternTerm sc (YosysBitvecConsumerOutputPort onm) out terms) -- construct result t <- liftIO $ SC.scAbstractExts sc [domainRecordEC] outputRecord diff --git a/src/SAWScript/Yosys/Utils.hs b/src/SAWScript/Yosys/Utils.hs index 4bea594ed7..c92cabe9f5 100644 --- a/src/SAWScript/Yosys/Utils.hs +++ b/src/SAWScript/Yosys/Utils.hs @@ -24,10 +24,71 @@ import qualified Cryptol.TypeCheck.Type as C import qualified Cryptol.Utils.Ident as C import qualified Cryptol.Utils.RecordMap as C -newtype YosysError = YosysError Text +reportBugText :: Text +reportBugText = "You should report this issue at: https://github.com/GaloisInc/saw-script/issues" + +consultYosysManual :: Text +consultYosysManual = "More information is available in the Yosys manual, at: https://yosyshq.net/yosys/documentation.html" + +data YosysBitvecConsumer + = YosysBitvecConsumerOutputPort Text + | YosysBitvecConsumerCell Text Text + +data YosysError + = YosysError Text + | YosysErrorNoSuchOutputBitvec Text YosysBitvecConsumer + | YosysErrorNoSuchCellType Text Text + | YosysErrorUnsupportedPmux + | YosysErrorUnsupportedFF Text instance Exception YosysError instance Show YosysError where - show (YosysError msg) = Text.unpack $ "Error: " <> msg + show (YosysError msg) = Text.unpack $ "Error: " <> msg <> "\n" <> reportBugText + show (YosysErrorNoSuchOutputBitvec bvec (YosysBitvecConsumerOutputPort onm)) = Text.unpack $ mconcat + [ "Error: Could not find the output bitvector ", bvec + , ", which is connected to a module output port \"", onm + , "\".\n" + , "This may represent a bug in SAW.\n" + , reportBugText + ] + show (YosysErrorNoSuchOutputBitvec bvec (YosysBitvecConsumerCell cnm inm)) = Text.unpack $ mconcat + [ "Error: Could not find the output bitvector ", bvec + , ", which is connected to the input \"", inm + , "\" of the cell with name \"", cnm + , "\".\n" + , "It is possible that this represents an undetected cycle in the netgraph.\n" + , reportBugText + ] + show (YosysErrorNoSuchCellType mnm cnm) + | Just ('$', _) <- Text.uncons mnm + = Text.unpack $ mconcat + [ "Error: The cell type \"", mnm + , "\", which is the type of the cell with name \"", cnm + , "\", is not a supported primitive cell type.\n" + , reportBugText + ] + | otherwise = Text.unpack $ mconcat + [ "Error: The cell type \"", mnm + , "\", which is the type of the cell with name \"", cnm + , "\", refers to a submodule of the circuit.\n" + , "Using such submodules during translation of sequential circuits is not currently supported by SAW.\n" + , "It may be helpful to use the \"flatten\" tactic within Yosys.\n" + , consultYosysManual + ] + show YosysErrorUnsupportedPmux = Text.unpack $ mconcat + [ "Error: The circuit contains cells with type \"$pmux\".\n" + , "These cells are not currently supported by SAW.\n" + , "It may be helpful to replace $pmux cells using the \"pmuxtree\" tactic within Yosys.\n" + , consultYosysManual + ] + show (YosysErrorUnsupportedFF mnm) = Text.unpack $ mconcat + [ "Error: The circuit contains cells with type \"", mnm, "\".\n" + , "These cells are not currently supported by SAW.\n" + , "It may be helpful to replace certain stateful cells using the \"memory\", \"dffunmap\", and \"async2sync\" tactics within Yosys.\n" + , consultYosysManual + ] + +mapForWithKeyM :: Monad m => Map k a -> (k -> a -> m b) -> m (Map k b) +mapForWithKeyM m f = sequence $ Map.mapWithKey f m cryptolRecordType :: MonadIO m => From 83f9eb74f48f154a6a499738b9b96740bc39d226 Mon Sep 17 00:00:00 2001 From: Samuel Breese Date: Sun, 18 Sep 2022 16:48:16 -0400 Subject: [PATCH 29/47] Add CPP to handle containers on GHC 8.8 --- src/SAWScript/Yosys.hs | 2 +- src/SAWScript/Yosys/Utils.hs | 10 ++++++++++ 2 files changed, 11 insertions(+), 1 deletion(-) diff --git a/src/SAWScript/Yosys.hs b/src/SAWScript/Yosys.hs index 981c0a7238..85508fd377 100644 --- a/src/SAWScript/Yosys.hs +++ b/src/SAWScript/Yosys.hs @@ -86,7 +86,7 @@ convertYosysIR :: m (Map Text ConvertedModule) convertYosysIR sc ir = do let mg = yosysIRModgraph ir - let sorted = Graph.reverseTopSort $ mg ^. modgraphGraph + let sorted = reverseTopSort $ mg ^. modgraphGraph foldM (\env v -> do let (m, nm, _) = mg ^. modgraphNodeFromVertex $ v diff --git a/src/SAWScript/Yosys/Utils.hs b/src/SAWScript/Yosys/Utils.hs index c92cabe9f5..d261649309 100644 --- a/src/SAWScript/Yosys/Utils.hs +++ b/src/SAWScript/Yosys/Utils.hs @@ -1,3 +1,4 @@ +{-# Language CPP #-} {-# Language TemplateHaskell #-} {-# Language OverloadedStrings #-} {-# Language LambdaCase #-} @@ -16,6 +17,7 @@ import Data.Text (Text) import qualified Data.Text as Text import Data.Map (Map) import qualified Data.Map as Map +import qualified Data.Graph as Graph import qualified Verifier.SAW.SharedTerm as SC import qualified Verifier.SAW.TypedTerm as SC @@ -90,6 +92,14 @@ instance Show YosysError where mapForWithKeyM :: Monad m => Map k a -> (k -> a -> m b) -> m (Map k b) mapForWithKeyM m f = sequence $ Map.mapWithKey f m +reverseTopSort :: Graph.Graph -> [Graph.Vertex] +reverseTopSort = +#if MIN_VERSION_containers(6,4,1) + Graph.reverseTopSort +#else + reverse . Graph.topSort +#endif + cryptolRecordType :: MonadIO m => SC.SharedContext -> From d829e1f37cffc2717db143b62dcf347f02d92617 Mon Sep 17 00:00:00 2001 From: Samuel Breese Date: Sun, 18 Sep 2022 17:17:19 -0400 Subject: [PATCH 30/47] Replace another reverseTopSort --- src/SAWScript/Yosys/Netgraph.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/SAWScript/Yosys/Netgraph.hs b/src/SAWScript/Yosys/Netgraph.hs index 23093bfd64..f3a1fc15fe 100644 --- a/src/SAWScript/Yosys/Netgraph.hs +++ b/src/SAWScript/Yosys/Netgraph.hs @@ -199,7 +199,7 @@ netgraphToTerms sc env ng inputs = do throw $ YosysError "Network graph contains a cycle after splitting on DFFs; SAW does not currently support analysis of this circuit" | otherwise = do - let sorted = Graph.reverseTopSort $ ng ^. netgraphGraph + let sorted = reverseTopSort $ ng ^. netgraphGraph foldM ( \acc v -> do let ((cnm, c), _output, _deps) = ng ^. netgraphNodeFromVertex $ v From 8389a79e2a43f640a4e83d2ad92db72461af8e05 Mon Sep 17 00:00:00 2001 From: Samuel Breese Date: Sun, 18 Sep 2022 18:55:22 -0400 Subject: [PATCH 31/47] Refactor to support recent changes to TopLevel --- saw-remote-api/src/SAWServer.hs | 4 +--- saw-remote-api/src/SAWServer/Yosys.hs | 3 ++- src/SAWScript/Value.hs | 11 ++++++++++- src/SAWScript/Yosys/Theorem.hs | 4 ++++ 4 files changed, 17 insertions(+), 5 deletions(-) diff --git a/saw-remote-api/src/SAWServer.hs b/saw-remote-api/src/SAWServer.hs index 62705a704d..0f87671c20 100644 --- a/saw-remote-api/src/SAWServer.hs +++ b/saw-remote-api/src/SAWServer.hs @@ -56,7 +56,7 @@ import SAWScript.Prover.Rewrite (basic_ss) import SAWScript.Proof (newTheoremDB) import SAWScript.Value (AIGProxy(..), BuiltinContext(..), JVMSetupM, LLVMCrucibleSetupM, TopLevelRO(..), TopLevelRW(..), defaultPPOpts, SAWSimpset) import SAWScript.Yosys.State (YosysSequential) -import SAWScript.Yosys.Theorem (YosysTheorem) +import SAWScript.Yosys.Theorem (YosysImport, YosysTheorem) import qualified Verifier.SAW.Cryptol.Prelude as CryptolSAW import Verifier.SAW.CryptolEnv (initCryptolEnv, bindTypedTerm) import qualified Cryptol.Utils.Ident as Cryptol @@ -308,8 +308,6 @@ data CrucibleSetupTypeRepr :: Type -> Type where UnitRepr :: CrucibleSetupTypeRepr () TypedTermRepr :: CrucibleSetupTypeRepr TypedTerm -newtype YosysImport = YosysImport { yosysImport :: Map Text TypedTerm } - data ServerVal = VTerm TypedTerm | VSimpset SAWSimpset diff --git a/saw-remote-api/src/SAWServer/Yosys.hs b/saw-remote-api/src/SAWServer/Yosys.hs index 6b505c52a6..f227c8fbf1 100644 --- a/saw-remote-api/src/SAWServer/Yosys.hs +++ b/saw-remote-api/src/SAWServer/Yosys.hs @@ -23,7 +23,7 @@ import qualified Argo.Doc as Doc import CryptolServer.Data.Expression (Expression(..), getCryptolExpr) -import SAWServer (SAWState, ServerName (ServerName), YosysImport(..), sawTask, setServerVal, getYosysImport, getYosysTheorem, getYosysSequential, sawTopLevelRW) +import SAWServer (SAWState, ServerName (ServerName), sawTask, setServerVal, getYosysImport, getYosysTheorem, getYosysSequential, sawTopLevelRW) import SAWServer.CryptolExpression (CryptolModuleException(..), getTypedTermOfCExp) import SAWServer.Exceptions (notAtTopLevel) import SAWServer.OK (OK, ok) @@ -32,6 +32,7 @@ import SAWServer.TopLevel (tl) import SAWScript.Value (getSharedContext, getTopLevelRW, rwCryptol) import SAWScript.Yosys (loadYosysIR, yosysIRToTypedTerms, yosys_verify, yosys_import_sequential, yosys_extract_sequential) +import SAWScript.Yosys.Theorem (YosysImport(..)) data YosysImportParams = YosysImportParams { yosysImportPath :: FilePath diff --git a/src/SAWScript/Value.hs b/src/SAWScript/Value.hs index 980494c932..70a176c0b6 100644 --- a/src/SAWScript/Value.hs +++ b/src/SAWScript/Value.hs @@ -81,7 +81,7 @@ import SAWScript.Prover.MRSolver.Term as MRSolver import SAWScript.Crucible.LLVM.Skeleton import SAWScript.X86 (X86Unsupported(..), X86Error(..)) import SAWScript.Yosys.IR -import SAWScript.Yosys.Theorem (YosysTheorem) +import SAWScript.Yosys.Theorem (YosysImport, YosysTheorem) import SAWScript.Yosys.State (YosysSequential) import Verifier.SAW.Name (toShortName, SAWNamingEnv, emptySAWNamingEnv) @@ -166,6 +166,7 @@ data Value | VCFG SAW_CFG | VGhostVar CMS.GhostGlobal | VYosysModule YosysIR + | VYosysImport YosysImport | VYosysSequential YosysSequential | VYosysTheorem YosysTheorem @@ -346,6 +347,7 @@ showsPrecValue opts nenv p v = VGhostVar x -> showParen (p > 10) $ showString "Ghost " . showsPrec 11 x VYosysModule _ -> showString "<>" + VYosysImport _ -> showString "<>" VYosysSequential _ -> showString "<>" VYosysTheorem _ -> showString "<>" VJVMSetup _ -> showString "<>" @@ -1218,6 +1220,13 @@ instance FromValue YosysIR where fromValue (VYosysModule ir) = ir fromValue v = error ("fromValue YosysIR: " ++ show v) +instance IsValue YosysImport where + toValue = VYosysImport + +instance FromValue YosysImport where + fromValue (VYosysImport i) = i + fromValue v = error ("fromValue YosysImport: " ++ show v) + instance IsValue YosysSequential where toValue = VYosysSequential diff --git a/src/SAWScript/Yosys/Theorem.hs b/src/SAWScript/Yosys/Theorem.hs index 03b8fe2c8e..337bfe6e53 100644 --- a/src/SAWScript/Yosys/Theorem.hs +++ b/src/SAWScript/Yosys/Theorem.hs @@ -15,7 +15,9 @@ import Control.Exception (throw) import Control.Monad.Catch (MonadThrow) import qualified Data.Text as Text +import Data.Text (Text) import qualified Data.Set as Set +import Data.Map (Map) import qualified Text.URI as URI @@ -30,6 +32,8 @@ import qualified Cryptol.TypeCheck.Type as C import SAWScript.Yosys.Utils +newtype YosysImport = YosysImport { yosysImport :: Map Text SC.TypedTerm } + data YosysTheorem = YosysTheorem { _theoremURI :: URI.URI -- URI identifying overridden module , _theoremInputCryptolType :: C.Type -- cryptol type of r From d7011560eb3ee5049479ddf87b21bbc320e8b1c5 Mon Sep 17 00:00:00 2001 From: Samuel Breese Date: Sun, 18 Sep 2022 20:02:41 -0400 Subject: [PATCH 32/47] Update saw-remote-api docs --- saw-remote-api/docs/SAW.rst | 139 ++++++++++++++++++++++++++++++++++++ 1 file changed, 139 insertions(+) diff --git a/saw-remote-api/docs/SAW.rst b/saw-remote-api/docs/SAW.rst index 8570eb6340..ade1382ffb 100644 --- a/saw-remote-api/docs/SAW.rst +++ b/saw-remote-api/docs/SAW.rst @@ -419,6 +419,145 @@ No return fields +SAW/Yosys/import (command) +~~~~~~~~~~~~~~~~~~~~~~~~~~ + +Import a file produced by the Yosys "write_json" command + +Parameter fields +++++++++++++++++ + + +``name`` + The name to refer to the record of Yosys modules by later. + + + +``path`` + The path to the Yosys JSON file to import. + + + +Return fields ++++++++++++++ + +No return fields + + + +SAW/Yosys/verify (command) +~~~~~~~~~~~~~~~~~~~~~~~~~~ + +Verify that the named HDL module meets its specification + +Parameter fields +++++++++++++++++ + + +``import`` + The imported Yosys file. + + + +``module`` + The HDL module to verify. + + + +``preconds`` + Any preconditions for the verificatiion. + + + +``spec`` + The specification to verify for the module. + + + +``lemmas`` + The lemmas to use for other modules during this verification. + + + +``script`` + The script to use to prove the validity of the resulting verification conditions. + + + +``lemma name`` + The name to refer to the result by later. + + + +Return fields ++++++++++++++ + +No return fields + + + +SAW/Yosys/import sequential (command) +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +Import a sequential circuit from a file produced by the Yosys "write_json" command + +Parameter fields +++++++++++++++++ + + +``name`` + The name to refer to the record of Yosys modules by later. + + + +``path`` + The path to the Yosys JSON file to import. + + + +``module`` + The sequential module within the Yosys JSON file to analyze. + + + +Return fields ++++++++++++++ + +No return fields + + + +SAW/Yosys/extract sequential (command) +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +Extract a term from a sequential circuit + +Parameter fields +++++++++++++++++ + + +``name`` + The name to refer extracted term by later. + + + +``cycles`` + The number of cycles over which to iterate the term. + + + +``module`` + The name of the sequential module to analyze. + + + +Return fields ++++++++++++++ + +No return fields + + + SAW/create ghost variable (command) ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ From a434e36f700a991cdb0ae1c3b6951e789af2ee34 Mon Sep 17 00:00:00 2001 From: Samuel Breese Date: Sun, 18 Sep 2022 21:31:39 -0400 Subject: [PATCH 33/47] Add a number of integration tests --- intTests/test_yosys_adder/test.json | 442 ++++++++++++++++++ intTests/test_yosys_adder/test.saw | 3 + intTests/test_yosys_adder/test.sh | 1 + intTests/test_yosys_basic/test.json | 113 +++++ intTests/test_yosys_basic/test.saw | 2 + intTests/test_yosys_basic/test.sh | 1 + intTests/test_yosys_compositional/test.json | 442 ++++++++++++++++++ intTests/test_yosys_compositional/test.saw | 21 + intTests/test_yosys_compositional/test.sh | 1 + .../test_yosys_multiple_modules/test.json | 442 ++++++++++++++++++ intTests/test_yosys_multiple_modules/test.saw | 2 + intTests/test_yosys_multiple_modules/test.sh | 1 + intTests/test_yosys_namespace/test.json | 442 ++++++++++++++++++ intTests/test_yosys_namespace/test.saw | 4 + intTests/test_yosys_namespace/test.sh | 1 + intTests/test_yosys_sequential/test.json | 407 ++++++++++++++++ intTests/test_yosys_sequential/test.saw | 2 + intTests/test_yosys_sequential/test.sh | 1 + .../test.json | 407 ++++++++++++++++ .../test.saw | 13 + .../test.sh | 1 + .../test_yosys_sequential_sally/test.json | 407 ++++++++++++++++ intTests/test_yosys_sequential_sally/test.saw | 13 + intTests/test_yosys_sequential_sally/test.sh | 1 + 24 files changed, 3170 insertions(+) create mode 100644 intTests/test_yosys_adder/test.json create mode 100644 intTests/test_yosys_adder/test.saw create mode 100644 intTests/test_yosys_adder/test.sh create mode 100644 intTests/test_yosys_basic/test.json create mode 100644 intTests/test_yosys_basic/test.saw create mode 100644 intTests/test_yosys_basic/test.sh create mode 100644 intTests/test_yosys_compositional/test.json create mode 100644 intTests/test_yosys_compositional/test.saw create mode 100644 intTests/test_yosys_compositional/test.sh create mode 100644 intTests/test_yosys_multiple_modules/test.json create mode 100644 intTests/test_yosys_multiple_modules/test.saw create mode 100644 intTests/test_yosys_multiple_modules/test.sh create mode 100644 intTests/test_yosys_namespace/test.json create mode 100644 intTests/test_yosys_namespace/test.saw create mode 100644 intTests/test_yosys_namespace/test.sh create mode 100644 intTests/test_yosys_sequential/test.json create mode 100644 intTests/test_yosys_sequential/test.saw create mode 100644 intTests/test_yosys_sequential/test.sh create mode 100644 intTests/test_yosys_sequential_known_cycles/test.json create mode 100644 intTests/test_yosys_sequential_known_cycles/test.saw create mode 100644 intTests/test_yosys_sequential_known_cycles/test.sh create mode 100644 intTests/test_yosys_sequential_sally/test.json create mode 100644 intTests/test_yosys_sequential_sally/test.saw create mode 100644 intTests/test_yosys_sequential_sally/test.sh diff --git a/intTests/test_yosys_adder/test.json b/intTests/test_yosys_adder/test.json new file mode 100644 index 0000000000..63adfa3abe --- /dev/null +++ b/intTests/test_yosys_adder/test.json @@ -0,0 +1,442 @@ +{ + "creator": "Yosys 0.10+1 (git sha1 7a7df9a3b4, gcc 10.3.0 -fPIC -Os)", + "modules": { + "add4": { + "attributes": { + }, + "ports": { + "a": { + "direction": "input", + "bits": [ 2, 3, 4, 5 ] + }, + "b": { + "direction": "input", + "bits": [ 6, 7, 8, 9 ] + }, + "res": { + "direction": "output", + "bits": [ 10, 11, 12, 13 ] + } + }, + "cells": { + "full0": { + "hide_name": 0, + "type": "full", + "parameters": { + }, + "attributes": { + }, + "port_directions": { + "a": "input", + "b": "input", + "cin": "input", + "cout": "output", + "s": "output" + }, + "connections": { + "a": [ 5 ], + "b": [ 9 ], + "cin": [ "0" ], + "cout": [ 14 ], + "s": [ 13 ] + } + }, + "full1": { + "hide_name": 0, + "type": "full", + "parameters": { + }, + "attributes": { + }, + "port_directions": { + "a": "input", + "b": "input", + "cin": "input", + "cout": "output", + "s": "output" + }, + "connections": { + "a": [ 4 ], + "b": [ 8 ], + "cin": [ 14 ], + "cout": [ 15 ], + "s": [ 12 ] + } + }, + "full2": { + "hide_name": 0, + "type": "full", + "parameters": { + }, + "attributes": { + }, + "port_directions": { + "a": "input", + "b": "input", + "cin": "input", + "cout": "output", + "s": "output" + }, + "connections": { + "a": [ 3 ], + "b": [ 7 ], + "cin": [ 15 ], + "cout": [ 16 ], + "s": [ 11 ] + } + }, + "full3": { + "hide_name": 0, + "type": "full", + "parameters": { + }, + "attributes": { + }, + "port_directions": { + "a": "input", + "b": "input", + "cin": "input", + "cout": "output", + "s": "output" + }, + "connections": { + "a": [ 2 ], + "b": [ 6 ], + "cin": [ 16 ], + "cout": [ 17 ], + "s": [ 10 ] + } + } + }, + "netnames": { + "$auto$ghdl.cc:764:import_module$2": { + "hide_name": 1, + "bits": [ 13 ], + "attributes": { + } + }, + "$auto$ghdl.cc:764:import_module$4": { + "hide_name": 1, + "bits": [ 12 ], + "attributes": { + } + }, + "$auto$ghdl.cc:764:import_module$6": { + "hide_name": 1, + "bits": [ 11 ], + "attributes": { + } + }, + "$auto$ghdl.cc:764:import_module$7": { + "hide_name": 1, + "bits": [ 17 ], + "attributes": { + } + }, + "$auto$ghdl.cc:764:import_module$8": { + "hide_name": 1, + "bits": [ 10 ], + "attributes": { + } + }, + "a": { + "hide_name": 0, + "bits": [ 2, 3, 4, 5 ], + "attributes": { + } + }, + "b": { + "hide_name": 0, + "bits": [ 6, 7, 8, 9 ], + "attributes": { + } + }, + "full0cout": { + "hide_name": 0, + "bits": [ 14 ], + "attributes": { + } + }, + "full1cout": { + "hide_name": 0, + "bits": [ 15 ], + "attributes": { + } + }, + "full2cout": { + "hide_name": 0, + "bits": [ 16 ], + "attributes": { + } + }, + "res": { + "hide_name": 0, + "bits": [ 10, 11, 12, 13 ], + "attributes": { + } + } + } + }, + "full": { + "attributes": { + }, + "ports": { + "a": { + "direction": "input", + "bits": [ 2 ] + }, + "b": { + "direction": "input", + "bits": [ 3 ] + }, + "cin": { + "direction": "input", + "bits": [ 4 ] + }, + "cout": { + "direction": "output", + "bits": [ 5 ] + }, + "s": { + "direction": "output", + "bits": [ 6 ] + } + }, + "cells": { + "\\25": { + "hide_name": 0, + "type": "$or", + "parameters": { + "A_SIGNED": "00000000000000000000000000000000", + "A_WIDTH": "00000000000000000000000000000001", + "B_SIGNED": "00000000000000000000000000000000", + "B_WIDTH": "00000000000000000000000000000001", + "Y_WIDTH": "00000000000000000000000000000001" + }, + "attributes": { + }, + "port_directions": { + "A": "input", + "B": "input", + "Y": "output" + }, + "connections": { + "A": [ 7 ], + "B": [ 8 ], + "Y": [ 5 ] + } + }, + "half0": { + "hide_name": 0, + "type": "half", + "parameters": { + }, + "attributes": { + }, + "port_directions": { + "a": "input", + "b": "input", + "c": "output", + "s": "output" + }, + "connections": { + "a": [ 2 ], + "b": [ 3 ], + "c": [ 7 ], + "s": [ 9 ] + } + }, + "half1": { + "hide_name": 0, + "type": "half", + "parameters": { + }, + "attributes": { + }, + "port_directions": { + "a": "input", + "b": "input", + "c": "output", + "s": "output" + }, + "connections": { + "a": [ 9 ], + "b": [ 4 ], + "c": [ 8 ], + "s": [ 6 ] + } + } + }, + "netnames": { + "$auto$ghdl.cc:764:import_module$12": { + "hide_name": 1, + "bits": [ 6 ], + "attributes": { + } + }, + "$auto$ghdl.cc:764:import_module$13": { + "hide_name": 1, + "bits": [ 5 ], + "attributes": { + } + }, + "a": { + "hide_name": 0, + "bits": [ 2 ], + "attributes": { + } + }, + "b": { + "hide_name": 0, + "bits": [ 3 ], + "attributes": { + } + }, + "cin": { + "hide_name": 0, + "bits": [ 4 ], + "attributes": { + } + }, + "cout": { + "hide_name": 0, + "bits": [ 5 ], + "attributes": { + } + }, + "half0c": { + "hide_name": 0, + "bits": [ 7 ], + "attributes": { + } + }, + "half0s": { + "hide_name": 0, + "bits": [ 9 ], + "attributes": { + } + }, + "half1c": { + "hide_name": 0, + "bits": [ 8 ], + "attributes": { + } + }, + "s": { + "hide_name": 0, + "bits": [ 6 ], + "attributes": { + } + } + } + }, + "half": { + "attributes": { + }, + "ports": { + "a": { + "direction": "input", + "bits": [ 2 ] + }, + "b": { + "direction": "input", + "bits": [ 3 ] + }, + "c": { + "direction": "output", + "bits": [ 4 ] + }, + "s": { + "direction": "output", + "bits": [ 5 ] + } + }, + "cells": { + "\\28": { + "hide_name": 0, + "type": "$and", + "parameters": { + "A_SIGNED": "00000000000000000000000000000000", + "A_WIDTH": "00000000000000000000000000000001", + "B_SIGNED": "00000000000000000000000000000000", + "B_WIDTH": "00000000000000000000000000000001", + "Y_WIDTH": "00000000000000000000000000000001" + }, + "attributes": { + }, + "port_directions": { + "A": "input", + "B": "input", + "Y": "output" + }, + "connections": { + "A": [ 2 ], + "B": [ 3 ], + "Y": [ 4 ] + } + }, + "\\29": { + "hide_name": 0, + "type": "$xor", + "parameters": { + "A_SIGNED": "00000000000000000000000000000000", + "A_WIDTH": "00000000000000000000000000000001", + "B_SIGNED": "00000000000000000000000000000000", + "B_WIDTH": "00000000000000000000000000000001", + "Y_WIDTH": "00000000000000000000000000000001" + }, + "attributes": { + }, + "port_directions": { + "A": "input", + "B": "input", + "Y": "output" + }, + "connections": { + "A": [ 2 ], + "B": [ 3 ], + "Y": [ 5 ] + } + } + }, + "netnames": { + "$auto$ghdl.cc:764:import_module$14": { + "hide_name": 1, + "bits": [ 4 ], + "attributes": { + } + }, + "$auto$ghdl.cc:764:import_module$15": { + "hide_name": 1, + "bits": [ 5 ], + "attributes": { + } + }, + "a": { + "hide_name": 0, + "bits": [ 2 ], + "attributes": { + } + }, + "b": { + "hide_name": 0, + "bits": [ 3 ], + "attributes": { + } + }, + "c": { + "hide_name": 0, + "bits": [ 4 ], + "attributes": { + } + }, + "s": { + "hide_name": 0, + "bits": [ 5 ], + "attributes": { + } + } + } + } + } +} diff --git a/intTests/test_yosys_adder/test.saw b/intTests/test_yosys_adder/test.saw new file mode 100644 index 0000000000..abd59157fc --- /dev/null +++ b/intTests/test_yosys_adder/test.saw @@ -0,0 +1,3 @@ +enable_experimental; +m <- yosys_import "test.json"; +prove_print w4 {{ m.add4 === \inp -> { res = inp.a + inp.b } }}; \ No newline at end of file diff --git a/intTests/test_yosys_adder/test.sh b/intTests/test_yosys_adder/test.sh new file mode 100644 index 0000000000..0b864017cd --- /dev/null +++ b/intTests/test_yosys_adder/test.sh @@ -0,0 +1 @@ +$SAW test.saw diff --git a/intTests/test_yosys_basic/test.json b/intTests/test_yosys_basic/test.json new file mode 100644 index 0000000000..7e31e3f3bd --- /dev/null +++ b/intTests/test_yosys_basic/test.json @@ -0,0 +1,113 @@ +{ + "creator": "Yosys 0.10+1 (git sha1 7a7df9a3b4, gcc 10.3.0 -fPIC -Os)", + "modules": { + "half": { + "attributes": { + }, + "ports": { + "a": { + "direction": "input", + "bits": [ 2 ] + }, + "b": { + "direction": "input", + "bits": [ 3 ] + }, + "c": { + "direction": "output", + "bits": [ 4 ] + }, + "s": { + "direction": "output", + "bits": [ 5 ] + } + }, + "cells": { + "\\28": { + "hide_name": 0, + "type": "$and", + "parameters": { + "A_SIGNED": "00000000000000000000000000000000", + "A_WIDTH": "00000000000000000000000000000001", + "B_SIGNED": "00000000000000000000000000000000", + "B_WIDTH": "00000000000000000000000000000001", + "Y_WIDTH": "00000000000000000000000000000001" + }, + "attributes": { + }, + "port_directions": { + "A": "input", + "B": "input", + "Y": "output" + }, + "connections": { + "A": [ 2 ], + "B": [ 3 ], + "Y": [ 4 ] + } + }, + "\\29": { + "hide_name": 0, + "type": "$xor", + "parameters": { + "A_SIGNED": "00000000000000000000000000000000", + "A_WIDTH": "00000000000000000000000000000001", + "B_SIGNED": "00000000000000000000000000000000", + "B_WIDTH": "00000000000000000000000000000001", + "Y_WIDTH": "00000000000000000000000000000001" + }, + "attributes": { + }, + "port_directions": { + "A": "input", + "B": "input", + "Y": "output" + }, + "connections": { + "A": [ 2 ], + "B": [ 3 ], + "Y": [ 5 ] + } + } + }, + "netnames": { + "$auto$ghdl.cc:764:import_module$14": { + "hide_name": 1, + "bits": [ 4 ], + "attributes": { + } + }, + "$auto$ghdl.cc:764:import_module$15": { + "hide_name": 1, + "bits": [ 5 ], + "attributes": { + } + }, + "a": { + "hide_name": 0, + "bits": [ 2 ], + "attributes": { + } + }, + "b": { + "hide_name": 0, + "bits": [ 3 ], + "attributes": { + } + }, + "c": { + "hide_name": 0, + "bits": [ 4 ], + "attributes": { + } + }, + "s": { + "hide_name": 0, + "bits": [ 5 ], + "attributes": { + } + } + } + } + } +} diff --git a/intTests/test_yosys_basic/test.saw b/intTests/test_yosys_basic/test.saw new file mode 100644 index 0000000000..2ad26f5b96 --- /dev/null +++ b/intTests/test_yosys_basic/test.saw @@ -0,0 +1,2 @@ +enable_experimental; +yosys_import "test.json"; \ No newline at end of file diff --git a/intTests/test_yosys_basic/test.sh b/intTests/test_yosys_basic/test.sh new file mode 100644 index 0000000000..0b864017cd --- /dev/null +++ b/intTests/test_yosys_basic/test.sh @@ -0,0 +1 @@ +$SAW test.saw diff --git a/intTests/test_yosys_compositional/test.json b/intTests/test_yosys_compositional/test.json new file mode 100644 index 0000000000..63adfa3abe --- /dev/null +++ b/intTests/test_yosys_compositional/test.json @@ -0,0 +1,442 @@ +{ + "creator": "Yosys 0.10+1 (git sha1 7a7df9a3b4, gcc 10.3.0 -fPIC -Os)", + "modules": { + "add4": { + "attributes": { + }, + "ports": { + "a": { + "direction": "input", + "bits": [ 2, 3, 4, 5 ] + }, + "b": { + "direction": "input", + "bits": [ 6, 7, 8, 9 ] + }, + "res": { + "direction": "output", + "bits": [ 10, 11, 12, 13 ] + } + }, + "cells": { + "full0": { + "hide_name": 0, + "type": "full", + "parameters": { + }, + "attributes": { + }, + "port_directions": { + "a": "input", + "b": "input", + "cin": "input", + "cout": "output", + "s": "output" + }, + "connections": { + "a": [ 5 ], + "b": [ 9 ], + "cin": [ "0" ], + "cout": [ 14 ], + "s": [ 13 ] + } + }, + "full1": { + "hide_name": 0, + "type": "full", + "parameters": { + }, + "attributes": { + }, + "port_directions": { + "a": "input", + "b": "input", + "cin": "input", + "cout": "output", + "s": "output" + }, + "connections": { + "a": [ 4 ], + "b": [ 8 ], + "cin": [ 14 ], + "cout": [ 15 ], + "s": [ 12 ] + } + }, + "full2": { + "hide_name": 0, + "type": "full", + "parameters": { + }, + "attributes": { + }, + "port_directions": { + "a": "input", + "b": "input", + "cin": "input", + "cout": "output", + "s": "output" + }, + "connections": { + "a": [ 3 ], + "b": [ 7 ], + "cin": [ 15 ], + "cout": [ 16 ], + "s": [ 11 ] + } + }, + "full3": { + "hide_name": 0, + "type": "full", + "parameters": { + }, + "attributes": { + }, + "port_directions": { + "a": "input", + "b": "input", + "cin": "input", + "cout": "output", + "s": "output" + }, + "connections": { + "a": [ 2 ], + "b": [ 6 ], + "cin": [ 16 ], + "cout": [ 17 ], + "s": [ 10 ] + } + } + }, + "netnames": { + "$auto$ghdl.cc:764:import_module$2": { + "hide_name": 1, + "bits": [ 13 ], + "attributes": { + } + }, + "$auto$ghdl.cc:764:import_module$4": { + "hide_name": 1, + "bits": [ 12 ], + "attributes": { + } + }, + "$auto$ghdl.cc:764:import_module$6": { + "hide_name": 1, + "bits": [ 11 ], + "attributes": { + } + }, + "$auto$ghdl.cc:764:import_module$7": { + "hide_name": 1, + "bits": [ 17 ], + "attributes": { + } + }, + "$auto$ghdl.cc:764:import_module$8": { + "hide_name": 1, + "bits": [ 10 ], + "attributes": { + } + }, + "a": { + "hide_name": 0, + "bits": [ 2, 3, 4, 5 ], + "attributes": { + } + }, + "b": { + "hide_name": 0, + "bits": [ 6, 7, 8, 9 ], + "attributes": { + } + }, + "full0cout": { + "hide_name": 0, + "bits": [ 14 ], + "attributes": { + } + }, + "full1cout": { + "hide_name": 0, + "bits": [ 15 ], + "attributes": { + } + }, + "full2cout": { + "hide_name": 0, + "bits": [ 16 ], + "attributes": { + } + }, + "res": { + "hide_name": 0, + "bits": [ 10, 11, 12, 13 ], + "attributes": { + } + } + } + }, + "full": { + "attributes": { + }, + "ports": { + "a": { + "direction": "input", + "bits": [ 2 ] + }, + "b": { + "direction": "input", + "bits": [ 3 ] + }, + "cin": { + "direction": "input", + "bits": [ 4 ] + }, + "cout": { + "direction": "output", + "bits": [ 5 ] + }, + "s": { + "direction": "output", + "bits": [ 6 ] + } + }, + "cells": { + "\\25": { + "hide_name": 0, + "type": "$or", + "parameters": { + "A_SIGNED": "00000000000000000000000000000000", + "A_WIDTH": "00000000000000000000000000000001", + "B_SIGNED": "00000000000000000000000000000000", + "B_WIDTH": "00000000000000000000000000000001", + "Y_WIDTH": "00000000000000000000000000000001" + }, + "attributes": { + }, + "port_directions": { + "A": "input", + "B": "input", + "Y": "output" + }, + "connections": { + "A": [ 7 ], + "B": [ 8 ], + "Y": [ 5 ] + } + }, + "half0": { + "hide_name": 0, + "type": "half", + "parameters": { + }, + "attributes": { + }, + "port_directions": { + "a": "input", + "b": "input", + "c": "output", + "s": "output" + }, + "connections": { + "a": [ 2 ], + "b": [ 3 ], + "c": [ 7 ], + "s": [ 9 ] + } + }, + "half1": { + "hide_name": 0, + "type": "half", + "parameters": { + }, + "attributes": { + }, + "port_directions": { + "a": "input", + "b": "input", + "c": "output", + "s": "output" + }, + "connections": { + "a": [ 9 ], + "b": [ 4 ], + "c": [ 8 ], + "s": [ 6 ] + } + } + }, + "netnames": { + "$auto$ghdl.cc:764:import_module$12": { + "hide_name": 1, + "bits": [ 6 ], + "attributes": { + } + }, + "$auto$ghdl.cc:764:import_module$13": { + "hide_name": 1, + "bits": [ 5 ], + "attributes": { + } + }, + "a": { + "hide_name": 0, + "bits": [ 2 ], + "attributes": { + } + }, + "b": { + "hide_name": 0, + "bits": [ 3 ], + "attributes": { + } + }, + "cin": { + "hide_name": 0, + "bits": [ 4 ], + "attributes": { + } + }, + "cout": { + "hide_name": 0, + "bits": [ 5 ], + "attributes": { + } + }, + "half0c": { + "hide_name": 0, + "bits": [ 7 ], + "attributes": { + } + }, + "half0s": { + "hide_name": 0, + "bits": [ 9 ], + "attributes": { + } + }, + "half1c": { + "hide_name": 0, + "bits": [ 8 ], + "attributes": { + } + }, + "s": { + "hide_name": 0, + "bits": [ 6 ], + "attributes": { + } + } + } + }, + "half": { + "attributes": { + }, + "ports": { + "a": { + "direction": "input", + "bits": [ 2 ] + }, + "b": { + "direction": "input", + "bits": [ 3 ] + }, + "c": { + "direction": "output", + "bits": [ 4 ] + }, + "s": { + "direction": "output", + "bits": [ 5 ] + } + }, + "cells": { + "\\28": { + "hide_name": 0, + "type": "$and", + "parameters": { + "A_SIGNED": "00000000000000000000000000000000", + "A_WIDTH": "00000000000000000000000000000001", + "B_SIGNED": "00000000000000000000000000000000", + "B_WIDTH": "00000000000000000000000000000001", + "Y_WIDTH": "00000000000000000000000000000001" + }, + "attributes": { + }, + "port_directions": { + "A": "input", + "B": "input", + "Y": "output" + }, + "connections": { + "A": [ 2 ], + "B": [ 3 ], + "Y": [ 4 ] + } + }, + "\\29": { + "hide_name": 0, + "type": "$xor", + "parameters": { + "A_SIGNED": "00000000000000000000000000000000", + "A_WIDTH": "00000000000000000000000000000001", + "B_SIGNED": "00000000000000000000000000000000", + "B_WIDTH": "00000000000000000000000000000001", + "Y_WIDTH": "00000000000000000000000000000001" + }, + "attributes": { + }, + "port_directions": { + "A": "input", + "B": "input", + "Y": "output" + }, + "connections": { + "A": [ 2 ], + "B": [ 3 ], + "Y": [ 5 ] + } + } + }, + "netnames": { + "$auto$ghdl.cc:764:import_module$14": { + "hide_name": 1, + "bits": [ 4 ], + "attributes": { + } + }, + "$auto$ghdl.cc:764:import_module$15": { + "hide_name": 1, + "bits": [ 5 ], + "attributes": { + } + }, + "a": { + "hide_name": 0, + "bits": [ 2 ], + "attributes": { + } + }, + "b": { + "hide_name": 0, + "bits": [ 3 ], + "attributes": { + } + }, + "c": { + "hide_name": 0, + "bits": [ 4 ], + "attributes": { + } + }, + "s": { + "hide_name": 0, + "bits": [ 5 ], + "attributes": { + } + } + } + } + } +} diff --git a/intTests/test_yosys_compositional/test.saw b/intTests/test_yosys_compositional/test.saw new file mode 100644 index 0000000000..91ef62e7be --- /dev/null +++ b/intTests/test_yosys_compositional/test.saw @@ -0,0 +1,21 @@ +enable_experimental; + +let {{ + cryfull : {a : [1], b : [1], cin : [1]} -> {cout : [1], s : [1]} + cryfull inp = { cout = [cout], s = [s] } + where [cout, s] = zext inp.a + zext inp.b + zext inp.cin + + cryadd4 : {a : [4], b : [4]} -> {res : [4]} + cryadd4 inp = { res = inp.a + inp.b } + + cryfullnocarry : {a : [1], b : [1], cin : [1]} -> {cout : [1], s : [1]} + cryfullnocarry inp = { cout = [cout], s = [s] } + where [cout, s] = zext inp.a + zext inp.b +}}; + +m <- yosys_import "test.json"; + +full_spec <- yosys_verify {{ m.full }} [] {{ cryfull }} [] w4; +yosys_verify {{ m.add4 }} [] {{ cryadd4 }} [full_spec] w4; +full_nocarry_spec <- yosys_verify {{ m.full }} [{{\(inp : {a : [1], b : [1], cin : [1]}) -> inp.cin == 0}}] {{ cryfullnocarry }} [] w4; +yosys_verify {{ m.add4 }} [] {{ cryadd4 }} [full_nocarry_spec] w4; \ No newline at end of file diff --git a/intTests/test_yosys_compositional/test.sh b/intTests/test_yosys_compositional/test.sh new file mode 100644 index 0000000000..0b864017cd --- /dev/null +++ b/intTests/test_yosys_compositional/test.sh @@ -0,0 +1 @@ +$SAW test.saw diff --git a/intTests/test_yosys_multiple_modules/test.json b/intTests/test_yosys_multiple_modules/test.json new file mode 100644 index 0000000000..63adfa3abe --- /dev/null +++ b/intTests/test_yosys_multiple_modules/test.json @@ -0,0 +1,442 @@ +{ + "creator": "Yosys 0.10+1 (git sha1 7a7df9a3b4, gcc 10.3.0 -fPIC -Os)", + "modules": { + "add4": { + "attributes": { + }, + "ports": { + "a": { + "direction": "input", + "bits": [ 2, 3, 4, 5 ] + }, + "b": { + "direction": "input", + "bits": [ 6, 7, 8, 9 ] + }, + "res": { + "direction": "output", + "bits": [ 10, 11, 12, 13 ] + } + }, + "cells": { + "full0": { + "hide_name": 0, + "type": "full", + "parameters": { + }, + "attributes": { + }, + "port_directions": { + "a": "input", + "b": "input", + "cin": "input", + "cout": "output", + "s": "output" + }, + "connections": { + "a": [ 5 ], + "b": [ 9 ], + "cin": [ "0" ], + "cout": [ 14 ], + "s": [ 13 ] + } + }, + "full1": { + "hide_name": 0, + "type": "full", + "parameters": { + }, + "attributes": { + }, + "port_directions": { + "a": "input", + "b": "input", + "cin": "input", + "cout": "output", + "s": "output" + }, + "connections": { + "a": [ 4 ], + "b": [ 8 ], + "cin": [ 14 ], + "cout": [ 15 ], + "s": [ 12 ] + } + }, + "full2": { + "hide_name": 0, + "type": "full", + "parameters": { + }, + "attributes": { + }, + "port_directions": { + "a": "input", + "b": "input", + "cin": "input", + "cout": "output", + "s": "output" + }, + "connections": { + "a": [ 3 ], + "b": [ 7 ], + "cin": [ 15 ], + "cout": [ 16 ], + "s": [ 11 ] + } + }, + "full3": { + "hide_name": 0, + "type": "full", + "parameters": { + }, + "attributes": { + }, + "port_directions": { + "a": "input", + "b": "input", + "cin": "input", + "cout": "output", + "s": "output" + }, + "connections": { + "a": [ 2 ], + "b": [ 6 ], + "cin": [ 16 ], + "cout": [ 17 ], + "s": [ 10 ] + } + } + }, + "netnames": { + "$auto$ghdl.cc:764:import_module$2": { + "hide_name": 1, + "bits": [ 13 ], + "attributes": { + } + }, + "$auto$ghdl.cc:764:import_module$4": { + "hide_name": 1, + "bits": [ 12 ], + "attributes": { + } + }, + "$auto$ghdl.cc:764:import_module$6": { + "hide_name": 1, + "bits": [ 11 ], + "attributes": { + } + }, + "$auto$ghdl.cc:764:import_module$7": { + "hide_name": 1, + "bits": [ 17 ], + "attributes": { + } + }, + "$auto$ghdl.cc:764:import_module$8": { + "hide_name": 1, + "bits": [ 10 ], + "attributes": { + } + }, + "a": { + "hide_name": 0, + "bits": [ 2, 3, 4, 5 ], + "attributes": { + } + }, + "b": { + "hide_name": 0, + "bits": [ 6, 7, 8, 9 ], + "attributes": { + } + }, + "full0cout": { + "hide_name": 0, + "bits": [ 14 ], + "attributes": { + } + }, + "full1cout": { + "hide_name": 0, + "bits": [ 15 ], + "attributes": { + } + }, + "full2cout": { + "hide_name": 0, + "bits": [ 16 ], + "attributes": { + } + }, + "res": { + "hide_name": 0, + "bits": [ 10, 11, 12, 13 ], + "attributes": { + } + } + } + }, + "full": { + "attributes": { + }, + "ports": { + "a": { + "direction": "input", + "bits": [ 2 ] + }, + "b": { + "direction": "input", + "bits": [ 3 ] + }, + "cin": { + "direction": "input", + "bits": [ 4 ] + }, + "cout": { + "direction": "output", + "bits": [ 5 ] + }, + "s": { + "direction": "output", + "bits": [ 6 ] + } + }, + "cells": { + "\\25": { + "hide_name": 0, + "type": "$or", + "parameters": { + "A_SIGNED": "00000000000000000000000000000000", + "A_WIDTH": "00000000000000000000000000000001", + "B_SIGNED": "00000000000000000000000000000000", + "B_WIDTH": "00000000000000000000000000000001", + "Y_WIDTH": "00000000000000000000000000000001" + }, + "attributes": { + }, + "port_directions": { + "A": "input", + "B": "input", + "Y": "output" + }, + "connections": { + "A": [ 7 ], + "B": [ 8 ], + "Y": [ 5 ] + } + }, + "half0": { + "hide_name": 0, + "type": "half", + "parameters": { + }, + "attributes": { + }, + "port_directions": { + "a": "input", + "b": "input", + "c": "output", + "s": "output" + }, + "connections": { + "a": [ 2 ], + "b": [ 3 ], + "c": [ 7 ], + "s": [ 9 ] + } + }, + "half1": { + "hide_name": 0, + "type": "half", + "parameters": { + }, + "attributes": { + }, + "port_directions": { + "a": "input", + "b": "input", + "c": "output", + "s": "output" + }, + "connections": { + "a": [ 9 ], + "b": [ 4 ], + "c": [ 8 ], + "s": [ 6 ] + } + } + }, + "netnames": { + "$auto$ghdl.cc:764:import_module$12": { + "hide_name": 1, + "bits": [ 6 ], + "attributes": { + } + }, + "$auto$ghdl.cc:764:import_module$13": { + "hide_name": 1, + "bits": [ 5 ], + "attributes": { + } + }, + "a": { + "hide_name": 0, + "bits": [ 2 ], + "attributes": { + } + }, + "b": { + "hide_name": 0, + "bits": [ 3 ], + "attributes": { + } + }, + "cin": { + "hide_name": 0, + "bits": [ 4 ], + "attributes": { + } + }, + "cout": { + "hide_name": 0, + "bits": [ 5 ], + "attributes": { + } + }, + "half0c": { + "hide_name": 0, + "bits": [ 7 ], + "attributes": { + } + }, + "half0s": { + "hide_name": 0, + "bits": [ 9 ], + "attributes": { + } + }, + "half1c": { + "hide_name": 0, + "bits": [ 8 ], + "attributes": { + } + }, + "s": { + "hide_name": 0, + "bits": [ 6 ], + "attributes": { + } + } + } + }, + "half": { + "attributes": { + }, + "ports": { + "a": { + "direction": "input", + "bits": [ 2 ] + }, + "b": { + "direction": "input", + "bits": [ 3 ] + }, + "c": { + "direction": "output", + "bits": [ 4 ] + }, + "s": { + "direction": "output", + "bits": [ 5 ] + } + }, + "cells": { + "\\28": { + "hide_name": 0, + "type": "$and", + "parameters": { + "A_SIGNED": "00000000000000000000000000000000", + "A_WIDTH": "00000000000000000000000000000001", + "B_SIGNED": "00000000000000000000000000000000", + "B_WIDTH": "00000000000000000000000000000001", + "Y_WIDTH": "00000000000000000000000000000001" + }, + "attributes": { + }, + "port_directions": { + "A": "input", + "B": "input", + "Y": "output" + }, + "connections": { + "A": [ 2 ], + "B": [ 3 ], + "Y": [ 4 ] + } + }, + "\\29": { + "hide_name": 0, + "type": "$xor", + "parameters": { + "A_SIGNED": "00000000000000000000000000000000", + "A_WIDTH": "00000000000000000000000000000001", + "B_SIGNED": "00000000000000000000000000000000", + "B_WIDTH": "00000000000000000000000000000001", + "Y_WIDTH": "00000000000000000000000000000001" + }, + "attributes": { + }, + "port_directions": { + "A": "input", + "B": "input", + "Y": "output" + }, + "connections": { + "A": [ 2 ], + "B": [ 3 ], + "Y": [ 5 ] + } + } + }, + "netnames": { + "$auto$ghdl.cc:764:import_module$14": { + "hide_name": 1, + "bits": [ 4 ], + "attributes": { + } + }, + "$auto$ghdl.cc:764:import_module$15": { + "hide_name": 1, + "bits": [ 5 ], + "attributes": { + } + }, + "a": { + "hide_name": 0, + "bits": [ 2 ], + "attributes": { + } + }, + "b": { + "hide_name": 0, + "bits": [ 3 ], + "attributes": { + } + }, + "c": { + "hide_name": 0, + "bits": [ 4 ], + "attributes": { + } + }, + "s": { + "hide_name": 0, + "bits": [ 5 ], + "attributes": { + } + } + } + } + } +} diff --git a/intTests/test_yosys_multiple_modules/test.saw b/intTests/test_yosys_multiple_modules/test.saw new file mode 100644 index 0000000000..2ad26f5b96 --- /dev/null +++ b/intTests/test_yosys_multiple_modules/test.saw @@ -0,0 +1,2 @@ +enable_experimental; +yosys_import "test.json"; \ No newline at end of file diff --git a/intTests/test_yosys_multiple_modules/test.sh b/intTests/test_yosys_multiple_modules/test.sh new file mode 100644 index 0000000000..0b864017cd --- /dev/null +++ b/intTests/test_yosys_multiple_modules/test.sh @@ -0,0 +1 @@ +$SAW test.saw diff --git a/intTests/test_yosys_namespace/test.json b/intTests/test_yosys_namespace/test.json new file mode 100644 index 0000000000..63adfa3abe --- /dev/null +++ b/intTests/test_yosys_namespace/test.json @@ -0,0 +1,442 @@ +{ + "creator": "Yosys 0.10+1 (git sha1 7a7df9a3b4, gcc 10.3.0 -fPIC -Os)", + "modules": { + "add4": { + "attributes": { + }, + "ports": { + "a": { + "direction": "input", + "bits": [ 2, 3, 4, 5 ] + }, + "b": { + "direction": "input", + "bits": [ 6, 7, 8, 9 ] + }, + "res": { + "direction": "output", + "bits": [ 10, 11, 12, 13 ] + } + }, + "cells": { + "full0": { + "hide_name": 0, + "type": "full", + "parameters": { + }, + "attributes": { + }, + "port_directions": { + "a": "input", + "b": "input", + "cin": "input", + "cout": "output", + "s": "output" + }, + "connections": { + "a": [ 5 ], + "b": [ 9 ], + "cin": [ "0" ], + "cout": [ 14 ], + "s": [ 13 ] + } + }, + "full1": { + "hide_name": 0, + "type": "full", + "parameters": { + }, + "attributes": { + }, + "port_directions": { + "a": "input", + "b": "input", + "cin": "input", + "cout": "output", + "s": "output" + }, + "connections": { + "a": [ 4 ], + "b": [ 8 ], + "cin": [ 14 ], + "cout": [ 15 ], + "s": [ 12 ] + } + }, + "full2": { + "hide_name": 0, + "type": "full", + "parameters": { + }, + "attributes": { + }, + "port_directions": { + "a": "input", + "b": "input", + "cin": "input", + "cout": "output", + "s": "output" + }, + "connections": { + "a": [ 3 ], + "b": [ 7 ], + "cin": [ 15 ], + "cout": [ 16 ], + "s": [ 11 ] + } + }, + "full3": { + "hide_name": 0, + "type": "full", + "parameters": { + }, + "attributes": { + }, + "port_directions": { + "a": "input", + "b": "input", + "cin": "input", + "cout": "output", + "s": "output" + }, + "connections": { + "a": [ 2 ], + "b": [ 6 ], + "cin": [ 16 ], + "cout": [ 17 ], + "s": [ 10 ] + } + } + }, + "netnames": { + "$auto$ghdl.cc:764:import_module$2": { + "hide_name": 1, + "bits": [ 13 ], + "attributes": { + } + }, + "$auto$ghdl.cc:764:import_module$4": { + "hide_name": 1, + "bits": [ 12 ], + "attributes": { + } + }, + "$auto$ghdl.cc:764:import_module$6": { + "hide_name": 1, + "bits": [ 11 ], + "attributes": { + } + }, + "$auto$ghdl.cc:764:import_module$7": { + "hide_name": 1, + "bits": [ 17 ], + "attributes": { + } + }, + "$auto$ghdl.cc:764:import_module$8": { + "hide_name": 1, + "bits": [ 10 ], + "attributes": { + } + }, + "a": { + "hide_name": 0, + "bits": [ 2, 3, 4, 5 ], + "attributes": { + } + }, + "b": { + "hide_name": 0, + "bits": [ 6, 7, 8, 9 ], + "attributes": { + } + }, + "full0cout": { + "hide_name": 0, + "bits": [ 14 ], + "attributes": { + } + }, + "full1cout": { + "hide_name": 0, + "bits": [ 15 ], + "attributes": { + } + }, + "full2cout": { + "hide_name": 0, + "bits": [ 16 ], + "attributes": { + } + }, + "res": { + "hide_name": 0, + "bits": [ 10, 11, 12, 13 ], + "attributes": { + } + } + } + }, + "full": { + "attributes": { + }, + "ports": { + "a": { + "direction": "input", + "bits": [ 2 ] + }, + "b": { + "direction": "input", + "bits": [ 3 ] + }, + "cin": { + "direction": "input", + "bits": [ 4 ] + }, + "cout": { + "direction": "output", + "bits": [ 5 ] + }, + "s": { + "direction": "output", + "bits": [ 6 ] + } + }, + "cells": { + "\\25": { + "hide_name": 0, + "type": "$or", + "parameters": { + "A_SIGNED": "00000000000000000000000000000000", + "A_WIDTH": "00000000000000000000000000000001", + "B_SIGNED": "00000000000000000000000000000000", + "B_WIDTH": "00000000000000000000000000000001", + "Y_WIDTH": "00000000000000000000000000000001" + }, + "attributes": { + }, + "port_directions": { + "A": "input", + "B": "input", + "Y": "output" + }, + "connections": { + "A": [ 7 ], + "B": [ 8 ], + "Y": [ 5 ] + } + }, + "half0": { + "hide_name": 0, + "type": "half", + "parameters": { + }, + "attributes": { + }, + "port_directions": { + "a": "input", + "b": "input", + "c": "output", + "s": "output" + }, + "connections": { + "a": [ 2 ], + "b": [ 3 ], + "c": [ 7 ], + "s": [ 9 ] + } + }, + "half1": { + "hide_name": 0, + "type": "half", + "parameters": { + }, + "attributes": { + }, + "port_directions": { + "a": "input", + "b": "input", + "c": "output", + "s": "output" + }, + "connections": { + "a": [ 9 ], + "b": [ 4 ], + "c": [ 8 ], + "s": [ 6 ] + } + } + }, + "netnames": { + "$auto$ghdl.cc:764:import_module$12": { + "hide_name": 1, + "bits": [ 6 ], + "attributes": { + } + }, + "$auto$ghdl.cc:764:import_module$13": { + "hide_name": 1, + "bits": [ 5 ], + "attributes": { + } + }, + "a": { + "hide_name": 0, + "bits": [ 2 ], + "attributes": { + } + }, + "b": { + "hide_name": 0, + "bits": [ 3 ], + "attributes": { + } + }, + "cin": { + "hide_name": 0, + "bits": [ 4 ], + "attributes": { + } + }, + "cout": { + "hide_name": 0, + "bits": [ 5 ], + "attributes": { + } + }, + "half0c": { + "hide_name": 0, + "bits": [ 7 ], + "attributes": { + } + }, + "half0s": { + "hide_name": 0, + "bits": [ 9 ], + "attributes": { + } + }, + "half1c": { + "hide_name": 0, + "bits": [ 8 ], + "attributes": { + } + }, + "s": { + "hide_name": 0, + "bits": [ 6 ], + "attributes": { + } + } + } + }, + "half": { + "attributes": { + }, + "ports": { + "a": { + "direction": "input", + "bits": [ 2 ] + }, + "b": { + "direction": "input", + "bits": [ 3 ] + }, + "c": { + "direction": "output", + "bits": [ 4 ] + }, + "s": { + "direction": "output", + "bits": [ 5 ] + } + }, + "cells": { + "\\28": { + "hide_name": 0, + "type": "$and", + "parameters": { + "A_SIGNED": "00000000000000000000000000000000", + "A_WIDTH": "00000000000000000000000000000001", + "B_SIGNED": "00000000000000000000000000000000", + "B_WIDTH": "00000000000000000000000000000001", + "Y_WIDTH": "00000000000000000000000000000001" + }, + "attributes": { + }, + "port_directions": { + "A": "input", + "B": "input", + "Y": "output" + }, + "connections": { + "A": [ 2 ], + "B": [ 3 ], + "Y": [ 4 ] + } + }, + "\\29": { + "hide_name": 0, + "type": "$xor", + "parameters": { + "A_SIGNED": "00000000000000000000000000000000", + "A_WIDTH": "00000000000000000000000000000001", + "B_SIGNED": "00000000000000000000000000000000", + "B_WIDTH": "00000000000000000000000000000001", + "Y_WIDTH": "00000000000000000000000000000001" + }, + "attributes": { + }, + "port_directions": { + "A": "input", + "B": "input", + "Y": "output" + }, + "connections": { + "A": [ 2 ], + "B": [ 3 ], + "Y": [ 5 ] + } + } + }, + "netnames": { + "$auto$ghdl.cc:764:import_module$14": { + "hide_name": 1, + "bits": [ 4 ], + "attributes": { + } + }, + "$auto$ghdl.cc:764:import_module$15": { + "hide_name": 1, + "bits": [ 5 ], + "attributes": { + } + }, + "a": { + "hide_name": 0, + "bits": [ 2 ], + "attributes": { + } + }, + "b": { + "hide_name": 0, + "bits": [ 3 ], + "attributes": { + } + }, + "c": { + "hide_name": 0, + "bits": [ 4 ], + "attributes": { + } + }, + "s": { + "hide_name": 0, + "bits": [ 5 ], + "attributes": { + } + } + } + } + } +} diff --git a/intTests/test_yosys_namespace/test.saw b/intTests/test_yosys_namespace/test.saw new file mode 100644 index 0000000000..8e149dff41 --- /dev/null +++ b/intTests/test_yosys_namespace/test.saw @@ -0,0 +1,4 @@ +enable_experimental; +m <- yosys_import "test.json"; +m' <- yosys_import "test.json"; +prove_print w4 {{ m.add4 === m'.add4 }}; \ No newline at end of file diff --git a/intTests/test_yosys_namespace/test.sh b/intTests/test_yosys_namespace/test.sh new file mode 100644 index 0000000000..0b864017cd --- /dev/null +++ b/intTests/test_yosys_namespace/test.sh @@ -0,0 +1 @@ +$SAW test.saw diff --git a/intTests/test_yosys_sequential/test.json b/intTests/test_yosys_sequential/test.json new file mode 100644 index 0000000000..11aafdb2b6 --- /dev/null +++ b/intTests/test_yosys_sequential/test.json @@ -0,0 +1,407 @@ +{ + "creator": "Yosys 0.10+1 (git sha1 7a7df9a3b4, gcc 10.3.0 -fPIC -Os)", + "modules": { + "seqgen": { + "attributes": { + }, + "ports": { + "clk": { + "direction": "input", + "bits": [ 2 ] + }, + "reset": { + "direction": "input", + "bits": [ 3 ] + }, + "C": { + "direction": "input", + "bits": [ 4 ] + }, + "G": { + "direction": "input", + "bits": [ 5 ] + }, + "P": { + "direction": "input", + "bits": [ 6 ] + }, + "S": { + "direction": "output", + "bits": [ 7 ] + } + }, + "cells": { + "\\10": { + "hide_name": 0, + "type": "$and", + "parameters": { + "A_SIGNED": "00000000000000000000000000000000", + "A_WIDTH": "00000000000000000000000000000001", + "B_SIGNED": "00000000000000000000000000000000", + "B_WIDTH": "00000000000000000000000000000001", + "Y_WIDTH": "00000000000000000000000000000001" + }, + "attributes": { + }, + "port_directions": { + "A": "input", + "B": "input", + "Y": "output" + }, + "connections": { + "A": [ 8 ], + "B": [ 5 ], + "Y": [ 9 ] + } + }, + "\\13": { + "hide_name": 0, + "type": "$mux", + "parameters": { + "WIDTH": "00000000000000000000000000000100" + }, + "attributes": { + }, + "port_directions": { + "A": "input", + "B": "input", + "S": "input", + "Y": "output" + }, + "connections": { + "A": [ 7, 10, 11, 12 ], + "B": [ 13, 14, 15, 16 ], + "S": [ 9 ], + "Y": [ 17, 18, 19, 20 ] + } + }, + "\\14": { + "hide_name": 0, + "type": "$mux", + "parameters": { + "WIDTH": "00000000000000000000000000000100" + }, + "attributes": { + }, + "port_directions": { + "A": "input", + "B": "input", + "S": "input", + "Y": "output" + }, + "connections": { + "A": [ 17, 18, 19, 20 ], + "B": [ 6, 7, 10, 11 ], + "S": [ 21 ], + "Y": [ 22, 23, 24, 25 ] + } + }, + "\\16": { + "hide_name": 0, + "type": "$mux", + "parameters": { + "WIDTH": "00000000000000000000000000000100" + }, + "attributes": { + }, + "port_directions": { + "A": "input", + "B": "input", + "S": "input", + "Y": "output" + }, + "connections": { + "A": [ 22, 23, 24, 25 ], + "B": [ "0", "0", "0", "0" ], + "S": [ 3 ], + "Y": [ 26, 27, 28, 29 ] + } + }, + "\\19": { + "hide_name": 0, + "type": "$dff", + "parameters": { + "CLK_POLARITY": "00000000000000000000000000000001", + "WIDTH": "00000000000000000000000000000100" + }, + "attributes": { + }, + "port_directions": { + "CLK": "input", + "D": "input", + "Q": "output" + }, + "connections": { + "CLK": [ 2 ], + "D": [ 26, 27, 28, 29 ], + "Q": [ 7, 10, 11, 12 ] + } + }, + "\\21": { + "hide_name": 0, + "type": "$shr", + "parameters": { + "A_SIGNED": "00000000000000000000000000000000", + "A_WIDTH": "00000000000000000000000000000100", + "B_SIGNED": "00000000000000000000000000000000", + "B_WIDTH": "00000000000000000000000000011111", + "Y_WIDTH": "00000000000000000000000000000100" + }, + "attributes": { + }, + "port_directions": { + "A": "input", + "B": "input", + "Y": "output" + }, + "connections": { + "A": [ 7, 10, 11, 12 ], + "B": [ "1", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0" ], + "Y": [ 30, 31, 32, 33 ] + } + }, + "\\24": { + "hide_name": 0, + "type": "$sub", + "parameters": { + "A_SIGNED": "00000000000000000000000000000000", + "A_WIDTH": "00000000000000000000000000000010", + "B_SIGNED": "00000000000000000000000000000000", + "B_WIDTH": "00000000000000000000000000000010", + "Y_WIDTH": "00000000000000000000000000000010" + }, + "attributes": { + }, + "port_directions": { + "A": "input", + "B": "input", + "Y": "output" + }, + "connections": { + "A": [ "0", "0" ], + "B": [ "1", "0" ], + "Y": [ 34, 35 ] + } + }, + "\\25": { + "hide_name": 0, + "type": "$shl", + "parameters": { + "A_SIGNED": "00000000000000000000000000000000", + "A_WIDTH": "00000000000000000000000000000100", + "B_SIGNED": "00000000000000000000000000000000", + "B_WIDTH": "00000000000000000000000000000010", + "Y_WIDTH": "00000000000000000000000000000100" + }, + "attributes": { + }, + "port_directions": { + "A": "input", + "B": "input", + "Y": "output" + }, + "connections": { + "A": [ 7, 10, 11, 12 ], + "B": [ 34, 35 ], + "Y": [ 36, 37, 38, 39 ] + } + }, + "\\26": { + "hide_name": 0, + "type": "$or", + "parameters": { + "A_SIGNED": "00000000000000000000000000000000", + "A_WIDTH": "00000000000000000000000000000100", + "B_SIGNED": "00000000000000000000000000000000", + "B_WIDTH": "00000000000000000000000000000100", + "Y_WIDTH": "00000000000000000000000000000100" + }, + "attributes": { + }, + "port_directions": { + "A": "input", + "B": "input", + "Y": "output" + }, + "connections": { + "A": [ 30, 31, 32, 33 ], + "B": [ 36, 37, 38, 39 ], + "Y": [ 13, 14, 15, 16 ] + } + }, + "\\5": { + "hide_name": 0, + "type": "$not", + "parameters": { + "A_SIGNED": "00000000000000000000000000000000", + "A_WIDTH": "00000000000000000000000000000001", + "Y_WIDTH": "00000000000000000000000000000001" + }, + "attributes": { + }, + "port_directions": { + "A": "input", + "Y": "output" + }, + "connections": { + "A": [ 5 ], + "Y": [ 40 ] + } + }, + "\\6": { + "hide_name": 0, + "type": "$and", + "parameters": { + "A_SIGNED": "00000000000000000000000000000000", + "A_WIDTH": "00000000000000000000000000000001", + "B_SIGNED": "00000000000000000000000000000000", + "B_WIDTH": "00000000000000000000000000000001", + "Y_WIDTH": "00000000000000000000000000000001" + }, + "attributes": { + }, + "port_directions": { + "A": "input", + "B": "input", + "Y": "output" + }, + "connections": { + "A": [ 4 ], + "B": [ 40 ], + "Y": [ 21 ] + } + }, + "\\9": { + "hide_name": 0, + "type": "$not", + "parameters": { + "A_SIGNED": "00000000000000000000000000000000", + "A_WIDTH": "00000000000000000000000000000001", + "Y_WIDTH": "00000000000000000000000000000001" + }, + "attributes": { + }, + "port_directions": { + "A": "input", + "Y": "output" + }, + "connections": { + "A": [ 4 ], + "Y": [ 8 ] + } + } + }, + "netnames": { + "$auto$ghdl.cc:764:import_module$1": { + "hide_name": 1, + "bits": [ 40 ], + "attributes": { + } + }, + "$auto$ghdl.cc:764:import_module$10": { + "hide_name": 1, + "bits": [ 34, 35 ], + "attributes": { + } + }, + "$auto$ghdl.cc:764:import_module$11": { + "hide_name": 1, + "bits": [ 36, 37, 38, 39 ], + "attributes": { + } + }, + "$auto$ghdl.cc:764:import_module$12": { + "hide_name": 1, + "bits": [ 13, 14, 15, 16 ], + "attributes": { + } + }, + "$auto$ghdl.cc:764:import_module$2": { + "hide_name": 1, + "bits": [ 21 ], + "attributes": { + } + }, + "$auto$ghdl.cc:764:import_module$3": { + "hide_name": 1, + "bits": [ 8 ], + "attributes": { + } + }, + "$auto$ghdl.cc:764:import_module$4": { + "hide_name": 1, + "bits": [ 9 ], + "attributes": { + } + }, + "$auto$ghdl.cc:764:import_module$5": { + "hide_name": 1, + "bits": [ 17, 18, 19, 20 ], + "attributes": { + } + }, + "$auto$ghdl.cc:764:import_module$6": { + "hide_name": 1, + "bits": [ 22, 23, 24, 25 ], + "attributes": { + } + }, + "$auto$ghdl.cc:764:import_module$7": { + "hide_name": 1, + "bits": [ 26, 27, 28, 29 ], + "attributes": { + } + }, + "$auto$ghdl.cc:764:import_module$9": { + "hide_name": 1, + "bits": [ 30, 31, 32, 33 ], + "attributes": { + } + }, + "C": { + "hide_name": 0, + "bits": [ 4 ], + "attributes": { + } + }, + "G": { + "hide_name": 0, + "bits": [ 5 ], + "attributes": { + } + }, + "P": { + "hide_name": 0, + "bits": [ 6 ], + "attributes": { + } + }, + "S": { + "hide_name": 0, + "bits": [ 7 ], + "attributes": { + } + }, + "clk": { + "hide_name": 0, + "bits": [ 2 ], + "attributes": { + } + }, + "pattern": { + "hide_name": 0, + "bits": [ 7, 10, 11, 12 ], + "attributes": { + "init": "0000" + } + }, + "reset": { + "hide_name": 0, + "bits": [ 3 ], + "attributes": { + } + } + } + } + } +} diff --git a/intTests/test_yosys_sequential/test.saw b/intTests/test_yosys_sequential/test.saw new file mode 100644 index 0000000000..9cf7f7cd56 --- /dev/null +++ b/intTests/test_yosys_sequential/test.saw @@ -0,0 +1,2 @@ +enable_experimental; +yosys_import_sequential "seqgen" "test.json"; \ No newline at end of file diff --git a/intTests/test_yosys_sequential/test.sh b/intTests/test_yosys_sequential/test.sh new file mode 100644 index 0000000000..0b864017cd --- /dev/null +++ b/intTests/test_yosys_sequential/test.sh @@ -0,0 +1 @@ +$SAW test.saw diff --git a/intTests/test_yosys_sequential_known_cycles/test.json b/intTests/test_yosys_sequential_known_cycles/test.json new file mode 100644 index 0000000000..11aafdb2b6 --- /dev/null +++ b/intTests/test_yosys_sequential_known_cycles/test.json @@ -0,0 +1,407 @@ +{ + "creator": "Yosys 0.10+1 (git sha1 7a7df9a3b4, gcc 10.3.0 -fPIC -Os)", + "modules": { + "seqgen": { + "attributes": { + }, + "ports": { + "clk": { + "direction": "input", + "bits": [ 2 ] + }, + "reset": { + "direction": "input", + "bits": [ 3 ] + }, + "C": { + "direction": "input", + "bits": [ 4 ] + }, + "G": { + "direction": "input", + "bits": [ 5 ] + }, + "P": { + "direction": "input", + "bits": [ 6 ] + }, + "S": { + "direction": "output", + "bits": [ 7 ] + } + }, + "cells": { + "\\10": { + "hide_name": 0, + "type": "$and", + "parameters": { + "A_SIGNED": "00000000000000000000000000000000", + "A_WIDTH": "00000000000000000000000000000001", + "B_SIGNED": "00000000000000000000000000000000", + "B_WIDTH": "00000000000000000000000000000001", + "Y_WIDTH": "00000000000000000000000000000001" + }, + "attributes": { + }, + "port_directions": { + "A": "input", + "B": "input", + "Y": "output" + }, + "connections": { + "A": [ 8 ], + "B": [ 5 ], + "Y": [ 9 ] + } + }, + "\\13": { + "hide_name": 0, + "type": "$mux", + "parameters": { + "WIDTH": "00000000000000000000000000000100" + }, + "attributes": { + }, + "port_directions": { + "A": "input", + "B": "input", + "S": "input", + "Y": "output" + }, + "connections": { + "A": [ 7, 10, 11, 12 ], + "B": [ 13, 14, 15, 16 ], + "S": [ 9 ], + "Y": [ 17, 18, 19, 20 ] + } + }, + "\\14": { + "hide_name": 0, + "type": "$mux", + "parameters": { + "WIDTH": "00000000000000000000000000000100" + }, + "attributes": { + }, + "port_directions": { + "A": "input", + "B": "input", + "S": "input", + "Y": "output" + }, + "connections": { + "A": [ 17, 18, 19, 20 ], + "B": [ 6, 7, 10, 11 ], + "S": [ 21 ], + "Y": [ 22, 23, 24, 25 ] + } + }, + "\\16": { + "hide_name": 0, + "type": "$mux", + "parameters": { + "WIDTH": "00000000000000000000000000000100" + }, + "attributes": { + }, + "port_directions": { + "A": "input", + "B": "input", + "S": "input", + "Y": "output" + }, + "connections": { + "A": [ 22, 23, 24, 25 ], + "B": [ "0", "0", "0", "0" ], + "S": [ 3 ], + "Y": [ 26, 27, 28, 29 ] + } + }, + "\\19": { + "hide_name": 0, + "type": "$dff", + "parameters": { + "CLK_POLARITY": "00000000000000000000000000000001", + "WIDTH": "00000000000000000000000000000100" + }, + "attributes": { + }, + "port_directions": { + "CLK": "input", + "D": "input", + "Q": "output" + }, + "connections": { + "CLK": [ 2 ], + "D": [ 26, 27, 28, 29 ], + "Q": [ 7, 10, 11, 12 ] + } + }, + "\\21": { + "hide_name": 0, + "type": "$shr", + "parameters": { + "A_SIGNED": "00000000000000000000000000000000", + "A_WIDTH": "00000000000000000000000000000100", + "B_SIGNED": "00000000000000000000000000000000", + "B_WIDTH": "00000000000000000000000000011111", + "Y_WIDTH": "00000000000000000000000000000100" + }, + "attributes": { + }, + "port_directions": { + "A": "input", + "B": "input", + "Y": "output" + }, + "connections": { + "A": [ 7, 10, 11, 12 ], + "B": [ "1", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0" ], + "Y": [ 30, 31, 32, 33 ] + } + }, + "\\24": { + "hide_name": 0, + "type": "$sub", + "parameters": { + "A_SIGNED": "00000000000000000000000000000000", + "A_WIDTH": "00000000000000000000000000000010", + "B_SIGNED": "00000000000000000000000000000000", + "B_WIDTH": "00000000000000000000000000000010", + "Y_WIDTH": "00000000000000000000000000000010" + }, + "attributes": { + }, + "port_directions": { + "A": "input", + "B": "input", + "Y": "output" + }, + "connections": { + "A": [ "0", "0" ], + "B": [ "1", "0" ], + "Y": [ 34, 35 ] + } + }, + "\\25": { + "hide_name": 0, + "type": "$shl", + "parameters": { + "A_SIGNED": "00000000000000000000000000000000", + "A_WIDTH": "00000000000000000000000000000100", + "B_SIGNED": "00000000000000000000000000000000", + "B_WIDTH": "00000000000000000000000000000010", + "Y_WIDTH": "00000000000000000000000000000100" + }, + "attributes": { + }, + "port_directions": { + "A": "input", + "B": "input", + "Y": "output" + }, + "connections": { + "A": [ 7, 10, 11, 12 ], + "B": [ 34, 35 ], + "Y": [ 36, 37, 38, 39 ] + } + }, + "\\26": { + "hide_name": 0, + "type": "$or", + "parameters": { + "A_SIGNED": "00000000000000000000000000000000", + "A_WIDTH": "00000000000000000000000000000100", + "B_SIGNED": "00000000000000000000000000000000", + "B_WIDTH": "00000000000000000000000000000100", + "Y_WIDTH": "00000000000000000000000000000100" + }, + "attributes": { + }, + "port_directions": { + "A": "input", + "B": "input", + "Y": "output" + }, + "connections": { + "A": [ 30, 31, 32, 33 ], + "B": [ 36, 37, 38, 39 ], + "Y": [ 13, 14, 15, 16 ] + } + }, + "\\5": { + "hide_name": 0, + "type": "$not", + "parameters": { + "A_SIGNED": "00000000000000000000000000000000", + "A_WIDTH": "00000000000000000000000000000001", + "Y_WIDTH": "00000000000000000000000000000001" + }, + "attributes": { + }, + "port_directions": { + "A": "input", + "Y": "output" + }, + "connections": { + "A": [ 5 ], + "Y": [ 40 ] + } + }, + "\\6": { + "hide_name": 0, + "type": "$and", + "parameters": { + "A_SIGNED": "00000000000000000000000000000000", + "A_WIDTH": "00000000000000000000000000000001", + "B_SIGNED": "00000000000000000000000000000000", + "B_WIDTH": "00000000000000000000000000000001", + "Y_WIDTH": "00000000000000000000000000000001" + }, + "attributes": { + }, + "port_directions": { + "A": "input", + "B": "input", + "Y": "output" + }, + "connections": { + "A": [ 4 ], + "B": [ 40 ], + "Y": [ 21 ] + } + }, + "\\9": { + "hide_name": 0, + "type": "$not", + "parameters": { + "A_SIGNED": "00000000000000000000000000000000", + "A_WIDTH": "00000000000000000000000000000001", + "Y_WIDTH": "00000000000000000000000000000001" + }, + "attributes": { + }, + "port_directions": { + "A": "input", + "Y": "output" + }, + "connections": { + "A": [ 4 ], + "Y": [ 8 ] + } + } + }, + "netnames": { + "$auto$ghdl.cc:764:import_module$1": { + "hide_name": 1, + "bits": [ 40 ], + "attributes": { + } + }, + "$auto$ghdl.cc:764:import_module$10": { + "hide_name": 1, + "bits": [ 34, 35 ], + "attributes": { + } + }, + "$auto$ghdl.cc:764:import_module$11": { + "hide_name": 1, + "bits": [ 36, 37, 38, 39 ], + "attributes": { + } + }, + "$auto$ghdl.cc:764:import_module$12": { + "hide_name": 1, + "bits": [ 13, 14, 15, 16 ], + "attributes": { + } + }, + "$auto$ghdl.cc:764:import_module$2": { + "hide_name": 1, + "bits": [ 21 ], + "attributes": { + } + }, + "$auto$ghdl.cc:764:import_module$3": { + "hide_name": 1, + "bits": [ 8 ], + "attributes": { + } + }, + "$auto$ghdl.cc:764:import_module$4": { + "hide_name": 1, + "bits": [ 9 ], + "attributes": { + } + }, + "$auto$ghdl.cc:764:import_module$5": { + "hide_name": 1, + "bits": [ 17, 18, 19, 20 ], + "attributes": { + } + }, + "$auto$ghdl.cc:764:import_module$6": { + "hide_name": 1, + "bits": [ 22, 23, 24, 25 ], + "attributes": { + } + }, + "$auto$ghdl.cc:764:import_module$7": { + "hide_name": 1, + "bits": [ 26, 27, 28, 29 ], + "attributes": { + } + }, + "$auto$ghdl.cc:764:import_module$9": { + "hide_name": 1, + "bits": [ 30, 31, 32, 33 ], + "attributes": { + } + }, + "C": { + "hide_name": 0, + "bits": [ 4 ], + "attributes": { + } + }, + "G": { + "hide_name": 0, + "bits": [ 5 ], + "attributes": { + } + }, + "P": { + "hide_name": 0, + "bits": [ 6 ], + "attributes": { + } + }, + "S": { + "hide_name": 0, + "bits": [ 7 ], + "attributes": { + } + }, + "clk": { + "hide_name": 0, + "bits": [ 2 ], + "attributes": { + } + }, + "pattern": { + "hide_name": 0, + "bits": [ 7, 10, 11, 12 ], + "attributes": { + "init": "0000" + } + }, + "reset": { + "hide_name": 0, + "bits": [ 3 ], + "attributes": { + } + } + } + } + } +} diff --git a/intTests/test_yosys_sequential_known_cycles/test.saw b/intTests/test_yosys_sequential_known_cycles/test.saw new file mode 100644 index 0000000000..43e865117d --- /dev/null +++ b/intTests/test_yosys_sequential_known_cycles/test.saw @@ -0,0 +1,13 @@ +enable_experimental; +m <- yosys_import_sequential "seqgen" "test.json"; +t <- yosys_extract_sequential m 10; + +sat_print w4 {{ \(c : Bit) (g : Bit) (x : Bit) -> + (t { + clk = repeat 1, + reset = [1] # zero, + C = [0, 1, 1, 1, [c]] # zero, + G = [0, 0, 0, 0, [g]] # repeat 1, + P = [0, 1, 1, 1, [x]] # zero + }).S ! 0 == 1 +}}; \ No newline at end of file diff --git a/intTests/test_yosys_sequential_known_cycles/test.sh b/intTests/test_yosys_sequential_known_cycles/test.sh new file mode 100644 index 0000000000..0b864017cd --- /dev/null +++ b/intTests/test_yosys_sequential_known_cycles/test.sh @@ -0,0 +1 @@ +$SAW test.saw diff --git a/intTests/test_yosys_sequential_sally/test.json b/intTests/test_yosys_sequential_sally/test.json new file mode 100644 index 0000000000..11aafdb2b6 --- /dev/null +++ b/intTests/test_yosys_sequential_sally/test.json @@ -0,0 +1,407 @@ +{ + "creator": "Yosys 0.10+1 (git sha1 7a7df9a3b4, gcc 10.3.0 -fPIC -Os)", + "modules": { + "seqgen": { + "attributes": { + }, + "ports": { + "clk": { + "direction": "input", + "bits": [ 2 ] + }, + "reset": { + "direction": "input", + "bits": [ 3 ] + }, + "C": { + "direction": "input", + "bits": [ 4 ] + }, + "G": { + "direction": "input", + "bits": [ 5 ] + }, + "P": { + "direction": "input", + "bits": [ 6 ] + }, + "S": { + "direction": "output", + "bits": [ 7 ] + } + }, + "cells": { + "\\10": { + "hide_name": 0, + "type": "$and", + "parameters": { + "A_SIGNED": "00000000000000000000000000000000", + "A_WIDTH": "00000000000000000000000000000001", + "B_SIGNED": "00000000000000000000000000000000", + "B_WIDTH": "00000000000000000000000000000001", + "Y_WIDTH": "00000000000000000000000000000001" + }, + "attributes": { + }, + "port_directions": { + "A": "input", + "B": "input", + "Y": "output" + }, + "connections": { + "A": [ 8 ], + "B": [ 5 ], + "Y": [ 9 ] + } + }, + "\\13": { + "hide_name": 0, + "type": "$mux", + "parameters": { + "WIDTH": "00000000000000000000000000000100" + }, + "attributes": { + }, + "port_directions": { + "A": "input", + "B": "input", + "S": "input", + "Y": "output" + }, + "connections": { + "A": [ 7, 10, 11, 12 ], + "B": [ 13, 14, 15, 16 ], + "S": [ 9 ], + "Y": [ 17, 18, 19, 20 ] + } + }, + "\\14": { + "hide_name": 0, + "type": "$mux", + "parameters": { + "WIDTH": "00000000000000000000000000000100" + }, + "attributes": { + }, + "port_directions": { + "A": "input", + "B": "input", + "S": "input", + "Y": "output" + }, + "connections": { + "A": [ 17, 18, 19, 20 ], + "B": [ 6, 7, 10, 11 ], + "S": [ 21 ], + "Y": [ 22, 23, 24, 25 ] + } + }, + "\\16": { + "hide_name": 0, + "type": "$mux", + "parameters": { + "WIDTH": "00000000000000000000000000000100" + }, + "attributes": { + }, + "port_directions": { + "A": "input", + "B": "input", + "S": "input", + "Y": "output" + }, + "connections": { + "A": [ 22, 23, 24, 25 ], + "B": [ "0", "0", "0", "0" ], + "S": [ 3 ], + "Y": [ 26, 27, 28, 29 ] + } + }, + "\\19": { + "hide_name": 0, + "type": "$dff", + "parameters": { + "CLK_POLARITY": "00000000000000000000000000000001", + "WIDTH": "00000000000000000000000000000100" + }, + "attributes": { + }, + "port_directions": { + "CLK": "input", + "D": "input", + "Q": "output" + }, + "connections": { + "CLK": [ 2 ], + "D": [ 26, 27, 28, 29 ], + "Q": [ 7, 10, 11, 12 ] + } + }, + "\\21": { + "hide_name": 0, + "type": "$shr", + "parameters": { + "A_SIGNED": "00000000000000000000000000000000", + "A_WIDTH": "00000000000000000000000000000100", + "B_SIGNED": "00000000000000000000000000000000", + "B_WIDTH": "00000000000000000000000000011111", + "Y_WIDTH": "00000000000000000000000000000100" + }, + "attributes": { + }, + "port_directions": { + "A": "input", + "B": "input", + "Y": "output" + }, + "connections": { + "A": [ 7, 10, 11, 12 ], + "B": [ "1", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0" ], + "Y": [ 30, 31, 32, 33 ] + } + }, + "\\24": { + "hide_name": 0, + "type": "$sub", + "parameters": { + "A_SIGNED": "00000000000000000000000000000000", + "A_WIDTH": "00000000000000000000000000000010", + "B_SIGNED": "00000000000000000000000000000000", + "B_WIDTH": "00000000000000000000000000000010", + "Y_WIDTH": "00000000000000000000000000000010" + }, + "attributes": { + }, + "port_directions": { + "A": "input", + "B": "input", + "Y": "output" + }, + "connections": { + "A": [ "0", "0" ], + "B": [ "1", "0" ], + "Y": [ 34, 35 ] + } + }, + "\\25": { + "hide_name": 0, + "type": "$shl", + "parameters": { + "A_SIGNED": "00000000000000000000000000000000", + "A_WIDTH": "00000000000000000000000000000100", + "B_SIGNED": "00000000000000000000000000000000", + "B_WIDTH": "00000000000000000000000000000010", + "Y_WIDTH": "00000000000000000000000000000100" + }, + "attributes": { + }, + "port_directions": { + "A": "input", + "B": "input", + "Y": "output" + }, + "connections": { + "A": [ 7, 10, 11, 12 ], + "B": [ 34, 35 ], + "Y": [ 36, 37, 38, 39 ] + } + }, + "\\26": { + "hide_name": 0, + "type": "$or", + "parameters": { + "A_SIGNED": "00000000000000000000000000000000", + "A_WIDTH": "00000000000000000000000000000100", + "B_SIGNED": "00000000000000000000000000000000", + "B_WIDTH": "00000000000000000000000000000100", + "Y_WIDTH": "00000000000000000000000000000100" + }, + "attributes": { + }, + "port_directions": { + "A": "input", + "B": "input", + "Y": "output" + }, + "connections": { + "A": [ 30, 31, 32, 33 ], + "B": [ 36, 37, 38, 39 ], + "Y": [ 13, 14, 15, 16 ] + } + }, + "\\5": { + "hide_name": 0, + "type": "$not", + "parameters": { + "A_SIGNED": "00000000000000000000000000000000", + "A_WIDTH": "00000000000000000000000000000001", + "Y_WIDTH": "00000000000000000000000000000001" + }, + "attributes": { + }, + "port_directions": { + "A": "input", + "Y": "output" + }, + "connections": { + "A": [ 5 ], + "Y": [ 40 ] + } + }, + "\\6": { + "hide_name": 0, + "type": "$and", + "parameters": { + "A_SIGNED": "00000000000000000000000000000000", + "A_WIDTH": "00000000000000000000000000000001", + "B_SIGNED": "00000000000000000000000000000000", + "B_WIDTH": "00000000000000000000000000000001", + "Y_WIDTH": "00000000000000000000000000000001" + }, + "attributes": { + }, + "port_directions": { + "A": "input", + "B": "input", + "Y": "output" + }, + "connections": { + "A": [ 4 ], + "B": [ 40 ], + "Y": [ 21 ] + } + }, + "\\9": { + "hide_name": 0, + "type": "$not", + "parameters": { + "A_SIGNED": "00000000000000000000000000000000", + "A_WIDTH": "00000000000000000000000000000001", + "Y_WIDTH": "00000000000000000000000000000001" + }, + "attributes": { + }, + "port_directions": { + "A": "input", + "Y": "output" + }, + "connections": { + "A": [ 4 ], + "Y": [ 8 ] + } + } + }, + "netnames": { + "$auto$ghdl.cc:764:import_module$1": { + "hide_name": 1, + "bits": [ 40 ], + "attributes": { + } + }, + "$auto$ghdl.cc:764:import_module$10": { + "hide_name": 1, + "bits": [ 34, 35 ], + "attributes": { + } + }, + "$auto$ghdl.cc:764:import_module$11": { + "hide_name": 1, + "bits": [ 36, 37, 38, 39 ], + "attributes": { + } + }, + "$auto$ghdl.cc:764:import_module$12": { + "hide_name": 1, + "bits": [ 13, 14, 15, 16 ], + "attributes": { + } + }, + "$auto$ghdl.cc:764:import_module$2": { + "hide_name": 1, + "bits": [ 21 ], + "attributes": { + } + }, + "$auto$ghdl.cc:764:import_module$3": { + "hide_name": 1, + "bits": [ 8 ], + "attributes": { + } + }, + "$auto$ghdl.cc:764:import_module$4": { + "hide_name": 1, + "bits": [ 9 ], + "attributes": { + } + }, + "$auto$ghdl.cc:764:import_module$5": { + "hide_name": 1, + "bits": [ 17, 18, 19, 20 ], + "attributes": { + } + }, + "$auto$ghdl.cc:764:import_module$6": { + "hide_name": 1, + "bits": [ 22, 23, 24, 25 ], + "attributes": { + } + }, + "$auto$ghdl.cc:764:import_module$7": { + "hide_name": 1, + "bits": [ 26, 27, 28, 29 ], + "attributes": { + } + }, + "$auto$ghdl.cc:764:import_module$9": { + "hide_name": 1, + "bits": [ 30, 31, 32, 33 ], + "attributes": { + } + }, + "C": { + "hide_name": 0, + "bits": [ 4 ], + "attributes": { + } + }, + "G": { + "hide_name": 0, + "bits": [ 5 ], + "attributes": { + } + }, + "P": { + "hide_name": 0, + "bits": [ 6 ], + "attributes": { + } + }, + "S": { + "hide_name": 0, + "bits": [ 7 ], + "attributes": { + } + }, + "clk": { + "hide_name": 0, + "bits": [ 2 ], + "attributes": { + } + }, + "pattern": { + "hide_name": 0, + "bits": [ 7, 10, 11, 12 ], + "attributes": { + "init": "0000" + } + }, + "reset": { + "hide_name": 0, + "bits": [ 3 ], + "attributes": { + } + } + } + } + } +} diff --git a/intTests/test_yosys_sequential_sally/test.saw b/intTests/test_yosys_sequential_sally/test.saw new file mode 100644 index 0000000000..471fc1b3a8 --- /dev/null +++ b/intTests/test_yosys_sequential_sally/test.saw @@ -0,0 +1,13 @@ +enable_experimental; +m <- yosys_import_sequential "seqgen" "test.json"; + +yosys_verify_sequential_offline_sally m "test.mcmt" {{ + \(cycles : [8]) (i : {reset : [1], C : [1], G : [1], P : [1]}) (s : {S : [1]}) -> + ( (cycles > 1) + && (i.G == 0) + && (i.C == 1) + && (i.P == 1) + ) ==> + (s.S == 1) + }} + ["C", "G", "P", "reset"]; \ No newline at end of file diff --git a/intTests/test_yosys_sequential_sally/test.sh b/intTests/test_yosys_sequential_sally/test.sh new file mode 100644 index 0000000000..0b864017cd --- /dev/null +++ b/intTests/test_yosys_sequential_sally/test.sh @@ -0,0 +1 @@ +$SAW test.saw From d4adc7547009912579069833a7fc0cc023e7cd74 Mon Sep 17 00:00:00 2001 From: Samuel Breese Date: Fri, 23 Sep 2022 23:04:26 -0400 Subject: [PATCH 34/47] Extend / truncate terms --- src/SAWScript/Yosys/Cell.hs | 63 ++++++++++++++++++++++++++----------- 1 file changed, 45 insertions(+), 18 deletions(-) diff --git a/src/SAWScript/Yosys/Cell.hs b/src/SAWScript/Yosys/Cell.hs index 32a320c025..24c37deecb 100644 --- a/src/SAWScript/Yosys/Cell.hs +++ b/src/SAWScript/Yosys/Cell.hs @@ -10,11 +10,10 @@ module SAWScript.Yosys.Cell where import Control.Lens ((^.)) -import Control.Monad (foldM) import Control.Monad.IO.Class (MonadIO(..)) import Control.Exception (throw) -import qualified Data.Foldable as Foldable +import Data.Char (digitToInt) import Data.Map (Map) import qualified Data.Map as Map import Data.Text (Text) @@ -47,10 +46,10 @@ primCellToTerm sc c args = case c ^. cellType of [ ("Y", res) ] "$neg" -> bvUnaryOp $ SC.scBvNeg sc - "$and" -> bvNAryOp $ SC.scBvAnd sc - "$or" -> bvNAryOp $ SC.scBvOr sc - "$xor" -> bvNAryOp $ SC.scBvXor sc - "$xnor" -> bvNAryOp $ \w x y -> do + "$and" -> bvBinaryOp $ SC.scBvAnd sc + "$or" -> bvBinaryOp $ SC.scBvOr sc + "$xor" -> bvBinaryOp $ SC.scBvXor sc + "$xnor" -> bvBinaryOp $ \w x y -> do r <- SC.scBvXor sc w x y SC.scBvNot sc w r "$reduce_and" -> bvReduce True =<< do @@ -180,6 +179,15 @@ primCellToTerm sc c args = case c ^. cellType of _ -> pure Nothing where nm = c ^. cellType + textBinNat :: Text -> Natural + textBinNat = fromIntegral . Text.foldl' (\a x -> digitToInt x + a * 2) 0 + connParams :: Text -> m (Maybe Natural, Bool) + connParams onm = do + let width = fmap textBinNat . Map.lookup (onm <> "_WIDTH") $ c ^. cellParameters + signed <- case Map.lookup (onm <> "_SIGNED") $ c ^. cellParameters of + Just t -> pure $ textBinNat t > 0 + Nothing -> pure False + pure (width, signed) connWidthNat :: Text -> Natural connWidthNat onm = case Map.lookup onm $ c ^. cellConnections of @@ -189,11 +197,31 @@ primCellToTerm sc c args = case c ^. cellType of connWidth onm = liftIO . SC.scNat sc $ connWidthNat onm outputWidthNat = connWidthNat "Y" outputWidth = connWidth "Y" + extTrunc :: Text -> SC.Term -> m SC.Term + extTrunc onm t = do + let bvw = connWidthNat onm + (mwidth, signed) <- connParams onm + case mwidth of + Just width + | bvw > width -> do + wterm <- liftIO $ SC.scNat sc width + diffterm <- liftIO . SC.scNat sc $ bvw - width + liftIO $ SC.scBvTrunc sc diffterm wterm t + | width > bvw && signed -> do + bvwpredterm <- liftIO . SC.scNat sc $ bvw - 1 + diffterm <- liftIO . SC.scNat sc $ width - bvw + liftIO $ SC.scBvSExt sc diffterm bvwpredterm t + | width > bvw && not signed -> do + bvwterm <- liftIO $ SC.scNat sc bvw + diffterm <- liftIO . SC.scNat sc $ width - bvw + liftIO $ SC.scBvUExt sc diffterm bvwterm t + _ -> pure t input :: Text -> m SC.Term - input inpNm = - case Map.lookup inpNm args of + input inpNm = do + raw <- case Map.lookup inpNm args of Nothing -> panic "cellToTerm" [Text.unpack $ mconcat [nm, " missing input ", inpNm]] Just a -> pure a + extTrunc inpNm raw inputNat :: Text -> m SC.Term inputNat inpNm = do v <- input inpNm @@ -210,6 +238,15 @@ primCellToTerm sc c args = case c ^. cellType of fmap Just . cryptolRecord sc $ Map.fromList [ ("Y", res) ] + bvBinaryOp :: (SC.Term -> SC.Term -> SC.Term -> IO SC.Term) -> m (Maybe SC.Term) + bvBinaryOp f = do + w <- outputWidth + ta <- input "A" + tb <- input "B" + res <- liftIO $ f w ta tb + fmap Just . cryptolRecord sc $ Map.fromList + [ ("Y", res) + ] bvBinaryArithOp :: (SC.Term -> SC.Term -> SC.Term -> IO SC.Term) -> m (Maybe SC.Term) bvBinaryArithOp f = do w <- outputWidth @@ -234,16 +271,6 @@ primCellToTerm sc c args = case c ^. cellType of fmap Just . cryptolRecord sc $ Map.fromList [ ("Y", res) ] - bvNAryOp :: (SC.Term -> SC.Term -> SC.Term -> IO SC.Term) -> m (Maybe SC.Term) - bvNAryOp f = - case Foldable.toList args of - [] -> panic "cellToTerm" [Text.unpack $ mconcat [nm, " cell given no inputs"]] - (t:rest) -> do - w <- outputWidth - res <- liftIO $ foldM (f w) t rest - fmap Just . cryptolRecord sc $ Map.fromList - [ ("Y", res) - ] bvReduce :: Bool -> SC.Term -> m (Maybe SC.Term) bvReduce boolIdentity boolFun = do t <- input "A" From 1f9d8d68a8f67d78c8308eb1cad7d9ca026406dc Mon Sep 17 00:00:00 2001 From: Samuel Breese Date: Fri, 23 Sep 2022 23:15:53 -0400 Subject: [PATCH 35/47] Use some more structured exceptions --- src/SAWScript/Yosys/Theorem.hs | 26 +++++---------------- src/SAWScript/Yosys/TransitionSystem.hs | 30 ++++++++++++------------- src/SAWScript/Yosys/Utils.hs | 29 ++++++++++++++++++++++++ 3 files changed, 49 insertions(+), 36 deletions(-) diff --git a/src/SAWScript/Yosys/Theorem.hs b/src/SAWScript/Yosys/Theorem.hs index 337bfe6e53..57f3881407 100644 --- a/src/SAWScript/Yosys/Theorem.hs +++ b/src/SAWScript/Yosys/Theorem.hs @@ -94,34 +94,18 @@ buildTheorem :: buildTheorem sc ymod newmod precond body = do cty <- case SC.ttType ymod of SC.TypedTermSchema (C.Forall [] [] cty) -> pure cty - _ -> throw . YosysError $ mconcat - [ "Term\n" - , Text.pack . SC.showTerm $ SC.ttTerm ymod - , "\ncannot be used as an override, as it does not have a monomorphic Cryptol type." - ] + _ -> throw YosysErrorInvalidOverrideTarget (cinpTy, coutTy) <- case cty of C.TCon (C.TC C.TCFun) [ci, co] -> pure (ci, co) - _ -> throw . YosysError $ mconcat - [ "Term\n" - , Text.pack . SC.showTerm $ SC.ttTerm ymod - , "\ndoes not have a Cryptol function type." - ] + _ -> throw YosysErrorInvalidOverrideTarget inpTy <- liftIO $ CSC.importType sc CSC.emptyEnv cinpTy outTy <- liftIO $ CSC.importType sc CSC.emptyEnv coutTy idx <- case SC.ttTerm ymod of (R.asConstant -> Just (SC.EC idx _ _, _)) -> pure idx - _ -> throw . YosysError $ mconcat - [ "Term\n" - , Text.pack . SC.showTerm $ SC.ttTerm ymod - , "\nis not a Yosys module." - ] + _ -> throw YosysErrorInvalidOverrideTarget uri <- liftIO (SC.scLookupNameInfo sc idx) >>= \case Just (SC.ImportedName uri _) -> pure uri - _ -> throw . YosysError $ mconcat - [ "Term\n" - , Text.pack . SC.showTerm $ SC.ttTerm ymod - , "\ndoes not call a Yosys module on either side of an equality." - ] + _ -> throw YosysErrorInvalidOverrideTarget pure YosysTheorem { _theoremURI = uri , _theoremInputCryptolType = cinpTy @@ -148,7 +132,7 @@ applyOverride :: m SC.Term applyOverride sc thm t = do tidx <- liftIO (SC.scResolveNameByURI sc $ thm ^. theoremURI) >>= \case - Nothing -> throw . YosysError $ "Could not resolve name " <> Text.pack (show $ thm ^. theoremURI) + Nothing -> throw . YosysErrorOverrideNameNotFound . URI.render $ thm ^. theoremURI Just i -> pure i unfolded <- liftIO $ SC.scUnfoldConstantSet sc False (Set.singleton tidx) t cache <- liftIO SC.newCache diff --git a/src/SAWScript/Yosys/TransitionSystem.hs b/src/SAWScript/Yosys/TransitionSystem.hs index 5544abea9f..0f2855698f 100644 --- a/src/SAWScript/Yosys/TransitionSystem.hs +++ b/src/SAWScript/Yosys/TransitionSystem.hs @@ -91,7 +91,7 @@ sequentialReprs fs = do } Some rest <- go ns pure $ Some $ Ctx.extend rest field - _ -> throw . YosysError $ "Invalid width for state field: " <> nm + _ -> throw $ YosysErrorInvalidStateFieldWidth nm ecBindingsOfFields :: MonadIO m => @@ -112,7 +112,7 @@ ecBindingsOfFields sym sc pfx fs s inp = fmap Map.fromList . forM (Map.assocs fs -> do inpExpr <- liftIO $ W4.structField sym inp idx pure . Sim.VWord $ W4.DBV inpExpr - _ -> throw . YosysError $ "Invalid field binding: " <> nm + _ -> throw $ YosysErrorTransitionSystemMissingField nm pure (baseName, (ec, val)) queryModelChecker :: @@ -153,7 +153,7 @@ queryModelChecker sym _scs sc sequential path query fixedInputs = do curInternalBindings <- ecBindingsOfFields sym sc "internal_" internalFields stateFields cur cycleVal <- case Map.lookup "cycle" curInternalBindings of Just (ec, _) -> SC.scExtCns sc ec - Nothing -> throw $ YosysError "Invalid current cycle field" + Nothing -> throw $ YosysErrorTransitionSystemMissingField "cycle" zero <- SC.scBvConst sc 8 0 wnat <- SC.scNat sc 8 cyclePred <- SC.scBvEq sc wnat cycleVal zero @@ -164,7 +164,7 @@ queryModelChecker sym _scs sc sequential path query fixedInputs = do sval <- SimW4.w4SolveBasic sym sc Map.empty args ref Set.empty cyclePred case sval of Sim.VBool b -> pure b - _ -> throw . YosysError $ "Invalid type when converting predicate to What4: " <> Text.pack (show sval) + _ -> throw YosysErrorTransitionSystemBadType , W4.stateTransitions = \input cur next -> do inputBindings <- ecBindingsOfFields sym sc "" (fst <$> variableInputFields) inputFields input curBindings <- ecBindingsOfFields sym sc "" (fst <$> (sequential ^. yosysSequentialStateFields)) stateFields cur @@ -178,7 +178,7 @@ queryModelChecker sym _scs sc sequential path query fixedInputs = do let bindings = if Set.member nm fixedInputs then curFixedInputBindings else inputBindings in case Map.lookup nm bindings of Just (ec, _) -> (nm,) <$> SC.scExtCns sc ec - Nothing -> throw . YosysError $ "Invalid input field: " <> nm + Nothing -> throw $ YosysErrorTransitionSystemMissingField nm states <- forM curBindings $ \(ec, _) -> SC.scExtCns sc ec inpst <- cryptolRecord sc states domainRec <- cryptolRecord sc $ Map.insert "__state__" inpst inps @@ -190,34 +190,34 @@ queryModelChecker sym _scs sc sequential path query fixedInputs = do wnat <- SC.scNat sc w new <- case Map.lookup nm nextBindings of Just (ec, _) -> SC.scExtCns sc ec - Nothing -> throw . YosysError $ "Invalid state update field: " <> nm + Nothing -> throw $ YosysErrorTransitionSystemMissingField nm liftIO $ SC.scBvEq sc wnat new val outputPreds <- forM (Map.assocs $ sequential ^. yosysSequentialOutputWidths) $ \(nm, w) -> do val <- cryptolRecordSelect sc codomainFields codomainRec nm wnat <- SC.scNat sc w new <- case Map.lookup nm nextOutputBindings of Just (ec, _) -> SC.scExtCns sc ec - Nothing -> throw . YosysError $ "Invalid output update field: " <> nm + Nothing -> throw $ YosysErrorTransitionSystemMissingField nm liftIO $ SC.scBvEq sc wnat new val fixedInputPreds <- forM (Map.assocs fixedInputWidths) $ \(nm, w) -> do wnat <- SC.scNat sc w val <- case Map.lookup nm curFixedInputBindings of Just (ec, _) -> SC.scExtCns sc ec - Nothing -> throw . YosysError $ "Invalid current fixed input field: " <> nm + Nothing -> throw $ YosysErrorTransitionSystemMissingField nm new <- case Map.lookup nm nextFixedInputBindings of Just (ec, _) -> SC.scExtCns sc ec - Nothing -> throw . YosysError $ "Invalid next fixed input field: " <> nm + Nothing -> throw $ YosysErrorTransitionSystemMissingField nm liftIO $ SC.scBvEq sc wnat new val cycleIncrement <- do wnat <- SC.scNat sc 8 val <- case Map.lookup "cycle" curInternalBindings of Just (ec, _) -> SC.scExtCns sc ec - Nothing -> throw $ YosysError "Invalid current cycle field" + Nothing -> throw $ YosysErrorTransitionSystemMissingField "cycle" one <- SC.scBvConst sc 8 1 incremented <- SC.scBvAdd sc wnat val one new <- case Map.lookup "cycle" nextInternalBindings of Just (ec, _) -> SC.scExtCns sc ec - Nothing -> throw $ YosysError "Invalid next cycle field" + Nothing -> throw $ YosysErrorTransitionSystemMissingField "cycle" liftIO $ SC.scBvEq sc wnat new incremented identity <- SC.scBool sc True conj <- foldM (SC.scAnd sc) identity $ stPreds <> outputPreds <> fixedInputPreds <> [cycleIncrement] @@ -235,7 +235,7 @@ queryModelChecker sym _scs sc sequential path query fixedInputs = do sval <- SimW4.w4SolveBasic sym sc Map.empty args ref Set.empty conj w4Conj <- case sval of Sim.VBool b -> pure b - _ -> throw . YosysError $ "Invalid type when converting predicate to What4: " <> Text.pack (show sval) + _ -> throw YosysErrorTransitionSystemBadType pure [ (W4.systemSymbol "default!", w4Conj) ] @@ -245,15 +245,15 @@ queryModelChecker sym _scs sc sequential path query fixedInputs = do curInternalBindings <- ecBindingsOfFields sym sc "internal_" internalFields stateFields cur fixedInps <- fmap Map.fromList . forM (Map.assocs fixedInputWidths) $ \(nm, _) -> case Map.lookup nm curFixedInputBindings of - Nothing -> throw . YosysError $ "Invalid fixed input field: " <> nm + Nothing -> throw $ YosysErrorTransitionSystemMissingField nm Just (ec, _) -> (nm,) <$> SC.scExtCns sc ec outputs <- fmap Map.fromList . forM (Map.assocs $ sequential ^. yosysSequentialOutputWidths) $ \(nm, _) -> case Map.lookup nm curOutputBindings of - Nothing -> throw . YosysError $ "Invalid output field: " <> nm + Nothing -> throw $ YosysErrorTransitionSystemMissingField nm Just (ec, _) -> (nm,) <$> SC.scExtCns sc ec cycleVal <- case Map.lookup "cycle" curInternalBindings of Just (ec, _) -> SC.scExtCns sc ec - Nothing -> throw $ YosysError "Invalid current cycle field" + Nothing -> throw $ YosysErrorTransitionSystemMissingField "cycle" fixedInputRec <- cryptolRecord sc fixedInps outputRec <- cryptolRecord sc outputs result <- liftIO $ SC.scApplyAll sc (query ^. SC.ttTermLens) [cycleVal, fixedInputRec, outputRec] diff --git a/src/SAWScript/Yosys/Utils.hs b/src/SAWScript/Yosys/Utils.hs index d261649309..63b40548bf 100644 --- a/src/SAWScript/Yosys/Utils.hs +++ b/src/SAWScript/Yosys/Utils.hs @@ -42,6 +42,11 @@ data YosysError | YosysErrorNoSuchCellType Text Text | YosysErrorUnsupportedPmux | YosysErrorUnsupportedFF Text + | YosysErrorInvalidOverrideTarget + | YosysErrorOverrideNameNotFound Text + | YosysErrorInvalidStateFieldWidth Text + | YosysErrorTransitionSystemMissingField Text + | YosysErrorTransitionSystemBadType instance Exception YosysError instance Show YosysError where show (YosysError msg) = Text.unpack $ "Error: " <> msg <> "\n" <> reportBugText @@ -88,6 +93,30 @@ instance Show YosysError where , "It may be helpful to replace certain stateful cells using the \"memory\", \"dffunmap\", and \"async2sync\" tactics within Yosys.\n" , consultYosysManual ] + show YosysErrorInvalidOverrideTarget = Text.unpack $ mconcat + [ "Error: The first argument to \"yosys_verify\" could not be identified as a Yosys module.\n" + , "This argument should typically take the form {{ m.module_name }}, where \"m\" is a record term returned by \"yosys_import\"" + ] + show (YosysErrorOverrideNameNotFound nm) = Text.unpack $ mconcat + [ "Error: The name \"", nm, "\" could not be found while applying overrides.\n" + , "This may represent a bug in SAW.\n" + , reportBugText + ] + show (YosysErrorInvalidStateFieldWidth nm) = Text.unpack $ mconcat + [ "Error: The state field \"", nm, "\" has an invalid width.\n" + , "This may represent a bug in SAW.\n" + , reportBugText + ] + show (YosysErrorTransitionSystemMissingField nm) = Text.unpack $ mconcat + [ "Error: While translating a sequential circuit to a Sally transition system, could not find the field \"", nm, "\".\n" + , "This may represent a bug in SAW.\n" + , reportBugText + ] + show YosysErrorTransitionSystemBadType = Text.unpack $ mconcat + [ "Error: While translating a sequential circuit to a Sally transition system, an intermediate What4 predicate was not a boolean.\n" + , "This may represent a bug in SAW.\n" + , reportBugText + ] mapForWithKeyM :: Monad m => Map k a -> (k -> a -> m b) -> m (Map k b) mapForWithKeyM m f = sequence $ Map.mapWithKey f m From 3077af376c6323c5a59daf6cb229f638cf81a4d0 Mon Sep 17 00:00:00 2001 From: Samuel Breese Date: Sun, 25 Sep 2022 17:27:27 -0400 Subject: [PATCH 36/47] Fix incorrect vector SAWCore type --- src/SAWScript/Yosys/Netgraph.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/SAWScript/Yosys/Netgraph.hs b/src/SAWScript/Yosys/Netgraph.hs index f3a1fc15fe..62b747d40c 100644 --- a/src/SAWScript/Yosys/Netgraph.hs +++ b/src/SAWScript/Yosys/Netgraph.hs @@ -177,12 +177,12 @@ lookupPatternTerm sc loc pat ts = one <- liftIO $ SC.scNat sc 1 boolty <- liftIO $ SC.scBoolType sc many <- liftIO . SC.scNat sc . fromIntegral $ length pat - vecty <- liftIO $ SC.scVecType sc many boolty + onety <- liftIO $ SC.scBitvector sc 1 bits <- forM pat $ \b -> do case Map.lookup [b] ts of Just t -> pure t Nothing -> throw $ YosysErrorNoSuchOutputBitvec (Text.pack $ show b) loc - vecBits <- liftIO $ SC.scVector sc vecty bits + vecBits <- liftIO $ SC.scVector sc onety bits liftIO $ SC.scJoin sc many one boolty vecBits -- | Given a netgraph and an initial map from bit patterns to terms, populate that map with terms From b57d1ae82fd0b767028bcbab616990dcc6752e91 Mon Sep 17 00:00:00 2001 From: Samuel Breese Date: Sun, 25 Sep 2022 17:28:54 -0400 Subject: [PATCH 37/47] Typecheck intermediate SAWCore terms --- src/SAWScript/Yosys/Cell.hs | 6 +++++- src/SAWScript/Yosys/Utils.hs | 19 +++++++++++++++++++ 2 files changed, 24 insertions(+), 1 deletion(-) diff --git a/src/SAWScript/Yosys/Cell.hs b/src/SAWScript/Yosys/Cell.hs index 24c37deecb..c2886aa798 100644 --- a/src/SAWScript/Yosys/Cell.hs +++ b/src/SAWScript/Yosys/Cell.hs @@ -38,7 +38,7 @@ primCellToTerm :: Cell [b] {- ^ Cell type -} -> Map Text SC.Term {- ^ Mapping of input names to input terms -} -> m (Maybe SC.Term) -primCellToTerm sc c args = case c ^. cellType of +primCellToTerm sc c args = traverse (validateTerm sc typeCheckMsg) =<< case c ^. cellType of "$not" -> bvUnaryOp $ SC.scBvNot sc "$pos" -> do res <- input "A" @@ -179,6 +179,10 @@ primCellToTerm sc c args = case c ^. cellType of _ -> pure Nothing where nm = c ^. cellType + typeCheckMsg :: Text + typeCheckMsg = mconcat + [ "translating a cell with type \"", nm, "\"" + ] textBinNat :: Text -> Natural textBinNat = fromIntegral . Text.foldl' (\a x -> digitToInt x + a * 2) 0 connParams :: Text -> m (Maybe Natural, Bool) diff --git a/src/SAWScript/Yosys/Utils.hs b/src/SAWScript/Yosys/Utils.hs index 63b40548bf..d4884459bc 100644 --- a/src/SAWScript/Yosys/Utils.hs +++ b/src/SAWScript/Yosys/Utils.hs @@ -21,6 +21,7 @@ import qualified Data.Graph as Graph import qualified Verifier.SAW.SharedTerm as SC import qualified Verifier.SAW.TypedTerm as SC +import qualified Verifier.SAW.SCTypeCheck as SC.TC import qualified Cryptol.TypeCheck.Type as C import qualified Cryptol.Utils.Ident as C @@ -38,6 +39,7 @@ data YosysBitvecConsumer data YosysError = YosysError Text + | YosysErrorTypeError Text Text | YosysErrorNoSuchOutputBitvec Text YosysBitvecConsumer | YosysErrorNoSuchCellType Text Text | YosysErrorUnsupportedPmux @@ -50,6 +52,13 @@ data YosysError instance Exception YosysError instance Show YosysError where show (YosysError msg) = Text.unpack $ "Error: " <> msg <> "\n" <> reportBugText + show (YosysErrorTypeError msg err) = Text.unpack $ mconcat + [ "Error: An internal term failed to type-check.\n" + , "This occured while ", msg, ".\n" + , "The type error was:\n", err + , "This may represent a bug in SAW.\n" + , reportBugText + ] show (YosysErrorNoSuchOutputBitvec bvec (YosysBitvecConsumerOutputPort onm)) = Text.unpack $ mconcat [ "Error: Could not find the output bitvector ", bvec , ", which is connected to a module output port \"", onm @@ -129,6 +138,16 @@ reverseTopSort = reverse . Graph.topSort #endif +validateTerm :: MonadIO m => SC.SharedContext -> Text -> SC.Term -> m SC.Term +validateTerm sc msg t = liftIO (SC.TC.scTypeCheck sc Nothing t) >>= \case + Right _ -> pure t + Left err -> + throw + . YosysErrorTypeError msg + . Text.pack + . unlines + $ SC.TC.prettyTCError err + cryptolRecordType :: MonadIO m => SC.SharedContext -> From 6ef682da5a33a4161b13f2162801b9896eea4d4c Mon Sep 17 00:00:00 2001 From: Samuel Breese Date: Sun, 25 Sep 2022 18:28:01 -0400 Subject: [PATCH 38/47] Typecheck some additional intermediate SAWCore terms --- src/SAWScript/Yosys.hs | 8 ++++++-- src/SAWScript/Yosys/State.hs | 1 + src/SAWScript/Yosys/Theorem.hs | 16 ++++++++++++---- 3 files changed, 19 insertions(+), 6 deletions(-) diff --git a/src/SAWScript/Yosys.hs b/src/SAWScript/Yosys.hs index 85508fd377..bf27275cdd 100644 --- a/src/SAWScript/Yosys.hs +++ b/src/SAWScript/Yosys.hs @@ -159,7 +159,9 @@ yosys_import :: FilePath -> TopLevel SC.TypedTerm yosys_import path = do sc <- getSharedContext ir <- loadYosysIR path - yosysIRToRecordTerm sc ir + tt <- yosysIRToRecordTerm sc ir + _ <- validateTerm sc "translating combinational circuits" $ SC.ttTerm tt + pure tt yosys_verify :: SC.TypedTerm -> [SC.TypedTerm] -> SC.TypedTerm -> [YosysTheorem] -> ProofScript () -> TopLevel YosysTheorem yosys_verify ymod preconds other specs tactic = do @@ -186,7 +188,9 @@ yosys_import_sequential nm path = do yosys_extract_sequential :: YosysSequential -> Integer -> TopLevel SC.TypedTerm yosys_extract_sequential s n = do sc <- getSharedContext - composeYosysSequential sc s n + tt <- composeYosysSequential sc s n + _ <- validateTerm sc "composing a sequential term" $ SC.ttTerm tt + pure tt yosys_extract_sequential_raw :: YosysSequential -> TopLevel SC.TypedTerm yosys_extract_sequential_raw s = pure $ s ^. yosysSequentialTerm diff --git a/src/SAWScript/Yosys/State.hs b/src/SAWScript/Yosys/State.hs index 5c11f419ae..d82b51633c 100644 --- a/src/SAWScript/Yosys/State.hs +++ b/src/SAWScript/Yosys/State.hs @@ -173,6 +173,7 @@ convertModuleInline sc m = do -- construct result t <- liftIO $ SC.scAbstractExts sc [domainRecordEC] outputRecord -- ty <- liftIO $ SC.scFun sc domainRecordType codomainRecordType + validateTerm sc "translating a sequential circuit" t let cty = C.tFun domainCryptolRecordType codomainCryptolRecordType pure YosysSequential { _yosysSequentialTerm = SC.TypedTerm (SC.TypedTermSchema $ C.tMono cty) t diff --git a/src/SAWScript/Yosys/Theorem.hs b/src/SAWScript/Yosys/Theorem.hs index 57f3881407..5ea2ce7f54 100644 --- a/src/SAWScript/Yosys/Theorem.hs +++ b/src/SAWScript/Yosys/Theorem.hs @@ -14,7 +14,6 @@ import Control.Monad.IO.Class (MonadIO(..)) import Control.Exception (throw) import Control.Monad.Catch (MonadThrow) -import qualified Data.Text as Text import Data.Text (Text) import qualified Data.Set as Set import Data.Map (Map) @@ -64,7 +63,10 @@ theoremProp sc thm = do liftIO $ SC.scImplies sc pcr equality func <- liftIO $ SC.scAbstractExts sc [ec] res let cty = C.tFun (thm ^. theoremInputCryptolType) C.tBit - pure $ SC.TypedTerm (SC.TypedTermSchema $ C.tMono cty) func + SC.TypedTerm (SC.TypedTermSchema $ C.tMono cty) + <$> validateTerm sc + ("constructing a proposition while verifying " <> URI.render (thm ^. theoremURI)) + func theoremReplacement :: (MonadIO m, MonadThrow m) => @@ -81,7 +83,10 @@ theoremReplacement sc thm = do thenCase <- liftIO $ SC.scApply sc (thm ^. theoremBody) r elseCase <- liftIO $ SC.scApply sc (thm ^. theoremModule) r liftIO $ SC.scIte sc (thm ^. theoremOutputType) precond thenCase elseCase - liftIO $ SC.scAbstractExts sc [ec] body + ft <- liftIO $ SC.scAbstractExts sc [ec] body + validateTerm sc + ("constructing an override replacement for " <> URI.render (thm ^. theoremURI)) + ft buildTheorem :: (MonadIO m, MonadThrow m) => @@ -148,4 +153,7 @@ applyOverride sc thm t = do | idx == tidx -> theoremReplacement sc thm | otherwise -> pure s _ -> SC.scTermF sc =<< traverse go tf - liftIO $ go unfolded + ft <- liftIO $ go unfolded + validateTerm sc + ("applying an override for " <> URI.render (thm ^. theoremURI)) + ft From 3e3c20d4586522d79e811ddc3adc941633165ba8 Mon Sep 17 00:00:00 2001 From: Samuel Breese Date: Sun, 25 Sep 2022 19:25:22 -0400 Subject: [PATCH 39/47] Fix warning --- src/SAWScript/Yosys/State.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/SAWScript/Yosys/State.hs b/src/SAWScript/Yosys/State.hs index d82b51633c..a87340aa60 100644 --- a/src/SAWScript/Yosys/State.hs +++ b/src/SAWScript/Yosys/State.hs @@ -173,7 +173,7 @@ convertModuleInline sc m = do -- construct result t <- liftIO $ SC.scAbstractExts sc [domainRecordEC] outputRecord -- ty <- liftIO $ SC.scFun sc domainRecordType codomainRecordType - validateTerm sc "translating a sequential circuit" t + _ <- validateTerm sc "translating a sequential circuit" t let cty = C.tFun domainCryptolRecordType codomainCryptolRecordType pure YosysSequential { _yosysSequentialTerm = SC.TypedTerm (SC.TypedTermSchema $ C.tMono cty) t From 958e2d8de0ce28d0b9371f6dc93d496f3ebb72d8 Mon Sep 17 00:00:00 2001 From: Samuel Breese Date: Sun, 25 Sep 2022 21:30:43 -0400 Subject: [PATCH 40/47] Support implicit Yosys extensions and truncations --- intTests/test_yosys_verilog/test.json | 82 ++++++++++++++++ intTests/test_yosys_verilog/test.saw | 10 ++ intTests/test_yosys_verilog/test.sh | 1 + src/SAWScript/Yosys/Cell.hs | 135 +++++++++++--------------- 4 files changed, 150 insertions(+), 78 deletions(-) create mode 100644 intTests/test_yosys_verilog/test.json create mode 100644 intTests/test_yosys_verilog/test.saw create mode 100644 intTests/test_yosys_verilog/test.sh diff --git a/intTests/test_yosys_verilog/test.json b/intTests/test_yosys_verilog/test.json new file mode 100644 index 0000000000..3e1b1c7a0f --- /dev/null +++ b/intTests/test_yosys_verilog/test.json @@ -0,0 +1,82 @@ +{ + "creator": "Yosys 0.20+42 (git sha1 1c36f4cc2, x86_64-apple-darwin20.2-clang 10.0.0-4ubuntu1 -fPIC -Os)", + "modules": { + "fulladd": { + "attributes": { + "cells_not_processed": "00000000000000000000000000000001" + }, + "ports": { + "a": { + "direction": "input", + "bits": [ 2, 3, 4, 5 ] + }, + "b": { + "direction": "input", + "bits": [ 6, 7, 8, 9 ] + }, + "c_in": { + "direction": "input", + "bits": [ 10 ] + }, + "c_out": { + "direction": "output", + "bits": [ 11 ] + }, + "sum": { + "direction": "output", + "bits": [ 12, 13, 14, 15 ] + } + }, + "cells": { + "$1": { + "hide_name": 1, + "type": "$add", + "parameters": { + "A_SIGNED": "00000000000000000000000000000000", + "A_WIDTH": "00000000000000000000000000000100", + "B_SIGNED": "00000000000000000000000000000000", + "B_WIDTH": "00000000000000000000000000000100", + "Y_WIDTH": "00000000000000000000000000000101" + }, + "attributes": { + }, + "port_directions": { + "A": "input", + "B": "input", + "Y": "output" + }, + "connections": { + "A": [ 2, 3, 4, 5 ], + "B": [ 6, 7, 8, 9 ], + "Y": [ 16, 17, 18, 19, 20 ] + } + }, + "$2": { + "hide_name": 1, + "type": "$add", + "parameters": { + "A_SIGNED": "00000000000000000000000000000000", + "A_WIDTH": "00000000000000000000000000000101", + "B_SIGNED": "00000000000000000000000000000000", + "B_WIDTH": "00000000000000000000000000000001", + "Y_WIDTH": "00000000000000000000000000000101" + }, + "attributes": { + }, + "port_directions": { + "A": "input", + "B": "input", + "Y": "output" + }, + "connections": { + "A": [ 16, 17, 18, 19, 20 ], + "B": [ 10 ], + "Y": [ 12, 13, 14, 15, 11 ] + } + } + }, + "netnames": { + } + } + } +} diff --git a/intTests/test_yosys_verilog/test.saw b/intTests/test_yosys_verilog/test.saw new file mode 100644 index 0000000000..ca34c8e92a --- /dev/null +++ b/intTests/test_yosys_verilog/test.saw @@ -0,0 +1,10 @@ +enable_experimental; +m <- yosys_import "test.json"; + +let {{ + cryfull : {a : [4], b : [4], c_in : [1]} -> {c_out : [1], sum : [4]} + cryfull inp = { c_out = cout, sum = reverse s } + where (cout, s) = splitAt (zext (reverse inp.a) + zext (reverse inp.b) + zext inp.c_in) +}}; + +prove_print w4 {{ m.fulladd === cryfull }}; \ No newline at end of file diff --git a/intTests/test_yosys_verilog/test.sh b/intTests/test_yosys_verilog/test.sh new file mode 100644 index 0000000000..0b864017cd --- /dev/null +++ b/intTests/test_yosys_verilog/test.sh @@ -0,0 +1 @@ +$SAW test.saw diff --git a/src/SAWScript/Yosys/Cell.hs b/src/SAWScript/Yosys/Cell.hs index c2886aa798..90a8c04362 100644 --- a/src/SAWScript/Yosys/Cell.hs +++ b/src/SAWScript/Yosys/Cell.hs @@ -42,9 +42,7 @@ primCellToTerm sc c args = traverse (validateTerm sc typeCheckMsg) =<< case c ^. "$not" -> bvUnaryOp $ SC.scBvNot sc "$pos" -> do res <- input "A" - fmap Just . cryptolRecord sc $ Map.fromList - [ ("Y", res) - ] + output res "$neg" -> bvUnaryOp $ SC.scBvNeg sc "$and" -> bvBinaryOp $ SC.scBvAnd sc "$or" -> bvBinaryOp $ SC.scBvOr sc @@ -74,33 +72,25 @@ primCellToTerm sc c args = traverse (validateTerm sc typeCheckMsg) =<< case c ^. nb <- inputNat "B" w <- outputWidth res <- liftIO $ SC.scBvShl sc w ta nb - fmap Just . cryptolRecord sc $ Map.fromList - [ ("Y", res) - ] + output res "$shr" -> do ta <- input "A" nb <- inputNat "B" w <- outputWidth res <- liftIO $ SC.scBvShr sc w ta nb - fmap Just . cryptolRecord sc $ Map.fromList - [ ("Y", res) - ] + output res "$sshl" -> do ta <- input "A" nb <- inputNat "B" w <- outputWidth res <- liftIO $ SC.scBvShl sc w ta nb - fmap Just . cryptolRecord sc $ Map.fromList - [ ("Y", res) - ] + output res "$sshr" -> do ta <- input "A" nb <- inputNat "B" w <- outputWidth res <- liftIO $ SC.scBvSShr sc w ta nb - fmap Just . cryptolRecord sc $ Map.fromList - [ ("Y", res) - ] + output res -- "$shift" -> _ -- "$shiftx" -> _ "$lt" -> bvBinaryCmp $ SC.scBvULt sc @@ -126,9 +116,7 @@ primCellToTerm sc c args = traverse (validateTerm sc typeCheckMsg) =<< case c ^. ta <- input "A" anz <- liftIO $ SC.scBvNonzero sc w ta res <- liftIO $ SC.scNot sc anz - fmap Just . cryptolRecord sc $ Map.fromList - [ ("Y", res) - ] + output res "$logic_and" -> do w <- outputWidth ta <- input "A" @@ -136,9 +124,7 @@ primCellToTerm sc c args = traverse (validateTerm sc typeCheckMsg) =<< case c ^. anz <- liftIO $ SC.scBvNonzero sc w ta bnz <- liftIO $ SC.scBvNonzero sc w tb res <- liftIO $ SC.scAnd sc anz bnz - fmap Just . cryptolRecord sc $ Map.fromList - [ ("Y", res) - ] + output res "$logic_or" -> do w <- outputWidth ta <- input "A" @@ -146,9 +132,7 @@ primCellToTerm sc c args = traverse (validateTerm sc typeCheckMsg) =<< case c ^. anz <- liftIO $ SC.scBvNonzero sc w ta bnz <- liftIO $ SC.scBvNonzero sc w tb res <- liftIO $ SC.scOr sc anz bnz - fmap Just . cryptolRecord sc $ Map.fromList - [ ("Y", res) - ] + output res "$mux" -> do ta <- input "A" tb <- input "B" @@ -157,9 +141,7 @@ primCellToTerm sc c args = traverse (validateTerm sc typeCheckMsg) =<< case c ^. snz <- liftIO $ SC.scBvNonzero sc swidth ts ty <- liftIO $ SC.scBitvector sc outputWidthNat res <- liftIO $ SC.scIte sc ty snz tb ta - fmap Just . cryptolRecord sc $ Map.fromList - [ ("Y", res) - ] + output res "$pmux" -> throw YosysErrorUnsupportedPmux "$adff" -> throw $ YosysErrorUnsupportedFF "$adff" "$sdff" -> throw $ YosysErrorUnsupportedFF "$sdff" @@ -185,13 +167,11 @@ primCellToTerm sc c args = traverse (validateTerm sc typeCheckMsg) =<< case c ^. ] textBinNat :: Text -> Natural textBinNat = fromIntegral . Text.foldl' (\a x -> digitToInt x + a * 2) 0 - connParams :: Text -> m (Maybe Natural, Bool) - connParams onm = do - let width = fmap textBinNat . Map.lookup (onm <> "_WIDTH") $ c ^. cellParameters - signed <- case Map.lookup (onm <> "_SIGNED") $ c ^. cellParameters of - Just t -> pure $ textBinNat t > 0 - Nothing -> pure False - pure (width, signed) + connSigned :: Text -> Bool + connSigned onm = + case Map.lookup (onm <> "_SIGNED") $ c ^. cellParameters of + Just t -> textBinNat t > 0 + Nothing -> False connWidthNat :: Text -> Natural connWidthNat onm = case Map.lookup onm $ c ^. cellConnections of @@ -204,66 +184,69 @@ primCellToTerm sc c args = traverse (validateTerm sc typeCheckMsg) =<< case c ^. extTrunc :: Text -> SC.Term -> m SC.Term extTrunc onm t = do let bvw = connWidthNat onm - (mwidth, signed) <- connParams onm - case mwidth of - Just width - | bvw > width -> do - wterm <- liftIO $ SC.scNat sc width - diffterm <- liftIO . SC.scNat sc $ bvw - width - liftIO $ SC.scBvTrunc sc diffterm wterm t - | width > bvw && signed -> do - bvwpredterm <- liftIO . SC.scNat sc $ bvw - 1 - diffterm <- liftIO . SC.scNat sc $ width - bvw - liftIO $ SC.scBvSExt sc diffterm bvwpredterm t - | width > bvw && not signed -> do - bvwterm <- liftIO $ SC.scNat sc bvw - diffterm <- liftIO . SC.scNat sc $ width - bvw - liftIO $ SC.scBvUExt sc diffterm bvwterm t - _ -> pure t - input :: Text -> m SC.Term - input inpNm = do - raw <- case Map.lookup inpNm args of + let width = outputWidthNat + let signed = connSigned onm + if + | bvw > width -> do + wterm <- liftIO $ SC.scNat sc width + diffterm <- liftIO . SC.scNat sc $ bvw - width + liftIO $ SC.scBvTrunc sc diffterm wterm t + | width > bvw && signed -> do + bvwpredterm <- liftIO . SC.scNat sc $ bvw - 1 + diffterm <- liftIO . SC.scNat sc $ width - bvw + liftIO $ SC.scBvSExt sc diffterm bvwpredterm t + | width > bvw && not signed -> do + bvwterm <- liftIO $ SC.scNat sc bvw + diffterm <- liftIO . SC.scNat sc $ width - bvw + liftIO $ SC.scBvUExt sc diffterm bvwterm t + | otherwise -> pure t + inputRaw :: Text -> m SC.Term + inputRaw inpNm = + case Map.lookup inpNm args of Nothing -> panic "cellToTerm" [Text.unpack $ mconcat [nm, " missing input ", inpNm]] Just a -> pure a - extTrunc inpNm raw + input :: Text -> m SC.Term + input inpNm = extTrunc inpNm =<< inputRaw inpNm + inputRev :: Text -> m SC.Term + inputRev inpNm = do + raw <- inputRaw inpNm + w <- connWidth inpNm + bool <- liftIO $ SC.scBoolType sc + rev <- liftIO $ SC.scGlobalApply sc "Prelude.reverse" [w, bool, raw] + extTrunc inpNm rev inputNat :: Text -> m SC.Term inputNat inpNm = do - v <- input inpNm w <- connWidth inpNm - bool <- liftIO $ SC.scBoolType sc - rev <- liftIO $ SC.scGlobalApply sc "Prelude.reverse" [w, bool, v] - -- note bvToNat is big-endian while yosys shifts expect little-endian + rev <- inputRev inpNm -- note bvToNat is big-endian while yosys shifts expect little-endian liftIO $ SC.scGlobalApply sc "Prelude.bvToNat" [w, rev] + output :: SC.Term -> m (Maybe SC.Term) + output res = do + eres <- extTrunc "Y" res + fmap Just . cryptolRecord sc $ Map.fromList + [ ("Y", eres) + ] bvUnaryOp :: (SC.Term -> SC.Term -> IO SC.Term) -> m (Maybe SC.Term) bvUnaryOp f = do t <- input "A" w <- outputWidth res <- liftIO $ f w t - fmap Just . cryptolRecord sc $ Map.fromList - [ ("Y", res) - ] + output res bvBinaryOp :: (SC.Term -> SC.Term -> SC.Term -> IO SC.Term) -> m (Maybe SC.Term) bvBinaryOp f = do w <- outputWidth ta <- input "A" tb <- input "B" res <- liftIO $ f w ta tb - fmap Just . cryptolRecord sc $ Map.fromList - [ ("Y", res) - ] + output res bvBinaryArithOp :: (SC.Term -> SC.Term -> SC.Term -> IO SC.Term) -> m (Maybe SC.Term) bvBinaryArithOp f = do w <- outputWidth bool <- liftIO $ SC.scBoolType sc - ta <- input "A" - reva <- liftIO $ SC.scGlobalApply sc "Prelude.reverse" [w, bool, ta] - tb <- input "B" - revb <- liftIO $ SC.scGlobalApply sc "Prelude.reverse" [w, bool, tb] - res <- liftIO $ f w reva revb + ta <- inputRev "A" + tb <- inputRev "B" + res <- liftIO $ f w ta tb revres <- liftIO $ SC.scGlobalApply sc "Prelude.reverse" [w, bool, res] - fmap Just . cryptolRecord sc $ Map.fromList - [ ("Y", revres) - ] + output revres bvBinaryCmp :: (SC.Term -> SC.Term -> SC.Term -> IO SC.Term) -> m (Maybe SC.Term) bvBinaryCmp f = do ta <- input "A" @@ -272,9 +255,7 @@ primCellToTerm sc c args = traverse (validateTerm sc typeCheckMsg) =<< case c ^. bit <- liftIO $ f w ta tb boolty <- liftIO $ SC.scBoolType sc res <- liftIO $ SC.scSingle sc boolty bit - fmap Just . cryptolRecord sc $ Map.fromList - [ ("Y", res) - ] + output res bvReduce :: Bool -> SC.Term -> m (Maybe SC.Term) bvReduce boolIdentity boolFun = do t <- input "A" @@ -285,6 +266,4 @@ primCellToTerm sc c args = traverse (validateTerm sc typeCheckMsg) =<< case c ^. bit <- liftIO $ SC.scApplyAll sc scFoldr [boolTy, boolTy, w, boolFun, identity, t] boolty <- liftIO $ SC.scBoolType sc res <- liftIO $ SC.scSingle sc boolty bit - fmap Just . cryptolRecord sc $ Map.fromList - [ ("Y", res) - ] + output res From 52787e157dd7b7617eeb8a427de8fb2426e29e86 Mon Sep 17 00:00:00 2001 From: Samuel Breese Date: Sun, 25 Sep 2022 22:51:53 -0400 Subject: [PATCH 41/47] Add zenc dependency --- saw-script.cabal | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/saw-script.cabal b/saw-script.cabal index 7fa6d4e99c..5f739f5146 100644 --- a/saw-script.cabal +++ b/saw-script.cabal @@ -23,6 +23,7 @@ library default-language: Haskell2010 build-depends: base >= 4 + , aeson >= 1.4.2 && < 2.0 , aig , array , binary @@ -38,12 +39,14 @@ library , crucible-llvm >= 0.2 , deepseq , either + , elf-edit , exceptions , executable-path , extra , directory >= 1.2.4.0 , fgl , filepath + , flexdis86 , free , haskeline , heapster-saw @@ -51,9 +54,14 @@ library , galois-dwarf >= 0.2.2 , IfElse , jvm-parser + , language-sally , lens , llvm-pretty >= 0.8 , llvm-pretty-bc-parser >= 0.1.3.1 + , macaw-base + , macaw-x86 + , macaw-symbolic + , macaw-x86-symbolic , modern-uri >= 0.3.2 && < 0.4 , mtl >= 2.1 , old-locale @@ -65,6 +73,7 @@ library , prettyprinter , pretty-show , process + , reflection , rme , saw-core , saw-core-aig @@ -82,19 +91,10 @@ library , transformers-compat , unordered-containers , utf8-string + , vector , what4 >= 0.4 , what4-transition-system - , language-sally - , vector - , GraphSCC - , macaw-base - , macaw-x86 - , macaw-symbolic - , macaw-x86-symbolic - , flexdis86 - , elf-edit - , reflection - , aeson >= 1.4.2 && < 2.0 + , zenc hs-source-dirs: src From 644a604c044cbb5e2450ed223a0c99f2a61262f3 Mon Sep 17 00:00:00 2001 From: Samuel Breese Date: Sun, 25 Sep 2022 22:52:56 -0400 Subject: [PATCH 42/47] Ensure that state field names are valid Cryptol identifiers --- src/SAWScript/Yosys/Cell.hs | 7 +++++-- src/SAWScript/Yosys/State.hs | 8 +++++++- 2 files changed, 12 insertions(+), 3 deletions(-) diff --git a/src/SAWScript/Yosys/Cell.hs b/src/SAWScript/Yosys/Cell.hs index 90a8c04362..38009549c9 100644 --- a/src/SAWScript/Yosys/Cell.hs +++ b/src/SAWScript/Yosys/Cell.hs @@ -136,7 +136,7 @@ primCellToTerm sc c args = traverse (validateTerm sc typeCheckMsg) =<< case c ^. "$mux" -> do ta <- input "A" tb <- input "B" - ts <- input "S" + ts <- inputRaw "S" swidth <- connWidth "S" snz <- liftIO $ SC.scBvNonzero sc swidth ts ty <- liftIO $ SC.scBitvector sc outputWidthNat @@ -216,8 +216,11 @@ primCellToTerm sc c args = traverse (validateTerm sc typeCheckMsg) =<< case c ^. extTrunc inpNm rev inputNat :: Text -> m SC.Term inputNat inpNm = do + raw <- inputRaw inpNm w <- connWidth inpNm - rev <- inputRev inpNm -- note bvToNat is big-endian while yosys shifts expect little-endian + bool <- liftIO $ SC.scBoolType sc + rev <- liftIO $ SC.scGlobalApply sc "Prelude.reverse" [w, bool, raw] + -- note bvToNat is big-endian while yosys shifts expect little-endian liftIO $ SC.scGlobalApply sc "Prelude.bvToNat" [w, rev] output :: SC.Term -> m (Maybe SC.Term) output res = do diff --git a/src/SAWScript/Yosys/State.hs b/src/SAWScript/Yosys/State.hs index a87340aa60..568e370908 100644 --- a/src/SAWScript/Yosys/State.hs +++ b/src/SAWScript/Yosys/State.hs @@ -19,10 +19,13 @@ import Data.Bifunctor (bimap) import Data.Map (Map) import qualified Data.Map as Map import Data.Text (Text) +import qualified Data.Text as Text import qualified Data.Graph as Graph import Numeric.Natural (Natural) +import Text.Encoding.Z (zEncodeString) + import qualified Verifier.SAW.SharedTerm as SC import qualified Verifier.SAW.TypedTerm as SC import qualified Verifier.SAW.Name as SC @@ -37,13 +40,16 @@ import SAWScript.Yosys.Utils import SAWScript.Yosys.IR import SAWScript.Yosys.Netgraph +cellIdentifier :: Text -> Text +cellIdentifier = Text.pack . zEncodeString . Text.unpack + findDffs :: Netgraph Bitrep -> Map Text (Cell [Bitrep]) findDffs ng = Map.fromList . filter (\(_, c) -> c ^. cellType == "$dff") - . fmap (\v -> let (n, _, _) = ng ^. netgraphNodeFromVertex $ v in n) + . fmap (\v -> let ((nm, n), _, _) = ng ^. netgraphNodeFromVertex $ v in (cellIdentifier nm, n)) . Graph.vertices $ ng ^. netgraphGraph From 9993b43cb2e221599807272a9edb8fc5007b1355 Mon Sep 17 00:00:00 2001 From: Samuel Breese Date: Sun, 25 Sep 2022 23:33:55 -0400 Subject: [PATCH 43/47] Add yosys_extract_sequential_with_state --- src/SAWScript/Interpreter.hs | 6 +++++ src/SAWScript/Yosys.hs | 8 +++++++ src/SAWScript/Yosys/State.hs | 44 ++++++++++++++++++++++++++++-------- 3 files changed, 49 insertions(+), 9 deletions(-) diff --git a/src/SAWScript/Interpreter.hs b/src/SAWScript/Interpreter.hs index c9d03489cd..6da478424c 100644 --- a/src/SAWScript/Interpreter.hs +++ b/src/SAWScript/Interpreter.hs @@ -3681,6 +3681,12 @@ primitives = Map.fromList , "This term can be used like a normal SAW term - it may be embedded in Cryptol expressions, used in prove and sat, etc." ] + , prim "yosys_extract_sequential_with_state" "YosysSequential -> Int -> TopLevel Term" + (pureVal yosys_extract_sequential_with_state) + Experimental + [ "Like yosys_extract_sequential, but the resulting term has an additional parameter to specify the initial state." + ] + , prim "yosys_extract_sequential_raw" "YosysSequential -> TopLevel Term" (pureVal yosys_extract_sequential_raw) Experimental diff --git a/src/SAWScript/Yosys.hs b/src/SAWScript/Yosys.hs index bf27275cdd..7f2fdd22e8 100644 --- a/src/SAWScript/Yosys.hs +++ b/src/SAWScript/Yosys.hs @@ -13,6 +13,7 @@ module SAWScript.Yosys , yosys_verify , yosys_import_sequential , yosys_extract_sequential + , yosys_extract_sequential_with_state , yosys_extract_sequential_raw , yosys_verify_sequential_sally , loadYosysIR @@ -192,6 +193,13 @@ yosys_extract_sequential s n = do _ <- validateTerm sc "composing a sequential term" $ SC.ttTerm tt pure tt +yosys_extract_sequential_with_state :: YosysSequential -> Integer -> TopLevel SC.TypedTerm +yosys_extract_sequential_with_state s n = do + sc <- getSharedContext + tt <- composeYosysSequentialWithState sc s n + _ <- validateTerm sc "composing a sequential term with state" $ SC.ttTerm tt + pure tt + yosys_extract_sequential_raw :: YosysSequential -> TopLevel SC.TypedTerm yosys_extract_sequential_raw s = pure $ s ^. yosysSequentialTerm diff --git a/src/SAWScript/Yosys/State.hs b/src/SAWScript/Yosys/State.hs index 568e370908..4f4ba79c1a 100644 --- a/src/SAWScript/Yosys/State.hs +++ b/src/SAWScript/Yosys/State.hs @@ -191,14 +191,14 @@ convertModuleInline sc m = do , _yosysSequentialStateWidths = stateWidths } -composeYosysSequential :: +composeYosysSequentialHelper :: forall m. MonadIO m => SC.SharedContext -> YosysSequential -> Integer -> - m SC.TypedTerm -composeYosysSequential sc s n = do + m (SC.Term, C.Type) +composeYosysSequentialHelper sc s n = do let t = SC.ttTerm $ s ^. yosysSequentialTerm width <- liftIO . SC.scNat sc $ fromIntegral n @@ -260,13 +260,39 @@ composeYosysSequential sc s n = do pure (st', mergedOuts) stateType <- fieldsToType sc $ s ^. yosysSequentialStateFields - initialStateMsg <- liftIO $ SC.scString sc "Attempted to read initial state of sequential circuit" - initialState <- liftIO $ SC.scGlobalApply sc (SC.mkIdent SC.preludeName "error") [stateType, initialStateMsg] - -- initialStateFields <- forM (s ^. yosysSequentialStateWidths) $ \w -> do - -- liftIO $ SC.scBvConst sc w 0 - -- initialState <- cryptolRecord sc initialStateFields + initialStateEC <- liftIO $ SC.scFreshEC sc "initial_state" stateType + initialState <- liftIO $ SC.scExtCns sc initialStateEC (_, outputs) <- foldM (\acc i -> compose1 i acc) (initialState, Map.empty) [0..n] + outputRecord <- cryptolRecord sc outputs - res <- liftIO $ SC.scAbstractExts sc [extendedInputRecordEC] outputRecord + res <- liftIO $ SC.scAbstractExts sc [initialStateEC, extendedInputRecordEC] outputRecord let cty = C.tFun extendedInputCryptolType extendedOutputCryptolType + + pure (res, cty) + +composeYosysSequential :: + forall m. + MonadIO m => + SC.SharedContext -> + YosysSequential -> + Integer -> + m SC.TypedTerm +composeYosysSequential sc s n = do + (t, cty) <- composeYosysSequentialHelper sc s n + stateType <- fieldsToType sc $ s ^. yosysSequentialStateFields + initialStateMsg <- liftIO $ SC.scString sc "Attempted to read initial state of sequential circuit" + initialState <- liftIO $ SC.scGlobalApply sc (SC.mkIdent SC.preludeName "error") [stateType, initialStateMsg] + res <- liftIO $ SC.scApply sc t initialState pure $ SC.TypedTerm (SC.TypedTermSchema $ C.tMono cty) res + +composeYosysSequentialWithState :: + forall m. + MonadIO m => + SC.SharedContext -> + YosysSequential -> + Integer -> + m SC.TypedTerm +composeYosysSequentialWithState sc s n = do + (t, cty) <- composeYosysSequentialHelper sc s n + scty <- fieldsToCryptolType $ s ^. yosysSequentialStateFields + pure $ SC.TypedTerm (SC.TypedTermSchema . C.tMono $ C.tFun scty cty) t From d093dee533e3b4a0924afa0b1f3b05172ded0f90 Mon Sep 17 00:00:00 2001 From: Samuel Breese Date: Sun, 25 Sep 2022 23:51:52 -0400 Subject: [PATCH 44/47] Revert change to s2nTests/docker/saw.dockerfile --- s2nTests/docker/saw.dockerfile | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/s2nTests/docker/saw.dockerfile b/s2nTests/docker/saw.dockerfile index 29f8e11910..4eb83bf9d4 100644 --- a/s2nTests/docker/saw.dockerfile +++ b/s2nTests/docker/saw.dockerfile @@ -39,7 +39,7 @@ RUN curl -L https://github.com/CVC4/CVC4/releases/download/1.8/cvc4-1.8-x86_64-l # Set executable and run tests RUN chmod +x rootfs/usr/local/bin/* -FROM haskell:8.10.7-buster AS build +FROM haskell:8.8.4-stretch AS build USER root RUN apt-get update && apt-get install -y wget libncurses-dev unzip COPY --from=solvers /solvers/rootfs / @@ -49,11 +49,11 @@ USER saw WORKDIR /home/saw ENV LANG=C.UTF-8 \ LC_ALL=C.UTF-8 -COPY cabal.GHC-8.10.7.config cabal.project.freeze -RUN cabal update -RUN cabal build +COPY cabal.GHC-8.8.4.config cabal.project.freeze +RUN cabal v2-update +RUN cabal v2-build RUN mkdir -p /home/saw/rootfs/usr/local/bin -RUN cp $(cabal exec which saw) /home/saw/rootfs/usr/local/bin/saw +RUN cp $(cabal v2-exec which saw) /home/saw/rootfs/usr/local/bin/saw WORKDIR /home/saw USER root RUN chown -R root:root /home/saw/rootfs From 1a76325bd6f3c1586934481ca2a45c463bc87ed9 Mon Sep 17 00:00:00 2001 From: Samuel Breese Date: Wed, 28 Sep 2022 14:47:08 -0400 Subject: [PATCH 45/47] More aggressively check combinational terms, fix bit outputs --- src/SAWScript/Yosys.hs | 1 + src/SAWScript/Yosys/Cell.hs | 27 ++++++++++++++++----------- 2 files changed, 17 insertions(+), 11 deletions(-) diff --git a/src/SAWScript/Yosys.hs b/src/SAWScript/Yosys.hs index 7f2fdd22e8..83fa7fd5a8 100644 --- a/src/SAWScript/Yosys.hs +++ b/src/SAWScript/Yosys.hs @@ -93,6 +93,7 @@ convertYosysIR sc ir = do let (m, nm, _) = mg ^. modgraphNodeFromVertex $ v -- liftIO . putStrLn . Text.unpack $ mconcat ["Converting module: ", nm] cm <- convertModule sc env m + _ <- validateTerm sc ("translating the combinational circuit \"" <> nm <> "\"") $ cm ^. convertedModuleTerm n <- liftIO $ Nonce.freshNonce Nonce.globalNonceGenerator let frag = Text.pack . show $ Nonce.indexValue n let uri = URI.URI diff --git a/src/SAWScript/Yosys/Cell.hs b/src/SAWScript/Yosys/Cell.hs index 38009549c9..2a6abd7061 100644 --- a/src/SAWScript/Yosys/Cell.hs +++ b/src/SAWScript/Yosys/Cell.hs @@ -116,15 +116,15 @@ primCellToTerm sc c args = traverse (validateTerm sc typeCheckMsg) =<< case c ^. ta <- input "A" anz <- liftIO $ SC.scBvNonzero sc w ta res <- liftIO $ SC.scNot sc anz - output res + outputBit res "$logic_and" -> do w <- outputWidth - ta <- input "A" - tb <- input "B" + ta <- inputRaw "A" + tb <- inputRaw "B" anz <- liftIO $ SC.scBvNonzero sc w ta bnz <- liftIO $ SC.scBvNonzero sc w tb res <- liftIO $ SC.scAnd sc anz bnz - output res + outputBit res "$logic_or" -> do w <- outputWidth ta <- input "A" @@ -132,7 +132,7 @@ primCellToTerm sc c args = traverse (validateTerm sc typeCheckMsg) =<< case c ^. anz <- liftIO $ SC.scBvNonzero sc w ta bnz <- liftIO $ SC.scBvNonzero sc w tb res <- liftIO $ SC.scOr sc anz bnz - output res + outputBit res "$mux" -> do ta <- input "A" tb <- input "B" @@ -228,6 +228,13 @@ primCellToTerm sc c args = traverse (validateTerm sc typeCheckMsg) =<< case c ^. fmap Just . cryptolRecord sc $ Map.fromList [ ("Y", eres) ] + outputBit :: SC.Term -> m (Maybe SC.Term) + outputBit res = do + bool <- liftIO $ SC.scBoolType sc + vres <- liftIO $ SC.scSingle sc bool res + fmap Just . cryptolRecord sc $ Map.fromList + [ ("Y", vres) + ] bvUnaryOp :: (SC.Term -> SC.Term -> IO SC.Term) -> m (Maybe SC.Term) bvUnaryOp f = do t <- input "A" @@ -252,9 +259,9 @@ primCellToTerm sc c args = traverse (validateTerm sc typeCheckMsg) =<< case c ^. output revres bvBinaryCmp :: (SC.Term -> SC.Term -> SC.Term -> IO SC.Term) -> m (Maybe SC.Term) bvBinaryCmp f = do - ta <- input "A" - tb <- input "B" - w <- outputWidth + ta <- inputRaw "A" + tb <- inputRaw "B" + w <- connWidth "A" bit <- liftIO $ f w ta tb boolty <- liftIO $ SC.scBoolType sc res <- liftIO $ SC.scSingle sc boolty bit @@ -267,6 +274,4 @@ primCellToTerm sc c args = traverse (validateTerm sc typeCheckMsg) =<< case c ^. identity <- liftIO $ SC.scBool sc boolIdentity scFoldr <- liftIO . SC.scLookupDef sc $ SC.mkIdent SC.preludeName "foldr" bit <- liftIO $ SC.scApplyAll sc scFoldr [boolTy, boolTy, w, boolFun, identity, t] - boolty <- liftIO $ SC.scBoolType sc - res <- liftIO $ SC.scSingle sc boolty bit - output res + outputBit bit From caffef466469e6ce2cc3f2ddc26b2caccf2ed3d4 Mon Sep 17 00:00:00 2001 From: Samuel Breese Date: Fri, 30 Sep 2022 01:26:06 -0400 Subject: [PATCH 46/47] Add Haddocks --- src/SAWScript/Yosys.hs | 59 +++++++++++++++++++++---- src/SAWScript/Yosys/Cell.hs | 8 ++++ src/SAWScript/Yosys/IR.hs | 45 ++++++++++++------- src/SAWScript/Yosys/Netgraph.hs | 8 ++++ src/SAWScript/Yosys/State.hs | 41 +++++++++++++---- src/SAWScript/Yosys/Theorem.hs | 32 ++++++++++---- src/SAWScript/Yosys/TransitionSystem.hs | 54 +++++++++++++++++----- src/SAWScript/Yosys/Utils.hs | 16 +++++++ 8 files changed, 212 insertions(+), 51 deletions(-) diff --git a/src/SAWScript/Yosys.hs b/src/SAWScript/Yosys.hs index 83fa7fd5a8..0727f74203 100644 --- a/src/SAWScript/Yosys.hs +++ b/src/SAWScript/Yosys.hs @@ -1,3 +1,11 @@ +{- | +Module : SAWScript.Yosys +Description : Loading and manipulating HDL programs +License : BSD3 +Maintainer : sbreese +Stability : experimental +-} + {-# Language TemplateHaskell #-} {-# Language OverloadedStrings #-} {-# Language RecordWildCards #-} @@ -67,6 +75,7 @@ data Modgraph = Modgraph } makeLenses ''Modgraph +-- | Given a Yosys IR, construct a graph of intermodule dependencies. yosysIRModgraph :: YosysIR -> Modgraph yosysIRModgraph ir = let @@ -91,7 +100,6 @@ convertYosysIR sc ir = do foldM (\env v -> do let (m, nm, _) = mg ^. modgraphNodeFromVertex $ v - -- liftIO . putStrLn . Text.unpack $ mconcat ["Converting module: ", nm] cm <- convertModule sc env m _ <- validateTerm sc ("translating the combinational circuit \"" <> nm <> "\"") $ cm ^. convertedModuleTerm n <- liftIO $ Nonce.freshNonce Nonce.globalNonceGenerator @@ -157,6 +165,9 @@ yosysIRToSequential sc ir nm = do {-# ANN module ("HLint: ignore Use camelCase" :: String) #-} +-- | Produces a Term given the path to a JSON file produced by the Yosys write_json command. +-- The resulting term is a Cryptol record, where each field corresponds to one HDL module exported by Yosys. +-- Each HDL module is in turn represented by a function from a record of input port values to a record of output port values. yosys_import :: FilePath -> TopLevel SC.TypedTerm yosys_import path = do sc <- getSharedContext @@ -165,7 +176,17 @@ yosys_import path = do _ <- validateTerm sc "translating combinational circuits" $ SC.ttTerm tt pure tt -yosys_verify :: SC.TypedTerm -> [SC.TypedTerm] -> SC.TypedTerm -> [YosysTheorem] -> ProofScript () -> TopLevel YosysTheorem +-- | Proves equality between a combinational HDL module and a specification. +-- Note that terms derived from HDL modules are first class, and are not restricted to yosys_verify: +-- they may also be used with SAW's typical Term infrastructure like sat, prove_print, term rewriting, etc. +-- yosys_verify simply provides a convenient and familiar interface, similar to llvm_verify or jvm_verify. +yosys_verify :: + SC.TypedTerm {- ^ Term corresponding to the HDL module -} -> + [SC.TypedTerm] {- ^ Preconditions for the equality -} -> + SC.TypedTerm {- ^ Specification term of the same type as the HDL module -} -> + [YosysTheorem] {- ^ Overrides to apply -} -> + ProofScript () -> + TopLevel YosysTheorem yosys_verify ymod preconds other specs tactic = do sc <- getSharedContext newmod <- foldM (flip $ applyOverride sc) @@ -181,32 +202,54 @@ yosys_verify ymod preconds other specs tactic = do _ <- Builtins.provePrintPrim tactic prop pure thm -yosys_import_sequential :: Text -> FilePath -> TopLevel YosysSequential +-- | Import a single sequential HDL module. +-- N.B. SAW expects the sequential module to exist entirely within a single Yosys module. +yosys_import_sequential :: + Text {- ^ Name of the HDL module -} -> + FilePath {- ^ Path to the Yosys JSON file -} -> + TopLevel YosysSequential yosys_import_sequential nm path = do sc <- getSharedContext ir <- loadYosysIR path yosysIRToSequential sc ir nm -yosys_extract_sequential :: YosysSequential -> Integer -> TopLevel SC.TypedTerm +-- | Extracts a term from the given sequential module with the state eliminated by iterating the term over the given concrete number of cycles. +-- The resulting term has no state field in the inputs or outputs. +-- Each input and output field is replaced with an array of that field's type (array length being the number of cycles specified). +yosys_extract_sequential :: + YosysSequential -> + Integer {- ^ Number of cycles to iterate term -} -> + TopLevel SC.TypedTerm yosys_extract_sequential s n = do sc <- getSharedContext tt <- composeYosysSequential sc s n _ <- validateTerm sc "composing a sequential term" $ SC.ttTerm tt pure tt -yosys_extract_sequential_with_state :: YosysSequential -> Integer -> TopLevel SC.TypedTerm +-- | Like `yosys_extract_sequential`, but the resulting term has an additional parameter to specify the initial state. +yosys_extract_sequential_with_state :: + YosysSequential -> + Integer {- ^ Number of cycles to iterate term -} -> + TopLevel SC.TypedTerm yosys_extract_sequential_with_state s n = do sc <- getSharedContext tt <- composeYosysSequentialWithState sc s n _ <- validateTerm sc "composing a sequential term with state" $ SC.ttTerm tt pure tt +-- | Extracts a term from the given sequential module. +-- This term has explicit fields for the state of the circuit in the input and output record types. yosys_extract_sequential_raw :: YosysSequential -> TopLevel SC.TypedTerm yosys_extract_sequential_raw s = pure $ s ^. yosysSequentialTerm -yosys_verify_sequential_sally :: YosysSequential -> FilePath -> SC.TypedTerm -> [String] -> TopLevel () +-- | Export a query over the given sequential module to an input file for the Sally model checker. +yosys_verify_sequential_sally :: + YosysSequential -> + FilePath {- ^ Path to write the resulting Sally input -} -> + SC.TypedTerm {- ^ A boolean function of three parameters: an 8-bit cycle counter, a record of "fixed" inputs, and a record of circuit outputs -} -> + [String] {- ^ Names of circuit inputs that are fixed -} -> + TopLevel () yosys_verify_sequential_sally s path q fixed = do sc <- getSharedContext sym <- liftIO $ Common.newSAWCoreExprBuilder sc - scs <- liftIO $ Common.sawCoreState sym - queryModelChecker sym scs sc s path q . Set.fromList $ Text.pack <$> fixed + queryModelChecker sym sc s path q . Set.fromList $ Text.pack <$> fixed diff --git a/src/SAWScript/Yosys/Cell.hs b/src/SAWScript/Yosys/Cell.hs index 2a6abd7061..31407af968 100644 --- a/src/SAWScript/Yosys/Cell.hs +++ b/src/SAWScript/Yosys/Cell.hs @@ -1,3 +1,11 @@ +{- | +Module : SAWScript.Yosys.Cell +Description : Translating Yosys cells into SAWCore +License : BSD3 +Maintainer : sbreese +Stability : experimental +-} + {-# Language TemplateHaskell #-} {-# Language OverloadedStrings #-} {-# Language RecordWildCards #-} diff --git a/src/SAWScript/Yosys/IR.hs b/src/SAWScript/Yosys/IR.hs index f650fbaf45..4e139c3ee4 100644 --- a/src/SAWScript/Yosys/IR.hs +++ b/src/SAWScript/Yosys/IR.hs @@ -1,3 +1,11 @@ +{- | +Module : SAWScript.Yosys.IR +Description : Representation for Yosys JSON output +License : BSD3 +Maintainer : sbreese +Stability : experimental +-} + {-# Language TemplateHaskell #-} {-# Language OverloadedStrings #-} {-# Language RecordWildCards #-} @@ -24,6 +32,7 @@ import SAWScript.Yosys.Utils -------------------------------------------------------------------------------- -- ** Representing and loading the Yosys JSON IR +-- | The direction of a module port. data Direction = DirectionInput | DirectionOutput @@ -35,12 +44,13 @@ instance Aeson.FromJSON Direction where parseJSON (Aeson.String "inout") = pure DirectionInout parseJSON v = fail $ "Failed to parse direction: " <> show v +-- | The value of a connection data Bitrep - = BitrepZero - | BitrepOne - | BitrepX - | BitrepZ - | Bitrep Integer + = BitrepZero -- ^ Constant zero bit + | BitrepOne -- ^ Constant one bit + | BitrepX -- ^ Undefined bit X + | BitrepZ -- ^ Undefined bit Z + | Bitrep Integer -- ^ The signal bit with the given index deriving (Show, Eq, Ord) instance Aeson.FromJSON Bitrep where parseJSON (Aeson.String "0") = pure BitrepZero @@ -50,11 +60,12 @@ instance Aeson.FromJSON Bitrep where parseJSON vn@Aeson.Number{} = Bitrep <$> Aeson.parseJSON vn parseJSON v = fail $ "Failed to parse bits: " <> show v +-- ^ A module input/output port. data Port = Port { _portDirection :: Direction - , _portBits :: [Bitrep] - , _portOffset :: Integer - , _portUpto :: Bool + , _portBits :: [Bitrep] -- ^ Which bit indices within the module are associated with the port + , _portOffset :: Integer -- currently unused + , _portUpto :: Bool -- currently unused } deriving (Show, Eq, Ord) makeLenses ''Port instance Aeson.FromJSON Port where @@ -69,13 +80,14 @@ instance Aeson.FromJSON Port where _ -> pure False pure Port{..} +-- | A cell within an HDL module. data Cell bs = Cell - { _cellHideName :: Bool - , _cellType :: Text - , _cellParameters :: Map Text Text - , _cellAttributes :: Aeson.Value - , _cellPortDirections :: Map Text Direction - , _cellConnections :: Map Text bs + { _cellHideName :: Bool -- ^ Whether the cell's name is human-readable + , _cellType :: Text -- ^ The cell type + , _cellParameters :: Map Text Text -- ^ Metadata parameters + , _cellAttributes :: Aeson.Value -- currently unused + , _cellPortDirections :: Map Text Direction -- ^ Direction for each cell connection + , _cellConnections :: Map Text bs -- ^ Bitrep for each cell connection } deriving (Show, Eq, Ord, Functor) makeLenses ''Cell instance Aeson.FromJSON (Cell [Bitrep]) where @@ -90,8 +102,9 @@ instance Aeson.FromJSON (Cell [Bitrep]) where _cellConnections <- o Aeson..: "connections" pure Cell{..} +-- | A single HDL module. data Module = Module - { _moduleAttributes :: Aeson.Value + { _moduleAttributes :: Aeson.Value -- currently unused , _modulePorts :: Map Text Port , _moduleCells :: Map Text (Cell [Bitrep]) } deriving (Show, Eq, Ord) @@ -103,6 +116,7 @@ instance Aeson.FromJSON Module where _moduleCells <- o Aeson..: "cells" pure Module{..} +-- | A collection of multiple HDL modules (possibly with dependencies on each other). data YosysIR = YosysIR { _yosysCreator :: Text , _yosysModules :: Map Text Module @@ -114,6 +128,7 @@ instance Aeson.FromJSON YosysIR where _yosysModules <- o Aeson..: "modules" pure YosysIR{..} +-- | Read a collection of HDL modules from a file produced by Yosys' write_json command. loadYosysIR :: MonadIO m => FilePath -> m YosysIR loadYosysIR p = liftIO $ Aeson.eitherDecodeFileStrict p >>= \case Left err -> throw . YosysError $ Text.pack err diff --git a/src/SAWScript/Yosys/Netgraph.hs b/src/SAWScript/Yosys/Netgraph.hs index 62b747d40c..eb348df70b 100644 --- a/src/SAWScript/Yosys/Netgraph.hs +++ b/src/SAWScript/Yosys/Netgraph.hs @@ -1,3 +1,11 @@ +{- | +Module : SAWScript.Yosys.Netgraph +Description : Translating graphs of Yosys cells into SAWCore +License : BSD3 +Maintainer : sbreese +Stability : experimental +-} + {-# Language TemplateHaskell #-} {-# Language OverloadedStrings #-} {-# Language RecordWildCards #-} diff --git a/src/SAWScript/Yosys/State.hs b/src/SAWScript/Yosys/State.hs index 4f4ba79c1a..eca2bb0456 100644 --- a/src/SAWScript/Yosys/State.hs +++ b/src/SAWScript/Yosys/State.hs @@ -1,3 +1,11 @@ +{- | +Module : SAWScript.Yosys.State +Description : Representing and manipulating stateful HDL circuits +License : BSD3 +Maintainer : sbreese +Stability : experimental +-} + {-# Language TemplateHaskell #-} {-# Language OverloadedStrings #-} {-# Language RecordWildCards #-} @@ -40,9 +48,13 @@ import SAWScript.Yosys.Utils import SAWScript.Yosys.IR import SAWScript.Yosys.Netgraph +-- | Encode the given string such that is a valid Cryptol identifier. +-- Since Yosys cell names often look like "\42", this makes it much easier to manipulate state records, +-- which are keyed by cell name. cellIdentifier :: Text -> Text cellIdentifier = Text.pack . zEncodeString . Text.unpack +-- | Find all of the flip-flop cells in a network graph. findDffs :: Netgraph Bitrep -> Map Text (Cell [Bitrep]) @@ -53,17 +65,19 @@ findDffs ng = . Graph.vertices $ ng ^. netgraphGraph +-- ^ A SAWCore translation of an HDL module alongside some type information that is useful to keep around. data YosysSequential = YosysSequential - { _yosysSequentialTerm :: SC.TypedTerm - , _yosysSequentialStateFields :: Map Text (SC.Term, C.Type) - , _yosysSequentialInputFields :: Map Text (SC.Term, C.Type) - , _yosysSequentialOutputFields :: Map Text (SC.Term, C.Type) - , _yosysSequentialInputWidths :: Map Text Natural - , _yosysSequentialOutputWidths :: Map Text Natural - , _yosysSequentialStateWidths :: Map Text Natural + { _yosysSequentialTerm :: SC.TypedTerm -- ^ The "raw" SAWCore term derived from the module, which includes a __state__ field in the input and output. + , _yosysSequentialStateFields :: Map Text (SC.Term, C.Type) -- ^ A mapping from each state field name to a SAWCore and Cryptol type. + , _yosysSequentialInputFields :: Map Text (SC.Term, C.Type) -- ^ A mapping from each input to a SAWCore and Cryptol type. + , _yosysSequentialOutputFields :: Map Text (SC.Term, C.Type) -- ^ A mapping from each output to a SAWCore and Cryptol type. + , _yosysSequentialInputWidths :: Map Text Natural -- ^ A mapping from each input to a width. + , _yosysSequentialOutputWidths :: Map Text Natural -- ^ A mapping from each output to a width. + , _yosysSequentialStateWidths :: Map Text Natural -- ^ A mapping from each state field to a width. } makeLenses ''YosysSequential +-- | Build a SAWCore type corresponding to the Cryptol record type with the given field types fieldsToType :: MonadIO m => SC.SharedContext -> @@ -71,23 +85,26 @@ fieldsToType :: m SC.Term fieldsToType sc = cryptolRecordType sc . fmap fst +-- | Build a Cryptol record type with the given field types fieldsToCryptolType :: MonadIO m => Map Text (SC.Term, C.Type) -> m C.Type fieldsToCryptolType fields = pure . C.tRec . C.recordFromFields $ bimap C.mkIdent snd <$> Map.assocs fields +-- | Add a record-typed field named __states__ to the given mapping of field names to types. insertStateField :: MonadIO m => SC.SharedContext -> - Map Text (SC.Term, C.Type) -> - Map Text (SC.Term, C.Type) -> + Map Text (SC.Term, C.Type) {- ^ The field types of "__states__" -} -> + Map Text (SC.Term, C.Type) {- ^ The mapping to update -} -> m (Map Text (SC.Term, C.Type)) insertStateField sc stateFields fields = do stateRecordType <- fieldsToType sc stateFields stateRecordCryptolType <- fieldsToCryptolType stateFields pure $ Map.insert "__state__" (stateRecordType, stateRecordCryptolType) fields +-- | Translate a stateful HDL module into SAWCore convertModuleInline :: MonadIO m => SC.SharedContext -> @@ -191,6 +208,8 @@ convertModuleInline sc m = do , _yosysSequentialStateWidths = stateWidths } +-- | Given a SAWCore term with an explicit state, iterate the term the given number of times. +-- | The resulting term has a parameter for the initial state, the resulting Cryptol types does not. composeYosysSequentialHelper :: forall m. MonadIO m => @@ -270,6 +289,8 @@ composeYosysSequentialHelper sc s n = do pure (res, cty) +-- | Given a SAWCore term with an explicit state, iterate the term the given number of times. +-- | Accessing the initial state produces an error. composeYosysSequential :: forall m. MonadIO m => @@ -285,6 +306,8 @@ composeYosysSequential sc s n = do res <- liftIO $ SC.scApply sc t initialState pure $ SC.TypedTerm (SC.TypedTermSchema $ C.tMono cty) res +-- | Given a SAWCore term with an explicit state, iterate the term the given number of times. +-- | The resulting term has a parameter for the initial state. composeYosysSequentialWithState :: forall m. MonadIO m => diff --git a/src/SAWScript/Yosys/Theorem.hs b/src/SAWScript/Yosys/Theorem.hs index 5ea2ce7f54..8a72b2c383 100644 --- a/src/SAWScript/Yosys/Theorem.hs +++ b/src/SAWScript/Yosys/Theorem.hs @@ -1,3 +1,11 @@ +{- | +Module : SAWScript.Yosys.Theorem +Description : Utilities for rewriting/compositional verification of HDL modules +License : BSD3 +Maintainer : sbreese +Stability : experimental +-} + {-# Language TemplateHaskell #-} {-# Language OverloadedStrings #-} {-# Language LambdaCase #-} @@ -34,17 +42,19 @@ import SAWScript.Yosys.Utils newtype YosysImport = YosysImport { yosysImport :: Map Text SC.TypedTerm } data YosysTheorem = YosysTheorem - { _theoremURI :: URI.URI -- URI identifying overridden module - , _theoremInputCryptolType :: C.Type -- cryptol type of r - , _theoremOutputCryptolType :: C.Type -- cryptol type of (module r) - , _theoremInputType :: SC.Term -- type of r - , _theoremOutputType :: SC.Term -- type of (module r) - , _theoremModule :: SC.Term -- {{ \r -> module r }} - , _theoremPrecond :: Maybe SC.Term -- {{ \r -> precond r }} - , _theoremBody :: SC.Term -- {{ \r -> other r }} + { _theoremURI :: URI.URI -- ^ URI identifying overridden module + , _theoremInputCryptolType :: C.Type -- ^ cryptol type of r + , _theoremOutputCryptolType :: C.Type -- ^ cryptol type of (module r) + , _theoremInputType :: SC.Term -- ^ type of r + , _theoremOutputType :: SC.Term -- ^ type of (module r) + , _theoremModule :: SC.Term -- ^ {{ \r -> module r }} + , _theoremPrecond :: Maybe SC.Term -- ^ {{ \r -> precond r }} + , _theoremBody :: SC.Term -- ^ {{ \r -> other r }} } makeLenses ''YosysTheorem +-- | Construct a SAWCore proposition for the given theorem. +-- In pseudo-Cryptol, this looks like {{ \r -> precond r ==> (module r == body r) }} theoremProp :: (MonadIO m, MonadThrow m) => SC.SharedContext -> @@ -68,6 +78,8 @@ theoremProp sc thm = do ("constructing a proposition while verifying " <> URI.render (thm ^. theoremURI)) func +-- | Construct a SAWCore proposition for the given theorem. +-- In pseudo-Cryptol, this looks like {{ \r -> if precond r then body r else module r }} theoremReplacement :: (MonadIO m, MonadThrow m) => SC.SharedContext -> @@ -88,6 +100,8 @@ theoremReplacement sc thm = do ("constructing an override replacement for " <> URI.render (thm ^. theoremURI)) ft +-- | Given a SAWCore term corresponding to an HDL module, a specification, and a precondition: +-- Construct a theorem summarizing the relationship between the module and the specification. buildTheorem :: (MonadIO m, MonadThrow m) => SC.SharedContext -> @@ -126,7 +140,7 @@ buildTheorem sc ymod newmod precond body = do -- 1) unfold all names except thm.theoremURI in t -- 2) traverse t, looking for constants named thm.theoremURI -- 4) replace the constant term with either thm.theoremBody, or --- {{ \x -> if thm.theoremPrecond r then thm.theoremBody else thm.theoremURI }} +-- {{ \r -> if thm.theoremPrecond r then thm.theoremBody r else thm.theoremURI r }} -- in the presence of a precondition applyOverride :: forall m. diff --git a/src/SAWScript/Yosys/TransitionSystem.hs b/src/SAWScript/Yosys/TransitionSystem.hs index 0f2855698f..fe98d3d5b2 100644 --- a/src/SAWScript/Yosys/TransitionSystem.hs +++ b/src/SAWScript/Yosys/TransitionSystem.hs @@ -1,3 +1,11 @@ +{- | +Module : SAWScript.Yosys.TransitionSystem +Description : Exporting stateful HDL circuits to model checkers +License : BSD3 +Maintainer : sbreese +Stability : experimental +-} + {-# Language TemplateHaskell #-} {-# Language OverloadedStrings #-} {-# Language TupleSections #-} @@ -54,18 +62,21 @@ import qualified Language.Sally.TransitionSystem as Sally import SAWScript.Yosys.Utils import SAWScript.Yosys.State +-- | A named field with the given What4 base type. data SequentialField tp = SequentialField { _sequentialFieldName :: Text , _sequentialFieldTypeRepr :: W4.BaseTypeRepr tp } makeLenses ''SequentialField +-- | A typed record associating field names with What4 base types. data SequentialFields ctx = SequentialFields { _sequentialFields :: Ctx.Assignment SequentialField ctx , _sequentialFieldsIndex :: Map Text (Some (Ctx.Index ctx)) } makeLenses ''SequentialFields +-- | Convert a mapping from names to widths into a typed mapping from those names to What4 bitvectors of those widths. sequentialReprs :: forall m. MonadIO m => @@ -93,14 +104,17 @@ sequentialReprs fs = do pure $ Some $ Ctx.extend rest field _ -> throw $ YosysErrorInvalidStateFieldWidth nm +-- | Given information about field names and types alongside an appropriately-typed What4 struct value, +-- explode that struct into a mapping from field names to fresh typed SAWCore constants and SAWCore What4 simulator values. +-- (This is used to unpack a What4 struct into a representation that is more convenient to manipulate in SAWCore.) ecBindingsOfFields :: MonadIO m => W4.B.ExprBuilder n st fs -> SC.SharedContext -> - Text -> - Map Text SC.Term -> - SequentialFields ctx -> - W4.SymStruct (W4.B.ExprBuilder n st fs) ctx -> + Text {- ^ Prefix to prepend to all field names -} -> + Map Text SC.Term {- ^ Mapping from field names to SAWCore types -} -> + SequentialFields ctx {- ^ Mapping from field names to What4 base types -} -> + W4.SymStruct (W4.B.ExprBuilder n st fs) ctx {- ^ What4 record to deconstruct -} -> m (Map Text (SC.ExtCns SC.Term, SimW4.SValue (W4.B.ExprBuilder n st fs))) ecBindingsOfFields sym sc pfx fs s inp = fmap Map.fromList . forM (Map.assocs fs) $ \(baseName, ty) -> do let nm = pfx <> baseName @@ -112,29 +126,37 @@ ecBindingsOfFields sym sc pfx fs s inp = fmap Map.fromList . forM (Map.assocs fs -> do inpExpr <- liftIO $ W4.structField sym inp idx pure . Sim.VWord $ W4.DBV inpExpr - _ -> throw $ YosysErrorTransitionSystemMissingField nm + _ -> throw $ YosysErrorTransitionSystemMissingField nm pure (baseName, (ec, val)) +-- | Given a sequential circuit and a query, construct and write to disk a Sally transition system encoding that query. queryModelChecker :: MonadIO m => W4.B.ExprBuilder n st fs -> - SimW4.SAWCoreState n -> SC.SharedContext -> YosysSequential -> - FilePath -> - SC.TypedTerm -> - Set.Set Text -> + FilePath {- ^ Path to write the resulting Sally input -} -> + SC.TypedTerm {- ^ A boolean function of three parameters: an 8-bit cycle counter, a record of "fixed" inputs, and a record of circuit outputs -} -> + Set.Set Text {- ^ Names of circuit inputs that are fixed -}-> m () -queryModelChecker sym _scs sc sequential path query fixedInputs = do +queryModelChecker sym sc sequential path query fixedInputs = do + -- there are 5 classes of field: + -- - fixed inputs (inputs from the circuit named in the fixed set, assumed to be constant across cycles + -- - variable inputs (all other inputs from the circuit) + -- - outputs (all outputs from the circuit) + -- - state (all circuit flip-flop states) + -- - internal (right now, just a cycle counter) let (fixedInputWidths, variableInputWidths) = Map.partitionWithKey (\nm _ -> Set.member nm fixedInputs) $ sequential ^. yosysSequentialInputWidths let (fixedInputFields, variableInputFields) = Map.partitionWithKey (\nm _ -> Set.member nm fixedInputs) $ sequential ^. yosysSequentialInputFields let internalWidths = Map.singleton "cycle" 8 internalFields <- forM internalWidths $ \w -> liftIO $ SC.scBitvector sc w + -- the "inputs" for our transition system are exclusively the circuit's variable inputs Some inputFields <- sequentialReprs variableInputWidths let inputReprs = TraversableFC.fmapFC (view sequentialFieldTypeRepr) $ inputFields ^. sequentialFields let inputNames = TraversableFC.fmapFC (Const . W4.safeSymbol . Text.unpack . view sequentialFieldName) $ inputFields ^. sequentialFields + -- while the transition system "states" are everything else: flip-flop states, fixed inputs, all outputs, and the cycle counter let combinedWidths = Map.unions [ sequential ^. yosysSequentialStateWidths , Map.mapKeys ("stateinput_"<>) fixedInputWidths @@ -150,6 +172,7 @@ queryModelChecker sym _scs sc sequential path query fixedInputs = do , W4.stateReprs = stateReprs , W4.stateNames = stateNames , W4.initialStatePredicate = \cur -> do + -- initially , we assert that cycle = 0 curInternalBindings <- ecBindingsOfFields sym sc "internal_" internalFields stateFields cur cycleVal <- case Map.lookup "cycle" curInternalBindings of Just (ec, _) -> SC.scExtCns sc ec @@ -166,6 +189,12 @@ queryModelChecker sym _scs sc sequential path query fixedInputs = do Sim.VBool b -> pure b _ -> throw YosysErrorTransitionSystemBadType , W4.stateTransitions = \input cur next -> do + -- there is exactly one state transition, defined by the SAWCore function f representing the circuit + -- here, we assert that: + -- - the new value of each state field is equal to the same field in f() + -- - the new value of each output is equal to the same output in f() + -- - the new value of each fixed input is equal to the old value of that fixed input + -- - the new cycle counter is equal to the old cycle counter plus one inputBindings <- ecBindingsOfFields sym sc "" (fst <$> variableInputFields) inputFields input curBindings <- ecBindingsOfFields sym sc "" (fst <$> (sequential ^. yosysSequentialStateFields)) stateFields cur curFixedInputBindings <- ecBindingsOfFields sym sc "stateinput_" (fst <$> fixedInputFields) stateFields cur @@ -240,6 +269,11 @@ queryModelChecker sym _scs sc sequential path query fixedInputs = do [ (W4.systemSymbol "default!", w4Conj) ] , W4.queries = \cur -> do + -- here we generate a single query, corresponding to the provided query term q + -- this is q applied to: + -- - the cycle counter (an 8-bit bitvector) + -- - a record of the fixed inputs (as usual really a SAWCore tuple, ordered per the Cryptol record type) + -- - a record of the outputs curFixedInputBindings <- ecBindingsOfFields sym sc "stateinput_" (fst <$> fixedInputFields) stateFields cur curOutputBindings <- ecBindingsOfFields sym sc "stateoutput_" (fst <$> (sequential ^. yosysSequentialOutputFields)) stateFields cur curInternalBindings <- ecBindingsOfFields sym sc "internal_" internalFields stateFields cur diff --git a/src/SAWScript/Yosys/Utils.hs b/src/SAWScript/Yosys/Utils.hs index d4884459bc..6fc2215a42 100644 --- a/src/SAWScript/Yosys/Utils.hs +++ b/src/SAWScript/Yosys/Utils.hs @@ -1,3 +1,11 @@ +{- | +Module : SAWScript.Yosys.Utils +Description : Miscellaneous utilities used when working with HDL +License : BSD3 +Maintainer : sbreese +Stability : experimental +-} + {-# Language CPP #-} {-# Language TemplateHaskell #-} {-# Language OverloadedStrings #-} @@ -138,6 +146,7 @@ reverseTopSort = reverse . Graph.topSort #endif +-- | Check that a SAWCore term is well-typed, throwing an exception otherwise. validateTerm :: MonadIO m => SC.SharedContext -> Text -> SC.Term -> m SC.Term validateTerm sc msg t = liftIO (SC.TC.scTypeCheck sc Nothing t) >>= \case Right _ -> pure t @@ -148,6 +157,7 @@ validateTerm sc msg t = liftIO (SC.TC.scTypeCheck sc Nothing t) >>= \case . unlines $ SC.TC.prettyTCError err +-- | Produce a SAWCore tuple type corresponding to a Cryptol record type with the given fields. cryptolRecordType :: MonadIO m => SC.SharedContext -> @@ -156,6 +166,7 @@ cryptolRecordType :: cryptolRecordType sc fields = liftIO $ SC.scTupleType sc (fmap snd . C.canonicalFields . C.recordFromFields $ Map.assocs fields) +-- | Produce a SAWCore tuple corresponding to a Cryptol record with the given fields. cryptolRecord :: MonadIO m => SC.SharedContext -> @@ -164,6 +175,7 @@ cryptolRecord :: cryptolRecord sc fields = liftIO $ SC.scTuple sc (fmap snd . C.canonicalFields . C.recordFromFields $ Map.assocs fields) +-- | Produce a SAWCore tuple index corresponding to a lookup in a Cryptol record with the given fields. cryptolRecordSelect :: MonadIO m => SC.SharedContext -> @@ -184,6 +196,8 @@ cryptolRecordSelect sc fields r nm = ] where ord = fmap fst . C.canonicalFields . C.recordFromFields $ Map.assocs fields +-- | Produce a SAWCore tuple index corresponding to a lookup in a Cryptol record. +-- The record fields are inferred from the Cryptol type attached to the `TypedTerm`. cryptolRecordSelectTyped :: MonadIO m => SC.SharedContext -> @@ -209,6 +223,8 @@ cryptolRecordSelectTyped sc r nm = do t <- cryptolRecordSelect sc fields (SC.ttTerm r) nm pure $ SC.TypedTerm (SC.TypedTermSchema $ C.tMono cty) t +-- | Construct a SAWCore expression asserting equality between each field of two records. +-- Both records should be tuples corresponding to the specified Cryptol record type. eqBvRecords :: (MonadIO m, MonadThrow m) => SC.SharedContext -> From 2fb0a499096c592c79fb99849bcb6057f5e58a0c Mon Sep 17 00:00:00 2001 From: Samuel Breese Date: Fri, 30 Sep 2022 12:05:52 -0400 Subject: [PATCH 47/47] Address warning --- src/SAWScript/Yosys/TransitionSystem.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/src/SAWScript/Yosys/TransitionSystem.hs b/src/SAWScript/Yosys/TransitionSystem.hs index fe98d3d5b2..68395c64d8 100644 --- a/src/SAWScript/Yosys/TransitionSystem.hs +++ b/src/SAWScript/Yosys/TransitionSystem.hs @@ -48,7 +48,6 @@ import qualified Verifier.SAW.TypedTerm as SC import qualified Verifier.SAW.Simulator.Value as Sim import qualified Verifier.SAW.Simulator.What4 as SimW4 -import qualified Verifier.SAW.Simulator.What4.ReturnTrip as SimW4 import qualified What4.Interface as W4 import qualified What4.Symbol as W4