mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-16 18:50:23 +02:00
store macro definitions in the function slot
Guile Emacs Lisp previously kept macros in a separate macro slot; now macros are stored as macro objects in the function slot for compatibility with other implementations. * module/language/elisp/compile-tree-il.scm (macro-slot): Remove. (is-macro?): Check that the argument is a symbol. Now-unnecessary check removed in `compile-tree-il'. (macro?, define-macro!, get-macro): Store macro definitions in the function slot, not in a separate macro slot. * module/language/elisp/runtime.scm (built-in-macro): Wrap the macro function in a macro object (i.e., cons the symbol `macro' onto it). * module/language/elisp/runtime/function-slot.scm: Move contents to "subrs.scm". Re-export function and macro definitions instead of defining functions directly in this module. * module/language/elisp/runtime/macro-slot.scm: Move contents to "macros.scm" and remove. * module/language/elisp/runtime/macros.scm: New file containing macro definitions from "macro-slot.scm". * module/language/elisp/runtime/subrs.scm: New file containing function definitions from "function-slot.scm".
This commit is contained in:
Brian Templeton
parent
88698140c0
commit
c55a2ddc1b
5 changed files with 451 additions and 352 deletions
|
|
@ -1,6 +1,6 @@
|
|||
;;; Guile Emacs Lisp
|
||||
|
||||
;;; Copyright (C) 2009 Free Software Foundation, Inc.
|
||||
;;; Copyright (C) 2010 Free Software Foundation, Inc.
|
||||
;;;
|
||||
;;; This library is free software; you can redistribute it and/or modify
|
||||
;;; it under the terms of the GNU Lesser General Public License as
|
||||
|
|
@ -17,340 +17,83 @@
|
|||
;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
|
||||
;;; 02110-1301 USA
|
||||
|
||||
;;; Code:
|
||||
|
||||
(define-module (language elisp runtime function-slot)
|
||||
#:use-module (language elisp runtime)
|
||||
#:use-module (system base compile))
|
||||
|
||||
;;; This module contains the function-slots of elisp symbols. Elisp
|
||||
;;; built-in functions are implemented as predefined function bindings
|
||||
;;; here.
|
||||
|
||||
;;; Equivalence and equalness predicates.
|
||||
|
||||
(built-in-func eq
|
||||
(lambda (a b)
|
||||
(elisp-bool (eq? a b))))
|
||||
|
||||
(built-in-func equal
|
||||
(lambda (a b)
|
||||
(elisp-bool (equal? a b))))
|
||||
|
||||
;;; Number predicates.
|
||||
|
||||
(built-in-func floatp
|
||||
(lambda (num)
|
||||
(elisp-bool (and (real? num)
|
||||
(or (inexact? num)
|
||||
(prim not (integer? num)))))))
|
||||
|
||||
(built-in-func integerp
|
||||
(lambda (num)
|
||||
(elisp-bool (and (exact? num)
|
||||
(integer? num)))))
|
||||
|
||||
(built-in-func numberp
|
||||
(lambda (num)
|
||||
(elisp-bool (real? num))))
|
||||
|
||||
(built-in-func wholenump
|
||||
(lambda (num)
|
||||
(elisp-bool (and (exact? num)
|
||||
(integer? num)
|
||||
(prim >= num 0)))))
|
||||
|
||||
(built-in-func zerop
|
||||
(lambda (num)
|
||||
(elisp-bool (prim = num 0))))
|
||||
|
||||
;;; Number comparisons.
|
||||
|
||||
(built-in-func =
|
||||
(lambda (num1 num2)
|
||||
(elisp-bool (prim = num1 num2))))
|
||||
|
||||
(built-in-func /=
|
||||
(lambda (num1 num2)
|
||||
(elisp-bool (prim not (prim = num1 num2)))))
|
||||
|
||||
(built-in-func <
|
||||
(lambda (num1 num2)
|
||||
(elisp-bool (prim < num1 num2))))
|
||||
|
||||
(built-in-func <=
|
||||
(lambda (num1 num2)
|
||||
(elisp-bool (prim <= num1 num2))))
|
||||
|
||||
(built-in-func >
|
||||
(lambda (num1 num2)
|
||||
(elisp-bool (prim > num1 num2))))
|
||||
|
||||
(built-in-func >=
|
||||
(lambda (num1 num2)
|
||||
(elisp-bool (prim >= num1 num2))))
|
||||
|
||||
(built-in-func max
|
||||
(lambda (. nums)
|
||||
(prim apply (@ (guile) max) nums)))
|
||||
|
||||
(built-in-func min
|
||||
(lambda (. nums)
|
||||
(prim apply (@ (guile) min) nums)))
|
||||
|
||||
(built-in-func abs
|
||||
(@ (guile) abs))
|
||||
|
||||
;;; Number conversion.
|
||||
|
||||
(built-in-func float
|
||||
(lambda (num)
|
||||
(if (exact? num)
|
||||
(exact->inexact num)
|
||||
num)))
|
||||
|
||||
;;; TODO: truncate, floor, ceiling, round.
|
||||
|
||||
;;; Arithmetic functions.
|
||||
|
||||
(built-in-func 1+ (@ (guile) 1+))
|
||||
|
||||
(built-in-func 1- (@ (guile) 1-))
|
||||
|
||||
(built-in-func + (@ (guile) +))
|
||||
|
||||
(built-in-func - (@ (guile) -))
|
||||
|
||||
(built-in-func * (@ (guile) *))
|
||||
|
||||
(built-in-func % (@ (guile) modulo))
|
||||
|
||||
;;; TODO: / with correct integer/real behaviour, mod (for floating-piont
|
||||
;;; values).
|
||||
|
||||
;;; Floating-point rounding operations.
|
||||
|
||||
(built-in-func ffloor (@ (guile) floor))
|
||||
|
||||
(built-in-func fceiling (@ (guile) ceiling))
|
||||
|
||||
(built-in-func ftruncate (@ (guile) truncate))
|
||||
|
||||
(built-in-func fround (@ (guile) round))
|
||||
|
||||
;;; List predicates.
|
||||
|
||||
(built-in-func consp
|
||||
(lambda (el)
|
||||
(elisp-bool (pair? el))))
|
||||
|
||||
(built-in-func atomp
|
||||
(lambda (el)
|
||||
(elisp-bool (prim not (pair? el)))))
|
||||
|
||||
(built-in-func listp
|
||||
(lambda (el)
|
||||
(elisp-bool (or (pair? el) (null? el)))))
|
||||
|
||||
(built-in-func nlistp
|
||||
(lambda (el)
|
||||
(elisp-bool (and (prim not (pair? el))
|
||||
(prim not (null? el))))))
|
||||
|
||||
(built-in-func null
|
||||
(lambda (el)
|
||||
(elisp-bool (null? el))))
|
||||
|
||||
;;; Accessing list elements.
|
||||
|
||||
(built-in-func car
|
||||
(lambda (el)
|
||||
(if (null? el)
|
||||
nil-value
|
||||
(prim car el))))
|
||||
|
||||
(built-in-func cdr
|
||||
(lambda (el)
|
||||
(if (null? el)
|
||||
nil-value
|
||||
(prim cdr el))))
|
||||
|
||||
(built-in-func car-safe
|
||||
(lambda (el)
|
||||
(if (pair? el)
|
||||
(prim car el)
|
||||
nil-value)))
|
||||
|
||||
(built-in-func cdr-safe
|
||||
(lambda (el)
|
||||
(if (pair? el)
|
||||
(prim cdr el)
|
||||
nil-value)))
|
||||
|
||||
(built-in-func nth
|
||||
(lambda (n lst)
|
||||
(if (negative? n)
|
||||
(prim car lst)
|
||||
(let iterate ((i n)
|
||||
(tail lst))
|
||||
(cond
|
||||
((null? tail) nil-value)
|
||||
((zero? i) (prim car tail))
|
||||
(else (iterate (prim 1- i) (prim cdr tail))))))))
|
||||
|
||||
(built-in-func nthcdr
|
||||
(lambda (n lst)
|
||||
(if (negative? n)
|
||||
lst
|
||||
(let iterate ((i n)
|
||||
(tail lst))
|
||||
(cond
|
||||
((null? tail) nil-value)
|
||||
((zero? i) tail)
|
||||
(else (iterate (prim 1- i) (prim cdr tail))))))))
|
||||
|
||||
(built-in-func length (@ (guile) length))
|
||||
|
||||
;;; Building lists.
|
||||
|
||||
(built-in-func cons (@ (guile) cons))
|
||||
|
||||
(built-in-func list (@ (guile) list))
|
||||
|
||||
(built-in-func make-list
|
||||
(lambda (len obj)
|
||||
(prim make-list len obj)))
|
||||
|
||||
(built-in-func append (@ (guile) append))
|
||||
|
||||
(built-in-func reverse (@ (guile) reverse))
|
||||
|
||||
(built-in-func copy-tree (@ (guile) copy-tree))
|
||||
|
||||
(built-in-func number-sequence
|
||||
(lambda (from . rest)
|
||||
(if (prim > (prim length rest) 2)
|
||||
(runtime-error "too many arguments for number-sequence"
|
||||
(prim cdddr rest))
|
||||
(if (null? rest)
|
||||
`(,from)
|
||||
(let ((to (prim car rest))
|
||||
(sep (if (or (null? (prim cdr rest))
|
||||
(eq? nil-value (prim cadr rest)))
|
||||
1
|
||||
(prim cadr rest))))
|
||||
(cond
|
||||
((or (eq? nil-value to) (prim = to from)) `(,from))
|
||||
((and (zero? sep) (prim not (prim = from to)))
|
||||
(runtime-error "infinite list in number-sequence"))
|
||||
((prim < (prim * to sep) (prim * from sep)) '())
|
||||
(else
|
||||
(let iterate ((i (prim +
|
||||
from
|
||||
(prim *
|
||||
sep
|
||||
(prim quotient
|
||||
(prim abs
|
||||
(prim -
|
||||
to
|
||||
from))
|
||||
(prim abs sep)))))
|
||||
(result '()))
|
||||
(if (prim = i from)
|
||||
(prim cons i result)
|
||||
(iterate (prim - i sep)
|
||||
(prim cons i result)))))))))))
|
||||
|
||||
;;; Changing lists.
|
||||
|
||||
(built-in-func setcar
|
||||
(lambda (cell val)
|
||||
(prim set-car! cell val)
|
||||
val))
|
||||
|
||||
(built-in-func setcdr
|
||||
(lambda (cell val)
|
||||
(prim set-cdr! cell val)
|
||||
val))
|
||||
|
||||
;;; Accessing symbol bindings for symbols known only at runtime.
|
||||
|
||||
(built-in-func symbol-value
|
||||
(lambda (sym)
|
||||
(reference-variable-with-check value-slot-module sym)))
|
||||
|
||||
(built-in-func symbol-function
|
||||
(lambda (sym)
|
||||
(reference-variable-with-check function-slot-module sym)))
|
||||
|
||||
(built-in-func set
|
||||
(lambda (sym value)
|
||||
(set-variable! value-slot-module sym value)))
|
||||
|
||||
(built-in-func fset
|
||||
(lambda (sym value)
|
||||
(set-variable! function-slot-module sym value)))
|
||||
|
||||
(built-in-func makunbound
|
||||
(lambda (sym)
|
||||
(set-variable! value-slot-module sym void)
|
||||
sym))
|
||||
|
||||
(built-in-func fmakunbound
|
||||
(lambda (sym)
|
||||
(set-variable! function-slot-module sym void)
|
||||
sym))
|
||||
|
||||
(built-in-func boundp
|
||||
(lambda (sym)
|
||||
(elisp-bool (prim not
|
||||
(eq? void
|
||||
(reference-variable value-slot-module
|
||||
sym))))))
|
||||
|
||||
(built-in-func fboundp
|
||||
(lambda (sym)
|
||||
(elisp-bool (prim not
|
||||
(eq? void
|
||||
(reference-variable function-slot-module
|
||||
sym))))))
|
||||
|
||||
;;; Function calls. These must take care of special cases, like using
|
||||
;;; symbols or raw lambda-lists as functions!
|
||||
|
||||
(built-in-func apply
|
||||
(lambda (func . args)
|
||||
(let ((real-func (cond
|
||||
((symbol? func)
|
||||
(reference-variable-with-check
|
||||
function-slot-module
|
||||
func))
|
||||
((list? func)
|
||||
(if (and (prim not (null? func))
|
||||
(eq? (prim car func) 'lambda))
|
||||
(compile func #:from 'elisp #:to 'value)
|
||||
(runtime-error "list is not a function"
|
||||
func)))
|
||||
(else func))))
|
||||
(prim apply (@ (guile) apply) real-func args))))
|
||||
|
||||
(built-in-func funcall
|
||||
(let ((myapply (fluid-ref apply)))
|
||||
(lambda (func . args)
|
||||
(myapply func args))))
|
||||
|
||||
;;; Throw can be implemented as built-in function.
|
||||
|
||||
(built-in-func throw
|
||||
(lambda (tag value)
|
||||
(prim throw 'elisp-exception tag value)))
|
||||
|
||||
;;; Miscellaneous.
|
||||
|
||||
(built-in-func not
|
||||
(lambda (x)
|
||||
(if x nil-value t-value)))
|
||||
|
||||
(built-in-func eval
|
||||
(lambda (form)
|
||||
(compile form #:from 'elisp #:to 'value)))
|
||||
#:use-module (language elisp runtime subrs)
|
||||
#:use-module (language elisp runtime macros)
|
||||
#:duplicates (last)
|
||||
;; functions
|
||||
#:re-export (eq
|
||||
equal
|
||||
floatp
|
||||
integerp
|
||||
numberp
|
||||
wholenump
|
||||
zerop
|
||||
=
|
||||
/=
|
||||
<
|
||||
<=
|
||||
>
|
||||
>=
|
||||
max
|
||||
min
|
||||
abs
|
||||
float
|
||||
1+
|
||||
1-
|
||||
+
|
||||
-
|
||||
*
|
||||
%
|
||||
ffloor
|
||||
fceiling
|
||||
ftruncate
|
||||
fround
|
||||
consp
|
||||
atomp
|
||||
listp
|
||||
nlistp
|
||||
null
|
||||
car
|
||||
cdr
|
||||
car-safe
|
||||
cdr-safe
|
||||
nth
|
||||
nthcdr
|
||||
length
|
||||
cons
|
||||
list
|
||||
make-list
|
||||
append
|
||||
reverse
|
||||
copy-tree
|
||||
number-sequence
|
||||
setcar
|
||||
setcdr
|
||||
symbol-value
|
||||
symbol-function
|
||||
set
|
||||
fset
|
||||
makunbound
|
||||
fmakunbound
|
||||
boundp
|
||||
fboundp
|
||||
apply
|
||||
funcall
|
||||
throw
|
||||
not
|
||||
eval)
|
||||
;; macros
|
||||
#:re-export (prog1
|
||||
prog2
|
||||
when
|
||||
unless
|
||||
cond
|
||||
and
|
||||
or
|
||||
dotimes
|
||||
dolist
|
||||
catch
|
||||
unwind-protect
|
||||
pop
|
||||
push))
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue