summaryrefslogtreecommitdiff
path: root/module
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2012-06-22 13:18:02 +0200
committerAndy Wingo <wingo@pobox.com>2012-06-22 13:18:02 +0200
commit0dd7c5407599b65a1a3da4b9bd8feccc715b51f7 (patch)
tree7e54c75087c5ea3f876bcb54cc49c70ec87ae0b5 /module
parent747747ee06ac64c224b91e8f64f810a1159c1675 (diff)
parent2874f66017b7bfae256e85af84689d00ecc418ab (diff)
downloadguile-0dd7c5407599b65a1a3da4b9bd8feccc715b51f7.tar.gz
Merge remote-tracking branch 'origin/stable-2.0'
Conflicts: libguile/deprecated.c libguile/ports.c libguile/ports.h libguile/strports.c test-suite/tests/cse.test
Diffstat (limited to 'module')
-rw-r--r--module/ice-9/command-line.scm2
-rw-r--r--module/ice-9/ftw.scm19
-rw-r--r--module/ice-9/match.scm4
-rw-r--r--module/ice-9/match.upstream.scm4
-rw-r--r--module/ice-9/pretty-print.scm7
-rw-r--r--module/language/ecmascript/base.scm6
-rw-r--r--module/language/tree-il/cse.scm4
-rw-r--r--module/language/tree-il/primitives.scm3
-rw-r--r--module/oop/goops/dispatch.scm15
-rw-r--r--module/srfi/srfi-6.scm18
10 files changed, 53 insertions, 29 deletions
diff --git a/module/ice-9/command-line.scm b/module/ice-9/command-line.scm
index 8aed74ec6..62a2c9e4f 100644
--- a/module/ice-9/command-line.scm
+++ b/module/ice-9/command-line.scm
@@ -66,7 +66,7 @@ There is NO WARRANTY, to the extent permitted by law."))
(define* (version-etc package version #:key
(port (current-output-port))
;; FIXME: authors
- (copyright-year 2011)
+ (copyright-year 2012)
(copyright-holder "Free Software Foundation, Inc.")
(copyright (format #f "Copyright (C) ~a ~a"
copyright-year copyright-holder))
diff --git a/module/ice-9/ftw.scm b/module/ice-9/ftw.scm
index 96422b5e4..6c9db27ee 100644
--- a/module/ice-9/ftw.scm
+++ b/module/ice-9/ftw.scm
@@ -538,26 +538,29 @@ of file names is sorted according to ENTRY<?, which defaults to
(define (enter? dir stat result)
(and stat (string=? dir name)))
- (define (leaf name stat result)
- (if (select? name)
- (and (pair? result) ; must have a "." entry
- (cons (basename name) result))
+ (define (visit basename result)
+ (if (select? basename)
+ (cons basename result)
result))
+ (define (leaf name stat result)
+ (and result
+ (visit (basename name) result)))
+
(define (down name stat result)
- (list "."))
+ (visit "." '()))
(define (up name stat result)
- (cons ".." result))
+ (visit ".." result))
(define (skip name stat result)
;; All the sub-directories are skipped.
- (cons (basename name) result))
+ (visit (basename name) result))
(define (error name* stat errno result)
(if (string=? name name*) ; top-level NAME is unreadable
result
- (cons (basename name*) result)))
+ (visit (basename name*) result)))
(and=> (file-system-fold enter? leaf down up skip error #f name stat)
(lambda (files)
diff --git a/module/ice-9/match.scm b/module/ice-9/match.scm
index 4b078c69f..7fd191a11 100644
--- a/module/ice-9/match.scm
+++ b/module/ice-9/match.scm
@@ -1,6 +1,6 @@
;;; -*- mode: scheme; coding: utf-8; -*-
;;;
-;;; Copyright (C) 2010, 2011 Free Software Foundation, Inc.
+;;; Copyright (C) 2010, 2011, 2012 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
@@ -52,7 +52,7 @@
;; `match' doesn't support clauses of the form `(pat => exp)'.
;; Unmodified public domain code by Alex Shinn retrieved from
-;; the Chibi-Scheme repository, commit 876:528cdab3f818.
+;; the Chibi-Scheme repository, commit 1206:acd808700e91.
;;
;; Note: Make sure to update `match.test.upstream' when updating this
;; file.
diff --git a/module/ice-9/match.upstream.scm b/module/ice-9/match.upstream.scm
index 978655667..29f9dbe2e 100644
--- a/module/ice-9/match.upstream.scm
+++ b/module/ice-9/match.upstream.scm
@@ -210,6 +210,7 @@
;; performance can be found at
;; http://synthcode.com/scheme/match-cond-expand.scm
;;
+;; 2012/05/23 - fixing combinatorial explosion of code in certain or patterns
;; 2011/09/25 - fixing bug when directly matching an identifier repeated in
;; the pattern (thanks to Stefan Israelsson Tampe)
;; 2011/01/27 - fixing bug when matching tail patterns against improper lists
@@ -479,7 +480,8 @@
(match-one v p . x))
((_ v (p . q) g+s sk fk i)
;; match one and try the remaining on failure
- (match-one v p g+s sk (match-gen-or-step v q g+s sk fk i) i))
+ (let ((fk2 (lambda () (match-gen-or-step v q g+s sk fk i))))
+ (match-one v p g+s sk (fk2) i)))
))
;; We match a pattern (p ...) by matching the pattern p in a loop on
diff --git a/module/ice-9/pretty-print.scm b/module/ice-9/pretty-print.scm
index bf45eed42..5c23cb009 100644
--- a/module/ice-9/pretty-print.scm
+++ b/module/ice-9/pretty-print.scm
@@ -320,9 +320,10 @@ sub-expression, via the @var{breadth-first?} keyword argument."
(let ((e "…"))
(catch 'encoding-error
(lambda ()
- (with-output-to-string
- (lambda ()
- (display e))))
+ (with-fluids ((%default-port-conversion-strategy 'error))
+ (with-output-to-string
+ (lambda ()
+ (display e)))))
(lambda (key . args)
"..."))))
diff --git a/module/language/ecmascript/base.scm b/module/language/ecmascript/base.scm
index b244bec01..6f5c65ba5 100644
--- a/module/language/ecmascript/base.scm
+++ b/module/language/ecmascript/base.scm
@@ -92,7 +92,7 @@
(pdel o (string->symbol p)))
(define-method (has-property? (o <js-object>) p)
- (if (hashq-get-handle (js-props o) v)
+ (if (hashq-get-handle (js-props o) p)
#t
(let ((proto (js-prototype o)))
(if proto
@@ -176,9 +176,9 @@
((boolean? x) (if x 1 0))
((null? x) 0)
((eq? x *undefined*) +nan.0)
- ((is-a? x <js-object>) (object->number x))
+ ((is-a? x <js-object>) (object->number x #t))
((string? x) (string->number x))
- (else (throw 'TypeError o '->number))))
+ (else (throw 'TypeError x '->number))))
(define (->integer x)
(let ((n (->number x)))
diff --git a/module/language/tree-il/cse.scm b/module/language/tree-il/cse.scm
index 1ac221eaa..40f6419e2 100644
--- a/module/language/tree-il/cse.scm
+++ b/module/language/tree-il/cse.scm
@@ -270,11 +270,11 @@
#f)))
(_
(cond
- ((find-dominating-expression exp effects #f db)
+ ((find-dominating-expression exp effects 'test db)
;; We have an EXP fact, so we infer #t.
(log 'inferring exp #t)
(make-const (tree-il-src exp) #t))
- ((find-dominating-expression (negate exp 'test) effects #f db)
+ ((find-dominating-expression (negate exp 'test) effects 'test db)
;; We have a (not EXP) fact, so we infer #f.
(log 'inferring exp #f)
(make-const (tree-il-src exp) #f))
diff --git a/module/language/tree-il/primitives.scm b/module/language/tree-il/primitives.scm
index a44bc1acc..18126863c 100644
--- a/module/language/tree-il/primitives.scm
+++ b/module/language/tree-il/primitives.scm
@@ -55,6 +55,8 @@
char<? char<=? char>=? char>?
+ integer->char char->integer number->string string->number
+
acons cons cons*
list vector
@@ -155,6 +157,7 @@
pair? null? list? symbol? vector? struct? string? number? char? nil
complex? real? rational? inf? nan? integer? exact? inexact? even? odd?
char<? char<=? char>=? char>?
+ integer->char char->integer number->string string->number
struct-vtable
string-length vector-length
;; These all should get expanded out by expand-primitives!.
diff --git a/module/oop/goops/dispatch.scm b/module/oop/goops/dispatch.scm
index b12ab15fa..de5359f3c 100644
--- a/module/oop/goops/dispatch.scm
+++ b/module/oop/goops/dispatch.scm
@@ -25,6 +25,7 @@
#:use-module (oop goops)
#:use-module (oop goops util)
#:use-module (oop goops compile)
+ #:use-module (system base target)
#:export (memoize-method!)
#:no-backtrace)
@@ -178,11 +179,15 @@
'())
(acons gf gf-sym '()))))
(define (comp exp vals)
- (let ((p ((@ (system base compile) compile) exp
- #:env *dispatch-module*
- #:opts '(#:partial-eval? #f #:cse? #f))))
- (apply p vals)))
-
+ ;; When cross-compiling Guile itself, the native Guile must generate
+ ;; code for the host.
+ (with-target %host-type
+ (lambda ()
+ (let ((p ((@ (system base compile) compile) exp
+ #:env *dispatch-module*
+ #:opts '(#:partial-eval? #f #:cse? #f))))
+ (apply p vals)))))
+
;; kick it.
(scan))
diff --git a/module/srfi/srfi-6.scm b/module/srfi/srfi-6.scm
index 098b586cc..7b8bcb114 100644
--- a/module/srfi/srfi-6.scm
+++ b/module/srfi/srfi-6.scm
@@ -1,6 +1,6 @@
;;; srfi-6.scm --- Basic String Ports
-;; Copyright (C) 2001, 2002, 2003, 2006 Free Software Foundation, Inc.
+;; Copyright (C) 2001, 2002, 2003, 2006, 2012 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,10 +23,20 @@
;;; Code:
(define-module (srfi srfi-6)
- #:re-export (open-input-string open-output-string get-output-string))
+ #:replace (open-input-string open-output-string)
+ #:re-export (get-output-string))
-;; Currently, guile provides these functions by default, so no action
-;; is needed, and this file is just a placeholder.
+;; SRFI-6 says nothing about encodings, and assumes that any character
+;; or string can be written to a string port. Thus, make all SRFI-6
+;; string ports Unicode capable. See <http://bugs.gnu.org/11197>.
+
+(define (open-input-string s)
+ (with-fluids ((%default-port-encoding "UTF-8"))
+ ((@ (guile) open-input-string) s)))
+
+(define (open-output-string)
+ (with-fluids ((%default-port-encoding "UTF-8"))
+ ((@ (guile) open-output-string))))
(cond-expand-provide (current-module) '(srfi-6))