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
sasa
Commits
a331f5b6
Commit
a331f5b6
authored
Jul 05, 2019
by
erwan
Browse files
New: Add various graph info (card, adjency matrix, etc.) into the generated oracles
parent
6618348f
Pipeline
#26704
passed with stages
in 9 minutes and 33 seconds
Changes
8
Pipelines
2
Hide whitespace changes
Inline
Side-by-side
lib/sasacore/genOracle.ml
View file @
a331f5b6
(* Time-stamp: <modified the 05/07/2019 (at 1
5
:2
5
) by Erwan Jahier> *)
(* Time-stamp: <modified the 05/07/2019 (at 1
7
:2
9
) by Erwan Jahier> *)
open
Process
let
b2s
b
=
if
b
then
"t"
else
"f"
let
(
f
:
'
v
Process
.
t
list
->
string
)
=
fun
pl
->
let
degree
=
Register
.
max_degree
()
in
let
diameter
=
Register
.
diameter
()
in
let
(
array_to_string
:
bool
array
->
string
)
=
fun
a
->
let
l
=
Array
.
fold_right
(
fun
b
acc
->
(
b2s
b
)
::
acc
)
a
[]
in
"["
^
(
String
.
concat
","
l
)
^
"]"
let
(
matrix_to_string
:
bool
array
array
->
string
)
=
fun
m
->
let
l
=
Array
.
fold_right
(
fun
a
acc
->
(
array_to_string
a
)
::
acc
)
m
[]
in
"[
\n\t
"
^
(
String
.
concat
",
\n\t
"
l
)
^
"]"
let
graph_attributes_to_string
()
=
let
al
=
Register
.
graph_attribute_list
()
in
let
l
=
List
.
map
(
fun
(
n
,
v
)
->
Printf
.
sprintf
"const %s=%s;
\n
"
n
v
)
al
in
String
.
concat
""
l
let
(
f
:
Topology
.
t
->
'
v
Process
.
t
list
->
string
)
=
fun
g
pl
->
let
actions_nb
=
List
.
map
(
fun
p
->
List
.
length
p
.
actions
)
pl
in
let
m
=
List
.
fold_left
max
(
List
.
hd
actions_nb
)
(
List
.
tl
actions_nb
)
in
let
n
=
List
.
length
pl
in
...
...
@@ -38,8 +52,16 @@ let (f: 'v Process.t list -> string) =
const an=%d; -- actions number
const pn=%d; -- processes number
const degree=%d;
const min_degree=%d;
const mean_degree=%f;
const diameter=%d;
const card=%d;
const links_number=%d;
const is_cyclic=%b;
const is_connected=%b;
const is_a_tree=%b;
const adjency=%s;
%s
node oracle(%s) returns (ok:bool);
var
%slet
...
...
@@ -49,7 +71,18 @@ tel
"
(
Mypervasives
.
entete
"--"
SasaVersion
.
str
SasaVersion
.
sha
)
algo
m
n
degree
diameter
m
n
(
Register
.
max_degree
()
)
(
Register
.
min_degree
()
)
(
Register
.
mean_degree
()
)
(
Register
.
diameter
()
)
(
Register
.
card
()
)
(
Register
.
links_number
()
)
(
Register
.
is_cyclic
()
)
(
Register
.
is_connected
()
)
(
Register
.
is_tree
()
)
(
matrix_to_string
(
Topology
.
to_adjency
g
))
(
graph_attributes_to_string
()
)
input_decl
array_decl
array_def_acti
...
...
lib/sasacore/genOracle.mli
View file @
a331f5b6
(* Time-stamp: <modified the
2
5/0
6
/2019 (at 1
1:13
) by Erwan Jahier> *)
(* Time-stamp: <modified the
0
5/0
7
/2019 (at 1
6:35
) by Erwan Jahier> *)
(** generates oracle skeletons *)
val
f
:
'
v
Process
.
t
list
->
string
val
f
:
Topology
.
t
->
'
v
Process
.
t
list
->
string
lib/sasacore/register.ml
View file @
a331f5b6
(* Time-stamp: <modified the 0
4
/07/2019 (at 1
0:35
) by Erwan Jahier> *)
(* Time-stamp: <modified the 0
5
/07/2019 (at 1
7:27
) by Erwan Jahier> *)
type
'
s
neighbor
=
{
state
:
'
s
;
...
...
@@ -275,3 +275,7 @@ let (get_graph_attribute : string -> string) =
let
(
set_graph_attribute
:
string
->
string
->
unit
)
=
Hashtbl
.
replace
tbls
.
graph_attributes
let
(
graph_attribute_list
:
unit
->
(
string
*
string
)
list
)
=
fun
()
->
Hashtbl
.
fold
(
fun
n
v
acc
->
(
n
,
v
)
::
acc
)
tbls
.
graph_attributes
[]
lib/sasacore/register.mli
View file @
a331f5b6
(* Time-stamp: <modified the 0
4
/07/2019 (at 1
0:34
) by Erwan Jahier> *)
(* Time-stamp: <modified the 0
5
/07/2019 (at 1
7:27
) by Erwan Jahier> *)
type
'
s
neighbor
=
{
state
:
'
s
;
...
...
@@ -44,6 +44,7 @@ val set_diameter : (unit -> int) -> unit
val
get_graph_attribute
:
string
->
string
val
set_graph_attribute
:
string
->
string
->
unit
val
graph_attribute_list
:
unit
->
(
string
*
string
)
list
val
card
:
unit
->
int
val
min_degree
:
unit
->
int
...
...
lib/sasacore/sasa.ml
View file @
a331f5b6
(* Time-stamp: <modified the
2
5/0
6
/2019 (at 1
1:1
4) by Erwan Jahier> *)
(* Time-stamp: <modified the
0
5/0
7
/2019 (at 1
6:3
4) by Erwan Jahier> *)
open
Register
open
Sasacore
...
...
@@ -285,7 +285,7 @@ let (make : bool -> string array -> 'v t) =
flush
stderr
;
exit
1
)
else
let
oc
=
open_out
fn
in
Printf
.
fprintf
oc
"%s"
(
GenOracle
.
f
pl
);
Printf
.
fprintf
oc
"%s"
(
GenOracle
.
f
g
pl
);
flush
oc
;
close_out
oc
;
exit
0
);
...
...
lib/sasacore/topology.ml
View file @
a331f5b6
(* Time-stamp: <modified the 0
3
/07/2019 (at 1
0:18
) by Erwan Jahier> *)
(* Time-stamp: <modified the 0
5
/07/2019 (at 1
6:32
) by Erwan Jahier> *)
open
Graph
open
Graph
.
Dot_ast
...
...
@@ -126,3 +126,17 @@ let (read: string -> t) = fun f ->
failwith
(
str
^
" unknown node id"
)
)
}
let
(
to_adjency
:
t
->
bool
array
array
)
=
fun
t
->
let
n
=
List
.
length
t
.
nodes
in
let
rank_node_tbl
=
Hashtbl
.
create
n
in
let
m
=
Array
.
make_matrix
n
n
false
in
let
rank_node
=
Hashtbl
.
find
rank_node_tbl
in
List
.
iteri
(
fun
i
n
->
Hashtbl
.
add
rank_node_tbl
n
.
id
i
)
t
.
nodes
;
List
.
iteri
(
fun
i
n
->
List
.
iter
(
fun
(
_
,
target
)
->
m
.
(
i
)
.
(
rank_node
target
)
<-
true
)
(
t
.
succ
n
.
id
)
)
t
.
nodes
;
m
lib/sasacore/topology.mli
View file @
a331f5b6
(* Time-stamp: <modified the
21
/0
6
/2019 (at 1
8
:1
3
) by Erwan Jahier> *)
(* Time-stamp: <modified the
05
/0
7
/2019 (at 1
6
:1
9
) by Erwan Jahier> *)
type
node_id
=
string
type
node
=
{
...
...
@@ -16,3 +16,7 @@ type t = {
(** Parse a sasa dot file *)
val
read
:
string
->
t
val
to_adjency
:
t
->
bool
array
array
test/bfs-spanning-tree/fig5.1.dot
View file @
a331f5b6
graph
fig4_1
{
graph
[
k
=
42
]
p1
[
algo
=
"root.ml"
init
=
"{d=2;par=0}"
]
p2
[
algo
=
"p.ml"
init
=
"{d=0;par=0}"
]
...
...
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