-
Notifications
You must be signed in to change notification settings - Fork 3
/
main.ml
1169 lines (1024 loc) · 34.9 KB
/
main.ml
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
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
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
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
(* Main program for translating HOL-Light proofs to Dedukti or Lambdapi. *)
open Fusion
open Xlib
open Xprelude
open Xproof
open Xfiles
open Xnames
let usage() =
print_string
"hol2dk uses
------------
hol2dk [-h|--help]
print this help
hol2dk options command arguments
Options
-------
--max-proof-size INT: maximum size of proof files
--max-abbrev-size INT: maximum size of term abbreviation files
--use-sharing: define term abbreviations using let's
--print-stats: print statistics on hash tables at exit
Patching commands
-----------------
hol2dk patch
patch the $HOLLIGHT_DIR sources
hol2dk unpatch
unpatch the $HOLLIGHT_DIR sources
Dumping commands
----------------
hol2dk dump-simp $base.(ml|hl)
compose the commands dump, pos, use, rewrite and purge
for a file $base.(ml|hl) depending on hol.ml
hol2dk dump-simp-before-hol $base.(ml|hl)
same as hol2dk dump-simp except that hol.ml is not loaded first
hol2dk dump $base.(ml|hl)
run OCaml toplevel to check $base.(ml|hl) and generate
$base.sig (type and term constants), $base.prf (proof steps)
and $base.thm (named theorems)
hol2dk dump-before-hol $base.(ml|hl)
same as hol2dk dump except that hol.ml is not loaded first
hol2dk pos $base
generate $base.pos, the positions of proof steps in $base.prf
hol2dk use $base
generate $base.use, some data to know whether a proof step is used or not
hol2dk rewrite $base
simplify $base.prf and update $base.pos and $base.use
hol2dk purge $base
set as unused the proof steps that do not contribute to a named theorem
Single-threaded dk/lp file generation
-------------------------------------
hol2dk $base.(dk|lp)
generate $base.(dk|lp)
hol2dk $base.(dk|lp) $thm_id
generate $base.(dk|lp) but with theorem index $thm_id only (for debug)
Multi-threaded lp file generation by having a file for each named theorem
-------------------------------------------------------------------------
hol2dk link [$path/]$base
add links to the files generated by dump in $HOLLIGHT_DIR[/$path/]
and to hol2dk files needed to translate $base.prf to Dedukti, Lambdapi
and Coq, and check the obtained files
hol2dk split $base
generate $base.thp and the files $thm.sti, $thm.pos and $thm.use
for each theorem $thm
hol2dk theorem $base $thm.lp
generate the lp proof of the theorem $thm
hol2dk thmsplit $base $thm.lp
split the proof of $thm in various pieces according to --max-proof-size
hol2dk thmpart $base ${thm}_part_$k.lp
generate ${thm}_part_$k.lp and its term abbreviations
according to --max-abbrev-size
hol2dk abbrev $base ${thm}_term_abbrevs_part_$k.lp
generate ${thm}_term_abbrevs_part_$k.lp
hol2dk type_abbrevs $base
generate ${file}_type_abbrevs.lp
Multi-threaded dk/lp file generation by splitting proofs in $n parts
--------------------------------------------------------------------
hol2dk mk $n $base
generate $base.dg, the dependency graph between parts when $base.prf is
split in $n parts, and the Makefile $base.mk for translating and checking
those parts in parallel
hol2dk part $k $x $y $base.(dk|lp)
generate dk/lp proof files of part $k from proof index $x to proof index $y
hol2dk sig $base
generate dk/lp signature files from $base.sig
hol2dk thm $base.(dk|lp)
generate $base.(dk|lp) from $base.thm
hol2dk axm $base.(dk|lp)
generate ${base}_opam.(dk|lp) from $base.thm (same as thm but without proofs)
Other commands
--------------
hol2dk env
print the values of $HOL2DK_DIR and $HOLLIGHT_DIR
hol2dk nbp $base
print the number of proof steps in $base.prf
hol2dk proof $base $x $y
print proof steps between theorem indexes $x and $y
hol2dk print use $base $x
print the contents of $base.use for theorem index $x
hol2dk stat $base
print statistics on proofs
hol2dk size $base [$lower_bound]
print statistics on the size of terms
and the number of terms of size greater than $lower_bound
hol2dk dep
print on stdout a Makefile giving the dependencies of all HOL-Light files
in the working directory and all its subdirectories recursively
hol2dk dep [$path/]$base.(ml|hl)
print the HOL-Light files required to check [$path/]$base.(ml|hl)
hol2dk name [$path/]$base.(ml|hl)
print the named theorems proved in [$path/]$base.(ml|hl)
hol2dk name upto [$path/]$base.(ml|hl)
print the named theorems proved in [$path/]$base.(ml|hl)
and all its dependencies
hol2dk name
print on stdout the named theorems proved in all HOL-Light files
in the working directory and all its subdirectories recursively
"
let is_dk f =
match Filename.extension f with
| ".dk" -> true
| ".lp" -> false
| _ -> err "\"%s\" does not end with \".dk\" or \".lp\"\n" f; exit 1
;;
let read_sig b =
let dump_file = b^".sig" in
let ic = open_in_bin dump_file in
log_read dump_file;
the_type_constants := List.rev (input_value ic);
(* we add "el" to use mk_const without failing *)
the_term_constants := ("el",aty)::List.rev (input_value ic);
the_axioms := List.rev (input_value ic);
the_definitions := List.rev (input_value ic);
close_in ic;
update_map_const_typ_vars_pos();
update_reserved()
;;
let integer s =
try int_of_string s
with Failure _ ->
Printf.eprintf "\"%s\" is not a valid integer\n" s; exit 1
;;
(* [make nb_proofs dg b] generates a makefile for translating the
proofs of [b] in parallel, according to the dependency graph
between parts [dg]. *)
let make nb_proofs dg b =
let nb_parts = Array.length dg in
let dump_file = b^".mk" in
log_gen dump_file;
let oc = open_out dump_file in
out oc "# file generated with: hol2dk mk %d %s\n" nb_parts b;
out oc "\nLAMBDAPI = lambdapi\n";
out oc "\n.SUFFIXES:\n";
(* dk files generation *)
out oc "\n.PHONY: dk\n";
out oc "dk: %s.dk\n" b;
out oc "%s.dk: theory_hol.dk %s_types.dk %s_terms.dk %s_axioms.dk"
b b b b;
for i = 1 to nb_parts do
out oc " %s_part_%d_type_abbrevs.dk %s_part_%d_term_abbrevs.dk \
%s_part_%d.dk" b i b i b i
done;
out oc " %s_theorems.dk\n\tcat $+ > $@\n" b;
out oc "%s_types.dk %s_terms.dk %s_axioms.dk &: %s.sig\n\
\thol2dk sig %s.dk\n" b b b b b;
out oc "%s_theorems.dk: %s.sig %s.thm %s.pos %s.prf\n\
\thol2dk thm %s.dk\n" b b b b b b;
let cmd i x y =
out oc "%s_part_%d.dk %s_part_%d_type_abbrevs.dk \
%s_part_%d_term_abbrevs.dk &: %s.sig %s.prf %s.pos\n\
\thol2dk part %d %d %d %s.dk\n" b i b i b i b b b i x y b
in
Xlib.iter_parts nb_proofs nb_parts cmd;
out oc ".PHONY: clean-dk\nclean-dk:\n\trm -f %s*.dk\n" b;
(* lp files generation *)
out oc "\n.PHONY: lp\n";
out oc "lp: theory_hol.lp %s.lp %s_types.lp %s_terms.lp \
%s_axioms.lp %s_opam.lp" b b b b b;
for i = 1 to nb_parts do
out oc " %s_part_%d_type_abbrevs.lp %s_part_%d_term_abbrevs.lp \
%s_part_%d.lp" b i b i b i
done;
out oc "\n%s_types.lp %s_terms.lp %s_axioms.lp &: %s.sig\n\
\thol2dk sig %s.lp\n" b b b b b;
out oc "%s.lp: %s.sig %s.thm %s.pos %s.prf\n\
\thol2dk thm %s.lp\n" b b b b b b;
let cmd i x y =
out oc "%s_part_%d.lp %s_part_%d_type_abbrevs.lp \
%s_part_%d_term_abbrevs.lp &: %s.sig %s.pos %s.prf %s.use\n\
\thol2dk part %d %d %d %s.lp\n"
b i b i b i b b b b i x y b
in
Xlib.iter_parts nb_proofs nb_parts cmd;
out oc "%s_opam.lp: %s.sig %s.thm %s.pos %s.prf\n\
\thol2dk axm %s.lp\n" b b b b b b;
out oc ".PHONY: clean-lp\nclean-lp:\n\trm -f %s*.lp\n" b;
(* targets common to dk and lp files part *)
out oc "\n%s.pos: %s.prf\n\thol2dk pos %s\n" b b b;
out oc "%s.use: %s.sig %s.prf %s.thm\n\thol2dk use %s\n" b b b b b;
(* generic function for lpo/vo file generation *)
let check e c clean =
out oc "\n.PHONY: %so\n" e;
out oc "%so: %s.%so\n" e b e;
out oc "%s.%so: theory_hol.%so %s_types.%so \
%s_terms.%so %s_axioms.%so %s_opam.%so" b e e b e b e b e b e;
for i = 1 to nb_parts do out oc " %s_part_%d.%so" b i e done;
out oc "\n%s_types.%so: theory_hol.%so\n" b e e;
out oc "%s_terms.%so: theory_hol.%so %s_types.%so\n" b e e b e;
out oc "%s_axioms.%so: theory_hol.%so %s_types.%so \
%s_terms.%so\n" b e e b e b e;
for i = 0 to nb_parts - 1 do
let j = i+1 in
out oc "%s_part_%d_type_abbrevs.%so: theory_hol.%so \
%s_types.%so\n" b j e e b e;
out oc "%s_part_%d_term_abbrevs.%so: \
theory_hol.%so %s_types.%so %s_part_%d_\
type_abbrevs.%so %s_terms.%so\n" b j e e b e b j e b e;
out oc "%s_part_%d.%so: theory_hol.%so \
%s_types.%so %s_part_%d_type_abbrevs.%so %s_terms.%so \
%s_part_%d_term_abbrevs.%so %s_axioms.%so"
b j e e b e b j e b e b j e b e;
for j = 0 to i - 1 do
if dg.(i).(j) then out oc " %s_part_%d.%so" b (j+1) e
done;
out oc "\n"
done;
out oc "%s_opam.%so: theory_hol.%so %s_types.%so %s_terms.%so \
%s_axioms.%so\n" b e e b e b e b e;
out oc "%%.%so: %%.%s\n\t%s $<\n" e e c;
out oc
".PHONY: clean-%so\nclean-%so:\n\trm -f theory_hol.%so %s*.%so%a\n"
e e e b e clean b;
in
(* lp files checking *)
check "lp" "$(LAMBDAPI) check -v0 -w -c" (fun _ _ -> ());
(* v files generation *)
out oc "\n.PHONY: v\nv: coq.v theory_hol.v \
%s_types.v %s_terms.v %s_axioms.v %s_opam.v" b b b b;
for i = 1 to nb_parts do
out oc " %s_part_%d_type_abbrevs.v %s_part_%d_term_abbrevs.v \
%s_part_%d.v" b i b i b i
done;
out oc " %s.v\n" b;
out oc "%%.v: %%.lp\n\t$(LAMBDAPI) export -o stt_coq \
--encoding $(HOL2DK_DIR)/encoding.lp \
--renaming $(HOL2DK_DIR)/renaming.lp \
--erasing $(HOL2DK_DIR)/erasing.lp \
--use-notations --requiring coq.v";
out oc {| $< | sed -e 's/^Require Import hol-light\./Require Import /g'|};
out oc " > $@\n";
out oc ".PHONY: clean-v\nclean-v:\n\trm -f theory_hol.v %s*.v\n" b;
(* coq files checking *)
let clean oc _b = out oc " coq.vo *.vo[sk] *.glob .*.aux .[nl]ia.cache" in
check "v" "coqc -R . HOLLight" clean;
out oc "theory_hol.vo: coq.vo\n";
(* clean-all target *)
out oc "\n.PHONY: clean-all\nclean-all: \
clean-dk clean-lp clean-lpo clean-v clean-vo\n";
close_out oc;
0
;;
let range args =
match args with
| [] -> All
| [x] ->
let x = integer x in
if x < 0 then (err "%d is negative\n" x; exit 1);
Only x
| [x;y] ->
let x = integer x in
if x < 0 then (err "%d is negative\n" x; exit 1);
let y = integer y in
if y < x then (err "%d is smaller than %d\n" y x; exit 1);
if x=0 then Upto y else Inter(x,y)
| _ -> (err "too many arguments\n"; exit 1)
;;
let dump after_hol f b =
let ml_file = Printf.sprintf "/tmp/dump%d.ml" (Unix.getpid()) in
log_gen ml_file;
let oc = open_out ml_file in
let use oc after_hol =
if after_hol then out oc "#use \"hol.ml\";;\nneeds \"%s\";;" f
else out oc "#use \"%s\";;" f
in
let cmd oc after_hol =
if after_hol then out oc " dump" else out oc " dump-before-hol" in
out oc
{|(* file generated with: hol2dk%a %s *)
#use "topfind";;
#require "camlp5";;
#load "camlp5o.cma";;
#require "unix";;
%a
close_out oc_dump;;
Sys.command ("mv "^dump_filename^" %s.prf");;
dump_nb_proofs "%s.nbp";;
dump_signature "%s.sig";;
#load "str.cma";;
#use "xnames.ml";;
dump_map_thid_name "%s.thm" %a;;
|} cmd after_hol f use after_hol b b b b
(olist ostring) (trans_file_deps (dep_graph (files())) f);
close_out oc;
Sys.command ("ocaml -w -A -I . "^ml_file)
;;
let basename_ml f =
match Filename.extension f with
| ".ml" | ".hl" -> Filename.chop_extension f
| _ -> err "\"%s\" does not end with \".ml\" or \".hl\"\n" f; exit 1
;;
let print_hstats() =
log "\nstring: %a\ntype: %a\nterm: %a\ntype_abbrev: %a\nterm_abbrev: %a\
\nsubterms: %a\nabbrev_part: %a\npart_abbrev_max: %a"
hstats (StrHashtbl.stats htbl_string)
hstats (TypHashtbl.stats htbl_type)
hstats (TrmHashtbl.stats htbl_term)
hstats (TypHashtbl.stats htbl_type_abbrev)
hstats (TrmHashtbl.stats htbl_term_abbrev)
hstats (TrmHashtbl.stats htbl_subterms)
hstats (Hashtbl.stats Xlp.htbl_abbrev_part)
hstats (Hashtbl.stats Xlp.htbl_abbrev_part_max)
;;
let valid_coq_filename s = match s with "at" -> "_"^s | _ -> s;;
let call_script s args =
match Sys.getenv_opt "HOL2DK_DIR" with
| None -> err "set $HOL2DK_DIR first\n"; 1
| Some d -> Sys.command (d^"/"^s^" "^String.concat " " args)
;;
let print_env_var n =
match Sys.getenv_opt n with
| None -> log "%s is undefined\n" n
| Some v -> log "%s = \"%s\"\n" n v
;;
let wrong_nb_args() = err "wrong number of arguments\n"; 1;;
let rec log_command l =
print_string "\nhol2dk";
List.iter (fun s -> print_char ' '; print_string s) l;
print_string " ...\n";
flush stdout;
command l
and dump_and_simp after_hol f =
let b = basename_ml f in
match dump after_hol f b with
| 0 -> begin match log_command ["pos";b] with
| 0 -> begin match log_command ["use";b] with
| 0 -> command ["simp";b]
| e -> e
end
| e -> e
end
| e -> e
and command = function
| [] | ["-"|"--help"|"help"] -> usage(); 0
| "--print-stats"::args -> at_exit print_hstats; command args
| "--use-sharing"::args -> use_sharing := true; command args
| "--max-abbrev-size"::k::args ->
Xlp.max_abbrev_part_size := integer k; command args
| "--max-proof-size"::k::args ->
Xlp.max_proof_part_size := integer k; command args
| s::_ when String.starts_with ~prefix:"--" s ->
err "unknown option \"%s\"\n" s; 1
| ["dep";f] ->
let dg = dep_graph (files()) in
log "%a\n" (list_sep " " string) (trans_file_deps dg f);
0
| ["dep"] ->
out_dep_graph stdout (dep_graph (files()));
0
| "dep"::_ -> wrong_nb_args()
| ["name";f] ->
log "%a\n" (list_sep "\n" string) (thms_of_file f);
0
| ["name";"upto";f] ->
let dg = dep_graph (files()) in
List.iter
(fun d -> List.iter (log "%s %s\n" d) (thms_of_file d))
(trans_file_deps dg f);
0
| ["name"] ->
List.iter
(fun f -> List.iter (log "%s %s\n" f) (thms_of_file f))
(files());
0
| "name"::_ -> wrong_nb_args()
| ["env"] -> print_env_var "HOL2DK_DIR"; print_env_var "HOLLIGHT_DIR"; 0
| "env"::_ -> wrong_nb_args()
| ["patch" as s] -> call_script s []
| "patch"::_ -> wrong_nb_args()
| ["unpatch" as s] -> call_script s []
| "unpatch"::_ -> wrong_nb_args()
| ["link";arg] -> call_script "add-links" [arg]
| "link"::_ -> wrong_nb_args()
| ["dump";f] -> dump true f (basename_ml f)
| "dump"::_ -> wrong_nb_args()
| ["dump-before-hol";f] -> dump false f (basename_ml f)
| "dump-before-hol"::_ -> wrong_nb_args()
| ["dump-simp";f] -> dump_and_simp true f
| "dump-simp"::_ -> wrong_nb_args()
| ["dump-simp-before-hol";f] -> dump_and_simp false f
| "dump-simp-before-hol"::_ -> wrong_nb_args()
| ["pos";b] ->
let nb_proofs = read_val (b^".nbp") in
let pos = Array.make nb_proofs 0 in
let dump_file = b^".prf" in
log_read dump_file;
let ic = open_in_bin dump_file in
let idx = ref 0 in
begin
try
while !idx < nb_proofs do
Array.set pos (!idx) (pos_in ic);
ignore (input_value ic);
incr idx;
done
with End_of_file -> assert false
end;
close_in ic;
let dump_file = b^".pos" in
log_gen dump_file;
let oc = open_out_bin dump_file in
output_value oc pos;
close_out oc;
0
| "pos"::_ -> wrong_nb_args()
| ["stat";b] ->
let nb_proofs = read_val (b^".nbp") in
let thm_uses = Array.make nb_proofs 0 in
let rule_uses = Array.make nb_rules 0 in
let unused = ref 0 in
read_use b;
let handle_proof k p =
if Array.get !Xproof.last_use k >= 0 then
(count_thm_uses thm_uses p; count_rule_uses rule_uses p)
else incr unused
in
read_prf b handle_proof;
print_string "compute statistics ...\n";
print_histogram thm_uses;
print_rule_uses rule_uses (nb_proofs - !unused);
0
| ["stat";b;s] ->
let nb_proofs = read_val (s^".nbp") in
let thm_uses = Array.make nb_proofs 0 in
let rule_uses = Array.make nb_rules 0 in
let unused = ref 0 in
read_use s;
let dump_file = b^".prf" in
log_read dump_file;
let ic = open_in_bin dump_file in
the_start_idx := read_val (s^".sti");
read_pos b;
seek_in ic (get_pos !the_start_idx);
let f k p =
if Array.get !Xproof.last_use k >= 0 then
(count_thm_uses thm_uses p; count_rule_uses rule_uses p)
else incr unused
in
for k = 0 to nb_proofs - 1 do f k (input_value ic) done;
close_in ic;
print_string "compute statistics ...\n";
print_histogram thm_uses;
print_rule_uses rule_uses (nb_proofs - !unused);
0
| "stat"::_ -> wrong_nb_args()
| ["nbp";b] -> log "%#d proof steps\n" (read_val (b^".nbp")); 0
| "nbp"::_ -> wrong_nb_args()
| ["size";b] -> command ["size";b;"0"]
| ["size";b;l] ->
let l = integer l in
read_use b;
init_proof_reading b;
let max_size = ref 0 and sum_size = ref 0 and nb_terms = ref 0
and nb_terms_gtl = ref 0 in
let handle_term t =
incr nb_terms;
let s = nb_cons t in
if s > !max_size then max_size := s;
if s > l then incr nb_terms_gtl;
sum_size := s + !sum_size
in
let handle_proof k p =
if Array.get !Xproof.last_use k >= 0 then
begin
let Proof(th,_) = p in
let hs,c = dest_thm th in
handle_term c; List.iter handle_term hs
end
in
read_prf b handle_proof;
log "%#d terms, average size = %#d, max size = %#d, \
%#d terms of size >%#d (%d%%)\n"
!nb_terms (!sum_size / !nb_terms) !max_size
!nb_terms_gtl l (percent !nb_terms_gtl !nb_terms);
0
| "size"::_ -> wrong_nb_args()
| ["proof";b;x;y] ->
let x = integer x and y = integer y in
let nb_proofs = read_val (b^".nbp") in
if x < 0 || y < x || y >= nb_proofs then
(err "[%d,%d] is not a valid interval\n" x y; exit 1);
read_pos b;
init_proof_reading b;
read_use b;
let map_thid_name = read_val (b^".thm") in
for k = x to y do
log "%8d: %a" k proof (proof_at k);
begin match Array.get !Xproof.last_use k with
| 0 -> (try log " (named %s)" (MapInt.find k map_thid_name)
with Not_found -> assert false)
| n -> if n < 0 then log " (unused)"
end;
log "\n"
done;
close_in !Xproof.ic_prf;
0
| ["proof";b;x] -> command ["proof";b;x;x]
| "proof"::_ -> wrong_nb_args()
| ["rewrite";b] ->
read_pos b;
init_proof_reading b;
read_use b;
let dump_file = b^"-simp.prf" in
log_gen dump_file;
let oc = open_out_bin dump_file in
(* count the number of simplications *)
let n = ref 0 in
(* map from theorem indexes to their new proofs *)
let map = ref MapInt.empty in
let add i c = map := MapInt.add i c !map in
let pc_at j =
match MapInt.find_opt j !map with
| Some c -> c
| None -> content_of (proof_at j)
in
(* simplification of proof p at index k *)
let simp k p =
let default() = output_value oc p in
let l = Array.get !last_use k in
if l < 0 then default() else
let out c = incr n; add k c; output_value oc (change_content p c) in
begin match content_of p with
| Ptrans(i,j) ->
let ci = pc_at i and cj = pc_at j in
begin match ci, cj with
| Prefl _, _ -> (* i:t=t j:t=u ==> k:t=u *) out cj
| _, Prefl _ -> (* i:t=u j:u=u ==> k:t=u *) out ci
| _ -> default()
end
| Psym i ->
let ci = pc_at i in
begin match ci with
| Prefl _ -> (* i:t=t ==> k:t=t *) out ci
| Psym j -> (* j:t=u ==> i:u=t ==> k:t=u *) out (pc_at j)
| _ -> default()
end
| Pconjunct1 i ->
begin match pc_at i with
| Pconj(j,_) -> (* j:p ==> i:p/\q ==> k:p *) out (pc_at j)
| _ -> default()
end
| Pconjunct2 i ->
begin match pc_at i with
| Pconj(_,j) -> (* j:q ==> i:p/\q ==> k:q *) out (pc_at j)
| _ -> default()
end
| Pmkcomb(i,j) ->
begin match pc_at i with
| Prefl t ->
begin match pc_at j with
| Prefl u -> (* i:t=t j:u=u ==> k:tu=tu *)
out (Prefl(mk_comb(t,u)))
| _ -> default()
end
| _ -> default()
end
| Peqmp(i,j) ->
begin match pc_at i with
| Prefl _ -> (* i:p=p j:p ==> k:p *) out (pc_at j)
| _ -> default()
end
| _ -> default()
end;
(* we can empty the map since the proofs coming after a named
theorem cannot refer to proofs coming before it *)
if l = 0 then map := MapInt.empty
in
for k = 0 to Array.length !prf_pos - 1 do simp k (proof_at k) done;
close_in !Xproof.ic_prf;
close_out oc;
let nb_proofs = Array.length !prf_pos in
log "%d simplifications (%d%%)\n" !n (percent !n nb_proofs);
(* replace file.prf by file-simp.prf, and recompute file.pos and
file.use *)
log "replace %s.prf by %s-simp.prf ...\n" b b;
begin match Sys.command (Printf.sprintf "mv %s-simp.prf %s.prf" b b) with
| 0 ->
begin match log_command ["pos";b] with
| 0 -> log_command ["use";b]
| e -> e
end
| e -> e
end
| "rewrite"::_ -> wrong_nb_args()
| ["purge";b] ->
(* compute useful theorems *)
read_pos b;
init_proof_reading b;
let map_thid_name = read_val (b^".thm") in
let nb_proofs = Array.length !prf_pos in
let useful = Array.make nb_proofs false in
let rec mark_as_useful = function
| [] -> ()
| k::ks ->
if useful.(k) then mark_as_useful ks
else begin
useful.(k) <- true;
mark_as_useful (List.rev_append (deps (proof_at k)) ks)
end
in
MapInt.iter (fun k _ -> mark_as_useful [k]) map_thid_name;
close_in !Xproof.ic_prf;
(* update file.use *)
read_use b;
let nb_useless = ref nb_proofs in
Array.iteri
(fun k b ->
if b then decr nb_useless else Array.set !Xproof.last_use k (-1))
useful;
let dump_file = b^".use" in
log_gen dump_file;
let oc = open_out_bin dump_file in
output_value oc !Xproof.last_use;
log "%d useless theorems (%d%%)\n"
!nb_useless (percent !nb_useless nb_proofs);
0
| "purge"::_ -> wrong_nb_args()
| ["simp";b] ->
begin match log_command ["rewrite";b] with
| 0 -> log_command ["purge";b]
| e -> e
end
| "simp"::_ -> wrong_nb_args()
| ["use";b] ->
(* The .use file records an array [last_use] such that
[last_use.(i) = 0] if [i] is a named theorem, the highest
theorem index using [i] if there is one, and -1 otherwise. *)
let nb_proofs = read_val (b^".nbp") in
let last_use = Array.make nb_proofs (-1) in
read_prf b
(fun i p -> List.iter (fun k -> Array.set last_use k i) (deps p));
MapInt.iter (fun k _ -> Array.set last_use k 0) (read_val (b^".thm"));
let dump_file = b^".use" in
log_gen dump_file;
let oc = open_out_bin dump_file in
output_value oc last_use;
let unused = ref 0 in
Array.iter (fun n -> if n < 0 then incr unused) last_use;
log "%d unused theorems (including named theorems) (%d%%)\n"
!unused (percent !unused nb_proofs);
close_out oc;
let first = ref (-1) in
let exception Found in
(try Array.iteri
(fun i j -> if j < 0 then (first := i; raise Found)) last_use
with Found -> ());
log "first unused: %d\n" !first;
0
| "use"::_ -> wrong_nb_args()
| ["print";"use";b;k] ->
let k = integer k in
let nb_proofs = read_val (b^".nbp") in
if k < 0 || k >= nb_proofs then
(err "%d is not a valid proof index\n" k; exit 1);
read_use b;
log "%d\n" (Array.get !Xproof.last_use k);
0
| "print"::"use"::_ -> wrong_nb_args()
| ["mk";nb_parts;b] ->
let nb_parts = integer nb_parts in
if nb_parts < 2 then (err "the number of parts must be > 1\n"; exit 1);
let nb_proofs = read_val (b^".nbp") in
let part_size = nb_proofs / nb_parts in
let part idx =
let k = idx / part_size in
if k >= nb_parts - 1 then nb_parts - 1 else k in
let dg = Array.init nb_parts (fun i -> Array.make i false) in
let add_dep x =
let px = part x in
fun y ->
let py = part y in
if px <> py then
begin
(*try*) dg.(px).(py) <- true (*dg.(px).(py) + 1*)
(*with (Invalid_argument _) as e ->
log "x = %d, px = %d, y = %d, py = %d\n%!" x px y py;
raise e*)
end
in
read_use b;
let handle_proof k p =
if Array.get !Xproof.last_use k >= 0 then
List.iter (add_dep k) (deps p)
in
read_prf b handle_proof;
for i = 1 to nb_parts - 1 do
log "%d:" (i+1);
for j = 0 to i - 1 do
(*if dg.(i).(j) > 0 then log " %d (%d)" (j+1) dg.(i).(j)*)
if dg.(i).(j) then log " %d" (j+1)
done;
log "\n"
done;
let dump_file = b^".dg" in
log_gen dump_file;
let oc = open_out_bin dump_file in
output_value oc nb_parts;
output_value oc dg;
close_out oc;
make nb_proofs dg b
| "mk"::_ -> wrong_nb_args()
| ["sig";f] ->
let dk = is_dk f in
let b = Filename.chop_extension f in
read_sig b;
if dk then
begin
Xdk.export_types b;
Xdk.export_terms b;
Xdk.export_axioms b
end
else
begin
Xlp.export_types b;
Xlp.export_terms b;
Xlp.export_axioms b
end;
0
| "sig"::_ -> wrong_nb_args()
| ["thm";f] ->
let dk = is_dk f in
let b = Filename.chop_extension f in
read_sig b;
let map_thid_name = read_val (b^".thm") in
read_pos b;
init_proof_reading b;
begin
if dk then Xdk.export_theorems b map_thid_name
else let nb_parts = read_val (b^".dg") in
Xlp.export_theorems_part nb_parts b map_thid_name
end;
close_in !Xproof.ic_prf;
0
| "thm"::_ -> wrong_nb_args()
| ["axm";f] ->
let dk = is_dk f in
let b = Filename.chop_extension f in
read_sig b;
let map_thid_name = read_val (b^".thm") in
read_pos b;
init_proof_reading b;
begin
if dk then Xdk.export_theorems_as_axioms b map_thid_name
else Xlp.export_theorems_as_axioms b map_thid_name
end;
close_in !Xproof.ic_prf;
0
| "axm"::_ -> wrong_nb_args()
| ["part";k;x;y;f] ->
let b = Filename.chop_extension f in
let dump_file = b^".dg" in
log_read dump_file;
let ic = open_in_bin dump_file in
let nb_parts = input_value ic in
let k = integer k and x = integer x and y = integer y in
if k < 1 || k > nb_parts || x < 0 || y < x then
(err "wrong part number or invalid interval\n"; exit 1);
read_sig b;
read_pos b;
init_proof_reading b;
read_use b;
if is_dk f then
begin
Xdk.export_proofs_part b k x y;
Xdk.export_term_abbrevs (b^part k);
Xdk.export_type_abbrevs (b^part k)
end
else
begin
let dg = input_value ic in
Xlp.export_proofs_part b dg k x y;
Xlp.export_term_abbrevs_in_one_file b (b^part k);
Xlp.export_type_abbrevs b (b^part k)
end;
close_in ic;
close_in !Xproof.ic_prf;
0
| "part"::_ -> wrong_nb_args()
| ["prfsize";b] ->
read_use b;
let size = Array.make (Array.length !Xproof.last_use) 0 in
read_prf b (fun k p ->
if get_use k >= 0 then Array.set size k (size_proof p));
write_val (b^".siz") size;
0
| "prfsize"::_ -> wrong_nb_args()
| ["thmsize";b;n] ->
init_proof_reading b;
read_use n;
read_pos n;
the_start_idx := read_val (n^".sti");
let size = Array.make (Array.length !Xproof.prf_pos) 0 in
(*let total = ref 0 in*)
Array.iteri (fun k pos ->
if Array.get !last_use k >= 0 then
begin
seek_in !ic_prf pos;
let s = size_proof (input_value !ic_prf) in
Array.set size k s;
(*total := !total + s*)
end)
!Xproof.prf_pos;
write_val (n^".siz") size;
(*log "size: %#d\n" !total;*)
0
| "thmsize"::_ -> wrong_nb_args()
| ["split";b] ->
read_pos b;
read_use b;
(*init_proof_reading b;*)
let map_thid_name = read_val (b^".thm") in
let map = ref MapInt.empty in
let create_segment start_index end_index =
let n = try valid_coq_filename (MapInt.find end_index map_thid_name)
with Not_found -> "thm"^string_of_int end_index in
let len = end_index - start_index + 1 in
write_val (n^".nbp") len;
write_val (n^".sti") start_index;
write_val (n^".pos") (Array.sub !prf_pos start_index len);
write_val (n^".use") (Array.sub !last_use start_index len);
let p = Array.get !prf_pos end_index in
map := MapInt.add end_index (n,p) !map;
(*let dump_file = n^".prf" in
log "write %s ...\n%!" dump_file;
let oc = open_out_bin dump_file in
seek_in !ic_prf (get_pos start_index);
for _k = 1 to len do
let p : proof = input_value !ic_prf in
output_value oc p
done;
close_out oc*)
in
let end_idx = ref (Array.length !prf_pos - 1) in
while Array.get !last_use !end_idx < 0 do decr end_idx done;
for k = !end_idx - 1 downto 0 do
let l = Array.get !last_use k in
if l = 0 || l > !end_idx then
begin
create_segment (k+1) !end_idx;
end_idx := k
end
done;
create_segment 0 !end_idx;
(*MapInt.iter (fun i (n,_) -> log "%d %s\n" i n) !map;*)
write_val (b^".thp") !map;
0
| "split"::_ -> wrong_nb_args()
| ["thmsplit";b;f] ->
let n = Filename.chop_extension f in