module/language/elisp/runtime/function-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 function-slot)
  23   #:use-module (language elisp runtime))
  24
  25 ; This module contains the function-slots of elisp symbols.  Elisp built-in
  26 ; functions are implemented as predefined function bindings here.
  27
  28
  29 ; Equivalence and equalness predicates.
  30
  31 (built-in-func eq (lambda (a b)
  32                     (elisp-bool (eq? a b))))
  33
  34 (built-in-func equal (lambda (a b)
  35                        (elisp-bool (equal? a b))))
  36
  37
  38 ; Number predicates.
  39
  40 (built-in-func floatp (lambda (num)
  41                         (elisp-bool (and (real? num)
  42                                          (or (inexact? num)
  43                                              (prim not (integer? num)))))))
  44
  45 (built-in-func integerp (lambda (num)
  46                           (elisp-bool (and (exact? num)
  47                                            (integer? num)))))
  48
  49 (built-in-func numberp (lambda (num)
  50                          (elisp-bool (real? num))))
  51
  52 (built-in-func wholenump (lambda (num)
  53                            (elisp-bool (and (exact? num)
  54                                             (integer? num)
  55                                             (prim >= num 0)))))
  56
  57 (built-in-func zerop (lambda (num)
  58                        (elisp-bool (prim = num 0))))
  59
  60
  61 ; Number comparisons.
  62
  63 (built-in-func = (lambda (num1 num2)
  64                    (elisp-bool (prim = num1 num2))))
  65 (built-in-func /= (lambda (num1 num2)
  66                     (elisp-bool (prim not (prim = num1 num2)))))
  67
  68 (built-in-func < (lambda (num1 num2)
  69                    (elisp-bool (prim < num1 num2))))
  70 (built-in-func <= (lambda (num1 num2)
  71                     (elisp-bool (prim <= num1 num2))))
  72 (built-in-func > (lambda (num1 num2)
  73                    (elisp-bool (prim > num1 num2))))
  74 (built-in-func >= (lambda (num1 num2)
  75                     (elisp-bool (prim >= num1 num2))))
  76
  77 (built-in-func max (lambda (. nums)
  78                      (prim apply (@ (guile) max) nums)))
  79 (built-in-func min (lambda (. nums)
  80                      (prim apply (@ (guile) min) nums)))
  81
  82 (built-in-func abs (@ (guile) abs))
  83
  84
  85 ; Number conversion.
  86
  87 (built-in-func float (lambda (num)
  88                        (if (exact? num)
  89                          (exact->inexact num)
  90                          num)))
  91
  92 ; TODO: truncate, floor, ceiling, round.
  93
  94
  95 ; Arithmetic functions.
  96
  97 (built-in-func 1+ (@ (guile) 1+))
  98 (built-in-func 1- (@ (guile) 1-))
  99 (built-in-func + (@ (guile) +))
 100 (built-in-func - (@ (guile) -))
 101 (built-in-func * (@ (guile) *))
 102 (built-in-func % (@ (guile) modulo))
 103
 104 ; TODO: / with correct integer/real behaviour, mod (for floating-piont values).
 105
 106
 107 ; Floating-point rounding operations.
 108
 109 (built-in-func ffloor (@ (guile) floor))
 110 (built-in-func fceiling (@ (guile) ceiling))
 111 (built-in-func ftruncate (@ (guile) truncate))
 112 (built-in-func fround (@ (guile) round))
 113
 114
 115 ; List predicates.
 116
 117 (built-in-func consp
 118   (lambda (el)
 119     (elisp-bool (pair? el))))
 120 (built-in-func atomp
 121   (lambda (el)
 122     (elisp-bool (prim not (pair? el)))))
 123
 124 (built-in-func listp
 125   (lambda (el)
 126     (elisp-bool (or (pair? el) (null? el)))))
 127 (built-in-func nlistp
 128   (lambda (el)
 129     (elisp-bool (and (prim not (pair? el))
 130                      (prim not (null? el))))))
 131
 132 (built-in-func null
 133   (lambda (el)
 134     (elisp-bool (null? el))))
 135
 136
 137 ; Accessing list elements.
 138
 139 (built-in-func car
 140   (lambda (el)
 141     (if (null? el)
 142       nil-value
 143       (prim car el))))
 144 (built-in-func cdr
 145   (lambda (el)
 146     (if (null? el)
 147       nil-value
 148       (prim cdr el))))
 149
 150 (built-in-func car-safe
 151   (lambda (el)
 152     (if (pair? el)
 153       (prim car el)
 154       nil-value)))
 155 (built-in-func cdr-safe
 156   (lambda (el)
 157     (if (pair? el)
 158       (prim cdr el)
 159       nil-value)))
 160
 161 (built-in-func nth
 162   (lambda (n lst)
 163     (if (negative? n)
 164       (prim car lst)
 165       (let iterate ((i n)
 166                     (tail lst))
 167         (cond
 168           ((null? tail) nil-value)
 169           ((zero? i) (prim car tail))
 170           (else (iterate (prim 1- i) (prim cdr tail))))))))
 171 (built-in-func nthcdr
 172   (lambda (n lst)
 173     (if (negative? n)
 174       lst
 175       (let iterate ((i n)
 176                     (tail lst))
 177         (cond
 178           ((null? tail) nil-value)
 179           ((zero? i) tail)
 180           (else (iterate (prim 1- i) (prim cdr tail))))))))
 181
 182
 183 ; Building lists.
 184
 185 (built-in-func cons (@ (guile) cons))
 186 (built-in-func list (@ (guile) list))
 187 (built-in-func make-list
 188   (lambda (len obj)
 189     (prim make-list len obj)))
 190
 191 (built-in-func append (@ (guile) append))
 192 (built-in-func reverse (@ (guile) reverse))
 193 (built-in-func copy-tree (@ (guile) copy-tree))
 194
 195 (built-in-func number-sequence
 196   (lambda (from . rest)
 197     (if (prim > (prim length rest) 2)
 198       (runtime-error "too many arguments for number-sequence"
 199                      (prim cdddr rest))
 200       (if (null? rest)
 201         `(,from)
 202         (let ((to (prim car rest))
 203               (sep (if (or (null? (prim cdr rest))
 204                            (eq? nil-value (prim cadr rest)))
 205                      1
 206                      (prim cadr rest))))
 207           (cond
 208             ((or (eq? nil-value to) (prim = to from)) `(,from))
 209             ((and (zero? sep) (prim not (prim = from to)))
 210              (runtime-error "infinite list in number-sequence"))
 211             ((prim < (prim * to sep) (prim * from sep)) '())
 212             (else
 213               (let iterate ((i (prim +
 214                                   from
 215                                   (prim * sep
 216                                           (prim quotient
 217                                             (prim abs (prim - to from))
 218                                             (prim abs sep)))))
 219                             (result '()))
 220                 (if (prim = i from)
 221                   (prim cons i result)
 222                   (iterate (prim - i sep) (prim cons i result)))))))))))
 223
 224
 225 ; Changing lists.
 226
 227 (built-in-func setcar
 228   (lambda (cell val)
 229     (prim set-car! cell val)
 230     val))
 231
 232 (built-in-func setcdr
 233   (lambda (cell val)
 234     (prim set-cdr! cell val)
 235     val))
 236
 237
 238 ; Miscellaneous.
 239
 240 (built-in-func not (lambda (x)
 241                      (if x nil-value t-value)))