mirror of
https://github.com/carp-lang/Carp.git
synced 2024-07-14 16:40:26 +03:00
feat: add c-name meta field (#1398)
* feat: add box templates and box type
This commit adds an implementation of Boxes, memory manged heap
allocated values.
Boxes are implemented as C pointers, with no additional structure but
are treated as structs in Carp. To facilitate this, we need to add them
as a clause to our special type emissions (TypesToC) as they'd otherwise
be emitted like other struct types.
Co-authored-by: Veit Heller <veit@veitheller.de>
* fix: slight memory management fix for Box
Make sure we free the box!
* test: add tests for box (including memory checks)
* Revert "fix: Ignore clang nitpick"
This reverts commit 70ec6d46d4
.
* fix: update example/functor.carp
Now that a builtin type named Box exists, the definitions in this file
cause a conflict. I've renamed the "Box" type in the functor example to
remove the conflict.
* feat: add Box.peek
Box.peek allows users to transform a reference to a box into a a
reference to the box's contained value. The returned reference will have
the same lifetime as the box. This function allows callers to manipulate
the value in a box without re-allocation, for example:
```clojure
(deftype Num [val Int])
(let-do [box (Box.init (Num.init 0))]
(Num.set-val! (Box.peek &box) 1)
@(Num.val (Box.peek &box)))
```
This commit also includes tests for Box.peek.
Co-authored-by: TimDeve <TimDeve@users.noreply.github.com>
* feat: add c-name meta key for code emission overrides
This commit adds a new special compiler meta key, c-name, that enables
users to explicitly c the C identifier Carp should emit for a given
symbol. For now, it is only explicitly supported for Def and Defn forms.
For example:
```clojure
(defn foo-bar [] 2)
(c-name foo-bar "foo_bar")
```
Will cause foo-bar in emitted C code to be emitted as `foo_bar` instead
of `foo_MINUS_bar`.
I've also refactored some of the meta code to be a bit more principled
about keys that are understood by the compiler.
* docs: update CInterop docs
Adds a section on using the c-name meta field to override identifiers
exclusively defined in Carp. Also performs some minor editorial.
Co-authored-by: Veit Heller <veit@veitheller.de>
Co-authored-by: Erik Svedäng <erik@coherence.io>
Co-authored-by: TimDeve <TimDeve@users.noreply.github.com>
This commit is contained in:
parent
3148703a22
commit
35edce70cd
@ -104,6 +104,16 @@
|
||||
(defmacro private [name]
|
||||
(eval (list 'meta-set! name "private" true)))
|
||||
|
||||
(doc c-name
|
||||
"Override the identifiers Carp generates for a given symbol in C output."
|
||||
""
|
||||
"```"
|
||||
"(defn foo-bar [] 1)"
|
||||
"(c-name foo-bar \"foo_bar\")"
|
||||
"```")
|
||||
(defmacro c-name [sym cname]
|
||||
(eval (list 'meta-set! sym "c-name" cname)))
|
||||
|
||||
(hidden and-)
|
||||
(defndynamic and- [xs]
|
||||
; (defndynamic and- [xs] ; shorter but currently not entirely stable
|
||||
|
@ -18,7 +18,6 @@ This is an extension of what is covered in the [Language Guide](./LanguageGuide.
|
||||
- [Callbacks](#callbacks)
|
||||
- [Headerparse](#headerparse)
|
||||
|
||||
|
||||
## How Carp generates identifiers
|
||||
|
||||
When creating a function or def it might be useful to know what identifier gets
|
||||
@ -56,8 +55,9 @@ generated on the C side. Here are some examples:
|
||||
; => print_MINUS_first_MINUS_and_MINUS_add__String_Long
|
||||
```
|
||||
|
||||
Looking at the examples should be clear enough but let's break it down:
|
||||
Carp will replace illegal characters in C with a string representation of them
|
||||
Looking at the examples should help illustrate how Carp transforms identifiers
|
||||
before producing C code, but let's break it down: Carp will replace illegal
|
||||
characters in C with a string representation of them
|
||||
(`- => _MINUS_`, `? => _QMARK_`, etc...)
|
||||
If in modules it will prefix the identifier with the modules name.
|
||||
When the arguments to a function are generic it will suffix the types to the
|
||||
@ -66,9 +66,19 @@ a function is potentially generic but you don't want it to be you can add a
|
||||
non-generic signature to it to make Carp generate your function like in our
|
||||
`true?` example.
|
||||
|
||||
When creating bindings to a library it would be hard to coerce this logic into
|
||||
creating the exact identifiers the library uses, this is why `register` and
|
||||
`register-type` accepts an optional argument to specify what identifiers to use:
|
||||
This process is called *mangling* and is necessary to ensure that identifiers
|
||||
that are valid in Carp but invalid in C don't produce invalid C code.
|
||||
|
||||
### Overriding Carp's default C identifier names
|
||||
|
||||
When creating bindings to an existing C library in Carp, it's inconvenient to
|
||||
have to replicate C identifiers exactly as they're declared in C. For example,
|
||||
due to mangling, you couldn't wrap your Carp bindings in a module, since the
|
||||
resulting identifiers would be prefixed, and probably incorrect. It would be
|
||||
inconvenient and tedious to have to replicate existing C identifiers exactly
|
||||
whenever you had to create bindings to an existing library , so, to help with
|
||||
this, `register` and `register-type` accepts an optional argument to specify
|
||||
what identifiers to use:
|
||||
|
||||
```clojure
|
||||
(defmodule CURL
|
||||
@ -76,6 +86,34 @@ creating the exact identifiers the library uses, this is why `register` and
|
||||
(register form-free (Fn [(Ref HttpPost)] ()) "curl_formfree"))
|
||||
```
|
||||
|
||||
This enables you to define whatever structure you want in Carp code (for
|
||||
example, here we wrap cURL bindings in a CURL module) while ensuring the
|
||||
emitted identifiers are correct and map to the identifiers used by the existing
|
||||
C library you're calling. For example, the `form-free` identifier in Carp would
|
||||
normally be subject to mangling and emitted as `form_MINUS_free`, but the
|
||||
override argument ensures this identifier is emitted as `curl_formfree`
|
||||
instead.
|
||||
|
||||
Likewise, you can override the C identifiers Carp generates for code
|
||||
exclusively defined in Carp. For instance, you may want to migrate
|
||||
safety-critical code in an existing C program into Carp, then call the
|
||||
resulting safe C code in your original C program. This can become tedious if
|
||||
your Carp code utilizes a lot of nested modules, custom types, or special
|
||||
characters in identifiers.
|
||||
|
||||
You can use the `c-name` meta field to explicitly set the C identifier Carp
|
||||
generates for a given definition. This can help make your compiled C more
|
||||
readable and easier to call from other languages. For example, given the
|
||||
definition and c-name call:
|
||||
|
||||
```clojure
|
||||
(defn foo-bar [] 2)
|
||||
(c-name foo-bar "foo_bar")
|
||||
```
|
||||
|
||||
Carp will generate a corresponding identifier `foo_bar` in its C output,
|
||||
instead of the default `foo_MINUS_bar`.
|
||||
|
||||
## Managed types
|
||||
|
||||
In Carp types like `String` and `Array` are _managed_ types in that they are
|
||||
|
14
src/Emit.hs
14
src/Emit.hs
@ -306,8 +306,10 @@ toC toCMode (Binder meta root) = emitterSrc (execState (visit startingIndent roo
|
||||
do
|
||||
appendToSrc (addIndent indent ++ "{\n")
|
||||
let innerIndent = indent + indentAmount
|
||||
cname = (Meta.getString (Meta.getCompilerKey Meta.CNAME) meta)
|
||||
fullname = if (null cname) then pathToC path else cname
|
||||
ret <- visit innerIndent expr
|
||||
when (ret /= "") $ appendToSrc (addIndent innerIndent ++ pathToC path ++ " = " ++ ret ++ ";\n")
|
||||
when (ret /= "") $ appendToSrc (addIndent innerIndent ++ fullname ++ " = " ++ ret ++ ";\n")
|
||||
delete innerIndent info
|
||||
appendToSrc (addIndent indent ++ "}\n")
|
||||
pure ""
|
||||
@ -782,16 +784,18 @@ delete indent i = mapM_ deleterToC (infoDelete i)
|
||||
|
||||
defnToDeclaration :: MetaData -> SymPath -> [XObj] -> Ty -> String
|
||||
defnToDeclaration meta path@(SymPath _ name) argList retTy =
|
||||
let (XObj (Lst annotations) _ _) = fromMaybe emptyList (Meta.get "annotations" meta)
|
||||
let override = Meta.getString (Meta.getCompilerKey Meta.CNAME) meta
|
||||
(XObj (Lst annotations) _ _) = fromMaybe emptyList (Meta.get "annotations" meta)
|
||||
annotationsStr = joinWith " " (map strToC annotations)
|
||||
sep = if not (null annotationsStr) then " " else ""
|
||||
fullname = if (null override) then (pathToC path) else override
|
||||
in annotationsStr ++ sep
|
||||
++ if name == "main"
|
||||
then "int main(int argc, char** argv)"
|
||||
else
|
||||
let retTyAsC = tyToCLambdaFix retTy
|
||||
paramsAsC = paramListToC argList
|
||||
in (retTyAsC ++ " " ++ pathToC path ++ "(" ++ paramsAsC ++ ")")
|
||||
in (retTyAsC ++ " " ++ fullname ++ "(" ++ paramsAsC ++ ")")
|
||||
where
|
||||
strToC (XObj (Str s) _ _) = s
|
||||
strToC xobj = pretty xobj
|
||||
@ -895,9 +899,11 @@ toDeclaration (Binder meta xobj@(XObj (Lst xobjs) _ ty)) =
|
||||
in defnToDeclaration meta path argList retTy ++ ";\n"
|
||||
[XObj Def _ _, XObj (Sym path _) _ _, _] ->
|
||||
let Just t = ty
|
||||
cname = (Meta.getString (Meta.getCompilerKey Meta.CNAME) meta)
|
||||
fullname = if (null cname) then pathToC path else cname
|
||||
in if (isUnit t)
|
||||
then ""
|
||||
else tyToCLambdaFix t ++ " " ++ pathToC path ++ ";\n"
|
||||
else tyToCLambdaFix t ++ " " ++ fullname ++ ";\n"
|
||||
XObj (Deftype t) _ _ : XObj (Sym path _) _ _ : rest ->
|
||||
defStructToDeclaration t path rest
|
||||
XObj (DefSumtype t) _ _ : XObj (Sym _ _) _ _ : rest ->
|
||||
|
43
src/Meta.hs
43
src/Meta.hs
@ -8,6 +8,10 @@ module Meta
|
||||
Meta.member,
|
||||
binderMember,
|
||||
hide,
|
||||
getString,
|
||||
getCompilerKey,
|
||||
validateAndSet,
|
||||
CompilerKey(..),
|
||||
)
|
||||
where
|
||||
|
||||
@ -16,6 +20,41 @@ import qualified Map
|
||||
import Obj
|
||||
import SymPath
|
||||
import Types
|
||||
import Data.Maybe(fromMaybe)
|
||||
import Data.Either(fromRight)
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- builtin special meta key values
|
||||
-- These keys, when set, alter the compiler's behavior.
|
||||
|
||||
data CompilerKey = CNAME
|
||||
|
||||
-- Given a compiler key, returns the key name as a string along with a default value.
|
||||
toKeyValue :: CompilerKey -> (String, XObj)
|
||||
toKeyValue CNAME = ("c-name", (XObj (Str "") Nothing Nothing))
|
||||
|
||||
-- | Get the key associated with a compiler Meta key as a string.
|
||||
getCompilerKey :: CompilerKey -> String
|
||||
getCompilerKey = fst . toKeyValue
|
||||
|
||||
-- | Special meta KV pairs expect values of a certain XObj form.
|
||||
--
|
||||
-- Returns True for valid values for the given compiler key, False otherwise.
|
||||
validateCompilerKeyValue :: CompilerKey -> Obj -> Bool
|
||||
validateCompilerKeyValue CNAME (Str _) = True
|
||||
validateCompilerKeyValue CNAME _ = False
|
||||
|
||||
-- | Validate and set a compiler key for a given MetaData object.
|
||||
--
|
||||
-- If the key or value is invalid, returns Left containing the original metadata.
|
||||
-- If the key and value is valid, return Right containing the updated metadata.
|
||||
validateAndSet :: MetaData -> CompilerKey -> XObj -> Either MetaData MetaData
|
||||
validateAndSet meta key val
|
||||
| validateCompilerKeyValue key (xobjObj val) =
|
||||
Right (set (getCompilerKey key) val meta)
|
||||
| otherwise = Left meta
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
-- | A temporary binder for meta calls on symbols that haven't been declared yet.
|
||||
-- Used in situations such as:
|
||||
@ -61,3 +100,7 @@ binderMember key binder = Meta.member key $ fromBinder binder
|
||||
hide :: Binder -> Binder
|
||||
hide binder =
|
||||
updateBinderMeta binder "hidden" trueXObj
|
||||
|
||||
-- | Get the value of a string valued meta key.
|
||||
getString :: String -> MetaData -> String
|
||||
getString key meta = fromMaybe "" $ fmap (fromRight "" . unwrapStringXObj) (Meta.get key meta)
|
||||
|
@ -27,6 +27,7 @@ import Obj
|
||||
import qualified Set
|
||||
import SymPath
|
||||
import Util
|
||||
import qualified Meta
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- Errors
|
||||
@ -353,7 +354,7 @@ qualifySym typeEnv globalEnv localEnv xobj@(XObj (Sym path@(SymPath _ name) _) i
|
||||
)
|
||||
)
|
||||
>>= \(origin, (e, binder)) ->
|
||||
resolve (E.prj origin) (E.prj e) (binderXObj binder)
|
||||
resolve (E.prj origin) (E.prj e) binder
|
||||
>>= pure . Qualified
|
||||
)
|
||||
<> ((resolveMulti path (E.lookupInUsed localEnv globalEnv path)) >>= pure . Qualified)
|
||||
@ -362,8 +363,8 @@ qualifySym typeEnv globalEnv localEnv xobj@(XObj (Sym path@(SymPath _ name) _) i
|
||||
<> pure (Qualified xobj)
|
||||
)
|
||||
where
|
||||
resolve :: Env -> Env -> XObj -> Either QualificationError XObj
|
||||
resolve _ _ (XObj (Lst (XObj (Interface _ _) _ _ : _)) _ _) =
|
||||
resolve :: Env -> Env -> Binder -> Either QualificationError XObj
|
||||
resolve _ _ (Binder _ (XObj (Lst (XObj (Interface _ _) _ _ : _)) _ _)) =
|
||||
-- Before we return an interface, double check that it isn't shadowed by a local let-binding.
|
||||
case (E.searchValue localEnv path) of
|
||||
Right (e, Binder _ _) ->
|
||||
@ -371,25 +372,29 @@ qualifySym typeEnv globalEnv localEnv xobj@(XObj (Sym path@(SymPath _ name) _) i
|
||||
InternalEnv -> pure (XObj (Sym (getPath xobj) (LookupLocal (captureOrNot e localEnv))) i t)
|
||||
_ -> pure (XObj (InterfaceSym name) i t)
|
||||
_ -> pure (XObj (InterfaceSym name) i t)
|
||||
resolve _ _ x@(XObj (Lst (XObj (External (Just overrideName)) _ _ : _)) _ _) =
|
||||
resolve _ _ (Binder _ x@(XObj (Lst (XObj (External (Just overrideName)) _ _ : _)) _ _)) =
|
||||
pure (XObj (Sym (getPath x) (LookupGlobalOverride overrideName)) i t)
|
||||
resolve _ _ (XObj (Mod modenv _) _ _) =
|
||||
resolve _ _ (Binder _ (XObj (Mod modenv _) _ _)) =
|
||||
nakedInit modenv
|
||||
resolve origin found xobj' =
|
||||
if (isTypeDef xobj')
|
||||
then
|
||||
( (replaceLeft (FailedToFindSymbol xobj') (fmap (globalEnv,) (E.searchValue globalEnv path)))
|
||||
>>= \(origin', (e', binder)) -> resolve (E.prj origin') (E.prj e') (binderXObj binder)
|
||||
)
|
||||
else case envMode (E.prj found) of
|
||||
RecursionEnv -> pure (XObj (Sym (getPath xobj') LookupRecursive) i t)
|
||||
InternalEnv -> pure (XObj (Sym (getPath xobj') (LookupLocal (captureOrNot found origin))) i t)
|
||||
ExternalEnv -> pure (XObj (Sym (getPath xobj') (LookupGlobal (if isExternalFunction xobj' then ExternalCode else CarpLand) (definitionMode xobj'))) i t)
|
||||
resolve origin found (Binder meta xobj') =
|
||||
let cname = (Meta.getString (Meta.getCompilerKey Meta.CNAME) meta)
|
||||
modality = if (null cname)
|
||||
then (LookupGlobal (if isExternalFunction xobj' then ExternalCode else CarpLand) (definitionMode xobj'))
|
||||
else (LookupGlobalOverride cname)
|
||||
in if (isTypeDef xobj')
|
||||
then
|
||||
( (replaceLeft (FailedToFindSymbol xobj') (fmap (globalEnv,) (E.searchValue globalEnv path)))
|
||||
>>= \(origin', (e', binder)) -> resolve (E.prj origin') (E.prj e') binder
|
||||
)
|
||||
else case envMode (E.prj found) of
|
||||
RecursionEnv -> pure (XObj (Sym (getPath xobj') LookupRecursive) i t)
|
||||
InternalEnv -> pure (XObj (Sym (getPath xobj') (LookupLocal (captureOrNot found origin))) i t)
|
||||
ExternalEnv -> pure (XObj (Sym (getPath xobj') modality) i t)
|
||||
resolveMulti :: (Show e, E.Environment e) => SymPath -> [(e, Binder)] -> Either QualificationError XObj
|
||||
resolveMulti _ [] =
|
||||
Left (FailedToFindSymbol xobj)
|
||||
resolveMulti _ [(e, b)] =
|
||||
resolve (E.prj e) (E.prj e) (binderXObj b)
|
||||
resolve (E.prj e) (E.prj e) b
|
||||
resolveMulti spath xs =
|
||||
let localOnly = remove (E.envIsExternal . fst) xs
|
||||
paths = map (getModuleSym . (second binderXObj)) xs
|
||||
|
Loading…
Reference in New Issue
Block a user