mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-02 21:10:27 +02:00
97d9da9a87
* module/language/elisp/runtime/subrs.scm (throw): Rewrite in Elisp and move to... * module/language/elisp/boot.el (throw): ...here.
115 lines
3.8 KiB
Scheme
115 lines
3.8 KiB
Scheme
;;; 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)
|
|
#:export (symbol-value
|
|
symbol-function
|
|
set
|
|
fset
|
|
makunbound
|
|
fmakunbound
|
|
boundp
|
|
fboundp
|
|
apply
|
|
eval
|
|
load))
|
|
|
|
;;; Accessing symbol bindings for symbols known only at runtime.
|
|
|
|
(define (symbol-value sym)
|
|
(reference-variable value-slot-module sym))
|
|
|
|
(define (symbol-function sym)
|
|
(reference-variable function-slot-module sym))
|
|
|
|
(define (set sym value)
|
|
(set-variable! value-slot-module sym value))
|
|
|
|
(define (fset sym value)
|
|
(set-variable! function-slot-module sym value))
|
|
|
|
(define (makunbound sym)
|
|
(if (module-bound? (resolve-interface value-slot-module) sym)
|
|
(let ((var (module-variable (resolve-module value-slot-module)
|
|
sym)))
|
|
(if (and (variable-bound? var) (fluid? (variable-ref var)))
|
|
(fluid-unset! (variable-ref var))
|
|
(variable-unset! var))))
|
|
sym)
|
|
|
|
(define (fmakunbound sym)
|
|
(if (module-bound? (resolve-interface function-slot-module) sym)
|
|
(let ((var (module-variable
|
|
(resolve-module function-slot-module)
|
|
sym)))
|
|
(if (and (variable-bound? var) (fluid? (variable-ref var)))
|
|
(fluid-unset! (variable-ref var))
|
|
(variable-unset! var))))
|
|
sym)
|
|
|
|
(define (boundp sym)
|
|
(elisp-bool
|
|
(and
|
|
(module-bound? (resolve-interface value-slot-module) sym)
|
|
(let ((var (module-variable (resolve-module value-slot-module)
|
|
sym)))
|
|
(and (variable-bound? var)
|
|
(if (fluid? (variable-ref var))
|
|
(fluid-bound? (variable-ref var))
|
|
#t))))))
|
|
|
|
(define (fboundp sym)
|
|
(elisp-bool
|
|
(and
|
|
(module-bound? (resolve-interface function-slot-module) sym)
|
|
(let* ((var (module-variable (resolve-module function-slot-module)
|
|
sym)))
|
|
(and (variable-bound? var)
|
|
(if (fluid? (variable-ref var))
|
|
(fluid-bound? (variable-ref var))
|
|
#t))))))
|
|
|
|
;;; Function calls. These must take care of special cases, like using
|
|
;;; symbols or raw lambda-lists as functions!
|
|
|
|
(define (apply func . args)
|
|
(let ((real-func (cond
|
|
((symbol? func)
|
|
(reference-variable 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)))
|
|
|
|
;;; Miscellaneous.
|
|
|
|
(define (eval form)
|
|
(compile form #:from 'elisp #:to 'value))
|
|
|
|
(define (load file)
|
|
(compile-file file #:from 'elisp #:to 'value)
|
|
#t)
|