mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-17 03:00:21 +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
|
|
@ -69,8 +69,6 @@
|
||||||
|
|
||||||
(define runtime '(language elisp runtime))
|
(define runtime '(language elisp runtime))
|
||||||
|
|
||||||
(define macro-slot '(language elisp runtime macro-slot))
|
|
||||||
|
|
||||||
(define value-slot (@ (language elisp runtime) value-slot-module))
|
(define value-slot (@ (language elisp runtime) value-slot-module))
|
||||||
|
|
||||||
(define function-slot (@ (language elisp runtime) function-slot-module))
|
(define function-slot (@ (language elisp runtime) function-slot-module))
|
||||||
|
|
@ -543,18 +541,21 @@
|
||||||
;;; Handle macro bindings.
|
;;; Handle macro bindings.
|
||||||
|
|
||||||
(define (is-macro? sym)
|
(define (is-macro? sym)
|
||||||
(module-defined? (resolve-interface macro-slot) sym))
|
(and
|
||||||
|
(symbol? sym)
|
||||||
|
(module-defined? (resolve-interface function-slot) sym)
|
||||||
|
(let ((macro (module-ref (resolve-module function-slot) sym)))
|
||||||
|
(and (pair? macro) (eq? (car macro) 'macro)))))
|
||||||
|
|
||||||
(define (define-macro! loc sym definition)
|
(define (define-macro! loc sym definition)
|
||||||
(let ((resolved (resolve-module macro-slot)))
|
(let ((resolved (resolve-module function-slot)))
|
||||||
(if (is-macro? sym)
|
(module-define! resolved sym (cons 'macro definition))
|
||||||
(report-error loc "macro is already defined" sym)
|
(module-export! resolved (list sym))))
|
||||||
(begin
|
|
||||||
(module-define! resolved sym definition)
|
|
||||||
(module-export! resolved (list sym))))))
|
|
||||||
|
|
||||||
(define (get-macro sym)
|
(define (get-macro sym)
|
||||||
(module-ref (resolve-module macro-slot) sym))
|
(and
|
||||||
|
(is-macro? sym)
|
||||||
|
(cdr (module-ref (resolve-module function-slot) sym))))
|
||||||
|
|
||||||
;;; See if a (backquoted) expression contains any unquotes.
|
;;; See if a (backquoted) expression contains any unquotes.
|
||||||
|
|
||||||
|
|
@ -876,9 +877,8 @@
|
||||||
|
|
||||||
;; Macro calls are simply expanded and recursively compiled.
|
;; Macro calls are simply expanded and recursively compiled.
|
||||||
|
|
||||||
((,macro . ,args) (guard (and (symbol? macro) (is-macro? macro)))
|
((,macro . ,args) (guard (is-macro? macro))
|
||||||
(let ((expander (get-macro macro)))
|
(compile-expr (apply (get-macro macro) args)))
|
||||||
(compile-expr (apply expander args))))
|
|
||||||
|
|
||||||
;; Function calls using (function args) standard notation; here, we
|
;; Function calls using (function args) standard notation; here, we
|
||||||
;; have to take the function value of a symbol if it is one. It
|
;; have to take the function value of a symbol if it is one. It
|
||||||
|
|
|
||||||
|
|
@ -113,7 +113,7 @@
|
||||||
(define-syntax built-in-macro
|
(define-syntax built-in-macro
|
||||||
(syntax-rules ()
|
(syntax-rules ()
|
||||||
((_ name value)
|
((_ name value)
|
||||||
(define-public name value))))
|
(define-public name (cons 'macro value)))))
|
||||||
|
|
||||||
;;; Call a guile-primitive that may be rebound for elisp and thus needs
|
;;; Call a guile-primitive that may be rebound for elisp and thus needs
|
||||||
;;; absolute addressing.
|
;;; absolute addressing.
|
||||||
|
|
|
||||||
|
|
@ -1,6 +1,6 @@
|
||||||
;;; Guile Emacs Lisp
|
;;; 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
|
;;; This library is free software; you can redistribute it and/or modify
|
||||||
;;; it under the terms of the GNU Lesser General Public License as
|
;;; 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
|
;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
|
||||||
;;; 02110-1301 USA
|
;;; 02110-1301 USA
|
||||||
|
|
||||||
;;; Code:
|
|
||||||
|
|
||||||
(define-module (language elisp runtime function-slot)
|
(define-module (language elisp runtime function-slot)
|
||||||
#:use-module (language elisp runtime)
|
#:use-module (language elisp runtime subrs)
|
||||||
#:use-module (system base compile))
|
#:use-module (language elisp runtime macros)
|
||||||
|
#:duplicates (last)
|
||||||
;;; This module contains the function-slots of elisp symbols. Elisp
|
;; functions
|
||||||
;;; built-in functions are implemented as predefined function bindings
|
#:re-export (eq
|
||||||
;;; here.
|
equal
|
||||||
|
floatp
|
||||||
;;; Equivalence and equalness predicates.
|
integerp
|
||||||
|
numberp
|
||||||
(built-in-func eq
|
wholenump
|
||||||
(lambda (a b)
|
zerop
|
||||||
(elisp-bool (eq? a b))))
|
=
|
||||||
|
/=
|
||||||
(built-in-func equal
|
<
|
||||||
(lambda (a b)
|
<=
|
||||||
(elisp-bool (equal? a b))))
|
>
|
||||||
|
>=
|
||||||
;;; Number predicates.
|
max
|
||||||
|
min
|
||||||
(built-in-func floatp
|
abs
|
||||||
(lambda (num)
|
float
|
||||||
(elisp-bool (and (real? num)
|
1+
|
||||||
(or (inexact? num)
|
1-
|
||||||
(prim not (integer? num)))))))
|
+
|
||||||
|
-
|
||||||
(built-in-func integerp
|
*
|
||||||
(lambda (num)
|
%
|
||||||
(elisp-bool (and (exact? num)
|
ffloor
|
||||||
(integer? num)))))
|
fceiling
|
||||||
|
ftruncate
|
||||||
(built-in-func numberp
|
fround
|
||||||
(lambda (num)
|
consp
|
||||||
(elisp-bool (real? num))))
|
atomp
|
||||||
|
listp
|
||||||
(built-in-func wholenump
|
nlistp
|
||||||
(lambda (num)
|
null
|
||||||
(elisp-bool (and (exact? num)
|
car
|
||||||
(integer? num)
|
cdr
|
||||||
(prim >= num 0)))))
|
car-safe
|
||||||
|
cdr-safe
|
||||||
(built-in-func zerop
|
nth
|
||||||
(lambda (num)
|
nthcdr
|
||||||
(elisp-bool (prim = num 0))))
|
length
|
||||||
|
cons
|
||||||
;;; Number comparisons.
|
list
|
||||||
|
make-list
|
||||||
(built-in-func =
|
append
|
||||||
(lambda (num1 num2)
|
reverse
|
||||||
(elisp-bool (prim = num1 num2))))
|
copy-tree
|
||||||
|
number-sequence
|
||||||
(built-in-func /=
|
setcar
|
||||||
(lambda (num1 num2)
|
setcdr
|
||||||
(elisp-bool (prim not (prim = num1 num2)))))
|
symbol-value
|
||||||
|
symbol-function
|
||||||
(built-in-func <
|
set
|
||||||
(lambda (num1 num2)
|
fset
|
||||||
(elisp-bool (prim < num1 num2))))
|
makunbound
|
||||||
|
fmakunbound
|
||||||
(built-in-func <=
|
boundp
|
||||||
(lambda (num1 num2)
|
fboundp
|
||||||
(elisp-bool (prim <= num1 num2))))
|
apply
|
||||||
|
funcall
|
||||||
(built-in-func >
|
throw
|
||||||
(lambda (num1 num2)
|
not
|
||||||
(elisp-bool (prim > num1 num2))))
|
eval)
|
||||||
|
;; macros
|
||||||
(built-in-func >=
|
#:re-export (prog1
|
||||||
(lambda (num1 num2)
|
prog2
|
||||||
(elisp-bool (prim >= num1 num2))))
|
when
|
||||||
|
unless
|
||||||
(built-in-func max
|
cond
|
||||||
(lambda (. nums)
|
and
|
||||||
(prim apply (@ (guile) max) nums)))
|
or
|
||||||
|
dotimes
|
||||||
(built-in-func min
|
dolist
|
||||||
(lambda (. nums)
|
catch
|
||||||
(prim apply (@ (guile) min) nums)))
|
unwind-protect
|
||||||
|
pop
|
||||||
(built-in-func abs
|
push))
|
||||||
(@ (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)))
|
|
||||||
|
|
|
||||||
|
|
@ -19,7 +19,7 @@
|
||||||
|
|
||||||
;;; Code:
|
;;; Code:
|
||||||
|
|
||||||
(define-module (language elisp runtime macro-slot)
|
(define-module (language elisp runtime macros)
|
||||||
#:use-module (language elisp runtime))
|
#:use-module (language elisp runtime))
|
||||||
|
|
||||||
;;; This module contains the macro definitions of elisp symbols. In
|
;;; This module contains the macro definitions of elisp symbols. In
|
||||||
356
module/language/elisp/runtime/subrs.scm
Normal file
356
module/language/elisp/runtime/subrs.scm
Normal file
|
|
@ -0,0 +1,356 @@
|
||||||
|
;;; Guile Emacs Lisp
|
||||||
|
|
||||||
|
;;; Copyright (C) 2009 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
|
||||||
|
;;; published by the Free Software Foundation; either version 3 of the
|
||||||
|
;;; License, or (at your option) any later version.
|
||||||
|
;;;
|
||||||
|
;;; This library is distributed in the hope that it will be useful, but
|
||||||
|
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||||
|
;;; Lesser General Public License for more details.
|
||||||
|
;;;
|
||||||
|
;;; You should have received a copy of the GNU Lesser General Public
|
||||||
|
;;; License along with this library; if not, write to the Free Software
|
||||||
|
;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
|
||||||
|
;;; 02110-1301 USA
|
||||||
|
|
||||||
|
;;; Code:
|
||||||
|
|
||||||
|
(define-module (language elisp runtime subrs)
|
||||||
|
#: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)))
|
||||||
Loading…
Add table
Add a link
Reference in a new issue