Revision a7062da6
Added by LĂ©lio Brun over 3 years ago
src/tools/stateflow/common/datatype.ml | ||
---|---|---|
1 |
open Utils |
|
1 | 2 |
open Basetypes |
2 | 3 |
(* open ActiveEnv *) |
3 | 4 |
|
... | ... | |
119 | 120 |
t.condition_act Action.pp_act t.transition_act pp_dest t.dest |
120 | 121 |
|
121 | 122 |
let pp_transitions fmt l = |
122 |
Format.fprintf fmt "@[<hov 0>[@[<hov 0>%a@]@ ]@]" |
|
123 |
(Utils.fprintf_list ~sep:";@ " pp_trans)
|
|
124 |
l
|
|
123 |
Format.(fprintf fmt "@[<hov 0>[@[<hov 0>%a@]@ ]@]"
|
|
124 |
(pp_print_list ~pp_sep:pp_print_semicolon pp_trans)
|
|
125 |
l)
|
|
125 | 126 |
|
126 | 127 |
let pp_comp fmt c = |
127 | 128 |
match c with |
128 | 129 |
| Or (_T, _S) -> |
129 |
Format.fprintf fmt "Or(%a, {%a})" pp_transitions _T |
|
130 |
(Utils.fprintf_list ~sep:"; " pp_state_name)
|
|
131 |
_S
|
|
130 |
Format.(fprintf fmt "Or(%a, {%a})" pp_transitions _T
|
|
131 |
(pp_print_list ~pp_sep:pp_print_semicolon pp_state_name)
|
|
132 |
_S)
|
|
132 | 133 |
| And _S -> |
133 |
Format.fprintf fmt "And({%a})" |
|
134 |
(Utils.fprintf_list ~sep:"; " pp_state_name)
|
|
135 |
_S
|
|
134 |
Format.(fprintf fmt "And({%a})"
|
|
135 |
(pp_print_list ~pp_sep:pp_print_semicolon pp_state_name)
|
|
136 |
_S)
|
|
136 | 137 |
|
137 | 138 |
let pp_state_actions fmt sa = |
138 | 139 |
Format.fprintf fmt "@[<hov 0>(%a,@ %a,@ %a)@]" Action.pp_act sa.entry_act |
... | ... | |
144 | 145 |
pp_transitions s.inner_trans pp_comp s.internal_composition |
145 | 146 |
|
146 | 147 |
let pp_src pp_sffunction fmt src = |
147 |
Format.fprintf fmt "@[<v>%a@ @]" |
|
148 |
(Utils.fprintf_list ~sep:"@ @ " (fun fmt src ->
|
|
149 |
match src with |
|
150 |
| State (p, def) -> |
|
151 |
Format.fprintf fmt "%a: %a" pp_path p pp_state def |
|
152 |
| Junction (s, tl) -> |
|
153 |
Format.fprintf fmt "%a: %a" pp_state_name s pp_transitions tl |
|
154 |
| SFFunction p -> |
|
155 |
pp_sffunction fmt p)) |
|
156 |
src
|
|
148 |
Format.(fprintf fmt "@[<v>%a@ @]"
|
|
149 |
(pp_print_list ~pp_sep:pp_print_cutcut (fun fmt src ->
|
|
150 |
match src with
|
|
151 |
| State (p, def) ->
|
|
152 |
Format.fprintf fmt "%a: %a" pp_path p pp_state def
|
|
153 |
| Junction (s, tl) ->
|
|
154 |
Format.fprintf fmt "%a: %a" pp_state_name s pp_transitions tl
|
|
155 |
| SFFunction p ->
|
|
156 |
pp_sffunction fmt p))
|
|
157 |
src)
|
|
157 | 158 |
|
158 | 159 |
let rec pp_sffunction fmt (Program (name, component_list, _)) = |
159 | 160 |
Format.fprintf fmt "SFFunction name: %s@ %a@ " name (pp_src pp_sffunction) |
160 | 161 |
component_list |
161 | 162 |
|
162 | 163 |
let pp_vars fmt src = |
163 |
Format.fprintf fmt "@[<v>%a@ @]" |
|
164 |
(Utils.fprintf_list ~sep:"@ " Printers.pp_var) |
|
165 |
src |
|
164 |
Format.(fprintf fmt "@[<v>%a@ @]" (pp_print_list Printers.pp_var) src) |
|
166 | 165 |
|
167 | 166 |
let pp_prog fmt (Program (name, component_list, vars)) = |
168 | 167 |
Format.fprintf fmt "Main node name: %s@ %a@ %a@" name (pp_src pp_sffunction) |
Also available in: Unified diff
another step towards refactoring