mirror of
https://github.com/carp-lang/Carp.git
synced 2024-09-11 13:37:57 +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 'System.abort)
|
||||||
(list 'bottom)))
|
(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]
|
(defndynamic implement-declaration [mod interface]
|
||||||
(list 'implements interface (Symbol.prefix mod interface)))
|
(list 'implements interface (Symbol.prefix mod interface)))
|
||||||
|
|
||||||
|
@ -7,3 +7,9 @@
|
|||||||
(doc defproject "Define a project configuration.")
|
(doc defproject "Define a project configuration.")
|
||||||
(defmacro defproject [:rest bindings]
|
(defmacro defproject [:rest bindings]
|
||||||
(project-config 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 "Bench.carp")
|
||||||
(load "Phantom.carp")
|
(load "Phantom.carp")
|
||||||
|
|
||||||
(save-docs Array
|
(save-docs-ex
|
||||||
Bench
|
['Array
|
||||||
Bool
|
'Bench
|
||||||
Byte
|
'Bool
|
||||||
Char
|
'Byte
|
||||||
Control
|
'Char
|
||||||
Debug
|
'Control
|
||||||
Derive
|
'Debug
|
||||||
Double
|
'Derive
|
||||||
Dynamic
|
'Double
|
||||||
Float
|
'Dynamic
|
||||||
Function
|
'Float
|
||||||
Geometry
|
'Function
|
||||||
Quasiquote
|
'Geometry
|
||||||
Int
|
'Quasiquote
|
||||||
Introspect
|
'Int
|
||||||
Unit
|
'Introspect
|
||||||
IO
|
'Unit
|
||||||
Long
|
'IO
|
||||||
Map
|
'Long
|
||||||
Maybe
|
'Map
|
||||||
Opaque
|
'Maybe
|
||||||
Pair
|
'Opaque
|
||||||
Pattern
|
'Pair
|
||||||
Quadruple
|
'Pattern
|
||||||
Phantom
|
'Quadruple
|
||||||
Pointer
|
'Phantom
|
||||||
Result
|
'Pointer
|
||||||
StaticArray
|
'Result
|
||||||
System
|
'StaticArray
|
||||||
Statistics
|
'System
|
||||||
String
|
'Statistics
|
||||||
Test
|
'String
|
||||||
Triple
|
'Test
|
||||||
Vector2
|
'Triple
|
||||||
Vector3
|
'Vector2
|
||||||
VectorN)
|
'Vector3
|
||||||
|
'VectorN]
|
||||||
|
["Macros.carp"
|
||||||
|
"ControlMacros.carp"])
|
||||||
|
|
||||||
(quit)
|
(quit)
|
||||||
|
@ -10,12 +10,18 @@
|
|||||||
(load "SDL_mixer.carp")
|
(load "SDL_mixer.carp")
|
||||||
(load "SDL_ttf.carp")
|
(load "SDL_ttf.carp")
|
||||||
|
|
||||||
(save-docs SDL
|
(save-docs-ex
|
||||||
SDLApp
|
['SDL
|
||||||
IMG
|
'SDLApp
|
||||||
GFX
|
'IMG
|
||||||
Mixer
|
'GFX
|
||||||
TTF
|
'Mixer
|
||||||
)
|
'TTF]
|
||||||
|
["SDL.carp"
|
||||||
|
"SDL_image.carp"
|
||||||
|
"SDL_gfx.carp"
|
||||||
|
"SDL_mixer.carp"
|
||||||
|
"SDL_ttf.carp"
|
||||||
|
])
|
||||||
|
|
||||||
(quit)
|
(quit)
|
||||||
|
@ -50,9 +50,9 @@ boolToXObj b = if b then trueXObj else falseXObj
|
|||||||
|
|
||||||
addCmd :: SymPath -> CommandFunctionType -> String -> String -> (String, Binder)
|
addCmd :: SymPath -> CommandFunctionType -> String -> String -> (String, Binder)
|
||||||
addCmd path callback doc example =
|
addCmd path callback doc example =
|
||||||
(name, Binder meta cmd)
|
(filename, Binder meta cmd)
|
||||||
where
|
where
|
||||||
SymPath _ name = path
|
SymPath _ filename = path
|
||||||
exampleUsage = "Example Usage:\n```\n" ++ example ++ "\n```\n"
|
exampleUsage = "Example Usage:\n```\n" ++ example ++ "\n```\n"
|
||||||
docString = doc ++ "\n\n" ++ exampleUsage
|
docString = doc ++ "\n\n" ++ exampleUsage
|
||||||
meta = Meta.set "doc" (XObj (Str docString) Nothing Nothing) emptyMeta
|
meta = Meta.set "doc" (XObj (Str docString) Nothing Nothing) emptyMeta
|
||||||
@ -383,7 +383,7 @@ commandProject ctx = do
|
|||||||
liftIO (print (contextProj ctx))
|
liftIO (print (contextProj ctx))
|
||||||
pure (ctx, dynamicNil)
|
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 :: NullaryCommandCallback
|
||||||
commandHostOS ctx =
|
commandHostOS ctx =
|
||||||
pure (ctx, Right (XObj (Str os) (Just dummyInfo) (Just StringTy)))
|
pure (ctx, Right (XObj (Str os) (Just dummyInfo) (Just StringTy)))
|
||||||
@ -736,22 +736,58 @@ commandHostBitWidth ctx =
|
|||||||
let bitSize = Integral (finiteBitSize (undefined :: Int))
|
let bitSize = Integral (finiteBitSize (undefined :: Int))
|
||||||
in pure (ctx, Right (XObj (Num IntTy bitSize) (Just dummyInfo) (Just IntTy)))
|
in pure (ctx, Right (XObj (Num IntTy bitSize) (Just dummyInfo) (Just IntTy)))
|
||||||
|
|
||||||
commandSaveDocsInternal :: UnaryCommandCallback
|
commandSaveDocsEx :: BinaryCommandCallback
|
||||||
commandSaveDocsInternal ctx modulePath = do
|
commandSaveDocsEx ctx modulePaths filePaths = do
|
||||||
let globalEnv = contextGlobalEnv ctx
|
case modulesAndGlobals of
|
||||||
case modulePath of
|
Left err -> pure (ctx, Left err)
|
||||||
XObj (Lst xobjs) _ _ ->
|
Right ok -> saveDocs ctx ok
|
||||||
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))
|
|
||||||
where
|
where
|
||||||
getEnvironmentBinderForDocumentation :: Context -> Env -> SymPath -> Either String Binder
|
globalEnv = contextGlobalEnv ctx
|
||||||
getEnvironmentBinderForDocumentation _ env path =
|
|
||||||
|
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
|
case E.searchValueBinder env path of
|
||||||
Right foundBinder@(Binder _ (XObj (Mod _ _) _ _)) ->
|
Right foundBinder@(Binder _ (XObj (Mod _ _) _ _)) ->
|
||||||
Right foundBinder
|
Right foundBinder
|
||||||
@ -760,6 +796,13 @@ commandSaveDocsInternal ctx modulePath = do
|
|||||||
Left _ ->
|
Left _ ->
|
||||||
Left ("I can’t find the module `" ++ show path ++ "`")
|
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.
|
-- | Command for emitting literal C code from Carp.
|
||||||
-- The string passed to this function will be emitted as is.
|
-- 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:
|
-- 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 "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 "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 "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 "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 "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",
|
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 "/" commandDiv "divides its first argument by its second." "(/ 4 2) ; => 2",
|
||||||
f "*" commandMul "multiplies its two arguments." "(* 2 3) ; => 6",
|
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 "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 =
|
variadics =
|
||||||
let f = addVariadicCommand . spath
|
let f = addVariadicCommand . spath
|
||||||
|
Loading…
Reference in New Issue
Block a user