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