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