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

   1 ;;; Guile Emacs Lisp
   2
   3 ;;; Copyright (C) 2009, 2010 Free Software Foundation, Inc.
   4 ;;;
   5 ;;; This library is free software; you can redistribute it and/or
   6 ;;; modify it under the terms of the GNU Lesser General Public
   7 ;;; License as published by the Free Software Foundation; either
   8 ;;; version 3 of the License, or (at your option) any later version.
   9 ;;;
  10 ;;; This library 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 GNU
  13 ;;; Lesser General Public License for more details.
  14 ;;;
  15 ;;; You should have received a copy of the GNU Lesser General Public
  16 ;;; License along with this library; if not, write to the Free Software
  17 ;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
  18
  19 ;;; Code:
  20
  21 (define-module (language elisp runtime function-slot)
  22   #:use-module (language elisp runtime)
  23   #:use-module (system base compile))
  24
  25 ;;; This module contains the function-slots of elisp symbols.  Elisp
  26 ;;; built-in functions are implemented as predefined function bindings
  27 ;;; here.
  28
  29 ;;; Equivalence and equalness predicates.
  30
  31 (built-in-func eq
  32   (lambda (a b)
  33     (elisp-bool (eq? a b))))
  34
  35 (built-in-func equal
  36   (lambda (a b)
  37     (elisp-bool (equal? a b))))
  38
  39 ;;; Number predicates.
  40
  41 (built-in-func floatp
  42   (lambda (num)
  43     (elisp-bool (and (real? num)
  44                      (or (inexact? num)
  45                          (prim not (integer? num)))))))
  46
  47 (built-in-func integerp
  48   (lambda (num)
  49     (elisp-bool (and (exact? num)
  50                      (integer? num)))))
  51
  52 (built-in-func numberp
  53   (lambda (num)
  54     (elisp-bool (real? num))))
  55
  56 (built-in-func wholenump
  57   (lambda (num)
  58     (elisp-bool (and (exact? num)
  59                      (integer? num)
  60                      (prim >= num 0)))))
  61
  62 (built-in-func zerop
  63   (lambda (num)
  64     (elisp-bool (prim = num 0))))
  65
  66 ;;; Number comparisons.
  67
  68 (built-in-func =
  69   (lambda (num1 num2)
  70     (elisp-bool (prim = num1 num2))))
  71
  72 (built-in-func /=
  73   (lambda (num1 num2)
  74     (elisp-bool (prim not (prim = num1 num2)))))
  75
  76 (built-in-func <
  77   (lambda (num1 num2)
  78     (elisp-bool (prim < num1 num2))))
  79
  80 (built-in-func <=
  81   (lambda (num1 num2)
  82     (elisp-bool (prim <= num1 num2))))
  83
  84 (built-in-func >
  85   (lambda (num1 num2)
  86     (elisp-bool (prim > num1 num2))))
  87
  88 (built-in-func >=
  89   (lambda (num1 num2)
  90     (elisp-bool (prim >= num1 num2))))
  91
  92 (built-in-func max
  93   (lambda (. nums)
  94     (prim apply (@ (guile) max) nums)))
  95
  96 (built-in-func min
  97   (lambda (. nums)
  98     (prim apply (@ (guile) min) nums)))
  99
 100 (built-in-func abs
 101   (@ (guile) abs))
 102
 103 ;;; Number conversion.
 104
 105 (built-in-func float
 106   (lambda (num)
 107     (if (exact? num)
 108         (exact->inexact num)
 109         num)))
 110
 111 ;;; TODO: truncate, floor, ceiling, round.
 112
 113 ;;; Arithmetic functions.
 114
 115 (built-in-func 1+ (@ (guile) 1+))
 116
 117 (built-in-func 1- (@ (guile) 1-))
 118
 119 (built-in-func + (@ (guile) +))
 120
 121 (built-in-func - (@ (guile) -))
 122
 123 (built-in-func * (@ (guile) *))
 124
 125 (built-in-func % (@ (guile) modulo))
 126
 127 ;;; TODO: / with correct integer/real behaviour, mod (for floating-piont
 128 ;;; values).
 129
 130 ;;; Floating-point rounding operations.
 131
 132 (built-in-func ffloor (@ (guile) floor))
 133
 134 (built-in-func fceiling (@ (guile) ceiling))
 135
 136 (built-in-func ftruncate (@ (guile) truncate))
 137
 138 (built-in-func fround (@ (guile) round))
 139
 140 ;;; List predicates.
 141
 142 (built-in-func consp
 143   (lambda (el)
 144     (elisp-bool (pair? el))))
 145
 146 (built-in-func atomp
 147   (lambda (el)
 148     (elisp-bool (prim not (pair? el)))))
 149
 150 (built-in-func listp
 151   (lambda (el)
 152     (elisp-bool (or (pair? el) (null? el)))))
 153
 154 (built-in-func nlistp
 155   (lambda (el)
 156     (elisp-bool (and (prim not (pair? el))
 157                      (prim not (null? el))))))
 158
 159 (built-in-func null
 160   (lambda (el)
 161     (elisp-bool (null? el))))
 162
 163 ;;; Accessing list elements.
 164
 165 (built-in-func car
 166   (lambda (el)
 167     (if (null? el)
 168         nil-value
 169         (prim car el))))
 170
 171 (built-in-func cdr
 172   (lambda (el)
 173     (if (null? el)
 174         nil-value
 175         (prim cdr el))))
 176
 177 (built-in-func car-safe
 178   (lambda (el)
 179     (if (pair? el)
 180         (prim car el)
 181         nil-value)))
 182
 183 (built-in-func cdr-safe
 184   (lambda (el)
 185     (if (pair? el)
 186         (prim cdr el)
 187         nil-value)))
 188
 189 (built-in-func nth
 190   (lambda (n lst)
 191     (if (negative? n)
 192         (prim car lst)
 193         (let iterate ((i n)
 194                       (tail lst))
 195           (cond
 196            ((null? tail) nil-value)
 197            ((zero? i) (prim car tail))
 198            (else (iterate (prim 1- i) (prim cdr tail))))))))
 199
 200 (built-in-func nthcdr
 201   (lambda (n lst)
 202     (if (negative? n)
 203         lst
 204         (let iterate ((i n)
 205                       (tail lst))
 206           (cond
 207            ((null? tail) nil-value)
 208            ((zero? i) tail)
 209            (else (iterate (prim 1- i) (prim cdr tail))))))))
 210
 211 (built-in-func length (@ (guile) length))
 212
 213 ;;; Building lists.
 214
 215 (built-in-func cons (@ (guile) cons))
 216
 217 (built-in-func list (@ (guile) list))
 218
 219 (built-in-func make-list
 220   (lambda (len obj)
 221     (prim make-list len obj)))
 222
 223 (built-in-func append (@ (guile) append))
 224
 225 (built-in-func reverse (@ (guile) reverse))
 226
 227 (built-in-func copy-tree (@ (guile) copy-tree))
 228
 229 (built-in-func number-sequence
 230   (lambda (from . rest)
 231     (if (prim > (prim length rest) 2)
 232         (runtime-error "too many arguments for number-sequence"
 233                        (prim cdddr rest))
 234         (if (null? rest)
 235             `(,from)
 236             (let ((to (prim car rest))
 237                   (sep (if (or (null? (prim cdr rest))
 238                                (eq? nil-value (prim cadr rest)))
 239                            1
 240                            (prim cadr rest))))
 241               (cond
 242                ((or (eq? nil-value to) (prim = to from)) `(,from))
 243                ((and (zero? sep) (prim not (prim = from to)))
 244                 (runtime-error "infinite list in number-sequence"))
 245                ((prim < (prim * to sep) (prim * from sep)) '())
 246                (else
 247                 (let iterate ((i (prim +
 248                                        from
 249                                        (prim *
 250                                              sep
 251                                              (prim quotient
 252                                                    (prim abs
 253                                                          (prim -
 254                                                                to
 255                                                                from))
 256                                                    (prim abs sep)))))
 257                               (result '()))
 258                   (if (prim = i from)
 259                       (prim cons i result)
 260                       (iterate (prim - i sep)
 261                                (prim cons i result)))))))))))
 262
 263 ;;; Changing lists.
 264
 265 (built-in-func setcar
 266   (lambda (cell val)
 267     (prim set-car! cell val)
 268     val))
 269
 270 (built-in-func setcdr
 271   (lambda (cell val)
 272     (prim set-cdr! cell val)
 273     val))
 274
 275 ;;; Accessing symbol bindings for symbols known only at runtime.
 276
 277 (built-in-func symbol-value
 278   (lambda (sym)
 279     (reference-variable-with-check value-slot-module sym)))
 280
 281 (built-in-func symbol-function
 282   (lambda (sym)
 283     (reference-variable-with-check function-slot-module sym)))
 284
 285 (built-in-func set
 286   (lambda (sym value)
 287     (set-variable! value-slot-module sym value)))
 288
 289 (built-in-func fset
 290   (lambda (sym value)
 291     (set-variable! function-slot-module sym value)))
 292
 293 (built-in-func makunbound
 294   (lambda (sym)
 295     (set-variable! value-slot-module sym void)
 296     sym))
 297
 298 (built-in-func fmakunbound
 299   (lambda (sym)
 300     (set-variable! function-slot-module sym void)
 301     sym))
 302
 303 (built-in-func boundp
 304   (lambda (sym)
 305     (elisp-bool (prim not
 306                       (eq? void
 307                            (reference-variable value-slot-module
 308                                                sym))))))
 309
 310 (built-in-func fboundp
 311   (lambda (sym)
 312     (elisp-bool (prim not
 313                       (eq? void
 314                            (reference-variable function-slot-module
 315                                                sym))))))
 316
 317 ;;; Function calls. These must take care of special cases, like using
 318 ;;; symbols or raw lambda-lists as functions!
 319
 320 (built-in-func apply
 321   (lambda (func . args)
 322     (let ((real-func (cond
 323                       ((symbol? func)
 324                        (reference-variable-with-check
 325                         function-slot-module
 326                         func))
 327                       ((list? func)
 328                        (if (and (prim not (null? func))
 329                                 (eq? (prim car func) 'lambda))
 330                            (compile func #:from 'elisp #:to 'value)
 331                            (runtime-error "list is not a function"
 332                                           func)))
 333                       (else func))))
 334       (prim apply (@ (guile) apply) real-func args))))
 335
 336 (built-in-func funcall
 337   (let ((myapply (fluid-ref apply)))
 338     (lambda (func . args)
 339       (myapply func args))))
 340
 341 ;;; Throw can be implemented as built-in function.
 342
 343 (built-in-func throw
 344   (lambda (tag value)
 345     (prim throw 'elisp-exception tag value)))
 346
 347 ;;; Miscellaneous.
 348
 349 (built-in-func not
 350   (lambda (x)
 351     (if x nil-value t-value)))
 352
 353 (built-in-func eval
 354   (lambda (form)
 355     (compile form #:from 'elisp #:to 'value)))