... This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
... If a copy of the MPL was not distributed with this file, You can obtain one at https://mozilla.org/MPL/2.0/.

(.using
 [library
  [lux (.except)
   [macro
    ["[0]" template]]]]
 ["[0]" // (.use "[1]#[0]" monad)])

... Inspired by;
... "Delimited continuations in Haskell" by Oleg Kiselyov

(every .public (Static it)
  it)

(the .public (reset it)
  (for_any (_ it)
    (-> (//.Cont it (Static it))
        (//.Cont it)))
  (//#pure (it //.empty)))

(alias [context]
       ..reset)

(the .public (shift exit)
  (for_any (_ local global)
    (-> (-> (-> local (Static global))
            (//.Cont global (Static global)))
        (//.Cont local (Static global))))
  (function (_ after_shift)
    ((exit after_shift) //.empty)))

(alias [exit]
       ..shift)

... Inspired by;
... "Shift to control" by Chung-chieh Shan

(every .public (Dynamic it)
  (-> (Maybe (-> it (Dynamic it)))
      it))

(the Dynamic_Context
  (template.macro (_ local global)
    [(//.Context local (Dynamic global))]))

(the (dynamic_empty return)
  (for_any (_ it)
    (Dynamic_Context it it))
  (function (_ dynamic)
    (when dynamic
      {.#None}
      return
      
      {.#Some dynamic}
      (dynamic return {.#None}))))

(the (dynamic_composite static dynamic)
  (for_any (_ local global)
    (-> (Dynamic_Context local global) (Maybe (Dynamic_Context global global))
        (Dynamic_Context local global)))
  (when dynamic
    {.#None}
    static
    
    {.#Some dynamic}
    (function (_ return dynamic')
      (static return {.#Some (dynamic_composite dynamic dynamic')}))))

(the .public (prompt it)
  (for_any (_ it)
    (-> (//.Cont it (Dynamic it))
        (//.Cont it)))
  (//#pure (it ..dynamic_empty {.#None})))

(the .public (control it)
  (for_any (_ local global)
    (-> (-> (-> local (//.Cont global (Dynamic global)))
            (//.Cont global (Dynamic global)))
        (//.Cont local (Dynamic global))))
  (function (_ local_static local_dynamic)
    (let [exit (function (_ return)
                 (function (_ global_static global_dynamic)
                   (((..dynamic_composite local_static local_dynamic) return)
                    {.#Some (..dynamic_composite global_static global_dynamic)})))]
      ((it exit) ..dynamic_empty {.#None}))))

(every .public (Propagated it)
  (-> (Stack (-> it (Propagated it)))
      it))

(the Propagated_Context
  (template.macro (_ local global)
    [(//.Context local (Propagated global))]))

(the (propagated_empty return)
  (for_any (_ it)
    (Propagated_Context it it))
  (function (_ propagated)
    (when propagated
      {.#Empty}
      return
      
      {.#Top head tail}
      (head return tail))))

(the .public (reset_0 it)
  (for_any (_ it)
    (-> (//.Cont it (Propagated it))
        (//.Cont it (Propagated it))))
  (function (_ static propagated)
    (it ..propagated_empty {.#Top static propagated})))

(the .public (propagated it)
  (for_any (_ local)
    (-> (//.Cont local (Propagated local))
        (//.Cont local)))
  (//#pure (it ..propagated_empty (stack))))

(the .public (shift_0 it)
  (for_any (_ local global)
    (-> (-> (-> local (//.Cont global (Propagated global)))
            (//.Cont global (Propagated global)))
        (//.Cont local (Propagated global))))
  (function (_ local_static local_propagated)
    (let [exit (function (_ return)
                 (function (_ global_static global_propagated)
                   ((local_static return) {.#Top global_static global_propagated})))]
      (when local_propagated
        {.#Empty}
        ((it exit) ..propagated_empty (stack))
        
        {.#Top head tail}
        ((it exit) head tail)))))

(every .public (Dynamic_Propagated it)
  (-> (Maybe (-> it (Dynamic_Propagated it)))
      (Stack (-> it (Dynamic_Propagated it)))
      it))

(the Dynamic_Propagated_Context
  (template.macro (_ local global)
    [(//.Context local (Dynamic_Propagated global))]))

(the (dynamic_propagated_empty return)
  (for_any (_ it)
    (Dynamic_Propagated_Context it it))
  (function (_ dynamic)
    (when dynamic
      {.#Some dynamic}
      ((dynamic return) {.#None})

      {.#None}
      (function (_ propagated)
        (when propagated
          {.#Empty}
          return
          
          {.#Top head tail}
          (head return {.#None} tail))))))

(the (dynamic_propagated_composite static dynamic)
  (for_any (_ local global)
    (-> (Dynamic_Propagated_Context local global)
        (Maybe (Dynamic_Propagated_Context global global))
        (Dynamic_Propagated_Context local global)))
  (when dynamic
    {.#None}
    static
    
    {.#Some dynamic}
    (function (_ return dynamic')
      (static return {.#Some (dynamic_propagated_composite dynamic dynamic')}))))

(the .public (prompt_0 it)
  (for_any (_ it)
    (-> (//.Cont it (Dynamic_Propagated it))
        (//.Cont it (Dynamic_Propagated it))))
  (function (_ static dynamic propagated)
    (it ..dynamic_propagated_empty
        {.#None}
        {.#Top (dynamic_propagated_composite static dynamic)
               propagated})))

(the .public (control_0 it)
  (for_any (_ local global)
    (-> (-> (-> local (//.Cont global (Dynamic_Propagated global)))
            (//.Cont global (Dynamic_Propagated global)))
        (//.Cont local (Dynamic_Propagated global))))
  (function (_ local_static local_dynamic local_propagated)
    (let [exit (function (_ return)
                 (function (_ global_static global_dynamic)
                   (((dynamic_propagated_composite local_static local_dynamic) return)
                    {.#Some (dynamic_propagated_composite global_static global_dynamic)})))]
      (when local_propagated
        {.#Empty}
        ((it exit) ..dynamic_propagated_empty {.#None} (stack))
        
        {.#Top head tail}
        ((it exit) head {.#None} tail)))))

(the .public (dynamic_propagated it)
  (for_any (_ local)
    (-> (//.Cont local (Dynamic_Propagated local))
        (//.Cont local)))
  (//#pure (it ..dynamic_propagated_empty {.#None} (stack))))
