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
10ff213e
Commit
10ff213e
authored
Jul 10, 2007
by
Pietro Abate
Browse files
[r2005-02-01 13:10:25 by afrisch] Cleanup
Original author: afrisch Date: 2005-02-01 13:10:26+00:00
parent
554d7f97
Changes
11
Expand all
Hide whitespace changes
Inline
Side-by-side
Makefile.distrib
View file @
10ff213e
...
...
@@ -210,7 +210,7 @@ OBJECTS += $(CQL_OBJECTS)
VALIDATE_OBJECTS
:=
$(
shell
for
o
in
$(OBJECTS)
;
do
echo
$$
o
;
if
[
"
$$
o"
=
"schema/schema_parser.cmo"
]
;
then
exit
0
;
fi
;
done
)
# all objects until schema_parser.cmo
CDUCE
=
$(OBJECTS)
driver/run.cmo
$(CQL_OBJECTS_RUN)
CDUCE
=
$(OBJECTS)
$(CQL_OBJECTS_RUN)
driver/run.cmo
DTD2CDUCE
=
tools/dtd2cduce.cmo
ALL_OBJECTS
=
$(OBJECTS)
$(NEW_SCHEMA_OBJS)
\
...
...
Makefile.types
View file @
10ff213e
...
...
@@ -54,7 +54,7 @@ else
CAML
=
$(CAMLC)
endif
cduce_types
:
$(OBJECTS)
cduce_types
.cmo
:
$(OBJECTS)
$(CAML)
-pack
-o
cduce_types.
$(EXT)
$(INCLUDES)
$^
$(CAML)
-a
-o
cduce_types.
$(EXTA)
$(INCLUDES)
cduce_types.
$(EXT)
...
...
@@ -62,10 +62,10 @@ HIDE=@
INCLUDES
=
$
(
DIRS:%
=
-I
%
)
types/intervals.$(EXT)
:
types/intervals.ml cat1
types/intervals.$(EXT)
:
types/intervals.ml cat1
types/intervals_int.ml
$(CAML)
-c
$(INCLUDES)
-pp
'./cat1 types/intervals_int.ml'
$<
types/intervals.cmi
:
types/intervals.mli cat1
types/intervals.cmi
:
types/intervals.mli cat1
types/intervals_int.mli
$(CAML)
-c
$(INCLUDES)
-pp
'./cat1 types/intervals_int.mli'
$<
misc/stats.$(EXT)
:
misc/stats.ml
...
...
depend
View file @
10ff213e
This diff is collapsed.
Click to expand it.
driver/cduce.ml
View file @
10ff213e
...
...
@@ -5,6 +5,8 @@ exception Escape of exn
exception
InvalidInputFilename
of
string
exception
InvalidObjectFilename
of
string
let
extra_specs
=
ref
[]
(* if set to false toplevel exception aren't cought.
* Useful for debugging with OCAMLRUNPARAM="b" *)
let
catch_exceptions
=
true
...
...
driver/cduce.mli
View file @
10ff213e
...
...
@@ -3,6 +3,8 @@ exception Escape of exn
val
toplevel
:
bool
ref
val
verbose
:
bool
ref
val
extra_specs
:
(
string
*
Arg
.
spec
*
string
)
list
ref
val
script
:
Format
.
formatter
->
Format
.
formatter
->
char
Stream
.
t
->
bool
val
topinput
:
Format
.
formatter
->
Format
.
formatter
->
char
Stream
.
t
->
bool
...
...
driver/run.ml
View file @
10ff213e
...
...
@@ -29,7 +29,7 @@ been modified from the original Q Public.\n\n
"
;
exit
0
let
specs
=
ref
let
specs
=
[
"--compile"
,
Arg
.
Set
compile
,
"compile the given CDuce file"
;
"--run"
,
Arg
.
Set
run
,
...
...
@@ -78,7 +78,7 @@ let err s =
exit
1
let
mode
()
=
Arg
.
parse
!
specs
(
fun
s
->
src
:=
s
::
!
src
)
Arg
.
parse
(
specs
@
!
Cduce
.
extra_
specs
)
(
fun
s
->
src
:=
s
::
!
src
)
"Usage:
\n
cduce [OPTIONS ...] [FILE ...] [--arg argument ...]
\n\n
Options:"
;
match
(
!
compile
,!
out_dir
,!
run
,!
src
,!
args
)
with
|
false
,
_
::_,
_
,
_
,
_
->
...
...
@@ -203,9 +203,5 @@ let main () =
Cduce
.
run
f
let
()
=
(* Hum... *)
let
b
=
ref
true
in
at_exit
(
fun
()
->
if
!
b
then
(
b
:=
false
;
main
()
));
at_exit
(
fun
()
->
Stats
.
dump
Format
.
std_formatter
)
at_exit
(
fun
()
->
Stats
.
dump
Format
.
std_formatter
);
main
()
misc/stats.ml
View file @
10ff213e
...
...
@@ -21,7 +21,7 @@ module Timer = struct
}
let
print
ppf
c
=
Format
.
fprintf
ppf
"Timer %s. Total time: %f. Count: %i@
\n
"
Format
.
fprintf
ppf
"Timer %s. Total time: %f. Count: %i@
.
"
c
.
name
c
.
total
c
.
count
let
create
s
=
...
...
@@ -49,7 +49,7 @@ module Counter = struct
}
let
print
ppf
c
=
Format
.
fprintf
ppf
"Counter %s: %i@
\n
"
Format
.
fprintf
ppf
"Counter %s: %i@
.
"
c
.
name
c
.
count
let
create
s
=
...
...
query/query_run.ml
View file @
10ff213e
let
()
=
Run
.
specs
:=
!
Run
.
specs
@
[
"--noquery-optim"
,
Arg
.
Set
Query
.
nooptim
,
" do not optimize queries "
]
let
()
=
Cduce
.
extra_specs
:=
(
"--noquery-optim"
,
Arg
.
Set
Query
.
nooptim
,
" do not optimize queries "
)
::
!
Cduce
.
extra_specs
types/intervals_int.ml
View file @
10ff213e
...
...
@@ -97,7 +97,23 @@ let print =
|
false
,
true
->
Format
.
fprintf
ppf
"%i--*"
a
)
let
add
l1
l2
=
any
let
may_add
x
y
=
(
x
=
0
)
||
(
y
=
0
)
||
(
if
(
x
>
0
)
&&
(
y
>
0
)
then
x
+
y
>
y
else
if
(
x
<
0
)
&&
(
y
<
0
)
then
x
+
y
<
y
else
true
)
let
add
l1
l2
=
List
.
fold_left
(
fun
accu
(
a
,
b
)
->
List
.
fold_left
(
fun
accu
(
c
,
d
)
->
if
(
may_add
a
c
)
&&
(
may_add
b
d
)
then
iadd
accu
(
a
+
c
,
b
+
d
)
else
any
)
accu
l2
)
[]
l1
let
negat
l
=
any
let
sub
l1
l2
=
any
let
mul
l1
l2
=
any
...
...
types/patterns.ml
View file @
10ff213e
...
...
@@ -1115,6 +1115,9 @@ struct
let
dispatchers
=
ref
DispMap
.
empty
let
generated
=
ref
0
let
to_generate
=
ref
[]
let
timer_disp
=
Stats
.
Timer
.
create
"Patterns.dispatcher loop"
let
rec
print_iface
ppf
=
function
...
...
@@ -1253,15 +1256,16 @@ struct
!
accu
let
first_lab
pl
=
let
first_lab
t
pl
=
let
aux
l
(
req
,_
)
=
min
l
(
Normal
.
Nnf
.
first_label
req
)
in
let
lab
=
Array
.
fold_left
(
List
.
fold_left
aux
)
LabelPool
.
dummy_max
pl
in
let
lab
=
min
lab
(
Types
.
Record
.
first_label
t
)
in
if
lab
==
LabelPool
.
dummy_max
then
None
else
Some
lab
let
get_tests
facto
pl
f
t
d
post
=
let
pl
=
Array
.
map
(
List
.
map
f
)
pl
in
let
lab
=
first_lab
pl
in
let
lab
=
first_lab
t
pl
in
let
pl
=
Array
.
map
(
List
.
map
(
fun
(
x
,
info
)
->
Normal
.
nnf
facto
lab
t
x
,
info
))
pl
in
(* Collect all subrequests *)
...
...
@@ -1364,6 +1368,22 @@ struct
|
_
->
assert
false
)
disp
.
pl
in
Some
(
RecLabel
(
lab
,
dispatch_prod0
disp
t
pl
))
let
iter_disp_disp
f
g
=
function
|
Dispatch
(
d
,
a
)
->
f
d
;
Array
.
iter
g
a
|
TailCall
d
->
f
d
|
Ignore
a
->
g
a
|
Impossible
->
()
let
iter_disp_prod
f
=
iter_disp_disp
f
(
iter_disp_disp
f
(
fun
_
->
()
))
let
rec
iter_disp_actions
f
=
function
|
AIgnore
_
->
()
|
AKind
k
->
iter_disp_prod
f
k
.
prod
;
iter_disp_prod
f
k
.
xml
;
(
match
k
.
record
with
Some
(
RecLabel
(
_
,
p
))
->
iter_disp_prod
f
p
|
_
->
()
)
let
actions
disp
=
match
disp
.
actions
with
|
Some
a
->
a
...
...
@@ -1375,10 +1395,14 @@ struct
(
dispatch_record
disp
)
in
disp
.
actions
<-
Some
a
;
iter_disp_actions
(
fun
d
->
to_generate
:=
d
::
!
to_generate
)
a
;
incr
generated
;
a
let
to_print
=
ref
[]
module
DSET
=
Set
.
Make
(
struct
type
t
=
int
let
compare
(
x
:
t
)
(
y
:
t
)
=
x
-
y
end
)
let
printed
=
ref
DSET
.
empty
...
...
@@ -1555,7 +1579,20 @@ struct
|
_
->
assert
false
)
pl
)
in
show
ppf
t
pl
lab
;
(* Format.fprintf ppf "# compiled dispatchers: %i@\n" !cur_id *)
Format
.
fprintf
ppf
"# compiled states: %i@
\n
"
!
generated
let
()
=
Stats
.
register
Stats
.
Summary
(
fun
ppf
->
let
i
=
!
generated
in
Format
.
fprintf
ppf
"Number of compiled states: %i@."
i
;
while
!
to_generate
!=
[]
do
let
d
=
List
.
hd
!
to_generate
in
to_generate
:=
List
.
tl
!
to_generate
;
ignore
(
actions
d
)
done
;
let
j
=
!
generated
in
Format
.
fprintf
ppf
"Total number of states: %i@."
j
)
end
...
...
types/types.ml
View file @
10ff213e
...
...
@@ -454,6 +454,8 @@ type descr = Descr.t
type
node
=
Node
.
t
include
Descr
let
forward_print
=
ref
(
fun
_
_
->
assert
false
)
let
hash_cons
=
DescrHash
.
create
17000
let
count
=
State
.
ref
"Types.count"
0
...
...
@@ -1657,6 +1659,8 @@ struct
DescrHash
.
clear
memo
let
print_node
ppf
n
=
print
ppf
(
descr
n
)
let
()
=
forward_print
:=
print
end
module
Positive
=
...
...
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