1%----------------------------------------------------------------------
2% BEGIN LICENSE BLOCK
3% Version: CMPL 1.1
4%
5% The contents of this file are subject to the Cisco-style Mozilla Public
6% License Version 1.1 (the "License"); you may not use this file except
7% in compliance with the License.  You may obtain a copy of the License
8% at www.eclipse-clp.org/license.
9% 
10% Software distributed under the License is distributed on an "AS IS"
11% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied.  See
12% the License for the specific language governing rights and limitations
13% under the License. 
14% 
15% The Original Code is  The Zinc Modelling Tools for ECLiPSe
16% The Initial Developer of the Original Code is  Joachim Schimpf
17% with support from Cisco Systems and NICTA Victoria.
18% Portions created by the Initial Developer are
19% Copyright (C) 2007 Cisco Systems, Inc.  All Rights Reserved.
20% 
21% Contributor(s): Joachim Schimpf
22% 
23% END LICENSE BLOCK
24%----------------------------------------------------------------------
25
26:- module(flatzinc_syntax).
27
28:-(call(op(1200, fx, (:-)))).
29:-(call(op(1200, xfx, (:-)))).
30
31:- comment(date, "$Date: 2012/10/23 00:38:15 $").
32:- comment(categories, ["Interfacing"]).
33:- comment(summary, "Configure ECLiPSe parser to accept FlatZinc syntax").
34:- comment(author, "Joachim Schimpf, supported by Cisco Systems and NICTA Victoria").
35:- comment(copyright, "Cisco Systems Inc, licensed under CMPL").
36:- comment(see_also, [library(flatzinc_parser)]).
37:- comment(desc, html("
38<P>
39This module provides a quick way to enable ECLiPSe to read FlatZinc items.
40FlatZinc Syntax is sufficiently close to ECLiPSe syntax to allow the normal
41ECLiPSe parser to read FlatZinc, provided a number of syntax options are set.
42The way to use this library is to load it
43<PRE>
44:- lib(flatzinc_syntax).
45</PRE>
46and then use the normal read/1,2,etc primitives with this
47module context, e.g.
48<PRE>
49..., read(Stream, FlatZincItem)@flatzinc_syntax, ...
50</PRE>
51for example
52<PRE>
53fzn_echo(File) :-
54	open(File, read, Stream),
55	read(Stream, Term1)@flatzinc_syntax,
56	( fromto(Term1, Term, Term2, end_of_file), param(Stream) do
57	    writeln(Term),
58	    read(Stream, Term2)@flatzinc_syntax
59	),
60	close(Stream).
61</PRE>
62</P><P>
63Alternatively, the library exports read_item/2, which is defined as
64<PRE>
65read_item(Stream, Term) :-
66	read(Stream, Term)@flatzinc_syntax,
67	Term \\== end_of_file.
68</PRE>
69and is call-compatible with the predicate of the same name
70exported from lib(flatzinc_parser), but faster.  Since it
71works simply by modifying syntax settings for the normal
72ECLiPSe parser, it is less strict than the purpose
73written library(flatzinc_parser), and will detect less
74syntax errors. This should however not be an issue when
75processing generated FlatZinc source.
76</P>
77")).
78
79
80:- export read_item/2.
81read_item(Stream, Term) :-
82	read(Stream, Term)@flatzinc_syntax,
83	Term \== end_of_file.
84
85
86% All syntax settings are done as initialisation
87% to avoid problems while parsing this file itself!
88
89:- local initialization((
90
91    (
92	between(32, 255, 1, Char),
93	get_chtab(Char, upper_case),
94	local(chtab(Char, lower_case)),
95	fail
96    ;
97	true
98    ),
99
100    local(chtab(0'!, symbol)),
101    local(chtab(0'-, solo)),    % to allow e.g. -3..-1 without spaces
102    local(chtab(0'+, solo)),    % to allow e.g. 0..+1 without spaces
103    local(chtab(0';, terminator)),
104
105    local(syntax_option(iso_base_prefix)),
106    local(syntax_option(not(nl_in_quotes))),
107    local(syntax_option(not(no_blanks))),
108    local(syntax_option(atom_subscripts)),
109    local(syntax_option(curly_args_as_list)),
110
111    % hide all global operator definitions
112    (
113	current_op(_, A, Op),
114	local(op(0, A, Op)),
115	fail
116    ;
117	true
118    ),
119
120    local(op(9, xfy, (::))),
121
122    local(op(1100, xfy, (;))),		% as in Prolog
123    local(op(900, xfx, (=))),
124    local(op(800, xfx, (','))),
125    local(op(800, xfx, (:))),
126    local(op(500, xfx, (..))),
127%    local(op(600, fxy, sum)),
128%    local(op(600, fxy, in)),
129%    local(op(200, fxy, forall)),
130
131    % the keywords
132%    local(op(1050, xfx, annotation)),
133%    local(op(500, fy, any)),
134    local(op(600, fx, array)),
135%    local(op(0, xfy, bool)),
136%    local(op(0, xfy, case)),
137    local(op(1000, fx, constraint)),
138%    local(op(0, xfy, default)),
139%    local(op(0, xfy, else)),
140%    local(op(0, xfy, elseif)),
141%    local(op(0, xfy, endif)),
142%    local(op(1000, fx, enum)),
143%    local(op(0, xfy, false)),
144%    local(op(0, xfy, float)),
145%    local(op(0, xfy, function)),
146%    local(op(0, xfy, if)),
147%    local(op(1000, fx, include)),
148%    local(op(0, xfy, int)),
149%    local(op(0, xfy, let)),
150    local(op(1000, xfx, maximize)),
151    local(op(1000, xfx, minimize)),
152    local(op(700, xfy, of)),
153    local(op(1000, fy, output)),
154    local(op(600, xfy, par)),
155    local(op(1000, fx, predicate)),
156%    local(op(1000, xfy, record)),
157    local(op(1000, xf, satisfy)),
158%    local(op(0, xfy, set)),
159%    local(op(0, fx, solve)),
160%    local(op(0, xfy, string)),
161%    local(op(0, xfy, test)),
162%    local(op(0, xfy, then)),
163%    local(op(0, xfy, true)),
164%    local(op(0, xfy, tuple)),
165%    local(op(1000, fx, type)),
166    local(op(700, fy, var)),
167%    local(op(1000, fx, variant_record)),
168%    local(op(550, xfy, where)),
169
170    % disable struct notation macros
171    local(macro((with)/2, (=)/2, [])),
172    local(macro((of)/2, (=)/2, []))
173
174    )).
175
176