module/language/elisp/runtime.scm

   1 ;;; Guile Emacs Lisp
   2
   3 ;;; Copyright (C) 2009, 2010 Free Software Foundation, Inc.
   4 ;;;
   5 ;;; This library is free software; you can redistribute it and/or
   6 ;;; modify it under the terms of the GNU Lesser General Public
   7 ;;; License as published by the Free Software Foundation; either
   8 ;;; version 3 of the License, or (at your option) any later version.
   9 ;;;
  10 ;;; This library is distributed in the hope that it will be useful,
  11 ;;; but 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 02110-1301 USA
  18
  19 ;;; Code:
  20
  21 (define-module (language elisp runtime)
  22   #:export (void
  23             nil-value
  24             t-value
  25             value-slot-module
  26             function-slot-module
  27             elisp-bool
  28             ensure-fluid!
  29             reference-variable
  30             reference-variable-with-check
  31             set-variable!
  32             runtime-error
  33             macro-error)
  34   #:export-syntax (built-in-func built-in-macro defspecial prim))
  35
  36 ;;; This module provides runtime support for the Elisp front-end.
  37
  38 ;;; The reserved value to mean (when eq?) void.
  39
  40 (define void (list 42))
  41
  42 ;;; Values for t and nil. (FIXME remove this abstraction)
  43
  44 (define nil-value #nil)
  45
  46 (define t-value #t)
  47
  48 ;;; Modules for the binding slots.
  49 ;;; Note: Naming those value-slot and/or function-slot clashes with the
  50 ;;; submodules of these names!
  51
  52 (define value-slot-module '(language elisp runtime value-slot))
  53
  54 (define function-slot-module '(language elisp runtime function-slot))
  55
  56 ;;; Report an error during macro compilation, that means some special
  57 ;;; compilation (syntax) error; or report a simple runtime-error from a
  58 ;;; built-in function.
  59
  60 (define (macro-error msg . args)
  61   (apply error msg args))
  62
  63 (define runtime-error macro-error)
  64
  65 ;;; Convert a scheme boolean to Elisp.
  66
  67 (define (elisp-bool b)
  68   (if b
  69       t-value
  70       nil-value))
  71
  72 ;;; Routines for access to elisp dynamically bound symbols.  This is
  73 ;;; used for runtime access using functions like symbol-value or set,
  74 ;;; where the symbol accessed might not be known at compile-time.  These
  75 ;;; always access the dynamic binding and can not be used for the
  76 ;;; lexical!
  77
  78 (define (ensure-fluid! module sym)
  79   (let ((intf (resolve-interface module))
  80         (resolved (resolve-module module)))
  81     (if (not (module-defined? intf sym))
  82         (let ((fluid (make-fluid)))
  83           (fluid-set! fluid void)
  84           (module-define! resolved sym fluid)
  85           (module-export! resolved `(,sym))))))
  86
  87 (define (reference-variable module sym)
  88   (ensure-fluid! module sym)
  89   (let ((resolved (resolve-module module)))
  90     (fluid-ref (module-ref resolved sym))))
  91
  92 (define (reference-variable-with-check module sym)
  93   (let ((value (reference-variable module sym)))
  94     (if (eq? value void)
  95         (runtime-error "variable is void:" sym)
  96         value)))
  97
  98 (define (set-variable! module sym value)
  99   (ensure-fluid! module sym)
 100   (let ((resolved (resolve-module module)))
 101     (fluid-set! (module-ref resolved sym) value)
 102     value))
 103
 104 ;;; Define a predefined function or predefined macro for use in the
 105 ;;; function-slot and macro-slot modules, respectively.
 106
 107 (define-syntax built-in-func
 108   (syntax-rules ()
 109     ((_ name value)
 110      (begin
 111        (define-public name (make-fluid))
 112        (fluid-set! name value)))))
 113
 114 (define (make-id template-id . data)
 115   (let ((append-symbols
 116          (lambda (symbols)
 117            (string->symbol
 118             (apply string-append (map symbol->string symbols))))))
 119     (datum->syntax template-id
 120                    (append-symbols
 121                     (map (lambda (datum)
 122                            ((if (identifier? datum)
 123                                 syntax->datum
 124                                 identity)
 125                             datum))
 126                          data)))))
 127
 128 (define-syntax built-in-macro
 129   (lambda (x)
 130     (syntax-case x ()
 131       ((_ name value)
 132        (with-syntax ((scheme-name (make-id #'name 'macro- #'name)))
 133         #'(begin
 134             (define-public scheme-name (make-fluid))
 135             (fluid-set! scheme-name (cons 'macro value))))))))
 136
 137 (define-syntax defspecial
 138   (lambda (x)
 139     (syntax-case x ()
 140       ((_ name args body ...)
 141        (with-syntax ((scheme-name (make-id #'name 'compile- #'name)))
 142          #'(begin
 143              (define scheme-name (make-fluid))
 144              (fluid-set! scheme-name
 145                          (cons 'special-operator
 146                                (lambda args body ...)))))))))
 147
 148 ;;; Call a guile-primitive that may be rebound for elisp and thus needs
 149 ;;; absolute addressing.
 150
 151 (define-syntax prim
 152   (syntax-rules ()
 153     ((_ sym args ...)
 154      ((@ (guile) sym) args ...))))