Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
L
lutin
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Issues
1
Issues
1
List
Boards
Labels
Service Desk
Milestones
Merge Requests
0
Merge Requests
0
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Operations
Operations
Incidents
Environments
Packages & Registries
Packages & Registries
Container Registry
Analytics
Analytics
CI / CD
Repository
Value Stream
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
verimag
synchrone
lutin
Commits
8671d38c
Commit
8671d38c
authored
Mar 17, 2020
by
erwan
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Upgrade: the rdbg package renamed Event into RdbgEvent
parent
7addffd8
Pipeline
#39230
passed with stages
in 4 minutes and 43 seconds
Changes
7
Pipelines
3
Hide whitespace changes
Inline
Side-by-side
Showing
7 changed files
with
166 additions
and
162 deletions
+166
-162
bin/lurette-nocaml/dune
bin/lurette-nocaml/dune
+5
-1
bin/lurette-nocaml/lurette.ml
bin/lurette-nocaml/lurette.ml
+2
-2
lib/lutin/lutExe.ml
lib/lutin/lutExe.ml
+149
-149
lib/lutin/lutExe.mli
lib/lutin/lutExe.mli
+3
-3
lib/lutin/lutinRun.ml
lib/lutin/lutinRun.ml
+3
-3
lib/lutin/reactive.ml
lib/lutin/reactive.ml
+2
-2
lib/lutin/reactive.mli
lib/lutin/reactive.mli
+2
-2
No files found.
bin/lurette-nocaml/dune
View file @
8671d38c
(executable
(name lurette)
(modes (byte exe) (native exe))
(libraries lustre-v6 lutin)
; (libraries camlidl lustre-v6 lutin sasa)
...
...
@@ -12,5 +13,8 @@
(install
(section bin)
(package lutin)
(files (lurette.exe as lurette))
(files
(lurette.exe as lurette)
(lurette.bc as lurette4dbg)
)
)
bin/lurette-nocaml/lurette.ml
View file @
8671d38c
(* Time-stamp: <modified the
06/02/2020 (at 17:25
) by Erwan Jahier> *)
(* Time-stamp: <modified the
16/03/2020 (at 11:43
) by Erwan Jahier> *)
(* Mimick the behavior of 'rdbg -lurette', but without the dependency
on ocaml *)
...
...
@@ -141,7 +141,7 @@ let _ =
RdbgRun
.
clean_terminate
()
;
flush
stderr
;
exit
2
|
Event
.
End
(
i
)
->
|
Rdbg
Event
.
End
(
i
)
->
RdbgRun
.
clean_terminate
()
;
exit
i
|
pb
->
...
...
lib/lutin/lutExe.ml
View file @
8671d38c
...
...
@@ -89,7 +89,7 @@ let (_tbl_to_string: t -> string) =
*)
let
(
to_event_var
:
'
a
Var
.
t
->
Event
.
var
)
=
let
(
to_event_var
:
'
a
Var
.
t
->
Rdbg
Event
.
var
)
=
fun
v
->
Var
.
name
v
,
Type
.
to_data_t
(
Var
.
typ
v
)
...
...
@@ -262,7 +262,7 @@ let make opt infile mnode = (
let
exped
=
Expand
.
make
tlenv
mainprg
mnode
in
Verbose
.
put
~
flag
:
dbg
"LutExe.make: Expand.make %s OK
\n
"
mnode
;
(* actual result .... *)
(* Verbose.put ~flag:dbg "Event.set_seed %i\n"(MainArg.seed opt); *)
(* Verbose.put ~flag:dbg "
Rdbg
Event.set_seed %i\n"(MainArg.seed opt); *)
MainArg
.
set_seed
opt
(
Some
(
MainArg
.
seed
opt
));
if
MainArg
.
run
opt
then
of_expanded_code
opt
exped
...
...
@@ -506,33 +506,33 @@ let min_max_src (bl1,el1,bc1,ec1,bchar1,echar1) (bl2,el2,bc2,ec2,bchar2,echar2)
exception
No_src_info
let
rec
(
to_src_info
:
CoIdent
.
src_stack
->
Event
.
src_info_atom
)
=
let
rec
(
to_src_info
:
CoIdent
.
src_stack
->
Rdbg
Event
.
src_info_atom
)
=
fun
l
->
match
l
with
|
[]
->
raise
No_src_info
|
(
lxm
,
_
,
None
)
::
tl
->
{
Event
.
file
=
lxm
.
Lexeme
.
file
;
Event
.
line
=
lxm
.
Lexeme
.
line
,
lxm
.
Lexeme
.
line
;
Event
.
char
=
lxm
.
Lexeme
.
cstart
,
lxm
.
Lexeme
.
cend
;
Event
.
stack
=
if
tl
=
[]
then
None
else
Some
(
to_src_info
tl
);
Event
.
str
=
lxm
.
Lexeme
.
str
;
Rdbg
Event
.
file
=
lxm
.
Lexeme
.
file
;
Rdbg
Event
.
line
=
lxm
.
Lexeme
.
line
,
lxm
.
Lexeme
.
line
;
Rdbg
Event
.
char
=
lxm
.
Lexeme
.
cstart
,
lxm
.
Lexeme
.
cend
;
Rdbg
Event
.
stack
=
if
tl
=
[]
then
None
else
Some
(
to_src_info
tl
);
Rdbg
Event
.
str
=
lxm
.
Lexeme
.
str
;
}
|
(
lxm
,_,
Some
ve
)
::
tl
->
let
line_b
,
line_e
,
col_b
,
col_e
,
char_b
,
char_e
=
cstr_src_info_of_val_exp
ve
in
let
file
=
lxm
.
Lexeme
.
file
in
let
filecontent
=
Mypervasives
.
readfile
file
in
{
Event
.
str
=
Rdbg
Event
.
str
=
(
try
String
.
sub
filecontent
char_b
(
char_e
-
char_b
+
1
)
with
_
->
try
String
.
sub
filecontent
char_b
(
String
.
length
filecontent
-
char_b
)
with
_
->
Printf
.
sprintf
"%s: fail to get chars %i-%i"
file
char_b
char_e
);
Event
.
file
=
file
;
Event
.
line
=
line_b
,
line_e
;
Event
.
char
=
col_b
,
col_e
;
Event
.
stack
=
if
tl
=
[]
then
None
else
Some
(
to_src_info
tl
);
Rdbg
Event
.
file
=
file
;
Rdbg
Event
.
line
=
line_b
,
line_e
;
Rdbg
Event
.
char
=
col_b
,
col_e
;
Rdbg
Event
.
stack
=
if
tl
=
[]
then
None
else
Some
(
to_src_info
tl
);
}
...
...
@@ -705,8 +705,8 @@ let string_of_cont_mnemo = function
|
Crun
(
s
)
->
Printf
.
sprintf
"!%s"
s
type
e
=
Event
.
t
type
ctx
=
Event
.
t
type
e
=
Rdbg
Event
.
t
type
ctx
=
Rdbg
Event
.
t
type
continuation
=
{
doit
:
behavior
->
behavior
;
...
...
@@ -780,7 +780,7 @@ let put_in_para te1 te2 = (
let
(
event_incr
:
ctx
->
MainArg
.
t
->
ctx
)
=
fun
ctx
opt
->
MainArg
.
event_incr
opt
;
Event
.
incr_event_nb
ctx
Rdbg
Event
.
incr_event_nb
ctx
let
rec
genpath
(
t
:
t
)
(
data
:
store
)
(* data env = inputs + pres *)
...
...
@@ -1540,31 +1540,31 @@ let rec (genpath_ldbg : t -> store -> t CoTraceExp.t -> ctx ->
let
try_cont
ctx
t
()
=
let
t
,
new_acc
,
is_sat
=
check_satisfiablity
t
new_acc
in
if
(
is_sat
)
then
let
enb
=
ctx
.
Event
.
nb
in
let
enb
=
ctx
.
Rdbg
Event
.
nb
in
let
ctx
=
event_incr
ctx
t
.
arg_opt
in
{
ctx
with
Event
.
kind
=
Event
.
MicroStep
"sat "
;
Event
.
nb
=
enb
;
Event
.
lang
=
"lutin"
;
Event
.
next
=
(
fun
()
->
RdbgEvent
.
kind
=
Rdbg
Event
.
MicroStep
"sat "
;
Rdbg
Event
.
nb
=
enb
;
Rdbg
Event
.
lang
=
"lutin"
;
Rdbg
Event
.
next
=
(
fun
()
->
(
br_cont
.
doit_ldbg
ctx
t
(
Goto
(
new_acc
,
TE_eps
))
cont
fail_cont
excn_cont
));
Event
.
sinfo
=
Some
(
fun
()
->
{
Event
.
expr
=
cstr
;
Event
.
more
=
None
;
Event
.
atoms
=
si_atoms
;
Event
.
in_subst
=
[]
;
Event
.
out_subst
=
[]
;
Rdbg
Event
.
sinfo
=
Some
(
fun
()
->
{
Rdbg
Event
.
expr
=
cstr
;
Rdbg
Event
.
more
=
None
;
Rdbg
Event
.
atoms
=
si_atoms
;
Rdbg
Event
.
in_subst
=
[]
;
Rdbg
Event
.
out_subst
=
[]
;
});
Event
.
depth
=
ctx
.
Event
.
depth
;
Event
.
step
=
ctx
.
Event
.
step
;
Event
.
name
=
ctx
.
Event
.
name
;
Event
.
inputs
=
ctx
.
Event
.
inputs
;
Event
.
outputs
=
ctx
.
Event
.
outputs
;
Event
.
locals
=
[]
;
(* fixme *)
Event
.
data
=
ctx
.
Event
.
data
;
Event
.
terminate
=
ctx
.
Event
.
terminate
;
Event
.
reset
=
ctx
.
Event
.
reset
;
RdbgEvent
.
depth
=
ctx
.
Rdbg
Event
.
depth
;
RdbgEvent
.
step
=
ctx
.
Rdbg
Event
.
step
;
RdbgEvent
.
name
=
ctx
.
Rdbg
Event
.
name
;
RdbgEvent
.
inputs
=
ctx
.
Rdbg
Event
.
inputs
;
RdbgEvent
.
outputs
=
ctx
.
Rdbg
Event
.
outputs
;
Rdbg
Event
.
locals
=
[]
;
(* fixme *)
RdbgEvent
.
data
=
ctx
.
Rdbg
Event
.
data
;
RdbgEvent
.
terminate
=
ctx
.
Rdbg
Event
.
terminate
;
RdbgEvent
.
reset
=
ctx
.
Rdbg
Event
.
reset
;
}
else
(* the constraint is unsat *)
let
lazy_ci
=
fun
()
->
...
...
@@ -1579,41 +1579,41 @@ let rec (genpath_ldbg : t -> store -> t CoTraceExp.t -> ctx ->
let
expr_cc
=
Exp
.
to_expr
cc
.
g_form
in
ExprUtil
.
get_info
t
.
snt
bdd
bdd_acc
(
expr_cc
,
bdd_cc
)
in
let
enb
=
ctx
.
Event
.
nb
in
let
enb
=
ctx
.
Rdbg
Event
.
nb
in
let
ctx
=
event_incr
ctx
t
.
arg_opt
in
let
usat_event
=
{
ctx
with
Event
.
nb
=
enb
;
Event
.
kind
=
Event
.
MicroStep
"usat"
;
Event
.
lang
=
"lutin"
;
Event
.
next
=
(* backtrack *)
(
fun
()
->
fail_cont
ctx
t
);
Event
.
sinfo
=
Some
(
fun
()
->
{
Event
.
expr
=
cstr
;
Event
.
more
=
Some
lazy_ci
;
Event
.
atoms
=
si_atoms
;
Event
.
in_subst
=
[]
;
Event
.
out_subst
=
[]
;
Rdbg
Event
.
nb
=
enb
;
RdbgEvent
.
kind
=
Rdbg
Event
.
MicroStep
"usat"
;
Rdbg
Event
.
lang
=
"lutin"
;
Rdbg
Event
.
next
=
(* backtrack *)
(
fun
()
->
fail_cont
ctx
t
);
Rdbg
Event
.
sinfo
=
Some
(
fun
()
->
{
Rdbg
Event
.
expr
=
cstr
;
Rdbg
Event
.
more
=
Some
lazy_ci
;
Rdbg
Event
.
atoms
=
si_atoms
;
Rdbg
Event
.
in_subst
=
[]
;
Rdbg
Event
.
out_subst
=
[]
;
});
Event
.
locals
=
[]
;
(* fixme *)
Rdbg
Event
.
locals
=
[]
;
(* fixme *)
}
in
usat_event
in
let
enb
=
ctx
.
Event
.
nb
in
let
enb
=
ctx
.
Rdbg
Event
.
nb
in
let
ctx
=
event_incr
ctx
t
.
arg_opt
in
{
ctx
with
Event
.
nb
=
enb
;
Event
.
kind
=
Event
.
MicroStep
"try "
;
Event
.
lang
=
"lutin"
;
Event
.
sinfo
=
Some
(
fun
()
->
{
Event
.
expr
=
cstr
;
Event
.
more
=
None
;
Event
.
atoms
=
si_atoms
;
Event
.
in_subst
=
[]
;
Event
.
out_subst
=
[]
;
Rdbg
Event
.
nb
=
enb
;
RdbgEvent
.
kind
=
Rdbg
Event
.
MicroStep
"try "
;
Rdbg
Event
.
lang
=
"lutin"
;
Rdbg
Event
.
sinfo
=
Some
(
fun
()
->
{
Rdbg
Event
.
expr
=
cstr
;
Rdbg
Event
.
more
=
None
;
Rdbg
Event
.
atoms
=
si_atoms
;
Rdbg
Event
.
in_subst
=
[]
;
Rdbg
Event
.
out_subst
=
[]
;
});
Event
.
locals
=
[]
;
(* fixme *)
Event
.
next
=
try_cont
ctx
t
;
Rdbg
Event
.
locals
=
[]
;
(* fixme *)
Rdbg
Event
.
next
=
try_cont
ctx
t
;
}
)
(* Sequence *)
...
...
@@ -2110,25 +2110,25 @@ let rec (genpath_ldbg : t -> store -> t CoTraceExp.t -> ctx ->
cont2
in
(* exiting a run *)
let
enb
,_
d
=
ctx
.
Event
.
nb
,
ctx
.
Event
.
depth
in
let
enb
,_
d
=
ctx
.
RdbgEvent
.
nb
,
ctx
.
Rdbg
Event
.
depth
in
let
ctx
=
event_incr
ctx
t
.
arg_opt
in
let
event
=
{
ctx
with
Event
.
step
=
ctx
.
Event
.
step
;
Event
.
nb
=
enb
;
Event
.
depth
=
ctx
.
Event
.
depth
;
Event
.
kind
=
Event
.
MicroStep
"quit"
;
Event
.
lang
=
"lutin"
;
Event
.
name
=
rid
;
Event
.
inputs
=
ctx
.
Event
.
inputs
;
Event
.
outputs
=
ctx
.
Event
.
outputs
;
Event
.
locals
=
[]
;
(* fixme *)
Event
.
data
=
ctx
.
Event
.
data
;
Event
.
sinfo
=
ctx
.
Event
.
sinfo
;
Event
.
next
=
RdbgEvent
.
step
=
ctx
.
Rdbg
Event
.
step
;
Rdbg
Event
.
nb
=
enb
;
RdbgEvent
.
depth
=
ctx
.
Rdbg
Event
.
depth
;
RdbgEvent
.
kind
=
Rdbg
Event
.
MicroStep
"quit"
;
Rdbg
Event
.
lang
=
"lutin"
;
Rdbg
Event
.
name
=
rid
;
RdbgEvent
.
inputs
=
ctx
.
Rdbg
Event
.
inputs
;
RdbgEvent
.
outputs
=
ctx
.
Rdbg
Event
.
outputs
;
Rdbg
Event
.
locals
=
[]
;
(* fixme *)
RdbgEvent
.
data
=
ctx
.
Rdbg
Event
.
data
;
RdbgEvent
.
sinfo
=
ctx
.
Rdbg
Event
.
sinfo
;
Rdbg
Event
.
next
=
(
fun
()
->
step_ldbg
ctx
t
react
ins
cont3
fail_cont
excn_cont
);
Event
.
terminate
=
ctx
.
Event
.
terminate
;
Event
.
reset
=
ctx
.
Event
.
reset
;
RdbgEvent
.
terminate
=
ctx
.
Rdbg
Event
.
terminate
;
RdbgEvent
.
reset
=
ctx
.
Rdbg
Event
.
reset
;
}
in
event
...
...
@@ -2330,14 +2330,14 @@ and (to_reactive_prg_ldbg :
let
predata
=
List
.
map
(
fun
(
n
,
v
)
->
"pre_"
^
n
,
Value
.
to_data_val
v
)
predata
in
let
ctx_save
=
ctx
in
let
ctx
=
{
ctx
with
Event
.
name
=
rid
;
Event
.
data
=
edata
@
predata
;
Event
.
inputs
=
List
.
map
to_event_var
(
in_var_list
run_t
);
Event
.
outputs
=
List
.
map
to_event_var
(
out_var_list
run_t
);
Rdbg
Event
.
name
=
rid
;
Rdbg
Event
.
data
=
edata
@
predata
;
Rdbg
Event
.
inputs
=
List
.
map
to_event_var
(
in_var_list
run_t
);
Rdbg
Event
.
outputs
=
List
.
map
to_event_var
(
out_var_list
run_t
);
}
in
let
ctx
=
Event
.
incr_event_depth
ctx
in
let
d
=
ctx
.
Event
.
depth
in
let
ctx
=
Rdbg
Event
.
incr_event_depth
ctx
in
let
d
=
ctx
.
Rdbg
Event
.
depth
in
let
(
cont2
:
ctx
->
t
->
behavior
->
e
)
=
fun
ctx2
t
b
->
match
b
with
|
Raise
x
->
excn_cont
ctx2
caller_t
x
...
...
@@ -2374,30 +2374,30 @@ and (to_reactive_prg_ldbg :
let
cstr
=
Exp
.
to_expr
zeguard
.
g_form
in
let
ctx2
=
{
ctx_save
with
(* once we exit, we return back to the previous ctx *)
Event
.
nb
=
ctx2
.
Event
.
nb
;
Event
.
data
=
edata
;
(* used? *)
Event
.
depth
=
ctx
.
Event
.
depth
-
1
RdbgEvent
.
nb
=
ctx2
.
Rdbg
Event
.
nb
;
Rdbg
Event
.
data
=
edata
;
(* used? *)
RdbgEvent
.
depth
=
ctx
.
Rdbg
Event
.
depth
-
1
}
in
let
ctx2
=
event_incr
ctx2
t
.
arg_opt
in
let
event
=
{
ctx
with
Event
.
nb
=
ctx2
.
Event
.
nb
-
1
;
Event
.
kind
=
Event
.
Exit
;
Event
.
lang
=
"lutin"
;
(*
Event.port =
Event.Exit (guard_to_string zeguard, cstr,lazy_si); *)
Event
.
name
=
rid
;
Event
.
locals
=
[]
;
(* fixme *)
Event
.
data
=
edata
;
Event
.
sinfo
=
Some
(
fun
()
->
{
Event
.
expr
=
cstr
;
(*Event.str = guard_to_string zeguard; *)
Event
.
more
=
None
;
Event
.
atoms
=
si_atoms
;
Event
.
in_subst
=
[]
;
Event
.
out_subst
=
[]
;
RdbgEvent
.
nb
=
ctx2
.
Rdbg
Event
.
nb
-
1
;
RdbgEvent
.
kind
=
Rdbg
Event
.
Exit
;
Rdbg
Event
.
lang
=
"lutin"
;
(*
RdbgEvent.port = Rdbg
Event.Exit (guard_to_string zeguard, cstr,lazy_si); *)
Rdbg
Event
.
name
=
rid
;
Rdbg
Event
.
locals
=
[]
;
(* fixme *)
Rdbg
Event
.
data
=
edata
;
Rdbg
Event
.
sinfo
=
Some
(
fun
()
->
{
Rdbg
Event
.
expr
=
cstr
;
(*
Rdbg
Event.str = guard_to_string zeguard; *)
Rdbg
Event
.
more
=
None
;
Rdbg
Event
.
atoms
=
si_atoms
;
Rdbg
Event
.
in_subst
=
[]
;
Rdbg
Event
.
out_subst
=
[]
;
});
Event
.
next
=
Rdbg
Event
.
next
=
(
fun
()
->
cont
ctx2
caller_t
(
DoStep_ldbg
(
to_reactive_prg_ldbg
rid
run_t
state'
))
...
...
@@ -2406,20 +2406,20 @@ and (to_reactive_prg_ldbg :
in
event
in
(* end of cont2 *)
let
enb
=
ctx
.
Event
.
nb
in
let
enb
=
ctx
.
Rdbg
Event
.
nb
in
let
ctx
=
event_incr
ctx
run_t
.
arg_opt
in
let
ctx
=
Event
.
incr_event_depth
ctx
in
(* inner events are one step deapper *)
let
ctx
=
Rdbg
Event
.
incr_event_depth
ctx
in
(* inner events are one step deapper *)
{
ctx
with
Event
.
nb
=
enb
;
Event
.
depth
=
d
;
Event
.
kind
=
Event
.
Call
;
Event
.
lang
=
"lutin"
;
Event
.
name
=
rid
;
Event
.
locals
=
[]
;
(* fixme *)
Event
.
data
=
edata
@
predata
;
Event
.
next
=
(
fun
()
->
genpath_ldbg
run_t
data
cstate
ctx
cont2
Rdbg
Event
.
nb
=
enb
;
Rdbg
Event
.
depth
=
d
;
RdbgEvent
.
kind
=
Rdbg
Event
.
Call
;
Rdbg
Event
.
lang
=
"lutin"
;
Rdbg
Event
.
name
=
rid
;
Rdbg
Event
.
locals
=
[]
;
(* fixme *)
Rdbg
Event
.
data
=
edata
@
predata
;
Rdbg
Event
.
next
=
(
fun
()
->
genpath_ldbg
run_t
data
cstate
ctx
cont2
fail_cont
excn_cont
);
Event
.
sinfo
=
None
;
Rdbg
Event
.
sinfo
=
None
;
}
...
...
@@ -2519,11 +2519,11 @@ let (step_rdbg: ctx -> string -> t -> control_state -> data_state ->
in
let
ctx_save
=
ctx
in
let
ctx
=
{
ctx
with
Event
.
name
=
node
;
Event
.
depth
=
ctx
.
Event
.
depth
+
1
;
Event
.
data
=
datal
;
Event
.
inputs
=
List
.
map
to_event_var
(
in_var_list
t
);
Event
.
outputs
=
List
.
map
to_event_var
(
out_var_list
t
);
Rdbg
Event
.
name
=
node
;
RdbgEvent
.
depth
=
ctx
.
Rdbg
Event
.
depth
+
1
;
Rdbg
Event
.
data
=
datal
;
Rdbg
Event
.
inputs
=
List
.
map
to_event_var
(
in_var_list
t
);
Rdbg
Event
.
outputs
=
List
.
map
to_event_var
(
out_var_list
t
);
}
in
let
cont2
=
fun
ctx2
t
bg
->
...
...
@@ -2563,55 +2563,55 @@ let (step_rdbg: ctx -> string -> t -> control_state -> data_state ->
let
ctx2
=
event_incr
ctx2
t
.
arg_opt
in
let
ctx2
=
{
ctx_save
with
(* once we exit, we return back to the previous ctx *)
Event
.
nb
=
ctx2
.
Event
.
nb
;
Event
.
data
=
edata
;
(* used? *)
Event
.
depth
=
ctx
.
Event
.
depth
-
1
RdbgEvent
.
nb
=
ctx2
.
Rdbg
Event
.
nb
;
Rdbg
Event
.
data
=
edata
;
(* used? *)
RdbgEvent
.
depth
=
ctx
.
Rdbg
Event
.
depth
-
1
}
in
let
si_atoms
=
List
.
map
to_src_info
zeguard
.
g_src
in
let
cstr
=
Exp
.
to_expr
zeguard
.
g_form
in
{
ctx
with
Event
.
step
=
ctx
.
Event
.
step
;
Event
.
nb
=
ctx2
.
Event
.
nb
-
1
;
Event
.
depth
=
ctx
.
Event
.
depth
;
Event
.
kind
=
Event
.
Exit
;
Event
.
lang
=
"lutin"
;
Event
.
name
=
node
;
Event
.
inputs
=
ctx
.
Event
.
inputs
;
Event
.
outputs
=
ctx
.
Event
.
outputs
;
Event
.
locals
=
[]
;
(* fixme *)
Event
.
data
=
edata
;
RdbgEvent
.
step
=
ctx
.
Rdbg
Event
.
step
;
RdbgEvent
.
nb
=
ctx2
.
Rdbg
Event
.
nb
-
1
;
RdbgEvent
.
depth
=
ctx
.
Rdbg
Event
.
depth
;
RdbgEvent
.
kind
=
Rdbg
Event
.
Exit
;
Rdbg
Event
.
lang
=
"lutin"
;
Rdbg
Event
.
name
=
node
;
RdbgEvent
.
inputs
=
ctx
.
Rdbg
Event
.
inputs
;
RdbgEvent
.
outputs
=
ctx
.
Rdbg
Event
.
outputs
;
Rdbg
Event
.
locals
=
[]
;
(* fixme *)
Rdbg
Event
.
data
=
edata
;
Event
.
sinfo
=
Some
(
fun
()
->
{
Event
.
expr
=
cstr
;
(* Event.str = guard_to_string zeguard; *)
Event
.
more
=
None
;
Event
.
atoms
=
si_atoms
;
Event
.
in_subst
=
[]
;
Event
.
out_subst
=
[]
;
Rdbg
Event
.
sinfo
=
Some
(
fun
()
->
{
Rdbg
Event
.
expr
=
cstr
;
(*
Rdbg
Event.str = guard_to_string zeguard; *)
Rdbg
Event
.
more
=
None
;
Rdbg
Event
.
atoms
=
si_atoms
;
Rdbg
Event
.
in_subst
=
[]
;
Rdbg
Event
.
out_subst
=
[]
;
});
(* Event.Exit (guard_to_string zeguard, cstr, lazy_si) *)
Event
.
next
=
(
fun
()
->
cont
ctx2
t
ctrl
data
);
Event
.
terminate
=
ctx2
.
Event
.
terminate
;
Event
.
reset
=
ctx2
.
Event
.
reset
;
(*
Rdbg
Event.Exit (guard_to_string zeguard, cstr, lazy_si) *)
Rdbg
Event
.
next
=
(
fun
()
->
cont
ctx2
t
ctrl
data
);
RdbgEvent
.
terminate
=
ctx2
.
Rdbg
Event
.
terminate
;
RdbgEvent
.
reset
=
ctx2
.
Rdbg
Event
.
reset
;
}
)
)
in
let
enb
=
ctx
.
Event
.
nb
in
let
enb
=
ctx
.
Rdbg
Event
.
nb
in
let
ctx
=
event_incr
ctx
t
.
arg_opt
in
let
d
=
ctx
.
Event
.
depth
in
let
ctx
=
{
ctx
with
depth
=
ctx
.
Event
.
depth
+
1
}
in
let
d
=
ctx
.
Rdbg
Event
.
depth
in
let
ctx
=
{
ctx
with
depth
=
ctx
.
Rdbg
Event
.
depth
+
1
}
in
{
ctx
with
Event
.
nb
=
enb
;
Event
.
depth
=
d
;
Event
.
kind
=
Event
.
Call
;
Event
.
lang
=
"lutin"
;
Event
.
name
=
node
;
Event
.
next
=
(
fun
()
->
Rdbg
Event
.
nb
=
enb
;
Rdbg
Event
.
depth
=
d
;
RdbgEvent
.
kind
=
Rdbg
Event
.
Call
;
Rdbg
Event
.
lang
=
"lutin"
;
Rdbg
Event
.
name
=
node
;
Rdbg
Event
.
next
=
(
fun
()
->
get_behavior_gen_ldbg
t
data
.
ins
data
.
mems
ctrl
ctx
cont2
);
Event
.
sinfo
=
None
;
(* XXX fixme ? *)
Rdbg
Event
.
sinfo
=
None
;
(* XXX fixme ? *)
}
...
...
lib/lutin/lutExe.mli
View file @
8671d38c
...
...
@@ -87,10 +87,10 @@ val find_one_sol : t -> guard -> t * guard * (Var.env_out * Var.env_loc)
val
make_pre
:
Var
.
env_in
->
Var
.
env_out
->
Var
.
env_loc
->
Var
.
env
(*
May raise Deadlock (or Event.Error ("deadlock",event))
May raise Deadlock (or
Rdbg
Event.Error ("deadlock",event))
*)
type
ctx
=
Event
.
t
type
e
=
Event
.
t
type
ctx
=
Rdbg
Event
.
t
type
e
=
Rdbg
Event
.
t
val
step
:
t
->
control_state
->
data_state
->
t
*
control_state
*
data_state
val
step_rdbg
:
ctx
->
string
->
t
->
control_state
->
data_state
->
(
ctx
->
t
->
control_state
->
data_state
->
e
)
->
e
...
...
lib/lutin/lutinRun.ml
View file @
8671d38c
(* Time-stamp: <modified the
30/08/2019 (at 14:37
) by Erwan Jahier> *)
(* Time-stamp: <modified the
16/03/2020 (at 11:38
) by Erwan Jahier> *)
(**********************************************************************************)
let
(
var_to_var_pair
:
Exp
.
var
->
string
*
Data
.
t
)
=
...
...
@@ -19,7 +19,7 @@ let (to_vals : Data.subst list -> Value.OfIdent.t) =
Value
.
OfIdent
.
empty
open
RdbgPlugin
type
ctx
=
Event
.
t
type
ctx
=
Rdbg
Event
.
t
let
compact
str
=
let
str
=
Str
.
global_replace
(
Str
.
regexp
"
\n
"
)
";"
str
in
...
...
@@ -62,7 +62,7 @@ let make argv =
in
let
(
lut_step_dbg
:
Data
.
subst
list
->
ctx
->
(
Data
.
subst
list
->
ctx
->
Event
.
t
)
->
Event
.
t
)
=
(
Data
.
subst
list
->
ctx
->
RdbgEvent
.
t
)
->
Rdbg
Event
.
t
)
=
fun
sl
ctx
cont
->
let
cont_lut_step
ctx
=
fun
new_tables
new_cs
new_ds
->
...
...
lib/lutin/reactive.ml
View file @
8671d38c
...
...
@@ -5,8 +5,8 @@ type prg = DoStep of (Value.t list -> Value.t list * prg)
let
step
p
=
match
p
with
DoStep
p
->
p
type
ctx
=
Event
.
t
type
e
=
Event
.
t
type
ctx
=
Rdbg
Event
.
t
type
e
=
Rdbg
Event
.
t
type
'
t
prg_ldbg
=
DoStep_ldbg
of
(
ctx
->
'
t
->
Value
.
t
list
->
...
...
lib/lutin/reactive.mli
View file @
8671d38c
...
...
@@ -4,8 +4,8 @@
type
prg
=
DoStep
of
(
Value
.
t
list
->
Value
.
t
list
*
prg
)
val
step
:
prg
->
Value
.
t
list
->
(
Value
.
t
list
*
prg
)
type
ctx
=
Event
.
t
type
e
=
Event
.
t
type
ctx
=
Rdbg
Event
.
t
type
e
=
Rdbg
Event
.
t
type
'
t
prg_ldbg
=
...
...
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