View Javadoc

1   /*
2    * #%L
3    * prolobjectlink-jpi-jpl7
4    * %%
5    * Copyright (C) 2019 Prolobjectlink Project
6    * %%
7    * Redistribution and use in source and binary forms, with or without
8    * modification, are permitted provided that the following conditions are met:
9    * 
10   * 1. Redistributions of source code must retain the above copyright notice,
11   *    this list of conditions and the following disclaimer.
12   * 2. Redistributions in binary form must reproduce the above copyright notice,
13   *    this list of conditions and the following disclaimer in the documentation
14   *    and/or other materials provided with the distribution.
15   * 
16   * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
17   * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
18   * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
19   * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR CONTRIBUTORS BE
20   * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
21   * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
22   * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
23   * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
24   * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
25   * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
26   * POSSIBILITY OF SUCH DAMAGE.
27   * #L%
28   */
29  package io.github.prolobjectlink.prolog.jpl7;
30  
31  import java.util.ArrayList;
32  import java.util.Arrays;
33  import java.util.HashMap;
34  import java.util.Iterator;
35  import java.util.List;
36  import java.util.Map;
37  import java.util.NoSuchElementException;
38  
39  import org.jpl7.PrologException;
40  import org.jpl7.Query;
41  import org.jpl7.Term;
42  import org.jpl7.Util;
43  import org.jpl7.Variable;
44  
45  import io.github.prolobjectlink.prolog.AbstractEngine;
46  import io.github.prolobjectlink.prolog.AbstractIterator;
47  import io.github.prolobjectlink.prolog.AbstractQuery;
48  import io.github.prolobjectlink.prolog.PrologError;
49  import io.github.prolobjectlink.prolog.PrologQuery;
50  import io.github.prolobjectlink.prolog.PrologTerm;
51  
52  /**
53   * 
54   * @author Jose Zalacain
55   * @since 1.0
56   */
57  final class JplQuery extends AbstractQuery implements PrologQuery {
58  
59  	private String stringQuery;
60  	private Map<String, PrologTerm>[] solutions;
61  	private Iterator<Map<String, PrologTerm>> iter;
62  
63  	private final List<String> variables = new ArrayList<String>();
64  
65  	private void enumerateVariables(List<String> vector, Term term) {
66  		if (!(term instanceof Variable)) {
67  			Term[] terms = term.args();
68  			for (Term t : terms) {
69  				enumerateVariables(vector, t);
70  			}
71  		} else if (!vector.contains(term.name())) {
72  			vector.add(term.name());
73  		}
74  	}
75  
76  	JplQuery(AbstractEngine engine, String file, String stringQuery) {
77  		super(engine);
78  
79  		if (stringQuery != null && stringQuery.length() > 0) {
80  			this.stringQuery = stringQuery;
81  
82  			// saving variable order
83  			enumerateVariables(variables, Util.textToTerm(stringQuery));
84  
85  			try {
86  
87  				Query.hasSolution("consult('" + file + "')");
88  				Query query = new Query(stringQuery);
89  				Map<String, Term>[] solve = query.allSolutions();
90  				solutions = toTermMapArray(solve, PrologTerm.class);
91  				iter = new JplQueryIter(solutions);
92  
93  			} catch (PrologException e) {
94  				// getLogger().error(getClass(), PrologLogger.RUNTIME_ERROR, e)
95  				Map<String, PrologTerm> m = new HashMap<String, PrologTerm>();
96  				JplReference prologexception = new JplReference(getProvider(), e);
97  				Term error = e.term();
98  				Term exception = error.arg(1);
99  				Term ref = exception.arg(1);
100 				if (ref.isJRef()) {
101 					Object object = ref.object();
102 					if (object instanceof Throwable) {
103 						Throwable k = (Throwable) object;
104 						// getLogger().error(getClass(), PrologLogger.RUNTIME_ERROR, k)
105 						JplReference javaexception = new JplReference(getProvider(), k);
106 						m.put("PrologException", prologexception);
107 						m.put("JavaException", javaexception);
108 						solutions = new Map[] { m };
109 					}
110 				}
111 			}
112 		}
113 
114 	}
115 
116 	public boolean hasSolution() {
117 		return iter != null && iter.hasNext();
118 	}
119 
120 	public boolean hasMoreSolutions() {
121 		return iter != null && iter.hasNext();
122 	}
123 
124 	public PrologTerm[] oneSolution() {
125 		int index = 0;
126 		Map<String, PrologTerm> solution = oneVariablesSolution();
127 		PrologTerm[] array = new PrologTerm[solution.size()];
128 		for (Iterator<String> i = variables.iterator(); i.hasNext();) {
129 			array[index++] = solution.get(i.next());
130 		}
131 		return array;
132 	}
133 
134 	public Map<String, PrologTerm> oneVariablesSolution() {
135 		return solutions.length > 0 ? solutions[0] : new HashMap<String, PrologTerm>();
136 	}
137 
138 	public PrologTerm[] nextSolution() {
139 		int index = 0;
140 		Map<String, PrologTerm> solution = nextVariablesSolution();
141 		PrologTerm[] array = new PrologTerm[solution.size()];
142 		for (Iterator<String> i = variables.iterator(); i.hasNext();) {
143 			array[index++] = solution.get(i.next());
144 		}
145 		return array;
146 	}
147 
148 	public Map<String, PrologTerm> nextVariablesSolution() {
149 		return iter.next();
150 	}
151 
152 	public PrologTerm[][] nSolutions(int n) {
153 		if (n > 0) {
154 			// m:solutionSize
155 			int m = 0;
156 			int index = 0;
157 			ArrayList<PrologTerm[]> all = new ArrayList<PrologTerm[]>();
158 			while (hasNext() && index < n) {
159 				PrologTerm[] solution = nextSolution();
160 				m = solution.length > m ? solution.length : m;
161 				index++;
162 				all.add(solution);
163 			}
164 
165 			PrologTerm[][] allSolutions = new PrologTerm[n][m];
166 			for (int i = 0; i < n; i++) {
167 				PrologTerm[] solution = all.get(i);
168 				for (int j = 0; j < m; j++) {
169 					allSolutions[i][j] = solution[j];
170 				}
171 			}
172 			return allSolutions;
173 		}
174 		throw new PrologError("Impossible find " + n + " solutions");
175 	}
176 
177 	public Map<String, PrologTerm>[] nVariablesSolutions(int n) {
178 		return Arrays.copyOf(solutions, n);
179 	}
180 
181 	public PrologTerm[][] allSolutions() {
182 		// n:solutionCount, m:solutionSize
183 		int n = 0;
184 		int m = 0;
185 		ArrayList<PrologTerm[]> all = new ArrayList<PrologTerm[]>();
186 		while (hasMoreSolutions()) {
187 			PrologTerm[] solution = nextSolution();
188 			m = solution.length > m ? solution.length : m;
189 			n++;
190 			all.add(solution);
191 		}
192 
193 		PrologTerm[][] allSolutions = new PrologTerm[n][m];
194 		for (int i = 0; i < n; i++) {
195 			PrologTerm[] solution = all.get(i);
196 			for (int j = 0; j < m; j++) {
197 				allSolutions[i][j] = solution[j];
198 			}
199 		}
200 		return allSolutions;
201 	}
202 
203 	public Map<String, PrologTerm>[] allVariablesSolutions() {
204 		return solutions;
205 	}
206 
207 	public void dispose() {
208 		iter = null;
209 		variables.clear();
210 		int l = solutions.length;
211 		for (int i = 0; i < l; i++) {
212 			solutions[i].clear();
213 			solutions[i] = null;
214 		}
215 		solutions = null;
216 	}
217 
218 	public List<Map<String, PrologTerm>> all() {
219 		List<Map<String, PrologTerm>> l = new ArrayList<Map<String, PrologTerm>>();
220 		for (Map<String, PrologTerm> map : solutions) {
221 			l.add(map);
222 		}
223 		return l;
224 	}
225 
226 	@Override
227 	public int hashCode() {
228 		final int prime = 31;
229 		int result = super.hashCode();
230 		result = prime * result + stringQuery.hashCode();
231 		result = prime * result + variables.hashCode();
232 		return result;
233 	}
234 
235 	@Override
236 	public boolean equals(Object obj) {
237 		if (this == obj) {
238 			return true;
239 		}
240 		if (!super.equals(obj)) {
241 			return false;
242 		}
243 		if (getClass() != obj.getClass()) {
244 			return false;
245 		}
246 		JplQuery other = (JplQuery) obj;
247 		return variables.equals(other.variables);
248 	}
249 
250 	@Override
251 	public String toString() {
252 		return stringQuery;
253 	}
254 
255 	private class JplQueryIter extends AbstractIterator<Map<String, PrologTerm>>
256 			implements Iterator<Map<String, PrologTerm>> {
257 
258 		private int nextIndex;
259 		private final Map<String, PrologTerm>[] maps;
260 
261 		private JplQueryIter(Map<String, PrologTerm>[] maps) {
262 			this.maps = maps;
263 		}
264 
265 		public boolean hasNext() {
266 			return nextIndex < maps.length;
267 		}
268 
269 		public Map<String, PrologTerm> next() {
270 			if (!hasNext()) {
271 				throw new NoSuchElementException();
272 			}
273 			return maps[nextIndex++];
274 		}
275 
276 	}
277 
278 }