monomorphize the ext_var of records/tag unions

compiler/mono/src/expr.rs

@@ -84,7 +84,7 @@ impl<'a> Procs<'a> {
 #[derive(Clone, Debug, PartialEq)]
 pub struct PartialProc<'a> {
     pub annotation: Variable,
-    pub patterns: std::vec::Vec<Located<roc_can::pattern::Pattern>>,
+    pub patterns: Vec<'a, Symbol>,
     pub body: roc_can::expr::Expr,
     pub specializations: MutMap<ContentHash, (Symbol, Option<Proc<'a>>)>,
 }
@@ -284,6 +284,79 @@ fn to_int_or_float(subs: &Subs, var: Variable) -> IntOrFloat {
     }
 }
 
+fn patterns_to_when<'a>(
+    env: &mut Env<'a, '_>,
+    patterns: std::vec::Vec<(Variable, Located<roc_can::pattern::Pattern>)>,
+    body_var: Variable,
+    mut body: Located<roc_can::expr::Expr>,
+) -> (
+    Vec<'a, Variable>,
+    Vec<'a, Symbol>,
+    Located<roc_can::expr::Expr>,
+) {
+    let mut arg_vars = Vec::with_capacity_in(patterns.len(), env.arena);
+    let mut symbols = Vec::with_capacity_in(patterns.len(), env.arena);
+
+    for (pattern_var, pattern) in patterns.into_iter().rev() {
+        let (new_symbol, new_body) = pattern_to_when(env, pattern_var, pattern, body_var, body);
+        body = new_body;
+        symbols.push(new_symbol);
+        arg_vars.push(pattern_var);
+    }
+
+    (arg_vars, symbols, body)
+}
+
+/// turn irrefutable patterns into when. For example
+///
+/// foo = \{ x } -> body
+///
+/// Assuming the above program typechecks, the pattern match cannot fail
+/// (it is irrefutable). It becomes
+///
+/// foo = \r ->
+///      when r is
+///          { x } -> body
+///
+/// conversion of one-pattern when expressions will do the most optimal thing
+fn pattern_to_when<'a>(
+    env: &mut Env<'a, '_>,
+    pattern_var: Variable,
+    pattern: Located<roc_can::pattern::Pattern>,
+    body_var: Variable,
+    body: Located<roc_can::expr::Expr>,
+) -> (Symbol, Located<roc_can::expr::Expr>) {
+    use roc_can::expr::Expr::*;
+    use roc_can::pattern::Pattern::*;
+
+    match &pattern.value {
+        Identifier(symbol) => (*symbol, body),
+        Underscore => {
+            // for underscore we generate a dummy Symbol
+            (env.fresh_symbol(), body)
+        }
+
+        AppliedTag(_, _, _) | RecordDestructure(_, _) | Shadowed(_, _) | UnsupportedPattern(_) => {
+            let symbol = env.fresh_symbol();
+
+            let wrapped_body = When {
+                cond_var: pattern_var,
+                expr_var: body_var,
+                loc_cond: Box::new(Located::at_zero(Var(symbol))),
+                branches: vec![(pattern, body)],
+            };
+
+            (symbol, Located::at_zero(wrapped_body))
+        }
+
+        // These patters are refutable, and thus should never occur outside a `when` expression
+        IntLiteral(_) | NumLiteral(_,_) | FloatLiteral(_) | StrLiteral(_) => {
+            unreachable!("refutable pattern {:?} where irrefutable pattern is expected. This should never happen!", pattern.value)
+        }
+
+    }
+}
+
 fn from_can<'a>(
     env: &mut Env<'a, '_>,
     can_expr: roc_can::expr::Expr,
@@ -352,8 +425,16 @@ fn from_can<'a>(
         Closure(annotation, _, _, loc_args, boxed_body) => {
             let (loc_body, ret_var) = *boxed_body;
 
-            let (arg_vars, patterns): (std::vec::Vec<_>, std::vec::Vec<_>) =
+            // turn record/tag patterns into a when expression, e.g.
-                loc_args.into_iter().unzip();
+            //
+            // foo = \{ x } -> body
+            //
+            // becomes
+            //
+            // foo = \r -> when r is { x } -> body
+            //
+            // conversion of one-pattern when expressions will do the most optimal thing
+            let (arg_vars, arg_symbols, body) = patterns_to_when(env, loc_args, ret_var, loc_body);
 
             let symbol = match name {
                 Some(symbol) => {
@@ -362,8 +443,8 @@ fn from_can<'a>(
                         symbol,
                         PartialProc {
                             annotation,
-                            patterns,
+                            patterns: arg_symbols,
-                            body: loc_body.value,
+                            body: body.value,
                             specializations: MutMap::default(),
                         },
                     );
@@ -373,6 +454,11 @@ fn from_can<'a>(
                     // an anonymous closure. These will always be specialized already
                     // by the surrounding context
                     let symbol = env.fresh_symbol();
+
+                    // Has the side-effect of monomorphizing record types
+                    // turning the ext_var into EmptyRecord or EmptyTagUnion
+                    let _ = ContentHash::from_var(annotation, env.subs);
+
                     let opt_proc = specialize_proc_body(
                         env,
                         procs,
@@ -380,9 +466,9 @@ fn from_can<'a>(
                         ret_var,
                         symbol,
                         &arg_vars,
-                        &patterns,
+                        &arg_symbols,
                         annotation,
-                        loc_body.value,
+                        body.value,
                     );
 
                     procs.insert_anonymous(symbol, opt_proc);
@@ -922,7 +1008,7 @@ fn call_by_name<'a>(
         ContentHash,
         Variable,
         roc_can::expr::Expr,
-        std::vec::Vec<Located<roc_can::pattern::Pattern>>,
+        Vec<'a, Symbol>,
     )>;
 
     let specialized_proc_name = if let Some(partial_proc) = procs.get_user_defined(proc_name) {
@@ -994,7 +1080,7 @@ fn specialize_proc_body<'a>(
     ret_var: Variable,
     proc_name: Symbol,
     loc_args: &[Variable],
-    loc_patterns: &[Located<roc_can::pattern::Pattern>],
+    pattern_symbols: &[Symbol],
     annotation: Variable,
     body: roc_can::expr::Expr,
 ) -> Option<Proc<'a>> {
@@ -1008,7 +1094,7 @@ fn specialize_proc_body<'a>(
 
     let mut proc_args = Vec::with_capacity_in(loc_args.len(), &env.arena);
 
-    for (arg_var, loc_pattern) in loc_args.iter().zip(loc_patterns.iter()) {
+    for (arg_var, arg_name) in loc_args.iter().zip(pattern_symbols.iter()) {
         let layout = match Layout::from_var(&env.arena, *arg_var, env.subs, env.pointer_size) {
             Ok(layout) => layout,
             Err(()) => {
@@ -1017,19 +1103,7 @@ fn specialize_proc_body<'a>(
             }
         };
 
-        // TODO FIXME what is the idea here? arguments don't map to identifiers one-to-one
+        proc_args.push((layout, *arg_name));
-        // e.g. underscore and record patterns
-        let arg_name: Symbol = match &loc_pattern.value {
-            Pattern::Identifier(symbol) => *symbol,
-            _ => {
-                panic!(
-                    "TODO determine arg_name for pattern {:?}",
-                    loc_pattern.value
-                );
-            }
-        };
-
-        proc_args.push((layout, arg_name));
     }
 
     let ret_layout = Layout::from_var(&env.arena, ret_var, env.subs, env.pointer_size)

compiler/mono/tests/test_mono.rs

@@ -160,6 +160,26 @@ mod test_mono {
         )
     }
 
+    //    #[test]
+    //    fn record_pattern() {
+    //        compiles_to(
+    //            r#"
+    //            \{ x } -> x + 0x5
+    //            "#,
+    //            { Float(3.45) },
+    //        )
+    //    }
+    //
+    //    #[test]
+    //    fn tag_pattern() {
+    //        compiles_to(
+    //            r#"
+    //            \Foo x -> x + 0x5
+    //            "#,
+    //            { Float(3.45) },
+    //        )
+    //    }
+
     #[test]
     fn polymorphic_identity() {
         compiles_to(

compiler/region/src/all.rs

@@ -89,6 +89,11 @@ impl<T> Located<T> {
     pub fn at(region: Region, value: T) -> Located<T> {
         Located { value, region }
     }
+
+    pub fn at_zero(value: T) -> Located<T> {
+        let region = Region::zero();
+        Located { value, region }
+    }
 }
 
 impl<T> Located<T> {

compiler/types/src/pretty_print.rs

@@ -436,7 +436,7 @@ fn write_flat_type(
 
             buf.push_str(" ]");
 
-            if let Some(content) = ext_content {
+            if let Err(content) = ext_content {
                 // This is an open tag union, so print the variable
                 // right after the ']'
                 //
@@ -483,7 +483,7 @@ fn write_flat_type(
 
             buf.push_str(" ]");
 
-            if let Some(content) = ext_content {
+            if let Err(content) = ext_content {
                 // This is an open tag union, so print the variable
                 // right after the ']'
                 //
@@ -508,10 +508,10 @@ pub fn chase_ext_tag_union(
     subs: &Subs,
     var: Variable,
     fields: &mut Vec<(TagName, Vec<Variable>)>,
-) -> Option<Content> {
+) -> Result<(), Content> {
     use FlatType::*;
     match subs.get_without_compacting(var).content {
-        Content::Structure(EmptyTagUnion) => None,
+        Content::Structure(EmptyTagUnion) => Ok(()),
         Content::Structure(TagUnion(tags, ext_var))
         | Content::Structure(RecursiveTagUnion(_, tags, ext_var)) => {
             for (label, vars) in tags {
@@ -521,7 +521,7 @@ pub fn chase_ext_tag_union(
             chase_ext_tag_union(subs, ext_var, fields)
         }
 
-        content => Some(content),
+        content => Err(content),
     }
 }
 
@@ -529,7 +529,7 @@ pub fn chase_ext_record(
     subs: &Subs,
     var: Variable,
     fields: &mut MutMap<Lowercase, Variable>,
-) -> Option<Content> {
+) -> Result<(), Content> {
     use crate::subs::Content::*;
     use crate::subs::FlatType::*;
 
@@ -540,11 +540,11 @@ pub fn chase_ext_record(
             chase_ext_record(subs, sub_ext, fields)
         }
 
-        Structure(EmptyRecord) => None,
+        Structure(EmptyRecord) => Ok(()),
 
         Alias(_, _, var) => chase_ext_record(subs, var, fields),
 
-        content => Some(content),
+        content => Err(content),
     }
 }
 

compiler/types/src/subs.rs

@@ -554,7 +554,7 @@ pub enum FlatType {
 pub struct ContentHash(u64);
 
 impl ContentHash {
-    pub fn from_var(var: Variable, subs: &Subs) -> Self {
+    pub fn from_var(var: Variable, subs: &mut Subs) -> Self {
         use std::hash::Hasher;
 
         let mut hasher = std::collections::hash_map::DefaultHasher::new();
@@ -563,14 +563,14 @@ impl ContentHash {
         ContentHash(hasher.finish())
     }
 
-    pub fn from_var_help<T>(var: Variable, subs: &Subs, hasher: &mut T)
+    pub fn from_var_help<T>(var: Variable, subs: &mut Subs, hasher: &mut T)
     where
         T: std::hash::Hasher,
     {
-        Self::from_content_help(&subs.get_without_compacting(var).content, subs, hasher)
+        Self::from_content_help(var, &subs.get_without_compacting(var).content, subs, hasher)
     }
 
-    pub fn from_content_help<T>(content: &Content, subs: &Subs, hasher: &mut T)
+    pub fn from_content_help<T>(var: Variable, content: &Content, subs: &mut Subs, hasher: &mut T)
     where
         T: std::hash::Hasher,
     {
@@ -581,7 +581,7 @@ impl ContentHash {
             }
             Content::Structure(flat_type) => {
                 hasher.write_u8(0x10);
-                Self::from_flat_type_help(flat_type, subs, hasher)
+                Self::from_flat_type_help(var, flat_type, subs, hasher)
             }
             Content::FlexVar(_) | Content::RigidVar(_) => {
                 hasher.write_u8(0x11);
@@ -592,8 +592,12 @@ impl ContentHash {
         }
     }
 
-    pub fn from_flat_type_help<T>(flat_type: &FlatType, subs: &Subs, hasher: &mut T)
+    pub fn from_flat_type_help<T>(
-    where
+        flat_type_var: Variable,
+        flat_type: &FlatType,
+        subs: &mut Subs,
+        hasher: &mut T,
+    ) where
         T: std::hash::Hasher,
     {
         use std::hash::Hash;
@@ -623,25 +627,49 @@ impl ContentHash {
                 hasher.write_u8(2);
             }
 
-            FlatType::Record(fields, ext) => {
+            FlatType::Record(record_fields, ext) => {
                 hasher.write_u8(3);
 
-                // We have to sort by the key, so this clone seems to be required
+                // NOTE: This function will modify the subs, putting all fields from the ext_var
-                let mut fields = fields.clone();
+                // into the record itself, then setting the ext_var to EMPTY_RECORD
 
-                match crate::pretty_print::chase_ext_record(subs, *ext, &mut fields) {
+                let mut fields = Vec::with_capacity(record_fields.len());
-                    Some(_) => panic!("Record with non-empty ext var"),
-                    None => {
-                        let mut fields_vec = Vec::with_capacity(fields.len());
-                        fields_vec.extend(fields.into_iter());
 
-                        fields_vec.sort();
+                let mut extracted_fields_from_ext = false;
+                if *ext != Variable::EMPTY_RECORD {
+                    let mut fields_map = MutMap::default();
+                    match crate::pretty_print::chase_ext_record(subs, *ext, &mut fields_map) {
+                        Err(Content::FlexVar(_)) | Ok(()) => {
+                            if !fields_map.is_empty() {
+                                extracted_fields_from_ext = true;
+                                fields.extend(fields_map.into_iter());
+                            }
+                        }
+                        Err(content) => panic!("Record with unexpected ext_var: {:?}", content),
+                    }
+                }
 
-                        for (name, argument) in fields_vec {
+                fields.extend(record_fields.clone().into_iter());
+                fields.sort();
+
+                for (name, argument) in &fields {
                     name.hash(hasher);
-                            Self::from_var_help(argument, subs, hasher);
+                    Self::from_var_help(*argument, subs, hasher);
                 }
+
+                if *ext != Variable::EMPTY_RECORD {
+                    // unify ext with empty record
+                    let desc = subs.get(Variable::EMPTY_RECORD);
+                    subs.union(Variable::EMPTY_RECORD, *ext, desc);
                 }
+
+                if extracted_fields_from_ext {
+                    let fields_map = fields.into_iter().collect();
+
+                    subs.set_content(
+                        flat_type_var,
+                        Content::Structure(FlatType::Record(fields_map, Variable::EMPTY_RECORD)),
+                    );
                 }
             }
 
@@ -652,45 +680,99 @@ impl ContentHash {
             FlatType::TagUnion(tags, ext) => {
                 hasher.write_u8(5);
 
-                // We have to sort by the key, so this clone seems to be required
+                // NOTE: This function will modify the subs, putting all tags from the ext_var
-                let mut tag_vec = Vec::with_capacity(tags.len());
+                // into the tag union itself, then setting the ext_var to EMPTY_TAG_UNION
-                tag_vec.extend(tags.clone().into_iter());
 
+                let mut tag_vec = Vec::with_capacity(tags.len());
+
+                let mut extracted_fields_from_ext = false;
+                if *ext != Variable::EMPTY_TAG_UNION {
                     match crate::pretty_print::chase_ext_tag_union(subs, *ext, &mut tag_vec) {
-                    Some(_) => panic!("Tag union with non-empty ext var"),
+                        Err(Content::FlexVar(_)) | Ok(()) => {
-                    None => {
+                            extracted_fields_from_ext = !tag_vec.is_empty();
+                        }
+                        Err(content) => panic!("TagUnion with unexpected ext_var: {:?}", content),
+                    }
+                }
+
+                tag_vec.extend(tags.clone().into_iter());
                 tag_vec.sort();
-                        for (name, arguments) in tag_vec {
+                for (name, arguments) in &tag_vec {
                     name.hash(hasher);
 
                     for var in arguments {
-                                Self::from_var_help(var, subs, hasher);
+                        Self::from_var_help(*var, subs, hasher);
-                            }
-                        }
-                    }
                     }
                 }
 
-            FlatType::RecursiveTagUnion(_rec, tags, ext) => {
+                if *ext != Variable::EMPTY_TAG_UNION {
-                // TODO should the rec_var be hashed in?
+                    // unify ext with empty record
+                    let desc = subs.get(Variable::EMPTY_TAG_UNION);
+                    subs.union(Variable::EMPTY_TAG_UNION, *ext, desc);
+                }
+
+                if extracted_fields_from_ext {
+                    let fields_map = tag_vec.into_iter().collect();
+
+                    subs.set_content(
+                        flat_type_var,
+                        Content::Structure(FlatType::TagUnion(
+                            fields_map,
+                            Variable::EMPTY_TAG_UNION,
+                        )),
+                    );
+                }
+            }
+
+            FlatType::RecursiveTagUnion(rec, tags, ext) => {
+                // NOTE: rec is not hashed in. If all the tags and their arguments are the same,
+                // then the recursive tag unions are the same
                 hasher.write_u8(6);
 
-                // We have to sort by the key, so this clone seems to be required
+                // NOTE: This function will modify the subs, putting all tags from the ext_var
-                let mut tag_vec = Vec::with_capacity(tags.len());
+                // into the tag union itself, then setting the ext_var to EMPTY_TAG_UNION
-                tag_vec.extend(tags.clone().into_iter());
 
+                let mut tag_vec = Vec::with_capacity(tags.len());
+
+                let mut extracted_fields_from_ext = false;
+                if *ext != Variable::EMPTY_TAG_UNION {
                     match crate::pretty_print::chase_ext_tag_union(subs, *ext, &mut tag_vec) {
-                    Some(_) => panic!("Tag union with non-empty ext var"),
+                        Err(Content::FlexVar(_)) | Ok(()) => {
-                    None => {
+                            extracted_fields_from_ext = !tag_vec.is_empty();
+                        }
+                        Err(content) => {
+                            panic!("RecursiveTagUnion with unexpected ext_var: {:?}", content)
+                        }
+                    }
+                }
+
+                tag_vec.extend(tags.clone().into_iter());
                 tag_vec.sort();
-                        for (name, arguments) in tag_vec {
+                for (name, arguments) in &tag_vec {
                     name.hash(hasher);
 
                     for var in arguments {
-                                Self::from_var_help(var, subs, hasher);
+                        Self::from_var_help(*var, subs, hasher);
                     }
                 }
+
+                if *ext != Variable::EMPTY_TAG_UNION {
+                    // unify ext with empty record
+                    let desc = subs.get(Variable::EMPTY_TAG_UNION);
+                    subs.union(Variable::EMPTY_TAG_UNION, *ext, desc);
                 }
+
+                if extracted_fields_from_ext {
+                    let fields_map = tag_vec.into_iter().collect();
+
+                    subs.set_content(
+                        flat_type_var,
+                        Content::Structure(FlatType::RecursiveTagUnion(
+                            *rec,
+                            fields_map,
+                            Variable::EMPTY_TAG_UNION,
+                        )),
+                    );
                 }
             }