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.
96 lines
2.9 KiB
Racket
96 lines
2.9 KiB
Racket
#lang racket/base
|
|
(require racket/class (for-syntax racket/base racket/syntax) racket/dict)
|
|
(provide (all-defined-out))
|
|
|
|
|
|
;; js-style `push`, which appends to end of list
|
|
(define-syntax-rule (push-end! ID THING)
|
|
(set! ID (append ID (list THING))))
|
|
|
|
|
|
(define-syntax (increment! stx)
|
|
(syntax-case stx ()
|
|
[(_ ID) #'(increment! ID 1)]
|
|
[(_ ID EXPR)
|
|
#'(begin (set! ID (+ ID EXPR)) ID)]))
|
|
|
|
(module+ test
|
|
(define xs '(1 2 3))
|
|
(push-end! xs 4)
|
|
(check-equal? xs '(1 2 3 4)))
|
|
|
|
(define-syntax-rule (+= ID THING) (begin (set! ID (+ ID THING)) ID))
|
|
(define-syntax-rule (++ ID) (+= ID 1))
|
|
(define-syntax-rule (-- ID) (+= ID -1))
|
|
(define-syntax-rule (-= ID THING) (+= ID (- THING)))
|
|
|
|
|
|
;; fancy number->string. bounds are checked, inexact integers are coerced.
|
|
(define (number x #:round [round? #true])
|
|
(unless (and (number? x) (< -1e21 x 1e21))
|
|
(raise-argument-error 'number "valid number" x))
|
|
(let ([x (if round? (/ (round (* x 1e6)) 1e6) x)])
|
|
(number->string (if (integer? x)
|
|
(inexact->exact x)
|
|
x))))
|
|
|
|
(module+ test
|
|
(check-equal? (number 4.5) "4.5")
|
|
(check-equal? (number 4.0) "4")
|
|
(check-equal? (number 4) "4")
|
|
(check-equal? (number -4) "-4"))
|
|
|
|
|
|
(define ·-helper
|
|
(procedure-rename
|
|
(λ (x . refs)
|
|
(for/fold ([x x])
|
|
([ref (in-list refs)]
|
|
#:break (not x))
|
|
(cond
|
|
;; give `send` precedence (presence of method => wants runtime resolution of value)
|
|
[(and (object? x)
|
|
(memq ref (interface->method-names (object-interface x)))) (dynamic-send x ref)]
|
|
;; dict first, to catch objects that implement gen:dict
|
|
[(dict? x) (dict-ref x ref #f)]
|
|
[(object? x) (cond
|
|
[(memq ref (field-names x)) (dynamic-get-field ref x)]
|
|
[else #f])]
|
|
[else (raise-argument-error '· "object or dict" (cons x refs))]))) '·))
|
|
|
|
(define-syntax-rule (· X REF ...) (·-helper X 'REF ...))
|
|
|
|
#;(module+ test
|
|
(define c (class object%
|
|
(super-new)
|
|
(field [a 42])
|
|
(define/public (res) (hash 'res (hash 'b 43)))))
|
|
(define co (make-object c))
|
|
(define h2 (hash 'a 42 'res co))
|
|
(check-equal? (· h2 a) 42)
|
|
(check-equal? (· h2 b) 43)
|
|
(check-equal? (· co a) 42)
|
|
(check-equal? (· co b) 43))
|
|
|
|
(define-syntax-rule (·map REF XS)
|
|
(for/list ([x (in-list XS)]) (· x REF)))
|
|
|
|
(module+ test
|
|
(require rackunit)
|
|
(define C
|
|
(class object%
|
|
(super-new)
|
|
(field [foo 'field])
|
|
(define/public (bar) 'method)
|
|
(define/public (zam) (hasheq 'zoom 'hash))))
|
|
(define h (hasheq 'bam (new C) 'foo 'hashlet))
|
|
(define o (new C))
|
|
(check-equal? (· o foo) 'field)
|
|
(check-equal? (· o bar) 'method)
|
|
(check-equal? (· o zam zoom) 'hash)
|
|
(check-equal? (· h bam foo) 'field)
|
|
(check-equal? (· h bam bar) 'method)
|
|
(check-equal? (· h bam zam zoom) 'hash)
|
|
(check-equal? (·map foo (list o h)) '(field hashlet)))
|
|
|