From 04585d2d086f91e7c29b1e9d2a6b4f3ddbd71e30 Mon Sep 17 00:00:00 2001 From: Mark Tullsen Date: Mon, 15 Sep 2025 22:27:02 -0700 Subject: [PATCH 01/57] refactor: new function loadAndTranslateModule, extracted from importModule function. # Conflicts: # cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs --- .../src/CryptolSAWCore/CryptolEnv.hs | 99 ++++++++++--------- 1 file changed, 55 insertions(+), 44 deletions(-) diff --git a/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs b/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs index 03f634c2b9..b118a39949 100644 --- a/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs +++ b/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs @@ -633,6 +633,56 @@ extractDefFromCryptolModule (CryptolModule _ tm) name = -------------------------------------------------------------------------------- +loadAndTranslateModule :: + (?fileReader :: FilePath -> IO ByteString) => + SharedContext {- ^ Shared context for creating terms -} -> + CryptolEnv {- ^ Extend this environment -} -> + Either FilePath P.ModName {- ^ Where to find the module -} -> + IO (P.Located P.ModName, CryptolEnv) +loadAndTranslateModule sc env src = + do let modEnv = eModuleEnv env + (mtop, modEnv') <- liftModuleM modEnv $ + case src of + Left path -> MB.loadModuleByPath True path + Right mn -> snd <$> MB.loadModuleFrom True (MM.FromModule mn) + m <- case mtop of + T.TCTopModule mod' -> pure mod' + T.TCTopSignature {} -> + fail "Expected a module but found an interface." + + checkNotParameterized m + + -- Regenerate SharedTerm environment: + let oldModNames = map ME.lmName + $ ME.lmLoadedModules + $ ME.meLoadedModules modEnv + isNew m' = T.mName m' `notElem` oldModNames + newModules = filter isNew + $ map ME.lmModule + $ ME.lmLoadedModules + $ ME.meLoadedModules modEnv' + newDeclGroups = concatMap T.mDecls newModules + newNominal = Map.difference (ME.loadedNominalTypes modEnv') + (ME.loadedNominalTypes modEnv) + + newTermEnv <- + do oldCryEnv <- mkCryEnv env + cEnv <- C.genCodeForNominalTypes sc newNominal oldCryEnv + newCryEnv <- C.importTopLevelDeclGroups + sc C.defaultPrimitiveOptions cEnv newDeclGroups + return (C.envE newCryEnv) + + let -- XXX: it would be better to have the real position, but it + -- seems to have been thrown away on the Cryptol side. + locate x = P.Located P.emptyRange x + + return ( locate $ T.mName m + , env{ eModuleEnv = modEnv' + , eTermEnv = newTermEnv + , eFFITypes = updateFFITypes m newTermEnv (eFFITypes env) + } + ) + -- | @'importModule' sc env src as vis imps@ - extend the Cryptol -- environment with a module. Closely mirrors the sawscript command "import". -- @@ -650,56 +700,17 @@ importModule :: ImportVisibility {- ^ What visibility to give symbols from this module -} -> Maybe P.ImportSpec {- ^ What to import -} -> IO CryptolEnv -importModule sc env src as vis imps = do - let modEnv = eModuleEnv env - (mtop, modEnv') <- liftModuleM modEnv $ - case src of - Left path -> MB.loadModuleByPath True path - Right mn -> snd <$> MB.loadModuleFrom True (MM.FromModule mn) - m <- case mtop of - T.TCTopModule mod' -> pure mod' - T.TCTopSignature {} -> - fail "Expected a module but found an interface." - - checkNotParameterized m - - -- Regenerate SharedTerm environment: - let oldModNames = map ME.lmName - $ ME.lmLoadedModules - $ ME.meLoadedModules modEnv - isNew m' = T.mName m' `notElem` oldModNames - newModules = filter isNew - $ map ME.lmModule - $ ME.lmLoadedModules - $ ME.meLoadedModules modEnv' - newDeclGroups = concatMap T.mDecls newModules - newNominal = Map.difference (loadedNonParamNominalTypes modEnv') - (loadedNonParamNominalTypes modEnv) - - newTermEnv <- - do oldCryEnv <- mkCryEnv env - cEnv <- C.genCodeForNominalTypes sc newNominal oldCryEnv - newCryEnv <- C.importTopLevelDeclGroups - sc C.defaultPrimitiveOptions cEnv newDeclGroups - return (C.envE newCryEnv) - - let newImport = (vis, P.Import { T.iModule= locate $ T.mName m +importModule sc env src as vis imps = + do + (modName, env') <- loadAndTranslateModule sc env src + let newImport = (vis, P.Import { T.iModule= modName , T.iAs = as , T.iSpec = imps , T.iInst = Nothing , T.iDoc = Nothing } ) - -- XXX: it would be better to have the real position, but it - -- seems to have been thrown away on the Cryptol side. - locate x = P.Located P.emptyRange x - - return $ - env{ eModuleEnv = modEnv' - , eTermEnv = newTermEnv - , eFFITypes = updateFFITypes m newTermEnv (eFFITypes env) - , eImports = newImport : eImports env - } + return $ env'{ eImports = newImport : eImports env } bindIdent :: Ident -> CryptolEnv -> (T.Name, CryptolEnv) bindIdent ident env = (name, env') From 920a822e03fb9ac4329a80caa31966bdbc526997 Mon Sep 17 00:00:00 2001 From: Mark Tullsen Date: Wed, 17 Sep 2025 22:29:13 -0700 Subject: [PATCH 02/57] comments and whitespace --- cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs | 14 +++++--------- 1 file changed, 5 insertions(+), 9 deletions(-) diff --git a/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs b/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs index b118a39949..deb684895d 100644 --- a/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs +++ b/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs @@ -470,10 +470,6 @@ loadCryptolModule sc env path = do checkNotParameterized m - -- NOTE: unclear what's happening here! - -- - FIXME: understand and doc. - -- - `m` not used (directly) but translating the modEnv' - -- - this behavior is not in `importModule` let ifaceDecls = getAllIfaceDecls modEnv' (types, modEnv'') <- liftModuleM modEnv' $ do @@ -554,13 +550,13 @@ mkCryptolModule m types newTermEnv = (\k _ -> Set.member k (MEx.exported C.NSType (T.mExports m))) (T.mTySyns m) ) - -- FIXME: TODO: ensure type synonym in submodule is included. + -- FIXME: TODO: ensure type synonyms in submodule are included. -- create the map of symbols: ( Map.filterWithKey (\k _ -> Set.member k names) $ Map.intersectionWith (\t x -> TypedTerm (TypedTermSchema t) x) - types -- NOTE: only use of this variable. + types newTermEnv ) @@ -678,9 +674,9 @@ loadAndTranslateModule sc env src = return ( locate $ T.mName m , env{ eModuleEnv = modEnv' - , eTermEnv = newTermEnv - , eFFITypes = updateFFITypes m newTermEnv (eFFITypes env) - } + , eTermEnv = newTermEnv + , eFFITypes = updateFFITypes m newTermEnv (eFFITypes env) + } ) -- | @'importModule' sc env src as vis imps@ - extend the Cryptol From 3a82d6aee3f70593a582f154ef220beb2baf93ce Mon Sep 17 00:00:00 2001 From: Mark Tullsen Date: Wed, 17 Sep 2025 22:31:29 -0700 Subject: [PATCH 03/57] refactor: move code for generating CryptolModule into mkCryptolModule - See comments in mkCryptolModule that justify the refactor (i.e., that modEnv' == modEnv'') --- .../src/CryptolSAWCore/CryptolEnv.hs | 62 +++++++++---------- 1 file changed, 29 insertions(+), 33 deletions(-) diff --git a/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs b/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs index deb684895d..bf1ed0ad06 100644 --- a/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs +++ b/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs @@ -470,22 +470,6 @@ loadCryptolModule sc env path = do checkNotParameterized m - - let ifaceDecls = getAllIfaceDecls modEnv' - (types, modEnv'') <- liftModuleM modEnv' $ do - do prims <- MB.getPrimMap - -- generate the primitive map; a monad reader - TM.inpVars `fmap` - MB.genInferInput P.emptyRange prims NoParams ifaceDecls - - -- NOTE: inpVars are the variables that are in scope. - -- FIXME: we are possibly doing unnecessary computation here (see - -- source code for MB.getPrimMap and MB.genInferInput.) - - -- FIXME: it appears (need to verify) that modEnv'' == modEnv' - -- if this true, we can simplify and move this section - -- into `mkCryptolModule`. - -- Regenerate SharedTerm environment: let oldModNames = map ME.lmName $ ME.lmLoadedModules @@ -494,7 +478,7 @@ loadCryptolModule sc env path = do newModules = filter isNew $ map ME.lmModule $ ME.lmLoadedModules - $ ME.meLoadedModules modEnv'' + $ ME.meLoadedModules modEnv' newDeclGroups = concatMap T.mDecls newModules newNominal = Map.difference (loadedNonParamNominalTypes modEnv') (loadedNonParamNominalTypes modEnv) @@ -506,18 +490,15 @@ loadCryptolModule sc env path = do sc C.defaultPrimitiveOptions cEnv newDeclGroups return (C.envE newCryEnv) - cryptolModule <- mkCryptolModule m types newTermEnv - -- NOTE: Bringing the module-handle into {{-}} scope is not handled -- here; it is done rather in `bindCryptolModule`, ONLY if the -- user binds the `cryptolModule` returned here at the saw -- command line. - return ( cryptolModule - , env { eModuleEnv = modEnv'' - , eTermEnv = newTermEnv - , eFFITypes = updateFFITypes m newTermEnv (eFFITypes env) - } + let env' = env { eModuleEnv = modEnv' + , eTermEnv = newTermEnv + , eFFITypes = updateFFITypes m newTermEnv (eFFITypes env) + } -- NOTE here the difference between this function and -- `importModule`: -- 1. the `eImports` field is not updated, as @@ -525,7 +506,9 @@ loadCryptolModule sc env path = do -- brought into scope inside {{ }} constructs. -- 2. modEnv'' vs modEnv' (which may not be different, see -- notes above). - ) + + cryptolModule <- mkCryptolModule m env' + return (cryptolModule, env') -- | mkCryptolModule -- @@ -533,15 +516,28 @@ loadCryptolModule sc env path = do -- - This incorrectly excludes both submodules and their contents from -- the NamingEnvs in `CryptolModule` --- - Regarding the CLI API: the `CryptolModule` type is exposed to --- the SAWScript CLI, is this necessary? - -mkCryptolModule :: T.Module - -> Map MN.Name T.Schema - -> Map MN.Name Term - -> IO CryptolModule -mkCryptolModule m types newTermEnv = +mkCryptolModule :: + (?fileReader :: FilePath -> IO ByteString) => + T.Module -> CryptolEnv -> IO CryptolModule +mkCryptolModule m env = do + let newTermEnv = eTermEnv env + modEnv = eModuleEnv env + ifaceDecls = getAllIfaceDecls modEnv + (types, _modEnv) <- liftModuleM modEnv $ do + -- NOTE: _modEnv == modEnv + -- - as we elaborate below, the monadic actions are all 'readers' + do prims <- MB.getPrimMap + -- generate the primitive map; a monad reader + TM.inpVars `fmap` + MB.genInferInput P.emptyRange prims NoParams ifaceDecls + -- NOTE: inpVars are the variables that are in scope. + -- FIXME: + -- - Why are we calling mB.genInferInput then projecting out + -- `inpVars`? + -- - If we had inlined, it appears that this is functional code. + -- - (Maybe because of information hiding?) + let names = MEx.exported C.NSValue (T.mExports m) -- :: Set T.Name return $ CryptolModule From 0ed72082c37a610705ccca8c121215205f2fc0a3 Mon Sep 17 00:00:00 2001 From: Mark Tullsen Date: Wed, 17 Sep 2025 22:48:47 -0700 Subject: [PATCH 04/57] refactors --- .../src/CryptolSAWCore/CryptolEnv.hs | 18 ++++++++++-------- 1 file changed, 10 insertions(+), 8 deletions(-) diff --git a/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs b/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs index bf1ed0ad06..c9df6310a6 100644 --- a/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs +++ b/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs @@ -630,7 +630,7 @@ loadAndTranslateModule :: SharedContext {- ^ Shared context for creating terms -} -> CryptolEnv {- ^ Extend this environment -} -> Either FilePath P.ModName {- ^ Where to find the module -} -> - IO (P.Located P.ModName, CryptolEnv) + IO (T.Module, CryptolEnv) loadAndTranslateModule sc env src = do let modEnv = eModuleEnv env (mtop, modEnv') <- liftModuleM modEnv $ @@ -664,11 +664,7 @@ loadAndTranslateModule sc env src = sc C.defaultPrimitiveOptions cEnv newDeclGroups return (C.envE newCryEnv) - let -- XXX: it would be better to have the real position, but it - -- seems to have been thrown away on the Cryptol side. - locate x = P.Located P.emptyRange x - - return ( locate $ T.mName m + return ( m , env{ eModuleEnv = modEnv' , eTermEnv = newTermEnv , eFFITypes = updateFFITypes m newTermEnv (eFFITypes env) @@ -694,8 +690,8 @@ importModule :: IO CryptolEnv importModule sc env src as vis imps = do - (modName, env') <- loadAndTranslateModule sc env src - let newImport = (vis, P.Import { T.iModule= modName + (mod', env') <- loadAndTranslateModule sc env src + let newImport = (vis, P.Import { T.iModule= locatedUnknown (T.mName mod') , T.iAs = as , T.iSpec = imps , T.iInst = Nothing @@ -704,6 +700,12 @@ importModule sc env src as vis imps = ) return $ env'{ eImports = newImport : eImports env } +locatedUnknown :: a -> P.Located a +locatedUnknown x = P.Located P.emptyRange x + -- XXX: it would be better to have the real position, but it + -- seems to have been thrown away on the Cryptol side in the uses + -- of this function. + bindIdent :: Ident -> CryptolEnv -> (T.Name, CryptolEnv) bindIdent ident env = (name, env') where From 6eadbeaee6b4e3e1f795ff14fceb1d00621aa378 Mon Sep 17 00:00:00 2001 From: Mark Tullsen Date: Wed, 17 Sep 2025 22:52:48 -0700 Subject: [PATCH 05/57] improve fail message --- cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs b/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs index c9df6310a6..59218b37c5 100644 --- a/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs +++ b/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs @@ -640,7 +640,13 @@ loadAndTranslateModule sc env src = m <- case mtop of T.TCTopModule mod' -> pure mod' T.TCTopSignature {} -> - fail "Expected a module but found an interface." + fail $ + "Expected a module, but " + ++ (case src of + Left path -> show path + Right mn -> show mn + ) + ++ " is an interface." checkNotParameterized m From 82f02a41d1e1a11ae8d9957159135a44456057f4 Mon Sep 17 00:00:00 2001 From: Mark Tullsen Date: Wed, 17 Sep 2025 23:03:04 -0700 Subject: [PATCH 06/57] comments. --- cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs b/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs index 59218b37c5..5200982d4d 100644 --- a/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs +++ b/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs @@ -451,7 +451,7 @@ checkNotParameterized m = -- This is used to implement the "cryptol_load" primitive in which a -- handle to the module is returned and can be bound to a SAWScript -- variable. - +-- loadCryptolModule :: (?fileReader :: FilePath -> IO ByteString) => SharedContext -> @@ -492,7 +492,7 @@ loadCryptolModule sc env path = do -- NOTE: Bringing the module-handle into {{-}} scope is not handled -- here; it is done rather in `bindCryptolModule`, ONLY if the - -- user binds the `cryptolModule` returned here at the saw + -- user binds the `cryptolModule` returned here at the SAW -- command line. let env' = env { eModuleEnv = modEnv' @@ -536,7 +536,7 @@ mkCryptolModule m env = -- - Why are we calling mB.genInferInput then projecting out -- `inpVars`? -- - If we had inlined, it appears that this is functional code. - -- - (Maybe because of information hiding?) + -- - (Possibly because of information hiding?) let names = MEx.exported C.NSValue (T.mExports m) -- :: Set T.Name return $ From 2f445b508a9bb069bec493d94a0aac3d09c019b9 Mon Sep 17 00:00:00 2001 From: Mark Tullsen Date: Wed, 17 Sep 2025 23:03:55 -0700 Subject: [PATCH 07/57] refactor: fold loadAndTranslateModule --- .../src/CryptolSAWCore/CryptolEnv.hs | 53 ++----------------- 1 file changed, 4 insertions(+), 49 deletions(-) diff --git a/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs b/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs index 5200982d4d..0f9707a058 100644 --- a/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs +++ b/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs @@ -440,11 +440,6 @@ checkNotParameterized m = , "Either use a ` import, or make a module instantiation." ] --- FIXME: Code duplication, these two functions are highly similar: --- - loadCryptolModule --- - importModule --- - TODO: "common up" the common code per #2569. - -- | loadCryptolModule - load a cryptol module and return a handle to -- the `CryptolModule`. The contents of the module are not imported. -- @@ -458,56 +453,16 @@ loadCryptolModule :: CryptolEnv -> FilePath -> IO (CryptolModule, CryptolEnv) -loadCryptolModule sc env path = do - let modEnv = eModuleEnv env - (mtop, modEnv') <- liftModuleM modEnv $ - MB.loadModuleByPath True path - m <- case mtop of - T.TCTopModule mod' -> pure mod' - T.TCTopSignature {} -> - fail $ - "Expected a module, but " ++ show path ++ " is an interface." - - checkNotParameterized m - - -- Regenerate SharedTerm environment: - let oldModNames = map ME.lmName - $ ME.lmLoadedModules - $ ME.meLoadedModules modEnv - isNew m' = T.mName m' `notElem` oldModNames - newModules = filter isNew - $ map ME.lmModule - $ ME.lmLoadedModules - $ ME.meLoadedModules modEnv' - newDeclGroups = concatMap T.mDecls newModules - newNominal = Map.difference (loadedNonParamNominalTypes modEnv') - (loadedNonParamNominalTypes modEnv) - - newTermEnv <- - do oldCryEnv <- mkCryEnv env - cEnv <- C.genCodeForNominalTypes sc newNominal oldCryEnv - newCryEnv <- C.importTopLevelDeclGroups - sc C.defaultPrimitiveOptions cEnv newDeclGroups - return (C.envE newCryEnv) +loadCryptolModule sc env path = + do + (mod', env') <- loadAndTranslateModule sc env (Left path) -- NOTE: Bringing the module-handle into {{-}} scope is not handled -- here; it is done rather in `bindCryptolModule`, ONLY if the -- user binds the `cryptolModule` returned here at the SAW -- command line. - let env' = env { eModuleEnv = modEnv' - , eTermEnv = newTermEnv - , eFFITypes = updateFFITypes m newTermEnv (eFFITypes env) - } - -- NOTE here the difference between this function and - -- `importModule`: - -- 1. the `eImports` field is not updated, as - -- this module (as a whole) is not being - -- brought into scope inside {{ }} constructs. - -- 2. modEnv'' vs modEnv' (which may not be different, see - -- notes above). - - cryptolModule <- mkCryptolModule m env' + cryptolModule <- mkCryptolModule mod' env' return (cryptolModule, env') -- | mkCryptolModule From e88ed5350b612a328e62ee58da27c1ff131f0e75 Mon Sep 17 00:00:00 2001 From: Mark Tullsen Date: Wed, 17 Sep 2025 23:24:59 -0700 Subject: [PATCH 08/57] comments, refactors --- .../src/CryptolSAWCore/CryptolEnv.hs | 28 +++++++++---------- 1 file changed, 14 insertions(+), 14 deletions(-) diff --git a/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs b/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs index 0f9707a058..0d7a248398 100644 --- a/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs +++ b/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs @@ -443,6 +443,11 @@ checkNotParameterized m = -- | loadCryptolModule - load a cryptol module and return a handle to -- the `CryptolModule`. The contents of the module are not imported. -- +-- NOTE: Bringing the module-handle into {{-}} scope is not handled +-- here; it is done rather in `bindCryptolModule`, ONLY if the +-- user binds the `cryptolModule` returned here at the SAW +-- command line. +-- -- This is used to implement the "cryptol_load" primitive in which a -- handle to the module is returned and can be bound to a SAWScript -- variable. @@ -456,21 +461,15 @@ loadCryptolModule :: loadCryptolModule sc env path = do (mod', env') <- loadAndTranslateModule sc env (Left path) - - -- NOTE: Bringing the module-handle into {{-}} scope is not handled - -- here; it is done rather in `bindCryptolModule`, ONLY if the - -- user binds the `cryptolModule` returned here at the SAW - -- command line. - cryptolModule <- mkCryptolModule mod' env' return (cryptolModule, env') --- | mkCryptolModule +-- | mkCryptolModule - translate a T.Module to a CryptolModule -- -- FIXME: -- - This incorrectly excludes both submodules and their contents from --- the NamingEnvs in `CryptolModule` - +-- both of the NamingEnvs in `CryptolModule` +-- mkCryptolModule :: (?fileReader :: FilePath -> IO ByteString) => T.Module -> CryptolEnv -> IO CryptolModule @@ -661,11 +660,12 @@ importModule sc env src as vis imps = ) return $ env'{ eImports = newImport : eImports env } -locatedUnknown :: a -> P.Located a -locatedUnknown x = P.Located P.emptyRange x - -- XXX: it would be better to have the real position, but it - -- seems to have been thrown away on the Cryptol side in the uses - -- of this function. + where + locatedUnknown :: a -> P.Located a + locatedUnknown x = P.Located P.emptyRange x + -- XXX: it would be better to have the real position, but it + -- seems to have been thrown away on the Cryptol side in the uses + -- of this function. bindIdent :: Ident -> CryptolEnv -> (T.Name, CryptolEnv) bindIdent ident env = (name, env') From d5dad71bd6cd19f3481596339a7362090f6649a5 Mon Sep 17 00:00:00 2001 From: Mark Tullsen Date: Wed, 17 Sep 2025 23:30:16 -0700 Subject: [PATCH 09/57] refactor: make names more consistent - s/importModule/importCryptolModule/g; --- crux-mir-comp/src/Mir/Cryptol.hs | 2 +- cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs | 14 +++++++------- otherTests/cryptol-saw-core/CryptolVerifierTC.hs | 10 +++++----- saw-script/src/SAWScript/Interpreter.hs | 2 +- saw-server/src/SAWServer/CryptolSetup.hs | 4 ++-- 5 files changed, 16 insertions(+), 16 deletions(-) diff --git a/crux-mir-comp/src/Mir/Cryptol.hs b/crux-mir-comp/src/Mir/Cryptol.hs index ae1c2f7705..395713038b 100644 --- a/crux-mir-comp/src/Mir/Cryptol.hs +++ b/crux-mir-comp/src/Mir/Cryptol.hs @@ -242,7 +242,7 @@ loadCryptolFunc col sig modulePath name = do let ?fileReader = BS.readFile ce <- liftIO (readIORef (mirCryEnv mirState)) let modName = Cry.textToModName modulePath - ce' <- liftIO $ SAW.importModule sc ce (Right modName) Nothing SAW.PublicAndPrivate Nothing + ce' <- liftIO $ SAW.importCryptolModule sc ce (Right modName) Nothing SAW.PublicAndPrivate Nothing liftIO (writeIORef (mirCryEnv mirState) ce') -- (m, _ce') <- liftIO $ SAW.loadCryptolModule sc ce (Text.unpack modulePath) -- tt <- liftIO $ SAW.extractDefFromCryptolModule m (Text.unpack name) diff --git a/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs b/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs index 0d7a248398..4393612cef 100644 --- a/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs +++ b/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs @@ -18,7 +18,7 @@ module CryptolSAWCore.CryptolEnv , bindCryptolModule , extractDefFromCryptolModule , combineCryptolEnv - , importModule + , importCryptolModule , bindTypedTerm , bindType , bindInteger @@ -115,7 +115,7 @@ data InputText = InputText -------------------------------------------------------------------------------- --- | 'ImportVisibility' - Should a given import (see 'importModule') +-- | 'ImportVisibility' - Should a given import (see 'importCryptolModule') -- result in all symbols being visible (as they are for focused -- modules in the Cryptol REPL) or only public symbols? Making all -- symbols visible is useful for verification and code generation. @@ -537,10 +537,10 @@ updateFFITypes m eTermEnv' eFFITypes' = -- -- FIXME: -- - submodules are not handled correctly below. --- - the code is duplicating functionality that we have with `importModule` +-- - the code is duplicating functionality that we have with `importCryptolModule` -- TODO: -- - new design in PR #2593 (addressing issue #2569) should replace --- this function so that the fundamental work is done via `importModule`. +-- this function so that the fundamental work is done via `importCryptolModule`. bindCryptolModule :: (P.ModName, CryptolModule) -> CryptolEnv -> CryptolEnv bindCryptolModule (modName, CryptolModule sm tm) env = @@ -631,7 +631,7 @@ loadAndTranslateModule sc env src = } ) --- | @'importModule' sc env src as vis imps@ - extend the Cryptol +-- | @'importCryptolModule' sc env src as vis imps@ - extend the Cryptol -- environment with a module. Closely mirrors the sawscript command "import". -- -- NOTE: @@ -639,7 +639,7 @@ loadAndTranslateModule sc env src = -- - 'vis' we can import public definitions or *all* (i.e., internal -- and public) definitions. -importModule :: +importCryptolModule :: (?fileReader :: FilePath -> IO ByteString) => SharedContext {- ^ Shared context for creating terms -} -> CryptolEnv {- ^ Extend this environment -} -> @@ -648,7 +648,7 @@ importModule :: ImportVisibility {- ^ What visibility to give symbols from this module -} -> Maybe P.ImportSpec {- ^ What to import -} -> IO CryptolEnv -importModule sc env src as vis imps = +importCryptolModule sc env src as vis imps = do (mod', env') <- loadAndTranslateModule sc env src let newImport = (vis, P.Import { T.iModule= locatedUnknown (T.mName mod') diff --git a/otherTests/cryptol-saw-core/CryptolVerifierTC.hs b/otherTests/cryptol-saw-core/CryptolVerifierTC.hs index 15130f3fd2..0c9a1f0c50 100644 --- a/otherTests/cryptol-saw-core/CryptolVerifierTC.hs +++ b/otherTests/cryptol-saw-core/CryptolVerifierTC.hs @@ -27,15 +27,15 @@ main = let ?fileReader = BS.readFile cenv0 <- CEnv.initCryptolEnv sc putStrLn "Translated Cryptol.cry!" - cenv1 <- CEnv.importModule sc cenv0 (Right N.floatName) Nothing CEnv.OnlyPublic Nothing + cenv1 <- CEnv.importCryptolModule sc cenv0 (Right N.floatName) Nothing CEnv.OnlyPublic Nothing putStrLn "Translated Float.cry!" - cenv2 <- CEnv.importModule sc cenv1 (Right N.arrayName) Nothing CEnv.OnlyPublic Nothing + cenv2 <- CEnv.importCryptolModule sc cenv1 (Right N.arrayName) Nothing CEnv.OnlyPublic Nothing putStrLn "Translated Array.cry!" - cenv3 <- CEnv.importModule sc cenv2 (Right N.suiteBName) Nothing CEnv.OnlyPublic Nothing + cenv3 <- CEnv.importCryptolModule sc cenv2 (Right N.suiteBName) Nothing CEnv.OnlyPublic Nothing putStrLn "Translated SuiteB.cry!" - cenv4 <- CEnv.importModule sc cenv3 (Right N.primeECName) Nothing CEnv.OnlyPublic Nothing + cenv4 <- CEnv.importCryptolModule sc cenv3 (Right N.primeECName) Nothing CEnv.OnlyPublic Nothing putStrLn "Translated PrimeEC.cry!" - cenv5 <- CEnv.importModule sc cenv4 (Right N.preludeReferenceName) Nothing CEnv.OnlyPublic Nothing + cenv5 <- CEnv.importCryptolModule sc cenv4 (Right N.preludeReferenceName) Nothing CEnv.OnlyPublic Nothing putStrLn "Translated Reference.cry!" cenv6 <- CEnv.parseDecls sc cenv5 (CEnv.InputText superclassContents "superclass.cry" 1 1) putStrLn "Translated superclass.cry!" diff --git a/saw-script/src/SAWScript/Interpreter.hs b/saw-script/src/SAWScript/Interpreter.hs index 358bceeb4c..de0d2a505a 100644 --- a/saw-script/src/SAWScript/Interpreter.hs +++ b/saw-script/src/SAWScript/Interpreter.hs @@ -917,7 +917,7 @@ interpretTopStmt printBinds stmt = do let mLoc = iModule imp qual = iAs imp spec = iSpec imp - cenv' <- io $ CEnv.importModule sc (rwCryptol rw) mLoc qual CEnv.PublicAndPrivate spec + cenv' <- io $ CEnv.importCryptolModule sc (rwCryptol rw) mLoc qual CEnv.PublicAndPrivate spec putTopLevelRW $ rw { rwCryptol = cenv' } --showCryptolEnv diff --git a/saw-server/src/SAWServer/CryptolSetup.hs b/saw-server/src/SAWServer/CryptolSetup.hs index 8f5840717c..4340489eec 100644 --- a/saw-server/src/SAWServer/CryptolSetup.hs +++ b/saw-server/src/SAWServer/CryptolSetup.hs @@ -41,7 +41,7 @@ cryptolLoadModule (CryptolLoadModuleParams modName) = let importSpec = Nothing -- TODO add field to params fileReader <- Argo.getFileReader let ?fileReader = fileReader - cenv' <- liftIO $ try $ CEnv.importModule sc cenv (Right modName) qual CEnv.PublicAndPrivate importSpec + cenv' <- liftIO $ try $ CEnv.importCryptolModule sc cenv (Right modName) qual CEnv.PublicAndPrivate importSpec case cenv' of Left (ex :: SomeException) -> Argo.raise $ cryptolError (show ex) Right cenv'' -> @@ -76,7 +76,7 @@ cryptolLoadFile (CryptolLoadFileParams fileName) = let importSpec = Nothing -- TODO add field to params fileReader <- Argo.getFileReader let ?fileReader = fileReader - cenv' <- liftIO $ try $ CEnv.importModule sc cenv (Left fileName) qual CEnv.PublicAndPrivate importSpec + cenv' <- liftIO $ try $ CEnv.importCryptolModule sc cenv (Left fileName) qual CEnv.PublicAndPrivate importSpec case cenv' of Left (ex :: SomeException) -> Argo.raise $ cryptolError (show ex) Right cenv'' -> From bb89001490a2e6a0c78c7da57225c9301245938a Mon Sep 17 00:00:00 2001 From: Mark Tullsen Date: Fri, 19 Sep 2025 14:13:41 -0700 Subject: [PATCH 10/57] improve comments --- cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs | 14 +++++++++++--- 1 file changed, 11 insertions(+), 3 deletions(-) diff --git a/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs b/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs index 4393612cef..9d490225e9 100644 --- a/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs +++ b/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs @@ -440,6 +440,7 @@ checkNotParameterized m = , "Either use a ` import, or make a module instantiation." ] + -- | loadCryptolModule - load a cryptol module and return a handle to -- the `CryptolModule`. The contents of the module are not imported. -- @@ -464,6 +465,7 @@ loadCryptolModule sc env path = cryptolModule <- mkCryptolModule mod' env' return (cryptolModule, env') + -- | mkCryptolModule - translate a T.Module to a CryptolModule -- -- FIXME: @@ -532,12 +534,18 @@ updateFFITypes m eTermEnv' eFFITypes' = "Cannot find foreign function in term environment: " <> Text.pack (show nm) ] --- | bindCryptolModule - ad hoc function called when `D <-cryptol_load` is seen --- on the command line. +-- | bindCryptolModule - ad hoc function/hook that allows for extending +-- the Cryptol env with the names in a CryptolModule. +-- +-- Three command line variants get us here: +-- > D <- cryptol_load "PATH" +-- > x <- return (cryptol_prims ()) +-- > let x = cryptol_prims () -- -- FIXME: -- - submodules are not handled correctly below. --- - the code is duplicating functionality that we have with `importCryptolModule` +-- - the code is somewhat duplicating functionality that we +-- already have with `importCryptolModule` -- TODO: -- - new design in PR #2593 (addressing issue #2569) should replace -- this function so that the fundamental work is done via `importCryptolModule`. From 86c6c5330540b80ef749dbfa4f73fb6d81d3106c Mon Sep 17 00:00:00 2001 From: Mark Tullsen Date: Fri, 19 Sep 2025 16:48:22 -0700 Subject: [PATCH 11/57] comments, refactors (re-ordering, folding locatedUnknown, new mkImport) --- .../src/CryptolSAWCore/CryptolEnv.hs | 144 ++++++++++-------- 1 file changed, 82 insertions(+), 62 deletions(-) diff --git a/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs b/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs index 9d490225e9..da4fea717a 100644 --- a/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs +++ b/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs @@ -103,6 +103,9 @@ import CryptolSAWCore.TypedTerm import Cryptol.ModuleSystem.Env (ModContextParams(NoParams)) -- import SAWCentral.AST (Located(getVal, locatedPos), Import(..)) + +---- Key Types ----------------------------------------------------------------- + -- | Parse input, together with information about where it came from. data InputText = InputText { inpText :: Text -- ^ Parse this @@ -241,15 +244,16 @@ initCryptolEnv sc = do termEnv <- genTermEnv sc modEnv3 cryEnv0 -- The module names in P.Import are now Located, so give them an empty position. - let preludeName' = P.Located P.emptyRange preludeName - preludeReferenceName' = P.Located P.emptyRange preludeReferenceName - arrayName' = P.Located P.emptyRange arrayName + let preludeName' = locatedUnknown preludeName + preludeReferenceName' = locatedUnknown preludeReferenceName + arrayName' = locatedUnknown arrayName return CryptolEnv - { eImports = [ (OnlyPublic, P.Import preludeName' Nothing Nothing Nothing Nothing) - , (OnlyPublic, P.Import preludeReferenceName' (Just preludeReferenceName) Nothing Nothing Nothing) - , (OnlyPublic, P.Import arrayName' Nothing Nothing Nothing Nothing) - ] + { eImports = + [ mkImport OnlyPublic preludeName' Nothing Nothing + , mkImport OnlyPublic preludeReferenceName' (Just preludeReferenceName) Nothing + , mkImport OnlyPublic arrayName' Nothing Nothing + ] , eModuleEnv = modEnv3 , eExtraNames = mempty , eExtraTypes = Map.empty @@ -260,9 +264,10 @@ initCryptolEnv sc = do , eFFITypes = Map.empty } + -- | Translate all declarations in all loaded modules to SAWCore terms -- NOTE: used only for initialization code. - +-- genTermEnv :: SharedContext -> ME.ModuleEnv -> C.Env -> IO (Map T.Name Term) genTermEnv sc modEnv cryEnv0 = do let declGroups = concatMap T.mDecls @@ -304,8 +309,8 @@ ioParseResult res = case res of -- NamingEnv and Related ------------------------------------------------------- --- | @'getNamingEnv' env@ - get the full 'MR.NamingEnv' based on all the 'eImports' - +-- | @'getNamingEnv' env@ - get the full 'MR.NamingEnv' based on all +-- the 'eImports' getNamingEnv :: CryptolEnv -> MR.NamingEnv getNamingEnv env = eExtraNames env @@ -370,6 +375,7 @@ runInferOutput out = do MM.typeCheckWarnings nm warns MM.typeCheckingFailed nm errs + -- Translate ------------------------------------------------------------------- mkCryEnv :: @@ -422,8 +428,7 @@ translateDeclGroups sc env dgs = , eTermEnv = C.envE cryEnv' } --------------------------------------------------------------------------------- - +---- Misc Exports -------------------------------------------------------------- combineCryptolEnv :: CryptolEnv -> CryptolEnv -> IO CryptolEnv combineCryptolEnv chkEnv newEnv = @@ -433,13 +438,7 @@ combineCryptolEnv chkEnv newEnv = return chkEnv{ eModuleEnv = menv' } -checkNotParameterized :: T.Module -> IO () -checkNotParameterized m = - when (T.isParametrizedModule m) $ - fail $ unlines [ "Cannot load parameterized modules directly." - , "Either use a ` import, or make a module instantiation." - ] - +---- CryptolModule/ExtCryptolModule functions: --------------------------------- -- | loadCryptolModule - load a cryptol module and return a handle to -- the `CryptolModule`. The contents of the module are not imported. @@ -512,28 +511,6 @@ mkCryptolModule m env = newTermEnv ) -updateFFITypes :: T.Module -> Map MN.Name Term -> Map NameInfo T.FFI -> Map NameInfo T.FFI -updateFFITypes m eTermEnv' eFFITypes' = - foldr (\(nm, ty) -> Map.insert (getNameInfo nm) ty) - eFFITypes' - (T.findForeignDecls m) - where - getNameInfo nm = - case Map.lookup nm eTermEnv' of - Just tm -> - case asConstant tm of - Just n -> nameInfo n - Nothing -> - panic "updateFFITypes" [ - "SAWCore term of Cryptol name is not Constant", - "Name: " <> Text.pack (show nm), - "Term: " <> Text.pack (showTerm tm) - ] - Nothing -> - panic "updateFFITypes" [ - "Cannot find foreign function in term environment: " <> Text.pack (show nm) - ] - -- | bindCryptolModule - ad hoc function/hook that allows for extending -- the Cryptol env with the names in a CryptolModule. -- @@ -585,7 +562,7 @@ extractDefFromCryptolModule (CryptolModule _ tm) name = -- FIXME: this is ad hoc, somehow invoke parse for name, or the like? --------------------------------------------------------------------------------- +---- Core functions for loading and Translating Modules ------------------------ loadAndTranslateModule :: (?fileReader :: FilePath -> IO ByteString) => @@ -639,12 +616,44 @@ loadAndTranslateModule sc env src = } ) +checkNotParameterized :: T.Module -> IO () +checkNotParameterized m = + when (T.isParametrizedModule m) $ + fail $ unlines [ "Cannot load parameterized modules directly." + , "Either use a ` import, or make a module instantiation." + ] + +updateFFITypes :: T.Module -> Map MN.Name Term -> Map NameInfo T.FFI -> Map NameInfo T.FFI +updateFFITypes m eTermEnv' eFFITypes' = + foldr (\(nm, ty) -> Map.insert (getNameInfo nm) ty) + eFFITypes' + (T.findForeignDecls m) + where + getNameInfo nm = + case Map.lookup nm eTermEnv' of + Just tm -> + case asConstant tm of + Just n -> nameInfo n + Nothing -> + panic "updateFFITypes" [ + "SAWCore term of Cryptol name is not Constant", + "Name: " <> Text.pack (show nm), + "Term: " <> Text.pack (showTerm tm) + ] + Nothing -> + panic "updateFFITypes" [ + "Cannot find foreign function in term environment: " <> Text.pack (show nm) + ] + + +---- import -------------------------------------------------------------------- + -- | @'importCryptolModule' sc env src as vis imps@ - extend the Cryptol -- environment with a module. Closely mirrors the sawscript command "import". -- -- NOTE: --- - the module can be qualified or not (per 'as' argument). per --- - 'vis' we can import public definitions or *all* (i.e., internal +-- - the module can be qualified or not (per 'as' argument). +-- - per 'vis' we can import public definitions or *all* (i.e., internal -- and public) definitions. importCryptolModule :: @@ -659,21 +668,25 @@ importCryptolModule :: importCryptolModule sc env src as vis imps = do (mod', env') <- loadAndTranslateModule sc env src - let newImport = (vis, P.Import { T.iModule= locatedUnknown (T.mName mod') - , T.iAs = as - , T.iSpec = imps - , T.iInst = Nothing - , T.iDoc = Nothing - } - ) - return $ env'{ eImports = newImport : eImports env } - - where - locatedUnknown :: a -> P.Located a - locatedUnknown x = P.Located P.emptyRange x - -- XXX: it would be better to have the real position, but it - -- seems to have been thrown away on the Cryptol side in the uses - -- of this function. + return $ env'{ eImports = mkImport vis (locatedUnknown (T.mName mod')) as imps + : eImports env + } + +mkImport :: ImportVisibility + -> P.Located C.ModName + -> Maybe C.ModName + -> Maybe T.ImportSpec + -> (ImportVisibility, T.Import) +mkImport vis nm as imps = (vis, P.Import { T.iModule= nm + , T.iAs = as + , T.iSpec = imps + , T.iInst = Nothing + , T.iDoc = Nothing + } + ) + + +---- Binding ------------------------------------------------------------------- bindIdent :: Ident -> CryptolEnv -> (T.Name, CryptolEnv) bindIdent ident env = (name, env') @@ -725,6 +738,7 @@ bindInteger (ident, n) env = (name, env') = bindIdent ident env tysyn = T.TySyn name [] [] (T.tNum n) Nothing + -------------------------------------------------------------------------------- meSolverConfig :: ME.ModuleEnv -> TM.SolverConfig @@ -762,7 +776,6 @@ resolveIdentifier env nm = Left _ -> pure Nothing Right (x,_) -> pure (Just x) - parseTypedTerm :: (HasCallStack, ?fileReader :: FilePath -> IO ByteString) => SharedContext -> CryptolEnv -> InputText -> IO TypedTerm @@ -829,7 +842,7 @@ parseDecls sc env input = do (_nenv, rdecls) <- MM.interactive (MB.rename interactiveName (getNamingEnv env) (MR.renameTopDecls interactiveName topdecls)) -- Create a Module to contain the declarations - let rmodule = P.Module { P.mName = P.Located P.emptyRange interactiveName + let rmodule = P.Module { P.mName = locatedUnknown interactiveName , P.mDef = P.NormalModule rdecls , P.mInScope = mempty , P.mDocTop = Nothing @@ -919,7 +932,14 @@ typeNoUser t = schemaNoUser :: T.Schema -> T.Schema schemaNoUser (T.Forall params props ty) = T.Forall params props (typeNoUser ty) ------------------------------------------------------------- + +---- Local Utility Functions --------------------------------------------------- + +locatedUnknown :: a -> P.Located a +locatedUnknown x = P.Located P.emptyRange x + -- XXX: it would be better to have the real position, but it + -- seems to have been thrown away on the Cryptol side in the uses + -- of this function. liftModuleM :: (?fileReader :: FilePath -> IO ByteString) => From 764eb6d2088a2fe5897419f0f2336c1b3488c4d4 Mon Sep 17 00:00:00 2001 From: Mark Tullsen Date: Fri, 19 Sep 2025 20:00:08 -0700 Subject: [PATCH 12/57] refactor (with dead code, thus no compile), in prep for ... --- .../src/CryptolSAWCore/CryptolEnv.hs | 72 ++++++++++++++----- 1 file changed, 55 insertions(+), 17 deletions(-) diff --git a/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs b/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs index da4fea717a..d2e063e540 100644 --- a/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs +++ b/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs @@ -115,8 +115,16 @@ data InputText = InputText } +-- | ExtCryptolModule - Extended CryptolModule; we keep track of +-- whether this module came directly from a constructed +-- `CryptolModule` or whether it came from parsing a Cryptol module +-- in filesystem (in which case it is loaded). +data ExtCryptolModule = + ECM_LoadedModule (P.Located C.ModName) -- source is load + | ECM_CryptolModule CryptolModule -- source in cryptol_prims + -- deriving (Show) + -- FIXME: TODO: more instances --------------------------------------------------------------------------------- -- | 'ImportVisibility' - Should a given import (see 'importCryptolModule') -- result in all symbols being visible (as they are for focused @@ -440,18 +448,39 @@ combineCryptolEnv chkEnv newEnv = ---- CryptolModule/ExtCryptolModule functions: --------------------------------- --- | loadCryptolModule - load a cryptol module and return a handle to --- the `CryptolModule`. The contents of the module are not imported. --- --- NOTE: Bringing the module-handle into {{-}} scope is not handled --- here; it is done rather in `bindCryptolModule`, ONLY if the --- user binds the `cryptolModule` returned here at the SAW --- command line. +-- | loadCryptolModule - load a cryptol module and returns the +-- `ExtCryptolModule`. The contents of the module are not directly +-- imported into the environment. -- -- This is used to implement the "cryptol_load" primitive in which a -- handle to the module is returned and can be bound to a SAWScript -- variable. -- +-- NOTE: Bringing the module into {{-}} scope is not handled +-- here; it is done rather in `bindExtCryptolModule`, ONLY if the +-- user binds the `cryptolModule` returned here at the SAW +-- command line. +loadExtCryptolModule :: + (?fileReader :: FilePath -> IO ByteString) => + SharedContext -> + CryptolEnv -> + FilePath -> + IO (ExtCryptolModule, CryptolEnv) +loadExtCryptolModule sc env path = + do + (mod', env') <- loadAndTranslateModule sc env (Left path) + return (ECM_LoadedModule (locatedUnknown (T.mName mod')), env') + + +-- | loadCryptolModule +-- +-- NOTE: +-- - the path to this function from the command line is only via +-- the experimental "write_coq_cryptol_module" command. +-- +-- FIXME: This incorrectly (in MkCryptolModule) excludes both +-- submodules and their contents from the NamingEnvs in +-- `CryptolModule` loadCryptolModule :: (?fileReader :: FilePath -> IO ByteString) => SharedContext -> @@ -461,16 +490,10 @@ loadCryptolModule :: loadCryptolModule sc env path = do (mod', env') <- loadAndTranslateModule sc env (Left path) - cryptolModule <- mkCryptolModule mod' env' - return (cryptolModule, env') - + cm <- mkCryptolModule mod' env' + return (cm, env') -- | mkCryptolModule - translate a T.Module to a CryptolModule --- --- FIXME: --- - This incorrectly excludes both submodules and their contents from --- both of the NamingEnvs in `CryptolModule` --- mkCryptolModule :: (?fileReader :: FilePath -> IO ByteString) => T.Module -> CryptolEnv -> IO CryptolModule @@ -511,7 +534,7 @@ mkCryptolModule m env = newTermEnv ) --- | bindCryptolModule - ad hoc function/hook that allows for extending +-- | bindExtCryptolModule - ad hoc function/hook that allows for extending -- the Cryptol env with the names in a CryptolModule. -- -- Three command line variants get us here: @@ -526,6 +549,21 @@ mkCryptolModule m env = -- TODO: -- - new design in PR #2593 (addressing issue #2569) should replace -- this function so that the fundamental work is done via `importCryptolModule`. +-- +bindExtCryptolModule :: + (P.ModName, ExtCryptolModule) -> CryptolEnv -> CryptolEnv +bindExtCryptolModule (modName, ecm) = + case ecm of + ECM_CryptolModule cm -> bindCryptolModule (modName, cm) + ECM_LoadedModule nm -> bindLoadedModule (modName, nm) + +bindLoadedModule :: + (P.ModName, P.Located C.ModName) -> CryptolEnv -> CryptolEnv +bindLoadedModule (asName, origName) env = + env{eImports= mkImport PublicAndPrivate origName (Just asName) Nothing + : eImports env + } + bindCryptolModule :: (P.ModName, CryptolModule) -> CryptolEnv -> CryptolEnv bindCryptolModule (modName, CryptolModule sm tm) env = From 1f33f045b8a655d80abd2f7c6dddcd6b7f19d2f2 Mon Sep 17 00:00:00 2001 From: Mark Tullsen Date: Sat, 20 Sep 2025 20:49:52 -0700 Subject: [PATCH 13/57] generalize the internals of "CryptolModule" (as seen on command-line) and updating code to reflect this - CryptolModule (as known at the command line) is generalized to ExtCryptolModule, - this allows for a module to be represented as EITHER - CryptolModule (2 namespaces), or - the name of a loaded module - This allows for simpler and newly shared code - This now should support submodules when we `cryptol_load`. --- .../src/CryptolSAWCore/CryptolEnv.hs | 66 ++++++++++++------- intTests/test_saw_submodule_access1/test.sh | 6 +- .../test_load_D.saw | 48 ++++++++++++-- saw-central/src/SAWCentral/Builtins.hs | 11 ++-- saw-central/src/SAWCentral/Value.hs | 6 +- saw-script/src/SAWScript/Interpreter.hs | 8 +-- 6 files changed, 99 insertions(+), 46 deletions(-) diff --git a/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs b/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs index d2e063e540..9d1897e2ce 100644 --- a/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs +++ b/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs @@ -9,14 +9,20 @@ Stability : provisional {-# LANGUAGE ImplicitParams #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE LambdaCase #-} module CryptolSAWCore.CryptolEnv ( ImportVisibility(..) , CryptolEnv(..) + + , ExtCryptolModule(..) + , showExtCryptolModule , initCryptolEnv , loadCryptolModule - , bindCryptolModule - , extractDefFromCryptolModule + , loadExtCryptolModule + , bindExtCryptolModule + + , extractDefFromExtCryptolModule , combineCryptolEnv , importCryptolModule , bindTypedTerm @@ -114,18 +120,6 @@ data InputText = InputText , inpCol :: Int -- ^ On this column number } - --- | ExtCryptolModule - Extended CryptolModule; we keep track of --- whether this module came directly from a constructed --- `CryptolModule` or whether it came from parsing a Cryptol module --- in filesystem (in which case it is loaded). -data ExtCryptolModule = - ECM_LoadedModule (P.Located C.ModName) -- source is load - | ECM_CryptolModule CryptolModule -- source in cryptol_prims - -- deriving (Show) - -- FIXME: TODO: more instances - - -- | 'ImportVisibility' - Should a given import (see 'importCryptolModule') -- result in all symbols being visible (as they are for focused -- modules in the Cryptol REPL) or only public symbols? Making all @@ -446,7 +440,23 @@ combineCryptolEnv chkEnv newEnv = return chkEnv{ eModuleEnv = menv' } ----- CryptolModule/ExtCryptolModule functions: --------------------------------- +---- CryptolModule/ExtCryptolModule types and functions: ----------------------- + + +-- | ExtCryptolModule - Extended CryptolModule; we keep track of +-- whether this module came directly from a constructed +-- `CryptolModule` or whether it came from parsing a Cryptol module +-- from filesystem (in which case it is loaded). +data ExtCryptolModule = + ECM_LoadedModule (P.Located C.ModName) -- ^ source is parsed/loaded + | ECM_CryptolModule CryptolModule -- ^ source, constructed + -- (e.g., via cryptol_prims) + +showExtCryptolModule :: ExtCryptolModule -> String +showExtCryptolModule = + \case + ECM_LoadedModule name -> "loaded module '" ++ show(pp name) ++ "'" + ECM_CryptolModule cm -> showCryptolModule cm -- | loadCryptolModule - load a cryptol module and returns the -- `ExtCryptolModule`. The contents of the module are not directly @@ -589,16 +599,22 @@ bindCryptolModule (modName, CryptolModule sm tm) env = addTSyn name = MN.shadowing (MN.singletonNS C.NSType (P.mkQual modName (MN.nameIdent name)) name) -- | NOTE: this is only used in the "cryptol_extract" primitive. -extractDefFromCryptolModule :: CryptolModule -> Text -> IO TypedTerm -extractDefFromCryptolModule (CryptolModule _ tm) name = - case Map.lookup (mkIdent name) (Map.mapKeys MN.nameIdent tm) of - Just t -> return t - Nothing -> fail $ Text.unpack $ "Binding not found: " <> name - -- FIXME: unfortunate we have lost the name of the module. - - -- FIXME: bug: we can't access definitions in submodules. - -- FIXME: this is ad hoc, somehow invoke parse for name, or the like? - +extractDefFromExtCryptolModule :: ExtCryptolModule -> Text -> IO TypedTerm +extractDefFromExtCryptolModule ecm name = + case ecm of + ECM_LoadedModule _modname -> + -- do env' <- bindLoadedModule ... + panic "extractDefFromExtCryptolModule" + ["FIXME: not implemented yet: need plumbing!"] + ECM_CryptolModule (CryptolModule _ tm) -> + case Map.lookup (mkIdent name) (Map.mapKeys MN.nameIdent tm) of + Just t -> return t + Nothing -> fail $ Text.unpack $ "Binding not found: " <> name + + -- FIXME: bug: we can't access definitions in submodules. + -- FIXME: this is ad hoc, somehow invoke parse for name, or the like? + -- FIXME: if one had a CryptolModule with qualified names (e.g., it + -- was generated from a module with submodules), would this work? ---- Core functions for loading and Translating Modules ------------------------ diff --git a/intTests/test_saw_submodule_access1/test.sh b/intTests/test_saw_submodule_access1/test.sh index c6c01a2e64..79e3e0452b 100755 --- a/intTests/test_saw_submodule_access1/test.sh +++ b/intTests/test_saw_submodule_access1/test.sh @@ -5,10 +5,6 @@ $SAW test_import_errors.saw $SAW test_import_D.saw -! $SAW test_load_D.saw - - # finishing https://github.com/GaloisInc/saw-script/pull/2593 - # should allow test_load_D.saw to succeed. (as it should) - # TODO: remove the ! above when that PR is done. +$SAW test_load_D.saw $SAW test_UseFunctors.saw diff --git a/intTests/test_saw_submodule_access1/test_load_D.saw b/intTests/test_saw_submodule_access1/test_load_D.saw index 09c0a0df1e..c73eba4de3 100644 --- a/intTests/test_saw_submodule_access1/test_load_D.saw +++ b/intTests/test_saw_submodule_access1/test_load_D.saw @@ -1,9 +1,47 @@ -D <- cryptol_load "D.cry"; +//////////////////////////////////////////////// +DDD <- cryptol_load "D.cry"; -print (eval_int {{D::D2::d2}}); // should succeed +print (eval_int {{DDD::D2::d2}}); // should succeed + +return DDD; // confirming fails of things that shouldn't be in scope: -fails (do {return {{ d2 }};}); -fails (do {return {{ D::d2 }};}); +fails (do {return {{D::D2::d2}};}); // 'D' not in scope. +fails (do {return {{ d2 }};}); // this requires DDD qualifier +fails (do {return {{ DDD::d2 }};}); // missing submodule qualifier. + +//////////////////////////////////////////////// +// Secondary bindings + +print "secondary bindings:"; + +DDD2 <- return DDD; +let DDD3 = DDD; + +print (eval_int {{DDD2::D2::d2}}); // should succeed +print (eval_int {{DDD3::D2::d2}}); // should succeed + +///////////////////////////////////////////// +// NOW let's see how the prims work: + +let CP1 = cryptol_prims (); +CP2 <- return (cryptol_prims ()); + +print ""; +print "{{ CP1::trunc }}"; +print {{ CP1::trunc }}; + +print ""; +print "{{ CP2::uext }}"; +print {{ CP2::uext }}; + +print ""; +fails (do {return {{ uext }};}); // not (directly) in scope. + +print "CP1 sext:"; +do {y <- cryptol_extract CP1 "sext"; print y;}; + +print "CP2 sgt:"; +do {y <- cryptol_extract CP2 "sgt"; print y;}; -print "done"; \ No newline at end of file +print "done"; diff --git a/saw-central/src/SAWCentral/Builtins.hs b/saw-central/src/SAWCentral/Builtins.hs index bec1cbf845..c3a7af1bbe 100644 --- a/saw-central/src/SAWCentral/Builtins.hs +++ b/saw-central/src/SAWCentral/Builtins.hs @@ -2045,8 +2045,11 @@ get_env name = do Nothing -> fail $ "Environment variable not found: " ++ Text.unpack name Just v -> return $ Text.pack v -cryptol_prims :: TopLevel CryptolModule -cryptol_prims = CryptolModule Map.empty <$> Map.fromList <$> traverse parsePrim prims +cryptol_prims :: TopLevel CEnv.ExtCryptolModule +cryptol_prims = + CEnv.ECM_CryptolModule + <$> CryptolModule Map.empty + <$> Map.fromList <$> traverse parsePrim prims where prims :: [(Text, Ident, Text)] prims = @@ -2081,13 +2084,13 @@ cryptol_prims = CryptolModule Map.empty <$> Map.fromList <$> traverse parsePrim putTopLevelRW $ rw { rwCryptol = cenv' } return (n', TypedTerm (TypedTermSchema s') t') -cryptol_load :: (FilePath -> IO StrictBS.ByteString) -> FilePath -> TopLevel CryptolModule +cryptol_load :: (FilePath -> IO StrictBS.ByteString) -> FilePath -> TopLevel CEnv.ExtCryptolModule cryptol_load fileReader path = do sc <- getSharedContext rw <- getTopLevelRW let ce = rwCryptol rw let ?fileReader = fileReader - (m, ce') <- io $ CEnv.loadCryptolModule sc ce path + (m, ce') <- io $ CEnv.loadExtCryptolModule sc ce path putTopLevelRW $ rw { rwCryptol = ce' } return m diff --git a/saw-central/src/SAWCentral/Value.hs b/saw-central/src/SAWCentral/Value.hs index 4b37477b0d..05de85b586 100644 --- a/saw-central/src/SAWCentral/Value.hs +++ b/saw-central/src/SAWCentral/Value.hs @@ -559,7 +559,7 @@ data Value | VJavaType JavaType | VLLVMType LLVM.Type | VMIRType MIR.Ty - | VCryptolModule CryptolModule + | VCryptolModule CEnv.ExtCryptolModule | VJavaClass JSS.Class | VLLVMModule (Some CMSLLVM.LLVMModule) | VMIRModule RustModule @@ -693,7 +693,7 @@ showsPrecValue opts nenv p v = VJavaType {} -> showString "<>" VLLVMType t -> showString (show (Crucible.LLVM.ppType t)) VMIRType t -> showString (show (PP.pretty t)) - VCryptolModule m -> showString (showCryptolModule m) + VCryptolModule m -> showString (CEnv.showExtCryptolModule m) VLLVMModule (Some m) -> showString (CMSLLVM.showLLVMModule m) VMIRModule m -> shows (PP.pretty (m^.rmCS^.collection)) VMIRAdt adt -> shows (PP.pretty adt) @@ -1171,7 +1171,7 @@ extendEnv sc pos name rb ty doc v rw = VInteger n -> pure $ CEnv.bindInteger (ident, n) ce VCryptolModule m -> - pure $ CEnv.bindCryptolModule (modname, m) ce + pure $ CEnv.bindExtCryptolModule (modname, m) ce VString s -> do tt <- typedTermOfString sc (Text.unpack s) pure $ CEnv.bindTypedTerm (ident, tt) ce diff --git a/saw-script/src/SAWScript/Interpreter.hs b/saw-script/src/SAWScript/Interpreter.hs index de0d2a505a..f2b8b9592e 100644 --- a/saw-script/src/SAWScript/Interpreter.hs +++ b/saw-script/src/SAWScript/Interpreter.hs @@ -1580,10 +1580,10 @@ instance FromValue MIR.Ty where fromValue _ (VMIRType t) = t fromValue _ _ = error "fromValue MIRType" -instance IsValue CryptolModule where +instance IsValue CEnv.ExtCryptolModule where toValue _name m = VCryptolModule m -instance FromValue CryptolModule where +instance FromValue CEnv.ExtCryptolModule where fromValue _ (VCryptolModule m) = m fromValue _ _ = error "fromValue CryptolModule" @@ -2202,7 +2202,7 @@ do_offline_w4_unint_yices :: [Text] -> Text -> ProofScript () do_offline_w4_unint_yices unints path = offline_w4_unint_yices unints (Text.unpack path) -do_cryptol_load :: (FilePath -> IO BS.ByteString) -> Text -> TopLevel CryptolModule +do_cryptol_load :: (FilePath -> IO BS.ByteString) -> Text -> TopLevel CEnv.ExtCryptolModule do_cryptol_load loader path = cryptol_load loader (Text.unpack path) @@ -4123,7 +4123,7 @@ primitives = Map.fromList $ [ "Load the given file as a Cryptol module." ] , prim "cryptol_extract" "CryptolModule -> String -> TopLevel Term" - (pureVal CEnv.extractDefFromCryptolModule) + (pureVal CEnv.extractDefFromExtCryptolModule) Current [ "Load a single definition from a Cryptol module and translate it into" , "a 'Term'." From 78322aae65b6bec5d2d57a4a6407403e895686b6 Mon Sep 17 00:00:00 2001 From: Mark Tullsen Date: Tue, 23 Sep 2025 18:26:39 -0700 Subject: [PATCH 14/57] refactors, comments, whitespace --- .../src/CryptolSAWCore/CryptolEnv.hs | 81 +++++++++++-------- 1 file changed, 46 insertions(+), 35 deletions(-) diff --git a/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs b/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs index 9d1897e2ce..b731c160b8 100644 --- a/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs +++ b/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs @@ -131,7 +131,8 @@ data InputText = InputText -- data ImportVisibility = OnlyPublic -- ^ behaves like a normal Cryptol "import" - | PublicAndPrivate -- ^ allows viewing of both "private" sections and (arbitrarily nested) submodules. + | PublicAndPrivate -- ^ allows viewing of both "private" sections + -- and (arbitrarily nested) submodules. deriving (Eq, Show) @@ -188,6 +189,7 @@ nameMatcher xs = in last cs == identText (C.ogName og) && init cs == C.modNameChunksText top ++ map identText ns + -- Initialize ------------------------------------------------------------------ -- | initCryptolEnv - Create initial CryptolEnv, this involves loading @@ -227,7 +229,7 @@ initCryptolEnv sc = do _ <- MB.loadModuleFrom False (MM.FromModule arrayName) return () - -- Load Cryptol reference implementations + -- Load Cryptol reference implementation ((_,refTop), modEnv3) <- liftModuleM modEnv2 $ MB.loadModuleFrom False (MM.FromModule preludeReferenceName) @@ -484,13 +486,13 @@ loadExtCryptolModule sc env path = -- | loadCryptolModule -- --- NOTE: +-- NOTE RE CALLERS: -- - the path to this function from the command line is only via -- the experimental "write_coq_cryptol_module" command. -- --- FIXME: This incorrectly (in MkCryptolModule) excludes both --- submodules and their contents from the NamingEnvs in --- `CryptolModule` +-- This function (note `mkCryptolModule`) returns the public types and values +-- of the module in a `CryptolModule` structure. +-- loadCryptolModule :: (?fileReader :: FilePath -> IO ByteString) => SharedContext -> @@ -503,7 +505,11 @@ loadCryptolModule sc env path = cm <- mkCryptolModule mod' env' return (cm, env') --- | mkCryptolModule - translate a T.Module to a CryptolModule + +-- | mkCryptolModule m env - translate a @m :: T.Module@ to a `CryptolModule` +-- +-- This function returns the public types and values of the module `m` +-- as a `CryptolModule` structure. mkCryptolModule :: (?fileReader :: FilePath -> IO ByteString) => T.Module -> CryptolEnv -> IO CryptolModule @@ -512,9 +518,9 @@ mkCryptolModule m env = let newTermEnv = eTermEnv env modEnv = eModuleEnv env ifaceDecls = getAllIfaceDecls modEnv - (types, _modEnv) <- liftModuleM modEnv $ do - -- NOTE: _modEnv == modEnv - -- - as we elaborate below, the monadic actions are all 'readers' + (types, _modEnv) <- liftModuleM modEnv $ + -- NOTE: _modEnv == modEnv, because, as we elaborate below, + -- the monadic actions are all 'readers'. do prims <- MB.getPrimMap -- generate the primitive map; a monad reader TM.inpVars `fmap` @@ -526,28 +532,32 @@ mkCryptolModule m env = -- - If we had inlined, it appears that this is functional code. -- - (Possibly because of information hiding?) - let names = MEx.exported C.NSValue (T.mExports m) -- :: Set T.Name return $ - CryptolModule - -- create type synonym Map, keep only the exports: - (Map.filterWithKey - (\k _ -> Set.member k (MEx.exported C.NSType (T.mExports m))) - (T.mTySyns m) - ) - -- FIXME: TODO: ensure type synonyms in submodule are included. - - -- create the map of symbols: - ( Map.filterWithKey (\k _ -> Set.member k names) - $ Map.intersectionWith - (\t x -> TypedTerm (TypedTermSchema t) x) - types - newTermEnv - ) - --- | bindExtCryptolModule - ad hoc function/hook that allows for extending --- the Cryptol env with the names in a CryptolModule. + let + -- we're keeping only the exports of `m`: + vNameSet = MEx.exported C.NSValue (T.mExports m) + tNameSet = MEx.exported C.NSType (T.mExports m) + in + CryptolModule + -- create Map of type synonyms + (Map.filterWithKey + (\k _ -> Set.member k tNameSet) + (T.mTySyns m) + ) + + -- create Map of the `TypedTerm` s: + ( Map.filterWithKey (\k _ -> Set.member k vNameSet) + $ Map.intersectionWith + (\t x -> TypedTerm (TypedTermSchema t) x) + types + newTermEnv + ) + +-- | bindExtCryptolModule - ad hoc function/hook that allows for +-- extending the Cryptol environment with the names in a Cryptol +-- module, `ExtCryptolModule`. -- --- Three command line variants get us here: +-- NOTE RE CALLERS: Three command line variants get us here: -- > D <- cryptol_load "PATH" -- > x <- return (cryptol_prims ()) -- > let x = cryptol_prims () @@ -616,6 +626,7 @@ extractDefFromExtCryptolModule ecm name = -- FIXME: if one had a CryptolModule with qualified names (e.g., it -- was generated from a module with submodules), would this work? + ---- Core functions for loading and Translating Modules ------------------------ loadAndTranslateModule :: @@ -977,10 +988,10 @@ declareName env mname input = do typeNoUser :: T.Type -> T.Type typeNoUser t = case t of - T.TCon tc ts -> T.TCon tc (map typeNoUser ts) - T.TVar {} -> t - T.TUser _ _ ty -> typeNoUser ty - T.TRec fields -> T.TRec (fmap typeNoUser fields) + T.TCon tc ts -> T.TCon tc (map typeNoUser ts) + T.TVar {} -> t + T.TUser _ _ ty -> typeNoUser ty + T.TRec fields -> T.TRec (fmap typeNoUser fields) T.TNominal nt ts -> T.TNominal nt (fmap typeNoUser ts) schemaNoUser :: T.Schema -> T.Schema @@ -996,7 +1007,7 @@ locatedUnknown x = P.Located P.emptyRange x -- of this function. liftModuleM :: - (?fileReader :: FilePath -> IO ByteString) => + (?fileReader :: FilePath -> IO ByteString) => ME.ModuleEnv -> MM.ModuleM a -> IO (a, ME.ModuleEnv) liftModuleM env m = do let minp solver = MM.ModuleInput { From b74ab644dc6b134992954560dbff6622cb5bbefe Mon Sep 17 00:00:00 2001 From: Mark Tullsen Date: Tue, 23 Sep 2025 18:40:22 -0700 Subject: [PATCH 15/57] revert (misguided) c923c717b revert c923c717b... improve submodule support for CLI `cryptol_load` --- cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs | 3 --- 1 file changed, 3 deletions(-) diff --git a/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs b/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs index b731c160b8..b27a5d80d1 100644 --- a/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs +++ b/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs @@ -589,7 +589,6 @@ bindCryptolModule :: (P.ModName, CryptolModule) -> CryptolEnv -> CryptolEnv bindCryptolModule (modName, CryptolModule sm tm) env = env { eExtraNames = flip (foldr addName) (Map.keys tm') $ flip (foldr addTSyn) (Map.keys sm) $ - flip (foldr addSubModule) (Map.keys tm') $ eExtraNames env , eExtraTSyns = Map.union sm (eExtraTSyns env) , eExtraTypes = Map.union (fmap fst tm') (eExtraTypes env) @@ -604,8 +603,6 @@ bindCryptolModule (modName, CryptolModule sm tm) env = addName name = MN.shadowing (MN.singletonNS C.NSValue (P.mkQual modName (MN.nameIdent name)) name) - addSubModule name = MN.shadowing (MN.singletonNS C.NSModule (P.mkQual modName (MN.nameIdent name)) name) - addTSyn name = MN.shadowing (MN.singletonNS C.NSType (P.mkQual modName (MN.nameIdent name)) name) -- | NOTE: this is only used in the "cryptol_extract" primitive. From 829c5324f56d3a8914f8b105250cba5b370114d1 Mon Sep 17 00:00:00 2001 From: Mark Tullsen Date: Tue, 23 Sep 2025 18:43:19 -0700 Subject: [PATCH 16/57] comments: move/improve; change whitespace/identing --- .../src/CryptolSAWCore/CryptolEnv.hs | 46 +++++++++++-------- 1 file changed, 28 insertions(+), 18 deletions(-) diff --git a/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs b/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs index b27a5d80d1..249f17a740 100644 --- a/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs +++ b/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs @@ -486,7 +486,7 @@ loadExtCryptolModule sc env path = -- | loadCryptolModule -- --- NOTE RE CALLERS: +-- NOTE RE CALLS TO: -- - the path to this function from the command line is only via -- the experimental "write_coq_cryptol_module" command. -- @@ -555,21 +555,13 @@ mkCryptolModule m env = -- | bindExtCryptolModule - ad hoc function/hook that allows for -- extending the Cryptol environment with the names in a Cryptol --- module, `ExtCryptolModule`. +-- module, represented here by a `ExtCryptolModule`. -- --- NOTE RE CALLERS: Three command line variants get us here: +-- NOTE RE CALLS TO: Three command line variants get us here: -- > D <- cryptol_load "PATH" -- > x <- return (cryptol_prims ()) -- > let x = cryptol_prims () -- --- FIXME: --- - submodules are not handled correctly below. --- - the code is somewhat duplicating functionality that we --- already have with `importCryptolModule` --- TODO: --- - new design in PR #2593 (addressing issue #2569) should replace --- this function so that the fundamental work is done via `importCryptolModule`. --- bindExtCryptolModule :: (P.ModName, ExtCryptolModule) -> CryptolEnv -> CryptolEnv bindExtCryptolModule (modName, ecm) = @@ -583,8 +575,16 @@ bindLoadedModule (asName, origName) env = env{eImports= mkImport PublicAndPrivate origName (Just asName) Nothing : eImports env } + -- FIXME:MT: PublicAndPrivate?! - +-- | bindCryptolModule - binding when we have the ECM_CryptolModule side. +-- +-- NOTE: +-- - this code is duplicating functionality that we already have with +-- `importCryptolModule`. We would like to have just one piece of +-- code that computes the names (i.e., have just "one source of +-- truth" here). +-- bindCryptolModule :: (P.ModName, CryptolModule) -> CryptolEnv -> CryptolEnv bindCryptolModule (modName, CryptolModule sm tm) env = env { eExtraNames = flip (foldr addName) (Map.keys tm') $ @@ -601,9 +601,13 @@ bindCryptolModule (modName, CryptolModule sm tm) env = f (TypedTerm (TypedTermSchema s) x) = Just (s,x) f _ = Nothing - addName name = MN.shadowing (MN.singletonNS C.NSValue (P.mkQual modName (MN.nameIdent name)) name) + addName name = + MN.shadowing + (MN.singletonNS C.NSValue (P.mkQual modName (MN.nameIdent name)) name) - addTSyn name = MN.shadowing (MN.singletonNS C.NSType (P.mkQual modName (MN.nameIdent name)) name) + addTSyn name = + MN.shadowing + (MN.singletonNS C.NSType (P.mkQual modName (MN.nameIdent name)) name) -- | NOTE: this is only used in the "cryptol_extract" primitive. extractDefFromExtCryptolModule :: ExtCryptolModule -> Text -> IO TypedTerm @@ -618,10 +622,16 @@ extractDefFromExtCryptolModule ecm name = Just t -> return t Nothing -> fail $ Text.unpack $ "Binding not found: " <> name - -- FIXME: bug: we can't access definitions in submodules. - -- FIXME: this is ad hoc, somehow invoke parse for name, or the like? - -- FIXME: if one had a CryptolModule with qualified names (e.g., it - -- was generated from a module with submodules), would this work? + -- NOTE RE CALLS TO: + -- - currently we can only get to this branch when CryptolModule + -- is the one created with `cryptol_prims` (Haskell function and + -- SAWScript function). E.g., + -- + -- > cryptol_extract (cryptol_prims ()) "trunc" + -- + -- FIXME: this code is somewhat ad hoc, might we rather invoke + -- parse for name, or the like? However, we expect this code + -- would likely go away after we address Issue #. ---- Core functions for loading and Translating Modules ------------------------ From d2b1ad90749f157e37e4914f38f73466cb3bd7c6 Mon Sep 17 00:00:00 2001 From: Mark Tullsen Date: Wed, 24 Sep 2025 14:37:10 -0700 Subject: [PATCH 17/57] refactor: re-plumb to get more arguments to `extractDefFromExtCryptolModule` --- .../src/CryptolSAWCore/CryptolEnv.hs | 18 ++++++++++++------ saw-central/src/SAWCentral/Builtins.hs | 7 +++++++ saw-script/src/SAWScript/Interpreter.hs | 2 +- 3 files changed, 20 insertions(+), 7 deletions(-) diff --git a/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs b/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs index 249f17a740..e4d8ee2857 100644 --- a/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs +++ b/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs @@ -609,18 +609,24 @@ bindCryptolModule (modName, CryptolModule sm tm) env = MN.shadowing (MN.singletonNS C.NSType (P.mkQual modName (MN.nameIdent name)) name) --- | NOTE: this is only used in the "cryptol_extract" primitive. -extractDefFromExtCryptolModule :: ExtCryptolModule -> Text -> IO TypedTerm -extractDefFromExtCryptolModule ecm name = + +-- | extractDefFromExtCryptolModule sc en ecm name - interpret `name` as a definition in +-- the module `ecm`, return the TypedTerm. +-- +-- NOTE RE CALLS TO: this is (only) used for the "cryptol_extract" primitive. +-- +extractDefFromExtCryptolModule :: + SharedContext -> CryptolEnv -> ExtCryptolModule -> Text -> IO TypedTerm +extractDefFromExtCryptolModule sc env ecm name = case ecm of ECM_LoadedModule _modname -> -- do env' <- bindLoadedModule ... panic "extractDefFromExtCryptolModule" ["FIXME: not implemented yet: need plumbing!"] ECM_CryptolModule (CryptolModule _ tm) -> - case Map.lookup (mkIdent name) (Map.mapKeys MN.nameIdent tm) of - Just t -> return t - Nothing -> fail $ Text.unpack $ "Binding not found: " <> name + case Map.lookup (mkIdent name) (Map.mapKeys MN.nameIdent tm) of + Just t -> return t + Nothing -> fail $ Text.unpack $ "Binding not found: " <> name -- NOTE RE CALLS TO: -- - currently we can only get to this branch when CryptolModule diff --git a/saw-central/src/SAWCentral/Builtins.hs b/saw-central/src/SAWCentral/Builtins.hs index c3a7af1bbe..a09d39d32f 100644 --- a/saw-central/src/SAWCentral/Builtins.hs +++ b/saw-central/src/SAWCentral/Builtins.hs @@ -2094,6 +2094,13 @@ cryptol_load fileReader path = do putTopLevelRW $ rw { rwCryptol = ce' } return m +cryptol_extract :: CEnv.ExtCryptolModule -> Text -> TopLevel TypedTerm +cryptol_extract ecm var = do + sc <- getSharedContext + rw <- getTopLevelRW + let ce = rwCryptol rw + io $ CEnv.extractDefFromExtCryptolModule sc ce ecm var + cryptol_add_path :: FilePath -> TopLevel () cryptol_add_path path = do rw <- getTopLevelRW diff --git a/saw-script/src/SAWScript/Interpreter.hs b/saw-script/src/SAWScript/Interpreter.hs index f2b8b9592e..dd383b5f97 100644 --- a/saw-script/src/SAWScript/Interpreter.hs +++ b/saw-script/src/SAWScript/Interpreter.hs @@ -4123,7 +4123,7 @@ primitives = Map.fromList $ [ "Load the given file as a Cryptol module." ] , prim "cryptol_extract" "CryptolModule -> String -> TopLevel Term" - (pureVal CEnv.extractDefFromExtCryptolModule) + (pureVal cryptol_extract) Current [ "Load a single definition from a Cryptol module and translate it into" , "a 'Term'." From 9ee42b59bfb0b0f675006e7bfa280016b7bdb00e Mon Sep 17 00:00:00 2001 From: Mark Tullsen Date: Wed, 24 Sep 2025 14:38:00 -0700 Subject: [PATCH 18/57] finish "generalize the internals of "CryptolModule" by finishing extractDefFromExtCryptolModule --- .../src/CryptolSAWCore/CryptolEnv.hs | 26 ++++++++++++++++--- 1 file changed, 22 insertions(+), 4 deletions(-) diff --git a/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs b/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs index e4d8ee2857..9ca851bea6 100644 --- a/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs +++ b/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs @@ -619,10 +619,19 @@ extractDefFromExtCryptolModule :: SharedContext -> CryptolEnv -> ExtCryptolModule -> Text -> IO TypedTerm extractDefFromExtCryptolModule sc env ecm name = case ecm of - ECM_LoadedModule _modname -> - -- do env' <- bindLoadedModule ... - panic "extractDefFromExtCryptolModule" - ["FIXME: not implemented yet: need plumbing!"] + ECM_LoadedModule loadedModName -> + do let localMN = C.packModName + [ "INTERNAL" + , C.modNameToText (P.thing loadedModName) + ] + env' = bindLoadedModule (localMN, loadedModName) env + -- FIXME: PublicAndPrivate now. ? + expr = noLoc (C.modNameToText localMN <> "::" <> name) + -- FIXME: be more robust? create an identifier? + let ?fileReader = panic "fileReader" + ["extractDefFromExtCryptolModule"] + parseTypedTerm sc env' expr + ECM_CryptolModule (CryptolModule _ tm) -> case Map.lookup (mkIdent name) (Map.mapKeys MN.nameIdent tm) of Just t -> return t @@ -1013,6 +1022,15 @@ schemaNoUser (T.Forall params props ty) = T.Forall params props (typeNoUser ty) ---- Local Utility Functions --------------------------------------------------- +noLoc :: Text -> InputText +noLoc x = InputText + { inpText = x + , inpFile = "(internalUse)" + , inpLine = 1 + , inpCol = 1 + } + + locatedUnknown :: a -> P.Located a locatedUnknown x = P.Located P.emptyRange x -- XXX: it would be better to have the real position, but it From 64f3503d14f01a9db2c6798419f7708953dd7363 Mon Sep 17 00:00:00 2001 From: Mark Tullsen Date: Wed, 24 Sep 2025 22:23:26 -0700 Subject: [PATCH 19/57] comments --- cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs | 9 +++------ 1 file changed, 3 insertions(+), 6 deletions(-) diff --git a/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs b/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs index 9ca851bea6..1c687f8d09 100644 --- a/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs +++ b/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs @@ -575,7 +575,6 @@ bindLoadedModule (asName, origName) env = env{eImports= mkImport PublicAndPrivate origName (Just asName) Nothing : eImports env } - -- FIXME:MT: PublicAndPrivate?! -- | bindCryptolModule - binding when we have the ECM_CryptolModule side. -- @@ -625,9 +624,7 @@ extractDefFromExtCryptolModule sc env ecm name = , C.modNameToText (P.thing loadedModName) ] env' = bindLoadedModule (localMN, loadedModName) env - -- FIXME: PublicAndPrivate now. ? expr = noLoc (C.modNameToText localMN <> "::" <> name) - -- FIXME: be more robust? create an identifier? let ?fileReader = panic "fileReader" ["extractDefFromExtCryptolModule"] parseTypedTerm sc env' expr @@ -645,9 +642,9 @@ extractDefFromExtCryptolModule sc env ecm name = -- > cryptol_extract (cryptol_prims ()) "trunc" -- -- FIXME: this code is somewhat ad hoc, might we rather invoke - -- parse for name, or the like? However, we expect this code - -- would likely go away after we address Issue #. - + -- parse for name, or the like? However, this code becomes + -- unnecessary after addressing Issue #2645 (turning + -- cryptol_prims into a built-in Cryptol module). ---- Core functions for loading and Translating Modules ------------------------ From 5f73a0bc64f2e6c23aa162ae0483566def349ff6 Mon Sep 17 00:00:00 2001 From: Mark Tullsen Date: Thu, 25 Sep 2025 09:58:25 -0700 Subject: [PATCH 20/57] plumb ?fileReader down. --- cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs | 3 +-- saw-central/src/SAWCentral/Builtins.hs | 1 + 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs b/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs index 1c687f8d09..b79aa8c151 100644 --- a/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs +++ b/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs @@ -615,6 +615,7 @@ bindCryptolModule (modName, CryptolModule sm tm) env = -- NOTE RE CALLS TO: this is (only) used for the "cryptol_extract" primitive. -- extractDefFromExtCryptolModule :: + (?fileReader :: FilePath -> IO ByteString) => SharedContext -> CryptolEnv -> ExtCryptolModule -> Text -> IO TypedTerm extractDefFromExtCryptolModule sc env ecm name = case ecm of @@ -625,8 +626,6 @@ extractDefFromExtCryptolModule sc env ecm name = ] env' = bindLoadedModule (localMN, loadedModName) env expr = noLoc (C.modNameToText localMN <> "::" <> name) - let ?fileReader = panic "fileReader" - ["extractDefFromExtCryptolModule"] parseTypedTerm sc env' expr ECM_CryptolModule (CryptolModule _ tm) -> diff --git a/saw-central/src/SAWCentral/Builtins.hs b/saw-central/src/SAWCentral/Builtins.hs index a09d39d32f..dbedce9d88 100644 --- a/saw-central/src/SAWCentral/Builtins.hs +++ b/saw-central/src/SAWCentral/Builtins.hs @@ -2099,6 +2099,7 @@ cryptol_extract ecm var = do sc <- getSharedContext rw <- getTopLevelRW let ce = rwCryptol rw + let ?fileReader = StrictBS.readFile io $ CEnv.extractDefFromExtCryptolModule sc ce ecm var cryptol_add_path :: FilePath -> TopLevel () From d86d22ac1d46d1701823fa276001dd9d92b2fe53 Mon Sep 17 00:00:00 2001 From: Mark Tullsen Date: Sat, 27 Sep 2025 15:54:03 -0700 Subject: [PATCH 21/57] refactor mkCryptolModule (inline internals and simplify) --- .../src/CryptolSAWCore/CryptolEnv.hs | 35 ++++--------------- 1 file changed, 7 insertions(+), 28 deletions(-) diff --git a/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs b/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs index b79aa8c151..45fac89aed 100644 --- a/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs +++ b/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs @@ -426,8 +426,7 @@ translateDeclGroups sc env dgs = let names = map T.dName decls let newTypes = Map.fromList [ (T.dName d, T.dSignature d) | d <- decls ] let addName name = MR.shadowing (MN.singletonNS C.NSValue (P.mkUnqual (MN.nameIdent name)) name) - return env - { eExtraNames = foldr addName (eExtraNames env) names + return env{ eExtraNames = foldr addName (eExtraNames env) names , eExtraTypes = Map.union (eExtraTypes env) newTypes , eTermEnv = C.envE cryEnv' } @@ -502,38 +501,18 @@ loadCryptolModule :: loadCryptolModule sc env path = do (mod', env') <- loadAndTranslateModule sc env (Left path) - cm <- mkCryptolModule mod' env' - return (cm, env') + return (mkCryptolModule mod' env', env') -- | mkCryptolModule m env - translate a @m :: T.Module@ to a `CryptolModule` -- -- This function returns the public types and values of the module `m` -- as a `CryptolModule` structure. -mkCryptolModule :: - (?fileReader :: FilePath -> IO ByteString) => - T.Module -> CryptolEnv -> IO CryptolModule +mkCryptolModule :: T.Module -> CryptolEnv -> CryptolModule mkCryptolModule m env = - do - let newTermEnv = eTermEnv env - modEnv = eModuleEnv env - ifaceDecls = getAllIfaceDecls modEnv - (types, _modEnv) <- liftModuleM modEnv $ - -- NOTE: _modEnv == modEnv, because, as we elaborate below, - -- the monadic actions are all 'readers'. - do prims <- MB.getPrimMap - -- generate the primitive map; a monad reader - TM.inpVars `fmap` - MB.genInferInput P.emptyRange prims NoParams ifaceDecls - -- NOTE: inpVars are the variables that are in scope. - -- FIXME: - -- - Why are we calling mB.genInferInput then projecting out - -- `inpVars`? - -- - If we had inlined, it appears that this is functional code. - -- - (Possibly because of information hiding?) - - return $ - let + let + ifaceDecls = getAllIfaceDecls (eModuleEnv env) + types = Map.map MI.ifDeclSig (MI.ifDecls ifaceDecls) -- we're keeping only the exports of `m`: vNameSet = MEx.exported C.NSValue (T.mExports m) tNameSet = MEx.exported C.NSType (T.mExports m) @@ -550,7 +529,7 @@ mkCryptolModule m env = $ Map.intersectionWith (\t x -> TypedTerm (TypedTermSchema t) x) types - newTermEnv + (eTermEnv env) ) -- | bindExtCryptolModule - ad hoc function/hook that allows for From 756ccd60ac2a35bf934abf95f6a4f81975c30094 Mon Sep 17 00:00:00 2001 From: Mark Tullsen Date: Sat, 27 Sep 2025 15:55:04 -0700 Subject: [PATCH 22/57] wibble to improve messages (info and error) --- cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs b/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs index 45fac89aed..2d57a8f072 100644 --- a/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs +++ b/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs @@ -427,9 +427,9 @@ translateDeclGroups sc env dgs = let newTypes = Map.fromList [ (T.dName d, T.dSignature d) | d <- decls ] let addName name = MR.shadowing (MN.singletonNS C.NSValue (P.mkUnqual (MN.nameIdent name)) name) return env{ eExtraNames = foldr addName (eExtraNames env) names - , eExtraTypes = Map.union (eExtraTypes env) newTypes - , eTermEnv = C.envE cryEnv' - } + , eExtraTypes = Map.union (eExtraTypes env) newTypes + , eTermEnv = C.envE cryEnv' + } ---- Misc Exports -------------------------------------------------------------- @@ -456,7 +456,7 @@ data ExtCryptolModule = showExtCryptolModule :: ExtCryptolModule -> String showExtCryptolModule = \case - ECM_LoadedModule name -> "loaded module '" ++ show(pp name) ++ "'" + ECM_LoadedModule name -> "loaded module '" ++ show(pp (P.thing name)) ++ "'" ECM_CryptolModule cm -> showCryptolModule cm -- | loadCryptolModule - load a cryptol module and returns the @@ -516,7 +516,7 @@ mkCryptolModule m env = -- we're keeping only the exports of `m`: vNameSet = MEx.exported C.NSValue (T.mExports m) tNameSet = MEx.exported C.NSType (T.mExports m) - in + in CryptolModule -- create Map of type synonyms (Map.filterWithKey @@ -600,12 +600,13 @@ extractDefFromExtCryptolModule sc env ecm name = case ecm of ECM_LoadedModule loadedModName -> do let localMN = C.packModName - [ "INTERNAL" + [ "INTERNAL_EXTRACT_MODNAME" , C.modNameToText (P.thing loadedModName) ] env' = bindLoadedModule (localMN, loadedModName) env expr = noLoc (C.modNameToText localMN <> "::" <> name) parseTypedTerm sc env' expr + -- FIXME: error message for bad `name` exposes the `localMN` to user. ECM_CryptolModule (CryptolModule _ tm) -> case Map.lookup (mkIdent name) (Map.mapKeys MN.nameIdent tm) of From 5d4bafa4642d11005d2792ac3b722bf7390c0ba2 Mon Sep 17 00:00:00 2001 From: Mark Tullsen Date: Sat, 27 Sep 2025 22:23:49 -0700 Subject: [PATCH 23/57] refactor --- cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs b/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs index 2d57a8f072..85932a7186 100644 --- a/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs +++ b/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs @@ -479,8 +479,8 @@ loadExtCryptolModule :: IO (ExtCryptolModule, CryptolEnv) loadExtCryptolModule sc env path = do - (mod', env') <- loadAndTranslateModule sc env (Left path) - return (ECM_LoadedModule (locatedUnknown (T.mName mod')), env') + (m, env') <- loadAndTranslateModule sc env (Left path) + return (ECM_LoadedModule (locatedUnknown (T.mName m)), env') -- | loadCryptolModule From dbab8e73e3d9919d4627acf52df7a48da0184d4c Mon Sep 17 00:00:00 2001 From: Mark Tullsen Date: Sat, 27 Sep 2025 22:38:00 -0700 Subject: [PATCH 24/57] Improve how we show a ECM_LoadedModule to the user. --- .../src/CryptolSAWCore/CryptolEnv.hs | 36 +++++++++++++------ 1 file changed, 26 insertions(+), 10 deletions(-) diff --git a/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs b/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs index 85932a7186..94c54cd2c1 100644 --- a/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs +++ b/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs @@ -441,7 +441,7 @@ combineCryptolEnv chkEnv newEnv = return chkEnv{ eModuleEnv = menv' } ----- CryptolModule/ExtCryptolModule types and functions: ----------------------- +---- Types and functions for CryptolModule & ExtCryptolModule ------------------ -- | ExtCryptolModule - Extended CryptolModule; we keep track of @@ -449,15 +449,28 @@ combineCryptolEnv chkEnv newEnv = -- `CryptolModule` or whether it came from parsing a Cryptol module -- from filesystem (in which case it is loaded). data ExtCryptolModule = - ECM_LoadedModule (P.Located C.ModName) -- ^ source is parsed/loaded - | ECM_CryptolModule CryptolModule -- ^ source, constructed - -- (e.g., via cryptol_prims) + -- | source is parsed/loaded + ECM_LoadedModule + { ecm_name :: P.Located C.ModName + , ecm_show :: String -- ^ how we show this on SAWScript CLI, + -- We can't look at state to compute show, + -- thus this (albeit adhoc). + } + + -- | source is internal/constructed (e.g., via cryptol_prims) + | ECM_CryptolModule {ecm_cm :: CryptolModule} showExtCryptolModule :: ExtCryptolModule -> String showExtCryptolModule = \case - ECM_LoadedModule name -> "loaded module '" ++ show(pp (P.thing name)) ++ "'" - ECM_CryptolModule cm -> showCryptolModule cm + ECM_LoadedModule name s -> + unlines ["Loaded module '" ++ show(pp (P.thing name)) ++ "':" + , s + ] + ECM_CryptolModule cm -> + unlines [ "Internal module:" + , showCryptolModule cm + ] -- | loadCryptolModule - load a cryptol module and returns the -- `ExtCryptolModule`. The contents of the module are not directly @@ -480,7 +493,10 @@ loadExtCryptolModule :: loadExtCryptolModule sc env path = do (m, env') <- loadAndTranslateModule sc env (Left path) - return (ECM_LoadedModule (locatedUnknown (T.mName m)), env') + let s = showCryptolModule (mkCryptolModule m env') + -- how to show, need to compute this here. + -- FIXME: this only shows public names, not internal. + return (ECM_LoadedModule (locatedUnknown (T.mName m)) s, env') -- | loadCryptolModule @@ -545,8 +561,8 @@ bindExtCryptolModule :: (P.ModName, ExtCryptolModule) -> CryptolEnv -> CryptolEnv bindExtCryptolModule (modName, ecm) = case ecm of - ECM_CryptolModule cm -> bindCryptolModule (modName, cm) - ECM_LoadedModule nm -> bindLoadedModule (modName, nm) + ECM_CryptolModule cm -> bindCryptolModule (modName, cm) + ECM_LoadedModule nm _ -> bindLoadedModule (modName, nm) bindLoadedModule :: (P.ModName, P.Located C.ModName) -> CryptolEnv -> CryptolEnv @@ -598,7 +614,7 @@ extractDefFromExtCryptolModule :: SharedContext -> CryptolEnv -> ExtCryptolModule -> Text -> IO TypedTerm extractDefFromExtCryptolModule sc env ecm name = case ecm of - ECM_LoadedModule loadedModName -> + ECM_LoadedModule loadedModName _ -> do let localMN = C.packModName [ "INTERNAL_EXTRACT_MODNAME" , C.modNameToText (P.thing loadedModName) From 935540ba4ea56d2a42668759fcf03fccec678287 Mon Sep 17 00:00:00 2001 From: Mark Tullsen Date: Sat, 27 Sep 2025 23:40:28 -0700 Subject: [PATCH 25/57] comments --- cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs b/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs index 94c54cd2c1..bb51804ccd 100644 --- a/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs +++ b/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs @@ -48,7 +48,6 @@ module CryptolSAWCore.CryptolEnv ) where ---import qualified Control.Exception as X import Data.ByteString (ByteString) import qualified Data.Text as Text import Data.Map (Map) @@ -622,8 +621,10 @@ extractDefFromExtCryptolModule sc env ecm name = env' = bindLoadedModule (localMN, loadedModName) env expr = noLoc (C.modNameToText localMN <> "::" <> name) parseTypedTerm sc env' expr - -- FIXME: error message for bad `name` exposes the `localMN` to user. + -- FIXME: error message for bad `name` exposes the + -- `localMN` to user. Fixing locally is challenging, as + -- the error is not an exception we can handle here. ECM_CryptolModule (CryptolModule _ tm) -> case Map.lookup (mkIdent name) (Map.mapKeys MN.nameIdent tm) of Just t -> return t From 89348b3061c76f70163e0a414eb9c0a99273ec3c Mon Sep 17 00:00:00 2001 From: Mark Tullsen Date: Sun, 28 Sep 2025 00:01:36 -0700 Subject: [PATCH 26/57] new tests --- intTests/test_saw_submodule_access1/A2.cry | 4 +++ intTests/test_saw_submodule_access1/G.cry | 6 ++++ intTests/test_saw_submodule_access1/H.cry | 8 +++++ .../HWithSubmodules.cry | 18 ++++++++++++ intTests/test_saw_submodule_access1/test.sh | 6 ++++ .../test_load_extract_D.saw | 27 +++++++++++++++++ .../test_private.saw | 19 ++++++++++++ .../test_private_with_submodules.saw | 29 +++++++++++++++++++ 8 files changed, 117 insertions(+) create mode 100644 intTests/test_saw_submodule_access1/A2.cry create mode 100644 intTests/test_saw_submodule_access1/G.cry create mode 100644 intTests/test_saw_submodule_access1/H.cry create mode 100644 intTests/test_saw_submodule_access1/HWithSubmodules.cry create mode 100644 intTests/test_saw_submodule_access1/test_load_extract_D.saw create mode 100644 intTests/test_saw_submodule_access1/test_private.saw create mode 100644 intTests/test_saw_submodule_access1/test_private_with_submodules.saw diff --git a/intTests/test_saw_submodule_access1/A2.cry b/intTests/test_saw_submodule_access1/A2.cry new file mode 100644 index 0000000000..e1c7e07502 --- /dev/null +++ b/intTests/test_saw_submodule_access1/A2.cry @@ -0,0 +1,4 @@ +module A2 where + +a : [32] +a = 3 diff --git a/intTests/test_saw_submodule_access1/G.cry b/intTests/test_saw_submodule_access1/G.cry new file mode 100644 index 0000000000..56c79d9024 --- /dev/null +++ b/intTests/test_saw_submodule_access1/G.cry @@ -0,0 +1,6 @@ +submodule M where + x = 0x02 + +import submodule M as Q::R + +y = Q::R::x \ No newline at end of file diff --git a/intTests/test_saw_submodule_access1/H.cry b/intTests/test_saw_submodule_access1/H.cry new file mode 100644 index 0000000000..c323b077ca --- /dev/null +++ b/intTests/test_saw_submodule_access1/H.cry @@ -0,0 +1,8 @@ +module H where + +a : [32] +a = 4 + +private + b : [32] + b = 5 diff --git a/intTests/test_saw_submodule_access1/HWithSubmodules.cry b/intTests/test_saw_submodule_access1/HWithSubmodules.cry new file mode 100644 index 0000000000..77cf0c8ca6 --- /dev/null +++ b/intTests/test_saw_submodule_access1/HWithSubmodules.cry @@ -0,0 +1,18 @@ +module H where + +a : [32] +a = 4 + +private + b : [32] + b = 5 + +submodule H2 where + + c : [32] + c = 6 + + private + + d : [32] + d = 7 diff --git a/intTests/test_saw_submodule_access1/test.sh b/intTests/test_saw_submodule_access1/test.sh index 79e3e0452b..1e20d03e76 100755 --- a/intTests/test_saw_submodule_access1/test.sh +++ b/intTests/test_saw_submodule_access1/test.sh @@ -7,4 +7,10 @@ $SAW test_import_D.saw $SAW test_load_D.saw +$SAW test_load_extract_D.saw + $SAW test_UseFunctors.saw + +$SAW test_private.saw + +$SAW test_private_with_submodules.saw diff --git a/intTests/test_saw_submodule_access1/test_load_extract_D.saw b/intTests/test_saw_submodule_access1/test_load_extract_D.saw new file mode 100644 index 0000000000..da732753ab --- /dev/null +++ b/intTests/test_saw_submodule_access1/test_load_extract_D.saw @@ -0,0 +1,27 @@ +//////////////////////////////////////////////// +DDD <- cryptol_load "D.cry"; + +print (eval_int {{DDD::D2::d2}}); + +print DDD; + +//// cryptol_extract /////////////////////////// + +do { y <- cryptol_extract DDD "D2::d2"; print y;}; +do { y <- cryptol_extract DDD "D2::d2"; print y;}; +fails (do {y <- cryptol_extract DDD "notinscope"; print y;}); + +print DDD; + + +//// cryptol_prims //////////////////////////// + +let PRIMS = cryptol_prims (); + +do {y <- cryptol_extract PRIMS "sext"; print y;}; + +fails (do {y <- cryptol_extract PRIMS "notinscope"; print y;}); + +print PRIMS; + +print "done"; diff --git a/intTests/test_saw_submodule_access1/test_private.saw b/intTests/test_saw_submodule_access1/test_private.saw new file mode 100644 index 0000000000..e43caf02b0 --- /dev/null +++ b/intTests/test_saw_submodule_access1/test_private.saw @@ -0,0 +1,19 @@ +////////////////////////////////////////////// +// testing import: +import "H.cry" as HI; + +print (eval_int {{HI::a}}); // public, should succeed. +print (eval_int {{HI::b}}); // private, should succeed. + + +////////////////////////////////////////////// +// testing cryptol_load +HL <- cryptol_load "H.cry"; + +print HL; + +print (eval_int {{HL::a}}); // public, should succeed. +print (eval_int {{HL::b}}); // private, should succeed. + +do {x <- cryptol_extract HL "a"; print x;}; // public, should succeed. +do {x <- cryptol_extract HL "b"; print x;}; // private, should succeed. diff --git a/intTests/test_saw_submodule_access1/test_private_with_submodules.saw b/intTests/test_saw_submodule_access1/test_private_with_submodules.saw new file mode 100644 index 0000000000..9c8e75e033 --- /dev/null +++ b/intTests/test_saw_submodule_access1/test_private_with_submodules.saw @@ -0,0 +1,29 @@ +////////////////////////////////////////////// +// testing import: +import "HWithSubmodules.cry" as HI; + +print (eval_int {{HI::a}}); // public, should succeed. +print (eval_int {{HI::b}}); // private, should succeed. +print (eval_int {{HI::H2::c}}); // public, should succeed. +fails (do {print (eval_int {{ HI::H2::d }});}); // private, should succeed. + // + +////////////////////////////////////////////// +// testing cryptol_load +HL <- cryptol_load "HWithSubmodules.cry"; +print HL; + +print (eval_int {{HL::a}}); // public, should succeed. +print (eval_int {{HL::b}}); // private, should succeed. +print (eval_int {{HL::H2::c}}); // public, should succeed. + +fails (do {print (eval_int {{HL::H2::d}});}); // private, should succeed. + +do {x <- cryptol_extract HL "a"; print x;}; // public, should succeed. +do {x <- cryptol_extract HL "b"; print x;}; // private, should succeed. +do {x <- cryptol_extract HL "H2::c"; print x;}; // public, should succeed. +fails (do {x <- cryptol_extract HL "H2::d"; print x;}); // private, should succeed. + +// QUESTION: +// This does seem to 'match' what `cryptol` REPL does. +// What we want? From 9b83ef593606b99f6a32e4099da00042de16894b Mon Sep 17 00:00:00 2001 From: Mark Tullsen Date: Sat, 4 Oct 2025 17:54:24 -0700 Subject: [PATCH 27/57] refactors (minor) and improving comments. --- .../src/CryptolSAWCore/CryptolEnv.hs | 55 +++++++++++-------- 1 file changed, 31 insertions(+), 24 deletions(-) diff --git a/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs b/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs index bb51804ccd..7681499e09 100644 --- a/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs +++ b/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs @@ -141,7 +141,8 @@ data ImportVisibility data CryptolEnv = CryptolEnv { eImports :: [(ImportVisibility, P.Import)] -- ^ Declarations of imported Cryptol modules - , eModuleEnv :: ME.ModuleEnv -- ^ Imported modules, and state for the ModuleM monad + , eModuleEnv :: ME.ModuleEnv -- ^ Loaded & imported modules, and + -- state for the ModuleM monad , eExtraNames :: MR.NamingEnv -- ^ Context for the Cryptol renamer , eExtraTypes :: Map T.Name T.Schema -- ^ Cryptol types for extra names in scope , eExtraTSyns :: Map T.Name T.TySyn -- ^ Extra Cryptol type synonyms in scope @@ -318,34 +319,38 @@ getNamingEnv :: CryptolEnv -> MR.NamingEnv getNamingEnv env = eExtraNames env `MR.shadowing` - (mconcat $ map - (importToNamingEnv (eModuleEnv env)) + (mconcat $ map (getNamingEnvForImport (eModuleEnv env)) (eImports env) ) -importToNamingEnv :: ME.ModuleEnv +getNamingEnvForImport :: ME.ModuleEnv -> (ImportVisibility, T.Import) -> MR.NamingEnv -importToNamingEnv modEnv (vis,imprt) = +getNamingEnvForImport modEnv (vis, imprt) = MN.interpImportEnv imprt -- adjust for qualified imports $ adjustVisible -- adjust if OnlyPublic names $ ME.mctxNames mctx -- namingEnv for PublicAndPrivate + -- FIXME: this does not do what we want: ...! + -- - PublicAndPrivate: doesn't work + -- - OnlyPublic really work?? where - mctx = modContextOf' (P.ImpTop $ P.thing $ T.iModule imprt) - + mctx = case ME.modContextOf impNm modEnv of + Just c -> c + Nothing -> panic "getNamingEnvForImport" + ["expecting module to be loaded: " + <> Text.pack (show (pp impNm))] + where + -- | fm - name of a 'top level' import: + impNm :: P.ImpName MN.Name + impNm = P.ImpTop $ P.thing $ T.iModule imprt + + adjustVisible :: MR.NamingEnv -> MR.NamingEnv adjustVisible = case vis of PublicAndPrivate -> id OnlyPublic -> \env' -> MN.filterUNames (`Set.member` ME.mctxExported mctx) env' - modContextOf' fm = - case ME.modContextOf fm modEnv of - Just c -> c - Nothing -> panic "getNamingEnv" - ["expecting module to be loaded: " - <> Text.pack (show (pp fm))] - getAllIfaceDecls :: ME.ModuleEnv -> M.IfaceDecls getAllIfaceDecls me = @@ -471,7 +476,7 @@ showExtCryptolModule = , showCryptolModule cm ] --- | loadCryptolModule - load a cryptol module and returns the +-- | loadCryptolModule - load a cryptol module and return the -- `ExtCryptolModule`. The contents of the module are not directly -- imported into the environment. -- @@ -500,9 +505,10 @@ loadExtCryptolModule sc env path = -- | loadCryptolModule -- --- NOTE RE CALLS TO: --- - the path to this function from the command line is only via --- the experimental "write_coq_cryptol_module" command. +-- NOTE RE CALLS TO THIS: +-- - There is only the path to this function from the command line, +-- and it is only via the experimental command, +-- "write_coq_cryptol_module". -- -- This function (note `mkCryptolModule`) returns the public types and values -- of the module in a `CryptolModule` structure. @@ -533,7 +539,7 @@ mkCryptolModule m env = tNameSet = MEx.exported C.NSType (T.mExports m) in CryptolModule - -- create Map of type synonyms + -- create Map of type synonyms: (Map.filterWithKey (\k _ -> Set.member k tNameSet) (T.mTySyns m) @@ -551,7 +557,7 @@ mkCryptolModule m env = -- extending the Cryptol environment with the names in a Cryptol -- module, represented here by a `ExtCryptolModule`. -- --- NOTE RE CALLS TO: Three command line variants get us here: +-- NOTE RE CALLS TO THIS: Three command line variants get us here: -- > D <- cryptol_load "PATH" -- > x <- return (cryptol_prims ()) -- > let x = cryptol_prims () @@ -606,7 +612,8 @@ bindCryptolModule (modName, CryptolModule sm tm) env = -- | extractDefFromExtCryptolModule sc en ecm name - interpret `name` as a definition in -- the module `ecm`, return the TypedTerm. -- --- NOTE RE CALLS TO: this is (only) used for the "cryptol_extract" primitive. +-- NOTE RE CALLS TO THIS: this is (only) used for the +-- "cryptol_extract" primitive. -- extractDefFromExtCryptolModule :: (?fileReader :: FilePath -> IO ByteString) => @@ -630,15 +637,15 @@ extractDefFromExtCryptolModule sc env ecm name = Just t -> return t Nothing -> fail $ Text.unpack $ "Binding not found: " <> name - -- NOTE RE CALLS TO: + -- NOTE RE CALLS TO THIS: -- - currently we can only get to this branch when CryptolModule -- is the one created with `cryptol_prims` (Haskell function and -- SAWScript function). E.g., -- -- > cryptol_extract (cryptol_prims ()) "trunc" -- - -- FIXME: this code is somewhat ad hoc, might we rather invoke - -- parse for name, or the like? However, this code becomes + -- FIXME: this code is somewhat ad hoc; might we rather invoke + -- parse for name or the like? However, this code should become -- unnecessary after addressing Issue #2645 (turning -- cryptol_prims into a built-in Cryptol module). From fe4a433a5e01b6b9b71e2e7d6366b4fa3e031aa2 Mon Sep 17 00:00:00 2001 From: Mark Tullsen Date: Mon, 6 Oct 2025 09:32:48 -0700 Subject: [PATCH 28/57] add new *.cry tests --- .../HWithPrivSubmodules.cry | 29 +++++++++++++++++++ .../HWithSubmodules2.cry | 19 ++++++++++++ 2 files changed, 48 insertions(+) create mode 100644 intTests/test_saw_submodule_access1/HWithPrivSubmodules.cry create mode 100644 intTests/test_saw_submodule_access1/HWithSubmodules2.cry diff --git a/intTests/test_saw_submodule_access1/HWithPrivSubmodules.cry b/intTests/test_saw_submodule_access1/HWithPrivSubmodules.cry new file mode 100644 index 0000000000..0ccd053067 --- /dev/null +++ b/intTests/test_saw_submodule_access1/HWithPrivSubmodules.cry @@ -0,0 +1,29 @@ +module H where + +a = 1 : [32] + +private + b : [32] + b = 2 + +submodule H2 where + + c : [32] + c = 2 + d + + private + d : [32] + d = 1 + +private submodule H3 where + + e : [32] + e = 3 + f + + private + f : [32] + f = 1 + +t1 = a + b + H2::c + H3::e + +// t2 = H2::d + H3::f diff --git a/intTests/test_saw_submodule_access1/HWithSubmodules2.cry b/intTests/test_saw_submodule_access1/HWithSubmodules2.cry new file mode 100644 index 0000000000..8cd963dd75 --- /dev/null +++ b/intTests/test_saw_submodule_access1/HWithSubmodules2.cry @@ -0,0 +1,19 @@ +module H where + +a : [32] +a = 4 + + +private + b : [32] + b = 5 + +submodule H2 where + + c : [32] + c = 6 + + private + + a : [32] + a = 7 From 3a71504be73a0c2da1eee6808cbc7625caabac14 Mon Sep 17 00:00:00 2001 From: Mark Tullsen Date: Mon, 6 Oct 2025 09:49:20 -0700 Subject: [PATCH 29/57] documentation (first draft) --- doc/developer/import-load-scope.org | 199 ++++++++++++++++++++++++++++ 1 file changed, 199 insertions(+) create mode 100644 doc/developer/import-load-scope.org diff --git a/doc/developer/import-load-scope.org b/doc/developer/import-load-scope.org new file mode 100644 index 0000000000..d040133b7c --- /dev/null +++ b/doc/developer/import-load-scope.org @@ -0,0 +1,199 @@ +* Import, Load, and Scope +** NOTE META: this doc will eventually end up in multiple places + +E.g., + 1. Issue/PR descriptions + 2. SAWScript manual describing imports/loads + 3. New Issue for further extending/simplifying import/load + +** TODO thk re scope; terminology + +- notions/terms + - scope :: the scope of variable (in terms of + - per four namespaces + - what's in scope at a point in cryptol module + - point in sawscript module + - ? :: the set of (qualified) names we add to scope with binders + - let, bind, import, magic-cryptolmodule-bind + - context/? :: + - ? the env at the top-level of a module + - ? : the env at a given point of a module + - in Cryptol, we can only *move* the focus (between modules and submodules). + +- standard scoping concepts in Cryptol + - the importer: gets names that a module exports. + +- non-standard scoping concepts in Cryptol + - submodules are special, reference to can be private/public + - if we have reference to a submodule, we can import it (in + Cryptol, in sawscript) + +** Explaining scope in sawscript + +Note that at the Cryptol command line, one cannot create an +environment that does not correspond to a point in the source code, +due to the command line only allowing one module (or submodule) to be +in focus. + +- Alternatives + + A. sawscript works like Cryptol *command line*: + - one module/submodule is *the* focus (not two) + + B. sawscript imports work exactly the same as in Cryptol *code* + - we have access to public submodules + - we can access *public* elements of these submodules with =::= + - we can extend the Env with =import submodule SM= + - just the public, cannot see private + + C. Like approach B., but the imports include the private vars + - the env added is + - the "top-level env" of the imported module + - thus top-level privates in =M= are added + - we can access *public* elements of these submodules with =::= + - DESIGN CHOICES + A. we work as if all the "private" annotations did not exist. + - for any any all imports, + - and future =import submodule= *NIY* + (this is not absolutely necessary as we can always access anything + with qualifiers). + B. we have some further granularity wrt exposing "private" + A. each import can choose Pub/All. + - =import submodule= does not have this choice + B. As A, but =import submodule= might have "PRIVATE TOO" + C. we have a different mechanism for referencing private vars + +Sawscript is different /by design/: + - Two values may not overlap in their scope at any one place in the + code. But we may want to use or relate these values together in + sawscript. Sawscript allows use to do this /without/ having to + create an ad hoc cryptol module for creating a scope where both + values are in scope. + + - Thus the simplicity of Cryptol's =:focus = is not desirable. + +We choose alternative C, design choice A. + +** Current (new branch) behavior + +- In SAWScript there are two ways to bring cryptol modules into scope: + the =import= command and the =cryptol_load= command. + + - =import= + - works like an =import= inside a Cryptol program (and it shares + identical *?* syntax), except that all "private annotations" are + ignored. + - Note that it doesn't work identically to =:load= in Cryptol: + - where an environment is created that is identical to the + top-level environment in the loaded Cryptol module, thus + - private definitions (and submodules) at top-level are visible + - private definitions inside submodules are *not* visible, + unless we change to focus to that submodule with =:focus= + - is a sawscript construct, not a CLI command + - the syntax is *TODO...* + - can only appear at the top-level + - as with cryptol + - we can qualify multiple modules to the same name + - we can import duplicate [qualified] names without error (the error only + comes when we try to reference one of those names) + + - =cryptol_load= + : String -> TopLevel CryptolModule + - it parses, loads, and translates the file (as import does) + - it is a command, can *...* + - *UNLESS* you bind the value, this is effectively a NOP (except + for printing a summary display). + + - the magic occurs when you do this (at the top level) + : M <- cryptol_load "M.cry" + + - (If not done at the top level, results might be wrong or + unintuitive [?]: a little unclear as to what's happening + here.) + + - The magic occurs anytime you bind a value of type + =CryptolModule= at the top-level (with "<-" or "let") + + - useful for the (only) other way to create =CryptolModule=: + : cryptol_prims : () -> CryptolModule + + - This will + - bind "M" as a SAWScript value of type `CryptolModule` (of course) + - Extend the cryptol environment with the given module + where the contents of the module are all qualified with "M". + - i.e., *TODO...* + - Using the =M : CryptolModule= SawScript value + - you can view the public names of "M.cry" with print + (i.e., the default show function for `CryptolModule` + - you can `cryptol_extract` the definitions in it thus + : cryptol_extract M "d2" + + this works just as if one had written + : return {{M::d2}} + +** Current (branch) compared to previous behavior (on master) + +- new :: we can access definitions in sub-modules, they are referenced + via =::= qualifiers, just as is done in Cryptol code. + +- chg :: =cryptol_load=: + - *Previously* + - given this + : A <- cryptol_load "A.cry" -- A::** are added to {{A::**}} + : A <- cryptol_load "A2.cry" -- A2:** are added to {{A::**}} + - the `A` in 2nd line would shadow the first `A`. + - for each symbol 's' from A2.cry: + - 's' may shadow any duplicate symbol 's' from `A.cry` + - and it would also + - leave symbols from A.cry in the cryptol environment, i.e., + {{A::*}}. + - *NOW*, + - given this + : A <- cryptol_load "A.cry" -- A::** are added to {{A::**}} + : A <- cryptol_load "A2.cry" -- A2:** are added to {{A::**}} + - works identical to + : import "A.cry" as A + : import "A2.cry" as A + - thus, + - no shadowing occurs + - importing ambiguous symbols is allowed + - referring to ambiguous (qualified) symbols is an error. + - : A <- cryptol_load "A2.cry" -- + - accessing =A= in SAWscript gives us "A2.cry" + +- chg :: + - cryptol_export is defined in terms of ={{A::name}}=, thus no more + gratuitous differences. + +- OLD behavior + - import put privates in scope (as does new) + - private var in submodules: N/A + - [ ] confirm these: + - [ ] =cryptol_load= did not put top-level privates in scope (?) + - [ ] =cryptol_export= could not access privates (?) + +** Issues, 2025-09-29 + +- [ ] Assume we want to immediately update semantics of =cryptol_load= + (i.e., that we don't try to support old code that relies on old ad + hoc behavior) + - warn on let/bind shadowing would help for this (and other errors) + +- [ ] private's in submodules are inaccessible + - and issues with private submodules too! + - as we *now* use cryptol code, and cryptol code leaves these + inacessible! + - [ ] clarify what we *really* want before implementing + +- [ ] print CryptolModule with submodules + - currently only prints top publics, due to quick implementation + with existing code + - depends on fixing last, d + +** Future + +- [ ] getting rid of the /magic-CryptolModule-bind/ +- [ ] doing import and being able to view! + : x <- qimport <...same as import> + : addtoscope x ... + From 944db86b623211bb26c3b6d63eac43d5d4d6d533 Mon Sep 17 00:00:00 2001 From: Mark Tullsen Date: Mon, 6 Oct 2025 09:58:17 -0700 Subject: [PATCH 30/57] documentation --- doc/developer/import-load-scope.org | 51 +++++++++++++++-------------- 1 file changed, 26 insertions(+), 25 deletions(-) diff --git a/doc/developer/import-load-scope.org b/doc/developer/import-load-scope.org index d040133b7c..7e861a2911 100644 --- a/doc/developer/import-load-scope.org +++ b/doc/developer/import-load-scope.org @@ -6,15 +6,15 @@ E.g., 2. SAWScript manual describing imports/loads 3. New Issue for further extending/simplifying import/load -** TODO thk re scope; terminology +** TODO Thinking re scope; terminology - notions/terms - scope :: the scope of variable (in terms of - per four namespaces - - what's in scope at a point in cryptol module - - point in sawscript module + - what's in scope at a point in Cryptol module + - point in SAWScript module - ? :: the set of (qualified) names we add to scope with binders - - let, bind, import, magic-cryptolmodule-bind + - let, bind, import, magic-Cryptolmodule-bind - context/? :: - ? the env at the top-level of a module - ? : the env at a given point of a module @@ -26,9 +26,9 @@ E.g., - non-standard scoping concepts in Cryptol - submodules are special, reference to can be private/public - if we have reference to a submodule, we can import it (in - Cryptol, in sawscript) + Cryptol, in SAWScript) -** Explaining scope in sawscript +** Explaining scope in SAWScript Note that at the Cryptol command line, one cannot create an environment that does not correspond to a point in the source code, @@ -37,10 +37,10 @@ in focus. - Alternatives - A. sawscript works like Cryptol *command line*: + A. SAWScript works like Cryptol *command line*: - one module/submodule is *the* focus (not two) - B. sawscript imports work exactly the same as in Cryptol *code* + B. SAWScript imports work exactly the same as in Cryptol *code* - we have access to public submodules - we can access *public* elements of these submodules with =::= - we can extend the Env with =import submodule SM= @@ -63,11 +63,11 @@ in focus. B. As A, but =import submodule= might have "PRIVATE TOO" C. we have a different mechanism for referencing private vars -Sawscript is different /by design/: +SAWScript is different /by design/: - Two values may not overlap in their scope at any one place in the code. But we may want to use or relate these values together in - sawscript. Sawscript allows use to do this /without/ having to - create an ad hoc cryptol module for creating a scope where both + SAWScript. SAWScript allows use to do this /without/ having to + create an ad hoc Cryptol module for creating a scope where both values are in scope. - Thus the simplicity of Cryptol's =:focus = is not desirable. @@ -76,7 +76,7 @@ We choose alternative C, design choice A. ** Current (new branch) behavior -- In SAWScript there are two ways to bring cryptol modules into scope: +- In SAWScript there are two ways to bring Cryptol modules into scope: the =import= command and the =cryptol_load= command. - =import= @@ -89,10 +89,10 @@ We choose alternative C, design choice A. - private definitions (and submodules) at top-level are visible - private definitions inside submodules are *not* visible, unless we change to focus to that submodule with =:focus= - - is a sawscript construct, not a CLI command + - is a SAWScript construct, not a CLI command - the syntax is *TODO...* - can only appear at the top-level - - as with cryptol + - as with Cryptol - we can qualify multiple modules to the same name - we can import duplicate [qualified] names without error (the error only comes when we try to reference one of those names) @@ -119,10 +119,10 @@ We choose alternative C, design choice A. - This will - bind "M" as a SAWScript value of type `CryptolModule` (of course) - - Extend the cryptol environment with the given module + - Extend the Cryptol environment with the given module where the contents of the module are all qualified with "M". - i.e., *TODO...* - - Using the =M : CryptolModule= SawScript value + - Using the =M : CryptolModule= SAWScript value - you can view the public names of "M.cry" with print (i.e., the default show function for `CryptolModule` - you can `cryptol_extract` the definitions in it thus @@ -133,10 +133,10 @@ We choose alternative C, design choice A. ** Current (branch) compared to previous behavior (on master) -- new :: we can access definitions in sub-modules, they are referenced +- New :: we can access definitions in sub-modules, they are referenced via =::= qualifiers, just as is done in Cryptol code. -- chg :: =cryptol_load=: +- Changes :: =cryptol_load=: - *Previously* - given this : A <- cryptol_load "A.cry" -- A::** are added to {{A::**}} @@ -145,7 +145,7 @@ We choose alternative C, design choice A. - for each symbol 's' from A2.cry: - 's' may shadow any duplicate symbol 's' from `A.cry` - and it would also - - leave symbols from A.cry in the cryptol environment, i.e., + - leave symbols from A.cry in the Cryptol environment, i.e., {{A::*}}. - *NOW*, - given this @@ -159,9 +159,9 @@ We choose alternative C, design choice A. - importing ambiguous symbols is allowed - referring to ambiguous (qualified) symbols is an error. - : A <- cryptol_load "A2.cry" -- - - accessing =A= in SAWscript gives us "A2.cry" + - accessing =A= in SAWScript gives us "A2.cry" -- chg :: +- Changes :: - cryptol_export is defined in terms of ={{A::name}}=, thus no more gratuitous differences. @@ -172,7 +172,7 @@ We choose alternative C, design choice A. - [ ] =cryptol_load= did not put top-level privates in scope (?) - [ ] =cryptol_export= could not access privates (?) -** Issues, 2025-09-29 +** Issues, 2025-10-06 - [ ] Assume we want to immediately update semantics of =cryptol_load= (i.e., that we don't try to support old code that relies on old ad @@ -180,9 +180,10 @@ We choose alternative C, design choice A. - warn on let/bind shadowing would help for this (and other errors) - [ ] private's in submodules are inaccessible - - and issues with private submodules too! - - as we *now* use cryptol code, and cryptol code leaves these - inacessible! + - ditto with private submodules + - bug in code, privates at top-level are accessible + - wrongly using Cryptol code, and Cryptol code leaves these + inacessible! - [ ] clarify what we *really* want before implementing - [ ] print CryptolModule with submodules From eb4017d0b63533327ea3aabcfd8484bd014c8088 Mon Sep 17 00:00:00 2001 From: Mark Tullsen Date: Mon, 6 Oct 2025 16:56:16 -0700 Subject: [PATCH 31/57] refactor: fold; whitespace --- cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs | 13 ++++++------- 1 file changed, 6 insertions(+), 7 deletions(-) diff --git a/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs b/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs index 7681499e09..bd1874760f 100644 --- a/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs +++ b/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs @@ -150,7 +150,7 @@ data CryptolEnv = CryptolEnv , ePrims :: Map C.PrimIdent Term -- ^ SAWCore terms for primitives , ePrimTypes :: Map C.PrimIdent Term -- ^ SAWCore terms for primitive type names , eFFITypes :: Map NameInfo T.FFI - -- ^ FFI info for SAWCore names of Cryptol foreign functions + -- ^ FFI info for SAWCore names of Cryptol foreign functions } @@ -320,12 +320,12 @@ getNamingEnv env = eExtraNames env `MR.shadowing` (mconcat $ map (getNamingEnvForImport (eModuleEnv env)) - (eImports env) + (eImports env) ) getNamingEnvForImport :: ME.ModuleEnv - -> (ImportVisibility, T.Import) - -> MR.NamingEnv + -> (ImportVisibility, T.Import) + -> MR.NamingEnv getNamingEnvForImport modEnv (vis, imprt) = MN.interpImportEnv imprt -- adjust for qualified imports $ adjustVisible -- adjust if OnlyPublic names @@ -755,9 +755,8 @@ importCryptolModule :: importCryptolModule sc env src as vis imps = do (mod', env') <- loadAndTranslateModule sc env src - return $ env'{ eImports = mkImport vis (locatedUnknown (T.mName mod')) as imps - : eImports env - } + let import' = mkImport vis (locatedUnknown (T.mName mod')) as imps + return $ env' {eImports= import' : eImports env } mkImport :: ImportVisibility -> P.Located C.ModName From 14168fe8d90ffb3f6dd49473cb1983a86c493c8f Mon Sep 17 00:00:00 2001 From: Mark Tullsen Date: Wed, 8 Oct 2025 09:12:26 -0700 Subject: [PATCH 32/57] rename test --- .../{HWithPrivSubmodules.cry => HWithPrivateSubmodules.cry} | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename intTests/test_saw_submodule_access1/{HWithPrivSubmodules.cry => HWithPrivateSubmodules.cry} (100%) diff --git a/intTests/test_saw_submodule_access1/HWithPrivSubmodules.cry b/intTests/test_saw_submodule_access1/HWithPrivateSubmodules.cry similarity index 100% rename from intTests/test_saw_submodule_access1/HWithPrivSubmodules.cry rename to intTests/test_saw_submodule_access1/HWithPrivateSubmodules.cry From af444d4337554496cadc84a0226dd90afbeba610 Mon Sep 17 00:00:00 2001 From: Mark Tullsen Date: Wed, 8 Oct 2025 09:12:39 -0700 Subject: [PATCH 33/57] comments --- cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs b/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs index bd1874760f..f1f4becb3f 100644 --- a/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs +++ b/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs @@ -331,7 +331,7 @@ getNamingEnvForImport modEnv (vis, imprt) = $ adjustVisible -- adjust if OnlyPublic names $ ME.mctxNames mctx -- namingEnv for PublicAndPrivate -- FIXME: this does not do what we want: ...! - -- - PublicAndPrivate: doesn't work + -- - PublicAndPrivate: cannot see privates inside submodules. -- - OnlyPublic really work?? where From 422242d3ef6badc2f8ec565aff8e1152d9702fdc Mon Sep 17 00:00:00 2001 From: Mark Tullsen Date: Wed, 8 Oct 2025 09:13:44 -0700 Subject: [PATCH 34/57] tweak F.cry test module --- intTests/test_saw_submodule_access1/F.cry | 22 ++++++++++++++-------- 1 file changed, 14 insertions(+), 8 deletions(-) diff --git a/intTests/test_saw_submodule_access1/F.cry b/intTests/test_saw_submodule_access1/F.cry index 67da35189e..fbb1a3e391 100644 --- a/intTests/test_saw_submodule_access1/F.cry +++ b/intTests/test_saw_submodule_access1/F.cry @@ -2,20 +2,26 @@ module F where import B import C -top0 = 2000 + b + c -topd2 = 5 + D3::d2 -topd3 = 10 + D3::D4::d3 +top1 = 2000 + b + c +top2 = 5 + D3::d3 +top3 = 10 + D3::D4::d4 d00 : [32] d00 = 1 // let's conflict with D.cry +private + top_pri = 5 + submodule D3 where - d2 = 10000 + top0 - d3D2 = 1 + D4::d3 - d2' = 1 + d3P + d3 = 10000 + top1 + d3a = 1 + D4::d4 + d3b = 1 + d3_pri private - d3P = 1 + d2 + d3_pri = 1 + d3 submodule D4 where - d3 = 20000 + top0 + d2 + d4 = 20000 + top1 + d3 + d4_pri + + private + d4_pri = 5 From 660aa353623fe410c9505708a72273f1394365a1 Mon Sep 17 00:00:00 2001 From: Mark Tullsen Date: Wed, 8 Oct 2025 09:27:29 -0700 Subject: [PATCH 35/57] add debugging code (temporarily) --- .../src/CryptolSAWCore/CryptolEnv.hs | 48 ++++++++++++++++++- 1 file changed, 47 insertions(+), 1 deletion(-) diff --git a/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs b/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs index f1f4becb3f..68a985b4a0 100644 --- a/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs +++ b/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs @@ -108,6 +108,8 @@ import CryptolSAWCore.TypedTerm import Cryptol.ModuleSystem.Env (ModContextParams(NoParams)) -- import SAWCentral.AST (Located(getVal, locatedPos), Import(..)) +debug :: Bool +debug = True ---- Key Types ----------------------------------------------------------------- @@ -695,7 +697,10 @@ loadAndTranslateModule sc env src = newCryEnv <- C.importTopLevelDeclGroups sc C.defaultPrimitiveOptions cEnv newDeclGroups return (C.envE newCryEnv) - + when debug $ do + putStrLn $ show (ppListX "newDeclGroups" newDeclGroups) + putStrLn $ show (ppListX "newTermEnv" + ({- map MN.nameIdent $ -} Map.keys newTermEnv)) return ( m , env{ eModuleEnv = modEnv' , eTermEnv = newTermEnv @@ -703,6 +708,10 @@ loadAndTranslateModule sc env src = } ) +ppListX :: PP a => String -> [a] -> Doc +ppListX s xs = text s <+> ppList (map pp xs) + + checkNotParameterized :: T.Module -> IO () checkNotParameterized m = when (T.isParametrizedModule m) $ @@ -756,6 +765,43 @@ importCryptolModule sc env src as vis imps = do (mod', env') <- loadAndTranslateModule sc env src let import' = mkImport vis (locatedUnknown (T.mName mod')) as imps + when debug $ + do + let lm = case ME.lookupModule (T.mName mod') (eModuleEnv env') of + Just lm' -> lm' + Nothing -> panic "importImportModule" [] + + nms1 :: Map MN.Name MI.IfaceDecl + nms1 = MI.ifDecls $ MI.ifDefines $ ME.lmInterface lm + -- Correct for PuPr + + -- ne = getNamingEnvForImport (eModuleEnv env') import' + + nmsPu :: Set.Set MN.Name + nmsPu = MI.ifsPublic $ MI.ifNames $ ME.lmInterface lm + -- Correct for PublicOnly + + nmsPP :: Set.Set MN.Name + nmsPP = MI.ifsDefines $ MI.ifNames $ ME.lmInterface lm + -- works, but doesn't "inline" submodule defs. + + putStrLn "importCrytolModule:" + print $ ppListX "nms1: " $ Set.toList $ Map.keysSet nms1 + print $ text "namingEnvFromNames:" + <> pp (MN.namingEnvFromNames (Map.keysSet nms1)) + print $ ppListX "nmsPu: " $ Set.toList nmsPu + print $ ppListX "nmsPuPr: " $ Set.toList nmsPP + print $ text "namingEnv:" <> pp (ME.lmNamingEnv lm) + -- shows everything in scope, excluding hidden from the top level + + putStrLn "importCrytolModule: submodules(" + flip mapM_ (Map.toList $ T.mSubmodules mod') $ \(nm,sm)-> + do + putStrLn ("submodule: " ++ show (pp nm)) + print $ pp (T.smInScope sm) + putStrLn "" + putStrLn ")" + return $ env' {eImports= import' : eImports env } mkImport :: ImportVisibility From 28c77db25de97b1585e672dd3030e300024aa168 Mon Sep 17 00:00:00 2001 From: Mark Tullsen Date: Wed, 8 Oct 2025 15:32:01 -0700 Subject: [PATCH 36/57] refactor (modulo debug logging details); tweaking .cry tests --- .../src/CryptolSAWCore/CryptolEnv.hs | 22 +++++++++---------- intTests/test_saw_submodule_access1/F.cry | 3 +++ 2 files changed, 14 insertions(+), 11 deletions(-) diff --git a/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs b/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs index 68a985b4a0..e8db139db1 100644 --- a/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs +++ b/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs @@ -698,8 +698,8 @@ loadAndTranslateModule sc env src = sc C.defaultPrimitiveOptions cEnv newDeclGroups return (C.envE newCryEnv) when debug $ do - putStrLn $ show (ppListX "newDeclGroups" newDeclGroups) - putStrLn $ show (ppListX "newTermEnv" + putStrLn $ show (ppListX "LOG: newDeclGroups" newDeclGroups) + putStrLn $ show (ppListX "LOG: newTermEnv" ({- map MN.nameIdent $ -} Map.keys newTermEnv)) return ( m , env{ eModuleEnv = modEnv' @@ -785,22 +785,22 @@ importCryptolModule sc env src as vis imps = nmsPP = MI.ifsDefines $ MI.ifNames $ ME.lmInterface lm -- works, but doesn't "inline" submodule defs. - putStrLn "importCrytolModule:" - print $ ppListX "nms1: " $ Set.toList $ Map.keysSet nms1 - print $ text "namingEnvFromNames:" + putStrLn "LOG: importCrytolModule:" + print $ ppListX "LOG: nms1: " $ Set.toList $ Map.keysSet nms1 + print $ text "LOG: namingEnvFromNames:" <> pp (MN.namingEnvFromNames (Map.keysSet nms1)) - print $ ppListX "nmsPu: " $ Set.toList nmsPu - print $ ppListX "nmsPuPr: " $ Set.toList nmsPP - print $ text "namingEnv:" <> pp (ME.lmNamingEnv lm) + print $ ppListX "LOG: nmsPu: " $ Set.toList nmsPu + print $ ppListX "LOG: nmsPuPr: " $ Set.toList nmsPP + print $ text "LOG: namingEnv:" <> pp (ME.lmNamingEnv lm) -- shows everything in scope, excluding hidden from the top level - putStrLn "importCrytolModule: submodules(" + putStrLn "LOG: importCrytolModule: submodules(" flip mapM_ (Map.toList $ T.mSubmodules mod') $ \(nm,sm)-> do - putStrLn ("submodule: " ++ show (pp nm)) + putStrLn ("LOG: submodule: " ++ show (pp nm)) print $ pp (T.smInScope sm) putStrLn "" - putStrLn ")" + putStrLn "LOG ) /* submodules */\n" return $ env' {eImports= import' : eImports env } diff --git a/intTests/test_saw_submodule_access1/F.cry b/intTests/test_saw_submodule_access1/F.cry index fbb1a3e391..d206cf8137 100644 --- a/intTests/test_saw_submodule_access1/F.cry +++ b/intTests/test_saw_submodule_access1/F.cry @@ -10,6 +10,7 @@ d00 : [32] d00 = 1 // let's conflict with D.cry private + top_pri : [32] top_pri = 5 submodule D3 where @@ -18,10 +19,12 @@ submodule D3 where d3b = 1 + d3_pri private + d3_pri : [32] d3_pri = 1 + d3 submodule D4 where d4 = 20000 + top1 + d3 + d4_pri private + d4_pri : [32] d4_pri = 5 From 1479130233e0502bb9ce32cdd0bf595f22c59f02 Mon Sep 17 00:00:00 2001 From: Mark Tullsen Date: Wed, 8 Oct 2025 22:36:09 -0700 Subject: [PATCH 37/57] checkpoint (logging code shows proposed new code) --- .../src/CryptolSAWCore/CryptolEnv.hs | 40 +++++++++++++++---- 1 file changed, 33 insertions(+), 7 deletions(-) diff --git a/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs b/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs index e8db139db1..962617e37a 100644 --- a/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs +++ b/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs @@ -770,10 +770,11 @@ importCryptolModule sc env src as vis imps = let lm = case ME.lookupModule (T.mName mod') (eModuleEnv env') of Just lm' -> lm' Nothing -> panic "importImportModule" [] + modNamingEnv = ME.lmNamingEnv lm nms1 :: Map MN.Name MI.IfaceDecl nms1 = MI.ifDecls $ MI.ifDefines $ ME.lmInterface lm - -- Correct for PuPr + -- Correct for PublicAndPrivate -- ne = getNamingEnvForImport (eModuleEnv env') import' @@ -791,17 +792,42 @@ importCryptolModule sc env src as vis imps = <> pp (MN.namingEnvFromNames (Map.keysSet nms1)) print $ ppListX "LOG: nmsPu: " $ Set.toList nmsPu print $ ppListX "LOG: nmsPuPr: " $ Set.toList nmsPP - print $ text "LOG: namingEnv:" <> pp (ME.lmNamingEnv lm) + print $ text "LOG: namingEnv:" <> pp modNamingEnv -- shows everything in scope, excluding hidden from the top level putStrLn "LOG: importCrytolModule: submodules(" - flip mapM_ (Map.toList $ T.mSubmodules mod') $ \(nm,sm)-> - do - putStrLn ("LOG: submodule: " ++ show (pp nm)) - print $ pp (T.smInScope sm) - putStrLn "" + smPrivates <- + flip mapM (Map.toList $ T.mSubmodules mod') $ \(nm,sm)-> + do + putStrLn ("LOG: submodule: " ++ show (pp nm)) + putStrLn ("LOG: submodule names in scope:") + print $ pp (T.smInScope sm) + putStrLn "" + let modName = textToModName $ identText $ MN.nameIdent nm + getQualifiedPrivateDefs sm' = + MN.interpImportEnv' + (Just modName) -- qualify with `modName` + Nothing -- no ImportSpec + (T.smInScope sm' `MN.without` modNamingEnv) + putStrLn ("LOG: qualifiedPrivateDefs:") + print $ pp $ getQualifiedPrivateDefs sm + putStrLn ("") + + return $ getQualifiedPrivateDefs sm + putStrLn "LOG ) /* submodules */\n" + let smPrivateNamingEnv = mconcat smPrivates + print $ text "LOG: smPrivateNamingEnv: " <> pp smPrivateNamingEnv + {- + let sms = T.mSubmodules mod' + submNamingEnvs = + map (getQualifiedPrivateDefs mod') sms + namingEnv' = mconcat (ME.lmNamingEnv lm : submNamingEnvs) + + getQualifiedPrivateDefs mod sm + -} + return $ env' {eImports= import' : eImports env } mkImport :: ImportVisibility From b0127a75cd7fe2c0eefe53e0ce18508051e8ce20 Mon Sep 17 00:00:00 2001 From: Mark Tullsen Date: Thu, 9 Oct 2025 10:50:17 -0700 Subject: [PATCH 38/57] refactor (turning logging messages into org outline) --- .../src/CryptolSAWCore/CryptolEnv.hs | 33 ++++++++++--------- 1 file changed, 18 insertions(+), 15 deletions(-) diff --git a/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs b/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs index 962617e37a..83a868ef15 100644 --- a/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs +++ b/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs @@ -698,8 +698,10 @@ loadAndTranslateModule sc env src = sc C.defaultPrimitiveOptions cEnv newDeclGroups return (C.envE newCryEnv) when debug $ do - putStrLn $ show (ppListX "LOG: newDeclGroups" newDeclGroups) - putStrLn $ show (ppListX "LOG: newTermEnv" + + putStrLn "* LOG: loadAndTranslateModule:" + putStrLn $ show (ppListX "** LOG: newDeclGroups\n" newDeclGroups) + putStrLn $ show (ppListX "** LOG: newTermEnv\n" ({- map MN.nameIdent $ -} Map.keys newTermEnv)) return ( m , env{ eModuleEnv = modEnv' @@ -786,21 +788,22 @@ importCryptolModule sc env src as vis imps = nmsPP = MI.ifsDefines $ MI.ifNames $ ME.lmInterface lm -- works, but doesn't "inline" submodule defs. - putStrLn "LOG: importCrytolModule:" - print $ ppListX "LOG: nms1: " $ Set.toList $ Map.keysSet nms1 - print $ text "LOG: namingEnvFromNames:" + putStrLn "* LOG: BEGIN importCrytolModule:" + print $ text "* LOG: namingEnvFromNames\n:" <> pp (MN.namingEnvFromNames (Map.keysSet nms1)) - print $ ppListX "LOG: nmsPu: " $ Set.toList nmsPu - print $ ppListX "LOG: nmsPuPr: " $ Set.toList nmsPP - print $ text "LOG: namingEnv:" <> pp modNamingEnv + putStrLn "* LOG: various names:" + print $ ppListX "- LOG: nms1: " $ Set.toList $ Map.keysSet nms1 + print $ ppListX "- LOG: nmsPu: " $ Set.toList nmsPu + print $ ppListX "- LOG: nmsPuPr: " $ Set.toList nmsPP + print $ text "* LOG: namingEnv:\n" <> pp modNamingEnv -- shows everything in scope, excluding hidden from the top level - putStrLn "LOG: importCrytolModule: submodules(" + putStrLn "* LOG: importCrytolModule: submodules:" smPrivates <- flip mapM (Map.toList $ T.mSubmodules mod') $ \(nm,sm)-> do - putStrLn ("LOG: submodule: " ++ show (pp nm)) - putStrLn ("LOG: submodule names in scope:") + putStrLn ("** LOG: submodule: " ++ show (pp nm)) + putStrLn ("*** LOG: submodule names in scope:") print $ pp (T.smInScope sm) putStrLn "" let modName = textToModName $ identText $ MN.nameIdent nm @@ -809,17 +812,16 @@ importCryptolModule sc env src as vis imps = (Just modName) -- qualify with `modName` Nothing -- no ImportSpec (T.smInScope sm' `MN.without` modNamingEnv) - putStrLn ("LOG: qualifiedPrivateDefs:") + putStrLn ("*** LOG: qualifiedPrivateDefs:") print $ pp $ getQualifiedPrivateDefs sm putStrLn ("") return $ getQualifiedPrivateDefs sm - putStrLn "LOG ) /* submodules */\n" - let smPrivateNamingEnv = mconcat smPrivates - print $ text "LOG: smPrivateNamingEnv: " <> pp smPrivateNamingEnv + print $ text "* LOG: smPrivateNamingEnv:\n" <> pp smPrivateNamingEnv {- + -- unmonadified for use in _ let sms = T.mSubmodules mod' submNamingEnvs = map (getQualifiedPrivateDefs mod') sms @@ -827,6 +829,7 @@ importCryptolModule sc env src as vis imps = getQualifiedPrivateDefs mod sm -} + putStrLn "* LOG: END importCrytolModule." return $ env' {eImports= import' : eImports env } From bea8b6ee5d11afcad00e1f458017126d2cb005cd Mon Sep 17 00:00:00 2001 From: Mark Tullsen Date: Fri, 10 Oct 2025 17:16:09 -0700 Subject: [PATCH 39/57] checkpoint --- .../src/CryptolSAWCore/CryptolEnv.hs | 103 ++++++++++++++++-- 1 file changed, 91 insertions(+), 12 deletions(-) diff --git a/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs b/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs index 83a868ef15..68441a4847 100644 --- a/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs +++ b/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs @@ -767,6 +767,7 @@ importCryptolModule sc env src as vis imps = do (mod', env') <- loadAndTranslateModule sc env src let import' = mkImport vis (locatedUnknown (T.mName mod')) as imps + when debug $ do let lm = case ME.lookupModule (T.mName mod') (eModuleEnv env') of @@ -774,29 +775,62 @@ importCryptolModule sc env src as vis imps = Nothing -> panic "importImportModule" [] modNamingEnv = ME.lmNamingEnv lm - nms1 :: Map MN.Name MI.IfaceDecl - nms1 = MI.ifDecls $ MI.ifDefines $ ME.lmInterface lm + nms1a :: Set.Set MN.Name + nms1a = Map.keysSet $ MI.ifDecls $ MI.ifDefines $ ME.lmInterface lm -- Correct for PublicAndPrivate + nms1b :: [MN.Name] + nms1b = map MI.ifDeclName + $ Map.elems $ MI.ifDecls $ MI.ifDefines $ ME.lmInterface lm + -- Equiv to nms1a + -- ne = getNamingEnvForImport (eModuleEnv env') import' nmsPu :: Set.Set MN.Name nmsPu = MI.ifsPublic $ MI.ifNames $ ME.lmInterface lm -- Correct for PublicOnly + nmsPriv :: Set.Set MN.Name + nmsPriv = nms1a Set.\\ nmsPu + nmsPP :: Set.Set MN.Name nmsPP = MI.ifsDefines $ MI.ifNames $ ME.lmInterface lm -- works, but doesn't "inline" submodule defs. + envPriv = MN.namingEnvFromNames' generalNameToPName nmsPriv + + let ppList' s ns = + do + print $ ppListX (unwords ["- LOG: ", s, " :\n"]) ns + putStrLn "" + putStrLn "* LOG: BEGIN importCrytolModule:" - print $ text "* LOG: namingEnvFromNames\n:" - <> pp (MN.namingEnvFromNames (Map.keysSet nms1)) + print $ text "* LOG: (namingEnvFromNames nms1a):\n" + <> pp (MN.namingEnvFromNames nms1a) putStrLn "* LOG: various names:" - print $ ppListX "- LOG: nms1: " $ Set.toList $ Map.keysSet nms1 - print $ ppListX "- LOG: nmsPu: " $ Set.toList nmsPu - print $ ppListX "- LOG: nmsPuPr: " $ Set.toList nmsPP - print $ text "* LOG: namingEnv:\n" <> pp modNamingEnv - -- shows everything in scope, excluding hidden from the top level + ppList' "nms1a" (Set.toList nms1a) + ppList' "nms1b" nms1b + ppList' "nmsPu" (Set.toList nmsPu) + ppList' "nmsPuPr" (Set.toList nmsPP) + ppList' "nmsPriv" (Set.toList nmsPriv) + + putStrLn "* LOG: print(ms1a):" + mapM_ (\n->print n >> putStrLn "") + (Set.toList nms1a) + + print $ text "* LOG: print modNamingEnv:\n" + flip mapM_ (Map.toList $ MN.namespaceMap C.NSValue modNamingEnv) $ + (\(k,v)-> do + print k + print v + putStrLn "") + + print $ text "* LOG: pp modNamingEnv:\n" + <> pp modNamingEnv + -- shows everything in scope at top level + + print $ text "* LOG: pp envPriv:\n" + <> pp envPriv putStrLn "* LOG: importCrytolModule: submodules:" smPrivates <- @@ -806,22 +840,49 @@ importCryptolModule sc env src as vis imps = putStrLn ("*** LOG: submodule names in scope:") print $ pp (T.smInScope sm) putStrLn "" - let modName = textToModName $ identText $ MN.nameIdent nm + let modName :: C.ModName + modName = textToModName $ identText $ MN.nameIdent nm + modName2 :: MN.Name + modName2 = MI.ifsName $ T.smIface sm getQualifiedPrivateDefs sm' = MN.interpImportEnv' (Just modName) -- qualify with `modName` Nothing -- no ImportSpec (T.smInScope sm' `MN.without` modNamingEnv) + getQualifiedPrivateDefs2 sm' = + (MN.interpImportEnv' + (Just modName) -- qualify with `modName` + Nothing -- no ImportSpec + (T.smInScope sm')) `MN.without` modNamingEnv + putStrLn ("*** LOG: modName/2: ") + print modName + print modName2 + putStrLn "" + + putStrLn ("*** LOG: value map sizes:") + putStrLn $ + "smInScope: " + ++ show (Map.size $ MN.namespaceMap C.NSValue (T.smInScope sm)) + putStrLn $ + "modNamingEnv: " + ++ show (Map.size $ MN.namespaceMap C.NSValue modNamingEnv) + putStrLn ("*** LOG: qualifiedPrivateDefs:") print $ pp $ getQualifiedPrivateDefs sm - putStrLn ("") + putStrLn "" + + putStrLn ("*** LOG: qualifiedPrivateDefs2:") + print $ pp $ getQualifiedPrivateDefs2 sm + putStrLn "" return $ getQualifiedPrivateDefs sm + putStrLn $ "* LOG: (findAmbig modNamingEnv) = " + ++ show (MN.findAmbig modNamingEnv) let smPrivateNamingEnv = mconcat smPrivates print $ text "* LOG: smPrivateNamingEnv:\n" <> pp smPrivateNamingEnv {- - -- unmonadified for use in _ + -- un-monadified for use in getNamingEnv: let sms = T.mSubmodules mod' submNamingEnvs = map (getQualifiedPrivateDefs mod') sms @@ -1150,3 +1211,21 @@ moduleCmdResult (res, ws) = do notDefaulting :: TE.Warning -> Bool notDefaulting (TE.DefaultingTo {}) = False notDefaulting _ = True + + +-- do these have better home? + +generalNameToPName :: T.Name -> P.PName +generalNameToPName n = + case MN.nameInfo n of + MN.GlobalName _ og -> generalOrigNameToPName og + MN.LocalName _ _ txt -> P.mkUnqual txt + +generalOrigNameToPName :: C.OrigName -> P.PName +generalOrigNameToPName og = + case C.modPathSplit (C.ogModule og) of + (_top,[] ) -> P.UnQual ident + (_top,ids) -> P.Qual (C.packModName (map identText ids)) ident + + where + ident = C.ogName og From e5516c2bd5e1a0c0886c5096da9ce781cf3f06ab Mon Sep 17 00:00:00 2001 From: Mark Tullsen Date: Fri, 10 Oct 2025 17:38:34 -0700 Subject: [PATCH 40/57] refactor, plus fixing nmsPr (based on nmsTopLevels) --- .../src/CryptolSAWCore/CryptolEnv.hs | 49 ++++++++++--------- 1 file changed, 27 insertions(+), 22 deletions(-) diff --git a/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs b/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs index 68441a4847..870948c52c 100644 --- a/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs +++ b/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs @@ -775,14 +775,18 @@ importCryptolModule sc env src as vis imps = Nothing -> panic "importImportModule" [] modNamingEnv = ME.lmNamingEnv lm - nms1a :: Set.Set MN.Name - nms1a = Map.keysSet $ MI.ifDecls $ MI.ifDefines $ ME.lmInterface lm + nmsPuPr1 :: Set.Set MN.Name + nmsPuPr1 = Map.keysSet $ MI.ifDecls $ MI.ifDefines $ ME.lmInterface lm -- Correct for PublicAndPrivate - nms1b :: [MN.Name] - nms1b = map MI.ifDeclName + nmsPuPr2 :: [MN.Name] + nmsPuPr2 = map MI.ifDeclName $ Map.elems $ MI.ifDecls $ MI.ifDefines $ ME.lmInterface lm - -- Equiv to nms1a + -- Equiv to nmsPuPr1 + + nmsPuPr3 :: Set.Set MN.Name + nmsPuPr3 = MI.ifsDefines $ MI.ifNames $ ME.lmInterface lm + -- works, but doesn't "inline" submodule defs. -- ne = getNamingEnvForImport (eModuleEnv env') import' @@ -790,14 +794,13 @@ importCryptolModule sc env src as vis imps = nmsPu = MI.ifsPublic $ MI.ifNames $ ME.lmInterface lm -- Correct for PublicOnly - nmsPriv :: Set.Set MN.Name - nmsPriv = nms1a Set.\\ nmsPu + nmsTopLevels :: Set.Set MN.Name + nmsTopLevels = MN.namingEnvNames modNamingEnv - nmsPP :: Set.Set MN.Name - nmsPP = MI.ifsDefines $ MI.ifNames $ ME.lmInterface lm - -- works, but doesn't "inline" submodule defs. + nmsPr :: Set.Set MN.Name + nmsPr = nmsPuPr1 Set.\\ nmsTopLevels - envPriv = MN.namingEnvFromNames' generalNameToPName nmsPriv + envPriv = MN.namingEnvFromNames' generalNameToPName nmsPr let ppList' s ns = do @@ -805,18 +808,22 @@ importCryptolModule sc env src as vis imps = putStrLn "" putStrLn "* LOG: BEGIN importCrytolModule:" - print $ text "* LOG: (namingEnvFromNames nms1a):\n" - <> pp (MN.namingEnvFromNames nms1a) + print $ text "* LOG: (namingEnvFromNames nmsPuPr1):\n" + <> pp (MN.namingEnvFromNames nmsPuPr1) putStrLn "* LOG: various names:" - ppList' "nms1a" (Set.toList nms1a) - ppList' "nms1b" nms1b - ppList' "nmsPu" (Set.toList nmsPu) - ppList' "nmsPuPr" (Set.toList nmsPP) - ppList' "nmsPriv" (Set.toList nmsPriv) + ppList' "nmsPuPr1" (Set.toList nmsPuPr1) + ppList' "nmsPuPr2" nmsPuPr2 + ppList' "nmsPuPr3" (Set.toList nmsPuPr3) + ppList' "nmsPu" (Set.toList nmsPu) + ppList' "nmsPr" (Set.toList nmsPr) - putStrLn "* LOG: print(ms1a):" + putStrLn "* LOG: print(nmsPuPr1):" mapM_ (\n->print n >> putStrLn "") - (Set.toList nms1a) + (Set.toList nmsPuPr1) + + putStrLn $ "* LOG: (findAmbig modNamingEnv) = " + ++ show (MN.findAmbig modNamingEnv) + -- this should be [], then the following works: print $ text "* LOG: print modNamingEnv:\n" flip mapM_ (Map.toList $ MN.namespaceMap C.NSValue modNamingEnv) $ @@ -877,8 +884,6 @@ importCryptolModule sc env src as vis imps = return $ getQualifiedPrivateDefs sm - putStrLn $ "* LOG: (findAmbig modNamingEnv) = " - ++ show (MN.findAmbig modNamingEnv) let smPrivateNamingEnv = mconcat smPrivates print $ text "* LOG: smPrivateNamingEnv:\n" <> pp smPrivateNamingEnv {- From 8f056b05a175f4d78c5c14cdf4e406a1150746df Mon Sep 17 00:00:00 2001 From: Mark Tullsen Date: Fri, 10 Oct 2025 20:03:19 -0700 Subject: [PATCH 41/57] checkpoint: compiles --- .../src/CryptolSAWCore/CryptolEnv.hs | 121 +++++++----------- 1 file changed, 43 insertions(+), 78 deletions(-) diff --git a/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs b/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs index 870948c52c..e390a2a8df 100644 --- a/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs +++ b/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs @@ -330,28 +330,49 @@ getNamingEnvForImport :: ME.ModuleEnv -> MR.NamingEnv getNamingEnvForImport modEnv (vis, imprt) = MN.interpImportEnv imprt -- adjust for qualified imports - $ adjustVisible -- adjust if OnlyPublic names - $ ME.mctxNames mctx -- namingEnv for PublicAndPrivate - -- FIXME: this does not do what we want: ...! - -- - PublicAndPrivate: cannot see privates inside submodules. - -- - OnlyPublic really work?? + $ getPublicAndPrivates modEnv vis imprt + -- NamingEnv for PublicAndPrivate definitions + + +getPublicAndPrivates :: + ME.ModuleEnv -> ImportVisibility -> T.Import -> MR.NamingEnv +getPublicAndPrivates modEnv vis imprt = + + case vis of + PublicAndPrivate -> modNamingEnv <> envPriv + OnlyPublic -> MN.filterUNames + (`Set.member` nmsPu) + modNamingEnv where - mctx = case ME.modContextOf impNm modEnv of - Just c -> c - Nothing -> panic "getNamingEnvForImport" - ["expecting module to be loaded: " - <> Text.pack (show (pp impNm))] - where - -- | fm - name of a 'top level' import: - impNm :: P.ImpName MN.Name - impNm = P.ImpTop $ P.thing $ T.iModule imprt - - adjustVisible :: MR.NamingEnv -> MR.NamingEnv - adjustVisible = case vis of - PublicAndPrivate -> id - OnlyPublic -> - \env' -> MN.filterUNames (`Set.member` ME.mctxExported mctx) env' + modName ::C.ModName + modName = P.thing $ T.iModule imprt + + lm = case ME.lookupModule modName modEnv of + Just lm' -> lm' + Nothing -> panic "FIXME" ["cannot lookupModule"] + + modNamingEnv = ME.lmNamingEnv lm + + nmsTopLevels :: Set.Set MN.Name + nmsTopLevels = MN.namingEnvNames modNamingEnv + + nmsPuPr1 :: Set.Set MN.Name + nmsPuPr1 = Map.keysSet $ MI.ifDecls $ MI.ifDefines $ ME.lmInterface lm + -- Correct for PublicAndPrivate + + nmsPu :: Set.Set MN.Name + nmsPu = MI.ifsPublic $ MI.ifNames $ ME.lmInterface lm + + nmsPr :: Set.Set MN.Name + nmsPr = nmsPuPr1 Set.\\ nmsTopLevels + + envPriv = MN.namingEnvFromNames' generalNameToPName nmsPr + + + + + getAllIfaceDecls :: ME.ModuleEnv -> M.IfaceDecls @@ -772,7 +793,7 @@ importCryptolModule sc env src as vis imps = do let lm = case ME.lookupModule (T.mName mod') (eModuleEnv env') of Just lm' -> lm' - Nothing -> panic "importImportModule" [] + Nothing -> panic "importCryptolModule" [] modNamingEnv = ME.lmNamingEnv lm nmsPuPr1 :: Set.Set MN.Name @@ -788,7 +809,7 @@ importCryptolModule sc env src as vis imps = nmsPuPr3 = MI.ifsDefines $ MI.ifNames $ ME.lmInterface lm -- works, but doesn't "inline" submodule defs. - -- ne = getNamingEnvForImport (eModuleEnv env') import' + ne = getNamingEnvForImport (eModuleEnv env') import' nmsPu :: Set.Set MN.Name nmsPu = MI.ifsPublic $ MI.ifNames $ ME.lmInterface lm @@ -839,62 +860,6 @@ importCryptolModule sc env src as vis imps = print $ text "* LOG: pp envPriv:\n" <> pp envPriv - putStrLn "* LOG: importCrytolModule: submodules:" - smPrivates <- - flip mapM (Map.toList $ T.mSubmodules mod') $ \(nm,sm)-> - do - putStrLn ("** LOG: submodule: " ++ show (pp nm)) - putStrLn ("*** LOG: submodule names in scope:") - print $ pp (T.smInScope sm) - putStrLn "" - let modName :: C.ModName - modName = textToModName $ identText $ MN.nameIdent nm - modName2 :: MN.Name - modName2 = MI.ifsName $ T.smIface sm - getQualifiedPrivateDefs sm' = - MN.interpImportEnv' - (Just modName) -- qualify with `modName` - Nothing -- no ImportSpec - (T.smInScope sm' `MN.without` modNamingEnv) - getQualifiedPrivateDefs2 sm' = - (MN.interpImportEnv' - (Just modName) -- qualify with `modName` - Nothing -- no ImportSpec - (T.smInScope sm')) `MN.without` modNamingEnv - putStrLn ("*** LOG: modName/2: ") - print modName - print modName2 - putStrLn "" - - putStrLn ("*** LOG: value map sizes:") - putStrLn $ - "smInScope: " - ++ show (Map.size $ MN.namespaceMap C.NSValue (T.smInScope sm)) - putStrLn $ - "modNamingEnv: " - ++ show (Map.size $ MN.namespaceMap C.NSValue modNamingEnv) - - putStrLn ("*** LOG: qualifiedPrivateDefs:") - print $ pp $ getQualifiedPrivateDefs sm - putStrLn "" - - putStrLn ("*** LOG: qualifiedPrivateDefs2:") - print $ pp $ getQualifiedPrivateDefs2 sm - putStrLn "" - - return $ getQualifiedPrivateDefs sm - - let smPrivateNamingEnv = mconcat smPrivates - print $ text "* LOG: smPrivateNamingEnv:\n" <> pp smPrivateNamingEnv - {- - -- un-monadified for use in getNamingEnv: - let sms = T.mSubmodules mod' - submNamingEnvs = - map (getQualifiedPrivateDefs mod') sms - namingEnv' = mconcat (ME.lmNamingEnv lm : submNamingEnvs) - - getQualifiedPrivateDefs mod sm - -} putStrLn "* LOG: END importCrytolModule." return $ env' {eImports= import' : eImports env } From 0e9e2524207bae135fd31beef3b584faf08e6c12 Mon Sep 17 00:00:00 2001 From: Mark Tullsen Date: Fri, 10 Oct 2025 20:53:29 -0700 Subject: [PATCH 42/57] checkpoint: many things working, publics in submodules now missing. --- .../src/CryptolSAWCore/CryptolEnv.hs | 52 ++++++++++--------- 1 file changed, 27 insertions(+), 25 deletions(-) diff --git a/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs b/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs index e390a2a8df..3950f14051 100644 --- a/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs +++ b/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs @@ -330,19 +330,7 @@ getNamingEnvForImport :: ME.ModuleEnv -> MR.NamingEnv getNamingEnvForImport modEnv (vis, imprt) = MN.interpImportEnv imprt -- adjust for qualified imports - $ getPublicAndPrivates modEnv vis imprt - -- NamingEnv for PublicAndPrivate definitions - - -getPublicAndPrivates :: - ME.ModuleEnv -> ImportVisibility -> T.Import -> MR.NamingEnv -getPublicAndPrivates modEnv vis imprt = - - case vis of - PublicAndPrivate -> modNamingEnv <> envPriv - OnlyPublic -> MN.filterUNames - (`Set.member` nmsPu) - modNamingEnv + $ computeNamingEnv lm vis where modName ::C.ModName @@ -352,27 +340,38 @@ getPublicAndPrivates modEnv vis imprt = Just lm' -> lm' Nothing -> panic "FIXME" ["cannot lookupModule"] +computeNamingEnv :: ME.LoadedModule -> ImportVisibility -> MR.NamingEnv +computeNamingEnv lm vis = + case vis of + PublicAndPrivate -> envPublic <> envPrivate + OnlyPublic -> envPublic + + where + + -- NamingEnv's: + modNamingEnv :: MR.NamingEnv modNamingEnv = ME.lmNamingEnv lm + envPrivate :: MR.NamingEnv + envPrivate = MN.namingEnvFromNames' generalNameToPName nmsPr + + envPublic = MN.filterUNames + (`Set.member` nmsPu) + modNamingEnv + + -- name sets: nmsTopLevels :: Set.Set MN.Name nmsTopLevels = MN.namingEnvNames modNamingEnv - nmsPuPr1 :: Set.Set MN.Name - nmsPuPr1 = Map.keysSet $ MI.ifDecls $ MI.ifDefines $ ME.lmInterface lm + nmsDefined :: Set.Set MN.Name + nmsDefined = Map.keysSet $ MI.ifDecls $ MI.ifDefines $ ME.lmInterface lm -- Correct for PublicAndPrivate nmsPu :: Set.Set MN.Name nmsPu = MI.ifsPublic $ MI.ifNames $ ME.lmInterface lm nmsPr :: Set.Set MN.Name - nmsPr = nmsPuPr1 Set.\\ nmsTopLevels - - envPriv = MN.namingEnvFromNames' generalNameToPName nmsPr - - - - - + nmsPr = nmsDefined Set.\\ nmsTopLevels getAllIfaceDecls :: ME.ModuleEnv -> M.IfaceDecls @@ -809,8 +808,6 @@ importCryptolModule sc env src as vis imps = nmsPuPr3 = MI.ifsDefines $ MI.ifNames $ ME.lmInterface lm -- works, but doesn't "inline" submodule defs. - ne = getNamingEnvForImport (eModuleEnv env') import' - nmsPu :: Set.Set MN.Name nmsPu = MI.ifsPublic $ MI.ifNames $ ME.lmInterface lm -- Correct for PublicOnly @@ -823,6 +820,11 @@ importCryptolModule sc env src as vis imps = envPriv = MN.namingEnvFromNames' generalNameToPName nmsPr + print $ text "* LOG: NEW: computeNamingEnv PublicAndPrivate:\n" + <> pp (computeNamingEnv lm PublicAndPrivate) + print $ text "* LOG: NEW: computeNamingEnv OnlyPublic:\n" + <> pp (computeNamingEnv lm OnlyPublic) + let ppList' s ns = do print $ ppListX (unwords ["- LOG: ", s, " :\n"]) ns From a4ef330126b9dee23c27fe3dd4ff42cb8204c2ee Mon Sep 17 00:00:00 2001 From: Mark Tullsen Date: Fri, 10 Oct 2025 21:05:19 -0700 Subject: [PATCH 43/57] refactor: renaming --- .../src/CryptolSAWCore/CryptolEnv.hs | 21 ++++++++++--------- 1 file changed, 11 insertions(+), 10 deletions(-) diff --git a/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs b/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs index 3950f14051..86a8186dd2 100644 --- a/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs +++ b/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs @@ -349,29 +349,30 @@ computeNamingEnv lm vis = where -- NamingEnv's: - modNamingEnv :: MR.NamingEnv - modNamingEnv = ME.lmNamingEnv lm + envTopLevels :: MR.NamingEnv + envTopLevels = ME.lmNamingEnv lm envPrivate :: MR.NamingEnv - envPrivate = MN.namingEnvFromNames' generalNameToPName nmsPr + envPrivate = MN.namingEnvFromNames' generalNameToPName nmsPrivate + envPublic :: MR.NamingEnv envPublic = MN.filterUNames - (`Set.member` nmsPu) - modNamingEnv + (`Set.member` nmsPublic) + envTopLevels -- name sets: nmsTopLevels :: Set.Set MN.Name - nmsTopLevels = MN.namingEnvNames modNamingEnv + nmsTopLevels = MN.namingEnvNames envTopLevels nmsDefined :: Set.Set MN.Name nmsDefined = Map.keysSet $ MI.ifDecls $ MI.ifDefines $ ME.lmInterface lm -- Correct for PublicAndPrivate - nmsPu :: Set.Set MN.Name - nmsPu = MI.ifsPublic $ MI.ifNames $ ME.lmInterface lm + nmsPublic :: Set.Set MN.Name + nmsPublic = MI.ifsPublic $ MI.ifNames $ ME.lmInterface lm - nmsPr :: Set.Set MN.Name - nmsPr = nmsDefined Set.\\ nmsTopLevels + nmsPrivate :: Set.Set MN.Name + nmsPrivate = nmsDefined Set.\\ nmsTopLevels getAllIfaceDecls :: ME.ModuleEnv -> M.IfaceDecls From 7bcbab9b41e2a67483b7f429f1cf5f6a0aa9607a Mon Sep 17 00:00:00 2001 From: Mark Tullsen Date: Sat, 11 Oct 2025 14:38:21 -0700 Subject: [PATCH 44/57] more logging, ensure it is off by default --- .../src/CryptolSAWCore/CryptolEnv.hs | 62 ++++++++++++++++--- 1 file changed, 54 insertions(+), 8 deletions(-) diff --git a/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs b/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs index 86a8186dd2..0028f105a9 100644 --- a/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs +++ b/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs @@ -109,7 +109,7 @@ import Cryptol.ModuleSystem.Env (ModContextParams(NoParams)) -- import SAWCentral.AST (Located(getVal, locatedPos), Import(..)) debug :: Bool -debug = True +debug = False ---- Key Types ----------------------------------------------------------------- @@ -794,11 +794,14 @@ importCryptolModule sc env src as vis imps = let lm = case ME.lookupModule (T.mName mod') (eModuleEnv env') of Just lm' -> lm' Nothing -> panic "importCryptolModule" [] + modNamingEnv = ME.lmNamingEnv lm nmsPuPr1 :: Set.Set MN.Name nmsPuPr1 = Map.keysSet $ MI.ifDecls $ MI.ifDefines $ ME.lmInterface lm - -- Correct for PublicAndPrivate + -- good: Correct for PublicAndPrivate [but only var-defs] + -- good: adds defs from submodules into scope, qualified + -- bad: no: types,enums,submodules nmsPuPr2 :: [MN.Name] nmsPuPr2 = map MI.ifDeclName @@ -807,7 +810,11 @@ importCryptolModule sc env src as vis imps = nmsPuPr3 :: Set.Set MN.Name nmsPuPr3 = MI.ifsDefines $ MI.ifNames $ ME.lmInterface lm - -- works, but doesn't "inline" submodule defs. + -- yes: includes types,enums,submodules + -- bad: doesn't "inline" submodule defs. + -- bad: doesn't include types,enums,submodules in 2nd level submodules + + nmsBetter = Set.union nmsPuPr1 nmsPuPr3 nmsPu :: Set.Set MN.Name nmsPu = MI.ifsPublic $ MI.ifNames $ ME.lmInterface lm @@ -821,6 +828,14 @@ importCryptolModule sc env src as vis imps = envPriv = MN.namingEnvFromNames' generalNameToPName nmsPr + nmsNested :: Set.Set MN.Name + nmsNested = MI.ifsNested $ MI.ifNames $ ME.lmInterface lm + -- NOTE: only has the top submodule, not submodules inside that. + + nmsModules :: Set.Set MN.Name + nmsModules = Map.keysSet $ MI.ifModules $ MI.ifDefines $ ME.lmInterface lm + + print $ text "* LOG: NEW: computeNamingEnv PublicAndPrivate:\n" <> pp (computeNamingEnv lm PublicAndPrivate) print $ text "* LOG: NEW: computeNamingEnv OnlyPublic:\n" @@ -835,11 +850,15 @@ importCryptolModule sc env src as vis imps = print $ text "* LOG: (namingEnvFromNames nmsPuPr1):\n" <> pp (MN.namingEnvFromNames nmsPuPr1) putStrLn "* LOG: various names:" - ppList' "nmsPuPr1" (Set.toList nmsPuPr1) - ppList' "nmsPuPr2" nmsPuPr2 - ppList' "nmsPuPr3" (Set.toList nmsPuPr3) - ppList' "nmsPu" (Set.toList nmsPu) - ppList' "nmsPr" (Set.toList nmsPr) + ppList' "nmsPuPr1" (Set.toList nmsPuPr1) + ppList' "nmsPuPr2" nmsPuPr2 + ppList' "nmsPuPr3" (Set.toList nmsPuPr3) + ppList' "nmsPu" (Set.toList nmsPu) + ppList' "nmsPr" (Set.toList nmsPr) + ppList' "nmsNested" (Set.toList nmsNested) + ppList' "nmsModules" (Set.toList nmsModules) + ppList' "nmsBetter" (Set.toList nmsBetter) + putStrLn "* LOG: print(nmsPuPr1):" mapM_ (\n->print n >> putStrLn "") @@ -849,6 +868,33 @@ importCryptolModule sc env src as vis imps = ++ show (MN.findAmbig modNamingEnv) -- this should be [], then the following works: + putStrLn "* LOG: submodules:" + flip mapM_ (Map.toList $ T.mSubmodules mod') $ \(nm,sm)-> + do + putStrLn ("** LOG: submodule: " ++ show (pp nm)) + -- putStrLn ("*** LOG: submodule names in scope:") + -- print $ pp (T.smInScope sm) + -- putStrLn "" + let modName :: C.ModName + modName = textToModName $ identText $ MN.nameIdent nm + modName2 :: MN.Name + modName2 = MI.ifsName $ T.smIface sm + putStrLn ("*** LOG: modName/2: ") + print modName + print modName2 + putStrLn "" + + ppList' "ifsDefines" + $ Set.toList $ MI.ifsDefines $ T.smIface sm + ppList' "ifsNested" + $ Set.toList $ MI.ifsNested $ T.smIface sm + putStrLn $ + "smInScope: " + ++ show (Map.size $ MN.namespaceMap C.NSValue (T.smInScope sm)) + putStrLn $ + "modNamingEnv: " + ++ show (Map.size $ MN.namespaceMap C.NSValue modNamingEnv) + print $ text "* LOG: print modNamingEnv:\n" flip mapM_ (Map.toList $ MN.namespaceMap C.NSValue modNamingEnv) $ (\(k,v)-> do From 6928264ef7f5bcb53ea0ef07411f1ce0b0774a3f Mon Sep 17 00:00:00 2001 From: Mark Tullsen Date: Sat, 11 Oct 2025 14:38:45 -0700 Subject: [PATCH 45/57] comments --- cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs b/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs index 0028f105a9..26ac8fdb1d 100644 --- a/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs +++ b/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs @@ -316,7 +316,7 @@ ioParseResult res = case res of -- NamingEnv and Related ------------------------------------------------------- -- | @'getNamingEnv' env@ - get the full 'MR.NamingEnv' based on all --- the 'eImports' +-- the imports (@eImports env@). getNamingEnv :: CryptolEnv -> MR.NamingEnv getNamingEnv env = eExtraNames env From 2137dd2548755fc01faee191fd39a212abb5dffb Mon Sep 17 00:00:00 2001 From: Mark Tullsen Date: Sat, 11 Oct 2025 14:40:29 -0700 Subject: [PATCH 46/57] fix `computeNamingEnv` Now working: full support of submodules, private, nominal types, and etc. --- .../src/CryptolSAWCore/CryptolEnv.hs | 40 +++++++++++++++---- 1 file changed, 33 insertions(+), 7 deletions(-) diff --git a/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs b/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs index 26ac8fdb1d..6f2bd5bd37 100644 --- a/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs +++ b/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs @@ -343,17 +343,28 @@ getNamingEnvForImport modEnv (vis, imprt) = computeNamingEnv :: ME.LoadedModule -> ImportVisibility -> MR.NamingEnv computeNamingEnv lm vis = case vis of - PublicAndPrivate -> envPublic <> envPrivate - OnlyPublic -> envPublic + PublicAndPrivate -> envPublicAndPrivate -- all names defined, pub & pri + OnlyPublic -> envPublic -- i.e., what's exported. where + -- NamingEnv's -- - -- NamingEnv's: + -- | envTopLevels + -- - Does not include privates in submodules (which makes for + -- much of the complications of this function). + -- - Includes everything in scope at the toplevel of 'lm' module envTopLevels :: MR.NamingEnv envTopLevels = ME.lmNamingEnv lm - envPrivate :: MR.NamingEnv - envPrivate = MN.namingEnvFromNames' generalNameToPName nmsPrivate + -- | envPublicAndPrivate - awkward as envTopLevels excludes privates + envPublicAndPrivate :: MR.NamingEnv + envPublicAndPrivate = + -- nab all the names defined in module (from toplevel scope): + MN.filterUNames (`Set.member` nmsDefined) envTopLevels + <> + -- we must create a new NamingEnv (since the privates are not + -- in `envTopLevels`): + MN.namingEnvFromNames' generalNameToPName nmsPrivate envPublic :: MR.NamingEnv envPublic = MN.filterUNames @@ -361,12 +372,27 @@ computeNamingEnv lm vis = envTopLevels -- name sets: + + -- | names in scope at Top level of module nmsTopLevels :: Set.Set MN.Name nmsTopLevels = MN.namingEnvNames envTopLevels + -- | names defined in module and in submodules + -- - this includes `PublicAndPrivate` names! + -- - includes submodule names, type synonyms, and nominal types nmsDefined :: Set.Set MN.Name - nmsDefined = Map.keysSet $ MI.ifDecls $ MI.ifDefines $ ME.lmInterface lm - -- Correct for PublicAndPrivate + nmsDefined = + -- definitions from all submodules: + ( Set.unions + $ map (MI.ifsDefines . T.smIface) + $ Map.elems + $ T.mSubmodules + $ ME.lmModule lm + ) + `Set.union` + -- definitions at the top module: + (MI.ifsDefines $ MI.ifNames $ ME.lmInterface lm) + nmsPublic :: Set.Set MN.Name nmsPublic = MI.ifsPublic $ MI.ifNames $ ME.lmInterface lm From 9b66459f2b59f49d8a250365a6ccf3984c6fb403 Mon Sep 17 00:00:00 2001 From: Mark Tullsen Date: Sat, 11 Oct 2025 14:41:39 -0700 Subject: [PATCH 47/57] Update tests (now that they pass). --- intTests/test_saw_submodule_access1/F.cry | 45 ++++++++++++++----- .../test_private_with_submodules.saw | 16 +++---- 2 files changed, 39 insertions(+), 22 deletions(-) diff --git a/intTests/test_saw_submodule_access1/F.cry b/intTests/test_saw_submodule_access1/F.cry index d206cf8137..7179bacdfb 100644 --- a/intTests/test_saw_submodule_access1/F.cry +++ b/intTests/test_saw_submodule_access1/F.cry @@ -1,30 +1,53 @@ module F where import B import C +import B as E1::E2 // N.B. -top1 = 2000 + b + c -top2 = 5 + D3::d3 -top3 = 10 + D3::D4::d4 +top1 = 1 + E1::E2::b // 1+12 = 13 +top2 = 1 + D3::d3 // 1+15 = 16 +top3 = 1 + D3::D4::d4 // 1+36 = 37 d00 : [32] -d00 = 1 // let's conflict with D.cry +d00 = 1 // let's conflict with D.cry (for other tests) + +type TopU64 = [64] + +enum TestEnum0 = A0 | B0 private top_pri : [32] top_pri = 5 + e1 = A0 : TestEnum0 + submodule D3 where - d3 = 10000 + top1 - d3a = 1 + D4::d4 - d3b = 1 + d3_pri + d3 = 2 + top1 // = 15 + d3a = 2 + d3_pri // = 33 + d3b = 2 + D4::d4 // = 38 + + type D3U64 = [64] + enum TestEnum3 = A3 | B3 private d3_pri : [32] - d3_pri = 1 + d3 + d3_pri = 1 + d3 + D3::d3 // 1 + 2*15 = 31 submodule D4 where - d4 = 20000 + top1 + d3 + d4_pri + d4 = 3 + top1 + d3 + d4_pri // 3 + 13 + 15 + 5 = 36 + d4b = d4_pri + D4::d4 + D3::D4::d4 // 5 + 36 + 36 = 77 + + enum TestEnum4 = A4 | B4 private - d4_pri : [32] - d4_pri = 5 + d4_pri : D4U32 + d4_pri = 5 + + type D4U32 = [32] + +/* + submodule E1::E2 where + e1 : [32] + e1 = 5 + // this not allowed, but you can import qualified these + // "multi-chunk" module names +*/ \ No newline at end of file diff --git a/intTests/test_saw_submodule_access1/test_private_with_submodules.saw b/intTests/test_saw_submodule_access1/test_private_with_submodules.saw index 9c8e75e033..3bf704497f 100644 --- a/intTests/test_saw_submodule_access1/test_private_with_submodules.saw +++ b/intTests/test_saw_submodule_access1/test_private_with_submodules.saw @@ -4,9 +4,8 @@ import "HWithSubmodules.cry" as HI; print (eval_int {{HI::a}}); // public, should succeed. print (eval_int {{HI::b}}); // private, should succeed. -print (eval_int {{HI::H2::c}}); // public, should succeed. -fails (do {print (eval_int {{ HI::H2::d }});}); // private, should succeed. - // +print (eval_int {{HI::H2::c}}); // public, should succeed. +print (eval_int {{HI::H2::d}}); // private, should succeed. ////////////////////////////////////////////// // testing cryptol_load @@ -15,15 +14,10 @@ print HL; print (eval_int {{HL::a}}); // public, should succeed. print (eval_int {{HL::b}}); // private, should succeed. -print (eval_int {{HL::H2::c}}); // public, should succeed. - -fails (do {print (eval_int {{HL::H2::d}});}); // private, should succeed. +print (eval_int {{HL::H2::c}}); // public, should succeed. +print (eval_int {{HL::H2::d}}); // private, should succeed. do {x <- cryptol_extract HL "a"; print x;}; // public, should succeed. do {x <- cryptol_extract HL "b"; print x;}; // private, should succeed. do {x <- cryptol_extract HL "H2::c"; print x;}; // public, should succeed. -fails (do {x <- cryptol_extract HL "H2::d"; print x;}); // private, should succeed. - -// QUESTION: -// This does seem to 'match' what `cryptol` REPL does. -// What we want? +do {x <- cryptol_extract HL "H2::d"; print x;}; // private, should succeed. From c3265ba9de813e8748bcc90c28d7a6a4e2ae8bf8 Mon Sep 17 00:00:00 2001 From: Mark Tullsen Date: Sat, 11 Oct 2025 15:31:43 -0700 Subject: [PATCH 48/57] refactor (with previous bump): move functions to deps/cryptol --- .../src/CryptolSAWCore/CryptolEnv.hs | 22 ++----------------- 1 file changed, 2 insertions(+), 20 deletions(-) diff --git a/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs b/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs index 6f2bd5bd37..b935de47ec 100644 --- a/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs +++ b/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs @@ -364,7 +364,7 @@ computeNamingEnv lm vis = <> -- we must create a new NamingEnv (since the privates are not -- in `envTopLevels`): - MN.namingEnvFromNames' generalNameToPName nmsPrivate + MN.namingEnvFromNames' MN.nameToPNameWithQualifiers nmsPrivate envPublic :: MR.NamingEnv envPublic = MN.filterUNames @@ -852,7 +852,7 @@ importCryptolModule sc env src as vis imps = nmsPr :: Set.Set MN.Name nmsPr = nmsPuPr1 Set.\\ nmsTopLevels - envPriv = MN.namingEnvFromNames' generalNameToPName nmsPr + envPriv = MN.namingEnvFromNames' MN.nameToPNameWithQualifiers nmsPr nmsNested :: Set.Set MN.Name nmsNested = MI.ifsNested $ MI.ifNames $ ME.lmInterface lm @@ -1256,21 +1256,3 @@ moduleCmdResult (res, ws) = do notDefaulting :: TE.Warning -> Bool notDefaulting (TE.DefaultingTo {}) = False notDefaulting _ = True - - --- do these have better home? - -generalNameToPName :: T.Name -> P.PName -generalNameToPName n = - case MN.nameInfo n of - MN.GlobalName _ og -> generalOrigNameToPName og - MN.LocalName _ _ txt -> P.mkUnqual txt - -generalOrigNameToPName :: C.OrigName -> P.PName -generalOrigNameToPName og = - case C.modPathSplit (C.ogModule og) of - (_top,[] ) -> P.UnQual ident - (_top,ids) -> P.Qual (C.packModName (map identText ids)) ident - - where - ident = C.ogName og From 0c8eb864a452f23d5ae6010b117360b2ba8d0eb9 Mon Sep 17 00:00:00 2001 From: Mark Tullsen Date: Sat, 11 Oct 2025 16:46:20 -0700 Subject: [PATCH 49/57] fixup the merge this change was broken, but now is correct: 32556b15.. : cryptol-saw-core: Only import nominal types from non-parameterized modules --- cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs b/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs index b935de47ec..f09ea425e2 100644 --- a/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs +++ b/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs @@ -735,8 +735,8 @@ loadAndTranslateModule sc env src = $ ME.lmLoadedModules $ ME.meLoadedModules modEnv' newDeclGroups = concatMap T.mDecls newModules - newNominal = Map.difference (ME.loadedNominalTypes modEnv') - (ME.loadedNominalTypes modEnv) + newNominal = Map.difference (loadedNonParamNominalTypes modEnv') + (loadedNonParamNominalTypes modEnv) newTermEnv <- do oldCryEnv <- mkCryEnv env From 2137a1efe5afe93c8c3d23de4e75904a4351da76 Mon Sep 17 00:00:00 2001 From: Mark Tullsen Date: Sat, 11 Oct 2025 17:40:05 -0700 Subject: [PATCH 50/57] whitespace, and elaborate comments --- .../src/CryptolSAWCore/CryptolEnv.hs | 120 ++++++++++-------- 1 file changed, 64 insertions(+), 56 deletions(-) diff --git a/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs b/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs index f09ea425e2..1613c11883 100644 --- a/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs +++ b/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs @@ -325,6 +325,7 @@ getNamingEnv env = (eImports env) ) +-- | get Naming Env for one Import. getNamingEnvForImport :: ME.ModuleEnv -> (ImportVisibility, T.Import) -> MR.NamingEnv @@ -338,8 +339,10 @@ getNamingEnvForImport modEnv (vis, imprt) = lm = case ME.lookupModule modName modEnv of Just lm' -> lm' - Nothing -> panic "FIXME" ["cannot lookupModule"] + Nothing -> panic "getNamingEnvForImport" + ["cannot lookupModule: " <> Text.pack(show modName)] +-- | compute the NamingEnv based on the ImportVisibility. computeNamingEnv :: ME.LoadedModule -> ImportVisibility -> MR.NamingEnv computeNamingEnv lm vis = case vis of @@ -347,58 +350,58 @@ computeNamingEnv lm vis = OnlyPublic -> envPublic -- i.e., what's exported. where - -- NamingEnv's -- - - -- | envTopLevels - -- - Does not include privates in submodules (which makes for - -- much of the complications of this function). - -- - Includes everything in scope at the toplevel of 'lm' module - envTopLevels :: MR.NamingEnv - envTopLevels = ME.lmNamingEnv lm - - -- | envPublicAndPrivate - awkward as envTopLevels excludes privates - envPublicAndPrivate :: MR.NamingEnv - envPublicAndPrivate = - -- nab all the names defined in module (from toplevel scope): - MN.filterUNames (`Set.member` nmsDefined) envTopLevels - <> - -- we must create a new NamingEnv (since the privates are not - -- in `envTopLevels`): - MN.namingEnvFromNames' MN.nameToPNameWithQualifiers nmsPrivate - - envPublic :: MR.NamingEnv - envPublic = MN.filterUNames - (`Set.member` nmsPublic) - envTopLevels - - -- name sets: - - -- | names in scope at Top level of module - nmsTopLevels :: Set.Set MN.Name - nmsTopLevels = MN.namingEnvNames envTopLevels - - -- | names defined in module and in submodules - -- - this includes `PublicAndPrivate` names! - -- - includes submodule names, type synonyms, and nominal types - nmsDefined :: Set.Set MN.Name - nmsDefined = - -- definitions from all submodules: - ( Set.unions - $ map (MI.ifsDefines . T.smIface) - $ Map.elems - $ T.mSubmodules - $ ME.lmModule lm - ) - `Set.union` - -- definitions at the top module: - (MI.ifsDefines $ MI.ifNames $ ME.lmInterface lm) - - - nmsPublic :: Set.Set MN.Name - nmsPublic = MI.ifsPublic $ MI.ifNames $ ME.lmInterface lm - - nmsPrivate :: Set.Set MN.Name - nmsPrivate = nmsDefined Set.\\ nmsTopLevels + -- NamingEnvs: -- + + -- | envTopLevels + -- - Does not include privates in submodules (which makes for + -- much of the complications of this function). + -- - Includes everything in scope at the toplevel of 'lm' module + envTopLevels :: MR.NamingEnv + envTopLevels = ME.lmNamingEnv lm + + -- | envPublicAndPrivate - awkward as envTopLevels excludes privates + envPublicAndPrivate :: MR.NamingEnv + envPublicAndPrivate = + -- nab all the names defined in module (from toplevel scope): + MN.filterUNames (`Set.member` nmsDefined) envTopLevels + <> + -- we must create a new NamingEnv (since the privates are not + -- in `envTopLevels`): + MN.namingEnvFromNames' MN.nameToPNameWithQualifiers nmsPrivate + + envPublic :: MR.NamingEnv + envPublic = MN.filterUNames + (`Set.member` nmsPublic) + envTopLevels + + -- Name Sets: -- + + -- | names in scope at Top level of module + nmsTopLevels :: Set.Set MN.Name + nmsTopLevels = MN.namingEnvNames envTopLevels + + -- | names defined in module and in submodules + -- - this includes `PublicAndPrivate` names! + -- - includes submodule names, type synonyms, and nominal types + nmsDefined :: Set.Set MN.Name + nmsDefined = + -- definitions from all submodules: + ( Set.unions + $ map (MI.ifsDefines . T.smIface) + $ Map.elems + $ T.mSubmodules + $ ME.lmModule lm + ) + `Set.union` + -- definitions at the top module: + (MI.ifsDefines $ MI.ifNames $ ME.lmInterface lm) + + + nmsPublic :: Set.Set MN.Name + nmsPublic = MI.ifsPublic $ MI.ifNames $ ME.lmInterface lm + + nmsPrivate :: Set.Set MN.Name + nmsPrivate = nmsDefined Set.\\ nmsTopLevels getAllIfaceDecls :: ME.ModuleEnv -> M.IfaceDecls @@ -546,9 +549,14 @@ loadExtCryptolModule :: loadExtCryptolModule sc env path = do (m, env') <- loadAndTranslateModule sc env (Left path) - let s = showCryptolModule (mkCryptolModule m env') - -- how to show, need to compute this here. - -- FIXME: this only shows public names, not internal. + let s = "Public interface:\n" ++ showCryptolModule (mkCryptolModule m env') + -- How to show, need to compute this here, because the show function + -- (of course) has no access to the state. + -- + -- FIXME: Since the complete public and private interface is + -- extractable, we should show the whole thing with public, + -- private, typesyns, constructors, submodules. + -- See Issue #2700 return (ECM_LoadedModule (locatedUnknown (T.mName m)) s, env') From 68b412d8fd229df04c7f088792b5a62da770a3ab Mon Sep 17 00:00:00 2001 From: Mark Tullsen Date: Sat, 11 Oct 2025 20:05:16 -0700 Subject: [PATCH 51/57] Tweak the tests (defined correctly, more comments, all passing). --- intTests/test_saw_submodule_access1/D.cry | 6 +++--- intTests/test_saw_submodule_access1/F.cry | 1 + .../UseFunctors.cry | 7 ++++++- .../test_UseFunctors.saw | 6 +++++- .../testDups.log.good | 2 +- .../testQualifiedImports.log.good | 20 +++++++++++++------ .../testQualifiedImports.saw | 6 +++--- 7 files changed, 33 insertions(+), 15 deletions(-) diff --git a/intTests/test_saw_submodule_access1/D.cry b/intTests/test_saw_submodule_access1/D.cry index 62fd960cb5..aa85138e01 100644 --- a/intTests/test_saw_submodule_access1/D.cry +++ b/intTests/test_saw_submodule_access1/D.cry @@ -2,18 +2,18 @@ module D where import B import C -d00 = 2000 + b + c +d00 = 2000 + b + c // 2000 + 12 + 102 = 2114 d01 = 5 + D2::d2 type DTySy = [32] submodule D2 where - d2 = d00 + 10000 + d2 = d00 + 10000 // 12114 type D2TySy = [32] submodule D3 where - d3 = d00 + d2 + 1 + d3 = d00 + d2 + 1 // 14229 type D3TySy = [32] diff --git a/intTests/test_saw_submodule_access1/F.cry b/intTests/test_saw_submodule_access1/F.cry index 7179bacdfb..2dce996f2a 100644 --- a/intTests/test_saw_submodule_access1/F.cry +++ b/intTests/test_saw_submodule_access1/F.cry @@ -3,6 +3,7 @@ import B import C import B as E1::E2 // N.B. +top0 = 2114 : [32] top1 = 1 + E1::E2::b // 1+12 = 13 top2 = 1 + D3::d3 // 1+15 = 16 top3 = 1 + D3::D4::d4 // 1+36 = 37 diff --git a/intTests/test_saw_submodule_access1/UseFunctors.cry b/intTests/test_saw_submodule_access1/UseFunctors.cry index e090fb0338..ff98b8b8c1 100644 --- a/intTests/test_saw_submodule_access1/UseFunctors.cry +++ b/intTests/test_saw_submodule_access1/UseFunctors.cry @@ -23,4 +23,9 @@ submodule I = submodule F where ex2 = I::f + 2 // This is OK because of implicit import of I -// ex3 = I::FM::z This is not OK, becase FM is not syntactically visible in I, so we can't add an implicit import \ No newline at end of file +// ex3 = I::FM::z This is not OK, becase FM is not syntactically visible in I, so we can't add an implicit import + + // interestingly enough we can accss {{I::FM::z}} at the CLI. + +// ex4 = F::FM::z This is not OK, becase we can't access a module with +// uninstantiated parameters. \ No newline at end of file diff --git a/intTests/test_saw_submodule_access1/test_UseFunctors.saw b/intTests/test_saw_submodule_access1/test_UseFunctors.saw index cc25631cee..a61f3c2ef5 100644 --- a/intTests/test_saw_submodule_access1/test_UseFunctors.saw +++ b/intTests/test_saw_submodule_access1/test_UseFunctors.saw @@ -3,8 +3,12 @@ import "UseFunctors.cry"; print (eval_int {{ex1}}); // should succeed. print (eval_int {{ex2}}); // should succeed. +print (eval_int {{ I::FM::z }}); + // should succeed, as things have been instantiated. + // interesting that I::FM::z is not legal inside the UseFunctors.cry module. + // confirming fails of things that shouldn't be in scope: -fails (do {return {{ I::FM::z }};}); +fails (do {return {{ F::FM::z }};}); // see comments in .cry file. print "done"; diff --git a/intTests/test_saw_submodule_access2/testDups.log.good b/intTests/test_saw_submodule_access2/testDups.log.good index 6628bfc616..fa9ee57dd0 100644 --- a/intTests/test_saw_submodule_access2/testDups.log.good +++ b/intTests/test_saw_submodule_access2/testDups.log.good @@ -9,6 +9,6 @@ Cryptol error: [error] at testDups.saw:7:33--7:36 Multiple definitions for symbol: d00 (at ../test_saw_submodule_access1/D.cry:5:1--5:4, D::d00) - (at ../test_saw_submodule_access1/F.cry:10:1--10:4, F::d00) + (at ../test_saw_submodule_access1/F.cry:12:1--12:4, F::d00) done diff --git a/intTests/test_saw_submodule_access2/testQualifiedImports.log.good b/intTests/test_saw_submodule_access2/testQualifiedImports.log.good index d149a6713b..87b1de181c 100644 --- a/intTests/test_saw_submodule_access2/testQualifiedImports.log.good +++ b/intTests/test_saw_submodule_access2/testQualifiedImports.log.good @@ -2,25 +2,33 @@ 2114 12114 14229 - 2 == Anticipated failure message == Stack trace: (builtin) in (callback) (builtin) in fails - testQualifiedImports.saw:13:1-13:30 (at top level) + testQualifiedImports.saw:12:1-12:34 (at top level) Cryptol error: -[error] at testQualifiedImports.saw:13:22--13:25 - Value not in scope: d00 +[error] at testQualifiedImports.saw:12:23--12:29 + Value not in scope: MyD::a == Anticipated failure message == Stack trace: (builtin) in (callback) (builtin) in fails - testQualifiedImports.saw:14:1-14:34 (at top level) + testQualifiedImports.saw:13:1-13:34 (at top level) Cryptol error: -[error] at testQualifiedImports.saw:14:22--14:29 +[error] at testQualifiedImports.saw:13:22--13:29 Value not in scope: MyD::d2 +== Anticipated failure message == +Stack trace: + (builtin) in (callback) + (builtin) in fails + testQualifiedImports.saw:14:1-14:42 (at top level) +Cryptol error: +[error] at testQualifiedImports.saw:14:22--14:37 + Value not in scope: MyD::D2::D3::d2 + == Anticipated failure message == Stack trace: (builtin) in (callback) diff --git a/intTests/test_saw_submodule_access2/testQualifiedImports.saw b/intTests/test_saw_submodule_access2/testQualifiedImports.saw index 4d40ff9fae..42872d2428 100644 --- a/intTests/test_saw_submodule_access2/testQualifiedImports.saw +++ b/intTests/test_saw_submodule_access2/testQualifiedImports.saw @@ -7,11 +7,11 @@ print (eval_int {{MyD::D2::d2}}); print (eval_int {{MyD::D2::D3::d3}}); // testing visible in MyD variables: -print (eval_int {{MyD::a}}); // confirming fails of things that shouldn't be in scope: -fails (do {return {{ d00 }};}); -fails (do {return {{ MyD::d2 }};}); +fails (do {return {{ MyD::a }};}); // in scope at top but not defd by D +fails (do {return {{ MyD::d2 }};}); // should be MyD::D2::d2 ! +fails (do {return {{ MyD::D2::D3::d2 }};}); // should be MyD::D2::d2 ! fails (do {return {{ NOTINSCOPEVar }};}); print "done"; From 5c331fae4b3a720045dcd720292a6ba8c815df63 Mon Sep 17 00:00:00 2001 From: Mark Tullsen Date: Sat, 11 Oct 2025 20:11:35 -0700 Subject: [PATCH 52/57] remove debugging code --- .../src/CryptolSAWCore/CryptolEnv.hs | 135 ------------------ 1 file changed, 135 deletions(-) diff --git a/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs b/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs index 1613c11883..805906e1f8 100644 --- a/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs +++ b/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs @@ -108,9 +108,6 @@ import CryptolSAWCore.TypedTerm import Cryptol.ModuleSystem.Env (ModContextParams(NoParams)) -- import SAWCentral.AST (Located(getVal, locatedPos), Import(..)) -debug :: Bool -debug = False - ---- Key Types ----------------------------------------------------------------- -- | Parse input, together with information about where it came from. @@ -752,12 +749,7 @@ loadAndTranslateModule sc env src = newCryEnv <- C.importTopLevelDeclGroups sc C.defaultPrimitiveOptions cEnv newDeclGroups return (C.envE newCryEnv) - when debug $ do - putStrLn "* LOG: loadAndTranslateModule:" - putStrLn $ show (ppListX "** LOG: newDeclGroups\n" newDeclGroups) - putStrLn $ show (ppListX "** LOG: newTermEnv\n" - ({- map MN.nameIdent $ -} Map.keys newTermEnv)) return ( m , env{ eModuleEnv = modEnv' , eTermEnv = newTermEnv @@ -765,10 +757,6 @@ loadAndTranslateModule sc env src = } ) -ppListX :: PP a => String -> [a] -> Doc -ppListX s xs = text s <+> ppList (map pp xs) - - checkNotParameterized :: T.Module -> IO () checkNotParameterized m = when (T.isParametrizedModule m) $ @@ -822,129 +810,6 @@ importCryptolModule sc env src as vis imps = do (mod', env') <- loadAndTranslateModule sc env src let import' = mkImport vis (locatedUnknown (T.mName mod')) as imps - - when debug $ - do - let lm = case ME.lookupModule (T.mName mod') (eModuleEnv env') of - Just lm' -> lm' - Nothing -> panic "importCryptolModule" [] - - modNamingEnv = ME.lmNamingEnv lm - - nmsPuPr1 :: Set.Set MN.Name - nmsPuPr1 = Map.keysSet $ MI.ifDecls $ MI.ifDefines $ ME.lmInterface lm - -- good: Correct for PublicAndPrivate [but only var-defs] - -- good: adds defs from submodules into scope, qualified - -- bad: no: types,enums,submodules - - nmsPuPr2 :: [MN.Name] - nmsPuPr2 = map MI.ifDeclName - $ Map.elems $ MI.ifDecls $ MI.ifDefines $ ME.lmInterface lm - -- Equiv to nmsPuPr1 - - nmsPuPr3 :: Set.Set MN.Name - nmsPuPr3 = MI.ifsDefines $ MI.ifNames $ ME.lmInterface lm - -- yes: includes types,enums,submodules - -- bad: doesn't "inline" submodule defs. - -- bad: doesn't include types,enums,submodules in 2nd level submodules - - nmsBetter = Set.union nmsPuPr1 nmsPuPr3 - - nmsPu :: Set.Set MN.Name - nmsPu = MI.ifsPublic $ MI.ifNames $ ME.lmInterface lm - -- Correct for PublicOnly - - nmsTopLevels :: Set.Set MN.Name - nmsTopLevels = MN.namingEnvNames modNamingEnv - - nmsPr :: Set.Set MN.Name - nmsPr = nmsPuPr1 Set.\\ nmsTopLevels - - envPriv = MN.namingEnvFromNames' MN.nameToPNameWithQualifiers nmsPr - - nmsNested :: Set.Set MN.Name - nmsNested = MI.ifsNested $ MI.ifNames $ ME.lmInterface lm - -- NOTE: only has the top submodule, not submodules inside that. - - nmsModules :: Set.Set MN.Name - nmsModules = Map.keysSet $ MI.ifModules $ MI.ifDefines $ ME.lmInterface lm - - - print $ text "* LOG: NEW: computeNamingEnv PublicAndPrivate:\n" - <> pp (computeNamingEnv lm PublicAndPrivate) - print $ text "* LOG: NEW: computeNamingEnv OnlyPublic:\n" - <> pp (computeNamingEnv lm OnlyPublic) - - let ppList' s ns = - do - print $ ppListX (unwords ["- LOG: ", s, " :\n"]) ns - putStrLn "" - - putStrLn "* LOG: BEGIN importCrytolModule:" - print $ text "* LOG: (namingEnvFromNames nmsPuPr1):\n" - <> pp (MN.namingEnvFromNames nmsPuPr1) - putStrLn "* LOG: various names:" - ppList' "nmsPuPr1" (Set.toList nmsPuPr1) - ppList' "nmsPuPr2" nmsPuPr2 - ppList' "nmsPuPr3" (Set.toList nmsPuPr3) - ppList' "nmsPu" (Set.toList nmsPu) - ppList' "nmsPr" (Set.toList nmsPr) - ppList' "nmsNested" (Set.toList nmsNested) - ppList' "nmsModules" (Set.toList nmsModules) - ppList' "nmsBetter" (Set.toList nmsBetter) - - - putStrLn "* LOG: print(nmsPuPr1):" - mapM_ (\n->print n >> putStrLn "") - (Set.toList nmsPuPr1) - - putStrLn $ "* LOG: (findAmbig modNamingEnv) = " - ++ show (MN.findAmbig modNamingEnv) - -- this should be [], then the following works: - - putStrLn "* LOG: submodules:" - flip mapM_ (Map.toList $ T.mSubmodules mod') $ \(nm,sm)-> - do - putStrLn ("** LOG: submodule: " ++ show (pp nm)) - -- putStrLn ("*** LOG: submodule names in scope:") - -- print $ pp (T.smInScope sm) - -- putStrLn "" - let modName :: C.ModName - modName = textToModName $ identText $ MN.nameIdent nm - modName2 :: MN.Name - modName2 = MI.ifsName $ T.smIface sm - putStrLn ("*** LOG: modName/2: ") - print modName - print modName2 - putStrLn "" - - ppList' "ifsDefines" - $ Set.toList $ MI.ifsDefines $ T.smIface sm - ppList' "ifsNested" - $ Set.toList $ MI.ifsNested $ T.smIface sm - putStrLn $ - "smInScope: " - ++ show (Map.size $ MN.namespaceMap C.NSValue (T.smInScope sm)) - putStrLn $ - "modNamingEnv: " - ++ show (Map.size $ MN.namespaceMap C.NSValue modNamingEnv) - - print $ text "* LOG: print modNamingEnv:\n" - flip mapM_ (Map.toList $ MN.namespaceMap C.NSValue modNamingEnv) $ - (\(k,v)-> do - print k - print v - putStrLn "") - - print $ text "* LOG: pp modNamingEnv:\n" - <> pp modNamingEnv - -- shows everything in scope at top level - - print $ text "* LOG: pp envPriv:\n" - <> pp envPriv - - putStrLn "* LOG: END importCrytolModule." - return $ env' {eImports= import' : eImports env } mkImport :: ImportVisibility From 0cc7170c49c9960949610bf0ef73ddaa69c9dcce Mon Sep 17 00:00:00 2001 From: Mark Tullsen Date: Sat, 11 Oct 2025 20:54:59 -0700 Subject: [PATCH 53/57] update doc/developer --- doc/developer/import-load-scope.org | 35 +++++------------------------ 1 file changed, 6 insertions(+), 29 deletions(-) diff --git a/doc/developer/import-load-scope.org b/doc/developer/import-load-scope.org index 7e861a2911..9ecccdc6a3 100644 --- a/doc/developer/import-load-scope.org +++ b/doc/developer/import-load-scope.org @@ -6,14 +6,14 @@ E.g., 2. SAWScript manual describing imports/loads 3. New Issue for further extending/simplifying import/load -** TODO Thinking re scope; terminology +** TODO Thoughts re scope; terminology - notions/terms - - scope :: the scope of variable (in terms of + - scope :: the scope of variable (in terms of a point in Cryptol source) - per four namespaces - what's in scope at a point in Cryptol module - point in SAWScript module - - ? :: the set of (qualified) names we add to scope with binders + - bindees :: the set of (qualified) names we add to scope with binders - let, bind, import, magic-Cryptolmodule-bind - context/? :: - ? the env at the top-level of a module @@ -133,9 +133,6 @@ We choose alternative C, design choice A. ** Current (branch) compared to previous behavior (on master) -- New :: we can access definitions in sub-modules, they are referenced - via =::= qualifiers, just as is done in Cryptol code. - - Changes :: =cryptol_load=: - *Previously* - given this @@ -166,30 +163,10 @@ We choose alternative C, design choice A. gratuitous differences. - OLD behavior - - import put privates in scope (as does new) + - import put privates in scope (as it does now) - private var in submodules: N/A - - [ ] confirm these: - - [ ] =cryptol_load= did not put top-level privates in scope (?) - - [ ] =cryptol_export= could not access privates (?) - -** Issues, 2025-10-06 - -- [ ] Assume we want to immediately update semantics of =cryptol_load= - (i.e., that we don't try to support old code that relies on old ad - hoc behavior) - - warn on let/bind shadowing would help for this (and other errors) - -- [ ] private's in submodules are inaccessible - - ditto with private submodules - - bug in code, privates at top-level are accessible - - wrongly using Cryptol code, and Cryptol code leaves these - inacessible! - - [ ] clarify what we *really* want before implementing - -- [ ] print CryptolModule with submodules - - currently only prints top publics, due to quick implementation - with existing code - - depends on fixing last, d + - =cryptol_load= did not put top-level privates in scope + - =cryptol_export= cannot not access privates ** Future From 0594a5006d57bec38e419d5f904ecb034b5576cd Mon Sep 17 00:00:00 2001 From: Mark Tullsen Date: Sat, 11 Oct 2025 20:55:41 -0700 Subject: [PATCH 54/57] Update CHANGES.md with doc for submodules and changed cryptol_load behavior. --- CHANGES.md | 31 +++++++++++++++++++++++++++++++ 1 file changed, 31 insertions(+) diff --git a/CHANGES.md b/CHANGES.md index 5c69c3a41f..64d00790cd 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -102,12 +102,43 @@ This release supports [version Accordingly, the second and third `String` arguments to `write_coq_cryptol_primitives_for_sawcore` have been removed. +* The behavior of `cryptol_load` has changed, previously when we had + this + + A <- cryptol_load "A1.cry" -- A1::** are added to {{A::**}} + A <- cryptol_load "A2.cry" -- A2::** are added to {{A::**}} + + the `A` in 2nd line would shadow the first `A`, and for each + symbol `s` from "A2.cry", that symbol may shadow any duplicate + symbol `s` from "A1.cry" and this would also leave symbols from + "A1.cry" in the Cryptol environment. + + The new behavior is that the same two commands now work + identically to the following + + import "A.cry" as A + import "A2.cry" as A + + and as a result + - no shadowing occurs + - importing ambiguous symbols is allowed + - referring to ambiguous (qualified) symbols is an error. + ## New Features * SAW has new commands `llvm_unint: [String] -> LLVMSetup ()` and and analogous commands for JVM and MIR, which can be used to declare that some Cryptol names should be kept opaque during symbolic simulation. +* When one does `import ...` and `cryptol_load` at the SAWScript CLI, + you can now access submodules in the loaded modules. Both these + will "import" submodules recursively and make no distinction between + normal and `private` variables. As a result, SAWScript code can + refer to *every* definition in the loaded module. + + You can reference public and private definitions in sub-modules via + `::` qualifiers, just as is done in Cryptol code. + * The Cryptol import syntax has been extended. - You can now import Cryptol module names, including qualified module names (which are resolved via the Cryptol load path) as well as From ecb16d95f29d40aabdf0d180c6b75f8bbcb30ac4 Mon Sep 17 00:00:00 2001 From: Mark Tullsen Date: Sat, 11 Oct 2025 21:07:49 -0700 Subject: [PATCH 55/57] remove doc file, moved to Issue #2701. --- doc/developer/import-load-scope.org | 177 ---------------------------- 1 file changed, 177 deletions(-) delete mode 100644 doc/developer/import-load-scope.org diff --git a/doc/developer/import-load-scope.org b/doc/developer/import-load-scope.org deleted file mode 100644 index 9ecccdc6a3..0000000000 --- a/doc/developer/import-load-scope.org +++ /dev/null @@ -1,177 +0,0 @@ -* Import, Load, and Scope -** NOTE META: this doc will eventually end up in multiple places - -E.g., - 1. Issue/PR descriptions - 2. SAWScript manual describing imports/loads - 3. New Issue for further extending/simplifying import/load - -** TODO Thoughts re scope; terminology - -- notions/terms - - scope :: the scope of variable (in terms of a point in Cryptol source) - - per four namespaces - - what's in scope at a point in Cryptol module - - point in SAWScript module - - bindees :: the set of (qualified) names we add to scope with binders - - let, bind, import, magic-Cryptolmodule-bind - - context/? :: - - ? the env at the top-level of a module - - ? : the env at a given point of a module - - in Cryptol, we can only *move* the focus (between modules and submodules). - -- standard scoping concepts in Cryptol - - the importer: gets names that a module exports. - -- non-standard scoping concepts in Cryptol - - submodules are special, reference to can be private/public - - if we have reference to a submodule, we can import it (in - Cryptol, in SAWScript) - -** Explaining scope in SAWScript - -Note that at the Cryptol command line, one cannot create an -environment that does not correspond to a point in the source code, -due to the command line only allowing one module (or submodule) to be -in focus. - -- Alternatives - - A. SAWScript works like Cryptol *command line*: - - one module/submodule is *the* focus (not two) - - B. SAWScript imports work exactly the same as in Cryptol *code* - - we have access to public submodules - - we can access *public* elements of these submodules with =::= - - we can extend the Env with =import submodule SM= - - just the public, cannot see private - - C. Like approach B., but the imports include the private vars - - the env added is - - the "top-level env" of the imported module - - thus top-level privates in =M= are added - - we can access *public* elements of these submodules with =::= - - DESIGN CHOICES - A. we work as if all the "private" annotations did not exist. - - for any any all imports, - - and future =import submodule= *NIY* - (this is not absolutely necessary as we can always access anything - with qualifiers). - B. we have some further granularity wrt exposing "private" - A. each import can choose Pub/All. - - =import submodule= does not have this choice - B. As A, but =import submodule= might have "PRIVATE TOO" - C. we have a different mechanism for referencing private vars - -SAWScript is different /by design/: - - Two values may not overlap in their scope at any one place in the - code. But we may want to use or relate these values together in - SAWScript. SAWScript allows use to do this /without/ having to - create an ad hoc Cryptol module for creating a scope where both - values are in scope. - - - Thus the simplicity of Cryptol's =:focus = is not desirable. - -We choose alternative C, design choice A. - -** Current (new branch) behavior - -- In SAWScript there are two ways to bring Cryptol modules into scope: - the =import= command and the =cryptol_load= command. - - - =import= - - works like an =import= inside a Cryptol program (and it shares - identical *?* syntax), except that all "private annotations" are - ignored. - - Note that it doesn't work identically to =:load= in Cryptol: - - where an environment is created that is identical to the - top-level environment in the loaded Cryptol module, thus - - private definitions (and submodules) at top-level are visible - - private definitions inside submodules are *not* visible, - unless we change to focus to that submodule with =:focus= - - is a SAWScript construct, not a CLI command - - the syntax is *TODO...* - - can only appear at the top-level - - as with Cryptol - - we can qualify multiple modules to the same name - - we can import duplicate [qualified] names without error (the error only - comes when we try to reference one of those names) - - - =cryptol_load= - : String -> TopLevel CryptolModule - - it parses, loads, and translates the file (as import does) - - it is a command, can *...* - - *UNLESS* you bind the value, this is effectively a NOP (except - for printing a summary display). - - - the magic occurs when you do this (at the top level) - : M <- cryptol_load "M.cry" - - - (If not done at the top level, results might be wrong or - unintuitive [?]: a little unclear as to what's happening - here.) - - - The magic occurs anytime you bind a value of type - =CryptolModule= at the top-level (with "<-" or "let") - - - useful for the (only) other way to create =CryptolModule=: - : cryptol_prims : () -> CryptolModule - - - This will - - bind "M" as a SAWScript value of type `CryptolModule` (of course) - - Extend the Cryptol environment with the given module - where the contents of the module are all qualified with "M". - - i.e., *TODO...* - - Using the =M : CryptolModule= SAWScript value - - you can view the public names of "M.cry" with print - (i.e., the default show function for `CryptolModule` - - you can `cryptol_extract` the definitions in it thus - : cryptol_extract M "d2" - - this works just as if one had written - : return {{M::d2}} - -** Current (branch) compared to previous behavior (on master) - -- Changes :: =cryptol_load=: - - *Previously* - - given this - : A <- cryptol_load "A.cry" -- A::** are added to {{A::**}} - : A <- cryptol_load "A2.cry" -- A2:** are added to {{A::**}} - - the `A` in 2nd line would shadow the first `A`. - - for each symbol 's' from A2.cry: - - 's' may shadow any duplicate symbol 's' from `A.cry` - - and it would also - - leave symbols from A.cry in the Cryptol environment, i.e., - {{A::*}}. - - *NOW*, - - given this - : A <- cryptol_load "A.cry" -- A::** are added to {{A::**}} - : A <- cryptol_load "A2.cry" -- A2:** are added to {{A::**}} - - works identical to - : import "A.cry" as A - : import "A2.cry" as A - - thus, - - no shadowing occurs - - importing ambiguous symbols is allowed - - referring to ambiguous (qualified) symbols is an error. - - : A <- cryptol_load "A2.cry" -- - - accessing =A= in SAWScript gives us "A2.cry" - -- Changes :: - - cryptol_export is defined in terms of ={{A::name}}=, thus no more - gratuitous differences. - -- OLD behavior - - import put privates in scope (as it does now) - - private var in submodules: N/A - - =cryptol_load= did not put top-level privates in scope - - =cryptol_export= cannot not access privates - -** Future - -- [ ] getting rid of the /magic-CryptolModule-bind/ -- [ ] doing import and being able to view! - : x <- qimport <...same as import> - : addtoscope x ... - From edd37dc388e376a0c5f31a2e2e7ddda7e484762d Mon Sep 17 00:00:00 2001 From: Mark Tullsen Date: Sat, 18 Oct 2025 21:12:19 -0700 Subject: [PATCH 56/57] refactors and add documentation based on code reviews by @RyanGIScott @sauclovian-g --- CHANGES.md | 2 +- .../src/CryptolSAWCore/CryptolEnv.hs | 89 +++++++++++++------ 2 files changed, 61 insertions(+), 30 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index 64d00790cd..5205d252f4 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -102,7 +102,7 @@ This release supports [version Accordingly, the second and third `String` arguments to `write_coq_cryptol_primitives_for_sawcore` have been removed. -* The behavior of `cryptol_load` has changed, previously when we had +* The behavior of `cryptol_load` has changed; previously when we had this A <- cryptol_load "A1.cry" -- A1::** are added to {{A::**}} diff --git a/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs b/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs index 805906e1f8..9f1244c727 100644 --- a/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs +++ b/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs @@ -7,9 +7,9 @@ Stability : provisional -} {-# LANGUAGE CPP #-} {-# LANGUAGE ImplicitParams #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE LambdaCase #-} module CryptolSAWCore.CryptolEnv ( ImportVisibility(..) @@ -331,7 +331,7 @@ getNamingEnvForImport modEnv (vis, imprt) = $ computeNamingEnv lm vis where - modName ::C.ModName + modName :: C.ModName modName = P.thing $ T.iModule imprt lm = case ME.lookupModule modName modEnv of @@ -501,18 +501,30 @@ combineCryptolEnv chkEnv newEnv = -- whether this module came directly from a constructed -- `CryptolModule` or whether it came from parsing a Cryptol module -- from filesystem (in which case it is loaded). +-- +-- data ExtCryptolModule = -- | source is parsed/loaded ECM_LoadedModule - { ecm_name :: P.Located C.ModName - , ecm_show :: String -- ^ how we show this on SAWScript CLI, - -- We can't look at state to compute show, - -- thus this (albeit adhoc). - } + (P.Located C.ModName) + String -- ^ how we show this on SAWScript CLI. -- | source is internal/constructed (e.g., via cryptol_prims) - | ECM_CryptolModule {ecm_cm :: CryptolModule} + | ECM_CryptolModule CryptolModule +-- | create the string needed for display in the CLI. +-- +-- - FIXME: This function, with the ECM_LoadedModule constructor, are +-- a bit ad hoc! Currently `ExtCrytpolModule` is exposed to the +-- CLI *and* requires a way to show this type to the user (as +-- implemented here) to support the user interface. As the state +-- isn't available when we want to display this value, we compute +-- the "display" String when we construct `ExtCryptolModule` values. +-- +-- The best solution is to implement Issue #2680 (Add `:cbrowse`) in +-- order to both improve the user interface and remove this awkward code. +-- Implementing #2680 will also address Issue #2700. +-- showExtCryptolModule :: ExtCryptolModule -> String showExtCryptolModule = \case @@ -607,15 +619,35 @@ mkCryptolModule m env = (eTermEnv env) ) --- | bindExtCryptolModule - ad hoc function/hook that allows for --- extending the Cryptol environment with the names in a Cryptol --- module, represented here by a `ExtCryptolModule`. +-- | bindExtCryptolModule - add extra bindings to the Cryptol +-- environment {{-}}, this happens when an `ExtCryptolModule` is +-- bound in the SAWScript code. (This may be referred to as a +-- "magic bind"). -- --- NOTE RE CALLS TO THIS: Three command line variants get us here: +-- NOTE RE CALLS TO THIS: Three SAWScript variants get us here: -- > D <- cryptol_load "PATH" +-- +-- which results in a call to `bindLoadedModule`. +-- And each of these +-- -- > x <- return (cryptol_prims ()) -- > let x = cryptol_prims () -- +-- will result in calling `bindCryptolModule`. +-- +-- NOTE: +-- - The `ExtCryptolModule` datatype and these functions are a bit +-- adhoc. +-- - Ideally thse would go away with further improvements to the +-- external interface and corresponding implementation changes. +-- - See #2569. +-- - Re `bindCryptolModule` below +-- - It is more general than what is needed. +-- - It is somewhat duplicating functionality that we already have with +-- `importCryptolModule`, this could go away in the future. +-- +-- - See also the discusion of `cryptol_load` in CHANGES.md. + bindExtCryptolModule :: (P.ModName, ExtCryptolModule) -> CryptolEnv -> CryptolEnv bindExtCryptolModule (modName, ecm) = @@ -623,21 +655,18 @@ bindExtCryptolModule (modName, ecm) = ECM_CryptolModule cm -> bindCryptolModule (modName, cm) ECM_LoadedModule nm _ -> bindLoadedModule (modName, nm) +-- | bindLoadedModule - when we have a `cryptol_load` created object, +-- add the module into the import list. bindLoadedModule :: (P.ModName, P.Located C.ModName) -> CryptolEnv -> CryptolEnv bindLoadedModule (asName, origName) env = - env{eImports= mkImport PublicAndPrivate origName (Just asName) Nothing - : eImports env + env{eImports = mkImport PublicAndPrivate origName (Just asName) Nothing + : eImports env } --- | bindCryptolModule - binding when we have the ECM_CryptolModule side. --- --- NOTE: --- - this code is duplicating functionality that we already have with --- `importCryptolModule`. We would like to have just one piece of --- code that computes the names (i.e., have just "one source of --- truth" here). --- +-- | bindCryptolModule - when we have a `cryptol_prims ()` created +-- object, add the `CryptolModule` to the relevant maps in the +-- `CryptolEnv` See `bindExtCryptolModule` above. bindCryptolModule :: (P.ModName, CryptolModule) -> CryptolEnv -> CryptolEnv bindCryptolModule (modName, CryptolModule sm tm) env = env { eExtraNames = flip (foldr addName) (Map.keys tm') $ @@ -817,13 +846,15 @@ mkImport :: ImportVisibility -> Maybe C.ModName -> Maybe T.ImportSpec -> (ImportVisibility, T.Import) -mkImport vis nm as imps = (vis, P.Import { T.iModule= nm - , T.iAs = as - , T.iSpec = imps - , T.iInst = Nothing - , T.iDoc = Nothing - } - ) +mkImport vis nm as imps = + let im = P.Import { T.iModule = nm + , T.iAs = as + , T.iSpec = imps + , T.iInst = Nothing + , T.iDoc = Nothing + } + in + (vis, im) ---- Binding ------------------------------------------------------------------- From 48dc42ab06746b70e4a65995f2eb3e75b7582356 Mon Sep 17 00:00:00 2001 From: Mark Tullsen Date: Sat, 18 Oct 2025 21:29:03 -0700 Subject: [PATCH 57/57] whitespace: follow existing whitespace/layout conventions more closely. --- .../src/CryptolSAWCore/CryptolEnv.hs | 30 +++++++++---------- 1 file changed, 15 insertions(+), 15 deletions(-) diff --git a/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs b/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs index 9f1244c727..dd8b9505d3 100644 --- a/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs +++ b/cryptol-saw-core/src/CryptolSAWCore/CryptolEnv.hs @@ -241,7 +241,7 @@ initCryptolEnv sc = do let refPrims = Map.fromList [ (prelPrim (identText (MN.nameIdent nm)), T.EWhere (T.EVar nm) refDecls) | nm <- nms ] - let cryEnv0 = C.emptyEnv{ C.envRefPrims = refPrims } + let cryEnv0 = C.emptyEnv { C.envRefPrims = refPrims } -- Generate SAWCore translations for all values in scope termEnv <- genTermEnv sc modEnv3 cryEnv0 @@ -479,10 +479,10 @@ translateDeclGroups sc env dgs = let names = map T.dName decls let newTypes = Map.fromList [ (T.dName d, T.dSignature d) | d <- decls ] let addName name = MR.shadowing (MN.singletonNS C.NSValue (P.mkUnqual (MN.nameIdent name)) name) - return env{ eExtraNames = foldr addName (eExtraNames env) names - , eExtraTypes = Map.union (eExtraTypes env) newTypes - , eTermEnv = C.envE cryEnv' - } + return env { eExtraNames = foldr addName (eExtraNames env) names + , eExtraTypes = Map.union (eExtraTypes env) newTypes + , eTermEnv = C.envE cryEnv' + } ---- Misc Exports -------------------------------------------------------------- @@ -490,8 +490,8 @@ combineCryptolEnv :: CryptolEnv -> CryptolEnv -> IO CryptolEnv combineCryptolEnv chkEnv newEnv = do let newMEnv = eModuleEnv newEnv let chkMEnv = eModuleEnv chkEnv - let menv' = chkMEnv{ ME.meNameSeeds = ME.meNameSeeds newMEnv } - return chkEnv{ eModuleEnv = menv' } + let menv' = chkMEnv { ME.meNameSeeds = ME.meNameSeeds newMEnv } + return chkEnv { eModuleEnv = menv' } ---- Types and functions for CryptolModule & ExtCryptolModule ------------------ @@ -660,9 +660,9 @@ bindExtCryptolModule (modName, ecm) = bindLoadedModule :: (P.ModName, P.Located C.ModName) -> CryptolEnv -> CryptolEnv bindLoadedModule (asName, origName) env = - env{eImports = mkImport PublicAndPrivate origName (Just asName) Nothing - : eImports env - } + env {eImports = mkImport PublicAndPrivate origName (Just asName) Nothing + : eImports env + } -- | bindCryptolModule - when we have a `cryptol_prims ()` created -- object, add the `CryptolModule` to the relevant maps in the @@ -780,10 +780,10 @@ loadAndTranslateModule sc env src = return (C.envE newCryEnv) return ( m - , env{ eModuleEnv = modEnv' - , eTermEnv = newTermEnv - , eFFITypes = updateFFITypes m newTermEnv (eFFITypes env) - } + , env { eModuleEnv = modEnv' + , eTermEnv = newTermEnv + , eFFITypes = updateFFITypes m newTermEnv (eFFITypes env) + } ) checkNotParameterized :: T.Module -> IO () @@ -839,7 +839,7 @@ importCryptolModule sc env src as vis imps = do (mod', env') <- loadAndTranslateModule sc env src let import' = mkImport vis (locatedUnknown (T.mName mod')) as imps - return $ env' {eImports= import' : eImports env } + return $ env' {eImports = import' : eImports env } mkImport :: ImportVisibility -> P.Located C.ModName