## 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.sublibstipulate
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.pkgherein
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;