You cannot select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
47 lines
1.7 KiB
Racket
47 lines
1.7 KiB
Racket
#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))))) |