15.4.540  src/lib/compiler/front/basics/main/basic-control.pkg

## basic-control.pkg
## (C) 2001 Lucent Technologies, Bell Labs

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



###             "Alas, I am dying beyond my means."
###
###                          -- Oscar Wilde,
###                             as he sipped champagne
###                             on his deathbed



stipulate
    package ci  =  global_control_index;                                # global_control_index          is from   src/lib/global-controls/global-control-index.pkg
    package ctl =  global_control;                                      # global_control                is from   src/lib/global-controls/global-control.pkg
herein

    api Basic_Control {
        #
        #
        print_warnings: Ref( Bool );                                    #  If FALSE, suppress all warning messages 

        top_index:      ci::Global_Control_Index;                       #  The top-level registry of the compiler.


        #  Nest a tier-2 registry within the top-level registry: 

        note_subindex
            :
            ( String,
              ci::Global_Control_Index,
              ctl::Menu_Slot
            )
            ->
            Void;
    };
end;



stipulate
    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   basic_control
    : (weak)  Basic_Control
    {
        top_index                                                       # XXX BUGGO FIXME more icky thread-hostile mutable toplevel state -- should be part of a compiler state record.
            =
            ci::make { help => "Compiler controls" };

        registry
            =
            ci::make { help => "compiler settings" };

        fun note_subindex (prefix, reg, menu_slot)
            =
            ci::note_subindex
                #
                top_index
                    {
                      prefix => THE prefix,
                      menu_slot,
                      obscurity => 0,
                      reg
                    };


                                                                                    my _ = 
        note_subindex ("basic", registry, [10, 10, 1]);

        print_warnings
            =
            r
            where
                r = REF TRUE;

                control
                    =
                    ctl::make_control
                      {
                        name      =>  "print_warnings",
                        menu_slot =>  [0],
                        obscurity =>  1,
                        help      =>  "whether warnings get generated",
                        control   =>  r
                      };

                sctl =  ctl::make_string_control
                            #
                            cj::cvt::bool
                            #
                            control;

                ci::note_control  registry
                  {
                    control         =>  sctl,
                    dictionary_name =>  THE "PRINT_CONTROL"
                  };
            end;
    };
end;