├── notes ├── test ├── test_leancop.py └── test_trs.py ├── prologsolvers ├── sat │ ├── __init__.py │ ├── results-learning.txt │ ├── results-back.txt │ ├── results-core.txt │ ├── results-restore.txt │ ├── results-freeze.txt │ ├── results-instrumented.txt │ ├── results-when.txt │ ├── sat_solver_core.pl │ ├── sat_solver_when.pl │ ├── sat_solver_freeze.pl │ ├── theory.pl │ ├── linear_theory.pl │ ├── sat_solver_instrumented.pl │ ├── harness.pl │ ├── static_var_order.pl │ ├── sat_solver_restore.pl │ ├── smt.pl │ ├── sat_solver_learning.pl │ ├── sat_solver_back.pl │ ├── sudoku.pl │ ├── parser.pl │ ├── normalise.pl │ └── uninterpreted_theory.pl ├── setlog │ ├── __init__.py │ ├── setlog_rules.pl │ ├── size_solver.pl │ └── setlog_tc.pl ├── __init__.py ├── leancop.py ├── trs.py └── nanocopi.py ├── .gitignore ├── pyproject.toml ├── README.md └── play.ipynb /notes: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /test/test_leancop.py: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /prologsolvers/sat/__init__.py: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /prologsolvers/setlog/__init__.py: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /prologsolvers/__init__.py: -------------------------------------------------------------------------------- 1 | import janus_swi as janus 2 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *.egg-info 2 | *.egg 3 | *.pyc 4 | *.pyo 5 | */__pycache__ -------------------------------------------------------------------------------- /test/test_trs.py: -------------------------------------------------------------------------------- 1 | from prologsolvers import trs 2 | import janus_swi as janus 3 | 4 | 5 | def test(): 6 | janus.consult("trs", data=trs.code) 7 | assert janus.query_once("equations_trs([a = b, b = c, e = f], Rs)") 8 | assert False 9 | -------------------------------------------------------------------------------- /prologsolvers/sat/results-learning.txt: -------------------------------------------------------------------------------- 1 | chat_80_1 13/31 0 sat 2 | chat_80_2 12/30 0 sat 3 | chat_80_3 8/14 0 sat 4 | chat_80_4 7/16 0 sat 5 | chat_80_5 7/16 0 sat 6 | chat_80_6 8/14 0 sat 7 | uf20-0903 20/91 0 sat 8 | uf50-0429 50/218 10 sat 9 | uf100-0658 100/430 70 sat 10 | uf150-046 150/645 3260 sat 11 | uuf50-0168 50/218 10 unsat 12 | uuf100-0592 100/430 160 unsat 13 | uuf150-089 150/645 14690 unsat 14 | 2bitcomp_5 95/310 120 sat 15 | flat200-90 600/2237 100 sat 16 | -------------------------------------------------------------------------------- /prologsolvers/sat/results-back.txt: -------------------------------------------------------------------------------- 1 | chat_80_1 13/31 0 sat 2 | chat_80_2 12/30 0 sat 3 | chat_80_3 8/14 0 sat 4 | chat_80_4 7/16 0 sat 5 | chat_80_5 7/16 0 sat 6 | chat_80_6 8/14 0 sat 7 | uf20-0903 20/91 0 sat 8 | uf50-0429 50/218 10 sat 9 | uf100-0658 100/430 30 sat 10 | uf150-046 150/645 260 sat 11 | uf250-091 250/1065 4850 sat 12 | uuf50-0168 50/218 0 unsat 13 | uuf100-0592 100/430 60 unsat 14 | uuf150-089 150/645 1320 unsat 15 | 2bitcomp_5 95/310 0 sat 16 | flat200-90 600/2237 40 sat 17 | -------------------------------------------------------------------------------- /prologsolvers/sat/results-core.txt: -------------------------------------------------------------------------------- 1 | chat_80_1 13/31 0 sat 2 | chat_80_2 12/30 0 sat 3 | chat_80_3 8/14 0 sat 4 | chat_80_4 7/16 0 sat 5 | chat_80_5 7/16 0 sat 6 | chat_80_6 8/14 0 sat 7 | uf20-0903 20/91 0 sat 8 | uf50-0429 50/218 0 sat 9 | uf100-0658 100/430 20 sat 10 | uf150-046 150/645 160 sat 11 | uf250-091 250/1065 2720 sat 12 | uuf50-0168 50/218 10 unsat 13 | uuf100-0592 100/430 30 unsat 14 | uuf150-089 150/645 820 unsat 15 | 2bitcomp_5 95/310 10 sat 16 | flat200-90 600/2237 30 sat 17 | -------------------------------------------------------------------------------- /prologsolvers/sat/results-restore.txt: -------------------------------------------------------------------------------- 1 | chat_80_1 13/31 0 sat 2 | chat_80_2 12/30 0 sat 3 | chat_80_3 8/14 0 sat 4 | chat_80_4 7/16 0 sat 5 | chat_80_5 7/16 0 sat 6 | chat_80_6 8/14 0 sat 7 | uf20-0903 20/91 0 sat 8 | uf50-0429 50/218 0 sat 9 | uf100-0658 100/430 20 sat 10 | uf150-046 150/645 160 sat 11 | uf250-091 250/1065 2740 sat 12 | uuf50-0168 50/218 10 unsat 13 | uuf100-0592 100/430 40 unsat 14 | uuf150-089 150/645 830 unsat 15 | 2bitcomp_5 95/310 10 sat 16 | flat200-90 600/2237 30 sat 17 | -------------------------------------------------------------------------------- /prologsolvers/sat/results-freeze.txt: -------------------------------------------------------------------------------- 1 | chat_80_1 13/31 0 sat 2 | chat_80_2 12/30 0 sat 3 | chat_80_3 8/14 0 sat 4 | chat_80_4 7/16 0 sat 5 | chat_80_5 7/16 0 sat 6 | chat_80_6 8/14 0 sat 7 | uf20-0903 20/91 0 sat 8 | uf50-0429 50/218 10 sat 9 | uf100-0658 100/430 50 sat 10 | uf150-046 150/645 410 sat 11 | uf250-091 250/1065 6860 sat 12 | uuf50-0168 50/218 10 unsat 13 | uuf100-0592 100/430 100 unsat 14 | uuf150-089 150/645 2060 unsat 15 | 2bitcomp_5 95/310 10 sat 16 | flat200-90 600/2237 60 sat 17 | -------------------------------------------------------------------------------- /prologsolvers/sat/results-instrumented.txt: -------------------------------------------------------------------------------- 1 | chat_80_1 13/31 0 sat 2 | chat_80_2 12/30 0 sat 3 | chat_80_3 8/14 0 sat 4 | chat_80_4 7/16 0 sat 5 | chat_80_5 7/16 0 sat 6 | chat_80_6 8/14 0 sat 7 | uf20-0903 20/91 0 sat 8 | uf50-0429 50/218 10 sat 9 | uf100-0658 100/430 20 sat 10 | uf150-046 150/645 160 sat 11 | uf250-091 250/1065 2770 sat 12 | uuf50-0168 50/218 0 unsat 13 | uuf100-0592 100/430 40 unsat 14 | uuf150-089 150/645 830 unsat 15 | 2bitcomp_5 95/310 10 sat 16 | flat200-90 600/2237 30 sat 17 | -------------------------------------------------------------------------------- /prologsolvers/sat/results-when.txt: -------------------------------------------------------------------------------- 1 | chat_80_1 13/31 0 sat 2 | chat_80_2 12/30 10 sat 3 | chat_80_3 8/14 0 sat 4 | chat_80_4 7/16 0 sat 5 | chat_80_5 7/16 0 sat 6 | chat_80_6 8/14 0 sat 7 | uf20-0903 20/91 0 sat 8 | uf50-0429 50/218 20 sat 9 | uf100-0658 100/430 60 sat 10 | uf150-046 150/645 570 sat 11 | uf250-091 250/1065 9250 sat 12 | uuf50-0168 50/218 10 unsat 13 | uuf100-0592 100/430 140 unsat 14 | uuf150-089 150/645 2960 unsat 15 | 2bitcomp_5 95/310 20 sat 16 | flat200-90 600/2237 80 sat 17 | -------------------------------------------------------------------------------- /pyproject.toml: -------------------------------------------------------------------------------- 1 | [project] 2 | name = "prologsolvers" 3 | version = "0.1.1" 4 | authors = [{ name = "Philip Zucker", email = "philzook58@gmail.com" }] 5 | description = "Prolog Provers" 6 | readme = "README.md" 7 | license = { file = "LICENSE" } 8 | classifiers = [ 9 | "Programming Language :: Python :: 3", 10 | "License :: OSI Approved :: MIT License", 11 | "Operating System :: OS Independent", 12 | ] 13 | dependencies = ["janus_swi"] 14 | [project.urls] 15 | #homepage = "https://github.com/philzook58/knuckledragger" 16 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Prolog Solvers 2 | 3 | These are prolog solvers wrapped to be more easily callable from python. Rights reserved by original authors. 4 | 5 | - trs 6 | - leancop 7 | - setlog 8 | - sat/smt 9 | - 10 | 11 | todo 12 | 13 | - leantap 14 | - ileancop 15 | - nanocop-m i etc 16 | - Resolution 17 | - 18 | - PTTP 19 | - PRESS 20 | - Recent prolog verification 21 | - SATCHMO 22 | - g4ip 23 | - 24 | - CHR stuff? 25 | 26 | Packages for swi 27 | 28 | - clpb 29 | - clp(fd) 30 | - s(CASP) 31 | - reif 32 | - 33 | - 34 | - 35 | - 36 | - aleph inductive logic programming 37 | - tabling 38 | - 39 | 40 | See also: 41 | 42 | - picat 43 | - clingo 44 | - minizinc 45 | - minikaren with constraints 46 | -------------------------------------------------------------------------------- /prologsolvers/sat/sat_solver_core.pl: -------------------------------------------------------------------------------- 1 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 2 | %A sat solver, utilising delay declaration to implement 3 | %watched literals 4 | % 5 | %Authors: Jacob Howe and Andy King 6 | %Last modified: 5/4/11 7 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 8 | 9 | :- module(sat_solver, [initialise/1, sat/2, search/4]). 10 | 11 | initialise(_). 12 | 13 | search(Clauses, Vars, Sat, _) :- 14 | sat(Clauses, Vars), 15 | !, 16 | Sat = true. 17 | search(_Clauses, _Vars, false, _). 18 | 19 | sat(Clauses, Vars) :- 20 | problem_setup(Clauses), elim_var(Vars). 21 | 22 | elim_var([]). 23 | elim_var([Var | Vars]) :- 24 | elim_var(Vars), assign(Var). 25 | 26 | assign(true). 27 | assign(false). 28 | 29 | problem_setup([]). 30 | problem_setup([Clause | Clauses]) :- 31 | clause_setup(Clause), 32 | problem_setup(Clauses). 33 | 34 | clause_setup([Pol-Var | Pairs]) :- set_watch(Pairs, Var, Pol). 35 | 36 | set_watch([], Var, Pol) :- Var = Pol. 37 | set_watch([Pol2-Var2 | Pairs], Var1, Pol1):- 38 | watch(Var1, Pol1, Var2, Pol2, Pairs). 39 | 40 | :- block watch(-, ?, -, ?, ?). 41 | watch(Var1, Pol1, Var2, Pol2, Pairs) :- 42 | nonvar(Var1) -> 43 | update_watch(Var1, Pol1, Var2, Pol2, Pairs); 44 | update_watch(Var2, Pol2, Var1, Pol1, Pairs). 45 | 46 | update_watch(Var1, Pol1, Var2, Pol2, Pairs) :- 47 | Var1 == Pol1 -> true; set_watch(Pairs, Var2, Pol2). 48 | -------------------------------------------------------------------------------- /prologsolvers/sat/sat_solver_when.pl: -------------------------------------------------------------------------------- 1 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 2 | %A sat solver, utilising delay declaration to implement 3 | %watched literals 4 | % 5 | %Version using when for delay (SWI) 6 | % 7 | %Authors: Jacob Howe and Andy King 8 | %Last modified: 4/4/11 9 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 10 | 11 | :- module(sat_solver, [initialise/1, sat/2, search/4]). 12 | 13 | initialise(_). 14 | 15 | search(Clauses, Vars, Sat, _) :- 16 | sat(Clauses, Vars), 17 | !, 18 | Sat = true. 19 | search(_Clauses, _Vars, false, _). 20 | 21 | sat(Clauses, Vars) :- 22 | problem_setup(Clauses), elim_var(Vars). 23 | 24 | elim_var([]). 25 | elim_var([Var | Vars]) :- 26 | elim_var(Vars), (Var = true; Var = false). 27 | 28 | problem_setup([]). 29 | problem_setup([Clause | Clauses]) :- 30 | clause_setup(Clause), 31 | problem_setup(Clauses). 32 | 33 | clause_setup([Pol-Var | Pairs]) :- set_watch(Pairs, Var, Pol). 34 | 35 | set_watch([], Var, Pol) :- Var = Pol. 36 | set_watch([Pol2-Var2 | Pairs], Var1, Pol1) :- 37 | when(;(nonvar(Var1),nonvar(Var2)),watch(Var1, Pol1, Var2, Pol2, Pairs)). 38 | 39 | watch(Var1, Pol1, Var2, Pol2, Pairs) :- 40 | nonvar(Var1) -> 41 | update_watch(Var1, Pol1, Var2, Pol2, Pairs); 42 | update_watch(Var2, Pol2, Var1, Pol1, Pairs). 43 | 44 | update_watch(Var1, Pol1, Var2, Pol2, Pairs) :- 45 | Var1 == Pol1 -> true; set_watch(Pairs, Var2, Pol2). 46 | -------------------------------------------------------------------------------- /prologsolvers/sat/sat_solver_freeze.pl: -------------------------------------------------------------------------------- 1 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 2 | %A sat solver, utilising delay declaration to implement 3 | %watched literals. 4 | % 5 | %Version using freeze for delay (SWI) 6 | % 7 | %Authors: Jacob Howe and Andy King 8 | %Last modified: 5/4/11 9 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 10 | 11 | :- module(sat_solver, [initialise/1, sat/2, search/4]). 12 | 13 | initialise(_). 14 | 15 | search(Clauses, Vars, Sat, _) :- 16 | sat(Clauses, Vars), 17 | !, 18 | Sat = true. 19 | search(_Clauses, _Vars, false, _). 20 | 21 | sat(Clauses, Vars) :- 22 | problem_setup(Clauses), elim_var(Vars). 23 | 24 | elim_var([]). 25 | elim_var([Var | Vars]) :- 26 | elim_var(Vars), (Var = true; Var = false). 27 | 28 | problem_setup([]). 29 | problem_setup([Clause | Clauses]) :- 30 | clause_setup(Clause), 31 | problem_setup(Clauses). 32 | 33 | clause_setup([Pol-Var | Pairs]) :- 34 | set_watch(Pairs, Var, Pol). 35 | 36 | set_watch([], Var, Pol) :- Var = Pol. 37 | set_watch([Pol2-Var2 | Pairs], Var1, Pol1) :- 38 | freeze(Var1,V=u), %u is simply a flag 39 | freeze(Var2,V=u), 40 | freeze(V, watch(Var1,Pol1,Var2,Pol2,Pairs)). 41 | 42 | watch(Var1, Pol1, Var2, Pol2, Pairs) :- 43 | nonvar(Var1) -> 44 | update_watch(Var1, Pol1, Var2, Pol2, Pairs); 45 | update_watch(Var2, Pol2, Var1, Pol1, Pairs). 46 | 47 | update_watch(Var1, Pol1, Var2, Pol2, Pairs) :- 48 | Var1 == Pol1 -> true; set_watch(Pairs, Var2, Pol2). 49 | -------------------------------------------------------------------------------- /prologsolvers/sat/theory.pl: -------------------------------------------------------------------------------- 1 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 2 | %Decision procedure for conjunctions of literals in the 3 | %theory of linear real arithmetic for an SMT solver. 4 | %Coded for SICStus, requires CLP(R). 5 | % 6 | %Authors: Jacob Howe and Andy King 7 | %Last modified: 10/9/10 8 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 9 | 10 | :- module(theory, [post_all/1, unsat_core/3]). 11 | :- use_module(library(clpr)). 12 | :- use_module(library(assoc)). 13 | 14 | post_all([]). 15 | post_all([Val-C|Cs]):- 16 | post_con(Val, C), 17 | post_all(Cs). 18 | 19 | post_con(true, Con) :- post_true(Con). 20 | post_con(false, Con) :- post_false(Con). 21 | 22 | post_true(triv). 23 | post_true(X=Y}. 29 | post_false(X=Y}. 30 | post_false(X=Y) :- {X=\=Y}. 31 | 32 | unsat_core(VarMap, ConsMap, Min) :- 33 | assoc_to_vals(VarMap, ConsMap, [], Cons), 34 | remove_redundant(Cons, [], [], Min). 35 | 36 | assoc_to_vals([], _, Cons, Cons). 37 | assoc_to_vals([Val-Var|VarMap], ConsMap, Acc, Vs) :- 38 | get_assoc(Var, ConsMap, Con), 39 | assoc_to_vals(VarMap, ConsMap, [Val-Con|Acc], Vs). 40 | 41 | check_redundant(Val-Con, Cons, TestedCons, Core, Min) :- 42 | append(Cons, TestedCons, AllCons), 43 | copy_term(AllCons, CopyCons), 44 | post_all(CopyCons),!, 45 | remove_redundant(Cons, [Val-Con | TestedCons], [Val | Core], Min). 46 | check_redundant(_, Cons, Tested, Core, Min) :- 47 | remove_redundant(Cons, Tested, [na | Core], Min). 48 | 49 | remove_redundant([], _, Min, Min). 50 | remove_redundant([C|Cs],Tested, Core, Min) :- 51 | check_redundant(C, Cs, Tested, Core, Min). 52 | -------------------------------------------------------------------------------- /prologsolvers/sat/linear_theory.pl: -------------------------------------------------------------------------------- 1 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 2 | %Decision procedure for conjunctions of literals in the 3 | %theory of linear real arithmetic for an SMT solver. 4 | %Coded for SICStus, requires CLP(R). 5 | % 6 | %Authors: Jacob Howe and Andy King 7 | %Last modified: 10/9/10 8 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 9 | 10 | :- module(theory, [post_all/1, unsat_core/3]). 11 | :- use_module(library(clpr)). 12 | :- use_module(library(assoc)). 13 | 14 | post_all([]). 15 | post_all([Val-C|Cs]):- 16 | post_con(Val, C), 17 | post_all(Cs). 18 | 19 | post_con(true, Con) :- post_true(Con). 20 | post_con(false, Con) :- post_false(Con). 21 | 22 | post_true(triv). 23 | post_true(X=Y}. 29 | post_false(X=Y}. 30 | post_false(X=Y) :- {X=\=Y}. 31 | 32 | unsat_core(VarMap, ConsMap, Min) :- 33 | assoc_to_vals(VarMap, ConsMap, [], Cons), 34 | remove_redundant(Cons, [], [], Min). 35 | 36 | assoc_to_vals([], _, Cons, Cons). 37 | assoc_to_vals([Val-Var|VarMap], ConsMap, Acc, Vs) :- 38 | get_assoc(Var, ConsMap, Con), 39 | assoc_to_vals(VarMap, ConsMap, [Val-Con|Acc], Vs). 40 | 41 | check_redundant(Val-Con, Cons, TestedCons, Core, Min) :- 42 | append(Cons, TestedCons, AllCons), 43 | copy_term(AllCons, CopyCons), 44 | post_all(CopyCons),!, 45 | remove_redundant(Cons, [Val-Con | TestedCons], [Val | Core], Min). 46 | check_redundant(_, Cons, Tested, Core, Min) :- 47 | remove_redundant(Cons, Tested, [na | Core], Min). 48 | 49 | remove_redundant([], _, Min, Min). 50 | remove_redundant([C|Cs],Tested, Core, Min) :- 51 | check_redundant(C, Cs, Tested, Core, Min). 52 | -------------------------------------------------------------------------------- /prologsolvers/sat/sat_solver_instrumented.pl: -------------------------------------------------------------------------------- 1 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 2 | %SAT solver with addition machinery to produce table in 3 | %FLOPS2010 paper. Note this setup prevents backtracking 4 | %for further solutions. 5 | % 6 | %Authors: Jacob Howe and Andy King 7 | %Last modified: 5/4/11 8 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 9 | 10 | :- use_module(library(terms)). 11 | :- use_module(library(lists)). 12 | 13 | :- module(sat_solver, [initialise/1, sat/2, search/4]). 14 | 15 | initialise(_). 16 | 17 | search(Clauses, Vs, Sat, N):- 18 | bb_put(count, 0), 19 | sat(Clauses, Vs),!, 20 | bb_get(count, N), 21 | Sat = true. 22 | search(_, _, false, N):- 23 | bb_get(count, N). 24 | 25 | sat(Clauses, Vars) :- 26 | problem_setup(Clauses), elim_var(Vars). 27 | 28 | elim_var([]). 29 | elim_var([Var | Vars]) :- 30 | elim_var(Vars), 31 | ( 32 | (bb_get(count,N),(var(Var)->NewN is N+1; NewN = N), 33 | Var = true, 34 | bb_put(count,NewN)); 35 | (bb_get(count,M),(var(Var)->NewM is M+1; NewM = M), 36 | Var = false, 37 | bb_put(count, NewM)) 38 | ). 39 | 40 | problem_setup([]). 41 | problem_setup([Clause | Clauses]) :- 42 | clause_setup(Clause), 43 | problem_setup(Clauses). 44 | 45 | clause_setup([Pol-Var | Pairs]) :- set_watch(Pairs, Var, Pol). 46 | 47 | set_watch([], Var, Pol) :- Var = Pol. 48 | set_watch([Pol2-Var2 | Pairs], Var1, Pol1):- 49 | watch(Var1, Pol1, Var2, Pol2, Pairs). 50 | 51 | :- block watch(-, ?, -, ?, ?). 52 | watch(Var1, Pol1, Var2, Pol2, Pairs) :- 53 | nonvar(Var1) -> 54 | update_watch(Var1, Pol1, Var2, Pol2, Pairs); 55 | update_watch(Var2, Pol2, Var1, Pol1, Pairs). 56 | 57 | update_watch(Var1, Pol1, Var2, Pol2, Pairs) :- 58 | Var1 == Pol1 -> true; set_watch(Pairs, Var2, Pol2). 59 | 60 | -------------------------------------------------------------------------------- /prologsolvers/sat/harness.pl: -------------------------------------------------------------------------------- 1 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 2 | %Harness for SAT solver 3 | % 4 | %author: Jacob Howe and Andy King 5 | %Last edited: 5/4/11/ 6 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 7 | 8 | :- use_module(library(timeout)). 9 | :- use_module(parser). 10 | :- use_module(static_var_order). 11 | 12 | %:- use_module(sat_solver_core). 13 | %:- use_module(sat_solver_back). 14 | %:- use_module(sat_solver_instrumented). 15 | :- use_module(sat_solver_learning). 16 | %:- use_module(sat_solver_restore). 17 | %:- use_module(sat_solver_freeze). 18 | %:- use_module(sat_solver_when). 19 | 20 | main :- 21 | harness(_File), 22 | fail. 23 | main. 24 | 25 | harness(File) :- 26 | parser(File, Clauses, Vars), 27 | order_variables(Clauses, Vars, Ordered_Vars), 28 | statistics(runtime, [Start, _]), 29 | initialise([]), 30 | time_out(search(Clauses, Ordered_Vars, Sat, _), 60000, Success), 31 | % search(Clauses, Ordered_Vars, Sat, _), Success = success, 32 | statistics(runtime, [Finish, _]), 33 | Time is Finish - Start, 34 | length(Clauses, NClauses), 35 | length(Vars, NVars), 36 | harness_aux(Success, Sat, File, NClauses, NVars, Time, Vars). 37 | 38 | harness_aux(timeout, _Sat, File, NClauses, NVars, Time, _Vars) :- 39 | format("~w~c~w/~w~c>~w~n", [File, 9, NVars, NClauses, 9, Time]). 40 | harness_aux(success, true, File, NClauses, NVars, Time, _Vars) :- 41 | % trim(Vars, TrimVars, 32), 42 | format("~w~c~w/~w~c~w~c~w~n", [File, 9, NVars, NClauses, 9, Time, 9, sat]). 43 | harness_aux(success, false, File, NClauses, NVars, Time, _Vars) :- 44 | format("~w~c~w/~w~c~w~c~w~n", [File, 9, NVars, NClauses, 9, Time, 9, unsat]). 45 | 46 | %trim([], [], _). 47 | %trim([_ | _], [...], 0) :- !. 48 | %trim([true | Vs], [1 | Ts], N) :- 49 | % N >= 0, !, 50 | % N1 is N - 1, 51 | % trim(Vs, Ts, N1). 52 | %trim([false | Vs], [0 | Ts], N) :- 53 | % N >= 0, 54 | % N1 is N - 1, 55 | % trim(Vs, Ts, N1). 56 | 57 | -------------------------------------------------------------------------------- /prologsolvers/sat/static_var_order.pl: -------------------------------------------------------------------------------- 1 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 2 | %Static variable ordering for a SAT solver 3 | % 4 | %Authors: Jacob Howe and Andy King 5 | %Last modified: 5/4/11 6 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 7 | 8 | :- module(static_var_order, [order_variables/3]). 9 | :- use_module(library(lists)). 10 | 11 | order_variables(Clauses, Vars, Ordered_Vars):- 12 | initial_counts(Vars, VarsZero), 13 | run_over_clauses(Clauses, VarsZero, VarsCounts), 14 | quicksort(VarsCounts, OrderedCounts), 15 | strip_counts(OrderedCounts, Ordered_Vars). 16 | 17 | run_over_clauses([], Vs, Vs). 18 | run_over_clauses([C | Cs], Vs, VsCounts):- 19 | run_over_clause(C, Cs, Vs, VsCounts). 20 | 21 | run_over_clause([], Cs, Vs, VsCounts):- 22 | run_over_clauses(Cs, Vs, VsCounts). 23 | run_over_clause([_-L | Ls], Cs, Vs, VsCounts):- 24 | inc_counts(Vs, L, NewVs), 25 | run_over_clause(Ls, Cs, NewVs, VsCounts). 26 | 27 | inc_counts([], _, []). 28 | inc_counts([Count-V | Vs], L, NewVs):- 29 | V \== L, !, 30 | inc_counts(Vs, L, VsInc), 31 | NewVs = [Count-V | VsInc]. 32 | inc_counts([Count-V | Vs], _, NewVs):- 33 | NewCount is Count+1, 34 | NewVs = [NewCount-V | Vs]. 35 | 36 | initial_counts([], []). 37 | initial_counts([V | Vs], [0-V | VCs]):- 38 | initial_counts(Vs, VCs). 39 | 40 | 41 | strip_counts([], []). 42 | strip_counts([_-X | CTs], [X | Ts]):- 43 | strip_counts(CTs, Ts). 44 | 45 | quicksort([],[]). 46 | quicksort([X|Xs],Ys) :- 47 | partition(Xs,X,LessOrEqual,Greater), 48 | quicksort(LessOrEqual,LEs), 49 | quicksort(Greater,Gs), 50 | append(LEs,[X|Gs],Ys). 51 | 52 | partition([],_Y,[],[]). 53 | partition([Count1-X|Xs],Count2-Y,[Count1-X|LessOrEqual],Greater) :- 54 | Count1 < Count2, 55 | partition(Xs,Count2-Y,LessOrEqual,Greater). 56 | partition([Count1-X|Xs],Count2-Y,LessOrEqual,[Count1-X|Greater]) :- 57 | Count1 >= Count2, 58 | partition(Xs,Count2-Y,LessOrEqual,Greater). 59 | -------------------------------------------------------------------------------- /prologsolvers/sat/sat_solver_restore.pl: -------------------------------------------------------------------------------- 1 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 2 | %A sat solver, utilising delay declaration to implement 3 | %watched literals, plus state saving and restoration 4 | % 5 | %Authors: Jacob Howe and Andy King 6 | %Last modified: 5/4/11 7 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 8 | 9 | :- module(sat_solver, [initialise/1, sat/2, search/4]). 10 | :- use_module(library(lists)). 11 | 12 | initialise(State):- 13 | bb_put(history, State). 14 | 15 | search(Clauses, Vars, Sat, _) :- 16 | sat(Clauses, Vars), 17 | !, 18 | Sat = true. 19 | search(_Clauses, _Vars, false, _). 20 | 21 | sat(Clauses, Vars) :- 22 | problem_setup(Clauses), elim_var(Vars), 23 | reverse(Vars, Rev), bb_put(history, Rev). 24 | 25 | elim_var([]). 26 | elim_var([V|Vs]):- 27 | elim_var(Vs), 28 | assign(V). 29 | 30 | assign(V):- 31 | bb_get(history, Hs), 32 | assign_true(Hs, V). 33 | assign(V):- 34 | bb_get(history, Hs), 35 | assign_false(Hs, V). 36 | 37 | assign_true([], true). 38 | assign_true([true|Hs], Var):- 39 | (Var = true -> 40 | bb_put(history, Hs) 41 | ; 42 | bb_put(history, []),fail 43 | ). 44 | 45 | assign_false([], false). 46 | assign_false([false|Hs], Var):- 47 | (Var = false -> 48 | bb_put(history, Hs) 49 | ; 50 | bb_put(history, []), fail 51 | ). 52 | 53 | problem_setup([]). 54 | problem_setup([Clause | Clauses]) :- 55 | clause_setup(Clause), 56 | problem_setup(Clauses). 57 | 58 | clause_setup([Pol-Var | Pairs]) :- set_watch(Pairs, Var, Pol). 59 | 60 | set_watch([], Var, Pol) :- Var = Pol. 61 | set_watch([Pol2-Var2 | Pairs], Var1, Pol1):- 62 | watch(Var1, Pol1, Var2, Pol2, Pairs). 63 | 64 | :- block watch(-, ?, -, ?, ?). 65 | watch(Var1, Pol1, Var2, Pol2, Pairs) :- 66 | nonvar(Var1) -> 67 | update_watch(Var1, Pol1, Var2, Pol2, Pairs); 68 | update_watch(Var2, Pol2, Var1, Pol1, Pairs). 69 | 70 | update_watch(Var1, Pol1, Var2, Pol2, Pairs) :- 71 | Var1 == Pol1 -> true; set_watch(Pairs, Var2, Pol2). 72 | 73 | 74 | -------------------------------------------------------------------------------- /prologsolvers/sat/smt.pl: -------------------------------------------------------------------------------- 1 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 2 | %An SMT solver. Requires a SAT solver and a theory. 3 | %Coded for SICStus 4 | % 5 | %Authors: Jacob Howe and Andy King 6 | %Last modified: 7/4/11 7 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 8 | 9 | :- use_module(theory). 10 | :- use_module(sat_solver_restore). 11 | :- use_module(library(assoc)). 12 | 13 | main :- 14 | Clauses = [[true-X], [true-Y, true-Z], [true-U, true-V], [false-W]], 15 | Vars = [X, Y, Z, U, V, W], 16 | empty_assoc(ConsMap0), 17 | put_assoc(X, ConsMap0, A < B, ConsMap1), 18 | put_assoc(Y, ConsMap1, A = 0, ConsMap2), 19 | put_assoc(Z, ConsMap2, A = 1, ConsMap3), 20 | put_assoc(U, ConsMap3, B = 0, ConsMap4), 21 | put_assoc(V, ConsMap4, B = 1, ConsMap5), 22 | put_assoc(W, ConsMap5, 1 =< A + B, ConsMap), 23 | smt(Clauses, Vars, ConsMap). 24 | 25 | smt(Clauses, Vars, ConsMap):- 26 | initialise([]), 27 | smt_call(Clauses, Vars, ConsMap). 28 | 29 | smt_call(Clauses, Vars, ConsMap) :- 30 | copy_term(Clauses-Vars, CopyClauses-CopyVars), 31 | sat(CopyClauses, CopyVars), !, 32 | zip(CopyVars, Vars, ZipVars), 33 | smt_proceed(ZipVars, Clauses, Vars, ConsMap). 34 | 35 | smt_proceed(ZipVars, _Clauses, _Vars, ConsMap) :- 36 | satisfiable(ZipVars, [], ConsMap), !. 37 | smt_proceed(ZipVars, Clauses, Vars, ConsMap) :- 38 | unsat_core(ZipVars, ConsMap, Min), 39 | new_clause(Min, Vars, NewClause), 40 | smt_call([NewClause | Clauses], Vars, ConsMap). 41 | 42 | satisfiable([], Cons, _):- post_all(Cons). 43 | satisfiable([Val-Var|Vals], Acc, ConsMap):- 44 | get_assoc(Var, ConsMap, Con), 45 | satisfiable(Vals, [Val-Con | Acc], ConsMap). 46 | 47 | zip([], [], []). 48 | zip([X|Xs], [Y|Ys], [X-Y|Zs]):- zip(Xs, Ys, Zs). 49 | 50 | new_clause([], _, []). 51 | new_clause([Val | Vals], Vars, Rest) :- 52 | new_clause(Val, Vals, Vars, Rest). 53 | 54 | new_clause(true, Vals, [Var | Vars], [false-Var | Rest]) :- 55 | new_clause(Vals, Vars, Rest). 56 | new_clause(false, Vals, [Var | Vars], [true-Var | Rest]) :- 57 | new_clause(Vals, Vars, Rest). 58 | new_clause(na, Vals, [_ | Vars], Rest) :- 59 | new_clause(Vals, Vars, Rest). 60 | -------------------------------------------------------------------------------- /prologsolvers/sat/sat_solver_learning.pl: -------------------------------------------------------------------------------- 1 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 2 | %A sat solver that learns clauses 3 | % 4 | %Authors: Jacob Howe and Andy King 5 | %Last modified: 6/4/10 6 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 7 | 8 | :- module(sat_solver, [initialise/1, sat/2, search/4]). 9 | 10 | initialise(_). 11 | 12 | search(Clauses, Vars, Sat, _) :- 13 | sat(Clauses, Vars), 14 | !, 15 | Sat = true. 16 | search(_Clauses, _Vars, false, _). 17 | 18 | sat(Clauses, Vars) :- 19 | bb_put(learn, []), 20 | length(Vars, N), 21 | special_reverse(Vars, N, [], RevVars), 22 | problem_setup(Clauses), !, 23 | solve(RevVars). 24 | 25 | special_reverse([], _, Vs, Vs). 26 | special_reverse([V|Vs], N, R, Rev):- 27 | NewN is N-1, 28 | special_reverse(Vs, NewN, [N-V | R], Rev). 29 | 30 | solve(Vars):- 31 | elim_var(Vars), !. 32 | solve(Vars):- 33 | learning(Vars),!, 34 | solve(Vars). 35 | 36 | learning(Vars):- 37 | bb_get(learn, L), 38 | buildclause(L, Vars, Clause), !, 39 | problem_setup([Clause]). 40 | 41 | buildclause([], _, []). 42 | buildclause([N|History], [N-Var|Vars], [false-Var|Clause]):-!, 43 | buildclause(History, Vars, Clause). 44 | buildclause(History, [_|Vars], Clause):- 45 | buildclause(History, Vars, Clause). 46 | 47 | negate(true, false). 48 | negate(false, true). 49 | 50 | elim_var([]). 51 | elim_var([N-Var|Vars]):- 52 | var(Var),!, 53 | Var = true-[N], 54 | elim_var(Vars). 55 | elim_var([_|Vars]):- 56 | elim_var(Vars). 57 | 58 | problem_setup([]). 59 | problem_setup([Clause | Clauses]) :- 60 | clause_setup(Clause), 61 | problem_setup(Clauses). 62 | 63 | clause_setup([Pol-Var | Pairs]) :- set_watch(Pairs, Var, Pol, []). 64 | 65 | set_watch([], Var, Pol, Assigns):- 66 | var(Var), !, 67 | Var = Pol-Assigns. 68 | set_watch([], Var, Pol, Assigns):-!, 69 | Var = Val-Inf, 70 | (Val == Pol -> true; (merge(Inf, Assigns, NewAss), bb_put(learn, NewAss), fail)). 71 | set_watch([Pol2-Var2 | Pairs], Var1, Pol1, Assigns):- 72 | watch(Var1, Pol1, Var2, Pol2, Pairs, Assigns). 73 | 74 | :- block watch(-, ?, -, ?, ?, ?). 75 | watch(Var1, Pol1, Var2, Pol2, Pairs, Assigns) :- 76 | nonvar(Var1) -> 77 | update_watch(Var1, Pol1, Var2, Pol2, Pairs, Assigns); 78 | update_watch(Var2, Pol2, Var1, Pol1, Pairs, Assigns). 79 | 80 | update_watch(Var1-Inf, Pol1, Var2, Pol2, Pairs, Assigns) :- 81 | Var1 == Pol1 -> true; 82 | ( 83 | merge(Inf, Assigns, NewAss), 84 | set_watch(Pairs, Var2, Pol2, NewAss)). 85 | 86 | merge([], Ys, Ys):-!. 87 | merge(Xs, [], Xs):-!. 88 | merge([X|Xs], [Y|Ys], Zs):- 89 | X < Y, !, 90 | Zs = [X|Rest], 91 | merge(Xs, [Y|Ys], Rest). 92 | merge([X|Xs], [Y|Ys], Zs):- 93 | X > Y, !, 94 | Zs = [Y|Rest], 95 | merge([X|Xs], Ys, Rest). 96 | merge([X|Xs], [Y|Ys], Zs):- 97 | X == Y, 98 | Zs = [X|Rest], 99 | merge(Xs, Ys, Rest). 100 | -------------------------------------------------------------------------------- /prologsolvers/sat/sat_solver_back.pl: -------------------------------------------------------------------------------- 1 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 2 | %A sat solver, utilising delay declaration to implement 3 | %watched literals, with some backjumping 4 | % 5 | %Authors: Jacob Howe and Andy King 6 | %Last modified: 5/4/11 7 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 8 | 9 | :- module(sat_solver, [initialise/1, sat/2, search/4]). 10 | 11 | initialise(_). 12 | 13 | search(Clauses, Vars, true, N):- 14 | bb_put(count, 0), 15 | sat(Clauses, Vars), !, 16 | bb_get(count, N). 17 | %search(_,_,false, _N). 18 | search(_,_,false, N) :- 19 | bb_get(count, N). 20 | 21 | sat(Clauses, Vars) :- 22 | problem_setup(Clauses), elim_var(Vars, 1). 23 | 24 | elim_var([], N):-clear(N). 25 | elim_var([Var | Vars], N) :- 26 | NewN is N+1, 27 | elim_var(Vars, NewN), assign(Var, NewN). 28 | 29 | clear(0):-!. 30 | clear(N):- 31 | (bb_delete(N,_);true),!, 32 | Dec is N-1, 33 | clear(Dec). 34 | 35 | assign(Var, N):- 36 | nonvar(Var), !, 37 | bb_put(N, []). 38 | assign(Var, N):- 39 | Var = true-[N], 40 | bb_get(count, C), NewC is C+1, bb_put(count, NewC). 41 | assign(Var, N):- 42 | bb_get(N, Infl), 43 | continue(Infl,N), 44 | Var = false-[N], 45 | bb_get(count, C), NewC is C+1, bb_put(count, NewC). 46 | 47 | continue([N | _], N):-!. 48 | continue(Ns, M):- 49 | NewM is M+1, 50 | update_aux(NewM, Ns), 51 | bb_delete(M, _), 52 | fail. 53 | 54 | problem_setup([]). 55 | problem_setup([Clause | Clauses]) :- 56 | clause_setup(Clause), 57 | problem_setup(Clauses). 58 | 59 | clause_setup([Pol-Var | Pairs]) :- set_watch(Pairs, Var, Pol, []). 60 | 61 | set_watch([], Var, Pol, _Infl) :- 62 | nonvar(Var), 63 | Var = V-_, V = Pol, !. 64 | set_watch([], Var, _Pol, Infl) :- 65 | nonvar(Var), 66 | Var = _V-InflV, 67 | merge(InflV, Infl, NewInfl), 68 | update(NewInfl), 69 | fail. 70 | set_watch([], Var, Pol, Infl) :- 71 | Var = Pol-Infl. 72 | set_watch([Pol2-Var2 | Pairs], Var1, Pol1, Infl):- 73 | watch(Var1, Pol1, Var2, Pol2, Pairs, Infl). 74 | 75 | update([N | Is]):- 76 | update_aux(N, [N | Is]). 77 | 78 | update_aux(N, Is1):- 79 | bb_get(N, Is2), !, 80 | merge(Is1, Is2, Is), 81 | decapitate_if_needed(Is, N, Dec), 82 | NewN is N+1, 83 | bb_delete(N, _), 84 | update_aux(NewN, Dec). 85 | update_aux(N, Is):- 86 | bb_put(N, Is). 87 | 88 | decapitate_if_needed([N | Dec], N, Dec):-!. 89 | decapitate_if_needed(Dec, _, Dec). 90 | 91 | :- block watch(-, ?, -, ?, ?, ?). 92 | watch(Var1, Pol1, Var2, Pol2, Pairs, Infl) :- 93 | nonvar(Var1) -> 94 | update_watch(Var1, Pol1, Var2, Pol2, Pairs, Infl); 95 | update_watch(Var2, Pol2, Var1, Pol1, Pairs, Infl). 96 | 97 | update_watch(Var1, Pol1, Var2, Pol2, Pairs, Infl) :- 98 | Var1 = Var-InflV, 99 | (Var == Pol1 -> true; 100 | (merge(InflV, Infl, NewInfl), set_watch(Pairs, Var2, Pol2, NewInfl))). 101 | 102 | merge([], Ys, Ys):-!. 103 | merge(Xs, [], Xs):-!. 104 | merge([X|Xs], [Y|Ys], Zs):- 105 | X < Y, !, 106 | Zs = [X|Rest], 107 | merge(Xs, [Y | Ys], Rest). 108 | merge([X|Xs], [Y|Ys], Zs):- 109 | X > Y, !, 110 | Zs = [Y|Rest], 111 | merge([X | Xs], Ys, Rest). 112 | merge([X|Xs], [Y|Ys], Zs):- 113 | X == Y, 114 | Zs = [X|Rest], 115 | merge(Xs, Ys, Rest). 116 | -------------------------------------------------------------------------------- /prologsolvers/leancop.py: -------------------------------------------------------------------------------- 1 | # leancop 2.1 2 | code = """ 3 | %% File: leancop21_swi.pl - Version: 2.1 - Date: 30 Aug 2008 4 | %% 5 | %% "Make everything as simple as possible, but not simpler." 6 | %% [Albert Einstein] 7 | %% 8 | %% Purpose: leanCoP: A Lean Connection Prover for Classical Logic 9 | %% 10 | %% Author: Jens Otten 11 | %% Web: www.leancop.de 12 | %% 13 | %% Usage: prove(M,P). % where M is a set of clauses and P is 14 | %% % the returned connection proof 15 | %% % e.g. M=[[q(a)],[-p],[p,-q(X)]] 16 | %% % and P=[[q(a)],[[-(q(a)),p],[[-(p)]]]] 17 | %% prove(F,P). % where F is a first-order formula and 18 | %% % P is the returned connection proof 19 | %% % e.g. F=((p,all X:(p=>q(X)))=>all Y:q(Y)) 20 | %% % and P=[[q(a)],[[-(q(a)),p],[[-(p)]]]] 21 | %% prove2(F,S,P). % where F is a formula, S is a subset of 22 | %% % [nodef,def,conj,reo(I),scut,cut,comp(J)] 23 | %% % (with numbers I,J) defining attributes 24 | %% % and P is the returned connection proof 25 | %% 26 | %% Copyright: (c) 1999-2008 by Jens Otten 27 | %% License: GNU General Public License 28 | 29 | 30 | :- [def_mm]. % load program for clausal form translation 31 | :- dynamic(pathlim/0), dynamic(lit/4). 32 | 33 | 34 | %%% prove matrix M / formula F 35 | 36 | prove(F,Proof) :- prove2(F,[cut,comp(7)],Proof). 37 | 38 | prove2(F,Set,Proof) :- 39 | (F=[_|_] -> M=F ; make_matrix(F,M,Set)), 40 | retractall(lit(_,_,_,_)), (member([-(#)],M) -> S=conj ; S=pos), 41 | assert_clauses(M,S), prove(1,Set,Proof). 42 | 43 | prove(PathLim,Set,Proof) :- 44 | \+member(scut,Set) -> prove([-(#)],[],PathLim,[],Set,[Proof]) ; 45 | lit(#,_,C,_) -> prove(C,[-(#)],PathLim,[],Set,Proof1), 46 | Proof=[C|Proof1]. 47 | prove(PathLim,Set,Proof) :- 48 | member(comp(Limit),Set), PathLim=Limit -> prove(1,[],Proof) ; 49 | (member(comp(_),Set);retract(pathlim)) -> 50 | PathLim1 is PathLim+1, prove(PathLim1,Set,Proof). 51 | 52 | %%% leanCoP core prover 53 | 54 | prove([],_,_,_,_,[]). 55 | 56 | prove([Lit|Cla],Path,PathLim,Lem,Set,Proof) :- 57 | Proof=[[[NegLit|Cla1]|Proof1]|Proof2], 58 | \+ (member(LitC,[Lit|Cla]), member(LitP,Path), LitC==LitP), 59 | (-NegLit=Lit;-Lit=NegLit) -> 60 | ( member(LitL,Lem), Lit==LitL, Cla1=[], Proof1=[] 61 | ; 62 | member(NegL,Path), unify_with_occurs_check(NegL,NegLit), 63 | Cla1=[], Proof1=[] 64 | ; 65 | lit(NegLit,NegL,Cla1,Grnd1), 66 | unify_with_occurs_check(NegL,NegLit), 67 | ( Grnd1=g -> true ; length(Path,K), K true ; 68 | \+ pathlim -> assert(pathlim), fail ), 69 | prove(Cla1,[Lit|Path],PathLim,Lem,Set,Proof1) 70 | ), 71 | ( member(cut,Set) -> ! ; true ), 72 | prove(Cla,Path,PathLim,[Lit|Lem],Set,Proof2). 73 | 74 | %%% write clauses into Prolog's database 75 | 76 | assert_clauses([],_). 77 | assert_clauses([C|M],Set) :- 78 | (Set\=conj, \+member(-_,C) -> C1=[#|C] ; C1=C), 79 | (ground(C) -> G=g ; G=n), assert_clauses2(C1,[],G), 80 | assert_clauses(M,Set). 81 | 82 | assert_clauses2([],_,_). 83 | assert_clauses2([L|C],C1,G) :- 84 | assert_renvar([L],[L2]), append(C1,C,C2), append(C1,[L],C3), 85 | assert(lit(L2,L,C2,G)), assert_clauses2(C,C3,G). 86 | 87 | assert_renvar([],[]). 88 | assert_renvar([F|FunL],[F1|FunL1]) :- 89 | ( var(F) -> true ; F=..[Fu|Arg], assert_renvar(Arg,Arg1), 90 | F1=..[Fu|Arg1] ), assert_renvar(FunL,FunL1). 91 | """ 92 | -------------------------------------------------------------------------------- /prologsolvers/sat/sudoku.pl: -------------------------------------------------------------------------------- 1 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 2 | %%% DECEMBER 15th 2010 3 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 4 | %%% SAT encoding of a Sudoku puzzle 5 | %%% By A.D., the anonymous referee 6 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 7 | 8 | %%% Problem of November 9th 2007 by "La Repubblica" 9 | %%% (Advanced Level) 10 | 11 | puzzle([cell(1,6,9), 12 | cell(2,1,4),cell(2,9,8), 13 | cell(3,1,7),cell(3,2,3),cell(3,4,2),cell(3,5,6), 14 | cell(4,1,8),cell(4,3,1),cell(4,6,3),cell(4,9,6), 15 | cell(5,1,6),cell(5,4,9),cell(5,5,7),cell(5,6,5),cell(5,9,3), 16 | cell(6,1,3),cell(6,4,1),cell(6,7,2),cell(6,9,4), 17 | cell(7,5,1),cell(7,6,8),cell(7,8,6),cell(7,9,7), 18 | cell(8,1,9),cell(8,9,5), 19 | cell(9,4,3) ],9). 20 | 21 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 22 | 23 | sudoku :- 24 | open('sudoku.cnf',write,Stream), 25 | set_output(Stream), 26 | puzzle(InputList,Size), 27 | write('ccccccccccccccccccccccccccccccccccccccccccccccccccccccccc'),nl, 28 | write('c SAT encoding of an instance of SUDOKU thanks to A.D. c'),nl, 29 | write('ccccccccccccccccccccccccccccccccccccccccccccccccccccccccc'),nl, 30 | fix_vars(InputList,Size), 31 | boolconstraints(Size), 32 | rowconstraints(Size), 33 | columnconstraints(Size), 34 | squareconstraints(Size), 35 | close(Stream). 36 | 37 | boolconstraints(Size) :- 38 | double_for(1,1,Size,k). 39 | rowconstraints(Size) :- 40 | double_for(1,1,Size,i). 41 | columnconstraints(Size) :- 42 | double_for(1,1,Size,j). 43 | squareconstraints(Size) :- 44 | value_for(0,Size). 45 | 46 | double_for(A,_,Size,_) :- 47 | A > Size, !. 48 | double_for(A,B,Size,Par) :- 49 | B > Size, !, 50 | A1 is A + 1, 51 | double_for(A1,1,Size,Par). 52 | double_for(A,B,Size,Par) :- 53 | digit(A,B,1,Size,List,Par), 54 | exactly_one(List), 55 | B1 is B + 1, 56 | double_for(A,B1,Size,Par). 57 | 58 | digit(_A,_B,C,Size,[],_):- 59 | C > Size. 60 | digit(A,B,C,Size,[Val|R],Par):- 61 | (Par=i, converti(C,A,B,Size,Val); 62 | Par=j, converti(A,C,B,Size,Val); 63 | Par=k, converti(A,B,C,Size,Val)), 64 | C1 is C + 1, 65 | digit(A,B,C1,Size,R,Par). 66 | 67 | value_for(Size, Size) :- !. 68 | value_for(Square, Size) :- 69 | square_clauses(Square, Size), 70 | Square1 is Square + 1, 71 | value_for(Square1, Size). 72 | 73 | square_clauses(Square, Size) :- 74 | Root is integer(sqrt(Size)), 75 | STARTX is (Square mod Root) * Root + 1, 76 | STARTY is (Square // Root) * Root + 1, 77 | insquare(1,Size,Root,STARTX,STARTY). 78 | 79 | insquare(K,Size,_,_,_) :- K>Size,!. 80 | insquare(K,Size,Root,StartX,StartY) :- 81 | digit_square(0,0,K,Root,Size,StartX,StartY,Clause), 82 | exactly_one(Clause), 83 | K1 is K+1, 84 | insquare(K1,Size,Root,StartX,StartY). 85 | 86 | digit_square(Root,_,_,Root,_,_,_,[]):-!. 87 | digit_square(I,Root,K,Root,Size,StartX,StartY,Clause):- 88 | !, 89 | I1 is I + 1, 90 | digit_square(I1,0,K,Root,Size,StartX,StartY,Clause). 91 | digit_square(I,J,K,Root,Size,StartX,StartY,[C|Clause]):- 92 | I1 is I+StartX, 93 | J1 is J+StartY, 94 | converti(I1,J1,K,Size,C), 95 | Jn is J+1, 96 | digit_square(I,Jn,K,Root,Size,StartX,StartY,Clause). 97 | 98 | fix_vars([],_). 99 | fix_vars([cell(I,J,K)|R],Size) :- 100 | converti(I,J,K,Size,Val), 101 | clause([Val]), 102 | fix_vars(R,Size). 103 | 104 | converti(I,J,K,Size,Val) :- 105 | Val is Size*Size*(I-1)+Size*(J-1)+K. 106 | 107 | exactly_one(L) :- 108 | clause(L), 109 | no_pair(L). 110 | 111 | clause(L) :- 112 | clausola(L). 113 | 114 | clausola([]) :- 115 | write('0 '),nl. 116 | clausola([A]) :- !, 117 | write(A), write(' 0'),nl. 118 | clausola([A|R]) :- 119 | write(A), write(' '), 120 | clausola(R). 121 | 122 | no_pair([]). 123 | no_pair([_]). 124 | no_pair([A|R]) :- 125 | A1 is -A, no_pairs(A1,R), no_pair(R). 126 | no_pairs(_,[]). 127 | no_pairs(A,[B|R]):- 128 | B1 is -B, clause([A,B1]), no_pairs(A,R). 129 | 130 | write_vars(Size) :- 131 | N is Size*Size*Size - 1, 132 | write_vars(1,N). 133 | write_vars(N,N) :- 134 | M is N + 1, 135 | write('X'),write(N),write(',X'),write(M). 136 | write_vars(X,N) :- 137 | X < N, 138 | write('X'),write(X),write(','), 139 | X1 is X + 1, 140 | write_vars(X1,N). 141 | 142 | %%%%%%%%%%% END 143 | -------------------------------------------------------------------------------- /prologsolvers/sat/parser.pl: -------------------------------------------------------------------------------- 1 | :- module(parser, [parser/3]). 2 | :- use_module(library(assoc)). 3 | :- use_module(library(lists)). 4 | 5 | 6 | 7 | benchmark('../flopsbenchmarks/chat_80_1.cnf', chat_80_1). 8 | benchmark('../flopsbenchmarks/chat_80_2.cnf', chat_80_2). 9 | benchmark('../flopsbenchmarks/chat_80_3.cnf', chat_80_3). 10 | benchmark('../flopsbenchmarks/chat_80_4.cnf', chat_80_4). 11 | benchmark('../flopsbenchmarks/chat_80_5.cnf', chat_80_5). 12 | benchmark('../flopsbenchmarks/chat_80_6.cnf', chat_80_6). 13 | benchmark('../flopsbenchmarks/uf20-0903.cnf', 'uf20-0903'). 14 | benchmark('../flopsbenchmarks/uf50-0429.cnf', 'uf50-0429'). 15 | benchmark('../flopsbenchmarks/uf100-0658.cnf', 'uf100-0658'). 16 | benchmark('../flopsbenchmarks/uf150-046.cnf', 'uf150-046'). 17 | benchmark('../flopsbenchmarks/uf250-091.cnf', 'uf250-091'). 18 | benchmark('../flopsbenchmarks/uuf50-0168.cnf', 'uuf50-0168'). 19 | benchmark('../flopsbenchmarks/uuf100-0592.cnf', 'uuf100-0592'). 20 | benchmark('../flopsbenchmarks/uuf150-089.cnf', 'uuf150-089'). 21 | benchmark('../flopsbenchmarks/uuf250-016.cnf', 'uuf250-016'). 22 | benchmark('../flopsbenchmarks/2bitcomp_5.cnf', '2bitcomp_5'). 23 | benchmark('../flopsbenchmarks/flat200-90.cnf', 'flat200-90'). 24 | 25 | %benchmark('../benchmarks/sudoku.cnf', sudoku). 26 | %benchmark('../benchmarks/small.cnf', small). 27 | %benchmark('../benchmarks/uf20-0694.cnf', 'uf20-0694'). 28 | %benchmark('../benchmarks/uf50-0987.cnf', 'uf50-0987'). 29 | %benchmark('../benchmarks/aim-50-1_6-no-1.cnf', 'aim-50-1_6-no-1'). 30 | %benchmark('../benchmarks/uuf50-0102.cnf', 'uuf50-0102'). 31 | %benchmark('../benchmarks/uuf50-0479.cnf', 'uuf50-0479'). 32 | %benchmark('../benchmarks/aim-100-1_6-no-1.cnf', 'aim-100-1_6-no-1'). 33 | %benchmark('../benchmarks/aim-100-1_6-yes1-4.cnf', 'aim-100-1_6-yes1-4'). 34 | %benchmark('../benchmarks/aim-200-3_4-yes1-4.cnf', 'aim-200-3_4-yes1-4'). 35 | %benchmark('../benchmarks/aim-200-6_0-yes1-1.cnf', 'aim-200-6_0-yes1-1'). 36 | %benchmark('../benchmarks/uf100-0386.cnf', 'uf100-0386'). 37 | %benchmark('../benchmarks/uuf100-0694.cnf', 'uuf100-0694'). 38 | 39 | parser(Name, NG_Clauses, NG_Vars) :- 40 | benchmark(File, Name), 41 | open(File, read, Stream), 42 | read_literals(Stream, Literals), 43 | close(Stream), 44 | read_clauses(Literals, [], Clauses), 45 | empty_assoc(Assoc1), 46 | nonground_clauses(Clauses, Assoc1, Assoc2, NG_Clauses), 47 | assoc_to_list(Assoc2, NG_List), 48 | pairs_to_vars(NG_List, 1, NG_Vars). 49 | 50 | nonground_clauses([], Assoc, Assoc, []). 51 | nonground_clauses([Clause | Clauses], Assoc1, Assoc3, [NG_Clause | NG_Clauses]) :- 52 | nonground_clause(Clause, Assoc1, Assoc2, NG_Clause), 53 | nonground_clauses(Clauses, Assoc2, Assoc3, NG_Clauses). 54 | 55 | nonground_clause([], Assoc, Assoc, []). 56 | nonground_clause([Literal | Clause], Assoc1, Assoc3, [true-Var | NG_Clause]) :- 57 | Literal > 0, 58 | get_assoc(Literal, Assoc1, Var), 59 | !, 60 | nonground_clause(Clause, Assoc1, Assoc3, NG_Clause). 61 | nonground_clause([Literal | Clause], Assoc1, Assoc3, [true-Var | NG_Clause]) :- 62 | Literal > 0, 63 | !, 64 | put_assoc(Literal, Assoc1, Var, Assoc2), 65 | nonground_clause(Clause, Assoc2, Assoc3, NG_Clause). 66 | nonground_clause([Literal | Clause], Assoc1, Assoc3, [false-Var | NG_Clause]) :- 67 | Literal < 0, 68 | NegLiteral is -Literal, 69 | get_assoc(NegLiteral, Assoc1, Var), 70 | !, 71 | nonground_clause(Clause, Assoc1, Assoc3, NG_Clause). 72 | nonground_clause([Literal | Clause], Assoc1, Assoc3, [false-Var | NG_Clause]) :- 73 | Literal < 0, 74 | NegLiteral is -Literal, 75 | put_assoc(NegLiteral, Assoc1, Var, Assoc2), 76 | nonground_clause(Clause, Assoc2, Assoc3, NG_Clause). 77 | 78 | read_literals(Stream, Literals) :- 79 | get_char(Stream, C), 80 | read_literals(C, Stream, Literals). 81 | 82 | read_literals(end_of_file, _Stream, Literals) :- 83 | !, 84 | Literals = []. 85 | read_literals(' ', Stream, Literals) :- 86 | !, 87 | read_literals(Stream, Literals). 88 | read_literals('\n', Stream, Literals) :- 89 | !, 90 | read_literals(Stream, Literals). 91 | read_literals('\t', Stream, Literals) :- 92 | !, 93 | read_literals(Stream, Literals). 94 | read_literals('c', Stream, Literals) :- 95 | !, 96 | read_line_then_literals(Stream, Literals). 97 | read_literals('p', Stream, Literals) :- 98 | !, 99 | read_line_then_literals(Stream, Literals). 100 | read_literals(C, Stream, Literals):- 101 | name(C, [A]), 102 | read_literal_then_literals(Stream, [A], Literals). 103 | 104 | read_literal_then_literals(Stream, As, Literals) :- 105 | get_char(Stream, C), 106 | read_literal_then_literals(C, Stream, As, Literals). 107 | 108 | read_literal_then_literals(C, Stream, As, Literals) :- 109 | digit(C), !, 110 | name(C, [A]), 111 | read_literal_then_literals(Stream, [A | As], Literals). 112 | read_literal_then_literals(C, Stream, As, Literals) :- 113 | reverse(As, RevAs), 114 | name(Literal, RevAs), 115 | Literals = [Literal | Rest_Literals], 116 | read_literals(C, Stream, Rest_Literals). 117 | 118 | digit('0'). 119 | digit('1'). 120 | digit('2'). 121 | digit('3'). 122 | digit('4'). 123 | digit('5'). 124 | digit('6'). 125 | digit('7'). 126 | digit('8'). 127 | digit('9'). 128 | 129 | read_line_then_literals(Stream, Literals) :- 130 | get_char(Stream, C), 131 | read_line_then_literals(C, Stream, Literals). 132 | 133 | read_line_then_literals('\n', Stream, Literals) :- 134 | !, 135 | read_literals(Stream, Literals). 136 | read_line_then_literals(_C, Stream, Literals) :- 137 | read_line_then_literals(Stream, Literals). 138 | 139 | read_clauses([], [], []). 140 | read_clauses([0 | Literals], Clause, Clauses) :- 141 | !, 142 | reverse(Clause, RevClause), 143 | % format("~w\n", [RevClause]), 144 | Clauses = [RevClause | RestClauses], 145 | read_clauses(Literals, [], RestClauses). 146 | read_clauses([Literal | Literals], Clause, Clauses) :- 147 | read_clauses(Literals, [Literal | Clause], Clauses). 148 | 149 | pairs_to_vars([], _Key, []). 150 | pairs_to_vars([Key-Var | Pairs], Key, [Var | Vars]) :- 151 | !, 152 | Key1 is Key + 1, 153 | pairs_to_vars(Pairs, Key1, Vars). 154 | pairs_to_vars([KeyPrime-Var | Pairs], Key, Vars) :- 155 | Key1 is Key + 1, 156 | pairs_to_vars([KeyPrime-Var | Pairs], Key1, Vars). 157 | 158 | -------------------------------------------------------------------------------- /play.ipynb: -------------------------------------------------------------------------------- 1 | { 2 | "cells": [ 3 | { 4 | "cell_type": "code", 5 | "execution_count": 1, 6 | "metadata": {}, 7 | "outputs": [], 8 | "source": [ 9 | "from prologsolvers import trs\n", 10 | "import janus_swi as janus\n", 11 | "\n", 12 | "\n", 13 | "\n", 14 | "\n", 15 | "janus.consult(\"trs\", data=trs.code)" 16 | ] 17 | }, 18 | { 19 | "cell_type": "code", 20 | "execution_count": 36, 21 | "metadata": {}, 22 | "outputs": [ 23 | { 24 | "name": "stdout", 25 | "output_type": "stream", 26 | "text": [ 27 | "hello\n" 28 | ] 29 | }, 30 | { 31 | "name": "stderr", 32 | "output_type": "stream", 33 | "text": [ 34 | "ERROR: Stream (0x561e862be880):3:0 Syntax error: Unexpected end of file\n" 35 | ] 36 | }, 37 | { 38 | "data": { 39 | "text/plain": [ 40 | "{'truth': True, 'Res': 3}" 41 | ] 42 | }, 43 | "execution_count": 36, 44 | "metadata": {}, 45 | "output_type": "execute_result" 46 | } 47 | ], 48 | "source": [ 49 | "janus.query_once(\"equations_trs([a = b, b = c, e = f], _Rs), R = #(_Rs)\")\n", 50 | "\n", 51 | "\n", 52 | "\"\"\"\n", 53 | "pythonize([A|B], [A|C]) :- !, maplist().\n", 54 | "pythonize(T,Out) :- T =.. [F|Args], maplist(pythonize,Args,ArgsOut), Out = F-ArgsOut.\n", 55 | "\n", 56 | "\"\"\"\n", 57 | "\n", 58 | "\n", 59 | "janus.consult(\"\", \"\"\"\n", 60 | "z3(true, T) :- py_call(z3:'BoolVal'(true), T).\n", 61 | "z3(and(A,B), T) :- z3(A,ZA), z3(B,ZB), py_call(z3:'And'(ZA, ZB), T). \n", 62 | "\"\"\")\n", 63 | "\n", 64 | "\n", 65 | "#janus.query_once(\"\"\"\n", 66 | "# py_call(z3:Int(\"x\"), Res)\"\"\")\n", 67 | "\n", 68 | "janus.query_once('py_call(print(\"hello\"))')\n", 69 | "janus.query_once(\"\"\"py_call(z3:'IntVal'(3), Res)\"\"\")" 70 | ] 71 | }, 72 | { 73 | "cell_type": "code", 74 | "execution_count": 31, 75 | "metadata": {}, 76 | "outputs": [ 77 | { 78 | "ename": "TypeError", 79 | "evalue": "'Term' object is not subscriptable", 80 | "output_type": "error", 81 | "traceback": [ 82 | "\u001b[0;31m---------------------------------------------------------------------------\u001b[0m", 83 | "\u001b[0;31mTypeError\u001b[0m Traceback (most recent call last)", 84 | "Cell \u001b[0;32mIn[31], line 6\u001b[0m\n\u001b[1;32m 4\u001b[0m \u001b[38;5;28;01mreturn\u001b[39;00m janus\u001b[38;5;241m.\u001b[39mquery_once(\u001b[38;5;124mf\u001b[39m\u001b[38;5;124m\"\u001b[39m\u001b[38;5;124mtrs:equations_trs(\u001b[39m\u001b[38;5;132;01m{\u001b[39;00meqs\u001b[38;5;132;01m}\u001b[39;00m\u001b[38;5;124m, _Rs), R =.. [prolog, _Rs]\u001b[39m\u001b[38;5;124m\"\u001b[39m)[\u001b[38;5;124m\"\u001b[39m\u001b[38;5;124mR\u001b[39m\u001b[38;5;124m\"\u001b[39m]\n\u001b[1;32m 5\u001b[0m rules \u001b[38;5;241m=\u001b[39m complete(\u001b[38;5;124m\"\u001b[39m\u001b[38;5;124m[a = b, b = c, e = f]\u001b[39m\u001b[38;5;124m\"\u001b[39m)\n\u001b[0;32m----> 6\u001b[0m \u001b[43mrules\u001b[49m\u001b[43m[\u001b[49m\u001b[38;5;241;43m0\u001b[39;49m\u001b[43m]\u001b[49m\n", 85 | "\u001b[0;31mTypeError\u001b[0m: 'Term' object is not subscriptable" 86 | ] 87 | } 88 | ], 89 | "source": [ 90 | "def complete(eqs):\n", 91 | " janus.consult(\"trs\", data=trs.code)\n", 92 | " #return janus.query_once(\"equations_trs(Eqs, _Rs), R = #(_Rs)\", {\"Eqs\": eqs})\n", 93 | " return janus.query_once(f\"trs:equations_trs({eqs}, _Rs), R =.. [prolog, _Rs]\")[\"R\"]\n", 94 | "rules = complete(\"[a = b, b = c, e = f]\")\n", 95 | "rules[0]" 96 | ] 97 | }, 98 | { 99 | "cell_type": "code", 100 | "execution_count": 10, 101 | "metadata": {}, 102 | "outputs": [ 103 | { 104 | "data": { 105 | "text/plain": [ 106 | "z3.z3.BoolRef" 107 | ] 108 | }, 109 | "execution_count": 10, 110 | "metadata": {}, 111 | "output_type": "execute_result" 112 | } 113 | ], 114 | "source": [ 115 | "import janus_swi as janus\n", 116 | "\n", 117 | "janus.consult(\"z3\", \"\"\"\n", 118 | "\n", 119 | "% leanCoP syntax\n", 120 | ":- op(1130, xfy, <=>). % equivalence\n", 121 | ":- op(1110, xfy, =>). % implication\n", 122 | "% % disjunction (;)\n", 123 | "% % conjunction (,)\n", 124 | ":- op( 500, fy, ~). % negation\n", 125 | ":- op( 500, fy, all). % universal quantifier\n", 126 | ":- op( 500, fy, ex). % existential quantifier\n", 127 | ":- op( 500,xfy, :).\n", 128 | "\n", 129 | "% TPTP syntax\n", 130 | ":- op(1130, xfy, <~>). % negated equivalence\n", 131 | ":- op(1110, xfy, <=). % implication\n", 132 | ":- op(1100, xfy, '|'). % disjunction\n", 133 | ":- op(1100, xfy, '~|'). % negated disjunction\n", 134 | ":- op(1000, xfy, &). % conjunction\n", 135 | ":- op(1000, xfy, ~&). % negated conjunction\n", 136 | ":- op( 500, fy, !). % universal quantifier\n", 137 | ":- op( 500, fy, ?). % existential quantifier\n", 138 | ":- op( 400, xfx, =). % equality\n", 139 | ":- op( 300, xf, !). % negated equality (for !=)\n", 140 | ":- op( 299, fx, $). % for $true/$false\n", 141 | " \n", 142 | "\n", 143 | "z3(int(A), F) :- py_call(z3:'Int'(A), F).\n", 144 | "z3(bool(A), F) :- py_call(z3:'Bool'(A), F).\n", 145 | "z3(A & B, F) :- z3(A, ZA), z3(B, ZB), py_call(z3:'And'(ZA,ZB), F).\n", 146 | "z3(A | B, F) :- z3(A, ZA), z3(B, ZB), py_call(z3:'Or'(ZA,ZB), F).\n", 147 | "z3(~A, F) :- z3(A, ZA), py_call(z3:'Not'(ZA), F).\n", 148 | "z3(A = B, F) :- z3(A, ZA), z3(B, ZB), py_call(z3:'Eq'(ZA,ZB), F).\n", 149 | "z3(A != B, F) :- z3(A, ZA), z3(B, ZB), py_call(z3:'Distinct'(ZA,ZB), F).\n", 150 | "z3(! Vs : B, A), F) :- z3(B, ZB), py_call(z3:'ForAll'(Vs, ZB), F).\n", 151 | "z3(? Vs : B, A), F) :- z3(B, ZB), py_call(z3:'Exists'(Vs, ZB), F).\n", 152 | "z3(A => B, F) :- z3(A, ZA), z3(B, ZB), py_call(z3:'Implies'(ZA,ZB), F).\n", 153 | "z3(A <=> B, F) :- z3(A, ZA), z3(B, ZB), py_call(z3:'Eq'(ZA,ZB), F).\n", 154 | "\n", 155 | "\"\"\")\n", 156 | "\n", 157 | "a = janus.query_once(\"z3(bool(a) & bool(b), F)\")[\"F\"]\n", 158 | "type(a)\n" 159 | ] 160 | }, 161 | { 162 | "cell_type": "code", 163 | "execution_count": 1, 164 | "metadata": {}, 165 | "outputs": [], 166 | "source": [ 167 | "from z3 import *" 168 | ] 169 | }, 170 | { 171 | "cell_type": "code", 172 | "execution_count": null, 173 | "metadata": {}, 174 | "outputs": [], 175 | "source": [] 176 | }, 177 | { 178 | "cell_type": "code", 179 | "execution_count": null, 180 | "metadata": {}, 181 | "outputs": [], 182 | "source": [] 183 | } 184 | ], 185 | "metadata": { 186 | "kernelspec": { 187 | "display_name": "Python 3", 188 | "language": "python", 189 | "name": "python3" 190 | }, 191 | "language_info": { 192 | "codemirror_mode": { 193 | "name": "ipython", 194 | "version": 3 195 | }, 196 | "file_extension": ".py", 197 | "mimetype": "text/x-python", 198 | "name": "python", 199 | "nbconvert_exporter": "python", 200 | "pygments_lexer": "ipython3", 201 | "version": "3.10.12" 202 | } 203 | }, 204 | "nbformat": 4, 205 | "nbformat_minor": 2 206 | } 207 | -------------------------------------------------------------------------------- /prologsolvers/sat/normalise.pl: -------------------------------------------------------------------------------- 1 | 2 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 3 | %A normalisation procedure 4 | % 5 | %Authors: Jacob Howe and Andy King 6 | %Last modified: 10/9/10 7 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 8 | 9 | %main(CNF, Map) :- 10 | % cnf(and(or(and(a == f(d), c == h(f(d))), 11 | % and([a == g(d, e), c == h(g(e, d)), d == e])), c =\= h(a)), CNF, Map), 12 | % write_term(CNF-Map, [max_depth(0)]). 13 | 14 | main(CNF, Map) :- 15 | cnf(and(or(and(a == b, b == g(c)), and(a == g(b), b == c)), a =\= g(c)), CNF, Map), 16 | write_term(CNF-Map, [max_depth(0)]). 17 | 18 | %main(CNF, Map) :- 19 | % cnf(imply(and([X < Y, or(X=0, Y=0), or(Y=0, Y=1)]), X+Y>=1), CNF, Map), 20 | % write_term(CNF-Map, [max_depth(0)]). 21 | 22 | cnf(A, CNFout, Mapout) :- 23 | cnf(A, W, [[true-W]], CNFout, [], Mapin, [], Fresh), 24 | sort(Fresh, OrderedFresh), 25 | equate_fresh_vars(OrderedFresh), 26 | equate_witness_vars(Mapin, Mapout). 27 | 28 | equate_fresh_vars([]). 29 | equate_fresh_vars([Term1 == Var1 | Eqns]) :- equate_fresh_vars(Eqns, Term1, Var1) . 30 | 31 | equate_fresh_vars([], _Term1, _Var1) . 32 | equate_fresh_vars([Term2 == Var2 | Eqns], Term1, Var1) :- 33 | (Term1 == Term2 -> 34 | Var1 = Var2 35 | ; 36 | true 37 | ), 38 | equate_fresh_vars(Eqns, Term2, Var2). 39 | 40 | equate_witness_vars(Mapin, Mapout) :- 41 | invert(Mapin, InvertedMapin), 42 | sort(InvertedMapin, OrderedMapin), 43 | equate_witness_vars_aux(OrderedMapin, Mapout). 44 | 45 | invert([], []). 46 | invert([Var-Con|Map], [Con-Var | InvertedMap]) :- invert(Map, InvertedMap). 47 | 48 | equate_witness_vars_aux([], []). 49 | equate_witness_vars_aux([Con-Var | InvertedMap], Map) :- 50 | equate_witness_vars_aux(InvertedMap, Con, Var, [], Map). 51 | 52 | equate_witness_vars_aux([], Con, Var, AccMap, Map) :- 53 | Map = [Var-Con | AccMap]. 54 | equate_witness_vars_aux([Con2-Var2 | InvertedMap], Con1, Var1, AccMap, Map) :- 55 | (Con1 \== triv, Con2 \== triv, Con1 == Con2 -> 56 | Var1 = Var2, 57 | equate_witness_vars_aux(InvertedMap, Con2, Var2, AccMap, Map) 58 | ; 59 | equate_witness_vars_aux(InvertedMap, Con2, Var2, [Var1-Con1 | AccMap], Map) 60 | ). 61 | 62 | cnf(A, W, CNFin, CNFout, Mapin, Mapout, Fresh, Fresh) :- 63 | simple(A), 64 | !, 65 | A = W, 66 | CNFout = CNFin, 67 | Mapout = [A-triv | Mapin]. 68 | %cnf(X = Y, W, CNFin, CNFout, Mapin, Mapout, Freshin, Freshout) :- 69 | % cnf(and(Y =< X, X =< Y), W, CNFin, CNFout, Mapin, Mapout, Freshin, Freshout). 70 | cnf(X = Y, W, CNFin, CNFout, Mapin, Mapout, Fresh, Fresh) :- 71 | CNFout = CNFin, 72 | Mapout = [W-(X = Y) | Mapin]. 73 | cnf(X < Y, W, CNFin, CNFout, Mapin, Mapout, Freshin, Freshout) :- 74 | cnf(not(Y =< X), W, CNFin, CNFout, Mapin, Mapout, Freshin, Freshout). 75 | cnf(X > Y, W, CNFin, CNFout, Mapin, Mapout, Freshin, Freshout) :- 76 | cnf(Y < X, W, CNFin, CNFout, Mapin, Mapout, Freshin, Freshout). 77 | cnf(X >= Y, W, CNFin, CNFout, Mapin, Mapout, Freshin, Freshout) :- 78 | cnf(Y =< X, W, CNFin, CNFout, Mapin, Mapout, Freshin, Freshout). 79 | cnf(X =< Y, W, CNFin, CNFout, Mapin, Mapout, Fresh, Fresh) :- 80 | CNFout = CNFin, 81 | Mapout = [W-(X =< Y) | Mapin]. 82 | cnf(X == Y, W, CNFin, CNFout, Mapin, Mapout, Freshin, Freshout) :- 83 | curry_eqns([X == Y], CurriedEqns), 84 | flatten_eqns(CurriedEqns, [], SimpleEqns, Freshin, Freshout), 85 | cnf_simple_eqns(SimpleEqns, [], W, CNFin, CNFout, Mapin, Mapout). 86 | cnf(X =\= Y, W, CNFin, CNFout, Mapin, Mapout, Freshin, Freshout) :- 87 | cnf(not(X == Y), W, CNFin, CNFout, Mapin, Mapout, Freshin, Freshout). 88 | cnf(not(A), W, CNFin, CNFout, Mapin, Mapout, Freshin, Freshout) :- 89 | cnf(A, W1, [[true-W, true-W1], [false-W, false-W1] | CNFin], CNFout, [W-triv | Mapin], Mapout, Freshin, Freshout). 90 | cnf(or(A, B), W, CNFin, CNFout, Mapin, Mapout, Freshin, Freshout) :- 91 | cnf(A, WA, [[false-WA, true-W], [false-WB, true-W], [true-WA, true-WB, false-W] | CNFin], CNFmid, [W-triv | Mapin], Mapmid, Freshin, Freshmid), 92 | cnf(B, WB, CNFmid, CNFout, Mapmid, Mapout, Freshmid, Freshout). 93 | cnf(imply(A, B), W, CNFin, CNFout, Mapin, Mapout, Freshin, Freshout) :- 94 | cnf(A, WA, [[true-WA, true-W], [false-WB, true-W], [false-WA, true-WB, false-W] | CNFin], CNFmid, [W-triv | Mapin], Mapmid, Freshin, Freshmid), 95 | cnf(B, WB, CNFmid, CNFout, Mapmid, Mapout, Freshmid, Freshout). 96 | cnf(and(A, B), W, CNFin, CNFout, Mapin, Mapout, Freshin, Freshout) :- 97 | cnf(A, WA, [[true-WA, false-W], [true-WB, false-W], [false-WA, false-WB, true-W] | CNFin], CNFmid, [W-triv | Mapin], Mapmid, Freshin, Freshmid), 98 | cnf(B, WB, CNFmid, CNFout, Mapmid, Mapout, Freshmid, Freshout). 99 | cnf(and(As), W, CNFin, CNFout, Mapin, Mapout, Freshin, Freshout) :- 100 | cnf_and(As, [true-W], W, CNFin, CNFout, Mapin, Mapout, Freshin, Freshout). 101 | 102 | cnf_and([], Clause, W, CNFin, CNFout, Mapin, Mapout, Freshin, Freshout) :- 103 | CNFout = [Clause | CNFin], 104 | Mapout = [W-triv | Mapin], 105 | Freshout = Freshin. 106 | cnf_and([A | As], Clause, W, CNFin, CNFout, Mapin, Mapout, Freshin, Freshout) :- 107 | cnf(A, WA, CNFin, CNFmid, Mapin, Mapmid, Freshin, Freshmid), 108 | cnf_and(As, [false-WA | Clause], W, [[true-WA, false-W] | CNFmid], CNFout, Mapmid, Mapout, Freshmid, Freshout). 109 | 110 | cnf_simple_eqns([], Ws, W, CNFin, CNFout, Mapin, Mapout) :- 111 | CNFout = [[true-W | Ws] | CNFin], 112 | Mapout = [W-triv | Mapin]. 113 | cnf_simple_eqns([Eqn | Eqns], Ws, W, CNFin, CNFout, Mapin, Mapout) :- 114 | cnf_simple_eqns(Eqns, [false-WEqn | Ws], W, [[true-WEqn, false-W] | CNFin], CNFout, [WEqn-Eqn | Mapin], Mapout). 115 | 116 | flatten_eqns([], FlatEqns, FlatEqns, Fresh, Fresh). 117 | flatten_eqns([A == B | Eqns], AccEqns, FlatEqns, Freshin, Freshout) :- 118 | simple(A), simple(B), !, 119 | flatten_eqns(Eqns, [A == B | AccEqns], FlatEqns, Freshin, Freshout). 120 | flatten_eqns([A == B | Eqns], AccEqns, FlatEqns, Freshin, Freshout) :- % nothing can be inferred 121 | compound(A), compound(B), !, 122 | flatten_eqns(Eqns, AccEqns, FlatEqns, Freshin, Freshout). 123 | flatten_eqns([A == B | Eqns], AccEqns, FlatEqns, Freshin, Freshout) :- 124 | simple(A), compound(B), !, 125 | flatten_eqns([B == A | Eqns], AccEqns, FlatEqns, Freshin, Freshout). 126 | flatten_eqns([f(A1, A2) == B | Eqns], AccEqns, FlatEqns, Freshin, Freshout) :- 127 | simple(A1), simple(A2), simple(B), !, 128 | flatten_eqns(Eqns, [f(A1, A2) == B | AccEqns], FlatEqns, Freshin, Freshout). 129 | flatten_eqns([f(A1, A2) == B | Eqns], AccEqns, FlatEqns, Freshin, Freshout) :- 130 | compound(A1), simple(B), !, 131 | flatten_eqns([f(NewA1, A2) == B, A1 == NewA1 | Eqns], AccEqns, FlatEqns, [A1 == NewA1 | Freshin], Freshout). 132 | flatten_eqns([f(A1, A2) == B | Eqns], AccEqns, FlatEqns, Freshin, Freshout) :- 133 | compound(A2), simple(B), 134 | flatten_eqns([f(A1, NewA2) == B, A2 == NewA2 | Eqns], AccEqns, FlatEqns, [A2 == NewA2 | Freshin], Freshout). 135 | 136 | curry_eqns([], []). 137 | curry_eqns([A == B | Eqns], [CurriedA == CurriedB | CurriedEqns]) :- 138 | curry_term(A, CurriedA), 139 | curry_term(B, CurriedB), 140 | curry_eqns(Eqns, CurriedEqns). 141 | 142 | curry_term(Term, CurriedTerm) :- 143 | simple(Term) -> 144 | CurriedTerm = Term 145 | ; 146 | Term =.. [Functor | Args], 147 | curry_terms(Args, CurriedArgs), 148 | curry_args(CurriedArgs, Functor, CurriedTerm) 149 | . 150 | 151 | curry_args([], Term, Term). 152 | curry_args([Arg | Args], Term, CurriedTerm) :- 153 | curry_args(Args, f(Term, Arg), CurriedTerm). 154 | 155 | curry_terms([], []). 156 | curry_terms([Term | Terms], [CurriedTerm | CurriedTerms]) :- 157 | curry_term(Term, CurriedTerm), 158 | curry_terms(Terms, CurriedTerms). 159 | -------------------------------------------------------------------------------- /prologsolvers/sat/uninterpreted_theory.pl: -------------------------------------------------------------------------------- 1 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 2 | %Decision procedure for uninterpreted functors 3 | % 4 | %Authors: Jacob Howe and Andy King 5 | %Last modified: 10/9/10 6 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 7 | 8 | :- module(theory, [post_all/1, unsat_core/3]). 9 | :- use_module(library(avl)). 10 | :- use_module(library(assoc)). 11 | 12 | main :- post_all([true-(b==c),false-(f(g,c)==a)]). 13 | 14 | post_all(Eqns) :- post_all(Eqns, [], []). 15 | 16 | post_all([], Eqs, DisEqs) :- 17 | my_empty_assoc(RepMap1), 18 | my_empty_assoc(ClassMap1), 19 | my_empty_assoc(LookMap1), 20 | my_empty_assoc(UseMap1), 21 | setup_maps(Eqs, RepMap1, RepMap2, ClassMap1, ClassMap2, UseMap1, UseMap2), 22 | setup_maps(DisEqs, RepMap2, RepMap3, ClassMap2, ClassMap3, UseMap2, UseMap3), 23 | merge(Eqs, RepMap3, RepMap4, ClassMap3, _ClassMap4, LookMap1, LookMap3, UseMap3, _UseMap4), 24 | check(DisEqs, RepMap4, LookMap3). 25 | post_all([_Bool-triv | Eqns], Eqs, DisEqs) :- 26 | !, 27 | post_all(Eqns, Eqs, DisEqs). 28 | post_all([Bool-Eqn | Eqns], Eqs, DisEqs) :- 29 | (Bool == true -> 30 | post_all(Eqns, [Eqn | Eqs], DisEqs) 31 | ; 32 | post_all(Eqns, Eqs, [Eqn | DisEqs]) 33 | ). 34 | 35 | setup_maps([], RepMap, RepMap, ClassMap, ClassMap, UseMap, UseMap). 36 | setup_maps([Term | Terms], RepMap1, RepMap3, ClassMap1, ClassMap3, UseMap1, UseMap3) :- 37 | simple(Term), !, 38 | (my_get_assoc(Term, RepMap1, _Rep) -> 39 | RepMap2 = RepMap1, 40 | ClassMap2 = ClassMap1, 41 | UseMap2 = UseMap1 42 | ; 43 | my_put_assoc(Term, RepMap1, Term, RepMap2), 44 | my_put_assoc(Term, ClassMap1, [Term], ClassMap2), 45 | my_put_assoc(Term, UseMap1, [], UseMap2) 46 | ), 47 | setup_maps(Terms, RepMap2, RepMap3, ClassMap2, ClassMap3, UseMap2, UseMap3). 48 | setup_maps([Term1 == Term2 | Eqs], RepMap1, RepMap3, ClassMap1, ClassMap2, UseMap1, UseMap2) :- 49 | !, 50 | setup_maps([Term1, Term2 | Eqs], RepMap1, RepMap3, ClassMap1, ClassMap2, UseMap1, UseMap2). 51 | setup_maps([Term1 =\= Term2 | Eqs], RepMap1, RepMap3, ClassMap1, ClassMap2, UseMap1, UseMap2) :- 52 | !, 53 | setup_maps([Term1, Term2 | Eqs], RepMap1, RepMap3, ClassMap1, ClassMap2, UseMap1, UseMap2). 54 | setup_maps([f(Term1, Term2) | Eqs], RepMap1, RepMap2, ClassMap1, ClassMap2, UseMap1, UseMap2) :- 55 | setup_maps([Term1, Term2 | Eqs], RepMap1, RepMap2, ClassMap1, ClassMap2, UseMap1, UseMap2). 56 | 57 | monitor(Eqs, RepMap, _ClassMap, LookMap, UseMap) :- 58 | assoc_to_list(RepMap, RepList), 59 | assoc_to_list(LookMap, LookList), 60 | assoc_to_list(UseMap, UseList), 61 | format("~nEqs, RepMap, LookMap, UseMap = ~w, ~w, ~w, ~w", [Eqs, RepList, LookList, UseList]). 62 | 63 | merge([], RepMap, RepMap, ClassMap, ClassMap, LookMap, LookMap, UseMap, UseMap) :- 64 | % monitor([], RepMap, ClassMap, LookMap, UseMap), 65 | true. 66 | merge([A == B | Eqs], RepMap1, RepMap3, ClassMap1, ClassMap3, LookMap1, LookMap3, UseMap1, UseMap3) :- 67 | % monitor([A == B | Eqs], RepMap1, ClassMap1, LookMap1, UseMap1), 68 | simple(A), simple(B), !, 69 | pending([A == B], RepMap1, RepMap2, ClassMap1, ClassMap2, LookMap1, LookMap2, UseMap1, UseMap2), 70 | merge(Eqs, RepMap2, RepMap3, ClassMap2, ClassMap3, LookMap2, LookMap3, UseMap2, UseMap3). 71 | merge([f(A1, A2) == A | Eqs], RepMap1, RepMap3, ClassMap1, ClassMap3, LookMap1, LookMap3, UseMap1, UseMap4) :- 72 | my_get_assoc(A1, RepMap1, RepA1), 73 | my_get_assoc(A2, RepMap1, RepA2), 74 | (my_get_assoc(RepA1-RepA2, LookMap1, f(D1, D2) == D) -> 75 | pending([(f(RepA1, RepA2) == A, f(D1, D2) == D)], RepMap1, RepMap2, ClassMap1, ClassMap2, LookMap1, LookMap2, UseMap1, UseMap3) 76 | ; 77 | my_put_assoc(RepA1-RepA2, LookMap1, f(RepA1, RepA2) == A, LookMap2), 78 | my_get_assoc(RepA1, UseMap1, Use1), 79 | my_get_assoc(RepA2, UseMap1, Use2), 80 | my_put_assoc(RepA1, UseMap1, [f(RepA1, RepA2) == A | Use1], UseMap2), 81 | my_put_assoc(RepA2, UseMap2, [f(RepA1, RepA2) == A | Use2], UseMap3), 82 | RepMap2 = RepMap1, 83 | ClassMap2 = ClassMap1 84 | ), 85 | merge(Eqs, RepMap2, RepMap3, ClassMap2, ClassMap3, LookMap2, LookMap3, UseMap3, UseMap4). 86 | 87 | pending([], RepMap, RepMap, ClassMap, ClassMap, LookMap, LookMap, UseMap, UseMap). 88 | pending([Eq | Pending1], RepMap1, RepMap3, ClassMap1, ClassMap4, LookMap1, LookMap3, UseMap1, UseMap4) :- 89 | (Eq = (A == B) -> 90 | true 91 | ; 92 | Eq = (f(_, _) == A, f(_, _) == B) 93 | ), 94 | my_get_assoc(A, RepMap1, RepA), 95 | my_get_assoc(B, RepMap1, RepB), 96 | (RepA == RepB -> 97 | Pending2 = Pending1, 98 | RepMap2 = RepMap1, 99 | ClassMap3 = ClassMap1, 100 | LookMap2 = LookMap1, 101 | UseMap3 = UseMap1 102 | ; 103 | my_del_assoc(RepA, ClassMap1, Terms1, ClassMap2), 104 | my_get_assoc(RepB, ClassMap2, Terms2), 105 | append(Terms1, Terms2, Terms), 106 | my_put_assoc(RepB, ClassMap2, Terms, ClassMap3), 107 | update_repmap(Terms1, RepB, RepMap1, RepMap2), 108 | my_del_assoc(RepA, UseMap1, Eqs, UseMap2), 109 | update_lookmap(Eqs, RepMap2, LookMap1, LookMap2, UseMap2, UseMap3, Pending1, Pending2) 110 | ), 111 | pending(Pending2, RepMap2, RepMap3, ClassMap3, ClassMap4, LookMap2, LookMap3, UseMap3, UseMap4). 112 | 113 | update_repmap([], _Rep, RepMap, RepMap). 114 | update_repmap([Term | Terms], Rep, RepMap1, RepMap3) :- 115 | my_put_assoc(Term, RepMap1, Rep, RepMap2), 116 | update_repmap(Terms, Rep, RepMap2, RepMap3). 117 | 118 | update_lookmap([], _RepMap, LookMap, LookMap, UseMap, UseMap, Pending, Pending). 119 | update_lookmap([f(C1, C2) == C | Eqs], RepMap, LookMap1, LookMap3, UseMap1, UseMap4, Pending1, Pending2) :- 120 | my_get_assoc(C1, RepMap, RepC1), 121 | my_get_assoc(C2, RepMap, RepC2), 122 | (my_get_assoc(RepC1-RepC2, LookMap1, f(D1, D2) == D) -> 123 | update_lookmap(Eqs, RepMap, LookMap1, LookMap2, UseMap1, UseMap4, [(f(RepC1, RepC2) == C, f(D1, D2) == D) | Pending1], Pending2) 124 | ; 125 | my_put_assoc(RepC1-RepC2, LookMap1, f(RepC1, RepC2) == C, LookMap2), 126 | (my_get_assoc(RepC1, UseMap1, EqsC1) -> 127 | filter_usemap(EqsC1, RepMap, [f(RepC1, RepC2) == C], FilterEqsC1) 128 | ; 129 | FilterEqsC1 = [f(RepC1, RepC2) == C] 130 | ), 131 | my_put_assoc(RepC1, UseMap1, FilterEqsC1, UseMap2), 132 | (my_get_assoc(RepC2, UseMap2, EqsC2) -> 133 | filter_usemap(EqsC2, RepMap, [f(RepC1, RepC2) == C], FilterEqsC2) 134 | ; 135 | FilterEqsC2 = [f(RepC1, RepC2) == C] 136 | ), 137 | my_put_assoc(RepC2, UseMap2, FilterEqsC2, UseMap3), 138 | update_lookmap(Eqs, RepMap, LookMap2, LookMap3, UseMap3, UseMap4, Pending1, Pending2) 139 | ). 140 | 141 | filter_usemap([], _, AccEqs, FilterEqs) :- 142 | sort(AccEqs, FilterEqs). 143 | filter_usemap([f(A1, A2) == A | Eqs], RepMap, AccEqs, FilterEqs) :- 144 | my_get_assoc(A1, RepMap, RepA1), 145 | my_get_assoc(A2, RepMap, RepA2), 146 | filter_usemap(Eqs, RepMap, [f(RepA1, RepA2) == A | AccEqs], FilterEqs). 147 | 148 | % my_empty_assoc(Assoc) :- empty_avl(Assoc). 149 | % my_get_assoc(Key, Map, Value) :- avl_fetch(Key, Map, Value). 150 | % my_put_assoc(Key, Map1, Value, Map2) :- avl_store(Key, Map1, Value, Map2). 151 | % my_del_assoc(Key, Map1, Value, Map2) :- avl_delete(Key, Map1, Value, Map2). % fixed in SICStus 4.1.2 152 | 153 | my_empty_assoc(Assoc) :- empty_assoc(Assoc). 154 | my_get_assoc(Key, Map, Value) :- get_assoc(Key, Map, Value). 155 | my_put_assoc(Key, Map1, Value, Map2) :- put_assoc(Key, Map1, Value, Map2). 156 | my_del_assoc(Key, Map1, Value, Map2) :- get_assoc(Key, Map1, Value), put_assoc(Key, Map1, bot, Map2). 157 | 158 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 159 | 160 | check([], _RepMap, _LookMap). 161 | check([A == B | DisEqs], RepMap, LookMap) :- 162 | simple(A), !, 163 | get_assoc(A, RepMap, RepA), 164 | get_assoc(B, RepMap, RepB), 165 | RepA \== RepB, 166 | check(DisEqs, RepMap, LookMap). 167 | check([f(A1, A2) == A | DisEqs], RepMap, LookMap) :- 168 | get_assoc(A1, RepMap, RepA1), 169 | get_assoc(A2, RepMap, RepA2), 170 | (get_assoc(RepA1-RepA2, LookMap, (f(_, _) == B)) -> 171 | get_assoc(A, RepMap, RepA), 172 | get_assoc(B, RepMap, RepB), 173 | RepA \== RepB 174 | ; 175 | true 176 | ), 177 | check(DisEqs, RepMap, LookMap). 178 | 179 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 180 | 181 | unsat_core(VarMap, ConstraintMap, Min) :- 182 | assoc_to_vals(VarMap, ConstraintMap, [], Cons), 183 | remove_red_aux(Cons, [], [], Min). 184 | 185 | assoc_to_vals([], _, Cons, Cons). 186 | assoc_to_vals([Val-Var|VarMap], ConstraintMap, Acc, Vs) :- 187 | my_get_assoc(Var, ConstraintMap, Con), 188 | assoc_to_vals(VarMap, ConstraintMap, [Val-Con|Acc], Vs). 189 | 190 | remove_red(Val-C, Cs, Tested, Thing, Min) :- 191 | copy_term(Cs-Tested, CCs-CTested), 192 | append(CTested, CCs, Combo), 193 | post_all(Combo), !, 194 | remove_red_aux(Cs, [Val-C | Tested], [Val | Thing], Min). 195 | remove_red(_, Cs, Tested, Thing, Min) :- 196 | remove_red_aux(Cs, Tested, [na | Thing], Min). 197 | 198 | remove_red_aux([], _Tested, Min, Min). 199 | remove_red_aux([C|Cs],Tested, Thing, Min) :- 200 | remove_red(C, Cs, Tested, Thing, Min). 201 | -------------------------------------------------------------------------------- /prologsolvers/setlog/setlog_rules.pl: -------------------------------------------------------------------------------- 1 | 2 | % Version 1.2-17 3 | 4 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 5 | % 6 | % User-defined "filtering" rules 7 | % for {log} version 4.8.2-2 or newer 8 | % 9 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 10 | % 11 | % by Maximiliano Cristia' and Gianfranco Rossi 12 | % April 2014 13 | % 14 | % Revised June 2023 15 | % 16 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 17 | 18 | filter_on. 19 | 20 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 21 | %%%%%%%%%%%%%%%%%%%%%%%% General rules %%%%%%%%%%%%%%%%%%%%%%%% 22 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 23 | 24 | 25 | %%%%%%%%%%%%%%%%%%%%%%%% equivalence rules 26 | 27 | % equiv_rule(A,B), with A, B {log} predicates: if the input goal contains B then 28 | % B matches with both filtering rules for A and filtering rules for B (since B => A) 29 | % (mainly for compatibility with previous releases) 30 | 31 | :- op(700,xfx,[ein,enin]). 32 | 33 | equiv_rule(e2,inters(X,Y,Z),dinters(X,Y,Z)). % e2. dinters(X,Y,Z) => inters(X,Y,Z) 34 | equiv_rule(e3,ssubset(X,Y),dssubset(X,Y)). % e3. dssubset(X,Y) => ssubset(X,Y) 35 | equiv_rule(e4,nsubset(X,Y),dnsubset(X,Y)). % e4. dnsubset(X,Y) => nsubset(X,Y) 36 | equiv_rule(e5,X in Y,X ein Y). % e5. X ein Y => X in Y 37 | equiv_rule(e6,X nin Y,X enin Y). % e6. X enin Y => X nin Y 38 | 39 | 40 | %%%%%%%%%%%%%%%%%%%%%%%% replace rules 41 | 42 | % replace_rule( 43 | % W: when, 44 | % C: atomic constraint 45 | % C_Conds: list of conditions for C 46 | % D: list of other atomic constraints to be checked 47 | % D_Conds: list of conditions for atomic constraints in D and C 48 | % AddC: constraint to be replaced to C) 49 | 50 | %%%%% general 51 | 52 | % t = X -replace-> X = t 53 | replace_rule(r1,T=X,[var(X),nonvar(T)],[],[],X=T). 54 | 55 | % X = Y -replace-> true & apply substitution 56 | %replace_rule(r2,X = Y,[var(X),var(Y),X=Y],[],[],true). 57 | 58 | %%%%% sets 59 | 60 | % inters(X,{...},t3) -replace-> inters({...},X,t3) 61 | replace_rule(sr1,inters(X,T2,T3),[var(X),nonvar(T2)],[],[],inters(T2,X,T3)). 62 | 63 | % A neq B & set(A) & set(B) -replace-> (X in A & X nin B or X nin A & X in B) 64 | replace_rule(sr2,A neq B,[var(A),var(B)],[set(A1),set(B1)],[A1==A,B1==B],(X in A & X nin B or X nin A & X in B)). 65 | % 66 | % A neq {...} & set(A) -replace-> (X in A & X nin {...} or X nin A & X in {...}) 67 | replace_rule(sr3,A neq B,[var(A),nonvar(B),B=_ with _],[set(A1)],[A1==A],(X in A & X nin B or X nin A & X in B)). 68 | % 69 | % {...} neq B & set(B) -replace-> (X in B & X nin {...} or X nin B & X in {...}) 70 | replace_rule(sr4,A neq B,[var(B),nonvar(A),A=_ with _],[set(B1)],[B1==B],(X in A & X nin B or X nin A & X in B)). 71 | 72 | % subset(A,B) & diff(B,A,C) -replace-> subset(A,B) & un(A,C,B) & disj(A,C) 73 | replace_rule(sr5,diff(B,A,C),[],[subset(A1,B1)],[A1==A,B1==B],(un(A,C,B) & disj(A,C))). 74 | % 75 | % subset(A,B) & un(A,C,B) -replace-> un(A,C,B) 76 | replace_rule(sr5_bis,subset(A,B),[],[un(A1,_C,B1)],[A1==A,B1==B],true). 77 | 78 | % un(A,B,B) & diff(B,A,C) -replace-> un(A,B,B) & un(A,C,B) & disj(A,C) 79 | replace_rule(sr6,diff(B,A,C),[],[un(A1,B1,B2)],[A1==A,B1==B,B2==B],(un(A,C,B) & disj(A,C))). 80 | % 81 | % un(A,B,B) & un(A,C,B) -replace-> un(A,C,B) 82 | replace_rule(sr6_bis,un(A,Ba,Bb),[Ba==Bb],[un(A1,C,B1)],[A1==A,B1==Ba,C\==B1],true). 83 | 84 | % diff(B,A,C) & diff(B,D,E) & D=A -replace-> diff(B,D,C) & A=D & E=C 85 | replace_rule(sr7,diff(B,A,C),[],[diff(B1,D,E),D1=A1],[A1==A,B1==B,D1==D],E=C). 86 | 87 | %%%%% relations/partial functions 88 | 89 | % dom(Rel,Dom) & pfun(Rel) -replace-> dompf(Rel,Dom) & pfun(Rel) 90 | replace_rule(br4,dom(Rel,Dom),[var(Rel)],[pfun(Rel1)],[Rel1==Rel],dompf(Rel,Dom)). 91 | 92 | % comp(R,S,Q) & pfun(R) & pfun(S) -replace-> comppf(R,S,Q) & pfun(Q) & pfun(R) & pfun(S) 93 | replace_rule(br5,comp(R,S,Q),[var(R),var(S)],[pfun(R1),pfun(S1)],[R1==R,S1==S],comppf(R,S,Q) & pfun(Q)). 94 | 95 | % dres(A,R,S) & pfun(R) -replace-> drespf(A,R,S) & pfun(R) 96 | replace_rule(br6,dres(A,R,S),[var(R)],[pfun(R1)],[R1==R],drespf(A,R,S)). 97 | 98 | % rel(R) & pfun(R) -replace-> pfun(R) & pfun(R) 99 | replace_rule(br7,rel(R),[var(R)],[pfun(R1)],[R1==R],pfun(R)). 100 | 101 | %un(S,T,cp(A,A)) -replace-> delay(un(S,T,cp(A,A)),false) 102 | %un(S,cp(C,D),cp(A,A)) -replace-> delay(un(S,cp(C,D),cp(A,A)),false) 103 | replace_rule(br9,un(S,T,CP2),[var(S),var(T),nonvar(CP2),CP2=cp(A,B),var(A),A==B], 104 | [],[],G=un(S,T,CP2) & delay(G,false) ). 105 | replace_rule(br9bis,un(S,CP1,CP2),[var(S),nonvar(CP1),CP1=cp(C,D),var(C),var(D),nonvar(CP2),CP2=cp(A,B),var(A),A==B], 106 | [],[],G=un(S,CP1,CP2) & delay(G,false) ). 107 | 108 | %subset(S,cp(A,A)) -replace-> delay(subset(S,cp(A,A)),false) 109 | replace_rule(br10,subset(S,CP2),[var(S),nonvar(CP2),CP2=cp(A,B),var(A),A==B], 110 | [],[],G=subset(S,CP2) & delay(G,false) ). 111 | 112 | %%%%% integer numbers 113 | 114 | % X < Y -replace-> Y > X 115 | replace_rule(ir1,X < Y,[var(X),var(Y)],[],[],Y > X). 116 | 117 | % X =< Y -replace-> Y >= X 118 | replace_rule(ir2,X =< Y,[var(X),var(Y)],[],[],Y >= X). 119 | 120 | 121 | %%%%%%%%%%%%%%%%%%%%%%%% inference rules 122 | 123 | % inference_rule( 124 | % W: when, 125 | % C: atomic constraint 126 | % C_Conds: list of conditions for C 127 | % D: list of other atomic constraints to be checked 128 | % D_Conds: list of conditions for atomic constraints in D and C 129 | % E: list of constraints in D to be NOT checked 130 | % AddC: constraint to be added) 131 | 132 | %%%%% sets 133 | 134 | %inters(X,Y,Z) & un(X,Y,Z) -+-> X = Y & Y = Z 135 | inference_rule('inters-un1',inters(X,Y,Z),[var(X),var(Y),var(Z)],[un(X1,Y1,Z1)],[X1==X,Y1==Y,Z1==Z],[],X = Y & Y = Z). 136 | %inters(X,Y,Z) & un(Y,X,Z) -+-> X = Y & Y = Z 137 | inference_rule('inters-un2',inters(X,Y,Z),[var(X),var(Y),var(Z)],[un(Y1,X1,Z1)],[X1==X,Y1==Y,Z1==Z],[],X = Y & Y = Z). 138 | 139 | %inters(X,Y,Z) & diff(X,Y,Z) -+-> X = {} 140 | inference_rule('inters-diff1',inters(X,Y,Z),[var(X),var(Y),var(Z)],[diff(X1,Y1,Z1)],[X1==X,Y1==Y,Z1==Z],[],X = {}). 141 | %inters(X,Y,Z) & diff(Y,X,Z) -+-> Y = {} 142 | inference_rule('inters-diff2',inters(X,Y,Z),[var(X),var(Y),var(Z)],[diff(Y1,X1,Z1)],[X1==X,Y1==Y,Z1==Z],[],Y = {}). 143 | 144 | % un(X,Y,Z) & disj(X,Z) -add-> X = {} 145 | inference_rule('un-disj',un(X,Y,Z),[var(X),var(Y),var(Z)],[disj(X1,Z1)],[X1==X,Z1==Z],[], X = {}). 146 | 147 | %%%%% lists 148 | 149 | % length(L,N) & length(L,M) -add-> N = M 150 | inference_rule('length-length',length(L,N),[var(L)],[length(L1,M)],[L1==L],[length(L,N)], N = M). 151 | 152 | %%%%% integer numbers 153 | 154 | % X > Y & Y > Z -add-> X > Z 155 | inference_rule('gt-gt',X > Y,[var(X),var(Y)],[Y1 > Z],[Y1==Y,Z\==X],[X > Y], X > Z). 156 | 157 | % X >= Y & Y >= X -add-> X = Y 158 | inference_rule('ge-ge',X >= Y,[var(X),var(Y)],[Y1 >= X1],[Y1==Y,X1==X],[], X = Y). 159 | 160 | % X is A - B & A > 0 & B > 0 & X > 0 -add-> A > B 161 | inference_rule('minus-gt0-gt0',X is A - B,[var(X),var(A),var(B)],[A1 > 0, B1 > 0, X1 > 0],[A1==A,B1==B,X1==X],[], A > B). 162 | 163 | % X is Y + k & Z is Y + k -add-> X = Z 164 | inference_rule('sum-sum',X is Y + K,[var(X),var(Y),integer(K)],[Z is Y1 + K1],[var(Z),var(Y1),integer(K1),Y1==Y,K1==K],[X is Y+K], X = Z). 165 | 166 | 167 | %%%%%%%%%%%%%%%%%%%%%%%% fail rules 168 | 169 | % fail_rule( 170 | % W: when, 171 | % C: atomic constraint 172 | % C_Conds: list of conditions for C 173 | % D: list of other atomic constraints to be checked 174 | % D_Conds: list of conditions for atomic constraints in D and C 175 | % E: list of constraints in D to be NOT checked) 176 | 177 | %%%%% integer numbers 178 | 179 | % bf1. X > Y & Y > X 180 | fail_rule('gt-gt',X > Y,[],[V > W],[V==Y,W==X],[]). 181 | % it works also for X > X 182 | 183 | % bf2. X >= Y & Y > X 184 | fail_rule('ge-gt',X >= Y,[],[V > W],[V==Y,W==X],[]). 185 | 186 | %%%%% sets 187 | 188 | % bf3. X in S & X nin S 189 | fail_rule('in-nin',X in S,[var(S)],[X1 nin S1],[X1==X,S1==S],[]). 190 | 191 | % bf4. NotSubsetOfSingleton 192 | % A neq {} & ssubset(A,{X}) 193 | fail_rule('NotSubsetOfSingleton',ssubset(A,S),[nonvar(S),S={} with _X],[A1 neq E],[nonvar(E),E={},A1==A],[]). 194 | 195 | %%%%% intervals (terminating, provided all variables have "not too big" domains) 196 | 197 | % bf5. NatRangeNotEmpty 198 | % X is Z+k & Y is Z+h & I=int(X,Y) & I={} and k =< h, k, h integer constants 199 | fail_rule('NatRangeNotEmpty',I=Intv, 200 | [nonvar(Intv),Intv=int(X,Y),var(X),var(Y)], 201 | [X1 is Expr1,Y1 is Expr2,I1=E], 202 | [nonvar(Expr1),Expr1=(Z+A),integer(A), 203 | nonvar(Expr2), Expr2=(Z1+B),integer(B),A== 0 and it holds that b-a > k*h 210 | % 211 | fail_rule('NatRangeNotEq3',I=Intv, 212 | [nonvar(Intv),Intv=int(X,Y),var(I),var(X),var(Y)], 213 | [X1 is Z+N, Y1 is Z1+M, N is V*H, P >= M, P1 is W*H, W is V1+K, J=int(A,B), I1=J1], 214 | [integer(A),A>=0,integer(B),B>=0,var(J), 215 | var(I1),var(J1),var(X1),var(Y1), 216 | var(N),integer(H),H>=0, 217 | var(P),var(M),var(P1), 218 | var(W),integer(K),K>=0, B-A > K*H, 219 | I==I1,J==J1,X==X1,Y==Y1,Z==Z1,P==P1,V==V1],[]). 220 | 221 | % f22. NatRangeNotSubset 222 | % I=int(X,Y) & J=int(Kn,Km) & essubset(J,I) & X is N+Za & Y is N+Zb & Za is M*Kp & Zb is Zc*Kp & Zc is M+Kq 223 | % with Km-Kn > Kq*Kp 224 | % 225 | fail_rule('NatRangeNotSubset',I=Intv, 226 | [nonvar(Intv),Intv=int(X,Y),var(I),var(X),var(Y)], 227 | [X1 is N+Za, Y1 is N1+Zb, Za1 is M*Kp, Zb1 is Zc*Kp, Zc1 is M1+Kq, J=int(Kn,Km), essubset(J1,I1)], 228 | [integer(Kn),Kn>=0,integer(Km),Km>=0,var(J), 229 | var(I1),var(J1),var(X1),var(Y1), 230 | var(N),var(M),var(Za),var(Zb),var(Zc), 231 | var(N1),var(M1),var(Za1),var(Zb1),var(Zc1), 232 | integer(Kq),Kq>=0,integer(Kp),Kq>=0,Km-Kn > Kq*Kp, 233 | I==I1,J==J1,X==X1,Y==Y1,N==N1,M==M1,Za=Za1,Zb==Zb1,Zc==Zc1],[]). 234 | 235 | % f23. NatRangeNotEq 236 | % I=int(X,Y) & J=int(Kn,Km) & I=J & X is N+Za & Y is N+Zb & Za is M*Kp & Zb is Zc*Kp & Zc is M+Kq 237 | % with Km-Kn > Kq*Kp 238 | % 239 | fail_rule('NatRangeNotEq',I=Intv, 240 | [nonvar(Intv),Intv=int(X,Y),var(I),var(X),var(Y)], 241 | [X1 is N+Za, Y1 is N1+Zb, Za1 is M*Kp, Zb1 is Zc*Kp, Zc1 is M1+Kq, J=int(Kn,Km), I1=J1], 242 | [integer(Kn),Kn>=0,integer(Km),Km>=0,var(J), 243 | var(I1),var(J1),var(X1),var(Y1), 244 | var(N),var(M),var(Za),var(Zb),var(Zc), 245 | var(N1),var(M1),var(Za1),var(Zb1),var(Zc1), 246 | integer(Kq),Kq>=0,integer(Kp),Kq>=0,Km-Kn > Kq*Kp, 247 | I==I1,J==J1,X==X1,Y==Y1,N==N1,M==M1,Za=Za1,Zb==Zb1,Zc==Zc1],[]). 248 | 249 | % f24. NatRangeNotEmpty3 250 | % I=int(X,Y) & I={} & X is N+Za & Y is N+Zb & Za is M*Kn & Zb is Zc*Kn & Zc is M+Km 251 | % 252 | fail_rule('NatRangeNotEmpty3',I=Intv, 253 | [nonvar(Intv),Intv=int(X,Y),var(I),var(X),var(Y)], 254 | [X1 is N+Za, Y1 is N1+Zb, Za1 is M*Kn, Zb1 is Zc*Kn, Zc1 is M1+Km, I1=E], 255 | [nonvar(E),E={}, 256 | integer(Kn),Kn>=0,integer(Km),Km>=0, 257 | var(I1),var(X1),var(Y1), 258 | var(N),var(M),var(Za),var(Zb),var(Zc), 259 | var(N1),var(M1),var(Za1),var(Zb1),var(Zc1), 260 | I==I1,X==X1,Y==Y1,N==N1,M==M1,Za=Za1,Zb==Zb1,Zc==Zc1],[]). 261 | 262 | % f25. NatRangeNotEmpty4 263 | % I=int(N,Y) & I={} & Y is N+M 264 | % 265 | fail_rule('NatRangeNotEmpty4',I=Intv, 266 | [nonvar(Intv),Intv=int(N,Y),var(I),var(N),var(Y)], 267 | [Y1 is N1+M, I1=E], 268 | [nonvar(E),E={},var(I1),var(Y1),var(N),var(N1),var(M),I==I1,Y==Y1,N==N1],[]). 269 | 270 | 271 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 272 | %%%%%%%%%%%%%%%%%%% More specific rules %%%%%%%%%%%%%%%%%%%%%%% 273 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 274 | 275 | % Add here other more specific user-defined rewriting rules, if any 276 | 277 | :- (exists_file('TTF_rules.pl'),!,consult('TTF_rules.pl') % for the TTF 278 | ; 279 | true). 280 | -------------------------------------------------------------------------------- /prologsolvers/trs.py: -------------------------------------------------------------------------------- 1 | # https://github.com/triska/trs 2 | 3 | code = """ 4 | /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 5 | Reason about Term Rewriting Systems. 6 | Written 2015-2022 by Markus Triska (triska@metalevel.at) 7 | Public domain code. Tested with Scryer Prolog. 8 | 9 | Motivating example 10 | ================== 11 | 12 | Consider a set S that is closed under the binary operation *, 13 | satisfying the equations: 14 | 15 | 1) e*X = X 16 | 2) i(X)*X = e 17 | 3) X*(Y*Z) = (X*Y)*Z 18 | 19 | The algebraic structure is called a group. 20 | 21 | From these equations, we can infer additional identities, such as: 22 | 23 | e*X = (i(i(X))*i(X))*X = 24 | = i(i(X))*(i(X)*X) = 25 | = i(i(X))*e 26 | 27 | Other identities that follow from these equations are i(i(X)) = X, 28 | i(e) = e, and many others. 29 | 30 | However, it is not immediately clear which identities are implied 31 | by these equations. In many cases, new terms must be inserted into 32 | equations in order to derive further identities, and it is not 33 | clear how far an ongoing derivation must be extended to derive a 34 | new identity, or if that is possible at all. 35 | 36 | Under certain conditions, we can convert such a set of equations 37 | into a set of oriented rewrite rules that always terminate and 38 | reduce identical elements to the same normal form. We call such a 39 | set of rewrite rules a convergent term rewriting system (TRS). 40 | 41 | For example (see group/1 below): 42 | 43 | ?- group(Gs), equations_trs(Gs, Rs), maplist(portray_clause, Rs). 44 | 45 | yielding the convergent TRS: 46 | 47 | i(A*B)==>i(B)*i(A). 48 | A*i(A)==>e. 49 | i(i(A))==>A. 50 | A*e==>A. 51 | A*B*C==>A*(B*C). 52 | i(A)*A==>e. 53 | e*A==>A. 54 | i(A)*(A*B)==>B. 55 | i(e)==>e. 56 | A*(i(A)*B)==>B. 57 | 58 | From this, we see that i(i(X)) = X is one of the consequences of 59 | the equations above. To see whether two terms are identical under 60 | the given equations, we can now simply check whether they reduce to 61 | the same normal form under the computed rewrite rules: 62 | 63 | ?- group(Gs), equations_trs(Gs, Rs), 64 | normal_form(Rs, i(i(X)), NF), 65 | normal_form(Rs, i(i(i(i(X)))), NF). 66 | ... 67 | X = NF . 68 | - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 69 | 70 | :- use_module(library(clpfd)). 71 | :- use_module(library(lists)). 72 | %:- use_module(library(dcgs)). 73 | %:- use_module(library(pairs)). 74 | %:- use_module(library(iso_ext)). 75 | %:- use_module(library(format)). 76 | 77 | /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 78 | Variables in equations and TRS are represented by Prolog variables. 79 | 80 | A major advantage of this representation is that efficient built-in 81 | Prolog predicates can be used for unification etc. The terms are 82 | also easier to read and type for users when specifying a TRS. 83 | However, care must be taken not to accidentally unify variables 84 | that are supposed to be different. copy_term/2 must be used when 85 | necessary to prevent this. Conversely, we also must retain all 86 | bindings that are supposed to hold. 87 | 88 | We use: 89 | 90 | Left ==> Right 91 | 92 | to denote a rewrite rule. A TRS is a list of such rules. 93 | - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 94 | 95 | :- op(800, xfx, ==>). 96 | 97 | /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 98 | Perform one rewriting step at the root position, using the first 99 | matching rule, if any. 100 | - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 101 | 102 | step([L==>R|Rs], T0, T) :- 103 | ( subsumes_term(L, T0) -> 104 | copy_term(L-R, T0-T) 105 | ; step(Rs, T0, T) 106 | ). 107 | 108 | %?- step([f(a) ==> f(a), f(X) ==> b], f(a), T). 109 | %?- step([g(f(X)) ==> X], g(Y), T). 110 | %?- step([f(X) ==> b, f(a) ==> f(a)], f(a), T). 111 | 112 | /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 113 | Reduce to normal form. May not terminate! 114 | For example: R = { a -> a, f(x) -> b }, 115 | although f(a) does have a normal form! 116 | - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 117 | 118 | %?- normal_form([f(X) ==> b, a ==> a], f(a), T). 119 | %?- normal_form([a ==> a, f(X) ==> b], f(a), T). 120 | 121 | normal_form(Rs, T0, T) :- 122 | ( var(T0) -> T = T0 123 | ; T0 =.. [F|Args0], 124 | maplist(normal_form(Rs), Args0, Args1), 125 | T1 =.. [F|Args1], 126 | ( step(Rs, T1, T2) -> 127 | normal_form(Rs, T2, T) 128 | ; T = T1 129 | ) 130 | ). 131 | 132 | /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 133 | Critical Pairs 134 | - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 135 | 136 | %?- critical_pairs([X==>a, Y ==> b], Ps). 137 | 138 | critical_pairs(Rs, CPs) :- 139 | phrase(critical_pairs_(Rs, Rs), CPs). 140 | 141 | critical_pairs_([], _) --> []. 142 | critical_pairs_([R|Rs], Rules) --> 143 | rule_cps(R, Rules, []), 144 | critical_pairs_(Rs, Rules). 145 | 146 | rule_cps(T ==> R, Rules, Cs) --> 147 | ( { var(T) } -> [] 148 | ; roots_cps(Rules, T ==> R, Cs), 149 | { T =.. [F|Ts] }, 150 | inner_cps(Ts, F, [], R, Rules, Cs) 151 | ). 152 | 153 | roots_cps([], _, _) --> []. 154 | roots_cps([Left0==>Right0|Rules], L0==>R0, Cs0) --> 155 | { copy_term(f(L0,R0,Cs0), f(L,R,Cs)), 156 | copy_term(Left0-Right0, Left-Right) }, 157 | ( { unify_with_occurs_check(L, Left) } -> 158 | { foldl(context, Cs, Right, Reduced) }, 159 | [R=Reduced] 160 | ; [] 161 | ), 162 | roots_cps(Rules, L0==>R0, Cs0). 163 | 164 | inner_cps([], _, _, _, _, _) --> []. 165 | inner_cps([T|Ts], F, Left0, R, Rules, Cs) --> 166 | { reverse(Left0, Left) }, 167 | rule_cps(T ==> R, Rules, [conc(F,Left,Ts)|Cs]), 168 | inner_cps(Ts, F, [T|Left0], R, Rules, Cs). 169 | 170 | context(conc(F,Ts1,Ts2), Arg, T) :- 171 | append(Ts1, [Arg|Ts2], Ts), 172 | T =.. [F|Ts]. 173 | 174 | %?- foldl(context, [conc(f,[x],[y]),conc(g,[a],[b])], -, R). 175 | 176 | /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 177 | Lexicographic order. 178 | - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 179 | 180 | %?- ord([a,b,c], b, a, Ord). 181 | 182 | ord(Fs, F1, F2, Ord) :- 183 | once((nth0(N1, Fs, F1), 184 | nth0(N2, Fs, F2))), 185 | compare(Ord, N1, N2). 186 | 187 | lex(Cmp, Xs, Ys, Ord) :- lex_(Xs, Ys, Cmp, Ord). 188 | 189 | lex_([], [], _, =). 190 | lex_([X|Xs], [Y|Ys], Cmp, Ord) :- 191 | call(Cmp, X, Y, Ord0), 192 | ( Ord0 == (=) -> lex_(Xs, Ys, Cmp, Ord) 193 | ; Ord = Ord0 194 | ). 195 | 196 | /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 197 | Multiset order. 198 | - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 199 | 200 | %?- foldl(subtract_element(ord([a,b,c])), [a], [a,a,b,c], Rs). 201 | %?- multiset_diff(ord([a,b,c]), [a,a,b,b], [a,b,c], Ds). 202 | 203 | multiset_diff(Cmp, Xs0, Ys, Xs) :- 204 | foldl(subtract_element(Cmp), Ys, Xs0, Xs). 205 | 206 | subtract_element(Cmp, Y, Xs0, Xs) :- subtract_first(Xs0, Y, Cmp, Xs). 207 | 208 | subtract_first([], _, _, []). 209 | subtract_first([X|Xs], Y, Cmp, Rs) :- 210 | ( call(Cmp, X, Y, =) -> Rs = Xs 211 | ; Rs = [X|Rest], 212 | subtract_first(Xs, Y, Cmp, Rest) 213 | ). 214 | 215 | mul(Cmp, Ms, Ns, Ord) :- 216 | multiset_diff(Cmp, Ns, Ms, NMs), 217 | multiset_diff(Cmp, Ms, Ns, MNs), 218 | ( NMs == [], MNs == [] -> Ord = (=) 219 | ; forall(member(N, NMs), 220 | ( member(M, MNs), call(Cmp, M, N, >))) -> Ord = (>) 221 | ; Ord = (<) 222 | ). 223 | 224 | /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 225 | Recursive path order with status. 226 | 227 | Stats is a list of pairs [f-mul, g-lex] etc. 228 | - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 229 | 230 | rpo(Fs, Stats, S, T, Ord) :- 231 | ( var(T) -> 232 | ( S == T -> Ord = (=) 233 | ; term_variables(S, Vs), member(V, Vs), V == T -> Ord = (>) 234 | ; Ord = (<) 235 | ) 236 | ; var(S) -> Ord = (<) 237 | ; S =.. [F|Ss], T =.. [G|Ts], 238 | ( forall(member(Si, Ss), rpo(Fs, Stats, Si, T, <)) -> 239 | ord(Fs, F, G, Ord0), 240 | ( Ord0 == (>) -> 241 | ( forall(member(Ti, Ts), rpo(Fs, Stats, S, Ti, >)) -> 242 | Ord = (>) 243 | ; Ord = (<) 244 | ) 245 | ; Ord0 == (=) -> 246 | ( forall(member(Ti, Ts), rpo(Fs, Stats, S, Ti, >)) -> 247 | memberchk(F-Stat, Stats), 248 | call(Stat, rpo(Fs, Stats), Ss, Ts, Ord) 249 | ; Ord = (<) 250 | ) 251 | ; Ord0 == (<) -> Ord = (<) 252 | ) 253 | ; Ord = (>) 254 | ) 255 | ). 256 | 257 | /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 258 | Huet / Knuth-Bendix Completion 259 | - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 260 | 261 | %?- rule_size(f(g(X),y), T). 262 | 263 | rule_size(T, S) :- 264 | ( var(T) -> S #= 1 265 | ; T =.. [_|Args], 266 | foldl(rule_size_, Args, 0, S0), 267 | S #= S0 + 1 268 | ). 269 | 270 | rule_size_(T, S0, S) :- 271 | rule_size(T, TS), 272 | S #= S0 + TS. 273 | 274 | smallest_rule_first(Rs0, Rs) :- 275 | maplist(rule_size, Rs0, Sizes0), 276 | pairs_keys_values(Pairs0, Sizes0, Rs0), 277 | keysort(Pairs0, Pairs), 278 | pairs_keys_values(Pairs, _, Rs). 279 | 280 | %?- smallest_rule_first([f(g(X)) ==> c, f(X) ==> b], Rs). 281 | 282 | orient([], _, Ss, Ss, Rs, Rs). 283 | orient([S0=T0|Es0], Cmp, Ss0, Ss, Rs0, Rs) :- 284 | append(Rs0, Ss0, Rules), 285 | maplist(normal_form(Rules), [S0,T0], [S,T]), 286 | ( S == T -> orient(Es0, Cmp, Ss0, Ss, Rs0, Rs) 287 | ; ( call(Cmp, S, T, >) -> Rule = (S ==> T) 288 | ; call(Cmp, T, S, >) -> Rule = (T ==> S) 289 | ; false /* identity cannot be oriented */ 290 | ), 291 | foldl(simpler(Rule, Rules), Ss0, Es0-[], Es1-Ss1), 292 | foldl(simpler(Rule, Rules), Rs0, Es1-[], Es-Rs1), 293 | orient(Es, Cmp, [Rule|Ss1], Ss, Rs1, Rs) 294 | ). 295 | 296 | simpler(Rule, Rules, L0==>R0, Es0-Us0, Es-Us) :- 297 | normal_form([Rule], L0, L), 298 | ( L0 == L -> 299 | normal_form([Rule|Rules], R0, R), 300 | Es-Us = Es0-[L==>R|Us0] 301 | ; Es-Us = [L=R0|Es0]-Us0 302 | ). 303 | 304 | completion(Es0, Cmp, Ss0, Rs0, Rs) :- 305 | orient(Es0, Cmp, Ss0, Ss1, Rs0, Rs1), 306 | ( Ss1 == [] -> Rs = Rs1 307 | ; smallest_rule_first(Ss1, [R|Ss]), 308 | phrase((critical_pairs_([R], Rs1), 309 | critical_pairs_(Rs1, [R]), 310 | critical_pairs_([R], [R])), CPs), 311 | completion(CPs, Cmp, Ss, [R|Rs1], Rs) 312 | ). 313 | 314 | /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 315 | Try to find a suitable order to create a convergent TRS from 316 | a list of equations. 317 | - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 318 | 319 | equations_trs(Es, Rs) :- 320 | equations_order(Es, Cmp), 321 | equations_trs(Cmp, Es, Rs). 322 | 323 | equations_trs(Cmp, Es, Rs) :- 324 | completion(Es, Cmp, [], [], Rs). 325 | 326 | equations_order(Es, rpo(Sorted,Stats)) :- 327 | equations_functors(Es, Fs), 328 | pairs_keys_values(Stats, Fs, Values), 329 | maplist(ord_status, Values), 330 | permutation(Fs, Sorted). 331 | 332 | ord_status(lex). 333 | ord_status(mul). 334 | 335 | /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 336 | Functors occurring in given equations. 337 | - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 338 | 339 | equations_functors(Eqs, Fs) :- 340 | phrase(eqs_functors_(Eqs), Fs0), 341 | sort(Fs0, Fs). 342 | 343 | eqs_functors_([]) --> []. 344 | eqs_functors_([A=B|Es]) --> 345 | term_functors(A), 346 | term_functors(B), 347 | eqs_functors_(Es). 348 | 349 | term_functors(Var) --> { var(Var) }, !. 350 | term_functors(T) --> 351 | { T =.. [F|Args] }, 352 | [F], 353 | functors_(Args). 354 | 355 | functors_([]) --> []. 356 | functors_([T|Ts]) --> 357 | term_functors(T), 358 | functors_(Ts). 359 | 360 | %?- group(Gs), equations_functors(Gs, Fs). 361 | 362 | %?- group(Gs), equations_trs(Gs, Rs). 363 | 364 | %?- group(Gs), permutation([*,e,i], Ord), equations_trs(rpo(Ord, [(*)-lex,e-lex,i-lex]), Gs, Rs), maplist(portray_clause, Rs). 365 | %?- group(Gs), equations_trs(rpo([*,e,i],[(*)-lex,e-lex,i-lex]), Gs, Rs), maplist(portray_clause, Rs). 366 | 367 | %?- group(Gs), equations_trs(rpo([e,*,i],[(*)-lex,e-lex,i-lex]), Gs, Rs), maplist(portray_clause, Rs), length(Rs, L). 368 | 369 | %?- group(Gs), equations_trs(rpo([*,i,e],[(*)-lex,e-lex,i-lex]), Gs, Rs), maplist(portray_clause, Rs), length(Rs, L). 370 | 371 | /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 372 | Testing 373 | - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 374 | 375 | rules(1, [f(f(X)) ==> g(X)]). 376 | 377 | rules(2, [f(f(X)) ==> f(X), 378 | g(g(X)) ==> f(X)]). 379 | 380 | c(CPs) :- 381 | rules(_, Rules), 382 | critical_pairs(Rules, CPs). 383 | 384 | group([e*X = X, 385 | i(X)*X = e, 386 | A*(B*C) = (A*B)*C]). 387 | 388 | orient(A=B, A==>B). 389 | 390 | %?- critical_pairs([f(X)*Y*Z==>X*Y*Z], Ps). 391 | 392 | %?- critical_pairs([i(X) ==> e, A*B*C ==> (A*B)*C], Ps). 393 | 394 | %?- critical_pairs([A*B*C ==> (A*B)*C], Ps). 395 | 396 | %?- critical_pairs([A*B*D ==> A*B], Ps). 397 | 398 | %?- group(Gs0), maplist(orient, Gs0, Gs), critical_pairs(Gs, Ps), maplist(portray_clause, Ps), length(Ps, L). 399 | 400 | %?- critical_pairs([f(f(X)) ==> a, f(f(X))==>b], Ps). 401 | %?- c(CPs). 402 | %@ CPs = [g(_A)=g(_A),g(f(_B))=f(g(_B))] 403 | %@ ; CPs = [f(_A)=f(_A),f(f(_B))=f(f(_B)),f(_C)=f(_C),f(g(_D))=g(f(_D))]. 404 | 405 | %?- critical_pairs([f(X,a) ==> X, a ==> b], Ps). 406 | 407 | %?- rules(1, Rs), critical_pairs(Rs, Ps). 408 | 409 | %?- critical_pairs([f(X,f(X)) ==> a, f(Y,Y) ==> b], Ps). 410 | 411 | /** 412 | 413 | ?- group(Gs), equations_trs(Gs, Rs). 414 | 415 | ?- group(Gs), equations_order(Gs, Cmp), equations_trs(Cmp, Gs, Rs). 416 | 417 | ?- Es = [X*X = X^2, (X+Y)^2 = X^2 + 2*X*Y + Y^2], 418 | equations_order(Es, Cmp), 419 | call_with_inference_limit(equations_trs(Cmp, Es, Rs), 10000, !). 420 | */ 421 | """ 422 | -------------------------------------------------------------------------------- /prologsolvers/nanocopi.py: -------------------------------------------------------------------------------- 1 | # https://leancop.de/nanocop-i/ 2 | 3 | code = """ 4 | %% File: nanocopi20_swi.pl - Version: 2.0 - Date: 1 May 2021 5 | %% 6 | %% Purpose: nanoCoP-i: A Non-clausal Connection Prover for 7 | %% Intuitionistic First-Order Logic 8 | %% 9 | %% Author: Jens Otten 10 | %% Web: www.leancop.de/nanocop-i/ 11 | %% 12 | %% Usage: prove(F,P). % where F is a first-order formula, e.g. 13 | %% % F=((p,all X:(p=>q(X)))=>all Y:q(Y)) 14 | %% % and P is the returned connection proof 15 | %% 16 | %% Copyright: (c) 2017-2021 by Jens Otten 17 | %% License: GNU General Public License 18 | 19 | :- set_prolog_flag(occurs_check,true). % global occurs check on 20 | 21 | :- dynamic(pathlim/0), dynamic(lit/4). 22 | 23 | % definitions of logical connectives and quantifiers 24 | 25 | :- op(1130,xfy,<=>). :- op(1110,xfy,=>). :- op(500, fy,'~'). 26 | :- op( 500, fy,all). :- op( 500, fy,ex). :- op(500,xfy,:). 27 | 28 | % ----------------------------------------------------------------- 29 | % prove(F,Proof) - prove formula F 30 | 31 | prove(F,Proof) :- prove2(F,[cut,comp(6)],Proof). 32 | 33 | prove2(F,Set,Proof) :- 34 | bmatrix(F,Set,Mat), retractall(lit(_,_,_,_)), 35 | assert_matrix(Mat), prove(Mat,1,Set,Proof). 36 | 37 | % start rule 38 | prove(Mat,PathLim,Set,[(I^0)^V:Proof]) :- 39 | ( member(scut,Set) -> ( append([(I^0)^V^VS:Cla1|_],[!|_],Mat) ; 40 | member((I^0)^V^VS:Cla,Mat), positiveC(Cla,Cla1) ) -> true ; 41 | ( append(MatC,[!|_],Mat) -> member((I^0)^V^VS:Cla1,MatC) ; 42 | member((I^0)^V^VS:Cla,Mat), positiveC(Cla,Cla1) ) ), 43 | prove(Cla1,Mat,[],[I^0],PathLim,[],PreS,VarS,Set,Proof), 44 | append(VarS,VS,VarS1), domain_cond(VarS1), prefix_unify(PreS). 45 | 46 | prove(Mat,PathLim,Set,Proof) :- 47 | retract(pathlim) -> 48 | ( member(comp(PathLim),Set) -> prove(Mat,1,[],Proof) ; 49 | PathLim1 is PathLim+1, prove(Mat,PathLim1,Set,Proof) ) ; 50 | member(comp(_),Set) -> prove(Mat,1,[],Proof). 51 | 52 | % axiom 53 | prove([],_,_,_,_,_,[],[],_,[]). 54 | 55 | % decomposition rule 56 | prove([J^K:Mat1|Cla],MI,Path,PI,PathLim,Lem,PreS,VarS,Set,Proof) :- 57 | !, member(I^V^FV:Cla1,Mat1), 58 | prove(Cla1,MI,Path,[I,J^K|PI],PathLim,Lem,PreS1,VarS1,Set,Proof1), 59 | prove(Cla,MI,Path,PI,PathLim,Lem,PreS2,VarS2,Set,Proof2), 60 | append(PreS2,PreS1,PreS), append(FV,VarS1,VarS3), 61 | append(VarS2,VarS3,VarS), Proof=[J^K:I^V:Proof1|Proof2]. 62 | 63 | % reduction and extension rules 64 | prove([Lit:Pre|Cla],MI,Path,PI,PathLim,Lem,PreS,VarS,Set,Proof) :- 65 | Proof=[Lit:Pre,I^V:[NegLit:PreN|Proof1]|Proof2], 66 | \+ (member(LitC,[Lit:Pre|Cla]), member(LitP,Path), LitC==LitP), 67 | (-NegLit=Lit;-Lit=NegLit) -> 68 | ( member(LitL,Lem), Lit:Pre==LitL, ClaB1=[], Proof1=[], 69 | I=l, V=[], PreN=Pre, PreS3=[], VarS3=[] 70 | ; 71 | member(NegL:PreN,Path), unify_with_occurs_check(NegL,NegLit), 72 | ClaB1=[], Proof1=[], I=r, V=[], 73 | \+ \+ prefix_unify([Pre=PreN]), PreS3=[Pre=PreN], VarS3=[] 74 | ; 75 | lit(NegLit:PreN,ClaB,Cla1,Grnd1), 76 | ( Grnd1=g -> true ; length(Path,K), K true ; 77 | \+ pathlim -> assert(pathlim), fail ), 78 | \+ \+ prefix_unify([Pre=PreN]), 79 | prove_ec(ClaB,Cla1,MI,PI,I^V^FV:ClaB1,MI1), 80 | prove(ClaB1,MI1,[Lit:Pre|Path],[I|PI],PathLim,Lem,PreS1,VarS1, 81 | Set,Proof1), PreS3=[Pre=PreN|PreS1], append(VarS1,FV,VarS3) 82 | ), 83 | ( member(cut,Set) -> ! ; true ), 84 | prove(Cla,MI,Path,PI,PathLim,[Lit:Pre|Lem],PreS2,VarS2,Set,Proof2), 85 | append(PreS3,PreS2,PreS), append(VarS2,VarS3,VarS). 86 | 87 | % extension clause (e-clause) 88 | prove_ec((I^K)^V:ClaB,IV:Cla,MI,PI,ClaB1,MI1) :- 89 | append(MIA,[(I^K1)^V1:Cla1|MIB],MI), length(PI,K), 90 | ( ClaB=[J^K:[ClaB2]|_], member(J^K1,PI), 91 | unify_with_occurs_check(V,V1), Cla=[_:[Cla2|_]|_], 92 | append(ClaD,[J^K1:MI2|ClaE],Cla1), 93 | prove_ec(ClaB2,Cla2,MI2,PI,ClaB1,MI3), 94 | append(ClaD,[J^K1:MI3|ClaE],Cla3), 95 | append(MIA,[(I^K1)^V1:Cla3|MIB],MI1) 96 | ; 97 | (\+member(I^K1,PI);V\==V1) -> 98 | ClaB1=(I^K)^V:ClaB, append(MIA,[IV:Cla|MIB],MI1) ). 99 | 100 | % ----------------------------------------------------------------- 101 | % assert_matrix(Matrix) - write matrix into Prolog's database 102 | 103 | assert_matrix(M) :- 104 | member(IV:C,M), assert_clauses(C,IV:ClaB,ClaB,IV:ClaC,ClaC). 105 | assert_matrix(_). 106 | 107 | assert_clauses(C,ClaB,ClaB1,ClaC,ClaC1) :- !, 108 | append(ClaD,[M|ClaE],C), 109 | ( M=J^K:Mat -> append(MatA,[IV:Cla|MatB],Mat), 110 | append([J^K:[IV:ClaB2]|ClaD],ClaE,ClaB1), 111 | append([IV:ClaC2|MatA],MatB,Mat1), 112 | append([J^K:Mat1|ClaD],ClaE,ClaC1), 113 | assert_clauses(Cla,ClaB,ClaB2,ClaC,ClaC2) 114 | ; append(ClaD,ClaE,ClaB1), ClaC1=C, 115 | (ground(C) -> Grnd=g ; Grnd=n), 116 | assert(lit(M,ClaB,ClaC,Grnd)), fail ). 117 | 118 | % ----------------------------------------------------------------- 119 | % bmatrix(Formula,Set,Matrix) - generate indexed matrix 120 | 121 | bmatrix(F,Set,M) :- 122 | univar(F,[],F1), 123 | ( member(conj,Set), F1=(A=>C) -> 124 | bmatrix(A:[],1,MA,[],[],[],_,1,J,_), 125 | bmatrix(C:[],0,MC,[],[],[],_,J,_,_), ( member(reo(I),Set) -> 126 | reorderC([MA],[_:MA1],I), reorderC([MC],[_:MC1],I) ; 127 | _:MA1=MA, _:MC1=MC ), append(MC1,[!|MA1],M) 128 | ; bmatrix(F1:[],0,M1,[],[],[],_,1,_,_), ( member(reo(I),Set) -> 129 | reorderC([M1],[_:M],I) ; _:M=M1 ) ). 130 | 131 | bmatrix((F1<=>F2):Pre,Pol,M,FreeV,FV,VSet,Paths,I,I1,K) :- !, 132 | bmatrix(((F1=>F2),(F2=>F1)):Pre,Pol,M,FreeV,FV,VSet,Paths,I,I1,K). 133 | 134 | bmatrix((~F):Pre,Pol,M,FreeV,FV,VSet,Paths,I,I1,K) :- !, 135 | ( Pol=0 -> Pr=[I^FreeV1], FV1=FV ; Pr=[V], FV1=[V|FV] ), 136 | Pol1 is (1-Pol), append(Pre,Pr,Pre1), append(FreeV,FV,FreeV1), 137 | I2 is I+1, bmatrix(F:Pre1,Pol1,M,FreeV,FV1,VSet,Paths,I2,I1,K). 138 | 139 | bmatrix(F:Pre,Pol,M,FreeV,FV,VSet,Paths,I,I1,K) :- 140 | F=..[C,X:F1], bma(uni,C,Pol), !, 141 | ( C=all -> append(Pre,[V],Pre1), FV1=[V|FV] ; Pre1=Pre, FV1=FV ), 142 | bmatrix(F1:Pre1,Pol,M,FreeV,[X|FV1],[X:Pre1|VSet],Paths,I,I1,K). 143 | 144 | bmatrix(F:Pre,Pol,M,FreeV,FV,VSet,Paths,I,I1,K) :- 145 | F=..[C,X:F1], bma(exist,C,Pol), !, 146 | ( C=all -> append(Pre,[I^FreeV1],Pre1) ; Pre1=Pre ), 147 | append(FreeV,FV,FreeV1), I2 is I+1, 148 | copy_term((X,F1,FreeV1),((I^FreeV1^Pre1),F2,FreeV1)), 149 | bmatrix(F2:Pre1,Pol,M,FreeV,FV,VSet,Paths,I2,I1,K). 150 | 151 | bmatrix(F:Pre,Pol,J^K:M3,FreeV,FV,VSet,Paths,I,I1,K) :- 152 | F=..[C,F1,F2], bma(alpha,C,Pol,Pol1,Pol2), !, 153 | ( C=(=>) -> append(Pre,[I^FreeV1],Pre1) ; Pre1=Pre ), 154 | append(FreeV,FV,FreeV1), I2 is I+1, 155 | bmatrix(F1:Pre1,Pol1,J^K:M1,FreeV,FV,VSet,Paths1,I2,I3,K), 156 | bmatrix(F2:Pre1,Pol2,_:M2,FreeV,FV,VSet,Paths2,I3,I1,K), 157 | Paths is Paths1*Paths2, 158 | (Paths1>Paths2 -> append(M2,M1,M3) ; append(M1,M2,M3)). 159 | 160 | bmatrix(F:Pre,Pol,I^K:[(I2^K)^FV1^VSet1:C3],FreeV,FV,VSet,Paths,I,I1,K) :- 161 | F=..[C,F1,F2], bma(beta,C,Pol,Pol1,Pol2), !, 162 | ( C=(=>) -> append(Pre,[V],Pre2), FV2=[V|FV] ; Pre2=Pre, FV2=FV ), 163 | ( FV=[] -> FV1=FV2, VSet1=VSet, F3=F1, F4=F2, Pre1=Pre2 ; 164 | copy_term((FV2,VSet,F1,F2,Pre2,FreeV),(FV1,VSet1,F3,F4,Pre1,FreeV)) ), 165 | append(FreeV,FV1,FreeV1), I2 is I+1, I3 is I+2, 166 | bmatrix(F3:Pre1,Pol1,M1,FreeV1,[],[],Paths1,I3,I4,K), 167 | bmatrix(F4:Pre1,Pol2,M2,FreeV1,[],[],Paths2,I4,I1,K), 168 | Paths is Paths1+Paths2, 169 | ( (M1=_:[_^[]^_:C1];[M1]=C1), (M2=_:[_^[]^_:C2];[M2]=C2) -> 170 | (Paths1>Paths2 -> append(C2,C1,C3) ; append(C1,C2,C3)) ). 171 | 172 | bmatrix(A:Pre,0,I^K:[(I2^K)^FV1^VSet1:[A1:Pre1]],FreeV,FV,VSet,1,I,I1,K) :- 173 | !, copy_term((FV,VSet,A,Pre,FreeV),(FV1,VSet1,A1,Pre1,FreeV)), 174 | I2 is I+1, I1 is I+2. 175 | 176 | bmatrix(A:Pre,1,I^K:[(I2^K)^FV1^VSet1:[-A1:(-Pre1)]],FreeV,FV,VSet,1,I,I1,K) :- 177 | copy_term((FV,VSet,A,Pre,FreeV),(FV1,VSet1,A1,Pre1,FreeV)), 178 | I2 is I+1, I1 is I+2. 179 | 180 | bma(alpha,',',1,1,1). bma(alpha,(;),0,0,0). bma(alpha,(=>),0,1,0). 181 | bma(beta,',',0,0,0). bma(beta,(;),1,1,1). bma(beta,(=>),1,0,1). 182 | bma(exist,all,0). bma(exist,ex,1). bma(uni,all,1). bma(uni,ex,0). 183 | 184 | % ----------------------------------------------------------------- 185 | % positiveC(Clause,ClausePos) - generate positive start clause 186 | 187 | positiveC([],[]). 188 | positiveC([M|C],[M3|C2]) :- 189 | ( M=I^K:M1 -> positiveM(M1,M2),M2\=[],M3=I^K:M2 ; -_:_\=M,M3=M ), 190 | positiveC(C,C2). 191 | 192 | positiveM([],[]). 193 | positiveM([I:C|M],M1) :- 194 | ( positiveC(C,C1) -> M1=[I:C1|M2] ; M1=M2 ), positiveM(M,M2). 195 | 196 | % ----------------------------------------------------------------- 197 | % reorderC([Matrix],[MatrixReo],I) - reorder clauses 198 | 199 | reorderC([],[],_). 200 | reorderC([M|C],[M1|C1],I) :- 201 | ( M=J^K:M2 -> reorderM(M2,M3,I), length(M2,L), I1 is I mod (L*L), 202 | mreord(M3,M4,I1), M1=J^K:M4 ; M1=M ), reorderC(C,C1,I). 203 | 204 | reorderM([],[],_). 205 | reorderM([J:C|M],[J:D|M1],I) :- reorderC(C,D,I), reorderM(M,M1,I). 206 | 207 | mreord(M,M,0) :- !. 208 | mreord(M,M1,I) :- 209 | mreord1(M,I,X,Y), append(Y,X,M2), I1 is I-1, mreord(M2,M1,I1). 210 | 211 | mreord1([],_,[],[]). 212 | mreord1([C|M],A,M1,M2) :- 213 | B is 67*A, I is B rem 101, I1 is I mod 2, 214 | ( I1=1 -> M1=[C|X], M2=Y ; M1=X, M2=[C|Y] ), mreord1(M,I,X,Y). 215 | 216 | % ----------------------------------------------------------------- 217 | % prefix_unify(PrefixEquations) - prefix unification 218 | 219 | prefix_unify([]). 220 | prefix_unify([S=T|G]) :- (-S2=S -> T2=T ; -S2=T, T2=S), 221 | flatten([S2,_],S1), flatten(T2,T1), 222 | tunify(S1,[],T1), prefix_unify(G). 223 | 224 | tunify([],[],[]). 225 | tunify([],[],[X|T]) :- tunify([X|T],[],[]). 226 | tunify([X1|S],[],[X2|T]) :- (var(X1) -> (var(X2), X1==X2); 227 | (\+var(X2), unify_with_occurs_check(X1,X2))), 228 | !, tunify(S,[],T). 229 | tunify([C|S],[],[V|T]) :- \+var(C), !, var(V), tunify([V|T],[],[C|S]). 230 | tunify([V|S],Z,[]) :- unify_with_occurs_check(V,Z), tunify(S,[],[]). 231 | tunify([V|S],[],[C1|T]) :- \+var(C1), V=[], tunify(S,[],[C1|T]). 232 | tunify([V|S],Z,[C1,C2|T]) :- \+var(C1), \+var(C2), append(Z,[C1],V1), 233 | unify_with_occurs_check(V,V1), 234 | tunify(S,[],[C2|T]). 235 | tunify([V,X|S],[],[V1|T]) :- var(V1), tunify([V1|T],[V],[X|S]). 236 | tunify([V,X|S],[Z1|Z],[V1|T]) :- var(V1), append([Z1|Z],[Vnew],V2), 237 | unify_with_occurs_check(V,V2), 238 | tunify([V1|T],[Vnew],[X|S]). 239 | tunify([V|S],Z,[X|T]) :- (S=[]; T\=[]; \+var(X)) -> 240 | append(Z,[X],Z1), tunify([V|S],Z1,T). 241 | 242 | % ----------------------------------------------------------------- 243 | % domain_cond(VariableSet) - check domain condition 244 | 245 | domain_cond([]). 246 | domain_cond([X:Pre|VarS]) :- addco(X,Pre), domain_cond(VarS). 247 | 248 | addco(X,_) :- (atomic(X);var(X);X==[[]]), !. 249 | addco(_^_^Pre1,Pre) :- !, prefix_unify([-Pre1=Pre]). 250 | addco(T,Pre) :- T=..[_,T1|T2], addco(T1,Pre), addco(T2,Pre). 251 | 252 | % ---------------------------- 253 | % create unique variable names 254 | 255 | univar(X,_,X) :- (atomic(X);var(X);X==[[]]), !. 256 | univar(F,Q,F1) :- 257 | F=..[A,B|T], ( (A=ex;A=all),B=X:C -> delete2(Q,X,Q1), 258 | copy_term((X,C,Q1),(Y,D,Q1)), univar(D,[Y|Q],E), F1=..[A,Y:E] ; 259 | univar(B,Q,B1), univar(T,Q,T1), F1=..[A,B1|T1] ). 260 | 261 | % delete variable from list 262 | delete2([],_,[]). 263 | delete2([X|T],Y,T1) :- X==Y, !, delete2(T,Y,T1). 264 | delete2([X|T],Y,[X|T1]) :- delete2(T,Y,T1). 265 | 266 | """ 267 | 268 | 269 | # adding tptp support 270 | code += """ 271 | 272 | %% File: nanocop_tptp2.pl - Version: 1.0 - Date: 17 January 2017 273 | %% 274 | %% Purpose: 1. Translate formula from TPTP into leanCoP syntax 275 | %% 2. Add equality axioms to the given formula 276 | %% 277 | %% Author: Jens Otten 278 | %% Web: www.leancop.de/nanocop/ 279 | %% 280 | %% Usage: leancop_tptp2(X,F). % where X is a problem file using TPTP 281 | %% % syntax and F the translated formula 282 | %% leancop_equal(F,G). % where F is a formula and G the 283 | %% % formula with added equality axioms 284 | %% 285 | %% Copyright: (c) 2009-2017 by Jens Otten 286 | %% License: GNU General Public License 287 | 288 | 289 | % definitions of logical connectives and quantifiers 290 | 291 | % leanCoP syntax 292 | :- op(1130, xfy, <=>). % equivalence 293 | :- op(1110, xfy, =>). % implication 294 | % % disjunction (;) 295 | % % conjunction (,) 296 | :- op( 500, fy, ~). % negation 297 | :- op( 500, fy, all). % universal quantifier 298 | :- op( 500, fy, ex). % existential quantifier 299 | :- op( 500,xfy, :). 300 | 301 | % TPTP syntax 302 | :- op(1130, xfy, <~>). % negated equivalence 303 | :- op(1110, xfy, <=). % implication 304 | :- op(1100, xfy, '|'). % disjunction 305 | :- op(1100, xfy, '~|'). % negated disjunction 306 | :- op(1000, xfy, &). % conjunction 307 | :- op(1000, xfy, ~&). % negated conjunction 308 | :- op( 500, fy, !). % universal quantifier 309 | :- op( 500, fy, ?). % existential quantifier 310 | :- op( 400, xfx, =). % equality 311 | :- op( 300, xf, !). % negated equality (for !=) 312 | :- op( 299, fx, $). % for $true/$false 313 | 314 | % TPTP syntax to leanCoP syntax mapping 315 | 316 | op_tptp2((A<=>B),(A1<=>B1), [A,B],[A1,B1]). 317 | op_tptp2((A<~>B),~((A1<=>B1)),[A,B],[A1,B1]). 318 | op_tptp2((A=>B),(A1=>B1), [A,B],[A1,B1]). 319 | op_tptp2((A<=B),(B1=>A1), [A,B],[A1,B1]). 320 | op_tptp2((A|B),(A1;B1), [A,B],[A1,B1]). 321 | op_tptp2((A'~|'B),~((A1;B1)), [A,B],[A1,B1]). 322 | op_tptp2((A&B),(A1,B1), [A,B],[A1,B1]). 323 | op_tptp2((A~&B),~((A1,B1)), [A,B],[A1,B1]). 324 | op_tptp2(~A,~A1,[A],[A1]). 325 | op_tptp2((! [V]:A),(all V:A1), [A],[A1]). 326 | op_tptp2((! [V|Vars]:A),(all V:A1),[! Vars:A],[A1]). 327 | op_tptp2((? [V]:A),(ex V:A1), [A],[A1]). 328 | op_tptp2((? [V|Vars]:A),(ex V:A1), [? Vars:A],[A1]). 329 | op_tptp2($true,(true___=>true___), [],[]). 330 | op_tptp2($false,(false___ , ~ false___),[],[]). 331 | op_tptp2(A=B,~(A1=B),[],[]) :- \+var(A), A=(A1!). 332 | op_tptp2(P,P,[],[]). 333 | 334 | 335 | %%% translate into leanCoP syntax 336 | 337 | leancop_tptp2(File,F) :- leancop_tptp2(File,'',[_],F,_). 338 | 339 | leancop_tptp2(File,AxPath,AxNames,F,Con) :- 340 | open(File,read,Stream), ( fof2cop(Stream,AxPath,AxNames,A,Con) 341 | -> close(Stream) ; close(Stream), fail ), 342 | ( Con=[] -> F=A ; A=[] -> F=Con ; F=(A=>Con) ). 343 | 344 | fof2cop(Stream,AxPath,AxNames,F,Con) :- 345 | read(Stream,Term), 346 | ( Term=end_of_file -> F=[], Con=[] ; 347 | ( Term=..[fof,Name,Type,Fml|_] -> 348 | ( \+member(Name,AxNames) -> true ; fml2cop([Fml],[Fml1]) ), 349 | ( Type=conjecture -> Con=Fml1 ; Con=Con1 ) ; 350 | ( Term=include(File), AxNames2=[_] ; 351 | Term=include(File,AxNames2) ) -> name(AxPath,AL), 352 | name(File,FL), append(AL,FL,AxL), name(AxFile,AxL), 353 | leancop_tptp2(AxFile,'',AxNames2,Fml1,_), Con=Con1 354 | ), fof2cop(Stream,AxPath,AxNames,F1,Con1), 355 | ( Term=..[fof,N,Type|_], (Type=conjecture;\+member(N,AxNames)) 356 | -> (F1=[] -> F=[] ; F=F1) ; (F1=[] -> F=Fml1 ; F=(Fml1,F1)) ) 357 | ). 358 | 359 | fml2cop([],[]). 360 | fml2cop([F|Fml],[F1|Fml1]) :- 361 | op_tptp2(F,F1,FL,FL1) -> fml2cop(FL,FL1), fml2cop(Fml,Fml1). 362 | 363 | 364 | %%% add equality axioms 365 | 366 | leancop_equal(F,F1) :- 367 | collect_predfunc([F],PL,FL), append(PL2,[(=,2)|PL3],PL), 368 | append(PL2,PL3,PL1) -> basic_equal_axioms(F0), 369 | subst_pred_axioms(PL1,F2), (F2=[] -> F3=F0 ; F3=(F0,F2)), 370 | subst_func_axioms(FL,F4), (F4=[] -> F5=F3 ; F5=(F3,F4)), 371 | ( F=(A=>C) -> F1=((F5,A)=>C) ; F1=(F5=>F) ) ; F1=F. 372 | 373 | basic_equal_axioms(F) :- 374 | F=(( all X:(X=X) ), 375 | ( all X:all Y:((X=Y)=>(Y=X)) ), 376 | ( all X:all Y:all Z:(((X=Y),(Y=Z))=>(X=Z)) )). 377 | 378 | % generate substitution axioms 379 | 380 | subst_pred_axioms([],[]). 381 | subst_pred_axioms([(P,I)|PL],F) :- 382 | subst_axiom(A,B,C,D,E,I), subst_pred_axioms(PL,F1), P1=..[P|C], 383 | P2=..[P|D], E=(B,P1=>P2), ( F1=[] -> F=A ; F=(A,F1) ). 384 | 385 | subst_func_axioms([],[]). 386 | subst_func_axioms([(P,I)|FL],F) :- 387 | subst_axiom(A,B,C,D,E,I), subst_func_axioms(FL,F1), P1=..[P|C], 388 | P2=..[P|D], E=(B=>(P1=P2)), ( F1=[] -> F=A ; F=(A,F1) ). 389 | 390 | subst_axiom((all X:all Y:E),(X=Y),[X],[Y],E,1). 391 | subst_axiom(A,B,[X|C],[Y|D],E,I) :- 392 | I>1, I1 is I-1, subst_axiom(A1,B1,C,D,E,I1), 393 | A=(all X:all Y:A1), B=((X=Y),B1). 394 | 395 | % collect predicate & function symbols 396 | 397 | collect_predfunc([],[],[]). 398 | collect_predfunc([F|Fml],PL,FL) :- 399 | ( ( F=..[<=>|F1] ; F=..[=>|F1] ; F=..[;|F1] ; F=..[','|F1] ; 400 | F=..[~|F1] ; (F=..[all,_:F2] ; F=..[ex,_:F2]), F1=[F2] ) -> 401 | collect_predfunc(F1,PL1,FL1) ; F=..[P|Arg], length(Arg,I), 402 | I>0 -> PL1=[(P,I)], collect_func(Arg,FL1) ; PL1=[], FL1=[] ), 403 | collect_predfunc(Fml,PL2,FL2), 404 | union1(PL1,PL2,PL), union1(FL1,FL2,FL). 405 | 406 | collect_func([],[]). 407 | collect_func([F|FunL],FL) :- 408 | ( \+var(F), F=..[F1|Arg], length(Arg,I), I>0 -> 409 | collect_func(Arg,FL1), union1([(F1,I)],FL1,FL2) ; FL2=[] ), 410 | collect_func(FunL,FL3), union1(FL2,FL3,FL). 411 | 412 | union1([],L,L). 413 | union1([H|L1],L2,L3) :- member(H,L2), !, union1(L1,L2,L3). 414 | union1([H|L1],L2,[H|L3]) :- union1(L1,L2,L3). 415 | 416 | """ 417 | -------------------------------------------------------------------------------- /prologsolvers/setlog/size_solver.pl: -------------------------------------------------------------------------------- 1 | %size_solver15 2 | 3 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 4 | % 5 | % Advanced size solver 6 | % 7 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 8 | % 9 | % by Maximiliano Cristia' and Gianfranco Rossi 10 | % January 2020 11 | % 12 | % Revised May 2023 13 | % 14 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 15 | 16 | %size_solver_on. 17 | 18 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 19 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 20 | %%%%%%%%%%%%%%%%%%%%%%%%%% size solver %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 21 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 22 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 23 | 24 | %%%%%%%% SAT solver (by Howe & King) %%%%% 25 | 26 | initialise(_). 27 | 28 | search(Clauses, Vars, Sat, _) :- 29 | sat(Clauses, Vars), 30 | !, 31 | Sat = true. 32 | search(_Clauses, _Vars, false, _). 33 | 34 | sat(Clauses, Vars) :- 35 | problem_setup(Clauses), elim_var(Vars). 36 | 37 | elim_var([]). 38 | elim_var([Var | Vars]) :- 39 | elim_var(Vars), (Var = true; Var = false). 40 | 41 | problem_setup([]). 42 | 43 | problem_setup([Clause | Clauses]) :- 44 | clause_setup(Clause), 45 | problem_setup(Clauses). 46 | 47 | clause_setup([Pol-Var | Pairs]) :- 48 | set_watch(Pairs, Var, Pol). 49 | 50 | set_watch([], Var, Pol) :- Var = Pol. 51 | set_watch([Pol2-Var2 | Pairs], Var1, Pol1) :- 52 | freeze(Var1,V=u), %u is simply a flag 53 | freeze(Var2,V=u), 54 | freeze(V, watch(Var1,Pol1,Var2,Pol2,Pairs)). 55 | 56 | watch(Var1, Pol1, Var2, Pol2, Pairs) :- 57 | nonvar(Var1) -> 58 | update_watch(Var1, Pol1, Var2, Pol2, Pairs); 59 | update_watch(Var2, Pol2, Var1, Pol1, Pairs). 60 | 61 | update_watch(Var1, Pol1, Var2, Pol2, Pairs) :- 62 | Var1 == Pol1 -> true; set_watch(Pairs, Var2, Pol2). 63 | 64 | %%%%%%%% construct and solve the boolean formula %%%%% 65 | 66 | %pi(+F,+Vars,+Neqs,-AdmSol) 67 | pi(F,Vars,_Neqs,AdmSol) :- 68 | bool_code(F,Vars,L), 69 | %DBG write('Boolean formula: \n\t'), write(L),nl,%get(_), 70 | (setof(Vars,sat(L,Vars),Arrs),! ; Arrs=[]), 71 | %DBG write('Boolean solutions: \n\t'),write(Arrs),nl,get(_), 72 | %DBG length(Arrs,LArr),write('Number boolean solutions: '),write(LArr),nl, 73 | powerset(Arrs,AdmSol). 74 | %DBG write('Admissible solution: \n\t'),write(AdmSol),nl,get(_), 75 | 76 | %bool_code(+F,+Vars,-L) 77 | bool_code(F,Vars,L) :- 78 | bool_code_formula(F,Vars,FL), 79 | one_true(Vars,VL), 80 | append(FL,[VL],L). 81 | 82 | bool_code_formula(true,_,[]) :- !. 83 | bool_code_formula((F1 & F),Vars,L) :- 84 | term_variables(F1,F1Vars), 85 | setlog:subset_strong(F1Vars,Vars), 86 | bool_code_constraint(F1,L1),!, 87 | bool_code_formula(F,Vars,L2), 88 | append(L1,L2,L). 89 | bool_code_formula((_F1 & F),Vars,L) :- 90 | bool_code_formula(F,Vars,L). 91 | 92 | bool_code_constraint(un(X,Y,Z),F) :- !, 93 | var(X),var(Y),var(Z), 94 | var_or_false([X,Y,Z],[A2,B2,C2]), 95 | F=[[false-C2,true-B2,true-A2],[false-A2,true-C2],[true-C2,false-B2]]. 96 | bool_code_constraint(disj(X,Y),F) :- !, 97 | var(X),var(Y), 98 | var_or_false([X,Y],[A2,B2]), 99 | F=[[false-A2,false-B2]]. 100 | bool_code_constraint(inters(X,Y,Z),F) :- !, 101 | var(X),var(Y),var(Z), 102 | var_or_false([X,Y,Z],[A2,B2,C2]), 103 | F=[[false-C2,true-A2],[false-C2,true-B2],[false-A2,false-B2,true-C2]]. 104 | bool_code_constraint(subset(X,Y),F) :- !, 105 | var(X),var(Y), 106 | var_or_false([X,Y],[A2,B2]), 107 | F=[[false-A2,true-B2]]. 108 | bool_code_constraint(diff(X,Y,Z),F) :- !, 109 | var(X),var(Y),var(Z), 110 | var_or_false([X,Y,Z],[A2,B2,C2]), 111 | F=[[false-C2,true-A2],[false-C2,false-B2],[false-A2,true-B2,true-C2]]. 112 | 113 | one_true([],[]). 114 | one_true([V|VR],[true-V|VRtrue]) :- 115 | one_true(VR,VRtrue). 116 | 117 | var_or_false([],[]). 118 | var_or_false([X|RX],[V|RV]) :- 119 | (var(X) -> V=X ; V=false), 120 | var_or_false(RX,RV). 121 | 122 | powerset([],[]). 123 | powerset([_H|T],P) :- powerset(T,P). 124 | powerset([H|T],[H|P]) :- powerset(T,P). 125 | 126 | 127 | %%%%%%%% construct and solve the arithmetic formula %%%%% 128 | 129 | mk_arithm_formula(F,SetVars,Sols,R) :- 130 | length(Sols,NSols), 131 | length(ViVars,NSols), 132 | replace_size(F,SetVars,ViVars,Sols,R). 133 | 134 | replace_size(true,_,ViVars,_,R) :- !, 135 | all_positive(ViVars,R). 136 | replace_size((size(S,N) & F2),SetVars,ViVars,Sols,[N is 0|R] ) :- 137 | nonvar(S), S={},!, 138 | replace_size(F2,SetVars,ViVars,Sols,R). 139 | replace_size((size(S,N) & F2),SetVars,ViVars,Sols,[N is Expr|R] ) :- 140 | member_th(S,SetVars,K),!, % search variable S in SetVars and returns its index K 141 | mk_expr(K,Sols,ViVars,Expr), 142 | replace_size(F2,SetVars,ViVars,Sols,R). 143 | replace_size((F1 & F2),SetVars,ViVars,Sols,[F1|R]) :- 144 | F1 = (A neq _B), 145 | attvar(A),!, 146 | replace_size(F2,SetVars,ViVars,Sols,R). 147 | replace_size((F1 & F2),SetVars,ViVars,Sols,[F1|R]) :- 148 | F1 =.. [Op,_,_], 149 | member(Op,[is,=<,<,>=,>,=]),!, 150 | replace_size(F2,SetVars,ViVars,Sols,R). 151 | replace_size((_F1 & F2),SetVars,ViVars,Sols,R) :- 152 | replace_size(F2,SetVars,ViVars,Sols,R). 153 | 154 | mk_expr(_,[],_,0) :-!. 155 | mk_expr(K,[Sol|Sols],[V|Vars],Expr) :- !, 156 | nth1(K,Sol,B), %get the k-th element in Sol and return its value (true/false) in B 157 | (B==true,!,Expr = 1*V + Expr1 158 | ; 159 | B==false,Expr = 0*V + Expr1 160 | ), 161 | mk_expr(K,Sols,Vars,Expr1) . 162 | 163 | member_th(X,[Y|_],1) :- 164 | X==Y,!. 165 | member_th(X,[_Y|R],N) :- 166 | member_th(X,R,M), 167 | N is M + 1. 168 | 169 | all_positive([],[]) :- !. 170 | all_positive([V|Vars],[V > 0|R]) :- 171 | all_positive(Vars,R). 172 | 173 | %%%%%%%% find set variables %%%%% 174 | 175 | find_setvars(F,Vars,Neqs) :- 176 | find_size_neq(F,F,[],SizeVars,NewF,Neqs), 177 | find_vars(NewF,SizeVars,Vars). 178 | 179 | %find_size_neq(+F,+FAll,+Vars,-NewVars,-NewF,-Neqs) (new parameter FAll = the whole formula 180 | find_size_neq(true,_,Vars,Vars,true,[]) :- !. 181 | find_size_neq((size(S,_) & F),FAll,Vars,NewVars,NewF,Neqs) :- 182 | var(S), 183 | setlog:member_strong(S,Vars), !, 184 | find_size_neq(F,FAll,Vars,NewVars,NewF,Neqs). 185 | find_size_neq((size(S,_) & F),FAll,Vars,NewVars,NewF,Neqs) :- 186 | var(S), 187 | member_constraint(S,FAll,V1,_),V1\==[],!, 188 | find_size_neq(F,FAll,[S|Vars],NewVars,NewF,Neqs). 189 | find_size_neq((A neq B & F),FAll,Vars,NewVars,(A neq B & NewF),[A neq B|Neqs]) :- !, 190 | find_size_neq(F,FAll,Vars,NewVars,NewF,Neqs). 191 | find_size_neq((F1 & F),FAll,Vars,NewVars,(F1 & NewF),Neqs) :- !, 192 | find_size_neq(F,FAll,Vars,NewVars,NewF,Neqs). 193 | 194 | find_vars(_F,[],[]) :- !. 195 | find_vars(true,Vars,Vars) :- !. 196 | find_vars(F,[V|Vars],NewVars) :- 197 | member_constraint(V,F,V1,F1), 198 | V1 \== [],!, 199 | cond_append(V1,Vars,Vars1), 200 | find_vars(F1,Vars1,NewVars1), 201 | cond_append(Vars1,NewVars1,NewVars). 202 | find_vars(F,[_V|Vars],NewVars) :- 203 | find_vars(F,Vars,NewVars). 204 | 205 | %member_constraint(+V,+F,-NewV,-NewF) %find all set constraints in F containing variable V and 206 | % %return the new variables (NewV) and the formula without the found constraints 207 | member_constraint(_V,true,[],true) :- !. 208 | member_constraint(V,(un(X,Y,Z) & true),[X,Y,Z],true) :- 209 | one_of(V,X,Y,Z),!. 210 | member_constraint(V,(un(X,Y,Z) & F),[X,Y,Z|NewV],NewF) :- 211 | one_of(V,X,Y,Z),!, 212 | member_constraint(V,F,NewV,NewF). 213 | member_constraint(V,(disj(X,Y) & true),[X,Y],true) :- 214 | one_of(V,X,Y),!. 215 | member_constraint(V,(disj(X,Y) & F),[X,Y|NewV],NewF) :- 216 | one_of(V,X,Y),!, 217 | member_constraint(V,F,NewV,NewF). 218 | member_constraint(V,(subset(X,Y) & true),[X,Y],true) :- 219 | one_of(V,X,Y),!. 220 | member_constraint(V,(subset(X,Y) & F),[X,Y|NewV],NewF) :- 221 | one_of(V,X,Y),!, 222 | member_constraint(V,F,NewV,NewF). 223 | member_constraint(V,(inters(X,Y,Z) & true),[X,Y,Z],true) :- 224 | one_of(V,X,Y,Z),!. 225 | member_constraint(V,(inters(X,Y,Z) & F),[X,Y,Z|NewV],NewF) :- 226 | one_of(V,X,Y,Z),!, 227 | member_constraint(V,F,NewV,NewF). 228 | member_constraint(V,(diff(X,Y,Z) & true),[X,Y,Z],true) :- 229 | one_of(V,X,Y,Z),!. 230 | member_constraint(V,(diff(X,Y,Z) & F),[X,Y,Z|NewV],NewF) :- 231 | one_of(V,X,Y,Z),!, 232 | member_constraint(V,F,NewV,NewF). 233 | member_constraint(V,(X neq Y & true),[X,Y],true) :- 234 | var(Y),!, 235 | (V==X,! ; V==Y). 236 | member_constraint(V,(X neq Y & F),[X,Y|NewV],NewF) :- 237 | var(Y), 238 | one_of(V,X,Y),!, 239 | member_constraint(V,F,NewV,NewF). 240 | member_constraint(V,(F1 & F),NewV,(F1 & NewF)) :- 241 | member_constraint(V,F,NewV,NewF). 242 | 243 | one_of(V,X,_Y,_Z) :- V==X,!. 244 | one_of(V,_X,Y,_Z) :- V==Y,!. 245 | one_of(V,_X,_Y,Z) :- V==Z. 246 | 247 | one_of(V,X,_Y) :- V==X,!. 248 | one_of(V,_X,Y) :- V==Y. 249 | 250 | %cond_append(+L1,+L2,-L3) 251 | cond_append([],Vars,Vars). 252 | cond_append([V|R],Vars,VarsNew) :- 253 | cond_append1(V,Vars,Vars1), 254 | cond_append(R,Vars1,VarsNew). 255 | 256 | cond_append1(V,Vars,Vars) :- 257 | setlog:member_strong(V,Vars),!. 258 | cond_append1(V,Vars,[V|Vars]). 259 | 260 | 261 | %%%%%%%% size_solve %%%%% 262 | 263 | size_solve(true,_,_) :- !. 264 | size_solve(F,SizeVars,MinSol) :- 265 | %DBG write('Input formula: \n\t'),write(F),nl, 266 | find_setvars(F,RVars,Neqs), 267 | reverse(RVars,Vars), 268 | %DBG write('Set variables: '),write(Vars),nl, 269 | size_solve(F,Vars,Neqs,SizeVars,MinSol). 270 | 271 | size_solve(F,SetVars,Neqs,SizeVars,MinSol) :- 272 | % (SetVars\==[] -> 273 | pi(F,SetVars,Neqs,Sols), 274 | %DBG write('Subset of boolean solutions: \n\t'),write(Sols),nl, 275 | mk_arithm_formula(F,SetVars,Sols,ArithmL), 276 | %DBG write('Arithmetic formula 1: \n\t'),write(ArithmL),nl, 277 | solve_Q_all(ArithmL), 278 | %DBG write('Arithmetic formula 2: \n\t'),write(ArithmL),nl, 279 | %DBG write('Sizes: \n\t'),write(AllSizes),nl, 280 | term_variables(ArithmL,IntVars), 281 | %DBG write('Size variables: \n\t'),write(SizeVars),nl, 282 | (SizeVars \== [],!, 283 | mk_sum_to_minimize(SizeVars,Sum) 284 | ; 285 | Sum = 1 286 | ), 287 | %DBG write('Arithmetic variables: \n\t'),write(IntVars),nl, 288 | bb_inf(IntVars,Sum,_,Vertex), 289 | %DBG write('Vertex: \n\t'),write(Vertex),nl, 290 | get_min_sol(SizeVars,IntVars,Vertex,MinSol) 291 | %DBG ,write('Formula: \n\t'),write(F),nl 292 | %DBG ,write('Minimum solution: \n\t'), write(MinSol),nl 293 | . 294 | 295 | %%%%%%%% check size constraints in the constraint list CList %%%%% 296 | 297 | cond_check_size(RedC,Nsize,MinSol) :- 298 | %DBG write('number of size constraints: '),write(Nsize),nl, 299 | (Nsize >= 1 -> 300 | b_getval(int_solver,CurrentSlv), 301 | b_setval(int_solver,clpq), 302 | check_size(RedC,MinSol),!, 303 | b_setval(int_solver,CurrentSlv) 304 | ; 305 | MinSol = [] 306 | ). 307 | 308 | % MinSol_ is the result of binding size variables to constants according 309 | % to the result of minimizing the sum of these variables. Some times, some 310 | % of these variables are bound to constants before the minimization algorithm 311 | % is called. MinSol1 gets the minimal solution returned by the minimization 312 | % algorithm; MinSol2 is equal to MinSol1 except that variables names are 313 | % substituted by those of the original formula; MinSol3 takes care of the 314 | % size variables that are bound to constants before the minimization 315 | % algorithm is called. 316 | check_size(CList,MinSol_) :- 317 | %DBG write('\n****** Input formula: '),nl,write(CList),nl, 318 | get_formula(CList,Formula,SizeV2,IntF,SizeV1,SizeC), 319 | %DBG write('****** Simplified formula: '),nl,write(Formula),flush_output, 320 | %DBG write('****** SizeVars: '),nl,write(SizeVars),nl, 321 | copy_term([Formula,SizeV2,IntF,SizeV1,SizeC],[FormulaNew,SizeV2New,IntFNew,SizeV1New,SizeCNew],_), 322 | %DBG write('****** Simplified formula copied: '),nl,write(FormulaNew),nl,%get(_), 323 | %DBG write('****** SizeVarsNew: '),nl,write(SizeVarsNew),nl, 324 | solve_with_inf_rules(FormulaNew,SizeV1New,IntFNew,SizeCNew), 325 | size_solve(FormulaNew,SizeV2New,MinSol1), 326 | %DBG write('****** MinSol1: '),nl,write(MinSol1),nl, 327 | substitute_vars_minsol(MinSol1,SizeV2New,SizeV2,MinSol2), 328 | %DBG write('****** MinSol2: '),nl,write(MinSol2),nl, 329 | bind_size_vars_not_in_minsol(SizeV2,SizeV2New,MinSol3), 330 | %DBG write('****** MinSol3: '),nl,write(MinSol3),nl, 331 | append(MinSol2,MinSol3,MinSol_) 332 | %DBG ,write('****** MinSolFinal: '),nl,write(MinSol_),nl 333 | . 334 | 335 | % bind_size_vars_not_in_minsol(SizeVars,SizeVarsNew,MinSol) 336 | % Some size variables are bound to values after calling solve_Q_all(ArithmL) 337 | % in size_solve/5. Since the size check is done over a copy of the original 338 | % formula, these variables aren't bound to those values in the orginal 339 | % formula. This might make the minimal not really the minimal one. 340 | % This predicate walks through the list of size variables in the 341 | % original formula (SizeVars) and when in the corresponding position of the 342 | % list of size variables of the copy there's a constant an equality is added 343 | % to MinSol. 344 | bind_size_vars_not_in_minsol([],_,[]) :- !. 345 | bind_size_vars_not_in_minsol([X|SizeVars],[C|SizeVarsNew],MinSol) :- 346 | integer(C),!, 347 | MinSol = [X = C | MinSol_], 348 | bind_size_vars_not_in_minsol(SizeVars,SizeVarsNew,MinSol_). 349 | bind_size_vars_not_in_minsol([_|SizeVars],[_|SizeVarsNew],MinSol) :- 350 | bind_size_vars_not_in_minsol(SizeVars,SizeVarsNew,MinSol). 351 | 352 | % substitute_vars_minsol(MinSol,SizeVarsNew,SizeVars,MinSol_) 353 | % substitutes the variables in MinSol by the corresponding variable in 354 | % SizeVars. The variables in MinSol belong to SizeVarsNew 355 | substitute_vars_minsol([],_,_,[]) :- !. 356 | substitute_vars_minsol([X = C|MinSol],SizeVarsNew,SizeVars,MinSol_) :- 357 | member_th(X,SizeVarsNew,I),!, % X can be a constant in SizeVarsNew 358 | nth1(I,SizeVars,X_), 359 | MinSol_ = [X_ = C|MinSol1], 360 | substitute_vars_minsol(MinSol,SizeVarsNew,SizeVars,MinSol1). 361 | substitute_vars_minsol([_|MinSol],SizeVarsNew,SizeVars,MinSol_) :- 362 | substitute_vars_minsol(MinSol,SizeVarsNew,SizeVars,MinSol_). 363 | 364 | % get_formula(C,F,SV,IF,S) 365 | % C: list of constraints 366 | % F: formula to be solved by Zarba 367 | % SV: list of the second argument of size constraints 368 | % IF: list of integer constraints contained in C 369 | % SS: list of the first argument of size constraints 370 | % S: list of size constraints contained in C 371 | get_formula([],true,[],[],[],[]) :-!. 372 | get_formula([glb_state(C)|R],C & D,SV,[C|I],SS,S) :- !, %add arithmetic constraints (stored in glb_state terms) 373 | get_formula(R,D,SV,I,SS,S). 374 | get_formula([solved(C,_,_)|R],CD,SV,I,SS,S) :- !, 375 | get_formula([C|R],CD,SV,I,SS,S). 376 | get_formula([size(S1,S2)|R],size(S1,S2) & D,[S2|SV],I,[S1|SS],[size(S1,S2)|S]) :- 377 | var(S1),var(S2),!, 378 | get_formula(R,D,SV,I,SS,S). 379 | get_formula([size(S1,S2)|R],size(S1,S2) & D,SV,I,[S1|SS],[size(S1,S2)|S]) :- 380 | var(S1),nonvar(S2),!, 381 | get_formula(R,D,SV,I,SS,S). 382 | get_formula([C|R],C & D,SV,I,SS,S) :- %add set constraints in solved form 383 | solved_set_constraint(C),!, 384 | get_formula(R,D,SV,I,SS,S). 385 | get_formula([X neq Y|R],C & D,SV,[C|I],SS,S) :- 386 | attvar(X),!, 387 | (C = (X > Y) 388 | ; 389 | C = (X < Y) 390 | ), 391 | get_formula(R,D,SV,I,SS,S). 392 | get_formula([subset(S1,int(A,B))|R],D,SV,I,SS,S) :- 393 | var(S1), 394 | open_intv(int(A,B)),!, 395 | nb_setval(subset_int,true), 396 | get_formula(R,D,SV,I,SS,S). 397 | get_formula([_C|R],D,SV,I,SS,S) :- 398 | get_formula(R,D,SV,I,SS,S). 399 | 400 | solved_set_constraint(un(X,Y,Z)) :- !, 401 | var(X),var(Y),var(Z). 402 | solved_set_constraint(subset(X,Y)) :- !, 403 | var(X),var(Y). 404 | solved_set_constraint(disj(X,Y)) :- !, 405 | var(X),var(Y). 406 | solved_set_constraint(inters(X,Y,Z)) :- !, 407 | var(X),var(Y),var(Z). 408 | solved_set_constraint(diff(X,Y,Z)) :- !, 409 | var(X),var(Y),var(Z). 410 | 411 | %%%%% Extra predicates for clpq and clpfd 412 | 413 | solve_Q_all([]). 414 | solve_Q_all([true|ConstrList]) :- 415 | !, 416 | solve_Q_all(ConstrList). 417 | solve_Q_all([C|ConstrList]) :- % solve the constraint 'Constr' using the CLP(Q) solver 418 | solve_Q(C,_), 419 | solve_Q_all(ConstrList). 420 | 421 | % mk_sum_to_minimize(SizeVars,Sum) 422 | % SizeVars = [A,B,C] --> Sum = A+B+C 423 | mk_sum_to_minimize([X],X) :- !. 424 | mk_sum_to_minimize([X|SizeVars],Sum) :- 425 | mk_sum_to_minimize(SizeVars,Sum1), 426 | Sum = X + Sum1. 427 | 428 | % get_min_sol(SizeVars,IntVars,Vertex) 429 | get_min_sol([],_,_,[]) :- !. 430 | get_min_sol([X|SizeVars],IntVars,Vertex,MinSol) :- 431 | var(X),!, 432 | member_th(X,IntVars,I), 433 | nth1(I,Vertex,Vx), 434 | MinSol = [X = Vx|MinSol1], 435 | get_min_sol(SizeVars,IntVars,Vertex,MinSol1). 436 | get_min_sol([_|SizeVars],IntVars,Vertex,MinSol) :- 437 | get_min_sol(SizeVars,IntVars,Vertex,MinSol). 438 | 439 | % inference rules 440 | 441 | solve_with_inf_rules(F,SizeVar,IntF,SizeC) :- 442 | apply_inf_rules(F,SizeVar,SizeC,IntF1), 443 | (IntF1 = [] -> 444 | true 445 | ; 446 | solve_Q_all(IntF), 447 | solve_Q_all(IntF1) 448 | ). 449 | 450 | apply_inf_rules(F,SizeVar,SizeC,IntF) :- 451 | apply_un_irule(F,SizeVar,SizeC,_SizeC1,IntF). 452 | % here apply more inference rules 453 | % append the IntF returned by each rule 454 | % make IntF the result of the append 455 | % use SizeC1 to get the size of set variables 456 | % to which some rule has added a new size constraint 457 | 458 | % apply_un_irule(F,SizeVar,SizeC,SizeC1,IntF) 459 | % F: input formula to the size_solver 460 | % SizeVar: list of the first argument of the size 461 | % constraints contained in F 462 | % SizeC: list of size constraints contained in F 463 | % SizeC1: list of size constraints generated by the 464 | % inference rule 465 | % IntF: the list of integer constraints generated by 466 | % the inference rule 467 | % un(A,B,C) & size(A,Na) --> Nc =< Na + Nb 468 | % where Nc and Nb represent the size of C and B 469 | % apply same rule if of size(A,Na), size(B,Nb) or size(C,Nc) 470 | % are in F 471 | apply_un_irule(F,SizeVar,SizeC,SizeC1,IntF) :- 472 | get_un(F,SizeVar,Un), 473 | (Un == [] -> 474 | true 475 | ; 476 | generate_constraints_un(Un,SizeC,SizeC1,IntF) 477 | ). 478 | 479 | % get_un(F,SV,U) 480 | % U is a list containing all the un-constraints in F 481 | % such that at least one of its arugments belongs to SC 482 | get_un((un(A,B,C) & F),SizeVar,[un(A,B,C)|Un]) :- 483 | (contains_var(A,SizeVar),! 484 | ; 485 | contains_var(B,SizeVar),! 486 | ; 487 | contains_var(C,SizeVar),! 488 | ), 489 | get_un(F,SizeVar,Un). 490 | get_un((_ & F),SizeVar,Un) :- 491 | get_un(F,SizeVar,Un). 492 | get_un(true,_,[]). 493 | 494 | generate_constraints_un([],_,[],[]) :-!. 495 | generate_constraints_un([un(A,B,C)|Un],SizeCons,SizeC1,IntF) :- 496 | get_size(SizeCons,A,Na,Size_A,Int_A), 497 | get_size(SizeCons,B,Nb,Size_B,Int_B), 498 | get_size(SizeCons,C,Nc,Size_C,Int_C), 499 | SizeC2 = [Size_A,Size_B,Size_C|SizeCons], 500 | IntF = [Nc =< Na + Nb,Int_A,Int_B,Int_C|IntF1], 501 | generate_constraints_un(Un,SizeC2,SizeC3,IntF1), 502 | append(SizeC2,SizeC3,SizeC1). 503 | 504 | get_size([],A,N,size(A,N),0 =< N) :- !. 505 | get_size([size(B,M)|_],A,N,true,true) :- 506 | B == A,!, 507 | M = N. 508 | get_size([_|SizeC],A,N,Size,Int) :- 509 | get_size(SizeC,A,N,Size,Int). 510 | 511 | 512 | 513 | 514 | 515 | 516 | 517 | 518 | 519 | 520 | 521 | 522 | 523 | 524 | 525 | 526 | 527 | 528 | 529 | 530 | 531 | 532 | 533 | 534 | 535 | 536 | 537 | 538 | 539 | 540 | 541 | -------------------------------------------------------------------------------- /prologsolvers/setlog/setlog_tc.pl: -------------------------------------------------------------------------------- 1 | % setlog_tc-2.3h4 2 | 3 | 4 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 5 | % 6 | % {log} type-checker 7 | % for version 4.9.8-7g or newer 8 | % 9 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 10 | % 11 | % by Maximiliano Cristia' and Gianfranco Rossi 12 | % January 2021 13 | % 14 | % Revised February 2024 15 | % 16 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 17 | 18 | % interface 19 | % typecheck(F,VN) 20 | % declare_type(Tid,Tdef) 21 | % + user commands 22 | 23 | :- dynamic(type/2). 24 | :- dynamic(cons_type/2). 25 | :- dynamic(enum/1). 26 | :- dynamic(p_type/1). 27 | :- dynamic(pp_type/1). 28 | :- dynamic(pp_type/2). 29 | :- dynamic(typedec/2). 30 | :- dynamic(fintype/1). 31 | :- dynamic(basic/1). 32 | 33 | % typecheck(F,VN) 34 | % F is a formula 35 | % or 36 | % head :- body 37 | % or 38 | % :- body 39 | % where head is a functor followed by its arguments and 40 | % body is a formula 41 | % VN is a list as returned by read_term 42 | % int and str are built-in types 43 | % (i.e. the types of the integer numbers and strings) 44 | % 45 | typecheck(F,VN) :- 46 | retractall(type(_,_)), 47 | typecheck_clause(F,VN),!, 48 | b_setval(vn,VN). % VN is saved for check_finite_types 49 | typecheck(_,_) :- 50 | throw(setlog_excpt('type error')). 51 | 52 | 53 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 54 | % 55 | % typecheck clauses 56 | % 57 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 58 | 59 | % typecheck_clause(C,VN) 60 | % C is the clause to typecheck 61 | % VN are the variable names 62 | % 63 | % In a clause head (i.e. H) all arguments are assumed to be 64 | % variables. Then definitions such as: 65 | % 66 | % p(1,X) :- X = 5. 67 | % 68 | % aren't allowed because the first argument of p must be a variable 69 | % 70 | typecheck_clause((H :- true),VN) :- 71 | H =.. [F|P], F == dec_p_type,!, 72 | (P = [_] -> 73 | declare_p_type(H,VN) 74 | ; 75 | print_type_error_clause2(H,VN) 76 | ). 77 | typecheck_clause((H :- true),VN) :- 78 | H =.. [F|P], F == dec_pp_type,!, 79 | (P = [_] -> 80 | declare_pp_type(H,VN) 81 | ; 82 | print_type_error_clause2(H,VN) 83 | ). 84 | typecheck_clause((H :- true),VN) :- 85 | H =.. [F|P], F == def_type,!, 86 | (P = [I,T], declare_type(I,T) -> 87 | true 88 | ; 89 | print_type_error_dec_type(H,VN) 90 | ). 91 | typecheck_clause((_ :- true),_) :- !. % facts aren't typed 92 | typecheck_clause((:- B),VN) :- !, 93 | typecheck_clause(B,VN). 94 | typecheck_clause((H :- _),_) :- 95 | H =.. [F|_], 96 | member(F,[def_type,dec_p_type,dec_pp_type]),!, % reserved words 97 | print_type_error_clause5(F). 98 | typecheck_clause((H :- B),VN) :- !, 99 | H =.. [F|P], 100 | length(P,A), 101 | functor(H1,F,A), 102 | (p_type(H1) -> % non-polymorphic predicate 103 | H1 =.. [_|P1], 104 | mk_dec(P,P1,D), 105 | setlog:conj_append(D,B,T), 106 | typecheck_clause(T,VN) % now a formula (not a clause) is typechecked 107 | ; 108 | pp_type(H1,V) -> % polymorphic predicate 109 | H1 =.. [_|P1], 110 | get_type_vars(V,VN,TV), 111 | mk_dec(P,P1,D), 112 | maplist(call,TV), 113 | setlog:conj_append(D,B,T), 114 | typecheck_clause(T,VN) % now a formula (not a clause) is typechecked 115 | ; 116 | print_type_error_clause3(H) 117 | ). 118 | typecheck_clause(F,VN) :- % F is a formula, not a clause 119 | assert_vars_types(F,VN), 120 | typecheck_formula(F,VN). 121 | 122 | 123 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 124 | % 125 | % verification of dec constraints 126 | % 127 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 128 | 129 | % checks that each variable in F has exactly one type 130 | % asserts some facts about the types in F 131 | % and makes other consistency checks about types 132 | % 133 | % facts of the form 134 | % type(V,t) 135 | % are interpreted as 136 | % "variable V is of type t" 137 | % facts of the form 138 | % cons_type(u,t) 139 | % are interpreted as 140 | % "term u is of type t" 141 | % u is the constructor of a sum type 142 | % before asserting type(V,t) or cons_type(u,t), t is checked 143 | % for consistency 144 | % 145 | assert_vars_types((C & F),VN) :- 146 | C = dec(V,T), nonvar(V), V = [_|_],!, 147 | assert_vars_types_list(V,T,VN), 148 | assert_vars_types(F,VN). 149 | assert_vars_types((C & F),VN) :- 150 | C = dec(V,T),!, 151 | expand_type(T,Type), % in dec(V,T) T is expanded so dec(V,Type) is done 152 | (var(V),! 153 | ; 154 | print_type_error_dec_1(dec(V,Type),VN) 155 | ), 156 | (check_type(Type),!, 157 | assert_fintype(Type) 158 | ; 159 | print_type_error_dec_2(dec(V,Type),VN) 160 | ), 161 | get_var(VN,V,Var), 162 | (\+ type(Var,_),!, % Var hasn't been declared yet 163 | assertz(type(Var,Type)), 164 | assert_vars_types(F,VN) 165 | ; 166 | print_type_error_dec_3(dec(V,Type),VN) 167 | ). 168 | assert_vars_types((C & F),_) :- 169 | C =.. [F|_], 170 | member(F,[def_type,dec_p_type,dec_pp_type]),!, % reserved words 171 | print_type_error_clause5(F). 172 | assert_vars_types(A,VN) :- 173 | A = dec(V,T), nonvar(V), V = [_|_],!, 174 | assert_vars_types_list(V,T,VN). 175 | assert_vars_types(A,VN) :- 176 | A = dec(V,T),!, 177 | expand_type(T,Type), % in dec(V,T) T is expanded so dec(V,Type) is done 178 | (var(V),! 179 | ; 180 | print_type_error_dec_1(dec(V,Type),VN) 181 | ), 182 | (check_type(Type),!, 183 | assert_fintype(Type) 184 | ; 185 | print_type_error_dec_2(dec(V,Type),VN) 186 | ), 187 | get_var(VN,V,Var), 188 | (\+ type(Var,_),!, % Var hasn't been declared yet 189 | assertz(type(Var,Type)) 190 | ; 191 | print_type_error_dec_3(dec(V,Type),VN) 192 | ). 193 | assert_vars_types(A,_) :- 194 | A =.. [F|_], 195 | member(F,[def_type,dec_p_type,dec_pp_type]),!, % reserved words 196 | print_type_error_clause5(F). 197 | assert_vars_types((_C & F),VN) :- !, 198 | assert_vars_types(F,VN). 199 | assert_vars_types(_A,_). 200 | 201 | assert_vars_types_list([],_,_) :- !. 202 | assert_vars_types_list([X|V],T,VN) :- 203 | assert_vars_types(dec(X,T),VN), 204 | assert_vars_types_list(V,T,VN). 205 | 206 | check_type(T) :- 207 | ground(T), % types can't have variables 208 | check_type1(T). 209 | 210 | check_type1(T) :- 211 | atom(T), typedec(T,_),!. 212 | check_type1(T) :- 213 | T = enum(Enum),!, 214 | check_type(sum(Enum)). 215 | check_type1(T) :- 216 | T = sum(Enum),!, 217 | (enum(Enum) -> % T has already been processed 218 | true 219 | ; 220 | maplist(functor,Enum,H,_), % H = constructors' heads 221 | list_to_set(H,H), % heads can't be repeated 222 | check_sum(Enum), 223 | assertz(enum(Enum)) % asserted to simplify some checks 224 | ). 225 | check_type1(T) :- % product type 226 | T = [T1,T2|T3],!, 227 | check_type1(T1), 228 | check_type1(T2), 229 | (T3 == [] -> 230 | true 231 | ; 232 | T3 = [T4] -> 233 | check_type1(T4) 234 | ; 235 | check_type1(T3) 236 | ). 237 | check_type1(T) :- % set type 238 | T = set(S),!, 239 | check_type1(S). 240 | check_type1(T) :- % rel type, it's just a synonym 241 | T = rel(U,V),!, 242 | check_type1(set([U,V])). 243 | check_type1(int) :- !. 244 | check_type1(str) :- !. 245 | check_type1(T) :- % basic type or built-in type 246 | atom(T), 247 | \+ cons_type(T,_), % T isn't an element of an enum 248 | (basic(T) -> 249 | true 250 | ; 251 | assertz(basic(T)) 252 | ). 253 | 254 | check_sum(Enum) :- 255 | Enum = [_,_|_], % sums have at least 2 elements 256 | forall(member(E,Enum),check_and_assert_sum_element(E,Enum)). 257 | 258 | % (1) and (2) check that E isn't used in other sum 259 | % and if everything goes OK cons_type(E,enum(Enum)) is asserted 260 | % (1) E can't be an element of other sum 261 | % (2) at this point E hasn't be typed so it is. 262 | % Note that if this clause is called it's because Enum 263 | % has never be processed 264 | % 265 | check_and_assert_sum_element(E,Enum) :- 266 | E =.. [H|P], 267 | \+ member(H,[int,str]), % int, str can't be elements of a sum 268 | \+ type(_,H), % H isn't another type (*) 269 | \+ basic(H), 270 | \+ typedec(H,_), % H isn't the id of a typedec 271 | forall(member(X,P),check_type(X)), 272 | (enum(Enum_), % (1) 273 | expand_type(sum(Enum_),sum(Enum2)), 274 | Enum2 \== Enum, 275 | maplist(functor,Enum_,Hs,_), % H = constructors' heads 276 | member(H,Hs),!, 277 | fail 278 | ; 279 | assertz(cons_type(E,sum(Enum))) % (2) 280 | ). 281 | 282 | % assert_fintype(T): if T is a finite type, then assert that fact 283 | assert_fintype(T) :- 284 | has_finite(T),\+clause(fintype(T),true) -> 285 | assertz(fintype(T)) 286 | ; 287 | true. 288 | 289 | 290 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 291 | % 292 | % formula typechecking 293 | % 294 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 295 | 296 | typecheck_formula((C & F),VN) :- !, 297 | typecheck_constraint(C,VN), 298 | typecheck_formula(F,VN). 299 | typecheck_formula(A,VN) :- 300 | typecheck_constraint(A,VN). 301 | 302 | 303 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 304 | % 305 | % constraint typechecking 306 | % 307 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 308 | 309 | % declarations are ignored in this phase 310 | typecheck_constraint(dec(_,_),_) :- !. 311 | 312 | % meta predicates 313 | 314 | typecheck_constraint(neg(P),VN) :- !, 315 | typecheck_clause(P,VN). 316 | 317 | typecheck_constraint((P implies Q),VN) :- !, 318 | typecheck_clause(P,VN), 319 | typecheck_clause(Q,VN). 320 | 321 | typecheck_constraint((P nimplies Q),VN) :- !, 322 | typecheck_clause(P,VN), 323 | typecheck_clause(Q,VN). 324 | 325 | typecheck_constraint((P or Q),VN) :- !, 326 | typecheck_clause(P,VN), 327 | typecheck_clause(Q,VN). 328 | 329 | typecheck_constraint(call(C),VN) :- !, 330 | typecheck_clause(C,VN). 331 | 332 | typecheck_constraint((C)!,VN) :- !, 333 | typecheck_clause(C,VN). 334 | 335 | typecheck_constraint(call(C,_),VN) :- !, 336 | typecheck_clause(C,VN). 337 | 338 | typecheck_constraint(solve(C),VN) :- !, 339 | typecheck_clause(C,VN). 340 | 341 | typecheck_constraint(delay(C,_),VN) :- !, 342 | typecheck_clause(C,VN). 343 | 344 | typecheck_constraint(bool(_,C),VN) :- !, 345 | typecheck_clause(C,VN). 346 | 347 | % calls to Prolog shouldn't be on constraints 348 | typecheck_constraint(prolog_call(_),_) :- !. 349 | 350 | % equality 351 | 352 | % equality is polymorphic 353 | typecheck_constraint(X = Y,VN) :- !, 354 | typecheck_term(X,Tx,VN), 355 | typecheck_term(Y,Ty,VN), 356 | (Tx = Ty,! 357 | ; 358 | print_type_error(X = Y,VN,Tx,Ty) 359 | ). 360 | 361 | typecheck_constraint(X neq Y,VN) :- !, 362 | typecheck_term(X,Tx,VN), 363 | typecheck_term(Y,Ty,VN), 364 | (Tx = Ty,! 365 | ; 366 | print_type_error(X neq Y,VN,Tx,Ty) 367 | ). 368 | 369 | % integer constraints 370 | 371 | typecheck_constraint(integer(X),VN) :- !, 372 | typecheck_term(X,T,VN), 373 | (\+(T == int) -> 374 | print_type_error(integer(X),VN,T) 375 | ; 376 | true 377 | ). 378 | 379 | typecheck_constraint(ninteger(X),VN) :- !, 380 | typecheck_term(X,T,VN), 381 | (T == int -> 382 | print_type_error(ninteger(X),VN,T) 383 | ; 384 | true 385 | ). 386 | 387 | typecheck_constraint(X is Y,VN) :- !, 388 | typecheck_term(X,Tx,VN), 389 | typecheck_term(Y,Ty,VN), 390 | (Tx = int, Ty = int,! 391 | ; 392 | print_type_error(X is Y,VN,Tx,Ty) 393 | ). 394 | 395 | typecheck_constraint(X =:= Y,VN) :- !, 396 | typecheck_term(X,Tx,VN), 397 | typecheck_term(Y,Ty,VN), 398 | (Tx = int, Ty = int,! 399 | ; 400 | print_type_error(X =:= Y,VN,Tx,Ty) 401 | ). 402 | 403 | typecheck_constraint(X =\= Y,VN) :- !, 404 | typecheck_term(X,Tx,VN), 405 | typecheck_term(Y,Ty,VN), 406 | (Tx = int, Ty = int,! 407 | ; 408 | print_type_error(X =\= Y,VN,Tx,Ty) 409 | ). 410 | 411 | typecheck_constraint(X =< Y,VN) :- !, 412 | typecheck_term(X,Tx,VN), 413 | typecheck_term(Y,Ty,VN), 414 | (Tx = int, Ty = int,! 415 | ; 416 | print_type_error(X =< Y,VN,Tx,Ty) 417 | ). 418 | 419 | typecheck_constraint(X < Y,VN) :- !, 420 | typecheck_term(X,Tx,VN), 421 | typecheck_term(Y,Ty,VN), 422 | (Tx = int, Ty = int,! 423 | ; 424 | print_type_error(X < Y,VN,Tx,Ty) 425 | ). 426 | 427 | typecheck_constraint(X >= Y,VN) :- !, 428 | typecheck_term(X,Tx,VN), 429 | typecheck_term(Y,Ty,VN), 430 | (Tx = int, Ty = int,! 431 | ; 432 | print_type_error(X >= Y,VN,Tx,Ty) 433 | ). 434 | 435 | typecheck_constraint(X > Y,VN) :- !, 436 | typecheck_term(X,Tx,VN), 437 | typecheck_term(Y,Ty,VN), 438 | (Tx = int, Ty = int,! 439 | ; 440 | print_type_error(X > Y,VN,Tx,Ty) 441 | ). 442 | 443 | % set constraints 444 | 445 | typecheck_constraint(set(X),VN) :- !, 446 | typecheck_term(X,T,VN), 447 | (\+(T = set(_)) -> 448 | print_type_error(set(X),VN,T) 449 | ; 450 | true 451 | ). 452 | 453 | typecheck_constraint(nset(X),VN) :- !, 454 | typecheck_term(X,T,VN), 455 | (T = set(_) -> 456 | print_type_error(nset(X),VN,T) 457 | ; 458 | true 459 | ). 460 | 461 | typecheck_constraint(X in Y,VN) :- !, 462 | typecheck_term(X,Tx,VN), 463 | typecheck_term(Y,Ty,VN), 464 | (Ty = set(Tx),! 465 | ; 466 | print_type_error(X in Y,VN,Tx,Ty) 467 | ). 468 | 469 | typecheck_constraint(X nin Y,VN) :- !, 470 | typecheck_term(X,Tx,VN), 471 | typecheck_term(Y,Ty,VN), 472 | (Ty = set(Tx),! 473 | ; 474 | print_type_error(X nin Y,VN,Tx,Ty) 475 | ). 476 | 477 | typecheck_constraint(disj(X,Y),VN) :- !, 478 | typecheck_term(X,Tx,VN), 479 | typecheck_term(Y,Ty,VN), 480 | (Tx = set(T), Ty = set(T),! 481 | ; 482 | print_type_error(disj(X,Y),VN,Tx,Ty) 483 | ). 484 | 485 | typecheck_constraint(ndisj(X,Y),VN) :- !, 486 | typecheck_term(X,Tx,VN), 487 | typecheck_term(Y,Ty,VN), 488 | (Tx = set(T), Ty = set(T),! 489 | ; 490 | print_type_error(ndisj(X,Y),VN,Tx,Ty) 491 | ). 492 | 493 | typecheck_constraint(un(X,Y,Z),VN) :- !, 494 | typecheck_term(X,Tx,VN), 495 | typecheck_term(Y,Ty,VN), 496 | typecheck_term(Z,Tz,VN), 497 | (Tx = set(T), Ty = set(T), Tz = set(T),! 498 | ; 499 | print_type_error(un(X,Y,Z),VN,Tx,Ty,Tz) 500 | ). 501 | 502 | typecheck_constraint(nun(X,Y,Z),VN) :- !, 503 | typecheck_term(X,Tx,VN), 504 | typecheck_term(Y,Ty,VN), 505 | typecheck_term(Z,Tz,VN), 506 | (Tx = set(T), Ty = set(T), Tz = set(T),! 507 | ; 508 | print_type_error(nun(X,Y,Z),VN,Tx,Ty,Tz) 509 | ). 510 | 511 | % size 512 | 513 | typecheck_constraint(size(X,Y),VN) :- !, 514 | typecheck_term(X,Tx,VN), 515 | typecheck_term(Y,Ty,VN), 516 | (Tx = set(_), Ty = int,! 517 | ; 518 | print_type_error(size(X,Y),VN,Tx,Ty) 519 | ). 520 | 521 | typecheck_constraint(nsize(X,Y),VN) :- !, 522 | typecheck_term(X,Tx,VN), 523 | typecheck_term(Y,Ty,VN), 524 | (Tx = set(_), Ty = int,! 525 | ; 526 | print_type_error(nsize(X,Y),VN,Tx,Ty) 527 | ). 528 | 529 | % relational constraints 530 | 531 | typecheck_constraint(pair(X),VN) :- !, 532 | typecheck_term(X,T,VN), 533 | (\+(T = [_,_]) -> 534 | print_type_error(pair(X),VN,T) 535 | ; 536 | true 537 | ). 538 | 539 | typecheck_constraint(npair(X),VN) :- !, 540 | typecheck_term(X,T,VN), 541 | (T = [_,_] -> 542 | print_type_error(npair(X),VN,T) 543 | ; 544 | true 545 | ). 546 | 547 | typecheck_constraint(rel(X),VN) :- !, 548 | typecheck_term(X,T,VN), 549 | (\+(T = set([_,_])) -> 550 | print_type_error(rel(X),VN,T) 551 | ; 552 | true 553 | ). 554 | 555 | typecheck_constraint(nrel(X),VN) :- !, 556 | typecheck_term(X,T,VN), 557 | (T = set([_,_]) -> 558 | print_type_error(nrel(X),VN,T) 559 | ; 560 | true 561 | ). 562 | 563 | typecheck_constraint(id(X,Y),VN) :- !, 564 | typecheck_term(X,Tx,VN), 565 | typecheck_term(Y,Ty,VN), 566 | (Tx = set(T), Ty = set([T,T]),! 567 | ; 568 | print_type_error(id(X,Y),VN,Tx,Ty) 569 | ). 570 | 571 | typecheck_constraint(nid(X,Y),VN) :- !, 572 | typecheck_term(X,Tx,VN), 573 | typecheck_term(Y,Ty,VN), 574 | (Tx = set(T), Ty = set([T,T]),! 575 | ; 576 | print_type_error(nid(X,Y),VN,Tx,Ty) 577 | ). 578 | 579 | typecheck_constraint(inv(X,Y),VN) :- !, 580 | typecheck_term(X,Tx,VN), 581 | typecheck_term(Y,Ty,VN), 582 | (Tx = set([T,U]), Ty = set([U,T]),! 583 | ; 584 | print_type_error(inv(X,Y),VN,Tx,Ty) 585 | ). 586 | 587 | typecheck_constraint(ninv(X,Y),VN) :- !, 588 | typecheck_term(X,Tx,VN), 589 | typecheck_term(Y,Ty,VN), 590 | (Tx = set([T,U]), Ty = set([U,T]),! 591 | ; 592 | print_type_error(ninv(X,Y),VN,Tx,Ty) 593 | ). 594 | 595 | typecheck_constraint(comp(X,Y,Z),VN) :- !, 596 | typecheck_term(X,Tx,VN), 597 | typecheck_term(Y,Ty,VN), 598 | typecheck_term(Z,Tz,VN), 599 | (Tx = set([T,U]), Ty = set([U,V]), Tz = set([T,V]),! 600 | ; 601 | print_type_error(comp(X,Y,Z),VN,Tx,Ty,Tz) 602 | ). 603 | 604 | typecheck_constraint(ncomp(X,Y,Z),VN) :- !, 605 | typecheck_term(X,Tx,VN), 606 | typecheck_term(Y,Ty,VN), 607 | typecheck_term(Z,Tz,VN), 608 | (Tx = set([T,U]), Ty = set([U,V]), Tz = set([T,V]),! 609 | ; 610 | print_type_error(ncomp(X,Y,Z),VN,Tx,Ty,Tz) 611 | ). 612 | 613 | % quantifiers and let 614 | 615 | % foreach 616 | 617 | % (1) variables in X and P are local to the foreach. so the same 618 | % names can be used in other foreach's with the same or different 619 | % types. then, after typechecking the inner formula, the type/2 620 | % facts asserted during this process are retracted. in this way if 621 | % the same names are used for local variables in a different 622 | % foreach we don't have a type clash. 623 | typecheck_constraint(foreach(D,F),VN) :- !, 624 | typecheck_constraint(foreach(D,_,F,true),VN). 625 | typecheck_constraint(foreach(X in Y,P,F1,F2),VN) :- !, 626 | mk_ris_formula(X in Y,F1,F2,F), 627 | typecheck_clause(F,VN), 628 | term_variables([X,P],LocVars), 629 | forall(member(A,LocVars),(get_var(VN,A,V),retract(type(V,_)),! ; true)). % (1) 630 | % the second argument is _ because typing information 631 | % about these variables is still to be processed 632 | typecheck_constraint(foreach([X|Y],P,F1,F2),VN) :- !, 633 | setlog:unfold_nested_foreach(foreach([X|Y],P,F1,F2),FEflat), 634 | FEflat = foreach(A in B,P,FEflat1,FEflat2), 635 | FEflat_ = foreach(1 in {},P,FEflat1 & A in B,FEflat2), 636 | typecheck_clause(FEflat_,VN), 637 | term_variables([X,P|Y],LocVars), 638 | forall(member(A,LocVars),(get_var(VN,A,V),retract(type(V,_)),! ; true)). 639 | 640 | % nforeach 641 | 642 | typecheck_constraint(nforeach(X in Y,F),VN) :- !, 643 | typecheck_constraint(foreach(X in Y,[],F,true),VN). 644 | typecheck_constraint(nforeach(X in Y,P,F1,F2),VN) :- !, 645 | typecheck_constraint(foreach(X in Y,P,F1,F2),VN). 646 | 647 | % exists 648 | 649 | % (1) exists calls nforeach with neg(F) 650 | % however, typechecking nforeach and neg(F) 651 | % is the same than typechecking foreach and F 652 | typecheck_constraint(exists(D,F),VN) :- !, 653 | typecheck_constraint(foreach(D,F),VN). % (1) 654 | typecheck_constraint(exists(D,P,F1,F2),VN) :- !, 655 | typecheck_constraint(foreach(D,P,F1,F2),VN). 656 | 657 | % nexists 658 | typecheck_constraint(nexists(D,F),VN) :- !, 659 | typecheck_constraint(foreach(D,F),VN). 660 | typecheck_constraint(nexists(D,P,F1,F2),VN) :- !, 661 | typecheck_constraint(foreach(D,P,F1,F2),VN). 662 | 663 | % let 664 | % typechecking let is similar to typechecking foreach 665 | % (1) variables in P are local to the let. so the same 666 | % names can be used in other constraints with the same or different 667 | % types. then, after typechecking the inner formula, the type/2 668 | % facts asserted during this process are retracted. in this way if 669 | % the same names are used for local variables in a different 670 | % constraint we don't have a type clash. 671 | typecheck_constraint(let(P,D,F),VN) :- !, 672 | mk_ris_formula(1 in {},D,F,NF), % conjoin D with F, 1 in {} is there just for reuse 673 | typecheck_clause(NF,VN), 674 | forall(member(A,P),(get_var(VN,A,V),retract(type(V,_)),! ; true)). % (1) 675 | 676 | % user-defined predicates 677 | 678 | % polymorphic predicates 679 | % a predicate p of arity n is a polymorphic predicate 680 | % if there is an assertion 681 | % pp_type(p(T_1,...,T_n)) 682 | % where each T_i is either a type or a type-variable. 683 | % Each t_i is assumed to be the type of the 684 | % corresponding argument of p. 685 | % For example: 686 | % pp_type(ran(set([_,U]),set(U))) 687 | % 688 | typecheck_constraint(C,VN) :- 689 | C =.. [_|P], 690 | functor(C,F,A), 691 | functor(T,F,A), 692 | pp_type(T),!, % pp_type fact asserted in some consulted file 693 | typecheck_args_pred(T,P,C,VN). 694 | 695 | % non-polymorphic predicates 696 | % a predicate p of arity n is a non-polymorphic predicate 697 | % if there is an assertion: 698 | % p_type(p(t_1,...,t_n)) 699 | % where each t_i is a type. Each t_i is assumed to be 700 | % the type of the corresponding argument of p. 701 | % 702 | typecheck_constraint(C,VN) :- 703 | C =.. [_|P], 704 | functor(C,F,A), 705 | functor(T,F,A), 706 | p_type(T),!, % p_type fact asserted in some loaded file 707 | typecheck_args_pred(T,P,C,VN). 708 | 709 | 710 | % {log} commands and special {log} predicates 711 | 712 | typecheck_constraint(C,_) :- 713 | (meta_pred(C),! 714 | ; 715 | setlog_command(C),! 716 | ; 717 | sys_special(C),! 718 | ; 719 | functor(C,F,N), 720 | sys(F,N) 721 | ), !. 722 | 723 | 724 | % predicates of arity 0 725 | 726 | typecheck_constraint(C,_) :- 727 | functor(C,_,0),!. 728 | 729 | % all the other constraints fail to typecheck 730 | % so typechecking fails 731 | 732 | typecheck_constraint(C,_) :- 733 | print_type_error_clause3(C). 734 | 735 | 736 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 737 | % 738 | % term typechecking 739 | % 740 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 741 | 742 | % a variable (of any type) 743 | typecheck_term(X,T,VN) :- 744 | var(X),var(T),!, 745 | (get_var(VN,X,VarX), type(VarX,T) -> 746 | true 747 | ; 748 | print_type_error_dec_4(X,VN) 749 | ). 750 | typecheck_term(X,T,VN) :- 751 | var(X),!, 752 | (get_var(VN,X,VarX), type(VarX,T1) -> 753 | (T = T1 -> 754 | true 755 | ; 756 | print_type_error_var(X,T1,T,VN) 757 | ) 758 | ; 759 | print_type_error_dec_4(X,VN) 760 | ). 761 | 762 | % integer terms 763 | 764 | typecheck_term(E,int,VN) :- 765 | E = - X,!, 766 | typecheck_term(X,int,VN). 767 | 768 | typecheck_term(E,int,VN) :- 769 | E = X + Y,!, 770 | typecheck_term(X,int,VN), 771 | typecheck_term(Y,int,VN). 772 | 773 | typecheck_term(E,int,VN) :- 774 | E = X - Y,!, 775 | typecheck_term(X,int,VN), 776 | typecheck_term(Y,int,VN). 777 | 778 | typecheck_term(E,int,VN) :- 779 | E = X * Y,!, 780 | typecheck_term(X,int,VN), 781 | typecheck_term(Y,int,VN). 782 | 783 | typecheck_term(E,int,VN) :- 784 | E = X div Y,!, 785 | typecheck_term(X,int,VN), 786 | typecheck_term(Y,int,VN). 787 | 788 | typecheck_term(E,int,VN) :- 789 | E = X mod Y,!, 790 | typecheck_term(X,int,VN), 791 | typecheck_term(Y,int,VN). 792 | 793 | typecheck_term(X,int,_) :- 794 | integer(X),!. 795 | 796 | % set terms 797 | 798 | % extensional 799 | typecheck_term(S,set(T),VN) :- 800 | S = X with Y, !, 801 | typecheck_term(Y,T,VN), 802 | typecheck_term(X,set(T),VN). 803 | typecheck_term(S,set(T),VN) :- 804 | S = {}(A),!, 805 | setnotation_to_list(A,Elems,Rest), 806 | maplist(typecheck_term1(T,VN),Elems), 807 | typecheck_term(Rest,set(T),VN). 808 | 809 | % Cartesian product 810 | typecheck_term(S,set([T,U]),VN) :- 811 | S = cp(X,Y), !, 812 | typecheck_term(X,set(T),VN), 813 | typecheck_term(Y,set(U),VN). 814 | 815 | % integer interval 816 | typecheck_term(S,set(int),VN) :- 817 | S = int(X,Y), !, 818 | typecheck_term(X,int,VN), 819 | typecheck_term(Y,int,VN). 820 | 821 | % ris 822 | % TODO: 823 | % is the following supported? 824 | % allow for general control expressions 825 | % allow for general patterns 826 | 827 | % ris(X in Y, formula) 828 | typecheck_term(S,T,VN) :- 829 | S = ris(X in Y,F),!, 830 | typecheck_term(ris(X in Y,[],F,X,true),T,VN). 831 | % ris(X in Y, [param], formula) 832 | typecheck_term(S,T,VN) :- 833 | S = ris(X in Y,V,F), nonvar(V), V = [_|_],!, 834 | typecheck_term(ris(X in Y,V,F,X,true),T,VN). 835 | % ris(X in Y, formula, pattern) 836 | typecheck_term(S,T,VN) :- 837 | S = ris(X in Y,F,P),!, 838 | typecheck_term(ris(X in Y,[],F,P,true),T,VN). 839 | % ris(X in Y, [parm], formula, pattern) 840 | typecheck_term(S,T,VN) :- 841 | S = ris(X in Y,V,F,P), nonvar(V), V = [_|_],!, 842 | typecheck_term(ris(X in Y,V,F,P,true),T,VN). 843 | % ris(X in Y, [parm], formula, pattern, formula) 844 | typecheck_term(S,set(T),VN) :- 845 | S = ris(X in Y,_,F1,P,F2), 846 | var(P), P == X,!, 847 | mk_ris_formula(X in Y,F1,F2,F), 848 | typecheck_clause(F,VN), 849 | typecheck_term(Y,set(T),VN). 850 | typecheck_term(S,set([T,U]),VN) :- 851 | S = ris(X in Y,_,F1,P,F2), 852 | nonvar(P), P = [P1,P2],!, % var(P1), P1 == X,!, 853 | mk_ris_formula(X in Y,F1,F2,F), 854 | typecheck_clause(F,VN), 855 | typecheck_term(Y,set([T,U]),VN), 856 | typecheck_term(P1,T,VN), 857 | typecheck_term(P2,U,VN). 858 | 859 | % {} is set-polymorphic 860 | typecheck_term(X,set(_),_) :- 861 | X = {},!. 862 | 863 | % ordered pairs / records / lists 864 | 865 | typecheck_term(X,T,VN) :- 866 | X = [X1,X2|X3], 867 | T = [Tx1,Tx2|Tx3],!, 868 | typecheck_term(X1,Tx1,VN), 869 | typecheck_term(X2,Tx2,VN), 870 | (X3 == [] -> 871 | Tx3 = [] 872 | ; 873 | X3 = [X4] -> 874 | Tx3 = [Tx4], 875 | typecheck_term(X4,Tx4,VN) 876 | ; 877 | typecheck_term(X3,Tx3,VN) 878 | ). 879 | 880 | % strings 881 | 882 | typecheck_term(X,str,_) :- 883 | string(X),!. 884 | 885 | % elements of basic types 886 | 887 | % in T:X, T is intended to be a basic type 888 | % and X an atom or an integer. in that case T:X is 889 | % an element of type T. at the type checker level 890 | % t:m = u:m doesn't type check; t:m=t:n type checks 891 | % but at the {log} level t:m and t:n are two different 892 | % terms and so the equality fails, as expected. 893 | % 894 | typecheck_term(T:X,T,VN) :- !, 895 | (atom(T), 896 | (atom(X),! ; integer(X)), 897 | \+ cons_type(T,enum(_)) -> 898 | true 899 | ; 900 | print_type_error_elem_ut(T:X,VN) 901 | ). 902 | 903 | % elements of sums 904 | 905 | typecheck_term(X,T,VN) :- 906 | atom(X),!, % nullary constructors 907 | (cons_type(X,T1) -> 908 | expand_type(T1,T) 909 | ; 910 | print_type_error_atom(X,VN) 911 | ). 912 | 913 | typecheck_term(X,T,VN) :- 914 | functor(X,H,A), % non-nullary constructors 915 | X =.. [H|P], 916 | functor(Y,H,A), 917 | Y =.. [H|PY], 918 | (cons_type(Y,T1) -> 919 | expand_type(T1,T), 920 | maplist(mk_pair,P,PY,LP), 921 | forall(member([Term,Type],LP), 922 | (expand_type(Type,EType),typecheck_term(Term,EType,VN)) 923 | ) 924 | ; 925 | print_type_error_atom(X,VN) 926 | ),!. 927 | 928 | 929 | % here we're sure X isn't of type T 930 | % or X isn't a 'typeable' term 931 | typecheck_term(X,T,VN) :- 932 | print_type_error_term(X,T,VN). 933 | 934 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 935 | % 936 | % type declarations 937 | % 938 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 939 | 940 | % TODO: throw appropriate exceptions 941 | 942 | % (1) Tid can't be the name of a basic type 943 | % it can be a synonym for int or str 944 | declare_type(Tid,Tdef) :- 945 | atom(Tid), 946 | \+ typedec(Tid,_), 947 | ground(Tdef), 948 | (atom(Tdef) -> member(Tdef,[int,str]) ; true), % (1) 949 | \+ contains_term(Tid,Tdef), 950 | check_type(Tdef), 951 | (\+ enum(_),!, 952 | assertz(typedec(Tid,Tdef)) 953 | ; 954 | enum(Enum), 955 | member(Tid,Enum),!, 956 | fail 957 | ; 958 | assertz(typedec(Tid,Tdef)) 959 | ). 960 | 961 | % type declaration of user-defined predicates 962 | 963 | % (1) more than one dec_p_type for the same p 964 | % is a sign of a possible error when they 965 | % are exactly the same 966 | % if the predicate has more than one clause 967 | % one dec_p_type is ok 968 | % note that no exception is risen if there are 969 | % two or more p with different arities or with 970 | % different types (i.e. that kind of polymorphism is ok) 971 | % 972 | declare_p_type(D,VN) :- 973 | D =.. [_,P], 974 | (ground(P) -> 975 | (p_type(P) -> 976 | print_type_error_clause4(P,VN) % (1) 977 | ; 978 | assertz(p_type(P)) 979 | ) 980 | ; 981 | print_type_error_clause1(D,VN) 982 | ). 983 | 984 | % dec_pp_type(D,VN) process a pp declaration 985 | % two facts are stored: 986 | % pp_type/1 which is exactly P in D =.. [_|P] 987 | % pp_type/2 which turns type variables in P into 988 | % constants and stores the constant P and the type 989 | % variable names 990 | % (1) in the case of polymorphic p's more than 991 | % one dec_pp_type for the same p is considered 992 | % an error because the type of polymorphic 993 | % predicates is given in terms of variables 994 | % 995 | declare_pp_type(D,VN) :- 996 | D =.. [_,P], 997 | P =.. [H|A], 998 | length(A,N), 999 | functor(F,H,N), 1000 | (pp_type(F) -> 1001 | print_type_error_clause4(P,VN) % (1) 1002 | ; 1003 | assertz(pp_type(P)) 1004 | ), 1005 | term_variables(D,V), 1006 | maplist(call,VN), % turn type variables into constants 1007 | assertz(pp_type(P,V)). 1008 | 1009 | % only for predicates defined inside {log} 1010 | % (e.g. inters, dres, etc.) 1011 | % (1) enclosed in dec just to comply with dec_pp_type/2's 1012 | % interface. dec_pp_type/2 will remove dec and will 1013 | % take just D 1014 | % 1015 | declare_pp_type(D) :- 1016 | declare_pp_type(dec(D),_), % (1) 1017 | D =.. [H|A], 1018 | length(A,N), 1019 | functor(F,H,N), % pp_type/2 facts aren't used in predicates 1020 | retractall(pp_type(F,_)). % defined inside {log} 1021 | 1022 | 1023 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1024 | % 1025 | % consistency of finite types 1026 | % 1027 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1028 | 1029 | % the following predicates ensure the consistency 1030 | % between type information and constraint solving 1031 | % when finite types are involved 1032 | % 1033 | % inconsistencies may appear when there are too 1034 | % many neq constraints involving variables whose 1035 | % types are finite. for example: 1036 | % dec(X,enum([f,t])) & X neq t & X neq f 1037 | % dec([X,Y,Z],enum([f,t])) & X neq Y & X neq Z & Y neq Z 1038 | % are unsatisfiable when the typing information is 1039 | % considered. 1040 | % 1041 | % the following predicates turn the above formulas 1042 | % into 1043 | % X in {f,t} & X neq t & X neq f 1044 | % X in {f,t} & Y in {f,t} & Z in {f,t} & X neq Y & X neq Z & Y neq Z 1045 | % 1046 | % variable X is a dec variable if there's a 1047 | % dec(X,_) constraint in scope 1048 | % otherwise is a non-dec variable 1049 | % non-dec variable appear for example in dom(F,{1}) 1050 | % because the solution is F = {[1,X]/_} where 1051 | % X is non declared (because is new) 1052 | 1053 | % check_finite_types(CS,F) 1054 | % * CS is the constraint store as passed from {log} 1055 | % * F is the formula (list of constraints) built as 1056 | % to ensure consistency 1057 | % {log} must execute F to check consistency 1058 | % F is empty when there's nothing to check (no neq 1059 | % constraints are in CS or their variables aren't 1060 | % of finite types). 1061 | % 1062 | check_finite_types(CS,F) :- 1063 | (types_ex_vars(CS,EV), 1064 | fintype(_),!, % if finite types in the formula 1065 | b_getval(vn,VN), 1066 | check_finite_types1(CS,VN,EV,[],F) 1067 | ; 1068 | F = [] 1069 | ). 1070 | 1071 | % check_finite_types1(CS,VN,Vars,F) 1072 | % * CS is the constraint store 1073 | % * VN is variable_names as in read_term 1074 | % * Vars is the list of variables participating in 1075 | % neq constraints that have already been processed 1076 | % this is to avoid adding many constraints of the 1077 | % form X in S for each such variable X 1078 | % * F is the formula 1079 | % the predicate goes through CS looking for neq constraints 1080 | % if there's one it checks whether or not its arguments 1081 | % are of a finite type. if not, nothing is done. if they 1082 | % are then a constraint of the form X in T is generated 1083 | % where X is a variable and T is the set corresponding 1084 | % to the type of X. the neq constraints and the 1085 | % corresponding "in" constraints are put in F. 1086 | % 1087 | % TODO: optimization to be done 1088 | % call fintype_to_set only once for each type 1089 | % 1090 | check_finite_types1([],_,_,_,[]) :- !. 1091 | check_finite_types1([C|CS],VN,EV,Vars,F) :- 1092 | is_neq_dec_vars(C,VN,EV,Vars,F0,NewVars),!, 1093 | check_finite_types1(CS,VN,EV,NewVars,F1), 1094 | append(F0,F1,F). 1095 | check_finite_types1([C|CS],VN,EV,Vars,F) :- 1096 | is_neq_new_vars(C,VN,EV,Vars,F0,NewVars),!, 1097 | check_finite_types1(CS,VN,EV,NewVars,F1), 1098 | append(F0,F1,F). 1099 | check_finite_types1([_|CS],VN,EV,Vars,F) :- 1100 | check_finite_types1(CS,VN,EV,Vars,F). 1101 | 1102 | is_neq_dec_vars(C,VN,EV,Vars,F,NewVars) :- 1103 | check_finite_types_two_dec_vars(C,VN,EV,X,Y,T),!, %two variables, at least one a dec variable with a finite type 1104 | mk_neq_in2(Vars,X,Y,T,F,NewVars). 1105 | 1106 | is_neq_dec_vars(C,VN,EV,Vars,F,NewVars) :- 1107 | check_finite_types_dec_var_const(C,VN,EV,X,Y,T),!, %one dec variable with a finite type, one constant 1108 | mk_neq_in(Vars,X,Y,T,F,NewVars). % mk_neq_in builds F and NewVars 1109 | 1110 | is_neq_new_vars(C,VN,EV,Vars,F,NewVars) :- 1111 | is_neq(C,_,X,Y), 1112 | var(X),nonvar(Y),!, % one variable, one constant 1113 | \+get_var(VN,X,_), \+get_type(EV,X,_), % X is a new variable, we don't know its type 1114 | (Y == {},!, % Y is the empty set 1115 | F = [X neq Y], 1116 | NewVars = Vars 1117 | ; 1118 | ground(Y), % Y is a constant 1119 | typecheck_term(Y,T,VN), % get Y's type; VN shouldn't be necessary (1) 1120 | has_finite(T), 1121 | mk_neq_in(Vars,X,Y,T,F,NewVars) % mk_neq_in builds F and NewVars 1122 | ). 1123 | is_neq_new_vars(C,VN,EV,Vars,F,NewVars) :- 1124 | is_neq(C,_,X,Y), 1125 | var(X),var(Y), % two variables 1126 | \+get_var(VN,X,_), \+get_type(EV,X,_), % X is a new variable 1127 | \+get_var(VN,Y,_), \+get_type(EV,Y,_), % Y is a new variable 1128 | find_var(X,VN,Z = Term), 1129 | type(Z,T), % Z is a dec var, then it has a type 1130 | get_type_from_term(X,Term,T,Tx), 1131 | has_finite(Tx), 1132 | mk_neq_in2(Vars,X,Y,Tx,F,NewVars). 1133 | 1134 | mk_neq_in(Vars,X,Y,T,F,NewVars) :- 1135 | (\+setlog:member_strong(X,Vars),!, 1136 | fintype_to_set(T,L), 1137 | setlog:mk_set(L,S), 1138 | F = [X neq Y,X in S], 1139 | NewVars = [X|Vars] 1140 | ; 1141 | F = [X neq Y], 1142 | NewVars = [X|Vars] 1143 | ). 1144 | 1145 | % mk_neq_in2 is similar to mk_neq_in 1146 | % TODO: check if mk_neq_in2 is enough and mk_neq_in 1147 | % can be deleted 1148 | % 1149 | mk_neq_in2(Vars,X,Y,T,F,NewVars) :- 1150 | (\+setlog:member_strong(X,Vars), 1151 | \+setlog:member_strong(Y,Vars),!, 1152 | fintype_to_set(T,L), 1153 | setlog:mk_set(L,S), 1154 | F = [X neq Y,X in S,Y in S], 1155 | NewVars = [X,Y|Vars] 1156 | ; 1157 | \+setlog:member_strong(X,Vars),!, 1158 | fintype_to_set(T,L), 1159 | setlog:mk_set(L,S), 1160 | F = [X neq Y,X in S], 1161 | NewVars = [X|Vars] 1162 | ; 1163 | \+setlog:member_strong(Y,Vars),!, 1164 | fintype_to_set(T,L), 1165 | setlog:mk_set(L,S), 1166 | F = [X neq Y,Y in S], 1167 | NewVars = [Y|Vars] 1168 | ; 1169 | F = [X neq Y], 1170 | NewVars = Vars 1171 | ). 1172 | 1173 | check_finite_types_two_dec_vars(C,VN,EV,X,Y,T) :- 1174 | is_neq(C,_,X,Y), 1175 | var(X),var(Y), % two variables 1176 | (get_var(VN,X,Vx),!, % X is dec variable and its name is Vx 1177 | type(Vx,T), % the type of Vx (i.e. X) is T, so is Vy's 1178 | fintype(T) % T is a finite type 1179 | ; % or 1180 | get_var(VN,Y,Vy),!, % Y is a dec variable and its name is Vy 1181 | type(Vy,T), % the type of Vy (i.e. Y) is T, so is Vx's 1182 | fintype(T) % T is a finite type 1183 | ; % or 1184 | get_type(EV,X,T),! % X is a dec variable, T is its (finite) type 1185 | ; % or 1186 | get_type(EV,Y,T) % Y is a dec variable, T is its (finite) type 1187 | ). 1188 | 1189 | check_finite_types_dec_var_const(C,VN,EV,X,Y,T) :- 1190 | is_neq(C,_,X,Y), 1191 | var(X),ground(Y), % one variable, one constant 1192 | (get_var(VN,X,V),!, % X is a dec variable and its name is V 1193 | type(V,T), % the type of X is T 1194 | fintype(T) % T is a finite type 1195 | ; 1196 | get_type(EV,X,T) % X is a dec variable, T is its (finite) type 1197 | ). 1198 | 1199 | % types_ex_vars(CS,EV) 1200 | % goes through the constraint store CS looking for 1201 | % dec constraints. this is necessary when user-defined 1202 | % predicates contain existential variables. typing of 1203 | % these variables has been checked when the predicate 1204 | % was consulted but this information was lost after 1205 | % that. so in order to check finite type consistency 1206 | % we need to reconstruct that information. this is a 1207 | % price to pay if types are checked only at consult 1208 | % time. EV is a list of pairs [V,T] where V is a 1209 | % variable in a dec and T is a finite type. 1210 | % 1211 | types_ex_vars([],[]) :- !. 1212 | types_ex_vars([dec(V,T)|CS],EV) :- 1213 | expand_type(T,Type), 1214 | (clause(fintype(Type),true) -> 1215 | true 1216 | ; 1217 | has_finite(Type), 1218 | assertz(fintype(Type)), 1219 | (Type = enum(Enum) -> 1220 | check_sum(Enum) 1221 | ; 1222 | true 1223 | ) 1224 | ),!, 1225 | mk_list_types(V,Type,V_EV), 1226 | types_ex_vars(CS,EV1), 1227 | append(V_EV,EV1,EV). 1228 | types_ex_vars([_|CS],EV) :- 1229 | types_ex_vars(CS,EV). 1230 | 1231 | mk_list_types(V,T,EV) :- 1232 | var(V),!, 1233 | EV = [[V,T]]. 1234 | mk_list_types([],_,[]) :- !. 1235 | mk_list_types(L,T,EV) :- 1236 | L = [V|Vars],!, 1237 | (var(V),!, 1238 | EV = [[V,T]|EV1], 1239 | mk_list_types(Vars,T,EV1) 1240 | ; 1241 | mk_list_types(Vars,T,EV) 1242 | ). 1243 | mk_list_types(_,_,[]). 1244 | 1245 | % get_type(EV,X,T) 1246 | % * EV is the list returned by types_ex_vars 1247 | % * X is a variable 1248 | % * T is the type of X according to EV 1249 | % if X is not the first component of any pair in EV 1250 | % get_type fails 1251 | % 1252 | get_type([[V,T]|_],X,T) :- 1253 | V == X,!. 1254 | get_type([[_,_]|DEC],X,T) :- 1255 | get_type(DEC,X,T). 1256 | 1257 | 1258 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1259 | % 1260 | % grounding -- generation of typed constants 1261 | % 1262 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1263 | 1264 | % gen_typed_eq(NonIntVar,NeqConst,VN,L,N,EqOther) 1265 | % - NonIntVar list of variables for which a value has 1266 | % to be generated 1267 | % - NeqConst list of constants which the generated 1268 | % constants can't belong to 1269 | % - VN variable names as in read_term 1270 | % - L label (letter) to be used as a prefix for some 1271 | % constants 1272 | % - N start number to label some constants 1273 | % - EqOther list of X = t or X in S (t and S ground) 1274 | % this predicate generates the constants to be bound 1275 | % to the variables in NonIntVar. 1276 | % the constants generated by gen_typed_eq have the 1277 | % following form: 1278 | % - int -> 0,1,-1,2,-2,... 1279 | % - str -> n0, n1, n2,.... 1280 | % - basic type t -> t:n0, t:n1, t:n2,... 1281 | % - sum types -> nullary constructs -> themselves 1282 | % non-nullary construct x(T) -> x(c) where c:T 1283 | % - product type [T,U] -> [ct,cu] where ct:T and cu:U 1284 | % - set type set(T) -> {c} where c:T 1285 | % 1286 | %(the next numbers refer to the code of gen_typed_eq/6) 1287 | % (1) this is different from the untyped case due 1288 | % to the presence of finite types. we can't 1289 | % just generate a different constant for 1290 | % each variable of a finite type because 1291 | % there might not be enough of them. 1292 | % ex: dec([X,Y,Z],enum([a,b])) & X neq Y & X neq Z. 1293 | % we can't generate three different values 1294 | % for X, Y and Z. we have two chose the same 1295 | % value for two of them. however, 1296 | % at this point we know the formula is 1297 | % satisfiable because check_finite_types has 1298 | % been called, so there are enough values of 1299 | % type T as to satisfy the formula. then for 1300 | % this case we generate set membership 1301 | % constraints for each variable of type T. 1302 | % the solver will assign a value to each 1303 | % variable. 1304 | % (2) this can be improved. T is converted once 1305 | % for each variable of type T. actually, S 1306 | % has been computed a few processing steps 1307 | % before when check_finite_types was called. 1308 | % (3) the constant for the next variable will be 1309 | % different from the constants for the 1310 | % previous variables because there might be 1311 | % neq constraints involving the variables in 1312 | % NonIntVar. 1313 | gen_typed_eq([],_,_,_,_,[]) :- !. 1314 | gen_typed_eq([X|NonIntVar],NeqConst,VN,L,N,EqOther) :- 1315 | get_var(VN,X,V),!, % X is a dec variable 1316 | type(V,T), 1317 | (is_finite(T) -> % (1) 1318 | fintype_to_set(T,TL), % (2) 1319 | setlog:mk_set(TL,S), 1320 | N1 is N + 1, 1321 | gen_typed_eq(NonIntVar,NeqConst,VN,L,N1,EqOther1), 1322 | EqOther = [X in S | EqOther1] 1323 | ; 1324 | gen_typed_val(T,L,N,Val), % T is infinite 1325 | (member(Val,NeqConst) -> % increase N until a valid constant is found 1326 | N1 is N + 1, 1327 | gen_typed_eq([X|NonIntVar],NeqConst,VN,L,N1,EqOther) 1328 | ; 1329 | N1 is N + 1, % (3) 1330 | gen_typed_eq(NonIntVar,NeqConst,VN,L,N1,EqOther1), 1331 | EqOther = [X = Val | EqOther1] 1332 | ) 1333 | ). 1334 | % (1) X isn't a dec variable so is part of the r.h.s. 1335 | % of an equality in VN 1336 | % (2) TODO: this part until the end is equal to the 1337 | % previous clause. it can/should be put in one new 1338 | % predicate. 1339 | gen_typed_eq([X|NonIntVar],NeqConst,VN,L,N,EqOther) :- 1340 | find_var(X,VN,Z = Term), % (1) 1341 | type(Z,T), % Z is a dec var, then it has a type 1342 | get_type_from_term(X,Term,T,Tx), 1343 | (is_finite(Tx) -> % (2) 1344 | fintype_to_set(Tx,TL), 1345 | setlog:mk_set(TL,S), 1346 | N1 is N + 1, 1347 | gen_typed_eq(NonIntVar,NeqConst,VN,L,N1,EqOther1), 1348 | EqOther = [X in S | EqOther1] 1349 | ; 1350 | gen_typed_val(Tx,L,N,Val), 1351 | (member(Val,NeqConst) -> 1352 | N1 is N + 1, 1353 | gen_typed_eq([X|NonIntVar],NeqConst,VN,L,N1,EqOther) 1354 | ; 1355 | N1 is N + 1, 1356 | gen_typed_eq(NonIntVar,NeqConst,VN,L,N1,EqOther1), 1357 | EqOther = [X = Val | EqOther1] 1358 | ) 1359 | ). 1360 | 1361 | % gen_typed_val(T,L,N,Val) 1362 | % - T is a type 1363 | % - L label (letter) to be used as a prefix for some 1364 | % constants 1365 | % - N number to label some constants 1366 | % - Val is the generated constant 1367 | % only non-recursive types are considered because 1368 | % if the term is an ordered pair, we generate a 1369 | % value for each of its components; if the term 1370 | % is a set, we generate a value for each of its 1371 | % elements. however, if the type is a sum such 1372 | % that one of its constructors has an argument 1373 | % of a set or product type then we need to 1374 | % generate values for that type too. 1375 | % 1376 | % values of basic types 1377 | gen_typed_val(T,L,N,CT) :- 1378 | atom(T), 1379 | \+member(T,[int,str]),!, 1380 | atomic_list_concat([T,:,L,N],C), 1381 | atom_to_term(C,CT,_). 1382 | % values of type int 1383 | gen_typed_val(int,_,N,N) :- !. 1384 | % values of type str 1385 | gen_typed_val(str,L,N,S) :- 1386 | atomic_list_concat([L,N],C), 1387 | atom_string(C,S),!. 1388 | % values of sum types 1389 | % if the constructors of the sum type are exhausted 1390 | % then no value for that type can be generated and 1391 | % so the formula would be unsatisfiable but at this 1392 | % point we know the formula is satisfiable. so the 1393 | % case sum([_|_]) is the only to be considered. 1394 | % 1395 | % first we try to find an infinite constructor. 1396 | % if we do, we use these values because there 1397 | % are infinitely many of them. 1398 | % if we don't, the sum type is finite and so it 1399 | % must be one of the components of a product 1400 | % type where the other component must be infinite 1401 | % because otherwise the whole type would be 1402 | % finite and so the first branch of gen_typed_eq 1403 | % would have been executed. 1404 | % 1405 | % no infinite constructor has been found so we 1406 | % use the last one (which might be infinite) 1407 | % TODO: the first and last clauses are equal 1408 | gen_typed_val(sum([C]),L,N,Val) :- 1409 | C =.. [H|P], 1410 | gen_typed_val_list(P,L,N,PVal), 1411 | Val1 =.. [H|PVal], 1412 | Val = Val1. 1413 | % try to find an infinite constructor 1414 | gen_typed_val(sum([C|Cons]),L,N,Val) :- 1415 | C =.. [_|P], 1416 | is_finite(P),!, % P is a product type 1417 | gen_typed_val(sum(Cons),L,N,Val). 1418 | % an infinite constructor has been found 1419 | gen_typed_val(sum([C|_]),L,N,Val) :- 1420 | C =.. [H|P], 1421 | gen_typed_val_list(P,L,N,PVal), 1422 | Val1 =.. [H|PVal], 1423 | Val = Val1. 1424 | % 1425 | % the following two clauses are used when a 1426 | % constructor of a sum type depends on a product 1427 | % or set type. 1428 | % 1429 | % note that only singleton sets are returned. 1430 | % the justification is as follows. set(T) is 1431 | % part of a constructor of a sum type. if the 1432 | % sum type is finite then it's part of a 1433 | % infinite product type (otherwise the whole 1434 | % type would be finite and so the first 1435 | % branch of gen_typed_eq would have been 1436 | % executed), so we can generate infinite 1437 | % constants of the product type by using 1438 | % the other component. otherwise the sum type 1439 | % is infinite. so either T is infinite or 1440 | % there's another infinite constructor in the 1441 | % sum type. in either case we can generate 1442 | % infinitely many constants (e.g. infinitely 1443 | % many singleton sets of type T). 1444 | % 1445 | gen_typed_val(set(T),L,N,Val) :- !, 1446 | gen_typed_val(T,L,N,Val1), 1447 | Val = {} with Val1. 1448 | gen_typed_val([T,U],L,N,Val) :- 1449 | gen_typed_val(T,L,N,Val1), 1450 | gen_typed_val(U,L,N,Val2), 1451 | Val = [Val1,Val2]. 1452 | 1453 | % gen_typed_val_list(TypeL,L,N,ValL) 1454 | gen_typed_val_list([],_,_,[]) :- !. 1455 | gen_typed_val_list([T|TypeL],L,N,ValL) :- 1456 | gen_typed_val(T,L,N,Val), 1457 | gen_typed_val_list(TypeL,L,N,ValL1), 1458 | ValL = [Val | ValL1]. 1459 | 1460 | 1461 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1462 | % 1463 | % user commands 1464 | % 1465 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1466 | 1467 | setlog_command(idef_type(_,_)) :- !. 1468 | setlog_command(reset_types) :- !. 1469 | setlog_command(type_of(_)) :- !. 1470 | setlog_command(type_decs(_)) :- !. 1471 | setlog_command(expand_type(_,_)) :- !. 1472 | 1473 | ssolve_command(idef_type(ID,T)) :- !, %% declare or consult a type 1474 | dec_type(ID,T). 1475 | ssolve_command(reset_types) :- !, %% delete all type declarations since 1476 | reset_types. 1477 | ssolve_command(type_of(P)) :- !, %% prints the type of predicate P 1478 | type_of(P). 1479 | ssolve_command(type_decs(T)) :- !, %% lists all type declarations 1480 | type_decs(T). 1481 | ssolve_command(expand_type(T,ET)) :- !, %% expands type T in ET 1482 | expand_type(T,ET). 1483 | 1484 | dec_type(I,T) :- 1485 | nonvar(T),!, 1486 | declare_type(I,T). 1487 | dec_type(I,T) :- 1488 | atom(I),!, 1489 | (typedec(I,T) -> 1490 | true 1491 | ; 1492 | print_type_error_dec_type(I) 1493 | ). 1494 | 1495 | reset_types :- 1496 | retractall(type(_,_)), 1497 | retractall(cons_type(_,_)), 1498 | retractall(enum(_)), 1499 | retractall(p_type(_)), 1500 | retractall(pp_type(_)), 1501 | retractall(pp_type(_,_)), 1502 | retractall(typedec(_,_)), 1503 | retractall(fintype(_)), 1504 | retractall(basic(_)), 1505 | dec_internal. 1506 | 1507 | type_of(P) :- 1508 | atom(P),!, 1509 | current_functor(P,A), 1510 | functor(F,P,A), 1511 | nl, 1512 | (p_type(F) -> 1513 | write(F) 1514 | ; 1515 | pp_type(F) -> 1516 | numbervars(F,19,_), 1517 | write(F) 1518 | ; 1519 | print_type_error_clause3(F) 1520 | ), 1521 | nl. 1522 | 1523 | type_decs(T) :- 1524 | (T == td -> 1525 | listing(typedec(_,_)) 1526 | ; 1527 | T == pt -> 1528 | listing(p_type(_)) 1529 | ; 1530 | T == ppt -> 1531 | listing(pp_type(_)) 1532 | ; 1533 | throw(setlog_excpt("possible arguments are td, pt or ppt")) 1534 | ). 1535 | 1536 | 1537 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1538 | % 1539 | % initialization 1540 | % 1541 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1542 | 1543 | % retract all type facts of previous runs of the 1544 | % typechecker. 1545 | % load the type definitions of defined constraints 1546 | % implemented inside {log} (e.g. inters, dom, etc.) 1547 | 1548 | :- initialization(reset_types). 1549 | 1550 | 1551 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1552 | % 1553 | % auxiliary predicates 1554 | % 1555 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1556 | 1557 | % get_var(VN,V,X) 1558 | % VN is variable_names as in read_term 1559 | % V is a variable 1560 | % X = inv(VN)(V) 1561 | % 1562 | get_var([],_,_) :- !, fail. 1563 | get_var([X = Y|_],V,Var) :- 1564 | Y == V,!, 1565 | Var = X. 1566 | get_var([_ = Y|VN],V,Var) :- 1567 | \+(Y == V), 1568 | get_var(VN,V,Var). 1569 | 1570 | % get_type_vars(V,VN,TV) 1571 | % V is a list of the form ['X','Y','Z',...] 1572 | % VN is variable_names as in read_term 1573 | % dres(V,VN,TV) 1574 | % 1575 | get_type_vars([],_,[]) :- !. 1576 | get_type_vars([X|V],VN,TV) :- 1577 | get_type_vars1(X,VN,E) -> 1578 | TV = [E|TV1], 1579 | get_type_vars(V,VN,TV1) 1580 | ; 1581 | get_type_vars(V,VN,TV). 1582 | 1583 | get_type_vars1(X,[X1 = Y|VN],E) :- 1584 | X == X1 -> 1585 | E = (X = Y) 1586 | ; 1587 | get_type_vars1(X,VN,E). 1588 | 1589 | % mk_dec(V,T,D) 1590 | % V = [V_1,...,V_n], T = [T_1,...,T_n] 1591 | % ==> D = dec(V_1,T_1) & ... & dev(V_n,T_n) 1592 | % if V_i is twice only one dec is conjoined 1593 | % TODO: implement with maplist? 1594 | % 1595 | mk_dec([],[],true) :- !. 1596 | mk_dec([V|Vars],[_|Types],Conj) :- 1597 | setlog:member_strong(V,Vars),!, 1598 | mk_dec(Vars,Types,Conj). 1599 | mk_dec([V|Vars],[T|Types],dec(V,T) & D) :- 1600 | mk_dec(Vars,Types,D). 1601 | 1602 | mk_ris_formula(F1,F2,F3,F) :- 1603 | setlog:conj_append(F1,F2,G), 1604 | setlog:conj_append(G,F3,F). 1605 | 1606 | typecheck_args_pred(Pred,Args,C,VN) :- 1607 | Pred =.. [_|DTypes], 1608 | length(DTypes,N), 1609 | length(ExpTypes,N), 1610 | maplist(expand_type,DTypes,ExpTypes), 1611 | (typecheck_args_pred1(Args,ATypes,VN) -> 1612 | (ExpTypes = ATypes -> 1613 | true 1614 | ; 1615 | print_type_error_defcons1(C,ATypes,Pred,VN) 1616 | ) 1617 | ; 1618 | print_type_error_defcons2(C,VN) 1619 | ). 1620 | 1621 | typecheck_args_pred1([],[],_) :- !. 1622 | typecheck_args_pred1([X|P],ATypes,VN) :- 1623 | typecheck_term(X,Tx,VN), 1624 | expand_type(Tx,ETx), 1625 | ATypes = [ETx|Types], 1626 | typecheck_args_pred1(P,Types,VN). 1627 | 1628 | typecheck_term_args(A,T,VN) :- 1629 | nonvar(A), A=(A1,A2),!, 1630 | typecheck_term(A1,T,VN), 1631 | typecheck_term_args(A2,T,VN). 1632 | typecheck_term_args(A1,T,VN) :- 1633 | typecheck_term(A1,T,VN). 1634 | 1635 | % expand_type(T,ET) 1636 | % recursively expands type T following type declarations 1637 | % possibly occurring in T 1638 | % For example: 1639 | % dec_type(a,[b,c]). 1640 | % dec_type(t,set(a)). 1641 | % then 1642 | % expand_type(set(t),set(set([b,c]))) 1643 | % 1644 | expand_type(T,T) :- 1645 | var(T),!. 1646 | expand_type(enum(L),sum(L)) :- !. 1647 | expand_type(sum(L),ET) :- !, 1648 | expand_type_sum(L,LE), 1649 | ET = sum(LE). 1650 | expand_type(T,ET) :- 1651 | atom(T),!, 1652 | (typedec(T,TD) -> 1653 | expand_type(TD,ET) 1654 | ; 1655 | ET = T 1656 | ). 1657 | expand_type(set(T),ET) :- !, 1658 | expand_type(T,ET1), 1659 | ET = set(ET1). 1660 | expand_type(rel(T,U),ET) :- !, % rel type; synonym for set 1661 | expand_type(set([T,U]),ET). 1662 | expand_type([T|T1],ET) :- !, 1663 | expand_type(T,ET1), 1664 | expand_type(T1,ET2), 1665 | ET = [ET1|ET2]. 1666 | expand_type([],[]). 1667 | 1668 | expand_type_sum([],[]). 1669 | expand_type_sum([C|R],[CE|RE]) :- 1670 | C =.. [H|P], 1671 | maplist(expand_type,P,PE), 1672 | CE =.. [H|PE], 1673 | expand_type_sum(R,RE). 1674 | 1675 | % find_diff1(L1,L2,L3,N) 1676 | % must be always invoked with N = 1 1677 | % L1 and L2 are assumed to be lists of the same length 1678 | % nth1(K,L1,E1) & nth1(K,L2,E2) & E1 \= E2 1679 | % <==> member([K,E1,E2],L3) 1680 | % for any K in [1,length(L1)] 1681 | % 1682 | find_diff1([],[],[],_) :- !. 1683 | find_diff1([X|L1],[X|L2],L3,N) :- 1684 | !, 1685 | M is N + 1, 1686 | find_diff1(L1,L2,L3,M). 1687 | find_diff1([X|L1],[Y|L2],[[N,X,Y]|L3],N) :- 1688 | M is N + 1, 1689 | find_diff1(L1,L2,L3,M). 1690 | 1691 | % is meant to be used from maplist 1692 | % in this way each element of the list 1693 | % goes in the last argument (Term) 1694 | % 1695 | typecheck_term1(Type,VN,Term) :- 1696 | typecheck_term(Term,Type,VN). 1697 | 1698 | % transforms the set notation (1,2/R) or (1/{2/R}) 1699 | % into the list L and the rest R 1700 | % setnotation_to_list((1,2/R),[1,2],R) 1701 | % the caller eliminated {} from (1,2/R); i.e. 1702 | % the caller had {1,2/R} but passed just (1,2/R) 1703 | % 1704 | setnotation_to_list(S,L,R) :- 1705 | nonvar(S), S = (X,Y),!, 1706 | L = [X|L1], 1707 | setnotation_to_list(Y,L1,R). 1708 | setnotation_to_list(E,[E],{}) :- 1709 | var(E),!. 1710 | setnotation_to_list(E,L,R) :- 1711 | E = (X/Y),!, 1712 | L = [X], 1713 | R = Y. 1714 | setnotation_to_list(E,[E],{}). 1715 | 1716 | % predicates used by {log} 1717 | 1718 | remove_dec(X,X) :- % var 1719 | var(X),!. 1720 | remove_dec(X,X) :- % constant terms 1721 | atomic(X),!. 1722 | remove_dec(X,Z) :- % dec/2 atoms 1723 | X = (dec(_,_) & F),!, 1724 | remove_dec(F,Z). 1725 | remove_dec(X,true) :- % dec/2 atoms 1726 | X = dec(_,_),!. 1727 | remove_dec(X,Z) :- % all other terms 1728 | =..(X,[F|ListX]), 1729 | remove_dec_all(ListX,ListZ), 1730 | =..(Z,[F|ListZ]). 1731 | 1732 | remove_dec_all([],[]). 1733 | remove_dec_all([A|L1],[B|L2]) :- 1734 | remove_dec(A,B), 1735 | remove_dec_all(L1,L2). 1736 | 1737 | % ignore type declarations or remove variable 1738 | % declarations from ordinary goals 1739 | ignore_type_dec(Goal,Term) :- 1740 | (Goal =.. [F|_], 1741 | member(F,[def_type,dec_p_type,dec_pp_type]) -> 1742 | Term = (:- true) 1743 | ; 1744 | %remove_dec(Goal,Goal1), 1745 | %Term = (:- Goal1) 1746 | Term = (:- Goal) 1747 | ). 1748 | 1749 | 1750 | % is_finite(T) iff T is a finite type 1751 | % T is a finite type iff 1752 | % * T is an enumerated type (i.e. a sum type with only nullary constructors) 1753 | % * T is the sum of finite types 1754 | % * T is the product of finite types 1755 | % * T is the powerset of a finite type 1756 | % 1757 | is_finite(enum(_)) :- !. 1758 | is_finite(sum(C)) :- !, 1759 | is_finite_sum(C). 1760 | is_finite([]) :- !. % the base case for a product type 1761 | is_finite([T1|T]) :- !, 1762 | is_finite(T1), 1763 | is_finite(T). 1764 | is_finite(set(T)) :- !, 1765 | is_finite(T). 1766 | is_finite(rel(T,U)) :- % rel type; synonym for set 1767 | is_finite(set([T,U])). 1768 | 1769 | is_finite_sum([]). 1770 | is_finite_sum([C|R]) :- 1771 | C =.. [_|P], 1772 | forall(member(T,P),is_finite(T)), 1773 | is_finite_sum(R). 1774 | 1775 | % has_finite(T) iff T is a finite type 1776 | % T has a finite type iff 1777 | % * T is an enumerated type (i.e. a sum type with only nullary constructors) 1778 | % * T is the sum of finite types 1779 | % * T is the product of at least one finite type 1780 | % dec(F,rel(enum([t,f]),int)) & 1781 | % pfun(F) & F = {X1,X2,X3} & X1 neq X2 & X1 neq X3 & X2 neq X3 & 1782 | % dec([X1,X2,X3],[enum([t,f]),int]) 1783 | % * T is the powerset of a finite type 1784 | % 1785 | has_finite(enum(_)) :- !. 1786 | has_finite(sum(C)) :- !, 1787 | has_finite_sum(C). 1788 | has_finite([T]) :- % the base case for a product type 1789 | has_finite(T),!. 1790 | has_finite([T1|T]) :- !, 1791 | (has_finite(T1),! 1792 | ; 1793 | has_finite(T) 1794 | ). 1795 | has_finite(set(T)) :- !, 1796 | has_finite(T). 1797 | has_finite(rel(T,U)) :- % rel type; synonym for set 1798 | has_finite(set([T,U])). 1799 | 1800 | has_finite_sum([]). 1801 | has_finite_sum([C|R]) :- 1802 | C =.. [_|P], 1803 | forall(member(T,P),has_finite(T)), 1804 | has_finite_sum(R). 1805 | 1806 | % fintype_to_set(Type,Set) 1807 | % writes finite type Type as {log} set term Set 1808 | % 1809 | fintype_to_set(enum(Elems),Elems) :- !. % enumerated type 1810 | fintype_to_set(sum(C),Elems) :- !, 1811 | fintype_to_set_sum(C,Elems). 1812 | fintype_to_set([],[]) :- !. % product type 1813 | fintype_to_set(P,CP) :- % product type 1814 | P = [T,U],!, % two types (base case) 1815 | fintype_to_set(T,ST), 1816 | fintype_to_set(U,SU), 1817 | findall([X,Y],(member(X,ST),member(Y,SU)),CP). 1818 | fintype_to_set([T|P],CP) :- !, % product type 1819 | fintype_to_set(T,ST), % more than two types 1820 | fintype_to_set(P,CPP), 1821 | findall([X,Y],(member(X,ST),member(Y,CPP)),CP1), 1822 | flatten_elem(CP1,CP). 1823 | fintype_to_set(set(T),PS) :- !, % set type 1824 | fintype_to_set(T,S), 1825 | findall(X,(setlog:powerset(S,E),setlog:mk_set(E,X)),PS). 1826 | fintype_to_set(rel([T,U]),PS) :- % rel type; it's just a synonym 1827 | fintype_to_set(set([T,U]),PS). 1828 | 1829 | fintype_to_set_sum([],[]) :- !. 1830 | fintype_to_set_sum([C|R],[C|Elems]) :- 1831 | atom(C),!, % nullary constructor 1832 | fintype_to_set_sum(R,Elems). 1833 | fintype_to_set_sum([C|R],Elems) :- 1834 | C =.. [H|P], 1835 | (P = [sum(Elems2)],!, % unary constructor 1836 | fintype_to_set_sum(Elems2,ElemsP) 1837 | ; 1838 | fintype_to_set(P,ElemsP) % binary or more constructor 1839 | ), 1840 | apply_cons(H,ElemsP,ElemsCons), % apply_cons(b,[x,y],[b(x),b(y)]) 1841 | fintype_to_set_sum(R,Elems1), 1842 | append(Elems1,ElemsCons,Elems). 1843 | 1844 | % apply_cons(H,L,T) 1845 | % if L = [L1,...,LN] then T = [H(L1),...,H(LN)] 1846 | % apply_cons(b,[x,y],[b(x),b(y)]) 1847 | % apply_cons(b,[[x,y],[u,v],[b(x,y),b(u,v)]) 1848 | apply_cons(_,[],[]) :- !. 1849 | apply_cons(C,[E|R],[T|RT]) :- 1850 | (atom(E) -> % unary constructor 1851 | T =.. [C,E] % apply_cons(b,[x,y],[b(x),b(y)]) 1852 | ; 1853 | T =.. [C|E] % binary or more constructor 1854 | ), % apply_cons(b,[[x,y],[u,v],[b(x,y),b(u,v)]) 1855 | apply_cons(C,R,RT). 1856 | 1857 | % flatten_elem(NL,FL) 1858 | % flattens each element of NL and puts the result 1859 | % in FL 1860 | % it's called only when the elements of NL are 1861 | % lists of lists. for example if NL = [[1,2],[a,b]] 1862 | % flatten_elem isn't called; if NL = [[[1,2],0],[[a,b],k]] 1863 | % it is called and the result is FL = [[1,2,0],[a,b,k]] 1864 | % 1865 | flatten_elem([],[]) :- !. 1866 | flatten_elem([E|NL],FL) :- 1867 | flatten_elem(NL,FL1), 1868 | flatten(E,FE), 1869 | FL = [FE|FL1]. 1870 | 1871 | mk_pair(X,Y,[X,Y]). 1872 | 1873 | % find_var(Var,VN,Eq) 1874 | % - Var is a variable 1875 | % - VN is variable_names as in read_term 1876 | % - Eq is the element in VN where Var is at the right-hand side 1877 | % 1878 | % Var must be somewhere in VN, so VN = [] isn't considered 1879 | % 1880 | find_var(Var,[X = Term|_],X = Term) :- 1881 | term_variables(Term,Vars), 1882 | setlog:member_strong(Var,Vars),!. 1883 | find_var(Var,[_|VN],Eq) :- 1884 | find_var(Var,VN,Eq). 1885 | 1886 | % get_type_from_term(X,Term,T,Tx) 1887 | % - X is a var 1888 | % - Term is a typed term; X is part of Term 1889 | % - T is the type of Term 1890 | % - Tx is the type of X deduced from Term and T 1891 | % 1892 | % the search is made by means of structural induction 1893 | % over the form of T 1894 | % only some cases are considered because the 1895 | % others are impossible at this point 1896 | % 1897 | get_type_from_term(X,Term,T,T) :- % if Term is X, T is X's type 1898 | var(Term), 1899 | X == Term,!. 1900 | get_type_from_term(X,Term,T,Tx) :- % Term is an ordered pair 1901 | T = [TTerm1,TTerm2],!, % iff T is a product type 1902 | nonvar(Term), 1903 | Term = [Term1,Term2], 1904 | (get_type_from_term(X,Term1,TTerm1,Tx),! 1905 | ; 1906 | get_type_from_term(X,Term2,TTerm2,Tx) 1907 | ). 1908 | get_type_from_term(X,Term,T,Tx) :- % Term is a set 1909 | T = set(TElem), % iff T is a set type 1910 | nonvar(Term), 1911 | Term = Set with E,!, 1912 | (get_type_from_term(X,E,TElem,Tx),! 1913 | ; 1914 | get_type_from_term(X,Set,T,Tx) 1915 | ). 1916 | 1917 | 1918 | 1919 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1920 | % 1921 | % type error messages 1922 | % 1923 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1924 | 1925 | print_type_error(C,VN,Tx) :- 1926 | term_string(C,S1,[variable_names(VN)]), 1927 | C =.. [_,X], 1928 | term_string(X,S2,[variable_names(VN)]), 1929 | term_string(Tx,S3), 1930 | string_concat("type error: in ",S1,C1), 1931 | string_concat(C1,"\n\t",C11), 1932 | string_concat(C11,S2,C2), 1933 | string_concat(C2," is of type ",C3), 1934 | string_concat(C3,S3,C4), 1935 | throw(setlog_excpt(C4)). 1936 | 1937 | print_type_error(C,VN,Tx,Ty) :- 1938 | term_string(C,S1,[variable_names(VN)]), 1939 | C =.. [_,X,Y], 1940 | term_string(X,S2,[variable_names(VN)]), 1941 | term_string(Tx,S3), 1942 | term_string(Y,S4,[variable_names(VN)]), 1943 | term_string(Ty,S5), 1944 | string_concat("type error: in ",S1,C1), 1945 | string_concat(C1,"\n\t",C11), 1946 | string_concat(C11,S2,C2), 1947 | string_concat(C2," is of type ",C3), 1948 | string_concat(C3,S3,C4), 1949 | string_concat(C4,"\n\t",C5), 1950 | string_concat(C5,S4,C6), 1951 | string_concat(C6," is of type ",C7), 1952 | string_concat(C7,S5,C8), 1953 | throw(setlog_excpt(C8)). 1954 | 1955 | print_type_error(C,VN,Tx,Ty,Tz) :- 1956 | term_string(C,S1,[variable_names(VN)]), 1957 | C =.. [_,X,Y,Z], 1958 | term_string(X,S2,[variable_names(VN)]), 1959 | term_string(Tx,S3), 1960 | term_string(Y,S4,[variable_names(VN)]), 1961 | term_string(Ty,S5), 1962 | term_string(Z,SZ1,[variable_names(VN)]), 1963 | term_string(Tz,SZ2), 1964 | string_concat("type error: in ",S1,C1), 1965 | string_concat(C1,"\n\t",C11), 1966 | 1967 | string_concat(C11,S2,C2), 1968 | string_concat(C2," is of type ",C3), 1969 | string_concat(C3,S3,C40), 1970 | 1971 | string_concat(C40,"\n\t",C41), 1972 | string_concat(C41,S4,C42), 1973 | string_concat(C42," is of type ",C43), 1974 | string_concat(C43,S5,C4), 1975 | 1976 | string_concat(C4,"\n\t",C5), 1977 | string_concat(C5,SZ1,C6), 1978 | string_concat(C6," is of type ",C7), 1979 | string_concat(C7,SZ2,C8), 1980 | throw(setlog_excpt(C8)). 1981 | 1982 | print_type_error_var(X,T1,T,VN) :- 1983 | term_string(X,S1,[variable_names(VN)]), 1984 | term_string(T1,S2,[variable_names(VN)]), 1985 | term_string(T,S3,[variable_names(VN)]), 1986 | string_concat("type error: variable ",S1,C1), 1987 | string_concat(C1," has type ",C2), 1988 | string_concat(C2,S2,C3), 1989 | string_concat(C3," but it should be ",C4), 1990 | string_concat(C4,S3,C5), 1991 | throw(setlog_excpt(C5)). 1992 | 1993 | print_type_error_dec_1(D,VN) :- 1994 | term_string(D,S1,[variable_names(VN)]), 1995 | D =.. [_,V,_], 1996 | term_string(V,S2,[variable_names(VN)]), 1997 | string_concat("type error: in ",S1,C1), 1998 | string_concat(C1,", ",C11), 1999 | string_concat(C11,S2,C2), 2000 | string_concat(C2," is not a variable",C3), 2001 | throw(setlog_excpt(C3)). 2002 | 2003 | print_type_error_dec_2(D,VN) :- 2004 | term_string(D,S1,[variable_names(VN)]), 2005 | D =.. [_,_,T], 2006 | term_string(T,S2,[variable_names(VN)]), 2007 | string_concat("type error: in ",S1,C1), 2008 | string_concat(C1,", type ",C11), 2009 | string_concat(C11,S2,C2), 2010 | string_concat(C2," is not well-defined",C3), 2011 | throw(setlog_excpt(C3)). 2012 | 2013 | print_type_error_dec_3(D,VN) :- 2014 | term_string(D,S1,[variable_names(VN)]), 2015 | D =.. [_,V,_], 2016 | term_string(V,S2,[variable_names(VN)]), 2017 | string_concat("type error: in ",S1,C1), 2018 | string_concat(C1,", ",C11), 2019 | string_concat(C11,"variable ",C12), 2020 | string_concat(C12,S2,C2), 2021 | string_concat(C2," is already declared",C3), 2022 | throw(setlog_excpt(C3)). 2023 | 2024 | print_type_error_dec_4(X,VN) :- 2025 | term_string(X,S1,[variable_names(VN)]), 2026 | string_concat("type error: variable ",S1,C1), 2027 | string_concat(C1," has no type declaration",C3), 2028 | throw(setlog_excpt(C3)). 2029 | 2030 | print_type_error_defcons1(C,ATypes,T,VN) :- 2031 | term_string(C,S1,[variable_names(VN)]), 2032 | string_concat("type error: in ",S1,C1), 2033 | string_concat(C1," arguments have the wrong type:\n",C2), 2034 | T =.. [_|Types], 2035 | length(Types,N), 2036 | length(ETypes,N), 2037 | maplist(expand_type,Types,ETypes), 2038 | find_diff1(ATypes,ETypes,Diff,1), 2039 | copy_term(Types,CTypes), 2040 | C =.. [_|P], 2041 | mk_msg(Diff,P,VN,Msg), 2042 | string_concat(C2,Msg,C7), 2043 | term_variables(CTypes,VT), 2044 | (VT == [] -> 2045 | throw(setlog_excpt(C7)) 2046 | ; 2047 | string_concat(C7," for some types ",C8), 2048 | numbervars(VT,19,_), 2049 | term_string(VT,S5,[numbervars(true)]), 2050 | string_concat(C8,S5,C9), 2051 | throw(setlog_excpt(C9)) 2052 | ). 2053 | 2054 | mk_msg([],_,_,"") :- !. 2055 | mk_msg([[N,T1,T2]|L],P,VN,Msg) :- 2056 | nth1(N,P,A), 2057 | term_string(A,Sa,[variable_names(VN)]), 2058 | term_string(T1,S1), 2059 | numbervars(T2,19,_), 2060 | term_string(T2,S2,[numbervars(true)]), 2061 | string_concat(Sa," is ",C1), 2062 | string_concat(C1,S1,C2), 2063 | string_concat(C2," but should be ",C3), 2064 | string_concat(C3,S2,C4), 2065 | (L \== [] -> 2066 | string_concat(C4,"\n",C5) 2067 | ; 2068 | C5 = C4 2069 | ), 2070 | mk_msg(L,P,VN,Msg1), 2071 | string_concat(C5,Msg1,Msg). 2072 | 2073 | print_type_error_defcons2(C,VN) :- 2074 | term_string(C,S1,[variable_names(VN)]), 2075 | string_concat("type error: in ",S1,C1), 2076 | string_concat(C1," one of the arguments has the wrong type",C2), 2077 | throw(setlog_excpt(C2)). 2078 | 2079 | print_type_error_clause1(H,VN) :- 2080 | term_string(H,S1,[variable_names(VN)]), 2081 | string_concat("type error: type declaration of predicate ",S1,C1), 2082 | string_concat(C1," include variables",C2), 2083 | throw(setlog_excpt(C2)). 2084 | 2085 | print_type_error_clause2(B,VN) :- 2086 | term_string(B,S1,[variable_names(VN)]), 2087 | string_concat("type error: type declaration of predicate ",S1,C1), 2088 | string_concat(C1," must have exactly one parameter",C2), 2089 | throw(setlog_excpt(C2)). 2090 | 2091 | print_type_error_clause3(H) :- 2092 | H =.. [F|P], 2093 | length(P,A), 2094 | term_string(F,S1), 2095 | term_string(A,S2), 2096 | string_concat("type error: type declaration of predicate ",S1,C1), 2097 | string_concat(C1,"/",C2), 2098 | string_concat(C2,S2,C3), 2099 | string_concat(C3," is missing",C4), 2100 | throw(setlog_excpt(C4)). 2101 | 2102 | print_type_error_clause4(H,VN) :- 2103 | term_string(H,S1,[variable_names(VN)]), 2104 | string_concat("type error: more than one type declaration for predicate ",S1,C1), 2105 | throw(setlog_excpt(C1)). 2106 | 2107 | print_type_error_clause5(H) :- 2108 | term_string(H,S1), 2109 | string_concat("type error: ",S1,C1), 2110 | string_concat(C1," is a reserved predicate; can't be used in this context",C2), 2111 | throw(setlog_excpt(C2)). 2112 | 2113 | print_type_error_dec_type(D,VN) :- 2114 | term_string(D,S1,[variable_names(VN)]), 2115 | string_concat("type error: incorrect type declaration ",S1,C1), 2116 | throw(setlog_excpt(C1)). 2117 | 2118 | print_type_error_atom(A,VN) :- 2119 | term_string(A,S,[variable_names(VN)]), 2120 | string_concat("type error: '",S,C1), 2121 | string_concat(C1,"' doesn\'t fit in the sum type",C2), 2122 | throw(setlog_excpt(C2)). 2123 | 2124 | print_type_error_dec_type(ID) :- 2125 | term_string(ID,S), 2126 | string_concat(S," isn't a type identifier",C), 2127 | throw(setlog_excpt(C)). 2128 | 2129 | print_type_error_term(X,T,VN) :- 2130 | var(T),!, 2131 | term_string(X,Sx,[variable_names(VN)]), 2132 | string_concat("type error: ",Sx,C1), 2133 | string_concat(C1," isn't an admissible term in type-checking mode",C2), 2134 | throw(setlog_excpt(C2)). 2135 | print_type_error_term(X,T,VN) :- % not sure if this branch is possible 2136 | term_string(X,Sx,[variable_names(VN)]), 2137 | term_string(T,St), 2138 | string_concat("type error: the type of ",Sx,C1), 2139 | string_concat(C1," isn't ",C2), 2140 | string_concat(C2,St,C3), 2141 | throw(setlog_excpt(C3)). 2142 | 2143 | print_type_error_elem_ut(T:X,VN) :- 2144 | term_string(T:X,S1,[variable_names(VN)]), 2145 | string_concat("type error: ",S1,C1), 2146 | string_concat(C1," isn't well defined",C2), 2147 | throw(setlog_excpt(C2)). 2148 | 2149 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 2150 | % 2151 | % type definitions for {log} derived constraints 2152 | % 2153 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 2154 | 2155 | dec_internal :- 2156 | % inters 2157 | declare_pp_type(inters(set(T),set(T),set(T))), 2158 | 2159 | % subset 2160 | declare_pp_type(subset(set(T),set(T))), 2161 | 2162 | % diff 2163 | declare_pp_type(diff(set(T),set(T),set(T))), 2164 | 2165 | % sdiff 2166 | declare_pp_type(sdiff(set(T),set(T),set(T))), 2167 | 2168 | % less 2169 | declare_pp_type(less(set(T),T,set(T))), 2170 | 2171 | % dom 2172 | declare_pp_type(dom(set([T,_]),set(T))), 2173 | 2174 | % dompf 2175 | declare_pp_type(dompf(set([T,_]),set(T))), 2176 | 2177 | % ran 2178 | declare_pp_type(ran(set([_,U]),set(U))), 2179 | 2180 | % dres 2181 | declare_pp_type(dres(set(T),set([T,U]),set([T,U]))), 2182 | 2183 | % dares 2184 | declare_pp_type(dares(set(T),set([T,U]),set([T,U]))), 2185 | 2186 | % rres 2187 | declare_pp_type(rres(set([T,U]),set(U),set([T,U]))), 2188 | 2189 | % rares 2190 | declare_pp_type(rares(set([T,U]),set(U),set([T,U]))), 2191 | 2192 | % rimg 2193 | declare_pp_type(rimg(set([T,U]),set(T),set(U))), 2194 | 2195 | % oplus 2196 | declare_pp_type(oplus(set([T,U]),set([T,U]),set([T,U]))), 2197 | 2198 | % pfun 2199 | declare_pp_type(pfun(set([_,_]))), 2200 | 2201 | % apply 2202 | declare_pp_type(apply(set([T,U]),T,U)), 2203 | 2204 | % comppf 2205 | declare_pp_type(comppf(set([T,U]),set([U,V]),set([T,V]))), 2206 | 2207 | % applyTo 2208 | declare_pp_type(applyTo(set([T,U]),T,U)), 2209 | 2210 | % smin 2211 | declare_pp_type(smin(set(int),int)), 2212 | 2213 | % smax 2214 | declare_pp_type(smax(set(int),int)), 2215 | 2216 | % negations 2217 | 2218 | % ninters 2219 | declare_pp_type(ninters(set(T),set(T),set(T))), 2220 | 2221 | % nsubset 2222 | declare_pp_type(nsubset(set(T),set(T))), 2223 | 2224 | % ndiff 2225 | declare_pp_type(ndiff(set(T),set(T),set(T))), 2226 | 2227 | % nsdiff 2228 | declare_pp_type(nsdiff(set(T),set(T),set(T))), 2229 | 2230 | % ndom 2231 | declare_pp_type(ndom(set([T,_]),set(T))), 2232 | 2233 | % ndompf 2234 | declare_pp_type(ndompf(set([T,_]),set(T))), 2235 | 2236 | % nran 2237 | declare_pp_type(nran(set([_,U]),set(U))), 2238 | 2239 | % ndres 2240 | declare_pp_type(ndres(set(T),set([T,U]),set([T,U]))), 2241 | 2242 | % ndares 2243 | declare_pp_type(ndares(set(T),set([T,U]),set([T,U]))), 2244 | 2245 | % nrres 2246 | declare_pp_type(nrres(set([T,U]),set(T),set([T,U]))), 2247 | 2248 | % nrares 2249 | declare_pp_type(nrares(set([T,U]),set(T),set([T,U]))), 2250 | 2251 | % nrimg 2252 | declare_pp_type(nrimg(set([T,U]),set(T),set(U))), 2253 | 2254 | % noplus 2255 | declare_pp_type(noplus(set([T,U]),set([T,U]),set([T,U]))), 2256 | 2257 | % npfun 2258 | declare_pp_type(npfun(set([_,_]))), 2259 | 2260 | % napply 2261 | declare_pp_type(napply(set([T,U]),T,U)), 2262 | 2263 | % ncomppf 2264 | declare_pp_type(ncomppf(set([T,U]),set([U,V]),set([T,V]))), 2265 | 2266 | % napplyTo 2267 | declare_pp_type(napplyTo(set([T,U]),T,U)). 2268 | 2269 | --------------------------------------------------------------------------------