## print-deep-syntax-as-nada.pkg
# Compiled by:
# src/lib/compiler/front/typer/typer.sublibstipulate
package ds = deep_syntax; # deep_syntax is from src/lib/compiler/front/typer-stuff/deep-syntax/deep-syntax.pkg package pp = standard_prettyprinter; # standard_prettyprinter is from src/lib/prettyprint/big/src/standard-prettyprinter.pkg package sci = sourcecode_info; # sourcecode_info is from src/lib/compiler/front/basics/source/sourcecode-info.pkg package syx = symbolmapstack; # symbolmapstack is from src/lib/compiler/front/typer-stuff/symbolmapstack/symbolmapstack.pkgherein
api Print_Deep_Syntax_As_Lib7 {
#
print_pattern_as_nada: syx::Symbolmapstack
-> pp::Prettyprinter
-> (ds::Case_Pattern,
Int)
-> Void;
print_expression_as_nada: (syx::Symbolmapstack,
Null_Or( sci::Sourcecode_Info ))
-> pp::Prettyprinter
-> (ds::Deep_Expression,
Int)
-> Void;
print_rule_as_nada: (syx::Symbolmapstack,
Null_Or( sci::Sourcecode_Info ))
-> pp::Prettyprinter
-> (ds::Case_Rule,
Int)
-> Void;
print_named_value_as_nada: (syx::Symbolmapstack,
Null_Or( sci::Sourcecode_Info ))
-> pp::Prettyprinter
-> (ds::Named_Value,
Int)
-> Void;
print_recursively_named_value_as_nada: (syx::Symbolmapstack,
Null_Or( sci::Sourcecode_Info ))
-> pp::Prettyprinter
-> (ds::Named_Recursive_Value,
Int)
-> Void;
print_declaration_as_nada: (syx::Symbolmapstack,
Null_Or( sci::Sourcecode_Info ))
-> pp::Prettyprinter
-> (ds::Declaration,
Int)
-> Void;
print_strexp_as_nada: (syx::Symbolmapstack,
Null_Or( sci::Sourcecode_Info ))
-> pp::Prettyprinter
-> (ds::Package_Expression,
Int)
-> Void;
lineprint: Ref( Bool );
debugging: Ref( Bool );
}; # Api Print_Deep_Syntax_As_Lib7
end;
stipulate
package cp = control_print; # control_print is from src/lib/compiler/front/basics/print/control-print.pkg package ds = deep_syntax; # deep_syntax is from src/lib/compiler/front/typer-stuff/deep-syntax/deep-syntax.pkg package err = error_message; # error_message is from src/lib/compiler/front/basics/errormsg/error-message.pkg package mwi = multiword_int; # multiword_int is from src/lib/std/multiword-int.pkg package mld = module_level_declarations; # module_level_declarations is from src/lib/compiler/front/typer-stuff/modules/module-level-declarations.pkg package pp = standard_prettyprinter; # standard_prettyprinter is from src/lib/prettyprint/big/src/standard-prettyprinter.pkg package sci = sourcecode_info; # sourcecode_info is from src/lib/compiler/front/basics/source/sourcecode-info.pkg package sy = symbol; # symbol is from src/lib/compiler/front/basics/map/symbol.pkg package tc = typer_control; # typer_control is from src/lib/compiler/front/typer/basics/typer-control.pkg package tdt = type_declaration_types; # type_declaration_types is from src/lib/compiler/front/typer-stuff/types/type-declaration-types.pkg include package tuples;
include package fixity;
include package variables_and_constructors;
include package type_declaration_types; # type_declaration_types is from src/lib/compiler/front/typer-stuff/types/type-declaration-types.pkg include package pp;
include package print_as_nada_junk;
include package print_typoid_as_nada;
include package print_value_as_nada;
herein
package print_deep_syntax_as_nada
: (weak) Print_Deep_Syntax_As_Lib7
{
# Debugging
#
say = cp::say;
#
debugging = REF FALSE;
fun if_debugging_say (msg: String)
=
if *debugging { say msg; say "\n";};
else ();
fi;
fun bug msg
=
err::impossible ("print_deep_syntax_as_nada: " + msg);
# internals = tc::internals;
internals = log::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 ( pp: pp::Prettyprinter,
source: sci::Sourcecode_Info,
charpos: Int
)
=
if *lineprint
#
(sci::filepos source charpos)
->
(file: String, line: Int, pos: Int);
pp.lit (int::to_string line);
pp.lit ".";
pp.lit (int::to_string pos);
else
pp.lit (int::to_string charpos);
fi;
fun checkpat (n, NIL)
=>
TRUE;
checkpat (n, (symbol, _) ! fields)
=>
sy::eq (symbol, number_to_label n) and checkpat (n+1, fields);
end;
fun checkexp (n, NIL)
=>
TRUE;
checkexp (n, (ds::NUMBERED_LABEL { name=>symbol, ... }, _) ! fields)
=>
sy::eq (symbol, number_to_label n) and checkexp (n+1, fields);
end;
fun is_tuplepat (ds::RECORD_PATTERN { fields => [_], ... } ) => FALSE;
is_tuplepat (ds::RECORD_PATTERN { is_incomplete => FALSE, fields, ... } ) => checkpat (1, fields);
is_tuplepat _ => FALSE;
end;
fun is_tupleexp (ds::RECORD_IN_EXPRESSION [_]) => FALSE;
is_tupleexp (ds::RECORD_IN_EXPRESSION fields) => checkexp (1, fields);
is_tupleexp (ds::SOURCE_CODE_REGION_FOR_EXPRESSION (a, _)) => is_tupleexp a;
is_tupleexp _ => FALSE;
end;
fun get_fix (dictionary, symbol)
=
find_in_symbolmapstack::find_fixity_by_symbol
(
dictionary,
sy::make_fixity_symbol (sy::name symbol)
);
fun strip_source_code_region_data (ds::SOURCE_CODE_REGION_FOR_EXPRESSION (a, _))
=>
strip_source_code_region_data a;
strip_source_code_region_data x
=>
x;
end;
fun print_pattern_as_nada dictionary pp
=
{ ppsay = pp.lit;
fun print_pattern_as_nada' (_, 0) => ppsay "<pattern>";
print_pattern_as_nada' (ds::VARIABLE_IN_PATTERN v, _) => print_var_as_nada pp v;
print_pattern_as_nada' (ds::WILDCARD_PATTERN, _) => ppsay "_";
print_pattern_as_nada' (ds::INT_CONSTANT_IN_PATTERN (i, t), _) => ppsay (mwi::to_string i);
/* (begin_block pp INCONSISTENT 2;
ppsay "("; ppsay (mwi::to_string i);
ppsay " :"; break pp { spaces=1, indent_on_wrap=1 };
prettyprint_type dictionary pp t; ppsay ")";
end_block pp) */
print_pattern_as_nada' (ds::UNT_CONSTANT_IN_PATTERN (w, t), _) => ppsay (mwi::to_string w);
/* (open_style_box INCONSISTENT pp (pp::typ::CURSOR_RELATIVE { blanks => 1, tab_to => 0, tabstops_are_every => 4 });
ppsay "("; ppsay (mwi::to_string w);
ppsay " :"; break pp { blanks=1, indent_on_wrap=1 };
print_typoid_as_nada dictionary pp t; ppsay ")";
shut_box pp) */
print_pattern_as_nada' (ds::FLOAT_CONSTANT_IN_PATTERN r, _) => ppsay r;
print_pattern_as_nada' (ds::STRING_CONSTANT_IN_PATTERN s, _) => print_lib7_string_as_nada pp s;
print_pattern_as_nada' (ds::CHAR_CONSTANT_IN_PATTERN s, _) => { ppsay "#"; print_lib7_string_as_nada pp s;};
print_pattern_as_nada' (ds::AS_PATTERN (v, p), d)
=>
{ open_style_box CONSISTENT pp (pp::typ::CURSOR_RELATIVE { blanks => 1, tab_to => 0, tabstops_are_every => 4 });
print_pattern_as_nada'(v, d); ppsay " as "; print_pattern_as_nada'(p, d - 1);
shut_box pp;
};
# Handle 0 length case specially to avoid {, ... }:
print_pattern_as_nada' (ds::RECORD_PATTERN { fields => [], is_incomplete, ... }, _)
=>
if is_incomplete ppsay "{... }";
else ppsay "()";
fi;
print_pattern_as_nada' (r as ds::RECORD_PATTERN { fields, is_incomplete, ... }, d)
=>
if (is_tuplepat r)
print_closed_sequence_as_nada pp
{ front=>(by pp::lit "("),
sep=>(\\ pp => { pp.lit ", ";
break pp { blanks=>0, indent_on_wrap=>0 } ;}; end ),
back=>(by pp::lit ")"),
pr=>(\\ _ => \\ (symbol, pattern) => print_pattern_as_nada'(pattern, d - 1); end; end ),
style=>INCONSISTENT }
fields;
else print_closed_sequence_as_nada pp
{ front=>(by pp::lit "{ "),
sep=>(\\ pp = { pp.lit ", ";
break pp { blanks=>0, indent_on_wrap=>0 };
}
),
back=>(\\ pp = if is_incomplete pp.lit ", ... }";
else pp.lit "}";
fi
),
pr=>(\\ pp = \\ (symbol, pattern) =
{ print_symbol_as_nada pp symbol; pp.lit "=";
print_pattern_as_nada'(pattern, d - 1);
}
),
style=>INCONSISTENT }
fields;
fi;
print_pattern_as_nada' (ds::VECTOR_PATTERN (NIL, _), d) => ppsay "#[]";
print_pattern_as_nada' (ds::VECTOR_PATTERN (pats, _), d)
=>
{ fun pr _ pattern = print_pattern_as_nada' (pattern, d - 1);
print_closed_sequence_as_nada pp
{ front => (by pp::lit "#["),
sep => (\\ pp => { pp.lit ", ";
break pp { blanks=>0, indent_on_wrap=>0 } ;}; end ),
back => (by pp::lit "]"),
pr,
style => INCONSISTENT
}
pats;
};
print_pattern_as_nada' (pattern as (ds::OR_PATTERN _), d)
=>
{
fun make_list (ds::OR_PATTERN (hd, tl)) => hd ! make_list tl;
make_list p => [p];
end;
fun pr _ pattern = print_pattern_as_nada'(pattern, d - 1);
print_closed_sequence_as_nada pp {
front => (by pp::lit "("),
sep => \\ pp => { break pp { blanks=>1, indent_on_wrap=>0 };
pp.lit "| ";}; end ,
back => (by pp::lit ")"),
pr,
style => INCONSISTENT
} (make_list pattern);
};
print_pattern_as_nada' (ds::CONSTRUCTOR_PATTERN (e, _), _) => print_valcon_as_nada pp e;
print_pattern_as_nada' (p as ds::APPLY_PATTERN _, d)
=>
print_valcon_pattern_as_nada (dictionary, pp) (p, null_fix, null_fix, d);
print_pattern_as_nada' (ds::TYPE_CONSTRAINT_PATTERN (p, t), d)
=>
{ open_style_box INCONSISTENT pp (pp::typ::CURSOR_RELATIVE { blanks => 1, tab_to => 0, tabstops_are_every => 4 });
print_pattern_as_nada'(p, d - 1); ppsay " :";
break pp { blanks=>1, indent_on_wrap=>2 };
print_typoid_as_nada dictionary pp t;
shut_box pp;
};
print_pattern_as_nada' _ => bug "print_pattern_as_nada'";
end;
print_pattern_as_nada';
}
also
fun print_valcon_pattern_as_nada (dictionary, pp)
=
{ fun lpcond (atom) = if atom pp.lit "("; fi;
fun rpcond (atom) = if atom pp.lit ")"; fi;
fun print_valcon_pattern_as_nada'(_, _, _, 0) => pp.lit "<pattern>";
print_valcon_pattern_as_nada' (ds::CONSTRUCTOR_PATTERN (VALCON { name, ... }, _), l: Fixity, r: Fixity, _)
=>
print_symbol_as_nada pp name;
print_valcon_pattern_as_nada'(ds::TYPE_CONSTRAINT_PATTERN (p, t), l, r, d)
=>
{ open_style_box INCONSISTENT pp (pp::typ::CURSOR_RELATIVE { blanks => 1, tab_to => 0, tabstops_are_every => 4 });
pp.lit "("; print_pattern_as_nada dictionary pp (p, d - 1); pp.lit " :";
break pp { blanks=>1, indent_on_wrap=>2 };
print_typoid_as_nada dictionary pp t; pp.lit ")";
shut_box pp;
};
print_valcon_pattern_as_nada'(ds::AS_PATTERN (v, p), l, r, d)
=>
{ open_style_box INCONSISTENT pp (pp::typ::CURSOR_RELATIVE { blanks => 1, tab_to => 0, tabstops_are_every => 4 });
pp.lit "("; print_pattern_as_nada dictionary pp (v, d); break pp { blanks=>1, indent_on_wrap=>2 };
pp.lit " as "; print_pattern_as_nada dictionary pp (p, d - 1); pp.lit ")";
shut_box pp;
};
print_valcon_pattern_as_nada' (ds::APPLY_PATTERN (VALCON { name, ... }, _, p), l, r, d)
=>
{ dname = sy::name name;
# Should really have original path, like for VARIABLE_IN_EXPRESSION
this_fix = get_fix (dictionary, name);
eff_fix
=
case this_fix
NONFIX => inf_fix;
x => x;
esac;
atom = stronger_r (eff_fix, r) or stronger_l (l, eff_fix);
open_style_box INCONSISTENT pp (pp::typ::CURSOR_RELATIVE { blanks => 1, tab_to => 0, tabstops_are_every => 4 });
lpcond (atom);
case (this_fix, p)
#
(INFIX _, ds::RECORD_PATTERN { fields => [(_, pl), (_, pr)], ... } )
=>
{ my (left, right)
=
if atom (null_fix, null_fix);
else (l, r);fi;
print_valcon_pattern_as_nada' (pl, left, this_fix, d - 1);
break pp { blanks=>1, indent_on_wrap=>0 };
pp.lit dname;
break pp { blanks=>1, indent_on_wrap=>0 };
print_valcon_pattern_as_nada' (pr, this_fix, right, d - 1);
};
_ =>
{ pp.lit dname;
break pp { blanks=>1, indent_on_wrap=>0 };
print_valcon_pattern_as_nada'(p, inf_fix, inf_fix, d - 1);
};
esac;
rpcond (atom);
shut_box pp;
};
print_valcon_pattern_as_nada' (p, _, _, d) => print_pattern_as_nada dictionary pp (p, d);
end;
print_valcon_pattern_as_nada';
};
fun trim [x] => [];
trim (a ! b) => a ! trim b;
trim [] => [];
end;
fun print_expression_as_nada (context as (dictionary, source_opt)) pp
=
{ fun lparen () = pp.lit "(";
fun rparen () = pp.lit ")";
fun lpcond (atom) = if atom pp.lit "("; fi;
fun rpcond (atom) = if atom pp.lit ")"; fi;
fun print_expression_as_nada' (_, _, 0) => pp.lit "<expression>";
#
print_expression_as_nada' (ds::VARIABLE_IN_EXPRESSION { var => REF var, ... }, _, _) => print_var_as_nada pp var;
print_expression_as_nada' (ds::VALCON_IN_EXPRESSION { valcon, ... }, _, _) => print_valcon_as_nada pp valcon;
print_expression_as_nada' ( ds::INT_CONSTANT_IN_EXPRESSION (i, t), _, _) => pp.lit (mwi::to_string i);
print_expression_as_nada' ( ds::UNT_CONSTANT_IN_EXPRESSION (w, t), _, _) => pp.lit (mwi::to_string w);
print_expression_as_nada' ( ds::FLOAT_CONSTANT_IN_EXPRESSION r, _, _) => pp.lit r;
print_expression_as_nada' (ds::STRING_CONSTANT_IN_EXPRESSION s, _, _) => print_lib7_string_as_nada pp s;
print_expression_as_nada' (ds::CHAR_CONSTANT_IN_EXPRESSION s, _, _) => { pp.lit "#"; print_lib7_string_as_nada pp s;};
print_expression_as_nada' (r as ds::RECORD_IN_EXPRESSION fields, _, d)
=>
if (is_tupleexp r)
print_closed_sequence_as_nada pp
{ front=>(by pp::lit "("),
sep=>(\\ pp => { pp.lit ", ";
break pp { blanks=>0, indent_on_wrap=>0 } ;}; end ),
back=>(by pp::lit ")"),
pr=>(\\ _ => \\ (_, expression) => print_expression_as_nada'(expression, FALSE, d - 1); end; end ),
style=>INCONSISTENT }
fields;
else print_closed_sequence_as_nada pp
{ front=>(by pp::lit "{ "),
sep=>(\\ pp => { pp.lit ", ";
break pp { blanks=>0, indent_on_wrap=>0 } ;}; end ),
back=>(by pp::lit "}"),
pr=>(\\ pp => \\ (ds::NUMBERED_LABEL { name, ... }, expression) =>
{ print_symbol_as_nada pp name; pp.lit "=";
print_expression_as_nada'(expression, FALSE, d);}; end; end ),
style=>INCONSISTENT }
fields;fi;
print_expression_as_nada' (ds::RECORD_SELECTOR_EXPRESSION (ds::NUMBERED_LABEL { name, ... }, expression), atom, d)
=>
{ open_style_box CONSISTENT pp (pp::typ::CURSOR_RELATIVE { blanks => 1, tab_to => 0, tabstops_are_every => 4 });
lpcond (atom);
pp.lit "#"; print_symbol_as_nada pp name;
print_expression_as_nada'(expression, TRUE, d - 1); pp.lit ">";
rpcond (atom);
shut_box pp;
};
print_expression_as_nada'(ds::VECTOR_IN_EXPRESSION (NIL, _), _, d) => pp.lit "#[]";
print_expression_as_nada'(ds::VECTOR_IN_EXPRESSION (exps, _), _, d)
=>
{ fun pr _ expression = print_expression_as_nada'(expression, FALSE, d - 1);
print_closed_sequence_as_nada pp
{ front => (by pp::lit "#["),
sep => (\\ pp => { pp.lit ", ";
break pp { blanks=>1, indent_on_wrap=>0 } ;}; end ),
back => (by pp::lit "]"),
pr,
style => INCONSISTENT
}
exps;
};
print_expression_as_nada'(ds::ABSTRACTION_PACKING_EXPRESSION (e, t, tcs), atom, d)
=>
if *internals
#
open_style_box INCONSISTENT pp (pp::typ::CURSOR_RELATIVE { blanks => 1, tab_to => 0, tabstops_are_every => 4 });
pp.lit "<PACK: "; print_expression_as_nada'(e, FALSE, d); pp.lit "; ";
break pp { blanks=>1, indent_on_wrap=>2 };
print_typoid_as_nada dictionary pp t; pp.lit ">";
shut_box pp;
else
print_expression_as_nada'(e, atom, d);
fi;
print_expression_as_nada'(ds::SEQUENTIAL_EXPRESSIONS exps, _, d)
=>
print_closed_sequence_as_nada pp
{ front => (by pp::lit "("),
sep => (\\ pp = { pp.lit ";";
break pp { blanks=>1, indent_on_wrap=>0 } ;}),
back => (by pp::lit ")"),
pr => (\\ _ = \\ expression = print_expression_as_nada'(expression, FALSE, d - 1)),
style => INCONSISTENT
}
exps;
print_expression_as_nada'(e as ds::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'(ds::TYPE_CONSTRAINT_EXPRESSION (e, t), atom, d)
=>
{ open_style_box INCONSISTENT pp (pp::typ::CURSOR_RELATIVE { blanks => 1, tab_to => 0, tabstops_are_every => 4 });
lpcond (atom);
print_expression_as_nada'(e, FALSE, d); pp.lit ":";
break pp { blanks=>1, indent_on_wrap=>2 };
print_typoid_as_nada dictionary pp t;
rpcond (atom);
shut_box pp;
};
print_expression_as_nada'(ds::EXCEPT_EXPRESSION (expression, (rules, _)), atom, d)
=>
{ open_style_box CONSISTENT pp (pp::typ::CURSOR_RELATIVE { blanks => 1, tab_to => 0, tabstops_are_every => 4 });
lpcond (atom);
print_expression_as_nada'(expression, atom, d - 1); newline pp; pp.lit "except ";
newline_indent pp 2;
ppvlist pp (" ", "| ",
(\\ pp = \\ r = print_rule_as_nada context pp (r, d - 1)), rules);
rpcond (atom);
shut_box pp;
};
print_expression_as_nada'(ds::RAISE_EXPRESSION (expression, _), atom, d)
=>
{ open_style_box CONSISTENT pp (pp::typ::CURSOR_RELATIVE { blanks => 1, tab_to => 0, tabstops_are_every => 4 });
lpcond (atom);
pp.lit "raise exception "; print_expression_as_nada'(expression, TRUE, d - 1);
rpcond (atom);
shut_box pp;
};
print_expression_as_nada'(ds::LET_EXPRESSION (declaration, expression), _, d)
=>
{ open_style_box CONSISTENT pp (pp::typ::CURSOR_RELATIVE { blanks => 1, tab_to => 0, tabstops_are_every => 4 });
pp.lit "{ /*let*/ ";
open_style_box CONSISTENT pp (pp::typ::CURSOR_RELATIVE { blanks => 1, tab_to => 0, tabstops_are_every => 4 });
print_declaration_as_nada context pp (declaration, d - 1);
shut_box pp;
break pp { blanks=>1, indent_on_wrap=>0 };
pp.lit " /*in*/ ";
open_style_box CONSISTENT pp (pp::typ::CURSOR_RELATIVE { blanks => 1, tab_to => 0, tabstops_are_every => 4 });
print_expression_as_nada'(expression, FALSE, d - 1);
shut_box pp;
break pp { blanks=>1, indent_on_wrap=>0 };
pp.lit "} /*end of let*/";
shut_box pp;
};
print_expression_as_nada'(ds::CASE_EXPRESSION (expression, rules, _), _, d)
=>
{ open_style_box CONSISTENT pp (pp::typ::CURSOR_RELATIVE { blanks => 1, tab_to => 0, tabstops_are_every => 4 });
pp.lit "(given "; print_expression_as_nada'(expression, TRUE, d - 1); newline_indent pp 2;
ppvlist pp ("when ", " when ",
(\\ pp => \\ r => print_rule_as_nada context pp (r, d - 1); end; end ),
trim rules);
rparen();
shut_box pp;
};
print_expression_as_nada' (ds::IF_EXPRESSION { test_case, then_case, else_case }, atom, d)
=>
{ open_style_box CONSISTENT pp (pp::typ::CURSOR_RELATIVE { blanks => 1, tab_to => 0, tabstops_are_every => 4 });
lpcond (atom);
pp.lit "if ";
open_style_box CONSISTENT pp (pp::typ::CURSOR_RELATIVE { blanks => 1, tab_to => 0, tabstops_are_every => 4 });
print_expression_as_nada' (test_case, FALSE, d - 1);
shut_box pp;
break pp { blanks=>1, indent_on_wrap=> 0 };
pp.lit "then ";
open_style_box CONSISTENT pp (pp::typ::CURSOR_RELATIVE { blanks => 1, tab_to => 0, tabstops_are_every => 4 });
print_expression_as_nada' (then_case, FALSE, d - 1);
shut_box pp;
break pp { blanks=>1, indent_on_wrap=> 0 };
pp.lit "else ";
open_style_box CONSISTENT pp (pp::typ::CURSOR_RELATIVE { blanks => 1, tab_to => 0, tabstops_are_every => 4 });
print_expression_as_nada' (else_case, FALSE, d - 1);
shut_box pp;
rpcond (atom);
shut_box pp;
};
print_expression_as_nada' (ds::AND_EXPRESSION (e1, e2), atom, d)
=>
{ open_style_box CONSISTENT pp (pp::typ::CURSOR_RELATIVE { blanks => 1, tab_to => 0, tabstops_are_every => 4 });
lpcond (atom);
open_style_box CONSISTENT pp (pp::typ::CURSOR_RELATIVE { blanks => 1, tab_to => 0, tabstops_are_every => 4 });
print_expression_as_nada' (e1, TRUE, d - 1);
shut_box pp;
break pp { blanks=>1, indent_on_wrap=> 0 };
pp.lit "and ";
open_style_box CONSISTENT pp (pp::typ::CURSOR_RELATIVE { blanks => 1, tab_to => 0, tabstops_are_every => 4 });
print_expression_as_nada' (e2, TRUE, d - 1);
shut_box pp;
rpcond (atom);
shut_box pp;
};
print_expression_as_nada' (ds::OR_EXPRESSION (e1, e2), atom, d)
=>
{ open_style_box CONSISTENT pp (pp::typ::CURSOR_RELATIVE { blanks => 1, tab_to => 0, tabstops_are_every => 4 });
lpcond (atom);
open_style_box CONSISTENT pp (pp::typ::CURSOR_RELATIVE { blanks => 1, tab_to => 0, tabstops_are_every => 4 });
print_expression_as_nada' (e1, TRUE, d - 1);
shut_box pp;
break pp { blanks=>1, indent_on_wrap=> 0 };
pp.lit "or ";
open_style_box CONSISTENT pp (pp::typ::CURSOR_RELATIVE { blanks => 1, tab_to => 0, tabstops_are_every => 4 });
print_expression_as_nada' (e2, TRUE, d - 1);
shut_box pp;
rpcond (atom);
shut_box pp;
};
print_expression_as_nada' (ds::WHILE_EXPRESSION { test, expression }, atom, d)
=>
{ open_style_box CONSISTENT pp (pp::typ::CURSOR_RELATIVE { blanks => 1, tab_to => 0, tabstops_are_every => 4 });
pp.lit "while ";
open_style_box CONSISTENT pp (pp::typ::CURSOR_RELATIVE { blanks => 1, tab_to => 0, tabstops_are_every => 4 });
print_expression_as_nada'(test, FALSE, d - 1);
shut_box pp;
break pp { blanks=>1, indent_on_wrap=> 0 };
pp.lit "do ";
open_style_box CONSISTENT pp (pp::typ::CURSOR_RELATIVE { blanks => 1, tab_to => 0, tabstops_are_every => 4 });
print_expression_as_nada'(expression, FALSE, d - 1);
shut_box pp;
shut_box pp;
};
print_expression_as_nada'(ds::FN_EXPRESSION (rules, _), _, d)
=>
{ pp::open_box (pp, pp::typ::BOX_RELATIVE { blanks => 1, tab_to => 0, tabstops_are_every => 4 }, pp::normal, 100 );
ppvlist pp ("(\\ ", " | ",
(\\ pp => \\ r =>
print_rule_as_nada context pp (r, d - 1); end; end ),
trim rules);
rparen();
pp::shut_box pp;
};
print_expression_as_nada' (ds::SOURCE_CODE_REGION_FOR_EXPRESSION (expression, (s, e)), atom, d)
=>
case source_opt
#
THE source
=>
if *internals
pp.lit "<MARK(";
prpos (pp, source, s); pp.lit ", ";
prpos (pp, source, e); pp.lit "): ";
print_expression_as_nada'(expression, FALSE, d); pp.lit ">";
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.lit "<expression>";
print_app_expression_as_nada arg
=>
{ 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
=
{ open_style_box INCONSISTENT pp (pp::typ::CURSOR_RELATIVE { blanks => 1, tab_to => 0, tabstops_are_every => 4 });
pp.lit dname; break pp { blanks=>1, indent_on_wrap=>0 };
print_expression_as_nada'(expression, TRUE, d - 1);
shut_box pp;};
case this_fix
INFIX _
=>
(case (strip_source_code_region_data operand)
ds::RECORD_IN_EXPRESSION [(_, pl), (_, pr)]
=>
{ atom = stronger_l (left_fix, this_fix) or
stronger_r (this_fix, right_fix);
my (left, right)
=
if atom (null_fix, null_fix);
else (left_fix, right_fix);
fi;
{ open_style_box INCONSISTENT pp (pp::typ::CURSOR_RELATIVE { blanks => 1, tab_to => 0, tabstops_are_every => 4 });
lpcond (atom);
print_app_expression_as_nada (pl, left, this_fix, d - 1);
break pp { blanks=>1, indent_on_wrap=>0 };
pp.lit dname;
break pp { blanks=>1, indent_on_wrap=>0 };
print_app_expression_as_nada (pr, this_fix, right, d - 1);
rpcond (atom);
shut_box pp;};
};
e' => pr_non e';
esac
);
NONFIX => pr_non operand;
esac;
};
fun apply_print (_, _, _, 0)
=>
pp.lit "#";
apply_print (ds::APPLY_EXPRESSION { operator, operand }, l, r, d)
=>
case (strip_source_code_region_data operator)
#
ds::VALCON_IN_EXPRESSION { valcon => VALCON { name, ... }, ... }
=>
fixitypp ([name], operand, l, r, d);
ds::VARIABLE_IN_EXPRESSION { var => v, ... }
=>
{ path = case *v
PLAIN_VARIABLE { path=>symbol_path::SYMBOL_PATH p, ... } => p;
OVERLOADED_VARIABLE { name, ... } => [name];
errorvar => [sy::make_value_symbol "<errorvar>"];
esac;
fixitypp (path, operand, l, r, d);
};
operator
=>
{ open_style_box INCONSISTENT pp (pp::typ::CURSOR_RELATIVE { blanks => 1, tab_to => 0, tabstops_are_every => 4 });
print_expression_as_nada'(operator, TRUE, d - 1); break pp { blanks=>1, indent_on_wrap=>2 };
print_expression_as_nada'(operand, TRUE, d - 1);
shut_box pp;
};
esac;
apply_print (ds::SOURCE_CODE_REGION_FOR_EXPRESSION (expression, (s, e)), l, r, d)
=>
case source_opt
#
THE source
=>
if *internals
pp.lit "<MARK(";
prpos (pp, source, s); pp.lit ", ";
prpos (pp, source, e); pp.lit "): ";
print_expression_as_nada'(expression, FALSE, d); pp.lit ">";
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;
(\\ (expression, depth) = print_expression_as_nada'(expression, FALSE, depth));
}
also
fun print_rule_as_nada (context as (dictionary, source_opt)) pp (ds::CASE_RULE (pattern, expression), d)
=
if (d > 0)
open_style_box CONSISTENT pp (pp::typ::CURSOR_RELATIVE { blanks => 1, tab_to => 0, tabstops_are_every => 4 });
print_pattern_as_nada dictionary pp (pattern, d - 1);
pp.lit " =>"; break pp { blanks=>1, indent_on_wrap=>2 };
print_expression_as_nada context pp (expression, d - 1);
shut_box pp;
else
pp.lit "<rule>";
fi
also
fun print_named_value_as_nada (context as (dictionary, source_opt)) pp (ds::VALUE_NAMING { pattern, expression, ... }, d)
=
if (d > 0)
open_style_box CONSISTENT pp (pp::typ::CURSOR_RELATIVE { blanks => 1, tab_to => 0, tabstops_are_every => 4 });
print_pattern_as_nada dictionary pp (pattern, d - 1); pp.lit " =";
break pp { blanks=>1, indent_on_wrap=>2 }; print_expression_as_nada context pp (expression, d - 1);
shut_box pp;
else
pp.lit "<naming>";
fi
also
fun print_recursively_named_value_as_nada context pp (ds::NAMED_RECURSIVE_VALUE { variable=>var, expression, ... }, d)
=
if (d>0)
open_style_box INCONSISTENT pp (pp::typ::CURSOR_RELATIVE { blanks => 1, tab_to => 0, tabstops_are_every => 4 });
print_var_as_nada pp var; pp.lit " =";
break pp { blanks=>1, indent_on_wrap=>2 }; print_expression_as_nada context pp (expression, d - 1);
shut_box pp;
else
pp.lit "<rec naming>";
fi
also
fun print_declaration_as_nada (context as (dictionary, source_opt)) pp
=
{ fun print_declaration_as_nada'(_, 0)
=>
pp.lit "<declaration>";
print_declaration_as_nada'(ds::VALUE_DECLARATIONS vbs, d)
=>
{ open_style_box CONSISTENT pp (pp::typ::CURSOR_RELATIVE { blanks => 1, tab_to => 0, tabstops_are_every => 4 });
ppvlist pp ("my ", "also ",
(\\ pp => \\ named_value => print_named_value_as_nada context pp (named_value, d - 1); end; end ), vbs);
shut_box pp;};
print_declaration_as_nada'(ds::RECURSIVE_VALUE_DECLARATIONS rvbs, d)
=>
{ open_style_box CONSISTENT pp (pp::typ::CURSOR_RELATIVE { blanks => 1, tab_to => 0, tabstops_are_every => 4 });
ppvlist pp ("my rec ", "also ",
(\\ pp => \\ named_recursive_values => print_recursively_named_value_as_nada context pp (named_recursive_values, d - 1); end; end ), rvbs);
shut_box pp;};
print_declaration_as_nada'(ds::TYPE_DECLARATIONS types, d)
=>
{ fun f pp (tdt::NAMED_TYPE { namepath, typescheme=>TYPESCHEME { arity, body }, ... } )
=>
{ case arity
0 => ();
1 => (pp.lit "'a ");
n => { print_tuple_as_mythrl7 pp pp::lit (type_formals n);
pp.lit " ";}; esac;
print_symbol_as_nada pp (inverse_path::last namepath);
pp.lit " = ";
print_typoid_as_nada dictionary pp body
;};
f _ _ => bug "print_declaration_as_nada'(TYPE_DECLARATIONS)"; end;
open_style_box CONSISTENT pp (pp::typ::CURSOR_RELATIVE { blanks => 1, tab_to => 0, tabstops_are_every => 4 });
ppvlist pp ("type ", " also ", f, types);
shut_box pp;
};
print_declaration_as_nada' (ds::SUMTYPE_DECLARATIONS { sumtypes, with_types }, d)
=>
{ fun print_data_as_nada pp (tdt::SUM_TYPE { namepath, arity, kind, ... } )
=>
case kind
SUMTYPE(_)
=>
{ case arity
0 => ();
1 => (pp.lit "'a ");
n => { print_tuple_as_mythrl7 pp pp::lit (type_formals n);
pp.lit " ";}; esac;
print_symbol_as_nada pp (inverse_path::last namepath); pp.lit " = ..."
/* ;
print_sequence_as_nada
pp
{ sep = (\\ pp = pp.lit " |";
break pp { blanks=1, indent_on_wrap=0 }),
pr = \\ pp =
\\ (VALCON { name, ... } )
=
print_symbol_as_nada pp name,
style = INCONSISTENT
}
dcons
*/
;};
_ => bug "print_declaration_as_nada'(SUMTYPE_DECLARATIONS) 1.1";
esac;
print_data_as_nada _ _
=>
bug "print_declaration_as_nada'(SUMTYPE_DECLARATIONS) 1.2";
end;
fun print_with_as_nada pp (tdt::NAMED_TYPE { namepath, typescheme=>TYPESCHEME { arity, body }, ... } )
=>
{ case arity
0 => ();
1 => (pp.lit "'a ");
n => { print_tuple_as_mythrl7 pp pp::lit (type_formals n);
pp.lit " ";};
esac;
print_symbol_as_nada pp (inverse_path::last namepath);
pp.lit " = ";
print_typoid_as_nada dictionary pp body
;};
print_with_as_nada _ _
=>
bug "print_declaration_as_nada'(SUMTYPE_DECLARATIONS) 2"; end;
# Could call PPDec::print_declaration_as_nada here:
open_style_box CONSISTENT pp (pp::typ::CURSOR_RELATIVE { blanks => 1, tab_to => 0, tabstops_are_every => 4 });
ppvlist pp ("enum ", "also ", print_data_as_nada, sumtypes);
newline pp;
ppvlist pp ("withtype ", "also ", print_with_as_nada, with_types);
shut_box pp;
};
print_declaration_as_nada'(ds::EXCEPTION_DECLARATIONS ebs, d)
=>
{ fun f pp ( ds::NAMED_EXCEPTION {
exception_constructor => VALCON { name, ... },
exception_typoid => etype,
...
}
)
=>
{ print_symbol_as_nada pp name;
case etype
#
NULL => ();
THE type'
=>
{
# pp.lit " of ";
pp.lit " ";
print_typoid_as_nada dictionary pp type';
};
esac;
};
f pp (ds::DUPLICATE_NAMED_EXCEPTION { exception_constructor => VALCON { name, ... },
equal_to => VALCON { name=>name', ... }
}
)
=>
{ print_symbol_as_nada pp name;
pp.lit "=";
print_symbol_as_nada pp name';
};
end;
open_style_box CONSISTENT pp (pp::typ::CURSOR_RELATIVE { blanks => 1, tab_to => 0, tabstops_are_every => 4 });
ppvlist pp ("exception ", "also ", f, ebs);
shut_box pp;
};
print_declaration_as_nada'(ds::PACKAGE_DECLARATIONS sbs, d)
=>
{ fun f pp (ds::NAMED_PACKAGE { name_symbol=>name, a_package=>mld::A_PACKAGE { varhome, ... }, definition=>def } )
=>
{ print_symbol_as_nada pp name;
print_varhome_as_nada pp varhome;
pp.lit " = ";
break pp { blanks=>1, indent_on_wrap=>2 };
print_strexp_as_nada context pp (def, d - 1);
};
f _ _
=>
bug "print_declaration_as_nada: PACKAGE_DECLARATION: NAMED_PACKAGE";
end;
open_style_box CONSISTENT pp (pp::typ::CURSOR_RELATIVE { blanks => 1, tab_to => 0, tabstops_are_every => 4 });
ppvlist pp ("package ", "also ", f, sbs);
shut_box pp;
};
print_declaration_as_nada'(ds::GENERIC_DECLARATIONS fbs, d)
=>
{ fun f pp (ds::NAMED_GENERIC { name_symbol => fname,
a_generic => mld::GENERIC { varhome, ... },
definition => def
}
)
=>
{ print_symbol_as_nada pp fname;
print_varhome_as_nada pp varhome;
pp.lit " = ";
break pp { blanks=>1, indent_on_wrap=> 2 };
print_fctexp_as_nada context pp (def, d - 1)
;};
f _ _
=>
bug "print_declaration_as_nada': GENERIC_DECLARATION";
end;
open_style_box CONSISTENT pp (pp::typ::CURSOR_RELATIVE { blanks => 1, tab_to => 0, tabstops_are_every => 4 });
ppvlist pp ("generic package ", "also ", f, fbs);
shut_box pp;
};
print_declaration_as_nada'(ds::API_DECLARATIONS sigvars, d)
=>
{ fun f pp (mld::API { name, ... } )
=>
{ pp.lit "api ";
case name
THE s => print_symbol_as_nada pp s;
NULL => pp.lit "ANONYMOUS"; esac
;};
f _ _
=>
bug "print_declaration_as_nada': API_DECLARATIONS"; end;
open_style_box CONSISTENT pp (pp::typ::CURSOR_RELATIVE { blanks => 1, tab_to => 0, tabstops_are_every => 4 });
print_sequence_as_nada
pp
{ sep => newline,
pr => f,
style => CONSISTENT
}
sigvars;
shut_box pp;
};
print_declaration_as_nada'(ds::GENERIC_API_DECLARATIONS sigvars, d)
=>
{ fun f pp (mld::GENERIC_API { kind, ... } )
=>
{ pp.lit "funsig ";
case kind
THE s => print_symbol_as_nada pp s;
NULL => pp.lit "ANONYMOUS"; esac
;};
f _ _
=>
bug "print_declaration_as_nada': GENERIC_API_DECLARATIONS"; end;
open_style_box CONSISTENT pp (pp::typ::CURSOR_RELATIVE { blanks => 1, tab_to => 0, tabstops_are_every => 4 });
print_sequence_as_nada
pp
{ sep => newline,
pr => f,
style => CONSISTENT
}
sigvars;
shut_box pp;
};
print_declaration_as_nada'(ds::LOCAL_DECLARATIONS (inner, outer), d)
=>
{ open_style_box CONSISTENT pp (pp::typ::CURSOR_RELATIVE { blanks => 1, tab_to => 0, tabstops_are_every => 4 });
pp.lit "stipulate"; newline_indent pp 2;
print_declaration_as_nada'(inner, d - 1); newline pp;
pp.lit "herein ";
print_declaration_as_nada'(outer, d - 1); newline pp;
pp.lit "end";
shut_box pp;
};
print_declaration_as_nada'(ds::SEQUENTIAL_DECLARATIONS decs, d)
=>
{ open_style_box CONSISTENT pp (pp::typ::CURSOR_RELATIVE { blanks => 1, tab_to => 0, tabstops_are_every => 4 });
print_sequence_as_nada
pp
{ sep => newline,
pr => (\\ pp => \\ declaration => print_declaration_as_nada'(declaration, d); end; end ),
style => CONSISTENT
}
decs;
shut_box pp;
};
print_declaration_as_nada'(ds::FIXITY_DECLARATION { fixity, ops }, d)
=>
{ open_style_box CONSISTENT pp (pp::typ::CURSOR_RELATIVE { blanks => 1, tab_to => 0, tabstops_are_every => 4 });
case fixity
NONFIX => pp.lit "nonfix ";
INFIX (i, _)
=>
{ if (i % 2 == 0 ) pp.lit "infix ";
else pp.lit "infixr "; fi;
if (i / 2 > 0 ) pp.lit (int::to_string (i / 2));
pp.lit " ";
fi;
};
esac;
print_sequence_as_nada
pp
{ sep => (\\ pp = break pp { blanks=>1, indent_on_wrap=>0 }),
pr => print_symbol_as_nada,
style => INCONSISTENT
}
ops;
shut_box pp;
};
print_declaration_as_nada'(ds::OVERLOADED_VARIABLE_DECLARATION overloaded_variable, d)
=>
{ pp.lit "overloaded my ";
print_var_as_nada pp overloaded_variable;
};
print_declaration_as_nada'(ds::INCLUDE_DECLARATIONS named_packages, d)
=>
{ open_style_box CONSISTENT pp (pp::typ::CURSOR_RELATIVE { blanks => 1, tab_to => 0, tabstops_are_every => 4 });
pp.lit "include package ";
print_sequence_as_nada
pp
{ sep => (\\ pp = break pp { blanks=>1, indent_on_wrap=>0 } ),
pr => (\\ pp = \\ (sp, _) = pp.lit (symbol_path::to_string sp)),
style => INCONSISTENT
}
named_packages;
shut_box pp;
};
print_declaration_as_nada'(ds::SOURCE_CODE_REGION_FOR_DECLARATION (declaration, (s, e)), d)
=>
case source_opt
THE source
=>
{ pp.lit "SOURCE_CODE_REGION_FOR_DECLARATION(";
print_declaration_as_nada'(declaration, d); pp.lit ", ";
prpos (pp, source, s); pp.lit ", ";
prpos (pp, source, e); pp.lit ")";
};
NULL => print_declaration_as_nada'(declaration, d);
esac;
end;
print_declaration_as_nada';
}
also
fun print_strexp_as_nada (context as (_, source_opt)) pp
=
{ fun print_strexp_as_nada'(_, 0)
=>
pp.lit "<package_expression>";
print_strexp_as_nada'(ds::PACKAGE_BY_NAME (mld::A_PACKAGE { varhome, ... } ), d)
=>
print_varhome_as_nada pp varhome;
print_strexp_as_nada' (
ds::COMPUTED_PACKAGE {
a_generic => mld::GENERIC { varhome => fa, ... },
generic_argument => mld::A_PACKAGE { varhome => sa, ... },
...
},
d
)
=>
{ print_varhome_as_nada pp fa;
pp.lit"(";
print_varhome_as_nada pp sa;
pp.lit")";
};
print_strexp_as_nada'(ds::PACKAGE_DEFINITION namings, d)
=>
{ open_style_box CONSISTENT pp (pp::typ::CURSOR_RELATIVE { blanks => 1, tab_to => 0, tabstops_are_every => 4 });
pp.lit "pkg"; newline_indent pp 2;
pp.lit "...";
# printNamingAsNada not yet undefined
/*
print_sequence_as_nada pp
{ sep=newline,
pr=(\\ pp => \\ b => printNamingAsNada context pp (b, d - 1)),
style=CONSISTENT }
namings;
*/
pp.lit "end";
shut_box pp;
};
print_strexp_as_nada'(ds::PACKAGE_LET { declaration, expression }, d)
=>
{ open_style_box CONSISTENT pp (pp::typ::CURSOR_RELATIVE { blanks => 1, tab_to => 0, tabstops_are_every => 4 });
pp.lit "stipulate "; print_declaration_as_nada context pp (declaration, d - 1);
newline pp;
pp.lit " herein "; print_strexp_as_nada'(expression, d - 1); newline pp;
pp.lit "end";
shut_box pp;
};
print_strexp_as_nada'(ds::SOURCE_CODE_REGION_FOR_PACKAGE (body, (s, e)), d)
=>
case source_opt
THE source
=>
{ pp.lit "ds::SOURCE_CODE_REGION_FOR_PACKAGE(";
print_strexp_as_nada'(body, d); pp.lit ", ";
prpos (pp, source, s); pp.lit ", ";
prpos (pp, source, e); pp.lit ")"
;};
NULL
=>
print_strexp_as_nada'(body, d);
esac;
print_strexp_as_nada' _
=>
bug "unexpected package expression in print_strexp_as_nada'";
end;
print_strexp_as_nada';
}
also
fun print_fctexp_as_nada (context as (_, source_opt)) pp
=
{ fun print_fctexp_as_nada'(_, 0)
=>
pp.lit "<generic_expression>";
print_fctexp_as_nada'(ds::GENERIC_BY_NAME (mld::GENERIC { varhome, ... } ), d)
=>
print_varhome_as_nada pp varhome;
print_fctexp_as_nada'(ds::GENERIC_DEFINITION { parameter=>mld::A_PACKAGE { varhome, ... }, definition=>def, ... }, d)
=>
{ pp.lit " GENERIC(";
print_varhome_as_nada pp varhome;
pp.lit ") => "; newline pp;
print_strexp_as_nada context pp (def, d - 1);
};
print_fctexp_as_nada'(ds::GENERIC_LET (declaration, body), d)
=>
{ open_style_box CONSISTENT pp (pp::typ::CURSOR_RELATIVE { blanks => 1, tab_to => 0, tabstops_are_every => 4 });
pp.lit "stipulate "; print_declaration_as_nada context pp (declaration, d - 1);
newline pp;
pp.lit " herein "; print_fctexp_as_nada'(body, d - 1); newline pp;
pp.lit "end";
shut_box pp;
};
print_fctexp_as_nada'(ds::SOURCE_CODE_REGION_FOR_GENERIC (body, (s, e)), d)
=>
case source_opt
THE source
=>
{ pp.lit "SOURCE_CODE_REGION_FOR_GENERIC(";
print_fctexp_as_nada'(body, d); pp.lit ", ";
prpos (pp, source, s); pp.lit ", ";
prpos (pp, source, e); pp.lit ")";
};
NULL => print_fctexp_as_nada'(body, d);
esac;
print_fctexp_as_nada' _
=>
bug "unexpected generic package expression in print_fctexp_as_nada'";
end;
print_fctexp_as_nada';
};
}; # package print_deep_syntax_as_nada
end; # stipulate