mirror of
https://github.com/carp-lang/Carp.git
synced 2024-09-11 05:25:28 +03:00
fix: permit registering types in modules (#1362)
Historically, we did not support calling (register-type) within a module--while there were instances of such calls (even in our core library!) they were not properly handled in two ways: 1. They weren't added to the right place in the type environment. 2. Their corresponding emitted code wasn't correct. This commit enables registering types in modules by making a few fixes: 1. Fix the logic in environment mutations -- before, adding a type to an environment would result in traversing the environment chain incorrectly. This is now fixed (we traverse modules and retrieve a type environment only at the end of the traversal). 2. Fix the typedef emission for registered types--it previously emitted the C code for the type path, not for the type definition (it called pathToC not tyToC). This will now allow authors of wrapper libraries to add more structure to their Carp wrapper APIs. This commit also adds a test to check the behavior.
This commit is contained in:
parent
380945bf32
commit
1175bb795b
@ -921,7 +921,7 @@ toDeclaration (Binder meta xobj@(XObj (Lst xobjs) _ ty)) =
|
||||
XObj (ExternalType Nothing) _ _ : _ ->
|
||||
""
|
||||
XObj (ExternalType (Just override)) _ _ : XObj (Sym path _) _ _ : _ ->
|
||||
"typedef " ++ override ++ " " ++ pathToC path ++ ";"
|
||||
"typedef " ++ override ++ " " ++ tyToC (StructTy (ConcreteNameTy path) []) ++ ";"
|
||||
XObj (Command _) _ _ : _ ->
|
||||
""
|
||||
XObj (Primitive _) _ _ : _ ->
|
||||
|
19
src/Env.hs
19
src/Env.hs
@ -374,15 +374,18 @@ mutate :: Environment e => (EnvironmentProducer e) -> e -> SymPath -> Binder ->
|
||||
mutate f e path binder = go path
|
||||
where
|
||||
go (SymPath [] name) = f e name binder
|
||||
go (SymPath (p : []) name) =
|
||||
do mod' <- getBinder e p
|
||||
env' <- nextEnv (modality e) mod'
|
||||
res <- mutate f (inj env') (SymPath [] name) binder
|
||||
new' <- updateEnv (modality e) (prj res) mod'
|
||||
addBinding e p new'
|
||||
go (SymPath (p : ps) name) =
|
||||
getBinder e p
|
||||
>>= \modu ->
|
||||
nextEnv (modality e) modu
|
||||
>>= \oldEnv ->
|
||||
mutate f (inj oldEnv) (SymPath ps name) binder
|
||||
>>= \result ->
|
||||
updateEnv (modality e) (prj result) modu
|
||||
>>= addBinding e p
|
||||
do mod' <- getBinder e p
|
||||
old <- nextEnv Values mod'
|
||||
result <- mutate f (inj old) (SymPath ps name) binder
|
||||
new' <- updateEnv Values (prj result) mod'
|
||||
addBinding e p new'
|
||||
|
||||
-- | Insert a binding into an environment at the given path.
|
||||
insert :: Environment e => e -> SymPath -> Binder -> Either EnvironmentError e
|
||||
|
@ -241,7 +241,7 @@ primitiveRegisterType x ctx _ = pure (toEvalError ctx x RegisterTypeError)
|
||||
-- | Register an external type that has no fields.
|
||||
primitiveRegisterTypeWithoutFields :: Context -> String -> Maybe String -> IO (Context, Either EvalError XObj)
|
||||
primitiveRegisterTypeWithoutFields ctx t override = do
|
||||
let path = SymPath [] t
|
||||
let path = SymPath (contextPath ctx) t
|
||||
typeDefinition = XObj (Lst [XObj (ExternalType override) Nothing Nothing, XObj (Sym path Symbol) Nothing Nothing]) Nothing (Just TypeTy)
|
||||
-- TODO: Support registering types in modules
|
||||
case insertTypeBinder ctx (markQualified path) (toBinder typeDefinition) of
|
||||
|
17
test/interop.carp
Normal file
17
test/interop.carp
Normal file
@ -0,0 +1,17 @@
|
||||
(relative-include "interop.h")
|
||||
|
||||
(load "Test.carp")
|
||||
(use Test)
|
||||
|
||||
(defmodule Wrap
|
||||
(register-type Nested "NESTED")
|
||||
(register make-nested (Fn [] Wrap.Nested) "make_nested")
|
||||
(register test-nested (Fn [Wrap.Nested] Int) "test_nested")
|
||||
)
|
||||
|
||||
(deftest test
|
||||
(assert-equal test
|
||||
&1
|
||||
&(Wrap.test-nested (Wrap.make-nested))
|
||||
"Types registered in modules are emitted correctly.")
|
||||
)
|
9
test/interop.h
Normal file
9
test/interop.h
Normal file
@ -0,0 +1,9 @@
|
||||
typedef int NESTED;
|
||||
|
||||
int test_nested(NESTED x) {
|
||||
return x;
|
||||
}
|
||||
|
||||
int make_nested() {
|
||||
return 1;
|
||||
}
|
Loading…
Reference in New Issue
Block a user