test.lisp

   1 ;;; Library
   2
   3 (eval-when-compile
   4   (%compile-defmacro 'defmacro
   5      (lambda (name args &rest body)
   6        `(eval-when-compile
   7           (%compile-defmacro ',name (lambda ,args ,@body))))))
   8
   9 (defmacro defun (name args &rest body)
  10   `(progn
  11      (eval-when-compile
  12        (%compile-defun ',name))
  13      (fsetq ,name (lambda ,args ,@body))))
  14
  15
  16 ;;; Tests
  17
  18 (lambda (x y) x)
  19
  20 (debug "hola")
  21 (debug '(1 2 3 4))
  22 (debug (if 2 (+ 2 1) 0))
  23 (debug (= (+ 2 1) (- 4 1)))
  24
  25 ;;; Variables
  26 (debug "---VARIABLES---")
  27 (eval-when-compile
  28   (%compile-defvar 'name))
  29 (setq name 10)
  30 (debug name)
  31
  32 ;;; Functions
  33 (debug "---FUNCTIONS---")
  34 (eval-when-compile
  35   (%compile-defun 'f))
  36 (fsetq f (lambda (x) (+ x 10)))
  37 (debug (f 20))
  38
  39 (debug ((lambda (x) x) 9999))
  40
  41 (debug #'f)
  42
  43 ;;; Macros
  44 (debug "---MACROS---")
  45
  46
  47
  48 (defmacro incf (x)
  49   (list 'setq x (list '+ 1 x)))
  50
  51 (eval-when-compile
  52   (%compile-defvar 'x))
  53
  54 (setq x 10)
  55 (incf x)
  56 (debug x)
  57
  58 ;;; Conses
  59 (debug (cons 1 2))
  60 (debug (car (cons 1 2)))
  61 (debug (cdr (cons 1 2)))
  62
  63 (setq x '(1 . 2))
  64 (debug x)
  65 (debug (eq x x))
  66 (debug (eq '(1 . 2) '(1 . 2)))
  67
  68 ;;; Symbols
  69 (debug (symbol-name 'foo))
  70 (debug (symbol-name 'foo-bar))
  71
  72 (debug (progn 1 2 3 123))
  73
  74 (debug (let ((x 99999))
  75          (incf x)))
  76
  77 ;;; &rest lambda-list
  78
  79 (debug (lambda (&rest x) x))
  80 (debug (lambda (x y &rest z) z))
  81 (debug (lambda (x y &rest z) x))
  82
  83
  84 (defun f (x) (* x x))
  85 (debug (f 33))
  86
  87 ;; (eval-when-compile
  88 ;;   (%compile-defmacro 'defun
  89 ;;                   (lambda (name args &rest body)
  90 ;;                     (list 'eval-when-compile
  91 ;;                           (list 'compile-defun)
  92 ;;                           (list 'fsetq (list 'lambda args (list 'progn body)))))))