chr_swi.pl

   1 /*  $Id$
   2
   3     Part of CHR (Constraint Handling Rules)
   4
   5     Author:        Tom Schrijvers and Jan Wielemaker
   6     E-mail:        Tom.Schrijvers@cs.kuleuven.be
   7     WWW:           http://www.swi-prolog.org
   8     Copyright (C): 2003-2004, K.U. Leuven
   9
  10     This program is free software; you can redistribute it and/or
  11     modify it under the terms of the GNU General Public License
  12     as published by the Free Software Foundation; either version 2
  13     of the License, or (at your option) any later version.
  14
  15     This program is distributed in the hope that it will be useful,
  16     but WITHOUT ANY WARRANTY; without even the implied warranty of
  17     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18     GNU General Public License for more details.
  19
  20     You should have received a copy of the GNU Lesser General Public
  21     License along with this library; if not, write to the Free Software
  22     Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  23
  24     As a special exception, if you link this library with other files,
  25     compiled with a Free Software compiler, to produce an executable, this
  26     library does not by itself cause the resulting executable to be covered
  27     by the GNU General Public License. This exception does not however
  28     invalidate any other reasons why the executable file might be covered by
  29     the GNU General Public License.
  30 */
  31
  32 %% SWI begin
  33 :- module(chr,
  34           [ op(1180, xfx, ==>),
  35             op(1180, xfx, <=>),
  36             op(1150, fx, constraints),
  37             op(1150, fx, chr_constraint),
  38             op(1150, fx, chr_constraint),
  39             op(1150, fx, handler),
  40             op(1150, fx, rules),
  41             op(1100, xfx, \),
  42             op(1200, xfx, @),
  43             op(1190, xfx, pragma),
  44             op( 500, yfx, #),
  45             op(1150, fx, chr_type),
  46             op(1130, xfx, --->),
  47             op(1150, fx, (?)),
  48             chr_show_store/1,           % +Module
  49             find_chr_constraint/1,      % +Pattern
  50             chr_trace/0,
  51             chr_notrace/0,
  52             chr_leash/1                 % +Ports
  53           ]).
  54
  55 :- set_prolog_flag(generate_debug_info, false).
  56
  57 :- use_module(library(gensym)).
  58
  59 :- multifile user:file_search_path/2.
  60 :- dynamic   user:file_search_path/2.
  61 :- dynamic   chr_translated_program/1.
  62
  63 user:file_search_path(chr, library(chr)).
  64
  65 :- use_module(chr(chr_translate)).
  66 :- use_module(chr(chr_runtime)).
  67 :- use_module(chr(chr_messages)).
  68 :- use_module(chr(chr_hashtable_store)).
  69
  70 :- use_module(chr(chr_compiler_errors)).
  71
  72 :- use_module(library(lists),[member/2]).
  73 %% SWI end
  74
  75 %% SICStus begin
  76 %% :- module(chr,[]).
  77 %%
  78 %% :- op(1180, xfx, ==>),
  79 %%      op(1180, xfx, <=>),
  80 %%      op(1150, fx, constraints),
  81 %%      op(1150, fx, handler),
  82 %%      op(1150, fx, rules),
  83 %%      op(1100, xfx, \),
  84 %%      op(1200, xfx, @),
  85 %%      op(1190, xfx, pragma),
  86 %%      op( 500, yfx, #),
  87 %%      op(1150, fx, chr_type),
  88 %%      op(1130, xfx, --->),
  89 %%      op(1150, fx, (?)).
  90 %%
  91 %% :- multifile user:file_search_path/2.
  92 %% :- dynamic   user:file_search_path/2.
  93 %% :- dynamic   chr_translated_program/1.
  94 %%
  95 %% user:file_search_path(chr, library(chr)).
  96 %%
  97 %%
  98 %% :- use_module('chr/chr_translate').
  99 %% :- use_module('chr/chr_runtime').
 100 %% :- use_module('chr/chr_messages').
 101 %% :- use_module('chr/chr_hashtable_store').
 102 %% :- use_module('chr/hprolog').
 103 %% :- use_module(library(lists),[member/2, memberchk/2]).
 104 %% SICStus end
 105
 106
 107 :- dynamic
 108         chr_term/2.                     % File, Term
 109
 110 %       chr_expandable(+Term)
 111 %
 112 %       Succeeds if Term is a  rule  that   must  be  handled by the CHR
 113 %       compiler. Ideally CHR definitions should be between
 114 %
 115 %               :- constraints ...
 116 %               ...
 117 %               :- end_constraints.
 118 %
 119 %       As they are not we have to   use  some heuristics. We assume any
 120 %       file is a CHR after we've seen :- constraints ...
 121
 122 chr_expandable((:- constraints _)).
 123 chr_expandable((constraints _)).
 124 chr_expandable((:- chr_constraint _)).
 125 chr_expandable((:- chr_type _)).
 126 chr_expandable((chr_type _)).
 127 chr_expandable(option(_, _)).
 128 chr_expandable((:- chr_option(_, _))).
 129 chr_expandable((handler _)).
 130 chr_expandable((rules _)).
 131 chr_expandable((_ <=> _)).
 132 chr_expandable((_ @ _)).
 133 chr_expandable((_ ==> _)).
 134 chr_expandable((_ pragma _)).
 135
 136 %       chr_expand(+Term, -Expansion)
 137 %
 138 %       Extract CHR declarations and rules from the file and run the
 139 %       CHR compiler when reaching end-of-file.
 140
 141 %% SWI begin
 142 extra_declarations([(:- use_module(chr(chr_runtime))),
 143                     (:- style_check(-discontiguous)), % no need to restore; file ends
 144                     (:- set_prolog_flag(generate_debug_info, false))
 145                    | Tail], Tail).
 146 %% SWI end
 147
 148 %% SICStus begin
 149 %% extra_declarations([(:-use_module(chr(chr_runtime)))
 150 %%                   , (:- use_module(library(terms),[term_variables/2]))
 151 %%                   , (:-use_module(chr(hpattvars)))
 152 %%                   | Tail], Tail).
 153 %% SICStus end
 154
 155 chr_expand(Term, []) :-
 156         chr_expandable(Term), !,
 157         prolog_load_context(file,File),
 158         assert(chr_term(File, Term)).
 159 chr_expand(end_of_file, FinalProgram) :-
 160         extra_declarations(FinalProgram,Program),
 161         prolog_load_context(file,File),
 162         findall(T, retract(chr_term(File, T)), CHR0),
 163         CHR0 \== [],
 164         prolog_load_context(module, Module),
 165         add_debug_decl(CHR0, CHR1),
 166         add_optimise_decl(CHR1, CHR),
 167         catch(call_chr_translate(File,
 168                            [ (:- module(Module, []))
 169                            | CHR
 170                            ],
 171                            Program0),
 172                 chr_error(Error),
 173                 (       chr_compiler_errors:print_chr_error(Error),
 174                         fail
 175                 )
 176         ),
 177         delete_header(Program0, Program).
 178
 179
 180 delete_header([(:- module(_,_))|T0], T) :- !,
 181         delete_header(T0, T).
 182 delete_header(L, L).
 183
 184 add_debug_decl(CHR, CHR) :-
 185         member(option(Name, _), CHR), Name == debug, !.
 186 add_debug_decl(CHR, CHR) :-
 187         member((:- chr_option(Name, _)), CHR), Name == debug, !.
 188 add_debug_decl(CHR, [(:- chr_option(debug, Debug))|CHR]) :-
 189         (   chr_current_prolog_flag(generate_debug_info, true)
 190         ->  Debug = on
 191         ;   Debug = off
 192         ).
 193
 194 %% SWI begin
 195 chr_current_prolog_flag(Flag,Val) :- current_prolog_flag(Flag,Val).
 196 %% SWI end
 197
 198 %% SICStus begin
 199 %% chr_current_prolog_flag(generate_debug_info, _) :- fail.
 200 %% chr_current_prolog_flag(optimize,full).
 201 %% chr_current_prolog_flag(chr_toplevel_show_store,true).
 202 %% SICStus end
 203
 204
 205
 206 add_optimise_decl(CHR, CHR) :-
 207         \+(\+(memberchk((:- chr_option(optimize, _)), CHR))), !.
 208 add_optimise_decl(CHR, [(:- chr_option(optimize, full))|CHR]) :-
 209         chr_current_prolog_flag(optimize, full), !.
 210 add_optimise_decl(CHR, CHR).
 211
 212
 213 %       call_chr_translate(+File, +In, -Out)
 214 %
 215 %       The entire chr_translate/2 translation may fail, in which case we'd
 216 %       better issue a warning  rather  than   simply  ignoring  the CHR
 217 %       declarations.
 218
 219 call_chr_translate(_, In, _Out) :-
 220         ( chr_translate(In, Out0) ->
 221             nb_setval(chr_translated_program,Out0),
 222             fail
 223         ).
 224 call_chr_translate(_, _In, Out) :-
 225         nb_current(chr_translated_program,Out), !,
 226         nb_delete(chr_translated_program).
 227
 228 call_chr_translate(File, _, []) :-
 229         print_message(error, chr(compilation_failed(File))).
 230
 231
 232                  /*******************************
 233                  *      SYNCHRONISE TRACER      *
 234                  *******************************/
 235
 236 :- multifile
 237         user:message_hook/3,
 238         chr:debug_event/2,
 239         chr:debug_interact/3.
 240 :- dynamic
 241         user:message_hook/3.
 242
 243 user:message_hook(trace_mode(OnOff), _, _) :-
 244         (   OnOff == on
 245         ->  chr_trace
 246         ;   chr_notrace
 247         ),
 248         fail.                           % backtrack to other handlers
 249
 250 %       chr:debug_event(+State, +Event)
 251 %
 252 %       Hook into the CHR debugger.  At this moment we will discard CHR
 253 %       events if we are in a Prolog `skip' and we ignore the
 254
 255 chr:debug_event(_State, _Event) :-
 256         tracing,                        % are we tracing?
 257         prolog_skip_level(Skip, Skip),
 258         Skip \== very_deep,
 259         prolog_current_frame(Me),
 260         prolog_frame_attribute(Me, level, Level),
 261         Level > Skip, !.
 262
 263 %       chr:debug_interact(+Event, +Depth, -Command)
 264 %
 265 %       Hook into the CHR debugger to display Event and ask for the next
 266 %       command to execute. This  definition   causes  the normal Prolog
 267 %       debugger to be used for the standard ports.
 268
 269 chr:debug_interact(Event, _Depth, creep) :-
 270         prolog_event(Event),
 271         tracing, !.
 272
 273 prolog_event(call(_)).
 274 prolog_event(exit(_)).
 275 prolog_event(fail(_)).
 276
 277
 278
 279
 280                  /*******************************
 281                  *            MESSAGES          *
 282                  *******************************/
 283
 284 :- multifile
 285         prolog:message/3.
 286
 287 prolog:message(chr(CHR)) -->
 288         chr_message(CHR).
 289
 290                  /*******************************
 291                  *       TOPLEVEL PRINTING      *
 292                  *******************************/
 293
 294 %% SWI begin
 295 :- set_prolog_flag(chr_toplevel_show_store,true).
 296 %% SWI end
 297
 298 :- multifile chr:'$chr_module'/1.
 299
 300 prolog:message(query(YesNo)) --> !,
 301         ['~@'-[chr:print_all_stores]],
 302         '$messages':prolog_message(query(YesNo)).
 303
 304 prolog:message(query(YesNo,Bindings)) --> !,
 305         ['~@'-[chr:print_all_stores]],
 306         '$messages':prolog_message(query(YesNo,Bindings)).
 307
 308 print_all_stores :-
 309         ( chr_current_prolog_flag(chr_toplevel_show_store,true),
 310           catch(nb_getval(chr_global, _), _, fail),
 311           chr:'$chr_module'(Mod),
 312           chr_show_store(Mod),
 313           fail
 314         ;
 315           true
 316         ).
 317
 318                  /*******************************
 319                  *         MUST BE LAST!        *
 320                  *******************************/
 321
 322 :- multifile user:term_expansion/2.
 323 :- dynamic   user:term_expansion/2.
 324
 325 user:term_expansion(In, Out) :-
 326         chr_expand(In, Out).
 327
 328