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.

src/Emit.hs

@@ -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 _) _ _ : _ ->

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
+      do mod' <- getBinder e p
-        >>= \modu ->
+         old <- nextEnv Values mod'
-          nextEnv (modality e) modu
+         result <- mutate f (inj old) (SymPath ps name) binder
-            >>= \oldEnv ->
+         new' <- updateEnv Values (prj result) mod'
-              mutate f (inj oldEnv) (SymPath ps name) binder
+         addBinding e p new'
-                >>= \result ->
-                  updateEnv (modality e) (prj result) modu
-                    >>= addBinding e p
 
 -- | Insert a binding into an environment at the given path.
 insert :: Environment e => e -> SymPath -> Binder -> Either EnvironmentError e

src/Primitives.hs

@@ -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

test/interop.carp

@@ -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.")
+)

test/interop.h

@@ -0,0 +1,9 @@
+typedef int NESTED;
+
+int test_nested(NESTED x) {
+  return x;
+}
+
+int make_nested() {
+  return 1;
+}