letrec bug

letrec bug

[Bill Schottstaedt]

I believe this shows a bug in letrec:

guile> (let ((x 1)) (let ((x 32) (y x)) y))
1
guile> (let ((x 1)) (letrec ((x 32) (y x)) y))

Backtrace:
In standard input:
   2: 0* (let* ((x 1)) (letrec ((x 32) (y x)) y))
   2: 1  (letrec ((x 32) (y x)) y)

standard input:2:14: In expression (letrec (# #) y):
standard input:2:14: Variable used before given a value: x
ABORT: (unbound-variable)

Re: letrec bug

[Mikael Djurfeldt]

2008/10/28 Bill Schottstaedt <bil@ccrma.stanford.edu>:
> I believe this shows a bug in letrec:
>
> guile> (let ((x 1)) (let ((x 32) (y x)) y))
> 1
> guile> (let ((x 1)) (letrec ((x 32) (y x)) y))
>
> Backtrace:
> In standard input:
>   2: 0* (let* ((x 1)) (letrec ((x 32) (y x)) y))
>   2: 1  (letrec ((x 32) (y x)) y)
>
> standard input:2:14: In expression (letrec (# #) y):
> standard input:2:14: Variable used before given a value: x
> ABORT: (unbound-variable)

Nope.

From R5RS:

"One restriction on `letrec' is very important: it must be possible
to evaluate each <init> without assigning or referring to the
value of any <variable>."

Re: letrec bug

[Mikael Djurfeldt]

2008/10/28 Mikael Djurfeldt <mikael@djurfeldt.com>:
> 2008/10/28 Bill Schottstaedt <bil@ccrma.stanford.edu>:
>> I believe this shows a bug in letrec:
>>
>> guile> (let ((x 1)) (let ((x 32) (y x)) y))
>> 1
>> guile> (let ((x 1)) (letrec ((x 32) (y x)) y))
>>
>> Backtrace:
>> In standard input:
>>   2: 0* (let* ((x 1)) (letrec ((x 32) (y x)) y))
>>   2: 1  (letrec ((x 32) (y x)) y)
>>
>> standard input:2:14: In expression (letrec (# #) y):
>> standard input:2:14: Variable used before given a value: x
>> ABORT: (unbound-variable)
>
> Nope.
>
> From R5RS:
>
> "One restriction on `letrec' is very important: it must be possible
> to evaluate each <init> without assigning or referring to the
> value of any <variable>."

Sorry.  I missed the surrounding let.  Yes, it is a bug.

Re: letrec bug

[Mikael Djurfeldt]

2008/10/28 Mikael Djurfeldt <mikael@djurfeldt.com>:
> 2008/10/28 Mikael Djurfeldt <mikael@djurfeldt.com>:
>> 2008/10/28 Bill Schottstaedt <bil@ccrma.stanford.edu>:
>>> I believe this shows a bug in letrec:
>>>
>>> guile> (let ((x 1)) (let ((x 32) (y x)) y))
>>> 1
>>> guile> (let ((x 1)) (letrec ((x 32) (y x)) y))
>>>
>>> Backtrace:
>>> In standard input:
>>>   2: 0* (let* ((x 1)) (letrec ((x 32) (y x)) y))
>>>   2: 1  (letrec ((x 32) (y x)) y)
>>>
>>> standard input:2:14: In expression (letrec (# #) y):
>>> standard input:2:14: Variable used before given a value: x
>>> ABORT: (unbound-variable)
>>
>> Nope.
>>
>> From R5RS:
>>
>> "One restriction on `letrec' is very important: it must be possible
>> to evaluate each <init> without assigning or referring to the
>> value of any <variable>."
>
> Sorry.  I missed the surrounding let.  Yes, it is a bug.

Sorry again (should never easily throw out comments when its about
letrec :).  The binding of x which letrec introduces covers the entire
letrec expression.  This means that it *is* an error to refer to it in
another init.  We should be grateful that Guile detects this, because
such code will likely behave in an implementation dependent, and not
standard conforming, manner.

R5RS again:

"The <variable>s are bound to fresh locations holding
 undefined values, the <init>s are evaluated in the resulting
 environment (in some unspecified order)"

Re: letrec bug

[Bill Schottstaedt]

I read those same paragraphs and interpreted them differently,
but now I agree with you.  

Re: letrec bug

[Marijn Schouten (hkBst)]

-----BEGIN PGP SIGNED MESSAGE-----
Hash: SHA1

Bill Schottstaedt wrote:
> I read those same paragraphs and interpreted them differently,
> but now I agree with you.

For your infotainment:

invoke.scm -e "(let ((x 1)) (letrec ((x 32) (y x)) y))"
Bigloo (3.1b)
#unspecified
CHICKEN 3.3.0
32
Elk 3.99.7
32
Gambit v4.1.0
#!unbound
Gauche scheme interpreter, version 0.8.13 [utf-8,pthreads]
32
Guile 1.8.5
ERROR: Variable used before given a value: x

ikarus is unavailable
kawa is unavailable
larceny is unavailable
MIT/GNU Scheme 7.7.90.+

;Premature reference to reserved name: x
;To continue, call RESTART with an option number:
; (RESTART 1) => Return to read-eval-print level 1.

2 error>
End of input stream reached.
Welcome to MzScheme v4.1 [3m], Copyright (c) 2004-2008 PLT Scheme Inc.
32
RScheme 0.7.3.4-b7u
value := 32

scheme48 1.8

Error: LETREC variable used before its value has been produced
Schoca Shell (Version 0.3.0-cvs) by Christoph Bauer

schoca> ==> #unspecified
schoca>
scm 5e4
Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996 Free Software Foundation, Inc.
SCM may be distributed under the terms of the GNU General Public Licence;
certain other uses are permitted as well. For details, see the file `COPYING',
which is included in the SCM distribution.
There is no warranty, to the extent permitted by law.
 This executable was loaded from "/usr/bin/scm"
32
sigscheme 0.8.3
sscm> 1
sscm>
sisc is unavailable
stklos (version 0.98)
#f
TinyScheme 1.39
> 1
>

cheers,

Marijn

- --
Marijn Schouten (hkBst), Gentoo Lisp project, Gentoo ML
<http://www.gentoo.org/proj/en/lisp/>, #gentoo-{lisp,ml} on FreeNode
-----BEGIN PGP SIGNATURE-----
Version: GnuPG v2.0.9 (GNU/Linux)
Comment: Using GnuPG with Mozilla - http://enigmail.mozdev.org

iEYEARECAAYFAkkJ020ACgkQp/VmCx0OL2wXIgCfd5sFqoZ9qQkdzI+m6+qTfPE/
TPwAn23CPCTIp9qYuqNmOHLBVkPM1m0Z
=fbTc
-----END PGP SIGNATURE-----

Re: letrec bug

[Ludovic Courtès]

Hello,

"Marijn Schouten (hkBst)" <hkBst@gentoo.org> writes:

> invoke.scm -e "(let ((x 1)) (letrec ((x 32) (y x)) y))"

Could you make a copy of `invoke.scm' available?  :-)

Thanks,
Ludo'.

Re: letrec bug

[Marijn Schouten (hkBst)]

[-- Attachment #1.1: Type: text/plain, Size: 450 bytes --]

Ludovic � wrote:
> Hello,
> 
> "Marijn Schouten (hkBst)" <hkBst@gentoo.org> writes:
> 
>> invoke.scm -e "(let ((x 1)) (letrec ((x 32) (y x)) y))"
> 
> Could you make a copy of `invoke.scm' available?  :-)
> 
> Thanks,
> Ludo'.

Certainly.

I hope you have as much fun with it as I have :D

Marijn

-- 
Marijn Schouten (hkBst), Gentoo Lisp project, Gentoo ML
<http://www.gentoo.org/proj/en/lisp/>, #gentoo-{lisp,ml} on FreeNode

[-- Attachment #1.2: invoke.scm --]
[-- Type: text/plain, Size: 9148 bytes --]

#!/usr/bin/guile \
-s
!#

(use-modules
 (oop goops)
; (oop goops describe)
 (ice-9 syncase)
 (ice-9 getopt-long)
 (ice-9 popen)
 )

(define-class <scheme> ()
  (name #:getter s-name #:init-keyword #:name)
  (announce #:getter s-announce #:init-keyword #:announce)
  (filename #:getter s-filename #:init-keyword #:filename)
  (eval #:getter s-eval #:init-keyword #:eval)
  (load-eval #:getter s-load-eval #:init-keyword #:load-eval)
;  (version-option #:getter s-version-option #:init-keyword #:version-option)
;  (version-command #:getter s-version-command #:init-keyword #:version-command)
  )

(define (in-path executable) (search-path (parse-path (getenv "PATH")) executable))

(define (for-each-display s) (string-append "(for-each display (list " s "))"))

(define (for-each-display-then-exit s) (string-append "(for-each display (list " s "))"))

(define (available? scheme)
  (in-path (s-filename scheme)))

(define (announce-bigloo)     (system* (s-filename bigloo) "-version"))
(define (announce-chicken)    (display "CHICKEN ") (system* (s-filename chicken) "-release"))
(define (announce-elk)        (display "Elk 3.99.7")(newline))
(define (announce-gambit)     (display "Gambit ") (eval-gambit "(##system-version-string)"))
(define (announce-gauche)     (system* (s-filename gauche) "-V"))
(define (announce-guile)      (display "Guile ") (eval-guile "(version)"))
(define (announce-ikarus)     (display "Ikarus")(newline))
(define (announce-kawa)       (display "kawa")(newline))
(define (announce-larceny)    (display "larceny")(newline))
(define (announce-mit-scheme) (display "MIT/GNU Scheme ") (eval-mit-scheme "(get-subsystem-version-string \"Release\")"))
(define (announce-mzscheme)   (system* (s-filename mzscheme) "-v"))
(define (announce-rscheme)    (display "RScheme ") (system* (s-filename rscheme) "--version"))
(define (announce-scheme48)   (display "scheme48 1.8")(newline))
(define (announce-schoca)     #f);(eval-schoca ""))
(define (announce-scm)        (system* (s-filename scm) "--version"))
(define (announce-sigscheme)  (display (s-name sigscheme))(display " 0.8.3")(newline))
(define (announce-sisc)       (into-pipe* "" (s-filename sisc)))
(define (announce-stklos)     (system* (s-filename stklos) "--version"))
(define (announce-tinyscheme) #f);(eval-tinyscheme ""))

(define (announce scheme)
  ((s-announce scheme)))

(define (evaluate-all command) (for-each (lambda (s)(evaluate s command)) schemes))

(define-syntax into-pipe*
  (syntax-rules ()
    ((_ command args ...)
     (let ((port (open-pipe* OPEN_WRITE args ...))) (display command port) (close-pipe port)))))

(define (eval-bigloo command)     (system* "bigloo" "-eval" (string-append (for-each-display command) "(exit)"))(newline));(into-pipe* command "bigloo" "-s" "-call/cc"))
(define (eval-chicken command)    (system* "csi" "-eval" (for-each-display command))(newline))
(define (eval-elk command)        (into-pipe* (for-each-display command) "elk" "-l" "-")(newline))
(define (eval-gambit command)     (system* "gambit-interpreter" "-e" (for-each-display command))(newline))
(define (eval-gauche command)     (into-pipe* (for-each-display command) "gosh" "-b")(newline))
(define (eval-guile command)      (system* "guile" "-c" (for-each-display command))(newline))
(define (eval-ikarus command)     (into-pipe* command "ikarus")(newline))
(define (eval-kawa command)       (into-pipe* command "kawa")(newline))
(define (eval-larceny command)    (into-pipe* command "larceny")(newline))
(define (eval-mit-scheme command) (into-pipe* (for-each-display command) "mit-scheme" "--batch-mode")(newline))
(define (eval-mzscheme command)   (system* "mzscheme" "--eval" (for-each-display command))(newline))
(define (eval-rscheme command)    (into-pipe* command "rs" "-script"))
(define (eval-scheme48 command)   (into-pipe* command "scheme48" "-a" "batch"))
(define (eval-schoca command)     (into-pipe* command "schoca")(newline))
(define (eval-scm command)        (system* "scm" "-e" (for-each-display command))(newline))
(define (eval-sigscheme command)  (into-pipe* command "sscm")(newline))
(define (eval-sisc command)       (into-pipe* command "sisc")(newline))
(define (eval-stklos command)     (system* "stklos" "-e" (for-each-display command))(newline))
(define (eval-tinyscheme command) (into-pipe* command "tinyscheme")(newline))

(define (evaluate scheme command)
  ((s-eval scheme) command))

(define (load-eval-bigloo file)     (system* "bigloo" "-load" file "-eval" "(exit)"))
(define (load-eval-chicken file)    (system* "csi" "-script" file))
(define (load-eval-elk file)        (system* "elk" "-l" file))
(define (load-eval-gambit file)     (system* "gambit-interpreter" file))
(define (load-eval-gauche file)     (system* "gosh" file))
(define (load-eval-guile file)      (system* "guile" "-s" file))
(define (load-eval-ikarus file)     (system* "ikarus" file))
(define (load-eval-kawa file)       (into-pipe* file "kawa"))
(define (load-eval-larceny file)    (into-pipe* file "larceny"))
(define (load-eval-mit-scheme file) (into-pipe* "" "mit-scheme" "--batch-mode" "--load" file))
(define (load-eval-mzscheme file)   (system* "mzscheme" "--load" file))
(define (load-eval-rscheme file)    (system* "rs" "-script" file))
(define (load-eval-scheme48 file)   (eval-scheme48 (string-append "(load \"" file "\")")))
(define (load-eval-schoca file)     (eval-schoca "")(system* "schoca" file))
(define (load-eval-scm file)        (system* "scm" "-l" file))
(define (load-eval-sigscheme file)  (system* "sscm" file))
(define (load-eval-sisc file)       (into-pipe* file "sisc"))
(define (load-eval-stklos file)     (system* "stklos" "-f" file))
(define (load-eval-tinyscheme file) (eval-tinyscheme "")(system* "tinyscheme" file))

(define (load scheme file)
  ((s-load-eval scheme) file))

(define-syntax define-scheme
  (syntax-rules ()
    ((define-scheme scheme name announce filename eval load-eval)
     (begin
       (define scheme (make <scheme>
                        #:name name #:announce announce #:filename filename #:eval eval #:load-eval load-eval)
         )
       (register scheme)))))

(define schemes '())
(define (register scheme)
  (set! schemes (cons scheme schemes)))

(define-scheme bigloo     "Bigloo"         announce-bigloo     "bigloo"     eval-bigloo     load-eval-bigloo)
(define-scheme chicken    "CHICKEN"        announce-chicken    "chicken"    eval-chicken    load-eval-chicken)   
(define-scheme elk        "Elk"            announce-elk        "elk"        eval-elk        load-eval-elk)       
(define-scheme gambit     "Gambit"         announce-gambit     "gsi"        eval-gambit     load-eval-gambit)    
(define-scheme gauche     "Gauche"         announce-gauche     "gosh"       eval-gauche     load-eval-gauche)    
(define-scheme guile      "Guile"          announce-guile      "guile"      eval-guile      load-eval-guile)     
(define-scheme ikarus     "ikarus"         announce-ikarus     "ikarus"     eval-ikarus     load-eval-ikarus)    
(define-scheme kawa       "kawa"           announce-kawa       "kawa"       eval-kawa       load-eval-kawa)      
(define-scheme larceny    "larceny"        announce-larceny    "larceny"    eval-larceny    load-eval-larceny)   
(define-scheme mit-scheme "MIT/GNU Scheme" announce-mit-scheme "mit-scheme" eval-mit-scheme load-eval-mit-scheme)
(define-scheme mzscheme   "MzScheme"       announce-mzscheme   "mzscheme"   eval-mzscheme   load-eval-mzscheme)  
(define-scheme rscheme    "RScheme"        announce-rscheme    "rs"         eval-rscheme    load-eval-rscheme)   
(define-scheme scheme48   "Scheme48"       announce-scheme48   "scheme48"   eval-scheme48   load-eval-scheme48)  
(define-scheme schoca     "Schoca"         announce-schoca     "schoca"     eval-schoca     load-eval-schoca)    
(define-scheme scm        "SCM"            announce-scm        "scm"        eval-scm        load-eval-scm)       
(define-scheme sigscheme  "sigscheme"      announce-sigscheme  "sscm"       eval-sigscheme  load-eval-sigscheme) 
(define-scheme sisc       "sisc"           announce-sisc       "sisc"       eval-sisc       load-eval-sisc)      
(define-scheme stklos     "STklos"         announce-stklos     "stklos"     eval-stklos     load-eval-stklos)    
(define-scheme tinyscheme "tinyscheme"     announce-tinyscheme "tinyscheme" eval-tinyscheme load-eval-tinyscheme)


; stalin

(set! schemes (reverse schemes))

(define option-spec
  '(;(version (single-char #\v) (value #f))
    (eval (single-char #\e) (value #t))
    (load (single-char #\l) (value #t))
    (schemes (single-char #\s) (value #t))
    ))

(define (main)
  (define options (getopt-long (command-line) option-spec))
  (for-each (lambda (s)
              (cond
               ((available? s)
                (announce s)
                (let ((command (option-ref options 'eval #f)))
                  (if command (evaluate s command)))
                (let ((file (option-ref options 'load #f)))
                  (if file (load s file))))
               (else
                (begin (display (s-name s)) (display " is unavailable")(newline)))))
            schemes))

(main)

[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 260 bytes --]