Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
cduce
cduce
Commits
e08a6bc4
Commit
e08a6bc4
authored
Oct 05, 2007
by
Pietro Abate
Browse files
[r2006-04-21 16:03:53 by afrisch] Tracing the cache
Original author: afrisch Date: 2006-04-21 16:03:53+00:00
parent
a699b619
Changes
1
Hide whitespace changes
Inline
Side-by-side
types/types.ml
View file @
e08a6bc4
...
...
@@ -1240,7 +1240,9 @@ module Cache = struct
~
atom
:
f
let
rec
type_has_witness
t
=
function
(* Special case for empty, any ? *)
let
rec
type_has_witness
t
w
=
print_char
'
?
'
;
flush
stdout
;
match
w
with
|
WInt
i
->
Intervals
.
contains
i
t
.
ints
|
WChar
c
->
Chars
.
contains
c
t
.
chars
|
WAtom
a
->
Atoms
.
contains_sample
a
t
.
atoms
...
...
@@ -1276,32 +1278,53 @@ module Cache = struct
|
WAbsent
->
t
.
absent
|
WAbstract
a
->
Abstract
.
contains_sample
a
t
.
abstract
(*
let type_has_witness t w =
Format.fprintf Format.std_formatter
"check wit:%a@." print_witness w;
let r = type_has_witness t w in
Format.fprintf Format.std_formatter "Done@.";
r
*)
type
'
a
cache
=
|
Empty
|
Type
of
t
*
'
a
|
Split
of
witness
*
'
a
cache
*
'
a
cache
let
steps
=
ref
0
let
rec
find
f
t
=
function
|
Empty
->
let
r
=
f
t
in
Type
(
t
,
r
)
,
r
|
Split
(
w
,
yes
,
no
)
->
incr
steps
;
print_char
'.'
;
flush
stdout
;
if
type_has_witness
t
w
then
let
yes
,
r
=
find
f
t
yes
in
Split
(
w
,
yes
,
no
)
,
r
else
let
no
,
r
=
find
f
t
no
in
Split
(
w
,
yes
,
no
)
,
r
|
Type
(
s
,
rs
)
as
c
->
Format
.
fprintf
Format
.
std_formatter
"!@."
;
try
let
w
=
witness
(
diff
t
s
)
in
(* Format.fprintf Format.std_formatter "wit:%a@." print_witness w; *)
let
rt
=
f
t
in
Split
(
w
,
Type
(
t
,
rt
)
,
c
)
,
rt
with
Not_found
->
try
let
w
=
witness
(
diff
s
t
)
in
(* Format.fprintf Format.std_formatter "wit:%a@." print_witness w; *)
let
rt
=
f
t
in
Split
(
w
,
c
,
Type
(
t
,
rt
))
,
rt
with
Not_found
->
c
,
rs
let
find
f
t
c
=
steps
:=
0
;
Format
.
fprintf
Format
.
std_formatter
"begin find@."
;
let
r
=
find
f
t
c
in
Format
.
fprintf
Format
.
std_formatter
"steps:%i@."
!
steps
;
r
let
emp
=
Empty
let
memo
f
=
...
...
@@ -1380,9 +1403,12 @@ struct
module
DescrPairMap
=
Map
.
Make
(
Custom
.
Pair
(
Descr
)(
Descr
))
let
uniq
=
(*Cache.memo*)
(
fun
t
->
t
)
let
named
=
ref
DescrMap
.
empty
let
named_xml
=
ref
DescrPairMap
.
empty
let
register_global
cu
(
name
:
Ns
.
QName
.
t
)
d
=
let
d
=
uniq
d
in
if
equal
{
d
with
xml
=
BoolPair
.
empty
}
empty
then
(
let
l
=
(*Product.merge_same_2*)
(
Product
.
get
~
kind
:
`XML
d
)
in
match
l
with
...
...
@@ -1395,6 +1421,7 @@ struct
else
named
:=
DescrMap
.
add
d
(
cu
,
name
)
!
named
let
unregister_global
d
=
let
d
=
uniq
d
in
if
equal
{
d
with
xml
=
BoolPair
.
empty
}
empty
then
(
let
l
=
Product
.
get
~
kind
:
`XML
d
in
match
l
with
...
...
@@ -1439,6 +1466,7 @@ struct
n
>=
5
let
rec
prepare
d
=
let
d
=
uniq
d
in
try
DescrHash
.
find
memo
d
with
Not_found
->
try
...
...
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