15.4.704  src/lib/compiler/toplevel/main/match-compiler-controls.pkg

## match-compiler-controls.pkg

# Compiled by:
#     src/lib/compiler/core.sublib



###               "The more I ponder the principles of language design,
###                and the techniques which put them into practice,
###                the more is my amazement and admiration of ALGOL 60.
###
###               "Here is a language so far ahead of its time,
###                that it was not only an improvement on its predecessors,
###                but also on nearly all its successors.
###
###               "Of particular interest are its introduction of all the
###                main program structuring concepts, the simplicity and
###                clarity of its description, rarely equalled and never
###                surpassed.
###
###               "Consider especially the avoidance of abbreviation in the
###                syntax names and equations, and the inclusion of examples
###                in every section."
###
###                                                -- C. A. R. Hoare, 1973



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
herein

    package  match_compiler_controls
    : (weak) Match_Compiler_Controls                                            # Match_Compiler_Controls       is from   src/lib/compiler/toplevel/main/control-apis.api
    {
        #
        #

        menu_slot = [10, 10, 4];
        obscurity = 2;
        prefix    = "compiler_mc";

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

        convert_boolean =  cj::cvt::bool;

        next_menu_slot =  REF 0;                                                        # XXX BUGGO FIXME more icky mutable global state :(

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

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

                next_menu_slot :=  menu_slot + 1;

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

                r;
            };

        print_args =  make_bool ("print_args", "arguments print mode", FALSE);
        print_ret  =  make_bool ("print_ret",  "return print mode",    FALSE);

        bind_no_variable_warn
            =
            make_bool ("bind_no_variable_warn", "whether to warn if no variables get bound",
                  FALSE);

        warn_on_nonexhaustive_bind
            =
            make_bool ("warn_on_nonexhaustive_bind",
                  "whether to warn on non-exhaustive bind", TRUE);

        error_on_nonexhaustive_bind
            =
            make_bool ("error_on_nonexhaustive_bind",
                  "whether non-exhaustive bind is an error", FALSE);

        warn_on_nonexhaustive_match
            =
            make_bool ("warn_on_nonexhaustive_match",
                  "whether to warn on non-exhaustive match", TRUE);

        error_on_nonexhaustive_match
            =
            make_bool ("error_on_nonexhaustive_match",
                  "whether non-exhaustive match is an error", FALSE);

        #  matchExhaustiveError overrides matchExhaustiveWarn 

        warn_on_redundant_match
            =
            make_bool ("warn_on_redundant_match", "whether to warn on redundant matches", TRUE);

        error_on_redundant_match
            =
            make_bool ("error_on_redundant_match", "whether a redundant match is an error", TRUE);

        #  error_on_redundant_match overrides warn_on_redundant_match 
    /*
        expand_result =
            make_bool ("expand_result", "whether to expand result of match", FALSE)
    */
    };
end;