mirror of
https://github.com/carp-lang/Carp.git
synced 2024-10-10 20:17:15 +03:00
feat: Emit docs for top level bindings (#1253)
* refactor: Tiny cleanup before we begin * refactor: Moved module finding to its own local function * feat: save-docs-internal is now a binary command * feat: This seems to work * fix: Cleaned up the code, save-docs now emit one module per file listed
This commit is contained in:
parent
e412559380
commit
09c91c7f90
@ -270,10 +270,6 @@
|
||||
(list 'System.abort)
|
||||
(list 'bottom)))
|
||||
|
||||
(defmacro save-docs [:rest modules]
|
||||
;; A trick to be able to send unquoted symbols to 'save-docs'
|
||||
(eval (list 'save-docs-internal (list 'quote modules))))
|
||||
|
||||
(defndynamic implement-declaration [mod interface]
|
||||
(list 'implements interface (Symbol.prefix mod interface)))
|
||||
|
||||
|
@ -7,3 +7,9 @@
|
||||
(doc defproject "Define a project configuration.")
|
||||
(defmacro defproject [:rest bindings]
|
||||
(project-config bindings))
|
||||
|
||||
(doc save-docs "A simple version of `save-docs-ex` that lets you list all the modules directly as unquoted symbols. Does not handle global symbols, use `save-docs-ex` for that.
|
||||
|
||||
Example usage: `(save-docs Int Float String)`")
|
||||
(defmacro save-docs [:rest modules]
|
||||
(eval (list 'save-docs-ex (list quote (collect-into modules array)) [])))
|
||||
|
@ -14,42 +14,45 @@
|
||||
(load "Bench.carp")
|
||||
(load "Phantom.carp")
|
||||
|
||||
(save-docs Array
|
||||
Bench
|
||||
Bool
|
||||
Byte
|
||||
Char
|
||||
Control
|
||||
Debug
|
||||
Derive
|
||||
Double
|
||||
Dynamic
|
||||
Float
|
||||
Function
|
||||
Geometry
|
||||
Quasiquote
|
||||
Int
|
||||
Introspect
|
||||
Unit
|
||||
IO
|
||||
Long
|
||||
Map
|
||||
Maybe
|
||||
Opaque
|
||||
Pair
|
||||
Pattern
|
||||
Quadruple
|
||||
Phantom
|
||||
Pointer
|
||||
Result
|
||||
StaticArray
|
||||
System
|
||||
Statistics
|
||||
String
|
||||
Test
|
||||
Triple
|
||||
Vector2
|
||||
Vector3
|
||||
VectorN)
|
||||
(save-docs-ex
|
||||
['Array
|
||||
'Bench
|
||||
'Bool
|
||||
'Byte
|
||||
'Char
|
||||
'Control
|
||||
'Debug
|
||||
'Derive
|
||||
'Double
|
||||
'Dynamic
|
||||
'Float
|
||||
'Function
|
||||
'Geometry
|
||||
'Quasiquote
|
||||
'Int
|
||||
'Introspect
|
||||
'Unit
|
||||
'IO
|
||||
'Long
|
||||
'Map
|
||||
'Maybe
|
||||
'Opaque
|
||||
'Pair
|
||||
'Pattern
|
||||
'Quadruple
|
||||
'Phantom
|
||||
'Pointer
|
||||
'Result
|
||||
'StaticArray
|
||||
'System
|
||||
'Statistics
|
||||
'String
|
||||
'Test
|
||||
'Triple
|
||||
'Vector2
|
||||
'Vector3
|
||||
'VectorN]
|
||||
["Macros.carp"
|
||||
"ControlMacros.carp"])
|
||||
|
||||
(quit)
|
||||
|
@ -10,12 +10,18 @@
|
||||
(load "SDL_mixer.carp")
|
||||
(load "SDL_ttf.carp")
|
||||
|
||||
(save-docs SDL
|
||||
SDLApp
|
||||
IMG
|
||||
GFX
|
||||
Mixer
|
||||
TTF
|
||||
)
|
||||
(save-docs-ex
|
||||
['SDL
|
||||
'SDLApp
|
||||
'IMG
|
||||
'GFX
|
||||
'Mixer
|
||||
'TTF]
|
||||
["SDL.carp"
|
||||
"SDL_image.carp"
|
||||
"SDL_gfx.carp"
|
||||
"SDL_mixer.carp"
|
||||
"SDL_ttf.carp"
|
||||
])
|
||||
|
||||
(quit)
|
||||
|
@ -50,9 +50,9 @@ boolToXObj b = if b then trueXObj else falseXObj
|
||||
|
||||
addCmd :: SymPath -> CommandFunctionType -> String -> String -> (String, Binder)
|
||||
addCmd path callback doc example =
|
||||
(name, Binder meta cmd)
|
||||
(filename, Binder meta cmd)
|
||||
where
|
||||
SymPath _ name = path
|
||||
SymPath _ filename = path
|
||||
exampleUsage = "Example Usage:\n```\n" ++ example ++ "\n```\n"
|
||||
docString = doc ++ "\n\n" ++ exampleUsage
|
||||
meta = Meta.set "doc" (XObj (Str docString) Nothing Nothing) emptyMeta
|
||||
@ -383,7 +383,7 @@ commandProject ctx = do
|
||||
liftIO (print (contextProj ctx))
|
||||
pure (ctx, dynamicNil)
|
||||
|
||||
-- | Command for getting the name of the operating system you're on.
|
||||
-- | Command for getting the filename of the operating system you're on.
|
||||
commandHostOS :: NullaryCommandCallback
|
||||
commandHostOS ctx =
|
||||
pure (ctx, Right (XObj (Str os) (Just dummyInfo) (Just StringTy)))
|
||||
@ -736,22 +736,58 @@ commandHostBitWidth ctx =
|
||||
let bitSize = Integral (finiteBitSize (undefined :: Int))
|
||||
in pure (ctx, Right (XObj (Num IntTy bitSize) (Just dummyInfo) (Just IntTy)))
|
||||
|
||||
commandSaveDocsInternal :: UnaryCommandCallback
|
||||
commandSaveDocsInternal ctx modulePath = do
|
||||
let globalEnv = contextGlobalEnv ctx
|
||||
case modulePath of
|
||||
XObj (Lst xobjs) _ _ ->
|
||||
case mapM unwrapSymPathXObj xobjs of
|
||||
Left err -> pure (evalError ctx err (xobjInfo modulePath))
|
||||
Right okPaths ->
|
||||
case mapM (getEnvironmentBinderForDocumentation ctx globalEnv) okPaths of
|
||||
Left err -> pure (evalError ctx err (xobjInfo modulePath))
|
||||
Right okEnvBinders -> saveDocs ctx (zip okPaths okEnvBinders)
|
||||
x ->
|
||||
pure (evalError ctx ("Invalid arg to save-docs-internal (expected list of symbols): " ++ pretty x) (xobjInfo modulePath))
|
||||
commandSaveDocsEx :: BinaryCommandCallback
|
||||
commandSaveDocsEx ctx modulePaths filePaths = do
|
||||
case modulesAndGlobals of
|
||||
Left err -> pure (ctx, Left err)
|
||||
Right ok -> saveDocs ctx ok
|
||||
where
|
||||
getEnvironmentBinderForDocumentation :: Context -> Env -> SymPath -> Either String Binder
|
||||
getEnvironmentBinderForDocumentation _ env path =
|
||||
globalEnv = contextGlobalEnv ctx
|
||||
|
||||
modulesAndGlobals =
|
||||
let (_, mods) = modules
|
||||
(_, globs) = filesWithGlobals
|
||||
in do
|
||||
okMods <- mods
|
||||
okGlobs <- globs
|
||||
pure (okMods ++ okGlobs)
|
||||
|
||||
modules :: (Context, Either EvalError [(SymPath, Binder)])
|
||||
modules = do
|
||||
case modulePaths of
|
||||
XObj (Arr xobjs) _ _ ->
|
||||
case mapM unwrapSymPathXObj xobjs of
|
||||
Left err -> evalError ctx err (xobjInfo modulePaths)
|
||||
Right okPaths ->
|
||||
case mapM (getEnvironmentBinderForDocumentation globalEnv) okPaths of
|
||||
Left err -> evalError ctx err (xobjInfo modulePaths)
|
||||
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
|
||||
XObj (Arr xobjs) _ _ ->
|
||||
case mapM unwrapStringXObj xobjs of
|
||||
Left err -> evalError ctx err (xobjInfo filePaths)
|
||||
Right okPaths ->
|
||||
let globalBinders = map (getGlobalBindersForDocumentation globalEnv) okPaths
|
||||
fauxModules = zipWith createFauxModule okPaths globalBinders
|
||||
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
|
||||
fauxGlobalModule = E.new Nothing (Just moduleName)
|
||||
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
|
||||
Right foundBinder@(Binder _ (XObj (Mod _ _) _ _)) ->
|
||||
Right foundBinder
|
||||
@ -760,6 +796,13 @@ commandSaveDocsInternal ctx modulePath = do
|
||||
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
|
||||
|
||||
-- | Command for emitting literal C code from Carp.
|
||||
-- The string passed to this function will be emitted as is.
|
||||
-- This is necessary in some C interop contexts, e.g. calling macros that only accept string literals:
|
||||
|
@ -258,7 +258,6 @@ dynamicModule =
|
||||
f "expand" commandExpand "expands a macro and prints the result." "(expand '(when true 1)) ; => (if true 1 ())",
|
||||
f "system-include" commandAddSystemInclude "adds a system include, i.e. a C `#include` with angle brackets (`<>`)." "(system-include \"stdint.h\")",
|
||||
f "relative-include" commandAddRelativeInclude "adds a relative include, i.e. a C `include` with quotes. It also prepends the current directory." "(relative-include \"myheader.h\")",
|
||||
f "save-docs-internal" commandSaveDocsInternal "is the internal companion command to `save-docs`. `save-docs` should be called instead." "(save-docs-internal 'Module)",
|
||||
f "read-file" commandReadFile "reads a file into a string." "(read-file \"myfile.txt\")",
|
||||
f "get-env" commandGetEnv "gets an environment variable. The result will be `()` if it isn’t set." "(read-file \"CARP_DIR\")",
|
||||
f "hash" commandHash "calculates the hash associated with a value." "(hash '('my 'value)) ; => 3175346968842793108",
|
||||
@ -278,7 +277,8 @@ dynamicModule =
|
||||
f "/" commandDiv "divides its first argument by its second." "(/ 4 2) ; => 2",
|
||||
f "*" commandMul "multiplies its two arguments." "(* 2 3) ; => 6",
|
||||
f "write-file" commandWriteFile "writes a string to a file." "(write-file \"myfile\" \"hello there!\")",
|
||||
f "set-env" commandSetEnv "sets an environment variable." "(set-env \"CARP_WAS_HERE\" \"true\")"
|
||||
f "set-env" commandSetEnv "sets an environment variable." "(set-env \"CARP_WAS_HERE\" \"true\")",
|
||||
f "save-docs-ex" commandSaveDocsEx "takes two arrays, one with paths to modules (as symbols), and one with filenames (as strings). The filenames are used to emit global symbols in those files into a 'Global' module." "(save-docs-internal '(ModuleA ModuleB) '(\"globals.carp\"))"
|
||||
]
|
||||
variadics =
|
||||
let f = addVariadicCommand . spath
|
||||
|
Loading…
Reference in New Issue
Block a user