module/language/elisp/runtime/subrs.scm

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