15.4.550  src/lib/compiler/front/basics/print/control-print.pkg

## control-print.pkg

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



###               "The limits of my language are the limits of my world."
###
###                                        -- Ludwig Wittgenstein



api Control_Print {
    #
    print_depth:    Ref( Int  );
    print_length:   Ref( Int  );
    string_depth:   Ref( Int  );
    integer_depth:  Ref( Int  );

    print_loop:     Ref( Bool );

    apis:           Ref( Int  );
    print_includes: Ref( Bool );

    out :
        Ref {
          say:     String -> Void,
          flush:   Void -> Void
        }; 

    linewidth:     Ref(  Int );
    say:           String -> Void; 
    flush:         Void -> Void;
};


###            "I never guess. It is a shocking
###             habit -- destructive to the
###             logical faculty."
###
###                           -- "Sherlock Holmes"


stipulate
    package bc  =  basic_control;                                       # basic_control                 is from   src/lib/compiler/front/basics/main/basic-control.pkg
    package ci  =  global_control_index;                                # global_control_index          is from   src/lib/global-controls/global-control-index.pkg
    package cj  =  global_control_junk;                                 # global_control_junk           is from   src/lib/global-controls/global-control-junk.pkg
    package ctl =  global_control;                                      # global_control                is from   src/lib/global-controls/global-control.pkg
    package fil =  file__premicrothread;                                # file__premicrothread          is from   src/lib/std/src/posix/file--premicrothread.pkg
herein

    package   control_print
    : (weak)  Control_Print                                             # Control_Print                 is from   src/lib/compiler/front/basics/print/control-print.pkg
    {
        menu_slot =  [10, 10, 2];
        obscurity =  2;
        prefix    =  "print";

        registry = ci::make { help => "compiler print settings" };
                                                                                    my _ = 
        bc::note_subindex (prefix, registry, menu_slot);

        convert_boolean =  cj::cvt::bool;
        convert_int     =  cj::cvt::int;

        next_menu_slot = REF 0;

        fun new (c, name, help, d)
            =
            {   r         =   REF d;
                menu_slot =   *next_menu_slot;

                control =   ctl::make_control
                              {
                                name,
                                menu_slot => [menu_slot],
                                obscurity,
                                help,
                                control => r
                              };

                next_menu_slot := menu_slot + 1;

                ci::note_control
                    #
                    registry
                    #
                    { control         =>  ctl::make_string_control c control,
                      dictionary_name =>  THE  (cj::dn::to_upper "PRINT_"  name)
                    };

                r;
            };

        print_depth    =  new (convert_int,     "depth",          "max print depth",                     20 );
        print_length   =  new (convert_int,     "length",         "max print length",                  2000 );
        string_depth   =  new (convert_int,     "string_depth",   "max string print depth",             700 );
        integer_depth  =  new (convert_int,     "integer_depth",  "max multiword_int::Int print depth",  70 );
        print_loop     =  new (convert_boolean, "loop",           "print loop",                        TRUE ); #  ? 
        apis           =  new (convert_int,     "apis",           "max api expansion depth",              2 ); #  ? 
        print_includes =  new (convert_boolean, "print_includes", "print `include'",                   TRUE );
        linewidth      =  new (convert_int,     "linewidth",      "line-width hint for pretty printer", 200 );

    # XXX BUGGO FIXME This stuff is mainly (only?) used for compiler
    #                 error messages, so it probably should be going
    #             to stderr instead of stdout.
    # 
        out = REF { say   =>  \\ s  =  fil::write (fil::stdout, s),
                    flush =>  \\ () =  fil::flush  fil::stdout
                  };



    #    fun say s     =   .say   *out s;
        fun flush ()   =   .flush *out ();

        fun say s
            =
            {
                .say   *out s;
            };

    };
end;

## (C) 2001 Lucent Technologies, Bell Labs
## Subsequent changes by Jeff Prothero Copyright (c) 2010-2015,
## released per terms of SMLNJ-COPYRIGHT.