PreviousUpNext

15.4.703  src/lib/compiler/toplevel/main/global-controls.pkg

## global-controls.pkg
#
# This is the old compiler-switches system, based on using
# bazillions of icky thread-hostile global variables.
#
# (I want to develop a replacement based on a red-black
# tree that lives in per-compile-stuff. -- 2011-10-02 CrT)

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


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   global_controls
    : (weak)  Global_Controls                                           # Global_Controls               is from   src/lib/compiler/toplevel/main/global-controls.api
    {
        stipulate
            #
            menu_slot =  [10, 10, 9];
            obscurity =  4;
            prefix    =  "controls";

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

                                                                     my _ = 
            basic_control::note_subindex (prefix, registry, menu_slot);

            convert_boolean =  cj::cvt::bool;

            next_menu_slot = REF 0;

            fun make (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  convert_boolean  control,
                            dictionary_name =>  THE (cj::dn::to_upper "CONTROL_" name)
                        };
                    r;
                };
        herein

            package print: (weak)  Control_Print                        # Control_Print                 is from   src/lib/compiler/front/basics/print/control-print.pkg
                =
                control_print;                                          # control_print                 is from   src/lib/compiler/front/basics/print/control-print.pkg


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


            package lowhalf
                =
                lowhalf_control;                                        # lowhalf_control               is from   src/lib/compiler/back/low/control/lowhalf-control.pkg


            package highcode : Anormcode_Sequencer_Controls             # Anormcode_Sequencer_Controls  is from   src/lib/compiler/toplevel/main/control-apis.api
                =
                anormcode_sequencer_controls;


            package compiler: (weak)  Compiler_Controls                 # Compiler_Controls             is from   src/lib/compiler/toplevel/main/control-apis.api
                =
                compiler_controls;                                      # compiler_controls             is from   src/lib/compiler/toplevel/main/compiler-controls.pkg


            include package   basic_control;                            # Provides: print_warnings = REF TRUE  


            include package   mythryl_parser;                           # Provides: primary_prompt = REF "- ";
                                                                        #           secondary_prompt = REF "= ";
                                                                        #           lazy_is_a_keyword = REF FALSE;
                                                                        #           quotation = REF FALSE;


            remember_highcode_codetemp_names = typer_data_controls::remember_highcode_codetemp_names;

            value_restriction_local_warn   =   typer_control::value_restriction_local_warn;
            value_restriction_top_warn     =   typer_control::value_restriction_top_warn;

            mult_def_warn     =   typer_control::mult_def_warn;
            share_def_error   =   typer_control::share_def_error;
            macro_expand_sigs =   typer_control::macro_expand_sigs;

            debugging = make ("debugging", "?", FALSE);

            execute_compiled_code       =   make ("execute_compiled_code",    "?", TRUE);
            unparse_raw_syntax_tree     =   make ("unparse_raw_syntax_tree",  "?", FALSE);
            unparse_deep_syntax_tree    =   make ("unparse_deep_syntax_tree", "?", FALSE);

            prettyprint_raw_syntax_tree =   make ("prettyprint_raw_syntax_tree",  "?", FALSE);

            internals   =   typer_control::internals;
            interp      =   make ("interp", "?", FALSE);      #  Turn on interpreter -- defunct 
          /*
            debugLook = REF FALSE
            debugCollect = REF FALSE
            debugBind = REF FALSE
          */
            mark_deep_syntax_tree = typer_control::mark_deep_syntax_tree;

            track_exn
                =
                make ("track_exn",
                     "whether to generate code that tracks exceptions", TRUE);

            # Warning message when call of poly_equal compiled:
            #
            poly_eq_warn
                =
                make ("poly_eq_warn", "whether to warn about calls of poly_equal", FALSE);

            indexing  = make ("indexing", "?", FALSE);
            inst_sigs = make ("inst_sigs", "?", TRUE);

            preserve_lvar_names = make ("preserve_lvar_names", "?", FALSE);

            #  These are really all the same REF cell: 
            #
            my saveit:                  Ref( Bool ) = remember_highcode_codetemp_names;
            my save_deep_syntax_tree:   Ref( Bool ) = saveit;
            my save_lambda:             Ref( Bool ) = saveit;
            my save_convert:            Ref( Bool ) = saveit;
            my save_nextcode:           Ref( Bool ) = saveit;           # Never referenced.
            my save_closure:            Ref( Bool ) = saveit;

            package inline {
                #
                Global_Setting
                  = OFF
                  | DEFAULT  Null_Or(Int)
                  ;

                Localsetting
                    =
                    Null_Or( Null_Or(Int) );

                my use_default:  Localsetting
                    =
                    NULL;

                fun suggest s:      Localsetting
                    =
                    THE s;

                fun parse "off" =>  THE OFF;
                    parse "on"  =>  THE (DEFAULT NULL);
                    parse s     =>  null_or::map (DEFAULT o THE) (int::from_string s);
                end;

                fun show OFF               =>  "off";
                    show (DEFAULT NULL)    =>  "on";
                    show (DEFAULT (THE i)) =>  int::to_string i;
                end;

                stipulate
                    registry
                        =
                        ci::make
                            { help => "cross-module inlining" };

                    menu_slot = [10, 10, 0, 1];
                                                                                                my _ = 
                    basic_control::note_subindex ("inline", registry, menu_slot);

                    convert = { name_of_type   =>  "controls::inline::Global_Setting",
                                from_string =>  parse, 
                                to_string   =>  show
                              };

                    state_r   =   REF (DEFAULT NULL);

                    control
                        =
                        ctl::make_control
                          {
                            name      =>  "inlining_aggressiveness",
                            menu_slot =>  [0],
                            help      =>  "aggressiveness of function-inliner",
                            control   =>  state_r,
                            obscurity =>  1
                          };

                                                      my _ =
                    ci::note_control
                        registry
                        { control         =>   ctl::make_string_control  convert control,
                          dictionary_name =>   THE "INLINE_SPLIT_AGGRESSIVENESS"
                        };
                herein
                    fun set x
                        =
                        ctl::set (control, x);

                    fun get ()
                        =
                        case (ctl::get  control)
                            #
                            OFF       =>  NULL;
                            DEFAULT d =>  d;
                        esac;

                    fun get' NULL    =>  get ();
                        get' (THE a) =>  case (ctl::get control)
                                             #
                                             OFF       =>  NULL;
                                             DEFAULT _ =>  a;
                                         esac;
                    end;
                end;
            };

            tdp_instrument_enabled
                =
                tdp_instrument::tdp_instrument_enabled;         # tdp_instrument        is from   src/lib/compiler/debugging-and-profiling/profiling/tdp-instrument.pkg

        end; #  with
    };
end;


Comments and suggestions to: bugs@mythryl.org

PreviousUpNext