PreviousUpNext

15.4.660  src/lib/compiler/front/typer/print/prettyprint-deep-syntax.pkg

## prettyprint-deep-syntax.pkg

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

# Nomenclature:
#     In these libraries we distinguish "unparsing" from "prettyprinting":
#
#       o The purpose of "unparsing" is to regenerate something close
#         to the language surface syntax, for example to issue syntax
#         error diagnostic messages to user.
#
#       o The purpose of "prettyprinting" is to accurately display
#         the actual internal datastructure in question, typically
#         for purposes of compiler debugging.
#
#     Both are useful, so we implement both
#     for both raw and deep syntax trees.

# 2009-05-13 CrT: Created  from unparse-deep-syntax.pkg.
#                 This is a really quick and dirty hack at present.

stipulate
    package ds  =  deep_syntax;                         # deep_syntax                   is from   src/lib/compiler/front/typer-stuff/deep-syntax/deep-syntax.pkg
    package pp  =  prettyprint;                         # prettyprint                   is from   src/lib/prettyprint/big/src/prettyprint.pkg
    package sci =  sourcecode_info;                     # sourcecode_info               is from   src/lib/compiler/front/basics/source/sourcecode-info.pkg
    package syx =  symbolmapstack;                      # symbolmapstack                is from   src/lib/compiler/front/typer-stuff/symbolmapstack/symbolmapstack.pkg
herein

    api Prettyprint_Deep_Syntax {
        #
        prettyprint_pattern
            :
            syx::Symbolmapstack
            -> pp::Stream 
            -> (ds::Case_Pattern,  Int)
            -> Void;

        prettyprint_expression
            :
            (syx::Symbolmapstack,  Null_Or( sci::Sourcecode_Info ))
            -> pp::Stream
            -> (ds::Deep_Expression,  Int)
            -> Void;

        prettyprint_declaration
            :
            (syx::Symbolmapstack,  Null_Or( sci::Sourcecode_Info ))
            -> pp::Stream
            -> (ds::Declaration,  Int)
            -> Void;

        prettyprint_rule
            :
            (syx::Symbolmapstack,  Null_Or( sci::Sourcecode_Info ))
            -> pp::Stream
            -> (ds::Case_Rule,  Int)
            -> Void;

        prettyprint_named_value
            :
            (syx::Symbolmapstack,  Null_Or( sci::Sourcecode_Info ))
            -> pp::Stream
            -> (ds::Named_Value,  Int)
            -> Void;

        prettyprint_recursively_named_value
            :
            (syx::Symbolmapstack,  Null_Or( sci::Sourcecode_Info ))
            -> pp::Stream
            -> (ds::Named_Recursive_Values,  Int)
            -> Void;


        prettyprint_package_expression
            :
            (syx::Symbolmapstack,  Null_Or( sci::Sourcecode_Info ))
            -> pp::Stream
            -> (ds::Package_Expression,  Int)
            -> Void;

        lineprint:  Ref(  Bool );

        debugging:  Ref(  Bool );

    }; #  Api Prettyprint_Deep_Syntax 
end;


stipulate
    package ds  =  deep_syntax;                         # deep_syntax                   is from   src/lib/compiler/front/typer-stuff/deep-syntax/deep-syntax.pkg
    package err =  error_message;                       # error_message                 is from   src/lib/compiler/front/basics/errormsg/error-message.pkg
    package mld =  module_level_declarations;           # module_level_declarations     is from   src/lib/compiler/front/typer-stuff/modules/module-level-declarations.pkg
    package pp  =  prettyprint;                         # prettyprint                   is from   src/lib/prettyprint/big/src/prettyprint.pkg
    package sci =  sourcecode_info;                     # sourcecode_info               is from   src/lib/compiler/front/basics/source/sourcecode-info.pkg
    package sy  =  symbol;                              # symbol                        is from   src/lib/compiler/front/basics/map/symbol.pkg
    package syx =  symbolmapstack;                      # symbolmapstack                is from   src/lib/compiler/front/typer-stuff/symbolmapstack/symbolmapstack.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

    include tuples;
    include fixity;
    include prettyprint;
    include unparse_junk;
    include prettyprint_type;
    include unparse_value;
herein

    package   prettyprint_deep_syntax
    : (weak)  Prettyprint_Deep_Syntax                   # Prettyprint_Deep_Syntax       is from   src/lib/compiler/front/typer/print/prettyprint-deep-syntax.pkg
    {
        #  Debugging 
        say = control_print::say;
        debugging = REF FALSE;

#       unparse_typevar_ref = unparse_type::unparse_typevar_ref         syx::empty;



        fun bug msg
            =
            error_message::impossible("unparse_deep_syntax: " + msg);

        internals = typer_control::internals;

        lineprint = REF FALSE;

        fun if_debugging_say (msg: String)
            =
            if   *debugging   say msg;   say "\n";   fi;

        fun if_debugging_unparse_typevar_ref  (msg, typevar_ref)
            = 
            if *debugging

                unparse_typevar_ref = unparse_type::unparse_typevar_ref         syx::empty;

                typer_debugging::with_internals
                    (fn () =  typer_debugging::debug_print debugging (msg, unparse_typevar_ref, typevar_ref));
            fi;


        fun by f x y
            =
            f y x;

        null_fix = INFIX (0, 0);
        inf_fix  = INFIX (1000000, 100000);

        fun stronger_l (INFIX(_, m), INFIX (n, _)) => m >= n;
            stronger_l _ => FALSE;                      #  should not matter 
        end;

        fun stronger_r (INFIX(_, m), INFIX (n, _)) => n > m;
            stronger_r _ => TRUE;                       #  should not matter 
         end; 

        fun prpos ( stream:  pp::Stream,
                   source:  sci::Sourcecode_Info,
                   charpos: Int
                 )
            =
            if *lineprint

                 my (file: String, line: Int, pos: Int)
                     =
                     sci::filepos source charpos;
              
                 pp::string stream (int::to_string line);
                 pp::string stream ".";
                 pp::string stream (int::to_string pos);

            else
                 pp::string stream (int::to_string charpos);
            fi;


        fun checkpat (n, NIL)
                =>
                TRUE;

            checkpat (n, (symbol, _) ! fields)
                => 
                sy::eq (symbol, number_to_label n) and checkpat (n+1, fields);
        end;

        fun checkexp (n, NIL)
                =>
                TRUE;
            checkexp (n, (ds::NUMBERED_LABEL { name=>symbol, ... }, _) ! fields)
                => 
                sy::eq (symbol, number_to_label n) and checkexp (n+1, fields);
        end;

        fun is_tuplepat (ds::RECORD_PATTERN { fields => [_],                  ... } ) =>  FALSE;
            is_tuplepat (ds::RECORD_PATTERN { is_incomplete => FALSE, fields, ... } ) =>  checkpat (1, fields);
            is_tuplepat _ => FALSE;
        end;

        fun is_tupleexp (ds::RECORD_IN_EXPRESSION [_]) => FALSE;
            is_tupleexp (ds::RECORD_IN_EXPRESSION fields) => checkexp (1, fields);
            is_tupleexp (ds::SOURCE_CODE_REGION_FOR_EXPRESSION (a, _)) => is_tupleexp a;
            is_tupleexp _ => FALSE;
        end;

        fun get_fix (symbolmapstack, symbol)
            =
            find_in_symbolmapstack::find_fixity_by_symbol
                (
                  symbolmapstack,
                  sy::make_fixity_symbol (sy::name symbol)
                );

        fun strip_source_code_region_data (ds::SOURCE_CODE_REGION_FOR_EXPRESSION (a, _)) => strip_source_code_region_data a;
            strip_source_code_region_data x => x;
        end;

        fun prettyprint_pattern symbolmapstack stream
            =
            {   ppsay = pp::string stream;

                fun prettyprint_pattern' (_,          0)
                        =>
                        ppsay "<pattern>";

                    prettyprint_pattern' (ds::VARIABLE_IN_PATTERN v,   _)
                        =>
                        {   ppsay "ds::VARIABLE_IN_PATTERN ";
#                           unparse_var stream v;
                            unparse_variable stream (symbolmapstack, v);        # More verbose version of previous line.
                            ppsay " ";
                        };

                    prettyprint_pattern' (ds::WILDCARD_PATTERN,    _)
                        =>
                        ppsay "WILDCARD_PATTERN ";

                    prettyprint_pattern' (ds::INT_CONSTANT_IN_PATTERN (i, t), _)
                        =>
                        {   ppsay "ds::INT_CONSTANT_IN_PATTERN ";  
                            ppsay (multiword_int::to_string i);
                            ppsay " ";
                        };

        /*           (begin_block stream INCONSISTENT 2;
                      ppsay "("; ppsay (multiword_int::to_string i);
                      ppsay " :"; break stream { spaces=1, indent_on_wrap=1 };
                      unparse_type symbolmapstack stream t; ppsay ")";
                      end_block stream)
         */

                    prettyprint_pattern' (ds::UNT_CONSTANT_IN_PATTERN (w, t), _)
                        =>
                        {   ppsay "ds::UNT_CONSTANT_IN_PATTERN ";  
                            ppsay (multiword_int::to_string w);
                            ppsay " ";
                        };


        /*           (open_style_box INCONSISTENT stream (pp::CURSOR_RELATIVE 2);
                      ppsay "("; ppsay (multiword_int::to_string w);
                      ppsay " :"; break stream { spaces=1, indent_on_wrap=1 };
                      unparse_type symbolmapstack stream t; ppsay ")";
                      end_box stream)
         */

                    prettyprint_pattern' (ds::FLOAT_CONSTANT_IN_PATTERN  r, _)
                        =>
                        {   ppsay "ds::FLOAT_CONSTANT_IN_PATTERN ";  
                            ppsay r;
                            ppsay " ";
                        };

                    prettyprint_pattern' (ds::STRING_CONSTANT_IN_PATTERN s, _)
                        =>
                        {   ppsay "ds::STRING_CONSTANT_IN_PATTERN ";  
                            unparse_mlstring  stream s;
                            ppsay " ";
                        };

                    prettyprint_pattern' (ds::CHAR_CONSTANT_IN_PATTERN   s, _)
                        =>
                        {   ppsay "ds::STRING_CONSTANT_IN_PATTERN ";  
                            unparse_mlstring' stream s;
                            ppsay " ";
                        };

                    prettyprint_pattern' (ds::AS_PATTERN (v, p), d)
                        =>
                        {   open_style_box CONSISTENT stream (pp::CURSOR_RELATIVE 0);
                            ppsay "ds::AS_PATTERN ";  
                            prettyprint_pattern'(v, d);
                            ppsay " as ";
                            prettyprint_pattern'(p, d - 1);
                            end_box stream;
                        };
                            #  Handle 0 length case specially to avoid {, ... }: 

                    prettyprint_pattern' (ds::RECORD_PATTERN { fields => [], is_incomplete, ... }, _)
                        =>
                        {   ppsay "ds::RECORD_PATTERN ";  
                            if is_incomplete      ppsay "{... }";
                            else                  ppsay "()";
                            fi;
                        };

                    prettyprint_pattern' (r as ds::RECORD_PATTERN { fields, is_incomplete, ... }, d)
                        =>
                        {   ppsay "ds::RECORD_PATTERN ";  

                            if   (is_tuplepat r)

                                 unparse_closed_sequence stream
                                   { front=>(by pp::string "("),
                                     sep=>(fn stream = { pp::string stream ", ";
                                                         break stream { spaces=>0, indent_on_wrap=>0 };
                                                       }
                                          ),
                                     back=>(by pp::string ")"),
                                     pr=>(fn _ = fn (symbol, pattern) = prettyprint_pattern'(pattern, d - 1) ),
                                     style=>INCONSISTENT
                                   }
                                   fields;
                            else
                                 unparse_closed_sequence stream
                                   { front=>(by pp::string "{ "),
                                     sep =>(fn stream =  { pp::string stream ", ";
                                                           break stream { spaces=>0, indent_on_wrap=>0 };
                                                         }
                                           ),
                                     back=>(fn stream =  if is_incomplete  pp::string stream ", ... }";
                                                         else pp::string stream "}";
                                                         fi
                                           ),
                                     pr=>(fn stream =  fn (symbol, pattern) =
                                           { unparse_symbol stream symbol; pp::string stream "=";
                                             prettyprint_pattern'(pattern, d - 1);
                                           }
                                         ),
                                     style=>INCONSISTENT
                                   }
                                   fields;
                            fi;
                        };

                    prettyprint_pattern' (ds::VECTOR_PATTERN (NIL, _), d)
                        =>
                        {   ppsay "ds::VECTOR_PATTERN ";  
                            ppsay "#[]";
                        };

                    prettyprint_pattern' (ds::VECTOR_PATTERN (pats, _), d)
                        => 
                        {   ppsay "ds::VECTOR_PATTERN ";  

                            fun pr _ pattern
                                =
                                prettyprint_pattern'(pattern, d - 1);

                            unparse_closed_sequence stream
                              {   front => (by pp::string "#["),
                                  sep   => (fn stream => { pp::string stream ", ";
                                                  break stream { spaces=>0, indent_on_wrap=>0 } ;}; end ),
                                  back  => (by pp::string "]"),
                                  pr,
                                  style => INCONSISTENT
                              }
                              pats;
                        };

                    prettyprint_pattern' (pattern as (ds::OR_PATTERN _), d)
                        =>
                        {   ppsay "ds::OR_PATTERN ";  

                            fun make_list (ds::OR_PATTERN (hd, tl)) => hd ! make_list tl;
                                make_list p => [p];
                            end;

                            fun pr _ pattern
                                =
                                prettyprint_pattern' (pattern, d - 1);

                            unparse_closed_sequence stream
                              {
                                front => (by pp::string "("),
                                sep   => fn stream => { break stream { spaces=>1, indent_on_wrap=>0 };
                                                    pp::string stream "| ";}; end ,
                                back  => (by pp::string ")"),
                                pr,
                                style => INCONSISTENT

                              } (make_list pattern);
                        };

                    prettyprint_pattern' (ds::CONSTRUCTOR_PATTERN (e, _), _)
                        =>
                        {   ppsay "ds::CONSTRUCTOR_PATTERN ";  
                            unparse_dcon stream e;
                        };

                    prettyprint_pattern' (p as ds::APPLY_PATTERN _, d)
                        =>
                        {   ppsay "ds::APPLY_PATTERN ";  
                            prettyprint_dcon_pattern (symbolmapstack, stream) (p, null_fix, null_fix, d);
                        };

                    prettyprint_pattern' (ds::TYPE_CONSTRAINT_PATTERN (p, t), d)
                        =>
                        {   open_style_box INCONSISTENT stream (pp::CURSOR_RELATIVE 0);
                            ppsay "ds::TYPE_CONSTRAINT_PATTERN ";  
                            prettyprint_pattern'(p, d - 1); ppsay " :";
                            break stream { spaces=>1, indent_on_wrap=>2 };
                            prettyprint_type  symbolmapstack  stream  t;
                            end_box stream;
                        };

                    prettyprint_pattern' _ => bug "prettyprint_pattern'";
                end;
            
                prettyprint_pattern';
            }

        also
        fun prettyprint_dcon_pattern (symbolmapstack, stream)
            = 
            {   ppsay = pp::string stream;

                fun lpcond (atom) = if atom  ppsay "("; fi;
                fun rpcond (atom) = if atom  ppsay ")"; fi;

                fun prettyprint_dcon_pattern'(_, _, _, 0) => ppsay "<pattern>";
                    #
                    prettyprint_dcon_pattern' (ds::CONSTRUCTOR_PATTERN (ty::VALCON { name, ... }, _), l: Fixity, r: Fixity, _)
                        =>
                        {   ppsay "ds::CONSTRUCTOR_PATTERN (ty::VALCON { ";
                            unparse_symbol  stream  name;
                            ppsay " } ) ";
                        };

                    prettyprint_dcon_pattern'(ds::TYPE_CONSTRAINT_PATTERN (p, t), l, r, d)
                        =>
                        {   open_style_box INCONSISTENT stream (pp::CURSOR_RELATIVE 0);
                            ppsay "ds::TYPE_CONSTRAINT_PATTERN (";
                            prettyprint_pattern symbolmapstack stream (p, d - 1);
                            ppsay " :";
                            break stream { spaces=>1, indent_on_wrap=>2 };
                            prettyprint_type  symbolmapstack  stream t;
                            ppsay ")";
                            end_box stream;
                        };

                    prettyprint_dcon_pattern'(ds::AS_PATTERN (v, p), l, r, d)
                        =>
                        {   open_style_box INCONSISTENT stream (pp::CURSOR_RELATIVE 0);
                            ppsay "ds::AS_PATTERN (";
                            prettyprint_pattern symbolmapstack stream (v, d);
                            break stream { spaces=>1, indent_on_wrap=>2 };
                            ppsay " as ";
                            prettyprint_pattern symbolmapstack stream (p, d - 1);
                            ppsay ")";
                            end_box stream;
                        };

                    prettyprint_dcon_pattern' (ds::APPLY_PATTERN (ty::VALCON { name, ... }, _, p), l, r, d)
                        =>
                        {   name' = sy::name name; 
                                #  should really have original path, like for VARIABLE_IN_EXPRESSION  XXX BUGGO FIXME

                            this_fix =  get_fix (symbolmapstack, name);
                            eff_fix  =  case this_fix    NONFIX => inf_fix;  x => x; esac;
                            atom     =  stronger_r (eff_fix, r) or stronger_l (l, eff_fix);

                            open_style_box INCONSISTENT stream (pp::CURSOR_RELATIVE 2);

                            ppsay "ds::APPLY_PATTERN (ty::VALCON { ";

                            lpcond (atom);

                            case (this_fix, p)
                                #                             
                                 (INFIX _, ds::RECORD_PATTERN { fields => [(_, pl), (_, pr)], ... } )
                                     =>
                                     {   my (left, right)
                                             =
                                             if atom      (null_fix, null_fix);
                                                       else   (       l,        r);   fi;
                                         prettyprint_dcon_pattern' (pl, left, this_fix, d - 1);
                                         break stream { spaces=>1, indent_on_wrap=>0 };
                                         ppsay name';
                                         break stream { spaces=>1, indent_on_wrap=>0 };
                                         prettyprint_dcon_pattern' (pr, this_fix, right, d - 1);
                                     };
                                 _ =>
                                     {   ppsay name';
                                         break stream { spaces=>1, indent_on_wrap=>0 };
                                         prettyprint_dcon_pattern'(p, inf_fix, inf_fix, d - 1);
                                     };
                            esac;

                            rpcond atom;

                            ppsay " } ) ";

                            end_box  stream;
                        };

                    prettyprint_dcon_pattern' (p, _, _, d)
                        =>
                        prettyprint_pattern symbolmapstack stream (p, d);
                end;

            
                prettyprint_dcon_pattern';
            };

        fun trim [x] => [];
            trim (a ! b) => a ! trim b;
            trim [] => [];
        end;

        fun prettyprint_expression (context as (symbolmapstack, source_opt)) stream
            =
            {   ppsay = pp::string stream;

#               my { begin_horizontal_else_vertical_box, begin_wrap_box, end_box, pps, break, ... }
#                    =
#                    en_pp stream;

                fun lparen () = ppsay "(";
                fun rparen () = ppsay ")";

                fun lpcond (atom) = if atom  ppsay "(";  fi;
                fun rpcond (atom) = if atom  ppsay ")";  fi;

                fun prettyprint_expression' (_, _, 0) => ppsay "<expression>";

                    prettyprint_expression' (ds::VALCON_IN_EXPRESSION (con, _),       _, _)
                        =>
                        {   ppsay "ds::VALCON_IN_EXPRESSION ";
                            unparse_dcon stream con;
                        };
#                   prettyprint_expression' (       ds::VARIABLE_IN_EXPRESSION (REF var, _),   _, _) =>  unparse_var stream var;

                    prettyprint_expression' (       ds::VARIABLE_IN_EXPRESSION (REF var, _),   _, _)
                        =>
                        {   ppsay "ds::VARIABLE_IN_EXPRESSION (REF ";
#                           unparse_var      stream                var ;
                            unparse_variable stream (symbolmapstack, var);      # More verbose version of previous line.
                            ppsay ", _) ";
                        };

                    prettyprint_expression' (   ds::INT_CONSTANT_IN_EXPRESSION (i, t), _, _)
                        =>
                        {   ppsay "ds::INT_CONSTANT_IN_EXPRESSION ";
                            ppsay (multiword_int::to_string i);
                            ppsay " ";
                        };

                    prettyprint_expression' (   ds::UNT_CONSTANT_IN_EXPRESSION (u, t),    _, _)
                        =>
                        {   ppsay "ds::UNT_CONSTANT_IN_EXPRESSION ";
                            ppsay (multiword_int::to_string u);
                            ppsay " ";
                        };

                    prettyprint_expression' ( ds::FLOAT_CONSTANT_IN_EXPRESSION r,         _, _)
                        =>
                        {   ppsay "ds::FLOAT_CONSTANT_IN_EXPRESSION ";
                            ppsay r;
                            ppsay " ";
                        };

                    prettyprint_expression' (ds::STRING_CONSTANT_IN_EXPRESSION s,       _, _)
                        =>
                        {   ppsay "ds::STRING_CONSTANT_IN_EXPRESSION ";
                            unparse_mlstring  stream s;
                            ppsay " ";
                        };

                    prettyprint_expression' (  ds::CHAR_CONSTANT_IN_EXPRESSION s,    _, _)
                        =>
                        {   ppsay "ds::CHAR_CONSTANT_IN_EXPRESSION ";
                            unparse_mlstring'  stream s;
                            ppsay " ";
                        };

                    prettyprint_expression' (r as ds::RECORD_IN_EXPRESSION fields, _, d)
                        =>
                        {   ppsay "ds::RECORD_IN_EXPRESSION ";

                            if (is_tupleexp r)

                                 unparse_closed_sequence stream
                                   { front=>(by pp::string "("),
                                    sep=>(fn stream => { pp::string stream ", ";
                                                       break stream { spaces=>0, indent_on_wrap=>0 } ;}; end ),
                                    back=>(by pp::string ")"),
                                    pr=>(fn _ => fn (_, expression) => prettyprint_expression'(expression, FALSE, d - 1); end; end ),
                                    style=>INCONSISTENT }
                                   fields;

                            else
                                 unparse_closed_sequence stream
                                   { front=>(by pp::string "{ "),
                                    sep=>(fn stream => { pp::string stream ", ";
                                                       break stream { spaces=>0, indent_on_wrap=>0 } ;}; end ),
                                    back=>(by pp::string "}"),
                                    pr=>(fn stream => fn (ds::NUMBERED_LABEL { name, ... }, expression) =>
                                        { unparse_symbol stream name; ppsay "=";
                                         prettyprint_expression'(expression, FALSE, d);}; end;  end ),
                                    style=>INCONSISTENT }
                                   fields;
                            fi;
                        };

                    prettyprint_expression' (ds::RECORD_SELECTOR_EXPRESSION (ds::NUMBERED_LABEL { name, ... }, expression), atom, d)
                        =>
                        {   open_style_box CONSISTENT stream (pp::CURSOR_RELATIVE 0);
                            ppsay "ds::RECORD_SELECTOR_EXPRESSION (ds::NUMBERED_LABEL { ";
                            ppsay "#"; unparse_symbol stream name;
                            ppsay ", ... }, ";
                            lpcond (atom);
                            prettyprint_expression'(expression, TRUE, d - 1); ppsay ">";
                            rpcond (atom);
                            ppsay " ) ";
                            end_box stream;
                        };

                    prettyprint_expression'(ds::VECTOR_IN_EXPRESSION (NIL, _), _, d)
                        =>
                        ppsay "ds::VECTOR_IN_EXPRESSION #[]";

                    prettyprint_expression'(ds::VECTOR_IN_EXPRESSION (exps, _), _, d)
                        =>
                        {   fun pr _ expression
                                =
                                prettyprint_expression'(expression, FALSE, d - 1);

                            ppsay "ds::VECTOR_IN_EXPRESSION ";

                            unparse_closed_sequence stream
                              {  front => (by pp::string "#["),
                                 sep   => (fn stream => { pp::string stream ", ";
                                                  break stream { spaces=>1, indent_on_wrap=>0 } ;}; end ),
                                 back  => (by pp::string "]"),
                                 pr,
                                 style => INCONSISTENT
                              }
                              exps;
                        };

                    prettyprint_expression'(ds::ABSTRACTION_PACKING_EXPRESSION (e, t, tcs), atom, d)
                        => 
                        {
                            open_style_box INCONSISTENT stream (pp::CURSOR_RELATIVE 0);
                            ppsay "<ds::ABSTRACTION_PACKING_EXPRESSION: ";
                            prettyprint_expression'(e, FALSE, d);
                            ppsay "; ";
                            break stream { spaces=>1, indent_on_wrap=>2 };
                            prettyprint_type  symbolmapstack  stream  t;
                            ppsay ">";
                            end_box stream;
                        };

                    prettyprint_expression'(ds::SEQUENTIAL_EXPRESSIONS expressions, _, d)
                        =>
                        {   ppsay "ds::SEQUENTIAL_EXPRESSIONS ";
                            #
                            unparse_closed_sequence stream
                              # 
                              { front => (by pp::string "("),
                                sep   => (fn stream = { pp::string stream ";";
                                                        break stream { spaces=>1, indent_on_wrap=>0 } ;
                                                      }
                                         ),
                                back  => (by pp::string ")"),
                                pr    => (fn _ = fn expression = prettyprint_expression'(expression, FALSE, d - 1)),
                                style => INCONSISTENT
                              }
                              # 
                              expressions;
                        };

                    prettyprint_expression'(e as ds::APPLY_EXPRESSION _, atom, d)
                        =>
                        {   infix0 = INFIX (0, 0);
                            #
                            ppsay "ds::APPLY_EXPRESSION ";
                            lpcond (atom);
                            prettyprint_app_expression (e, null_fix, null_fix, d);
                            rpcond (atom);
                        };

                    prettyprint_expression'(ds::TYPE_CONSTRAINT_EXPRESSION (e, t), atom, d)
                        =>
                        {   open_style_box INCONSISTENT stream (pp::CURSOR_RELATIVE 0);
                            ppsay "ds::TYPE_CONSTRAINT_EXPRESSION ";
                            lpcond (atom);
                            prettyprint_expression'(e, FALSE, d); ppsay ":";
                            break stream { spaces=>1, indent_on_wrap=>2 };
                            prettyprint_type  symbolmapstack  stream  t;
                            rpcond (atom);
                            end_box stream;
                        };

                    prettyprint_expression'(ds::EXCEPT_EXPRESSION (expression, (rules, _)), atom, d)
                        =>
                        {   open_style_box CONSISTENT stream (pp::CURSOR_RELATIVE 0);
                            ppsay "ds::EXCEPT_EXPRESSION ";
                            lpcond (atom);
                            prettyprint_expression'(expression, atom, d - 1); newline stream; ppsay "except ";
                            newline_indent stream 2;
                            ppvlist stream ("  ", "| ",
                               (fn stream => fn r => prettyprint_rule context stream (r, d - 1); end; end ), rules);
                            rpcond (atom);
                            end_box stream;
                        };

                    prettyprint_expression'(ds::RAISE_EXPRESSION (expression, _), atom, d)
                        => 
                        {   open_style_box CONSISTENT stream (pp::CURSOR_RELATIVE 0);
                            ppsay "ds::RAISE_EXPRESSION ";
                            lpcond (atom);
                            ppsay "raise exception "; prettyprint_expression'(expression, TRUE, d - 1);
                            rpcond (atom);
                            end_box stream;
                        };

                    prettyprint_expression'(ds::LET_EXPRESSION (declaration, expression), _, d)
                        =>
                        {   open_style_box CONSISTENT stream (pp::CURSOR_RELATIVE 0);
                            ppsay "ds::LET_EXPRESSION ";
                            ppsay "stipulate ";
                            open_style_box CONSISTENT stream (pp::CURSOR_RELATIVE 0);
                            prettyprint_declaration context stream (declaration, d - 1); 
                            end_box stream;
                            break stream { spaces=>1, indent_on_wrap=>0 };
                            ppsay "herein ";
                            open_style_box CONSISTENT stream (pp::CURSOR_RELATIVE 0);
                             prettyprint_expression'(expression, FALSE, d - 1);
                            end_box stream;
                            break stream { spaces=>1, indent_on_wrap=>0 };
                            ppsay "end;";
                            end_box stream;
                        };

                    prettyprint_expression'(ds::CASE_EXPRESSION (expression, rules, _), _, d)
                        =>
                        {   open_style_box CONSISTENT stream (pp::CURSOR_RELATIVE 0);
                            ppsay "ds::CASE_EXPRESSION ";
                            ppsay "case ("; prettyprint_expression'(expression, TRUE, d - 1); newline_indent stream 2;
                            ppvlist stream (") ", ";",
                              (fn stream =  fn r =  prettyprint_rule context stream (r, d - 1)), 
                               trim rules);
                            rparen();
                            ppsay "esac";
                            end_box stream;
                        };

                    prettyprint_expression' (ds::IF_EXPRESSION { test_case, then_case, else_case }, atom, d)
                        =>
                        {   open_style_box CONSISTENT stream (pp::CURSOR_RELATIVE 0);
                            ppsay "ds::IF_EXPRESSION ";
                            lpcond (atom);
                            ppsay "if ";
                            open_style_box CONSISTENT stream (pp::CURSOR_RELATIVE 0);
                             prettyprint_expression' (test_case, FALSE, d - 1);
                            end_box stream;
                            break stream { spaces=>1, indent_on_wrap=> 0 };
                            ppsay "then ";
                            open_style_box CONSISTENT stream (pp::CURSOR_RELATIVE 0);
                             prettyprint_expression' (then_case, FALSE, d - 1);
                            end_box stream;
                            break stream { spaces=>1, indent_on_wrap=> 0 };
                            ppsay "else ";
                            open_style_box CONSISTENT stream (pp::CURSOR_RELATIVE 0);
                             prettyprint_expression' (else_case, FALSE, d - 1);
                            end_box stream;
                            rpcond (atom);
                            end_box stream;
                        };

                    prettyprint_expression' (ds::AND_EXPRESSION (e1, e2), atom, d)
                        =>
                        {   open_style_box CONSISTENT stream (pp::CURSOR_RELATIVE 0);
                            ppsay "ds::AND_EXPRESSION ";
                            lpcond (atom);
                            open_style_box CONSISTENT stream (pp::CURSOR_RELATIVE 0);
                            prettyprint_expression' (e1, TRUE, d - 1);
                            end_box stream;
                            break stream { spaces=>1, indent_on_wrap=> 0 };
                            ppsay "and ";
                            open_style_box CONSISTENT stream (pp::CURSOR_RELATIVE 0);
                            prettyprint_expression' (e2, TRUE, d - 1);
                            end_box stream;
                            rpcond (atom);
                            end_box stream;
                        };

                    prettyprint_expression' (ds::OR_EXPRESSION (e1, e2), atom, d)
                        =>
                        {   open_style_box CONSISTENT stream (pp::CURSOR_RELATIVE 0);
                            ppsay "ds::OR_EXPRESSION ";
                            lpcond (atom);
                            open_style_box CONSISTENT stream (pp::CURSOR_RELATIVE 0);
                            prettyprint_expression' (e1, TRUE, d - 1);
                            end_box stream;
                            break stream { spaces=>1, indent_on_wrap=> 0 };
                            ppsay "or ";
                            open_style_box CONSISTENT stream (pp::CURSOR_RELATIVE 0);
                            prettyprint_expression' (e2, TRUE, d - 1);
                            end_box stream;
                            rpcond (atom);
                            end_box stream;
                        };

                    prettyprint_expression' (ds::WHILE_EXPRESSION { test, expression }, atom, d)
                        =>
                        {   open_style_box CONSISTENT stream (pp::CURSOR_RELATIVE 0);
                            ppsay "ds::WHILE_EXPRESSION ";
                            ppsay "while ";
                            open_style_box CONSISTENT stream (pp::CURSOR_RELATIVE 0);
                             prettyprint_expression'(test, FALSE, d - 1);
                            end_box stream;
                            break stream { spaces=>1, indent_on_wrap=> 0 };
                            ppsay "do ";
                            open_style_box CONSISTENT stream (pp::CURSOR_RELATIVE 0);
                              prettyprint_expression'(expression, FALSE, d - 1);
                            end_box stream;
                            end_box stream;
                        };

                    prettyprint_expression'(ds::FN_EXPRESSION (rules, _), _, d)
                        =>
                        {   begin_horizontal_else_vertical_box stream;
                            ppsay "ds::FN_EXPRESSION ";
                            ppvlist stream ("(fn ", "  | ",
                                            (fn stream => fn r =>
                                               prettyprint_rule context stream (r, d - 1); end; end ),
                                            trim rules);
                            rparen();
                            end_box stream;
                        };

                    prettyprint_expression' (ds::SOURCE_CODE_REGION_FOR_EXPRESSION (expression, (s, e)), atom, d)
                        =>
                        case source_opt
                            #
                            NULL
                                =>
                                prettyprint_expression'(expression, atom, d);

                            THE source
                                =>
                                {
                                     ppsay "<ds::SOURCE_CODE_REGION_FOR_EXPRESSION(";
                                     prpos (stream, source, s);
                                     ppsay ", ";
                                     prpos (stream, source, e);
                                     ppsay "): ";
                                     prettyprint_expression'(expression, FALSE, d);
                                     ppsay ">";
                                };
                        esac;
                end 

                also
                fun prettyprint_app_expression (_, _, _, 0)
                        =>
                        pp::string stream "<expression>";

                    prettyprint_app_expression arg
                        =>
                        {   ppsay = pp::string stream;

                            fun fixitypp (symbol, operand, left_fix, right_fix, d)
                                =
                                {   name
                                        =
                                        symbol_path::to_string
                                            (symbol_path::SYMBOL_PATH symbol);

                                    this_fix
                                        =
                                        case symbol
                                          
                                             [symbol] =>  get_fix (symbolmapstack, symbol);
                                             _        =>  NONFIX;
                                        esac;

                                    fun pr_non expression
                                        =
                                        {   open_style_box INCONSISTENT stream (pp::CURSOR_RELATIVE 2);
                                            ppsay name; break stream { spaces=>1, indent_on_wrap=>0 };
                                            prettyprint_expression'(expression, TRUE, d - 1);
                                            end_box stream;
                                        };

                                    case this_fix
                                      
                                         INFIX _
                                         =>
                                         case (strip_source_code_region_data operand)
                                             #
                                             ds::RECORD_IN_EXPRESSION [(_, pl), (_, pr)]
                                                 =>
                                                 {   atom =  stronger_l (left_fix, this_fix)
                                                          or stronger_r (this_fix, right_fix);

                                                     my (left, right)
                                                         =
                                                         atom   ??   (null_fix, null_fix )
                                                                ::   (left_fix, right_fix);

                                                     open_style_box INCONSISTENT stream (pp::CURSOR_RELATIVE 2);
                                                     ppsay "ds::RECORD_IN_EXPRESSION ";
                                                     lpcond (atom);
                                                     prettyprint_app_expression (pl, left, this_fix, d - 1);
                                                     break stream { spaces=>1, indent_on_wrap=>0 };
                                                     ppsay name;
                                                     break stream { spaces=>1, indent_on_wrap=>0 };
                                                     prettyprint_app_expression (pr, this_fix, right, d - 1);
                                                     rpcond (atom);
                                                     end_box stream;
                                                 };

                                             e' => pr_non e';
                                         esac;


                                         NONFIX => pr_non operand;
                                    esac;
                                };

                            fun apply_print (_, _, _, 0)
                                    =>
                                    ppsay "#";

                                apply_print (ds::APPLY_EXPRESSION (operator, operand), l, r, d)
                                    =>
                                    case (strip_source_code_region_data operator)
                                        #
                                        ds::VALCON_IN_EXPRESSION (ty::VALCON { name, ... }, _)
                                            =>
                                            fixitypp ([name], operand, l, r, d);

                                        ds::VARIABLE_IN_EXPRESSION (v, _)
                                            =>
                                            {   path =  case *v
                                                            vac::ORDINARY_VARIABLE { path=>symbol_path::SYMBOL_PATH path', ... } => path';
                                                            vac::OVERLOADED_IDENTIFIER { name, ... } => [name];
                                                            errorvar => [sy::make_value_symbol "<errorvar>"];
                                                        esac;

                                                fixitypp (path, operand, l, r, d);
                                            };

                                        operator
                                            =>
                                            {   open_style_box INCONSISTENT stream (pp::CURSOR_RELATIVE 2);
                                                prettyprint_expression'(operator, TRUE, d - 1);   break stream { spaces=>1, indent_on_wrap=>2 };
                                                prettyprint_expression'(operand,  TRUE, d - 1);
                                                end_box stream;
                                            };
                                    esac;

                                apply_print (ds::SOURCE_CODE_REGION_FOR_EXPRESSION (expression, (s, e)), l, r, d)
                                    =>
                                    case source_opt
                                        #
                                        NULL =>   apply_print (expression, l, r, d);
                                        #
                                        THE source
                                            =>
                                            if *internals
                                                #
                                                ppsay "<MARK(";
                                                prpos (stream, source, s); ppsay ", ";
                                                prpos (stream, source, e); ppsay "): ";
                                                prettyprint_expression'(expression, FALSE, d); ppsay ">";
                                            else
                                                apply_print (expression, l, r, d);
                                            fi;
                                    esac;


                                apply_print (e, _, _, d)
                                    =>
                                    prettyprint_expression'(e, TRUE, d);
                            end;

                            apply_print arg;
                        };
                end;
            
                (fn (expression, depth)
                    =
                    prettyprint_expression' (expression, FALSE, depth));
            }

        also
        fun prettyprint_rule (context as (symbolmapstack, source_opt)) stream (ds::CASE_RULE (pattern, expression), d)
            =
            if   (d > 0)
                
                 open_style_box  CONSISTENT  stream  (pp::CURSOR_RELATIVE 0);
                 pp::string  stream  "CASE_RULE ";
                 prettyprint_pattern  symbolmapstack  stream  (pattern, d - 1);
                 pp::string  stream  " =>";
                 break stream { spaces=>1,  indent_on_wrap=>2 };
                 prettyprint_expression  context  stream  (expression, d - 1);
                 end_box  stream;
            else
                 pp::string stream "<rule>";
            fi

        also
        fun prettyprint_named_value (context as (symbolmapstack, source_opt)) stream (ds::NAMED_VALUE { pattern, expression, bound_typevar_refs, ... }, d)
            =
            if   (d > 0)
                
                 open_style_box  CONSISTENT  stream  (pp::CURSOR_RELATIVE 0);
                 pp::string  stream  "ds::NAMED_VALUE { ";

                 pp::string  stream (sprintf "bound_typevar_refs => %d-entry list: "  (length  bound_typevar_refs));
                 apply unparse bound_typevar_refs
                 where
                     fun unparse  typevar_ref
                         =
                         prettyprint_type::prettyprint_typevar_ref
                             symbolmapstack
                             stream
                             typevar_ref;

#                        if_debugging_unparse_typevar_ref  ("", typevar_ref);
                 end;
                 pp::string  stream ",";
                 break stream { spaces=>1,  indent_on_wrap=>2 };

                 pp::string  stream  " pattern => ";
                 prettyprint_pattern  symbolmapstack  stream  (pattern, d - 1);
                 pp::string  stream  ",";
                 break stream { spaces=>1,  indent_on_wrap=>2 };
                 pp::string  stream  " expression => ";
                 prettyprint_expression  context  stream  (expression, d - 1);
                 end_box  stream;
            else
                 pp::string stream "<naming>";
            fi

        also
        fun prettyprint_recursively_named_value context stream (ds::NAMED_RECURSIVE_VALUES { variable=>var, expression, ... }, d)
            = 
            if (d > 0)
                #  
                open_style_box INCONSISTENT stream (pp::CURSOR_RELATIVE 0);
                unparse_var stream var; pp::string stream " =";
                break stream { spaces=>1, indent_on_wrap=>2 };
                prettyprint_expression context stream (expression, d - 1);
                end_box stream;
            else
                pp::string stream "<rec naming>";
            fi


        # NB: The original 1992 deep syntax unparser still exists, in
        #
        #     src/lib/compiler/src/print/unparse-interactive-deep-syntax-declaration.pkg
        #
        # It gets called only by
        #
        #     src/lib/compiler/toplevel/interact/read-eval-print-loop-g.pkg
        #  
        # which uses it to display the results of interactive expression evaluation. 
        #  
        # The more recent version here gets used for everything else.
        # It gets called from:
        #  
        #     src/lib/compiler/front/typer/main/type-core-language.pkg
        #     src/lib/compiler/toplevel/main/translate-raw-syntax-to-execode-g.pkg
        #     src/lib/compiler/toplevel/main/print-hooks.pkg
        #
        also
        fun prettyprint_declaration (context as (symbolmapstack, source_opt)) stream
            =
            {   ppsay = pp::string stream;

                fun prettyprint_declaration' (_, 0)
                        =>
                        ppsay "<declaration>";

                    prettyprint_declaration' (ds::VALUE_DECLARATIONS vbs, d)
                        =>
                        {   open_style_box CONSISTENT stream (pp::CURSOR_RELATIVE 0);

                            ppvlist stream ("my ", "also ",
                                (fn stream =  fn named_value =  prettyprint_named_value context stream (named_value, d - 1)), vbs);
                            end_box stream;
                        };

                    prettyprint_declaration' (ds::RECURSIVE_VALUE_DECLARATIONS rvbs, d)
                        =>
                        {   open_style_box CONSISTENT stream (pp::CURSOR_RELATIVE 0);
                            ppvlist stream ("my rec ", "also ",
                                (fn stream =  fn named_recursive_values =  prettyprint_recursively_named_value context stream (named_recursive_values, d - 1)), rvbs);
                            end_box stream;
                        };

                    prettyprint_declaration' (ds::TYPE_DECLARATIONS typs, d)
                        =>
                        {   fun f stream (ty::DEFINED_TYP { path, type_scheme=>ty::TYPE_SCHEME { arity, body }, ... } )
                                    =>
                                    {   case arity
                                            #
                                            0 => ();
                                            1 => ppsay "'a ";
                                            n => {   unparse_tuple stream pp::string (type_formals n); 
                                                     ppsay " ";
                                                 };
                                        esac;

                                        unparse_symbol
                                            stream
                                            (inverse_path::last path);

                                        ppsay " = ";

                                        prettyprint_type
                                            symbolmapstack
                                            stream
                                            body;
                                    };

                                f _ _
                                    =>
                                    bug "prettyprint_declaration' (TYPE_DECLARATIONS)";
                            end;

                            open_style_box CONSISTENT stream (pp::CURSOR_RELATIVE 0);

                            ppvlist stream (
                                "",                     # was "type "
                                " also ",
                                f,
                                typs
                            );
                            end_box stream;
                        };

                    prettyprint_declaration' (ds::ENUM_DECLARATIONS { datatyps, with_typs }, d)
                        =>
                        {   fun prettyprint_data stream (ty::PLAIN_TYP { path, arity, kind, ... } )
                                    =>
                                    case kind
                                        #
                                        ty::DATATYPE (_)
                                            =>
                                            {   case arity
                                                    #
                                                    0 => ();
                                                    1 => (ppsay "'a ");
                                                    n => { unparse_tuple stream pp::string (type_formals n); 
                                                           ppsay " ";
                                                         };
                                                 esac;

                                                 unparse_symbol stream (inverse_path::last path); ppsay " = ...";
                                            /* 

                                                 unparse_sequence
                                                     stream
                                                     {   sep = (fn stream => (pp::string stream " |";
                                                                     break stream { spaces=1, indent_on_wrap=0 } )),

                                                         pr  = (fn stream =
                                                                fn (ty::VALCON { name, ... } ) =>  
                                                                      unparse_symbol stream  name),

                                                         style = INCONSISTENT
                                                     }
                                                     dcons;
                                             */
                                            };

                                        _   =>
                                            bug "prettyprint_declaration'(ENUM_DECLARATIONS) 1.1";
                                   esac;

                               prettyprint_data _ _
                                   =>
                                   bug "prettyprint_declaration'(ENUM_DECLARATIONS) 1.2";
                            end;

                            fun prettyprint_with  stream  (ty::DEFINED_TYP { path, type_scheme=>ty::TYPE_SCHEME { arity, body }, ... } )
                                    =>
                                    {   case arity   
                                            0 => ();
                                            1 => (ppsay "'a ");
                                            n => { unparse_tuple stream pp::string (type_formals n); 
                                                   ppsay " ";};
                                        esac;

                                        unparse_symbol stream (inverse_path::last path);

                                        ppsay " = ";

                                        prettyprint_type  symbolmapstack  stream  body;
                                    };

                                prettyprint_with _ _
                                    =>
                                    bug "prettyprint_declaration'(ENUM_DECLARATIONS) 2";
                            end;

                            #  Could call PPDec::prettyprint_declaration here: 

                            open_style_box CONSISTENT stream (pp::CURSOR_RELATIVE 0);
                            ppvlist stream (
                                "",                     # Was "enum "
                                "also ",
                                prettyprint_data,
                                datatyps
                            );
                            newline stream;
                            ppvlist stream ("withtype ", "also ", prettyprint_with, with_typs);
                            end_box stream;
                        };

                    prettyprint_declaration' (ds::ABSTRACT_TYPE_DECLARATION _, d)
                        =>
                        ppsay "abstype";

                    prettyprint_declaration' (ds::EXCEPTION_DECLARATIONS ebs, d)
                        =>
                        {   fun f stream (   ds::NAMED_EXCEPTION {
                                                 exception_constructor =>  ty::VALCON { name, ... },
                                                 exception_type        =>  etype,
                                                 ...
                                             }
                                         )
                                    =>
                                    {   unparse_symbol  stream  name;

                                        case etype
                                            #
                                            NULL => ();

                                            THE type'
                                                =>
                                                {
#                                                    ppsay " of ";
                                                    prettyprint_type  symbolmapstack  stream  type';
                                                };
                                        esac;
                                    };

                                f stream (ds::DUPLICATE_NAMED_EXCEPTION { exception_constructor  =>  ty::VALCON { name, ... },
                                                                          equal_to               =>  ty::VALCON { name=>name', ... }
                                                                        }
                                         )
                                    =>
                                    {   unparse_symbol stream name;
                                        ppsay "=";
                                        unparse_symbol stream name';
                                    };
                            end;

                            open_style_box CONSISTENT stream (pp::CURSOR_RELATIVE 0);
                            ppvlist stream ("exception ", "also ", f, ebs);
                            end_box stream;
                        };

                    prettyprint_declaration' (ds::PACKAGE_DECLARATIONS sbs, d)
                        =>
                        {   fun f stream (ds::NAMED_PACKAGE { name_symbol=>name, a_package=>mld::A_PACKAGE { varhome, ... }, definition=>def } )
                                    =>
                                    {   unparse_symbol stream name;
                                        unparse_varhome stream varhome;
                                        ppsay " = ";
                                        break stream { spaces=>1, indent_on_wrap=>2 };
                                        prettyprint_package_expression context stream (def, d - 1);
                                    };

                                f _ _
                                    =>
                                    bug "prettyprint_declaration: PACKAGE_DECLARATION: NAMED_PACKAGE";
                            end;

                            open_style_box CONSISTENT stream (pp::CURSOR_RELATIVE 0);
                            ppvlist stream ("package ", "also ", f, sbs);
                            end_box stream;
                        };

                    prettyprint_declaration' (ds::GENERIC_DECLARATIONS fbs, d)
                        =>
                        {   fun f stream (ds::NAMED_GENERIC { name_symbol=>fname, a_generic => mld::GENERIC { varhome, ... }, definition=>def } )
                                    =>
                                    {   unparse_symbol stream fname;
                                        unparse_varhome stream varhome;
                                        ppsay " = "; 
                                        break stream { spaces=>1, indent_on_wrap=> 2 };
                                        prettyprint_generic_expression context stream (def, d - 1);
                                    };

                                f _ _
                                    =>
                                    bug "prettyprint_declaration': GENERIC_DECLARATION";
                            end;

                            open_style_box CONSISTENT stream (pp::CURSOR_RELATIVE 0);
                            ppvlist stream ("generic package ", "also ", f, fbs);
                            end_box stream;
                        };

                    prettyprint_declaration' (ds::API_DECLARATIONS sigvars, d)
                        =>
                        {   fun f stream (mld::API { name, ... } )
                                    =>
                                    {   ppsay "api "; 

                                        case name
                                          
                                             THE s =>  unparse_symbol stream s;
                                             NULL  =>  ppsay "ANONYMOUS";
                                        esac;
                                    };

                                f _ _
                                    =>
                                    bug "prettyprint_declaration': API_DECLARATIONS";
                            end;

                            open_style_box CONSISTENT stream (pp::CURSOR_RELATIVE 0);

                            unparse_sequence
                                stream
                                {   sep   => newline,
                                    pr    => f,
                                    style => CONSISTENT
                                }
                                sigvars;

                            end_box stream;
                        };

                    prettyprint_declaration'(ds::GENERIC_API_DECLARATIONS sigvars, d)
                        =>
                        {   fun f stream (mld::GENERIC_API { kind, ... } )
                                =>
                                {   ppsay "funsig "; 

                                    case kind   
                                        THE s => unparse_symbol stream s;
                                        NULL => ppsay "ANONYMOUS";
                                    esac;
                                };

                               f _ _
                                =>
                                bug "prettyprint_declaration': GENERIC_API_DECLARATIONS"; end;

                            open_style_box CONSISTENT stream (pp::CURSOR_RELATIVE 0);

                            unparse_sequence
                                stream
                                {   sep   => newline,
                                    pr    => f,
                                    style => CONSISTENT
                                }
                                sigvars;

                            end_box stream;
                        };

                    prettyprint_declaration' (ds::LOCAL_DECLARATIONS (inner, outer), d)
                        =>
                        {   open_style_box CONSISTENT stream (pp::CURSOR_RELATIVE 0);
                            ppsay "with";
                            newline_indent stream 2;
                            prettyprint_declaration'(inner, d - 1);
                            newline stream;
                            ppsay "do";
                            newline stream;
                            prettyprint_declaration'(outer, d - 1);
                            newline stream;
                            ppsay "end;";
                            end_box stream;
                        };

                    prettyprint_declaration' (ds::SEQUENTIAL_DECLARATIONS decs, d)
                        =>
                        {   open_style_box CONSISTENT stream (pp::CURSOR_RELATIVE 0);

                            unparse_sequence
                                stream
                                {   sep   => newline,
                                    pr    => (fn stream => fn declaration => prettyprint_declaration'(declaration, d); end; end ),
                                    style => CONSISTENT
                                }
                                decs;

                            end_box stream;
                        };

                    prettyprint_declaration' (ds::FIXITY_DECLARATION { fixity, ops }, d)
                        =>
                        {   open_style_box CONSISTENT stream (pp::CURSOR_RELATIVE 0);

                            case fixity
                                #                              
                                NONFIX => ppsay "nonfix ";

                                INFIX (i, _)
                                    => 
                                    {   if (i % 2 == 0)   ppsay "infix ";
                                        else              ppsay "infixr ";
                                        fi;

                                        if (i / 2 > 0)    ppsay (int::to_string (i / 2));
                                                          ppsay " ";
                                        fi;
                                    };
                            esac;

                            unparse_sequence
                               stream
                               {   sep   => (fn stream =  break stream { spaces=>1, indent_on_wrap=>0 }),
                                   pr    => unparse_symbol,
                                   style => INCONSISTENT
                               }
                               ops;

                            end_box stream;
                        };

                    prettyprint_declaration' (ds::OVERLOADED_VARIABLE_DECLARATION overloaded_variable, d)
                        =>
                        {   ppsay "overloaded my ";
                            unparse_var  stream  overloaded_variable;
                        };

                    prettyprint_declaration' (ds::INCLUDE_DECLARATIONS named_packages, d)
                        =>
                        {   open_style_box CONSISTENT stream (pp::CURSOR_RELATIVE 0);
                            ppsay "use ";
                            unparse_sequence
                                stream
                                {   sep   => (fn stream =  break stream { spaces=>1, indent_on_wrap=>0 }  ),
                                    pr    => (fn stream =  fn (sp, _) =  ppsay (symbol_path::to_string sp)),
                                    style => INCONSISTENT
                                }
                                named_packages;

                            end_box stream;
                        };

                    prettyprint_declaration' (ds::SOURCE_CODE_REGION_FOR_DECLARATION (declaration, (s, e)), d)
                        => 
                        case source_opt
                          
                             NULL
                                 =>
                                 prettyprint_declaration'(declaration, d);

                             THE source
                                 =>
                                 {
#                                    2007-09-14CrT: Source region stuff commented out because it clutters the printout horribly:
#                                    ppsay "ds::SOURCE_CODE_REGION_FOR_DECLARATION(";

                                     prettyprint_declaration'(declaration, d);

#                                    ppsay ", ";
#                                    prpos (stream, source, s);         # "s" for "start"
#                                    ppsay ", ";
#                                    prpos (stream, source, e);         # "e" for "end"
#                                    ppsay ")";
                                 };
                        esac;
                  end;

              
                  prettyprint_declaration';
              }

        also
        fun prettyprint_package_expression (context as (_, source_opt)) stream
            =
            {    ppsay   =   pp::string stream;

                fun prettyprint_package_expression' (_, 0)
                        =>
                        ppsay "<package_expression>";

                    prettyprint_package_expression' (ds::PACKAGE_BY_NAME (mld::A_PACKAGE { varhome, ... } ), d)
                        =>
                        unparse_varhome stream varhome;

                    prettyprint_package_expression'
                        (
                            ds::COMPUTED_PACKAGE {
                                a_generic        => mld::GENERIC   { varhome => fa, ... },
                                generic_argument => mld::A_PACKAGE { varhome => sa, ... },
                                ...
                            },
                            d
                        )
                        =>
                        {   unparse_varhome stream fa;
                            ppsay"(";
                            unparse_varhome stream sa;
                            ppsay")";
                        };

                    prettyprint_package_expression' (ds::PACKAGE_DEFINITION namings, d)
                        =>
                        {   open_style_box CONSISTENT stream (pp::CURSOR_RELATIVE 0);
                            ppsay "pkg"; newline_indent stream 2;
                            ppsay "...";
                            #  unparse_naming not yet undefined 
                            /*
                               unparse_sequence stream
                                 { sep=newline,
                                  pr=(fn stream => fn b => unparse_naming context stream (b, d - 1)),
                                  style=CONSISTENT }
                               namings;
                             */
                            ppsay "end";
                            end_box stream;
                        };

                    prettyprint_package_expression' (ds::PACKAGE_LET { declaration, expression }, d)
                        =>
                        {   open_style_box CONSISTENT stream (pp::CURSOR_RELATIVE 0);
                            ppsay "stipulate ";
                            newline stream;
                            prettyprint_declaration context stream (declaration, d - 1); 
                            newline stream;
                            ppsay "herein";
                            newline stream;
                            prettyprint_package_expression'(expression, d - 1);
                            newline stream;
                            ppsay "end;";
                            end_box stream;
                        };

                    prettyprint_package_expression' (ds::SOURCE_CODE_REGION_FOR_PACKAGE (body, (s, e)), d)
                        =>
                        case source_opt
                            #                     
                            THE source
                                =>
                                {
#                                   2007-09-14CrT: Source region stuff commented out because it clutters the printout horribly:
#                                   ppsay "SOURCE_CODE_REGION_FOR_PACKAGE(";

                                    prettyprint_package_expression'(body, d);

#                                   ppsay ", ";
#                                   prpos (stream, source, s);                  # "s" for "start"
#                                   ppsay ", ";
#                                   prpos (stream, source, e);                  # "e" for "end"
#                                   ppsay ")";
                                };

                            NULL =>   prettyprint_package_expression'(body, d);
                        esac;

                    prettyprint_package_expression' _
                        =>
                        bug "unexpected package expression in prettyprintStrexp'";
                end;

            
                prettyprint_package_expression';
            }

        also
        fun prettyprint_generic_expression (context as (_, source_opt)) stream
            = 
            prettyprint_generic_expression'
            where
                ppsay   =   pp::string stream;

                fun prettyprint_generic_expression' (_, 0)
                        =>
                        ppsay "<generic_expression>";

                    prettyprint_generic_expression' (ds::GENERIC_BY_NAME (mld::GENERIC { varhome, ... } ), d)
                        =>
                        unparse_varhome stream varhome;

                    prettyprint_generic_expression' (ds::GENERIC_DEFINITION { parameter=>mld::A_PACKAGE { varhome, ... }, definition=>def, ... }, d)
                        =>
                        {   ppsay " GENERIC("; 
                            unparse_varhome  stream  varhome;
                            ppsay ") => "; newline stream;
                            prettyprint_package_expression context stream (def, d - 1);
                        };

                    prettyprint_generic_expression' (ds::GENERIC_LET (declaration, body), d)
                        =>
                        {   open_style_box CONSISTENT stream (pp::CURSOR_RELATIVE 0);
                            ppsay "stipulate ";
                            prettyprint_declaration context stream (declaration, d - 1); 
                            newline stream;
                            ppsay "herein";
                            newline stream;
                            prettyprint_generic_expression'(body, d - 1);
                            newline stream;
                            ppsay "end;";
                            end_box stream;
                        };

                    prettyprint_generic_expression' (ds::SOURCE_CODE_REGION_FOR_GENERIC (body, (s, e)), d)
                        =>
                        case source_opt
                            #                     
                            THE source
                                =>
                                {
#                                   2007-09-14CrT: Source region stuff commented out because it clutters the printout horribly:
#                                   ppsay "SOURCE_CODE_REGION_FOR_GENERIC(";

                                    prettyprint_generic_expression'(body, d); ppsay ", ";

#                                   prpos (stream, source, s); ppsay ", ";
#                                   prpos (stream, source, e); ppsay ")";
                                };

                            NULL =>   prettyprint_generic_expression'(body, d);
                        esac;

                    prettyprint_generic_expression' _
                        =>
                        bug "unexpected generic package expression in prettyprint_generic_expression'";
                end;
            end;
    };                                  #  package unparse_deep_syntax 
end;                                    #  top-level stipulate









Comments and suggestions to: bugs@mythryl.org

PreviousUpNext