1 | !752 |
2 | |
3 | static class Prolog { |
4 | boolean upperCaseVariables = false; // true for SNL, false for NL |
5 | long varCount; |
6 | boolean showStuff; |
7 | new L<Entry> stack; |
8 | Trail sofar = null; |
9 | new L<Clause> program; |
10 | long steps; |
11 | new L<Native> natives; |
12 | |
13 | // stats |
14 | int maxLevelSeen; // maximum stack level reached during computation |
15 | long topUnifications; |
16 | |
17 | static interface Native { |
18 | public boolean yo(Prolog p, Lisp term); |
19 | } |
20 | |
21 | static class Var extends Lisp { |
22 | long id; |
23 | Lisp instance; |
24 | |
25 | *(S name) { |
26 | super(name); |
27 | instance = this; |
28 | } |
29 | |
30 | *(long id) { |
31 | super("___"); |
32 | this.id = id; |
33 | instance = this; |
34 | } |
35 | |
36 | void reset() { instance = this; } |
37 | |
38 | public String toString() { |
39 | if (instance != this) |
40 | ret instance.toString(); |
41 | ret isUserVar() ? getName() : "_" + id; |
42 | } |
43 | |
44 | boolean isUserVar() { |
45 | ret id == 0; |
46 | } |
47 | |
48 | S getName() { |
49 | ret head; |
50 | } |
51 | |
52 | Lisp getValue() { |
53 | Lisp l = instance; |
54 | while (l instanceof Var) { |
55 | Var v = cast l; |
56 | if (v.instance == v) |
57 | ret v; |
58 | l = v.instance; |
59 | } |
60 | ret l; |
61 | } |
62 | } |
63 | |
64 | class Clause { |
65 | Lisp head; |
66 | Goal body; |
67 | |
68 | *(Lisp *head, Goal *body) {} |
69 | *(Lisp *head) {} |
70 | |
71 | Clause copy() { |
72 | return new Clause(copy2(head), body == null ? null : body.copy()); |
73 | } |
74 | |
75 | public String toString() { |
76 | //ret head + " :- " + (body == null ? "true" : body); |
77 | ret body == null ? head.toString() : head + " :- " + body; |
78 | } |
79 | } |
80 | |
81 | class Trail { |
82 | Var tcar; |
83 | Trail tcdr; |
84 | |
85 | *(Var *tcar, Trail *tcdr) {} |
86 | } |
87 | |
88 | Trail Trail_Note() { return sofar; } |
89 | void Trail_Push(Var x) { sofar = new Trail(x, sofar); } |
90 | void Trail_Undo(Trail whereto) { |
91 | for (; sofar != whereto; sofar = sofar.tcdr) |
92 | sofar.tcar.reset(); |
93 | } |
94 | |
95 | static class TermVarMapping { |
96 | new L<Var> vars; |
97 | |
98 | *(L<Var> *vars) {} |
99 | *(Var... vars) { this.vars.addAll(asList(vars)); } |
100 | |
101 | void showanswer() { |
102 | print("TRUE."); |
103 | for (Var v : vars) |
104 | print(" " + v.getName() + " = " + v); |
105 | } |
106 | } |
107 | |
108 | class Goal { |
109 | Lisp car; |
110 | Goal cdr; |
111 | |
112 | *(Lisp *car, Goal *cdr) {} |
113 | *(Lisp *car) {} |
114 | |
115 | public String toString() { |
116 | ret cdr == null ? car.toString() : car + "; " + cdr; |
117 | } |
118 | |
119 | Goal copy() { |
120 | return new Goal(/* XXX copy2(car) XXX */ Prolog.this.copy(car), |
121 | cdr == null ? null : cdr.copy()); |
122 | } |
123 | |
124 | Goal append(Goal l) { |
125 | return new Goal(car, cdr == null ? null : cdr.append(l)); |
126 | } |
127 | |
128 | } // class Goal |
129 | |
130 | boolean unify(Lisp thiz, Lisp t) { |
131 | if (thiz == null) fail("thiz=null"); |
132 | if (t == null) fail("t=null"); |
133 | |
134 | if (thiz instanceof Var) { // TermVar::unify |
135 | Var v = cast thiz; |
136 | if (v.instance != v) |
137 | return unify(v.instance, t); |
138 | Trail_Push(v); |
139 | v.instance = t; |
140 | return true; |
141 | } |
142 | |
143 | // TermCons::unify |
144 | return unify2(t, thiz); |
145 | } |
146 | |
147 | boolean unify2(Lisp thiz, Lisp t) { |
148 | if (thiz instanceof Var) |
149 | return unify(thiz, t); |
150 | |
151 | int arity = thiz.size(); |
152 | if (neq(thiz.head, t.head) || arity != t.size()) |
153 | return false; |
154 | for (int i = 0; i < arity; i++) |
155 | if (!unify(thiz.get(i), t.get(i))) |
156 | return false; |
157 | return true; |
158 | } |
159 | |
160 | Lisp copy(Lisp thiz) { |
161 | if (thiz instanceof Var) { |
162 | Var v = cast thiz; |
163 | if (v.instance == v) { |
164 | Trail_Push(v); |
165 | v.instance = newVar(); |
166 | } |
167 | return v.instance; |
168 | } |
169 | |
170 | ret copy2(thiz); |
171 | } |
172 | |
173 | Lisp newTermCons(Lisp t) { |
174 | Lisp l = new Lisp(t.head); |
175 | for (Lisp arg : t) |
176 | l.add(copy(arg)); |
177 | ret l; |
178 | } |
179 | |
180 | Lisp copy2(Lisp thiz) { |
181 | return newTermCons(thiz); |
182 | } |
183 | |
184 | Var newVar() { |
185 | ret new Var(++varCount); |
186 | } |
187 | |
188 | Var newVar(S name) { |
189 | ret new Var(name); |
190 | } |
191 | |
192 | Clause clause(Lisp head, Goal body) { |
193 | ret prologify(new Clause(head, body)); |
194 | } |
195 | |
196 | Clause clause(Lisp rule) { |
197 | L<Lisp> ops = snlSplitOps(rule); |
198 | if (showStuff) |
199 | print("clause(Lisp): " + rule + " => " + structure(ops)); |
200 | |
201 | if (!empty(ops) && last(ops).is("then *")) { |
202 | Lisp head = last(ops).get(0); |
203 | Goal goal = null; |
204 | |
205 | // TODO: check the actual words (if/and/...) |
206 | for (int i = l(ops)-2; i >= 0; i--) |
207 | goal = new Goal(ops.get(i).get(0), goal); |
208 | |
209 | ret clause(head, goal); |
210 | } else |
211 | ret clause(rule, (Lisp) null); |
212 | } |
213 | |
214 | Clause clause(Lisp head, Lisp body) { |
215 | ret clause(head, body == null ? null : new Goal(body)); |
216 | } |
217 | |
218 | Lisp prologify(Lisp term) { |
219 | ret prologify(term, new HashMap); |
220 | } |
221 | |
222 | Clause prologify(Clause c) { |
223 | new HashMap vars; |
224 | c = new Clause( |
225 | prologify(c.head, vars), |
226 | prologify(c.body, vars)); |
227 | if (showStuff) |
228 | print("Clause made: " + structure_seen(c)); |
229 | ret c; |
230 | } |
231 | |
232 | Goal prologify(Goal goal, Map<S, Var> vars) { |
233 | if (goal == null) ret null; |
234 | ret new Goal( |
235 | prologify(goal.car, vars), |
236 | prologify(goal.cdr, vars)); |
237 | } |
238 | |
239 | boolean isVar(Lisp term) { |
240 | ret upperCaseVariables ? snlIsVar(term) : nlIsVar(term); |
241 | } |
242 | |
243 | Lisp prologify(Lisp term, Map<S, Var> vars) { |
244 | if (term == null) ret null; |
245 | if (isVar(term)) { |
246 | Var v = vars.get(term.head); |
247 | if (v == null) |
248 | vars.put(term.head, v = newVar(term.head)); |
249 | ret v; |
250 | } else { |
251 | Lisp l = new Lisp(term.head); |
252 | for (Lisp arg : term) |
253 | l.add(prologify(arg, vars)); |
254 | ret l; |
255 | } |
256 | } |
257 | |
258 | L<Var> findVars(Goal g) { |
259 | new IdentityHashMap<Var, Boolean> map; |
260 | while (g != null) { |
261 | findVars(g.car, map); |
262 | g = g.cdr; |
263 | } |
264 | ret asList(map.keySet()); |
265 | } |
266 | |
267 | L<Var> findVars(Lisp term) { |
268 | new IdentityHashMap<Var, Boolean> map; |
269 | findVars(term, map); |
270 | ret asList(map.keySet()); |
271 | } |
272 | |
273 | void findVars(Lisp term, IdentityHashMap<Var, Boolean> map) { |
274 | if (term instanceof Var) |
275 | map.put((Var) term, Boolean.TRUE); |
276 | else |
277 | for (Lisp arg : term) |
278 | findVars(arg, map); |
279 | } |
280 | |
281 | static Map<S, Var> makeVarMap(L<Var> vars) { |
282 | new HashMap<S, Var> map; |
283 | for (Var v : vars) |
284 | map.put(v.getName(), v); |
285 | ret map; |
286 | } |
287 | |
288 | // Executor stack entry |
289 | static class Entry { |
290 | Goal goal; |
291 | int programIdx = -1; // -1 is natives |
292 | Trail trail; |
293 | boolean trailSet; |
294 | boolean cutPoint; |
295 | |
296 | *(Goal *goal) {} |
297 | } |
298 | |
299 | void start(Lisp goal) { |
300 | start(new Goal(prologify(goal))); |
301 | } |
302 | |
303 | // warning: doesn't prologify the goal |
304 | void start(Goal goal) { |
305 | if (showStuff) |
306 | print("start: " + structure_seen(goal)); |
307 | steps = 0; |
308 | stack = new L; |
309 | Trail_Undo(null); |
310 | stackAdd(new Entry(goal)); |
311 | } |
312 | |
313 | int level() { |
314 | ret l(stack)-1; |
315 | } |
316 | |
317 | boolean done() { |
318 | ret empty(stack); |
319 | } |
320 | |
321 | boolean gnext(Goal g) { |
322 | Goal gdash = g.cdr; |
323 | if (gdash == null) |
324 | ret true; |
325 | else { |
326 | stackAdd(new Entry(gdash)); |
327 | ret false; |
328 | } |
329 | } |
330 | |
331 | void stackPop() { |
332 | Entry e = popLast(stack); |
333 | if (e.trailSet) |
334 | Trail_Undo(e.trail); |
335 | } |
336 | |
337 | void backToCutPoint() { |
338 | if (showStuff) |
339 | print("back to cut point."); |
340 | while (!empty(stack) && !last(stack).cutPoint) { |
341 | if (showStuff) |
342 | print("cut: dropping " + structure(last(stack))); |
343 | stackPop(); |
344 | } |
345 | for (int i = 0; i < 2; i++) { |
346 | if (!empty(stack)) { |
347 | if (showStuff) |
348 | print("cut: dropping " + i + " " + structure(last(stack))); |
349 | stackPop(); |
350 | } |
351 | } |
352 | } |
353 | |
354 | boolean step() { |
355 | if (done()) fail("done!"); // safety |
356 | |
357 | ++steps; |
358 | Entry e = last(stack); |
359 | |
360 | if (e.trailSet) { |
361 | Trail_Undo(e.trail); |
362 | e.trailSet = false; |
363 | } |
364 | |
365 | e.trail = Trail_Note(); |
366 | e.trailSet = true; |
367 | |
368 | // cut operator - suceeds first time |
369 | if (e.goal.car.is("!", 0)) { |
370 | if (showStuff) |
371 | print("cut " + e.programIdx + ". " + structure(e.goal)); |
372 | if (e.programIdx == -1) { |
373 | ++e.programIdx; |
374 | ret gnext(e.goal); |
375 | } else if (e.programIdx == 0) { |
376 | ++e.programIdx; |
377 | // fails 2nd time and cuts |
378 | //e.goal.car.head = "false"; // super-hack :D |
379 | backToCutPoint(); |
380 | ret false; |
381 | } else { |
382 | stackPop(); |
383 | ret false; |
384 | } |
385 | } |
386 | |
387 | if (e.programIdx >= l(program)) { // program loop ends |
388 | removeLast(stack); |
389 | ret false; |
390 | } |
391 | |
392 | if (e.programIdx == -1) { |
393 | if (showStuff) |
394 | print(indent(level()) + "solve@" + level() + ": " + e.goal); |
395 | ++e.programIdx; |
396 | |
397 | // try native functions |
398 | if (goNative(e.goal.car)) { |
399 | if (showStuff) |
400 | print(indent(level()) + "native!"); |
401 | |
402 | ret gnext(e.goal); |
403 | } |
404 | |
405 | ret false; |
406 | } |
407 | |
408 | // now in program loop |
409 | |
410 | Clause c = program.get(e.programIdx).copy(); |
411 | ++e.programIdx; |
412 | Trail_Undo(e.trail); |
413 | if (showStuff) |
414 | print(indent(level()) + " try:" + c); |
415 | ++topUnifications; |
416 | if (unify(e.goal.car, c.head)) { |
417 | Goal gdash = c.body == null ? e.goal.cdr : c.body.append(e.goal.cdr); |
418 | if (gdash == null) |
419 | ret true; |
420 | else { |
421 | Entry e2 = new Entry(gdash); |
422 | if (c.body != null) |
423 | e2.cutPoint = true; |
424 | stackAdd(e2); |
425 | ret false; |
426 | } |
427 | } else |
428 | if (showStuff) |
429 | print(indent(level()) + " nomatch."); |
430 | |
431 | ret false; |
432 | } |
433 | |
434 | void stackAdd(Entry e) { |
435 | stack.add(e); |
436 | int n = l(stack); |
437 | if (n > maxLevelSeen) maxLevelSeen = n; |
438 | } |
439 | |
440 | void addClause(Lisp c) { |
441 | program.add(clause(c)); |
442 | } |
443 | |
444 | void addClause(Clause c) { |
445 | program.add(c); |
446 | } |
447 | |
448 | boolean canSolve(Lisp goal) { |
449 | ret canSolve(new Goal(prologify(goal))); |
450 | } |
451 | |
452 | boolean canSolve(Goal goal) { |
453 | start(goal); |
454 | while (!done()) |
455 | if (step()) |
456 | ret true; |
457 | ret false; |
458 | } |
459 | |
460 | // return variable map or null if unsolved |
461 | Map<S, Lisp> solve(Lisp goal) { |
462 | Goal g = new Goal(prologify(goal)); |
463 | if (!canSolve(g)) |
464 | ret null; |
465 | ret getUserVarMap(); |
466 | } |
467 | |
468 | Map<S, Lisp> getUserVarMap() { |
469 | Goal g = stack.get(0).goal; |
470 | new HashMap<S, Lisp> map; |
471 | for (Var v : findVars(g)) |
472 | if (v.isUserVar()) |
473 | map.put(v.getName(), v.getValue()); |
474 | ret map; |
475 | } |
476 | |
477 | Map<S, Lisp> nextSolution() { |
478 | while (!done()) |
479 | if (step()) |
480 | ret getUserVarMap(); |
481 | ret null; |
482 | } |
483 | |
484 | void addClauses(Lisp tree) { |
485 | if (nlIsMultipleStatements(tree)) |
486 | for (Lisp part : tree) |
487 | addClause(part); |
488 | else |
489 | addClause(tree); |
490 | } |
491 | |
492 | boolean goNative(Lisp term) { |
493 | term = resolve(term); |
494 | |
495 | for (Native n : natives) { |
496 | Trail t = Trail_Note(); |
497 | boolean result; |
498 | try { |
499 | result = n.yo(this, term); |
500 | } catch (Exception e) { |
501 | Trail_Undo(t); |
502 | continue; |
503 | } |
504 | if (!result) { |
505 | Trail_Undo(t); |
506 | continue; |
507 | } |
508 | ret true; |
509 | } |
510 | |
511 | if (term.is("nativeTest", 0)) |
512 | ret true; |
513 | |
514 | if (term.is("true", 0)) |
515 | ret true; |
516 | |
517 | if (term.is("isQuoted", 1)) { |
518 | Lisp x = term.get(0); |
519 | ret !(x instanceof Var) && x.isLeaf() && isQuoted(x.head); |
520 | } |
521 | |
522 | ret false; |
523 | } |
524 | |
525 | // resolve all variables |
526 | Lisp resolve(Lisp term) { |
527 | if (term instanceof Var) |
528 | ret ((Var) term).getValue(); |
529 | |
530 | // smart recurse |
531 | for (int i = 0; i < term.size(); i++) { |
532 | Lisp l = term.get(i); |
533 | Lisp r = resolve(l); |
534 | if (l != r) { |
535 | Lisp x = new Lisp(term.head); |
536 | for (int j = 0; j < i; j++) |
537 | x.add(term.get(j)); |
538 | x.add(r); |
539 | for (i++; i < term.size(); i++) |
540 | x.add(resolve(term.get(i))); |
541 | ret x; |
542 | } |
543 | } |
544 | |
545 | ret term; |
546 | } |
547 | |
548 | // looks for a bodyless rule in the program that matches the term |
549 | boolean containsStatement(Lisp term) { |
550 | for (Clause c : program) |
551 | if (c.body == null && eq(c.head, term)) |
552 | ret true; |
553 | ret false; |
554 | } |
555 | |
556 | // closed == contains no variables |
557 | boolean isClosedTerm(Lisp term) { |
558 | if (term instanceof Var) |
559 | ret false; |
560 | else |
561 | for (Lisp arg : term) |
562 | if (!isClosedTerm(arg)) |
563 | ret false; |
564 | ret true; |
565 | } |
566 | |
567 | void addNative(Native n) { |
568 | natives.add(n); |
569 | } |
570 | |
571 | L<Lisp> getStackTerms() { |
572 | new L<Lisp> l; |
573 | for (Entry e : stack) |
574 | l.add(e.goal.car); |
575 | ret l; |
576 | } |
577 | |
578 | } // class Prolog |
Began life as a copy of #1002823
download show line numbers debug dex old transpilations
Travelled to 13 computer(s): aoiabmzegqzx, bhatertpkbcr, cbybwowwnfue, cfunsshuasjs, gwrvuhgaqvyk, ishqpsrjomds, lpdgvwnxivlt, mqqgnosmbjvj, pyentgdyhuwx, pzhvpgtvlbxg, tslmcundralx, tvejysmllsmz, vouqrxazstgt
No comments. add comment
Snippet ID: | #1002826 |
Snippet name: | class Prolog (old, current in #1002855) |
Eternal ID of this version: | #1002826/1 |
Text MD5: | 5c6776886d5283e0f0c53c53c1dcbc39 |
Author: | stefan |
Category: | javax |
Type: | JavaX fragment (include) |
Public (visible to everyone): | Yes |
Archived (hidden from active list): | No |
Created/modified: | 2016-03-05 17:34:45 |
Source code size: | 12823 bytes / 578 lines |
Pitched / IR pitched: | No / No |
Views / Downloads: | 717 / 898 |
Referenced in: | [show references] |