carp-lang/Carp
1
1
Fork 0
mirror of https://github.com/carp-lang/Carp.git synced 2024-08-16 08:40:41 +03:00
Code Issues Projects Releases Wiki Activity

docs: set infoFile on primitives and commands (#1273)

Browse Source
This commit is contained in:
Veit Heller 2021-07-06 11:33:12 +02:00 committed by GitHub
parent 00c85cac42
commit ca0f9f7d4f
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
2 changed files with 2 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
src/Commands.hs
View File

@ -64,7 +64,7 @@ addCmd path callback doc example =
XObj (Arr args) Nothing Nothing
]
)
(Just dummyInfo)
(Just dummyInfo {infoFile = "Core Commands"})
(Just DynamicTy)
args = (\x -> XObj (Sym (SymPath [] x) Symbol) Nothing Nothing) <$> argnames
argnames = case callback of
@ -743,7 +743,6 @@ commandSaveDocsEx ctx modulePaths filePaths = do
Right ok -> saveDocs ctx ok
where
globalEnv = contextGlobalEnv ctx
modulesAndGlobals =
let (_, mods) = modules
(_, globs) = filesWithGlobals
@ -751,7 +750,6 @@ commandSaveDocsEx ctx modulePaths filePaths = do
okMods <- mods
okGlobs <- globs
pure (okMods ++ okGlobs)
modules :: (Context, Either EvalError [(SymPath, Binder)])
modules = do
case modulePaths of
@ -764,7 +762,6 @@ commandSaveDocsEx ctx modulePaths filePaths = do
Right okEnvBinders -> (ctx, Right (zip okPaths okEnvBinders))
x ->
evalError ctx ("Invalid first arg to save-docs-internal (expected array of symbols): " ++ pretty x) (xobjInfo modulePaths)
filesWithGlobals :: (Context, Either EvalError [(SymPath, Binder)])
filesWithGlobals = do
case filePaths of
@ -777,7 +774,6 @@ commandSaveDocsEx ctx modulePaths filePaths = do
in (ctx, Right fauxModules)
x ->
evalError ctx ("Invalid second arg to save-docs-internal (expected array of strings containing filenames): " ++ pretty x) (xobjInfo filePaths)
createFauxModule :: String -> Map.Map String Binder -> (SymPath, Binder)
createFauxModule filename binders =
let moduleName = "Globals in " ++ filename
@ -785,7 +781,6 @@ commandSaveDocsEx ctx modulePaths filePaths = do
fauxGlobalModuleWithBindings = fauxGlobalModule {envBindings = binders}
fauxTypeEnv = E.new Nothing Nothing
in (SymPath [] moduleName, Binder emptyMeta (XObj (Mod fauxGlobalModuleWithBindings fauxTypeEnv) Nothing Nothing))
getEnvironmentBinderForDocumentation :: Env -> SymPath -> Either String Binder
getEnvironmentBinderForDocumentation env path =
case E.searchValueBinder env path of
@ -795,11 +790,9 @@ commandSaveDocsEx ctx modulePaths filePaths = do
Left ("I can’t generate documentation for `" ++ pretty x ++ "` because it isn’t a module")
Left _ ->
Left ("I can’t find the module `" ++ show path ++ "`")
getGlobalBindersForDocumentation :: Env -> String -> Map.Map String Binder
getGlobalBindersForDocumentation env filename =
Map.filter (\bind -> (binderFilename bind) == filename) (envBindings env)
binderFilename :: Binder -> String
binderFilename = takeFileName . fromMaybe "" . fmap infoFile . xobjInfo . binderXObj

4
src/Primitives.hs
View File

@ -74,7 +74,7 @@ makePrim path callback doc example =
XObj (Arr args) Nothing Nothing
]
)
(Just dummyInfo)
(Just dummyInfo {infoFile = "Core Primitives"})
(Just DynamicTy)
args = (\x -> XObj (Sym (SymPath [] x) Symbol) Nothing Nothing) <$> argnames
argnames = case callback of
@ -371,7 +371,6 @@ primitiveMembers _ ctx xobj@(XObj (Sym path _) _ _) =
go (XObj (Lst ((XObj (DefSumtype _) _ _) : _ : cases)) _ _) =
pure $ (ctx, (either Left (\a -> Right (XObj (Arr (concat a)) Nothing Nothing)) (mapM getMembersFromCase cases)))
go x = pure (toEvalError ctx x (NonTypeInTypeEnv path x))
getMembersFromCase :: XObj -> Either EvalError [XObj]
getMembersFromCase (XObj (Lst members) _ _) =
Right (map (\(a, b) -> XObj (Lst [a, b]) Nothing Nothing) (pairwise members))
@ -666,7 +665,6 @@ primitiveUse xobj ctx (XObj (Sym path _) _ _) =
updateGlobalUsePaths :: Env -> SymPath -> (Context, Either EvalError XObj)
updateGlobalUsePaths e spath =
((replaceGlobalEnv ctx (addUsePath e spath)), dynamicNil)
updateModuleUsePaths :: Env -> SymPath -> Binder -> SymPath -> (Context, Either EvalError XObj)
updateModuleUsePaths e p (Binder meta (XObj (Mod ev et) i t)) spath =
either