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
f9f88ab7
Commit
f9f88ab7
authored
Jul 10, 2007
by
Pietro Abate
Browse files
[r2005-03-23 16:03:28 by afrisch] Empty log message
Original author: afrisch Date: 2005-03-23 16:03:29+00:00
parent
af84c65d
Changes
4
Hide whitespace changes
Inline
Side-by-side
misc/bool.ml
View file @
f9f88ab7
...
...
@@ -360,7 +360,7 @@ struct
|
Split
(
_
,
y
,
p
,
i
,
n
)
->
let
c
=
X
.
compare
x
y
in
assert
(
c
<>
0
);
if
x
<
y
then
if
(
c
<
0
)
then
if
pos
then
split
x
a
False
False
else
split
x
False
False
a
else
split
y
(
cap_atom
x
pos
p
)
(
cap_atom
x
pos
i
)
(
cap_atom
x
pos
n
)
...
...
runtime/value.ml
View file @
f9f88ab7
...
...
@@ -699,9 +699,14 @@ let mk_record labels fields =
Record
(
LabelMap
.
from_list_disj
!
l
)
(* TODO: optimize cases
- (f x = [])
- all chars copied or deleted *)
let
rec
transform_aux
f
accu
=
function
|
Pair
(
x
,
y
)
->
let
accu
=
Concat
(
accu
,
f
x
)
in
transform_aux
f
accu
y
|
Atom
_
->
accu
|
v
->
transform_aux
f
accu
(
normalize
v
)
let
transform
f
v
=
transform_aux
f
nil
v
types/sequence.ml
View file @
f9f88ab7
...
...
@@ -105,7 +105,6 @@ let approx t =
let
map_tree
f
seq
=
let
memo
=
ref
H
.
empty
in
let
rec
aux
t
=
(* Printf.eprintf "A"; flush stderr; *)
try
H
.
find
t
!
memo
with
Not_found
->
let
v
=
V
.
forward
()
in
...
...
@@ -126,18 +125,48 @@ let map_tree f seq =
if
iter
=
[]
then
result
else
V
.
cup
[
V
.
times
(
V
.
cup
iter
)
v
;
result
]
in
let
d
=
Types
.
descr
(
V
.
solve
(
aux
seq
))
in
(* Printf.eprintf "Done."; flush stderr; *)
(* Format.fprintf Format.std_formatter "%a\n" Types.Print.print_descr d; *)
d
Types
.
descr
(
V
.
solve
(
aux
seq
))
(* TODO: avoid flushing the memo between calls to mapping inside map_tree *)
let
map_tree_mono
domain
seq
=
let
ts
=
ref
[]
in
let
vs
=
ref
[]
in
(* <helpers> *)
let
memo
=
ref
H
.
empty
in
let
rec
aux
t
=
try
H
.
find
t
!
memo
with
Not_found
->
let
v
=
V
.
forward
()
in
memo
:=
H
.
add
t
v
!
memo
;
let
v'
=
mapping
descr_aux
t
(
V
.
ty
nil_type
)
in
V
.
define
v
v'
;
v
and
descr_aux
t
v
=
let
residual
=
Types
.
diff
t
domain
in
let
f2
(
attr
,
child
)
=
V
.
times
(
V
.
ty
attr
)
(
aux
child
)
in
let
f1
(
tag
,
x
)
=
let
x
=
V
.
cup
(
List
.
map
f2
(
Types
.
Product
.
get
x
))
in
V
.
xml
(
V
.
ty
tag
)
x
in
let
iter
=
List
.
map
f1
(
Types
.
Product
.
get
~
kind
:
`XML
residual
)
in
let
resid
=
Types
.
Product
.
other
~
kind
:
`XML
residual
in
let
iter
=
if
Types
.
is_empty
resid
then
iter
else
V
.
ty
resid
::
iter
in
let
result
=
V
.
forward
()
in
ts
:=
(
Types
.
cap
domain
t
)
::
!
ts
;
vs
:=
(
result
,
v
)
::
!
vs
;
if
iter
=
[]
then
result
else
V
.
cup
[
V
.
times
(
V
.
cup
iter
)
v
;
result
]
in
let
r
=
aux
seq
in
!
ts
,
(
fun
fts
->
List
.
iter2
(
fun
t
(
result
,
v
)
->
V
.
define
result
(
aux_concat
t
v
))
fts
!
vs
;
solve
r
)
(* TODO: avoid flushing the memo between calls to mapping inside map_tree *)
let
seq_of_list
l
=
let
times'
t
acc
=
Types
.
times
(
Types
.
cons
t
)
(
Types
.
cons
acc
)
in
List
.
fold_right
times'
l
nil_type
(* </helpers> *)
types/sequence.mli
View file @
f9f88ab7
...
...
@@ -10,12 +10,14 @@ val concat: Types.t -> Types.t -> Types.t
val
flatten
:
Types
.
t
->
Types
.
t
val
map
:
(
Types
.
t
->
Types
.
t
)
->
Types
.
t
->
Types
.
t
val
map_mono
:
Types
.
t
->
Types
.
t
list
*
(
Types
.
t
list
->
Types
.
t
)
val
map_tree
:
(
Types
.
t
->
Types
.
t
*
Types
.
t
)
->
Types
.
t
->
Types
.
t
(* input type -> (result, residual) *)
(* sequence type *)
val
map_mono
:
Types
.
t
->
Types
.
t
list
*
(
Types
.
t
list
->
Types
.
t
)
val
map_tree_mono
:
Types
.
t
->
Types
.
t
->
Types
.
t
list
*
(
Types
.
t
list
->
Types
.
t
)
val
star
:
Types
.
t
->
Types
.
t
(* For a type t, returns [t*] *)
val
plus
:
Types
.
t
->
Types
.
t
...
...
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