racket/types.rkt

   1 #lang racket
   2
   3 (provide blank-exn? make-blank-exn mal-exn? make-mal-exn mal-exn-val
   4          malfunc malfunc? malfunc-fn
   5          malfunc-ast malfunc-env malfunc-params malfunc-macro? malfunc-meta
   6          _partition _equal? _printf
   7          nil _nil? _keyword _keyword?
   8          _to_list _sequential? _count _empty? _nth _first _rest _map
   9          _assoc _dissoc _get
  10          atom atom? atom-val set-atom-val!)
  11
  12 (define-struct (blank-exn exn:fail:user) ())
  13 (define-struct (mal-exn exn:fail:user) [val])
  14
  15 (define nil%
  16   (class object%
  17     (super-new)))
  18
  19 (define nil (new nil%))
  20
  21 (define (_nil? obj)
  22   (eq? nil obj))
  23
  24 (struct malfunc [fn ast env params macro? meta]
  25         #:property prop:procedure (struct-field-index fn))
  26
  27 ;; General functions
  28
  29 ;; From: http://stackoverflow.com/questions/8725832/how-to-split-list-into-evenly-sized-chunks-in-racket-scheme/8731622#8731622
  30 (define (_partition n xs)
  31   (if (null? xs)
  32       '()
  33       (let ((first-chunk (take xs n))
  34             (rest (drop xs n)))
  35         (cons first-chunk (_partition n rest)))))
  36
  37 (define (_equal_seqs? seq_a seq_b)
  38   (let ([a (_to_list seq_a)]
  39         [b (_to_list seq_b)])
  40     (and (= (length a) (length b))
  41          (andmap (lambda (va vb) (_equal? va vb)) a b))))
  42
  43 (define (_equal_hashes? a b)
  44   (if (= (hash-count a) (hash-count b))
  45     (let ([keys (hash-keys a)])
  46       (andmap (lambda (k) (_equal? (_get a k) (_get b k))) keys))
  47     #f))
  48
  49 (define (_equal? a b)
  50   (cond
  51     [(and (_sequential? a) (_sequential? b)) (_equal_seqs? a b)]
  52     [(and (hash? a) (hash? b))               (_equal_hashes? a b)]
  53     [else                                    (equal? a b)]))
  54
  55 ;; printf with flush
  56 (define _printf (lambda a (apply printf a) (flush-output)))
  57
  58 ;; Keywords
  59 (define (_keyword str)
  60   (string-append "\u029e" str))
  61
  62 (define (_keyword? k)
  63   (and (string? k) (regexp-match? #px"^\u029e" k)))
  64
  65
  66 ;; Lists and vectors
  67
  68 (define (_to_list a)
  69   (if (vector? a) (vector->list a) a))
  70
  71 (define (_sequential? seq)
  72   (or (vector? seq) (list? seq)))
  73
  74 (define (_count seq)
  75   (cond [(_nil? seq)    0]
  76         [(vector? seq) (vector-length seq)]
  77         [else          (length seq)]))
  78
  79 (define (_empty? seq)
  80   (eq? 0 (_count seq)))
  81
  82 (define (_nth seq idx)
  83     (cond [(>= idx (_count seq)) (raise "nth: index out of range")]
  84           [(vector? seq) (vector-ref seq idx)]
  85           [else          (list-ref seq idx)]))
  86
  87 (define (_first seq)
  88   (cond [(vector? seq) (if (_empty? seq) nil (vector-ref seq 0))]
  89         [else          (if (_empty? seq) nil (list-ref seq 0))]))
  90
  91 (define (_rest seq)
  92   (cond [(vector? seq) (if (_empty? seq) '() (rest (vector->list seq)))]
  93         [else          (if (_empty? seq) '() (rest seq))]))
  94
  95 (define (_map f seq)
  96   (cond [(vector? seq) (vector-map f seq)]
  97         [else          (map f seq)]))
  98
  99 ;; Hash maps
 100 (define _assoc
 101   (lambda args
 102     (let ([new-hm (hash-copy (first args))]
 103           [pairs (_partition 2 (rest args))])
 104       (map (lambda (k_v)
 105              (hash-set! new-hm (first k_v) (second k_v))) pairs)
 106       new-hm)))
 107
 108 (define _dissoc
 109   (lambda args
 110     (let ([new-hm (hash-copy (first args))])
 111       (map (lambda (k) (hash-remove! new-hm k)) (rest args))
 112       new-hm)))
 113
 114 (define (_get hm k)
 115     (cond [(_nil? hm) nil]
 116           [(dict-has-key? hm k) (hash-ref hm k)]
 117           [else nil]))
 118
 119 ;; Atoms
 120 (struct atom [val] #:mutable)