## prettyprint-deep-syntax.pkg
#
# Nomenclature:
# In these libraries we distinguish "unparsing" from "prettyprinting":
#
# o The purpose of "unparsing" is to regenerate something close
# to the language surface syntax, for example to issue syntax
# error diagnostic messages to user.
#
# o The purpose of "prettyprinting" is to accurately display
# the actual internal datastructure in question, typically
# for purposes of compiler debugging.
#
# Both are useful, so we implement both
# for both raw and deep syntax trees.
# Compiled by:
# src/lib/compiler/front/typer/typer.sublib# 2009-05-13 CrT: Created from unparse-deep-syntax.pkg.
# This is a really quick and dirty hack at present.
stipulate
package ds = deep_syntax; # deep_syntax is from src/lib/compiler/front/typer-stuff/deep-syntax/deep-syntax.pkg package pp = standard_prettyprinter; # standard_prettyprinter is from src/lib/prettyprint/big/src/standard-prettyprinter.pkg package sci = sourcecode_info; # sourcecode_info is from src/lib/compiler/front/basics/source/sourcecode-info.pkg package syx = symbolmapstack; # symbolmapstack is from src/lib/compiler/front/typer-stuff/symbolmapstack/symbolmapstack.pkgherein
api Prettyprint_Deep_Syntax {
#
prettyprint_pattern
:
syx::Symbolmapstack
-> pp::Prettyprinter
-> (ds::Case_Pattern, Int)
-> Void;
prettyprint_expression
:
(syx::Symbolmapstack, Null_Or( sci::Sourcecode_Info ))
-> pp::Prettyprinter
-> (ds::Deep_Expression, Int)
-> Void;
prettyprint_declaration
:
(syx::Symbolmapstack, Null_Or( sci::Sourcecode_Info ))
-> pp::Prettyprinter
-> (ds::Declaration, Int)
-> Void;
prettyprint_rule
:
(syx::Symbolmapstack, Null_Or( sci::Sourcecode_Info ))
-> pp::Prettyprinter
-> (ds::Case_Rule, Int)
-> Void;
prettyprint_named_value
:
(syx::Symbolmapstack, Null_Or( sci::Sourcecode_Info ))
-> pp::Prettyprinter
-> (ds::Named_Value, Int)
-> Void;
prettyprint_named_recursive_value
:
(syx::Symbolmapstack, Null_Or( sci::Sourcecode_Info ))
-> pp::Prettyprinter
-> (ds::Named_Recursive_Value, Int)
-> Void;
prettyprint_package_expression
:
(syx::Symbolmapstack, Null_Or( sci::Sourcecode_Info ))
-> pp::Prettyprinter
-> (ds::Package_Expression, Int)
-> Void;
lineprint: Ref( Bool );
debugging: Ref( Bool );
}; # Api Prettyprint_Deep_Syntax
end;
stipulate
package ds = deep_syntax; # deep_syntax is from src/lib/compiler/front/typer-stuff/deep-syntax/deep-syntax.pkg package err = error_message; # error_message is from src/lib/compiler/front/basics/errormsg/error-message.pkg package ip = inverse_path; # inverse_path is from src/lib/compiler/front/typer-stuff/basics/symbol-path.pkg package mld = module_level_declarations; # module_level_declarations is from src/lib/compiler/front/typer-stuff/modules/module-level-declarations.pkg package pp = standard_prettyprinter; # standard_prettyprinter is from src/lib/prettyprint/big/src/standard-prettyprinter.pkg package sci = sourcecode_info; # sourcecode_info is from src/lib/compiler/front/basics/source/sourcecode-info.pkg package sy = symbol; # symbol is from src/lib/compiler/front/basics/map/symbol.pkg package syp = symbol_path; # symbol_path is from src/lib/compiler/front/typer-stuff/basics/symbol-path.pkg package syx = symbolmapstack; # symbolmapstack is from src/lib/compiler/front/typer-stuff/symbolmapstack/symbolmapstack.pkg package tdt = type_declaration_types; # type_declaration_types is from src/lib/compiler/front/typer-stuff/types/type-declaration-types.pkg package vac = variables_and_constructors; # variables_and_constructors is from src/lib/compiler/front/typer-stuff/deep-syntax/variables-and-constructors.pkg package tpl = tuples; # tuples is from src/lib/compiler/front/typer-stuff/types/tuples.pkg package fxt = fixity; # fixity is from src/lib/compiler/front/basics/map/fixity.pkg package uj = unparse_junk; # unparse_junk is from src/lib/compiler/front/typer/print/unparse-junk.pkg package ppt = prettyprint_type; # prettyprint_type is from src/lib/compiler/front/typer/print/prettyprint-type.pkg package uv = unparse_value; # unparse_value is from src/lib/compiler/front/typer/print/unparse-value.pkg package ppv = prettyprint_value; # prettyprint_value is from src/lib/compiler/front/typer/print/prettyprint-value.pkg Pp = pp::Pp;
herein
package prettyprint_deep_syntax
: (weak) Prettyprint_Deep_Syntax # Prettyprint_Deep_Syntax is from src/lib/compiler/front/typer/print/prettyprint-deep-syntax.pkg {
# Debugging
say = control_print::say;
# debugging = REF FALSE;
debugging = log::debugging;
# unparse_typevar_ref = unparse_type::unparse_typevar_ref syx::empty;
fun bug msg
=
error_message::impossible("unparse_deep_syntax: " + msg);
# internals = typer_control::internals;
internals = log::internals;
lineprint = REF FALSE;
fun if_debugging_say (msg: String)
=
if *debugging say msg; say "\n"; fi;
fun if_debugging_unparse_typevar_ref (msg, typevar_ref)
=
if *debugging
#
unparse_typevar_ref = unparse_type::unparse_typevar_ref syx::empty;
#
typer_debugging::with_internals
(\\ () = typer_debugging::debug_print debugging (msg, unparse_typevar_ref, typevar_ref));
fi;
fun by f x y
=
f y x;
null_fix = fxt::INFIX (0, 0);
inf_fix = fxt::INFIX (1000000, 100000);
fun stronger_l (fxt::INFIX(_, m), fxt::INFIX (n, _)) => m >= n;
stronger_l _ => FALSE; # should not matter
end;
fun stronger_r (fxt::INFIX(_, m), fxt::INFIX (n, _)) => n > m;
stronger_r _ => TRUE; # should not matter
end;
fun prpos ( pp: pp::Prettyprinter,
source: sci::Sourcecode_Info,
charpos: Int
)
=
if *lineprint
#
(sci::filepos source charpos)
->
(file: String, line: Int, pos: Int);
pp.lit (int::to_string line);
pp.lit ".";
pp.lit (int::to_string pos);
else
pp.lit (int::to_string charpos);
fi;
fun checkpat (n, NIL)
=>
TRUE;
checkpat (n, (symbol, _) ! fields)
=>
sy::eq (symbol, tpl::number_to_label n) and checkpat (n+1, fields);
end;
fun checkexp (n, NIL)
=>
TRUE;
checkexp (n, (ds::NUMBERED_LABEL { name=>symbol, ... }, _) ! fields)
=>
sy::eq (symbol, tpl::number_to_label n) and checkexp (n+1, fields);
end;
fun is_tuplepat (ds::RECORD_PATTERN { fields => [_], ... } ) => FALSE;
is_tuplepat (ds::RECORD_PATTERN { is_incomplete => FALSE, fields, ... } ) => checkpat (1, fields);
is_tuplepat _ => FALSE;
end;
fun is_tupleexp (ds::RECORD_IN_EXPRESSION [_]) => FALSE;
is_tupleexp (ds::RECORD_IN_EXPRESSION fields) => checkexp (1, fields);
is_tupleexp (ds::SOURCE_CODE_REGION_FOR_EXPRESSION (a, _)) => is_tupleexp a;
is_tupleexp _ => FALSE;
end;
fun get_fix (symbolmapstack, symbol)
=
find_in_symbolmapstack::find_fixity_by_symbol
(
symbolmapstack,
sy::make_fixity_symbol (sy::name symbol)
);
fun strip_source_code_region_data (ds::SOURCE_CODE_REGION_FOR_EXPRESSION (a, _)) => strip_source_code_region_data a;
strip_source_code_region_data x => x;
end;
fun prettyprint_pattern symbolmapstack (pp:Pp)
=
prettyprint_pattern'
where
fun prettyprint_pattern' (_, 0)
=>
pp.lit "<pattern>";
prettyprint_pattern' (ds::VARIABLE_IN_PATTERN v, _)
=>
pp.box' 0 -1 {.
pp.lit "ds::VARIABLE_IN_PATTERN";
pp.ind 4;
pp.txt " ";
if *internals ppv::prettyprint_variable pp (symbolmapstack, v); # More verbose version of next line.
else ppv::prettyprint_var pp v;
fi;
};
prettyprint_pattern' (ds::WILDCARD_PATTERN, _)
=>
pp.lit "WILDCARD_PATTERN ";
prettyprint_pattern' (ds::INT_CONSTANT_IN_PATTERN (i, t), _)
=>
pp.box' 0 -1 {.
pp.lit "ds::INT_CONSTANT_IN_PATTERN";
pp.txt " ";
pp.lit (multiword_int::to_string i);
pp.lit " ";
};
/* (begin_block pp uj::ALIGN 2;
pp.lit "("; pp.lit (multiword_int::to_string i);
pp.lit " :";
pp.txt " ";
unparse_type symbolmapstack pp t; pp.lit ")";
end_block pp)
*/
prettyprint_pattern' (ds::UNT_CONSTANT_IN_PATTERN (w, t), _)
=>
pp.box' 0 -1 {.
pp.lit "ds::UNT_CONSTANT_IN_PATTERN";
pp.txt " ";
pp.lit (multiword_int::to_string w);
};
/* pp.cbox {. pp.rulename "ppdscb1";
pp.lit "("; pp.lit (multiword_int::to_string w);
pp.lit " :";
pp.txt " ";
unparse_type symbolmapstack pp t; pp.lit ")";
};
*/
prettyprint_pattern' (ds::FLOAT_CONSTANT_IN_PATTERN r, _)
=>
pp.box' 0 -1 {.
pp.lit "ds::FLOAT_CONSTANT_IN_PATTERN";
pp.txt " ";
pp.lit r;
};
prettyprint_pattern' (ds::STRING_CONSTANT_IN_PATTERN s, _)
=>
pp.box' 0 -1 {.
pp.lit "ds::STRING_CONSTANT_IN_PATTERN";
pp.txt " ";
uj::unparse_mlstring pp s;
};
prettyprint_pattern' (ds::CHAR_CONSTANT_IN_PATTERN s, _)
=>
pp.box' 0 -1 {.
pp.lit "ds::STRING_CONSTANT_IN_PATTERN";
pp.txt " ";
uj::unparse_mlstring' pp s;
};
prettyprint_pattern' (ds::AS_PATTERN (v, p), d)
=>
pp.box' 0 -1 {.
pp.lit "ds::AS_PATTERN";
pp.ind 4;
pp.txt " ";
prettyprint_pattern' (v, d);
pp.ind 0;
pp.txt " ";
pp.lit "as";
pp.ind 4;
pp.txt " ";
prettyprint_pattern' (p, d - 1);
};
# Handle 0 length case specially to avoid {, ... }:
prettyprint_pattern' (ds::RECORD_PATTERN { fields => [], is_incomplete, ... }, _)
=>
pp.box' 0 -1 {.
pp.lit "ds::RECORD_PATTERN";
pp.txt " ";
if is_incomplete pp.lit "{... }";
else pp.lit "()";
fi;
};
prettyprint_pattern' (r as ds::RECORD_PATTERN { fields, is_incomplete, ... }, d)
=>
pp.box' 0 -1 {.
pp.lit "ds::RECORD_PATTERN";
pp.ind 4;
pp.txt " ";
if (is_tuplepat r)
#
pp::tuplex pp (\\ (symbol, pattern) = prettyprint_pattern' (pattern, d - 1) ) "" fields;
else
uj::unparse_closed_sequence pp
{ front => \\ pp = pp.txt "{ ",
separator => \\ pp = pp.txt ", ",
back => \\ pp = if is_incomplete pp.lit ", ... }";
else pp.lit "}";
fi,
print_one => \\ pp = \\ (symbol, pattern)
=
pp.box' 0 0 {.
uj::unparse_symbol pp symbol;
pp.txt " => ";
prettyprint_pattern' (pattern, d - 1);
},
breakstyle => uj::ALIGN
}
fields;
fi;
};
prettyprint_pattern' (ds::VECTOR_PATTERN (NIL, _), d)
=>
pp.box' 0 -1 {.
pp.txt "ds::VECTOR_PATTERN";
pp.txt " ";
pp.lit "#[]";
};
prettyprint_pattern' (ds::VECTOR_PATTERN (pats, _), d)
=>
pp.box' 0 -1 {.
#
fun print_one _ pattern
=
prettyprint_pattern' (pattern, d - 1);
pp.lit "ds::VECTOR_PATTERN";
pp.ind 4;
pp.txt " ";
uj::unparse_closed_sequence pp
{ front => \\ pp = pp.lit "#[",
separator => \\ pp = pp.txt ", ",
back => \\ pp = pp.lit "]",
print_one,
breakstyle => uj::ALIGN
}
pats;
};
prettyprint_pattern' (pattern as (ds::OR_PATTERN _), d)
=>
pp.box' 0 -1 {.
#
fun make_list (ds::OR_PATTERN (hd, tl)) => hd ! make_list tl;
make_list p => [p];
end;
fun print_one _ pattern
=
prettyprint_pattern' (pattern, d - 1);
pp.lit "ds::OR_PATTERN";
pp.ind 4;
pp.txt " ";
uj::unparse_closed_sequence pp
{
front => \\ pp = pp.lit "(",
separator => \\ pp = { pp.txt " "; pp.lit "| "; },
back => \\ pp = pp.lit ")",
print_one,
breakstyle => uj::ALIGN
}
(make_list pattern);
};
prettyprint_pattern' (ds::CONSTRUCTOR_PATTERN (e, _), _)
=>
pp.box' 0 -1 {.
pp.lit "ds::CONSTRUCTOR_PATTERN";
pp.ind 4;
pp.txt " ";
ppv::prettyprint_valcon pp e;
};
prettyprint_pattern' (p as ds::APPLY_PATTERN _, d)
=>
pp.box' 0 -1 {.
pp.lit "ds::APPLY_PATTERN";
pp.ind 4;
pp.txt " ";
prettyprint_valcon_pattern (symbolmapstack, pp) (p, null_fix, null_fix, d);
};
prettyprint_pattern' (ds::TYPE_CONSTRAINT_PATTERN (pattern, typoid), depth)
=>
{ pp.box' 0 -1 {.
pp.lit "ds::TYPE_CONSTRAINT_PATTERN";
pp.ind 4;
pp.txt " ";
prettyprint_pattern' (pattern, depth - 1);
pp.lit " :";
pp.txt " ";
ppt::prettyprint_typoid symbolmapstack pp typoid;
};
};
prettyprint_pattern' _ => bug "prettyprint_pattern'";
end;
end
also
fun prettyprint_valcon_pattern (symbolmapstack, pp)
=
{ fun lpcond atom = if atom pp.lit "("; fi;
fun rpcond atom = if atom pp.lit ")"; fi;
fun prettyprint_valcon_pattern' (_, _, _, 0) => pp.lit "<pattern>";
#
prettyprint_valcon_pattern' (ds::CONSTRUCTOR_PATTERN (tdt::VALCON { name, ... }, _), l: fxt::Fixity, r: fxt::Fixity, _)
=>
pp.box' 0 -1 {.
pp.lit "ds::CONSTRUCTOR_PATTERN (tdt::VALCON {";
pp.ind 4;
pp.txt " ";
uj::unparse_symbol pp name;
pp.ind 0;
pp.txt " ";
pp.lit "} )";
};
prettyprint_valcon_pattern' (ds::TYPE_CONSTRAINT_PATTERN (pattern, typoid), l, r, depth)
=>
{ pp.box' 0 -1 {.
pp.lit "ds::TYPE_CONSTRAINT_PATTERN (";
prettyprint_pattern symbolmapstack pp (pattern, depth - 1);
pp.lit " :";
pp.txt " ";
ppt::prettyprint_typoid symbolmapstack pp typoid;
pp.lit ")";
};
};
prettyprint_valcon_pattern' (ds::AS_PATTERN (v, p), l, r, d)
=>
pp.box' 0 -1 {.
pp.lit "ds::AS_PATTERN (";
prettyprint_pattern symbolmapstack pp (v, d);
pp.txt " as ";
prettyprint_pattern symbolmapstack pp (p, d - 1);
pp.lit ")";
};
prettyprint_valcon_pattern' (ds::APPLY_PATTERN (tdt::VALCON { name, ... }, _, p), l, r, d)
=>
{ name' = sy::name name;
# should really have original path, like for VARIABLE_IN_EXPRESSION XXX BUGGO FIXME
this_fix = get_fix (symbolmapstack, name);
eff_fix = case this_fix fxt::NONFIX => inf_fix; x => x; esac;
atom = stronger_r (eff_fix, r) or stronger_l (l, eff_fix);
pp.box' 0 -1 {. pp.rulename "ppdscb2";
#
pp.lit "ds::APPLY_PATTERN (tdt::VALCON {";
pp.ind 4;
pp.txt " ";
lpcond atom;
case (this_fix, p)
#
(fxt::INFIX _, ds::RECORD_PATTERN { fields => [(_, pl), (_, pr)], ... } )
=>
{ my (left, right)
=
if atom (null_fix, null_fix);
else ( l, r);
fi;
prettyprint_valcon_pattern' (pl, left, this_fix, d - 1);
pp.txt " ";
pp.lit name';
pp.txt " ";
prettyprint_valcon_pattern' (pr, this_fix, right, d - 1);
};
_ =>
{ pp.lit name';
pp.txt " ";
prettyprint_valcon_pattern' (p, inf_fix, inf_fix, d - 1);
};
esac;
rpcond atom;
pp.ind 0;
pp.txt " ";
pp.lit "} ) ";
};
};
prettyprint_valcon_pattern' (p, _, _, d)
=>
prettyprint_pattern symbolmapstack pp (p, d);
end;
prettyprint_valcon_pattern';
};
fun trim [x] => [];
trim (a ! b) => a ! trim b;
trim [] => [];
end;
fun prettyprint_expression (context as (symbolmapstack, source_opt)) (pp:Pp)
=
{
fun lparen () = pp.lit "("; # These should be eliminated when I'm bored -- they merely obfusticate a bit. XXX SUCKO FIXME
fun rparen () = pp.lit ")";
fun lpcond atom = if atom pp.lit "("; fi; # These should be eliminated when 'atom' is elimnated.
fun rpcond atom = if atom pp.lit ")"; fi;
fun prettyprint_expression' (_, _, 0) # 2nd arg is 'atom: Bool', TRUE iff first arg is an atom, or something like that. It should be eliminated -- it tries to do part of the prettyprint mill's job for it, which sucks. XXX SUCKO FIXME.
=> # 3rd arg is prettyprint 'depth'. We stop prettyprint recursion when 'depth' drops to 0.
pp.lit "<expression>";
#
prettyprint_expression' (ds::VALCON_IN_EXPRESSION { valcon, typescheme_args }, _, _)
=>
pp.box' 0 -1 {.
pp.lit "ds::VALCON_IN_EXPRESSION {";
pp.ind 4;
pp.txt " ";
pp.box' 0 0 {.
pp.txt "valcon => ";
ppv::prettyprint_valcon pp valcon;
};
pp.endlit ",";
pp.txt " ";
pp.box' 0 -1 {.
pp.lit (sprintf "%d typescheme_args => [ " (list::length typescheme_args));
pp.ind 4;
pp.txt " ";
apply pp_typoid typescheme_args
where
fun pp_typoid typoid
=
{ ppt::prettyprint_typoid symbolmapstack pp typoid;
pp.endlit ",";
pp.txt " ";
};
end;
pp.ind 0;
pp.txt " ";
pp.txt "] ";
};
pp.ind 0;
pp.txt " ";
pp.lit "}";
};
prettyprint_expression' (ds::VARIABLE_IN_EXPRESSION { var => REF var, typescheme_args }, _, _)
=>
{
pp.box' 0 0 {.
pp.lit "ds::VARIABLE_IN_EXPRESSION";
pp.txt " ";
pp.txt "{";
pp.ind 4;
pp.txt " ";
pp.box' 0 -1 {.
pp.lit "var";
pp.ind 4;
pp.txt " ";
pp.txt "=> ";
if *internals ppv::prettyprint_variable pp (symbolmapstack, var); # More verbose version of next line.
else ppv::prettyprint_var pp var ;
fi;
};
pp.endlit ",";
pp.txt " ";
pp.box' 0 -1 {.
pp.lit (sprintf "%d typescheme_args" (list::length typescheme_args));
pp.ind 4;
pp.txt " ";
pp.txt "=> ";
pp.box' 0 -1 {.
pp.txt "[";
pp.ind 4;
pp.txt " ";
apply pp_typoid typescheme_args
where
fun pp_typoid typoid
=
{ ppt::prettyprint_typoid symbolmapstack pp typoid;
pp.endlit ",";
pp.txt " ";
};
end;
pp.ind 0;
pp.txt " ";
pp.lit "]";
};
};
pp.ind 0;
pp.txt " ";
pp.lit "}";
};
};
prettyprint_expression' ( ds::INT_CONSTANT_IN_EXPRESSION (i, t), _, _)
=>
pp.box' 0 -1 {.
pp.lit "ds::INT_CONSTANT_IN_EXPRESSION";
pp.txt " ";
pp.lit (multiword_int::to_string i);
};
prettyprint_expression' ( ds::UNT_CONSTANT_IN_EXPRESSION (u, t), _, _)
=>
pp.box' 0 -1 {.
pp.lit "ds::UNT_CONSTANT_IN_EXPRESSION";
pp.txt " ";
pp.lit (multiword_int::to_string u);
};
prettyprint_expression' ( ds::FLOAT_CONSTANT_IN_EXPRESSION r, _, _)
=>
pp.box' 0 -1 {.
pp.lit "ds::FLOAT_CONSTANT_IN_EXPRESSION";
pp.txt " ";
pp.lit r;
};
prettyprint_expression' (ds::STRING_CONSTANT_IN_EXPRESSION s, _, _)
=>
pp.box' 0 -1 {.
pp.lit "ds::STRING_CONSTANT_IN_EXPRESSION";
pp.txt " ";
uj::unparse_mlstring pp s;
};
prettyprint_expression' ( ds::CHAR_CONSTANT_IN_EXPRESSION s, _, _)
=>
pp.box' 0 -1 {.
pp.lit "ds::CHAR_CONSTANT_IN_EXPRESSION";
pp.txt " ";
uj::unparse_mlstring' pp s;
};
prettyprint_expression' (r as ds::RECORD_IN_EXPRESSION fields, _, d)
=>
pp.box' 0 0 {.
pp.lit "ds::RECORD_IN_EXPRESSION";
pp.ind 4;
pp.txt " ";
if (is_tupleexp r)
#
pp::tuplex pp (\\ (_, expression) = prettyprint_expression' (expression, FALSE, d - 1)) "" fields;
else
uj::unparse_closed_sequence pp
{ front => \\ pp = pp.txt "{ ",
separator => \\ pp = pp.txt ", ",
back => \\ pp = pp.lit "}",
print_one => \\ pp = \\ (ds::NUMBERED_LABEL { name, ... }, expression)
=
pp.box' 0 0 {.
uj::unparse_symbol pp name;
pp.lit " =>";
pp.ind 4;
pp.txt " ";
prettyprint_expression' (expression, FALSE, d);
},
breakstyle => uj::ALIGN
}
fields;
fi;
};
prettyprint_expression' (ds::RECORD_SELECTOR_EXPRESSION (ds::NUMBERED_LABEL { name, ... }, expression), atom, d)
=>
{ pp.box' 0 0 {. pp.rulename "ppdscb3";
pp.lit "ds::RECORD_SELECTOR_EXPRESSION (ds::NUMBERED_LABEL {";
pp.ind 4;
pp.txt " ";
pp.lit "#";
uj::unparse_symbol pp name;
pp.lit ", ... }, ";
lpcond atom;
prettyprint_expression' (expression, TRUE, d - 1);
pp.lit ">";
rpcond atom;
pp.ind 0;
pp.cut ();
pp.lit ") ";
};
};
prettyprint_expression' (ds::VECTOR_IN_EXPRESSION (NIL, _), _, d)
=>
pp.lit "ds::VECTOR_IN_EXPRESSION #[]";
prettyprint_expression' (ds::VECTOR_IN_EXPRESSION (exps, _), _, d)
=>
pp.box' 0 0 {.
#
fun print_one _ expression
=
prettyprint_expression' (expression, FALSE, d - 1);
pp.lit "ds::VECTOR_IN_EXPRESSION";
pp.txt " ";
uj::unparse_closed_sequence pp
{ front => \\ pp = pp.lit "#[",
separator => \\ pp = pp.txt ", ",
back => \\ pp = pp.lit "]",
print_one,
breakstyle => uj::ALIGN
}
exps;
};
prettyprint_expression' (ds::ABSTRACTION_PACKING_EXPRESSION (e, t, tcs), atom, d)
=>
{
pp.box' 0 0 {. pp.rulename "ppdscb4";
pp.lit "<ds::ABSTRACTION_PACKING_EXPRESSION:";
pp.ind 4;
pp.txt " ";
prettyprint_expression' (e, FALSE, d);
pp.endlit ";";
pp.txt " ";
ppt::prettyprint_typoid symbolmapstack pp t;
pp.ind 0;
pp.cut ();
pp.lit ">";
};
};
prettyprint_expression' (ds::SEQUENTIAL_EXPRESSIONS expressions, _, d)
=>
pp.box' 0 0 {.
#
pp.lit "ds::SEQUENTIAL_EXPRESSIONS";
pp.ind 4;
pp.txt " ";
uj::unparse_closed_sequence pp
#
{ front => \\ pp = pp.lit "(",
separator => \\ pp = { pp.endlit ";";
pp.txt " ";
},
back => \\ pp = pp.lit ")",
print_one => (\\ _ = \\ expression = prettyprint_expression' (expression, FALSE, d - 1)),
breakstyle => uj::ALIGN
}
#
expressions;
};
prettyprint_expression' (e as ds::APPLY_EXPRESSION _, atom, d)
=>
pp.box' 0 0 {.
infix0 = fxt::INFIX (0, 0);
#
pp.lit "ds::APPLY_EXPRESSION";
# lpcond atom;
prettyprint_app_expression (e, null_fix, null_fix, d);
# rpcond atom;
};
prettyprint_expression' (ds::TYPE_CONSTRAINT_EXPRESSION (e, t), atom, d)
=>
{ pp.box' 0 0 {. pp.rulename "ppdscb5";
pp.lit "ds::TYPE_CONSTRAINT_EXPRESSION";
pp.ind 4;
pp.txt " ";
lpcond atom;
prettyprint_expression' (e, FALSE, d);
pp.endlit ":";
pp.txt " ";
ppt::prettyprint_typoid symbolmapstack pp t;
rpcond atom;
};
};
prettyprint_expression' (ds::EXCEPT_EXPRESSION (expression, (rules, _)), atom, d)
=>
{ pp.box' 0 0 {. pp.rulename "ppdscb6";
pp.lit "ds::EXCEPT_EXPRESSION";
pp.ind 4;
pp.txt " ";
lpcond atom;
prettyprint_expression' (expression, atom, d - 1);
pp.txt " ";
pp.lit "except";
pp.txt " ";
uj::ppvlist pp (" ", "| ",
(\\ pp = \\ r = prettyprint_rule context pp (r, d - 1)), rules);
rpcond atom;
};
};
prettyprint_expression' (ds::RAISE_EXPRESSION (expression, _), atom, d)
=>
{ pp.box' 0 0 {. pp.rulename "ppdscb7";
pp.lit "ds::RAISE_EXPRESSION";
pp.ind 4;
pp.txt " ";
lpcond atom;
pp.lit "raise exception ";
prettyprint_expression' (expression, TRUE, d - 1);
rpcond atom;
};
};
prettyprint_expression' (ds::LET_EXPRESSION (declaration, expression), _, d)
=>
{ pp.box' 0 0 {. pp.rulename "ppdscb8";
pp.lit "ds::LET_EXPRESSION (\"stipulate\")";
pp.ind 4;
pp.txt " ";
pp.box' 0 -1 {. pp.rulename "ppdscb9";
prettyprint_declaration context pp (declaration, d - 1);
};
pp.ind 0;
pp.txt " ";
pp.lit "herein";
pp.ind 4;
pp.txt " ";
pp.box' 0 -1 {. pp.rulename "ppdscb10";
prettyprint_expression' (expression, FALSE, d - 1);
};
pp.ind 0;
pp.txt " ";
pp.lit "end;";
};
};
prettyprint_expression' (ds::CASE_EXPRESSION (expression, rules, _), _, d)
=>
{ pp.box' 0 0 {. pp.rulename "ppdscb11";
pp.lit "ds::CASE_EXPRESSION ";
pp.ind 4;
pp.txt " ";
prettyprint_expression' (expression, TRUE, d - 1); uj::newline_indent pp 2;
pp.ind 4;
pp.txt " ";
uj::ppvlist pp ("", ";",
(\\ pp = \\ r = prettyprint_rule context pp (r, d - 1)),
trim rules);
rparen();
pp.ind 0;
pp.txt " ";
pp.lit "esac";
};
};
prettyprint_expression' (ds::IF_EXPRESSION { test_case, then_case, else_case }, atom, d)
=>
{ pp.box' 0 0 {. pp.rulename "ppdscb12";
pp.lit "ds::IF_EXPRESSION";
pp.txt " ";
pp.lit "if (";
pp.ind 4;
pp.cut();
pp.box' 0 0 {. pp.rulename "ppdscb13";
prettyprint_expression' (test_case, FALSE, d - 1);
};
pp.ind 0;
pp.cut ();
pp.lit ")";
pp.ind 4;
pp.txt " ";
pp.box' 0 0 {. pp.rulename "ppdscb14";
prettyprint_expression' (then_case, FALSE, d - 1);
};
pp.ind 0;
pp.txt " ";
pp.lit "else";
pp.ind 4;
pp.txt " ";
pp.box' 0 0 {. pp.rulename "ppdscb15";
prettyprint_expression' (else_case, FALSE, d - 1);
};
pp.ind 0;
pp.txt " ";
pp.lit "fi";
};
};
prettyprint_expression' (ds::AND_EXPRESSION (e1, e2), atom, d)
=>
{ pp.box' 0 0 {. pp.rulename "ppdscb16";
lpcond atom;
pp.lit "ds::AND_EXPRESSION";
pp.ind 4;
pp.txt " ";
pp.box' 0 0 {. pp.rulename "ppdscb17";
prettyprint_expression' (e1, TRUE, d - 1);
};
pp.ind 0;
pp.txt " ";
pp.lit "and";
pp.ind 4;
pp.txt " ";
pp.box' 0 0 {. pp.rulename "ppdscb18";
prettyprint_expression' (e2, TRUE, d - 1);
};
rpcond atom;
};
};
prettyprint_expression' (ds::OR_EXPRESSION (e1, e2), atom, d)
=>
{ pp.box' 0 0 {. pp.rulename "ppdscb19";
lpcond atom;
pp.lit "ds::OR_EXPRESSION";
pp.ind 4;
pp.txt " ";
pp.box' 0 0 {. pp.rulename "ppdscb20";
prettyprint_expression' (e1, TRUE, d - 1);
};
pp.ind 0;
pp.txt " ";
pp.lit "or";
pp.ind 4;
pp.txt " ";
pp.box' 0 0 {. pp.rulename "ppdscb21";
prettyprint_expression' (e2, TRUE, d - 1);
};
pp.ind 0;
pp.txt " ";
rpcond atom;
};
};
prettyprint_expression' (ds::WHILE_EXPRESSION { test, expression }, atom, d)
=>
{ pp.box' 0 0 {. pp.rulename "ppdscb22";
pp.lit "ds::WHILE_EXPRESSION ";
pp.txt " ";
pp.lit "while (";
pp.ind 4;
pp.cut();
pp.box' 0 0 {. pp.rulename "ppdscb23";
prettyprint_expression' (test, FALSE, d - 1);
};
pp.ind 0;
pp.cut ();
pp.lit ")";
pp.ind 4;
pp.cut();
pp.cbox {. pp.rulename "ppdscb24";
prettyprint_expression' (expression, FALSE, d - 1);
};
};
};
prettyprint_expression' (ds::FN_EXPRESSION (rules, typoid), _, d)
=>
pp.box' 0 0 {.
pp.lit "ds::FN_EXPRESSION:";
pp.ind 4;
pp.txt " ";
pp.box' 0 0 {.
pp.lit "typoid => (";
pp.ind 4;
pp.txt " ";
ppt::prettyprint_typoid symbolmapstack pp typoid;
pp.ind 0;
pp.cut ();
pp.lit ")";
};
pp.endlit ",";
pp.txt " ";
pp.box' 0 0 {.
pp.lit "rules => [";
pp.ind 4;
pp.txt " ";
uj::ppvlist pp ("", " | ",
(\\ pp = \\ r =
prettyprint_rule context pp (r, d - 1)),
trim rules);
pp.ind 0;
pp.txt " ";
pp.lit "]";
};
};
prettyprint_expression' (ds::SOURCE_CODE_REGION_FOR_EXPRESSION (expression, (s, e)), atom, d)
=>
case source_opt
#
NULL => prettyprint_expression' (expression, atom, d);
THE source
=>
# pp.box' 0 0 {.
# pp.lit "<ds::SOURCE_CODE_REGION_FOR_EXPRESSION "; # Commented out as mainly a distraction in practice.
# pp.ind 4;
# pp.box' 0 0 {.
# pp.lit "(";
# pp.ind 4;
# prpos (pp, source, s);
# pp.txt ", ";
# prpos (pp, source, e);
# pp.ind 0;
# pp.cut ();
# pp.txt ")";
# };
# pp.txt " ";
prettyprint_expression' (expression, FALSE, d);
#
# pp.ind 0;
# pp.cut ();
# pp.lit ">";
# };
esac;
end
also
fun prettyprint_app_expression (_, _, _, 0)
=>
pp.lit "<expression>";
prettyprint_app_expression arg
=>
apply_print arg
where
fun fixitypp (symbol, operand, left_fix, right_fix, d)
=
{ name = syp::to_string (syp::SYMBOL_PATH symbol);
#
this_fix = case symbol
#
[symbol] => get_fix (symbolmapstack, symbol);
_ => fxt::NONFIX;
esac;
fun pr_non expression
=
{ pp.box' 0 2 {. pp.rulename "ppdscb25";
pp.lit "{";
pp.ind 2;
pp.txt " ";
pp.box' 0 -1 {.
pp.lit "operator =>";
pp.ind 4;
pp.txt " ";
pp.lit name;
};
pp.endlit ",";
pp.txt " ";
pp.box' 0 -1 {.
pp.lit "operand =>";
pp.ind 4;
pp.txt " ";
prettyprint_expression' (expression, TRUE, d - 1);
};
pp.ind 0;
pp.txt " ";
pp.lit "}";
};
};
case this_fix
#
fxt::INFIX _
=>
case (strip_source_code_region_data operand)
#
ds::RECORD_IN_EXPRESSION [(_, pl), (_, pr)]
=>
{ atom = stronger_l (left_fix, this_fix)
or stronger_r (this_fix, right_fix);
my (left, right)
=
atom ?? (null_fix, null_fix )
:: (left_fix, right_fix);
pp.box' 0 0 {. pp.rulename "ppdscb26";
pp.lit "ds::RECORD_IN_EXPRESSION";
pp.ind 4;
pp.txt " ";
lpcond atom;
prettyprint_app_expression (pl, left, this_fix, d - 1);
pp.txt " ";
pp.lit name;
pp.txt " ";
prettyprint_app_expression (pr, this_fix, right, d - 1);
rpcond atom;
};
};
e' => pr_non e';
esac;
fxt::NONFIX => pr_non operand;
esac;
};
fun apply_print (_, _, _, 0)
=>
pp.lit "#";
apply_print (ds::APPLY_EXPRESSION { operator, operand }, l, r, d)
=>
case (strip_source_code_region_data operator)
#
ds::VALCON_IN_EXPRESSION { valcon => tdt::VALCON { name, ... }, ... }
=>
fixitypp ([name], operand, l, r, d);
ds::VARIABLE_IN_EXPRESSION { var => v, typescheme_args }
=>
pp.box' 0 0 {.
case typescheme_args # Added 2013-11-10 CrT
[] => ();
_ => { # if ((length typescheme_args) > 0) # For the moment I'm finding suppression of empty typescheme arglists more confusing than helpful -- 2013-12-15 CrT
pp.box' 1 2 {.
pp.lit (sprintf "operator.typescheme_args (%d) => [" (list::length typescheme_args));
pp.ind 2;
pp.txt " ";
pp::seqx {. pp.txt ", "; } {. pp_typoid #typoid; } typescheme_args
where
fun pp_typoid typoid
=
ppt::prettyprint_typoid symbolmapstack pp typoid;
end;
pp.ind 0;
pp.txt " ";
pp.txt "],";
};
pp.txt " ";
# fi;
};
esac;
path = case *v
vac::PLAIN_VARIABLE { path=>syp::SYMBOL_PATH path', ... } => path';
vac::OVERLOADED_VARIABLE { name, ... } => [name];
errorvar => [sy::make_value_symbol "<errorvar>"];
esac;
fixitypp (path, operand, l, r, d);
};
operator
=>
{ pp.box' 0 2 {. pp.rulename "ppdscb27";
pp.lit "{";
pp.ind 4;
pp.txt " ";
pp.box' 0 0 {.
pp.lit "operator =>";
pp.ind 4;
pp.txt " ";
prettyprint_expression' (operator, TRUE, d - 1);
};
pp.endlit ",";
pp.txt " ";
pp.box' 0 0 {.
pp.lit "operand =>";
pp.ind 4;
pp.txt " ";
prettyprint_expression' (operand, TRUE, d - 1);
};
pp.ind 0;
pp.txt " ";
pp.lit "}";
};
};
esac;
apply_print (ds::SOURCE_CODE_REGION_FOR_EXPRESSION (expression, (s, e)), l, r, d)
=>
case source_opt
#
NULL => apply_print (expression, l, r, d);
#
THE source
=>
if *internals
#
pp.box' 0 0 {.
pp.lit "<MARK(";
prpos (pp, source, s); pp.txt ", ";
prpos (pp, source, e); pp.txt "): ";
prettyprint_expression' (expression, FALSE, d);
pp.lit ">";
};
else
apply_print (expression, l, r, d);
fi;
esac;
apply_print (e, _, _, d)
=>
prettyprint_expression' (e, TRUE, d);
end;
end;
end;
(\\ (expression, depth)
=
prettyprint_expression' (expression, FALSE, depth));
}
also
fun prettyprint_rule (context as (symbolmapstack, source_opt)) pp (ds::CASE_RULE (pattern, expression), d)
=
if (d > 0)
#
pp.box' 0 0 {.
pp.lit "ds::CASE_RULE (";
pp.ind 2;
pp.txt " ";
prettyprint_pattern symbolmapstack pp (pattern, d - 1);
pp.endlit ",";
pp.txt " ";
prettyprint_expression context pp (expression, d - 1);
pp.ind 0;
pp.cut ();
pp.lit ")";
};
else
pp.lit "<rule>";
fi
also
fun prettyprint_named_value (context as (symbolmapstack, source_opt)) pp (ds::VALUE_NAMING { pattern, expression, generalized_typevars, raw_typevars }, d)
=
if (d > 0)
#
pp.box' 0 0 {.
pp.lit "ds::VALUE_NAMING {";
pp.ind 4;
pp.txt " ";
fun prettyprint_typevar typevar_ref
=
ppt::prettyprint_typevar_ref
symbolmapstack
pp
typevar_ref;
# if ((length *raw_typevars) > 0) # Made unconditional for the moment for more clarity -- 2013-12-15 CrT
pp.txt " ";
pp.lit (sprintf "raw_typevars => %d-entry list: " (length *raw_typevars));
apply prettyprint_typevar *raw_typevars;
pp.endlit ",";
pp.txt " ";
# fi;
# if ((length generalized_typevars) > 0)
#
pp.lit (sprintf "generalized_typevars => %d-entry list: " (length generalized_typevars));
apply prettyprint_typevar generalized_typevars;
pp.endlit ",";
pp.txt " ";
# fi;
pp.box' 0 -1 {.
pp.lit "pattern =>";
pp.ind 4;
pp.txt " ";
prettyprint_pattern symbolmapstack pp (pattern, d - 1);
};
pp.endlit ",";
pp.txt " ";
pp.box' 0 -1 {.
pp.lit "expression =>";
pp.ind 4;
pp.txt " ";
prettyprint_expression context pp (expression, d - 1);
};
pp.ind 0;
pp.txt " ";
pp.lit "}";
};
else
pp.lit "<naming>";
fi
also
fun prettyprint_named_recursive_value context pp (ds::NAMED_RECURSIVE_VALUE { variable=>var, expression, ... }, d)
=
if (d > 0)
#
pp.box' 0 0 {. pp.rulename "ppdscb28";
ppv::prettyprint_var pp var;
pp.lit " =";
pp.txt " ";
prettyprint_expression context pp (expression, d - 1);
};
else
pp.lit "<rec naming>";
fi
# NB: The original 1992 deep syntax unparser still exists, in
#
# src/lib/compiler/src/print/unparse-interactive-deep-syntax-declaration.pkg #
# It gets called only by
#
# src/lib/compiler/toplevel/interact/read-eval-print-loop-g.pkg #
# which uses it to display the results of interactive expression evaluation.
#
# The more recent version here gets used for everything else.
# It gets called from:
#
# src/lib/compiler/front/typer/main/type-core-language.pkg # src/lib/compiler/toplevel/main/translate-raw-syntax-to-execode-g.pkg # src/lib/compiler/toplevel/main/print-hooks.pkg #
also
fun prettyprint_declaration (context as (symbolmapstack, source_opt)) pp
=
{
fun prettyprint_declaration' (_, 0)
=>
pp.lit "<declaration>";
prettyprint_declaration' (ds::VALUE_DECLARATIONS vbs, d)
=>
{ pp.box' 0 0 {. pp.rulename "ppdscb29";
pp.lit "ds::VALUE_DECLARATIONS [ ";
pp.ind 4;
pp.txt " ";
#
uj::ppvlist pp (" ", ", ",
(\\ pp = \\ named_value = prettyprint_named_value context pp (named_value, d - 1)), vbs);
pp.ind 0;
pp.txt " ";
pp.lit "]";
};
};
prettyprint_declaration' (ds::RECURSIVE_VALUE_DECLARATIONS rvbs, d)
=>
{ pp.box' 0 0 {. pp.rulename "ppdscb30";
pp.lit "ds::RECURSIVE_VALUE_DECLARATIONS [";
pp.ind 4;
pp.txt " ";
uj::ppvlist pp (" ", ", ",
(\\ pp = \\ named_recursive_values = prettyprint_named_recursive_value context pp (named_recursive_values, d - 1)), rvbs);
pp.ind 0;
pp.txt " ";
pp.lit "]";
};
};
prettyprint_declaration' (ds::TYPE_DECLARATIONS types, d)
=>
{ fun f pp (tdt::NAMED_TYPE { namepath, typescheme=>tdt::TYPESCHEME { arity, body }, ... } )
=>
{ case arity
#
0 => ();
1 => pp.lit "'a ";
n => { uj::unparse_tuple pp pp::lit (ppt::type_formals n);
pp.lit " ";
};
esac;
uj::unparse_symbol pp (ip::last namepath);
pp.lit " = ";
ppt::prettyprint_typoid symbolmapstack pp body;
};
f _ _
=>
bug "prettyprint_declaration' (TYPE_DECLARATIONS)";
end;
pp.box' 0 0 {. pp.rulename "ppdscb31";
#
uj::ppvlist pp (
"", # was "type "
" also ",
f,
types
);
};
};
prettyprint_declaration' (ds::SUMTYPE_DECLARATIONS { sumtypes, with_types }, d)
=>
{ fun prettyprint_data pp (tdt::SUM_TYPE { namepath, arity, kind, ... } )
=>
case kind
#
tdt::SUMTYPE (_)
=>
{ case arity
#
0 => ();
1 => (pp.lit "'a ");
n => { uj::unparse_tuple pp pp::lit (ppt::type_formals n);
pp.lit " ";
};
esac;
uj::unparse_symbol pp (ip::last namepath);
pp.lit " = ...";
/*
uj::unparse_sequence
pp
{ separator => \\ pp = { pp.lit " |"; pp.txt " "; },
print_one => (\\ pp =
\\ (tdt::VALCON { name, ... } ) =
uj::unparse_symbol pp name),
breakstyle => uj::ALIGN
}
dcons;
*/
};
_ =>
bug "prettyprint_declaration' (SUMTYPE_DECLARATIONS) 1.1";
esac;
prettyprint_data _ _
=>
bug "prettyprint_declaration' (SUMTYPE_DECLARATIONS) 1.2";
end;
fun prettyprint_with pp (tdt::NAMED_TYPE { namepath, typescheme=>tdt::TYPESCHEME { arity, body }, ... } )
=>
pp.box' 0 0 {.
#
case arity
0 => ();
1 => (pp.lit "'a ");
n => { uj::unparse_tuple pp pp::lit (ppt::type_formals n); pp.lit " "; };
esac;
uj::unparse_symbol pp (ip::last namepath);
pp.txt " = ";
ppt::prettyprint_typoid symbolmapstack pp body;
};
prettyprint_with _ _
=>
bug "prettyprint_declaration' (SUMTYPE_DECLARATIONS) 2";
end;
# Could call PPDec::prettyprint_declaration here:
pp.box' 0 0 {. pp.rulename "ppdscb32";
uj::ppvlist pp (
"", # Was "enum "
"also ",
prettyprint_data,
sumtypes
);
pp.txt " ";
uj::ppvlist pp ("withtype ", "also ", prettyprint_with, with_types);
};
};
prettyprint_declaration' (ds::EXCEPTION_DECLARATIONS ebs, d)
=>
{ fun f pp ( ds::NAMED_EXCEPTION {
exception_constructor => tdt::VALCON { name, ... },
exception_typoid => etype,
...
}
)
=>
pp.box' 0 0 {.
#
uj::unparse_symbol pp name;
case etype
#
NULL => ();
THE type'
=>
{ pp.txt " of ";
ppt::prettyprint_typoid symbolmapstack pp type';
};
esac;
};
f pp (ds::DUPLICATE_NAMED_EXCEPTION { exception_constructor => tdt::VALCON { name, ... },
equal_to => tdt::VALCON { name=>name', ... }
}
)
=>
pp.box' 0 0 {.
uj::unparse_symbol pp name;
pp.ind 4;
pp.txt " ";
pp.txt "= ";
uj::unparse_symbol pp name';
};
end;
pp.box' 0 0 {. pp.rulename "ppdscb33";
uj::ppvlist pp ("exception ", "also ", f, ebs);
};
};
prettyprint_declaration' (ds::PACKAGE_DECLARATIONS sbs, d)
=>
{ fun f pp (ds::NAMED_PACKAGE { name_symbol=>name, a_package=>mld::A_PACKAGE { varhome, ... }, definition=>def } )
=>
pp.box' 0 0 {.
uj::unparse_symbol pp name;
ppv::prettyprint_varhome pp varhome;
pp.ind 4;
pp.txt " ";
pp.txt "= ";
prettyprint_package_expression context pp (def, d - 1);
};
f _ _
=>
bug "prettyprint_declaration: PACKAGE_DECLARATION: NAMED_PACKAGE";
end;
pp.box' 0 0 {. pp.rulename "ppdscb34";
uj::ppvlist pp ("package ", "also ", f, sbs);
};
};
prettyprint_declaration' (ds::GENERIC_DECLARATIONS fbs, d)
=>
{ fun f pp (ds::NAMED_GENERIC { name_symbol=>fname, a_generic => mld::GENERIC { varhome, ... }, definition=>def } )
=>
pp.box' 0 0 {.
uj::unparse_symbol pp fname;
ppv::prettyprint_varhome pp varhome;
pp.ind 4;
pp.txt " ";
pp.txt "= ";
prettyprint_generic_expression context pp (def, d - 1);
};
f _ _
=>
bug "prettyprint_declaration': GENERIC_DECLARATION";
end;
pp.box' 0 0 {. pp.rulename "ppdscb35";
uj::ppvlist pp ("generic package ", "also ", f, fbs);
};
};
prettyprint_declaration' (ds::API_DECLARATIONS sigvars, d)
=>
{ fun f pp (mld::API { name, ... } )
=>
pp.box' 0 0 {.
#
pp.lit "api ";
case name
#
THE s => uj::unparse_symbol pp s;
NULL => pp.lit "ANONYMOUS";
esac;
};
f _ _
=>
bug "prettyprint_declaration': API_DECLARATIONS";
end;
pp.box' 0 0 {. pp.rulename "ppdscb36";
#
uj::unparse_sequence
pp
{ separator => \\ pp = pp.txt " ",
print_one => f,
breakstyle => uj::ALIGN
}
sigvars;
};
};
prettyprint_declaration' (ds::GENERIC_API_DECLARATIONS sigvars, d)
=>
{ fun f pp (mld::GENERIC_API { kind, ... } )
=>
{ pp.lit "funsig ";
#
case kind
THE s => uj::unparse_symbol pp s;
NULL => pp.lit "ANONYMOUS";
esac;
};
f _ _
=>
bug "prettyprint_declaration': GENERIC_API_DECLARATIONS"; end;
pp.box' 0 0 {. pp.rulename "ppdscb37";
#
uj::unparse_sequence
pp
{ separator => \\ pp = pp.txt " ",
print_one => f,
breakstyle => uj::ALIGN
}
sigvars;
};
};
prettyprint_declaration' (ds::LOCAL_DECLARATIONS (inner, outer), d)
=>
{ pp.box' 0 0 {. pp.rulename "ppdscb38";
pp.lit "ds::LOCAL_DECLARATIONS (stipulate)";
pp.ind 4;
pp.txt " ";
prettyprint_declaration' (inner, d - 1);
pp.ind 0;
pp.txt " ";
pp.lit "herein";
pp.ind 4;
pp.txt " ";
prettyprint_declaration' (outer, d - 1);
pp.ind 0;
pp.txt " ";
pp.lit "end";
};
};
prettyprint_declaration' (ds::SEQUENTIAL_DECLARATIONS decs, d)
=>
{ pp.box' 0 0 {. pp.rulename "ppdscb39";
#
pp.lit "ds::SEQUENTIAL_DECLARATIONS [";
pp.ind 4;
pp.txt " ";
uj::unparse_sequence
pp
{ separator => \\ pp = pp.txt " ",
print_one => (\\ pp = \\ declaration = prettyprint_declaration' (declaration, d)),
breakstyle => uj::ALIGN
}
decs;
pp.ind 0;
pp.txt " ";
pp.lit "]";
};
};
prettyprint_declaration' (ds::FIXITY_DECLARATION { fixity, ops }, d)
=>
{ pp.box' 0 0 {. pp.rulename "ppdscb40";
#
case fixity
#
fxt::NONFIX => pp.lit "nonfix ";
fxt::INFIX (i, _)
=>
{ if (i % 2 == 0) pp.lit "infix ";
else pp.lit "infixr ";
fi;
if (i / 2 > 0) pp.lit (int::to_string (i / 2));
pp.lit " ";
fi;
};
esac;
uj::unparse_sequence
pp
{ separator => \\ pp = pp.txt " ",
print_one => uj::unparse_symbol,
breakstyle => uj::ALIGN
}
ops;
};
};
prettyprint_declaration' (ds::OVERLOADED_VARIABLE_DECLARATION overloaded_variable, d)
=>
pp.box' 0 0 {.
pp.lit "overloaded my";
pp.ind 4;
pp.txt " ";
ppv::prettyprint_var pp overloaded_variable;
};
prettyprint_declaration' (ds::INCLUDE_DECLARATIONS named_packages, d)
=>
{ pp.box' 0 0 {. pp.rulename "ppdscb41";
pp.lit "include package ";
uj::unparse_sequence
pp
{ separator => (\\ pp = pp.txt " "),
print_one => (\\ pp = \\ (sp, _) = pp.lit (syp::to_string sp)),
breakstyle => uj::ALIGN
}
named_packages;
};
};
prettyprint_declaration' (ds::SOURCE_CODE_REGION_FOR_DECLARATION (declaration, (s, e)), d)
=>
case source_opt
#
NULL => prettyprint_declaration' (declaration, d);
THE source
=>
{
# 2007-09-14CrT: Source region stuff commented out because it clutters the printout horribly:
# pp.lit "ds::SOURCE_CODE_REGION_FOR_DECLARATION(";
prettyprint_declaration' (declaration, d);
# pp.lit ", ";
# prpos (pp, source, s); # "s" for "start"
# pp.lit ", ";
# prpos (pp, source, e); # "e" for "end"
# pp.lit ")";
};
esac;
end;
prettyprint_declaration';
}
also
fun prettyprint_package_expression (context as (_, source_opt)) pp
=
{ fun prettyprint_package_expression' (_, 0)
=>
pp.lit "<package_expression>";
prettyprint_package_expression' (ds::PACKAGE_BY_NAME (mld::A_PACKAGE { varhome, ... } ), d)
=>
ppv::prettyprint_varhome pp varhome;
prettyprint_package_expression'
(
ds::COMPUTED_PACKAGE {
a_generic => mld::GENERIC { varhome => fa, ... },
generic_argument => mld::A_PACKAGE { varhome => sa, ... },
...
},
d
)
=>
pp.box' 0 0 {.
ppv::prettyprint_varhome pp fa;
pp.txt "( ";
ppv::prettyprint_varhome pp sa;
pp.txt " )";
};
prettyprint_package_expression' (ds::PACKAGE_DEFINITION namings, d)
=>
{ pp.box' 0 0 {. pp.rulename "ppdscb42";
pp.lit "pkg";
pp.ind 4;
pp.txt " ";
pp.lit "...";
# unparse_naming not yet undefined
/*
uj::unparse_sequence pp
{ separator => pp::newline,
print_one => (\\ pp => \\ b => unparse_naming context pp (b, d - 1)),
breakstyle => uj::ALIGN
}
namings;
*/
pp.ind 0;
pp.txt " ";
pp.lit "end";
};
};
prettyprint_package_expression' (ds::PACKAGE_LET { declaration, expression }, d)
=>
{ pp.box' 0 0 {. pp.rulename "ppdscb43";
pp.lit "stipulate";
pp.ind 4;
pp.txt " ";
prettyprint_declaration context pp (declaration, d - 1);
pp.ind 0;
pp.txt " ";
pp.lit "herein";
pp.ind 4;
pp.txt " ";
prettyprint_package_expression' (expression, d - 1);
pp.ind 0;
pp.txt " ";
pp.lit "end";
};
};
prettyprint_package_expression' (ds::SOURCE_CODE_REGION_FOR_PACKAGE (body, (s, e)), d)
=>
case source_opt
#
THE source
=>
{
# 2007-09-14CrT: Source region stuff commented out because it clutters the printout horribly:
# pp.lit "SOURCE_CODE_REGION_FOR_PACKAGE(";
prettyprint_package_expression' (body, d);
# pp.lit ", ";
# prpos (pp, source, s); # "s" for "start"
# pp.lit ", ";
# prpos (pp, source, e); # "e" for "end"
# pp.lit ")";
};
NULL => prettyprint_package_expression' (body, d);
esac;
prettyprint_package_expression' _
=>
bug "unexpected package expression in prettyprintStrexp'";
end;
prettyprint_package_expression';
}
also
fun prettyprint_generic_expression (context as (_, source_opt)) pp
=
prettyprint_generic_expression'
where
fun prettyprint_generic_expression' (_, 0)
=>
pp.lit "<generic_expression>";
prettyprint_generic_expression' (ds::GENERIC_BY_NAME (mld::GENERIC { varhome, ... } ), d)
=>
ppv::prettyprint_varhome pp varhome;
prettyprint_generic_expression' (ds::GENERIC_DEFINITION { parameter=>mld::A_PACKAGE { varhome, ... }, definition=>def, ... }, d)
=>
pp.box' 0 0 {.
pp.lit " GENERIC(";
ppv::prettyprint_varhome pp varhome;
pp.txt ") => ";
prettyprint_package_expression context pp (def, d - 1);
};
prettyprint_generic_expression' (ds::GENERIC_LET (declaration, body), d)
=>
{ pp.box' 0 0 {. pp.rulename "ppdscb44";
pp.lit "stipulate";
pp.ind 4;
pp.txt " ";
prettyprint_declaration context pp (declaration, d - 1);
pp.ind 0;
pp.txt " ";
pp.lit "herein";
pp.ind 4;
pp.txt " ";
prettyprint_generic_expression' (body, d - 1);
pp.ind 0;
pp.txt " ";
pp.lit "end";
};
};
prettyprint_generic_expression' (ds::SOURCE_CODE_REGION_FOR_GENERIC (body, (s, e)), d)
=>
case source_opt
#
THE source
=>
{
# 2007-09-14CrT: Source region stuff commented out because it clutters the printout horribly:
# pp.lit "SOURCE_CODE_REGION_FOR_GENERIC(";
prettyprint_generic_expression' (body, d); pp.lit ", ";
# prpos (pp, source, s); pp.lit ", ";
# prpos (pp, source, e); pp.lit ")";
};
NULL => prettyprint_generic_expression' (body, d);
esac;
prettyprint_generic_expression' _
=>
bug "unexpected generic package expression in prettyprint_generic_expression'";
end;
end;
}; # package unparse_deep_syntax
end; # top-level stipulate