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
35fb94d9
Commit
35fb94d9
authored
Oct 05, 2007
by
Pietro Abate
Browse files
[r2005-01-05 11:08:43 by afrisch] Bug in factorization
Original author: afrisch Date: 2005-01-05 11:08:44+00:00
parent
b14cf675
Changes
2
Hide whitespace changes
Inline
Side-by-side
types/patterns.ml
View file @
35fb94d9
...
...
@@ -450,7 +450,8 @@ let filter_descr t p =
(* Factorization of capture variables and constant patterns *)
module
Factorize
=
struct
module
NodeSet
=
Set
.
Make
(
Node
)
module
NodeTypeSet
=
Set
.
Make
(
Custom
.
Pair
(
Node
)(
Types
))
let
pi1
~
kind
t
=
Types
.
Product
.
pi1
(
Types
.
Product
.
get
~
kind
t
)
let
pi2
~
kind
t
=
Types
.
Product
.
pi2
(
Types
.
Product
.
get
~
kind
t
)
...
...
@@ -489,15 +490,15 @@ x=(1,2)
|
_
->
assert
false
and
approx_var_node
seen
q
t
xs
=
if
(
NodeSet
.
mem
q
seen
)
if
(
Node
Type
Set
.
mem
(
q
,
t
)
seen
)
then
xs
else
approx_var
(
NodeSet
.
add
q
seen
)
q
.
descr
t
xs
else
approx_var
(
Node
Type
Set
.
add
(
q
,
t
)
seen
)
q
.
descr
t
xs
(* Obviously not complete ! *)
let
rec
approx_nil
seen
((
a
,
fv
,
d
)
as
p
)
t
xs
=
(*
assert (Types.subtype t a);
assert (IdSet.subset xs fv);
*)
assert
(
Types
.
subtype
t
a
);
assert
(
IdSet
.
subset
xs
fv
);
if
(
IdSet
.
is_empty
xs
)
||
(
Types
.
is_empty
t
)
then
xs
else
match
d
with
|
Cup
((
a1
,_,_
)
as
p1
,
p2
)
->
...
...
@@ -514,9 +515,9 @@ x=(1,2)
|
_
->
IdSet
.
empty
and
approx_nil_node
seen
q
t
xs
=
if
(
NodeSet
.
mem
q
seen
)
if
(
Node
Type
Set
.
mem
(
q
,
t
)
seen
)
then
xs
else
approx_nil
(
NodeSet
.
add
q
seen
)
q
.
descr
t
xs
else
approx_nil
(
Node
Type
Set
.
add
(
q
,
t
)
seen
)
q
.
descr
t
xs
let
cst
((
a
,_,_
)
as
p
)
t
xs
=
if
IdSet
.
is_empty
xs
then
IdMap
.
empty
...
...
@@ -531,10 +532,10 @@ x=(1,2)
IdMap
.
from_list_disj
(
List
.
fold_left
aux
[]
(
filter_descr
t
p
))
let
var
((
a
,_,_
)
as
p
)
t
=
approx_var
NodeSet
.
empty
p
(
Types
.
cap
t
a
)
approx_var
Node
Type
Set
.
empty
p
(
Types
.
cap
t
a
)
let
nil
((
a
,_,_
)
as
p
)
t
=
approx_nil
NodeSet
.
empty
p
(
Types
.
cap
t
a
)
approx_nil
Node
Type
Set
.
empty
p
(
Types
.
cap
t
a
)
end
...
...
@@ -911,9 +912,19 @@ module Normal = struct
let
a
=
List
.
fold_left
(
fun
a
x
->
ncap
a
(
ncapture
l
x
))
a
vs
in
let
vs
=
facto
Factorize
.
nil
t
xs
pl
in
(*
let ppf = Format.std_formatter in
Format.fprintf ppf "t = %a xs = %a"
Types.Print.print t
Print.print_xs xs;
List.iter (fun p -> Format.fprintf ppf "p:%a " Print.print (descr p)) pl;
Format.fprintf ppf " => %a@."
Print.print_xs vs;
*)
let
xs
=
IdSet
.
diff
xs
vs
in
let
a
=
List
.
fold_left
(
fun
a
x
->
ncap
a
(
nconstant
l
x
Sequence
.
nil_cst
))
a
vs
in
List
.
fold_left
(
fun
a
p
->
ncap
a
(
nnormal
l
(
descr
p
)
xs
))
a
pl
let
nnf
lab
t0
(
pl
,
t
,
xs
)
=
...
...
web/site.cd
View file @
35fb94d9
...
...
@@ -347,7 +347,7 @@ match page with
transform
t
with
|
<
section
title
=
title
>
c
->
[
<
p
>
[
<
b
style
=
"
color: #008000
"
>
title
]
!
(
content
c
)
]
|
<
paper
(
r
)
>
[
<
title
>
tit
aut
::
Author
*
<
comment
>
com
<
abstract
>
ab
]
->
|
<
paper
(
r
)
>
[
<
title
>
tit
aut
::
Author
*
<
comment
>
com
<
abstract
>
ab
]
->
[
(
match
r
with
|
{
file
=
f
;
old
=
""
}
->
<
a
class
=
"
old
"
href
=
f
>
tit
|
{
file
=
f
}
->
<
a
href
=
f
>
tit
...
...
@@ -529,7 +529,6 @@ let gen_page_seq
;;
let
[
<
site
>
[
<
title
>
site
p
]
]
=
try
(
load_include
input
:?
[
Site
])
with
(
err
&
Latin1
)
->
...
...
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