[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] GNU Guile branch, master, updated. release_1-9-4-19-g04c
|
From: |
Ludovic Courtès |
|
Subject: |
[Guile-commits] GNU Guile branch, master, updated. release_1-9-4-19-g04c68c0 |
|
Date: |
Thu, 22 Oct 2009 20:59:03 +0000 |
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=04c68c039194f33d5bd7e8b1f21eba7c8bd6adbe
The branch, master has been updated
via 04c68c039194f33d5bd7e8b1f21eba7c8bd6adbe (commit)
via 84012ef4b1188770d8087ad82289dbdc27a3adfb (commit)
via 6bb891dc6137885182f86aa147dba428e1149a63 (commit)
via 3c365b8efcee9e953b0cad8085ca14f4b0d5d7d5 (commit)
from 9c2224f2a616bc4fb3fca7947d65c44c6c66ffdf (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 04c68c039194f33d5bd7e8b1f21eba7c8bd6adbe
Author: Ludovic Courtès <address@hidden>
Date: Thu Oct 22 22:58:03 2009 +0200
Compile Guile modules with `-Wunbound-variable'.
* am/guilec (.scm.go): Compile with `-Wunbound-variable'.
commit 84012ef4b1188770d8087ad82289dbdc27a3adfb
Author: Ludovic Courtès <address@hidden>
Date: Thu Oct 22 22:42:45 2009 +0200
Fix typos leading to unbound variable references.
* module/ice-9/session.scm (help): Fix unbound reference to `env'.
* module/system/vm/program.scm (program-property): Fix typo.
* module/system/vm/frame.scm: Add missing `#:use-module (system vm
objcode)'.
* module/system/repl/command.scm (guile:load): New.
(load): Use either `primitive-load' or `load'.
* module/srfi/srfi-18.scm (thread-sleep!): Fix typo.
* module/srfi/srfi-19.scm: Use `(ice-9 rdelim)'.
(date->broken-down-time, priv:year-day, priv:char->int): Fix typo.
(time-*->time-*, time-*->time-*!): Fix reference to unbound variable
`caller'.
* module/oop/goops.scm (bound-check-get): Fix typo.
* module/language/glil/compile-assembly.scm (glil->assembly): Fix typo.
* module/language/glil.scm (parse-glil): Fix typo.
* module/language/ecmascript/base.scm (object->value/string,
object->value/number, ->number): Fix typos.
* module/language/assembly/disassemble.scm (disassemble-free-vars): Fix
typo.
commit 6bb891dc6137885182f86aa147dba428e1149a63
Author: Ludovic Courtès <address@hidden>
Date: Thu Oct 22 22:33:53 2009 +0200
Adjust `unbound-variable' GOOPS heuristic for `goops.scm'.
* module/language/tree-il/analyze.scm (goops-toplevel-definition): Add
ENV argument. Deal with GOOPS macros expanded within `goops.scm'.
(report-possibly-unbound-variables): Adjust.
commit 3c365b8efcee9e953b0cad8085ca14f4b0d5d7d5
Author: Ludovic Courtès <address@hidden>
Date: Thu Oct 22 22:29:22 2009 +0200
Fix bytecode disassembler.
* module/language/assembly/decompile-bytecode.scm (decode-load-program):
Add missing argument to `ensure-label'.
-----------------------------------------------------------------------
Summary of changes:
am/guilec | 4 ++-
module/ice-9/session.scm | 5 ++-
module/language/assembly/decompile-bytecode.scm | 2 +-
module/language/assembly/disassemble.scm | 2 +-
module/language/ecmascript/base.scm | 10 +++---
module/language/glil.scm | 2 +-
module/language/glil/compile-assembly.scm | 4 +-
module/language/tree-il/analyze.scm | 25 ++++++++++++-----
module/oop/goops.scm | 2 +-
module/srfi/srfi-18.scm | 4 +-
module/srfi/srfi-19.scm | 33 ++++++++++++++--------
module/system/repl/command.scm | 10 +++---
module/system/vm/frame.scm | 4 +-
module/system/vm/program.scm | 2 +-
14 files changed, 65 insertions(+), 44 deletions(-)
diff --git a/am/guilec b/am/guilec
index ce0711b..00366d8 100644
--- a/am/guilec
+++ b/am/guilec
@@ -30,4 +30,6 @@ install-data-hook:
SUFFIXES = .scm .go
.scm.go:
- GUILE_AUTO_COMPILE=0 $(top_builddir)/meta/uninstalled-env guile-tools
compile -o "$@" "$<"
+ GUILE_AUTO_COMPILE=0 \
+ $(top_builddir)/meta/uninstalled-env \
+ guile-tools compile -Wunbound-variable -o "$@" "$<"
diff --git a/module/ice-9/session.scm b/module/ice-9/session.scm
index 1f3ec27..70708c3 100644
--- a/module/ice-9/session.scm
+++ b/module/ice-9/session.scm
@@ -1,4 +1,4 @@
-;;;; Copyright (C) 1997, 2000, 2001, 2003, 2006 Free Software Foundation,
Inc.
+;;;; Copyright (C) 1997, 2000, 2001, 2003, 2006, 2009 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
@@ -112,7 +112,8 @@ You don't seem to have regular expressions installed.\n")
(= (length name) 2)
(eq? (car name) 'unquote))
(let ((doc (try-value-help (cadr name)
- (local-eval (cadr name) env))))
+ (module-ref (current-module)
+ (cadr name)))))
(cond ((not doc) (not-found 'documentation (cadr name)))
((eq? doc #t)) ;; pass
(else (write-line doc)))))
diff --git a/module/language/assembly/decompile-bytecode.scm
b/module/language/assembly/decompile-bytecode.scm
index 915e101..559abea 100644
--- a/module/language/assembly/decompile-bytecode.scm
+++ b/module/language/assembly/decompile-bytecode.scm
@@ -89,7 +89,7 @@
((,br ,rel1 ,rel2 ,rel3) (guard (br-instruction? br))
(lp (cons `(,br ,(ensure-label rel1 rel2 rel3)) out)))
((mv-call ,n ,rel1 ,rel2 ,rel3)
- (lp (cons `(mv-call ,n ,(ensure-label rel1 rel2)) out)))
+ (lp (cons `(mv-call ,n ,(ensure-label rel1 rel2 rel3)) out)))
(else
(lp (cons exp out))))))))))
diff --git a/module/language/assembly/disassemble.scm
b/module/language/assembly/disassemble.scm
index ed2a82f..c7b9df9 100644
--- a/module/language/assembly/disassemble.scm
+++ b/module/language/assembly/disassemble.scm
@@ -95,7 +95,7 @@
(define (disassemble-free-vars free-vars)
(display "Free variables:\n\n")
- (let ((i 0))
+ (let lp ((i 0))
(cond ((< i (vector-length free-vars))
(print-info i (vector-ref free-vars i) #f #f)
(lp (1+ i))))))
diff --git a/module/language/ecmascript/base.scm
b/module/language/ecmascript/base.scm
index f133bb0..b244bec 100644
--- a/module/language/ecmascript/base.scm
+++ b/module/language/ecmascript/base.scm
@@ -149,14 +149,14 @@
o))))
(define (object->value/string o)
- (if (is-a? x <js-object>)
+ (if (is-a? o <js-object>)
(object->number o #t)
- x))
+ o))
(define (object->value/number o)
- (if (is-a? x <js-object>)
+ (if (is-a? o <js-object>)
(object->string o #t)
- x))
+ o))
(define (object->value o)
;; FIXME: if it's a date, we should try numbers first
@@ -176,7 +176,7 @@
((boolean? x) (if x 1 0))
((null? x) 0)
((eq? x *undefined*) +nan.0)
- ((is-a? x <js-object>) (object->number o))
+ ((is-a? x <js-object>) (object->number x))
((string? x) (string->number x))
(else (throw 'TypeError o '->number))))
diff --git a/module/language/glil.scm b/module/language/glil.scm
index 0777073..bfe81ef 100644
--- a/module/language/glil.scm
+++ b/module/language/glil.scm
@@ -105,7 +105,7 @@
((toplevel ,op ,name) (make-glil-toplevel op name))
((module public ,op ,mod ,name) (make-glil-module op mod name #t))
((module private ,op ,mod ,name) (make-glil-module op mod name #f))
- ((label ,label) (make-label label))
+ ((label ,label) (make-glil-label label))
((branch ,inst ,label) (make-glil-branch inst label))
((call ,inst ,nargs) (make-glil-call inst nargs))
((mv-call ,nargs ,ra) (make-glil-mv-call nargs ra))
diff --git a/module/language/glil/compile-assembly.scm
b/module/language/glil/compile-assembly.scm
index 121d9db..1bae321 100644
--- a/module/language/glil/compile-assembly.scm
+++ b/module/language/glil/compile-assembly.scm
@@ -262,8 +262,8 @@
((empty-box) `((empty-box ,index)))
((fix) `((fix-closure 0 ,index)))
(else (error "what" op)))
- (let ((a (quotient i 256))
- (b (modulo i 256)))
+ (let ((a (quotient index 256))
+ (b (modulo index 256)))
`((,(case op
((ref)
(if boxed?
diff --git a/module/language/tree-il/analyze.scm
b/module/language/tree-il/analyze.scm
index 352462f..d689559 100644
--- a/module/language/tree-il/analyze.scm
+++ b/module/language/tree-il/analyze.scm
@@ -633,21 +633,29 @@
(defs toplevel-info-defs) ;; (VARIABLE-NAME ...)
(locs toplevel-info-locs)) ;; (LOCATION ...)
-(define (goops-toplevel-definition proc args)
+(define (goops-toplevel-definition proc args env)
;; If application of PROC to ARGS is a GOOPS top-level definition, return
;; the name of the variable being defined; otherwise return #f. This
;; assumes knowledge of the current implementation of `define-class' et al.
+ (define (toplevel-define-arg args)
+ (and (pair? args) (pair? (cdr args)) (null? (cddr args))
+ (record-case (car args)
+ ((<const> exp)
+ (and (symbol? exp) exp))
+ (else #f))))
+
(record-case proc
((<module-ref> mod public? name)
(and (equal? mod '(oop goops))
(not public?)
(eq? name 'toplevel-define!)
- (pair? args) (pair? (cdr args)) (null? (cddr args))
- (record-case (car args)
- ((<const> exp)
- (and (symbol? exp)
- exp))
- (else #f))))
+ (toplevel-define-arg args)))
+ ((<toplevel-ref> name)
+ ;; This may be the result of expanding one of the GOOPS macros within
+ ;; `oop/goops.scm'.
+ (and (eq? name 'toplevel-define!)
+ (eq? env (resolve-module '(oop goops)))
+ (toplevel-define-arg args)))
(else #f)))
;; TODO: Combine with `report-unused-variables' so we don't traverse the tree
@@ -703,7 +711,8 @@
((<application> proc args)
;; Check for a dynamic top-level definition, as is
;; done by code expanded from GOOPS macros.
- (let ((name (goops-toplevel-definition proc args)))
+ (let ((name (goops-toplevel-definition proc args
+ env)))
(if (symbol? name)
(make-toplevel-info (alist-delete name refs
eq?)
diff --git a/module/oop/goops.scm b/module/oop/goops.scm
index a47c4ee..7871c2f 100644
--- a/module/oop/goops.scm
+++ b/module/oop/goops.scm
@@ -1157,7 +1157,7 @@
(define-standard-accessor-method ((bound-check-get n) o)
(let ((x (@slot-ref o n)))
(if (unbound? x)
- (slot-unbound obj)
+ (slot-unbound o)
x)))
(define-standard-accessor-method ((standard-get n) o)
diff --git a/module/srfi/srfi-18.scm b/module/srfi/srfi-18.scm
index 26acb63..4a171b4 100644
--- a/module/srfi/srfi-18.scm
+++ b/module/srfi/srfi-18.scm
@@ -1,6 +1,6 @@
;;; srfi-18.scm --- Multithreading support
-;; Copyright (C) 2008 Free Software Foundation, Inc.
+;; Copyright (C) 2008, 2009 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
@@ -232,7 +232,7 @@
(let* ((ct (time->seconds (current-time)))
(t (cond ((time? timeout) (- (time->seconds timeout) ct))
((number? timeout) (- timeout ct))
- (else (scm-error 'wrong-type-arg caller
+ (else (scm-error 'wrong-type-arg "thread-sleep!"
"Wrong type argument: ~S"
(list timeout)
'()))))
diff --git a/module/srfi/srfi-19.scm b/module/srfi/srfi-19.scm
index ba13c03..2820615 100644
--- a/module/srfi/srfi-19.scm
+++ b/module/srfi/srfi-19.scm
@@ -42,6 +42,7 @@
:use-module (srfi srfi-6)
:use-module (srfi srfi-8)
:use-module (srfi srfi-9)
+ :autoload (ice-9 rdelim) (read-line)
:use-module (ice-9 i18n))
(begin-deprecated
@@ -300,7 +301,7 @@
(set-tm:hour result (date-hour date))
;; FIXME: SRFI day ranges from 0-31. (not compatible with set-tm:mday).
(set-tm:mday result (date-day date))
- (set-tm:month result (- (date-month date) 1))
+ (set-tm:mon result (- (date-month date) 1))
;; FIXME: need to signal error on range violation.
(set-tm:year result (+ 1900 (date-year date)))
(set-tm:isdst result -1)
@@ -489,33 +490,38 @@
;; -- these depend on time-monotonic having the same definition as time-tai!
(define (time-monotonic->time-utc time-in)
(if (not (eq? (time-type time-in) time-monotonic))
- (priv:time-error caller 'incompatible-time-types time-in))
+ (priv:time-error 'time-monotonic->time-utc
+ 'incompatible-time-types time-in))
(let ((ntime (copy-time time-in)))
(set-time-type! ntime time-tai)
(priv:time-tai->time-utc! ntime ntime 'time-monotonic->time-utc)))
(define (time-monotonic->time-utc! time-in)
(if (not (eq? (time-type time-in) time-monotonic))
- (priv:time-error caller 'incompatible-time-types time-in))
+ (priv:time-error 'time-monotonic->time-utc!
+ 'incompatible-time-types time-in))
(set-time-type! time-in time-tai)
- (priv:time-tai->time-utc! ntime ntime 'time-monotonic->time-utc))
+ (priv:time-tai->time-utc! time-in time-in 'time-monotonic->time-utc))
(define (time-monotonic->time-tai time-in)
(if (not (eq? (time-type time-in) time-monotonic))
- (priv:time-error caller 'incompatible-time-types time-in))
+ (priv:time-error 'time-monotonic->time-tai
+ 'incompatible-time-types time-in))
(let ((ntime (copy-time time-in)))
(set-time-type! ntime time-tai)
ntime))
(define (time-monotonic->time-tai! time-in)
(if (not (eq? (time-type time-in) time-monotonic))
- (priv:time-error caller 'incompatible-time-types time-in))
+ (priv:time-error 'time-monotonic->time-tai!
+ 'incompatible-time-types time-in))
(set-time-type! time-in time-tai)
time-in)
(define (time-utc->time-monotonic time-in)
(if (not (eq? (time-type time-in) time-utc))
- (priv:time-error caller 'incompatible-time-types time-in))
+ (priv:time-error 'time-utc->time-monotonic
+ 'incompatible-time-types time-in))
(let ((ntime (priv:time-utc->time-tai! time-in (make-time-unnormalized #f #f
#f)
'time-utc->time-monotonic)))
(set-time-type! ntime time-monotonic)
@@ -523,7 +529,8 @@
(define (time-utc->time-monotonic! time-in)
(if (not (eq? (time-type time-in) time-utc))
- (priv:time-error caller 'incompatible-time-types time-in))
+ (priv:time-error 'time-utc->time-monotonic!
+ 'incompatible-time-types time-in))
(let ((ntime (priv:time-utc->time-tai! time-in time-in
'time-utc->time-monotonic!)))
(set-time-type! ntime time-monotonic)
@@ -531,14 +538,16 @@
(define (time-tai->time-monotonic time-in)
(if (not (eq? (time-type time-in) time-tai))
- (priv:time-error caller 'incompatible-time-types time-in))
+ (priv:time-error 'time-tai->time-monotonic
+ 'incompatible-time-types time-in))
(let ((ntime (copy-time time-in)))
(set-time-type! ntime time-monotonic)
ntime))
(define (time-tai->time-monotonic! time-in)
(if (not (eq? (time-type time-in) time-tai))
- (priv:time-error caller 'incompatible-time-types time-in))
+ (priv:time-error 'time-tai->time-monotonic!
+ 'incompatible-time-types time-in))
(set-time-type! time-in time-monotonic)
time-in)
@@ -741,7 +750,7 @@
(define (priv:year-day day month year)
(let ((days-pr (assoc month priv:month-assoc)))
(if (not days-pr)
- (priv:error 'date-year-day 'invalid-month-specification month))
+ (priv:time-error 'date-year-day 'invalid-month-specification month))
(if (and (priv:leap-year? year) (> month 2))
(+ day (cdr days-pr) 1)
(+ day (cdr days-pr)))))
@@ -1216,7 +1225,7 @@
((#\8) 8)
((#\9) 9)
(else (priv:time-error 'bad-date-template-string
- (list "Non-integer character" ch i)))))
+ (list "Non-integer character" ch)))))
;; read an integer upto n characters long on port; upto -> #f is any length
(define (priv:integer-reader upto port)
diff --git a/module/system/repl/command.scm b/module/system/repl/command.scm
index 66e2fb4..1da2d6c 100644
--- a/module/system/repl/command.scm
+++ b/module/system/repl/command.scm
@@ -267,16 +267,16 @@ Import modules / List those imported."
(for-each puts (map module-name (module-uses (current-module))))
(for-each use args))))
+(define guile:load load)
(define-meta-command (load repl file . opts)
"load FILE
Load a file in the current module.
-f Load source file (see `compile')"
- (let* ((file (->string file))
- (objcode (if (memq #:f opts)
- (apply load-source-file file opts)
- (apply load-file file opts))))
- (vm-load (repl-vm repl) objcode)))
+ (let ((file (->string file)))
+ (if (memq #:f opts)
+ (primitive-load file)
+ (guile:load file))))
(define-meta-command (binding repl)
"binding
diff --git a/module/system/vm/frame.scm b/module/system/vm/frame.scm
index 332cd61..be85fb7 100644
--- a/module/system/vm/frame.scm
+++ b/module/system/vm/frame.scm
@@ -1,7 +1,6 @@
;;; Guile VM frame functions
-;;; Copyright (C) 2001, 2009 Free Software Foundation, Inc.
-;;; Copyright (C) 2005 Ludovic Courtès <address@hidden>
+;;; Copyright (C) 2001, 2005, 2009 Free Software Foundation, Inc.
;;;
;;; This program is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
@@ -22,6 +21,7 @@
(define-module (system vm frame)
#:use-module (system vm program)
#:use-module (system vm instruction)
+ #:use-module (system vm objcode)
#:use-module ((srfi srfi-1) #:select (fold))
#:export (vm-frame?
vm-frame-program
diff --git a/module/system/vm/program.scm b/module/system/vm/program.scm
index 755c606..72ec479 100644
--- a/module/system/vm/program.scm
+++ b/module/system/vm/program.scm
@@ -59,7 +59,7 @@
(cdddr source))
(define (program-property prog prop)
- (assq-ref (program-properties proc) prop))
+ (assq-ref (program-properties prog) prop))
(define (program-documentation prog)
(assq-ref (program-properties prog) 'documentation))
hooks/post-receive
--
GNU Guile
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Guile-commits] GNU Guile branch, master, updated. release_1-9-4-19-g04c68c0,
Ludovic Courtès <=