Generate derive keys for tags

crates/compiler/derive/src/hash.rs

@@ -22,6 +22,7 @@ use crate::{synth_var, util::Env, DerivedBody};
 pub(crate) fn derive_hash(env: &mut Env<'_>, key: FlatHashKey, def_symbol: Symbol) -> DerivedBody {
     let (body, body_type) = match key {
         FlatHashKey::Record(fields) => hash_record(env, def_symbol, fields),
+        FlatHashKey::TagUnion(_) => todo!(),
     };
 
     let specialization_lambda_sets =

crates/compiler/derive_key/src/encoding.rs

@@ -5,7 +5,7 @@ use roc_module::{
 use roc_types::subs::{Content, FlatType, Subs, Variable};
 
 use crate::{
-    util::{check_derivable_ext_var, debug_name_record},
+    util::{check_derivable_ext_var, debug_name_record, debug_name_tag},
     DeriveError,
 };
 
@@ -32,19 +32,7 @@ impl FlatEncodableKey {
             FlatEncodableKey::Set() => "set".to_string(),
             FlatEncodableKey::Dict() => "dict".to_string(),
             FlatEncodableKey::Record(fields) => debug_name_record(fields),
-            FlatEncodableKey::TagUnion(tags) => {
+            FlatEncodableKey::TagUnion(tags) => debug_name_tag(tags),
-                let mut str = String::from('[');
-                tags.iter().enumerate().for_each(|(i, (tag, arity))| {
-                    if i > 0 {
-                        str.push(',');
-                    }
-                    str.push_str(tag.0.as_str());
-                    str.push(' ');
-                    str.push_str(&arity.to_string());
-                });
-                str.push(']');
-                str
-            }
         }
     }
 }

crates/compiler/derive_key/src/hash.rs

@@ -1,8 +1,11 @@
-use roc_module::{ident::Lowercase, symbol::Symbol};
+use roc_module::{
+    ident::{Lowercase, TagName},
+    symbol::Symbol,
+};
 use roc_types::subs::{Content, FlatType, Subs, Variable};
 
 use crate::{
-    util::{check_derivable_ext_var, debug_name_record},
+    util::{check_derivable_ext_var, debug_name_record, debug_name_tag},
     DeriveError,
 };
 
@@ -18,12 +21,14 @@ pub enum FlatHash {
 pub enum FlatHashKey {
     // Unfortunate that we must allocate here, c'est la vie
     Record(Vec<Lowercase>),
+    TagUnion(Vec<(TagName, u16)>),
 }
 
 impl FlatHashKey {
     pub(crate) fn debug_name(&self) -> String {
         match self {
             FlatHashKey::Record(fields) => debug_name_record(fields),
+            FlatHashKey::TagUnion(tags) => debug_name_tag(tags),
         }
     }
 }
@@ -60,16 +65,40 @@ impl FlatHash {
 
                     Ok(Key(FlatHashKey::Record(field_names)))
                 }
-                FlatType::TagUnion(_tags, _ext) | FlatType::RecursiveTagUnion(_, _tags, _ext) => {
+                FlatType::TagUnion(tags, ext) | FlatType::RecursiveTagUnion(_, tags, ext) => {
-                    Err(Underivable) // yet
+                    // The recursion var doesn't matter, because the derived implementation will only
-                }
+                    // look on the surface of the tag union type, and more over the payloads of the
-                FlatType::FunctionOrTagUnion(_name_index, _, _) => {
+                    // arguments will be left generic for the monomorphizer to fill in with the
-                    Err(Underivable) // yet
+                    // appropriate type. That is,
+                    //   [ A t1, B t1 t2 ]
+                    // and
+                    //   [ A t1, B t1 t2 ] as R
+                    // look the same on the surface, because `R` is only somewhere inside of the
+                    // `t`-prefixed payload types.
+                    let (tags_iter, ext) = tags.unsorted_tags_and_ext(subs, ext);
+
+                    check_derivable_ext_var(subs, ext, |ext| {
+                        matches!(ext, Content::Structure(FlatType::EmptyTagUnion))
+                    })?;
+
+                    let mut tag_names_and_payload_sizes: Vec<_> = tags_iter
+                        .tags
+                        .into_iter()
+                        .map(|(name, payload_slice)| {
+                            let payload_size = payload_slice.len();
+                            (name.clone(), payload_size as _)
+                        })
+                        .collect();
+
+                    tag_names_and_payload_sizes.sort_by(|(t1, _), (t2, _)| t1.cmp(t2));
+
+                    Ok(Key(FlatHashKey::TagUnion(tag_names_and_payload_sizes)))
                 }
+                FlatType::FunctionOrTagUnion(name_index, _, _) => Ok(Key(FlatHashKey::TagUnion(
+                    vec![(subs[name_index].clone(), 0)],
+                ))),
                 FlatType::EmptyRecord => Ok(Key(FlatHashKey::Record(vec![]))),
-                FlatType::EmptyTagUnion => {
+                FlatType::EmptyTagUnion => Ok(Key(FlatHashKey::TagUnion(vec![]))),
-                    Err(Underivable) // yet
-                }
                 //
                 FlatType::Erroneous(_) => Err(Underivable),
                 FlatType::Func(..) => Err(Underivable),

crates/compiler/derive_key/src/util.rs

@@ -1,4 +1,4 @@
-use roc_module::ident::Lowercase;
+use roc_module::ident::{Lowercase, TagName};
 use roc_types::subs::{Content, Subs, Variable};
 
 use crate::DeriveError;
@@ -42,3 +42,17 @@ pub(crate) fn debug_name_record(fields: &[Lowercase]) -> String {
     str.push('}');
     str
 }
+
+pub(crate) fn debug_name_tag(tags: &[(TagName, u16)]) -> String {
+    let mut str = String::from('[');
+    tags.iter().enumerate().for_each(|(i, (tag, arity))| {
+        if i > 0 {
+            str.push(',');
+        }
+        str.push_str(tag.0.as_str());
+        str.push(' ');
+        str.push_str(&arity.to_string());
+    });
+    str.push(']');
+    str
+}

crates/compiler/test_derive/src/hash.rs

@@ -27,6 +27,20 @@ test_key_eq! {
         v!({ c: v!(U8), a: v!(U8), b: v!(U8), })
     explicit_empty_record_and_implicit_empty_record:
         v!(EMPTY_RECORD), v!({})
+
+    same_tag_union:
+        v!([ A v!(U8) v!(STR), B v!(STR) ]), v!([ A v!(U8) v!(STR), B v!(STR) ])
+    same_tag_union_tags_diff_types:
+        v!([ A v!(U8) v!(U8), B v!(U8) ]), v!([ A v!(STR) v!(STR), B v!(STR) ])
+    same_tag_union_tags_any_order:
+        v!([ A v!(U8) v!(U8), B v!(U8), C ]), v!([ C, B v!(STR), A v!(STR) v!(STR) ])
+    explicit_empty_tag_union_and_implicit_empty_tag_union:
+        v!(EMPTY_TAG_UNION), v!([])
+
+    same_recursive_tag_union:
+        v!([ Nil, Cons v!(^lst)] as lst), v!([ Nil, Cons v!(^lst)] as lst)
+    same_tag_union_and_recursive_tag_union_fields:
+        v!([ Nil, Cons v!(STR)]), v!([ Nil, Cons v!(^lst)] as lst)
 }
 
 test_key_neq! {
@@ -36,6 +50,13 @@ test_key_neq! {
         v!({ a: v!(U8), }), v!({ b: v!(U8), })
     record_empty_vs_nonempty:
         v!(EMPTY_RECORD), v!({ a: v!(U8), })
+
+    different_tag_union_tags:
+        v!([ A v!(U8) ]), v!([ B v!(U8) ])
+    tag_union_empty_vs_nonempty:
+        v!(EMPTY_TAG_UNION), v!([ B v!(U8) ])
+    different_recursive_tag_union_tags:
+        v!([ Nil, Cons v!(^lst) ] as lst), v!([ Nil, Next v!(^lst) ] as lst)
 }
 
 #[test]
@@ -87,6 +108,36 @@ fn derivable_record_with_record_ext() {
     );
 }
 
+#[test]
+fn derivable_tag_ext_flex_var() {
+    check_derivable(
+        Hash,
+        v!([ A v!(STR) ]* ),
+        DeriveKey::Hash(FlatHashKey::TagUnion(vec![("A".into(), 1)])),
+    );
+}
+
+#[test]
+fn derivable_tag_ext_flex_able_var() {
+    check_derivable(
+        Hash,
+        v!([ A v!(STR) ]a has Symbol::ENCODE_TO_ENCODER),
+        DeriveKey::Hash(FlatHashKey::TagUnion(vec![("A".into(), 1)])),
+    );
+}
+
+#[test]
+fn derivable_tag_with_tag_ext() {
+    check_derivable(
+        Hash,
+        v!([ B v!(STR) v!(U8) ][ A v!(STR) ]),
+        DeriveKey::Hash(FlatHashKey::TagUnion(vec![
+            ("A".into(), 1),
+            ("B".into(), 2),
+        ])),
+    );
+}
+
 #[test]
 fn empty_record() {
     derive_test(Hash, v!(EMPTY_RECORD), |golden| {