;; -*- Lisp -*-
;; ---------------------------------------------------------------
;; MiniLisp - Very small lisp interpreter to demonstrate MiniExp.
;; Copyright (c) 2005  Leon Bottou
;;
;; This software is subject to, and may be distributed under, the
;; GNU General Public License, either Version 2 of the license,
;; or (at your option) any later version. The license should have
;; accompanied the software or you may obtain a copy of the license
;; from the Free Software Foundation at http://www.fsf.org .
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.
;; ---------------------------------------------------------------

;;   Executable <minilisp> loads this file on startup.
;;   It contains a few helpful minilisp functions and macros.

(defvar defun
  (mlambda((name . args) . body)
     (list 'defvar name (list 'lambda args . body)) ) )

(defvar defmacro
  (mlambda((name . args) . body)
     (list 'defvar name (list 'mlambda args . body)) ) )

(defmacro (pretty f)
  (let ((s (if (symbolp f) (list (list quote f)))))
    (list 'let
      (list (list 's (list 'funcdef f . s)))
      (list 'pprint 's 72)
      () ) ) )

(defun (copyrev l)
   (let ((r ()))
     (while l
       (setq r (cons (car l) r))
       (setq l (cdr l)) )
     r ) )

(defun (copy l)
   (reverse (copyrev l)) )

(defun (append . l)
  (setq l (copyrev l))
  (let ((r (car l)))
    (while (consp (setq l (cdr l)))
      (let ((x (copyrev (car l))))
        (while (consp x)
          (let ((y (cdr x)))
            (setq r (rplacd x r))
            (setq x y) ) ) ) )
    r ) )

(defmacro (when cond . body)
   (list 'if cond (list 'progn . body)) )

(let ((sym-to  '|S 0001|)
      (sym-res '|S 0002|) )
  (defmacro (for (v from to) . body)
    (list 'let (list (list v from)
                     (list sym-to to)
                     (list sym-res ()) )
          (list 'while (list <= v sym-to)
                (list 'setq sym-res (list 'progn . body))
                (list 'setq v (list '+ v 1)) )
          sym-res ) ) )

(let ((sym-to  '|S 0001|)
      (sym-res '|S 0002|) )
  (defmacro (mapfor (v from to) . body)
    (list 'let (list (list v from)
                     (list sym-to to)
                     (list sym-res ()) )
          (list 'while (list <= v sym-to)
                (list 'setq sym-res (list 'cons (list 'progn . body) sym-res))
                (list 'setq v (list '+ v 1)) )
          (list 'reverse sym-res) ) ) )

(defmacro (cond . args)
   (let ((a (copyrev args))
         (r ()))
     (while (consp a)
       (setq r (cons 'if (cons (caar a)
           (if (= (length (cdar a)) 1)
              (list (car (cdar a)) r)
              (list (cons 'progn (cdar a)) r) ) )))
       (setq a (cdr a)) )
     r ) )

(defmacro (not n)
  (list 'nullp n) )

(defmacro (and . args)
   (let ((r 't)
         (a (copyrev args)) )
      (while a
        (setq r (list 'if (car a) r))
        (setq a (cdr a)) )
      r ) )

(defmacro (or . args)
   (let ((r ())
         (a (copyrev args))
         (f (mlambda(x . b)
              (list 'let (list (list 's x))
                 (list 'if 's 's . b) ) )) )
     (while a
        (setq r (list f (car a) r))
        (setq a (cdr a)) )
     r ) )

(defun (mapcar f l)
  (let ((r ()))
    (while l
       (setq r (cons (f (car l)) r))
       (setq l (cdr l)) )
    (reverse r) ) )

(defun (1+ x) (+ x 1))

(defun (1- x) (- x 1))

(defun (2* x) (* x 2))

(defun (2/ x) (/ x 2))

(defun (div n d)
  (floor (/ n d)) )

(defun (mod n d)
   (- n (* d (div n d))) )

(defvar set! setq)

(defvar set-car! rplaca)

(defvar set-cdr! rplacd)

(display "MiniLisp, (C) 2005, Leon Bottou.\n"
         "Available under the GNU General Public Licence.\n\n")