module/ice-9/top-repl.scm

   1 ;;; -*- mode: scheme; coding: utf-8; -*-
   2
   3 ;;;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
   4 ;;;;   2005, 2006, 2007, 2008, 2009, 2010, 2011, 2013 Free Software Foundation, Inc.
   5 ;;;;
   6 ;;;; This library is free software; you can redistribute it and/or
   7 ;;;; modify it under the terms of the GNU Lesser General Public
   8 ;;;; License as published by the Free Software Foundation; either
   9 ;;;; version 3 of the License, or (at your option) any later version.
  10 ;;;;
  11 ;;;; This library is distributed in the hope that it will be useful,
  12 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  14 ;;;; Lesser General Public License for more details.
  15 ;;;;
  16 ;;;; You should have received a copy of the GNU Lesser General Public
  17 ;;;; License along with this library; if not, write to the Free Software
  18 ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
  19 ;;;;
  20
  21 (define-module (ice-9 top-repl)
  22   #:use-module (ice-9 top-repl)
  23   #:use-module ((system repl repl) #:select (start-repl))
  24
  25   ;; #:replace, as with deprecated code enabled these will be in the root env
  26   #:replace (top-repl))
  27
  28 (define call-with-sigint
  29   (if (not (provided? 'posix))
  30       (lambda (thunk) (thunk))
  31       (lambda (thunk)
  32         (let ((handler #f))
  33           (dynamic-wind
  34             (lambda ()
  35               (set! handler
  36                     (sigaction SIGINT
  37                       (lambda (sig)
  38                         (scm-error 'signal #f "User interrupt" '()
  39                                    (list sig))))))
  40             thunk
  41             (lambda ()
  42               (if handler
  43                   ;; restore Scheme handler, SIG_IGN or SIG_DFL.
  44                   (sigaction SIGINT (car handler) (cdr handler))
  45                   ;; restore original C handler.
  46                   (sigaction SIGINT #f))))))))
  47
  48 (define (top-repl)
  49   (let ((guile-user-module (resolve-module '(guile-user))))
  50
  51     ;; Use some convenient modules (in reverse order)
  52
  53     (set-current-module guile-user-module)
  54     (process-use-modules
  55      (append
  56       '(((ice-9 r5rs))
  57         ((ice-9 session)))
  58       (if (provided? 'regex)
  59           '(((ice-9 regex)))
  60           '())
  61       (if (provided? 'threads)
  62           '(((ice-9 threads)))
  63           '())))
  64
  65     (call-with-sigint
  66      (lambda ()
  67        (and (defined? 'setlocale)
  68             (catch 'system-error
  69               (lambda ()
  70                 (setlocale LC_ALL ""))
  71               (lambda (key subr fmt args errno)
  72                 (format (current-error-port)
  73                         "warning: failed to install locale: ~a~%"
  74                         (strerror (car errno))))))
  75
  76        (let ((status (start-repl (current-language))))
  77          (run-hook exit-hook)
  78          status)))))