PreviousUpNext

15.4.669  src/lib/compiler/front/typer/print/unparse-junk.pkg

## unparse-junk.pkg 

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

stipulate
    package s: (weak)  Symbol                   # Symbol        is from   src/lib/compiler/front/basics/map/symbol.api
             = symbol;                          # symbol        is from   src/lib/compiler/front/basics/map/symbol.pkg

    package pp = prettyprint;                   # prettyprint   is from   src/lib/prettyprint/big/src/prettyprint.pkg
    package ip = inverse_path;                  # inverse_path  is from   src/lib/compiler/front/typer-stuff/basics/symbol-path.pkg
    package sp = symbol_path;                   # symbol_path   is from   src/lib/compiler/front/typer-stuff/basics/symbol-path.pkg
herein

    package   unparse_junk
    : (weak)  Unparse_Junk                      # Unparse_Junk  is from   src/lib/compiler/front/typer/print/unparse-junk.api
    {

        pps = pp::string;


        fun unparse_sequence0  ppstream ( sep: pp::Stream -> Void, pr, elems)
            =
            pr_elems  elems
            where
                fun pr_elems [el]
                        =>
                        pr ppstream el;

                    pr_elems (el ! rest)
                        =>
                        {   pr ppstream el;
                            sep ppstream;
                            pr_elems rest;
                        };

                    pr_elems []
                        =>
                        ();
                end;
            end;

        Break_Style
            =
            CONSISTENT | INCONSISTENT;


        fun open_style_box style
            = 
            case style

                 CONSISTENT   =>  pp::begin_indented_horizontal_else_vertical_box;
                 INCONSISTENT =>  pp::begin_indented_wrap_box;
            esac;


        fun unparse_sequence
                ppstream
                {   sep:   pp::Stream -> Void,
                    pr:    pp::Stream -> X -> Void, 
                    style: Break_Style
                }
                (elems: List(X))
            =
            {   open_style_box style ppstream (pp::CURSOR_RELATIVE 0);
                unparse_sequence0 ppstream (sep, pr, elems);
                pp::end_box ppstream;
            };


        fun unparse_closed_sequence
                ppstream
                {   front: pp::Stream -> Void,
                    sep:   pp::Stream -> Void,
                    back:  pp::Stream -> Void,
                    pr:    pp::Stream -> X -> Void,
                    style: Break_Style
                }
                (elems: List(X))
            =
            {   pp::begin_horizontal_else_vertical_box ppstream;
                front ppstream;
                open_style_box style ppstream (pp::CURSOR_RELATIVE 0);
                unparse_sequence0 ppstream (sep, pr, elems); 
                pp::end_box ppstream;
                back ppstream;
                pp::end_box ppstream;
            };


        fun unparse_symbol ppstream (s: s::Symbol)
            =
            pp::string ppstream (s::name s);


        string_depth = control_print::string_depth;

        heap_string = print_junk::heap_string;

        fun unparse_mlstring' ppstream =   pp::string ppstream o print_junk::print_heap_string';
        fun unparse_mlstring  ppstream =   pp::string ppstream o print_junk::print_heap_string;
        fun unparse_integer   ppstream =   pp::string ppstream o print_junk::print_integer;


        fun ppvseq ppstream indent (separator: String) pr elements
            =
            {   fun print_elements [element]
                        =>
                        pr ppstream element;

                    print_elements (element ! rest)
                        =>
                        {   pr ppstream element; 
                            pp::string ppstream separator; 
                            pp::newline ppstream;
                            print_elements rest;
                        };

                    print_elements []
                        =>
                        ();
                end;

                pp::begin_indented_horizontal_else_vertical_box ppstream (pp::CURSOR_RELATIVE indent);
                print_elements elements;
                pp::end_box ppstream;
            };


        fun ppvlist stream (header, separator, print_item, items)
            =
            case items

                 NIL   =>   ();

                 first ! rest
                     =>
                     {   pp::string stream header;
                         print_item stream first;

                         apply
                             (fn x
                                 =
                                 {   pp::newline stream;
                                     pp::string stream separator;
                                     print_item stream x;
                                 }
                             )
                             rest;
                     };
            esac;


        fun ppvlist' stream (header, separator, print_item, items)
            =
            case items

                 NIL => ();

                 first ! rest
                     =>
                     {   print_item stream header first;

                         apply
                             (fn x
                                 =
                                 {   pp::newline stream;
                                     print_item stream separator x;
                                 }
                             )
                             rest;
                     };
            esac;

        #  Debug print functions 

        fun unparse_int_path ppstream
            =
            unparse_closed_sequence
                ppstream 
                {   front =>  (fn pps =  pp::string pps "["),
                    sep   =>  (fn pps =  { pp::string pps ", "; pp::break pps { spaces=>0, indent_on_wrap=>0 }; } ),
                    back  =>  (fn pps =  pp::string pps "]"),
                    style =>  INCONSISTENT,
                    pr    =>  (fn pps =  pp::string pps o int::to_string)
                };

        fun unparse_symbol_path ppstream (sp: symbol_path::Symbol_Path)
            = 
            pp::string ppstream (symbol_path::to_string sp);

        fun unparse_inverse_path ppstream (inverse_path::INVERSE_PATH path: inverse_path::Inverse_Path)
            =
            unparse_closed_sequence
                ppstream 
                {   front =>  (fn pps =  pp::string pps "<"),
                    sep   =>  (fn pps =  (pp::string pps ".")),
                    back  =>  (fn pps =  pp::string pps ">"),
                    style =>  INCONSISTENT,
                    pr    =>  unparse_symbol
                }
                path;


        /* find_path:  Convert inverse symbolic path names
                      to a printable string in the context
                      of a dictionary.

          Its arguments are the inverse symbolic path, a check predicate on static
          semantic values, and a lookup function mapping paths to their namings
          (if any) in an dictionary and raising Dictionary::UNBOUND on paths with no
          naming.

          It looks up each suffix of the path name, going from shortest to longest
          suffix, in the current dictionary until it finds one whose lookup value
          satisfies the check predicate.  It then converts that suffix to a string.
          If it doesn't find any suffix, the full path (reversed, i.e. in the 
          normal order) and the boolean value FALSE are returned, otherwise the
          suffix and TRUE are returned.

          Example:
                 Given a::b::t as a path, and a lookup function for an
                 dictionary, this function tries:
                           t
                           b::t
                           a::b::t
                 If none of these work, it returns ?.a::b::t

          Note: the symbolic path is passed in reverse order because that is
          the way all symbolic path names are stored within static semantic chunks.
         */

        result_id =  s::make_package_symbol "<result_package>";
        return_id =  s::make_package_symbol "<return_package>";

        fun find_path (ip::INVERSE_PATH p: ip::Inverse_Path, check, get): ( (List( s::Symbol ), Bool))
            =
            {   fun try (name ! untried, tried)
                        =>
                        (   if   ((s::eq (name, result_id))   or   (s::eq (name, return_id))) 

                                 try (untried, tried);
                            else
                                 { element   =   get (sp::SYMBOL_PATH (name ! tried));

                                     if    (check element)
                                          (name ! tried, TRUE);
                                     else try (untried, name ! tried);
                                     fi;
                                 }
                                 except
                                     symbolmapstack::UNBOUND
                                     =
                                     try (untried, name ! tried);
                            fi
                        );

                    try([], tried)
                        =>
                        (tried, FALSE);
                end;

                try (p, []);
            };


        fun unparse_int  stream  (i: Int)
            =
            pps stream (int::to_string i);


        fun unparse_comma  stream
            =
            pps stream ", ";


        fun unparse_comma_newline  stream
            =
            {   unparse_comma stream;
                pp::newline stream;
            };


        fun newline_indent  stream  i
            =
            {   linewidth = 10000;

                pp::break stream { spaces => linewidth,   indent_on_wrap => i };
            };


        fun newline_apply  stream  f
            =
            g
            where
                fun g []                =>   ();
                    g [element]         =>   f stream element;
                    g (element ! rest)   =>  { f stream element; pp::newline stream; g rest;};
                end;
            end;


        fun break_apply  stream  f
            =
            g
            where
                fun g []          =>  ();
                    g [el]        =>  f stream el;
                    g (el ! rest) =>  { f stream el;   pp::break stream { spaces=>1, indent_on_wrap=>0 };   g rest;};
                end;
            end;



        # For conciseness, construct and return versions
        # of the common prettyprint fns in which 'stream'
        # is implicit:

        fun en_pp stream           #  "en" for ... "enclose" ...? 
            =
            {   begin_horizontal_else_vertical_box  =>  (fn indent =  pp::begin_indented_horizontal_else_vertical_box  stream (pp::CURSOR_RELATIVE indent)),  #  CONSISTENT 
                begin_wrap_box =>  (fn indent =  pp::begin_indented_wrap_box stream (pp::CURSOR_RELATIVE indent)),  #  INCONSISTENT 
                end_box    =>  .{ pp::end_box stream; } ,

                pps          =>  pp::string stream,
                break        =>  fn nsp_offset =  pp::break stream nsp_offset,
                newline      =>  .{ pp::newline stream; }
            };


        fun unparse_array   stream  ( f:   pp::Stream -> X -> Void,
                                          a:   Rw_Vector(X)
                                        )
            =
            {   my { begin_horizontal_else_vertical_box, begin_wrap_box, pps, break, end_box, ... }
                    =
                    en_pp stream;


                fun loop i
                    = 
                    {   element
                            =
                            rw_vector::get  (a, i);

                        pps  (int::to_string  i);
                        pps ": "; 
                        f  stream  element;
                        break { spaces=>1, indent_on_wrap=>0 };
                        loop (i+1);
                    };

                begin_wrap_box 0;

                loop 0
                except
                    (exceptions::SUBSCRIPT|exceptions::INDEX_OUT_OF_BOUNDS) = ();

                end_box();
            };


        fun by f x y
            =
            f y x;


        fun unparse_tuple stream f
            =
            unparse_closed_sequence
                stream 
                {   front => by pps "(",
                    back  => by pps ")",
                    pr    => f,
                    style => INCONSISTENT,
                    sep   => fn stream =  {   pps stream ", ";
                                              pp::break stream { spaces=>0, indent_on_wrap=>0 };
                                          }
                };


    };  #  package unparse_junk 
end;


Comments and suggestions to: bugs@mythryl.org

PreviousUpNext