PreviousUpNext

15.4.670  src/lib/compiler/front/typer/print/unparse-package-language.pkg

## unparse-package-language.pkg 

# Compiled by:
#     src/lib/compiler/front/typer/typer.sublib

#  modified to use Lib7 Lib pp. [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 mtt =  more_type_types;                     # more_type_types               is from   src/lib/compiler/front/typer/types/more-type-types.pkg
    package pp  =  standard_prettyprinter;              # standard_prettyprinter        is from   src/lib/prettyprint/big/src/standard-prettyprinter.pkg
    package syx =  symbolmapstack;                      # symbolmapstack                is from   src/lib/compiler/front/typer-stuff/symbolmapstack/symbolmapstack.pkg
    package sxe =  symbolmapstack_entry;                # symbolmapstack_entry          is from   src/lib/compiler/front/typer-stuff/symbolmapstack/symbolmapstack-entry.pkg
    package sy  =  symbol;                              # symbol                        is from   src/lib/compiler/front/basics/map/symbol.pkg
    package syp =  symbol_path;                         # symbol_path                   is from   src/lib/compiler/front/typer-stuff/basics/symbol-path.pkg
herein

    api Unparse_Package_Language {
        #
        unparse_api
            :
            pp::Prettyprinter 
            ->
            ( mld::Api,
              syx::Symbolmapstack,
              Int                               # Max prettyprint recursion depth
            )
            ->
            Void;


        unparse_package
            :
            pp::Prettyprinter
            ->
            ( mld::Package,
              syx::Symbolmapstack,
              Int                               # Max prettyprint recursion depth
            )
            ->
            Void;


        unparse_open
            :
            pp::Prettyprinter
            ->
            ( syp::Symbol_Path,
              mld::Package,
              syx::Symbolmapstack,
              Int                               # Max prettyprint recursion depth
            )
            ->
            Void;


        unparse_package_name
            :
            pp::Prettyprinter
            ->
            ( mld::Package,
              syx::Symbolmapstack
            )
            ->
            Void;


        unparse_generic
            :
            pp::Prettyprinter
            ->
            ( mld::Generic,
              syx::Symbolmapstack,
              Int                               # Max prettyprint recursion depth
            )
            ->
            Void;


        unparse_generic_api
            :
            pp::Prettyprinter
            ->
            ( mld::Generic_Api,
              syx::Symbolmapstack,
              Int                               # Max prettyprint recursion depth
            )
            ->
            Void;


        unparse_naming
            :
            pp::Prettyprinter 
            ->
            ( sy::Symbol,
              sxe::Symbolmapstack_Entry,
              syx::Symbolmapstack,
              Int                               # Max prettyprint recursion depth
            )
            ->
            Void;


        unparse_dictionary
            :
            pp::Prettyprinter
            ->
            ( syx::Symbolmapstack,
              syx::Symbolmapstack,
              Int,
              Null_Or( List( sy::Symbol ) )
            )
            ->
            Void;



        #  module internals 


        unparse_elements
            :
            ( (  syx::Symbolmapstack,
                 Int,
                 Null_Or( mld::Typerstore )
              )
            )
            -> pp::Prettyprinter
            -> mld::Api_Elements
            -> Void;


        unparse_typechecked_package
            :
            pp::Prettyprinter
            ->
            ( mld::Typerstore_Entry,
              syx::Symbolmapstack,
              Int
            )
            ->
            Void;


        unparse_typerstore
            :
            pp::Prettyprinter
            ->
            ( mld::Typerstore,
              syx::Symbolmapstack,
              Int
            )
            ->
            Void;

    };
end;


stipulate
    package id  =  inlining_data;                       # inlining_data                 is from   src/lib/compiler/front/typer-stuff/basics/inlining-data.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 mtt =  more_type_types;                     # more_type_types               is from   src/lib/compiler/front/typer/types/more-type-types.pkg
    package pp  =  standard_prettyprinter;              # standard_prettyprinter        is from   src/lib/prettyprint/big/src/standard-prettyprinter.pkg
    package sp  =  symbol_path;                         # symbol_path                   is from   src/lib/compiler/front/typer-stuff/basics/symbol-path.pkg
    package sxe =  symbolmapstack_entry;                # symbolmapstack_entry          is from   src/lib/compiler/front/typer-stuff/symbolmapstack/symbolmapstack-entry.pkg
    package sy  =  symbol;                              # symbol                        is from   src/lib/compiler/front/basics/map/symbol.pkg
    package syx =  symbolmapstack;                      # symbolmapstack                is from   src/lib/compiler/front/typer-stuff/symbolmapstack/symbolmapstack.pkg
    package tdt =  type_declaration_types;              # type_declaration_types        is from   src/lib/compiler/front/typer-stuff/types/type-declaration-types.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 uj  =  unparse_junk;                        # unparse_junk                  is from   src/lib/compiler/front/typer/print/unparse-junk.pkg
    package ut  =  unparse_type;                        # unparse_type                  is from   src/lib/compiler/front/typer/print/unparse-type.pkg
    package vac =  variables_and_constructors;          # variables_and_constructors    is from   src/lib/compiler/front/typer-stuff/deep-syntax/variables-and-constructors.pkg
    package vh  =  varhome;                             # varhome                       is from   src/lib/compiler/front/typer-stuff/basics/varhome.pkg
    #
    Pp = pp::Pp;
herein 


    package   unparse_package_language
    : (weak)  Unparse_Package_Language
    {
                                                        # typer_control         is from   src/lib/compiler/front/typer/basics/typer-control.pkg
#       internals =   typer_control::internals;
internals = log::internals;

        fun bug msg
            =
            error_message::impossible("unparse_package_language: " + msg);
        #
        fun by f x y
            =
            f y x;

        unparse_typoid           =  ut::unparse_typoid;
        unparse_type             =  ut::unparse_type;
        unparse_typescheme       =  ut::unparse_typescheme;
        unparse_formals          =  ut::unparse_formals;

        result_id
            =
            sy::make_package_symbol  "<result_package>";

        #
        fun pkg_to_dictionary  ( mld::API { api_elements, ... },  entities)
                =>
                {   fun bind_element ((symbol, spec), symbolmapstack)
                        =
                        case spec
                            #
                            mld::TYPE_IN_API { module_stamp, ... }
                                => 
                                {   type = tro::find_type_by_module_stamp (entities, module_stamp);
                                    #
                                    syx::bind  (symbol,  sxe::NAMED_TYPE type,  symbolmapstack);
                                };

                            mld::PACKAGE_IN_API { module_stamp, an_api, ... }
                                =>
                                {   typechecked_package
                                        =
                                        tro::find_package_by_module_stamp (entities, module_stamp);

                                    syx::bind (
                                        symbol,
                                        sxe::NAMED_PACKAGE (
                                            mld::A_PACKAGE {
                                                an_api,
                                                typechecked_package,
                                                varhome       => vh::null_varhome,
                                                inlining_data => id::NIL
                                            }
                                        ),
                                        symbolmapstack
                                    );
                                };

                            mld::VALCON_IN_API { sumtype, ... }
                                =>
                                syx::bind (symbol, sxe::NAMED_CONSTRUCTOR sumtype, symbolmapstack);

                            _   =>
                                symbolmapstack;
                    esac;


                    fold_forward  bind_element  syx::empty  api_elements;
                };

            pkg_to_dictionary _
                =>
                syx::empty;
        end;

        #
        fun api_to_symbolmapstack ( mld::API { api_elements, ... } )
                =>
                {   fun bind_element ((symbol, spec), symbolmapstack)
                        =
                        case spec
                            #                             
                            mld::TYPE_IN_API { type, ... }
                                =>
                                syx::bind (symbol, sxe::NAMED_TYPE type, symbolmapstack);

                            mld::PACKAGE_IN_API { an_api, slot, definition, module_stamp=>ev }
                                =>
                                syx::bind (
                                    symbol,
                                    sxe::NAMED_PACKAGE (
                                        mld::PACKAGE_API {
                                            an_api,
                                            stamppath   => [ev]
                                        }
                                    ),
                                    symbolmapstack
                                );

                            mld::VALCON_IN_API { sumtype, ... }
                                =>
                                syx::bind (symbol, sxe::NAMED_CONSTRUCTOR sumtype, symbolmapstack);

                            _   =>
                                symbolmapstack;
                        esac;

                    fold_forward  bind_element  syx::empty  api_elements;
                };

            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 prettyprint-ing apis.
        #
        fun is_prettyprintable_valcon_naming (tdt::VALCON { form=>vh::EXCEPTION _, ... }, _)
                =>
                TRUE;

            is_prettyprintable_valcon_naming (con, symbolmapstack)
                => 
                {   exception HIDDEN;
                    #
                    visible_valcon_type
                        =
                        {   type =  tu::sumtype_to_type  con;

                            (   tu::type_equality
                                (   lu::find_type_via_symbol_path
                                      ( symbolmapstack,
                                        sp::SYMBOL_PATH [ ip::last (tu::namepath_of_type type) ],
                                        \\ _ = raise exception HIDDEN
                                      ),
                                    type
                                )
                                except
                                    HIDDEN = FALSE
                            );
                        };

                    (   *internals        or
                        not visible_valcon_type
                    );
                };
        end;

        #
        fun all_prettyprintable_namings alist symbolmapstack
            = 
            list::filter
                \\ (name, sxe::NAMED_CONSTRUCTOR con)
                        =>
                        is_prettyprintable_valcon_naming (con, symbolmapstack);

                    b   =>
                        TRUE;
                end
                alist;

        #
        fun unparse_lty (pp:Pp) ( /* lambdaty, depth */ )
            =
            pp.lit "<lambdaty>";

        #
        fun unparse_typechecked_package_variable  (pp:Pp)   module_stamp
            = 
            pp.lit (stamppath::module_stamp_to_string module_stamp);

        #
        fun unparse_stamppath  (pp:Pp)  stamppath
            = 
            pp.lit (stamppath::stamppath_to_string stamppath);

        /*    prettyprintClosedSequence pp
              { front=(\\ pp => pp.lit "["),
               sep=(\\ pp => (pp.lit ", "; break pp { spaces=0, indent_on_wrap=0 } )),
               back=(\\ pp => pp.lit "]"),
               style=uj::WRAP,
               pr=prettyprintMacroExpansionVariable }
        */
        #
        fun unparse_type_expression  (pp:Pp)  (type_expression, depth)
            =
            if (depth <= 0) 
                pp.lit "<typeConstructorExpression>";
            else
                case type_expression
                    #
                    mld::TYPEVAR_TYPE ep
                        =>
                        {   pp.lit "te::TYPEVAR_TYPE:";
                            pp.txt' 1 -1  " ";
                            unparse_stamppath pp ep;
                        };

                    mld::CONSTANT_TYPE type
                        => 
                        {   pp.lit "te::CONSTANT_TYPE:";
                            pp.txt' 1 -1  " ";
                            unparse_type  syx::empty  pp  type;
                        };

                    mld::FORMAL_TYPE type
                        =>
                        {   pp.lit "te::FORMAL_TYPE:";
                            pp.txt' 1 -1  " ";
                            unparse_type  syx::empty  pp  type;
                        };
                esac;
            fi;
        #
        fun unparse_package_name  (pp:Pp)  (str, symbolmapstack)
            =
            {   inverse_path
                    =
                    case str
                        #
                        mld::A_PACKAGE { typechecked_package, ... }
                            =>
                            typechecked_package.inverse_path;

                        _ => bug "unparse_package_name";
                    esac;

                #
                fun get a
                    =
                    lu::find_package_via_symbol_path (
                        symbolmapstack,
                        a,
                        (\\ _ = raise exception syx::UNBOUND)
                    );

                #
                fun check str'
                    =
                    mj::eq_origin (str', str);


                (uj::find_path (inverse_path, check, get))
                    ->
                    (syms, found);
            
                pp.lit (     found   ??   sp::to_string (sp::SYMBOL_PATH syms)
                                         ::   "?" + (sp::to_string (sp::SYMBOL_PATH syms))
                           );
            };
        #
        fun unparse_variable  pp
            =
            {
                #
                fun unparse_v ( vac::PLAIN_VARIABLE { path, varhome, vartypoid_ref, inlining_data },
                                symbolmapstack: syx::Symbolmapstack
                              )
                        => 
                        {   pp.box' 0 -1 {.                                     pp.rulename "upb1";
                                #
                                pp.lit (sp::to_string path);

                                if *internals
                                     unparse_value::unparse_varhome  pp  varhome;
                                fi;

                                pp.txt " : ";

                                unparse_typoid  symbolmapstack  pp  *vartypoid_ref;
                            };
                        };

                    unparse_v (vac::OVERLOADED_VARIABLE { name, alternatives, typescheme=>tdt::TYPESCHEME { body, ... } }, symbolmapstack)
                        =>
                        {   pp.box' 0 -1 {.                                     pp.rulename "upb2";
                                #
                                uj::unparse_symbol pp (name);
                                pp.txt " : ";
                                unparse_typoid  symbolmapstack  pp  body; 

                                pp.txt " as ";

                                uj::unparse_sequence
                                  pp
                                  { separator  =>  \\ pp = pp.txt " ",
                                    print_one  =>  \\ pp = \\ { variant, ... } = unparse_v (variant, symbolmapstack),
                                    breakstyle =>  uj::ALIGN
                                  }
                                  *alternatives;

                            };
                        };

                    unparse_v (vac::ERROR_VARIABLE, _)
                        =>
                        pp.lit "<ERROR_VARIABLE>";
                end;
            
                unparse_v;
            };

        #
        fun unparse_con_naming pp
            =
            {
                #
                fun unparse_con (tdt::VALCON { name, typoid, form=>vh::EXCEPTION _, ... }, symbolmapstack)
                        =>
                        {
                            pp.wrap {.                                                                                  pp.rulename "upw1";
                                #
                                pp.txt "exception ";
                                uj::unparse_symbol  pp  name; 

                                if (mtt::is_arrow_type  typoid)
                                    #                          
#                                   pp.txt " of ";
                                    pp.txt " ";
                                    unparse_typoid  symbolmapstack  pp  (mtt::domain  typoid);
                                fi;
                            }; 
                        };

                    unparse_con (con as tdt::VALCON { name, typoid, ... }, symbolmapstack)
                        => 
                        if *internals
                            pp.wrap {.                                                                                  pp.rulename "upw2";
                                pp.txt "Constructor ";
                                uj::unparse_symbol  pp  name;
                                pp.txt " : ";
                                unparse_typoid  symbolmapstack  pp  typoid;
                            };
                        fi;
                end;
            
                unparse_con;
            };
        #
        fun unparse_package pp (pkg, symbolmapstack, depth)
            =
            {
                case pkg
                    #             
                    mld::A_PACKAGE { an_api, typechecked_package as { typerstore, ... }, ... }
                        =>
                        if *internals 
                            #
                            pp.box {.                                   pp.rulename "upb3";
                                pp.lit "A_PACKAGE";
                                uj::newline_indent pp 2;
                                pp.box' 0 -1 {.                                         pp.rulename "upb3b";
                                    pp.lit "an_api:";
                                    pp.txt' 0 2 " ";
                                    unparse_api0 pp (an_api, symbolmapstack, depth - 1, THE typerstore);
                                    pp.newline();
                                    pp.lit "typechecked_package:";
                                    pp.txt' 0 2 " ";
                                    unparse_generics_expansion pp (typechecked_package, symbolmapstack, depth - 1);
                                };
                            };
                        else
                            case an_api
                                #
                                mld::API { name => THE symbol, ... }
                                    =>
                                    (   (   if ( mj::apis_equal (
                                                    an_api,
                                                    lu::find_api_by_symbol (
                                                        symbolmapstack,
                                                        symbol,
                                                        (\\ _ =  raise exception syx::UNBOUND)
                                                    )
                                                 )
                                               )

                                                 uj::unparse_symbol pp symbol;
                                            else uj::unparse_symbol pp symbol;     pp.lit "?";
                                            fi
                                        )
                                        except
                                            syx::UNBOUND
                                            =
                                            {   uj::unparse_symbol pp symbol;
                                                pp.lit "?";
                                            }
                                    );

                                mld::API { name => NULL, ... }
                                    => 
                                    if (depth <= 1)
                                        pp.lit "<api>";
                                    else
                                        unparse_api0 pp
                                            (an_api, symbolmapstack, depth - 1, THE typerstore);
                                    fi;

                                mld::ERRONEOUS_API
                                    =>
                                    pp.lit "<ERRONEOUS_API>";
                            esac;
                        fi;


                    mld::PACKAGE_API _      =>   pp.lit   "<pkg_api>";
                    mld::ERRONEOUS_PACKAGE  =>   pp.lit   "<error pkg>";
                esac;
            }        

        also
        fun unparse_elements
                (symbolmapstack, depth, typechecked_package_env_op)
                pp
                elements
            =
            {   fun pr first (symbol, spec)
                    =
                    case spec
                        #
                        mld::PACKAGE_IN_API { an_api, module_stamp, definition, slot }
                            =>
                            {   if (not first)   pp.newline();   fi;
                                #
                                pp.box {.                                       pp.rulename "upb4";
                                    pp.lit "package ";
                                    uj::unparse_symbol pp symbol;
                                    pp.lit " :";
                                    pp.txt' 0 2 " ";

                                    pp.box {.                                   pp.rulename "upb4b";
                                        #
                                        case typechecked_package_env_op
                                            #
                                            NULL => unparse_api0
                                                        pp
                                                        (   an_api,
                                                            symbolmapstack,
                                                            depth - 1,
                                                            NULL
                                                        );

                                            THE eenv 
                                                =>
                                                {   my { typerstore, ... }
                                                        =
                                                        case (tro::find_entry_by_module_stamp (eenv, module_stamp))
                                                            #
                                                            mld::PACKAGE_ENTRY e
                                                                =>
                                                                e;

                                                            _ => bug "prettyprintElements: PACKAGE_ENTRY";
                                                        esac;

                                                    unparse_api0 pp (an_api, symbolmapstack, depth - 1, THE typerstore);
                                                };
                                        esac;

                                        if *internals
                                            #
                                            pp.newline();
                                            pp.lit "module_stamp: ";
                                            pp.lit (stamppath::module_stamp_to_string module_stamp);
                                        fi;

                                        pp.lit ";";

                                    };
                                };
                            };

                        mld::GENERIC_IN_API { a_generic_api, module_stamp, slot }
                            => 
                            {   if (not first)   pp.newline();    fi;
                                #
                                pp.box {.                                       pp.rulename "upb5";
                                    pp.lit "generic package ";
                                    uj::unparse_symbol pp symbol;
                                    pp.lit " :";
                                    pp.txt' 0 2 " ";

                                    pp.box {.                                                                   pp.rulename "upb5b";
                                        unparse_generic_api pp (a_generic_api, symbolmapstack, depth - 1);

                                        if *internals
                                            #
                                            pp.newline();
                                            pp.lit "module_stamp: ";
                                            pp.lit (stamppath::module_stamp_to_string module_stamp);
                                        fi;

                                        pp.endlit ";";
                                    };
                                };
                            };

                        mld::TYPE_IN_API { type=>spec, module_stamp, is_a_replica, scope }
                            => 
                            {   if (not first)
                                    pp.newline();
                                fi;

                                pp.box {.                                       pp.rulename "upb6";
                                    #
                                    case typechecked_package_env_op
                                        #                                  
                                        NULL =>
                                            if   is_a_replica      unparse_replicate_naming      pp (spec, symbolmapstack);
                                            else                   unparse_type_bind pp (spec, symbolmapstack);
                                            fi;

                                        THE eenv
                                            =>
                                            case (tro::find_entry_by_module_stamp (eenv, module_stamp))
                                                #
                                                mld::TYPE_ENTRY type
                                                    => 
                                                    if (is_a_replica)
                                                        unparse_replicate_naming    pp (type, symbolmapstack);
                                                    else
                                                        unparse_type_bind pp (type, symbolmapstack);
                                                    fi;

                                                mld::ERRONEOUS_ENTRY
                                                    =>
                                                    pp.lit "<ERRONEOUS_ENTRY>";

                                                _   =>
                                                    bug "prettyprintElements: TYPE_ENTRY";
                                            esac;

                                    esac;

                                    if *internals
                                         pp.newline();
                                         pp.lit "module_stamp: ";
                                         pp.lit (stamppath::module_stamp_to_string module_stamp);
                                         pp.newline();
                                         pp.lit "scope: ";
                                         pp.lit (int::to_string scope);
                                    fi;

                                    pp.endlit ";";
                                };
                            };

                        mld::VALUE_IN_API { typoid, ... }
                            =>
                            {   if (not first)   pp.newline();   fi;
                                #
                                pp.box' 0 -1 {.                                                                                 pp.rulename "upb38";
                                    pp.lit /*2007-12-08CrT:"my "*/"";
                                    uj::unparse_symbol pp symbol;
                                    pp.txt' 1 0 " ";
                                    pp.cbox {.                                                                                  pp.rulename "upcb1";
                                        pp.lit ":";
                                        pp.txt' 0 -1 " ";
                                        unparse_typoid  symbolmapstack  pp  typoid;
                                    };
                                    pp.endlit ";";
                                };
                            };

                        mld::VALCON_IN_API {

                            sumtype => valcon as tdt::VALCON {

                                            form => vh::EXCEPTION _,
                                            ...
                                        },
                            ...
                        }
                            =>
                            {   if (not first)   pp.newline();   fi;
                                #
                                unparse_con_naming pp (valcon, symbolmapstack);
                                pp.endlit ";";
                            };

                        mld::VALCON_IN_API { sumtype, ... }
                            => 
                            if *internals
                                #
                                if (not first)   pp.newline();   fi;

                                unparse_con_naming pp (sumtype, symbolmapstack);

                                pp.endlit ";";
                            fi;                                                         #  Ordinary data constructor -- don't print. 
                    esac;
            
                pp.box' 0 -1 {.                                 pp.rulename "upb7";
                    #
                    case elements
                        #
                        NIL          =>  ();

                        first ! rest =>  {   pr TRUE first;
                                             apply (pr FALSE) rest;
                                         };
                    esac;
                };
            }

        also
        fun unparse_api0 pp (an_api, symbolmapstack, depth, typechecked_package_env_op)
            = 
            {
                symbolmapstack 
                    =
                    syx::atop
                      ( case typechecked_package_env_op
                            #
                            NULL => api_to_symbolmapstack  an_api;

                            THE typerstore
                                =>
                                pkg_to_dictionary (an_api, typerstore);
                        esac,

                        symbolmapstack
                      );
                #
                fun unparse_constraints (variety, constraints:  List( mld::Share_Spec ))
                    = 
                    {   pp.box' 0 -1 {.                                 pp.rulename "upb8";
                            #
                            uj::ppvseq pp 0 ""
                                (\\ pp =
                                 \\ paths =
                                    { pp.wrap' 0 2 {.                                                                                   pp.rulename "upw3";
                                          #
                                          pp.lit "sharing ";
                                          pp.lit variety;

                                          uj::unparse_sequence pp 
                                           { separator  => \\ pp = { pp.lit " =";  pp.txt' 0 -1 " "; },
                                             print_one  => uj::unparse_symbol_path,
                                             breakstyle => uj::WRAP
                                           }
                                          paths;
                                      };
                                    }
                                )
                                constraints;

                        };
                    };

                some_print = REF FALSE;
            
                if (depth <= 0)
                    #
                    case an_api    mld::API { name => THE symbol, ... } => { pp.lit "<api ";   uj::unparse_symbol pp symbol;   pp.lit ">"; };
                                   _                                    =>   pp.lit "<api>;";
                    esac;
                else
                    case an_api
                        #
                        mld::API { stamp, name, api_elements, type_sharing, package_sharing, ... }
                            =>
                            if *internals
                                #
                                pp.box' 0 -1 {.                                 pp.rulename "upb9";
                                    #
                                    pp.lit "BEGIN_API:";
                                    uj::newline_indent pp 2;

                                    pp.box' 0 -1 {.                                     pp.rulename "upb9b";

                                        pp.lit "stamp: ";
                                        pp.lit (stamp::to_short_string stamp);
                                        pp.newline();

                                        pp.lit "name: ";

                                        case name     NULL  =>  pp.lit "ANONYMOUS";
                                                      THE p =>  {   pp.lit "NAMED ";   uj::unparse_symbol pp p;   };
                                        esac;

                                        case api_elements
                                            #
                                            NIL => ();

                                            _   => {   pp.newline();
                                                       pp.lit "elements:";
                                                       uj::newline_indent pp 2;
                                                       unparse_elements (symbolmapstack, depth, typechecked_package_env_op)  pp  api_elements;
                                                   };
                                        esac;

                                        case package_sharing
                                            #
                                            NIL => ();

                                            _   => {   pp.newline();
                                                       pp.lit "package_sharing:";
                                                       uj::newline_indent pp 2;
                                                       unparse_constraints("", package_sharing);
                                                   };
                                        esac;

                                        case type_sharing
                                            #
                                            NIL => ();

                                            _   => {   pp.newline();
                                                       pp.lit "typesharing:";
                                                       uj::newline_indent pp 2;
                                                       unparse_constraints(/*2007-12-07CrT"type "*/"", type_sharing);
                                                   };
                                        esac;

                                        pp.endlit ";";
                                    };
                                };

                            else                        # not *internals 

                                pp.box' 0 -1 {.                                 pp.rulename "upb10";
                                    #
                                    pp.lit "api";

                                    pp.box' 0 -1 {.                                     pp.rulename "upb10b";
                                        #
                                        pp.newline();           # 2008-01-03 CrT: Was:  break { spaces=>1, indent_on_wrap=>2 };
                                        pp.lit "    ";          # 2008-01-03 CrT: A gross hack to line things up properly. XXX BUGGO FIXME.

                                        case api_elements
                                            #
                                            NIL => ();

                                            _   => {   unparse_elements (symbolmapstack, depth, typechecked_package_env_op)  pp  api_elements;
                                                       some_print := TRUE;
                                                   };
                                        esac;

                                        case package_sharing
                                            #
                                            NIL => ();

                                            _   => {   if *some_print      pp.newline();  fi;
                                                       unparse_constraints("", package_sharing);
                                                       some_print := TRUE;
                                                   };
                                        esac;

                                        case type_sharing
                                            #
                                            NIL => ();

                                            _   => {   if   *some_print      pp.newline();  fi;
                                                       unparse_constraints(/*2007-12-07CrT"type "*/"", type_sharing);
                                                       some_print := TRUE;
                                                   };
                                        esac;

                                    };

                                    if *some_print
                                         pp.newline();
#                                        pp.txt " ";
                                    fi;

                                    pp.lit "end;";
                                };
                            fi;

                        mld::ERRONEOUS_API
                            =>
                            pp.lit "<error api>;";
                    esac;
                fi;
            }

        also
        fun unparse_generic_api pp (an_api, symbolmapstack, depth)
            =
            {
                #
                fun true_body_sig (orig as mld::API { api_elements => [(symbol, mld::PACKAGE_IN_API { an_api, ... } )],
                                                       ... 
                                                     }
                                )
                        =>
                        if (sy::eq (symbol, result_id))   an_api; 
                        else                                  orig;
                        fi;

                    true_body_sig orig
                        =>
                        orig;
                end;

            
                if (depth <= 0)
                    #
                    pp.lit "<fctsig>";
                else
                    case an_api
                        #
                        mld::GENERIC_API { parameter_api, parameter_variable, parameter_symbol, body_api, ... }
                            => 
                            if *internals
                                #
                                pp.box' 0 -1 {.                                 pp.rulename "upb11";
                                    #
                                    pp.lit "GENERIC_API:";
                                    uj::newline_indent pp 2;

                                    pp.box' 0 -1 {.                                     pp.rulename "upb11b";
                                        #
                                        pp.lit "psig: ";
                                        unparse_api0 pp (parameter_api, symbolmapstack, depth - 1, NULL);
                                        pp.newline();
                                        pp.lit "pvar: ";
                                        pp.lit (stamppath::module_stamp_to_string parameter_variable);
                                        pp.newline();
                                        pp.lit "psym: ";
                                        case parameter_symbol
                                            #
                                            NULL       =>  pp.lit "<anonymous>";
                                            THE symbol =>  uj::unparse_symbol pp symbol;
                                        esac;
                                        pp.newline();
                                        pp.lit "bsig: ";
                                        unparse_api0 pp (body_api, symbolmapstack, depth - 1, NULL);
                                    };
                                };
                            else
                                pp.box' 0 -1 {.                                 pp.rulename "upb12";
                                    #
                                    pp.lit "(";

                                    case parameter_symbol
                                        #
                                        THE x =>  pp.lit (sy::name x);
                                        _     =>  pp.lit "<parameter>";
                                    esac;

                                    pp.txt ": ";
                                    unparse_api0 pp (parameter_api, symbolmapstack, depth - 1, NULL);
                                    pp.txt ") : ";
                                    unparse_api0 pp (true_body_sig body_api, symbolmapstack, depth - 1, NULL);
                                };
                            fi;

                        mld::ERRONEOUS_GENERIC_API
                            =>
                            pp.lit "<error fsig>";
                    esac;
                fi;
            }


        also
        fun unparse_generics_expansion pp (e, symbolmapstack, depth)
            =
            {   e ->  { stamp, typerstore, property_list, inverse_path, stub   };
                #           
                if (depth <= 1) 
                    #               
                    pp.lit "<package typechecked_package>";
                else
                    pp.box' 0 -1 {.                                     pp.rulename "upb13";
                        #
                        pp.lit "Typechecked_Package:";
                        uj::newline_indent pp 2;

                        pp.box' 0 -1 {.                                 pp.rulename "upb13b";
                            #
                            pp.lit "inverse_path: ";
                            pp.lit (ip::to_string inverse_path);
                            pp.newline();
                            pp.lit "stamp: ";
                            pp.lit (stamp::to_short_string stamp);
                            pp.newline();
                            pp.lit "typerstore:";
                            uj::newline_indent pp 2;
                            unparse_typerstore pp (typerstore, symbolmapstack, depth - 1);
                            pp.newline();
                            pp.lit "lambdaty:";
                            uj::newline_indent pp 2;
                            unparse_lty pp ( /* ModulePropLists::packageMacroExpansionLambdatype e, depth - 1 */);
                        };
                    };
                fi;
            }

        also
        fun unparse_typechecked_generic pp (e, symbolmapstack, depth)
            =
            {   e ->    { stamp, generic_closure, property_list, typepath, inverse_path, stub };
                #
                if (depth <= 1) 
                    #               
                    pp.lit "<generic typechecked_package>";
                else
                    pp.box' 0 -1 {.                                     pp.rulename "upb14";
                        #
                        pp.lit "Typechecked_Generic:";
                        uj::newline_indent pp 2;

                        pp.box' 0 -1 {.                                 pp.rulename "upb14b";
                            #
                            pp.lit "inverse_path: ";
                            pp.lit (ip::to_string inverse_path);
                            pp.newline();
                            pp.lit "stamp: ";
                            pp.lit (stamp::to_short_string stamp);
                            pp.newline();
                            pp.txt' 0 2 "generic_closure: ";
                            unparse_closure pp (generic_closure, depth - 1);
                            pp.newline();
                            pp.txt' 0 2 "lambdaty: ";
                            unparse_lty pp ( /* ModulePropLists::genericMacroExpansionLty e, depth - 1 */ );
                            pp.txt' 0 2 "typepath: ";
                            pp.lit "--printing of Typepath not implemented yet--";
                        };
                    };
                fi;
            }

        also
        fun unparse_generic pp
            =
            unparse_f
            where
                fun unparse_f (mld::GENERIC { a_generic_api, typechecked_generic, ... }, symbolmapstack, depth)
                        =>
                        if (depth <= 1) 
                            #
                            pp.lit "<generic package>";
                        else
                            pp.box' 0 -1 {.                                     pp.rulename "upb15";
                                pp.lit "a_generic_api:";
                                uj::newline_indent pp 2;
                                unparse_generic_api pp (a_generic_api, symbolmapstack, depth - 1);
                                pp.newline();
                                pp.lit "typechecked_generic:";
                                uj::newline_indent pp 2;
                                unparse_typechecked_generic pp (typechecked_generic, symbolmapstack, depth - 1);
                            };
                        fi;

                    unparse_f (mld::ERRONEOUS_GENERIC, _, _)
                        =>
                        pp.lit "<error generic package>";
                end;
            end

        also
        fun unparse_type_bind pp (type, symbolmapstack)
            =
            {
                #
                fun visible_dcons (type, dcons)
                    =
                    find  dcons
                    where
                        fun check_con (vac::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,
                                                     \\ _ = raise exception syx::UNBOUND));
                              
                                    # Test whether the sumtypes of actual and
                                    # found constructor agree:

                                    case (tu::sumtype_to_type found)
                                        #
                                        type1 as tdt::SUM_TYPE _
                                            =>
                                            # The expected form in packages 
                                            if (tu::types_are_equal (type, type1))
                                                 found ! find rest;
                                            else find rest;
                                            fi;

                                        tdt::TYPE_BY_STAMPPATH _
                                            => 
                                            # The expected form in apis;
                                            # we won't check visibility [David B MacQueen]
                                            found ! find rest;

                                        d_found
                                            =>
                                            #  something's weird 
                                            {   old_internals = *internals;

                                                internals := TRUE;
                                                pp.box' 0 -1 {.                                 pp.rulename "upb16";
                                                    pp.lit "unparse_type_bind failure: ";
                                                    pp.newline();
                                                    unparse_type  symbolmapstack  pp  type;
                                                    pp.newline();
                                                    unparse_type  symbolmapstack  pp  d_found;
                                                    pp.newline();
                                                };
                                                internals := old_internals;
                                                find rest;
                                            };
                                    esac;
                                }
                                except
                                    syx::UNBOUND =  find rest;

                            find []
                                =>
                                [];
                        end;
                    end;                        # fun visible_dcons

                #
                fun body_of_typescheme_else_nop (tdt::TYPESCHEME_TYPOID { typescheme => tdt::TYPESCHEME { body, ... }, ... } )
                        =>
                        body;

                    body_of_typescheme_else_nop type
                        =>
                        type;
                end;

                #
                fun unparse_valcon (tdt::VALCON { name, typoid, ... } )
                    =
                    {   uj::unparse_symbol  pp  name; 
                        #
                        type =  body_of_typescheme_else_nop  typoid;

                        if (mtt::is_arrow_type  typoid)
                            #                       
#                           pps " of ";
                            pp.lit " ";
                            unparse_typoid  symbolmapstack  pp  (mtt::domain  typoid);
                        fi;
                    };
            
                if *internals 
                    #
                    pp.box' 0 -1 {.                                     pp.rulename "upb17";
                        pp.lit /*2007-12-07CrT"type "*/"";
                        unparse_type  symbolmapstack  pp  type;
                    };
                else
                    case type
                        #
                        tdt::SUM_TYPE { namepath, arity, is_eqtype, kind, ... }
                            =>
                            case (*is_eqtype, kind)
                                #
                                (_, tdt::SUMTYPE { index, family => { members, ... }, ... } )
                                    =>
                                    # Ordinary enum 
                                    #
                                    {   (vector::get (members, index))
                                            ->
                                            { valcons, ... };

                                        visdcons   =  visible_dcons (type, valcons);

                                        incomplete =  length visdcons < length valcons;

                                        pp.box' 0 -1 {.                                 pp.rulename "upb19";
#                                           pp.lit "enum";
                                            uj::unparse_symbol pp (ip::last namepath);
                                            unparse_formals pp arity;
                                            pp.lit " ";

                                            case visdcons
                                                #
                                                NIL =>  pp.lit " = ...";

                                                first ! rest
                                                    =>
                                                    {   pp.txt' 0 2 " ";
                                                        #
                                                        pp.box' 0 -1 {.                                 pp.rulename "upb20";
                                                            #
                                                            pp.lit "= ";
                                                            unparse_valcon first;

                                                            apply
                                                                (\\ d = {  pp.txt " ";   pp.lit "| ";   unparse_valcon d;  })
                                                                rest;

                                                            if incomplete
                                                                pp.txt " ";
                                                                pp.lit "... ";
                                                            fi;
                                                        };
                                                    };
                                            esac;
                                        };
                                    };

                                _   =>
                                    {   pp.box' 0 -1 {.                                 pp.rulename "upb21";
                                            #
                                            if (eq_types::is_equality_type type)
                                                 pp.lit "eqtype"; 
                                            else pp.lit /*2007-12-07CrT"type "*/"";
                                            fi;

                                            uj::unparse_symbol pp (ip::last namepath);
                                            unparse_formals pp arity;
                                            pp.lit " ";
                                        };
                                    };
                            esac;

                        tdt::NAMED_TYPE { namepath, typescheme => tdt::TYPESCHEME { arity, body }, ... }
                            =>
                            {   pp.wrap' 0 2 {.                                                                                 pp.rulename "upw4";
                                    pp.lit /*2007-12-07CrT"type "*/""; 
                                    uj::unparse_symbol pp (ip::last namepath); 
                                    unparse_formals pp arity;
                                    pp.lit " ="; 
                                    pp.txt " ";
                                    unparse_typoid  symbolmapstack  pp  body;
                                };
                            };

                        type => {   pp.lit "strange type: ";
                                    unparse_type  symbolmapstack  pp  type;
                                };
                    esac;
                fi;
            }                          # fun  unparse_type_bind pp

        also
        fun unparse_replicate_naming
                pp
                (   tdt::NAMED_TYPE {
                        typescheme => tdt::TYPESCHEME {
                                           body => tdt::TYPCON_TYPOID (right_type, _),
                                           ...
                                       },
                        namepath,
                        ...
                    },
                    symbolmapstack
                )
                =>
                {
                    pp.wrap' 0 2 {.                                                                                     pp.rulename "upbw5";
#                       pp.lit "enum";                                      pp.txt " ";
                        uj::unparse_symbol pp (ip::last namepath);
                        pp.lit " =";                                        pp.txt " ";
#                       pp.lit "enum";                                      pp.txt " ";
                        unparse_type  symbolmapstack  pp  right_type;
                    };
                };

            unparse_replicate_naming _ _
                =>
                error_message::impossible "prettyprintReplicateNaming";
        end 

        also
        fun unparse_typechecked_package pp (typechecked_package, symbolmapstack, depth)
            =
            case typechecked_package
                #
                mld::TYPE_ENTRY type
                    =>
                    unparse_type  symbolmapstack  pp  type;

                mld::PACKAGE_ENTRY typechecked_package
                    =>
                    unparse_generics_expansion pp (typechecked_package, symbolmapstack, depth - 1);

                mld::GENERIC_ENTRY typechecked_generic
                    =>
                    unparse_typechecked_generic   pp (typechecked_generic, symbolmapstack, depth - 1);

                mld::ERRONEOUS_ENTRY
                    =>
                    pp.lit "ERRONEOUS_ENTRY";
            esac


        also
        fun unparse_typerstore pp (typerstore, symbolmapstack, depth)
            =
            if (depth <= 1) 
                #
                pp.lit "<typerstore>";
            else
                (uj::ppvseq
                    pp 2 ""
                    (\\ pp =
                     \\ (module_stamp, typechecked_package)
                        =
                        pp.box' 0 2 {.                                  pp.rulename "upb22";
                            pp.lit (stamppath::module_stamp_to_string module_stamp);
                            pp.lit ":";
                            uj::newline_indent pp 2;
                            unparse_typechecked_package pp (typechecked_package, symbolmapstack, depth - 1);
                            pp.newline();
                        }
                    )
                    (tro::to_list typerstore));
            fi

        also
        fun unparse_module_declaration pp (module_declaration, depth)
            =
            if (depth <= 0)
                #
                pp.lit "<module_declaration>";
            else
                case module_declaration
                    #
                    mld::TYPE_DECLARATION ( module_stamp, type_expression )
                        =>
                        {   pp.lit "ed::TYPE_DECLARATIOn: ";
                            unparse_typechecked_package_variable pp module_stamp;
                            pp.txt' 1 0 " ";
                            unparse_type_expression pp (type_expression, depth - 1);
                        };

                    mld::PACKAGE_DECLARATION (module_stamp, package_expression, symbol)
                        =>
                        {   pp.lit "ed::PACKAGE_DECLARATION: ";
                            unparse_typechecked_package_variable pp module_stamp;
                            pp.txt' 1 0 " ";
                            unparse_package_expression pp (package_expression, depth - 1);
                            pp.txt' 1 0 " ";
                            uj::unparse_symbol pp symbol;
                        };

                    mld::GENERIC_DECLARATION (module_stamp, generic_expression)
                        =>
                        {   pp.lit "ed::GENERIC_DECLARATION: ";
                            unparse_typechecked_package_variable pp module_stamp;
                            pp.txt' 1 0 " ";
                            unparse_generic_expression pp (generic_expression, depth - 1);
                        };

                    mld::SEQUENTIAL_DECLARATIONS typechecked_package_decs
                        =>
                        uj::ppvseq pp 0 ""
                            (\\ pp =
                             \\ module_declaration =
                                unparse_module_declaration pp (module_declaration, depth)
                            )
                            typechecked_package_decs;

                    mld::LOCAL_DECLARATION (typechecked_package_dec_l, typechecked_package_dec_b)
                        =>
                        pp.lit "ed::LOCAL_DECLARATION:";

                    mld::ERRONEOUS_ENTRY_DECLARATION
                        =>
                        pp.lit "ed::ERRONEOUS_ENTRY_DECLARATION:";

                    mld::EMPTY_GENERIC_EVALUATION_DECLARATION
                        =>
                        pp.lit "ed::EMPTY_GENERIC_EVALUATION_DECLARATION:";
                 esac;
            fi

        also
        fun unparse_package_expression pp (package_expression, depth)
            =
            if (depth <= 0)
                #                
                pp.lit "<packageexpression>";
            else
                case package_expression
                    #
                    mld::VARIABLE_PACKAGE ep
                        =>
                        {   pp.lit "syx::VARIABLE_PACKAGE:";
                            pp.txt' 1 0 " ";
                            unparse_stamppath pp ep;
                        };

                    mld::CONSTANT_PACKAGE { stamp, inverse_path, ... }
                        =>
                        {   pp.lit "syx::CONSTANT_PACKAGE:";
                            pp.txt' 1 0 " ";
                            uj::unparse_inverse_path pp inverse_path;
                        };

                    mld::PACKAGE { stamp, module_declaration }
                        =>
                        {   pp.lit "syx::PACKAGE:";
                            pp.txt' 1 0 " ";
                            unparse_module_declaration pp (module_declaration, depth - 1);
                        };

                    mld::APPLY (generic_expression, package_expression)
                        =>
                        {   pp.box {.                                   pp.rulename "upb23";
                                pp.lit "syx::AP:";
                                pp.txt' 1 0 " ";
                                pp.box {.                                       pp.rulename "upb23b";
                                    pp.lit "fct:";      unparse_generic_expression pp (generic_expression, depth - 1);
                                    pp.txt " ";
                                    pp.lit "arg:";      unparse_package_expression pp (package_expression, depth - 1);
                                };
                            };
                        };

                    mld::PACKAGE_LET { declaration => module_declaration, expression => package_expression }
                        => 
                        {   pp.box {.                                   pp.rulename "upb24";
                                pp.lit "syx::PACKAGE_LET:";
                                pp.txt' 1 0 " ";
                                pp.box {.                                       pp.rulename "upb24b";
                                    pp.lit "stipulate:";        unparse_module_declaration pp (module_declaration, depth - 1);
                                    pp.txt " ";
                                    pp.lit "herein:";           unparse_package_expression pp (package_expression, depth - 1);
                                };
                            };
                        };

                    mld::ABSTRACT_PACKAGE (an_api, package_expression)
                        => 
                        {   pp.box {.                                   pp.rulename "upb25";
                                pp.lit "syx::ABSTRACT_PACKAGE:";
                                pp.txt' 1 0 " ";
                                pp.box {.                                       pp.rulename "upb25b";
                                    pp.lit "an_api: <omitted>"; 
                                    pp.txt " ";
                                    pp.lit "sexp:"; unparse_package_expression pp (package_expression, depth - 1);
                                };
                            };
                        };

                    mld::COERCED_PACKAGE { boundvar, raw, coercion }
                        => 
                        {   pp.box {.                                                                                   pp.rulename "upb26";
                                pp.lit "syx::COERCED_PACKAGE:";
                                pp.txt' 1 -1 " ";

                                pp.box {.                                                                                       pp.rulename "upb26b";
                                    unparse_typechecked_package_variable pp boundvar;
                                    pp.txt' 1 0  " ";
                                    pp.lit "src:"; unparse_package_expression pp (raw, depth - 1);
                                    pp.txt " ";
                                    pp.lit "tgt:"; unparse_package_expression pp (coercion, depth - 1);
                                };
                            };
                        };

                    mld::FORMAL_PACKAGE (an_api)
                        =>
                        pp.lit "syx::FORMAL_PACKAGE:";
                esac;
            fi

        also
        fun unparse_generic_expression pp (generic_expression, depth)
            =
            if (depth <= 0)
                #
                pp.lit "<genericexpression>";
            else
                case generic_expression
                    #
                    mld::VARIABLE_GENERIC ep
                        =>
                        {   pp.lit "fe::VARIABLE_GENERIC:";
                            unparse_stamppath pp ep;
                        };

                    mld::CONSTANT_GENERIC { inverse_path, ... }
                        =>
                        {   pp.lit "fe::CONSTANT_GENERIC:";
                            uj::unparse_inverse_path pp inverse_path;
                        };

                    mld::LAMBDA_TP { parameter, body, ... }
                        =>
                        {   pp.box {.                                                                                   pp.rulename "upb27";
                                pp.lit "fe::LAMBDA_TP:";
                                pp.txt' 1 0  " ";

                                pp.box {.                                                                                       pp.rulename "upb27b";
                                    pp.lit "parameter:";        unparse_typechecked_package_variable pp parameter;
                                    pp.txt " ";
                                    pp.lit "body:";             unparse_package_expression pp (body, depth - 1);
                                };
                            };
                        };    

                    mld::LAMBDA { parameter, body }
                        =>
                        {   pp.box {.                                                                                   pp.rulename "upb28";
                                pp.lit "fe::LAMBDA:";
                                pp.txt' 1 0  " ";

                                pp.box {.                                                                                       pp.rulename "upb28b";
                                    pp.lit "parameter:";        unparse_typechecked_package_variable pp parameter;
                                    pp.txt " ";
                                    pp.lit "body:";             unparse_package_expression pp (body, depth - 1);
                                };
                            };
                        };    

                    mld::LET_GENERIC (module_declaration, generic_expression)
                        => 
                        {   pp.box {.                                                                                   pp.rulename "upb29";
                                pp.lit "fe::LET_GENERIC:";
                                pp.txt' 1 0  " ";

                                pp.box {.                                                                                       pp.rulename "upb29b";
                                    pp.lit "stipulate:";        unparse_module_declaration pp (module_declaration, depth - 1);
                                    pp.txt " ";
                                    pp.lit "herein:";           unparse_generic_expression pp (generic_expression, depth - 1);
                                };
                            };
                        };
                esac;
            fi    

        /*
        also prettyprintBodyExpression pp (bodyExpression, depth) =
            if depth <= 0 then pp.lit "<bodyExpression>" else
            case bodyExpression
              of mld::FLEX an_api => pp.lit "be::F:"
               | mld::OPAQ (an_api, packageexpression) =>
                   (begin_align_box pp;
                     pp.lit "be::O:"; break pp { spaces=1, indent_on_wrap=1 };
                     prettyprintPackageexpression pp (packageexpression, depth - 1);
                    end_box pp)
               | mld::TNSP (an_api, packageexpression) =>
                   (begin_align_box pp;
                     pp.lit "be::T:"; break pp { spaces=1, indent_on_wrap=1 };
                     prettyprintPackageexpression pp (packageexpression, depth - 1);
                    end_box pp)

        */

        also
        fun unparse_closure pp (mld::GENERIC_CLOSURE {   parameter_module_stamp    => parameter,
                                                         body_package_expression => body,
                                                         typerstore       => symbolmapstack
                                                     },
                                                     depth
                                      )
            =
            pp.box' 0 -1 {.                                                                                     pp.rulename "upb30";
                #
                pp.lit "GENERIC_CLOSURE:";
                pp.txt' 1 0  " ";

                pp.box' 0 -1 {.                                                                                 pp.rulename "upb30b";
                    pp.lit "parameter: ";
                    unparse_typechecked_package_variable pp parameter;
                    pp.newline();
                    pp.lit "body: ";                    unparse_package_expression pp (body, depth - 1);
                    pp.newline();
                    pp.lit "dictionary: ";                      unparse_typerstore pp (symbolmapstack, syx::empty, depth - 1);
                };
            }

        #  Assumes no newline is needed before prettyprinting: 
        also
        fun unparse_naming pp (name, naming: sxe::Symbolmapstack_Entry, symbolmapstack: syx::Symbolmapstack, depth: Int)
            =
            case naming
                #             
                sxe::NAMED_VARIABLE var
                    =>
                    {    pp.lit /*2007-12-08CrT:"my "*/"";
                         unparse_variable pp (var, symbolmapstack);
                    };

                sxe::NAMED_CONSTRUCTOR con
                    =>
                    unparse_con_naming pp (con, symbolmapstack);

                sxe::NAMED_TYPE type
                    =>
                    unparse_type_bind pp (type, symbolmapstack);

                sxe::NAMED_API an_api
                    =>
                    pp.box' 0 -1 {.                                                                                     pp.rulename "upb31";
                        #
                        pp.lit "api ";
                        uj::unparse_symbol pp name;
                        pp.lit " =";
                        pp.txt' 2 -1 " ";
                        unparse_api0 pp (an_api, symbolmapstack, depth, NULL);
                    };

                sxe::NAMED_GENERIC_API fs
                    =>
                    pp.box' 0 2 {.                                                                                      pp.rulename "upb32";
                        pp.lit "funsig ";
                        uj::unparse_symbol pp name; 
                        unparse_generic_api pp (fs, symbolmapstack, depth);
                    };

                sxe::NAMED_PACKAGE str
                    =>
                    pp.box' 0 -1 {.                                                                                     pp.rulename "upb33";
                        pp.lit "packageX ";
                        uj::unparse_symbol pp name;
                        pp.lit " :";
                        pp.txt' 2 -1  " ";
                        unparse_package pp (str, symbolmapstack, depth);
                    };

                sxe::NAMED_GENERIC fct
                    =>
                    pp.box' 0 -1 {.                                                                                     pp.rulename "upb34";
                        pp.lit "generic package ";
                        uj::unparse_symbol pp name;
                        pp.lit " : <sig>";                              #  David B MacQueen -- should print the api  XXX SUCKO FIXME
                    };

                sxe::NAMED_FIXITY fixity
                    =>
                    {   pp.lit (fixity::fixity_to_string fixity);
                        uj::unparse_symbol pp name;
                    };
            esac

        # prettyprintDict: prettyprint 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 unparse_dictionary pp (symbolmapstack, topenv, depth, boundsyms)
            =
            {   namings =   case boundsyms
                                #
                                NULL  =>  syx::to_sorted_list  symbolmapstack;

                                THE l =>  fold_backward
                                              (\\ (x, bs)
                                                  =
                                                  (x, syx::get (symbolmapstack, x)) ! bs
                                                  except
                                                      syx::UNBOUND = bs
                                              )
                                              []
                                              l;
                            esac;

                pp_env =  syx::atop (symbolmapstack, topenv);

                uj::unparse_sequence pp
                  { separator  =>  \\ pp = pp.newline(),
                    breakstyle =>  uj::ALIGN,
                    print_one  =>  (\\ pp =
                                        \\ (name, naming)
                                            =
                                            unparse_naming pp (name, naming, pp_env, depth)
                                       )
                  }
                  (all_prettyprintable_namings namings pp_env);
            };

        fun unparse_open pp (path, pkg, symbolmapstack, depth)
            =
            pp.box' 0 -1 {.                                                                                     pp.rulename "upb35";
                #
                pp.lit "including ";
                uj::unparse_symbol_path pp 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, ... }
                                    => 
                                    {   pp.newline();
                                        pp.box' 0 -1 {.                                                 pp.rulename "upb37";

                                            unparse_elements
                                                ( syx::atop (api_to_symbolmapstack an_api, symbolmapstack),
                                                  depth,
                                                  THE typerstore
                                                )
                                                pp
                                                api_elements;

                                        };
                                    };

                                mld::ERRONEOUS_API
                                    =>
                                    ();
                            esac;

                        mld::ERRONEOUS_PACKAGE => ();
                        mld::PACKAGE_API _ => bug "unparse_open";
                    esac;
                fi;

                pp.newline();
            };


        fun unparse_api  pp (an_api, symbolmapstack, depth)
            = 
            unparse_api0 pp (an_api, symbolmapstack, depth, NULL);

    };                                                                          # package unparse_package_language 
end;                                                                            # stipulate








Comments and suggestions to: bugs@mythryl.org

PreviousUpNext