Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
verimag
synchrone
lutin
Commits
9d0c853a
Commit
9d0c853a
authored
Apr 12, 2019
by
erwan
Browse files
Update: monadisation of Lutin, part 4.
Rationale: make rdbg time traveling work.
parent
7a6ac267
Changes
23
Expand all
Hide whitespace changes
Inline
Side-by-side
_oasis
View file @
9d0c853a
...
...
@@ -27,7 +27,7 @@ Executable lutin
Path: lutin/src
MainIs: main.ml
BuildDepends: str,unix,num,rdbg-plugin (>= 1.177),lutin-utils,ezdl,gbddml,polka,camlp4,camlidl,gmp
NativeOpt: -package num # XXX turn around a bug in oasis/ocamlbuild/ocamlfind?
NativeOpt:
-warn-error "+26"
-package num # XXX turn around a bug in oasis/ocamlbuild/ocamlfind?
Build: true
Install:true
CompiledObject: native
...
...
ltop/src/lurettetop.ml
View file @
9d0c853a
...
...
@@ -73,7 +73,7 @@ let main_read_arg () =
args
.
tmp_dir
<-
lurette_tmp_dir
;
Unix
.
putenv
"TMPDIR"
(
String
.
escaped
lurette_tmp_dir
)
;
in
let
source_dir
=
(
Filename
.
concat
(
ExtTools
.
lurette_path
()
)
"source"
)
in
let
_
source_dir
=
(
Filename
.
concat
(
ExtTools
.
lurette_path
()
)
"source"
)
in
match
args
.
sut_compiler
with
|
Scade
->
assert
false
|
VerimagV4
...
...
ltop/src/runDirect.ml
View file @
9d0c853a
...
...
@@ -89,7 +89,7 @@ let (make_rp_list : reactive_program list ->
(
Data
.
subst
list
->
ctx
->
(
Data
.
subst
list
->
ctx
->
Event
.
t
)
->
Event
.
t
)
list
*
Data
.
subst
list
list
*
Data
.
subst
list
list
)
=
fun
rpl
->
let
add_init
init
(
a
,
b
,
c
,
d
,
e
)
=
(
a
,
b
,
c
,
d
,
e
,
init
,
init
)
in
let
_
add_init
init
(
a
,
b
,
c
,
d
,
e
)
=
(
a
,
b
,
c
,
d
,
e
,
init
,
init
)
in
let
aux
rp
=
let
plugin
=
match
rp
with
...
...
lurette-nocaml/src/lurette.ml
View file @
9d0c853a
(* Time-stamp: <modified the
29
/0
3
/2019 (at 14:5
3
) by Erwan Jahier> *)
(* Time-stamp: <modified the
11
/0
4
/2019 (at 14:5
6
) by Erwan Jahier> *)
(* Mimick the behavior of 'rdbg -lurette', but without the dependency
on ocaml *)
open
Event
...
...
@@ -77,11 +77,11 @@ let _ =
args
.
verbose
<-
if
!
verbose
then
1
else
0
;
args
.
output
<-
!
output_file
;
args
.
overwrite_output
=
!
overwrite_output
;
args
.
stop_on_oracle_error
=
not
!
dont_stop_on_oracle_error
;
args
.
log
=
!
log
;
args
.
cov_file
=
!
cov_file
;
args
.
reset_cov_file
=
!
reset_cov_file
;
args
.
overwrite_output
<-
!
overwrite_output
;
args
.
stop_on_oracle_error
<-
not
!
dont_stop_on_oracle_error
;
args
.
log
<-
!
log
;
args
.
cov_file
<-
!
cov_file
;
args
.
reset_cov_file
<-
!
reset_cov_file
;
args
.
debug_rdbg
<-
!
drdbg
;
args
.
rdbg
<-
false
;
...
...
lutin/src/auto2Lucky.ml
View file @
9d0c853a
...
...
@@ -42,13 +42,13 @@ let print_header
)
open
Util
let
make
(
srcname
:
string
)
(
mnode
:
string
)
(
auto
:
AutoGen
.
t
)
(
os
:
Pervasives
.
out_channel
)
=
(
(* le source au cas ou ... *)
let
source_code
=
AutoGen
.
source
auto
in
...
...
@@ -61,8 +61,7 @@ let make
let
etab2prof
s
xi
acc
=
(
(
s
,
xi
.
xi_prof
)
::
acc
)
in
let
xlist
=
Hashtbl
.
fold
etab2prof
(
Expand
.
extern_tab
source_code
)
[]
in
let
xlist
=
Util
.
StringMap
.
fold
etab2prof
(
Expand
.
extern_tab
source_code
)
[]
in
if
(
xlist
=
[]
)
then
()
else
(
fprintf
os
"
\n
functions {
\n
"
;
...
...
@@ -79,7 +78,7 @@ let make
(* pour les dumps des vars support *)
(* Hashtbl.iter (print_support Local) (Expand.support_tab source_code); *)
let
print_support
nme
=
(
let
info
=
Util
.
hfind
(
Expand
.
support_tab
source_code
)
nme
in
let
info
=
Util
.
StringMap
.
find
nme
(
Expand
.
support_tab
source_code
)
in
fprintf
os
" %s : %s"
(
CoIdent
.
to_string
nme
)
(
CkTypeEff
.
to_string
info
.
si_type
);
...
...
@@ -104,8 +103,7 @@ let make
(* pour les dumps de la liste d'alias *)
let
print_alias
nme
=
(
let
info
=
Util
.
hfind
(
Expand
.
alias_tab
source_code
)
nme
in
let
info
=
StringMap
.
find
nme
(
Expand
.
alias_tab
source_code
)
in
fprintf
os
" %s : %s"
(
CoIdent
.
to_string
nme
)
(
CkTypeEff
.
to_string
info
.
ai_type
);
...
...
lutin/src/autoExplore.ml
deleted
100644 → 0
View file @
7a6ac267
This diff is collapsed.
Click to expand it.
lutin/src/autoGen.ml
View file @
9d0c853a
...
...
@@ -354,12 +354,8 @@ let gentrans
(* Correspondance id de trace -> trace exp
N.B. on traque les récursions ? *)
(*-------------------------------------------*)
let
id2trace
s
=
(
(
Util
.
hfind
(
Expand
.
trace_tab
xenv
)
s
)
.
ti_def_exp
)
in
let
unalias
s
=
(
(
Util
.
hfind
(
Expand
.
alias_tab
xenv
)
s
)
.
ai_def_exp
)
in
let
id2trace
s
=
(
StringMap
.
find
s
(
Expand
.
trace_tab
xenv
))
.
ti_def_exp
in
let
unalias
s
=
(
StringMap
.
find
s
(
Expand
.
alias_tab
xenv
))
.
ai_def_exp
in
(*-------------------------------------------*)
(* LA FONCTION RÉCURSIVE *)
...
...
@@ -891,7 +887,7 @@ let init (xenv : Expand.t) =
}
in
let
is
=
Expand
.
main_trace
xenv
in
let
ie
=
(
Util
.
h
find
(
Expand
.
trace_tab
xenv
)
is
)
.
ti_def_exp
in
let
ie
=
(
Util
.
StringMap
.
find
is
(
Expand
.
trace_tab
xenv
))
.
ti_def_exp
in
let
init_control
,
res
=
get_stable
res
ie
in
let
final_control
,
res
=
get_sink
res
"vanish"
in
{
res
with
...
...
@@ -924,12 +920,9 @@ let rec ttree2trans (it:t) (src: string) (tt : ttree) = (
)
let
get_state_def
(
it
:
t
)
(
ix
:
string
)
=
StringMap
.
find
ix
it
._
state2trace
let
get_state_def
(
it
:
t
)
(
ix
:
string
)
=
StringMap
.
find
ix
it
._
state2trace
let
get_state_info
(
it
:
t
)
(
ix
:
string
)
=
StringMap
.
find
ix
it
.
states
let
get_state_info
(
it
:
t
)
(
ix
:
string
)
=
StringMap
.
find
ix
it
.
states
(*
*)
...
...
lutin/src/ckTypeEff.ml
View file @
9d0c853a
...
...
@@ -191,20 +191,20 @@ let rec of_texp = ( function
x ref -> x
*)
let
lifts_to
t1
t2
=
(
let
res
=
(
t1
=
t2
)
or
((
t1
=
boolref
)
&&
(
t2
=
boolean
))
or
((
t1
=
boolean
)
&&
(
t2
=
trace
))
or
((
t1
=
boolref
)
&&
(
t2
=
trace
))
or
((
t1
=
integer
)
&&
(
t2
=
weight
))
or
((
t1
=
intref
)
&&
(
t2
=
weight
))
or
(
match
(
t1
,
t2
)
with
(
TEFF_ref
x
,
TEFF_data
y
)
->
(
x
=
y
)
|
_
->
false
)
in
res
let
res
=
(
t1
=
t2
)
||
((
t1
=
boolref
)
&&
(
t2
=
boolean
))
||
((
t1
=
boolean
)
&&
(
t2
=
trace
))
||
((
t1
=
boolref
)
&&
(
t2
=
trace
))
||
((
t1
=
integer
)
&&
(
t2
=
weight
))
||
((
t1
=
intref
)
&&
(
t2
=
weight
))
||
(
match
(
t1
,
t2
)
with
(
TEFF_ref
x
,
TEFF_data
y
)
->
(
x
=
y
)
|
_
->
false
)
in
res
)
(* compatibilit d'un profil avec une liste de types de params
Renvoie le type eff du rsultat ou lve une exception :
...
...
lutin/src/coAlgExp.ml
View file @
9d0c853a
...
...
@@ -95,7 +95,7 @@ let of_alias i t c =
{
ae_type
=
t
;
ae_ctrl
=
c
;
ae_val
=
AE_alias
i
}
let
of_call
i
t
args
=
(
let
f
b
ae
=
(
b
or
ae
.
ae_ctrl
)
in
let
f
b
ae
=
(
b
||
ae
.
ae_ctrl
)
in
let
c
=
List
.
fold_left
f
false
args
in
{
ae_type
=
t
;
ae_ctrl
=
c
;
ae_val
=
AE_call
(
i
,
args
)}
)
...
...
lutin/src/exp.ml
View file @
9d0c853a
...
...
@@ -238,7 +238,7 @@ let rec (simplifie_a_little : formula -> formula) =
let
f1'
=
simplifie_a_little
f1
and
f2'
=
simplifie_a_little
f2
in
if
f1
<>
f1'
or
f2
<>
f2'
then
if
f1
<>
f1'
||
f2
<>
f2'
then
simplifie_a_little
(
And
(
f1'
,
f2'
))
else
And
(
f1'
,
f2'
)
...
...
@@ -246,7 +246,7 @@ let rec (simplifie_a_little : formula -> formula) =
let
f1'
=
simplifie_a_little
f1
and
f2'
=
simplifie_a_little
f2
in
let
f12'
=
Or
(
f1'
,
f2'
)
in
if
f1
<>
f1'
or
f2
<>
f2'
then
if
f1
<>
f1'
||
f2
<>
f2'
then
simplifie_a_little
f12'
else
f12'
...
...
lutin/src/expand.ml
View file @
9d0c853a
This diff is collapsed.
Click to expand it.
lutin/src/expand.mli
View file @
9d0c853a
...
...
@@ -49,26 +49,28 @@ val make : CheckEnv.t -> Syntaxe.package -> string -> t
type
support_scope
type
support_nature
=
Input
|
Output
|
LocalIn
|
LocalOut
and
support_info
=
{
|
Input
|
Output
|
LocalIn
|
LocalOut
type
support_info
=
{
si_ident
:
CoIdent
.
t
;
si_nature
:
support_nature
;
si_type
:
CkTypeEff
.
t
;
si_ref_exp
:
CoAlgExp
.
t
;
si_src
:
CoIdent
.
src_stack
;
(* on ne la crée qu'à la demande *)
mutable
si_pre_ref_exp
:
CoAlgExp
.
t
option
;
si_pre_ref_exp
:
CoAlgExp
.
t
option
;
si_default
:
CoAlgExp
.
t
option
;
si_scope
:
support_scope
option
;
si_init
:
CoAlgExp
.
t
option
;
si_range
:
(
CoAlgExp
.
t
*
CoAlgExp
.
t
)
option
;
}
open
Util
(* support_info that are actually used in pre's *)
val
support_tab
:
t
->
(
CoIdent
.
t
,
support_info
)
Hashtbl
.
t
val
support_tab
:
t
->
support_info
StringMap
.
t
(* support_info that are actually used in pre's *)
val
support_pres
:
t
->
(
CoIdent
.
t
*
support_info
)
list
...
...
@@ -91,12 +93,12 @@ type alias_info = {
ai_src
:
CoIdent
.
src_stack
}
val
alias_tab
:
t
->
(
CoIdent
.
t
,
alias_info
)
Hashtbl
.
t
val
alias_tab
:
t
->
alias_info
StringMap
.
t
val
alias_list
:
t
->
CoIdent
.
t
list
(* Run tab *)
(* not necessary ?
val run_tab : t -> (CoIdent.t, t)
Hashtbl
.t
val run_tab : t -> (CoIdent.t, t)
StringMap
.t
*)
val
get_run_expanded_code
:
t
->
CoIdent
.
t
->
t
...
...
@@ -108,7 +110,7 @@ type trace_info = {
ti_src
:
CoIdent
.
src_stack
;
}
val
trace_tab
:
t
->
(
CoIdent
.
t
,
trace_info
)
Hashtbl
.
t
val
trace_tab
:
t
->
trace_info
StringMap
.
t
val
get_trace_info
:
t
->
CoIdent
.
t
->
trace_info
...
...
@@ -124,7 +126,7 @@ type extern_info = {
xi_src
:
Lexeme
.
t
}
val
extern_tab
:
t
->
(
string
,
extern_info
)
Hashtbl
.
t
val
extern_tab
:
t
->
extern_info
StringMap
.
t
(** Identificateur (target) de la trace principale *)
val
main_trace
:
t
->
CoIdent
.
t
...
...
lutin/src/luc2alice.ml
View file @
9d0c853a
...
...
@@ -233,15 +233,9 @@ let (gen_alice_stub_c : alice_args -> unit) =
fun
args
->
let
amn
=
Filename
.
basename
args
.
alice_module_name
in
let
oc
=
my_open_out
(
Filename
.
concat
args
.
output_dir
(
amn
^
".cpp"
))
in
let
put
s
=
output_string
oc
s
in
let
putln
s
=
output_string
oc
(
s
^
"
\n
"
)
in
let
rec
putlist
=
function
[]
->
()
|
[
x
]
->
put
x
|
x
::
l'
->
put
x
;
put
", "
;
putlist
l'
in
putln
(
Util
.
entete
"// "
""
);
putln
(
gen_alice_stub
args
)
putln
(
Util
.
entete
"// "
""
);
putln
(
gen_alice_stub
args
)
let
(
gen_alice_stub_h
:
alice_args
->
unit
)
=
...
...
lutin/src/luc2c.ml
View file @
9d0c853a
...
...
@@ -480,7 +480,7 @@ Input procedures must be used:
)
in_vars
;
let
lut_file
=
(
List
.
hd
option
.
env
)
(* only work with lutin XXX fixme? *)
in
let
_
lut_file
=
(
List
.
hd
option
.
env
)
(* only work with lutin XXX fixme? *)
in
(* let lut_dir = Filename.dirname lut_file in *)
putln
(
"
/*--------
...
...
lutin/src/lucFGen.ml
View file @
9d0c853a
...
...
@@ -83,119 +83,119 @@ let (get_all_formula: t -> formula list) =
fun
a
->
let
rec
aux
a
acc
=
let
(
a'
,
f
,
_nl
)
=
choose_one_formula
a
in
if
no_more_formula
a'
then
acc
else
(
aux
a'
(
f
::
acc
))
if
no_more_formula
a'
then
acc
else
(
aux
a'
(
f
::
acc
))
in
aux
a
[]
(****************************************************************************)
let
rec
(
wt_list_to_cont
:
Var
.
env_in
->
Prog
.
state
->
wt_cont
list
->
formula
->
node
list
->
t
->
t
)
=
formula
->
node
list
->
t
->
t
)
=
fun
input
state
wtl
facc
nl
fgen
->
(* [nl] is the list of nodes that correspond to [facc] *)
let
_
=
if
debug
then
(
print_string
"XXX wt_list_to_cont
\n
"
;
flush
stdout
)
in
match
wtl
with
|
[]
->
Cont
(
fun
()
->
(
fgen
,
facc
,
nl
))
|
wt
::
wtl'
->
if
wt
=
WFinish
then
fgen
else
match
choose_one_formula_atomic
input
state
facc
wt
with
|
WFinish
,
False
,
""
->
fgen
|
WStop
str
,
_
,
""
->
RStop
str
|
wt2
,
f2
,
n
->
let
fgen'
=
Cont
(
fun
()
->
call_cont
(
wt_list_to_cont
input
state
(
wt2
::
wtl'
)
facc
nl
fgen
))
in
wt_list_to_cont
input
state
wtl'
f2
(
n
::
nl
)
fgen'
match
wtl
with
|
[]
->
Cont
(
fun
()
->
(
fgen
,
facc
,
nl
))
|
wt
::
wtl'
->
if
wt
=
WFinish
then
fgen
else
match
choose_one_formula_atomic
input
state
facc
wt
with
|
WFinish
,
False
,
""
->
fgen
|
WStop
str
,
_
,
""
->
RStop
str
|
wt2
,
f2
,
n
->
let
fgen'
=
Cont
(
fun
()
->
call_cont
(
wt_list_to_cont
input
state
(
wt2
::
wtl'
)
facc
nl
fgen
))
in
wt_list_to_cont
input
state
wtl'
f2
(
n
::
nl
)
fgen'
and
(
choose_one_formula_atomic
:
Var
.
env_in
->
Prog
.
state
->
Exp
.
formula
->
wt_cont
->
wt_cont
*
formula
*
node
)
=
(
choose_one_formula_atomic
:
Var
.
env_in
->
Prog
.
state
->
Exp
.
formula
->
wt_cont
->
wt_cont
*
formula
*
node
)
=
fun
input
state
facc
cont
->
let
_
=
if
debug
then
(
print_string
"XXX choose_one_formula_atomic
\n
"
;
flush
stdout
)
in
match
cont
with
|
WFinish
->
WFinish
,
False
,
""
|
WStop
_
->
cont
,
True
,
""
|
WCont
_
->
let
(
cont'
,
f
,
n
)
=
call_wt_cont
cont
in
let
_
=
if
debug
then
(
print_string
(
"XXX "
^
n
^
"
\n
"
);
flush
stdout
)
in
let
facc'
=
match
f
,
facc
with
True
,
True
->
True
|
True
,
f
->
f
|
f
,
True
->
f
|
_
,_
->
And
(
f
,
facc
)
in
let
ctx_msg
=
Prog
.
ctrl_state_to_string_long
state
.
d
.
ctrl_state
in
Utils
.
time_C
"is_sat"
;
let
sat
=
(
Solver
.
is_satisfiable
input
state
.
d
.
memory
state
.
d
.
verbose
ctx_msg
facc'
""
)
in
Utils
.
time_R
"is_sat"
;
if
sat
then
(
cont'
,
facc'
,
n
)
else
choose_one_formula_atomic
input
state
facc
cont'
match
cont
with
|
WFinish
->
WFinish
,
False
,
""
|
WStop
_
->
cont
,
True
,
""
|
WCont
_
->
let
(
cont'
,
f
,
n
)
=
call_wt_cont
cont
in
let
_
=
if
debug
then
(
print_string
(
"XXX "
^
n
^
"
\n
"
);
flush
stdout
)
in
let
facc'
=
match
f
,
facc
with
True
,
True
->
True
|
True
,
f
->
f
|
f
,
True
->
f
|
_
,_
->
And
(
f
,
facc
)
in
let
ctx_msg
=
Prog
.
ctrl_state_to_string_long
state
.
d
.
ctrl_state
in
Utils
.
time_C
"is_sat"
;
let
sat
=
(
Solver
.
is_satisfiable
input
state
.
d
.
memory
state
.
d
.
verbose
ctx_msg
facc'
""
)
in
Utils
.
time_R
"is_sat"
;
if
sat
then
(
cont'
,
facc'
,
n
)
else
choose_one_formula_atomic
input
state
facc
cont'
and
(
wt_to_cont
:
Var
.
env_in
->
Prog
.
state
->
wt
->
wt_cont
->
wt_cont
)
=
fun
input
state
(
tbl
,
n
)
cont
->
let
_
=
if
debug
then
(
print_string
(
"XXX wt_to_cont "
^
n
^
"
\n
"
);
flush
stdout
)
in
let
children
=
Util
.
StringMap
.
find
n
tbl
in
match
children
with
|
Prog
.
Stop
str
->
WStop
str
|
Leave
(
f
,
nstate
)
->
WCont
(
fun
()
->
(
cont
,
f
,
nstate
))
|
Children
l
->
if
l
=
[]
then
cont
else
let
(
l1
,
l2
)
=
List
.
partition
(
fun
(
dw
,_
)
->
dw
=
Infin
)
l
in
(
match
l1
with
|
[]
->
let
get_weigth
dw
=
match
dw
with
|
V
i
->
if
i
<
0
then
0
else
i
(* a negative weight means null weigth *)
|
Infin
->
assert
false
in
let
w_sum
=
List
.
fold_left
(
fun
acc
(
dw
,_
)
->
acc
+
(
get_weigth
dw
))
0
l2
in
if
w_sum
=
0
then
cont
else
let
j
=
1
+
Random
.
int
w_sum
in
let
rec
get_jth_trans
j
list
acc
=
match
list
with
[]
->
assert
false
|
(
dw
,
nt
)
::
tail
->
let
newj
=
j
-
(
get_weigth
dw
)
in
if
(
newj
<
1
)
then
nt
,
(
rev_append
acc
tail
)
else
get_jth_trans
newj
tail
((
dw
,
nt
)
::
acc
)
in
let
(
nt
,
l2'
)
=
get_jth_trans
j
l2
[]
in
let
tbl'
=
Util
.
StringMap
.
add
n
(
Children
l2'
)
tbl
in
let
tbl''
=
Util
.
StringMap
.
remove
n
tbl
in
(* to optimize mem *)
let
cont'
=
WCont
(
fun
()
->
call_wt_cont
(
wt_to_cont
input
state
(
tbl'
,
n
)
cont
)
)
in
wt_to_cont
input
state
(
tbl''
,
nt
)
cont'
|
[(
_
,
nt
)]
->
let
tbl'
=
Util
.
StringMap
.
add
n
(
Children
l2
)
tbl
in
let
tbl''
=
Util
.
StringMap
.
remove
n
tbl
in
let
cont'
=
WCont
(
fun
()
->
call_wt_cont
(
wt_to_cont
input
state
(
tbl'
,
n
)
cont
)
)
in
wt_to_cont
input
state
(
tbl''
,
nt
)
cont'
|
_
::_
->
failwith
"Only one transition with a infinite weigth is allowed"
)
match
children
with
|
Prog
.
Stop
str
->
WStop
str
|
Leave
(
f
,
nstate
)
->
WCont
(
fun
()
->
(
cont
,
f
,
nstate
))
|
Children
l
->
if
l
=
[]
then
cont
else
let
(
l1
,
l2
)
=
List
.
partition
(
fun
(
dw
,_
)
->
dw
=
Infin
)
l
in
(
match
l1
with
|
[]
->
let
get_weigth
dw
=
match
dw
with
|
V
i
->
if
i
<
0
then
0
else
i
(* a negative weight means null weigth *)
|
Infin
->
assert
false
in
let
w_sum
=
List
.
fold_left
(
fun
acc
(
dw
,_
)
->
acc
+
(
get_weigth
dw
))
0
l2
in
if
w_sum
=
0
then
cont
else
let
j
=
1
+
Random
.
int
w_sum
in
let
rec
get_jth_trans
j
list
acc
=
match
list
with
[]
->
assert
false
|
(
dw
,
nt
)
::
tail
->
let
newj
=
j
-
(
get_weigth
dw
)
in
if
(
newj
<
1
)
then
nt
,
(
rev_append
acc
tail
)
else
get_jth_trans
newj
tail
((
dw
,
nt
)
::
acc
)
in
let
(
nt
,
l2'
)
=
get_jth_trans
j
l2
[]
in
let
tbl'
=
Util
.
StringMap
.
add
n
(
Children
l2'
)
tbl
in
let
tbl''
=
Util
.
StringMap
.
remove
n
tbl
in
(* to optimize mem *)
let
cont'
=
WCont
(
fun
()
->
call_wt_cont
(
wt_to_cont
input
state
(
tbl'
,
n
)
cont
)
)
in
wt_to_cont
input
state
(
tbl''
,
nt
)
cont'
|
[(
_
,
nt
)]
->
let
tbl'
=
Util
.
StringMap
.
add
n
(
Children
l2
)
tbl
in
let
tbl''
=
Util
.
StringMap
.
remove
n
tbl
in
let
cont'
=
WCont
(
fun
()
->
call_wt_cont
(
wt_to_cont
input
state
(
tbl'
,
n
)
cont
)
)
in
wt_to_cont
input
state
(
tbl''
,
nt
)
cont'
|
_
::_
->
failwith
"Only one transition with a infinite weigth is allowed"
)
(****************************************************************************)
(* NO LONGER EXPORTED *)
let
(
_internal_get
:
Var
.
env_in
->
Prog
.
state
->
t
list
)
=
...
...
@@ -214,7 +214,7 @@ Utils.time_R "wt_to_cont";
Utils
.
time_C
"wt_list_to_cont"
;
let
res
=
wt_list_to_cont
input
state
wt_cont_l
True
[]
Finish
in
Utils
.
time_R
"wt_list_to_cont"
;
res
res
)
nll
...
...
@@ -222,17 +222,17 @@ Utils.time_R "wt_list_to_cont";
(* EXPORTED *)
let
rec
(
fgen_of_t
:
t
->
FGen
.
t
)
=
fun
t
->
{
FGen
.
choose_one_formula
=
(
fun
()
->
let
(
t'
,
s
,
f
)
=
choose_one_formula
t
in
(
fgen_of_t
t'
,
s
,
f
)
)
;
FGen
.
get_all_formula
=
(
fun
()
->
get_all_formula
t
)
}
fun
t
->
{
FGen
.
choose_one_formula
=
(
fun
()
->
let
(
t'
,
s
,
f
)
=
choose_one_formula
t
in
(
fgen_of_t
t'
,
s
,
f
)
)
;
FGen
.
get_all_formula
=
(
fun
()
->
get_all_formula
t
)
}
let
get
i
s
=
List
.
map
fgen_of_t
(
_internal_get
i
s
)
lutin/src/lutExe.ml
View file @
9d0c853a
This diff is collapsed.
Click to expand it.
lutin/src/lutExe.mli
View file @
9d0c853a
...
...
@@ -81,8 +81,7 @@ val find_some_sols : t -> Thickness.formula_draw_nb -> Thickness.numeric -> guar
val
find_one_sol
:
t
->
guard
->
(
Var
.
env_out
*
Var
.
env_loc
)
(* the "t" is given in order to filter necessary pres, not really necessary *)
val
make_pre
:
t
->
Var
.
env_in
->
Var
.
env_out
->
Var
.
env_loc
->
Var
.
env
val
make_pre
:
Var
.
env_in
->
Var
.
env_out
->
Var
.
env_loc
->
Var
.
env
(*
May raise Deadlock (or Event.Error ("deadlock",event))
...
...
lutin/src/lutProg.ml
View file @
9d0c853a
...
...
@@ -320,7 +320,7 @@ let init_vars (it: t) = (
(***********************************************************)
let
add_support
mode
it
id
=
(
let
nme
=
CoIdent
.
to_string
id
in
let
info
=
Util
.
hfin
d
(
Expand
.
support_tab
source_code
)
id
in
let
info
=
Util
.
StringMap
.
find
i
d
(
Expand
.
support_tab
source_code
)
in
(* Verbose.put ~flag:dbg " LutProg.add_support \"%s\"\n" nme; *)
let
res
=
lucky_make_var
it
mnode
nme
(
lucky_type_of
info
.
Expand
.
si_type
)
mode
info
.
Expand
.
si_range
in
(* init ? *)
...
...
@@ -344,7 +344,7 @@ let init_vars (it: t) = (
let
add_alias
it
id
=
(
let
nme
=
CoIdent
.
to_string
id
in
Verbose
.
put
~
flag
:
dbg
" LutProg.add_alias
\"
%s
\"\n
"
nme
;
let
info
=
Util
.
hfin
d
(
Expand
.
alias_tab
source_code
)
id
in
let
info
=
Util
.
StringMap
.
find
i
d
(
Expand
.
alias_tab
source_code
)
in
(* les alias sont des Local spciaux en lucky *)
let
res
=
Var
.
set_alias
(
lucky_make_var
it
mnode
nme
(
lucky_type_of
info
.
Expand
.
ai_type
)
Var
.
Local
None
)
...
...
lutin/src/lutinRun.ml
View file @
9d0c853a
(* Time-stamp: <modified the 1
0
/04/2019 (at 1
0:10
) by Erwan Jahier> *)
(* Time-stamp: <modified the 1
2
/04/2019 (at 1
1:32
) by Erwan Jahier> *)
(**********************************************************************************)
type
vars
=
(
string
*
Data
.
t
)
list
...
...
@@ -23,6 +23,10 @@ open RdbgPlugin
type
ctx
=
Event
.
t
type
e
=
Event
.
t
let
compact
str
=
let
str
=
Str
.
global_replace
(
Str
.
regexp
"
\n
"
)
";"
str
in