mirror of
https://github.com/roc-lang/roc.git
synced 2024-09-22 08:17:40 +03:00
Merge pull request #2372 from rtfeldman/effect-forever
Add `Effect.forever`
This commit is contained in:
commit
82c7e8c37e
@ -21,15 +21,21 @@ type Builder = for<'r, 's, 't0, 't1> fn(
|
||||
&'t1 mut VarStore,
|
||||
) -> (Symbol, Def);
|
||||
|
||||
pub const BUILTIN_EFFECT_FUNCTIONS: [(&str, Builder); 3] = [
|
||||
pub const BUILTIN_EFFECT_FUNCTIONS: &[(&str, Builder)] = &[
|
||||
// Effect.after : Effect a, (a -> Effect b) -> Effect b
|
||||
("after", build_effect_after),
|
||||
// Effect.map : Effect a, (a -> b) -> Effect b
|
||||
("map", build_effect_map),
|
||||
// Effect.always : a -> Effect a
|
||||
("always", build_effect_always),
|
||||
// Effect.forever : Effect a -> Effect b
|
||||
("forever", build_effect_forever),
|
||||
// Effect.loop : a, (a -> Effect [ Step a, Done b ]) -> Effect b
|
||||
("loop", build_effect_loop),
|
||||
];
|
||||
|
||||
const RECURSIVE_BUILTIN_EFFECT_FUNCTIONS: &[&str] = &["forever", "loop"];
|
||||
|
||||
// the Effects alias & associated functions
|
||||
//
|
||||
// A platform can define an Effect type in its header. It can have an arbitrary name
|
||||
@ -52,7 +58,7 @@ pub fn build_effect_builtins(
|
||||
exposed_symbols: &mut MutSet<Symbol>,
|
||||
declarations: &mut Vec<Declaration>,
|
||||
) {
|
||||
for (_, f) in BUILTIN_EFFECT_FUNCTIONS.iter() {
|
||||
for (name, f) in BUILTIN_EFFECT_FUNCTIONS.iter() {
|
||||
let (symbol, def) = f(
|
||||
env,
|
||||
scope,
|
||||
@ -62,8 +68,34 @@ pub fn build_effect_builtins(
|
||||
);
|
||||
|
||||
exposed_symbols.insert(symbol);
|
||||
declarations.push(Declaration::Declare(def));
|
||||
|
||||
let is_recursive = RECURSIVE_BUILTIN_EFFECT_FUNCTIONS.iter().any(|n| n == name);
|
||||
if is_recursive {
|
||||
declarations.push(Declaration::DeclareRec(vec![def]));
|
||||
} else {
|
||||
declarations.push(Declaration::Declare(def));
|
||||
}
|
||||
}
|
||||
|
||||
// Useful when working on functions in this module. By default symbols that we named do now
|
||||
// show up with their name. We have to register them like below to make the names show up in
|
||||
// debug prints
|
||||
if false {
|
||||
env.home.register_debug_idents(&env.ident_ids);
|
||||
}
|
||||
}
|
||||
|
||||
macro_rules! new_symbol {
|
||||
($scope:expr, $env:expr, $name:expr) => {{
|
||||
$scope
|
||||
.introduce(
|
||||
$name.into(),
|
||||
&$env.exposed_ident_ids,
|
||||
&mut $env.ident_ids,
|
||||
Region::zero(),
|
||||
)
|
||||
.unwrap()
|
||||
}};
|
||||
}
|
||||
|
||||
fn build_effect_always(
|
||||
@ -588,6 +620,755 @@ fn build_effect_after(
|
||||
(after_symbol, def)
|
||||
}
|
||||
|
||||
/// turn `value` into `@Effect \{} -> value`
|
||||
fn wrap_in_effect_thunk(
|
||||
body: Expr,
|
||||
effect_tag_name: TagName,
|
||||
closure_name: Symbol,
|
||||
captured_symbols: Vec<Symbol>,
|
||||
var_store: &mut VarStore,
|
||||
) -> Expr {
|
||||
let captured_symbols: Vec<_> = captured_symbols
|
||||
.into_iter()
|
||||
.map(|x| (x, var_store.fresh()))
|
||||
.collect();
|
||||
|
||||
// \{} -> body
|
||||
let const_closure = {
|
||||
let arguments = vec![(
|
||||
var_store.fresh(),
|
||||
Loc::at_zero(empty_record_pattern(var_store)),
|
||||
)];
|
||||
|
||||
Expr::Closure(ClosureData {
|
||||
function_type: var_store.fresh(),
|
||||
closure_type: var_store.fresh(),
|
||||
closure_ext_var: var_store.fresh(),
|
||||
return_type: var_store.fresh(),
|
||||
name: closure_name,
|
||||
// captured_symbols: vec![(value_symbol, var_store.fresh())],
|
||||
captured_symbols,
|
||||
recursive: Recursive::NotRecursive,
|
||||
arguments,
|
||||
loc_body: Box::new(Loc::at_zero(body)),
|
||||
})
|
||||
};
|
||||
|
||||
// `@Effect \{} -> value`
|
||||
Expr::Tag {
|
||||
variant_var: var_store.fresh(),
|
||||
ext_var: var_store.fresh(),
|
||||
name: effect_tag_name,
|
||||
arguments: vec![(var_store.fresh(), Loc::at_zero(const_closure))],
|
||||
}
|
||||
}
|
||||
|
||||
/// given `effect : Effect a`, unwrap the thunk and force it, giving a value of type `a`
|
||||
fn force_effect(
|
||||
effect: Expr,
|
||||
effect_tag_name: TagName,
|
||||
thunk_symbol: Symbol,
|
||||
var_store: &mut VarStore,
|
||||
) -> Expr {
|
||||
let whole_var = var_store.fresh();
|
||||
let ext_var = var_store.fresh();
|
||||
|
||||
let thunk_var = var_store.fresh();
|
||||
|
||||
let pattern = Pattern::AppliedTag {
|
||||
ext_var,
|
||||
whole_var,
|
||||
tag_name: effect_tag_name,
|
||||
arguments: vec![(thunk_var, Loc::at_zero(Pattern::Identifier(thunk_symbol)))],
|
||||
};
|
||||
|
||||
let pattern_vars = SendMap::default();
|
||||
// pattern_vars.insert(thunk_symbol, thunk_var);
|
||||
|
||||
let def = Def {
|
||||
loc_pattern: Loc::at_zero(pattern),
|
||||
loc_expr: Loc::at_zero(effect),
|
||||
expr_var: var_store.fresh(),
|
||||
pattern_vars,
|
||||
annotation: None,
|
||||
};
|
||||
|
||||
let ret_var = var_store.fresh();
|
||||
|
||||
let force_thunk_call = {
|
||||
let boxed = (
|
||||
var_store.fresh(),
|
||||
Loc::at_zero(Expr::Var(thunk_symbol)),
|
||||
var_store.fresh(),
|
||||
ret_var,
|
||||
);
|
||||
|
||||
let arguments = vec![(var_store.fresh(), Loc::at_zero(Expr::EmptyRecord))];
|
||||
let call = Expr::Call(Box::new(boxed), arguments, CalledVia::Space);
|
||||
|
||||
Loc::at_zero(call)
|
||||
};
|
||||
|
||||
Expr::LetNonRec(Box::new(def), Box::new(force_thunk_call), var_store.fresh())
|
||||
}
|
||||
|
||||
fn build_effect_forever(
|
||||
env: &mut Env,
|
||||
scope: &mut Scope,
|
||||
effect_symbol: Symbol,
|
||||
effect_tag_name: TagName,
|
||||
var_store: &mut VarStore,
|
||||
) -> (Symbol, Def) {
|
||||
// morally
|
||||
//
|
||||
// Effect.forever = \effect -> Effect.after effect (\_ -> Effect.forever effect)
|
||||
//
|
||||
// Here we inline the `Effect.after`, and get
|
||||
//
|
||||
// Effect.forever : Effect a -> Effect b
|
||||
// Effect.forever = \effect ->
|
||||
// @Effect \{} ->
|
||||
// @Effect thunk1 = effect
|
||||
// _ = thunk1 {}
|
||||
// @Effect thunk2 = Effect.forever effect
|
||||
// thunk2 {}
|
||||
//
|
||||
// We then rely on our defunctionalization to turn this into a tail-recursive loop.
|
||||
// First the `@Effect` wrapper melts away
|
||||
//
|
||||
// Effect.forever : ({} -> a) -> ({} -> b)
|
||||
// Effect.forever = \effect ->
|
||||
// \{} ->
|
||||
// thunk1 = effect
|
||||
// _ = thunk1 {}
|
||||
// thunk2 = Effect.forever effect
|
||||
// thunk2 {}
|
||||
//
|
||||
// Then we defunctionalize
|
||||
//
|
||||
// foreverInner = \{}, { effect } ->
|
||||
// thunk1 = effect
|
||||
// _ = thunk1 {}
|
||||
// thunk2 = Effect.forever effect
|
||||
// thunk2 {}
|
||||
//
|
||||
// Effect.forever : [ C foreverInner { effect : T } ]
|
||||
// Effect.forever = \effect ->
|
||||
// C { effect }
|
||||
//
|
||||
// And we have to adjust the call
|
||||
//
|
||||
// foreverInner = \{}, { effect } ->
|
||||
// thunk1 = effect
|
||||
// _ = thunk1 {}
|
||||
// thunk2 = Effect.forever effect
|
||||
// when thunk2 is
|
||||
// C env -> foreverInner {} env.effect
|
||||
//
|
||||
// Making `foreverInner` perfectly tail-call optimizable
|
||||
|
||||
let forever_symbol = {
|
||||
scope
|
||||
.introduce(
|
||||
"forever".into(),
|
||||
&env.exposed_ident_ids,
|
||||
&mut env.ident_ids,
|
||||
Region::zero(),
|
||||
)
|
||||
.unwrap()
|
||||
};
|
||||
|
||||
let effect = {
|
||||
scope
|
||||
.introduce(
|
||||
"effect".into(),
|
||||
&env.exposed_ident_ids,
|
||||
&mut env.ident_ids,
|
||||
Region::zero(),
|
||||
)
|
||||
.unwrap()
|
||||
};
|
||||
|
||||
let body = build_effect_forever_body(
|
||||
env,
|
||||
scope,
|
||||
effect_tag_name.clone(),
|
||||
forever_symbol,
|
||||
effect,
|
||||
var_store,
|
||||
);
|
||||
|
||||
let arguments = vec![(var_store.fresh(), Loc::at_zero(Pattern::Identifier(effect)))];
|
||||
|
||||
let function_var = var_store.fresh();
|
||||
let after_closure = Expr::Closure(ClosureData {
|
||||
function_type: var_store.fresh(),
|
||||
closure_type: var_store.fresh(),
|
||||
closure_ext_var: var_store.fresh(),
|
||||
return_type: var_store.fresh(),
|
||||
name: forever_symbol,
|
||||
captured_symbols: Vec::new(),
|
||||
recursive: Recursive::Recursive,
|
||||
arguments,
|
||||
loc_body: Box::new(Loc::at_zero(body)),
|
||||
});
|
||||
|
||||
let mut introduced_variables = IntroducedVariables::default();
|
||||
|
||||
let signature = {
|
||||
let var_a = var_store.fresh();
|
||||
let var_b = var_store.fresh();
|
||||
|
||||
introduced_variables.insert_named("a".into(), var_a);
|
||||
introduced_variables.insert_named("b".into(), var_b);
|
||||
|
||||
let effect_a = build_effect_alias(
|
||||
effect_symbol,
|
||||
effect_tag_name.clone(),
|
||||
"a",
|
||||
var_a,
|
||||
Type::Variable(var_a),
|
||||
var_store,
|
||||
&mut introduced_variables,
|
||||
);
|
||||
|
||||
let effect_b = build_effect_alias(
|
||||
effect_symbol,
|
||||
effect_tag_name,
|
||||
"b",
|
||||
var_b,
|
||||
Type::Variable(var_b),
|
||||
var_store,
|
||||
&mut introduced_variables,
|
||||
);
|
||||
|
||||
let closure_var = var_store.fresh();
|
||||
introduced_variables.insert_wildcard(closure_var);
|
||||
|
||||
Type::Function(
|
||||
vec![effect_a],
|
||||
Box::new(Type::Variable(closure_var)),
|
||||
Box::new(effect_b),
|
||||
)
|
||||
};
|
||||
|
||||
let def_annotation = roc_can::def::Annotation {
|
||||
signature,
|
||||
introduced_variables,
|
||||
aliases: SendMap::default(),
|
||||
region: Region::zero(),
|
||||
};
|
||||
|
||||
let pattern = Pattern::Identifier(forever_symbol);
|
||||
let mut pattern_vars = SendMap::default();
|
||||
pattern_vars.insert(forever_symbol, function_var);
|
||||
let def = Def {
|
||||
loc_pattern: Loc::at_zero(pattern),
|
||||
loc_expr: Loc::at_zero(after_closure),
|
||||
expr_var: function_var,
|
||||
pattern_vars,
|
||||
annotation: Some(def_annotation),
|
||||
};
|
||||
|
||||
(forever_symbol, def)
|
||||
}
|
||||
|
||||
fn build_effect_forever_body(
|
||||
env: &mut Env,
|
||||
scope: &mut Scope,
|
||||
effect_tag_name: TagName,
|
||||
forever_symbol: Symbol,
|
||||
effect: Symbol,
|
||||
var_store: &mut VarStore,
|
||||
) -> Expr {
|
||||
let closure_name = {
|
||||
scope
|
||||
.introduce(
|
||||
"forever_inner".into(),
|
||||
&env.exposed_ident_ids,
|
||||
&mut env.ident_ids,
|
||||
Region::zero(),
|
||||
)
|
||||
.unwrap()
|
||||
};
|
||||
|
||||
let inner_body = build_effect_forever_inner_body(
|
||||
env,
|
||||
scope,
|
||||
effect_tag_name.clone(),
|
||||
forever_symbol,
|
||||
effect,
|
||||
var_store,
|
||||
);
|
||||
|
||||
let captured_symbols = vec![effect];
|
||||
wrap_in_effect_thunk(
|
||||
inner_body,
|
||||
effect_tag_name,
|
||||
closure_name,
|
||||
captured_symbols,
|
||||
var_store,
|
||||
)
|
||||
}
|
||||
|
||||
fn build_effect_forever_inner_body(
|
||||
env: &mut Env,
|
||||
scope: &mut Scope,
|
||||
effect_tag_name: TagName,
|
||||
forever_symbol: Symbol,
|
||||
effect: Symbol,
|
||||
var_store: &mut VarStore,
|
||||
) -> Expr {
|
||||
let thunk1_symbol = {
|
||||
scope
|
||||
.introduce(
|
||||
"thunk1".into(),
|
||||
&env.exposed_ident_ids,
|
||||
&mut env.ident_ids,
|
||||
Region::zero(),
|
||||
)
|
||||
.unwrap()
|
||||
};
|
||||
|
||||
let thunk2_symbol = {
|
||||
scope
|
||||
.introduce(
|
||||
"thunk2".into(),
|
||||
&env.exposed_ident_ids,
|
||||
&mut env.ident_ids,
|
||||
Region::zero(),
|
||||
)
|
||||
.unwrap()
|
||||
};
|
||||
|
||||
// Effect thunk1 = effect
|
||||
let thunk_from_effect = {
|
||||
let whole_var = var_store.fresh();
|
||||
let ext_var = var_store.fresh();
|
||||
|
||||
let thunk_var = var_store.fresh();
|
||||
|
||||
let pattern = Pattern::AppliedTag {
|
||||
ext_var,
|
||||
whole_var,
|
||||
tag_name: effect_tag_name.clone(),
|
||||
arguments: vec![(thunk_var, Loc::at_zero(Pattern::Identifier(thunk1_symbol)))],
|
||||
};
|
||||
|
||||
let pattern_vars = SendMap::default();
|
||||
|
||||
Def {
|
||||
loc_pattern: Loc::at_zero(pattern),
|
||||
loc_expr: Loc::at_zero(Expr::Var(effect)),
|
||||
expr_var: var_store.fresh(),
|
||||
pattern_vars,
|
||||
annotation: None,
|
||||
}
|
||||
};
|
||||
|
||||
// thunk1 {}
|
||||
let force_thunk_call = {
|
||||
let ret_var = var_store.fresh();
|
||||
let boxed = (
|
||||
var_store.fresh(),
|
||||
Loc::at_zero(Expr::Var(thunk1_symbol)),
|
||||
var_store.fresh(),
|
||||
ret_var,
|
||||
);
|
||||
|
||||
let arguments = vec![(var_store.fresh(), Loc::at_zero(Expr::EmptyRecord))];
|
||||
let call = Expr::Call(Box::new(boxed), arguments, CalledVia::Space);
|
||||
|
||||
Loc::at_zero(call)
|
||||
};
|
||||
|
||||
// _ = thunk1 {}
|
||||
let force_thunk1 = Def {
|
||||
loc_pattern: Loc::at_zero(Pattern::Underscore),
|
||||
loc_expr: force_thunk_call,
|
||||
expr_var: var_store.fresh(),
|
||||
pattern_vars: Default::default(),
|
||||
annotation: None,
|
||||
};
|
||||
|
||||
// recursive call `forever effect`
|
||||
let forever_effect = {
|
||||
let boxed = (
|
||||
var_store.fresh(),
|
||||
Loc::at_zero(Expr::Var(forever_symbol)),
|
||||
var_store.fresh(),
|
||||
var_store.fresh(),
|
||||
);
|
||||
|
||||
let arguments = vec![(var_store.fresh(), Loc::at_zero(Expr::Var(effect)))];
|
||||
Expr::Call(Box::new(boxed), arguments, CalledVia::Space)
|
||||
};
|
||||
|
||||
// ```
|
||||
// Effect thunk2 = forever effect
|
||||
// thunk2 {}
|
||||
// ```
|
||||
let force_thunk2 = Loc::at_zero(force_effect(
|
||||
forever_effect,
|
||||
effect_tag_name,
|
||||
thunk2_symbol,
|
||||
var_store,
|
||||
));
|
||||
|
||||
Expr::LetNonRec(
|
||||
Box::new(thunk_from_effect),
|
||||
Box::new(Loc::at_zero(Expr::LetNonRec(
|
||||
Box::new(force_thunk1),
|
||||
Box::new(force_thunk2),
|
||||
var_store.fresh(),
|
||||
))),
|
||||
var_store.fresh(),
|
||||
)
|
||||
}
|
||||
|
||||
fn build_effect_loop(
|
||||
env: &mut Env,
|
||||
scope: &mut Scope,
|
||||
effect_symbol: Symbol,
|
||||
effect_tag_name: TagName,
|
||||
var_store: &mut VarStore,
|
||||
) -> (Symbol, Def) {
|
||||
let loop_symbol = new_symbol!(scope, env, "loop");
|
||||
let state_symbol = new_symbol!(scope, env, "state");
|
||||
let step_symbol = new_symbol!(scope, env, "step");
|
||||
|
||||
let body = build_effect_loop_body(
|
||||
env,
|
||||
scope,
|
||||
effect_tag_name.clone(),
|
||||
loop_symbol,
|
||||
state_symbol,
|
||||
step_symbol,
|
||||
var_store,
|
||||
);
|
||||
|
||||
let arguments = vec![
|
||||
(
|
||||
var_store.fresh(),
|
||||
Loc::at_zero(Pattern::Identifier(state_symbol)),
|
||||
),
|
||||
(
|
||||
var_store.fresh(),
|
||||
Loc::at_zero(Pattern::Identifier(step_symbol)),
|
||||
),
|
||||
];
|
||||
|
||||
let function_var = var_store.fresh();
|
||||
let after_closure = Expr::Closure(ClosureData {
|
||||
function_type: var_store.fresh(),
|
||||
closure_type: var_store.fresh(),
|
||||
closure_ext_var: var_store.fresh(),
|
||||
return_type: var_store.fresh(),
|
||||
name: loop_symbol,
|
||||
captured_symbols: Vec::new(),
|
||||
recursive: Recursive::Recursive,
|
||||
arguments,
|
||||
loc_body: Box::new(Loc::at_zero(body)),
|
||||
});
|
||||
|
||||
let mut introduced_variables = IntroducedVariables::default();
|
||||
|
||||
let signature = {
|
||||
let var_a = var_store.fresh();
|
||||
let var_b = var_store.fresh();
|
||||
|
||||
introduced_variables.insert_named("a".into(), var_a);
|
||||
introduced_variables.insert_named("b".into(), var_b);
|
||||
|
||||
let effect_b = build_effect_alias(
|
||||
effect_symbol,
|
||||
effect_tag_name.clone(),
|
||||
"b",
|
||||
var_b,
|
||||
Type::Variable(var_b),
|
||||
var_store,
|
||||
&mut introduced_variables,
|
||||
);
|
||||
|
||||
let state_type = {
|
||||
let step_tag_name = TagName::Global("Step".into());
|
||||
let done_tag_name = TagName::Global("Done".into());
|
||||
|
||||
Type::TagUnion(
|
||||
vec![
|
||||
(step_tag_name, vec![Type::Variable(var_a)]),
|
||||
(done_tag_name, vec![Type::Variable(var_b)]),
|
||||
],
|
||||
Box::new(Type::EmptyTagUnion),
|
||||
)
|
||||
};
|
||||
|
||||
let effect_state_type = {
|
||||
let closure_var = var_store.fresh();
|
||||
introduced_variables.insert_wildcard(closure_var);
|
||||
|
||||
let actual = {
|
||||
Type::TagUnion(
|
||||
vec![(
|
||||
effect_tag_name,
|
||||
vec![Type::Function(
|
||||
vec![Type::EmptyRec],
|
||||
Box::new(Type::Variable(closure_var)),
|
||||
Box::new(state_type.clone()),
|
||||
)],
|
||||
)],
|
||||
Box::new(Type::EmptyTagUnion),
|
||||
)
|
||||
};
|
||||
|
||||
Type::Alias {
|
||||
symbol: effect_symbol,
|
||||
type_arguments: vec![("a".into(), state_type)],
|
||||
lambda_set_variables: vec![roc_types::types::LambdaSet(Type::Variable(
|
||||
closure_var,
|
||||
))],
|
||||
actual: Box::new(actual),
|
||||
}
|
||||
};
|
||||
|
||||
let closure_var = var_store.fresh();
|
||||
introduced_variables.insert_wildcard(closure_var);
|
||||
|
||||
let step_type = Type::Function(
|
||||
vec![Type::Variable(var_a)],
|
||||
Box::new(Type::Variable(closure_var)),
|
||||
Box::new(effect_state_type),
|
||||
);
|
||||
|
||||
let closure_var = var_store.fresh();
|
||||
introduced_variables.insert_wildcard(closure_var);
|
||||
|
||||
Type::Function(
|
||||
vec![Type::Variable(var_a), step_type],
|
||||
Box::new(Type::Variable(closure_var)),
|
||||
Box::new(effect_b),
|
||||
)
|
||||
};
|
||||
|
||||
let def_annotation = roc_can::def::Annotation {
|
||||
signature,
|
||||
introduced_variables,
|
||||
aliases: SendMap::default(),
|
||||
region: Region::zero(),
|
||||
};
|
||||
|
||||
let pattern = Pattern::Identifier(loop_symbol);
|
||||
let mut pattern_vars = SendMap::default();
|
||||
pattern_vars.insert(loop_symbol, function_var);
|
||||
let def = Def {
|
||||
loc_pattern: Loc::at_zero(pattern),
|
||||
loc_expr: Loc::at_zero(after_closure),
|
||||
expr_var: function_var,
|
||||
pattern_vars,
|
||||
annotation: Some(def_annotation),
|
||||
};
|
||||
|
||||
(loop_symbol, def)
|
||||
}
|
||||
|
||||
fn build_effect_loop_body(
|
||||
env: &mut Env,
|
||||
scope: &mut Scope,
|
||||
effect_tag_name: TagName,
|
||||
loop_symbol: Symbol,
|
||||
state_symbol: Symbol,
|
||||
step_symbol: Symbol,
|
||||
var_store: &mut VarStore,
|
||||
) -> Expr {
|
||||
let closure_name = {
|
||||
scope
|
||||
.introduce(
|
||||
"loop_inner".into(),
|
||||
&env.exposed_ident_ids,
|
||||
&mut env.ident_ids,
|
||||
Region::zero(),
|
||||
)
|
||||
.unwrap()
|
||||
};
|
||||
|
||||
let inner_body = build_effect_loop_inner_body(
|
||||
env,
|
||||
scope,
|
||||
effect_tag_name.clone(),
|
||||
loop_symbol,
|
||||
state_symbol,
|
||||
step_symbol,
|
||||
var_store,
|
||||
);
|
||||
|
||||
let captured_symbols = vec![state_symbol, step_symbol];
|
||||
wrap_in_effect_thunk(
|
||||
inner_body,
|
||||
effect_tag_name,
|
||||
closure_name,
|
||||
captured_symbols,
|
||||
var_store,
|
||||
)
|
||||
}
|
||||
|
||||
fn applied_tag_pattern(
|
||||
tag_name: TagName,
|
||||
argument_symbols: &[Symbol],
|
||||
var_store: &mut VarStore,
|
||||
) -> Pattern {
|
||||
let arguments = argument_symbols
|
||||
.iter()
|
||||
.map(|s| {
|
||||
let pattern = Pattern::Identifier(*s);
|
||||
|
||||
(var_store.fresh(), Loc::at_zero(pattern))
|
||||
})
|
||||
.collect();
|
||||
|
||||
Pattern::AppliedTag {
|
||||
ext_var: var_store.fresh(),
|
||||
whole_var: var_store.fresh(),
|
||||
tag_name,
|
||||
arguments,
|
||||
}
|
||||
}
|
||||
|
||||
fn build_effect_loop_inner_body(
|
||||
env: &mut Env,
|
||||
scope: &mut Scope,
|
||||
effect_tag_name: TagName,
|
||||
loop_symbol: Symbol,
|
||||
state_symbol: Symbol,
|
||||
step_symbol: Symbol,
|
||||
var_store: &mut VarStore,
|
||||
) -> Expr {
|
||||
let thunk1_symbol = new_symbol!(scope, env, "thunk3");
|
||||
let thunk2_symbol = new_symbol!(scope, env, "thunk4");
|
||||
|
||||
let new_state_symbol = new_symbol!(scope, env, "newState");
|
||||
let done_symbol = new_symbol!(scope, env, "done");
|
||||
|
||||
// Effect thunk1 = step state
|
||||
let thunk_from_effect = {
|
||||
let whole_var = var_store.fresh();
|
||||
let ext_var = var_store.fresh();
|
||||
|
||||
let thunk_var = var_store.fresh();
|
||||
|
||||
let pattern = Pattern::AppliedTag {
|
||||
ext_var,
|
||||
whole_var,
|
||||
tag_name: effect_tag_name.clone(),
|
||||
arguments: vec![(thunk_var, Loc::at_zero(Pattern::Identifier(thunk1_symbol)))],
|
||||
};
|
||||
|
||||
let pattern_vars = SendMap::default();
|
||||
|
||||
// `step state`
|
||||
let rhs = {
|
||||
let boxed = (
|
||||
var_store.fresh(),
|
||||
Loc::at_zero(Expr::Var(step_symbol)),
|
||||
var_store.fresh(),
|
||||
var_store.fresh(),
|
||||
);
|
||||
|
||||
let arguments = vec![(var_store.fresh(), Loc::at_zero(Expr::Var(state_symbol)))];
|
||||
Expr::Call(Box::new(boxed), arguments, CalledVia::Space)
|
||||
};
|
||||
|
||||
Def {
|
||||
loc_pattern: Loc::at_zero(pattern),
|
||||
loc_expr: Loc::at_zero(rhs),
|
||||
expr_var: var_store.fresh(),
|
||||
pattern_vars,
|
||||
annotation: None,
|
||||
}
|
||||
};
|
||||
|
||||
// thunk1 {}
|
||||
let force_thunk_call = {
|
||||
let ret_var = var_store.fresh();
|
||||
let boxed = (
|
||||
var_store.fresh(),
|
||||
Loc::at_zero(Expr::Var(thunk1_symbol)),
|
||||
var_store.fresh(),
|
||||
ret_var,
|
||||
);
|
||||
|
||||
let arguments = vec![(var_store.fresh(), Loc::at_zero(Expr::EmptyRecord))];
|
||||
let call = Expr::Call(Box::new(boxed), arguments, CalledVia::Space);
|
||||
|
||||
Loc::at_zero(call)
|
||||
};
|
||||
|
||||
// recursive call `loop newState step`
|
||||
let loop_new_state_step = {
|
||||
let boxed = (
|
||||
var_store.fresh(),
|
||||
Loc::at_zero(Expr::Var(loop_symbol)),
|
||||
var_store.fresh(),
|
||||
var_store.fresh(),
|
||||
);
|
||||
|
||||
let arguments = vec![
|
||||
(var_store.fresh(), Loc::at_zero(Expr::Var(new_state_symbol))),
|
||||
(var_store.fresh(), Loc::at_zero(Expr::Var(step_symbol))),
|
||||
];
|
||||
Expr::Call(Box::new(boxed), arguments, CalledVia::Space)
|
||||
};
|
||||
|
||||
// ```
|
||||
// Effect thunk2 = loop effect
|
||||
// thunk2 {}
|
||||
// ```
|
||||
let force_thunk2 = force_effect(
|
||||
loop_new_state_step,
|
||||
effect_tag_name,
|
||||
thunk2_symbol,
|
||||
var_store,
|
||||
);
|
||||
|
||||
let step_branch = {
|
||||
let step_tag_name = TagName::Global("Step".into());
|
||||
|
||||
let step_pattern = applied_tag_pattern(step_tag_name, &[new_state_symbol], var_store);
|
||||
|
||||
roc_can::expr::WhenBranch {
|
||||
patterns: vec![Loc::at_zero(step_pattern)],
|
||||
value: Loc::at_zero(force_thunk2),
|
||||
guard: None,
|
||||
}
|
||||
};
|
||||
|
||||
let done_branch = {
|
||||
let done_tag_name = TagName::Global("Done".into());
|
||||
let done_pattern = applied_tag_pattern(done_tag_name, &[done_symbol], var_store);
|
||||
|
||||
roc_can::expr::WhenBranch {
|
||||
patterns: vec![Loc::at_zero(done_pattern)],
|
||||
value: Loc::at_zero(Expr::Var(done_symbol)),
|
||||
guard: None,
|
||||
}
|
||||
};
|
||||
|
||||
let branches = vec![step_branch, done_branch];
|
||||
|
||||
let match_on_force_thunk1 = Expr::When {
|
||||
cond_var: var_store.fresh(),
|
||||
expr_var: var_store.fresh(),
|
||||
region: Region::zero(),
|
||||
loc_cond: Box::new(force_thunk_call),
|
||||
branches,
|
||||
};
|
||||
|
||||
Expr::LetNonRec(
|
||||
Box::new(thunk_from_effect),
|
||||
Box::new(Loc::at_zero(match_on_force_thunk1)),
|
||||
var_store.fresh(),
|
||||
)
|
||||
}
|
||||
|
||||
pub fn build_host_exposed_def(
|
||||
env: &mut Env,
|
||||
scope: &mut Scope,
|
||||
|
@ -738,15 +738,19 @@ impl<'a> Procs<'a> {
|
||||
ret_var: Variable,
|
||||
layout_cache: &mut LayoutCache<'a>,
|
||||
) -> Result<ProcLayout<'a>, RuntimeError> {
|
||||
// anonymous functions cannot reference themselves, therefore cannot be tail-recursive
|
||||
let is_self_recursive = false;
|
||||
|
||||
let raw_layout = layout_cache
|
||||
.raw_from_var(env.arena, annotation, env.subs)
|
||||
.unwrap_or_else(|err| panic!("TODO turn fn_var into a RuntimeError {:?}", err));
|
||||
|
||||
let top_level = ProcLayout::from_raw(env.arena, raw_layout);
|
||||
|
||||
// anonymous functions cannot reference themselves, therefore cannot be tail-recursive
|
||||
// EXCEPT when the closure conversion makes it tail-recursive.
|
||||
let is_self_recursive = match top_level.arguments.last() {
|
||||
Some(Layout::LambdaSet(lambda_set)) => lambda_set.contains(symbol),
|
||||
_ => false,
|
||||
};
|
||||
|
||||
match patterns_to_when(env, layout_cache, loc_args, ret_var, loc_body) {
|
||||
Ok((_, pattern_symbols, body)) => {
|
||||
// an anonymous closure. These will always be specialized already
|
||||
|
@ -569,6 +569,11 @@ impl<'a> LambdaSet<'a> {
|
||||
*self.representation
|
||||
}
|
||||
|
||||
/// Does the lambda set contain the given symbol?
|
||||
pub fn contains(&self, symbol: Symbol) -> bool {
|
||||
self.set.iter().any(|(s, _)| *s == symbol)
|
||||
}
|
||||
|
||||
pub fn is_represented(&self) -> Option<Layout<'a>> {
|
||||
if let Layout::Struct(&[]) = self.representation {
|
||||
None
|
||||
|
@ -1,9 +1,42 @@
|
||||
interface Task
|
||||
exposes [ Task, succeed, fail, after, map, putLine, putInt, getInt ]
|
||||
exposes [ Task, succeed, fail, after, map, putLine, putInt, getInt, forever, loop ]
|
||||
imports [ fx.Effect ]
|
||||
|
||||
Task ok err : Effect.Effect (Result ok err)
|
||||
|
||||
forever : Task val err -> Task * err
|
||||
forever = \task ->
|
||||
looper = \{ } ->
|
||||
task
|
||||
|> Effect.map
|
||||
\res ->
|
||||
when res is
|
||||
Ok _ ->
|
||||
Step {}
|
||||
|
||||
Err e ->
|
||||
Done (Err e)
|
||||
|
||||
Effect.loop {} looper
|
||||
|
||||
loop : state, (state -> Task [ Step state, Done done ] err) -> Task done err
|
||||
loop = \state, step ->
|
||||
looper = \current ->
|
||||
step current
|
||||
|> Effect.map
|
||||
\res ->
|
||||
when res is
|
||||
Ok (Step newState) ->
|
||||
Step newState
|
||||
|
||||
Ok (Done result) ->
|
||||
Done (Ok result)
|
||||
|
||||
Err e ->
|
||||
Done (Err e)
|
||||
|
||||
Effect.loop state looper
|
||||
|
||||
succeed : val -> Task val *
|
||||
succeed = \val ->
|
||||
Effect.always (Ok val)
|
||||
|
@ -1,9 +1,42 @@
|
||||
interface Task
|
||||
exposes [ Task, succeed, fail, await, map, onFail, attempt ]
|
||||
exposes [ Task, succeed, fail, await, map, onFail, attempt, forever, loop ]
|
||||
imports [ fx.Effect ]
|
||||
|
||||
Task ok err : Effect.Effect (Result ok err)
|
||||
|
||||
forever : Task val err -> Task * err
|
||||
forever = \task ->
|
||||
looper = \{ } ->
|
||||
task
|
||||
|> Effect.map
|
||||
\res ->
|
||||
when res is
|
||||
Ok _ ->
|
||||
Step {}
|
||||
|
||||
Err e ->
|
||||
Done (Err e)
|
||||
|
||||
Effect.loop {} looper
|
||||
|
||||
loop : state, (state -> Task [ Step state, Done done ] err) -> Task done err
|
||||
loop = \state, step ->
|
||||
looper = \current ->
|
||||
step current
|
||||
|> Effect.map
|
||||
\res ->
|
||||
when res is
|
||||
Ok (Step newState) ->
|
||||
Step newState
|
||||
|
||||
Ok (Done result) ->
|
||||
Done (Ok result)
|
||||
|
||||
Err e ->
|
||||
Done (Err e)
|
||||
|
||||
Effect.loop state looper
|
||||
|
||||
succeed : val -> Task val *
|
||||
succeed = \val ->
|
||||
Effect.always (Ok val)
|
||||
|
Loading…
Reference in New Issue
Block a user