[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.0-66-gd59dd06

[Andy Wingo]

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=d59dd06eb9a3a45b9a385421555b2414345d7272

The branch, stable-2.0 has been updated
       via  d59dd06eb9a3a45b9a385421555b2414345d7272 (commit)
       via  b6b84131cd2cf36b49e65f30a67dbc114b78c610 (commit)
      from  900a6f87bad5c5a34f017cc6c851483758433f38 (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 d59dd06eb9a3a45b9a385421555b2414345d7272
Author: Andy Wingo <address@hidden>
Date:   Sat Mar 5 23:16:11 2011 +0100

    add ice-9 eval-string
    
    * module/Makefile.am:
    * module/ice-9/eval-string.scm: New module, for use in implementing the
      scm_c_eval_string_from_file_line suggestion.
    
    * test-suite/Makefile.am:
    * test-suite/tests/eval-string.test: New tests.

commit b6b84131cd2cf36b49e65f30a67dbc114b78c610
Author: Andy Wingo <address@hidden>
Date:   Sat Mar 5 21:48:47 2011 +0100

    remove obsolete comments
    
    * libguile/eval.c (scm_nconc2last):
    * libguile/strports.c (scm_c_read_string): Remove some obsolete
      comments.

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

Summary of changes:
 libguile/eval.c                   |    6 +--
 libguile/strports.c               |    1 -
 module/Makefile.am                |    1 +
 module/ice-9/eval-string.scm      |   88 +++++++++++++++++++++++++++++++++++++
 test-suite/Makefile.am            |    1 +
 test-suite/tests/eval-string.test |   54 ++++++++++++++++++++++
 6 files changed, 145 insertions(+), 6 deletions(-)
 create mode 100644 module/ice-9/eval-string.scm
 create mode 100644 test-suite/tests/eval-string.test

diff --git a/libguile/eval.c b/libguile/eval.c
index 6f2020e..b52cc27 100644
--- a/libguile/eval.c
+++ b/libguile/eval.c
@@ -543,11 +543,7 @@ SCM_DEFINE (scm_nconc2last, "apply:nconc2last", 1, 0, 0,
   SCM *lloc;
   SCM_VALIDATE_NONEMPTYLIST (1, lst);
   lloc = &lst;
-  while (!scm_is_null (SCM_CDR (*lloc))) /* Perhaps should be
-                                          SCM_NULL_OR_NIL_P, but not
-                                          needed in 99.99% of cases,
-                                          and it could seriously hurt
-                                          performance. - Neil */
+  while (!scm_is_null (SCM_CDR (*lloc)))
     lloc = SCM_CDRLOC (*lloc);
   SCM_ASSERT (scm_ilength (SCM_CAR (*lloc)) >= 0, lst, SCM_ARG1, FUNC_NAME);
   *lloc = SCM_CAR (*lloc);
diff --git a/libguile/strports.c b/libguile/strports.c
index 64987fa..af601cf 100644
--- a/libguile/strports.c
+++ b/libguile/strports.c
@@ -475,7 +475,6 @@ scm_c_read_string (const char *expr)
                            "scm_c_read_string");
   SCM form;
 
-  /* Read expressions from that port; ignore the values.  */
   form = scm_read (port);
 
   scm_close_port (port);
diff --git a/module/Makefile.am b/module/Makefile.am
index 16ce6d2..b39b827 100644
--- a/module/Makefile.am
+++ b/module/Makefile.am
@@ -187,6 +187,7 @@ ICE_9_SOURCES = \
   ice-9/curried-definitions.scm \
   ice-9/debug.scm \
   ice-9/documentation.scm \
+  ice-9/eval-string.scm \
   ice-9/expect.scm \
   ice-9/format.scm \
   ice-9/futures.scm \
diff --git a/module/ice-9/eval-string.scm b/module/ice-9/eval-string.scm
new file mode 100644
index 0000000..27448d7
--- /dev/null
+++ b/module/ice-9/eval-string.scm
@@ -0,0 +1,88 @@
+;;; Evaluating code from users
+
+;;; Copyright (C) 2011 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
+
+;;; Code:
+
+(define-module (ice-9 eval-string)
+  #:use-module (system base compile)
+  #:use-module (system base language)
+  #:use-module (system vm program)
+  #:replace (eval-string))
+
+(define (ensure-language x)
+  (if (language? x)
+      x
+      (lookup-language x)))
+
+(define* (read-and-eval port #:key (lang (current-language)))
+  (with-fluids ((*current-language* (ensure-language lang)))
+    (define (read)
+      ((language-reader (current-language)) port (current-module)))
+    (define (eval exp)
+      ((language-evaluator (current-language)) exp (current-module)))
+            
+    (let ((exp (read)))
+      (if (eof-object? exp)
+          ;; The behavior of read-and-compile and of the old
+          ;; eval-string.
+          *unspecified*
+          (let lp ((exp exp))
+            (call-with-values
+                (lambda () (eval exp))
+              (lambda vals
+                (let ((next (read)))
+                  (cond
+                   ((eof-object? next)
+                    (apply values vals))
+                   (else
+                    (lp next)))))))))))
+
+(define* (eval-string str #:key
+                      (module (current-module))
+                      (file #f)
+                      (line #f)
+                      (column #f)
+                      (lang (current-language))
+                      (compile? #f))
+  (define (maybe-with-module module thunk)
+    (if module
+        (save-module-excursion
+         (lambda ()
+           (set-current-module module)
+           (thunk)))
+        (thunk)))
+
+  (let ((lang (ensure-language lang)))
+    (call-with-input-string
+     str
+     (lambda (port)
+       (maybe-with-module
+        module
+        (lambda ()
+          (if module
+              (set-current-module module))
+          (if file
+              (set-port-filename! port file))
+          (if line
+              (set-port-line! port line))
+          (if column
+              (set-port-column! port line))
+
+          (if (or compile? (not (language-evaluator lang)))
+              ((make-program (read-and-compile port #:from lang #:to 
'objcode)))
+              (read-and-eval port #:lang lang))))))))
diff --git a/test-suite/Makefile.am b/test-suite/Makefile.am
index 6cf1bd3..9273406 100644
--- a/test-suite/Makefile.am
+++ b/test-suite/Makefile.am
@@ -44,6 +44,7 @@ SCM_TESTS = tests/00-initial-env.test         \
            tests/elisp-compiler.test           \
            tests/elisp-reader.test             \
            tests/eval.test                     \
+           tests/eval-string.test              \
            tests/exceptions.test               \
            tests/filesys.test                  \
            tests/fluids.test                   \
diff --git a/test-suite/tests/eval-string.test 
b/test-suite/tests/eval-string.test
new file mode 100644
index 0000000..8cef244
--- /dev/null
+++ b/test-suite/tests/eval-string.test
@@ -0,0 +1,54 @@
+;;;; eval-string.test --- tests for (ice-9 eval-string)   -*- scheme -*-
+;;;; Copyright (C) 2011 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 (test-suite test-eval-string)
+  #:use-module (test-suite lib)
+  #:use-module (ice-9 eval-string))
+
+
+(with-test-prefix "basic"
+  (pass-if "eval none"
+    (equal? (eval-string "") *unspecified*))
+
+  (pass-if "eval single"
+    (equal? (eval-string "'foo") 'foo))
+
+  (pass-if "eval multiple"
+    (equal? (eval-string "'foo 'bar") 'bar))
+
+  (pass-if "compile none"
+    (equal? (eval-string "" #:compile? #t) *unspecified*))
+
+  (pass-if "compile single"
+    (equal? (eval-string "'foo" #:compile? #t)
+            'foo))
+
+  (pass-if "compile multiple"
+    (equal? (eval-string "'foo 'bar" #:compile? #t)
+            'bar))
+
+  (pass-if "eval values"
+    (equal? (call-with-values (lambda ()
+                                (eval-string "(values 1 2)"))
+              list)
+            '(1 2)))
+
+  (pass-if "compile values"
+    (equal? (call-with-values (lambda ()
+                                (eval-string "(values 1 2)" #:compile? #t))
+              list)
+            '(1 2))))
\ No newline at end of file


hooks/post-receive
-- 
GNU Guile