mirror of
https://github.com/carp-lang/Carp.git
synced 2024-09-11 05:25:28 +03:00
feat: Add support for emitting literal C (#1178)
This commit is contained in:
parent
19c1a4c557
commit
1458bf4031
@ -71,7 +71,8 @@ defaultProject =
|
||||
projectForceReload = False,
|
||||
projectPkgConfigFlags = [],
|
||||
projectCModules = [],
|
||||
projectLoadStack = []
|
||||
projectLoadStack = [],
|
||||
projectPreproc = []
|
||||
}
|
||||
|
||||
-- | Starting point of the application.
|
||||
|
@ -15,6 +15,7 @@ typedef char *Pattern;
|
||||
typedef int64_t Long;
|
||||
typedef uint32_t Char;
|
||||
typedef char CChar;
|
||||
typedef void *c_code;
|
||||
|
||||
#if defined NDEBUG
|
||||
#define CHK_INDEX(i, n)
|
||||
|
@ -12,6 +12,8 @@ This is an extension of what is covered in the [Language Guide](./LanguageGuide.
|
||||
- [`deftemplate`](#deftemplate)
|
||||
- [`Basic example`](#basic-example)
|
||||
- [`Generics`](#generics)
|
||||
- [`emit-c`](#unsafe-emit-c)
|
||||
- [`preproc`](#unsafe-preproc)
|
||||
- [Callbacks](#callbacks)
|
||||
|
||||
|
||||
@ -343,6 +345,70 @@ out/main.c:9153:29: error: invalid operands to binary expression ('String' (aka
|
||||
1 error generated.
|
||||
```
|
||||
|
||||
### `Unsafe.emit-c`
|
||||
|
||||
While `deftemplate` is flexible and sufficient for most use cases, there are
|
||||
certain scenarios in which it won't accomplish what you need. For example, some
|
||||
C macros, such as c11's `static_assert` require a string literal argument.
|
||||
`deftemplate` can't accomplish this. In such cases, you can use `Unsafe.emit-c`
|
||||
to emit a literal string in the Carp compiler's C output. `emit-c` is perfect
|
||||
for scenarios like `static_assert` calls. Assuming `static_assert` is
|
||||
`register`ed as `static-assert`, we can use `emit-c` in the following way to
|
||||
ensure it is passed a string literal in the compiler's emitted C code:
|
||||
|
||||
```
|
||||
(register static-assert (Fn [a C] ()))
|
||||
|
||||
(static-assert 0 (Unsafe.emit-c "\"foo\""))
|
||||
```
|
||||
|
||||
which will emit the corresponding C:
|
||||
|
||||
```
|
||||
static_assert(0, "foo")
|
||||
```
|
||||
|
||||
`emit-C` returns values of the `C` type, a special type that represents literal
|
||||
C code in Carp.
|
||||
|
||||
### `Unsafe.preproc`
|
||||
|
||||
The Carp compiler emits C code in an order that ensures the dependencies of
|
||||
functions are available before functions are called. Sometimes, you may want to
|
||||
include C code before the Carp compiler's output. For instance, you might want
|
||||
to provide some preprocessor directives to a C compiler. The `Unsafe.preproc`
|
||||
function was designed with this use case in mind. You can use `preproc` to
|
||||
inject arbitrary C code prior to the Carp compiler's normal C output. Any code
|
||||
passed to `preproc` will be emitted after file `includes` but before any other
|
||||
emitted C code.
|
||||
|
||||
`preproc` takes a value of type `C` as an argument, so it must be used in
|
||||
combination with `Unsafe.emit-c`. The C code you pass to `preproc` isn't
|
||||
checked at all, so be careful!
|
||||
|
||||
If you do define C symbols using `preproc`, you'll still need to call
|
||||
`register` to reference them in Carp code. For example, the following snippet
|
||||
uses `preproc` to make a C macro and function available in the Carp compiler's
|
||||
output and then calls `register` to reference these symbols in the `main`
|
||||
function in the Carp source:
|
||||
|
||||
```
|
||||
(Unsafe.preproc (Unsafe.emit-c "#define FOO 0"))
|
||||
(Unsafe.preproc (Unsafe.emit-c "void foo() { printf(\"%d\\n\", 1); }"))
|
||||
|
||||
(register FOO Int)
|
||||
(register foo (Fn [] ()))
|
||||
|
||||
(defn main []
|
||||
(do (foo)
|
||||
(IO.println &(fmt "%d" FOO))))
|
||||
```
|
||||
|
||||
You can use this technique to add provisional definitions you need to reference
|
||||
in compiler output. If your helper functions, macros, or preprocessor
|
||||
directives are lengthy or complex, you may want to define them in a separate
|
||||
`h` file and `relative-include` it in your Carp source instead.
|
||||
|
||||
## Callbacks
|
||||
|
||||
Some C APIs rely on callbacks, let's define a C function that accepts a
|
||||
|
@ -1,6 +1,7 @@
|
||||
module Commands where
|
||||
|
||||
import ColorText
|
||||
import Context
|
||||
import Control.Exception
|
||||
import Control.Monad (join, when)
|
||||
import Control.Monad.IO.Class (MonadIO, liftIO)
|
||||
@ -303,6 +304,7 @@ commandBuild ctx [XObj (Bol shutUp) _ _] = do
|
||||
let compiler = projectCompiler proj
|
||||
echoCompilationCommand = projectEchoCompilationCommand proj
|
||||
incl = projectIncludesToC proj
|
||||
preproc = projectPreprocToC proj
|
||||
includeCorePath = projectCarpDir proj ++ "/core/ "
|
||||
cModules = projectCModules proj
|
||||
flags = projectFlags proj
|
||||
@ -334,7 +336,7 @@ commandBuild ctx [XObj (Bol shutUp) _ _] = do
|
||||
liftIO $ createDirectoryIfMissing False outDir
|
||||
outputHandle <- openFile outMain WriteMode
|
||||
hSetEncoding outputHandle utf8
|
||||
hPutStr outputHandle (incl ++ okSrc)
|
||||
hPutStr outputHandle (incl ++ preproc ++ okSrc)
|
||||
hClose outputHandle
|
||||
if generateOnly
|
||||
then pure (ctx, dynamicNil)
|
||||
@ -396,6 +398,17 @@ commandAddInclude includerConstructor ctx x =
|
||||
_ ->
|
||||
pure (evalError ctx ("Argument to 'include' must be a string, but was `" ++ pretty x ++ "`") (xobjInfo x))
|
||||
|
||||
-- | Command for adding preprocessing directives to emitted C output.
|
||||
-- All of the directives will be emitted after the project includes and before any other code.
|
||||
commandPreproc :: UnaryCommandCallback
|
||||
commandPreproc ctx (XObj (C c) _ _) =
|
||||
let proj = contextProj ctx
|
||||
preprocs = (projectPreproc proj) ++ [c]
|
||||
proj' = proj {projectPreproc = preprocs}
|
||||
in pure (replaceProject ctx proj', dynamicNil)
|
||||
commandPreproc ctx x =
|
||||
pure (evalError ctx ("Argument to 'preproc' must be C code, but was `" ++ pretty x ++ "`") (xobjInfo x))
|
||||
|
||||
commandAddSystemInclude :: UnaryCommandCallback
|
||||
commandAddSystemInclude = commandAddInclude SystemInclude
|
||||
|
||||
@ -715,6 +728,17 @@ commandSaveDocsInternal ctx modulePath = do
|
||||
Nothing ->
|
||||
Left ("I can’t find the module `" ++ show path ++ "`")
|
||||
|
||||
-- | 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:
|
||||
-- (static-assert 0 (emit-c "\"foo\""))
|
||||
-- Also used in combination with the preproc command.
|
||||
commandEmitC :: UnaryCommandCallback
|
||||
commandEmitC ctx (XObj (Str c) i _) =
|
||||
pure (ctx, Right (XObj (C c) i (Just CTy)))
|
||||
commandEmitC ctx xobj =
|
||||
pure (evalError ctx ("Invalid argument to emit-c (expected a string):" ++ pretty xobj) (xobjInfo xobj))
|
||||
|
||||
saveDocs :: Context -> [(SymPath, Binder)] -> IO (Context, Either a XObj)
|
||||
saveDocs ctx pathsAndEnvBinders = do
|
||||
liftIO (saveDocsForEnvs (contextProj ctx) pathsAndEnvBinders)
|
||||
@ -807,6 +831,7 @@ commandType :: UnaryCommandCallback
|
||||
commandType ctx (XObj x _ _) =
|
||||
pure (ctx, Right (XObj (Sym (SymPath [] (typeOf x)) Symbol) Nothing Nothing))
|
||||
where
|
||||
typeOf (C _) = "C"
|
||||
typeOf (Str _) = "string"
|
||||
typeOf (Sym _ _) = "symbol"
|
||||
typeOf (MultiSym _ _) = "multi-symbol"
|
||||
|
@ -3,6 +3,7 @@ module Emit
|
||||
envToC,
|
||||
globalsToC,
|
||||
projectIncludesToC,
|
||||
projectPreprocToC,
|
||||
envToDeclarations,
|
||||
checkForUnresolvedSymbols,
|
||||
ToCMode (..),
|
||||
@ -172,6 +173,7 @@ toC toCMode (Binder meta root) = emitterSrc (execState (visit startingIndent roo
|
||||
(Match _) -> dontVisit
|
||||
With -> dontVisit
|
||||
MetaStub -> dontVisit
|
||||
C c -> pure c
|
||||
visitStr' indent str i shouldEscape =
|
||||
-- This will allocate a new string every time the code runs:
|
||||
-- do let var = freshVar i
|
||||
@ -946,6 +948,11 @@ projectIncludesToC proj = intercalate "\n" (map includerToC includes) ++ "\n\n"
|
||||
includerToC (RelativeInclude file) = "#include \"" ++ file ++ "\""
|
||||
includes = projectIncludes proj
|
||||
|
||||
projectPreprocToC :: Project -> String
|
||||
projectPreprocToC proj = intercalate "\n" preprocs ++ "\n\n"
|
||||
where
|
||||
preprocs = projectPreproc proj
|
||||
|
||||
binderToC :: ToCMode -> Binder -> Either ToCError String
|
||||
binderToC toCMode binder =
|
||||
let xobj = binderXObj binder
|
||||
|
@ -74,6 +74,7 @@ initialTypes typeEnv rootEnv root = evalState (visit rootEnv root) 0
|
||||
visit env xobj = case xobjObj xobj of
|
||||
(Num t _) -> pure (Right (xobj {xobjTy = Just t}))
|
||||
(Bol _) -> pure (Right (xobj {xobjTy = Just BoolTy}))
|
||||
(C _) -> pure (Right xobj {xobjTy = Just CTy})
|
||||
(Str _) -> do
|
||||
lt <- genVarTy
|
||||
pure (Right (xobj {xobjTy = Just (RefTy StringTy lt)}))
|
||||
|
@ -170,6 +170,7 @@ data Obj
|
||||
| Ref
|
||||
| Deref
|
||||
| Interface Ty [SymPath]
|
||||
| C String -- C literal
|
||||
deriving (Show, Eq, Generic)
|
||||
|
||||
instance Hashable Obj
|
||||
@ -411,6 +412,7 @@ pretty = visit 0
|
||||
visit :: Int -> XObj -> String
|
||||
visit indent xobj =
|
||||
case xobjObj xobj of
|
||||
C c -> show c
|
||||
Lst lst -> "(" ++ joinWithSpace (map (visit indent) lst) ++ ")"
|
||||
Arr arr -> "[" ++ joinWithSpace (map (visit indent) arr) ++ "]"
|
||||
StaticArr arr -> "$[" ++ joinWithSpace (map (visit indent) arr) ++ "]"
|
||||
@ -488,6 +490,7 @@ prettyUpTo lim xobj =
|
||||
Num DoubleTy _ -> ""
|
||||
Num _ _ -> error "Invalid number type."
|
||||
Str _ -> ""
|
||||
C _ -> ""
|
||||
Pattern _ -> ""
|
||||
Chr _ -> ""
|
||||
Sym _ _ -> ""
|
||||
@ -778,6 +781,7 @@ incrementEnvNestLevel env =
|
||||
|
||||
-- | Converts an S-expression to one of the Carp types.
|
||||
xobjToTy :: XObj -> Maybe Ty
|
||||
xobjToTy (XObj (Sym (SymPath _ "C") _) _ _) = Just CTy
|
||||
xobjToTy (XObj (Sym (SymPath _ "Unit") _) _ _) = Just UnitTy
|
||||
xobjToTy (XObj (Sym (SymPath _ "Int") _) _ _) = Just IntTy
|
||||
xobjToTy (XObj (Sym (SymPath _ "Float") _) _ _) = Just FloatTy
|
||||
|
@ -18,6 +18,7 @@ instance Show Target where
|
||||
data Project = Project
|
||||
{ projectTitle :: String,
|
||||
projectIncludes :: [Includer],
|
||||
projectPreproc :: [String],
|
||||
projectCFlags :: [String],
|
||||
projectLibFlags :: [String],
|
||||
projectPkgConfigFlags :: [String],
|
||||
@ -59,6 +60,7 @@ instance Show Project where
|
||||
"Compiler: " ++ projectCompiler,
|
||||
"Target: " ++ show projectTarget,
|
||||
"Includes:\n " ++ joinIndented (map show projectIncludes),
|
||||
"Preprocessor directives:\n " ++ joinIndented (map show projectPreproc),
|
||||
"Cflags:\n " ++ joinIndented projectCFlags,
|
||||
"Library flags:\n " ++ joinIndented projectLibFlags,
|
||||
"Flags for pkg-config:\n " ++ joinIndented projectPkgConfigFlags,
|
||||
|
@ -365,6 +365,25 @@ dynamicStringModule =
|
||||
let f = addTernaryCommand . spath
|
||||
in [f "slice" commandSubstring "creates a substring from a beginning index to an end index." "(String.slice \"hello\" 1 3) ; => \"ell\""]
|
||||
|
||||
unsafeModule :: Env
|
||||
unsafeModule =
|
||||
Env {
|
||||
envBindings = bindings,
|
||||
envParent = Nothing,
|
||||
envModuleName = Just "Unsafe",
|
||||
envUseModules = Set.empty,
|
||||
envMode = ExternalEnv,
|
||||
envFunctionNestingLevel = 0
|
||||
}
|
||||
where
|
||||
spath = SymPath ["Unsafe"]
|
||||
bindings = Map.fromList unaries
|
||||
unaries =
|
||||
let f = addUnaryCommand . spath
|
||||
in [ f "emit-c" commandEmitC "emits literal C inline" "(Unsafe.emit-c \"#if 0\")",
|
||||
f "preproc" commandPreproc "adds preprocessing C code to emitted output" "(Unsafe.preproc (Unsafe.emit-c \"#define FOO 0\"))"
|
||||
]
|
||||
|
||||
-- | A submodule of the Dynamic module. Contains functions for working with symbols in the repl or during compilation.
|
||||
dynamicSymModule :: Env
|
||||
dynamicSymModule =
|
||||
@ -457,6 +476,7 @@ startingGlobalEnv noArray =
|
||||
++ [("Pointer", Binder emptyMeta (XObj (Mod pointerModule) Nothing Nothing))]
|
||||
++ [("Dynamic", Binder emptyMeta (XObj (Mod dynamicModule) Nothing Nothing))]
|
||||
++ [("Function", Binder emptyMeta (XObj (Mod functionModule) Nothing Nothing))]
|
||||
++ [("Unsafe", Binder emptyMeta (XObj (Mod unsafeModule) Nothing Nothing))]
|
||||
|
||||
-- | The type environment (containing deftypes and interfaces) before any code is run.
|
||||
startingTypeEnv :: Env
|
||||
|
@ -65,6 +65,7 @@ data Ty
|
||||
| MacroTy
|
||||
| DynamicTy -- the type of dynamic functions (used in REPL and macros)
|
||||
| InterfaceTy
|
||||
| CTy -- C literals
|
||||
| Universe -- the type of types of types (the type of TypeTy)
|
||||
deriving (Eq, Ord, Generic)
|
||||
|
||||
@ -192,6 +193,7 @@ instance Show Ty where
|
||||
show MacroTy = "Macro"
|
||||
show DynamicTy = "Dynamic"
|
||||
show Universe = "Universe"
|
||||
show CTy = "C"
|
||||
|
||||
showMaybeTy :: Maybe Ty -> String
|
||||
showMaybeTy (Just t) = show t
|
||||
|
@ -54,4 +54,5 @@ tyToCManglePtr _ ty = f ty
|
||||
f Universe = err "universe"
|
||||
f (PointerTy _) = err "pointers"
|
||||
f (RefTy _ _) = err "references"
|
||||
f CTy = "c_code" -- Literal C; we shouldn't emit anything.
|
||||
err s = error ("Can't emit the type of " ++ s ++ ".")
|
||||
|
Loading…
Reference in New Issue
Block a user