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