Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
Why3
why3
Commits
30dda877
Commit
30dda877
authored
Sep 30, 2011
by
Andrei Paskevich
Browse files
qualified names + Add Rec LoadPath in Coq printer
parent
b92e64bc
Changes
1
Hide whitespace changes
Inline
Side-by-side
src/printer/coq.ml
View file @
30dda877
...
...
@@ -104,6 +104,26 @@ type info = {
realization
:
(
Theory
.
theory
*
ident_printer
)
Mid
.
t
option
;
}
let
print_path
=
print_list
(
constant_string
"."
)
string
let
print_id
fmt
id
=
string
fmt
(
id_unique
iprinter
id
)
let
print_id_real
info
fmt
id
=
match
info
.
realization
with
|
Some
m
->
begin
try
let
th
,
ipr
=
Mid
.
find
id
m
in
fprintf
fmt
"%a.%s.%s"
print_path
th
.
Theory
.
th_path
th
.
Theory
.
th_name
.
id_string
(
id_unique
ipr
id
)
with
Not_found
->
print_id
fmt
id
end
|
None
->
print_id
fmt
id
let
print_ls_real
info
fmt
ls
=
print_id_real
info
fmt
ls
.
ls_name
let
print_ts_real
info
fmt
ts
=
print_id_real
info
fmt
ts
.
ts_name
let
print_pr_real
info
fmt
pr
=
print_id_real
info
fmt
pr
.
pr_name
(** Types *)
let
rec
print_ty
info
fmt
ty
=
match
ty
.
ty_node
with
...
...
@@ -121,8 +141,8 @@ let rec print_ty info fmt ty = match ty.ty_node with
|
None
->
begin
match
tl
with
|
[]
->
print_ts
fmt
ts
|
l
->
fprintf
fmt
"(%a@ %a)"
print_ts
ts
|
[]
->
(
print_ts
_real
info
)
fmt
ts
|
l
->
fprintf
fmt
"(%a@ %a)"
(
print_ts
_real
info
)
ts
(
print_list
space
(
print_ty
info
))
l
end
end
...
...
@@ -163,9 +183,9 @@ let rec print_pat info fmt p = match p.pat_node with
|
Papp
(
cs
,
pl
)
->
begin
match
query_syntax
info
.
info_syn
cs
.
ls_name
with
|
Some
s
->
syntax_arguments
s
(
print_pat
info
)
fmt
pl
|
_
when
pl
=
[]
->
print_ls
fmt
cs
|
_
when
pl
=
[]
->
(
print_ls
_real
info
)
fmt
cs
|
_
->
fprintf
fmt
"(%a %a)"
print_ls
cs
(
print_list
space
(
print_pat
info
))
pl
(
print_ls
_real
info
)
cs
(
print_list
space
(
print_pat
info
))
pl
end
let
print_vsty_nopar
info
fmt
v
=
...
...
@@ -250,10 +270,10 @@ and print_tnode opl opr info fmt t = match t.t_node with
syntax_arguments
s
(
print_term
info
)
fmt
tl
|
_
->
if
unambig_fs
fs
then
if
tl
=
[]
then
fprintf
fmt
"%a"
print_ls
fs
else
fprintf
fmt
"(%a %a)"
print_ls
fs
if
tl
=
[]
then
fprintf
fmt
"%a"
(
print_ls
_real
info
)
fs
else
fprintf
fmt
"(%a %a)"
(
print_ls
_real
info
)
fs
(
print_space_list
(
print_term
info
))
tl
else
fprintf
fmt
(
protect_on
opl
"(%a%a:%a)"
)
print_ls
fs
else
fprintf
fmt
(
protect_on
opl
"(%a%a:%a)"
)
(
print_ls
_real
info
)
fs
(
print_paren_r
(
print_term
info
))
tl
(
print_ty
info
)
(
t_type
t
)
end
|
Tquant
_
|
Tbinop
_
|
Tnot
_
|
Ttrue
|
Tfalse
->
raise
(
TermExpected
t
)
...
...
@@ -301,7 +321,7 @@ and print_fnode opl opr info fmt f = match f.t_node with
|
Tapp
(
ps
,
tl
)
->
begin
match
query_syntax
info
.
info_syn
ps
.
ls_name
with
|
Some
s
->
syntax_arguments
s
(
print_term
info
)
fmt
tl
|
_
->
fprintf
fmt
"(%a %a)"
print_ls
ps
|
_
->
fprintf
fmt
"(%a %a)"
(
print_ls
_real
info
)
ps
(
print_space_list
(
print_term
info
))
tl
end
|
Tvar
_
|
Tconst
_
|
Teps
_
->
raise
(
FmlaExpected
f
)
...
...
@@ -665,24 +685,31 @@ let init_printer th =
Sid
.
iter
(
fun
id
->
ignore
(
id_unique
pr
id
))
th
.
Theory
.
th_local
;
pr
let
print_task
_
env
pr
thpr
realize
?
old
fmt
task
=
let
print_task
env
pr
thpr
realize
?
old
fmt
task
=
forget_all
()
;
print_prelude
fmt
pr
;
print_th_prelude
task
fmt
thpr
;
let
realization
,
decls
=
if
realize
then
let
used
=
Task
.
used_theories
task
in
let
used
=
Mid
.
filter
(
fun
_
th
->
th
.
Theory
.
th_path
<>
[]
)
used
in
(* 2 cases: goal is clone T with [] or goal is a real goal *)
let
used
=
match
task
with
|
None
->
assert
false
|
Some
{
Task
.
task_decl
=
{
Theory
.
td_node
=
Theory
.
Clone
(
th
,_
)
}}
->
Sid
.
iter
(
fun
id
->
ignore
(
id_unique
iprinter
id
))
th
.
Theory
.
th_local
;
Sid
.
iter
(
fun
id
->
ignore
(
id_unique
iprinter
id
))
th
.
Theory
.
th_local
;
Mid
.
remove
th
.
Theory
.
th_name
used
|
_
->
used
in
(* output the Require commands *)
List
.
iter
(
fprintf
fmt
"Add Rec LoadPath
\"
%s
\"
.@
\n
"
)
(
Env
.
get_loadpath
env
);
Mid
.
iter
(
fun
id
_th
->
fprintf
fmt
"Require %s.@."
id
.
id_string
)
(
fun
id
th
->
fprintf
fmt
"Require %a.%s.@
\n
"
print_path
th
.
Theory
.
th_path
id
.
id_string
)
used
;
let
symbols
=
Task
.
used_symbols
used
in
(* build the printers for each theories *)
...
...
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