Merge pull request #5248 from roc-lang/glue-result-option

glue + tests for result and option

crates/glue/src/RustGlue.roc

@@ -41,7 +41,7 @@ convertTypesToFile = \types ->
 
                 TagUnion (NonRecursive { name, tags, discriminantSize, discriminantOffset }) ->
                     if !(List.isEmpty tags) then
-                        generateNonRecursiveTagUnion buf types id name tags discriminantSize discriminantOffset None
+                        generateNonRecursiveTagUnion buf types id name tags discriminantSize discriminantOffset
                     else
                         buf
 
@@ -307,15 +307,89 @@ generateEnumTagsDebug = \name ->
     \accum, tagName ->
         Str.concat accum "\(indent)\(indent)\(indent)Self::\(tagName) => f.write_str(\"\(name)::\(tagName)\"),\n"
 
-generateNonRecursiveTagUnion = \buf, types, id, name, tags, discriminantSize, discriminantOffset, _nullTagIndex ->
+generateConstructorFunctions : Str, Types, Str, List { name : Str, payload : [Some TypeId, None] } -> Str
+generateConstructorFunctions = \buf, types, tagUnionType, tags ->
+    buf
+        |> Str.concat "\n\nimpl \(tagUnionType) {\n"
+        |> \b -> List.walk tags b \accum, r -> generateConstructorFunction accum types tagUnionType r.name r.payload
+        |> Str.concat "\n}\n\n"
+
+generateConstructorFunction : Str, Types, Str, Str, [Some TypeId, None] -> Str
+generateConstructorFunction = \buf, types, tagUnionType, name, optPayload ->
+    when optPayload is
+        None ->
+            """
+            \(buf)
+
+                pub fn \(name)() -> Self {
+                    Self {
+                        discriminant: discriminant_\(tagUnionType)::\(name),
+                        payload: union_\(tagUnionType) {
+                            \(name): (),
+                        }
+                    }
+                }
+            """
+
+        Some payloadId ->
+            payloadType = typeName types payloadId
+
+            """
+            \(buf)
+
+                pub fn \(name)(payload: \(payloadType)) -> Self {
+                    Self {
+                        discriminant: discriminant_\(tagUnionType)::\(name),
+                        payload: union_\(tagUnionType) {
+                            \(name): core::mem::ManuallyDrop::new(payload),
+                        }
+                    }
+                }
+            """
+
+generateDestructorFunctions : Str, Types, Str, List { name : Str, payload : [Some TypeId, None] } -> Str
+generateDestructorFunctions = \buf, types, tagUnionType, tags ->
+    buf
+        |> Str.concat "\n\nimpl \(tagUnionType) {\n"
+        |> \b -> List.walk tags b \accum, r -> generateDestructorFunction accum types tagUnionType r.name r.payload
+        |> Str.concat "\n}\n\n"
+
+generateDestructorFunction : Str, Types, Str, Str, [Some TypeId, None] -> Str
+generateDestructorFunction = \buf, types, tagUnionType, name, optPayload ->
+    when optPayload is
+        None ->
+            """
+            \(buf)
+
+                pub fn is_\(name)(&self) -> bool {
+                    matches!(self.discriminant, discriminant_\(tagUnionType)::\(name))
+                }
+            """
+
+        Some payloadId ->
+            payloadType = typeName types payloadId
+
+            """
+            \(buf)
+
+                pub fn unwrap_\(name)(mut self) -> \(payloadType) {
+                    debug_assert_eq!(self.discriminant, discriminant_\(tagUnionType)::\(name));
+                    unsafe { core::mem::ManuallyDrop::take(&mut self.payload.\(name)) }
+                }
+
+                pub fn is_\(name)(&self) -> bool {
+                    matches!(self.discriminant, discriminant_\(tagUnionType)::\(name))
+                }
+            """
+
+generateNonRecursiveTagUnion : Str, Types, TypeId, Str, List { name : Str, payload : [Some TypeId, None] }, U32, U32 -> Str
+generateNonRecursiveTagUnion = \buf, types, id, name, tags, discriminantSize, discriminantOffset ->
     escapedName = escapeKW name
     discriminantName = "discriminant_\(escapedName)"
+    unionName = "union_\(escapedName)"
     discriminantOffsetStr = Num.toStr discriminantOffset
     tagNames = List.map tags \{ name: n } -> n
-    # self = "self"
     selfMut = "self"
-    # other = "other"
-    unionName = escapedName
 
     buf
     |> generateDiscriminant types discriminantName tagNames discriminantSize
@@ -349,6 +423,16 @@ generateNonRecursiveTagUnion = \buf, types, id, name, tags, discriminantSize, di
 
         """
     |> Str.concat "// TODO: NonRecursive TagUnion constructor impls\n\n"
+    |> Str.concat
+        """
+        #[repr(C)]
+        pub struct \(escapedName) {
+            payload: union_\(escapedName),
+            discriminant: discriminant_\(escapedName),
+        }
+        """
+    |> generateDestructorFunctions types escapedName tags
+    |> generateConstructorFunctions types escapedName tags
     |> \b ->
         type = Types.shape types id
         if cannotDeriveCopy types type then
@@ -415,7 +499,7 @@ generateTagUnionDropPayload = \buf, types, selfMut, tags, discriminantName, disc
         |> writeTagImpls tags discriminantName indents \name, payload ->
             when payload is
                 Some id if cannotDeriveCopy types (Types.shape types id) ->
-                    "unsafe {{ core::mem::ManuallyDrop::drop(&mut \(selfMut).\(name)) }},"
+                    "unsafe {{ core::mem::ManuallyDrop::drop(&mut \(selfMut).payload.\(name)) }},"
 
                 _ ->
                     # If it had no payload, or if the payload had no pointers,
@@ -480,10 +564,11 @@ generateDiscriminant = \buf, types, name, tags, size ->
 
 generateUnionField = \types ->
     \accum, { name: fieldName, payload } ->
+        escapedFieldName = escapeKW fieldName
+
         when payload is
             Some id ->
                 typeStr = typeName types id
-                escapedFieldName = escapeKW fieldName
 
                 type = Types.shape types id
                 fullTypeStr =
@@ -495,11 +580,11 @@ generateUnionField = \types ->
                     else
                         typeStr
 
-                Str.concat accum "\(indent)\(escapedFieldName): std::mem::ManuallyDrop<\(fullTypeStr)>,\n"
+                Str.concat accum "\(indent)\(escapedFieldName): \(fullTypeStr),\n"
 
             None ->
-                # If there's no payload, we don't need a discriminant for it.
-                accum
+                # use unit as the payload
+                Str.concat accum "\(indent)\(escapedFieldName): (),\n"
 
 generateNullableUnwrapped = \buf, _types, _id, _name, _nullTag, _nonNullTag, _nonNullPayload, _whichTagIsNull ->
     Str.concat buf "// TODO: TagUnion NullableUnwrapped\n\n"

crates/glue/src/types.rs

@@ -660,7 +660,7 @@ impl From<&Types> for roc_type::Types {
             deps,
             entrypoints,
             sizes: types.sizes.as_slice().into(),
-            types: types.types.iter().map(|t| t.into()).collect(),
+            types: types.types.iter().map(roc_type::RocType::from).collect(),
             typesByName: types_by_name,
             target: types.target.into(),
         }

crates/glue/tests/fixtures/option/app.roc

@@ -0,0 +1,11 @@
+app "app"
+    packages { pf: "platform.roc" }
+    imports []
+    provides [main] to pf
+
+main : Bool -> [ Some Str, None ] 
+main = \returnStr ->
+    if returnStr then
+        Some "Hello World!"
+    else
+        None

crates/glue/tests/fixtures/option/platform.roc

@@ -0,0 +1,9 @@
+platform "test-platform"
+    requires {} { main : Bool -> [ Some Str, None ] }
+    exposes []
+    packages {}
+    imports []
+    provides [mainForHost]
+
+mainForHost : Bool -> [ Some Str, None ]
+mainForHost = \u -> main u

crates/glue/tests/fixtures/option/src/lib.rs

@@ -0,0 +1,62 @@
+mod test_glue;
+
+#[no_mangle]
+pub extern "C" fn rust_main() -> i32 {
+    let string = test_glue::mainForHost(true);
+    println!("Answer was: {:?}", string.unwrap_Some()); // Debug
+                                                        //
+    let integer = test_glue::mainForHost(false);
+    println!("Answer was: {:?}", integer.discriminant()); // Debug
+
+    // Exit code
+    0
+}
+
+// Externs required by roc_std and by the Roc app
+
+use core::ffi::c_void;
+use std::ffi::CStr;
+use std::os::raw::c_char;
+
+#[no_mangle]
+pub unsafe extern "C" fn roc_alloc(size: usize, _alignment: u32) -> *mut c_void {
+    return libc::malloc(size);
+}
+
+#[no_mangle]
+pub unsafe extern "C" fn roc_realloc(
+    c_ptr: *mut c_void,
+    new_size: usize,
+    _old_size: usize,
+    _alignment: u32,
+) -> *mut c_void {
+    return libc::realloc(c_ptr, new_size);
+}
+
+#[no_mangle]
+pub unsafe extern "C" fn roc_dealloc(c_ptr: *mut c_void, _alignment: u32) {
+    return libc::free(c_ptr);
+}
+
+#[no_mangle]
+pub unsafe extern "C" fn roc_panic(c_ptr: *mut c_void, tag_id: u32) {
+    match tag_id {
+        0 => {
+            let slice = CStr::from_ptr(c_ptr as *const c_char);
+            let string = slice.to_str().unwrap();
+            eprintln!("Roc hit a panic: {}", string);
+            std::process::exit(1);
+        }
+        _ => todo!(),
+    }
+}
+
+#[no_mangle]
+pub unsafe extern "C" fn roc_memcpy(dst: *mut c_void, src: *mut c_void, n: usize) -> *mut c_void {
+    libc::memcpy(dst, src, n)
+}
+
+#[no_mangle]
+pub unsafe extern "C" fn roc_memset(dst: *mut c_void, c: i32, n: usize) -> *mut c_void {
+    libc::memset(dst, c, n)
+}

crates/glue/tests/fixtures/rocresult/app.roc

@@ -0,0 +1,11 @@
+app "app"
+    packages { pf: "platform.roc" }
+    imports []
+    provides [main] to pf
+
+main : Bool -> Result Str I32
+main = \returnStr ->
+    if returnStr then
+        Ok "Hello World!"
+    else
+        Err 42

crates/glue/tests/fixtures/rocresult/platform.roc

@@ -0,0 +1,9 @@
+platform "test-platform"
+    requires {} { main : Bool -> Result Str I32 }
+    exposes []
+    packages {}
+    imports []
+    provides [mainForHost]
+
+mainForHost : Bool -> Result Str I32
+mainForHost = \u -> main u

crates/glue/tests/fixtures/rocresult/src/lib.rs

@@ -0,0 +1,62 @@
+mod test_glue;
+
+#[no_mangle]
+pub extern "C" fn rust_main() -> i32 {
+    let string = test_glue::mainForHost(true);
+    println!("Answer was: {:?}", string); // Debug
+                                          //
+    let integer = test_glue::mainForHost(false);
+    println!("Answer was: {:?}", integer); // Debug
+
+    // Exit code
+    0
+}
+
+// Externs required by roc_std and by the Roc app
+
+use core::ffi::c_void;
+use std::ffi::CStr;
+use std::os::raw::c_char;
+
+#[no_mangle]
+pub unsafe extern "C" fn roc_alloc(size: usize, _alignment: u32) -> *mut c_void {
+    return libc::malloc(size);
+}
+
+#[no_mangle]
+pub unsafe extern "C" fn roc_realloc(
+    c_ptr: *mut c_void,
+    new_size: usize,
+    _old_size: usize,
+    _alignment: u32,
+) -> *mut c_void {
+    return libc::realloc(c_ptr, new_size);
+}
+
+#[no_mangle]
+pub unsafe extern "C" fn roc_dealloc(c_ptr: *mut c_void, _alignment: u32) {
+    return libc::free(c_ptr);
+}
+
+#[no_mangle]
+pub unsafe extern "C" fn roc_panic(c_ptr: *mut c_void, tag_id: u32) {
+    match tag_id {
+        0 => {
+            let slice = CStr::from_ptr(c_ptr as *const c_char);
+            let string = slice.to_str().unwrap();
+            eprintln!("Roc hit a panic: {}", string);
+            std::process::exit(1);
+        }
+        _ => todo!(),
+    }
+}
+
+#[no_mangle]
+pub unsafe extern "C" fn roc_memcpy(dst: *mut c_void, src: *mut c_void, n: usize) -> *mut c_void {
+    libc::memcpy(dst, src, n)
+}
+
+#[no_mangle]
+pub unsafe extern "C" fn roc_memset(dst: *mut c_void, c: i32, n: usize) -> *mut c_void {
+    libc::memset(dst, c, n)
+}

crates/glue/tests/test_glue_cli.rs

@@ -74,24 +74,24 @@ mod glue_cli_run {
         basic_record:"basic-record" => "Record was: MyRcd { b: 42, a: 1995 }\n",
         nested_record:"nested-record" => "Record was: Outer { y: \"foo\", z: [1, 2], x: Inner { b: 24.0, a: 5 } }\n",
         enumeration:"enumeration" => "tag_union was: MyEnum::Foo, Bar is: MyEnum::Bar, Baz is: MyEnum::Baz\n",
-        // union_with_padding:"union-with-padding" => indoc!(r#"
-        //     tag_union was: NonRecursive::Foo("This is a test")
-        //     `Foo "small str"` is: NonRecursive::Foo("small str")
-        //     `Foo "A long enough string to not be small"` is: NonRecursive::Foo("A long enough string to not be small")
-        //     `Bar 123` is: NonRecursive::Bar(123)
-        //     `Baz` is: NonRecursive::Baz
-        //     `Blah 456` is: NonRecursive::Blah(456)
-        // "#),
         single_tag_union:"single-tag-union" => indoc!(r#"
             tag_union was: SingleTagUnion::OneTag
         "#),
-        // union_without_padding:"union-without-padding" => indoc!(r#"
-        //     tag_union was: NonRecursive::Foo("This is a test")
-        //     `Foo "small str"` is: NonRecursive::Foo("small str")
-        //     `Bar 123` is: NonRecursive::Bar(123)
-        //     `Baz` is: NonRecursive::Baz
-        //     `Blah 456` is: NonRecursive::Blah(456)
-        // "#),
+        //        union_with_padding:"union-with-padding" => indoc!(r#"
+        //            tag_union was: NonRecursive::Foo("This is a test")
+        //            `Foo "small str"` is: NonRecursive::Foo("small str")
+        //            `Foo "A long enough string to not be small"` is: NonRecursive::Foo("A long enough string to not be small")
+        //            `Bar 123` is: NonRecursive::Bar(123)
+        //            `Baz` is: NonRecursive::Baz
+        //            `Blah 456` is: NonRecursive::Blah(456)
+        //        "#),
+        //        union_without_padding:"union-without-padding" => indoc!(r#"
+        //            tag_union was: NonRecursive::Foo("This is a test")
+        //            `Foo "small str"` is: NonRecursive::Foo("small str")
+        //            `Bar 123` is: NonRecursive::Bar(123)
+        //            `Baz` is: NonRecursive::Baz
+        //            `Blah 456` is: NonRecursive::Blah(456)
+        //        "#),
         // nullable_wrapped:"nullable-wrapped" => indoc!(r#"
         //     tag_union was: StrFingerTree::More("foo", StrFingerTree::More("bar", StrFingerTree::Empty))
         //     `More "small str" (Single "other str")` is: StrFingerTree::More("small str", StrFingerTree::Single("other str"))
@@ -125,6 +125,14 @@ mod glue_cli_run {
         arguments:"arguments" => indoc!(r#"
             Answer was: 84
         "#),
+        rocresult:"rocresult" => indoc!(r#"
+            Answer was: RocOk(ManuallyDrop { value: "Hello World!" })
+            Answer was: RocErr(ManuallyDrop { value: 42 })
+        "#),
+        option:"option" => indoc!(r#"
+            Answer was: "Hello World!"
+            Answer was: discriminant_U1::None
+        "#),
     }
 
     fn check_for_tests(all_fixtures: &mut roc_collections::VecSet<String>) {