guile-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Guile-commits] GNU Guile branch, master, updated. release_1-9-11-140-gf


From: Andy Wingo
Subject: [Guile-commits] GNU Guile branch, master, updated. release_1-9-11-140-gff87b2b
Date: Tue, 22 Jun 2010 21:48:21 +0000

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

http://git.savannah.gnu.org/cgit/guile.git/commit/?id=ff87b2bd7c8a421333fa2182837388e6421df88e

The branch, master has been updated
       via  ff87b2bd7c8a421333fa2182837388e6421df88e (commit)
       via  8fba85750d512bf628520310574e658c147b6cc7 (commit)
       via  c592de96c0f24b12e3124f7c8f04245d8c9c0c11 (commit)
       via  049ec2029982d98983413365b66ecc7d95060987 (commit)
       via  6669cd81371c7449a4fd817589542bafb2f99699 (commit)
       via  1fdd5bec023500f2009782e83b053e1bf1409503 (commit)
       via  1623ca68496be7ae8d07901e5537ad308595c140 (commit)
       via  ec0f307ee9821943b77c43da48a2c101376553be (commit)
      from  ea28e981342fd1d381e489e57cddde97eb390442 (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit ff87b2bd7c8a421333fa2182837388e6421df88e
Author: Andy Wingo <address@hidden>
Date:   Tue Jun 22 23:50:27 2010 +0200

    top-repl out to its own module
    
    * module/ice-9/boot-9.scm:
    * module/ice-9/top-repl.scm: Move top-repl out here.
    
    * module/Makefile.am: Add new file.
    
    * module/ice-9/deprecated.scm (top-repl): Deprecated shim.
    
    * libguile/script.c (scm_compile_shell_switches): Invoke top-repl from
      its new location.

commit 8fba85750d512bf628520310574e658c147b6cc7
Author: Andy Wingo <address@hidden>
Date:   Tue Jun 22 23:29:43 2010 +0200

    simplify top-repl
    
    * module/ice-9/boot-9.scm (top-repl): Simplify.

commit c592de96c0f24b12e3124f7c8f04245d8c9c0c11
Author: Andy Wingo <address@hidden>
Date:   Tue Jun 22 23:16:49 2010 +0200

    don't bother catching SIGSEGV et al in top-repl
    
    * module/ice-9/boot-9.scm (exit-hook): Move up with the other hooks.
      (top-repl): Don't install handlers for SIGFPE, SIGILL, SIGSEGV, or
      SIGBUS, as they will have no effect.

commit 049ec2029982d98983413365b66ecc7d95060987
Author: Andy Wingo <address@hidden>
Date:   Tue Jun 22 22:34:23 2010 +0200

    deprecate named-module-use!, load-emacs-interface, and remove --emacs
    
    * module/ice-9/boot-9.scm:
    * module/ice-9/deprecated.scm (named-module-use!)
      (load-emacs-interface): Deprecate these.
    
    * module/ice-9/gds-client.scm (run-utility): Redefine to not use
      named-module-use!.
    
    * libguile/script.c (scm_shell_usage): Remove --emacs option.
      (scm_compile_shell_switches): Remove support for --emacs.
    
    * module/ice-9/boot-9.scm (top-repl): Don't muck with --emacs.
    
    * doc/ref/scheme-scripts.texi (Invoking Guile): Remove note about
      --emacs.

commit 6669cd81371c7449a4fd817589542bafb2f99699
Author: Andy Wingo <address@hidden>
Date:   Tue Jun 22 22:25:20 2010 +0200

    require-extension using syntax-case
    
    * module/ice-9/boot-9.scm (require-extension): Implement using
      syntax-case.

commit 1fdd5bec023500f2009782e83b053e1bf1409503
Author: Andy Wingo <address@hidden>
Date:   Tue Jun 22 22:15:50 2010 +0200

    cond-expand in syntax-case
    
    * module/ice-9/boot-9.scm: Some spacing improvements.
      (cond-expand): Reimplement in syntax-case.

commit 1623ca68496be7ae8d07901e5537ad308595c140
Author: Andy Wingo <address@hidden>
Date:   Tue Jun 22 21:47:15 2010 +0200

    more aspiration in boot-9
    
    * module/ice-9/boot-9.scm: Spacing fixes for local-ref et al.

commit ec0f307ee9821943b77c43da48a2c101376553be
Author: Andy Wingo <address@hidden>
Date:   Tue Jun 22 21:43:09 2010 +0200

    begin-deprecated using syntax-case
    
    * module/ice-9/boot-9.scm (begin-deprecated): In terms of syntax-case.

-----------------------------------------------------------------------

Summary of changes:
 doc/ref/scheme-scripts.texi |    9 +-
 libguile/script.c           |   15 +--
 module/Makefile.am          |    1 +
 module/ice-9/boot-9.scm     |  299 +++++++++++++-----------------------------
 module/ice-9/deprecated.scm |   23 +++-
 module/ice-9/gds-client.scm |    3 +-
 module/ice-9/top-repl.scm   |   72 +++++++++++
 7 files changed, 197 insertions(+), 225 deletions(-)
 create mode 100644 module/ice-9/top-repl.scm

diff --git a/doc/ref/scheme-scripts.texi b/doc/ref/scheme-scripts.texi
index f43d360..fcb22a6 100644
--- a/doc/ref/scheme-scripts.texi
+++ b/doc/ref/scheme-scripts.texi
@@ -1,6 +1,6 @@
 @c -*-texinfo-*-
 @c This is part of the GNU Guile Reference Manual.
address@hidden Copyright (C)  1996, 1997, 2000, 2001, 2002, 2003, 2004, 2005
address@hidden Copyright (C)  1996, 1997, 2000, 2001, 2002, 2003, 2004, 2005, 
2010
 @c   Free Software Foundation, Inc.
 @c See the file guile.texi for copying conditions.
 
@@ -162,13 +162,6 @@ Examples}.
 Read more command-line arguments, starting from the second line of the
 script file.  @xref{The Meta Switch}.
 
address@hidden --emacs
-Assume Guile is running as an inferior process of Emacs, and use a
-special protocol to communicate with Emacs's Guile interaction mode.
-This switch sets the global variable use-emacs-interface to @code{#t}.
-
-This switch is still experimental.
-
 @item address@hidden
 The option @code{--use-srfi} expects a comma-separated list of numbers,
 each representing a SRFI number to be loaded into the interpreter
diff --git a/libguile/script.c b/libguile/script.c
index 7b606ae..3ea425c 100644
--- a/libguile/script.c
+++ b/libguile/script.c
@@ -385,7 +385,6 @@ scm_shell_usage (int fatal, char *message)
            "                 Default is to enable autocompilation of source\n"
            "                 files.\n"
           "  -q             inhibit loading of user init file\n"
-           "  --emacs        enable Emacs protocol (experimental)\n"
           "  --use-srfi=LS  load SRFI modules for the SRFIs in LS,\n"
           "                 which is a list of numbers like \"2,13,14\"\n"
            "  -h, --help     display this help and exit\n"
@@ -407,6 +406,7 @@ SCM_SYMBOL (sym_command_line, "command-line");
 SCM_SYMBOL (sym_begin, "begin");
 SCM_SYMBOL (sym_turn_on_debugging, "turn-on-debugging");
 SCM_SYMBOL (sym_load_user_init, "load-user-init");
+SCM_SYMBOL (sym_ice_9, "ice-9");
 SCM_SYMBOL (sym_top_repl, "top-repl");
 SCM_SYMBOL (sym_quit, "quit");
 SCM_SYMBOL (sym_use_srfis, "use-srfis");
@@ -454,7 +454,6 @@ scm_compile_shell_switches (int argc, char **argv)
   SCM user_load_path = SCM_EOL; /* for -L switch */
   int interactive = 1;         /* Should we go interactive when done? */
   int inhibit_user_init = 0;   /* Don't load user init file */
-  int use_emacs_interface = 0;
   int turn_on_debugging = 0;
   int dont_turn_on_debugging = 0;
 
@@ -603,9 +602,6 @@ scm_compile_shell_switches (int argc, char **argv)
         scm_variable_set_x (scm_c_lookup ("%load-should-autocompile"),
                             SCM_BOOL_F);
 
-      else if (! strcmp (argv[i], "--emacs")) /* use emacs protocol */ 
-       use_emacs_interface = 1;
-
       else if (! strcmp (argv[i], "-q")) /* don't load user init */ 
        inhibit_user_init = 1;
 
@@ -676,9 +672,6 @@ scm_compile_shell_switches (int argc, char **argv)
      script/command/whatever.  */
   scm_set_program_arguments (argc ? argc - i : 0, argv + i, argv0);
   
-  /* If the --emacs switch was set, now is when we process it.  */
-  scm_c_define ("use-emacs-interface", scm_from_bool (use_emacs_interface));
-
   /* Handle the `-e' switch, if it was specified.  */
   if (!scm_is_null (entry_point))
     tail = scm_cons (scm_cons2 (entry_point,
@@ -689,7 +682,11 @@ scm_compile_shell_switches (int argc, char **argv)
   /* If we didn't end with a -c or a -s, start the repl.  */
   if (interactive)
     {
-      tail = scm_cons (scm_cons (sym_top_repl, SCM_EOL), tail);
+      tail = scm_cons (scm_list_1 (scm_list_3
+                                   (sym_at,
+                                    scm_list_2 (sym_ice_9, sym_top_repl),
+                                    sym_top_repl)),
+                       tail);
     }
   else
     {
diff --git a/module/Makefile.am b/module/Makefile.am
index 08367c4..6e3e064 100644
--- a/module/Makefile.am
+++ b/module/Makefile.am
@@ -219,6 +219,7 @@ ICE_9_SOURCES = \
   ice-9/string-fun.scm \
   ice-9/syncase.scm \
   ice-9/threads.scm \
+  ice-9/top-repl.scm \
   ice-9/buffered-input.scm \
   ice-9/time.scm \
   ice-9/history.scm \
diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index 3803ba2..bd5625d 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -516,13 +516,14 @@ If there is no handler at all, Guile prints an error and 
then exits."
 
 ;;; {Deprecation}
 ;;;
-;;; Depends on: defmacro
-;;;
 
-(defmacro begin-deprecated forms
-  (if (include-deprecated-features)
-      `(begin ,@forms)
-      `(begin)))
+(define-syntax begin-deprecated
+  (lambda (x)
+    (syntax-case x ()
+      ((_ form form* ...)
+       (if (include-deprecated-features)
+           #'(begin form form* ...)
+           #'(begin))))))
 
 
 
@@ -2081,12 +2082,23 @@ If there is no handler at all, Guile prints an error 
and then exits."
               (loop cur (car tail) (cdr tail)))))))
 
 
-(define (local-ref names) (nested-ref (current-module) names))
-(define (local-set! names val) (nested-set! (current-module) names val))
-(define (local-define names val) (nested-define! (current-module) names val))
-(define (local-remove names) (nested-remove! (current-module) names))
-(define (local-ref-module names) (nested-ref-module (current-module) names))
-(define (local-define-module names mod) (nested-define-module! 
(current-module) names mod))
+(define (local-ref names)
+  (nested-ref (current-module) names))
+
+(define (local-set! names val)
+  (nested-set! (current-module) names val))
+
+(define (local-define names val)
+  (nested-define! (current-module) names val))
+
+(define (local-remove names)
+  (nested-remove! (current-module) names))
+
+(define (local-ref-module names)
+  (nested-ref-module (current-module) names))
+
+(define (local-define-module names mod)
+  (nested-define-module! (current-module) names mod))
 
 
 
@@ -2672,16 +2684,19 @@ module '(ice-9 q) '(make-q q-length))}."
 ;;; {Running Repls}
 ;;;
 
+(define *repl-level* (make-fluid))
+
 ;; Programs can call `batch-mode?' to see if they are running as part of a
 ;; script or if they are running interactively. REPL implementations ensure 
that
 ;; `batch-mode?' returns #f during their extent.
 ;;
+(define (batch-mode?)
+  (negative? (or (fluid-ref *repl-level*) -1)))
+
 ;; Programs can re-enter batch mode, for example after a fork, by calling
 ;; `ensure-batch-mode!'. It's not a great interface, though; it would be better
 ;; to abort to the outermost prompt, and call a thunk there.
-(define *repl-level* (make-fluid))
-(define (batch-mode?)
-  (negative? (or (fluid-ref *repl-level*) -1)))
+;;
 (define (ensure-batch-mode!)
   (fluid-set! *repl-level* #f))
 
@@ -2706,6 +2721,10 @@ module '(ice-9 q) '(make-q q-length))}."
 (define before-print-hook (make-hook 1))
 (define after-print-hook (make-hook 1))
 
+;;; This hook is run at the very end of an interactive session.
+;;;
+(define exit-hook (make-hook))
+
 ;;; The default repl-reader function.  We may override this if we've
 ;;; the readline library.
 (define repl-reader
@@ -2784,16 +2803,16 @@ module '(ice-9 q) '(make-q q-length))}."
 ;; Return a list of expressions that evaluate to the appropriate
 ;; arguments for resolve-interface according to SPEC.
 
-(eval-when
- (compile)
- (if (memq 'prefix (read-options))
-     (error "boot-9 must be compiled with #:kw, not :kw")))
+(eval-when (compile)
+  (if (memq 'prefix (read-options))
+      (error "boot-9 must be compiled with #:kw, not :kw")))
 
 (define (keyword-like-symbol->keyword sym)
   (symbol->keyword (string->symbol (substring (symbol->string sym) 1))))
 
 ;; FIXME: we really need to clean up the guts of the module system.
 ;; We can compile to something better than process-define-module.
+;;
 (define-syntax define-module
   (lambda (x)
     (define (keyword-like? stx)
@@ -3242,66 +3261,45 @@ module '(ice-9 q) '(make-q q-length))}."
                      (append (hashq-ref %cond-expand-table mod '())
                              features)))))
 
-(define-macro (cond-expand . clauses)
-  (let ((syntax-error (lambda (cl)
-                        (error "invalid clause in `cond-expand'" cl))))
-    (letrec
-        ((test-clause
-          (lambda (clause)
-            (cond
-             ((symbol? clause)
-              (or (memq clause %cond-expand-features)
-                  (let lp ((uses (module-uses (current-module))))
-                    (if (pair? uses)
-                        (or (memq clause
-                                  (hashq-ref %cond-expand-table
-                                             (car uses) '()))
-                            (lp (cdr uses)))
-                        #f))))
-             ((pair? clause)
-              (cond
-               ((eq? 'and (car clause))
-                (let lp ((l (cdr clause)))
-                  (cond ((null? l)
-                         #t)
-                        ((pair? l)
-                         (and (test-clause (car l)) (lp (cdr l))))
-                        (else
-                         (syntax-error clause)))))
-               ((eq? 'or (car clause))
-                (let lp ((l (cdr clause)))
-                  (cond ((null? l)
-                         #f)
-                        ((pair? l)
-                         (or (test-clause (car l)) (lp (cdr l))))
-                        (else
-                         (syntax-error clause)))))
-               ((eq? 'not (car clause))
-                (cond ((not (pair? (cdr clause)))
-                       (syntax-error clause))
-                      ((pair? (cddr clause))
-                       ((syntax-error clause))))
-                (not (test-clause (cadr clause))))
-               (else
-                (syntax-error clause))))
-             (else
-              (syntax-error clause))))))
-      (let lp ((c clauses))
-        (cond
-         ((null? c)
-          (error "Unfulfilled `cond-expand'"))
-         ((not (pair? c))
-          (syntax-error c))
-         ((not (pair? (car c)))
-          (syntax-error (car c)))
-         ((test-clause (caar c))
-          `(begin ,@(cdar c)))
-         ((eq? (caar c) 'else)
-          (if (pair? (cdr c))
-              (syntax-error c))
-          `(begin ,@(cdar c)))
-         (else
-          (lp (cdr c))))))))
+(define-syntax cond-expand
+  (lambda (x)
+    (define (module-has-feature? mod sym)
+      (or-map (lambda (mod)
+                (memq sym (hashq-ref %cond-expand-table mod '())))
+              (module-uses mod)))
+
+    (define (condition-matches? condition)
+      (syntax-case condition (and or not)
+        ((and c ...)
+         (and-map condition-matches? #'(c ...)))
+        ((or c ...)
+         (or-map condition-matches? #'(c ...)))
+        ((not c)
+         (if (condition-matches? #'c) #f #t))
+        (c
+         (identifier? #'c)
+         (let ((sym (syntax->datum #'c)))
+           (if (memq sym %cond-expand-features)
+               #t
+               (module-has-feature? (current-module) sym))))))
+
+    (define (match clauses alternate)
+      (syntax-case clauses ()
+        (((condition form ...) . rest)
+         (if (condition-matches? #'condition)
+             #'(begin form ...)
+             (match #'rest alternate)))
+        (() (alternate))))
+
+    (syntax-case x (else)
+      ((_ clause ... (else form ...))
+       (match #'(clause ...)
+         (lambda ()
+           #'(begin form ...))))
+      ((_ clause ...)
+       (match #'(clause ...)
+         (lambda ()
+           (syntax-violation 'cond-expand "unfulfilled cond-expand" x)))))))
 
 ;; This procedure gets called from the startup code with a list of
 ;; numbers, which are the numbers of the SRFIs to be loaded on startup.
@@ -3318,48 +3316,22 @@ module '(ice-9 q) '(make-q q-length))}."
 ;;; srfi-55: require-extension
 ;;;
 
-(define-macro (require-extension extension-spec)
-  ;; This macro only handles the srfi extension, which, at present, is
-  ;; the only one defined by the standard.
-  (if (not (pair? extension-spec))
-      (scm-error 'wrong-type-arg "require-extension"
-                 "Not an extension: ~S" (list extension-spec) #f))
-  (let ((extension (car extension-spec))
-        (extension-args (cdr extension-spec)))
-    (case extension
-      ((srfi)
-       (let ((use-list '()))
-         (for-each
-          (lambda (i)
-            (if (not (integer? i))
-                (scm-error 'wrong-type-arg "require-extension"
-                           "Invalid srfi name: ~S" (list i) #f))
-            (let ((srfi-sym (string->symbol
-                             (string-append "srfi-" (number->string i)))))
-              (if (not (memq srfi-sym %cond-expand-features))
-                  (set! use-list (cons `(use-modules (srfi ,srfi-sym))
-                                       use-list)))))
-          extension-args)
-         (if (pair? use-list)
-             ;; i.e. (begin (use-modules x) (use-modules y) (use-modules z))
-             `(begin ,@(reverse! use-list)))))
-      (else
-       (scm-error
-        'wrong-type-arg "require-extension"
-        "Not a recognized extension type: ~S" (list extension) #f)))))
-
-
-
-;;; {Load emacs interface support if emacs option is given.}
-;;;
-
-(define (named-module-use! user usee)
-  (module-use! (resolve-module user) (resolve-interface usee)))
-
-(define (load-emacs-interface)
-  (and (provided? 'debug-extensions)
-       (debug-enable 'backtrace))
-  (named-module-use! '(guile-user) '(ice-9 emacs)))
+(define-syntax require-extension
+  (lambda (x)
+    (syntax-case x (srfi)
+      ((_ (srfi n ...))
+       (and-map integer? (syntax->datum #'(n ...)))
+       (with-syntax
+           (((srfi-n ...)
+             (map (lambda (n)
+                    (datum->syntax x (symbol-append 'srfi- n)))
+                  (map string->symbol
+                       (map number->string (syntax->datum #'(n ...)))))))
+         #'(use-modules (srfi srfi-n) ...)))
+      ((_ (type arg ...))
+       (identifier? #'type)
+       (syntax-violation 'require-extension "Not a recognized extension type"
+                         x)))))
 
 
 
@@ -3369,91 +3341,6 @@ module '(ice-9 q) '(make-q q-length))}."
       (lambda () (fluid-ref using-readline?))
       (lambda (v) (fluid-set! using-readline? v)))))
 
-(define (top-repl)
-  (let ((guile-user-module (resolve-module '(guile-user))))
-
-    ;; Load emacs interface support if emacs option is given.
-    (if (and (module-defined? guile-user-module 'use-emacs-interface)
-             (module-ref guile-user-module 'use-emacs-interface))
-        (load-emacs-interface))
-
-    ;; Use some convenient modules (in reverse order)
-
-    (set-current-module guile-user-module)
-    (process-use-modules 
-     (append
-      '(((ice-9 r5rs))
-        ((ice-9 session))
-        ((ice-9 debug)))
-      (if (provided? 'regex)
-          '(((ice-9 regex)))
-          '())
-      (if (provided? 'threads)
-          '(((ice-9 threads)))
-          '())))
-    ;; load debugger on demand
-    (module-autoload! guile-user-module '(system vm debug) '(debug))
-
-    ;; Note: SIGFPE, SIGSEGV and SIGBUS are actually "query-only" (see
-    ;; scmsigs.c scm_sigaction_for_thread), so the handlers setup here have
-    ;; no effect.
-    (let ((old-handlers #f)
-          ;; We can't use @ here, as modules have been booted, but in Guile's
-          ;; build the srfi-1 helper lib hasn't been built yet, which will
-          ;; result in an error when (system repl repl) is loaded at compile
-          ;; time (to see if it is a macro or not).
-          (start-repl (module-ref (resolve-module '(system repl repl))
-                                  'start-repl))
-          (signals (if (provided? 'posix)
-                       `((,SIGINT . "User interrupt")
-                         (,SIGFPE . "Arithmetic error")
-                         (,SIGSEGV
-                          . "Bad memory access (Segmentation violation)"))
-                       '())))
-      ;; no SIGBUS on mingw
-      (if (defined? 'SIGBUS)
-          (set! signals (acons SIGBUS "Bad memory access (bus error)"
-                               signals)))
-
-      (dynamic-wind
-
-          ;; call at entry
-          (lambda ()
-            (let ((make-handler (lambda (msg)
-                                  (lambda (sig)
-                                    (scm-error 'signal
-                                               #f
-                                               msg
-                                               #f
-                                               (list sig))))))
-              (set! old-handlers
-                    (map (lambda (sig-msg)
-                           (sigaction (car sig-msg)
-                                      (make-handler (cdr sig-msg))))
-                         signals))))
-
-          ;; the protected thunk.
-          (lambda ()
-            (let ((status (start-repl 'scheme)))
-              (run-hook exit-hook)
-              status))
-
-          ;; call at exit.
-          (lambda ()
-            (map (lambda (sig-msg old-handler)
-                   (if (not (car old-handler))
-                       ;; restore original C handler.
-                       (sigaction (car sig-msg) #f)
-                       ;; restore Scheme handler, SIG_IGN or SIG_DFL.
-                       (sigaction (car sig-msg)
-                                  (car old-handler)
-                                  (cdr old-handler))))
-                 signals old-handlers))))))
-
-;;; This hook is run at the very end of an interactive session.
-;;;
-(define exit-hook (make-hook))
-
 
 
 ;;; {Deprecated stuff}
diff --git a/module/ice-9/deprecated.scm b/module/ice-9/deprecated.scm
index ebc9709..1ce98f2 100644
--- a/module/ice-9/deprecated.scm
+++ b/module/ice-9/deprecated.scm
@@ -62,7 +62,10 @@
             handle-system-error
             stack-saved?
             the-last-stack
-            save-stack)
+            save-stack
+            named-module-use!
+            load-emacs-interface
+            top-repl)
 
   #:replace (module-ref-submodule module-define-submodule!))
 
@@ -670,3 +673,21 @@ if you need it.")
    "`save-stack' is deprecated. Use it from `(ice-9 save-stack)' if you need
 it.")
   (apply (@ (ice-9 save-stack) save-stack) args))
+
+(define (named-module-use! user usee)
+  (issue-deprecation-warning
+   "`named-module-use!' is deprecated. Define it yourself if you need it.")
+  (module-use! (resolve-module user) (resolve-interface usee)))
+
+(define (load-emacs-interface)
+  (issue-deprecation-warning
+   "`load-emacs-interface' and the old emacs interface itself are deprecated.
+Use Geiser.")
+  (and (provided? 'debug-extensions)
+       (debug-enable 'backtrace))
+  (named-module-use! '(guile-user) '(ice-9 emacs)))
+
+(define (top-repl)
+  (issue-deprecation-warning
+   "`top-repl' has moved to the `(ice-9 top-repl)' module.")
+  ((module-ref (resolve-module '(ice-9 top-repl)) 'top-repl)))
diff --git a/module/ice-9/gds-client.scm b/module/ice-9/gds-client.scm
index aa45b54..848b774 100755
--- a/module/ice-9/gds-client.scm
+++ b/module/ice-9/gds-client.scm
@@ -504,7 +504,8 @@ Thanks!\n\n"
   (write (getpid))
   (newline)
   (force-output)
-  (named-module-use! '(guile-user) '(ice-9 session))
+  (module-use! (resolve-module '(guile-user))
+               (resolve-interface '(ice-9 session)))
   (gds-accept-input #f))
 
 (define-method (trap-description (trap <trap>))
diff --git a/module/ice-9/top-repl.scm b/module/ice-9/top-repl.scm
new file mode 100644
index 0000000..e41da4e
--- /dev/null
+++ b/module/ice-9/top-repl.scm
@@ -0,0 +1,72 @@
+;;; -*- mode: scheme; coding: utf-8; -*-
+
+;;;; Copyright (C) 
1995,1996,1997,1998,1999,2000,2001,2002,2003,2004,2005,2006,2007,2008,2009,2010
+;;;; 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
+;;;;
+
+(define-module (ice-9 top-repl)
+  #:use-module (ice-9 top-repl)
+  #:use-module ((system repl repl) #:select (start-repl))
+
+  ;; #:replace, as with deprecated code enabled these will be in the root env
+  #:replace (top-repl))
+
+(define call-with-sigint
+  (if (not (provided? 'posix))
+      (lambda (thunk) (thunk))
+      (lambda (thunk)
+        (let ((handler #f))
+          (dynamic-wind
+            (lambda ()
+              (set! handler
+                    (sigaction SIGINT
+                      (lambda (sig)
+                        (scm-error 'signal #f "User interrupt" #f
+                                   (list sig))))))
+            thunk
+            (lambda ()
+              (if handler
+                  ;; restore Scheme handler, SIG_IGN or SIG_DFL.
+                  (sigaction SIGINT (car handler) (cdr handler))
+                  ;; restore original C handler.
+                  (sigaction SIGINT #f))))))))
+
+(define (top-repl)
+  (let ((guile-user-module (resolve-module '(guile-user))))
+
+    ;; Use some convenient modules (in reverse order)
+
+    (set-current-module guile-user-module)
+    (process-use-modules 
+     (append
+      '(((ice-9 r5rs))
+        ((ice-9 session))
+        ((ice-9 debug)))
+      (if (provided? 'regex)
+          '(((ice-9 regex)))
+          '())
+      (if (provided? 'threads)
+          '(((ice-9 threads)))
+          '())))
+    ;; load debugger on demand
+    (module-autoload! guile-user-module '(system vm debug) '(debug))
+
+    (call-with-sigint
+     (lambda ()
+       (let ((status (start-repl 'scheme)))
+         (run-hook exit-hook)
+         status)))))


hooks/post-receive
-- 
GNU Guile



reply via email to

[Prev in Thread] Current Thread [Next in Thread]