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.
beautiful-racket/beautiful-racket-demo/basic-demo-3/go.rkt

52 lines
1.5 KiB
Racket

8 years ago
#lang br
8 years ago
(require "struct.rkt" "line.rkt" "misc.rkt")
(provide b-end b-goto b-gosub b-return b-for b-next)
(define (b-end) (raise (end-program-signal)))
8 years ago
(define (b-goto num-expr)
(raise (change-line-signal num-expr)))
8 years ago
(define return-ccs empty)
8 years ago
(define (b-gosub num-expr)
8 years ago
(let/cc this-cc
(push! return-ccs this-cc)
8 years ago
(b-goto num-expr)))
(define (b-return)
8 years ago
(unless (not (empty? return-ccs))
8 years ago
(raise-line-error "return without gosub"))
8 years ago
(define top-cc (pop! return-ccs))
(top-cc (void)))
(define next-funcs (make-hasheq))
(define-macro-cases b-for
[(_ LOOP-ID START END) #'(b-for LOOP-ID START END 1)]
[(_ LOOP-ID START END STEP)
#'(b-let LOOP-ID
(let/cc loop-cc
(hash-set! next-funcs
'LOOP-ID
(λ ()
(define next-val
(+ LOOP-ID STEP))
(if (next-val
. in-closed-interval? .
START END)
(loop-cc next-val)
(hash-remove! next-funcs
'LOOP-ID))))
START))])
(define (in-closed-interval? x start end)
((if (< start end) <= >=) start x end))
(define-macro (b-next LOOP-ID)
#'(begin
(unless (hash-has-key? next-funcs 'LOOP-ID)
(raise-line-error
(format "`next ~a` without for" 'LOOP-ID)))
(define func (hash-ref next-funcs 'LOOP-ID))
(func)))