DLLEXPORT void jl_show_any(jl_value_t *v)
{
// fallback for printing some other builtin types
ios_t *s = jl_current_output_stream();
if (jl_is_tuple(v)) {
show_tuple((jl_tuple_t*)v, '(', ')', 1);
}
else if (jl_is_type(v)) {
show_type(v);
}
else if (jl_is_func(v)) {
show_function(v);
}
else if (jl_typeis(v,jl_intrinsic_type)) {
ios_printf(s, "#<intrinsic-function %d>", *(uint32_t*)jl_bits_data(v));
}
else {
jl_value_t *t = (jl_value_t*)jl_typeof(v);
if (jl_is_struct_type(t)) {
jl_struct_type_t *st = (jl_struct_type_t*)t;
ios_puts(st->name->name->name, s);
ios_putc('(', s);
size_t i;
size_t n = st->names->length;
for(i=0; i < n; i++) {
jl_show(nth_field(v, i));
if (i < n-1)
ios_putc(',', s);
}
ios_putc(')', s);
}
}
}
static void show_function(jl_value_t *v)
{
ios_t *s = jl_current_output_stream();
if (jl_is_gf(v)) {
ios_puts(jl_gf_name(v)->name, s);
}
else {
ios_puts("#<function>", s);
}
}
// comma_one prints a comma for 1 element, e.g. "(x,)"
static void show_tuple(jl_tuple_t *t, char opn, char cls, int comma_one)
{
ios_t *s = jl_current_output_stream();
ios_putc(opn, s);
size_t i, n=t->length;
for(i=0; i < n; i++) {
jl_show(jl_tupleref(t, i));
if ((i < n-1) || (n==1 && comma_one))
ios_putc(',', s);
}
ios_putc(cls, s);
}
void jl_show_full_function(jl_value_t *v)
{
ios_t *s = jl_current_output_stream();
if (jl_is_gf(v)) {
ios_puts("Methods for generic function ", s);
ios_puts(jl_gf_name(v)->name, s);
ios_putc('\n', s);
jl_show_method_table((jl_function_t*)v);
}
else {
show_function(v);
}
}
static void repl_show_value(jl_value_t *v)
{
if (jl_is_function(v) && !jl_is_struct_type(v)) {
// show method table when a function is shown at the top level.
jl_show_full_function(v);
return;
}
jl_show(v);
if (jl_is_struct_type(v)) {
ios_t *s = jl_current_output_stream();
// for convenience, show constructor methods when
// a type is shown at the top level.
if (jl_is_gf(v)) {
ios_putc('\n', s);
jl_show_full_function(v);
}
}
}
static void show_type(jl_value_t *t)
{
ios_t *s = jl_current_output_stream();
if (jl_is_func_type(t)) {
if (t == (jl_value_t*)jl_any_func) {
ios_puts("Function", s);
}
else {
jl_show((jl_value_t*)((jl_func_type_t*)t)->from);
ios_write(s, "-->", 3);
jl_show((jl_value_t*)((jl_func_type_t*)t)->to);
}
}
else if (t == (jl_value_t*)jl_function_type) {
ios_puts("Function", s);
}
else if (jl_is_union_type(t)) {
if (t == (jl_value_t*)jl_bottom_type) {
ios_write(s, "None", 4);
}
else if (t == jl_top_type) {
ios_write(s, "Top", 3);
}
else {
ios_write(s, "Union", 5);
show_tuple(((jl_uniontype_t*)t)->types, '(', ')', 0);
}
}
else if (jl_is_seq_type(t)) {
jl_show(jl_tparam0(t));
ios_write(s, "...", 3);
}
else if (jl_is_typector(t)) {
jl_show((jl_value_t*)((jl_typector_t*)t)->body);
}
else {
assert(jl_is_some_tag_type(t));
jl_tag_type_t *tt = (jl_tag_type_t*)t;
ios_puts(tt->name->name->name, s);
jl_tuple_t *p = tt->parameters;
if (p->length > 0)
show_tuple(p, '{', '}', 0);
}
}
static void print_obj_profile(void)
{
jl_value_t *errstream = jl_get_global(jl_base_module,
jl_symbol("stderr_stream"));
JL_TRY {
if (errstream)
jl_set_current_output_stream_obj(errstream);
ios_t *s = jl_current_output_stream();
for(int i=0; i < obj_counts.size; i+=2) {
if (obj_counts.table[i+1] != HT_NOTFOUND) {
ios_printf(s, "%d ", obj_counts.table[i+1]-1);
jl_show(obj_counts.table[i]);
ios_printf(s, "\n");
}
}
}
JL_CATCH {
}
}
value_t fl_invoke_julia_macro(value_t *args, uint32_t nargs)
{
if (nargs < 1)
argcount("invoke-julia-macro", nargs, 1);
(void)tosymbol(args[0], "invoke-julia-macro");
jl_sym_t *name = jl_symbol(symbol_name(args[0]));
jl_function_t *f = jl_get_expander(jl_current_module, name);
if (f == NULL)
return FL_F;
jl_value_t **margs;
int na = nargs-1;
if (na > 0)
margs = alloca(na * sizeof(jl_value_t*));
else
margs = NULL;
int i;
for(i=0; i < na; i++) margs[i] = NULL;
JL_GC_PUSHARGS(margs, na);
for(i=0; i < na; i++) margs[i] = scm_to_julia(args[i+1]);
jl_value_t *result;
JL_TRY {
result = jl_apply(f, margs, na);
}
JL_CATCH {
JL_GC_POP();
jl_show(jl_exception_in_transit);
ios_putc('\n', jl_current_output_stream());
return fl_cons(symbol("error"), FL_NIL);
}
// protect result from GC, otherwise it could be freed during future
// macro expansions, since it will be referenced only from scheme and
// not julia.
// all calls to invoke-julia-macro happen under a single call to jl_expand,
// so the preserved value stack is popped there.
jl_gc_preserve(result);
value_t scm = julia_to_scm(result);
JL_GC_POP();
return scm;
}
/*
warn about ambiguous method priorities
the relative priority of A and B is ambiguous if
!subtype(A,B) && !subtype(B,A) && no corresponding tuple
elements are disjoint.
for example, (AbstractArray, AbstractMatrix) and (AbstractMatrix, AbstractArray) are ambiguous.
however, (AbstractArray, AbstractMatrix, Foo) and (AbstractMatrix, AbstractArray, Bar) are fine
since Foo and Bar are disjoint, so there would be no confusion over
which one to call.
There is also this kind of ambiguity: foo{T,S}(T, S) vs. foo(Any,Any)
In this case jl_types_equal() is true, but one is jl_type_morespecific
or jl_type_match_morespecific than the other.
To check this, jl_types_equal_generic needs to be more sophisticated
so (T,T) is not equivalent to (Any,Any). (TODO)
*/
static void check_ambiguous(jl_methlist_t *ml, jl_tuple_t *type,
jl_tuple_t *sig, jl_sym_t *fname)
{
// we know !jl_args_morespecific(type, sig)
if ((type->length==sig->length ||
(type->length==sig->length+1 && is_va_tuple(type)) ||
(type->length+1==sig->length && is_va_tuple(sig))) &&
!jl_args_morespecific((jl_value_t*)sig, (jl_value_t*)type)) {
jl_value_t *isect = jl_type_intersection((jl_value_t*)type,
(jl_value_t*)sig);
if (isect == (jl_value_t*)jl_bottom_type)
return;
JL_GC_PUSH(&isect);
jl_methlist_t *l = ml;
while (l != NULL) {
if (sigs_eq(isect, (jl_value_t*)l->sig))
goto done_chk_amb; // ok, intersection is covered
l = l->next;
}
char *n = fname->name;
jl_value_t *errstream = jl_get_global(jl_system_module,
jl_symbol("stderr_stream"));
JL_TRY {
if (errstream)
jl_set_current_output_stream_obj(errstream);
ios_t *s = jl_current_output_stream();
ios_printf(s, "Warning: New definition %s", n);
jl_show((jl_value_t*)type);
ios_printf(s, " is ambiguous with %s", n);
jl_show((jl_value_t*)sig);
ios_printf(s, ".\n Make sure %s", n);
jl_show(isect);
ios_printf(s, " is defined first.\n");
}
JL_CATCH {
jl_raise(jl_exception_in_transit);
}
done_chk_amb:
JL_GC_POP();
}
DLLEXPORT
void jl_show_float(double d, int ndec)
{
ios_t *s = jl_current_output_stream();
char buf[64];
if (!DFINITE(d)) {
char *rep = isnan(d) ? "NaN" : sign_bit(d) ? "-Inf" : "Inf";
ios_puts(rep, s);
}
else if (d == 0) {
if (1/d < 0)
ios_puts("-0.0", s);
else
ios_puts("0.0", s);
}
else {
snprint_real(buf, sizeof(buf), d, 0, ndec, 3, 10);
int hasdec = (strpbrk(buf, ".eE") != NULL);
ios_puts(buf, s);
if (!hasdec) ios_puts(".0", s);
}
}
// for bootstrap
DLLEXPORT void jl_print_int64(int64_t i)
{
ios_t *s = jl_current_output_stream();
ios_printf(s, "%lld", i);
}
DLLEXPORT void jl_print_symbol(jl_sym_t *sym)
{
ios_puts(sym->name, jl_current_output_stream());
}
DLLEXPORT void jl_print_array_uint8(jl_array_t *b)
{
ios_write(jl_current_output_stream(), (char*)b->data, b->length);
}
