roc-lang/roc
1
1
Fork 0
mirror of https://github.com/roc-lang/roc.git synced 2024-09-22 08:17:40 +03:00
Code Issues Packages Projects Releases Wiki Activity

convert mutually recursive tag unions to recursive ones

Browse Source
This commit is contained in:
Folkert 2020-02-19 21:27:24 +01:00
parent 24b3056005
commit 203add5518
5 changed files with 83 additions and 57 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

85
src/can/def.rs
View File

@ -12,14 +12,13 @@ use crate::can::problem::Problem;
use crate::can::problem::RuntimeError;
use crate::can::procedure::References;
use crate::can::scope::Scope;
use crate::collections::{default_hasher, ImSet, MutMap, MutSet, SendMap};
use crate::collections::{default_hasher, ImMap, ImSet, MutMap, MutSet, SendMap};
use crate::graph::{strongly_connected_components, topological_sort_into_groups};
use crate::module::symbol::Symbol;
use crate::parse::ast;
use crate::region::{Located, Region};
use crate::subs::{VarStore, Variable};
use crate::types::{Alias, Type};
use std::cmp::Ordering;
use std::collections::HashMap;
use std::fmt::Debug;
@ -179,10 +178,6 @@ pub fn canonicalize_defs<'a>(
if cfg!(debug_assertions) {
env.home.register_debug_idents(&env.ident_ids);
}
let aliases_first = |x: &PendingDef<'_>, _: &PendingDef<'_>| match x {
PendingDef::Alias { .. } => Ordering::Less,
_ => Ordering::Greater,
};
let mut aliases = SendMap::default();
let mut value_defs = Vec::new();
@ -214,16 +209,7 @@ pub fn canonicalize_defs<'a>(
}
if can_ann.typ.contains_symbol(symbol) {
// the alias is recursive. If it's a tag union, we attempt to fix this
if let Type::TagUnion(tags, ext) = can_ann.typ {
// re-canonicalize the alias with the alias already in scope
let rec_var = var_store.fresh();
let mut rec_type_union = Type::RecursiveTagUnion(rec_var, tags, ext);
rec_type_union.substitute_alias(symbol, &Type::Variable(rec_var));
can_ann.typ = rec_type_union;
} else {
panic!("recursion in type alias that is not behind a Tag");
}
make_tag_union_recursive(symbol, &mut can_ann.typ, var_store);
}
let alias = crate::types::Alias {
@ -291,9 +277,8 @@ pub fn canonicalize_defs<'a>(
#[inline(always)]
pub fn sort_can_defs(
env: &mut Env<'_>,
mut defs: CanDefs,
defs: CanDefs,
mut output: Output,
var_store: &VarStore,
) -> (Result<Vec<Declaration>, RuntimeError>, Output) {
let CanDefs {
refs_by_symbol,
@ -1154,15 +1139,7 @@ pub fn can_defs_with_return<'a>(
// Use its output as a starting point because its tail_call already has the right answer!
let (ret_expr, output) =
canonicalize_expr(env, var_store, &mut scope, loc_ret.region, &loc_ret.value);
let (can_defs, mut output) = sort_can_defs(env, unsorted, output, var_store);
// Now that we've collected all the references, check to see if any of the new idents
// we defined went unused by the return expression. If any were unused, report it.
for (symbol, region) in symbols_introduced {
if !output.references.has_lookup(symbol) {
env.problem(Problem::UnusedDef(symbol, region));
}
}
let (can_defs, mut output) = sort_can_defs(env, unsorted, output);
// Now that we've collected all the references, check to see if any of the new idents
// we defined went unused by the return expression. If any were unused, report it.
@ -1382,6 +1359,23 @@ fn correct_mutual_recursive_type_alias(aliases: &mut SendMap<Symbol, Alias>, var
}
};
let all_successors_without_self = |symbol: &Symbol| -> ImSet<Symbol> {
match aliases.get(symbol) {
Some(alias) => {
let mut loc_succ = alias.typ.symbols();
// remove anything that is not defined in the current block
loc_succ.retain(|key| symbols_introduced.contains(key));
loc_succ.remove(&symbol);
loc_succ
}
None => ImSet::default(),
}
};
let originals = aliases.clone();
// TODO investigate should this be in a loop?
let defined_symbols: Vec<Symbol> = aliases.keys().copied().collect();
// split into self-recursive and mutually recursive
@ -1390,10 +1384,39 @@ fn correct_mutual_recursive_type_alias(aliases: &mut SendMap<Symbol, Alias>, var
// no mutual recursion in any alias
}
Err((_, mutually_recursive_symbols)) => {
panic!(
"TODO mutually recursive tag unions {:?}",
mutually_recursive_symbols
);
for cycle in strongly_connected_components(
&mutually_recursive_symbols,
all_successors_without_self,
) {
// TODO use itertools to be more efficient here
for rec in &cycle {
let mut to_instantiate = ImMap::default();
for other in &cycle {
if rec != other {
if let Some(alias) = originals.get(other) {
to_instantiate.insert(*other, alias.clone());
}
}
}
if let Some(alias) = aliases.get_mut(rec) {
alias.typ.instantiate_aliases(&to_instantiate, var_store);
make_tag_union_recursive(*rec, &mut alias.typ, var_store);
}
}
}
}
}
}
fn make_tag_union_recursive(symbol: Symbol, typ: &mut Type, var_store: &VarStore) {
match typ {
Type::TagUnion(tags, ext) => {
let rec_var = var_store.fresh();
*typ = Type::RecursiveTagUnion(rec_var, tags.to_vec(), ext.clone());
typ.substitute_alias(symbol, &Type::Variable(rec_var));
}
Type::Alias(_, _, actual) => make_tag_union_recursive(symbol, actual, var_store),
_ => panic!("recursion in type alias is not behind a Tag"),
}
}

2
src/can/module.rs
View File

@ -137,7 +137,7 @@ pub fn canonicalize_module_defs<'a>(
references.insert(*symbol);
}
match sort_can_defs(&mut env, defs, Output::default(), var_store) {
match sort_can_defs(&mut env, defs, Output::default()) {
(Ok(declarations), output) => {
use crate::can::def::Declaration::*;

5
src/types/mod.rs
View File

@ -80,6 +80,9 @@ impl fmt::Debug for Type {
write!(f, " {:?}", arg)?;
}
// Sometimes it's useful to see the expansion of the alias
// write!(f, "[ but actually {:?} ]", _actual)?;
Ok(())
}
Type::Record(fields, ext) => {
@ -448,7 +451,7 @@ impl Type {
*self = Type::Alias(*symbol, named_args, Box::new(actual));
}
} else {
panic!("no alias for {:?}", symbol);
// do nothing, maybe this alias gets instantiated later?
}
}
EmptyRec | EmptyTagUnion | Erroneous(_) | Variable(_) | Boolean(_) => {}

8
tests/test_infer.rs
View File

@ -1884,7 +1884,7 @@ mod test_infer {
}
#[test]
fn typecheck_mutually_recursive_tag_union2() {
fn typecheck_mutually_recursive_tag_union_listabc() {
infer_eq_without_problem(
indoc!(
r#"
@ -1892,13 +1892,13 @@ mod test_infer {
ListB a : [ Cons a (ListC a) ]
ListC a : [ Cons a (ListA a), Nil ]
val : ListC a
val = Nil
val : ListC Int.Int
val = Cons 1 (Cons 2 (Cons 3 Nil))
val
"#
),
"(b -> a), ListA a b -> List a",
"ListC Int",
);
}

40
tests/test_uniqueness_infer.rs
View File

@ -1813,32 +1813,32 @@ mod test_infer_uniq {
// );
// }
// infinite loop in type_to_var
// boolean variables introduced by the alias are not bound (by the alias) and thus not instantiated
// #[test]
// fn typecheck_mutually_recursive_tag_union() {
// infer_eq(
// indoc!(
// r#"
// ListA a b : [ Cons a (ListB b a), Nil ]
// ListB a b : [ Cons a (ListA b a), Nil ]
// indoc!(
// r#"
// ListA a b : [ Cons a (ListB b a), Nil ]
// ListB a b : [ Cons a (ListA b a), Nil ]
//
// List q : [ Cons q (List q), Nil ]
// List q : [ Cons q (List q), Nil ]
//
// toAs : (q -> p), ListA p q -> List p
// toAs = \f, lista ->
// when lista is
// Nil -> Nil
// Cons a listb ->
// when listb is
// Nil -> Nil
// Cons b newLista ->
// Cons a (Cons (f b) (toAs f newLista))
// toAs : (q -> p), ListA p q -> List p
// toAs = \f, lista ->
// when lista is
// Nil -> Nil
// Cons a listb ->
// when listb is
// Nil -> Nil
// Cons b newLista ->
// Cons a (Cons (f b) (toAs f newLista))
//
// toAs
// "#
// ),
// "Attr Shared (Attr Shared (Attr a q -> Attr b p), Attr * (ListA (Attr b p) (Attr a q)) -> Attr * (List (Attr b p)))"
// );
// toAs
// "#
// ),
// "Attr Shared (Attr Shared (Attr a q -> Attr b p), Attr * (ListA (Attr b p) (Attr a q)) -> Attr * (List (Attr b p)))"
// );
// }
#[test]