1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124 | --
-- Copyright (C) 2014-2022, AdaCore
-- SPDX-License-Identifier: Apache-2.0
--
-- Provide common support material for Adalog unit tests
with Ada.Containers.Vectors;
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
with Gpr_Parser_Support.Adalog.Logic_Var;
with Gpr_Parser_Support.Adalog.Solver;
with Gpr_Parser_Support.Adalog.Solver_Interface;
generic
type T is private;
with function Image (I : T) return String is <>;
package Gpr_Parser_Support.Adalog.Generic_Main_Support is
package Refs is new Gpr_Parser_Support.Adalog.Logic_Var
(T, Value_Image => Image);
function Create (Name : String) return Refs.Logic_Var;
package Solver_Ifc is new Solver_Interface (Refs);
package T_Solver is new Gpr_Parser_Support.Adalog.Solver (Solver_Ifc);
use Solver_Ifc, T_Solver, Refs;
function "+" (R : Relation) return Relation;
-- Register R and return it. This is used to keep track of allocated
-- relations in testcases, to be released in Finalize.
function "-" (S : String) return String_Access;
-- Return a dynamically allocated string for S, keeping track of it to be
-- released in Finalize.
function R_All
(Rels : Relation_Array; Dbg_String : String := "") return Relation
is (+Create_All (Rels, -Dbg_String));
function R_Any
(Rels : Relation_Array; Dbg_String : String := "") return Relation
is (+Create_Any (Rels, -Dbg_String));
function "or" (L, R : Relation) return Relation is (+Create_Any ((L, R)));
function "and" (L, R : Relation) return Relation is (+Create_All ((L, R)));
function Domain (Var : Refs.Logic_Var;
Rels : Value_Array;
Dbg_String : String := "") return Relation
is (+Create_Domain (Var, Rels, -Dbg_String));
function "=" (Var : Refs.Logic_Var; Val : T) return Relation
is (+Create_Assign (Var, Val));
function "=" (L, R : Refs.Logic_Var) return Relation
is (+Create_Unify (L, R));
function Propagate
(L, R : Refs.Logic_Var;
Conv : Converter_Type'Class := No_Converter;
Dbg_String : String := "") return Relation
is
(+Create_Propagate (L, R, Conv, -Dbg_String));
function N_Propagate
(To : Refs.Logic_Var;
Comb : Combiner_Type'Class;
Vars : Logic_Var_Array;
Dbg_String : String := "") return Relation
is (+Create_N_Propagate (To, Comb, Vars, -Dbg_String));
function Unify
(L, R : Refs.Logic_Var; Dbg_String : String := "") return Relation
is (+Create_Unify (L, R, -Dbg_String));
function Assign
(L : Refs.Logic_Var;
R : T;
Conv : Converter_Type'Class := No_Converter;
Dbg_String : String := "") return Relation
is
(+Create_Assign (L, R, Conv, -Dbg_String));
function Predicate
(L : Refs.Logic_Var;
P : Predicate_Type'Class;
Dbg_String : String := "") return Relation
is
(+Create_Predicate (L, P, -Dbg_String));
function N_Predicate
(Vars : Logic_Var_Array;
P : N_Predicate_Type'Class;
Dbg_String : String := "") return Relation
is
(+Create_N_Predicate (Vars, P, -Dbg_String));
function Logic_False return Relation is (+Create_False);
function Logic_True return Relation is (+Create_True);
procedure Solve_All (Rel : Relation; Timeout : Natural := 0);
procedure Run_Main (Main : access procedure);
procedure Setup_Traces;
procedure Finalize;
private
package Relation_Vectors is new Ada.Containers.Vectors
(Positive, Relation);
package Variable_Vectors is new Ada.Containers.Vectors
(Positive, Refs.Logic_Var, Refs."=");
package String_Access_Vectors is new Ada.Containers.Vectors
(Positive, String_Access);
Relations : Relation_Vectors.Vector;
Variables : Variable_Vectors.Vector;
Strings : String_Access_Vectors.Vector;
end Gpr_Parser_Support.Adalog.Generic_Main_Support;
|