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

Try different List.map unique implementation

Browse Source
This commit is contained in:
Chad Stearns 2020-08-22 19:46:29 -04:00
commit 800b99d165
30 changed files with 2172 additions and 604 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
cli/src/repl.rs
View File

@ -258,8 +258,13 @@ pub fn gen(src: &[u8], target: Triple, opt_level: OptLevel) -> Result<(String, S
};
let main_body = roc_mono::ir::Stmt::new(&mut mono_env, loc_expr.value, &mut procs);
let main_body =
roc_mono::inc_dec::visit_declaration(mono_env.arena, mono_env.arena.alloc(main_body));
let param_map = roc_mono::borrow::ParamMap::default();
let main_body = roc_mono::inc_dec::visit_declaration(
mono_env.arena,
mono_env.arena.alloc(param_map),
mono_env.arena.alloc(main_body),
);
let mut headers = {
let num_headers = match &procs.pending_specializations {
Some(map) => map.len(),
@ -294,21 +299,20 @@ pub fn gen(src: &[u8], target: Triple, opt_level: OptLevel) -> Result<(String, S
panic!("A specialization was still marked InProgress after monomorphization had completed: {:?} with layout {:?}", symbol, layout);
}
Done(proc) => {
let (fn_val, arg_basic_types) =
build_proc_header(&env, &mut layout_ids, symbol, &layout, &proc);
let fn_val = build_proc_header(&env, &mut layout_ids, symbol, &layout, &proc);
headers.push((proc, fn_val, arg_basic_types));
headers.push((proc, fn_val));
}
}
}
// Build each proc using its header info.
for (proc, fn_val, arg_basic_types) in headers {
for (proc, fn_val) in headers {
// NOTE: This is here to be uncommented in case verification fails.
// (This approach means we don't have to defensively clone name here.)
//
// println!("\n\nBuilding and then verifying function {}\n\n", name);
build_proc(&env, &mut layout_ids, proc, fn_val, arg_basic_types);
build_proc(&env, &mut layout_ids, proc, fn_val);
if fn_val.verify(true) {
fpm.run_on(&fn_val);

11
compiler/build/src/program.rs
View File

@ -158,7 +158,7 @@ pub fn gen(
pattern_symbols: bumpalo::collections::Vec::new_in(
mono_env.arena,
),
is_tail_recursive: false,
is_self_recursive: false,
body,
};
@ -250,19 +250,18 @@ pub fn gen(
// We have to do this in a separate pass first,
// because their bodies may reference each other.
for ((symbol, layout), proc) in procs.get_specialized_procs(arena) {
let (fn_val, arg_basic_types) =
build_proc_header(&env, &mut layout_ids, symbol, &layout, &proc);
let fn_val = build_proc_header(&env, &mut layout_ids, symbol, &layout, &proc);
headers.push((proc, fn_val, arg_basic_types));
headers.push((proc, fn_val));
}
// Build each proc using its header info.
for (proc, fn_val, arg_basic_types) in headers {
for (proc, fn_val) in headers {
// NOTE: This is here to be uncommented in case verification fails.
// (This approach means we don't have to defensively clone name here.)
//
// println!("\n\nBuilding and then verifying function {:?}\n\n", proc);
build_proc(&env, &mut layout_ids, proc, fn_val, arg_basic_types);
build_proc(&env, &mut layout_ids, proc, fn_val);
if fn_val.verify(true) {
fpm.run_on(&fn_val);

9
compiler/builtins/docs/List.roc
View File

@ -347,8 +347,17 @@ min : List (Num a) -> Result (Num a) [ ListWasEmpty ]*
##
## If the given index is outside the bounds of the list, returns the original
## list unmodified.
##
## To drop the element at a given index, instead of replacing it, see #List.drop.
put : List elem, Len, elem -> List elem
## Drops the element at the given index from the list.
##
## This has no effect if the given index is outside the bounds of the list.
##
## To replace the element at a given index, instead of dropping it, see #List.put.
drop : List elem, Len -> List elem
## Adds a new element to the end of the list.
##
## >>> List.append [ "a", "b" ] "c"

3
compiler/builtins/docs/Set.roc
View File

@ -14,7 +14,8 @@ len : Set * -> Len
add : Set 'elem, 'elem -> Set 'elem
rem : Set 'elem, 'elem -> Set 'elem
## Drops the given element from the set.
drop : Set 'elem, 'elem -> Set 'elem
## Convert each element in the set to something new, by calling a conversion
## function on each of them. Then return a new set of the converted values.

198
compiler/builtins/docs/Str.roc
View File

@ -7,33 +7,36 @@ interface Str exposes [ Str, isEmpty, join ] imports []
##
## _For more advanced use cases like working with raw [code points](https://unicode.org/glossary/#code_point),
## see the [roc/unicode](roc/unicode) package. For locale-specific text
## functions (including capitalizing a string, as capitalization rules vary by locale)
## see the [roc/locale](roc/locale) package._
## functions (including uppercasing strings, as capitalization rules vary by locale;
## in English, `"i"` capitalizes to `"I"`, but [in Turkish](https://en.wikipedia.org/wiki/Dotted_and_dotless_I#In_computing),
## the same `"i"` capitalizes to `"İ"` - as well as sorting strings, which also varies
## by locale; `"ö"` is sorted differently in German and Swedish) see the [roc/locale](roc/locale) package._
##
## ### Unicode
##
## Unicode can represent text values which span multiple languages, symbols, and emoji.
## Here are some valid Roc strings:
##
## "Roc"
## "Roc!"
## "鹏"
## "🕊"
##
## Every Unicode string is a sequence of [grapheme clusters](https://unicode.org/glossary/#grapheme_cluster).
## A grapheme cluster corresponds to what a person reading a string might call a "character",
## but because the term "character" is used to mean many different concepts across
## different programming languages, the documentation for Roc strings intentionally
## avoids it. Instead, we use the term "clusters" as a shorthand for "grapheme clusters."
## Every Unicode string is a sequence of [extended grapheme clusters](http://www.unicode.org/glossary/#extended_grapheme_cluster).
## An extended grapheme cluster represents what a person reading a string might
## call a "character" - like "A" or "ö" or "👩‍👩‍👦‍👦".
## Because the term "character" means different things in different areas of
## programming, and "extended grapheme cluster" is a mouthful, in Roc we use the
## term "grapheme" as a shorthand for the more precise "extended grapheme cluster."
##
## You can get the number of grapheme clusters in a string by calling #Str.countClusters on it:
## You can get the number of graphemes in a string by calling #Str.countGraphemes on it:
##
## Str.countClusters "Roc!"
## Str.countClusters "折り紙"
## Str.countClusters "🕊"
## Str.countGraphemes "Roc!"
## Str.countGraphemes "折り紙"
## Str.countGraphemes "🕊"
##
## > The `countClusters` function walks through the entire string to get its answer,
## > The `countGraphemes` function walks through the entire string to get its answer,
## > so if you want to check whether a string is empty, you'll get much better performance
## > by calling `Str.isEmpty myStr` instead of `Str.countClusters myStr == 0`.
## > by calling `Str.isEmpty myStr` instead of `Str.countGraphemes myStr == 0`.
##
## ### Escape sequences
##
@ -107,7 +110,7 @@ Str : [ @Str ]
##
## If you want to keep all the digits, passing the same float to #Str.num
## will do that.
decimal : Float *, Ulen -> Str
decimal : Float *, Len -> Str
## Split a string around a separator.
##
@ -118,7 +121,7 @@ decimal : Float *, Ulen -> Str
##
## >>> Str.split "1,2,3" ""
##
## To split a string into its individual grapheme clusters, use #Str.clusters
## To split a string into its individual graphemes, use #Str.graphemes
split : Str, Str -> List Str
## Check
@ -136,9 +139,9 @@ endsWith : Str, Str -> Bool
contains : Str, Str -> Bool
anyClusters : Str, (Str -> Bool) -> Bool
anyGraphemes : Str, (Str -> Bool) -> Bool
allClusters : Str, (Str -> Bool) -> Bool
allGraphemes : Str, (Str -> Bool) -> Bool
## Combine
@ -154,60 +157,69 @@ join : List Str -> Str
joinWith : List Str, Str -> Str
## Add to the start of a string until it has at least the given number of
## grapheme clusters.
## graphemes.
##
## >>> Str.padClustersStart "0" 5 "36"
## >>> Str.padGraphemesStart "0" 5 "36"
##
## >>> Str.padClustersStart "0" 1 "36"
## >>> Str.padGraphemesStart "0" 1 "36"
##
## >>> Str.padClustersStart "0" 5 "12345"
## >>> Str.padGraphemesStart "0" 5 "12345"
##
## >>> Str.padClustersStart "✈️"" 5 "👩‍👩‍👦‍👦👩‍👩‍👦‍👦👩‍👩‍👦‍👦"
padClustersStart : Str, Int, Str -> Str
## >>> Str.padGraphemesStart "✈️"" 5 "👩‍👩‍👦‍👦👩‍👩‍👦‍👦👩‍👩‍👦‍👦"
padGraphemesStart : Str, Int, Str -> Str
## Add to the end of a string until it has at least the given number of
## grapheme clusters.
## graphemes.
##
## >>> Str.padClustersStart "0" 5 "36"
## >>> Str.padGraphemesStart "0" 5 "36"
##
## >>> Str.padClustersStart "0" 1 "36"
## >>> Str.padGraphemesStart "0" 1 "36"
##
## >>> Str.padClustersStart "0" 5 "12345"
## >>> Str.padGraphemesStart "0" 5 "12345"
##
## >>> Str.padClustersStart "✈️"" 5 "👩‍👩‍👦‍👦👩‍👩‍👦‍👦👩‍👩‍👦‍👦"
padClustersEnd : Str, Int, Str -> Str
## >>> Str.padGraphemesStart "✈️"" 5 "👩‍👩‍👦‍👦👩‍👩‍👦‍👦👩‍👩‍👦‍👦"
padGraphemesEnd : Str, Int, Str -> Str
## Grapheme Clusters
## Graphemes
## Split a string into its individual grapheme clusters.
## Split a string into its individual graphemes.
##
## >>> Str.clusters "1,2,3"
## >>> Str.graphemes "1,2,3"
##
## >>> Str.clusters "👍👍👍"
## >>> Str.graphemes "👍👍👍"
##
clusters : Str -> List Str
graphemes : Str -> List Str
## Str.countClusters "Roc!" # 4
## Str.countClusters "七巧板" # 3
## Str.countClusters "🕊" # 1
## Str.countGraphemes "Roc!" # 4
## Str.countGraphemes "七巧板" # 3
## Str.countGraphemes "🕊" # 1
## Reverse the order of the string's individual grapheme clusters.
## Reverse the order of the string's individual graphemes.
##
## >>> Str.reverseClusters "1-2-3"
## >>> Str.reverseGraphemes "1-2-3"
##
## >>> Str.reverseClusters "🐦✈️"👩‍👩‍👦‍👦"
reverseClusters : Str -> Str
## >>> Str.reverseGraphemes "🐦✈️"👩‍👩‍👦‍👦"
##
## >>> Str.reversegraphemes "Crème Brûlée"
reverseGraphemes : Str -> Str
foldClusters : Str, { start: state, step: (state, Str -> state) } -> state
## Returns #True if the string begins with a capital letter, and #False otherwise.
## Returns #True if the two strings are equal when ignoring case.
##
## >>> Str.isCapitalized "hi"
## >>> Str.caseInsensitiveEq "hi" "Hi"
isCaseInsensitiveEq : Str, Str -> Bool
isCaseInsensitiveNeq : Str, Str -> Bool
walkGraphemes : Str, { start: state, step: (state, Str -> state) } -> state
## Returns #True if the string begins with an uppercase letter.
##
## >>> Str.isCapitalized "Hi"
##
## >>> Str.isCapitalized " Hi"
##
## >>> Str.isCapitalized "hi"
##
## >>> Str.isCapitalized "Česká"
##
## >>> Str.isCapitalized "Э"
@ -218,18 +230,63 @@ foldClusters : Str, { start: state, step: (state, Str -> state) } -> state
##
## >>> Str.isCapitalized ""
##
## Since the rules for how to capitalize an uncapitalized string vary by locale,
## see the [roc/locale](roc/locale) package for functions which do that.
## Since the rules for how to capitalize a string vary by locale,
## (for example, in English, `"i"` capitalizes to `"I"`, but
## [in Turkish](https://en.wikipedia.org/wiki/Dotted_and_dotless_I#In_computing),
## the same `"i"` capitalizes to `"İ"`) see the [roc/locale](roc/locale) package
## package for functions which capitalize strings.
isCapitalized : Str -> Bool
## ## Code Units
## Returns #True if the string consists entirely of uppercase letters.
##
## Besides grapheme clusters, another way to break down strings is into
## >>> Str.isAllUppercase "hi"
##
## >>> Str.isAllUppercase "Hi"
##
## >>> Str.isAllUppercase "HI"
##
## >>> Str.isAllUppercase " Hi"
##
## >>> Str.isAllUppercase "Česká"
##
## >>> Str.isAllUppercase "Э"
##
## >>> Str.isAllUppercase "東京"
##
## >>> Str.isAllUppercase "🐦"
##
## >>> Str.isAllUppercase ""
isAllUppercase : Str -> Bool
## Returns #True if the string consists entirely of lowercase letters.
##
## >>> Str.isAllLowercase "hi"
##
## >>> Str.isAllLowercase "Hi"
##
## >>> Str.isAllLowercase "HI"
##
## >>> Str.isAllLowercase " Hi"
##
## >>> Str.isAllLowercase "Česká"
##
## >>> Str.isAllLowercase "Э"
##
## >>> Str.isAllLowercase "東京"
##
## >>> Str.isAllLowercase "🐦"
##
## >>> Str.isAllLowercase ""
isAllLowercase : Str -> Bool
## Code Units
## Besides graphemes, another way to break down strings is into
## raw code unit integers.
##
## Code units are no substitute for grapheme clusters!
## Code units are no substitute for graphemes!
## These functions exist to support advanced use cases like those found in
## [roc/unicode](roc/unicode), and using code units when grapheme clusters would
## [roc/unicode](roc/unicode), and using code units when graphemes would
## be more appropriate can very easily lead to bugs.
##
## For example, `Str.countGraphemes "👩‍👩‍👦‍👦"` returns `1`,
@ -239,7 +296,7 @@ isCapitalized : Str -> Bool
## Return a #List of the string's #U8 UTF-8 [code units](https://unicode.org/glossary/#code_unit).
## (To split the string into a #List of smaller #Str values instead of #U8 values,
## see #Str.split and #Str.clusters.)
## see #Str.split and #Str.graphemes.)
##
## >>> Str.toUtf8 "👩‍👩‍👦‍👦"
##
@ -250,12 +307,12 @@ isCapitalized : Str -> Bool
## >>> Str.toUtf8 "🐦"
##
## For a more flexible function that walks through each of these #U8 code units
## without creating a #List, see #Str.foldUtf8 and #Str.foldRevUtf8.
## without creating a #List, see #Str.walkUtf8 and #Str.walkRevUtf8.
toUtf8 : Str -> List U8
## Return a #List of the string's #U16 UTF-16 [code units](https://unicode.org/glossary/#code_unit).
## (To split the string into a #List of smaller #Str values instead of #U16 values,
## see #Str.split and #Str.clusters.)
## see #Str.split and #Str.graphemes.)
##
## >>> Str.toUtf16 "👩‍👩‍👦‍👦"
##
@ -266,12 +323,12 @@ toUtf8 : Str -> List U8
## >>> Str.toUtf16 "🐦"
##
## For a more flexible function that walks through each of these #U16 code units
## without creating a #List, see #Str.foldUtf16 and #Str.foldRevUtf16.
## without creating a #List, see #Str.walkUtf16 and #Str.walkRevUtf16.
toUtf16 : Str -> List U16
## Return a #List of the string's #U32 UTF-32 [code units](https://unicode.org/glossary/#code_unit).
## (To split the string into a #List of smaller #Str values instead of #U32 values,
## see #Str.split and #Str.clusters.)
## see #Str.split and #Str.graphemes.)
##
## >>> Str.toUtf32 "👩‍👩‍👦‍👦"
##
@ -282,13 +339,12 @@ toUtf16 : Str -> List U16
## >>> Str.toUtf32 "🐦"
##
## For a more flexible function that walks through each of these #U32 code units
## without creating a #List, see #Str.foldUtf32 and #Str.foldRevUtf32.
## without creating a #List, see #Str.walkUtf32 and #Str.walkRevUtf32.
toUtf32 : Str -> List U32
## Walk through the string's #U8 UTF-8 [code units](https://unicode.org/glossary/#code_unit)
## to build up a state.
## (If you want a `step` function which receives a #Str instead of an #U8, see #Str.foldClusters.)
## (If you want a `step` function which receives a #Str instead of an #U8, see #Str.walkGraphemes.)
##
## Here are the #U8 values that will be passed to `step` when this function is
## called on various strings:
@ -299,11 +355,11 @@ toUtf32 : Str -> List U32
## * `"🐦"` passes 240, 159, 144, 166
##
## To convert a #Str into a plain `List U8` of UTF-8 code units, see #Str.toUtf8.
foldUtf8 : Str, { start: state, step: (state, U8 -> state) } -> state
walkUtf8 : Str, { start: state, step: (state, U8 -> state) } -> state
## Walk through the string's #U16 UTF-16 [code units](https://unicode.org/glossary/#code_unit)
## to build up a state.
## (If you want a `step` function which receives a #Str instead of an #U16, see #Str.foldClusters.)
## (If you want a `step` function which receives a #Str instead of an #U16, see #Str.walkGraphemes.)
##
## Here are the #U16 values that will be passed to `step` when this function is
## called on various strings:
@ -314,11 +370,11 @@ foldUtf8 : Str, { start: state, step: (state, U8 -> state) } -> state
## * `"🐦"` passes 55357, 56358
##
## To convert a #Str into a plain `List U16` of UTF-16 code units, see #Str.toUtf16.
foldUtf16 : Str, { start: state, step: (state, U16 -> state) } -> state
walkUtf16 : Str, { start: state, step: (state, U16 -> state) } -> state
## Walk through the string's #U32 UTF-32 [code units](https://unicode.org/glossary/#code_unit)
## to build up a state.
## (If you want a `step` function which receives a #Str instead of an #U32, see #Str.foldClusters.)
## (If you want a `step` function which receives a #Str instead of an #U32, see #Str.walkGraphemes.)
##
## Here are the #U32 values that will be passed to `step` when this function is
## called on various strings:
@ -329,12 +385,12 @@ foldUtf16 : Str, { start: state, step: (state, U16 -> state) } -> state
## * `"🐦"` passes 128038
##
## To convert a #Str into a plain `List U32` of UTF-32 code units, see #Str.toUtf32.
foldUtf32 : Str, { start: state, step: (state, U32 -> state) } -> state
walkUtf32 : Str, { start: state, step: (state, U32 -> state) } -> state
## Walk backwards through the string's #U8 UTF-8 [code units](https://unicode.org/glossary/#code_unit)
## to build up a state.
## (If you want a `step` function which receives a #Str instead of an #U8, see #Str.foldClusters.)
## (If you want a `step` function which receives a #Str instead of an #U8, see #Str.walkGraphemes.)
##
## Here are the #U8 values that will be passed to `step` when this function is
## called on various strings:
@ -345,11 +401,11 @@ foldUtf32 : Str, { start: state, step: (state, U32 -> state) } -> state
## * `"🐦"` passes 166, 144, 159, 240
##
## To convert a #Str into a plain `List U8` of UTF-8 code units, see #Str.toUtf8.
foldRevUtf8 : Str, { start: state, step: (state, U8 -> state) } -> state
walkRevUtf8 : Str, { start: state, step: (state, U8 -> state) } -> state
## Walk backwards through the string's #U16 UTF-16 [code units](https://unicode.org/glossary/#code_unit)
## to build up a state.
## (If you want a `step` function which receives a #Str instead of an #U16, see #Str.foldClusters.)
## (If you want a `step` function which receives a #Str instead of an #U16, see #Str.walkGraphemes.)
##
## Here are the #U16 values that will be passed to `step` when this function is
## called on various strings:
@ -360,11 +416,11 @@ foldRevUtf8 : Str, { start: state, step: (state, U8 -> state) } -> state
## * `"🐦"` passes 56358, 55357
##
## To convert a #Str into a plain `List U16` of UTF-16 code units, see #Str.toUtf16.
foldRevUtf16 : Str, { start: state, step: (state, U16 -> state) } -> state
walkRevUtf16 : Str, { start: state, step: (state, U16 -> state) } -> state
## Walk backwards through the string's #U32 UTF-32 [code units](https://unicode.org/glossary/#code_unit)
## to build up a state.
## (If you want a `step` function which receives a #Str instead of an #U32, see #Str.foldClusters.)
## (If you want a `step` function which receives a #Str instead of an #U32, see #Str.walkGraphemes.)
##
## Here are the #U32 values that will be passed to `step` when this function is
## called on various strings:
@ -375,4 +431,4 @@ foldRevUtf16 : Str, { start: state, step: (state, U16 -> state) } -> state
## * `"🐦"` passes 128038
##
## To convert a #Str into a plain `List U32` of UTF-32 code units, see #Str.toUtf32.
foldRevUtf32 : Str, { start: state, step: (state, U32 -> state) } -> state
walkRevUtf32 : Str, { start: state, step: (state, U32 -> state) } -> state

6
compiler/builtins/src/std.rs
View File

@ -431,6 +431,12 @@ pub fn types() -> MutMap<Symbol, (SolvedType, Region)> {
// Str module
// Str.concat : Str, Str -> Str
add_type(
Symbol::STR_CONCAT,
SolvedType::Func(vec![str_type(), str_type()], Box::new(str_type())),
);
// isEmpty : Str -> Bool
add_type(
Symbol::STR_ISEMPTY,

41
compiler/builtins/src/unique.rs
View File

@ -772,15 +772,42 @@ pub fn types() -> MutMap<Symbol, (SolvedType, Region)> {
// , Attr Shared (a -> b)
// -> Attr * (List b)
add_type(Symbol::LIST_MAP, {
let_tvars! { a, b, star1, star2 };
let_tvars! { star1, star2, star3, a, b };
unique_function(
vec![
list_type(star1, a),
shared(SolvedType::Func(vec![flex(a)], Box::new(flex(b)))),
SolvedType::Apply(
Symbol::ATTR_ATTR,
vec![
flex(star1),
SolvedType::Apply(Symbol::LIST_LIST, vec![flex(a)]),
],
),
SolvedType::Apply(
Symbol::ATTR_ATTR,
vec![
flex(star2),
SolvedType::Func(vec![flex(a)], Box::new(flex(b))),
],
),
],
list_type(star2, b),
SolvedType::Apply(
Symbol::ATTR_ATTR,
vec![
flex(star3),
SolvedType::Apply(Symbol::LIST_LIST, vec![flex(b)]),
],
),
)
// let_tvars! { a, b, star1, star2 };
//
// unique_function(
// vec![
// list_type(star1, a),
// shared(SolvedType::Func(vec![flex(a)], Box::new(flex(b)))),
// ],
// list_type(star2, b),
// )
});
// foldr : Attr (* | u) (List (Attr u a))
@ -1043,8 +1070,8 @@ pub fn types() -> MutMap<Symbol, (SolvedType, Region)> {
unique_function(vec![str_type(star1)], bool_type(star2))
});
// append : Attr * Str, Attr * Str -> Attr * Str
add_type(Symbol::STR_APPEND, {
// Str.concat : Attr * Str, Attr * Str -> Attr * Str
add_type(Symbol::STR_CONCAT, {
let_tvars! { star1, star2, star3 };
unique_function(vec![str_type(star1), str_type(star2)], str_type(star3))
});

20
compiler/can/src/builtins.rs
View File

@ -50,6 +50,7 @@ pub fn builtin_defs(var_store: &mut VarStore) -> MutMap<Symbol, Def> {
Symbol::BOOL_AND => bool_and,
Symbol::BOOL_OR => bool_or,
Symbol::BOOL_NOT => bool_not,
Symbol::STR_CONCAT => str_concat,
Symbol::LIST_LEN => list_len,
Symbol::LIST_GET => list_get,
Symbol::LIST_SET => list_set,
@ -620,6 +621,25 @@ fn list_reverse(symbol: Symbol, var_store: &mut VarStore) -> Def {
)
}
/// Str.concat : Str, Str -> Str
fn str_concat(symbol: Symbol, var_store: &mut VarStore) -> Def {
let str_var = var_store.fresh();
let body = RunLowLevel {
op: LowLevel::StrConcat,
args: vec![(str_var, Var(Symbol::ARG_1)), (str_var, Var(Symbol::ARG_2))],
ret_var: str_var,
};
defn(
symbol,
vec![(str_var, Symbol::ARG_1), (str_var, Symbol::ARG_2)],
var_store,
body,
str_var,
)
}
/// List.concat : List elem, List elem -> List elem
fn list_concat(symbol: Symbol, var_store: &mut VarStore) -> Def {
let list_var = var_store.fresh();

487
compiler/gen/src/llvm/build.rs
View File

@ -1,10 +1,14 @@
use crate::layout_id::LayoutIds;
use crate::llvm::build_list::{
allocate_list, empty_polymorphic_list, list_append, list_concat, list_get_unsafe, list_join,
list_len, list_map, list_prepend, list_repeat, list_reverse, list_set, list_single,
allocate_list, build_basic_phi2, clone_nonempty_list, empty_list, empty_polymorphic_list,
incrementing_index_loop, list_append, list_concat, list_get_unsafe, list_is_not_empty,
list_join, list_len, list_prepend, list_repeat, list_reverse, list_set, list_single,
load_list_ptr,
};
use crate::llvm::compare::{build_eq, build_neq};
use crate::llvm::convert::{basic_type_from_layout, collection, get_fn_type, ptr_int};
use crate::llvm::convert::{
basic_type_from_layout, collection, get_fn_type, get_ptr_type, ptr_int,
};
use bumpalo::collections::Vec;
use bumpalo::Bump;
use inkwell::basic_block::BasicBlock;
@ -15,7 +19,7 @@ use inkwell::module::{Linkage, Module};
use inkwell::passes::{PassManager, PassManagerBuilder};
use inkwell::types::{BasicTypeEnum, FunctionType, IntType, StructType};
use inkwell::values::BasicValueEnum::{self, *};
use inkwell::values::{FloatValue, FunctionValue, IntValue, PointerValue, StructValue};
use inkwell::values::{BasicValue, FloatValue, FunctionValue, IntValue, PointerValue, StructValue};
use inkwell::AddressSpace;
use inkwell::{IntPredicate, OptimizationLevel};
use roc_collections::all::{ImMap, MutSet};
@ -33,6 +37,9 @@ const PRINT_FN_VERIFICATION_OUTPUT: bool = true;
#[cfg(not(debug_assertions))]
const PRINT_FN_VERIFICATION_OUTPUT: bool = false;
pub const REFCOUNT_0: usize = std::usize::MAX;
pub const REFCOUNT_1: usize = REFCOUNT_0 - 1;
#[derive(Debug, Clone, Copy)]
pub enum OptLevel {
Normal,
@ -218,46 +225,74 @@ pub fn build_exp_literal<'a, 'ctx, 'env>(
Byte(b) => env.context.i8_type().const_int(*b as u64, false).into(),
Str(str_literal) => {
if str_literal.is_empty() {
panic!("TODO build an empty string in LLVM");
empty_list(env)
} else {
let ctx = env.context;
let builder = env.builder;
let str_len = str_literal.len() + 1/* TODO drop the +1 when we have structs and this is no longer a NUL-terminated CString.*/;
let byte_type = ctx.i8_type();
let nul_terminator = byte_type.const_zero();
let len_val = ctx.i64_type().const_int(str_len as u64, false);
let ptr = env
.builder
.build_array_malloc(ctx.i8_type(), len_val, "str_ptr")
.unwrap();
let len_u64 = str_literal.len() as u64;
// TODO check if malloc returned null; if so, runtime error for OOM!
let elem_bytes = CHAR_LAYOUT.stack_size(env.ptr_bytes) as u64;
// Copy the bytes from the string literal into the array
for (index, byte) in str_literal.bytes().enumerate() {
let ptr = {
let bytes_len = elem_bytes * len_u64;
let len_type = env.ptr_int();
let len = len_type.const_int(bytes_len, false);
allocate_list(env, &CHAR_LAYOUT, len)
// TODO check if malloc returned null; if so, runtime error for OOM!
};
// Copy the elements from the list literal into the array
for (index, char) in str_literal.as_bytes().iter().enumerate() {
let val = env
.context
.i8_type()
.const_int(*char as u64, false)
.as_basic_value_enum();
let index_val = ctx.i64_type().const_int(index as u64, false);
let elem_ptr =
unsafe { builder.build_in_bounds_gep(ptr, &[index_val], "byte") };
unsafe { builder.build_in_bounds_gep(ptr, &[index_val], "index") };
builder.build_store(elem_ptr, byte_type.const_int(byte as u64, false));
builder.build_store(elem_ptr, val);
}
// Add a NUL terminator at the end.
// TODO: Instead of NUL-terminating, return a struct
// with the pointer and also the length and capacity.
let index_val = ctx.i64_type().const_int(str_len as u64 - 1, false);
let elem_ptr =
unsafe { builder.build_in_bounds_gep(ptr, &[index_val], "nul_terminator") };
let ptr_bytes = env.ptr_bytes;
let int_type = ptr_int(ctx, ptr_bytes);
let ptr_as_int = builder.build_ptr_to_int(ptr, int_type, "list_cast_ptr");
let struct_type = collection(ctx, ptr_bytes);
let len = BasicValueEnum::IntValue(env.ptr_int().const_int(len_u64, false));
let mut struct_val;
builder.build_store(elem_ptr, nul_terminator);
// Store the pointer
struct_val = builder
.build_insert_value(
struct_type.get_undef(),
ptr_as_int,
Builtin::WRAPPER_PTR,
"insert_ptr",
)
.unwrap();
BasicValueEnum::PointerValue(ptr)
// Store the length
struct_val = builder
.build_insert_value(struct_val, len, Builtin::WRAPPER_LEN, "insert_len")
.unwrap();
// Bitcast to an array of raw bytes
builder.build_bitcast(
struct_val.into_struct_value(),
collection(ctx, ptr_bytes),
"cast_collection",
)
}
}
}
}
static CHAR_LAYOUT: Layout = Layout::Builtin(Builtin::Int8);
pub fn build_exp_expr<'a, 'ctx, 'env>(
env: &Env<'a, 'ctx, 'env>,
layout_ids: &mut LayoutIds<'a>,
@ -872,7 +907,7 @@ pub fn build_exp_stmt<'a, 'ctx, 'env>(
match layout {
Layout::Builtin(Builtin::List(MemoryMode::Refcounted, _)) => {
increment_refcount_list(env, value.into_struct_value());
increment_refcount_list(env, parent, value.into_struct_value());
build_exp_stmt(env, layout_ids, scope, parent, cont)
}
_ => build_exp_stmt(env, layout_ids, scope, parent, cont),
@ -897,11 +932,7 @@ fn refcount_is_one_comparison<'ctx>(
context: &'ctx Context,
refcount: IntValue<'ctx>,
) -> IntValue<'ctx> {
let refcount_one: IntValue<'ctx> = context.i64_type().const_int((std::usize::MAX) as _, false);
// Note: Check for refcount < refcount_1 as the "true" condition,
// to avoid misprediction. (In practice this should usually pass,
// and CPUs generally default to predicting that a forward jump
// shouldn't be taken; that is, they predict "else" won't be taken.)
let refcount_one: IntValue<'ctx> = context.i64_type().const_int(REFCOUNT_1 as _, false);
builder.build_int_compare(
IntPredicate::EQ,
refcount,
@ -966,6 +997,7 @@ fn decrement_refcount_layout<'a, 'ctx, 'env>(
}
}
}
RecursiveUnion(_) => todo!("TODO implement decrement layout of recursive tag union"),
Union(tags) => {
debug_assert!(!tags.is_empty());
let wrapper_struct = value.into_struct_value();
@ -1054,11 +1086,29 @@ fn decrement_refcount_builtin<'a, 'ctx, 'env>(
fn increment_refcount_list<'a, 'ctx, 'env>(
env: &Env<'a, 'ctx, 'env>,
parent: FunctionValue<'ctx>,
original_wrapper: StructValue<'ctx>,
) {
let builder = env.builder;
let ctx = env.context;
let len = list_len(builder, original_wrapper);
let is_non_empty = builder.build_int_compare(
IntPredicate::UGT,
len,
ctx.i64_type().const_zero(),
"len > 0",
);
// build blocks
let increment_block = ctx.append_basic_block(parent, "increment_block");
let cont_block = ctx.append_basic_block(parent, "after_increment_block");
builder.build_conditional_branch(is_non_empty, increment_block, cont_block);
builder.position_at_end(increment_block);
let refcount_ptr = list_get_refcount_ptr(env, original_wrapper);
let refcount = env
@ -1075,6 +1125,9 @@ fn increment_refcount_list<'a, 'ctx, 'env>(
// Mutate the new array in-place to change the element.
builder.build_store(refcount_ptr, decremented);
builder.build_unconditional_branch(cont_block);
builder.position_at_end(cont_block);
}
fn decrement_refcount_list<'a, 'ctx, 'env>(
@ -1085,6 +1138,30 @@ fn decrement_refcount_list<'a, 'ctx, 'env>(
let builder = env.builder;
let ctx = env.context;
// the block we'll always jump to when we're done
let cont_block = ctx.append_basic_block(parent, "after_decrement_block");
let decrement_block = ctx.append_basic_block(parent, "decrement_block");
// currently, an empty list has a null-pointer in its length is 0
// so we must first check the length
let len = list_len(builder, original_wrapper);
let is_non_empty = builder.build_int_compare(
IntPredicate::UGT,
len,
ctx.i64_type().const_zero(),
"len > 0",
);
// if the length is 0, we're done and jump to the continuation block
// otherwise, actually read and check the refcount
builder.build_conditional_branch(is_non_empty, decrement_block, cont_block);
builder.position_at_end(decrement_block);
// build blocks
let then_block = ctx.append_basic_block(parent, "then");
let else_block = ctx.append_basic_block(parent, "else");
let refcount_ptr = list_get_refcount_ptr(env, original_wrapper);
let refcount = env
@ -1094,16 +1171,24 @@ fn decrement_refcount_list<'a, 'ctx, 'env>(
let comparison = refcount_is_one_comparison(builder, env.context, refcount);
// build blocks
let then_block = ctx.append_basic_block(parent, "then");
let else_block = ctx.append_basic_block(parent, "else");
let cont_block = ctx.append_basic_block(parent, "dec_ref_branchcont");
// TODO what would be most optimial for the branch predictor
//
// are most refcounts 1 most of the time? or not?
builder.build_conditional_branch(comparison, then_block, else_block);
// build then block
{
builder.position_at_end(then_block);
if !env.leak {
let free = builder.build_free(refcount_ptr);
builder.insert_instruction(&free, None);
}
builder.build_unconditional_branch(cont_block);
}
// build else block
{
builder.position_at_end(else_block);
// our refcount 0 is actually usize::MAX, so decrementing the refcount means incrementing this value.
let decremented = env.builder.build_int_add(
ctx.i64_type().const_int(1 as u64, false),
@ -1117,16 +1202,6 @@ fn decrement_refcount_list<'a, 'ctx, 'env>(
builder.build_unconditional_branch(cont_block);
}
// build else block
{
builder.position_at_end(else_block);
if !env.leak {
let free = builder.build_free(refcount_ptr);
builder.insert_instruction(&free, None);
}
builder.build_unconditional_branch(cont_block);
}
// emit merge block
builder.position_at_end(cont_block);
}
@ -1373,7 +1448,7 @@ pub fn build_proc_header<'a, 'ctx, 'env>(
symbol: Symbol,
layout: &Layout<'a>,
proc: &roc_mono::ir::Proc<'a>,
) -> (FunctionValue<'ctx>, Vec<'a, BasicTypeEnum<'ctx>>) {
) -> FunctionValue<'ctx> {
let args = proc.args;
let arena = env.arena;
let context = &env.context;
@ -1407,15 +1482,14 @@ pub fn build_proc_header<'a, 'ctx, 'env>(
fn_val.set_call_conventions(FAST_CALL_CONV);
}
(fn_val, arg_basic_types)
fn_val
}
pub fn build_proc<'a, 'ctx, 'env>(
env: &Env<'a, 'ctx, 'env>,
env: &'a Env<'a, 'ctx, 'env>,
layout_ids: &mut LayoutIds<'a>,
proc: roc_mono::ir::Proc<'a>,
fn_val: FunctionValue<'ctx>,
arg_basic_types: Vec<'a, BasicTypeEnum<'ctx>>,
) {
let args = proc.args;
let context = &env.context;
@ -1429,13 +1503,15 @@ pub fn build_proc<'a, 'ctx, 'env>(
let mut scope = Scope::default();
// Add args to scope
for ((arg_val, arg_type), (layout, arg_symbol)) in
fn_val.get_param_iter().zip(arg_basic_types).zip(args)
{
for (arg_val, (layout, arg_symbol)) in fn_val.get_param_iter().zip(args) {
set_name(arg_val, arg_symbol.ident_string(&env.interns));
let alloca =
create_entry_block_alloca(env, fn_val, arg_type, arg_symbol.ident_string(&env.interns));
let alloca = create_entry_block_alloca(
env,
fn_val,
arg_val.get_type(),
arg_symbol.ident_string(&env.interns),
);
builder.build_store(alloca, arg_val);
@ -1560,6 +1636,16 @@ fn run_low_level<'a, 'ctx, 'env>(
use LowLevel::*;
match op {
StrConcat => {
// Str.concat : Str, Str -> Str
debug_assert_eq!(args.len(), 2);
let first_str = load_symbol(env, scope, &args[0]);
let second_str = load_symbol(env, scope, &args[1]);
str_concat(env, parent, first_str, second_str)
}
ListLen => {
// List.len : List * -> Int
debug_assert_eq!(args.len(), 1);
@ -1593,7 +1679,15 @@ fn run_low_level<'a, 'ctx, 'env>(
list_reverse(env, parent, scope, list)
}
ListConcat => list_concat(env, scope, parent, args),
ListConcat => {
debug_assert_eq!(args.len(), 2);
let (first_list, list_layout) = load_symbol_and_layout(env, scope, &args[0]);
let second_list = load_symbol(env, scope, &args[1]);
list_concat(env, parent, first_list, second_list, list_layout)
}
ListMap => {
// List.map : List a, (a -> elem) -> List elem
@ -1760,14 +1854,9 @@ fn run_low_level<'a, 'ctx, 'env>(
list_get_unsafe(env, list_layout, elem_index, wrapper_struct)
}
ListSet => {
ListSetInPlace => {
let (list_symbol, list_layout) = load_symbol_and_layout(env, scope, &args[0]);
let in_place = match &list_layout {
Layout::Builtin(Builtin::List(MemoryMode::Unique, _)) => InPlace::InPlace,
_ => InPlace::Clone,
};
list_set(
parent,
&[
@ -1776,22 +1865,276 @@ fn run_low_level<'a, 'ctx, 'env>(
(load_symbol_and_layout(env, scope, &args[2])),
],
env,
in_place,
InPlace::InPlace,
)
}
ListSetInPlace => list_set(
parent,
&[
(load_symbol_and_layout(env, scope, &args[0])),
ListSet => {
let (list_symbol, list_layout) = load_symbol_and_layout(env, scope, &args[0]);
let arguments = &[
(list_symbol, list_layout),
(load_symbol_and_layout(env, scope, &args[1])),
(load_symbol_and_layout(env, scope, &args[2])),
],
env,
InPlace::InPlace,
),
];
match list_layout {
Layout::Builtin(Builtin::List(MemoryMode::Unique, _)) => {
// the layout tells us this List.set can be done in-place
list_set(parent, arguments, env, InPlace::InPlace)
}
Layout::Builtin(Builtin::List(MemoryMode::Refcounted, _)) => {
// no static guarantees, but all is not lost: we can check the refcount
// if it is one, we hold the final reference, and can mutate it in-place!
let builder = env.builder;
let ctx = env.context;
let ret_type =
basic_type_from_layout(env.arena, ctx, list_layout, env.ptr_bytes);
let refcount_ptr = list_get_refcount_ptr(env, list_symbol.into_struct_value());
let refcount = env
.builder
.build_load(refcount_ptr, "get_refcount")
.into_int_value();
let comparison = refcount_is_one_comparison(builder, env.context, refcount);
// build then block
// refcount is 1, so work in-place
let build_pass = || list_set(parent, arguments, env, InPlace::InPlace);
// build else block
// refcount != 1, so clone first
let build_fail = || list_set(parent, arguments, env, InPlace::Clone);
crate::llvm::build_list::build_basic_phi2(
env, parent, comparison, build_pass, build_fail, ret_type,
)
}
Layout::Builtin(Builtin::EmptyList) => list_symbol,
other => unreachable!("List.set: weird layout {:?}", other),
}
}
}
}
/// Str.concat : Str, Str -> Str
fn str_concat<'a, 'ctx, 'env>(
env: &Env<'a, 'ctx, 'env>,
parent: FunctionValue<'ctx>,
first_str: BasicValueEnum<'ctx>,
second_str: BasicValueEnum<'ctx>,
) -> BasicValueEnum<'ctx> {
let builder = env.builder;
let ctx = env.context;
let second_str_wrapper = second_str.into_struct_value();
let second_str_len = list_len(builder, second_str_wrapper);
let first_str_wrapper = first_str.into_struct_value();
let first_str_len = list_len(builder, first_str_wrapper);
// first_str_len > 0
// We do this check to avoid allocating memory. If the first input
// str is empty, then we can just return the second str cloned
let first_str_length_comparison = list_is_not_empty(builder, ctx, first_str_len);
let if_first_str_is_empty = || {
// second_str_len > 0
// We do this check to avoid allocating memory. If the second input
// str is empty, then we can just return an empty str
let second_str_length_comparison = list_is_not_empty(builder, ctx, second_str_len);
let build_second_str_then = || {
let char_type = basic_type_from_layout(env.arena, ctx, &CHAR_LAYOUT, env.ptr_bytes);
let ptr_type = get_ptr_type(&char_type, AddressSpace::Generic);
let (new_wrapper, _) = clone_nonempty_list(
env,
second_str_len,
load_list_ptr(builder, second_str_wrapper, ptr_type),
&CHAR_LAYOUT,
);
BasicValueEnum::StructValue(new_wrapper)
};
let build_second_str_else = || empty_list(env);
build_basic_phi2(
env,
parent,
second_str_length_comparison,
build_second_str_then,
build_second_str_else,
BasicTypeEnum::StructType(collection(ctx, env.ptr_bytes)),
)
};
let if_first_str_is_not_empty = || {
let char_type = ctx.i8_type().into();
let ptr_type = get_ptr_type(&char_type, AddressSpace::Generic);
let if_second_str_is_empty = || {
let (new_wrapper, _) = clone_nonempty_list(
env,
first_str_len,
load_list_ptr(builder, first_str_wrapper, ptr_type),
&CHAR_LAYOUT,
);
BasicValueEnum::StructValue(new_wrapper)
};
// second_str_len > 0
// We do this check to avoid allocating memory. If the second input
// str is empty, then we can just return the first str cloned
let second_str_length_comparison = list_is_not_empty(builder, ctx, second_str_len);
let if_second_str_is_not_empty = || {
let combined_str_len =
builder.build_int_add(first_str_len, second_str_len, "add_list_lengths");
let combined_str_ptr = allocate_list(env, &CHAR_LAYOUT, combined_str_len);
// FIRST LOOP
let first_loop = |first_index| {
let first_str_ptr = load_list_ptr(builder, first_str_wrapper, ptr_type);
// The pointer to the element in the first list
let first_str_char_ptr = unsafe {
builder.build_in_bounds_gep(first_str_ptr, &[first_index], "load_index")
};
// The pointer to the element in the combined list
let combined_str_elem_ptr = unsafe {
builder.build_in_bounds_gep(
combined_str_ptr,
&[first_index],
"load_index_combined_list",
)
};
let first_str_elem = builder.build_load(first_str_char_ptr, "get_elem");
// Mutate the new array in-place to change the element.
builder.build_store(combined_str_elem_ptr, first_str_elem);
};
let index_name = "#index";
let index_alloca = incrementing_index_loop(
builder,
parent,
ctx,
first_str_len,
index_name,
None,
first_loop,
);
// Reset the index variable to 0
builder.build_store(index_alloca, ctx.i64_type().const_int(0, false));
// SECOND LOOP
let second_loop = |second_index| {
let second_str_ptr = load_list_ptr(builder, second_str_wrapper, ptr_type);
// The pointer to the element in the second list
let second_str_char_ptr = unsafe {
builder.build_in_bounds_gep(second_str_ptr, &[second_index], "load_index")
};
// The pointer to the element in the combined str.
// Note that the pointer does not start at the index
// 0, it starts at the index of first_str_len. In that
// sense it is "offset".
let offset_combined_str_char_ptr = unsafe {
builder.build_in_bounds_gep(combined_str_ptr, &[first_str_len], "elem")
};
// The pointer to the char from the second str
// in the combined list
let combined_str_char_ptr = unsafe {
builder.build_in_bounds_gep(
offset_combined_str_char_ptr,
&[second_index],
"load_index_combined_list",
)
};
let second_str_elem = builder.build_load(second_str_char_ptr, "get_elem");
// Mutate the new array in-place to change the element.
builder.build_store(combined_str_char_ptr, second_str_elem);
};
incrementing_index_loop(
builder,
parent,
ctx,
second_str_len,
index_name,
Some(index_alloca),
second_loop,
);
let ptr_bytes = env.ptr_bytes;
let int_type = ptr_int(ctx, ptr_bytes);
let ptr_as_int = builder.build_ptr_to_int(combined_str_ptr, int_type, "list_cast_ptr");
let struct_type = collection(ctx, ptr_bytes);
let mut struct_val;
// Store the pointer
struct_val = builder
.build_insert_value(
struct_type.get_undef(),
ptr_as_int,
Builtin::WRAPPER_PTR,
"insert_ptr",
)
.unwrap();
// Store the length
struct_val = builder
.build_insert_value(
struct_val,
combined_str_len,
Builtin::WRAPPER_LEN,
"insert_len",
)
.unwrap();
builder.build_bitcast(
struct_val.into_struct_value(),
collection(ctx, ptr_bytes),
"cast_collection",
)
};
build_basic_phi2(
env,
parent,
second_str_length_comparison,
if_second_str_is_not_empty,
if_second_str_is_empty,
BasicTypeEnum::StructType(collection(ctx, env.ptr_bytes)),
)
};
build_basic_phi2(
env,
parent,
first_str_length_comparison,
if_first_str_is_not_empty,
if_first_str_is_empty,
BasicTypeEnum::StructType(collection(ctx, env.ptr_bytes)),
)
}
fn build_int_binop<'a, 'ctx, 'env>(
env: &Env<'a, 'ctx, 'env>,
lhs: IntValue<'ctx>,

41
compiler/gen/src/llvm/build_list.rs
View File

@ -207,10 +207,7 @@ pub fn list_prepend<'a, 'ctx, 'env>(
let ptr_bytes = env.ptr_bytes;
// Allocate space for the new array that we'll copy into.
let elem_type = basic_type_from_layout(env.arena, ctx, elem_layout, env.ptr_bytes);
let clone_ptr = builder
.build_array_malloc(elem_type, new_list_len, "list_ptr")
.unwrap();
let clone_ptr = allocate_list(env, elem_layout, new_list_len);
let int_type = ptr_int(ctx, ptr_bytes);
let ptr_as_int = builder.build_ptr_to_int(clone_ptr, int_type, "list_cast_ptr");
@ -355,9 +352,7 @@ pub fn list_join<'a, 'ctx, 'env>(
.build_load(list_len_sum_alloca, list_len_sum_name)
.into_int_value();
let final_list_ptr = builder
.build_array_malloc(elem_type, final_list_sum, "final_list_sum")
.unwrap();
let final_list_ptr = allocate_list(env, elem_layout, final_list_sum);
let dest_elem_ptr_alloca = builder.build_alloca(elem_ptr_type, "dest_elem");
@ -873,19 +868,14 @@ pub fn list_map<'a, 'ctx, 'env>(
/// List.concat : List elem, List elem -> List elem
pub fn list_concat<'a, 'ctx, 'env>(
env: &Env<'a, 'ctx, 'env>,
scope: &Scope<'a, 'ctx>,
parent: FunctionValue<'ctx>,
args: &[Symbol],
first_list: BasicValueEnum<'ctx>,
second_list: BasicValueEnum<'ctx>,
list_layout: &Layout<'a>,
) -> BasicValueEnum<'ctx> {
debug_assert_eq!(args.len(), 2);
let builder = env.builder;
let ctx = env.context;
let (first_list, list_layout) = load_symbol_and_layout(env, scope, &args[0]);
let second_list = load_symbol(env, scope, &args[1]);
let second_list_wrapper = second_list.into_struct_value();
let second_list_len = list_len(builder, second_list_wrapper);
@ -908,7 +898,7 @@ pub fn list_concat<'a, 'ctx, 'env>(
let if_first_list_is_empty = || {
// second_list_len > 0
// We do this check to avoid allocating memory. If the second input
// list is empty, then we can just return the first list cloned
// list is empty, then we can just return an empty list
let second_list_length_comparison =
list_is_not_empty(builder, ctx, second_list_len);
@ -1126,7 +1116,7 @@ pub fn list_concat<'a, 'ctx, 'env>(
// This helper simulates a basic for loop, where
// and index increments up from 0 to some end value
fn incrementing_index_loop<'ctx, LoopFn>(
pub fn incrementing_index_loop<'ctx, LoopFn>(
builder: &Builder<'ctx>,
parent: FunctionValue<'ctx>,
ctx: &'ctx Context,
@ -1176,7 +1166,7 @@ where
index_alloca
}
fn build_basic_phi2<'a, 'ctx, 'env, PassFn, FailFn>(
pub fn build_basic_phi2<'a, 'ctx, 'env, PassFn, FailFn>(
env: &Env<'a, 'ctx, 'env>,
parent: FunctionValue<'ctx>,
comparison: IntValue<'ctx>,
@ -1243,7 +1233,7 @@ pub fn empty_list<'a, 'ctx, 'env>(env: &Env<'a, 'ctx, 'env>) -> BasicValueEnum<'
BasicValueEnum::StructValue(struct_type.const_zero())
}
fn list_is_not_empty<'ctx>(
pub fn list_is_not_empty<'ctx>(
builder: &Builder<'ctx>,
ctx: &'ctx Context,
list_len: IntValue<'ctx>,
@ -1256,7 +1246,7 @@ fn list_is_not_empty<'ctx>(
)
}
fn load_list_ptr<'ctx>(
pub fn load_list_ptr<'ctx>(
builder: &Builder<'ctx>,
wrapper_struct: StructValue<'ctx>,
ptr_type: PointerType<'ctx>,
@ -1269,7 +1259,7 @@ fn load_list_ptr<'ctx>(
builder.build_int_to_ptr(ptr_as_int, ptr_type, "list_cast_ptr")
}
fn clone_nonempty_list<'a, 'ctx, 'env>(
pub fn clone_nonempty_list<'a, 'ctx, 'env>(
env: &Env<'a, 'ctx, 'env>,
list_len: IntValue<'ctx>,
elems_ptr: PointerValue<'ctx>,
@ -1390,9 +1380,12 @@ pub fn allocate_list<'a, 'ctx, 'env>(
"make ptr",
);
// put our "refcount 0" in the first slot
let ref_count_zero = ctx.i64_type().const_int(std::usize::MAX as u64, false);
builder.build_store(refcount_ptr, ref_count_zero);
// the refcount of a new list is initially 1
// we assume that the list is indeed used (dead variables are eliminated)
let ref_count_one = ctx
.i64_type()
.const_int(crate::llvm::build::REFCOUNT_1 as _, false);
builder.build_store(refcount_ptr, ref_count_one);
list_element_ptr
}

7
compiler/gen/src/llvm/convert.rs
View File

@ -107,6 +107,7 @@ pub fn basic_type_from_layout<'ctx>(
.struct_type(field_types.into_bump_slice(), false)
.as_basic_type_enum()
}
RecursiveUnion(_) => todo!("TODO implement layout of recursive tag union"),
Union(_) => {
// TODO make this dynamic
let ptr_size = std::mem::size_of::<i64>();
@ -150,13 +151,9 @@ pub fn basic_type_from_layout<'ctx>(
Float64 => context.f64_type().as_basic_type_enum(),
Float32 => context.f32_type().as_basic_type_enum(),
Float16 => context.f16_type().as_basic_type_enum(),
Str | EmptyStr => context
.i8_type()
.ptr_type(AddressSpace::Generic)
.as_basic_type_enum(),
Map(_, _) | EmptyMap => panic!("TODO layout_to_basic_type for Builtin::Map"),
Set(_) | EmptySet => panic!("TODO layout_to_basic_type for Builtin::Set"),
List(_, _) => collection(context, ptr_bytes).into(),
List(_, _) | Str | EmptyStr => collection(context, ptr_bytes).into(),
EmptyList => BasicTypeEnum::StructType(collection(context, ptr_bytes)),
},
}

30
compiler/gen/tests/gen_list.rs
View File

@ -232,7 +232,28 @@ mod gen_list {
}
#[test]
fn list_concat() {
fn foobarbaz() {
assert_evals_to!(
indoc!(
r#"
firstList : List Int
firstList =
[]
secondList : List Int
secondList =
[]
List.concat firstList secondList
"#
),
&[],
&'static [i64]
);
}
#[test]
fn list_concat_vanilla() {
assert_evals_to!("List.concat [] []", &[], &'static [i64]);
assert_evals_to!(
@ -538,7 +559,7 @@ mod gen_list {
assert_evals_to!(
indoc!(
r#"
shared = [ 2.1, 4.3 ]
main = \shared ->
# This should not mutate the original
x =
@ -552,6 +573,8 @@ mod gen_list {
Err _ -> 0
{ x, y }
main [ 2.1, 4.3 ]
"#
),
(7.7, 4.3),
@ -564,6 +587,7 @@ mod gen_list {
assert_evals_to!(
indoc!(
r#"
main = \{} ->
shared = [ 2, 4 ]
# This List.set is out of bounds, and should have no effect
@ -578,6 +602,8 @@ mod gen_list {
Err _ -> 0
{ x, y }
main {}
"#
),
(4, 4),

18
compiler/gen/tests/gen_num.rs
View File

@ -482,9 +482,12 @@ mod gen_num {
assert_evals_to!(
indoc!(
r#"
when 10 is
x if x == 5 -> 0
_ -> 42
main = \{} ->
when 10 is
x if x == 5 -> 0
_ -> 42
main {}
"#
),
42,
@ -497,9 +500,12 @@ mod gen_num {
assert_evals_to!(
indoc!(
r#"
when 10 is
x if x == 10 -> 42
_ -> 0
main = \{} ->
when 10 is
x if x == 10 -> 42
_ -> 0
main {}
"#
),
42,

16
compiler/gen/tests/gen_primitives.rs
View File

@ -13,17 +13,11 @@ mod helpers;
#[cfg(test)]
mod gen_primitives {
use std::ffi::{CStr, CString};
use std::os::raw::c_char;
#[test]
fn basic_str() {
assert_evals_to!(
"\"shirt and hat\"",
CString::new("shirt and hat").unwrap().as_c_str(),
*const c_char,
CStr::from_ptr
);
assert_evals_to!("\"\"", "", &'static str);
assert_evals_to!("\"shirt and hat\"", "shirt and hat", &'static str);
}
#[test]
@ -289,7 +283,10 @@ mod gen_primitives {
assert_evals_to!(
indoc!(
r#"
main = \{} ->
(\a -> a) 5
main {}
"#
),
5,
@ -302,11 +299,14 @@ mod gen_primitives {
assert_evals_to!(
indoc!(
r#"
main = \{} ->
alwaysFloatIdentity : Int -> (Float -> Float)
alwaysFloatIdentity = \num ->
(\a -> a)
(alwaysFloatIdentity 2) 3.14
main {}
"#
),
3.14,

34
compiler/gen/tests/gen_str.rs Normal file
View File

@ -0,0 +1,34 @@
#[macro_use]
extern crate pretty_assertions;
#[macro_use]
extern crate indoc;
extern crate bumpalo;
extern crate inkwell;
extern crate libc;
extern crate roc_gen;
#[macro_use]
mod helpers;
#[cfg(test)]
mod gen_str {
#[test]
fn str_concat() {
assert_evals_to!("Str.concat \"a\" \"b\"", "ab", &'static str);
assert_evals_to!("Str.concat \"\" \"second str\"", "second str", &'static str);
assert_evals_to!("Str.concat \"first str\" \"\"", "first str", &'static str);
assert_evals_to!("Str.concat \"\" \"\"", "", &'static str);
assert_evals_to!(
indoc!(
r#"
Str.concat
"First string that is fairly long. Longer strings make for different errors. "
"Second string that is also fairly long. Two long strings test things that might not appear with short strings."
"#
),
"First string that is fairly long. Longer strings make for different errors. Second string that is also fairly long. Two long strings test things that might not appear with short strings.",
&'static str
);
}
}

61
compiler/gen/tests/gen_tags.rs
View File

@ -455,9 +455,12 @@ mod gen_tags {
assert_evals_to!(
indoc!(
r#"
when 2 is
2 if False -> 0
_ -> 42
main = \{} ->
when 2 is
2 if False -> 0
_ -> 42
main {}
"#
),
42,
@ -470,9 +473,12 @@ mod gen_tags {
assert_evals_to!(
indoc!(
r#"
when 2 is
2 if True -> 42
_ -> 0
main = \{} ->
when 2 is
2 if True -> 42
_ -> 0
main {}
"#
),
42,
@ -485,9 +491,12 @@ mod gen_tags {
assert_evals_to!(
indoc!(
r#"
when 2 is
_ if False -> 0
_ -> 42
main = \{} ->
when 2 is
_ if False -> 0
_ -> 42
main {}
"#
),
42,
@ -665,16 +674,19 @@ mod gen_tags {
assert_evals_to!(
indoc!(
r#"
x : [ Red, White, Blue ]
x = Blue
main = \{} ->
x : [ Red, White, Blue ]
x = Blue
y =
when x is
Red -> 1
White -> 2
Blue -> 3.1
y =
when x is
Red -> 1
White -> 2
Blue -> 3.1
y
y
main {}
"#
),
3.1,
@ -687,13 +699,16 @@ mod gen_tags {
assert_evals_to!(
indoc!(
r#"
y =
when 1 + 2 is
3 -> 3
1 -> 1
_ -> 0
main = \{} ->
y =
when 1 + 2 is
3 -> 3
1 -> 1
_ -> 0
y
y
main {}
"#
),
3,

41
compiler/gen/tests/helpers/eval.rs
View File

@ -106,8 +106,6 @@ pub fn helper_without_uniqueness<'a>(
};
let main_body = roc_mono::ir::Stmt::new(&mut mono_env, loc_expr.value, &mut procs);
let main_body =
roc_mono::inc_dec::visit_declaration(mono_env.arena, mono_env.arena.alloc(main_body));
let mut headers = {
let num_headers = match &procs.pending_specializations {
@ -125,6 +123,13 @@ pub fn helper_without_uniqueness<'a>(
roc_collections::all::MutMap::default()
);
let (mut procs, param_map) = procs.get_specialized_procs_help(mono_env.arena);
let main_body = roc_mono::inc_dec::visit_declaration(
mono_env.arena,
param_map,
mono_env.arena.alloc(main_body),
);
// Put this module's ident_ids back in the interns, so we can use them in env.
// This must happen *after* building the headers, because otherwise there's
// a conflicting mutable borrow on ident_ids.
@ -133,17 +138,15 @@ pub fn helper_without_uniqueness<'a>(
// Add all the Proc headers to the module.
// We have to do this in a separate pass first,
// because their bodies may reference each other.
for ((symbol, layout), proc) in procs.drain() {
let fn_val = build_proc_header(&env, &mut layout_ids, symbol, &layout, &proc);
for ((symbol, layout), proc) in procs.get_specialized_procs(env.arena).drain() {
let (fn_val, arg_basic_types) =
build_proc_header(&env, &mut layout_ids, symbol, &layout, &proc);
headers.push((proc, fn_val, arg_basic_types));
headers.push((proc, fn_val));
}
// Build each proc using its header info.
for (proc, fn_val, arg_basic_types) in headers {
build_proc(&env, &mut layout_ids, proc, fn_val, arg_basic_types);
for (proc, fn_val) in headers {
build_proc(&env, &mut layout_ids, proc, fn_val);
if fn_val.verify(true) {
function_pass.run_on(&fn_val);
@ -297,8 +300,6 @@ pub fn helper_with_uniqueness<'a>(
};
let main_body = roc_mono::ir::Stmt::new(&mut mono_env, loc_expr.value, &mut procs);
let main_body =
roc_mono::inc_dec::visit_declaration(mono_env.arena, mono_env.arena.alloc(main_body));
let mut headers = {
let num_headers = match &procs.pending_specializations {
Some(map) => map.len(),
@ -315,6 +316,13 @@ pub fn helper_with_uniqueness<'a>(
roc_collections::all::MutMap::default()
);
let (mut procs, param_map) = procs.get_specialized_procs_help(mono_env.arena);
let main_body = roc_mono::inc_dec::visit_declaration(
mono_env.arena,
param_map,
mono_env.arena.alloc(main_body),
);
// Put this module's ident_ids back in the interns, so we can use them in env.
// This must happen *after* building the headers, because otherwise there's
// a conflicting mutable borrow on ident_ids.
@ -323,16 +331,15 @@ pub fn helper_with_uniqueness<'a>(
// Add all the Proc headers to the module.
// We have to do this in a separate pass first,
// because their bodies may reference each other.
for ((symbol, layout), proc) in procs.get_specialized_procs(env.arena).drain() {
let (fn_val, arg_basic_types) =
build_proc_header(&env, &mut layout_ids, symbol, &layout, &proc);
for ((symbol, layout), proc) in procs.drain() {
let fn_val = build_proc_header(&env, &mut layout_ids, symbol, &layout, &proc);
headers.push((proc, fn_val, arg_basic_types));
headers.push((proc, fn_val));
}
// Build each proc using its header info.
for (proc, fn_val, arg_basic_types) in headers {
build_proc(&env, &mut layout_ids, proc, fn_val, arg_basic_types);
for (proc, fn_val) in headers {
build_proc(&env, &mut layout_ids, proc, fn_val);
if fn_val.verify(true) {
fpm.run_on(&fn_val);

1
compiler/module/src/low_level.rs
View File

@ -3,6 +3,7 @@
/// into an Expr when added directly by can::builtins
#[derive(Debug, Copy, Clone, PartialEq, Eq)]
pub enum LowLevel {
StrConcat,
ListLen,
ListGetUnsafe,
ListSet,

1
compiler/module/src/symbol.rs
View File

@ -652,6 +652,7 @@ define_builtins! {
1 STR_AT_STR: "@Str" // the Str.@Str private tag
2 STR_ISEMPTY: "isEmpty"
3 STR_APPEND: "append"
4 STR_CONCAT: "concat"
}
4 LIST: "List" => {
0 LIST_LIST: "List" imported // the List.List type alias

497
compiler/mono/src/borrow.rs Normal file
View File

@ -0,0 +1,497 @@
use crate::ir::{Expr, JoinPointId, Param, Proc, Stmt};
use crate::layout::Layout;
use bumpalo::collections::Vec;
use bumpalo::Bump;
use roc_collections::all::{MutMap, MutSet};
use roc_module::low_level::LowLevel;
use roc_module::symbol::Symbol;
pub fn infer_borrow<'a>(
arena: &'a Bump,
procs: &MutMap<(Symbol, Layout<'a>), Proc<'a>>,
) -> ParamMap<'a> {
let mut param_map = ParamMap {
items: MutMap::default(),
};
for proc in procs.values() {
param_map.visit_proc(arena, proc);
}
let mut env = BorrowInfState {
current_proc: Symbol::ATTR_ATTR,
param_set: MutSet::default(),
owned: MutMap::default(),
modified: false,
param_map,
arena,
};
// This is a fixed-point analysis
//
// all functions initiall own all their paramters
// through a series of checks and heuristics, some arguments are set to borrowed
// when that doesn't lead to conflicts the change is kept, otherwise it may be reverted
//
// when the signatures no longer change, the analysis stops and returns the signatures
loop {
// sort the symbols (roughly) in definition order.
// TODO in the future I think we need to do this properly, and group
// mutually recursive functions (or just make all their arguments owned)
for proc in procs.values() {
env.collect_proc(proc);
}
if !env.modified {
// if there were no modifications, we're done
break;
} else {
// otherwise see if there are changes after another iteration
env.modified = false;
}
}
env.param_map
}
#[derive(Debug, PartialEq, Eq, Hash, Clone)]
enum Key {
Declaration(Symbol),
JoinPoint(JoinPointId),
}
#[derive(Debug, Clone, Default)]
pub struct ParamMap<'a> {
items: MutMap<Key, &'a [Param<'a>]>,
}
impl<'a> ParamMap<'a> {
pub fn get_symbol(&self, symbol: Symbol) -> Option<&'a [Param<'a>]> {
let key = Key::Declaration(symbol);
self.items.get(&key).copied()
}
pub fn get_join_point(&self, id: JoinPointId) -> &'a [Param<'a>] {
let key = Key::JoinPoint(id);
match self.items.get(&key) {
Some(slice) => slice,
None => unreachable!("join point not in param map: {:?}", id),
}
}
}
impl<'a> ParamMap<'a> {
fn init_borrow_params(arena: &'a Bump, ps: &'a [Param<'a>]) -> &'a [Param<'a>] {
Vec::from_iter_in(
ps.iter().map(|p| Param {
borrow: p.layout.is_refcounted(),
layout: p.layout.clone(),
symbol: p.symbol,
}),
arena,
)
.into_bump_slice()
}
fn init_borrow_args(arena: &'a Bump, ps: &'a [(Layout<'a>, Symbol)]) -> &'a [Param<'a>] {
Vec::from_iter_in(
ps.iter().map(|(layout, symbol)| Param {
borrow: layout.is_refcounted(),
layout: layout.clone(),
symbol: *symbol,
}),
arena,
)
.into_bump_slice()
}
fn visit_proc(&mut self, arena: &'a Bump, proc: &Proc<'a>) {
self.items.insert(
Key::Declaration(proc.name),
Self::init_borrow_args(arena, proc.args),
);
self.visit_stmt(arena, proc.name, &proc.body);
}
fn visit_stmt(&mut self, arena: &'a Bump, _fnid: Symbol, stmt: &Stmt<'a>) {
use Stmt::*;
let mut stack = bumpalo::vec![ in arena; stmt ];
while let Some(stmt) = stack.pop() {
match stmt {
Join {
id: j,
parameters: xs,
remainder: v,
continuation: b,
} => {
self.items
.insert(Key::JoinPoint(*j), Self::init_borrow_params(arena, xs));
stack.push(v);
stack.push(b);
}
Let(_, _, _, cont) => {
stack.push(cont);
}
Cond { pass, fail, .. } => {
stack.push(pass);
stack.push(fail);
}
Switch {
branches,
default_branch,
..
} => {
stack.extend(branches.iter().map(|b| &b.1));
stack.push(default_branch);
}
Inc(_, _) | Dec(_, _) => unreachable!("these have not been introduced yet"),
Ret(_) | Jump(_, _) | RuntimeError(_) => {
// these are terminal, do nothing
}
}
}
}
}
// Apply the inferred borrow annotations stored in ParamMap to a block of mutually recursive procs
struct BorrowInfState<'a> {
current_proc: Symbol,
param_set: MutSet<Symbol>,
owned: MutMap<Symbol, MutSet<Symbol>>,
modified: bool,
param_map: ParamMap<'a>,
arena: &'a Bump,
}
impl<'a> BorrowInfState<'a> {
pub fn own_var(&mut self, x: Symbol) {
let current = self.owned.get_mut(&self.current_proc).unwrap();
if current.contains(&x) {
// do nothing
} else {
current.insert(x);
self.modified = true;
}
}
fn is_owned(&self, x: Symbol) -> bool {
match self.owned.get(&self.current_proc) {
None => unreachable!(
"the current procedure symbol {:?} is not in the owned map",
self.current_proc
),
Some(set) => set.contains(&x),
}
}
fn update_param_map(&mut self, k: Key) {
let arena = self.arena;
if let Some(ps) = self.param_map.items.get(&k) {
let ps = Vec::from_iter_in(
ps.iter().map(|p| {
if !p.borrow {
p.clone()
} else if self.is_owned(p.symbol) {
self.modified = true;
let mut p = p.clone();
p.borrow = false;
p
} else {
p.clone()
}
}),
arena,
);
self.param_map.items.insert(k, ps.into_bump_slice());
}
}
/// This looks at an application `f x1 x2 x3`
/// If the parameter (based on the definition of `f`) is owned,
/// then the argument must also be owned
fn own_args_using_params(&mut self, xs: &[Symbol], ps: &[Param<'a>]) {
debug_assert_eq!(xs.len(), ps.len());
for (x, p) in xs.iter().zip(ps.iter()) {
if !p.borrow {
self.own_var(*x);
}
}
}
/// This looks at an application `f x1 x2 x3`
/// If the parameter (based on the definition of `f`) is owned,
/// then the argument must also be owned
fn own_args_using_bools(&mut self, xs: &[Symbol], ps: &[bool]) {
debug_assert_eq!(xs.len(), ps.len());
for (x, borrow) in xs.iter().zip(ps.iter()) {
if !borrow {
self.own_var(*x);
}
}
}
/// For each xs[i], if xs[i] is owned, then mark ps[i] as owned.
/// We use this action to preserve tail calls. That is, if we have
/// a tail call `f xs`, if the i-th parameter is borrowed, but `xs[i]` is owned
/// we would have to insert a `dec xs[i]` after `f xs` and consequently
/// "break" the tail call.
fn own_params_using_args(&mut self, xs: &[Symbol], ps: &[Param<'a>]) {
debug_assert_eq!(xs.len(), ps.len());
for (x, p) in xs.iter().zip(ps.iter()) {
if self.is_owned(*x) {
self.own_var(p.symbol);
}
}
}
/// Mark `xs[i]` as owned if it is one of the parameters `ps`.
/// We use this action to mark function parameters that are being "packed" inside constructors.
/// This is a heuristic, and is not related with the effectiveness of the reset/reuse optimization.
/// It is useful for code such as
///
/// > def f (x y : obj) :=
/// > let z := ctor_1 x y;
/// > ret z
fn own_args_if_param(&mut self, xs: &[Symbol]) {
for x in xs.iter() {
// TODO may also be asking for the index here? see Lean
if self.param_set.contains(x) {
self.own_var(*x);
}
}
}
/// This looks at the assignement
///
/// let z = e in ...
///
/// and determines whether z and which of the symbols used in e
/// must be taken as owned paramters
fn collect_expr(&mut self, z: Symbol, e: &Expr<'a>) {
use Expr::*;
match e {
Tag { arguments: xs, .. } | Struct(xs) | Array { elems: xs, .. } => {
self.own_var(z);
// if the used symbol is an argument to the current function,
// the function must take it as an owned parameter
self.own_args_if_param(xs);
}
EmptyArray => {
self.own_var(z);
}
AccessAtIndex { structure: x, .. } => {
// if the structure (record/tag/array) is owned, the extracted value is
if self.is_owned(*x) {
self.own_var(z);
}
// if the extracted value is owned, the structure must be too
if self.is_owned(z) {
self.own_var(*x);
}
}
FunctionCall {
call_type,
args,
arg_layouts,
..
} => {
// get the borrow signature of the applied function
let ps = match self.param_map.get_symbol(call_type.get_inner()) {
Some(slice) => slice,
None => Vec::from_iter_in(
arg_layouts.iter().cloned().map(|layout| Param {
symbol: Symbol::UNDERSCORE,
borrow: false,
layout,
}),
self.arena,
)
.into_bump_slice(),
};
// the return value will be owned
self.own_var(z);
// if the function exects an owned argument (ps), the argument must be owned (args)
self.own_args_using_params(args, ps);
}
RunLowLevel(op, args) => {
// very unsure what demand RunLowLevel should place upon its arguments
self.own_var(z);
let ps = lowlevel_borrow_signature(self.arena, *op);
self.own_args_using_bools(args, ps);
}
Literal(_) | FunctionPointer(_, _) | RuntimeErrorFunction(_) => {}
}
}
fn preserve_tail_call(&mut self, x: Symbol, v: &Expr<'a>, b: &Stmt<'a>) {
if let (
Expr::FunctionCall {
call_type,
args: ys,
..
},
Stmt::Ret(z),
) = (v, b)
{
let g = call_type.get_inner();
if self.current_proc == g && x == *z {
// anonymous functions (for which the ps may not be known)
// can never be tail-recursive, so this is fine
if let Some(ps) = self.param_map.get_symbol(g) {
self.own_params_using_args(ys, ps)
}
}
}
}
fn update_param_set(&mut self, ps: &[Param<'a>]) {
for p in ps.iter() {
self.param_set.insert(p.symbol);
}
}
fn update_param_set_symbols(&mut self, ps: &[Symbol]) {
for p in ps.iter() {
self.param_set.insert(*p);
}
}
fn collect_stmt(&mut self, stmt: &Stmt<'a>) {
use Stmt::*;
match stmt {
Join {
id: j,
parameters: ys,
remainder: v,
continuation: b,
} => {
let old = self.param_set.clone();
self.update_param_set(ys);
self.collect_stmt(v);
self.param_set = old;
self.update_param_map(Key::JoinPoint(*j));
self.collect_stmt(b);
}
Let(x, Expr::FunctionPointer(fsymbol, layout), _, b) => {
// ensure that the function pointed to is in the param map
if let Some(params) = self.param_map.get_symbol(*fsymbol) {
self.param_map.items.insert(Key::Declaration(*x), params);
}
self.collect_stmt(b);
self.preserve_tail_call(*x, &Expr::FunctionPointer(*fsymbol, layout.clone()), b);
}
Let(x, v, _, b) => {
self.collect_stmt(b);
self.collect_expr(*x, v);
self.preserve_tail_call(*x, v, b);
}
Jump(j, ys) => {
let ps = self.param_map.get_join_point(*j);
// for making sure the join point can reuse
self.own_args_using_params(ys, ps);
// for making sure the tail call is preserved
self.own_params_using_args(ys, ps);
}
Cond { pass, fail, .. } => {
self.collect_stmt(pass);
self.collect_stmt(fail);
}
Switch {
branches,
default_branch,
..
} => {
for (_, b) in branches.iter() {
self.collect_stmt(b);
}
self.collect_stmt(default_branch);
}
Inc(_, _) | Dec(_, _) => unreachable!("these have not been introduced yet"),
Ret(_) | RuntimeError(_) => {
// these are terminal, do nothing
}
}
}
fn collect_proc(&mut self, proc: &Proc<'a>) {
let old = self.param_set.clone();
let ys = Vec::from_iter_in(proc.args.iter().map(|t| t.1), self.arena).into_bump_slice();
self.update_param_set_symbols(ys);
self.current_proc = proc.name;
// ensure that current_proc is in the owned map
self.owned.entry(proc.name).or_default();
self.collect_stmt(&proc.body);
self.update_param_map(Key::Declaration(proc.name));
self.param_set = old;
}
}
pub fn lowlevel_borrow_signature(arena: &Bump, op: LowLevel) -> &[bool] {
use LowLevel::*;
// TODO is true or false more efficient for non-refcounted layouts?
let irrelevant = false;
let owned = false;
let borrowed = true;
// Here we define the borrow signature of low-level operations
//
// - arguments with non-refcounted layouts (ints, floats) are `irrelevant`
// - arguments that we may want to update destructively must be Owned
// - other refcounted arguments are Borrowed
match op {
ListLen => arena.alloc_slice_copy(&[borrowed]),
ListSet => arena.alloc_slice_copy(&[owned, irrelevant, irrelevant]),
ListSetInPlace => arena.alloc_slice_copy(&[owned, irrelevant, irrelevant]),
ListGetUnsafe => arena.alloc_slice_copy(&[borrowed, irrelevant]),
ListSingle => arena.alloc_slice_copy(&[irrelevant]),
ListRepeat => arena.alloc_slice_copy(&[irrelevant, irrelevant]),
ListReverse => arena.alloc_slice_copy(&[owned]),
ListConcat | StrConcat => arena.alloc_slice_copy(&[irrelevant, irrelevant]),
ListAppend => arena.alloc_slice_copy(&[owned, owned]),
ListPrepend => arena.alloc_slice_copy(&[owned, owned]),
ListJoin => arena.alloc_slice_copy(&[irrelevant]),
Eq | NotEq | And | Or | NumAdd | NumSub | NumMul | NumGt | NumGte | NumLt | NumLte
| NumDivUnchecked | NumRemUnchecked => arena.alloc_slice_copy(&[irrelevant, irrelevant]),
NumAbs | NumNeg | NumSin | NumCos | NumSqrtUnchecked | NumRound | NumToFloat | Not => {
arena.alloc_slice_copy(&[irrelevant])
}
}
}

262
compiler/mono/src/inc_dec.rs
View File

@ -1,3 +1,4 @@
use crate::borrow::ParamMap;
use crate::ir::{Expr, JoinPointId, Param, Proc, Stmt};
use crate::layout::Layout;
use bumpalo::collections::Vec;
@ -113,7 +114,11 @@ pub fn occuring_variables_expr(expr: &Expr<'_>, result: &mut MutSet<Symbol>) {
result.extend(arguments.iter().copied());
}
RunLowLevel(_, _) | EmptyArray | RuntimeErrorFunction(_) | Literal(_) => {}
RunLowLevel(_, args) => {
result.extend(args.iter());
}
EmptyArray | RuntimeErrorFunction(_) | Literal(_) => {}
}
}
@ -139,7 +144,7 @@ pub struct Context<'a> {
vars: VarMap,
jp_live_vars: JPLiveVarMap, // map: join point => live variables
local_context: LocalContext<'a>, // we use it to store the join point declarations
function_params: MutMap<Symbol, &'a [Param<'a>]>,
param_map: &'a ParamMap<'a>,
}
fn update_live_vars<'a>(expr: &Expr<'a>, v: &LiveVarSet) -> LiveVarSet {
@ -150,6 +155,7 @@ fn update_live_vars<'a>(expr: &Expr<'a>, v: &LiveVarSet) -> LiveVarSet {
v
}
/// `isFirstOcc xs x i = true` if `xs[i]` is the first occurrence of `xs[i]` in `xs`
fn is_first_occurence(xs: &[Symbol], i: usize) -> bool {
match xs.get(i) {
None => unreachable!(),
@ -157,6 +163,9 @@ fn is_first_occurence(xs: &[Symbol], i: usize) -> bool {
}
}
/// Return `n`, the number of times `x` is consumed.
/// - `ys` is a sequence of instruction parameters where we search for `x`.
/// - `consumeParamPred i = true` if parameter `i` is consumed.
fn get_num_consumptions<F>(x: Symbol, ys: &[Symbol], consume_param_pred: F) -> usize
where
F: Fn(usize) -> bool,
@ -171,6 +180,8 @@ where
n
}
/// Return true if `x` also occurs in `ys` in a position that is not consumed.
/// That is, it is also passed as a borrow reference.
fn is_borrow_param_help<F>(x: Symbol, ys: &[Symbol], consume_param_pred: F) -> bool
where
F: Fn(usize) -> bool,
@ -182,11 +193,11 @@ where
fn is_borrow_param(x: Symbol, ys: &[Symbol], ps: &[Param]) -> bool {
// default to owned arguments
let pred = |i: usize| match ps.get(i) {
let is_owned = |i: usize| match ps.get(i) {
Some(param) => !param.borrow,
None => true,
None => unreachable!("or?"),
};
is_borrow_param_help(x, ys, pred)
is_borrow_param_help(x, ys, is_owned)
}
// We do not need to consume the projection of a variable that is not consumed
@ -201,13 +212,13 @@ fn consume_expr(m: &VarMap, e: &Expr<'_>) -> bool {
}
impl<'a> Context<'a> {
pub fn new(arena: &'a Bump) -> Self {
pub fn new(arena: &'a Bump, param_map: &'a ParamMap<'a>) -> Self {
Self {
arena,
vars: MutMap::default(),
jp_live_vars: MutMap::default(),
local_context: LocalContext::default(),
function_params: MutMap::default(),
param_map,
}
}
@ -253,56 +264,13 @@ impl<'a> Context<'a> {
self.arena.alloc(Stmt::Dec(symbol, stmt))
}
fn add_inc_before_consume_all_help<F>(
&self,
xs: &[Symbol],
consume_param_pred: F,
mut b: &'a Stmt<'a>,
live_vars_after: &LiveVarSet,
) -> &'a Stmt<'a>
where
F: Fn(usize) -> bool + Clone,
{
for (i, x) in xs.iter().enumerate() {
let info = self.get_var_info(*x);
if !info.reference || !is_first_occurence(xs, i) {
// do nothing
} else {
// number of times the argument is used (in the body?)
let num_consumptions = get_num_consumptions(*x, xs, consume_param_pred.clone());
// `x` is not a variable that must be consumed by the current procedure
// `x` is live after executing instruction
// `x` is used in a position that is passed as a borrow reference
let lives_on = !info.consume
|| live_vars_after.contains(x)
|| is_borrow_param_help(*x, xs, consume_param_pred.clone());
let num_incs = if lives_on {
num_consumptions
} else {
num_consumptions - 1
};
// Lean can increment by more than 1 at once. Is that needed?
debug_assert!(num_incs <= 1);
if num_incs == 1 {
b = self.add_inc(*x, b);
}
}
}
b
}
fn add_inc_before_consume_all(
&self,
xs: &[Symbol],
b: &'a Stmt<'a>,
live_vars_after: &LiveVarSet,
) -> &'a Stmt<'a> {
self.add_inc_before_consume_all_help(xs, |_: usize| true, b, live_vars_after)
self.add_inc_before_help(xs, |_: usize| true, b, live_vars_after)
}
fn add_inc_before_help<F>(
@ -321,11 +289,17 @@ impl<'a> Context<'a> {
// do nothing
} else {
let num_consumptions = get_num_consumptions(*x, xs, consume_param_pred.clone()); // number of times the argument is used
let num_incs = if !info.consume || // `x` is not a variable that must be consumed by the current procedure
live_vars_after.contains(x) || // `x` is live after executing instruction
is_borrow_param_help( *x ,xs, consume_param_pred.clone())
// `x` is not a variable that must be consumed by the current procedure
let need_not_consume = !info.consume;
// `x` is live after executing instruction
let is_live_after = live_vars_after.contains(x);
// `x` is used in a position that is passed as a borrow reference
{
let is_borrowed = is_borrow_param_help(*x, xs, consume_param_pred.clone());
let num_incs = if need_not_consume || is_live_after || is_borrowed {
num_consumptions
} else {
num_consumptions - 1
@ -352,7 +326,7 @@ impl<'a> Context<'a> {
// default to owned arguments
let pred = |i: usize| match ps.get(i) {
Some(param) => !param.borrow,
None => true,
None => unreachable!("or?"),
};
self.add_inc_before_help(xs, pred, b, live_vars_after)
}
@ -383,10 +357,10 @@ impl<'a> Context<'a> {
b_live_vars: &LiveVarSet,
) -> &'a Stmt<'a> {
for (i, x) in xs.iter().enumerate() {
/* We must add a `dec` if `x` must be consumed, it is alive after the application,
and it has been borrowed by the application.
Remark: `x` may occur multiple times in the application (e.g., `f x y x`).
This is why we check whether it is the first occurrence. */
// We must add a `dec` if `x` must be consumed, it is alive after the application,
// and it has been borrowed by the application.
// Remark: `x` may occur multiple times in the application (e.g., `f x y x`).
// This is why we check whether it is the first occurrence.
if self.must_consume(*x)
&& is_first_occurence(xs, i)
&& is_borrow_param(*x, xs, ps)
@ -399,6 +373,31 @@ impl<'a> Context<'a> {
b
}
fn add_dec_after_lowlevel(
&self,
xs: &[Symbol],
ps: &[bool],
mut b: &'a Stmt<'a>,
b_live_vars: &LiveVarSet,
) -> &'a Stmt<'a> {
for (i, (x, is_borrow)) in xs.iter().zip(ps.iter()).enumerate() {
/* We must add a `dec` if `x` must be consumed, it is alive after the application,
and it has been borrowed by the application.
Remark: `x` may occur multiple times in the application (e.g., `f x y x`).
This is why we check whether it is the first occurrence. */
if self.must_consume(*x)
&& is_first_occurence(xs, i)
&& *is_borrow
&& !b_live_vars.contains(x)
{
b = self.add_dec(*x, b);
}
}
b
}
#[allow(clippy::many_single_char_names)]
fn visit_variable_declaration(
&self,
@ -432,54 +431,37 @@ impl<'a> Context<'a> {
self.arena.alloc(Stmt::Let(z, v, l, b))
}
RunLowLevel(_, _) => {
// THEORY: runlowlevel only occurs
//
// - in a custom hard-coded function
// - when we insert them as compiler authors
//
// if we're carefule to only use RunLowLevel for non-rc'd types
// (e.g. when building a cond/switch, we check equality on integers, and to boolean and)
// then RunLowLevel should not change in any way the refcounts.
RunLowLevel(op, args) => {
let ps = crate::borrow::lowlevel_borrow_signature(self.arena, op);
let b = self.add_dec_after_lowlevel(args, ps, b, b_live_vars);
// let b = self.add_dec_after_application(ys, ps, b, b_live_vars);
self.arena.alloc(Stmt::Let(z, v, l, b))
}
FunctionCall {
args: ys,
call_type,
arg_layouts,
call_type,
..
} => {
// this is where the borrow signature would come in
//let ps := (getDecl ctx f).params;
use crate::ir::CallType;
use crate::layout::Builtin;
let symbol = match call_type {
CallType::ByName(s) => s,
CallType::ByPointer(s) => s,
// get the borrow signature
let ps = match self.param_map.get_symbol(call_type.get_inner()) {
Some(slice) => slice,
None => Vec::from_iter_in(
arg_layouts.iter().cloned().map(|layout| Param {
symbol: Symbol::UNDERSCORE,
borrow: false,
layout,
}),
self.arena,
)
.into_bump_slice(),
};
let ps = Vec::from_iter_in(
arg_layouts.iter().map(|layout| {
let borrow = match layout {
Layout::Builtin(Builtin::List(_, _)) => true,
_ => false,
};
Param {
symbol,
borrow,
layout: layout.clone(),
}
}),
self.arena,
)
.into_bump_slice();
let b = self.add_dec_after_application(ys, ps, b, b_live_vars);
self.arena.alloc(Stmt::Let(z, v, l, b))
let b = self.arena.alloc(Stmt::Let(z, v, l, b));
self.add_inc_before(ys, ps, b, b_live_vars)
}
EmptyArray | FunctionPointer(_, _) | Literal(_) | RuntimeErrorFunction(_) => {
@ -495,13 +477,15 @@ impl<'a> Context<'a> {
fn update_var_info(&self, symbol: Symbol, layout: &Layout<'a>, expr: &Expr<'a>) -> Self {
let mut ctx = self.clone();
// TODO actually make these non-constant
// can this type be reference-counted at runtime?
let reference = layout.contains_refcounted();
// is this value a constant?
let persistent = false;
// TODO do function pointers also fall into this category?
let persistent = match expr {
Expr::FunctionCall { args, .. } => args.is_empty(),
_ => false,
};
// must this value be consumed?
let consume = consume_expr(&ctx.vars, expr);
@ -518,9 +502,6 @@ impl<'a> Context<'a> {
}
fn update_var_info_with_params(&self, ps: &[Param]) -> Self {
//def updateVarInfoWithParams (ctx : Context) (ps : Array Param) : Context :=
//let m := ps.foldl (fun (m : VarMap) p => m.insert p.x { ref := p.ty.isObj, consume := !p.borrow }) ctx.varMap;
//{ ctx with varMap := m }
let mut ctx = self.clone();
for p in ps.iter() {
@ -535,8 +516,13 @@ impl<'a> Context<'a> {
ctx
}
/* Add `dec` instructions for parameters that are references, are not alive in `b`, and are not borrow.
That is, we must make sure these parameters are consumed. */
// Add `dec` instructions for parameters that are
//
// - references
// - not alive in `b`
// - not borrow.
//
// That is, we must make sure these parameters are consumed.
fn add_dec_for_dead_params(
&self,
ps: &[Param<'a>],
@ -619,25 +605,20 @@ impl<'a> Context<'a> {
Join {
id: j,
parameters: xs,
parameters: _,
remainder: b,
continuation: v,
} => {
let xs = *xs;
let v_orig = v;
// NOTE deviation from lean, insert into local context
let mut ctx = self.clone();
ctx.local_context.join_points.insert(*j, (xs, v_orig));
// get the parameters with borrow signature
let xs = self.param_map.get_join_point(*j);
let (v, v_live_vars) = {
let ctx = ctx.update_var_info_with_params(xs);
let ctx = self.update_var_info_with_params(xs);
ctx.visit_stmt(v)
};
let mut ctx = self.clone();
let v = ctx.add_dec_for_dead_params(xs, v, &v_live_vars);
let mut ctx = ctx.clone();
update_jp_live_vars(*j, xs, v, &mut ctx.jp_live_vars);
@ -673,7 +654,10 @@ impl<'a> Context<'a> {
Some(vars) => vars,
None => &empty,
};
let ps = self.local_context.join_points.get(j).unwrap().0;
// TODO use borrow signature here?
let ps = self.param_map.get_join_point(*j);
// let ps = self.local_context.join_points.get(j).unwrap().0;
let b = self.add_inc_before(xs, ps, stmt, j_live_vars);
let b_live_vars = collect_stmt(b, &self.jp_live_vars, MutSet::default());
@ -796,8 +780,15 @@ pub fn collect_stmt(
collect_stmt(cont, jp_live_vars, vars)
}
Jump(_, arguments) => {
Jump(id, arguments) => {
vars.extend(arguments.iter().copied());
// NOTE deviation from Lean
// we fall through when no join point is available
if let Some(jvars) = jp_live_vars.get(id) {
vars.extend(jvars);
}
vars
}
@ -866,8 +857,13 @@ fn update_jp_live_vars(j: JoinPointId, ys: &[Param], v: &Stmt<'_>, m: &mut JPLiv
m.insert(j, j_live_vars);
}
pub fn visit_declaration<'a>(arena: &'a Bump, stmt: &'a Stmt<'a>) -> &'a Stmt<'a> {
let ctx = Context::new(arena);
/// used to process the main function in the repl
pub fn visit_declaration<'a>(
arena: &'a Bump,
param_map: &'a ParamMap<'a>,
stmt: &'a Stmt<'a>,
) -> &'a Stmt<'a> {
let ctx = Context::new(arena, param_map);
let params = &[] as &[_];
let ctx = ctx.update_var_info_with_params(params);
@ -875,23 +871,21 @@ pub fn visit_declaration<'a>(arena: &'a Bump, stmt: &'a Stmt<'a>) -> &'a Stmt<'a
ctx.add_dec_for_dead_params(params, b, &b_live_vars)
}
pub fn visit_proc<'a>(arena: &'a Bump, proc: &mut Proc<'a>) {
let ctx = Context::new(arena);
pub fn visit_proc<'a>(arena: &'a Bump, param_map: &'a ParamMap<'a>, proc: &mut Proc<'a>) {
let ctx = Context::new(arena, param_map);
if proc.name.is_builtin() {
// we must take care of our own refcounting in builtins
return;
}
let params = Vec::from_iter_in(
proc.args.iter().map(|(layout, symbol)| Param {
symbol: *symbol,
layout: layout.clone(),
borrow: layout.contains_refcounted(),
}),
arena,
)
.into_bump_slice();
let params = match param_map.get_symbol(proc.name) {
Some(slice) => slice,
None => Vec::from_iter_in(
proc.args.iter().cloned().map(|(layout, symbol)| Param {
symbol,
borrow: false,
layout,
}),
arena,
)
.into_bump_slice(),
};
let stmt = arena.alloc(proc.body.clone());
let ctx = ctx.update_var_info_with_params(params);

129
compiler/mono/src/ir.rs
View File

@ -23,7 +23,7 @@ pub struct PartialProc<'a> {
pub annotation: Variable,
pub pattern_symbols: Vec<'a, Symbol>,
pub body: roc_can::expr::Expr,
pub is_tail_recursive: bool,
pub is_self_recursive: bool,
}
#[derive(Clone, Debug, PartialEq)]
@ -40,7 +40,13 @@ pub struct Proc<'a> {
pub body: Stmt<'a>,
pub closes_over: Layout<'a>,
pub ret_layout: Layout<'a>,
pub is_tail_recursive: bool,
pub is_self_recursive: SelfRecursive,
}
#[derive(Clone, Debug, PartialEq)]
pub enum SelfRecursive {
NotSelfRecursive,
SelfRecursive(JoinPointId),
}
impl<'a> Proc<'a> {
@ -111,15 +117,74 @@ impl<'a> Procs<'a> {
for (key, in_prog_proc) in self.specialized.into_iter() {
match in_prog_proc {
InProgress => unreachable!("The procedure {:?} should have be done by now", key),
Done(mut proc) => {
crate::inc_dec::visit_proc(arena, &mut proc);
Done(proc) => {
result.insert(key, proc);
}
}
}
for (_, proc) in result.iter_mut() {
use self::SelfRecursive::*;
if let SelfRecursive(id) = proc.is_self_recursive {
proc.body = crate::tail_recursion::make_tail_recursive(
arena,
id,
proc.name,
proc.body.clone(),
proc.args,
);
}
}
let borrow_params = arena.alloc(crate::borrow::infer_borrow(arena, &result));
for (_, proc) in result.iter_mut() {
crate::inc_dec::visit_proc(arena, borrow_params, proc);
}
result
}
pub fn get_specialized_procs_help(
self,
arena: &'a Bump,
) -> (
MutMap<(Symbol, Layout<'a>), Proc<'a>>,
&'a crate::borrow::ParamMap<'a>,
) {
let mut result = MutMap::with_capacity_and_hasher(self.specialized.len(), default_hasher());
for (key, in_prog_proc) in self.specialized.into_iter() {
match in_prog_proc {
InProgress => unreachable!("The procedure {:?} should have be done by now", key),
Done(proc) => {
result.insert(key, proc);
}
}
}
for (_, proc) in result.iter_mut() {
use self::SelfRecursive::*;
if let SelfRecursive(id) = proc.is_self_recursive {
proc.body = crate::tail_recursion::make_tail_recursive(
arena,
id,
proc.name,
proc.body.clone(),
proc.args,
);
}
}
let borrow_params = arena.alloc(crate::borrow::infer_borrow(arena, &result));
for (_, proc) in result.iter_mut() {
crate::inc_dec::visit_proc(arena, borrow_params, proc);
}
(result, borrow_params)
}
// TODO trim down these arguments!
#[allow(clippy::too_many_arguments)]
pub fn insert_named(
@ -130,7 +195,7 @@ impl<'a> Procs<'a> {
annotation: Variable,
loc_args: std::vec::Vec<(Variable, Located<roc_can::pattern::Pattern>)>,
loc_body: Located<roc_can::expr::Expr>,
is_tail_recursive: bool,
is_self_recursive: bool,
ret_var: Variable,
) {
match patterns_to_when(env, layout_cache, loc_args, ret_var, loc_body) {
@ -145,7 +210,7 @@ impl<'a> Procs<'a> {
annotation,
pattern_symbols,
body: body.value,
is_tail_recursive,
is_self_recursive,
},
);
}
@ -179,7 +244,7 @@ impl<'a> Procs<'a> {
layout_cache: &mut LayoutCache<'a>,
) -> Result<Layout<'a>, RuntimeError> {
// anonymous functions cannot reference themselves, therefore cannot be tail-recursive
let is_tail_recursive = false;
let is_self_recursive = false;
match patterns_to_when(env, layout_cache, loc_args, ret_var, loc_body) {
Ok((pattern_vars, pattern_symbols, body)) => {
@ -219,7 +284,7 @@ impl<'a> Procs<'a> {
annotation,
pattern_symbols,
body: body.value,
is_tail_recursive,
is_self_recursive,
},
);
}
@ -229,7 +294,7 @@ impl<'a> Procs<'a> {
annotation,
pattern_symbols,
body: body.value,
is_tail_recursive,
is_self_recursive,
};
// Mark this proc as in-progress, so if we're dealing with
@ -459,6 +524,15 @@ pub enum CallType {
ByPointer(Symbol),
}
impl CallType {
pub fn get_inner(&self) -> Symbol {
match self {
CallType::ByName(s) => *s,
CallType::ByPointer(s) => *s,
}
}
}
#[derive(Clone, Debug, PartialEq)]
pub enum Expr<'a> {
Literal(Literal<'a>),
@ -1001,7 +1075,7 @@ fn specialize<'a>(
annotation,
pattern_symbols,
body,
is_tail_recursive,
is_self_recursive,
} = partial_proc;
// unify the called function with the specialized signature, then specialize the function body
@ -1031,9 +1105,6 @@ fn specialize<'a>(
let proc_args = proc_args.into_bump_slice();
let specialized_body =
crate::tail_recursion::make_tail_recursive(env, proc_name, specialized_body, proc_args);
let ret_layout = layout_cache
.from_var(&env.arena, ret_var, env.subs)
.unwrap_or_else(|err| panic!("TODO handle invalid function {:?}", err));
@ -1041,13 +1112,19 @@ fn specialize<'a>(
// TODO WRONG
let closes_over_layout = Layout::Struct(&[]);
let recursivity = if is_self_recursive {
SelfRecursive::SelfRecursive(JoinPointId(env.unique_symbol()))
} else {
SelfRecursive::NotSelfRecursive
};
let proc = Proc {
name: proc_name,
args: proc_args,
body: specialized_body,
closes_over: closes_over_layout,
ret_layout,
is_tail_recursive,
is_self_recursive: recursivity,
};
Ok(proc)
@ -1109,8 +1186,8 @@ pub fn with_hole<'a>(
let (loc_body, ret_var) = *boxed_body;
let is_tail_recursive =
matches!(recursivity, roc_can::expr::Recursive::TailRecursive);
let is_self_recursive =
!matches!(recursivity, roc_can::expr::Recursive::NotRecursive);
procs.insert_named(
env,
@ -1119,7 +1196,7 @@ pub fn with_hole<'a>(
ann,
loc_args,
loc_body,
is_tail_recursive,
is_self_recursive,
ret_var,
);
@ -1193,8 +1270,8 @@ pub fn with_hole<'a>(
let (loc_body, ret_var) = *boxed_body;
let is_tail_recursive =
matches!(recursivity, roc_can::expr::Recursive::TailRecursive);
let is_self_recursive =
!matches!(recursivity, roc_can::expr::Recursive::NotRecursive);
procs.insert_named(
env,
@ -1203,7 +1280,7 @@ pub fn with_hole<'a>(
ann,
loc_args,
loc_body,
is_tail_recursive,
is_self_recursive,
ret_var,
);
@ -2060,8 +2137,8 @@ pub fn from_can<'a>(
let (loc_body, ret_var) = *boxed_body;
let is_tail_recursive =
matches!(recursivity, roc_can::expr::Recursive::TailRecursive);
let is_self_recursive =
!matches!(recursivity, roc_can::expr::Recursive::NotRecursive);
procs.insert_named(
env,
@ -2070,7 +2147,7 @@ pub fn from_can<'a>(
ann,
loc_args,
loc_body,
is_tail_recursive,
is_self_recursive,
ret_var,
);
@ -2096,8 +2173,8 @@ pub fn from_can<'a>(
let (loc_body, ret_var) = *boxed_body;
let is_tail_recursive =
matches!(recursivity, roc_can::expr::Recursive::TailRecursive);
let is_self_recursive =
!matches!(recursivity, roc_can::expr::Recursive::NotRecursive);
procs.insert_named(
env,
@ -2106,7 +2183,7 @@ pub fn from_can<'a>(
ann,
loc_args,
loc_body,
is_tail_recursive,
is_self_recursive,
ret_var,
);

54
compiler/mono/src/layout.rs
View File

@ -22,6 +22,7 @@ pub enum Layout<'a> {
Builtin(Builtin<'a>),
Struct(&'a [Layout<'a>]),
Union(&'a [&'a [Layout<'a>]]),
RecursiveUnion(&'a [&'a [Layout<'a>]]),
/// A function. The types of its arguments, then the type of its return value.
FunctionPointer(&'a [Layout<'a>], &'a Layout<'a>),
Pointer(&'a Layout<'a>),
@ -96,6 +97,10 @@ impl<'a> Layout<'a> {
Union(tags) => tags
.iter()
.all(|tag_layout| tag_layout.iter().all(|field| field.safe_to_memcpy())),
RecursiveUnion(_) => {
// a recursive union will always contain a pointer, and are thus not safe to memcpy
false
}
FunctionPointer(_, _) => {
// Function pointers are immutable and can always be safely copied
true
@ -138,6 +143,16 @@ impl<'a> Layout<'a> {
})
.max()
.unwrap_or_default(),
RecursiveUnion(fields) => fields
.iter()
.map(|tag_layout| {
tag_layout
.iter()
.map(|field| field.stack_size(pointer_size))
.sum()
})
.max()
.unwrap_or_default(),
FunctionPointer(_, _) => pointer_size,
Pointer(_) => pointer_size,
}
@ -146,6 +161,7 @@ impl<'a> Layout<'a> {
pub fn is_refcounted(&self) -> bool {
match self {
Layout::Builtin(Builtin::List(_, _)) => true,
Layout::RecursiveUnion(_) => true,
_ => false,
}
}
@ -164,6 +180,7 @@ impl<'a> Layout<'a> {
.map(|ls| ls.iter())
.flatten()
.any(|f| f.is_refcounted()),
RecursiveUnion(_) => true,
FunctionPointer(_, _) | Pointer(_) => false,
}
}
@ -406,8 +423,41 @@ fn layout_from_flat_type<'a>(
Ok(layout_from_tag_union(arena, tags, subs))
}
RecursiveTagUnion(_rec_var, _tags, _ext_var) => {
panic!("TODO make Layout for empty RecursiveTagUnion");
RecursiveTagUnion(_rec_var, _tags, ext_var) => {
debug_assert!(ext_var_is_empty_tag_union(subs, ext_var));
// some observations
//
// * recursive tag unions are always recursive
// * therefore at least one tag has a pointer (non-zero sized) field
// * they must (to be instantiated) have 2 or more tags
//
// That means none of the optimizations for enums or single tag tag unions apply
// let rec_var = subs.get_root_key_without_compacting(rec_var);
// let mut tag_layouts = Vec::with_capacity_in(tags.len(), arena);
//
// // tags: MutMap<TagName, std::vec::Vec<Variable>>,
// for (_name, variables) in tags {
// let mut tag_layout = Vec::with_capacity_in(variables.len(), arena);
//
// for var in variables {
// // TODO does this still cause problems with mutually recursive unions?
// if rec_var == subs.get_root_key_without_compacting(var) {
// // TODO make this a pointer?
// continue;
// }
//
// let var_content = subs.get_without_compacting(var).content;
//
// tag_layout.push(Layout::new(arena, var_content, subs)?);
// }
//
// tag_layouts.push(tag_layout.into_bump_slice());
// }
//
// Ok(Layout::RecursiveUnion(tag_layouts.into_bump_slice()))
Ok(Layout::RecursiveUnion(&[]))
}
EmptyTagUnion => {
panic!("TODO make Layout for empty Tag Union");

1
compiler/mono/src/lib.rs
View File

@ -11,6 +11,7 @@
// re-enable this when working on performance optimizations than have it block PRs.
#![allow(clippy::large_enum_variant)]
pub mod borrow;
pub mod inc_dec;
pub mod ir;
pub mod layout;

42
compiler/mono/src/tail_recursion.rs
View File

@ -1,19 +1,40 @@
use crate::ir::{CallType, Env, Expr, JoinPointId, Param, Stmt};
use crate::ir::{CallType, Expr, JoinPointId, Param, Stmt};
use crate::layout::Layout;
use bumpalo::collections::Vec;
use bumpalo::Bump;
use roc_module::symbol::Symbol;
/// Make tail calls into loops (using join points)
///
/// e.g.
///
/// > factorial n accum = if n == 1 then accum else factorial (n - 1) (n * accum)
///
/// becomes
///
/// ```elm
/// factorial n1 accum1 =
/// let joinpoint j n accum =
/// if n == 1 then
/// accum
/// else
/// jump j (n - 1) (n * accum)
///
/// in
/// jump j n1 accum1
/// ```
///
/// This will effectively compile into a loop in llvm, and
/// won't grow the call stack for each iteration
pub fn make_tail_recursive<'a>(
env: &mut Env<'a, '_>,
arena: &'a Bump,
id: JoinPointId,
needle: Symbol,
stmt: Stmt<'a>,
args: &'a [(Layout<'a>, Symbol)],
) -> Stmt<'a> {
let id = JoinPointId(env.unique_symbol());
let alloced = env.arena.alloc(stmt);
match insert_jumps(env.arena, alloced, id, needle) {
let alloced = arena.alloc(stmt);
match insert_jumps(arena, alloced, id, needle) {
None => alloced.clone(),
Some(new) => {
// jumps were inserted, we must now add a join point
@ -24,13 +45,14 @@ pub fn make_tail_recursive<'a>(
layout: layout.clone(),
borrow: true,
}),
env.arena,
arena,
)
.into_bump_slice();
let args = Vec::from_iter_in(args.iter().map(|t| t.1), env.arena).into_bump_slice();
// TODO could this be &[]?
let args = Vec::from_iter_in(args.iter().map(|t| t.1), arena).into_bump_slice();
let jump = env.arena.alloc(Stmt::Jump(id, args));
let jump = arena.alloc(Stmt::Jump(id, args));
Stmt::Join {
id,
@ -185,7 +207,6 @@ fn insert_jumps<'a>(
None
}
}
Ret(_) => None,
Inc(symbol, cont) => match insert_jumps(arena, cont, goal_id, needle) {
Some(cont) => Some(arena.alloc(Inc(*symbol, cont))),
None => None,
@ -195,6 +216,7 @@ fn insert_jumps<'a>(
None => None,
},
Ret(_) => None,
Jump(_, _) => None,
RuntimeError(_) => None,
}

534
compiler/mono/tests/test_mono.rs
View File

@ -66,17 +66,18 @@ mod test_mono {
// let mono_expr = Expr::new(&mut mono_env, loc_expr.value, &mut procs);
let procs = roc_mono::ir::specialize_all(&mut mono_env, procs, &mut LayoutCache::default());
// apply inc/dec
let stmt = mono_env.arena.alloc(ir_expr);
let ir_expr = roc_mono::inc_dec::visit_declaration(mono_env.arena, stmt);
assert_eq!(
procs.runtime_errors,
roc_collections::all::MutMap::default()
);
let (procs, param_map) = procs.get_specialized_procs_help(mono_env.arena);
// apply inc/dec
let stmt = mono_env.arena.alloc(ir_expr);
let ir_expr = roc_mono::inc_dec::visit_declaration(mono_env.arena, param_map, stmt);
let mut procs_string = procs
.get_specialized_procs(mono_env.arena)
.values()
.map(|proc| proc.to_pretty(200))
.collect::<Vec<_>>();
@ -94,6 +95,7 @@ mod test_mono {
let result_lines = result.split("\n").collect::<Vec<&str>>();
assert_eq!(expected_lines, result_lines);
//assert_eq!(0, 1);
}
}
@ -380,27 +382,35 @@ mod test_mono {
fn guard_pattern_true() {
compiles_to_ir(
r#"
when 2 is
2 if False -> 42
_ -> 0
main = \{} ->
when 2 is
2 if False -> 42
_ -> 0
main {}
"#,
indoc!(
r#"
let Test.0 = 2i64;
let Test.6 = true;
let Test.7 = 2i64;
let Test.10 = lowlevel Eq Test.7 Test.0;
let Test.8 = lowlevel And Test.10 Test.6;
let Test.3 = false;
jump Test.2 Test.3;
joinpoint Test.2 Test.9:
let Test.5 = lowlevel And Test.9 Test.8;
if Test.5 then
let Test.1 = 42i64;
ret Test.1;
else
let Test.4 = 0i64;
ret Test.4;
procedure Test.0 (Test.2):
let Test.5 = 2i64;
let Test.11 = true;
let Test.12 = 2i64;
let Test.15 = lowlevel Eq Test.12 Test.5;
let Test.13 = lowlevel And Test.15 Test.11;
let Test.8 = false;
jump Test.7 Test.8;
joinpoint Test.7 Test.14:
let Test.10 = lowlevel And Test.14 Test.13;
if Test.10 then
let Test.6 = 42i64;
ret Test.6;
else
let Test.9 = 0i64;
ret Test.9;
let Test.4 = Struct {};
let Test.3 = CallByName Test.0 Test.4;
ret Test.3;
"#
),
)
@ -539,7 +549,6 @@ mod test_mono {
let Test.6 = 2i64;
let Test.4 = Array [Test.5, Test.6];
let Test.3 = CallByName Test.0 Test.4;
dec Test.4;
ret Test.3;
"#
),
@ -548,6 +557,8 @@ mod test_mono {
#[test]
fn list_append() {
// TODO this leaks at the moment
// ListAppend needs to decrement its arguments
compiles_to_ir(
r#"
List.append [1] 2
@ -562,7 +573,6 @@ mod test_mono {
let Test.1 = Array [Test.3];
let Test.2 = 2i64;
let Test.0 = CallByName List.5 Test.1 Test.2;
dec Test.1;
ret Test.0;
"#
),
@ -581,16 +591,16 @@ mod test_mono {
indoc!(
r#"
procedure Num.14 (#Attr.2, #Attr.3):
let Test.13 = lowlevel NumAdd #Attr.2 #Attr.3;
ret Test.13;
let Test.11 = lowlevel NumAdd #Attr.2 #Attr.3;
ret Test.11;
procedure List.7 (#Attr.2):
let Test.9 = lowlevel ListLen #Attr.2;
ret Test.9;
procedure List.7 (#Attr.2):
let Test.11 = lowlevel ListLen #Attr.2;
ret Test.11;
let Test.10 = lowlevel ListLen #Attr.2;
ret Test.10;
let Test.8 = 1f64;
let Test.1 = Array [Test.8];
@ -613,35 +623,43 @@ mod test_mono {
fn when_joinpoint() {
compiles_to_ir(
r#"
x : [ Red, White, Blue ]
x = Blue
main = \{} ->
x : [ Red, White, Blue ]
x = Blue
y =
when x is
Red -> 1
White -> 2
Blue -> 3
y =
when x is
Red -> 1
White -> 2
Blue -> 3
y
y
main {}
"#,
indoc!(
r#"
let Test.0 = 0u8;
switch Test.0:
case 1:
let Test.4 = 1i64;
jump Test.3 Test.4;
procedure Test.0 (Test.4):
let Test.2 = 0u8;
switch Test.2:
case 1:
let Test.9 = 1i64;
jump Test.8 Test.9;
case 2:
let Test.10 = 2i64;
jump Test.8 Test.10;
default:
let Test.11 = 3i64;
jump Test.8 Test.11;
joinpoint Test.8 Test.3:
ret Test.3;
case 2:
let Test.5 = 2i64;
jump Test.3 Test.5;
default:
let Test.6 = 3i64;
jump Test.3 Test.6;
joinpoint Test.3 Test.1:
ret Test.1;
let Test.6 = Struct {};
let Test.5 = CallByName Test.0 Test.6;
ret Test.5;
"#
),
)
@ -704,43 +722,51 @@ mod test_mono {
fn when_on_result() {
compiles_to_ir(
r#"
x : Result Int Int
x = Ok 2
main = \{} ->
x : Result Int Int
x = Ok 2
y =
when x is
Ok 3 -> 1
Ok _ -> 2
Err _ -> 3
y
y =
when x is
Ok 3 -> 1
Ok _ -> 2
Err _ -> 3
y
main {}
"#,
indoc!(
r#"
let Test.17 = 1i64;
let Test.18 = 2i64;
let Test.0 = Ok Test.17 Test.18;
let Test.13 = true;
let Test.15 = Index 0 Test.0;
let Test.14 = 1i64;
let Test.16 = lowlevel Eq Test.14 Test.15;
let Test.12 = lowlevel And Test.16 Test.13;
if Test.12 then
let Test.8 = true;
let Test.9 = 3i64;
let Test.10 = Index 0 Test.0;
let Test.11 = lowlevel Eq Test.9 Test.10;
let Test.7 = lowlevel And Test.11 Test.8;
if Test.7 then
let Test.4 = 1i64;
jump Test.3 Test.4;
procedure Test.0 (Test.4):
let Test.22 = 1i64;
let Test.23 = 2i64;
let Test.2 = Ok Test.22 Test.23;
let Test.18 = true;
let Test.20 = Index 0 Test.2;
let Test.19 = 1i64;
let Test.21 = lowlevel Eq Test.19 Test.20;
let Test.17 = lowlevel And Test.21 Test.18;
if Test.17 then
let Test.13 = true;
let Test.14 = 3i64;
let Test.15 = Index 0 Test.2;
let Test.16 = lowlevel Eq Test.14 Test.15;
let Test.12 = lowlevel And Test.16 Test.13;
if Test.12 then
let Test.9 = 1i64;
jump Test.8 Test.9;
else
let Test.10 = 2i64;
jump Test.8 Test.10;
else
let Test.5 = 2i64;
jump Test.3 Test.5;
else
let Test.6 = 3i64;
jump Test.3 Test.6;
joinpoint Test.3 Test.1:
ret Test.1;
let Test.11 = 3i64;
jump Test.8 Test.11;
joinpoint Test.8 Test.3:
ret Test.3;
let Test.6 = Struct {};
let Test.5 = CallByName Test.0 Test.6;
ret Test.5;
"#
),
)
@ -796,30 +822,38 @@ mod test_mono {
compiles_to_ir(
indoc!(
r#"
when 10 is
x if x == 5 -> 0
_ -> 42
main = \{} ->
when 10 is
x if x == 5 -> 0
_ -> 42
main {}
"#
),
indoc!(
r#"
procedure Bool.5 (#Attr.2, #Attr.3):
let Test.10 = lowlevel Eq #Attr.2 #Attr.3;
ret Test.10;
procedure Test.0 (Test.3):
let Test.6 = 10i64;
let Test.14 = true;
let Test.10 = 5i64;
let Test.9 = CallByName Bool.5 Test.6 Test.10;
jump Test.8 Test.9;
joinpoint Test.8 Test.15:
let Test.13 = lowlevel And Test.15 Test.14;
if Test.13 then
let Test.7 = 0i64;
ret Test.7;
else
let Test.12 = 42i64;
ret Test.12;
let Test.1 = 10i64;
let Test.8 = true;
let Test.5 = 5i64;
let Test.4 = CallByName Bool.5 Test.1 Test.5;
jump Test.3 Test.4;
joinpoint Test.3 Test.9:
let Test.7 = lowlevel And Test.9 Test.8;
if Test.7 then
let Test.2 = 0i64;
ret Test.2;
else
let Test.6 = 42i64;
ret Test.6;
procedure Bool.5 (#Attr.2, #Attr.3):
let Test.11 = lowlevel Eq #Attr.2 #Attr.3;
ret Test.11;
let Test.5 = Struct {};
let Test.4 = CallByName Test.0 Test.5;
ret Test.4;
"#
),
)
@ -905,12 +939,6 @@ mod test_mono {
),
indoc!(
r#"
procedure Test.1 (Test.3):
let Test.9 = 0i64;
let Test.10 = 0i64;
let Test.8 = CallByName List.4 Test.3 Test.9 Test.10;
ret Test.8;
procedure List.4 (#Attr.2, #Attr.3, #Attr.4):
let Test.14 = lowlevel ListLen #Attr.2;
let Test.12 = lowlevel NumLt #Attr.3 Test.14;
@ -920,12 +948,17 @@ mod test_mono {
else
ret #Attr.2;
procedure Test.1 (Test.3):
let Test.9 = 0i64;
let Test.10 = 0i64;
let Test.8 = CallByName List.4 Test.3 Test.9 Test.10;
ret Test.8;
let Test.5 = 1i64;
let Test.6 = 2i64;
let Test.7 = 3i64;
let Test.0 = Array [Test.5, Test.6, Test.7];
let Test.4 = CallByName Test.1 Test.0;
dec Test.0;
ret Test.4;
"#
),
@ -1066,7 +1099,8 @@ mod test_mono {
)
}
#[allow(dead_code)]
#[ignore]
#[test]
fn quicksort_help() {
crate::helpers::with_larger_debug_stack(|| {
compiles_to_ir(
@ -1094,7 +1128,8 @@ mod test_mono {
})
}
#[allow(dead_code)]
#[ignore]
#[test]
fn quicksort_partition_help() {
crate::helpers::with_larger_debug_stack(|| {
compiles_to_ir(
@ -1128,7 +1163,8 @@ mod test_mono {
})
}
#[allow(dead_code)]
#[ignore]
#[test]
fn quicksort_full() {
crate::helpers::with_larger_debug_stack(|| {
compiles_to_ir(
@ -1217,29 +1253,29 @@ mod test_mono {
"#,
indoc!(
r#"
procedure Num.15 (#Attr.2, #Attr.3):
let Test.13 = lowlevel NumSub #Attr.2 #Attr.3;
ret Test.13;
procedure Test.0 (Test.2, Test.3):
jump Test.20 Test.2 Test.3;
joinpoint Test.20 Test.2 Test.3:
let Test.17 = true;
let Test.18 = 0i64;
let Test.19 = lowlevel Eq Test.18 Test.2;
let Test.16 = lowlevel And Test.19 Test.17;
if Test.16 then
jump Test.18 Test.2 Test.3;
joinpoint Test.18 Test.2 Test.3:
let Test.15 = true;
let Test.16 = 0i64;
let Test.17 = lowlevel Eq Test.16 Test.2;
let Test.14 = lowlevel And Test.17 Test.15;
if Test.14 then
ret Test.3;
else
let Test.13 = 1i64;
let Test.9 = CallByName Num.15 Test.2 Test.13;
let Test.12 = 1i64;
let Test.9 = CallByName Num.15 Test.2 Test.12;
let Test.10 = CallByName Num.16 Test.2 Test.3;
jump Test.20 Test.9 Test.10;
jump Test.18 Test.9 Test.10;
procedure Num.16 (#Attr.2, #Attr.3):
let Test.11 = lowlevel NumMul #Attr.2 #Attr.3;
ret Test.11;
procedure Num.15 (#Attr.2, #Attr.3):
let Test.14 = lowlevel NumSub #Attr.2 #Attr.3;
ret Test.14;
let Test.5 = 10i64;
let Test.6 = 1i64;
let Test.4 = CallByName Test.0 Test.5 Test.6;
@ -1248,4 +1284,248 @@ mod test_mono {
),
)
}
#[test]
#[ignore]
fn is_nil() {
compiles_to_ir(
r#"
ConsList a : [ Cons a (ConsList a), Nil ]
isNil : ConsList a -> Bool
isNil = \list ->
when list is
Nil -> True
Cons _ _ -> False
isNil (Cons 0x2 Nil)
"#,
indoc!(
r#"
procedure Test.1 (Test.3):
let Test.13 = true;
let Test.15 = Index 0 Test.3;
let Test.14 = 1i64;
let Test.16 = lowlevel Eq Test.14 Test.15;
let Test.12 = lowlevel And Test.16 Test.13;
if Test.12 then
let Test.10 = true;
ret Test.10;
else
let Test.11 = false;
ret Test.11;
let Test.6 = 0i64;
let Test.7 = 2i64;
let Test.9 = 1i64;
let Test.8 = Nil Test.9;
let Test.5 = Cons Test.6 Test.7 Test.8;
let Test.4 = CallByName Test.1 Test.5;
ret Test.4;
"#
),
)
}
#[test]
#[ignore]
fn has_none() {
compiles_to_ir(
r#"
Maybe a : [ Just a, Nothing ]
ConsList a : [ Cons a (ConsList a), Nil ]
hasNone : ConsList (Maybe a) -> Bool
hasNone = \list ->
when list is
Nil -> False
Cons Nothing _ -> True
Cons (Just _) xs -> hasNone xs
hasNone (Cons (Just 3) Nil)
"#,
indoc!(
r#"
procedure Test.1 (Test.3):
let Test.13 = true;
let Test.15 = Index 0 Test.3;
let Test.14 = 1i64;
let Test.16 = lowlevel Eq Test.14 Test.15;
let Test.12 = lowlevel And Test.16 Test.13;
if Test.12 then
let Test.10 = true;
ret Test.10;
else
let Test.11 = false;
ret Test.11;
let Test.6 = 0i64;
let Test.7 = 2i64;
let Test.9 = 1i64;
let Test.8 = Nil Test.9;
let Test.5 = Cons Test.6 Test.7 Test.8;
let Test.4 = CallByName Test.1 Test.5;
ret Test.4;
"#
),
)
}
#[test]
fn mk_pair_of() {
compiles_to_ir(
r#"
mkPairOf = \x -> Pair x x
mkPairOf [1,2,3]
"#,
indoc!(
r#"
procedure Test.0 (Test.2):
inc Test.2;
let Test.8 = Struct {Test.2, Test.2};
ret Test.8;
let Test.5 = 1i64;
let Test.6 = 2i64;
let Test.7 = 3i64;
let Test.4 = Array [Test.5, Test.6, Test.7];
let Test.3 = CallByName Test.0 Test.4;
ret Test.3;
"#
),
)
}
#[test]
fn fst() {
compiles_to_ir(
r#"
fst = \x, y -> x
fst [1,2,3] [3,2,1]
"#,
indoc!(
r#"
procedure Test.0 (Test.2, Test.3):
inc Test.2;
ret Test.2;
let Test.10 = 1i64;
let Test.11 = 2i64;
let Test.12 = 3i64;
let Test.5 = Array [Test.10, Test.11, Test.12];
let Test.7 = 3i64;
let Test.8 = 2i64;
let Test.9 = 1i64;
let Test.6 = Array [Test.7, Test.8, Test.9];
let Test.4 = CallByName Test.0 Test.5 Test.6;
dec Test.6;
dec Test.5;
ret Test.4;
"#
),
)
}
#[test]
fn list_cannot_update_inplace() {
compiles_to_ir(
indoc!(
r#"
x : List Int
x = [1,2,3]
add : List Int -> List Int
add = \y -> List.set y 0 0
List.len (add x) + List.len x
"#
),
indoc!(
r#"
procedure Num.14 (#Attr.2, #Attr.3):
let Test.19 = lowlevel NumAdd #Attr.2 #Attr.3;
ret Test.19;
procedure Test.1 (Test.3):
let Test.13 = 0i64;
let Test.14 = 0i64;
let Test.12 = CallByName List.4 Test.3 Test.13 Test.14;
ret Test.12;
procedure List.4 (#Attr.2, #Attr.3, #Attr.4):
let Test.18 = lowlevel ListLen #Attr.2;
let Test.16 = lowlevel NumLt #Attr.3 Test.18;
if Test.16 then
let Test.17 = lowlevel ListSet #Attr.2 #Attr.3 #Attr.4;
ret Test.17;
else
ret #Attr.2;
procedure List.7 (#Attr.2):
let Test.11 = lowlevel ListLen #Attr.2;
ret Test.11;
let Test.8 = 1i64;
let Test.9 = 2i64;
let Test.10 = 3i64;
let Test.0 = Array [Test.8, Test.9, Test.10];
inc Test.0;
let Test.7 = CallByName Test.1 Test.0;
let Test.5 = CallByName List.7 Test.7;
dec Test.7;
let Test.6 = CallByName List.7 Test.0;
dec Test.0;
let Test.4 = CallByName Num.14 Test.5 Test.6;
ret Test.4;
"#
),
)
}
#[test]
fn list_get() {
compiles_to_ir(
indoc!(
r#"
main = \{} ->
List.get [1,2,3] 0
main {}
"#
),
indoc!(
r#"
procedure Test.0 (Test.2):
let Test.16 = 1i64;
let Test.17 = 2i64;
let Test.18 = 3i64;
let Test.6 = Array [Test.16, Test.17, Test.18];
let Test.7 = 0i64;
let Test.5 = CallByName List.3 Test.6 Test.7;
dec Test.6;
ret Test.5;
procedure List.3 (#Attr.2, #Attr.3):
let Test.15 = lowlevel ListLen #Attr.2;
let Test.11 = lowlevel NumLt #Attr.3 Test.15;
if Test.11 then
let Test.13 = 1i64;
let Test.14 = lowlevel ListGetUnsafe #Attr.2 #Attr.3;
let Test.12 = Ok Test.13 Test.14;
ret Test.12;
else
let Test.9 = 0i64;
let Test.10 = Struct {};
let Test.8 = Err Test.9 Test.10;
ret Test.8;
let Test.4 = Struct {};
let Test.3 = CallByName Test.0 Test.4;
ret Test.3;
"#
),
)
}
}

4
compiler/solve/tests/solve_uniq_expr.rs
View File

@ -2416,9 +2416,9 @@ mod solve_uniq_expr {
}
#[test]
fn str_append() {
fn str_concat() {
infer_eq(
"Str.append",
"Str.concat",
"Attr * (Attr * Str, Attr * Str -> Attr * Str)",
);
}

69
examples/shared-quicksort/Quicksort.roc Normal file
View File

@ -0,0 +1,69 @@
app Quicksort provides [ quicksort ] imports []
quicksort : List Int -> List Int
quicksort = \originalList -> helper originalList
helper : List Int -> List Int
helper = \originalList ->
quicksortHelp : List (Num a), Int, Int -> List (Num a)
quicksortHelp = \list, low, high ->
if low < high then
when partition low high list is
Pair partitionIndex partitioned ->
partitioned
|> quicksortHelp low (partitionIndex - 1)
|> quicksortHelp (partitionIndex + 1) high
else
list
swap : Int, Int, List a -> List a
swap = \i, j, list ->
when Pair (List.get list i) (List.get list j) is
Pair (Ok atI) (Ok atJ) ->
list
|> List.set i atJ
|> List.set j atI
_ ->
[]
partition : Int, Int, List (Num a) -> [ Pair Int (List (Num a)) ]
partition = \low, high, initialList ->
when List.get initialList high is
Ok pivot ->
when partitionHelp (low - 1) low initialList high pivot is
Pair newI newList ->
Pair (newI + 1) (swap (newI + 1) high newList)
Err _ ->
Pair (low - 1) initialList
partitionHelp : Int, Int, List (Num a), Int, (Num a) -> [ Pair Int (List (Num a)) ]
partitionHelp = \i, j, list, high, pivot ->
if j < high then
when List.get list j is
Ok value ->
if value <= pivot then
partitionHelp (i + 1) (j + 1) (swap (i + 1) j list) high pivot
else
partitionHelp i (j + 1) list high pivot
Err _ ->
Pair i list
else
Pair i list
result = quicksortHelp originalList 0 (List.len originalList - 1)
if List.len originalList > 3 then
result
else
# Absolutely make the `originalList` Shared by using it again here
# but this branch is not evaluated, so should not affect performance
List.set originalList 0 (List.len originalList)

47
examples/shared-quicksort/host.rs Normal file
View File

@ -0,0 +1,47 @@
use std::time::SystemTime;
#[link(name = "roc_app", kind = "static")]
extern "C" {
#[allow(improper_ctypes)]
#[link_name = "quicksort#1"]
fn quicksort(list: &[i64]) -> Box<[i64]>;
}
const NUM_NUMS: usize = 1_000_000;
pub fn main() {
let nums = {
let mut nums = Vec::with_capacity(NUM_NUMS + 1);
// give this list refcount 1
nums.push((std::usize::MAX - 1) as i64);
for index in 1..nums.capacity() {
let num = index as i64 % 12345;
nums.push(num);
}
nums
};
println!("Running Roc shared quicksort");
let start_time = SystemTime::now();
let answer = unsafe { quicksort(&nums[1..]) };
let end_time = SystemTime::now();
let duration = end_time.duration_since(start_time).unwrap();
println!(
"Roc quicksort took {:.4} ms to compute this answer: {:?}",
duration.as_secs_f64() * 1000.0,
// truncate the answer, so stdout is not swamped
// NOTE index 0 is the refcount!
&answer[1..20]
);
// the pointer is to the first _element_ of the list,
// but the refcount precedes it. Thus calling free() on
// this pointer would segfault/cause badness. Therefore, we
// leak it for now
Box::leak(answer);
}

94
roc-for-elm-programmers.md
View File

@ -122,50 +122,6 @@ You can rewrite the above like so:
\UserId id ->
```
## Function equality
In Elm, if you write `(\val -> val) == (\val -> val)`, you currently get a runtime exception
which links to [the `==` docs](https://package.elm-lang.org/packages/elm/core/latest/Basics#==), which explain why this is the current behavior and what the better version will look like.
> OCaml also has the "runtime exception if you compare functions for structural equality" behavior, but unlike Elm, in OCaml this appears to be the long-term design.
In Roc, the design is for function equality to be a compile error, but not tracked visibly
in the type system. In this way it's like tail calls; the compiler tracks them, but
it tracks them in a way that is not exposed to the author directly.
So if you write `(\val -> val) == (\val -> val)` in Roc, you'll get a compile error about "function equality," but not a type mismatch - because the types will be identical (`a -> a` in both cases).
The reason for this design is that in practice, the Elm stopgap runtime exception design has
revealed that this edge case comes up absurdly infrequently - to the point where many seasoned Elm programmers do not even know this is a runtime exception, because they've never even accidentally written code that triggers it!
Clearly since this is detectable at compile time, it's a nicer design to give the feedback
at compile time rather than crashing at runtime. Also, it happens so infrequently that it would
be hard to justify lots of type signatures gaining an `Eq` constraint of some sort -
especially when the syntax for that would be added to the language *solely* for the sake
of this extreme edge case.
Instead the design is to track this behind the scenes only, and give
a separate class of compiler error for it than the "type mismatch" error you'd see
for this in Rust or Haskell.
> It's possible that it would be nice to present a note when printing these types
> in a REPL or editor, e.g.
>
> ```
> > \a, b -> a == b
> <function> : a, a -> Bool
>
> Note: this `a` type variable will not accept types that contain functions
> ```
>
> I can see a similar argument for noting information about whether a function
> is tail-recursive. For example:
>
> ```
> > fibonacci
> <tail-recursive function> : Int -> Int
> ```
## Unbound type variables
In Elm, every type variable is named. For example:
@ -776,25 +732,54 @@ outside a record field. Optionality is a concept that exists only in record fiel
and it's intended for the use case of config records like this. The ergonomics
of destructuring mean this wouldn't be a good fit for data modeling.
## Function equality
In Elm, if you write `(\val -> val) == (\val -> val)`, you currently get a runtime exception
which links to [the `==` docs](https://package.elm-lang.org/packages/elm/core/latest/Basics#==),
which explain why this is the current behavior and what the better version will look like.
> OCaml also has the "runtime exception if you compare functions for structural equality"
> behavior, but unlike Elm, in OCaml this appears to be the long-term design.
In Roc, function equality is a compile error, tracked explicitly in the type system.
Here's the type of Roc's equality function:
```elm
'val, 'val -> Bool
```
Whenever a named type variable in Roc has a `'` at the beginning, that means
it is a *functionless* type - a type which cannot involve functions.
If there are any functions in that type, it's a type mismatch. This is true
whether `val` itself is a function, or if it's a type that wraps a function,
like `{ predicate: (Int -> Bool) }` or `List (Bool -> Bool)`.
So if you write `(\a -> a) == (\a -> a)` in Roc, you'll get a type mismatch.
If you wrap both sides of that `==` in a record or list, you'll still get a
type mismatch.
If a named type variable has a `'` anywhere in a given type, then it must have a `'`
everywhere in that type. So it would be an error to have a type like `x, 'x -> Bool`
because `x` has a `'` in one place but not everywhere.
## Standard Data Structures
Elm has `List`, `Array`, `Set`, and `Dict` in the standard library.
Roc has `List`, `Bytes`, `Set`, and `Map` in the standard library.
Roc has `List`, `Set`, and `Map` in the standard library.
Here are the differences:
* `List` in Roc uses the term "list" the way Python does: to mean an unordered sequence of elements. Roc's `List` is more like Elm's `Array`; under the hood it is a RRB tree - specifically, [this one](https://docs.rs/im/14.0.0/im/vector/index.html). It still uses the `[` `]` syntax for values. Also there is no `::` operator because "cons" is not a notably efficient operation on a RRB tree like it is in a linked list; adding an element to either the beginning or end of a Roc `List` is an amortized constant time operation.
* `Bytes` in Roc works like [`Bytes` in `elm/bytes`](https://package.elm-lang.org/packages/elm/bytes/latest/Bytes). It's in the standard library because Roc does not have a concept analogous to Elm's `Kernel`, so if `Bytes` weren't in the standard library, it could not exist as a separate package (and thus operating on raw byte streams would not be supported in Roc).
* `Map` in Roc is like `Dict` in Elm, except it's backed by hashing rather than ordering. Like `List`, it uses [one of Bodil Stokke's `im-rs` persistent data structures](https://docs.rs/im/14.0.0/im/hashmap/index.html) under the hood. Roc also silently computes hash values for any value that can be used with `==`, so there is no `comparable` (or similar) constraint on `Map` keys in Roc.
* `Set` in Roc is like `Set` in Elm: it's shorthand for a `Map` with keys but no value, and it has a slightly different API. Like with `Map`, there is no `comparable` (or similar) constraint on the values that can go in a Roc `Set`.
* `List` in Roc uses the term "list" the way Python does: to mean an unordered sequence of elements. Roc's `List` is more like an array, in that all the elements are sequential in memory and can be accessed in constant time. It still uses the `[` `]` syntax for list literals. Also there is no `::` operator because "cons" is not an efficient operation on an array like it is in a linked list.
* `Map` in Roc is like `Dict` in Elm, except it's backed by hashing rather than ordering. Roc silently computes hash values for any value that can be used with `==`, so instead of a `comparable` constraint on `Set` elements and `Map` keys, in Roc they instead have the *functionless* constraint indicated with a `'`. So to add to a `Set` you use `Set.add : Set 'elem, 'elem -> Set 'elem`, and putting a value into a Map is `Map.put : Map 'key val, 'key, val -> Map 'key val`.
* `Set` in Roc is like `Set` in Elm: it's shorthand for a `Map` with keys but no value, and it has a slightly different API.
> The main reason it's called `Map` instead of `Dict` is that it's annoying to have a conversation about `Dict` out loud, let alone to teach it in a workshop, because you have to be so careful to enunciate. `Map` is one letter shorter, doesn't have this problem, is widely used, and never seems to be confused with the `map` function in practice (in e.g. JavaScript and Rust, both of which have both `Map` and `map`) even though it seems like it would in theory.
Roc also has a special literal syntax for maps and sets. Here's how to write a `Map` literal:
Roc also has a literal syntax for maps and sets. Here's how to write a `Map` literal:
```elm
{{ "Sam" => 1, "Ali" => 2, firstName => 3 }}
{: "Sam" => 1, "Ali" => 2, firstName => 3 :}
```
This expression has the type `Map Str Int`, and the `firstName` variable would
@ -812,17 +797,18 @@ This works, but is not nearly as nice to read.
Additionally, map literals can compile direcly to efficient initialization code without needing to (hopefully be able to) optimize away the intermediate `List` involved in `fromList`.
`{{}}` is an empty `Map`.
`{::}` is an empty `Map`.
You can write a `Set` literal like this:
```elm
{[ "Sam", "Ali", firstName ]}
[: "Sam", "Ali", firstName :]
```
The `Set` literal syntax is partly for the initialization benefit, and also for symmetry
with the `Map` literal syntax.
`{[]}` is an empty `Set`.
`[::]` is an empty `Set`.
Roc does not have syntax for pattern matching on data structures - not even `[` `]` like Elm does.