## 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 = 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 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::Stream
-> (ds::Case_Pattern,
Int)
-> Void;
print_expression_as_nada: (syx::Symbolmapstack,
Null_Or( sci::Sourcecode_Info ))
-> pp::Stream
-> (ds::Deep_Expression,
Int)
-> Void;
print_rule_as_nada: (syx::Symbolmapstack,
Null_Or( sci::Sourcecode_Info ))
-> pp::Stream
-> (ds::Case_Rule,
Int)
-> Void;
print_named_value_as_nada: (syx::Symbolmapstack,
Null_Or( sci::Sourcecode_Info ))
-> pp::Stream
-> (ds::Named_Value,
Int)
-> Void;
print_recursively_named_value_as_nada: (syx::Symbolmapstack,
Null_Or( sci::Sourcecode_Info ))
-> pp::Stream
-> (ds::Named_Recursive_Values,
Int)
-> Void;
print_declaration_as_nada: (syx::Symbolmapstack,
Null_Or( sci::Sourcecode_Info ))
-> pp::Stream
-> (ds::Declaration,
Int)
-> Void;
print_strexp_as_nada: (syx::Symbolmapstack,
Null_Or( sci::Sourcecode_Info ))
-> pp::Stream
-> (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 = prettyprint; # prettyprint is from src/lib/prettyprint/big/src/prettyprint.pkg package sci = sourcecode_info; # sourcecode_info is from src/lib/compiler/front/basics/source/sourcecode-info.pkg package sy = symbol; # symbol is from src/lib/compiler/front/basics/map/symbol.pkg package tc = typer_control; # typer_control is from src/lib/compiler/front/typer/basics/typer-control.pkg include tuples;
include fixity;
include variables_and_constructors;
include types;
include prettyprint;
include print_as_nada_junk;
include print_type_as_nada;
include 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;
lineprint = REF FALSE;
fun by f x y
=
f y x;
null_fix = INFIX (0, 0);
inf_fix = INFIX (1000000, 100000);
fun stronger_l ( INFIX (_, m),
INFIX (n, _)
)
=>
m >= n;
stronger_l _
=>
FALSE; # should not matter
end;
fun stronger_r ( INFIX (_, m),
INFIX (n, _)
)
=>
n > m;
stronger_r _
=>
TRUE; # should not matter
end;
fun prpos ( stream: pp::Stream,
source: sci::Sourcecode_Info,
charpos: Int
)
=
if *lineprint
#
my (file: String, line: Int, pos: Int)
=
sci::filepos source charpos;
pp::string stream (int::to_string line);
pp::string stream ".";
pp::string stream (int::to_string pos);
else
pp::string stream (int::to_string charpos);
fi;
fun 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 stream
=
{ ppsay = pp::string stream;
fun print_pattern_as_nada' (_, 0) => ppsay "<pattern>";
print_pattern_as_nada' (ds::VARIABLE_IN_PATTERN v, _) => print_var_as_nada stream 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 stream INCONSISTENT 2;
ppsay "("; ppsay (mwi::to_string i);
ppsay " :"; break stream { spaces=1, indent_on_wrap=1 };
prettyprint_type dictionary stream t; ppsay ")";
end_block stream) */
print_pattern_as_nada' (ds::UNT_CONSTANT_IN_PATTERN (w, t), _) => ppsay (mwi::to_string w);
/* (open_style_box INCONSISTENT stream (pp::CURSOR_RELATIVE 2);
ppsay "("; ppsay (mwi::to_string w);
ppsay " :"; break stream { spaces=1, indent_on_wrap=1 };
print_type_as_nada dictionary stream t; ppsay ")";
end_box stream) */
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 stream s;
print_pattern_as_nada' (ds::CHAR_CONSTANT_IN_PATTERN s, _) => { ppsay "#"; print_lib7_string_as_nada stream s;};
print_pattern_as_nada' (ds::AS_PATTERN (v, p), d)
=>
{ open_style_box CONSISTENT stream (pp::CURSOR_RELATIVE 0);
print_pattern_as_nada'(v, d); ppsay " as "; print_pattern_as_nada'(p, d - 1);
end_box stream;
};
# 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 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 }
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 };
}
),
back=>(fn stream = if is_incomplete pp::string stream ", ... }";
else pp::string stream "}";
fi
),
pr=>(fn stream = fn (symbol, pattern) =
{ print_symbol_as_nada stream symbol; pp::string stream "=";
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 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
}
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 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
} (make_list pattern);
};
print_pattern_as_nada' (ds::CONSTRUCTOR_PATTERN (e, _), _) => print_dcon_as_nada stream e;
print_pattern_as_nada' (p as ds::APPLY_PATTERN _, d)
=>
print_dcon_pattern_as_nada (dictionary, stream) (p, null_fix, null_fix, d);
print_pattern_as_nada' (ds::TYPE_CONSTRAINT_PATTERN (p, t), d)
=>
{ open_style_box INCONSISTENT stream (pp::CURSOR_RELATIVE 0);
print_pattern_as_nada'(p, d - 1); ppsay " :";
break stream { spaces=>1, indent_on_wrap=>2 };
print_type_as_nada dictionary stream t;
end_box stream;
};
print_pattern_as_nada' _ => bug "print_pattern_as_nada'";
end;
print_pattern_as_nada';
}
also
fun print_dcon_pattern_as_nada (dictionary, stream)
=
{ ppsay = pp::string stream;
fun lpcond (atom) = if atom ppsay "("; fi;
fun rpcond (atom) = if atom ppsay ")"; fi;
fun print_dcon_pattern_as_nada'(_, _, _, 0) => ppsay "<pattern>";
print_dcon_pattern_as_nada' (ds::CONSTRUCTOR_PATTERN (VALCON { name, ... }, _), l: Fixity, r: Fixity, _)
=>
print_symbol_as_nada stream name;
print_dcon_pattern_as_nada'(ds::TYPE_CONSTRAINT_PATTERN (p, t), l, r, d)
=>
{ open_style_box INCONSISTENT stream (pp::CURSOR_RELATIVE 0);
ppsay "("; print_pattern_as_nada dictionary stream (p, d - 1); ppsay " :";
break stream { spaces=>1, indent_on_wrap=>2 };
print_type_as_nada dictionary stream t; ppsay ")";
end_box stream;
};
print_dcon_pattern_as_nada'(ds::AS_PATTERN (v, p), l, r, d)
=>
{ open_style_box INCONSISTENT stream (pp::CURSOR_RELATIVE 0);
ppsay "("; print_pattern_as_nada dictionary stream (v, d); break stream { spaces=>1, indent_on_wrap=>2 };
ppsay " as "; print_pattern_as_nada dictionary stream (p, d - 1); ppsay ")";
end_box stream;
};
print_dcon_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 stream (pp::CURSOR_RELATIVE 2);
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_dcon_pattern_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_dcon_pattern_as_nada' (pr, this_fix, right, d - 1);
};
_ =>
{ ppsay dname;
break stream { spaces=>1, indent_on_wrap=>0 };
print_dcon_pattern_as_nada'(p, inf_fix, inf_fix, d - 1);
};
esac;
rpcond (atom);
end_box stream;
};
print_dcon_pattern_as_nada' (p, _, _, d) => print_pattern_as_nada dictionary stream (p, d);
end;
print_dcon_pattern_as_nada';
};
fun trim [x] => [];
trim (a ! b) => a ! trim b;
trim [] => [];
end;
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;
fun print_expression_as_nada' (_, _, 0) => ppsay "<expression>";
print_expression_as_nada' (ds::VARIABLE_IN_EXPRESSION (REF var, _), _, _) => print_var_as_nada stream var;
print_expression_as_nada' (ds::VALCON_IN_EXPRESSION (con, _), _, _) => print_dcon_as_nada stream con;
print_expression_as_nada' ( ds::INT_CONSTANT_IN_EXPRESSION (i, t), _, _) => ppsay (mwi::to_string i);
print_expression_as_nada' ( ds::UNT_CONSTANT_IN_EXPRESSION (w, t), _, _) => ppsay (mwi::to_string w);
print_expression_as_nada' ( ds::FLOAT_CONSTANT_IN_EXPRESSION r, _, _) => ppsay r;
print_expression_as_nada' (ds::STRING_CONSTANT_IN_EXPRESSION s, _, _) => print_lib7_string_as_nada stream s;
print_expression_as_nada' (ds::CHAR_CONSTANT_IN_EXPRESSION s, _, _) => { ppsay "#"; print_lib7_string_as_nada stream s;};
print_expression_as_nada' (r as ds::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 (ds::NUMBERED_LABEL { 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' (ds::RECORD_SELECTOR_EXPRESSION (ds::NUMBERED_LABEL { name, ... }, expression), atom, d)
=>
{ open_style_box CONSISTENT stream (pp::CURSOR_RELATIVE 0);
lpcond (atom);
ppsay "#"; print_symbol_as_nada stream name;
print_expression_as_nada'(expression, TRUE, d - 1); ppsay ">";
rpcond (atom);
end_box stream;
};
print_expression_as_nada'(ds::VECTOR_IN_EXPRESSION (NIL, _), _, d) => ppsay "#[]";
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 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'(ds::ABSTRACTION_PACKING_EXPRESSION (e, t, tcs), atom, d)
=>
if *internals
#
open_style_box INCONSISTENT stream (pp::CURSOR_RELATIVE 0);
ppsay "<PACK: "; print_expression_as_nada'(e, FALSE, d); ppsay "; ";
break stream { spaces=>1, indent_on_wrap=>2 };
print_type_as_nada dictionary stream t; ppsay ">";
end_box stream;
else
print_expression_as_nada'(e, atom, d);
fi;
print_expression_as_nada'(ds::SEQUENTIAL_EXPRESSIONS 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 } ;}),
back => (by pp::string ")"),
pr => (fn _ = fn 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 stream (pp::CURSOR_RELATIVE 0);
lpcond (atom);
print_expression_as_nada'(e, FALSE, d); ppsay ":";
break stream { spaces=>1, indent_on_wrap=>2 };
print_type_as_nada dictionary stream t;
rpcond (atom);
end_box stream;
};
print_expression_as_nada'(ds::EXCEPT_EXPRESSION (expression, (rules, _)), atom, d)
=>
{ open_style_box CONSISTENT stream (pp::CURSOR_RELATIVE 0);
lpcond (atom);
print_expression_as_nada'(expression, atom, d - 1); newline stream; ppsay "except ";
newline_indent stream 2;
ppvlist stream (" ", "| ",
(fn stream = fn r = print_rule_as_nada context stream (r, d - 1)), rules);
rpcond (atom);
end_box stream;
};
print_expression_as_nada'(ds::RAISE_EXPRESSION (expression, _), atom, d)
=>
{ open_style_box CONSISTENT stream (pp::CURSOR_RELATIVE 0);
lpcond (atom);
ppsay "raise exception "; print_expression_as_nada'(expression, TRUE, d - 1);
rpcond (atom);
end_box stream;
};
print_expression_as_nada'(ds::LET_EXPRESSION (declaration, expression), _, d)
=>
{ open_style_box CONSISTENT stream (pp::CURSOR_RELATIVE 0);
ppsay "{ /*let*/ ";
open_style_box CONSISTENT stream (pp::CURSOR_RELATIVE 0);
print_declaration_as_nada context stream (declaration, d - 1);
end_box stream;
break stream { spaces=>1, indent_on_wrap=>0 };
ppsay " /*in*/ ";
open_style_box CONSISTENT stream (pp::CURSOR_RELATIVE 0);
print_expression_as_nada'(expression, FALSE, d - 1);
end_box stream;
break stream { spaces=>1, indent_on_wrap=>0 };
ppsay "} /*end of let*/";
end_box stream;
};
print_expression_as_nada'(ds::CASE_EXPRESSION (expression, rules, _), _, d)
=>
{ open_style_box CONSISTENT stream (pp::CURSOR_RELATIVE 0);
ppsay "(given "; print_expression_as_nada'(expression, TRUE, d - 1); newline_indent stream 2;
ppvlist stream ("when ", " when ",
(fn stream => fn r => print_rule_as_nada context stream (r, d - 1); end; end ),
trim rules);
rparen();
end_box stream;
};
print_expression_as_nada' (ds::IF_EXPRESSION { test_case, then_case, else_case }, atom, d)
=>
{ open_style_box CONSISTENT stream (pp::CURSOR_RELATIVE 0);
lpcond (atom);
ppsay "if ";
open_style_box CONSISTENT stream (pp::CURSOR_RELATIVE 0);
print_expression_as_nada' (test_case, FALSE, d - 1);
end_box stream;
break stream { spaces=>1, indent_on_wrap=> 0 };
ppsay "then ";
open_style_box CONSISTENT stream (pp::CURSOR_RELATIVE 0);
print_expression_as_nada' (then_case, FALSE, d - 1);
end_box stream;
break stream { spaces=>1, indent_on_wrap=> 0 };
ppsay "else ";
open_style_box CONSISTENT stream (pp::CURSOR_RELATIVE 0);
print_expression_as_nada' (else_case, FALSE, d - 1);
end_box stream;
rpcond (atom);
end_box stream;
};
print_expression_as_nada' (ds::AND_EXPRESSION (e1, e2), atom, d)
=>
{ open_style_box CONSISTENT stream (pp::CURSOR_RELATIVE 0);
lpcond (atom);
open_style_box CONSISTENT stream (pp::CURSOR_RELATIVE 0);
print_expression_as_nada' (e1, TRUE, d - 1);
end_box stream;
break stream { spaces=>1, indent_on_wrap=> 0 };
ppsay "and ";
open_style_box CONSISTENT stream (pp::CURSOR_RELATIVE 0);
print_expression_as_nada' (e2, TRUE, d - 1);
end_box stream;
rpcond (atom);
end_box stream;
};
print_expression_as_nada' (ds::OR_EXPRESSION (e1, e2), atom, d)
=>
{ open_style_box CONSISTENT stream (pp::CURSOR_RELATIVE 0);
lpcond (atom);
open_style_box CONSISTENT stream (pp::CURSOR_RELATIVE 0);
print_expression_as_nada' (e1, TRUE, d - 1);
end_box stream;
break stream { spaces=>1, indent_on_wrap=> 0 };
ppsay "or ";
open_style_box CONSISTENT stream (pp::CURSOR_RELATIVE 0);
print_expression_as_nada' (e2, TRUE, d - 1);
end_box stream;
rpcond (atom);
end_box stream;
};
print_expression_as_nada' (ds::WHILE_EXPRESSION { test, expression }, atom, d)
=>
{ open_style_box CONSISTENT stream (pp::CURSOR_RELATIVE 0);
ppsay "while ";
open_style_box CONSISTENT stream (pp::CURSOR_RELATIVE 0);
print_expression_as_nada'(test, FALSE, d - 1);
end_box stream;
break stream { spaces=>1, indent_on_wrap=> 0 };
ppsay "do ";
open_style_box CONSISTENT stream (pp::CURSOR_RELATIVE 0);
print_expression_as_nada'(expression, FALSE, d - 1);
end_box stream;
end_box stream;
};
print_expression_as_nada'(ds::FN_EXPRESSION (rules, _), _, d)
=>
{ begin_horizontal_else_vertical_box stream;
ppvlist stream ("(fn ", " | ",
(fn stream => fn r =>
print_rule_as_nada context stream (r, d - 1); end; end ),
trim rules);
rparen();
end_box stream;};
print_expression_as_nada' (ds::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
=
{ open_style_box INCONSISTENT 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_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 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 (ds::APPLY_EXPRESSION (operator, operand), l, r, d)
=>
case (strip_source_code_region_data operator)
#
ds::VALCON_IN_EXPRESSION (VALCON { name, ... }, _)
=>
fixitypp ([name], operand, l, r, d);
ds::VARIABLE_IN_EXPRESSION (v, _)
=>
{ path =
case *v
ORDINARY_VARIABLE { path=>symbol_path::SYMBOL_PATH p, ... } => p;
OVERLOADED_IDENTIFIER { name, ... } => [name];
errorvar => [sy::make_value_symbol "<errorvar>"];
esac;
fixitypp (path, operand, l, r, d);
};
operator
=>
{ open_style_box INCONSISTENT 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 (ds::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 (ds::CASE_RULE (pattern, expression), d)
=
if (d > 0)
open_style_box CONSISTENT stream (pp::CURSOR_RELATIVE 0);
print_pattern_as_nada dictionary 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_named_value_as_nada (context as (dictionary, source_opt)) stream (ds::NAMED_VALUE { pattern, expression, ... }, d)
=
if (d > 0)
open_style_box CONSISTENT stream (pp::CURSOR_RELATIVE 0);
print_pattern_as_nada dictionary 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 "<naming>";
fi
also
fun print_recursively_named_value_as_nada context stream (ds::NAMED_RECURSIVE_VALUES { variable=>var, expression, ... }, d)
=
if (d>0)
open_style_box INCONSISTENT stream (pp::CURSOR_RELATIVE 0);
print_var_as_nada stream var; 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 "<rec naming>";
fi
also
fun print_declaration_as_nada (context as (dictionary, source_opt)) stream
=
{ ppsay = pp::string stream;
fun print_declaration_as_nada'(_, 0)
=>
ppsay "<declaration>";
print_declaration_as_nada'(ds::VALUE_DECLARATIONS vbs, d)
=>
{ open_style_box CONSISTENT stream (pp::CURSOR_RELATIVE 0);
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'(ds::RECURSIVE_VALUE_DECLARATIONS rvbs, d)
=>
{ open_style_box CONSISTENT stream (pp::CURSOR_RELATIVE 0);
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'(ds::TYPE_DECLARATIONS typs, d)
=>
{ fun f stream (DEFINED_TYP { path, type_scheme=>TYPE_SCHEME { arity, body }, ... } )
=>
{ case arity
0 => ();
1 => (ppsay "'a ");
n => { print_tuple_as_mythrl7 stream pp::string (type_formals n);
ppsay " ";}; esac;
print_symbol_as_nada stream (inverse_path::last path);
ppsay " = ";
print_type_as_nada dictionary stream body
;};
f _ _ => bug "print_declaration_as_nada'(TYPE_DECLARATIONS)"; end;
open_style_box CONSISTENT stream (pp::CURSOR_RELATIVE 0);
ppvlist stream ("type ", " also ", f, typs);
end_box stream;
};
print_declaration_as_nada' (ds::ENUM_DECLARATIONS { datatyps, with_typs }, d)
=>
{ fun print_data_as_nada stream (PLAIN_TYP { path, arity, kind, ... } )
=>
case kind
DATATYPE(_)
=>
{ case arity
0 => ();
1 => (ppsay "'a ");
n => { print_tuple_as_mythrl7 stream pp::string (type_formals n);
ppsay " ";}; esac;
print_symbol_as_nada stream (inverse_path::last path); ppsay " = ..."
/* ;
print_sequence_as_nada
stream
{ sep = (fn stream => (pp::string stream " |";
break stream { spaces=1, indent_on_wrap=0 } )),
pr = (fn stream =
fn (VALCON { name, ... } ) =
print_symbol_as_nada stream name),
style = INCONSISTENT
}
dcons
*/
;};
_ => bug "print_declaration_as_nada'(ENUM_DECLARATIONS) 1.1";
esac;
print_data_as_nada _ _
=>
bug "print_declaration_as_nada'(ENUM_DECLARATIONS) 1.2";
end;
fun print_with_as_nada stream (DEFINED_TYP { path, type_scheme=>TYPE_SCHEME { arity, body }, ... } )
=>
{ case arity
0 => ();
1 => (ppsay "'a ");
n => { print_tuple_as_mythrl7 stream pp::string (type_formals n);
ppsay " ";}; esac;
print_symbol_as_nada stream (inverse_path::last path);
ppsay " = ";
print_type_as_nada dictionary stream body
;};
print_with_as_nada _ _
=>
bug "print_declaration_as_nada'(ENUM_DECLARATIONS) 2"; end;
# Could call PPDec::print_declaration_as_nada here:
open_style_box CONSISTENT stream (pp::CURSOR_RELATIVE 0);
ppvlist stream ("enum ", "also ", print_data_as_nada, datatyps);
newline stream;
ppvlist stream ("withtype ", "also ", print_with_as_nada, with_typs);
end_box stream;
};
print_declaration_as_nada'(ds::ABSTRACT_TYPE_DECLARATION _, d)
=>
ppsay "abstype";
print_declaration_as_nada'(ds::EXCEPTION_DECLARATIONS ebs, d)
=>
{ fun f stream ( ds::NAMED_EXCEPTION {
exception_constructor => VALCON { name, ... },
exception_type => etype,
...
}
)
=>
{ print_symbol_as_nada stream name;
case etype
#
NULL => ();
THE type'
=>
{
# ppsay " of ";
ppsay " ";
print_type_as_nada dictionary stream type';
};
esac;
};
f stream (ds::DUPLICATE_NAMED_EXCEPTION { exception_constructor => VALCON { name, ... },
equal_to => VALCON { name=>name', ... }
}
)
=>
{ print_symbol_as_nada stream name;
ppsay "=";
print_symbol_as_nada stream name';
};
end;
open_style_box CONSISTENT stream (pp::CURSOR_RELATIVE 0);
ppvlist stream ("exception ", "also ", f, ebs);
end_box stream;
};
print_declaration_as_nada'(ds::PACKAGE_DECLARATIONS sbs, d)
=>
{ fun f stream (ds::NAMED_PACKAGE { name_symbol=>name, a_package=>mld::A_PACKAGE { varhome, ... }, definition=>def } )
=>
{ print_symbol_as_nada stream name;
print_varhome_as_nada stream varhome;
ppsay " = ";
break stream { spaces=>1, indent_on_wrap=>2 };
print_strexp_as_nada context stream (def, d - 1);
};
f _ _
=>
bug "print_declaration_as_nada: PACKAGE_DECLARATION: NAMED_PACKAGE";
end;
open_style_box CONSISTENT stream (pp::CURSOR_RELATIVE 0);
ppvlist stream ("package ", "also ", f, sbs);
end_box stream;
};
print_declaration_as_nada'(ds::GENERIC_DECLARATIONS fbs, d)
=>
{ fun f stream (ds::NAMED_GENERIC { name_symbol => fname,
a_generic => mld::GENERIC { varhome, ... },
definition => def
}
)
=>
{ print_symbol_as_nada stream fname;
print_varhome_as_nada stream varhome;
ppsay " = ";
break stream { spaces=>1, indent_on_wrap=> 2 };
print_fctexp_as_nada context stream (def, d - 1)
;};
f _ _
=>
bug "print_declaration_as_nada': GENERIC_DECLARATION";
end;
open_style_box CONSISTENT stream (pp::CURSOR_RELATIVE 0);
ppvlist stream ("generic package ", "also ", f, fbs);
end_box stream;
};
print_declaration_as_nada'(ds::API_DECLARATIONS sigvars, d)
=>
{ fun f stream (mld::API { name, ... } )
=>
{ ppsay "api ";
case name
THE s => print_symbol_as_nada stream s;
NULL => ppsay "ANONYMOUS"; esac
;};
f _ _
=>
bug "print_declaration_as_nada': API_DECLARATIONS"; end;
open_style_box CONSISTENT stream (pp::CURSOR_RELATIVE 0);
print_sequence_as_nada
stream
{ sep => newline,
pr => f,
style => CONSISTENT
}
sigvars;
end_box stream;
};
print_declaration_as_nada'(ds::GENERIC_API_DECLARATIONS sigvars, d)
=>
{ fun f stream (mld::GENERIC_API { kind, ... } )
=>
{ ppsay "funsig ";
case kind
THE s => print_symbol_as_nada stream s;
NULL => ppsay "ANONYMOUS"; esac
;};
f _ _
=>
bug "print_declaration_as_nada': GENERIC_API_DECLARATIONS"; end;
open_style_box CONSISTENT stream (pp::CURSOR_RELATIVE 0);
print_sequence_as_nada
stream
{ sep => newline,
pr => f,
style => CONSISTENT
}
sigvars;
end_box stream;
};
print_declaration_as_nada'(ds::LOCAL_DECLARATIONS (inner, outer), d)
=>
{ open_style_box CONSISTENT stream (pp::CURSOR_RELATIVE 0);
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'(ds::SEQUENTIAL_DECLARATIONS decs, d)
=>
{ open_style_box CONSISTENT stream (pp::CURSOR_RELATIVE 0);
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'(ds::FIXITY_DECLARATION { fixity, ops }, d)
=>
{ open_style_box CONSISTENT stream (pp::CURSOR_RELATIVE 0);
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 }),
pr => print_symbol_as_nada,
style => INCONSISTENT
}
ops;
end_box stream;
};
print_declaration_as_nada'(ds::OVERLOADED_VARIABLE_DECLARATION overloaded_variable, d)
=>
{ ppsay "overloaded my ";
print_var_as_nada stream overloaded_variable;
};
print_declaration_as_nada'(ds::INCLUDE_DECLARATIONS named_packages, d)
=>
{ open_style_box CONSISTENT stream (pp::CURSOR_RELATIVE 0);
ppsay "use ";
print_sequence_as_nada
stream
{ sep => (fn stream = break stream { spaces=>1, indent_on_wrap=>0 } ),
pr => (fn stream = fn (sp, _) = ppsay (symbol_path::to_string sp)),
style => INCONSISTENT
}
named_packages;
end_box stream;
};
print_declaration_as_nada'(ds::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;
end;
print_declaration_as_nada';
}
also
fun print_strexp_as_nada (context as (_, source_opt)) stream
=
{ ppsay = pp::string stream;
fun print_strexp_as_nada'(_, 0)
=>
ppsay "<package_expression>";
print_strexp_as_nada'(ds::PACKAGE_BY_NAME (mld::A_PACKAGE { varhome, ... } ), d)
=>
print_varhome_as_nada stream 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 stream fa;
ppsay"(";
print_varhome_as_nada stream sa;
ppsay")";
};
print_strexp_as_nada'(ds::PACKAGE_DEFINITION namings, d)
=>
{ open_style_box CONSISTENT stream (pp::CURSOR_RELATIVE 0);
ppsay "pkg"; newline_indent stream 2;
ppsay "...";
# printNamingAsNada not yet undefined
/*
print_sequence_as_nada stream
{ sep=newline,
pr=(fn stream => fn b => printNamingAsNada context stream (b, d - 1)),
style=CONSISTENT }
namings;
*/
ppsay "end";
end_box stream;
};
print_strexp_as_nada'(ds::PACKAGE_LET { declaration, expression }, d)
=>
{ open_style_box CONSISTENT stream (pp::CURSOR_RELATIVE 0);
ppsay "stipulate "; print_declaration_as_nada context stream (declaration, d - 1);
newline stream;
ppsay " herein "; print_strexp_as_nada'(expression, d - 1); newline stream;
ppsay "end";
end_box stream;
};
print_strexp_as_nada'(ds::SOURCE_CODE_REGION_FOR_PACKAGE (body, (s, e)), d)
=>
case source_opt
THE source
=>
{ ppsay "ds::SOURCE_CODE_REGION_FOR_PACKAGE(";
print_strexp_as_nada'(body, d); ppsay ", ";
prpos (stream, source, s); ppsay ", ";
prpos (stream, source, e); ppsay ")"
;};
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)) stream
=
{ ppsay = pp::string stream;
fun print_fctexp_as_nada'(_, 0)
=>
ppsay "<generic_expression>";
print_fctexp_as_nada'(ds::GENERIC_BY_NAME (mld::GENERIC { varhome, ... } ), d)
=>
print_varhome_as_nada stream varhome;
print_fctexp_as_nada'(ds::GENERIC_DEFINITION { parameter=>mld::A_PACKAGE { varhome, ... }, definition=>def, ... }, d)
=>
{ ppsay " GENERIC(";
print_varhome_as_nada stream varhome;
ppsay ") => "; newline stream;
print_strexp_as_nada context stream (def, d - 1);
};
print_fctexp_as_nada'(ds::GENERIC_LET (declaration, body), d)
=>
{ open_style_box CONSISTENT stream (pp::CURSOR_RELATIVE 0);
ppsay "stipulate "; print_declaration_as_nada context stream (declaration, d - 1);
newline stream;
ppsay " herein "; print_fctexp_as_nada'(body, d - 1); newline stream;
ppsay "end";
end_box stream;
};
print_fctexp_as_nada'(ds::SOURCE_CODE_REGION_FOR_GENERIC (body, (s, e)), d)
=>
case source_opt
THE source
=>
{ ppsay "SOURCE_CODE_REGION_FOR_GENERIC(";
print_fctexp_as_nada'(body, d); ppsay ", ";
prpos (stream, source, s); ppsay ", ";
prpos (stream, source, e); ppsay ")";
};
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