From db1eff6e6f8a38f377fbd1b7bb23694474e5e87c Mon Sep 17 00:00:00 2001 From: Brian Huffman Date: Fri, 11 Sep 2020 12:37:01 -0700 Subject: [PATCH 1/2] Factor out local function `doShowDocString`. --- src/Cryptol/REPL/Command.hs | 22 ++++++++-------------- 1 file changed, 8 insertions(+), 14 deletions(-) diff --git a/src/Cryptol/REPL/Command.hs b/src/Cryptol/REPL/Command.hs index 1696bd50e..007f79c7d 100644 --- a/src/Cryptol/REPL/Command.hs +++ b/src/Cryptol/REPL/Command.hs @@ -1386,11 +1386,7 @@ helpCmd cmd "requires:" $$ nest 2 (vcat rs) doShowFix (T.atFixitiy a) - - case T.atDoc a of - Nothing -> pure () - Just d -> do rPutStrLn "" - rPutStrLn d + doShowDocString (T.atDoc a) fromTyParam = do p <- Map.lookup name (M.ifParamTypes params) @@ -1408,9 +1404,7 @@ helpCmd cmd doShowTyHelp nameEnv decl doc = do rPutStrLn "" rPrint (runDoc nameEnv (nest 4 decl)) - case doc of - Nothing -> return () - Just d -> rPutStrLn "" >> rPutStrLn d + doShowDocString doc doShowFix fx = case fx of @@ -1447,9 +1441,7 @@ helpCmd cmd doShowFix $ ifDeclFixity `mplus` (guard ifDeclInfix >> return P.defaultFixity) - case ifDeclDoc of - Just str -> rPutStrLn ('\n' : str) - Nothing -> return () + doShowDocString ifDeclDoc fromNewtype = do _ <- Map.lookup name (M.ifNewtypes env) @@ -1466,10 +1458,12 @@ helpCmd cmd <+> pp (T.mvpType p) doShowFix (T.mvpFixity p) + doShowDocString (T.mvpDoc p) - case T.mvpDoc p of - Just str -> rPutStrLn ('\n' : str) - Nothing -> return () + doShowDocString doc = + case doc of + Nothing -> pure () + Just d -> rPutStrLn ('\n' : d) showCmdHelp c [arg] | ":set" `elem` cNames c = showOptionHelp arg showCmdHelp c _args = From f6be4c52050ad99d381ce849f88e7129043fe43c Mon Sep 17 00:00:00 2001 From: Brian Huffman Date: Fri, 11 Sep 2020 12:41:45 -0700 Subject: [PATCH 2/2] Use `Text` instead of `String` to represent docstrings. --- src/Cryptol/ModuleSystem/Interface.hs | 3 ++- src/Cryptol/Parser.y | 4 ++-- src/Cryptol/Parser/AST.hs | 9 +++++---- src/Cryptol/Parser/NoPat.hs | 7 ++++--- src/Cryptol/Parser/ParserUtils.hs | 17 ++++++++--------- src/Cryptol/REPL/Command.hs | 2 +- src/Cryptol/TypeCheck/AST.hs | 7 ++++--- src/Cryptol/TypeCheck/Depends.hs | 13 +++++++------ src/Cryptol/TypeCheck/Kind.hs | 11 ++++++----- src/Cryptol/TypeCheck/Type.hs | 7 ++++--- 10 files changed, 43 insertions(+), 37 deletions(-) diff --git a/src/Cryptol/ModuleSystem/Interface.hs b/src/Cryptol/ModuleSystem/Interface.hs index 82ae29b56..2e2d084ea 100644 --- a/src/Cryptol/ModuleSystem/Interface.hs +++ b/src/Cryptol/ModuleSystem/Interface.hs @@ -32,6 +32,7 @@ import Cryptol.Parser.Position(Located) import qualified Data.Map as Map import Data.Semigroup +import Data.Text (Text) import GHC.Generics (Generic) import Control.DeepSeq @@ -100,7 +101,7 @@ data IfaceDecl = IfaceDecl , ifDeclPragmas :: [Pragma] -- ^ Pragmas , ifDeclInfix :: Bool -- ^ Is this an infix thing , ifDeclFixity :: Maybe Fixity -- ^ Fixity information - , ifDeclDoc :: Maybe String -- ^ Documentation + , ifDeclDoc :: Maybe Text -- ^ Documentation } deriving (Show, Generic, NFData) mkIfaceDecl :: Decl -> IfaceDecl diff --git a/src/Cryptol/Parser.y b/src/Cryptol/Parser.y index f483045c4..0f1bbf736 100644 --- a/src/Cryptol/Parser.y +++ b/src/Cryptol/Parser.y @@ -271,10 +271,10 @@ par_decl :: { TopDecl PName } (mkProp $4) } -doc :: { Located String } +doc :: { Located Text } : DOC { mkDoc (fmap tokenText $1) } -mbDoc :: { Maybe (Located String) } +mbDoc :: { Maybe (Located Text) } : doc { Just $1 } | {- empty -} { Nothing } diff --git a/src/Cryptol/Parser/AST.hs b/src/Cryptol/Parser/AST.hs index 45c3a5d64..f304a56b0 100644 --- a/src/Cryptol/Parser/AST.hs +++ b/src/Cryptol/Parser/AST.hs @@ -90,6 +90,7 @@ import Data.List(intersperse) import Data.Bits(shiftR) import Data.Maybe (catMaybes) import Data.Ratio(numerator,denominator) +import Data.Text (Text) import Numeric(showIntAtBase,showFloat,showHFloat) import GHC.Generics (Generic) @@ -160,7 +161,7 @@ data Decl name = DSignature [Located name] (Schema name) data ParameterType name = ParameterType { ptName :: Located name -- ^ name of type parameter , ptKind :: Kind -- ^ kind of parameter - , ptDoc :: Maybe String -- ^ optional documentation + , ptDoc :: Maybe Text -- ^ optional documentation , ptFixity :: Maybe Fixity -- ^ info for infix use , ptNumber :: !Int -- ^ number of the parameter } deriving (Eq,Show,Generic,NFData) @@ -169,7 +170,7 @@ data ParameterType name = ParameterType data ParameterFun name = ParameterFun { pfName :: Located name -- ^ name of value parameter , pfSchema :: Schema name -- ^ schema for parameter - , pfDoc :: Maybe String -- ^ optional documentation + , pfDoc :: Maybe Text -- ^ optional documentation , pfFixity :: Maybe Fixity -- ^ info for infix use } deriving (Eq,Show,Generic,NFData) @@ -230,7 +231,7 @@ data Bind name = Bind , bFixity :: Maybe Fixity -- ^ Optional fixity info , bPragmas :: [Pragma] -- ^ Optional pragmas , bMono :: Bool -- ^ Is this a monomorphic binding - , bDoc :: Maybe String -- ^ Optional doc string + , bDoc :: Maybe Text -- ^ Optional doc string } deriving (Eq, Generic, NFData, Functor, Show) type LBindDef = Located (BindDef PName) @@ -270,7 +271,7 @@ data ExportType = Public -- | A top-level module declaration. data TopLevel a = TopLevel { tlExport :: ExportType - , tlDoc :: Maybe (Located String) + , tlDoc :: Maybe (Located Text) , tlValue :: a } deriving (Show, Generic, NFData, Functor, Foldable, Traversable) diff --git a/src/Cryptol/Parser/NoPat.hs b/src/Cryptol/Parser/NoPat.hs index 4ac17a4c5..21fc51265 100644 --- a/src/Cryptol/Parser/NoPat.hs +++ b/src/Cryptol/Parser/NoPat.hs @@ -29,6 +29,7 @@ import Cryptol.Utils.RecordMap import MonadLib hiding (mapM) import Data.Maybe(maybeToList) import qualified Data.Map as Map +import Data.Text (Text) import GHC.Generics (Generic) import Control.DeepSeq @@ -323,7 +324,7 @@ data AnnotMap = AnnotMap , annSigs :: Map.Map PName [Located (Schema PName)] , annValueFs :: Map.Map PName [Located Fixity ] , annTypeFs :: Map.Map PName [Located Fixity ] - , annDocs :: Map.Map PName [Located String ] + , annDocs :: Map.Map PName [Located Text ] } type Annotates a = a -> StateT AnnotMap NoPatM a @@ -477,7 +478,7 @@ checkFixs f fs@(x:_) = do recordError $ MultipleFixities f $ map srcRange fs return (Just (thing x)) -checkDocs :: PName -> [Located String] -> NoPatM (Maybe String) +checkDocs :: PName -> [Located Text] -> NoPatM (Maybe Text) checkDocs _ [] = return Nothing checkDocs _ [d] = return (Just (thing d)) checkDocs f ds@(d:_) = do recordError $ MultipleDocs f (map srcRange ds) @@ -502,7 +503,7 @@ toFixity (DFixity f ns) = [ (thing n, [Located (srcRange n) f]) | n <- ns ] toFixity _ = [] -- | Does this top-level declaration provide a documentation string? -toDocs :: TopLevel (Decl PName) -> [(PName, [Located String])] +toDocs :: TopLevel (Decl PName) -> [(PName, [Located Text])] toDocs TopLevel { .. } | Just txt <- tlDoc = go txt tlValue | otherwise = [] diff --git a/src/Cryptol/Parser/ParserUtils.hs b/src/Cryptol/Parser/ParserUtils.hs index 1a8668610..a34a39074 100644 --- a/src/Cryptol/Parser/ParserUtils.hs +++ b/src/Cryptol/Parser/ParserUtils.hs @@ -360,18 +360,18 @@ anonTyApp ~(Just r) ts = TTyApp (map toField ts) where noName = Located { srcRange = r, thing = mkIdent (T.pack "") } toField t = Named { name = noName, value = t } -exportDecl :: Maybe (Located String) -> ExportType -> Decl PName -> TopDecl PName +exportDecl :: Maybe (Located Text) -> ExportType -> Decl PName -> TopDecl PName exportDecl mbDoc e d = Decl TopLevel { tlExport = e , tlDoc = mbDoc , tlValue = d } -exportNewtype :: ExportType -> Maybe (Located String) -> Newtype PName -> +exportNewtype :: ExportType -> Maybe (Located Text) -> Newtype PName -> TopDecl PName exportNewtype e d n = TDNewtype TopLevel { tlExport = e , tlDoc = d , tlValue = n } -mkParFun :: Maybe (Located String) -> +mkParFun :: Maybe (Located Text) -> Located PName -> Schema PName -> TopDecl PName @@ -381,7 +381,7 @@ mkParFun mbDoc n s = DParameterFun ParameterFun { pfName = n , pfFixity = Nothing } -mkParType :: Maybe (Located String) -> +mkParType :: Maybe (Located Text) -> Located PName -> Located Kind -> ParseM (TopDecl PName) @@ -515,7 +515,7 @@ mkIf ifThens theElse = foldr addIfThen theElse ifThens -- instead of just place it on the binding directly. A better solution might be -- to just have a different constructor for primitives. mkPrimDecl :: - Maybe (Located String) -> LPName -> Schema PName -> [TopDecl PName] + Maybe (Located Text) -> LPName -> Schema PName -> [TopDecl PName] mkPrimDecl mbDoc ln sig = [ exportDecl mbDoc Public $ DBind Bind { bName = ln @@ -533,7 +533,7 @@ mkPrimDecl mbDoc ln sig = ] mkPrimTypeDecl :: - Maybe (Located String) -> + Maybe (Located Text) -> Schema PName -> Located Kind -> ParseM [TopDecl PName] @@ -601,12 +601,11 @@ mkPrimTypeDecl mbDoc (Forall as qs st ~(Just schema_rng)) finK = -- | Fix-up the documentation strings by removing the comment delimiters on each -- end, and stripping out common prefixes on all the remaining lines. -mkDoc :: Located Text -> Located String +mkDoc :: Located Text -> Located Text mkDoc ltxt = ltxt { thing = docStr } where - docStr = unlines - $ map T.unpack + docStr = T.unlines $ dropPrefix $ trimFront $ T.lines diff --git a/src/Cryptol/REPL/Command.hs b/src/Cryptol/REPL/Command.hs index 007f79c7d..51f764e76 100644 --- a/src/Cryptol/REPL/Command.hs +++ b/src/Cryptol/REPL/Command.hs @@ -1463,7 +1463,7 @@ helpCmd cmd doShowDocString doc = case doc of Nothing -> pure () - Just d -> rPutStrLn ('\n' : d) + Just d -> rPutStrLn ('\n' : T.unpack d) showCmdHelp c [arg] | ":set" `elem` cNames c = showOptionHelp arg showCmdHelp c _args = diff --git a/src/Cryptol/TypeCheck/AST.hs b/src/Cryptol/TypeCheck/AST.hs index 0435dea28..b197ae593 100644 --- a/src/Cryptol/TypeCheck/AST.hs +++ b/src/Cryptol/TypeCheck/AST.hs @@ -47,6 +47,7 @@ import Control.DeepSeq import Data.Map (Map) import qualified Data.Map as Map import qualified Data.IntMap as IntMap +import Data.Text (Text) -- | A Cryptol module. @@ -80,7 +81,7 @@ data ModTParam = ModTParam -- This is used when we move parameters from the module -- level to individual declarations -- (type synonyms in particular) - , mtpDoc :: Maybe String + , mtpDoc :: Maybe Text } deriving (Show,Generic,NFData) mtpParam :: ModTParam -> TParam @@ -97,7 +98,7 @@ mtpParam mtp = TParam { tpUnique = nameUnique (mtpName mtp) data ModVParam = ModVParam { mvpName :: Name , mvpType :: Schema - , mvpDoc :: Maybe String + , mvpDoc :: Maybe Text , mvpFixity :: Maybe Fixity } deriving (Show,Generic,NFData) @@ -168,7 +169,7 @@ data Decl = Decl { dName :: !Name , dPragmas :: [Pragma] , dInfix :: !Bool , dFixity :: Maybe Fixity - , dDoc :: Maybe String + , dDoc :: Maybe Text } deriving (Generic, NFData, Show) data DeclDef = DPrim diff --git a/src/Cryptol/TypeCheck/Depends.hs b/src/Cryptol/TypeCheck/Depends.hs index 0d345ae30..1f04ec7cf 100644 --- a/src/Cryptol/TypeCheck/Depends.hs +++ b/src/Cryptol/TypeCheck/Depends.hs @@ -27,16 +27,17 @@ import Data.Graph (SCC(..)) import Data.Map (Map) import qualified Data.Map as Map import qualified Data.Set as Set +import Data.Text (Text) data TyDecl = - TS (P.TySyn Name) (Maybe String) -- ^ Type synonym - | NT (P.Newtype Name) (Maybe String) -- ^ Newtype - | AT (P.ParameterType Name) (Maybe String) -- ^ Parameter type - | PS (P.PropSyn Name) (Maybe String) -- ^ Property synonym - | PT (P.PrimType Name) (Maybe String) -- ^ A primitive/abstract typee + TS (P.TySyn Name) (Maybe Text) -- ^ Type synonym + | NT (P.Newtype Name) (Maybe Text) -- ^ Newtype + | AT (P.ParameterType Name) (Maybe Text) -- ^ Parameter type + | PS (P.PropSyn Name) (Maybe Text) -- ^ Property synonym + | PT (P.PrimType Name) (Maybe Text) -- ^ A primitive/abstract typee deriving Show -setDocString :: Maybe String -> TyDecl -> TyDecl +setDocString :: Maybe Text -> TyDecl -> TyDecl setDocString x d = case d of TS a _ -> TS a x diff --git a/src/Cryptol/TypeCheck/Kind.hs b/src/Cryptol/TypeCheck/Kind.hs index 4c37b60b6..ec27a1500 100644 --- a/src/Cryptol/TypeCheck/Kind.hs +++ b/src/Cryptol/TypeCheck/Kind.hs @@ -36,6 +36,7 @@ import qualified Data.Map as Map import Data.List(sortBy,groupBy) import Data.Maybe(fromMaybe) import Data.Function(on) +import Data.Text (Text) import Control.Monad(unless,forM,when) @@ -66,7 +67,7 @@ checkSchema withWild (P.Forall xs ps t mb) = -- | Check a module parameter declarations. Nothing much to check, -- we just translate from one syntax to another. -checkParameterType :: P.ParameterType Name -> Maybe String -> InferM ModTParam +checkParameterType :: P.ParameterType Name -> Maybe Text -> InferM ModTParam checkParameterType a mbDoc = do let k = cvtK (P.ptKind a) n = thing (P.ptName a) @@ -75,7 +76,7 @@ checkParameterType a mbDoc = -- | Check a type-synonym declaration. -checkTySyn :: P.TySyn Name -> Maybe String -> InferM TySyn +checkTySyn :: P.TySyn Name -> Maybe Text -> InferM TySyn checkTySyn (P.TySyn x _ as t) mbD = do ((as1,t1),gs) <- collectGoals $ inRange (srcRange x) @@ -91,7 +92,7 @@ checkTySyn (P.TySyn x _ as t) mbD = } -- | Check a constraint-synonym declaration. -checkPropSyn :: P.PropSyn Name -> Maybe String -> InferM TySyn +checkPropSyn :: P.PropSyn Name -> Maybe Text -> InferM TySyn checkPropSyn (P.PropSyn x _ as ps) mbD = do ((as1,t1),gs) <- collectGoals $ inRange (srcRange x) @@ -108,7 +109,7 @@ checkPropSyn (P.PropSyn x _ as ps) mbD = -- | Check a newtype declaration. -- XXX: Do something with constraints. -checkNewtype :: P.Newtype Name -> Maybe String -> InferM Newtype +checkNewtype :: P.Newtype Name -> Maybe Text -> InferM Newtype checkNewtype (P.Newtype x as fs) mbD = do ((as1,fs1),gs) <- collectGoals $ inRange (srcRange x) $ @@ -128,7 +129,7 @@ checkNewtype (P.Newtype x as fs) mbD = , ntDoc = mbD } -checkPrimType :: P.PrimType Name -> Maybe String -> InferM AbstractType +checkPrimType :: P.PrimType Name -> Maybe Text -> InferM AbstractType checkPrimType p mbD = do let (as,cs) = P.primTCts p (as',cs') <- withTParams NoWildCards (TPOther . Just) as $ diff --git a/src/Cryptol/TypeCheck/Type.hs b/src/Cryptol/TypeCheck/Type.hs index 73835d483..81527ffbe 100644 --- a/src/Cryptol/TypeCheck/Type.hs +++ b/src/Cryptol/TypeCheck/Type.hs @@ -15,6 +15,7 @@ import qualified Data.IntMap as IntMap import Data.Maybe (fromMaybe) import Data.Set (Set) import qualified Data.Set as Set +import Data.Text (Text) import Cryptol.Parser.Selector import Cryptol.Parser.Position(Range,emptyRange) @@ -169,7 +170,7 @@ data TySyn = TySyn { tsName :: Name -- ^ Name , tsParams :: [TParam] -- ^ Parameters , tsConstraints :: [Prop] -- ^ Ensure body is OK , tsDef :: Type -- ^ Definition - , tsDoc :: !(Maybe String) -- ^ Documentation + , tsDoc :: !(Maybe Text) -- ^ Documentation } deriving (Show, Generic, NFData) @@ -182,7 +183,7 @@ data Newtype = Newtype { ntName :: Name , ntParams :: [TParam] , ntConstraints :: [Prop] , ntFields :: [(Ident,Type)] - , ntDoc :: Maybe String + , ntDoc :: Maybe Text } deriving (Show, Generic, NFData) @@ -192,7 +193,7 @@ data AbstractType = AbstractType , atKind :: Kind , atCtrs :: ([TParam], [Prop]) , atFixitiy :: Maybe Fixity - , atDoc :: Maybe String + , atDoc :: Maybe Text } deriving (Show, Generic, NFData)