diff --git a/core/Macros.carp b/core/Macros.carp index e84eca58..4fb265bd 100644 --- a/core/Macros.carp +++ b/core/Macros.carp @@ -113,7 +113,7 @@ (if (= 1 (length xs)) (car xs) (list 'if (car xs) (and- (cdr xs)) false) ))) -(defmacro and [:rest xs] +(defmacro and [:rest xs] (and- xs)) (hidden or-) @@ -126,7 +126,7 @@ (if (= 1 (length xs)) (car xs) (list 'if (car xs) true (or- (cdr xs))) ))) -(defmacro or [:rest xs] +(defmacro or [:rest xs] (or- xs)) @@ -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))) diff --git a/core/Project.carp b/core/Project.carp index cf650fd7..8c465d14 100644 --- a/core/Project.carp +++ b/core/Project.carp @@ -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)) []))) diff --git a/docs/core/generate_core_docs.carp b/docs/core/generate_core_docs.carp index f64711ea..26c20d0f 100644 --- a/docs/core/generate_core_docs.carp +++ b/docs/core/generate_core_docs.carp @@ -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) diff --git a/docs/sdl/generate_sdl_docs.carp b/docs/sdl/generate_sdl_docs.carp index e1ac25d6..f6399633 100644 --- a/docs/sdl/generate_sdl_docs.carp +++ b/docs/sdl/generate_sdl_docs.carp @@ -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) diff --git a/src/Commands.hs b/src/Commands.hs index a0082197..5489c81f 100644 --- a/src/Commands.hs +++ b/src/Commands.hs @@ -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: diff --git a/src/StartingEnv.hs b/src/StartingEnv.hs index 84fdf963..ff8cbcbf 100644 --- a/src/StartingEnv.hs +++ b/src/StartingEnv.hs @@ -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