Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
What's new
10
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Open sidebar
Why3
why3
Commits
143d49dd
Commit
143d49dd
authored
Jan 22, 2018
by
Guillaume Melquiond
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Remove duplicate code in Coq printer.
parent
ef0af75d
Changes
1
Hide whitespace changes
Inline
Side-by-side
Showing
1 changed file
with
19 additions
and
65 deletions
+19
-65
src/printer/coq.ml
src/printer/coq.ml
+19
-65
No files found.
src/printer/coq.ml
View file @
143d49dd
...
...
@@ -185,7 +185,9 @@ let unambig_fs fs =
|
Tyvar
u
when
not
(
lookup
u
)
->
false
|
_
->
ty_all
inspect
ty
in
inspect
(
Opt
.
get
fs
.
ls_value
)
match
fs
.
ls_value
with
|
None
->
true
|
Some
v
->
inspect
v
(** Patterns, terms, and formulas *)
...
...
@@ -232,30 +234,10 @@ let print_label fmt (l,_) = fprintf fmt "(*%s*)" l
let
protect_on
x
s
=
if
x
then
"("
^^
s
^^
")"
else
s
let
rec
print_term
info
fmt
t
=
print_lrterm
false
false
info
fmt
t
and
print_fmla
info
fmt
f
=
print_lrfmla
false
false
info
fmt
f
and
print_opl_term
info
fmt
t
=
print_lrterm
true
false
info
fmt
t
and
print_opl_fmla
info
fmt
f
=
print_lrfmla
true
false
info
fmt
f
and
print_opr_term
info
fmt
t
=
print_lrterm
false
true
info
fmt
t
and
print_opr_fmla
info
fmt
f
=
print_lrfmla
false
true
info
fmt
f
and
print_lrterm
opl
opr
info
fmt
t
=
match
t
.
t_label
with
|
_
->
print_tnode
opl
opr
info
fmt
t
(*
| [] -> print_tnode opl opr info fmt t
| ll -> fprintf fmt "(%a %a)"
(print_list space print_label) ll (print_tnode false false info) t
*)
and
print_lrfmla
opl
opr
info
fmt
f
=
match
f
.
t_label
with
|
_
->
print_fnode
opl
opr
info
fmt
f
(*
| [] -> print_fnode opl opr info fmt f
| ll -> fprintf fmt "(%a %a)"
(print_list space print_label) ll (print_fnode false false info) f
*)
and
print_tnode
_opl
opr
info
fmt
t
=
match
t
.
t_node
with
let
rec
print_term
info
fmt
t
=
print_tnode
false
false
info
fmt
t
and
print_opl_term
info
fmt
f
=
print_tnode
true
false
info
fmt
f
and
print_opr_term
info
fmt
t
=
print_tnode
false
true
info
fmt
t
and
print_tnode
opl
opr
info
fmt
t
=
match
t
.
t_node
with
|
Tvar
v
->
print_vs
fmt
v
|
Tconst
c
->
...
...
@@ -278,9 +260,6 @@ and print_tnode _opl opr info fmt t = match t.t_node with
Number
.
def_real_support
=
Number
.
Number_unsupported
;
}
in
Number
.
print
number_format
fmt
c
|
Tif
(
f
,
t1
,
t2
)
->
fprintf
fmt
(
protect_on
opr
"@[<hov>if %a@ then %a@ else %a@]"
)
(
print_fmla
info
)
f
(
print_term
info
)
t1
(
print_opl_term
info
)
t2
|
Tlet
(
t1
,
tb
)
->
let
v
,
t2
=
t_open_bound
tb
in
fprintf
fmt
(
protect_on
opr
"@[<hov>let %a :=@[<hov 1>@ %a@] in@ %a@]"
)
...
...
@@ -295,7 +274,7 @@ and print_tnode _opl opr info fmt t = match t.t_node with
if
vl
=
[]
then
begin
let
v
,
f
=
t_open_bound
fb
in
fprintf
fmt
(
protect_on
opr
"@[<hov 1>epsilon %a.@ %a@]"
)
(
print_vsty
info
)
v
(
print_opl_
fmla
info
)
f
;
(
print_vsty
info
)
v
(
print_opl_
term
info
)
f
;
forget_var
v
end
else
begin
if
t0
.
t_ty
=
None
then
unsupportedTerm
t
...
...
@@ -325,20 +304,17 @@ and print_tnode _opl opr info fmt t = match t.t_node with
(
print_ls_real
info
)
fs
(
print_list
space
(
print_opr_term
info
))
tl
(
print_ty
info
)
(
t_type
t
)
end
|
Tquant
_
|
Tbinop
_
|
Tnot
_
|
Ttrue
|
Tfalse
->
raise
(
TermExpected
t
)
and
print_fnode
opl
opr
info
fmt
f
=
match
f
.
t_node
with
|
Tquant
(
Tforall
,
fq
)
->
let
vl
,_
tl
,
f
=
t_open_quant
fq
in
fprintf
fmt
(
protect_on
opr
"@[<hov>forall @[<hov>%a@],@ @[<hov>%a@]@]"
)
(
print_list
space
(
print_vsty
info
))
vl
(* (print_tl info) tl *)
(
print_
fmla
info
)
f
;
(* (print_tl info) tl *)
(
print_
term
info
)
f
;
List
.
iter
forget_var
vl
|
Tquant
(
Texists
,
fq
)
->
let
vl
,_
tl
,
f
=
t_open_quant
fq
in
let
rec
aux
fmt
vl
=
match
vl
with
|
[]
->
print_
fmla
info
fmt
f
|
[]
->
print_
term
info
fmt
f
|
v
::
vr
->
fprintf
fmt
(
protect_on
opr
"@[<hov>exists @[<hov>%a@],@ @[<hov>%a@]@]"
)
(
print_vsty_nopar
info
)
v
...
...
@@ -354,32 +330,16 @@ and print_fnode opl opr info fmt f = match f.t_node with
(
match
b
with
|
Tand
|
Tor
->
fprintf
fmt
(
protect_on
(
opl
||
opr
)
"@[<hov>%a %a@ %a@]"
)
(
print_opr_
fmla
info
)
f1
print_binop
b
(
print_opl_
fmla
info
)
f2
(
print_opr_
term
info
)
f1
print_binop
b
(
print_opl_
term
info
)
f2
|
Timplies
|
Tiff
->
fprintf
fmt
(
protect_on
(
opl
||
opr
)
"@[<hov>%a %a@ %a@]"
)
(
print_opr_
fmla
info
)
f1
print_binop
b
(
print_opl_
fmla
info
)
f2
)
(
print_opr_
term
info
)
f1
print_binop
b
(
print_opl_
term
info
)
f2
)
|
Tnot
f
->
fprintf
fmt
(
protect_on
opr
"@[<hov>~ %a@]"
)
(
print_opl_fmla
info
)
f
|
Tlet
(
t
,
f
)
->
let
v
,
f
=
t_open_bound
f
in
fprintf
fmt
(
protect_on
opr
"@[<hov>let %a :=@ @[<hov>%a@] in@ %a@]"
)
print_vs
v
(
print_term
info
)
t
(
print_opl_fmla
info
)
f
;
forget_var
v
|
Tcase
(
t
,
bl
)
->
fprintf
fmt
"@[<hov>match %a with@
\n
%a@
\n
end@]"
(
print_term
info
)
t
(
print_list
newline
(
print_fbranch
info
))
bl
fprintf
fmt
(
protect_on
opr
"@[<hov>~ %a@]"
)
(
print_opl_term
info
)
f
|
Tif
(
f1
,
f2
,
f3
)
->
fprintf
fmt
(
protect_on
opr
"@[<hov>if @[<hov>%a@] then@ @[<hov>%a@]@ else@ @[<hov>%a@]@]"
)
(
print_fmla
info
)
f1
(
print_fmla
info
)
f2
(
print_opl_fmla
info
)
f3
|
Tapp
(
ps
,
tl
)
->
begin
match
query_syntax
info
.
info_syn
ps
.
ls_name
with
|
Some
s
->
syntax_arguments
s
(
print_opr_term
info
)
fmt
tl
|
_
->
fprintf
fmt
"@[<hov 1>(%a%a)@]"
(
print_ls_real
info
)
ps
(
print_list_pre
space
(
print_opr_term
info
))
tl
end
|
Tvar
_
|
Tconst
_
|
Teps
_
->
raise
(
FmlaExpected
f
)
(
print_term
info
)
f1
(
print_term
info
)
f2
(
print_opl_term
info
)
f3
and
print_tbranch
info
fmt
br
=
let
p
,
t
=
t_open_branch
br
in
...
...
@@ -387,14 +347,8 @@ and print_tbranch info fmt br =
(
print_pat
info
)
p
(
print_term
info
)
t
;
Svs
.
iter
forget_var
p
.
pat_vars
and
print_fbranch
info
fmt
br
=
let
p
,
f
=
t_open_branch
br
in
fprintf
fmt
"@[<hov 4>| %a =>@ %a@]"
(
print_pat
info
)
p
(
print_fmla
info
)
f
;
Svs
.
iter
forget_var
p
.
pat_vars
let
print_expr
info
fmt
=
TermTF
.
t_select
(
print_term
info
fmt
)
(
print_
fmla
info
fmt
)
TermTF
.
t_select
(
print_term
info
fmt
)
(
print_
term
info
fmt
)
(** Declarations *)
...
...
@@ -880,7 +834,7 @@ let print_recursive_decl ~old info fmt dl =
List
.
iter
(
print_equivalence_lemma
~
old
info
fmt
)
dl_syn
let
print_ind
info
fmt
(
pr
,
f
)
=
fprintf
fmt
"@[<hov 4>| %a : %a@]"
print_pr
pr
(
print_
fmla
info
)
f
fprintf
fmt
"@[<hov 4>| %a : %a@]"
print_pr
pr
(
print_
term
info
)
f
let
print_ind_decl
info
fmt
ps
bl
=
let
_
,
_
,
all_ty_params
=
ls_ty_vars
ps
in
...
...
@@ -919,16 +873,16 @@ let print_prop_decl ~prev info fmt (k,pr,f) =
|
Some
(
Axiom
_
)
when
stt
=
"Lemma"
->
fprintf
fmt
"(* Why3 goal *)@
\n
@[<hv 2>Hypothesis %a :@ @[<hov>%a%a.@]@]@
\n
@
\n
"
print_pr
pr
(
print_params
info
~
whytypes
:
true
)
params
(
print_
fmla
info
)
f
(
print_
term
info
)
f
|
_
->
fprintf
fmt
"(* Why3 goal *)@
\n
@[<hv 2>%s %a :@ @[<hv>%a@[<hov>%a.@]@]@]@
\n
%a@
\n
"
stt
print_pr
pr
(
print_params
info
~
whytypes
:
true
)
params
(
print_
fmla
info
)
f
(
print_
term
info
)
f
(
print_previous_proof
(
Some
(
params
,
f
))
info
)
prev
else
fprintf
fmt
"@[<hv 2>Axiom %a :@ @[%a%a.@]@]@
\n
@
\n
"
print_pr
pr
(
print_params
info
~
whytypes
:
true
)
params
(
print_
fmla
info
)
f
;
(
print_
term
info
)
f
;
forget_tvs
()
let
print_decl
~
old
info
fmt
d
=
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment