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.ac.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 :- module(chr,
  33           [ op( 700, xfx, ::),
  34             op(1180, xfx, ==>),
  35             op(1180, xfx, <=>),
  36             op(1150, fx, constraints),
  37             op(1150, fx, handler),
  38             op(1150, fx, rules),
  39             op(1100, xfx, \),
  40             op(1200, xfx, @),
  41             op(1190, xfx, pragma),
  42             op( 500, yfx, #),
  43             op(1150, fx, chr_type),
  44             op(1130, xfx, --->),
  45             op(1150, fx, (+)),
  46             op(1150, fx, (-)),
  47             op(1150, fx, (?)),
  48             chr_show_store/1,           % +Module
  49             chr_trace/0,
  50             chr_notrace/0,
  51             chr_leash/1                 % +Ports
  52           ]).
  53 :- set_prolog_flag(generate_debug_info, false).
  54
  55 :- multifile user:file_search_path/2.
  56 :- dynamic   user:file_search_path/2.
  57 :- dynamic   chr_translated_program/1.
  58
  59 user:file_search_path(chr, library(chr)).
  60
  61 :- use_module(chr(chr_translate)).
  62 :- use_module(chr(chr_runtime)).
  63 :- use_module(chr(chr_debug)).
  64 :- use_module(chr(chr_messages)).
  65 :- use_module(library(gensym)).
  66 :- use_module(chr(chr_hashtable_store)).
  67
  68 :- dynamic
  69         chr_term/2.                     % File, Term
  70
  71 %       chr_expandable(+Term)
  72 %
  73 %       Succeeds if Term is a  rule  that   must  be  handled by the CHR
  74 %       compiler. Ideally CHR definitions should be between
  75 %
  76 %               :- constraints ...
  77 %               ...
  78 %               :- end_constraints.
  79 %
  80 %       As they are not we have to   use  some heuristics. We assume any
  81 %       file is a CHR after we've seen :- constraints ... or if the file
  82 %       is named *.chr
  83
  84 chr_expandable((:- constraints _)).
  85 chr_expandable((constraints _)).
  86 chr_expandable((:- chr_type _)).
  87 chr_expandable((chr_type _)).
  88 chr_expandable((handler _)) :-
  89         is_chr_file.
  90 chr_expandable((rules _)) :-
  91         is_chr_file.
  92 chr_expandable((_ <=> _)) :-
  93         is_chr_file.
  94 chr_expandable((_ @ _)) :-
  95         is_chr_file.
  96 chr_expandable((_ ==> _)) :-
  97         is_chr_file.
  98 chr_expandable((_ pragma _)) :-
  99         is_chr_file.
 100 chr_expandable(option(_, _)) :-
 101         is_chr_file.
 102
 103 is_chr_file :-
 104         source_location(File, _Line),
 105         (   chr_term(File, _)
 106         ->  true
 107         ;   file_name_extension(_, chr, File)
 108         ).
 109
 110 %       chr_expand(+Term, -Expansion)
 111 %
 112 %       Extract CHR declarations and rules from the file and run the
 113 %       CHR compiler when reaching end-of-file.
 114
 115 chr_expand(Term, []) :-
 116         chr_expandable(Term), !,
 117         source_location(File, _Line),
 118         assert(chr_term(File, Term)).
 119 chr_expand(end_of_file,
 120            [ (:- use_module(chr(chr_runtime))),
 121              (:- style_check(-discontiguous)), % no need to restore; file ends
 122              (:- set_prolog_flag(generate_debug_info, false))
 123            | Program
 124            ]) :-
 125         is_chr_file,
 126         source_location(File, _Line),
 127         findall(T, retract(chr_term(File, T)), CHR0),
 128         CHR0 \== [],
 129 %       length(CHR0, NDecls),
 130 %       format('Translating ~w declarations~n', [NDecls]),
 131         prolog_load_context(module, Module),
 132         (   Module == user
 133         ->  (   memberchk(handler(Handler), CHR0)
 134             ->  true
 135             ;   gensym(chr_handler, Handler)
 136             )
 137         ;   Handler = Module
 138         ),
 139         add_debug_decl(CHR0, CHR1),
 140         add_optimise_decl(CHR1, CHR),
 141         call_chr_translate(File,
 142                            [ (:- module(Handler, []))
 143                            | CHR
 144                            ],
 145                            Program0),
 146         delete_header(Program0, Program).
 147
 148
 149 delete_header([(:- module(_,_))|T0], T) :- !,
 150         delete_header(T0, T).
 151 delete_header(L, L).
 152
 153 add_debug_decl(CHR, CHR) :-
 154         memberchk(option(debug, _), CHR), !.
 155 add_debug_decl(CHR, [option(debug, Debug)|CHR]) :-
 156         (   current_prolog_flag(generate_debug_info, true)
 157         ->  Debug = on
 158         ;   Debug = off
 159         ).
 160
 161 add_optimise_decl(CHR, CHR) :-
 162         memberchk(option(optimize, _), CHR), !.
 163 add_optimise_decl(CHR, [option(optimize, full)|CHR]) :-
 164         current_prolog_flag(optimize, true), !.
 165 add_optimise_decl(CHR, CHR).
 166
 167
 168 %       call_chr_translate(+File, +In, -Out)
 169 %
 170 %       The entire chr_translate/2 translation may   fail, in which we'd
 171 %       better issue a warning  rather  than   simply  ignoring  the CHR
 172 %       declarations.
 173
 174 call_chr_translate(_, In, _Out) :-
 175            ( chr_translate(In, Out0) ->
 176                 assert(chr_translated_program(Out0)),
 177                 fail
 178             ).
 179 call_chr_translate(_, _In, Out) :-
 180             retract(chr_translated_program(Out)),!.
 181
 182 call_chr_translate(File, _, []) :-
 183         print_message(error, chr(compilation_failed(File))).
 184
 185
 186                  /*******************************
 187                  *      SYNCHRONISE TRACER      *
 188                  *******************************/
 189
 190 :- multifile
 191         user:message_hook/3,
 192         chr:debug_event/2,
 193         chr:debug_interact/3.
 194 :- dynamic
 195         user:message_hook/3.
 196
 197 user:message_hook(trace_mode(OnOff), _, _) :-
 198         (   OnOff == on
 199         ->  chr_trace
 200         ;   chr_notrace
 201         ),
 202         fail.                           % backtrack to other handlers
 203
 204 %       chr:debug_event(+State, +Event)
 205 %
 206 %       Hook into the CHR debugger.  At this moment we will discard CHR
 207 %       events if we are in a Prolog `skip' and we ignore the
 208
 209 chr:debug_event(_State, _Event) :-
 210         tracing,                        % are we tracing?
 211         prolog_skip_level(Skip, Skip),
 212         Skip \== very_deep,
 213         prolog_current_frame(Me),
 214         prolog_frame_attribute(Me, level, Level),
 215         Level > Skip, !.
 216
 217 %       chr:debug_interact(+Event, +Depth, -Command)
 218 %
 219 %       Hook into the CHR debugger to display Event and ask for the next
 220 %       command to execute. This  definition   causes  the normal Prolog
 221 %       debugger to be used for the standard ports.
 222
 223 chr:debug_interact(Event, _Depth, creep) :-
 224         prolog_event(Event),
 225         tracing, !.
 226
 227 prolog_event(call(_)).
 228 prolog_event(exit(_)).
 229 prolog_event(fail(_)).
 230
 231
 232
 233
 234                  /*******************************
 235                  *            MESSAGES          *
 236                  *******************************/
 237
 238 :- multifile
 239         prolog:message/3.
 240
 241 prolog:message(chr(CHR)) -->
 242         chr_message(CHR).
 243
 244                  /*******************************
 245                  *       TOPLEVEL PRINTING      *
 246                  *******************************/
 247
 248 :- multifile chr:'$chr_module'/1.
 249
 250 prolog:message(query(YesNo)) --> !,
 251         ['~@'-[chr:print_all_stores]],
 252         '$messages':prolog_message(query(YesNo)).
 253
 254 prolog:message(query(YesNo,Bindings)) --> !,
 255         ['~@'-[chr:print_all_stores]],
 256         '$messages':prolog_message(query(YesNo,Bindings)).
 257
 258 print_all_stores :-
 259         ( chr:'$chr_module'(Mod),
 260           chr_show_store(Mod),
 261           fail
 262         ;
 263           true
 264         ).
 265
 266                  /*******************************
 267                  *         MUST BE LAST!        *
 268                  *******************************/
 269
 270 :- multifile user:term_expansion/2.
 271 :- dynamic   user:term_expansion/2.
 272
 273 user:term_expansion(In, Out) :-
 274         chr_expand(In, Out).
 275
 276