;;; Generated by dzn code from #ast:source-file
(define-module (main)
  ##:use-module (srfi srfi-1)
  ##:use-module (srfi srfi-26)
  ##:use-module (ice-9 rdelim)
  ##:use-module (oop goops)
  ##:use-module (dzn runtime)
  ##:use-module (dzn pump)
  #x:use-module
  ##:use-module (#scheme:module-name)
  ##:duplicates (merge-generics)
  ##:export (main))

(define relaxed? ##f)

(define (drop-prefix string prefix)
  (if (string-prefix? prefix string)
      (substring string (string-length prefix))
      string))

(define (consume-synchronous-out-events prefix event event-alist)
  (let ((match (string-append prefix event)))
    (when (getenv "PUMP_DEBUG") (format (current-error-port) "consume match=~a\n" match))
    (let loop ((s (read-line)))
      (when (getenv "PUMP_DEBUG") (format (current-error-port) "consume s=~a\n" s))
      (and s
           (not (eof-object? s))
           (not (equal? s match))
           (loop (read-line)))))
  (let loop ((s (read-line)))
    (let ((event (and s
                      (not (eof-object? s))
                      (assoc-ref event-alist (string->symbol s)))))
      (cond (event
              (event)
              (loop (read-line)))
            (else
             (and s (not (eof-object? s))
                    (last (string-split s #\.))))))))

(define (log-in port event event-alist)
  (dzn:trace stderr port event)
  (when (not relaxed?)
    (let* ((prefix (string-append (.name (.in port)) "."))
           (prefix (drop-prefix prefix "<external>.")))
      (consume-synchronous-out-events prefix event event-alist))
    (dzn:trace-out stderr port "return"))
  ##f)

(define (log-out port event event-alist)
  (dzn:trace-out stderr port event)
  ##f)

(define (type-helper value type)
  (cond ((eq? type 'int) (string->number value))
        ((eq? type 'bool) (equal? value "true"))
        (else (string->symbol value))))

(define (log-typed port event event-alist)
  (dzn:trace stderr port event)
  (if (not relaxed?)
      (let* ((prefix (string-append (.name (.in port)) "."))
             (prefix (drop-prefix prefix "<external>."))
             (s (consume-synchronous-out-events prefix event event-alist)))
        (cond
        (s
          (dzn:trace-out stderr port s)
          s)
        (else
          0)))
      0))

(define (fill-event-alist o)
  (let* ((dzn-i 0)
         (flush? (find (cute string=? <> "--flush") (command-line)))
         (defer? (find (cute string=? <> "--defer") (command-line)))
         (defer? ##t) ;; FIXME: always true for now
         (pump (dzn:get (.locator o) <dzn:pump>))
         (c (make <dzn:component> ##:locator (.locator o) ##:flushes? flush?))
         (e `(#x:main-event-map-void
              #x:main-event-map-typed
              #x:main-event-map-flush
              (<defer> . ,(cute dzn:run-defer pump)))))

    #x:main-provides-port-init
    #x:main-requires-port-init

    (when flush?
      ##f
      #x:main-provides-flush-init
      #x:main-requires-flush-init)

    #x:main-port-connect-in-void
    #x:main-port-connect-in-typed
    #x:main-port-connect-out
  e))

(define (main . args)
  (let* ((print-illegal (lambda () (stderr "illegal\n") (exit 0)))
         (locator (make <dzn:locator>))
         (runtime (make <dzn:runtime> ##:illegal print-illegal))
         (pump (make <dzn:pump>))
         (locator (dzn:set! locator runtime))
         (locator (dzn:set! locator pump))
         (sut (make <#x:class-name > ##:locator locator ##:name "sut"))
         (event-alist (fill-event-alist sut)))

    (define (next-event)
      (let ((s (read-line)))
        (when (getenv "PUMP_DEBUG") (format (current-error-port) "next-event s=~a\n" s))
        (if (eof-object? s) s
            (assoc-ref event-alist (string->symbol s)))))

    (let loop ()
      (when (getenv "PUMP_DEBUG") (format (current-error-port) "main loop\n"))
      (let ((event (next-event)))
        (unless (eof-object? event)
          (when event
            (dzn:pump pump event next-event))
          (loop))))

    (dzn:finalize pump)))

;;; version: #x:version
