language-servers/roc
1
0
Fork 0
mirror of https://github.com/roc-lang/roc.git synced 2025-10-02 16:21:11 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions 6

conditionally leak memory

Browse source
This commit is contained in:
Folkert 2020-08-01 21:37:54 +02:00
parent 5d22b6a9cf
commit 5548bf136d
6 changed files with 372 additions and 7 deletions
Download patch file Download diff file Expand all files Collapse all files

1
cli/src/repl.rs
View file

@ -241,6 +241,7 @@ pub fn gen(src: &str, target: Triple, opt_level: OptLevel) -> Result<(String, St
interns, interns,
module: arena.alloc(module), module: arena.alloc(module),
ptr_bytes, ptr_bytes,
leak: false,
}; };
let mut procs = Procs::default(); let mut procs = Procs::default();
let mut ident_ids = env.interns.all_ident_ids.remove(&home).unwrap(); let mut ident_ids = env.interns.all_ident_ids.remove(&home).unwrap();

1
compiler/build/src/program.rs
View file

@ -157,6 +157,7 @@ pub fn gen(
interns: loaded.interns, interns: loaded.interns,
module: arena.alloc(module), module: arena.alloc(module),
ptr_bytes, ptr_bytes,
leak: false,
}; };
let mut ident_ids = env.interns.all_ident_ids.remove(&home).unwrap(); let mut ident_ids = env.interns.all_ident_ids.remove(&home).unwrap();
let mut layout_ids = LayoutIds::default(); let mut layout_ids = LayoutIds::default();

7
compiler/gen/src/llvm/build.rs
View file

@ -44,6 +44,7 @@ pub struct Env<'a, 'ctx, 'env> {
pub module: &'ctx Module<'ctx>, pub module: &'ctx Module<'ctx>,
pub interns: Interns, pub interns: Interns,
pub ptr_bytes: u32, pub ptr_bytes: u32,
pub leak: bool,
} }
impl<'a, 'ctx, 'env> Env<'a, 'ctx, 'env> { impl<'a, 'ctx, 'env> Env<'a, 'ctx, 'env> {
@ -798,8 +799,10 @@ fn decrement_refcount_list<'a, 'ctx, 'env>(
// refcount is one, and will be decremented. This list can be freed // refcount is one, and will be decremented. This list can be freed
let build_else = || { let build_else = || {
let free = builder.build_free(refcount_ptr); if !env.leak {
builder.insert_instruction(&free, None); let free = builder.build_free(refcount_ptr);
builder.insert_instruction(&free, None);
}
body body
}; };

317
compiler/gen/tests/gen_list.rs
View file

@ -543,6 +543,120 @@ mod gen_list {
); );
} }
#[test]
fn gen_swap() {
assert_evals_to!(
indoc!(
r#"
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
_ ->
[]
swap 0 1 [ 1, 2 ]
"#
),
&[2, 1],
&'static [i64]
);
}
// #[test]
// fn gen_partition() {
// assert_evals_to!(
// indoc!(
// r#"
// 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, Int -> [ 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
//
// # when partition 0 0 [ 1,2,3,4,5 ] is
// # Pair list _ -> list
// [ 1,3 ]
// "#
// ),
// &[2, 1],
// &'static [i64]
// );
// }
// #[test]
// fn gen_partition() {
// assert_evals_to!(
// indoc!(
// r#"
// 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, Int -> [ Pair Int (List (Num a)) ]
//
// # when partition 0 0 [ 1,2,3,4,5 ] is
// # Pair list _ -> list
// [ 1,3 ]
// "#
// ),
// &[2, 1],
// &'static [i64]
// );
// }
#[test] #[test]
fn gen_quicksort() { fn gen_quicksort() {
with_larger_debug_stack(|| { with_larger_debug_stack(|| {
@ -610,7 +724,159 @@ mod gen_list {
"# "#
), ),
&[4, 7, 19, 21], &[4, 7, 19, 21],
&'static [i64] &'static [i64],
|x| x,
true
);
})
}
#[test]
fn foobar2() {
with_larger_debug_stack(|| {
assert_evals_to!(
indoc!(
r#"
quicksort : List (Num a) -> List (Num a)
quicksort = \list ->
quicksortHelp list 0 (List.len list - 1)
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, Int -> [ Pair Int (List (Num a)) ]
partitionHelp = \i, j, list, high, pivot ->
# if j < high then
if False 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
quicksort [ 7, 4, 21, 19 ]
"#
),
&[19, 7, 4, 21],
&'static [i64],
|x| x,
true
);
})
}
#[test]
fn foobar() {
with_larger_debug_stack(|| {
assert_evals_to!(
indoc!(
r#"
quicksort : List (Num a) -> List (Num a)
quicksort = \list ->
quicksortHelp list 0 (List.len list - 1)
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, Int -> [ 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
when List.first (quicksort [0x1]) is
_ -> 4
"#
),
4,
i64,
|x| x,
false
); );
}) })
} }
@ -665,4 +931,53 @@ mod gen_list {
&'static [i64] &'static [i64]
); );
} }
// fn bad() {
// assert_evals_to!(
// indoc!(
// r#"
// id : List Int -> [ Id (List Int) ]
// id = \y -> Pair y 4
//
// when id [ 1,2,3 ] is
// Id v -> v
// "#
// ),
// &[1, 2, 3],
// &'static [i64]
// );
// }
//
#[test]
fn list_wrap_in_tag() {
assert_evals_to!(
indoc!(
r#"
id : List Int -> [ Pair (List Int) Int, Nil ]
id = \y -> Pair y 4
when id [1,2,3] is
Pair _ _ -> v
"#
),
&[1, 2, 3],
&'static [i64]
);
}
#[test]
fn list_wrap_in_tag() {
assert_evals_to!(
indoc!(
r#"
x = [1,2,3]
when id [1,2,3] is
Pair _ _ -> v
"#
),
&[1, 2, 3],
&'static [i64]
);
}
} }

28
compiler/gen/tests/helpers/eval.rs
View file

@ -1,6 +1,6 @@
#[macro_export] #[macro_export]
macro_rules! assert_llvm_evals_to { macro_rules! assert_llvm_evals_to {
($src:expr, $expected:expr, $ty:ty, $transform:expr) => { ($src:expr, $expected:expr, $ty:ty, $transform:expr, $leak:expr) => {
let target = target_lexicon::Triple::host(); let target = target_lexicon::Triple::host();
let ptr_bytes = target.pointer_width().unwrap().bytes() as u32; let ptr_bytes = target.pointer_width().unwrap().bytes() as u32;
let arena = Bump::new(); let arena = Bump::new();
@ -56,7 +56,9 @@ macro_rules! assert_llvm_evals_to {
context: &context, context: &context,
interns, interns,
module: arena.alloc(module), module: arena.alloc(module),
ptr_bytes ptr_bytes,
leak: $leak
}; };
let mut procs = Procs::default(); let mut procs = Procs::default();
let mut ident_ids = env.interns.all_ident_ids.remove(&home).unwrap(); let mut ident_ids = env.interns.all_ident_ids.remove(&home).unwrap();
@ -179,6 +181,10 @@ macro_rules! assert_llvm_evals_to {
assert_eq!($transform(main.call()), $expected); assert_eq!($transform(main.call()), $expected);
} }
}; };
($src:expr, $expected:expr, $ty:ty, $transform:expr) => {
assert_llvm_evals_to!($src, $expected, $ty, $transform, false);
};
} }
// TODO this is almost all code duplication with assert_llvm_evals_to // TODO this is almost all code duplication with assert_llvm_evals_to
@ -186,7 +192,7 @@ macro_rules! assert_llvm_evals_to {
// Should extract the common logic into test helpers. // Should extract the common logic into test helpers.
#[macro_export] #[macro_export]
macro_rules! assert_opt_evals_to { macro_rules! assert_opt_evals_to {
($src:expr, $expected:expr, $ty:ty, $transform:expr) => { ($src:expr, $expected:expr, $ty:ty, $transform:expr, $leak:expr) => {
let arena = Bump::new(); let arena = Bump::new();
let target = target_lexicon::Triple::host(); let target = target_lexicon::Triple::host();
let ptr_bytes = target.pointer_width().unwrap().bytes() as u32; let ptr_bytes = target.pointer_width().unwrap().bytes() as u32;
@ -242,7 +248,8 @@ macro_rules! assert_opt_evals_to {
context: &context, context: &context,
interns, interns,
module: arena.alloc(module), module: arena.alloc(module),
ptr_bytes ptr_bytes,
leak: $leak
}; };
let mut procs = Procs::default(); let mut procs = Procs::default();
let mut ident_ids = env.interns.all_ident_ids.remove(&home).unwrap(); let mut ident_ids = env.interns.all_ident_ids.remove(&home).unwrap();
@ -365,6 +372,10 @@ macro_rules! assert_opt_evals_to {
assert_eq!($transform(main.call()), $expected); assert_eq!($transform(main.call()), $expected);
} }
}; };
($src:expr, $expected:expr, $ty:ty, $transform:expr) => {
assert_llvm_evals_to!($src, $expected, $ty, $transform, false)
};
} }
#[macro_export] #[macro_export]
@ -390,4 +401,13 @@ macro_rules! assert_evals_to {
assert_opt_evals_to!($src, $expected, $ty, $transform); assert_opt_evals_to!($src, $expected, $ty, $transform);
} }
}; };
($src:expr, $expected:expr, $ty:ty, $transform:expr, $leak:expr) => {
// Same as above, except with an additional transformation argument.
{
assert_llvm_evals_to!($src, $expected, $ty, $transform, $leak);
}
{
assert_opt_evals_to!($src, $expected, $ty, $transform, $leak);
}
};
} }

25
compiler/mono/tests/test_mono.rs
View file

@ -1002,4 +1002,29 @@ mod test_mono {
), ),
) )
} }
#[test]
fn double_list_len() {
compiles_to_string(
r#"
x : List Int
x = [1,2,3]
List.len x + List.len x
"#,
indoc!(
r#"
procedure Num.14 (#Attr.2, #Attr.3):
Lowlevel.NumAdd (Load #Attr.2) (Load #Attr.3)
procedure List.7 (#Attr.2):
Lowlevel.ListLen (Load #Attr.2)
Store Test.0: [ 1i64, 2i64, 3i64 ]
Call Num.14 (Call List.7 (Load Test.0)) (Call List.7 (Load Test.0))
Dec Test.0
"#
),
)
}
} }