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

(provide linked-thread)

(require "engine.rkt")
(require (only-in racket/exn exn->string))

(define-logger syndicate/driver-support)

(define (linked-thread thread-proc
                       #:name [name (gensym 'linked-thread)]
                       #:peer [peer (ref (entity/stop-on-retract #:name (list name 'monitor)))]
                       #:custodian [c0 #f])
  (define c (or c0 (make-custodian)))

  (define facet this-facet)
  (define actor this-actor)

  (define handle #f)
  (define armed? #t)

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

  (on-stop (!))
  (actor-add-exit-hook! 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)
                                           (log-syndicate/driver-support-error "~a crashed:\n~a"
                                                                               name
                                                                               (exn->string e))
                                           (void))])
                                     (thread-proc facet))
                                   (!))))))))