FM / elisp

/usr/share/guile/3.0/language/elisp

Name	Size	Mode	Actions
runtime/	-	0755	rm
bindings.scm	3969	0644	edit dl rm
boot.el	17094	0644	edit dl rm
compile-tree-il.scm	28867	0644	edit dl rm
falias.scm	1543	0644	edit dl rm
lexer.scm	17696	0644	edit dl rm
parser.scm	8519	0644	edit dl rm
runtime.scm	5282	0644	edit dl rm
spec.scm	1762	0644	edit dl rm

Edit: /usr/share/guile/3.0/language/elisp/runtime.scm (5282B)

;;; Guile Emacs Lisp

;;; Copyright (C) 2009, 2010, 2011 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)
  #:export (nil-value
            t-value
            value-slot-module
            function-slot-module
            elisp-bool
            ensure-fluid!
            symbol-fluid
            set-symbol-fluid!
            symbol-value
            set-symbol-value!
            symbol-function
            set-symbol-function!
            symbol-bound?
            symbol-fbound?
            makunbound!
            fmakunbound!)
  #:export-syntax (defspecial prim))

;;; This module provides runtime support for the Elisp front-end.

;;; Values for t and nil. (FIXME remove this abstraction)

(define nil-value #nil)

(define t-value #t)

;;; Modules for the binding slots.
;;; Note: Naming those value-slot and/or function-slot clashes with the
;;; submodules of these names!

(define value-slot-module '(language elisp runtime value-slot))

(define function-slot-module '(language elisp runtime function-slot))

;;; Routines for access to elisp dynamically bound symbols.  This is
;;; used for runtime access using functions like symbol-value or set,
;;; where the symbol accessed might not be known at compile-time.  These
;;; always access the dynamic binding and can not be used for the
;;; lexical!

(define (ensure-fluid! module sym)
  (let ((intf (resolve-interface module))
        (resolved (resolve-module module)))
    (if (not (module-defined? intf sym))
        (let ((fluid (make-unbound-fluid)))
          (module-define! resolved sym fluid)
          (module-export! resolved `(,sym))))))

(define (symbol-fluid symbol)
  (let ((module (resolve-module value-slot-module)))
    (ensure-fluid! value-slot-module symbol) ;++ implicit special proclamation
    (module-ref module symbol)))

(define (set-symbol-fluid! symbol fluid)
  (let ((module (resolve-module value-slot-module)))
    (module-define! module symbol fluid)
    (module-export! module (list symbol)))
  fluid)

(define (symbol-value symbol)
  (fluid-ref (symbol-fluid symbol)))

(define (set-symbol-value! symbol value)
  (fluid-set! (symbol-fluid symbol) value)
  value)

(define (symbol-function symbol)
  (let ((module (resolve-module function-slot-module)))
    (module-ref module symbol)))

(define (set-symbol-function! symbol value)
  (let ((module (resolve-module function-slot-module)))
   (module-define! module symbol value)
   (module-export! module (list symbol)))
  value)

(define (symbol-bound? symbol)
  (and
   (module-bound? (resolve-interface value-slot-module) symbol)
   (let ((var (module-variable (resolve-module value-slot-module)
                               symbol)))
     (and (variable-bound? var)
          (if (fluid? (variable-ref var))
              (fluid-bound? (variable-ref var))
              #t)))))

(define (symbol-fbound? symbol)
  (and
   (module-bound? (resolve-interface function-slot-module) symbol)
   (variable-bound?
    (module-variable (resolve-module function-slot-module)
                     symbol))))

(define (makunbound! symbol)
  (if (module-bound? (resolve-interface value-slot-module) symbol)
      (let ((var (module-variable (resolve-module value-slot-module)
                                  symbol)))
        (if (and (variable-bound? var) (fluid? (variable-ref var)))
            (fluid-unset! (variable-ref var))
            (variable-unset! var))))
    symbol)

(define (fmakunbound! symbol)
  (if (module-bound? (resolve-interface function-slot-module) symbol)
      (variable-unset! (module-variable
                        (resolve-module function-slot-module)
                        symbol)))
  symbol)

;;; Define a predefined macro for use in the function-slot module.

(define (make-id template-id . data)
  (let ((append-symbols
         (lambda (symbols)
           (string->symbol
            (apply string-append (map symbol->string symbols))))))
    (datum->syntax template-id
                   (append-symbols
                    (map (lambda (datum)
                           ((if (identifier? datum)
                                syntax->datum
                                identity)
                            datum))
                         data)))))

(define-syntax defspecial
  (lambda (x)
    (syntax-case x ()
      ((_ name args body ...)
       (with-syntax ((scheme-name (make-id #'name 'compile- #'name)))
         #'(define scheme-name
             (cons 'special-operator (lambda args body ...))))))))

cmd: