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 (defvar t 't)
  16 (defvar nil 'nil)
  17
  18 (defmacro defun (name args &rest body)
  19   `(progn
  20      (eval-when-compile
  21        (%compile-defun ',name))
  22      (fsetq ,name (lambda ,args ,@body))))
  23
  24 (defun = (x y) (= x y))
  25 (defun + (x y) (+ x y))
  26 (defun - (x y) (- x y))
  27 (defun * (x y) (* x y))
  28 (defun / (x y) (/ x y))
  29 (defun 1+ (x) (+ x 1))
  30 (defun 1- (x) (- x 1))
  31 (defun zerop (x) (= x 0))
  32 (defun not (x) (if x nil t))
  33
  34 (defun truncate (x y) (floor (/ x y)))
  35
  36 (defun cons (x y ) (cons x y))
  37 (defun car (x) (car x))
  38 (defun caar (x) (car (car x)))
  39 (defun cadr (x) (car (cdr x)))
  40 (defun cdr (x) (cdr x))
  41 (defun cdar (x) (cdr (car x)))
  42 (defun cddr (x) (cdr (cdr x)))
  43
  44 (defun append (list1 list2)
  45   (if (null list1)
  46       list2
  47       (cons (car list1)
  48             (append (cdr list1) list2))))
  49
  50 (defun reverse-aux (list acc)
  51   (if (null list)
  52       acc
  53       (reverse-aux (cdr list) (cons (car list) acc))))
  54
  55 (defun reverse (list)
  56   (reverse-aux list '()))
  57
  58 (defun mapcar (func list)
  59   (if (null list)
  60       '()
  61       (cons (funcall func (car list))
  62             (mapcar func (cdr list)))))
  63
  64 (defmacro push (x place)
  65   `(setq ,place (cons ,x ,place)))
  66
  67 (defvar *package* (new))
  68
  69 (defun intern (name)
  70   (let ((s (get *package* name)))
  71     (if s
  72         s
  73         (set *package* name (make-symbol name)))))
  74
  75 (defun find-symbol (name)
  76   (get *package* name))
  77
  78
  79 (defmacro cond (&rest clausules)
  80   (if (null clausules)
  81       nil
  82       (if (eq (caar clausules) t)
  83           `(progn ,@(cdar clausules))
  84           `(if ,(caar clausules)
  85                (progn ,@(cdar clausules))
  86                (cond ,@(cdr clausules))))))
  87
  88 (defun !reduce (func list initial)
  89   (if (null list)
  90       initial
  91       (!reduce func
  92                (cdr list)
  93                (funcall func initial (car list)))))
  94
  95
  96 (defun code-char (x) x)
  97 (defun char-code (x) x)
  98 (defvar *newline* (string (code-char 10)))
  99
 100 (defun concat (&rest strs)
 101   (!reduce (lambda (s1 s2) (concat-two s1 s2))
 102            strs
 103            ""))
 104
 105 ;;; Concatenate a list of strings, with a separator
 106 (defun join (list separator)
 107   (cond
 108     ((null list)
 109      "")
 110     ((null (cdr list))
 111      (car list))
 112     (t
 113      (concat (car list)
 114              separator
 115              (join (cdr list) separator)))))
 116
 117 (defun join-trailing (list separator)
 118   (if (null list)
 119       ""
 120       (concat (car list) separator (join-trailing (cdr list) separator))))
 121
 122 (defun integer-to-string (x)
 123   (if (zerop x)
 124       "0"
 125       (let ((digits nil))
 126         (while (not (zerop x 0))
 127           (push (mod x 10) digits)
 128           (setq x (truncate x 10)))
 129         (join (mapcar (lambda (d) (string (char "0123456789" d)))
 130                       digits)
 131               ""))))