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
bdacc884
Commit
bdacc884
authored
Jul 10, 2007
by
Pietro Abate
Browse files
[r2003-06-26 09:10:05 by cvscast] Optim dispatch on atoms
Original author: cvscast Date: 2003-06-26 09:10:05+00:00
parent
9d75ace2
Changes
2
Show whitespace changes
Inline
Side-by-side
benchmarks/bench.ml
View file @
bdacc884
...
...
@@ -47,13 +47,16 @@ let args = List.map int_of_string (split ',' args)
let
sp
=
sprintf
let
langs
=
[
"CDuce PXP"
,
".cd"
,
(*
"CDuce PXP", ".cd",
(fun script xml ->
sp
"%s --pxp --quiet %s --arg %s"
cduce_cmd
script
xml
);
sp "%s --pxp --quiet %s --arg %s" cduce_cmd script xml);
*)
"CDuce
expat
"
,
".cd"
,
"CDuce"
,
".cd"
,
(
fun
script
xml
->
sp
"%s --expat --quiet %s --arg %s"
cduce_cmd
script
xml
);
sp
"%s --quiet %s --arg %s"
cduce_cmd
script
xml
);
"CDuce.old"
,
".cd"
,
(
fun
script
xml
->
sp
"%s --quiet %s --arg %s"
(
cduce_cmd
^
".old"
)
script
xml
);
"XDuce 0.4.0"
,
".q"
,
(
fun
script
xml
->
...
...
types/atoms.ml
View file @
bdacc884
open
Encodings
(* TODO:
- pretty-printing
- efficient dispatch
*)
module
Ns
=
struct
include
Pool
.
Make
(
Utf8
)
...
...
@@ -294,21 +289,42 @@ module IMap = struct
|
Leaf
of
int
*
'
a
|
Branch
of
int
*
int
*
'
a
t
*
'
a
t
type
'
a
s
=
|
DError
|
DReturn
of
'
a
|
DLeaf
of
int
*
'
a
*
'
a
|
DBranch
of
int
*
int
*
'
a
s
*
'
a
s
let
zero_bit
k
m
=
(
k
land
m
)
==
0
let
lowest_bit
x
=
x
land
(
-
x
)
let
branching_bit
p0
p1
=
lowest_bit
(
p0
lxor
p1
)
let
mask
p
m
=
p
land
(
m
-
1
)
let
match_prefix
k
p
m
=
(
mask
k
m
)
==
p
let
rec
find_def
def
k
=
function
|
Empty
->
def
|
Leaf
(
j
,
x
)
->
if
k
==
j
then
x
else
def
|
Branch
(
_
,
m
,
l
,
r
)
->
find_def
def
k
(
if
zero_bit
k
m
then
l
else
r
)
let
rec
prepare_def
y
=
function
|
Empty
->
DReturn
y
|
Leaf
(
k
,
x
)
->
DLeaf
(
k
,
x
,
y
)
|
Branch
(
p
,
m
,
t0
,
t1
)
->
DBranch
(
p
,
m
,
prepare_def
y
t0
,
prepare_def
y
t1
)
let
rec
prepare_nodef
=
function
|
Empty
->
DError
|
Leaf
(
k
,
x
)
->
DReturn
x
|
Branch
(
p
,
m
,
t0
,
t1
)
->
match
(
prepare_nodef
t0
,
prepare_nodef
t1
)
with
|
(
DReturn
x0
,
DReturn
x1
)
when
x0
==
x1
->
DReturn
x0
|
(
t0
,
t1
)
->
DBranch
(
p
,
m
,
t0
,
t1
)
let
prepare
def
y
=
match
def
with
|
None
->
prepare_nodef
y
|
Some
def
->
prepare_def
def
y
let
rec
find
k
=
function
|
Empty
->
assert
false
|
Leaf
(
j
,
x
)
->
x
|
Branch
(
_
,
m
,
l
,
r
)
->
find
k
(
if
zero_bit
k
m
then
l
else
r
)
|
DError
->
assert
false
|
DReturn
y
->
y
|
DLeaf
(
j
,
x
,
y
)
->
if
k
==
j
then
x
else
y
|
DBranch
(
_
,
m
,
l
,
r
)
->
find
k
(
if
zero_bit
k
m
then
l
else
r
)
let
join
p0
t0
p1
t1
=
let
m
=
branching_bit
p0
p1
in
...
...
@@ -328,59 +344,69 @@ module IMap = struct
else
Branch
(
p
,
m
,
t0
,
add
k
x
t1
)
else
join
k
(
Leaf
(
k
,
x
))
p
t
end
(* TODO: avoid option (using functional types instead ?) *)
let
rec
dump
f
ppf
=
function
|
DError
->
Format
.
fprintf
ppf
"Error"
|
DReturn
x
->
Format
.
fprintf
ppf
"Return %a"
f
x
|
DLeaf
(
j
,
x
,
y
)
->
Format
.
fprintf
ppf
"Leaf(%i,%a,%a)"
j
f
x
f
y
|
DBranch
(
p
,
m
,
t0
,
t1
)
->
Format
.
fprintf
ppf
"B(%i,%i,%a,%a)"
p
m
(
dump
f
)
t0
(
dump
f
)
t1
type
'
a
map
=
{
min_ns
:
int
;
table
:
'
a
IMap
.
t
array
;
table_def
:
'
a
option
array
;
def
:
'
a
option
}
end
let
get_map
(
ns
,
x
)
m
=
let
i
=
ns
-
m
.
min_ns
in
if
(
i
<
0
)
||
(
i
>=
Array
.
length
m
.
table
)
then
(
match
m
.
def
with
Some
y
->
y
|
None
->
assert
false
)
else
match
m
.
table_def
.
(
i
)
with
|
Some
def
->
IMap
.
find_def
def
x
m
.
table
.
(
i
)
|
None
->
IMap
.
find
x
m
.
table
.
(
i
)
type
'
a
map
=
'
a
IMap
.
s
IMap
.
s
let
rec
get_ma
x
=
function
|
[
(
ns
,_
)
]
->
ns
|
_
::
l
->
get_max
l
|
[]
->
assert
false
let
get_ma
p
(
ns
,
x
)
m
=
IMap
.
find
x
(
IMap
.
find
ns
m
)
module
IntSet
=
Set
.
Make
(
struct
type
t
=
int
let
compare
(
x
:
int
)
y
=
Pervasives
.
compare
x
y
end
)
let
mk_map
l
=
let
min
_ns
=
ref
max_int
and
max_ns
=
ref
min_int
in
let
all
_ns
=
ref
IntSet
.
empty
in
let
def
=
ref
None
in
List
.
iter
(
function
|
(
Finite
s
,
_
)
->
(
match
T
.
get
s
with
|
[]
->
()
|
(
ns
,_
)
::_
as
l
->
min_ns
:=
min
!
min_ns
ns
;
max_ns
:=
max
!
max_ns
(
get_max
l
))
|
(
Cofinite
_
,
y
)
->
def
:=
Some
y
)
l
;
let
n
=
!
max_ns
-
!
min_ns
+
1
in
let
table
=
Array
.
make
n
IMap
.
Empty
in
let
table_def
=
Array
.
make
n
None
in
let
ofs
=
!
min_ns
in
for
ns
=
ofs
to
!
max_ns
do
table
.
(
ns
-
ofs
)
<-
List
.
iter
(
fun
(
ns
,_
)
->
all_ns
:=
IntSet
.
add
ns
!
all_ns
)
(
T
.
get
s
)
|
(
Cofinite
_
,
y
)
->
def
:=
Some
(
IMap
.
DReturn
y
))
l
;
let
one_ns
ns
=
let
def
=
ref
None
in
let
t
=
List
.
fold_left
(
fun
accu
(
s
,
y
)
->
match
(
symbol_set
ns
s
)
with
|
SymbolSet
.
Finite
syms
->
List
.
fold_left
(
fun
accu
x
->
IMap
.
add
x
y
accu
)
accu
syms
|
SymbolSet
.
Cofinite
syms
->
table_def
.
(
ns
-
ofs
)
<-
Some
y
;
accu
)
def
:=
Some
y
;
accu
)
IMap
.
Empty
l
in
IMap
.
prepare
!
def
t
in
let
t
=
List
.
fold_left
(
fun
accu
ns
->
IMap
.
add
ns
(
one_ns
ns
)
accu
)
IMap
.
Empty
l
;
done
;
{
min_ns
=
ofs
;
table
=
table
;
table_def
=
table_def
;
def
=
!
def
}
(
IntSet
.
elements
!
all_ns
)
in
let
t
=
IMap
.
prepare
!
def
t
in
(*
let rec rank y i = function
| (_,x)::_ when x == y -> i
| _::r -> rank y (succ i) r
| [] -> assert false in
let dump_ns =
IMap.dump (fun ppf y -> Format.fprintf ppf "[%i]" (rank y 0 l)) in
Format.fprintf Format.std_formatter "table: %a@."
(IMap.dump (fun ppf y -> Format.fprintf ppf "[%a]" dump_ns y)) t;
*)
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