# unparse-chunk.pkg
# Compiled by:
# src/lib/compiler/core.sublib# We get invoked only from
#
# src/lib/compiler/src/print/unparse-interactive-deep-syntax-declaration.pkgapi Unparse_Chunk {
#
Chunk;
#
unparse_chunk: symbolmapstack::Symbolmapstack
-> prettyprint::Stream
-> (Chunk, types::Type, Int)
-> Void;
debugging: Ref( Bool );
};
stipulate
package bt = type_types; # type_types is from src/lib/compiler/front/typer/types/type-types.pkg package f8b = eight_byte_float; # eight_byte_float is from src/lib/std/eight-byte-float.pkg package fx = fixity; # fixity is from src/lib/compiler/front/basics/map/fixity.pkg package pp = prettyprint; # prettyprint is from src/lib/prettyprint/big/src/prettyprint.pkg package ty = types; # types is from src/lib/compiler/front/typer-stuff/types/types.pkg package tu = type_junk; # type_junk is from src/lib/compiler/front/typer-stuff/types/type-junk.pkg package uc = unsafe::unsafe_chunk; # unsafe is from src/lib/std/src/unsafe/unsafe.pkg package us = unparse_junk; # unparse_junk is from src/lib/compiler/front/typer/print/unparse-junk.pkg package ve = vector; # vector is from src/lib/std/src/vector.pkg package vh = varhome; # varhome is from src/lib/compiler/front/typer-stuff/basics/varhome.pkg #
include prettyprint;
include unparse_junk;
#
herein
package unparse_chunk
: (weak) Unparse_Chunk # Unparse_Chunk is from src/lib/compiler/src/print/unparse-chunk.pkg {
# Debugging:
#
say = global_controls::print::say;
debugging = REF FALSE;
fun if_debugging_say (msg: String)
=
if *debugging
#
say msg;
say "\n";
fi;
fun bug msg
=
error_message::impossible("PrettyprintChunk: " + msg);
Chunk = uc::Chunk;
fun gettag chunk
=
uc::to_int (uc::nth (chunk, 0));
exception SWITCH;
fun switch (chunk, dcons)
=
try dcons
where
fun check (f, tag: Int)
=
f chunk == tag
except
uc::REPRESENTATION = FALSE;
fun try ((d as { name, form, domain } ) ! r)
=>
case form
#
vh::TAGGED i => if (check (gettag, i) ) d; else try r;fi;
vh::CONSTANT i => if (check (uc::to_int, i) ) d; else try r;fi;
vh::TRANSPARENT => d;
vh::UNTAGGED => if (uc::boxed chunk ) d; else try r; fi;
vh::REFCELL_REP => d;
vh::LISTCONS => if (uc::boxed chunk ) d; else try r; fi;
vh::LISTNIL => if (check (uc::to_int, 0) ) d; else try r;fi;
vh::SUSPENSION _ => d; /* LAZY */
_ => bug "switch: funny Constructor";
esac;
try []
=>
bug "switch: none of the valcons matched";
end;
end;
# A temporary hack for printing UNTAGGEDREC chunks:
#
fun is_rec_type (ty::TYPE_VARIABLE_REF { id, ref_typevar => REF (ty::RESOLVED_TYPE_VARIABLE t) } )
=>
is_rec_type t;
is_rec_type (ty::TYPCON_TYPE (ty::RECORD_TYP _, _ ! _))
=>
TRUE;
is_rec_type _
=>
FALSE;
end;
fun is_ubx_type (ty::TYPE_VARIABLE_REF { id, ref_typevar => REF (ty::RESOLVED_TYPE_VARIABLE t) } )
=>
is_ubx_type t;
is_ubx_type (ty::TYPCON_TYPE (tc as ty::PLAIN_TYP _, []))
=>
(tu::typs_are_equal (tc, bt::int1_typ)) or
(tu::typs_are_equal (tc, bt::unt1_typ));
is_ubx_type _ => FALSE;
end;
fun decon (chunk, { form, name, domain } )
=
case form
#
vh::UNTAGGED
=>
case domain
#
THE t
=>
if (is_rec_type t or is_ubx_type t)
#
chunk;
else
uc::nth (chunk, 0)
except
e = raise exception e;
fi;
_ => bug "decon -- unexpected Valcon_Form-domain";
esac;
vh::TAGGED _ => (uc::nth (chunk, 1) except e => raise exception e; end );
/* vh::TAGGEDREC _ =>
{ # skip first element, i.e. discard tag
a = tuple chunk;
fun f i = if (i < ve::length a) ve::sub (a, i) ! f (i+1);
else [];
fi;
u::cast (ve::from_list (f (1)));
}
*/
vh::CONSTANT _ => uc::to_chunk ();
vh::TRANSPARENT => chunk;
vh::REFCELL_REP => *(uc::to_ref chunk);
vh::EXCEPTION _ => (uc::nth (chunk, 0) except e = raise exception e);
vh::LISTCONS => chunk;
vh::LISTNIL => bug "decon - constant Constructor in decon";
vh::SUSPENSION _ => chunk;
esac;
noparen = fx::INFIX (0, 0);
stipulate
fun dcons_of ( ty::PLAIN_TYP {
kind => ty::DATATYPE {
family => { members => #[ { constructor_list, ... } ],
...
},
...
},
...
}
)
=>
constructor_list;
dcons_of _
=>
bug "(u)listDcons";
end;
herein
list_dcons = dcons_of bt::list_typ;
ulist_dcons = dcons_of bt::ulist_typ;
end;
stipulate
# Counter to generate identifier:
cpt = REF 0;
# Test membership in an association
# list and return second element.
#
fun mem (a: Ref( Void ))
=
{ fun m [] => NULL;
m ((x, r) ! l) => if (a == x ) THE r;
else m l; fi;
end;
m;
};
# Check if a chunk has been seen and if
# so return its identification number,
# creating a new one if necessary:
#
fun is_seen chunk l
=
{ chunk' = unsafe::cast chunk: Ref( Void );
case (mem chunk' l)
#
NULL => (FALSE, 0);
#
THE (r as REF NULL)
=>
{ id = *cpt;
cpt := id+1;
r := THE id;
(TRUE, id);
};
#
THE (REF (THE id))
=>
(TRUE, id);
esac;
};
herein
# Reset the identifier counter:
#
fun init_cpt ()
=
cpt := 0;
# Print with sharing if necessary.
# The "printer" already knows the ppstream.
#
fun print_with_sharing stream (chunk, accu, printer)
=
if *global_controls::print::print_loop
#
(is_seen chunk accu)
->
(seen, nb);
if seen
#
pp::string stream "%";
pp::string stream (int::to_string nb);
else
modif = REF NULL;
nl_accu = (unsafe::cast chunk: Ref( Void ), modif) ! accu;
printer (chunk, nl_accu);
case *modif
#
NULL => ();
#
THE i
=>
{ pp::string stream " as %";
pp::string stream (int::to_string i);
};
esac;
fi;
else
printer (chunk, accu);
fi;
end; # stipulate
fun interp_args (tys, NULL)
=>
tys;
interp_args (tys, THE (members, free_typs))
=>
map subst tys
where
fun subst (ty::TYPCON_TYPE (ty::RECURSIVE_TYPE n, args))
=>
{ typ'
=
list::nth (members, n)
except
(SUBSCRIPT|INDEX_OUT_OF_BOUNDS) = bug "interpArgs 1";
ty::TYPCON_TYPE (typ', map subst args);
};
subst (ty::TYPCON_TYPE (ty::FREE_TYPE n, args))
=>
{ typ'
=
list::nth (free_typs, n)
except
(SUBSCRIPT|INDEX_OUT_OF_BOUNDS) = bug "interpArgs 2";
ty::TYPCON_TYPE (typ', map subst args);
};
subst (ty::TYPCON_TYPE (typ, args))
=>
ty::TYPCON_TYPE (typ, map subst args);
subst (ty::TYPE_VARIABLE_REF { id, ref_typevar => REF (ty::RESOLVED_TYPE_VARIABLE type) } )
=>
subst type;
subst type
=>
type;
end;
end;
end;
fun trans_members
(
stamps: Vector( stamp::Stamp ),
free_typs: List( ty::Typ ),
root,
family as { members, ... }: ty::Datatype_Family
)
=
{ fun dtmember_to_typ
(
n,
{ typ_name,
arity,
constructor_list,
eqtype_info,
an_api,
is_lazy
},
l
)
=
ty::PLAIN_TYP
{
stub => NULL,
stamp => vector::get (stamps, n),
arity,
eqtype_info => REF (ty::eq_type::YES),
path => inverse_path::INVERSE_PATH [ typ_name ],
kind => ty::DATATYPE
{
index => n,
stamps,
root,
family,
free_typs
}
} ! l;
(vector::keyed_fold_backward dtmember_to_typ NIL members, free_typs);
};
# main function:
# unparse_chunk
# :
# Symbolmapstack
# -> ppstream
# -> (Chunk, Type, Int)
# -> Void
#
fun unparse_chunk symbolmapstack stream
=
unparse_value
where
fun unparse_value (chunk: Chunk, type: ty::Type, depth: Int) : Void
=
unparse_val' (chunk, type, NULL, depth, noparen, noparen, [])
also
fun unparse_val_share ( chunk: Chunk,
type: ty::Type,
members_op: Null_Or( ( List( ty::Typ ),
List( ty::Typ )
)
),
depth: Int,
accu
)
=
unparse_val' (chunk, type, members_op, depth, noparen, noparen, accu)
also
fun unparse_val' (_, _, _, 0, _, _, _)
=>
pp::string stream "#";
unparse_val' (chunk: Chunk, type: ty::Type, members_op: Null_Or( (List( ty::Typ ), List( ty::Typ )) ),
depth: Int, l: fx::Fixity, r: fx::Fixity, accu) : Void
=>
case type
#
ty::TYPE_VARIABLE_REF { id, ref_typevar => REF (ty::RESOLVED_TYPE_VARIABLE t) }
=>
unparse_val'(chunk, t, members_op, depth, r, l, accu);
ty::TYPE_SCHEME_TYPE { type_scheme=>ty::TYPE_SCHEME { body, arity }, ... }
=>
if (arity == 0)
unparse_val'(chunk, body, members_op, depth, l, r, accu);
else
args = uc::make_tuple (list::from_fn (arity, fn i => uc::to_chunk 0; end ));
my tchunk: Chunk -> Chunk = unsafe::cast chunk;
result = tchunk args;
unparse_val'(result, body, members_op, depth, l, r, accu);
fi;
ty::TYPCON_TYPE (typ as ty::PLAIN_TYP { kind, stamp, eqtype_info, ... }, argtys)
=>
case (kind, *eqtype_info)
#
(ty::BASE _, _)
=>
{ fun unparse_word s
=
pp::string stream ("0wx" + s);
if (tu::typs_are_equal (typ, bt::int_typ)) pp::string stream (int::to_string (uc::to_int chunk));
elif (tu::typs_are_equal (typ, bt::int1_typ)) pp::string stream (one_word_int::to_string (uc::to_int1 chunk));
elif (tu::typs_are_equal (typ, bt::multiword_int_typ)) us::unparse_integer stream (unsafe::cast chunk);
elif (tu::typs_are_equal (typ, bt::unt_typ)) unparse_word (unt::to_string (uc::to_unt chunk));
elif (tu::typs_are_equal (typ, bt::unt8_typ)) unparse_word (one_byte_unt::to_string (uc::to_unt8 chunk));
elif (tu::typs_are_equal (typ, bt::unt1_typ)) unparse_word (one_word_unt::to_string (uc::to_unt1 chunk));
elif (tu::typs_are_equal (typ, bt::float64_typ)) pp::string stream (f8b::to_string (uc::to_float chunk));
elif (tu::typs_are_equal (typ, bt::string_typ)) us::unparse_mlstring stream (uc::to_string chunk);
elif (tu::typs_are_equal (typ, bt::char_typ)) us::unparse_mlstring' stream (string::from_char (char::from_int (uc::to_int chunk)));
elif (tu::typs_are_equal (typ, bt::arrow_typ)) pp::string stream "fn";
elif (tu::typs_are_equal (typ, bt::exception_typ)) { name = exceptions::exception_name (uc::to_exn chunk);
pp::string stream name;
pp::string stream "(-)";
};
elif (tu::typs_are_equal (typ, bt::fate_typ)) pp::string stream "fate";
elif (tu::typs_are_equal (typ, bt::vector_typ))
#
unparse_vector (uc::to_vector chunk, head argtys, members_op, depth, *global_controls::print::print_length, accu)
except
uc::REPRESENTATION = pp::string stream "prim?";
elif (tu::typs_are_equal (typ, bt::rw_vector_typ))
( print_with_sharing stream
( chunk,
accu,
fn (chunk, accu)
=>
case (uc::rep chunk)
#
uc::TYPEAGNOSTIC_RW_VECTOR
=>
unparse_array (uc::to_rw_vector chunk, head argtys, members_op, depth, *global_controls::print::print_length, accu);
uc::FLOAT64_RW_VECTOR
=>
unparse_real_array (uc::to_float64_rw_vector chunk, *global_controls::print::print_length);
_ => bug "rw_vector (neither Float nor Poly)";
esac; end
)
except
uc::REPRESENTATION
=
pp::string stream "prim?"
);
else pp::string stream "prim?";
fi;
};
(ty::DATATYPE _, ty::eq_type::EQ_ABSTRACT)
=>
unparse_table::pp_chunk stream stamp chunk
except
pp_not_installed = pp::string stream "-";
(ty::DATATYPE { index, stamps,
family as { members, ... }, free_typs, root }, _)
=>
if (tu::typs_are_equal (typ, bt::ulist_typ))
#
unparse_ur_list
(
chunk, head argtys, members_op, depth, *global_controls::print::print_length, accu
);
elif (tu::typs_are_equal (typ, bt::susp_typ) )
#
pp::string stream "@@"; # LAZY
elif (tu::typs_are_equal (typ, bt::list_typ) )
#
unparse_list
(
chunk, head argtys, members_op, depth, *global_controls::print::print_length, accu
);
elif (tu::typs_are_equal (typ, bt::ref_typ) )
#
(print_with_sharing stream
(chunk, accu,
{ argtys' = interp_args (argtys, members_op);
fn (chunk, accu) =>
unparse_dcon (chunk,
(vector::get (stamps, index),
vector::get (members, index)),
THE([bt::ref_typ],[]), argtys',
depth, l, r, accu); end ;
}));
else
argtys' = interp_args (argtys, members_op);
unparse_dcon (chunk, (vector::get (stamps, index),
vector::get (members, index)),
THE (trans_members (stamps, free_typs,
root, family)),
argtys', depth, l, r, accu);
fi;
(ty::ABSTRACT _, _)
=>
if (tu::typs_are_equal (typ, bt::int2_typ))
#
# # inline_t is from src/lib/core/init/built-in.pkg case (uc::to_tuple chunk)
#
[hi, lo]
=>
{ i = inline_t::i2::intern (uc::to_unt1 hi, uc::to_unt1 lo); # "i2" == "two-word int" (64-bits on 32-bit architectures, 128-bits on 64-bit architectures.)
#
pp::string stream (two_word_int::to_string i);
};
_ => pp::string stream "<two_word_int?>";
esac;
elif (tu::typs_are_equal (typ, bt::unt2_typ) )
case (uc::to_tuple chunk)
#
[hi, lo]
=>
{ w = inline_t::u2::intern (uc::to_unt1 hi, uc::to_unt1 lo);
#
pp::string stream ("0wx" + two_word_unt::to_string w);
};
_ => pp::string stream "<word64?>";
esac;
else
pp::string stream "-";
fi;
_ => pp::string stream "-";
esac;
ty::TYPCON_TYPE (typ as ty::RECORD_TYP [], _)
=>
pp::string stream "()";
ty::TYPCON_TYPE (typ as ty::RECORD_TYP labels, argtys)
=>
if (tuples::is_tuple_typ typ)
#
unparse_tuple (uc::to_tuple chunk, argtys, members_op, depth, accu);
else unparse_record (uc::to_tuple chunk, labels, argtys, members_op, depth, accu);
fi;
ty::TYPCON_TYPE (typ as ty::DEFINED_TYP _, _)
=>
unparse_val'(chunk, tu::reduce_type type, members_op, depth, l, r, accu);
ty::TYPCON_TYPE (typ as ty::RECURSIVE_TYPE i, argtys)
=>
case members_op
#
THE (member_typs, _)
=>
{ typ'
=
list::nth (member_typs, i)
except
(SUBSCRIPT|INDEX_OUT_OF_BOUNDS)
=
{ flush_stream stream;
print "#prettyprintVal': ";
print (int::to_string i);
print " "; print (int::to_string (length member_typs));
print "\n";
bug "prettyprintVal': bad index for RECURSIVE_TYPE";
};
case typ'
#
ty::PLAIN_TYP
{ kind => ty::DATATYPE
{ index,
stamps,
family => { members, ... },
...
},
...
}
=>
unparse_dcon (chunk, (vector::get (stamps, index),
vector::get (members, index)),
members_op, argtys,
depth, l, r, accu);
#
_ => bug "prettyprintVal': bad typ in members";
esac;
};
NULL => bug "prettyprintVal': RECURSIVE_TYPE with no members";
esac;
ty::TYPCON_TYPE (typ as ty::FREE_TYPE i, argtys)
=>
case members_op
#
THE (_, free_typs)
=>
{ typ'
=
list::nth (free_typs, i)
except
(SUBSCRIPT|INDEX_OUT_OF_BOUNDS)
=
{ flush_stream stream;
print "#prettyprintVal': ";
print (int::to_string i);
print " ";
print (int::to_string (length free_typs));
print "\n";
bug "prettyprintVal': bad index for FREE_TYPE";
};
unparse_val'
(
chunk,
ty::TYPCON_TYPE (typ', argtys),
members_op,
depth,
l,
r,
accu
);
};
NULL => bug "prettyprintVal': RECURSIVE_TYPE with no members";
esac;
_ => pp::string stream "-";
esac
except e = raise exception e;
end
also
fun unparse_dcon (_, _, _, _, 0, _, _, _)
=>
pp::string stream "#";
unparse_dcon ( chunk: Chunk,
( stamp,
{ typ_name,
constructor_list,
...
}
),
members_op: Null_Or( (List( ty::Typ ), List( ty::Typ )) ),
argtys,
depth: Int,
l: fx::Fixity,
r: fx::Fixity,
accu
)
=>
unparse_table::pp_chunk stream stamp chunk
# Attempt to find and apply user-defined prettyprint on chunk
except
pp_not_installed
=
if (length constructor_list == 0)
#
pp::string stream "-";
else
my dcon as { name, domain, ... }
=
switch (chunk, constructor_list);
dname = symbol::name name;
case domain
#
NULL => pp::string stream dname;
#
THE dom
=>
{ fixity
=
find_in_symbolmapstack::find_fixity_by_symbol
( symbolmapstack,
symbol::make_fixity_symbol dname
);
# (??) may be inaccurate XXX BUGGO FIXME
dom = tu::apply_type_scheme (ty::TYPE_SCHEME { arity=>length argtys, body=>dom },
argtys);
dom = tu::head_reduce_type dom; # unnecessary
fun prdcon ()
=
case (fixity, dom)
#
(fx::INFIX _, ty::TYPCON_TYPE (dom_typ as ty::RECORD_TYP _, [ty_l, ty_r]))
=>
{ my (a, b)
=
case (uc::to_tuple (decon (chunk, dcon)))
#
[a, b] => (a, b);
_ => bug "prettyprintDcon [a, b]";
esac;
if (tuples::is_tuple_typ dom_typ)
#
begin_wrap_box stream;
unparse_val'(a, ty_l,
members_op,
depth - 1, fx::NONFIX, fixity, accu);
break stream { spaces=>1, indent_on_wrap=>0 };
pp::string stream dname;
break stream { spaces=>1, indent_on_wrap=>0 };
unparse_val'(b, ty_r,
members_op,
depth - 1, fixity, fx::NONFIX, accu);
end_box stream;
else
begin_indented_wrap_box stream (pp::CURSOR_RELATIVE 2);
pp::string stream dname;
break stream { spaces=>1, indent_on_wrap=>0 };
unparse_val'(decon (chunk, dcon), dom,
members_op, depth - 1,
fx::NONFIX, fx::NONFIX, accu);
end_box stream;
fi;
};
_ =>
{ begin_indented_wrap_box stream (pp::CURSOR_RELATIVE 2);
pp::string stream dname; break stream { spaces=>1, indent_on_wrap=>0 };
unparse_val'(decon (chunk, dcon), dom, members_op, depth - 1,
fx::NONFIX, fx::NONFIX, accu);
end_box stream;
};
esac;
fun prpardcon ()
=
{ begin_wrap_box stream;
pp::string stream "(";
prdcon();
pp::string stream ")";
end_box stream;
};
case (l, r, fixity)
#
(fx::NONFIX, fx::NONFIX, _) => prpardcon();
(fx::INFIX _, fx::INFIX _, _) => prdcon();
# special case: only on first iteration, for no parens
(_, _, fx::NONFIX) => prdcon();
(fx::INFIX(_, p1), _, fx::INFIX (p2, _))
=>
if (p1 >= p2) prpardcon();
else prdcon ();
fi;
(_, fx::INFIX (p1, _), fx::INFIX(_, p2))
=>
if (p1 > p2) prpardcon();
else prdcon ();
fi;
esac;
};
esac;
fi;
end
also
fun unparse_list (chunk: Chunk, type: ty::Type, members_op, depth: Int, length: Int, accu)
=
{ fun list_case p
=
case (switch (p, list_dcons))
#
{ domain=>NULL, ... }
=>
NULL;
dcon
=>
case (uc::to_tuple (decon (p, dcon)))
#
[a, b] => THE (a, b);
_ => bug "prettyprintList [a, b]";
esac;
esac;
fun unparse_tail (p, len)
=
case (list_case p)
#
NULL => ();
#
THE (hd, tl)
=>
if (len <= 0)
#
pp::string stream "...";
else
case (list_case tl)
#
NULL => unparse_val_share (hd, type, members_op, depth - 1, accu);
_ =>
{ unparse_val_share (hd, type, members_op, depth - 1, accu);
pp::string stream ", ";
break stream { spaces=>0, indent_on_wrap=>0 };
unparse_tail (tl, len - 1);
};
esac;
fi;
esac;
begin_indented_wrap_box stream (pp::CURSOR_RELATIVE 1);
pp::string stream "[";
unparse_tail (chunk, length);
pp::string stream "]";
end_box stream;
}
also
fun unparse_ur_list (chunk: Chunk, type: ty::Type, members_op, depth: Int, length: Int, accu)
=
{ fun list_case p
=
case (switch (p, ulist_dcons))
#
{ domain => NULL, ... }
=>
NULL;
dcon
=>
case (uc::to_tuple (decon (p, dcon)))
#
[a, b] => THE (a, b);
_ => bug "prettyprintUrList [a, b]";
esac;
esac;
fun unparse_tail (p, len)
=
case (list_case p)
#
NULL => ();
#
THE (hd, tl)
=>
if (len <= 0)
#
pp::string stream "...";
else
case (list_case tl)
#
NULL => unparse_val_share (hd, type, members_op, depth - 1, accu);
#
_ =>
{ unparse_val_share (hd, type, members_op, depth - 1, accu);
pp::string stream ", ";
break stream { spaces=>0, indent_on_wrap=>0 };
unparse_tail (tl, len - 1);
};
esac;
fi;
esac;
begin_indented_wrap_box stream (pp::CURSOR_RELATIVE 1);
pp::string stream "[ unrolled list ";
# prettyprintTail (chunk, length);
pp::string stream "]";
end_box stream;
}
also
fun unparse_tuple (chunks: List( Chunk ), tys: List( ty::Type ), members_op, depth: Int, accu) : Void
=
{ fun unparse_fields ([f],[type])
=>
unparse_val_share (f, type, members_op, depth - 1, accu);
unparse_fields (f ! restf, type ! restty)
=>
{ unparse_val_share (f, type, members_op, depth - 1, accu);
pp::string stream (", ");
break stream { spaces=>0, indent_on_wrap=>0 };
unparse_fields (restf, restty);
};
unparse_fields ([], [])
=>
();
unparse_fields _
=>
bug "prettyprintFields in ppval.sml";
end;
begin_indented_wrap_box stream (pp::CURSOR_RELATIVE 1);
pp::string stream ("(");
unparse_fields (chunks, tys);
pp::string stream (")");
end_box stream;
}
also
fun unparse_record (chunks: List( Chunk ), labels: List( ty::Label ),
tys: List( ty::Type ), members_op, depth: Int, accu)
=
{ fun unparse_fields ([f],[l],[type])
=>
{ begin_indented_horizontal_else_vertical_box stream (pp::CURSOR_RELATIVE 2);
pp::string stream (symbol::name l);
pp::string stream ("=");
unparse_val_share (f, type, members_op, depth - 1, accu);
end_box stream;
};
unparse_fields (f ! restf, l ! restl, type ! restty)
=>
{ begin_indented_horizontal_else_vertical_box stream (pp::CURSOR_RELATIVE 2);
pp::string stream (symbol::name l);
pp::string stream ("=");
unparse_val_share (f, type, members_op, depth - 1, accu);
end_box stream;
pp::string stream (", ");
break stream { spaces=>0, indent_on_wrap=>0 };
unparse_fields (restf, restl, restty);
};
unparse_fields([],[],[])
=>
();
unparse_fields _
=>
bug "prettyprintFields in ppval.sml";
end;
begin_indented_wrap_box stream (pp::CURSOR_RELATIVE 1);
pp::string stream ("{ ");
unparse_fields (chunks, labels, tys);
pp::string stream (" }");
end_box stream;
}
also
fun unparse_vector (chunks: Vector( Chunk ), type: ty::Type, members_op, depth: Int, length, accu)
=
{ vector_length = ve::length chunks;
my (len, closing)
=
if (length >= vector_length)
#
(vector_length, fn _ = pp::string stream "]");
else
( length,
#
fn sep = { pp::string stream sep;
pp::string stream "...]";
}
);
fi;
fun print_rest (sep, breaker, index)
=
if (index >= len)
#
closing sep;
else
pp::string stream sep; breaker ();
unparse_val_share (ve::get (chunks, index), type, members_op, depth - 1, accu);
print_rest (", ", fn () = break stream { spaces=>0, indent_on_wrap=>0 }, index + 1);
fi;
begin_indented_wrap_box stream (pp::CURSOR_RELATIVE 1);
pp::string stream "#["; print_rest("", fn () => (); end, 0);
end_box stream;
}
also
fun unparse_array (chunks: Rw_Vector( Chunk ), type: ty::Type, members_op, depth: Int, length, accu)
=
{ vector_length = rw_vector::length chunks;
my (len, closing)
=
if (length >= vector_length)
#
(vector_length, fn _ = pp::string stream "|]");
else
( length,
#
fn sep = { pp::string stream sep;
pp::string stream "...|]";
}
);
fi;
fun print_rest (sep, breaker, index)
=
if (index >= len)
#
closing sep;
else
pp::string stream sep;
breaker ();
unparse_val_share (rw_vector::get (chunks, index), type, members_op, depth - 1, accu);
print_rest (", ", fn () = break stream { spaces=>0, indent_on_wrap=>0 }, index + 1);
fi;
begin_indented_wrap_box stream (pp::CURSOR_RELATIVE 1);
pp::string stream "[|";
print_rest("", fn () = (), 0);
end_box stream;
}
also
fun unparse_real_array (chunks: rw_vector_of_eight_byte_floats::Rw_Vector, length: Int)
=
{ vector_length
=
rw_vector_of_eight_byte_floats::length chunks;
my (len, closing)
=
if (length >= vector_length)
#
( vector_length,
fn _ = pp::string stream "|]"
);
else
( length,
#
fn sep = { pp::string stream sep;
pp::string stream "...|]";
}
);
fi;
fun print_rest (sep, breaker, index)
=
if (index >= len)
#
closing sep;
else
pp::string stream sep; breaker ();
pp::string stream (f8b::to_string (rw_vector_of_eight_byte_floats::get (chunks, index)));
print_rest (", ", fn () = break stream { spaces=>0, indent_on_wrap=>0 }, index + 1);
fi;
begin_indented_wrap_box stream (pp::CURSOR_RELATIVE 1);
pp::string stream "[|";
print_rest("", fn () = (), 0);
end_box stream;
};
end; # fun unparse_chunk
}; # package unparse_chunk
end;