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
verimag
synchrone
lutils
Commits
881a4122
Commit
881a4122
authored
Aug 23, 2019
by
erwan
Browse files
Update: remove warnings
parent
1818dc92
Pipeline
#28208
failed with stages
in 1 minute and 26 seconds
Changes
7
Pipelines
1
Hide whitespace changes
Inline
Side-by-side
Makefile.dev
View file @
881a4122
...
...
@@ -67,11 +67,12 @@ opam-rel :
opam-test
:
./sh/make-opam-pack
$(NAME)
-test
###############################
# pushing onto the official repo
WWW
=
"/import/www/DIST-TOOLS/SYNCHRONE"
OPAM_FILE
=
$(
shell
find
$(WWW)
/opam-repository/packages
-name
opam |
head
-1
|
sed
-e
's/^./\U&/'
)
OPAM_FILE
=
$(
shell
find
$(WWW)
/opam-repository/packages
/
$(NAME)
-name
opam
-cnewer
opam |
head
-1
|
sed
-e
's/^./\U&/'
)
OPAM_DIR
=
`
dirname
$(OPAM_FILE)
`
opam-pr
:
cp
$(OPAM_DIR)
/home/jahier/local/opam-repository/packages/
cp
-r
$(OPAM_DIR)
/home/jahier/local/opam-repository/packages/
$(NAME)
xxx
:
echo
"OPAM_FILE=
$(OPAM_FILE)
WWW=
$(WWW)
"
lib/data.ml
View file @
881a4122
(* Time-stamp: <modified the 2
2
/0
5
/2019 (at 1
4:45
) by Erwan Jahier> *)
(* Time-stamp: <modified the 2
3
/0
8
/2019 (at 1
1:32
) by Erwan Jahier> *)
type
ident
=
string
type
v
=
I
of
int
|
F
of
float
|
B
of
bool
...
...
@@ -14,14 +14,14 @@ type t =
|
Alpha
of
int
|
Alias
of
(
string
*
t
)
let
rec
(
val_to_string_type
:
v
->
string
)
=
let
(
val_to_string_type
:
v
->
string
)
=
function
|
I
_
->
"int"
|
F
_
->
"real"
|
B
_
->
"bool"
|
E
(
e
,_
)
->
e
|
S
fl
->
"struct"
|
A
a
->
"array"
|
S
_
->
"struct"
|
A
_
->
"array"
|
U
->
"nil"
let
rec
(
val_to_string
:
(
float
->
string
)
->
v
->
string
)
=
...
...
@@ -41,7 +41,7 @@ let rec (val_to_string : (float -> string) -> v -> string) =
(
!
str
^
"]"
)
|
U
->
"nil"
let
rec
(
val_to_rif_string
:
(
float
->
string
)
->
v
->
string
)
=
let
(
val_to_rif_string
:
(
float
->
string
)
->
v
->
string
)
=
fun
s2f
->
function
|
I
i
->
(
try
string_of_int
i
with
_
->
assert
false
)
...
...
@@ -50,7 +50,7 @@ let rec (val_to_rif_string : (float -> string) -> v -> string) =
|
B
false
->
"f"
|
E
(
e
,_
)
->
e
|
S
fl
->
""
^
(
String
.
concat
";"
(
List
.
map
(
fun
(
fn
,
fv
)
->
" "
^
(
val_to_string
s2f
fv
))
fl
))
^
""
(
List
.
map
(
fun
(
_
fn
,
fv
)
->
" "
^
(
val_to_string
s2f
fv
))
fl
))
^
""
|
A
a
->
let
str
=
ref
""
in
let
f
i
a
=
str
:=
!
str
^
(
if
i
=
0
then
""
else
" "
)
^
(
val_to_string
s2f
a
)
in
...
...
@@ -68,7 +68,7 @@ let rec (type_to_string_gen : bool -> t -> string) =
|
Real
->
"real"
|
Extern
s
->
s
^
"(*extern*)"
(* | Enum (s, sl) -> "enum " ^ s ^ " {" ^ (String.concat ", " sl) ^ "}" *)
|
Enum
(
s
,
sl
)
->
s
|
Enum
(
s
,
_
sl
)
->
s
|
Struct
(
sid
,_
)
->
sid
^
"(*struct*)"
|
Array
(
ty
,
sz
)
->
Printf
.
sprintf
"%s^%d"
(
type_to_string_gen
alias
ty
)
sz
|
Alpha
nb
->
...
...
@@ -106,12 +106,6 @@ type subst = (string * v)
type
access
=
Idx
of
int
|
Fld
of
ident
|
Sle
of
int
*
int
*
int
*
int
let
get_array_elt
a
i
=
match
a
with
|
A
a
->
a
.
(
i
)
|
_
->
assert
false
(* exported *)
let
rec
(
update_val
:
v
->
v
->
access
list
->
v
)
=
fun
pre_v
v
access
->
...
...
@@ -165,16 +159,16 @@ let rec (create_u_val : t -> v) =
a
.
(
i
)
<-
create_u_val
vt
done
;
A
a
|
Struct
(
sn
,
fl
)
->
S
(
List
.
map
(
fun
(
fn
,
ft
)
->
fn
,
create_u_val
ft
)
fl
)
|
Struct
(
_
sn
,
fl
)
->
S
(
List
.
map
(
fun
(
fn
,
ft
)
->
fn
,
create_u_val
ft
)
fl
)
|
_
->
U
(* seems slower (??) *)
let
rec
(
create_val
:
t
->
v
->
access
list
->
v
)
=
let
(
create_val
:
t
->
v
->
access
list
->
v
)
=
fun
vt
v
access
->
let
u_val
=
create_u_val
vt
in
update_val
u_val
v
access
let
rec
(
create_val_alt
:
t
->
v
->
access
list
->
v
)
=
let
(
_
create_val_alt
:
t
->
v
->
access
list
->
v
)
=
fun
vt
v
access
->
match
vt
,
access
with
|
_
,
[]
->
v
...
...
@@ -198,8 +192,9 @@ let rec (create_val_alt : t -> v -> access list -> v) =
let
a_i
=
create_val
vt
v
access
in
a
.
(
i
)
<-
a_i
;
A
a
|
Struct
(
sn
,
fl
)
,
(
Fld
fn
)
::
access
->
S
(
List
.
map
(
fun
(
fn2
,
vt2
)
->
if
fn
=
fn2
then
fn
,
create_val
vt2
v
access
else
fn2
,
U
)
fl
)
|
Struct
(
_sn
,
fl
)
,
(
Fld
fn
)
::
access
->
S
(
List
.
map
(
fun
(
fn2
,
vt2
)
->
if
fn
=
fn2
then
fn
,
create_val
vt2
v
access
else
fn2
,
U
)
fl
)
|
_
,_
->
assert
false
lib/gnuplotRif.ml
View file @
881a4122
(* Time-stamp: <modified the 2
1
/08/2019 (at 1
7:2
4) by Erwan Jahier> *)
(* Time-stamp: <modified the 2
3
/08/2019 (at 1
5:4
4) by Erwan Jahier> *)
(*-----------------------------------------------------------------------
** This file may only be copied under the terms of the CeCill
** Public License
...
...
@@ -61,7 +61,7 @@ let verbose = ref false
let
debug_msg
msg
=
if
!
verbose
then
(
output_string
stdout
(
"
\n
gnuplot-rif: "
^
msg
);
flush
stdout
)
let
(
print_debug
:
string
->
tok
->
unit
)
=
let
(
_
print_debug
:
string
->
tok
->
unit
)
=
fun
msg
tok
->
if
!
verbose
then
(
output_string
stdout
((
string_of_int
(
Stream
.
count
tok
))
^
": "
^
msg
);
...
...
@@ -275,13 +275,13 @@ let gen_gnuplot_file vars to_hide ttbl file tk =
in
let
bool_nb
=
List
.
fold_left
(
fun
cpt
(
id
,
(
t
,_,
ii
))
->
if
t
=
"bool"
&&
not
(
to_hide
id
)
then
cpt
+
1
else
cpt
)
(
fun
cpt
(
id
,
(
t
,_,
_
ii
))
->
if
t
=
"bool"
&&
not
(
to_hide
id
)
then
cpt
+
1
else
cpt
)
0
ttbl
in
let
num_nb
=
List
.
fold_left
(
fun
cpt
(
id
,
(
t
,_,
ii
))
->
if
t
<>
"bool"
&&
not
(
to_hide
id
)
then
cpt
+
1
else
cpt
)
(
fun
cpt
(
id
,
(
t
,_,
_
ii
))
->
if
t
<>
"bool"
&&
not
(
to_hide
id
)
then
cpt
+
1
else
cpt
)
0
ttbl
in
...
...
@@ -318,12 +318,12 @@ scale_bool(x,i) = min + 1.7*i*delta + (x*delta)
label_pos(i)=min + i*delta*1.7+delta*0.5
"
^
(
if
!
dynamic
then
(
"set xtics "
^
(
string_of_int
(
!
window_size
/
10
)))
else
match
!
min_step
,!
max_step
with
|
None
,
None
->
""
|
Some
l
,
None
->
""
|
None
,
Some
h
->
"set xtics "
^
(
string_of_int
(
h
/
10
))
|
Some
l
,
Some
h
->
"set xtics "
^
(
string_of_int
((
h
-
l
)
/
10
))
)
^
"
\n
"
);
match
!
min_step
,!
max_step
with
|
None
,
None
->
""
|
Some
_
l
,
None
->
""
|
None
,
Some
h
->
"set xtics "
^
(
string_of_int
(
h
/
10
))
|
Some
l
,
Some
h
->
"set xtics "
^
(
string_of_int
((
h
-
l
)
/
10
))
)
^
"
\n
"
);
put
(
terminal_kind_to_string
tk
file
);
put
"
\n
plot "
;
ignore
...
...
@@ -346,7 +346,7 @@ label_pos(i)=min + i*delta*1.7+delta*0.5
put
"
\n\n
unset label
\n
"
;
bool_var_nb
:=
0
;
List
.
iter
(
fun
(
id
,
(
t
,
pos
,
ii
))
->
(
fun
(
id
,
(
t
,
_
pos
,
_
ii
))
->
if
(
to_hide
id
)
then
debug_msg
(
"Hidding "
^
id
^
"
\n
"
);
if
t
=
"bool"
then
(
if
(
to_hide
id
)
then
()
else
(
...
...
lib/localGenlex.ml
View file @
881a4122
...
...
@@ -229,18 +229,18 @@ let make_lexer keywords =
match
Stream
.
peek
strm__
with
Some
'
(
'
->
Stream
.
junk
strm__
;
maybe_nested_comment
strm__
|
Some
'
*
'
->
Stream
.
junk
strm__
;
maybe_end_comment
strm__
|
Some
c
->
Stream
.
junk
strm__
;
comment
strm__
|
Some
_
c
->
Stream
.
junk
strm__
;
comment
strm__
|
_
->
raise
Stream
.
Failure
and
maybe_nested_comment
(
strm__
:
_
Stream
.
t
)
=
match
Stream
.
peek
strm__
with
Some
'
*
'
->
Stream
.
junk
strm__
;
let
s
=
strm__
in
comment
s
;
comment
s
|
Some
c
->
Stream
.
junk
strm__
;
comment
strm__
|
Some
_
c
->
Stream
.
junk
strm__
;
comment
strm__
|
_
->
raise
Stream
.
Failure
and
maybe_end_comment
(
strm__
:
_
Stream
.
t
)
=
match
Stream
.
peek
strm__
with
Some
'
)
'
->
Stream
.
junk
strm__
;
()
|
Some
'
*
'
->
Stream
.
junk
strm__
;
maybe_end_comment
strm__
|
Some
c
->
Stream
.
junk
strm__
;
comment
strm__
|
Some
_
c
->
Stream
.
junk
strm__
;
comment
strm__
|
_
->
raise
Stream
.
Failure
in
fun
input
->
Stream
.
from
(
fun
_count
->
next_token
input
)
lib/luciole.ml
View file @
881a4122
(* Time-stamp: <modified the
01
/0
2
/2019 (at 1
0:45
) by Erwan Jahier> *)
(* Time-stamp: <modified the
23
/0
8
/2019 (at 1
1:34
) by Erwan Jahier> *)
(*-----------------------------------------------------------------------
** This file may only be copied under the terms of the CeCill
** Public License
...
...
@@ -12,16 +12,14 @@
(* Var name and C type *)
type
vn_ct
=
string
*
string
let
soi
=
string_of_int
(** Generates stub files for calling luciole. *)
(** Generate a Makefile that compiles files generated by gen_stubs,
and calls luciole on the resulting .dro file.
the first arg is a just a string used to invent file names
*)
let
(
gen_makefile
:
string
->
unit
)
=
let
(
_
gen_makefile
:
string
->
unit
)
=
fun
str
->
let
oc
=
open_out
(
"Makefile."
^
str
)
in
let
p
s
=
output_string
oc
s
in
...
...
@@ -69,7 +67,7 @@ let (gen_stubs : string -> vn_ct list -> vn_ct list -> unit) =
|
"_real"
|
"real"
|
"float"
|
"double"
->
"real"
|
"_bool"
|
"bool"
->
"bool"
|
"_int"
->
"int"
|
e
->
"int"
|
_
e
->
"int"
in
let
vn_ct_to_array
(
vn
,
ct
)
=
pn
(
" {
\"
"
^
vn
^
"
\"
,
\"
"
^
(
d2r
ct
)
^
"
\"
, NULL},"
)
...
...
@@ -82,11 +80,11 @@ let (gen_stubs : string -> vn_ct list -> vn_ct list -> unit) =
(
i
+
1
)
in
let
vn_ct_to_input_init
i
(
vn
,
ct
)
=
let
vn_ct_to_input_init
i
(
vn
,
_
ct
)
=
pn
(
" _intab["
^
(
string_of_int
i
)
^
"].valptr = (void*)(& _THIS->_"
^
vn
^
");"
);
(
i
+
1
)
in
let
vn_ct_to_output_init
i
(
vn
,
ct
)
=
let
vn_ct_to_output_init
i
(
vn
,
_
ct
)
=
pn
(
" _outab["
^
(
string_of_int
i
)
^
"].valptr = (void*)(& _THIS->_"
^
vn
^
");"
);
(
i
+
1
)
in
...
...
lib/mypervasives.ml
View file @
881a4122
(* Time-stamp: <modified the
15
/0
5
/2019 (at 1
0:55
) by Erwan Jahier> *)
(* Time-stamp: <modified the
23
/0
8
/2019 (at 1
1:29
) by Erwan Jahier> *)
(* Should rather be named misc or utils *)
...
...
@@ -19,7 +19,7 @@ let (readfile: ?verbose:bool ->string -> string) =
fun
?
(
verbose
=
false
)
file
->
if
verbose
then
(
Printf
.
eprintf
"Reading %s...
\n
"
file
;
flush
stderr
);
try
let
rec
(
readfile_ic
:
in_channel
->
bytes
)
=
let
(
readfile_ic
:
in_channel
->
bytes
)
=
fun
ic
->
let
ic_l
=
in_channel_length
ic
in
let
str_buf
=
Bytes
.
make
ic_l
'
'
in
...
...
lib/rifIO.ml
View file @
881a4122
(* Time-stamp: <modified the
10
/0
7
/2019 (at 1
7:41
) by Erwan Jahier> *)
(* Time-stamp: <modified the
23
/0
8
/2019 (at 1
1:35
) by Erwan Jahier> *)
(*-----------------------------------------------------------------------
** This file may only be copied under the terms of the CeCILL
** Public License
...
...
@@ -22,11 +22,11 @@ let dflt_pragmas = ["inputs";"reset";"quit"]
type
stream
=
LocalGenlex
.
token
Stream
.
t
let
rec
(
parse_string_list
:
stream
->
string
list
->
string
list
)
=
let
rec
(
_
parse_string_list
:
stream
->
string
list
->
string
list
)
=
fun
stream
sl
->
try
(
match
(
Stream
.
next
stream
)
with
(
LocalGenlex
.
String
(
str
))
->
parse_string_list
stream
(
str
::
sl
)
(
LocalGenlex
.
String
(
str
))
->
_
parse_string_list
stream
(
str
::
sl
)
|
_
->
failwith
(
"### rif parse error. A
\"
string
\"
(wrapped with double"
^
"quotes) was expected.
\n
"
)
)
...
...
@@ -102,7 +102,7 @@ let rec (read_until_pragma_end :?debug:(bool) -> in_channel -> out_channel optio
read_until_pragma_end
~
debug
:
debug
ic
oc
(
str
^
" "
^
line
)
(* exported *)
let
rec
(
read_interface
:
?
debug
:
(
bool
)
->
?
label
:
(
string
)
->
in_channel
->
let
(
read_interface
:
?
debug
:
(
bool
)
->
?
label
:
(
string
)
->
in_channel
->
out_channel
option
->
vntl
*
vntl
)
=
fun
?
(
debug
=
false
)
?
(
label
=
""
)
ic
oc
->
let
rec
loop
ins
outs
in_done
out_done
=
...
...
@@ -152,10 +152,10 @@ let rec (read_interface : ?debug:(bool) -> ?label:(string) -> in_channel ->
(* exported *)
(** Reads input values on ic. It should follow the rif format. *)
let
rec
(
read
:
?
debug
:
(
bool
)
->
?
label
:
(
string
)
->
?
pragma
:
(
string
list
)
->
in_channel
->
out_channel
option
->
vntl
->
subst
list
)
=
fun
?
(
debug
=
false
)
?
(
label
=
""
)
?
(
pragma
=
dflt_pragmas
)
ic
oc
vntl
->
(** Reads input values on ic. It should follow the rif format. *)
let
tbl
=
[]
in
if
vntl
=
[]
then
tbl
else
let
str
,
stream
=
get_stream
debug
label
ic
oc
in
...
...
@@ -361,7 +361,7 @@ let (write_outputs : out_channel -> (float -> string) -> vntl -> subst list -> u
fun
oc
s2f
vntl
sl
->
let
str
=
List
.
fold_left
(
fun
acc
(
vn
,
vt
)
->
(
fun
acc
(
vn
,
_
vt
)
->
acc
^
(
try
Data
.
val_to_string
s2f
(
List
.
assoc
vn
sl
)
with
|
Not_found
->
...
...
Write
Preview
Supports
Markdown
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