## pp-lib.pkg
#
# For the standard system prettyprinter stuff see
#
# src/lib/prettyprint/big/src/standard-prettyprinter.pkg# Compiled by:
# src/lib/c-kit/src/ast/ast.sublibstipulate
package f8b = eight_byte_float; # eight_byte_float is from src/lib/std/eight-byte-float.pkg package fil = file__premicrothread; # file__premicrothread is from src/lib/std/src/posix/file--premicrothread.pkgherein
package prettyprint_lib {
#
package pp= old_prettyprinter; # old_prettyprinter is from src/lib/prettyprint/big/src/old-prettyprinter.pkg Prettyprint(X) = pp::Ppstream -> X -> Void;
exception PRETTYPRINT_EXCEPTION String;
suppress_pid_underscores = REF TRUE;
suppress_pid_global_underscores = REF TRUE;
#
# Usually want to do this to preserve linkability.
suppress_tid_underscores = REF TRUE;
#
# These flags are set to TRUE temporarily during parsing to make error messages
# more readable, and are then resored to their original values. See
# parse-to-ast.pkg.
fun warning f msg
=
{ print f;
print ":";
print msg;
};
fun prettyprint_to_strm prettyprint stream v
=
{ pps = pp::make_ppstream { consumer => (\\ s = fil::write (stream, s)),
flush => (\\ () = fil::flush (stream)),
close => (\\ () = ())
};
prettyprint pps v;
pp::flush_ppstream pps;
};
fun prettyprint_to_string prettyprint
=
pp::prettyprint_to_string prettyprint;
add_string = pp::add_string;
newline = pp::add_newline;
b_block = pp::begin_block;
e_block = pp::end_block;
fun prettyprint_int pps i
=
if (i >= 0)
add_string pps (int::to_string i);
else
add_string pps "-";
add_string pps (int::to_string (-i));
fi;
fun prettyprint_int1 pps i
=
if (i >= 0)
add_string pps (one_word_int::to_string i);
else
add_string pps "-";
add_string pps (one_word_int::to_string -i);
fi;
fun prettyprint_li pps i
=
if (i >= 0)
add_string pps (large_int::to_string i);
else
add_string pps "-";
add_string pps (large_int::to_string -i);
fi;
fun prettyprint_real pps r
=
add_string pps (f8b::to_string r);
fun prettyprint_string pps s
=
{ add_string pps "\"";
add_string pps (string::to_cstring s);
add_string pps "\"";
};
fun separate (prettyprint, sep) pps []
=>
();
separate (prettyprint, sep) pps [x]
=>
prettyprint pps x;
separate (prettyprint, sep) pps (x ! xs)
=>
{ prettyprint pps x;
sep pps;
separate (prettyprint, sep) pps xs;
};
end;
fun prettyprint_list { prettyprint, sep, l_delim, r_delim } pps items
=
{ add_string pps l_delim;
separate (prettyprint, \\ pps = add_string pps sep) pps items;
add_string pps r_delim;
};
fun space pps
=
add_string pps " ";
fun spaces pps 0 => ();
spaces pps n => { space pps; spaces pps (n - 1); };
end;
fun blockify n prettyprint pps v
=
{ newline pps;
b_block pps pp::INCONSISTENT n;
spaces pps n;
prettyprint pps v;
e_block pps;
};
fun prettyprint_opt prettyprint pps (THE x) => prettyprint pps x;
prettyprint_opt prettyprint pps (NULL ) => ();
end;
fun prettyprint_sp prettyprint pps v
=
{ space pps;
prettyprint pps v;
};
fun prettyprint_sp_opt prettyprint pps opt
=
prettyprint_opt (prettyprint_sp prettyprint) pps opt;
fun prettyprint_guarded s bool pps
=
if bool add_string pps s; fi;
/*
fun prettyprintPid (pidtab: Tables::pidtab, _) pps pid =
let fun prettyprintSymbolQuietly symbol = add_string pps (symbol::name symbol)
fun prettyprintSymbolVerbose symbol = ( add_string pps (symbol::name symbol)
; add_string pps "_"
; add_string pps (Pid::to_string pid)
)
prettyprint_symbol = if *suppressPidUnderscores then prettyprintSymbolQuietly
else prettyprintSymbolVerbose
in case Pidtab::find (pidtab, pid)
of THE { symbol, kind, ... } =>
(case kind
of (info::FIELDp _ |
info::VARIABLEp { stIlk=THE raw_syntax::EXTERN, ... } |
info::VARIABLEp { global=TRUE, ... } ) =>
add_string pps (symbol2string symbol)
| info::VARIABLEp { global=FALSE, ... } => prettyprint_symbol symbol
| info::LABEL => prettyprint_symbol symbol
| info::TYPEDEFp _ => prettyprint_symbol symbol
| info::TAGp _ => prettyprint_symbol symbol)
| _ => add_string pps (Pid::to_string pid)
end
*/
fun prettyprint_symbol' pps symbol
=
add_string pps (symbol::name symbol);
fun prettyprint_symbol pps (symbol: symbol::Symbol, uid: pid::Uid)
=
{ add_string pps (symbol::name symbol);
if (not *suppress_pid_underscores)
add_string pps "_";
add_string pps (pid::to_string uid);
fi;
};
fun prettyprint_id pps ( { name, uid, kind, st_ilk, global, ... }: raw_syntax::Id)
=
case (st_ilk, global)
((raw_syntax::EXTERN, _) | (_, TRUE)) # globals
=>
if *suppress_pid_global_underscores
prettyprint_symbol' pps name;
else
prettyprint_symbol pps (name, uid);
fi;
_ =>
prettyprint_symbol pps (name, uid);
esac;
#
# No uids printed for globals to preserve linkability.
fun prettyprint_label pps ( { name, uid, ... }: raw_syntax::Label)
=
prettyprint_symbol pps (name, uid);
fun prettyprint_member pps ( { name, ... }: raw_syntax::Member)
=
prettyprint_symbol' pps name;
fun prettyprint_tid (tidtab: tables::Tidtab) pps tid
=
case (tidtab::find (tidtab, tid))
THE { name=>NULL, ... }
=>
add_string pps (tid::to_string tid);
THE { name=>THE id, ... }
=>
if *suppress_tid_underscores
add_string pps id;
else
add_string pps id;
add_string pps "_";
add_string pps (tid::to_string tid);
fi;
NULL =>
add_string pps (tid::to_string tid);
esac;
};
end;