module/language/elisp/runtime/macro-slot.scm

   1 ;;; Guile Emac Lisp
   2
   3 ;; Copyright (C) 2001 Free Software Foundation, Inc.
   4
   5 ;; This program is free software; you can redistribute it and/or modify
   6 ;; it under the terms of the GNU General Public License as published by
   7 ;; the Free Software Foundation; either version 2, or (at your option)
   8 ;; any later version.
   9 ;;
  10 ;; This program is distributed in the hope that it will be useful,
  11 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13 ;; GNU General Public License for more details.
  14 ;;
  15 ;; You should have received a copy of the GNU General Public License
  16 ;; along with this program; see the file COPYING.  If not, write to
  17 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  18 ;; Boston, MA 02111-1307, USA.
  19
  20 ;;; Code:
  21
  22 (define-module (language elisp runtime macro-slot)
  23   #:use-module (language elisp runtime))
  24
  25 ; This module contains the macro definitions of elisp symbols.  In contrast to
  26 ; the other runtime modules, those are used directly during compilation, of
  27 ; course, so not really in runtime.  But I think it fits well to the others
  28 ; here.
  29
  30
  31 ; The prog1 and prog2 constructs can easily be defined as macros using progn
  32 ; and some lexical-let's to save the intermediate value to return at the end.
  33
  34 (built-in-macro prog1
  35   (lambda (form1 . rest)
  36     (let ((temp (gensym)))
  37       `(without-void-checks (,temp)
  38          (lexical-let ((,temp ,form1))
  39            ,@rest
  40            ,temp)))))
  41
  42 (built-in-macro prog2
  43   (lambda (form1 form2 . rest)
  44     `(progn ,form1 (prog1 ,form2 ,@rest))))
  45
  46
  47 ; Define the conditionals when and unless as macros.
  48
  49 (built-in-macro when
  50   (lambda (condition . thens)
  51     `(if ,condition (progn ,@thens) nil)))
  52
  53 (built-in-macro unless
  54   (lambda (condition . elses)
  55     `(if ,condition nil (progn ,@elses))))
  56
  57
  58 ; Impement the cond form as nested if's.  A special case is a (condition)
  59 ; subform, in which case we need to return the condition itself if it is true
  60 ; and thus save it in a local variable before testing it.
  61
  62 (built-in-macro cond
  63   (lambda (. clauses)
  64     (let iterate ((tail clauses))
  65       (if (null? tail)
  66         'nil
  67         (let ((cur (car tail))
  68               (rest (iterate (cdr tail))))
  69           (prim cond
  70             ((prim or (not (list? cur)) (null? cur))
  71              (macro-error "invalid clause in cond" cur))
  72             ((null? (cdr cur))
  73              (let ((var (gensym)))
  74                `(without-void-checks (,var)
  75                   (lexical-let ((,var ,(car cur)))
  76                     (if ,var
  77                       ,var
  78                       ,rest)))))
  79             (else
  80               `(if ,(car cur)
  81                  (progn ,@(cdr cur))
  82                  ,rest))))))))
  83
  84
  85 ; The and and or forms can also be easily defined with macros.
  86
  87 (built-in-macro and
  88   (lambda (. args)
  89     (if (null? args)
  90       't
  91       (let iterate ((tail args))
  92         (if (null? (cdr tail))
  93           (car tail)
  94           `(if ,(car tail)
  95              ,(iterate (cdr tail))
  96              nil))))))
  97
  98 (built-in-macro or
  99   (lambda (. args)
 100     (let iterate ((tail args))
 101       (if (null? tail)
 102         'nil
 103         (let ((var (gensym)))
 104           `(without-void-checks (,var)
 105              (lexical-let ((,var ,(car tail)))
 106                (if ,var
 107                  ,var
 108                  ,(iterate (cdr tail))))))))))
 109
 110
 111 ; Define the dotimes and dolist iteration macros.
 112
 113 (built-in-macro dotimes
 114   (lambda (args . body)
 115     (if (prim or (not (list? args))
 116                  (< (length args) 2)
 117                  (> (length args) 3))
 118       (macro-error "invalid dotimes arguments" args)
 119       (let ((var (car args))
 120             (count (cadr args)))
 121         (if (not (symbol? var))
 122           (macro-error "expected symbol as dotimes variable"))
 123         `(let ((,var 0))
 124            (while (< ,var ,count)
 125              ,@body
 126              (setq ,var (1+ ,var)))
 127            ,@(if (= (length args) 3)
 128                (list (caddr args))
 129                '()))))))
 130
 131 (built-in-macro dolist
 132   (lambda (args . body)
 133     (if (prim or (not (list? args))
 134                  (< (length args) 2)
 135                  (> (length args) 3))
 136       (macro-error "invalid dolist arguments" args)
 137       (let ((var (car args))
 138             (iter-list (cadr args))
 139             (tailvar (gensym)))
 140         (if (not (symbol? var))
 141           (macro-error "expected symbol as dolist variable")
 142           `(let (,var)
 143              (without-void-checks (,tailvar)
 144                (lexical-let ((,tailvar ,iter-list))
 145                  (while (not (null ,tailvar))
 146                    (setq ,var (car ,tailvar))
 147                    ,@body
 148                    (setq ,tailvar (cdr ,tailvar)))
 149                  ,@(if (= (length args) 3)
 150                      (list (caddr args))
 151                      '())))))))))
 152
 153
 154 ; Pop off the first element from a list or push one to it.
 155
 156 (built-in-macro pop
 157   (lambda (list-name)
 158     `(prog1 (car ,list-name)
 159             (setq ,list-name (cdr ,list-name)))))
 160
 161 (built-in-macro push
 162   (lambda (new-el list-name)
 163     `(setq ,list-name (cons ,new-el ,list-name))))