## vector.pkg
# Compiled by:
# src/lib/std/src/standard-core.sublib### "Hunger is the handmaid of genius."
###
### -- Mark Twain,
### "Following the Equator"
stipulate
package ig = int_guts; # int_guts is from src/lib/std/src/int-guts.pkg package it = inline_t; # inline_t is from src/lib/core/init/built-in.pkg package rt = runtime; # runtime is from src/lib/core/init/runtime.pkg package g2d = exceptions_guts; # exceptions_guts is from src/lib/std/src/exceptions-guts.pkgherein
package vector
: (weak) Vector # Vector is from src/lib/std/src/vector.api {
# my (op +) = it::default_int::(+)
# my (op <) = it::default_int::(<)
# my (op >=) = it::default_int::(>=)
# Fast add/subtract avoiding
# the overflow test:
#
infix my --- +++ ;
fun x --- y = it::tu::copyt_tagged_int (it::tu::copyf_tagged_int x - it::tu::copyf_tagged_int y);
fun x +++ y = it::tu::copyt_tagged_int (it::tu::copyf_tagged_int x + it::tu::copyf_tagged_int y);
Vector(X) = Vector(X);
maximum_vector_length = core::maximum_vector_length;
fun check_len n
=
if (it::default_int::ltu (maximum_vector_length, n))
#
raise exception g2d::SIZE;
fi;
fun from_list l
=
{ # No list can be longer than
# what is representable as Int:
#
fun len ([], n) => n;
len ([_], n) => n +++ 1;
len (_ ! _ ! r, n) => len (r, n +++ 2);
end;
n = len (l, 0);
check_len n;
if (n == 0) rt::zero_length_vector__global;
else rt::asm::make_typeagnostic_ro_vector (n, l);
fi;
};
fun from_fn (0, _)
=>
rt::zero_length_vector__global;
from_fn (n, f)
=>
{ fun tab i
=
if (i == n)
[];
else f i ! tab (i+++1);
fi;
check_len n;
rt::asm::make_typeagnostic_ro_vector (n, tab 0);
};
end;
length = it::poly_vector::length : Vector(X) -> Int;
# Note: The (_[]) enables 'vec[index]' notation;
# The (_[]:=) enables 'vec[index] := value' notation;
get = it::poly_vector::get_with_boundscheck : (Vector(X), Int) -> X;
(_[]) = it::poly_vector::get_with_boundscheck : (Vector(X), Int) -> X;
unsafe_get = it::poly_vector::get;
# A utility function
fun reverse ([], l) => l;
reverse (x ! r, l) => reverse (r, x ! l);
end;
# fun extract (v, base, optLen) = let
# len = length v
# fun newVec n = let
# fun tab (-1, l) = rt::asm::make_vector (n, l)
# | tab (i, l) = tab (i - 1, it::poly_vector::get (v, base+i) ! l)
# in
# tab (n - 1, [])
# end
# in
# case (base, optLen)
# of (0, NULL) => v
# | (_, THE 0) => if ((base < 0) or (len < base))
# then raise exception exceptions::INDEX_OUT_OF_BOUNDS
# else rt::zero_length_vector__global
# | (_, NULL) => if ((base < 0) or (len < base))
# then raise exception exceptions::INDEX_OUT_OF_BOUNDS
# else if (len == base)
# then rt::zero_length_vector__global
# else newVec (len - base)
# | (_, THE n) =>
# if ((base < 0) or (n < 0) or (len < (base+n)))
# then raise exception exceptions::INDEX_OUT_OF_BOUNDS
# else newVec n
# # end case
# end
fun cat [v] => v;
#
cat vl
=>
{ # Get the total length and flatten the list:
#
fun len ([], n, l)
=>
{ check_len n;
(n, reverse (l, []));
};
len (v ! r, n, l)
=>
{ n' = it::poly_vector::length v;
#
fun explode (i, l)
=
if (i < n') explode (i+++1, unsafe_get (v, i) ! l);
else l;
fi;
len (r, n +++ n', explode (0, l));
};
end;
case (len (vl, 0, []))
#
(0, _) => rt::zero_length_vector__global;
(n, l) => rt::asm::make_typeagnostic_ro_vector (n, l);
esac;
};
end;
fun keyed_apply f vec
=
apply 0
where
len = length vec;
fun apply i
=
if (i < len)
#
f (i, unsafe_get (vec, i));
apply (i +++ 1);
fi;
end;
fun apply f vec
=
apply 0
where
len = length vec;
fun apply i
=
if (i < len)
#
f (unsafe_get (vec, i));
apply (i +++ 1);
fi;
end;
fun keyed_map f vec
=
{ len = length vec;
fun mapf (i, l)
=
if (i < len) mapf (i +++ 1, f (i, unsafe_get (vec, i)) ! l);
else rt::asm::make_typeagnostic_ro_vector (len, reverse (l, []));
fi;
if (len > 0) mapf (0, []);
else rt::zero_length_vector__global;
fi;
};
fun map f vec
=
{ len = length vec;
fun mapf (i, l)
=
if (i < len) mapf (i+1, f (unsafe_get (vec, i)) ! l);
else rt::asm::make_typeagnostic_ro_vector (len, reverse (l, []));
fi;
if (len > 0) mapf (0, []);
else rt::zero_length_vector__global;
fi;
};
fun set (v, i, x)
=
keyed_map
(\\ (i', x') = i == i' ?? x :: x')
v;
(_[]:=) = set;
fun keyed_fold_forward f init vec
=
fold (0, init)
where
len = length vec;
fun fold (i, a)
=
if (i >= len) a;
else fold (i +++ 1, f (i, unsafe_get (vec, i), a));
fi;
end;
fun fold_forward f init vec
=
fold (0, init)
where
len = length vec;
fun fold (i, a)
=
if (i >= len) a;
else fold (i +++ 1, f (unsafe_get (vec, i), a));
fi;
end;
fun keyed_fold_backward f init vec
=
fold (length vec --- 1, init)
where
fun fold (i, a)
=
if (i < 0) a;
else fold (i --- 1, f (i, unsafe_get (vec, i), a));
fi;
end;
fun fold_backward f init vec
=
fold (length vec --- 1, init)
where
fun fold (i, a)
=
if (i < 0) a;
else fold (i --- 1, f (unsafe_get (vec, i), a));
fi;
end;
fun keyed_find p vec
=
fnd 0
where
len = length vec;
fun fnd i
=
if (i >= len)
#
NULL;
else
x = unsafe_get (vec, i);
if (p (i, x)) THE (i, x);
else fnd (i +++ 1);
fi;
fi;
end;
fun find p vec
=
fnd 0
where
len = length vec;
fun fnd i
=
if (i >= len)
#
NULL;
else
x = unsafe_get (vec, i);
#
if (p x) THE x;
else fnd (i +++ 1);
fi;
fi;
end;
fun exists p vec
=
ex 0
where
len = length vec;
fun ex i
=
i < len
and
( p (unsafe_get (vec, i))
or
ex (i +++ 1)
);
end;
fun all p vec
=
al 0
where
len = length vec;
fun al i
=
i >= len
or
( p (unsafe_get (vec, i))
and
al (i +++ 1)
);
end;
fun compare_sequences c (v1, v2)
=
col 0
where
l1 = length v1;
l2 = length v2;
l12 = it::ti::min (l1, l2); # "ti" == "tagged_int".
fun col i
=
if (i >= l12)
#
ig::compare (l1, l2);
else
case (c (unsafe_get (v1, i), unsafe_get (v2, i)))
#
EQUAL => col (i +++ 1);
unequal => unequal;
esac;
fi;
end;
}; # package vector
end;