[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Re: letrec bug
From: |
Marijn Schouten (hkBst) |
Subject: |
Re: letrec bug |
Date: |
Tue, 04 Nov 2008 00:29:46 +0100 |
User-agent: |
Thunderbird 2.0.0.17 (X11/20081002) |
Ludovic � wrote:
> Hello,
>
> "Marijn Schouten (hkBst)" <address@hidden> 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
#!/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)
signature.asc
Description: OpenPGP digital signature
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- Re: letrec bug,
Marijn Schouten (hkBst) <=