1 | % (c) 2021-2022 Lehrstuhl fuer Softwaretechnik und Programmiersprachen, | |
2 | % Heinrich Heine Universitaet Duesseldorf | |
3 | % This software is licenced under EPL 1.0 (http://www.eclipse.org/org/documents/epl-v10.html) | |
4 | ||
5 | :- module(tools_portability, [ | |
6 | check_arithmetic_function/1, | |
7 | exists_source/1, | |
8 | supported_term_expansion_style/1, | |
9 | supported_goal_expansion_style/1 | |
10 | ]). | |
11 | ||
12 | % To make it easier to write code that works with | |
13 | % both library(atts) (SICStus, Ciao, etc.) and the *_attr builtins (SWI, hProlog, etc.), | |
14 | % declare the attribute operator from library(atts) here. | |
15 | % This prevents syntax errors if a library(atts)-style attribute declaration directive | |
16 | % appears in code that is conditionally disabled via if/endif. | |
17 | :- op(1150, fx, (attribute)). | |
18 | ||
19 | :- use_module(module_information). | |
20 | ||
21 | :- module_info(group, infrastructure). | |
22 | :- module_info(description, 'Utilities for inspecting the features of the current Prolog system, to simplify writing portable code that can run on different Prolog systems.'). | |
23 | ||
24 | %! check_arithmetic_function(+FuncCall) | |
25 | % | |
26 | % True if the term FuncCall is a valid arithmetic function/operator. | |
27 | % FuncCall must be a valid arithmetic expression that evaluates without errors | |
28 | % (assuming the function in question exists). | |
29 | % It is *not* enough to pass a skeletal term (i. e. with variable arguments), | |
30 | % because the implementation may try to actually evaluate the expression. | |
31 | % | |
32 | % For example: check_arithmetic_function(log(2, 4)) and NOT check_arithmetic_function(log(_, _)) | |
33 | ||
34 | :- if(predicate_property(current_arithmetic_function(_), _)). | |
35 | % Use current_arithmetic_function/1 if possible (supported by SWI). | |
36 | check_arithmetic_function(FuncCall) :- | |
37 | current_arithmetic_function(FuncCall). | |
38 | :- else. | |
39 | % Otherwise try to call the function and see if it works or not. | |
40 | check_arithmetic_function(FuncCall) :- | |
41 | catch(_Res is FuncCall, _Error, false). | |
42 | :- endif. | |
43 | ||
44 | %! exists_source(+Source). | |
45 | % | |
46 | % True if Source refers to a Prolog source file that exists. | |
47 | % Source must be a Prolog source specifier as accepted by use_module, consult, etc. | |
48 | % | |
49 | % This predicate is natively supported on some Prolog systems (at least SWI and YAP). | |
50 | % Otherwise this module provides a fallback implementation based on absolute_file_name/2. | |
51 | ||
52 | :- if(predicate_property(exists_source(_), _)). | |
53 | % Spider will assume if to be false | |
54 | :- else. | |
55 | exists_source(Source) :- | |
56 | absolute_file_name(Source, _, [access(exist), file_type(source), file_errors(fail)]). | |
57 | :- endif. | |
58 | ||
59 | % Define all known variants of term_expansion to detect which ones are supported by the system. | |
60 | ||
61 | :- multifile user:term_expansion/2. | |
62 | user:term_expansion(Term1, Term2) :- | |
63 | Term1 == unsupported_term_expansion_style(traditional), | |
64 | !, | |
65 | Term2 = supported_term_expansion_style(traditional). | |
66 | ||
67 | :- multifile user:term_expansion/4. | |
68 | user:term_expansion(Term1, Layout1, Term2, Layout2) :- | |
69 | Term1 == unsupported_term_expansion_style(swi_layout), | |
70 | !, | |
71 | Term2 = supported_term_expansion_style(swi_layout), | |
72 | Layout2 = Layout1. | |
73 | ||
74 | :- multifile user:term_expansion/6. | |
75 | user:term_expansion(Term1, Layout1, Tokens1, Term2, Layout2, Tokens2) :- | |
76 | nonmember(tools_portability, Tokens1), | |
77 | Term1 == unsupported_term_expansion_style(sicstus), | |
78 | !, | |
79 | Term2 = supported_term_expansion_style(sicstus), | |
80 | Layout2 = Layout1, | |
81 | Tokens2 = [tools_portability|Tokens1]. | |
82 | ||
83 | %! supported_term_expansion_style(+Style). | |
84 | % | |
85 | % True if the Prolog system supports the given style of term_expansion. | |
86 | % Style must be an atom. | |
87 | % The following styles are recognized by this predicate: | |
88 | % | |
89 | % * `traditional`: The traditional style, with no extra parameters - `term_expansion(Term1, Term2)`. | |
90 | % * `swi_layout`: The SWI-Prolog style, with extra parameters for source layout information - `term_expansion(Term1, Layout1, Term2, Layout2)`. | |
91 | % * `sicstus`: The SICStus Prolog style, with extra parameters for source layout information and avoiding duplicate expansion - `term_expansion(Term1, Layout1, Tokens1, Term2, Layout2, Tokens2)`. | |
92 | % | |
93 | % All styles should be defined globally, | |
94 | % i. e. with an explicit `user:` module prefix. | |
95 | % Module-local term expansion is not supported consistently across Prolog systems - | |
96 | % at least SICStus (as of version 4.6) only supports global term expansion. | |
97 | % Some module-local expansions can be implemented using goal_expansion instead. | |
98 | ||
99 | :- discontiguous supported_term_expansion_style/1. | |
100 | supported_term_expansion_style(_) :- fail. | |
101 | ||
102 | :- public unsupported_term_expansion_style/1. % for Spider, processed only be term expansions below | |
103 | ||
104 | unsupported_term_expansion_style(traditional). | |
105 | unsupported_term_expansion_style(swi_layout). | |
106 | unsupported_term_expansion_style(sicstus). | |
107 | ||
108 | % Define all known variants of goal_expansion to detect which ones are supported by the system. | |
109 | ||
110 | supported_goal_expansion_style_inner(_Style) :- fail. | |
111 | ||
112 | goal_expansion(Goal1, Goal2) :- | |
113 | Goal1 == supported_goal_expansion_style_inner(traditional), | |
114 | !, | |
115 | Goal2 = true. | |
116 | ||
117 | goal_expansion(Goal1, Layout1, Goal2, Layout2) :- | |
118 | Goal1 == supported_goal_expansion_style_inner(swi_layout), | |
119 | !, | |
120 | Goal2 = true, | |
121 | Layout2 = Layout1. | |
122 | ||
123 | goal_expansion(Goal1, Layout1, _Module, Goal2, Layout2) :- | |
124 | Goal1 == supported_goal_expansion_style_inner(sicstus), | |
125 | !, | |
126 | Goal2 = true, | |
127 | Layout2 = Layout1. | |
128 | ||
129 | %! supported_goal_expansion_style(+Style). | |
130 | % | |
131 | % True if the Prolog system supports the given style of goal_expansion. | |
132 | % Style must be an atom. | |
133 | % The following styles are recognized by this predicate: | |
134 | % | |
135 | % * `traditional`: The traditional style, with no extra parameters - `goal_expansion(Goal1, Goal2)`. | |
136 | % * `swi_layout`: The SWI-Prolog style, with extra parameters for source layout information - `goal_expansion(Goal1, Layout1, Goal2, Layout2)`. | |
137 | % * `sicstus`: The SICStus Prolog style, with extra parameters for source layout and module information - `goal_expansion(Goal1, Layout1, Module, Goal2, Layout2)`. | |
138 | % | |
139 | % All styles should be defined locally in the module they belong to, | |
140 | % i. e. without an explicit module prefix. | |
141 | % Global goal expansion is not supported consistently across Prolog systems - | |
142 | % at least on SICStus 4.6.0, defining user:goal_expansion/5 has no effect. | |
143 | % Try to avoid unscoped global expansions if possible, | |
144 | % but if really necessary they can be implemented using term_expansion. | |
145 | ||
146 | supported_goal_expansion_style(traditional) :- supported_goal_expansion_style_inner(traditional). | |
147 | supported_goal_expansion_style(swi_layout) :- supported_goal_expansion_style_inner(swi_layout). | |
148 | supported_goal_expansion_style(sicstus) :- supported_goal_expansion_style_inner(sicstus). | |
149 |