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/br/demo/basic/expander0.rkt

88 lines
2.7 KiB
Racket

#lang br
(provide (all-defined-out)
#%top-interaction
#%datum
(rename-out [basic-module-begin #%module-begin]))
(require (for-syntax racket/string))
(define #'(basic-module-begin PARSE-TREE ...)
#'(#%module-begin
(println (quote PARSE-TREE ...))
'PARSE-TREE ...))
(define #'(basic-program LINE ...)
#'(basic-run LINE ...))
(define (basic-run . lines)
(define program-lines (list->vector (filter (λ(x) x) lines)))
(void (for/fold ([line-idx 0])
([i (in-naturals)]
#:break (= line-idx (vector-length program-lines)))
(match-define (cons line-number proc)
(vector-ref program-lines line-idx))
(define maybe-jump-number (and proc (proc)))
(if (number? maybe-jump-number)
(let ([jump-number maybe-jump-number])
(for/or ([idx (in-range (vector-length program-lines))])
(and (= (car (vector-ref program-lines idx)) jump-number)
idx)))
(add1 line-idx)))))
(define #'(CR) #'#f)
(define #'(REM ARG ...) #'(void (list 'ARG ...)))
;; model each line as (cons line-number line-thunk)
(define-cases #'line
[#'(_ NUMBER . SEPARATED-STMTS)
#`(cons NUMBER
(λ _ (begin
#,@(for/list ([(item idx) (in-indexed (syntax->list #'SEPARATED-STMTS))]
#:when (even? idx))
item))))]
[#'(_ ARG ...) #'(line #f ARG ...)])
(define #'(statement NAME ARG ...) #'(NAME ARG ...))
(define #'(expression ITEM) #'ITEM)
(define #'(unsignedexpr ITEM) #'ITEM)
(define #'(term ITEM) #'ITEM)
(define #'(factor ITEM) #'ITEM)
(define #'(number ITEM) #'ITEM)
(define #'(varlist ITEM) #'ITEM)
(define #'(var ITEM) #'ITEM)
(define #'(printitem EXPR-OR-STRING) #'EXPR-OR-STRING)
;; skip separators
(define #'(printlist . SEPARATED-ITEMS) #`(list #,@(for/list ([(item idx) (in-indexed (syntax->list #'SEPARATED-ITEMS))]
#:when (even? idx))
item)))
(define #'(separator SEP) #'(void))
(define #'(function NAME EXP ")") #`(#,(string->symbol (string-trim (syntax->datum #'NAME) "(")) EXP))
(define (TAB expr)
(make-string expr #\space))
(define (PRINT . args)
(println args)
(if (and (= (length args) 1) (list? (car args)))
(begin
(for-each display (car args))
(displayln ""))
(filter (λ(i) (and (equal? i ":") (displayln ""))) args)))
(define (GOTO where)
where)
(define vars (make-hasheq))
(define (INPUT id)
(hash-set! vars (string->symbol id) (read (open-input-string (read-line)))))
(define-cases #'expr-list
[#'(_ EXPR ...) #'(list EXPR ...)])