#lang br/quicklang
(provide (rename-out [b-module-begin #%module-begin])
         (all-defined-out))

(define-exn-srcloc duplicate-line-number exn:fail)

(define-macro (b-module-begin (b-program LINE ...))
  #'(#%module-begin
     (define lines (sort (list LINE ...) #:key $line-number <))
     (unless (apply < (map $line-number lines))
       (raise-duplicate-line-number
        ($line-srcloc (check-duplicates lines = #:key $line-number))))
     (run lines)))

(struct $line (number thunk srcloc) #:transparent)

(define-macro (b-line LINE-NUMBER STATEMENT)
  (with-pattern ([SRCLOC (syntax-srcloc caller-stx)])
    #'($line LINE-NUMBER (thunk STATEMENT) SRCLOC)))

(define-macro (b-statement (PROC-NAME ARG ...))
  #'(begin (PROC-NAME ARG ...)))

(define (b-rem str) #f)
(define (b-print str) (displayln str))
(define (b-goto line-number) line-number)

(define-exn end-program-signal exn:fail)
(define (b-end) (raise-end-program-signal))

(define-exn-srcloc line-not-found exn:fail)

(define (run lines)
  (define line-vec (list->vector lines))
  (define line-idx-table (for/hasheqv ([(line idx) (in-indexed line-vec)])
                           (values ($line-number line) idx)))
  (with-handlers ([end-program-signal? void])
    (for/fold ([line-idx 0])
              ([i (in-naturals)])
      (unless (< line-idx (vector-length line-vec)) (b-end))
      (define this-line (vector-ref line-vec line-idx))
      (define this-thunk ($line-thunk this-line))
      (define this-result (this-thunk))
      (if (exact-positive-integer? this-result)
          (hash-ref line-idx-table this-result
                    (thunk (raise-line-not-found ($line-srcloc this-line))))
          (add1 line-idx)))))