Skip to content

Commit

Permalink
Improve bind readability
Browse files Browse the repository at this point in the history
Removing f from bind_status arguments may have a slight performance hit but it should be ok
  • Loading branch information
krtab authored and zapashcanon committed Aug 11, 2024
1 parent f9ce838 commit c006b9a
Showing 1 changed file with 12 additions and 15 deletions.
27 changes: 12 additions & 15 deletions src/symbolic/symbolic_choice.ml
Original file line number Diff line number Diff line change
Expand Up @@ -38,23 +38,20 @@ module CoreImpl = struct

let return_status status = Sched (Fun.const status)

let rec bind (mx : ('a, 'wls) t) (f : 'a -> ('b, 'wls) t) : _ t =
let rec bind_status (x : _ status) (outter_wls : 'wls) f : _ status =
match x with
| Now x -> run (f x) outter_wls
| Yield (prio, lx) ->
Yield (prio, Sched (fun wls -> bind_status (run lx wls) wls f))
| Choice (mx1, mx2) ->
let mx1' = bind_status mx1 outter_wls f in
let mx2' = bind_status mx2 outter_wls f in
Choice (mx1', mx2')
| Stop -> Stop
in
let rec bind (mx : ('a, 'wls) t) (f : 'a -> ('b, 'wls) t) : ('b, 'wls) t =
Sched
(fun wls ->
match run mx wls with
| Yield (prio, mx) -> Yield (prio, bind mx f)
| x -> bind_status x wls f )
let rec unfold_status (x : ('a, 'wls) status) : ('b, 'wls) status =
match x with
| Now x -> run (f x) wls
| Yield (prio, lx) -> Yield (prio, bind lx f)
| Choice (mx1, mx2) ->
let mx1' = unfold_status mx1 in
let mx2' = unfold_status mx2 in
Choice (mx1', mx2')
| Stop -> Stop
in
unfold_status (run mx wls) )

let ( let* ) = bind

Expand Down

0 comments on commit c006b9a

Please sign in to comment.