## print-raw-syntax-as-nada.pkg
## Jing Cao and Lukasz Ziarek
# Compiled by:
# src/lib/compiler/front/typer/typer.sublibstipulate
package err = error_message; # error_message is from src/lib/compiler/front/basics/errormsg/error-message.pkg# package mld = module_level_declarations; # module_level_declarations is from src/lib/compiler/front/typer-stuff/modules/module-level-declarations.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 syx = symbolmapstack_entry; # symbolmapstack_entry is from src/lib/compiler/front/typer-stuff/symbolmapstack/symbolmapstack-entry.pkg package tc = typer_control; # typer_control is from src/lib/compiler/front/typer/basics/typer-control.pkg package tt = type_types; # type_types is from src/lib/compiler/front/typer/types/type-types.pkg #
include raw_syntax;
include tuples;
include fixity;
include variables_and_constructors;
include prettyprint;
include print_as_nada_junk;
include unparse_type;
include unparse_value;
herein
package print_raw_syntax_tree_as_nada
: (weak) Print_Raw_Syntax_Tree_As_Lib7 # Print_Raw_Syntax_Tree_As_Lib7 is from src/lib/compiler/front/typer/print/print-raw-syntax-as-nada.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
#
(sci::filepos source charpos)
->
(file: String, line: Int, pos: Int);
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
=
err::impossible("unparse_raw_syntax: " + msg);
arrow_stamp = tt::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_info (SOURCE_CODE_REGION_FOR_EXPRESSION (a, _))
=>
strip_source_code_region_info a;
strip_source_code_region_info x
=>
x;
end;
fun trim [x] => [];
trim (a ! b) => a ! trim b;
trim [] => [];
end;
fun pp_path stream symbols
=
{ fun pr stream (symbol)
=
(print_symbol_as_nada stream symbol);
print_sequence_as_nada
stream
{ sep => (fn stream => (pp::string stream "."); end ),
pr,
style => INCONSISTENT
}
symbols;
};
fun print_pattern_as_nada (context as (dictionary, source_opt)) stream
=
{ ppsay = pp::string stream;
pp_symbol_list = pp_path stream;
fun print_pattern_as_nada' (WILDCARD_PATTERN, _) => (ppsay "_");
print_pattern_as_nada' (VARIABLE_IN_PATTERN p, d) => pp_symbol_list (p);
print_pattern_as_nada' (INT_CONSTANT_IN_PATTERN i, _) => ppsay (multiword_int::to_string i);
print_pattern_as_nada' (UNT_CONSTANT_IN_PATTERN w, _) => ppsay (multiword_int::to_string w);
print_pattern_as_nada' (STRING_CONSTANT_IN_PATTERN s, _) => print_lib7_string_as_nada stream s;
print_pattern_as_nada' (CHAR_CONSTANT_IN_PATTERN s, _) => { ppsay "#"; print_lib7_string_as_nada stream s;};
print_pattern_as_nada' (AS_PATTERN { variable_pattern, expression_pattern }, d)
=>
{ begin_horizontal_else_vertical_box stream;
print_pattern_as_nada'(variable_pattern, d); ppsay " as "; print_pattern_as_nada'(expression_pattern, d - 1);
end_box stream;
};
print_pattern_as_nada' (RECORD_PATTERN { definition => [], is_incomplete }, _)
=>
if is_incomplete ppsay "{... }";
else ppsay "()";
fi;
print_pattern_as_nada' (r as RECORD_PATTERN { definition, is_incomplete }, d)
=>
if (is_tuplepat r)
print_closed_sequence_as_nada
stream
{ front => (by pp::string "("),
sep => (fn stream => { pp::string stream ", ";
break stream { spaces=>0, indent_on_wrap=>0 } ;}; end ),
back => (by pp::string ")"),
pr => (fn _ => fn (symbol, pattern) => print_pattern_as_nada' (pattern, d - 1); end; end ),
style => INCONSISTENT
}
definition;
else
print_closed_sequence_as_nada
stream
{ front => (by pp::string "{ "),
sep => (fn stream => { pp::string stream ", ";
break stream { spaces=>0, indent_on_wrap=>0 } ;}; end ),
back => (fn stream => if is_incomplete pp::string stream ", ... }";
else pp::string stream "}";fi; end ),
pr => (fn stream => fn (symbol, pattern) => { print_symbol_as_nada stream symbol;
pp::string stream "=";
print_pattern_as_nada' (pattern, d - 1);
};
end; end
),
style => INCONSISTENT
}
definition;
fi;
print_pattern_as_nada' (LIST_PATTERN NIL, d)
=>
ppsay "[]";
print_pattern_as_nada' (LIST_PATTERN l, d)
=>
{ fun pr _ pattern = print_pattern_as_nada'(pattern, d - 1);
print_closed_sequence_as_nada
stream
{ front => (by pp::string "["),
sep => (fn stream => { pp::string stream ", ";
break stream { spaces=>0, indent_on_wrap=>0 } ;}; end
),
back => (by pp::string "]"),
pr,
style => INCONSISTENT
}
l;
};
print_pattern_as_nada' (TUPLE_PATTERN t, d)
=>
{ fun pr _ pattern = print_pattern_as_nada'(pattern, d - 1);
print_closed_sequence_as_nada
stream
{ front => (by pp::string "("),
sep => (fn stream => { pp::string stream ", ";
break stream { spaces=>0, indent_on_wrap=>0 }
;}; end
),
back => (by pp::string ")"),
pr,
style => INCONSISTENT
}
t;
};
print_pattern_as_nada' (PRE_FIXITY_PATTERN fap, d)
=>
{ fun pr _ { item, fixity, source_code_region } = print_pattern_as_nada'(item, d - 1);
print_sequence_as_nada
stream
{ sep => (fn stream => (break stream { spaces=>1, indent_on_wrap=>0 } ); end ),
pr,
style => INCONSISTENT
}
fap;
};
print_pattern_as_nada' (APPLY_PATTERN { constructor, argument }, d)
=>
{ begin_horizontal_else_vertical_box stream;
print_pattern_as_nada' (constructor, d);
ppsay " as ";
print_pattern_as_nada'(argument, d);
end_box stream;
};
print_pattern_as_nada' (TYPE_CONSTRAINT_PATTERN { pattern, type_constraint }, d)
=>
{ begin_wrap_box stream;
print_pattern_as_nada' (pattern, d - 1);
ppsay " :";
break stream { spaces => 1, indent_on_wrap => 2 };
print_type_as_nada context stream (type_constraint, d);
end_box stream;
};
print_pattern_as_nada' (VECTOR_PATTERN NIL, d)
=>
ppsay "#[]";
print_pattern_as_nada' (VECTOR_PATTERN v, d)
=>
{ fun pr _ pattern = print_pattern_as_nada'(pattern, d - 1);
print_closed_sequence_as_nada
stream
{ front => (by pp::string "#["),
sep => (fn stream => { pp::string stream ", ";break stream { spaces=>1, indent_on_wrap=>0 } ;}; end ),
back => (by pp::string "]"),
pr,
style => INCONSISTENT
}
v;
};
print_pattern_as_nada' (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 "): ";
print_pattern_as_nada'(pattern, d); ppsay ">";
else
print_pattern_as_nada'(pattern, d);
fi;
NULL => print_pattern_as_nada'(pattern, d);
esac;
print_pattern_as_nada' (OR_PATTERN orpat, d)
=>
{ fun pr _ pattern = print_pattern_as_nada'(pattern, d - 1);
print_closed_sequence_as_nada
stream
{ front => (by pp::string "("),
sep => (fn stream => { break stream { spaces=>1, indent_on_wrap=>0 }; pp::string stream "| ";}; end ),
back => (by pp::string ")"),
pr,
style => INCONSISTENT
};
} (orpat);
end;
print_pattern_as_nada';
}
also
fun print_expression_as_nada (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 print_expression_as_nada' (_, _, 0) => ppsay "<expression>";
print_expression_as_nada' (VARIABLE_IN_EXPRESSION p, _, _) => pp_symbol_list (p);
print_expression_as_nada' (IMPLICIT_THUNK_PARAMETER p, _, _) => { ppsay " #"; pp_symbol_list (p); };
print_expression_as_nada' (FN_EXPRESSION NIL, _, d) => ppsay "<function>";
print_expression_as_nada' (FN_EXPRESSION rules, _, d)
=>
{ fun pr _ pattern = print_rule_as_nada context stream (pattern, d - 1);
print_sequence_as_nada
stream
{ sep => (fn stream => { pp::string stream "|";break stream { spaces=>0, indent_on_wrap=>0 } ;}; end ),
pr,
style => INCONSISTENT
}
rules;
};
print_expression_as_nada' (PRE_FIXITY_EXPRESSION fap, _, d)
=>
{ fun pr _ { item, fixity, source_code_region } = print_expression_as_nada'(item, TRUE, d);
print_sequence_as_nada
stream
{ sep => (fn stream => (break stream { spaces=>1, indent_on_wrap=>0 } ); end ),
pr,
style => INCONSISTENT
}
fap;
};
print_expression_as_nada' (e as APPLY_EXPRESSION _, atom, d)
=>
{ infix0 = INFIX (0, 0);
lpcond atom;
print_app_expression_as_nada (e, null_fix, null_fix, d);
rpcond atom;
};
print_expression_as_nada' (OBJECT_FIELD_EXPRESSION { object, field }, _, d)
=>
{ print_expression_as_nada' (object, TRUE, d - 1);
ppsay "->";
print_symbol_as_nada stream field;
};
print_expression_as_nada' (CASE_EXPRESSION { expression, rules }, _, d)
=>
{ begin_horizontal_else_vertical_box stream;
ppsay "case ("; print_expression_as_nada'(expression, TRUE, d - 1); newline_indent stream 2;
ppvlist stream (") ", ";", (fn stream = fn r = print_rule_as_nada context stream (r, d - 1)), trim rules);
ppsay "esac";
end_box stream;
};
print_expression_as_nada' (LET_EXPRESSION { declaration, expression }, _, d)
=>
{ begin_horizontal_else_vertical_box stream;
ppsay "stipulate ";
begin_horizontal_else_vertical_box stream;
print_declaration_as_nada context stream (declaration, d - 1);
end_box stream;
break stream { spaces=>1, indent_on_wrap=>0 };
ppsay "herein ";
begin_horizontal_else_vertical_box stream;
print_expression_as_nada'(expression, FALSE, d - 1);
end_box stream;
break stream { spaces=>1, indent_on_wrap=>0 };
ppsay "end";
end_box stream;
};
print_expression_as_nada' (SEQUENCE_EXPRESSION exps, _, d)
=>
print_closed_sequence_as_nada
stream
{ front => (by pp::string "("),
sep => (fn stream => { pp::string stream ";";
break stream { spaces=>1, indent_on_wrap=>0 } ;}; end ),
back => (by pp::string ")"),
pr => (fn _ => fn expression => print_expression_as_nada'(expression, FALSE, d - 1); end; end ),
style => INCONSISTENT
}
exps;
print_expression_as_nada' ( INT_CONSTANT_IN_EXPRESSION i, _, _) => ppsay (multiword_int::to_string i);
print_expression_as_nada' ( UNT_CONSTANT_IN_EXPRESSION w, _, _) => ppsay (multiword_int::to_string w);
print_expression_as_nada' ( FLOAT_CONSTANT_IN_EXPRESSION r, _, _) => ppsay r;
print_expression_as_nada' ( STRING_CONSTANT_IN_EXPRESSION s, _, _) => print_lib7_string_as_nada stream s;
print_expression_as_nada' (CHAR_CONSTANT_IN_EXPRESSION s, _, _) => { ppsay "#"; print_lib7_string_as_nada stream s;};
print_expression_as_nada'(r as RECORD_IN_EXPRESSION fields, _, d)
=>
if (is_tupleexp r)
print_closed_sequence_as_nada
stream
{ front => (by pp::string "("),
sep => (fn stream => { pp::string stream ", ";
break stream { spaces=>0, indent_on_wrap=>0 } ;}; end ),
back => (by pp::string ")"),
pr => (fn _ => fn (_, expression) => print_expression_as_nada'(expression, FALSE, d - 1); end; end ),
style => INCONSISTENT
}
fields;
else
print_closed_sequence_as_nada
stream
{ front => (by pp::string "{"),
sep => (fn stream => { pp::string stream ", ";
break stream { spaces=>0, indent_on_wrap=>0 } ;}; end ),
back => (by pp::string "}"),
pr => (fn stream => fn (name, expression)
=>
{ print_symbol_as_nada stream name; ppsay "=";
print_expression_as_nada'(expression, FALSE, d)
;}; end; end
),
style => INCONSISTENT
}
fields;
fi;
print_expression_as_nada' (LIST_EXPRESSION p, _, d)
=>
print_closed_sequence_as_nada
stream
{ front => (by pp::string "["),
sep => (fn stream => { pp::string stream ", ";
break stream { spaces=>0, indent_on_wrap=>0 } ;}; end ),
back => (by pp::string "]"),
pr => (fn stream => fn expression =>
(print_expression_as_nada'(expression, FALSE, d - 1)); end; end ),
style => INCONSISTENT
}
p;
print_expression_as_nada' (TUPLE_EXPRESSION p, _, d)
=>
print_closed_sequence_as_nada
stream
{ front => (by pp::string "("),
sep => (fn stream => { pp::string stream ", ";
break stream { spaces=>0, indent_on_wrap=>0 } ;}; end ),
back => (by pp::string ")"),
pr => (fn stream => fn expression =>
(print_expression_as_nada'(expression, FALSE, d - 1)); end; end ),
style => INCONSISTENT
}
p;
print_expression_as_nada'(RECORD_SELECTOR_EXPRESSION name, atom, d)
=>
{ begin_horizontal_else_vertical_box stream;
lpcond (atom);
ppsay "#"; print_symbol_as_nada stream name;
ppsay ">";
rpcond (atom);
end_box stream;
};
print_expression_as_nada' (TYPE_CONSTRAINT_EXPRESSION { expression, constraint }, atom, d)
=>
{ begin_wrap_box stream;
lpcond (atom);
print_expression_as_nada'(expression, FALSE, d); ppsay ":";
break stream { spaces=>1, indent_on_wrap=>2 };
print_type_as_nada context stream (constraint, d);
rpcond (atom);
end_box stream;
};
print_expression_as_nada'(EXCEPT_EXPRESSION { expression, rules }, atom, d)
=>
{ begin_horizontal_else_vertical_box stream;
lpcond (atom);
print_expression_as_nada'(expression, atom, d - 1); newline stream; ppsay "except ";
newline_indent stream 2;
ppvlist stream (" ", "also ",
(fn stream => fn r => print_rule_as_nada context stream (r, d - 1); end; end ), rules);
rpcond (atom);
end_box stream;
};
print_expression_as_nada' (RAISE_EXPRESSION expression, atom, d)
=>
{ begin_horizontal_else_vertical_box stream;
lpcond (atom);
ppsay "raise exception "; print_expression_as_nada'(expression, TRUE, d - 1);
rpcond (atom);
end_box stream;
};
print_expression_as_nada' (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;
print_expression_as_nada' (test_case, FALSE, d - 1);
end_box stream;
break stream { spaces=>1, indent_on_wrap=> 0 };
ppsay "then ";
begin_horizontal_else_vertical_box stream;
print_expression_as_nada' (then_case, FALSE, d - 1);
end_box stream;
break stream { spaces=>1, indent_on_wrap=> 0 };
ppsay "else ";
begin_horizontal_else_vertical_box stream;
print_expression_as_nada' (else_case, FALSE, d - 1);
end_box stream;
rpcond (atom);
end_box stream;
};
print_expression_as_nada' (AND_EXPRESSION (e1, e2), atom, d)
=>
{ begin_horizontal_else_vertical_box stream;
lpcond (atom);
begin_horizontal_else_vertical_box stream;
print_expression_as_nada' (e1, TRUE, d - 1);
end_box stream;
break stream { spaces=>1, indent_on_wrap=> 0 };
ppsay "also ";
begin_horizontal_else_vertical_box stream;
print_expression_as_nada' (e2, TRUE, d - 1);
end_box stream;
rpcond (atom);
end_box stream;
};
print_expression_as_nada' (OR_EXPRESSION (e1, e2), atom, d)
=>
{ begin_horizontal_else_vertical_box stream;
lpcond (atom);
begin_horizontal_else_vertical_box stream;
print_expression_as_nada' (e1, TRUE, d - 1);
end_box stream;
break stream { spaces=>1, indent_on_wrap=> 0 };
ppsay "or ";
begin_horizontal_else_vertical_box stream;
print_expression_as_nada' (e2, TRUE, d - 1);
end_box stream;
rpcond (atom);
end_box stream;
};
print_expression_as_nada' (WHILE_EXPRESSION { test, expression }, atom, d)
=>
{ begin_horizontal_else_vertical_box stream;
ppsay "while ";
begin_horizontal_else_vertical_box stream;
print_expression_as_nada'(test, FALSE, d - 1);
end_box stream;
break stream { spaces=>1, indent_on_wrap=> 0 };
ppsay "do ";
begin_horizontal_else_vertical_box stream;
print_expression_as_nada'(expression, FALSE, d - 1);
end_box stream;
end_box stream;
};
print_expression_as_nada'(VECTOR_IN_EXPRESSION NIL, _, d)
=>
ppsay "#[]";
print_expression_as_nada' (VECTOR_IN_EXPRESSION exps, _, d)
=>
{ fun pr _ expression = print_expression_as_nada'(expression, FALSE, d - 1);
print_closed_sequence_as_nada
stream
{ front => (by pp::string "#["),
sep => (fn stream => { pp::string stream ", ";
break stream { spaces=>1, indent_on_wrap=>0 } ;}; end ),
back => (by pp::string "]"),
pr,
style => INCONSISTENT
}
exps;
};
print_expression_as_nada' (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 "): ";
print_expression_as_nada'(expression, FALSE, d); ppsay ">";
else
print_expression_as_nada'(expression, atom, d);
fi;
NULL => print_expression_as_nada'(expression, atom, d);
esac;
end
also
fun print_app_expression_as_nada (_, _, _, 0)
=>
pp::string stream "<expression>";
print_app_expression_as_nada 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 };
print_expression_as_nada'(expression, TRUE, d - 1);
end_box stream;
};
case this_fix
INFIX _
=>
case (strip_source_code_region_info 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);
print_app_expression_as_nada (pl, left, this_fix, d - 1);
break stream { spaces=>1, indent_on_wrap=>0 };
ppsay dname;
break stream { spaces=>1, indent_on_wrap=>0 };
print_app_expression_as_nada (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_info operator)
VARIABLE_IN_EXPRESSION v
=>
{ path = v;
fixitypp (path, operand, l, r, d);
};
operator
=>
{ begin_indented_wrap_box stream (pp::CURSOR_RELATIVE 2);
print_expression_as_nada'(operator, TRUE, d - 1); break stream { spaces=>1, indent_on_wrap=>2 };
print_expression_as_nada'(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 "): ";
print_expression_as_nada'(expression, FALSE, d); ppsay ">";
else
apply_print (expression, l, r, d);
fi;
NULL => apply_print (expression, l, r, d);
esac;
apply_print (e, _, _, d)
=>
print_expression_as_nada'(e, TRUE, d);
end;
apply_print arg;
};
end;
(fn (expression, depth) = print_expression_as_nada' (expression, FALSE, depth));
}
also
fun print_rule_as_nada (context as (dictionary, source_opt)) stream (CASE_RULE { pattern, expression }, d)
=
if (d > 0)
begin_horizontal_else_vertical_box stream;
print_pattern_as_nada context stream (pattern, d - 1);
pp::string stream " =>"; break stream { spaces=>1, indent_on_wrap=>2 };
print_expression_as_nada context stream (expression, d - 1);
end_box stream;
else
pp::string stream "<rule>";
fi
also
fun print_package_expression_as_nada (context as (_, source_opt)) stream
=
{ ppsay = pp::string stream;
pp_symbol_list = pp_path stream;
fun print_package_expression_as_nada'(_, 0)
=>
ppsay "<package_expression>";
print_package_expression_as_nada'(PACKAGE_BY_NAME p, d)
=>
pp_symbol_list (p);
print_package_expression_as_nada'(PACKAGE_DEFINITION (SEQUENTIAL_DECLARATIONS NIL), d)
=>
{ ppsay "pkg";
nonbreakable_spaces stream 1;
ppsay "end";
};
print_package_expression_as_nada'(PACKAGE_DEFINITION de, d)
=>
{ begin_vertical_box stream;
ppsay "pkg"; unparse_junk::newline_indent stream 2;
print_declaration_as_nada context stream (de, d - 1);
ppsay "end";
end_box stream;
};
print_package_expression_as_nada' (PACKAGE_CAST (stre, constraint), d)
=>
{ begin_wrap_box stream;
print_package_expression_as_nada' (stre, d - 1);
case constraint
NO_PACKAGE_CAST => ();
WEAK_PACKAGE_CAST api_expression
=>
{ ppsay ": (weak) "; break stream { spaces=>1, indent_on_wrap=>2 };
print_api_expression_as_nada context stream (api_expression, d - 1);
};
PARTIAL_PACKAGE_CAST api_expression
=>
{ ppsay ": (partial) "; break stream { spaces=>1, indent_on_wrap=>2 };
print_api_expression_as_nada context stream (api_expression, d - 1);
};
STRONG_PACKAGE_CAST api_expression
=>
{ ppsay ": "; break stream { spaces=>1, indent_on_wrap=>2 };
print_api_expression_as_nada context stream (api_expression, d - 1);
};
esac;
end_box stream;
};
print_package_expression_as_nada'(CALL_OF_GENERIC (path, str_list), d)
=>
{ fun pr stream (strl, bool)
=
{ ppsay "("; print_package_expression_as_nada context stream (strl, d); ppsay ")";};
pp_symbol_list (path);
print_sequence_as_nada
stream
{ sep => (fn stream => (break stream { spaces=>1, indent_on_wrap=>0 } ); end ),
pr,
style => INCONSISTENT
}
str_list;
};
print_package_expression_as_nada'(INTERNAL_CALL_OF_GENERIC (path, str_list), d)
=>
{ fun pr stream (strl, bool)
=
{ ppsay "("; print_package_expression_as_nada context stream (strl, d); ppsay ")";};
pp_symbol_list (path);
print_sequence_as_nada
stream
{ sep => (fn stream => (break stream { spaces=>1, indent_on_wrap=>0 } ); end ),
pr,
style => INCONSISTENT
}
str_list;
};
print_package_expression_as_nada' (LET_IN_PACKAGE (declaration, body), d)
=>
{ begin_horizontal_else_vertical_box stream;
ppsay "stipulate "; print_declaration_as_nada context stream (declaration, d - 1);
newline stream;
ppsay " herein "; print_package_expression_as_nada'(body, d - 1); newline stream;
ppsay "end";
end_box stream;
};
print_package_expression_as_nada' (SOURCE_CODE_REGION_FOR_PACKAGE (body, (s, e)), d)
=>
print_package_expression_as_nada' (body, d);
end;
/* case source_opt
THE source
=>
(ppsay "SOURCE_CODE_REGION_FOR_PACKAGE(";
print_package_expression_as_nada'(body, d); ppsay ", ";
prpos (stream, source, s); ppsay ", ";
prpos (stream, source, e); ppsay ")");
NULL => print_package_expression_as_nada'(body, d);
esac
*/
print_package_expression_as_nada';
}
also
fun print_generic_expression_as_nada (context as (_, source_opt)) stream
=
{ ppsay = pp::string stream;
pp_symbol_list = pp_path stream;
fun print_generic_expression_as_nada'(_, 0) => ppsay "<generic_expression>";
print_generic_expression_as_nada'(GENERIC_BY_NAME (p, _), d) => pp_symbol_list (p);
print_generic_expression_as_nada'(LET_IN_GENERIC (declaration, body), d)
=>
{ begin_horizontal_else_vertical_box stream;
ppsay "stipulate "; print_declaration_as_nada context stream (declaration, d - 1);
newline stream;
ppsay " herein "; print_generic_expression_as_nada'(body, d - 1); newline stream;
ppsay "end";
end_box stream;
};
print_generic_expression_as_nada'(CONSTRAINED_CALL_OF_GENERIC (path, sblist, fsigconst), d)
=>
{ fun pr stream (package_expression, _)
=
{ ppsay "(";
print_package_expression_as_nada context stream (package_expression, d);
ppsay ")"
;};
begin_horizontal_else_vertical_box stream;
pp_symbol_list path;
print_sequence_as_nada
stream
{ sep => (fn stream => (break stream { spaces=>1, indent_on_wrap=>0 } ); end ),
pr,
style => INCONSISTENT
}
sblist;
end_box stream;
};
print_generic_expression_as_nada'(SOURCE_CODE_REGION_FOR_GENERIC (body, (s, e)), d)
=>
print_generic_expression_as_nada' (body, d);
print_generic_expression_as_nada'(GENERIC_DEFINITION _, d)
=>
err::impossible "print_generic_expression_as_nada: GENERIC_DEFINITION";
end;
print_generic_expression_as_nada';
}
also
fun print_where_spec_as_nada (context as (dictionary, source_opt)) stream
=
{ ppsay = pp::string stream;
fun print_where_spec_as_nada'(_, 0) => ppsay "<WhereSpec>";
print_where_spec_as_nada'(WHERE_TYPE([],[], type), d) => print_type_as_nada context stream (type, d);
print_where_spec_as_nada'(WHERE_TYPE (slist, tvlist, type), d)
=>
{ fun pr _ symbol = print_symbol_as_nada stream symbol;
fun pr' _ tyv = print_type_variable_as_nada context stream (tyv, d);
ppsay "type ";
print_sequence_as_nada
stream
{ sep => (fn stream => (break stream { spaces=>1, indent_on_wrap=>0 } ); end ),
pr => pr',
style => INCONSISTENT
}
tvlist;
break stream { spaces=>1, indent_on_wrap=>0 };
print_sequence_as_nada
stream
{ sep => (fn stream => (break stream { spaces=>1, indent_on_wrap=>0 } ); end ),
pr,
style => INCONSISTENT
}
slist;
ppsay" =";
break stream { spaces=>1, indent_on_wrap=>0 };
print_type_as_nada context stream (type, d);
};
print_where_spec_as_nada' (WHERE_PACKAGE (slist, slist'), d)
=>
{ fun pr _ symbol
=
print_symbol_as_nada stream symbol;
ppsay "package ";
print_sequence_as_nada
stream
{ sep => (fn stream => (break stream { spaces=>1, indent_on_wrap=>0 } ); end ),
pr,
style => INCONSISTENT
}
slist;break stream { spaces=>1, indent_on_wrap=>0 };
print_sequence_as_nada
stream
{ sep => (fn stream => (break stream { spaces=>1, indent_on_wrap=>0 } ); end ),
pr,
style => INCONSISTENT
}
slist';
}; end;
print_where_spec_as_nada';
}
also
fun print_api_expression_as_nada (context as (dictionary, source_opt)) stream
=
{ ppsay = pp::string stream;
fun print_api_expression_as_nada'(_, 0) => ppsay "<api_expression>";
print_api_expression_as_nada'(API_BY_NAME s, d) => (print_symbol_as_nada stream s);
print_api_expression_as_nada'(API_WITH_WHERE_SPECS (an_api, wherel), d)
=>
{ print_api_expression_as_nada' (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 => print_where_spec_as_nada context stream (r, d - 1); end; end ), wherel);
SOURCE_CODE_REGION_FOR_API (API_BY_NAME s, r)
=>
ppvlist stream ("where ", "also ",
(fn stream => fn r => print_where_spec_as_nada context stream (r, d - 1); end; end ), wherel);
_
=>
{ newline stream; ppvlist stream ("where ", "also ",
(fn stream => fn r => print_where_spec_as_nada context stream (r, d - 1); end; end ), wherel);}; esac
);
};
print_api_expression_as_nada' (API_DEFINITION [], d)
=>
{ ppsay "api";
nonbreakable_spaces stream 1;
ppsay "end";
};
print_api_expression_as_nada' (API_DEFINITION specl, d)
=>
{ fun pr stream speci = (print_specification_as_nada context stream (speci, d));
{ begin_vertical_box stream;
ppsay "api";
unparse_junk::newline_indent stream 4;
print_sequence_as_nada
stream
{ sep => (fn stream => (newline stream); end ),
pr,
style => INCONSISTENT
}
specl;
newline stream;
ppsay "end ";
end_box stream;
};
};
print_api_expression_as_nada' (SOURCE_CODE_REGION_FOR_API (m, r), d)
=>
print_api_expression_as_nada context stream (m, d);
end;
print_api_expression_as_nada';
}
also
fun print_generic_api_expression_as_nada (context as (dictionary, source_opt)) stream
=
{ ppsay = pp::string stream;
fun print_generic_api_expression_as_nada'(_, 0) => ppsay "<generic_api_expression>";
print_generic_api_expression_as_nada'(GENERIC_API_BY_NAME s, d) => print_symbol_as_nada stream s;
print_generic_api_expression_as_nada'(GENERIC_API_DEFINITION { parameter, result }, d)
=>
{ fun pr stream (THE symbol, api_expression)
=>
{ ppsay "("; print_symbol_as_nada stream symbol; ppsay ":";
print_api_expression_as_nada context stream (api_expression, d);
ppsay ")"
;};
pr stream (NULL, api_expression)
=>
{ ppsay "("; print_api_expression_as_nada context stream (api_expression, d); ppsay ")";}; end;
print_sequence_as_nada
stream
{ sep => (fn stream => (newline stream); end ),
pr,
style => INCONSISTENT
}
parameter;
break stream { spaces=>1, indent_on_wrap=>2 };
ppsay "=> ";
print_api_expression_as_nada context stream (result, d);
};
print_generic_api_expression_as_nada' (SOURCE_CODE_REGION_FOR_GENERIC_API (m, r), d)
=>
print_generic_api_expression_as_nada context stream (m, d);
end;
print_generic_api_expression_as_nada';
}
also
fun print_specification_as_nada (context as (dictionary, source_opt)) stream
=
{ ppsay = pp::string stream;
fun pp_tyvar_list ([], d) => ();
pp_tyvar_list ( [type_variable], d)
=>
{ print_type_variable_as_nada context stream (type_variable, d);
break stream { spaces=>1, indent_on_wrap=>0 };
};
pp_tyvar_list (tyvar_list, d)
=>
{ fun pr _ (type_variable)
=
(print_type_variable_as_nada context stream (type_variable, d));
print_closed_sequence_as_nada
stream
{ front => (fn stream => pp::string stream "("; end ),
sep => { pp::string stream ", ";fn stream => (break stream { spaces=>1, indent_on_wrap=>0 } ); end ;},
back => { pp::string stream ")";fn stream => (break stream { spaces=>1, indent_on_wrap=>0 } ); end ;},
pr,
style => INCONSISTENT
}
tyvar_list;
};
end;
fun print_specification_as_nada'(_, 0) => ppsay "<Specification>";
print_specification_as_nada'(PACKAGES_IN_API sspo_list, d)
=>
{ fun pr _ (symbol, api_expression, path)
=
( case path
THE p => { print_symbol_as_nada stream symbol; ppsay " = ";
print_api_expression_as_nada context stream (api_expression, d);
break stream { spaces=>1, indent_on_wrap=>0 }; pp_path stream p;};
NULL => { print_symbol_as_nada stream symbol; ppsay " = ";
print_api_expression_as_nada context stream (api_expression, d);}; esac
);
print_closed_sequence_as_nada
stream
{ front => (by pp::string "package "),
sep => (fn stream => { pp::string stream ", ";
break stream { spaces=>1, indent_on_wrap=>0 } ;}; end ),
back => (by pp::string ""),
pr,
style => INCONSISTENT
}
sspo_list;
};
print_specification_as_nada' (TYPS_IN_API (stto_list, bool), d)
=>
{ fun pr _ (symbol, tyvar_list, tyo)
=
( case tyo
THE type
=>
{ pp_tyvar_list (tyvar_list, d);print_symbol_as_nada stream symbol; ppsay "= ";
print_type_as_nada context stream (type, d);};
NULL
=>
{ pp_tyvar_list (tyvar_list, d);print_symbol_as_nada stream symbol;}; esac
);
print_closed_sequence_as_nada
stream
{ front => (by pp::string "type "),
sep => (fn stream => { pp::string stream "|";newline stream;}; end ),
back => (by pp::string ""),
pr,
style => INCONSISTENT
}
stto_list;
};
print_specification_as_nada' (GENERICS_IN_API sf_list, d)
=>
{ fun pr stream (symbol, generic_api_expression)
=
{ print_symbol_as_nada stream symbol; ppsay " : ";
print_generic_api_expression_as_nada context stream (generic_api_expression, d - 1)
;};
begin_horizontal_else_vertical_box stream;
ppvlist stream ("generic package ", "also ", pr, sf_list);
end_box stream;
};
print_specification_as_nada' (VALUES_IN_API st_list, d)
=>
{ fun pr stream (symbol, type)
=
{ print_symbol_as_nada stream symbol; ppsay ":"; print_type_as_nada context stream (type, d);};
begin_horizontal_else_vertical_box stream;
ppvlist stream ("my ", "also ", pr, st_list);
end_box stream;
};
print_specification_as_nada' (VALCONS_IN_API { datatyps, with_typs => [] }, d)
=>
{ fun pr stream (dbing) = (print_datatype_naming_as_mythryl7 context stream (dbing, d));
begin_horizontal_else_vertical_box stream;
ppvlist stream ("enum ", "also ", pr, datatyps);
end_box stream;
};
print_specification_as_nada' (VALCONS_IN_API { datatyps, with_typs }, d)
=>
{ fun prd stream (dbing) = (print_datatype_naming_as_mythryl7 context stream (dbing, d));
fun prw stream (tbing) = (print_type_naming_as_nada context stream (tbing, d));
{ begin_horizontal_else_vertical_box stream;
ppvlist stream ("enum ", "also ", prd, datatyps);
newline stream;
ppvlist stream ("enum ", "also ", prw, with_typs);
end_box stream;
};
};
print_specification_as_nada' (EXCEPTIONS_IN_API sto_list, d)
=>
{ fun pr stream (symbol, tyo)
=
( case tyo
THE type
=>
{ print_symbol_as_nada stream symbol; ppsay " : ";
print_type_as_nada context stream (type, d)
;};
NULL
=>
print_symbol_as_nada stream symbol; esac
);
begin_horizontal_else_vertical_box stream;
ppvlist stream ("exception ", "also ", pr, sto_list);
end_box stream;
};
print_specification_as_nada' (PACKAGE_SHARING_IN_API paths, d)
=>
{ begin_horizontal_else_vertical_box stream;
ppvlist stream ("sharing ", " = ", pp_path, paths);
end_box stream;
};
print_specification_as_nada' (TYPE_SHARING_IN_API paths, d)
=>
{ begin_horizontal_else_vertical_box stream;
ppvlist stream ("sharing ", " = ", pp_path, paths);
end_box stream;
};
print_specification_as_nada' (IMPORT_IN_API api_expression, d)
=>
print_api_expression_as_nada context stream (api_expression, d);
print_specification_as_nada' (SOURCE_CODE_REGION_FOR_API_ELEMENT (m, r), d)
=>
print_specification_as_nada context stream (m, d);
end;
print_specification_as_nada';
}
also
fun print_declaration_as_nada (context as (dictionary, source_opt)) stream
=
{ ppsay = pp::string stream;
pp_symbol_list = pp_path stream;
fun print_declaration_as_nada'(_, 0) => ppsay "<declaration>";
print_declaration_as_nada' (VALUE_DECLARATIONS (vbs, type_variables), d)
=>
{ begin_horizontal_else_vertical_box stream;
ppvlist stream ("my ", "also ", (fn stream => fn named_value => print_named_value_as_nada context stream (named_value, d - 1); end; end ), vbs);
end_box stream;
};
print_declaration_as_nada' (FIELD_DECLARATIONS (fields, type_variables), d)
=>
{ begin_horizontal_else_vertical_box stream;
ppvlist stream ("my ", "also ", (fn stream = fn named_field = print_named_field_as_nada context stream (named_field, d - 1)), fields);
end_box stream;
};
print_declaration_as_nada' (RECURSIVE_VALUE_DECLARATIONS (rvbs, type_variables), d)
=>
{ begin_horizontal_else_vertical_box stream;
ppvlist
stream
( "my rec ",
"also ",
( fn stream =>
fn named_recursive_values =>
print_recursively_named_value_as_nada
context
stream
(named_recursive_values, d - 1); end; end
),
rvbs
);
end_box stream;
};
print_declaration_as_nada' (FUNCTION_DECLARATIONS (fbs, type_variables), d)
=>
{ begin_horizontal_else_vertical_box stream;
ppvlist'
stream
( "fun ",
"also ",
( fn stream =>
fn str =>
fn fb =>
print_sml_named_function_as_nada
context
stream
str
(fb, d - 1); end; end; end
),
fbs
);
end_box stream;
};
print_declaration_as_nada' (NADA_FUNCTION_DECLARATIONS (fbs, type_variables), d)
=>
{ begin_horizontal_else_vertical_box stream;
ppvlist'
stream
( "fun ",
"also ",
( fn stream =>
fn str =>
fn fb =>
print_lib7_named_function_as_nada
context
stream
str
(fb, d - 1); end; end; end
),
fbs
);
end_box stream;
};
print_declaration_as_nada' (TYPE_DECLARATIONS typs, d)
=>
{ fun pr stream (typ)
=
(print_type_naming_as_nada context stream (typ, d));
print_closed_sequence_as_nada
stream
{ front => (by pp::string "type "),
sep => (fn stream => (break stream { spaces=>1, indent_on_wrap=>0 } ); end ),
back => (by pp::string ""),
pr,
style => INCONSISTENT
}
typs;
};
print_declaration_as_nada' (ENUM_DECLARATIONS { datatyps, with_typs => [] }, d)
=>
{ fun prd _ (dbing)
=
(print_datatype_naming_as_mythryl7 context stream (dbing, d));
print_closed_sequence_as_nada
stream
{ front => (by pp::string "enum "),
sep => (fn stream => (break stream { spaces=>1, indent_on_wrap=>0 } ); end ),
back => (by pp::string ""),
pr => prd,
style => INCONSISTENT
}
datatyps;
};
print_declaration_as_nada' (ENUM_DECLARATIONS { datatyps, with_typs }, d)
=>
{ fun prd stream dbing = (print_datatype_naming_as_mythryl7 context stream (dbing, d));
fun prw stream tbing = (print_type_naming_as_nada context stream (tbing, d));
{ begin_horizontal_else_vertical_box stream;
print_closed_sequence_as_nada
stream
{ front => (by pp::string "enum "),
sep => (fn stream => (break stream { spaces=>1, indent_on_wrap=>0 } ); end ),
back => (by pp::string ""),
pr => prd,
style => INCONSISTENT
}
datatyps;
newline stream;
print_closed_sequence_as_nada
stream
{ front => (by pp::string "withtype "),
sep => (fn stream => (break stream { spaces=>1, indent_on_wrap=>0 } ); end ),
back => (by pp::string ""),
pr => prw,
style => INCONSISTENT
}
with_typs;
end_box stream;
};
};
print_declaration_as_nada' (ABSTRACT_TYPE_DECLARATIONS { abstract_typs, with_typs => [], body }, d)
=>
{ fun prd stream dbing = (print_datatype_naming_as_mythryl7 context stream (dbing, d));
fun prw stream tbing = (print_type_naming_as_nada context stream (tbing, d));
{ begin_horizontal_else_vertical_box stream;
( print_closed_sequence_as_nada
stream
{ front => (by pp::string "enum "),
sep => (fn stream => (break stream { spaces=>1, indent_on_wrap=>0 } ); end ),
back => (by pp::string ""),
pr => prd,
style => INCONSISTENT
}
abstract_typs
);
newline stream;
print_declaration_as_nada' (body, d);
end_box stream;
};
};
print_declaration_as_nada' (ABSTRACT_TYPE_DECLARATIONS { abstract_typs, with_typs, body }, d)
=>
{ fun prd _ (dbing) = (print_datatype_naming_as_mythryl7 context stream (dbing, d));
fun prw _ (tbing) = (print_type_naming_as_nada context stream (tbing, d));
{ begin_horizontal_else_vertical_box stream;
( print_closed_sequence_as_nada
stream
{ front => (by pp::string "enum "),
sep => (fn stream => (break stream { spaces=>1, indent_on_wrap=>0 } ); end ),
back => (by pp::string ""),
pr => prd,
style => INCONSISTENT
}
abstract_typs
);
newline stream;
( print_closed_sequence_as_nada
stream
{ front => (by pp::string "withtype "),
sep => (fn stream => (break stream { spaces=>1, indent_on_wrap=>0 } ); end ),
back => (by pp::string ""),
pr => prw,
style => INCONSISTENT
}
with_typs
);
newline stream;
print_declaration_as_nada' (body, d);
end_box stream;
};
};
print_declaration_as_nada' (EXCEPTION_DECLARATIONS ebs, d)
=>
{ begin_horizontal_else_vertical_box stream;
( (fn stream => fn eb => print_exception_naming_as_nada context stream (eb, d - 1); end; end ), ebs );
end_box stream;
};
print_declaration_as_nada'(PACKAGE_DECLARATIONS sbs, d)
=>
{ fun pr _ (sbing)
=
(print_named_package_as_nada context stream (sbing, d));
print_closed_sequence_as_nada
stream
{ front => (by pp::string "package "),
sep => (fn stream => (break stream { spaces=>1, indent_on_wrap=>0 } ); end ),
back => (by pp::string ""),
pr,
style => INCONSISTENT
}
sbs;
};
print_declaration_as_nada' (GENERIC_DECLARATIONS fbs, d)
=>
{ fun f stream generic_naming
=
print_generic_naming_as_nada context stream (generic_naming, d);
begin_horizontal_else_vertical_box stream;
ppvlist stream ("generic package ", "also ", f, fbs);
end_box stream;
};
print_declaration_as_nada' (API_DECLARATIONS sigvars, d)
=>
{ fun f stream (NAMED_API { name_symbol=>fname, definition=>def } )
=>
{ print_symbol_as_nada stream fname; ppsay " =";
newline stream;
print_api_expression_as_nada 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);
end_box stream;
};
print_declaration_as_nada' (GENERIC_API_DECLARATIONS sigvars, d)
=>
{ fun pr stream sigv = print_generic_api_naming_as_nada context stream (sigv, d);
begin_horizontal_else_vertical_box stream;
print_sequence_as_nada
stream
{ sep => newline,
pr,
style => CONSISTENT
}
sigvars;
end_box stream;
};
print_declaration_as_nada' (LOCAL_DECLARATIONS (inner, outer), d)
=>
{ begin_horizontal_else_vertical_box stream;
ppsay "stipulate"; newline_indent stream 2;
print_declaration_as_nada' (inner, d - 1); newline stream;
ppsay "herein ";
print_declaration_as_nada' (outer, d - 1); newline stream;
ppsay "end ";
end_box stream;
};
print_declaration_as_nada' (SEQUENTIAL_DECLARATIONS decs, d)
=>
{ begin_horizontal_else_vertical_box stream;
print_sequence_as_nada
stream
{ sep => newline,
pr => (fn stream => fn declaration => print_declaration_as_nada'(declaration, d); end; end ),
style => CONSISTENT
}
decs;
end_box stream;
};
print_declaration_as_nada' (INCLUDE_DECLARATIONS named_packages, d)
=>
{ begin_horizontal_else_vertical_box stream;
ppsay "use ";
print_sequence_as_nada
stream
{ sep => (fn stream => break stream { spaces=>1, indent_on_wrap=>0 }; end ),
pr => (fn stream => fn sp => pp_symbol_list sp; end; end ),
style => INCONSISTENT
}
named_packages;
end_box stream;
};
print_declaration_as_nada' (OVERLOADED_VARIABLE_DECLARATION (symbol, type, explist, extension), d)
=>
{ ppsay "overloaded val ";
print_symbol_as_nada stream symbol;
};
print_declaration_as_nada' (FIXITY_DECLARATIONS { fixity, ops }, d)
=>
{ begin_horizontal_else_vertical_box stream;
case fixity
NONFIX => ppsay "nonfix ";
INFIX (i, _)
=>
{ if (i % 2 == 0)
ppsay "infix ";
else ppsay "infixr "; fi;
if (i / 2 > 0)
ppsay (int::to_string (i / 2));
ppsay " ";
fi;
};
esac;
print_sequence_as_nada
stream
{ sep => (fn stream => break stream { spaces=>1, indent_on_wrap=>0 }; end ),
pr => print_symbol_as_nada,
style => INCONSISTENT
}
ops;
end_box stream;
};
print_declaration_as_nada' (SOURCE_CODE_REGION_FOR_DECLARATION (declaration, (s, e)), d)
=>
case source_opt
#
THE source
=>
{ ppsay "SOURCE_CODE_REGION_FOR_DECLARATION(";
print_declaration_as_nada'(declaration, d); ppsay ", ";
prpos (stream, source, s); ppsay ", ";
prpos (stream, source, e); ppsay ")";
};
NULL => print_declaration_as_nada'(declaration, d);
esac;
print_declaration_as_nada' (PRE_COMPILE_CODE string, d)
=>
ppsay ("PRE_COMPILE_CODE \"" + string + "\"");
end;
print_declaration_as_nada';
}
also
fun print_named_value_as_nada (context as (dictionary, source_opt)) stream
=
{ ppsay = pp::string stream;
fun print_named_value_as_nada'(_, 0)=> ppsay "<naming>";
print_named_value_as_nada'(NAMED_VALUE { pattern, expression, ... }, d)
=>
{ begin_horizontal_else_vertical_box stream;
print_pattern_as_nada context stream (pattern, d - 1);
pp::string stream " =";
break stream { spaces=>1, indent_on_wrap=>2 };
print_expression_as_nada context stream (expression, d - 1);
end_box stream;
};
print_named_value_as_nada' (SOURCE_CODE_REGION_FOR_NAMED_VALUE (named_value, source_code_region), d)
=>
print_named_value_as_nada' (named_value, d); end;
print_named_value_as_nada';
}
also
fun print_named_field_as_nada (context as (dictionary, source_opt)) stream
=
{ ppsay = pp::string stream;
fun print_named_field_as_nada'(_, 0)=> ppsay "<field>";
print_named_field_as_nada'(NAMED_FIELD { name => symbol, type, init }, d)
=>
{ begin_horizontal_else_vertical_box stream;
pp_path stream [symbol];
pp::string stream " =";
print_type_as_nada context stream (type, d);
end_box stream;
};
print_named_field_as_nada' (SOURCE_CODE_REGION_FOR_NAMED_FIELD (named_field, source_code_region), d)
=>
print_named_field_as_nada' (named_field, d);
end;
print_named_field_as_nada';
}
also
fun print_recursively_named_value_as_nada (context as (_, source_opt)) stream
=
{ ppsay = pp::string stream;
fun print_recursively_named_value_as_nada'(_, 0)=> ppsay "<rec naming>";
print_recursively_named_value_as_nada'(NAMED_RECURSIVE_VALUE { variable_symbol, expression, ... }, d)
=>
{ begin_wrap_box stream;
print_symbol_as_nada stream variable_symbol; pp::string stream " =";
break stream { spaces=>1, indent_on_wrap=>2 }; print_expression_as_nada context stream (expression, d - 1);
end_box stream;
};
print_recursively_named_value_as_nada' (SOURCE_CODE_REGION_FOR_RECURSIVELY_NAMED_VALUE (named_recursive_values, source_code_region), d)
=>
print_recursively_named_value_as_nada' (named_recursive_values, d);
end;
print_recursively_named_value_as_nada';
}
also
fun print_sml_named_function_as_nada (context as (_, source_opt)) stream head
=
{ ppsay = pp::string stream;
fun print_sml_named_function_as_nada'(_, 0)
=>
ppsay "<FunNaming>";
print_sml_named_function_as_nada'(NAMED_FUNCTION { pattern_clauses, is_lazy, kind, null_or_type }, d)
=>
{
case kind
PLAIN_FUN => ppsay " fun ";
METHOD_FUN => ppsay " method fun ";
MESSAGE_FUN => ppsay " message fun ";
esac;
case null_or_type
THE type => { ppsay " : ";
print_type_as_nada context stream (type, d - 1);
};
NULL => ();
esac;
ppvlist stream
( head, " ; ",
(fn stream = fn (cl: Pattern_Clause) = (print_pattern_clause_as_nada context stream (cl, d))),
pattern_clauses
);
};
print_sml_named_function_as_nada' (SOURCE_CODE_REGION_FOR_NAMED_FUNCTION (t, r), d)
=>
print_sml_named_function_as_nada context stream head (t, d);
end;
print_sml_named_function_as_nada';
}
also
fun print_lib7_named_function_as_nada (context as (_, source_opt)) stream head
=
{ ppsay = pp::string stream;
fun print_lib7_named_function_as_nada'(_, 0)=> ppsay "<FunNaming>";
print_lib7_named_function_as_nada'(NADA_NAMED_FUNCTION (clauses, ops), d)
=>
ppvlist stream (head, " | ",
(fn stream => fn (cl: Nada_Pattern_Clause) => (print_lib7_pattern_clause_as_nada context stream (cl, d)); end; end ),
clauses);
print_lib7_named_function_as_nada' (SOURCE_CODE_REGION_FOR_NADA_NAMED_FUNCTION (t, r), d)
=>
print_lib7_named_function_as_nada context stream head (t, d);
end;
print_lib7_named_function_as_nada';
}
also
fun print_pattern_clause_as_nada (context as (_, source_opt)) stream
=
{ ppsay = pp::string stream;
fun print_pattern_clause_as_nada' (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
=>
print_pattern_as_nada context stream (item, d);
NULL
=>
( case item
PRE_FIXITY_PATTERN p
=>
{ pp::string stream "(";print_pattern_as_nada context stream (item, d);
pp::string stream ")";};
TYPE_CONSTRAINT_PATTERN p
=>
{ pp::string stream "(";print_pattern_as_nada context stream (item, d);
pp::string stream ")";};
AS_PATTERN p
=>
{ pp::string stream"(";print_pattern_as_nada context stream (item, d);
pp::string stream ")";};
OR_PATTERN p
=>
{ pp::string stream "(";print_pattern_as_nada context stream (item, d);
pp::string stream ")";};
_ => print_pattern_as_nada context stream (item, d); esac
); esac
);
{ begin_wrap_box stream;
( print_sequence_as_nada
stream
{ sep => (fn stream => (break stream { spaces=>1, indent_on_wrap=>0 } ); end ),
pr,
style => INCONSISTENT
}
patterns
);
( case result_type
THE type
=>
{ pp::string stream ":";
print_type_as_nada context stream (type, d);
};
NULL => (); esac
);
pp::string stream " =";
break stream { spaces=>1, indent_on_wrap=>0 };
print_expression_as_nada context stream (expression, d);
end_box stream;
};
};
print_pattern_clause_as_nada';
}
also
fun print_lib7_pattern_clause_as_nada (context as (_, source_opt)) stream
=
{ ppsay = pp::string stream;
fun print_lib7_pattern_clause_as_nada' (NADA_PATTERN_CLAUSE { pattern, result_type, expression }, d)
=
{ fun pr _ (item: Case_Pattern)
=
# XXX BUGGO FIXME need to get intelligent about paren insertion, by and by
{ pp::string stream "(";
print_pattern_as_nada context stream (item, d);
pp::string stream ")"
;};
{ begin_wrap_box stream;
( print_sequence_as_nada
stream
{ sep => (fn stream => (break stream { spaces=>1, indent_on_wrap=>0 } ); end ),
pr,
style => INCONSISTENT
}
# XXX BUGGO FIXME this list is (obviously!) always length 1 -- the logic probably needs fixing.
[ pattern ]
);
case result_type
THE type
=>
{ pp::string stream ":";
print_type_as_nada context stream (type, d);
};
NULL => ();
esac;
pp::string stream " =";
break stream { spaces=>1, indent_on_wrap=>0 };
print_expression_as_nada context stream (expression, d);
end_box stream;
};
};
print_lib7_pattern_clause_as_nada';
}
also
fun print_type_naming_as_nada (context as (_, source_opt)) stream
=
{ ppsay = pp::string stream;
fun pp_tyvar_list (symbol_list, d)
=
{ fun pr _ (type_variable) = (print_type_variable_as_nada context stream (type_variable, d));
print_sequence_as_nada
stream
{ sep => (fn stream => { pp::string stream "*";
break stream { spaces=>1, indent_on_wrap=>0 } ;}; end ),
pr,
style => INCONSISTENT
}
symbol_list;
};
fun print_type_naming_as_nada'(_, 0)=> ppsay "<t::naming>";
print_type_naming_as_nada' (NAMED_TYPE { typ, definition, type_variables }, d)
=>
{ begin_wrap_box stream;
print_symbol_as_nada stream typ; pp::string stream " =";
break stream { spaces=>1, indent_on_wrap=>0 }; print_type_as_nada context stream (definition, d);
pp_tyvar_list (type_variables, d);
end_box stream;
};
print_type_naming_as_nada' (SOURCE_CODE_REGION_FOR_NAMED_TYPE (t, r), d)
=>
print_type_naming_as_nada context stream (t, d);
end;
print_type_naming_as_nada';
}
also
fun print_datatype_naming_as_mythryl7 (context as (_, source_opt)) stream
=
{ ppsay = pp::string stream;
fun pp_tyvar_list (symbol_list, d)
=
{ fun pr _ (type_variable) = (print_type_variable_as_nada context stream (type_variable, d));
print_sequence_as_nada
stream
{ sep => (fn stream => { pp::string stream "*";
break stream { spaces=>1, indent_on_wrap=>0 } ;}; end ),
pr,
style => INCONSISTENT
}
symbol_list;
};
fun print_datatype_naming_as_mythryl7'(_, 0)=> ppsay "<d::naming>";
print_datatype_naming_as_mythryl7' (NAMED_ENUM { typ, type_variables, right_hand_side, is_lazy }, d)
=>
{ begin_wrap_box stream;
print_symbol_as_nada stream typ;
pp::string stream " =";
break stream { spaces=>1, indent_on_wrap=>0 };
print_datatype_naming_right_hand_side_as_nada context stream (right_hand_side, d);
end_box stream;
};
print_datatype_naming_as_mythryl7'(SOURCE_CODE_REGION_FOR_NAMED_DATATYPE (t, r), d)
=>
print_datatype_naming_as_mythryl7 context stream (t, d); end;
print_datatype_naming_as_mythryl7';
}
also
fun print_datatype_naming_right_hand_side_as_nada (context as (_, source_opt)) stream
=
{ ppsay = pp::string stream;
fun print_datatype_naming_right_hand_side_as_nada'(_, 0)=> ppsay "<datatype_naming_right_hand_side>";
print_datatype_naming_right_hand_side_as_nada' (VALCONS const, d)
=>
{ fun pr stream (symbol: Symbol, tv: Null_Or( raw_syntax::Any_Type ))
=
case tv
THE a
=>
{ print_symbol_as_nada stream symbol;
# ppsay" of ";
ppsay " ";
print_type_as_nada context stream (a, d);
};
NULL
=>
(print_symbol_as_nada stream symbol);
esac;
print_sequence_as_nada
stream
{ sep => (fn stream = { pp::string stream "; ";
break stream { spaces=>1, indent_on_wrap=>0 } ;}),
pr,
style => INCONSISTENT
}
const;
};
print_datatype_naming_right_hand_side_as_nada' (REPLICAS symlist, d)
=>
print_sequence_as_nada
stream
{ sep => (fn stream = { pp::string stream "; ";
break stream { spaces=>1, indent_on_wrap=>0 } ;}),
pr => (fn stream = fn symbol = print_symbol_as_nada stream symbol),
style => INCONSISTENT
}
symlist;
end;
print_datatype_naming_right_hand_side_as_nada';
}
also
fun print_exception_naming_as_nada (context as (_, source_opt)) stream
=
{ ppsay = pp::string stream;
pp_symbol_list = pp_path stream;
fun print_exception_naming_as_nada'(_, 0)=> ppsay "<Eb>";
print_exception_naming_as_nada' ( NAMED_EXCEPTION {
exception_symbol => exn,
exception_type => etype
},
d
)
=>
( case etype
THE a
=>
{ begin_horizontal_else_vertical_box stream;
print_symbol_as_nada stream exn; pp::string stream " =";
break stream { spaces=>1, indent_on_wrap=>2 }; print_type_as_nada context stream (a, d - 1);
end_box stream
;};
NULL
=>
{ begin_horizontal_else_vertical_box stream;
print_symbol_as_nada stream exn;
end_box stream
;}; esac
);
print_exception_naming_as_nada' ( 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;
print_symbol_as_nada stream exn;
pp::string stream " =";
break stream { spaces=>1, indent_on_wrap=>2 };
pp_symbol_list (edef);
end_box stream;
};
print_exception_naming_as_nada' (SOURCE_CODE_REGION_FOR_NAMED_EXCEPTION (t, r), d)
=>
print_exception_naming_as_nada context stream (t, d);
end;
print_exception_naming_as_nada';
}
also
fun print_named_package_as_nada (context as (_, source_opt)) stream
=
{ ppsay = pp::string stream;
fun print_named_package_as_nada'(_, 0)=> ppsay "<NAMED_PACKAGE>";
print_named_package_as_nada' ( NAMED_PACKAGE { name_symbol=>name, definition=>def, constraint, kind }, d)
=>
{ begin_horizontal_else_vertical_box stream;
print_symbol_as_nada stream name; pp::string stream " :";
break stream { spaces=>1, indent_on_wrap=>2 }; print_package_expression_as_nada context stream (def, d - 1);
end_box stream;
};
print_named_package_as_nada' (SOURCE_CODE_REGION_FOR_NAMED_PACKAGE (t, r), d)
=>
print_named_package_as_nada context stream (t, d);
end;
print_named_package_as_nada';
}
also
fun print_generic_naming_as_nada (context as (_, source_opt)) stream
=
{ ppsay = pp::string stream;
fun print_generic_naming_as_nada' (_, 0) => ppsay "<NAMED_GENERIC>";
print_generic_naming_as_nada' (
NAMED_GENERIC {
name_symbol => name,
definition => GENERIC_DEFINITION { parameters, body, constraint }
},
d
)
=>
{ begin_horizontal_else_vertical_box stream;
print_symbol_as_nada stream name;
{ fun pr stream (THE symbol, api_expression)
=>
{ ppsay "(";
print_symbol_as_nada stream symbol;
ppsay " : ";
print_api_expression_as_nada context stream (api_expression, d);
ppsay ")";
};
pr stream (NULL, api_expression)
=>
{ ppsay "(";
print_api_expression_as_nada context stream (api_expression, d);
ppsay ")";
};
end;
{ print_sequence_as_nada
stream
{ sep => (fn stream => (break stream { spaces=>1, indent_on_wrap=>0 } ); end ),
pr,
style => INCONSISTENT
}
parameters;
case constraint
NO_PACKAGE_CAST
=>
();
WEAK_PACKAGE_CAST (api_expression)
=>
{ ppsay ": (weak)";
break stream { spaces=>1, indent_on_wrap=>2 };
print_api_expression_as_nada context stream (api_expression, d);
};
PARTIAL_PACKAGE_CAST (api_expression)
=>
{ ppsay ": (partial)";
break stream { spaces=>1, indent_on_wrap=>2 };
print_api_expression_as_nada context stream (api_expression, d);
};
STRONG_PACKAGE_CAST (api_expression)
=>
{ ppsay ":";
break stream { spaces=>1, indent_on_wrap=>2 };
print_api_expression_as_nada context stream (api_expression, d);
};
esac;
nonbreakable_spaces stream 1;
ppsay "="; break stream { spaces=>1, indent_on_wrap=>0 };
print_package_expression_as_nada context stream (body, d);};
};
end_box stream;
};
print_generic_naming_as_nada' ( NAMED_GENERIC { name_symbol=>name, definition=>def }, d)
=>
{ begin_horizontal_else_vertical_box stream;
print_symbol_as_nada stream name;
pp::string stream " =";
break stream { spaces=>1, indent_on_wrap=>2 };
print_generic_expression_as_nada context stream (def, d - 1);
end_box stream;
};
print_generic_naming_as_nada' (SOURCE_CODE_REGION_FOR_NAMED_GENERIC (t, r), d)
=>
print_generic_naming_as_nada context stream (t, d);
end;
print_generic_naming_as_nada';
}
also
fun print_generic_api_naming_as_nada (context as (_, source_opt)) stream
=
{ ppsay = pp::string stream;
fun print_generic_api_naming_as_nada'(_, 0)=> ppsay "<NAMED_GENERIC_API>";
print_generic_api_naming_as_nada' (NAMED_GENERIC_API { name_symbol=>name, definition=>def }, d)
=>
{ begin_horizontal_else_vertical_box stream;
ppsay "funsig "; print_symbol_as_nada stream name; ppsay " =";
break stream { spaces=>1, indent_on_wrap=>2 }; print_generic_api_expression_as_nada context stream (def, d - 1);
end_box stream;
};
print_generic_api_naming_as_nada' (SOURCE_REGION_FOR_NAMED_GENERIC_API (t, r), d)
=>
print_generic_api_naming_as_nada context stream (t, d);
end;
print_generic_api_naming_as_nada';
}
also
fun print_type_variable_as_nada (context as (_, source_opt)) stream
=
{ ppsay = pp::string stream;
fun print_type_variable_as_nada' (_, 0) => ppsay "<type_variable>";
print_type_variable_as_nada' (TYPE_VARIABLE s, d) => (print_symbol_as_nada stream s);
print_type_variable_as_nada' (SOURCE_CODE_REGION_FOR_TYPE_VARIABLE (t, r), d) => print_type_variable_as_nada context stream (t, d); end;
print_type_variable_as_nada';
}
also
fun print_type_as_nada (context as (dictionary, source_opt)) stream
=
{ ppsay = pp::string stream;
#
fun print_type_as_nada' (_, 0)
=>
ppsay "<type>";
print_type_as_nada' (TYPE_VARIABLE_TYPE t, d)
=>
(print_type_variable_as_nada context stream (t, d));
print_type_as_nada' (TYP_TYPE (typ, []), d)
=>
{ begin_indented_horizontal_else_vertical_box stream (pp::CURSOR_RELATIVE 1);
pp_path stream typ;
end_box stream;
};
print_type_as_nada' (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]
=>
{ print_type_as_nada' (dom, d - 1);
ppsay " ->";
break stream { spaces=>1, indent_on_wrap=>2 };
print_type_as_nada' (ran, d - 1);
};
_ => err::impossible "wrong args for -> type";
esac;
else
print_type_args_as_nada (args, d);
print_symbol_as_nada stream typ;
end_box stream;
fi;
_ => { print_type_args_as_nada (args, d);
pp_path stream typ;
end_box stream;
};
esac;
};
print_type_as_nada' (RECORD_TYPE s, d)
=>
{ fun pr stream (symbol: Symbol, tv: raw_syntax::Any_Type)
=
{ print_symbol_as_nada stream symbol;
ppsay ":";
print_type_as_nada context stream (tv, d)
;};
print_closed_sequence_as_nada
stream
{ front => (by pp::string "{"),
sep => (fn stream => { pp::string stream ", ";
break stream { spaces=>1, indent_on_wrap=>0 } ;}; end ),
back => (by pp::string "}"),
pr,
style => INCONSISTENT
}
s;
};
print_type_as_nada' (TUPLE_TYPE t, d)
=>
{ fun pr _ (tv: raw_syntax::Any_Type)
=
(print_type_as_nada context stream (tv, d));
print_sequence_as_nada
stream
{ sep => (fn stream => { pp::string stream " *";
break stream { spaces=>1, indent_on_wrap=>0 } ;}; end ),
pr,
style => INCONSISTENT
}
t;
};
print_type_as_nada' (SOURCE_CODE_REGION_FOR_TYPE (t, r), d)
=>
(print_type_as_nada context stream (t, d));
end
also
fun print_type_args_as_nada ([], d)
=>
();
print_type_args_as_nada ( [type], d)
=>
{ if (strength type <= 1)
begin_indented_wrap_box stream (pp::CURSOR_RELATIVE 1);
ppsay "(";
print_type_as_nada' (type, d);
ppsay ")";
end_box stream;
else
print_type_as_nada' (type, d);
fi;
break stream { spaces => 1, indent_on_wrap => 0 };
};
print_type_args_as_nada (tys, d)
=>
print_closed_sequence_as_nada
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 = print_type_as_nada' (type, d)
}
tys;
end;
print_type_as_nada';
};
}; # package print_raw_syntax_tree_as_nada
end;