src/testing-library.scm

   1 (define list (lambda args args))
   2
   3 (define join-lists
   4   (lambda (l1 l2)
   5     (if (null? l1)
   6       l2
   7       (cons (car l1) (join-lists (cdr l1) l2)))))
   8
   9 (define-macro (cadr x) (list 'car (list 'cdr x)))
  10
  11 (define-macro (define args . body)
  12               (if (pair? args)
  13                 (list 'define (car args) (join-lists (list 'lambda (cdr args)) body))
  14                 'no-match))
  15
  16 (define (map proc l)
  17   (if (null? l)
  18     '()
  19     (cons (proc (car l)) (map proc (cdr l)))))
  20
  21
  22 (define-macro (not x)
  23               (list 'if x #f #t))
  24
  25 (define-macro (let args . body)
  26               (join-lists
  27                 (list (join-lists (list 'lambda (map (lambda (x) (car x)) args)) body))
  28                 (map (lambda (x) (cadr x)) args)))
  29
  30 ((lambda ()
  31    (define (qqhelper l)
  32      (if (null? l)
  33        l
  34        (let ((head (car l))
  35              (tail (cdr l)))
  36
  37          (if (pair? head)
  38              (if (eq? (car head) 'unquote)
  39                  (list 'cons (cadr head) (qqhelper tail))
  40                  (if (eq? (car head) 'unquote-splicing)
  41                      (list 'join-lists (cadr head) (qqhelper tail))
  42                      (list 'cons (list 'quasiquote head) (qqhelper tail))))
  43              (if (symbol? head)
  44                  (list 'cons (list 'quote head) (qqhelper tail))
  45                  (list 'cons head (qqhelper tail)))))))
  46
  47    (define-macro (quasiquote arg)
  48                  (if (not (pair? arg))
  49                    (list 'quote arg)
  50                    (qqhelper arg)))))