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 pp  =  prettyprint;                         # prettyprint                   is from   src/lib/prettyprint/big/src/prettyprint.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
herein

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


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


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


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


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


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


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


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



        #  module internals 


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


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


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

    };
end;


stipulate
    package bt  =  type_types;                          # type_types                    is from   src/lib/compiler/front/typer/types/type-types.pkg
    package tro =  typerstore;                          # typerstore                    is from   src/lib/compiler/front/typer-stuff/modules/typerstore.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 mld =  module_level_declarations;           # module_level_declarations     is from   src/lib/compiler/front/typer-stuff/modules/module-level-declarations.pkg
    package mj  =  module_junk;                         # module_junk                   is from   src/lib/compiler/front/typer-stuff/modules/module-junk.pkg
    package pp  =  prettyprint;                         # prettyprint                   is from   src/lib/prettyprint/big/src/prettyprint.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 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 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 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
#   package id  =  inlining_data 
    #
    include prettyprint;
    include unparse_junk;
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;

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

        pps = pp::string;
        unparse_type              =  unparse_type::unparse_type;
        unparse_typ  =  unparse_type::unparse_typ;
        unparse_type_scheme       =  unparse_type::unparse_type_scheme;
        unparse_formals           =  unparse_type::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::TYP_IN_API { module_stamp, ... }
                                => 
                                { typ = tro::find_typ_by_module_stamp (entities, module_stamp);

                                    syx::bind (symbol, sxe::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,
                                        sxe::NAMED_PACKAGE (
                                            mld::A_PACKAGE {
                                                an_api,
                                                typechecked_package,
                                                varhome       => vh::null_varhome,
                                                inlining_data   => inlining_data::NULL
                                            }
                                        ),
                                        symbolmapstack
                                    );
                                };

                            mld::VALCON_IN_API { datatype, ... }
                                =>
                                syx::bind (symbol, sxe::NAMED_CONSTRUCTOR datatype, 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::TYP_IN_API { typ, ... }
                                =>
                                syx::bind (symbol, sxe::NAMED_TYPE typ, 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 { datatype, ... }
                                =>
                                syx::bind (symbol, sxe::NAMED_CONSTRUCTOR datatype, 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 (ty::VALCON { form=>vh::EXCEPTION _, ... }, _)
                =>
                TRUE;

            is_prettyprintable_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_prettyprintable_namings alist symbolmapstack
            = 
            list::filter
                fn (name, sxe::NAMED_CONSTRUCTOR con)
                        =>
                        is_prettyprintable_valcon_naming (con, symbolmapstack);

                    b   =>
                        TRUE;
                end
                alist;

        #
        fun unparse_lty stream ( /* lambdaty, depth */ )
            =
            pps stream "<lambdaty>";

        #
        fun unparse_typechecked_package_variable stream module_stamp
            = 
            pps stream (stamppath::module_stamp_to_string module_stamp);

        #
        fun unparse_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 unparse_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 };
                            unparse_stamppath stream ep;
                        };

                    mld::CONSTANT_TYP typ
                        => 
                        {   pps stream "te::C:"; break stream { spaces=>1, indent_on_wrap=>1 };
                            unparse_typ  syx::empty  stream  typ;
                        };

                    mld::FORMAL_TYP typ
                        =>
                        {   pps stream "te::FM:"; break stream { spaces=>1, indent_on_wrap=>1 };
                            unparse_typ  syx::empty  stream  typ;
                        };
                esac;
            fi;
        #
        fun unparse_package_name stream (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,
                        (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 unparse_variable  stream
            =
            {   (en_pp stream)
                    ->
                    { begin_horizontal_else_vertical_box, begin_wrap_box, end_box, pps, ... };

                #
                fun unparse_v ( vac::ORDINARY_VARIABLE { path, varhome, var_type, inlining_data },
                                   symbolmapstack: syx::Symbolmapstack
                                 )
                        => 
                        {   begin_horizontal_else_vertical_box 0;
                            pps (sp::to_string path);

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

                            pps " : ";   unparse_type  symbolmapstack  stream  *var_type;
                            end_box ();
                        };

                    unparse_v (vac::OVERLOADED_IDENTIFIER { name, alternatives, type_scheme=>ty::TYPE_SCHEME { body, ... } }, symbolmapstack)
                        =>
                        {   begin_horizontal_else_vertical_box 0;
                            unparse_symbol stream (name); pps " : ";   unparse_type  symbolmapstack  stream  body; 
                            pps " as ";

                            unparse_sequence
                              stream
                              { sep   => by pp::break { spaces=>1, indent_on_wrap=>0 },
                                pr    => (fn stream = fn { variant, ... } = unparse_v (variant, symbolmapstack)),
                                style => CONSISTENT
                              }
                              *alternatives;

                            end_box ();
                        };

                    unparse_v (vac::ERRORVAR, _)
                        =>
                        pps "<ERRORVAR>";
                end;
            
                unparse_v;
            };

        #
        fun unparse_con_naming stream
            =
            {   (en_pp  stream)
                    ->
                    { begin_horizontal_else_vertical_box, begin_wrap_box, end_box, pps, ... };
                    
                #
                fun unparse_con (ty::VALCON { name, type, form=>vh::EXCEPTION _, ... }, symbolmapstack)
                        =>
                        {  begin_wrap_box 4;
                           pps "exception ";
                           unparse_symbol  stream  name; 

                           if   (type_types::is_arrow_type  type)
                               
#                               pps " of ";
                                pps " ";
                                unparse_type  symbolmapstack  stream  (type_types::domain  type);
                           fi;

                           end_box ();
                        };

                    unparse_con (con as ty::VALCON { name, type, ... }, symbolmapstack)
                        => 
                        if *internals
                             begin_wrap_box 4;
                             pps "Constructor ";
                             unparse_symbol  stream  name;
                             pps " : ";
                             unparse_type  symbolmapstack  stream  type;
                             end_box ();
                        fi;
                end;
            
                unparse_con;
            };
        #
        fun unparse_package stream (pkg, symbolmapstack, depth)
            =
            {   (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 };
                            unparse_api0 stream (an_api, symbolmapstack, depth - 1, THE typerstore);
                            newline();
                            pps "typechecked_package:";
                            break { spaces=>1, indent_on_wrap=>2 };
                            unparse_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 "<api>";
                                    else
                                        unparse_api0 stream
                                            (an_api, symbolmapstack, depth - 1, THE typerstore);
                                    fi;

                                mld::ERRONEOUS_API
                                    =>
                                    pps "<error sig>";
                            esac;
                        fi;


                    mld::PACKAGE_API _      =>   pps   "<pkg_api>";
                    mld::ERRONEOUS_PACKAGE  =>   pps   "<error pkg>";
                esac;
            }        

        also
        fun unparse_elements
                (symbolmapstack, depth, typechecked_package_env_op)
                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
                                         =>
                                         unparse_api0
                                             stream
                                             (   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 stream (an_api, symbolmapstack, depth - 1, THE typerstore);
                                         };
                                 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;
                                 unparse_generic_api stream (a_generic_api, symbolmapstack, depth - 1);

                                 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      unparse_replicate_naming      stream (spec, symbolmapstack);
                                         else                   unparse_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)
                                                     unparse_replicate_naming    stream (typ, symbolmapstack);
                                                 else
                                                     unparse_typ_bind stream (typ, symbolmapstack);
                                                 fi;

                                             mld::ERRONEOUS_ENTRY
                                                 =>
                                                 pps stream "<ERRONEOUS_ENTRY>";

                                             _   =>
                                                 bug "prettyprintElements: 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 (not first)
                                     newline stream;
                                 fi;

                                 begin_indented_wrap_box stream (pp::CURSOR_RELATIVE 4);
                                 pps stream /*2007-12-08CrT:"my "*/"";
                                 unparse_symbol stream symbol; pps stream " : ";
                                 unparse_type  symbolmapstack  stream  (type);
                                 pps stream ";";
                                 end_box stream;
                             };

                         mld::VALCON_IN_API {

                             datatype => dcon as ty::VALCON {

                                             form => vh::EXCEPTION _,
                                             ...
                                         },
                             ...
                         }
                             =>
                             {   if (not first)
                                     newline stream;
                                 fi;

                                 unparse_con_naming stream (dcon, symbolmapstack);
                                 pps stream ";";
                             };

                         mld::VALCON_IN_API { datatype, ... }
                             => 
                             if *internals

                                  if (not first)
                                      newline  stream;
                                  fi;

                                  unparse_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 unparse_api0 stream (an_api, symbolmapstack, depth, typechecked_package_env_op)
            = 
            {   (en_pp  stream)
                    ->
                    { begin_horizontal_else_vertical_box,
                      begin_wrap_box,
                      end_box,
                      pps,
                      break,
                      newline
                    };
                    

                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 ))
                    = 
                    {   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)
                    case an_api    mld::API { name => THE symbol, ... } => { pps "<api "; unparse_symbol stream symbol; pps ">"; };
                                   _                                    =>   pps "<api>;";
                    esac;
                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;
                                               unparse_elements (symbolmapstack, depth, typechecked_package_env_op)  stream  api_elements;
                                           };
                                esac;

                                case package_sharing
                                    #
                                    NIL => ();

                                    _   => {   newline();
                                               pps "package_sharing:";
                                               newline_indent stream 2;
                                               unparse_constraints("", package_sharing);
                                           };
                                esac;

                                case type_sharing
                                    #
                                    NIL => ();

                                    _   => {   newline();
                                               pps "typsharing:";
                                               newline_indent stream 2;
                                               unparse_constraints(/*2007-12-07CrT"type "*/"", type_sharing);
                                           };
                                esac;

                                pps ";";
                                end_box ();
                                end_box ();

                            else
                                #  not *internals 
                                begin_horizontal_else_vertical_box 0;
                                pps "api";
                                begin_horizontal_else_vertical_box 0;
                                newline();              # 2008-01-03 CrT: Was:  break { spaces=>1, indent_on_wrap=>2 };
                                pps "    ";             # 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)  stream  api_elements;
                                               some_print := TRUE;
                                           };
                                esac;

                                case package_sharing
                                    #
                                    NIL => ();

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

                                case type_sharing
                                    #
                                    NIL => ();

                                    _   => {   if   *some_print      newline();  fi;
                                               unparse_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;";
                                end_box ();
                            fi;

                        mld::ERRONEOUS_API
                            =>
                            pps "<error api>;";
                    esac;
                fi;
            }

        also
        fun unparse_generic_api stream (an_api, symbolmapstack, depth)
            =
            {   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 (sy::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: ";
                                 unparse_api0 stream (parameter_api, symbolmapstack, depth - 1, NULL);
                                 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: ";
                                 unparse_api0 stream (body_api, symbolmapstack, depth - 1, NULL);
                                 end_box ();
                                 end_box ();
                             else
                                 begin_horizontal_else_vertical_box 0;
                                 pps "(";

                                 case parameter_symbol

                                      THE x =>  pps (sy::name x);
                                      _     =>  pps "<parameter>";
                                 esac;

                                 pps ": ";
                                 unparse_api0 stream (parameter_api, symbolmapstack, depth - 1, NULL);
                                 pps ") :";
                                 break { spaces=>1, indent_on_wrap=>0 };
                                 unparse_api0 stream (true_body_sig body_api, symbolmapstack, depth - 1, NULL);
                                 end_box ();
                             fi;

                         mld::ERRONEOUS_GENERIC_API
                             =>
                             pps "<error fsig>";
                    esac;
                fi;
            }


        also
        fun unparse_generics_expansion stream (e, symbolmapstack, depth)
            =
            {   e ->  { stamp, typerstore, property_list, inverse_path, stub   };

                my { begin_horizontal_else_vertical_box, begin_wrap_box, end_box, pps, break, newline }
                    =
                    en_pp  stream;
            
                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;
                    unparse_typerstore stream (typerstore, symbolmapstack, depth - 1);
                    newline();
                    pps "lambdaty:";
                    newline_indent stream 2;
                    unparse_lty stream ( /* ModulePropLists::packageMacroExpansionLambdatype e, depth - 1 */);
                    end_box ();
                    end_box ();
                fi;
            }

        also
        fun unparse_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 };
                    unparse_closure stream (generic_closure, depth - 1);
                    newline();
                    pps "lambdaty:";
                    break { spaces=>1, indent_on_wrap=>2 };
                    unparse_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 unparse_generic stream
            =
            {   (en_pp stream)
                    ->
                    { begin_horizontal_else_vertical_box, begin_wrap_box, end_box, pps, break, newline };
                #
                fun unparse_f (mld::GENERIC { a_generic_api, typechecked_generic, ... }, symbolmapstack, depth)
                        =>
                        if (depth <= 1) 

                            pps "<generic package>";
                        else
                            begin_horizontal_else_vertical_box 0;
                            pps "a_generic_api:";
                            newline_indent stream 2;
                            unparse_generic_api stream (a_generic_api, symbolmapstack, depth - 1);
                            newline();
                            pps "typechecked_generic:";
                            newline_indent stream 2;
                            unparse_typechecked_generic stream (typechecked_generic, symbolmapstack, depth - 1);
                            end_box ();
                        fi;

                    unparse_f (mld::ERRONEOUS_GENERIC, _, _)
                        =>
                        pps "<error generic package>";
                end;
            
                unparse_f;
            }

        also
        fun unparse_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 (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,
                                                 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 [David B MacQueen]
                                            found ! find rest;

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

                                                internals := TRUE;
                                                begin_horizontal_else_vertical_box 0;
                                                pps "unparse_typ_bind failure: ";
                                                newline();
                                                unparse_typ  symbolmapstack  stream  typ;
                                                newline();
                                                unparse_typ  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 unparse_dcon (ty::VALCON { name, type, ... } )
                    =
                    {   unparse_symbol  stream  name; 

                        type =  strip_poly  type;

                        if (bt::is_arrow_type  type)
                            #                       
#                           pps " of ";
                            pps " ";
                            unparse_type  symbolmapstack  stream  (bt::domain  type);
                        fi;
                    };
            
                if *internals 
                    #
                    begin_horizontal_else_vertical_box 0;
                    pps /*2007-12-07CrT"type "*/"";   unparse_typ  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);
                                        unparse_formals stream arity;
                                        pps " ";
                                        end_box ();
                                    };

                                (_, ty::DATATYPE { index, family => { members, ... }, ... } )
                                    =>
                                    # Ordinary enum 
                                    #
                                    {   (vector::get (members, index))
                                            ->
                                            { constructor_list, ... };

                                        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);
                                        unparse_formals stream arity;
                                        pps " ";

                                        case visdcons

                                            NIL =>  pps " = ...";

                                            first ! rest
                                                =>
                                                {   break { spaces=>1, indent_on_wrap=>2 };
                                                    begin_horizontal_else_vertical_box 0;
                                                    pps "= "; unparse_dcon first;

                                                    apply
                                                        (fn d = { break { spaces=>1, indent_on_wrap=>0 }; pps "| "; unparse_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);
                                        unparse_formals stream arity;
                                        pps " ";
                                        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); 
                                unparse_formals stream arity;
                                pps " ="; 
                                break { spaces=>1, indent_on_wrap=>0 };
                                unparse_type  symbolmapstack  stream  body;
                                end_box ();
                            };

                        typ
                            =>
                            {   pps "strange typ: ";
                                unparse_typ  symbolmapstack  stream  typ;
                            };
                    esac;
                fi;
            }                          # fun  unparse_typ_bind stream

        also
        fun unparse_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 };
                    unparse_typ  symbolmapstack  stream  right_typ;
                    end_box ();
                };

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

        also
        fun unparse_typechecked_package stream (typechecked_package, symbolmapstack, depth)
            =
            case typechecked_package

                mld::TYP_ENTRY typ
                    =>
                    unparse_typ  symbolmapstack  stream  typ;

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

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

                mld::ERRONEOUS_ENTRY
                    =>
                    pps                        stream "ERRONEOUS_ENTRY";
            esac


        also
        fun unparse_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;
                            unparse_typechecked_package stream (typechecked_package, symbolmapstack, depth - 1);
                            newline();
                            end_box ();
                        }
                    )
                    (tro::to_list typerstore));
            fi

        also
        fun unparse_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: ";
                            unparse_typechecked_package_variable stream module_stamp;
                            break stream { spaces=>1, indent_on_wrap=>1 };
                            unparse_typ_expression stream (typ_expression, depth - 1);
                        };

                    mld::PACKAGE_DECLARATION (module_stamp, package_expression, symbol)
                        =>
                        {   pps stream "ed::S: ";
                            unparse_typechecked_package_variable stream module_stamp;
                            break stream { spaces=>1, indent_on_wrap=>1 };
                            unparse_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: ";
                            unparse_typechecked_package_variable stream module_stamp;
                            break stream { spaces=>1, indent_on_wrap=>1 };
                            unparse_generic_expression stream (generic_expression, depth - 1);
                        };

                    mld::SEQUENTIAL_DECLARATIONS typechecked_package_decs
                        =>
                        ppvseq stream 0 ""
                            (fn stream =
                             fn module_declaration =
                                unparse_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 unparse_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 }; 
                            unparse_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 };
                            unparse_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:"; unparse_generic_expression stream (generic_expression, depth - 1);
                            break stream { spaces=>1, indent_on_wrap=>0 };
                            pps stream "arg:"; unparse_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:"; unparse_module_declaration stream (module_declaration, depth - 1);
                            break stream { spaces=>1, indent_on_wrap=>0 };
                            pps stream "herein:"; unparse_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:"; unparse_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;
                            unparse_typechecked_package_variable stream boundvar; break stream { spaces=>1, indent_on_wrap=>1 };
                            pps stream "src:"; unparse_package_expression stream (raw, depth - 1);
                            break stream { spaces=>1, indent_on_wrap=>0 };
                            pps stream "tgt:"; unparse_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 unparse_generic_expression stream (generic_expression, depth)
            =
            if (depth <= 0)
                pps stream "<genericexpression>";
            else
                case generic_expression

                    mld::VARIABLE_GENERIC ep
                        =>
                        {   pps stream "fe::V:";
                            unparse_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:"; unparse_typechecked_package_variable stream parameter;
                            break stream { spaces=>1, indent_on_wrap=>0 };
                            pps stream "bod:"; unparse_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:"; unparse_typechecked_package_variable stream parameter;
                            break stream { spaces=>1, indent_on_wrap=>0 };
                            pps stream "bod:"; unparse_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:"; unparse_module_declaration stream (module_declaration, depth - 1);
                            break stream { spaces=>1, indent_on_wrap=>0 };
                            pps stream "herein:"; unparse_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 unparse_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: ";
                unparse_typechecked_package_variable stream parameter;
                newline();
                pps "body: ";
                unparse_package_expression stream (body, depth - 1);
                newline();
                pps "dictionary: ";
                unparse_typerstore stream (symbolmapstack, syx::empty, depth - 1);
                end_box ();
                end_box ();
            }

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

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

                sxe::NAMED_TYPE typ
                    =>
                    unparse_typ_bind stream (typ, symbolmapstack);

                sxe::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 };
                        unparse_api0 stream (an_api, symbolmapstack, depth, NULL);
                        end_box ();
                    };

                sxe::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; 
                        unparse_generic_api stream (fs, symbolmapstack, depth);
                        end_box ();
                    };

                sxe::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 };
                        unparse_package stream (str, symbolmapstack, depth);
                        end_box ();
                    };

                sxe::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 ();
                    };

                sxe::NAMED_FIXITY fixity
                    =>
                    {   pps stream (fixity::fixity_to_string fixity);
                        unparse_symbol stream 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 stream (symbolmapstack, topenv, depth, boundsyms)
            =
            {   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)
                                    =
                                    unparse_naming stream (name, naming, pp_env, depth)
                               )
                  }
                  (all_prettyprintable_namings namings pp_env);
            };

        fun unparse_open stream (path, pkg, symbolmapstack, depth)
            =
            {    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;

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

                                        end_box ();
                                    };

                                mld::ERRONEOUS_API
                                    =>
                                    ();
                            esac;

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


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

    };                                                                          # package unparse_package_language 
end;                                                                            # stipulate








Comments and suggestions to: bugs@mythryl.org

PreviousUpNext