diff --git a/compiler/mono/src/expr.rs b/compiler/mono/src/expr.rs index 1197e9344d..0fd6237211 100644 --- a/compiler/mono/src/expr.rs +++ b/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>, + pub patterns: Vec<'a, Symbol>, pub body: roc_can::expr::Expr, pub specializations: MutMap>)>, } @@ -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)>, + body_var: Variable, + mut body: Located, +) -> ( + Vec<'a, Variable>, + Vec<'a, Symbol>, + Located, +) { + 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, + body_var: Variable, + body: Located, +) -> (Symbol, Located) { + 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<_>) = - loc_args.into_iter().unzip(); + // turn record/tag patterns into a when expression, e.g. + // + // 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, - body: loc_body.value, + patterns: arg_symbols, + 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>, + 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], + pattern_symbols: &[Symbol], annotation: Variable, body: roc_can::expr::Expr, ) -> Option> { @@ -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 - // 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)); + proc_args.push((layout, *arg_name)); } let ret_layout = Layout::from_var(&env.arena, ret_var, env.subs, env.pointer_size) diff --git a/compiler/mono/tests/test_mono.rs b/compiler/mono/tests/test_mono.rs index 4e29588d34..1d7103dd3e 100644 --- a/compiler/mono/tests/test_mono.rs +++ b/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( diff --git a/compiler/region/src/all.rs b/compiler/region/src/all.rs index 772d0e0afc..5c9410bc0c 100644 --- a/compiler/region/src/all.rs +++ b/compiler/region/src/all.rs @@ -89,6 +89,11 @@ impl Located { pub fn at(region: Region, value: T) -> Located { Located { value, region } } + + pub fn at_zero(value: T) -> Located { + let region = Region::zero(); + Located { value, region } + } } impl Located { diff --git a/compiler/types/src/pretty_print.rs b/compiler/types/src/pretty_print.rs index f576a5ca50..0108b35618 100644 --- a/compiler/types/src/pretty_print.rs +++ b/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)>, -) -> Option { +) -> 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, -) -> Option { +) -> 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), } } diff --git a/compiler/types/src/subs.rs b/compiler/types/src/subs.rs index 56b8b3a09a..3e8b42e3dc 100644 --- a/compiler/types/src/subs.rs +++ b/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(var: Variable, subs: &Subs, hasher: &mut T) + pub fn from_var_help(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(content: &Content, subs: &Subs, hasher: &mut T) + pub fn from_content_help(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(flat_type: &FlatType, subs: &Subs, hasher: &mut T) - where + pub fn from_flat_type_help( + flat_type_var: Variable, + flat_type: &FlatType, + subs: &mut Subs, + hasher: &mut T, + ) where T: std::hash::Hasher, { use std::hash::Hash; @@ -623,26 +627,50 @@ 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 - let mut fields = fields.clone(); + // NOTE: This function will modify the subs, putting all fields from the ext_var + // into the record itself, then setting the ext_var to EMPTY_RECORD - match crate::pretty_print::chase_ext_record(subs, *ext, &mut fields) { - Some(_) => panic!("Record with non-empty ext var"), - None => { - let mut fields_vec = Vec::with_capacity(fields.len()); - fields_vec.extend(fields.into_iter()); + let mut fields = Vec::with_capacity(record_fields.len()); - fields_vec.sort(); - - for (name, argument) in fields_vec { - name.hash(hasher); - Self::from_var_help(argument, subs, hasher); + 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), } } + + fields.extend(record_fields.clone().into_iter()); + fields.sort(); + + for (name, argument) in &fields { + name.hash(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)), + ); + } } FlatType::EmptyTagUnion => { @@ -652,46 +680,100 @@ 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 + // into the tag union itself, then setting the ext_var to EMPTY_TAG_UNION + let mut tag_vec = Vec::with_capacity(tags.len()); - tag_vec.extend(tags.clone().into_iter()); - match crate::pretty_print::chase_ext_tag_union(subs, *ext, &mut tag_vec) { - Some(_) => panic!("Tag union with non-empty ext var"), - None => { - tag_vec.sort(); - for (name, arguments) in tag_vec { - name.hash(hasher); - - for var in arguments { - Self::from_var_help(var, subs, hasher); - } + 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) { + Err(Content::FlexVar(_)) | Ok(()) => { + 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 { + name.hash(hasher); + + for var in arguments { + 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::TagUnion( + fields_map, + Variable::EMPTY_TAG_UNION, + )), + ); + } } - FlatType::RecursiveTagUnion(_rec, tags, ext) => { - // TODO should the rec_var be hashed in? + 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 + // into the tag union itself, then setting the ext_var to EMPTY_TAG_UNION + let mut tag_vec = Vec::with_capacity(tags.len()); - tag_vec.extend(tags.clone().into_iter()); - match crate::pretty_print::chase_ext_tag_union(subs, *ext, &mut tag_vec) { - Some(_) => panic!("Tag union with non-empty ext var"), - None => { - tag_vec.sort(); - for (name, arguments) in tag_vec { - name.hash(hasher); - - for var in arguments { - Self::from_var_help(var, subs, hasher); - } + 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) { + Err(Content::FlexVar(_)) | Ok(()) => { + 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 { + name.hash(hasher); + + for var in arguments { + 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, + )), + ); + } } FlatType::Boolean(boolean) => {