15.4.650  src/lib/compiler/front/typer/main/typer-debugging.pkg

## typer-debugging.pkg

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

api Typer_Debugging {

     debug_print:  Ref( Bool )
                  -> ( (String,
                      (prettyprint::Stream -> X -> Void),
                      X)
                     )
                  -> Void;

     prettyprint_symbol_list:  prettyprint::Stream
                             -> List( symbol::Symbol )
                             -> Void;

     symbolmapstack_symbols:  symbolmapstack::Symbolmapstack
                          -> List( symbol::Symbol );

     check_symbolmapstack:  (symbolmapstack::Symbolmapstack,
                          symbol::Symbol)
                        -> String;

     with_internals:  (Void -> X)
                     -> X;

}; #  Api Typer_Debugging 




stipulate
    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 pp  =  prettyprint;                                                 # prettyprint                   is from   src/lib/prettyprint/big/src/prettyprint.pkg
    package ppu =  unparse_junk;                                                # unparse_junk                  is from   src/lib/compiler/front/typer/print/unparse-junk.pkg
    package err =  error_message;                                               # error_message                 is from   src/lib/compiler/front/basics/errormsg/error-message.pkg

    include pp;
herein 

    package  typer_debugging
    : (weak) Typer_Debugging                                            # Typer_Debugging               is from   src/lib/compiler/front/typer/main/typer-debugging.pkg
    {

        fun debug_print (debugging: Ref( Bool ))
                       ( msg:       String,
                         printfn:   pp::Stream -> X -> Void,
                         arg:       X
                       )
            =
            if *debugging
                #
                with_prettyprint_device (err::default_plaint_sink())
                  (fn stream
                    =
                    {   begin_horizontal_else_vertical_box stream;
                        pp::string stream msg;
                        newline stream;
                        pp::nonbreakable_spaces stream 2;
                        begin_horizontal_else_vertical_box stream;
                        printfn stream arg;
                        end_box stream;
                        newline stream;
                        end_box stream;
                        pp::flush_stream stream;
                    }
                  );
            fi;

        fun prettyprint_symbol_list stream (syms: List( sy::Symbol ))
            = 
            ppu::unparse_closed_sequence

                stream

                { front => (fn stream =  pp::string stream "["),
                  sep   => (fn stream = (pp::string stream ", ")),
                  back  => (fn stream =  pp::string stream "]"),
                  style => ppu::INCONSISTENT,
                  pr    => ppu::unparse_symbol
                }

                syms;


        #  More debugging: 

        fun symbolmapstack_symbols (symbolmapstack: syx::Symbolmapstack)
            =
            syx::fold   (fn ((s, _), sl) =  s ! sl)   NIL   symbolmapstack;

        fun check_symbolmapstack (   symbolmapstack: syx::Symbolmapstack,
                                 symbol:      sy::Symbol
                     )
            =
            {   syx::get (symbolmapstack, symbol);
               "YES";
            }
            except
                syx::UNBOUND
                =>
                "NO"; end ;

        fun with_internals (f: Void -> X)
            =
            {   internals   =   *typer_control::internals;

                typer_control::internals := TRUE;

                (   f()
                    before
                        typer_control::internals := internals
                )
                except
                    exn = {   typer_control::internals := internals;
                              raise exception exn;
                          };
            };

    };          # package typer_debugging 
end;            # stipulate