diff options
Diffstat (limited to 'main/guile')
10 files changed, 687 insertions, 1 deletions
diff --git a/main/guile/0002-Mark-mutex-with-owner-not-retained-threads-test-as-u.patch b/main/guile/0002-Mark-mutex-with-owner-not-retained-threads-test-as-u.patch new file mode 100644 index 00000000000..cbe194dfd51 --- /dev/null +++ b/main/guile/0002-Mark-mutex-with-owner-not-retained-threads-test-as-u.patch @@ -0,0 +1,29 @@ +From be9d97e0eeb2423b86fad7094a462b142f5176f7 Mon Sep 17 00:00:00 2001 +From: Rob Browning <rlb@defaultvalue.org> +Date: Sun, 18 Mar 2012 13:28:24 -0500 +Subject: Mark "mutex with owner not retained" threads test as unresolved. + +As per discussion with upstream, mark this test as unresolved since it +may produce false negatives, depending on the behavior/timing of the +garbage collector. +--- + test-suite/tests/threads.test | 6 ++++-- + 1 file changed, 4 insertions(+), 2 deletions(-) + +diff --git a/test-suite/tests/threads.test b/test-suite/tests/threads.test +index 8178120..7d180de 100644 +--- a/test-suite/tests/threads.test ++++ b/test-suite/tests/threads.test +@@ -412,8 +412,10 @@ + + (gc) (gc) + (let ((m (g))) +- (and (mutex? m) +- (eq? (mutex-owner m) (current-thread))))))) ++ (or ++ (and (mutex? m) ++ (eq? (mutex-owner m) (current-thread))) ++ (throw 'unresolved)))))) + + ;; + ;; mutex lock levels diff --git a/main/guile/0003-Recognize-more-ARM-targets.patch b/main/guile/0003-Recognize-more-ARM-targets.patch new file mode 100644 index 00000000000..59fc857f3cc --- /dev/null +++ b/main/guile/0003-Recognize-more-ARM-targets.patch @@ -0,0 +1,70 @@ +From ff888821b2bd221ed74ce9bef8d28d94327450d4 Mon Sep 17 00:00:00 2001 +From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org> +Date: Fri, 4 Jul 2014 17:26:41 +0200 +Subject: Recognize more ARM targets. + +Suggested by Dale P. Smith. + +* module/system/base/target.scm (cpu-endianness): Add cases for + "arm.*eb", "^aarch64.*be", and "aarch64". Change "arm" case to + "arm.*". + (triplet-pointer-size): Allow underscore as in 'aarch64_be'. +* test-suite/tests/asm-to-bytecode.test ("cross-compilation")["armeb-unknown-linux-gnu", + "aarch64-linux-gnu", "aarch64_be-linux-gnu"]: New tests. + +Origin: upstream, commit: ffd3e55cfd12a3559621e3130d613d319243512d +Bug-Debian: https://bugs.debian.org/cgi-bin/bugreport.cgi?bug=758463 +Added-by: Rob Browning <rlb@defaultvalue.org> +--- + module/system/base/target.scm | 10 +++++++++- + test-suite/tests/asm-to-bytecode.test | 9 +++++++++ + 2 files changed, 18 insertions(+), 1 deletion(-) + +diff --git a/module/system/base/target.scm b/module/system/base/target.scm +index c74ae67..9d65184 100644 +--- a/module/system/base/target.scm ++++ b/module/system/base/target.scm +@@ -72,6 +72,14 @@ + (endianness big)) + ((string-match "^arm.*el" cpu) + (endianness little)) ++ ((string-match "^arm.*eb" cpu) ++ (endianness big)) ++ ((string-prefix? "arm" cpu) ;ARMs are LE by default ++ (endianness little)) ++ ((string-match "^aarch64.*be" cpu) ++ (endianness big)) ++ ((string=? "aarch64" cpu) ++ (endianness little)) + (else + (error "unknown CPU endianness" cpu))))) + +@@ -95,7 +103,7 @@ + ((string-match "^x86_64-.*-gnux32" triplet) 4) ; x32 + + ((string-match "64$" cpu) 8) +- ((string-match "64[lbe][lbe]$" cpu) 8) ++ ((string-match "64_?[lbe][lbe]$" cpu) 8) + ((member cpu '("sparc" "powerpc" "mips" "mipsel")) 4) + ((string-match "^arm.*" cpu) 4) + (else (error "unknown CPU word size" cpu))))) +diff --git a/test-suite/tests/asm-to-bytecode.test b/test-suite/tests/asm-to-bytecode.test +index 6d2f20e..937e990 100644 +--- a/test-suite/tests/asm-to-bytecode.test ++++ b/test-suite/tests/asm-to-bytecode.test +@@ -205,6 +205,15 @@ + (test-target "x86_64-unknown-linux-gnux32" ; x32 ABI (Debian tuplet) + (endianness little) 4) + ++ (test-target "arm-unknown-linux-androideabi" ++ (endianness little) 4) ++ (test-target "armeb-unknown-linux-gnu" ++ (endianness big) 4) ++ (test-target "aarch64-linux-gnu" ++ (endianness little) 8) ++ (test-target "aarch64_be-linux-gnu" ++ (endianness big) 8) ++ + (pass-if-exception "unknown target" + exception:miscellaneous-error + (call-with-values (lambda () diff --git a/main/guile/0008-VM-ASM_MUL-for-ARM-Add-earlyclobber-constraint-to-th.patch b/main/guile/0008-VM-ASM_MUL-for-ARM-Add-earlyclobber-constraint-to-th.patch new file mode 100644 index 00000000000..c403996a0d7 --- /dev/null +++ b/main/guile/0008-VM-ASM_MUL-for-ARM-Add-earlyclobber-constraint-to-th.patch @@ -0,0 +1,37 @@ +From 923c3afaeeacce15c22ad90e7f47d3a250c36190 Mon Sep 17 00:00:00 2001 +From: Mark H Weaver <mhw@netris.org> +Date: Fri, 19 Sep 2014 21:18:09 -0400 +Subject: VM: ASM_MUL for ARM: Add earlyclobber constraint to the SMULL + outputs. + +Reported by Rob Browning <rlb@defaultvalue.org>. + +* libguile/vm-i-scheme.c (ASM_MUL)[ARM]: Add earlyclobber (&) constraint + to the SMULL output registers. + +Origin: http://git.savannah.gnu.org/cgit/guile.git/commit/?id=a85c78ea1393985fdb6e6678dea19135c553d341 +Added-by: Rob Browning <rlb@defaultvalue.org> +--- + libguile/vm-i-scheme.c | 5 ++--- + 1 file changed, 2 insertions(+), 3 deletions(-) + +diff --git a/libguile/vm-i-scheme.c b/libguile/vm-i-scheme.c +index 587aa95..162efab 100644 +--- a/libguile/vm-i-scheme.c ++++ b/libguile/vm-i-scheme.c +@@ -1,5 +1,4 @@ +-/* Copyright (C) 2001, 2009, 2010, 2011, 2012, 2013, +- * 2014 Free Software Foundation, Inc. ++/* Copyright (C) 2001, 2009-2014 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 +@@ -363,7 +362,7 @@ VM_DEFINE_FUNCTION (149, ge, "ge?", 2) + { \ + scm_t_signed_bits rlo, rhi; \ + asm ("smull %0, %1, %2, %3\n" \ +- : "=r" (rlo), "=r" (rhi) \ ++ : "=&r" (rlo), "=&r" (rhi) \ + : "r" (SCM_UNPACK (x) - scm_tc2_int), \ + "r" (SCM_I_INUM (y))); \ + if (SCM_LIKELY (SCM_SRS (rlo, 31) == rhi)) \ diff --git a/main/guile/0009-VM-Allow-the-C-compiler-to-choose-FP_REG-on-ARM.patch b/main/guile/0009-VM-Allow-the-C-compiler-to-choose-FP_REG-on-ARM.patch new file mode 100644 index 00000000000..103b3345585 --- /dev/null +++ b/main/guile/0009-VM-Allow-the-C-compiler-to-choose-FP_REG-on-ARM.patch @@ -0,0 +1,37 @@ +From 1ebf3ef7b8318865dc85f5a18be59b6f8e23949f Mon Sep 17 00:00:00 2001 +From: Mark H Weaver <mhw@netris.org> +Date: Sat, 20 Sep 2014 03:59:51 -0400 +Subject: VM: Allow the C compiler to choose FP_REG on ARM. + +Reported by Rob Browning <rlb@defaultvalue.org>. + +* libguile/vm-engine.h (IP_REG)[__arm__]: Remove explicit register + choice ("r7") for FP_REG, which was reported to cause compilation + failures on ARM. + +Origin: http://git.savannah.gnu.org/cgit/guile.git/commit/?id=bed025bd2569b1c033f24d7d9e660e39ebf65cac +Bug-Debian: http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=763115 +Added-by: Rob Browning <rlb@defaultvalue.org> +--- + libguile/vm-engine.h | 4 ++-- + 1 file changed, 2 insertions(+), 2 deletions(-) + +diff --git a/libguile/vm-engine.h b/libguile/vm-engine.h +index 28cab40..178828c 100644 +--- a/libguile/vm-engine.h ++++ b/libguile/vm-engine.h +@@ -1,4 +1,4 @@ +-/* Copyright (C) 2001, 2009, 2010, 2011, 2012 Free Software Foundation, Inc. ++/* Copyright (C) 2001, 2009-2012, 2014 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 +@@ -81,7 +81,7 @@ + #ifdef __arm__ + #define IP_REG asm("r9") + #define SP_REG asm("r8") +-#define FP_REG asm("r7") ++#define FP_REG + #endif + #endif + diff --git a/main/guile/0010-web-Keep-the-default-size-for-the-client-s-in-kernel.patch b/main/guile/0010-web-Keep-the-default-size-for-the-client-s-in-kernel.patch new file mode 100644 index 00000000000..fd3ec43fa5d --- /dev/null +++ b/main/guile/0010-web-Keep-the-default-size-for-the-client-s-in-kernel.patch @@ -0,0 +1,39 @@ +From 4dee57333aa8dd5017f4c45302d40f8f3b900ab6 Mon Sep 17 00:00:00 2001 +From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org> +Date: Fri, 23 May 2014 22:00:21 +0200 +Subject: web: Keep the default size for the client's in-kernel receive buffer. + +Fixes <http://bugs.gnu.org/15368>. + +* module/web/client.scm (open-socket-for-uri): Remove call to + 'setsockopt'. Contrary to what the comment said, its effect was to + shrink the receive buffer from 124 KiB (the default size, per + /proc/sys/net/core/rmem_default on Linux-based systems) to 12 KiB. + +Origin: http://git.savannah.gnu.org/cgit/guile.git/commit/?id=0bb3f946e97424616c1a95f2372e5bc41e8f8174 +Added-by: Rob Browning <rlb@defaultvalue.org> +--- + module/web/client.scm | 4 +--- + 1 file changed, 1 insertion(+), 3 deletions(-) + +diff --git a/module/web/client.scm b/module/web/client.scm +index 3f6c45b..070b0c3 100644 +--- a/module/web/client.scm ++++ b/module/web/client.scm +@@ -1,6 +1,6 @@ + ;;; Web client + +-;; Copyright (C) 2011, 2012, 2013 Free Software Foundation, Inc. ++;; Copyright (C) 2011, 2012, 2013, 2014 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 +@@ -92,8 +92,6 @@ + + ;; Buffer input and output on this port. + (setvbuf s _IOFBF) +- ;; Enlarge the receive buffer. +- (setsockopt s SOL_SOCKET SO_RCVBUF (* 12 1024)) + ;; If we're using a proxy, make a note of that. + (when http-proxy (set-http-proxy-port?! s #t)) + s) diff --git a/main/guile/0011-Fix-shrinking-of-contiguous-bytevectors-as-from-get-.patch b/main/guile/0011-Fix-shrinking-of-contiguous-bytevectors-as-from-get-.patch new file mode 100644 index 00000000000..2380d838e73 --- /dev/null +++ b/main/guile/0011-Fix-shrinking-of-contiguous-bytevectors-as-from-get-.patch @@ -0,0 +1,48 @@ +From a1784f281279f6f8b95f75c336786987e77bc84a Mon Sep 17 00:00:00 2001 +From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org> +Date: Wed, 28 May 2014 19:26:45 +0200 +Subject: Fix shrinking of contiguous bytevectors, as from 'get-bytevector-n'. + +Fixes <http://bugs.gnu.org/17466>. +Reported by J Kalbhenn <jkal@posteo.eu>. + +* libguile/bytevectors.c (scm_c_shrink_bytevector): When BV is + contiguous, add use of 'SCM_BYTEVECTOR_SET_CONTENTS'. + +Origin: http://git.savannah.gnu.org/cgit/guile.git/commit/?id=1baa2159307c34683e8ede54f38f65010fc594b0 +Added-by: Rob Browning <rlb@defaultvalue.org> +--- + libguile/bytevectors.c | 16 +++++++++++----- + 1 file changed, 11 insertions(+), 5 deletions(-) + +diff --git a/libguile/bytevectors.c b/libguile/bytevectors.c +index be8b654..b210440 100644 +--- a/libguile/bytevectors.c ++++ b/libguile/bytevectors.c +@@ -1,4 +1,4 @@ +-/* Copyright (C) 2009, 2010, 2011, 2012 Free Software Foundation, Inc. ++/* Copyright (C) 2009, 2010, 2011, 2012, 2014 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 +@@ -315,10 +315,16 @@ scm_c_shrink_bytevector (SCM bv, size_t c_new_len) + SCM_BYTEVECTOR_SET_LENGTH (bv, c_new_len); + + if (SCM_BYTEVECTOR_CONTIGUOUS_P (bv)) +- new_bv = PTR2SCM (scm_gc_realloc (SCM2PTR (bv), +- c_len + SCM_BYTEVECTOR_HEADER_BYTES, +- c_new_len + SCM_BYTEVECTOR_HEADER_BYTES, +- SCM_GC_BYTEVECTOR)); ++ { ++ signed char *c_bv; ++ ++ c_bv = scm_gc_realloc (SCM2PTR (bv), ++ c_len + SCM_BYTEVECTOR_HEADER_BYTES, ++ c_new_len + SCM_BYTEVECTOR_HEADER_BYTES, ++ SCM_GC_BYTEVECTOR); ++ new_bv = PTR2SCM (c_bv); ++ SCM_BYTEVECTOR_SET_CONTENTS (new_bv, c_bv + SCM_BYTEVECTOR_HEADER_BYTES); ++ } + else + { + signed char *c_bv; diff --git a/main/guile/0013-Handle-p-in-format-warnings.patch b/main/guile/0013-Handle-p-in-format-warnings.patch new file mode 100644 index 00000000000..1490433f424 --- /dev/null +++ b/main/guile/0013-Handle-p-in-format-warnings.patch @@ -0,0 +1,106 @@ +From 1366d9ed223c6953df491260ecaeb3b3867006b2 Mon Sep 17 00:00:00 2001 +From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org> +Date: Tue, 26 Aug 2014 23:40:22 +0200 +Subject: Handle ~p in 'format' warnings. + +Fixes <http://bugs.gnu.org/18299>. +Reported by Frank Terbeck <ft@bewatermyfriend.org>. + +* module/language/tree-il/analyze.scm (format-string-argument-count): + Add case for ~p. +* test-suite/tests/tree-il.test ("warnings")["format"]("~p", "~p, too + few arguments", "~:p", "~:@p, too many arguments", "~:@p, too few + arguments"): New tests. + +Origin: http://git.savannah.gnu.org/cgit/guile.git/commit/?id=8ac39b38d14f47b6028030fa829f1fe7d0499f21 +Added-by: Rob Browning <rlb@defaultvalue.org> +--- + module/language/tree-il/analyze.scm | 13 ++++++++++- + test-suite/tests/tree-il.test | 44 +++++++++++++++++++++++++++++++++++++ + 2 files changed, 56 insertions(+), 1 deletion(-) + +diff --git a/module/language/tree-il/analyze.scm b/module/language/tree-il/analyze.scm +index badce9f..ef625d4 100644 +--- a/module/language/tree-il/analyze.scm ++++ b/module/language/tree-il/analyze.scm +@@ -1,6 +1,7 @@ + ;;; TREE-IL -> GLIL compiler + +-;; Copyright (C) 2001, 2008, 2009, 2010, 2011, 2012 Free Software Foundation, Inc. ++;; Copyright (C) 2001, 2008, 2009, 2010, 2011, 2012, ++;; 2014 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 +@@ -1273,6 +1274,16 @@ accurate information is missing from a given `tree-il' element." + conditions end-group + (+ 1 min-count) + (+ 1 max-count))) ++ ((#\p #\P) (let* ((colon? (memq #\: params)) ++ (min-count (if colon? ++ (max 1 min-count) ++ (+ 1 min-count)))) ++ (loop (cdr chars) 'literal '() ++ conditions end-group ++ min-count ++ (if colon? ++ (max max-count min-count) ++ (+ 1 max-count))))) + ((#\[) + (loop chars 'literal '() '() + (let ((selector (previous-number params)) +diff --git a/test-suite/tests/tree-il.test b/test-suite/tests/tree-il.test +index 34bc810..f892033 100644 +--- a/test-suite/tests/tree-il.test ++++ b/test-suite/tests/tree-il.test +@@ -1698,6 +1698,50 @@ + (number? (string-contains (car w) + "expected 3, got 2"))))) + ++ (pass-if "~p" ++ (null? (call-with-warnings ++ (lambda () ++ (compile '(((@ (ice-9 format) format) #f "thing~p" 2)) ++ #:opts %opts-w-format ++ #:to 'assembly))))) ++ ++ (pass-if "~p, too few arguments" ++ (let ((w (call-with-warnings ++ (lambda () ++ (compile '((@ (ice-9 format) format) #f "~p") ++ #:opts %opts-w-format ++ #:to 'assembly))))) ++ (and (= (length w) 1) ++ (number? (string-contains (car w) ++ "expected 1, got 0"))))) ++ ++ (pass-if "~:p" ++ (null? (call-with-warnings ++ (lambda () ++ (compile '(((@ (ice-9 format) format) #f "~d thing~:p" 2)) ++ #:opts %opts-w-format ++ #:to 'assembly))))) ++ ++ (pass-if "~:@p, too many arguments" ++ (let ((w (call-with-warnings ++ (lambda () ++ (compile '((@ (ice-9 format) format) #f "~d pupp~:@p" 5 5) ++ #:opts %opts-w-format ++ #:to 'assembly))))) ++ (and (= (length w) 1) ++ (number? (string-contains (car w) ++ "expected 1, got 2"))))) ++ ++ (pass-if "~:@p, too few arguments" ++ (let ((w (call-with-warnings ++ (lambda () ++ (compile '((@ (ice-9 format) format) #f "pupp~:@p") ++ #:opts %opts-w-format ++ #:to 'assembly))))) ++ (and (= (length w) 1) ++ (number? (string-contains (car w) ++ "expected 1, got 0"))))) ++ + (pass-if "~?" + (null? (call-with-warnings + (lambda () diff --git a/main/guile/0015-Fix-SCM_SMOB_OBJECT-_-_0_-_1_-_2_-_3_-LOC.patch b/main/guile/0015-Fix-SCM_SMOB_OBJECT-_-_0_-_1_-_2_-_3_-LOC.patch new file mode 100644 index 00000000000..8c82aedd153 --- /dev/null +++ b/main/guile/0015-Fix-SCM_SMOB_OBJECT-_-_0_-_1_-_2_-_3_-LOC.patch @@ -0,0 +1,44 @@ +From 129950433fd597c683478430240261161e5ced64 Mon Sep 17 00:00:00 2001 +From: David Kastrup <dak@gnu.org> +Date: Sat, 20 Sep 2014 05:17:54 -0400 +Subject: Fix SCM_SMOB_OBJECT{_,_0_,_1_,_2_,_3_}LOC. + +Fixes <http://bugs.gnu.org/18495>. + +* libguile/smob.h (SCM_SMOB_OBJECT_LOC, SCM_SMOB_OBJECT_0_LOC) + (SCM_SMOB_OBJECT_1_LOC, SCM_SMOB_OBJECT_2_LOC) + (SCM_SMOB_OBJECT_3_LOC): These elementary API macros have been broken + by commit 56164dc47f6616b359f0ad23be208f01a77b55fa in 2009. + +Signed-off-by: David Kastrup <dak@gnu.org> + +Origin: http://git.savannah.gnu.org/cgit/guile.git/commit/?id=8442211ef0029581b35f784489afcf210491fc41) +Added-by: Rob Browning <rlb@defaultvalue.org> +--- + libguile/smob.h | 10 +++++----- + 1 file changed, 5 insertions(+), 5 deletions(-) + +diff --git a/libguile/smob.h b/libguile/smob.h +index 60abe37..f910a24 100644 +--- a/libguile/smob.h ++++ b/libguile/smob.h +@@ -156,14 +156,14 @@ scm_new_double_smob (scm_t_bits tc, scm_t_bits data1, + #define SCM_SET_SMOB_OBJECT_1(x,obj) (SCM_SET_SMOB_OBJECT_N ((x), 1, (obj))) + #define SCM_SET_SMOB_OBJECT_2(x,obj) (SCM_SET_SMOB_OBJECT_N ((x), 2, (obj))) + #define SCM_SET_SMOB_OBJECT_3(x,obj) (SCM_SET_SMOB_OBJECT_N ((x), 3, (obj))) +-#define SCM_SMOB_OBJECT_0_LOC(x) (SCM_SMOB_OBJECT_N_LOC ((x), 0))) +-#define SCM_SMOB_OBJECT_1_LOC(x) (SCM_SMOB_OBJECT_N_LOC ((x), 1))) +-#define SCM_SMOB_OBJECT_2_LOC(x) (SCM_SMOB_OBJECT_N_LOC ((x), 2))) +-#define SCM_SMOB_OBJECT_3_LOC(x) (SCM_SMOB_OBJECT_N_LOC ((x), 3))) ++#define SCM_SMOB_OBJECT_0_LOC(x) (SCM_SMOB_OBJECT_N_LOC ((x), 0)) ++#define SCM_SMOB_OBJECT_1_LOC(x) (SCM_SMOB_OBJECT_N_LOC ((x), 1)) ++#define SCM_SMOB_OBJECT_2_LOC(x) (SCM_SMOB_OBJECT_N_LOC ((x), 2)) ++#define SCM_SMOB_OBJECT_3_LOC(x) (SCM_SMOB_OBJECT_N_LOC ((x), 3)) + + #define SCM_SMOB_OBJECT(x) (SCM_SMOB_OBJECT_1 (x)) + #define SCM_SET_SMOB_OBJECT(x,obj) (SCM_SET_SMOB_OBJECT_1 ((x), (obj))) +-#define SCM_SMOB_OBJECT_LOC(x) (SCM_SMOB_OBJECT_1_LOC (x))) ++#define SCM_SMOB_OBJECT_LOC(x) (SCM_SMOB_OBJECT_1_LOC (x)) + + + #define SCM_SMOB_APPLY_0(x) (scm_call_0 (x)) diff --git a/main/guile/0016-peval-Handle-optional-argument-inits-that-refer-to-p.patch b/main/guile/0016-peval-Handle-optional-argument-inits-that-refer-to-p.patch new file mode 100644 index 00000000000..c134815c1d2 --- /dev/null +++ b/main/guile/0016-peval-Handle-optional-argument-inits-that-refer-to-p.patch @@ -0,0 +1,239 @@ +From fdc2c9e00af5f2721c4e70180d30f45c15adc65a Mon Sep 17 00:00:00 2001 +From: Mark H Weaver <mhw@netris.org> +Date: Sun, 28 Sep 2014 12:51:11 -0400 +Subject: peval: Handle optional argument inits that refer to previous + arguments. + +Fixes <http://bugs.gnu.org/17634>. +Reported by Josep Portella Florit <jpf@primfilat.com>. + +* module/language/tree-il/peval.scm (inlined-application): When inlining + an application whose operator is a lambda expression with optional + arguments that rely on default initializers, expand into a series of + nested let expressions, to ensure that previous arguments are in scope + when the default initializers are evaluated. + +* test-suite/tests/peval.test ("partial evaluation"): Add tests. + +Origin: http://git.savannah.gnu.org/cgit/guile.git/commit/?id=7a71a45cfd6092402d540e9bc5d2432941a8a336 +Added-by: Rob Browning <rlb@defaultvalue.org> +--- + module/language/tree-il/peval.scm | 94 +++++++++++++++++++++++++++++++-------- + test-suite/tests/peval.test | 86 ++++++++++++++++++++++++++++++++++- + 2 files changed, 160 insertions(+), 20 deletions(-) + +diff --git a/module/language/tree-il/peval.scm b/module/language/tree-il/peval.scm +index bd92edc..7dfbf6f 100644 +--- a/module/language/tree-il/peval.scm ++++ b/module/language/tree-il/peval.scm +@@ -1,6 +1,6 @@ + ;;; Tree-IL partial evaluator + +-;; Copyright (C) 2011, 2012, 2013 Free Software Foundation, Inc. ++;; Copyright (C) 2011-2014 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 +@@ -1313,24 +1313,80 @@ top-level bindings from ENV and return the resulting expression." + (nopt (if opt (length opt) 0)) + (key (source-expression proc))) + (define (inlined-application) +- (make-let src +- (append req +- (or opt '()) +- (if rest (list rest) '())) +- gensyms +- (if (> nargs (+ nreq nopt)) +- (append (list-head orig-args (+ nreq nopt)) +- (list +- (make-application +- #f +- (make-primitive-ref #f 'list) +- (drop orig-args (+ nreq nopt))))) +- (append orig-args +- (drop inits (- nargs nreq)) +- (if rest +- (list (make-const #f '())) +- '()))) +- body)) ++ (cond ++ ((= nargs (+ nreq nopt)) ++ (make-let src ++ (append req ++ (or opt '()) ++ (if rest (list rest) '())) ++ gensyms ++ (append orig-args ++ (if rest ++ (list (make-const #f '())) ++ '())) ++ body)) ++ ((> nargs (+ nreq nopt)) ++ (make-let src ++ (append req ++ (or opt '()) ++ (list rest)) ++ gensyms ++ (append (take orig-args (+ nreq nopt)) ++ (list (make-application ++ #f ++ (make-primitive-ref #f 'list) ++ (drop orig-args (+ nreq nopt))))) ++ body)) ++ (else ++ ;; Here we handle the case where nargs < nreq + nopt, ++ ;; so the rest argument (if any) will be empty, and ++ ;; there will be optional arguments that rely on their ++ ;; default initializers. ++ ;; ++ ;; The default initializers of optional arguments ++ ;; may refer to earlier arguments, so in the general ++ ;; case we must expand into a series of nested let ++ ;; expressions. ++ ;; ++ ;; In the generated code, the outermost let ++ ;; expression will bind all arguments provided by ++ ;; the application's argument list, as well as the ++ ;; empty rest argument, if any. Each remaining ++ ;; optional argument that relies on its default ++ ;; initializer will be bound within an inner let. ++ ;; ++ ;; rest-gensyms, rest-vars and rest-inits will have ++ ;; either 0 or 1 elements. They are oddly named, but ++ ;; allow simpler code below. ++ (let*-values ++ (((non-rest-gensyms rest-gensyms) ++ (split-at gensyms (+ nreq nopt))) ++ ((provided-gensyms default-gensyms) ++ (split-at non-rest-gensyms nargs)) ++ ((provided-vars default-vars) ++ (split-at (append req opt) nargs)) ++ ((rest-vars) ++ (if rest (list rest) '())) ++ ((rest-inits) ++ (if rest ++ (list (make-const #f '())) ++ '())) ++ ((default-inits) ++ (drop inits (- nargs nreq)))) ++ (make-let src ++ (append provided-vars rest-vars) ++ (append provided-gensyms rest-gensyms) ++ (append orig-args rest-inits) ++ (fold-right (lambda (var gensym init body) ++ (make-let src ++ (list var) ++ (list gensym) ++ (list init) ++ body)) ++ body ++ default-vars ++ default-gensyms ++ default-inits)))))) + + (cond + ((or (< nargs nreq) (and (not rest) (> nargs (+ nreq nopt)))) +diff --git a/test-suite/tests/peval.test b/test-suite/tests/peval.test +index 5b003d2..2183429 100644 +--- a/test-suite/tests/peval.test ++++ b/test-suite/tests/peval.test +@@ -1,7 +1,7 @@ + ;;;; tree-il.test --- test suite for compiling tree-il -*- scheme -*- + ;;;; Andy Wingo <wingo@pobox.com> --- May 2009 + ;;;; +-;;;; Copyright (C) 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc. ++;;;; Copyright (C) 2009-2014 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 +@@ -411,6 +411,90 @@ + (const 7)) + + (pass-if-peval ++ ;; Higher order with optional argument (default uses earlier argument). ++ ;; <http://bugs.gnu.org/17634> ++ ((lambda* (f x #:optional (y (+ 3 (car x)))) ++ (+ y (f (* (car x) (cadr x))))) ++ (lambda (x) ++ (+ x 1)) ++ '(2 3)) ++ (const 12)) ++ ++ (pass-if-peval ++ ;; Higher order with optional arguments ++ ;; (default uses earlier optional argument). ++ ((lambda* (f x #:optional (y (+ 3 (car x))) (z (+ (cadr x) y))) ++ (+ y z (f (* (car x) (cadr x))))) ++ (lambda (x) ++ (+ x 1)) ++ '(2 3)) ++ (const 20)) ++ ++ (pass-if-peval ++ ;; Higher order with optional arguments (one caller-supplied value, ++ ;; one default that uses earlier optional argument). ++ ((lambda* (f x #:optional (y (+ 3 (car x))) (z (+ (cadr x) y))) ++ (+ y z (f (* (car x) (cadr x))))) ++ (lambda (x) ++ (+ x 1)) ++ '(2 3) ++ -3) ++ (const 4)) ++ ++ (pass-if-peval ++ ;; Higher order with optional arguments (caller-supplied values). ++ ((lambda* (f x #:optional (y (+ 3 (car x))) (z (+ (cadr x) y))) ++ (+ y z (f (* (car x) (cadr x))))) ++ (lambda (x) ++ (+ x 1)) ++ '(2 3) ++ -3 ++ 17) ++ (const 21)) ++ ++ (pass-if-peval ++ ;; Higher order with optional and rest arguments (one ++ ;; caller-supplied value, one default that uses earlier optional ++ ;; argument). ++ ((lambda* (f x #:optional (y (+ 3 (car x))) (z (+ (cadr x) y)) ++ #:rest r) ++ (list r (+ y z (f (* (car x) (cadr x)))))) ++ (lambda (x) ++ (+ x 1)) ++ '(2 3) ++ -3) ++ (apply (primitive list) (const ()) (const 4))) ++ ++ (pass-if-peval ++ ;; Higher order with optional and rest arguments ++ ;; (caller-supplied values for optionals). ++ ((lambda* (f x #:optional (y (+ 3 (car x))) (z (+ (cadr x) y)) ++ #:rest r) ++ (list r (+ y z (f (* (car x) (cadr x)))))) ++ (lambda (x) ++ (+ x 1)) ++ '(2 3) ++ -3 ++ 17) ++ (apply (primitive list) (const ()) (const 21))) ++ ++ (pass-if-peval ++ ;; Higher order with optional and rest arguments ++ ;; (caller-supplied values for optionals and rest). ++ ((lambda* (f x #:optional (y (+ 3 (car x))) (z (+ (cadr x) y)) ++ #:rest r) ++ (list r (+ y z (f (* (car x) (cadr x)))))) ++ (lambda (x) ++ (+ x 1)) ++ '(2 3) ++ -3 ++ 17 ++ 8 ++ 3) ++ (let (r) (_) ((apply (primitive list) (const 8) (const 3))) ++ (apply (primitive list) (lexical r _) (const 21)))) ++ ++ (pass-if-peval + ;; Higher order with optional argument (caller-supplied value). + ((lambda* (f x #:optional (y 0)) + (+ y (f (* (car x) (cadr x))))) diff --git a/main/guile/APKBUILD b/main/guile/APKBUILD index d256a22b79d..aa46577a8e2 100644 --- a/main/guile/APKBUILD +++ b/main/guile/APKBUILD @@ -1,7 +1,7 @@ # Maintainer: Natanael Copa <ncopa@alpinelinux.org> pkgname=guile pkgver=2.0.11 -pkgrel=1 +pkgrel=2 pkgdesc="Guile is a portable, embeddable Scheme implementation written in C" url="http://www.gnu.org/software/guile/" arch="all" @@ -13,6 +13,16 @@ depends= depends_dev="guile gc-dev" install= source="ftp://ftp.gnu.org/pub/gnu/$pkgname/$pkgname-$pkgver.tar.gz + 0002-Mark-mutex-with-owner-not-retained-threads-test-as-u.patch + 0003-Recognize-more-ARM-targets.patch + 0008-VM-ASM_MUL-for-ARM-Add-earlyclobber-constraint-to-th.patch + 0009-VM-Allow-the-C-compiler-to-choose-FP_REG-on-ARM.patch + 0010-web-Keep-the-default-size-for-the-client-s-in-kernel.patch + 0011-Fix-shrinking-of-contiguous-bytevectors-as-from-get-.patch + 0013-Handle-p-in-format-warnings.patch + 0015-Fix-SCM_SMOB_OBJECT-_-_0_-_1_-_2_-_3_-LOC.patch + 0016-peval-Handle-optional-argument-inits-that-refer-to-p.patch + strtol_l.patch " @@ -49,8 +59,35 @@ package() { } md5sums="e532c68c6f17822561e3001136635ddd guile-2.0.11.tar.gz +00b381cff020d6b43de150a99d08d955 0002-Mark-mutex-with-owner-not-retained-threads-test-as-u.patch +f140776c944bacc6cc14919f83902696 0003-Recognize-more-ARM-targets.patch +16b1a41f9cc22b2b177200a6f3961752 0008-VM-ASM_MUL-for-ARM-Add-earlyclobber-constraint-to-th.patch +25ed9239ec91a1fb78f6c4947125554f 0009-VM-Allow-the-C-compiler-to-choose-FP_REG-on-ARM.patch +4bed81aa62ff7a4b6b0cf223efce6a5f 0010-web-Keep-the-default-size-for-the-client-s-in-kernel.patch +36cd7ea5a15ace11c9c37f424baba09d 0011-Fix-shrinking-of-contiguous-bytevectors-as-from-get-.patch +9e7b0d2d52e22b253ac314c6cb317bb4 0013-Handle-p-in-format-warnings.patch +9bb62ca4bd913b5ba6a94868a2d33464 0015-Fix-SCM_SMOB_OBJECT-_-_0_-_1_-_2_-_3_-LOC.patch +04012be1e50736374564b14440e410f6 0016-peval-Handle-optional-argument-inits-that-refer-to-p.patch 54b76be46ecc9333e2a57cc0906c1927 strtol_l.patch" sha256sums="e6786c934346fa2e38e46d8d81a622bb1c16d130153523f6129fcd79ef1fb040 guile-2.0.11.tar.gz +760355a63be9b756607a03352ceb916dfba02da917fa00c6bc07253d0f7c75f6 0002-Mark-mutex-with-owner-not-retained-threads-test-as-u.patch +1b438b5b513f6711c098a54944f907e4b4744bfd1b9315fb8bc33c67a1481952 0003-Recognize-more-ARM-targets.patch +10c710b4e4cba8a99d5f6ca1fd24653f5f67ed6fd3263b551678648713bdc049 0008-VM-ASM_MUL-for-ARM-Add-earlyclobber-constraint-to-th.patch +9247fdd64b5bc8dc8e3b233156a6b6027c7b06778729773d5c360f16c1f85fd3 0009-VM-Allow-the-C-compiler-to-choose-FP_REG-on-ARM.patch +36a05b4aee0135897ab1322762931c5ee4ee1e9d153ec46e69c5bc1954552788 0010-web-Keep-the-default-size-for-the-client-s-in-kernel.patch +b7b3425c807d227dccf0ada653d3edd6d343d6c9d7ee648140bd13812f7776e7 0011-Fix-shrinking-of-contiguous-bytevectors-as-from-get-.patch +3557178fec43d58c62a505a3199054d4f32da97cfafaa969a8e9b90616bc603f 0013-Handle-p-in-format-warnings.patch +4ded8227e4b93a5205ddcf43f01e0e8c7684396669192b2e95b2c710573b6395 0015-Fix-SCM_SMOB_OBJECT-_-_0_-_1_-_2_-_3_-LOC.patch +d28837b89c1653d9addf80573934dc97128a0c464b531f64fc58b1577f60340a 0016-peval-Handle-optional-argument-inits-that-refer-to-p.patch 2ba49adb27db50f5ec33779ce2f002cafde99a04038ca689bee7d2098296ce33 strtol_l.patch" sha512sums="dc1a30d44e6d432fab2407d72385e959af863f6feba6cca5813b4de24c92200c78b44f336d1f4fa8c7b4058dea880982787c69888c91a2236fd2fb1d313137fd guile-2.0.11.tar.gz +b1c309cc07830ff1741ef88857f8099187b449580e8d57862886abc367ef1accc5a35636d81eee09247f13d3a751cdc8909fdea05368d3d509bd2039ce06d078 0002-Mark-mutex-with-owner-not-retained-threads-test-as-u.patch +0d3a5fd9ebd34d65f9c5534ea87a161099f4e0d1aae0153226962776ad0b823becd1688fe431c8425968d44377aec5ba2f81865924652125f6356b5f9d993101 0003-Recognize-more-ARM-targets.patch +b283ac11ca5d01a4ab102258ff896fb3fb6cb053144ea31ae0d43c0229c9b9509c4eadc90d757b232a3c5421f39a83107893a3cd2c06551a4b822ab82f1ba4fc 0008-VM-ASM_MUL-for-ARM-Add-earlyclobber-constraint-to-th.patch +44ed0295e4f07bec155f14d6d77e6cde36be0517f594c2304d0dc21956bdc5235586a52f1a46ddc5e2bc9106c3cc4cdac14916c6e61aaca7ffa9139dd166e02e 0009-VM-Allow-the-C-compiler-to-choose-FP_REG-on-ARM.patch +58d0531f5a5a641187e3fadd8fd3951f18751531617f0eb10da59c8b8e7686329a3e1905b888496932daf2be0dd4597231268dee3e3853448e721337ade70b37 0010-web-Keep-the-default-size-for-the-client-s-in-kernel.patch +3ad38f8ed820751203e263d58b035304d0bb1f8815d4bcd4f4d2e292acc6a2f8c3d2a2287e48520386cd9fc785e179d2f8f1f4b9252bdbba817de06ab5df7ab1 0011-Fix-shrinking-of-contiguous-bytevectors-as-from-get-.patch +8484e882723d68ea1e658a86c7be5006de1af7d457f7f9a37a99b427460db8420980174efdcaff8fbfa49346ba01252d2e6183c8b5e323bd228d223ed011655b 0013-Handle-p-in-format-warnings.patch +5f450e57968f2f0592a0de6beaa02db315d668a31a85330e3aa44d87995c82f866828fceb71012c123f5dd3b3b5c3ec944c8011ba09658ad00e8ce1c6f958a87 0015-Fix-SCM_SMOB_OBJECT-_-_0_-_1_-_2_-_3_-LOC.patch +f55e514534fd1aba547ed8d4350fbeeaef77d634d7f1915a0108244a9bef5afe7074f3292b9f74bdccd0c56cddc60e222e9ccd2519ba337b6f156123e632ec26 0016-peval-Handle-optional-argument-inits-that-refer-to-p.patch 596efb03c65df98ea9afd932cb67e5b436e35fbf2442630e8a1854818f246b5a24eb920e3502ba28b882f0afb27c5148f1ff509c29baa91a7f37b3ecdc28c000 strtol_l.patch" |