[Guile-commits] GNU Guile branch, master, updated. v2.1.0-83-g6fc634f

[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=6fc634f8a378475efa336afadb8cef26807bd0cb

The branch, master has been updated
       via  6fc634f8a378475efa336afadb8cef26807bd0cb (commit)
       via  30411abf5caf98ebe8dbb7c5d63c8ba43b488d4b (commit)
       via  cf7a884f125de0a44ddccbc985a96e3a6eb62b8b (commit)
       via  3ddd438179d98b0370592ea82b748de25d76c4d7 (commit)
       via  3c01acbcf5afe0be07d44a12cf3f23106b8ca1a5 (commit)
       via  681f2b8585eeda8bc0b3e5acd78d80abd3385ee9 (commit)
      from  ebca3afedb716087b5cd5d64e9ba4e5d94491367 (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 6fc634f8a378475efa336afadb8cef26807bd0cb
Author: Andy Wingo <address@hidden>
Date:   Mon Jul 21 17:30:16 2014 +0200

    CSE allocate-struct fix
    
    * module/language/cps/cse.scm (compute-equivalent-subexpressions):
      Fix handling of allocate-struct in tail position.

commit 30411abf5caf98ebe8dbb7c5d63c8ba43b488d4b
Author: Andy Wingo <address@hidden>
Date:   Mon Jul 21 17:03:51 2014 +0200

    Fix typo in arities.scm
    
    * module/language/cps/arities.scm (fix-arities*): Fix typo.

commit cf7a884f125de0a44ddccbc985a96e3a6eb62b8b
Author: Andy Wingo <address@hidden>
Date:   Mon Jul 21 12:19:33 2014 +0200

    Stabilize renumber.scm:sort-conts.
    
    * module/language/cps/renumber.scm (sort-conts): Prevent spurious
      continuation reordering.

commit 3ddd438179d98b0370592ea82b748de25d76c4d7
Author: Andy Wingo <address@hidden>
Date:   Mon Jul 21 21:37:20 2014 +0200

    maybe_annotate_source does not annotate negative positions
    
    * libguile/read.c (maybe_annotate_source): Don't annotate with negative
      lines or columns.

commit 3c01acbcf5afe0be07d44a12cf3f23106b8ca1a5
Author: Andy Wingo <address@hidden>
Date:   Mon Jul 21 21:36:30 2014 +0200

    Soft port fill-input doesn't alter line or column
    
    * libguile/vports.c (sf_fill_input): Save and restore the line/column
      info around the ungetc.

commit 681f2b8585eeda8bc0b3e5acd78d80abd3385ee9
Author: Andy Wingo <address@hidden>
Date:   Mon Jul 21 21:35:49 2014 +0200

    scm_ungetc_unlocked should not result in negative columns
    
    * libguile/ports.c (scm_ungetc_unlocked): Use DECCOL in all cases, to
      avoid negative columns.

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

Summary of changes:
 libguile/ports.c                 |   10 ++--------
 libguile/read.c                  |    5 +++++
 libguile/vports.c                |   22 +++++++++++++++++-----
 module/language/cps/arities.scm  |    2 +-
 module/language/cps/cse.scm      |    1 +
 module/language/cps/renumber.scm |    9 ++++++++-
 6 files changed, 34 insertions(+), 15 deletions(-)

diff --git a/libguile/ports.c b/libguile/ports.c
index 5fb3424..8185d85 100644
--- a/libguile/ports.c
+++ b/libguile/ports.c
@@ -2172,14 +2172,8 @@ scm_ungetc_unlocked (scm_t_wchar c, SCM port)
     free (result);
 
   if (c == '\n')
-    {
-      /* What should col be in this case?
-       * We'll leave it at -1.
-       */
-      SCM_LINUM (port) -= 1;
-    }
-  else
-    SCM_COL(port) -= 1;
+    SCM_LINUM (port) -= 1;
+  SCM_DECCOL (port);
 }
 #undef FUNC_NAME
 
diff --git a/libguile/read.c b/libguile/read.c
index bcb40ee..c2d50af 100644
--- a/libguile/read.c
+++ b/libguile/read.c
@@ -411,6 +411,11 @@ static SCM
 maybe_annotate_source (SCM x, SCM port, scm_t_read_opts *opts,
                        long line, int column)
 {
+  /* This condition can be caused by a user calling
+     set-port-column!.  */
+  if (line < 0 || column < 0)
+    return x;
+
   if (opts->record_positions_p)
     scm_i_set_source_properties_x (x, line, column, SCM_FILENAME (port));
   return x;
diff --git a/libguile/vports.c b/libguile/vports.c
index e726330..17eac86 100644
--- a/libguile/vports.c
+++ b/libguile/vports.c
@@ -88,6 +88,7 @@ sf_fill_input (SCM port)
 {
   SCM p = SCM_PACK (SCM_STREAM (port));
   SCM ans;
+  scm_t_wchar c;
   scm_t_port_internal *pti;
 
   ans = scm_call_0 (SCM_SIMPLE_VECTOR_REF (p, 3)); /* get char.  */
@@ -96,18 +97,29 @@ sf_fill_input (SCM port)
   SCM_ASSERT (SCM_CHARP (ans), ans, SCM_ARG1, "sf_fill_input");
   pti = SCM_PORT_GET_INTERNAL (port);
 
-  if (pti->encoding_mode == SCM_PORT_ENCODING_MODE_LATIN1)
+  c = SCM_CHAR (ans);
+
+  if (pti->encoding_mode == SCM_PORT_ENCODING_MODE_LATIN1
+      || (pti->encoding_mode == SCM_PORT_ENCODING_MODE_UTF8 && c < 0xff))
     {
       scm_t_port *pt = SCM_PTAB_ENTRY (port);    
       
-      *pt->read_buf = SCM_CHAR (ans);
+      *pt->read_buf = c;
       pt->read_pos = pt->read_buf;
       pt->read_end = pt->read_buf + 1;
-      return *pt->read_buf;
     }
   else
-    scm_ungetc_unlocked (SCM_CHAR (ans), port);
-  return SCM_CHAR (ans);
+    {
+      long line = SCM_LINUM (port);
+      int column = SCM_COL (port);
+
+      scm_ungetc_unlocked (c, port);
+
+      SCM_LINUM (port) = line;
+      SCM_COL (port) = column;
+    }
+
+  return c;
 }
 
 
diff --git a/module/language/cps/arities.scm b/module/language/cps/arities.scm
index c8a9728..e6c5f29 100644
--- a/module/language/cps/arities.scm
+++ b/module/language/cps/arities.scm
@@ -95,7 +95,7 @@
          (rewrite-cps-term (lookup-cont k dfg)
            (($ $ktail)
             ,(rewrite-cps-term exp
-               (($values (sym))
+               (($ $values (sym))
                 ($continue ktail src ($primcall 'return (sym))))
                (_
                 ,(let-fresh (k*) (v)
diff --git a/module/language/cps/cse.scm b/module/language/cps/cse.scm
index ab48290..204480e 100644
--- a/module/language/cps/cse.scm
+++ b/module/language/cps/cse.scm
@@ -341,6 +341,7 @@ could be that both true and false proofs are available."
             (('primcall (or 'allocate-struct 'allocate-struct/immediate)
                         vtable size)
              (match defs
+               (() #f) ;; allocate-struct in tail or kreceive position.
                ((struct)
                 (add-def! `(primcall struct-vtable ,(subst-var struct))
                           vtable))))
diff --git a/module/language/cps/renumber.scm b/module/language/cps/renumber.scm
index 78425ab..4f51b70 100644
--- a/module/language/cps/renumber.scm
+++ b/module/language/cps/renumber.scm
@@ -66,7 +66,14 @@
                    (let ((k-len (vector-ref path-lengths k))
                          (kt-len (vector-ref path-lengths kt)))
                      (cond
-                      ((and k-len kt-len (< k-len kt-len))
+                      ((if kt-len
+                           (or (not k-len)
+                               (< k-len kt-len)
+                               ;; If the path lengths are the
+                               ;; same, preserve original order
+                               ;; to avoid squirreliness.
+                               (and (= k-len kt-len) (< kt k)))
+                           (if k-len #f (< kt k)))
                        (maybe-visit k)
                        (maybe-visit kt))
                       (else


hooks/post-receive
-- 
GNU Guile