Skip to content

Commit 73056be

Browse files
committed
fix: avoid accumulating Db's header twice
1 parent 94d7187 commit 73056be

File tree

4 files changed

+38
-14
lines changed

4 files changed

+38
-14
lines changed

src/coq_elpi_programs.ml

Lines changed: 11 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -16,16 +16,18 @@ module SLSet = Set.Make(struct type t = qualified_name let compare = compare_qua
1616
type src =
1717
| File of src_file
1818
| EmbeddedString of src_string
19-
| Database of qualified_name
19+
| DatabaseBody of qualified_name
20+
| DatabaseHeader of src_db_header
2021
and src_file = {
2122
fname : string;
2223
fast : cunit;
2324
}
2425
and src_string = {
25-
(* sloc : API.Ast.Loc.t;
26-
sdata : string; *)
2726
sast : cunit;
2827
}
28+
and src_db_header = {
29+
dast : cunit;
30+
}
2931

3032
let alpha = 65599
3133
let combine_hash h1 h2 = h1 * alpha + h2
@@ -398,11 +400,13 @@ let get ?(fail_if_not_exists=false) p =
398400
(* undup *)
399401
| File { fast = (kn,_) } when Names.KNset.mem kn units -> units, dbs, prog
400402
| EmbeddedString { sast = (kn,_) } when Names.KNset.mem kn units -> units, dbs, prog
401-
| Database n when SLSet.mem n dbs -> units, dbs, prog
403+
| DatabaseHeader { dast = (kn,_) } when Names.KNset.mem kn units -> units, dbs, prog
404+
| DatabaseBody n when SLSet.mem n dbs -> units, dbs, prog
402405
(* add *)
403406
| File { fast = (kn,_ as u) } -> (Names.KNset.add kn units), dbs, Some (Code.snoc_opt u prog)
404407
| EmbeddedString { sast = (kn,_ as u) } -> (Names.KNset.add kn units), dbs, Some (Code.snoc_opt u prog)
405-
| Database n -> units, SLSet.add n dbs, Some (Code.snoc_db_opt Hashtbl.hash n prog)
408+
| DatabaseHeader { dast = (kn,_ as u) } -> (Names.KNset.add kn units), dbs, Some (Code.snoc_opt u prog)
409+
| DatabaseBody n -> units, SLSet.add n dbs, Some (Code.snoc_db_opt Hashtbl.hash n prog)
406410
in
407411
let prog = Option.get prog in
408412
{ units; dbs; sources_rev = prog; empty = empty && from = Initialization }
@@ -663,9 +667,8 @@ let compile ~loc src =
663667
lookup_chunk bh h src
664668
with Not_found ->
665669
match src with
666-
| Chunk.Base { base = (k,u) } ->
667-
let prog = extend_w_units ~base ~loc [u] in
668-
cache_chunk bh h prog src
670+
| Chunk.Base _ ->
671+
base (* the base of dbs is accumulated with a Snoc so to avoid accumulating it twice when "Accumulate Db Header" is followed by "Accumulate Db" *)
669672
| Chunk.Snoc { prev; source_rev } ->
670673
let base = compile_chunk bh base prev in
671674
let prog = extend_w_units ~base ~loc (List.rev_map snd source_rev) in

src/coq_elpi_programs.mli

Lines changed: 6 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -11,16 +11,19 @@ type program_name = Loc.t * qualified_name
1111
type src =
1212
| File of src_file
1313
| EmbeddedString of src_string
14-
| Database of qualified_name
14+
| DatabaseBody of qualified_name
15+
| DatabaseHeader of src_db_header
1516
and src_file = {
1617
fname : string;
1718
fast : cunit;
1819
}
1920
and src_string = {
20-
(* sloc : Ast.Loc.t;
21-
sdata : string; *)
2221
sast : cunit;
2322
}
23+
and src_db_header = {
24+
dast : cunit;
25+
}
26+
2427
type nature = Command of { raw_args : bool } | Tactic | Program of { raw_args : bool }
2528

2629

src/coq_elpi_vernacular.ml

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -277,19 +277,19 @@ let run_in_program ~loc ?(program = current_program ()) ?(st_setup=fun _ x -> x)
277277
P.accumulate_to_db program [new_ast] [] ~scope:Coq_elpi_utils.Regular
278278
| `Program base ->
279279
let new_ast = P.unit_from_string ~elpi ~base ~loc sloc s in
280-
P.accumulate program [EmbeddedString { (*sloc = loc; sdata = s;*) sast = new_ast}]
280+
P.accumulate program [EmbeddedString { sast = new_ast}]
281281
let accumulate_string ~atts:(only,ph) ~loc ?program sloc = skip ~only ~ph (accumulate_string ~loc ?program) sloc
282282

283283

284284
let accumulate_db ~loc ?(program=current_program()) name =
285285
let _ = P.ensure_initialized () in
286-
if P.db_exists name then P.accumulate program [Database name]
286+
if P.db_exists name then P.accumulate program [DatabaseHeader { dast = P.(header_of_db name) };DatabaseBody name]
287287
else CErrors.user_err Pp.(str "Db " ++ pr_qualified_name name ++ str" not found")
288288
let accumulate_db ~atts:(only,ph) ~loc ?program name = skip ~only ~ph (accumulate_db ~loc ?program) name
289289

290290
let accumulate_db_header ~loc ?(program=current_program()) name =
291291
let _ = P.ensure_initialized () in
292-
if P.db_exists name then P.accumulate program [EmbeddedString { sast = P.header_of_db name } ]
292+
if P.db_exists name then P.accumulate program [DatabaseHeader { dast = P.(header_of_db name) }]
293293
else CErrors.user_err Pp.(str "Db " ++ pr_qualified_name name ++ str" not found")
294294
let accumulate_db_header ~atts:(only,ph) ~loc ?program name = skip ~only ~ph (accumulate_db_header ~loc ?program) name
295295

tests/test_API2.v

Lines changed: 18 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -386,3 +386,21 @@ Elpi Query lp:{{
386386
test {{ fun z => S (fun x y => z z x y) }} {{ fun z => S (z z) }},
387387
].
388388
}}.
389+
390+
391+
Elpi Db foo.db lp:{{
392+
pred p o:int.
393+
p 1.
394+
}}.
395+
Elpi Accumulate foo.db lp:{{
396+
p 2.
397+
}}.
398+
Elpi Command query_foo.
399+
Elpi Accumulate Db Header foo.db.
400+
Elpi Accumulate lp:{{
401+
main _ :-
402+
std.findall (p _) [p 1, p 2].
403+
}}.
404+
Elpi Accumulate Db foo.db.
405+
406+
Elpi query_foo.

0 commit comments

Comments
 (0)