#lang syndicate
;;; SPDX-License-Identifier: LGPL-3.0-or-later
;;; SPDX-FileCopyrightText: Copyright © 2021 Tony Garnock-Jones <tonyg@leastfixedpoint.com>

(provide linked-thread)

(require "engine.rkt")

(define-logger syndicate/driver-support)

(define linked-thread
  (action (peer
           thunk
           #:name [name (gensym 'linked-thread)]
           #:custodian [c (make-custodian)])
    (define handle #f)

    (define armed? #t)

    (define !
      (action ()
        (when armed?
          (set! armed? #f)
          (log-syndicate/driver-support-info "~a shutdown" name)
          (turn-retract! this-turn handle)
          (queue-task! (actor-engine this-actor) (lambda () (custodian-shutdown-all c)))
          (actor-remove-exit-hook! this-actor !))))

    (on-stop (! this-turn))
    (actor-add-exit-hook! this-actor !)

    (log-syndicate/driver-support-info "~a startup" name)
    (set! handle
          (parameterize ((current-custodian c))
            (turn-assert! this-turn
                          peer
                          (embedded
                           (thread (lambda ()
                                     (with-handlers ([(lambda (_e) #t) (lambda (_e) (void))]) (thunk))
                                     (turn-freshen this-turn !)))))))))