From 32ce4058db1adc319dabf6f93143cb367f7456fc Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Fri, 12 Mar 2010 11:54:26 +0100 Subject: [PATCH] prompt around REPL evaluations, and around `guile' program invocation * module/ice-9/control.scm (%): Add a single-argument case, which instates a default prompt with a default handler. * libguile/script.c (scm_compile_shell_switches): Wrap user programs in a default prompt. * module/system/repl/common.scm (repl-eval): REPL expressions are user programs too; wrap each one in a default prompt. --- libguile/script.c | 9 ++++++++- module/ice-9/control.scm | 18 ++++++++++++++++++ module/system/repl/common.scm | 8 +++++--- 3 files changed, 31 insertions(+), 4 deletions(-) diff --git a/libguile/script.c b/libguile/script.c index 89ff7a0c4..2f2495774 100644 --- a/libguile/script.c +++ b/libguile/script.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1994, 1995, 1996, 1997, 1998, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. +/* Copyright (C) 1994, 1995, 1996, 1997, 1998, 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 @@ -740,6 +740,13 @@ scm_compile_shell_switches (int argc, char **argv) { SCM val = scm_cons (sym_begin, tail); + /* Wrap the expression in a prompt. */ + val = scm_list_2 (scm_list_3 (scm_sym_at, + scm_list_2 (scm_from_locale_symbol ("ice-9"), + scm_from_locale_symbol ("control")), + scm_from_locale_symbol ("%")), + val); + #if 0 scm_write (val, SCM_UNDEFINED); scm_newline (SCM_UNDEFINED); diff --git a/module/ice-9/control.scm b/module/ice-9/control.scm index 98397a37f..dbee61e25 100644 --- a/module/ice-9/control.scm +++ b/module/ice-9/control.scm @@ -28,6 +28,10 @@ (define-syntax % (syntax-rules () + ((_ expr) + (call-with-prompt (default-prompt-tag) + (lambda () expr) + default-prompt-handler)) ((_ expr handler) (call-with-prompt (default-prompt-tag) (lambda () expr) @@ -36,3 +40,17 @@ (call-with-prompt tag (lambda () expr) handler)))) + +;; Each prompt tag has a type -- an expected set of arguments, and an unwritten +;; contract of what its handler will do on an abort. In the case of the default +;; prompt tag, we could choose to return values, exit nonlocally, or punt to the +;; user. +;; +;; We choose the latter, by requiring that the user return one value, a +;; procedure, to an abort to the prompt tag. That argument is then invoked with +;; the continuation as an argument, within a reinstated default prompt. In this +;; way the return value(s) from a default prompt are under the user's control. +(define (default-prompt-handler k proc) + (% (default-prompt-tag) + (proc k) + default-prompt-handler)) diff --git a/module/system/repl/common.scm b/module/system/repl/common.scm index 9570d1d18..e3dc0c461 100644 --- a/module/system/repl/common.scm +++ b/module/system/repl/common.scm @@ -1,6 +1,6 @@ ;;; Repl common routines -;; Copyright (C) 2001, 2008, 2009 Free Software Foundation, Inc. +;; Copyright (C) 2001, 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 @@ -23,6 +23,7 @@ #:use-module (system base compile) #:use-module (system base language) #:use-module (system vm vm) + #:use-module (ice-9 control) #:export ( make-repl repl-vm repl-language repl-options repl-tm-stats repl-gc-stats repl-welcome repl-prompt repl-read repl-compile repl-eval @@ -80,8 +81,9 @@ (if (and eval (or (null? (language-compilers (repl-language repl))) (assq-ref (repl-options repl) 'interp))) - (eval form (current-module)) - (vm-load (repl-vm repl) (repl-compile repl form '()))))) + (% (eval form (current-module))) + (let ((compiled (repl-compile repl form '()))) + (% (vm-load (repl-vm repl) compiled)))))) (define (repl-print repl val) (if (not (eq? val *unspecified*))