## latex-print-package-language.pkg
## Copyright 2003 by The SML/NJ Fellowship
# Compiled by:
# src/lib/compiler/front/typer/typer.sublib# Invoked from src/lib/compiler/front/typer-stuff/symbolmapstack/latex-print-symbolmapstack.pkg# This is a clone of unparse-package-language.pkg
# specialized to produce LaTeX output intended to be
# run through Hevea to produce online HTML docs of
# our interfaces.
#
# Modified to use Mythryl stdlib prettyprinter. [dbm, 7/30/03])
stipulate
package mld = module_level_declarations; # module_level_declarations is from src/lib/compiler/front/typer-stuff/modules/module-level-declarations.pkg package sxe = symbolmapstack_entry; # symbolmapstack_entry is from src/lib/compiler/front/typer-stuff/symbolmapstack/symbolmapstack-entry.pkg package syx = symbolmapstack; # symbolmapstack is from src/lib/compiler/front/typer-stuff/symbolmapstack/symbolmapstack.pkgherein
api Latex_Print_Package_Language {
latex_print_api
:
prettyprint::Stream
->
( mld::Api,
syx::Symbolmapstack,
Int, # Max prettyprint recursion depth
Ref( List( String ) ) # index_entries -- a return value list of strings like "(backslash)index[fun]{foo}" her
)
->
Void;
latex_print_package
:
prettyprint::Stream
->
( mld::Package,
syx::Symbolmapstack,
Int, # Max prettyprint recursion depth
Ref( List( String ) ) # index_entries -- a return value list of strings like "(backslash)index[fun]{foo}" her
)
->
Void;
latex_print_open
:
prettyprint::Stream
->
( symbol_path::Symbol_Path,
mld::Package,
syx::Symbolmapstack,
Int, # Max prettyprint recursion depth
Ref( List( String ) ) # index_entries -- a return value list of strings like "(backslash)index[fun]{foo}" her
)
->
Void;
latex_print_package_name
:
prettyprint::Stream
->
( mld::Package,
syx::Symbolmapstack
)
->
Void;
latex_print_generic
:
prettyprint::Stream
->
( mld::Generic,
syx::Symbolmapstack,
Int, # Max prettyprint recursion depth
Ref( List( String ) ) # index_entries -- a return value list of strings like "(backslash)index[fun]{foo}" her
)
->
Void;
latex_print_generic_api
:
prettyprint::Stream
->
( mld::Generic_Api,
syx::Symbolmapstack,
Int, # Max prettyprint recursion depth
Ref( List( String ) ) # index_entries -- a return value list of strings like "(backslash)index[fun]{foo}" her
)
->
Void;
latex_print_naming
:
prettyprint::Stream
->
( symbol::Symbol,
sxe::Symbolmapstack_Entry,
syx::Symbolmapstack,
Int, # Max prettyprint recursion depth
Ref( List( String ) ) # index_entries -- a return value list of strings like "(backslash)index[fun]{foo}" her
)
->
Void;
latex_print_dictionary
:
prettyprint::Stream
->
( syx::Symbolmapstack,
syx::Symbolmapstack,
Int,
Null_Or( List( symbol::Symbol ) ),
Ref( List( String ) ) # index_entries -- a return value list of strings like "(backslash)index[fun]{foo}" her
)
->
Void;
# module internals
latex_print_elements
:
( syx::Symbolmapstack,
Int,
Null_Or( mld::Typerstore ),
Ref( List( String ) ) # index_entries -- a return value list of strings like "(backslash)index[fun]{foo}" her
)
-> prettyprint::Stream
-> mld::Api_Elements
-> Void;
latex_print_typechecked_package
:
prettyprint::Stream
->
( mld::Typerstore_Entry,
syx::Symbolmapstack,
Int
)
->
Void;
latex_print_typerstore
:
prettyprint::Stream
->
( mld::Typerstore,
syx::Symbolmapstack,
Int
)
->
Void;
};
end;
stipulate
package a = varhome; # varhome is from src/lib/compiler/front/typer-stuff/basics/varhome.pkg package b = symbolmapstack_entry; # symbolmapstack_entry is from src/lib/compiler/front/typer-stuff/symbolmapstack/symbolmapstack-entry.pkg package bt = type_types; # type_types is from src/lib/compiler/front/typer/types/type-types.pkg package ip = inverse_path; # inverse_path is from src/lib/compiler/front/typer-stuff/basics/symbol-path.pkg package lu = find_in_symbolmapstack; # find_in_symbolmapstack is from src/lib/compiler/front/typer-stuff/symbolmapstack/find-in-symbolmapstack.pkg package mj = module_junk; # module_junk is from src/lib/compiler/front/typer-stuff/modules/module-junk.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 s = symbol; # symbol is from src/lib/compiler/front/basics/map/symbol.pkg package sp = symbol_path; # symbol_path is from src/lib/compiler/front/typer-stuff/basics/symbol-path.pkg package syx = symbolmapstack; # symbolmapstack is from src/lib/compiler/front/typer-stuff/symbolmapstack/symbolmapstack.pkg package tro = typerstore; # typerstore is from src/lib/compiler/front/typer-stuff/modules/typerstore.pkg package tu = type_junk; # type_junk is from src/lib/compiler/front/typer-stuff/types/type-junk.pkg package ty = types; # types is from src/lib/compiler/front/typer-stuff/types/types.pkg package v = variables_and_constructors; # variables_and_constructors is from src/lib/compiler/front/typer-stuff/deep-syntax/variables-and-constructors.pkg # package id = inlining_data
#
include prettyprint;
include unparse_junk;
herein
package latex_print_package_language
: (weak) Latex_Print_Package_Language
{
# typer_control is from src/lib/compiler/front/typer/basics/typer-control.pkg internals
=
typer_control::internals;
fun bug msg
=
error_message::impossible("latex_print_package_language: " + msg);
fun by f x y
=
f y x;
pps = pp::string;
latex_print_some_type = latex_print_type::latex_print_some_type;
latex_print_type = latex_print_type::latex_print_type;
latex_print_type_scheme = latex_print_type::latex_print_type_scheme;
latex_print_formals = latex_print_type::latex_print_formals;
backslash_latex_special_chars = latex_print_value::backslash_latex_special_chars;
result_id
=
s::make_package_symbol "<result_package>";
fun str_to_dictionary ( mld::API { api_elements, ... }, entities)
=>
fold_forward bind_element syx::empty api_elements
where
fun bind_element ((symbol, spec), symbolmapstack)
=
case spec
mld::TYP_IN_API { module_stamp, ... }
=>
{ typ
=
tro::find_typ_by_module_stamp (entities, module_stamp);
syx::bind (symbol, b::NAMED_TYPE typ, symbolmapstack );
};
mld::PACKAGE_IN_API { module_stamp, an_api, ... }
=>
{ typechecked_package
=
tro::find_package_by_module_stamp (entities, module_stamp);
syx::bind (
symbol,
b::NAMED_PACKAGE (
mld::A_PACKAGE {
an_api,
typechecked_package,
varhome => a::null_varhome,
inlining_data => inlining_data::NULL
}
),
symbolmapstack
);
};
mld::VALCON_IN_API { datatype, ... }
=>
syx::bind (symbol, b::NAMED_CONSTRUCTOR datatype, symbolmapstack);
_ =>
symbolmapstack;
esac;
end;
str_to_dictionary _
=>
syx::empty;
end;
fun api_to_symbolmapstack ( mld::API { api_elements, ... } )
=>
fold_forward bind_element syx::empty api_elements
where
fun bind_element ((symbol, spec), symbolmapstack)
=
case spec
#
mld::TYP_IN_API { typ, ... }
=>
syx::bind (symbol, b::NAMED_TYPE typ, symbolmapstack);
mld::PACKAGE_IN_API { an_api, slot, definition, module_stamp=>ev }
=>
syx::bind (
symbol,
b::NAMED_PACKAGE (
mld::PACKAGE_API {
an_api,
stamppath => [ev]
}
),
symbolmapstack
);
mld::VALCON_IN_API { datatype, ... }
=>
syx::bind (symbol, b::NAMED_CONSTRUCTOR datatype, symbolmapstack);
_ =>
symbolmapstack;
esac;
end;
api_to_symbolmapstack _
=>
bug "api_to_symbolmapstack";
end;
# Support for a hack to make sure that non-visible ConNamings don't
# cause spurious blank lines when latex_print-ing apis.
#
fun is_latex_printable_valcon_naming (ty::VALCON { form=>a::EXCEPTION _, ... }, _)
=>
TRUE;
is_latex_printable_valcon_naming (con, symbolmapstack)
=>
{ exception HIDDEN;
visible_dcon_typ
=
{ typ
=
tu::datatyp_to_typ con;
( tu::typ_equality
( lu::find_typ_via_symbol_path
( symbolmapstack,
sp::SYMBOL_PATH [ ip::last (tu::typ_path typ) ],
fn _ = raise exception HIDDEN
),
typ
)
except
HIDDEN = FALSE
);
};
( *internals or
not visible_dcon_typ
);
};
end;
fun all_latex_printable_namings alist symbolmapstack
=
list::filter
fn (name, b::NAMED_CONSTRUCTOR con)
=>
is_latex_printable_valcon_naming (con, symbolmapstack);
b =>
TRUE;
end
alist;
fun latex_print_lty stream ( /* lambdaty, depth */ )
=
pps stream "<lambdaty>";
fun latex_print_typechecked_package_variable stream module_stamp
=
pps stream (stamppath::module_stamp_to_string module_stamp);
fun latex_print_stamppath stream stamppath
=
pps stream (stamppath::stamppath_to_string stamppath);
/* prettyprintClosedSequence ppstream
{ front=(fn stream => pps stream "["),
sep=(fn stream => (pps stream ", "; break stream { spaces=0, indent_on_wrap=0 } )),
back=(fn stream => pps stream "]"),
style=INCONSISTENT,
pr=prettyprintMacroExpansionVariable }
*/
fun latex_print_typ_expression stream (typ_expression, depth)
=
if (depth <= 0)
pps stream "<typeConstructorExpression>";
else
case typ_expression
mld::TYPE_VARIABLE_TYP ep
=>
{ pps stream "te::V:";
break stream { spaces=>1, indent_on_wrap=>1 };
latex_print_stamppath stream ep;
};
mld::CONSTANT_TYP typ
=>
{ pps stream "te::C:";
break stream { spaces=>1, indent_on_wrap=>1 };
latex_print_type syx::empty stream typ;
};
mld::FORMAL_TYP typ
=>
{ pps stream "te::FM:";
break stream { spaces=>1, indent_on_wrap=>1 };
latex_print_type syx::empty stream typ;
};
esac;
fi;
fun latex_print_package_name stream (str, symbolmapstack)
=
{ inverse_path
=
case str
mld::A_PACKAGE { typechecked_package, ... }
=>
typechecked_package.inverse_path;
_ => bug "latex_print_package_name";
esac;
fun get a
=
lu::find_package_via_symbol_path (
symbolmapstack,
a,
(fn _ = raise exception syx::UNBOUND)
);
fun check str'
=
mj::eq_origin (str', str);
my (syms, found)
=
find_path (inverse_path, check, get);
pps stream ( found ?? sp::to_string (sp::SYMBOL_PATH syms)
:: "?" + (sp::to_string (sp::SYMBOL_PATH syms))
);
};
fun latex_print_variable stream
=
{ (en_pp stream)
->
{ begin_horizontal_else_vertical_box, begin_wrap_box, end_box, pps, ... };
fun latex_print_v ( v::ORDINARY_VARIABLE { path, varhome, var_type, inlining_data },
symbolmapstack: syx::Symbolmapstack
)
=>
{ begin_horizontal_else_vertical_box 0;
pps (sp::to_string path);
if *internals
latex_print_value::latex_print_varhome stream varhome;
fi;
pps " : ";
latex_print_some_type symbolmapstack stream *var_type;
end_box ();
};
latex_print_v (v::OVERLOADED_IDENTIFIER { name, alternatives, type_scheme=>ty::TYPE_SCHEME { body, ... } }, symbolmapstack)
=>
{ begin_horizontal_else_vertical_box 0;
unparse_symbol stream (name);
pps " : ";
latex_print_some_type symbolmapstack stream body;
pps " as ";
unparse_sequence stream
{ sep => by prettyprint::break { spaces=>1, indent_on_wrap=>0 },
pr => (fn stream = fn { variant, ... } = latex_print_v (variant, symbolmapstack)),
style => CONSISTENT
}
*alternatives;
end_box ();
};
latex_print_v (v::ERRORVAR, _)
=>
pps "<ERRORVAR>";
end;
latex_print_v;
};
fun latex_print_con_naming stream
=
{ (en_pp stream)
->
{ begin_horizontal_else_vertical_box, begin_wrap_box, end_box, pps, ... };
fun latex_print_con (ty::VALCON { name, type, form=>a::EXCEPTION _, ... }, symbolmapstack)
=>
{ begin_wrap_box 4;
pps "exception "; unparse_symbol stream name;
if (type_types::is_arrow_type type)
# pps " of ";
pps " ";
latex_print_some_type symbolmapstack stream (type_types::domain type);
fi;
end_box ();
};
latex_print_con (con as ty::VALCON { name, type, ... }, symbolmapstack)
=>
if *internals
begin_wrap_box 4;
pps "Constructor ";
unparse_symbol stream name;
pps " : ";
latex_print_some_type symbolmapstack stream type;
end_box ();
fi;
end;
latex_print_con;
};
fun latex_print_package stream (pkg, symbolmapstack, depth, index_entries)
=
{ (en_pp stream)
->
{ begin_horizontal_else_vertical_box, begin_wrap_box, end_box, pps, break, newline };
case pkg
#
mld::A_PACKAGE { an_api, typechecked_package as { typerstore, ... }, ... }
=>
if *internals
#
begin_horizontal_else_vertical_box 2;
pps "A_PACKAGE";
newline_indent stream 2;
begin_horizontal_else_vertical_box 0;
pps "an_api:";
break { spaces=>1, indent_on_wrap=>2 };
latex_print_api0 stream (an_api, symbolmapstack, depth - 1, THE typerstore, index_entries);
newline();
pps "typechecked_package:";
break { spaces=>1, indent_on_wrap=>2 };
latex_print_generics_expansion stream (typechecked_package, symbolmapstack, depth - 1);
end_box ();
end_box ();
else
case an_api
#
mld::API { name => THE symbol, ... }
=>
( ( if (mj::apis_equal (
an_api,
lu::find_api_by_symbol (
symbolmapstack,
symbol,
(fn _ = raise exception syx::UNBOUND)
)
)
)
unparse_symbol stream symbol;
else
unparse_symbol stream symbol;
pps "?";
fi
)
except
syx::UNBOUND
=
{ unparse_symbol stream symbol;
pps "?";
}
);
mld::API { name => NULL, ... }
=>
if (depth <= 1)
#
pps "<sig>";
else
latex_print_api0 stream
(an_api, symbolmapstack, depth - 1, THE typerstore, index_entries);
fi;
mld::ERRONEOUS_API
=>
pps "<error sig>";
esac;
fi;
mld::PACKAGE_API _ => pps "<pkg api>";
mld::ERRONEOUS_PACKAGE => pps "<error str>";
esac;
}
also
fun latex_print_elements (symbolmapstack, depth, typechecked_package_env_op, index_entries) stream elements
=
{ fun pr first (symbol, spec)
=
case spec
#
mld::PACKAGE_IN_API { an_api, module_stamp, definition, slot }
=>
{ if (not first)
newline stream;
fi;
begin_horizontal_else_vertical_box stream;
pps stream "package ";
unparse_symbol stream symbol;
pps stream " :";
break stream { spaces=>1, indent_on_wrap=>2 };
begin_horizontal_else_vertical_box stream;
case typechecked_package_env_op
#
NULL
=>
latex_print_api0
stream
( an_api,
symbolmapstack,
depth - 1,
NULL,
index_entries
);
THE eenv
=>
{ my { typerstore, ... }
=
case (tro::find_entry_by_module_stamp (eenv, module_stamp))
#
mld::PACKAGE_ENTRY e
=>
e;
_ => bug "latex_print_elements: PACKAGE_ENTRY";
esac;
latex_print_api0 stream (an_api, symbolmapstack, depth - 1, THE typerstore, index_entries);
};
esac;
if *internals
#
newline stream;
pps stream "module_stamp: ";
pps stream (stamppath::module_stamp_to_string module_stamp);
fi;
pps stream ";";
end_box stream;
end_box stream;
};
mld::GENERIC_IN_API { a_generic_api, module_stamp, slot }
=>
{ if (not first)
newline stream;
fi;
begin_horizontal_else_vertical_box stream;
pps stream "generic package ";
unparse_symbol stream symbol; pps stream " :";
break stream { spaces=>1, indent_on_wrap=>2 };
begin_horizontal_else_vertical_box stream;
latex_print_generic_api stream (a_generic_api, symbolmapstack, depth - 1, index_entries);
if *internals
newline stream;
pps stream "module_stamp: ";
pps stream (stamppath::module_stamp_to_string module_stamp);
fi;
pps stream ";";
end_box stream;
end_box stream;
};
mld::TYP_IN_API { typ=>spec, module_stamp, is_a_replica, scope }
=>
{ if (not first)
newline stream;
fi;
begin_horizontal_else_vertical_box stream;
case typechecked_package_env_op
#
NULL =>
if is_a_replica latex_print_replicate_naming stream (spec, symbolmapstack);
else latex_print_typ_bind stream (spec, symbolmapstack);
fi;
THE eenv
=>
case (tro::find_entry_by_module_stamp (eenv, module_stamp))
mld::TYP_ENTRY typ
=>
if is_a_replica
latex_print_replicate_naming stream (typ, symbolmapstack);
else
latex_print_typ_bind stream (typ, symbolmapstack);
fi;
mld::ERRONEOUS_ENTRY
=>
pps stream "<ERRONEOUS_ENTRY>";
_ =>
bug "latex_print_elements: TYP_ENTRY";
esac;
esac;
if *internals
newline stream;
pps stream "module_stamp: ";
pps stream (stamppath::module_stamp_to_string module_stamp);
newline stream;
pps stream "scope: ";
pps stream (int::to_string scope);
fi;
pps stream ";";
end_box stream;
};
mld::VALUE_IN_API { type, ... }
=>
{ if first ();
else newline stream;
fi;
begin_indented_wrap_box stream (pp::CURSOR_RELATIVE 4);
pps stream /*2007-12-08CrT:"my "*/"";
unparse_symbol stream symbol; pps stream " : ";
latex_print_some_type symbolmapstack stream (type);
pps stream ";";
# Add an appropriate TeX index entry for the value,
# for our html manual. We break the string up a
# bit to avoid irritating Mythryl or HeVea with
# apparent keywords in their respective syntaxes:
#
index_entries
:=
( (string::cat [ "\\inde", "x[fu", "n]{", (backslash_latex_special_chars (symbol::name symbol)), "}\n" ])
!
(*index_entries)
);
end_box stream;
};
mld::VALCON_IN_API {
datatype => dcon as ty::VALCON {
form => a::EXCEPTION _,
...
},
...
}
=>
{ if (not first)
newline stream;
fi;
latex_print_con_naming stream (dcon, symbolmapstack);
pps stream ";";
};
mld::VALCON_IN_API { datatype, ... }
=>
if *internals
#
if (not first)
newline stream;
fi;
latex_print_con_naming stream (datatype, symbolmapstack);
pps stream ";";
fi; # Ordinary data constructor -- don't print.
esac;
begin_horizontal_else_vertical_box stream;
case elements
#
NIL => ();
first ! rest => { pr TRUE first;
apply (pr FALSE) rest;
};
esac;
end_box stream;
}
also
fun latex_print_api0 stream (an_api, symbolmapstack, depth, typechecked_package_env_op, index_entries)
=
{ my { begin_horizontal_else_vertical_box, begin_wrap_box, end_box, pps, break, newline }
=
en_pp stream;
symbolmapstack = syx::atop (
case typechecked_package_env_op
#
NULL => api_to_symbolmapstack an_api;
#
THE typerstore => str_to_dictionary (an_api, typerstore);
esac,
symbolmapstack
);
fun latex_print_constraints (variety, constraints: List( mld::Share_Spec ))
=
{ begin_horizontal_else_vertical_box 0;
ppvseq stream 0 ""
(fn stream =
fn paths =
{ begin_wrap_box 2;
pps "sharing "; pps variety;
unparse_sequence stream
{ sep=>(fn stream = { pps " ="; break { spaces=>1, indent_on_wrap=>0 }; }),
pr=>unparse_symbol_path,
style=>INCONSISTENT
}
paths;
end_box ();
}
)
constraints;
end_box ();
};
some_print = REF FALSE;
if (depth <= 0)
pps "<api>;";
else
case an_api
#
mld::API { stamp, name, api_elements, type_sharing, package_sharing, ... }
=>
if *internals
#
begin_horizontal_else_vertical_box 0;
pps "BEGIN_API:";
newline_indent stream 2;
begin_horizontal_else_vertical_box 0;
pps "stamp: "; pps (stamp::to_short_string stamp);
newline();
pps "name: ";
case name
#
NULL => pps "ANONYMOUS";
#
THE p => { pps "NAMED ";
unparse_symbol stream p;
};
esac;
case api_elements
#
NIL => ();
#
_ => { newline();
pps "elements:";
newline_indent stream 2;
latex_print_elements (symbolmapstack, depth, typechecked_package_env_op, index_entries) stream api_elements;
};
esac;
case package_sharing
NIL => ();
_ => { newline();
pps "package_sharing:";
newline_indent stream 2;
latex_print_constraints("", package_sharing);
};
esac;
case type_sharing
NIL => ();
_ => { newline();
pps "typsharing:";
newline_indent stream 2;
latex_print_constraints(/*2007-12-07CrT"type "*/"", type_sharing);
};
esac;
pps ";";
end_box ();
end_box ();
else
# not *internals
begin_horizontal_else_vertical_box 0;
pps "api {";
newline(); # 2008-01-03 CrT: Was: break { spaces=>1, indent_on_wrap=>2 };
begin_horizontal_else_vertical_box 0;
pps " ";
case api_elements
#
NIL => ();
_ => { latex_print_elements (symbolmapstack, depth, typechecked_package_env_op, index_entries) stream api_elements;
some_print := TRUE;
};
esac;
case package_sharing
#
NIL => ();
#
_ => { if *some_print newline(); fi;
latex_print_constraints("", package_sharing);
some_print := TRUE;
};
esac;
case type_sharing
#
NIL => ();
#
_ => { if *some_print newline(); fi;
latex_print_constraints(/*2007-12-07CrT"type "*/"", type_sharing);
some_print := TRUE;
};
esac;
end_box ();
if *some_print
#
newline();
# break { spaces => 1, indent_on_wrap => 0 };
fi;
pps "};";
end_box ();
fi;
mld::ERRONEOUS_API
=>
pps "<error api>;";
esac;
fi;
}
also
fun latex_print_generic_api stream (an_api, symbolmapstack, depth, index_entries)
=
{ my { begin_horizontal_else_vertical_box, begin_wrap_box, end_box, pps, break, newline }
=
en_pp stream;
fun true_body_sig (orig as mld::API { api_elements => [(symbol, mld::PACKAGE_IN_API { an_api, ... } )],
...
}
)
=>
if (symbol::eq (symbol, result_id)) an_api;
else orig;
fi;
true_body_sig orig
=>
orig;
end;
if (depth <= 0)
#
pps "<fctsig>";
else
case an_api
#
mld::GENERIC_API { parameter_api, parameter_variable, parameter_symbol, body_api, ... }
=>
if *internals
#
begin_horizontal_else_vertical_box 0;
pps "GENERIC_API:";
newline_indent stream 2;
begin_horizontal_else_vertical_box 0;
pps "psig: ";
latex_print_api0 stream (parameter_api, symbolmapstack, depth - 1, NULL, index_entries);
newline();
pps "pvar: ";
pps (stamppath::module_stamp_to_string parameter_variable);
newline();
pps "psym: ";
case parameter_symbol
NULL => pps "<anonymous>";
THE symbol => unparse_symbol stream symbol;
esac;
newline();
pps "bsig: ";
latex_print_api0 stream (body_api, symbolmapstack, depth - 1, NULL, index_entries);
end_box ();
end_box ();
else
begin_horizontal_else_vertical_box 0;
pps "(";
case parameter_symbol
THE x => pps (s::name x);
_ => pps "<parameter>";
esac;
pps ": ";
latex_print_api0 stream (parameter_api, symbolmapstack, depth - 1, NULL, index_entries);
pps ") :";
break { spaces=>1, indent_on_wrap=>0 };
latex_print_api0 stream (true_body_sig body_api, symbolmapstack, depth - 1, NULL, index_entries);
end_box ();
fi;
mld::ERRONEOUS_GENERIC_API
=>
pps "<error fsig>";
esac;
fi;
}
also
fun latex_print_generics_expansion stream (e, symbolmapstack, depth)
=
{ e -> { stamp, typerstore, property_list, inverse_path, stub };
(en_pp stream)
->
{ begin_horizontal_else_vertical_box, begin_wrap_box, end_box, pps, break, newline };
if (depth <= 1)
pps "<package typechecked_package>";
else
begin_horizontal_else_vertical_box 0;
pps "Typechecked_Package:";
newline_indent stream 2;
begin_horizontal_else_vertical_box 0;
pps "inverse_path: ";
pps (ip::to_string inverse_path);
newline();
pps "stamp: ";
pps (stamp::to_short_string stamp);
newline();
pps "typerstore:";
newline_indent stream 2;
latex_print_typerstore stream (typerstore, symbolmapstack, depth - 1);
newline();
pps "lambdaty:";
newline_indent stream 2;
latex_print_lty stream ( /* ModulePropLists::packageMacroExpansionLambdatype e, depth - 1 */);
end_box ();
end_box ();
fi;
}
also
fun latex_print_typechecked_generic stream (e, symbolmapstack, depth)
=
{ e -> { stamp, generic_closure, property_list, typ_path, inverse_path, stub };
(en_pp stream) -> { begin_horizontal_else_vertical_box, begin_wrap_box, end_box, pps, break, newline };
if (depth <= 1)
pps "<generic typechecked_package>";
else
begin_horizontal_else_vertical_box 0;
pps "Typechecked_Generic:";
newline_indent stream 2;
begin_horizontal_else_vertical_box 0;
pps "inverse_path: ";
pps (ip::to_string inverse_path);
newline();
pps "stamp: ";
pps (stamp::to_short_string stamp);
newline();
pps "generic_closure:";
break { spaces=>1, indent_on_wrap=>2 };
latex_print_closure stream (generic_closure, depth - 1);
newline();
pps "lambdaty:";
break { spaces=>1, indent_on_wrap=>2 };
latex_print_lty stream ( /* ModulePropLists::genericMacroExpansionLty e, depth - 1 */ );
pps "typ_path:";
break { spaces=>1, indent_on_wrap=>2 };
pps "--printing of Typ_Path not implemented yet--";
end_box ();
end_box ();
fi;
}
also
fun latex_print_generic stream
=
latex_print_f
where
(en_pp stream)
->
{ begin_horizontal_else_vertical_box, begin_wrap_box, end_box, pps, break, newline };
fun latex_print_f (mld::GENERIC { a_generic_api, typechecked_generic, ... }, symbolmapstack, depth, index_entries)
=>
if (depth <= 1)
#
pps "<generic package>";
else
begin_horizontal_else_vertical_box 0;
pps "a_generic_api:";
newline_indent stream 2;
latex_print_generic_api stream (a_generic_api, symbolmapstack, depth - 1, index_entries);
newline();
pps "typechecked_generic:";
newline_indent stream 2;
latex_print_typechecked_generic stream (typechecked_generic, symbolmapstack, depth - 1);
end_box ();
fi;
latex_print_f (mld::ERRONEOUS_GENERIC, _, _, _)
=>
pps "<error generic package>";
end;
end
also
fun latex_print_typ_bind stream (typ, symbolmapstack)
=
{ (en_pp stream)
->
{ begin_horizontal_else_vertical_box, begin_wrap_box, end_box, pps, break, newline };
fun visible_dcons (typ, dcons)
=
find dcons
where
fun check_con (v::CONSTRUCTOR c) => c;
check_con _ => raise exception syx::UNBOUND;
end;
fun find ((actual as { name, form, domain } ) ! rest)
=>
{ found
=
check_con (lu::find_value_by_symbol
(symbolmapstack, name,
fn _ = raise exception syx::UNBOUND));
# Test whether the datatypes of actual and
# found constructor agree:
case (tu::datatyp_to_typ found)
#
typ1 as ty::PLAIN_TYP _
=>
# The expected form in packages
if (tu::typs_are_equal (typ, typ1))
found ! find rest;
else find rest;fi;
ty::TYP_BY_STAMPPATH _
=>
/* the expected form in apis;
we won't check visibility [dbm] */
found ! find rest;
d_found
=>
# something's weird
{ old_internals = *internals;
internals := TRUE;
begin_horizontal_else_vertical_box 0;
pps "latex_print_typ_bind failure: ";
newline();
latex_print_type symbolmapstack stream typ;
newline();
latex_print_type symbolmapstack stream d_found;
newline();
end_box ();
internals := old_internals;
find rest;
};
esac;
}
except
syx::UNBOUND = find rest;
find []
=>
[];
end;
end; # fun visible_dcons
fun strip_poly (ty::TYPE_SCHEME_TYPE { type_scheme => ty::TYPE_SCHEME { body, ... }, ... } )
=>
body;
strip_poly type
=>
type;
end;
fun latex_print_dcon (ty::VALCON { name, type, ... } )
=
{ unparse_symbol stream name;
type = strip_poly type;
if (bt::is_arrow_type type)
#
# pps " of ";
pps " ";
latex_print_some_type symbolmapstack stream (bt::domain type);
fi;
};
if *internals
#
begin_horizontal_else_vertical_box 0;
pps /*2007-12-07CrT"type "*/"";
latex_print_type symbolmapstack stream typ;
end_box ();
else
case typ
#
ty::PLAIN_TYP { path, arity, eqtype_info, kind, ... }
=>
case (*eqtype_info, kind)
#
(ty::eq_type::EQ_ABSTRACT, _)
=>
# Abstype
{ begin_horizontal_else_vertical_box 0;
pps /*2007-12-07CrT"type "*/"";
unparse_symbol stream (ip::last path);
pps " ";
latex_print_formals stream arity;
end_box ();
};
(_, ty::DATATYPE { index, family => { members, ... }, ... } )
=>
# ordinary enum
{ my { constructor_list, ... }
=
vector::get (members, index);
visdcons = visible_dcons (typ, constructor_list);
incomplete = length visdcons < length constructor_list;
begin_horizontal_else_vertical_box 0;
# pps "enum";
unparse_symbol stream (ip::last path);
pps " ";
latex_print_formals stream arity;
case visdcons
#
NIL => pps " = ...";
first ! rest
=>
{ break { spaces=>1, indent_on_wrap=>2 };
begin_horizontal_else_vertical_box 0;
pps "= "; latex_print_dcon first;
apply (fn d = { break { spaces=>1, indent_on_wrap=>0 };
pps "| ";
latex_print_dcon d;
}
)
rest;
if incomplete
break { spaces=>1, indent_on_wrap=>0 };
pps "... ";
fi;
end_box ();
};
esac;
end_box ();
};
_ =>
{ begin_horizontal_else_vertical_box 0;
if (eq_types::is_equality_typ typ) pps "eqtype ";
else pps /*2007-12-07CrT"type "*/"";
fi;
unparse_symbol stream (ip::last path);
pps " ";
latex_print_formals stream arity;
end_box ();
};
esac;
ty::DEFINED_TYP { path, type_scheme => ty::TYPE_SCHEME { arity, body }, ... }
=>
{ begin_wrap_box 2;
pps /*2007-12-07CrT"type "*/"";
unparse_symbol stream (inverse_path::last path);
break { spaces=>1, indent_on_wrap=>0 };
latex_print_formals stream arity;
pps " =";
break { spaces=>1, indent_on_wrap=>0 };
latex_print_some_type symbolmapstack stream body;
end_box ();
};
typ
=>
{ pps "strange typ: ";
latex_print_type symbolmapstack stream typ;
};
esac;
fi;
} # fun latex_print_typ_bind stream
also
fun latex_print_replicate_naming
stream
( ty::DEFINED_TYP {
type_scheme => ty::TYPE_SCHEME {
body => ty::TYPCON_TYPE (right_typ, _),
...
},
path,
...
},
symbolmapstack
)
=>
{ (en_pp stream)
->
{ begin_horizontal_else_vertical_box, begin_wrap_box, end_box, pps, break, newline };
begin_wrap_box 2;
# pps "enum"; break { spaces => 1, indent_on_wrap => 0 };
unparse_symbol stream (ip::last path);
pps " ="; break { spaces => 1, indent_on_wrap => 0 };
# pps "enum"; break { spaces => 1, indent_on_wrap => 0 };
latex_print_type symbolmapstack stream right_typ;
end_box ();
};
latex_print_replicate_naming _ _
=>
error_message::impossible "latex_print_replicate_naming";
end
also
fun latex_print_typechecked_package stream (typechecked_package, symbolmapstack, depth)
=
case typechecked_package
#
mld::TYP_ENTRY typ
=>
latex_print_type symbolmapstack stream typ;
mld::PACKAGE_ENTRY typechecked_package
=>
latex_print_generics_expansion stream (typechecked_package, symbolmapstack, depth - 1);
mld::GENERIC_ENTRY typechecked_generic
=>
latex_print_typechecked_generic stream (typechecked_generic, symbolmapstack, depth - 1);
mld::ERRONEOUS_ENTRY
=>
pps stream "ERRONEOUS_ENTRY";
esac
also
fun latex_print_typerstore stream (typerstore, symbolmapstack, depth)
=
if (depth <= 1)
#
pps stream "<typerstore>";
else
(ppvseq
stream 2 ""
(fn stream =
fn (module_stamp, typechecked_package)
=
{ (en_pp stream)
->
{ begin_horizontal_else_vertical_box, begin_wrap_box, end_box, pps, break, newline };
begin_horizontal_else_vertical_box 2;
pps (stamppath::module_stamp_to_string module_stamp);
pps ":";
newline_indent stream 2;
latex_print_typechecked_package stream (typechecked_package, symbolmapstack, depth - 1);
newline();
end_box ();
}
)
(tro::to_list typerstore));
fi
also
fun latex_print_module_declaration stream (module_declaration, depth)
=
if (depth <= 0)
pps stream "<module_declaration>";
else
case module_declaration
#
mld::TYP_DECLARATION ( module_stamp, typ_expression )
=>
{ pps stream "ed::T: ";
latex_print_typechecked_package_variable stream module_stamp;
break stream { spaces=>1, indent_on_wrap=>1 };
latex_print_typ_expression stream (typ_expression, depth - 1);
};
mld::PACKAGE_DECLARATION (module_stamp, package_expression, symbol)
=>
{ pps stream "ed::S: ";
latex_print_typechecked_package_variable stream module_stamp;
break stream { spaces=>1, indent_on_wrap=>1 };
latex_print_package_expression stream (package_expression, depth - 1);
break stream { spaces=>1, indent_on_wrap=>1 };
unparse_symbol stream symbol;
};
mld::GENERIC_DECLARATION (module_stamp, generic_expression)
=>
{ pps stream "ed::F: ";
latex_print_typechecked_package_variable stream module_stamp;
break stream { spaces=>1, indent_on_wrap=>1 };
latex_print_generic_expression stream (generic_expression, depth - 1);
};
mld::SEQUENTIAL_DECLARATIONS typechecked_package_decs
=>
ppvseq stream 0 ""
(fn stream =
fn module_declaration =
latex_print_module_declaration stream (module_declaration, depth)
)
typechecked_package_decs;
mld::LOCAL_DECLARATION (typechecked_package_dec_l, typechecked_package_dec_b)
=>
pps stream "ed::L:";
mld::ERRONEOUS_ENTRY_DECLARATION
=>
pps stream "ed::ER:";
mld::EMPTY_GENERIC_EVALUATION_DECLARATION
=>
pps stream "ed::EM:";
esac;
fi
also
fun latex_print_package_expression stream (package_expression, depth)
=
if (depth <= 0)
pps stream "<packageexpression>";
else
case package_expression
#
mld::VARIABLE_PACKAGE ep
=>
{ pps stream "syx::V:";
break stream { spaces=>1, indent_on_wrap=>1 };
latex_print_stamppath stream ep;
};
mld::CONSTANT_PACKAGE { stamp, inverse_path, ... }
=>
{ pps stream "syx::C:"; break stream { spaces=>1, indent_on_wrap=>1 };
unparse_inverse_path stream inverse_path;
};
mld::PACKAGE { stamp, module_declaration }
=>
{ pps stream "syx::S:";
break stream { spaces=>1, indent_on_wrap=>1 };
latex_print_module_declaration stream (module_declaration, depth - 1);
};
mld::APPLY (generic_expression, package_expression)
=>
{ begin_horizontal_else_vertical_box stream;
pps stream "syx::AP:"; break stream { spaces=>1, indent_on_wrap=>1 };
begin_horizontal_else_vertical_box stream;
pps stream "fct:"; latex_print_generic_expression stream (generic_expression, depth - 1);
break stream { spaces=>1, indent_on_wrap=>0 };
pps stream "arg:"; latex_print_package_expression stream (package_expression, depth - 1);
end_box stream;
end_box stream;
};
mld::PACKAGE_LET { declaration => module_declaration, expression => package_expression }
=>
{ begin_horizontal_else_vertical_box stream;
pps stream "syx::L:"; break stream { spaces=>1, indent_on_wrap=>1 };
begin_horizontal_else_vertical_box stream;
pps stream "stipulate:"; latex_print_module_declaration stream (module_declaration, depth - 1);
break stream { spaces=>1, indent_on_wrap=>0 };
pps stream "herein:"; latex_print_package_expression stream (package_expression, depth - 1);
end_box stream;
end_box stream;
};
mld::ABSTRACT_PACKAGE (an_api, package_expression)
=>
{ begin_horizontal_else_vertical_box stream;
pps stream "syx::AB:"; break stream { spaces=>1, indent_on_wrap=>1 };
begin_horizontal_else_vertical_box stream;
pps stream "an_api: <omitted>";
break stream { spaces=>1, indent_on_wrap=>0 };
pps stream "sexp:"; latex_print_package_expression stream (package_expression, depth - 1);
end_box stream;
end_box stream;
};
mld::COERCED_PACKAGE { boundvar, raw, coercion }
=>
{ begin_horizontal_else_vertical_box stream;
pps stream "syx::CO:"; break stream { spaces=>1, indent_on_wrap=>1 };
begin_horizontal_else_vertical_box stream;
latex_print_typechecked_package_variable stream boundvar; break stream { spaces=>1, indent_on_wrap=>1 };
pps stream "src:"; latex_print_package_expression stream (raw, depth - 1);
break stream { spaces=>1, indent_on_wrap=>0 };
pps stream "tgt:"; latex_print_package_expression stream (coercion, depth - 1);
end_box stream;
end_box stream;
};
mld::FORMAL_PACKAGE (an_api)
=>
pps stream "syx::FM:";
esac;
fi
also
fun latex_print_generic_expression stream (generic_expression, depth)
=
if (depth <= 0)
pps stream "<genericexpression>";
else
case generic_expression
#
mld::VARIABLE_GENERIC ep
=>
{ pps stream "fe::V:";
latex_print_stamppath stream ep;
};
mld::CONSTANT_GENERIC { inverse_path, ... }
=>
{ pps stream "fe::C:";
unparse_inverse_path stream inverse_path;
};
mld::LAMBDA_TP { parameter, body, ... }
=>
{ begin_horizontal_else_vertical_box stream;
pps stream "fe::LP:"; break stream { spaces=>1, indent_on_wrap=>1 };
begin_horizontal_else_vertical_box stream;
pps stream "par:"; latex_print_typechecked_package_variable stream parameter;
break stream { spaces=>1, indent_on_wrap=>0 };
pps stream "bod:"; latex_print_package_expression stream (body, depth - 1);
end_box stream;
end_box stream;
};
mld::LAMBDA { parameter, body }
=>
{ begin_horizontal_else_vertical_box stream;
pps stream "fe::L:"; break stream { spaces=>1, indent_on_wrap=>1 };
begin_horizontal_else_vertical_box stream;
pps stream "par:"; latex_print_typechecked_package_variable stream parameter;
break stream { spaces=>1, indent_on_wrap=>0 };
pps stream "bod:"; latex_print_package_expression stream (body, depth - 1);
end_box stream;
end_box stream;
};
mld::LET_GENERIC (module_declaration, generic_expression)
=>
{ begin_horizontal_else_vertical_box stream;
pps stream "fe::LT:"; break stream { spaces=>1, indent_on_wrap=>1 };
begin_horizontal_else_vertical_box stream;
pps stream "stipulate:"; latex_print_module_declaration stream (module_declaration, depth - 1);
break stream { spaces=>1, indent_on_wrap=>0 };
pps stream "herein:"; latex_print_generic_expression stream (generic_expression, depth - 1);
end_box stream;
end_box stream;
};
esac;
fi
/*
also prettyprintBodyExpression stream (bodyExpression, depth) =
if depth <= 0 then pps stream "<bodyExpression>" else
case bodyExpression
of mld::FLEX an_api => pps stream "be::F:"
| mld::OPAQ (an_api, packageexpression) =>
(begin_horizontal_else_vertical_box stream;
pps stream "be::O:"; break stream { spaces=1, indent_on_wrap=1 };
prettyprintPackageexpression stream (packageexpression, depth - 1);
end_box stream)
| mld::TNSP (an_api, packageexpression) =>
(begin_horizontal_else_vertical_box stream;
pps stream "be::T:"; break stream { spaces=1, indent_on_wrap=1 };
prettyprintPackageexpression stream (packageexpression, depth - 1);
end_box stream)
*/
also
fun latex_print_closure stream (mld::GENERIC_CLOSURE { parameter_module_stamp => parameter,
body_package_expression => body,
typerstore => symbolmapstack
},
depth
)
=
{ (en_pp stream)
->
{ begin_horizontal_else_vertical_box, begin_wrap_box, end_box, pps, newline, break, ... };
begin_horizontal_else_vertical_box 0;
pps "CL:"; break { spaces=>1, indent_on_wrap=>1 };
begin_horizontal_else_vertical_box 0;
pps "parameter: ";
latex_print_typechecked_package_variable stream parameter;
newline();
pps "body: ";
latex_print_package_expression stream (body, depth - 1);
newline();
pps "dictionary: ";
latex_print_typerstore stream (symbolmapstack, syx::empty, depth - 1);
end_box ();
end_box ();
}
# Assumes no newline is needed before latex-printing:
also
fun latex_print_naming stream (name, naming: b::Symbolmapstack_Entry, symbolmapstack: syx::Symbolmapstack, depth: Int, index_entries)
=
case naming
#
b::NAMED_VARIABLE var
=>
{ pps stream /*2007-12-08CrT:"my "*/"";
latex_print_variable stream (var, symbolmapstack);
};
b::NAMED_CONSTRUCTOR con
=>
latex_print_con_naming stream (con, symbolmapstack);
b::NAMED_TYPE typ
=>
latex_print_typ_bind stream (typ, symbolmapstack);
b::NAMED_API an_api
=>
{ (en_pp stream)
->
{ begin_horizontal_else_vertical_box, begin_wrap_box, end_box, pps, break, ... };
begin_horizontal_else_vertical_box 0;
pps "api ";
unparse_symbol stream name;
pps " =";
break { spaces=>1, indent_on_wrap=>2 };
latex_print_api0 stream (an_api, symbolmapstack, depth, NULL, index_entries);
end_box ();
};
b::NAMED_GENERIC_API fs
=>
{ my { begin_horizontal_else_vertical_box, begin_wrap_box, end_box, pps, ... } = en_pp stream;
begin_horizontal_else_vertical_box 2;
pps "funsig ";
unparse_symbol stream name;
latex_print_generic_api stream (fs, symbolmapstack, depth, index_entries);
end_box ();
};
b::NAMED_PACKAGE str
=>
{ (en_pp stream)
->
{ begin_horizontal_else_vertical_box, begin_wrap_box, end_box, pps, break, ... };
begin_horizontal_else_vertical_box 0;
pps "packageX ";
unparse_symbol stream name;
pps " :";
break { spaces=>1, indent_on_wrap=>2 };
latex_print_package stream (str, symbolmapstack, depth, index_entries);
end_box ();
};
b::NAMED_GENERIC fct
=>
{ (en_pp stream)
->
{ begin_horizontal_else_vertical_box, begin_wrap_box, end_box, pps, ... };
begin_horizontal_else_vertical_box 0;
pps "generic package ";
unparse_symbol stream name;
pps " : <sig>"; # David B MacQueen -- should print the api XXX BUGGO FIXME
end_box ();
};
b::NAMED_FIXITY fixity
=>
{ pps stream (fixity::fixity_to_string fixity);
unparse_symbol stream name;
};
esac
# latex_print_dictionary: latex-print a symbol table
# in the context of the top-level symbol table.
# The symbol table must either be for a api or be absolute (i.e.
# all types and packages have been interpreted)
# Note: I made a preliminary pass over namings to remove
# invisible con_namings -- Konrad.
# and invisible packages too -- PC
also
fun latex_print_dictionary stream (symbolmapstack, topenv, depth, boundsyms, index_entries)
=
{ namings
=
case boundsyms
#
NULL => syx::to_sorted_list symbolmapstack;
THE l => fold_backward
(fn (x, bs)
=
(x, syx::get (symbolmapstack, x)) ! bs
except
syx::UNBOUND = bs
)
[]
l;
esac;
pp_env = syx::atop (symbolmapstack, topenv);
unparse_sequence stream
{ sep => newline,
style => CONSISTENT,
pr => (fn stream =
fn (name, naming)
=
latex_print_naming stream (name, naming, pp_env, depth, index_entries)
)
}
(all_latex_printable_namings namings pp_env);
};
fun latex_print_open stream (path, pkg, symbolmapstack, depth, index_entries)
=
{ my { begin_horizontal_else_vertical_box, begin_wrap_box, end_box, pps, break, newline }
=
en_pp stream;
begin_horizontal_else_vertical_box 0;
begin_horizontal_else_vertical_box 2;
pps "including ";
unparse_symbol_path stream path;
if (depth >= 1)
#
case pkg
#
mld::A_PACKAGE { an_api, typechecked_package as { typerstore, ... }, ... }
=>
case an_api
#
mld::API { api_elements => [], ... }
=>
();
mld::API { api_elements, ... }
=>
{ newline ();
begin_horizontal_else_vertical_box 0;
latex_print_elements
( syx::atop (api_to_symbolmapstack an_api, symbolmapstack),
depth,
THE typerstore,
index_entries
)
stream
api_elements;
end_box ();
};
mld::ERRONEOUS_API
=>
();
esac;
mld::ERRONEOUS_PACKAGE => ();
mld::PACKAGE_API _ => bug "latex_print_open";
esac;
fi;
end_box ();
newline ();
end_box ();
};
fun latex_print_api stream (an_api, symbolmapstack, depth, index_entries)
=
latex_print_api0 stream (an_api, symbolmapstack, depth, NULL, index_entries);
}; # package latex_print_package_language
end; # stipulate