Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
why3
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Issues
119
Issues
119
List
Boards
Labels
Service Desk
Milestones
Merge Requests
16
Merge Requests
16
Operations
Operations
Incidents
Packages & Registries
Packages & Registries
Container Registry
Analytics
Analytics
Repository
Value Stream
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Commits
Issue Boards
Open sidebar
Why3
why3
Commits
32893b03
Commit
32893b03
authored
Oct 21, 2012
by
Andrei Paskevich
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
move [MSH]str and [MSH]int from Util to Stdlib
Util now is a small module containing misc functions.
parent
ba635d27
Changes
89
Hide whitespace changes
Inline
Side-by-side
Showing
89 changed files
with
461 additions
and
474 deletions
+461
-474
Makefile.in
Makefile.in
+2
-2
examples/runstrat/runstrat.ml
examples/runstrat/runstrat.ml
+1
-1
plugins/parser/genequlin.ml
plugins/parser/genequlin.ml
+3
-3
plugins/tptp/tptp_typing.ml
plugins/tptp/tptp_typing.ml
+23
-23
plugins/tptp/tptp_typing.mli
plugins/tptp/tptp_typing.mli
+1
-1
src/coq-tactic/why3tac.ml
src/coq-tactic/why3tac.ml
+3
-3
src/core/decl.ml
src/core/decl.ml
+4
-4
src/core/env.ml
src/core/env.ml
+21
-15
src/core/env.mli
src/core/env.mli
+1
-1
src/core/ident.ml
src/core/ident.ml
+2
-3
src/core/pattern.ml
src/core/pattern.ml
+1
-1
src/core/pretty.ml
src/core/pretty.ml
+1
-1
src/core/printer.ml
src/core/printer.ml
+3
-3
src/core/task.ml
src/core/task.ml
+1
-1
src/core/task.mli
src/core/task.mli
+1
-1
src/core/term.ml
src/core/term.ml
+17
-13
src/core/theory.ml
src/core/theory.ml
+9
-11
src/core/theory.mli
src/core/theory.mli
+0
-1
src/core/trans.ml
src/core/trans.ml
+2
-2
src/core/trans.mli
src/core/trans.mli
+1
-1
src/core/ty.ml
src/core/ty.ml
+11
-11
src/driver/autodetection.ml
src/driver/autodetection.ml
+4
-5
src/driver/driver.ml
src/driver/driver.ml
+4
-4
src/driver/whyconf.ml
src/driver/whyconf.ml
+3
-4
src/driver/whyconf.mli
src/driver/whyconf.mli
+6
-6
src/ide/gmain.ml
src/ide/gmain.ml
+7
-7
src/main.ml
src/main.ml
+1
-1
src/parser/denv.ml
src/parser/denv.ml
+1
-1
src/parser/denv.mli
src/parser/denv.mli
+1
-1
src/parser/lexer.mli
src/parser/lexer.mli
+1
-1
src/parser/typing.ml
src/parser/typing.ml
+37
-37
src/parser/typing.mli
src/parser/typing.mli
+1
-1
src/printer/coq.ml
src/printer/coq.ml
+1
-1
src/printer/pvs.ml
src/printer/pvs.ml
+1
-1
src/printer/why3printer.ml
src/printer/why3printer.ml
+1
-1
src/programs/pgm_main.ml
src/programs/pgm_main.ml
+1
-1
src/programs/pgm_module.ml
src/programs/pgm_module.ml
+1
-1
src/programs/pgm_module.mli
src/programs/pgm_module.mli
+1
-1
src/programs/pgm_types.mli
src/programs/pgm_types.mli
+1
-1
src/programs/pgm_typing.ml
src/programs/pgm_typing.ml
+1
-1
src/programs/pgm_wp.ml
src/programs/pgm_wp.ml
+1
-1
src/session/session.ml
src/session/session.ml
+15
-15
src/session/session.mli
src/session/session.mli
+2
-1
src/session/termcode.ml
src/session/termcode.ml
+1
-1
src/transform/discriminate.ml
src/transform/discriminate.ml
+3
-3
src/transform/eliminate_algebraic.ml
src/transform/eliminate_algebraic.ml
+4
-4
src/transform/eliminate_if.ml
src/transform/eliminate_if.ml
+2
-3
src/transform/encoding.ml
src/transform/encoding.ml
+1
-1
src/transform/encoding_decoexp.ml
src/transform/encoding_decoexp.ml
+2
-2
src/transform/encoding_decorate.ml
src/transform/encoding_decorate.ml
+2
-2
src/transform/encoding_explicit.ml
src/transform/encoding_explicit.ml
+1
-1
src/transform/encoding_guard.ml
src/transform/encoding_guard.ml
+1
-1
src/transform/encoding_instantiate.ml
src/transform/encoding_instantiate.ml
+3
-4
src/transform/encoding_select.ml
src/transform/encoding_select.ml
+2
-2
src/transform/encoding_sort.ml
src/transform/encoding_sort.ml
+1
-1
src/transform/encoding_twin.ml
src/transform/encoding_twin.ml
+2
-2
src/transform/inlining.ml
src/transform/inlining.ml
+5
-5
src/transform/libencoding.ml
src/transform/libencoding.ml
+2
-2
src/transform/simplify_recursive_definition.ml
src/transform/simplify_recursive_definition.ml
+1
-1
src/util/rc.mli
src/util/rc.mli
+1
-1
src/util/rc.mll
src/util/rc.mll
+1
-1
src/util/stdlib.ml
src/util/stdlib.ml
+79
-0
src/util/stdlib.mli
src/util/stdlib.mli
+47
-0
src/util/util.ml
src/util/util.ml
+0
-83
src/util/util.mli
src/util/util.mli
+1
-51
src/why3bench/bench.ml
src/why3bench/bench.ml
+1
-1
src/why3bench/benchdb.ml
src/why3bench/benchdb.ml
+2
-2
src/why3bench/benchrc.ml
src/why3bench/benchrc.ml
+1
-1
src/why3bench/benchrc.mli
src/why3bench/benchrc.mli
+1
-1
src/why3bench/db.ml
src/why3bench/db.ml
+6
-6
src/why3bench/db.mli
src/why3bench/db.mli
+3
-3
src/why3bench/why3bench.ml
src/why3bench/why3bench.ml
+1
-1
src/why3doc/doc_main.ml
src/why3doc/doc_main.ml
+1
-1
src/why3session/why3session_html.ml
src/why3session/why3session_html.ml
+5
-4
src/why3session/why3session_info.ml
src/why3session/why3session_info.ml
+1
-1
src/why3session/why3session_latex.ml
src/why3session/why3session_latex.ml
+10
-10
src/whyml/mlw_decl.ml
src/whyml/mlw_decl.ml
+2
-2
src/whyml/mlw_driver.ml
src/whyml/mlw_driver.ml
+1
-1
src/whyml/mlw_expr.ml
src/whyml/mlw_expr.ml
+2
-2
src/whyml/mlw_expr.mli
src/whyml/mlw_expr.mli
+0
-1
src/whyml/mlw_main.ml
src/whyml/mlw_main.ml
+1
-1
src/whyml/mlw_main.mli
src/whyml/mlw_main.mli
+2
-2
src/whyml/mlw_module.ml
src/whyml/mlw_module.ml
+2
-2
src/whyml/mlw_module.mli
src/whyml/mlw_module.mli
+1
-1
src/whyml/mlw_ocaml.ml
src/whyml/mlw_ocaml.ml
+4
-14
src/whyml/mlw_ty.ml
src/whyml/mlw_ty.ml
+11
-10
src/whyml/mlw_typing.ml
src/whyml/mlw_typing.ml
+33
-33
src/whyml/mlw_typing.mli
src/whyml/mlw_typing.mli
+1
-1
src/whyml/mlw_wp.ml
src/whyml/mlw_wp.ml
+7
-7
No files found.
Makefile.in
View file @
32893b03
...
...
@@ -108,8 +108,8 @@ LIBGENERATED = src/util/config.ml src/util/rc.ml src/parser/lexer.ml \
src/driver/driver_parser.mli src/driver/driver_parser.ml
\
src/driver/driver_lexer.ml src/session/xml.ml
LIB_UTIL
=
config
opt lists strings extmap exthtbl stdlib
\
exn_printer pp debug loc print_tree
\
LIB_UTIL
=
config
util opt lists strings extmap exthtbl weakhtbl
\
hashcons stdlib
exn_printer pp debug loc print_tree
\
cmdline weakhtbl hashcons util warning sysutil rc plugin
LIB_CORE
=
ident ty term pattern decl theory task pretty
env
trans printer
...
...
examples/runstrat/runstrat.ml
View file @
32893b03
...
...
@@ -20,7 +20,7 @@
open
Format
open
Why3
open
Util
open
Stdlib
open
Whyconf
open
Theory
open
Task
...
...
plugins/parser/genequlin.ml
View file @
32893b03
...
...
@@ -45,7 +45,7 @@ open Why3
open
Theory
open
Term
open
Util
open
Stdlib
open
Ident
...
...
@@ -80,10 +80,10 @@ let read_channel env path filename cin =
(** create a set of constraints *)
let
create_fmla
nvar
m
k
=
let
lvar
=
mapi
(
fun
_
->
create_vsymbol
(
id_fresh
"x"
)
Ty
.
ty_int
)
let
lvar
=
Util
.
mapi
(
fun
_
->
create_vsymbol
(
id_fresh
"x"
)
Ty
.
ty_int
)
1
nvar
in
let
lt
=
List
.
map
t_var
lvar
in
let
lits
=
foldi
(
create_lit
lt
k
)
t_true
1
m
in
let
lits
=
Util
.
foldi
(
create_lit
lt
k
)
t_true
1
m
in
t_forall_close
lvar
[]
(
t_implies_simp
lits
t_false
)
in
(** read the first line *)
...
...
plugins/tptp/tptp_typing.ml
View file @
32893b03
...
...
@@ -13,7 +13,7 @@ open Format
open
Tptp_ast
open
Why3
open
Util
open
Stdlib
open
Ident
open
Ty
open
Term
...
...
@@ -60,7 +60,7 @@ type symbol =
(* dead code
type env = symbol Mstr.t
type implicit =
(string,symbol) Hashtbl
.t
type implicit =
symbol Hstr
.t
*)
(** Defined symbols : arithmetic etc... *)
...
...
@@ -107,7 +107,7 @@ let make_denv lib =
let
add_theory
env
impl
th
=
let
s
=
"$th$"
^
th
.
th_name
.
id_string
in
if
not
(
Mstr
.
mem
s
env
)
then
H
ashtbl
.
replace
impl
s
(
Suse
th
)
if
not
(
Mstr
.
mem
s
env
)
then
H
str
.
replace
impl
s
(
Suse
th
)
let
defined_ty
~
loc
denv
env
impl
dw
tyl
=
let
ts
=
match
dw
with
...
...
@@ -208,9 +208,9 @@ let defined_expr ~loc is_fmla denv env impl dw tl = match dw, tl with
let
find_tv
~
loc
env
impl
s
=
let
tv
=
try
Mstr
.
find
s
env
with
Not_found
->
try
H
ashtbl
.
find
impl
s
with
Not_found
->
try
H
str
.
find
impl
s
with
Not_found
->
let
tv
=
STVar
(
create_tvsymbol
(
id_user
s
loc
))
in
H
ashtbl
.
add
impl
s
tv
;
H
str
.
add
impl
s
tv
;
tv
in
match
tv
with
|
STVar
tv
->
ty_var
tv
...
...
@@ -219,9 +219,9 @@ let find_tv ~loc env impl s =
let
find_vs
~
loc
denv
env
impl
s
=
let
vs
=
try
Mstr
.
find
s
env
with
Not_found
->
try
H
ashtbl
.
find
impl
s
with
Not_found
->
try
H
str
.
find
impl
s
with
Not_found
->
let
vs
=
SVar
(
create_vsymbol
(
id_user
s
loc
)
denv
.
ty_univ
)
in
H
ashtbl
.
add
impl
s
vs
;
H
str
.
add
impl
s
vs
;
vs
in
match
vs
with
|
SVar
vs
->
t_var
vs
...
...
@@ -229,11 +229,11 @@ let find_vs ~loc denv env impl s =
let
find_ts
~
loc
env
impl
s
args
=
let
ts
=
try
Mstr
.
find
s
env
with
Not_found
->
try
H
ashtbl
.
find
impl
s
with
Not_found
->
try
H
str
.
find
impl
s
with
Not_found
->
let
args
=
List
.
map
(
fun
_
->
create_tvsymbol
(
id_fresh
"a"
))
args
in
let
ss
=
if
s
=
"int"
||
s
=
"real"
then
"_"
^
s
else
s
in
let
ts
=
SType
(
create_tysymbol
(
id_user
ss
loc
)
args
None
)
in
H
ashtbl
.
add
impl
s
ts
;
H
str
.
add
impl
s
ts
;
ts
in
match
ts
with
|
SType
ts
->
ts
...
...
@@ -241,29 +241,29 @@ let find_ts ~loc env impl s args =
let
find_fs
~
loc
denv
env
impl
s
args
=
try
Mstr
.
find
s
env
with
Not_found
->
try
H
ashtbl
.
find
impl
s
with
Not_found
->
try
H
str
.
find
impl
s
with
Not_found
->
let
args
=
List
.
map
(
fun
_
->
denv
.
ty_univ
)
args
in
let
fs
=
create_fsymbol
(
id_user
s
loc
)
args
denv
.
ty_univ
in
let
fs
=
SFunc
([]
,
[]
,
Stv
.
empty
,
fs
)
in
H
ashtbl
.
add
impl
s
fs
;
H
str
.
add
impl
s
fs
;
fs
let
find_ps
~
loc
denv
env
impl
s
args
=
try
Mstr
.
find
s
env
with
Not_found
->
try
H
ashtbl
.
find
impl
s
with
Not_found
->
try
H
str
.
find
impl
s
with
Not_found
->
let
args
=
List
.
map
(
fun
_
->
denv
.
ty_univ
)
args
in
let
ps
=
create_psymbol
(
id_user
s
loc
)
args
in
let
ps
=
SPred
([]
,
[]
,
Stv
.
empty
,
ps
)
in
H
ashtbl
.
add
impl
s
ps
;
H
str
.
add
impl
s
ps
;
ps
let
find_dobj
~
loc
denv
env
impl
s
=
let
ds
=
"$do$"
^
s
in
let
fs
=
try
Mstr
.
find
ds
env
with
Not_found
->
try
H
ashtbl
.
find
impl
ds
with
Not_found
->
try
H
str
.
find
impl
ds
with
Not_found
->
let
id
=
id_user
(
"do_"
^
s
)
loc
in
let
fs
=
Sdobj
(
create_fsymbol
id
[]
denv
.
ty_univ
)
in
H
ashtbl
.
add
impl
ds
fs
;
H
str
.
add
impl
ds
fs
;
fs
in
match
fs
with
|
Sdobj
fs
->
fs_app
fs
[]
denv
.
ty_univ
...
...
@@ -369,7 +369,7 @@ and fmla denv env impl pol tvl { e_loc = loc; e_node = n } = match n with
let
sk
=
Format
.
sprintf
"_%s_%d_%d"
s
ln
cn
in
let
ts
=
create_tysymbol
(
id_user
sk
loc
)
tvl
None
in
let
tv
=
ty_app
ts
(
List
.
map
ty_var
tvl
)
in
H
ashtbl
.
add
impl
sk
(
SType
ts
);
H
str
.
add
impl
sk
(
SType
ts
);
Mstr
.
add
s
(
STSko
tv
)
env
,
pol
,
tvl
,
vl
,
true
else
let
ty
=
ty
denv
env
impl
e
in
...
...
@@ -535,7 +535,7 @@ let typedecl denv env impl loc s (tvl,(el,e)) =
in
let
ss
=
if
s
=
"int"
||
s
=
"real"
then
"_"
^
s
else
s
in
let
ts
=
create_tysymbol
(
id_user
ss
loc
)
(
List
.
map
ntv
el
)
None
in
H
ashtbl
.
add
impl
s
(
SType
ts
)
H
str
.
add
impl
s
(
SType
ts
)
else
(* function/predicate symbol *)
let
ntv
(
s
,
{
e_node
=
n
;
e_loc
=
loc
})
=
match
n
with
...
...
@@ -558,7 +558,7 @@ let typedecl denv env impl loc s (tvl,(el,e)) =
let
tyl
=
List
.
map
ghost
gvl
@
tyl
in
let
ls
=
create_psymbol
(
id_user
s
loc
)
tyl
in
if
gvl
<>
[]
then
add_theory
env
impl
denv
.
th_ghost
;
H
ashtbl
.
add
impl
s
(
SPred
(
tvl
,
gvl
,
mvs
,
ls
))
H
str
.
add
impl
s
(
SPred
(
tvl
,
gvl
,
mvs
,
ls
))
else
let
tyv
=
ty
denv
env
impl
e
in
let
tvs
=
ty_freevars
tvs
tyv
in
...
...
@@ -566,7 +566,7 @@ let typedecl denv env impl loc s (tvl,(el,e)) =
let
tyl
=
List
.
map
ghost
gvl
@
tyl
in
let
ls
=
create_fsymbol
(
id_user
s
loc
)
tyl
tyv
in
if
gvl
<>
[]
then
add_theory
env
impl
denv
.
th_ghost
;
H
ashtbl
.
add
impl
s
(
SFunc
(
tvl
,
gvl
,
mvs
,
ls
))
H
str
.
add
impl
s
(
SFunc
(
tvl
,
gvl
,
mvs
,
ls
))
let
flush_impl
~
strict
env
uc
impl
=
let
update_th
_
e
uc
=
match
e
with
...
...
@@ -603,16 +603,16 @@ let flush_impl ~strict env uc impl =
(* none of these is possible in implicit *)
|
SletF
_
|
SletP
_
|
STSko
_
->
assert
false
in
let
uc
=
H
ashtbl
.
fold
update_th
impl
uc
in
let
res
=
H
ashtbl
.
fold
update
impl
(
env
,
uc
)
in
H
ashtbl
.
clear
impl
;
let
uc
=
H
str
.
fold
update_th
impl
uc
in
let
res
=
H
str
.
fold
update
impl
(
env
,
uc
)
in
H
str
.
clear
impl
;
res
let
typecheck
lib
path
ast
=
(* initial environment *)
let
env
=
Mstr
.
empty
in
let
denv
=
make_denv
lib
in
let
impl
=
H
ashtbl
.
create
17
in
let
impl
=
H
str
.
create
17
in
add_theory
env
impl
denv
.
th_univ
;
(* parsing function *)
let
conj
=
ref
false
in
...
...
plugins/tptp/tptp_typing.mli
View file @
32893b03
...
...
@@ -10,5 +10,5 @@
(********************************************************************)
val
typecheck
:
unit
Why3
.
Env
.
library
->
Why3
.
Env
.
pathname
->
Tptp_ast
.
tptp_file
->
Why3
.
Theory
.
theory
Why3
.
Util
.
Mstr
.
t
Tptp_ast
.
tptp_file
->
Why3
.
Theory
.
theory
Why3
.
Stdlib
.
Mstr
.
t
src/coq-tactic/why3tac.ml
View file @
32893b03
...
...
@@ -675,11 +675,11 @@ and decompose_definition dep env c =
|
Some
b
->
let
tvs
=
List
.
fold_left
Ty
.
ty_freevars
Stv
.
empty
(
Ty
.
oty_cons
ls
.
ls_args
ls
.
ls_value
)
in
let
add
tv
tvm
=
Util
.
Mstr
.
add
tv
.
tv_name
.
Ident
.
id_string
tv
tvm
in
let
tvm
=
Stv
.
fold
add
tvs
Util
.
Mstr
.
empty
in
let
add
tv
tvm
=
Stdlib
.
Mstr
.
add
tv
.
tv_name
.
Ident
.
id_string
tv
tvm
in
let
tvm
=
Stv
.
fold
add
tvs
Stdlib
.
Mstr
.
empty
in
let
ty
=
Global
.
type_of_global
r
in
let
(
_
,
vars
)
,
env
,
_
=
decomp_type_quantifiers
env
ty
in
let
conv
tv
=
Util
.
Mstr
.
find
tv
.
tv_name
.
Ident
.
id_string
tvm
in
let
conv
tv
=
Stdlib
.
Mstr
.
find
tv
.
tv_name
.
Ident
.
id_string
tvm
in
let
vars
=
List
.
map
conv
vars
in
let
tvm
,
env
,
b
=
decomp_type_lambdas
Idmap
.
empty
env
vars
b
in
let
(
bv
,
vsl
)
,
env
,
b
=
...
...
src/core/decl.ml
View file @
32893b03
...
...
@@ -9,7 +9,7 @@
(* *)
(********************************************************************)
open
Util
open
Stdlib
open
Ident
open
Ty
open
Term
...
...
@@ -260,7 +260,7 @@ type prsymbol = {
pr_name
:
ident
;
}
module
Prop
=
WeakStructMake
(
struct
module
Prop
=
MakeMSHW
(
struct
type
t
=
prsymbol
let
tag
pr
=
pr
.
pr_name
.
id_tag
end
)
...
...
@@ -366,7 +366,7 @@ module Hsdecl = Hashcons.Make (struct
end
)
module
Decl
=
WeakStructMake
(
struct
module
Decl
=
MakeMSHW
(
struct
type
t
=
decl
let
tag
d
=
d
.
d_tag
end
)
...
...
@@ -621,7 +621,7 @@ let merge_known kn1 kn2 =
Mid
.
union
check_known
kn1
kn2
let
known_add_decl
kn0
decl
=
let
kn
=
Mid
.
map
(
const
decl
)
decl
.
d_news
in
let
kn
=
Mid
.
map
(
Util
.
const
decl
)
decl
.
d_news
in
let
check
id
decl0
_
=
if
d_equal
decl0
decl
then
raise
(
KnownIdent
id
)
...
...
src/core/env.ml
View file @
32893b03
...
...
@@ -9,7 +9,7 @@
(* *)
(********************************************************************)
open
Util
open
Stdlib
open
Ident
open
Theory
...
...
@@ -47,16 +47,16 @@ let create_env = let c = ref (-1) in fun lp -> {
let
get_loadpath
env
=
Sstr
.
elements
env
.
env_path
let
read_format_table
=
H
ashtbl
.
create
17
(* format name -> read_format *)
let
extensions_table
=
H
ashtbl
.
create
17
(* suffix -> format name *)
let
read_format_table
=
H
str
.
create
17
(* format name -> read_format *)
let
extensions_table
=
H
str
.
create
17
(* suffix -> format name *)
let
lookup_format
name
=
try
H
ashtbl
.
find
read_format_table
name
try
H
str
.
find
read_format_table
name
with
Not_found
->
raise
(
UnknownFormat
name
)
let
list_formats
()
=
let
add
n
(
_
,_,
l
,
desc
)
acc
=
(
n
,
l
,
desc
)
::
acc
in
H
ashtbl
.
fold
add
read_format_table
[]
H
str
.
fold
add
read_format_table
[]
let
get_extension
file
=
let
s
=
try
Filename
.
chop_extension
file
...
...
@@ -66,7 +66,7 @@ let get_extension file =
let
get_format
file
=
let
ext
=
get_extension
file
in
try
H
ashtbl
.
find
extensions_table
ext
try
H
str
.
find
extensions_table
ext
with
Not_found
->
raise
(
UnknownExtension
ext
)
let
read_channel
?
format
env
file
ic
=
...
...
@@ -118,11 +118,17 @@ exception CircularDependency of pathname
type
'
a
contents
=
'
a
*
theory
Mstr
.
t
module
Hpath
=
Hashtbl
.
Make
(
struct
type
t
=
pathname
let
hash
=
Hashtbl
.
hash
let
equal
=
(
=
)
end
)
type
'
a
library
=
{
lib_env
:
env
;
lib_read
:
'
a
read_format
;
lib_exts
:
extension
list
;
lib_memo
:
(
pathname
,
'
a
contents
option
)
Hashtbl
.
t
;
lib_memo
:
(
'
a
contents
option
)
Hpath
.
t
;
}
and
'
a
read_format
=
...
...
@@ -132,7 +138,7 @@ let mk_library read exts env = {
lib_env
=
env
;
lib_read
=
read
;
lib_exts
=
exts
;
lib_memo
=
H
ashtbl
.
create
17
;
lib_memo
=
H
path
.
create
17
;
}
let
env_of_library
lib
=
lib
.
lib_env
...
...
@@ -141,18 +147,18 @@ let read_lib_file lib path =
let
file
=
locate_lib_file
lib
.
lib_env
path
lib
.
lib_exts
in
let
ic
=
open_in
file
in
try
H
ashtbl
.
replace
lib
.
lib_memo
path
None
;
H
path
.
replace
lib
.
lib_memo
path
None
;
let
res
=
lib
.
lib_read
lib
path
file
ic
in
H
ashtbl
.
replace
lib
.
lib_memo
path
(
Some
res
);
H
path
.
replace
lib
.
lib_memo
path
(
Some
res
);
close_in
ic
;
res
with
e
->
H
ashtbl
.
remove
lib
.
lib_memo
path
;
H
path
.
remove
lib
.
lib_memo
path
;
close_in
ic
;
raise
e
let
read_lib_file
lib
path
=
try
match
H
ashtbl
.
find
lib
.
lib_memo
path
with
try
match
H
path
.
find
lib
.
lib_memo
path
with
|
Some
res
->
res
|
None
->
raise
(
CircularDependency
path
)
with
Not_found
->
read_lib_file
lib
path
...
...
@@ -172,12 +178,12 @@ let read_lib_theory lib path th =
raise
(
TheoryNotFound
(
path
,
th
))
let
register_format
~
(
desc
:
Pp
.
formatted
)
name
exts
read
=
if
H
ashtbl
.
mem
read_format_table
name
then
raise
(
KnownFormat
name
);
if
H
str
.
mem
read_format_table
name
then
raise
(
KnownFormat
name
);
let
getlib
=
Wenv
.
memoize
5
(
mk_library
read
exts
)
in
let
rc
env
file
ic
=
snd
(
read
(
getlib
env
)
[]
file
ic
)
in
let
rl
env
path
th
=
read_lib_theory
(
getlib
env
)
path
th
in
H
ashtbl
.
add
read_format_table
name
(
rc
,
rl
,
exts
,
desc
);
List
.
iter
(
fun
s
->
H
ashtbl
.
replace
extensions_table
s
name
)
exts
;
H
str
.
add
read_format_table
name
(
rc
,
rl
,
exts
,
desc
);
List
.
iter
(
fun
s
->
H
str
.
replace
extensions_table
s
name
)
exts
;
getlib
let
locate_lib_file
env
format
path
=
...
...
src/core/env.mli
View file @
32893b03
...
...
@@ -9,7 +9,7 @@
(* *)
(********************************************************************)
open
Util
open
Stdlib
open
Theory
(** Local type aliases and exceptions *)
...
...
src/core/ident.ml
View file @
32893b03
...
...
@@ -10,7 +10,6 @@
(********************************************************************)
open
Stdlib
open
Util
(** Labels *)
...
...
@@ -19,7 +18,7 @@ type label = {
lab_tag
:
int
;
}
module
Lab
=
StructMake
(
struct
module
Lab
=
MakeMSH
(
struct
type
t
=
label
let
tag
lab
=
lab
.
lab_tag
end
)
...
...
@@ -52,7 +51,7 @@ type ident = {
id_tag
:
Weakhtbl
.
tag
;
(* unique magical tag *)
}
module
Id
=
WeakStructMake
(
struct
module
Id
=
MakeMSHW
(
struct
type
t
=
ident
let
tag
id
=
id
.
id_tag
end
)
...
...
src/core/pattern.ml
View file @
32893b03
...
...
@@ -9,7 +9,7 @@
(* *)
(********************************************************************)
open
Util
open
Stdlib
open
Ident
open
Ty
open
Term
...
...
src/core/pretty.ml
View file @
32893b03
...
...
@@ -11,7 +11,7 @@
open
Format
open
Pp
open
Util
open
Stdlib
open
Ident
open
Ty
open
Term
...
...
src/core/printer.ml
View file @
32893b03
...
...
@@ -143,9 +143,9 @@ let get_type_arguments t = match t.t_node with
let
m
=
oty_match
Mtv
.
empty
ls
.
ls_value
t
.
t_ty
in
let
m
=
List
.
fold_left2
(
fun
m
ty
t
->
oty_match
m
(
Some
ty
)
t
.
t_ty
)
m
ls
.
ls_args
tl
in
let
name
tv
=
Util
.
Mstr
.
add
tv
.
tv_name
.
id_string
in
let
m
=
Mtv
.
fold
name
m
Util
.
Mstr
.
empty
in
Array
.
of_list
(
Util
.
Mstr
.
values
m
)
let
name
tv
=
Stdlib
.
Mstr
.
add
tv
.
tv_name
.
id_string
in
let
m
=
Mtv
.
fold
name
m
Stdlib
.
Mstr
.
empty
in
Array
.
of_list
(
Stdlib
.
Mstr
.
values
m
)
|
_
->
[
||
]
...
...
src/core/task.ml
View file @
32893b03
...
...
@@ -9,7 +9,7 @@
(* *)
(********************************************************************)
open
Util
open
Stdlib
open
Ident
open
Ty
open
Term
...
...
src/core/task.mli
View file @
32893b03
...
...
@@ -11,7 +11,7 @@
(** Proof Tasks, Cloning and Meta History *)
open
Util
open
Stdlib
open
Ident
open
Ty
open
Term
...
...
src/core/term.ml
View file @
32893b03
...
...
@@ -9,10 +9,9 @@
(* *)
(********************************************************************)
open
Util
open
Stdlib
open
Ident
open
Ty
open
Stdlib
(** Variable symbols *)
...
...
@@ -21,7 +20,7 @@ type vsymbol = {
vs_ty
:
ty
;
}
module
Vsym
=
WeakStructMake
(
struct
module
Vsym
=
MakeMSHW
(
struct
type
t
=
vsymbol
let
tag
vs
=
vs
.
vs_name
.
id_tag
end
)
...
...
@@ -48,7 +47,7 @@ type lsymbol = {
ls_value
:
ty
option
;
}
module
Lsym
=
WeakStructMake
(
struct
module
Lsym
=
MakeMSHW
(
struct
type
t
=
lsymbol
let
tag
ls
=
ls
.
ls_name
.
id_tag
end
)
...
...
@@ -124,7 +123,7 @@ module Hspat = Hashcons.Make (struct
let
tag
n
p
=
{
p
with
pat_tag
=
n
}
end
)
module
Pat
=
StructMake
(
struct
module
Pat
=
MakeMSH
(
struct
type
t
=
pattern
let
tag
pat
=
pat
.
pat_tag
end
)
...
...
@@ -181,8 +180,11 @@ let pat_fold fn acc pat = match pat.pat_node with
|
Pas
(
p
,
_
)
->
fn
acc
p
|
Por
(
p
,
q
)
->
fn
(
fn
acc
p
)
q
let
pat_all
pr
pat
=
try
pat_fold
(
all_fn
pr
)
true
pat
with
FoldSkip
->
false
let
pat_any
pr
pat
=
try
pat_fold
(
any_fn
pr
)
false
pat
with
FoldSkip
->
true
let
pat_all
pr
pat
=
try
pat_fold
(
Util
.
all_fn
pr
)
true
pat
with
Util
.
FoldSkip
->
false
let
pat_any
pr
pat
=
try
pat_fold
(
Util
.
any_fn
pr
)
false
pat
with
Util
.
FoldSkip
->
true
(* smart constructors for patterns *)
...
...
@@ -443,7 +445,7 @@ module Hsterm = Hashcons.Make (struct
end
)
module
Term
=
StructMake
(
struct
module
Term
=
MakeMSH
(
struct
type
t
=
term
let
tag
term
=
term
.
t_tag
end
)
...
...
@@ -804,7 +806,7 @@ let t_bool_false = fs_app fs_bool_false [] ty_bool
let
fs_tuple_ids
=
Hid
.
create
17
let
fs_tuple
=
Util
.
Hint
.
memo
17
(
fun
n
->
let
fs_tuple
=
Hint
.
memo
17
(
fun
n
->
let
ts
=
ts_tuple
n
in
let
tl
=
List
.
map
ty_var
ts
.
ts_args
in
let
ty
=
ty_app
ts
tl
in
...
...
@@ -955,10 +957,12 @@ let rec t_gen_fold fnT fnL acc t =
let
t_s_fold
=
t_gen_fold
let
t_s_all
prT
prL
t
=
try
t_s_fold
(
all_fn
prT
)
(
all_fn
prL
)
true
t
with
FoldSkip
->
false
try
t_s_fold
(
Util
.
all_fn
prT
)
(
Util
.
all_fn
prL
)
true
t
with
Util
.
FoldSkip
->
false
let
t_s_any
prT
prL
t
=
try
t_s_fold
(
any_fn
prT
)
(
any_fn
prL
)
false
t
with
FoldSkip
->
true
try
t_s_fold
(
Util
.
any_fn
prT
)
(
Util
.
any_fn
prL
)
false
t
with
Util
.
FoldSkip
->
true
(* map/fold over types in terms and formulas *)
...
...
@@ -1019,8 +1023,8 @@ let t_fold fn acc t = match t.t_node with
let
_
,
tl
,
f1
=
t_open_quant
b
in
tr_fold
fn
(
fn
acc
f1
)
tl
|
_
->
t_fold_unsafe
fn
acc
t
let
t_all
pr
t
=
try
t_fold
(
all_fn
pr
)
true
t
with
FoldSkip
->
false
let
t_any
pr
t
=
try
t_fold
(
any_fn
pr
)
false
t
with
FoldSkip
->
true
let
t_all
pr
t
=
try
t_fold
(
Util
.
all_fn
pr
)
true
t
with
Util
.
FoldSkip
->
false
let
t_any
pr
t
=
try
t_fold
(
Util
.
any_fn
pr
)
false
t
with
Util
.
FoldSkip
->
true
(* safe opening map_fold *)
...
...
src/core/theory.ml
View file @
32893b03
...
...
@@ -10,7 +10,7 @@
(********************************************************************)
open
Format
open
Util
open
Stdlib
open
Ident
open
Ty
open
Term
...
...
@@ -101,7 +101,7 @@ let print_meta_desc fmt m =
fprintf
fmt
"@[%s@
\n
@[%a@]@]"
m
.
meta_name
Pp
.
formatted
m
.
meta_desc
module
SMmeta
=
StructMake
(
struct
type
t
=
meta
let
tag
m
=
m
.
meta_tag
end
)
module
SMmeta
=
MakeMSH
(
struct
type
t
=
meta
let
tag
m
=
m
.
meta_tag
end
)
module
Smeta
=
SMmeta
.
S
module
Mmeta
=
SMmeta
.
M
...
...
@@ -116,7 +116,7 @@ exception UnknownMeta of string
exception
BadMetaArity
of
meta
*
int
*
int
exception
MetaTypeMismatch
of
meta
*
meta_arg_type
*
meta_arg_type
let
meta_table
=
H
ashtbl
.
create
17
let
meta_table
=
H
str
.
create
17
let
mk_meta
=
let
c
=
ref
(
-
1
)
in
...
...
@@ -130,22 +130,20 @@ let mk_meta =
let
register_meta
~
desc
s
al
excl
=
try
let
m
=
H
ashtbl
.
find
meta_table
s
in
let
m
=
H
str
.
find
meta_table
s
in
if
al
=
m
.
meta_type
&&
excl
=
m
.
meta_excl
then
m
else
raise
(
KnownMeta
m
)
with
Not_found
->
let
m
=
mk_meta
desc
s
al
excl
in
H
ashtbl
.
add
meta_table
s
m
;
H
str
.
add
meta_table
s
m
;
m
let
register_meta_excl
~
desc
s
al
=
register_meta
~
desc
s
al
true
let
register_meta
~
desc
s
al
=
register_meta
~
desc
s
al
false
let
lookup_meta
s
=