## unparse-raw-syntax.pkg
## Jing Cao and Lukasz Ziarek
# Compiled by:
# src/lib/compiler/front/typer/typer.sublib# We refer to a literal dump of the raw syntax tree as "prettyprinting".
# We refer to reconstruction of surface syntax from the raw syntax tree as "unparsing".
# Unparsing is good for end-user diagnostics; prettyprinting is good for compiler debugging.
# This is the implementation of our raw syntax unparser.
# For our raw syntax prettyprinter, see src/lib/compiler/front/typer/print/prettyprint-raw-syntax.pkgstipulate
package bt = type_types; # type_types is from src/lib/compiler/front/typer/types/type-types.pkg package err = error_message; # error_message is from src/lib/compiler/front/basics/errormsg/error-message.pkg package pp = prettyprint; # prettyprint is from src/lib/prettyprint/big/src/prettyprint.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 tc = typer_control; # typer_control is from src/lib/compiler/front/typer/basics/typer-control.pkg #
include raw_syntax; # raw_syntax is from src/lib/compiler/front/parser/raw-syntax/raw-syntax.pkg include tuples; # tuples is from src/lib/compiler/front/typer-stuff/types/tuples.pkg include fixity; # fixity is from src/lib/compiler/front/basics/map/fixity.pkg include variables_and_constructors; # variables_and_constructors is from src/lib/compiler/front/typer-stuff/deep-syntax/variables-and-constructors.pkg include prettyprint;
include unparse_junk; # unparse_junk is from src/lib/compiler/front/typer/print/unparse-junk.pkg include unparse_type; # unparse_type is from src/lib/compiler/front/typer/print/unparse-type.pkg include unparse_value; # unparse_value is from src/lib/compiler/front/typer/print/unparse-value.pkgherein
package unparse_raw_syntax
: (weak) Unparse_Raw_Syntax # Unparse_Raw_Syntax is from src/lib/compiler/front/typer/print/unparse-raw-syntax.api {
internals = tc::internals;
lineprint = REF FALSE;
fun by f x y
=
f y x;
null_fix = INFIX (0, 0);
inf_fix = INFIX (1000000, 100000);
fun stronger_l (INFIX(_, m), INFIX (n, _)) => m >= n;
stronger_l _ => FALSE; # should not matter
end;
fun stronger_r (INFIX(_, m), INFIX (n, _)) => n > m;
stronger_r _ => TRUE; # should not matter
end;
fun prpos ( stream: pp::Stream,
source: sci::Sourcecode_Info,
charpos: Int
)
=
if *lineprint
my (file: String, line: Int, pos: Int)
=
sci::filepos source charpos;
pp::string stream (int::to_string line);
pp::string stream ".";
pp::string stream (int::to_string pos);
else
pp::string stream (int::to_string charpos);
fi;
fun bug msg
=
error_message::impossible("unparse_raw_syntax: " + msg);
arrow_stamp = bt::arrow_stamp;
fun strength (type)
=
case type
#
TYPE_VARIABLE_TYPE(_) => 1;
TYP_TYPE (typ, args)
=>
case typ
#
[typ]
=>
if (sy::eq (sy::make_type_symbol("->"), typ)) 0;
else 2;
fi;
_ => 2;
esac;
RECORD_TYPE _ => 2;
TUPLE_TYPE _ => 1;
_ => 2;
esac;
fun checkpat (n, NIL)
=>
TRUE;
checkpat (n, (symbol, _) ! fields)
=>
sy::eq (symbol, number_to_label n)
and
checkpat (n+1, fields);
end;
fun checkexp (n, NIL)
=>
TRUE;
checkexp (n, (symbol, expression) ! fields)
=>
sy::eq (symbol, number_to_label n)
and
checkexp (n+1, fields);
end;
fun is_tuplepat (RECORD_PATTERN { definition => [_], ... } ) => FALSE;
is_tuplepat (RECORD_PATTERN { definition => defs, is_incomplete => FALSE } ) => checkpat (1, defs);
is_tuplepat _ => FALSE;
end;
fun is_tupleexp (RECORD_IN_EXPRESSION [_]) => FALSE;
is_tupleexp (RECORD_IN_EXPRESSION fields) => checkexp (1, fields);
is_tupleexp (SOURCE_CODE_REGION_FOR_EXPRESSION (a, _)) => is_tupleexp a;
is_tupleexp _ => FALSE;
end;
fun get_fix (dictionary, symbol)
=
find_in_symbolmapstack::find_fixity_by_symbol (
dictionary,
sy::make_fixity_symbol (sy::name symbol)
);
fun strip_source_code_region_data (SOURCE_CODE_REGION_FOR_EXPRESSION (a, _))
=>
strip_source_code_region_data a;
strip_source_code_region_data x
=>
x;
end;
fun trim [x] => [];
trim (a ! b) => a ! trim b;
trim [] => [];
end;
fun pp_path stream symbols
=
{ fun pr stream (symbol)
=
unparse_symbol stream symbol;
unparse_sequence
stream
{ sep => (fn stream = (pp::string stream "::")), # Was "."
pr,
style => INCONSISTENT
}
symbols;
};
fun unparse_pattern (context as (dictionary, source_opt)) stream
=
{ ppsay = pp::string stream;
pp_symbol_list = pp_path stream;
fun unparse_pattern' (WILDCARD_PATTERN, _) => ppsay "_";
unparse_pattern' (VARIABLE_IN_PATTERN p, d) => pp_symbol_list (p);
unparse_pattern' (INT_CONSTANT_IN_PATTERN i, _) => ppsay (multiword_int::to_string i);
unparse_pattern' (UNT_CONSTANT_IN_PATTERN w, _) => ppsay (multiword_int::to_string w);
unparse_pattern' (STRING_CONSTANT_IN_PATTERN s, _) => unparse_mlstring stream s;
unparse_pattern' (CHAR_CONSTANT_IN_PATTERN s, _) => unparse_mlstring' stream s;
unparse_pattern' (AS_PATTERN { variable_pattern, expression_pattern }, d)
=>
{ begin_horizontal_else_vertical_box stream;
unparse_pattern'(variable_pattern, d); ppsay " as "; unparse_pattern'(expression_pattern, d - 1);
end_box stream;
};
unparse_pattern' (RECORD_PATTERN { definition => [], is_incomplete }, _)
=>
if is_incomplete ppsay "{ ... }";
else ppsay "()";
fi;
unparse_pattern' (r as RECORD_PATTERN { definition, is_incomplete }, d)
=>
if (is_tuplepat r)
unparse_closed_sequence
stream
{ front => (by pp::string "("),
sep => (fn stream
=
{ pp::string stream ", ";
break stream { spaces=>0, indent_on_wrap=>0 };
}
),
back => (by pp::string ")"),
pr => (fn _ = fn (symbol, pattern) = unparse_pattern' (pattern, d - 1)),
style => INCONSISTENT
}
definition;
else
unparse_closed_sequence
stream
{ front => (by pp::string "{ "),
sep => (fn stream = { pp::string stream ", ";
break stream { spaces=>0, indent_on_wrap=>0 };
}
),
back => (fn stream = if is_incomplete pp::string stream ", ... }";
else pp::string stream "}";
fi
),
pr => (fn stream = fn (symbol, pattern) = { unparse_symbol stream symbol;
pp::string stream " => ";
unparse_pattern' (pattern, d - 1);
}
),
style => INCONSISTENT
}
definition;
fi;
unparse_pattern' (LIST_PATTERN NIL, d) => ppsay "[]";
unparse_pattern' (LIST_PATTERN l, d)
=>
{ fun pr _ pattern
=
unparse_pattern' (pattern, d - 1);
unparse_closed_sequence
stream
{ front => (by pp::string "["),
sep => (fn stream = { pp::string stream ", ";
break stream { spaces=>0, indent_on_wrap=>0 };
}
),
back => (by pp::string "]"),
pr,
style => INCONSISTENT
}
l;
};
unparse_pattern' (TUPLE_PATTERN t, d)
=>
{ fun pr _ pattern
=
unparse_pattern'(pattern, d - 1);
unparse_closed_sequence
stream
{ front => (by pp::string "("),
sep => (fn stream = { pp::string stream ", ";
break stream { spaces=>0, indent_on_wrap=>0 };
}
),
back => (by pp::string ")"),
pr,
style => INCONSISTENT
}
t;
};
unparse_pattern' (PRE_FIXITY_PATTERN fap, d)
=>
{ fun pr _ { item, fixity, source_code_region }
=
unparse_pattern'(item, d - 1);
unparse_sequence
stream
{ sep => (fn stream = (break stream { spaces=>1, indent_on_wrap=>0 } )),
pr,
style => INCONSISTENT
}
fap;
};
unparse_pattern' (APPLY_PATTERN { constructor, argument }, d)
=>
{ begin_horizontal_else_vertical_box stream;
unparse_pattern' (constructor, d);
ppsay " as ";
unparse_pattern'(argument, d);
end_box stream;
};
unparse_pattern' (TYPE_CONSTRAINT_PATTERN { pattern, type_constraint }, d)
=>
{ begin_wrap_box stream;
unparse_pattern' (pattern, d - 1);
ppsay " :";
break stream { spaces => 1, indent_on_wrap => 2 };
unparse_type context stream (type_constraint, d);
end_box stream;
};
unparse_pattern' (VECTOR_PATTERN NIL, d)
=>
ppsay "#[]";
unparse_pattern' (VECTOR_PATTERN v, d)
=>
{ fun pr _ pattern
=
unparse_pattern'(pattern, d - 1);
unparse_closed_sequence
stream
{ front => (by pp::string "#["),
sep => (fn stream = { pp::string stream ", ";
break stream { spaces=>1, indent_on_wrap=>0 };
}
),
back => (by pp::string "]"),
pr,
style => INCONSISTENT
}
v;
};
unparse_pattern' (SOURCE_CODE_REGION_FOR_PATTERN (pattern, (s, e)), d)
=>
case source_opt
THE source
=>
if *internals
ppsay "<MARK(";
prpos (stream, source, s); ppsay ", ";
prpos (stream, source, e); ppsay "): ";
unparse_pattern'(pattern, d); ppsay ">";
else
unparse_pattern'(pattern, d);
fi;
NULL => unparse_pattern'(pattern, d);
esac;
unparse_pattern' (OR_PATTERN orpat, d)
=>
{ fun pr _ pattern
=
unparse_pattern'(pattern, d - 1);
unparse_closed_sequence
stream
{ front => (by pp::string "("),
sep => (fn stream = { break stream { spaces=>1, indent_on_wrap=>0 }; pp::string stream "| ";}),
back => (by pp::string ")"),
pr,
style => INCONSISTENT
};
}
orpat;
end;
unparse_pattern';
}
also
fun unparse_expression (context as (dictionary, source_opt)) stream
=
{ ppsay = pp::string stream;
fun lparen () = ppsay "(";
fun rparen () = ppsay ")";
fun lpcond (atom) = if atom ppsay "("; fi;
fun rpcond (atom) = if atom ppsay ")"; fi;
pp_symbol_list = pp_path stream;
fun unparse_expression' (_, _, 0) => ppsay "<expression>";
unparse_expression' (VARIABLE_IN_EXPRESSION p, _, _) => pp_symbol_list p;
unparse_expression' (IMPLICIT_THUNK_PARAMETER p, _, _) => { ppsay "#"; pp_symbol_list p; };
unparse_expression' (FN_EXPRESSION NIL, _, d) => ppsay "<function>";
unparse_expression' (FN_EXPRESSION rules, _, d)
=>
{ fun pr _ pattern
=
unparse_rule context stream (pattern, d - 1);
unparse_sequence
stream
{ sep => (fn stream = { pp::string stream "|";break stream { spaces=>0, indent_on_wrap=>0 }; }),
pr,
style => INCONSISTENT
}
rules;
};
unparse_expression' (PRE_FIXITY_EXPRESSION fap, _, d)
=>
{ fun pr _ { item, fixity, source_code_region }
=
unparse_expression'(item, TRUE, d);
unparse_sequence
stream
{ sep => (fn stream = (break stream { spaces=>1, indent_on_wrap=>0 } )),
pr,
style => INCONSISTENT
}
fap;
};
unparse_expression' (e as APPLY_EXPRESSION _, atom, d)
=>
{ lpcond atom;
unparse_app_expression (e, null_fix, null_fix, d);
rpcond atom;
};
unparse_expression' (OBJECT_FIELD_EXPRESSION { object, field }, _, d)
=>
{ unparse_expression' (object, TRUE, d - 1);
ppsay "->";
unparse_symbol stream field;
};
unparse_expression' (CASE_EXPRESSION { expression, rules }, _, d)
=>
{ begin_horizontal_else_vertical_box stream;
ppsay "case ("; # Was "(case ";
unparse_expression'(expression, TRUE, d - 1);
newline stream; # Was newline_indent stream 2;
ppvlist stream (
") ",
";", # Was " | ",
(fn stream = fn r = unparse_rule context stream (r, d - 1)),
trim rules
);
ppsay "esac;"; # Was rparen();
end_box stream;
};
unparse_expression' (LET_EXPRESSION { declaration, expression }, _, d)
=>
{ begin_horizontal_else_vertical_box stream;
ppsay "stipulate ";
begin_horizontal_else_vertical_box stream;
unparse_declaration context stream (declaration, d - 1);
end_box stream;
break stream { spaces=>1, indent_on_wrap=>0 };
ppsay "herein ";
begin_horizontal_else_vertical_box stream;
unparse_expression'(expression, FALSE, d - 1);
end_box stream;
break stream { spaces=>1, indent_on_wrap=>0 };
ppsay "end";
end_box stream;
};
unparse_expression' (SEQUENCE_EXPRESSION exps, _, d)
=>
unparse_closed_sequence
stream
{ front => (by pp::string "("),
sep => (fn stream = { pp::string stream ";";
break stream { spaces=>1, indent_on_wrap=>0 };
}
),
back => (by pp::string ")"),
pr => (fn _ = fn expression = unparse_expression'(expression, FALSE, d - 1)),
style => INCONSISTENT
}
exps;
unparse_expression' ( INT_CONSTANT_IN_EXPRESSION i, _, _) => ppsay (multiword_int::to_string i);
unparse_expression' ( UNT_CONSTANT_IN_EXPRESSION w, _, _) => ppsay (multiword_int::to_string w);
unparse_expression' ( FLOAT_CONSTANT_IN_EXPRESSION r, _, _) => ppsay r;
unparse_expression' (STRING_CONSTANT_IN_EXPRESSION s, _, _) => unparse_mlstring stream s;
unparse_expression' ( CHAR_CONSTANT_IN_EXPRESSION s, _, _) => unparse_mlstring' stream s;
unparse_expression'(r as RECORD_IN_EXPRESSION fields, _, d)
=>
if (is_tupleexp r)
#
unparse_closed_sequence
stream
{ front => (by pp::string "("),
back => (by pp::string ")"),
pr => (fn _ = fn (_, expression) = unparse_expression'(expression, FALSE, d - 1)),
style => INCONSISTENT,
sep => (fn stream = { pp::string stream ", ";
break stream { spaces=>0, indent_on_wrap=>0 };
}
)
}
fields;
else
unparse_closed_sequence
stream
{ front => (by pp::string "{ "),
sep => (fn stream = { pp::string stream ", ";
break stream { spaces=>0, indent_on_wrap=>0 } ;}
),
back => (by pp::string "}"),
pr => (fn stream = fn (name, expression)
=
{ unparse_symbol stream name;
ppsay " => ";
unparse_expression'(expression, FALSE, d);
}
),
style => INCONSISTENT
}
fields;
fi;
unparse_expression' (LIST_EXPRESSION p, _, d)
=>
unparse_closed_sequence
stream
{ front => (by pp::string "["),
sep => (fn stream = { pp::string stream ", ";
break stream { spaces=>0, indent_on_wrap=>0 } ;}
),
back => (by pp::string "]"),
pr => (fn stream =
fn expression =
(unparse_expression'(expression, FALSE, d - 1))
),
style => INCONSISTENT
}
p;
unparse_expression' (TUPLE_EXPRESSION p, _, d)
=>
unparse_closed_sequence
stream
{ front => (by pp::string "("),
sep => (fn stream = { pp::string stream ", ";
break stream { spaces=>0, indent_on_wrap=>0 };
}
),
back => (by pp::string ")"),
pr => (fn stream =
fn expression = (unparse_expression'(expression, FALSE, d - 1))
),
style => INCONSISTENT
}
p;
unparse_expression'(RECORD_SELECTOR_EXPRESSION name, atom, d)
=>
{ begin_horizontal_else_vertical_box stream;
# lpcond (atom); # Seems like pure clutter so commented out 2009-08-06 CrT
ppsay "."; # Was "#"
unparse_symbol stream name;
# rpcond (atom);
end_box stream;
};
unparse_expression' (TYPE_CONSTRAINT_EXPRESSION { expression, constraint }, atom, d)
=>
{ begin_wrap_box stream;
lpcond (atom);
unparse_expression'(expression, FALSE, d); ppsay ":";
break stream { spaces=>1, indent_on_wrap=>2 };
unparse_type context stream (constraint, d);
rpcond (atom);
end_box stream;
};
unparse_expression'(EXCEPT_EXPRESSION { expression, rules }, atom, d)
=>
{ begin_horizontal_else_vertical_box stream;
lpcond atom;
unparse_expression'(expression, atom, d - 1);
newline stream;
ppsay "except ";
newline_indent stream 2;
ppvlist stream (
" ",
"; ", # Was "| ",
(fn stream = fn r = unparse_rule context stream (r, d - 1)),
rules
);
rpcond atom;
end_box stream;
};
unparse_expression' (RAISE_EXPRESSION expression, atom, d)
=>
{ begin_horizontal_else_vertical_box stream;
lpcond atom;
ppsay "raise exception ";
unparse_expression'(expression, TRUE, d - 1);
rpcond atom;
end_box stream;
};
unparse_expression' (IF_EXPRESSION { test_case, then_case, else_case }, atom, d)
=>
{ begin_horizontal_else_vertical_box stream;
lpcond (atom);
ppsay "if ";
begin_horizontal_else_vertical_box stream;
unparse_expression' (test_case, FALSE, d - 1);
end_box stream;
break stream { spaces=>1, indent_on_wrap=> 0 };
ppsay "then ";
begin_horizontal_else_vertical_box stream;
unparse_expression' (then_case, FALSE, d - 1);
end_box stream;
break stream { spaces=>1, indent_on_wrap=> 0 };
ppsay "else ";
begin_horizontal_else_vertical_box stream;
unparse_expression' (else_case, FALSE, d - 1);
end_box stream;
rpcond (atom);
end_box stream;
};
unparse_expression' (AND_EXPRESSION (e1, e2), atom, d)
=>
{ begin_horizontal_else_vertical_box stream;
lpcond (atom);
begin_horizontal_else_vertical_box stream;
unparse_expression' (e1, TRUE, d - 1);
end_box stream;
break stream { spaces=>1, indent_on_wrap=> 0 };
ppsay "and ";
begin_horizontal_else_vertical_box stream;
unparse_expression' (e2, TRUE, d - 1);
end_box stream;
rpcond (atom);
end_box stream;
};
unparse_expression' (OR_EXPRESSION (e1, e2), atom, d)
=>
{ begin_horizontal_else_vertical_box stream;
lpcond (atom);
begin_horizontal_else_vertical_box stream;
unparse_expression' (e1, TRUE, d - 1);
end_box stream;
break stream { spaces=>1, indent_on_wrap=> 0 };
ppsay "or ";
begin_horizontal_else_vertical_box stream;
unparse_expression' (e2, TRUE, d - 1);
end_box stream;
rpcond (atom);
end_box stream;
};
unparse_expression' (WHILE_EXPRESSION { test, expression }, atom, d)
=>
{ begin_horizontal_else_vertical_box stream;
ppsay "while ";
begin_horizontal_else_vertical_box stream;
unparse_expression'(test, FALSE, d - 1);
end_box stream;
break stream { spaces=>1, indent_on_wrap=> 0 };
ppsay "do ";
begin_horizontal_else_vertical_box stream;
unparse_expression'(expression, FALSE, d - 1);
end_box stream;
end_box stream;
};
unparse_expression'(VECTOR_IN_EXPRESSION NIL, _, d) => ppsay "#[]";
unparse_expression' (VECTOR_IN_EXPRESSION exps, _, d)
=>
{ fun pr _ expression
=
unparse_expression'(expression, FALSE, d - 1);
unparse_closed_sequence
stream
{ front => (by pp::string "#["),
sep => (fn stream = { pp::string stream ", ";
break stream { spaces=>1, indent_on_wrap=>0 };
}
),
back => (by pp::string "]"),
pr,
style => INCONSISTENT
}
exps;
};
unparse_expression' (SOURCE_CODE_REGION_FOR_EXPRESSION (expression, (s, e)), atom, d)
=>
case source_opt
#
THE source
=>
if *internals
ppsay "<MARK(";
prpos (stream, source, s); ppsay ", ";
prpos (stream, source, e); ppsay "): ";
unparse_expression'(expression, FALSE, d); ppsay ">";
else
unparse_expression'(expression, atom, d);
fi;
NULL => unparse_expression'(expression, atom, d);
esac;
end
also
fun unparse_app_expression (_, _, _, 0)
=>
pp::string stream "<expression>";
unparse_app_expression arg
=>
{ ppsay = pp::string stream;
fun fixitypp (name, operand, left_fix, right_fix, d)
=
{ dname = symbol_path::to_string (symbol_path::SYMBOL_PATH name);
this_fix = case name
[id] => get_fix (dictionary, id);
_ => NONFIX;
esac;
fun pr_non expression
=
{ begin_indented_wrap_box stream (pp::CURSOR_RELATIVE 2);
ppsay dname; break stream { spaces=>1, indent_on_wrap=>0 };
unparse_expression'(expression, TRUE, d - 1);
end_box stream;
};
case this_fix
INFIX _
=>
case (strip_source_code_region_data operand)
RECORD_IN_EXPRESSION [(_, pl), (_, pr)]
=>
{ atom = stronger_l (left_fix, this_fix) or
stronger_r (this_fix, right_fix);
my (left, right)
=
if atom (null_fix, null_fix);
else (left_fix, right_fix);fi;
{ begin_indented_wrap_box stream (pp::CURSOR_RELATIVE 2);
lpcond (atom);
unparse_app_expression (pl, left, this_fix, d - 1);
break stream { spaces=>1, indent_on_wrap=>0 };
ppsay dname;
break stream { spaces=>1, indent_on_wrap=>0 };
unparse_app_expression (pr, this_fix, right, d - 1);
rpcond (atom);
end_box stream;
};
};
e' => pr_non e';
esac;
NONFIX => pr_non operand;
esac;
};
fun apply_print (_, _, _, 0)
=>
ppsay "#";
apply_print (APPLY_EXPRESSION { function=>operator, argument=>operand }, l, r, d)
=>
case (strip_source_code_region_data operator)
#
VARIABLE_IN_EXPRESSION v
=>
{ path = v;
fixitypp (path, operand, l, r, d);
};
operator
=>
{ begin_indented_wrap_box stream (pp::CURSOR_RELATIVE 2);
unparse_expression'(operator, TRUE, d - 1); break stream { spaces=>1, indent_on_wrap=>2 };
unparse_expression'(operand, TRUE, d - 1);
end_box stream;
};
esac;
apply_print (SOURCE_CODE_REGION_FOR_EXPRESSION (expression, (s, e)), l, r, d)
=>
case source_opt
THE source
=>
if *internals
ppsay "<MARK(";
prpos (stream, source, s); ppsay ", ";
prpos (stream, source, e); ppsay "): ";
unparse_expression'(expression, FALSE, d);
ppsay ">";
else
apply_print (expression, l, r, d);
fi;
NULL => apply_print (expression, l, r, d);
esac;
apply_print (e, _, _, d)
=>
unparse_expression'(e, TRUE, d);
end;
apply_print arg;
};
end;
fn (expression, depth)
=
unparse_expression' (expression, FALSE, depth);
}
also
fun unparse_rule (context as (dictionary, source_opt)) stream (CASE_RULE { pattern, expression }, d)
=
if (d>0)
#
begin_horizontal_else_vertical_box stream;
unparse_pattern context stream (pattern, d - 1);
pp::string stream " =>";
break stream { spaces=>1, indent_on_wrap=>2 };
unparse_expression context stream (expression, d - 1);
end_box stream;
else
pp::string stream "<rule>";
fi
also
fun unparse_package_cast (context as (_, source_opt)) stream package_cast d
=
{ ppsay = pp::string stream;
#
case package_cast
#
NO_PACKAGE_CAST
=>
();
WEAK_PACKAGE_CAST api_expression
=>
{ ppsay " : (weak)";
break stream { spaces=>1, indent_on_wrap=>2 };
unparse_api_expression context stream (api_expression, d - 1);
};
PARTIAL_PACKAGE_CAST api_expression
=>
{ ppsay " : (partial)";
break stream { spaces=>1, indent_on_wrap=>2 };
unparse_api_expression context stream (api_expression, d - 1);
};
STRONG_PACKAGE_CAST api_expression
=>
{ ppsay " : ";
break stream { spaces=>1, indent_on_wrap=>2 };
unparse_api_expression context stream (api_expression, d - 1);
};
esac;
}
also
fun unparse_package_expression (context as (_, source_opt)) stream
=
{ ppsay = pp::string stream;
pp_symbol_list = pp_path stream;
fun unparse_package_expression'(_, 0)
=>
ppsay "<package_expression>";
unparse_package_expression'(PACKAGE_BY_NAME p, d)
=>
pp_symbol_list (p);
unparse_package_expression'(PACKAGE_DEFINITION (SEQUENTIAL_DECLARATIONS NIL), d)
=>
{ ppsay "package {";
nonbreakable_spaces stream 1;
ppsay "};";
};
unparse_package_expression'(PACKAGE_DEFINITION de, d)
=>
{ begin_vertical_box stream;
ppsay "package {";
unparse_junk::newline_indent stream 2;
unparse_declaration context stream (de, d - 1);
ppsay "};";
end_box stream;
};
unparse_package_expression' (PACKAGE_CAST (stre, constraint), d)
=>
{ begin_wrap_box stream;
unparse_package_expression' (stre, d - 1);
unparse_package_cast context stream constraint d;
end_box stream;
};
unparse_package_expression'(CALL_OF_GENERIC (path, str_list), d)
=>
{ fun pr stream (strl, bool)
=
{ ppsay "("; unparse_package_expression context stream (strl, d); ppsay ")";};
pp_symbol_list (path);
unparse_sequence
stream
{ sep => (fn stream = (break stream { spaces=>1, indent_on_wrap=>0 } )),
pr,
style => INCONSISTENT
}
str_list;
};
unparse_package_expression'(INTERNAL_CALL_OF_GENERIC (path, str_list), d)
=>
{ fun pr stream (strl, bool)
=
{ ppsay "(";
unparse_package_expression context stream (strl, d);
ppsay ")";
};
pp_symbol_list (path);
unparse_sequence
stream
{ sep => (fn stream = (break stream { spaces=>1, indent_on_wrap=>0 } )),
pr,
style => INCONSISTENT
}
str_list;
};
unparse_package_expression' (LET_IN_PACKAGE (declaration, body), d)
=>
{ begin_horizontal_else_vertical_box stream;
ppsay "stipulate ";
unparse_declaration context stream (declaration, d - 1);
newline stream;
ppsay " herein ";
unparse_package_expression'(body, d - 1);
newline stream;
ppsay "end";
end_box stream;
};
unparse_package_expression' (SOURCE_CODE_REGION_FOR_PACKAGE (body, (s, e)), d)
=>
unparse_package_expression' (body, d);
end;
# (case source_opt
# of THE source =>
# (ppsay "SOURCE_CODE_REGION_FOR_PACKAGE(";
# prettyprintPackageexpression'(body, d); ppsay ", ";
# prpos (stream, source, s); ppsay ", ";
# prpos (stream, source, e); ppsay ")")
# | NULL => prettyprintPackageexpression'(body, d))
unparse_package_expression';
}
also
fun unparse_generic_expression (context as (_, source_opt)) stream
=
{ ppsay = pp::string stream;
pp_symbol_list = pp_path stream;
fun unparse_generic_expression'(_, 0)
=>
ppsay "<generic_expression>";
unparse_generic_expression'(GENERIC_BY_NAME (p, _), d)
=>
pp_symbol_list (p);
unparse_generic_expression'(LET_IN_GENERIC (declaration, body), d)
=>
{ begin_horizontal_else_vertical_box stream;
ppsay "stipulate ";
unparse_declaration context stream (declaration, d - 1);
newline stream;
ppsay " herein ";
unparse_generic_expression'(body, d - 1);
newline stream;
ppsay "end";
end_box stream;
};
unparse_generic_expression'(CONSTRAINED_CALL_OF_GENERIC (path, sblist, fsigconst), d)
=>
{ fun pr stream (package_expression, _)
=
{ ppsay "(";
unparse_package_expression context stream (package_expression, d);
ppsay ")";
};
begin_horizontal_else_vertical_box stream;
pp_symbol_list path;
unparse_sequence
stream
{ sep => (fn stream = (break stream { spaces=>1, indent_on_wrap=>0 } )),
pr,
style => INCONSISTENT
}
sblist;
end_box stream;
};
unparse_generic_expression'(SOURCE_CODE_REGION_FOR_GENERIC (body, (s, e)), d)
=>
unparse_generic_expression' (body, d);
unparse_generic_expression'(GENERIC_DEFINITION _, d)
=>
error_message::impossible "prettyprintGenericexpression: GENERIC_DEFINITION";
end;
unparse_generic_expression';
}
also
fun unparse_where_spec (context as (dictionary, source_opt)) stream
=
{ ppsay = pp::string stream;
fun unparse_where_spec'(_, 0)
=>
ppsay "<WhereSpec>";
unparse_where_spec'(WHERE_TYPE([],[], type), d)
=>
unparse_type context stream (type, d);
unparse_where_spec'(WHERE_TYPE (slist, tvlist, type), d)
=>
{ fun pr _ symbol
=
unparse_symbol stream symbol;
fun pr' _ tyv
=
unparse_type_variable context stream (tyv, d);
ppsay "typeX ";
unparse_sequence
stream
{ sep => (fn stream = (break stream { spaces=>1, indent_on_wrap=>0 } )),
pr => pr',
style => INCONSISTENT
}
tvlist;
break stream { spaces=>1, indent_on_wrap=>0 };
unparse_sequence
stream
{ sep => (fn stream = (break stream { spaces=>1, indent_on_wrap=>0 } )),
pr,
style => INCONSISTENT
}
slist;
ppsay" =";
break stream { spaces=>1, indent_on_wrap=>0 };
unparse_type context stream (type, d);
};
unparse_where_spec' (WHERE_PACKAGE (slist, slist'), d)
=>
{ fun pr _ symbol
=
unparse_symbol stream symbol;
ppsay "packageZ ";
unparse_sequence
stream
{ sep => (fn stream = (break stream { spaces=>1, indent_on_wrap=>0 } )),
pr,
style => INCONSISTENT
}
slist;break stream { spaces=>1, indent_on_wrap=>0 };
unparse_sequence
stream
{ sep => (fn stream = (break stream { spaces=>1, indent_on_wrap=>0 } )),
pr,
style => INCONSISTENT
}
slist';
};
end;
unparse_where_spec';
}
also
fun unparse_api_expression (context as (dictionary, source_opt)) stream
=
{ ppsay = pp::string stream;
#
fun unparse_api_expression'(_, 0)
=>
ppsay "<api_expression>";
unparse_api_expression'(API_BY_NAME s, d)
=>
unparse_symbol stream s;
unparse_api_expression'(API_WITH_WHERE_SPECS (an_api, wherel), d)
=>
{ unparse_api_expression' (an_api, d);
break stream { spaces=>1, indent_on_wrap=>0 };
case an_api
#
API_BY_NAME s
=>
ppvlist stream (
"where ",
"also ",
(fn stream = fn r = unparse_where_spec context stream (r, d - 1)),
wherel
);
SOURCE_CODE_REGION_FOR_API (API_BY_NAME s, r)
=>
ppvlist stream (
"where ",
"also ",
(fn stream = fn r = unparse_where_spec context stream (r, d - 1)),
wherel
);
_ =>
{ newline stream;
#
ppvlist stream (
"where ",
"also ",
(fn stream = fn r = unparse_where_spec context stream (r, d - 1)),
wherel
);
};
esac;
};
unparse_api_expression' (API_DEFINITION [], d)
=>
{ ppsay "api {";
nonbreakable_spaces stream 1;
ppsay "};";
};
unparse_api_expression'(API_DEFINITION specl, d)
=>
{ fun pr stream speci
=
unparse_specification context stream (speci, d);
newline stream; # XXX BUGGO TEST ONLY
ppsay "api {";
begin_vertical_box stream;
newline stream;
# unparse_junk::newline_indent stream 4;
unparse_sequence
stream
{ sep => (fn stream = newline stream),
pr,
style => INCONSISTENT
}
specl;
end_box stream;
newline stream;
ppsay "};";
};
unparse_api_expression'(SOURCE_CODE_REGION_FOR_API (m, r), d)
=>
unparse_api_expression context stream (m, d);
end;
unparse_api_expression';
}
also
fun unparse_generic_api_expression (context as (dictionary, source_opt)) stream
=
{ ppsay = pp::string stream;
#
fun unparse_generic_api_expression'(_, 0)
=>
ppsay "<generic_api_expression>";
unparse_generic_api_expression'(GENERIC_API_BY_NAME s, d)
=>
unparse_symbol stream s;
unparse_generic_api_expression'(GENERIC_API_DEFINITION { parameter, result }, d)
=>
{ fun pr stream (THE symbol, api_expression)
=>
{ ppsay "(";
unparse_symbol stream symbol;
ppsay ":";
unparse_api_expression context stream (api_expression, d);
ppsay ")";
};
pr stream (NULL, api_expression)
=>
{ ppsay "("; unparse_api_expression context stream (api_expression, d);
ppsay ")";
};
end;
unparse_sequence
stream
{ sep => (fn stream = (newline stream)),
pr,
style => INCONSISTENT
}
parameter;
break stream { spaces=>1, indent_on_wrap=>2 };
ppsay "=> ";
unparse_api_expression context stream (result, d);
};
unparse_generic_api_expression' (SOURCE_CODE_REGION_FOR_GENERIC_API (m, r), d)
=>
unparse_generic_api_expression context stream (m, d);
end;
unparse_generic_api_expression';
}
also
fun unparse_specification (context as (dictionary, source_opt)) stream
=
{ ppsay = pp::string stream;
#
fun pp_tyvar_list ([], d)
=>
();
pp_tyvar_list ( [type_variable], d)
=>
{ unparse_type_variable context stream (type_variable, d);
break stream { spaces=>1, indent_on_wrap=>0 };
};
pp_tyvar_list (tyvar_list, d)
=>
{ fun pr _ type_variable
=
(unparse_type_variable context stream (type_variable, d));
unparse_closed_sequence
stream
{ front => (fn stream = pp::string stream "("),
sep => { pp::string stream ", "; fn stream = (break stream { spaces=>1, indent_on_wrap=>0 } ); },
back => { pp::string stream ")" ; fn stream = (break stream { spaces=>1, indent_on_wrap=>0 } ); },
pr,
style => INCONSISTENT
}
tyvar_list;
};
end;
fun unparse_specification'(_, 0)
=>
ppsay "<Specification>";
unparse_specification'(PACKAGES_IN_API sspo_list, d)
=>
{ fun pr _ (symbol, api_expression, path)
=
case path
THE p => { unparse_symbol stream symbol;
ppsay " = ";
unparse_api_expression context stream (api_expression, d);
break stream { spaces=>1, indent_on_wrap=>0 };
pp_path stream p;
};
NULL => { unparse_symbol stream symbol;
ppsay " = ";
unparse_api_expression context stream (api_expression, d);
};
esac;
unparse_closed_sequence
stream
{ front => (by pp::string "packageY "),
sep => (fn stream
=
{ pp::string stream ", ";
break stream { spaces=>1, indent_on_wrap=>0 };
}
),
back => (by pp::string ""),
pr,
style => INCONSISTENT
}
sspo_list;
};
unparse_specification' (TYPS_IN_API (stto_list, bool), d)
=>
{ fun pr _ (symbol, tyvar_list, tyo)
=
case tyo
THE type
=>
{ unparse_symbol stream symbol;
ppsay "(";
pp_tyvar_list (tyvar_list, d);
ppsay ") = ";
unparse_type context stream (type, d);
};
NULL
=>
{ unparse_symbol stream symbol;
ppsay "(";
pp_tyvar_list (tyvar_list, d);
ppsay ")";
};
esac;
unparse_closed_sequence
stream
{ front => (by pp::string ""), # Was "type "
sep => fn stream = { pp::string stream "|";
newline stream;
},
back => (by pp::string ";"),
pr,
style => INCONSISTENT
}
stto_list;
};
unparse_specification' (GENERICS_IN_API sf_list, d)
=>
{ fun pr stream (symbol, generic_api_expression)
=
{ unparse_symbol stream symbol;
ppsay " : ";
unparse_generic_api_expression context stream (generic_api_expression, d - 1);
};
begin_horizontal_else_vertical_box stream;
ppvlist stream ("generic package ", "also ", pr, sf_list);
end_box stream;
};
unparse_specification' (VALUES_IN_API st_list, d)
=>
{ fun pr stream (symbol, type)
=
{ unparse_symbol stream symbol;
ppsay ": ";
unparse_type context stream (type, d);
};
begin_horizontal_else_vertical_box stream;
ppvlist stream (
"", # Was "my ",
"also ",
pr,
st_list
);
ppsay "; ";
end_box stream;
};
unparse_specification' (VALCONS_IN_API { datatyps, with_typs => [] }, d)
=>
{ fun pr stream (dbing)
=
(unparse_named_datatype context stream (dbing, d));
begin_horizontal_else_vertical_box stream;
ppvlist stream ("", "also ", pr, datatyps);
end_box stream;
};
unparse_specification' (VALCONS_IN_API { datatyps, with_typs }, d)
=>
{ fun prd stream (dbing) = (unparse_named_datatype context stream (dbing, d));
fun prw stream (tbing) = (unparse_named_type context stream (tbing, d));
{ begin_horizontal_else_vertical_box stream;
ppvlist stream ("", "also ", prd, datatyps);
newline stream;
ppvlist stream ("", "also ", prw, with_typs);
end_box stream;
};
};
unparse_specification' (EXCEPTIONS_IN_API sto_list, d)
=>
{ fun pr stream (symbol, tyo)
=
case tyo
THE type
=>
{ unparse_symbol stream symbol;
ppsay " : ";
unparse_type context stream (type, d);
};
NULL
=>
unparse_symbol stream symbol;
esac;
begin_horizontal_else_vertical_box stream;
ppvlist stream ("exception ", "also ", pr, sto_list);
end_box stream;
};
unparse_specification' (PACKAGE_SHARING_IN_API paths, d)
=>
{ begin_horizontal_else_vertical_box stream;
ppvlist stream ("sharing ", " = ", pp_path, paths);
end_box stream;
};
unparse_specification' (TYPE_SHARING_IN_API paths, d)
=>
{ begin_horizontal_else_vertical_box stream;
ppvlist stream ("sharing ", " = ", pp_path, paths);
end_box stream;
};
unparse_specification' (IMPORT_IN_API api_expression, d)
=>
unparse_api_expression context stream (api_expression, d);
unparse_specification' (SOURCE_CODE_REGION_FOR_API_ELEMENT (m, r), d)
=>
unparse_specification context stream (m, d);
end;
unparse_specification';
}
also
fun unparse_declaration (context as (dictionary, source_opt)) stream
=
{ ppsay = pp::string stream;
#
pp_symbol_list = pp_path stream;
fun unparse_declaration' (_, 0)
=>
ppsay "<declaration>";
unparse_declaration' (VALUE_DECLARATIONS (vbs, type_variables), d)
=>
{ begin_horizontal_else_vertical_box stream;
ppvlist stream (
"my ",
"also ",
(fn stream = fn named_value = unparse_named_value context stream (named_value, d - 1)),
vbs
);
end_box stream;
};
unparse_declaration' (FIELD_DECLARATIONS (fields, type_variables), d)
=>
# 2009-02-23 CrT: A quick first-cut solution, duplicated from VALUE_DECLARATIONS: case:
#
{ begin_horizontal_else_vertical_box stream;
ppvlist stream (
"field ",
"also ",
(fn stream = fn named_value = unparse_named_field context stream (named_value, d - 1)),
fields
);
end_box stream;
};
unparse_declaration' (RECURSIVE_VALUE_DECLARATIONS (rvbs, type_variables), d)
=>
{ begin_horizontal_else_vertical_box stream;
ppvlist
stream
( "my rec ",
"also ",
( fn stream =
fn named_recursive_values =
unparse_named_recursive_values
context
stream
(named_recursive_values, d - 1)
),
rvbs
);
end_box stream;
};
unparse_declaration' (FUNCTION_DECLARATIONS (fbs, type_variables), d)
=>
{ begin_horizontal_else_vertical_box stream;
ppvlist'
stream
( "fun ",
"also ",
( fn stream =
fn str =
fn fb =
unparse_named_sml_function
context
stream
str
(fb, d - 1)
),
fbs
);
end_box stream;
};
unparse_declaration' (NADA_FUNCTION_DECLARATIONS (fbs, type_variables), d)
=>
{ begin_horizontal_else_vertical_box stream;
ppvlist'
stream
( "fun ",
"also ",
( fn stream =
fn str =
fn fb =
unparse_named_lib7function
context
stream
str
(fb, d - 1)
),
fbs
);
end_box stream;
};
unparse_declaration' (TYPE_DECLARATIONS typs, d)
=>
{ fun pr stream (typ)
=
(unparse_named_type context stream (typ, d));
unparse_closed_sequence
stream
{ front => (by pp::string ""), # Was "type "
sep => (fn stream = (break stream { spaces=>1, indent_on_wrap=>0 } )),
back => (by pp::string ";"),
pr,
style => INCONSISTENT
}
typs;
};
unparse_declaration' (ENUM_DECLARATIONS { datatyps, with_typs => [] }, d)
=>
{ fun prd _ (dbing)
=
(unparse_named_datatype context stream (dbing, d));
unparse_closed_sequence
stream
{ front => (by pp::string ""),
sep => (fn stream = (break stream { spaces=>1, indent_on_wrap=>0 } )),
back => (by pp::string ";"),
pr => prd,
style => INCONSISTENT
}
datatyps;
};
unparse_declaration' (ENUM_DECLARATIONS { datatyps, with_typs }, d)
=>
{ fun prd stream dbing = (unparse_named_datatype context stream (dbing, d));
fun prw stream tbing = (unparse_named_type context stream (tbing, d));
{ begin_horizontal_else_vertical_box stream;
unparse_closed_sequence
stream
{ front => (by pp::string ""),
sep => (fn stream = (break stream { spaces=>1, indent_on_wrap=>0 } )),
back => (by pp::string ";"),
pr => prd,
style => INCONSISTENT
}
datatyps;
newline stream;
unparse_closed_sequence
stream
{ front => (by pp::string "withtype "),
sep => (fn stream = (break stream { spaces=>1, indent_on_wrap=>0 } )),
back => (by pp::string ""),
pr => prw,
style => INCONSISTENT
}
with_typs;
end_box stream;
};
};
unparse_declaration' (ABSTRACT_TYPE_DECLARATIONS { abstract_typs, with_typs => [], body }, d)
=>
{ fun prd stream dbing = (unparse_named_datatype context stream (dbing, d));
fun prw stream tbing = (unparse_named_type context stream (tbing, d));
{ begin_horizontal_else_vertical_box stream;
( unparse_closed_sequence
stream
{ front => (by pp::string ""),
sep => (fn stream = (break stream { spaces=>1, indent_on_wrap=>0 } )),
back => (by pp::string ";"),
pr => prd,
style => INCONSISTENT
}
abstract_typs
);
newline stream;
unparse_declaration' (body, d);
end_box stream;
};
};
unparse_declaration' (ABSTRACT_TYPE_DECLARATIONS { abstract_typs, with_typs, body }, d)
=>
{ fun prd _ (dbing) = (unparse_named_datatype context stream (dbing, d));
fun prw _ (tbing) = (unparse_named_type context stream (tbing, d));
{ begin_horizontal_else_vertical_box stream;
( unparse_closed_sequence
stream
{ front => (by pp::string ""),
sep => (fn stream = (break stream { spaces=>1, indent_on_wrap=>0 } )),
back => (by pp::string ";"),
pr => prd,
style => INCONSISTENT
}
abstract_typs
);
newline stream;
( unparse_closed_sequence
stream
{ front => (by pp::string "withtype "),
sep => (fn stream = (break stream { spaces=>1, indent_on_wrap=>0 } )),
back => (by pp::string ""),
pr => prw,
style => INCONSISTENT
}
with_typs
);
newline stream;
unparse_declaration' (body, d);
end_box stream;
};
};
unparse_declaration' (EXCEPTION_DECLARATIONS ebs, d)
=>
{ begin_horizontal_else_vertical_box stream;
( (fn stream = fn eb = unparse_named_exception context stream (eb, d - 1)), ebs );
end_box stream;
};
unparse_declaration'(PACKAGE_DECLARATIONS sbs, d)
=>
{ fun pr _ (sbing)
=
(unparse_named_package context stream (sbing, d));
unparse_closed_sequence
stream
{ front => (by pp::string "package "),
sep => (fn stream = (break stream { spaces=>1, indent_on_wrap=>0 } )),
back => (by pp::string ";"),
pr,
style => INCONSISTENT
}
sbs;
};
unparse_declaration' (GENERIC_DECLARATIONS fbs, d)
=>
{ fun f stream generic_naming
=
unparse_named_generic context stream (generic_naming, d);
begin_horizontal_else_vertical_box stream;
ppvlist stream ("generic package ", "also ", f, fbs);
end_box stream;
};
unparse_declaration' (API_DECLARATIONS sigvars, d)
=>
{ fun f stream (NAMED_API { name_symbol=>fname, definition=>def } )
=>
{ unparse_symbol stream fname;
newline stream;
ppsay "=";
unparse_api_expression context stream (def, d);
};
f stream (SOURCE_CODE_REGION_FOR_NAMED_API (t, r))
=>
f stream t;
end;
begin_horizontal_else_vertical_box stream;
ppvlist stream ("api ", "also ", f, sigvars); # Was "api "
end_box stream;
};
unparse_declaration' (GENERIC_API_DECLARATIONS sigvars, d)
=>
{ fun pr stream sigv
=
unparse_generic_api_naming context stream (sigv, d);
begin_horizontal_else_vertical_box stream;
unparse_sequence
stream
{ sep => newline,
pr,
style => CONSISTENT
}
sigvars;
end_box stream;
};
unparse_declaration' (LOCAL_DECLARATIONS (inner, outer), d)
=>
{ horizontal_else_vertical_box stream .{
newline stream; ppsay "with";
vertical_box stream .{
newline stream; unparse_declaration'(inner, d - 1);
};
newline stream; ppsay "do ";
vertical_box stream .{
newline stream; unparse_declaration'(outer, d - 1);
};
newline stream; ppsay "end;\t\t# with";
};
newline stream;
};
unparse_declaration' (SEQUENTIAL_DECLARATIONS decs, d)
=>
{ begin_horizontal_else_vertical_box stream;
unparse_sequence
stream
{ sep => newline,
pr => (fn stream = fn declaration = unparse_declaration'(declaration, d)),
style => CONSISTENT
}
decs;
end_box stream;
};
unparse_declaration' (INCLUDE_DECLARATIONS named_packages, d)
=>
{ begin_horizontal_else_vertical_box stream;
ppsay "use ";
unparse_sequence
stream
{ sep => (fn stream = break stream { spaces=>1, indent_on_wrap=>0 }),
pr => (fn stream = fn sp = pp_symbol_list sp),
style => INCONSISTENT
}
named_packages;
end_box stream;
};
unparse_declaration' (OVERLOADED_VARIABLE_DECLARATION (symbol, type, explist, extension), d)
=>
{
ppsay "overloaded my ";
unparse_symbol stream symbol;
ppsay ( extension ?? " += ... " :: " = ... ");
};
unparse_declaration' (FIXITY_DECLARATIONS { fixity, ops }, d)
=>
{ begin_horizontal_else_vertical_box stream;
case fixity
#
NONFIX => ppsay "nonfix my ";
INFIX (i, _)
=>
{ if (i % 2 == 0)
ppsay "infix my ";
else
ppsay "infixr my ";
fi;
if (i / 2 > 0)
ppsay (int::to_string (i / 2));
ppsay " ";
fi;
};
esac;
unparse_sequence
stream
{ sep => (fn stream = break stream { spaces=>1, indent_on_wrap=>0 }),
pr => unparse_symbol,
style => INCONSISTENT
}
ops;
end_box stream;
};
unparse_declaration' (SOURCE_CODE_REGION_FOR_DECLARATION (declaration, (s, e)), d)
=>
# case source_opt
#
# THE source
# =>
# { ppsay "SOURCE_CODE_REGION_FOR_DECLARATION(";
# unparse_declaration'(declaration, d); ppsay ", ";
# prpos (stream, source, s); ppsay ", ";
# prpos (stream, source, e); ppsay ")";
# };
#
# NULL
# =>
unparse_declaration' (declaration, d);
# esac;
unparse_declaration' (PRE_COMPILE_CODE string, d)
=>
ppsay ("#DO " + string);
end;
unparse_declaration';
}
also
fun unparse_named_value (context as (dictionary, source_opt)) stream
=
{ ppsay = pp::string stream;
#
fun unparse_named_value'(_, 0)
=>
ppsay "<naming>";
unparse_named_value'(NAMED_VALUE { pattern, expression, ... }, d)
=>
{ begin_horizontal_else_vertical_box stream;
unparse_pattern context stream (pattern, d - 1);
pp::string stream " =";
break stream { spaces=>1, indent_on_wrap=>2 };
unparse_expression context stream (expression, d - 1);
end_box stream;
};
unparse_named_value' (SOURCE_CODE_REGION_FOR_NAMED_VALUE (named_value, source_code_region), d)
=>
unparse_named_value' (named_value, d);
end;
unparse_named_value';
}
also
fun unparse_named_field (context as (dictionary, source_opt)) stream
=
# 2009-02-23 CrT: A quick first-cut solution
# duplicated from unparse_named_value:
#
{ ppsay = pp::string stream;
#
fun unparse_named_field'(_, 0)
=>
ppsay "<field>";
unparse_named_field'(NAMED_FIELD { name => symbol, type => case_pattern, init }, d)
=>
{ begin_horizontal_else_vertical_box stream;
pp_path stream [symbol];
end_box stream;
};
unparse_named_field' (SOURCE_CODE_REGION_FOR_NAMED_FIELD (named_field, source_code_region), d)
=>
unparse_named_field' (named_field, d);
end;
unparse_named_field';
}
also
fun unparse_named_recursive_values (context as (_, source_opt)) stream
=
{ ppsay = pp::string stream;
#
fun unparse_named_recursive_values'(_, 0)=> ppsay "<rec naming>";
unparse_named_recursive_values'(NAMED_RECURSIVE_VALUE { variable_symbol, expression, ... }, d)
=>
{ begin_wrap_box stream;
unparse_symbol stream variable_symbol;
pp::string stream " =";
break stream { spaces=>1, indent_on_wrap=>2 };
unparse_expression context stream (expression, d - 1);
end_box stream;
};
unparse_named_recursive_values' (SOURCE_CODE_REGION_FOR_RECURSIVELY_NAMED_VALUE (named_recursive_values, source_code_region), d)
=>
unparse_named_recursive_values' (named_recursive_values, d);
end;
unparse_named_recursive_values';
}
also
fun unparse_named_sml_function (context as (_, source_opt)) stream head
=
{ ppsay = pp::string stream;
fun unparse_named_sml_function'(_, 0)
=>
ppsay "<FunNaming>";
unparse_named_sml_function'(NAMED_FUNCTION { pattern_clauses, is_lazy, kind, null_or_type }, d)
=>
{
case kind
PLAIN_FUN => ppsay "";
METHOD_FUN => ppsay " (method) ";
MESSAGE_FUN => ppsay " (message) ";
esac;
case null_or_type
THE type => { ppsay " : ";
unparse_type context stream (type, d - 1);
};
NULL => ();
esac;
ppvlist stream
( head, " ; ",
(fn stream = fn (cl: Pattern_Clause) = (unparse_pattern_clause context stream (cl, d))),
pattern_clauses
);
};
unparse_named_sml_function' (SOURCE_CODE_REGION_FOR_NAMED_FUNCTION (t, r), d)
=>
unparse_named_sml_function context stream head (t, d);
end;
unparse_named_sml_function';
}
also
fun unparse_pattern_clause (context as (_, source_opt)) stream
=
{ ppsay = pp::string stream;
fun unparse_pattern_clause' (PATTERN_CLAUSE { patterns, result_type, expression }, d)
=
{ fun pr _ { item: Case_Pattern,
fixity: Null_Or( Symbol ),
source_code_region: Source_Code_Region
}
=
case fixity
THE a
=>
unparse_pattern context stream (item, d);
NULL
=>
case item
PRE_FIXITY_PATTERN p
=>
{ pp::string stream "(";unparse_pattern context stream (item, d);
pp::string stream ")";
};
TYPE_CONSTRAINT_PATTERN p
=>
{ pp::string stream "(";unparse_pattern context stream (item, d);
pp::string stream ")";
};
AS_PATTERN p
=>
{ pp::string stream"(";unparse_pattern context stream (item, d);
pp::string stream ")";
};
OR_PATTERN p
=>
{ pp::string stream "(";unparse_pattern context stream (item, d);
pp::string stream ")";
};
_ =>
unparse_pattern context stream (item, d);
esac;
esac;
begin_wrap_box stream;
unparse_sequence
stream
{ sep => (fn stream = (break stream { spaces=>1, indent_on_wrap=>0 } )),
pr,
style => INCONSISTENT
}
patterns;
case result_type
THE type
=>
{ pp::string stream ":";
unparse_type context stream (type, d);
};
NULL => ();
esac;
pp::string stream " =";
break stream { spaces=>1, indent_on_wrap=>0 };
unparse_expression context stream (expression, d);
end_box stream;
};
unparse_pattern_clause';
}
also
fun unparse_named_lib7function (context as (_, source_opt)) stream head
=
{ ppsay = pp::string stream;
fun unparse_named_lib7function'(_, 0)
=>
ppsay "<FunNaming>";
unparse_named_lib7function'(NADA_NAMED_FUNCTION (clauses, ops), d)
=>
ppvlist stream (head, " | ",
(fn stream =
fn (cl: Nada_Pattern_Clause) = (unparse_lib7pattern_clause context stream (cl, d))
),
clauses);
unparse_named_lib7function' (SOURCE_CODE_REGION_FOR_NADA_NAMED_FUNCTION (t, r), d)
=>
unparse_named_lib7function context stream head (t, d);
end;
unparse_named_lib7function';
}
also
fun unparse_lib7pattern_clause (context as (_, source_opt)) stream
=
{ ppsay = pp::string stream;
fun unparse_lib7pattern_clause' (NADA_PATTERN_CLAUSE { pattern, result_type, expression }, d)
=
{ fun pr _ (item: Case_Pattern)
=
# XXX BUGGO FIXME: Need to be more intelligent about paren insertion:
{ pp::string stream "(";
unparse_pattern context stream (item, d);
pp::string stream ")";
};
begin_wrap_box stream;
unparse_sequence
stream
{ sep => (fn stream = (break stream { spaces=>1, indent_on_wrap=>0 } )),
pr,
style => INCONSISTENT
}
[ pattern ]; # XXX BUGGO FIXME this list is always len 1 (obviously) so the logic here can probably be simplified.
case result_type
THE type
=>
{ pp::string stream ":";
unparse_type context stream (type, d);
};
NULL => ();
esac;
pp::string stream " =";
break stream { spaces=>1, indent_on_wrap=>0 };
unparse_expression context stream (expression, d);
end_box stream;
};
unparse_lib7pattern_clause';
}
also
fun unparse_named_type (context as (_, source_opt)) stream
=
{ ppsay = pp::string stream;
fun pp_tyvar_list (symbol_list, d)
=
{ fun pr _ (type_variable)
=
unparse_type_variable context stream (type_variable, d);
unparse_sequence
stream
{ sep => (fn stream = { pp::string stream ","; # Was "*"
break stream { spaces=>1, indent_on_wrap=>0 } ;}),
pr,
style => INCONSISTENT
}
symbol_list;
};
fun unparse_named_type'(_, 0)
=>
ppsay "<t::naming>";
unparse_named_type' (NAMED_TYPE { typ, definition, type_variables }, d)
=>
{ begin_wrap_box stream;
unparse_symbol stream typ;
if (list::length type_variables > 0)
pp::string stream "(";
pp_tyvar_list (type_variables, d);
pp::string stream ")";
fi;
pp::string stream " =";
break stream { spaces=>1, indent_on_wrap=>0 };
unparse_type context stream (definition, d);
end_box stream;
};
unparse_named_type' (SOURCE_CODE_REGION_FOR_NAMED_TYPE (t, r), d)
=>
unparse_named_type context stream (t, d);
end;
unparse_named_type';
}
also
fun unparse_named_datatype (context as (_, source_opt)) stream
=
{ ppsay = pp::string stream;
# Commented out because apparently unused -- 2009-08-08 CrT
# fun pp_tyvar_list (symbol_list, d)
# =
# { fun pr _ (type_variable)
# =
# (unparse_type_variable context stream (type_variable, d));
#
# unparse_sequence
# stream
# { sep => (fn stream = { pp::string stream ","; # Was "*"
# break stream { spaces=>1, indent_on_wrap=>0 } ;}),
# pr,
# style => INCONSISTENT
# }
# symbol_list;
# };
fun unparse_named_datatype'(_, 0)
=>
ppsay "<d::naming>";
unparse_named_datatype' (NAMED_ENUM { typ, type_variables, right_hand_side, is_lazy }, d)
=>
{ begin_wrap_box stream;
unparse_symbol stream typ;
pp::string stream " =";
break stream { spaces=>1, indent_on_wrap=>0 };
unparse_named_datatype_right_hand_side context stream (right_hand_side, d);
end_box stream;
};
unparse_named_datatype'(SOURCE_CODE_REGION_FOR_NAMED_DATATYPE (t, r), d)
=>
unparse_named_datatype context stream (t, d);
end;
unparse_named_datatype';
}
also
fun unparse_named_datatype_right_hand_side (context as (_, source_opt)) stream
=
{ ppsay = pp::string stream;
fun unparse_named_datatype_right_hand_side'(_, 0)
=>
ppsay "<datatype_naming_right_hand_side>";
unparse_named_datatype_right_hand_side' (VALCONS const, d)
=>
{ fun pr stream (symbol: Symbol, tv: Null_Or( raw_syntax::Any_Type ))
=
case tv
THE a
=>
{ unparse_symbol stream symbol;
ppsay " "; # Was " of "
unparse_type context stream (a, d);
};
NULL
=>
(unparse_symbol stream symbol);
esac;
unparse_sequence
stream
{ sep => (fn stream = { pp::string stream " |";
break stream { spaces=>1, indent_on_wrap=>0 };
}
),
pr,
style => INCONSISTENT
}
const;
};
unparse_named_datatype_right_hand_side' (REPLICAS symlist, d)
=>
unparse_sequence
stream
{ sep => (fn stream
=
{ pp::string stream " |";
break stream { spaces=>1, indent_on_wrap=>0 };
}
),
pr => (fn stream = fn symbol = unparse_symbol stream symbol),
style => INCONSISTENT
}
symlist;
end;
unparse_named_datatype_right_hand_side';
}
also
fun unparse_named_exception (context as (_, source_opt)) stream
=
{ ppsay = pp::string stream;
pp_symbol_list = pp_path stream;
fun unparse_named_exception'(_, 0)
=>
ppsay "<Eb>";
unparse_named_exception' ( NAMED_EXCEPTION {
exception_symbol => exn,
exception_type => etype
},
d
)
=>
case etype
THE a
=>
{ begin_horizontal_else_vertical_box stream;
unparse_symbol stream exn;
pp::string stream " =";
break stream { spaces=>1, indent_on_wrap=>2 };
unparse_type context stream (a, d - 1);
end_box stream;
};
NULL
=>
{ begin_horizontal_else_vertical_box stream;
unparse_symbol stream exn;
end_box stream;
};
esac;
unparse_named_exception' ( DUPLICATE_NAMED_EXCEPTION { exception_symbol=>exn, equal_to=>edef }, d)
=>
# ASK MACQUEEN IF WE NEED TO PRINT EDEF XXX BUGGO FIXME
{ begin_horizontal_else_vertical_box stream;
unparse_symbol stream exn;
pp::string stream " =";
break stream { spaces=>1, indent_on_wrap=>2 };
pp_symbol_list (edef);
end_box stream;
};
unparse_named_exception' (SOURCE_CODE_REGION_FOR_NAMED_EXCEPTION (t, r), d)
=>
unparse_named_exception context stream (t, d);
end;
unparse_named_exception';
}
also
fun unparse_named_package (context as (_, source_opt)) stream
=
{ ppsay = pp::string stream;
fun unparse_named_package' (_, 0)
=>
ppsay "<NAMED_PACKAGE>";
unparse_named_package' ( NAMED_PACKAGE { name_symbol=>name, definition=>def, constraint, kind }, d)
=>
{ ppsay case kind
PLAIN_PACKAGE => "package ";
CLASS_PACKAGE => "class ";
CLASS2_PACKAGE => "class2 ";
esac;
begin_horizontal_else_vertical_box stream;
unparse_symbol stream name;
unparse_package_cast context stream constraint d;
pp::string stream " =";
break stream { spaces=>1, indent_on_wrap=>2 };
unparse_package_expression context stream (def, d - 1);
end_box stream;
};
unparse_named_package' (SOURCE_CODE_REGION_FOR_NAMED_PACKAGE (t, r), d)
=>
unparse_named_package context stream (t, d);
end;
unparse_named_package';
}
also
fun unparse_named_generic (context as (_, source_opt)) stream
=
{ ppsay = pp::string stream;
fun unparse_named_generic' (_, 0)
=>
ppsay "<NAMED_GENERIC>";
unparse_named_generic' (
NAMED_GENERIC {
name_symbol => name,
definition => GENERIC_DEFINITION { parameters, body, constraint }
},
d
)
=>
{ begin_horizontal_else_vertical_box stream;
unparse_symbol stream name;
{ fun pr stream (THE symbol, api_expression)
=>
{ ppsay "(";
unparse_symbol stream symbol;
ppsay " : ";
unparse_api_expression context stream (api_expression, d);
ppsay ")";
};
pr stream (NULL, api_expression)
=>
{ ppsay "(";
unparse_api_expression context stream (api_expression, d);
ppsay ")";
};
end;
{ unparse_sequence
stream
{ sep => (fn stream = (break stream { spaces=>1, indent_on_wrap=>0 } )),
pr,
style => INCONSISTENT
}
parameters;
unparse_package_cast context stream constraint d;
nonbreakable_spaces stream 1;
ppsay "=";
break stream { spaces=>1, indent_on_wrap=>0 };
unparse_package_expression context stream (body, d);};
};
end_box stream;
};
unparse_named_generic' ( NAMED_GENERIC { name_symbol=>name, definition=>def }, d)
=>
{ begin_horizontal_else_vertical_box stream;
unparse_symbol stream name;
pp::string stream " =";
break stream { spaces=>1, indent_on_wrap=>2 };
unparse_generic_expression context stream (def, d - 1);
end_box stream;
};
unparse_named_generic' (SOURCE_CODE_REGION_FOR_NAMED_GENERIC (t, r), d)
=>
unparse_named_generic context stream (t, d);
end;
unparse_named_generic';
}
also
fun unparse_generic_api_naming (context as (_, source_opt)) stream
=
{ ppsay = pp::string stream;
fun unparse_generic_api_naming'(_, 0)
=>
ppsay "<NAMED_GENERIC_API>";
unparse_generic_api_naming' (NAMED_GENERIC_API { name_symbol=>name, definition=>def }, d)
=>
{ begin_horizontal_else_vertical_box stream;
ppsay "funsig ";
unparse_symbol stream name;
ppsay " =";
break stream { spaces=>1, indent_on_wrap=>2 };
unparse_generic_api_expression context stream (def, d - 1);
end_box stream;
};
unparse_generic_api_naming' (SOURCE_REGION_FOR_NAMED_GENERIC_API (t, r), d)
=>
unparse_generic_api_naming context stream (t, d);
end;
unparse_generic_api_naming';
}
also
fun unparse_type_variable (context as (_, source_opt)) stream
=
{ ppsay = pp::string stream;
fun unparse_type_variable' (_, 0) => ppsay "<type_variable>";
unparse_type_variable' (TYPE_VARIABLE s, d) => (unparse_symbol stream s);
unparse_type_variable' (SOURCE_CODE_REGION_FOR_TYPE_VARIABLE (t, r), d) => unparse_type_variable context stream (t, d);
end;
unparse_type_variable';
}
also
fun unparse_type (context as (dictionary, source_opt)) stream
=
{ ppsay = pp::string stream;
fun unparse_type' (_, 0)
=>
ppsay "<type>";
unparse_type' (TYPE_VARIABLE_TYPE t, d)
=>
(unparse_type_variable context stream (t, d));
unparse_type' (TYP_TYPE (typ, []), d)
=>
{ begin_indented_horizontal_else_vertical_box stream (pp::CURSOR_RELATIVE 1);
pp_path stream typ;
end_box stream;
};
unparse_type' (TYP_TYPE (typ, args), d)
=>
{ begin_indented_horizontal_else_vertical_box stream (pp::CURSOR_RELATIVE 1);
case typ
#
[typ]
=>
if (sy::eq (sy::make_type_symbol("->"), typ))
#
case args
[dom, ran]
=>
{ unparse_type' (dom, d - 1);
ppsay " ->";
break stream { spaces=>1, indent_on_wrap=>2 };
unparse_type' (ran, d - 1);
};
_ =>
err::impossible "wrong args for -> type";
esac;
else
unparse_symbol stream typ;
ppsay "(";
unparse_type_args (args, d);
ppsay ")";
fi;
_ => { pp_path stream typ;
ppsay "(";
unparse_type_args (args, d);
ppsay ")";
};
esac;
end_box stream;
};
unparse_type' (RECORD_TYPE s, d)
=>
{ fun pr stream (symbol: Symbol, tv: raw_syntax::Any_Type)
=
{ unparse_symbol stream symbol;
ppsay ": ";
unparse_type context stream (tv, d);
};
unparse_closed_sequence
stream
{ front => (by pp::string "{ "),
sep => (fn stream = { pp::string stream ", ";
break stream { spaces=>1, indent_on_wrap=>0 };
}
),
back => (by pp::string "}"),
pr,
style => INCONSISTENT
}
s;
};
unparse_type' (TUPLE_TYPE t, d)
=>
{ fun pr _ (tv: raw_syntax::Any_Type)
=
(unparse_type context stream (tv, d));
unparse_closed_sequence
stream
{ front => (by pp::string "("),
sep => (fn stream = { pp::string stream ", "; # Was " *"
break stream { spaces=>0, indent_on_wrap=>0 };
}
),
back => (by pp::string ")"),
pr,
style => INCONSISTENT
}
t;
};
unparse_type' (SOURCE_CODE_REGION_FOR_TYPE (t, r), d)
=>
unparse_type context stream (t, d);
end
also
fun unparse_type_args ([], d)
=>
();
unparse_type_args ( [type], d)
=>
{ if (strength type <= 1)
begin_indented_wrap_box stream (pp::CURSOR_RELATIVE 1);
ppsay "(";
unparse_type' (type, d);
ppsay ")";
end_box stream;
else
unparse_type' (type, d);
fi;
break stream { spaces => 0, indent_on_wrap => 0 };
};
unparse_type_args (tys, d)
=>
unparse_closed_sequence
stream
{ front => by pp::string "(",
sep => fn stream = { pp::string stream ", ";
break stream { spaces=>0, indent_on_wrap=>0 };
},
back => by pp::string ") ",
style => INCONSISTENT,
pr => fn _ = fn type = unparse_type' (type, d)
}
tys;
end;
unparse_type';
};
}; # package unparse_raw_syntax
end; # top-level local