1/*  Part of CHR (Constraint Handling Rules)
    2
    3    Author:        Tom Schrijvers
    4    E-mail:        Tom.Schrijvers@cs.kuleuven.be
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (c)  2005-2011, K.U. Leuven
    7    All rights reserved.
    8
    9    Redistribution and use in source and binary forms, with or without
   10    modification, are permitted provided that the following conditions
   11    are met:
   12
   13    1. Redistributions of source code must retain the above copyright
   14       notice, this list of conditions and the following disclaimer.
   15
   16    2. Redistributions in binary form must reproduce the above copyright
   17       notice, this list of conditions and the following disclaimer in
   18       the documentation and/or other materials provided with the
   19       distribution.
   20
   21    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   22    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   23    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   24    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   25    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   26    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   27    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   28    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   29    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   30    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   31    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   32    POSSIBILITY OF SUCH DAMAGE.
   33*/
   34
   35:- module(chr_compiler_options,
   36	[ handle_option/2
   37	, init_chr_pp_flags/0
   38	, chr_pp_flag/2
   39	]).

   47local_current_prolog_flag(X,Y) :- current_prolog_flag(X,Y).

   51:- use_module(chr_compiler_errors).   52
   53%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   54% Global Options
   55%
   56
   57handle_option(Name,Value) :-
   58	var(Name), !,
   59	chr_error(syntax((:- chr_option(Name,Value))),'First argument should be an atom, not a variable.\n',[]).
   60
   61handle_option(Name,Value) :-
   62	var(Value), !,
   63	chr_error(syntax((:- chr_option(Name,Value))),'Second argument cannot be a variable.\n',[]).
   64
   65handle_option(Name,Value) :-
   66	option_definition(Name,Value,Flags),
   67	!,
   68	set_chr_pp_flags(Flags).
   69
   70handle_option(Name,Value) :-
   71	\+ option_definition(Name,_,_), !,
   72	chr_error(syntax((:- chr_option(Name,Value))),'Invalid option name ~w: consult the manual for valid options.\n',[Name]).
   73
   74handle_option(Name,Value) :-
   75	chr_error(syntax((:- chr_option(Name,Value))),'Invalid option value ~w: consult the manual for valid option values.\n',[Value]).
   76
   77option_definition(optimize,experimental,Flags) :-
   78	Flags = [ functional_dependency_analysis  - on,
   79                  check_unnecessary_active - full,
   80		  reorder_heads		   - on,
   81		  set_semantics_rule	   - on,
   82		  storage_analysis	   - on,
   83		  guard_via_reschedule     - on,
   84		  guard_simplification	   - on,
   85		  check_impossible_rules   - on,
   86		  occurrence_subsumption   - on,
   87		  observation_analysis	   - on,
   88		  ai_observation_analysis  - on,
   89		  late_allocation	   - on,
   90		  reduced_indexing	   - on,
   91		  term_indexing		   - on,
   92                  inline_insertremove      - on,
   93		  mixed_stores		   - on
   94		].
   95option_definition(optimize,full,Flags) :-
   96	Flags = [ functional_dependency_analysis  - on,
   97                  check_unnecessary_active - full,
   98		  reorder_heads		   - on,
   99		  set_semantics_rule	   - on,
  100		  storage_analysis	   - on,
  101		  guard_via_reschedule     - on,
  102		  guard_simplification	   - on,
  103		  check_impossible_rules   - on,
  104		  occurrence_subsumption   - on,
  105		  observation_analysis	   - on,
  106		  ai_observation_analysis  - on,
  107		  late_allocation	   - on,
  108		  reduced_indexing	   - on,
  109                  inline_insertremove      - on,
  110		  mixed_stores		   - off,
  111		  debugable		   - off
  112		].
  113
  114option_definition(optimize,off,Flags) :-
  115	Flags = [ functional_dependency_analysis  - off,
  116                  check_unnecessary_active - off,
  117		  reorder_heads		   - off,
  118		  set_semantics_rule	   - off,
  119		  storage_analysis	   - off,
  120		  guard_via_reschedule     - off,
  121		  guard_simplification	   - off,
  122		  check_impossible_rules   - off,
  123		  occurrence_subsumption   - off,
  124		  observation_analysis     - off,
  125		  ai_observation_analysis  - off,
  126		  late_allocation	   - off,
  127		  reduced_indexing	   - off
  128		].
  129
  130option_definition(functional_dependency_analysis,on,Flags) :-
  131	Flags = [ functional_dependency_analysis - on ].
  132option_definition(functional_dependency_analysis,off,Flags) :-
  133	Flags = [ functional_dependency_analysis - off ].
  134
  135option_definition(set_semantics_rule,on,Flags) :-
  136	Flags = [ set_semantics_rule - on ].
  137option_definition(set_semantics_rule,off,Flags) :-
  138	Flags = [ set_semantics_rule - off ].
  139
  140option_definition(check_unnecessary_active,full,Flags) :-
  141	Flags = [ check_unnecessary_active - full ].
  142option_definition(check_unnecessary_active,simplification,Flags) :-
  143	Flags = [ check_unnecessary_active - simplification ].
  144option_definition(check_unnecessary_active,off,Flags) :-
  145	Flags = [ check_unnecessary_active - off ].
  146
  147option_definition(check_guard_bindings,on,Flags) :-
  148	Flags = [ guard_locks - on ].
  149option_definition(check_guard_bindings,off,Flags) :-
  150	Flags = [ guard_locks - off ].
  151option_definition(check_guard_bindings,error,Flags) :-
  152	Flags = [ guard_locks - error ].
  153
  154option_definition(reduced_indexing,on,Flags) :-
  155	Flags = [ reduced_indexing - on ].
  156option_definition(reduced_indexing,off,Flags) :-
  157	Flags = [ reduced_indexing - off ].
  158
  159option_definition(storage_analysis,on,Flags) :-
  160	Flags = [ storage_analysis - on ].
  161option_definition(storage_analysis,off,Flags) :-
  162	Flags = [ storage_analysis - off ].
  163
  164option_definition(guard_simplification,on,Flags) :-
  165	Flags = [ guard_simplification - on ].
  166option_definition(guard_simplification,off,Flags) :-
  167	Flags = [ guard_simplification - off ].
  168
  169option_definition(check_impossible_rules,on,Flags) :-
  170	Flags = [ check_impossible_rules - on ].
  171option_definition(check_impossible_rules,off,Flags) :-
  172	Flags = [ check_impossible_rules - off ].
  173
  174option_definition(occurrence_subsumption,on,Flags) :-
  175	Flags = [ occurrence_subsumption - on ].
  176option_definition(occurrence_subsumption,off,Flags) :-
  177	Flags = [ occurrence_subsumption - off ].
  178
  179option_definition(late_allocation,on,Flags) :-
  180	Flags = [ late_allocation - on ].
  181option_definition(late_allocation,off,Flags) :-
  182	Flags = [ late_allocation - off ].
  183
  184option_definition(inline_insertremove,on,Flags) :-
  185	Flags = [ inline_insertremove - on ].
  186option_definition(inline_insertremove,off,Flags) :-
  187	Flags = [ inline_insertremove - off ].
  188
  189option_definition(type_definition,TypeDef,[]) :-
  190	( nonvar(TypeDef) ->
  191	TypeDef = type(T,D),
  192	chr_translate:type_definition(T,D)
  193	; true).
  194option_definition(type_declaration,TypeDecl,[]) :-
  195	( nonvar(TypeDecl) ->
  196	functor(TypeDecl,F,A),
  197	TypeDecl =.. [_|ArgTypes],
  198	chr_translate:constraint_type(F/A,ArgTypes)
  199	; true).
  200	
  201option_definition(mode,ModeDecl,[]) :-
  202	( nonvar(ModeDecl) ->
  203	functor(ModeDecl,F,A),
  204	ModeDecl =.. [_|ArgModes],
  205	chr_translate:constraint_mode(F/A,ArgModes)
  206	; true).
  207option_definition(store,FA-Store,[]) :-
  208	chr_translate:store_type(FA,Store).
  209
  210%------------------------------------------------------------------------------%
  211option_definition(declare_stored_constraints,off,[declare_stored_constraints-off]).
  212option_definition(declare_stored_constraints,on ,[declare_stored_constraints-on]).
  213
  214option_definition(stored,F/A,[]) :-
  215	chr_translate:stored_assertion(F/A).
  216%------------------------------------------------------------------------------%
  217option_definition(experiment,off,[experiment-off]).
  218option_definition(experiment,on,[experiment-on]).
  219option_definition(experimental,off,[experiment-off]).
  220option_definition(experimental,on,[experiment-on]).
  221option_definition(sss,off,[sss-off]).
  222option_definition(sss,on,[sss-on]).
  223%------------------------------------------------------------------------------%
  224option_definition(debug,off,Flags) :-
  225        option_definition(optimize,full,Flags2),
  226        Flags = [ debugable - off | Flags2].
  227option_definition(debug,on,Flags) :-
  228	( local_current_prolog_flag(generate_debug_info,false) ->
  229		% TODO: should not be allowed when nodebug flag is set in SWI-Prolog
  230		chr_warning(any,':- chr_option(debug,on) inconsistent with current_prolog_flag(generate_debug_info,off\n\tCHR option is ignored!\n)',[]),
  231		Flags = []
  232	;
  233       		Flags = [ debugable - on ]
  234	).
  235
  236option_definition(store_counter,off,[]).
  237option_definition(store_counter,on,[store_counter-on]).
  238
  239option_definition(observation,off,Flags) :-
  240	Flags = [
  241			observation_analysis - off,
  242			ai_observation_analysis - off,
  243			late_allocation - off,
  244			storage_analysis - off
  245		].
  246option_definition(observation,on,Flags) :-
  247	Flags = [
  248			observation_analysis - on,
  249			ai_observation_analysis - on
  250		].
  251option_definition(observation,regular,Flags) :-
  252	Flags = [
  253			observation_analysis - on,
  254			ai_observation_analysis - off
  255		].
  256option_definition(observation,ai,Flags) :-
  257	Flags = [
  258			observation_analysis - off,
  259			ai_observation_analysis - on
  260		].
  261
  262option_definition(store_in_guards, on, [store_in_guards - on]).
  263option_definition(store_in_guards, off, [store_in_guards - off]).
  264
  265option_definition(solver_events,NMod,Flags) :-
  266	Flags =	[solver_events - NMod].
  267
  268option_definition(toplevel_show_store,on,Flags) :-
  269	Flags = [toplevel_show_store - on].
  270
  271option_definition(toplevel_show_store,off,Flags) :-
  272	Flags = [toplevel_show_store - off].
  273
  274option_definition(term_indexing,on,Flags) :-
  275	Flags = [term_indexing - on].
  276option_definition(term_indexing,off,Flags) :-
  277	Flags = [term_indexing - off].
  278
  279option_definition(verbosity,on,Flags) :-
  280	Flags = [verbosity - on].
  281option_definition(verbosity,off,Flags) :-
  282	Flags = [verbosity - off].
  283
  284option_definition(ht_removal,on,Flags) :-
  285	Flags = [ht_removal - on].
  286option_definition(ht_removal,off,Flags) :-
  287	Flags = [ht_removal - off].
  288
  289option_definition(mixed_stores,on,Flags) :-
  290	Flags = [mixed_stores - on].
  291option_definition(mixed_stores,off,Flags) :-
  292	Flags = [mixed_stores - off].	
  293
  294option_definition(line_numbers,on,Flags) :-
  295	Flags = [line_numbers - on].
  296option_definition(line_numbers,off,Flags) :-
  297	Flags = [line_numbers - off].
  298
  299option_definition(dynattr,on,Flags) :-
  300	Flags = [dynattr - on].
  301option_definition(dynattr,off,Flags) :-
  302	Flags = [dynattr - off].
  303
  304option_definition(verbose,off,[verbose-off]).
  305option_definition(verbose,on,[verbose-on]).
  306
  307option_definition(dump,off,[dump-off]).
  308option_definition(dump,on,[dump-on]).
  309
  310init_chr_pp_flags :-
  311	chr_pp_flag_definition(Name,[DefaultValue|_]),
  312	set_chr_pp_flag(Name,DefaultValue),
  313	fail.
  314init_chr_pp_flags.		
  315
  316set_chr_pp_flags([]).
  317set_chr_pp_flags([Name-Value|Flags]) :-
  318	set_chr_pp_flag(Name,Value),
  319	set_chr_pp_flags(Flags).
  320
  321set_chr_pp_flag(Name,Value) :-
  322	atom_concat('$chr_pp_',Name,GlobalVar),
  323	nb_setval(GlobalVar,Value).
  324
  325chr_pp_flag_definition(functional_dependency_analysis,[off,on]).
  326chr_pp_flag_definition(check_unnecessary_active,[off,full,simplification]).
  327chr_pp_flag_definition(reorder_heads,[off,on]).
  328chr_pp_flag_definition(set_semantics_rule,[off,on]).
  329chr_pp_flag_definition(guard_via_reschedule,[off,on]).
  330chr_pp_flag_definition(guard_locks,[on,off,error]).
  331chr_pp_flag_definition(storage_analysis,[off,on]).
  332chr_pp_flag_definition(debugable,[on,off]).
  333chr_pp_flag_definition(reduced_indexing,[off,on]).
  334chr_pp_flag_definition(observation_analysis,[off,on]).
  335chr_pp_flag_definition(ai_observation_analysis,[off,on]).
  336chr_pp_flag_definition(store_in_guards,[off,on]).
  337chr_pp_flag_definition(late_allocation,[off,on]).
  338chr_pp_flag_definition(store_counter,[off,on]).
  339chr_pp_flag_definition(guard_simplification,[off,on]).
  340chr_pp_flag_definition(check_impossible_rules,[off,on]).
  341chr_pp_flag_definition(occurrence_subsumption,[off,on]).
  342chr_pp_flag_definition(observation,[off,on]).
  343chr_pp_flag_definition(show,[off,on]).
  344chr_pp_flag_definition(inline_insertremove,[on,off]).
  345chr_pp_flag_definition(solver_events,[none,_]).
  346chr_pp_flag_definition(toplevel_show_store,[on,off]).
  347chr_pp_flag_definition(term_indexing,[off,on]).
  348chr_pp_flag_definition(verbosity,[on,off]).
  349chr_pp_flag_definition(ht_removal,[off,on]).
  350chr_pp_flag_definition(mixed_stores,[on,off]).
  351chr_pp_flag_definition(line_numbers,[off,on]).
  352chr_pp_flag_definition(dynattr,[off,on]).
  353chr_pp_flag_definition(experiment,[off,on]).
  354chr_pp_flag_definition(sss,[off,on]).
  355	% emit compiler inferred code
  356chr_pp_flag_definition(verbose,[off,on]).
  357	% emit input code and output code
  358chr_pp_flag_definition(dump,[off,on]).
  359
  360chr_pp_flag_definition(declare_stored_constraints,[off,on]).
  361
  362chr_pp_flag(Name,Value) :-
  363	atom_concat('$chr_pp_',Name,GlobalVar),
  364	nb_getval(GlobalVar,V),
  365	( V == [] ->
  366		chr_pp_flag_definition(Name,[Value|_])
  367	;
  368		V = Value
  369	).
  370	
  371
  372% TODO: add whatever goes wrong with (debug,on), (optimize,full) combo here!
  373% trivial example of what does go wrong:
  374%	b <=> true.
  375% !!!
  376sanity_check :-
  377	chr_pp_flag(store_in_guards, on),
  378	chr_pp_flag(ai_observation_analysis, on),
  379	chr_warning(any, 'ai_observation_analysis should be turned off when using store_in_guards\n', []),
  380	fail.
  381sanity_check.
  382%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%