Compare commits

..

1 Commits

Author SHA1 Message Date
radrow 4e60d019ca Fix constraints ordering 2021-02-23 11:05:02 +01:00
3 changed files with 36 additions and 79 deletions
+1 -9
View File
@@ -975,20 +975,12 @@ List.unzip(l : list('a * 'b)) : list('a) * list('b)
Opposite to the `zip` operation. Takes a list of pairs and returns pair of lists with respective elements on same indices.
### merge
```
List.merge(lesser_cmp : ('a, 'a) => bool, l1 : list('a), l2 : list('a)) : list('a)
```
Merges two sorted lists into a single sorted list. O(length(l1) + length(l2))
### sort
```
List.sort(lesser_cmp : ('a, 'a) => bool, l : list('a)) : list('a)
```
Sorts a list using given comparator. `lesser_cmp(x, y)` should return `true` iff `x < y`. If `lesser_cmp` is not transitive or there exists an element `x` such that `lesser_cmp(x, x)` or there exists a pair of elements `x` and `y` such that `lesser_cmp(x, y) && lesser_cmp(y, x)` then the result is undefined. O(length(l) * log_2(length(l))).
Sorts a list using given comparator. `lesser_cmp(x, y)` should return `true` iff `x < y`. If `lesser_cmp` is not transitive or there exists an element `x` such that `lesser_cmp(x, x)` or there exists a pair of elements `x` and `y` such that `lesser_cmp(x, y) && lesser_cmp(y, x)` then the result is undefined. Currently O(n^2).
### intersperse
+5 -61
View File
@@ -227,67 +227,11 @@ namespace List =
(left, right)::t => unzip_(t, left::acc_l, right::acc_r)
/** Merges two sorted lists using `lt` comparator
*/
function
merge : (('a, 'a) => bool, list('a), list('a)) => list('a)
merge(lt, x::xs, y::ys) =
if(lt(x, y)) x::merge(lt, xs, y::ys)
else y::merge(lt, x::xs, ys)
merge(_, [], ys) = ys
merge(_, xs, []) = xs
/** Mergesort inspired by
* https://hackage.haskell.org/package/base-4.14.1.0/docs/src/Data.OldList.html#sort
*/
function
sort : (('a, 'a) => bool, list('a)) => list('a)
sort(_, []) = []
sort(lt, l) =
merge_all(lt, monotonic_subs(lt, l))
/** Splits list into compound increasing sublists
*/
private function
monotonic_subs : (('a, 'a) => bool, list('a)) => list(list('a))
monotonic_subs(lt, x::y::rest) =
if(lt(y, x)) desc(lt, y, [x], rest)
else asc(lt, y, [x], rest)
monotonic_subs(_, l) = [l]
/** Extracts the longest descending prefix and proceeds with monotonic split
*/
private function
desc : (('a, 'a) => bool, 'a, list('a), list('a)) => list(list('a))
desc(lt, x, acc, h::t) =
if(lt(x, h)) (x::acc) :: monotonic_subs(lt, h::t)
else desc(lt, h, x::acc, t)
desc(_, x, acc, []) = [x::acc]
/** Extracts the longest ascending prefix and proceeds with monotonic split
*/
private function
asc : (('a, 'a) => bool, 'a, list('a), list('a)) => list(list('a))
asc(lt, x, acc, h::t) =
if(lt(h, x)) List.reverse(x::acc) :: monotonic_subs(lt, h::t)
else asc(lt, h, x::acc, t)
asc(_, x, acc, []) = [List.reverse(x::acc)]
/** Merges list of sorted lists
*/
private function
merge_all : (('a, 'a) => bool, list(list('a))) => list('a)
merge_all(_, [part]) = part
merge_all(lt, parts) = merge_all(lt, merge_pairs(lt, parts))
/** Single round of `merge_all` pairs of lists in a list of list
*/
private function
merge_pairs : (('a, 'a) => bool, list(list('a))) => list(list('a))
merge_pairs(lt, x::y::rest) = merge(lt, x, y) :: merge_pairs(lt, rest)
merge_pairs(_, l) = l
// TODO: Improve?
function sort(lesser_cmp : ('a, 'a) => bool, l : list('a)) : list('a) = switch(l)
[] => []
h::t => switch (partition((x) => lesser_cmp(x, h), t))
(lesser, bigger) => sort(lesser_cmp, lesser) ++ h::sort(lesser_cmp, bigger)
/** Puts `delim` between every two members of the list
*/
+30 -9
View File
@@ -1557,6 +1557,15 @@ free_vars(L) when is_list(L) ->
[V || Elem <- L,
V <- free_vars(Elem)].
next_count() ->
V = case get(counter) of
undefined ->
0;
X -> X
end,
put(counter, V + 1),
V.
%% Clean up all the ets tables (in case of an exception)
ets_tables() ->
@@ -1602,6 +1611,18 @@ ets_tab2list(Name) ->
TabId = ets_tabid(Name),
ets:tab2list(TabId).
ets_insert_ordered(_, []) -> true;
ets_insert_ordered(Name, [H|T]) ->
ets_insert_ordered(Name, H),
ets_insert_ordered(Name, T);
ets_insert_ordered(Name, Object) ->
Count = next_count(),
TabId = ets_tabid(Name),
ets:insert(TabId, {Count, Object}).
ets_tab2list_ordered(Name) ->
[E || {_, E} <- ets_tab2list(Name)].
%% Options
create_options(Options) ->
@@ -1637,17 +1658,17 @@ destroy_and_report_unsolved_constraints(Env) ->
%% -- Named argument constraints --
create_named_argument_constraints() ->
ets_new(named_argument_constraints, [bag]).
ets_new(named_argument_constraints, [ordered_set]).
destroy_named_argument_constraints() ->
ets_delete(named_argument_constraints).
get_named_argument_constraints() ->
ets_tab2list(named_argument_constraints).
ets_tab2list_ordered(named_argument_constraints).
-spec add_named_argument_constraint(named_argument_constraint()) -> ok.
add_named_argument_constraint(Constraint) ->
ets_insert(named_argument_constraints, Constraint),
ets_insert_ordered(named_argument_constraints, Constraint),
ok.
solve_named_argument_constraints(Env) ->
@@ -1686,14 +1707,14 @@ destroy_and_report_unsolved_named_argument_constraints(Env) ->
| {add_bytes, aeso_syntax:ann(), concat | split, utype(), utype(), utype()}.
create_bytes_constraints() ->
ets_new(bytes_constraints, [bag]).
ets_new(bytes_constraints, [ordered_set]).
get_bytes_constraints() ->
ets_tab2list(bytes_constraints).
ets_tab2list_ordered(bytes_constraints).
-spec add_bytes_constraint(byte_constraint()) -> true.
add_bytes_constraint(Constraint) ->
ets_insert(bytes_constraints, Constraint).
ets_insert_ordered(bytes_constraints, Constraint).
solve_bytes_constraints(Env) ->
[ solve_bytes_constraint(Env, C) || C <- get_bytes_constraints() ],
@@ -1747,18 +1768,18 @@ check_bytes_constraint(Env, {add_bytes, Ann, Fun, A0, B0, C0}) ->
create_field_constraints() ->
%% A relation from uvars to constraints
ets_new(field_constraints, [bag]).
ets_new(field_constraints, [ordered_set]).
destroy_field_constraints() ->
ets_delete(field_constraints).
-spec constrain([field_constraint()]) -> true.
constrain(FieldConstraints) ->
ets_insert(field_constraints, FieldConstraints).
ets_insert_ordered(field_constraints, FieldConstraints).
-spec get_field_constraints() -> [field_constraint()].
get_field_constraints() ->
ets_tab2list(field_constraints).
ets_tab2list_ordered(field_constraints).
solve_field_constraints(Env) ->
FieldCs =