mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-01 20:30:28 +02:00
*** empty log message ***
This commit is contained in:
Keisuke Nishida
parent
abaca96059
commit
7a0d0cee1f
8 changed files with 27 additions and 443 deletions
|
|
@ -1,247 +0,0 @@
|
||||||
;;; guile-scheme.el --- Guile Scheme editing mode.
|
|
||||||
|
|
||||||
;; Copyright (C) 2001 Keisuke Nishida <kxn30@po.cwru.edu>
|
|
||||||
|
|
||||||
;; GNU Emacs is free software; you can redistribute it and/or modify
|
|
||||||
;; it under the terms of the GNU General Public License as published by
|
|
||||||
;; the Free Software Foundation; either version 2, or (at your option)
|
|
||||||
;; any later version.
|
|
||||||
|
|
||||||
;; GNU Emacs 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 General Public License for more details.
|
|
||||||
|
|
||||||
;; You should have received a copy of the GNU General Public License
|
|
||||||
;; along with GNU Emacs; see the file COPYING. If not, write to the
|
|
||||||
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
|
||||||
;; Boston, MA 02111-1307, USA.
|
|
||||||
|
|
||||||
;;; Code:
|
|
||||||
|
|
||||||
(require 'scheme)
|
|
||||||
|
|
||||||
(defgroup guile-scheme nil
|
|
||||||
"Editing Guile-Scheme code"
|
|
||||||
:group 'lisp)
|
|
||||||
|
|
||||||
(defvar guile-scheme-syntax-keywords
|
|
||||||
'((begin 0) (if 1) (cond 0) (case 1) (do 2) (try 1)
|
|
||||||
quote syntax lambda and or else delay receive
|
|
||||||
(match 1) (match-lambda 0) (match-lambda* 0)
|
|
||||||
(let scheme-let-indent) (let* 1) (letrec 1) (and-let* 1)
|
|
||||||
(let-syntax 1) (letrec-syntax 1) (syntax-rules 1) (syntax-case 2)))
|
|
||||||
|
|
||||||
(defvar guile-scheme-special-procedures
|
|
||||||
'((catch 1) (lazy-catch 1) (stack-catch 1)
|
|
||||||
map for-each (dynamic-wind 3)))
|
|
||||||
|
|
||||||
(dolist (x (append guile-scheme-syntax-keywords
|
|
||||||
guile-scheme-special-procedures))
|
|
||||||
(when (consp x)
|
|
||||||
(put (car x) 'scheme-indent-function (cadr x))))
|
|
||||||
|
|
||||||
;; This is shared by cmuscheme and xscheme.
|
|
||||||
(defcustom guile-scheme-program-name "guile"
|
|
||||||
"*Program invoked by the `run-scheme' command."
|
|
||||||
:type 'string
|
|
||||||
:group 'guile-scheme)
|
|
||||||
|
|
||||||
(defconst guile-scheme-font-lock-keywords
|
|
||||||
(eval-when-compile
|
|
||||||
(list
|
|
||||||
(list (concat "(\\(define\\*?\\("
|
|
||||||
;; Function names.
|
|
||||||
"\\(\\|-public\\|-method\\|-generic\\)\\|"
|
|
||||||
;; Macro names, as variable names. A bit dubious, this.
|
|
||||||
"\\(-syntax\\|-macro\\)\\|"
|
|
||||||
;; Others
|
|
||||||
"-\\sw+\\)\\)\\>"
|
|
||||||
;; Any whitespace and declared object.
|
|
||||||
"\\s *(?\\(\\sw+\\)?")
|
|
||||||
'(1 font-lock-keyword-face)
|
|
||||||
'(5 (cond ((match-beginning 3) font-lock-function-name-face)
|
|
||||||
((match-beginning 4) font-lock-variable-name-face)
|
|
||||||
(t font-lock-type-face)) nil t))
|
|
||||||
(list (concat
|
|
||||||
"(" (regexp-opt
|
|
||||||
(mapcar (lambda (e)
|
|
||||||
(prin1-to-string (if (consp e) (car e) e)))
|
|
||||||
(append guile-scheme-syntax-keywords
|
|
||||||
guile-scheme-special-procedures)) 'words))
|
|
||||||
'(1 font-lock-keyword-face))
|
|
||||||
'("<\\sw+>" . font-lock-type-face)
|
|
||||||
'("\\<:\\sw+\\>" . font-lock-builtin-face)
|
|
||||||
))
|
|
||||||
"Expressions to highlight in Guile-Scheme modes.")
|
|
||||||
|
|
||||||
(defvar guile-scheme-mode-syntax-table nil)
|
|
||||||
(unless guile-scheme-mode-syntax-table
|
|
||||||
(let ((i 0))
|
|
||||||
(setq guile-scheme-mode-syntax-table (make-syntax-table))
|
|
||||||
(set-syntax-table guile-scheme-mode-syntax-table)
|
|
||||||
|
|
||||||
;; Default is atom-constituent.
|
|
||||||
(while (< i 256)
|
|
||||||
(modify-syntax-entry i "_ ")
|
|
||||||
(setq i (1+ i)))
|
|
||||||
|
|
||||||
;; Word components.
|
|
||||||
(setq i ?0)
|
|
||||||
(while (<= i ?9)
|
|
||||||
(modify-syntax-entry i "w ")
|
|
||||||
(setq i (1+ i)))
|
|
||||||
(setq i ?A)
|
|
||||||
(while (<= i ?Z)
|
|
||||||
(modify-syntax-entry i "w ")
|
|
||||||
(setq i (1+ i)))
|
|
||||||
(setq i ?a)
|
|
||||||
(while (<= i ?z)
|
|
||||||
(modify-syntax-entry i "w ")
|
|
||||||
(setq i (1+ i)))
|
|
||||||
|
|
||||||
;; Whitespace
|
|
||||||
(modify-syntax-entry ?\t " ")
|
|
||||||
(modify-syntax-entry ?\n "> ")
|
|
||||||
(modify-syntax-entry ?\f " ")
|
|
||||||
(modify-syntax-entry ?\r " ")
|
|
||||||
(modify-syntax-entry ? " ")
|
|
||||||
|
|
||||||
;; These characters are delimiters but otherwise undefined.
|
|
||||||
;; Brackets and braces balance for editing convenience.
|
|
||||||
(modify-syntax-entry ?\[ "(] ")
|
|
||||||
(modify-syntax-entry ?\] ")[ ")
|
|
||||||
(modify-syntax-entry ?{ "(} ")
|
|
||||||
(modify-syntax-entry ?} "){ ")
|
|
||||||
(modify-syntax-entry ?\| " 23")
|
|
||||||
|
|
||||||
;; Other atom delimiters
|
|
||||||
(modify-syntax-entry ?\( "() ")
|
|
||||||
(modify-syntax-entry ?\) ")( ")
|
|
||||||
(modify-syntax-entry ?\; "< ")
|
|
||||||
(modify-syntax-entry ?\" "\" ")
|
|
||||||
(modify-syntax-entry ?' " p")
|
|
||||||
(modify-syntax-entry ?` " p")
|
|
||||||
(modify-syntax-entry ?. " p")
|
|
||||||
|
|
||||||
;; Special characters
|
|
||||||
(modify-syntax-entry ?, "_ p")
|
|
||||||
(modify-syntax-entry ?# "_ p14")
|
|
||||||
(modify-syntax-entry ?\\ "\\ ")))
|
|
||||||
|
|
||||||
(defvar guile-scheme-mode-line-process "")
|
|
||||||
|
|
||||||
(defvar guile-scheme-mode-map nil
|
|
||||||
"Keymap for Guile Scheme mode.
|
|
||||||
All commands in `lisp-mode-shared-map' are inherited by this map.")
|
|
||||||
|
|
||||||
(unless guile-scheme-mode-map
|
|
||||||
(let ((map (make-sparse-keymap "Guile-Scheme")))
|
|
||||||
(setq guile-scheme-mode-map (make-sparse-keymap))
|
|
||||||
(set-keymap-parent guile-scheme-mode-map lisp-mode-shared-map)
|
|
||||||
(define-key guile-scheme-mode-map [menu-bar] (make-sparse-keymap))
|
|
||||||
(define-key guile-scheme-mode-map [menu-bar guile-scheme]
|
|
||||||
(cons "Guile Scheme" map))
|
|
||||||
(define-key map [run-guile-scheme]
|
|
||||||
'("Run Inferior Guile-Scheme" . run-guile-scheme))
|
|
||||||
(define-key map [uncomment-region]
|
|
||||||
'("Uncomment Out Region" . (lambda (beg end)
|
|
||||||
(interactive "r")
|
|
||||||
(comment-region beg end '(4)))))
|
|
||||||
(define-key map [comment-region] '("Comment Out Region" . comment-region))
|
|
||||||
(define-key map [indent-region] '("Indent Region" . indent-region))
|
|
||||||
(define-key map [indent-line] '("Indent Line" . lisp-indent-line))
|
|
||||||
(put 'comment-region 'menu-enable 'mark-active)
|
|
||||||
(put 'uncomment-region 'menu-enable 'mark-active)
|
|
||||||
(put 'indent-region 'menu-enable 'mark-active)))
|
|
||||||
|
|
||||||
(defcustom guile-scheme-mode-hook nil
|
|
||||||
"Normal hook run when entering `guile-scheme-mode'.
|
|
||||||
See `run-hooks'."
|
|
||||||
:type 'hook
|
|
||||||
:group 'guile-scheme)
|
|
||||||
|
|
||||||
|
|
||||||
;;;
|
|
||||||
;;; Guile Scheme mode
|
|
||||||
;;;
|
|
||||||
|
|
||||||
;;;###autoload
|
|
||||||
(defun guile-scheme-mode ()
|
|
||||||
"Major mode for editing Guile-Scheme code.
|
|
||||||
Editing commands are similar to those of `lisp-mode'.
|
|
||||||
|
|
||||||
In addition, if an inferior Scheme process is running, some additional
|
|
||||||
commands will be defined, for evaluating expressions and controlling
|
|
||||||
the interpreter, and the state of the process will be displayed in the
|
|
||||||
modeline of all Scheme buffers. The names of commands that interact
|
|
||||||
with the Scheme process start with \"xscheme-\" if you use the MIT
|
|
||||||
Scheme-specific `xscheme' package; for more information see the
|
|
||||||
documentation for `xscheme-interaction-mode'. Use \\[run-scheme] to
|
|
||||||
start an inferior Scheme using the more general `cmuscheme' package.
|
|
||||||
|
|
||||||
Commands:
|
|
||||||
Delete converts tabs to spaces as it moves back.
|
|
||||||
Blank lines separate paragraphs. Semicolons start comments.
|
|
||||||
\\{scheme-mode-map}
|
|
||||||
Entry to this mode calls the value of `scheme-mode-hook'
|
|
||||||
if that value is non-nil."
|
|
||||||
(interactive)
|
|
||||||
(kill-all-local-variables)
|
|
||||||
(setq mode-name "Guile Scheme")
|
|
||||||
(setq major-mode 'guile-scheme-mode)
|
|
||||||
(use-local-map guile-scheme-mode-map)
|
|
||||||
(guile-scheme-mode-variables)
|
|
||||||
(run-hooks 'guile-scheme-mode-hook))
|
|
||||||
|
|
||||||
(defun guile-scheme-mode-variables ()
|
|
||||||
(set-syntax-table guile-scheme-mode-syntax-table)
|
|
||||||
(setq local-abbrev-table scheme-mode-abbrev-table)
|
|
||||||
(make-local-variable 'paragraph-start)
|
|
||||||
(setq paragraph-start (concat "$\\|" page-delimiter))
|
|
||||||
(make-local-variable 'paragraph-separate)
|
|
||||||
(setq paragraph-separate paragraph-start)
|
|
||||||
(make-local-variable 'paragraph-ignore-fill-prefix)
|
|
||||||
(setq paragraph-ignore-fill-prefix t)
|
|
||||||
(make-local-variable 'fill-paragraph-function)
|
|
||||||
(setq fill-paragraph-function 'lisp-fill-paragraph)
|
|
||||||
;; Adaptive fill mode gets in the way of auto-fill,
|
|
||||||
;; and should make no difference for explicit fill
|
|
||||||
;; because lisp-fill-paragraph should do the job.
|
|
||||||
(make-local-variable 'adaptive-fill-mode)
|
|
||||||
(setq adaptive-fill-mode nil)
|
|
||||||
(make-local-variable 'normal-auto-fill-function)
|
|
||||||
(setq normal-auto-fill-function 'lisp-mode-auto-fill)
|
|
||||||
(make-local-variable 'indent-line-function)
|
|
||||||
(setq indent-line-function 'lisp-indent-line)
|
|
||||||
(make-local-variable 'parse-sexp-ignore-comments)
|
|
||||||
(setq parse-sexp-ignore-comments t)
|
|
||||||
(make-local-variable 'outline-regexp)
|
|
||||||
(setq outline-regexp ";;; \\|(....")
|
|
||||||
(make-local-variable 'comment-start)
|
|
||||||
(setq comment-start ";")
|
|
||||||
(make-local-variable 'comment-start-skip)
|
|
||||||
;; Look within the line for a ; following an even number of backslashes
|
|
||||||
;; after either a non-backslash or the line beginning.
|
|
||||||
(setq comment-start-skip "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\);+[ \t]*")
|
|
||||||
(make-local-variable 'comment-column)
|
|
||||||
(setq comment-column 40)
|
|
||||||
(make-local-variable 'comment-indent-function)
|
|
||||||
(setq comment-indent-function 'lisp-comment-indent)
|
|
||||||
(make-local-variable 'parse-sexp-ignore-comments)
|
|
||||||
(setq parse-sexp-ignore-comments t)
|
|
||||||
(make-local-variable 'lisp-indent-function)
|
|
||||||
(set lisp-indent-function 'scheme-indent-function)
|
|
||||||
(setq mode-line-process '("" guile-scheme-mode-line-process))
|
|
||||||
(set (make-local-variable 'imenu-case-fold-search) t)
|
|
||||||
(set (make-local-variable 'imenu-syntax-alist)
|
|
||||||
'(("+-*/.<>=?!$%_&~^:" . "w")))
|
|
||||||
(make-local-variable 'font-lock-defaults)
|
|
||||||
(setq font-lock-defaults
|
|
||||||
'((guile-scheme-font-lock-keywords)
|
|
||||||
nil t (("+-*/.<>=!?$%_&~^:@" . "w")) beginning-of-defun
|
|
||||||
(font-lock-mark-block-function . mark-defun))))
|
|
||||||
|
|
||||||
(provide 'guile-scheme)
|
|
||||||
|
|
||||||
;;; guile-scheme.el ends here
|
|
||||||
110
emacs/guile.el
110
emacs/guile.el
|
|
@ -1,110 +0,0 @@
|
||||||
;;; guile.el --- Emacs Guile interface
|
|
||||||
|
|
||||||
;; Copyright (C) 2001 Keisuke Nishida <kxn30@po.cwru.edu>
|
|
||||||
|
|
||||||
;; GNU Emacs is free software; you can redistribute it and/or modify
|
|
||||||
;; it under the terms of the GNU General Public License as published by
|
|
||||||
;; the Free Software Foundation; either version 2, or (at your option)
|
|
||||||
;; any later version.
|
|
||||||
|
|
||||||
;; GNU Emacs 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 General Public License for more details.
|
|
||||||
|
|
||||||
;; You should have received a copy of the GNU General Public License
|
|
||||||
;; along with GNU Emacs; see the file COPYING. If not, write to the
|
|
||||||
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
|
||||||
;; Boston, MA 02111-1307, USA.
|
|
||||||
|
|
||||||
;;; Code:
|
|
||||||
|
|
||||||
(defun guile:make-adapter (command)
|
|
||||||
(let* ((buff (generate-new-buffer " *guile object channel*"))
|
|
||||||
(proc (start-process "guile-oa" buff command "-q")))
|
|
||||||
(process-kill-without-query proc)
|
|
||||||
(process-send-string proc "(use-modules (guile channel))\n")
|
|
||||||
(process-send-string proc "(open-object-channel)\n")
|
|
||||||
(accept-process-output proc)
|
|
||||||
proc))
|
|
||||||
|
|
||||||
(defun guile:eval (exp adapter)
|
|
||||||
(let ((str (format "eval %S\n" exp)))
|
|
||||||
(guile-process-require adapter str "channel> " 'guile:eval-filter)))
|
|
||||||
|
|
||||||
(defun guile:eval-filter (proc)
|
|
||||||
(cond
|
|
||||||
((looking-at "value = ")
|
|
||||||
(car (read-from-string (buffer-substring (match-end 0) (point-max)))))
|
|
||||||
((looking-at "token = ")
|
|
||||||
(caar (read-from-string (buffer-substring (match-end 0) (point-max)))))
|
|
||||||
((looking-at "exception = ")
|
|
||||||
(apply 'signal (car (read-from-string
|
|
||||||
(buffer-substring (match-end 0) (point-max))))))
|
|
||||||
(t
|
|
||||||
(error "Unsupported result"))))
|
|
||||||
|
|
||||||
;;;
|
|
||||||
;;; Process handling
|
|
||||||
;;;
|
|
||||||
|
|
||||||
(defvar guile-process-output-start nil)
|
|
||||||
(defvar guile-process-output-value nil)
|
|
||||||
(defvar guile-process-output-filter nil)
|
|
||||||
(defvar guile-process-output-finished nil)
|
|
||||||
(defvar guile-process-output-separator nil)
|
|
||||||
(defvar guile-process-output-separator-lines 2)
|
|
||||||
|
|
||||||
(defun guile-process-require (process string separator &optional filter)
|
|
||||||
(setq guile-process-output-value nil)
|
|
||||||
(setq guile-process-output-filter filter)
|
|
||||||
(setq guile-process-output-finished nil)
|
|
||||||
(setq guile-process-output-separator separator)
|
|
||||||
(let (temp-buffer)
|
|
||||||
(unless (process-buffer process)
|
|
||||||
(setq temp-buffer (guile-temp-buffer))
|
|
||||||
(set-process-buffer process temp-buffer))
|
|
||||||
(with-current-buffer (process-buffer process)
|
|
||||||
(goto-char (point-max))
|
|
||||||
(insert string)
|
|
||||||
(setq guile-process-output-start (point))
|
|
||||||
(set-process-filter process 'guile-process-filter)
|
|
||||||
(process-send-string process string)
|
|
||||||
(while (not guile-process-output-finished)
|
|
||||||
(unless (accept-process-output process 5)
|
|
||||||
(when (> (point) guile-process-output-start)
|
|
||||||
(display-buffer (current-buffer))
|
|
||||||
(error "BUG in the filter!!")))))
|
|
||||||
(when temp-buffer
|
|
||||||
(set-process-buffer process nil)
|
|
||||||
(kill-buffer temp-buffer)))
|
|
||||||
guile-process-output-value)
|
|
||||||
|
|
||||||
(defun guile-process-filter (process string)
|
|
||||||
(with-current-buffer (process-buffer process)
|
|
||||||
(insert string)
|
|
||||||
(forward-line (- guile-process-output-separator-lines))
|
|
||||||
(if (< (point) guile-process-output-start)
|
|
||||||
(goto-char guile-process-output-start))
|
|
||||||
(when (re-search-forward guile-process-output-separator nil 0)
|
|
||||||
(goto-char (match-beginning 0))
|
|
||||||
(if guile-process-output-filter
|
|
||||||
(save-current-buffer
|
|
||||||
(narrow-to-region guile-process-output-start (point))
|
|
||||||
(goto-char (point-min))
|
|
||||||
(setq guile-process-output-value
|
|
||||||
(funcall guile-process-output-filter process))
|
|
||||||
(widen))
|
|
||||||
(setq guile-process-output-value
|
|
||||||
(buffer-substring guile-process-output-start (point))))
|
|
||||||
(setq guile-process-output-finished t))))
|
|
||||||
|
|
||||||
(defun guile-process-kill (process)
|
|
||||||
(set-process-filter process nil)
|
|
||||||
(delete-process process)
|
|
||||||
(if (process-buffer process)
|
|
||||||
(kill-buffer (process-buffer process))))
|
|
||||||
|
|
||||||
(provide 'guile)
|
|
||||||
|
|
||||||
;;; guile.el ends here
|
|
||||||
|
|
@ -1,79 +0,0 @@
|
||||||
;;; Guile object channel
|
|
||||||
|
|
||||||
;; Copyright (C) 2001 Free Software Foundation, Inc.
|
|
||||||
|
|
||||||
;; This program is free software; you can redistribute it and/or modify
|
|
||||||
;; it under the terms of the GNU General Public License as published by
|
|
||||||
;; the Free Software Foundation; either version 2, or (at your option)
|
|
||||||
;; any later version.
|
|
||||||
;;
|
|
||||||
;; This program 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 General Public License for more details.
|
|
||||||
;;
|
|
||||||
;; You should have received a copy of the GNU General Public License
|
|
||||||
;; along with this program; see the file COPYING. If not, write to
|
|
||||||
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
|
||||||
;; Boston, MA 02111-1307, USA.
|
|
||||||
|
|
||||||
;;; Code:
|
|
||||||
|
|
||||||
(define-module (guile channel)
|
|
||||||
:use-syntax (system base syntax)
|
|
||||||
:export (open-object-channel))
|
|
||||||
|
|
||||||
(define-record (<channel> (stdin (current-input-port))
|
|
||||||
(stdout (current-output-port))
|
|
||||||
(token-module (make-module))))
|
|
||||||
|
|
||||||
(define (make-channel) (<channel>))
|
|
||||||
|
|
||||||
(define (native-type? x)
|
|
||||||
(or (boolean? x) (integer? x) (null? x) (symbol? x) (string? x)
|
|
||||||
(pair? x) (vector? x)))
|
|
||||||
|
|
||||||
(define (open-object-channel)
|
|
||||||
(let ((ch (make-channel)))
|
|
||||||
(let loop ()
|
|
||||||
(catch #t
|
|
||||||
(lambda ()
|
|
||||||
(channel:prompt ch)
|
|
||||||
(let ((cmd (read ch.stdin)))
|
|
||||||
(if (eof-object? cmd)
|
|
||||||
(throw 'quit)
|
|
||||||
(case cmd
|
|
||||||
((eval)
|
|
||||||
(module-use! (current-module) ch.token-module)
|
|
||||||
(let ((val (eval (read ch.stdin) (current-module))))
|
|
||||||
(if (native-type? val)
|
|
||||||
(format ch.stdout "value = ~S\n" val)
|
|
||||||
(let* ((token (gensym "%object-token%"))
|
|
||||||
(pair (cons token (object->string val))))
|
|
||||||
(format ch.stdout "token = ~S\n" pair)
|
|
||||||
(module-define! ch.token-module token val)))))
|
|
||||||
((destroy)
|
|
||||||
(let ((token (read ch.stdin)))
|
|
||||||
(if (module-defined? ch.token-module token)
|
|
||||||
(module-remove! ch.token-module token)
|
|
||||||
(channel:error ch "Invalid token: ~S" token))))
|
|
||||||
((quit)
|
|
||||||
(throw 'quit))
|
|
||||||
(else
|
|
||||||
(channel:error ch "Unknown command: ~S" cmd)))))
|
|
||||||
(loop))
|
|
||||||
(lambda args
|
|
||||||
(case (car args)
|
|
||||||
((quit) (throw 'quit))
|
|
||||||
(else
|
|
||||||
(format ch.stdout "exception = ~S\n" args)
|
|
||||||
(loop))))))))
|
|
||||||
|
|
||||||
(define (channel:prompt ch)
|
|
||||||
(display "channel> " ch.stdout)
|
|
||||||
(force-output ch.stdout))
|
|
||||||
|
|
||||||
(define (channel:error ch msg . args)
|
|
||||||
(display "ERROR: " ch.stdout)
|
|
||||||
(apply format ch.stdout msg args)
|
|
||||||
(newline ch.stdout))
|
|
||||||
|
|
@ -89,6 +89,9 @@
|
||||||
(let ((m (string-match "\\.[^.]*$" file)))
|
(let ((m (string-match "\\.[^.]*$" file)))
|
||||||
(string-append (if m (match:prefix m) file) ".go")))
|
(string-append (if m (match:prefix m) file) ".go")))
|
||||||
|
|
||||||
|
(define-public (scheme-eval x e)
|
||||||
|
(vm-load (the-vm) (compile-in x e scheme)))
|
||||||
|
|
||||||
|
|
||||||
;;;
|
;;;
|
||||||
;;; Scheme compiler interface
|
;;; Scheme compiler interface
|
||||||
|
|
|
||||||
9
src/vm.c
9
src/vm.c
|
|
@ -395,6 +395,15 @@ SCM_DEFINE (scm_vm_next_hook, "vm-next-hook", 1, 0, 0,
|
||||||
}
|
}
|
||||||
#undef FUNC_NAME
|
#undef FUNC_NAME
|
||||||
|
|
||||||
|
SCM_DEFINE (scm_vm_break_hook, "vm-break-hook", 1, 0, 0,
|
||||||
|
(SCM vm),
|
||||||
|
"")
|
||||||
|
#define FUNC_NAME s_scm_vm_break_hook
|
||||||
|
{
|
||||||
|
VM_DEFINE_HOOK (SCM_VM_BREAK_HOOK);
|
||||||
|
}
|
||||||
|
#undef FUNC_NAME
|
||||||
|
|
||||||
SCM_DEFINE (scm_vm_enter_hook, "vm-enter-hook", 1, 0, 0,
|
SCM_DEFINE (scm_vm_enter_hook, "vm-enter-hook", 1, 0, 0,
|
||||||
(SCM vm),
|
(SCM vm),
|
||||||
"")
|
"")
|
||||||
|
|
|
||||||
15
src/vm.h
15
src/vm.h
|
|
@ -4,12 +4,12 @@
|
||||||
* it under the terms of the GNU General Public License as published by
|
* it under the terms of the GNU General Public License as published by
|
||||||
* the Free Software Foundation; either version 2, or (at your option)
|
* the Free Software Foundation; either version 2, or (at your option)
|
||||||
* any later version.
|
* any later version.
|
||||||
*
|
*
|
||||||
* This program is distributed in the hope that it will be useful,
|
* This program is distributed in the hope that it will be useful,
|
||||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
* GNU General Public License for more details.
|
* GNU General Public License for more details.
|
||||||
*
|
*
|
||||||
* You should have received a copy of the GNU General Public License
|
* You should have received a copy of the GNU General Public License
|
||||||
* along with this software; see the file COPYING. If not, write to
|
* along with this software; see the file COPYING. If not, write to
|
||||||
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||||
|
|
@ -48,11 +48,12 @@
|
||||||
#define SCM_VM_BOOT_HOOK 0
|
#define SCM_VM_BOOT_HOOK 0
|
||||||
#define SCM_VM_HALT_HOOK 1
|
#define SCM_VM_HALT_HOOK 1
|
||||||
#define SCM_VM_NEXT_HOOK 2
|
#define SCM_VM_NEXT_HOOK 2
|
||||||
#define SCM_VM_ENTER_HOOK 3
|
#define SCM_VM_BREAK_HOOK 3
|
||||||
#define SCM_VM_APPLY_HOOK 4
|
#define SCM_VM_ENTER_HOOK 4
|
||||||
#define SCM_VM_EXIT_HOOK 5
|
#define SCM_VM_APPLY_HOOK 5
|
||||||
#define SCM_VM_RETURN_HOOK 6
|
#define SCM_VM_EXIT_HOOK 6
|
||||||
#define SCM_VM_NUM_HOOKS 7
|
#define SCM_VM_RETURN_HOOK 7
|
||||||
|
#define SCM_VM_NUM_HOOKS 8
|
||||||
|
|
||||||
struct scm_vm {
|
struct scm_vm {
|
||||||
scm_byte_t *ip; /* instruction pointer */
|
scm_byte_t *ip; /* instruction pointer */
|
||||||
|
|
|
||||||
|
|
@ -183,6 +183,7 @@
|
||||||
#define BOOT_HOOK() RUN_HOOK (SCM_VM_BOOT_HOOK)
|
#define BOOT_HOOK() RUN_HOOK (SCM_VM_BOOT_HOOK)
|
||||||
#define HALT_HOOK() RUN_HOOK (SCM_VM_HALT_HOOK)
|
#define HALT_HOOK() RUN_HOOK (SCM_VM_HALT_HOOK)
|
||||||
#define NEXT_HOOK() RUN_HOOK (SCM_VM_NEXT_HOOK)
|
#define NEXT_HOOK() RUN_HOOK (SCM_VM_NEXT_HOOK)
|
||||||
|
#define BREAK_HOOK() RUN_HOOK (SCM_VM_BREAK_HOOK)
|
||||||
#define ENTER_HOOK() RUN_HOOK (SCM_VM_ENTER_HOOK)
|
#define ENTER_HOOK() RUN_HOOK (SCM_VM_ENTER_HOOK)
|
||||||
#define APPLY_HOOK() RUN_HOOK (SCM_VM_APPLY_HOOK)
|
#define APPLY_HOOK() RUN_HOOK (SCM_VM_APPLY_HOOK)
|
||||||
#define EXIT_HOOK() RUN_HOOK (SCM_VM_EXIT_HOOK)
|
#define EXIT_HOOK() RUN_HOOK (SCM_VM_EXIT_HOOK)
|
||||||
|
|
|
||||||
|
|
@ -63,6 +63,12 @@ VM_DEFINE_INSTRUCTION (halt, "halt", 0, 0, 0)
|
||||||
return ret;
|
return ret;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
VM_DEFINE_INSTRUCTION (break, "break", 0, 0, 0)
|
||||||
|
{
|
||||||
|
BREAK_HOOK ();
|
||||||
|
NEXT;
|
||||||
|
}
|
||||||
|
|
||||||
VM_DEFINE_INSTRUCTION (drop, "drop", 0, 0, 0)
|
VM_DEFINE_INSTRUCTION (drop, "drop", 0, 0, 0)
|
||||||
{
|
{
|
||||||
DROP ();
|
DROP ();
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue