1:- module(plammar_environments, [
2 target_ops/2,
3 target_options/2
4 ]). 5
6:- use_module(library(lists), [append/3]). 7:- use_module(library(option), [merge_options/3]).
11target_ops(iso, Ops) :-
12 Ops = [
13 op(1200, xfx, ':-'),
14 op(1200, xfx, '-->'),
15 op(1200, fx, ':-'),
16 op(1200, fx, '?-'),
17 op(1100, xfy, ';'),
18 op(1050, xfy, '->'),
19 op(1000, xfy, ','),
20 op( 900, fy, '\\+'),
21 op( 700, xfx, '='),
22 op( 700, xfx, '\\='),
23 op( 700, xfx, '=='),
24 op( 700, xfx, '\\=='),
25 op( 700, xfx, '@<'),
26 op( 700, xfx, '@=<'),
27 op( 700, xfx, '@>'),
28 op( 700, xfx, '@>='),
29 op( 700, xfx, '=..'),
30 op( 700, xfx, 'is'),
31 op( 700, xfx, '=:='),
32 op( 700, xfx, '=\\='),
33 op( 700, xfx, '<'),
34 op( 700, xfx, '=<'),
35 op( 700, xfx, '>'),
36 op( 700, xfx, '>='),
37 op( 500, yfx, '+'),
38 op( 500, yfx, '-'),
39 op( 500, yfx, '/\\'),
40 op( 500, yfx, '\\/'),
41 op( 400, yfx, '*'),
42 op( 400, yfx, '/'),
43 op( 400, yfx, '//'),
44 op( 400, yfx, 'div'), 45 op( 400, yfx, 'rem'),
46 op( 400, yfx, 'mod'),
47 op( 400, yfx, '<<'),
48 op( 400, yfx, '>>'),
49 op( 200, xfx, '**'),
50 op( 200, xfy, '^'),
51 op( 200, fy, '+'), 52 op( 200, fy, '-'),
53 op( 200, fy, '\\')
54 ].
55
56target_ops(swi, Ops) :-
57 extend_ops(iso, [
58 op(1105, xfy, '|'),
59 op(1050, xfy, '*->'),
60 op( 700, xfx, '>:<'),
61 op( 700, xfx, ':<'),
62 op( 700, xfx, '=@='),
63 op( 700, xfx, '\\=@='),
64 op( 600, xfy, ':'),
65 op( 400, yfx, 'rdiv'),
66 op( 400, yfx, 'xor'),
67 op(1150, fx, 'discontiguous'),
68 op(1150, fx, 'dynamic'),
69 op(1150, fx, 'volatile'),
70 op(1150, fx, 'thread_local'),
71 op(1150, fx, 'initialization'),
72 op(1150, fx, 'thread_initialization'),
73 op(1150, fx, 'module_transparent'),
74 op(1150, fx, 'multifile'),
75 op(1150, fx, 'meta_predicate'),
76 op(1150, fx, 'public'),
77 op(1150, fx, 'table'),
78 op( 700, xfx, 'as'),
79
80 op( 200, fy, '@'), 81 op( 1, fx, '$'), 82 op( 990, xfx, ':='), 83
84 op( 100, yfx, '.') 85 ], Ops).
86
87extend_ops(Target, Extension, Combined) :-
88 target_ops(Target, Target_Ops),
89 append(Target_Ops, Extension, Combined).
94target_options(swi, Options) :-
95 target_options(swi(8), Options).
96
97target_options(swi(8), Options) :-
98 extend_options(swi(7), [], Options).
99
100target_options(swi(7), Options) :-
101 extend_options(swi(6), [
102 dicts(yes),
103 back_quoted_text(yes),
104 allow_compounds_with_zero_arguments(yes),
105 allow_arg_precedence_geq_1000(yes),
106 allow_operator_as_operand(yes)
107 ], Options).
108
109target_options(swi(6), Options) :-
110 extend_options(swi(5), [
111 allow_digit_groups_with_underscore(yes),
112 allow_digit_groups_with_space(yes)
113 ], Options).
114
115target_options(swi(5), Options) :-
116 extend_options(iso, [
117 allow_shebang(yes),
118 allow_tab_as_quote_char(yes),
119 allow_newline_as_quote_char(yes),
120 allow_symbolic_no_output_char_c(yes),
121 allow_symbolic_escape_char_e(yes),
122 allow_symbolic_space_char_s(yes),
123 allow_unicode(yes),
124 allow_integer_exponential_notation(yes),
125 allow_single_quote_char_in_character_code_constant(yes),
126 allow_missing_closing_backslash_in_character_escape(yes),
127 allow_unicode_character_escape(yes)
128 ], Options).
129
130
131target_options(iso, Options) :-
132 Options = [
133 allow_shebang(no),
134 allow_unicode(no),
135 var_prefix(no),
136 dicts(no),
137 back_quoted_text(no),
138 allow_compounds_with_zero_arguments(no),
139 allow_arg_precedence_geq_1000(no),
140 allow_operator_as_operand(no),
141 allow_tab_as_quote_char(no),
142 allow_newline_as_quote_char(no),
143 allow_symbolic_no_output_char_c(no),
144 allow_symbolic_escape_char_e(no),
145 allow_symbolic_space_char_s(no),
146 allow_digit_groups_with_underscore(no),
147 allow_digit_groups_with_space(no),
148 allow_integer_exponential_notation(no),
149 allow_single_quote_char_in_character_code_constant(no),
150 allow_missing_closing_backslash_in_character_escape(no),
151 allow_unicode_character_escape(no)
152 ].
153
154extend_options(Target, Extension, Combined) :-
155 target_options(Target, Target_Options),
156 merge_options(Extension, Target_Options, Combined)