mirror of
https://github.com/carp-lang/Carp.git
synced 2024-08-15 16:20:40 +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]
|
(defmacro private [name]
|
||||||
(eval (list 'meta-set! name "private" true)))
|
(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-)
|
(hidden and-)
|
||||||
(defndynamic and- [xs]
|
(defndynamic and- [xs]
|
||||||
; (defndynamic and- [xs] ; shorter but currently not entirely stable
|
; (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)
|
- [Callbacks](#callbacks)
|
||||||
- [Headerparse](#headerparse)
|
- [Headerparse](#headerparse)
|
||||||
|
|
||||||
|
|
||||||
## How Carp generates identifiers
|
## How Carp generates identifiers
|
||||||
|
|
||||||
When creating a function or def it might be useful to know what identifier gets
|
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
|
; => print_MINUS_first_MINUS_and_MINUS_add__String_Long
|
||||||
```
|
```
|
||||||
|
|
||||||
Looking at the examples should be clear enough but let's break it down:
|
Looking at the examples should help illustrate how Carp transforms identifiers
|
||||||
Carp will replace illegal characters in C with a string representation of them
|
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...)
|
(`- => _MINUS_`, `? => _QMARK_`, etc...)
|
||||||
If in modules it will prefix the identifier with the modules name.
|
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
|
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
|
non-generic signature to it to make Carp generate your function like in our
|
||||||
`true?` example.
|
`true?` example.
|
||||||
|
|
||||||
When creating bindings to a library it would be hard to coerce this logic into
|
This process is called *mangling* and is necessary to ensure that identifiers
|
||||||
creating the exact identifiers the library uses, this is why `register` and
|
that are valid in Carp but invalid in C don't produce invalid C code.
|
||||||
`register-type` accepts an optional argument to specify what identifiers to use:
|
|
||||||
|
### 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
|
```clojure
|
||||||
(defmodule CURL
|
(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"))
|
(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
|
## Managed types
|
||||||
|
|
||||||
In Carp types like `String` and `Array` are _managed_ types in that they are
|
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
|
do
|
||||||
appendToSrc (addIndent indent ++ "{\n")
|
appendToSrc (addIndent indent ++ "{\n")
|
||||||
let innerIndent = indent + indentAmount
|
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
|
ret <- visit innerIndent expr
|
||||||
when (ret /= "") $ appendToSrc (addIndent innerIndent ++ pathToC path ++ " = " ++ ret ++ ";\n")
|
when (ret /= "") $ appendToSrc (addIndent innerIndent ++ fullname ++ " = " ++ ret ++ ";\n")
|
||||||
delete innerIndent info
|
delete innerIndent info
|
||||||
appendToSrc (addIndent indent ++ "}\n")
|
appendToSrc (addIndent indent ++ "}\n")
|
||||||
pure ""
|
pure ""
|
||||||
@ -782,16 +784,18 @@ delete indent i = mapM_ deleterToC (infoDelete i)
|
|||||||
|
|
||||||
defnToDeclaration :: MetaData -> SymPath -> [XObj] -> Ty -> String
|
defnToDeclaration :: MetaData -> SymPath -> [XObj] -> Ty -> String
|
||||||
defnToDeclaration meta path@(SymPath _ name) argList retTy =
|
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)
|
annotationsStr = joinWith " " (map strToC annotations)
|
||||||
sep = if not (null annotationsStr) then " " else ""
|
sep = if not (null annotationsStr) then " " else ""
|
||||||
|
fullname = if (null override) then (pathToC path) else override
|
||||||
in annotationsStr ++ sep
|
in annotationsStr ++ sep
|
||||||
++ if name == "main"
|
++ if name == "main"
|
||||||
then "int main(int argc, char** argv)"
|
then "int main(int argc, char** argv)"
|
||||||
else
|
else
|
||||||
let retTyAsC = tyToCLambdaFix retTy
|
let retTyAsC = tyToCLambdaFix retTy
|
||||||
paramsAsC = paramListToC argList
|
paramsAsC = paramListToC argList
|
||||||
in (retTyAsC ++ " " ++ pathToC path ++ "(" ++ paramsAsC ++ ")")
|
in (retTyAsC ++ " " ++ fullname ++ "(" ++ paramsAsC ++ ")")
|
||||||
where
|
where
|
||||||
strToC (XObj (Str s) _ _) = s
|
strToC (XObj (Str s) _ _) = s
|
||||||
strToC xobj = pretty xobj
|
strToC xobj = pretty xobj
|
||||||
@ -895,9 +899,11 @@ toDeclaration (Binder meta xobj@(XObj (Lst xobjs) _ ty)) =
|
|||||||
in defnToDeclaration meta path argList retTy ++ ";\n"
|
in defnToDeclaration meta path argList retTy ++ ";\n"
|
||||||
[XObj Def _ _, XObj (Sym path _) _ _, _] ->
|
[XObj Def _ _, XObj (Sym path _) _ _, _] ->
|
||||||
let Just t = ty
|
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)
|
in if (isUnit t)
|
||||||
then ""
|
then ""
|
||||||
else tyToCLambdaFix t ++ " " ++ pathToC path ++ ";\n"
|
else tyToCLambdaFix t ++ " " ++ fullname ++ ";\n"
|
||||||
XObj (Deftype t) _ _ : XObj (Sym path _) _ _ : rest ->
|
XObj (Deftype t) _ _ : XObj (Sym path _) _ _ : rest ->
|
||||||
defStructToDeclaration t path rest
|
defStructToDeclaration t path rest
|
||||||
XObj (DefSumtype t) _ _ : XObj (Sym _ _) _ _ : rest ->
|
XObj (DefSumtype t) _ _ : XObj (Sym _ _) _ _ : rest ->
|
||||||
|
43
src/Meta.hs
43
src/Meta.hs
@ -8,6 +8,10 @@ module Meta
|
|||||||
Meta.member,
|
Meta.member,
|
||||||
binderMember,
|
binderMember,
|
||||||
hide,
|
hide,
|
||||||
|
getString,
|
||||||
|
getCompilerKey,
|
||||||
|
validateAndSet,
|
||||||
|
CompilerKey(..),
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
|
||||||
@ -16,6 +20,41 @@ import qualified Map
|
|||||||
import Obj
|
import Obj
|
||||||
import SymPath
|
import SymPath
|
||||||
import Types
|
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.
|
-- | A temporary binder for meta calls on symbols that haven't been declared yet.
|
||||||
-- Used in situations such as:
|
-- Used in situations such as:
|
||||||
@ -61,3 +100,7 @@ binderMember key binder = Meta.member key $ fromBinder binder
|
|||||||
hide :: Binder -> Binder
|
hide :: Binder -> Binder
|
||||||
hide binder =
|
hide binder =
|
||||||
updateBinderMeta binder "hidden" trueXObj
|
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 qualified Set
|
||||||
import SymPath
|
import SymPath
|
||||||
import Util
|
import Util
|
||||||
|
import qualified Meta
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
-- Errors
|
-- Errors
|
||||||
@ -353,7 +354,7 @@ qualifySym typeEnv globalEnv localEnv xobj@(XObj (Sym path@(SymPath _ name) _) i
|
|||||||
)
|
)
|
||||||
)
|
)
|
||||||
>>= \(origin, (e, binder)) ->
|
>>= \(origin, (e, binder)) ->
|
||||||
resolve (E.prj origin) (E.prj e) (binderXObj binder)
|
resolve (E.prj origin) (E.prj e) binder
|
||||||
>>= pure . Qualified
|
>>= pure . Qualified
|
||||||
)
|
)
|
||||||
<> ((resolveMulti path (E.lookupInUsed localEnv globalEnv path)) >>= 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)
|
<> pure (Qualified xobj)
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
resolve :: Env -> Env -> XObj -> Either QualificationError XObj
|
resolve :: Env -> Env -> Binder -> Either QualificationError XObj
|
||||||
resolve _ _ (XObj (Lst (XObj (Interface _ _) _ _ : _)) _ _) =
|
resolve _ _ (Binder _ (XObj (Lst (XObj (Interface _ _) _ _ : _)) _ _)) =
|
||||||
-- Before we return an interface, double check that it isn't shadowed by a local let-binding.
|
-- Before we return an interface, double check that it isn't shadowed by a local let-binding.
|
||||||
case (E.searchValue localEnv path) of
|
case (E.searchValue localEnv path) of
|
||||||
Right (e, Binder _ _) ->
|
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)
|
InternalEnv -> pure (XObj (Sym (getPath xobj) (LookupLocal (captureOrNot e localEnv))) i t)
|
||||||
_ -> pure (XObj (InterfaceSym name) i t)
|
_ -> pure (XObj (InterfaceSym name) 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)
|
pure (XObj (Sym (getPath x) (LookupGlobalOverride overrideName)) i t)
|
||||||
resolve _ _ (XObj (Mod modenv _) _ _) =
|
resolve _ _ (Binder _ (XObj (Mod modenv _) _ _)) =
|
||||||
nakedInit modenv
|
nakedInit modenv
|
||||||
resolve origin found xobj' =
|
resolve origin found (Binder meta xobj') =
|
||||||
if (isTypeDef xobj')
|
let cname = (Meta.getString (Meta.getCompilerKey Meta.CNAME) meta)
|
||||||
then
|
modality = if (null cname)
|
||||||
( (replaceLeft (FailedToFindSymbol xobj') (fmap (globalEnv,) (E.searchValue globalEnv path)))
|
then (LookupGlobal (if isExternalFunction xobj' then ExternalCode else CarpLand) (definitionMode xobj'))
|
||||||
>>= \(origin', (e', binder)) -> resolve (E.prj origin') (E.prj e') (binderXObj binder)
|
else (LookupGlobalOverride cname)
|
||||||
)
|
in if (isTypeDef xobj')
|
||||||
else case envMode (E.prj found) of
|
then
|
||||||
RecursionEnv -> pure (XObj (Sym (getPath xobj') LookupRecursive) i t)
|
( (replaceLeft (FailedToFindSymbol xobj') (fmap (globalEnv,) (E.searchValue globalEnv path)))
|
||||||
InternalEnv -> pure (XObj (Sym (getPath xobj') (LookupLocal (captureOrNot found origin))) i t)
|
>>= \(origin', (e', binder)) -> resolve (E.prj origin') (E.prj e') binder
|
||||||
ExternalEnv -> pure (XObj (Sym (getPath xobj') (LookupGlobal (if isExternalFunction xobj' then ExternalCode else CarpLand) (definitionMode xobj'))) i t)
|
)
|
||||||
|
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 :: (Show e, E.Environment e) => SymPath -> [(e, Binder)] -> Either QualificationError XObj
|
||||||
resolveMulti _ [] =
|
resolveMulti _ [] =
|
||||||
Left (FailedToFindSymbol xobj)
|
Left (FailedToFindSymbol xobj)
|
||||||
resolveMulti _ [(e, b)] =
|
resolveMulti _ [(e, b)] =
|
||||||
resolve (E.prj e) (E.prj e) (binderXObj b)
|
resolve (E.prj e) (E.prj e) b
|
||||||
resolveMulti spath xs =
|
resolveMulti spath xs =
|
||||||
let localOnly = remove (E.envIsExternal . fst) xs
|
let localOnly = remove (E.envIsExternal . fst) xs
|
||||||
paths = map (getModuleSym . (second binderXObj)) xs
|
paths = map (getModuleSym . (second binderXObj)) xs
|
||||||
|
Loading…
Reference in New Issue
Block a user