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 defvar (name value)
  10   `(progn
  11      (eval-when-compile
  12        (%compile-defvar ',name))
  13      (setq ,name ,value)))
  14
  15 (defmacro defun (name args &rest body)
  16   `(progn
  17      (eval-when-compile
  18        (%compile-defun ',name))
  19      (fsetq ,name (lambda ,args ,@body))))
  20
  21 (defun = (x y) (= x y))
  22 (defun + (x y) (+ x y))
  23 (defun - (x y) (- x y))
  24 (defun * (x y) (* x y))
  25 (defun / (x y) (/ x y))
  26 (defun 1+ (x) (+ x 1))
  27 (defun 1- (x) (- x 1))
  28 (defun cons (x y ) (cons x y))
  29 (defun car (x) (car x))
  30 (defun cdr (x) (cdr x))
  31
  32 (defun append (list1 list2)
  33   (if (null list1)
  34       list2
  35       (cons (car list1)
  36             (append (cdr list1) list2))))
  37
  38 (defun reverse-aux (list acc)
  39   (if (null list)
  40       acc
  41       (reverse-aux (cdr list) (cons (car list) acc))))
  42
  43 (defun reverse (list)
  44   (reverse-aux list '()))
  45
  46 (defun mapcar (func list)
  47   (if (null list)
  48       '()
  49       (cons (funcall func (car list))
  50             (mapcar func (cdr list)))))
  51
  52
  53 ;;; Tests
  54
  55 (lambda (x y) x)
  56
  57 (debug "hola")
  58 (debug '(1 2 3 4))
  59 (debug (if 2 (+ 2 1) 0))
  60 (debug (= (+ 2 1) (- 4 1)))
  61
  62 ;;; Variables
  63 (debug "---VARIABLES---")
  64 (eval-when-compile
  65   (%compile-defvar 'name))
  66 (setq name 10)
  67 (debug name)
  68
  69 ;;; Functions
  70 (debug "---FUNCTIONS---")
  71 (eval-when-compile
  72   (%compile-defun 'f))
  73 (fsetq f (lambda (x) (+ x 10)))
  74 (debug (f 20))
  75
  76 (debug ((lambda (x) x) 9999))
  77
  78 (debug #'f)
  79
  80 ;;; Macros
  81 (debug "---MACROS---")
  82
  83
  84
  85 (defmacro incf (x)
  86   (list 'setq x (list '+ 1 x)))
  87
  88 (eval-when-compile
  89   (%compile-defvar 'x))
  90
  91 (setq x 10)
  92 (incf x)
  93 (debug x)
  94
  95 ;;; Conses
  96 (debug (cons 1 2))
  97 (debug (car (cons 1 2)))
  98 (debug (cdr (cons 1 2)))
  99
 100 (setq x '(1 . 2))
 101 (debug x)
 102 (debug (eq x x))
 103 (debug (eq '(1 . 2) '(1 . 2)))
 104
 105 ;;; Symbols
 106 (debug (symbol-name 'foo))
 107 (debug (symbol-name 'foo-bar))
 108
 109 (debug (progn 1 2 3 123))
 110
 111 (debug (let ((x 99999))
 112          (incf x)))
 113
 114 ;;; &rest lambda-list
 115
 116 (debug (lambda (&rest x) x))
 117 (debug (lambda (x y &rest z) z))
 118 (debug (lambda (x y &rest z) x))
 119
 120
 121 ;; (eval-when-compile
 122 ;;   (%compile-defmacro 'defun
 123 ;;                   (lambda (name args &rest body)
 124 ;;                     (list 'eval-when-compile
 125 ;;                           (list 'compile-defun)
 126 ;;                           (list 'fsetq (list 'lambda args (list 'progn body)))))))