#lang br (require racket/stxparam) (provide (all-defined-out) #%top-interaction #%top (rename-out [my-datum #%datum])) (define-macro top #'#%module-begin) (define-macro (my-datum . VAL) (with-syntax ([NEW-VAL (let ([val (syntax->datum #'VAL)]) (if (and (integer? val) (inexact? val)) (inexact->exact val) val))]) #'(#%datum . NEW-VAL))) (define-macro (var ID VAL) #'(define ID VAL)) (define (add/concat . xs) (cond [(andmap number? xs) (apply + xs)] [(ormap string? xs) (string-join (map ~a xs) "")])) (define-macro-cases add-or-sub [(_ LEFT "+" RIGHT) #'(add/concat LEFT RIGHT)] [(_ LEFT "-" RIGHT) #'(- LEFT RIGHT)] [(_ OTHER) #'OTHER]) (define-macro-cases mult-or-div [(_ LEFT "*" RIGHT) #'(* LEFT RIGHT)] [(_ LEFT "/" RIGHT) #'(/ LEFT RIGHT)] [(_ OTHER) #'OTHER]) (define-macro (object (K V) ...) #'(make-hash (list (cons K V) ...))) (define-syntax-parameter return (λ (stx) (error 'not-parameterized))) (define-macro (fun (ARG ...) STMT ...) (syntax/loc caller-stx (λ (ARG ...) (let/cc return-cc (syntax-parameterize ([return (make-rename-transformer #'return-cc)]) STMT ... (void)))))) (define (resolve-deref base . keys) (for/fold ([val base]) ([key (in-list keys)]) (cond [(and (hash? val) (cond [(hash-ref val key #f)] [(hash-ref val (symbol->string key) #f)] [else #f]))] [else (error 'deref-failure)]))) (define-macro (deref (BASE KEY ...)) #'(resolve-deref BASE 'KEY ...)) (define-macro app #'#%app) (define-macro-cases if [(_ COND TSTMT ... "else" FSTMT ...) #'(cond [COND TSTMT ...] [else FSTMT ...])] [(_ COND STMT ...) #'(when COND STMT ...)]) (define-macro-cases comparison [(_ VAL) #'VAL] [(_ L "==" R) #'(equal? L R)] [(_ L "!=" R) #'(not (equal? L R))]) (define-macro (while COND STMT ...) #'(let loop () (when COND STMT ... (loop)))) (define alert displayln) (define-macro (increment ID) #'(let () (set! ID (add1 ID)) ID))