From 1f6f880318beaa83501bbacdaae178aed438cc4d Mon Sep 17 00:00:00 2001 From: Eric Mertens Date: Tue, 13 Aug 2024 13:23:00 -0500 Subject: [PATCH] Functor docstrings (#1726) * Fix docstring behaviors around functors - Don't duplicate docstrings onto modules generated by the desugarer - Combine docstrings when instantiating a functor to preserve both the instance and the instantiated documentation * Suppress :check-docstring output for definitions without fences --- src/Cryptol/ModuleSystem/Interface.hs | 4 +- src/Cryptol/Parser.y | 4 +- src/Cryptol/Parser/AST.hs | 5 ++- src/Cryptol/Parser/ParserUtils.hs | 53 +++++++++++++++---------- src/Cryptol/REPL/Command.hs | 23 ++++++----- src/Cryptol/REPL/Help.hs | 20 +++++----- src/Cryptol/TypeCheck/AST.hs | 42 +++++++++++++------- src/Cryptol/TypeCheck/Infer.hs | 8 ++-- src/Cryptol/TypeCheck/Module.hs | 14 +++++-- src/Cryptol/TypeCheck/ModuleInstance.hs | 2 +- src/Cryptol/TypeCheck/Monad.hs | 10 ++--- tests/docstrings/T01.icry.stdout | 8 +++- tests/docstrings/T02.icry.stdout | 19 +++------ tests/docstrings/T03.icry.stdout | 3 +- tests/docstrings/T04.icry.stdout | 3 +- tests/docstrings/T05.icry.stdout | 3 +- tests/docstrings/T06.icry.stdout | 17 +------- tests/docstrings/T07.icry.stdout | 3 +- tests/docstrings/T08.cry | 16 ++++++++ tests/docstrings/T08.icry | 2 + tests/docstrings/T08.icry.stdout | 14 +++++++ 21 files changed, 157 insertions(+), 116 deletions(-) create mode 100644 tests/docstrings/T08.cry create mode 100644 tests/docstrings/T08.icry create mode 100644 tests/docstrings/T08.icry.stdout diff --git a/src/Cryptol/ModuleSystem/Interface.hs b/src/Cryptol/ModuleSystem/Interface.hs index 92b65a6f0..1543099a6 100644 --- a/src/Cryptol/ModuleSystem/Interface.hs +++ b/src/Cryptol/ModuleSystem/Interface.hs @@ -77,7 +77,7 @@ data IfaceNames name = IfaceNames , ifsNested :: Set Name -- ^ Things nested in this module , ifsDefines :: Set Name -- ^ Things defined in this module , ifsPublic :: Set Name -- ^ Subset of `ifsDefines` that is public - , ifsDoc :: !(Maybe Text) -- ^ Documentation + , ifsDoc :: ![Text] -- ^ Documentation: more specific to least specific } deriving (Show, Generic, NFData, Functor) -- | Is this interface for a functor. @@ -90,7 +90,7 @@ emptyIface nm = Iface , ifsDefines = mempty , ifsPublic = mempty , ifsNested = mempty - , ifsDoc = Nothing + , ifsDoc = mempty } , ifParams = mempty , ifDefines = mempty diff --git a/src/Cryptol/Parser.y b/src/Cryptol/Parser.y index 3f3ea9534..8543b0a8c 100644 --- a/src/Cryptol/Parser.y +++ b/src/Cryptol/Parser.y @@ -296,8 +296,8 @@ vtop_decl :: { [TopDecl PName] } | private_decls { $1 } | mbDoc 'interface' 'constraint' type {% mkInterfaceConstraint $1 $4 } | parameter_decls { [ $1 ] } - | mbDoc 'submodule' - module_def {% ((:[]) . exportModule $1) `fmap` mkNested $3 } + | mbDoc 'submodule' module_def + {% ((:[]) . exportModule $1) `fmap` mkNested $3 } | mbDoc sig_def { [mkSigDecl $1 $2] } | mod_param_decl { [DModParam $1] } diff --git a/src/Cryptol/Parser/AST.hs b/src/Cryptol/Parser/AST.hs index 04f650671..67fa72ffa 100644 --- a/src/Cryptol/Parser/AST.hs +++ b/src/Cryptol/Parser/AST.hs @@ -169,7 +169,8 @@ data ModuleG mname name = Module -- Also, for the 'FunctorInstance' case this is not the final result of -- the names in scope. The typechecker adds in the names in scope in the -- functor, so this will just contain the names in the enclosing scope. - , mDoc :: Maybe (Located Text) + , mDocTop :: Maybe (Located Text) + -- ^ only used for top-level modules } deriving (Show, Generic, NFData) @@ -1455,7 +1456,7 @@ instance NoPos (ModuleG mname name) where noPos m = Module { mName = mName m , mDef = noPos (mDef m) , mInScope = mInScope m - , mDoc = noPos (mDoc m) + , mDocTop = noPos (mDocTop m) } instance NoPos (ModuleDefinition name) where diff --git a/src/Cryptol/Parser/ParserUtils.hs b/src/Cryptol/Parser/ParserUtils.hs index a22a25b2d..de989e330 100644 --- a/src/Cryptol/Parser/ParserUtils.hs +++ b/src/Cryptol/Parser/ParserUtils.hs @@ -1117,7 +1117,7 @@ mkModule :: Located ModName -> [TopDecl PName] -> Module PName mkModule nm ds = Module { mName = nm , mDef = NormalModule ds , mInScope = mempty - , mDoc = Nothing + , mDocTop = Nothing } mkNested :: Module PName -> ParseM (NestedModule PName) @@ -1139,7 +1139,7 @@ mkSigDecl doc (nm,sig) = Module { mName = nm , mDef = InterfaceModule sig , mInScope = mempty - , mDoc = Nothing + , mDocTop = Nothing } } @@ -1217,7 +1217,7 @@ mkModuleInstanceAnon nm fun ds = Module { mName = nm , mDef = FunctorInstance fun (DefaultInstAnonArg ds) mempty , mInScope = mempty - , mDoc = Nothing + , mDocTop = Nothing } mkModuleInstance :: @@ -1229,7 +1229,7 @@ mkModuleInstance m f as = Module { mName = m , mDef = FunctorInstance f as emptyModuleInstance , mInScope = mempty - , mDoc = Nothing + , mDocTop = Nothing } @@ -1360,14 +1360,16 @@ mkImport loc impName optInst mbAs mbImportSpec optImportWhere doc = mkTopMods :: Maybe (Located Text) -> Module PName -> ParseM [Module PName] -mkTopMods doc m = desugarMod m { mDoc = doc } +mkTopMods doc m = + do (m', ms) <- desugarMod m { mDocTop = doc } + pure (ms ++ [m']) mkTopSig :: Located ModName -> Signature PName -> [Module PName] mkTopSig nm sig = [ Module { mName = nm , mDef = InterfaceModule sig , mInScope = mempty - , mDoc = Nothing + , mDocTop = Nothing } ] @@ -1392,8 +1394,9 @@ instance MkAnon PName where . getIdent toImpName = ImpNested - -desugarMod :: MkAnon name => ModuleG name PName -> ParseM [ModuleG name PName] +-- | Desugar a module returning first the updated original module and a +-- list of any new modules generated by desugaring. +desugarMod :: MkAnon name => ModuleG name PName -> ParseM (ModuleG name PName, [ModuleG name PName]) desugarMod mo = case mDef mo of @@ -1411,16 +1414,20 @@ desugarMod mo = let i = mkAnon AnonArg (thing (mName mo)) nm = Located { srcRange = srcRange (mName mo), thing = i } as' = DefaultInstArg (ModuleArg . toImpName <$> nm) - pure [ Module - { mName = nm, mDef = NormalModule lds', mInScope = mempty, mDoc = mDoc mo } - , mo { mDef = FunctorInstance f as' mempty } - ] + pure ( mo { mDef = FunctorInstance f as' mempty } + , [ Module + { mName = nm + , mDef = NormalModule lds' + , mInScope = mempty + , mDocTop = Nothing + }] + ) NormalModule ds -> do (newMs, newDs) <- desugarTopDs (mName mo) ds - pure (newMs ++ [ mo { mDef = NormalModule newDs } ]) + pure (mo {mDef = NormalModule newDs }, newMs) - _ -> pure [mo] + _ -> pure (mo, []) desugarTopDs :: @@ -1463,7 +1470,7 @@ desugarTopDs ownerName = go emptySig pure ( [ Module { mName = nm , mDef = InterfaceModule sig , mInScope = mempty - , mDoc = Nothing + , mDocTop = Nothing } ] , [ DModParam @@ -1498,8 +1505,14 @@ desugarTopDs ownerName = go emptySig DParamDecl _ ds' -> cont [] (jnSig ds' sig) DModule tl | NestedModule mo <- tlValue tl -> - do ms <- desugarMod mo - cont [ DModule tl { tlValue = NestedModule m } | m <- ms ] sig + do (mo', ms) <- desugarMod mo + cont ([ DModule TopLevel + { tlExport = tlExport tl + , tlValue = NestedModule m + , tlDoc = Nothing -- generated modules have no docstrings + } + | m <- ms] ++ [DModule tl { tlValue = NestedModule mo' }]) + sig _ -> cont [d] sig @@ -1508,14 +1521,14 @@ desugarInstImport :: ModuleInstanceArgs PName {- ^ The insantiation -} -> ParseM [TopDecl PName] desugarInstImport i inst = - do ms <- desugarMod + do (m, ms) <- desugarMod Module { mName = i { thing = iname } , mDef = FunctorInstance (iModule <$> i) inst emptyModuleInstance , mInScope = mempty - , mDoc = Nothing + , mDocTop = Nothing } - pure (DImport (newImp <$> i) : map modTop ms) + pure (DImport (newImp <$> i) : map modTop (ms ++ [m])) where imp = thing i diff --git a/src/Cryptol/REPL/Command.hs b/src/Cryptol/REPL/Command.hs index a38b74976..6c4b0b179 100644 --- a/src/Cryptol/REPL/Command.hs +++ b/src/Cryptol/REPL/Command.hs @@ -2123,14 +2123,14 @@ interpretControls [] = [] -- | The result of running a docstring as attached to a definition data DocstringResult = DocstringResult - { drName :: P.ImpName T.Name -- ^ The associated definition of the docstring + { drName :: T.DocFor -- ^ The associated definition of the docstring , drFences :: [[SubcommandResult]] -- ^ list of fences in this definition's docstring } -- | Check all the code blocks in a given docstring. checkDocItem :: T.DocItem -> REPL DocstringResult checkDocItem item = - do xs <- case extractCodeBlocks (fromMaybe "" (T.docText item)) of + do xs <- case traverse extractCodeBlocks (T.docText item) of Left e -> do pure [[SubcommandResult { srInput = T.empty @@ -2142,7 +2142,7 @@ checkDocItem item = Ex.bracket (liftModuleCmd (`M.runModuleM` (M.getFocusedModule <* M.setFocusedModule (T.docModContext item)))) (\mb -> liftModuleCmd (`M.runModuleM` M.setMaybeFocusedModule mb)) - (\_ -> traverse checkBlock bs) + (\_ -> traverse checkBlock (concat bs)) pure DocstringResult { drName = T.docFor item , drFences = xs @@ -2210,14 +2210,15 @@ checkDocStringsCmd input let (successes, nofences, failures) = countOutcomes [concat (drFences r) | r <- results] forM_ results $ \dr -> - do rPutStrLn "" - rPutStrLn ("Checking " ++ show (pp (drName dr))) - forM_ (drFences dr) $ \fence -> - forM_ fence $ \line -> do - rPutStrLn "" - rPutStrLn (T.unpack (srInput line)) - rPutStr (srLog line) - + unless (null (drFences dr)) $ + do rPutStrLn "" + rPutStrLn ("\nChecking " ++ show (pp (drName dr))) + forM_ (drFences dr) $ \fence -> + forM_ fence $ \line -> do + rPutStrLn "" + rPutStrLn (T.unpack (srInput line)) + rPutStr (srLog line) + rPutStrLn "" rPutStrLn ("Successes: " ++ show successes ++ ", No fences: " ++ show nofences ++ ", Failures: " ++ show failures) diff --git a/src/Cryptol/REPL/Help.hs b/src/Cryptol/REPL/Help.hs index 1c2654f21..b9a5f8565 100644 --- a/src/Cryptol/REPL/Help.hs +++ b/src/Cryptol/REPL/Help.hs @@ -8,8 +8,9 @@ import qualified Data.Text as Text import Data.Map (Map) import qualified Data.Map as Map import qualified Data.Set as Set -import Data.Maybe(fromMaybe) +import Data.Maybe(fromMaybe, maybeToList) import Data.List(intersperse) +import Data.Foldable (for_) import Control.Monad(when,guard,unless,msum,mplus) import Cryptol.Utils.PP @@ -93,7 +94,7 @@ ifaceSummary env info = , addV <$> fromD , addM <$> msum [ fromM, fromS, fromF ] ] - where + where addT (k,d) = ns { msTypes = T.ModTParam { T.mtpName = x , T.mtpKind = k , T.mtpDoc = d @@ -124,7 +125,7 @@ ifaceSummary env info = pure (M.AFunctor, M.ifsDoc (M.ifNames def)) fromS = do def <- Map.lookup x (M.ifSignatures env) - pure (M.ASignature, T.mpnDoc def) + pure (M.ASignature, maybeToList (T.mpnDoc def)) @@ -144,7 +145,7 @@ showFunctorHelp _env _nameEnv name info = showSigHelp :: M.IfaceDecls -> NameDisp -> M.Name -> T.ModParamNames -> REPL () showSigHelp _env _nameEnv name info = - showSummary M.ASignature name (T.mpnDoc info) + showSummary M.ASignature name (maybeToList (T.mpnDoc info)) emptySummary { msTypes = Map.elems (T.mpnTypes info) , msVals = Map.elems (T.mpnFuns info) @@ -157,7 +158,7 @@ data ModSummary = ModSummary , msConstraints :: [T.Prop] , msTypes :: [T.ModTParam] , msVals :: [T.ModVParam] - , msMods :: [ (M.Name, M.ModKind, Maybe Text) ] + , msMods :: [ (M.Name, M.ModKind, [Text]) ] } emptySummary :: ModSummary @@ -169,7 +170,7 @@ emptySummary = ModSummary , msMods = [] } -showSummary :: M.ModKind -> M.Name -> Maybe Text -> ModSummary -> REPL () +showSummary :: M.ModKind -> M.Name -> [Text] -> ModSummary -> REPL () showSummary k name doc info = do rPutStrLn "" @@ -385,11 +386,10 @@ doShowParameterSource i = | otherwise = "Provided by `parameters` declaration." -doShowDocString :: Maybe Text -> REPL () +doShowDocString :: Foldable f => f Text -> REPL () doShowDocString doc = - case doc of - Nothing -> pure () - Just d -> rPutStrLn ('\n' : Text.unpack d) + for_ doc $ \d -> + rPutStrLn ('\n' : Text.unpack d) ppFixity :: T.Fixity -> String ppFixity f = "Precedence " ++ show (P.fLevel f) ++ ", " ++ diff --git a/src/Cryptol/TypeCheck/AST.hs b/src/Cryptol/TypeCheck/AST.hs index 128677e21..6b413d3d0 100644 --- a/src/Cryptol/TypeCheck/AST.hs +++ b/src/Cryptol/TypeCheck/AST.hs @@ -28,6 +28,7 @@ module Cryptol.TypeCheck.AST , Fixity(..) , PrimMap(..) , module Cryptol.TypeCheck.Type + , DocFor(..) ) where import Cryptol.Utils.Panic(panic) @@ -56,7 +57,7 @@ import Control.DeepSeq import qualified Data.IntMap as IntMap import Data.Map (Map) import qualified Data.Map as Map -import Data.Maybe (mapMaybe) +import Data.Maybe (mapMaybe, maybeToList) import Data.Set (Set) import Data.Text (Text) @@ -83,7 +84,7 @@ tcTopEntityToModule ent = -- | A Cryptol module. data ModuleG mname = Module { mName :: !mname - , mDoc :: !(Maybe Text) + , mDoc :: ![Text] , mExports :: ExportSpec Name -- Functors: @@ -125,7 +126,7 @@ emptyModule :: mname -> ModuleG mname emptyModule nm = Module { mName = nm - , mDoc = Nothing + , mDoc = mempty , mExports = mempty , mParams = mempty @@ -529,10 +530,21 @@ instance PP (WithNames TCTopEntity) where data DocItem = DocItem { docModContext :: ImpName Name -- ^ The module scope to run repl commands in - , docFor :: ImpName Name -- ^ The name the documentation is attached to - , docText :: Maybe Text -- ^ The text of the attached docstring, if any + , docFor :: DocFor -- ^ The name the documentation is attached to + , docText :: [Text] -- ^ The text of the attached docstring, if any } +data DocFor + = DocForMod (ImpName Name) + | DocForDef Name -- definitions that aren't modules + +instance PP DocFor where + ppPrec p x = + case x of + DocForMod m -> ppPrec p m + DocForDef n -> ppPrec p n + + gatherModuleDocstrings :: Map Name (ImpName Name) -> Module -> @@ -540,7 +552,7 @@ gatherModuleDocstrings :: gatherModuleDocstrings nameToModule m = [DocItem { docModContext = ImpTop (mName m) - , docFor = ImpTop (mName m) + , docFor = DocForMod (ImpTop (mName m)) , docText = mDoc m } ] ++ @@ -549,28 +561,28 @@ gatherModuleDocstrings nameToModule m = -- mParamFuns m [DocItem { docModContext = lookupModuleName n - , docFor = ImpNested n - , docText = tsDoc t + , docFor = DocForDef n + , docText = maybeToList (tsDoc t) } | (n, t) <- Map.assocs (mTySyns m)] ++ [DocItem { docModContext = lookupModuleName n - , docFor = ImpNested n - , docText = ntDoc t + , docFor = DocForDef n + , docText = maybeToList (ntDoc t) } | (n, t) <- Map.assocs (mNominalTypes m)] ++ [DocItem { docModContext = lookupModuleName (dName d) - , docFor = ImpNested (dName d) - , docText = dDoc d + , docFor = DocForDef (dName d) + , docText = maybeToList (dDoc d) } | g <- mDecls m, d <- groupDecls g] ++ [DocItem { docModContext = ImpNested n - , docFor = ImpNested n + , docFor = DocForMod (ImpNested n) , docText = ifsDoc (smIface s) } | (n, s) <- Map.assocs (mSubmodules m)] ++ [DocItem { docModContext = ImpTop (mName m) - , docFor = ImpNested n - , docText = mpnDoc s + , docFor = DocForMod (ImpNested n) + , docText = maybeToList (mpnDoc s) } | (n, s) <- Map.assocs (mSignatures m)] where lookupModuleName n = diff --git a/src/Cryptol/TypeCheck/Infer.hs b/src/Cryptol/TypeCheck/Infer.hs index 51f0d53ca..61dad6925 100644 --- a/src/Cryptol/TypeCheck/Infer.hs +++ b/src/Cryptol/TypeCheck/Infer.hs @@ -63,7 +63,7 @@ import Data.Map (Map) import qualified Data.Set as Set import Data.List(foldl', sortBy, groupBy, partition) import Data.Either(partitionEithers) -import Data.Maybe(isJust, fromMaybe, mapMaybe) +import Data.Maybe(isJust, fromMaybe, mapMaybe, maybeToList) import Data.Ratio(numerator,denominator) import Data.Traversable(forM) import Data.Function(on) @@ -77,14 +77,14 @@ inferTopModule :: P.Module Name -> InferM TCTopEntity inferTopModule m = case P.mDef m of P.NormalModule ds -> - do newModuleScope (thing <$> P.mDoc m) (thing (P.mName m)) (P.exportedDecls ds) (P.mInScope m) + do newModuleScope (maybeToList (thing <$> P.mDocTop m)) (thing (P.mName m)) (P.exportedDecls ds) (P.mInScope m) checkTopDecls ds proveModuleTopLevel endModule P.FunctorInstance f as inst -> do mb <- doFunctorInst - (P.ImpTop <$> P.mName m) f as inst (P.mInScope m) Nothing + (P.ImpTop <$> P.mName m) f as inst (P.mInScope m) (thing <$> P.mDocTop m) case mb of Just mo -> pure mo Nothing -> panic "inferModule" ["Didnt' get a module"] @@ -1487,7 +1487,7 @@ checkTopDecls = mapM_ checkTopDecl P.NormalModule ds -> do newSubmoduleScope (thing (P.mName m)) - (thing <$> P.tlDoc tl) + (maybeToList (thing <$> P.tlDoc tl)) (P.exportedDecls ds) (P.mInScope m) checkTopDecls ds diff --git a/src/Cryptol/TypeCheck/Module.hs b/src/Cryptol/TypeCheck/Module.hs index a5df03ee1..09179a255 100644 --- a/src/Cryptol/TypeCheck/Module.hs +++ b/src/Cryptol/TypeCheck/Module.hs @@ -4,6 +4,7 @@ module Cryptol.TypeCheck.Module (doFunctorInst) where import Data.List(partition,unzip4) import Data.Text(Text) import Data.Map(Map) +import Data.Maybe (maybeToList) import qualified Data.Map as Map import qualified Data.Map.Merge.Strict as Map import Data.Set (Set) @@ -42,7 +43,7 @@ doFunctorInst :: -} -> NamingEnv {- ^ Names in the enclosing scope of the instantiated module -} -> - Maybe Text {- ^ Documentation -} -> + Maybe Text {- ^ Documentation for the module being generated -} -> InferM (Maybe TCTopEntity) doFunctorInst m f as instMap0 enclosingInScope doc = inRange (srcRange m) @@ -57,7 +58,7 @@ doFunctorInst m f as instMap0 enclosingInScope doc = ?nameSu = instMap <> mconcat paramInstMaps let m1 = moduleInstance mf m2 = m1 { mName = m - , mDoc = Nothing + , mDoc = mempty , mParamTypes = mempty , mParamFuns = mempty , mParamConstraints = mempty @@ -98,9 +99,14 @@ doFunctorInst m f as instMap0 enclosingInScope doc = mconcat [ modParamNamingEnv mp | (_, mp, AddDeclParams) <- argIs ] inScope = inScope0 `shadowing` enclosingInScope + -- Combine the docstrings of: + -- * The functor being instantiated + -- * The module being generated + let newDoc = maybeToList doc <> mDoc mf + case thing m of - P.ImpTop mn -> newModuleScope (mDoc mf) mn (mExports m2) inScope - P.ImpNested mn -> newSubmoduleScope mn doc (mExports m2) inScope + P.ImpTop mn -> newModuleScope newDoc mn (mExports m2) inScope + P.ImpNested mn -> newSubmoduleScope mn newDoc (mExports m2) inScope mapM_ addTySyn (Map.elems (mTySyns m2)) mapM_ addNominal (Map.elems (mNominalTypes m2)) diff --git a/src/Cryptol/TypeCheck/ModuleInstance.hs b/src/Cryptol/TypeCheck/ModuleInstance.hs index 3b2dfac51..a261a0723 100644 --- a/src/Cryptol/TypeCheck/ModuleInstance.hs +++ b/src/Cryptol/TypeCheck/ModuleInstance.hs @@ -72,7 +72,7 @@ instance ModuleInstance Submodule where instance ModuleInstance (ModuleG name) where moduleInstance m = Module { mName = mName m - , mDoc = Nothing + , mDoc = mempty , mExports = doNameInst (mExports m) , mParamTypes = doMap (mParamTypes m) , mParamFuns = doMap (mParamFuns m) diff --git a/src/Cryptol/TypeCheck/Monad.hs b/src/Cryptol/TypeCheck/Monad.hs index a1b03cd04..b4cc02cb4 100644 --- a/src/Cryptol/TypeCheck/Monad.hs +++ b/src/Cryptol/TypeCheck/Monad.hs @@ -998,16 +998,16 @@ newTopSignatureScope x = newScope (TopSignatureScope x) to initialize an empty module. As we type check declarations they are added to this module's scope. -} newSubmoduleScope :: - Name -> Maybe Text -> ExportSpec Name -> NamingEnv -> InferM () + Name -> [Text] -> ExportSpec Name -> NamingEnv -> InferM () newSubmoduleScope x docs e inScope = do updScope \o -> o { mNested = Set.insert x (mNested o) } newScope (SubModule x) updScope \m -> m { mDoc = docs, mExports = e, mInScope = inScope } -newModuleScope :: Maybe Text -> P.ModName -> ExportSpec Name -> NamingEnv -> InferM () -newModuleScope doc x e inScope = +newModuleScope :: [Text] -> P.ModName -> ExportSpec Name -> NamingEnv -> InferM () +newModuleScope docs x e inScope = do newScope (MTopModule x) - updScope \m -> m { mDoc = doc, mExports = e, mInScope = inScope } + updScope \m -> m { mDoc = docs, mExports = e, mInScope = inScope } -- | Update the current scope (first in the list). Assumes there is one. updScope :: (ModuleG ScopeName -> ModuleG ScopeName) -> InferM () @@ -1135,7 +1135,7 @@ getCurDecls = mergeDecls m1 m2 = Module { mName = () - , mDoc = Nothing + , mDoc = mempty , mExports = mempty , mParams = mempty , mParamTypes = mempty diff --git a/tests/docstrings/T01.icry.stdout b/tests/docstrings/T01.icry.stdout index 709d49589..9897f35f2 100644 --- a/tests/docstrings/T01.icry.stdout +++ b/tests/docstrings/T01.icry.stdout @@ -2,25 +2,29 @@ Loading module Cryptol Loading module Cryptol Loading module T01 + Checking T01 pp False -Checking submodule T01::Sub::pp + +Checking T01::Sub::pp :check pp Using exhaustive testing. Testing... Passed 1 tests. Q.E.D. -Checking submodule T01::pp + +Checking T01::pp :check ~ pp Using exhaustive testing. Testing... Passed 1 tests. Q.E.D. + Checking submodule T01::Sub :exhaust pp && pp diff --git a/tests/docstrings/T02.icry.stdout b/tests/docstrings/T02.icry.stdout index 0e222f05d..91cd6c906 100644 --- a/tests/docstrings/T02.icry.stdout +++ b/tests/docstrings/T02.icry.stdout @@ -2,27 +2,24 @@ Loading module Cryptol Loading module Cryptol Loading module T02 -Checking T02 -Checking submodule T02::`where` argument of F7::n - -Checking submodule T02::F7::`parameter` interface of F::n - -Checking submodule T02::F7::c +Checking T02::F7::c :check c == 1 Using exhaustive testing. Testing... Passed 1 tests. Q.E.D. -Checking submodule T02::F7::p + +Checking T02::F7::p :exhaust p Using exhaustive testing. Testing... Passed 7 tests. Q.E.D. -Checking submodule T02::f + +Checking T02::f let y = 20 @@ -31,10 +28,4 @@ Using exhaustive testing. Testing... Passed 1 tests. Q.E.D. -Checking submodule T02::`where` argument of F7 - -Checking submodule T02::F7 - -Checking submodule T02::`parameter` interface of F - Successes: 4, No fences: 6, Failures: 0 diff --git a/tests/docstrings/T03.icry.stdout b/tests/docstrings/T03.icry.stdout index 703fd8356..a43d88d5f 100644 --- a/tests/docstrings/T03.icry.stdout +++ b/tests/docstrings/T03.icry.stdout @@ -2,9 +2,8 @@ Loading module Cryptol Loading module Cryptol Loading module T03 -Checking T03 -Checking submodule T03::a +Checking T03::a let x = 1 diff --git a/tests/docstrings/T04.icry.stdout b/tests/docstrings/T04.icry.stdout index 549c29fd7..7d92ab3dd 100644 --- a/tests/docstrings/T04.icry.stdout +++ b/tests/docstrings/T04.icry.stdout @@ -2,9 +2,8 @@ Loading module Cryptol Loading module Cryptol Loading module T03 -Checking T03 -Checking submodule T03::a +Checking T03::a :load AFile.cry Unknown command diff --git a/tests/docstrings/T05.icry.stdout b/tests/docstrings/T05.icry.stdout index e818263e6..34678b260 100644 --- a/tests/docstrings/T05.icry.stdout +++ b/tests/docstrings/T05.icry.stdout @@ -2,9 +2,8 @@ Loading module Cryptol Loading module Cryptol Loading module T05 -Checking T05 -Checking submodule T05::p +Checking T05::p :exhaust p Using exhaustive testing. diff --git a/tests/docstrings/T06.icry.stdout b/tests/docstrings/T06.icry.stdout index 1960fdf59..e4971f4ff 100644 --- a/tests/docstrings/T06.icry.stdout +++ b/tests/docstrings/T06.icry.stdout @@ -2,24 +2,9 @@ Loading module Cryptol Loading module Cryptol Loading module T06 -Checking T06 -Checking submodule T06::N1::N - -Checking submodule T06::A::I::N - -Checking submodule T06::A::I::N - -Checking submodule T06::A::C_::lost +Checking T06::A::C_::lost let x = lost -Checking submodule T06::N1 - -Checking submodule T06::A - -Checking submodule T06::A::C_ - -Checking submodule T06::I - Successes: 1, No fences: 8, Failures: 0 diff --git a/tests/docstrings/T07.icry.stdout b/tests/docstrings/T07.icry.stdout index 9eee9e29c..4dfac3fbe 100644 --- a/tests/docstrings/T07.icry.stdout +++ b/tests/docstrings/T07.icry.stdout @@ -5,11 +5,10 @@ Loading interface module `parameter` interface of T07F Loading module T07F Loading module T07 + Checking T07 42 : [N] 0x2a -Checking submodule T07::`parameter` interface of T07F::N - Successes: 1, No fences: 1, Failures: 0 diff --git a/tests/docstrings/T08.cry b/tests/docstrings/T08.cry new file mode 100644 index 000000000..d093be8ab --- /dev/null +++ b/tests/docstrings/T08.cry @@ -0,0 +1,16 @@ +/** A functor that works for all 8-bit numbers + +``` +"F" +``` +*/ +submodule F where + parameter n: [8] + +/** An instance of F where n is 2 + +``` +"M" +``` +*/ +submodule M = submodule F where n = 2 diff --git a/tests/docstrings/T08.icry b/tests/docstrings/T08.icry new file mode 100644 index 000000000..e355f525f --- /dev/null +++ b/tests/docstrings/T08.icry @@ -0,0 +1,2 @@ +:m T08 +:check-docstrings diff --git a/tests/docstrings/T08.icry.stdout b/tests/docstrings/T08.icry.stdout new file mode 100644 index 000000000..955543b4f --- /dev/null +++ b/tests/docstrings/T08.icry.stdout @@ -0,0 +1,14 @@ +Loading module Cryptol +Loading module Cryptol +Loading module Main + + +Checking submodule Main::M + +"M" +[0x4d] + +"F" +[0x46] + +Successes: 2, No fences: 5, Failures: 0