atomo-0.2.1: prelude/continuation.atomo

{ define: *dynamic-winds* as: []

  (o: Object) call/cc := o call/cc: []
  (o: Object) call/cc: as :=
    { cc |
      winds = *dynamic-winds* _?

      new = cc clone do:
        { yield: v :=
            { dynamic-unwind: winds
                delta: (*dynamic-winds* _? length - winds length)

              cc yield: v
            } call
        }

      o call: (new . as)
    } raw-call/cc

  (v: Block) before: (b: Block) := v before: b after: { @ok }
  (v: Block) after: (a: Block) := v before: { @ok } after: a

  (v: Block) before: (b: Block) after: (a: Block) :=
    { b call

      *dynamic-winds* =! ((b -> a) . *dynamic-winds* _?)

      res = v call

      a call

      *dynamic-winds* =! *dynamic-winds* _? tail

      res
    } call

  (init: Block) wrap: cleanup do: action :=
    { action call: [x] } before: { x = init call } in-context after: { cleanup call: [x] }

  dynamic-unwind: to delta: d :=
    condition: {
      (*dynamic-winds* _? == to) -> @ok

      (d < 0) ->
        { dynamic-unwind: to tail delta: (d + 1)
          to head from call
          *dynamic-winds* =! to
          @ok
        } call

      otherwise ->
        { post = *dynamic-winds* _? head to
          *dynamic-winds* =! *dynamic-winds* _? tail
          post call
          dynamic-unwind: to delta: (d - 1)
        } call
    }
} call