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

## typer-debugging.pkg

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

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

    api Typer_Debugging {
        #
        debug_print:  Ref( Bool )
                     -> ( (String,
                         (pp::Prettyprinter -> X -> Void),
                         X)
                        )
                     -> Void;

        prettyprint_symbol_list:  pp::Prettyprinter
                                  -> List( sy::Symbol )
                                  -> Void;

        symbolmapstack_symbols:  syx::Symbolmapstack
                                 -> List( sy::Symbol );

        check_symbolmapstack:  (syx::Symbolmapstack, sy::Symbol)
                               -> String;

        with_internals:  (Void -> X)
                         -> X;
    };                                                                          #  Api Typer_Debugging 
end;



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

    Pp = pp::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::Prettyprinter -> X -> Void,
                         arg:       X
                       )
            =
            if *debugging
                #
                pp::with_standard_prettyprinter
                    #
                    (err::default_plaint_sink())        []
                    #
                    (\\ pp:   pp::Prettyprinter
                        =
                        {   pp.box' 0 -1 {.                                                     pp.rulename "tdbg1";
                                pp.lit msg;
                                pp.ind 4;
                                printfn pp arg;
                            };
                            pp.newline();
                            pp.flush  ();
                        }
                      );
            fi;

        fun prettyprint_symbol_list  pp  (syms: List( sy::Symbol ))
            = 
            uj::unparse_closed_sequence
                #
                pp
                #
                { front      =>   \\ pp =  pp.txt "[ ",
                  separator  =>   \\ pp =  pp.txt ", ",
                  back       =>   \\ pp =  pp.txt " ]",
                  #
                  breakstyle =>  uj::ALIGN,
                  print_one  =>  uj::unparse_symbol
                }

                syms;


        # More debugging: 

        fun symbolmapstack_symbols (symbolmapstack: syx::Symbolmapstack)
            =
            syx::fold   (\\ ((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()
                    then
                        typer_control::internals := internals
                )
                except
                    exn = {   typer_control::internals := internals;
                              raise exception exn;
                          };
            };

    };          # package typer_debugging 
end;            # stipulate